26 #if defined DEBUG || defined QUICKDEBUG
63 real(RP),
parameter :: sq = 21.0_rp**0.5
64 real(RP),
parameter :: RC41 = 1.0_rp/7.0_rp
65 real(RP),
parameter :: RC42 = (-7.0_rp+3.0_rp*sq)/98.0_rp
66 real(RP),
parameter :: RC43 = (21.0_rp-5.0_rp*sq)/49.0_rp
67 real(RP),
parameter :: RC51 = (11.0_rp-sq)/84.0_rp
68 real(RP),
parameter :: RC53 = (18.0_rp-4.0_rp*sq)/63.0_rp
69 real(RP),
parameter :: RC54 = (21.0_rp+sq)/252.0_rp
70 real(RP),
parameter :: RC61 = (5.0_rp-sq)/48.0_rp
71 real(RP),
parameter :: RC63 = (9.0_rp-sq)/36.0_rp
72 real(RP),
parameter :: RC64 = (-231.0_rp-14.0_rp*sq)/360.0_rp
73 real(RP),
parameter :: RC65 = (63.0_rp+7.0_rp*sq)/80.0_rp
74 real(RP),
parameter :: RC71 = (10.0_rp+sq)/42.0_rp
75 real(RP),
parameter :: RC73 = (-432.0_rp-92.0_rp*sq)/315.0_rp
76 real(RP),
parameter :: RC74 = (633.0_rp+145.0_rp*sq)/90.0_rp
77 real(RP),
parameter :: RC75 = (-504.0_rp-115.0_rp*sq)/70.0_rp
78 real(RP),
parameter :: RC76 = (63.0_rp+13.0_rp*sq)/35.0_rp
79 real(RP),
parameter :: RC81 = 1.0_rp/14.0_rp
80 real(RP),
parameter :: RC85 = (14.0_rp+3.0_rp*sq)/126.0_rp
81 real(RP),
parameter :: RC86 = (13.0_rp+3.0_rp*sq)/63.0_rp
82 real(RP),
parameter :: RC87 = 1.0_rp/9.0_rp
83 real(RP),
parameter :: RC91 = 1.0_rp/32.0_rp
84 real(RP),
parameter :: RC95 = (91.0_rp+21.0_rp*sq)/576.0_rp
85 real(RP),
parameter :: RC96 = 11.0_rp/72.0_rp
86 real(RP),
parameter :: RC97 = (-385.0_rp+75.0_rp*sq)/1152.0_rp
87 real(RP),
parameter :: RC98 = (63.0_rp-13.0_rp*sq)/128.0_rp
88 real(RP),
parameter :: RC101 = 1.0_rp/14.0_rp
89 real(RP),
parameter :: RC105 = 1.0_rp/9.0_rp
90 real(RP),
parameter :: RC106 = (-733.0_rp+147.0_rp*sq)/2205.0_rp
91 real(RP),
parameter :: RC107 = (515.0_rp-111.0_rp*sq)/504.0_rp
92 real(RP),
parameter :: RC108 = (-51.0_rp+11.0_rp*sq)/56.0_rp
93 real(RP),
parameter :: RC109 = (132.0_rp-28.0_rp*sq)/245.0_rp
94 real(RP),
parameter :: RC115 = (-42.0_rp-7.0_rp*sq)/18.0_rp
95 real(RP),
parameter :: RC116 = (-18.0_rp-28.0_rp*sq)/45.0_rp
96 real(RP),
parameter :: RC117 = (-273.0_rp+53.0_rp*sq)/72.0_rp
97 real(RP),
parameter :: RC118 = (301.0_rp-53.0_rp*sq)/72.0_rp
98 real(RP),
parameter :: RC119 = (28.0_rp+28.0_rp*sq)/45.0_rp
99 real(RP),
parameter :: RC1110 = (49.0_rp+7.0_rp*sq)/18.0_rp
100 real(RP),
parameter :: ZERO = 0.0_rp
103 (/ zero, 0.5_rp, 0.25_rp, rc41, rc51, rc61, rc71, rc81, rc91, rc101, zero, &
104 zero, zero, 0.25_rp, rc42, zero, zero, zero, zero, zero, zero, zero, &
105 zero, zero, zero, rc43, rc53, rc63, rc73, zero, zero, zero, zero, &
106 zero, zero, zero, zero, rc54, rc64, rc74, zero, zero, zero, zero, &
107 zero, zero, zero, zero, zero, rc65, rc75, rc85, rc95, rc105, rc115, &
108 zero, zero, zero, zero, zero, zero, rc76, rc86, rc96, rc106, rc116, &
109 zero, zero, zero, zero, zero, zero, zero, rc87, rc97, rc107, rc117, &
110 zero, zero, zero, zero, zero, zero, zero, zero, rc98, rc108, rc118, &
111 zero, zero, zero, zero, zero, zero, zero, zero, zero, rc109, rc119, &
112 zero, zero, zero, zero, zero, zero, zero, zero, zero, zero, rc1110, &
113 zero, zero, zero, zero, zero, zero, zero, zero, zero, zero, zero /), &
117 (/ 0.05_rp, zero, zero, zero, zero, zero, zero, 49.0_rp/180.0_rp, 16.0_rp/45.0_rp, &
118 49.0_rp/180.0_rp, 0.05_rp /)
128 integer,
private,
parameter :: rk_nstage = 11
129 integer,
private,
parameter :: rk_nregister = 11
131 type(
rkinfo),
private :: rk_dynvar
132 integer,
private,
parameter :: i_rk_dens = 1
133 integer,
private,
parameter :: i_rk_momz = 2
134 integer,
private,
parameter :: i_rk_momx = 3
135 integer,
private,
parameter :: i_rk_momy = 4
136 integer,
private,
parameter :: i_rk_rhot = 5
138 type(
rkinfo),
private :: rk_prgvar
140 type(
rkinfo),
private :: rk_mflx_hi
141 type(
rkinfo),
private :: rk_tflx_hi
157 character(len=*) :: tinteg_type
160 character(H_SHORT) :: dynvar_name_list(5)
161 character(H_SHORT) :: prgvar_name_list(
va)
162 character(H_SHORT) :: flux_name_list(3)
164 real(rp) :: rkcoef_a(rk_nstage,rk_nstage)
165 real(rp) :: rkcoef_b(rk_nstage)
169 select case( trim(tinteg_type) )
170 case (
'RK11s8o',
'RK11s8oCooperVerner1972')
174 log_error(
"ATMOS_DYN_Tinteg_short_rk11s8o_setup",*)
'The specified TINTEG_TYPE is invalid. Check!', tinteg_type
178 dynvar_name_list(1) =
'DENS'
179 dynvar_name_list(2) =
'MOMZ'
180 dynvar_name_list(3) =
'MOMX'
181 dynvar_name_list(4) =
'MOMY'
182 dynvar_name_list(5) =
'RHOT'
183 call rkcommon_setup( rk_dynvar, rk_nstage, rk_nregister, rkcoef_a, rkcoef_b, dynvar_name_list )
186 flux_name_list(iv) =
'PROG'
188 call rkcommon_setup( rk_prgvar, rk_nstage, rk_nregister, rkcoef_a, rkcoef_b,prgvar_name_list, comm_id_offset=5 )
191 flux_name_list(iv) =
'mflx_hi'
193 call rkcommon_setup( rk_mflx_hi, rk_nstage, rk_nregister, rkcoef_a, rkcoef_b, flux_name_list, is_type_flux=.true. )
197 flux_name_list(iv) =
'tflx_hi'
199 call rkcommon_setup( rk_tflx_hi, rk_nstage, rk_nregister, rkcoef_a, rkcoef_b, flux_name_list, is_type_flux=.true. )
209 DENS, MOMZ, MOMX, MOMY, RHOT, PROG, &
211 DENS_t, MOMZ_t, MOMX_t, MOMY_t, RHOT_t, &
212 DPRES0, CVtot, CORIOLI, &
213 num_diff, wdamp_coef, divdmp_coef, DDIV, &
214 FLAG_FCT_MOMENTUM, FLAG_FCT_T, &
215 FLAG_FCT_ALONG_STREAM, &
216 CDZ, FDZ, FDX, FDY, &
217 RCDZ, RCDX, RCDY, RFDZ, RFDX, RFDY, &
218 PHI, GSQRT, J13G, J23G, J33G, MAPF, &
219 REF_pres, REF_dens, &
220 BND_W, BND_E, BND_S, BND_N, TwoD, &
231 real(rp),
intent(inout) :: dens(
ka,
ia,
ja)
232 real(rp),
intent(inout) :: momz(
ka,
ia,
ja)
233 real(rp),
intent(inout) :: momx(
ka,
ia,
ja)
234 real(rp),
intent(inout) :: momy(
ka,
ia,
ja)
235 real(rp),
intent(inout) :: rhot(
ka,
ia,
ja)
236 real(rp),
intent(inout) :: prog(
ka,
ia,
ja,
va)
238 real(rp),
intent(inout) :: mflx_hi(
ka,
ia,
ja,3)
239 real(rp),
intent(out) :: tflx_hi(
ka,
ia,
ja,3)
241 real(rp),
intent(in) :: dens_t(
ka,
ia,
ja)
242 real(rp),
intent(in) :: momz_t(
ka,
ia,
ja)
243 real(rp),
intent(in) :: momx_t(
ka,
ia,
ja)
244 real(rp),
intent(in) :: momy_t(
ka,
ia,
ja)
245 real(rp),
intent(in) :: rhot_t(
ka,
ia,
ja)
247 real(rp),
intent(in) :: dpres0(
ka,
ia,
ja)
248 real(rp),
intent(in) :: cvtot(
ka,
ia,
ja)
249 real(rp),
intent(in) :: corioli(
ia,
ja)
250 real(rp),
intent(in) :: num_diff(
ka,
ia,
ja,5,3)
251 real(rp),
intent(in) :: wdamp_coef(
ka)
252 real(rp),
intent(in) :: divdmp_coef
253 real(rp),
intent(in) :: ddiv(
ka,
ia,
ja)
255 logical,
intent(in) :: flag_fct_momentum
256 logical,
intent(in) :: flag_fct_t
257 logical,
intent(in) :: flag_fct_along_stream
259 real(rp),
intent(in) :: cdz (
ka)
260 real(rp),
intent(in) :: fdz (
ka-1)
261 real(rp),
intent(in) :: fdx (
ia-1)
262 real(rp),
intent(in) :: fdy (
ja-1)
263 real(rp),
intent(in) :: rcdz(
ka)
264 real(rp),
intent(in) :: rcdx(
ia)
265 real(rp),
intent(in) :: rcdy(
ja)
266 real(rp),
intent(in) :: rfdz(
ka-1)
267 real(rp),
intent(in) :: rfdx(
ia-1)
268 real(rp),
intent(in) :: rfdy(
ja-1)
270 real(rp),
intent(in) :: phi (
ka,
ia,
ja)
271 real(rp),
intent(in) :: gsqrt(
ka,
ia,
ja,7)
272 real(rp),
intent(in) :: j13g (
ka,
ia,
ja,7)
273 real(rp),
intent(in) :: j23g (
ka,
ia,
ja,7)
274 real(rp),
intent(in) :: j33g
275 real(rp),
intent(in) :: mapf (
ia,
ja,2,4)
277 real(rp),
intent(in) :: ref_pres(
ka,
ia,
ja)
278 real(rp),
intent(in) :: ref_dens(
ka,
ia,
ja)
280 logical,
intent(in) :: bnd_w
281 logical,
intent(in) :: bnd_e
282 logical,
intent(in) :: bnd_s
283 logical,
intent(in) :: bnd_n
284 logical,
intent(in) :: twod
286 real(rp),
intent(in) :: dt
288 integer :: i, j,
k, iv, n, s
291 integer,
parameter :: ko_dynvar(5) = (/ 0, 1, 0, 0, 0 /)
292 integer,
parameter :: io_dynvar(5) = (/ 0, 0, 1, 0, 0 /)
293 integer,
parameter :: jo_dynvar(5) = (/ 0, 0, 0, 1, 0 /)
294 integer :: ko_prgvar(
va)
295 integer :: io_prgvar(
va)
296 integer :: jo_prgvar(
va)
302 call rkcommon_rkwork_alloc( rk_dynvar )
303 call rkcommon_rkwork_alloc( rk_prgvar )
306 rk_mflx_hi%buf( 1:
ks-1,:,:,:) = undef
307 rk_mflx_hi%buf(
ke+1:
ka ,:,:,:) = undef
314 rk_dynvar%work0(:,:,:,i_rk_dens) = dens(:,:,:)
316 rk_dynvar%work0(:,:,:,i_rk_momz) = momz(:,:,:)
318 rk_dynvar%work0(:,:,:,i_rk_momx) = momx(:,:,:)
320 rk_dynvar%work0(:,:,:,i_rk_momy) = momy(:,:,:)
322 rk_dynvar%work0(:,:,:,i_rk_rhot) = rhot(:,:,:)
324 rk_dynvar%buf(:,:,:,:) = rk_dynvar%work0(:,:,:,:)
330 rk_prgvar%work0(:,:,:,:) = prog
332 rk_prgvar%buf(:,:,:,:) = rk_prgvar%work0(:,:,:,:)
340 rk_mflx_hi%buf(
k,
is-1,j,2) = mflx_hi(
k,
is-1,j,2)
347 rk_mflx_hi%buf(
k,
ie,j,2) = mflx_hi(
k,
ie,j,2)
354 rk_mflx_hi%buf(
k,i,
js-1,3) = mflx_hi(
k,i,
js-1,3)
361 rk_mflx_hi%buf(
k,i,
je,3) = mflx_hi(
k,i,
je,3)
366 io_prgvar(:) = 0; jo_prgvar(:) = 0; ko_prgvar(:) = 0
374 do stage = 1, rk_nstage
379 rk_dynvar%buf(:,:,:,i_rk_momz), &
380 rk_dynvar%buf(:,:,:,i_rk_momx), &
381 rk_dynvar%buf(:,:,:,i_rk_momy), &
382 rk_dynvar%buf(:,:,:,i_rk_rhot), &
383 rk_prgvar%buf(:,:,:,: ), &
384 rk_dynvar%work0(:,:,:,i_rk_dens), &
385 rk_dynvar%work0(:,:,:,i_rk_momz), &
386 rk_dynvar%work0(:,:,:,i_rk_momx), &
387 rk_dynvar%work0(:,:,:,i_rk_momy), &
388 rk_dynvar%work0(:,:,:,i_rk_rhot), &
389 rk_prgvar%work0(:,:,:,:), &
390 bnd_w, bnd_e, bnd_s, bnd_n, twod )
393 call rkcommon_comm( rk_dynvar )
394 call rkcommon_comm( rk_prgvar )
395 call rkcommon_comm_wait( rk_dynvar )
396 call rkcommon_comm_wait( rk_prgvar )
402 call atmos_dyn_tstep( &
403 rk_dynvar%work(:,:,:,i_rk_dens,stage), &
404 rk_dynvar%work(:,:,:,i_rk_momz,stage), &
405 rk_dynvar%work(:,:,:,i_rk_momx,stage), &
406 rk_dynvar%work(:,:,:,i_rk_momy,stage), &
407 rk_dynvar%work(:,:,:,i_rk_rhot,stage), &
408 rk_prgvar%work(:,:,:,: ,stage), &
409 rk_mflx_hi%buf(:,:,:,:), rk_tflx_hi%buf(:,:,:,:), &
410 rk_dynvar%work0(:,:,:,i_rk_dens), &
411 rk_dynvar%work0(:,:,:,i_rk_momz), &
412 rk_dynvar%work0(:,:,:,i_rk_momx), &
413 rk_dynvar%work0(:,:,:,i_rk_momy), &
414 rk_dynvar%work0(:,:,:,i_rk_rhot), &
415 rk_dynvar%buf(:,:,:,i_rk_dens), &
416 rk_dynvar%buf(:,:,:,i_rk_momz), &
417 rk_dynvar%buf(:,:,:,i_rk_momx), &
418 rk_dynvar%buf(:,:,:,i_rk_momy), &
419 rk_dynvar%buf(:,:,:,i_rk_rhot), &
420 dens_t, momz_t, momx_t, momy_t, rhot_t, &
421 rk_prgvar%work0, rk_prgvar%buf(:,:,:,:), &
422 dpres0, cvtot, corioli, &
423 num_diff, wdamp_coef, divdmp_coef, ddiv, &
424 flag_fct_momentum, flag_fct_t, &
425 flag_fct_along_stream, &
426 cdz, fdz, fdx, fdy, &
427 rcdz, rcdx, rcdy, rfdz, rfdx, rfdy, &
428 phi, gsqrt, j13g, j23g, j33g, mapf, &
429 ref_pres, ref_dens, &
430 bnd_w, bnd_e, bnd_s, bnd_n, twod, &
433 if ( stage < rk_nstage)
then
434 call rkcommon_nextstage( rk_dynvar, stage, io_dynvar, jo_dynvar, ko_dynvar, dt )
435 call rkcommon_nextstage( rk_prgvar, stage, io_prgvar, jo_prgvar, ko_prgvar, dt )
437 call rkcommon_updatevar( rk_dynvar, io_dynvar, jo_dynvar, ko_dynvar, i_rk_dens, i_rk_dens, dt, dens )
438 call rkcommon_updatevar( rk_dynvar, io_dynvar, jo_dynvar, ko_dynvar, i_rk_momz, i_rk_momz, dt, momz )
439 call rkcommon_updatevar( rk_dynvar, io_dynvar, jo_dynvar, ko_dynvar, i_rk_momx, i_rk_momx, dt, momx )
440 call rkcommon_updatevar( rk_dynvar, io_dynvar, jo_dynvar, ko_dynvar, i_rk_momy, i_rk_momy, dt, momy )
441 call rkcommon_updatevar( rk_dynvar, io_dynvar, jo_dynvar, ko_dynvar, i_rk_rhot, i_rk_rhot, dt, rhot )
442 call rkcommon_updatevar( rk_prgvar, io_prgvar, jo_prgvar, ko_prgvar, 1,
va, dt, prog )
444 call rkcommon_updateflux( rk_mflx_hi, stage, 0, 0, 0, 3, mflx_hi )
445 call rkcommon_updateflux( rk_tflx_hi, stage, 0, 0, 0, 3, tflx_hi )
450 call rkcommon_rkwork_dealloc( rk_dynvar )
451 call rkcommon_rkwork_dealloc( rk_prgvar )