module_IGWAVE_ADJUST.F
References to this file elsewhere.
1 !-----------------------------------------------------------------------
2 !
3 !NCEP_MESO:MODEL_LAYER: INERTIAL GRAVITY WAVE ADJUSTMENT
4 !
5 !-----------------------------------------------------------------------
6 #include "nmm_loop_basemacros.h"
7 #include "nmm_loop_macros.h"
8 #define DATA_CALLS_INCLUDED
9 !-----------------------------------------------------------------------
10 !
11 MODULE MODULE_IGWAVE_ADJUST
12 !
13 !-----------------------------------------------------------------------
14 USE MODULE_MODEL_CONSTANTS
15 ! USE MODULE_TIMERS ! this one creates a name conflict at compile time
16 !-----------------------------------------------------------------------
17 !***
18 !*** SPECIFY THE NUMBER OF TIMES TO SMOOTH THE VERTICAL VELOCITY
19 !*** AND THE NUMBER OF ROWS FROM THE NORTHERN AND SOUTHERN EDGES
20 !*** OF THE GLOBAL DOMAIN BEYOND WHICH THE SMOOTHING DOES NOT GO
21 !*** FOR SUBROUTINE PDTE
22 !
23 INTEGER :: KSMUD=0,LNSDT=7
24 !
25 !-----------------------------------------------------------------------
26 !
27 CONTAINS
28 !
29 !***********************************************************************
30 SUBROUTINE PFDHT(NTSD,LAST_TIME,PT,DETA1,DETA2,PDTOP,RES,FIS &
31 & ,HYDRO,SIGMA,FIRST,DX,DY &
32 & ,HTM,HBM2,VTM,VBM2,VBM3 &
33 & ,FDIV,FCP,WPDAR,DFL,CPGFU,CPGFV &
34 & ,PD,PDSL,T,Q,U,V,CWM,OMGALF,PINT,DWDT &
35 & ,RTOP,DIV,FEW,FNS,FNE,FSE &
36 & ,IHE,IHW,IVE,IVW,INDX3_WRK &
37 & ,IDS,IDE,JDS,JDE,KDS,KDE &
38 & ,IMS,IME,JMS,JME,KMS,KME &
39 & ,ITS,ITE,JTS,JTE,KTS,KTE)
40 !***********************************************************************
41 !$$$ SUBPROGRAM DOCUMENTATION BLOCK
42 ! . . .
43 ! SUBPROGRAM: PFDHT DIVERGENCE/HORIZONTAL OMEGA-ALPHA
44 ! PRGRMMR: JANJIC ORG: W/NP22 DATE: 93-10-28
45 !
46 ! ABSTRACT:
47 ! PFDHT CALCULATES THE PRESSURE GRADIENT FORCE, UPDATES THE
48 ! VELOCITY COMPONENTS DUE TO THE EFFECT OF THE PRESSURE GRADIENT
49 ! AND CORIOILS FORCES, COMPUTES THE DIVERGENCE INCLUDING THE
50 ! MODIFICATION PREVENTING GRAVITY WAVE GRID SEPARATION, AND
51 ! CALCULATES THE HORIZONTAL PART OF THE OMEGA-ALPHA TERM.
52 ! (THE PART PROPORTIONAL TO THE ADVECTION OF MASS ALONG
53 ! COORDINATE SURFACES).
54 !
55 ! PROGRAM HISTORY LOG:
56 ! 87-06-?? JANJIC - ORIGINATOR
57 ! 95-03-25 BLACK - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL
58 ! 96-03-29 BLACK - ADDED EXTERNAL EDGE
59 ! 98-10-30 BLACK - MODIFIED FOR DISTRIBUTED MEMORY
60 ! 02-02-01 BLACK - REWRITTEN FOR WRF CODING STANDARDS
61 ! 04-02-17 JANJIC - REMOVED UPDATE OF TEMPERATURE
62 ! 04-11-23 BLACK - THREADED
63 !
64 ! USAGE: CALL PFDHT FROM MAIN PROGRAM SOLVE_RUNSTREAM
65 ! INPUT ARGUMENT LIST:
66 !
67 ! OUTPUT ARGUMENT LIST:
68 !
69 ! OUTPUT FILES:
70 ! NONE
71 !
72 ! SUBPROGRAMS CALLED:
73 !
74 ! UNIQUE: NONE
75 !
76 ! LIBRARY: NONE
77 !
78 ! ATTRIBUTES:
79 ! LANGUAGE: FORTRAN 90
80 ! MACHINE : IBM SP
81 !$$$
82 !-----------------------------------------------------------------------
83 !***********************************************************************
84 !-----------------------------------------------------------------------
85 IMPLICIT NONE
86 !-----------------------------------------------------------------------
87 !#ifdef DM_PARALLEL
88 ! INCLUDE "mpif.h"
89 !#endif
90 !-----------------------------------------------------------------------
91 LOGICAL,INTENT(IN) :: FIRST,HYDRO
92 INTEGER,INTENT(IN) :: SIGMA
93 !
94 INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
95 & ,IMS,IME,JMS,JME,KMS,KME &
96 & ,ITS,ITE,JTS,JTE,KTS,KTE
97 !
98 INTEGER, DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW
99 !
100 !*** NMM_MAX_DIM is set in configure.wrf and must agree with
101 !*** the value of dimspec q in the Registry/Registry
102 !
103 INTEGER,DIMENSION(-3:3,NMM_MAX_DIM,0:6),INTENT(IN) :: INDX3_WRK
104 !
105 INTEGER,INTENT(IN) :: NTSD
106 LOGICAL,INTENT(IN) :: LAST_TIME
107 !
108 REAL,INTENT(IN) :: CPGFV,DY,PDTOP,PT
109 !
110 REAL,DIMENSION(KMS:KME-1),INTENT(IN) :: DETA1,DETA2
111 !
112 REAL,DIMENSION(KMS:KME),INTENT(IN) :: DFL
113 !
114 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: CPGFU,DX,FCP,FDIV &
115 & ,PD,FIS,RES,WPDAR &
116 & ,HBM2,VBM2,VBM3
117 !
118 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: CWM,DWDT &
119 & ,Q,T,HTM,VTM
120 !
121 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: PINT
122 !
123 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: DIV &
124 & ,OMGALF &
125 & ,RTOP,U,V
126 !
127 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(OUT) :: FEW,FNS &
128 & ,FNE,FSE
129 !
130 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: PDSL
131 !-----------------------------------------------------------------------
132 !
133 !*** LOCAL VARIABLES
134 !
135 INTEGER :: I,J,JJ,JKNT,JSTART,K
136 INTEGER :: J1_00,J1_M1,J1_P1,J1_P2
137 INTEGER :: J2_00,J2_M1,J2_P1
138 INTEGER :: J3_00,J3_P1,J3_P2
139 INTEGER :: J4_00,J4_M1,J4_P1
140 INTEGER :: J5_00,J5_M1
141 INTEGER :: J6_00,J6_P1
142 !
143 REAL,DIMENSION(ITS-5:ITE+5,JTS-5:JTE+5) :: ALP1,FILO
144 !
145 REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE+1,JTS-5:JTE+5) :: PINTLG
146 !
147 REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,JTS-5:JTE+5) :: FIM
148 !
149 REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE) :: DIVL,TEW
150 !
151 REAL :: ADPDNE,ADPDSE,ADPDX,ADPDY,APELP,DFI,DCNEK,DCSEK &
152 & ,DPFEW,DPFNS,DPFNEK,DPFSEK,DPNEK,DPSEK,EDIV,FIUP &
153 & ,HM,PCEW,PCNS,PEW,PNS,PRSFRC,PVNEK,PVSEK,RTOPP,VM
154 !
155 REAL :: SLP_STD=101300.0
156 !
157 !*** TYPE 1 WORKING ARRAY
158 !
159 REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,-2:2) :: APEL,DFDZ,DPDE
160 !
161 !*** TYPE 2 WORKING ARRAY
162 !
163 REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,-2:1) :: CNE,PCNE,PNE,PPNE
164 !
165 !*** TYPE 3 WORKING ARRAY
166 !
167 REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,-1:2) :: CSE,PCSE,PPSE,PSE
168 !
169 !*** TYPE 4 WORKING ARRAY
170 !
171 REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,-1:1) :: PCXC,TNS,UDY,VDX
172 !
173 !*** TYPE 5 WORKING ARRAY
174 !
175 REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,-1:0) :: TNE
176 !
177 !*** TYPE 6 WORKING ARRAY
178 !
179 REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE, 0:1) :: TSE
180 !-----------------------------------------------------------------------
181 !***********************************************************************
182 !
183 !
184 ! CSE CSE ------- 1
185 ! * *
186 ! * *
187 ! ******* * ******* *
188 ! * * * * * *
189 ! CNE * * CNE * *
190 ! TEW----------OMGALF----------TEW ------- 0
191 ! CSE * * CSE * *
192 ! * * * * * *
193 ! ******* * ******* *
194 ! * *
195 ! * *
196 ! CNE CNE ------- -1
197 !
198 !
199 !
200 !
201 !***********************************************************************
202 !
203 ! CSE ------- 2
204 ! *
205 ! *
206 ! *
207 ! *
208 ! CNE*****TNS ------- 1
209 ! CSE | *
210 ! | *
211 ! | *
212 ! | *
213 ! | CNE
214 ! OMGALF ------- 0
215 ! | CSE
216 ! | *
217 ! | *
218 ! | *
219 ! CNE | *
220 ! CSE*****TNS ------- -1
221 ! *
222 ! *
223 ! *
224 ! *
225 ! CNE ------- -2
226 !
227 !***********************************************************************
228 !-----------------------------------------------------------------------
229 !*** PREPARATORY CALCULATIONS
230 !-----------------------------------------------------------------------
231 ! call hpm_start('PFDHT')
232 !
233 DO J=JMS,JME
234 DO I=IMS,IME
235 PDSL(I,J)=0.
236 ENDDO
237 ENDDO
238 !
239 DO J=JMS,JME
240 DO K=KMS,KME
241 DO I=IMS,IME
242 OMGALF(I,K,J)=0.
243 ENDDO
244 ENDDO
245 ENDDO
246 !
247 !*** ZERO OUT TEMPORARIES.
248 !
249 DO J=JTS-5,JTE+5
250 DO I=ITS-5,ITE+5
251 ALP1(I,J)=0.
252 FILO(I,J)=0.
253 ENDDO
254 ENDDO
255 !
256 DO J=JTS-5,JTE+5
257 DO K=KTS,KTE+1
258 DO I=ITS-5,ITE+5
259 PINTLG(I,K,J)=0.
260 ENDDO
261 ENDDO
262 ENDDO
263 !
264 DO J=JTS-5,JTE+5
265 DO K=KTS,KTE
266 DO I=ITS-5,ITE+5
267 FIM(I,K,J)=0.
268 ENDDO
269 ENDDO
270 ENDDO
271 !
272 DO K=KTS,KTE
273 DO I=ITS-5,ITE+5
274 DIVL(I,K)=0.
275 TEW(I,K)=0.
276 ENDDO
277 ENDDO
278 !
279 DO J=-2,2
280 DO K=KTS,KTE
281 DO I=ITS-5,ITE+5
282 APEL(I,K,J)=0.
283 DFDZ(I,K,J)=0.
284 DPDE(I,K,J)=0.
285 ENDDO
286 ENDDO
287 ENDDO
288 !
289 DO J=-2,1
290 DO K=KTS,KTE
291 DO I=ITS-5,ITE+5
292 CNE(I,K,J)=0.
293 PCNE(I,K,J)=0.
294 PNE(I,K,J)=0.
295 PPNE(I,K,J)=0.
296 ENDDO
297 ENDDO
298 ENDDO
299 !
300 DO J=-1,2
301 DO K=KTS,KTE
302 DO I=ITS-5,ITE+5
303 CSE(I,K,J)=0.
304 PCSE(I,K,J)=0.
305 PSE(I,K,J)=0.
306 PPSE(I,K,J)=0.
307 ENDDO
308 ENDDO
309 ENDDO
310 !
311 DO J=-1,1
312 DO K=KTS,KTE
313 DO I=ITS-5,ITE+5
314 PCXC(I,K,J)=0.
315 TNS(I,K,J)=0.
316 UDY(I,K,J)=0.
317 VDX(I,K,J)=0.
318 ENDDO
319 ENDDO
320 ENDDO
321 !
322 DO J=-1,0
323 DO K=KTS,KTE
324 DO I=ITS-5,ITE+5
325 TNE(I,K,J)=0.
326 ENDDO
327 ENDDO
328 ENDDO
329 !
330 DO J=0,1
331 DO K=KTS,KTE
332 DO I=ITS-5,ITE+5
333 TSE(I,K,J)=0.
334 ENDDO
335 ENDDO
336 ENDDO
337 !
338 IF(SIGMA.EQ.1)THEN
339 DO J=MYJS_P4,MYJE_P4
340 DO I=MYIS_P4,MYIE_P4
341 FILO(I,J)=FIS(I,J)
342 PDSL(I,J)=PD(I,J)
343 ENDDO
344 ENDDO
345 ELSE
346 DO J=MYJS_P4,MYJE_P4
347 DO I=MYIS_P4,MYIE_P4
348 FILO(I,J)=0.0
349 PDSL(I,J)=RES(I,J)*PD(I,J)
350 ENDDO
351 ENDDO
352 ENDIF
353 !
354 !-----------------------------------------------------------------------
355 !***
356 !*** INTEGRATE THE GEOPOTENTIAL
357 !***
358 !-----------------------------------------------------------------------
359 !
360 !$omp parallel do &
361 !$omp& private(apelp,dfi,fiup,i,j,k,rtopp)
362 DO J=MYJS_P4,MYJE_P4
363 !
364 DO K=KTS,KTE
365 DO I=MYIS_P4,MYIE_P4
366 !
367 APELP=(PINT(I,K+1,J)+PINT(I,K,J))*0.5
368 RTOPP=(Q(I,K,J)*P608-CWM(I,K,J)+1.)*T(I,K,J)*R_D/APELP
369
370 DFI=RTOPP*(DETA1(K)*PDTOP+DETA2(K)*PDSL(I,J))
371 !
372 RTOP(I,K,J)=RTOPP
373 FIUP=FILO(I,J)+DFI
374 FIM(I,K,J)=FILO(I,J)+FIUP
375 FILO(I,J)=(FIUP-DFL(K+1))*HTM(I,K,J)+DFL(K+1)
376 ENDDO
377 ENDDO
378 !
379 ENDDO
380 !
381 !-----------------------------------------------------------------------
382 !-----------------------------------------------------------------------
383 !*** MARCH NORTHWARD THROUGH THE SOUTHERNMOST SLABS TO BEGIN
384 !*** FILLING THE MAIN WORKING ARRAYS WHICH ARE MULTI-DIMENSIONED
385 !*** IN J BECAUSE THEY ARE DIFFERENCED OR AVERAGED IN J
386 !-----------------------------------------------------------------------
387 !-----------------------------------------------------------------------
388 !
389 JSTART=MYJS2_P2
390 !
391 DO J=-2,1
392 JJ=JSTART+J
393 !
394 !$omp parallel do &
395 !$omp& private(apelp,i,k)
396 DO K=KTS,KTE
397 DO I=MYIS_P4,MYIE_P4
398 APELP=0.5*(PINT(I,K+1,JJ)+PINT(I,K,JJ))
399 APEL(I,K,J)=APELP
400 DFDZ(I,K,J)=RTOP(I,K,JJ)
401 DPDE(I,K,J)=DETA1(K)*PDTOP+DETA2(K)*PDSL(I,JJ)
402 ENDDO
403 ENDDO
404 !
405 ENDDO
406 !
407 DO J=-2,0
408 JJ=JSTART+J
409 !
410 !$omp parallel do &
411 !$omp& private(i,k)
412 DO K=KTS,KTE
413 DO I=MYIS_P3,MYIE_P3
414 CNE(I,K,J)=(DFDZ(I+IHE(JJ),K,J+1)+DFDZ(I,K,J))*2. &
415 & *(APEL(I+IHE(JJ),K,J+1)-APEL(I,K,J))
416 PNE(I,K,J)=(FIM(I+IHE(JJ),K,JJ+1)-FIM(I,K,JJ)) &
417 & *(DWDT(I+IHE(JJ),K,JJ+1)+DWDT(I,K,JJ))
418 PCNE(I,K,J)=CNE(I,K,J)*(DPDE(I+IHE(JJ),K,J+1)+DPDE(I,K,J))
419 PPNE(I,K,J)=PNE(I,K,J)*(DPDE(I+IHE(JJ),K,J+1)+DPDE(I,K,J))
420 ENDDO
421 ENDDO
422 !
423 !$omp parallel do &
424 !$omp& private(i,k)
425 DO K=KTS,KTE
426 DO I=MYIS_P3,MYIE_P3
427 CSE(I,K,J+1)=(DFDZ(I+IHE(JJ+1),K,J)+DFDZ(I,K,J+1))*2. &
428 & *(APEL(I+IHE(JJ+1),K,J)-APEL(I,K,J+1))
429 PSE(I,K,J+1)=(FIM(I+IHE(JJ+1),K,JJ)-FIM(I,K,JJ+1)) &
430 & *(DWDT(I+IHE(JJ+1),K,JJ)+DWDT(I,K,JJ+1))
431 PCSE(I,K,J+1)=CSE(I,K,J+1) &
432 & *(DPDE(I+IHE(JJ+1),K,J)+DPDE(I,K,J+1))
433 PPSE(I,K,J+1)=PSE(I,K,J+1) &
434 & *(DPDE(I+IHE(JJ+1),K,J)+DPDE(I,K,J+1))
435 ENDDO
436 ENDDO
437 ENDDO
438 !
439 IF(.NOT.FIRST)THEN ! Skip at timestep 0
440 J=0
441 JJ=JSTART+J
442 !
443 !$omp parallel do &
444 !$omp& private(adpdx,adpdy,dcnek,dcsek,dpfew,dpfnek,dpfns,dpfsek, &
445 !$omp& dpnek,dpsek,i,k,pcew,pcns,pew,pns,vm)
446 DO K=KTS,KTE
447 DO I=MYIS_P2,MYIE1_P2
448 DPFNEK=((PPNE(I+IVW(JJ),K,J)+PPNE(I,K,J-1)) &
449 & +(PCNE(I+IVW(JJ),K,J)+PCNE(I,K,J-1)))*2.
450 DPFSEK=((PPSE(I+IVW(JJ),K,J)+PPSE(I,K,J+1)) &
451 & +(PCSE(I+IVW(JJ),K,J)+PCSE(I,K,J+1)))*2.
452 DPFEW=DPFNEK+DPFSEK
453 DPFNS=DPFNEK-DPFSEK
454 ADPDX=DPDE(I+IVW(JJ),K,J)+DPDE(I+IVE(JJ),K,J)
455 ADPDY=DPDE(I,K,J-1)+DPDE(I,K,J+1)
456 DPNEK=PNE(I+IVW(JJ),K,J)+PNE(I,K,J-1)
457 DPSEK=PSE(I+IVW(JJ),K,J)+PSE(I,K,J+1)
458 PEW=DPNEK+DPSEK
459 PNS=DPNEK-DPSEK
460 DCNEK=CNE(I+IVW(JJ),K,J)+CNE(I,K,J-1)
461 DCSEK=CSE(I+IVW(JJ),K,J)+CSE(I,K,J+1)
462 PCEW=(DCNEK+DCSEK)*ADPDX
463 PCNS=(DCNEK-DCSEK)*ADPDY
464 VM=VTM(I,K,JJ)*VBM2(I,JJ)
465 U(I,K,JJ)=(((DPFEW+PCEW)/ADPDX+PEW)*CPGFU(I,JJ))*VM+U(I,K,JJ)
466 V(I,K,JJ)=(((DPFNS+PCNS)/ADPDY+PNS)*CPGFV )*VM+V(I,K,JJ)
467 ENDDO
468 ENDDO
469 ENDIF
470 !
471 DO J=-1,0
472 JJ=JSTART+J
473 !
474 !$omp parallel do &
475 !$omp& private(adpdy,dcnek,dcsek,i,k)
476 DO K=KTS,KTE
477 DO I=MYIS_P3,MYIE_P3
478 UDY(I,K,J)=DY*U(I,K,JJ)
479 VDX(I,K,J)=DX(I,JJ)*V(I,K,JJ)
480 DCNEK=CNE(I+IVW(JJ),K,J)+CNE(I,K,J-1)
481 DCSEK=CSE(I+IVW(JJ),K,J)+CSE(I,K,J+1)
482 ADPDY=DPDE(I,K,J-1)+DPDE(I,K,J+1)
483 TNS(I,K,J)=VDX(I,K,J)*((DCNEK-DCSEK)*ADPDY)
484 FNS(I,K,JJ)=VDX(I,K,J)*ADPDY
485 ENDDO
486 ENDDO
487 !
488 !$omp parallel do &
489 !$omp& private(i,k)
490 DO K=KTS,KTE
491 DO I=MYIS_P1,MYIE_P1
492 PCXC(I,K,J)=(PNE(I+IVW(JJ),K,J)-PNE(I,K,J-1) &
493 & +CNE(I+IVW(JJ),K,J)-CNE(I,K,J-1) &
494 & +PSE(I+IVW(JJ),K,J)-PSE(I,K,J+1) &
495 & +CSE(I+IVW(JJ),K,J)-CSE(I,K,J+1)) &
496 & *VBM3(I,JJ)*VTM(I,K,JJ)
497 ENDDO
498 ENDDO
499 !
500 ENDDO
501 !
502 JJ=JSTART
503 !$omp parallel do &
504 !$omp& private(adpdne,i,k,pvnek)
505 DO K=KTS,KTE
506 DO I=MYIS_P2,MYIE1_P2
507 ADPDNE=DPDE(I+IHE(JJ-1),K,0)+DPDE(I,K,-1)
508 PVNEK=(UDY(I+IHE(JJ-1),K,-1)+VDX(I+IHE(JJ-1),K,-1)) &
509 & +(UDY(I,K,0) +VDX(I,K,0))
510 PCNE(I,K,-1)=CNE(I,K,-1)*ADPDNE
511 PPNE(I,K,-1)=PNE(I,K,-1)*ADPDNE
512 TNE(I,K,-1)=PVNEK*PCNE(I,K,-1)*2.
513 FNE(I,K,JJ-1)=PVNEK*ADPDNE
514 ENDDO
515 ENDDO
516 !
517 !$omp parallel do &
518 !$omp& private(adpdse,i,k,pvsek)
519 DO K=KTS,KTE
520 DO I=MYIS_P2,MYIE1_P2
521 ADPDSE=DPDE(I+IHE(JJ),K,-1)+DPDE(I,K,0)
522 PVSEK=(UDY(I+IHE(JJ),K,0)-VDX(I+IHE(JJ),K,0)) &
523 & +(UDY(I,K,-1) -VDX(I,K,-1))
524 PCSE(I,K,0)=CSE(I,K,0)*ADPDSE
525 PPSE(I,K,0)=PSE(I,K,0)*ADPDSE
526 TSE(I,K,0)=PVSEK*PCSE(I,K,0)*2.
527 FSE(I,K,JJ)=PVSEK*ADPDSE
528 ENDDO
529 ENDDO
530 !
531 JKNT=0
532 !
533 !-----------------------------------------------------------------------
534 !-----------------------------------------------------------------------
535 !*** MAIN INTEGRATION LOOP
536 !-----------------------------------------------------------------------
537 !-----------------------------------------------------------------------
538 !
539 main_integration : DO J=MYJS2_P2,MYJE2_P2
540 !
541 !-----------------------------------------------------------------------
542 !***
543 !*** SET THE 3RD INDEX IN THE WORKING ARRAYS (SEE SUBROUTINE INIT
544 !*** AND ABOVE DIAGRAMS)
545 !***
546 !*** J[TYPE]_NN WHERE "TYPE" IS THE WORKING ARRAY TYPE SEEN IN THE
547 !*** LOCAL DECLARATION ABOVE (DEPENDENT UPON THE J EXTENT) AND
548 !*** NN IS THE NUMBER OF ROWS NORTH OF THE CENTRAL ROW WHOSE J IS
549 !*** THE CURRENT VALUE OF THE main_integration LOOP.
550 !*** (P2 denotes +2, etc.)
551 !***
552 JKNT=JKNT+1
553 !
554 J1_P2=INDX3_WRK(2,JKNT,1)
555 J1_P1=INDX3_WRK(1,JKNT,1)
556 J1_00=INDX3_WRK(0,JKNT,1)
557 J1_M1=INDX3_WRK(-1,JKNT,1)
558 !
559 J2_P1=INDX3_WRK(1,JKNT,2)
560 J2_00=INDX3_WRK(0,JKNT,2)
561 J2_M1=INDX3_WRK(-1,JKNT,2)
562 !
563 J3_P2=INDX3_WRK(2,JKNT,3)
564 J3_P1=INDX3_WRK(1,JKNT,3)
565 J3_00=INDX3_WRK(0,JKNT,3)
566 !
567 J4_P1=INDX3_WRK(1,JKNT,4)
568 J4_00=INDX3_WRK(0,JKNT,4)
569 J4_M1=INDX3_WRK(-1,JKNT,4)
570 !
571 J5_00=INDX3_WRK(0,JKNT,5)
572 J5_M1=INDX3_WRK(-1,JKNT,5)
573 !
574 J6_P1=INDX3_WRK(1,JKNT,6)
575 J6_00=INDX3_WRK(0,JKNT,6)
576 !
577 !-----------------------------------------------------------------------
578 PRSFRC=PDTOP/(SLP_STD-PT)
579 !$omp parallel do &
580 !$omp& private(apelp,i,k)
581 DO K=KTS,KTE
582 !
583 DO I=MYIS_P4,MYIE_P4
584 APELP=0.5*(PINT(I,K+1,J+2)+PINT(I,K,J+2))
585 APEL(I,K,J1_P2)=APELP
586 DFDZ(I,K,J1_P2)=RTOP(I,K,J+2)
587 DPDE(I,K,J1_P2)=DETA1(K)*PDTOP+DETA2(K)*PDSL(I,J+2)
588 ENDDO
589 !
590 !-----------------------------------------------------------------------
591 !*** DIAGONAL CONTRIBUTIONS TO PRESSURE GRADIENT FORCE
592 !-----------------------------------------------------------------------
593 !
594 ! call hpm_start('block1')
595 DO I=MYIS_P3,MYIE_P3
596 CNE(I,K,J2_P1)=(DFDZ(I+IHE(J+1),K,J1_P2)+DFDZ(I,K,J1_P1))*2. &
597 & *(APEL(I+IHE(J+1),K,J1_P2)-APEL(I,K,J1_P1))
598 PNE(I,K,J2_P1)=(FIM(I+IHE(J+1),K,J+2)-FIM(I,K,J+1)) &
599 & *(DWDT(I+IHE(J+1),K,J+2)+DWDT(I,K,J+1))
600 PCNE(I,K,J2_P1)=CNE(I,K,J2_P1) &
601 & *(DPDE(I+IHE(J+1),K,J1_P2)+DPDE(I,K,J1_P1))
602 PPNE(I,K,J2_P1)=PNE(I,K,J2_P1) &
603 & *(DPDE(I+IHE(J+1),K,J1_P2)+DPDE(I,K,J1_P1))
604 ENDDO
605 !
606 DO I=MYIS_P3,MYIE_P3
607 CSE(I,K,J3_P2)=(DFDZ(I+IHE(J+2),K,J1_P1)+DFDZ(I,K,J1_P2))*2. &
608 & *(APEL(I+IHE(J+2),K,J1_P1)-APEL(I,K,J1_P2))
609 PSE(I,K,J3_P2)=(FIM(I+IHE(J+2),K,J+1)-FIM(I,K,J+2)) &
610 & *(DWDT(I+IHE(J+2),K,J+1)+DWDT(I,K,J+2))
611 PCSE(I,K,J3_P2)=CSE(I,K,J3_P2) &
612 & *(DPDE(I+IHE(J+2),K,J1_P1)+DPDE(I,K,J1_P2))
613 PPSE(I,K,J3_P2)=PSE(I,K,J3_P2) &
614 & *(DPDE(I+IHE(J+2),K,J1_P1)+DPDE(I,K,J1_P2))
615 ENDDO
616 !
617 !-----------------------------------------------------------------------
618 !*** CONTINUITY EQUATION MODIFICATION
619 !-----------------------------------------------------------------------
620 !
621 DO I=MYIS_P1,MYIE_P1
622 PCXC(I,K,J4_P1)=(PNE(I+IVW(J+1),K,J2_P1) &
623 & +CNE(I+IVW(J+1),K,J2_P1) &
624 & +PSE(I+IVW(J+1),K,J3_P1) &
625 & +CSE(I+IVW(J+1),K,J3_P1) &
626 & -PNE(I,K,J2_00) &
627 & -CNE(I,K,J2_00) &
628 & -PSE(I,K,J3_P2) &
629 & -CSE(I,K,J3_P2)) &
630 & *VBM3(I,J+1)*VTM(I,K,J+1)
631 ENDDO
632 !
633 !-----------------------------------------------------------------------
634 !
635 DO I=MYIS1,MYIE1
636 DIVL(I,K)=(DETA1(K)*PRSFRC &
637 & +DETA2(K)*(1.-PRSFRC))*WPDAR(I,J) &
638 & *(PCXC(I+IHE(J),K,J4_00)-PCXC(I,K,J4_P1) &
639 +PCXC(I+IHW(J),K,J4_00)-PCXC(I,K,J4_M1))
640 ENDDO
641 ENDDO
642 ! call hpm_stop('block1')
643 !
644 !-----------------------------------------------------------------------
645 !
646 IF(.NOT.FIRST)THEN ! Skip at timestep 0
647 !
648 !-----------------------------------------------------------------------
649 !*** LAT & LONG PRESSURE FORCE COMPONENTS
650 !-----------------------------------------------------------------------
651 !
652 !$omp parallel do &
653 !$omp& private(adpdx,adpdy,dcnek,dcsek,dpfew,dpfnek,dpfns,dpfsek, &
654 !$omp& dpnek,dpsek,i,k,pcew,pcns,pew,pns,vm)
655 DO K=KTS,KTE
656 DO I=MYIS_P2,MYIE1_P2
657 DPNEK=PNE(I+IVW(J+1),K,J2_P1)+PNE(I,K,J2_00)
658 DPSEK=PSE(I+IVW(J+1),K,J3_P1)+PSE(I,K,J3_P2)
659 PEW=DPNEK+DPSEK
660 PNS=DPNEK-DPSEK
661 !
662 ADPDX=DPDE(I+IVW(J+1),K,J1_P1)+DPDE(I+IVE(J+1),K,J1_P1)
663 ADPDY=DPDE(I,K,J1_00)+DPDE(I,K,J1_P2)
664 DCNEK=CNE(I+IVW(J+1),K,J2_P1)+CNE(I,K,J2_00)
665 DCSEK=CSE(I+IVW(J+1),K,J3_P1)+CSE(I,K,J3_P2)
666 PCEW=(DCNEK+DCSEK)*ADPDX
667 PCNS=(DCNEK-DCSEK)*ADPDY
668 !
669 DPFNEK=((PPNE(I+IVW(J+1),K,J2_P1)+PPNE(I,K,J2_00)) &
670 & +(PCNE(I+IVW(J+1),K,J2_P1)+PCNE(I,K,J2_00)))*2.
671 DPFSEK=((PPSE(I+IVW(J+1),K,J3_P1)+PPSE(I,K,J3_P2)) &
672 & +(PCSE(I+IVW(J+1),K,J3_P1)+PCSE(I,K,J3_P2)))*2.
673 DPFEW=DPFNEK+DPFSEK
674 DPFNS=DPFNEK-DPFSEK
675 !
676 !-----------------------------------------------------------------------
677 !*** UPDATE U AND V FOR PRESSURE GRADIENT FORCE
678 !-----------------------------------------------------------------------
679 !
680 VM=VTM(I,K,J+1)*VBM2(I,J+1)
681 U(I,K,J+1)=(((DPFEW+PCEW)/ADPDX+PEW)*CPGFU(I,J+1))*VM &
682 & +U(I,K,J+1)
683 V(I,K,J+1)=(((DPFNS+PCNS)/ADPDY+PNS)*CPGFV )*VM &
684 & +V(I,K,J+1)
685 ENDDO
686 ENDDO
687 !-----------------------------------------------------------------------
688 !
689 ENDIF !End of IF block executed for FIRST equal to .FALSE.
690 !
691 !-----------------------------------------------------------------------
692 !-----------------------------------------------------------------------
693 !
694 IF(.NOT.LAST_TIME)THEN !Do not execute block at last timestep
695 !
696 !-----------------------------------------------------------------------
697 !$omp parallel do &
698 !$omp& private(adpdx,adpdy,dcnek,dcsek,ediv,hm,i,k,pvnek,pvsek)
699 DO K=KTS,KTE
700 DO I=MYIS_P2,MYIE_P3
701 UDY(I,K,J4_P1)=DY*U(I,K,J+1)
702 VDX(I,K,J4_P1)=DX(I,J+1)*V(I,K,J+1)
703 ENDDO
704 !
705 !-----------------------------------------------------------------------
706 !*** LAT & LON FLUXES & OMEGA-ALPHA COMPONENTS
707 !-----------------------------------------------------------------------
708 !
709 DO I=MYIS_P2,MYIE_P3
710 ADPDX=DPDE(I+IVW(J),K,J1_00)+DPDE(I+IVE(J),K,J1_00)
711 DCNEK=CNE(I+IVW(J),K,J2_00)+CNE(I,K,J2_M1)
712 DCSEK=CSE(I+IVW(J),K,J3_00)+CSE(I,K,J3_P1)
713 TEW(I,K)=UDY(I,K,J4_00)*((DCNEK+DCSEK)*ADPDX)
714 FEW(I,K,J)=UDY(I,K,J4_00)*ADPDX
715 !
716 ADPDY=DPDE(I,K,J1_P2)+DPDE(I,K,J1_00)
717 DCNEK=CNE(I+IVW(J+1),K,J2_P1)+CNE(I,K,J2_00)
718 DCSEK=CSE(I+IVW(J+1),K,J3_P1)+CSE(I,K,J3_P2)
719 TNS(I,K,J4_P1)=VDX(I,K,J4_P1)*((DCNEK-DCSEK)*ADPDY)
720 FNS(I,K,J+1)=VDX(I,K,J4_P1)*ADPDY
721 ENDDO
722 !
723 !-----------------------------------------------------------------------
724 !*** DIAGONAL FLUXES AND DIAGONALLY AVERAGED WIND
725 !-----------------------------------------------------------------------
726 !
727 DO I=MYIS_P1,MYIE1_P1
728 PVNEK=(UDY(I+IHE(J),K,J4_00)+VDX(I+IHE(J),K,J4_00)) &
729 & +(UDY(I,K,J4_P1) +VDX(I,K,J4_P1))
730 TNE(I,K,J5_00)=PVNEK*PCNE(I,K,J2_00)*2.
731 FNE(I,K,J)=PVNEK*(DPDE(I+IHE(J),K,J1_P1)+DPDE(I,K,J1_00))
732 ENDDO
733 !
734 DO I=MYIS_P1,MYIE1_P1
735 PVSEK=(UDY(I+IHE(J+1),K,J4_P1)-VDX(I+IHE(J+1),K,J4_P1)) &
736 & +(UDY(I,K,J4_00) -VDX(I,K,J4_00))
737 TSE(I,K,J6_P1)=PVSEK*PCSE(I,K,J3_P1)*2.
738 FSE(I,K,J+1)=PVSEK*(DPDE(I+IHE(J+1),K,J1_00)+DPDE(I,K,J1_P1))
739 ENDDO
740 !
741 !-----------------------------------------------------------------------
742 !*** HORIZONTAL PART OF OMEGA-ALPHA & DIVERGENCE
743 !-----------------------------------------------------------------------
744 !
745 DO I=MYIS1,MYIE1
746 HM=HTM(I,K,J)*HBM2(I,J)
747 OMGALF(I,K,J)=(TEW(I+IHE(J),K)+TEW(I+IHW(J),K) &
748 & +TNS(I,K,J4_P1) +TNS(I,K,J4_M1) &
749 & +TNE(I,K,J5_00) +TNE(I+IHW(J),K,J5_M1) &
750 & +TSE(I,K,J6_00)+TSE(I+IHW(J),K,J6_P1)) &
751 & /DPDE(I,K,J1_00)*FCP(I,J)*HM
752 EDIV=(FEW(I+IHE(J),K,J)+FNS(I,K,J+1) &
753 & +FNE(I,K,J)+FSE(I,K,J) &
754 & -(FEW(I+IHW(J),K,J)+FNS(I,K,J-1) &
755 & +FNE(I+IHW(J),K,J-1)+FSE(I+IHW(J),K,J+1)))*FDIV(I,J)
756 DIV(I,K,J)=(EDIV+DIVL(I,K))*HM
757 ENDDO
758 ENDDO
759 !-----------------------------------------------------------------------
760 !
761 ENDIF !End block to skip execution at last timestep
762 !
763 !-----------------------------------------------------------------------
764 !
765 ENDDO main_integration
766 ! call hpm_stop('PFDHT')
767 !
768 !-----------------------------------------------------------------------
769 !
770 END SUBROUTINE PFDHT
771 !
772 !-----------------------------------------------------------------------
773 !***********************************************************************
774 !-----------------------------------------------------------------------
775 SUBROUTINE PDTE( &
776 #ifdef DM_PARALLEL
777 & GRID, &
778 #endif
779 & NTSD,DT,PT,ETA2,RES,HYDRO &
780 & ,HTM,HBM2 &
781 & ,PD,PDSL,PDSLO &
782 & ,PETDT,DIV,PSDT &
783 & ,IHE,IHW,IVE,IVW,INDX3_WRK &
784 & ,IDS,IDE,JDS,JDE,KDS,KDE &
785 & ,IMS,IME,JMS,JME,KMS,KME &
786 & ,ITS,ITE,JTS,JTE,KTS,KTE)
787 !***********************************************************************
788 !$$$ SUBPROGRAM DOCUMENTATION BLOCK
789 ! . . .
790 ! SUBPROGRAM: PDTE SURFACE PRESSURE TENDENCY CALC
791 ! PRGRMMR: JANJIC ORG: W/NP2 DATE: 96-07-??
792 !
793 ! ABSTRACT:
794 ! PDTE VERTICALLY INTEGRATES THE MASS FLUX DIVERGENCE TO
795 ! OBTAIN THE SURFACE PRESSURE TENDENCY AND VERTICAL VELOCITY ON
796 ! THE LAYER INTERFACES. THEN IT UPDATES THE HYDROSTATIC SURFACE
797 ! PRESSURE AND THE NONHYDROSTATIC PRESSURE.
798 !
799 ! PROGRAM HISTORY LOG:
800 ! 87-06-?? JANJIC - ORIGINATOR
801 ! 95-03-25 BLACK - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL
802 ! 96-05-?? JANJIC - ADDED NONHYDROSTATIC EFFECTS & MERGED THE
803 ! PREVIOUS SUBROUTINES PDTE & PDNEW
804 ! 00-01-03 BLACK - DISTRIBUTED MEMORY AND THREADS
805 ! 01-02-23 BLACK - CONVERTED TO WRF FORMAT
806 ! 01-04-11 BLACK - REWRITTEN FOR WRF CODING STANDARDS
807 ! 04-02-17 JANJIC - MOVED UPDATE OF T DUE TO OMEGA-ALPHA TERM
808 ! AND UPDATE OF PINT TO NEW ROUTINE VTOA
809 ! 04-11-23 BLACK - THREADED
810 !
811 ! USAGE: CALL PDTE FROM SUBROUTINE SOLVE_RUNSTREAM
812 ! INPUT ARGUMENT LIST:
813 !
814 ! OUTPUT ARGUMENT LIST:
815 !
816 ! OUTPUT FILES:
817 ! NONE
818 !
819 ! SUBPROGRAMS CALLED:
820 !
821 ! UNIQUE: NONE
822 !
823 ! LIBRARY: NONE
824 !
825 ! ATTRIBUTES:
826 ! LANGUAGE: FORTRAN 90
827 ! MACHINE : IBM SP
828 !$$$
829 !***********************************************************************
830 #ifdef DM_PARALLEL
831 USE module_domain
832 USE module_dm
833 #endif
834 !-----------------------------------------------------------------------
835 IMPLICIT NONE
836 !-----------------------------------------------------------------------
837 #ifdef DM_PARALLEL
838 ! INCLUDE "mpif.h"
839 TYPE (DOMAIN) :: GRID
840 #endif
841 !-----------------------------------------------------------------------
842 LOGICAL,INTENT(IN) :: HYDRO
843 !
844 INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
845 ,IMS,IME,JMS,JME,KMS,KME &
846 ,ITS,ITE,JTS,JTE,KTS,KTE
847 !
848 INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW
849 !
850 !*** NMM_MAX_DIM is set in configure.wrf and must agree with
851 !*** the value of dimspec q in the Registry/Registry
852 !
853 INTEGER,DIMENSION(-3:3,NMM_MAX_DIM,0:6),INTENT(IN) :: INDX3_WRK
854 !
855 INTEGER,INTENT(IN) :: NTSD
856 !
857 REAL,INTENT(IN) :: DT,PT
858 !
859 REAL,DIMENSION(KMS:KME),INTENT(IN) :: ETA2
860 !
861 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: RES,HBM2
862 !
863 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: HTM
864 !
865 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: DIV
866 !
867 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: PD,PDSL
868 !
869 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: PETDT
870 !
871 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: PDSLO,PSDT
872 !
873 !-----------------------------------------------------------------------
874 !
875 !*** LOCAL VARIABLES
876 !
877 INTEGER :: I,IHH,IHL,IX,J,JHH,JHL,JJ,JX,K,KNT,KS,NSMUD
878 INTEGER :: J1_00,J1_M1,J2_00,J2_P1
879 INTEGER :: MY_IS_GLB,MY_IE_GLB,MY_JS_GLB,MY_JE_GLB
880 #ifdef DM_PARALLEL
881 INTEGER :: IPS,IPE,JPS,JPE,KPS,KPE
882 #endif
883 #ifdef DEREF_KLUDGE
884 ! SEE http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
885 INTEGER :: SM31,EM31,SM32,EM32,SM33,EM33
886 INTEGER :: SM31X,EM31X,SM32X,EM32X,SM33X,EM33X
887 INTEGER :: SM31Y,EM31Y,SM32Y,EM32Y,SM33Y,EM33Y
888 #endif
889 !
890 REAL,DIMENSION(ITS-5:ITE+5,JTS-5:JTE+5) :: APDT,HBMS,PRET
891 !
892 REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,-1:0) :: PNE
893 REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE, 0:1) :: PSE
894 !
895 REAL :: PETDTL
896 !
897 !-----------------------------------------------------------------------
898 !***********************************************************************
899 !-----------------------------------------------------------------------
900 #include "deref_kludge.h"
901 !
902 DO J=JMS,JME
903 DO I=IMS,IME
904 PDSLO(I,J)=0.
905 ENDDO
906 ENDDO
907 !
908 MY_IS_GLB=ITS
909 MY_IE_GLB=ITE
910 MY_JS_GLB=JTS
911 MY_JE_GLB=JTE
912 !-----------------------------------------------------------------------
913 !*** COMPUTATION OF PRESSURE TENDENCY & PREPARATIONS
914 !-----------------------------------------------------------------------
915 !
916 !$omp parallel do &
917 !$omp& private(i,j,k)
918 DO J=MYJS_P2,MYJE_P2
919 DO K=KTE-1,KTS,-1
920 DO I=MYIS_P2,MYIE_P2
921 DIV(I,K,J)=DIV(I,K+1,J)+DIV(I,K,J)
922 ENDDO
923 ENDDO
924 ENDDO
925 !-----------------------------------------------------------------------
926 !$omp parallel do &
927 !$omp& private(i,j)
928 DO J=MYJS_P2,MYJE_P2
929 DO I=MYIS_P2,MYIE_P2
930 PSDT(I,J)=-DIV(I,KTS,J)
931 APDT(I,J)=PSDT(I,J)
932 PDSLO(I,J)=PDSL(I,J)
933 ENDDO
934 ENDDO
935 !-----------------------------------------------------------------------
936 DO J=JMS,JME
937 DO I=IMS,IME
938 PDSL(I,J)=0.
939 ENDDO
940 ENDDO
941 !
942 !$omp parallel do &
943 !$omp& private(i,j)
944 DO J=MYJS_P2,MYJE_P2
945 DO I=MYIS_P2,MYIE_P2
946 PD(I,J)=PSDT(I,J)*DT+PD(I,J)
947 PRET(I,J)=PSDT(I,J)*RES(I,J)
948 PDSL(I,J)=PD(I,J)*RES(I,J)
949 ENDDO
950 ENDDO
951 !-----------------------------------------------------------------------
952 !*** COMPUTATION OF PETDT
953 !-----------------------------------------------------------------------
954 !$omp parallel do &
955 !$omp& private(i,j,k)
956 DO J=MYJS_P2,MYJE_P2
957 DO K=KTE-1,KTS,-1
958 DO I=MYIS_P2,MYIE_P2
959 PETDT(I,K,J)=-(PRET(I,J)*ETA2(K+1)+DIV(I,K+1,J)) &
960 & *HTM(I,K,J)*HBM2(I,J)
961 ENDDO
962 ENDDO
963 ENDDO
964 !-----------------------------------------------------------------------
965 !*** SMOOTHING VERTICAL VELOCITY ALONG BOUNDARIES
966 !-----------------------------------------------------------------------
967 nonhydrostatic_smoothing: IF(.NOT.HYDRO.AND.KSMUD.GT.0)THEN
968 !
969 NSMUD=KSMUD
970 !
971 DO J=MYJS,MYJE
972 DO I=MYIS,MYIE
973 HBMS(I,J)=HBM2(I,J)
974 ENDDO
975 ENDDO
976 !
977 JHL=LNSDT
978 JHH=JDE-JHL+1
979 !
980 !$omp parallel do &
981 !$omp& private(i,ihh,ihl,ix,j,jx)
982 DO J=JHL,JHH
983 IF(J.GE.MY_JS_GLB.AND.J.LE.MY_JE_GLB)THEN
984 IHL=JHL/2+1
985 IHH=IDE-IHL+MOD(J,2)
986 !
987 DO I=IHL,IHH
988 IF(I.GE.MY_IS_GLB.AND.I.LE.MY_IE_GLB)THEN
989 IX=I ! -MY_IS_GLB+1
990 JX=J ! -MY_JS_GLB+1
991 HBMS(IX,JX)=0.
992 ENDIF
993 ENDDO
994 !
995 ENDIF
996 ENDDO
997 !
998 !-----------------------------------------------------------------------
999 !***
1000 !*** SMOOTH THE VERTICAL VELOCITY
1001 !***
1002 !-----------------------------------------------------------------------
1003 !
1004 DO KS=1,NSMUD
1005 !
1006 !-----------------------------------------------------------------------
1007 !
1008 !*** FILL SOUTHERNMOST SLABS OF THE PNE AND PSE WORKING ARRAYS
1009 !
1010 JJ=MYJS2-1
1011 !$omp parallel do &
1012 !$omp& private(i,k)
1013 DO K=KTS,KTE-1
1014 !
1015 DO I=MYIS_P1,MYIE1_P1
1016 PNE(I,K,-1)=(PETDT(I+IHE(JJ),K,JJ+1)-PETDT(I,K,JJ)) &
1017 & *HTM(I,K,JJ)*HTM(I+IHE(JJ),K,JJ+1)
1018 ENDDO
1019 !
1020 DO I=MYIS_P1,MYIE1_P1
1021 PSE(I,K,0)=(PETDT(I+IHE(JJ+1),K,JJ)-PETDT(I,K,JJ+1)) &
1022 & *HTM(I+IHE(JJ+1),K,JJ)*HTM(I,K,JJ+1)
1023 ENDDO
1024 !
1025 ENDDO
1026 !
1027 KNT=0
1028 !
1029 !-----------------------------------------------------------------------
1030 !
1031 !*** PROCEED NORTHWARD WITH THE SMOOTHING.
1032 !*** PNE AT H(I,J) LIES BETWEEN (I,J) AND THE H POINT TO THE NE.
1033 !*** PSE AT H(I,J) LIES BETWEEN (I,J) AND THE H POINT TO THE SE.
1034 !
1035 DO J=MYJS2,MYJE2
1036 !
1037 KNT=KNT+1
1038 J1_00=-MOD(KNT+1,2)
1039 J1_M1=-MOD(KNT,2)
1040 J2_P1=MOD(KNT,2)
1041 J2_00=MOD(KNT+1,2)
1042 !
1043 !$omp parallel do &
1044 !$omp& private(i,k,petdtl)
1045 DO K=KTS,KTE-1
1046 !
1047 DO I=MYIS_P1,MYIE1_P1
1048 PNE(I,K,J1_00)=(PETDT(I+IHE(J),K,J+1)-PETDT(I,K,J)) &
1049 & *HTM(I,K+1,J)*HTM(I+IHE(J),K+1,J+1)
1050 ENDDO
1051 !
1052 DO I=MYIS_P1,MYIE1_P1
1053 PSE(I,K,J2_P1)=(PETDT(I+IHE(J+1),K,J)-PETDT(I,K,J+1)) &
1054 & *HTM(I+IHE(J+1),K+1,J)*HTM(I,K+1,J+1)
1055 ENDDO
1056 !
1057 DO I=MYIS1,MYIE1
1058 PETDTL=(PNE(I,K,J1_00)-PNE(I+IHW(J),K,J1_M1) &
1059 & +PSE(I,K,J2_00)-PSE(I+IHW(J),K,J2_P1))*HBM2(I,J)
1060 PETDT(I,K,J)=PETDTL*HBMS(I,J)*0.125+PETDT(I,K,J)
1061 ENDDO
1062 !
1063 ENDDO
1064 !
1065 ENDDO
1066 !
1067 #ifdef DM_PARALLEL
1068 IPS=ITS;IPE=ITE;JPS=JTS;JPE=JTE;KPS=KTS;KPE=KTE
1069 # include <HALO_NMM_E.inc>
1070 #endif
1071 !-----------------------------------------------------------------------
1072 !
1073 ENDDO ! End of smoothing loop
1074 !
1075 !-----------------------------------------------------------------------
1076 ENDIF nonhydrostatic_smoothing
1077 !-----------------------------------------------------------------------
1078 END SUBROUTINE PDTE
1079 !-----------------------------------------------------------------------
1080 !***********************************************************************
1081 !-----------------------------------------------------------------------
1082 SUBROUTINE VTOA( &
1083 #ifdef DM_PARALLEL
1084 & grid, &
1085 #endif
1086 & NTSD,DT,PT,ETA2 &
1087 & ,HTM,HBM2,EF4T &
1088 & ,T,DWDT,RTOP,OMGALF &
1089 & ,PINT,DIV,PSDT,RES &
1090 & ,IHE,IHW,IVE,IVW,INDX3_WRK &
1091 & ,IDS,IDE,JDS,JDE,KDS,KDE &
1092 & ,IMS,IME,JMS,JME,KMS,KME &
1093 & ,ITS,ITE,JTS,JTE,KTS,KTE)
1094 !***********************************************************************
1095 !$$$ SUBPROGRAM DOCUMENTATION BLOCK
1096 ! . . .
1097 ! SUBPROGRAM: VTOA OMEGA-ALPHA
1098 ! PRGRMMR: JANJIC ORG: W/NP2 DATE: 04-02-17
1099 !
1100 ! ABSTRACT:
1101 ! VTOA UPDATES THE NONHYDROSTATIC PRESSURE AND ADDS THE
1102 ! CONTRIBUTION OF THE OMEGA-ALPHA TERM OF THE THERMODYNAMIC
1103 ! EQUATION. ALSO, THE OMEGA-ALPHA TERM IS COMPUTED FOR DIAGNOSTICS.
1104 !
1105 ! PROGRAM HISTORY LOG:
1106 ! 04-02-17 JANJIC - SEPARATED FROM ORIGINAL PDTEDT ROUTINE
1107 ! 04-11-23 BLACK - THREADED
1108 !
1109
1110 ! INPUT ARGUMENT LIST:
1111 !
1112 ! OUTPUT ARGUMENT LIST:
1113 !
1114 ! OUTPUT FILES:
1115 ! NONE
1116 !
1117 ! SUBPROGRAMS CALLED:
1118 !
1119 ! UNIQUE: NONE
1120 !
1121 ! LIBRARY: NONE
1122 !
1123 ! ATTRIBUTES:
1124 ! LANGUAGE: FORTRAN 90
1125 ! MACHINE : IBM SP
1126 !$$$
1127 !***********************************************************************
1128 #ifdef DM_PARALLEL
1129 USE MODULE_DOMAIN
1130 USE MODULE_DM
1131 #endif
1132 !-----------------------------------------------------------------------
1133 IMPLICIT NONE
1134 !-----------------------------------------------------------------------
1135 #ifdef DM_PARALLEL
1136 ! INCLUDE "mpif.h"
1137 TYPE (DOMAIN) :: GRID
1138 #endif
1139 !-----------------------------------------------------------------------
1140 !
1141 INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
1142 ,IMS,IME,JMS,JME,KMS,KME &
1143 ,ITS,ITE,JTS,JTE,KTS,KTE
1144 !
1145 INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW
1146 !
1147 !*** NMM_MAX_DIM is set in configure.wrf and must agree with
1148 !*** the value of dimspec q in the Registry/Registry
1149 !
1150 INTEGER,DIMENSION(-3:3,NMM_MAX_DIM,0:6),INTENT(IN) :: INDX3_WRK
1151 !
1152 INTEGER,INTENT(IN) :: NTSD
1153 !
1154 REAL,INTENT(IN) :: DT,EF4T,PT
1155 !
1156 REAL,DIMENSION(KMS:KME),INTENT(IN) :: ETA2
1157 !
1158 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: HBM2,PSDT,RES
1159 !
1160 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: DIV,DWDT &
1161 & ,HTM,RTOP
1162 !
1163 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: OMGALF,T
1164 !
1165 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: PINT
1166 !
1167 !-----------------------------------------------------------------------
1168 !
1169 !*** LOCAL VARIABLES
1170 !
1171 INTEGER :: I,IHH,IHL,IX,J,JHH,JHL,JJ,JX,K,KNT,KS,NSMUD
1172 INTEGER :: J1_00,J1_M1,J2_00,J2_P1
1173 !
1174 REAL,DIMENSION(ITS-5:ITE+5,JTS-5:JTE+5) :: PRET,TPM
1175 !
1176 REAL :: DWDTP,RHS,TPMP
1177 !
1178 !-----------------------------------------------------------------------
1179 !***********************************************************************
1180 !-----------------------------------------------------------------------
1181 !*** PREPARATIONS
1182 !-----------------------------------------------------------------------
1183 !$omp parallel do &
1184 !$omp& private(i,j)
1185 DO J=MYJS_P2,MYJE_P2
1186 DO I=MYIS_P2,MYIE_P2
1187 PINT(I,KTE+1,J)=PT
1188 TPM(I,J)=PT+PINT(I,KTE,J)
1189 PRET(I,J)=PSDT(I,J)*RES(I,J)
1190 ENDDO
1191 ENDDO
1192 !-----------------------------------------------------------------------
1193 !*** KINETIC ENERGY GENERATION TERMS IN T EQUATION
1194 !-----------------------------------------------------------------------
1195 !$omp parallel do &
1196 !$omp& private(dwdtp,i,j,rhs,tpmp)
1197 DO J=MYJS,MYJE
1198 DO I=MYIS,MYIE
1199 DWDTP=DWDT(I,KTE,J)
1200 TPMP=PINT(I,KTE,J)+PINT(I,KTE-1,J)
1201 !
1202 RHS=-DIV(I,KTE,J)*RTOP(I,KTE,J)*HTM(I,KTE,J)*DWDTP*EF4T
1203 OMGALF(I,KTE,J)=OMGALF(I,KTE,J)+RHS
1204 T(I,KTE,J)=OMGALF(I,KTE,J)*HBM2(I,J)+T(I,KTE,J)
1205 PINT(I,KTE,J)=PRET(I,J)*(ETA2(KTE+1)+ETA2(KTE))*DWDTP*DT &
1206 & +TPM(I,J)-PINT(I,KTE+1,J)
1207 !
1208 TPM(I,J)=TPMP
1209 ENDDO
1210 ENDDO
1211 !-----------------------------------------------------------------------
1212 !$omp parallel do &
1213 !$omp& private(dwdtp,i,j,k,rhs,tpmp)
1214 DO J=MYJS,MYJE
1215 DO K=KTE-1,KTS+1,-1
1216 DO I=MYIS,MYIE
1217 DWDTP=DWDT(I,K,J)
1218 TPMP=PINT(I,K,J)+PINT(I,K-1,J)
1219 !
1220 RHS=-(DIV(I,K+1,J)+DIV(I,K,J))*RTOP(I,K,J)*HTM(I,K,J)*DWDTP &
1221 & *EF4T
1222 OMGALF(I,K,J)=OMGALF(I,K,J)+RHS
1223 T(I,K,J)=OMGALF(I,K,J)*HBM2(I,J)+T(I,K,J)
1224 PINT(I,K,J)=PRET(I,J)*(ETA2(K+1)+ETA2(K))*DWDTP*DT &
1225 & +TPM(I,J)-PINT(I,K+1,J)
1226 !
1227 TPM(I,J)=TPMP
1228 ENDDO
1229 ENDDO
1230 ENDDO
1231 !-----------------------------------------------------------------------
1232 !$omp parallel do &
1233 !$omp& private(dwdtp,i,j,rhs)
1234 DO J=MYJS,MYJE
1235 DO I=MYIS,MYIE
1236 !
1237 DWDTP=DWDT(I,KTS,J)
1238 !
1239 RHS=-(DIV(I,KTS+1,J)+DIV(I,KTS,J))*RTOP(I,KTS,J)*HTM(I,KTS,J) &
1240 & *DWDTP*EF4T
1241 OMGALF(I,KTS,J)=OMGALF(I,KTS,J)+RHS
1242 T(I,KTS,J)=OMGALF(I,KTS,J)*HBM2(I,J)+T(I,KTS,J)
1243 PINT(I,KTS,J)=PRET(I,J)*(ETA2(KTS+1)+ETA2(KTS))*DWDTP*DT &
1244 & +TPM(I,J)-PINT(I,KTS+1,J)
1245 ENDDO
1246 ENDDO
1247 !-----------------------------------------------------------------------
1248 END SUBROUTINE VTOA
1249 !-----------------------------------------------------------------------
1250 !***********************************************************************
1251 SUBROUTINE DDAMP(NTSD,DT,DETA1,DETA2,PDSL,PDTOP,DIV,HBM2,VTM &
1252 & ,T,U,V,DDMPU,DDMPV &
1253 & ,IHE,IHW,IVE,IVW,INDX3_WRK &
1254 & ,IDS,IDE,JDS,JDE,KDS,KDE &
1255 & ,IMS,IME,JMS,JME,KMS,KME &
1256 & ,ITS,ITE,JTS,JTE,KTS,KTE)
1257 !***********************************************************************
1258 !$$$ SUBPROGRAM DOCUMENTATION BLOCK
1259 ! . . .
1260 ! SUBPROGRAM: DDAMP DIVERGENCE DAMPING
1261 ! PRGRMMR: JANJIC ORG: W/NP22 DATE: 94-03-08
1262 !
1263 ! ABSTRACT:
1264 ! DDAMP MODIFIES THE WIND COMPONENTS SO AS TO REDUCE THE
1265 ! HORIZONTAL DIVERGENCE.
1266 !
1267 ! PROGRAM HISTORY LOG:
1268 ! 87-08-?? JANJIC - ORIGINATOR
1269 ! 95-03-25 BLACK - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL
1270 ! 95-03-28 BLACK - ADDED EXTERNAL EDGE
1271 ! 98-10-30 BLACK - MODIFIED FOR DISTRIBUTED MEMORY
1272 ! 01-03-12 BLACK - CONVERTED TO WRF STRUCTURE
1273 ! 04-11-18 BLACK - THREADED
1274 !
1275 ! USAGE: CALL DDAMP FROM SUBROUTINE SOLVE_RUNSTREAM
1276 !
1277 ! INPUT ARGUMENT LIST:
1278 !
1279 ! OUTPUT ARGUMENT LIST:
1280 !
1281 ! OUTPUT FILES:
1282 ! NONE
1283 !
1284 ! SUBPROGRAMS CALLED:
1285 !
1286 ! UNIQUE: NONE
1287 !
1288 ! LIBRARY: NONE
1289 !
1290 ! ATTRIBUTES:
1291 ! LANGUAGE: FORTRAN 90
1292 ! MACHINE : IBM SP
1293 !$$$
1294 !***********************************************************************
1295 !-----------------------------------------------------------------------
1296 IMPLICIT NONE
1297 !-----------------------------------------------------------------------
1298 !
1299 INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
1300 & ,IMS,IME,JMS,JME,KMS,KME &
1301 & ,ITS,ITE,JTS,JTE,KTS,KTE
1302 !
1303 INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW
1304 !
1305 !-----------------------------------------------------------------------
1306 !!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1307 !*** NMM_MAX_DIM is set in configure.wrf and must agree with
1308 !*** the value of dimspec q in the Registry/Registry
1309 !!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1310 !-----------------------------------------------------------------------
1311 !
1312 INTEGER,DIMENSION(-3:3,NMM_MAX_DIM,0:6),INTENT(IN) :: INDX3_WRK
1313 !
1314 INTEGER,INTENT(IN) :: NTSD
1315 !
1316 REAL,INTENT(IN) :: DT,PDTOP
1317 !
1318 REAL,DIMENSION(KMS:KME-1),INTENT(IN) :: DETA1,DETA2
1319 !
1320 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: DDMPU,DDMPV &
1321 & ,HBM2,PDSL
1322 !
1323 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: VTM
1324 !
1325 REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: DIV,T &
1326 & ,U,V
1327 !-----------------------------------------------------------------------
1328 !
1329 !*** LOCAL VARIABLES
1330 !
1331 INTEGER :: I,IER,J,J4_00,J4_M1,J4_P1,JJ,JKNT,JSTART,K,STAT
1332 !
1333 REAL :: FCIM,FCXM,RDPDX,RDPDY
1334 !
1335 !*** TYPE 4 WORKING ARRAY ! See PFDHT
1336 !
1337 REAL,DIMENSION(ITS-5:ITE+5) :: XDIVX,XDIVY
1338 !
1339 REAL,DIMENSION(ITS-5:ITE+5,-1:1) :: DIVE,PDE
1340 !
1341 REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,-1:1) :: DPDE
1342 !
1343 !-----------------------------------------------------------------------
1344 !***********************************************************************
1345 !-----------------------------------------------------------------------
1346 !
1347 !*** MARCH NORTHWARD THROUGH THE SOUTHERNMOST SLABS TO BEGIN
1348 !*** FILLING THE WORKING ARRAY NEEDED FOR AVERAGING AND
1349 !*** DIFFERENCING IN J
1350 !
1351 !-----------------------------------------------------------------------
1352 JSTART=MYJS2
1353 !
1354 DO J=-1,0
1355 JJ=JSTART+J
1356 !
1357 DO I=MYIS_P2,MYIE_P2
1358 PDE (I,J)=PDSL(I,JJ)+PDTOP
1359 DIVE(I,J)=0.
1360 ENDDO
1361 !
1362 !$omp parallel do &
1363 !$omp& private(i,k)
1364 DO K=KTS,KTE
1365 DO I=MYIS_P2,MYIE_P2
1366 DPDE(I,K,J )=DETA1(K)*PDTOP+DETA2(K)*PDSL(I,JJ)
1367 DIV (I,K,JJ)=DIV(I,K,JJ)*HBM2(I,JJ)
1368 DIVE(I,J)=DIV(I,K,JJ)*HBM2(I,JJ)+DIVE(I,J)
1369 ENDDO
1370 ENDDO
1371 !
1372 ENDDO
1373 !
1374 JKNT=0
1375 !-----------------------------------------------------------------------
1376 !
1377 main_integration : DO J=MYJS2,MYJE2
1378 !
1379 !-----------------------------------------------------------------------
1380 !***
1381 !*** SET THE 3RD INDEX OF THE WORKING ARRAYS (SEE SUBROUTINE INIT
1382 !*** AND PFDHT DIAGRAMS)
1383 !***
1384 !*** J[TYPE]_NN WHERE "TYPE" IS THE WORKING ARRAY TYPE SEEN IN THE
1385 !*** LOCAL DECLARATION ABOVE (DEPENDENT UPON THE J EXTENT) AND
1386 !*** NN IS THE NUMBER OF ROWS NORTH OF THE CENTRAL ROW WHOSE J IS
1387 !*** THE CURRENT VALUE OF THE main_integration LOOP.
1388 !*** (P2 denotes +2, etc.)
1389 !***
1390 JKNT=JKNT+1
1391 !
1392 J4_P1=INDX3_WRK(1,JKNT,4)
1393 J4_00=INDX3_WRK(0,JKNT,4)
1394 J4_M1=INDX3_WRK(-1,JKNT,4)
1395 !
1396 !-----------------------------------------------------------------------
1397 !
1398 FCXM=1.
1399 !
1400 DO I=MYIS_P2,MYIE_P2
1401 PDE (I,J4_P1)=PDSL(I,J+1)+PDTOP
1402 DIVE(I,J4_P1)=0.
1403 ENDDO
1404 !
1405 DO K=KTS,KTE
1406 DO I=MYIS_P2,MYIE_P2
1407 DIVE(I,J4_P1)=DIV(I,K,J+1)*HBM2(I,J+1)+DIVE(I,J4_P1)
1408 ENDDO
1409 ENDDO
1410 !
1411 DO I=MYIS1_P1,MYIE1_P1
1412 RDPDX=DDMPU(I,J)*FCXM &
1413 & /(PDE(I+IVW(J),J4_00)+PDE(I+IVE(J),J4_00))
1414 RDPDY=DDMPV(I,J)*FCXM &
1415 & /(PDE(I ,J4_M1)+PDE(I ,J4_P1))
1416 !
1417 XDIVX(I)=(DIVE(I+IVE(J),J4_00) &
1418 & -DIVE(I+IVW(J),J4_00))*RDPDX
1419 XDIVY(I)=(DIVE(I ,J4_P1) &
1420 & -DIVE(I ,J4_M1))*RDPDY
1421 ENDDO
1422 !
1423 !-----------------------------------------------------------------------
1424 !
1425 FCIM=1.
1426 !
1427 !$omp parallel do &
1428 !$omp& private(i,k,rdpdx,rdpdy)
1429 DO K=KTS,KTE
1430 !
1431 DO I=MYIS_P2,MYIE_P2
1432 DPDE(I,K,J4_P1)=DETA1(K)*PDTOP+DETA2(K)*PDSL(I,J+1)
1433 DIV(I,K,J+1)=DIV(I,K,J+1)*HBM2(I,J+1)
1434 ENDDO
1435 !
1436 DO I=MYIS1_P1,MYIE1_P1
1437 RDPDX=DDMPU(I,J)*FCIM &
1438 & /(DPDE(I+IVW(J),K,J4_00)+DPDE(I+IVE(J),K,J4_00))
1439 RDPDY=DDMPV(I,J)*FCIM &
1440 & /(DPDE(I ,K,J4_M1)+DPDE(I ,K,J4_P1))
1441 U(I,K,J)=((DIV(I+IVE(J),K,J )-DIV(I+IVW(J),K,J ))*RDPDX &
1442 & +XDIVX(I))*VTM(I,K,J)+U(I,K,J)
1443 V(I,K,J)=((DIV(I ,K,J+1)-DIV(I ,K,J-1))*RDPDY &
1444 & +XDIVY(I))*VTM(I,K,J)+V(I,K,J)
1445 ENDDO
1446 !
1447 ENDDO
1448 !
1449 !-----------------------------------------------------------------------
1450 !
1451 ENDDO main_integration
1452 !
1453 !-----------------------------------------------------------------------
1454 !
1455 END SUBROUTINE DDAMP
1456 !
1457 !-----------------------------------------------------------------------
1458 !
1459 END MODULE MODULE_IGWAVE_ADJUST
1460 !
1461 !-----------------------------------------------------------------------