7 !! Definition of the initial surface and bedrock topography
8 !! (including gradients) and of the horizontal grid spacings dxi, deta.
9 !! For initial topography from previous simulation (read in NetCDF format).
13 !! Copyright 2009-2013 Ralf Greve
17 !! This file is part of SICOPOLIS.
19 !! SICOPOLIS is free software: you can redistribute it and/or modify
20 !! it under the terms of the GNU General Public License as published by
21 !! the Free Software Foundation, either version 3 of the License, or
22 !! (at your option) any later version.
24 !! SICOPOLIS is distributed in the hope that it will be useful,
25 !! but WITHOUT ANY WARRANTY; without even the implied warranty of
26 !! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
27 !! GNU General Public License for more details.
29 !! You should have received a copy of the GNU General Public License
30 !! along with SICOPOLIS. If not, see <http://www.gnu.org/licenses/>.
32 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
35 !> Definition of the initial surface and bedrock topography
36 !! (including gradients) and of the horizontal grid spacings dxi, deta.
37 !! For initial topography from previous simulation (read in NetCDF format).
38 !<------------------------------------------------------------------------------
47 character (len=100),
intent (in) :: anfdatname
49 real(dp),
intent (out) :: dxi, deta, z_sl
51 integer(i4b) :: i, j, kc, kt, kr, n
53 real(sp) :: time_conv, dummy_conv, z_sl_conv, &
54 h_r_conv, xi_conv(0:imax), eta_conv(0:jmax), &
55 sigma_level_c_conv(0:kcmax), sigma_level_t_conv(0:ktmax), &
56 sigma_level_r_conv(0:krmax), &
57 lambda_conv(0:jmax,0:imax), phi_conv(0:jmax,0:imax), &
58 temp_s_conv(0:jmax,0:imax), as_perp_conv(0:jmax,0:imax), &
59 zs_conv(0:jmax,0:imax), zm_conv(0:jmax,0:imax), &
60 zb_conv(0:jmax,0:imax), zl_conv(0:jmax,0:imax), &
61 h_c_conv(0:jmax,0:imax), h_t_conv(0:jmax,0:imax), &
62 h_conv(0:jmax,0:imax), &
63 q_bm_conv(0:jmax,0:imax), q_tld_conv(0:jmax,0:imax), &
64 am_perp_conv(0:jmax,0:imax), &
65 qx_conv(0:jmax,0:imax), qy_conv(0:jmax,0:imax), &
66 temp_r_conv(0:krmax,0:jmax,0:imax), &
67 vx_c_conv(0:kcmax,0:jmax,0:imax), &
68 vy_c_conv(0:kcmax,0:jmax,0:imax), &
69 vz_c_conv(0:kcmax,0:jmax,0:imax), &
70 vx_t_conv(0:ktmax,0:jmax,0:imax), &
71 vy_t_conv(0:ktmax,0:jmax,0:imax), &
72 vz_t_conv(0:ktmax,0:jmax,0:imax), &
73 temp_c_conv(0:kcmax,0:jmax,0:imax), &
74 age_c_conv(0:kcmax,0:jmax,0:imax), &
75 omega_t_conv(0:ktmax,0:jmax,0:imax), &
76 age_t_conv(0:ktmax,0:jmax,0:imax), &
77 dzs_dtau_conv(0:jmax,0:imax), dzm_dtau_conv(0:jmax,0:imax), &
78 dzb_dtau_conv(0:jmax,0:imax), dzl_dtau_conv(0:jmax,0:imax), &
79 dh_c_dtau_conv(0:jmax,0:imax), dh_t_dtau_conv(0:jmax,0:imax), &
80 dh_dtau_conv(0:jmax,0:imax), &
81 vx_b_g_conv(0:jmax,0:imax), vy_b_g_conv(0:jmax,0:imax), &
82 vz_b_conv(0:jmax,0:imax), &
83 vx_s_g_conv(0:jmax,0:imax), vy_s_g_conv(0:jmax,0:imax), &
84 vz_s_conv(0:jmax,0:imax), &
85 temp_b_conv(0:jmax,0:imax), temph_b_conv(0:jmax,0:imax), &
86 p_b_w_conv(0:jmax,0:imax), h_w_conv(0:jmax,0:imax), &
87 q_gl_g_conv(0:jmax,0:imax)
90 integer(i4b) :: ncid, ncv
96 call
check( nf90_open(anfdatpath//
'/'//trim(anfdatname), nf90_nowrite, ncid) )
98 call
check( nf90_inq_varid(ncid,
'time', ncv) )
99 call
check( nf90_get_var(ncid, ncv, time_conv) )
101 if ( nf90_inq_varid(ncid,
'delta_ts', ncv) == nf90_noerr )
then
102 call
check( nf90_get_var(ncid, ncv, dummy_conv) )
103 else if ( nf90_inq_varid(ncid,
'glac_index', ncv) == nf90_noerr )
then
104 call
check( nf90_get_var(ncid, ncv, dummy_conv) )
109 call
check( nf90_inq_varid(ncid,
'z_sl', ncv) )
110 call
check( nf90_get_var(ncid, ncv, z_sl_conv) )
112 call
check( nf90_inq_varid(ncid,
'xi', ncv) )
113 call
check( nf90_get_var(ncid, ncv, xi_conv) )
115 call
check( nf90_inq_varid(ncid,
'eta', ncv) )
116 call
check( nf90_get_var(ncid, ncv, eta_conv) )
118 call
check( nf90_inq_varid(ncid,
'sigma_level_c', ncv) )
119 call
check( nf90_get_var(ncid, ncv, sigma_level_c_conv) )
121 call
check( nf90_inq_varid(ncid,
'sigma_level_t', ncv) )
122 call
check( nf90_get_var(ncid, ncv, sigma_level_t_conv) )
124 call
check( nf90_inq_varid(ncid,
'sigma_level_r', ncv) )
125 call
check( nf90_get_var(ncid, ncv, sigma_level_r_conv) )
127 call
check( nf90_inq_varid(ncid,
'lambda', ncv) )
128 call
check( nf90_get_var(ncid, ncv, lambda_conv) )
130 call
check( nf90_inq_varid(ncid,
'phi', ncv) )
131 call
check( nf90_get_var(ncid, ncv, phi_conv) )
133 call
check( nf90_inq_varid(ncid,
'temp_s', ncv) )
134 call
check( nf90_get_var(ncid, ncv, temp_s_conv) )
136 call
check( nf90_inq_varid(ncid,
'as_perp', ncv) )
137 call
check( nf90_get_var(ncid, ncv, as_perp_conv) )
139 call
check( nf90_inq_varid(ncid,
'maske', ncv) )
140 call
check( nf90_get_var(ncid, ncv, maske) )
142 call
check( nf90_inq_varid(ncid,
'n_cts', ncv) )
143 call
check( nf90_get_var(ncid, ncv, n_cts) )
145 call
check( nf90_inq_varid(ncid,
'zs', ncv) )
146 call
check( nf90_get_var(ncid, ncv, zs_conv) )
148 call
check( nf90_inq_varid(ncid,
'zm', ncv) )
149 call
check( nf90_get_var(ncid, ncv, zm_conv) )
151 call
check( nf90_inq_varid(ncid,
'zb', ncv) )
152 call
check( nf90_get_var(ncid, ncv, zb_conv) )
154 call
check( nf90_inq_varid(ncid,
'zl', ncv) )
155 call
check( nf90_get_var(ncid, ncv, zl_conv) )
157 call
check( nf90_inq_varid(ncid,
'H_c', ncv) )
158 call
check( nf90_get_var(ncid, ncv, h_c_conv) )
160 call
check( nf90_inq_varid(ncid,
'H_t', ncv) )
161 call
check( nf90_get_var(ncid, ncv, h_t_conv) )
163 call
check( nf90_inq_varid(ncid,
'H', ncv) )
164 call
check( nf90_get_var(ncid, ncv, h_conv) )
166 call
check( nf90_inq_varid(ncid,
'H_R', ncv) )
167 call
check( nf90_get_var(ncid, ncv, h_r_conv) )
169 call
check( nf90_inq_varid(ncid,
'vx_c', ncv) )
170 call
check( nf90_get_var(ncid, ncv, vx_c_conv) )
172 call
check( nf90_inq_varid(ncid,
'vy_c', ncv) )
173 call
check( nf90_get_var(ncid, ncv, vy_c_conv) )
175 call
check( nf90_inq_varid(ncid,
'vz_c', ncv) )
176 call
check( nf90_get_var(ncid, ncv, vz_c_conv) )
178 call
check( nf90_inq_varid(ncid,
'vx_t', ncv) )
179 call
check( nf90_get_var(ncid, ncv, vx_t_conv) )
181 call
check( nf90_inq_varid(ncid,
'vy_t', ncv) )
182 call
check( nf90_get_var(ncid, ncv, vy_t_conv) )
184 call
check( nf90_inq_varid(ncid,
'vz_t', ncv) )
185 call
check( nf90_get_var(ncid, ncv, vz_t_conv) )
187 call
check( nf90_inq_varid(ncid,
'temp_c', ncv) )
188 call
check( nf90_get_var(ncid, ncv, temp_c_conv) )
190 call
check( nf90_inq_varid(ncid,
'omega_t', ncv) )
191 call
check( nf90_get_var(ncid, ncv, omega_t_conv) )
193 call
check( nf90_inq_varid(ncid,
'temp_r', ncv) )
194 call
check( nf90_get_var(ncid, ncv, temp_r_conv) )
196 call
check( nf90_inq_varid(ncid,
'Q_bm', ncv) )
197 call
check( nf90_get_var(ncid, ncv, q_bm_conv) )
199 call
check( nf90_inq_varid(ncid,
'Q_tld', ncv) )
200 call
check( nf90_get_var(ncid, ncv, q_tld_conv) )
202 call
check( nf90_inq_varid(ncid,
'am_perp', ncv) )
203 call
check( nf90_get_var(ncid, ncv, am_perp_conv) )
205 call
check( nf90_inq_varid(ncid,
'qx', ncv) )
206 call
check( nf90_get_var(ncid, ncv, qx_conv) )
208 call
check( nf90_inq_varid(ncid,
'qy', ncv) )
209 call
check( nf90_get_var(ncid, ncv, qy_conv) )
211 call
check( nf90_inq_varid(ncid,
'age_c', ncv) )
212 call
check( nf90_get_var(ncid, ncv, age_c_conv) )
214 call
check( nf90_inq_varid(ncid,
'age_t', ncv) )
215 call
check( nf90_get_var(ncid, ncv, age_t_conv) )
217 call
check( nf90_inq_varid(ncid,
'dzs_dtau', ncv) )
218 call
check( nf90_get_var(ncid, ncv, dzs_dtau_conv) )
220 call
check( nf90_inq_varid(ncid,
'dzm_dtau', ncv) )
221 call
check( nf90_get_var(ncid, ncv, dzm_dtau_conv) )
223 call
check( nf90_inq_varid(ncid,
'dzb_dtau', ncv) )
224 call
check( nf90_get_var(ncid, ncv, dzb_dtau_conv) )
226 call
check( nf90_inq_varid(ncid,
'dzl_dtau', ncv) )
227 call
check( nf90_get_var(ncid, ncv, dzl_dtau_conv) )
229 call
check( nf90_inq_varid(ncid,
'dH_c_dtau', ncv) )
230 call
check( nf90_get_var(ncid, ncv, dh_c_dtau_conv) )
232 call
check( nf90_inq_varid(ncid,
'dH_t_dtau', ncv) )
233 call
check( nf90_get_var(ncid, ncv, dh_t_dtau_conv) )
235 call
check( nf90_inq_varid(ncid,
'dH_dtau', ncv) )
236 call
check( nf90_get_var(ncid, ncv, dh_dtau_conv) )
238 if ( nf90_inq_varid(ncid,
'vx_b_g', ncv) == nf90_noerr )
then
239 call
check( nf90_get_var(ncid, ncv, vx_b_g_conv) )
244 if ( nf90_inq_varid(ncid,
'vy_b_g', ncv) == nf90_noerr )
then
245 call
check( nf90_get_var(ncid, ncv, vy_b_g_conv) )
250 if ( nf90_inq_varid(ncid,
'vz_b', ncv) == nf90_noerr )
then
251 call
check( nf90_get_var(ncid, ncv, vz_b_conv) )
256 if ( nf90_inq_varid(ncid,
'vx_s_g', ncv) == nf90_noerr )
then
257 call
check( nf90_get_var(ncid, ncv, vx_s_g_conv) )
262 if ( nf90_inq_varid(ncid,
'vy_s_g', ncv) == nf90_noerr )
then
263 call
check( nf90_get_var(ncid, ncv, vy_s_g_conv) )
268 if ( nf90_inq_varid(ncid,
'vz_s', ncv) == nf90_noerr )
then
269 call
check( nf90_get_var(ncid, ncv, vz_s_conv) )
274 if ( nf90_inq_varid(ncid,
'temp_b', ncv) == nf90_noerr )
then
275 call
check( nf90_get_var(ncid, ncv, temp_b_conv) )
280 if ( nf90_inq_varid(ncid,
'temph_b', ncv) == nf90_noerr )
then
281 call
check( nf90_get_var(ncid, ncv, temph_b_conv) )
286 if ( nf90_inq_varid(ncid,
'p_b_w', ncv) == nf90_noerr )
then
287 call
check( nf90_get_var(ncid, ncv, p_b_w_conv) )
292 if ( nf90_inq_varid(ncid,
'H_w', ncv) == nf90_noerr )
then
293 call
check( nf90_get_var(ncid, ncv, h_w_conv) )
298 if ( nf90_inq_varid(ncid,
'q_gl_g', ncv) == nf90_noerr )
then
299 call
check( nf90_get_var(ncid, ncv, q_gl_g_conv) )
307 write(6,
'(/1x,a)')
'topography3_nc: End-of-file condition while reading *.nc.'
308 write(6,
'(1x,a)')
' Some variables will be undefined.'
312 call
check( nf90_close(ncid) )
316 z_sl =
real(z_sl_conv,dp)
318 h_r =
real(h_r_conv,dp)
323 xi(i) =
real(xi_conv(i),dp)
324 eta(j) =
real(eta_conv(j),dp)
325 zs(j,i) =
real(zs_conv(j,i),dp)
326 zm(j,i) =
real(zm_conv(j,i),dp)
327 zb(j,i) =
real(zb_conv(j,i),dp)
328 zl(j,i) =
real(zl_conv(j,i),dp)
329 h_c(j,i) =
real(H_c_conv(j,i),dp)
330 h_t(j,i) =
real(H_t_conv(j,i),dp)
331 q_bm(j,i) =
real(Q_bm_conv(j,i),dp)
332 q_tld(j,i) =
real(Q_tld_conv(j,i),dp)
333 am_perp(j,i) =
real(am_perp_conv(j,i),dp)
334 qx(j,i) =
real(qx_conv(j,i),dp)
335 qy(j,i) =
real(qy_conv(j,i),dp)
336 dzs_dtau(j,i) =
real(dzs_dtau_conv(j,i),dp)
337 dzm_dtau(j,i) =
real(dzm_dtau_conv(j,i),dp)
338 dzb_dtau(j,i) =
real(dzb_dtau_conv(j,i),dp)
339 dzl_dtau(j,i) =
real(dzl_dtau_conv(j,i),dp)
340 dh_c_dtau(j,i) =
real(dH_c_dtau_conv(j,i),dp)
341 dh_t_dtau(j,i) =
real(dH_t_dtau_conv(j,i),dp)
342 vx_b_g(j,i) =
real(vx_b_g_conv(j,i),dp)
343 vy_b_g(j,i) =
real(vy_b_g_conv(j,i),dp)
344 vz_b(j,i) =
real(vz_b_conv(j,i),dp)
345 vx_s_g(j,i) =
real(vx_s_g_conv(j,i),dp)
346 vy_s_g(j,i) =
real(vy_s_g_conv(j,i),dp)
347 vz_s(j,i) =
real(vz_s_conv(j,i),dp)
348 temp_b(j,i) =
real(temp_b_conv(j,i),dp)
349 temph_b(j,i) =
real(temph_b_conv(j,i),dp)
350 p_b_w(j,i) =
real(p_b_w_conv(j,i),dp)
351 h_w(j,i) =
real(H_w_conv(j,i),dp)
352 q_gl_g(j,i) =
real(q_gl_g_conv(j,i),dp)
355 temp_r(kr,j,i) =
real(temp_r_conv(kr,j,i),dp)
359 vx_t(kt,j,i) =
real(vx_t_conv(kt,j,i),dp)
360 vy_t(kt,j,i) =
real(vy_t_conv(kt,j,i),dp)
361 vz_t(kt,j,i) =
real(vz_t_conv(kt,j,i),dp)
362 omega_t(kt,j,i) =
real(omega_t_conv(kt,j,i),dp)
363 age_t(kt,j,i) =
real(age_t_conv(kt,j,i),dp)
367 vx_c(kc,j,i) =
real(vx_c_conv(kc,j,i),dp)
368 vy_c(kc,j,i) =
real(vy_c_conv(kc,j,i),dp)
369 vz_c(kc,j,i) =
real(vz_c_conv(kc,j,i),dp)
370 temp_c(kc,j,i) =
real(temp_c_conv(kc,j,i),dp)
371 age_c(kc,j,i) =
real(age_c_conv(kc,j,i),dp)
379 open(23, iostat=ios, &
380 file=inpath//
'/grl/'//zl0_file, &
381 recl=8192, status=
'old')
383 if (ios /= 0) stop
' topography3_nc: Error when opening the zl0 file!'
385 do n=1, 6;
read(23,
'(a)') ch_dummy;
end do
388 read(23,*) (zl0(j,i), i=0,imax)
391 close(23, status=
'keep')
400 call
geo_coord(phi(j,i), lambda(j,i), xi(i), eta(j))
418 area(j,i) = sq_g11_g(j,i)*sq_g22_g(j,i)*dxi*deta
425 !> NetCDF error capturing.
426 !<------------------------------------------------------------------------------
428 integer(i4b),
intent (in) :: status
429 if(status /= nf90_noerr)
then
430 write(6,
'(a)') trim(nf90_strerror(status))
431 stop
' topography3_nc: Stopped due to netcdf error!'