Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

module_NONHY_DYNAM.F @ 3567

Last change on this file since 3567 was 2759, checked in by aslmd, 2 years ago
adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size
File size: 30.7 KB

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

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

Download in other formats:

Original Format