Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

module_DIFFUSION_NMM.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: 27.6 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	!-----------------------------------------------------------------------
17	!
18	LOGICAL :: SECOND=.TRUE.
19	INTEGER :: KSMUD=1
20	!
21	!-----------------------------------------------------------------------
22	!
23	CONTAINS
24	!
25	!***********************************************************************
26	SUBROUTINE HDIFF(NTSD,DT,FIS,DY,HDAC,HDACV &
27	& ,HTM,HBM2,VTM,DETA1,SIGMA &
28	& ,T,Q,U,V,Q2,Z,W,SM,SICE &
29	& ,IHE,IHW,IVE,IVW,INDX3_WRK &
30	& ,IDS,IDE,JDS,JDE,KDS,KDE &
31	& ,IMS,IME,JMS,JME,KMS,KME &
32	& ,ITS,ITE,JTS,JTE,KTS,KTE)
33	!***********************************************************************
34	!$$$ SUBPROGRAM DOCUMENTATION BLOCK
35	! . . .
36	! SUBPROGRAM: HDIFF HORIZONTAL DIFFUSION
37	! PRGRMMR: JANJIC ORG: W/NP22 DATE: 93-11-17
38	!
39	! ABSTRACT:
40	! HDIFF CALCULATES THE CONTRIBUTION OF THE HORIZONTAL DIFFUSION
41	! TO THE TENDENCIES OF TEMPERATURE, SPECIFIC HUMIDITY, WIND
42	! COMPONENTS, AND TURBULENT KINETIC ENERGY AND THEN UPDATES THOSE
43	! VARIABLES. A SECOND-ORDER NONLINEAR SCHEME SIMILAR TO
44	! SMAGORINSKY'S IS USED WHERE THE DIFFUSION COEFFICIENT IS
45	! A FUNCTION OF THE DEFORMATION FIELD AND OF THE TURBULENT
46	! KINETIC ENERGY.
47	!
48	! PROGRAM HISTORY LOG:
49	! 87-06-?? JANJIC - ORIGINATOR
50	! 95-03-25 BLACK - CONVERSION FROM 1-D TO 2-D IN HORIZONTAL
51	! 96-03-28 BLACK - ADDED EXTERNAL EDGE
52	! 98-10-30 BLACK - MODIFIED FOR DISTRIBUTED MEMORY
53	! 02-02-07 BLACK - CONVERTED TO WRF STRUCTURE
54	! 02-08-29 MICHALAKES -
55	! 02-09-06 WOLFE -
56	! 03-05-27 JANJIC - ADDED SLOPE ADJUSTMENT
57	! 04-11-18 BLACK - THREADED
58	! 06-08-15 JANJIC - ENHANCEMENT AT SLOPING SEA COAST
59	!
60	! USAGE: CALL HDIFF FROM SUBROUTINE SOLVE_RUNSTREAM
61	!
62	! INPUT ARGUMENT LIST:
63	!
64	! OUTPUT ARGUMENT LIST:
65	!
66	! OUTPUT FILES:
67	! NONE
68	!
69	! SUBPROGRAMS CALLED:
70	!
71	! UNIQUE: NONE
72	!
73	! LIBRARY: NONE
74	!
75	! ATTRIBUTES:
76	! LANGUAGE: FORTRAN 90
77	! MACHINE : IBM SP
78	!$$$
79	!***********************************************************************
80	!-----------------------------------------------------------------------
81	!
82	IMPLICIT NONE
83	!
84	!-----------------------------------------------------------------------
85	!
86	INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
87	& ,IMS,IME,JMS,JME,KMS,KME &
88	& ,ITS,ITE,JTS,JTE,KTS,KTE
89	!
90	INTEGER,INTENT(IN) :: NTSD
91	!
92	REAL,INTENT(IN) :: DT,DY
93	!
94	REAL,DIMENSION(KMS:KME),INTENT(IN) :: DETA1
95	!
96	REAL,DIMENSION(IMS:IME,JMS:JME),INTENT(IN) :: FIS,HBM2 &
97	& ,HDAC,HDACV &
98	& ,SM,SICE
99	!
100	REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(IN) :: HTM,VTM,Z,W
101	!
102	REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME),INTENT(INOUT) :: T,Q,Q2 &
103	& ,U,V
104	!
105	INTEGER, DIMENSION(JMS:JME), INTENT(IN) :: IHE,IHW,IVE,IVW
106	!
107	!-----------------------------------------------------------------------
108	!!!!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
109	!*** NMM_MAX_DIM is set in configure.wrf and must agree with
110	!*** the value of dimspec q in the Registry/Registry.
111	!!!!!!!!!!!!!!!!!!!!!!!!!!!! IMPORTANT !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
112	!-----------------------------------------------------------------------
113	!
114	INTEGER,DIMENSION(-3:3,NMM_MAX_DIM,0:6),INTENT(IN) :: INDX3_WRK
115	!
116	INTEGER,INTENT(IN) :: SIGMA
117	!
118	!-----------------------------------------------------------------------
119	!
120	!*** LOCAL VARIABLES
121	!
122	LOGICAL :: CILINE,WATSLOP
123	!
124	INTEGER :: I,J,J1_P1,J1_P2,J2_00,J2_M1,J2_P1,J3_00,J3_P1,J3_P2 &
125	& ,J4_00,J4_M1,J4_M2,J4_P1,J4_P2,JJ,JKNT,JSTART,K,KS
126	!
127	REAL :: DEF_J,DEFSK,DEFTK,HKNE_J,HKSE_J,Q2L,RDY,SLOP,SLOPHC &
128	& ,UTK,VKNE_J,VKSE_J,VTK,DEF1,DEF2,DEF3,DEF4
129	!
130	REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE) :: Q2L_IK,SNE,SSE
131	!
132	!*** TYPE 1 WORKING ARRAY (SEE PFDHT)
133	!
134	REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,-2:2) :: DEF
135	!
136	!*** TYPE 2 WORKING ARRAY (SEE PFDHT)
137	!
138	REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,-2:1) :: HKNE,QNE,Q2NE,TNE &
139	& ,UNE,VKNE,VNE
140	!
141	!*** TYPE 3 WORKING ARRAY (SEE PFDHT)
142	!
143	REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,-1:2) :: HKSE,QSE,Q2SE,TSE &
144	& ,USE,VKSE,VSE
145	!
146	!*** TYPE 4 WORKING ARRAY (SEE PFDHT)
147	!
148	REAL,DIMENSION(ITS-5:ITE+5,KTS:KTE,-1:1) :: CKE,QDIF,Q2DIF &
149	& ,TDIF,UDIF,VDIF
150	!
151	!-----------------------------------------------------------------------
152	!***********************************************************************
153	!-----------------------------------------------------------------------
154	!
155	JSTART=MYJS2
156	!-----------------------------------------------------------------------
157	!
158	SLOPHC=SLOPHTSQRT(2.)0.5
159	RDY=1./DY
160	!
161	!-----------------------------------------------------------------------
162	!***
163	!*** DIFFUSING Q2 AT GROUND LEVEL DOES NOT MATTER
164	!*** BECAUSE USTAR2 IS RECALCULATED
165	!***
166	!-----------------------------------------------------------------------
167	!*** MARCH NORTHWARD THROUGH THE SOUTHERNMOST SLABS TO BEGIN
168	!*** FILLING THE MAIN WORKING ARRAYS WHICH ARE MULTI-DIMENSIONED
169	!*** IN J BECAUSE THEY ARE DIFFERENCED OR AVERAGED IN J.
170	!-----------------------------------------------------------------------
171	!
172	DO J=-2,2
173	DO K=KTS,KTE
174	DO I=ITS-5,ITE+5
175	DEF(I,K,J)=0.
176	ENDDO
177	ENDDO
178	ENDDO
179	!
180	DO J=-2,1
181	DO K=KTS,KTE
182	DO I=ITS-5,ITE+5
183	TNE(I,K,J)=0.
184	QNE(I,K,J)=0.
185	Q2NE(I,K,J)=0.
186	HKNE(I,K,J)=0.
187	UNE(I,K,J)=0.
188	VNE(I,K,J)=0.
189	VKNE(I,K,J)=0.
190	ENDDO
191	ENDDO
192	ENDDO
193	!
194	DO J=-1,2
195	DO K=KTS,KTE
196	DO I=ITS-5,ITE+5
197	TSE(I,K,J)=0.
198	QSE(I,K,J)=0.
199	Q2SE(I,K,J)=0.
200	HKSE(I,K,J)=0.
201	USE(I,K,J)=0.
202	VSE(I,K,J)=0.
203	VKSE(I,K,J)=0.
204	ENDDO
205	ENDDO
206	ENDDO
207	!-----------------------------------------------------------------------
208	!
209	!$omp parallel do &
210	!$omp& private(def_j,def1,def2,def3,def4,defsk,deftk,i,j,jj,k,q2l)
211	DO J=-2,1
212	JJ=JSTART+J
213	!
214	DO K=KTS,KTE
215
216	DO I=MYIS_P1,MYIE_P1
217	DEFTK=U(I+IHE(JJ),K,JJ)-U(I+IHW(JJ),K,JJ) &
218	& -V(I,K,JJ+1)+V(I,K,JJ-1)
219	DEFSK=U(I,K,JJ+1)-U(I,K,JJ-1) &
220	& +V(I+IHE(JJ),K,JJ)-V(I+IHW(JJ),K,JJ)
221	Q2L=MAX(Q2(I,K,JJ),EPSQ2)
222	IF(Q2L<=EPSQ2)Q2L=0.
223	!
224	DEF1=W(I+IHW(JJ),K,JJ-1)-W(I,K,JJ)
225	DEF2=W(I+IHE(JJ),K,JJ-1)-W(I,K,JJ)
226	DEF3=W(I+IHW(JJ),K,JJ+1)-W(I,K,JJ)
227	DEF4=W(I+IHE(JJ),K,JJ+1)-W(I,K,JJ)
228	!
229	DEF_J=DEFTKDEFTK+DEFSKDEFSK+DEF1DEF1+DEF2DEF2+ &
230	& DEF3DEF3+DEF4DEF4+SCQ2*Q2L
231	DEF_J=SQRT(DEF_J+DEF_J)*HBM2(I,JJ)
232	DEF_J=MAX(DEF_J,DEFC)
233	DEF_J=MIN(DEF_J,DEFM)
234	DEF_J=DEF_J*0.1
235	DEF(I,K,J)=DEF_J
236	ENDDO
237	ENDDO
238	!
239	ENDDO
240	!-----------------------------------------------------------------------
241	!
242	!$omp parallel do &
243	!$omp& private(hkne_j,i,j,jj,k,slop,sne,vkne_j)
244	DO J=-2,0
245	JJ=JSTART+J
246	!
247	!-----------------------------------------------------------------------
248	!*** SLOPE SWITCHES FOR MOISTURE
249	!-----------------------------------------------------------------------
250	!
251	IF(SIGMA==1)THEN
252	DO K=KTS,KTE
253	!
254	!-----------------------------------------------------------------------
255	!*** PRESSURE DOMAIN
256	!-----------------------------------------------------------------------
257	!
258	IF(DETA1(K)>0.)THEN
259	DO I=MYIS_P1,MYIE1_P1
260	SNE(I,K)=1.
261	ENDDO
262	!
263	!-----------------------------------------------------------------------
264	!*** SIGMA DOMAIN
265	!-----------------------------------------------------------------------
266	!
267	ELSE
268	DO I=MYIS_P1,MYIE1_P1
269	SLOP=ABS((Z(I+IHE(JJ),K,JJ+1)-Z(I,K,JJ))*RDY)
270	!
271	CILINE=((SM(I+IHE(JJ),JJ+1)/=SM(I,JJ)) .OR. &
272	(SICE(I+IHE(JJ),JJ+1)/=SICE(I,JJ)))
273	!
274	WATSLOP=(SM(I+IHE(JJ),JJ+1)==1.0 .AND. &
275	SM(I,JJ)==1.0 .AND. SLOP/=0.)
276	!
277	IF(SLOP<SLOPHC .OR. CILINE .OR. WATSLOP)THEN
278	SNE(I,K)=1.
279	ELSE
280	SNE(I,K)=0.
281	ENDIF
282	!
283	ENDDO
284	ENDIF
285	!
286	ENDDO
287	ENDIF
288	!
289	DO K=KTS,KTE
290	DO I=MYIS_P1,MYIE1_P1
291	HKNE_J=(DEF(I,K,J)+DEF(I+IHE(JJ),K,J+1)) &
292	& HTM(I,K,JJ)HTM(I+IHE(JJ),K,JJ+1)*SNE(I,K)
293	TNE (I,K,J)=(T (I+IHE(JJ),K,JJ+1)-T (I,K,JJ))*HKNE_J
294	QNE (I,K,J)=(Q (I+IHE(JJ),K,JJ+1)-Q (I,K,JJ))*HKNE_J
295	Q2NE(I,K,J)=(Q2(I+IHE(JJ),K,JJ+1)-Q2(I,K,JJ))*HKNE_J
296	HKNE(I,K,J)=HKNE_J
297	!
298	VKNE_J=(DEF(I+IVE(JJ),K,J)+DEF(I,K,J+1)) &
299	& VTM(I,K,JJ)VTM(I+IVE(JJ),K,JJ+1)
300	UNE(I,K,J)=(U(I+IVE(JJ),K,JJ+1)-U(I,K,JJ))*VKNE_J
301	VNE(I,K,J)=(V(I+IVE(JJ),K,JJ+1)-V(I,K,JJ))*VKNE_J
302	VKNE(I,K,J)=VKNE_J
303	ENDDO
304	ENDDO
305	!
306	ENDDO
307	!-----------------------------------------------------------------------
308	!
309	!$omp parallel do &
310	!$omp& private(hkse_j,i,j,jj,k,slop,sse,vkse_j)
311	DO J=-1,1
312	JJ=JSTART+J
313	!
314	!-----------------------------------------------------------------------
315	!*** SLOPE SWITCHES FOR MOISTURE
316	!-----------------------------------------------------------------------
317	!
318	IF(SIGMA==1)THEN
319	DO K=KTS,KTE
320	!
321	!-----------------------------------------------------------------------
322	!*** PRESSURE DOMAIN
323	!-----------------------------------------------------------------------
324	!
325	IF(DETA1(K)>0.)THEN
326	DO I=MYIS_P1,MYIE1_P1
327	SSE(I,K)=1.
328	ENDDO
329	!
330	!-----------------------------------------------------------------------
331	!*** SIGMA DOMAIN
332	!-----------------------------------------------------------------------
333	!
334	ELSE
335	DO I=MYIS_P1,MYIE1_P1
336	SLOP=ABS((Z(I+IHE(JJ),K,JJ-1)-Z(I,K,JJ))*RDY)
337	!
338	CILINE=((SM(I+IHE(JJ),JJ-1)/=SM(I,JJ)) .OR. &
339	(SICE(I+IHE(JJ),JJ-1)/=SICE(I,JJ)))
340	!
341	WATSLOP=(SM(I+IHE(JJ),JJ-1)==1.0 .AND. &
342	SM(I,JJ)==1.0 .AND. SLOP/=0.)
343	!
344	IF(SLOP<SLOPHC .OR. CILINE .OR. WATSLOP)THEN
345	SSE(I,K)=1.
346	ELSE
347	SSE(I,K)=0.
348	ENDIF
349	ENDDO
350	!
351	ENDIF
352	!
353	ENDDO
354	ENDIF
355	!
356	DO K=KTS,KTE
357	DO I=MYIS_P1,MYIE1_P1
358	HKSE_J=(DEF(I+IHE(JJ),K,J-1)+DEF(I,K,J)) &
359	& HTM(I+IHE(JJ),K,JJ-1)HTM(I,K,JJ)*SSE(I,K)
360	TSE (I,K,J)=(T (I+IHE(JJ),K,JJ-1)-T (I,K,JJ))*HKSE_J
361	QSE (I,K,J)=(Q (I+IHE(JJ),K,JJ-1)-Q (I,K,JJ))*HKSE_J
362	Q2SE(I,K,J)=(Q2(I+IHE(JJ),K,JJ-1)-Q2(I,K,JJ))*HKSE_J
363	HKSE(I,K,J)=HKSE_J
364	!
365	VKSE_J=(DEF(I,K,J-1)+DEF(I+IVE(JJ),K,J)) &
366	& VTM(I+IVE(JJ),K,JJ-1)VTM(I,K,JJ)
367	USE(I,K,J)=(U(I+IVE(JJ),K,JJ-1)-U(I,K,JJ))*VKSE_J
368	VSE(I,K,J)=(V(I+IVE(JJ),K,JJ-1)-V(I,K,JJ))*VKSE_J
369	VKSE(I,K,J)=VKSE_J
370	ENDDO
371	ENDDO
372	!
373	ENDDO
374	!-----------------------------------------------------------------------
375	!
376	!$omp parallel do &
377	!$omp& private(i,j,jj,k)
378	DO J=-1,0
379	JJ=JSTART+J
380	!
381	DO K=KTS,KTE
382	DO I=MYIS1_P1,MYIE1
383	TDIF (I,K,J)=(TNE (I,K,J)-TNE (I+IHW(JJ),K,J-1) &
384	& +TSE (I,K,J)-TSE (I+IHW(JJ),K,J+1)) &
385	& *HDAC(I,JJ)
386	QDIF (I,K,J)=(QNE (I,K,J)-QNE (I+IHW(JJ),K,J-1) &
387	& +QSE (I,K,J)-QSE (I+IHW(JJ),K,J+1)) &
388	& HDAC(I,JJ)FCDIF
389	Q2DIF(I,K,J)=(Q2NE(I,K,J)-Q2NE(I+IHW(JJ),K,J-1) &
390	& +Q2SE(I,K,J)-Q2SE(I+IHW(JJ),K,J+1)) &
391	& *HDAC(I,JJ)
392	!
393	UDIF (I,K,J)=(UNE (I,K,J)-UNE (I+IVW(JJ),K,J-1) &
394	& +USE (I,K,J)-USE (I+IVW(JJ),K,J+1)) &
395	& *HDACV(I,JJ)
396	VDIF (I,K,J)=(VNE (I,K,J)-VNE (I+IVW(JJ),K,J-1) &
397	& +VSE (I,K,J)-VSE (I+IVW(JJ),K,J+1)) &
398	& *HDACV(I,JJ)
399	ENDDO
400	ENDDO
401	!
402	ENDDO
403	!
404	!-----------------------------------------------------------------------
405	!*** ITERATION LOOP
406	!-----------------------------------------------------------------------
407	!
408	DO 600 KS=1,KSMUD
409
410	!
411	JKNT=0
412
413	!-----------------------------------------------------------------------
414	!-----------------------------------------------------------------------
415	!*** MAIN VERTICAL INTEGRATION LOOP
416	!-----------------------------------------------------------------------
417	!-----------------------------------------------------------------------
418	main_integration : DO J=MYJS2,MYJE2
419	!-----------------------------------------------------------------------
420	!
421	!***
422	!*** SET THE 3RD INDEX IN THE WORKING ARRAYS (SEE SUBROUTINE INIT
423	!*** AND DIAGRAMS IN PFDHT)
424	!***
425	!*** J[TYPE]_NN WHERE "TYPE" IS THE WORKING ARRAY TYPE SEEN IN THE
426	!*** LOCAL DECLARATION ABOVE (DEPENDENT UPON THE J EXTENT) AND
427	!*** NN IS THE NUMBER OF ROWS NORTH OF THE CENTRAL ROW WHOSE J IS
428	!*** THE CURRENT VALUE OF THE main_integration LOOP.
429	!*** (P2 denotes +2, etc.)
430	!***
431	JKNT=JKNT+1
432	!
433	J1_P2=INDX3_WRK(2,JKNT,1)
434	J1_P1=INDX3_WRK(1,JKNT,1)
435	!
436	J2_P1=INDX3_WRK(1,JKNT,2)
437	J2_00=INDX3_WRK(0,JKNT,2)
438	J2_M1=INDX3_WRK(-1,JKNT,2)
439	!
440	J3_P2=INDX3_WRK(2,JKNT,3)
441	J3_P1=INDX3_WRK(1,JKNT,3)
442	J3_00=INDX3_WRK(0,JKNT,3)
443	!
444	J4_P2=INDX3_WRK(2,JKNT,4)
445	J4_P1=INDX3_WRK(1,JKNT,4)
446	J4_00=INDX3_WRK(0,JKNT,4)
447	J4_M1=INDX3_WRK(-1,JKNT,4)
448	!
449	!-----------------------------------------------------------------------
450	!*** SLOPE SWITCHES FOR MOISTURE
451	!-----------------------------------------------------------------------
452	IF(SIGMA==1)THEN
453	!
454	!$omp parallel do &
455	!$omp& private(i,k,slop)
456	DO K=KTS,KTE
457	!
458	!-----------------------------------------------------------------------
459	!*** PRESSURE DOMAIN
460	!-----------------------------------------------------------------------
461	!
462	IF(DETA1(K)>0.)THEN
463	DO I=MYIS_P1,MYIE1_P1
464	SNE(I,K)=1.
465	SSE(I,K)=1.
466	ENDDO
467	!
468	!-----------------------------------------------------------------------
469	!*** SIGMA DOMAIN
470	!-----------------------------------------------------------------------
471	!
472	ELSE
473	DO I=MYIS_P1,MYIE1_P1
474	SLOP=ABS((Z(I+IHE(J+1),K,J+2)-Z(I,K,J+1))*RDY)
475	!
476	CILINE=((SM(I+IHE(J+1),J+2)/=SM(I,J+1)) .OR. &
477	(SICE(I+IHE(J+1),J+2)/=SICE(I,J+1)))
478	!
479	WATSLOP=(SM(I+IHE(J+1),J+2)==1.0 .AND. &
480	SM(I,J+1)==1.0 .AND. SLOP/=0.)
481	!
482	IF(SLOP<SLOPHC .OR. CILINE .OR. WATSLOP)THEN
483	SNE(I,K)=1.
484	ELSE
485	SNE(I,K)=0.
486	ENDIF
487	!
488	SLOP=ABS((Z(I+IHE(J+2),K,J+1)-Z(I,K,J+2))*RDY)
489	!
490	CILINE=((SM(I+IHE(J+2),J+1)/=SM(I,J+2)) .OR. &
491	(SICE(I+IHE(J+2),J+1)/=SICE(I,J+2)))
492	!
493	WATSLOP=(SM(I+IHE(J+2),J+1)==1.0 .AND. &
494	SM(I,J+2)==1.0 .AND. SLOP/=0.)
495
496	IF(SLOP<SLOPHC .OR. CILINE .OR. WATSLOP)THEN
497	SSE(I,K)=1.
498	ELSE
499	SSE(I,K)=0.
500	ENDIF
501	ENDDO
502	ENDIF
503	!
504	ENDDO
505	ENDIF
506	!-----------------------------------------------------------------------
507	!*** DEFORMATIONS
508	!-----------------------------------------------------------------------
509	!
510	!$omp parallel do &
511	!$omp& private(i,k,q2l)
512	DO K=KTS,KTE
513	DO I=MYIS_P1,MYIE_P1
514	Q2L=Q2(I,K,J+2)
515	IF(Q2L<=EPSQ2)Q2L=0.
516	Q2L_IK(I,K)=Q2L
517	ENDDO
518	ENDDO
519	!
520	!$omp parallel do &
521	!$omp& private(def_j,def1,def2,def3,def4,defsk,deftk,i,k,q2l)
522	DO K=KTS,KTE
523	DO I=MYIS_P1,MYIE_P1
524	!
525	DEFTK=U(I+IHE(J+2),K,J+2)-U(I+IHW(J+2),K,J+2) &
526	& -V(I,K,J+3)+V(I,K,J+1)
527	DEFSK=U(I,K,J+3)-U(I,K,J+1) &
528	& +V(I+IHE(J+2),K,J+2)-V(I+IHW(J+2),K,J+2)
529	DEF1=W(I+IHW(J+2),K,J+1)-W(I,K,J+2)
530	DEF2=W(I+IHE(J+2),K,J+1)-W(I,K,J+2)
531	DEF3=W(I+IHW(J+2),K,J+3)-W(I,K,J+2)
532	DEF4=W(I+IHE(J+2),K,J+3)-W(I,K,J+2)
533	DEF_J=DEFTKDEFTK+DEFSKDEFSK+DEF1DEF1+DEF2DEF2 &
534	& +DEF3DEF3+DEF4DEF4+SCQ2*Q2L_IK(I,K)
535	DEF_J=SQRT(DEF_J+DEF_J)*HBM2(I,J+2)
536	DEF_J=MAX(DEF_J,DEFC)
537	DEF_J=MIN(DEF_J,DEFM)
538	DEF_J=DEF_J*0.1
539	DEF(I,K,J1_P2)=DEF_J
540	ENDDO
541	ENDDO
542	!
543	!-----------------------------------------------------------------------
544	!*** DIAGONAL CONTRIBUTIONS
545	!-----------------------------------------------------------------------
546	!
547	!$omp parallel do &
548	!$omp& private(hkne_j,hkse_j,i,k,vkne_j,vkse_j)
549	DO K=KTS,KTE
550	DO I=MYIS_P1,MYIE1_P1
551	HKNE_J=(DEF(I,K,J1_P1)+DEF(I+IHE(J+1),K,J1_P2)) &
552	& HTM(I,K,J+1)HTM(I+IHE(J+1),K,J+2)*SNE(I,K)
553	TNE (I,K,J2_P1)=(T (I+IHE(J+1),K,J+2)-T (I,K,J+1))*HKNE_J
554	QNE (I,K,J2_P1)=(Q (I+IHE(J+1),K,J+2)-Q (I,K,J+1))*HKNE_J
555	Q2NE(I,K,J2_P1)=(Q2(I+IHE(J+1),K,J+2)-Q2(I,K,J+1))*HKNE_J
556	HKNE(I,K,J2_P1)=HKNE_J
557	!
558	VKNE_J=(DEF(I+IVE(J+1),K,J1_P1)+DEF(I,K,J1_P2)) &
559	& VTM(I,K,J+1)VTM(I+IVE(J+1),K,J+2)
560	UNE(I,K,J2_P1)=(U(I+IVE(J+1),K,J+2)-U(I,K,J+1))*VKNE_J
561	VNE(I,K,J2_P1)=(V(I+IVE(J+1),K,J+2)-V(I,K,J+1))*VKNE_J
562	VKNE(I,K,J2_P1)=VKNE_J
563	!
564	HKSE_J=(DEF(I+IHE(J+2),K,J1_P1)+DEF(I,K,J1_P2)) &
565	& HTM(I+IHE(J+2),K,J+1)HTM(I,K,J+2)*SSE(I,K)
566	TSE (I,K,J3_P2)=(T (I+IHE(J+2),K,J+1)-T (I,K,J+2))*HKSE_J
567	QSE (I,K,J3_P2)=(Q (I+IHE(J+2),K,J+1)-Q (I,K,J+2))*HKSE_J
568	Q2SE(I,K,J3_P2)=(Q2(I+IHE(J+2),K,J+1)-Q2(I,K,J+2))*HKSE_J
569	HKSE(I,K,J3_P2)=HKSE_J
570	!
571	VKSE_J=(DEF(I,K,J1_P1)+DEF(I+IVE(J+2),K,J1_P2)) &
572	& VTM(I+IVE(J+2),K,J+1)VTM(I,K,J+2)
573	USE (I,K,J3_P2)=(U (I+IVE(J+2),K,J+1)-U (I,K,J+2))*VKSE_J
574	VSE (I,K,J3_P2)=(V (I+IVE(J+2),K,J+1)-V (I,K,J+2))*VKSE_J
575	VKSE(I,K,J3_P2)=VKSE_J
576	ENDDO
577	ENDDO
578	!-----------------------------------------------------------------------
579	!
580	!$omp parallel do &
581	!$omp& private(i,k)
582	DO K=KTS,KTE
583	DO I=MYIS_P1,MYIE
584	TDIF (I,K,J4_P1)=(TNE (I,K,J2_P1)-TNE (I+IHW(J+1),K,J2_00) &
585	& +TSE (I,K,J3_P1)-TSE (I+IHW(J+1),K,J3_P2)) &
586	& *HDAC(I,J+1)
587	QDIF (I,K,J4_P1)=(QNE (I,K,J2_P1)-QNE (I+IHW(J+1),K,J2_00) &
588	& +QSE (I,K,J3_P1)-QSE (I+IHW(J+1),K,J3_P2)) &
589	& HDAC(I,J+1)FCDIF
590	Q2DIF(I,K,J4_P1)=(Q2NE(I,K,J2_P1)-Q2NE(I+IHW(J+1),K,J2_00) &
591	& +Q2SE(I,K,J3_P1)-Q2SE(I+IHW(J+1),K,J3_P2)) &
592	& *HDAC(I,J+1)
593	!
594	UDIF (I,K,J4_P1)=(UNE (I,K,J2_P1)-UNE (I+IVW(J+1),K,J2_00) &
595	& +USE (I,K,J3_P1)-USE (I+IVW(J+1),K,J3_P2)) &
596	& *HDACV(I,J+1)
597	VDIF (I,K,J4_P1)=(VNE (I,K,J2_P1)-VNE (I+IVW(J+1),K,J2_00) &
598	& +VSE (I,K,J3_P1)-VSE (I+IVW(J+1),K,J3_P2)) &
599	& *HDACV(I,J+1)
600	ENDDO
601	ENDDO
602	!
603	!-----------------------------------------------------------------------
604	!*** 2ND ORDER DIFFUSION
605	!-----------------------------------------------------------------------
606	!
607	IF(SECOND)THEN
608	!$omp parallel do &
609	!$omp& private(i,k)
610	DO K=KTS,KTE
611	DO I=MYIS1,MYIE1
612	T(I,K,J)=T(I,K,J)+TDIF(I,K,J4_00)
613	Q(I,K,J)=Q(I,K,J)+QDIF(I,K,J4_00)
614	!
615	U(I,K,J)=U(I,K,J)+UDIF(I,K,J4_00)
616	V(I,K,J)=V(I,K,J)+VDIF(I,K,J4_00)
617	ENDDO
618	ENDDO
619	!
620	!-----------------------------------------------------------------------
621	!$omp parallel do &
622	!$omp& private(i,k)
623	DO K=KTS+1,KTE
624	DO I=MYIS1,MYIE1
625	Q2(I,K,J)=Q2(I,K,J)+Q2DIF(I,K,J4_00)*HTM(I,K-1,J)
626	ENDDO
627	ENDDO
628	!
629	!-----------------------------------------------------------------------
630	!*** 4TH ORDER DIAGONAL CONTRIBUTIONS
631	!-----------------------------------------------------------------------
632	!
633	ELSE
634	!
635	!$omp parallel do &
636	!$omp& private(hkne_j,hkse_j,i,k,vkne_j,vkse_j)
637	DO K=KTS,KTE
638	DO I=MYIS_P1,MYIE1
639	HKNE_J=HKNE(I,K,J2_00)
640	TNE (I,K,J2_00)=(TDIF (I+IHE(J),K,J4_P1)-TDIF (I,K,J4_00)) &
641	& *HKNE_J
642	QNE (I,K,J2_00)=(QDIF (I+IHE(J),K,J4_P1)-QDIF (I,K,J4_00)) &
643	& *HKNE_J
644	Q2NE(I,K,J2_00)=(Q2DIF(I+IHE(J),K,J4_P1)-Q2DIF(I,K,J4_00)) &
645	& *HKNE_J
646	!
647	VKNE_J=VKNE(I,K,J2_00)
648	UNE (I,K,J2_00)=(UDIF (I+IVE(J),K,J4_P1)-UDIF (I,K,J4_00)) &
649	& *VKNE_J
650	VNE (I,K,J2_00)=(VDIF (I+IVE(J),K,J4_P1)-VDIF (I,K,J4_00)) &
651	& *VKNE_J
652	!
653	HKSE_J=HKSE(I,K,J3_P1)
654	TSE (I,K,J3_P1)=(TDIF (I+IHE(J+1),K,J4_00) &
655	& -TDIF (I ,K,J4_P1))*HKSE_J
656	QSE (I,K,J3_P1)=(QDIF (I+IHE(J+1),K,J4_00) &
657	& -QDIF (I ,K,J4_P1))*HKSE_J
658	Q2SE(I,K,J3_P1)=(Q2DIF(I+IHE(J+1),K,J4_00) &
659	& -Q2DIF(I ,K,J4_P1))*HKSE_J
660
661	!
662	VKSE_J=VKSE(I,K,J3_P1)
663	USE (I,K,J3_P1)=(UDIF (I+IVE(J+1),K,J4_00) &
664	& -UDIF (I ,K,J4_P1))*VKSE_J
665	VSE (I,K,J3_P1)=(VDIF (I+IVE(J+1),K,J4_00) &
666	& -VDIF (I ,K,J4_P1))*VKSE_J
667	ENDDO
668	ENDDO
669	!
670	IF(J==MYJS2)THEN
671	!$omp parallel do &
672	!$omp& private(hkne_j,hkse_j,i,k,vkne_j,vkse_j)
673	DO K=KTS,KTE
674	DO I=MYIS_P1,MYIE1
675	HKNE_J=HKNE(I,K,J2_M1)
676	TNE (I,K,J2_M1)=(TDIF (I+IHE(J-1),K,J4_00) &
677	& -TDIF (I ,K,J4_M1))*HKNE_J
678	QNE (I,K,J2_M1)=(QDIF (I+IHE(J-1),K,J4_00) &
679	& -QDIF (I ,K,J4_M1))*HKNE_J
680	Q2NE(I,K,J2_M1)=(Q2DIF(I+IHE(J-1),K,J4_00) &
681	& -Q2DIF(I ,K,J4_M1))*HKNE_J
682	!
683	VKNE_J=VKNE(I,K,J2_M1)
684	UNE (I,K,J2_M1)=(UDIF (I+IVE(J-1),K,J4_00) &
685	& -UDIF (I ,K,J4_M1))*VKNE_J
686	VNE (I,K,J2_M1)=(VDIF (I+IVE(J-1),K,J4_00) &
687	& -VDIF (I ,K,J4_M1))*VKNE_J
688	!
689	HKSE_J=HKSE(I,K,J3_00)
690	TSE (I,K,J3_00)=(TDIF (I+IHE(J),K,J4_M1) &
691	& -TDIF (I ,K,J4_00))*HKSE_J
692	QSE (I,K,J3_00)=(QDIF (I+IHE(J),K,J4_M1) &
693	& -QDIF (I ,K,J4_00))*HKSE_J
694	Q2SE(I,K,J3_00)=(Q2DIF(I+IHE(J),K,J4_M1) &
695	& -Q2DIF(I ,K,J4_00))*HKSE_J
696
697	!
698	VKSE_J=VKSE(I,K,J3_00)
699	USE (I,K,J3_00)=(UDIF (I+IVE(J),K,J4_M1) &
700	& -UDIF (I ,K,J4_00))*VKSE_J
701	VSE (I,K,J3_00)=(VDIF (I+IVE(J),K,J4_M1) &
702	& -VDIF (I ,K,J4_00))*VKSE_J
703	ENDDO
704	ENDDO
705	ENDIF
706	!
707	IF(J==MYJE2)THEN
708	!
709	DO K=KTS,KTE
710	DO I=MYIS_P1,MYIE1
711	TNE (I,K,J2_P1)=0.
712	QNE (I,K,J2_P1)=0.
713	Q2NE(I,K,J2_P1)=0.
714	UNE (I,K,J2_P1)=0.
715	VNE (I,K,J2_P1)=0.
716	ENDDO
717	ENDDO
718	!
719	ENDIF
720	!
721	!-----------------------------------------------------------------------
722	!
723	!$omp parallel do &
724	!$omp& private(i,k,utk,vtk)
725	DO K=KTS,KTE
726	DO I=MYIS1,MYIE1
727	T(I,K,J)=T(I,K,J)-(TNE (I,K,J2_00)-TNE (I+IHW(J),K,J2_M1) &
728	& +TSE (I,K,J3_00)-TSE (I+IHW(J),K,J3_P1)) &
729	& *HDAC(I,J)
730	Q(I,K,J)=Q(I,K,J)-(QNE (I,K,J2_00)-QNE (I+IHW(J),K,J2_M1) &
731	& +QSE (I,K,J3_00)-QSE (I+IHW(J),K,J3_P1)) &
732	& HDAC(I,J)FCDIF
733	!
734	UTK=U(I,K,J)
735	VTK=V(I,K,J)
736	U(I,K,J)=U(I,K,J)-(UNE (I,K,J2_00)-UNE (I+IVW(J),K,J2_M1) &
737	& +USE (I,K,J3_00)-USE (I+IVW(J),K,J3_P1)) &
738	& *HDACV(I,J)
739	V(I,K,J)=V(I,K,J)-(VNE (I,K,J2_00)-VNE (I+IVW(J),K,J2_M1) &
740	& +VSE (I,K,J3_00)-VSE (I+IVW(J),K,J3_P1)) &
741	& *HDACV(I,J)
742	CKE(I,K,J4_00)=0.5(U(I,K,J)U(I,K,J)-UTK*UTK &
743	& +V(I,K,J)V(I,K,J)-VTKVTK)
744	ENDDO
745	ENDDO
746	!
747	!-----------------------------------------------------------------------
748	!
749	!$omp parallel do &
750	!$omp& private(i,k)
751	DO K=KTS,KTE-1
752	DO I=MYIS1,MYIE1
753	Q2(I,K,J)=Q2(I,K,J)-(Q2NE(I,K,J2_00)-Q2NE(I+IHW(J),K,J2_M1) &
754	& +Q2SE(I,K,J3_00)-Q2SE(I+IHW(J),K,J3_P1)) &
755	& HDAC(I,J)HTM(I,K+1,J)
756	ENDDO
757	ENDDO
758	!
759	!-----------------------------------------------------------------------
760	ENDIF ! End 4th order diffusion
761	!-----------------------------------------------------------------------
762	!
763	ENDDO main_integration
764	!
765	!-----------------------------------------------------------------------
766	!
767	600 CONTINUE
768	!
769	!-----------------------------------------------------------------------
770	END SUBROUTINE HDIFF
771	!-----------------------------------------------------------------------
772	END MODULE MODULE_DIFFUSION_NMM
773	!-----------------------------------------------------------------------

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

Download in other formats:

Original Format