Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

module_NEST_UTIL.F @ 3026

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

Rev	Line
[2759]	1	!
	2	!NCEP_MESO:MODEL_LAYER: BOUNDARY CONDITION UPDATES
	3	!
	4	!----------------------------------------------------------------------
	5	!
	6	MODULE module_NEST_UTIL
	7	!
	8	!----------------------------------------------------------------------
	9	USE MODULE_MPP
	10	USE MODULE_STATE_DESCRIPTION
	11	USE MODULE_DM
	12	!
	13	!#ifdef DM_PARALLEL
	14	! INCLUDE "mpif.h"
	15	!#endif
	16	!----------------------------------------------------------------------
	17	CONTAINS
	18	!
	19	!*********************************************************************************************
	20	SUBROUTINE NESTBC_PATCH(PD_BXS,PD_BXE,PD_BYS,PD_BYE &
	21	,T_BXS,T_BXE,T_BYS,T_BYE,Q_BXS,Q_BXE,Q_BYS,Q_BYE &
	22	,U_BXS,U_BXE,U_BYS,U_BYE,V_BXS,V_BXE,V_BYS,V_BYE &
	23	,Q2_BXS,Q2_BXE,Q2_BYS,Q2_BYE &
	24	,CWM_BXS,CWM_BXE,CWM_BYS,CWM_BYE &
	25	,PD_BTXS,PD_BTXE,PD_BTYS,PD_BTYE &
	26	,T_BTXS,T_BTXE,T_BTYS,T_BTYE,Q_BTXS,Q_BTXE,Q_BTYS,Q_BTYE &
	27	,U_BTXS,U_BTXE,U_BTYS,U_BTYE,V_BTXS,V_BTXE,V_BTYS,V_BTYE &
	28	,Q2_BTXS,Q2_BTXE,Q2_BTYS,Q2_BTYE &
	29	,CWM_BTXS,CWM_BTXE,CWM_BTYS,CWM_BTYE &
	30	!
	31	,PDTMP_B,TTMP_B, QTMP_B,UTMP_B,VTMP_B,Q2TMP_B,CWMTMP_B &
	32	,PDTMP_BT,TTMP_BT,QTMP_BT,UTMP_BT,VTMP_BT,Q2TMP_BT,CWMTMP_BT &
	33	!
	34	,SPEC_BDY_WIDTH &
	35	,IDS,IDE,JDS,JDE,KDS,KDE &
	36	,IMS,IME,JMS,JME,KMS,KME &
	37	,ITS,ITE,JTS,JTE,KTS,KTE )
	38	!**********************************************************************
	39	!$$$ SUBPROGRAM DOCUMENTATION BLOCK
	40	! . . .
	41	! SUBPROGRAM: PATCH
	42	! PRGRMMR: gopal
	43	!
	44	! ABSTRACT:
	45	! THIS IS JUST A FIX FOR USING NESTED BOUNDARIES IN THE HALO REGION
	46	! PROGRAM HISTORY LOG:
	47	! 09-23-2004 : gopal
	48	!
	49	! USAGE: CALL PATCH FROM SUBROUTINE SOLVE_RUNSTREAM FOR NESTED DOMAIN ONLY
	50	!
	51	! ATTRIBUTES:
	52	! LANGUAGE: FORTRAN 90
	53	! MACHINE : IBM SP
	54	!$$$
	55	!**********************************************************************
	56	!----------------------------------------------------------------------
	57	!
	58	IMPLICIT NONE
	59	!
	60	!----------------------------------------------------------------------
	61	!
	62
	63	INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
	64	,IMS,IME,JMS,JME,KMS,KME &
	65	,ITS,ITE,JTS,JTE,KTS,KTE
	66	INTEGER,INTENT(IN) :: SPEC_BDY_WIDTH
	67	!
	68	!
	69	REAL,DIMENSION(IMS:IME,1,SPEC_BDY_WIDTH) &
	70	,INTENT(INOUT) :: PD_BYS,PD_BYE &
	71	,PD_BTYS,PD_BTYE
	72
	73	REAL,DIMENSION(IMS:IME,KMS:KME,SPEC_BDY_WIDTH) &
	74	,INTENT(INOUT) :: CWM_BYS,CWM_BYE &
	75	,Q_BYS,Q_BYE &
	76	,Q2_BYS,Q2_BYE &
	77	,T_BYS,T_BYE &
	78	,U_BYS,U_BYE &
	79	,V_BYS,V_BYE
	80
	81	REAL,DIMENSION(IMS:IME,KMS:KME,SPEC_BDY_WIDTH) &
	82	,INTENT(INOUT) :: CWM_BTYS,CWM_BTYE &
	83	,Q_BTYS,Q_BTYE &
	84	,Q2_BTYS,Q2_BTYE &
	85	,T_BTYS,T_BTYE &
	86	,U_BTYS,U_BTYE &
	87	,V_BTYS,V_BTYE
	88
	89	!
	90
	91	REAL,DIMENSION(JMS:JME,1,SPEC_BDY_WIDTH) &
	92	,INTENT(INOUT) :: PD_BXS,PD_BXE &
	93	,PD_BTXS,PD_BTXE
	94
	95	REAL,DIMENSION(JMS:JME,KMS:KME,SPEC_BDY_WIDTH) &
	96	,INTENT(INOUT) :: CWM_BXS,CWM_BXE &
	97	,Q_BXS,Q_BXE &
	98	,Q2_BXS,Q2_BXE &
	99	,T_BXS,T_BXE &
	100	,U_BXS,U_BXE &
	101	,V_BXS,V_BXE
	102
	103	REAL,DIMENSION(JMS:JME,KMS:KME,SPEC_BDY_WIDTH) &
	104	,INTENT(INOUT) :: CWM_BTXS,CWM_BTXE &
	105	,Q_BTXS,Q_BTXE &
	106	,Q2_BTXS,Q2_BTXE &
	107	,T_BTXS,T_BTXE &
	108	,U_BTXS,U_BTXE &
	109	,V_BTXS,V_BTXE
	110
	111	!
	112
	113	REAL,DIMENSION(IMS:IME,JMS:JME) &
	114	,INTENT(IN) :: PDTMP_B,PDTMP_BT
	115
	116	REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME) &
	117	,INTENT(IN) :: CWMTMP_B,CWMTMP_BT &
	118	,QTMP_B,QTMP_BT &
	119	,Q2TMP_B,Q2TMP_BT &
	120	,TTMP_B,TTMP_BT &
	121	,UTMP_B,UTMP_BT &
	122	,VTMP_B,VTMP_BT
	123
	124	!
	125
	126	!----------------------------------------------------------------------
	127	!
	128	!*** LOCAL VARIABLES
	129	!
	130	LOGICAL :: E_BDY,W_BDY,N_BDY,S_BDY
	131	INTEGER :: I,J,K,IBDY,II,JJ,IB,JB,IIM,JJM,BF
	132	!----------------------------------------------------------------------
	133	!**********************************************************************
	134	!----------------------------------------------------------------------
	135	!
	136	W_BDY=(ITS==IDS)
	137	E_BDY=(ITE==IDE)
	138	S_BDY=(JTS==JDS)
	139	N_BDY=(JTE==JDE)
	140
	141	!----------------------------------------------------------------------
	142	!*** WEST AND EAST BOUNDARIES
	143	!----------------------------------------------------------------------
	144	!
	145	!*** USE IBDY=1 FOR WEST; 2 FOR EAST.
	146
	147	! WRITE(0,*)'WESTERN BC FOR PATCH',IDS,MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2)
	148	!
	149
	150	DO IBDY=1,2
	151	!
	152	!*** MAKE SURE THE PROCESSOR HAS THIS BOUNDARY.
	153	!
	154	IF(W_BDY.AND.IBDY.EQ.1)THEN
	155	! BF=P_XSB ! Which boundary (XSB=the boundary where X is at its start)
	156	IB=1 ! Which cell in from boundary
	157	II=1 ! Which cell in the domain
	158
	159	DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2)
	160	IF(MOD(J,2).EQ.1)THEN ! J=3,5,7,9
	161	PD_BXS(J,1,IB) =PDTMP_B(II,J)
	162	PD_BTXS(J,1,IB) =PDTMP_BT(II,J)
	163	ENDIF
	164	ENDDO
	165	!
	166	DO K=KTS,KTE
	167	DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2)
	168	IF(MOD(J,2).EQ.1)THEN ! J=3,5,7,9
	169	T_BXS(J,K,IB) = TTMP_B(II,J,K)
	170	T_BTXS(J,K,IB) = TTMP_BT(II,J,K)
	171	Q_BXS(J,K,IB) = QTMP_B(II,J,K)
	172	Q_BTXS(J,K,IB) = QTMP_BT(II,J,K)
	173	Q2_BXS(J,K,IB) = Q2TMP_B(II,J,K)
	174	Q2_BTXS(J,K,IB) = Q2TMP_BT(II,J,K)
	175	CWM_BXS(J,K,IB) = CWMTMP_B(II,J,K)
	176	CWM_BTXS(J,K,IB) = CWMTMP_BT(II,J,K)
	177	ENDIF
	178	ENDDO
	179	ENDDO
	180
	181	DO K=KTS,KTE
	182	DO J=MAX(JTS-1,JDS+2-1),MIN(JTE+1,JDE-1)
	183	IF(MOD(J,2).EQ.0)THEN ! J=2,4,6,8
	184	U_BXS(J,K,IB) = UTMP_B(II,J,K)
	185	U_BTXS(J,K,IB) = UTMP_BT(II,J,K)
	186	V_BXS(J,K,IB) = VTMP_B(II,J,K)
	187	V_BTXS(J,K,IB) = VTMP_BT(II,J,K)
	188	ENDIF
	189	ENDDO
	190	ENDDO
	191
	192	ELSEIF (E_BDY.AND.IBDY.EQ.2) THEN
	193
	194	! BF=P_XEB ! Which boundary (XEB=the boundary where X is at its end)
	195	IB=1 ! Which cell in from boundary
	196	II=IDE ! Which cell in the domain
	197
	198	DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2)
	199	IF(MOD(J,2).EQ.1)THEN ! J=3,5,7,9
	200	PD_BXE(J,1,IB) =PDTMP_B(II,J)
	201	PD_BTXE(J,1,IB) =PDTMP_BT(II,J)
	202	ENDIF
	203	ENDDO
	204	!
	205	DO K=KTS,KTE
	206	DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2)
	207	IF(MOD(J,2).EQ.1)THEN ! J=3,5,7,9
	208	T_BXE(J,K,IB) = TTMP_B(II,J,K)
	209	T_BTXE(J,K,IB) = TTMP_BT(II,J,K)
	210	Q_BXE(J,K,IB) = QTMP_B(II,J,K)
	211	Q_BTXE(J,K,IB) = QTMP_BT(II,J,K)
	212	Q2_BXE(J,K,IB) = Q2TMP_B(II,J,K)
	213	Q2_BTXE(J,K,IB) = Q2TMP_BT(II,J,K)
	214	CWM_BXE(J,K,IB) = CWMTMP_B(II,J,K)
	215	CWM_BTXE(J,K,IB) = CWMTMP_BT(II,J,K)
	216	ENDIF
	217	ENDDO
	218	ENDDO
	219
	220	DO K=KTS,KTE
	221	DO J=MAX(JTS-1,JDS+2-1),MIN(JTE+1,JDE-1)
	222	IF(MOD(J,2).EQ.0)THEN ! J=2,4,6,8
	223	U_BXE(J,K,IB) = UTMP_B(II,J,K)
	224	U_BTXE(J,K,IB) = UTMP_BT(II,J,K)
	225	V_BXE(J,K,IB) = VTMP_B(II,J,K)
	226	V_BTXE(J,K,IB) = VTMP_BT(II,J,K)
	227	ENDIF
	228	ENDDO
	229	ENDDO
	230
	231	ENDIF
	232	ENDDO
	233	!
	234	!----------------------------------------------------------------------
	235	!*** SOUTH AND NORTH BOUNDARIES
	236	!----------------------------------------------------------------------
	237	!
	238	!*** USE IBDY=1 FOR SOUTH; 2 FOR NORTH
	239	!
	240	DO IBDY=1,2
	241	!
	242	!*** MAKE SURE THE PROCESSOR HAS THIS BOUNDARY.
	243	!
	244	IF(S_BDY.AND.IBDY.EQ.1) THEN
	245	!
	246	! BF=P_YSB ! Which boundary (YSB=the boundary where Y is at its start)
	247	JB=1 ! Which cell in from boundary
	248	JJ=1 ! Which cell in the domain
	249	!
	250	DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
	251	PD_BYS(I,1,JB) = PDTMP_B(I,JJ)
	252	PD_BTYS(I,1,JB)= PDTMP_BT(I,JJ)
	253	ENDDO
	254
	255	!
	256	DO K=KTS,KTE
	257	DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
	258	T_BYS(I,K,JB) = TTMP_B(I,JJ,K)
	259	T_BTYS(I,K,JB) = TTMP_BT(I,JJ,K)
	260	Q_BYS(I,K,JB) = QTMP_B(I,JJ,K)
	261	Q_BTYS(I,K,JB) = QTMP_BT(I,JJ,K)
	262	Q2_BYS(I,K,JB) = Q2TMP_B(I,JJ,K)
	263	Q2_BTYS(I,K,JB) = Q2TMP_BT(I,JJ,K)
	264	CWM_BYS(I,K,JB) = CWMTMP_B(I,JJ,K)
	265	CWM_BTYS(I,K,JB)= CWMTMP_BT(I,JJ,K)
	266	ENDDO
	267	ENDDO
	268
	269	DO K=KTS,KTE
	270	DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
	271	U_BYS(I,K,JB) = UTMP_B(I,JJ,K)
	272	U_BTYS(I,K,JB) = UTMP_BT(I,JJ,K)
	273	V_BYS(I,K,JB) = VTMP_B(I,JJ,K)
	274	V_BTYS(I,K,JB) = VTMP_BT(I,JJ,K)
	275	ENDDO
	276	ENDDO
	277
	278	ELSEIF (N_BDY.AND.IBDY.EQ.2) THEN
	279	! BF=P_YEB ! Which boundary (YEB=the boundary where Y is at its end)
	280	JB=1 ! Which cell in from boundary
	281	JJ=JDE ! Which cell in the domain
	282
	283	DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
	284	PD_BYE(I,1,JB) = PDTMP_B(I,JJ)
	285	PD_BTYE(I,1,JB)= PDTMP_BT(I,JJ)
	286	ENDDO
	287
	288	!
	289	DO K=KTS,KTE
	290	DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
	291	T_BYE(I,K,JB) = TTMP_B(I,JJ,K)
	292	T_BTYE(I,K,JB) = TTMP_BT(I,JJ,K)
	293	Q_BYE(I,K,JB) = QTMP_B(I,JJ,K)
	294	Q_BTYE(I,K,JB) = QTMP_BT(I,JJ,K)
	295	Q2_BYE(I,K,JB) = Q2TMP_B(I,JJ,K)
	296	Q2_BTYE(I,K,JB) = Q2TMP_BT(I,JJ,K)
	297	CWM_BYE(I,K,JB) = CWMTMP_B(I,JJ,K)
	298	CWM_BTYE(I,K,JB)= CWMTMP_BT(I,JJ,K)
	299	ENDDO
	300	ENDDO
	301
	302	DO K=KTS,KTE
	303	DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
	304	U_BYE(I,K,JB) = UTMP_B(I,JJ,K)
	305	U_BTYE(I,K,JB) = UTMP_BT(I,JJ,K)
	306	V_BYE(I,K,JB) = VTMP_B(I,JJ,K)
	307	V_BTYE(I,K,JB) = VTMP_BT(I,JJ,K)
	308	ENDDO
	309	ENDDO
	310
	311
	312
	313	ENDIF
	314	ENDDO
	315	END SUBROUTINE NESTBC_PATCH
	316
	317	!----------------------------------------------------------------------
	318	!
	319	SUBROUTINE STATS_FOR_MOVE (XLOC,YLOC,PDYN,MSLP,SQWS &
	320	,PINT,T,Q,U,V &
	321	,FIS,PD,SM,PDTOP,PTOP &
	322	,DETA1,DETA2 &
	323	,MOVED,MVNEST,NTSD,NPHS &
	324	,IDS,IDE,JDS,JDE,KDS,KDE &
	325	,IMS,IME,JMS,JME,KMS,KME &
	326	,ITS,ITE,JTS,JTE,KTS,KTE )
	327
	328	!**********************************************************************
	329	!$$$ SUBPROGRAM DOCUMENTATION BLOCK
	330	! . . .
	331	! SUBPROGRAM: STATS_FOR_MOVE
	332	! PRGRMMR: gopal
	333	!
	334	! ABSTRACT:
	335	! THIS ROUTINE COMPUTES SOME STATS REQUIRED FOR AUTOMATIC GRID MOTION
	336	! PROGRAM HISTORY LOG:
	337	! 05-18-2005 : gopal
	338	!
	339	! USAGE: CALL STATS_FOR_MOVE FROM SUBROUTINE SOLVE_RUNSTREAM FOR NESTED DOMAIN ONLY
	340	!
	341	! ATTRIBUTES:
	342	! LANGUAGE: FORTRAN 90
	343	! MACHINE : IBM SP
	344	!$$$
	345	!**********************************************************************
	346
	347	USE MODULE_MODEL_CONSTANTS
	348	USE MODULE_DM
	349
	350	IMPLICIT NONE
	351	!
	352	LOGICAL,EXTERNAL :: wrf_dm_on_monitor
	353	LOGICAL,INTENT(INOUT) :: MVNEST ! NMM SWITCH FOR GRID MOTION
	354	LOGICAL,INTENT(IN) :: MOVED
	355	INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE &
	356	,IMS,IME,JMS,JME,KMS,KME &
	357	,ITS,ITE,JTS,JTE,KTS,KTE &
	358	,NTSD,NPHS
	359	!
	360	INTEGER, INTENT(OUT) :: XLOC,YLOC
	361	REAL, DIMENSION(KMS:KME), INTENT(IN) :: DETA1,DETA2
	362	REAL, INTENT(IN) :: PDTOP,PTOP
	363	REAL, DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: FIS,PD,SM
	364	REAL, DIMENSION(IMS:IME,JMS:JME,KMS:KME), INTENT(IN) :: PINT,T,Q,U,V
	365	REAL, DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: PDYN,MSLP,SQWS
	366	!
	367	! LOCAL
	368
	369	INTEGER,SAVE :: NTIME0
	370	INTEGER :: IM,JM,IP,JP
	371	INTEGER :: I,K,J,XR,YR,DTMOVE,IDUM,JDUM,ITF,JTF
	372	REAL, PARAMETER :: LAPSR=6.5E-3, GI=1./G,D608=0.608
	373	REAL, PARAMETER :: COEF3=287.05GILAPSR, COEF2=-1./COEF3
	374	REAL, PARAMETER :: TRG=2.0R_DGI,LAPSI=1.0/LAPSR
	375	REAL :: DZ,RTOPP,APELP,A,TSFC,STMP0,STMP1
	376	REAL :: SMSUM,SMOUT,XDIFF,YDIFF,PCUT,PGR
	377	REAL :: MINGBL_PDYN,MAXGBL_PDYN,MAXGBL_SQWS
	378	REAL :: MINGBL_MIJ
	379	REAL, DIMENSION(IMS:IME,JMS:JME) :: MIJ
	380	REAL, DIMENSION(IMS:IME,JMS:JME,KMS:KME) :: Z
	381
	382	! EXEC
	383
	384	ITF=MIN(ITE,IDE-1)
	385	JTF=MIN(JTE,JDE-1)
	386
	387	!----------------------------------------------------------------------------------
	388
	389	! KEEP NEST MOTION IN SINK WITH PHYSICS TIME STEPS
	390
	391	IF(MOD(NTSD+1,NPHS)/=0)THEN
	392	MVNEST=.FALSE.
	393	RETURN
	394	ENDIF
	395
	396	WRITE(0,*)'PHYSICS IN SINK',NTSD,NPHS
	397
	398	! DETERMINE THE HEIGHTS ON THE PARENT DOMAIN
	399
	400	DO J = JTS, MIN(JTE,JDE)
	401	DO I = ITS, MIN(ITE,IDE)
	402	Z(I,1,J)=FIS(I,J)*GI
	403	ENDDO
	404	ENDDO
	405	!
	406	DO K = KTS,KTE
	407	DO J = JTS, MIN(JTE,JDE)
	408	DO I = ITS, MIN(ITE,IDE)
	409	APELP = (PINT(I,J,K+1)+PINT(I,J,K))
	410	RTOPP = TRGT(I,J,K)(1.0+Q(I,J,K)*P608)/APELP
	411	DZ = RTOPP(DETA1(K)PDTOP+DETA2(K)*PD(I,J))
	412	Z(I,K+1,J) = Z(I,J,K) + DZ
	413	ENDDO
	414	ENDDO
	415	ENDDO
	416
	417	! DETERMINE THE MEAN SEA LEVEL PRESSURE, THE VERTICALLY AVERAGED WIND
	418	! SPEED AT ABOUT LEVELS 9 10 AND 11 AND THE DYNAMIC PRESSURES DEFINED
	419	! FROM BASIC BERNOULLI's THEOREM
	420
	421	DO J = JTS, MIN(JTE,JDE)
	422	DO I = ITS, MIN(ITE,IDE)
	423	TSFC = T(I,J,1)(1.+D608Q(I,J,1)) + LAPSR(Z(I,J,1)+Z(I,J,2))0.5
	424	A = LAPSR*Z(I,J,1)/TSFC
	425	MSLP(I,J) = PINT(I,J,1)(1-A)*COEF2
	426	SQWS(I,J) = (U(I,J,9)U(I,J,9) + V(I,J,9)V(I,J,9) &
	427	+ U(I,J,10)U(I,J,10) + V(I,J,10)V(I,J,10) &
	428	+ U(I,J,11)U(I,J,11) + V(I,J,11)V(I,J,11))/3.0
	429	PDYN(I,J) = MSLP(I,J) + 1.1*SQWS(I,J)/2.0
	430	ENDDO
	431	ENDDO
	432
	433	! FILTER OUT PDYN AND STORE THAT IN MIJ. THE MAXIMUM VALUE OF MIJ GIVES THE STORM CENTER
	434	! ALSO DO THAT WITHIN A SUB DOMAIN
	435
	436	MAXGBL_PDYN=MAXVAL(PDYN(ITS:ITF,JTS:JTF))
	437	CALL WRF_DM_MAXVAL(MAXGBL_PDYN,IDUM,JDUM)
	438	MINGBL_PDYN=MINVAL(PDYN(ITS:ITF,JTS:JTF))
	439	CALL WRF_DM_MINVAL(MINGBL_PDYN,IDUM,JDUM)
	440	PCUT = 0.5*(MAXGBL_PDYN + MINGBL_PDYN)
	441	!
	442	IM=IDE/2 - IDE/6
	443	IP=IDE/2 + IDE/6
	444	JM=JDE/2 - JDE/4
	445	JP=JDE/2 + JDE/4
	446	!
	447	DO J = JTS, MIN(JTE,JDE)
	448	DO I = ITS, MIN(ITE,IDE)
	449	IF(I .GE. IM .AND. I .LE. IP .AND. J .GE. JM .AND. J .LE. JP &
	450	.AND. PCUT .GT. PDYN(I,J))THEN
	451	MIJ(I,J) = PDYN(I,J)
	452	ELSE
	453	MIJ(I,J) = 105000.0
	454	ENDIF
	455	ENDDO
	456	ENDDO
	457
	458	DO J = JTS, MIN(JTE,JDE)
	459	DO I = ITS, MIN(ITE,IDE)
	460	PDYN(I,J)=MIJ(I,J)
	461	ENDDO
	462	ENDDO
	463
	464	! DETERMINE THE LOCATION OF CENTER OF THE CIRCULATION DEFINED BY MIJ AND FIND THE CORRESPONDING MSLP
	465
	466	MINGBL_MIJ=MINVAL(MIJ(ITS:ITF,JTS:JTF))
	467	DO J = JTS, MIN(JTE,JDE)
	468	DO I = ITS, MIN(ITE,IDE)
	469	IF(MIJ(I,J) .EQ. MINGBL_MIJ)THEN
	470	XLOC=I
	471	YLOC=J
	472	STMP0=MSLP(I,J)
	473	ENDIF
	474	ENDDO
	475	ENDDO
	476
	477	CALL WRF_DM_MINVAL(MINGBL_MIJ,XLOC,YLOC)
	478	CALL WRF_DM_MINVAL(STMP0,IDUM,JDUM)
	479
	480	! DETERMINE THE MAXIMUM MSLP AT ABOUT 18 GRID POINTS AWAY FROM THE STORM CENTER
	481
	482	DO J = JTS, MIN(JTE,JDE)
	483	DO I = ITS, MIN(ITE,IDE)
	484	IF(I .EQ. XLOC+18)THEN
	485	XR=I
	486	YR=J
	487	STMP1=MSLP(I,J)
	488	ENDIF
	489	ENDDO
	490	ENDDO
	491
	492	CALL WRF_DM_MAXVAL(STMP1,XR,YR)
	493
	494	!
	495	! DETERMINE IF THE ENTIRE NESTED DOMAIN IS OVER LAND (SM=0)
	496	!
	497
	498	SMSUM = 0.0
	499	DO J = JTS, MIN(JTE,JDE)
	500	DO I = ITS, MIN(ITE,IDE)
	501	SMSUM = SMSUM + SM(I,J)
	502	ENDDO
	503	ENDDO
	504
	505	SMOUT=WRF_DM_SUM_REAL(SMSUM)/(IDE*JDE)
	506
	507	! STOP GRID MOTION. AVOID MOVING TOO RAPID GRID MOTION, SAY SOMETHING LIKE EVERY
	508	! OTHER TIME STEP OR SO
	509
	510	PGR=STMP1-STMP0
	511	XDIFF=ABS(XLOC - IDE/2)
	512	YDIFF=ABS(YLOC - JDE/2)
	513	IF(NTSD==0 .OR. MOVED)NTIME0=NTSD
	514	DTMOVE=NTSD-NTIME0 ! TIME INTERVAL SINCE THE PREVIOUS MOVE
	515	!
	516	IF(DTMOVE .LE. 45 .OR. PGR .LE. 200.)THEN
	517	WRITE(0,*)'SUSPEND MOTION: SMALL DTMOVE OR WEAK PGF:','DTMOVE=',DTMOVE,'PGR=',PGR
	518	MVNEST=.FALSE. ! SET STATIC GRID
	519	ELSE IF(STMP0 .GE. STMP1)THEN
	520	WRITE(0,*)'SUSPEND MOTION: THERE IS NO VORTEX IN THE DOMAIN:','STMP0=',STMP0,'STMP1=',STMP1
	521	MVNEST=.FALSE.
	522	ELSE IF(XDIFF .GT. 24 .OR. YDIFF .GT. 24)THEN
	523	WRITE(0,*)'SUSPEND MOTION: LOST VORTEX ','DTMOVE=',DTMOVE,'XDIFF=',XDIFF,'YDIFF=',YDIFF
	524	MVNEST=.FALSE.
	525	ELSE IF(SMOUT .LE. 0.2 .AND. XDIFF .GT. 12 .AND. YDIFF .GT. 12)THEN
	526	WRITE(0,*)'SUSPEND MOTION: VORTEX LOST OVER LAND ','DTMOVE=',DTMOVE,'XDIFF=',XDIFF,'YDIFF=',YDIFF
	527	MVNEST=.FALSE.
	528	ELSE IF(SMOUT .LE. 0.2 .AND. PGR .LE. 400.)THEN
	529	WRITE(0,*)'SUSPEND MOTION: VORTEX WEAK OVER LAND ','SMOUT=',SMOUT,'PGR=',PGR
	530	MVNEST=.FALSE.
	531	ELSE IF(SMOUT .LE. 0.2 .AND. DTMOVE .GE. 1500)THEN
	532	WRITE(0,*)'SUSPEND MOTION: STOP MOTION OVER LAND','SMOUT=',SMOUT,'DTMOVE=',DTMOVE
	533	MVNEST=.FALSE.
	534	ELSE
	535	MVNEST=.TRUE.
	536	ENDIF
	537
	538	RETURN
	539
	540	END SUBROUTINE STATS_FOR_MOVE
	541	!----------------------------------------------------------------------------------
	542
	543	END MODULE module_NEST_UTIL

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

Download in other formats:

Original Format