| blob | 824f247367d9fd36f8c87c545a452e3e9d4bb137 |
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_EXCHANGE
16 USE MODULE_MPP,ONLY: MYPE
17 ! USE MODULE_TIMERS ! this one creates a name conflict at compile time
18 !-----------------------------------------------------------------------
19 !***
20 !*** SPECIFY THE NUMBER OF TIMES TO SMOOTH THE VERTICAL VELOCITY
21 !*** AND THE NUMBER OF ROWS FROM THE NORTHERN AND SOUTHERN EDGES
22 !*** OF THE GLOBAL DOMAIN BEYOND WHICH THE SMOOTHING DOES NOT GO
23 !*** FOR SUBROUTINE PDTE
24 !
25 INTEGER :: KSMUD=0,LNSDT=7
26 !
27 !-----------------------------------------------------------------------
28 !
29 CONTAINS
30 !
31 !***********************************************************************
32 SUBROUTINE PFDHT(NTSD,LAST_TIME,PT,DETA1,DETA2,PDTOP,RES,FIS &
33 & ,HYDRO,SIGMA,FIRST,DX,DY &
34 & ,HBM2,VBM2,VBM3 &
35 & ,FDIV,FCP,WPDAR,DFL,CPGFU,CPGFV &
36 & ,PD,PDSL,T,Q,U,V,CWM,OMGALF,PINT,DWDT &
37 & ,RTOP,DIV,FEW,FNS,FNE,FSE &
38 & ,IHE,IHW,IVE,IVW &
39 & ,IDS,IDE,JDS,JDE,KDS,KDE &
40 & ,IMS,IME,JMS,JME,KMS,KME &
41 & ,ITS,ITE,JTS,JTE,KTS,KTE)
42 !***********************************************************************
43 !$$$ SUBPROGRAM DOCUMENTATION BLOCK
44 ! . . .
45 ! SUBPROGRAM: PFDHT DIVERGENCE/HORIZONTAL OMEGA-ALPHA
46 ! PRGRMMR: JANJIC ORG: W/NP22 DATE: 93-10-28
47 !
48 ! ABSTRACT:
49 ! PFDHT CALCULATES THE PRESSURE GRADIENT FORCE, UPDATES THE
50 ! VELOCITY COMPONENTS DUE TO THE EFFECT OF THE PRESSURE GRADIENT
51 ! AND CORIOILS FORCES, COMPUTES THE DIVERGENCE INCLUDING THE
52 ! MODIFICATION PREVENTING GRAVITY WAVE GRID SEPARATION, AND
53 ! CALCULATES THE HORIZONTAL PART OF THE OMEGA-ALPHA TERM.
54 ! (THE PART PROPORTIONAL TO THE ADVECTION OF MASS ALONG
55 ! COORDINATE SURFACES).
56 !
57 ! PROGRAM HISTORY LOG:
58 ! 87-06-?? JANJIC - ORIGINATOR
59 ! 95-03-25 BLACK - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL
60 ! 96-03-29 BLACK - ADDED EXTERNAL EDGE
61 ! 98-10-30 BLACK - MODIFIED FOR DISTRIBUTED MEMORY
62 ! 02-02-01 BLACK - REWRITTEN FOR WRF CODING STANDARDS
63 ! 04-02-17 JANJIC - REMOVED UPDATE OF TEMPERATURE
64 ! 04-11-23 BLACK - THREADED
65 ! 05-12-09 BLACK - CONVERTED FROM IKJ TO IJK
66 !
67 ! USAGE: CALL PFDHT FROM MAIN PROGRAM SOLVE_RUNSTREAM
68 ! INPUT ARGUMENT LIST:
69 !
70 ! OUTPUT ARGUMENT LIST:
71 !
72 ! OUTPUT FILES:
73 ! NONE
74 !
75 ! SUBPROGRAMS CALLED:
76 !
77 ! UNIQUE: NONE
78 !
79 ! LIBRARY: NONE
80 !
81 ! ATTRIBUTES:
82 ! LANGUAGE: FORTRAN 90
83 ! MACHINE : IBM SP
84 !$$$
85 !-----------------------------------------------------------------------
86 !***********************************************************************
87 !-----------------------------------------------------------------------
88 IMPLICIT NONE
89 !-----------------------------------------------------------------------
90 !#ifdef DM_PARALLEL
91 ! INCLUDE "mpif.h"
92 !#endif
93 !-----------------------------------------------------------------------
94 LOGICAL,INTENT(IN) :: FIRST,HYDRO
95 INTEGER,INTENT(IN) :: SIGMA
96 !
97 INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
98 & ,IMS,IME,JMS,JME,KMS,KME &
99 & ,ITS,ITE,JTS,JTE,KTS,KTE
100 !
101 INTEGER, DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW
102 !
103 INTEGER,INTENT(IN) :: NTSD
104 LOGICAL,INTENT(IN) :: LAST_TIME
105 !
106 REAL,INTENT(IN) :: CPGFV,DY,PDTOP,PT
107 !
108 REAL,DIMENSION(KMS:KME-1),INTENT(IN) :: DETA1,DETA2
109 !
110 REAL,DIMENSION(KMS:KME),INTENT(IN) :: DFL
111 !
112 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: CPGFU,DX,FCP,FDIV &
113 & ,PD,FIS,RES,WPDAR &
114 & ,HBM2,VBM2,VBM3
115 !
116 REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(IN) :: CWM,DWDT &
117 & ,Q,T
118 !
119 REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(IN) :: PINT
120 !
121 REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(INOUT) :: DIV &
122 & ,OMGALF &
123 & ,RTOP,U,V
124 !
125 REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(OUT) :: FEW,FNS &
126 & ,FNE,FSE
127 !
128 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: PDSL
129 !
130 !-----------------------------------------------------------------------
131 !*** LOCAL VARIABLES
132 !-----------------------------------------------------------------------
133 !
134 INTEGER :: I,J,K
135 !
136 REAL :: SLP_STD=101300.0
137 !
138 REAL :: APELP,DFI,DCNEK,DCSEK,DPFNEK,DPFSEK,DPNEK,DPSEK &
139 & ,EDIV,FIUP,PRSFRC,PVNEK,PVSEK,RTOPP,VM
140 !
141 REAL,DIMENSION(ITS-5:ITE+5,JTS-5:JTE+5) :: ADPDNE,ADPDSE &
142 & ,ADPDX,ADPDY,APEL &
143 & ,CNE,CSE,DFDZ,DPDE &
144 & ,DPFEW,DPFNS &
145 & ,FILO,FIM,HM &
146 & ,PCEW,PCNE,PCNS,PCSE &
147 & ,PCXC,PEW,PNE,PNS &
148 & ,PPNE,PPSE,PSE &
149 & ,RDPD,RDPDX,RDPDY &
150 & ,TEW,TNE,TNS,TSE &
151 & ,UDY,VDX
152 !
153 !-----------------------------------------------------------------------
154 !***********************************************************************
155 !
156 !
157 ! CSE CSE ------- 1
158 ! * *
159 ! * *
160 ! ******* * ******* *
161 ! * * * * * *
162 ! CNE * * CNE * *
163 ! TEW----------OMGALF----------TEW ------- 0
164 ! CSE * * CSE * *
165 ! * * * * * *
166 ! ******* * ******* *
167 ! * *
168 ! * *
169 ! CNE CNE ------- -1
170 !
171 !
172 !
173 !
174 !***********************************************************************
175 !
176 ! CSE ------- 2
177 ! *
178 ! *
179 ! *
180 ! *
181 ! CNE*****TNS ------- 1
182 ! CSE | *
183 ! | *
184 ! | *
185 ! | *
186 ! | CNE
187 ! OMGALF ------- 0
188 ! | CSE
189 ! | *
190 ! | *
191 ! | *
192 ! CNE | *
193 ! CSE*****TNS ------- -1
194 ! *
195 ! *
196 ! *
197 ! *
198 ! CNE ------- -2
199 !
200 !***********************************************************************
201 !-----------------------------------------------------------------------
202 !*** PREPARATORY CALCULATIONS
203 !-----------------------------------------------------------------------
204 ! call hpm_start('PFDHT')
205 !
206 !$omp parallel do
207 DO K=KMS,KME
208 DO J=JMS,JME
209 DO I=IMS,IME
210 OMGALF(I,J,K)=0.
211 DIV(I,J,K)=0.
212 ENDDO
213 ENDDO
214 ENDDO
215 !
216 !$omp parallel do
217 DO J=JMS,JME
218 DO I=IMS,IME
219 PDSL(I,J)=0.
220 ENDDO
221 ENDDO
222 !
223 !$omp parallel do
224 DO J=JTS-5,JTE+5
225 DO I=ITS-5,ITE+5
226 ADPDNE(I,J)=0.
227 ADPDSE(I,J)=0.
228 ADPDX(I,J)=0.
229 ADPDY(I,J)=0.
230 APEL(I,J)=0.
231 CNE (I,J)=0.
232 CSE (I,J)=0.
233 DFDZ(I,J)=0.
234 DPDE(I,J)=0.
235 DPFEW(I,J)=0.
236 DPFNS(I,J)=0.
237 FILO(I,J)=0.
238 FIM (I,J)=0.
239 HM (I,J)=0.
240 PCEW(I,J)=0.
241 PCNE(I,J)=0.
242 PCNS(I,J)=0.
243 PCSE(I,J)=0.
244 PCXC(I,J)=0.
245 PEW (I,J)=0.
246 PNE (I,J)=0.
247 PNS (I,J)=0.
248 PPNE(I,J)=0.
249 PPSE(I,J)=0.
250 PSE (I,J)=0.
251 RDPD(I,J)=0.
252 RDPDX(I,J)=0.
253 RDPDY(I,J)=0.
254 TEW (I,J)=0.
255 TNE (I,J)=0.
256 TNS (I,J)=0.
257 TSE (I,J)=0.
258 UDY (I,J)=0.
259 VDX (I,J)=0.
260 ENDDO
261 ENDDO
262 !
263 IF(SIGMA==1)THEN
264 !$omp parallel do
265 DO J=MYJS_P4,MYJE_P4
266 DO I=MYIS_P4,MYIE_P4
267 FILO(I,J)=FIS(I,J)
268 PDSL(I,J)=PD(I,J)
269 ENDDO
270 ENDDO
271 ELSE
272 !$omp parallel do
273 DO J=MYJS_P4,MYJE_P4
274 DO I=MYIS_P4,MYIE_P4
275 FILO(I,J)=0.0
276 PDSL(I,J)=RES(I,J)*PD(I,J)
277 ENDDO
278 ENDDO
279 ENDIF
280 !
281 PRSFRC=PDTOP/(SLP_STD-PT)
282 !
283 !-----------------------------------------------------------------------
284 !
285 !*** MAIN VERTICAL INTEGRATION LOOP
286 !
287 !-----------------------------------------------------------------------
288 !$omp parallel do &
289 !$omp& private(adpdne,adpdse,adpdx,adpdy, &
290 !$omp& apel,cne,cse,dcnek,dcsek,dfdz,dpde,dpfew,dpfnek, &
291 !$omp& dpfns,dpfsek,dpnek,ediv,few,fne,fns,fse,hm, &
292 !$omp& pcew,pcne,pcns,pcse,pcxc,pew,pne,pns,ppne,ppse, &
293 !$omp& pse,pvnek,pvsek,rdpd,rdpdx,rdpdy,tew,tne,tns,tse, &
294 !$omp& udy,vdx,vm)
295 !-----------------------------------------------------------------------
296 !
297 main_integration : DO K=KTS,KTE
298 !
299 !-----------------------------------------------------------------------
300 !
301 !-----------------------------------------------------------------------
302 !*** INTEGRATE THE GEOPOTENTIAL
303 !-----------------------------------------------------------------------
304 !
305 DO J=MYJS_P4,MYJE_P4
306 DO I=MYIS_P4,MYIE_P4
307 !
308 HM(I,J)=HBM2(I,J)
309 !
310 APELP=(PINT(I,J,K+1)+PINT(I,J,K))*0.5
311 RTOPP=(Q(I,J,K)*P608-CWM(I,J,K)+1.)*T(I,J,K)*R_D/APELP
312 DFI=RTOPP*(DETA1(K)*PDTOP+DETA2(K)*PDSL(I,J))
313 !
314 APEL(I,J)=APELP
315 RTOP(I,J,K)=RTOPP
316 DFDZ(I,J)=RTOPP
317 !
318 FIUP=FILO(I,J)+DFI
319 FIM(I,J)=FILO(I,J)+FIUP
320 ! if(i==154.and.j==096)then
321 ! write(0,10281)k,q(i,j,k),cwm(i,j,k),t(i,j,k),apelp,pdsl(i,j)
322 10281 format(' k=',i2,' q=',z8,' cwm=',z8,' t=',z8,' apelp=',z8,' pdsl=',z8)
323 ! endif
324 FILO(I,J)=FIUP
325 !
326 ENDDO
327 ENDDO
328 !
329 !-----------------------------------------------------------------------
330 !
331 DO J=MYJS_P4,MYJE_P4
332 DO I=MYIS_P4,MYIE_P4
333 DPDE(I,J)=DETA1(K)*PDTOP+DETA2(K)*PDSL(I,J)
334 ENDDO
335 ENDDO
336 !
337 DO J=MYJS,MYJE
338 DO I=MYIS,MYIE
339 RDPD(I,J)=1./DPDE(I,J)
340 ENDDO
341 ENDDO
342 !
343 DO J=MYJS1_P3,MYJE1_P3
344 DO I=MYIS_P3,MYIE_P3
345 ADPDX(I,J)=DPDE(I+IVW(J),J)+DPDE(I+IVE(J),J)
346 ADPDY(I,J)=DPDE(I,J+1)+DPDE(I,J-1)
347 RDPDX(I,J)=1./ADPDX(I,J)
348 RDPDY(I,J)=1./ADPDY(I,J)
349 ENDDO
350 ENDDO
351 !
352 !-----------------------------------------------------------------------
353 !*** DIAGONAL CONTRIBUTIONS TO PRESSURE GRADIENT FORCE
354 !-----------------------------------------------------------------------
355 !
356 DO J=MYJS_P3,MYJE1_P3
357 DO I=MYIS_P3,MYIE_P3
358 ADPDNE(I,J)=DPDE(I+IHE(J),J+1)+DPDE(I,J)
359 PNE(I,J)=(FIM (I+IHE(J),J+1)-FIM (I,J)) &
360 & *(DWDT(I+IHE(J),J+1,K)+DWDT(I,J,K))
361 PPNE(I,J)=PNE(I,J)*ADPDNE(I,J)
362 CNE(I,J)=(DFDZ(I+IHE(J),J+1)+DFDZ(I,J))*2. &
363 & *(APEL(I+IHE(J),J+1)-APEL(I,J))
364 PCNE(I,J)=CNE(I,J)*ADPDNE(I,J)
365 ENDDO
366 ENDDO
367 !
368 DO J=MYJS1_P3,MYJE_P3
369 DO I=MYIS_P3,MYIE_P3
370 ADPDSE(I,J)=DPDE(I+IHE(J),J-1)+DPDE(I,J)
371 PSE(I,J)=(FIM (I+IHE(J),J-1)-FIM (I,J)) &
372 & *(DWDT(I+IHE(J),J-1,K)+DWDT(I,J,K))
373 ! if(i==154.and.j==096.and.k==kte)then
374 ! write(0,58391)PSE(I,J),FIM(I+IHE(J),J-1),FIM(I,J),DWDT(I+IHE(J),J-1,K),DWDT(I,J,K),ihe(j)
375 58391 format(' pse=',z8,' fim=',2(1x,z8),' dwdt=',2(1x,z8),' ihe=',i2)
376 ! endif
377 PPSE(I,J)=PSE(I,J)*ADPDSE(I,J)
378 CSE(I,J)=(DFDZ(I+IHE(J),J-1)+DFDZ(I,J))*2. &
379 & *(APEL(I+IHE(J),J-1)-APEL(I,J))
380 PCSE(I,J)=CSE(I,J)*ADPDSE(I,J)
381 ENDDO
382 ENDDO
383 !
384 !-----------------------------------------------------------------------
385 !*** CONTINUITY EQUATION MODIFICATION
386 !-----------------------------------------------------------------------
387 !
388 DO J=MYJS1_P1,MYJE1_P1
389 DO I=MYIS_P1,MYIE_P1
390 ! if(i==155.and.j==096.and.k==kte)then
391 ! write(0,72451)PNE(I+IVW(J),J),PNE(I,J-1),PSE(I+IVW(J),J),PSE(I,J+1),ivw(j)
392 ! write(0,72452)CNE(I+IVW(J),J),CNE(I,J-1),CSE(I+IVW(J),J),CSE(I,J+1)
393 72451 format(' pne=',2(1x,z8),' pse=',2(1x,z8),' ivw=',i2)
394 72452 format(' cne=',2(1x,z8),' cse=',2(1x,z8))
395 ! endif
396 PCXC(I,J)=VBM3(I,J)* &
397 & (PNE(I+IVW(J),J)+CNE(I+IVW(J),J) &
398 & +PSE(I+IVW(J),J)+CSE(I+IVW(J),J) &
399 & -PNE(I,J-1)-CNE(I,J-1) &
400 & -PSE(I,J+1)-CSE(I,J+1))
401 ENDDO
402 ENDDO
403 !
404 !-----------------------------------------------------------------------
405 !
406 DO J=MYJS2,MYJE2
407 DO I=MYIS1,MYIE1
408 ! if(i==155.and.j==095.and.k==kte)then
409 ! write(0,76501)deta1(k),deta2(k),prsfrc,wpdar(i,j),ihe(j),ihw(j)
410 ! write(0,76502)PCXC(I+IHE(J),J),PCXC(I,J+1),PCXC(I+IHW(J),J),PCXC(I,J-1)
411 76501 format(' deta1=',z8,' deta2=',z8,' prsfrc=',z8,' wpdar=',z8,' ihe=',i2,' ihw=',i2)
412 76502 format(' pcxc=',4(1x,z8))
413 ! endif
414 DIV(I,J,K)=(DETA1(K)*PRSFRC &
415 & +DETA2(K)*(1.-PRSFRC))*WPDAR(I,J) &
416 & *(PCXC(I+IHE(J),J)-PCXC(I,J+1) &
417 & +PCXC(I+IHW(J),J)-PCXC(I,J-1))
418 ENDDO
419 ENDDO
420 !
421 !-----------------------------------------------------------------------
422 !*** LATITUDINAL AND LONGITUDINAL PRESSURE FORCE COMPONENTS
423 !-----------------------------------------------------------------------
424 !
425 DO J=MYJS1_P2,MYJE1_P2
426 DO I=MYIS_P2,MYIE_P3
427 DPNEK=PNE(I+IVW(J),J)+PNE(I,J-1)
428 DPSEK=PSE(I+IVW(J),J)+PSE(I,J+1)
429 PEW(I,J)=DPNEK+DPSEK
430 PNS(I,J)=DPNEK-DPSEK
431 DCNEK=CNE(I+IVW(J),J)+CNE(I,J-1)
432 DCSEK=CSE(I+IVW(J),J)+CSE(I,J+1)
433 PCEW(I,J)=(DCNEK+DCSEK)*ADPDX(I,J)
434 PCNS(I,J)=(DCNEK-DCSEK)*ADPDY(I,J)
435 ENDDO
436 ENDDO
437 !
438 !-----------------------------------------------------------------------
439 !
440 IF(.NOT.FIRST)THEN ! Skip at timestep 0
441 !
442 !-----------------------------------------------------------------------
443 !*** UPDATE U AND V FOR PRESSURE GRADIENT FORCE
444 !-----------------------------------------------------------------------
445 !
446 DO J=MYJS2_P2,MYJE2_P2
447 DO I=MYIS_P2,MYIE1_P2
448 DPFNEK=((PPNE(I+IVW(J),J)+PPNE(I,J-1)) &
449 & +(PCNE(I+IVW(J),J)+PCNE(I,J-1)))
450 DPFNEK=DPFNEK+DPFNEK
451 DPFSEK=((PPSE(I+IVW(J),J)+PPSE(I,J+1)) &
452 & +(PCSE(I+IVW(J),J)+PCSE(I,J+1)))
453 DPFSEK=DPFSEK+DPFSEK
454 DPFEW(I,J)=DPFNEK+DPFSEK
455 DPFNS(I,J)=DPFNEK-DPFSEK
456 ENDDO
457 ENDDO
458 !
459 !-----------------------------------------------------------------------
460 !
461 DO J=MYJS2_P3,MYJE2_P3
462 DO I=MYIS_P2,MYIE1_P2
463 VM=VBM2(I,J)
464 U(I,J,K)=(((DPFEW(I,J)+PCEW(I,J))*RDPDX(I,J) &
465 & +PEW(I,J))*CPGFU(I,J))*VM+U(I,J,K)
466 V(I,J,K)=(((DPFNS(I,J)+PCNS(I,J))*RDPDY(I,J) &
467 & +PNS(I,J))*CPGFV)*VM+V(I,J,K)
468 ENDDO
469 ENDDO
470 !
471 !-----------------------------------------------------------------------
472 !
473 ENDIF !End of IF block executed for FIRST equal to .FALSE.
474 !
475 !-----------------------------------------------------------------------
476 !-----------------------------------------------------------------------
477 !
478 IF(.NOT.LAST_TIME)THEN !Do not execute block at last timestep
479 !
480 !-----------------------------------------------------------------------
481 !*** LATITUDINAL AND LONGITUDINAL FLUXES AND OMEGA-ALPHA COMPONENTS
482 !-----------------------------------------------------------------------
483 !
484 DO J=MYJS1_P2,MYJE1_P2
485 DO I=MYIS_P2,MYIE_P3
486 UDY(I,J)=DY*U(I,J,K)
487 FEW(I,J,K)=UDY(I,J)*ADPDX(I,J)
488 TEW(I,J)=UDY(I,J)*PCEW(I,J)
489 VDX(I,J)=DX(I,J)*V(I,J,K)
490 ! if(i==178.and.j==003.and.k==53)then
491 ! write(0,77601)udy(i,j),dy,u(i,j,k)
492 77601 format(' udy=',z8,' dy=',z8,' u=',z8)
493 ! endif
494 FNS(I,J,K)=VDX(I,J)*ADPDY(I,J)
495 TNS(I,J)=VDX(I,J)*PCNS(I,J)
496 ENDDO
497 ENDDO
498 !
499 !-----------------------------------------------------------------------
500 !*** DIAGONAL FLUXES AND DIAGONALLY AVERAGED WIND
501 !-----------------------------------------------------------------------
502 !
503 DO J=MYJS1_P1,MYJE2_P1
504 DO I=MYIS_P1,MYIE1_P1
505 PVNEK=(UDY(I+IHE(J),J)+VDX(I+IHE(J),J)) &
506 & +(UDY(I,J+1)+VDX(I,J+1))
507 FNE(I,J,K)=PVNEK*ADPDNE(I,J)
508 ! if(i==178.and.j==003.and.k==53)then
509 ! write(0,33781)fne(i,j,k),dpde(i+ihe(j),j+1),dpde(i,j),ihe(j)
510 ! write(0,33782)udy(i+ihe(j),j),udy(i,j+1),vdx(i+ihe(j),j),vdx(i,j+1)
511 33781 format(' fne=',z8,' dpdne=',2(1x,z8),' ihe=',i2)
512 33782 format(' udy=',2(1x,z8),' vdx=',2(1x,z8))
513 ! endif
514 TNE(I,J)=PVNEK*PCNE(I,J)*2.
515 ENDDO
516 ENDDO
517 !
518 DO J=MYJS2_P1,MYJE1_P1
519 DO I=MYIS_P1,MYIE1_P1
520 PVSEK=(UDY(I+IHE(J),J)-VDX(I+IHE(J),J)) &
521 & +(UDY(I,J-1)-VDX(I,J-1))
522 FSE(I,J,K)=PVSEK*ADPDSE(I,J)
523 TSE(I,J)=PVSEK*PCSE(I,J)*2.
524 ENDDO
525 ENDDO
526 !
527 !-----------------------------------------------------------------------
528 !*** HORIZONTAL PART OF OMEGA-ALPHA & DIVERGENCE
529 !-----------------------------------------------------------------------
530 !
531 DO J=MYJS2,MYJE2
532 DO I=MYIS1,MYIE1
533 OMGALF(I,J,K)=(TEW(I+IHE(J),J)+TEW(I+IHW(J),J) &
534 & +TNS(I,J+1) +TNS(I,J-1) &
535 & +TNE(I,J) +TNE(I+IHW(J),J-1) &
536 & +TSE(I,J) +TSE(I+IHW(J),J+1)) &
537 & *RDPD(I,J)*FCP(I,J)*HM(I,J)
538 !
539 ! if(i==178.and.j==003.and.k==53)then
540 ! write(0,36311)div(i,j,k),fdiv(i,j),ihe(j),ihw(j)
541 ! write(0,36312)FEW(I+IHE(J),J,K),FEW(I+IHW(J),J,K),FNS(I,J+1,K),FNS(I,J-1,K)
542 ! write(0,36313)FNE(I,J,K),FNE(I+IHW(J),J-1,K),FSE(I,J,K),FSE(I+IHW(J),J+1,K)
543 36311 format(' PFDHT div=',z8,' fdiv=',z8,' ihe=',i2,' ihw=',i2)
544 36312 format(' few=',2(1x,z8),' fns=',2(1x,z8))
545 36313 format(' fne=',2(1x,z8),' fse=',2(1x,z8))
546 ! endif
547 EDIV=(FEW(I+IHE(J),J,K) +FNS(I,J+1,K) &
548 +FNE(I,J,K) +FSE(I,J,K) &
549 -(FEW(I+IHW(J),J,K) +FNS(I,J-1,K) &
550 +FNE(I+IHW(J),J-1,K)+FSE(I+IHW(J),J+1,K)))*FDIV(I,J)
551 !
552 DIV(I,J,K)=(EDIV+DIV(I,J,K))*HM(I,J)
553 ENDDO
554 ENDDO
555 !
556 !-----------------------------------------------------------------------
557 !
558 ENDIF !End block to skip execution at last timestep
559 !
560 !-----------------------------------------------------------------------
561 !
562 ENDDO main_integration
563 !
564 !-----------------------------------------------------------------------
565 ! call hpm_stop('PFDHT')
566 !-----------------------------------------------------------------------
567 !
568 END SUBROUTINE PFDHT
569 !
570 !-----------------------------------------------------------------------
571 !***********************************************************************
572 !-----------------------------------------------------------------------
573 SUBROUTINE PDTE( &
574 #ifdef DM_PARALLEL
575 & GRID,MYPE,MPI_COMM_COMP, &
576 #endif
577 & NTSD,DT,PT,ETA2,RES,HYDRO,HBM2 &
578 & ,PD,PDSL,PDSLO &
579 & ,PETDT,DIV,PSDT &
580 & ,IHE,IHW,IVE,IVW &
581 & ,IDS,IDE,JDS,JDE,KDS,KDE &
582 & ,IMS,IME,JMS,JME,KMS,KME &
583 & ,ITS,ITE,JTS,JTE,KTS,KTE)
584 !***********************************************************************
585 !$$$ SUBPROGRAM DOCUMENTATION BLOCK
586 ! . . .
587 ! SUBPROGRAM: PDTE SURFACE PRESSURE TENDENCY CALC
588 ! PRGRMMR: JANJIC ORG: W/NP2 DATE: 96-07-??
589 !
590 ! ABSTRACT:
591 ! PDTE VERTICALLY INTEGRATES THE MASS FLUX DIVERGENCE TO
592 ! OBTAIN THE SURFACE PRESSURE TENDENCY AND VERTICAL VELOCITY ON
593 ! THE LAYER INTERFACES. THEN IT UPDATES THE HYDROSTATIC SURFACE
594 ! PRESSURE AND THE NONHYDROSTATIC PRESSURE.
595 !
596 ! PROGRAM HISTORY LOG:
597 ! 87-06-?? JANJIC - ORIGINATOR
598 ! 95-03-25 BLACK - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL
599 ! 96-05-?? JANJIC - ADDED NONHYDROSTATIC EFFECTS & MERGED THE
600 ! PREVIOUS SUBROUTINES PDTE & PDNEW
601 ! 00-01-03 BLACK - DISTRIBUTED MEMORY AND THREADS
602 ! 01-02-23 BLACK - CONVERTED TO WRF FORMAT
603 ! 01-04-11 BLACK - REWRITTEN FOR WRF CODING STANDARDS
604 ! 04-02-17 JANJIC - MOVED UPDATE OF T DUE TO OMEGA-ALPHA TERM
605 ! AND UPDATE OF PINT TO NEW ROUTINE VTOA
606 ! 04-11-23 BLACK - THREADED
607 ! 05-12-09 BLACK - CONVERTED FROM IKJ TO IJK
608 !
609 ! USAGE: CALL PDTE FROM SUBROUTINE SOLVE_RUNSTREAM
610 ! INPUT ARGUMENT LIST:
611 !
612 ! OUTPUT ARGUMENT LIST:
613 !
614 ! OUTPUT FILES:
615 ! NONE
616 !
617 ! SUBPROGRAMS CALLED:
618 !
619 ! UNIQUE: NONE
620 !
621 ! LIBRARY: NONE
622 !
623 ! ATTRIBUTES:
624 ! LANGUAGE: FORTRAN 90
625 ! MACHINE : IBM SP
626 !$$$
627 !***********************************************************************
628 #ifdef DM_PARALLEL
629 USE module_domain
630 USE MODULE_DM, ONLY : LOCAL_COMMUNICATOR &
631 ,MYTASK,NTASKS,NTASKS_X &
632 ,NTASKS_Y
633 USE MODULE_COMM_DM
634 #endif
635 !-----------------------------------------------------------------------
636 IMPLICIT NONE
637 !-----------------------------------------------------------------------
638 #ifdef DM_PARALLEL
639 ! INCLUDE "mpif.h"
640 TYPE (DOMAIN) :: GRID
641 INTEGER,INTENT(IN) :: MYPE,MPI_COMM_COMP
642 #endif
643 !-----------------------------------------------------------------------
644 LOGICAL,INTENT(IN) :: HYDRO
645 !
646 INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
647 ,IMS,IME,JMS,JME,KMS,KME &
648 ,ITS,ITE,JTS,JTE,KTS,KTE
649 !
650 INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW
651 !
652 INTEGER,INTENT(IN) :: NTSD
653 !
654 REAL,INTENT(IN) :: DT,PT
655 !
656 REAL,DIMENSION(KMS:KME),INTENT(IN) :: ETA2
657 !
658 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: RES,HBM2
659 !
660 REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(INOUT) :: DIV
661 !
662 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(INOUT) :: PD,PDSL
663 !
664 REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(INOUT) :: PETDT
665 !
666 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(OUT) :: PDSLO,PSDT
667 !
668 !-----------------------------------------------------------------------
669 !*** LOCAL VARIABLES
670 !-----------------------------------------------------------------------
671 !
672 INTEGER :: I,IHH,IHL,IX,J,JHH,JHL,JX,K,KS,NSMUD
673 INTEGER :: MY_IS_GLB,MY_IE_GLB,MY_JS_GLB,MY_JE_GLB
674 #ifdef DM_PARALLEL
675 INTEGER :: IPS,IPE,JPS,JPE,KPS,KPE
676 #endif
677 !#ifdef DEREF_KLUDGE
678 !! SEE http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
679 ! INTEGER :: SM31,EM31,SM32,EM32,SM33,EM33
680 ! INTEGER :: SM31X,EM31X,SM32X,EM32X,SM33X,EM33X
681 ! INTEGER :: SM31Y,EM31Y,SM32Y,EM32Y,SM33Y,EM33Y
682 !#endif
683 !
684 REAL :: PETDTL
685 !
686 REAL,DIMENSION(ITS-5:ITE+5,JTS-5:JTE+5) :: HBMS,PNE,PRET,PSE
687 !
688 !-----------------------------------------------------------------------
689 !***********************************************************************
690 !-----------------------------------------------------------------------
691 !#include "deref_kludge.h"
692 !
693 DO J=JMS,JME
694 DO I=IMS,IME
695 PDSLO(I,J)=0.
696 ENDDO
697 ENDDO
698 !
699 MY_IS_GLB=ITS
700 MY_IE_GLB=ITE
701 MY_JS_GLB=JTS
702 MY_JE_GLB=JTE
703 !
704 !-----------------------------------------------------------------------
705 !*** VERTICALLY INTEGRATE THE HORIZONTAL DIVERGENCE
706 !-----------------------------------------------------------------------
707 !
708 !$omp parallel do &
709 !$omp& private(i,j,k)
710 DO K=KTE-1,KTS,-1
711 DO J=MYJS_P2,MYJE_P2
712 DO I=MYIS_P2,MYIE_P2
713 DIV(I,J,K)=DIV(I,J,K+1)+DIV(I,J,K)
714 ENDDO
715 ENDDO
716 ENDDO
717 !
718 !-----------------------------------------------------------------------
719 !*** COMPUTATION OF PRESSURE TENDENCY
720 !-----------------------------------------------------------------------
721 !
722 !$omp parallel do &
723 !$omp& private(i,j)
724 DO J=MYJS_P2,MYJE_P2
725 DO I=MYIS_P2,MYIE_P2
726 PSDT(I,J)=-DIV(I,J,KTS)
727 PDSLO(I,J)=PDSL(I,J)
728 ENDDO
729 ENDDO
730 !-----------------------------------------------------------------------
731 DO J=JMS,JME
732 DO I=IMS,IME
733 PDSL(I,J)=0.
734 ENDDO
735 ENDDO
736 !
737 !$omp parallel do &
738 !$omp& private(i,j)
739 DO J=MYJS_P2,MYJE_P2
740 DO I=MYIS_P2,MYIE_P2
741 PD(I,J)=PSDT(I,J)*DT+PD(I,J)
742 PRET(I,J)=PSDT(I,J)*RES(I,J)
743 PDSL(I,J)=PD(I,J)*RES(I,J)
744 ENDDO
745 ENDDO
746 !
747 !-----------------------------------------------------------------------
748 !*** COMPUTATION OF PETDT
749 !-----------------------------------------------------------------------
750 !
751 !$omp parallel do &
752 !$omp& private(i,j,k)
753 DO K=KTE-1,KTS,-1
754 DO J=MYJS_P2,MYJE_P2
755 DO I=MYIS_P2,MYIE_P2
756 PETDT(I,J,K)=-(PRET(I,J)*ETA2(K+1)+DIV(I,J,K+1)) &
757 & *HBM2(I,J)
758 ENDDO
759 ENDDO
760 ENDDO
761 !
762 !-----------------------------------------------------------------------
763 !*** SMOOTHING VERTICAL VELOCITY ALONG BOUNDARIES
764 !-----------------------------------------------------------------------
765 !
766 nonhydrostatic_smoothing: IF(.NOT.HYDRO.AND.KSMUD.GT.0)THEN
767 !
768 NSMUD=KSMUD
769 !
770 DO J=MYJS,MYJE
771 DO I=MYIS,MYIE
772 HBMS(I,J)=HBM2(I,J)
773 ENDDO
774 ENDDO
775 !
776 JHL=LNSDT
777 JHH=JDE-JHL+1
778 !
779 !$omp parallel do &
780 !$omp& private(i,ihh,ihl,ix,j,jx)
781 DO J=JHL,JHH
782 IF(J.GE.MY_JS_GLB.AND.J.LE.MY_JE_GLB)THEN
783 IHL=JHL/2+1
784 IHH=IDE-IHL+MOD(J,2)
785 !
786 DO I=IHL,IHH
787 IF(I.GE.MY_IS_GLB.AND.I.LE.MY_IE_GLB)THEN
788 IX=I ! -MY_IS_GLB+1
789 JX=J ! -MY_JS_GLB+1
790 HBMS(IX,JX)=0.
791 ENDIF
792 ENDDO
793 !
794 ENDIF
795 ENDDO
796 !
797 !-----------------------------------------------------------------------
798 !***
799 !*** SMOOTH THE VERTICAL VELOCITY
800 !***
801 !-----------------------------------------------------------------------
802 !
803 DO KS=1,NSMUD
804 !
805 !-----------------------------------------------------------------------
806 !
807 !*** PNE AT H(I,J) LIES BETWEEN (I,J) AND THE H POINT TO THE NE.
808 !*** PSE AT H(I,J) LIES BETWEEN (I,J) AND THE H POINT TO THE SE.
809 !
810 !$omp parallel do &
811 !$omp& private(i,j,k,petdtl,pne,pse)
812 !
813 DO K=KTS+1,KTE
814 !
815 DO J=MYJS_P1,MYJE1_P1
816 DO I=MYIS_P1,MYIE1_P1
817 PNE(I,J)=PETDT(I+IHE(J),J+1,K)-PETDT(I,J,K)
818 ENDDO
819 ENDDO
820 !
821 DO J=MYJS1_P1,MYJE_P1
822 DO I=MYIS_P1,MYIE1_P1
823 PSE(I,J)=PETDT(I+IHE(J),J-1,K)-PETDT(I,J,K)
824 ENDDO
825 ENDDO
826 !
827 DO J=MYJS2,MYJE2
828 DO I=MYIS1,MYIE1
829 PETDTL=(PNE(I,J)-PNE(I+IHW(J),J-1) &
830 & +PSE(I,J)-PSE(I+IHW(J),J+1))*HBM2(I,J)
831 PETDT(I,J,K)=PETDTL*HBMS(I,J)*0.125+PETDT(I,J,K)
832 ENDDO
833 ENDDO
834 !
835 ENDDO
836 !
837 #ifdef DM_PARALLEL
838 ! IPS=ITS;IPE=ITE;JPS=JTS;JPE=JTE;KPS=KTS;KPE=KTE
839 # include <HALO_NMM_E.inc>
840 #endif
841 !-----------------------------------------------------------------------
842 !
843 ENDDO ! End of smoothing loop
844 !
845 !-----------------------------------------------------------------------
846 !
847 ENDIF nonhydrostatic_smoothing
848 !
849 !-----------------------------------------------------------------------
850 !
851 END SUBROUTINE PDTE
852 !
853 !-----------------------------------------------------------------------
854 !***********************************************************************
855 !-----------------------------------------------------------------------
856 SUBROUTINE VTOA( &
857 #ifdef DM_PARALLEL
858 & GRID, &
859 #endif
860 & NTSD,DT,PT,ETA2 &
861 & ,HBM2,EF4T &
862 & ,T,DWDT,RTOP,OMGALF &
863 & ,PINT,DIV,PSDT,RES &
864 & ,IHE,IHW,IVE,IVW &
865 & ,IDS,IDE,JDS,JDE,KDS,KDE &
866 & ,IMS,IME,JMS,JME,KMS,KME &
867 & ,ITS,ITE,JTS,JTE,KTS,KTE)
868 !***********************************************************************
869 !$$$ SUBPROGRAM DOCUMENTATION BLOCK
870 ! . . .
871 ! SUBPROGRAM: VTOA OMEGA-ALPHA
872 ! PRGRMMR: JANJIC ORG: W/NP2 DATE: 04-02-17
873 !
874 ! ABSTRACT:
875 ! VTOA UPDATES THE NONHYDROSTATIC PRESSURE AND ADDS THE
876 ! CONTRIBUTION OF THE OMEGA-ALPHA TERM OF THE THERMODYNAMIC
877 ! EQUATION. ALSO, THE OMEGA-ALPHA TERM IS COMPUTED FOR DIAGNOSTICS.
878 !
879 ! PROGRAM HISTORY LOG:
880 ! 04-02-17 JANJIC - SEPARATED FROM ORIGINAL PDTEDT ROUTINE
881 ! 04-11-23 BLACK - THREADED
882 !
884 ! INPUT ARGUMENT LIST:
885 !
886 ! OUTPUT ARGUMENT LIST:
887 !
888 ! OUTPUT FILES:
889 ! NONE
890 !
891 ! SUBPROGRAMS CALLED:
892 !
893 ! UNIQUE: NONE
894 !
895 ! LIBRARY: NONE
896 !
897 ! ATTRIBUTES:
898 ! LANGUAGE: FORTRAN 90
899 ! MACHINE : IBM SP
900 !$$$
901 !***********************************************************************
902 #ifdef DM_PARALLEL
903 USE MODULE_DOMAIN
904 USE MODULE_DM, ONLY : LOCAL_COMMUNICATOR &
905 ,MYTASK,NTASKS,NTASKS_X &
906 ,NTASKS_Y
907 USE MODULE_COMM_DM
908 #endif
909 !-----------------------------------------------------------------------
910 IMPLICIT NONE
911 !-----------------------------------------------------------------------
912 #ifdef DM_PARALLEL
913 ! INCLUDE "mpif.h"
914 TYPE (DOMAIN) :: GRID
915 #endif
916 !-----------------------------------------------------------------------
917 !
918 INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
919 ,IMS,IME,JMS,JME,KMS,KME &
920 ,ITS,ITE,JTS,JTE,KTS,KTE
921 !
922 INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW
923 !
924 INTEGER,INTENT(IN) :: NTSD
925 !
926 REAL,INTENT(IN) :: DT,EF4T,PT
927 !
928 REAL,DIMENSION(KMS:KME),INTENT(IN) :: ETA2
929 !
930 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: HBM2,PSDT,RES
931 !
932 REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(IN) :: DIV,DWDT &
933 & ,RTOP
934 !
935 REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(INOUT) :: OMGALF,T
936 !
937 REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(INOUT) :: PINT
938 !
939 !-----------------------------------------------------------------------
940 !*** LOCAL VARIABLES
941 !-----------------------------------------------------------------------
942 !
943 INTEGER :: I,J,K
944 !
945 REAL,DIMENSION(ITS-5:ITE+5,JTS-5:JTE+5) :: PRET,TPM
946 !
947 REAL :: DWDTP,RHS,TPMP
948 !
949 !-----------------------------------------------------------------------
950 !***********************************************************************
951 !-----------------------------------------------------------------------
952 !*** PREPARATIONS
953 !-----------------------------------------------------------------------
954 !
955 !$omp parallel do &
956 !$omp& private(i,j)
957 DO J=MYJS_P2,MYJE_P2
958 DO I=MYIS_P2,MYIE_P2
959 PINT(I,J,KTE+1)=PT
960 TPM(I,J)=PT+PINT(I,J,KTE)
961 PRET(I,J)=PSDT(I,J)*RES(I,J)
962 ENDDO
963 ENDDO
964 !
965 !-----------------------------------------------------------------------
966 !*** KINETIC ENERGY GENERATION TERMS IN T EQUATION
967 !-----------------------------------------------------------------------
968 !
969 !$omp parallel do &
970 !$omp& private(dwdtp,i,j,rhs,tpmp)
971 DO J=MYJS,MYJE
972 DO I=MYIS,MYIE
973 DWDTP=DWDT(I,J,KTE)
974 TPMP=PINT(I,J,KTE)+PINT(I,J,KTE-1)
975 !
976 RHS=-DIV(I,J,KTE)*RTOP(I,J,KTE)*DWDTP*EF4T
977 OMGALF(I,J,KTE)=OMGALF(I,J,KTE)+RHS
978 T(I,J,KTE)=OMGALF(I,J,KTE)*HBM2(I,J)+T(I,J,KTE)
979 PINT(I,J,KTE)=PRET(I,J)*(ETA2(KTE+1)+ETA2(KTE))*DWDTP*DT &
980 & +TPM(I,J)-PINT(I,J,KTE+1)
981 !
982 TPM(I,J)=TPMP
983 ENDDO
984 ENDDO
985 !-----------------------------------------------------------------------
986 !$omp parallel do &
987 !$omp& private(dwdtp,i,j,k,rhs,tpmp)
988 DO K=KTE-1,KTS+1,-1
989 DO J=MYJS,MYJE
990 DO I=MYIS,MYIE
991 DWDTP=DWDT(I,J,K)
992 TPMP=PINT(I,J,K)+PINT(I,J,K-1)
993 !
994 RHS=-(DIV(I,J,K+1)+DIV(I,J,K))*RTOP(I,J,K)*DWDTP*EF4T
995 OMGALF(I,J,K)=OMGALF(I,J,K)+RHS
996 T(I,J,K)=OMGALF(I,J,K)*HBM2(I,J)+T(I,J,K)
997 PINT(I,J,K)=PRET(I,J)*(ETA2(K+1)+ETA2(K))*DWDTP*DT &
998 & +TPM(I,J)-PINT(I,J,K+1)
999 !
1000 TPM(I,J)=TPMP
1001 ENDDO
1002 ENDDO
1003 ENDDO
1004 !-----------------------------------------------------------------------
1005 !$omp parallel do &
1006 !$omp& private(dwdtp,i,j,rhs)
1007 DO J=MYJS,MYJE
1008 DO I=MYIS,MYIE
1009 !
1010 DWDTP=DWDT(I,J,KTS)
1011 !
1012 ! if(i==77.and.j==53)then
1013 ! write(0,28361)t(i,j,kts),omgalf(i,j,kts),rtop(i,j,kts),dwdtp
1014 ! write(0,28362)div(i,j,kts),div(i,j,kts+1),ef4t
1015 28361 format(' t=',z8,' omgalf=',z8,' rtop=',z8,' dwdtp=',z8)
1016 28362 format(' div=',2(1x,z8),' ef4t=',z8)
1017 ! endif
1018 RHS=-(DIV(I,J,KTS+1)+DIV(I,J,KTS))*RTOP(I,J,KTS)*DWDTP*EF4T
1019 OMGALF(I,J,KTS)=OMGALF(I,J,KTS)+RHS
1020 T(I,J,KTS)=OMGALF(I,J,KTS)*HBM2(I,J)+T(I,J,KTS)
1021 PINT(I,J,KTS)=PRET(I,J)*(ETA2(KTS+1)+ETA2(KTS))*DWDTP*DT &
1022 & +TPM(I,J)-PINT(I,J,KTS+1)
1023 ENDDO
1024 ENDDO
1025 !-----------------------------------------------------------------------
1026 !
1027 END SUBROUTINE VTOA
1028 !
1029 !-----------------------------------------------------------------------
1030 !***********************************************************************
1031 SUBROUTINE DDAMP(NTSD,DT,DETA1,DETA2,PDSL,PDTOP,DIV,HBM2 &
1032 & ,T,U,V,DDMPU,DDMPV &
1033 & ,IHE,IHW,IVE,IVW &
1034 & ,IDS,IDE,JDS,JDE,KDS,KDE &
1035 & ,IMS,IME,JMS,JME,KMS,KME &
1036 & ,ITS,ITE,JTS,JTE,KTS,KTE)
1037 !***********************************************************************
1038 !$$$ SUBPROGRAM DOCUMENTATION BLOCK
1039 ! . . .
1040 ! SUBPROGRAM: DDAMP DIVERGENCE DAMPING
1041 ! PRGRMMR: JANJIC ORG: W/NP22 DATE: 94-03-08
1042 !
1043 ! ABSTRACT:
1044 ! DDAMP MODIFIES THE WIND COMPONENTS SO AS TO REDUCE THE
1045 ! HORIZONTAL DIVERGENCE.
1046 !
1047 ! PROGRAM HISTORY LOG:
1048 ! 87-08-?? JANJIC - ORIGINATOR
1049 ! 95-03-25 BLACK - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL
1050 ! 95-03-28 BLACK - ADDED EXTERNAL EDGE
1051 ! 98-10-30 BLACK - MODIFIED FOR DISTRIBUTED MEMORY
1052 ! 01-03-12 BLACK - CONVERTED TO WRF STRUCTURE
1053 ! 04-11-18 BLACK - THREADED
1054 ! 05-12-09 BLACK - CONVERTED FROM IKJ TO IJK
1055 !
1056 ! USAGE: CALL DDAMP FROM SUBROUTINE SOLVE_RUNSTREAM
1057 !
1058 ! INPUT ARGUMENT LIST:
1059 !
1060 ! OUTPUT ARGUMENT LIST:
1061 !
1062 ! OUTPUT FILES:
1063 ! NONE
1064 !
1065 ! SUBPROGRAMS CALLED:
1066 !
1067 ! UNIQUE: NONE
1068 !
1069 ! LIBRARY: NONE
1070 !
1071 ! ATTRIBUTES:
1072 ! LANGUAGE: FORTRAN 90
1073 ! MACHINE : IBM SP
1074 !$$$
1075 !***********************************************************************
1076 !-----------------------------------------------------------------------
1077 IMPLICIT NONE
1078 !-----------------------------------------------------------------------
1079 !
1080 INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
1081 & ,IMS,IME,JMS,JME,KMS,KME &
1082 & ,ITS,ITE,JTS,JTE,KTS,KTE
1083 !
1084 INTEGER,DIMENSION(JMS:JME),INTENT(IN) :: IHE,IHW,IVE,IVW
1085 !
1086 INTEGER,INTENT(IN) :: NTSD
1087 !
1088 REAL,INTENT(IN) :: DT,PDTOP
1089 !
1090 REAL,DIMENSION(KMS:KME-1),INTENT(IN) :: DETA1,DETA2
1091 !
1092 REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: DDMPU,DDMPV &
1093 & ,HBM2,PDSL
1094 !
1095 REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(INOUT) :: DIV,T &
1096 & ,U,V
1097 !
1098 !-----------------------------------------------------------------------
1099 !*** LOCAL VARIABLES
1100 !-----------------------------------------------------------------------
1101 !
1102 INTEGER :: I,J,K
1103 !
1104 REAL :: FCIM,FCXM,RDPDX,RDPDY
1105 !
1106 REAL,DIMENSION(ITS-5:ITE+5,JTS-5:JTE+5) :: DIVE,DPDE,PDE &
1107 & ,XDIVX,XDIVY
1108 !
1109 !-----------------------------------------------------------------------
1110 !***********************************************************************
1111 !-----------------------------------------------------------------------
1112 !
1113 !$omp parallel do &
1114 !$omp& private(i,j)
1115 DO J=JTS-5,JTE+5
1116 DO I=ITS-5,ITE+5
1117 PDE(I,J)=0.
1118 DPDE(I,J)=0.
1119 XDIVX(I,J)=0.
1120 XDIVY(I,J)=0.
1121 ENDDO
1122 ENDDO
1123 !
1124 !-----------------------------------------------------------------------
1125 !
1126 FCXM=1.
1127 !
1128 DO J=MYJS_P2,MYJE_P2
1129 DO I=MYIS_P2,MYIE_P2
1130 PDE (I,J)=PDSL(I,J)+PDTOP
1131 DIVE(I,J)=0.
1132 ENDDO
1133 ENDDO
1134 !
1135 DO K=KTS,KTE
1136 !$omp parallel do
1137 DO J=MYJS_P2,MYJE_P2
1138 DO I=MYIS_P2,MYIE_P2
1139 DIVE(I,J)=DIV(I,J,K)*HBM2(I,J)+DIVE(I,J)
1140 ENDDO
1141 ENDDO
1142 ENDDO
1143 !
1144 !$omp parallel do &
1145 !$omp& private(i,j,rdpdx,rdpdy)
1146 DO J=MYJS2,MYJE2
1147 DO I=MYIS1_P1,MYIE1_P1
1148 RDPDX=DDMPU(I,J)*FCXM &
1149 & /(PDE(I+IVW(J),J) +PDE(I+IVE(J),J))
1150 RDPDY=DDMPV(I,J)*FCXM &
1151 & /(PDE(I ,J-1)+PDE(I ,J+1))
1152 !
1153 XDIVX(I,J)=(DIVE(I+IVE(J),J )-DIVE(I+IVW(J),J ))*RDPDX
1154 XDIVY(I,J)=(DIVE(I ,J+1)-DIVE(I ,J-1))*RDPDY
1155 ENDDO
1156 ENDDO
1157 !
1158 !-----------------------------------------------------------------------
1159 !
1160 FCIM=1.
1161 !
1162 !$omp parallel do &
1163 !$omp& private(dpde,i,j,k,rdpdx,rdpdy)
1164 !
1165 DO K=KTS,KTE
1166 !
1167 !-----------------------------------------------------------------------
1168 !
1169 DO J=MYJS_P2,MYJE_P2
1170 DO I=MYIS_P1,MYIE_P1
1171 DPDE(I,J)=DETA1(K)*PDTOP+DETA2(K)*PDSL(I,J)
1172 DIV(I,J,K)=DIV(I,J,K)*HBM2(I,J)
1173 ENDDO
1174 ENDDO
1175 !
1176 DO J=MYJS2,MYJE2
1177 DO I=MYIS1_P1,MYIE1_P1
1178 RDPDX=DDMPU(I,J)*FCIM &
1179 & /(DPDE(I+IVW(J),J) +DPDE(I+IVE(J),J))
1180 RDPDY=DDMPV(I,J)*FCIM &
1181 & /(DPDE(I ,J-1)+DPDE(I ,J+1))
1182 U(I,J,K)=((DIV(I+IVE(J),J,K )-DIV(I+IVW(J),J,K ))*RDPDX &
1183 & +XDIVX(I,J))+U(I,J,K)
1184 V(I,J,K)=((DIV(I ,J+1,K)-DIV(I ,J-1,K))*RDPDY &
1185 & +XDIVY(I,J))+V(I,J,K)
1186 ENDDO
1187 ENDDO
1188 !
1189 !-----------------------------------------------------------------------
1190 !
1191 ENDDO
1192 !
1193 !-----------------------------------------------------------------------
1194 !
1195 END SUBROUTINE DDAMP
1196 !
1197 !-----------------------------------------------------------------------
1198 !
1199 END MODULE MODULE_IGWAVE_ADJUST
1200 !
1201 !-----------------------------------------------------------------------