module_check.F
References to this file elsewhere.
1 !WRF:MODEL_LAYER:DYNAMICS
2 !
3
4 MODULE module_check
5
6 USE g_module_advect_em
7 USE a_module_advect_em
8 USE g_module_em
9 USE a_module_em
10 USE g_module_big_step_utilities_em
11 USE a_module_big_step_utilities_em
12 USE g_module_small_step_em
13 USE a_module_small_step_em
14 USE g_module_diffusion_em
15 USE a_module_diffusion_em
16 USE g_module_bc_em
17 USE a_module_bc_em
18 USE module_configure
19
20
21 CONTAINS
22
23 !------------------------------------------------------------------------
24
25 SUBROUTINE t_advect_scalar ( field, field_old, tendency, ru, rv, rom, &
26 mut, config_flags, &
27 msfu, msfv, msft, fzm, fzp, &
28 rdx, rdy, rdzw, &
29 ids, ide, jds, jde, kds, kde, &
30 ims, ime, jms, jme, kms, kme, &
31 its, ite, jts, jte, kts, kte )
32
33 ! Input variables: field, field_old, tendency, ru, rv, rom, mut
34 ! Output variable: tendency
35 ! Contants: All others
36 ! Qingnong Xiao, January 25, 2005
37
38 IMPLICIT NONE
39
40 ! Input data
41
42 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
43
44 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
45 ims, ime, jms, jme, kms, kme, &
46 its, ite, jts, jte, kts, kte
47
48 REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) :: field, &
49 field_old, &
50 ru, &
51 rv, &
52 rom
53
54 REAL , DIMENSION( ims:ime , jms:jme ) :: mut
55 REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) :: tendency
56
57 REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msfu, &
58 msfv, &
59 msft
60
61 REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fzm, &
62 fzp, &
63 rdzw
64
65 REAL , INTENT(IN ) :: rdx, &
66 rdy
67
68 ! Local data
69
70 INTEGER :: i, j, k, itf, jtf, ktf
71 INTEGER :: i_start, i_end, j_start, j_end
72 INTEGER :: i_start_f, i_end_f, j_start_f, j_end_f
73 INTEGER :: jmin, jmax, jp, jm, imin, imax
74
75 REAL :: mrdx, mrdy, ub, vb, uw, vw
76 REAL , DIMENSION(its:ite, kts:kte) :: vflux
77
78 REAL, DIMENSION( its:ite+1, kts:kte ) :: fqx
79 REAL, DIMENSION( its:ite, kts:kte, 2 ) :: fqy
80
81 INTEGER :: horz_order, vert_order
82
83 LOGICAL :: degrade_xs, degrade_ys
84 LOGICAL :: degrade_xe, degrade_ye
85
86 INTEGER :: jp1, jp0, jtmp
87
88
89 ! definition of flux operators, 3rd, 4rth, 5th or 6th order
90
91 REAL :: flux3, flux4, flux5, flux6
92 REAL :: q_im3, q_im2, q_im1, q_i, q_ip1, q_ip2, ua, vel
93 LOGICAL :: specified ! changed by Thomas Nehrkorn, AER
94
95 ! Xiao: new definition
96
97 REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) :: S_field, &
98 S_field_old, &
99 S_ru, &
100 S_rv, &
101 S_rom
102 REAL , DIMENSION( ims:ime , jms:jme ) :: S_mut
103 REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) :: S_tendency
104 REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) :: P_field, &
105 P_field_old, &
106 P_ru, &
107 P_rv, &
108 P_rom
109 REAL , DIMENSION( ims:ime , jms:jme ) :: P_mut
110 REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) :: P_tendency
111 REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) :: B_field, &
112 B_field_old, &
113 B_ru, &
114 B_rv, &
115 B_rom
116 REAL , DIMENSION( ims:ime , jms:jme ) :: B_mut
117 REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) :: B_tendency
118 REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) :: K_tendency
119 REAL :: SAVE_L, COEF, ALPHA, FACTOR, VAL_N, VAL_L, VAL_A
120 INTEGER :: NT
121
122 ! Xiao: new definition end
123
124 ! TGL test
125
126 S_field(:,:,:)=field(:,:,:)
127 S_field_old(:,:,:)=field_old(:,:,:)
128 S_ru(:,:,:)=ru(:,:,:)
129 S_rv(:,:,:)=rv(:,:,:)
130 S_rom(:,:,:)=rom(:,:,:)
131 S_mut(:,:)=mut(:,:)
132 S_tendency(:,:,:)=tendency(:,:,:)
133 K_tendency(:,:,:)=tendency(:,:,:)
134
135 P_field(:,:,:)=field(:,:,:)
136 P_field_old(:,:,:)=field_old(:,:,:)
137 P_ru(:,:,:)=ru(:,:,:)
138 P_rv(:,:,:)=rv(:,:,:)
139 P_rom(:,:,:)=rom(:,:,:)
140 P_mut(:,:)=mut(:,:)
141 P_tendency(:,:,:)=tendency(:,:,:)
142
143 ! NLM
144
145 CALL advect_scalar ( field, field_old, tendency, &
146 ru, rv, rom, &
147 mut, config_flags, &
148 msfu, msfv, msft, &
149 fzm, fzp, &
150 rdx, rdy, rdzw, &
151 ids, ide, jds, jde, kds, kde, &
152 ims, ime, jms, jme, kms, kme, &
153 its, ite, jts, jte, kts, kte )
154
155 B_tendency(:,:,:)=tendency(:,:,:)
156
157 ! TGL
158
159 CALL g_advect_scalar (field, P_field, field_old, P_field_old, K_tendency, P_tendency, &
160 ru, P_ru, rv, P_rv, rom, P_rom, &
161 config_flags, &
162 msft, &
163 fzm, fzp, &
164 rdx, rdy, rdzw, &
165 ids, ide, jds, jde, kde, &
166 ims, ime, jms, jme, kms, kme, &
167 its, ite, jts, jte, kts, kte )
168
169 SAVE_L=sum(P_tendency(:,:,:)*P_tendency(:,:,:))
170
171 ALPHA=1.
172 DO NT=1,11
173 ALPHA=0.1*ALPHA
174 FACTOR=1.+ALPHA
175 P_field(:,:,:)=FACTOR*S_field(:,:,:)
176 P_field_old(:,:,:)=FACTOR*S_field_old(:,:,:)
177 P_ru(:,:,:)=FACTOR*S_ru(:,:,:)
178 P_rv(:,:,:)=FACTOR*S_rv(:,:,:)
179 P_rom(:,:,:)=FACTOR*S_rom(:,:,:)
180 P_mut(:,:)=FACTOR*S_mut(:,:)
181 P_tendency(:,:,:)=FACTOR*S_tendency(:,:,:)
182 CALL advect_scalar ( P_field, P_field_old, P_tendency, &
183 P_ru, P_rv, P_rom, &
184 P_mut, config_flags, &
185 msfu, msfv, msft, &
186 fzm, fzp, &
187 rdx, rdy, rdzw, &
188 ids, ide, jds, jde, kds, kde, &
189 ims, ime, jms, jme, kms, kme, &
190 its, ite, jts, jte, kts, kte )
191 VAL_N=sum((P_tendency(:,:,:)-B_tendency(:,:,:))* &
192 (P_tendency(:,:,:)-B_tendency(:,:,:)))
193 VAL_L=SAVE_L*ALPHA**2
194 COEF=VAL_N/VAL_L
195
196 WRITE(6, fmt='(A,E9.4,A,E22.13,A,E13.6,A,E13.6)') &
197 'g_advect_scalar: ALPHA=',ALPHA,' COEF=',COEF, &
198 ' VAL_N=',VAL_N,' VAL_L=',VAL_L
199 ENDDO
200
201 ! ADJ test
202
203 FACTOR=0.1
204 field(:,:,:)=S_field(:,:,:)
205 field_old(:,:,:)=S_field_old(:,:,:)
206 ru(:,:,:)=S_ru(:,:,:)
207 rv(:,:,:)=S_rv(:,:,:)
208 rom(:,:,:)=S_rom(:,:,:)
209 mut(:,:)=S_mut(:,:)
210 tendency(:,:,:)=S_tendency(:,:,:)
211
212 P_field(:,:,:)=FACTOR*S_field(:,:,:)
213 P_field_old(:,:,:)=FACTOR*S_field_old(:,:,:)
214 P_ru(:,:,:)=FACTOR*S_ru(:,:,:)
215 P_rv(:,:,:)=FACTOR*S_rv(:,:,:)
216 P_rom(:,:,:)=FACTOR*S_rom(:,:,:)
217 P_mut(:,:)=FACTOR*S_mut(:,:)
218 P_tendency(:,:,:)=FACTOR*S_tendency(:,:,:)
219
220 B_field(:,:,:)=P_field(:,:,:)
221 B_field_old(:,:,:)=P_field_old(:,:,:)
222 B_ru(:,:,:)=P_ru(:,:,:)
223 B_rv(:,:,:)=P_rv(:,:,:)
224 B_rom(:,:,:)=P_rom(:,:,:)
225 B_mut(:,:)=P_mut(:,:)
226 B_tendency(:,:,:)=P_tendency(:,:,:)
227
228 ! TGL
229
230 call g_advect_scalar (field, P_field, field_old, P_field_old, tendency, P_tendency, &
231 ru, P_ru, rv, P_rv, rom, P_rom, &
232 config_flags, &
233 msft, &
234 fzm, fzp, &
235 rdx, rdy, rdzw, &
236 ids, ide, jds, jde, kde, &
237 ims, ime, jms, jme, kms, kme, &
238 its, ite, jts, jte, kts, kte )
239
240 VAL_L=sum(P_tendency(:,:,:)*P_tendency(:,:,:))
241
242 P_field(:,:,:)=0.
243 P_field_old(:,:,:)=0.
244 P_ru(:,:,:)=0.
245 P_rv(:,:,:)=0.
246 P_rom(:,:,:)=0.
247 P_mut(:,:)=0.
248
249 ! ADJ
250
251 call a_advect_scalar (field, P_field, field_old, P_field_old, P_tendency, &
252 ru, P_ru, rv, P_rv, rom, P_rom, &
253 config_flags, &
254 msft, &
255 fzm, fzp, &
256 rdx, rdy, rdzw, &
257 ids, ide, jds, jde, kde, &
258 ims, ime, jms, jme, kms, kme, &
259 its, ite, jts, jte, kts, kte )
260 VAL_A=sum(P_field(:,:,:)*B_field(:,:,:)) + &
261 sum(P_field_old(:,:,:)*B_field_old(:,:,:))+ &
262 sum(P_tendency(:,:,:)*B_tendency(:,:,:)) + &
263 sum(P_ru(:,:,:)*B_ru(:,:,:)) + &
264 sum(P_rv(:,:,:)*B_rv(:,:,:))+ &
265 sum(P_rom(:,:,:)*B_rom(:,:,:))
266
267 write(6,fmt='(A,2E22.13)') 'a_advect_scalar: ', VAL_L,VAL_A
268
269 ! RECOVER
270
271 field(:,:,:)=S_field(:,:,:)
272 field_old(:,:,:)=S_field_old(:,:,:)
273 ru(:,:,:)=S_ru(:,:,:)
274 rv(:,:,:)=S_rv(:,:,:)
275 rom(:,:,:)=S_rom(:,:,:)
276 mut(:,:)=S_mut(:,:)
277 tendency(:,:,:)=S_tendency(:,:,:)
278
279 END SUBROUTINE t_advect_scalar
280
281 !===================================================================================!
282
283 SUBROUTINE t_rk_tendency ( config_flags, rk_step, &
284 ru_tend, rv_tend, rw_tend, ph_tend, t_tend, &
285 ru_tendf, rv_tendf, rw_tendf, ph_tendf, t_tendf, &
286 mu_tend, u_save, v_save, w_save, ph_save, &
287 t_save, mu_save, RTHFTEN, &
288 ru, rv, rw, ww, &
289 u, v, w, t, ph, &
290 u_old, v_old, w_old, t_old, ph_old, &
291 h_diabatic, phb,t_init, &
292 mu, mut, muu, muv, mub, &
293 al, alt, p, pb, php, cqu, cqv, cqw, &
294 u_base, v_base, t_base, qv_base, z_base, &
295 msfu, msfv, msft, f, e, sina, cosa, &
296 fnm, fnp, rdn, rdnw, &
297 dt, rdx, rdy, khdif, kvdif, xkmhd, &
298 diff_6th_opt, diff_6th_rate, &
299 dampcoef,zdamp,damp_opt, &
300 cf1, cf2, cf3, cfn, cfn1, n_moist, &
301 non_hydrostatic, &
302 ids, ide, jds, jde, kds, kde, &
303 ims, ime, jms, jme, kms, kme, &
304 its, ite, jts, jte, kts, kte )
305
306
307 ! Input variables : ru,rv,rw,ww,u,v,w,t,ph,u_old,v_old,w_old,t_old,ph_old
308 ! : phb,al,alt,p,pb,php,cqu,cqv,t_init,xkmhd, h_diabatic
309
310 ! Output variables: ru_tend, rv_tend, rw_tend, t_tend, ph_tend, RTHFTEN
311 ! : u_save, v_save, w_save, ph_save, t_save
312 ! : mu_tend, mu_save
313
314 ! InOut variables : ru_tendf, rv_tendf, rw_tendf, t_tendf, ph_tendf, cqw
315
316 ! Contants : All others
317
318
319
320 ! Input variables : ru,rv,rw,ww,u,v,w,t,ph,u_old,v_old,w_old,t_old,ph_old
321 ! : al,alt,p,php,cqu,cqv,xkmhd
322 ! : mu,mut,muu,muv,
323
324 ! Output variables: ru_tend, rv_tend, rw_tend, t_tend, ph_tend
325 ! : u_save, v_save, w_save, ph_save, t_save
326 ! : mu_tend
327
328 ! InOut variables : ru_tendf, rv_tendf, rw_tendf, t_tendf, cqw
329
330
331
332
333 ! Zaizhong Ma, March 18,2005
334
335 IMPLICIT NONE
336
337 ! Input data.
338
339 TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags
340
341 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
342 ims, ime, jms, jme, kms, kme, &
343 its, ite, jts, jte, kts, kte
344
345 LOGICAL , INTENT(IN ) :: non_hydrostatic
346
347 INTEGER , INTENT(IN ) :: n_moist, rk_step
348
349 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: ru, &
350 rv, &
351 rw, &
352 ww, &
353 u, &
354 v, &
355 w, &
356 t, &
357 ph, &
358 u_old, &
359 v_old, &
360 w_old, &
361 t_old, &
362 ph_old, &
363 phb, &
364 al, &
365 alt, &
366 p, &
367 pb, &
368 php, &
369 cqu, &
370 cqv, &
371 t_init, &
372 xkmhd, &
373 h_diabatic
374
375 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , &
376 INTENT(OUT ) :: ru_tend, &
377 rv_tend, &
378 rw_tend, &
379 t_tend, &
380 ph_tend, &
381 RTHFTEN, &
382 u_save, &
383 v_save, &
384 w_save, &
385 ph_save, &
386 t_save
387
388 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: ru_tendf, &
389 rv_tendf, &
390 rw_tendf, &
391 t_tendf, &
392 ph_tendf, &
393 cqw
394
395 REAL , DIMENSION( ims:ime , jms:jme ) , INTENT( OUT) :: mu_tend, &
396 mu_save
397
398 REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msfu, &
399 msfv, &
400 msft, &
401 f, &
402 e, &
403 sina, &
404 cosa, &
405 mub
406 REAL , DIMENSION( ims:ime , jms:jme ) :: mu, &
407 mut, &
408 muu, &
409 muv
410
411 REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnm, &
412 fnp, &
413 rdn, &
414 rdnw, &
415 u_base, &
416 v_base, &
417 t_base, &
418 qv_base, &
419 z_base
420
421 REAL , INTENT(IN ) :: rdx, &
422 rdy, &
423 dt, &
424 khdif, &
425 kvdif
426 INTEGER, INTENT( IN ) :: diff_6th_opt
427 REAL, INTENT( IN ) :: diff_6th_rate
428
429 INTEGER, INTENT( IN ) :: damp_opt
430
431 REAL, INTENT( IN ) :: zdamp, dampcoef
432
433 REAL :: kdift, khdq, kvdq, cfn, cfn1, cf1, cf2, cf3
434 INTEGER :: i,j,k
435
436 ! zzma: new definition
437
438 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: S_ru, &
439 S_rv, &
440 S_rw, &
441 S_ww, &
442 S_u, &
443 S_v, &
444 S_w, &
445 S_t, &
446 S_ph, &
447 S_u_old, &
448 S_v_old, &
449 S_w_old, &
450 S_t_old, &
451 S_ph_old, &
452 S_al, &
453 S_alt, &
454 S_p, &
455 S_php, &
456 S_cqu, &
457 S_cqv, &
458 S_xkmhd
459 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: P_ru, &
460 P_rv, &
461 P_rw, &
462 P_ww, &
463 P_u, &
464 P_v, &
465 P_w, &
466 P_t, &
467 P_ph, &
468 P_u_old, &
469 P_v_old, &
470 P_w_old, &
471 P_t_old, &
472 P_ph_old, &
473 P_al, &
474 P_alt, &
475 P_p, &
476 P_php, &
477 P_cqu, &
478 P_cqv, &
479 P_xkmhd
480 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: B_ru, &
481 B_rv, &
482 B_rw, &
483 B_ww, &
484 B_u, &
485 B_v, &
486 B_w, &
487 B_t, &
488 B_ph, &
489 B_u_old, &
490 B_v_old, &
491 B_w_old, &
492 B_t_old, &
493 B_ph_old, &
494 B_al, &
495 B_alt, &
496 B_p, &
497 B_php, &
498 B_cqu, &
499 B_cqv, &
500 B_xkmhd
501
502 REAL , DIMENSION( ims:ime , jms:jme ) :: S_mu, &
503 S_mut, &
504 S_muu, &
505 S_muv
506 REAL , DIMENSION( ims:ime , jms:jme ) :: P_mu, &
507 P_mut, &
508 P_muu, &
509 P_muv
510 REAL , DIMENSION( ims:ime , jms:jme ) :: B_mu, &
511 B_mut, &
512 B_muu, &
513 B_muv
514 ! INOUT varibales
515
516 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: S_ru_tendf, &
517 S_rv_tendf, &
518 S_rw_tendf, &
519 S_t_tendf, &
520 S_cqw
521 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: P_ru_tendf, &
522 P_rv_tendf, &
523 P_rw_tendf, &
524 P_t_tendf, &
525 P_cqw
526
527 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: K_ru_tendf, &
528 K_rv_tendf, &
529 K_rw_tendf, &
530 K_t_tendf, &
531 K_cqw
532
533 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: B_ru_tendf, &
534 B_rv_tendf, &
535 B_rw_tendf, &
536 B_t_tendf, &
537 B_cqw
538
539 ! OUT varibales
540
541 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: P_ru_tend, &
542 P_rv_tend, &
543 P_rw_tend, &
544 P_t_tend, &
545 P_ph_tend, &
546 P_u_save, &
547 P_v_save, &
548 P_w_save, &
549 P_ph_save, &
550 P_t_save
551 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: B_ru_tend, &
552 B_rv_tend, &
553 B_rw_tend, &
554 B_t_tend, &
555 B_ph_tend, &
556 B_u_save, &
557 B_v_save, &
558 B_w_save, &
559 B_ph_save, &
560 B_t_save
561 REAL , DIMENSION( ims:ime , jms:jme ) :: P_mu_tend
562 REAL , DIMENSION( ims:ime , jms:jme ) :: B_mu_tend
563
564
565 REAL :: SAVE_L, COEF, ALPHA, FACTOR, VAL_N, VAL_L, VAL_A
566 INTEGER :: NT
567
568 ! zzma: new definition end
569
570 !TGL test
571
572 do i=ims,ime
573 do k=kms,kme
574 do j=jms,jme
575 S_ru(i,k,j)=ru(i,k,j)
576 S_rv(i,k,j)=rv(i,k,j)
577 S_rw(i,k,j)=rw(i,k,j)
578 S_ww(i,k,j)=ww(i,k,j)
579 S_u(i,k,j)=u(i,k,j)
580 S_v(i,k,j)=v(i,k,j)
581 S_w(i,k,j)=w(i,k,j)
582 S_t(i,k,j)=t(i,k,j)
583 S_ph(i,k,j)=ph(i,k,j)
584 S_u_old(i,k,j)=u_old(i,k,j)
585 S_v_old(i,k,j)=v_old(i,k,j)
586 S_w_old(i,k,j)=w_old(i,k,j)
587 S_t_old(i,k,j)=t_old(i,k,j)
588 S_ph_old(i,k,j)=ph_old(i,k,j)
589 S_al(i,k,j)=al(i,k,j)
590 S_alt(i,k,j)=alt(i,k,j)
591 S_p(i,k,j)=p(i,k,j)
592 S_php(i,k,j)=php(i,k,j)
593 S_cqu(i,k,j)=cqu(i,k,j)
594 S_cqv(i,k,j)=cqv(i,k,j)
595 S_xkmhd(i,k,j)=xkmhd(i,k,j)
596
597 P_ru(i,k,j)=ru(i,k,j)
598 P_rv(i,k,j)=rv(i,k,j)
599 P_rw(i,k,j)=rw(i,k,j)
600 P_ww(i,k,j)=ww(i,k,j)
601 P_u(i,k,j)=u(i,k,j)
602 P_v(i,k,j)=v(i,k,j)
603 P_w(i,k,j)=w(i,k,j)
604 P_t(i,k,j)=t(i,k,j)
605 P_ph(i,k,j)=ph(i,k,j)
606 P_u_old(i,k,j)=u_old(i,k,j)
607 P_v_old(i,k,j)=v_old(i,k,j)
608 P_w_old(i,k,j)=w_old(i,k,j)
609 P_t_old(i,k,j)=t_old(i,k,j)
610 P_ph_old(i,k,j)=ph_old(i,k,j)
611 P_al(i,k,j)=al(i,k,j)
612 P_alt(i,k,j)=alt(i,k,j)
613 P_p(i,k,j)=p(i,k,j)
614 P_php(i,k,j)=php(i,k,j)
615 P_cqu(i,k,j)=cqu(i,k,j)
616 P_cqv(i,k,j)=cqv(i,k,j)
617 P_xkmhd(i,k,j)=xkmhd(i,k,j)
618 enddo
619 enddo
620 enddo
621
622 do i=ims,ime
623 do k=kms,kme
624 do j=jms,jme
625 S_ru_tendf(i,k,j)=ru_tendf(i,k,j)
626 S_rv_tendf(i,k,j)=rv_tendf(i,k,j)
627 S_rw_tendf(i,k,j)=rw_tendf(i,k,j)
628 S_t_tendf(i,k,j)=t_tendf(i,k,j)
629 S_cqw(i,k,j)=cqw(i,k,j)
630
631 P_ru_tendf(i,k,j)=ru_tendf(i,k,j)
632 P_rv_tendf(i,k,j)=rv_tendf(i,k,j)
633 P_rw_tendf(i,k,j)=rw_tendf(i,k,j)
634 P_t_tendf(i,k,j)=t_tendf(i,k,j)
635 P_cqw(i,k,j)=cqw(i,k,j)
636
637 K_ru_tendf(i,k,j)=ru_tendf(i,k,j)
638 K_rv_tendf(i,k,j)=rv_tendf(i,k,j)
639 K_rw_tendf(i,k,j)=rw_tendf(i,k,j)
640 K_t_tendf(i,k,j)=t_tendf(i,k,j)
641 K_cqw(i,k,j)=cqw(i,k,j)
642
643 enddo
644 enddo
645 enddo
646
647 do i=ims,ime
648 do j=jms,jme
649 S_mu(i,j)=mu(i,j)
650 S_mut(i,j)=mut(i,j)
651 S_muu(i,j)=muu(i,j)
652 S_muv(i,j)=muv(i,j)
653
654 P_mu(i,j)=mu(i,j)
655 P_mut(i,j)=mut(i,j)
656 P_muu(i,j)=muu(i,j)
657 P_muv(i,j)=muv(i,j)
658 enddo
659 enddo
660
661
662 !NLM
663
664 CALL rk_tendency ( config_flags, rk_step, &
665 ru_tend, rv_tend, rw_tend, ph_tend, t_tend, &
666 ru_tendf, rv_tendf, rw_tendf, ph_tendf, t_tendf, &
667 mu_tend, u_save, v_save, w_save, ph_save, &
668 t_save, mu_save, RTHFTEN, &
669 ru, rv, rw, ww, &
670 u, v, w, t, ph, &
671 u_old, v_old, w_old, t_old, ph_old, &
672 h_diabatic, phb,t_init, &
673 mu, mut, muu, muv, mub, &
674 al, alt, p, pb, php, cqu, cqv, cqw, &
675 u_base, v_base, t_base, qv_base, z_base, &
676 msfu, msfv, msft, f, e, sina, cosa, &
677 fnm, fnp, rdn, rdnw, &
678 dt, rdx, rdy, khdif, kvdif, xkmhd, &
679 diff_6th_opt, diff_6th_rate, &
680 dampcoef,zdamp,damp_opt, &
681 cf1, cf2, cf3, cfn, cfn1, n_moist, &
682 non_hydrostatic, &
683 ids, ide, jds, jde, kds, kde, &
684 ims, ime, jms, jme, kms, kme, &
685 its, ite, jts, jte, kts, kte )
686
687 do i=ims,ime
688 do k=kms,kme
689 do j=jms,jme
690 B_ru_tend(i,k,j)=ru_tend(i,k,j)
691 B_rv_tend(i,k,j)=rv_tend(i,k,j)
692 B_rw_tend(i,k,j)=rw_tend(i,k,j)
693 B_t_tend(i,k,j)=t_tend(i,k,j)
694 B_ph_tend(i,k,j)=ph_tend(i,k,j)
695 B_u_save(i,k,j)=u_save(i,k,j)
696 B_v_save(i,k,j)=v_save(i,k,j)
697 B_w_save(i,k,j)=w_save(i,k,j)
698 B_ph_save(i,k,j)=ph_save(i,k,j)
699 B_t_save(i,k,j)=t_save(i,k,j)
700 enddo
701 enddo
702 enddo
703
704 do i=ims,ime
705 do k=kms,kme
706 do j=jms,jme
707 B_ru_tendf(i,k,j)=ru_tendf(i,k,j)
708 B_rv_tendf(i,k,j)=rv_tendf(i,k,j)
709 B_rw_tendf(i,k,j)=rw_tendf(i,k,j)
710 B_t_tendf(i,k,j)=t_tendf(i,k,j)
711 B_cqw(i,k,j)=cqw(i,k,j)
712 enddo
713 enddo
714 enddo
715
716 do i=ims,ime
717 do j=jms,jme
718 B_mu_tend(i,j)=mu_tend(i,j)
719 enddo
720 enddo
721
722
723 ! TCL
724
725 CALL g_rk_tendency( config_flags, rk_step, ru_tend, P_ru_tend, rv_tend, P_rv_tend, rw_tend, P_rw_tend, ph_tend, P_ph_tend, &
726 &t_tend, P_t_tend, K_ru_tendf, P_ru_tendf, K_rv_tendf, P_rv_tendf, K_rw_tendf, P_rw_tendf, K_t_tendf, P_t_tendf, mu_tend, P_mu_tend, &
727 &u_save, P_u_save, v_save, P_v_save, w_save, P_w_save, ph_save, P_ph_save, t_save, P_t_save, ru, P_ru, rv, P_rv, rw, P_rw, ww, &
728 &P_ww, u, P_u, v, P_v, w, P_w, t, P_t, ph, P_ph, u_old, P_u_old, v_old, P_v_old, w_old, P_w_old, t_old, P_t_old, ph_old, P_ph_old, &
729 &phb, t_init, mu, P_mu, mut, P_mut, muu, P_muu, muv, P_muv, mub, al, P_al, alt, P_alt, p, P_p, pb, php, P_php, cqu, P_cqu, cqv, &
730 &P_cqv, K_cqw, P_cqw, u_base, v_base, z_base, msfu, msfv, msft, f, e, sina, cosa, fnm, fnp, rdn, rdnw, dt, rdx, rdy, kvdif, xkmhd, &
731 &P_xkmhd, &
732 dampcoef,zdamp,damp_opt, &
733 cf1, cf2, cf3, cfn, cfn1, non_hydrostatic, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, &
734 &jts, jte, kts, kte )
735
736 SAVE_L=0.
737 do i=ims,ime
738 do k=kms,kme
739 do j=jms,jme
740 SAVE_L=SAVE_L + P_ru_tend(i,k,j)*P_ru_tend(i,k,j) &
741 + P_rv_tend(i,k,j)*P_rv_tend(i,k,j) &
742 + P_rw_tend(i,k,j)*P_rw_tend(i,k,j) &
743 + P_t_tend(i,k,j)*P_t_tend(i,k,j) &
744 + P_ph_tend(i,k,j)*P_ph_tend(i,k,j) &
745 + P_u_save(i,k,j)*P_u_save(i,k,j) &
746 + P_v_save(i,k,j)*P_v_save(i,k,j) &
747 + P_w_save(i,k,j)*P_w_save(i,k,j) &
748 + P_ph_save(i,k,j)*P_ph_save(i,k,j) &
749 + P_t_save(i,k,j)*P_t_save(i,k,j)
750 enddo
751 enddo
752 enddo
753 do i=ims,ime
754 do k=kms,kme
755 do j=jms,jme
756 SAVE_L=SAVE_L + P_ru_tendf(i,k,j) *P_ru_tendf(i,k,j) &
757 + P_rv_tendf(i,k,j) *P_rv_tendf(i,k,j) &
758 + P_rw_tendf(i,k,j) *P_rw_tendf(i,k,j) &
759 + P_t_tendf(i,k,j) *P_t_tendf(i,k,j) &
760 + P_cqw(i,k,j) *P_cqw(i,k,j)
761 enddo
762 enddo
763 enddo
764 do i=ims,ime
765 do j=jms,jme
766 SAVE_L=SAVE_L + P_mu_tend(i,j) *P_mu_tend(i,j)
767 enddo
768 enddo
769
770 ALPHA=1.
771 DO NT=1,11
772 ALPHA=0.1*ALPHA
773 FACTOR=1.+ALPHA
774 do i=ims,ime
775 do k=kms,kme
776 do j=jms,jme
777 P_ru(i,k,j)=FACTOR*S_ru(i,k,j)
778 P_rv(i,k,j)=FACTOR*S_rv(i,k,j)
779 P_rw(i,k,j)=FACTOR*S_rw(i,k,j)
780 P_ww(i,k,j)=FACTOR*S_ww(i,k,j)
781 P_u(i,k,j)=FACTOR*S_u(i,k,j)
782 P_v(i,k,j)=FACTOR*S_v(i,k,j)
783 P_w(i,k,j)=FACTOR*S_w(i,k,j)
784 P_t(i,k,j)=FACTOR*S_t(i,k,j)
785 P_ph(i,k,j)=FACTOR*S_ph(i,k,j)
786 P_u_old(i,k,j)=FACTOR*S_u_old(i,k,j)
787 P_v_old(i,k,j)=FACTOR*S_v_old(i,k,j)
788 P_w_old(i,k,j)=FACTOR*S_w_old(i,k,j)
789 P_t_old(i,k,j)=FACTOR*S_t_old(i,k,j)
790 P_ph_old(i,k,j)=FACTOR*S_ph_old(i,k,j)
791 P_al(i,k,j)=FACTOR*S_al(i,k,j)
792 P_alt(i,k,j)=FACTOR*S_alt(i,k,j)
793 P_p(i,k,j)=FACTOR*S_p(i,k,j)
794 P_php(i,k,j)=FACTOR*S_php(i,k,j)
795 P_cqu(i,k,j)=FACTOR*S_cqu(i,k,j)
796 P_cqv(i,k,j)=FACTOR*S_cqv(i,k,j)
797 P_xkmhd(i,k,j)=FACTOR*S_xkmhd(i,k,j)
798 enddo
799 enddo
800 enddo
801
802 do i=ims,ime
803 do k=kms,kme
804 do j=jms,jme
805 P_ru_tendf(i,k,j)=FACTOR*S_ru_tendf(i,k,j)
806 P_rv_tendf(i,k,j)=FACTOR*S_rv_tendf(i,k,j)
807 P_rw_tendf(i,k,j)=FACTOR*S_rw_tendf(i,k,j)
808 P_t_tendf(i,k,j)=FACTOR*S_t_tendf(i,k,j)
809 P_cqw(i,k,j)=FACTOR*S_cqw(i,k,j)
810 enddo
811 enddo
812 enddo
813
814 do i=ims,ime
815 do j=jms,jme
816 P_mu(i,j)=FACTOR*S_mu(i,j)
817 P_mut(i,j)=FACTOR*S_mut(i,j)
818 P_muu(i,j)=FACTOR*S_muu(i,j)
819 P_muv(i,j)=FACTOR*S_muv(i,j)
820 enddo
821 enddo
822
823 CALL rk_tendency ( config_flags, rk_step, &
824 P_ru_tend, P_rv_tend, P_rw_tend, P_ph_tend, P_t_tend, &
825 P_ru_tendf, P_rv_tendf, P_rw_tendf, ph_tendf, P_t_tendf, &
826 P_mu_tend, P_u_save, P_v_save, P_w_save, P_ph_save, &
827 P_t_save, mu_save, RTHFTEN, &
828 P_ru, P_rv, P_rw, P_ww, &
829 P_u, P_v, P_w, P_t, P_ph, &
830 P_u_old, P_v_old, P_w_old, P_t_old, P_ph_old, &
831 h_diabatic, phb,t_init, &
832 P_mu, P_mut, P_muu, P_muv, mub, &
833 P_al, P_alt, P_p, pb, P_php, P_cqu, P_cqv, P_cqw, &
834 u_base, v_base, t_base, qv_base, z_base, &
835 msfu, msfv, msft, f, e, sina, cosa, &
836 fnm, fnp, rdn, rdnw, &
837 dt, rdx, rdy, khdif, kvdif, P_xkmhd, &
838 diff_6th_opt, diff_6th_rate, &
839 dampcoef,zdamp,damp_opt, &
840 cf1, cf2, cf3, cfn, cfn1, n_moist, &
841 non_hydrostatic, &
842 ids, ide, jds, jde, kds, kde, &
843 ims, ime, jms, jme, kms, kme, &
844 its, ite, jts, jte, kts, kte )
845
846
847 VAL_N=0.
848 do i=ims,ime
849 do k=kms,kme
850 do j=jms,jme
851 VAL_N=VAL_N+(P_ru_tend(i,k,j)- B_ru_tend(i,k,j))*(P_ru_tend(i,k,j)- B_ru_tend(i,k,j)) &
852 +(P_rv_tend(i,k,j)- B_rv_tend(i,k,j))*(P_rv_tend(i,k,j)- B_rv_tend(i,k,j)) &
853 +(P_rw_tend(i,k,j)- B_rw_tend(i,k,j))*(P_rw_tend(i,k,j)- B_rw_tend(i,k,j)) &
854 +(P_t_tend(i,k,j)- B_t_tend(i,k,j))*(P_t_tend(i,k,j)- B_t_tend(i,k,j)) &
855 +(P_ph_tend(i,k,j)- B_ph_tend(i,k,j))*(P_ph_tend(i,k,j)- B_ph_tend(i,k,j)) &
856 +(P_u_save(i,k,j)- B_u_save(i,k,j))*(P_u_save(i,k,j)- B_u_save(i,k,j)) &
857 +(P_v_save(i,k,j)- B_v_save(i,k,j))*(P_v_save(i,k,j)- B_v_save(i,k,j)) &
858 +(P_w_save(i,k,j)- B_w_save(i,k,j))*(P_w_save(i,k,j)- B_w_save(i,k,j)) &
859 +(P_ph_save(i,k,j)- B_ph_save(i,k,j))*(P_ph_save(i,k,j)- B_ph_save(i,k,j)) &
860 +(P_t_save(i,k,j)- B_t_save(i,k,j))*(P_t_save(i,k,j)- B_t_save(i,k,j))
861 enddo
862 enddo
863 enddo
864
865 do i=ims,ime
866 do k=kms,kme
867 do j=jms,jme
868 VAL_N=VAL_N+(P_ru_tendf(i,k,j)- B_ru_tendf(i,k,j))*(P_ru_tendf(i,k,j)- B_ru_tendf(i,k,j)) &
869 +(P_rv_tendf(i,k,j)- B_rv_tendf(i,k,j))*(P_rv_tendf(i,k,j)- B_rv_tendf(i,k,j)) &
870 +(P_rw_tendf(i,k,j)- B_rw_tendf(i,k,j))*(P_rw_tendf(i,k,j)- B_rw_tendf(i,k,j)) &
871 +(P_t_tendf(i,k,j)- B_t_tendf(i,k,j))*(P_t_tendf(i,k,j)- B_t_tendf(i,k,j)) &
872 +(P_cqw(i,k,j)- B_cqw(i,k,j))*(P_cqw(i,k,j)- B_cqw(i,k,j))
873 enddo
874 enddo
875 enddo
876
877 do i=ims,ime
878 do j=jms,jme
879 VAL_N=VAL_N+(P_mu_tend(i,j)- B_mu_tend(i,j))*(P_mu_tend(i,j)- B_mu_tend(i,j))
880 enddo
881 enddo
882
883 VAL_L=SAVE_L*ALPHA**2
884 COEF=VAL_N/VAL_L
885 WRITE(6, fmt='(A,E9.4,A,E22.13,A,E13.6,A,E13.6)') &
886 'g_rk_tendency: ALPHA=',ALPHA,' COEF=',COEF, &
887 ' VAL_N=',VAL_N,' VAL_L=',VAL_L
888 ENDDO
889
890 ! ADJ test
891
892 FACTOR=0.1
893 do i=ims,ime
894 do k=kms,kme
895 do j=jms,jme
896
897 ru(i,k,j)=S_ru(i,k,j)
898 rv(i,k,j)=S_rv(i,k,j)
899 rw(i,k,j)=S_rw(i,k,j)
900 ww(i,k,j)=S_ww(i,k,j)
901 u(i,k,j)=S_u(i,k,j)
902 v(i,k,j)=S_v(i,k,j)
903 w(i,k,j)=S_w(i,k,j)
904 t(i,k,j)=S_t(i,k,j)
905 ph(i,k,j)=S_ph(i,k,j)
906 u_old(i,k,j)=S_u_old(i,k,j)
907 v_old(i,k,j)=S_v_old(i,k,j)
908 w_old(i,k,j)=S_w_old(i,k,j)
909 t_old(i,k,j)=S_t_old(i,k,j)
910 ph_old(i,k,j)=S_ph_old(i,k,j)
911 al(i,k,j)=S_al(i,k,j)
912 alt(i,k,j)=S_alt(i,k,j)
913 p(i,k,j)=S_p(i,k,j)
914 php(i,k,j)=S_php(i,k,j)
915 cqu(i,k,j)=S_cqu(i,k,j)
916 cqv(i,k,j)=S_cqv(i,k,j)
917 xkmhd(i,k,j)=S_xkmhd(i,k,j)
918
919
920 P_ru(i,k,j)=FACTOR*S_ru(i,k,j)
921 P_rv(i,k,j)=FACTOR*S_rv(i,k,j)
922 P_rw(i,k,j)=FACTOR*S_rw(i,k,j)
923 P_ww(i,k,j)=FACTOR*S_ww(i,k,j)
924 P_u(i,k,j)=FACTOR*S_u(i,k,j)
925 P_v(i,k,j)=FACTOR*S_v(i,k,j)
926 P_w(i,k,j)=FACTOR*S_w(i,k,j)
927 P_t(i,k,j)=FACTOR*S_t(i,k,j)
928 P_ph(i,k,j)=FACTOR*S_ph(i,k,j)
929 P_u_old(i,k,j)=FACTOR*S_u_old(i,k,j)
930 P_v_old(i,k,j)=FACTOR*S_v_old(i,k,j)
931 P_w_old(i,k,j)=FACTOR*S_w_old(i,k,j)
932 P_t_old(i,k,j)=FACTOR*S_t_old(i,k,j)
933 P_ph_old(i,k,j)=FACTOR*S_ph_old(i,k,j)
934 P_al(i,k,j)=FACTOR*S_al(i,k,j)
935 P_alt(i,k,j)=FACTOR*S_alt(i,k,j)
936 P_p(i,k,j)=FACTOR*S_p(i,k,j)
937 P_php(i,k,j)=FACTOR*S_php(i,k,j)
938 P_cqu(i,k,j)=FACTOR*S_cqu(i,k,j)
939 P_cqv(i,k,j)=FACTOR*S_cqv(i,k,j)
940 P_xkmhd(i,k,j)=FACTOR*S_xkmhd(i,k,j)
941
942 B_ru(i,k,j)=P_ru(i,k,j)
943 B_rv(i,k,j)=P_rv(i,k,j)
944 B_rw(i,k,j)=P_rw(i,k,j)
945 B_ww(i,k,j)=P_ww(i,k,j)
946 B_u(i,k,j)=P_u(i,k,j)
947 B_v(i,k,j)=P_v(i,k,j)
948 B_w(i,k,j)=P_w(i,k,j)
949 B_t(i,k,j)=P_t(i,k,j)
950 B_ph(i,k,j)=P_ph(i,k,j)
951 B_u_old(i,k,j)=P_u_old(i,k,j)
952 B_v_old(i,k,j)=P_v_old(i,k,j)
953 B_w_old(i,k,j)=P_w_old(i,k,j)
954 B_t_old(i,k,j)=P_t_old(i,k,j)
955 B_ph_old(i,k,j)=P_ph_old(i,k,j)
956 B_al(i,k,j)=P_al(i,k,j)
957 B_alt(i,k,j)=P_alt(i,k,j)
958 B_p(i,k,j)=P_p(i,k,j)
959 B_php(i,k,j)=P_php(i,k,j)
960 B_cqu(i,k,j)=P_cqu(i,k,j)
961 B_cqv(i,k,j)=P_cqv(i,k,j)
962 B_xkmhd(i,k,j)=P_xkmhd(i,k,j)
963
964 enddo
965 enddo
966 enddo
967
968 do i=ims,ime
969 do k=kms,kme
970 do j=jms,jme
971
972 ru_tendf(i,k,j)=S_ru_tendf(i,k,j)
973 rv_tendf(i,k,j)=S_rv_tendf(i,k,j)
974 rw_tendf(i,k,j)=S_rw_tendf(i,k,j)
975 t_tendf(i,k,j)=S_t_tendf(i,k,j)
976 cqw(i,k,j)=S_cqw(i,k,j)
977
978 P_ru_tendf(i,k,j)=FACTOR*S_ru_tendf(i,k,j)
979 P_rv_tendf(i,k,j)=FACTOR*S_rv_tendf(i,k,j)
980 P_rw_tendf(i,k,j)=FACTOR*S_rw_tendf(i,k,j)
981 P_t_tendf(i,k,j)=FACTOR*S_t_tendf(i,k,j)
982 P_cqw(i,k,j)=FACTOR*S_cqw(i,k,j)
983
984 B_ru_tendf(i,k,j)=P_ru_tendf(i,k,j)
985 B_rv_tendf(i,k,j)=P_rv_tendf(i,k,j)
986 B_rw_tendf(i,k,j)=P_rw_tendf(i,k,j)
987 B_t_tendf(i,k,j)=P_t_tendf(i,k,j)
988 B_cqw(i,k,j)=P_cqw(i,k,j)
989
990 K_cqw(i,k,j)=cqw(i,k,j)
991 enddo
992 enddo
993 enddo
994
995 do i=ims,ime
996 do j=jms,jme
997
998 mu(i,j)=S_mu(i,j)
999 mut(i,j)=S_mut(i,j)
1000 muu(i,j)=S_muu(i,j)
1001 muv(i,j)=S_muv(i,j)
1002
1003 P_mu(i,j)=FACTOR*S_mu(i,j)
1004 P_mut(i,j)=FACTOR*S_mut(i,j)
1005 P_muu(i,j)=FACTOR*S_muu(i,j)
1006 P_muv(i,j)=FACTOR*S_muv(i,j)
1007
1008 B_mu(i,j)=P_mu(i,j)
1009 B_mut(i,j)=P_mut(i,j)
1010 B_muu(i,j)=P_muu(i,j)
1011 B_muv(i,j)=P_muv(i,j)
1012
1013 enddo
1014 enddo
1015
1016 ! TGL
1017
1018 CALL g_rk_tendency( config_flags, rk_step, ru_tend, P_ru_tend, rv_tend, P_rv_tend, rw_tend, P_rw_tend, ph_tend, P_ph_tend, &
1019 &t_tend, P_t_tend, ru_tendf, P_ru_tendf, rv_tendf, P_rv_tendf, rw_tendf, P_rw_tendf, t_tendf, P_t_tendf, mu_tend, P_mu_tend, &
1020 &u_save, P_u_save, v_save, P_v_save, w_save, P_w_save, ph_save, P_ph_save, t_save, P_t_save, ru, P_ru, rv, P_rv, rw, P_rw, ww, &
1021 &P_ww, u, P_u, v, P_v, w, P_w, t, P_t, ph, P_ph, u_old, P_u_old, v_old, P_v_old, w_old, P_w_old, t_old, P_t_old, ph_old, P_ph_old, &
1022 &phb, t_init, mu, P_mu, mut, P_mut, muu, P_muu, muv, P_muv, mub, al, P_al, alt, P_alt, p, P_p, pb, php, P_php, cqu, P_cqu, cqv, &
1023 &P_cqv, cqw, P_cqw, u_base, v_base, z_base, msfu, msfv, msft, f, e, sina, cosa, fnm, fnp, rdn, rdnw, dt, rdx, rdy, kvdif, xkmhd, &
1024 &P_xkmhd, &
1025 dampcoef,zdamp,damp_opt, &
1026 cf1, cf2, cf3, cfn, cfn1, non_hydrostatic, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, &
1027 &jts, jte, kts, kte )
1028
1029 VAL_L=0.
1030 do i=ims,ime
1031 do k=kms,kme
1032 do j=jms,jme
1033 VAL_L=VAL_L + P_ru_tend(i,k,j)*P_ru_tend(i,k,j) &
1034 + P_rv_tend(i,k,j)*P_rv_tend(i,k,j) &
1035 + P_rw_tend(i,k,j)*P_rw_tend(i,k,j) &
1036 + P_t_tend(i,k,j)*P_t_tend(i,k,j) &
1037 + P_ph_tend(i,k,j)*P_ph_tend(i,k,j) &
1038 + P_u_save(i,k,j)*P_u_save(i,k,j) &
1039 + P_v_save(i,k,j)*P_v_save(i,k,j) &
1040 + P_w_save(i,k,j)*P_w_save(i,k,j) &
1041 + P_ph_save(i,k,j)*P_ph_save(i,k,j) &
1042 + P_t_save(i,k,j)*P_t_save(i,k,j)
1043 enddo
1044 enddo
1045 enddo
1046 do i=ims,ime
1047 do k=kms,kme
1048 do j=jms,jme
1049 VAL_L=VAL_L + P_ru_tendf(i,k,j) *P_ru_tendf(i,k,j) &
1050 + P_rv_tendf(i,k,j) *P_rv_tendf(i,k,j) &
1051 + P_rw_tendf(i,k,j) *P_rw_tendf(i,k,j) &
1052 + P_t_tendf(i,k,j) *P_t_tendf(i,k,j) &
1053 + P_cqw(i,k,j) *P_cqw(i,k,j)
1054 enddo
1055 enddo
1056 enddo
1057 do i=ims,ime
1058 do j=jms,jme
1059 VAL_L=VAL_L + P_mu_tend(i,j) *P_mu_tend(i,j)
1060 enddo
1061 enddo
1062
1063 do i=ims,ime
1064 do k=kms,kme
1065 do j=jms,jme
1066 P_ru(i,k,j)=0.0
1067 P_rv(i,k,j)=0.0
1068 P_rw(i,k,j)=0.0
1069 P_ww(i,k,j)=0.0
1070 P_u(i,k,j)=0.0
1071 P_v(i,k,j)=0.0
1072 P_w(i,k,j)=0.0
1073 P_t(i,k,j)=0.0
1074 P_ph(i,k,j)=0.0
1075 P_u_old(i,k,j)=0.0
1076 P_v_old(i,k,j)=0.0
1077 P_w_old(i,k,j)=0.0
1078 P_t_old(i,k,j)=0.0
1079 P_ph_old(i,k,j)=0.0
1080 P_al(i,k,j)=0.0
1081 P_alt(i,k,j)=0.0
1082 P_p(i,k,j)=0.0
1083 P_php(i,k,j)=0.0
1084 P_cqu(i,k,j)=0.0
1085 P_cqv(i,k,j)=0.0
1086 P_xkmhd(i,k,j)=0.0
1087 enddo
1088 enddo
1089 enddo
1090 do i=ims,ime
1091 do j=jms,jme
1092 P_mu(i,j)=0.0
1093 P_mut(i,j)=0.0
1094 P_muu(i,j)=0.0
1095 P_muv(i,j)=0.0
1096 enddo
1097 enddo
1098
1099
1100 ! ADJ
1101
1102 CALL a_rk_tendency( config_flags, rk_step, P_ru_tend, P_rv_tend, P_rw_tend, P_ph_tend, P_t_tend, P_ru_tendf, P_rv_tendf, &
1103 &P_rw_tendf, P_t_tendf, P_mu_tend, P_u_save, P_v_save, P_w_save, P_ph_save, P_t_save, ru, P_ru, rv, P_rv, rw, P_rw, ww, P_ww, u, &
1104 &P_u, v, P_v, w, P_w, t, P_t, ph, P_ph, u_old, P_u_old, v_old, P_v_old, w_old, P_w_old, t_old, P_t_old, ph_old, P_ph_old, phb, &
1105 &t_init, mu, P_mu, mut, P_mut, muu, P_muu, muv, P_muv, mub, al, P_al, alt, P_alt, p, P_p, pb, php, P_php, cqu, P_cqu, cqv, P_cqv, &
1106 &K_cqw, P_cqw, u_base, v_base, z_base, msfu, msfv, msft, f, e, sina, cosa, fnm, fnp, rdn, rdnw, dt, rdx, rdy, kvdif, xkmhd, P_xkmhd, &
1107 dampcoef,zdamp,damp_opt, &
1108 &cf1, cf2, cf3, cfn, cfn1, non_hydrostatic, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, &
1109 &kts, kte )
1110
1111
1112 VAL_A=0.
1113 do i=ims,ime
1114 do k=kms,kme
1115 do j=jms,jme
1116 VAL_A=VAL_A +P_ru(i,k,j)*B_ru(i,k,j) &
1117 +P_rv(i,k,j)*B_rv(i,k,j) &
1118 +P_rw(i,k,j)*B_rw(i,k,j) &
1119 +P_ww(i,k,j)*B_ww(i,k,j) &
1120 +P_u(i,k,j)*B_u(i,k,j) &
1121 +P_v(i,k,j)*B_v(i,k,j) &
1122 +P_w(i,k,j)*B_w(i,k,j) &
1123 +P_t(i,k,j)*B_t(i,k,j) &
1124 +P_ph(i,k,j)*B_ph(i,k,j) &
1125 +P_u_old(i,k,j)*B_u_old(i,k,j) &
1126 +P_v_old(i,k,j)*B_v_old(i,k,j) &
1127 +P_w_old(i,k,j)*B_w_old(i,k,j) &
1128 +P_t_old(i,k,j)*B_t_old(i,k,j) &
1129 +P_ph_old(i,k,j)*B_ph_old(i,k,j) &
1130 +P_al(i,k,j)*B_al(i,k,j) &
1131 +P_alt(i,k,j)*B_alt(i,k,j) &
1132 +P_p(i,k,j)*B_p(i,k,j) &
1133 +P_php(i,k,j)*B_php(i,k,j) &
1134 +P_cqu(i,k,j)*B_cqu(i,k,j) &
1135 +P_cqv(i,k,j)*B_cqv(i,k,j) &
1136 +P_xkmhd(i,k,j)*B_xkmhd(i,k,j)
1137 enddo
1138 enddo
1139 enddo
1140
1141 do i=ims,ime
1142 do k=kms,kme
1143 do j=jms,jme
1144 VAL_A=VAL_A +P_ru_tendf(i,k,j)*B_ru_tendf(i,k,j) &
1145 +P_rv_tendf(i,k,j)*B_rv_tendf(i,k,j) &
1146 +P_rw_tendf(i,k,j)*B_rw_tendf(i,k,j) &
1147 +P_t_tendf(i,k,j)*B_t_tendf(i,k,j) &
1148 +P_cqw(i,k,j)*B_cqw(i,k,j)
1149 enddo
1150 enddo
1151 enddo
1152
1153 do i=ims,ime
1154 do j=jms,jme
1155 VAL_A=VAL_A +P_mu(i,j)*B_mu(i,j) &
1156 +P_mut(i,j)*B_mut(i,j) &
1157 +P_muu(i,j)*B_muu(i,j) &
1158 +P_muv(i,j)*B_muv(i,j)
1159 enddo
1160 enddo
1161
1162 print*, ' '
1163 write(6,fmt='(A,2E22.13)') 'a_advect_scalar: ', VAL_L,VAL_A
1164
1165 ! RECOVER
1166
1167 do i=ims,ime
1168 do k=kms,kme
1169 do j=jms,jme
1170 ru(i,k,j)=S_ru(i,k,j)
1171 rv(i,k,j)=S_rv(i,k,j)
1172 rw(i,k,j)=S_rw(i,k,j)
1173 ww(i,k,j)=S_ww(i,k,j)
1174 u(i,k,j)=S_u(i,k,j)
1175 v(i,k,j)=S_v(i,k,j)
1176 w(i,k,j)=S_w(i,k,j)
1177 t(i,k,j)=S_t(i,k,j)
1178 ph(i,k,j)=S_ph(i,k,j)
1179 u_old(i,k,j)=S_u_old(i,k,j)
1180 v_old(i,k,j)=S_v_old(i,k,j)
1181 w_old(i,k,j)=S_w_old(i,k,j)
1182 t_old(i,k,j)=S_t_old(i,k,j)
1183 ph_old(i,k,j)=S_ph_old(i,k,j)
1184 al(i,k,j)=S_al(i,k,j)
1185 alt(i,k,j)=S_alt(i,k,j)
1186 p(i,k,j)=S_p(i,k,j)
1187 php(i,k,j)=S_php(i,k,j)
1188 cqu(i,k,j)=S_cqu(i,k,j)
1189 cqv(i,k,j)=S_cqv(i,k,j)
1190 xkmhd(i,k,j)=S_xkmhd(i,k,j)
1191 enddo
1192 enddo
1193 enddo
1194
1195 do i=ims,ime
1196 do k=kms,kme
1197 do j=jms,jme
1198 ru_tendf(i,k,j)=S_ru_tendf(i,k,j)
1199 rv_tendf(i,k,j)=S_rv_tendf(i,k,j)
1200 rw_tendf(i,k,j)=S_rw_tendf(i,k,j)
1201 t_tendf(i,k,j)=S_t_tendf(i,k,j)
1202 cqw(i,k,j)=S_cqw(i,k,j)
1203 enddo
1204 enddo
1205 enddo
1206
1207 do i=ims,ime
1208 do j=jms,jme
1209 mu(i,j)=S_mu(i,j)
1210 mut(i,j)=S_mut(i,j)
1211 muu(i,j)=S_muu(i,j)
1212 muv(i,j)=S_muv(i,j)
1213 enddo
1214 enddo
1215
1216 !the result of testing rk_tendency, using em_quarter_ss
1217
1218 !g_rk_tendency: ALPHA=.1000E+00 COEF= 0.121735E+01 VAL_N= 0.217612E+12 VAL_L= 0.178758E+12
1219 !g_rk_tendency: ALPHA=.1000E-01 COEF= 0.102015E+01 VAL_N= 0.182361E+10 VAL_L= 0.178758E+10
1220 !g_rk_tendency: ALPHA=.1000E-02 COEF= 0.100215E+01 VAL_N= 0.179143E+08 VAL_L= 0.178758E+08
1221 !g_rk_tendency: ALPHA=.1000E-03 COEF= 0.100113E+01 VAL_N= 0.178961E+06 VAL_L= 0.178758E+06
1222 !g_rk_tendency: ALPHA=.1000E-04 COEF= 0.101263E+01 VAL_N= 0.181017E+04 VAL_L= 0.178758E+04
1223 !g_rk_tendency: ALPHA=.1000E-05 COEF= 0.106717E+01 VAL_N= 0.190766E+02 VAL_L= 0.178758E+02
1224 !g_rk_tendency: ALPHA=.1000E-06 COEF= 0.170886E+01 VAL_N= 0.305473E+00 VAL_L= 0.178758E+00
1225 !g_rk_tendency: ALPHA=.1000E-07 COEF= 0.647516E-15 VAL_N= 0.115749E-17 VAL_L= 0.178758E-02
1226 !g_rk_tendency: ALPHA=.1000E-08 COEF= 0.647516E-13 VAL_N= 0.115749E-17 VAL_L= 0.178758E-04
1227 !g_rk_tendency: ALPHA=.1000E-09 COEF= 0.647516E-11 VAL_N= 0.115749E-17 VAL_L= 0.178758E-06
1228 !g_rk_tendency: ALPHA=.1000E-10 COEF= 0.647516E-09 VAL_N= 0.115749E-17 VAL_L= 0.178758E-08
1229
1230 !a_advect_scalar: 0.1787557969920E+12 0.1787880734720E+12
1231
1232 !g_rk_tendency: ALPHA=.1000E+00 COEF= 0.1217344191204E+01 VAL_N= 0.217614E+12 VAL_L= 0.178761E+12
1233 !g_rk_tendency: ALPHA=.1000E-01 COEF= 0.1020167288022E+01 VAL_N= 0.182366E+10 VAL_L= 0.178761E+10
1234 !g_rk_tendency: ALPHA=.1000E-02 COEF= 0.1002001638191E+01 VAL_N= 0.179119E+08 VAL_L= 0.178761E+08
1235 !g_rk_tendency: ALPHA=.1000E-03 COEF= 0.1000199989221E+01 VAL_N= 0.178797E+06 VAL_L= 0.178761E+06
1236 !g_rk_tendency: ALPHA=.1000E-04 COEF= 0.1000019972902E+01 VAL_N= 0.178765E+04 VAL_L= 0.178761E+04
1237 !g_rk_tendency: ALPHA=.1000E-05 COEF= 0.1000001972593E+01 VAL_N= 0.178761E+02 VAL_L= 0.178761E+02
1238 !g_rk_tendency: ALPHA=.1000E-06 COEF= 0.1000000174417E+01 VAL_N= 0.178761E+00 VAL_L= 0.178761E+00
1239 !g_rk_tendency: ALPHA=.1000E-07 COEF= 0.9999999817357E+00 VAL_N= 0.178761E-02 VAL_L= 0.178761E-02
1240 !g_rk_tendency: ALPHA=.1000E-08 COEF= 0.1000000166722E+01 VAL_N= 0.178761E-04 VAL_L= 0.178761E-04
1241 !g_rk_tendency: ALPHA=.1000E-09 COEF= 0.1000001082845E+01 VAL_N= 0.178761E-06 VAL_L= 0.178761E-06
1242 !g_rk_tendency: ALPHA=.1000E-10 COEF= 0.1000005202259E+01 VAL_N= 0.178762E-08 VAL_L= 0.178761E-08
1243
1244 !a_advect_scalar: 0.1787609594770E+12 0.1787609594770E+12
1245
1246
1247 END SUBROUTINE t_rk_tendency
1248
1249
1250 !---------------------------------------------------------------------------------------------------
1251
1252
1253 SUBROUTINE t_rk_step_prep ( config_flags, rk_step, &
1254 u, v, w, t, ph, mu, &
1255 moist, &
1256 ru, rv, rw, ww, php, alt, muu, muv, &
1257 mub, mut, phb, pb, p, al, alb, &
1258 cqu, cqv, cqw, &
1259 msfu, msfv, msft, &
1260 fnm, fnp, dnw, rdx, rdy, &
1261 n_moist, &
1262 ids, ide, jds, jde, kds, kde, &
1263 ims, ime, jms, jme, kms, kme, &
1264 its, ite, jts, jte, kts, kte )
1265
1266 IMPLICIT NONE
1267
1268
1269 ! Input data.
1270
1271 TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags
1272
1273 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
1274 ims, ime, jms, jme, kms, kme, &
1275 its, ite, jts, jte, kts, kte
1276
1277 INTEGER , INTENT(IN ) :: n_moist, rk_step
1278
1279 REAL , INTENT(IN ) :: rdx, rdy
1280
1281 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ),INTENT(IN ):: t, &
1282 phb, &
1283 pb, &
1284 alb
1285
1286 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: u, &
1287 v, &
1288 w, &
1289 ph, &
1290 al
1291
1292 REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , &
1293 INTENT( OUT) :: ru, &
1294 rv, &
1295 rw, &
1296 ww, &
1297 php, &
1298 cqu, &
1299 cqv, &
1300 cqw, &
1301 alt
1302
1303 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: p
1304
1305
1306
1307
1308 REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_moist ) :: moist
1309
1310 REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msft, &
1311 msfu, &
1312 msfv, &
1313 mub
1314 REAL , DIMENSION( ims:ime , jms:jme ) :: mu
1315
1316 REAL , DIMENSION( ims:ime , jms:jme ) , INTENT( OUT) :: muu, &
1317 muv, &
1318 mut
1319
1320 REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnm, fnp, dnw
1321
1322 integer :: i,j,k,h
1323
1324 ! zzma: new definition
1325
1326 ! IN variable
1327
1328 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: S_u, &
1329 S_v, &
1330 S_w, &
1331 S_ph, &
1332 S_al
1333 REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_moist ) :: S_moist
1334 REAL , DIMENSION( ims:ime , jms:jme ) :: S_mu
1335 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: P_u, &
1336 P_v, &
1337 P_w, &
1338 P_ph, &
1339 P_al
1340 REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_moist ) :: P_moist
1341 REAL , DIMENSION( ims:ime , jms:jme ) :: P_mu
1342
1343 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: B_u, &
1344 B_v, &
1345 B_w, &
1346 B_ph, &
1347 B_al
1348 REAL , DIMENSION( ims:ime, kms:kme, jms:jme, n_moist ) :: B_moist
1349 REAL , DIMENSION( ims:ime , jms:jme ) :: B_mu
1350
1351
1352 !OUT variable
1353
1354 REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) :: P_ru, &
1355 P_rv, &
1356 P_rw, &
1357 P_ww, &
1358 P_php, &
1359 P_cqu, &
1360 P_cqv, &
1361 P_cqw, &
1362 P_alt
1363 REAL , DIMENSION( ims:ime , jms:jme ) :: P_muu, &
1364 P_muv, &
1365 P_mut
1366 REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) :: B_ru, &
1367 B_rv, &
1368 B_rw, &
1369 B_ww, &
1370 B_php, &
1371 B_cqu, &
1372 B_cqv, &
1373 B_cqw, &
1374 B_alt
1375 REAL , DIMENSION( ims:ime , jms:jme ) :: B_muu, &
1376 B_muv, &
1377 B_mut
1378
1379 REAL :: SAVE_L, COEF, ALPHA, FACTOR, VAL_N, VAL_L, VAL_A
1380 INTEGER :: NT
1381
1382 ! zzma: new definition end
1383
1384 !TGL test
1385
1386 do i=ims,ime
1387 do k=kms,kme
1388 do j=jms,jme
1389 S_u(i,k,j)=u(i,k,j)
1390 S_v(i,k,j)=v(i,k,j)
1391 S_w(i,k,j)=w(i,k,j)
1392 S_ph(i,k,j)=ph(i,k,j)
1393 S_al(i,k,j)=al(i,k,j)
1394
1395 P_u(i,k,j)=u(i,k,j)
1396 P_v(i,k,j)=v(i,k,j)
1397 P_w(i,k,j)=w(i,k,j)
1398 P_ph(i,k,j)=ph(i,k,j)
1399 P_al(i,k,j)=al(i,k,j)
1400 enddo
1401 enddo
1402 enddo
1403
1404 do i=ims,ime
1405 do k=kms,kme
1406 do j=jms,jme
1407 do h=1 ,n_moist
1408 S_moist(i,k,j,h)=moist(i,k,j,h)
1409
1410 P_moist(i,k,j,h)=moist(i,k,j,h)
1411 enddo
1412 enddo
1413 enddo
1414 enddo
1415
1416 do i=ims,ime
1417 do j=jms,jme
1418 S_mu(i,j)=mu(i,j)
1419
1420 P_mu(i,j)=mu(i,j)
1421 enddo
1422 enddo
1423
1424 !NLM
1425
1426 CALL rk_step_prep ( config_flags, rk_step, &
1427 u, v, w, t, ph, mu, &
1428 moist, &
1429 ru, rv, rw, ww, php, alt, muu, muv, &
1430 mub, mut, phb, pb, p, al, alb, &
1431 cqu, cqv, cqw, &
1432 msfu, msfv, msft, &
1433 fnm, fnp, dnw, rdx, rdy, &
1434 n_moist, &
1435 ids, ide, jds, jde, kds, kde, &
1436 ims, ime, jms, jme, kms, kme, &
1437 its, ite, jts, jte, kts, kte )
1438
1439 do i=ims,ime
1440 do k=kms,kme
1441 do j=jms,jme
1442 B_ru(i,k,j)=ru(i,k,j)
1443 B_rv(i,k,j)=rv(i,k,j)
1444 B_rw(i,k,j)=rw(i,k,j)
1445 B_ww(i,k,j)=ww(i,k,j)
1446 B_php(i,k,j)=php(i,k,j)
1447 B_cqu(i,k,j)=cqu(i,k,j)
1448 B_cqv(i,k,j)=cqv(i,k,j)
1449 B_cqw(i,k,j)=cqw(i,k,j)
1450 B_alt(i,k,j)=alt(i,k,j)
1451 enddo
1452 enddo
1453 enddo
1454
1455 do i=ims,ime
1456 do j=jms,jme
1457 B_muu(i,j)=muu(i,j)
1458 B_muv(i,j)=muv(i,j)
1459 B_mut(i,j)=mut(i,j)
1460 enddo
1461 enddo
1462
1463 ! TCL
1464
1465 CALL g_rk_step_prep( config_flags, u, P_u, v, P_v, w, P_w, ph, P_ph, mu, P_mu, moist, P_moist, ru, P_ru, rv, P_rv, rw, P_rw, &
1466 &ww, P_ww, php, P_php, alt, P_alt, muu, P_muu, muv, P_muv, mub, mut, P_mut, phb, al, P_al, alb, cqu, P_cqu, cqv, P_cqv, cqw, P_cqw,&
1467 & msfu, msfv, msft, dnw, rdx, rdy, n_moist, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
1468
1469 SAVE_L=0.
1470 do i=ims,ime
1471 do k=kms,kme
1472 do j=jms,jme
1473 SAVE_L=SAVE_L + P_ru(i,k,j)*P_ru(i,k,j) &
1474 + P_rv(i,k,j)*P_rv(i,k,j) &
1475 + P_rw(i,k,j)*P_rw(i,k,j) &
1476 + P_ww(i,k,j)*P_ww(i,k,j) &
1477 + P_php(i,k,j)*P_php(i,k,j) &
1478 + P_cqu(i,k,j)*P_cqu(i,k,j) &
1479 + P_cqv(i,k,j)*P_cqv(i,k,j) &
1480 + P_cqw(i,k,j)*P_cqw(i,k,j) &
1481 + P_alt(i,k,j)*P_alt(i,k,j)
1482
1483 enddo
1484 enddo
1485 enddo
1486
1487 do i=ims,ime
1488 do j=jms,jme
1489 SAVE_L=SAVE_L + P_muu(i,j)*P_muu(i,j) &
1490 + P_muv(i,j)*P_muv(i,j) &
1491 + P_mut(i,j)*P_mut(i,j)
1492 enddo
1493 enddo
1494
1495 ALPHA=1.
1496 DO NT=1,11
1497 ALPHA=0.1*ALPHA
1498 FACTOR=1.+ALPHA
1499
1500 do i=ims,ime
1501 do k=kms,kme
1502 do j=jms,jme
1503 P_u(i,k,j)=FACTOR*S_u(i,k,j)
1504 P_v(i,k,j)=FACTOR*S_v(i,k,j)
1505 P_w(i,k,j)=FACTOR*S_w(i,k,j)
1506 P_ph(i,k,j)=FACTOR*S_ph(i,k,j)
1507 P_al(i,k,j)=FACTOR*S_al(i,k,j)
1508 enddo
1509 enddo
1510 enddo
1511
1512 do i=ims,ime
1513 do k=kms,kme
1514 do j=jms,jme
1515 do h=1 ,n_moist
1516 P_moist(i,k,j,h)=FACTOR*S_moist(i,k,j,h)
1517 enddo
1518 enddo
1519 enddo
1520 enddo
1521
1522 do i=ims,ime
1523 do j=jms,jme
1524 P_mu(i,j)=FACTOR*S_mu(i,j)
1525 enddo
1526 enddo
1527
1528 CALL rk_step_prep ( config_flags, rk_step, &
1529 P_u, P_v, P_w, t, P_ph, P_mu, &
1530 P_moist, &
1531 P_ru, P_rv, P_rw, P_ww, P_php, P_alt, P_muu, P_muv, &
1532 mub, P_mut, phb, pb, p, P_al, alb, &
1533 P_cqu, P_cqv, P_cqw, &
1534 msfu, msfv, msft, &
1535 fnm, fnp, dnw, rdx, rdy, &
1536 n_moist, &
1537 ids, ide, jds, jde, kds, kde, &
1538 ims, ime, jms, jme, kms, kme, &
1539 its, ite, jts, jte, kts, kte )
1540
1541
1542 VAL_N=0.
1543 do i=ims,ime
1544 do k=kms,kme
1545 do j=jms,jme
1546 VAL_N=VAL_N +(P_ru(i,k,j) - B_ru(i,k,j))*(P_ru(i,k,j) - B_ru(i,k,j)) &
1547 +(P_rv(i,k,j) - B_rv(i,k,j))*(P_rv(i,k,j) - B_rv(i,k,j)) &
1548 +(P_rw(i,k,j) - B_rw(i,k,j))*(P_rw(i,k,j) - B_rw(i,k,j)) &
1549 +(P_ww(i,k,j) - B_ww(i,k,j))*(P_ww(i,k,j) - B_ww(i,k,j)) &
1550 +(P_php(i,k,j) - B_php(i,k,j))*(P_php(i,k,j) - B_php(i,k,j)) &
1551 +(P_cqu(i,k,j) - B_cqu(i,k,j))*(P_cqu(i,k,j) - B_cqu(i,k,j)) &
1552 +(P_cqv(i,k,j) - B_cqv(i,k,j))*(P_cqv(i,k,j) - B_cqv(i,k,j)) &
1553 +(P_cqw(i,k,j) - B_cqw(i,k,j))*(P_cqw(i,k,j) - B_cqw(i,k,j)) &
1554 +(P_alt(i,k,j) - B_alt(i,k,j))*(P_alt(i,k,j) - B_alt(i,k,j))
1555 enddo
1556 enddo
1557 enddo
1558 do i=ims,ime
1559 do j=jms,jme
1560 VAL_N=VAL_N+(P_muu(i,j) - B_muu(i,j))*(P_muu(i,j) - B_muu(i,j)) &
1561 +(P_muv(i,j) - B_muv(i,j))*(P_muv(i,j) - B_muv(i,j)) &
1562 +(P_mut(i,j) - B_mut(i,j))*(P_mut(i,j) - B_mut(i,j))
1563 enddo
1564 enddo
1565
1566 VAL_L=SAVE_L*ALPHA**2
1567 COEF=VAL_N/VAL_L
1568 WRITE(6, fmt='(A,E9.4,A,E22.13,A,E13.6,A,E13.6)') &
1569 'g_rk_step_prep: ALPHA=',ALPHA,' COEF=',COEF, &
1570 ' VAL_N=',VAL_N,' VAL_L=',VAL_L
1571 ENDDO
1572
1573 ! ADJ test
1574
1575 FACTOR=0.1
1576 do i=ims,ime
1577 do k=kms,kme
1578 do j=jms,jme
1579 u(i,k,j)=S_u(i,k,j)
1580 v(i,k,j)=S_v(i,k,j)
1581 w(i,k,j)=S_w(i,k,j)
1582 ph(i,k,j)=S_ph(i,k,j)
1583 al(i,k,j)=S_al(i,k,j)
1584
1585 P_u(i,k,j)=FACTOR*S_u(i,k,j)
1586 P_v(i,k,j)=FACTOR*S_v(i,k,j)
1587 P_w(i,k,j)=FACTOR*S_w(i,k,j)
1588 P_ph(i,k,j)=FACTOR*S_ph(i,k,j)
1589 P_al(i,k,j)=FACTOR*S_al(i,k,j)
1590
1591 B_u(i,k,j)=P_u(i,k,j)
1592 B_v(i,k,j)=P_v(i,k,j)
1593 B_w(i,k,j)=P_w(i,k,j)
1594 B_ph(i,k,j)=P_ph(i,k,j)
1595 B_al(i,k,j)=P_al(i,k,j)
1596
1597 enddo
1598 enddo
1599 enddo
1600
1601 do i=ims,ime
1602 do k=kms,kme
1603 do j=jms,jme
1604 do h=1 ,n_moist
1605 moist(i,k,j,h)=S_moist(i,k,j,h)
1606
1607 P_moist(i,k,j,h)=FACTOR*S_moist(i,k,j,h)
1608
1609 B_moist(i,k,j,h)=P_moist(i,k,j,h)
1610 enddo
1611 enddo
1612 enddo
1613 enddo
1614
1615 do i=ims,ime
1616 do j=jms,jme
1617 mu(i,j)=S_mu(i,j)
1618
1619 P_mu(i,j)=FACTOR*S_mu(i,j)
1620
1621 B_mu(i,j)=P_mu(i,j)
1622 enddo
1623 enddo
1624
1625 ! TGL
1626
1627 CALL g_rk_step_prep( config_flags, u, P_u, v, P_v, w, P_w, ph, P_ph, mu, P_mu, moist, P_moist, ru, P_ru, rv, P_rv, rw, P_rw, &
1628 &ww, P_ww, php, P_php, alt, P_alt, muu, P_muu, muv, P_muv, mub, mut, P_mut, phb, al, P_al, alb, cqu, P_cqu, cqv, P_cqv, cqw, P_cqw,&
1629 & msfu, msfv, msft, dnw, rdx, rdy, n_moist, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
1630
1631 VAL_L=0.
1632 do i=ims,ime
1633 do k=kms,kme
1634 do j=jms,jme
1635 VAL_L=VAL_L + P_ru(i,k,j)*P_ru(i,k,j) &
1636 + P_rv(i,k,j)*P_rv(i,k,j) &
1637 + P_rw(i,k,j)*P_rw(i,k,j) &
1638 + P_ww(i,k,j)*P_ww(i,k,j) &
1639 + P_php(i,k,j)*P_php(i,k,j) &
1640 + P_cqu(i,k,j)*P_cqu(i,k,j) &
1641 + P_cqv(i,k,j)*P_cqv(i,k,j) &
1642 + P_cqw(i,k,j)*P_cqw(i,k,j) &
1643 + P_alt(i,k,j)*P_alt(i,k,j)
1644
1645 enddo
1646 enddo
1647 enddo
1648
1649 do i=ims,ime
1650 do j=jms,jme
1651 VAL_L=VAL_L + P_muu(i,j)*P_muu(i,j) &
1652 + P_muv(i,j)*P_muv(i,j) &
1653 + P_mut(i,j)*P_mut(i,j)
1654 enddo
1655 enddo
1656
1657 do i=ims,ime
1658 do k=kms,kme
1659 do j=jms,jme
1660 P_u(i,k,j)=0.0
1661 P_v(i,k,j)=0.0
1662 P_w(i,k,j)=0.0
1663 P_ph(i,k,j)=0.0
1664 P_al(i,k,j)=0.0
1665 enddo
1666 enddo
1667 enddo
1668
1669 do i=ims,ime
1670 do k=kms,kme
1671 do j=jms,jme
1672 do h=1 ,n_moist
1673 P_moist(i,k,j,h)=0.0
1674 enddo
1675 enddo
1676 enddo
1677 enddo
1678
1679 do i=ims,ime
1680 do j=jms,jme
1681 P_mu(i,j)=0.0
1682 enddo
1683 enddo
1684
1685 ! ADJ
1686
1687 CALL a_rk_step_prep( config_flags, u, P_u, v, P_v, w, P_w, P_ph, mu, P_mu, moist, P_moist, P_ru, P_rv, P_rw, P_ww, P_php, &
1688 &P_alt, muu, P_muu, muv, P_muv, mub, mut, P_mut, P_al, P_cqu, P_cqv, P_cqw, msfu, msfv, msft, dnw, rdx, rdy, n_moist, ids, ide, &
1689 &jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
1690
1691 VAL_A=0.
1692 do i=ims,ime
1693 do k=kms,kme
1694 do j=jms,jme
1695 VAL_A=VAL_A + P_u(i,k,j)*B_u(i,k,j) &
1696 + P_v(i,k,j)*B_v(i,k,j) &
1697 + P_w(i,k,j)*B_w(i,k,j) &
1698 + P_ph(i,k,j)*B_ph(i,k,j) &
1699 + P_al(i,k,j)*B_al(i,k,j)
1700 enddo
1701 enddo
1702 enddo
1703
1704 do i=ims,ime
1705 do k=kms,kme
1706 do j=jms,jme
1707 do h=1 ,n_moist
1708 VAL_A=VAL_A + P_moist(i,k,j,h)*B_moist(i,k,j,h)
1709 enddo
1710 enddo
1711 enddo
1712 enddo
1713
1714 do i=ims,ime
1715 do j=jms,jme
1716 VAL_A=VAL_A + P_mu(i,j)*B_mu(i,j)
1717 enddo
1718 enddo
1719
1720 print*, ' '
1721 write(6,fmt='(A,2E22.13)') 'a_rk_step_prep: ', VAL_L,VAL_A
1722
1723 ! RECOVER
1724
1725 do i=ims,ime
1726 do k=kms,kme
1727 do j=jms,jme
1728 u(i,k,j)=S_u(i,k,j)
1729 v(i,k,j)=S_v(i,k,j)
1730 w(i,k,j)=S_w(i,k,j)
1731 ph(i,k,j)=S_ph(i,k,j)
1732 al(i,k,j)=S_al(i,k,j)
1733 enddo
1734 enddo
1735 enddo
1736
1737 do i=ims,ime
1738 do k=kms,kme
1739 do j=jms,jme
1740 do h=1 ,n_moist
1741 moist(i,k,j,h)=S_moist(i,k,j,h)
1742 enddo
1743 enddo
1744 enddo
1745 enddo
1746
1747 do i=ims,ime
1748 do j=jms,jme
1749 mu(i,j)=S_mu(i,j)
1750 enddo
1751 enddo
1752
1753 ! the result of testing rk_step_prep, using em_quarter_ss
1754
1755 !g_rk_step_prep: ALPHA=.1000E+00 COEF= 0.9992192983627E+00 VAL_N= 0.338343E+16 VAL_L= 0.338607E+16
1756 !g_rk_step_prep: ALPHA=.1000E-01 COEF= 0.9996247887611E+00 VAL_N= 0.338480E+14 VAL_L= 0.338607E+14
1757 !g_rk_step_prep: ALPHA=.1000E-02 COEF= 0.9993402957916E+00 VAL_N= 0.338384E+12 VAL_L= 0.338607E+12
1758 !g_rk_step_prep: ALPHA=.1000E-03 COEF= 0.9999324679375E+00 VAL_N= 0.338585E+10 VAL_L= 0.338607E+10
1759 !g_rk_step_prep: ALPHA=.1000E-04 COEF= 0.1030537486076E+01 VAL_N= 0.348948E+08 VAL_L= 0.338607E+08
1760 !g_rk_step_prep: ALPHA=.1000E-05 COEF= 0.1312857389450E+01 VAL_N= 0.444543E+06 VAL_L= 0.338608E+06
1761 !g_rk_step_prep: ALPHA=.1000E-06 COEF= 0.3907715606689E+02 VAL_N= 0.132318E+06 VAL_L= 0.338608E+04
1762 !g_rk_step_prep: ALPHA=.1000E-07 COEF= 0.3579903320312E+04 VAL_N= 0.121218E+06 VAL_L= 0.338608E+02
1763 !g_rk_step_prep: ALPHA=.1000E-08 COEF= 0.3579903125000E+06 VAL_N= 0.121218E+06 VAL_L= 0.338608E+00
1764 !g_rk_step_prep: ALPHA=.1000E-09 COEF= 0.3579902800000E+08 VAL_N= 0.121218E+06 VAL_L= 0.338608E-02
1765 !g_rk_step_prep: ALPHA=.1000E-10 COEF= 0.3579902464000E+10 VAL_N= 0.121218E+06 VAL_L= 0.338608E-04
1766
1767 !a_rk_step_prep: 0.3386954569744E+16 0.3385869822067E+16
1768
1769
1770 !g_rk_step_prep: ALPHA=.1000E+00 COEF= 0.9990601883727E+00 VAL_N= 0.338407E+16 VAL_L= 0.338726E+16
1771 !g_rk_step_prep: ALPHA=.1000E-01 COEF= 0.9999060025300E+00 VAL_N= 0.338694E+14 VAL_L= 0.338726E+14
1772 !g_rk_step_prep: ALPHA=.1000E-02 COEF= 0.9999909575619E+00 VAL_N= 0.338723E+12 VAL_L= 0.338726E+12
1773 !g_rk_step_prep: ALPHA=.1000E-03 COEF= 0.1000034846551E+01 VAL_N= 0.338737E+10 VAL_L= 0.338726E+10
1774 !g_rk_step_prep: ALPHA=.1000E-04 COEF= 0.1003578564589E+01 VAL_N= 0.339938E+08 VAL_L= 0.338726E+08
1775 !g_rk_step_prep: ALPHA=.1000E-05 COEF= 0.1357865847341E+01 VAL_N= 0.459944E+06 VAL_L= 0.338726E+06
1776 !g_rk_step_prep: ALPHA=.1000E-06 COEF= 0.3678658566932E+02 VAL_N= 0.124606E+06 VAL_L= 0.338726E+04
1777 !g_rk_step_prep: ALPHA=.1000E-07 COEF= 0.3579658567082E+04 VAL_N= 0.121252E+06 VAL_L= 0.338726E+02
1778 !g_rk_step_prep: ALPHA=.1000E-08 COEF= 0.3578668567080E+06 VAL_N= 0.121219E+06 VAL_L= 0.338726E+00
1779 !g_rk_step_prep: ALPHA=.1000E-09 COEF= 0.3578658667078E+08 VAL_N= 0.121218E+06 VAL_L= 0.338726E-02
1780 !g_rk_step_prep: ALPHA=.1000E-10 COEF= 0.3578658568079E+10 VAL_N= 0.121218E+06 VAL_L= 0.338726E-04
1781
1782 !a_rk_step_prep: 0.3387256544396E+16 0.3387256544395E+16
1783
1784
1785 END SUBROUTINE t_rk_step_prep
1786
1787 !---------------------------------------------------------------------------------------------------
1788
1789 SUBROUTINE t_init_zero_tendency(ru_tendf, rv_tendf, rw_tendf, ph_tendf, &
1790 t_tendf, tke_tendf, &
1791 mu_tendf, &
1792 moist_tendf,chem_tendf,scalar_tendf, &
1793 n_moist,n_chem,n_scalar,rk_step, &
1794 ids, ide, jds, jde, kds, kde, &
1795 ims, ime, jms, jme, kms, kme, &
1796 its, ite, jts, jte, kts, kte )
1797 IMPLICIT NONE
1798
1799 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
1800 ims, ime, jms, jme, kms, kme, &
1801 its, ite, jts, jte, kts, kte
1802
1803 INTEGER , INTENT(IN ) :: n_moist,n_chem,n_scalar,rk_step
1804
1805 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(INOUT) :: &
1806 ru_tendf, &
1807 rv_tendf, &
1808 rw_tendf, &
1809 ph_tendf, &
1810 t_tendf, &
1811 tke_tendf
1812
1813 REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: mu_tendf
1814
1815 REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist),INTENT(INOUT)::&
1816 moist_tendf
1817
1818 REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_chem ),INTENT(INOUT)::&
1819 chem_tendf
1820
1821 REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar ),INTENT(INOUT)::&
1822 scalar_tendf
1823
1824 ! LOCAL VARS
1825
1826 INTEGER :: im, ic,i,j,k,h
1827
1828 ! zzma: new definition
1829
1830 ! INOUT variables
1831
1832 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: S_ru_tendf, &
1833 S_rv_tendf, &
1834 S_rw_tendf, &
1835 S_ph_tendf, &
1836 S_t_tendf
1837
1838 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: P_ru_tendf, &
1839 P_rv_tendf, &
1840 P_rw_tendf, &
1841 P_ph_tendf, &
1842 P_t_tendf, &
1843 P_tke_tendf
1844 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: B_ru_tendf, &
1845 B_rv_tendf, &
1846 B_rw_tendf, &
1847 B_ph_tendf, &
1848 B_t_tendf
1849 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: K_ru_tendf, &
1850 K_rv_tendf, &
1851 K_rw_tendf, &
1852 K_ph_tendf, &
1853 K_t_tendf
1854
1855 REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist) :: S_moist_tendf, &
1856 P_moist_tendf, &
1857 B_moist_tendf, &
1858 K_moist_tendf
1859
1860 REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_chem) :: S_chem_tendf, &
1861 P_chem_tendf, &
1862 B_chem_tendf, &
1863 K_chem_tendf
1864
1865 REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar) :: S_scalar_tendf, &
1866 P_scalar_tendf, &
1867 B_scalar_tendf, &
1868 K_scalar_tendf
1869
1870 REAL :: SAVE_L, COEF, ALPHA, FACTOR, VAL_N, VAL_L, VAL_A
1871 INTEGER :: NT
1872
1873 ! zzma: new definition end
1874
1875 !TGL test
1876
1877 do i=ims,ime
1878 do k=kms,kme
1879 do j=jms,jme
1880 S_ru_tendf(i,k,j)=ru_tendf(i,k,j)
1881 S_rv_tendf(i,k,j)=rv_tendf(i,k,j)
1882 S_rw_tendf(i,k,j)=rw_tendf(i,k,j)
1883 S_ph_tendf(i,k,j)=ph_tendf(i,k,j)
1884 S_t_tendf(i,k,j)=t_tendf(i,k,j)
1885
1886 ! P_ru_tendf(i,k,j)=ru_tendf(i,k,j)
1887 ! P_rv_tendf(i,k,j)=rv_tendf(i,k,j)
1888 ! P_rw_tendf(i,k,j)=rw_tendf(i,k,j)
1889 ! P_ph_tendf(i,k,j)=ph_tendf(i,k,j)
1890 ! P_t_tendf(i,k,j)=t_tendf(i,k,j)
1891
1892 ! K_ru_tendf(i,k,j)=ru_tendf(i,k,j)
1893 ! K_rv_tendf(i,k,j)=rv_tendf(i,k,j)
1894 ! K_rw_tendf(i,k,j)=rw_tendf(i,k,j)
1895 ! K_ph_tendf(i,k,j)=ph_tendf(i,k,j)
1896 ! K_t_tendf(i,k,j)=t_tendf(i,k,j)
1897 enddo
1898 enddo
1899 enddo
1900
1901 do i=ims,ime
1902 do k=kms,kme
1903 do j=jms,jme
1904 do h=1 ,n_moist
1905 S_moist_tendf(i,k,j,h)=moist_tendf(i,k,j,h)
1906 ! P_moist_tendf(i,k,j,h)=moist_tendf(i,k,j,h)
1907 ! K_moist_tendf(i,k,j,h)=moist_tendf(i,k,j,h)
1908 enddo
1909 enddo
1910 enddo
1911 enddo
1912
1913 !NLM
1914
1915 CALL init_zero_tendency(ru_tendf, rv_tendf, rw_tendf, ph_tendf, &
1916 t_tendf, tke_tendf, &
1917 mu_tendf, &
1918 moist_tendf,chem_tendf,scalar_tendf, &
1919 n_moist,n_chem,n_scalar,rk_step, &
1920 ids, ide, jds, jde, kds, kde, &
1921 ims, ime, jms, jme, kms, kme, &
1922 its, ite, jts, jte, kts, kte )
1923
1924 do i=ims,ime
1925 do k=kms,kme
1926 do j=jms,jme
1927 B_ru_tendf(i,k,j)=ru_tendf(i,k,j)
1928 B_rv_tendf(i,k,j)=rv_tendf(i,k,j)
1929 B_rw_tendf(i,k,j)=rw_tendf(i,k,j)
1930 B_ph_tendf(i,k,j)=ph_tendf(i,k,j)
1931 B_t_tendf(i,k,j)=t_tendf(i,k,j)
1932 enddo
1933 enddo
1934 enddo
1935 do i=ims,ime
1936 do k=kms,kme
1937 do j=jms,jme
1938 do h=1 ,n_moist
1939 B_moist_tendf(i,k,j,h)=moist_tendf(i,k,j,h)
1940 enddo
1941 enddo
1942 enddo
1943 enddo
1944
1945 ! TGL
1946 CALL g_init_zero_tendency( ru_tendf, P_ru_tendf, rv_tendf, P_rv_tendf, rw_tendf, P_rw_tendf, ph_tendf, P_ph_tendf, t_tendf, &
1947 &P_t_tendf, moist_tendf, P_moist_tendf, &
1948 chem_tendf, P_chem_tendf, scalar_tendf, P_scalar_tendf,n_moist, n_chem, n_scalar, &
1949 ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
1950
1951 SAVE_L=0.
1952 do i=ims,ime
1953 do k=kms,kme
1954 do j=jms,jme
1955 SAVE_L=SAVE_L+ P_ru_tendf(i,k,j)*P_ru_tendf(i,k,j) &
1956 + P_rv_tendf(i,k,j)*P_rv_tendf(i,k,j) &
1957 + P_rw_tendf(i,k,j)*P_rw_tendf(i,k,j) &
1958 + P_ph_tendf(i,k,j)*P_ph_tendf(i,k,j) &
1959 + P_t_tendf(i,k,j)*P_t_tendf(i,k,j)
1960 enddo
1961 enddo
1962 enddo
1963 do i=ims,ime
1964 do k=kms,kme
1965 do j=jms,jme
1966 do h=1 ,n_moist
1967 SAVE_L=SAVE_L + P_moist_tendf(i,k,j,h)*P_moist_tendf(i,k,j,h)
1968 enddo
1969 enddo
1970 enddo
1971 enddo
1972
1973 ALPHA=1.
1974 DO NT=1,11
1975 ALPHA=0.1*ALPHA
1976 FACTOR=1.+ALPHA
1977
1978 do i=ims,ime
1979 do k=kms,kme
1980 do j=jms,jme
1981 ! P_ru_tendf(i,k,j)=FACTOR*S_ru_tendf(i,k,j)
1982 ! P_rv_tendf(i,k,j)=FACTOR*S_rv_tendf(i,k,j)
1983 ! P_rw_tendf(i,k,j)=FACTOR*S_rw_tendf(i,k,j)
1984 ! P_ph_tendf(i,k,j)=FACTOR*S_ph_tendf(i,k,j)
1985 ! P_t_tendf(i,k,j)=FACTOR*S_t_tendf(i,k,j)
1986 enddo
1987 enddo
1988 enddo
1989 do i=ims,ime
1990 do k=kms,kme
1991 do j=jms,jme
1992 do h=1 ,n_moist
1993 ! P_moist_tendf(i,k,j,h)=FACTOR*S_moist_tendf(i,k,j,h)
1994 enddo
1995 enddo
1996 enddo
1997 enddo
1998
1999 CALL init_zero_tendency(P_ru_tendf, P_rv_tendf, P_rw_tendf, P_ph_tendf, &
2000 P_t_tendf, tke_tendf, &
2001 mu_tendf, &
2002 P_moist_tendf,P_chem_tendf,p_scalar_tendf, &
2003 n_moist,n_chem,n_scalar,rk_step, &
2004 ids, ide, jds, jde, kds, kde, &
2005 ims, ime, jms, jme, kms, kme, &
2006 its, ite, jts, jte, kts, kte )
2007
2008 VAL_N=0.
2009 do i=ims,ime
2010 do k=kms,kme
2011 do j=jms,jme
2012 VAL_N=VAL_N +(P_ru_tendf(i,k,j)-B_ru_tendf(i,k,j))*(P_ru_tendf(i,k,j)-B_ru_tendf(i,k,j)) &
2013 +(P_rv_tendf(i,k,j)-B_rv_tendf(i,k,j))*(P_rv_tendf(i,k,j)-B_rv_tendf(i,k,j)) &
2014 +(P_rw_tendf(i,k,j)-B_rw_tendf(i,k,j))*(P_rw_tendf(i,k,j)-B_rw_tendf(i,k,j)) &
2015 +(P_ph_tendf(i,k,j)-B_ph_tendf(i,k,j))*(P_ph_tendf(i,k,j)-B_ph_tendf(i,k,j)) &
2016 +(P_t_tendf(i,k,j)-B_t_tendf(i,k,j))*(P_t_tendf(i,k,j)-B_t_tendf(i,k,j))
2017 enddo
2018 enddo
2019 enddo
2020 do i=ims,ime
2021 do k=kms,kme
2022 do j=jms,jme
2023 do h=1 ,n_moist
2024 VAL_N=VAL_N +(P_moist_tendf(i,k,j,h)-B_moist_tendf(i,k,j,h))*(P_moist_tendf(i,k,j,h)-B_moist_tendf(i,k,j,h))
2025 enddo
2026 enddo
2027 enddo
2028 enddo
2029
2030 VAL_L=SAVE_L*ALPHA**2
2031 if(VAL_L == 0.) then
2032 COEF = 1.
2033 else
2034 COEF=VAL_N/VAL_L
2035 endif
2036
2037 WRITE(6, fmt='(A,E9.4,A,E22.13,A,E13.6,A,E13.6)') &
2038 'g_init_zero_tendency: ALPHA=',ALPHA,' COEF=',COEF, &
2039 ' VAL_N=',VAL_N,' VAL_L=',VAL_L
2040 ENDDO
2041
2042 ! ADJ test
2043
2044 FACTOR=0.1
2045 do i=ims,ime
2046 do k=kms,kme
2047 do j=jms,jme
2048 ! ru_tendf(i,k,j)=S_ru_tendf(i,k,j)
2049 ! rv_tendf(i,k,j)=S_rv_tendf(i,k,j)
2050 ! rw_tendf(i,k,j)=S_rw_tendf(i,k,j)
2051 ! ph_tendf(i,k,j)=S_ph_tendf(i,k,j)
2052 ! t_tendf(i,k,j)=S_t_tendf(i,k,j)
2053
2054 ! P_ru_tendf(i,k,j)=FACTOR*S_ru_tendf(i,k,j)
2055 ! P_rv_tendf(i,k,j)=FACTOR*S_rv_tendf(i,k,j)
2056 ! P_rw_tendf(i,k,j)=FACTOR*S_rw_tendf(i,k,j)
2057 ! P_ph_tendf(i,k,j)=FACTOR*S_ph_tendf(i,k,j)
2058 ! P_t_tendf(i,k,j)=FACTOR*S_t_tendf(i,k,j)
2059
2060 ! B_ru_tendf(i,k,j)=P_ru_tendf(i,k,j)
2061 ! B_rv_tendf(i,k,j)=P_rv_tendf(i,k,j)
2062 ! B_rw_tendf(i,k,j)=P_rw_tendf(i,k,j)
2063 ! B_ph_tendf(i,k,j)=P_ph_tendf(i,k,j)
2064 ! B_t_tendf(i,k,j)=P_t_tendf(i,k,j)
2065 !
2066 enddo
2067 enddo
2068 enddo
2069 do i=ims,ime
2070 do k=kms,kme
2071 do j=jms,jme
2072 do h=1 ,n_moist
2073 ! moist_tendf(i,k,j,h)=S_moist_tendf(i,k,j,h)
2074 ! P_moist_tendf(i,k,j,h)=FACTOR*S_moist_tendf(i,k,j,h)
2075 ! B_moist_tendf(i,k,j,h)=P_moist_tendf(i,k,j,h)
2076 enddo
2077 enddo
2078 enddo
2079 enddo
2080
2081 ! TGL
2082 CALL g_init_zero_tendency( ru_tendf, P_ru_tendf, rv_tendf, P_rv_tendf, rw_tendf, P_rw_tendf, ph_tendf, P_ph_tendf, t_tendf, &
2083 &P_t_tendf, moist_tendf, P_moist_tendf, chem_tendf, P_chem_tendf,scalar_tendf, P_scalar_tendf, &
2084 n_moist, n_chem, n_scalar, &
2085 ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
2086
2087 VAL_L=0.
2088 do i=ims,ime
2089 do k=kms,kme
2090 do j=jms,jme
2091 VAL_L=VAL_L +P_ru_tendf(i,k,j)*P_ru_tendf(i,k,j) &
2092 +P_rv_tendf(i,k,j)*P_rv_tendf(i,k,j) &
2093 +P_rw_tendf(i,k,j)*P_rw_tendf(i,k,j) &
2094 +P_ph_tendf(i,k,j)*P_ph_tendf(i,k,j) &
2095 +P_t_tendf(i,k,j)*P_t_tendf(i,k,j)
2096 enddo
2097 enddo
2098 enddo
2099 do i=ims,ime
2100 do k=kms,kme
2101 do j=jms,jme
2102 do h=1 ,n_moist
2103 VAL_L=VAL_L +P_moist_tendf(i,k,j,h)*P_moist_tendf(i,k,j,h)
2104 enddo
2105 enddo
2106 enddo
2107 enddo
2108
2109 ! ADJ
2110
2111 CALL a_init_zero_tendency( P_ru_tendf, P_rv_tendf, P_rw_tendf, P_ph_tendf, P_t_tendf, p_tke_tendf, &
2112 P_moist_tendf, &
2113 P_chem_tendf,P_scalar_tendf, n_moist, n_chem, n_scalar, ims, ime, jms, &
2114 &jme, kms, kme, its, ite, jts, jte, kts, kte )
2115
2116 VAL_A=0.
2117 DO I=ims,ime
2118 DO K=kms,kme
2119 DO J=jms,jme
2120 ! VAL_A=VAL_A +P_ru_tendf(i,k,j)*B_ru_tendf(i,k,j) &
2121 ! +P_rv_tendf(i,k,j)*B_rv_tendf(i,k,j) &
2122 ! +P_rw_tendf(i,k,j)*B_rw_tendf(i,k,j) &
2123 ! +P_ph_tendf(i,k,j)*B_ph_tendf(i,k,j) &
2124 ! +P_t_tendf(i,k,j)*B_t_tendf(i,k,j)
2125 enddo
2126 enddo
2127 enddo
2128 do i=ims,ime
2129 do k=kms,kme
2130 do j=jms,jme
2131 do h=1 ,n_moist
2132 ! VAL_A=VAL_A +P_moist_tendf(i,k,j,h)*B_moist_tendf(i,k,j,h)
2133 enddo
2134 enddo
2135 enddo
2136 enddo
2137
2138 write(6,fmt='(A,2E22.13)') 'a_init_zero_tendency: ', VAL_L,VAL_A
2139
2140 ! RECOVER
2141
2142 do i=ims,ime
2143 do k=kms,kme
2144 do j=jms,jme
2145 ru_tendf(i,k,j)=S_ru_tendf(i,k,j)
2146 rv_tendf(i,k,j)=S_rv_tendf(i,k,j)
2147 rw_tendf(i,k,j)=S_rw_tendf(i,k,j)
2148 ph_tendf(i,k,j)=S_ph_tendf(i,k,j)
2149 t_tendf(i,k,j)=S_t_tendf(i,k,j)
2150 enddo
2151 enddo
2152 enddo
2153 do i=ims,ime
2154 do k=kms,kme
2155 do j=jms,jme
2156 do h=1 ,n_moist
2157 moist_tendf(i,k,j,h)=S_moist_tendf(i,k,j,h)
2158 enddo
2159 enddo
2160 enddo
2161 enddo
2162
2163 !g_init_zero_tendency: ALPHA=.1000E+00 COEF= 0.1000000953674E+01 VAL_N= 0.115569E-19 VAL_L= 0.115569E-19
2164 !g_init_zero_tendency: ALPHA=.1000E-01 COEF= 0.1000003337860E+01 VAL_N= 0.115569E-21 VAL_L= 0.115569E-21
2165 !g_init_zero_tendency: ALPHA=.1000E-02 COEF= 0.1000092029572E+01 VAL_N= 0.115579E-23 VAL_L= 0.115569E-23
2166 !g_init_zero_tendency: ALPHA=.1000E-03 COEF= 0.9997125864029E+00 VAL_N= 0.115536E-25 VAL_L= 0.115569E-25
2167 !g_init_zero_tendency: ALPHA=.1000E-04 COEF= 0.9984483122826E+00 VAL_N= 0.115389E-27 VAL_L= 0.115569E-27
2168 !g_init_zero_tendency: ALPHA=.1000E-05 COEF= 0.8998992443085E+00 VAL_N= 0.104000E-29 VAL_L= 0.115569E-29
2169 !g_init_zero_tendency: ALPHA=.1000E-06 COEF= 0.1599820733070E+01 VAL_N= 0.184889E-31 VAL_L= 0.115569E-31
2170 !g_init_zero_tendency: ALPHA=.1000E-07 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.115569E-33
2171 !g_init_zero_tendency: ALPHA=.1000E-08 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.115569E-35
2172 !g_init_zero_tendency: ALPHA=.1000E-09 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.115569E-37
2173 !g_init_zero_tendency: ALPHA=.1000E-10 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.115569E-39
2174
2175 !a_init_zero_tendency: 0.1155687153334E-19 0.1155687153334E-19
2176
2177 END SUBROUTINE t_init_zero_tendency
2178
2179 !------------------------------------------------------------------------------------------------------------
2180
2181 SUBROUTINE t_phy_prep ( config_flags, & ! input
2182 mu, u, v, p, pb, alt, ph, & ! input
2183 phb, t, tsk, moist, n_moist, & ! input
2184 mu_3d, rho, th_phy, p_phy , pi_phy , & ! output
2185 u_phy, v_phy, p8w, t_phy, t8w, & ! output
2186 z, z_at_w, dz8w, & ! output
2187 fzm, fzp, & ! params
2188 RTHRATEN, &
2189 RTHBLTEN, RUBLTEN, RVBLTEN, &
2190 RQVBLTEN, RQCBLTEN, RQIBLTEN, &
2191 RTHCUTEN, RQVCUTEN, RQCCUTEN, &
2192 RQRCUTEN, RQICUTEN, RQSCUTEN, &
2193 RTHFTEN, RQVFTEN, &
2194 ids, ide, jds, jde, kds, kde, &
2195 ims, ime, jms, jme, kms, kme, &
2196 its, ite, jts, jte, kts, kte )
2197
2198 IMPLICIT NONE
2199 !----------------------------------------------------------------------
2200
2201 TYPE(grid_config_rec_type) , INTENT(IN ) :: config_flags
2202
2203 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
2204 ims, ime, jms, jme, kms, kme, &
2205 its, ite, jts, jte, kts, kte
2206 INTEGER , INTENT(IN ) :: n_moist
2207
2208 REAL, DIMENSION( ims:ime, kms:kme , jms:jme , n_moist ), INTENT(IN) :: moist
2209
2210
2211 REAL , DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: TSK, mu
2212
2213 REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , &
2214 INTENT( OUT) :: u_phy, &
2215 v_phy, &
2216 pi_phy, &
2217 p_phy, &
2218 p8w, &
2219 t_phy, &
2220 th_phy, &
2221 t8w, &
2222 mu_3d, &
2223 rho, &
2224 z, &
2225 dz8w, &
2226 z_at_w
2227
2228 REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , &
2229 INTENT(IN ) :: pb, &
2230 u, &
2231 v, &
2232 alt, &
2233 phb
2234
2235 REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) :: p,ph,t
2236
2237 REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fzm, &
2238 fzp
2239
2240 REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), &
2241 INTENT(INOUT) :: RTHRATEN
2242
2243 REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), &
2244 INTENT(INOUT) :: RTHCUTEN, &
2245 RQVCUTEN, &
2246 RQCCUTEN, &
2247 RQRCUTEN, &
2248 RQICUTEN, &
2249 RQSCUTEN
2250
2251 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , &
2252 INTENT(INOUT) :: RUBLTEN, &
2253 RVBLTEN, &
2254 RTHBLTEN, &
2255 RQVBLTEN, &
2256 RQCBLTEN, &
2257 RQIBLTEN
2258
2259 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) , &
2260 INTENT(INOUT) :: RTHFTEN, &
2261 RQVFTEN
2262
2263 INTEGER :: i_start, i_end, j_start, j_end, k_start, k_end
2264 INTEGER :: i, j, k
2265 REAL :: w1, w2, z0, z1, z2
2266
2267 ! zzma: new definition
2268
2269 ! IN variables
2270
2271 REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) :: S_p, &
2272 S_ph, &
2273 S_t
2274 REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) :: P_p, &
2275 P_ph, &
2276 P_t
2277 REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) :: B_p, &
2278 B_ph, &
2279 B_t
2280 ! OUT variables
2281
2282 REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) :: P_pi_phy, &
2283 P_p_phy, &
2284 P_p8w, &
2285 P_t_phy, &
2286 P_th_phy, &
2287 P_t8w, &
2288 P_z, &
2289 P_z_at_w
2290 REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) :: B_pi_phy, &
2291 B_p_phy, &
2292 B_p8w, &
2293 B_t_phy, &
2294 B_th_phy, &
2295 B_t8w, &
2296 B_z, &
2297 B_z_at_w
2298
2299 REAL :: SAVE_L, COEF, ALPHA, FACTOR, VAL_N, VAL_L, VAL_A
2300 INTEGER :: NT
2301
2302 ! zzma: new definition end
2303
2304 !TGL test
2305
2306 do i=ims,ime
2307 do k=kms,kme
2308 do j=jms,jme
2309 S_p(i,k,j)=p(i,k,j)
2310 S_ph(i,k,j)=ph(i,k,j)
2311 S_t(i,k,j)=t(i,k,j)
2312
2313 P_p(i,k,j)=p(i,k,j)
2314 P_ph(i,k,j)=ph(i,k,j)
2315 P_t(i,k,j)=t(i,k,j)
2316 enddo
2317 enddo
2318 enddo
2319
2320 ! NLM
2321
2322 CALL phy_prep ( config_flags, & ! input
2323 mu, u, v, p, pb, alt, ph, & ! input
2324 phb, t, tsk, moist, n_moist, & ! input
2325 mu_3d, rho, th_phy, p_phy , pi_phy , & ! output
2326 u_phy, v_phy, p8w, t_phy, t8w, & ! output
2327 z, z_at_w, dz8w, & ! output
2328 fzm, fzp, & ! params
2329 RTHRATEN, &
2330 RTHBLTEN, RUBLTEN, RVBLTEN, &
2331 RQVBLTEN, RQCBLTEN, RQIBLTEN, &
2332 RTHCUTEN, RQVCUTEN, RQCCUTEN, &
2333 RQRCUTEN, RQICUTEN, RQSCUTEN, &
2334 RTHFTEN, RQVFTEN, &
2335 ids, ide, jds, jde, kds, kde, &
2336 ims, ime, jms, jme, kms, kme, &
2337 its, ite, jts, jte, kts, kte )
2338
2339
2340 do i=ims,ime
2341 do k=kms,kme
2342 do j=jms,jme
2343 B_pi_phy(i,k,j)=pi_phy(i,k,j)
2344 B_p_phy(i,k,j)=p_phy(i,k,j)
2345 B_p8w(i,k,j)=p8w(i,k,j)
2346 B_t_phy(i,k,j)=t_phy(i,k,j)
2347 B_th_phy(i,k,j)=th_phy(i,k,j)
2348 B_t8w(i,k,j)=t8w(i,k,j)
2349 B_z(i,k,j)=z(i,k,j)
2350 B_z_at_w(i,k,j)=z_at_w(i,k,j)
2351 enddo
2352 enddo
2353 enddo
2354
2355 ! TGL
2356
2357 CALL g_phy_prep( p, P_p, pb, ph, P_ph, phb, t, P_t, mu_3d, rho, th_phy, P_th_phy, p_phy, P_p_phy, pi_phy, P_pi_phy, u_phy, &
2358 &v_phy, p8w, P_p8w, t_phy, P_t_phy, t8w, P_t8w, z, P_z, z_at_w, P_z_at_w, dz8w, fzm, fzp, rthraten, rthblten, rublten, rvblten, &
2359 &rqvblten, rqcblten, rqiblten, rthcuten, rqvcuten, rqccuten, rqrcuten, rqicuten, rqscuten, rthften, rqvften, ide, jde, kde, ims, &
2360 &ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
2361
2362 SAVE_L=0.
2363 do i=ims,ime
2364 do k=kms,kme
2365 do j=jms,jme
2366 SAVE_L=SAVE_L + P_pi_phy(i,k,j)*P_pi_phy(i,k,j) &
2367 + P_p_phy(i,k,j)*P_p_phy(i,k,j) &
2368 + P_p8w(i,k,j)*P_p8w(i,k,j) &
2369 + P_t_phy(i,k,j)*P_t_phy(i,k,j) &
2370 + P_th_phy(i,k,j)*P_th_phy(i,k,j) &
2371 + P_t8w(i,k,j)*P_t8w(i,k,j) &
2372 + P_z(i,k,j)*P_z(i,k,j) &
2373 + P_z_at_w(i,k,j)*P_z_at_w(i,k,j)
2374
2375 enddo
2376 enddo
2377 enddo
2378
2379 ALPHA=1.
2380 DO NT=1,11
2381 ALPHA=0.1*ALPHA
2382 FACTOR=1.+ALPHA
2383 do i=ims,ime
2384 do k=kms,kme
2385 do j=jms,jme
2386 P_p(i,k,j)=FACTOR*S_p(i,k,j)
2387 P_ph(i,k,j)=FACTOR*S_ph(i,k,j)
2388 P_t(i,k,j)=FACTOR*S_t(i,k,j)
2389 enddo
2390 enddo
2391 enddo
2392 CALL phy_prep ( config_flags, & ! input
2393 mu, u, v, P_p, pb, alt, P_ph, & ! input
2394 phb, P_t, tsk, moist, n_moist, & ! input
2395 mu_3d, rho, P_th_phy, P_p_phy , P_pi_phy , & ! output
2396 u_phy, v_phy, P_p8w, P_t_phy, P_t8w, & ! output
2397 P_z, P_z_at_w, dz8w, & ! output
2398 fzm, fzp, & ! params
2399 RTHRATEN, &
2400 RTHBLTEN, RUBLTEN, RVBLTEN, &
2401 RQVBLTEN, RQCBLTEN, RQIBLTEN, &
2402 RTHCUTEN, RQVCUTEN, RQCCUTEN, &
2403 RQRCUTEN, RQICUTEN, RQSCUTEN, &
2404 RTHFTEN, RQVFTEN, &
2405 ids, ide, jds, jde, kds, kde, &
2406 ims, ime, jms, jme, kms, kme, &
2407 its, ite, jts, jte, kts, kte )
2408
2409 VAL_N=0.
2410 do i=ims,ime
2411 do k=kms,kme
2412 do j=jms,jme
2413 VAL_N=VAL_N + (P_pi_phy(i,k,j)-B_pi_phy(i,k,j))*(P_pi_phy(i,k,j)-B_pi_phy(i,k,j)) &
2414 + (P_p_phy(i,k,j)-B_p_phy(i,k,j))*(P_p_phy(i,k,j)-B_p_phy(i,k,j)) &
2415 + (P_p8w(i,k,j)-B_p8w(i,k,j))*(P_p8w(i,k,j)-B_p8w(i,k,j)) &
2416 + (P_t_phy(i,k,j)-B_t_phy(i,k,j))*(P_t_phy(i,k,j)-B_t_phy(i,k,j)) &
2417 + (P_th_phy(i,k,j)-B_th_phy(i,k,j))*(P_th_phy(i,k,j)-B_th_phy(i,k,j)) &
2418 + (P_t8w(i,k,j)-B_t8w(i,k,j))*(P_t8w(i,k,j)-B_t8w(i,k,j)) &
2419 + (P_z(i,k,j)-B_z(i,k,j))*(P_z(i,k,j)-B_z(i,k,j)) &
2420 + (P_z_at_w(i,k,j)-B_z_at_w(i,k,j))*(P_z_at_w(i,k,j)-B_z_at_w(i,k,j))
2421
2422
2423 enddo
2424 enddo
2425 enddo
2426
2427 VAL_L=SAVE_L*ALPHA**2
2428 COEF=VAL_N/VAL_L
2429 WRITE(6, fmt='(A,E9.4,A,E22.13,A,E13.6,A,E13.6)') &
2430 'g_phy_prep: ALPHA=',ALPHA,' COEF=',COEF, &
2431 ' VAL_N=',VAL_N,' VAL_L=',VAL_L
2432 ENDDO
2433
2434 ! ADJ test
2435
2436 FACTOR=0.1
2437 do i=ims,ime
2438 do k=kms,kme
2439 do j=jms,jme
2440 p(i,k,j)=S_p(i,k,j)
2441 ph(i,k,j)=S_ph(i,k,j)
2442 t(i,k,j)=S_t(i,k,j)
2443
2444 P_p(i,k,j)=FACTOR*S_p(i,k,j)
2445 P_ph(i,k,j)=FACTOR*S_ph(i,k,j)
2446 P_t(i,k,j)=FACTOR*S_t(i,k,j)
2447
2448 B_p(i,k,j)=P_p(i,k,j)
2449 B_ph(i,k,j)=P_ph(i,k,j)
2450 B_t(i,k,j)=P_t(i,k,j)
2451 enddo
2452 enddo
2453 enddo
2454
2455 ! TGL
2456
2457 CALL g_phy_prep( p, P_p, pb, ph, P_ph, phb, t, P_t, mu_3d, rho, th_phy, P_th_phy, p_phy, P_p_phy, pi_phy, P_pi_phy, u_phy, &
2458 &v_phy, p8w, P_p8w, t_phy, P_t_phy, t8w, P_t8w, z, P_z, z_at_w, P_z_at_w, dz8w, fzm, fzp, rthraten, rthblten, rublten, rvblten, &
2459 &rqvblten, rqcblten, rqiblten, rthcuten, rqvcuten, rqccuten, rqrcuten, rqicuten, rqscuten, rthften, rqvften, ide, jde, kde, ims, &
2460 &ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
2461
2462 VAL_L=0.
2463 do i=ims,ime
2464 do k=kms,kme
2465 do j=jms,jme
2466 VAL_L=VAL_L + P_pi_phy(i,k,j)*P_pi_phy(i,k,j) &
2467 + P_p_phy(i,k,j)*P_p_phy(i,k,j) &
2468 + P_p8w(i,k,j)*P_p8w(i,k,j) &
2469 + P_t_phy(i,k,j)*P_t_phy(i,k,j) &
2470 + P_th_phy(i,k,j)*P_th_phy(i,k,j) &
2471 + P_t8w(i,k,j)*P_t8w(i,k,j) &
2472 + P_z(i,k,j)*P_z(i,k,j) &
2473 + P_z_at_w(i,k,j)*P_z_at_w(i,k,j)
2474
2475 enddo
2476 enddo
2477 enddo
2478
2479 do i=ims,ime
2480 do k=kms,kme
2481 do j=jms,jme
2482 P_p(i,k,j)=0.0
2483 P_ph(i,k,j)=0.0
2484 P_t(i,k,j)=0.0
2485 enddo
2486 enddo
2487 enddo
2488
2489 ! ADJ
2490 call a_phy_prep( p, P_p, pb, ph, P_ph, phb, t, P_t, th_phy, P_th_phy, p_phy, P_p_phy, pi_phy, P_pi_phy, P_p8w, t_phy, &
2491 &P_t_phy, P_t8w, z, P_z, z_at_w, P_z_at_w, fzm, fzp, ide, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
2492
2493 VAL_A=0.
2494 DO I=ims,ime
2495 DO K=kms,kme
2496 DO J=jms,jme
2497 VAL_A=VAL_A + P_p(i,k,j)*B_p(i,k,j) &
2498 + P_ph(i,k,j)*B_ph(i,k,j) &
2499 + P_t(i,k,j)*B_t(i,k,j)
2500
2501 enddo
2502 enddo
2503 enddo
2504
2505 write(6,fmt='(A,2E22.13)') 'a_phy_prep: ', VAL_L,VAL_A
2506
2507 ! RECOVER
2508
2509 do i=ims,ime
2510 do k=kms,kme
2511 do j=jms,jme
2512 p(i,k,j)=S_p(i,k,j)
2513 ph(i,k,j)=S_ph(i,k,j)
2514 t(i,k,j)=S_t(i,k,j)
2515 enddo
2516 enddo
2517 enddo
2518
2519 !g_phy_prep: ALPHA=.1000E+00 COEF= 0.1000007867813E+01 VAL_N= 0.283924E+08 VAL_L= 0.283921E+08
2520 !g_phy_prep: ALPHA=.1000E-01 COEF= 0.1000007271767E+01 VAL_N= 0.283923E+06 VAL_L= 0.283921E+06
2521 !g_phy_prep: ALPHA=.1000E-02 COEF= 0.9970672726631E+00 VAL_N= 0.283089E+04 VAL_L= 0.283921E+04
2522 !g_phy_prep: ALPHA=.1000E-03 COEF= 0.9730178117752E+00 VAL_N= 0.276261E+02 VAL_L= 0.283921E+02
2523 !g_phy_prep: ALPHA=.1000E-04 COEF= 0.2119694232941E+01 VAL_N= 0.601827E+00 VAL_L= 0.283921E+00
2524 !g_phy_prep: ALPHA=.1000E-05 COEF= 0.9598098397255E+00 VAL_N= 0.272511E-02 VAL_L= 0.283921E-02
2525 !g_phy_prep: ALPHA=.1000E-06 COEF= 0.9365414977074E+00 VAL_N= 0.265904E-04 VAL_L= 0.283921E-04
2526 !g_phy_prep: ALPHA=.1000E-07 COEF= 0.4753468885871E-11 VAL_N= 0.134961E-17 VAL_L= 0.283921E-06
2527 !g_phy_prep: ALPHA=.1000E-08 COEF= 0.4753468729746E-09 VAL_N= 0.134961E-17 VAL_L= 0.283921E-08
2528 !g_phy_prep: ALPHA=.1000E-09 COEF= 0.4753468019203E-07 VAL_N= 0.134961E-17 VAL_L= 0.283922E-10
2529 !g_phy_prep: ALPHA=.1000E-10 COEF= 0.4753467692353E-05 VAL_N= 0.134961E-17 VAL_L= 0.283922E-12
2530
2531 !a_phy_prep: 0.2839517000000E+08 0.2839852400000E+08
2532
2533
2534 END SUBROUTINE t_phy_prep
2535
2536 !------------------------------------------------------------------------------------------------------
2537
2538 SUBROUTINE t_calculate_km_kh( config_flags, dt, &
2539 dampcoef, zdamp, damp_opt, &
2540 xkmh, xkmhd, xkmv, xkhh, xkhv, &
2541 BN2, khdif, kvdif, div, &
2542 defor11, defor22, defor33, &
2543 defor12, defor13, defor23, &
2544 tke, p8w, t8w, theta, t, p, moist, &
2545 dn, dnw, dx, dy, rdz, rdzw, cr_len, &
2546 n_moist, cf1, cf2, cf3, warm_rain, &
2547 kh_tke_upper_bound, kv_tke_upper_bound, &
2548 ids, ide, jds, jde, kds, kde, &
2549 ims, ime, jms, jme, kms, kme, &
2550 its, ite, jts, jte, kts, kte )
2551
2552 IMPLICIT NONE
2553
2554 TYPE( grid_config_rec_type ), INTENT( IN ) &
2555 :: config_flags
2556
2557 INTEGER, INTENT( IN ) &
2558 :: n_moist, damp_opt, &
2559 ids, ide, jds, jde, kds, kde, &
2560 ims, ime, jms, jme, kms, kme, &
2561 its, ite, jts, jte, kts, kte
2562
2563 LOGICAL, INTENT( IN ) &
2564 :: warm_rain
2565
2566 REAL, INTENT( IN ) &
2567 :: cr_len, dx, dy, zdamp, dt, dampcoef, cf1, cf2, cf3, khdif, kvdif
2568
2569 REAL, DIMENSION( kms:kme ), INTENT( IN ) &
2570 :: dnw, dn
2571
2572 REAL, DIMENSION( ims:ime, kms:kme, jms:jme, n_moist ) :: moist
2573
2574 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT ) &
2575 :: xkmv, xkmh, xkhv, xkhh
2576
2577 REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), INTENT( IN ) &
2578 :: defor11, defor22, defor33, defor12, defor13, defor23, &
2579 div, rdz, rdzw
2580
2581 REAL, DIMENSION( ims:ime , kms:kme, jms:jme ) :: p8w, t8w, theta, t, p,xkmhd,BN2
2582
2583 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT( INOUT ) &
2584 :: tke
2585
2586 REAL, INTENT( IN ) &
2587 :: kh_tke_upper_bound, kv_tke_upper_bound
2588
2589 ! Local variables.
2590
2591 INTEGER &
2592 :: i_start, i_end, j_start, j_end, ktf, i, j, k
2593
2594 ! zzma: new definition
2595
2596 ! IN variables
2597
2598 REAL, DIMENSION( ims:ime , kms:kme, jms:jme ) :: S_p8w, S_t8w, S_theta, S_t, S_p
2599 REAL, DIMENSION( ims:ime , kms:kme, jms:jme ) :: P_p8w, P_t8w, P_theta, P_t, P_p
2600 REAL, DIMENSION( ims:ime , kms:kme, jms:jme ) :: B_p8w, B_t8w, B_theta, B_t, B_p
2601
2602 ! INOUT variables
2603
2604 REAL, DIMENSION( ims:ime, kms:kme, jms:jme, n_moist ) :: S_moist,P_moist,B_moist,K_moist
2605
2606 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) :: S_xkmhd,S_BN2,P_xkmhd,P_BN2,B_xkmhd,B_BN2,K_xkmhd,K_BN2
2607
2608 REAL :: SAVE_L, COEF, ALPHA, FACTOR, VAL_N, VAL_L, VAL_A
2609 INTEGER :: NT,h
2610
2611 ! zzma: new definition end
2612
2613 ! TGL test
2614
2615 do i=ims,ime
2616 do k=kms,kme
2617 do j=jms,jme
2618 S_p8w(i,k,j)=p8w(i,k,j)
2619 S_t8w(i,k,j)=t8w(i,k,j)
2620 S_theta(i,k,j)=theta(i,k,j)
2621 S_t(i,k,j)=t(i,k,j)
2622 S_p(i,k,j)=p(i,k,j)
2623
2624 P_p8w(i,k,j)=p8w(i,k,j)
2625 P_t8w(i,k,j)=t8w(i,k,j)
2626 P_theta(i,k,j)=theta(i,k,j)
2627 P_t(i,k,j)=t(i,k,j)
2628 P_p(i,k,j)=p(i,k,j)
2629 enddo
2630 enddo
2631 enddo
2632
2633 do i=ims,ime
2634 do k=kms,kme
2635 do j=jms,jme
2636 do h=1 ,n_moist
2637 S_moist(i,k,j,h)=moist(i,k,j,h)
2638
2639 P_moist(i,k,j,h)=moist(i,k,j,h)
2640
2641 K_moist(i,k,j,h)=moist(i,k,j,h)
2642 enddo
2643 enddo
2644 enddo
2645 enddo
2646
2647 do i=ims,ime
2648 do k=kms,kme
2649 do j=jms,jme
2650 S_xkmhd(i,k,j)=xkmhd(i,k,j)
2651 S_bn2(i,k,j)=bn2(i,k,j)
2652
2653 P_xkmhd(i,k,j)=xkmhd(i,k,j)
2654 P_bn2(i,k,j)=bn2(i,k,j)
2655
2656 K_xkmhd(i,k,j)=xkmhd(i,k,j)
2657 K_bn2(i,k,j)=bn2(i,k,j)
2658 enddo
2659 enddo
2660 enddo
2661
2662 ! NLM
2663 CALL calculate_km_kh( config_flags, dt, &
2664 dampcoef, zdamp, damp_opt, &
2665 xkmh, xkmhd, xkmv, xkhh, xkhv, &
2666 BN2, khdif, kvdif, div, &
2667 defor11, defor22, defor33, &
2668 defor12, defor13, defor23, &
2669 tke, p8w, t8w, theta, t, p, moist, &
2670 dn, dnw, dx, dy, rdz, rdzw, cr_len, &
2671 n_moist, cf1, cf2, cf3, warm_rain, &
2672 kh_tke_upper_bound, kv_tke_upper_bound, &
2673 ids, ide, jds, jde, kds, kde, &
2674 ims, ime, jms, jme, kms, kme, &
2675 its, ite, jts, jte, kts, kte )
2676 do i=ims,ime
2677 do k=kms,kme
2678 do j=jms,jme
2679 do h=1 ,n_moist
2680 B_moist(i,k,j,h)=moist(i,k,j,h)
2681 enddo
2682 enddo
2683 enddo
2684 enddo
2685
2686 do i=ims,ime
2687 do k=kms,kme
2688 do j=jms,jme
2689 B_xkmhd(i,k,j)=xkmhd(i,k,j)
2690 B_bn2(i,k,j)=bn2(i,k,j)
2691 enddo
2692 enddo
2693 enddo
2694
2695 ! TGL
2696 CALL g_calculate_km_kh( config_flags, dt, dampcoef, zdamp, damp_opt, xkmh, K_xkmhd, P_xkmhd, xkmv, xkhh, xkhv, K_bn2, P_bn2, &
2697 &khdif, defor11, defor22, defor33, defor12, defor13, defor23, tke, p8w, P_p8w, t8w, P_t8w, theta, P_theta, t, P_t, p, P_p, K_moist, &
2698 &P_moist, dx, dy, rdz, rdzw, n_moist, cf1, cf2, cf3, kh_tke_upper_bound, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, &
2699 &its, ite, jts, jte, kts, kte )
2700
2701 SAVE_L=0.
2702 do i=ims,ime
2703 do k=kms,kme
2704 do j=jms,jme
2705 do h=1 ,n_moist
2706 SAVE_L=SAVE_L+P_moist(i,k,j,h)*P_moist(i,k,j,h)
2707 enddo
2708 enddo
2709 enddo
2710 enddo
2711
2712 do i=ims,ime
2713 do k=kms,kme
2714 do j=jms,jme
2715 SAVE_L=SAVE_L+P_xkmhd(i,k,j)*P_xkmhd(i,k,j) +P_bn2(i,k,j)*P_bn2(i,k,j)
2716 enddo
2717 enddo
2718 enddo
2719
2720 ALPHA=1.
2721 DO NT=1,11
2722 ALPHA=0.1*ALPHA
2723 FACTOR=1.+ALPHA
2724 do i=ims,ime
2725 do k=kms,kme
2726 do j=jms,jme
2727 P_p8w(i,k,j)=FACTOR*S_p8w(i,k,j)
2728 P_t8w(i,k,j)=FACTOR*S_t8w(i,k,j)
2729 P_theta(i,k,j)=FACTOR*S_theta(i,k,j)
2730 P_t(i,k,j)=FACTOR*S_t(i,k,j)
2731 P_p(i,k,j)=FACTOR*S_p(i,k,j)
2732 enddo
2733 enddo
2734 enddo
2735 do i=ims,ime
2736 do k=kms,kme
2737 do j=jms,jme
2738 do h=1 ,n_moist
2739 P_moist(i,k,j,h)=FACTOR*S_moist(i,k,j,h)
2740 enddo
2741 enddo
2742 enddo
2743 enddo
2744 do i=ims,ime
2745 do k=kms,kme
2746 do j=jms,jme
2747 P_xkmhd(i,k,j)=FACTOR*S_xkmhd(i,k,j)
2748 P_bn2(i,k,j)=FACTOR*S_bn2(i,k,j)
2749 enddo
2750 enddo
2751 enddo
2752
2753 CALL calculate_km_kh( config_flags, dt, &
2754 dampcoef, zdamp, damp_opt, &
2755 xkmh, P_xkmhd, xkmv, xkhh, xkhv, &
2756 P_BN2, khdif, kvdif, div, &
2757 defor11, defor22, defor33, &
2758 defor12, defor13, defor23, &
2759 tke, P_p8w, P_t8w, P_theta, P_t, P_p, P_moist, &
2760 dn, dnw, dx, dy, rdz, rdzw, cr_len, &
2761 n_moist, cf1, cf2, cf3, warm_rain, &
2762 kh_tke_upper_bound, kv_tke_upper_bound, &
2763 ids, ide, jds, jde, kds, kde, &
2764 ims, ime, jms, jme, kms, kme, &
2765 its, ite, jts, jte, kts, kte )
2766 VAL_N=0.
2767 do i=ims,ime
2768 do k=kms,kme
2769 do j=jms,jme
2770 do h=1 ,n_moist
2771 VAL_N=VAL_N+(P_moist(i,k,j,h)-B_moist(i,k,j,h))*(P_moist(i,k,j,h)-B_moist(i,k,j,h))
2772 enddo
2773 enddo
2774 enddo
2775 enddo
2776
2777 do i=ims,ime
2778 do k=kms,kme
2779 do j=jms,jme
2780 VAL_N=VAL_N + (P_xkmhd(i,k,j)-B_xkmhd(i,k,j))*(P_xkmhd(i,k,j)-B_xkmhd(i,k,j)) &
2781 + (P_bn2(i,k,j) -B_bn2(i,k,j))*(P_bn2(i,k,j) -B_bn2(i,k,j))
2782 enddo
2783 enddo
2784 enddo
2785
2786 VAL_L=SAVE_L*ALPHA**2
2787 COEF=VAL_N/VAL_L
2788 WRITE(6, fmt='(A,E9.4,A,E22.13,A,E13.6,A,E13.6)') &
2789 'g_calculate_km_kh: ALPHA=',ALPHA,' COEF=',COEF, &
2790 ' VAL_N=',VAL_N,' VAL_L=',VAL_L
2791 ENDDO
2792
2793 ! ADJ test
2794
2795 FACTOR=0.1
2796 do i=ims,ime
2797 do k=kms,kme
2798 do j=jms,jme
2799 p8w(i,k,j)=S_p8w(i,k,j)
2800 t8w(i,k,j)=S_t8w(i,k,j)
2801 theta(i,k,j)=S_theta(i,k,j)
2802 t(i,k,j)=S_t(i,k,j)
2803 p(i,k,j)=S_p(i,k,j)
2804
2805 P_p8w(i,k,j)=FACTOR*S_p8w(i,k,j)
2806 P_t8w(i,k,j)=FACTOR*S_t8w(i,k,j)
2807 P_theta(i,k,j)=FACTOR*S_theta(i,k,j)
2808 P_t(i,k,j)=FACTOR*S_t(i,k,j)
2809 P_p(i,k,j)=FACTOR*S_p(i,k,j)
2810
2811 B_p8w(i,k,j)=P_p8w(i,k,j)
2812 B_t8w(i,k,j)=P_t8w(i,k,j)
2813 B_theta(i,k,j)=P_theta(i,k,j)
2814 B_t(i,k,j)=P_t(i,k,j)
2815 B_p(i,k,j)=P_p(i,k,j)
2816 enddo
2817 enddo
2818 enddo
2819 do i=ims,ime
2820 do k=kms,kme
2821 do j=jms,jme
2822 do h=1 ,n_moist
2823 moist(i,k,j,h)=S_moist(i,k,j,h)
2824 K_moist(i,k,j,h)=S_moist(i,k,j,h)
2825
2826 P_moist(i,k,j,h)=FACTOR*S_moist(i,k,j,h)
2827
2828 B_moist(i,k,j,h)=P_moist(i,k,j,h)
2829 enddo
2830 enddo
2831 enddo
2832 enddo
2833
2834 do i=ims,ime
2835 do k=kms,kme
2836 do j=jms,jme
2837 xkmhd(i,k,j)=S_xkmhd(i,k,j)
2838 bn2(i,k,j)=S_bn2(i,k,j)
2839 K_xkmhd(i,k,j)=S_xkmhd(i,k,j)
2840 K_bn2(i,k,j)=S_bn2(i,k,j)
2841
2842 P_xkmhd(i,k,j)=FACTOR*S_xkmhd(i,k,j)
2843 P_bn2(i,k,j)=FACTOR*S_bn2(i,k,j)
2844
2845 B_xkmhd(i,k,j)=P_xkmhd(i,k,j)
2846 B_bn2(i,k,j)=P_bn2(i,k,j)
2847 enddo
2848 enddo
2849 enddo
2850
2851 ! TGL
2852
2853 CALL g_calculate_km_kh( config_flags, dt, dampcoef, zdamp, damp_opt, xkmh, xkmhd, P_xkmhd, xkmv, xkhh, xkhv, bn2, P_bn2, &
2854 &khdif, defor11, defor22, defor33, defor12, defor13, defor23, tke, p8w, P_p8w, t8w, P_t8w, theta, P_theta, t, P_t, p, P_p, moist, &
2855 &P_moist, dx, dy, rdz, rdzw, n_moist, cf1, cf2, cf3, kh_tke_upper_bound, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, &
2856 &its, ite, jts, jte, kts, kte )
2857
2858 VAL_L=0.
2859 do i=ims,ime
2860 do k=kms,kme
2861 do j=jms,jme
2862 ! VAL_L=VAL_L + P_p8w(i,k,j)*P_p8w(i,k,j) &
2863 ! + P_t8w(i,k,j)*P_t8w(i,k,j) &
2864 ! + P_theta(i,k,j)*P_theta(i,k,j) &
2865 ! + P_t(i,k,j)*P_t(i,k,j) &
2866 ! + P_p(i,k,j)*P_p(i,k,j)
2867 enddo
2868 enddo
2869 enddo
2870 do i=ims,ime
2871 do k=kms,kme
2872 do j=jms,jme
2873 do h=1 ,n_moist
2874 VAL_L=VAL_L+P_moist(i,k,j,h)*P_moist(i,k,j,h)
2875 enddo
2876 enddo
2877 enddo
2878 enddo
2879
2880 do i=ims,ime
2881 do k=kms,kme
2882 do j=jms,jme
2883 VAL_L=VAL_L+P_xkmhd(i,k,j)*P_xkmhd(i,k,j) +P_bn2(i,k,j)*P_bn2(i,k,j)
2884 enddo
2885 enddo
2886 enddo
2887
2888 do i=ims,ime
2889 do k=kms,kme
2890 do j=jms,jme
2891 P_p8w(i,k,j)=0.0
2892 P_t8w(i,k,j)=0.0
2893 P_theta(i,k,j)=0.0
2894 P_t(i,k,j)=0.0
2895 P_p(i,k,j)=0.0
2896 enddo
2897 enddo
2898 enddo
2899
2900 ! ADJ
2901
2902 call a_calculate_km_kh( config_flags, dt, dampcoef, zdamp, damp_opt, xkmh, K_xkmhd, P_xkmhd, xkmv, xkhh, xkhv, K_bn2, P_bn2, &
2903 &khdif, div, defor11, defor22, defor33, defor12, defor13, defor23, tke, p8w, P_p8w, t8w, P_t8w, theta, P_theta, t, P_t, p, P_p, &
2904 &K_moist, P_moist, dn, dnw, dx, dy, rdz, rdzw, n_moist, cf1, cf2, cf3, kh_tke_upper_bound, ids, ide, jds, jde, kde, ims, ime, jms, &
2905 &jme, kms, kme, its, ite, jts, jte, kts, kte )
2906
2907 VAL_A=0.
2908 DO I=ims,ime
2909 DO K=kms,kme
2910 DO J=jms,jme
2911 VAL_A=VAL_A + P_p8w(i,k,j)*B_p8w(i,k,j) &
2912 + P_t8w(i,k,j)*B_t8w(i,k,j) &
2913 + P_theta(i,k,j)*B_theta(i,k,j) &
2914 + P_t(i,k,j) *B_t(i,k,j) &
2915 + P_p(i,k,j) *B_p(i,k,j)
2916 END DO
2917 END DO
2918 END DO
2919
2920 do i=ims,ime
2921 do k=kms,kme
2922 do j=jms,jme
2923 do h=1 ,n_moist
2924 VAL_A=VAL_A + P_moist(i,k,j,h)*B_moist(i,k,j,h)
2925 enddo
2926 enddo
2927 enddo
2928 enddo
2929
2930 do i=ims,ime
2931 do k=kms,kme
2932 do j=jms,jme
2933 VAL_A=VAL_A + P_xkmhd(i,k,j)*B_xkmhd(i,k,j) +P_bn2(i,k,j)*B_bn2(i,k,j)
2934 enddo
2935 enddo
2936 enddo
2937
2938
2939 write(6,fmt='(A,2E22.13)') 'a_calculate_km_kh: ', VAL_L,VAL_A
2940
2941 ! RECOVER
2942
2943
2944 do i=ims,ime
2945 do k=kms,kme
2946 do j=jms,jme
2947 p8w(i,k,j)=S_p8w(i,k,j)
2948 t8w(i,k,j)=S_t8w(i,k,j)
2949 theta(i,k,j)=S_theta(i,k,j)
2950 t(i,k,j)=S_t(i,k,j)
2951 p(i,k,j)=S_p(i,k,j)
2952
2953 enddo
2954 enddo
2955 enddo
2956 do i=ims,ime
2957 do k=kms,kme
2958 do j=jms,jme
2959 do h=1 ,n_moist
2960 moist(i,k,j,h)=S_moist(i,k,j,h)
2961 enddo
2962 enddo
2963 enddo
2964 enddo
2965
2966 do i=ims,ime
2967 do k=kms,kme
2968 do j=jms,jme
2969 xkmhd(i,k,j)=S_xkmhd(i,k,j)
2970 bn2(i,k,j)=S_bn2(i,k,j)
2971 enddo
2972 enddo
2973 enddo
2974
2975 !g_calculate_km_kh: ALPHA=.1000E+00 COEF= 0.3474252223969E+01 VAL_N= 0.534163E-01 VAL_L= 0.153749E-01
2976 !g_calculate_km_kh: ALPHA=.1000E-01 COEF= 0.1000073671341E+01 VAL_N= 0.153760E-03 VAL_L= 0.153749E-03
2977 !g_calculate_km_kh: ALPHA=.1000E-02 COEF= 0.1000226140022E+01 VAL_N= 0.153784E-05 VAL_L= 0.153749E-05
2978 !g_calculate_km_kh: ALPHA=.1000E-03 COEF= 0.1000114679337E+01 VAL_N= 0.153767E-07 VAL_L= 0.153749E-07
2979 !g_calculate_km_kh: ALPHA=.1000E-04 COEF= 0.1005010604858E+01 VAL_N= 0.154519E-09 VAL_L= 0.153749E-09
2980 !g_calculate_km_kh: ALPHA=.1000E-05 COEF= 0.8787735104561E+00 VAL_N= 0.135111E-11 VAL_L= 0.153749E-11
2981 !g_calculate_km_kh: ALPHA=.1000E-06 COEF= 0.1789559841156E+01 VAL_N= 0.275143E-13 VAL_L= 0.153749E-13
2982 !g_calculate_km_kh: ALPHA=.1000E-07 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.153749E-15
2983 !g_calculate_km_kh: ALPHA=.1000E-08 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.153749E-17
2984 !g_calculate_km_kh: ALPHA=.1000E-09 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.153749E-19
2985 !g_calculate_km_kh: ALPHA=.1000E-10 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.153749E-21
2986
2987 !a_calculate_km_kh: 0.1537548657507E-01 0.1537548657507E-01
2988
2989 END SUBROUTINE t_calculate_km_kh
2990
2991 !--------------------------------------------------------------------------------------------------------
2992
2993 SUBROUTINE t_relax_bdy_dry ( config_flags, &
2994 ru_tendf, rv_tendf, ph_tendf, t_tendf, &
2995 rw_tendf, mu_tend, &
2996 ru, rv, ph, t, &
2997 w, mu, mut, &
2998 u_b, v_b, ph_b, t_b, &
2999 w_b, mu_b, &
3000 u_bt, v_bt, ph_bt, t_bt, &
3001 w_bt, mu_bt, &
3002 spec_bdy_width, spec_zone, relax_zone, &
3003 dtbc, fcx, gcx, &
3004 ijds, ijde, & ! min/max(id,jd)
3005 ids,ide, jds,jde, kds,kde, & ! domain dims
3006 ims,ime, jms,jme, kms,kme, & ! memory dims
3007 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
3008 its, ite, jts, jte, kts, kte)
3009
3010 ! Zaizhong Ma, March 24,2005
3011
3012 IMPLICIT NONE
3013
3014 ! Input data.
3015 TYPE( grid_config_rec_type ) config_flags
3016
3017 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
3018 ims, ime, jms, jme, kms, kme, &
3019 ips, ipe, jps, jpe, kps, kpe, &
3020 its, ite, jts, jte, kts, kte
3021 INTEGER , INTENT(IN ) :: ijds, ijde
3022 INTEGER , INTENT(IN ) :: spec_bdy_width, spec_zone, relax_zone
3023
3024 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: ru, &
3025 rv, &
3026 ph, &
3027 w, &
3028 t
3029 REAL , DIMENSION( ims:ime , jms:jme ) :: mu , &
3030 mut
3031 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: ru_tendf, &
3032 rv_tendf, &
3033 ph_tendf, &
3034 rw_tendf, &
3035 t_tendf
3036 REAL , DIMENSION( ims:ime , jms:jme ) :: mu_tend
3037 REAL , DIMENSION( spec_bdy_width) , INTENT(IN ) :: fcx, gcx
3038
3039 REAL, DIMENSION( ijds:ijde , kds:kde , spec_bdy_width, 4 ) :: u_b, &
3040 v_b, &
3041 ph_b, &
3042 w_b, &
3043 t_b, &
3044 u_bt, &
3045 v_bt, &
3046 ph_bt, &
3047 w_bt, &
3048 t_bt
3049
3050 REAL, DIMENSION( ijds:ijde , 1:1 , spec_bdy_width, 4 ) :: mu_b, &
3051 mu_bt
3052 REAL, INTENT(IN ) :: dtbc
3053
3054 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: rfield
3055 INTEGER :: i_start, i_end, j_start, j_end, i, j, k
3056
3057 ! zzma: new definition
3058
3059 ! IN variables
3060
3061 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: S_ru, &
3062 S_rv, &
3063 S_ph, &
3064 S_w, &
3065 S_t
3066 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: P_ru, &
3067 P_rv, &
3068 P_ph, &
3069 P_w, &
3070 P_t
3071 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: B_ru, &
3072 B_rv, &
3073 B_ph, &
3074 B_w, &
3075 B_t
3076
3077 REAL , DIMENSION( ims:ime , jms:jme ) :: S_mu, S_mut,P_mu, P_mut,B_mu, B_mut
3078
3079 REAL, DIMENSION( ijds:ijde , kds:kde , spec_bdy_width, 4 ) :: S_u_b, &
3080 S_v_b, &
3081 S_ph_b, &
3082 S_w_b, &
3083 S_t_b, &
3084 S_u_bt, &
3085 S_v_bt, &
3086 S_ph_bt, &
3087 S_w_bt, &
3088 S_t_bt
3089
3090 REAL, DIMENSION( ijds:ijde , kds:kde , spec_bdy_width, 4 ) :: P_u_b, &
3091 P_v_b, &
3092 P_ph_b, &
3093 P_w_b, &
3094 P_t_b, &
3095 P_u_bt, &
3096 P_v_bt, &
3097 P_ph_bt, &
3098 P_w_bt, &
3099 P_t_bt
3100
3101 REAL, DIMENSION( ijds:ijde , kds:kde , spec_bdy_width, 4 ) :: B_u_b, &
3102 B_v_b, &
3103 B_ph_b, &
3104 B_w_b, &
3105 B_t_b, &
3106 B_u_bt, &
3107 B_v_bt, &
3108 B_ph_bt, &
3109 B_w_bt, &
3110 B_t_bt
3111
3112 REAL, DIMENSION( ijds:ijde , 1:1 , spec_bdy_width, 4 ) :: S_mu_b, S_mu_bt,P_mu_b, P_mu_bt,B_mu_b, B_mu_bt
3113
3114 ! INOUT variables
3115
3116 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: S_ru_tendf, &
3117 S_rv_tendf, &
3118 S_ph_tendf, &
3119 S_rw_tendf, &
3120 S_t_tendf
3121
3122 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: P_ru_tendf, &
3123 P_rv_tendf, &
3124 P_ph_tendf, &
3125 P_rw_tendf, &
3126 P_t_tendf
3127
3128 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: K_ru_tendf, &
3129 K_rv_tendf, &
3130 K_ph_tendf, &
3131 K_rw_tendf, &
3132 K_t_tendf
3133
3134 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: B_ru_tendf, &
3135 B_rv_tendf, &
3136 B_ph_tendf, &
3137 B_rw_tendf, &
3138 B_t_tendf
3139
3140 REAL , DIMENSION( ims:ime , jms:jme ) :: S_mu_tend,P_mu_tend,K_mu_tend,B_mu_tend
3141
3142 REAL :: SAVE_L, COEF, ALPHA, FACTOR, VAL_N, VAL_L, VAL_A
3143 INTEGER :: NT,h
3144
3145 ! zzma: new definition end
3146
3147 do i=ims,ime
3148 do k=kms,kme
3149 do j=jms,jme
3150 S_ru(i,k,j)=ru(i,k,j)
3151 S_rv(i,k,j)=rv(i,k,j)
3152 S_w(i,k,j)=w(i,k,j)
3153 S_t(i,k,j)=t(i,k,j)
3154 S_ph(i,k,j)=ph(i,k,j)
3155
3156 P_ru(i,k,j)=ru(i,k,j)
3157 P_rv(i,k,j)=rv(i,k,j)
3158 P_w(i,k,j)=w(i,k,j)
3159 P_t(i,k,j)=t(i,k,j)
3160 P_ph(i,k,j)=ph(i,k,j)
3161 enddo
3162 enddo
3163 enddo
3164
3165 do i=ims,ime
3166 do j=jms,jme
3167 S_mu(i,j)=mu(i,j)
3168 S_mut(i,j)=mut(i,j)
3169
3170 P_mu(i,j)=mu(i,j)
3171 P_mut(i,j)=mut(i,j)
3172 enddo
3173 enddo
3174
3175 do i=ijds,ijde
3176 do k=kds,kde
3177 do j=1,spec_bdy_width
3178 do h=1,4
3179 S_u_b(i,k,j,h)=u_b(i,k,j,h)
3180 S_v_b(i,k,j,h)=v_b(i,k,j,h)
3181 S_ph_b(i,k,j,h)=ph_b(i,k,j,h)
3182 S_w_b(i,k,j,h)=w_b(i,k,j,h)
3183 S_t_b(i,k,j,h)=t_b(i,k,j,h)
3184 S_u_bt(i,k,j,h)=u_bt(i,k,j,h)
3185 S_v_bt(i,k,j,h)=v_bt(i,k,j,h)
3186 S_ph_bt(i,k,j,h)=ph_bt(i,k,j,h)
3187 S_w_bt(i,k,j,h)=w_bt(i,k,j,h)
3188 S_t_bt(i,k,j,h)=t_bt(i,k,j,h)
3189
3190 P_u_b(i,k,j,h)=u_b(i,k,j,h)
3191 P_v_b(i,k,j,h)=v_b(i,k,j,h)
3192 P_ph_b(i,k,j,h)=ph_b(i,k,j,h)
3193 P_w_b(i,k,j,h)=w_b(i,k,j,h)
3194 P_t_b(i,k,j,h)=t_b(i,k,j,h)
3195 P_u_bt(i,k,j,h)=u_bt(i,k,j,h)
3196 P_v_bt(i,k,j,h)=v_bt(i,k,j,h)
3197 P_ph_bt(i,k,j,h)=ph_bt(i,k,j,h)
3198 P_w_bt(i,k,j,h)=w_bt(i,k,j,h)
3199 P_t_bt(i,k,j,h)=t_bt(i,k,j,h)
3200 enddo
3201 enddo
3202 enddo
3203 enddo
3204
3205 do i=ijds,ijde
3206 do k=1,1
3207 do j=1,spec_bdy_width
3208 do h=1,4
3209 S_mu_b(i,k,j,h)=mu_b(i,k,j,h)
3210 S_mu_bt(i,k,j,h)=mu_bt(i,k,j,h)
3211
3212 P_mu_b(i,k,j,h)=mu_b(i,k,j,h)
3213 P_mu_bt(i,k,j,h)=mu_bt(i,k,j,h)
3214 enddo
3215 enddo
3216 enddo
3217 enddo
3218
3219
3220
3221
3222
3223
3224 do i=ims,ime
3225 do k=kms,kme
3226 do j=jms,jme
3227 S_ru_tendf(i,k,j)=ru_tendf(i,k,j)
3228 S_rv_tendf(i,k,j)=rv_tendf(i,k,j)
3229 S_rw_tendf(i,k,j)=rw_tendf(i,k,j)
3230 S_t_tendf(i,k,j)=t_tendf(i,k,j)
3231 S_ph_tendf(i,k,j)=ph_tendf(i,k,j)
3232
3233 P_ru_tendf(i,k,j)=ru_tendf(i,k,j)
3234 P_rv_tendf(i,k,j)=rv_tendf(i,k,j)
3235 P_rw_tendf(i,k,j)=rw_tendf(i,k,j)
3236 P_t_tendf(i,k,j)=t_tendf(i,k,j)
3237 P_ph_tendf(i,k,j)=ph_tendf(i,k,j)
3238
3239 K_ru_tendf(i,k,j)=ru_tendf(i,k,j)
3240 K_rv_tendf(i,k,j)=rv_tendf(i,k,j)
3241 K_rw_tendf(i,k,j)=rw_tendf(i,k,j)
3242 K_t_tendf(i,k,j)=t_tendf(i,k,j)
3243 K_ph_tendf(i,k,j)=ph_tendf(i,k,j)
3244 enddo
3245 enddo
3246 enddo
3247
3248 do i=ims,ime
3249 do j=jms,jme
3250 S_mu_tend(i,j)=mu_tend(i,j)
3251 P_mu_tend(i,j)=mu_tend(i,j)
3252 K_mu_tend(i,j)=mu_tend(i,j)
3253 enddo
3254 enddo
3255
3256 !NLM
3257
3258 CALL relax_bdy_dry ( config_flags, &
3259 ru_tendf, rv_tendf, ph_tendf, t_tendf, &
3260 rw_tendf, mu_tend, &
3261 ru, rv, ph, t, &
3262 w, mu, mut, &
3263 u_b, v_b, ph_b, t_b, &
3264 w_b, mu_b, &
3265 u_bt, v_bt, ph_bt, t_bt, &
3266 w_bt, mu_bt, &
3267 spec_bdy_width, spec_zone, relax_zone, &
3268 dtbc, fcx, gcx, &
3269 ijds, ijde, & ! min/max(id,jd)
3270 ids,ide, jds,jde, kds,kde, & ! domain dims
3271 ims,ime, jms,jme, kms,kme, & ! memory dims
3272 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
3273 its, ite, jts, jte, kts, kte)
3274
3275 do i=ims,ime
3276 do k=kms,kme
3277 do j=jms,jme
3278 B_ru_tendf(i,k,j)=ru_tendf(i,k,j)
3279 B_rv_tendf(i,k,j)=rv_tendf(i,k,j)
3280 B_rw_tendf(i,k,j)=rw_tendf(i,k,j)
3281 B_t_tendf(i,k,j)=t_tendf(i,k,j)
3282 B_ph_tendf(i,k,j)=ph_tendf(i,k,j)
3283 enddo
3284 enddo
3285 enddo
3286
3287 do i=ims,ime
3288 do j=jms,jme
3289 B_mu_tend(i,j)=mu_tend(i,j)
3290 enddo
3291 enddo
3292
3293 ! TCL
3294
3295 CALL g_relax_bdy_dry( config_flags, K_ru_tendf, P_ru_tendf, K_rv_tendf, P_rv_tendf, K_ph_tendf, P_ph_tendf, K_t_tendf, P_t_tendf, &
3296 &K_rw_tendf, P_rw_tendf, K_mu_tend, P_mu_tend, ru, P_ru, rv, P_rv, ph, P_ph, t, P_t, w, P_w, mu, P_mu, mut, P_mut, u_b, P_u_b, v_b, &
3297 &P_v_b, ph_b, P_ph_b, t_b, P_t_b, w_b, P_w_b, mu_b, P_mu_b, u_bt, P_u_bt, v_bt, P_v_bt, ph_bt, P_ph_bt, t_bt, P_t_bt, w_bt, P_w_bt,&
3298 & mu_bt, P_mu_bt, spec_bdy_width, spec_zone, relax_zone, dtbc, fcx, gcx, ijds, ijde, ids, ide, jds, jde, kds, kde, ims, ime, jms, &
3299 &jme, kms, kme, its, ite, jts, jte, kts, kte )
3300
3301 SAVE_L=0.
3302 do i=ims,ime
3303 do k=kms,kme
3304 do j=jms,jme
3305 SAVE_L=SAVE_L + P_ru_tendf(i,k,j)*P_ru_tendf(i,k,j) &
3306 + P_rv_tendf(i,k,j)*P_rv_tendf(i,k,j) &
3307 + P_rw_tendf(i,k,j)*P_rw_tendf(i,k,j) &
3308 + P_t_tendf(i,k,j)*P_t_tendf(i,k,j) &
3309 + P_ph_tendf(i,k,j)*P_ph_tendf(i,k,j)
3310 enddo
3311 enddo
3312 enddo
3313 do i=ims,ime
3314 do j=jms,jme
3315 SAVE_L=SAVE_L + P_mu_tend(i,j)*P_mu_tend(i,j)
3316 enddo
3317 enddo
3318
3319 ALPHA=1.
3320 DO NT=1,11
3321 ALPHA=0.1*ALPHA
3322 FACTOR=1.+ALPHA
3323 do i=ims,ime
3324 do k=kms,kme
3325 do j=jms,jme
3326 P_ru(i,k,j)=FACTOR*S_ru(i,k,j)
3327 P_rv(i,k,j)=FACTOR*S_rv(i,k,j)
3328 P_w(i,k,j)=FACTOR*S_w(i,k,j)
3329 P_t(i,k,j)=FACTOR*S_t(i,k,j)
3330 P_ph(i,k,j)=FACTOR*S_ph(i,k,j)
3331 enddo
3332 enddo
3333 enddo
3334
3335 do i=ims,ime
3336 do j=jms,jme
3337 P_mu(i,j)=FACTOR*S_mu(i,j)
3338 P_mut(i,j)=FACTOR*S_mut(i,j)
3339 enddo
3340 enddo
3341 do i=ijds,ijde
3342 do k=kds,kde
3343 do j=1,spec_bdy_width
3344 do h=1,4
3345 P_u_b(i,k,j,h)=FACTOR*S_u_b(i,k,j,h)
3346 P_v_b(i,k,j,h)=FACTOR*S_v_b(i,k,j,h)
3347 P_ph_b(i,k,j,h)=FACTOR*S_ph_b(i,k,j,h)
3348 P_w_b(i,k,j,h)=FACTOR*S_w_b(i,k,j,h)
3349 P_t_b(i,k,j,h)=FACTOR*S_t_b(i,k,j,h)
3350 P_u_bt(i,k,j,h)=FACTOR*S_u_bt(i,k,j,h)
3351 P_v_bt(i,k,j,h)=FACTOR*S_v_bt(i,k,j,h)
3352 P_ph_bt(i,k,j,h)=FACTOR*S_ph_bt(i,k,j,h)
3353 P_w_bt(i,k,j,h)=FACTOR*S_w_bt(i,k,j,h)
3354 P_t_bt(i,k,j,h)=FACTOR*S_t_bt(i,k,j,h)
3355 enddo
3356 enddo
3357 enddo
3358 enddo
3359
3360 do i=ijds,ijde
3361 do k=1,1
3362 do j=1,spec_bdy_width
3363 do h=1,4
3364 P_mu_b(i,k,j,h)=FACTOR*S_mu_b(i,k,j,h)
3365 P_mu_bt(i,k,j,h)=FACTOR*S_mu_bt(i,k,j,h)
3366 enddo
3367 enddo
3368 enddo
3369 enddo
3370 do i=ims,ime
3371 do k=kms,kme
3372 do j=jms,jme
3373 P_ru_tendf(i,k,j)=FACTOR*S_ru_tendf(i,k,j)
3374 P_rv_tendf(i,k,j)=FACTOR*S_rv_tendf(i,k,j)
3375 P_rw_tendf(i,k,j)=FACTOR*S_rw_tendf(i,k,j)
3376 P_t_tendf(i,k,j)=FACTOR*S_t_tendf(i,k,j)
3377 P_ph_tendf(i,k,j)=FACTOR*S_ph_tendf(i,k,j)
3378 enddo
3379 enddo
3380 enddo
3381
3382 do i=ims,ime
3383 do j=jms,jme
3384 P_mu_tend(i,j)=FACTOR*S_mu_tend(i,j)
3385 enddo
3386 enddo
3387
3388 CALL relax_bdy_dry ( config_flags, &
3389 P_ru_tendf, P_rv_tendf, P_ph_tendf, P_t_tendf, &
3390 P_rw_tendf, P_mu_tend, &
3391 P_ru, P_rv, P_ph, P_t, &
3392 P_w, P_mu, P_mut, &
3393 P_u_b, P_v_b, P_ph_b, P_t_b, &
3394 P_w_b, P_mu_b, &
3395 P_u_bt, P_v_bt, P_ph_bt, P_t_bt, &
3396 P_w_bt, P_mu_bt, &
3397 spec_bdy_width, spec_zone, relax_zone, &
3398 dtbc, fcx, gcx, &
3399 ijds, ijde, & ! min/max(id,jd)
3400 ids,ide, jds,jde, kds,kde, & ! domain dims
3401 ims,ime, jms,jme, kms,kme, & ! memory dims
3402 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
3403 its, ite, jts, jte, kts, kte)
3404
3405 VAL_N=0.
3406 do i=ims,ime
3407 do k=kms,kme
3408 do j=jms,jme
3409 VAL_N=VAL_N + (P_ru_tendf(i,k,j)-B_ru_tendf(i,k,j))*(P_ru_tendf(i,k,j)-B_ru_tendf(i,k,j)) &
3410 + (P_rv_tendf(i,k,j)-B_rv_tendf(i,k,j))*(P_rv_tendf(i,k,j)-B_rv_tendf(i,k,j)) &
3411 + (P_rw_tendf(i,k,j)-B_rw_tendf(i,k,j))*(P_rw_tendf(i,k,j)-B_rw_tendf(i,k,j)) &
3412 + (P_t_tendf(i,k,j)-B_t_tendf(i,k,j))*(P_t_tendf(i,k,j)-B_t_tendf(i,k,j)) &
3413 + (P_ph_tendf(i,k,j)-B_ph_tendf(i,k,j))*(P_ph_tendf(i,k,j)-B_ph_tendf(i,k,j))
3414 enddo
3415 enddo
3416 enddo
3417 do i=ims,ime
3418 do j=jms,jme
3419 VAL_N=VAL_N + (P_mu_tend(i,j)-B_mu_tend(i,j))*(P_mu_tend(i,j)-B_mu_tend(i,j))
3420 enddo
3421 enddo
3422
3423 VAL_L=SAVE_L*ALPHA**2
3424 COEF=VAL_N/VAL_L
3425 WRITE(6, fmt='(A,E9.4,A,E22.13,A,E13.6,A,E13.6)') &
3426 'g_relax_bdy_dry: ALPHA=',ALPHA,' COEF=',COEF, &
3427 ' VAL_N=',VAL_N,' VAL_L=',VAL_L
3428 ENDDO
3429
3430 ! ADJ test
3431
3432 FACTOR=0.1
3433 do i=ims,ime
3434 do k=kms,kme
3435 do j=jms,jme
3436 ru(i,k,j)=S_ru(i,k,j)
3437 rv(i,k,j)=S_rv(i,k,j)
3438 w(i,k,j)=S_w(i,k,j)
3439 t(i,k,j)=S_t(i,k,j)
3440 ph(i,k,j)=S_ph(i,k,j)
3441
3442 P_ru(i,k,j)=FACTOR*S_ru(i,k,j)
3443 P_rv(i,k,j)=FACTOR*S_rv(i,k,j)
3444 P_w(i,k,j)=FACTOR*S_w(i,k,j)
3445 P_t(i,k,j)=FACTOR*S_t(i,k,j)
3446 P_ph(i,k,j)=FACTOR*S_ph(i,k,j)
3447
3448 B_ru(i,k,j)=P_ru(i,k,j)
3449 B_rv(i,k,j)=P_rv(i,k,j)
3450 B_w(i,k,j)=P_w(i,k,j)
3451 B_t(i,k,j)=P_t(i,k,j)
3452 B_ph(i,k,j)=P_ph(i,k,j)
3453 enddo
3454 enddo
3455 enddo
3456
3457 do i=ims,ime
3458 do j=jms,jme
3459 mu(i,j)=S_mu(i,j)
3460 mut(i,j)=S_mut(i,j)
3461
3462 P_mu(i,j)=FACTOR*S_mu(i,j)
3463 P_mut(i,j)=FACTOR*S_mut(i,j)
3464
3465 B_mu(i,j)=P_mu(i,j)
3466 B_mut(i,j)=P_mut(i,j)
3467 enddo
3468 enddo
3469
3470 do i=ijds,ijde
3471 do k=kds,kde
3472 do j=1,spec_bdy_width
3473 do h=1,4
3474 u_b(i,k,j,h)=S_u_b(i,k,j,h)
3475 v_b(i,k,j,h)=S_v_b(i,k,j,h)
3476 ph_b(i,k,j,h)=S_ph_b(i,k,j,h)
3477 w_b(i,k,j,h)=S_w_b(i,k,j,h)
3478 t_b(i,k,j,h)=S_t_b(i,k,j,h)
3479 u_bt(i,k,j,h)=S_u_bt(i,k,j,h)
3480 v_bt(i,k,j,h)=S_v_bt(i,k,j,h)
3481 ph_bt(i,k,j,h)=S_ph_bt(i,k,j,h)
3482 w_bt(i,k,j,h)=S_w_bt(i,k,j,h)
3483 t_bt(i,k,j,h)=S_t_bt(i,k,j,h)
3484
3485 P_u_b(i,k,j,h)=FACTOR*S_u_b(i,k,j,h)
3486 P_v_b(i,k,j,h)=FACTOR*S_v_b(i,k,j,h)
3487 P_ph_b(i,k,j,h)=FACTOR*S_ph_b(i,k,j,h)
3488 P_w_b(i,k,j,h)=FACTOR*S_w_b(i,k,j,h)
3489 P_t_b(i,k,j,h)=FACTOR*S_t_b(i,k,j,h)
3490 P_u_bt(i,k,j,h)=FACTOR*S_u_bt(i,k,j,h)
3491 P_v_bt(i,k,j,h)=FACTOR*S_v_bt(i,k,j,h)
3492 P_ph_bt(i,k,j,h)=FACTOR*S_ph_bt(i,k,j,h)
3493 P_w_bt(i,k,j,h)=FACTOR*S_w_bt(i,k,j,h)
3494 P_t_bt(i,k,j,h)=FACTOR*S_t_bt(i,k,j,h)
3495
3496 B_u_b(i,k,j,h)=P_u_b(i,k,j,h)
3497 B_v_b(i,k,j,h)=P_v_b(i,k,j,h)
3498 B_ph_b(i,k,j,h)=P_ph_b(i,k,j,h)
3499 B_w_b(i,k,j,h)=P_w_b(i,k,j,h)
3500 B_t_b(i,k,j,h)=P_t_b(i,k,j,h)
3501 B_u_bt(i,k,j,h)=P_u_bt(i,k,j,h)
3502 B_v_bt(i,k,j,h)=P_v_bt(i,k,j,h)
3503 B_ph_bt(i,k,j,h)=P_ph_bt(i,k,j,h)
3504 B_w_bt(i,k,j,h)=P_w_bt(i,k,j,h)
3505 B_t_bt(i,k,j,h)=P_t_bt(i,k,j,h)
3506 enddo
3507 enddo
3508 enddo
3509 enddo
3510
3511 do i=ijds,ijde
3512 do k=1,1
3513 do j=1,spec_bdy_width
3514 do h=1,4
3515 mu_b(i,k,j,h)=S_mu_b(i,k,j,h)
3516 mu_bt(i,k,j,h)=S_mu_bt(i,k,j,h)
3517
3518 P_mu_b(i,k,j,h)=FACTOR*S_mu_b(i,k,j,h)
3519 P_mu_bt(i,k,j,h)=FACTOR*S_mu_bt(i,k,j,h)
3520
3521 B_mu_b(i,k,j,h)=P_mu_b(i,k,j,h)
3522 B_mu_bt(i,k,j,h)=P_mu_bt(i,k,j,h)
3523 enddo
3524 enddo
3525 enddo
3526 enddo
3527 do i=ims,ime
3528 do k=kms,kme
3529 do j=jms,jme
3530 ru_tendf(i,k,j)=S_ru_tendf(i,k,j)
3531 rv_tendf(i,k,j)=S_rv_tendf(i,k,j)
3532 rw_tendf(i,k,j)=S_rw_tendf(i,k,j)
3533 t_tendf(i,k,j)=S_t_tendf(i,k,j)
3534 ph_tendf(i,k,j)=S_ph_tendf(i,k,j)
3535
3536 P_ru_tendf(i,k,j)=FACTOR*S_ru_tendf(i,k,j)
3537 P_rv_tendf(i,k,j)=FACTOR*S_rv_tendf(i,k,j)
3538 P_rw_tendf(i,k,j)=FACTOR*S_rw_tendf(i,k,j)
3539 P_t_tendf(i,k,j)=FACTOR*S_t_tendf(i,k,j)
3540 P_ph_tendf(i,k,j)=FACTOR*S_ph_tendf(i,k,j)
3541
3542 B_ru_tendf(i,k,j)=P_ru_tendf(i,k,j)
3543 B_rv_tendf(i,k,j)=P_rv_tendf(i,k,j)
3544 B_rw_tendf(i,k,j)=P_rw_tendf(i,k,j)
3545 B_t_tendf(i,k,j)=P_t_tendf(i,k,j)
3546 B_ph_tendf(i,k,j)=P_ph_tendf(i,k,j)
3547 enddo
3548 enddo
3549 enddo
3550
3551 do i=ims,ime
3552 do j=jms,jme
3553 mu_tend(i,j)=S_mu_tend(i,j)
3554 P_mu_tend(i,j)=FACTOR*S_mu_tend(i,j)
3555 B_mu_tend(i,j)=P_mu_tend(i,j)
3556 enddo
3557 enddo
3558
3559 ! TGL
3560
3561 CALL g_relax_bdy_dry( config_flags, ru_tendf, P_ru_tendf, rv_tendf, P_rv_tendf, ph_tendf, P_ph_tendf, t_tendf, P_t_tendf, &
3562 &rw_tendf, P_rw_tendf, mu_tend, P_mu_tend, ru, P_ru, rv, P_rv, ph, P_ph, t, P_t, w, P_w, mu, P_mu, mut, P_mut, u_b, P_u_b, v_b, &
3563 &P_v_b, ph_b, P_ph_b, t_b, P_t_b, w_b, P_w_b, mu_b, P_mu_b, u_bt, P_u_bt, v_bt, P_v_bt, ph_bt, P_ph_bt, t_bt, P_t_bt, w_bt, P_w_bt,&
3564 & mu_bt, P_mu_bt, spec_bdy_width, spec_zone, relax_zone, dtbc, fcx, gcx, ijds, ijde, ids, ide, jds, jde, kds, kde, ims, ime, jms, &
3565 &jme, kms, kme, its, ite, jts, jte, kts, kte )
3566
3567 VAL_L=0.
3568 do i=ims,ime
3569 do k=kms,kme
3570 do j=jms,jme
3571 VAL_L=VAL_L + P_ru_tendf(i,k,j)*P_ru_tendf(i,k,j) &
3572 + P_rv_tendf(i,k,j)*P_rv_tendf(i,k,j) &
3573 + P_rw_tendf(i,k,j)*P_rw_tendf(i,k,j) &
3574 + P_t_tendf(i,k,j)*P_t_tendf(i,k,j) &
3575 + P_ph_tendf(i,k,j)*P_ph_tendf(i,k,j)
3576 enddo
3577 enddo
3578 enddo
3579 do i=ims,ime
3580 do j=jms,jme
3581 VAL_L=VAL_L + P_mu_tend(i,j)*P_mu_tend(i,j)
3582 enddo
3583 enddo
3584
3585 do i=ims,ime
3586 do k=kms,kme
3587 do j=jms,jme
3588 P_ru(i,k,j)=0.0
3589 P_rv(i,k,j)=0.0
3590 P_w(i,k,j)=0.0
3591 P_t(i,k,j)=0.0
3592 P_ph(i,k,j)=0.0
3593 enddo
3594 enddo
3595 enddo
3596
3597 do i=ims,ime
3598 do j=jms,jme
3599 P_mu(i,j)=0.0
3600 P_mut(i,j)=0.0
3601 enddo
3602 enddo
3603 do i=ijds,ijde
3604 do k=kds,kde
3605 do j=1,spec_bdy_width
3606 do h=1,4
3607 P_u_b(i,k,j,h)=0.0
3608 P_v_b(i,k,j,h)=0.0
3609 P_ph_b(i,k,j,h)=0.0
3610 P_w_b(i,k,j,h)=0.0
3611 P_t_b(i,k,j,h)=0.0
3612 P_u_bt(i,k,j,h)=0.0
3613 P_v_bt(i,k,j,h)=0.0
3614 P_ph_bt(i,k,j,h)=0.0
3615 P_w_bt(i,k,j,h)=0.0
3616 P_t_bt(i,k,j,h)=0.0
3617 enddo
3618 enddo
3619 enddo
3620 enddo
3621 do i=ijds,ijde
3622 do k=1,1
3623 do j=1,spec_bdy_width
3624 do h=1,4
3625 P_mu_b(i,k,j,h)=0.0
3626 P_mu_bt(i,k,j,h)=0.0
3627 enddo
3628 enddo
3629 enddo
3630 enddo
3631
3632 ! ADJ
3633
3634 CALL a_relax_bdy_dry( config_flags, P_ru_tendf, P_rv_tendf, P_ph_tendf, P_t_tendf, P_rw_tendf, P_mu_tend, P_ru, P_rv, ph, &
3635 &P_ph, t, P_t, w, P_w, P_mu, mut, P_mut, P_u_b, P_v_b, P_ph_b, P_t_b, P_w_b, P_mu_b, P_u_bt, P_v_bt, P_ph_bt, P_t_bt, P_w_bt, &
3636 &P_mu_bt, spec_bdy_width, spec_zone, relax_zone, dtbc, fcx, gcx, ijds, ijde, ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms,&
3637 & kme, its, ite, jts, jte, kts, kte )
3638
3639 VAL_A=0.
3640 do i=ims,ime
3641 do k=kms,kme
3642 do j=jms,jme
3643 VAL_A=VAL_A + P_ru(i,k,j)*B_ru(i,k,j) &
3644 + P_rv(i,k,j)*B_rv(i,k,j) &
3645 + P_w(i,k,j)*B_w(i,k,j) &
3646 + P_t(i,k,j)*B_t(i,k,j) &
3647 + P_ph(i,k,j)*B_ph(i,k,j)
3648 enddo
3649 enddo
3650 enddo
3651
3652 do i=ims,ime
3653 do j=jms,jme
3654 VAL_A=VAL_A + P_mu(i,j)*B_mu(i,j) &
3655 + P_mut(i,j)*B_mut(i,j)
3656 enddo
3657 enddo
3658 do i=ijds,ijde
3659 do k=kds,kde
3660 do j=1,spec_bdy_width
3661 do h=1,4
3662 VAL_A=VAL_A + P_u_b(i,k,j,h)*B_u_b(i,k,j,h) &
3663 + P_v_b(i,k,j,h)*B_v_b(i,k,j,h) &
3664 + P_ph_b(i,k,j,h)*B_ph_b(i,k,j,h) &
3665 + P_w_b(i,k,j,h)*B_w_b(i,k,j,h) &
3666 + P_t_b(i,k,j,h)*B_t_b(i,k,j,h) &
3667 + P_u_bt(i,k,j,h)*B_u_bt(i,k,j,h) &
3668 + P_v_bt(i,k,j,h)*B_v_bt(i,k,j,h) &
3669 + P_ph_bt(i,k,j,h)*B_ph_bt(i,k,j,h) &
3670 + P_w_bt(i,k,j,h)*B_w_bt(i,k,j,h) &
3671 + P_t_bt(i,k,j,h)*B_t_bt(i,k,j,h)
3672 enddo
3673 enddo
3674 enddo
3675 enddo
3676
3677 do i=ijds,ijde
3678 do k=1,1
3679 do j=1,spec_bdy_width
3680 do h=1,4
3681 VAL_A=VAL_A + P_mu_b(i,k,j,h)*B_mu_b(i,k,j,h) &
3682 + P_mu_bt(i,k,j,h)*B_mu_bt(i,k,j,h)
3683 enddo
3684 enddo
3685 enddo
3686 enddo
3687 do i=ims,ime
3688 do k=kms,kme
3689 do j=jms,jme
3690 VAL_A=VAL_A + P_ru_tendf(i,k,j)*B_ru_tendf(i,k,j) &
3691 + P_rv_tendf(i,k,j)*B_rv_tendf(i,k,j) &
3692 + P_rw_tendf(i,k,j)*B_rw_tendf(i,k,j) &
3693 + P_t_tendf(i,k,j)*B_t_tendf(i,k,j) &
3694 + P_ph_tendf(i,k,j)*B_ph_tendf(i,k,j)
3695 enddo
3696 enddo
3697 enddo
3698 do i=ims,ime
3699 do j=jms,jme
3700 VAL_A=VAL_A + P_mu_tend(i,j)*B_mu_tend(i,j)
3701 enddo
3702 enddo
3703
3704 print*, ' '
3705 write(6,fmt='(A,2E22.13)') 'a_relax_bdy_dry: ', VAL_L,VAL_A
3706
3707 ! RECOVER
3708
3709 do i=ims,ime
3710 do k=kms,kme
3711 do j=jms,jme
3712 ru(i,k,j)=S_ru(i,k,j)
3713 rv(i,k,j)=S_rv(i,k,j)
3714 w(i,k,j)=S_w(i,k,j)
3715 t(i,k,j)=S_t(i,k,j)
3716 ph(i,k,j)=S_ph(i,k,j)
3717 enddo
3718 enddo
3719 enddo
3720
3721 do i=ims,ime
3722 do j=jms,jme
3723 mu(i,j)=S_mu(i,j)
3724 mut(i,j)=S_mut(i,j)
3725 enddo
3726 enddo
3727 do i=ijds,ijde
3728 do k=kds,kde
3729 do j=1,spec_bdy_width
3730 do h=1,4
3731 u_b(i,k,j,h)=S_u_b(i,k,j,h)
3732 v_b(i,k,j,h)=S_v_b(i,k,j,h)
3733 ph_b(i,k,j,h)=S_ph_b(i,k,j,h)
3734 w_b(i,k,j,h)=S_w_b(i,k,j,h)
3735 t_b(i,k,j,h)=S_t_b(i,k,j,h)
3736 u_bt(i,k,j,h)=S_u_bt(i,k,j,h)
3737 v_bt(i,k,j,h)=S_v_bt(i,k,j,h)
3738 ph_bt(i,k,j,h)=S_ph_bt(i,k,j,h)
3739 w_bt(i,k,j,h)=S_w_bt(i,k,j,h)
3740 t_bt(i,k,j,h)=S_t_bt(i,k,j,h)
3741 enddo
3742 enddo
3743 enddo
3744 enddo
3745
3746 do i=ijds,ijde
3747 do k=1,1
3748 do j=1,spec_bdy_width
3749 do h=1,4
3750 mu_b(i,k,j,h)=S_mu_b(i,k,j,h)
3751 mu_bt(i,k,j,h)=S_mu_bt(i,k,j,h)
3752 enddo
3753 enddo
3754 enddo
3755 enddo
3756 do i=ims,ime
3757 do k=kms,kme
3758 do j=jms,jme
3759 ru_tendf(i,k,j)=S_ru_tendf(i,k,j)
3760 rv_tendf(i,k,j)=S_rv_tendf(i,k,j)
3761 rw_tendf(i,k,j)=S_rw_tendf(i,k,j)
3762 t_tendf(i,k,j)=S_t_tendf(i,k,j)
3763 ph_tendf(i,k,j)=S_ph_tendf(i,k,j)
3764 enddo
3765 enddo
3766 enddo
3767
3768 do i=ims,ime
3769 do j=jms,jme
3770 mu_tend(i,j)=S_mu_tend(i,j)
3771 enddo
3772 enddo
3773
3774 ! method: using goto clause before if
3775
3776 !g_relax_bdy_dry: ALPHA=.1000E+00 COEF= 0.1000000953674E+01 VAL_N= 0.577844E-20 VAL_L= 0.577844E-20
3777 !g_relax_bdy_dry: ALPHA=.1000E-01 COEF= 0.1000003337860E+01 VAL_N= 0.577846E-22 VAL_L= 0.577844E-22
3778 !g_relax_bdy_dry: ALPHA=.1000E-02 COEF= 0.1000092029572E+01 VAL_N= 0.577897E-24 VAL_L= 0.577844E-24
3779 !g_relax_bdy_dry: ALPHA=.1000E-03 COEF= 0.9997125864029E+00 VAL_N= 0.577678E-26 VAL_L= 0.577844E-26
3780 !g_relax_bdy_dry: ALPHA=.1000E-04 COEF= 0.9984483122826E+00 VAL_N= 0.576947E-28 VAL_L= 0.577844E-28
3781 !g_relax_bdy_dry: ALPHA=.1000E-05 COEF= 0.8998992443085E+00 VAL_N= 0.520001E-30 VAL_L= 0.577844E-30
3782 !g_relax_bdy_dry: ALPHA=.1000E-06 COEF= 0.1599820733070E+01 VAL_N= 0.924446E-32 VAL_L= 0.577844E-32
3783 !g_relax_bdy_dry: ALPHA=.1000E-07 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.577844E-34
3784 !g_relax_bdy_dry: ALPHA=.1000E-08 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.577844E-36
3785 !g_relax_bdy_dry: ALPHA=.1000E-09 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.577844E-38
3786 !g_relax_bdy_dry: ALPHA=.1000E-10 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.577839E-40
3787
3788 !a_relax_bdy_dry: 0.5778436170567E-20 0.5778436170567E-20
3789
3790 END SUBROUTINE t_relax_bdy_dry
3791
3792 !---------------------------------------------------------------------------------------------------
3793
3794 SUBROUTINE t_rk_addtend_dry ( ru_tend, rv_tend, rw_tend, ph_tend, t_tend, &
3795 ru_tendf, rv_tendf, rw_tendf, ph_tendf, t_tendf, &
3796 u_save, v_save, w_save, ph_save, t_save, &
3797 mu_tend, mu_tendf, rk_step, &
3798 h_diabatic, mut, msft, msfu, msfv, &
3799 ids,ide, jds,jde, kds,kde, &
3800 ims,ime, jms,jme, kms,kme, &
3801 ips,ipe, jps,jpe, kps,kpe, &
3802 its,ite, jts,jte, kts,kte )
3803
3804 ! Zaizhong Ma, March 25,2005
3805
3806 IMPLICIT NONE
3807
3808 ! Input data.
3809
3810 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
3811 ims, ime, jms, jme, kms, kme, &
3812 ips, ipe, jps, jpe, kps, kpe, &
3813 its, ite, jts, jte, kts, kte
3814 INTEGER , INTENT(IN ) :: rk_step
3815
3816 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: ru_tend, &
3817 rv_tend, &
3818 rw_tend, &
3819 ph_tend, &
3820 t_tend, &
3821 ru_tendf, &
3822 rv_tendf, &
3823 rw_tendf, &
3824 ph_tendf, &
3825 t_tendf
3826
3827 REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: mu_tend, &
3828 mu_tendf
3829
3830 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: u_save, &
3831 v_save, &
3832 w_save, &
3833 ph_save, &
3834 t_save
3835 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: h_diabatic
3836
3837 REAL , DIMENSION( ims:ime , jms:jme ) :: mut
3838 REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msft, &
3839 msfu, &
3840 msfv
3841
3842
3843 ! Local
3844 INTEGER :: i, j, k
3845
3846 ! zzma: new definition
3847
3848 ! IN variables
3849
3850 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: S_u_save, &
3851 S_v_save, &
3852 S_w_save, &
3853 S_ph_save, &
3854 S_t_save
3855 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: P_u_save, &
3856 P_v_save, &
3857 P_w_save, &
3858 P_ph_save, &
3859 P_t_save
3860 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: B_u_save, &
3861 B_v_save, &
3862 B_w_save, &
3863 B_ph_save, &
3864 B_t_save
3865
3866 REAL , DIMENSION( ims:ime , jms:jme ) :: S_mut,P_mut,B_mut
3867
3868 ! INOUT variables
3869
3870 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: S_ru_tend, &
3871 S_rv_tend, &
3872 S_rw_tend, &
3873 S_ph_tend, &
3874 S_t_tend, &
3875 S_ru_tendf, &
3876 S_rv_tendf, &
3877 S_rw_tendf, &
3878 S_ph_tendf, &
3879 S_t_tendf
3880 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: P_ru_tend, &
3881 P_rv_tend, &
3882 P_rw_tend, &
3883 P_ph_tend, &
3884 P_t_tend, &
3885 P_ru_tendf, &
3886 P_rv_tendf, &
3887 P_rw_tendf, &
3888 P_ph_tendf, &
3889 P_t_tendf
3890 REAL , DIMENSION( ims:ime ,jms:jme ) :: P_mu_tend, &
3891 P_mu_tendf
3892 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: B_ru_tend, &
3893 B_rv_tend, &
3894 B_rw_tend, &
3895 B_ph_tend, &
3896 B_t_tend, &
3897 B_ru_tendf, &
3898 B_rv_tendf, &
3899 B_rw_tendf, &
3900 B_ph_tendf, &
3901 B_t_tendf
3902 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: K_ru_tend, &
3903 K_rv_tend, &
3904 K_rw_tend, &
3905 K_ph_tend, &
3906 K_t_tend, &
3907 K_ru_tendf, &
3908 K_rv_tendf, &
3909 K_rw_tendf, &
3910 K_ph_tendf, &
3911 K_t_tendf
3912
3913
3914 REAL :: SAVE_L, COEF, ALPHA, FACTOR, VAL_N, VAL_L, VAL_A
3915 INTEGER :: NT
3916
3917 ! zzma: new definition end
3918
3919 !TGL test
3920
3921 ! JRB mu_tend and mu_tendf only partially added. FIX
3922
3923 do i=ims,ime
3924 do k=kms,kme
3925 do j=jms,jme
3926 S_u_save(i,k,j)=u_save(i,k,j)
3927 S_v_save(i,k,j)=v_save(i,k,j)
3928 S_w_save(i,k,j)=w_save(i,k,j)
3929 S_t_save(i,k,j)=t_save(i,k,j)
3930 S_ph_save(i,k,j)=ph_save(i,k,j)
3931
3932 P_u_save(i,k,j)=u_save(i,k,j)
3933 P_v_save(i,k,j)=v_save(i,k,j)
3934 P_w_save(i,k,j)=w_save(i,k,j)
3935 P_t_save(i,k,j)=t_save(i,k,j)
3936 P_ph_save(i,k,j)=ph_save(i,k,j)
3937 enddo
3938 enddo
3939 enddo
3940 do i=ims,ime
3941 do j=jms,jme
3942 S_mut(i,j)=mut(i,j)
3943 P_mut(i,j)=mut(i,j)
3944 enddo
3945 enddo
3946 do i=ims,ime
3947 do k=kms,kme
3948 do j=jms,jme
3949 S_ru_tend(i,k,j)=ru_tend(i,k,j)
3950 S_rv_tend(i,k,j)=rv_tend(i,k,j)
3951 S_rw_tend(i,k,j)=rw_tend(i,k,j)
3952 S_t_tend(i,k,j)=t_tend(i,k,j)
3953 S_ph_tend(i,k,j)=ph_tend(i,k,j)
3954 S_ru_tendf(i,k,j)=ru_tendf(i,k,j)
3955 S_rv_tendf(i,k,j)=rv_tendf(i,k,j)
3956 S_rw_tendf(i,k,j)=rw_tendf(i,k,j)
3957 S_t_tendf(i,k,j)=t_tendf(i,k,j)
3958 S_ph_tendf(i,k,j)=ph_tendf(i,k,j)
3959
3960 P_ru_tend(i,k,j)=ru_tend(i,k,j)
3961 P_rv_tend(i,k,j)=rv_tend(i,k,j)
3962 P_rw_tend(i,k,j)=rw_tend(i,k,j)
3963 P_t_tend(i,k,j)=t_tend(i,k,j)
3964 P_ph_tend(i,k,j)=ph_tend(i,k,j)
3965 P_ru_tendf(i,k,j)=ru_tendf(i,k,j)
3966 P_rv_tendf(i,k,j)=rv_tendf(i,k,j)
3967 P_rw_tendf(i,k,j)=rw_tendf(i,k,j)
3968 P_t_tendf(i,k,j)=t_tendf(i,k,j)
3969 P_ph_tendf(i,k,j)=ph_tendf(i,k,j)
3970
3971 K_ru_tend(i,k,j)=ru_tend(i,k,j)
3972 K_rv_tend(i,k,j)=rv_tend(i,k,j)
3973 K_rw_tend(i,k,j)=rw_tend(i,k,j)
3974 K_t_tend(i,k,j)=t_tend(i,k,j)
3975 K_ph_tend(i,k,j)=ph_tend(i,k,j)
3976 K_ru_tendf(i,k,j)=ru_tendf(i,k,j)
3977 K_rv_tendf(i,k,j)=rv_tendf(i,k,j)
3978 K_rw_tendf(i,k,j)=rw_tendf(i,k,j)
3979 K_t_tendf(i,k,j)=t_tendf(i,k,j)
3980 K_ph_tendf(i,k,j)=ph_tendf(i,k,j)
3981 enddo
3982 enddo
3983 enddo
3984
3985 !NLM
3986
3987 CALL rk_addtend_dry ( ru_tend, rv_tend, rw_tend, ph_tend, t_tend, &
3988 ru_tendf, rv_tendf, rw_tendf, ph_tendf, t_tendf, &
3989 u_save, v_save, w_save, ph_save, t_save, &
3990 mu_tend, mu_tendf, rk_step, &
3991 h_diabatic, mut, msft, msfu, msfv, &
3992 ids,ide, jds,jde, kds,kde, &
3993 ims,ime, jms,jme, kms,kme, &
3994 ips,ipe, jps,jpe, kps,kpe, &
3995 its,ite, jts,jte, kts,kte )
3996
3997 do i=ims,ime
3998 do k=kms,kme
3999 do j=jms,jme
4000 B_ru_tend(i,k,j)=ru_tend(i,k,j)
4001 B_rv_tend(i,k,j)=rv_tend(i,k,j)
4002 B_rw_tend(i,k,j)=rw_tend(i,k,j)
4003 B_t_tend(i,k,j)=t_tend(i,k,j)
4004 B_ph_tend(i,k,j)=ph_tend(i,k,j)
4005 B_ru_tendf(i,k,j)=ru_tendf(i,k,j)
4006 B_rv_tendf(i,k,j)=rv_tendf(i,k,j)
4007 B_rw_tendf(i,k,j)=rw_tendf(i,k,j)
4008 B_t_tendf(i,k,j)=t_tendf(i,k,j)
4009 B_ph_tendf(i,k,j)=ph_tendf(i,k,j)
4010 enddo
4011 enddo
4012 enddo
4013
4014 ! TCL
4015
4016 CALL g_rk_addtend_dry( K_ru_tend, P_ru_tend, K_rv_tend, P_rv_tend, &
4017 K_rw_tend, P_rw_tend, K_ph_tend, P_ph_tend, K_t_tend, P_t_tend, &
4018 &K_ru_tendf, P_ru_tendf, K_rv_tendf, P_rv_tendf, K_rw_tendf, P_rw_tendf, &
4019 K_ph_tendf, P_ph_tendf, K_t_tendf, P_t_tendf, u_save, P_u_save, &
4020 &v_save, P_v_save, w_save, P_w_save, ph_save, P_ph_save, t_save, &
4021 P_t_save, rk_step, h_diabatic, mut, P_mut, msft, msfu, msfv, ide, &
4022 &jde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
4023
4024 SAVE_L=0.
4025 do i=ims,ime
4026 do k=kms,kme
4027 do j=jms,jme
4028 SAVE_L=SAVE_L + P_ru_tend(i,k,j)*P_ru_tend(i,k,j) &
4029 + P_rv_tend(i,k,j)*P_rv_tend(i,k,j) &
4030 + P_rw_tend(i,k,j)*P_rw_tend(i,k,j) &
4031 + P_t_tend(i,k,j)*P_t_tend(i,k,j) &
4032 + P_ph_tend(i,k,j)*P_ph_tend(i,k,j) &
4033 + P_ru_tendf(i,k,j)*P_ru_tendf(i,k,j) &
4034 + P_rv_tendf(i,k,j)*P_rv_tendf(i,k,j) &
4035 + P_rw_tendf(i,k,j)*P_rw_tendf(i,k,j) &
4036 + P_t_tendf(i,k,j)*P_t_tendf(i,k,j) &
4037 + P_ph_tendf(i,k,j)*P_ph_tendf(i,k,j)
4038 enddo
4039 enddo
4040 enddo
4041
4042 ALPHA=1.
4043 DO NT=1,11
4044 ALPHA=0.1*ALPHA
4045 FACTOR=1.+ALPHA
4046 do i=ims,ime
4047 do k=kms,kme
4048 do j=jms,jme
4049 P_u_save(i,k,j)=FACTOR*S_u_save(i,k,j)
4050 P_v_save(i,k,j)=FACTOR*S_v_save(i,k,j)
4051 P_w_save(i,k,j)=FACTOR*S_w_save(i,k,j)
4052 P_t_save(i,k,j)=FACTOR*S_t_save(i,k,j)
4053 P_ph_save(i,k,j)=FACTOR*S_ph_save(i,k,j)
4054 enddo
4055 enddo
4056 enddo
4057 do i=ims,ime
4058 do j=jms,jme
4059 P_mut(i,j)=FACTOR*S_mut(i,j)
4060 enddo
4061 enddo
4062 do i=ims,ime
4063 do k=kms,kme
4064 do j=jms,jme
4065 P_ru_tend(i,k,j)=FACTOR*S_ru_tend(i,k,j)
4066 P_rv_tend(i,k,j)=FACTOR*S_rv_tend(i,k,j)
4067 P_rw_tend(i,k,j)=FACTOR*S_rw_tend(i,k,j)
4068 P_t_tend(i,k,j)=FACTOR*S_t_tend(i,k,j)
4069 P_ph_tend(i,k,j)=FACTOR*S_ph_tend(i,k,j)
4070 P_ru_tendf(i,k,j)=FACTOR*S_ru_tendf(i,k,j)
4071 P_rv_tendf(i,k,j)=FACTOR*S_rv_tendf(i,k,j)
4072 P_rw_tendf(i,k,j)=FACTOR*S_rw_tendf(i,k,j)
4073 P_t_tendf(i,k,j)=FACTOR*S_t_tendf(i,k,j)
4074 P_ph_tendf(i,k,j)=FACTOR*S_ph_tendf(i,k,j)
4075 enddo
4076 enddo
4077 enddo
4078
4079 CALL rk_addtend_dry ( P_ru_tend, P_rv_tend, P_rw_tend, P_ph_tend, P_t_tend, &
4080 P_ru_tendf, P_rv_tendf, P_rw_tendf, P_ph_tendf, P_t_tendf, &
4081 P_u_save, P_v_save, P_w_save, P_ph_save, P_t_save, &
4082 P_mu_tend,P_mu_tendf, rk_step,&
4083 h_diabatic, P_mut, msft, msfu, msfv, &
4084 ids,ide, jds,jde, kds,kde, &
4085 ims,ime, jms,jme, kms,kme, &
4086 ips,ipe, jps,jpe, kps,kpe, &
4087 its,ite, jts,jte, kts,kte )
4088 VAL_N=0.
4089 do i=ims,ime
4090 do k=kms,kme
4091 do j=jms,jme
4092 VAL_N=VAL_N+(P_ru_tend(i,k,j)- B_ru_tend(i,k,j))*(P_ru_tend(i,k,j)- B_ru_tend(i,k,j)) &
4093 +(P_rv_tend(i,k,j)- B_rv_tend(i,k,j))*(P_rv_tend(i,k,j)- B_rv_tend(i,k,j)) &
4094 +(P_rw_tend(i,k,j)- B_rw_tend(i,k,j))*(P_rw_tend(i,k,j)- B_rw_tend(i,k,j)) &
4095 +(P_t_tend(i,k,j)- B_t_tend(i,k,j))*(P_t_tend(i,k,j)- B_t_tend(i,k,j)) &
4096 +(P_ph_tend(i,k,j)- B_ph_tend(i,k,j))*(P_ph_tend(i,k,j)- B_ph_tend(i,k,j)) &
4097 +(P_ru_tendf(i,k,j)- B_ru_tendf(i,k,j))*(P_ru_tendf(i,k,j)- B_ru_tendf(i,k,j)) &
4098 +(P_rv_tendf(i,k,j)- B_rv_tendf(i,k,j))*(P_rv_tendf(i,k,j)- B_rv_tendf(i,k,j)) &
4099 +(P_rw_tendf(i,k,j)- B_rw_tendf(i,k,j))*(P_rw_tendf(i,k,j)- B_rw_tendf(i,k,j)) &
4100 +(P_t_tendf(i,k,j)- B_t_tendf(i,k,j))*(P_t_tendf(i,k,j)- B_t_tendf(i,k,j)) &
4101 +(P_ph_tendf(i,k,j)- B_ph_tendf(i,k,j))*(P_ph_tendf(i,k,j)- B_ph_tendf(i,k,j))
4102 enddo
4103 enddo
4104 enddo
4105
4106 VAL_L=SAVE_L*ALPHA**2
4107 COEF=VAL_N/VAL_L
4108 WRITE(6, fmt='(A,E9.4,A,E22.13,A,E13.6,A,E13.6)') &
4109 'g_rk_addtend_dry: ALPHA=',ALPHA,' COEF=',COEF, &
4110 ' VAL_N=',VAL_N,' VAL_L=',VAL_L
4111 ENDDO
4112
4113 ! ADJ test
4114
4115 FACTOR=0.1
4116 do i=ims,ime
4117 do k=kms,kme
4118 do j=jms,jme
4119 u_save(i,k,j)=S_u_save(i,k,j)
4120 v_save(i,k,j)=S_v_save(i,k,j)
4121 w_save(i,k,j)=S_w_save(i,k,j)
4122 t_save(i,k,j)=S_t_save(i,k,j)
4123 ph_save(i,k,j)=S_ph_save(i,k,j)
4124
4125 P_u_save(i,k,j)=FACTOR*S_u_save(i,k,j)
4126 P_v_save(i,k,j)=FACTOR*S_v_save(i,k,j)
4127 P_w_save(i,k,j)=FACTOR*S_w_save(i,k,j)
4128 P_t_save(i,k,j)=FACTOR*S_t_save(i,k,j)
4129 P_ph_save(i,k,j)=FACTOR*S_ph_save(i,k,j)
4130
4131 B_u_save(i,k,j)=P_u_save(i,k,j)
4132 B_v_save(i,k,j)=P_v_save(i,k,j)
4133 B_w_save(i,k,j)=P_w_save(i,k,j)
4134 B_t_save(i,k,j)=P_t_save(i,k,j)
4135 B_ph_save(i,k,j)=P_ph_save(i,k,j)
4136 enddo
4137 enddo
4138 enddo
4139 do i=ims,ime
4140 do j=jms,jme
4141 mut(i,j)=S_mut(i,j)
4142 P_mut(i,j)=FACTOR*S_mut(i,j)
4143 B_mut(i,j)=P_mut(i,j)
4144 enddo
4145 enddo
4146
4147 do i=ims,ime
4148 do k=kms,kme
4149 do j=jms,jme
4150 ru_tend(i,k,j)=S_ru_tend(i,k,j)
4151 rv_tend(i,k,j)=S_rv_tend(i,k,j)
4152 rw_tend(i,k,j)=S_rw_tend(i,k,j)
4153 t_tend(i,k,j)=S_t_tend(i,k,j)
4154 ph_tend(i,k,j)=S_ph_tend(i,k,j)
4155 ru_tendf(i,k,j)=S_ru_tendf(i,k,j)
4156 rv_tendf(i,k,j)=S_rv_tendf(i,k,j)
4157 rw_tendf(i,k,j)=S_rw_tendf(i,k,j)
4158 t_tendf(i,k,j)=S_t_tendf(i,k,j)
4159 ph_tendf(i,k,j)=S_ph_tendf(i,k,j)
4160
4161 P_ru_tend(i,k,j)=FACTOR*S_ru_tend(i,k,j)
4162 P_rv_tend(i,k,j)=FACTOR*S_rv_tend(i,k,j)
4163 P_rw_tend(i,k,j)=FACTOR*S_rw_tend(i,k,j)
4164 P_t_tend(i,k,j)=FACTOR*S_t_tend(i,k,j)
4165 P_ph_tend(i,k,j)=FACTOR*S_ph_tend(i,k,j)
4166 P_ru_tendf(i,k,j)=FACTOR*S_ru_tendf(i,k,j)
4167 P_rv_tendf(i,k,j)=FACTOR*S_rv_tendf(i,k,j)
4168 P_rw_tendf(i,k,j)=FACTOR*S_rw_tendf(i,k,j)
4169 P_t_tendf(i,k,j)=FACTOR*S_t_tendf(i,k,j)
4170 P_ph_tendf(i,k,j)=FACTOR*S_ph_tendf(i,k,j)
4171
4172 B_ru_tend(i,k,j)=P_ru_tend(i,k,j)
4173 B_rv_tend(i,k,j)=P_rv_tend(i,k,j)
4174 B_rw_tend(i,k,j)=P_rw_tend(i,k,j)
4175 B_t_tend(i,k,j)=P_t_tend(i,k,j)
4176 B_ph_tend(i,k,j)=P_ph_tend(i,k,j)
4177 B_ru_tendf(i,k,j)=P_ru_tendf(i,k,j)
4178 B_rv_tendf(i,k,j)=P_rv_tendf(i,k,j)
4179 B_rw_tendf(i,k,j)=P_rw_tendf(i,k,j)
4180 B_t_tendf(i,k,j)=P_t_tendf(i,k,j)
4181 B_ph_tendf(i,k,j)=P_ph_tendf(i,k,j)
4182
4183 enddo
4184 enddo
4185 enddo
4186
4187 ! TGL
4188
4189 CALL g_rk_addtend_dry( ru_tend, P_ru_tend, rv_tend, P_rv_tend, rw_tend, P_rw_tend, ph_tend, P_ph_tend, t_tend, P_t_tend, &
4190 &ru_tendf, P_ru_tendf, rv_tendf, P_rv_tendf, rw_tendf, P_rw_tendf, ph_tendf, P_ph_tendf, t_tendf, P_t_tendf, u_save, P_u_save, &
4191 &v_save, P_v_save, w_save, P_w_save, ph_save, P_ph_save, t_save, P_t_save, rk_step, h_diabatic, mut, P_mut, msft, msfu, msfv, ide, &
4192 &jde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
4193
4194 VAL_L=0.
4195 do i=ims,ime
4196 do k=kms,kme
4197 do j=jms,jme
4198 VAL_L=VAL_L + P_ru_tend(i,k,j)*P_ru_tend(i,k,j) &
4199 + P_rv_tend(i,k,j)*P_rv_tend(i,k,j) &
4200 + P_rw_tend(i,k,j)*P_rw_tend(i,k,j) &
4201 + P_t_tend(i,k,j)*P_t_tend(i,k,j) &
4202 + P_ph_tend(i,k,j)*P_ph_tend(i,k,j) &
4203 + P_ru_tendf(i,k,j)*P_ru_tendf(i,k,j) &
4204 + P_rv_tendf(i,k,j)*P_rv_tendf(i,k,j) &
4205 + P_rw_tendf(i,k,j)*P_rw_tendf(i,k,j) &
4206 + P_t_tendf(i,k,j)*P_t_tendf(i,k,j) &
4207 + P_ph_tendf(i,k,j)*P_ph_tendf(i,k,j)
4208 enddo
4209 enddo
4210 enddo
4211 do i=ims,ime
4212 do k=kms,kme
4213 do j=jms,jme
4214 P_u_save(i,k,j)=0.0
4215 P_v_save(i,k,j)=0.0
4216 P_w_save(i,k,j)=0.0
4217 P_t_save(i,k,j)=0.0
4218 P_ph_save(i,k,j)=0.0
4219 enddo
4220 enddo
4221 enddo
4222 do i=ims,ime
4223 do j=jms,jme
4224 P_mut(i,j)=0.0
4225 enddo
4226 enddo
4227
4228 ! ADJ
4229
4230 CALL a_rk_addtend_dry( P_ru_tend, P_rv_tend, P_rw_tend, P_ph_tend, P_t_tend, P_ru_tendf, P_rv_tendf, P_rw_tendf, P_ph_tendf, &
4231 &P_t_tendf, P_u_save, P_v_save, P_w_save, P_ph_save, P_t_save, rk_step, h_diabatic, P_mut, msft, msfu, msfv, ide, jde, ims, ime, &
4232 &jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
4233
4234 VAL_A=0.
4235 do i=ims,ime
4236 do k=kms,kme
4237 do j=jms,jme
4238 VAL_A=VAL_A + P_u_save(i,k,j)*B_u_save(i,k,j) &
4239 + P_v_save(i,k,j)*B_v_save(i,k,j) &
4240 + P_w_save(i,k,j)*B_w_save(i,k,j) &
4241 + P_t_save(i,k,j)*B_t_save(i,k,j) &
4242 + P_ph_save(i,k,j)*B_ph_save(i,k,j)
4243 enddo
4244 enddo
4245 enddo
4246 do i=ims,ime
4247 do j=jms,jme
4248 VAL_A=VAL_A + P_mut(i,j)*B_mut(i,j)
4249 enddo
4250 enddo
4251 do i=ims,ime
4252 do k=kms,kme
4253 do j=jms,jme
4254 VAL_A=VAL_A + P_ru_tend(i,k,j)*B_ru_tend(i,k,j) &
4255 + P_rv_tend(i,k,j)*B_rv_tend(i,k,j) &
4256 + P_rw_tend(i,k,j)*B_rw_tend(i,k,j) &
4257 + P_t_tend(i,k,j)*B_t_tend(i,k,j) &
4258 + P_ph_tend(i,k,j)*B_ph_tend(i,k,j) &
4259 + P_ru_tendf(i,k,j)*B_ru_tendf(i,k,j) &
4260 + P_rv_tendf(i,k,j)*B_rv_tendf(i,k,j) &
4261 + P_rw_tendf(i,k,j)*B_rw_tendf(i,k,j) &
4262 + P_t_tendf(i,k,j)*B_t_tendf(i,k,j) &
4263 + P_ph_tendf(i,k,j)*B_ph_tendf(i,k,j)
4264 enddo
4265 enddo
4266 enddo
4267
4268 print*, ' '
4269 write(6,fmt='(A,2E22.13)') 'a_rk_addtend_dry: ', VAL_L,VAL_A
4270
4271 ! RECOVER
4272
4273 do i=ims,ime
4274 do k=kms,kme
4275 do j=jms,jme
4276 u_save(i,k,j)=S_u_save(i,k,j)
4277 v_save(i,k,j)=S_v_save(i,k,j)
4278 w_save(i,k,j)=S_w_save(i,k,j)
4279 t_save(i,k,j)=S_t_save(i,k,j)
4280 ph_save(i,k,j)=S_ph_save(i,k,j)
4281 enddo
4282 enddo
4283 enddo
4284 do i=ims,ime
4285 do j=jms,jme
4286 mut(i,j)=S_mut(i,j)
4287 enddo
4288 enddo
4289 do i=ims,ime
4290 do k=kms,kme
4291 do j=jms,jme
4292 ru_tend(i,k,j)=S_ru_tend(i,k,j)
4293 rv_tend(i,k,j)=S_rv_tend(i,k,j)
4294 rw_tend(i,k,j)=S_rw_tend(i,k,j)
4295 t_tend(i,k,j)=S_t_tend(i,k,j)
4296 ph_tend(i,k,j)=S_ph_tend(i,k,j)
4297 ru_tendf(i,k,j)=S_ru_tendf(i,k,j)
4298 rv_tendf(i,k,j)=S_rv_tendf(i,k,j)
4299 rw_tendf(i,k,j)=S_rw_tendf(i,k,j)
4300 t_tendf(i,k,j)=S_t_tendf(i,k,j)
4301 ph_tendf(i,k,j)=S_ph_tendf(i,k,j)
4302 enddo
4303 enddo
4304 enddo
4305
4306 !g_rk_addtend_dry: ALPHA=.1000E+00 COEF= 0.9999989867210E+00 VAL_N= 0.198619E+11 VAL_L= 0.198619E+11
4307 !g_rk_addtend_dry: ALPHA=.1000E-01 COEF= 0.1000009894371E+01 VAL_N= 0.198621E+09 VAL_L= 0.198619E+09
4308 !g_rk_addtend_dry: ALPHA=.1000E-02 COEF= 0.1000102877617E+01 VAL_N= 0.198640E+07 VAL_L= 0.198619E+07
4309 !g_rk_addtend_dry: ALPHA=.1000E-03 COEF= 0.1000385403633E+01 VAL_N= 0.198696E+05 VAL_L= 0.198619E+05
4310 !g_rk_addtend_dry: ALPHA=.1000E-04 COEF= 0.1002598404884E+01 VAL_N= 0.199135E+03 VAL_L= 0.198619E+03
4311 !g_rk_addtend_dry: ALPHA=.1000E-05 COEF= 0.9058508872986E+00 VAL_N= 0.179919E+01 VAL_L= 0.198619E+01
4312 !g_rk_addtend_dry: ALPHA=.1000E-06 COEF= 0.1524479985237E+01 VAL_N= 0.302791E-01 VAL_L= 0.198619E-01
4313 !g_rk_addtend_dry: ALPHA=.1000E-07 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.198619E-03
4314 !g_rk_addtend_dry: ALPHA=.1000E-08 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.198619E-05
4315 !g_rk_addtend_dry: ALPHA=.1000E-09 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.198619E-07
4316 !g_rk_addtend_dry: ALPHA=.1000E-10 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.198619E-09
4317
4318 !a_rk_addtend_dry: 0.1986187673600E+11 0.1986187673600E+11
4319
4320 END SUBROUTINE t_rk_addtend_dry
4321
4322 !---------------------------------------------------------------------------------------------------
4323
4324 SUBROUTINE t_spec_bdy_dry ( config_flags, &
4325 ru_tend, rv_tend, ph_tend, t_tend, &
4326 rw_tend, mu_tend, &
4327 u_b, v_b, ph_b, t_b, &
4328 w_b, mu_b, &
4329 u_bt, v_bt, ph_bt, t_bt, &
4330 w_bt, mu_bt, &
4331 spec_bdy_width, spec_zone, &
4332 ijds, ijde, & ! min/max(id,jd)
4333 ids,ide, jds,jde, kds,kde, & ! domain dims
4334 ims,ime, jms,jme, kms,kme, & ! memory dims
4335 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4336 its, ite, jts, jte, kts, kte)
4337
4338 ! Zaizhong Ma, March 25,2005
4339 ! Qingnong Xiao, April 2005, rewritten.
4340
4341 IMPLICIT NONE
4342
4343 ! Input data.
4344 TYPE( grid_config_rec_type ) config_flags
4345
4346
4347 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
4348 ims, ime, jms, jme, kms, kme, &
4349 ips, ipe, jps, jpe, kps, kpe, &
4350 its, ite, jts, jte, kts, kte
4351 INTEGER , INTENT(IN ) :: ijds, ijde
4352 INTEGER , INTENT(IN ) :: spec_bdy_width, spec_zone
4353
4354 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: ru_tend, &
4355 rv_tend, &
4356 ph_tend, &
4357 rw_tend, &
4358 t_tend
4359 REAL , DIMENSION( ims:ime , jms:jme ) :: mu_tend
4360 REAL, DIMENSION( ijds:ijde , kds:kde , spec_bdy_width, 4 ), INTENT(IN ) :: u_b, &
4361 v_b, &
4362 ph_b, &
4363 w_b, &
4364 t_b
4365 REAL, DIMENSION( ijds:ijde , kds:kde , spec_bdy_width, 4 ) :: u_bt, &
4366 v_bt, &
4367 ph_bt, &
4368 w_bt, &
4369 t_bt
4370
4371 REAL, DIMENSION( ijds:ijde , 1:1 , spec_bdy_width, 4 ), INTENT(IN ) :: mu_b
4372 REAL, DIMENSION( ijds:ijde , 1:1 , spec_bdy_width, 4 ) :: mu_bt
4373
4374 ! zzma: new definition
4375
4376 ! IN variables
4377
4378 REAL, DIMENSION( ijds:ijde , kds:kde , spec_bdy_width, 4 ) :: S_u_bt, &
4379 S_v_bt, &
4380 S_ph_bt, &
4381 S_w_bt, &
4382 S_t_bt
4383 REAL, DIMENSION( ijds:ijde , kds:kde , spec_bdy_width, 4 ) :: P_u_bt, &
4384 P_v_bt, &
4385 P_ph_bt, &
4386 P_w_bt, &
4387 P_t_bt
4388 REAL, DIMENSION( ijds:ijde , kds:kde , spec_bdy_width, 4 ) :: B_u_bt, &
4389 B_v_bt, &
4390 B_ph_bt, &
4391 B_w_bt, &
4392 B_t_bt
4393
4394 REAL, DIMENSION( ijds:ijde , 1:1 , spec_bdy_width, 4 ) :: S_mu_bt,P_mu_bt, B_mu_bt
4395
4396 ! OUT variables
4397
4398 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: S_ru_tend, &
4399 S_rv_tend, &
4400 S_ph_tend, &
4401 S_rw_tend, &
4402 S_t_tend
4403
4404 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: P_ru_tend, &
4405 P_rv_tend, &
4406 P_ph_tend, &
4407 P_rw_tend, &
4408 P_t_tend
4409
4410 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: B_ru_tend, &
4411 B_rv_tend, &
4412 B_ph_tend, &
4413 B_rw_tend, &
4414 B_t_tend
4415
4416 REAL , DIMENSION( ims:ime , jms:jme ) :: S_mu_tend,P_mu_tend,B_mu_tend
4417
4418 REAL :: SAVE_L, COEF, ALPHA, FACTOR, VAL_N, VAL_L, VAL_A
4419 INTEGER :: NT,i,j,k,h
4420
4421 ! zzma: new definition end
4422
4423 S_u_bt(:,:,:,:)=u_bt(:,:,:,:)
4424 S_v_bt(:,:,:,:)=v_bt(:,:,:,:)
4425 S_ph_bt(:,:,:,:)=ph_bt(:,:,:,:)
4426 S_w_bt(:,:,:,:)=w_bt(:,:,:,:)
4427 S_t_bt(:,:,:,:)=t_bt(:,:,:,:)
4428
4429 P_u_bt(:,:,:,:)=u_bt(:,:,:,:)
4430 P_v_bt(:,:,:,:)=v_bt(:,:,:,:)
4431 P_ph_bt(:,:,:,:)=ph_bt(:,:,:,:)
4432 P_w_bt(:,:,:,:)=w_bt(:,:,:,:)
4433 P_t_bt(:,:,:,:)=t_bt(:,:,:,:)
4434
4435 S_mu_bt(:,:,:,:)=mu_bt(:,:,:,:)
4436 P_mu_bt(:,:,:,:)=mu_bt(:,:,:,:)
4437
4438 S_ru_tend(:,:,:)=ru_tend(:,:,:)
4439 S_rv_tend(:,:,:)=rv_tend(:,:,:)
4440 S_rw_tend(:,:,:)=rw_tend(:,:,:)
4441 S_t_tend(:,:,:)=t_tend(:,:,:)
4442 S_ph_tend(:,:,:)=ph_tend(:,:,:)
4443
4444 P_ru_tend(:,:,:)=ru_tend(:,:,:)
4445 P_rv_tend(:,:,:)=rv_tend(:,:,:)
4446 P_rw_tend(:,:,:)=rw_tend(:,:,:)
4447 P_t_tend(:,:,:)=t_tend(:,:,:)
4448 P_ph_tend(:,:,:)=ph_tend(:,:,:)
4449
4450 S_mu_tend(:,:)=mu_tend(:,:)
4451 P_mu_tend(:,:)=mu_tend(:,:)
4452
4453 !NLM
4454
4455 CALL spec_bdy_dry ( config_flags, &
4456 ru_tend, rv_tend, ph_tend, t_tend, &
4457 rw_tend, mu_tend, &
4458 u_b, v_b, ph_b, t_b, &
4459 w_b, mu_b, &
4460 u_bt, v_bt, ph_bt, t_bt, &
4461 w_bt, mu_bt, &
4462 spec_bdy_width, spec_zone, &
4463 ijds, ijde, & ! min/max(id,jd)
4464 ids,ide, jds,jde, kds,kde, & ! domain dims
4465 ims,ime, jms,jme, kms,kme, & ! memory dims
4466 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4467 its, ite, jts, jte, kts, kte)
4468
4469 B_u_bt(:,:,:,:)=u_bt(:,:,:,:)
4470 B_v_bt(:,:,:,:)=v_bt(:,:,:,:)
4471 B_ph_bt(:,:,:,:)=ph_bt(:,:,:,:)
4472 B_w_bt(:,:,:,:)=w_bt(:,:,:,:)
4473 B_t_bt(:,:,:,:)=t_bt(:,:,:,:)
4474 B_mu_bt(:,:,:,:)=mu_bt(:,:,:,:)
4475
4476 B_ru_tend(:,:,:)=ru_tend(:,:,:)
4477 B_rv_tend(:,:,:)=rv_tend(:,:,:)
4478 B_rw_tend(:,:,:)=rw_tend(:,:,:)
4479 B_t_tend(:,:,:)=t_tend(:,:,:)
4480 B_ph_tend(:,:,:)=ph_tend(:,:,:)
4481
4482 B_mu_tend(:,:)=mu_tend(:,:)
4483
4484 ! TCL
4485
4486 u_bt(:,:,:,:)=S_u_bt(:,:,:,:)
4487 v_bt(:,:,:,:)=S_v_bt(:,:,:,:)
4488 ph_bt(:,:,:,:)=S_ph_bt(:,:,:,:)
4489 w_bt(:,:,:,:)=S_w_bt(:,:,:,:)
4490 t_bt(:,:,:,:)=S_t_bt(:,:,:,:)
4491 mu_bt(:,:,:,:)=S_mu_bt(:,:,:,:)
4492
4493 rv_tend(:,:,:)=S_rv_tend(:,:,:)
4494 rw_tend(:,:,:)=S_rw_tend(:,:,:)
4495 t_tend(:,:,:)=S_t_tend(:,:,:)
4496 ph_tend(:,:,:)=S_ph_tend(:,:,:)
4497 mu_tend(:,:)=S_mu_tend(:,:)
4498
4499 CALL g_spec_bdy_dry( config_flags, ru_tend, P_ru_tend, rv_tend, P_rv_tend, ph_tend, P_ph_tend, t_tend, P_t_tend, rw_tend, &
4500 &P_rw_tend, mu_tend, P_mu_tend, u_bt, P_u_bt, v_bt, P_v_bt, ph_bt, P_ph_bt, t_bt, P_t_bt, w_bt, P_w_bt, mu_bt, P_mu_bt, &
4501 &spec_bdy_width, spec_zone, ijds, ijde, ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
4502
4503 SAVE_L = sum(P_u_bt(:,:,:,:)*P_u_bt(:,:,:,:))+ &
4504 sum(P_v_bt(:,:,:,:)*P_v_bt(:,:,:,:))+ &
4505 sum(P_ph_bt(:,:,:,:)*P_ph_bt(:,:,:,:))+ &
4506 sum(P_w_bt(:,:,:,:)*P_w_bt(:,:,:,:))+ &
4507 sum(P_t_bt(:,:,:,:)*P_t_bt(:,:,:,:))+ &
4508 sum(P_mu_bt(:,:,:,:)*P_mu_bt(:,:,:,:))
4509
4510 SAVE_L=SAVE_L + sum(P_ru_tend(:,:,:)*P_ru_tend(:,:,:))+ &
4511 sum(P_rv_tend(:,:,:)*P_rv_tend(:,:,:))+ &
4512 sum(P_rw_tend(:,:,:)*P_rw_tend(:,:,:))+ &
4513 sum(P_t_tend(:,:,:)*P_t_tend(:,:,:))+ &
4514 sum(P_ph_tend(:,:,:)*P_ph_tend(:,:,:))+ &
4515 sum(P_mu_tend(:,:)*P_mu_tend(:,:))
4516
4517 ALPHA=1.
4518 DO NT=1,11
4519 ALPHA=0.1*ALPHA
4520 FACTOR=1.+ALPHA
4521 P_u_bt(:,:,:,:)=FACTOR*S_u_bt(:,:,:,:)
4522 P_v_bt(:,:,:,:)=FACTOR*S_v_bt(:,:,:,:)
4523 P_ph_bt(:,:,:,:)=FACTOR*S_ph_bt(:,:,:,:)
4524 P_w_bt(:,:,:,:)=FACTOR*S_w_bt(:,:,:,:)
4525 P_t_bt(:,:,:,:)=FACTOR*S_t_bt(:,:,:,:)
4526
4527 P_mu_bt(:,:,:,:)=FACTOR*S_mu_bt(:,:,:,:)
4528
4529 P_ru_tend(:,:,:)=FACTOR*S_ru_tend(:,:,:)
4530 P_rv_tend(:,:,:)=FACTOR*S_rv_tend(:,:,:)
4531 P_rw_tend(:,:,:)=FACTOR*S_rw_tend(:,:,:)
4532 P_t_tend(:,:,:)=FACTOR*S_t_tend(:,:,:)
4533 P_ph_tend(:,:,:)=FACTOR*S_ph_tend(:,:,:)
4534
4535 P_mu_tend(:,:)=FACTOR*S_mu_tend(:,:)
4536
4537 CALL spec_bdy_dry ( config_flags, &
4538 P_ru_tend, P_rv_tend, P_ph_tend, P_t_tend, &
4539 P_rw_tend, P_mu_tend, &
4540 u_b, v_b, ph_b, t_b, &
4541 w_b, mu_b, &
4542 P_u_bt, P_v_bt, P_ph_bt, P_t_bt, &
4543 P_w_bt, P_mu_bt, &
4544 spec_bdy_width, spec_zone, &
4545 ijds, ijde, & ! min/max(id,jd)
4546 ids,ide, jds,jde, kds,kde, & ! domain dims
4547 ims,ime, jms,jme, kms,kme, & ! memory dims
4548 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
4549 its, ite, jts, jte, kts, kte)
4550
4551 VAL_N=sum((P_u_bt(:,:,:,:)-B_u_bt(:,:,:,:))*(P_u_bt(:,:,:,:)-B_u_bt(:,:,:,:))) + &
4552 sum((P_v_bt(:,:,:,:)-B_v_bt(:,:,:,:))*(P_v_bt(:,:,:,:)-B_v_bt(:,:,:,:)))+ &
4553 sum((P_ph_bt(:,:,:,:)-B_ph_bt(:,:,:,:))*(P_ph_bt(:,:,:,:)-B_ph_bt(:,:,:,:)))+ &
4554 sum((P_w_bt(:,:,:,:)-B_w_bt(:,:,:,:))*(P_w_bt(:,:,:,:)-B_w_bt(:,:,:,:)))+ &
4555 sum((P_t_bt(:,:,:,:)-B_t_bt(:,:,:,:))*(P_t_bt(:,:,:,:)-B_t_bt(:,:,:,:)))+ &
4556 sum((P_mu_bt(:,:,:,:)-B_mu_bt(:,:,:,:))*(P_mu_bt(:,:,:,:)-B_mu_bt(:,:,:,:)))
4557
4558 VAL_N=VAL_N + sum((P_ru_tend(:,:,:)-B_ru_tend(:,:,:))*(P_ru_tend(:,:,:)-B_ru_tend(:,:,:)))+ &
4559 sum((P_rv_tend(:,:,:)-B_rv_tend(:,:,:))*(P_rv_tend(:,:,:)-B_rv_tend(:,:,:)))+ &
4560 sum((P_rw_tend(:,:,:)-B_rw_tend(:,:,:))*(P_rw_tend(:,:,:)-B_rw_tend(:,:,:)))+ &
4561 sum((P_t_tend(:,:,:)-B_t_tend(:,:,:))*(P_t_tend(:,:,:)-B_t_tend(:,:,:)))+ &
4562 sum((P_ph_tend(:,:,:)-B_ph_tend(:,:,:))*(P_ph_tend(:,:,:)-B_ph_tend(:,:,:)))+ &
4563 sum((P_mu_tend(:,:)-B_mu_tend(:,:))*(P_mu_tend(:,:)-B_mu_tend(:,:)))
4564
4565 VAL_L=SAVE_L*ALPHA**2
4566 COEF=VAL_N/VAL_L
4567 WRITE(6, fmt='(A,E9.4,A,E22.13,A,E13.6,A,E13.6)') &
4568 'g_spec_bdy_dry: ALPHA=',ALPHA,' COEF=',COEF, &
4569 ' VAL_N=',VAL_N,' VAL_L=',VAL_L
4570 ENDDO
4571
4572 ! ADJ test
4573
4574 FACTOR=0.1
4575 u_bt(:,:,:,:)=S_u_bt(:,:,:,:)
4576 v_bt(:,:,:,:)=S_v_bt(:,:,:,:)
4577 ph_bt(:,:,:,:)=S_ph_bt(:,:,:,:)
4578 w_bt(:,:,:,:)=S_w_bt(:,:,:,:)
4579 t_bt(:,:,:,:)=S_t_bt(:,:,:,:)
4580
4581 P_u_bt(:,:,:,:)=FACTOR*S_u_bt(:,:,:,:)
4582 P_v_bt(:,:,:,:)=FACTOR*S_v_bt(:,:,:,:)
4583 P_ph_bt(:,:,:,:)=FACTOR*S_ph_bt(:,:,:,:)
4584 P_w_bt(:,:,:,:)=FACTOR*S_w_bt(:,:,:,:)
4585 P_t_bt(:,:,:,:)=FACTOR*S_t_bt(:,:,:,:)
4586
4587 B_u_bt(:,:,:,:)=P_u_bt(:,:,:,:)
4588 B_v_bt(:,:,:,:)=P_v_bt(:,:,:,:)
4589 B_ph_bt(:,:,:,:)=P_ph_bt(:,:,:,:)
4590 B_w_bt(:,:,:,:)=P_w_bt(:,:,:,:)
4591 B_t_bt(:,:,:,:)=P_t_bt(:,:,:,:)
4592
4593 mu_bt(:,:,:,:)=S_mu_bt(:,:,:,:)
4594 P_mu_bt(:,:,:,:)=FACTOR*S_mu_bt(:,:,:,:)
4595 B_mu_bt(:,:,:,:)=P_mu_bt(:,:,:,:)
4596
4597 ru_tend(:,:,:)=S_ru_tend(:,:,:)
4598 rv_tend(:,:,:)=S_rv_tend(:,:,:)
4599 rw_tend(:,:,:)=S_rw_tend(:,:,:)
4600 t_tend(:,:,:)=S_t_tend(:,:,:)
4601 ph_tend(:,:,:)=S_ph_tend(:,:,:)
4602
4603 P_ru_tend(:,:,:)=FACTOR*S_ru_tend(:,:,:)
4604 P_rv_tend(:,:,:)=FACTOR*S_rv_tend(:,:,:)
4605 P_rw_tend(:,:,:)=FACTOR*S_rw_tend(:,:,:)
4606 P_t_tend(:,:,:)=FACTOR*S_t_tend(:,:,:)
4607 P_ph_tend(:,:,:)=FACTOR*S_ph_tend(:,:,:)
4608
4609 B_ru_tend(:,:,:)=P_ru_tend(:,:,:)
4610 B_rv_tend(:,:,:)=P_rv_tend(:,:,:)
4611 B_rw_tend(:,:,:)=P_rw_tend(:,:,:)
4612 B_t_tend(:,:,:)=P_t_tend(:,:,:)
4613 B_ph_tend(:,:,:)=P_ph_tend(:,:,:)
4614
4615 mu_tend(:,:)=S_mu_tend(:,:)
4616 P_mu_tend(:,:)=FACTOR*S_mu_tend(:,:)
4617 B_mu_tend(:,:)=P_mu_tend(:,:)
4618
4619 ! TGL
4620
4621 CALL g_spec_bdy_dry( config_flags, ru_tend, P_ru_tend, rv_tend, P_rv_tend, ph_tend, P_ph_tend, t_tend, P_t_tend, rw_tend, &
4622 &P_rw_tend, mu_tend, P_mu_tend, u_bt, P_u_bt, v_bt, P_v_bt, ph_bt, P_ph_bt, t_bt, P_t_bt, w_bt, P_w_bt, mu_bt, P_mu_bt, &
4623 &spec_bdy_width, spec_zone, ijds, ijde, ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
4624
4625 VAL_L=sum(P_ru_tend(:,:,:)*P_ru_tend(:,:,:))+ &
4626 sum(P_rv_tend(:,:,:)*P_rv_tend(:,:,:))+ &
4627 sum(P_rw_tend(:,:,:)*P_rw_tend(:,:,:))+ &
4628 sum(P_t_tend(:,:,:)*P_t_tend(:,:,:))+ &
4629 sum(P_ph_tend(:,:,:)*P_ph_tend(:,:,:))+ &
4630 sum(P_mu_tend(:,:)*P_mu_tend(:,:))
4631 VAL_L=VAL_L+sum(P_u_bt(:,:,:,:)*P_u_bt(:,:,:,:))+ &
4632 sum(P_v_bt(:,:,:,:)*P_v_bt(:,:,:,:))+ &
4633 sum(P_ph_bt(:,:,:,:)*P_ph_bt(:,:,:,:))+ &
4634 sum(P_w_bt(:,:,:,:)*P_w_bt(:,:,:,:))+ &
4635 sum(P_t_bt(:,:,:,:)*P_t_bt(:,:,:,:))+ &
4636 sum(P_mu_bt(:,:,:,:)*P_mu_bt(:,:,:,:))
4637
4638 ! ADJ
4639
4640 CALL a_spec_bdy_dry( config_flags, P_ru_tend, P_rv_tend, P_ph_tend, P_t_tend, P_rw_tend, P_mu_tend, P_u_bt, P_v_bt, P_ph_bt, &
4641 &P_t_bt, P_w_bt, P_mu_bt, spec_bdy_width, spec_zone, ijds, ijde, ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, &
4642 &ite, jts, jte, kts, kte )
4643
4644 VAL_A=sum(P_u_bt(:,:,:,:)*B_u_bt(:,:,:,:))+ &
4645 sum(P_v_bt(:,:,:,:)*B_v_bt(:,:,:,:))+ &
4646 sum(P_ph_bt(:,:,:,:)*B_ph_bt(:,:,:,:))+ &
4647 sum(P_w_bt(:,:,:,:)*B_w_bt(:,:,:,:))+ &
4648 sum(P_t_bt(:,:,:,:)*B_t_bt(:,:,:,:))+ &
4649 sum(P_mu_bt(:,:,:,:)*B_mu_bt(:,:,:,:))
4650 VAL_A=VAL_A+sum(P_ru_tend(:,:,:)*B_ru_tend(:,:,:))+ &
4651 sum(P_rv_tend(:,:,:)*B_rv_tend(:,:,:))+ &
4652 sum(P_rw_tend(:,:,:)*B_rw_tend(:,:,:))+ &
4653 sum(P_t_tend(:,:,:)*B_t_tend(:,:,:))+ &
4654 sum(P_ph_tend(:,:,:)*B_ph_tend(:,:,:))+ &
4655 sum(P_mu_tend(:,:)*B_mu_tend(:,:))
4656
4657 print*, ' '
4658 write(6,fmt='(A,2E22.13)') 'a_spec_bdy_dry: ', VAL_L,VAL_A
4659
4660 ! RECOVER
4661
4662 u_bt(:,:,:,:)=S_u_bt(:,:,:,:)
4663 v_bt(:,:,:,:)=S_v_bt(:,:,:,:)
4664 ph_bt(:,:,:,:)=S_ph_bt(:,:,:,:)
4665 w_bt(:,:,:,:)=S_w_bt(:,:,:,:)
4666 t_bt(:,:,:,:)=S_t_bt(:,:,:,:)
4667
4668 mu_bt(:,:,:,:)=S_mu_bt(:,:,:,:)
4669
4670 ru_tend(:,:,:)=S_ru_tend(:,:,:)
4671 rv_tend(:,:,:)=S_rv_tend(:,:,:)
4672 rw_tend(:,:,:)=S_rw_tend(:,:,:)
4673 t_tend(:,:,:)=S_t_tend(:,:,:)
4674 ph_tend(:,:,:)=S_ph_tend(:,:,:)
4675
4676 mu_tend(:,:)=S_mu_tend(:,:)
4677
4678 END SUBROUTINE t_spec_bdy_dry
4679
4680 !----------------------------------------------------------------------------------------------
4681
4682 SUBROUTINE t_small_step_prep( u_1, u_2, v_1, v_2, w_1, w_2, &
4683 t_1, t_2, ph_1, ph_2, &
4684 mub, mu_1, mu_2, &
4685 muu, muus, muv, muvs, &
4686 mut, muts, mudf, &
4687 u_save, v_save, w_save, &
4688 t_save, ph_save, mu_save, &
4689 ww, ww_save, &
4690 dnw, c2a, pb, p, alt, &
4691 msfu, msfv, msft, &
4692 rk_step, &
4693 ids,ide, jds,jde, kds,kde, &
4694 ims,ime, jms,jme, kms,kme, &
4695 its,ite, jts,jte, kts,kte )
4696
4697 ! Zaizhong Ma, March 28,2005
4698
4699 IMPLICIT NONE ! religion first
4700
4701 ! declarations for the stuff coming in
4702
4703 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
4704 INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
4705 INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
4706
4707 INTEGER, INTENT(IN ) :: rk_step
4708
4709 REAL, DIMENSION(ims:ime, kms:kme, jms:jme),INTENT(INOUT) :: u_1, &
4710 v_1, &
4711 w_1, &
4712 t_1, &
4713 ph_1
4714
4715 REAL, DIMENSION(ims:ime, kms:kme, jms:jme),INTENT( OUT) :: u_save, &
4716 v_save, &
4717 w_save, &
4718 t_save, &
4719 ph_save
4720
4721 REAL, DIMENSION(ims:ime, kms:kme, jms:jme),INTENT(INOUT) :: u_2, &
4722 v_2, &
4723 w_2, &
4724 t_2, &
4725 ph_2
4726
4727 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT( OUT) :: c2a, &
4728 ww_save
4729
4730 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: pb, &
4731 p, &
4732 alt, &
4733 ww
4734
4735 ! pjj/cray
4736 ! REAL, DIMENSION(ims:ime, jms:jme) , INTENT(INOUT) :: mu_1
4737 REAL, DIMENSION(ims:ime, jms:jme) , INTENT(INOUT) :: mu_1,mu_2
4738
4739 REAL, DIMENSION(ims:ime, jms:jme) , INTENT(INout) :: mub, &
4740 muu, &
4741 muv, &
4742 mut, &
4743 msfu, &
4744 msfv, &
4745 msft
4746
4747 REAL, DIMENSION(ims:ime, jms:jme) , INTENT( OUT) :: muus, &
4748 muvs, &
4749 muts, &
4750 !pjj/cray
4751 ! mu_2, &
4752 mudf
4753 REAL, DIMENSION(ims:ime, jms:jme) , INTENT( OUT) :: mu_save
4754
4755 REAL, DIMENSION(kms:kme, jms:jme) , INTENT(IN ) :: dnw
4756
4757 ! local variables
4758
4759 INTEGER :: i, j, k
4760 INTEGER :: i_start, i_end, j_start, j_end, k_start, k_end
4761 INTEGER :: i_endu, j_endv
4762
4763 ! zzma: new definition
4764
4765 ! IN variables
4766
4767 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: S_p, &
4768 S_alt, &
4769 S_ww
4770 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: P_p, &
4771 P_alt, &
4772 P_ww
4773 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: B_p, &
4774 B_alt, &
4775 B_ww
4776
4777 ! INOUT variables
4778
4779 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: S_u_1, &
4780 S_v_1, &
4781 S_w_1, &
4782 S_t_1, &
4783 S_ph_1, &
4784 S_u_2, &
4785 S_v_2, &
4786 S_w_2, &
4787 S_t_2, &
4788 S_ph_2
4789 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: P_u_1, &
4790 P_v_1, &
4791 P_w_1, &
4792 P_t_1, &
4793 P_ph_1, &
4794 P_u_2, &
4795 P_v_2, &
4796 P_w_2, &
4797 P_t_2, &
4798 P_ph_2
4799 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: B_u_1, &
4800 B_v_1, &
4801 B_w_1, &
4802 B_t_1, &
4803 B_ph_1, &
4804 B_u_2, &
4805 B_v_2, &
4806 B_w_2, &
4807 B_t_2, &
4808 B_ph_2
4809 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: K_u_1, &
4810 K_v_1, &
4811 K_w_1, &
4812 K_t_1, &
4813 K_ph_1, &
4814 K_u_2, &
4815 K_v_2, &
4816 K_w_2, &
4817 K_t_2, &
4818 K_ph_2
4819
4820
4821 REAL, DIMENSION(ims:ime, jms:jme) :: S_mu_1, &
4822 S_mu_2, &
4823 S_muu, &
4824 S_muv, &
4825 S_mut
4826 REAL, DIMENSION(ims:ime, jms:jme) :: P_mu_1, &
4827 P_mu_2, &
4828 P_muu, &
4829 P_muv, &
4830 P_mut
4831 REAL, DIMENSION(ims:ime, jms:jme) :: B_mu_1, &
4832 B_mu_2, &
4833 B_muu, &
4834 B_muv, &
4835 B_mut
4836 REAL, DIMENSION(ims:ime, jms:jme) :: K_mu_1, &
4837 K_mu_2, &
4838 K_muu, &
4839 K_muv, &
4840 K_mut
4841 ! OUT variables
4842
4843 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: P_u_save, &
4844 P_v_save, &
4845 P_w_save, &
4846 P_t_save, &
4847 P_ph_save, &
4848 P_c2a, &
4849 P_ww_save
4850 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: B_u_save, &
4851 B_v_save, &
4852 B_w_save, &
4853 B_t_save, &
4854 B_ph_save, &
4855 B_c2a, &
4856 B_ww_save
4857
4858 REAL, DIMENSION(ims:ime, jms:jme) :: P_muus, &
4859 P_muvs, &
4860 P_muts, &
4861 P_mu_save ,&
4862 P_mudf
4863 REAL, DIMENSION(ims:ime, jms:jme) :: B_muus, &
4864 B_muvs, &
4865 B_muts, &
4866 B_mu_save ,&
4867 B_mudf
4868
4869 REAL :: SAVE_L, COEF, ALPHA, FACTOR, VAL_N, VAL_L, VAL_A
4870 INTEGER :: NT
4871
4872 ! zzma: new definition end
4873
4874 !TGL test
4875
4876 do i=ims,ime
4877 do k=kms,kme
4878 do j=jms,jme
4879 S_p(i,k,j)=p(i,k,j)
4880 S_alt(i,k,j)=alt(i,k,j)
4881 S_ww(i,k,j)=ww(i,k,j)
4882
4883 P_p(i,k,j)=p(i,k,j)
4884 P_alt(i,k,j)=alt(i,k,j)
4885 P_ww(i,k,j)=ww(i,k,j)
4886 enddo
4887 enddo
4888 enddo
4889 do i=ims,ime
4890 do k=kms,kme
4891 do j=jms,jme
4892 S_u_1(i,k,j)=u_1(i,k,j)
4893 S_v_1(i,k,j)=v_1(i,k,j)
4894 S_w_1(i,k,j)=w_1(i,k,j)
4895 S_t_1(i,k,j)=t_1(i,k,j)
4896 S_ph_1(i,k,j)=ph_1(i,k,j)
4897 S_u_2(i,k,j)=u_2(i,k,j)
4898 S_v_2(i,k,j)=v_2(i,k,j)
4899 S_w_2(i,k,j)=w_2(i,k,j)
4900 S_t_2(i,k,j)=t_2(i,k,j)
4901 S_ph_2(i,k,j)=ph_2(i,k,j)
4902
4903 P_u_1(i,k,j)=u_1(i,k,j)
4904 P_v_1(i,k,j)=v_1(i,k,j)
4905 P_w_1(i,k,j)=w_1(i,k,j)
4906 P_t_1(i,k,j)=t_1(i,k,j)
4907 P_ph_1(i,k,j)=ph_1(i,k,j)
4908 P_u_2(i,k,j)=u_2(i,k,j)
4909 P_v_2(i,k,j)=v_2(i,k,j)
4910 P_w_2(i,k,j)=w_2(i,k,j)
4911 P_t_2(i,k,j)=t_2(i,k,j)
4912 P_ph_2(i,k,j)=ph_2(i,k,j)
4913
4914 K_u_1(i,k,j)=u_1(i,k,j)
4915 K_v_1(i,k,j)=v_1(i,k,j)
4916 K_w_1(i,k,j)=w_1(i,k,j)
4917 K_t_1(i,k,j)=t_1(i,k,j)
4918 K_ph_1(i,k,j)=ph_1(i,k,j)
4919 K_u_2(i,k,j)=u_2(i,k,j)
4920 K_v_2(i,k,j)=v_2(i,k,j)
4921 K_w_2(i,k,j)=w_2(i,k,j)
4922 K_t_2(i,k,j)=t_2(i,k,j)
4923 K_ph_2(i,k,j)=ph_2(i,k,j)
4924 enddo
4925 enddo
4926 enddo
4927 do i=ims,ime
4928 do j=jms,jme
4929 S_mu_1(i,j)=mu_1(i,j)
4930 S_mu_2(i,j)=mu_2(i,j)
4931 S_mut(i,j)=mut(i,j)
4932 S_muu(i,j)=muu(i,j)
4933 S_muv(i,j)=muv(i,j)
4934
4935 P_mu_1(i,j)=mu_1(i,j)
4936 P_mu_2(i,j)=mu_2(i,j)
4937 P_mut(i,j)=mut(i,j)
4938 P_muu(i,j)=muu(i,j)
4939 P_muv(i,j)=muv(i,j)
4940
4941 K_mu_1(i,j)=mu_1(i,j)
4942 K_mu_2(i,j)=mu_2(i,j)
4943 K_mut(i,j)=mut(i,j)
4944 K_muu(i,j)=muu(i,j)
4945 K_muv(i,j)=muv(i,j)
4946
4947 enddo
4948 enddo
4949
4950 !NLM
4951
4952 CALL small_step_prep( u_1, u_2, v_1, v_2, w_1, w_2, &
4953 t_1, t_2, ph_1, ph_2, &
4954 mub, mu_1, mu_2, &
4955 muu, muus, muv, muvs, &
4956 mut, muts, mudf, &
4957 u_save, v_save, w_save, &
4958 t_save, ph_save, mu_save, &
4959 ww, ww_save, &
4960 dnw, c2a, pb, p, alt, &
4961 msfu, msfv, msft, &
4962 rk_step, &
4963 ids,ide, jds,jde, kds,kde, &
4964 ims,ime, jms,jme, kms,kme, &
4965 its,ite, jts,jte, kts,kte )
4966
4967 do i=ims,ime
4968 do k=kms,kme
4969 do j=jms,jme
4970 B_u_1(i,k,j)=u_1(i,k,j)
4971 B_v_1(i,k,j)=v_1(i,k,j)
4972 B_w_1(i,k,j)=w_1(i,k,j)
4973 B_t_1(i,k,j)=t_1(i,k,j)
4974 B_ph_1(i,k,j)=ph_1(i,k,j)
4975 B_u_2(i,k,j)=u_2(i,k,j)
4976 B_v_2(i,k,j)=v_2(i,k,j)
4977 B_w_2(i,k,j)=w_2(i,k,j)
4978 B_t_2(i,k,j)=t_2(i,k,j)
4979 B_ph_2(i,k,j)=ph_2(i,k,j)
4980 enddo
4981 enddo
4982 enddo
4983 do i=ims,ime
4984 do j=jms,jme
4985 B_mu_1(i,j)=mu_1(i,j)
4986 B_mu_2(i,j)=mu_2(i,j)
4987 B_mut(i,j)=mut(i,j)
4988 B_muu(i,j)=muu(i,j)
4989 B_muv(i,j)=muv(i,j)
4990 enddo
4991 enddo
4992
4993 do i=ims,ime
4994 do k=kms,kme
4995 do j=jms,jme
4996 B_u_save(i,k,j)=u_save(i,k,j)
4997 B_v_save(i,k,j)=v_save(i,k,j)
4998 B_w_save(i,k,j)=w_save(i,k,j)
4999 B_ph_save(i,k,j)=ph_save(i,k,j)
5000 B_t_save(i,k,j)=t_save(i,k,j)
5001 B_c2a(i,k,j)=c2a(i,k,j)
5002 B_ww_save(i,k,j)=ww_save(i,k,j)
5003 enddo
5004 enddo
5005 enddo
5006 do i=ims,ime
5007 do j=jms,jme
5008 B_muus(i,j)=muus(i,j)
5009 B_muvs(i,j)=muvs(i,j)
5010 B_muts(i,j)=muts(i,j)
5011 B_mu_save(i,j)=mu_save(i,j)
5012 B_mudf(i,j)=mudf(i,j)
5013 enddo
5014 enddo
5015
5016 ! TCL
5017
5018 CALL g_small_step_prep( K_u_1, P_u_1, K_u_2, P_u_2, K_v_1, P_v_1, K_v_2, P_v_2, K_w_1, P_w_1, K_w_2, P_w_2, K_t_1, P_t_1, K_t_2, P_t_2, K_ph_1,&
5019 & P_ph_1, K_ph_2, P_ph_2, mub, K_mu_1, P_mu_1, K_mu_2, P_mu_2, K_muu, P_muu, muus, P_muus, K_muv, P_muv, muvs, P_muvs, K_mut, P_mut, muts, &
5020 &P_muts, mudf, P_mudf, u_save, P_u_save, v_save, P_v_save, w_save, P_w_save, t_save, P_t_save, ph_save, P_ph_save, mu_save, &
5021 &P_mu_save, ww, P_ww, ww_save, P_ww_save, c2a, P_c2a, pb, p, P_p, alt, P_alt, msfu, msfv, msft, rk_step, ide, jde, kde, &
5022 &ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
5023
5024 SAVE_L=0.
5025 do i=ims,ime
5026 do k=kms,kme
5027 do j=jms,jme
5028 SAVE_L=SAVE_L + P_u_1(i,k,j)*P_u_1(i,k,j) &
5029 + P_v_1(i,k,j)*P_v_1(i,k,j) &
5030 + P_w_1(i,k,j)*P_w_1(i,k,j) &
5031 + P_t_1(i,k,j)*P_t_1(i,k,j) &
5032 + P_ph_1(i,k,j)*P_ph_1(i,k,j) &
5033 + P_u_2(i,k,j)*P_u_2(i,k,j) &
5034 + P_v_2(i,k,j)*P_v_2(i,k,j) &
5035 + P_w_2(i,k,j)*P_w_2(i,k,j) &
5036 + P_t_2(i,k,j)*P_t_2(i,k,j) &
5037 + P_ph_2(i,k,j)*P_ph_2(i,k,j)
5038 enddo
5039 enddo
5040 enddo
5041 do i=ims,ime
5042 do j=jms,jme
5043 SAVE_L=SAVE_L + P_mu_1(i,j)*P_mu_1(i,j) &
5044 + P_mu_2(i,j)*P_mu_2(i,j) &
5045 + P_mut(i,j)*P_mut(i,j) &
5046 + P_muu(i,j)*P_muu(i,j) &
5047 + P_muv(i,j)*P_muv(i,j)
5048 enddo
5049 enddo
5050 do i=ims,ime
5051 do k=kms,kme
5052 do j=jms,jme
5053 SAVE_L=SAVE_L + P_u_save(i,k,j)*P_u_save(i,k,j) &
5054 + P_v_save(i,k,j)*P_v_save(i,k,j) &
5055 + P_w_save(i,k,j)*P_w_save(i,k,j) &
5056 + P_ph_save(i,k,j)*P_ph_save(i,k,j) &
5057 + P_t_save(i,k,j)*P_t_save(i,k,j) &
5058 + P_c2a(i,k,j)*P_c2a(i,k,j) &
5059 + P_ww_save(i,k,j)*P_ww_save(i,k,j)
5060 enddo
5061 enddo
5062 enddo
5063 do i=ims,ime
5064 do j=jms,jme
5065 SAVE_L=SAVE_L + P_muus(i,j)*P_muus(i,j) &
5066 + P_muvs(i,j)*P_muvs(i,j) &
5067 + P_muts(i,j)*P_muts(i,j) &
5068 + P_mu_save(i,j)*P_mu_save(i,j) &
5069 + P_mudf(i,j)*P_mudf(i,j)
5070 enddo
5071 enddo
5072
5073 ALPHA=1.
5074 DO NT=1,11
5075 ALPHA=0.1*ALPHA
5076 FACTOR=1.+ALPHA
5077 do i=ims,ime
5078 do k=kms,kme
5079 do j=jms,jme
5080 P_p(i,k,j)=FACTOR*S_p(i,k,j)
5081 P_alt(i,k,j)=FACTOR*S_alt(i,k,j)
5082 P_ww(i,k,j)=FACTOR*S_ww(i,k,j)
5083 enddo
5084 enddo
5085 enddo
5086 do i=ims,ime
5087 do k=kms,kme
5088 do j=jms,jme
5089 P_u_1(i,k,j)=FACTOR*S_u_1(i,k,j)
5090 P_v_1(i,k,j)=FACTOR*S_v_1(i,k,j)
5091 P_w_1(i,k,j)=FACTOR*S_w_1(i,k,j)
5092 P_t_1(i,k,j)=FACTOR*S_t_1(i,k,j)
5093 P_ph_1(i,k,j)=FACTOR*S_ph_1(i,k,j)
5094 P_u_2(i,k,j)=FACTOR*S_u_2(i,k,j)
5095 P_v_2(i,k,j)=FACTOR*S_v_2(i,k,j)
5096 P_w_2(i,k,j)=FACTOR*S_w_2(i,k,j)
5097 P_t_2(i,k,j)=FACTOR*S_t_2(i,k,j)
5098 P_ph_2(i,k,j)=FACTOR*S_ph_2(i,k,j)
5099 enddo
5100 enddo
5101 enddo
5102 do i=ims,ime
5103 do j=jms,jme
5104 P_mu_1(i,j)=FACTOR*S_mu_1(i,j)
5105 P_mu_2(i,j)=FACTOR*S_mu_2(i,j)
5106 P_mut(i,j)=FACTOR*S_mut(i,j)
5107 P_muu(i,j)=FACTOR*S_muu(i,j)
5108 P_muv(i,j)=FACTOR*S_muv(i,j)
5109 enddo
5110 enddo
5111
5112 CALL small_step_prep( P_u_1, P_u_2, P_v_1, P_v_2, P_w_1, P_w_2, &
5113 P_t_1, P_t_2, P_ph_1, P_ph_2, &
5114 mub, P_mu_1, P_mu_2, &
5115 P_muu, P_muus, P_muv, P_muvs, &
5116 P_mut, P_muts, P_mudf, &
5117 P_u_save, P_v_save, P_w_save, &
5118 P_t_save, P_ph_save, P_mu_save, &
5119 P_ww, P_ww_save, &
5120 dnw, P_c2a, pb, P_p, P_alt, &
5121 msfu, msfv, msft, &
5122 rk_step, &
5123 ids,ide, jds,jde, kds,kde, &
5124 ims,ime, jms,jme, kms,kme, &
5125 its,ite, jts,jte, kts,kte )
5126
5127 VAL_N=0.
5128 do i=ims,ime
5129 do k=kms,kme
5130 do j=jms,jme
5131 VAL_N=VAL_N + (P_u_1(i,k,j)- B_u_1(i,k,j))*(P_u_1(i,k,j)- B_u_1(i,k,j)) &
5132 + (P_v_1(i,k,j)- B_v_1(i,k,j))*(P_v_1(i,k,j)- B_v_1(i,k,j)) &
5133 + (P_w_1(i,k,j)- B_w_1(i,k,j))*(P_w_1(i,k,j)- B_w_1(i,k,j)) &
5134 + (P_t_1(i,k,j)- B_t_1(i,k,j))*(P_t_1(i,k,j)- B_t_1(i,k,j)) &
5135 + (P_ph_1(i,k,j)- B_ph_1(i,k,j))*(P_ph_1(i,k,j)- B_ph_1(i,k,j)) &
5136 + (P_u_2(i,k,j)- B_u_2(i,k,j))*(P_u_2(i,k,j)- B_u_2(i,k,j)) &
5137 + (P_v_2(i,k,j)- B_v_2(i,k,j))*(P_v_2(i,k,j)- B_v_2(i,k,j)) &
5138 + (P_w_2(i,k,j)- B_w_2(i,k,j))*(P_w_2(i,k,j)- B_w_2(i,k,j)) &
5139 + (P_t_2(i,k,j)- B_t_2(i,k,j))*(P_t_2(i,k,j)- B_t_2(i,k,j)) &
5140 + (P_ph_2(i,k,j)- B_ph_2(i,k,j))*(P_ph_2(i,k,j)- B_ph_2(i,k,j))
5141 enddo
5142 enddo
5143 enddo
5144 do i=ims,ime
5145 do j=jms,jme
5146 VAL_N=VAL_N + (P_mu_1(i,j)- B_mu_1(i,j))*(P_mu_1(i,j)- B_mu_1(i,j)) &
5147 + (P_mu_2(i,j)- B_mu_2(i,j))*(P_mu_2(i,j)- B_mu_2(i,j)) &
5148 + (P_mut(i,j)- B_mut(i,j))*(P_mut(i,j)- B_mut(i,j)) &
5149 + (P_muu(i,j)- B_muu(i,j))*(P_muu(i,j)- B_muu(i,j)) &
5150 + (P_muv(i,j)- B_muv(i,j))*(P_muv(i,j)- B_muv(i,j))
5151 enddo
5152 enddo
5153 do i=ims,ime
5154 do k=kms,kme
5155 do j=jms,jme
5156 VAL_N=VAL_N + (P_u_save(i,k,j)- B_u_save(i,k,j))*(P_u_save(i,k,j)- B_u_save(i,k,j)) &
5157 + (P_v_save(i,k,j)- B_v_save(i,k,j))*(P_v_save(i,k,j)- B_v_save(i,k,j)) &
5158 + (P_w_save(i,k,j)- B_w_save(i,k,j))*(P_w_save(i,k,j)- B_w_save(i,k,j)) &
5159 + (P_ph_save(i,k,j)- B_ph_save(i,k,j))*(P_ph_save(i,k,j)- B_ph_save(i,k,j)) &
5160 + (P_t_save(i,k,j)- B_t_save(i,k,j))*(P_t_save(i,k,j)- B_t_save(i,k,j)) &
5161 + (P_c2a(i,k,j)- B_c2a(i,k,j))*(P_c2a(i,k,j)- B_c2a(i,k,j)) &
5162 + (P_ww_save(i,k,j)- B_ww_save(i,k,j))*(P_ww_save(i,k,j)- B_ww_save(i,k,j))
5163 enddo
5164 enddo
5165 enddo
5166 do i=ims,ime
5167 do j=jms,jme
5168 VAL_N=VAL_N + (P_muus(i,j)- B_muus(i,j))*(P_muus(i,j)- B_muus(i,j)) &
5169 + (P_muvs(i,j)- B_muvs(i,j))*(P_muvs(i,j)- B_muvs(i,j)) &
5170 + (P_muts(i,j)- B_muts(i,j))*(P_muts(i,j)- B_muts(i,j)) &
5171 + (P_mu_save(i,j)- B_mu_save(i,j))*(P_mu_save(i,j)- B_mu_save(i,j)) &
5172 + (P_mudf(i,j)- B_mudf(i,j))*(P_mudf(i,j)- B_mudf(i,j))
5173 enddo
5174 enddo
5175
5176 VAL_L=SAVE_L*ALPHA**2
5177 COEF=VAL_N/VAL_L
5178 WRITE(6, fmt='(A,E9.4,A,E22.13,A,E13.6,A,E13.6)') &
5179 'g_small_step_prep: ALPHA=',ALPHA,' COEF=',COEF, &
5180 ' VAL_N=',VAL_N,' VAL_L=',VAL_L
5181 ENDDO
5182
5183 ! ADJ test
5184
5185 FACTOR=0.1
5186 do i=ims,ime
5187 do k=kms,kme
5188 do j=jms,jme
5189 p(i,k,j)=S_p(i,k,j)
5190 alt(i,k,j)=S_alt(i,k,j)
5191 ww(i,k,j)=S_ww(i,k,j)
5192
5193 P_p(i,k,j)=FACTOR*S_p(i,k,j)
5194 P_alt(i,k,j)=FACTOR*S_alt(i,k,j)
5195 P_ww(i,k,j)=FACTOR*S_ww(i,k,j)
5196
5197 B_p(i,k,j)=P_p(i,k,j)
5198 B_alt(i,k,j)=P_alt(i,k,j)
5199 B_ww(i,k,j)=P_ww(i,k,j)
5200 enddo
5201 enddo
5202 enddo
5203 do i=ims,ime
5204 do k=kms,kme
5205 do j=jms,jme
5206 u_1(i,k,j)=S_u_1(i,k,j)
5207 v_1(i,k,j)=S_v_1(i,k,j)
5208 w_1(i,k,j)=S_w_1(i,k,j)
5209 t_1(i,k,j)=S_t_1(i,k,j)
5210 ph_1(i,k,j)=S_ph_1(i,k,j)
5211 u_2(i,k,j)=S_u_2(i,k,j)
5212 v_2(i,k,j)=S_v_2(i,k,j)
5213 w_2(i,k,j)=S_w_2(i,k,j)
5214 t_2(i,k,j)=S_t_2(i,k,j)
5215 ph_2(i,k,j)=S_ph_2(i,k,j)
5216
5217 P_u_1(i,k,j)=FACTOR*S_u_1(i,k,j)
5218 P_v_1(i,k,j)=FACTOR*S_v_1(i,k,j)
5219 P_w_1(i,k,j)=FACTOR*S_w_1(i,k,j)
5220 P_t_1(i,k,j)=FACTOR*S_t_1(i,k,j)
5221 P_ph_1(i,k,j)=FACTOR*S_ph_1(i,k,j)
5222 P_u_2(i,k,j)=FACTOR*S_u_2(i,k,j)
5223 P_v_2(i,k,j)=FACTOR*S_v_2(i,k,j)
5224 P_w_2(i,k,j)=FACTOR*S_w_2(i,k,j)
5225 P_t_2(i,k,j)=FACTOR*S_t_2(i,k,j)
5226 P_ph_2(i,k,j)=FACTOR*S_ph_2(i,k,j)
5227
5228 B_u_1(i,k,j)=P_u_1(i,k,j)
5229 B_v_1(i,k,j)=P_v_1(i,k,j)
5230 B_w_1(i,k,j)=P_w_1(i,k,j)
5231 B_t_1(i,k,j)=P_t_1(i,k,j)
5232 B_ph_1(i,k,j)=P_ph_1(i,k,j)
5233 B_u_2(i,k,j)=P_u_2(i,k,j)
5234 B_v_2(i,k,j)=P_v_2(i,k,j)
5235 B_w_2(i,k,j)=P_w_2(i,k,j)
5236 B_t_2(i,k,j)=P_t_2(i,k,j)
5237 B_ph_2(i,k,j)=P_ph_2(i,k,j)
5238
5239 K_u_1(i,k,j)=u_1(i,k,j)
5240 K_v_1(i,k,j)=v_1(i,k,j)
5241 K_w_1(i,k,j)=w_1(i,k,j)
5242 K_t_1(i,k,j)=t_1(i,k,j)
5243 K_ph_1(i,k,j)=ph_1(i,k,j)
5244 K_u_2(i,k,j)=u_2(i,k,j)
5245 K_v_2(i,k,j)=v_2(i,k,j)
5246 K_w_2(i,k,j)=w_2(i,k,j)
5247 K_t_2(i,k,j)=t_2(i,k,j)
5248 K_ph_2(i,k,j)=ph_2(i,k,j)
5249 enddo
5250 enddo
5251 enddo
5252 do i=ims,ime
5253 do j=jms,jme
5254 mu_1(i,j)=S_mu_1(i,j)
5255 mu_2(i,j)=S_mu_2(i,j)
5256 mut(i,j)=S_mut(i,j)
5257 muu(i,j)=S_muu(i,j)
5258 muv(i,j)=S_muv(i,j)
5259
5260 P_mu_1(i,j)=FACTOR*S_mu_1(i,j)
5261 P_mu_2(i,j)=FACTOR*S_mu_2(i,j)
5262 P_mut(i,j)=FACTOR*S_mut(i,j)
5263 P_muu(i,j)=FACTOR*S_muu(i,j)
5264 P_muv(i,j)=FACTOR*S_muv(i,j)
5265
5266 B_mu_1(i,j)=P_mu_1(i,j)
5267 B_mu_2(i,j)=P_mu_2(i,j)
5268 B_mut(i,j)=P_mut(i,j)
5269 B_muu(i,j)=P_muu(i,j)
5270 B_muv(i,j)=P_muv(i,j)
5271
5272 K_mu_1(i,j)=mu_1(i,j)
5273 K_mu_2(i,j)=mu_2(i,j)
5274 K_mut(i,j)=mut(i,j)
5275 K_muu(i,j)=muu(i,j)
5276 K_muv(i,j)=muv(i,j)
5277 enddo
5278 enddo
5279
5280 ! TGL
5281
5282 CALL g_small_step_prep( u_1, P_u_1, u_2, P_u_2, v_1, P_v_1, v_2, P_v_2, w_1, P_w_1, w_2, P_w_2, t_1, P_t_1, t_2, P_t_2, ph_1,&
5283 & P_ph_1, ph_2, P_ph_2, mub, mu_1, P_mu_1, mu_2, P_mu_2, muu, P_muu, muus, P_muus, muv, P_muv, muvs, P_muvs, mut, P_mut, muts, &
5284 &P_muts, mudf, P_mudf, u_save, P_u_save, v_save, P_v_save, w_save, P_w_save, t_save, P_t_save, ph_save, P_ph_save, mu_save, &
5285 &P_mu_save, ww, P_ww, ww_save, P_ww_save, c2a, P_c2a, pb, p, P_p, alt, P_alt, msfu, msfv, msft, rk_step, ide, jde, kde, &
5286 &ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
5287
5288 VAL_L=0.
5289 do i=ims,ime
5290 do k=kms,kme
5291 do j=jms,jme
5292 VAL_L=VAL_L + P_u_1(i,k,j)*P_u_1(i,k,j) &
5293 + P_v_1(i,k,j)*P_v_1(i,k,j) &
5294 + P_w_1(i,k,j)*P_w_1(i,k,j) &
5295 + P_t_1(i,k,j)*P_t_1(i,k,j) &
5296 + P_ph_1(i,k,j)*P_ph_1(i,k,j) &
5297 + P_u_2(i,k,j)*P_u_2(i,k,j) &
5298 + P_v_2(i,k,j)*P_v_2(i,k,j) &
5299 + P_w_2(i,k,j)*P_w_2(i,k,j) &
5300 + P_t_2(i,k,j)*P_t_2(i,k,j) &
5301 + P_ph_2(i,k,j)*P_ph_2(i,k,j)
5302 enddo
5303 enddo
5304 enddo
5305 do i=ims,ime
5306 do j=jms,jme
5307 VAL_L=VAL_L + P_mu_1(i,j)*P_mu_1(i,j) &
5308 + P_mu_2(i,j)*P_mu_2(i,j) &
5309 + P_mut(i,j)*P_mut(i,j) &
5310 + P_muu(i,j)*P_muu(i,j) &
5311 + P_muv(i,j)*P_muv(i,j)
5312 enddo
5313 enddo
5314 do i=ims,ime
5315 do k=kms,kme
5316 do j=jms,jme
5317 VAL_L=VAL_L + P_u_save(i,k,j)*P_u_save(i,k,j) &
5318 + P_v_save(i,k,j)*P_v_save(i,k,j) &
5319 + P_w_save(i,k,j)*P_w_save(i,k,j) &
5320 + P_ph_save(i,k,j)*P_ph_save(i,k,j) &
5321 + P_t_save(i,k,j)*P_t_save(i,k,j) &
5322 + P_c2a(i,k,j)*P_c2a(i,k,j) &
5323 + P_ww_save(i,k,j)*P_ww_save(i,k,j)
5324 enddo
5325 enddo
5326 enddo
5327
5328 do i=ims,ime
5329 do j=jms,jme
5330 VAL_L=VAL_L + P_muus(i,j)*P_muus(i,j) &
5331 + P_muvs(i,j)*P_muvs(i,j) &
5332 + P_muts(i,j)*P_muts(i,j) &
5333 + P_mu_save(i,j)*P_mu_save(i,j) &
5334 + P_mudf(i,j)*P_mudf(i,j)
5335 enddo
5336 enddo
5337
5338 do i=ims,ime
5339 do k=kms,kme
5340 do j=jms,jme
5341 P_p(i,k,j)=0.0
5342 P_alt(i,k,j)=0.0
5343 P_ww(i,k,j)=0.0
5344 enddo
5345 enddo
5346 enddo
5347
5348 ! ADJ
5349
5350 CALL a_small_step_prep( K_u_1, P_u_1, K_u_2, P_u_2, K_v_1, P_v_1, K_v_2, P_v_2, K_w_1, P_w_1, K_w_2, P_w_2, K_t_1, P_t_1, K_t_2, P_t_2, &
5351 &P_ph_1, P_ph_2, mub, K_mu_1, P_mu_1, K_mu_2, P_mu_2, K_muu, P_muu, muus, P_muus, K_muv, P_muv, muvs, P_muvs, K_mut, P_mut, muts, P_muts, &
5352 &P_mudf, P_u_save, P_v_save, P_w_save, P_t_save, P_ph_save, P_mu_save, P_ww, P_ww_save, P_c2a, pb, p, P_p, alt, P_alt, msfu, msfv, &
5353 &msft, rk_step, ide, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
5354
5355
5356 VAL_A=0.
5357 do i=ims,ime
5358 do k=kms,kme
5359 do j=jms,jme
5360 VAL_A=VAL_A +P_p(i,k,j)*B_p(i,k,j) &
5361 +P_alt(i,k,j)*B_alt(i,k,j) &
5362 +P_ww(i,k,j)*B_ww(i,k,j)
5363 enddo
5364 enddo
5365 enddo
5366 do i=ims,ime
5367 do k=kms,kme
5368 do j=jms,jme
5369 VAL_A=VAL_A + P_u_1(i,k,j)*B_u_1(i,k,j) &
5370 + P_v_1(i,k,j)*B_v_1(i,k,j) &
5371 + P_w_1(i,k,j)*B_w_1(i,k,j) &
5372 + P_t_1(i,k,j)*B_t_1(i,k,j) &
5373 + P_ph_1(i,k,j)*B_ph_1(i,k,j) &
5374 + P_u_2(i,k,j)*B_u_2(i,k,j) &
5375 + P_v_2(i,k,j)*B_v_2(i,k,j) &
5376 + P_w_2(i,k,j)*B_w_2(i,k,j) &
5377 + P_t_2(i,k,j)*B_t_2(i,k,j) &
5378 + P_ph_2(i,k,j)*B_ph_2(i,k,j)
5379 enddo
5380 enddo
5381 enddo
5382 do i=ims,ime
5383 do j=jms,jme
5384 VAL_A=VAL_A + P_mu_1(i,j)*B_mu_1(i,j) &
5385 + P_mu_2(i,j)*B_mu_2(i,j) &
5386 + P_mut(i,j)*B_mut(i,j) &
5387 + P_muu(i,j)*B_muu(i,j) &
5388 + P_muv(i,j)*B_muv(i,j)
5389 enddo
5390 enddo
5391
5392 print*, ' '
5393 write(6,fmt='(A,2E22.13)') 'a_small_step_prep: ', VAL_L,VAL_A
5394
5395 ! RECOVER
5396
5397 do i=ims,ime
5398 do k=kms,kme
5399 do j=jms,jme
5400 p(i,k,j)=S_p(i,k,j)
5401 alt(i,k,j)=S_alt(i,k,j)
5402 ww(i,k,j)=S_ww(i,k,j)
5403 enddo
5404 enddo
5405 enddo
5406 do i=ims,ime
5407 do k=kms,kme
5408 do j=jms,jme
5409 u_1(i,k,j)=S_u_1(i,k,j)
5410 v_1(i,k,j)=S_v_1(i,k,j)
5411 w_1(i,k,j)=S_w_1(i,k,j)
5412 t_1(i,k,j)=S_t_1(i,k,j)
5413 ph_1(i,k,j)=S_ph_1(i,k,j)
5414 u_2(i,k,j)=S_u_2(i,k,j)
5415 v_2(i,k,j)=S_v_2(i,k,j)
5416 w_2(i,k,j)=S_w_2(i,k,j)
5417 t_2(i,k,j)=S_t_2(i,k,j)
5418 ph_2(i,k,j)=S_ph_2(i,k,j)
5419 enddo
5420 enddo
5421 enddo
5422 do i=ims,ime
5423 do j=jms,jme
5424 mu_1(i,j)=S_mu_1(i,j)
5425 mu_2(i,j)=S_mu_2(i,j)
5426 mut(i,j)=S_mut(i,j)
5427 muu(i,j)=S_muu(i,j)
5428 muv(i,j)=S_muv(i,j)
5429 enddo
5430 enddo
5431
5432 !g_small_step_prep: ALPHA=.1000E+00 COEF= 0.1210182666779E+01 VAL_N= 0.419130E+17 VAL_L= 0.346336E+17
5433 !g_small_step_prep: ALPHA=.1000E-01 COEF= 0.1020382523537E+01 VAL_N= 0.353396E+15 VAL_L= 0.346336E+15
5434 !g_small_step_prep: ALPHA=.1000E-02 COEF= 0.1002328515053E+01 VAL_N= 0.347143E+13 VAL_L= 0.346337E+13
5435 !g_small_step_prep: ALPHA=.1000E-03 COEF= 0.1001530051231E+01 VAL_N= 0.346866E+11 VAL_L= 0.346337E+11
5436 !g_small_step_prep: ALPHA=.1000E-04 COEF= 0.1006592035294E+01 VAL_N= 0.348620E+09 VAL_L= 0.346337E+09
5437 !g_small_step_prep: ALPHA=.1000E-05 COEF= 0.8559100627899E+00 VAL_N= 0.296433E+07 VAL_L= 0.346337E+07
5438 !g_small_step_prep: ALPHA=.1000E-06 COEF= 0.1041831374168E+01 VAL_N= 0.360824E+05 VAL_L= 0.346337E+05
5439 !g_small_step_prep: ALPHA=.1000E-07 COEF= 0.3898711849393E-20 VAL_N= 0.135027E-17 VAL_L= 0.346337E+03
5440 !g_small_step_prep: ALPHA=.1000E-08 COEF= 0.3898711865549E-18 VAL_N= 0.135027E-17 VAL_L= 0.346337E+01
5441 !g_small_step_prep: ALPHA=.1000E-09 COEF= 0.3898711338221E-16 VAL_N= 0.135027E-17 VAL_L= 0.346337E-01
5442 !g_small_step_prep: ALPHA=.1000E-10 COEF= 0.3898710967644E-14 VAL_N= 0.135027E-17 VAL_L= 0.346337E-03
5443
5444 !a_small_step_prep: 0.3464210455042E+17 0.3464191771935E+17
5445
5446
5447 !g_small_step_prep: ALPHA=.1000E+00 COEF= 0.1209974728298E+01 VAL_N= 0.419156E+17 VAL_L= 0.346417E+17
5448 !g_small_step_prep: ALPHA=.1000E-01 COEF= 0.1020097416385E+01 VAL_N= 0.353380E+15 VAL_L= 0.346417E+15
5449 !g_small_step_prep: ALPHA=.1000E-02 COEF= 0.1002000740908E+01 VAL_N= 0.347111E+13 VAL_L= 0.346417E+13
5450 !g_small_step_prep: ALPHA=.1000E-03 COEF= 0.1000199984095E+01 VAL_N= 0.346487E+11 VAL_L= 0.346417E+11
5451 !g_small_step_prep: ALPHA=.1000E-04 COEF= 0.1000019998524E+01 VAL_N= 0.346424E+09 VAL_L= 0.346417E+09
5452 !g_small_step_prep: ALPHA=.1000E-05 COEF= 0.1000002099436E+01 VAL_N= 0.346418E+07 VAL_L= 0.346417E+07
5453 !g_small_step_prep: ALPHA=.1000E-06 COEF= 0.1000010201248E+01 VAL_N= 0.346421E+05 VAL_L= 0.346417E+05
5454 !g_small_step_prep: ALPHA=.1000E-07 COEF= 0.1000999980880E+01 VAL_N= 0.346764E+03 VAL_L= 0.346417E+03
5455 !g_small_step_prep: ALPHA=.1000E-08 COEF= 0.1099997807301E+01 VAL_N= 0.381058E+01 VAL_L= 0.346417E+01
5456 !g_small_step_prep: ALPHA=.1000E-09 COEF= 0.1099973804174E+02 VAL_N= 0.381050E+00 VAL_L= 0.346417E-01
5457 !g_small_step_prep: ALPHA=.1000E-10 COEF= 0.1000973937427E+04 VAL_N= 0.346755E+00 VAL_L= 0.346417E-03
5458
5459 !a_small_step_prep: 0.3464174588297E+17 0.3464174588296E+17
5460
5461 END SUBROUTINE t_small_step_prep
5462
5463 !-----------------------------------------------------------------------------------------------
5464
5465 SUBROUTINE t_calc_p_rho( al, p, ph, &
5466 alt, t_2, t_1, c2a, pm1, &
5467 mu, muts, znu, t0, &
5468 rdnw, dnw, smdiv, &
5469 non_hydrostatic, step, &
5470 ids, ide, jds, jde, kds, kde, &
5471 ims, ime, jms, jme, kms, kme, &
5472 its,ite, jts,jte, kts,kte )
5473
5474 ! Zaizhong Ma, March 28,2005
5475
5476
5477 IMPLICIT NONE ! religion first
5478
5479 ! declarations for the stuff coming in
5480
5481 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
5482 INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
5483 INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
5484
5485 INTEGER, INTENT(IN ) :: step
5486
5487 REAL, DIMENSION(ims:ime, kms:kme, jms:jme),INTENT( OUT) :: al, &
5488 p
5489 ! pjj/cray
5490 ! p, &
5491 ! pm1
5492
5493 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: alt, &
5494 t_2, &
5495 t_1, &
5496 c2a
5497
5498 ! pjj/cray
5499 ! REAL, DIMENSION(ims:ime, kms:kme, jms:jme),INTENT(INOUT) :: ph
5500 REAL, DIMENSION(ims:ime, kms:kme, jms:jme),INTENT(INOUT) :: ph, pm1
5501
5502 REAL, DIMENSION(ims:ime, jms:jme) :: mu, &
5503 muts
5504
5505 REAL, DIMENSION(kms:kme) , INTENT(IN ) :: dnw, &
5506 rdnw, &
5507 znu
5508
5509 REAL, INTENT(IN ) :: t0, smdiv
5510
5511 LOGICAL, INTENT(IN ) :: non_hydrostatic
5512
5513 ! local variables
5514
5515 INTEGER :: i, j, k
5516 INTEGER :: i_start, i_end, j_start, j_end, k_start, k_end
5517 REAL :: ptmp
5518
5519
5520 ! zzma: new definition
5521
5522 ! IN variables
5523
5524 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: S_alt, &
5525 S_t_2, &
5526 S_t_1, &
5527 S_c2a
5528 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: P_alt, &
5529 P_t_2, &
5530 P_t_1, &
5531 P_c2a
5532 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: B_alt, &
5533 B_t_2, &
5534 B_t_1, &
5535 B_c2a
5536 REAL, DIMENSION(ims:ime, jms:jme) :: S_mu, S_muts,P_mu, P_muts,B_mu, B_muts
5537
5538 ! INOUT variables
5539
5540 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: S_ph, S_pm1,P_ph, P_pm1,K_ph, K_pm1,B_ph, B_pm1
5541
5542 ! OUT variables
5543
5544 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: P_al, P_p,B_al, B_p
5545
5546 REAL :: SAVE_L, COEF, ALPHA, FACTOR, VAL_N, VAL_L, VAL_A
5547 INTEGER :: NT
5548
5549 ! zzma: new definition end
5550
5551 !TGL test
5552
5553 do i=ims,ime
5554 do k=kms,kme
5555 do j=jms,jme
5556 S_alt(i,k,j)=alt(i,k,j)
5557 S_t_2(i,k,j)=t_2(i,k,j)
5558 S_t_1(i,k,j)=t_1(i,k,j)
5559 S_c2a(i,k,j)=c2a(i,k,j)
5560
5561 P_alt(i,k,j)=alt(i,k,j)
5562 P_t_2(i,k,j)=t_2(i,k,j)
5563 P_t_1(i,k,j)=t_1(i,k,j)
5564 P_c2a(i,k,j)=c2a(i,k,j)
5565 enddo
5566 enddo
5567 enddo
5568 do i=ims,ime
5569 do j=jms,jme
5570 S_mu(i,j)=mu(i,j)
5571 S_muts(i,j)=muts(i,j)
5572
5573 P_mu(i,j)=mu(i,j)
5574 P_muts(i,j)=muts(i,j)
5575 enddo
5576 enddo
5577 do i=ims,ime
5578 do k=kms,kme
5579 do j=jms,jme
5580 S_ph(i,k,j)=ph(i,k,j)
5581 S_pm1(i,k,j)=pm1(i,k,j)
5582
5583 P_ph(i,k,j)=ph(i,k,j)
5584 P_pm1(i,k,j)=pm1(i,k,j)
5585
5586 K_ph(i,k,j)=ph(i,k,j)
5587 K_pm1(i,k,j)=pm1(i,k,j)
5588 enddo
5589 enddo
5590 enddo
5591
5592 !NLM
5593
5594 CALL calc_p_rho( al, p, ph, &
5595 alt, t_2, t_1, c2a, pm1, &
5596 mu, muts, znu, t0, &
5597 rdnw, dnw, smdiv, &
5598 non_hydrostatic, step, &
5599 ids, ide, jds, jde, kds, kde, &
5600 ims, ime, jms, jme, kms, kme, &
5601 its,ite, jts,jte, kts,kte )
5602
5603 do i=ims,ime
5604 do k=kms,kme
5605 do j=jms,jme
5606 B_al(i,k,j)=al(i,k,j)
5607 B_p(i,k,j)=p(i,k,j)
5608 enddo
5609 enddo
5610 enddo
5611 do i=ims,ime
5612 do k=kms,kme
5613 do j=jms,jme
5614 B_ph(i,k,j)=ph(i,k,j)
5615 B_pm1(i,k,j)=pm1(i,k,j)
5616 enddo
5617 enddo
5618 enddo
5619
5620 ! TCL
5621
5622 CALL g_calc_p_rho( al, P_al, p, P_p, K_ph, P_ph, alt, P_alt, t_2, P_t_2, t_1, P_t_1, c2a, P_c2a, K_pm1, P_pm1, mu, P_mu, muts, &
5623 &P_muts, znu, t0, rdnw, dnw, smdiv, non_hydrostatic, step, ide, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, &
5624 &kte )
5625
5626 SAVE_L=0.
5627 do i=ims,ime
5628 do k=kms,kme
5629 do j=jms,jme
5630 SAVE_L=SAVE_L + P_al(i,k,j)*P_al(i,k,j) +P_p(i,k,j)*P_p(i,k,j)
5631 enddo
5632 enddo
5633 enddo
5634 do i=ims,ime
5635 do k=kms,kme
5636 do j=jms,jme
5637 SAVE_L=SAVE_L +P_ph(i,k,j)*P_ph(i,k,j) + P_pm1(i,k,j)*P_pm1(i,k,j)
5638 enddo
5639 enddo
5640 enddo
5641
5642 ALPHA=1.
5643 DO NT=1,11
5644 ALPHA=0.1*ALPHA
5645 FACTOR=1.+ALPHA
5646 do i=ims,ime
5647 do k=kms,kme
5648 do j=jms,jme
5649 P_alt(i,k,j)=FACTOR*S_alt(i,k,j)
5650 P_t_2(i,k,j)=FACTOR*S_t_2(i,k,j)
5651 P_t_1(i,k,j)=FACTOR*S_t_1(i,k,j)
5652 P_c2a(i,k,j)=FACTOR*S_c2a(i,k,j)
5653 enddo
5654 enddo
5655 enddo
5656 do i=ims,ime
5657 do j=jms,jme
5658 P_mu(i,j)=FACTOR*S_mu(i,j)
5659 P_muts(i,j)=FACTOR*S_muts(i,j)
5660 enddo
5661 enddo
5662 do i=ims,ime
5663 do k=kms,kme
5664 do j=jms,jme
5665 P_ph(i,k,j)=FACTOR*S_ph(i,k,j)
5666 P_pm1(i,k,j)=FACTOR*S_pm1(i,k,j)
5667 enddo
5668 enddo
5669 enddo
5670
5671 CALL calc_p_rho( P_al, P_p, P_ph, &
5672 P_alt, P_t_2, P_t_1, P_c2a, P_pm1, &
5673 P_mu, P_muts, znu, t0, &
5674 rdnw, dnw, smdiv, &
5675 non_hydrostatic, step, &
5676 ids, ide, jds, jde, kds, kde, &
5677 ims, ime, jms, jme, kms, kme, &
5678 its,ite, jts,jte, kts,kte )
5679
5680 VAL_N=0.
5681 do i=ims,ime
5682 do k=kms,kme
5683 do j=jms,jme
5684 VAL_N=VAL_N + (P_al(i,k,j)- B_al(i,k,j))*(P_al(i,k,j)- B_al(i,k,j)) &
5685 + (P_p(i,k,j) - B_p(i,k,j))*(P_p(i,k,j) - B_p(i,k,j))
5686 enddo
5687 enddo
5688 enddo
5689 do i=ims,ime
5690 do k=kms,kme
5691 do j=jms,jme
5692 VAL_N=VAL_N + (P_ph(i,k,j)- B_ph(i,k,j))*(P_ph(i,k,j)- B_ph(i,k,j)) &
5693 + (P_pm1(i,k,j)-B_pm1(i,k,j))*(P_pm1(i,k,j)-B_pm1(i,k,j))
5694 enddo
5695 enddo
5696 enddo
5697
5698 VAL_L=SAVE_L*ALPHA**2
5699 COEF=VAL_N/VAL_L
5700 WRITE(6, fmt='(A,E9.4,A,E22.13,A,E13.6,A,E13.6)') &
5701 'g_calc_p_rho: ALPHA=',ALPHA,' COEF=',COEF, &
5702 ' VAL_N=',VAL_N,' VAL_L=',VAL_L
5703 ENDDO
5704
5705 ! ADJ test
5706
5707 FACTOR=0.1
5708 do i=ims,ime
5709 do k=kms,kme
5710 do j=jms,jme
5711 alt(i,k,j)=S_alt(i,k,j)
5712 t_2(i,k,j)=S_t_2(i,k,j)
5713 t_1(i,k,j)=S_t_1(i,k,j)
5714 c2a(i,k,j)=S_c2a(i,k,j)
5715
5716 P_alt(i,k,j)=FACTOR*S_alt(i,k,j)
5717 P_t_2(i,k,j)=FACTOR*S_t_2(i,k,j)
5718 P_t_1(i,k,j)=FACTOR*S_t_1(i,k,j)
5719 P_c2a(i,k,j)=FACTOR*S_c2a(i,k,j)
5720
5721 B_alt(i,k,j)=P_alt(i,k,j)
5722 B_t_2(i,k,j)=P_t_2(i,k,j)
5723 B_t_1(i,k,j)=P_t_1(i,k,j)
5724 B_c2a(i,k,j)=P_c2a(i,k,j)
5725 enddo
5726 enddo
5727 enddo
5728 do i=ims,ime
5729 do j=jms,jme
5730 mu(i,j)=S_mu(i,j)
5731 muts(i,j)=S_muts(i,j)
5732
5733 P_mu(i,j)=FACTOR*S_mu(i,j)
5734 P_muts(i,j)=FACTOR*S_muts(i,j)
5735
5736 B_mu(i,j)=P_mu(i,j)
5737 B_muts(i,j)=P_muts(i,j)
5738 enddo
5739 enddo
5740 do i=ims,ime
5741 do k=kms,kme
5742 do j=jms,jme
5743 ph(i,k,j)=S_ph(i,k,j)
5744 pm1(i,k,j)=S_pm1(i,k,j)
5745
5746 P_ph(i,k,j)=FACTOR*S_ph(i,k,j)
5747 P_pm1(i,k,j)=FACTOR*S_pm1(i,k,j)
5748
5749 B_ph(i,k,j)=P_ph(i,k,j)
5750 B_pm1(i,k,j)=P_pm1(i,k,j)
5751
5752 K_ph(i,k,j)=ph(i,k,j)
5753 K_pm1(i,k,j)=pm1(i,k,j)
5754 enddo
5755 enddo
5756 enddo
5757
5758 ! TGL
5759
5760 CALL g_calc_p_rho( al, P_al, p, P_p, ph, P_ph, alt, P_alt, t_2, P_t_2, t_1, P_t_1, c2a, P_c2a, pm1, P_pm1, mu, P_mu, muts, &
5761 &P_muts, znu, t0, rdnw, dnw, smdiv, non_hydrostatic, step, ide, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, &
5762 &kte )
5763
5764 VAL_L=0.
5765 do i=ims,ime
5766 do k=kms,kme
5767 do j=jms,jme
5768 VAL_L=VAL_L + P_al(i,k,j)*P_al(i,k,j) +P_p(i,k,j)*P_p(i,k,j)
5769 enddo
5770 enddo
5771 enddo
5772 do i=ims,ime
5773 do k=kms,kme
5774 do j=jms,jme
5775 VAL_L=VAL_L + P_ph(i,k,j)*P_ph(i,k,j) + P_pm1(i,k,j)*P_pm1(i,k,j)
5776 enddo
5777 enddo
5778 enddo
5779
5780
5781 do i=ims,ime
5782 do k=kms,kme
5783 do j=jms,jme
5784 P_alt(i,k,j)=0.0
5785 P_t_2(i,k,j)=0.0
5786 P_t_1(i,k,j)=0.0
5787 P_c2a(i,k,j)=0.0
5788 enddo
5789 enddo
5790 enddo
5791 do i=ims,ime
5792 do j=jms,jme
5793 P_mu(i,j)=0.0
5794 P_muts(i,j)=0.0
5795 enddo
5796 enddo
5797
5798 ! ADJ
5799
5800 CALL a_calc_p_rho( al, P_al, p, P_p, K_ph, P_ph, alt, P_alt, t_2, P_t_2, t_1, P_t_1, c2a, P_c2a, P_pm1, mu, P_mu, muts, P_muts,&
5801 & znu, t0, rdnw, dnw, smdiv, non_hydrostatic, step, ide, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
5802
5803 VAL_A=0.
5804 do i=ims,ime
5805 do k=kms,kme
5806 do j=jms,jme
5807 VAL_A=VAL_A + P_alt(i,k,j)*B_alt(i,k,j) &
5808 + P_t_2(i,k,j)*B_t_2(i,k,j) &
5809 + P_t_1(i,k,j)*B_t_1(i,k,j) &
5810 + P_c2a(i,k,j)*B_c2a(i,k,j)
5811 enddo
5812 enddo
5813 enddo
5814 do i=ims,ime
5815 do j=jms,jme
5816 VAL_A=VAL_A + P_mu(i,j)*B_mu(i,j) &
5817 + P_muts(i,j)*B_muts(i,j)
5818 enddo
5819 enddo
5820 do i=ims,ime
5821 do k=kms,kme
5822 do j=jms,jme
5823 VAL_A=VAL_A + P_ph(i,k,j)*B_ph(i,k,j) &
5824 + P_pm1(i,k,j)*B_pm1(i,k,j)
5825 enddo
5826 enddo
5827 enddo
5828
5829 print*, ' '
5830 write(6,fmt='(A,2E22.13)') 'a_calc_p_rho: ', VAL_L,VAL_A
5831
5832
5833 ! RECOVER
5834
5835 do i=ims,ime
5836 do k=kms,kme
5837 do j=jms,jme
5838 alt(i,k,j)=S_alt(i,k,j)
5839 t_2(i,k,j)=S_t_2(i,k,j)
5840 t_1(i,k,j)=S_t_1(i,k,j)
5841 c2a(i,k,j)=S_c2a(i,k,j)
5842 enddo
5843 enddo
5844 enddo
5845 do i=ims,ime
5846 do j=jms,jme
5847 mu(i,j)=S_mu(i,j)
5848 muts(i,j)=S_muts(i,j)
5849 enddo
5850 enddo
5851 do i=ims,ime
5852 do k=kms,kme
5853 do j=jms,jme
5854 ph(i,k,j)=S_ph(i,k,j)
5855 pm1(i,k,j)=S_pm1(i,k,j)
5856 enddo
5857 enddo
5858 enddo
5859
5860 !g_calc_p_rho: ALPHA=.1000E+00 COEF= 0.1000004291534E+01 VAL_N= 0.171105E+08 VAL_L= 0.171104E+08
5861 !g_calc_p_rho: ALPHA=.1000E-01 COEF= 0.1000008940697E+01 VAL_N= 0.171106E+06 VAL_L= 0.171104E+06
5862 !g_calc_p_rho: ALPHA=.1000E-02 COEF= 0.1001088023186E+01 VAL_N= 0.171290E+04 VAL_L= 0.171104E+04
5863 !g_calc_p_rho: ALPHA=.1000E-03 COEF= 0.1101572036743E+01 VAL_N= 0.188484E+02 VAL_L= 0.171104E+02
5864 !g_calc_p_rho: ALPHA=.1000E-04 COEF= 0.1111159610748E+02 VAL_N= 0.190124E+01 VAL_L= 0.171104E+00
5865 !g_calc_p_rho: ALPHA=.1000E-05 COEF= 0.1011856994629E+04 VAL_N= 0.173133E+01 VAL_L= 0.171104E-02
5866 !g_calc_p_rho: ALPHA=.1000E-06 COEF= 0.1010873671875E+06 VAL_N= 0.172965E+01 VAL_L= 0.171104E-04
5867 !g_calc_p_rho: ALPHA=.1000E-07 COEF= 0.1010873600000E+08 VAL_N= 0.172965E+01 VAL_L= 0.171104E-06
5868 !g_calc_p_rho: ALPHA=.1000E-08 COEF= 0.1010873664000E+10 VAL_N= 0.172965E+01 VAL_L= 0.171104E-08
5869 !g_calc_p_rho: ALPHA=.1000E-09 COEF= 0.1010873548800E+12 VAL_N= 0.172965E+01 VAL_L= 0.171104E-10
5870 !g_calc_p_rho: ALPHA=.1000E-10 COEF= 0.1010873506202E+14 VAL_N= 0.172965E+01 VAL_L= 0.171104E-12
5871
5872 !a_calc_p_rho: 0.1711048600000E+08 0.1711048600000E+08
5873
5874 !g_calc_p_rho: ALPHA=.1000E+00 COEF= 0.1000000101086E+01 VAL_N= 0.171103E+08 VAL_L= 0.171103E+08
5875 !g_calc_p_rho: ALPHA=.1000E-01 COEF= 0.1000010108599E+01 VAL_N= 0.171105E+06 VAL_L= 0.171103E+06
5876 !g_calc_p_rho: ALPHA=.1000E-02 COEF= 0.1001010859867E+01 VAL_N= 0.171276E+04 VAL_L= 0.171103E+04
5877 !g_calc_p_rho: ALPHA=.1000E-03 COEF= 0.1101085986751E+01 VAL_N= 0.188400E+02 VAL_L= 0.171103E+02
5878 !g_calc_p_rho: ALPHA=.1000E-04 COEF= 0.1110859867508E+02 VAL_N= 0.190072E+01 VAL_L= 0.171103E+00
5879 !g_calc_p_rho: ALPHA=.1000E-05 COEF= 0.1011859867506E+04 VAL_N= 0.173133E+01 VAL_L= 0.171103E-02
5880 !g_calc_p_rho: ALPHA=.1000E-06 COEF= 0.1010869867506E+06 VAL_N= 0.172963E+01 VAL_L= 0.171103E-04
5881 !g_calc_p_rho: ALPHA=.1000E-07 COEF= 0.1010859967506E+08 VAL_N= 0.172962E+01 VAL_L= 0.171103E-06
5882 !g_calc_p_rho: ALPHA=.1000E-08 COEF= 0.1010859868506E+10 VAL_N= 0.172962E+01 VAL_L= 0.171103E-08
5883 !g_calc_p_rho: ALPHA=.1000E-09 COEF= 0.1010859867516E+12 VAL_N= 0.172962E+01 VAL_L= 0.171103E-10
5884 !g_calc_p_rho: ALPHA=.1000E-10 COEF= 0.1010859867506E+14 VAL_N= 0.172962E+01 VAL_L= 0.171103E-12
5885
5886 !a_calc_p_rho: 0.1711034017432E+08 0.1711034017432E+08
5887
5888
5889 END SUBROUTINE t_calc_p_rho
5890
5891 !-----------------------------------------------------------------------------------------------
5892
5893 SUBROUTINE t_calc_coef_w( a,alpha,gamma, &
5894 mut, cqw, &
5895 rdn, rdnw, c2a, &
5896 dts, g, epssm, &
5897 ids,ide, jds,jde, kds,kde, & ! domain dims
5898 ims,ime, jms,jme, kms,kme, & ! memory dims
5899 its,ite, jts,jte, kts,kte ) ! tile dims
5900
5901 ! Zaizhong Ma, March 30,2005
5902
5903 IMPLICIT NONE ! religion first
5904
5905 ! passed in through the call
5906
5907 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
5908 INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
5909 INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
5910
5911
5912 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: c2a, &
5913 cqw
5914
5915 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: alpha, &
5916 gamma, &
5917 a
5918
5919 REAL, DIMENSION(ims:ime, jms:jme) :: mut
5920
5921 REAL, DIMENSION(kms:kme), INTENT(IN ) :: rdn, &
5922 rdnw
5923
5924 REAL, INTENT(IN ) :: epssm, &
5925 dts, &
5926 g
5927
5928 ! Local stack data.
5929
5930 REAL, DIMENSION(ims:ime) :: cof
5931 REAL :: b, c
5932
5933 INTEGER :: i, j, k, i_start, i_end, j_start, j_end, k_start, k_end
5934 INTEGER :: ij, ijp, ijm
5935
5936 ! zzma: new definition
5937
5938 ! IN variables
5939
5940 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: S_c2a, S_cqw,P_c2a, P_cqw,B_c2a, B_cqw
5941 REAL, DIMENSION(ims:ime, jms:jme) :: S_mut,P_mut,B_mut
5942
5943 ! INOUT variables
5944
5945 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: S_alpha,S_gamma,S_a,P_alpha,P_gamma,P_a, &
5946 K_alpha,K_gamma,K_a,B_alpha,B_gamma,B_a
5947
5948 REAL :: SAVE_L, COEF, ALPHA_M, FACTOR, VAL_N, VAL_L, VAL_A
5949 INTEGER :: NT
5950
5951 ! zzma: new definition end
5952
5953 !TGL test
5954
5955 do i=ims,ime
5956 do k=kms,kme
5957 do j=jms,jme
5958 S_c2a(i,k,j)=c2a(i,k,j)
5959 S_cqw(i,k,j)=cqw(i,k,j)
5960
5961 P_c2a(i,k,j)=c2a(i,k,j)
5962 P_cqw(i,k,j)=cqw(i,k,j)
5963 enddo
5964 enddo
5965 enddo
5966 do i=ims,ime
5967 do j=jms,jme
5968 S_mut(i,j)=mut(i,j)
5969
5970 P_mut(i,j)=mut(i,j)
5971 enddo
5972 enddo
5973 do i=ims,ime
5974 do k=kms,kme
5975 do j=jms,jme
5976 S_alpha(i,k,j)=alpha(i,k,j)
5977 S_gamma(i,k,j)=gamma(i,k,j)
5978 S_a(i,k,j)=a(i,k,j)
5979
5980 P_alpha(i,k,j)=alpha(i,k,j)
5981 P_gamma(i,k,j)=gamma(i,k,j)
5982 P_a(i,k,j)=a(i,k,j)
5983
5984 K_alpha(i,k,j)=alpha(i,k,j)
5985 K_gamma(i,k,j)=gamma(i,k,j)
5986 K_a(i,k,j)=a(i,k,j)
5987 enddo
5988 enddo
5989 enddo
5990
5991 !NLM
5992
5993 CALL calc_coef_w( a,alpha,gamma, &
5994 mut, cqw, &
5995 rdn, rdnw, c2a, &
5996 dts, g, epssm, &
5997 ids,ide, jds,jde, kds,kde, & ! domain dims
5998 ims,ime, jms,jme, kms,kme, & ! memory dims
5999 its,ite, jts,jte, kts,kte ) ! tile dims
6000
6001 do i=ims,ime
6002 do k=kms,kme
6003 do j=jms,jme
6004 B_alpha(i,k,j)=alpha(i,k,j)
6005 B_gamma(i,k,j)=gamma(i,k,j)
6006 B_a(i,k,j)=a(i,k,j)
6007 enddo
6008 enddo
6009 enddo
6010
6011 ! TCL
6012
6013 CALL g_calc_coef_w( K_a, P_a, K_alpha, P_alpha, K_gamma, P_gamma, mut, P_mut, cqw, P_cqw, rdn, rdnw, c2a, P_c2a, dts, g, epssm, &
6014 &ide, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte )
6015
6016 SAVE_L=0.
6017 do i=ims,ime
6018 do k=kms,kme
6019 do j=jms,jme
6020 SAVE_L=SAVE_L + P_alpha(i,k,j)*P_alpha(i,k,j) &
6021 + P_gamma(i,k,j)*P_gamma(i,k,j) &
6022 + P_a(i,k,j)*P_a(i,k,j)
6023 enddo
6024 enddo
6025 enddo
6026
6027 ALPHA_M=1.
6028 DO NT=1,11
6029 ALPHA_M=0.1*ALPHA_M
6030 FACTOR=1.+ALPHA_M
6031 do i=ims,ime
6032 do k=kms,kme
6033 do j=jms,jme
6034 P_c2a(i,k,j)=FACTOR*S_c2a(i,k,j)
6035 P_cqw(i,k,j)=FACTOR*S_cqw(i,k,j)
6036 enddo
6037 enddo
6038 enddo
6039 do i=ims,ime
6040 do j=jms,jme
6041 P_mut(i,j)=FACTOR*S_mut(i,j)
6042 enddo
6043 enddo
6044 do i=ims,ime
6045 do k=kms,kme
6046 do j=jms,jme
6047 P_alpha(i,k,j)=FACTOR*S_alpha(i,k,j)
6048 P_gamma(i,k,j)=FACTOR*S_gamma(i,k,j)
6049 P_a(i,k,j)=FACTOR*S_a(i,k,j)
6050 enddo
6051 enddo
6052 enddo
6053
6054 CALL calc_coef_w( P_a,P_alpha,P_gamma, &
6055 P_mut, P_cqw, &
6056 rdn, rdnw, P_c2a, &
6057 dts, g, epssm, &
6058 ids,ide, jds,jde, kds,kde, & ! domain dims
6059 ims,ime, jms,jme, kms,kme, & ! memory dims
6060 its,ite, jts,jte, kts,kte ) ! tile dims
6061
6062 VAL_N=0.
6063 do i=ims,ime
6064 do k=kms,kme
6065 do j=jms,jme
6066 VAL_N=VAL_N + (P_alpha(i,k,j) -B_alpha(i,k,j))*(P_alpha(i,k,j) -B_alpha(i,k,j)) &
6067 + (P_gamma(i,k,j) -B_gamma(i,k,j))*(P_gamma(i,k,j) -B_gamma(i,k,j)) &
6068 + (P_a(i,k,j) -B_a(i,k,j))*(P_a(i,k,j) -B_a(i,k,j))
6069 enddo
6070 enddo
6071 enddo
6072
6073 VAL_L=SAVE_L*ALPHA_M**2
6074 COEF=VAL_N/VAL_L
6075 WRITE(6, fmt='(A,E9.4,A,E22.13,A,E13.6,A,E13.6)') &
6076 'g_calc_coef_w: ALPHA=',ALPHA_M,' COEF=',COEF, &
6077 ' VAL_N=',VAL_N,' VAL_L=',VAL_L
6078 ENDDO
6079
6080 ! ADJ test
6081
6082 FACTOR=0.1
6083 do i=ims,ime
6084 do k=kms,kme
6085 do j=jms,jme
6086 c2a(i,k,j)=S_c2a(i,k,j)
6087 cqw(i,k,j)=S_cqw(i,k,j)
6088
6089 P_c2a(i,k,j)=FACTOR*S_c2a(i,k,j)
6090 P_cqw(i,k,j)=FACTOR*S_cqw(i,k,j)
6091
6092 B_c2a(i,k,j)=P_c2a(i,k,j)
6093 B_cqw(i,k,j)=P_cqw(i,k,j)
6094 enddo
6095 enddo
6096 enddo
6097 do i=ims,ime
6098 do j=jms,jme
6099 mut(i,j)=S_mut(i,j)
6100
6101 P_mut(i,j)=FACTOR*S_mut(i,j)
6102
6103 B_mut(i,j)=P_mut(i,j)
6104 enddo
6105 enddo
6106 do i=ims,ime
6107 do k=kms,kme
6108 do j=jms,jme
6109 alpha(i,k,j)=S_alpha(i,k,j)
6110 gamma(i,k,j)=S_gamma(i,k,j)
6111 a(i,k,j)=S_a(i,k,j)
6112
6113 P_alpha(i,k,j)=FACTOR*S_alpha(i,k,j)
6114 P_gamma(i,k,j)=FACTOR*S_gamma(i,k,j)
6115 P_a(i,k,j)=FACTOR*S_a(i,k,j)
6116
6117 B_alpha(i,k,j)=P_alpha(i,k,j)
6118 B_gamma(i,k,j)=P_gamma(i,k,j)
6119 B_a(i,k,j)=P_a(i,k,j)
6120
6121 K_alpha(i,k,j)=alpha(i,k,j)
6122 K_gamma(i,k,j)=gamma(i,k,j)
6123 K_a(i,k,j)=a(i,k,j)
6124 enddo
6125 enddo
6126 enddo
6127
6128 ! TGL
6129
6130 CALL g_calc_coef_w( a, P_a, alpha, P_alpha, gamma, P_gamma, mut, P_mut, cqw, P_cqw, rdn, rdnw, c2a, P_c2a, dts, g, epssm, &
6131 &ide, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte )
6132
6133 VAL_L=0.
6134 do i=ims,ime
6135 do k=kms,kme
6136 do j=jms,jme
6137 VAL_L=VAL_L + P_alpha(i,k,j)*P_alpha(i,k,j) &
6138 + P_gamma(i,k,j)*P_gamma(i,k,j) &
6139 + P_a(i,k,j)*P_a(i,k,j)
6140 enddo
6141 enddo
6142 enddo
6143
6144 do i=ims,ime
6145 do k=kms,kme
6146 do j=jms,jme
6147 P_c2a(i,k,j)=0.0
6148 P_cqw(i,k,j)=0.0
6149 enddo
6150 enddo
6151 enddo
6152 do i=ims,ime
6153 do j=jms,jme
6154 P_mut(i,j)=0.0
6155 enddo
6156 enddo
6157
6158 ! ADJ
6159
6160 CALL a_calc_coef_w( K_a, P_a, K_alpha, P_alpha, K_gamma, P_gamma, mut, P_mut, cqw, P_cqw, rdn, rdnw, c2a, P_c2a, dts, g, epssm, &
6161 &ide, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte )
6162
6163 VAL_A=0.
6164 do i=ims,ime
6165 do k=kms,kme
6166 do j=jms,jme
6167 VAL_A=VAL_A + P_c2a(i,k,j)*B_c2a(i,k,j) &
6168 + P_cqw(i,k,j)*B_cqw(i,k,j)
6169 enddo
6170 enddo
6171 enddo
6172 do i=ims,ime
6173 do j=jms,jme
6174 VAL_A=VAL_A + P_mut(i,j)*B_mut(i,j)
6175 enddo
6176 enddo
6177 do i=ims,ime
6178 do k=kms,kme
6179 do j=jms,jme
6180 VAL_A=VAL_A + P_alpha(i,k,j)*B_alpha(i,k,j) &
6181 + P_gamma(i,k,j)*B_gamma(i,k,j) &
6182 + P_a(i,k,j)*B_a(i,k,j)
6183 enddo
6184 enddo
6185 enddo
6186
6187 print*, ' '
6188 write(6,fmt='(A,2E22.13)') 'a_calc_coef_w: ', VAL_L,VAL_A
6189
6190
6191 ! RECOVER
6192
6193 do i=ims,ime
6194 do k=kms,kme
6195 do j=jms,jme
6196 c2a(i,k,j)=S_c2a(i,k,j)
6197 cqw(i,k,j)=S_cqw(i,k,j)
6198 enddo
6199 enddo
6200 enddo
6201 do i=ims,ime
6202 do j=jms,jme
6203 mut(i,j)=S_mut(i,j)
6204 enddo
6205 enddo
6206 do i=ims,ime
6207 do k=kms,kme
6208 do j=jms,jme
6209 alpha(i,k,j)=S_alpha(i,k,j)
6210 gamma(i,k,j)=S_gamma(i,k,j)
6211 a(i,k,j)=S_a(i,k,j)
6212 enddo
6213 enddo
6214 enddo
6215
6216 !g_calc_coef_w: ALPHA=.1000E+00 COEF= 0.8264269232750E+00 VAL_N= 0.922998E+06 VAL_L= 0.111685E+07
6217 !g_calc_coef_w: ALPHA=.1000E-01 COEF= 0.9802830815315E+00 VAL_N= 0.109483E+05 VAL_L= 0.111685E+05
6218 !g_calc_coef_w: ALPHA=.1000E-02 COEF= 0.9980322718620E+00 VAL_N= 0.111466E+03 VAL_L= 0.111685E+03
6219 !g_calc_coef_w: ALPHA=.1000E-03 COEF= 0.1003263592720E+01 VAL_N= 0.112050E+01 VAL_L= 0.111685E+01
6220 !g_calc_coef_w: ALPHA=.1000E-04 COEF= 0.1013251900673E+01 VAL_N= 0.113165E-01 VAL_L= 0.111685E-01
6221 !g_calc_coef_w: ALPHA=.1000E-05 COEF= 0.1187977194786E+01 VAL_N= 0.132680E-03 VAL_L= 0.111685E-03
6222 !g_calc_coef_w: ALPHA=.1000E-06 COEF= 0.1717434310913E+02 VAL_N= 0.191812E-04 VAL_L= 0.111685E-05
6223 !g_calc_coef_w: ALPHA=.1000E-07 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.111685E-07
6224 !g_calc_coef_w: ALPHA=.1000E-08 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.111685E-09
6225 !g_calc_coef_w: ALPHA=.1000E-09 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.111685E-11
6226 !g_calc_coef_w: ALPHA=.1000E-10 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.111685E-13
6227
6228 !a_calc_coef_w: 0.1116833000000E+07 0.1116870750000E+07
6229
6230 !g_calc_coef_w: ALPHA=.1000E+00 COEF= 0.8264462829075E+00 VAL_N= 0.923009E+06 VAL_L= 0.111684E+07
6231 !g_calc_coef_w: ALPHA=.1000E-01 COEF= 0.9802960496253E+00 VAL_N= 0.109484E+05 VAL_L= 0.111684E+05
6232 !g_calc_coef_w: ALPHA=.1000E-02 COEF= 0.9980029960275E+00 VAL_N= 0.111461E+03 VAL_L= 0.111684E+03
6233 !g_calc_coef_w: ALPHA=.1000E-03 COEF= 0.9998000300046E+00 VAL_N= 0.111662E+01 VAL_L= 0.111684E+01
6234 !g_calc_coef_w: ALPHA=.1000E-04 COEF= 0.9999800002875E+00 VAL_N= 0.111682E-01 VAL_L= 0.111684E-01
6235 !g_calc_coef_w: ALPHA=.1000E-05 COEF= 0.9999979995651E+00 VAL_N= 0.111684E-03 VAL_L= 0.111684E-03
6236 !g_calc_coef_w: ALPHA=.1000E-06 COEF= 0.9999998004147E+00 VAL_N= 0.111684E-05 VAL_L= 0.111684E-05
6237 !g_calc_coef_w: ALPHA=.1000E-07 COEF= 0.1000000012124E+01 VAL_N= 0.111684E-07 VAL_L= 0.111684E-07
6238 !g_calc_coef_w: ALPHA=.1000E-08 COEF= 0.1000001026566E+01 VAL_N= 0.111684E-09 VAL_L= 0.111684E-09
6239 !g_calc_coef_w: ALPHA=.1000E-09 COEF= 0.1000007201550E+01 VAL_N= 0.111685E-11 VAL_L= 0.111684E-11
6240 !g_calc_coef_w: ALPHA=.1000E-10 COEF= 0.9999895664473E+00 VAL_N= 0.111683E-13 VAL_L= 0.111684E-13
6241
6242 !a_calc_coef_w: 0.1116841252269E+07 0.1116841252269E+07
6243
6244 END SUBROUTINE t_calc_coef_w
6245 !-----------------------------------------------------------------------------------------------
6246 SUBROUTINE t_advance_uv ( u, ru_tend, v, rv_tend, &
6247 p, pb, &
6248 ph, php, alt, al, mu, &
6249 muu, cqu, muv, cqv, mudf, &
6250 rdx, rdy, dts, &
6251 cf1, cf2, cf3, fnm, fnp, &
6252 emdiv, &
6253 rdnw, config_flags, spec_zone, &
6254 non_hydrostatic, &
6255 ids, ide, jds, jde, kds, kde, &
6256 ims, ime, jms, jme, kms, kme, &
6257 its, ite, jts, jte, kts, kte )
6258
6259 ! Zaizhong Ma, March 30,2005
6260
6261 IMPLICIT NONE ! religion first
6262
6263 ! stuff coming in
6264
6265 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
6266
6267 LOGICAL, INTENT(IN ) :: non_hydrostatic
6268
6269 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
6270 INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
6271 INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
6272 INTEGER, INTENT(IN ) :: spec_zone
6273
6274 REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), &
6275 INTENT(INOUT) :: &
6276 u, &
6277 v
6278
6279 REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), INTENT( IN) :: pb
6280 REAL, DIMENSION( ims:ime , kms:kme, jms:jme ) :: &
6281 ru_tend, &
6282 rv_tend, &
6283 ph, &
6284 php, &
6285 p, &
6286 alt, &
6287 al, &
6288 cqu, &
6289 cqv
6290
6291
6292 REAL, DIMENSION( ims:ime , jms:jme ) :: muu, &
6293 muv, &
6294 mu, &
6295 mudf
6296
6297
6298 REAL, DIMENSION( kms:kme ), INTENT(IN ) :: fnm, &
6299 fnp , &
6300 rdnw
6301
6302 REAL, INTENT(IN ) :: rdx, &
6303 rdy, &
6304 dts, &
6305 cf1, &
6306 cf2, &
6307 cf3, &
6308 emdiv
6309
6310
6311 ! Local 3d array from the stack (note tile size)
6312
6313 REAL, DIMENSION (its:ite, kts:kte) :: dpn, dpxy
6314 REAL, DIMENSION (its:ite) :: mudf_xy
6315 REAL :: dx, dy
6316
6317 INTEGER :: i,j,k, i_start, i_end, j_start, j_end, k_start, k_end
6318 INTEGER :: i_endu, j_endv, k_endw
6319 INTEGER :: i_start_up, i_end_up, j_start_up, j_end_up
6320 INTEGER :: i_start_vp, i_end_vp, j_start_vp, j_end_vp
6321 INTEGER :: i_start_u_tend, i_end_u_tend, j_start_v_tend, j_end_v_tend
6322
6323 ! zzma: new definition
6324
6325 ! IN variables
6326
6327 REAL, DIMENSION( ims:ime , kms:kme, jms:jme ) :: S_ru_tend, &
6328 S_rv_tend, &
6329 S_ph, &
6330 S_php, &
6331 S_p, &
6332 S_alt, &
6333 S_al, &
6334 S_cqu, &
6335 S_cqv
6336
6337 REAL, DIMENSION( ims:ime , kms:kme, jms:jme ) :: P_ru_tend, &
6338 P_rv_tend, &
6339 P_ph, &
6340 P_php, &
6341 P_p, &
6342 P_alt, &
6343 P_al, &
6344 P_cqu, &
6345 P_cqv
6346
6347 REAL, DIMENSION( ims:ime , kms:kme, jms:jme ) :: B_ru_tend, &
6348 B_rv_tend, &
6349 B_ph, &
6350 B_php, &
6351 B_p, &
6352 B_alt, &
6353 B_al, &
6354 B_cqu, &
6355 B_cqv
6356
6357 REAL, DIMENSION( ims:ime , jms:jme ) :: S_muu, &
6358 S_muv, &
6359 S_mu, &
6360 S_mudf
6361 REAL, DIMENSION( ims:ime , jms:jme ) :: P_muu, &
6362 P_muv, &
6363 P_mu, &
6364 P_mudf
6365 REAL, DIMENSION( ims:ime , jms:jme ) :: B_muu, &
6366 B_muv, &
6367 B_mu, &
6368 B_mudf
6369
6370
6371 ! INOUT variables
6372
6373 REAL, DIMENSION( ims:ime , kms:kme, jms:jme ) :: S_u, S_v,P_u, P_v,K_u, K_v,B_u, B_v
6374
6375 REAL :: SAVE_L, COEF, ALPHA, FACTOR, VAL_N, VAL_L, VAL_A
6376 INTEGER :: NT
6377
6378 ! zzma: new definition end
6379
6380 !TGL test
6381
6382 do i=ims,ime
6383 do k=kms,kme
6384 do j=jms,jme
6385 S_ru_tend(i,k,j)=ru_tend(i,k,j)
6386 S_rv_tend(i,k,j)=rv_tend(i,k,j)
6387 S_ph(i,k,j)=ph(i,k,j)
6388 S_php(i,k,j)=php(i,k,j)
6389 S_p(i,k,j)=p(i,k,j)
6390 S_alt(i,k,j)=alt(i,k,j)
6391 S_al(i,k,j)=al(i,k,j)
6392 S_cqu(i,k,j)=cqu(i,k,j)
6393 S_cqv(i,k,j)=cqv(i,k,j)
6394
6395 P_ru_tend(i,k,j)=ru_tend(i,k,j)
6396 P_rv_tend(i,k,j)=rv_tend(i,k,j)
6397 P_ph(i,k,j)=ph(i,k,j)
6398 P_php(i,k,j)=php(i,k,j)
6399 P_p(i,k,j)=p(i,k,j)
6400 P_alt(i,k,j)=alt(i,k,j)
6401 P_al(i,k,j)=al(i,k,j)
6402 P_cqu(i,k,j)=cqu(i,k,j)
6403 P_cqv(i,k,j)=cqv(i,k,j)
6404 enddo
6405 enddo
6406 enddo
6407 do i=ims,ime
6408 do j=jms,jme
6409 S_muu(i,j)=muu(i,j)
6410 S_muv(i,j)=muv(i,j)
6411 S_mu(i,j)=mu(i,j)
6412 S_mudf(i,j)=mudf(i,j)
6413
6414 P_muu(i,j)=muu(i,j)
6415 P_muv(i,j)=muv(i,j)
6416 P_mu(i,j)=mu(i,j)
6417 P_mudf(i,j)=mudf(i,j)
6418 enddo
6419 enddo
6420 do i=ims,ime
6421 do k=kms,kme
6422 do j=jms,jme
6423 S_u(i,k,j)=u(i,k,j)
6424 S_v(i,k,j)=v(i,k,j)
6425
6426 P_u(i,k,j)=u(i,k,j)
6427 P_v(i,k,j)=v(i,k,j)
6428
6429 K_u(i,k,j)=u(i,k,j)
6430 K_v(i,k,j)=v(i,k,j)
6431 enddo
6432 enddo
6433 enddo
6434
6435 !NLM
6436
6437 CALL advance_uv ( u, ru_tend, v, rv_tend, &
6438 p, pb, &
6439 ph, php, alt, al, mu, &
6440 muu, cqu, muv, cqv, mudf, &
6441 rdx, rdy, dts, &
6442 cf1, cf2, cf3, fnm, fnp, &
6443 emdiv, &
6444 rdnw, config_flags, spec_zone, &
6445 non_hydrostatic, &
6446 ids, ide, jds, jde, kds, kde, &
6447 ims, ime, jms, jme, kms, kme, &
6448 its, ite, jts, jte, kts, kte )
6449
6450 do i=ims,ime
6451 do k=kms,kme
6452 do j=jms,jme
6453 B_u(i,k,j)=u(i,k,j)
6454 B_v(i,k,j)=v(i,k,j)
6455 enddo
6456 enddo
6457 enddo
6458
6459 ! TCL
6460
6461 CALL g_advance_uv( K_u, P_u, ru_tend, P_ru_tend, K_v, P_v, rv_tend, P_rv_tend, p, P_p, pb, ph, P_ph, php, P_php, alt, P_alt, al, &
6462 &P_al, mu, P_mu, muu, P_muu, cqu, P_cqu, muv, P_muv, cqv, P_cqv, mudf, P_mudf, rdx, rdy, dts, cf1, cf2, cf3, fnm, fnp, emdiv, rdnw,&
6463 & config_flags, spec_zone, non_hydrostatic, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
6464
6465 SAVE_L=0.
6466 do i=ims,ime
6467 do k=kms,kme
6468 do j=jms,jme
6469 SAVE_L=SAVE_L + P_u(i,k,j)*P_u(i,k,j) &
6470 + P_v(i,k,j)*P_v(i,k,j)
6471 enddo
6472 enddo
6473 enddo
6474
6475 ALPHA=1.
6476 DO NT=1,11
6477 ALPHA=0.1*ALPHA
6478 FACTOR=1.+ALPHA
6479 do i=ims,ime
6480 do k=kms,kme
6481 do j=jms,jme
6482 P_ru_tend(i,k,j)=FACTOR*S_ru_tend(i,k,j)
6483 P_rv_tend(i,k,j)=FACTOR*S_rv_tend(i,k,j)
6484 P_ph(i,k,j)=FACTOR*S_ph(i,k,j)
6485 P_php(i,k,j)=FACTOR*S_php(i,k,j)
6486 P_p(i,k,j)=FACTOR*S_p(i,k,j)
6487 P_alt(i,k,j)=FACTOR*S_alt(i,k,j)
6488 P_al(i,k,j)=FACTOR*S_al(i,k,j)
6489 P_cqu(i,k,j)=FACTOR*S_cqu(i,k,j)
6490 P_cqv(i,k,j)=FACTOR*S_cqv(i,k,j)
6491 enddo
6492 enddo
6493 enddo
6494 do i=ims,ime
6495 do j=jms,jme
6496 P_muu(i,j)=FACTOR*S_muu(i,j)
6497 P_muv(i,j)=FACTOR*S_muv(i,j)
6498 P_mu(i,j)=FACTOR*S_mu(i,j)
6499 P_mudf(i,j)=FACTOR*S_mudf(i,j)
6500 enddo
6501 enddo
6502 do i=ims,ime
6503 do k=kms,kme
6504 do j=jms,jme
6505 P_u(i,k,j)=FACTOR*S_u(i,k,j)
6506 P_v(i,k,j)=FACTOR*S_v(i,k,j)
6507 enddo
6508 enddo
6509 enddo
6510
6511 CALL advance_uv ( P_u, P_ru_tend, P_v, P_rv_tend, &
6512 P_p, pb, &
6513 P_ph, P_php, P_alt, P_al, P_mu, &
6514 P_muu, P_cqu, P_muv, P_cqv, P_mudf, &
6515 rdx, rdy, dts, &
6516 cf1, cf2, cf3, fnm, fnp, &
6517 emdiv, &
6518 rdnw, config_flags, spec_zone, &
6519 non_hydrostatic, &
6520 ids, ide, jds, jde, kds, kde, &
6521 ims, ime, jms, jme, kms, kme, &
6522 its, ite, jts, jte, kts, kte )
6523
6524 VAL_N=0.
6525 do i=ims,ime
6526 do k=kms,kme
6527 do j=jms,jme
6528 VAL_N=VAL_N+(P_u(i,k,j)- B_u(i,k,j))*(P_u(i,k,j)- B_u(i,k,j)) &
6529 +(P_v(i,k,j)- B_v(i,k,j))*(P_v(i,k,j)- B_v(i,k,j))
6530 enddo
6531 enddo
6532 enddo
6533
6534 VAL_L=SAVE_L*ALPHA**2
6535 COEF=VAL_N/VAL_L
6536 WRITE(6, fmt='(A,E9.4,A,E22.13,A,E13.6,A,E13.6)') &
6537 'g_advance_uv: ALPHA=',ALPHA,' COEF=',COEF, &
6538 ' VAL_N=',VAL_N,' VAL_L=',VAL_L
6539 ENDDO
6540
6541 ! ADJ test
6542
6543 FACTOR=0.1
6544 do i=ims,ime
6545 do k=kms,kme
6546 do j=jms,jme
6547 ru_tend(i,k,j)=S_ru_tend(i,k,j)
6548 rv_tend(i,k,j)=S_rv_tend(i,k,j)
6549 ph(i,k,j)=S_ph(i,k,j)
6550 php(i,k,j)=S_php(i,k,j)
6551 p(i,k,j)=S_p(i,k,j)
6552 alt(i,k,j)=S_alt(i,k,j)
6553 al(i,k,j)=S_al(i,k,j)
6554 cqu(i,k,j)=S_cqu(i,k,j)
6555 cqv(i,k,j)=S_cqv(i,k,j)
6556
6557 P_ru_tend(i,k,j)=FACTOR*S_ru_tend(i,k,j)
6558 P_rv_tend(i,k,j)=FACTOR*S_rv_tend(i,k,j)
6559 P_ph(i,k,j)=FACTOR*S_ph(i,k,j)
6560 P_php(i,k,j)=FACTOR*S_php(i,k,j)
6561 P_p(i,k,j)=FACTOR*S_p(i,k,j)
6562 P_alt(i,k,j)=FACTOR*S_alt(i,k,j)
6563 P_al(i,k,j)=FACTOR*S_al(i,k,j)
6564 P_cqu(i,k,j)=FACTOR*S_cqu(i,k,j)
6565 P_cqv(i,k,j)=FACTOR*S_cqv(i,k,j)
6566
6567 B_ru_tend(i,k,j)=P_ru_tend(i,k,j)
6568 B_rv_tend(i,k,j)=P_rv_tend(i,k,j)
6569 B_ph(i,k,j)=P_ph(i,k,j)
6570 B_php(i,k,j)=P_php(i,k,j)
6571 B_p(i,k,j)=P_p(i,k,j)
6572 B_alt(i,k,j)=P_alt(i,k,j)
6573 B_al(i,k,j)=P_al(i,k,j)
6574 B_cqu(i,k,j)=P_cqu(i,k,j)
6575 B_cqv(i,k,j)=P_cqv(i,k,j)
6576 enddo
6577 enddo
6578 enddo
6579 do i=ims,ime
6580 do j=jms,jme
6581 muu(i,j)=S_muu(i,j)
6582 muv(i,j)=S_muv(i,j)
6583 mu(i,j)=S_mu(i,j)
6584 mudf(i,j)=S_mudf(i,j)
6585
6586 P_muu(i,j)=FACTOR*S_muu(i,j)
6587 P_muv(i,j)=FACTOR*S_muv(i,j)
6588 P_mu(i,j)=FACTOR*S_mu(i,j)
6589 P_mudf(i,j)=FACTOR*S_mudf(i,j)
6590
6591 B_muu(i,j)=P_muu(i,j)
6592 B_muv(i,j)=P_muv(i,j)
6593 B_mu(i,j)=P_mu(i,j)
6594 B_mudf(i,j)=P_mudf(i,j)
6595 enddo
6596 enddo
6597 do i=ims,ime
6598 do k=kms,kme
6599 do j=jms,jme
6600 u(i,k,j)=S_u(i,k,j)
6601 v(i,k,j)=S_v(i,k,j)
6602
6603 P_u(i,k,j)=FACTOR*S_u(i,k,j)
6604 P_v(i,k,j)=FACTOR*S_v(i,k,j)
6605
6606 B_u(i,k,j)=P_u(i,k,j)
6607 B_v(i,k,j)=P_v(i,k,j)
6608 enddo
6609 enddo
6610 enddo
6611
6612 ! TGL
6613
6614 CALL g_advance_uv( u, P_u, ru_tend, P_ru_tend, v, P_v, rv_tend, P_rv_tend, p, P_p, pb, ph, P_ph, php, P_php, alt, P_alt, al, &
6615 &P_al, mu, P_mu, muu, P_muu, cqu, P_cqu, muv, P_muv, cqv, P_cqv, mudf, P_mudf, rdx, rdy, dts, cf1, cf2, cf3, fnm, fnp, emdiv, rdnw,&
6616 & config_flags, spec_zone, non_hydrostatic, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
6617
6618 VAL_L=0.
6619 do i=ims,ime
6620 do k=kms,kme
6621 do j=jms,jme
6622 VAL_L=VAL_L +P_u(i,k,j)*P_u(i,k,j) &
6623 + P_v(i,k,j)*P_v(i,k,j)
6624 enddo
6625 enddo
6626 enddo
6627
6628 do i=ims,ime
6629 do k=kms,kme
6630 do j=jms,jme
6631 P_ru_tend(i,k,j)=0.0
6632 P_rv_tend(i,k,j)=0.0
6633 P_ph(i,k,j)=0.0
6634 P_php(i,k,j)=0.0
6635 P_p(i,k,j)=0.0
6636 P_alt(i,k,j)=0.0
6637 P_al(i,k,j)=0.0
6638 P_cqu(i,k,j)=0.0
6639 P_cqv(i,k,j)=0.0
6640 enddo
6641 enddo
6642 enddo
6643 do i=ims,ime
6644 do j=jms,jme
6645 P_muu(i,j)=0.0
6646 P_muv(i,j)=0.0
6647 P_mu(i,j)=0.0
6648 P_mudf(i,j)=0.0
6649 enddo
6650 enddo
6651
6652 ! ADJ
6653
6654 CALL a_advance_uv( P_u, P_ru_tend, P_v, P_rv_tend, p, P_p, pb, ph, P_ph, php, P_php, alt, P_alt, al, P_al, mu, P_mu, muu, &
6655 &P_muu, cqu, P_cqu, muv, P_muv, cqv, P_cqv, P_mudf, rdx, rdy, dts, cf1, cf2, cf3, fnm, fnp, emdiv, rdnw, config_flags, spec_zone, &
6656 &non_hydrostatic, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
6657
6658 VAL_A=0.
6659 do i=ims,ime
6660 do k=kms,kme
6661 do j=jms,jme
6662 VAL_A=VAL_A + P_ru_tend(i,k,j)*B_ru_tend(i,k,j) &
6663 + P_rv_tend(i,k,j)*B_rv_tend(i,k,j) &
6664 + P_ph(i,k,j)*B_ph(i,k,j) &
6665 + P_php(i,k,j)*B_php(i,k,j) &
6666 + P_p(i,k,j)*B_p(i,k,j) &
6667 + P_alt(i,k,j)*B_alt(i,k,j) &
6668 + P_al(i,k,j)*B_al(i,k,j) &
6669 + P_cqu(i,k,j)*B_cqu(i,k,j) &
6670 + P_cqv(i,k,j)*B_cqv(i,k,j)
6671 enddo
6672 enddo
6673 enddo
6674 do i=ims,ime
6675 do j=jms,jme
6676 VAL_A=VAL_A + P_mu(i,j)*B_mu(i,j) &
6677 + P_mudf(i,j)*B_mudf(i,j) &
6678 + P_muu(i,j)*B_muu(i,j) &
6679 + P_muv(i,j)*B_muv(i,j)
6680 enddo
6681 enddo
6682 do i=ims,ime
6683 do k=kms,kme
6684 do j=jms,jme
6685 VAL_A=VAL_A + P_u(i,k,j)*B_u(i,k,j) &
6686 + P_v(i,k,j)*B_v(i,k,j)
6687 enddo
6688 enddo
6689 enddo
6690
6691 print*, ' '
6692 write(6,fmt='(A,2E22.13)') 'a_advance_uv: ', VAL_L,VAL_A
6693
6694 ! RECOVER
6695
6696 do i=ims,ime
6697 do k=kms,kme
6698 do j=jms,jme
6699 ru_tend(i,k,j)=S_ru_tend(i,k,j)
6700 rv_tend(i,k,j)=S_rv_tend(i,k,j)
6701 ph(i,k,j)=S_ph(i,k,j)
6702 php(i,k,j)=S_php(i,k,j)
6703 p(i,k,j)=S_p(i,k,j)
6704 alt(i,k,j)=S_alt(i,k,j)
6705 al(i,k,j)=S_al(i,k,j)
6706 cqu(i,k,j)=S_cqu(i,k,j)
6707 cqv(i,k,j)=S_cqv(i,k,j)
6708 enddo
6709 enddo
6710 enddo
6711 do i=ims,ime
6712 do j=jms,jme
6713 muu(i,j)=S_muu(i,j)
6714 muv(i,j)=S_muv(i,j)
6715 mu(i,j)=S_mu(i,j)
6716 mudf(i,j)=S_mudf(i,j)
6717 enddo
6718 enddo
6719 do i=ims,ime
6720 do k=kms,kme
6721 do j=jms,jme
6722 u(i,k,j)=S_u(i,k,j)
6723 v(i,k,j)=S_v(i,k,j)
6724 enddo
6725 enddo
6726 enddo
6727
6728 !g_advance_uv: ALPHA=.1000E+00 COEF= 0.1000012874603E+01 VAL_N= 0.988534E+11 VAL_L= 0.988521E+11
6729 !g_advance_uv: ALPHA=.1000E-01 COEF= 0.1000010371208E+01 VAL_N= 0.988531E+09 VAL_L= 0.988521E+09
6730 !g_advance_uv: ALPHA=.1000E-02 COEF= 0.1000114560127E+01 VAL_N= 0.988634E+07 VAL_L= 0.988521E+07
6731 !g_advance_uv: ALPHA=.1000E-03 COEF= 0.1000334739685E+01 VAL_N= 0.988852E+05 VAL_L= 0.988521E+05
6732 !g_advance_uv: ALPHA=.1000E-04 COEF= 0.1000074028969E+01 VAL_N= 0.988594E+03 VAL_L= 0.988521E+03
6733 !g_advance_uv: ALPHA=.1000E-05 COEF= 0.9045659899712E+00 VAL_N= 0.894183E+01 VAL_L= 0.988521E+01
6734 !g_advance_uv: ALPHA=.1000E-06 COEF= 0.1374753713608E+01 VAL_N= 0.135897E+00 VAL_L= 0.988521E-01
6735 !g_advance_uv: ALPHA=.1000E-07 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.988521E-03
6736 !g_advance_uv: ALPHA=.1000E-08 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.988521E-05
6737 !g_advance_uv: ALPHA=.1000E-09 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.988521E-07
6738 !g_advance_uv: ALPHA=.1000E-10 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.988521E-09
6739
6740 !a_advance_uv: 0.9885338009600E+11 0.9885322444800E+11
6741
6742 !g_advance_uv: ALPHA=.1000E+00 COEF= 0.1000000000000E+01 VAL_N= 0.988532E+11 VAL_L= 0.988532E+11
6743 !g_advance_uv: ALPHA=.1000E-01 COEF= 0.1000000000000E+01 VAL_N= 0.988532E+09 VAL_L= 0.988532E+09
6744 !g_advance_uv: ALPHA=.1000E-02 COEF= 0.9999999999998E+00 VAL_N= 0.988532E+07 VAL_L= 0.988532E+07
6745 !g_advance_uv: ALPHA=.1000E-03 COEF= 0.9999999999998E+00 VAL_N= 0.988532E+05 VAL_L= 0.988532E+05
6746 !g_advance_uv: ALPHA=.1000E-04 COEF= 0.1000000000013E+01 VAL_N= 0.988532E+03 VAL_L= 0.988532E+03
6747 !g_advance_uv: ALPHA=.1000E-05 COEF= 0.9999999998322E+00 VAL_N= 0.988532E+01 VAL_L= 0.988532E+01
6748 !g_advance_uv: ALPHA=.1000E-06 COEF= 0.1000000001109E+01 VAL_N= 0.988532E-01 VAL_L= 0.988532E-01
6749 !g_advance_uv: ALPHA=.1000E-07 COEF= 0.9999999865495E+00 VAL_N= 0.988532E-03 VAL_L= 0.988532E-03
6750 !g_advance_uv: ALPHA=.1000E-08 COEF= 0.1000000149405E+01 VAL_N= 0.988532E-05 VAL_L= 0.988532E-05
6751 !g_advance_uv: ALPHA=.1000E-09 COEF= 0.1000000029187E+01 VAL_N= 0.988532E-07 VAL_L= 0.988532E-07
6752 !g_advance_uv: ALPHA=.1000E-10 COEF= 0.9999987059852E+00 VAL_N= 0.988531E-09 VAL_L= 0.988532E-09
6753
6754 !a_advance_uv: 0.9885322606433E+11 0.9885322606433E+11
6755
6756
6757 END SUBROUTINE t_advance_uv
6758 !-----------------------------------------------------------------------------------------------
6759 SUBROUTINE t_advance_mu_t( ww, ww_1, u, u_1, v, v_1, &
6760 mu, mut, muave, muts, muu, muv, &
6761 mudf, uam, vam, wwam, t, t_1, &
6762 t_ave, ft, mu_tend, &
6763 rdx, rdy, dts, epssm, &
6764 dnw, fnm, fnp, rdnw, &
6765 msfu, msfv, msft, &
6766 step, config_flags, &
6767 ids, ide, jds, jde, kds, kde, &
6768 ims, ime, jms, jme, kms, kme, &
6769 its, ite, jts, jte, kts, kte )
6770
6771 ! Zaizhong Ma, March 31,2005
6772
6773 IMPLICIT NONE ! religion first
6774
6775 ! stuff coming in
6776
6777 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
6778
6779 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
6780 INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
6781 INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
6782
6783 INTEGER, INTENT(IN ) :: step
6784
6785 REAL, DIMENSION( ims:ime , kms:kme, jms:jme ) :: &
6786 u, &
6787 v, &
6788 u_1, &
6789 v_1, &
6790 t_1, &
6791 ft
6792
6793 REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), &
6794 INTENT(INOUT) :: &
6795 ww, &
6796 ww_1, &
6797 t, &
6798 t_ave, &
6799 uam, &
6800 vam, &
6801 wwam
6802
6803 REAL, DIMENSION( ims:ime , jms:jme ) :: muu, &
6804 muv, &
6805 mut, &
6806 mu_tend
6807
6808 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ) :: msfu, &
6809 msfv, &
6810 msft
6811
6812 REAL, DIMENSION( ims:ime , jms:jme ), INTENT( OUT) :: muave, &
6813 muts, &
6814 mudf
6815
6816 REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT) :: mu
6817
6818 REAL, DIMENSION( kms:kme ), INTENT(IN ) :: fnm, &
6819 fnp, &
6820 dnw, &
6821 rdnw
6822
6823 REAL, INTENT(IN ) :: rdx, &
6824 rdy, &
6825 dts, &
6826 epssm
6827
6828 ! Local 3d array from the stack (note tile size)
6829
6830 REAL, DIMENSION (its:ite, kts:kte) :: wdtn, dvdxi
6831 REAL, DIMENSION (its:ite) :: dmdt
6832
6833 INTEGER :: i,j,k, i_start, i_end, j_start, j_end, k_start, k_end
6834 INTEGER :: i_endu, j_endv
6835 REAL :: acc
6836
6837 ! zzma: new definition
6838
6839 ! IN variables
6840
6841 REAL, DIMENSION( ims:ime , kms:kme, jms:jme ) :: &
6842 S_u, &
6843 S_v, &
6844 S_u_1, &
6845 S_v_1, &
6846 S_t_1, &
6847 S_ft , &
6848 P_u, &
6849 P_v, &
6850 P_u_1, &
6851 P_v_1, &
6852 P_t_1, &
6853 P_ft , &
6854 B_u, &
6855 B_v, &
6856 B_u_1, &
6857 B_v_1, &
6858 B_t_1, &
6859 B_ft
6860
6861 REAL, DIMENSION( ims:ime , jms:jme ) :: S_muu, &
6862 S_muv, &
6863 S_mut, &
6864 S_mu_tend
6865 REAL, DIMENSION( ims:ime , jms:jme ) :: P_muu, &
6866 P_muv, &
6867 P_mut, &
6868 P_mu_tend
6869 REAL, DIMENSION( ims:ime , jms:jme ) :: B_muu, &
6870 B_muv, &
6871 B_mut, &
6872 B_mu_tend
6873 ! INOUT variables
6874
6875 REAL, DIMENSION( ims:ime , kms:kme, jms:jme ) :: &
6876 S_ww, &
6877 S_ww_1, &
6878 S_t, &
6879 S_t_ave, &
6880 P_ww, &
6881 P_ww_1, &
6882 P_t, &
6883 P_t_ave, &
6884 B_ww, &
6885 B_ww_1, &
6886 B_t, &
6887 B_t_ave, &
6888 K_ww, &
6889 K_ww_1, &
6890 K_t, &
6891 K_t_ave
6892
6893 REAL, DIMENSION( ims:ime , jms:jme ) :: S_mu,P_mu,K_mu,B_mu
6894
6895 ! OUT variables
6896
6897 REAL, DIMENSION( ims:ime , jms:jme ) :: P_muave, P_muts, P_mudf,B_muave, B_muts, B_mudf
6898
6899
6900 REAL :: SAVE_L, COEF, ALPHA, FACTOR, VAL_N, VAL_L, VAL_A
6901 INTEGER :: NT
6902
6903 ! zzma: new definition end
6904
6905 !TGL test
6906
6907 do i=ims,ime
6908 do k=kms,kme
6909 do j=jms,jme
6910 S_u(i,k,j)=u(i,k,j)
6911 S_v(i,k,j)=v(i,k,j)
6912 S_u_1(i,k,j)=u_1(i,k,j)
6913 S_v_1(i,k,j)=v_1(i,k,j)
6914 S_t_1(i,k,j)=t_1(i,k,j)
6915 S_ft(i,k,j)=ft(i,k,j)
6916
6917 P_u(i,k,j)=u(i,k,j)
6918 P_v(i,k,j)=v(i,k,j)
6919 P_u_1(i,k,j)=u_1(i,k,j)
6920 P_v_1(i,k,j)=v_1(i,k,j)
6921 P_t_1(i,k,j)=t_1(i,k,j)
6922 P_ft(i,k,j)=ft(i,k,j)
6923 enddo
6924 enddo
6925 enddo
6926 do i=ims,ime
6927 do j=jms,jme
6928 S_mu_tend(i,j)=mu_tend(i,j)
6929 S_mut(i,j)=mut(i,j)
6930 S_muu(i,j)=muu(i,j)
6931 S_muv(i,j)=muv(i,j)
6932
6933 P_mu_tend(i,j)=mu_tend(i,j)
6934 P_mut(i,j)=mut(i,j)
6935 P_muu(i,j)=muu(i,j)
6936 P_muv(i,j)=muv(i,j)
6937 enddo
6938 enddo
6939 do i=ims,ime
6940 do k=kms,kme
6941 do j=jms,jme
6942 S_ww(i,k,j)=ww(i,k,j)
6943 S_ww_1(i,k,j)=ww_1(i,k,j)
6944 S_t(i,k,j)=t(i,k,j)
6945 S_t_ave(i,k,j)=t_ave(i,k,j)
6946
6947 P_ww(i,k,j)=ww(i,k,j)
6948 P_ww_1(i,k,j)=ww_1(i,k,j)
6949 P_t(i,k,j)=t(i,k,j)
6950 P_t_ave(i,k,j)=t_ave(i,k,j)
6951
6952 K_ww(i,k,j)=ww(i,k,j)
6953 K_ww_1(i,k,j)=ww_1(i,k,j)
6954 K_t(i,k,j)=t(i,k,j)
6955 K_t_ave(i,k,j)=t_ave(i,k,j)
6956 enddo
6957 enddo
6958 enddo
6959 do i=ims,ime
6960 do j=jms,jme
6961 S_mu(i,j)=mu(i,j)
6962 P_mu(i,j)=mu(i,j)
6963 K_mu(i,j)=mu(i,j)
6964 enddo
6965 enddo
6966
6967
6968 !NLM
6969
6970 CALL advance_mu_t( ww, ww_1, u, u_1, v, v_1, &
6971 mu, mut, muave, muts, muu, muv, &
6972 mudf, uam, vam, wwam, t, t_1, &
6973 t_ave, ft, mu_tend, &
6974 rdx, rdy, dts, epssm, &
6975 dnw, fnm, fnp, rdnw, &
6976 msfu, msfv, msft, &
6977 step, config_flags, &
6978 ids, ide, jds, jde, kds, kde, &
6979 ims, ime, jms, jme, kms, kme, &
6980 its, ite, jts, jte, kts, kte )
6981
6982 do i=ims,ime
6983 do j=jms,jme
6984 B_muave(i,j)=muave(i,j)
6985 B_muts(i,j)=muts(i,j)
6986 B_mudf(i,j)=mudf(i,j)
6987 enddo
6988 enddo
6989 do i=ims,ime
6990 do k=kms,kme
6991 do j=jms,jme
6992 B_ww(i,k,j)=ww(i,k,j)
6993 B_ww_1(i,k,j)=ww_1(i,k,j)
6994 B_t(i,k,j)=t(i,k,j)
6995 B_t_ave(i,k,j)=t_ave(i,k,j)
6996 enddo
6997 enddo
6998 enddo
6999 do i=ims,ime
7000 do j=jms,jme
7001 B_mu(i,j)=mu(i,j)
7002 enddo
7003 enddo
7004
7005 ! TCL
7006
7007 CALL g_advance_mu_t( K_ww, P_ww, K_ww_1, P_ww_1, u, P_u, u_1, P_u_1, v, P_v, v_1, P_v_1, K_mu, P_mu, mut, P_mut, muave, P_muave, &
7008 &muts, P_muts, muu, P_muu, muv, P_muv, mudf, P_mudf, K_t, P_t, t_1, P_t_1, K_t_ave, P_t_ave, ft, P_ft, mu_tend, P_mu_tend, rdx, rdy, &
7009 &dts, epssm, dnw, fnm, fnp, rdnw, msfu, msfv, msft, config_flags, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, &
7010 &jts, jte, kts, kte )
7011
7012 SAVE_L=0.
7013 do i=ims,ime
7014 do j=jms,jme
7015 SAVE_L=SAVE_L + P_muave(i,j)*P_muave(i,j) &
7016 + P_muts(i,j)*P_muts(i,j) &
7017 + P_mudf(i,j)*P_mudf(i,j)
7018 enddo
7019 enddo
7020 do i=ims,ime
7021 do k=kms,kme
7022 do j=jms,jme
7023 SAVE_L=SAVE_L + P_ww(i,k,j)*P_ww(i,k,j) &
7024 + P_ww_1(i,k,j)*P_ww_1(i,k,j) &
7025 + P_t(i,k,j)*P_t(i,k,j) &
7026 + P_t_ave(i,k,j)*P_t_ave(i,k,j)
7027 enddo
7028 enddo
7029 enddo
7030 do i=ims,ime
7031 do j=jms,jme
7032 SAVE_L=SAVE_L + P_mu(i,j)*P_mu(i,j)
7033 enddo
7034 enddo
7035
7036 ALPHA=1.
7037 DO NT=1,11
7038 ALPHA=0.1*ALPHA
7039 FACTOR=1.+ALPHA
7040 do i=ims,ime
7041 do k=kms,kme
7042 do j=jms,jme
7043 P_u(i,k,j)=FACTOR*S_u(i,k,j)
7044 P_v(i,k,j)=FACTOR*S_v(i,k,j)
7045 P_u_1(i,k,j)=FACTOR*S_u_1(i,k,j)
7046 P_v_1(i,k,j)=FACTOR*S_v_1(i,k,j)
7047 P_t_1(i,k,j)=FACTOR*S_t_1(i,k,j)
7048 P_ft(i,k,j)=FACTOR*S_ft(i,k,j)
7049 enddo
7050 enddo
7051 enddo
7052 do i=ims,ime
7053 do j=jms,jme
7054 P_mu_tend(i,j)=FACTOR*S_mu_tend(i,j)
7055 P_mut(i,j)=FACTOR*S_mut(i,j)
7056 P_muu(i,j)=FACTOR*S_muu(i,j)
7057 P_muv(i,j)=FACTOR*S_muv(i,j)
7058 enddo
7059 enddo
7060 do i=ims,ime
7061 do k=kms,kme
7062 do j=jms,jme
7063 P_ww(i,k,j)=FACTOR*S_ww(i,k,j)
7064 P_ww_1(i,k,j)=FACTOR*S_ww_1(i,k,j)
7065 P_t(i,k,j)=FACTOR*S_t(i,k,j)
7066 P_t_ave(i,k,j)=FACTOR*S_t_ave(i,k,j)
7067 enddo
7068 enddo
7069 enddo
7070 do i=ims,ime
7071 do j=jms,jme
7072 P_mu(i,j)=FACTOR*S_mu(i,j)
7073 enddo
7074 enddo
7075
7076 CALL advance_mu_t( P_ww, P_ww_1, P_u, P_u_1, P_v, P_v_1, &
7077 P_mu, P_mut, P_muave, P_muts, P_muu, P_muv, &
7078 P_mudf, uam, vam, wwam, P_t, P_t_1, &
7079 P_t_ave, P_ft, P_mu_tend, &
7080 rdx, rdy, dts, epssm, &
7081 dnw, fnm, fnp, rdnw, &
7082 msfu, msfv, msft, &
7083 step, config_flags, &
7084 ids, ide, jds, jde, kds, kde, &
7085 ims, ime, jms, jme, kms, kme, &
7086 its, ite, jts, jte, kts, kte )
7087
7088 VAL_N=0.
7089
7090 do i=ims,ime
7091 do j=jms,jme
7092 VAL_N=VAL_N + (P_muave(i,j) -B_muave(i,j))*(P_muave(i,j) -B_muave(i,j)) &
7093 + (P_muts(i,j) -B_muts(i,j))*(P_muts(i,j) -B_muts(i,j)) &
7094 + (P_mudf(i,j) -B_mudf(i,j))*(P_mudf(i,j) -B_mudf(i,j))
7095 enddo
7096 enddo
7097 do i=ims,ime
7098 do k=kms,kme
7099 do j=jms,jme
7100 VAL_N=VAL_N + (P_ww(i,k,j) -B_ww(i,k,j))*(P_ww(i,k,j) -B_ww(i,k,j)) &
7101 + (P_ww_1(i,k,j) -B_ww_1(i,k,j))*(P_ww_1(i,k,j) -B_ww_1(i,k,j)) &
7102 + (P_t(i,k,j) -B_t(i,k,j))*(P_t(i,k,j) -B_t(i,k,j)) &
7103 + (P_t_ave(i,k,j) -B_t_ave(i,k,j))*(P_t_ave(i,k,j) -B_t_ave(i,k,j))
7104 enddo
7105 enddo
7106 enddo
7107 do i=ims,ime
7108 do j=jms,jme
7109 VAL_N=VAL_N + (P_mu(i,j) -B_mu(i,j))*(P_mu(i,j) -B_mu(i,j))
7110 enddo
7111 enddo
7112
7113 VAL_L=SAVE_L*ALPHA**2
7114 COEF=VAL_N/VAL_L
7115 WRITE(6, fmt='(A,E9.4,A,E22.13,A,E13.6,A,E13.6)') &
7116 'g_advance_mu_t: ALPHA=',ALPHA,' COEF=',COEF, &
7117 ' VAL_N=',VAL_N,' VAL_L=',VAL_L
7118 ENDDO
7119
7120 ! ADJ test
7121
7122 FACTOR=0.1
7123 do i=ims,ime
7124 do k=kms,kme
7125 do j=jms,jme
7126 u(i,k,j)=S_u(i,k,j)
7127 v(i,k,j)=S_v(i,k,j)
7128 u_1(i,k,j)=S_u_1(i,k,j)
7129 v_1(i,k,j)=S_v_1(i,k,j)
7130 t_1(i,k,j)=S_t_1(i,k,j)
7131 ft(i,k,j)=S_ft(i,k,j)
7132
7133 P_u(i,k,j)=FACTOR*S_u(i,k,j)
7134 P_v(i,k,j)=FACTOR*S_v(i,k,j)
7135 P_u_1(i,k,j)=FACTOR*S_u_1(i,k,j)
7136 P_v_1(i,k,j)=FACTOR*S_v_1(i,k,j)
7137 P_t_1(i,k,j)=FACTOR*S_t_1(i,k,j)
7138 P_ft(i,k,j)=FACTOR*S_ft(i,k,j)
7139
7140 B_u(i,k,j)=P_u(i,k,j)
7141 B_v(i,k,j)=P_v(i,k,j)
7142 B_u_1(i,k,j)=P_u_1(i,k,j)
7143 B_v_1(i,k,j)=P_v_1(i,k,j)
7144 B_t_1(i,k,j)=P_t_1(i,k,j)
7145 B_ft(i,k,j)=P_ft(i,k,j)
7146 enddo
7147 enddo
7148 enddo
7149 do i=ims,ime
7150 do j=jms,jme
7151 mu_tend(i,j)=S_mu_tend(i,j)
7152 mut(i,j)=S_mut(i,j)
7153 muu(i,j)=S_muu(i,j)
7154 muv(i,j)=S_muv(i,j)
7155
7156 P_mu_tend(i,j)=FACTOR*S_mu_tend(i,j)
7157 P_mut(i,j)=FACTOR*S_mut(i,j)
7158 P_muu(i,j)=FACTOR*S_muu(i,j)
7159 P_muv(i,j)=FACTOR*S_muv(i,j)
7160
7161 B_mu_tend(i,j)=P_mu_tend(i,j)
7162 B_mut(i,j)=P_mut(i,j)
7163 B_muu(i,j)=P_muu(i,j)
7164 B_muv(i,j)=P_muv(i,j)
7165 enddo
7166 enddo
7167 do i=ims,ime
7168 do k=kms,kme
7169 do j=jms,jme
7170 ww(i,k,j)=S_ww(i,k,j)
7171 ww_1(i,k,j)=S_ww_1(i,k,j)
7172 t(i,k,j)=S_t(i,k,j)
7173 t_ave(i,k,j)=S_t_ave(i,k,j)
7174
7175 P_ww(i,k,j)=FACTOR*S_ww(i,k,j)
7176 P_ww_1(i,k,j)=FACTOR*S_ww_1(i,k,j)
7177 P_t(i,k,j)=FACTOR*S_t(i,k,j)
7178 P_t_ave(i,k,j)=FACTOR*S_t_ave(i,k,j)
7179
7180 B_ww(i,k,j)=P_ww(i,k,j)
7181 B_ww_1(i,k,j)=P_ww_1(i,k,j)
7182 B_t(i,k,j)=P_t(i,k,j)
7183 B_t_ave(i,k,j)=P_t_ave(i,k,j)
7184
7185 K_ww(i,k,j)=ww(i,k,j)
7186 K_ww_1(i,k,j)=ww_1(i,k,j)
7187 K_t(i,k,j)=t(i,k,j)
7188 K_t_ave(i,k,j)=t_ave(i,k,j)
7189 enddo
7190 enddo
7191 enddo
7192 do i=ims,ime
7193 do j=jms,jme
7194 mu(i,j)=S_mu(i,j)
7195 P_mu(i,j)=FACTOR*S_mu(i,j)
7196 B_mu(i,j)=P_mu(i,j)
7197 K_mu(i,j)=mu(i,j)
7198 enddo
7199 enddo
7200
7201 ! TGL
7202
7203 CALL g_advance_mu_t( ww, P_ww, ww_1, P_ww_1, u, P_u, u_1, P_u_1, v, P_v, v_1, P_v_1, mu, P_mu, mut, P_mut, muave, P_muave, &
7204 &muts, P_muts, muu, P_muu, muv, P_muv, mudf, P_mudf, t, P_t, t_1, P_t_1, t_ave, P_t_ave, ft, P_ft, mu_tend, P_mu_tend, rdx, rdy, &
7205 &dts, epssm, dnw, fnm, fnp, rdnw, msfu, msfv, msft, config_flags, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, &
7206 &jts, jte, kts, kte )
7207
7208 VAL_L=0.
7209 do i=ims,ime
7210 do j=jms,jme
7211 VAL_L=VAL_L + P_muave(i,j)*P_muave(i,j) &
7212 + P_muts(i,j)*P_muts(i,j) &
7213 + P_mudf(i,j)*P_mudf(i,j)
7214 enddo
7215 enddo
7216 do i=ims,ime
7217 do k=kms,kme
7218 do j=jms,jme
7219 VAL_L=VAL_L + P_ww(i,k,j)*P_ww(i,k,j) &
7220 + P_ww_1(i,k,j)*P_ww_1(i,k,j) &
7221 + P_t(i,k,j)*P_t(i,k,j) &
7222 + P_t_ave(i,k,j)*P_t_ave(i,k,j)
7223 enddo
7224 enddo
7225 enddo
7226 do i=ims,ime
7227 do j=jms,jme
7228 VAL_L=VAL_L + P_mu(i,j)*P_mu(i,j)
7229 enddo
7230 enddo
7231 do i=ims,ime
7232 do k=kms,kme
7233 do j=jms,jme
7234 P_u(i,k,j)=0.0
7235 P_v(i,k,j)=0.0
7236 P_u_1(i,k,j)=0.0
7237 P_v_1(i,k,j)=0.0
7238 P_t_1(i,k,j)=0.0
7239 P_ft(i,k,j)=0.0
7240 enddo
7241 enddo
7242 enddo
7243 do i=ims,ime
7244 do j=jms,jme
7245 P_mu_tend(i,j)=0.0
7246 P_mut(i,j)=0.0
7247 P_muu(i,j)=0.0
7248 P_muv(i,j)=0.0
7249 enddo
7250 enddo
7251
7252 ! ADJ
7253
7254 CALL a_advance_mu_t( K_ww, P_ww, K_ww_1, P_ww_1, u, P_u, u_1, P_u_1, v, P_v, v_1, P_v_1, P_mu, P_mut, P_muave, P_muts, muu, &
7255 &P_muu, muv, P_muv, P_mudf, P_t, t_1, P_t_1, P_t_ave, P_ft, mu_tend, P_mu_tend, rdx, rdy, dts, epssm, dnw, fnm, fnp, rdnw, msfu, &
7256 &msfv, msft, config_flags, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
7257
7258 VAL_A=0.
7259 do i=ims,ime
7260 do k=kms,kme
7261 do j=jms,jme
7262 VAL_A=VAL_A + P_u(i,k,j)*B_u(i,k,j) &
7263 + P_v(i,k,j)*B_v(i,k,j) &
7264 + P_u_1(i,k,j)*B_u_1(i,k,j) &
7265 + P_v_1(i,k,j)*B_v_1(i,k,j) &
7266 + P_t_1(i,k,j)*B_t_1(i,k,j) &
7267 + P_ft(i,k,j)*B_ft(i,k,j)
7268 enddo
7269 enddo
7270 enddo
7271 do i=ims,ime
7272 do j=jms,jme
7273 VAL_A=VAL_A + P_mu_tend(i,j)*B_mu_tend(i,j) &
7274 + P_mut(i,j)*B_mut(i,j) &
7275 + P_muu(i,j)*B_muu(i,j) &
7276 + P_muv(i,j)*B_muv(i,j)
7277 enddo
7278 enddo
7279 do i=ims,ime
7280 do k=kms,kme
7281 do j=jms,jme
7282 VAL_A=VAL_A + P_ww(i,k,j)*B_ww(i,k,j) &
7283 + P_ww_1(i,k,j)*B_ww_1(i,k,j) &
7284 + P_t(i,k,j)*B_t(i,k,j) &
7285 + P_t_ave(i,k,j)*B_t_ave(i,k,j)
7286 enddo
7287 enddo
7288 enddo
7289 do i=ims,ime
7290 do j=jms,jme
7291 VAL_A=VAL_A + P_mu(i,j)*B_mu(i,j)
7292 enddo
7293 enddo
7294
7295 print*, ' '
7296 write(6,fmt='(A,2E22.13)') 'a_advance_mu_t: ', VAL_L,VAL_A
7297
7298 ! RECOVER
7299
7300 do i=ims,ime
7301 do k=kms,kme
7302 do j=jms,jme
7303 u(i,k,j)=S_u(i,k,j)
7304 v(i,k,j)=S_v(i,k,j)
7305 u_1(i,k,j)=S_u_1(i,k,j)
7306 v_1(i,k,j)=S_v_1(i,k,j)
7307 t_1(i,k,j)=S_t_1(i,k,j)
7308 ft(i,k,j)=S_ft(i,k,j)
7309 enddo
7310 enddo
7311 enddo
7312 do i=ims,ime
7313 do j=jms,jme
7314 mu_tend(i,j)=S_mu_tend(i,j)
7315 mut(i,j)=S_mut(i,j)
7316 muu(i,j)=S_muu(i,j)
7317 muv(i,j)=S_muv(i,j)
7318 enddo
7319 enddo
7320 do i=ims,ime
7321 do k=kms,kme
7322 do j=jms,jme
7323 ww(i,k,j)=S_ww(i,k,j)
7324 ww_1(i,k,j)=S_ww_1(i,k,j)
7325 t(i,k,j)=S_t(i,k,j)
7326 t_ave(i,k,j)=S_t_ave(i,k,j)
7327 enddo
7328 enddo
7329 enddo
7330 do i=ims,ime
7331 do j=jms,jme
7332 mu(i,j)=S_mu(i,j)
7333 enddo
7334 enddo
7335
7336 !g_advance_mu_t: ALPHA=.1000E+00 COEF= 0.1077146768570E+01 VAL_N= 0.644103E+12 VAL_L= 0.597971E+12
7337 !g_advance_mu_t: ALPHA=.1000E-01 COEF= 0.1007574081421E+01 VAL_N= 0.602500E+10 VAL_L= 0.597971E+10
7338 !g_advance_mu_t: ALPHA=.1000E-02 COEF= 0.1000920295715E+01 VAL_N= 0.598521E+08 VAL_L= 0.597971E+08
7339 !g_advance_mu_t: ALPHA=.1000E-03 COEF= 0.1005400180817E+01 VAL_N= 0.601200E+06 VAL_L= 0.597971E+06
7340 !g_advance_mu_t: ALPHA=.1000E-04 COEF= 0.1377802491188E+01 VAL_N= 0.823886E+04 VAL_L= 0.597971E+04
7341 !g_advance_mu_t: ALPHA=.1000E-05 COEF= 0.1535273933411E+02 VAL_N= 0.918050E+03 VAL_L= 0.597971E+02
7342 !g_advance_mu_t: ALPHA=.1000E-06 COEF= 0.4109736633301E+03 VAL_N= 0.245750E+03 VAL_L= 0.597971E+00
7343 !g_advance_mu_t: ALPHA=.1000E-07 COEF= 0.3229349176482E-16 VAL_N= 0.193106E-18 VAL_L= 0.597971E-02
7344 !g_advance_mu_t: ALPHA=.1000E-08 COEF= 0.3229349110307E-14 VAL_N= 0.193106E-18 VAL_L= 0.597971E-04
7345 !g_advance_mu_t: ALPHA=.1000E-09 COEF= 0.3229348754553E-12 VAL_N= 0.193106E-18 VAL_L= 0.597971E-06
7346 !g_advance_mu_t: ALPHA=.1000E-10 COEF= 0.3229348385925E-10 VAL_N= 0.193106E-18 VAL_L= 0.597971E-08
7347
7348 !a_advance_mu_t: 0.5979716976640E+12 0.5979532820480E+12
7349
7350
7351 END SUBROUTINE t_advance_mu_t
7352 !-----------------------------------------------------------------------------------------------
7353
7354 SUBROUTINE t_sumflux ( ru, rv, ww, &
7355 u_lin, v_lin, ww_lin, &
7356 muu, muv, &
7357 ru_m, rv_m, ww_m, epssm, &
7358 msfu, msfv, &
7359 iteration , number_of_small_timesteps, &
7360 ids,ide, jds,jde, kds,kde, &
7361 ims,ime, jms,jme, kms,kme, &
7362 its,ite, jts,jte, kts,kte )
7363
7364
7365 IMPLICIT NONE ! religion first
7366
7367 ! declarations for the stuff coming in
7368
7369 INTEGER, INTENT(IN ) :: number_of_small_timesteps
7370 INTEGER, INTENT(IN ) :: iteration
7371 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
7372 INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
7373 INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
7374
7375 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: ru, &
7376 rv, &
7377 ww, &
7378 u_lin, &
7379 v_lin, &
7380 ww_lin
7381
7382
7383 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) , INTENT(INOUT) :: ru_m, &
7384 rv_m, &
7385 ww_m
7386 REAL, DIMENSION(ims:ime, jms:jme) , INTENT(IN ) :: msfu, msfv
7387 REAL, DIMENSION(ims:ime, jms:jme) :: muu, muv
7388
7389 REAL, INTENT(IN ) :: epssm
7390 INTEGER :: i,j,k
7391
7392 ! zzma: new definition
7393
7394 ! IN variables
7395
7396 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: S_ru, &
7397 S_rv, &
7398 S_ww, &
7399 S_u_lin, &
7400 S_v_lin, &
7401 S_ww_lin
7402 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: P_ru, &
7403 P_rv, &
7404 P_ww, &
7405 P_u_lin, &
7406 P_v_lin, &
7407 P_ww_lin
7408 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: B_ru, &
7409 B_rv, &
7410 B_ww, &
7411 B_u_lin, &
7412 B_v_lin, &
7413 B_ww_lin
7414
7415 REAL, DIMENSION(ims:ime, jms:jme) :: S_muu, S_muv,P_muu, P_muv,B_muu, B_muv
7416
7417 ! INOUT variables
7418
7419 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: S_ru_m, S_rv_m, S_ww_m,P_ru_m, P_rv_m, P_ww_m
7420 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: K_ru_m, K_rv_m, K_ww_m,B_ru_m, B_rv_m, B_ww_m
7421
7422 REAL :: SAVE_L, COEF, ALPHA, FACTOR, VAL_N, VAL_L, VAL_A
7423 INTEGER :: NT
7424
7425 ! zzma: new definition end
7426
7427 !TGL test
7428
7429 do i=ims,ime
7430 do k=kms,kme
7431 do j=jms,jme
7432 S_ru(i,k,j)=ru(i,k,j)
7433 S_rv(i,k,j)=rv(i,k,j)
7434 S_ww(i,k,j)=ww(i,k,j)
7435 S_u_lin(i,k,j)=u_lin(i,k,j)
7436 S_v_lin(i,k,j)=v_lin(i,k,j)
7437 S_ww_lin(i,k,j)=ww_lin(i,k,j)
7438
7439 P_ru(i,k,j)=ru(i,k,j)
7440 P_rv(i,k,j)=rv(i,k,j)
7441 P_ww(i,k,j)=ww(i,k,j)
7442 P_u_lin(i,k,j)=u_lin(i,k,j)
7443 P_v_lin(i,k,j)=v_lin(i,k,j)
7444 P_ww_lin(i,k,j)=ww_lin(i,k,j)
7445 enddo
7446 enddo
7447 enddo
7448 do i=ims,ime
7449 do j=jms,jme
7450 S_muu(i,j)=muu(i,j)
7451 S_muv(i,j)=muv(i,j)
7452
7453 P_muu(i,j)=muu(i,j)
7454 P_muv(i,j)=muv(i,j)
7455 enddo
7456 enddo
7457 do i=ims,ime
7458 do k=kms,kme
7459 do j=jms,jme
7460 S_ru_m(i,k,j)=ru_m(i,k,j)
7461 S_rv_m(i,k,j)=rv_m(i,k,j)
7462 S_ww_m(i,k,j)=ww_m(i,k,j)
7463
7464 P_ru_m(i,k,j)=ru_m(i,k,j)
7465 P_rv_m(i,k,j)=rv_m(i,k,j)
7466 P_ww_m(i,k,j)=ww_m(i,k,j)
7467
7468 K_ru_m(i,k,j)=ru_m(i,k,j)
7469 K_rv_m(i,k,j)=rv_m(i,k,j)
7470 K_ww_m(i,k,j)=ww_m(i,k,j)
7471 enddo
7472 enddo
7473 enddo
7474
7475 !NLM
7476
7477 CALL sumflux ( ru, rv, ww, &
7478 u_lin, v_lin, ww_lin, &
7479 muu, muv, &
7480 ru_m, rv_m, ww_m, epssm, &
7481 msfu, msfv, &
7482 iteration , number_of_small_timesteps, &
7483 ids,ide, jds,jde, kds,kde, &
7484 ims,ime, jms,jme, kms,kme, &
7485 its,ite, jts,jte, kts,kte )
7486
7487 do i=ims,ime
7488 do k=kms,kme
7489 do j=jms,jme
7490 B_ru_m(i,k,j)=ru_m(i,k,j)
7491 B_rv_m(i,k,j)=rv_m(i,k,j)
7492 B_ww_m(i,k,j)=ww_m(i,k,j)
7493 enddo
7494 enddo
7495 enddo
7496
7497 ! TCL
7498
7499 CALL g_sumflux( ru, P_ru, rv, P_rv, ww, P_ww, u_lin, P_u_lin, v_lin, P_v_lin, ww_lin, P_ww_lin, muu, P_muu, muv, P_muv, K_ru_m,&
7500 & P_ru_m, K_rv_m, P_rv_m, K_ww_m, P_ww_m, msfu, msfv, iteration, number_of_small_timesteps, ide, jde, kde, ims, ime, jms, jme, kms, &
7501 &kme, its, ite, jts, jte, kts, kte )
7502
7503 SAVE_L=0.
7504 do i=ims,ime
7505 do k=kms,kme
7506 do j=jms,jme
7507 SAVE_L=SAVE_L +P_ru_m(i,k,j)*P_ru_m(i,k,j) &
7508 +P_rv_m(i,k,j)*P_rv_m(i,k,j) &
7509 +P_ww_m(i,k,j)*P_ww_m(i,k,j)
7510 enddo
7511 enddo
7512 enddo
7513
7514 ALPHA=1.
7515 DO NT=1,11
7516 ALPHA=0.1*ALPHA
7517 FACTOR=1.+ALPHA
7518 do i=ims,ime
7519 do k=kms,kme
7520 do j=jms,jme
7521 P_ru(i,k,j)=FACTOR*S_ru(i,k,j)
7522 P_rv(i,k,j)=FACTOR*S_rv(i,k,j)
7523 P_ww(i,k,j)=FACTOR*S_ww(i,k,j)
7524 P_u_lin(i,k,j)=FACTOR*S_u_lin(i,k,j)
7525 P_v_lin(i,k,j)=FACTOR*S_v_lin(i,k,j)
7526 P_ww_lin(i,k,j)=FACTOR*S_ww_lin(i,k,j)
7527 enddo
7528 enddo
7529 enddo
7530 do i=ims,ime
7531 do j=jms,jme
7532 P_muu(i,j)=FACTOR*S_muu(i,j)
7533 P_muv(i,j)=FACTOR*S_muv(i,j)
7534 enddo
7535 enddo
7536 do i=ims,ime
7537 do k=kms,kme
7538 do j=jms,jme
7539 P_ru_m(i,k,j)=FACTOR*S_ru_m(i,k,j)
7540 P_rv_m(i,k,j)=FACTOR*S_rv_m(i,k,j)
7541 P_ww_m(i,k,j)=FACTOR*S_ww_m(i,k,j)
7542 enddo
7543 enddo
7544 enddo
7545
7546 CALL sumflux ( P_ru, P_rv, P_ww, &
7547 P_u_lin, P_v_lin, P_ww_lin, &
7548 P_muu, P_muv, &
7549 P_ru_m, P_rv_m, P_ww_m, epssm, &
7550 msfu, msfv, &
7551 iteration , number_of_small_timesteps, &
7552 ids,ide, jds,jde, kds,kde, &
7553 ims,ime, jms,jme, kms,kme, &
7554 its,ite, jts,jte, kts,kte )
7555
7556 VAL_N=0.
7557 do i=ims,ime
7558 do k=kms,kme
7559 do j=jms,jme
7560 VAL_N=VAL_N + (P_ru_m(i,k,j)-B_ru_m(i,k,j))*(P_ru_m(i,k,j)-B_ru_m(i,k,j)) &
7561 + (P_rv_m(i,k,j)-B_rv_m(i,k,j))*(P_rv_m(i,k,j)-B_rv_m(i,k,j)) &
7562 + (P_ww_m(i,k,j)-B_ww_m(i,k,j))*(P_ww_m(i,k,j)-B_ww_m(i,k,j))
7563 enddo
7564 enddo
7565 enddo
7566
7567 VAL_L=SAVE_L*ALPHA**2
7568 COEF=VAL_N/VAL_L
7569 WRITE(6, fmt='(A,E9.4,A,E22.13,A,E13.6,A,E13.6)') &
7570 'g_sumflux: ALPHA=',ALPHA,' COEF=',COEF, &
7571 ' VAL_N=',VAL_N,' VAL_L=',VAL_L
7572 ENDDO
7573
7574 ! ADJ test
7575
7576 FACTOR=0.1
7577 do i=ims,ime
7578 do k=kms,kme
7579 do j=jms,jme
7580 ru(i,k,j)=S_ru(i,k,j)
7581 rv(i,k,j)=S_rv(i,k,j)
7582 ww(i,k,j)=S_ww(i,k,j)
7583 u_lin(i,k,j)=S_u_lin(i,k,j)
7584 v_lin(i,k,j)=S_v_lin(i,k,j)
7585 ww_lin(i,k,j)=S_ww_lin(i,k,j)
7586
7587 P_ru(i,k,j)=FACTOR*S_ru(i,k,j)
7588 P_rv(i,k,j)=FACTOR*S_rv(i,k,j)
7589 P_ww(i,k,j)=FACTOR*S_ww(i,k,j)
7590 P_u_lin(i,k,j)=FACTOR*S_u_lin(i,k,j)
7591 P_v_lin(i,k,j)=FACTOR*S_v_lin(i,k,j)
7592 P_ww_lin(i,k,j)=FACTOR*S_ww_lin(i,k,j)
7593
7594 B_ru(i,k,j)=P_ru(i,k,j)
7595 B_rv(i,k,j)=P_rv(i,k,j)
7596 B_ww(i,k,j)=P_ww(i,k,j)
7597 B_u_lin(i,k,j)=P_u_lin(i,k,j)
7598 B_v_lin(i,k,j)=P_v_lin(i,k,j)
7599 B_ww_lin(i,k,j)=P_ww_lin(i,k,j)
7600 enddo
7601 enddo
7602 enddo
7603 do i=ims,ime
7604 do j=jms,jme
7605 muu(i,j)=S_muu(i,j)
7606 muv(i,j)=S_muv(i,j)
7607
7608 P_muu(i,j)=FACTOR*S_muu(i,j)
7609 P_muv(i,j)=FACTOR*S_muv(i,j)
7610
7611 B_muu(i,j)=P_muu(i,j)
7612 B_muv(i,j)=P_muv(i,j)
7613 enddo
7614 enddo
7615 do i=ims,ime
7616 do k=kms,kme
7617 do j=jms,jme
7618 ru_m(i,k,j)=S_ru_m(i,k,j)
7619 rv_m(i,k,j)=S_rv_m(i,k,j)
7620 ww_m(i,k,j)=S_ww_m(i,k,j)
7621
7622 P_ru_m(i,k,j)=FACTOR*S_ru_m(i,k,j)
7623 P_rv_m(i,k,j)=FACTOR*S_rv_m(i,k,j)
7624 P_ww_m(i,k,j)=FACTOR*S_ww_m(i,k,j)
7625
7626 B_ru_m(i,k,j)=P_ru_m(i,k,j)
7627 B_rv_m(i,k,j)=P_rv_m(i,k,j)
7628 B_ww_m(i,k,j)=P_ww_m(i,k,j)
7629
7630 K_ru_m(i,k,j)=ru_m(i,k,j)
7631 K_rv_m(i,k,j)=rv_m(i,k,j)
7632 K_ww_m(i,k,j)=ww_m(i,k,j)
7633 enddo
7634 enddo
7635 enddo
7636
7637 ! TGL
7638
7639 CALL g_sumflux( ru, P_ru, rv, P_rv, ww, P_ww, u_lin, P_u_lin, v_lin, P_v_lin, ww_lin, P_ww_lin, muu, P_muu, muv, P_muv, ru_m,&
7640 & P_ru_m, rv_m, P_rv_m, ww_m, P_ww_m, msfu, msfv, iteration, number_of_small_timesteps, ide, jde, kde, ims, ime, jms, jme, kms, &
7641 &kme, its, ite, jts, jte, kts, kte )
7642
7643 VAL_L=0.
7644 do i=ims,ime
7645 do k=kms,kme
7646 do j=jms,jme
7647 VAL_L=VAL_L +P_ru_m(i,k,j)*P_ru_m(i,k,j) &
7648 +P_rv_m(i,k,j)*P_rv_m(i,k,j) &
7649 +P_ww_m(i,k,j)*P_ww_m(i,k,j)
7650 enddo
7651 enddo
7652 enddo
7653
7654 do i=ims,ime
7655 do k=kms,kme
7656 do j=jms,jme
7657 P_ru(i,k,j)=0.0
7658 P_rv(i,k,j)=0.0
7659 P_ww(i,k,j)=0.0
7660 P_u_lin(i,k,j)=0.0
7661 P_v_lin(i,k,j)=0.0
7662 P_ww_lin(i,k,j)=0.0
7663 enddo
7664 enddo
7665 enddo
7666 do i=ims,ime
7667 do j=jms,jme
7668 P_muu(i,j)=0.0
7669 P_muv(i,j)=0.0
7670 enddo
7671 enddo
7672
7673 ! ADJ
7674
7675 CALL a_sumflux( P_ru, P_rv, P_ww, u_lin, P_u_lin, v_lin, P_v_lin, P_ww_lin, muu, P_muu, muv, P_muv, P_ru_m, P_rv_m, P_ww_m, &
7676 &msfu, msfv, iteration, number_of_small_timesteps, ide, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
7677
7678 VAL_A=0.
7679 do i=ims,ime
7680 do k=kms,kme
7681 do j=jms,jme
7682 VAL_A=VAL_A+P_ru(i,k,j)*B_ru(i,k,j) &
7683 +P_rv(i,k,j)*B_rv(i,k,j) &
7684 +P_ww(i,k,j)*B_ww(i,k,j) &
7685 +P_u_lin(i,k,j)*B_u_lin(i,k,j) &
7686 +P_v_lin(i,k,j)*B_v_lin(i,k,j) &
7687 +P_ww_lin(i,k,j)*B_ww_lin(i,k,j)
7688 enddo
7689 enddo
7690 enddo
7691 do i=ims,ime
7692 do j=jms,jme
7693 VAL_A=VAL_A +P_muu(i,j)*B_muu(i,j) &
7694 +P_muv(i,j)*B_muv(i,j)
7695 enddo
7696 enddo
7697
7698 do i=ims,ime
7699 do k=kms,kme
7700 do j=jms,jme
7701 VAL_A=VAL_A + P_ru_m(i,k,j)*B_ru_m(i,k,j) &
7702 +P_rv_m(i,k,j)*B_rv_m(i,k,j) &
7703 +P_ww_m(i,k,j)*B_ww_m(i,k,j)
7704 enddo
7705 enddo
7706 enddo
7707
7708 print*, ' '
7709 write(6,fmt='(A,2E22.13)') 'a_sumflux: ', VAL_L,VAL_A
7710
7711 ! RECOVER
7712
7713 do i=ims,ime
7714 do k=kms,kme
7715 do j=jms,jme
7716 ru(i,k,j)=S_ru(i,k,j)
7717 rv(i,k,j)=S_rv(i,k,j)
7718 ww(i,k,j)=S_ww(i,k,j)
7719 u_lin(i,k,j)=S_u_lin(i,k,j)
7720 v_lin(i,k,j)=S_v_lin(i,k,j)
7721 ww_lin(i,k,j)=S_ww_lin(i,k,j)
7722 enddo
7723 enddo
7724 enddo
7725 do i=ims,ime
7726 do j=jms,jme
7727 muu(i,j)=S_muu(i,j)
7728 muv(i,j)=S_muv(i,j)
7729 enddo
7730 enddo
7731 do i=ims,ime
7732 do k=kms,kme
7733 do j=jms,jme
7734 ru_m(i,k,j)=S_ru_m(i,k,j)
7735 rv_m(i,k,j)=S_rv_m(i,k,j)
7736 ww_m(i,k,j)=S_ww_m(i,k,j)
7737 enddo
7738 enddo
7739 enddo
7740
7741 !g_sumflux: ALPHA=.1000E+00 COEF= 0.1102335453033E+01 VAL_N= 0.150645E+17 VAL_L= 0.136659E+17
7742 !g_sumflux: ALPHA=.1000E-01 COEF= 0.1010020852089E+01 VAL_N= 0.138029E+15 VAL_L= 0.136659E+15
7743 !g_sumflux: ALPHA=.1000E-02 COEF= 0.1001844882965E+01 VAL_N= 0.136912E+13 VAL_L= 0.136659E+13
7744 !g_sumflux: ALPHA=.1000E-03 COEF= 0.1002220749855E+01 VAL_N= 0.136963E+11 VAL_L= 0.136659E+11
7745 !g_sumflux: ALPHA=.1000E-04 COEF= 0.1009521842003E+01 VAL_N= 0.137961E+09 VAL_L= 0.136659E+09
7746 !g_sumflux: ALPHA=.1000E-05 COEF= 0.9413729906082E+00 VAL_N= 0.128648E+07 VAL_L= 0.136659E+07
7747 !g_sumflux: ALPHA=.1000E-06 COEF= 0.1890421867371E+01 VAL_N= 0.258344E+05 VAL_L= 0.136659E+05
7748 !g_sumflux: ALPHA=.1000E-07 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.136659E+03
7749 !g_sumflux: ALPHA=.1000E-08 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.136659E+01
7750 !g_sumflux: ALPHA=.1000E-09 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.136659E-01
7751 !g_sumflux: ALPHA=.1000E-10 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.136659E-03
7752
7753 !a_sumflux: 0.1368172140062E+17 0.1367992825178E+17
7754
7755 !g_sumflux: ALPHA=.1000E+00 COEF= 0.1102499259156E+01 VAL_N= 0.150786E+17 VAL_L= 0.136768E+17
7756 !g_sumflux: ALPHA=.1000E-01 COEF= 0.1010024927542E+01 VAL_N= 0.138139E+15 VAL_L= 0.136768E+15
7757 !g_sumflux: ALPHA=.1000E-02 COEF= 0.1001000242770E+01 VAL_N= 0.136905E+13 VAL_L= 0.136768E+13
7758 !g_sumflux: ALPHA=.1000E-03 COEF= 0.1000100001778E+01 VAL_N= 0.136782E+11 VAL_L= 0.136768E+11
7759 !g_sumflux: ALPHA=.1000E-04 COEF= 0.1000009999971E+01 VAL_N= 0.136769E+09 VAL_L= 0.136768E+09
7760 !g_sumflux: ALPHA=.1000E-05 COEF= 0.1000000999870E+01 VAL_N= 0.136768E+07 VAL_L= 0.136768E+07
7761 !g_sumflux: ALPHA=.1000E-06 COEF= 0.1000000101149E+01 VAL_N= 0.136768E+05 VAL_L= 0.136768E+05
7762 !g_sumflux: ALPHA=.1000E-07 COEF= 0.1000000009549E+01 VAL_N= 0.136768E+03 VAL_L= 0.136768E+03
7763 !g_sumflux: ALPHA=.1000E-08 COEF= 0.1000000163077E+01 VAL_N= 0.136768E+01 VAL_L= 0.136768E+01
7764 !g_sumflux: ALPHA=.1000E-09 COEF= 0.1000000280416E+01 VAL_N= 0.136768E-01 VAL_L= 0.136768E-01
7765 !g_sumflux: ALPHA=.1000E-10 COEF= 0.1000000491168E+01 VAL_N= 0.136768E-03 VAL_L= 0.136768E-03
7766
7767 !a_sumflux: 0.1367678888613E+17 0.1367678888613E+17
7768
7769 END SUBROUTINE t_sumflux
7770 !-----------------------------------------------------------------------------------------------
7771
7772 SUBROUTINE t_advance_w( w, rw_tend, ww, u, v, &
7773 mu1, mut, muave, muts, &
7774 t_2ave, t_2, t_1, &
7775 ph, ph_1, phb, ph_tend, &
7776 ht, c2a, cqw, alt, alb, &
7777 a, alpha, gamma, &
7778 rdx, rdy, dts, t0, epssm, &
7779 dnw, fnm, fnp, rdnw, rdn, &
7780 cf1, cf2, cf3, msft, &
7781 config_flags, &
7782 ids,ide, jds,jde, kds,kde, & ! domain dims
7783 ims,ime, jms,jme, kms,kme, & ! memory dims
7784 its,ite, jts,jte, kts,kte ) ! tile dims
7785
7786 IMPLICIT NONE ! religion first
7787
7788 ! stuff coming in
7789
7790
7791 TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
7792
7793 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
7794 INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
7795 INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
7796
7797 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), &
7798 INTENT(INOUT) :: &
7799 t_2ave, &
7800 w, &
7801 ph
7802
7803
7804 REAL, DIMENSION( ims:ime , kms:kme, jms:jme ), &
7805 INTENT(IN ) :: &
7806 phb, &
7807 alb
7808 REAL, DIMENSION( ims:ime , kms:kme, jms:jme ) :: &
7809 rw_tend, &
7810 ww, &
7811 u, &
7812 v, &
7813 t_2, &
7814 t_1, &
7815 ph_1, &
7816 ph_tend, &
7817 alpha, &
7818 gamma, &
7819 a, &
7820 c2a, &
7821 cqw, &
7822 alt
7823
7824 REAL, DIMENSION( ims:ime , jms:jme ), &
7825 INTENT(IN ) :: &
7826 ht, &
7827 msft
7828 REAL, DIMENSION( ims:ime , jms:jme ) :: &
7829 mu1, &
7830 mut, &
7831 muave, &
7832 muts
7833
7834 REAL, DIMENSION( kms:kme ), INTENT(IN ) :: fnp, &
7835 fnm, &
7836 rdnw, &
7837 rdn, &
7838 dnw
7839
7840 REAL, INTENT(IN ) :: rdx, &
7841 rdy, &
7842 dts, &
7843 cf1, &
7844 cf2, &
7845 cf3, &
7846 t0, &
7847 epssm
7848
7849 ! Stack based 3d data, tile size.
7850
7851 REAL, DIMENSION( its:ite ) :: mut_inv, msft_inv
7852 REAL, DIMENSION( its:ite, kts:kte ) :: rhs, wdwn
7853 INTEGER :: i,j,k, i_start, i_end, j_start, j_end, k_start, k_end
7854
7855 ! zzma: new definition
7856
7857 ! IN variables
7858
7859 REAL, DIMENSION( ims:ime , kms:kme, jms:jme ) :: &
7860 S_rw_tend, &
7861 S_ww, &
7862 S_u, &
7863 S_v, &
7864 S_t_2, &
7865 S_t_1, &
7866 S_ph_1, &
7867 S_ph_tend, &
7868 S_alpha, &
7869 S_gamma, &
7870 S_a, &
7871 S_c2a, &
7872 S_cqw, &
7873 S_alt
7874 REAL, DIMENSION( ims:ime , kms:kme, jms:jme ) :: &
7875 P_rw_tend, &
7876 P_ww, &
7877 P_u, &
7878 P_v, &
7879 P_t_2, &
7880 P_t_1, &
7881 P_ph_1, &
7882 P_ph_tend, &
7883 P_alpha, &
7884 P_gamma, &
7885 P_a, &
7886 P_c2a, &
7887 P_cqw, &
7888 P_alt
7889 REAL, DIMENSION( ims:ime , kms:kme, jms:jme ) :: &
7890 B_rw_tend, &
7891 B_ww, &
7892 B_u, &
7893 B_v, &
7894 B_t_2, &
7895 B_t_1, &
7896 B_ph_1, &
7897 B_ph_tend, &
7898 B_alpha, &
7899 B_gamma, &
7900 B_a, &
7901 B_c2a, &
7902 B_cqw, &
7903 B_alt
7904
7905 REAL, DIMENSION( ims:ime , jms:jme ) :: S_mu1, S_mut, S_muave,S_muts,P_mu1, P_mut, P_muave,P_muts, &
7906 B_mu1, B_mut, B_muave,B_muts
7907
7908 ! INOUT variables
7909
7910 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) :: S_t_2ave, S_w, S_ph,P_t_2ave, P_w, P_ph
7911 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) :: K_t_2ave, K_w, K_ph,B_t_2ave, B_w, B_ph
7912
7913
7914
7915 REAL :: SAVE_L, COEF, ALPHA_M, FACTOR, VAL_N, VAL_L, VAL_A
7916 INTEGER :: NT
7917
7918 ! zzma: new definition end
7919
7920 !TGL test
7921
7922 do i=ims,ime
7923 do k=kms,kme
7924 do j=jms,jme
7925 S_rw_tend(i,k,j)=rw_tend(i,k,j)
7926 S_ww(i,k,j)=ww(i,k,j)
7927 S_u(i,k,j)=u(i,k,j)
7928 S_v(i,k,j)=v(i,k,j)
7929 S_t_1(i,k,j)=t_1(i,k,j)
7930 S_t_2(i,k,j)=t_2(i,k,j)
7931 S_ph_1(i,k,j)=ph_1(i,k,j)
7932 S_ph_tend(i,k,j)=ph_tend(i,k,j)
7933 S_alpha(i,k,j)=alpha(i,k,j)
7934 S_gamma(i,k,j)=gamma(i,k,j)
7935 S_a(i,k,j)=a(i,k,j)
7936 S_c2a(i,k,j)=c2a(i,k,j)
7937 S_cqw(i,k,j)=cqw(i,k,j)
7938 S_alt(i,k,j)=alt(i,k,j)
7939
7940 P_rw_tend(i,k,j)=rw_tend(i,k,j)
7941 P_ww(i,k,j)=ww(i,k,j)
7942 P_u(i,k,j)=u(i,k,j)
7943 P_v(i,k,j)=v(i,k,j)
7944 P_t_1(i,k,j)=t_1(i,k,j)
7945 P_t_2(i,k,j)=t_2(i,k,j)
7946 P_ph_1(i,k,j)=ph_1(i,k,j)
7947 P_ph_tend(i,k,j)=ph_tend(i,k,j)
7948 P_alpha(i,k,j)=alpha(i,k,j)
7949 P_gamma(i,k,j)=gamma(i,k,j)
7950 P_a(i,k,j)=a(i,k,j)
7951 P_c2a(i,k,j)=c2a(i,k,j)
7952 P_cqw(i,k,j)=cqw(i,k,j)
7953 P_alt(i,k,j)=alt(i,k,j)
7954 enddo
7955 enddo
7956 enddo
7957 do i=ims,ime
7958 do j=jms,jme
7959 S_mu1(i,j)=mu1(i,j)
7960 S_mut(i,j)=mut(i,j)
7961 S_muave(i,j)=muave(i,j)
7962 S_muts(i,j)=muts(i,j)
7963
7964 P_mu1(i,j)=mu1(i,j)
7965 P_mut(i,j)=mut(i,j)
7966 P_muave(i,j)=muave(i,j)
7967 P_muts(i,j)=muts(i,j)
7968 enddo
7969 enddo
7970 do i=ims,ime
7971 do k=kms,kme
7972 do j=jms,jme
7973 S_t_2ave(i,k,j)=t_2ave(i,k,j)
7974 S_w(i,k,j)=w(i,k,j)
7975 S_ph(i,k,j)=ph(i,k,j)
7976
7977 P_t_2ave(i,k,j)=t_2ave(i,k,j)
7978 P_w(i,k,j)=w(i,k,j)
7979 P_ph(i,k,j)=ph(i,k,j)
7980
7981 K_t_2ave(i,k,j)=t_2ave(i,k,j)
7982 K_w(i,k,j)=w(i,k,j)
7983 K_ph(i,k,j)=ph(i,k,j)
7984 enddo
7985 enddo
7986 enddo
7987
7988 !NLM
7989
7990 CALL advance_w( w, rw_tend, ww, u, v, &
7991 mu1, mut, muave, muts, &
7992 t_2ave, t_2, t_1, &
7993 ph, ph_1, phb, ph_tend, &
7994 ht, c2a, cqw, alt, alb, &
7995 a, alpha, gamma, &
7996 rdx, rdy, dts, t0, epssm, &
7997 dnw, fnm, fnp, rdnw, rdn, &
7998 cf1, cf2, cf3, msft, &
7999 config_flags, &
8000 ids,ide, jds,jde, kds,kde, & ! domain dims
8001 ims,ime, jms,jme, kms,kme, & ! memory dims
8002 its,ite, jts,jte, kts,kte ) ! tile dims
8003
8004
8005 do i=ims,ime
8006 do k=kms,kme
8007 do j=jms,jme
8008 B_t_2ave(i,k,j)=t_2ave(i,k,j)
8009 B_w(i,k,j)=w(i,k,j)
8010 B_ph(i,k,j)=ph(i,k,j)
8011 enddo
8012 enddo
8013 enddo
8014
8015 ! TCL
8016
8017 CALL g_advance_w( K_w, P_w, rw_tend, P_rw_tend, ww, P_ww, u, P_u, v, P_v, mu1, P_mu1, mut, P_mut, muave, P_muave, muts, P_muts,&
8018 & K_t_2ave, P_t_2ave, t_2, P_t_2, t_1, P_t_1, K_ph, P_ph, ph_1, P_ph_1, phb, ph_tend, P_ph_tend, ht, c2a, P_c2a, cqw, P_cqw, alt, &
8019 &P_alt, alb, a, P_a, alpha, P_alpha, gamma, P_gamma, rdx, rdy, dts, t0, epssm, fnm, fnp, rdnw, rdn, cf1, cf2, cf3, msft, &
8020 &config_flags, ids, ide, jds, jde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
8021
8022 SAVE_L=0.
8023 do i=ims,ime
8024 do k=kms,kme
8025 do j=jms,jme
8026 SAVE_L=SAVE_L +P_t_2ave(i,k,j)*P_t_2ave(i,k,j) &
8027 +P_w(i,k,j)*P_w(i,k,j) &
8028 +P_ph(i,k,j)*P_ph(i,k,j)
8029 enddo
8030 enddo
8031 enddo
8032
8033 ALPHA_M=1.
8034 DO NT=1,11
8035 ALPHA_M=0.1*ALPHA_M
8036 FACTOR=1.+ALPHA_M
8037 do i=ims,ime
8038 do k=kms,kme
8039 do j=jms,jme
8040 P_rw_tend(i,k,j)=FACTOR*S_rw_tend(i,k,j)
8041 P_ww(i,k,j)=FACTOR*S_ww(i,k,j)
8042 P_u(i,k,j)=FACTOR*S_u(i,k,j)
8043 P_v(i,k,j)=FACTOR*S_v(i,k,j)
8044 P_t_1(i,k,j)=FACTOR*S_t_1(i,k,j)
8045 P_t_2(i,k,j)=FACTOR*S_t_2(i,k,j)
8046 P_ph_1(i,k,j)=FACTOR*S_ph_1(i,k,j)
8047 P_ph_tend(i,k,j)=FACTOR*S_ph_tend(i,k,j)
8048 P_alpha(i,k,j)=FACTOR*S_alpha(i,k,j)
8049 P_gamma(i,k,j)=FACTOR*S_gamma(i,k,j)
8050 P_a(i,k,j)=FACTOR*S_a(i,k,j)
8051 P_c2a(i,k,j)=FACTOR*S_c2a(i,k,j)
8052 P_cqw(i,k,j)=FACTOR*S_cqw(i,k,j)
8053 P_alt(i,k,j)=FACTOR*S_alt(i,k,j)
8054 enddo
8055 enddo
8056 enddo
8057 do i=ims,ime
8058 do j=jms,jme
8059 P_mu1(i,j)=FACTOR*S_mu1(i,j)
8060 P_mut(i,j)=FACTOR*S_mut(i,j)
8061 P_muave(i,j)=FACTOR*S_muave(i,j)
8062 P_muts(i,j)=FACTOR*S_muts(i,j)
8063 enddo
8064 enddo
8065 do i=ims,ime
8066 do k=kms,kme
8067 do j=jms,jme
8068 P_t_2ave(i,k,j)=FACTOR*S_t_2ave(i,k,j)
8069 P_w(i,k,j)=FACTOR*S_w(i,k,j)
8070 P_ph(i,k,j)=FACTOR*S_ph(i,k,j)
8071 enddo
8072 enddo
8073 enddo
8074
8075 CALL advance_w( P_w, P_rw_tend, P_ww, P_u, P_v, &
8076 P_mu1, P_mut, P_muave, P_muts, &
8077 P_t_2ave, P_t_2, P_t_1, &
8078 P_ph, P_ph_1, phb, P_ph_tend, &
8079 ht, P_c2a, P_cqw, P_alt, alb, &
8080 P_a, P_alpha, P_gamma, &
8081 rdx, rdy, dts, t0, epssm, &
8082 dnw, fnm, fnp, rdnw, rdn, &
8083 cf1, cf2, cf3, msft, &
8084 config_flags, &
8085 ids,ide, jds,jde, kds,kde, & ! domain dims
8086 ims,ime, jms,jme, kms,kme, & ! memory dims
8087 its,ite, jts,jte, kts,kte ) ! tile dims
8088
8089 VAL_N=0.
8090 do i=ims,ime
8091 do k=kms,kme
8092 do j=jms,jme
8093 VAL_N=VAL_N+(P_t_2ave(i,k,j)-B_t_2ave(i,k,j))*(P_t_2ave(i,k,j)-B_t_2ave(i,k,j)) &
8094 +(P_w(i,k,j)-B_w(i,k,j))*(P_w(i,k,j)-B_w(i,k,j)) &
8095 +(P_ph(i,k,j)-B_ph(i,k,j))*(P_ph(i,k,j)-B_ph(i,k,j))
8096 enddo
8097 enddo
8098 enddo
8099
8100 VAL_L=SAVE_L*ALPHA_M**2
8101 COEF=VAL_N/VAL_L
8102 WRITE(6, fmt='(A,E9.4,A,E22.13,A,E13.6,A,E13.6)') &
8103 'g_advance_w: ALPHA=',ALPHA_M,' COEF=',COEF, &
8104 ' VAL_N=',VAL_N,' VAL_L=',VAL_L
8105 ENDDO
8106
8107 ! ADJ test
8108
8109 FACTOR=0.1
8110 do i=ims,ime
8111 do k=kms,kme
8112 do j=jms,jme
8113 rw_tend(i,k,j)=S_rw_tend(i,k,j)
8114 ww(i,k,j)=S_ww(i,k,j)
8115 u(i,k,j)=S_u(i,k,j)
8116 v(i,k,j)=S_v(i,k,j)
8117 t_1(i,k,j)=S_t_1(i,k,j)
8118 t_2(i,k,j)=S_t_2(i,k,j)
8119 ph_1(i,k,j)=S_ph_1(i,k,j)
8120 ph_tend(i,k,j)=S_ph_tend(i,k,j)
8121 alpha(i,k,j)=S_alpha(i,k,j)
8122 gamma(i,k,j)=S_gamma(i,k,j)
8123 a(i,k,j)=S_a(i,k,j)
8124 c2a(i,k,j)=S_c2a(i,k,j)
8125 cqw(i,k,j)=S_cqw(i,k,j)
8126 alt(i,k,j)=S_alt(i,k,j)
8127
8128 P_rw_tend(i,k,j)=FACTOR*S_rw_tend(i,k,j)
8129 P_ww(i,k,j)=FACTOR*S_ww(i,k,j)
8130 P_u(i,k,j)=FACTOR*S_u(i,k,j)
8131 P_v(i,k,j)=FACTOR*S_v(i,k,j)
8132 P_t_1(i,k,j)=FACTOR*S_t_1(i,k,j)
8133 P_t_2(i,k,j)=FACTOR*S_t_2(i,k,j)
8134 P_ph_1(i,k,j)=FACTOR*S_ph_1(i,k,j)
8135 P_ph_tend(i,k,j)=FACTOR*S_ph_tend(i,k,j)
8136 P_alpha(i,k,j)=FACTOR*S_alpha(i,k,j)
8137 P_gamma(i,k,j)=FACTOR*S_gamma(i,k,j)
8138 P_a(i,k,j)=FACTOR*S_a(i,k,j)
8139 P_c2a(i,k,j)=FACTOR*S_c2a(i,k,j)
8140 P_cqw(i,k,j)=FACTOR*S_cqw(i,k,j)
8141 P_alt(i,k,j)=FACTOR*S_alt(i,k,j)
8142
8143 B_rw_tend(i,k,j)=P_rw_tend(i,k,j)
8144 B_ww(i,k,j)=P_ww(i,k,j)
8145 B_u(i,k,j)=P_u(i,k,j)
8146 B_v(i,k,j)=P_v(i,k,j)
8147 B_t_1(i,k,j)=P_t_1(i,k,j)
8148 B_t_2(i,k,j)=P_t_2(i,k,j)
8149 B_ph_1(i,k,j)=P_ph_1(i,k,j)
8150 B_ph_tend(i,k,j)=P_ph_tend(i,k,j)
8151 B_alpha(i,k,j)=P_alpha(i,k,j)
8152 B_gamma(i,k,j)=P_gamma(i,k,j)
8153 B_a(i,k,j)=P_a(i,k,j)
8154 B_c2a(i,k,j)=P_c2a(i,k,j)
8155 B_cqw(i,k,j)=P_cqw(i,k,j)
8156 B_alt(i,k,j)=P_alt(i,k,j)
8157 enddo
8158 enddo
8159 enddo
8160 do i=ims,ime
8161 do j=jms,jme
8162 mu1(i,j)=S_mu1(i,j)
8163 mut(i,j)=S_mut(i,j)
8164 muave(i,j)=S_muave(i,j)
8165 muts(i,j)=S_muts(i,j)
8166
8167 P_mu1(i,j)=FACTOR*S_mu1(i,j)
8168 P_mut(i,j)=FACTOR*S_mut(i,j)
8169 P_muave(i,j)=FACTOR*S_muave(i,j)
8170 P_muts(i,j)=FACTOR*S_muts(i,j)
8171
8172 B_mu1(i,j)=P_mu1(i,j)
8173 B_mut(i,j)=P_mut(i,j)
8174 B_muave(i,j)=P_muave(i,j)
8175 B_muts(i,j)=P_muts(i,j)
8176 enddo
8177 enddo
8178 do i=ims,ime
8179 do k=kms,kme
8180 do j=jms,jme
8181 t_2ave(i,k,j)=S_t_2ave(i,k,j)
8182 w(i,k,j)=S_w(i,k,j)
8183 ph(i,k,j)=S_ph(i,k,j)
8184
8185 P_t_2ave(i,k,j)=FACTOR*S_t_2ave(i,k,j)
8186 P_w(i,k,j)=FACTOR*S_w(i,k,j)
8187 P_ph(i,k,j)=FACTOR*S_ph(i,k,j)
8188
8189 B_t_2ave(i,k,j)=P_t_2ave(i,k,j)
8190 B_w(i,k,j)=P_w(i,k,j)
8191 B_ph(i,k,j)=P_ph(i,k,j)
8192
8193 K_t_2ave(i,k,j)=t_2ave(i,k,j)
8194 K_w(i,k,j)=w(i,k,j)
8195 K_ph(i,k,j)=ph(i,k,j)
8196 enddo
8197 enddo
8198 enddo
8199
8200
8201 ! TGL
8202
8203 CALL g_advance_w( w, P_w, rw_tend, P_rw_tend, ww, P_ww, u, P_u, v, P_v, mu1, P_mu1, mut, P_mut, muave, P_muave, muts, P_muts,&
8204 & t_2ave, P_t_2ave, t_2, P_t_2, t_1, P_t_1, ph, P_ph, ph_1, P_ph_1, phb, ph_tend, P_ph_tend, ht, c2a, P_c2a, cqw, P_cqw, alt, &
8205 &P_alt, alb, a, P_a, alpha, P_alpha, gamma, P_gamma, rdx, rdy, dts, t0, epssm, fnm, fnp, rdnw, rdn, cf1, cf2, cf3, msft, &
8206 &config_flags, ids, ide, jds, jde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
8207
8208 VAL_L=0.
8209 do i=ims,ime
8210 do k=kms,kme
8211 do j=jms,jme
8212 VAL_L=VAL_L + P_t_2ave(i,k,j)*P_t_2ave(i,k,j) &
8213 + P_w(i,k,j)*P_w(i,k,j) &
8214 + P_ph(i,k,j)*P_ph(i,k,j)
8215 enddo
8216 enddo
8217 enddo
8218 do i=ims,ime
8219 do k=kms,kme
8220 do j=jms,jme
8221 P_rw_tend(i,k,j)=0.0
8222 P_ww(i,k,j)=0.0
8223 P_u(i,k,j)=0.0
8224 P_v(i,k,j)=0.0
8225 P_t_1(i,k,j)=0.0
8226 P_t_2(i,k,j)=0.0
8227 P_ph_1(i,k,j)=0.0
8228 P_ph_tend(i,k,j)=0.0
8229 P_alpha(i,k,j)=0.0
8230 P_gamma(i,k,j)=0.0
8231 P_a(i,k,j)=0.0
8232 P_c2a(i,k,j)=0.0
8233 P_cqw(i,k,j)=0.0
8234 P_alt(i,k,j)=0.0
8235 enddo
8236 enddo
8237 enddo
8238 do i=ims,ime
8239 do j=jms,jme
8240 P_mu1(i,j)=0.0
8241 P_mut(i,j)=0.0
8242 P_muave(i,j)=0.0
8243 P_muts(i,j)=0.0
8244 enddo
8245 enddo
8246
8247 ! ADJ
8248
8249 CALL a_advance_w( K_w, P_w, rw_tend, P_rw_tend, ww, P_ww, u, P_u, v, P_v, mu1, P_mu1, mut, P_mut, muave, P_muave, muts, P_muts,&
8250 & K_t_2ave, P_t_2ave, t_2, P_t_2, t_1, P_t_1, K_ph, P_ph, ph_1, P_ph_1, phb, ph_tend, P_ph_tend, ht, c2a, P_c2a, cqw, P_cqw, alt, &
8251 &P_alt, alb, a, P_a, alpha, P_alpha, gamma, P_gamma, rdx, rdy, dts, t0, epssm, fnm, fnp, rdnw, rdn, cf1, cf2, cf3, msft, &
8252 &config_flags, ids, ide, jds, jde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
8253
8254 VAL_A=0.
8255 do i=ims,ime
8256 do k=kms,kme
8257 do j=jms,jme
8258 VAL_A=VAL_A + P_rw_tend(i,k,j)*B_rw_tend(i,k,j) &
8259 + P_ww(i,k,j)*B_ww(i,k,j) &
8260 + P_u(i,k,j)*B_u(i,k,j) &
8261 + P_v(i,k,j)*B_v(i,k,j) &
8262 + P_t_1(i,k,j)*B_t_1(i,k,j) &
8263 + P_t_2(i,k,j)*B_t_2(i,k,j) &
8264 + P_ph_1(i,k,j)*B_ph_1(i,k,j) &
8265 + P_ph_tend(i,k,j)*B_ph_tend(i,k,j) &
8266 + P_alpha(i,k,j)*B_alpha(i,k,j) &
8267 + P_gamma(i,k,j)*B_gamma(i,k,j) &
8268 + P_a(i,k,j)*B_a(i,k,j) &
8269 + P_c2a(i,k,j)*B_c2a(i,k,j) &
8270 + P_cqw(i,k,j)*B_cqw(i,k,j) &
8271 + P_alt(i,k,j)*B_alt(i,k,j)
8272 enddo
8273 enddo
8274 enddo
8275 do i=ims,ime
8276 do j=jms,jme
8277 VAL_A=VAL_A + P_mu1(i,j)*B_mu1(i,j) &
8278 + P_mut(i,j)*B_mut(i,j) &
8279 + P_muave(i,j)*B_muave(i,j) &
8280 + P_muts(i,j)*B_muts(i,j)
8281 enddo
8282 enddo
8283 do i=ims,ime
8284 do k=kms,kme
8285 do j=jms,jme
8286 VAL_A=VAL_A + P_t_2ave(i,k,j)*B_t_2ave(i,k,j) &
8287 + P_w(i,k,j)*B_w(i,k,j) &
8288 + P_ph(i,k,j)*B_ph(i,k,j)
8289 enddo
8290 enddo
8291 enddo
8292
8293 print*, ' '
8294 write(6,fmt='(A,2E22.13)') 'a_advance_w: ', VAL_L,VAL_A
8295
8296 ! RECOVER
8297
8298 do i=ims,ime
8299 do k=kms,kme
8300 do j=jms,jme
8301 rw_tend(i,k,j)=S_rw_tend(i,k,j)
8302 ww(i,k,j)=S_ww(i,k,j)
8303 u(i,k,j)=S_u(i,k,j)
8304 v(i,k,j)=S_v(i,k,j)
8305 t_1(i,k,j)=S_t_1(i,k,j)
8306 t_2(i,k,j)=S_t_2(i,k,j)
8307 ph_1(i,k,j)=S_ph_1(i,k,j)
8308 ph_tend(i,k,j)=S_ph_tend(i,k,j)
8309 alpha(i,k,j)=S_alpha(i,k,j)
8310 gamma(i,k,j)=S_gamma(i,k,j)
8311 a(i,k,j)=S_a(i,k,j)
8312 c2a(i,k,j)=S_c2a(i,k,j)
8313 cqw(i,k,j)=S_cqw(i,k,j)
8314 alt(i,k,j)=S_alt(i,k,j)
8315 enddo
8316 enddo
8317 enddo
8318 do i=ims,ime
8319 do j=jms,jme
8320 mu1(i,j)=S_mu1(i,j)
8321 mut(i,j)=S_mut(i,j)
8322 muave(i,j)=S_muave(i,j)
8323 muts(i,j)=S_muts(i,j)
8324 enddo
8325 enddo
8326 do i=ims,ime
8327 do k=kms,kme
8328 do j=jms,jme
8329 t_2ave(i,k,j)=S_t_2ave(i,k,j)
8330 w(i,k,j)=S_w(i,k,j)
8331 ph(i,k,j)=S_ph(i,k,j)
8332 enddo
8333 enddo
8334 enddo
8335
8336 !g_advance_w: ALPHA=.1000E+00 COEF= 0.4203023437500E+05 VAL_N= 0.447786E+18 VAL_L= 0.106539E+14
8337 !g_advance_w: ALPHA=.1000E-01 COEF= 0.8862628340721E+00 VAL_N= 0.944215E+11 VAL_L= 0.106539E+12
8338 !g_advance_w: ALPHA=.1000E-02 COEF= 0.9950740337372E+00 VAL_N= 0.106014E+10 VAL_L= 0.106539E+10
8339 !g_advance_w: ALPHA=.1000E-03 COEF= 0.1000316143036E+01 VAL_N= 0.106573E+08 VAL_L= 0.106539E+08
8340 !g_advance_w: ALPHA=.1000E-04 COEF= 0.1005530953407E+01 VAL_N= 0.107128E+06 VAL_L= 0.106539E+06
8341 !g_advance_w: ALPHA=.1000E-05 COEF= 0.9066505432129E+00 VAL_N= 0.965936E+03 VAL_L= 0.106539E+04
8342 !g_advance_w: ALPHA=.1000E-06 COEF= 0.1328220486641E+01 VAL_N= 0.141507E+02 VAL_L= 0.106539E+02
8343 !g_advance_w: ALPHA=.1000E-07 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.106539E+00
8344 !g_advance_w: ALPHA=.1000E-08 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.106539E-02
8345 !g_advance_w: ALPHA=.1000E-09 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.106539E-04
8346 !g_advance_w: ALPHA=.1000E-10 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.106539E-06
8347
8348 !a_advance_w: 0.1065481876275E+14 0.2132781144474E+14
8349
8350 !g_advance_w: ALPHA=.1000E+00 COEF= 0.4202960279442E+05 VAL_N= 0.447787E+18 VAL_L= 0.106541E+14
8351 !g_advance_w: ALPHA=.1000E-01 COEF= 0.8863898444207E+00 VAL_N= 0.944368E+11 VAL_L= 0.106541E+12
8352 !g_advance_w: ALPHA=.1000E-02 COEF= 0.9950242040299E+00 VAL_N= 0.106011E+10 VAL_L= 0.106541E+10
8353 !g_advance_w: ALPHA=.1000E-03 COEF= 0.9995589489485E+00 VAL_N= 0.106494E+08 VAL_L= 0.106541E+08
8354 !g_advance_w: ALPHA=.1000E-04 COEF= 0.9999564508007E+00 VAL_N= 0.106536E+06 VAL_L= 0.106541E+06
8355 !g_advance_w: ALPHA=.1000E-05 COEF= 0.9999956504520E+00 VAL_N= 0.106540E+04 VAL_L= 0.106541E+04
8356 !g_advance_w: ALPHA=.1000E-06 COEF= 0.9999995659454E+00 VAL_N= 0.106541E+02 VAL_L= 0.106541E+02
8357 !g_advance_w: ALPHA=.1000E-07 COEF= 0.9999999434296E+00 VAL_N= 0.106541E+00 VAL_L= 0.106541E+00
8358 !g_advance_w: ALPHA=.1000E-08 COEF= 0.1000000115664E+01 VAL_N= 0.106541E-02 VAL_L= 0.106541E-02
8359 !g_advance_w: ALPHA=.1000E-09 COEF= 0.1000000381680E+01 VAL_N= 0.106541E-04 VAL_L= 0.106541E-04
8360 !g_advance_w: ALPHA=.1000E-10 COEF= 0.1000001224183E+01 VAL_N= 0.106541E-06 VAL_L= 0.106541E-06
8361
8362 !a_advance_w: 0.1065409474212E+14 0.2136289875657E+14
8363
8364 END SUBROUTINE t_advance_w
8365 !-----------------------------------------------------------------------------------------------
8366
8367 SUBROUTINE t_spec_bdyupdate_ph( ph_save, field, &
8368 field_tend, mu_tend, muts, dt, &
8369 variable_in, config_flags, &
8370 spec_zone, &
8371 ids,ide, jds,jde, kds,kde, & ! domain dims
8372 ims,ime, jms,jme, kms,kme, & ! memory dims
8373 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
8374 its,ite, jts,jte, kts,kte )
8375
8376 ! Zaizhong Ma, April 1,2005
8377
8378 IMPLICIT NONE
8379
8380 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
8381 INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
8382 INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe
8383 INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
8384 INTEGER, INTENT(IN ) :: spec_zone
8385 CHARACTER, INTENT(IN ) :: variable_in
8386 REAL, INTENT(IN ) :: dt
8387
8388
8389 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: field
8390 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) :: field_tend, ph_save
8391 REAL, DIMENSION( ims:ime , jms:jme ) :: mu_tend, muts
8392 TYPE( grid_config_rec_type ) config_flags
8393
8394 CHARACTER :: variable
8395 INTEGER :: i, j, k, ibs, ibe, jbs, jbe, itf, jtf, ktf
8396 INTEGER :: b_dist
8397
8398 ! Local array
8399
8400 REAL, DIMENSION( its:ite , jts:jte ) :: mu_old
8401
8402 ! zzma: new definition
8403
8404 ! IN variables
8405
8406 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) :: S_field_tend, S_ph_save,P_field_tend, P_ph_save,B_field_tend, B_ph_save
8407 REAL, DIMENSION( ims:ime , jms:jme ) :: S_mu_tend, S_muts,P_mu_tend, P_muts,B_mu_tend, B_muts
8408
8409 ! INOUT variables
8410
8411 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) :: S_field,P_field,B_field,K_field
8412
8413 REAL :: SAVE_L, COEF, ALPHA, FACTOR, VAL_N, VAL_L, VAL_A
8414 INTEGER :: NT
8415
8416 ! zzma: new definition end
8417
8418 !TGL test
8419
8420 do i=ims,ime
8421 do k=kms,kme
8422 do j=jms,jme
8423 S_field_tend(i,k,j)=field_tend(i,k,j)
8424 S_ph_save(i,k,j)=ph_save(i,k,j)
8425
8426 P_field_tend(i,k,j)=field_tend(i,k,j)
8427 P_ph_save(i,k,j)=ph_save(i,k,j)
8428 enddo
8429 enddo
8430 enddo
8431 do i=ims,ime
8432 do j=jms,jme
8433 S_mu_tend(i,j)=mu_tend(i,j)
8434 S_muts(i,j)=muts(i,j)
8435
8436 P_mu_tend(i,j)=mu_tend(i,j)
8437 P_muts(i,j)=muts(i,j)
8438 enddo
8439 enddo
8440 do i=ims,ime
8441 do k=kms,kme
8442 do j=jms,jme
8443 S_field(i,k,j)=field(i,k,j)
8444 P_field(i,k,j)=field(i,k,j)
8445 K_field(i,k,j)=field(i,k,j)
8446 enddo
8447 enddo
8448 enddo
8449
8450 !NLM
8451
8452 CALL spec_bdyupdate_ph( ph_save, field, &
8453 field_tend, mu_tend, muts, dt, &
8454 variable_in, config_flags, &
8455 spec_zone, &
8456 ids,ide, jds,jde, kds,kde, & ! domain dims
8457 ims,ime, jms,jme, kms,kme, & ! memory dims
8458 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
8459 its,ite, jts,jte, kts,kte )
8460
8461 do i=ims,ime
8462 do k=kms,kme
8463 do j=jms,jme
8464 B_field(i,k,j)=field(i,k,j)
8465 enddo
8466 enddo
8467 enddo
8468
8469 ! TCL
8470
8471 CALL g_spec_bdyupdate_ph( ph_save, P_ph_save, K_field, P_field, field_tend, P_field_tend, mu_tend, P_mu_tend, muts, P_muts, dt,&
8472 & variable_in, spec_zone, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
8473
8474 SAVE_L=0.
8475 do i=ims,ime
8476 do k=kms,kme
8477 do j=jms,jme
8478 SAVE_L=SAVE_L + P_field(i,k,j)*P_field(i,k,j)
8479 enddo
8480 enddo
8481 enddo
8482
8483 ALPHA=1.
8484 DO NT=1,11
8485 ALPHA=0.1*ALPHA
8486 FACTOR=1.+ALPHA
8487 do i=ims,ime
8488 do k=kms,kme
8489 do j=jms,jme
8490 P_field_tend(i,k,j)=FACTOR*S_field_tend(i,k,j)
8491 P_ph_save(i,k,j)=FACTOR*S_ph_save(i,k,j)
8492 enddo
8493 enddo
8494 enddo
8495 do i=ims,ime
8496 do j=jms,jme
8497 P_mu_tend(i,j)=FACTOR*S_mu_tend(i,j)
8498 P_muts(i,j)=FACTOR*S_muts(i,j)
8499 enddo
8500 enddo
8501 do i=ims,ime
8502 do k=kms,kme
8503 do j=jms,jme
8504 P_field(i,k,j)=FACTOR*S_field(i,k,j)
8505 enddo
8506 enddo
8507 enddo
8508
8509 CALL spec_bdyupdate_ph( P_ph_save, P_field, &
8510 P_field_tend, P_mu_tend, P_muts, dt, &
8511 variable_in, config_flags, &
8512 spec_zone, &
8513 ids,ide, jds,jde, kds,kde, & ! domain dims
8514 ims,ime, jms,jme, kms,kme, & ! memory dims
8515 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
8516 its,ite, jts,jte, kts,kte )
8517
8518 VAL_N=0.
8519 do i=ims,ime
8520 do k=kms,kme
8521 do j=jms,jme
8522 VAL_N=VAL_N+(P_field(i,k,j) -B_field(i,k,j))*(P_field(i,k,j) -B_field(i,k,j))
8523 enddo
8524 enddo
8525 enddo
8526
8527 VAL_L=SAVE_L*ALPHA**2
8528 COEF=VAL_N/VAL_L
8529 WRITE(6, fmt='(A,E9.4,A,E22.13,A,E13.6,A,E13.6)') &
8530 'g_spec_bdyupdate_ph: ALPHA=',ALPHA,' COEF=',COEF, &
8531 ' VAL_N=',VAL_N,' VAL_L=',VAL_L
8532 ENDDO
8533
8534 ! ADJ test
8535
8536 FACTOR=0.1
8537 do i=ims,ime
8538 do k=kms,kme
8539 do j=jms,jme
8540 field_tend(i,k,j)=S_field_tend(i,k,j)
8541 ph_save(i,k,j)=S_ph_save(i,k,j)
8542
8543 P_field_tend(i,k,j)=FACTOR*S_field_tend(i,k,j)
8544 P_ph_save(i,k,j)=FACTOR*S_ph_save(i,k,j)
8545
8546 B_field_tend(i,k,j)=P_field_tend(i,k,j)
8547 B_ph_save(i,k,j)=P_ph_save(i,k,j)
8548 enddo
8549 enddo
8550 enddo
8551 do i=ims,ime
8552 do j=jms,jme
8553 mu_tend(i,j)=S_mu_tend(i,j)
8554 muts(i,j)=S_muts(i,j)
8555
8556 P_mu_tend(i,j)=FACTOR*S_mu_tend(i,j)
8557 P_muts(i,j)=FACTOR*S_muts(i,j)
8558
8559 B_mu_tend(i,j)=P_mu_tend(i,j)
8560 B_muts(i,j)=P_muts(i,j)
8561 enddo
8562 enddo
8563 do i=ims,ime
8564 do k=kms,kme
8565 do j=jms,jme
8566 field(i,k,j)=S_field(i,k,j)
8567 P_field(i,k,j)=FACTOR*S_field(i,k,j)
8568 B_field(i,k,j)=P_field(i,k,j)
8569 K_field(i,k,j)=field(i,k,j)
8570 enddo
8571 enddo
8572 enddo
8573
8574 CALL g_spec_bdyupdate_ph( ph_save, P_ph_save, field, P_field, field_tend, P_field_tend, mu_tend, P_mu_tend, muts, P_muts, dt,&
8575 & variable_in, spec_zone, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
8576
8577 VAL_L=0.
8578 do i=ims,ime
8579 do k=kms,kme
8580 do j=jms,jme
8581 VAL_L=VAL_L + P_field(i,k,j)*P_field(i,k,j)
8582 enddo
8583 enddo
8584 enddo
8585 do i=ims,ime
8586 do k=kms,kme
8587 do j=jms,jme
8588 P_field_tend(i,k,j)=0.0
8589 P_ph_save(i,k,j)=0.0
8590 enddo
8591 enddo
8592 enddo
8593 do i=ims,ime
8594 do j=jms,jme
8595 P_mu_tend(i,j)=0.0
8596 P_muts(i,j)=0.0
8597 enddo
8598 enddo
8599
8600 ! ADJ
8601
8602 CALL a_spec_bdyupdate_ph( ph_save, P_ph_save, K_field, P_field, field_tend, P_field_tend, mu_tend, P_mu_tend, muts, P_muts, dt,&
8603 & variable_in, spec_zone, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
8604
8605 VAL_A=0.
8606 do i=ims,ime
8607 do k=kms,kme
8608 do j=jms,jme
8609 VAL_A=VAL_A + P_field_tend(i,k,j)*B_field_tend(i,k,j) &
8610 + P_ph_save(i,k,j)*B_ph_save(i,k,j)
8611 enddo
8612 enddo
8613 enddo
8614 do i=ims,ime
8615 do j=jms,jme
8616 VAL_A=VAL_A + P_mu_tend(i,j)*B_mu_tend(i,j) &
8617 + P_muts(i,j)*B_muts(i,j)
8618 enddo
8619 enddo
8620 do i=ims,ime
8621 do k=kms,kme
8622 do j=jms,jme
8623 VAL_A=VAL_A + P_field(i,k,j)*B_field(i,k,j)
8624 enddo
8625 enddo
8626 enddo
8627
8628 print*, ' '
8629 write(6,fmt='(A,2E22.13)') 'a_spec_bdyupdate_ph: ', VAL_L,VAL_A
8630
8631 ! RECOVER
8632
8633 do i=ims,ime
8634 do k=kms,kme
8635 do j=jms,jme
8636 field_tend(i,k,j)=S_field_tend(i,k,j)
8637 ph_save(i,k,j)=S_ph_save(i,k,j)
8638 enddo
8639 enddo
8640 enddo
8641 do i=ims,ime
8642 do j=jms,jme
8643 mu_tend(i,j)=S_mu_tend(i,j)
8644 muts(i,j)=S_muts(i,j)
8645 enddo
8646 enddo
8647 do i=ims,ime
8648 do k=kms,kme
8649 do j=jms,jme
8650 field(i,k,j)=S_field(i,k,j)
8651 enddo
8652 enddo
8653 enddo
8654
8655 !g_spec_bdyupdate_ph: ALPHA=.1000E+00 COEF= 0.1000000119209E+01 VAL_N= 0.143960E+07 VAL_L= 0.143960E+07
8656 !g_spec_bdyupdate_ph: ALPHA=.1000E-01 COEF= 0.9999946355820E+00 VAL_N= 0.143960E+05 VAL_L= 0.143960E+05
8657 !g_spec_bdyupdate_ph: ALPHA=.1000E-02 COEF= 0.1000091433525E+01 VAL_N= 0.143973E+03 VAL_L= 0.143960E+03
8658 !g_spec_bdyupdate_ph: ALPHA=.1000E-03 COEF= 0.1000368714333E+01 VAL_N= 0.144013E+01 VAL_L= 0.143960E+01
8659 !g_spec_bdyupdate_ph: ALPHA=.1000E-04 COEF= 0.1002776384354E+01 VAL_N= 0.144360E-01 VAL_L= 0.143960E-01
8660 !g_spec_bdyupdate_ph: ALPHA=.1000E-05 COEF= 0.9063574671745E+00 VAL_N= 0.130480E-03 VAL_L= 0.143960E-03
8661 !g_spec_bdyupdate_ph: ALPHA=.1000E-06 COEF= 0.1363814473152E+01 VAL_N= 0.196335E-05 VAL_L= 0.143960E-05
8662 !g_spec_bdyupdate_ph: ALPHA=.1000E-07 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.143960E-07
8663 !g_spec_bdyupdate_ph: ALPHA=.1000E-08 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.143960E-09
8664 !g_spec_bdyupdate_ph: ALPHA=.1000E-09 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.143960E-11
8665 !g_spec_bdyupdate_ph: ALPHA=.1000E-10 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.143960E-13
8666
8667 !a_spec_bdyupdate_ph: 0.1439602750000E+07 0.1439628875000E+07
8668
8669 !g_spec_bdyupdate_ph: ALPHA=.1000E+00 COEF= 0.1000000000000E+01 VAL_N= 0.143976E+07 VAL_L= 0.143976E+07
8670 !g_spec_bdyupdate_ph: ALPHA=.1000E-01 COEF= 0.1000000000000E+01 VAL_N= 0.143976E+05 VAL_L= 0.143976E+05
8671 !g_spec_bdyupdate_ph: ALPHA=.1000E-02 COEF= 0.9999999999998E+00 VAL_N= 0.143976E+03 VAL_L= 0.143976E+03
8672 !g_spec_bdyupdate_ph: ALPHA=.1000E-03 COEF= 0.9999999999999E+00 VAL_N= 0.143976E+01 VAL_L= 0.143976E+01
8673 !g_spec_bdyupdate_ph: ALPHA=.1000E-04 COEF= 0.1000000000014E+01 VAL_N= 0.143976E-01 VAL_L= 0.143976E-01
8674 !g_spec_bdyupdate_ph: ALPHA=.1000E-05 COEF= 0.9999999998296E+00 VAL_N= 0.143976E-03 VAL_L= 0.143976E-03
8675 !g_spec_bdyupdate_ph: ALPHA=.1000E-06 COEF= 0.1000000001183E+01 VAL_N= 0.143976E-05 VAL_L= 0.143976E-05
8676 !g_spec_bdyupdate_ph: ALPHA=.1000E-07 COEF= 0.9999999881095E+00 VAL_N= 0.143976E-07 VAL_L= 0.143976E-07
8677 !g_spec_bdyupdate_ph: ALPHA=.1000E-08 COEF= 0.1000000163263E+01 VAL_N= 0.143976E-09 VAL_L= 0.143976E-09
8678 !g_spec_bdyupdate_ph: ALPHA=.1000E-09 COEF= 0.1000000083661E+01 VAL_N= 0.143976E-11 VAL_L= 0.143976E-11
8679 !g_spec_bdyupdate_ph: ALPHA=.1000E-10 COEF= 0.9999994281817E+00 VAL_N= 0.143976E-13 VAL_L= 0.143976E-13
8680
8681 !a_spec_bdyupdate_ph: 0.1439763904620E+07 0.1439763904620E+07
8682
8683
8684 END SUBROUTINE t_spec_bdyupdate_ph
8685 !-----------------------------------------------------------------------------------------------
8686 SUBROUTINE t_calc_mu_uv_1 ( config_flags, &
8687 mu, muu, muv, &
8688 ids, ide, jds, jde, kds, kde, &
8689 ims, ime, jms, jme, kms, kme, &
8690 its, ite, jts, jte, kts, kte )
8691
8692 ! Zaizhong Ma, April 1,2005
8693
8694 IMPLICIT NONE
8695
8696 ! Input data
8697
8698 TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags
8699
8700 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
8701 ims, ime, jms, jme, kms, kme, &
8702 its, ite, jts, jte, kts, kte
8703
8704 REAL, DIMENSION( ims:ime , jms:jme ) , INTENT( OUT) :: muu, muv
8705 REAL, DIMENSION( ims:ime , jms:jme ) :: mu
8706
8707 ! local stuff
8708
8709 INTEGER :: i, j, itf, jtf, im, jm
8710
8711 ! zzma: new definition
8712
8713 ! IN variables
8714
8715 REAL, DIMENSION( ims:ime , jms:jme ) :: S_mu,P_mu,B_mu
8716
8717 ! OUT variables
8718
8719 REAL, DIMENSION( ims:ime , jms:jme ) :: P_muu, P_muv,B_muu, B_muv
8720
8721 REAL :: SAVE_L, COEF, ALPHA, FACTOR, VAL_N, VAL_L, VAL_A
8722 INTEGER :: NT
8723
8724 ! zzma: new definition end
8725
8726 !TGL test
8727
8728 do i=ims,ime
8729 do j=jms,jme
8730 S_mu(i,j)=mu(i,j)
8731 P_mu(i,j)=mu(i,j)
8732 B_mu(i,j)=mu(i,j)
8733 enddo
8734 enddo
8735
8736 !NLM
8737
8738 CALL calc_mu_uv_1 ( config_flags, &
8739 mu, muu, muv, &
8740 ids, ide, jds, jde, kds, kde, &
8741 ims, ime, jms, jme, kms, kme, &
8742 its, ite, jts, jte, kts, kte )
8743
8744 do i=ims,ime
8745 do j=jms,jme
8746 B_muu(i,j)=muu(i,j)
8747 B_muv(i,j)=muv(i,j)
8748 enddo
8749 enddo
8750
8751 ! TCL
8752
8753 CALL g_calc_mu_uv_1( config_flags, mu, P_mu, muu, P_muu, muv, P_muv, ids, ide, jds, jde, ims, ime, jms, jme, its, ite, jts, &
8754 &jte )
8755
8756 SAVE_L=0.
8757 do i=ims,ime
8758 do j=jms,jme
8759 SAVE_L=SAVE_L + P_muu(i,j)*P_muu(i,j) + P_muv(i,j)*P_muv(i,j)
8760 enddo
8761 enddo
8762
8763 ALPHA=1.
8764 DO NT=1,11
8765 ALPHA=0.1*ALPHA
8766 FACTOR=1.+ALPHA
8767 do i=ims,ime
8768 do j=jms,jme
8769 P_mu(i,j)=FACTOR*S_mu(i,j)
8770 enddo
8771 enddo
8772
8773 CALL calc_mu_uv_1 ( config_flags, &
8774 P_mu, P_muu, P_muv, &
8775 ids, ide, jds, jde, kds, kde, &
8776 ims, ime, jms, jme, kms, kme, &
8777 its, ite, jts, jte, kts, kte )
8778
8779 VAL_N=0.
8780 do i=ims,ime
8781 do j=jms,jme
8782 VAL_N=VAL_N+ (P_muu(i,j)-B_muu(i,j))*(P_muu(i,j)-B_muu(i,j)) &
8783 + (P_muv(i,j)-B_muv(i,j))*(P_muv(i,j)-B_muv(i,j))
8784 enddo
8785 enddo
8786
8787 VAL_L=SAVE_L*ALPHA**2
8788 COEF=VAL_N/VAL_L
8789 WRITE(6, fmt='(A,E9.4,A,E22.13,A,E13.6,A,E13.6)') &
8790 'g_calc_mu_uv_1: ALPHA=',ALPHA,' COEF=',COEF, &
8791 ' VAL_N=',VAL_N,' VAL_L=',VAL_L
8792 ENDDO
8793
8794 ! ADJ test
8795
8796 FACTOR=0.1
8797 do i=ims,ime
8798 do j=jms,jme
8799 mu(i,j)=S_mu(i,j)
8800
8801 P_mu(i,j)=FACTOR*S_mu(i,j)
8802
8803 B_mu(i,j)=P_mu(i,j)
8804 enddo
8805 enddo
8806
8807 ! TGL
8808
8809 CALL g_calc_mu_uv_1( config_flags, mu, P_mu, muu, P_muu, muv, P_muv, ids, ide, jds, jde, ims, ime, jms, jme, its, ite, jts, &
8810 &jte )
8811
8812 VAL_L=0.
8813 do i=ims,ime
8814 do j=jms,jme
8815 VAL_L=VAL_L +P_muu(i,j)*P_muu(i,j) + P_muv(i,j)*P_muv(i,j)
8816 enddo
8817 enddo
8818 do i=ims,ime
8819 do j=jms,jme
8820 P_mu(i,j)=0.0
8821 enddo
8822 enddo
8823
8824 ! ADJ
8825
8826 CALL a_calc_mu_uv_1( config_flags, P_mu, P_muu, P_muv, ids, ide, jds, jde, ims, ime, jms, jme, its, ite, jts, jte )
8827
8828 VAL_A=0.
8829 do i=ims,ime
8830 do j=jms,jme
8831 VAL_A=VAL_A +P_mu(i,j)*B_mu(i,j)
8832 enddo
8833 enddo
8834
8835 print*, ' '
8836 write(6,fmt='(A,2E22.13)') 'a_calc_mu_uv_1: ', VAL_L,VAL_A
8837
8838 ! RECOVER
8839
8840 do i=ims,ime
8841 do j=jms,jme
8842 mu(i,j)=S_mu(i,j)
8843 enddo
8844 enddo
8845
8846 !g_calc_mu_uv_1: ALPHA=.1000E+00 COEF= 0.5623352050781E+01 VAL_N= 0.178737E+13 VAL_L= 0.317848E+12
8847 !g_calc_mu_uv_1: ALPHA=.1000E-01 COEF= 0.4679619445801E+03 VAL_N= 0.148741E+13 VAL_L= 0.317848E+10
8848 !g_calc_mu_uv_1: ALPHA=.1000E-02 COEF= 0.4670370312500E+05 VAL_N= 0.148447E+13 VAL_L= 0.317848E+08
8849 !g_calc_mu_uv_1: ALPHA=.1000E-03 COEF= 0.4670370000000E+07 VAL_N= 0.148447E+13 VAL_L= 0.317848E+06
8850 !g_calc_mu_uv_1: ALPHA=.1000E-04 COEF= 0.4670369920000E+09 VAL_N= 0.148447E+13 VAL_L= 0.317848E+04
8851 !g_calc_mu_uv_1: ALPHA=.1000E-05 COEF= 0.4670369792000E+11 VAL_N= 0.148447E+13 VAL_L= 0.317848E+02
8852 !g_calc_mu_uv_1: ALPHA=.1000E-06 COEF= 0.4670369038336E+13 VAL_N= 0.148447E+13 VAL_L= 0.317848E+00
8853 !g_calc_mu_uv_1: ALPHA=.1000E-07 COEF= 0.4670369248051E+15 VAL_N= 0.148447E+13 VAL_L= 0.317848E-02
8854 !g_calc_mu_uv_1: ALPHA=.1000E-08 COEF= 0.4670368912507E+17 VAL_N= 0.148447E+13 VAL_L= 0.317848E-04
8855 !g_calc_mu_uv_1: ALPHA=.1000E-09 COEF= 0.4670368603269E+19 VAL_N= 0.148447E+13 VAL_L= 0.317848E-06
8856 !g_calc_mu_uv_1: ALPHA=.1000E-10 COEF= 0.4670368273416E+21 VAL_N= 0.148447E+13 VAL_L= 0.317848E-08
8857
8858 !a_calc_mu_uv_1: 0.1787371847680E+13 0.3030103490560E+12
8859
8860 !g_calc_mu_uv_1: ALPHA=.1000E+00 COEF= 0.1000000000000E+01 VAL_N= 0.303010E+12 VAL_L= 0.303010E+12
8861 !g_calc_mu_uv_1: ALPHA=.1000E-01 COEF= 0.1000000000000E+01 VAL_N= 0.303010E+10 VAL_L= 0.303010E+10
8862 !g_calc_mu_uv_1: ALPHA=.1000E-02 COEF= 0.9999999999998E+00 VAL_N= 0.303010E+08 VAL_L= 0.303010E+08
8863 !g_calc_mu_uv_1: ALPHA=.1000E-03 COEF= 0.1000000000001E+01 VAL_N= 0.303010E+06 VAL_L= 0.303010E+06
8864 !g_calc_mu_uv_1: ALPHA=.1000E-04 COEF= 0.1000000000010E+01 VAL_N= 0.303010E+04 VAL_L= 0.303010E+04
8865 !g_calc_mu_uv_1: ALPHA=.1000E-05 COEF= 0.9999999997959E+00 VAL_N= 0.303010E+02 VAL_L= 0.303010E+02
8866 !g_calc_mu_uv_1: ALPHA=.1000E-06 COEF= 0.1000000001036E+01 VAL_N= 0.303010E+00 VAL_L= 0.303010E+00
8867 !g_calc_mu_uv_1: ALPHA=.1000E-07 COEF= 0.9999999973814E+00 VAL_N= 0.303010E-02 VAL_L= 0.303010E-02
8868 !g_calc_mu_uv_1: ALPHA=.1000E-08 COEF= 0.1000000270797E+01 VAL_N= 0.303010E-04 VAL_L= 0.303010E-04
8869 !g_calc_mu_uv_1: ALPHA=.1000E-09 COEF= 0.1000000267344E+01 VAL_N= 0.303010E-06 VAL_L= 0.303010E-06
8870 !g_calc_mu_uv_1: ALPHA=.1000E-10 COEF= 0.1000003235117E+01 VAL_N= 0.303011E-08 VAL_L= 0.303010E-08
8871
8872 !a_calc_mu_uv_1: 0.3030098328208E+12 0.3030098328208E+12
8873
8874
8875 END SUBROUTINE t_calc_mu_uv_1
8876 !-----------------------------------------------------------------------------------------------
8877
8878 SUBROUTINE t_small_step_finish( u_2, u_1, v_2, v_1, w_2, w_1, &
8879 t_2, t_1, ph_2, ph_1, ww, ww1, &
8880 mu_2, mu_1, &
8881 mut, muts, muu, muus, muv, muvs, &
8882 u_save, v_save, w_save, &
8883 t_save, ph_save, mu_save, &
8884 msfu, msfv, msft, &
8885 h_diabatic, &
8886 number_of_small_timesteps,dts, &
8887 rk_step, rk_order, &
8888 ids,ide, jds,jde, kds,kde, &
8889 ims,ime, jms,jme, kms,kme, &
8890 its,ite, jts,jte, kts,kte )
8891
8892 ! Zaizhong Ma, April 4,2005
8893
8894 IMPLICIT NONE ! religion first
8895
8896 ! stuff passed in
8897
8898 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
8899 INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
8900 INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
8901 INTEGER, INTENT(IN ) :: number_of_small_timesteps
8902 INTEGER, INTENT(IN ) :: rk_step, rk_order
8903 REAL, INTENT(IN ) :: dts
8904
8905 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN ) :: u_1, &
8906 v_1, &
8907 w_1, &
8908 t_1, &
8909 ww1, &
8910 ph_1
8911
8912 REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: u_2, &
8913 v_2, &
8914 w_2, &
8915 t_2, &
8916 ww, &
8917 ph_2
8918
8919 REAL, DIMENSION(ims:ime, kms:kme, jms:jme),INTENT(IN ) :: h_diabatic
8920 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: u_save, &
8921 v_save, &
8922 w_save, &
8923 t_save, &
8924 ph_save
8925
8926 REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: muus, muvs
8927 REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: mu_2, mu_1
8928 REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: mut, muts, &
8929 muu, muv, mu_save
8930 REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN ) :: msfu, msfv, msft
8931
8932
8933 ! local stuff
8934
8935 INTEGER :: i,j,k
8936 INTEGER :: i_start, i_end, j_start, j_end, i_endu, j_endv
8937
8938 ! zzma: new definition
8939
8940 ! IN variables
8941
8942 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: S_u_save, &
8943 S_v_save, &
8944 S_w_save, &
8945 S_t_save, &
8946 S_ph_save
8947
8948 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: P_u_save, &
8949 P_v_save, &
8950 P_w_save, &
8951 P_t_save, &
8952 P_ph_save
8953
8954 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: B_u_save, &
8955 B_v_save, &
8956 B_w_save, &
8957 B_t_save, &
8958 B_ph_save
8959
8960 ! INOUT variables
8961 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: S_u_2, &
8962 S_v_2, &
8963 S_w_2, &
8964 S_t_2, &
8965 S_ph_2
8966 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: P_u_2, &
8967 P_v_2, &
8968 P_w_2, &
8969 P_t_2, &
8970 P_ph_2
8971 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: K_u_2, &
8972 K_v_2, &
8973 K_w_2, &
8974 K_t_2, &
8975 K_ph_2
8976 REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: B_u_2, &
8977 B_v_2, &
8978 B_w_2, &
8979 B_t_2, &
8980 B_ph_2
8981
8982 REAL, DIMENSION(ims:ime, jms:jme) :: S_muus, S_muvs,S_mu_2,S_mut, S_muts,S_muu, S_muv, S_mu_save
8983 REAL, DIMENSION(ims:ime, jms:jme) :: P_muus, P_muvs,P_mu_2,P_mut, P_muts,P_muu, P_muv, P_mu_save
8984 REAL, DIMENSION(ims:ime, jms:jme) :: K_muus, K_muvs,K_mu_2,K_mut, K_muts,K_muu, K_muv, K_mu_save
8985 REAL, DIMENSION(ims:ime, jms:jme) :: B_muus, B_muvs,B_mu_2,B_mut, B_muts,B_muu, B_muv, B_mu_save
8986
8987 REAL :: SAVE_L, COEF, ALPHA, FACTOR, VAL_N, VAL_L, VAL_A
8988 INTEGER :: NT
8989
8990 ! zzma: new definition end
8991
8992 !TGL test
8993
8994 do i=ims,ime
8995 do k=kms,kme
8996 do j=jms,jme
8997 S_u_save(i,k,j)=u_save(i,k,j)
8998 S_v_save(i,k,j)=v_save(i,k,j)
8999 S_w_save(i,k,j)=w_save(i,k,j)
9000 S_t_save(i,k,j)=t_save(i,k,j)
9001 S_ph_save(i,k,j)=ph_save(i,k,j)
9002
9003 P_u_save(i,k,j)=u_save(i,k,j)
9004 P_v_save(i,k,j)=v_save(i,k,j)
9005 P_w_save(i,k,j)=w_save(i,k,j)
9006 P_t_save(i,k,j)=t_save(i,k,j)
9007 P_ph_save(i,k,j)=ph_save(i,k,j)
9008 enddo
9009 enddo
9010 enddo
9011
9012 do i=ims,ime
9013 do k=kms,kme
9014 do j=jms,jme
9015 S_u_2(i,k,j)=u_2(i,k,j)
9016 S_v_2(i,k,j)=v_2(i,k,j)
9017 S_w_2(i,k,j)=w_2(i,k,j)
9018 S_t_2(i,k,j)=t_2(i,k,j)
9019 S_ph_2(i,k,j)=ph_2(i,k,j)
9020
9021 P_u_2(i,k,j)=u_2(i,k,j)
9022 P_v_2(i,k,j)=v_2(i,k,j)
9023 P_w_2(i,k,j)=w_2(i,k,j)
9024 P_t_2(i,k,j)=t_2(i,k,j)
9025 P_ph_2(i,k,j)=ph_2(i,k,j)
9026
9027 K_u_2(i,k,j)=u_2(i,k,j)
9028 K_v_2(i,k,j)=v_2(i,k,j)
9029 K_w_2(i,k,j)=w_2(i,k,j)
9030 K_t_2(i,k,j)=t_2(i,k,j)
9031 K_ph_2(i,k,j)=ph_2(i,k,j)
9032 enddo
9033 enddo
9034 enddo
9035 do i=ims,ime
9036 do j=jms,jme
9037 S_muus(i,j)=muus(i,j)
9038 S_muvs(i,j)=muvs(i,j)
9039 S_mu_2(i,j)=mu_2(i,j)
9040 S_mut(i,j)=mut(i,j)
9041 S_muts(i,j)=muts(i,j)
9042 S_muu(i,j)=muu(i,j)
9043 S_muv(i,j)=muv(i,j)
9044 S_mu_save(i,j)=mu_save(i,j)
9045
9046 P_muus(i,j)=muus(i,j)
9047 P_muvs(i,j)=muvs(i,j)
9048 P_mu_2(i,j)=mu_2(i,j)
9049 P_mut(i,j)=mut(i,j)
9050 P_muts(i,j)=muts(i,j)
9051 P_muu(i,j)=muu(i,j)
9052 P_muv(i,j)=muv(i,j)
9053 P_mu_save(i,j)=mu_save(i,j)
9054
9055 K_muus(i,j)=muus(i,j)
9056 K_muvs(i,j)=muvs(i,j)
9057 K_mu_2(i,j)=mu_2(i,j)
9058 K_mut(i,j)=mut(i,j)
9059 K_muts(i,j)=muts(i,j)
9060 K_muu(i,j)=muu(i,j)
9061 K_muv(i,j)=muv(i,j)
9062 K_mu_save(i,j)=mu_save(i,j)
9063 enddo
9064 enddo
9065
9066 !NLM
9067
9068 CALL small_step_finish( u_2, u_1, v_2, v_1, w_2, w_1, &
9069 t_2, t_1, ph_2, ph_1, ww, ww1, &
9070 mu_2, mu_1, &
9071 mut, muts, muu, muus, muv, muvs, &
9072 u_save, v_save, w_save, &
9073 t_save, ph_save, mu_save, &
9074 msfu, msfv, msft, &
9075 h_diabatic, &
9076 number_of_small_timesteps,dts, &
9077 rk_step, rk_order, &
9078 ids,ide, jds,jde, kds,kde, &
9079 ims,ime, jms,jme, kms,kme, &
9080 its,ite, jts,jte, kts,kte )
9081
9082 do i=ims,ime
9083 do k=kms,kme
9084 do j=jms,jme
9085 B_u_2(i,k,j)=u_2(i,k,j)
9086 B_v_2(i,k,j)=v_2(i,k,j)
9087 B_w_2(i,k,j)=w_2(i,k,j)
9088 B_t_2(i,k,j)=t_2(i,k,j)
9089 B_ph_2(i,k,j)=ph_2(i,k,j)
9090 enddo
9091 enddo
9092 enddo
9093 do i=ims,ime
9094 do j=jms,jme
9095 B_muus(i,j)=muus(i,j)
9096 B_muvs(i,j)=muvs(i,j)
9097 B_mu_2(i,j)=mu_2(i,j)
9098 B_mut(i,j)=mut(i,j)
9099 B_muts(i,j)=muts(i,j)
9100 B_muu(i,j)=muu(i,j)
9101 B_muv(i,j)=muv(i,j)
9102 B_mu_save(i,j)=mu_save(i,j)
9103 enddo
9104 enddo
9105
9106 ! TCL
9107
9108 CALL g_small_step_finish( K_u_2, P_u_2, K_v_2, P_v_2, K_w_2, P_w_2, K_t_2, P_t_2, K_ph_2, P_ph_2, ww, K_mu_2, P_mu_2, &
9109 &K_mut, P_mut, K_muts, &
9110 &P_muts, K_muu, P_muu, K_muus, P_muus, K_muv, P_muv, K_muvs, P_muvs, u_save, P_u_save, v_save, P_v_save, w_save, P_w_save, t_save, &
9111 &P_t_save, ph_save, P_ph_save, K_mu_save, P_mu_save, msfu, msfv, msft, ide, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, &
9112 &jts, jte )
9113
9114 SAVE_L=0.
9115 do i=ims,ime
9116 do k=kms,kme
9117 do j=jms,jme
9118 SAVE_L=SAVE_L + P_u_2(i,k,j)*P_u_2(i,k,j) &
9119 + P_v_2(i,k,j)*P_v_2(i,k,j) &
9120 + P_w_2(i,k,j)*P_w_2(i,k,j) &
9121 + P_t_2(i,k,j)*P_t_2(i,k,j) &
9122 + P_ph_2(i,k,j)*P_ph_2(i,k,j)
9123 enddo
9124 enddo
9125 enddo
9126 do i=ims,ime
9127 do j=jms,jme
9128 SAVE_L=SAVE_L + P_muus(i,j)*P_muus(i,j) &
9129 + P_muvs(i,j)*P_muvs(i,j) &
9130 + P_mu_2(i,j)*P_mu_2(i,j) &
9131 + P_mut(i,j)*P_mut(i,j) &
9132 + P_muts(i,j)*P_muts(i,j) &
9133 + P_muu(i,j)*P_muu(i,j) &
9134 + P_muv(i,j)*P_muv(i,j) &
9135 + P_mu_save(i,j)*P_mu_save(i,j)
9136 enddo
9137 enddo
9138
9139 ALPHA=1.
9140 DO NT=1,11
9141 ALPHA=0.1*ALPHA
9142 FACTOR=1.+ALPHA
9143 do i=ims,ime
9144 do k=kms,kme
9145 do j=jms,jme
9146 P_u_save(i,k,j)=FACTOR*S_u_save(i,k,j)
9147 P_v_save(i,k,j)=FACTOR*S_v_save(i,k,j)
9148 P_w_save(i,k,j)=FACTOR*S_w_save(i,k,j)
9149 P_t_save(i,k,j)=FACTOR*S_t_save(i,k,j)
9150 P_ph_save(i,k,j)=FACTOR*S_ph_save(i,k,j)
9151 enddo
9152 enddo
9153 enddo
9154 do i=ims,ime
9155 do k=kms,kme
9156 do j=jms,jme
9157 P_u_2(i,k,j)=FACTOR*S_u_2(i,k,j)
9158 P_v_2(i,k,j)=FACTOR*S_v_2(i,k,j)
9159 P_w_2(i,k,j)=FACTOR*S_w_2(i,k,j)
9160 P_t_2(i,k,j)=FACTOR*S_t_2(i,k,j)
9161 P_ph_2(i,k,j)=FACTOR*S_ph_2(i,k,j)
9162 enddo
9163 enddo
9164 enddo
9165 do i=ims,ime
9166 do j=jms,jme
9167 P_muus(i,j)=FACTOR*S_muus(i,j)
9168 P_muvs(i,j)=FACTOR*S_muvs(i,j)
9169 P_mu_2(i,j)=FACTOR*S_mu_2(i,j)
9170 P_mut(i,j)=FACTOR*S_mut(i,j)
9171 P_muts(i,j)=FACTOR*S_muts(i,j)
9172 P_muu(i,j)=FACTOR*S_muu(i,j)
9173 P_muv(i,j)=FACTOR*S_muv(i,j)
9174 P_mu_save(i,j)=FACTOR*S_mu_save(i,j)
9175 enddo
9176 enddo
9177
9178 CALL small_step_finish( P_u_2, u_1, P_v_2, v_1, P_w_2, w_1, &
9179 P_t_2, t_1, P_ph_2, ph_1, ww, ww1, &
9180 P_mu_2, mu_1, &
9181 P_mut, P_muts, P_muu, P_muus, P_muv, P_muvs, &
9182 P_u_save, P_v_save, P_w_save, &
9183 P_t_save, P_ph_save, P_mu_save, &
9184 msfu, msfv, msft, &
9185 h_diabatic, &
9186 number_of_small_timesteps,dts, &
9187 rk_step, rk_order, &
9188 ids,ide, jds,jde, kds,kde, &
9189 ims,ime, jms,jme, kms,kme, &
9190 its,ite, jts,jte, kts,kte )
9191
9192 VAL_N=0.
9193 do i=ims,ime
9194 do k=kms,kme
9195 do j=jms,jme
9196 VAL_N=VAL_N + (P_u_2(i,k,j)- B_u_2(i,k,j))*(P_u_2(i,k,j)- B_u_2(i,k,j)) &
9197 + (P_v_2(i,k,j)- B_v_2(i,k,j))*(P_v_2(i,k,j)- B_v_2(i,k,j)) &
9198 + (P_w_2(i,k,j)- B_w_2(i,k,j))*(P_w_2(i,k,j)- B_w_2(i,k,j)) &
9199 + (P_t_2(i,k,j)- B_t_2(i,k,j))*(P_t_2(i,k,j)- B_t_2(i,k,j)) &
9200 + (P_ph_2(i,k,j)- B_ph_2(i,k,j))*(P_ph_2(i,k,j)- B_ph_2(i,k,j))
9201 enddo
9202 enddo
9203 enddo
9204 do i=ims,ime
9205 do j=jms,jme
9206 VAL_N=VAL_N + (P_muus(i,j)- B_muus(i,j))*(P_muus(i,j)- B_muus(i,j)) &
9207 + (P_muvs(i,j)- B_muvs(i,j))*(P_muvs(i,j)- B_muvs(i,j)) &
9208 + (P_mu_2(i,j)- B_mu_2(i,j))*(P_mu_2(i,j)- B_mu_2(i,j)) &
9209 + (P_mut(i,j)- B_mut(i,j))*(P_mut(i,j)- B_mut(i,j)) &
9210 + (P_muts(i,j)- B_muts(i,j))*(P_muts(i,j)- B_muts(i,j)) &
9211 + (P_muu(i,j)- B_muu(i,j))*(P_muu(i,j)- B_muu(i,j)) &
9212 + (P_muv(i,j)- B_muv(i,j))*(P_muv(i,j)- B_muv(i,j)) &
9213 + (P_mu_save(i,j)- B_mu_save(i,j))*(P_mu_save(i,j)- B_mu_save(i,j))
9214 enddo
9215 enddo
9216
9217 VAL_L=SAVE_L*ALPHA**2
9218 COEF=VAL_N/VAL_L
9219 WRITE(6, fmt='(A,E9.4,A,E22.13,A,E13.6,A,E13.6)') &
9220 'g_small_step_finish: ALPHA=',ALPHA,' COEF=',COEF, &
9221 ' VAL_N=',VAL_N,' VAL_L=',VAL_L
9222 ENDDO
9223
9224 ! ADJ test
9225
9226 FACTOR=0.1
9227 do i=ims,ime
9228 do k=kms,kme
9229 do j=jms,jme
9230 u_save(i,k,j)=S_u_save(i,k,j)
9231 v_save(i,k,j)=S_v_save(i,k,j)
9232 w_save(i,k,j)=S_w_save(i,k,j)
9233 t_save(i,k,j)=S_t_save(i,k,j)
9234 ph_save(i,k,j)=S_ph_save(i,k,j)
9235
9236 P_u_save(i,k,j)=FACTOR*S_u_save(i,k,j)
9237 P_v_save(i,k,j)=FACTOR*S_v_save(i,k,j)
9238 P_w_save(i,k,j)=FACTOR*S_w_save(i,k,j)
9239 P_t_save(i,k,j)=FACTOR*S_t_save(i,k,j)
9240 P_ph_save(i,k,j)=FACTOR*S_ph_save(i,k,j)
9241
9242 B_u_save(i,k,j)=P_u_save(i,k,j)
9243 B_v_save(i,k,j)=P_v_save(i,k,j)
9244 B_w_save(i,k,j)=P_w_save(i,k,j)
9245 B_t_save(i,k,j)=P_t_save(i,k,j)
9246 B_ph_save(i,k,j)=P_ph_save(i,k,j)
9247 enddo
9248 enddo
9249 enddo
9250 do i=ims,ime
9251 do k=kms,kme
9252 do j=jms,jme
9253 u_2(i,k,j)=S_u_2(i,k,j)
9254 v_2(i,k,j)=S_v_2(i,k,j)
9255 w_2(i,k,j)=S_w_2(i,k,j)
9256 t_2(i,k,j)=S_t_2(i,k,j)
9257 ph_2(i,k,j)=S_ph_2(i,k,j)
9258
9259 P_u_2(i,k,j)=FACTOR*S_u_2(i,k,j)
9260 P_v_2(i,k,j)=FACTOR*S_v_2(i,k,j)
9261 P_w_2(i,k,j)=FACTOR*S_w_2(i,k,j)
9262 P_t_2(i,k,j)=FACTOR*S_t_2(i,k,j)
9263 P_ph_2(i,k,j)=FACTOR*S_ph_2(i,k,j)
9264
9265 B_u_2(i,k,j)=P_u_2(i,k,j)
9266 B_v_2(i,k,j)=P_v_2(i,k,j)
9267 B_w_2(i,k,j)=P_w_2(i,k,j)
9268 B_t_2(i,k,j)=P_t_2(i,k,j)
9269 B_ph_2(i,k,j)=P_ph_2(i,k,j)
9270
9271 K_u_2(i,k,j)=u_2(i,k,j)
9272 K_v_2(i,k,j)=v_2(i,k,j)
9273 K_w_2(i,k,j)=w_2(i,k,j)
9274 K_t_2(i,k,j)=t_2(i,k,j)
9275 K_ph_2(i,k,j)=ph_2(i,k,j)
9276 enddo
9277 enddo
9278 enddo
9279 do i=ims,ime
9280 do j=jms,jme
9281 muus(i,j)=S_muus(i,j)
9282 muvs(i,j)=S_muvs(i,j)
9283 mu_2(i,j)=S_mu_2(i,j)
9284 mut(i,j)=S_mut(i,j)
9285 muts(i,j)=S_muts(i,j)
9286 muu(i,j)=S_muu(i,j)
9287 muv(i,j)=S_muv(i,j)
9288 mu_save(i,j)=S_mu_save(i,j)
9289
9290 P_muus(i,j)=FACTOR*S_muus(i,j)
9291 P_muvs(i,j)=FACTOR*S_muvs(i,j)
9292 P_mu_2(i,j)=FACTOR*S_mu_2(i,j)
9293 P_mut(i,j)=FACTOR*S_mut(i,j)
9294 P_muts(i,j)=FACTOR*S_muts(i,j)
9295 P_muu(i,j)=FACTOR*S_muu(i,j)
9296 P_muv(i,j)=FACTOR*S_muv(i,j)
9297 P_mu_save(i,j)=FACTOR*S_mu_save(i,j)
9298
9299 B_muus(i,j)=P_muus(i,j)
9300 B_muvs(i,j)=P_muvs(i,j)
9301 B_mu_2(i,j)=P_mu_2(i,j)
9302 B_mut(i,j)=P_mut(i,j)
9303 B_muts(i,j)=P_muts(i,j)
9304 B_muu(i,j)=P_muu(i,j)
9305 B_muv(i,j)=P_muv(i,j)
9306 B_mu_save(i,j)=P_mu_save(i,j)
9307
9308 K_muus(i,j)=muus(i,j)
9309 K_muvs(i,j)=muvs(i,j)
9310 K_mu_2(i,j)=mu_2(i,j)
9311 K_mut(i,j)=mut(i,j)
9312 K_muts(i,j)=muts(i,j)
9313 K_muu(i,j)=muu(i,j)
9314 K_muv(i,j)=muv(i,j)
9315 K_mu_save(i,j)=mu_save(i,j)
9316 enddo
9317 enddo
9318
9319 ! TGL
9320
9321 CALL g_small_step_finish( u_2, P_u_2, v_2, P_v_2, w_2, P_w_2, t_2, P_t_2, ph_2, P_ph_2, ww, mu_2, P_mu_2, &
9322 &mut, P_mut, muts, &
9323 &P_muts, muu, P_muu, muus, P_muus, muv, P_muv, muvs, P_muvs, u_save, P_u_save, v_save, P_v_save, w_save, P_w_save, t_save, &
9324 &P_t_save, ph_save, P_ph_save, mu_save, P_mu_save, msfu, msfv, msft, ide, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, &
9325 &jts, jte )
9326
9327 VAL_L=0.
9328 do i=ims,ime
9329 do k=kms,kme
9330 do j=jms,jme
9331 VAL_L=VAL_L + P_u_2(i,k,j)*P_u_2(i,k,j) &
9332 + P_v_2(i,k,j)*P_v_2(i,k,j) &
9333 + P_w_2(i,k,j)*P_w_2(i,k,j) &
9334 + P_t_2(i,k,j)*P_t_2(i,k,j) &
9335 + P_ph_2(i,k,j)*P_ph_2(i,k,j)
9336 enddo
9337 enddo
9338 enddo
9339 do i=ims,ime
9340 do j=jms,jme
9341 VAL_L=VAL_L +P_muus(i,j)*P_muus(i,j) &
9342 + P_muvs(i,j)*P_muvs(i,j) &
9343 + P_mu_2(i,j)*P_mu_2(i,j) &
9344 + P_mut(i,j)*P_mut(i,j) &
9345 + P_muts(i,j)*P_muts(i,j) &
9346 + P_muu(i,j)*P_muu(i,j) &
9347 + P_muv(i,j)*P_muv(i,j) &
9348 + P_mu_save(i,j)*P_mu_save(i,j)
9349 enddo
9350 enddo
9351
9352 do i=ims,ime
9353 do k=kms,kme
9354 do j=jms,jme
9355 P_u_save(i,k,j)=0.0
9356 P_v_save(i,k,j)=0.0
9357 P_w_save(i,k,j)=0.0
9358 P_t_save(i,k,j)=0.0
9359 P_ph_save(i,k,j)=0.0
9360 enddo
9361 enddo
9362 enddo
9363
9364 ! ADJ
9365
9366 CALL a_small_step_finish(K_u_2,P_u_2, K_v_2, P_v_2, K_w_2, P_w_2, K_t_2, P_t_2, P_ph_2, P_mu_2, K_mut, P_mut, K_muts, P_muts, K_muu, &
9367 &P_muu,K_muus,P_muus, K_muv, P_muv, K_muvs, P_muvs, u_save, P_u_save, v_save, P_v_save, w_save, P_w_save, t_save, P_t_save, P_ph_save, &
9368 &P_mu_save, msfu, msfv, msft, ide, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte )
9369
9370 VAL_A=0.
9371 do i=ims,ime
9372 do k=kms,kme
9373 do j=jms,jme
9374 VAL_A=VAL_A +B_u_save(i,k,j)*P_u_save(i,k,j) &
9375 +B_v_save(i,k,j)*P_v_save(i,k,j) &
9376 +B_w_save(i,k,j)*P_w_save(i,k,j) &
9377 +B_t_save(i,k,j)*P_t_save(i,k,j) &
9378 +B_ph_save(i,k,j)*P_ph_save(i,k,j)
9379 enddo
9380 enddo
9381 enddo
9382 do i=ims,ime
9383 do k=kms,kme
9384 do j=jms,jme
9385 VAL_A=VAL_A + P_u_2(i,k,j)*B_u_2(i,k,j) &
9386 + P_v_2(i,k,j)*B_v_2(i,k,j) &
9387 + P_w_2(i,k,j)*B_w_2(i,k,j) &
9388 + P_t_2(i,k,j)*B_t_2(i,k,j) &
9389 + P_ph_2(i,k,j)*B_ph_2(i,k,j)
9390 enddo
9391 enddo
9392 enddo
9393 do i=ims,ime
9394 do j=jms,jme
9395 VAL_A=VAL_A + P_muus(i,j)*B_muus(i,j) &
9396 + P_muvs(i,j)*B_muvs(i,j) &
9397 + P_mu_2(i,j)*B_mu_2(i,j) &
9398 + P_mut(i,j)*B_mut(i,j) &
9399 + P_muts(i,j)*B_muts(i,j) &
9400 + P_muu(i,j)*B_muu(i,j) &
9401 + P_muv(i,j)*B_muv(i,j) &
9402 + P_mu_save(i,j)*B_mu_save(i,j)
9403 enddo
9404 enddo
9405
9406 print*, ' '
9407 write(6,fmt='(A,2E22.13)') 'a_small_step_finish: ', VAL_L,VAL_A
9408
9409 ! RECOVER
9410
9411 do i=ims,ime
9412 do k=kms,kme
9413 do j=jms,jme
9414 u_save(i,k,j)=S_u_save(i,k,j)
9415 v_save(i,k,j)=S_v_save(i,k,j)
9416 w_save(i,k,j)=S_w_save(i,k,j)
9417 t_save(i,k,j)=S_t_save(i,k,j)
9418 ph_save(i,k,j)=S_ph_save(i,k,j)
9419 enddo
9420 enddo
9421 enddo
9422 do i=ims,ime
9423 do k=kms,kme
9424 do j=jms,jme
9425 u_2(i,k,j)=S_u_2(i,k,j)
9426 v_2(i,k,j)=S_v_2(i,k,j)
9427 w_2(i,k,j)=S_w_2(i,k,j)
9428 t_2(i,k,j)=S_t_2(i,k,j)
9429 ph_2(i,k,j)=S_ph_2(i,k,j)
9430 enddo
9431 enddo
9432 enddo
9433 do i=ims,ime
9434 do j=jms,jme
9435 muus(i,j)=S_muus(i,j)
9436 muvs(i,j)=S_muvs(i,j)
9437 mu_2(i,j)=S_mu_2(i,j)
9438 mut(i,j)=S_mut(i,j)
9439 muts(i,j)=S_muts(i,j)
9440 muu(i,j)=S_muu(i,j)
9441 muv(i,j)=S_muv(i,j)
9442 mu_save(i,j)=S_mu_save(i,j)
9443 enddo
9444 enddo
9445
9446 !g_small_step_finish: ALPHA=.1000E+00 COEF= 0.9997525215149E+00 VAL_N= 0.959912E+12 VAL_L= 0.960150E+12
9447 !g_small_step_finish: ALPHA=.1000E-01 COEF= 0.9998036623001E+00 VAL_N= 0.959961E+10 VAL_L= 0.960150E+10
9448 !g_small_step_finish: ALPHA=.1000E-02 COEF= 0.1000095129013E+01 VAL_N= 0.960241E+08 VAL_L= 0.960150E+08
9449 !g_small_step_finish: ALPHA=.1000E-03 COEF= 0.1000633716583E+01 VAL_N= 0.960758E+06 VAL_L= 0.960150E+06
9450 !g_small_step_finish: ALPHA=.1000E-04 COEF= 0.9989603161812E+00 VAL_N= 0.959152E+04 VAL_L= 0.960150E+04
9451 !g_small_step_finish: ALPHA=.1000E-05 COEF= 0.8403349518776E+00 VAL_N= 0.806847E+02 VAL_L= 0.960150E+02
9452 !g_small_step_finish: ALPHA=.1000E-06 COEF= 0.6937835216522E+00 VAL_N= 0.666136E+00 VAL_L= 0.960150E+00
9453 !g_small_step_finish: ALPHA=.1000E-07 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.960150E-02
9454 !g_small_step_finish: ALPHA=.1000E-08 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.960150E-04
9455 !g_small_step_finish: ALPHA=.1000E-09 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.960150E-06
9456 !g_small_step_finish: ALPHA=.1000E-10 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.960150E-08
9457
9458 !a_small_step_finish: 0.9599120834560E+12 0.9599578931200E+12
9459
9460 !g_small_step_finish: ALPHA=.1000E+00 COEF= 0.1000000000000E+01 VAL_N= 0.960067E+12 VAL_L= 0.960067E+12
9461 !g_small_step_finish: ALPHA=.1000E-01 COEF= 0.1000000000000E+01 VAL_N= 0.960067E+10 VAL_L= 0.960067E+10
9462 !g_small_step_finish: ALPHA=.1000E-02 COEF= 0.9999999999998E+00 VAL_N= 0.960067E+08 VAL_L= 0.960067E+08
9463 !g_small_step_finish: ALPHA=.1000E-03 COEF= 0.1000000000001E+01 VAL_N= 0.960067E+06 VAL_L= 0.960067E+06
9464 !g_small_step_finish: ALPHA=.1000E-04 COEF= 0.1000000000010E+01 VAL_N= 0.960067E+04 VAL_L= 0.960067E+04
9465 !g_small_step_finish: ALPHA=.1000E-05 COEF= 0.9999999997936E+00 VAL_N= 0.960067E+02 VAL_L= 0.960067E+02
9466 !g_small_step_finish: ALPHA=.1000E-06 COEF= 0.1000000001029E+01 VAL_N= 0.960067E+00 VAL_L= 0.960067E+00
9467 !g_small_step_finish: ALPHA=.1000E-07 COEF= 0.9999999976363E+00 VAL_N= 0.960067E-02 VAL_L= 0.960067E-02
9468 !g_small_step_finish: ALPHA=.1000E-08 COEF= 0.1000000273437E+01 VAL_N= 0.960067E-04 VAL_L= 0.960067E-04
9469 !g_small_step_finish: ALPHA=.1000E-09 COEF= 0.1000000269678E+01 VAL_N= 0.960067E-06 VAL_L= 0.960067E-06
9470 !g_small_step_finish: ALPHA=.1000E-10 COEF= 0.1000003270830E+01 VAL_N= 0.960070E-08 VAL_L= 0.960067E-08
9471
9472 !a_small_step_finish: 0.9600668356832E+12 0.9600668356832E+12
9473
9474 END SUBROUTINE t_small_step_finish
9475 !-----------------------------------------------------------------------------------------------
9476 SUBROUTINE t_rk_scalar_tend ( scs, sce, config_flags, &
9477 rk_step, dt, &
9478 ru, rv, ww, mut, alt, &
9479 scalar, &
9480 scalar_tends, advect_tend, &
9481 RQVFTEN, &
9482 base, moist_step, fnm, fnp, &
9483 msfu, msfv, msft, &
9484 rdx, rdy, rdn, rdnw, &
9485 khdif, kvdif, xkmhd, &
9486 diff_6th_opt, diff_6th_rate, &
9487 ids, ide, jds, jde, kds, kde, &
9488 ims, ime, jms, jme, kms, kme, &
9489 its, ite, jts, jte, kts, kte )
9490
9491 ! Zaizhong Ma, April 4,2005
9492
9493 IMPLICIT NONE
9494
9495 ! Input data.
9496
9497 TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags
9498
9499 INTEGER , INTENT(IN ) :: rk_step, scs, sce
9500 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
9501 ims, ime, jms, jme, kms, kme, &
9502 its, ite, jts, jte, kts, kte
9503
9504 LOGICAL , INTENT(IN ) :: moist_step
9505
9506 REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce ), &
9507 INTENT(INOUT) :: scalar
9508
9509 REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce ), &
9510 INTENT( OUT) :: scalar_tends
9511
9512 REAL, DIMENSION(ims:ime, kms:kme, jms:jme ) :: advect_tend
9513
9514 REAL, DIMENSION(ims:ime, kms:kme, jms:jme ), INTENT(OUT ) :: RQVFTEN
9515
9516 REAL, DIMENSION(ims:ime, kms:kme, jms:jme ) :: ru, &
9517 rv, &
9518 ww, &
9519 xkmhd, &
9520 alt
9521
9522
9523 REAL , DIMENSION( kms:kme ) , INTENT(IN ) :: fnm, &
9524 fnp, &
9525 rdn, &
9526 rdnw, &
9527 base
9528
9529 REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msfu, &
9530 msfv, &
9531 msft
9532 REAL , DIMENSION( ims:ime , jms:jme ) :: mut
9533
9534
9535 REAL , INTENT(IN ) :: rdx, &
9536 rdy, &
9537 khdif, &
9538 kvdif
9539
9540 INTEGER, INTENT( IN ) :: diff_6th_opt
9541 REAL, INTENT( IN ) :: diff_6th_rate
9542
9543 REAL , INTENT(IN ) :: dt
9544
9545 ! Local data
9546
9547 INTEGER :: im, i,j,k
9548
9549 REAL :: khdq, kvdq, tendency
9550
9551 ! zzma: new definition
9552
9553 ! IN variables
9554
9555 REAL, DIMENSION(ims:ime, kms:kme, jms:jme ) :: S_ru, &
9556 S_rv, &
9557 S_ww, &
9558 S_advect_tend, &
9559 S_xkmhd, &
9560 S_alt
9561 REAL, DIMENSION(ims:ime, kms:kme, jms:jme ) :: P_ru, &
9562 P_rv, &
9563 P_ww, &
9564 P_advect_tend, &
9565 P_xkmhd, &
9566 P_alt
9567 REAL, DIMENSION(ims:ime, kms:kme, jms:jme ) :: B_ru, &
9568 B_rv, &
9569 B_ww, &
9570 B_advect_tend, &
9571 B_xkmhd, &
9572 B_alt
9573 REAL , DIMENSION( ims:ime , jms:jme ) :: S_mut,P_mut,B_mut
9574
9575 ! INOUT variables
9576
9577 REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce ) :: S_scalar, P_scalar
9578 REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce ) :: K_scalar, B_scalar
9579
9580 ! OUT variables
9581
9582 REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce ) :: P_scalar_tends,B_scalar_tends
9583
9584 REAL :: SAVE_L, COEF, ALPHA, FACTOR, VAL_N, VAL_L, VAL_A
9585 INTEGER :: NT,h
9586
9587 ! zzma: new definition end
9588
9589 !TGL test
9590
9591 do i=ims,ime
9592 do k=kms,kme
9593 do j=jms,jme
9594 S_ru(i,k,j)=ru(i,k,j)
9595 S_rv(i,k,j)=rv(i,k,j)
9596 S_ww(i,k,j)=ww(i,k,j)
9597 S_advect_tend(i,k,j)=advect_tend(i,k,j)
9598 S_xkmhd(i,k,j)=xkmhd(i,k,j)
9599 S_alt(i,k,j)=alt(i,k,j)
9600
9601 P_ru(i,k,j)=ru(i,k,j)
9602 P_rv(i,k,j)=rv(i,k,j)
9603 P_ww(i,k,j)=ww(i,k,j)
9604 P_advect_tend(i,k,j)=advect_tend(i,k,j)
9605 P_xkmhd(i,k,j)=xkmhd(i,k,j)
9606 P_alt(i,k,j)=alt(i,k,j)
9607 enddo
9608 enddo
9609 enddo
9610 do i=ims,ime
9611 do k=kms,kme
9612 do j=jms,jme
9613 do h=scs,sce
9614 S_scalar(i,k,j,h)=scalar(i,k,j,h)
9615
9616 P_scalar(i,k,j,h)=scalar(i,k,j,h)
9617
9618 K_scalar(i,k,j,h)=scalar(i,k,j,h)
9619 enddo
9620 enddo
9621 enddo
9622 enddo
9623
9624 !NLM
9625
9626 CALL rk_scalar_tend ( scs, sce, config_flags, &
9627 rk_step, dt, &
9628 ru, rv, ww, mut, alt, &
9629 scalar, &
9630 scalar_tends, advect_tend, &
9631 RQVFTEN, &
9632 base, moist_step, fnm, fnp, &
9633 msfu, msfv, msft, &
9634 rdx, rdy, rdn, rdnw, &
9635 khdif, kvdif, xkmhd, &
9636 diff_6th_opt, diff_6th_rate, &
9637 ids, ide, jds, jde, kds, kde, &
9638 ims, ime, jms, jme, kms, kme, &
9639 its, ite, jts, jte, kts, kte )
9640
9641 do i=ims,ime
9642 do k=kms,kme
9643 do j=jms,jme
9644 do h=scs,sce
9645 B_scalar_tends(i,k,j,h)=scalar_tends(i,k,j,h)
9646 enddo
9647 enddo
9648 enddo
9649 enddo
9650
9651 do i=ims,ime
9652 do k=kms,kme
9653 do j=jms,jme
9654 do h=scs,sce
9655 B_scalar(i,k,j,h)=scalar(i,k,j,h)
9656 enddo
9657 enddo
9658 enddo
9659 enddo
9660
9661 ! TCL
9662
9663 CALL g_rk_scalar_tend( scs, sce, config_flags, rk_step, ru, P_ru, rv, P_rv, ww, P_ww, mut, P_mut, alt, P_alt, &
9664 &K_scalar, P_scalar, scalar_tends, P_scalar_tends, advect_tend, P_advect_tend, base, moist_step, fnm, fnp, msfu, msfv, &
9665 &msft, rdx, rdy, rdn, rdnw, kvdif, xkmhd, P_xkmhd, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, &
9666 &jte, kts, kte )
9667
9668 SAVE_L=0.
9669 do i=ims,ime
9670 do k=kms,kme
9671 do j=jms,jme
9672 do h=scs,sce
9673 SAVE_L=SAVE_L + P_scalar_tends(i,k,j,h)*P_scalar_tends(i,k,j,h)
9674 enddo
9675 enddo
9676 enddo
9677 enddo
9678
9679 do i=ims,ime
9680 do k=kms,kme
9681 do j=jms,jme
9682 do h=scs,sce
9683 SAVE_L=SAVE_L + P_scalar(i,k,j,h)*P_scalar(i,k,j,h)
9684 enddo
9685 enddo
9686 enddo
9687 enddo
9688
9689 ALPHA=1.
9690 DO NT=1,11
9691 ALPHA=0.1*ALPHA
9692 FACTOR=1.+ALPHA
9693 do i=ims,ime
9694 do k=kms,kme
9695 do j=jms,jme
9696 P_ru(i,k,j)=FACTOR*S_ru(i,k,j)
9697 P_rv(i,k,j)=FACTOR*S_rv(i,k,j)
9698 P_ww(i,k,j)=FACTOR*S_ww(i,k,j)
9699 P_advect_tend(i,k,j)=FACTOR*S_advect_tend(i,k,j)
9700 P_alt(i,k,j)=FACTOR*S_alt(i,k,j)
9701 P_xkmhd(i,k,j)=FACTOR*S_xkmhd(i,k,j)
9702 enddo
9703 enddo
9704 enddo
9705 do i=ims,ime
9706 do k=kms,kme
9707 do j=jms,jme
9708 do h=scs,sce
9709 P_scalar(i,k,j,h)=FACTOR*S_scalar(i,k,j,h)
9710 enddo
9711 enddo
9712 enddo
9713 enddo
9714
9715 CALL rk_scalar_tend ( scs, sce, config_flags, &
9716 rk_step, dt, &
9717 P_ru, P_rv, P_ww, P_mut, P_alt, &
9718 P_scalar, &
9719 P_scalar_tends, P_advect_tend, &
9720 RQVFTEN, &
9721 base, moist_step, fnm, fnp, &
9722 msfu, msfv, msft, &
9723 rdx, rdy, rdn, rdnw, &
9724 khdif, kvdif, P_xkmhd, &
9725 diff_6th_opt, diff_6th_rate, &
9726 ids, ide, jds, jde, kds, kde, &
9727 ims, ime, jms, jme, kms, kme, &
9728 its, ite, jts, jte, kts, kte )
9729
9730 VAL_N=0.
9731 do i=ims,ime
9732 do k=kms,kme
9733 do j=jms,jme
9734 do h=scs,sce
9735 VAL_N=VAL_N+(P_scalar_tends(i,k,j,h) -B_scalar_tends(i,k,j,h))*(P_scalar_tends(i,k,j,h) -B_scalar_tends(i,k,j,h))
9736 enddo
9737 enddo
9738 enddo
9739 enddo
9740
9741 do i=ims,ime
9742 do k=kms,kme
9743 do j=jms,jme
9744 do h=scs,sce
9745 VAL_N=VAL_N+(P_scalar(i,k,j,h) -B_scalar(i,k,j,h))*(P_scalar(i,k,j,h) -B_scalar(i,k,j,h))
9746 enddo
9747 enddo
9748 enddo
9749 enddo
9750
9751 VAL_L=SAVE_L*ALPHA**2
9752 COEF=VAL_N/VAL_L
9753 WRITE(6, fmt='(A,E9.4,A,E22.13,A,E13.6,A,E13.6)') &
9754 'g_rk_scalar_tend: ALPHA=',ALPHA,' COEF=',COEF, &
9755 ' VAL_N=',VAL_N,' VAL_L=',VAL_L
9756 ENDDO
9757
9758 ! ADJ test
9759
9760 FACTOR=0.1
9761 do i=ims,ime
9762 do k=kms,kme
9763 do j=jms,jme
9764 ru(i,k,j)=S_ru(i,k,j)
9765 rv(i,k,j)=S_rv(i,k,j)
9766 ww(i,k,j)=S_ww(i,k,j)
9767 advect_tend(i,k,j)=S_advect_tend(i,k,j)
9768 xkmhd(i,k,j)=S_xkmhd(i,k,j)
9769 alt(i,k,j)=S_alt(i,k,j)
9770
9771 P_ru(i,k,j)=FACTOR*S_ru(i,k,j)
9772 P_rv(i,k,j)=FACTOR*S_rv(i,k,j)
9773 P_ww(i,k,j)=FACTOR*S_ww(i,k,j)
9774 P_advect_tend(i,k,j)=FACTOR*S_advect_tend(i,k,j)
9775 P_alt(i,k,j)=FACTOR*S_alt(i,k,j)
9776 P_xkmhd(i,k,j)=FACTOR*S_xkmhd(i,k,j)
9777
9778 B_ru(i,k,j)=P_ru(i,k,j)
9779 B_rv(i,k,j)=P_rv(i,k,j)
9780 B_advect_tend(i,k,j)=P_advect_tend(i,k,j)
9781 B_ww(i,k,j)=P_ww(i,k,j)
9782 B_alt(i,k,j)=P_alt(i,k,j)
9783 B_xkmhd(i,k,j)=P_xkmhd(i,k,j)
9784 enddo
9785 enddo
9786 enddo
9787 do i=ims,ime
9788 do k=kms,kme
9789 do j=jms,jme
9790 do h=scs,sce
9791 scalar(i,k,j,h)=S_scalar(i,k,j,h)
9792
9793 P_scalar(i,k,j,h)=FACTOR*S_scalar(i,k,j,h)
9794
9795 B_scalar(i,k,j,h)=P_scalar(i,k,j,h)
9796
9797 K_scalar(i,k,j,h)=scalar(i,k,j,h)
9798 enddo
9799 enddo
9800 enddo
9801 enddo
9802
9803 ! TGL
9804
9805 CALL g_rk_scalar_tend( scs, sce, config_flags, rk_step, ru, P_ru, rv, P_rv, ww, P_ww, mut, P_mut, alt, P_alt, &
9806 &scalar, P_scalar, scalar_tends, P_scalar_tends, advect_tend, P_advect_tend, base, moist_step, fnm, fnp, msfu, msfv, &
9807 &msft, rdx, rdy, rdn, rdnw, kvdif, xkmhd, P_xkmhd, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, &
9808 &jte, kts, kte )
9809
9810 VAL_L=0.
9811 do i=ims,ime
9812 do k=kms,kme
9813 do j=jms,jme
9814 do h=scs,sce
9815 VAL_L=VAL_L + P_scalar_tends(i,k,j,h)*P_scalar_tends(i,k,j,h)
9816 enddo
9817 enddo
9818 enddo
9819 enddo
9820
9821 do i=ims,ime
9822 do k=kms,kme
9823 do j=jms,jme
9824 do h=scs,sce
9825 VAL_L=VAL_L + P_scalar(i,k,j,h)*P_scalar(i,k,j,h)
9826 enddo
9827 enddo
9828 enddo
9829 enddo
9830
9831 do i=ims,ime
9832 do k=kms,kme
9833 do j=jms,jme
9834 P_ru(i,k,j)=0.0
9835 P_rv(i,k,j)=0.0
9836 P_ww(i,k,j)=0.0
9837 P_advect_tend(i,k,j)=0.0
9838 P_alt(i,k,j)=0.0
9839 P_xkmhd(i,k,j)=0.0
9840 enddo
9841 enddo
9842 enddo
9843
9844 ! ADJ
9845
9846 CALL a_rk_scalar_tend( scs, sce, config_flags, rk_step, ru, P_ru, rv, P_rv, ww, P_ww, mut, P_mut, alt, P_alt, &
9847 &K_scalar, P_scalar, P_scalar_tends, P_advect_tend, base, moist_step, fnm, fnp, msfu, msfv, msft, rdx, rdy, rdn, rdnw, &
9848 &kvdif, xkmhd, P_xkmhd, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
9849
9850
9851 VAL_A=0.
9852 do i=ims,ime
9853 do k=kms,kme
9854 do j=jms,jme
9855 VAL_A=VAL_A +P_ru(i,k,j)*B_ru(i,k,j) &
9856 +P_rv(i,k,j)*B_rv(i,k,j) &
9857 +P_ww(i,k,j)*B_ww(i,k,j) &
9858 +P_advect_tend(i,k,j)*B_advect_tend(i,k,j) &
9859 +P_alt(i,k,j)*B_alt(i,k,j) &
9860 +P_xkmhd(i,k,j)*B_xkmhd(i,k,j)
9861 enddo
9862 enddo
9863 enddo
9864 do i=ims,ime
9865 do k=kms,kme
9866 do j=jms,jme
9867 do h=scs,sce
9868 VAL_A=VAL_A +P_scalar(i,k,j,h)*B_scalar(i,k,j,h)
9869 enddo
9870 enddo
9871 enddo
9872 enddo
9873
9874 print*, ' '
9875 write(6,fmt='(A,2E22.13)') 'a_rk_scalar_tend: ', VAL_L,VAL_A
9876
9877 ! RECOVER
9878
9879
9880 do i=ims,ime
9881 do k=kms,kme
9882 do j=jms,jme
9883 ru(i,k,j)=S_ru(i,k,j)
9884 rv(i,k,j)=S_rv(i,k,j)
9885 ww(i,k,j)=S_ww(i,k,j)
9886 advect_tend(i,k,j)=S_advect_tend(i,k,j)
9887 xkmhd(i,k,j)=S_xkmhd(i,k,j)
9888 alt(i,k,j)=S_alt(i,k,j)
9889 enddo
9890 enddo
9891 enddo
9892 do i=ims,ime
9893 do k=kms,kme
9894 do j=jms,jme
9895 do h=scs,sce
9896 scalar(i,k,j,h)=S_scalar(i,k,j,h)
9897 enddo
9898 enddo
9899 enddo
9900 enddo
9901
9902 !g_rk_scalar_tend: ALPHA=.1000E+00 COEF= 0.9997231364250E+00 VAL_N= 0.307437E-01 VAL_L= 0.307522E-01
9903 !g_rk_scalar_tend: ALPHA=.1000E-01 COEF= 0.9999352693558E+00 VAL_N= 0.307502E-03 VAL_L= 0.307522E-03
9904 !g_rk_scalar_tend: ALPHA=.1000E-02 COEF= 0.9999766945839E+00 VAL_N= 0.307515E-05 VAL_L= 0.307522E-05
9905 !g_rk_scalar_tend: ALPHA=.1000E-03 COEF= 0.1000588893890E+01 VAL_N= 0.307703E-07 VAL_L= 0.307522E-07
9906 !g_rk_scalar_tend: ALPHA=.1000E-04 COEF= 0.1067813396454E+01 VAL_N= 0.328376E-09 VAL_L= 0.307522E-09
9907 !g_rk_scalar_tend: ALPHA=.1000E-05 COEF= 0.7152854919434E+01 VAL_N= 0.219966E-10 VAL_L= 0.307522E-11
9908 !g_rk_scalar_tend: ALPHA=.1000E-06 COEF= 0.6295269775391E+03 VAL_N= 0.193594E-10 VAL_L= 0.307522E-13
9909 !g_rk_scalar_tend: ALPHA=.1000E-07 COEF= 0.6282780078125E+05 VAL_N= 0.193210E-10 VAL_L= 0.307522E-15
9910 !g_rk_scalar_tend: ALPHA=.1000E-08 COEF= 0.6282780000000E+07 VAL_N= 0.193210E-10 VAL_L= 0.307522E-17
9911 !g_rk_scalar_tend: ALPHA=.1000E-09 COEF= 0.6282778880000E+09 VAL_N= 0.193210E-10 VAL_L= 0.307522E-19
9912 !g_rk_scalar_tend: ALPHA=.1000E-10 COEF= 0.6282778624000E+11 VAL_N= 0.193210E-10 VAL_L= 0.307522E-21
9913
9914 !a_rk_scalar_tend: 0.3074371442199E-01 0.3074371442199E-01
9915
9916 !g_rk_scalar_tend: ALPHA=.1000E+00 COEF= 0.1000000000628E+01 VAL_N= 0.307533E-01 VAL_L= 0.307533E-01
9917 !g_rk_scalar_tend: ALPHA=.1000E-01 COEF= 0.1000000062825E+01 VAL_N= 0.307533E-03 VAL_L= 0.307533E-03
9918 !g_rk_scalar_tend: ALPHA=.1000E-02 COEF= 0.1000006282450E+01 VAL_N= 0.307535E-05 VAL_L= 0.307533E-05
9919 !g_rk_scalar_tend: ALPHA=.1000E-03 COEF= 0.1000628245062E+01 VAL_N= 0.307726E-07 VAL_L= 0.307533E-07
9920 !g_rk_scalar_tend: ALPHA=.1000E-04 COEF= 0.1062824506169E+01 VAL_N= 0.326854E-09 VAL_L= 0.307533E-09
9921 !g_rk_scalar_tend: ALPHA=.1000E-05 COEF= 0.7282450615443E+01 VAL_N= 0.223959E-10 VAL_L= 0.307533E-11
9922 !g_rk_scalar_tend: ALPHA=.1000E-06 COEF= 0.6292450615583E+03 VAL_N= 0.193514E-10 VAL_L= 0.307533E-13
9923 !g_rk_scalar_tend: ALPHA=.1000E-07 COEF= 0.6282550615548E+05 VAL_N= 0.193209E-10 VAL_L= 0.307533E-15
9924 !g_rk_scalar_tend: ALPHA=.1000E-08 COEF= 0.6282451615549E+07 VAL_N= 0.193206E-10 VAL_L= 0.307533E-17
9925 !g_rk_scalar_tend: ALPHA=.1000E-09 COEF= 0.6282450625547E+09 VAL_N= 0.193206E-10 VAL_L= 0.307533E-19
9926 !g_rk_scalar_tend: ALPHA=.1000E-10 COEF= 0.6282450615649E+11 VAL_N= 0.193206E-10 VAL_L= 0.307533E-21
9927
9928 !a_rk_scalar_tend: 0.3075329603091E-01 0.3075329603091E-01
9929
9930 END SUBROUTINE t_rk_scalar_tend
9931 !-----------------------------------------------------------------------------------------------
9932 SUBROUTINE t_spec_bdy_scalar ( scalar_tend, &
9933 scalar_b, scalar_bt, &
9934 spec_bdy_width, spec_zone, &
9935 config_flags, &
9936 ijds, ijde, & ! min/max(id,jd)
9937 ids,ide, jds,jde, kds,kde, & ! domain dims
9938 ims,ime, jms,jme, kms,kme, & ! memory dims
9939 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
9940 its, ite, jts, jte, kts, kte)
9941
9942 ! Zaizhong Ma, April 5,2005
9943 ! Qingnong Xiao, rewritten, April 2005.
9944
9945 IMPLICIT NONE
9946
9947 ! Input data.
9948 TYPE( grid_config_rec_type ) config_flags
9949
9950
9951 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
9952 ims, ime, jms, jme, kms, kme, &
9953 ips, ipe, jps, jpe, kps, kpe, &
9954 its, ite, jts, jte, kts, kte
9955 INTEGER , INTENT(IN ) :: ijds, ijde
9956 INTEGER , INTENT(IN ) :: spec_bdy_width, spec_zone
9957
9958 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(OUT ) :: scalar_tend
9959 REAL, DIMENSION( ijds:ijde , kds:kde , spec_bdy_width, 4 ), INTENT(IN ) :: scalar_b
9960 REAL, DIMENSION( ijds:ijde , kds:kde , spec_bdy_width, 4 ) :: scalar_bt
9961 !Local
9962 INTEGER :: i,j,k
9963
9964 ! zzma: new definition
9965
9966 ! IN variables
9967
9968 REAL, DIMENSION( ijds:ijde , kds:kde , spec_bdy_width, 4 ) :: S_scalar_bt,P_scalar_bt,B_scalar_bt
9969
9970 ! OUT variables
9971
9972 REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) :: S_scalar_tend,P_scalar_tend,B_scalar_tend
9973
9974 REAL :: SAVE_L, COEF, ALPHA, FACTOR, VAL_N, VAL_L, VAL_A
9975 INTEGER :: NT,h
9976
9977 ! zzma: new definition end
9978
9979 !TGL test
9980
9981 S_scalar_bt(:,:,:,:)=scalar_bt(:,:,:,:)
9982 P_scalar_bt(:,:,:,:)=scalar_bt(:,:,:,:)
9983
9984 S_scalar_tend(:,:,:)=scalar_tend(:,:,:)
9985 p_scalar_tend(:,:,:)=scalar_tend(:,:,:)
9986
9987 !NLM
9988
9989 CALL spec_bdy_scalar ( scalar_tend, &
9990 scalar_b, scalar_bt, &
9991 spec_bdy_width, spec_zone, &
9992 config_flags, &
9993 ijds, ijde, & ! min/max(id,jd)
9994 ids,ide, jds,jde, kds,kde, & ! domain dims
9995 ims,ime, jms,jme, kms,kme, & ! memory dims
9996 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
9997 its, ite, jts, jte, kts, kte)
9998
9999 B_scalar_bt(:,:,:,:)=scalar_bt(:,:,:,:)
10000 B_scalar_tend(:,:,:)=scalar_tend(:,:,:)
10001
10002 ! TCL
10003
10004 scalar_bt(:,:,:,:)=S_scalar_bt(:,:,:,:)
10005 scalar_tend(:,:,:)=S_scalar_tend(:,:,:)
10006
10007 CALL g_spec_bdy_scalar( scalar_tend, P_scalar_tend, scalar_bt, P_scalar_bt, spec_bdy_width, spec_zone, ijds, ijde, ids, ide, &
10008 &jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
10009
10010 SAVE_L=sum(P_scalar_tend(:,:,:)*P_scalar_tend(:,:,:)) + &
10011 sum(P_scalar_bt(:,:,:,:)*P_scalar_bt(:,:,:,:))
10012
10013 ALPHA=1.
10014 DO NT=1,11
10015 ALPHA=0.1*ALPHA
10016 FACTOR=1.+ALPHA
10017 P_scalar_bt(:,:,:,:)=FACTOR*S_scalar_bt(:,:,:,:)
10018 P_scalar_tend(:,:,:)=FACTOR*S_scalar_tend(:,:,:)
10019
10020 CALL spec_bdy_scalar ( P_scalar_tend, &
10021 scalar_b, P_scalar_bt, &
10022 spec_bdy_width, spec_zone, &
10023 config_flags, &
10024 ijds, ijde, & ! min/max(id,jd)
10025 ids,ide, jds,jde, kds,kde, & ! domain dims
10026 ims,ime, jms,jme, kms,kme, & ! memory dims
10027 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
10028 its, ite, jts, jte, kts, kte)
10029
10030
10031 VAL_N= sum((P_scalar_tend(:,:,:)-B_scalar_tend(:,:,:))*(P_scalar_tend(:,:,:)-B_scalar_tend(:,:,:))) + &
10032 sum((P_scalar_bt(:,:,:,:)-B_scalar_bt(:,:,:,:))*(P_scalar_bt(:,:,:,:)-B_scalar_bt(:,:,:,:)))
10033
10034 VAL_L=SAVE_L*ALPHA**2
10035 COEF=VAL_N/VAL_L
10036 WRITE(6, fmt='(A,E9.4,A,E22.13,A,E13.6,A,E13.6)') &
10037 'g_spec_bdy_scalar: ALPHA=',ALPHA,' COEF=',COEF, &
10038 ' VAL_N=',VAL_N,' VAL_L=',VAL_L
10039 ENDDO
10040
10041 ! ADJ test
10042
10043 FACTOR=0.1
10044 scalar_bt(:,:,:,:)=S_scalar_bt(:,:,:,:)
10045 scalar_tend(:,:,:)=S_scalar_tend(:,:,:)
10046 P_scalar_bt(:,:,:,:)=FACTOR*S_scalar_bt(:,:,:,:)
10047 P_scalar_tend(:,:,:)=FACTOR*S_scalar_tend(:,:,:)
10048 B_scalar_bt(:,:,:,:)=P_scalar_bt(:,:,:,:)
10049 B_scalar_tend(:,:,:)=P_scalar_tend(:,:,:)
10050
10051 CALL g_spec_bdy_scalar( scalar_tend, P_scalar_tend, scalar_bt, P_scalar_bt, spec_bdy_width, spec_zone, ijds, ijde, ids, ide, &
10052 &jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
10053
10054 VAL_L=sum(P_scalar_tend(:,:,:)*P_scalar_tend(:,:,:))+ &
10055 sum(P_scalar_bt(:,:,:,:)*P_scalar_bt(:,:,:,:))
10056
10057 ! ADJ
10058
10059 CALL a_spec_bdy_scalar( P_scalar_tend, P_scalar_bt, spec_bdy_width, spec_zone, ijds, ijde, ids, ide, jds, jde, kds, kde, ims,&
10060 & ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
10061
10062 VAL_A=sum(P_scalar_bt(:,:,:,:)*B_scalar_bt(:,:,:,:)) + &
10063 sum(P_scalar_tend(:,:,:)*B_scalar_tend(:,:,:))
10064
10065 print*, ' '
10066 write(6,fmt='(A,2E22.13)') 'a_spec_bdy_scalar: ', VAL_L,VAL_A
10067
10068 ! RECOVER
10069
10070 scalar_bt(:,:,:,:)=S_scalar_bt(:,:,:,:)
10071 scalar_tend(:,:,:)=S_scalar_tend(:,:,:)
10072
10073 END SUBROUTINE t_spec_bdy_scalar
10074
10075 !-----------------------------------------------------------------------------------------------
10076
10077 SUBROUTINE t_rk_update_scalar( scs, sce, &
10078 scalar_1, scalar_2, sc_tend, &
10079 advect_tend, msft, &
10080 mu_old, mu_new, mu_base, &
10081 rk_step, dt, spec_zone, &
10082 config_flags, &
10083 ids, ide, jds, jde, kds, kde, &
10084 ims, ime, jms, jme, kms, kme, &
10085 its, ite, jts, jte, kts, kte )
10086
10087 ! Zaizhong Ma, April 5,2005
10088
10089 IMPLICIT NONE
10090
10091 ! Input data.
10092
10093 TYPE(grid_config_rec_type ) , INTENT(IN ) :: config_flags
10094
10095 INTEGER , INTENT(IN ) :: scs, sce, rk_step, spec_zone
10096 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
10097 ims, ime, jms, jme, kms, kme, &
10098 its, ite, jts, jte, kts, kte
10099
10100 REAL, INTENT(IN ) :: dt
10101
10102 REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce), &
10103 INTENT(INOUT) :: scalar_1, &
10104 scalar_2, &
10105 sc_tend
10106
10107 REAL, DIMENSION(ims:ime, kms:kme, jms:jme ) :: advect_tend
10108 REAL, DIMENSION(ims:ime, jms:jme ) :: mu_old, mu_new
10109
10110 REAL, DIMENSION(ims:ime, jms:jme ), INTENT(IN ) :: mu_base, &
10111 msft
10112
10113 INTEGER :: i,j,k,im
10114 REAL :: sc_middle, msfsq
10115 REAL, DIMENSION(its:ite) :: muold, r_munew
10116
10117 REAL, DIMENSION(its:ite, kts:kte, jts:jte ) :: tendency
10118
10119 INTEGER :: i_start,i_end,j_start,j_end,k_start,k_end
10120 INTEGER :: i_start_spc,i_end_spc,j_start_spc,j_end_spc,k_start_spc,k_end_spc
10121
10122 ! zzma: new definition
10123
10124 ! IN variables
10125
10126 REAL, DIMENSION(ims:ime, kms:kme, jms:jme ) :: S_advect_tend,P_advect_tend,B_advect_tend
10127 REAL, DIMENSION(ims:ime, jms:jme ) :: S_mu_old, S_mu_new,P_mu_old, P_mu_new,B_mu_old, B_mu_new
10128
10129 ! INOUT variables
10130
10131 REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce) :: S_scalar_1, S_scalar_2, S_sc_tend,P_scalar_1, P_scalar_2, P_sc_tend
10132 REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce) :: K_scalar_1, K_scalar_2, K_sc_tend,B_scalar_1, B_scalar_2, B_sc_tend
10133
10134
10135 REAL :: SAVE_L, COEF, ALPHA, FACTOR, VAL_N, VAL_L, VAL_A
10136 INTEGER :: NT,h
10137
10138 ! zzma: new definition end
10139
10140 !TGL test
10141
10142
10143 do i=ims,ime
10144 do k=kms,kme
10145 do j=jms,jme
10146 S_advect_tend(i,k,j)=advect_tend(i,k,j)
10147
10148 P_advect_tend(i,k,j)=advect_tend(i,k,j)
10149 enddo
10150 enddo
10151 enddo
10152 do i=ims,ime
10153 do j=jms,jme
10154 S_mu_old(i,j)=mu_old(i,j)
10155 S_mu_new(i,j)=mu_new(i,j)
10156
10157 P_mu_old(i,j)=mu_old(i,j)
10158 P_mu_new(i,j)=mu_new(i,j)
10159 enddo
10160 enddo
10161 do i=ims,ime
10162 do k=kms,kme
10163 do j=jms,jme
10164 do h=scs,sce
10165 S_scalar_1(i,k,j,h)=scalar_1(i,k,j,h)
10166 S_scalar_2(i,k,j,h)=scalar_2(i,k,j,h)
10167 S_sc_tend(i,k,j,h)=sc_tend(i,k,j,h)
10168
10169 P_scalar_1(i,k,j,h)=scalar_1(i,k,j,h)
10170 P_scalar_2(i,k,j,h)=scalar_2(i,k,j,h)
10171 P_sc_tend(i,k,j,h)=sc_tend(i,k,j,h)
10172
10173 K_scalar_1(i,k,j,h)=scalar_1(i,k,j,h)
10174 K_scalar_2(i,k,j,h)=scalar_2(i,k,j,h)
10175 K_sc_tend(i,k,j,h)=sc_tend(i,k,j,h)
10176 enddo
10177 enddo
10178 enddo
10179 enddo
10180
10181 !NLM
10182
10183 CALL rk_update_scalar( scs, sce, &
10184 scalar_1, scalar_2, sc_tend, &
10185 advect_tend, msft, &
10186 mu_old, mu_new, mu_base, &
10187 rk_step, dt, spec_zone, &
10188 config_flags, &
10189 ids, ide, jds, jde, kds, kde, &
10190 ims, ime, jms, jme, kms, kme, &
10191 its, ite, jts, jte, kts, kte )
10192
10193 do i=ims,ime
10194 do k=kms,kme
10195 do j=jms,jme
10196 do h=scs,sce
10197 B_scalar_1(i,k,j,h)=scalar_1(i,k,j,h)
10198 B_scalar_2(i,k,j,h)=scalar_2(i,k,j,h)
10199 B_sc_tend(i,k,j,h)=sc_tend(i,k,j,h)
10200 enddo
10201 enddo
10202 enddo
10203 enddo
10204
10205 ! TCL
10206
10207 CALL g_rk_update_scalar( scs, sce, K_scalar_1, P_scalar_1, K_scalar_2, P_scalar_2, K_sc_tend, P_sc_tend, advect_tend, &
10208 &P_advect_tend, msft, mu_old, P_mu_old, mu_new, P_mu_new, mu_base, rk_step, dt, spec_zone, config_flags, ids, ide,&
10209 & jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
10210
10211 SAVE_L=0.
10212 do i=ims,ime
10213 do k=kms,kme
10214 do j=jms,jme
10215 do h=scs,sce
10216 SAVE_L=SAVE_L + P_scalar_1(i,k,j,h)*P_scalar_1(i,k,j,h) &
10217 + P_scalar_2(i,k,j,h)*P_scalar_2(i,k,j,h) &
10218 + P_sc_tend(i,k,j,h)*P_sc_tend(i,k,j,h)
10219 enddo
10220 enddo
10221 enddo
10222 enddo
10223
10224 ALPHA=1.
10225 DO NT=1,11
10226 ALPHA=0.1*ALPHA
10227 FACTOR=1.+ALPHA
10228 do i=ims,ime
10229 do k=kms,kme
10230 do j=jms,jme
10231 P_advect_tend(i,k,j)=FACTOR*S_advect_tend(i,k,j)
10232 enddo
10233 enddo
10234 enddo
10235 do i=ims,ime
10236 do j=jms,jme
10237 P_mu_old(i,j)=FACTOR*S_mu_old(i,j)
10238 P_mu_new(i,j)=FACTOR*S_mu_new(i,j)
10239 enddo
10240 enddo
10241 do i=ims,ime
10242 do k=kms,kme
10243 do j=jms,jme
10244 do h=scs,sce
10245 P_scalar_1(i,k,j,h)=FACTOR*S_scalar_1(i,k,j,h)
10246 P_scalar_2(i,k,j,h)=FACTOR*S_scalar_2(i,k,j,h)
10247 P_sc_tend(i,k,j,h)=FACTOR*S_sc_tend(i,k,j,h)
10248 enddo
10249 enddo
10250 enddo
10251 enddo
10252
10253 CALL rk_update_scalar( scs, sce, &
10254 P_scalar_1, P_scalar_2, P_sc_tend, &
10255 P_advect_tend, msft, &
10256 P_mu_old, P_mu_new, mu_base, &
10257 rk_step, dt, spec_zone, &
10258 config_flags, &
10259 ids, ide, jds, jde, kds, kde, &
10260 ims, ime, jms, jme, kms, kme, &
10261 its, ite, jts, jte, kts, kte )
10262
10263 VAL_N=0.
10264 do i=ims,ime
10265 do k=kms,kme
10266 do j=jms,jme
10267 do h=scs,sce
10268 VAL_N=VAL_N+(P_scalar_1(i,k,j,h)-B_scalar_1(i,k,j,h))*(P_scalar_1(i,k,j,h)-B_scalar_1(i,k,j,h)) &
10269 +(P_scalar_2(i,k,j,h)-B_scalar_2(i,k,j,h))*(P_scalar_2(i,k,j,h)-B_scalar_2(i,k,j,h)) &
10270 +(P_sc_tend(i,k,j,h) -B_sc_tend(i,k,j,h))*(P_sc_tend(i,k,j,h) -B_sc_tend(i,k,j,h))
10271 enddo
10272 enddo
10273 enddo
10274 enddo
10275
10276 VAL_L=SAVE_L*ALPHA**2
10277 COEF=VAL_N/VAL_L
10278 WRITE(6, fmt='(A,E9.4,A,E22.13,A,E13.6,A,E13.6)') &
10279 'g_rk_update_scalar: ALPHA=',ALPHA,' COEF=',COEF, &
10280 ' VAL_N=',VAL_N,' VAL_L=',VAL_L
10281 ENDDO
10282
10283 ! ADJ test
10284
10285 FACTOR=0.1
10286 do i=ims,ime
10287 do k=kms,kme
10288 do j=jms,jme
10289 advect_tend(i,k,j)=S_advect_tend(i,k,j)
10290
10291 P_advect_tend(i,k,j)=FACTOR*S_advect_tend(i,k,j)
10292
10293 B_advect_tend(i,k,j)=P_advect_tend(i,k,j)
10294 enddo
10295 enddo
10296 enddo
10297 do i=ims,ime
10298 do j=jms,jme
10299 mu_old(i,j)=S_mu_old(i,j)
10300 mu_new(i,j)=S_mu_new(i,j)
10301
10302 P_mu_old(i,j)=FACTOR*S_mu_old(i,j)
10303 P_mu_new(i,j)=FACTOR*S_mu_new(i,j)
10304
10305 B_mu_old(i,j)=P_mu_old(i,j)
10306 B_mu_new(i,j)=P_mu_new(i,j)
10307 enddo
10308 enddo
10309 do i=ims,ime
10310 do k=kms,kme
10311 do j=jms,jme
10312 do h=scs,sce
10313 scalar_1(i,k,j,h)=S_scalar_1(i,k,j,h)
10314 scalar_2(i,k,j,h)=S_scalar_2(i,k,j,h)
10315 sc_tend(i,k,j,h)=S_sc_tend(i,k,j,h)
10316
10317 P_scalar_1(i,k,j,h)=FACTOR*S_scalar_1(i,k,j,h)
10318 P_scalar_2(i,k,j,h)=FACTOR*S_scalar_2(i,k,j,h)
10319 P_sc_tend(i,k,j,h)=FACTOR*S_sc_tend(i,k,j,h)
10320
10321 B_scalar_1(i,k,j,h)=P_scalar_1(i,k,j,h)
10322 B_scalar_2(i,k,j,h)=P_scalar_2(i,k,j,h)
10323 B_sc_tend(i,k,j,h)=P_sc_tend(i,k,j,h)
10324
10325 K_scalar_1(i,k,j,h)=scalar_1(i,k,j,h)
10326 K_scalar_2(i,k,j,h)=scalar_2(i,k,j,h)
10327 K_sc_tend(i,k,j,h)=sc_tend(i,k,j,h)
10328 enddo
10329 enddo
10330 enddo
10331 enddo
10332
10333 ! TGL
10334
10335 CALL g_rk_update_scalar( scs, sce, scalar_1, P_scalar_1, scalar_2, P_scalar_2, sc_tend, P_sc_tend, advect_tend, &
10336 &P_advect_tend, msft, mu_old, P_mu_old, mu_new, P_mu_new, mu_base, rk_step, dt, spec_zone, config_flags, ids, ide,&
10337 & jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
10338
10339 VAL_L=0.
10340 do i=ims,ime
10341 do k=kms,kme
10342 do j=jms,jme
10343 do h=scs,sce
10344 VAL_L=VAL_L + P_scalar_1(i,k,j,h)*P_scalar_1(i,k,j,h) &
10345 + P_scalar_2(i,k,j,h)*P_scalar_2(i,k,j,h) &
10346 + P_sc_tend(i,k,j,h)*P_sc_tend(i,k,j,h)
10347 enddo
10348 enddo
10349 enddo
10350 enddo
10351 do i=ims,ime
10352 do k=kms,kme
10353 do j=jms,jme
10354 P_advect_tend(i,k,j)=0.0
10355 enddo
10356 enddo
10357 enddo
10358 do i=ims,ime
10359 do j=jms,jme
10360 P_mu_old(i,j)=0.0
10361 P_mu_new(i,j)=0.0
10362 enddo
10363 enddo
10364
10365 ! ADJ
10366
10367 CALL a_rk_update_scalar( scs, sce, K_scalar_1, P_scalar_1, K_scalar_2, P_scalar_2, K_sc_tend, P_sc_tend, advect_tend, &
10368 &P_advect_tend, msft, mu_old, P_mu_old, mu_new, P_mu_new, mu_base, rk_step, dt, spec_zone, config_flags, ids, ide,&
10369 & jds, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
10370
10371 VAL_A=0.
10372 do i=ims,ime
10373 do k=kms,kme
10374 do j=jms,jme
10375 VAL_A=VAL_A +P_advect_tend(i,k,j)*B_advect_tend(i,k,j)
10376 enddo
10377 enddo
10378 enddo
10379 do i=ims,ime
10380 do j=jms,jme
10381 VAL_A=VAL_A +P_mu_old(i,j)*B_mu_old(i,j) &
10382 +P_mu_new(i,j)*B_mu_new(i,j)
10383 enddo
10384 enddo
10385 do i=ims,ime
10386 do k=kms,kme
10387 do j=jms,jme
10388 do h=scs,sce
10389 VAL_A=VAL_A + P_scalar_1(i,k,j,h)*B_scalar_1(i,k,j,h) &
10390 + P_scalar_2(i,k,j,h)*B_scalar_2(i,k,j,h) &
10391 + P_sc_tend(i,k,j,h)*B_sc_tend(i,k,j,h)
10392 enddo
10393 enddo
10394 enddo
10395 enddo
10396
10397 print*, ' '
10398 write(6,fmt='(A,2E22.13)') 'a_rk_update_scalar: ', VAL_L,VAL_A
10399
10400 ! RECOVER
10401
10402 do i=ims,ime
10403 do k=kms,kme
10404 do j=jms,jme
10405 advect_tend(i,k,j)=S_advect_tend(i,k,j)
10406 enddo
10407 enddo
10408 enddo
10409 do i=ims,ime
10410 do j=jms,jme
10411 mu_old(i,j)=S_mu_old(i,j)
10412 mu_new(i,j)=S_mu_new(i,j)
10413 enddo
10414 enddo
10415 do i=ims,ime
10416 do k=kms,kme
10417 do j=jms,jme
10418 do h=scs,sce
10419 scalar_1(i,k,j,h)=S_scalar_1(i,k,j,h)
10420 scalar_2(i,k,j,h)=S_scalar_2(i,k,j,h)
10421 sc_tend(i,k,j,h)=S_sc_tend(i,k,j,h)
10422 enddo
10423 enddo
10424 enddo
10425 enddo
10426
10427 !g_rk_update_scalar: ALPHA=.1000E+00 COEF= 0.9997228980064E+00 VAL_N= 0.307440E-01 VAL_L= 0.307526E-01
10428 !g_rk_update_scalar: ALPHA=.1000E-01 COEF= 0.9999256134033E+00 VAL_N= 0.307503E-03 VAL_L= 0.307526E-03
10429 !g_rk_update_scalar: ALPHA=.1000E-02 COEF= 0.9999616742134E+00 VAL_N= 0.307514E-05 VAL_L= 0.307526E-05
10430 !g_rk_update_scalar: ALPHA=.1000E-03 COEF= 0.9997097849846E+00 VAL_N= 0.307436E-07 VAL_L= 0.307526E-07
10431 !g_rk_update_scalar: ALPHA=.1000E-04 COEF= 0.1002490162849E+01 VAL_N= 0.308291E-09 VAL_L= 0.307526E-09
10432 !g_rk_update_scalar: ALPHA=.1000E-05 COEF= 0.8739548921585E+00 VAL_N= 0.268764E-11 VAL_L= 0.307526E-11
10433 !g_rk_update_scalar: ALPHA=.1000E-06 COEF= 0.1635856509209E+01 VAL_N= 0.503068E-13 VAL_L= 0.307526E-13
10434 !g_rk_update_scalar: ALPHA=.1000E-07 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.307526E-15
10435 !g_rk_update_scalar: ALPHA=.1000E-08 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.307526E-17
10436 !g_rk_update_scalar: ALPHA=.1000E-09 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.307526E-19
10437 !g_rk_update_scalar: ALPHA=.1000E-10 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.307526E-21
10438
10439 !a_rk_update_scalar: 0.3074402920902E-01 0.3075052797794E-01
10440
10441 !g_rk_update_scalar: ALPHA=.1000E+00 COEF= 0.1000001003829E+01 VAL_N= 0.307535E-01 VAL_L= 0.307535E-01
10442 !g_rk_update_scalar: ALPHA=.1000E-01 COEF= 0.1000000096620E+01 VAL_N= 0.307535E-03 VAL_L= 0.307535E-03
10443 !g_rk_update_scalar: ALPHA=.1000E-02 COEF= 0.1000000009624E+01 VAL_N= 0.307535E-05 VAL_L= 0.307535E-05
10444 !g_rk_update_scalar: ALPHA=.1000E-03 COEF= 0.1000000000962E+01 VAL_N= 0.307535E-07 VAL_L= 0.307535E-07
10445 !g_rk_update_scalar: ALPHA=.1000E-04 COEF= 0.1000000000106E+01 VAL_N= 0.307535E-09 VAL_L= 0.307535E-09
10446 !g_rk_update_scalar: ALPHA=.1000E-05 COEF= 0.9999999999299E+00 VAL_N= 0.307535E-11 VAL_L= 0.307535E-11
10447 !g_rk_update_scalar: ALPHA=.1000E-06 COEF= 0.1000000001150E+01 VAL_N= 0.307535E-13 VAL_L= 0.307535E-13
10448 !g_rk_update_scalar: ALPHA=.1000E-07 COEF= 0.9999999881787E+00 VAL_N= 0.307535E-15 VAL_L= 0.307535E-15
10449 !g_rk_update_scalar: ALPHA=.1000E-08 COEF= 0.1000000050476E+01 VAL_N= 0.307535E-17 VAL_L= 0.307535E-17
10450 !g_rk_update_scalar: ALPHA=.1000E-09 COEF= 0.1000000785292E+01 VAL_N= 0.307535E-19 VAL_L= 0.307535E-19
10451 !g_rk_update_scalar: ALPHA=.1000E-10 COEF= 0.1000006304873E+01 VAL_N= 0.307537E-21 VAL_L= 0.307535E-21
10452
10453 !a_rk_update_scalar: 0.3075349138757E-01 0.3075349138757E-01
10454
10455
10456 END SUBROUTINE t_rk_update_scalar
10457 !-----------------------------------------------------------------------------------------------
10458 SUBROUTINE t_calc_p_rho_phi ( moist, n_moist, &
10459 al, alb, mu, muts, ph, p, pb, &
10460 t, p0, t0, znu, dnw, rdnw, &
10461 rdn, non_hydrostatic, &
10462 ids, ide, jds, jde, kds, kde, &
10463 ims, ime, jms, jme, kms, kme, &
10464 its, ite, jts, jte, kts, kte )
10465
10466
10467 ! Zaizhong Ma, April 5,2005
10468
10469 IMPLICIT NONE
10470
10471 ! Input data
10472
10473 LOGICAL , INTENT(IN ) :: non_hydrostatic
10474
10475 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
10476 ims, ime, jms, jme, kms, kme, &
10477 its, ite, jts, jte, kts, kte
10478
10479 INTEGER , INTENT(IN ) :: n_moist
10480
10481 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) :: t
10482
10483 REAL, DIMENSION( ims:ime , kms:kme , jms:jme, n_moist ) :: moist
10484 REAL, DIMENSION( ims:ime , jms:jme ) :: mu, muts
10485
10486 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(IN ) :: alb, &
10487 pb
10488
10489
10490 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT( OUT) :: al, p
10491
10492 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ), INTENT(INOUT) :: ph
10493
10494
10495 REAL, DIMENSION( kms:kme ), INTENT(IN ) :: znu, dnw, rdnw, rdn
10496
10497 REAL, INTENT(IN ) :: t0, p0
10498
10499 ! Local stuff
10500
10501 INTEGER :: i, j, k, itf, jtf, ktf, ispe
10502 REAL :: qvf, qtot, qf1, qf2
10503
10504 ! zzma: new definition
10505
10506 ! IN variables
10507
10508 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) :: S_t,P_t,B_t
10509
10510 REAL, DIMENSION( ims:ime , kms:kme , jms:jme, n_moist ) :: S_moist,P_moist,B_moist
10511 REAL, DIMENSION( ims:ime , jms:jme ) :: S_mu, S_muts,P_mu, P_muts,B_mu, B_muts
10512 ! INOUT
10513
10514 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) :: S_ph,P_ph,K_ph,B_ph
10515
10516 ! OUT variables
10517
10518 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) :: P_al, P_p,B_al, B_p
10519
10520 REAL :: SAVE_L, COEF, ALPHA, FACTOR, VAL_N, VAL_L, VAL_A
10521 INTEGER :: NT,h
10522
10523 ! zzma: new definition end
10524
10525 !TGL test
10526
10527 do i=ims,ime
10528 do k=kms,kme
10529 do j=jms,jme
10530 S_t(i,k,j)=t(i,k,j)
10531 P_t(i,k,j)=t(i,k,j)
10532 enddo
10533 enddo
10534 enddo
10535 do i=ims,ime
10536 do k=kms,kme
10537 do j=jms,jme
10538 do h=1,n_moist
10539 S_moist(i,k,j,h)=moist(i,k,j,h)
10540 P_moist(i,k,j,h)=moist(i,k,j,h)
10541 enddo
10542 enddo
10543 enddo
10544 enddo
10545 do i=ims,ime
10546 do j=jms,jme
10547 S_mu(i,j)=mu(i,j)
10548 S_muts(i,j)=muts(i,j)
10549
10550 P_mu(i,j)=mu(i,j)
10551 P_muts(i,j)=muts(i,j)
10552 enddo
10553 enddo
10554
10555 do i=ims,ime
10556 do k=kms,kme
10557 do j=jms,jme
10558 S_ph(i,k,j)=ph(i,k,j)
10559 P_ph(i,k,j)=ph(i,k,j)
10560 K_ph(i,k,j)=ph(i,k,j)
10561 enddo
10562 enddo
10563 enddo
10564
10565 !NLM
10566
10567 CALL calc_p_rho_phi ( moist, n_moist, &
10568 al, alb, mu, muts, ph, p, pb, &
10569 t, p0, t0, znu, dnw, rdnw, &
10570 rdn, non_hydrostatic, &
10571 ids, ide, jds, jde, kds, kde, &
10572 ims, ime, jms, jme, kms, kme, &
10573 its, ite, jts, jte, kts, kte )
10574
10575 do i=ims,ime
10576 do k=kms,kme
10577 do j=jms,jme
10578 B_al(i,k,j)=al(i,k,j)
10579 B_p(i,k,j)=p(i,k,j)
10580 enddo
10581 enddo
10582 enddo
10583 do i=ims,ime
10584 do k=kms,kme
10585 do j=jms,jme
10586 B_ph(i,k,j)=ph(i,k,j)
10587 enddo
10588 enddo
10589 enddo
10590
10591 ! TCL
10592
10593 CALL g_calc_p_rho_phi( moist, P_moist, n_moist, al, P_al, alb, mu, P_mu, muts, P_muts, K_ph, P_ph, p, P_p, pb, t, P_t, p0, t0, &
10594 &dnw, rdnw, rdn, non_hydrostatic, ide, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
10595
10596 SAVE_L=0.
10597 do i=ims,ime
10598 do k=kms,kme
10599 do j=jms,jme
10600 SAVE_L=SAVE_L +P_al(i,k,j)*P_al(i,k,j) +P_p(i,k,j)*P_p(i,k,j)
10601 enddo
10602 enddo
10603 enddo
10604 do i=ims,ime
10605 do k=kms,kme
10606 do j=jms,jme
10607 SAVE_L=SAVE_L +P_ph(i,k,j)*P_ph(i,k,j)
10608 enddo
10609 enddo
10610 enddo
10611
10612 ALPHA=1.
10613 DO NT=1,11
10614 ALPHA=0.1*ALPHA
10615 FACTOR=1.+ALPHA
10616 do i=ims,ime
10617 do k=kms,kme
10618 do j=jms,jme
10619 P_t(i,k,j)=FACTOR*S_t(i,k,j)
10620 enddo
10621 enddo
10622 enddo
10623 do i=ims,ime
10624 do k=kms,kme
10625 do j=jms,jme
10626 do h=1,n_moist
10627 P_moist(i,k,j,h)=FACTOR*S_moist(i,k,j,h)
10628 enddo
10629 enddo
10630 enddo
10631 enddo
10632 do i=ims,ime
10633 do j=jms,jme
10634 P_mu(i,j)=FACTOR*S_mu(i,j)
10635 P_muts(i,j)=FACTOR*S_muts(i,j)
10636 enddo
10637 enddo
10638
10639 do i=ims,ime
10640 do k=kms,kme
10641 do j=jms,jme
10642 P_ph(i,k,j)=FACTOR*S_ph(i,k,j)
10643 enddo
10644 enddo
10645 enddo
10646
10647 CALL calc_p_rho_phi ( P_moist, n_moist, &
10648 P_al, alb, P_mu, P_muts, P_ph, P_p, pb, &
10649 P_t, p0, t0, znu, dnw, rdnw, &
10650 rdn, non_hydrostatic, &
10651 ids, ide, jds, jde, kds, kde, &
10652 ims, ime, jms, jme, kms, kme, &
10653 its, ite, jts, jte, kts, kte )
10654
10655
10656 VAL_N=0.
10657 do i=ims,ime
10658 do k=kms,kme
10659 do j=jms,jme
10660 VAL_N=VAL_N+(P_ph(i,k,j)-B_ph(i,k,j))*(P_ph(i,k,j)-B_ph(i,k,j))
10661 enddo
10662 enddo
10663 enddo
10664 do i=ims,ime
10665 do k=kms,kme
10666 do j=jms,jme
10667 VAL_N=VAL_N+(P_al(i,k,j)-B_al(i,k,j))*(P_al(i,k,j)-B_al(i,k,j)) &
10668 +(P_p(i,k,j) -B_p(i,k,j))*(P_p(i,k,j) -B_p(i,k,j))
10669 enddo
10670 enddo
10671 enddo
10672
10673 VAL_L=SAVE_L*ALPHA**2
10674 COEF=VAL_N/VAL_L
10675 WRITE(6, fmt='(A,E9.4,A,E22.13,A,E13.6,A,E13.6)') &
10676 'g_calc_p_rho_phi: ALPHA=',ALPHA,' COEF=',COEF, &
10677 ' VAL_N=',VAL_N,' VAL_L=',VAL_L
10678 ENDDO
10679
10680 ! ADJ test
10681
10682 FACTOR=0.1
10683 do i=ims,ime
10684 do k=kms,kme
10685 do j=jms,jme
10686 t(i,k,j)=S_t(i,k,j)
10687 P_t(i,k,j)=FACTOR*S_t(i,k,j)
10688 B_t(i,k,j)=P_t(i,k,j)
10689 enddo
10690 enddo
10691 enddo
10692 do i=ims,ime
10693 do k=kms,kme
10694 do j=jms,jme
10695 do h=1,n_moist
10696 moist(i,k,j,h)=S_moist(i,k,j,h)
10697 P_moist(i,k,j,h)=FACTOR*S_moist(i,k,j,h)
10698 B_moist(i,k,j,h)=P_moist(i,k,j,h)
10699 enddo
10700 enddo
10701 enddo
10702 enddo
10703 do i=ims,ime
10704 do j=jms,jme
10705 mu(i,j)=S_mu(i,j)
10706 muts(i,j)=S_muts(i,j)
10707
10708 P_mu(i,j)=FACTOR*S_mu(i,j)
10709 P_muts(i,j)=FACTOR*S_muts(i,j)
10710
10711 B_mu(i,j)=P_mu(i,j)
10712 B_muts(i,j)=P_muts(i,j)
10713 enddo
10714 enddo
10715
10716 do i=ims,ime
10717 do k=kms,kme
10718 do j=jms,jme
10719 ph(i,k,j)=S_ph(i,k,j)
10720 P_ph(i,k,j)=FACTOR*S_ph(i,k,j)
10721 B_ph(i,k,j)=P_ph(i,k,j)
10722 K_ph(i,k,j)=ph(i,k,j)
10723 enddo
10724 enddo
10725 enddo
10726
10727 ! TGL
10728
10729 CALL g_calc_p_rho_phi( moist, P_moist, n_moist, al, P_al, alb, mu, P_mu, muts, P_muts, ph, P_ph, p, P_p, pb, t, P_t, p0, t0, &
10730 &dnw, rdnw, rdn, non_hydrostatic, ide, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
10731
10732 VAL_L=0.
10733 do i=ims,ime
10734 do k=kms,kme
10735 do j=jms,jme
10736 VAL_L=VAL_L +P_al(i,k,j)*P_al(i,k,j) +P_p(i,k,j)*P_p(i,k,j)
10737 enddo
10738 enddo
10739 enddo
10740 do i=ims,ime
10741 do k=kms,kme
10742 do j=jms,jme
10743 VAL_L=VAL_L +P_ph(i,k,j)*P_ph(i,k,j)
10744 enddo
10745 enddo
10746 enddo
10747 do i=ims,ime
10748 do k=kms,kme
10749 do j=jms,jme
10750 P_t(i,k,j)=0.0
10751 enddo
10752 enddo
10753 enddo
10754 do i=ims,ime
10755 do k=kms,kme
10756 do j=jms,jme
10757 do h=1,n_moist
10758 P_moist(i,k,j,h)=0.0
10759 enddo
10760 enddo
10761 enddo
10762 enddo
10763 do i=ims,ime
10764 do j=jms,jme
10765 P_mu(i,j)=0.0
10766 P_muts(i,j)=0.0
10767 enddo
10768 enddo
10769
10770 ! ADJ
10771
10772 CALL a_calc_p_rho_phi( moist, P_moist, n_moist, al, P_al, alb, mu, P_mu, muts, P_muts, K_ph, P_ph, p, P_p, pb, t, P_t, p0, t0, &
10773 &dnw, rdnw, rdn, non_hydrostatic, ide, jde, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
10774
10775 VAL_A=0.
10776 do i=ims,ime
10777 do k=kms,kme
10778 do j=jms,jme
10779 VAL_A=VAL_A +P_t(i,k,j) *B_t(i,k,j)
10780 enddo
10781 enddo
10782 enddo
10783 do i=ims,ime
10784 do k=kms,kme
10785 do j=jms,jme
10786 do h=1,n_moist
10787 VAL_A=VAL_A +P_moist(i,k,j,h)*B_moist(i,k,j,h)
10788 enddo
10789 enddo
10790 enddo
10791 enddo
10792 do i=ims,ime
10793 do j=jms,jme
10794 VAL_A=VAL_A +P_mu(i,j)*B_mu(i,j) +P_muts(i,j)*B_muts(i,j)
10795 enddo
10796 enddo
10797
10798 do i=ims,ime
10799 do k=kms,kme
10800 do j=jms,jme
10801 VAL_A=VAL_A +P_ph(i,k,j)*B_ph(i,k,j)
10802 enddo
10803 enddo
10804 enddo
10805
10806 print*, ' '
10807 write(6,fmt='(A,2E22.13)') 'a_calc_p_rho_phi: ', VAL_L,VAL_A
10808
10809 ! RECOVER
10810
10811 do i=ims,ime
10812 do k=kms,kme
10813 do j=jms,jme
10814 t(i,k,j)=S_t(i,k,j)
10815 enddo
10816 enddo
10817 enddo
10818 do i=ims,ime
10819 do k=kms,kme
10820 do j=jms,jme
10821 do h=1,n_moist
10822 moist(i,k,j,h)=S_moist(i,k,j,h)
10823 enddo
10824 enddo
10825 enddo
10826 enddo
10827 do i=ims,ime
10828 do j=jms,jme
10829 mu(i,j)=S_mu(i,j)
10830 enddo
10831 enddo
10832
10833 do i=ims,ime
10834 do k=kms,kme
10835 do j=jms,jme
10836 ph(i,k,j)=S_ph(i,k,j)
10837 enddo
10838 enddo
10839 enddo
10840
10841 !g_calc_p_rho_phi: ALPHA=.1000E+00 COEF= 0.1006161451340E+01 VAL_N= 0.101051E+11 VAL_L= 0.100433E+11
10842 !g_calc_p_rho_phi: ALPHA=.1000E-01 COEF= 0.1000751256943E+01 VAL_N= 0.100508E+09 VAL_L= 0.100433E+09
10843 !g_calc_p_rho_phi: ALPHA=.1000E-02 COEF= 0.9996134638786E+00 VAL_N= 0.100394E+07 VAL_L= 0.100433E+07
10844 !g_calc_p_rho_phi: ALPHA=.1000E-03 COEF= 0.9992095828056E+00 VAL_N= 0.100353E+05 VAL_L= 0.100433E+05
10845 !g_calc_p_rho_phi: ALPHA=.1000E-04 COEF= 0.1008291125298E+01 VAL_N= 0.101265E+03 VAL_L= 0.100433E+03
10846 !g_calc_p_rho_phi: ALPHA=.1000E-05 COEF= 0.2676813364029E+01 VAL_N= 0.268839E+01 VAL_L= 0.100433E+01
10847 !g_calc_p_rho_phi: ALPHA=.1000E-06 COEF= 0.1743072204590E+03 VAL_N= 0.175061E+01 VAL_L= 0.100433E-01
10848 !g_calc_p_rho_phi: ALPHA=.1000E-07 COEF= 0.1722197265625E+05 VAL_N= 0.172965E+01 VAL_L= 0.100433E-03
10849 !g_calc_p_rho_phi: ALPHA=.1000E-08 COEF= 0.1722197125000E+07 VAL_N= 0.172965E+01 VAL_L= 0.100433E-05
10850 !g_calc_p_rho_phi: ALPHA=.1000E-09 COEF= 0.1722196960000E+09 VAL_N= 0.172965E+01 VAL_L= 0.100433E-07
10851 !g_calc_p_rho_phi: ALPHA=.1000E-10 COEF= 0.1722196787200E+11 VAL_N= 0.172965E+01 VAL_L= 0.100433E-09
10852
10853 !a_calc_p_rho_phi: 0.1004590899200E+11 0.1003517337600E+11
10854
10855 !g_calc_p_rho_phi: ALPHA=.1000E+00 COEF= 0.1006000807140E+01 VAL_N= 0.101045E+11 VAL_L= 0.100442E+11
10856 !g_calc_p_rho_phi: ALPHA=.1000E-01 COEF= 0.1000601117766E+01 VAL_N= 0.100502E+09 VAL_L= 0.100442E+09
10857 !g_calc_p_rho_phi: ALPHA=.1000E-02 COEF= 0.1000061842375E+01 VAL_N= 0.100448E+07 VAL_L= 0.100442E+07
10858 !g_calc_p_rho_phi: ALPHA=.1000E-03 COEF= 0.1000178212958E+01 VAL_N= 0.100460E+05 VAL_L= 0.100442E+05
10859 !g_calc_p_rho_phi: ALPHA=.1000E-04 COEF= 0.1017220683002E+01 VAL_N= 0.102171E+03 VAL_L= 0.100442E+03
10860 !g_calc_p_rho_phi: ALPHA=.1000E-05 COEF= 0.2722008232576E+01 VAL_N= 0.273403E+01 VAL_L= 0.100442E+01
10861 !g_calc_p_rho_phi: ALPHA=.1000E-06 COEF= 0.1732008172974E+03 VAL_N= 0.173966E+01 VAL_L= 0.100442E-01
10862 !g_calc_p_rho_phi: ALPHA=.1000E-07 COEF= 0.1722108172876E+05 VAL_N= 0.172972E+01 VAL_L= 0.100442E-03
10863 !g_calc_p_rho_phi: ALPHA=.1000E-08 COEF= 0.1722009172880E+07 VAL_N= 0.172962E+01 VAL_L= 0.100442E-05
10864 !g_calc_p_rho_phi: ALPHA=.1000E-09 COEF= 0.1722008182880E+09 VAL_N= 0.172962E+01 VAL_L= 0.100442E-07
10865 !g_calc_p_rho_phi: ALPHA=.1000E-10 COEF= 0.1722008172980E+11 VAL_N= 0.172962E+01 VAL_L= 0.100442E-09
10866
10867 !a_calc_p_rho_phi: 0.1004417776524E+11 0.1004417776524E+11
10868
10869
10870 END SUBROUTINE t_calc_p_rho_phi
10871 !-----------------------------------------------------------------------------------------------
10872 SUBROUTINE t_diagnose_w( ph_tend, ph_new, ph_old, w, mu, dt, &
10873 u, v, ht, &
10874 cf1, cf2, cf3, rdx, rdy, msft, &
10875 ids, ide, jds, jde, kds, kde, &
10876 ims, ime, jms, jme, kms, kme, &
10877 its, ite, jts, jte, kts, kte )
10878
10879
10880 ! Zaizhong Ma, April 6,2005
10881
10882 IMPLICIT NONE
10883
10884 INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
10885 ims, ime, jms, jme, kms, kme, &
10886 its, ite, jts, jte, kts, kte
10887
10888 REAL, DIMENSION( ims:ime, kms:kme , jms:jme ) :: ph_tend, &
10889 ph_new, &
10890 ph_old, &
10891 u, &
10892 v
10893
10894
10895 REAL, DIMENSION( ims:ime, kms:kme , jms:jme ), INTENT( OUT) :: w
10896
10897 REAL, DIMENSION( ims:ime, jms:jme ) :: mu
10898 REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: ht, msft
10899
10900 REAL, INTENT(IN ) :: dt, cf1, cf2, cf3, rdx, rdy
10901
10902 INTEGER :: i, j, k, itf, jtf
10903
10904 ! zzma: new definition
10905
10906 ! IN variables
10907
10908 REAL, DIMENSION( ims:ime, kms:kme , jms:jme ) :: S_ph_tend, &
10909 S_ph_new, &
10910 S_ph_old, &
10911 S_u, &
10912 S_v
10913 REAL, DIMENSION( ims:ime, kms:kme , jms:jme ) :: P_ph_tend, &
10914 P_ph_new, &
10915 P_ph_old, &
10916 P_u, &
10917 P_v
10918 REAL, DIMENSION( ims:ime, kms:kme , jms:jme ) :: B_ph_tend, &
10919 B_ph_new, &
10920 B_ph_old, &
10921 B_u, &
10922 B_v
10923
10924 REAL, DIMENSION( ims:ime, jms:jme ) :: S_mu,P_mu,B_mu
10925
10926 ! OUT variables
10927
10928 REAL, DIMENSION( ims:ime, kms:kme , jms:jme ) :: P_w,B_w
10929
10930 REAL :: SAVE_L, COEF, ALPHA, FACTOR, VAL_N, VAL_L, VAL_A
10931 INTEGER :: NT
10932
10933 ! zzma: new definition end
10934
10935 !TGL test
10936
10937 do i=ims,ime
10938 do k=kms,kme
10939 do j=jms,jme
10940 S_u(i,k,j)=u(i,k,j)
10941 S_v(i,k,j)=v(i,k,j)
10942 S_ph_new(i,k,j)=ph_new(i,k,j)
10943 S_ph_old(i,k,j)=ph_old(i,k,j)
10944 S_ph_tend(i,k,j)=ph_tend(i,k,j)
10945
10946 P_u(i,k,j)=u(i,k,j)
10947 P_v(i,k,j)=v(i,k,j)
10948 P_ph_new(i,k,j)=ph_new(i,k,j)
10949 P_ph_old(i,k,j)=ph_old(i,k,j)
10950 P_ph_tend(i,k,j)=ph_tend(i,k,j)
10951 enddo
10952 enddo
10953 enddo
10954 do i=ims,ime
10955 do j=jms,jme
10956 S_mu(i,j)=mu(i,j)
10957
10958 P_mu(i,j)=mu(i,j)
10959 enddo
10960 enddo
10961
10962 !NLM
10963
10964 CALL diagnose_w( ph_tend, ph_new, ph_old, w, mu, dt, &
10965 u, v, ht, &
10966 cf1, cf2, cf3, rdx, rdy, msft, &
10967 ids, ide, jds, jde, kds, kde, &
10968 ims, ime, jms, jme, kms, kme, &
10969 its, ite, jts, jte, kts, kte )
10970
10971 do i=ims,ime
10972 do k=kms,kme
10973 do j=jms,jme
10974 B_w(i,k,j)=w(i,k,j)
10975 enddo
10976 enddo
10977 enddo
10978
10979 ! TCL
10980
10981 CALL g_diagnose_w( ph_tend, P_ph_tend, ph_new, P_ph_new, ph_old, P_ph_old, w, P_w, mu, P_mu, dt, u, P_u, v, P_v, ht, cf1, &
10982 &cf2, cf3, rdx, rdy, msft, ide, jde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kte )
10983
10984 SAVE_L=0.
10985 do i=ims,ime
10986 do k=kms,kme
10987 do j=jms,jme
10988 SAVE_L=SAVE_L +P_w(i,k,j)*P_w(i,k,j)
10989 enddo
10990 enddo
10991 enddo
10992
10993 ALPHA=1.
10994 DO NT=1,11
10995 ALPHA=0.1*ALPHA
10996 FACTOR=1.+ALPHA
10997 do i=ims,ime
10998 do k=kms,kme
10999 do j=jms,jme
11000 P_u(i,k,j)=FACTOR*S_u(i,k,j)
11001 P_v(i,k,j)=FACTOR*S_v(i,k,j)
11002 P_ph_new(i,k,j)=FACTOR*S_ph_new(i,k,j)
11003 P_ph_old(i,k,j)=FACTOR*S_ph_old(i,k,j)
11004 P_ph_tend(i,k,j)=FACTOR*S_ph_tend(i,k,j)
11005 enddo
11006 enddo
11007 enddo
11008 do i=ims,ime
11009 do j=jms,jme
11010 P_mu(i,j)=FACTOR*S_mu(i,j)
11011 enddo
11012 enddo
11013
11014 CALL diagnose_w( P_ph_tend, P_ph_new, P_ph_old, P_w, P_mu, dt, &
11015 P_u, P_v, ht, &
11016 cf1, cf2, cf3, rdx, rdy, msft, &
11017 ids, ide, jds, jde, kds, kde, &
11018 ims, ime, jms, jme, kms, kme, &
11019 its, ite, jts, jte, kts, kte )
11020
11021 VAL_N=0.
11022 do i=ims,ime
11023 do k=kms,kme
11024 do j=jms,jme
11025 VAL_N=VAL_N+(P_w(i,k,j)- B_w(i,k,j))*(P_w(i,k,j)- B_w(i,k,j))
11026 enddo
11027 enddo
11028 enddo
11029
11030 VAL_L=SAVE_L*ALPHA**2
11031 COEF=VAL_N/VAL_L
11032 WRITE(6, fmt='(A,E9.4,A,E22.13,A,E13.6,A,E13.6)') &
11033 'g_diagnose_w: ALPHA=',ALPHA,' COEF=',COEF, &
11034 ' VAL_N=',VAL_N,' VAL_L=',VAL_L
11035 ENDDO
11036
11037 ! ADJ test
11038
11039 FACTOR=0.1
11040 do i=ims,ime
11041 do k=kms,kme
11042 do j=jms,jme
11043 u(i,k,j)=S_u(i,k,j)
11044 v(i,k,j)=S_v(i,k,j)
11045 ph_new(i,k,j)=S_ph_new(i,k,j)
11046 ph_old(i,k,j)=S_ph_old(i,k,j)
11047 ph_tend(i,k,j)=S_ph_tend(i,k,j)
11048
11049 P_u(i,k,j)=FACTOR*S_u(i,k,j)
11050 P_v(i,k,j)=FACTOR*S_v(i,k,j)
11051 P_ph_new(i,k,j)=FACTOR*S_ph_new(i,k,j)
11052 P_ph_old(i,k,j)=FACTOR*S_ph_old(i,k,j)
11053 P_ph_tend(i,k,j)=FACTOR*S_ph_tend(i,k,j)
11054
11055 B_u(i,k,j)=P_u(i,k,j)
11056 B_v(i,k,j)=P_v(i,k,j)
11057 B_ph_new(i,k,j)=P_ph_new(i,k,j)
11058 B_ph_old(i,k,j)=P_ph_old(i,k,j)
11059 B_ph_tend(i,k,j)=P_ph_tend(i,k,j)
11060 enddo
11061 enddo
11062 enddo
11063 do i=ims,ime
11064 do j=jms,jme
11065 mu(i,j)=S_mu(i,j)
11066 P_mu(i,j)=FACTOR*S_mu(i,j)
11067 B_mu(i,j)=P_mu(i,j)
11068 enddo
11069 enddo
11070
11071 ! TGL
11072
11073 CALL g_diagnose_w( ph_tend, P_ph_tend, ph_new, P_ph_new, ph_old, P_ph_old, w, P_w, mu, P_mu, dt, u, P_u, v, P_v, ht, cf1, &
11074 &cf2, cf3, rdx, rdy, msft, ide, jde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kte )
11075
11076 VAL_L=0.
11077 do i=ims,ime
11078 do k=kms,kme
11079 do j=jms,jme
11080 VAL_L=VAL_L + P_w(i,k,j)*P_w(i,k,j)
11081 enddo
11082 enddo
11083 enddo
11084 do i=ims,ime
11085 do k=kms,kme
11086 do j=jms,jme
11087 P_u(i,k,j)=0.0
11088 P_v(i,k,j)=0.0
11089 P_ph_new(i,k,j)=0.0
11090 P_ph_old(i,k,j)=0.0
11091 P_ph_tend(i,k,j)=0.0
11092 enddo
11093 enddo
11094 enddo
11095 do i=ims,ime
11096 do j=jms,jme
11097 P_mu(i,j)=0.0
11098 enddo
11099 enddo
11100
11101 ! ADJ
11102
11103 CALL a_diagnose_w( ph_tend, P_ph_tend, P_ph_new, P_ph_old, P_w, mu, P_mu, dt, P_u, P_v, ht, cf1, cf2, cf3, rdx, rdy, msft, &
11104 &ide, jde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kte )
11105
11106 VAL_A=0.
11107 do i=ims,ime
11108 do k=kms,kme
11109 do j=jms,jme
11110 VAL_A=VAL_A +P_u(i,k,j)*B_u(i,k,j) &
11111 +P_v(i,k,j)*B_v(i,k,j) &
11112 +P_ph_new(i,k,j)*B_ph_new(i,k,j) &
11113 +P_ph_old(i,k,j)*B_ph_old(i,k,j) &
11114 +P_ph_tend(i,k,j)*B_ph_tend(i,k,j)
11115 enddo
11116 enddo
11117 enddo
11118 do i=ims,ime
11119 do j=jms,jme
11120 VAL_A=VAL_A +P_mu(i,j)*B_mu(i,j)
11121 enddo
11122 enddo
11123
11124 print*, ' '
11125 write(6,fmt='(A,2E22.13)') 'a_diagnose_w: ', VAL_L,VAL_A
11126
11127 ! RECOVER
11128
11129 do i=ims,ime
11130 do k=kms,kme
11131 do j=jms,jme
11132 u(i,k,j)=S_u(i,k,j)
11133 v(i,k,j)=S_v(i,k,j)
11134 ph_new(i,k,j)=S_ph_new(i,k,j)
11135 ph_old(i,k,j)=S_ph_old(i,k,j)
11136 ph_tend(i,k,j)=S_ph_tend(i,k,j)
11137 enddo
11138 enddo
11139 enddo
11140 do i=ims,ime
11141 do j=jms,jme
11142 mu(i,j)=S_mu(i,j)
11143 enddo
11144 enddo
11145
11146 !g_diagnose_w: ALPHA=.1000E+00 COEF= 0.1000005245209E+01 VAL_N= 0.670413E+01 VAL_L= 0.670409E+01
11147 !g_diagnose_w: ALPHA=.1000E-01 COEF= 0.1000001430511E+01 VAL_N= 0.670410E-01 VAL_L= 0.670409E-01
11148 !g_diagnose_w: ALPHA=.1000E-02 COEF= 0.1000097274780E+01 VAL_N= 0.670475E-03 VAL_L= 0.670409E-03
11149 !g_diagnose_w: ALPHA=.1000E-03 COEF= 0.1000367045403E+01 VAL_N= 0.670656E-05 VAL_L= 0.670409E-05
11150 !g_diagnose_w: ALPHA=.1000E-04 COEF= 0.1005415797234E+01 VAL_N= 0.674040E-07 VAL_L= 0.670409E-07
11151 !g_diagnose_w: ALPHA=.1000E-05 COEF= 0.9407595992088E+00 VAL_N= 0.630694E-09 VAL_L= 0.670410E-09
11152 !g_diagnose_w: ALPHA=.1000E-06 COEF= 0.8932945728302E+00 VAL_N= 0.598873E-11 VAL_L= 0.670410E-11
11153 !g_diagnose_w: ALPHA=.1000E-07 COEF= 0.2442521740420E-08 VAL_N= 0.163749E-21 VAL_L= 0.670410E-13
11154 !g_diagnose_w: ALPHA=.1000E-08 COEF= 0.2442521633839E-06 VAL_N= 0.163749E-21 VAL_L= 0.670410E-15
11155 !g_diagnose_w: ALPHA=.1000E-09 COEF= 0.2442521326884E-04 VAL_N= 0.163749E-21 VAL_L= 0.670410E-17
11156 !g_diagnose_w: ALPHA=.1000E-10 COEF= 0.2442521275952E-02 VAL_N= 0.163749E-21 VAL_L= 0.670410E-19
11157
11158 !a_diagnose_w: 0.6704125404358E+01 0.6704235553741E+01
11159
11160
11161 !g_diagnose_w: ALPHA=.1000E+00 COEF= 0.1000000000000E+01 VAL_N= 0.670470E+01 VAL_L= 0.670470E+01
11162 !g_diagnose_w: ALPHA=.1000E-01 COEF= 0.1000000000000E+01 VAL_N= 0.670470E-01 VAL_L= 0.670470E-01
11163 !g_diagnose_w: ALPHA=.1000E-02 COEF= 0.9999999999999E+00 VAL_N= 0.670470E-03 VAL_L= 0.670470E-03
11164 !g_diagnose_w: ALPHA=.1000E-03 COEF= 0.9999999999994E+00 VAL_N= 0.670470E-05 VAL_L= 0.670470E-05
11165 !g_diagnose_w: ALPHA=.1000E-04 COEF= 0.1000000000010E+01 VAL_N= 0.670470E-07 VAL_L= 0.670470E-07
11166 !g_diagnose_w: ALPHA=.1000E-05 COEF= 0.9999999998131E+00 VAL_N= 0.670470E-09 VAL_L= 0.670470E-09
11167 !g_diagnose_w: ALPHA=.1000E-06 COEF= 0.1000000001353E+01 VAL_N= 0.670470E-11 VAL_L= 0.670470E-11
11168 !g_diagnose_w: ALPHA=.1000E-07 COEF= 0.9999999833020E+00 VAL_N= 0.670470E-13 VAL_L= 0.670470E-13
11169 !g_diagnose_w: ALPHA=.1000E-08 COEF= 0.1000000134166E+01 VAL_N= 0.670470E-15 VAL_L= 0.670470E-15
11170 !g_diagnose_w: ALPHA=.1000E-09 COEF= 0.1000000233388E+01 VAL_N= 0.670470E-17 VAL_L= 0.670470E-17
11171 !g_diagnose_w: ALPHA=.1000E-10 COEF= 0.9999982203515E+00 VAL_N= 0.670469E-19 VAL_L= 0.670470E-19
11172
11173 !a_diagnose_w: 0.6704701074044E+01 0.6704701074044E+01
11174
11175 END SUBROUTINE t_diagnose_w
11176 !-----------------------------------------------------------------------------------------------
11177 SUBROUTINE t_spec_bdyupdate( field, &
11178 field_tend, dt, &
11179 variable_in, config_flags, &
11180 spec_zone, &
11181 ids,ide, jds,jde, kds,kde, & ! domain dims
11182 ims,ime, jms,jme, kms,kme, & ! memory dims
11183 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
11184 its,ite, jts,jte, kts,kte )
11185
11186
11187 IMPLICIT NONE
11188
11189 INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
11190 INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
11191 INTEGER, INTENT(IN ) :: ips,ipe, jps,jpe, kps,kpe
11192 INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
11193 INTEGER, INTENT(IN ) :: spec_zone
11194 CHARACTER, INTENT(IN ) :: variable_in
11195 REAL, INTENT(IN ) :: dt
11196
11197
11198 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) :: field
11199 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) :: field_tend
11200 TYPE( grid_config_rec_type ) config_flags
11201
11202 CHARACTER :: variable
11203 INTEGER :: i, j, k, ibs, ibe, jbs, jbe, itf, jtf, ktf
11204 INTEGER :: b_dist
11205
11206 ! zzma: new definition
11207
11208 !IN variables
11209
11210 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) :: S_field_tend,P_field_tend,B_field_tend
11211
11212 !INOUT variables
11213
11214 REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) :: S_field,P_field,B_field,K_field
11215
11216 REAL :: SAVE_L, COEF, ALPHA, FACTOR, VAL_N, VAL_L, VAL_A
11217 INTEGER :: NT
11218
11219 ! zzma: new definition end
11220
11221 !TGL test
11222
11223 do i=ims,ime
11224 do k=kms,kme
11225 do j=jms,jme
11226 S_field_tend(i,k,j)=field_tend(i,k,j)
11227
11228 P_field_tend(i,k,j)=field_tend(i,k,j)
11229 enddo
11230 enddo
11231 enddo
11232 do i=ims,ime
11233 do k=kms,kme
11234 do j=jms,jme
11235 S_field(i,k,j)=field(i,k,j)
11236
11237 P_field(i,k,j)=field(i,k,j)
11238
11239 K_field(i,k,j)=field(i,k,j)
11240 enddo
11241 enddo
11242 enddo
11243
11244 !NLM
11245
11246 CALL spec_bdyupdate( field, &
11247 field_tend, dt, &
11248 variable_in, config_flags, &
11249 spec_zone, &
11250 ids,ide, jds,jde, kds,kde, & ! domain dims
11251 ims,ime, jms,jme, kms,kme, & ! memory dims
11252 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
11253 its,ite, jts,jte, kts,kte )
11254
11255 do i=ims,ime
11256 do k=kms,kme
11257 do j=jms,jme
11258 B_field(i,k,j)=field(i,k,j)
11259 enddo
11260 enddo
11261 enddo
11262
11263 ! TCL
11264
11265 CALL g_spec_bdyupdate( K_field, P_field, field_tend, P_field_tend, dt, variable_in, spec_zone, ids, ide, jds, jde, kde, ims, &
11266 &ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
11267
11268 SAVE_L=0.
11269 do i=ims,ime
11270 do k=kms,kme
11271 do j=jms,jme
11272 SAVE_L=SAVE_L + P_field(i,k,j)*P_field(i,k,j)
11273 enddo
11274 enddo
11275 enddo
11276
11277 ALPHA=1.
11278 DO NT=1,11
11279 ALPHA=0.1*ALPHA
11280 FACTOR=1.+ALPHA
11281 do i=ims,ime
11282 do k=kms,kme
11283 do j=jms,jme
11284 P_field_tend(i,k,j)=FACTOR*S_field_tend(i,k,j)
11285 P_field(i,k,j)=FACTOR*S_field(i,k,j)
11286 enddo
11287 enddo
11288 enddo
11289
11290 CALL spec_bdyupdate( P_field, &
11291 P_field_tend, dt, &
11292 variable_in, config_flags, &
11293 spec_zone, &
11294 ids,ide, jds,jde, kds,kde, & ! domain dims
11295 ims,ime, jms,jme, kms,kme, & ! memory dims
11296 ips,ipe, jps,jpe, kps,kpe, & ! patch dims
11297 its,ite, jts,jte, kts,kte )
11298
11299 VAL_N=0.
11300 do i=ims,ime
11301 do k=kms,kme
11302 do j=jms,jme
11303 VAL_N=VAL_N+(P_field(i,k,j) -B_field(i,k,j))*(P_field(i,k,j) -B_field(i,k,j))
11304 enddo
11305 enddo
11306 enddo
11307
11308 VAL_L=SAVE_L*ALPHA**2
11309 COEF=VAL_N/VAL_L
11310 WRITE(6, fmt='(A,E9.4,A,E22.13,A,E13.6,A,E13.6)') &
11311 'g_spec_bdyupdate: ALPHA=',ALPHA,' COEF=',COEF, &
11312 ' VAL_N=',VAL_N,' VAL_L=',VAL_L
11313 ENDDO
11314
11315 ! ADJ test
11316
11317 FACTOR=0.1
11318 do i=ims,ime
11319 do k=kms,kme
11320 do j=jms,jme
11321 field_tend(i,k,j)=S_field_tend(i,k,j)
11322 P_field_tend(i,k,j)=FACTOR*S_field_tend(i,k,j)
11323 B_field_tend(i,k,j)=P_field_tend(i,k,j)
11324 enddo
11325 enddo
11326 enddo
11327 do i=ims,ime
11328 do k=kms,kme
11329 do j=jms,jme
11330 field(i,k,j)=S_field(i,k,j)
11331 P_field(i,k,j)=FACTOR*S_field(i,k,j)
11332 B_field(i,k,j)=P_field(i,k,j)
11333 K_field(i,k,j)=field(i,k,j)
11334 enddo
11335 enddo
11336 enddo
11337
11338 CALL g_spec_bdyupdate( field, P_field, field_tend, P_field_tend, dt, variable_in, spec_zone, ids, ide, jds, jde, kde, ims, &
11339 &ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte )
11340
11341 VAL_L=0.
11342 do i=ims,ime
11343 do k=kms,kme
11344 do j=jms,jme
11345 VAL_L=VAL_L + P_field(i,k,j)*P_field(i,k,j)
11346 enddo
11347 enddo
11348 enddo
11349 do i=ims,ime
11350 do k=kms,kme
11351 do j=jms,jme
11352 P_field_tend(i,k,j)=0.0
11353 enddo
11354 enddo
11355 enddo
11356
11357 ! ADJ
11358
11359 CALL a_spec_bdyupdate( P_field, P_field_tend, dt, variable_in, spec_zone, ids, ide, jds, jde, kde, ims, ime, jms, jme, kms, &
11360 &kme, its, ite, jts, jte, kts, kte )
11361
11362 VAL_A=0.
11363 do i=ims,ime
11364 do k=kms,kme
11365 do j=jms,jme
11366 VAL_A=VAL_A + P_field_tend(i,k,j)*B_field_tend(i,k,j)
11367 enddo
11368 enddo
11369 enddo
11370 do i=ims,ime
11371 do k=kms,kme
11372 do j=jms,jme
11373 VAL_A=VAL_A + P_field(i,k,j)*B_field(i,k,j)
11374 enddo
11375 enddo
11376 enddo
11377
11378 print*, ' '
11379 write(6,fmt='(A,2E22.13)') 'a_spec_bdyupdate: ', VAL_L,VAL_A
11380
11381 ! RECOVER
11382
11383 do i=ims,ime
11384 do k=kms,kme
11385 do j=jms,jme
11386 field_tend(i,k,j)=S_field_tend(i,k,j)
11387 enddo
11388 enddo
11389 enddo
11390 do i=ims,ime
11391 do k=kms,kme
11392 do j=jms,jme
11393 field(i,k,j)=S_field(i,k,j)
11394 enddo
11395 enddo
11396 enddo
11397
11398 !g_spec_bdyupdate: ALPHA=.1000E+00 COEF= 0.1000000000000E+01 VAL_N= 0.494271E+11 VAL_L= 0.494271E+11
11399 !g_spec_bdyupdate: ALPHA=.1000E-01 COEF= 0.9999986886978E+00 VAL_N= 0.494271E+09 VAL_L= 0.494272E+09
11400 !g_spec_bdyupdate: ALPHA=.1000E-02 COEF= 0.1000093936920E+01 VAL_N= 0.494318E+07 VAL_L= 0.494272E+07
11401 !g_spec_bdyupdate: ALPHA=.1000E-03 COEF= 0.1000092506409E+01 VAL_N= 0.494317E+05 VAL_L= 0.494272E+05
11402 !g_spec_bdyupdate: ALPHA=.1000E-04 COEF= 0.1003426194191E+01 VAL_N= 0.495965E+03 VAL_L= 0.494272E+03
11403 !g_spec_bdyupdate: ALPHA=.1000E-05 COEF= 0.9386174082756E+00 VAL_N= 0.463932E+01 VAL_L= 0.494272E+01
11404 !g_spec_bdyupdate: ALPHA=.1000E-06 COEF= 0.1423480510712E+01 VAL_N= 0.703586E-01 VAL_L= 0.494272E-01
11405 !g_spec_bdyupdate: ALPHA=.1000E-07 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.494272E-03
11406 !g_spec_bdyupdate: ALPHA=.1000E-08 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.494272E-05
11407 !g_spec_bdyupdate: ALPHA=.1000E-09 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.494272E-07
11408 !g_spec_bdyupdate: ALPHA=.1000E-10 COEF= 0.0000000000000E+00 VAL_N= 0.000000E+00 VAL_L= 0.494272E-09
11409
11410 !a_spec_bdyupdate: 0.4942713241600E+11 0.4942713241600E+11
11411
11412 !g_spec_bdyupdate: ALPHA=.1000E+00 COEF= 0.1000000000000E+01 VAL_N= 0.494266E+11 VAL_L= 0.494266E+11
11413 !g_spec_bdyupdate: ALPHA=.1000E-01 COEF= 0.1000000000000E+01 VAL_N= 0.494266E+09 VAL_L= 0.494266E+09
11414 !g_spec_bdyupdate: ALPHA=.1000E-02 COEF= 0.9999999999998E+00 VAL_N= 0.494266E+07 VAL_L= 0.494266E+07
11415 !g_spec_bdyupdate: ALPHA=.1000E-03 COEF= 0.9999999999999E+00 VAL_N= 0.494266E+05 VAL_L= 0.494266E+05
11416 !g_spec_bdyupdate: ALPHA=.1000E-04 COEF= 0.1000000000013E+01 VAL_N= 0.494266E+03 VAL_L= 0.494266E+03
11417 !g_spec_bdyupdate: ALPHA=.1000E-05 COEF= 0.9999999998369E+00 VAL_N= 0.494266E+01 VAL_L= 0.494266E+01
11418 !g_spec_bdyupdate: ALPHA=.1000E-06 COEF= 0.1000000001169E+01 VAL_N= 0.494266E-01 VAL_L= 0.494266E-01
11419 !g_spec_bdyupdate: ALPHA=.1000E-07 COEF= 0.9999999879249E+00 VAL_N= 0.494266E-03 VAL_L= 0.494266E-03
11420 !g_spec_bdyupdate: ALPHA=.1000E-08 COEF= 0.1000000181960E+01 VAL_N= 0.494266E-05 VAL_L= 0.494266E-05
11421 !g_spec_bdyupdate: ALPHA=.1000E-09 COEF= 0.9999999928643E+00 VAL_N= 0.494266E-07 VAL_L= 0.494266E-07
11422 !g_spec_bdyupdate: ALPHA=.1000E-10 COEF= 0.9999993623163E+00 VAL_N= 0.494266E-09 VAL_L= 0.494266E-09
11423
11424 !a_spec_bdyupdate: 0.4942663099544E+11 0.4942663099544E+11
11425
11426 END SUBROUTINE t_spec_bdyupdate
11427 !-----------------------------------------------------------------------------------------------
11428
11429 END MODULE module_check