Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

module_IGWAVE_ADJUST.F @ 3709

Last change on this file since 3709 was 11, checked in by aslmd, 15 years ago
spiga@svn-planeto:ajoute le modele meso-echelle martien
File size: 49.0 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_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)=PVNEKPCNE(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)=PVSEKPCSE(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)=PVNEKPCNE(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)=PVSEKPCSE(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)=PETDTLHBMS(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)DWDTPEF4T
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	& DWDTPEF4T
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 :: RDPDX,RDPDY
1334	!
1335	!*** TYPE 4 WORKING ARRAY ! See PFDHT
1336	!
1337	REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,-1:1) :: CKE,DPDE
1338	!
1339	!-----------------------------------------------------------------------
1340	!***********************************************************************
1341	!-----------------------------------------------------------------------
1342	!
1343	!*** MARCH NORTHWARD THROUGH THE SOUTHERNMOST SLABS TO BEGIN
1344	!*** FILLING THE WORKING ARRAY NEEDED FOR AVERAGING AND
1345	!*** DIFFERENCING IN J
1346	!
1347	!-----------------------------------------------------------------------
1348	JSTART=MYJS2
1349	!
1350	DO J=-1,0
1351	JJ=JSTART+J
1352	!
1353	!$omp parallel do &
1354	!$omp& private(i,k)
1355	DO K=KTS,KTE
1356	DO I=MYIS_P2,MYIE_P2
1357	DPDE(I,K,J)=DETA1(K)PDTOP+DETA2(K)PDSL(I,JJ)
1358	DIV(I,K,JJ)=DIV(I,K,JJ)*HBM2(I,JJ)
1359	ENDDO
1360	ENDDO
1361	!
1362	ENDDO
1363	!
1364	JKNT=0
1365	!-----------------------------------------------------------------------
1366	!
1367	main_integration : DO J=MYJS2,MYJE2
1368	!
1369	!-----------------------------------------------------------------------
1370	!***
1371	!*** SET THE 3RD INDEX OF THE WORKING ARRAYS (SEE SUBROUTINE INIT
1372	!*** AND PFDHT DIAGRAMS)
1373	!***
1374	!*** J[TYPE]_NN WHERE "TYPE" IS THE WORKING ARRAY TYPE SEEN IN THE
1375	!*** LOCAL DECLARATION ABOVE (DEPENDENT UPON THE J EXTENT) AND
1376	!*** NN IS THE NUMBER OF ROWS NORTH OF THE CENTRAL ROW WHOSE J IS
1377	!*** THE CURRENT VALUE OF THE main_integration LOOP.
1378	!*** (P2 denotes +2, etc.)
1379	!***
1380	JKNT=JKNT+1
1381	!
1382	J4_P1=INDX3_WRK(1,JKNT,4)
1383	J4_00=INDX3_WRK(0,JKNT,4)
1384	J4_M1=INDX3_WRK(-1,JKNT,4)
1385	!
1386	!-----------------------------------------------------------------------
1387	!$omp parallel do &
1388	!$omp& private(i,k,rdpdx,rdpdy)
1389	DO K=KTS,KTE
1390	!
1391	DO I=MYIS_P2,MYIE_P2
1392	DPDE(I,K,J4_P1)=DETA1(K)PDTOP+DETA2(K)PDSL(I,J+1)
1393	DIV(I,K,J+1)=DIV(I,K,J+1)*HBM2(I,J+1)
1394	ENDDO
1395	!
1396	DO I=MYIS1_P1,MYIE1_P1
1397	RDPDX=VTM(I,K,J)/(DPDE(I+IVW(J),K,J4_00) &
1398	& +DPDE(I+IVE(J),K,J4_00))
1399	U(I,K,J)=U(I,K,J)+(DIV(I+IVE(J),K,J)-DIV(I+IVW(J),K,J)) &
1400	& RDPDXDDMPU(I,J)
1401	!
1402	RDPDY=VTM(I,K,J)/(DPDE(I,K,J4_M1)+DPDE(I,K,J4_P1))
1403	V(I,K,J)=V(I,K,J)+(DIV(I,K,J+1)-DIV(I,K,J-1)) &
1404	& RDPDYDDMPV(I,J)
1405	ENDDO
1406	!
1407	ENDDO
1408	!
1409	!-----------------------------------------------------------------------
1410	!
1411	ENDDO main_integration
1412	!
1413	!-----------------------------------------------------------------------
1414	END SUBROUTINE DDAMP
1415	!-----------------------------------------------------------------------
1416	END MODULE MODULE_IGWAVE_ADJUST
1417	!-----------------------------------------------------------------------

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

Download in other formats:

Original Format