Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

module_NONHY_DYNAM.F @ 2743

Last change on this file since 2743 was 1, checked in by lfita, 12 years ago

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

WRF: version v3.3
LMDZ: version v1818

More details in:

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

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

Download in other formats:

Original Format