49 character(len=100),
intent(in) :: anfdatname
51 real(dp),
intent(out) :: dxi, deta, z_sl
53 integer(i4b) :: i, j, kc, kt, kr, n
56 character(len=256) :: anfdatname_with_path
58 integer(i4b) :: ncid, ncv
62 integer(i2b),
dimension(0:IMAX,0:JMAX) :: maske_conv, n_cts_conv, kc_cts_conv
63 real(sp) :: time_conv, dummy_conv, z_sl_conv, &
64 v_tot_conv, a_grounded_conv, a_floating_conv, &
66 xi_conv(0:imax), eta_conv(0:jmax), &
67 sigma_level_c_conv(0:kcmax), sigma_level_t_conv(0:ktmax), &
68 sigma_level_r_conv(0:krmax)
69 real(sp),
dimension(0:IMAX,0:JMAX) :: lambda_conv, phi_conv, &
71 temp_s_conv, as_perp_conv, &
72 zs_conv, zm_conv, zb_conv, zl_conv, &
73 h_cold_conv, h_temp_conv, h_conv, &
74 q_bm_conv, q_tld_conv, &
77 dzs_dtau_conv, dzm_dtau_conv, dzb_dtau_conv, dzl_dtau_conv, &
78 dh_c_dtau_conv, dh_t_dtau_conv, dh_dtau_conv, &
79 vx_b_g_conv, vy_b_g_conv, vz_b_conv, vh_b_conv, &
80 vx_s_g_conv, vy_s_g_conv, vz_s_conv, vh_s_conv, &
81 temp_b_conv, temph_b_conv, &
82 p_b_w_conv, h_w_conv, q_gl_g_conv
83 real(sp),
dimension(0:IMAX,0:JMAX,0:KCMAX) :: vx_c_conv, vy_c_conv, vz_c_conv, &
84 temp_c_conv, age_c_conv, &
85 enth_c_conv, omega_c_conv, &
87 real(sp),
dimension(0:IMAX,0:JMAX,0:KTMAX) :: vx_t_conv, vy_t_conv, vz_t_conv, &
88 omega_t_conv, age_t_conv, &
91 real(sp),
dimension(0:IMAX,0:JMAX,0:KRMAX) :: temp_r_conv
95 anfdatname_with_path = trim(anfdatpath)//
'/'//trim(anfdatname)
97 call
check( nf90_open(trim(anfdatname_with_path), nf90_nowrite, ncid) )
99 call
check( nf90_inq_varid(ncid,
'time', ncv) )
100 call
check( nf90_get_var(ncid, ncv, time_conv) )
102 if ( nf90_inq_varid(ncid,
'delta_ts', ncv) == nf90_noerr )
then
103 call
check( nf90_get_var(ncid, ncv, dummy_conv) )
104 else if ( nf90_inq_varid(ncid,
'glac_index', ncv) == nf90_noerr )
then
105 call
check( nf90_get_var(ncid, ncv, dummy_conv) )
110 call
check( nf90_inq_varid(ncid,
'z_sl', ncv) )
111 call
check( nf90_get_var(ncid, ncv, z_sl_conv) )
113 call
check( nf90_inq_varid(ncid,
'xi', ncv) )
114 call
check( nf90_get_var(ncid, ncv, xi_conv) )
116 call
check( nf90_inq_varid(ncid,
'eta', ncv) )
117 call
check( nf90_get_var(ncid, ncv, eta_conv) )
119 call
check( nf90_inq_varid(ncid,
'sigma_level_c', ncv) )
120 call
check( nf90_get_var(ncid, ncv, sigma_level_c_conv) )
122 call
check( nf90_inq_varid(ncid,
'sigma_level_t', ncv) )
123 call
check( nf90_get_var(ncid, ncv, sigma_level_t_conv) )
125 call
check( nf90_inq_varid(ncid,
'sigma_level_r', ncv) )
126 call
check( nf90_get_var(ncid, ncv, sigma_level_r_conv) )
128 call
check( nf90_inq_varid(ncid,
'lon', ncv) )
129 call
check( nf90_get_var(ncid, ncv, lon_conv) )
131 call
check( nf90_inq_varid(ncid,
'lat', ncv) )
132 call
check( nf90_get_var(ncid, ncv, lat_conv) )
134 call
check( nf90_inq_varid(ncid,
'lambda', ncv) )
135 call
check( nf90_get_var(ncid, ncv, lambda_conv) )
137 call
check( nf90_inq_varid(ncid,
'phi', ncv) )
138 call
check( nf90_get_var(ncid, ncv, phi_conv) )
140 call
check( nf90_inq_varid(ncid,
'temp_s', ncv) )
141 call
check( nf90_get_var(ncid, ncv, temp_s_conv) )
143 call
check( nf90_inq_varid(ncid,
'as_perp', ncv) )
144 call
check( nf90_get_var(ncid, ncv, as_perp_conv) )
146 call
check( nf90_inq_varid(ncid,
'maske', ncv) )
147 call
check( nf90_get_var(ncid, ncv, maske_conv) )
149 call
check( nf90_inq_varid(ncid,
'n_cts', ncv) )
150 call
check( nf90_get_var(ncid, ncv, n_cts_conv) )
152 if ( nf90_inq_varid(ncid,
'kc_cts', ncv) == nf90_noerr )
then
153 call
check( nf90_get_var(ncid, ncv, kc_cts_conv) )
158 call
check( nf90_inq_varid(ncid,
'zs', ncv) )
159 call
check( nf90_get_var(ncid, ncv, zs_conv) )
161 call
check( nf90_inq_varid(ncid,
'zm', ncv) )
162 call
check( nf90_get_var(ncid, ncv, zm_conv) )
164 call
check( nf90_inq_varid(ncid,
'zb', ncv) )
165 call
check( nf90_get_var(ncid, ncv, zb_conv) )
167 call
check( nf90_inq_varid(ncid,
'zl', ncv) )
168 call
check( nf90_get_var(ncid, ncv, zl_conv) )
170 call
check( nf90_inq_varid(ncid,
'H_cold', ncv) )
171 call
check( nf90_get_var(ncid, ncv, h_cold_conv) )
173 call
check( nf90_inq_varid(ncid,
'H_temp', ncv) )
174 call
check( nf90_get_var(ncid, ncv, h_temp_conv) )
176 call
check( nf90_inq_varid(ncid,
'H', ncv) )
177 call
check( nf90_get_var(ncid, ncv, h_conv) )
179 call
check( nf90_inq_varid(ncid,
'H_R', ncv) )
180 call
check( nf90_get_var(ncid, ncv, h_r_conv) )
182 call
check( nf90_inq_varid(ncid,
'vx_c', ncv) )
183 call
check( nf90_get_var(ncid, ncv, vx_c_conv) )
185 call
check( nf90_inq_varid(ncid,
'vy_c', ncv) )
186 call
check( nf90_get_var(ncid, ncv, vy_c_conv) )
188 call
check( nf90_inq_varid(ncid,
'vz_c', ncv) )
189 call
check( nf90_get_var(ncid, ncv, vz_c_conv) )
191 call
check( nf90_inq_varid(ncid,
'vx_t', ncv) )
192 call
check( nf90_get_var(ncid, ncv, vx_t_conv) )
194 call
check( nf90_inq_varid(ncid,
'vy_t', ncv) )
195 call
check( nf90_get_var(ncid, ncv, vy_t_conv) )
197 call
check( nf90_inq_varid(ncid,
'vz_t', ncv) )
198 call
check( nf90_get_var(ncid, ncv, vz_t_conv) )
200 call
check( nf90_inq_varid(ncid,
'temp_c', ncv) )
201 call
check( nf90_get_var(ncid, ncv, temp_c_conv) )
203 call
check( nf90_inq_varid(ncid,
'omega_t', ncv) )
204 call
check( nf90_get_var(ncid, ncv, omega_t_conv) )
206 call
check( nf90_inq_varid(ncid,
'temp_r', ncv) )
207 call
check( nf90_get_var(ncid, ncv, temp_r_conv) )
209 if ( nf90_inq_varid(ncid,
'enth_c', ncv) == nf90_noerr )
then
210 call
check( nf90_get_var(ncid, ncv, enth_c_conv) )
215 if ( nf90_inq_varid(ncid,
'enth_t', ncv) == nf90_noerr )
then
216 call
check( nf90_get_var(ncid, ncv, enth_t_conv) )
221 if ( nf90_inq_varid(ncid,
'omega_c', ncv) == nf90_noerr )
then
222 call
check( nf90_get_var(ncid, ncv, omega_c_conv) )
227 if ( nf90_inq_varid(ncid,
'enh_c', ncv) == nf90_noerr )
then
228 call
check( nf90_get_var(ncid, ncv, enh_c_conv) )
233 if ( nf90_inq_varid(ncid,
'enh_t', ncv) == nf90_noerr )
then
234 call
check( nf90_get_var(ncid, ncv, enh_t_conv) )
239 call
check( nf90_inq_varid(ncid,
'Q_bm', ncv) )
240 call
check( nf90_get_var(ncid, ncv, q_bm_conv) )
242 call
check( nf90_inq_varid(ncid,
'Q_tld', ncv) )
243 call
check( nf90_get_var(ncid, ncv, q_tld_conv) )
245 call
check( nf90_inq_varid(ncid,
'am_perp', ncv) )
246 call
check( nf90_get_var(ncid, ncv, am_perp_conv) )
248 call
check( nf90_inq_varid(ncid,
'qx', ncv) )
249 call
check( nf90_get_var(ncid, ncv, qx_conv) )
251 call
check( nf90_inq_varid(ncid,
'qy', ncv) )
252 call
check( nf90_get_var(ncid, ncv, qy_conv) )
254 call
check( nf90_inq_varid(ncid,
'age_c', ncv) )
255 call
check( nf90_get_var(ncid, ncv, age_c_conv) )
257 call
check( nf90_inq_varid(ncid,
'age_t', ncv) )
258 call
check( nf90_get_var(ncid, ncv, age_t_conv) )
260 call
check( nf90_inq_varid(ncid,
'dzs_dtau', ncv) )
261 call
check( nf90_get_var(ncid, ncv, dzs_dtau_conv) )
263 call
check( nf90_inq_varid(ncid,
'dzm_dtau', ncv) )
264 call
check( nf90_get_var(ncid, ncv, dzm_dtau_conv) )
266 call
check( nf90_inq_varid(ncid,
'dzb_dtau', ncv) )
267 call
check( nf90_get_var(ncid, ncv, dzb_dtau_conv) )
269 call
check( nf90_inq_varid(ncid,
'dzl_dtau', ncv) )
270 call
check( nf90_get_var(ncid, ncv, dzl_dtau_conv) )
272 call
check( nf90_inq_varid(ncid,
'dH_c_dtau', ncv) )
273 call
check( nf90_get_var(ncid, ncv, dh_c_dtau_conv) )
275 call
check( nf90_inq_varid(ncid,
'dH_t_dtau', ncv) )
276 call
check( nf90_get_var(ncid, ncv, dh_t_dtau_conv) )
278 call
check( nf90_inq_varid(ncid,
'dH_dtau', ncv) )
279 call
check( nf90_get_var(ncid, ncv, dh_dtau_conv) )
281 if ( nf90_inq_varid(ncid,
'vx_b_g', ncv) == nf90_noerr )
then
282 call
check( nf90_get_var(ncid, ncv, vx_b_g_conv) )
287 if ( nf90_inq_varid(ncid,
'vy_b_g', ncv) == nf90_noerr )
then
288 call
check( nf90_get_var(ncid, ncv, vy_b_g_conv) )
293 if ( nf90_inq_varid(ncid,
'vz_b', ncv) == nf90_noerr )
then
294 call
check( nf90_get_var(ncid, ncv, vz_b_conv) )
299 if ( nf90_inq_varid(ncid,
'vh_b', ncv) == nf90_noerr )
then
300 call
check( nf90_get_var(ncid, ncv, vh_b_conv) )
305 if ( nf90_inq_varid(ncid,
'vx_s_g', ncv) == nf90_noerr )
then
306 call
check( nf90_get_var(ncid, ncv, vx_s_g_conv) )
311 if ( nf90_inq_varid(ncid,
'vy_s_g', ncv) == nf90_noerr )
then
312 call
check( nf90_get_var(ncid, ncv, vy_s_g_conv) )
317 if ( nf90_inq_varid(ncid,
'vz_s', ncv) == nf90_noerr )
then
318 call
check( nf90_get_var(ncid, ncv, vz_s_conv) )
323 if ( nf90_inq_varid(ncid,
'vh_s', ncv) == nf90_noerr )
then
324 call
check( nf90_get_var(ncid, ncv, vh_s_conv) )
329 if ( nf90_inq_varid(ncid,
'temp_b', ncv) == nf90_noerr )
then
330 call
check( nf90_get_var(ncid, ncv, temp_b_conv) )
335 if ( nf90_inq_varid(ncid,
'temph_b', ncv) == nf90_noerr )
then
336 call
check( nf90_get_var(ncid, ncv, temph_b_conv) )
341 if ( nf90_inq_varid(ncid,
'p_b_w', ncv) == nf90_noerr )
then
342 call
check( nf90_get_var(ncid, ncv, p_b_w_conv) )
347 if ( nf90_inq_varid(ncid,
'H_w', ncv) == nf90_noerr )
then
348 call
check( nf90_get_var(ncid, ncv, h_w_conv) )
353 if ( nf90_inq_varid(ncid,
'q_gl_g', ncv) == nf90_noerr )
then
354 call
check( nf90_get_var(ncid, ncv, q_gl_g_conv) )
362 write(6,
'(/1x,a)')
'topography3_nc: End-of-file condition while reading *.nc.'
363 write(6,
'(1x,a)')
' Some variables will be undefined.'
367 call
check( nf90_close(ncid) )
371 z_sl =
real(z_sl_conv,dp)
373 h_r =
real(h_r_conv,dp)
376 xi(i) =
real(xi_conv(i),dp)
380 eta(j) =
real(eta_conv(j),dp)
386 maske(j,i) = maske_conv(i,j)
387 n_cts(j,i) = n_cts_conv(i,j)
388 kc_cts(j,i) = kc_cts_conv(i,j)
389 zs(j,i) =
real(zs_conv(i,j),dp)
390 zm(j,i) =
real(zm_conv(i,j),dp)
391 zb(j,i) =
real(zb_conv(i,j),dp)
392 zl(j,i) =
real(zl_conv(i,j),dp)
394 h_c(j,i) =
real(H_cold_conv(i,j),dp)
395 h_t(j,i) =
real(H_temp_conv(i,j),dp)
396 #elif (CALCMOD==0 || CALCMOD==2 || CALCMOD==3 || CALCMOD==-1)
397 h_c(j,i) =
real(H_conv(i,j),dp)
400 q_bm(j,i) =
real(Q_bm_conv(i,j),dp)/year_sec
401 q_tld(j,i) =
real(Q_tld_conv(i,j),dp)/year_sec
402 am_perp(j,i) =
real(am_perp_conv(i,j),dp)/year_sec
403 qx(j,i) =
real(qx_conv(i,j),dp)/year_sec
404 qy(j,i) =
real(qy_conv(i,j),dp)/year_sec
405 dzs_dtau(j,i) =
real(dzs_dtau_conv(i,j),dp)/year_sec
406 dzm_dtau(j,i) =
real(dzm_dtau_conv(i,j),dp)/year_sec
407 dzb_dtau(j,i) =
real(dzb_dtau_conv(i,j),dp)/year_sec
408 dzl_dtau(j,i) =
real(dzl_dtau_conv(i,j),dp)/year_sec
409 dh_c_dtau(j,i) =
real(dH_c_dtau_conv(i,j),dp)/year_sec
410 dh_t_dtau(j,i) =
real(dH_t_dtau_conv(i,j),dp)/year_sec
411 vx_b_g(j,i) =
real(vx_b_g_conv(i,j),dp)/year_sec
412 vy_b_g(j,i) =
real(vy_b_g_conv(i,j),dp)/year_sec
413 vz_b(j,i) =
real(vz_b_conv(i,j),dp)/year_sec
414 vx_s_g(j,i) =
real(vx_s_g_conv(i,j),dp)/year_sec
415 vy_s_g(j,i) =
real(vy_s_g_conv(i,j),dp)/year_sec
416 vz_s(j,i) =
real(vz_s_conv(i,j),dp)/year_sec
417 temp_b(j,i) =
real(temp_b_conv(i,j),dp)
418 temph_b(j,i) =
real(temph_b_conv(i,j),dp)
419 p_b_w(j,i) =
real(p_b_w_conv(i,j),dp)
420 h_w(j,i) =
real(H_w_conv(i,j),dp)
421 q_gl_g(j,i) =
real(q_gl_g_conv(i,j),dp)/year_sec
424 temp_r(kr,j,i) =
real(temp_r_conv(i,j,kr),dp)
428 vx_t(kt,j,i) =
real(vx_t_conv(i,j,kt),dp)/year_sec
429 vy_t(kt,j,i) =
real(vy_t_conv(i,j,kt),dp)/year_sec
430 vz_t(kt,j,i) =
real(vz_t_conv(i,j,kt),dp)/year_sec
431 omega_t(kt,j,i) =
real(omega_t_conv(i,j,kt),dp)
432 age_t(kt,j,i) =
real(age_t_conv(i,j,kt),dp)*year_sec
433 enth_t(kt,j,i) =
real(enth_t_conv(i,j,kt),dp)
434 enh_t(kt,j,i) =
real(enh_t_conv(i,j,kt),dp)
438 vx_c(kc,j,i) =
real(vx_c_conv(i,j,kc),dp)/year_sec
439 vy_c(kc,j,i) =
real(vy_c_conv(i,j,kc),dp)/year_sec
440 vz_c(kc,j,i) =
real(vz_c_conv(i,j,kc),dp)/year_sec
441 temp_c(kc,j,i) =
real(temp_c_conv(i,j,kc),dp)
442 age_c(kc,j,i) =
real(age_c_conv(i,j,kc),dp)*year_sec
443 enth_c(kc,j,i) =
real(enth_c_conv(i,j,kc),dp)
444 omega_c(kc,j,i) =
real(omega_c_conv(i,j,kc),dp)
445 enh_c(kc,j,i) =
real(enh_c_conv(i,j,kc),dp)
453 open(23, iostat=ios, &
454 file=inpath//
'/'//trim(ch_domain_short)//
'/'//zl0_file, &
455 recl=16384, status=
'old')
457 if (ios /= 0) stop
' topography3_nc: Error when opening the zl0 file!'
459 do n=1, 6;
read(23,
'(a)') ch_dummy;
end do
462 read(23,*) (zl0(j,i), i=0,imax)
465 close(23, status=
'keep')
469 dxi = dlambda *pi_180
474 call
geo_coord(phi(j,i), lambda(j,i), xi(i), eta(j))
492 area(j,i) = sq_g11_g(j,i)*sq_g22_g(j,i)*dxi*deta
subroutine topograd_2(dxi, deta, n_switch)
Calculation of topography gradients on the staggered grid and on the grid points (the latter by fourt...
Declarations of kind types for SICOPOLIS.
subroutine topograd_1(dxi, deta, n_switch)
Calculation of topography gradients on the staggered grid and on the grid points (the latter by secon...
subroutine topography3_nc(dxi, deta, z_sl, anfdatname)
Definition of the initial surface and bedrock topography (including gradients) and of the horizontal ...
subroutine check(status, ch_calling_routine)
NetCDF error capturing.
Declarations of global variables for SICOPOLIS (for the ANT domain).
subroutine geo_coord(phi_val, lambda_val, x_val, y_val)
Computation of longitude lambda and latitude phi for position (x,y) in the numerical domain...
subroutine metric()
Definition of the components g11 and g22 of the metric tensor of the applied coordinates.
Declarations of global variables for SICOPOLIS.