Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

module_DIFFUSION_NMM.F @ 1577

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

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

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 16.5 KB

Line
1	!-----------------------------------------------------------------------
2	!
3	!NCEP_MESO:MODEL_LAYER: HORIZONTAL DIFFUSION
4	!
5	!-----------------------------------------------------------------------
6	!
7	#include "nmm_loop_basemacros.h"
8	#include "nmm_loop_macros.h"
9	!
10	!-----------------------------------------------------------------------
11	!
12	MODULE MODULE_DIFFUSION_NMM
13	!
14	!-----------------------------------------------------------------------
15	USE MODULE_MODEL_CONSTANTS
16	USE MODULE_CONFIGURE, ONLY : GRID_CONFIG_REC_TYPE
17	USE MODULE_STATE_DESCRIPTION
18	!-----------------------------------------------------------------------
19	!
20	LOGICAL :: SECOND=.TRUE.
21	INTEGER :: KSMUD=1
22	!
23	!-----------------------------------------------------------------------
24	!
25	CONTAINS
26	!
27	!***********************************************************************
28	SUBROUTINE HDIFF(NTSD,DT,FIS,DY,HDAC,HDACV &
29	& ,HBM2,DETA1,SIGMA &
30	#ifdef HWRF
31	& ,T,Q,U,V,Q2,Z,W,SM,SICE,h_diff &
32	#else
33	& ,T,Q,U,V,Q2,Z,W,SM,SICE &
34	#endif
35	& ,DEF3D &
36	& ,IHE,IHW,IVE,IVW &
37	& ,CONFIG_FLAGS &
38	& ,IDS,IDE,JDS,JDE,KDS,KDE &
39	& ,IMS,IME,JMS,JME,KMS,KME &
40	& ,ITS,ITE,JTS,JTE,KTS,KTE)
41	!***********************************************************************
42	!$$$ SUBPROGRAM DOCUMENTATION BLOCK
43	! . . .
44	! SUBPROGRAM: HDIFF HORIZONTAL DIFFUSION
45	! PRGRMMR: JANJIC ORG: W/NP22 DATE: 93-11-17
46	!
47	! ABSTRACT:
48	! HDIFF CALCULATES THE CONTRIBUTION OF THE HORIZONTAL DIFFUSION
49	! TO THE TENDENCIES OF TEMPERATURE, SPECIFIC HUMIDITY, WIND
50	! COMPONENTS, AND TURBULENT KINETIC ENERGY AND THEN UPDATES THOSE
51	! VARIABLES. A SECOND-ORDER NONLINEAR SCHEME SIMILAR TO
52	! SMAGORINSKY'S IS USED WHERE THE DIFFUSION COEFFICIENT IS
53	! A FUNCTION OF THE DEFORMATION FIELD AND OF THE TURBULENT
54	! KINETIC ENERGY.
55	!
56	! PROGRAM HISTORY LOG:
57	! 87-06-?? JANJIC - ORIGINATOR
58	! 95-03-25 BLACK - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL
59	! 96-03-28 BLACK - ADDED EXTERNAL EDGE
60	! 98-10-30 BLACK - MODIFIED FOR DISTRIBUTED MEMORY
61	! 02-02-07 BLACK - CONVERTED TO WRF STRUCTURE
62	! 02-08-29 MICHALAKES -
63	! 02-09-06 WOLFE -
64	! 03-05-27 JANJIC - ADDED SLOPE ADJUSTMENT
65	! 04-11-18 BLACK - THREADED
66	! 05-12-12 BLACK - CONVERTED FROM IKJ TO IJK
67	! 06-08-15 JANJIC - ENHANCEMENT AT SLOPING SEA COAST
68	!
69	! USAGE: CALL HDIFF FROM SUBROUTINE SOLVE_RUNSTREAM
70	!
71	! INPUT ARGUMENT LIST:
72	!
73	! OUTPUT ARGUMENT LIST:
74	!
75	! OUTPUT FILES:
76	! NONE
77	!
78	! SUBPROGRAMS CALLED:
79	!
80	! UNIQUE: NONE
81	!
82	! LIBRARY: NONE
83	!
84	! ATTRIBUTES:
85	! LANGUAGE: FORTRAN 90
86	! MACHINE : IBM SP
87	!$$$
88	!***********************************************************************
89	!-----------------------------------------------------------------------
90	!
91	IMPLICIT NONE
92	!
93	!-----------------------------------------------------------------------
94	!
95	!*** STRUCTURE THAT CONTAINS RUN-TIME CONFIGURATION (NAMELIST) DATA FOR DOMAIN
96	!
97	TYPE(GRID_CONFIG_REC_TYPE),INTENT(IN) :: CONFIG_FLAGS
98	!
99	INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
100	& ,IMS,IME,JMS,JME,KMS,KME &
101	& ,ITS,ITE,JTS,JTE,KTS,KTE
102	!
103	INTEGER,INTENT(IN) :: NTSD
104	!
105	REAL,INTENT(IN) :: DT,DY
106	#ifdef HWRF
107	REAL,INTENT(IN) :: H_DIFF
108	#endif
109	!
110	REAL,DIMENSION(KMS:KME),INTENT(IN) :: DETA1
111	!
112	REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: FIS,HBM2 &
113	& ,HDAC,HDACV &
114	& ,SM,SICE
115	!
116	REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(OUT) :: DEF3D
117	!
118	REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(IN) :: W,Z
119	!
120	REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME),INTENT(INOUT) :: T,Q,Q2 &
121	& ,U,V
122	!
123	INTEGER, DIMENSION(JMS:JME), INTENT(IN) :: IHE,IHW,IVE,IVW
124	!
125	!-----------------------------------------------------------------------
126	!
127	INTEGER,INTENT(IN) :: SIGMA
128	!
129	!-----------------------------------------------------------------------
130	!*** LOCAL VARIABLES
131	!-----------------------------------------------------------------------
132	!
133	INTEGER :: I,J,K,KS
134	!
135	REAL :: DEF_IJ,DEFSK,DEFTK,HKNE_IJ,HKSE_IJ,Q2L,RDY,SLOP,SLOPHC &
136	& ,UTK,VKNE_IJ,VKSE_IJ,VTK,DEF1,DEF2,DEF3,DEF4
137	!
138	REAL,DIMENSION(ITS-5:ITE+5,JTS-5:JTE+5) :: DEF,HKNE,HKSE &
139	& ,Q2DIF,Q2NE,Q2SE &
140	& ,QDIF,QNE,QSE,SNE,SSE &
141	& ,TDIF,TNE,TSE &
142	& ,UDIF,UNE,USE &
143	& ,VDIF,VKNE,VKSE,VNE,VSE
144	!
145	LOGICAL :: CILINE,WATSLOP
146	!
147	!-----------------------------------------------------------------------
148	!***********************************************************************
149	!-----------------------------------------------------------------------
150	!
151	#ifdef HWRF
152	SLOPHC=SLOPHTSQRT(2.)0.5*9.
153	#else
154	SLOPHC=config_flags%slophc
155	#endif
156	RDY=1./DY
157	!
158	DO J=JTS-5,JTE+5
159	DO I=ITS-5,ITE+5
160	DEF(I,J)=0.
161	TNE(I,J)=0.
162	QNE(I,J)=0.
163	Q2NE(I,J)=0.
164	HKNE(I,J)=0.
165	UNE(I,J)=0.
166	VNE(I,J)=0.
167	VKNE(I,J)=0.
168	TSE(I,J)=0.
169	QSE(I,J)=0.
170	Q2SE(I,J)=0.
171	HKSE(I,J)=0.
172	USE(I,J)=0.
173	VSE(I,J)=0.
174	VKSE(I,J)=0.
175	ENDDO
176	ENDDO
177	!
178	!-----------------------------------------------------------------------
179	!***
180	!*** DIFFUSING Q2 AT GROUND LEVEL DOES NOT MATTER
181	!*** BECAUSE USTAR2 IS RECALCULATED.
182	!***
183	!-----------------------------------------------------------------------
184	!*** ITERATION LOOP
185	!-----------------------------------------------------------------------
186	!
187	DO 600 KS=1,KSMUD
188	!
189	!-----------------------------------------------------------------------
190	!-----------------------------------------------------------------------
191	!*** MAIN INTEGRATION LOOP
192	!-----------------------------------------------------------------------
193	!-----------------------------------------------------------------------
194	!$omp parallel do &
195	!$omp& private(def1,def2,def3,def4,def_ij,defsk,deftk,hkne_ij,hkse_ij &
196	!$omp& ,i,j,k,q2dif,q2ne,q2se,qdif,qne,qse,slop,sne,sse &
197	!$omp& ,tdif,tne,tse,udif,une,use,vdif,vkne,vkne_ij &
198	!$omp& ,vkse,vkse_ij,vne,vse)
199	!-----------------------------------------------------------------------
200	!
201	main_integration : DO K=KTS,KTE
202
203	DO J=JMS,JME
204	DO I=IMS,IME
205	DEF3D(I,J,K)=0.
206	ENDDO
207	ENDDO
208	!
209	!-----------------------------------------------------------------------
210	!*** SLOPE SWITCHES FOR MOISTURE
211	!-----------------------------------------------------------------------
212	!
213	IF(SIGMA==1)THEN
214	!
215	!-----------------------------------------------------------------------
216	!*** PRESSURE DOMAIN
217	!-----------------------------------------------------------------------
218	!
219	IF(DETA1(K)>0.)THEN
220	DO J=MYJS_P1,MYJE1_P2
221	DO I=MYIS_P1,MYIE1_P1
222	SNE(I,J)=1.
223	ENDDO
224	ENDDO
225	!
226	DO J=MYJS1_P1,MYJE_P2
227	DO I=MYIS_P1,MYIE1_P1
228	SSE(I,J)=1.
229	ENDDO
230	ENDDO
231	!
232	!-----------------------------------------------------------------------
233	!*** SIGMA DOMAIN
234	!-----------------------------------------------------------------------
235	!
236	ELSE
237	DO J=MYJS_P1,MYJE1_P1
238	DO I=MYIS_P1,MYIE1_P1
239	SLOP=ABS((Z(I+IHE(J),J+1,K)-Z(I,J,K))*RDY)
240	!
241	CILINE=((SM(I+IHE(J),J+1)/=SM(I,J)).OR. &
242	(SICE(I+IHE(J),J+1)/=SICE(I,J)))
243	!
244	WATSLOP=(SM(I+IHE(J),J+1)==1.0.AND. &
245	SM(I,J)==1.0.AND.SLOP/=0.)
246	!
247	IF(SLOP<SLOPHC.OR.CILINE.OR.WATSLOP)THEN
248	SNE(I,J)=1.
249	ELSE
250	SNE(I,J)=0.
251	ENDIF
252	ENDDO
253	ENDDO
254	!
255	DO J=MYJS1_P1,MYJE_P1
256	DO I=MYIS_P1,MYIE1_P1
257	SLOP=ABS((Z(I+IHE(J),J-1,K)-Z(I,J,K))*RDY)
258	!
259	CILINE=((SM(I+IHE(J),J-1)/=SM(I,J)).OR. &
260	(SICE(I+IHE(J),J-1)/=SICE(I,J)))
261	!
262	WATSLOP=(SM(I+IHE(J),J-1)==1.0.AND. &
263	SM(I,J)==1.0.AND.SLOP/=0.)
264	!
265	IF(SLOP<SLOPHC.OR.CILINE.OR.WATSLOP)THEN
266	SSE(I,J)=1.
267	ELSE
268	SSE(I,J)=0.
269	ENDIF
270	ENDDO
271	ENDDO
272	ENDIF
273	!
274	ENDIF
275	!-----------------------------------------------------------------------
276	!*** DEFORMATIONS
277	!-----------------------------------------------------------------------
278	!
279	DO J=MYJS_P1,MYJE_P1
280	DO I=MYIS_P1,MYIE_P1
281	!
282	DEFTK=U(I+IHE(J),J,K)-U(I+IHW(J),J,K) &
283	& -V(I,J+1,K)+V(I,J-1,K)
284	DEFSK=U(I,J+1,K)-U(I,J-1,K) &
285	& +V(I+IHE(J),J,K)-V(I+IHW(J),J,K)
286	DEF1=(W(I+IHW(J),J-1,K)-W(I,J,K))*0.5
287	DEF2=(W(I+IHE(J),J-1,K)-W(I,J,K))*0.5
288	DEF3=(W(I+IHW(J),J+1,K)-W(I,J,K))*0.5
289	DEF4=(W(I+IHE(J),J+1,K)-W(I,J,K))*0.5
290	Q2L=Q2(I,J,K)
291	IF(Q2L<=EPSQ2)Q2L=0.
292	IF ( CONFIG_FLAGS%BL_PBL_PHYSICS == MYJPBLSCHEME) then
293	DEF_IJ=DEFTKDEFTK+DEFSKDEFSK+DEF1DEF1+DEF2DEF2 &
294	& +DEF3DEF3+DEF4DEF4+SCQ2*Q2L
295	else
296	DEF_IJ=DEFTKDEFTK+DEFSKDEFSK+DEF1DEF1+DEF2DEF2 &
297	& +DEF3DEF3+DEF4DEF4
298	ENDIF
299
300	DEF_IJ=SQRT(DEF_IJ+DEF_IJ)*HBM2(I,J)
301	DEF_IJ=MAX(DEF_IJ,DEFC)
302	DEF_IJ=MIN(DEF_IJ,DEFM)
303	DEF_IJ=DEF_IJ*0.1
304	DEF(I,J)=DEF_IJ
305	DEF3D(I,J,K)=DEF_IJ
306	ENDDO
307	ENDDO
308	!
309	!-----------------------------------------------------------------------
310	!*** DIAGONAL CONTRIBUTIONS
311	!-----------------------------------------------------------------------
312	!
313	DO J=MYJS_P1,MYJE1_P1
314	DO I=MYIS_P1,MYIE1_P1
315	HKNE_IJ=(DEF(I,J)+DEF(I+IHE(J),J+1))*SNE(I,J)
316	TNE (I,J)=(T (I+IHE(J),J+1,K)-T (I,J,K))*HKNE_IJ
317	QNE (I,J)=(Q (I+IHE(J),J+1,K)-Q (I,J,K))*HKNE_IJ
318	Q2NE(I,J)=(Q2(I+IHE(J),J+1,K)-Q2(I,J,K))*HKNE_IJ
319	HKNE(I,J)=HKNE_IJ
320	!
321	VKNE_IJ=DEF(I+IVE(J),J)+DEF(I,J+1)
322	UNE(I,J)=(U(I+IVE(J),J+1,K)-U(I,J,K))*VKNE_IJ
323	VNE(I,J)=(V(I+IVE(J),J+1,K)-V(I,J,K))*VKNE_IJ
324	VKNE(I,J)=VKNE_IJ
325	ENDDO
326	ENDDO
327	!
328	DO J=MYJS1_P1,MYJE_P1
329	DO I=MYIS_P1,MYIE1_P1
330	HKSE_IJ=(DEF(I+IHE(J),J-1)+DEF(I,J))*SSE(I,J)
331	TSE (I,J)=(T (I+IHE(J),J-1,K)-T (I,J,K))*HKSE_IJ
332	QSE (I,J)=(Q (I+IHE(J),J-1,K)-Q (I,J,K))*HKSE_IJ
333	Q2SE(I,J)=(Q2(I+IHE(J),J-1,K)-Q2(I,J,K))*HKSE_IJ
334	HKSE(I,J)=HKSE_IJ
335	!
336	VKSE_IJ=DEF(I,J-1)+DEF(I+IVE(J),J)
337	USE(I,J)=(U(I+IVE(J),J-1,K)-U(I,J,K))*VKSE_IJ
338	VSE(I,J)=(V(I+IVE(J),J-1,K)-V(I,J,K))*VKSE_IJ
339	VKSE(I,J)=VKSE_IJ
340	ENDDO
341	ENDDO
342	!-----------------------------------------------------------------------
343	!
344	DO J=MYJS1,MYJE1
345	DO I=MYIS1,MYIE
346	TDIF (I,J)=(TNE (I,J)-TNE (I+IHW(J),J-1) &
347	& +TSE (I,J)-TSE (I+IHW(J),J+1))*HDAC(I,J)
348	QDIF (I,J)=(QNE (I,J)-QNE (I+IHW(J),J-1) &
349	& +QSE (I,J)-QSE (I+IHW(J),J+1))HDAC(I,J)FCDIF
350	Q2DIF(I,J)=(Q2NE(I,J)-Q2NE(I+IHW(J),J-1) &
351	& +Q2SE(I,J)-Q2SE(I+IHW(J),J+1))*HDAC(I,J)
352	!
353	UDIF(I,J)=(UNE(I,J)-UNE(I+IVW(J),J-1) &
354	& +USE(I,J)-USE(I+IVW(J),J+1))*HDACV(I,J)
355	VDIF(I,J)=(VNE(I,J)-VNE(I+IVW(J),J-1) &
356	& +VSE(I,J)-VSE(I+IVW(J),J+1))*HDACV(I,J)
357	ENDDO
358	ENDDO
359	!
360	!-----------------------------------------------------------------------
361	!*** 2ND ORDER DIFFUSION
362	!-----------------------------------------------------------------------
363	!
364	IF(SECOND)THEN
365	DO J=MYJS2,MYJE2
366	DO I=MYIS1,MYIE1
367	T (I,J,K)=T (I,J,K)+TDIF (I,J)
368	Q (I,J,K)=Q (I,J,K)+QDIF (I,J)
369	!
370	#ifdef HWRF
371	U(I,J,K)=U(I,J,K)+UDIF(I,J)*h_diff
372	V(I,J,K)=V(I,J,K)+VDIF(I,J)*h_diff
373	#else
374	U(I,J,K)=U(I,J,K)+UDIF(I,J)
375	V(I,J,K)=V(I,J,K)+VDIF(I,J)
376	#endif
377	ENDDO
378	ENDDO
379	!
380	!-----------------------------------------------------------------------
381	IF(K>=KTS+1)THEN
382	DO J=MYJS2,MYJE2
383	DO I=MYIS1,MYIE1
384	Q2(I,J,K)=Q2(I,J,K)+Q2DIF(I,J)
385	ENDDO
386	ENDDO
387	ENDIF
388	!
389	!-----------------------------------------------------------------------
390	!*** 4TH ORDER DIAGONAL CONTRIBUTIONS
391	!-----------------------------------------------------------------------
392	!
393	ELSE
394	!
395	DO J=MYJS,MYJE1
396	DO I=MYIS,MYIE1
397	HKNE_IJ=HKNE(I,J)
398	TNE (I,J)=(TDIF (I+IHE(J),J+1)-TDIF (I,J))*HKNE_IJ
399	QNE (I,J)=(QDIF (I+IHE(J),J+1)-QDIF (I,J))*HKNE_IJ
400	Q2NE(I,J)=(Q2DIF(I+IHE(J),J+1)-Q2DIF(I,J))*HKNE_IJ
401	ENDDO
402	ENDDO
403	!
404	DO J=MYJS1,MYJE
405	DO I=MYIS,MYIE1
406	HKSE_IJ=HKSE(I,J)
407	TSE (I,J)=(TDIF (I+IHE(J),J-1)-TDIF (I,J))*HKSE_IJ
408	QSE (I,J)=(QDIF (I+IHE(J),J-1)-QDIF (I,J))*HKSE_IJ
409	Q2SE(I,J)=(Q2DIF(I+IHE(J),J-1)-Q2DIF(I,J))*HKSE_IJ
410	ENDDO
411	ENDDO
412	!
413	DO J=MYJS2,MYJE2
414	DO I=MYIS1,MYIE1
415	T(I,J,K)=T(I,J,K)-(TNE(I,J)-TNE(I+IHW(J),J-1) &
416	& +TSE(I,J)-TSE(I+IHW(J),J+1))*HDAC(I,J)
417	Q(I,J,K)=Q(I,J,K)-(QNE(I,J)-QNE(I+IHW(J),J-1) &
418	& +QSE(I,J)-QSE(I+IHW(J),J+1))*HDAC(I,J) &
419	& *FCDIF
420	ENDDO
421	ENDDO
422
423	!
424	IF(K>=KTS+1)THEN
425	DO J=MYJS2,MYJE2
426	DO I=MYIS1,MYIE1
427	Q2(I,J,K)=Q2(I,J,K)-(Q2NE(I,J)-Q2NE(I+IHW(J),J-1) &
428	& +Q2SE(I,J)-Q2SE(I+IHW(J),J+1)) &
429	& *HDAC(I,J)
430	ENDDO
431	ENDDO
432	ENDIF
433	!
434	!-----------------------------------------------------------------------
435	!
436	DO J=MYJS,MYJE1
437	DO I=MYIS,MYIE1
438	UNE(I,J)=(UDIF(I+IVE(J),J+1)-UDIF(I,J))*VKNE(I,J)
439	VNE(I,J)=(VDIF(I+IVE(J),J+1)-VDIF(I,J))*VKNE(I,J)
440	ENDDO
441	ENDDO
442	!
443	DO J=MYJS1,MYJE
444	DO I=MYIS,MYIE1
445	USE(I,J)=(UDIF(I+IVE(J),J-1)-UDIF(I,J))*VKSE(I,J)
446	VSE(I,J)=(VDIF(I+IVE(J),J-1)-VDIF(I,J))*VKSE(I,J)
447	ENDDO
448	ENDDO
449	!
450	DO J=MYJS2,MYJE2
451	DO I=MYIS1,MYIE1
452	#ifdef HWRF
453	U(I,J,K)=U(I,J,K)-(UNE(I,J)-UNE(I+IVW(J),J-1) &
454	& +USE(I,J)-USE(I+IVW(J),J+1))HDACV(I,J)h_diff
455	V(I,J,K)=V(I,J,K)-(VNE(I,J)-VNE(I+IVW(J),J-1) &
456	& +VSE(I,J)-VSE(I+IVW(J),J+1))HDACV(I,J)h_diff
457	#else
458	U(I,J,K)=U(I,J,K)-(UNE(I,J)-UNE(I+IVW(J),J-1) &
459	& +USE(I,J)-USE(I+IVW(J),J+1))*HDACV(I,J)
460	V(I,J,K)=V(I,J,K)-(VNE(I,J)-VNE(I+IVW(J),J-1) &
461	& +VSE(I,J)-VSE(I+IVW(J),J+1))*HDACV(I,J)
462	#endif
463	ENDDO
464	ENDDO
465	!
466	!-----------------------------------------------------------------------
467	ENDIF ! End 4th order diffusion
468	!-----------------------------------------------------------------------
469	!
470	ENDDO main_integration
471	!
472	!-----------------------------------------------------------------------
473	!
474	600 CONTINUE
475	!
476	!-----------------------------------------------------------------------
477	!
478	END SUBROUTINE HDIFF
479	!
480	!-----------------------------------------------------------------------
481	!
482	END MODULE MODULE_DIFFUSION_NMM
483	!
484	!-----------------------------------------------------------------------

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

Download in other formats:

Original Format