Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
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

Rev	Line
[2759]	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