module_NONHY_DYNAM.F
References to this file elsewhere.
1 !----------------------------------------------------------------------
2 !
3 !NCEP_MESO:MODEL_LAYER: NONHYDROSTATIC DYNAMICS ROUTINES
4 !
5 !----------------------------------------------------------------------
6 !
7 #include "nmm_loop_basemacros.h"
8 #include "nmm_loop_macros.h"
9 !
10 !----------------------------------------------------------------------
11 !
12 MODULE MODULE_NONHY_DYNAM
13 !
14 !----------------------------------------------------------------------
15 USE MODULE_MODEL_CONSTANTS
16 ! USE MODULE_INDX
17 !----------------------------------------------------------------------
18 !
19 REAL :: CAPA=R_D/CP,RG=1./G,TRG=2.*R_D/G
20 !
21 CONTAINS
22 !
23 !***********************************************************************
24 SUBROUTINE EPS(NTSD,DT,HYDRO,DX,DY,FAD &
25 ,DETA1,DETA2,PDTOP,PT &
26 ,HTM,HBM2,HBM3,LMH &
27 ,PDSL,PDSLO,PINT,RTOP,PETDT,PDWDT &
28 ,DWDT,DWDTMN,DWDTMX &
29 ,FNS,FEW,FNE,FSE &
30 ,T,U,V,W,Q,CWM &
31 ,IHE,IHW,IVE,IVW,INDX3_WRK &
32 ,IDS,IDE,JDS,JDE,KDS,KDE &
33 ,IMS,IME,JMS,JME,KMS,KME &
34 ,ITS,ITE,JTS,JTE,KTS,KTE)
35 !***********************************************************************
36 !$$$ SUBPROGRAM DOCUMENTATION BLOCK
37 ! . . .
38 ! SUBPROGRAM: EPS
39 ! PRGRMMR: JANJIC ORG: W/NP22 DATE: 9?-??-??
40 !
41 ! ABSTRACT:
42 ! EPS COMPUTES THE VERTICAL AND HORIZONTAL ADVECTION OF DZ/DT
43 !
44 ! PROGRAM HISTORY LOG:
45 ! 9?-??-?? JANJIC - ORIGINATOR
46 ! 00-01-05 BLACK - DISTRIBUTED MEMORY AND THREADS
47 ! 02-02-07 BLACK - CONVERTED TO WRF STRUCTURE
48 ! 04-11-22 BLACK - THREADED
49 !
50 ! USAGE: CALL EPS FROM SUBROUTINE SOLVE_RUNSTREAM
51 ! INPUT ARGUMENT LIST:
52 !
53 ! OUTPUT ARGUMENT LIST:
54 !
55 ! OUTPUT FILES:
56 ! NONE
57 !
58 ! SUBPROGRAMS CALLED:
59 !
60 ! UNIQUE: NONE
61 !
62 ! LIBRARY: NONE
63 !
64 ! ATTRIBUTES:
65 ! LANGUAGE: FORTRAN 90
66 ! MACHINE : IBM SP
67 !$$$
68 !-----------------------------------------------------------------------
69 !
70 IMPLICIT NONE
71 !-----------------------------------------------------------------------
72 #ifdef DM_PARALLEL
73 INCLUDE "mpif.h"
74 #endif
75 !
76 !-----------------------------------------------------------------------
77 INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
78 ,IMS,IME,JMS,JME,KMS,KME &
79 ,ITS,ITE,JTS,JTE,KTS,KTE
80 !
81 INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW
82 !
83 !-----------------------------------------------------------------------
84 !!!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
85 !*** NMM_MAX_DIM is set in configure.wrf and must agree with
86 !*** the value of dimspec q in the Registry/Registry
87 !!!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
88 !-----------------------------------------------------------------------
89 !
90 INTEGER,DIMENSION(-3:3,NMM_MAX_DIM,0:6),INTENT(IN) :: INDX3_WRK
91 !
92 INTEGER,INTENT(IN) :: NTSD
93 !
94 INTEGER,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: LMH
95 !
96 REAL,INTENT(IN) :: DT,DY,PDTOP,PT
97 !
98 REAL,DIMENSION(KMS:KME-1),INTENT(IN) :: DETA1,DETA2
99 !
100 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: DWDTMN,DWDTMX,DX &
101 ,FAD,HBM2,HBM3 &
102 ,PDSL,PDSLO
103 !
104 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: PETDT
105 !
106 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: CWM &
107 ,FEW,FNE &
108 ,FNS,FSE &
109 ,HTM,Q &
110 ,RTOP &
111 ,U,V
112 !
113 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: DWDT &
114 ,PDWDT &
115 ,T
116 !
117 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: PINT,W
118 !
119 LOGICAL,INTENT(IN) :: HYDRO
120 !
121 !-----------------------------------------------------------------------
122 !
123 !*** LOCAL VARIABLES
124 !
125 !-----------------------------------------------------------------------
126 !
127 INTEGER,PARAMETER :: NTSHY=2
128 !
129 REAL,PARAMETER :: WGHT=0.35,WP=0.
130 !
131 INTEGER,DIMENSION(KTS:KTE) :: LA
132 !
133 INTEGER :: I,J,J4_00,J4_M1,J4_P1,J5_00,J5_M1,J6_00,J6_P1 &
134 ,JEND,JJ,JKNT,JSTART,K,KOFF,LMP
135 !
136 REAL,DIMENSION(KTS:KTE) :: B1,B2,B3,C0,CWM_K,DWDT_K,Q_K,RDPP &
137 ,RTOP_K,T_K
138 !
139 REAL,DIMENSION(KTS:KTE+1) :: CHI,COFF,PINT_K,PNP1,PONE,PSTR,W_K
140 !
141 REAL,DIMENSION(ITS-5:ITE+5,JTS-5:JTE+5) :: TTB
142 !
143 REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE) :: WEW
144 !
145 REAL :: ADDT,DELP,DETAL,DP,DPDE,DPPL,DPSTR,DPTL,DPTU &
146 ,DWDTT,EPSN,FCT,FFC,GDT,GDT2 &
147 ,HBM3IJ,HM,PP1,PSTRDN,PSTRUP,RDP,RDPDN,RDPUP,RDT &
148 ,TFC,TMP,TTAL,TTFC
149 !
150 LOGICAL :: BOT,TOP
151 !
152 !*** TYPE 4 WORKING ARRAY (SEE PFDHT)
153 !
154 REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,-1:1) :: WNS
155 !
156 !*** TYPE 5 WORKING ARRAY
157 !
158 REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,-1:0) :: WNE
159 !
160 !*** TYPE 6 WORKING ARRAY
161 !
162 REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE, 0:1) :: WSE
163 !-----------------------------------------------------------------------
164 !***********************************************************************
165 !-----------------------------------------------------------------------
166 IF(NTSD<=NTSHY.OR.HYDRO)THEN
167 !***
168 DO J=MYJS_P2,MYJE_P2
169 DO I=MYIS_P1,MYIE_P1
170 PINT(I,KTE+1,J)=PT
171 ENDDO
172 ENDDO
173 !
174 !$omp parallel do &
175 !$omp& private(i,j,k)
176 DO J=MYJS_P2,MYJE_P2
177 DO K=KTS,KTE
178 DO I=MYIS_P1,MYIE_P1
179 DWDT(I,K,J)=1.
180 PDWDT(I,K,J)=1.
181 ENDDO
182 ENDDO
183 ENDDO
184 !
185 !$omp parallel do &
186 !$omp& private(i,j,k)
187 DO J=MYJS_P2,MYJE_P2
188 DO K=KTE,KTS,-1
189 DO I=MYIS_P1,MYIE_P1
190 PINT(I,K,J)=DETA1(K)*PDTOP+DETA2(K)*PDSL(I,J)+PINT(I,K+1,J)
191 ENDDO
192 ENDDO
193 ENDDO
194 !***
195 RETURN
196 !***
197 ENDIF
198 !-----------------------------------------------------------------------
199 ADDT=DT
200 RDT=1./ADDT
201 !-----------------------------------------------------------------------
202 !
203 !*** TIME TENDENCY
204 !
205 !$omp parallel do &
206 !$omp& private(i,j,k)
207 DO J=MYJS_P1,MYJE_P1
208 DO K=KTS,KTE
209 DO I=MYIS_P1,MYIE_P1
210 DWDT(I,K,J)=(W(I,K,J)-DWDT(I,K,J))*HTM(I,K,J)*HBM2(I,J)*RDT
211 ENDDO
212 ENDDO
213 ENDDO
214 !
215 !-----------------------------------------------------------------------
216 !***
217 !*** VERTICAL ADVECTION
218 !***
219 !-----------------------------------------------------------------------
220 DO J=MYJS2,MYJE2
221 DO I=MYIS,MYIE
222 TTB(I,J)=0.
223 ENDDO
224 ENDDO
225 !
226 !$omp parallel do &
227 !$omp& private(i,j,k,ttal)
228 DO J=MYJS2,MYJE2
229 DO K=KTE,KTS+1,-1
230 DO I=MYIS,MYIE
231 TTAL=(W(I,K-1,J)-W(I,K,J))*PETDT(I,K-1,J)*0.5
232 DWDT(I,K,J)=(TTAL+TTB(I,J)) &
233 /(DETA1(K)*PDTOP+DETA2(K)*PDSLO(I,J)) &
234 +DWDT(I,K,J)
235 TTB(I,J)=TTAL
236 ENDDO
237 ENDDO
238 ENDDO
239 !
240 !$omp parallel do &
241 !$omp& private(i,j)
242 DO J=MYJS2,MYJE2
243 DO I=MYIS1,MYIE1
244 TTB(I,J)=(W(I,KTS,J)-W(I,KTS+1,J))*PETDT(I,KTS,J)*0.5
245 DWDT(I,KTS,J)=TTB(I,J)/(DETA1(KTS)*PDTOP+DETA2(KTS)*PDSLO(I,J)) &
246 +DWDT(I,KTS,J)
247 ENDDO
248 ENDDO
249 !-----------------------------------------------------------------------
250 !***
251 !*** END OF VERTICAL ADVECTION
252 !***
253 !-----------------------------------------------------------------------
254 !
255 !-----------------------------------------------------------------------
256 !***
257 !*** HORIZONTAL ADVECTION
258 !***
259 !-----------------------------------------------------------------------
260 !*** MARCH NORTHWARD THROUGH THE SOUTHERNMOST SLABS TO BEGIN
261 !*** FILLING THE MAIN WORKING ARRAYS WHICH ARE MULTI-DIMENSIONED
262 !*** IN J BECAUSE THEY ARE DIFFERENCED OR AVERAGED IN J
263 !-----------------------------------------------------------------------
264 !
265 JSTART=MYJS3
266 !
267 DO J=-1,0
268 JJ=JSTART+J
269 !
270 !$omp parallel do &
271 !$omp& private(i,k)
272 DO K=KTS,KTE
273 DO I=MYIS_P3,MYIE_P3
274 WNS(I,K,J)=FNS(I,K,JJ)*(W(I,K,JJ+1)-W(I,K,JJ-1))
275 ENDDO
276 ENDDO
277 !
278 ENDDO
279 !
280 J=-1
281 JJ=JSTART+J
282 !
283 !$omp parallel do &
284 !$omp& private(i,k)
285 DO K=KTS,KTE
286 DO I=MYIS_P2,MYIE1_P2
287 WNE(I,K,J)=FNE(I,K,JJ)*(W(I+IHE(JJ),K,JJ+1)-W(I,K,JJ))
288 ENDDO
289 ENDDO
290 !
291 J=0
292 JJ=JSTART+J
293 !
294 !$omp parallel do &
295 !$omp& private(i,k)
296 DO K=KTS,KTE
297 DO I=MYIS_P2,MYIE1_P2
298 WSE(I,K,J)=FSE(I,K,JJ)*(W(I+IHE(JJ),K,JJ-1)-W(I,K,JJ))
299 ENDDO
300 ENDDO
301 !-----------------------------------------------------------------------
302 !-----------------------------------------------------------------------
303 !
304 JKNT=0
305 JSTART=MYJS3
306 JEND =MYJE3
307 !
308 main_horizontal: DO J=JSTART,JEND
309 !
310 !-----------------------------------------------------------------------
311 !-----------------------------------------------------------------------
312 !***
313 !*** SET THE 3RD INDEX IN THE WORKING ARRAYS (SEE SUBROUTINE INIT
314 !*** AND PFDHT DIAGRAMS)
315 !***
316 !*** J[TYPE]_NN WHERE "TYPE" IS THE WORKING ARRAY TYPE SEEN IN THE
317 !*** LOCAL DECLARATION ABOVE (DEPENDENT UPON THE J EXTENT) AND
318 !*** NN IS THE NUMBER OF ROWS NORTH OF THE CENTRAL ROW WHOSE J IS
319 !*** THE CURRENT VALUE OF THE main_integration LOOP.
320 !*** (P3 denotes +3, M1 denotes -1, etc.)
321 !***
322 JKNT=JKNT+1
323 !
324 J4_P1=INDX3_WRK(1,JKNT,4)
325 J4_00=INDX3_WRK(0,JKNT,4)
326 J4_M1=INDX3_WRK(-1,JKNT,4)
327 !
328 J5_00=INDX3_WRK(0,JKNT,5)
329 J5_M1=INDX3_WRK(-1,JKNT,5)
330 !
331 J6_P1=INDX3_WRK(1,JKNT,6)
332 J6_00=INDX3_WRK(0,JKNT,6)
333 !
334 !-----------------------------------------------------------------------
335 !*** THE WORKING ARRAYS FOR THE PRIMARY VARIABLES
336 !-----------------------------------------------------------------------
337 !$omp parallel do &
338 !$omp& private(dpde,i,k)
339 DO K=KTS,KTE
340 !
341 DO I=MYIS_P3,MYIE_P3
342 WEW(I,K)=FEW(I,K,J)*(W(I+IVE(J),K,J)-W(I+IVW(J),K,J))
343 WNS(I,K,J4_P1)=FNS(I,K,J+1)*(W(I,K,J+2)-W(I,K,J))
344 ENDDO
345 !
346 !*** DIAGONAL FLUXES AND DIAGONALLY AVERAGED WIND
347 !
348 DO I=MYIS_P2,MYIE1_P2
349 WNE(I,K,J5_00)=FNE(I,K,J)*(W(I+IHE(J),K,J+1)-W(I,K,J))
350 WSE(I,K,J6_P1)=FSE(I,K,J+1)*(W(I+IHE(J+1),K,J)-W(I,K,J+1))
351 ENDDO
352 !-----------------------------------------------------------------------
353 !
354 DO I=MYIS2,MYIE2
355 DPDE=DETA1(K)*PDTOP+DETA2(K)*PDSLO(I,J)
356 DWDT(I,K,J)=-(WEW(I+IHW(J),K) +WEW(I+IHE(J),K) &
357 +WNS(I,K,J4_M1) +WNS(I,K,J4_P1) &
358 +WNE(I+IHW(J),K,J5_M1)+WNE(I,K,J5_00) &
359 +WSE(I,K,J6_00) +WSE(I+IHW(J),K,J6_P1)) &
360 *FAD(I,J)*HTM(I,K,J)*HBM3(I,J)/(DPDE*DT) &
361 +DWDT(I,K,J)
362 ENDDO
363 !
364 ENDDO
365 !-----------------------------------------------------------------------
366 !
367 ENDDO main_horizontal
368 !
369 !-----------------------------------------------------------------------
370 !***
371 !*** END OF HORIZONTAL ADVECTION
372 !***
373 !-----------------------------------------------------------------------
374 !
375 !$omp parallel do &
376 !$omp& private(dwdtt,i,j,k)
377 DO J=MYJS,MYJE
378 DO K=KTS,KTE
379 DO I=MYIS,MYIE
380 DWDTT=DWDT(I,K,J)*HTM(I,K,J)
381 DWDTT=MAX(DWDTT,DWDTMN(I,J))
382 DWDTT=MIN(DWDTT,DWDTMX(I,J))
383 !
384 DWDT(I,K,J)=(DWDTT*RG+1.)*(1.-WP)+PDWDT(I,K,J)*WP
385 ENDDO
386 ENDDO
387 ENDDO
388 !-----------------------------------------------------------------------
389 !
390 GDT=G*DT
391 GDT2=GDT*GDT
392 FFC=-R_D/GDT2
393 !
394 !-----------------------------------------------------------------------
395 !
396 !$omp parallel do &
397 !$omp& private(b1,b2,b3,c0,chi,coff,cwm_k,delp,dppl,dpstr,dptl,dptu, &
398 !$omp& dwdt_k,fct,hbm3ij,i,j,k,koff,pint_k,pnp1,pone,pp1,pstr, &
399 !$omp& pstrdn,pstrup,q_k,rdpdn,rdpp,rdpup,rtop_k,t_k,tfc, &
400 !$omp& tmp,ttfc,w_k)
401 final_update: DO J=MYJS3,MYJE3
402 !
403 PONE(KTE+1)=PT
404 PSTR(KTE+1)=PT
405 PNP1(KTE+1)=PT
406 CHI(KTE+1)=0.
407 !
408 DO I=MYIS2,MYIE2
409 !
410 !-----------------------------------------------------------------------
411 !
412 !*** EXTRACT COLUMNS FROM 3-D ARRAYS
413 !
414 DO K=KTS,KTE
415 CWM_K(K)=CWM(I,K,J)
416 DWDT_K(K)=DWDT(I,K,J)
417 Q_K(K)=Q(I,K,J)
418 RTOP_K(K)=RTOP(I,K,J)
419 T_K(K)=T(I,K,J)
420 ENDDO
421 !
422 DO K=KTS,KTE+1
423 PINT_K(K)=PINT(I,K,J)
424 W_K(K)=W(I,K,J)
425 ENDDO
426 !-----------------------------------------------------------------------
427 !
428 KOFF=KTE-LMH(I,J)
429 !
430 DO K=KTE,KOFF+1,-1
431 CHI(K)=0.
432 DPPL=DETA1(K)*PDTOP+DETA2(K)*PDSL(I,J)
433 RDPP(K)=1./DPPL
434 PONE(K)=PINT_K(K)
435 DPSTR=DWDT_K(K)*DPPL
436 PSTR(K)=PSTR(K+1)+DPSTR
437 PP1=PNP1(K+1)+DPSTR
438 PNP1(K)=(PP1-PONE(K))*WGHT+PONE(K)
439 TFC=Q_K(K)*P608+(1.-CWM_K(K))
440 TTFC=-CAPA*TFC+1.
441 COFF(K)=T_K(K)*TTFC*TFC*DPPL*FFC &
442 /((PNP1(K+1)+PNP1(K))*(PNP1(K+1)+PNP1(K)))
443 ENDDO
444 !-----------------------------------------------------------------------
445 !
446 PSTRUP=-(PSTR(KTE+1)+PSTR(KTE)-PONE(KTE+1)-PONE(KTE))*COFF(KTE)
447 !
448 !-----------------------------------------------------------------------
449 DO K=KTE-1,KOFF+1,-1
450 RDPDN=RDPP(K)
451 RDPUP=RDPP(K+1)
452 !
453 PSTRDN=-(PSTR(K+1)+PSTR(K)-PONE(K+1)-PONE(K))*COFF(K)
454 !
455 B1(K)=COFF(K+1)+RDPUP
456 B2(K)=(COFF(K+1)+COFF(K))-(RDPUP+RDPDN)
457 B3(K)=COFF(K)+RDPDN
458 C0(K)=PSTRUP+PSTRDN
459 !
460 PSTRUP=PSTRDN
461 ENDDO
462 !-----------------------------------------------------------------------
463 B1(KTE-1)=0.
464 B2(KOFF+1)=B2(KOFF+1)+B3(KOFF+1)
465 !-----------------------------------------------------------------------
466 !
467 !*** ELIMINATION
468 !
469 DO K=KTE-2,KOFF+1,-1
470 TMP=-B1(K)/B2(K+1)
471 B2(K)=B3(K+1)*TMP+B2(K)
472 C0(K)=C0(K+1)*TMP+C0(K)
473 ENDDO
474 !
475 CHI(KTE+1)=0.
476 !-----------------------------------------------------------------------
477 !
478 !*** BACK SUBSTITUTION
479 !
480 CHI(KOFF+2)=C0(KOFF+1)/B2(KOFF+1)
481 CHI(KOFF+1)=CHI(KOFF+2)
482 !
483 DO K=KOFF+3,KTE
484 CHI(K)=(-B3(K-1)*CHI(K-1)+C0(K-1))/B2(K-1)
485 ENDDO
486 !-----------------------------------------------------------------------
487 HBM3IJ=HBM3(I,J)
488 DPTU=0.
489 FCT=0.5/CP*HBM3IJ
490 !
491 DO K=KTE,KOFF+1,-1
492 DPTL=(CHI(K)+PSTR(K)-PINT_K(K))*HBM3IJ
493 PINT_K(K)=PINT_K(K)+DPTL
494 T_K(K)=(DPTU+DPTL)*RTOP_K(K)*FCT+T_K(K)
495 DELP=(PINT_K(K)-PINT_K(K+1))*RDPP(K)
496 W_K(K)=((DELP-DWDT_K(K))*GDT+W_K(K))*HBM3IJ
497 DWDT_K(K)=(DELP-1.)*HBM3IJ+1.
498 !
499 DPTU=DPTL
500 ENDDO
501 !-----------------------------------------------------------------------
502 DO K=KOFF+1,KTE
503 PINT(I,K,J)=PINT_K(K)
504 T(I,K,J)=T_K(K)
505 W(I,K,J)=W_K(K)
506 DWDT(I,K,J)=DWDT_K(K)
507 ENDDO
508 !-----------------------------------------------------------------------
509 !
510 ENDDO
511 !
512 ENDDO final_update
513 !
514 !-----------------------------------------------------------------------
515 !
516 END SUBROUTINE EPS
517 !
518 !-----------------------------------------------------------------------
519 !
520 !-----------------------------------------------------------------------
521 !***********************************************************************
522 SUBROUTINE VADZ(NTSD,DT,FIS,SIGMA,DFL,HTM,HBM2 &
523 ,DETA1,DETA2,PDTOP &
524 ,PINT,PDSL,PDSLO,PETDT &
525 ,RTOP,T,Q,CWM,Z,W,DWDT,PDWDT &
526 ,IHE,IHW,IVE,IVW,INDX3_WRK &
527 ,IDS,IDE,JDS,JDE,KDS,KDE &
528 ,IMS,IME,JMS,JME,KMS,KME &
529 ,ITS,ITE,JTS,JTE,KTS,KTE)
530 !***********************************************************************
531 !$$$ SUBPROGRAM DOCUMENTATION BLOCK
532 ! . . .
533 ! SUBPROGRAM: VADZ VERTICAL ADVECTION OF HEIGHT
534 ! PRGRMMR: JANJIC ORG: W/NP22 DATE: 93-11-17
535 !
536 ! ABSTRACT:
537 ! VADV CALCULATES THE CONTRIBUTION OF THE VERTICAL ADVECTION
538 ! OF HEIGHT IN ORDER TO COMPUTE W=DZ/DT DIAGNOSTICALLY
539 !
540 ! PROGRAM HISTORY LOG:
541 ! 96-05-?? JANJIC - ORIGINATOR
542 ! 00-01-04 BLACK - DISTRIBUTED MEMORY AND THREADS
543 ! 01-03-26 BLACK - CONVERTED TO WRF STRUCTURE
544 ! 02-02-19 BLACK - CONVERSION UPDATED
545 ! 04-11-22 BLACK - THREADED
546 !
547 ! USAGE: CALL VADZ FROM MAIN PROGRAM
548 ! INPUT ARGUMENT LIST:
549 !
550 ! OUTPUT ARGUMENT LIST:
551 !
552 ! OUTPUT FILES:
553 ! NONE
554 !
555 ! SUBPROGRAMS CALLED:
556 !
557 ! UNIQUE: NONE
558 !
559 ! LIBRARY: NONE
560 !
561 ! ATTRIBUTES:
562 ! LANGUAGE: FORTRAN 90
563 ! MACHINE : IBM SP
564 !$$$
565 !***********************************************************************
566 !-----------------------------------------------------------------------
567 !
568 IMPLICIT NONE
569 !
570 !-----------------------------------------------------------------------
571 #ifdef AS_RECEIVED
572 LOGICAL,INTENT(IN) :: SIGMA
573 #else
574 INTEGER,INTENT(IN) :: SIGMA
575 #endif
576 !
577 INTEGER,INTENT(IN) :: NTSD
578 !
579 INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
580 ,IMS,IME,JMS,JME,KMS,KME &
581 ,ITS,ITE,JTS,JTE,KTS,KTE
582 !
583 INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW
584 !
585 !-----------------------------------------------------------------------
586 !!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
587 !*** NMM_MAX_DIM is set in configure.wrf and must agree with
588 !*** the value of dimspec q in the Registry/Registry
589 !!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
590 !-----------------------------------------------------------------------
591 !
592 INTEGER,DIMENSION(-3:3,NMM_MAX_DIM,0:6),INTENT(IN) :: INDX3_WRK
593 !
594 REAL,INTENT(IN) :: DT,PDTOP
595 !
596 REAL,DIMENSION(KTS:KTE),INTENT(IN) :: DETA1,DETA2
597 !
598 REAL,DIMENSION(KTS:KTE+1),INTENT(IN) :: DFL
599 !
600 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: FIS,HBM2,PDSL,PDSLO
601 !
602 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: PETDT
603 !
604 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: CWM,HTM &
605 ,Q,RTOP,T
606 !
607 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(OUT) :: PDWDT
608 !
609 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: DWDT
610 !
611 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: PINT
612 !
613 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(OUT) :: W,Z
614 !-----------------------------------------------------------------------
615 !
616 !*** LOCAL VARIABLES
617 !
618 !-----------------------------------------------------------------------
619 INTEGER :: I,J,K
620 !
621 REAL,DIMENSION(IMS:IME,JMS:JME) :: FNE,FSE,TTB
622 !
623 REAL :: DZ,RDT,TTAL,ZETA
624 !-----------------------------------------------------------------------
625 !***********************************************************************
626 !-----------------------------------------------------------------------
627 RDT=1./DT
628 !-----------------------------------------------------------------------
629 !$omp parallel do &
630 !$omp& private(dz,i,j,k,zeta)
631 DO J=MYJS,MYJE
632 !
633 DO K=KTS,KTE
634 DO I=MYIS,MYIE
635 PDWDT(I,K,J)=DWDT(I,K,J)
636 DWDT(I,K,J)=W(I,K,J)
637 ENDDO
638 ENDDO
639 !
640 DO I=MYIS,MYIE
641 W(I,KTS,J)=0.
642 #ifdef AS_RECEIVED
643 IF(SIGMA)THEN
644 #else
645 IF(SIGMA==1)THEN
646 #endif
647 Z(I,KTS,J)=FIS(I,J)*RG
648 ELSE
649 Z(I,KTS,J)=0.
650 ENDIF
651 ENDDO
652 !
653 DO K=KTS,KTE
654 !
655 ZETA=DFL(K+1)*RG
656 !
657 DO I=MYIS,MYIE
658 !
659 DZ=(Q(I,K,J)*P608-CWM(I,K,J)+1.)*T(I,K,J) &
660 /(PINT(I,K+1,J)+PINT(I,K,J)) &
661 *(DETA1(K)*PDTOP+DETA2(K)*PDSL(I,J))*TRG
662 Z(I,K+1,J)=(Z(I,K,J)+DZ-ZETA)*HTM(I,K,J)+ZETA
663 W(I,K+1,J)=(DZ-RTOP(I,K,J) &
664 *(DETA1(K)*PDTOP+DETA2(K)*PDSLO(I,J))*RG) &
665 *HTM(I,K,J)*HBM2(I,J) &
666 +W(I,K,J)
667 !
668 ENDDO
669 ENDDO
670 !
671 ENDDO
672 !-----------------------------------------------------------------------
673 !$omp parallel do &
674 !$omp& private(i,j,k)
675 DO J=MYJS,MYJE
676 !
677 DO K=KTS,KTE
678 DO I=MYIS,MYIE
679 Z(I,K,J)=(Z(I,K+1,J)+Z(I,K,J))*0.5
680 W(I,K,J)=(W(I,K+1,J)+W(I,K,J))*HTM(I,K,J)*HBM2(I,J)*0.5*RDT
681 ENDDO
682 ENDDO
683 !
684 ENDDO
685 !-----------------------------------------------------------------------
686 DO J=MYJS,MYJE
687 DO I=MYIS,MYIE
688 TTB(I,J)=0.
689 ENDDO
690 ENDDO
691 !
692 !$omp parallel do &
693 !$omp& private(i,j,k,ttal)
694 DO J=MYJS2,MYJE2
695 DO K=KTE,KTS+1,-1
696 DO I=MYIS1,MYIE1
697 TTAL=(Z(I,K-1,J)-Z(I,K,J))*PETDT(I,K-1,J)*0.5
698 W(I,K,J)=(TTAL+TTB(I,J))/(DETA1(K)*PDTOP+DETA2(K)*PDSLO(I,J)) &
699 +W(I,K,J)
700 TTB(I,J)=TTAL
701 ENDDO
702 ENDDO
703 ENDDO
704 !
705 !$omp parallel do &
706 !$omp& private(i,j)
707 DO J=MYJS2,MYJE2
708 DO I=MYIS1,MYIE1
709 W(I,KTS,J)=TTB(I,J)/(DETA1(KTS)*PDTOP+DETA2(KTS)*PDSLO(I,J)) &
710 +W(I,KTS,J)
711 ENDDO
712 ENDDO
713 !-----------------------------------------------------------------------
714 END SUBROUTINE VADZ
715 !-----------------------------------------------------------------------
716 !
717 !-----------------------------------------------------------------------
718 !***********************************************************************
719 SUBROUTINE HADZ(NTSD,DT,HYDRO,HTM,HBM2,DETA1,DETA2,PDTOP &
720 ,DX,DY,FAD &
721 ,FEW,FNS,FNE,FSE &
722 ,PDSL,U,V,W,Z &
723 ,IHE,IHW,IVE,IVW,INDX3_WRK &
724 ,IDS,IDE,JDS,JDE,KDS,KDE &
725 ,IMS,IME,JMS,JME,KMS,KME &
726 ,ITS,ITE,JTS,JTE,KTS,KTE)
727 !***********************************************************************
728 !$$$ SUBPROGRAM DOCUMENTATION BLOCK
729 ! . . .
730 ! SUBPROGRAM: HADZ HORIZONTAL ADVECTION OF HEIGHT
731 ! PRGRMMR: JANJIC ORG: W/NP22 DATE: 96-05-??
732 !
733 ! ABSTRACT:
734 ! HADZ CALCULATES DIAGNOSTICALLY THE CONTRIBUTION OF
735 ! THE HORIZONTAL ADVECTION OF HEIGHT
736 !
737 ! PROGRAM HISTORY LOG:
738 ! 96-05-?? JANJIC - ORIGINATOR
739 ! 00-01-04 BLACK - DISTRIBUTED MEMORY AND THREADS
740 ! 01-03-26 BLACK - CONVERTED TO WRF STRUCTURE
741 ! 04-11-22 BLACK - THREADED
742 !
743 ! USAGE: CALL HADZ FROM MAIN PROGRAM
744 ! INPUT ARGUMENT LIST:
745 !
746 ! OUTPUT ARGUMENT LIST:
747 ! NONE
748 !
749 ! OUTPUT FILES:
750 !
751 ! SUBPROGRAMS CALLED:
752 !
753 ! UNIQUE: NONE
754 !
755 ! LIBRARY: NONE
756 !
757 ! ATTRIBUTES:
758 ! LANGUAGE: FORTRAN 90
759 ! MACHINE : IBM SP
760 !$$$
761 !***********************************************************************
762 !-----------------------------------------------------------------------
763 !
764 IMPLICIT NONE
765 !
766 !-----------------------------------------------------------------------
767 LOGICAL,INTENT(IN) :: HYDRO
768 !
769 INTEGER,INTENT(IN) :: NTSD
770 !
771 INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
772 ,IMS,IME,JMS,JME,KMS,KME &
773 ,ITS,ITE,JTS,JTE,KTS,KTE
774 !
775 INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW
776 !
777 !-----------------------------------------------------------------------
778 !!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
779 !*** NMM_MAX_DIM is set in configure.wrf and must agree with
780 !*** the value of dimspec q in the Registry/Registry
781 !!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
782 !-----------------------------------------------------------------------
783 !
784 INTEGER,DIMENSION(-3:3,NMM_MAX_DIM,0:6),INTENT(IN) :: INDX3_WRK
785 !
786 REAL,INTENT(IN) :: DT,DY,PDTOP
787 !
788 REAL,DIMENSION(KMS:KME-1),INTENT(IN) :: DETA1,DETA2
789 !
790 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: DX,FAD,HBM2,PDSL
791 !
792 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: HTM,U,V
793 !
794 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(OUT) :: FEW,FNE &
795 ,FNS,FSE
796 !
797 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: Z
798 !
799 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: W
800 !-----------------------------------------------------------------------
801 !
802 !*** LOCAL VARIABLES
803 !
804 !-----------------------------------------------------------------------
805 INTEGER,PARAMETER :: NTSHY=2
806 !
807 INTEGER :: I,J,J1_00,J1_P1,J1_P2,J4_00,J4_M1,J4_P1,J5_00,J5_M1 &
808 ,J6_00,J6_P1,JJ,JKNT,JSTART,K
809 !
810 REAL :: FEWP,FNEP,FNSP,FSEP,UDY,VDX
811 !
812 REAL,DIMENSION(IMS:IME,KTS:KTE) :: UDY_00,ZEW
813 !
814 !*** TYPE 1 WORKING ARRAY (SEE PFDHT)
815 !
816 REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,-2:2) :: DPDE
817 !
818 !*** TYPE 4 WORKING ARRAY
819 !
820 REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,-1:1) :: UNED,USED,ZNS
821 !
822 !*** TYPE 5 WORKING ARRAY
823 !
824 REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,-1:0) :: ZNE
825 !
826 !*** TYPE 6 WORKING ARRAY
827 !
828 REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE, 0:1) :: ZSE
829 !-----------------------------------------------------------------------
830 !***********************************************************************
831 !-----------------------------------------------------------------------
832 IF(NTSD+1<=NTSHY.OR.HYDRO)THEN
833 !$omp parallel do &
834 !$omp& private(i,j,k)
835 DO J=MYJS,MYJE
836 DO K=KTS,KTE
837 DO I=MYIS,MYIE
838 W(I,K,J)=0.
839 ENDDO
840 ENDDO
841 ENDDO
842 !***
843 RETURN
844 !***
845 ENDIF
846 !-----------------------------------------------------------------------
847 !***********************************************************************
848 !-----------------------------------------------------------------------
849 !
850 !*** FIRST ZERO OUT SOME WORKING ARRAYS
851 !
852 DO J=-2,2
853 !$omp parallel do &
854 !$omp& private(i,k)
855 DO K=KTS,KTE
856 DO I=ITS-5,ITE+5
857 DPDE(I,K,J)=0.
858 ENDDO
859 ENDDO
860 ENDDO
861 !
862 DO J=-1,1
863 !$omp parallel do &
864 !$omp& private(i,k)
865 DO K=KTS,KTE
866 DO I=ITS-5,ITE+5
867 UNED(I,K,J)=0.
868 USED(I,K,J)=0.
869 ENDDO
870 ENDDO
871 ENDDO
872 !
873 !-----------------------------------------------------------------------
874 !*** MARCH NORTHWARD THROUGH THE SOUTHERNMOST SLABS TO BEGIN
875 !*** FILLING THE MAIN WORKING ARRAYS WHICH ARE MULTI-DIMENSIONED
876 !*** IN J BECAUSE THEY ARE DIFFERENCED OR AVERAGED IN J
877 !-----------------------------------------------------------------------
878 !
879 JSTART=MYJS2_P1
880 !
881 DO J=-2,1
882 JJ=JSTART+J
883 !
884 !$omp parallel do &
885 !$omp& private(i,k)
886 DO K=KTS,KTE
887 DO I=MYIS_P4,MYIE_P4
888 DPDE(I,K,J)=DETA1(K)*PDTOP+DETA2(K)*PDSL(I,JJ)
889 ENDDO
890 ENDDO
891 !
892 ENDDO
893 !
894 DO J=-1,0
895 JJ=JSTART+J
896 !
897 !$omp parallel do &
898 !$omp& private(fnsp,i,k,udy,vdx)
899 DO K=KTS,KTE
900 DO I=MYIS_P3,MYIE_P3
901 UDY=U(I,K,JJ)*DY
902 VDX=V(I,K,JJ)*DX(I,JJ)
903 UNED(I,K,J)=UDY+VDX
904 USED(I,K,J)=UDY-VDX
905 FNSP=VDX*(DPDE(I,K,J-1)+DPDE(I,K,J+1))
906 ZNS(I,K,J)=FNSP*(Z(I,K,JJ+1)-Z(I,K,JJ-1))
907 FNS(I,K,JJ)=FNSP
908 UDY_00(I,K)=UDY
909 ENDDO
910 ENDDO
911 !
912 ENDDO
913 !
914 J=-1
915 JJ=JSTART+J
916 !
917 !$omp parallel do &
918 !$omp& private(fnep,i,k)
919 DO K=KTS,KTE
920 DO I=MYIS_P2,MYIE_P2
921 FNEP=(UNED(I+IHE(JJ),K,J)+UNED(I,K,J+1)) &
922 *(DPDE(I,K,J)+DPDE(I+IHE(JJ),K,J+1))
923 ZNE(I,K,J)=FNEP*(Z(I+IHE(JJ),K,JJ+1)-Z(I,K,JJ))
924 ENDDO
925 ENDDO
926 !
927 J=0
928 JJ=JSTART+J
929 !
930 !$omp parallel do &
931 !$omp& private(fsep,i,k)
932 DO K=KTS,KTE
933 DO I=MYIS_P2,MYIE_P2
934 FSEP=(USED(I+IHE(JJ),K,J)+USED(I,K,J-1)) &
935 *(DPDE(I,K,J)+DPDE(I+IHE(JJ),K,J-1))
936 ZSE(I,K,J)=FSEP*(Z(I+IHE(JJ),K,JJ-1)-Z(I,K,JJ))
937 FSE(I,K,JJ)=FSEP
938 ENDDO
939 ENDDO
940 !-----------------------------------------------------------------------
941 !
942 JKNT=0
943 !
944 main_integration: DO J=MYJS2_P1,MYJE2_P1
945 !
946 !-----------------------------------------------------------------------
947 !***
948 !*** SET THE 3RD INDEX IN THE WORKING ARRAYS (SEE SUBROUTINE INIT
949 !*** AND ABOVE DIAGRAMS)
950 !***
951 !*** J[TYPE]_NN WHERE "TYPE" IS THE WORKING ARRAY TYPE SEEN IN THE
952 !*** LOCAL DECLARATION ABOVE (DEPENDENT UPON THE J EXTENT) AND
953 !*** NN IS THE NUMBER OF ROWS NORTH OF THE CENTRAL ROW WHOSE J IS
954 !*** THE CURRENT VALUE OF THE main_integration LOOP.
955 !*** (P2 denotes +2, etc.)
956 !***
957 JKNT=JKNT+1
958 !
959 J1_P2=INDX3_WRK(2,JKNT,1)
960 J1_P1=INDX3_WRK(1,JKNT,1)
961 J1_00=INDX3_WRK(0,JKNT,1)
962 !
963 J4_P1=INDX3_WRK(1,JKNT,4)
964 J4_00=INDX3_WRK(0,JKNT,4)
965 J4_M1=INDX3_WRK(-1,JKNT,4)
966 !
967 J5_00=INDX3_WRK(0,JKNT,5)
968 J5_M1=INDX3_WRK(-1,JKNT,5)
969 !
970 J6_P1=INDX3_WRK(1,JKNT,6)
971 J6_00=INDX3_WRK(0,JKNT,6)
972 !-----------------------------------------------------------------------
973 !
974 !*** MASS FLUXES AND MASS POINT ADVECTION COMPONENTS
975 !
976 !-----------------------------------------------------------------------
977 !$omp parallel do &
978 !$omp& private(fewp,fnep,fnsp,fsep,i,k,udy,vdx)
979 DO K=KTS,KTE
980 !
981 DO I=MYIS_P4,MYIE_P4
982 DPDE(I,K,J1_P2)=DETA1(K)*PDTOP+DETA2(K)*PDSL(I,J+2)
983 ENDDO
984 !
985 DO I=MYIS_P3,MYIE_P3
986 UDY=U(I,K,J+1)*DY
987 VDX=V(I,K,J+1)*DX(I,J+1)
988 !
989 FEWP=UDY_00(I,K) &
990 *(DPDE(I+IVW(J),K,J1_00)+DPDE(I+IVE(J),K,J1_00))
991 FNSP=VDX*(DPDE(I,K,J1_00)+DPDE(I,K,J1_P2))
992 !
993 FEW(I,K,J)=FEWP
994 FNS(I,K,J+1)=FNSP
995 !
996 ZEW(I,K)=FEWP*(Z(I+IVE(J),K,J)-Z(I+IVW(J),K,J))
997 ZNS(I,K,J4_P1)=FNSP*(Z(I,K,J+2)-Z(I,K,J))
998 !
999 UNED(I,K,J4_P1)=UDY+VDX
1000 USED(I,K,J4_P1)=UDY-VDX
1001 !
1002 UDY_00(I,K)=UDY
1003 ENDDO
1004 !
1005 !-----------------------------------------------------------------------
1006 !
1007 !*** DIAGONAL FLUXES AND DIAGONALLY AVERAGED WIND
1008 !
1009 !-----------------------------------------------------------------------
1010 DO I=MYIS_P2,MYIE1_P2
1011 FNEP=(UNED(I+IHE(J),K,J4_00)+UNED(I,K,J4_P1)) &
1012 *(DPDE(I,K,J1_00)+DPDE(I+IHE(J),K,J1_P1))
1013 FNE(I,K,J)=FNEP
1014 ZNE(I,K,J5_00)=FNEP*(Z(I+IHE(J),K,J+1)-Z(I,K,J))
1015 !
1016 FSEP=(USED(I+IHE(J+1),K,J4_P1)+USED(I,K,J4_00)) &
1017 *(DPDE(I,K,J1_P1)+DPDE(I+IHE(J+1),K,J1_00))
1018 FSE(I,K,J+1)=FSEP
1019 ZSE(I,K,J6_P1)=FSEP*(Z(I+IHE(J+1),K,J)-Z(I,K,J+1))
1020 ENDDO
1021 !
1022 !-----------------------------------------------------------------------
1023 !
1024 !*** ADVECTION OF Z
1025 !
1026 !-----------------------------------------------------------------------
1027 DO I=MYIS1_P1,MYIE1_P1
1028 W(I,K,J)=-(ZEW(I+IHW(J),K)+ZEW(I+IHE(J),K) &
1029 +ZNS(I,K,J4_M1)+ZNS(I,K,J4_P1) &
1030 +ZNE(I+IHW(J),K,J5_M1)+ZNE(I,K,J5_00) &
1031 +ZSE(I,K,J6_00)+ZSE(I+IHW(J),K,J6_P1)) &
1032 *FAD(I,J)*HTM(I,K,J)*HBM2(I,J)/(DPDE(I,K,J1_00)*DT) &
1033 +W(I,K,J)
1034 ENDDO
1035 !
1036 ENDDO ! End K loop
1037 !-----------------------------------------------------------------------
1038 !
1039 ENDDO main_integration
1040 !
1041 !-----------------------------------------------------------------------
1042 !
1043 END SUBROUTINE HADZ
1044 !
1045 !-----------------------------------------------------------------------
1046 END MODULE MODULE_NONHY_DYNAM
1047 !-----------------------------------------------------------------------