Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

module_IGWAVE_ADJUST.F @ 2367

Last change on this file since 2367 was 1, checked in by lfita, 11 years ago

-- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 43.2 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format