| 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_B,T_B,Q_B,U_B,V_B,Q2_B,CWM_B & |
|---|
| 21 | ,PD_BT,T_BT,Q_BT,U_BT,V_BT,Q2_BT,CWM_BT & |
|---|
| 22 | ,PDTMP_B,TTMP_B,QTMP_B,UTMP_B,VTMP_B,Q2TMP_B,CWMTMP_B & |
|---|
| 23 | ,PDTMP_BT,TTMP_BT,QTMP_BT,UTMP_BT,VTMP_BT,Q2TMP_BT,CWMTMP_BT & |
|---|
| 24 | ,IJDS,IJDE,SPEC_BDY_WIDTH & ! min/max(id,jd) |
|---|
| 25 | ,IDS,IDE,JDS,JDE,KDS,KDE & |
|---|
| 26 | ,IMS,IME,JMS,JME,KMS,KME & |
|---|
| 27 | ,ITS,ITE,JTS,JTE,KTS,KTE ) |
|---|
| 28 | !********************************************************************** |
|---|
| 29 | !$$$ SUBPROGRAM DOCUMENTATION BLOCK |
|---|
| 30 | ! . . . |
|---|
| 31 | ! SUBPROGRAM: PATCH |
|---|
| 32 | ! PRGRMMR: gopal |
|---|
| 33 | ! |
|---|
| 34 | ! ABSTRACT: |
|---|
| 35 | ! THIS IS JUST A FIX FOR USING NESTED BOUNDARIES IN THE HALLO REGION |
|---|
| 36 | ! PROGRAM HISTORY LOG: |
|---|
| 37 | ! 09-23-2004 : gopal |
|---|
| 38 | ! |
|---|
| 39 | ! USAGE: CALL PATCH FROM SUBROUTINE SOLVE_RUNSTREAM FOR NESTED DOMAIN ONLY |
|---|
| 40 | ! |
|---|
| 41 | ! ATTRIBUTES: |
|---|
| 42 | ! LANGUAGE: FORTRAN 90 |
|---|
| 43 | ! MACHINE : IBM SP |
|---|
| 44 | !$$$ |
|---|
| 45 | !********************************************************************** |
|---|
| 46 | !---------------------------------------------------------------------- |
|---|
| 47 | ! |
|---|
| 48 | IMPLICIT NONE |
|---|
| 49 | ! |
|---|
| 50 | !---------------------------------------------------------------------- |
|---|
| 51 | ! |
|---|
| 52 | |
|---|
| 53 | INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE & |
|---|
| 54 | ,IMS,IME,JMS,JME,KMS,KME & |
|---|
| 55 | ,ITS,ITE,JTS,JTE,KTS,KTE |
|---|
| 56 | INTEGER,INTENT(IN) :: IJDS,IJDE,SPEC_BDY_WIDTH |
|---|
| 57 | ! |
|---|
| 58 | ! |
|---|
| 59 | REAL,DIMENSION(IJDS:IJDE,1,SPEC_BDY_WIDTH,4) & |
|---|
| 60 | ,INTENT(INOUT) :: PD_B,PD_BT |
|---|
| 61 | ! |
|---|
| 62 | REAL,DIMENSION(IJDS:IJDE,KMS:KME,SPEC_BDY_WIDTH,4) & |
|---|
| 63 | ,INTENT(INOUT) :: CWM_B,Q_B,Q2_B, & |
|---|
| 64 | T_B,U_B,V_B |
|---|
| 65 | REAL,DIMENSION(IJDS:IJDE,KMS:KME,SPEC_BDY_WIDTH,4) & |
|---|
| 66 | ,INTENT(INOUT) :: CWM_BT,Q_BT,Q2_BT, & |
|---|
| 67 | T_BT,U_BT,V_BT |
|---|
| 68 | |
|---|
| 69 | REAL,DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: PDTMP_B,PDTMP_BT |
|---|
| 70 | |
|---|
| 71 | REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME), & |
|---|
| 72 | INTENT(IN) :: TTMP_B,QTMP_B,UTMP_B, & |
|---|
| 73 | VTMP_B,Q2TMP_B,CWMTMP_B |
|---|
| 74 | |
|---|
| 75 | REAL,DIMENSION(IMS:IME,KMS:KME,JMS:JME), & |
|---|
| 76 | INTENT(IN) :: TTMP_BT,QTMP_BT,UTMP_BT, & |
|---|
| 77 | VTMP_BT,Q2TMP_BT,CWMTMP_BT |
|---|
| 78 | ! |
|---|
| 79 | !---------------------------------------------------------------------- |
|---|
| 80 | ! |
|---|
| 81 | !*** LOCAL VARIABLES |
|---|
| 82 | ! |
|---|
| 83 | LOGICAL :: E_BDY,W_BDY,N_BDY,S_BDY |
|---|
| 84 | INTEGER :: I,J,K,IBDY,II,JJ,IB,JB,IIM,JJM,BF |
|---|
| 85 | !---------------------------------------------------------------------- |
|---|
| 86 | !********************************************************************** |
|---|
| 87 | !---------------------------------------------------------------------- |
|---|
| 88 | ! |
|---|
| 89 | W_BDY=(ITS==IDS) |
|---|
| 90 | E_BDY=(ITE==IDE) |
|---|
| 91 | S_BDY=(JTS==JDS) |
|---|
| 92 | N_BDY=(JTE==JDE) |
|---|
| 93 | |
|---|
| 94 | !---------------------------------------------------------------------- |
|---|
| 95 | !*** WEST AND EAST BOUNDARIES |
|---|
| 96 | !---------------------------------------------------------------------- |
|---|
| 97 | ! |
|---|
| 98 | !*** USE IBDY=1 FOR WEST; 2 FOR EAST. |
|---|
| 99 | |
|---|
| 100 | ! WRITE(0,*)'WESTERN BC FOR PATCH',IDS,MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2) |
|---|
| 101 | ! |
|---|
| 102 | |
|---|
| 103 | DO IBDY=1,2 |
|---|
| 104 | ! |
|---|
| 105 | !*** MAKE SURE THE PROCESSOR HAS THIS BOUNDARY. |
|---|
| 106 | ! |
|---|
| 107 | IF((W_BDY.AND.IBDY.EQ.1).OR.(E_BDY.AND.IBDY.EQ.2))THEN |
|---|
| 108 | IF(IBDY.EQ.1)THEN |
|---|
| 109 | BF=P_XSB ! Which boundary (XSB=the boundary where X is at its start) |
|---|
| 110 | IB=1 ! Which cell in from boundary |
|---|
| 111 | II=1 ! Which cell in the domain |
|---|
| 112 | ELSE |
|---|
| 113 | BF=P_XEB ! Which boundary (XEB=the boundary where X is at its end) |
|---|
| 114 | IB=1 ! Which cell in from boundary |
|---|
| 115 | II=IDE ! Which cell in the domain |
|---|
| 116 | ENDIF |
|---|
| 117 | |
|---|
| 118 | DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2) |
|---|
| 119 | IF(MOD(J,2).EQ.1)THEN ! J=3,5,7,9 |
|---|
| 120 | PD_B(J,1,IB,BF) =PDTMP_B(II,J) |
|---|
| 121 | PD_BT(J,1,IB,BF) =PDTMP_BT(II,J) |
|---|
| 122 | ENDIF |
|---|
| 123 | ENDDO |
|---|
| 124 | |
|---|
| 125 | ! |
|---|
| 126 | DO K=KTS,KTE |
|---|
| 127 | DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2) |
|---|
| 128 | IF(MOD(J,2).EQ.1)THEN ! J=3,5,7,9 |
|---|
| 129 | T_B(J,K,IB,BF) = TTMP_B(II,K,J) |
|---|
| 130 | T_BT(J,K,IB,BF) = TTMP_BT(II,K,J) |
|---|
| 131 | Q_B(J,K,IB,BF) = QTMP_B(II,K,J) |
|---|
| 132 | Q_BT(J,K,IB,BF) = QTMP_BT(II,K,J) |
|---|
| 133 | Q2_B(J,K,IB,BF) = Q2TMP_B(II,K,J) |
|---|
| 134 | Q2_BT(J,K,IB,BF) = Q2TMP_BT(II,K,J) |
|---|
| 135 | CWM_B(J,K,IB,BF) = CWMTMP_B(II,K,J) |
|---|
| 136 | CWM_BT(J,K,IB,BF) = CWMTMP_BT(II,K,J) |
|---|
| 137 | ENDIF |
|---|
| 138 | ENDDO |
|---|
| 139 | ENDDO |
|---|
| 140 | |
|---|
| 141 | DO K=KTS,KTE |
|---|
| 142 | DO J=MAX(JTS-1,JDS+2-1),MIN(JTE+1,JDE-1) |
|---|
| 143 | IF(MOD(J,2).EQ.0)THEN ! J=2,4,6,8 |
|---|
| 144 | U_B(J,K,IB,BF) = UTMP_B(II,K,J) |
|---|
| 145 | U_BT(J,K,IB,BF) = UTMP_BT(II,K,J) |
|---|
| 146 | V_B(J,K,IB,BF) = VTMP_B(II,K,J) |
|---|
| 147 | V_BT(J,K,IB,BF) = VTMP_BT(II,K,J) |
|---|
| 148 | ENDIF |
|---|
| 149 | ENDDO |
|---|
| 150 | ENDDO |
|---|
| 151 | |
|---|
| 152 | ENDIF |
|---|
| 153 | ENDDO |
|---|
| 154 | ! |
|---|
| 155 | !---------------------------------------------------------------------- |
|---|
| 156 | !*** SOUTH AND NORTH BOUNDARIES |
|---|
| 157 | !---------------------------------------------------------------------- |
|---|
| 158 | ! |
|---|
| 159 | !*** USE IBDY=1 FOR SOUTH; 2 FOR NORTH |
|---|
| 160 | ! |
|---|
| 161 | DO IBDY=1,2 |
|---|
| 162 | ! |
|---|
| 163 | !*** MAKE SURE THE PROCESSOR HAS THIS BOUNDARY. |
|---|
| 164 | ! |
|---|
| 165 | IF((S_BDY.AND.IBDY.EQ.1).OR.(N_BDY.AND.IBDY.EQ.2))THEN |
|---|
| 166 | ! |
|---|
| 167 | IF(IBDY.EQ.1)THEN |
|---|
| 168 | BF=P_YSB ! Which boundary (YSB=the boundary where Y is at its start) |
|---|
| 169 | JB=1 ! Which cell in from boundary |
|---|
| 170 | JJ=1 ! Which cell in the domain |
|---|
| 171 | ELSE |
|---|
| 172 | BF=P_YEB ! Which boundary (YEB=the boundary where Y is at its end) |
|---|
| 173 | JB=1 ! Which cell in from boundary |
|---|
| 174 | JJ=JDE ! Which cell in the domain |
|---|
| 175 | ENDIF |
|---|
| 176 | ! |
|---|
| 177 | DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE) |
|---|
| 178 | PD_B(I,1,JB,BF) = PDTMP_B(I,JJ) |
|---|
| 179 | PD_BT(I,1,JB,BF)= PDTMP_BT(I,JJ) |
|---|
| 180 | ENDDO |
|---|
| 181 | |
|---|
| 182 | ! |
|---|
| 183 | DO K=KTS,KTE |
|---|
| 184 | DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE) |
|---|
| 185 | T_B(I,K,JB,BF) = TTMP_B(I,K,JJ) |
|---|
| 186 | T_BT(I,K,JB,BF) = TTMP_BT(I,K,JJ) |
|---|
| 187 | Q_B(I,K,JB,BF) = QTMP_B(I,K,JJ) |
|---|
| 188 | Q_BT(I,K,JB,BF) = QTMP_BT(I,K,JJ) |
|---|
| 189 | Q2_B(I,K,JB,BF) = Q2TMP_B(I,K,JJ) |
|---|
| 190 | Q2_BT(I,K,JB,BF) = Q2TMP_BT(I,K,JJ) |
|---|
| 191 | CWM_B(I,K,JB,BF) = CWMTMP_B(I,K,JJ) |
|---|
| 192 | CWM_BT(I,K,JB,BF)= CWMTMP_BT(I,K,JJ) |
|---|
| 193 | ENDDO |
|---|
| 194 | ENDDO |
|---|
| 195 | |
|---|
| 196 | DO K=KTS,KTE |
|---|
| 197 | DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE) |
|---|
| 198 | U_B(I,K,JB,BF) = UTMP_B(I,K,JJ) |
|---|
| 199 | U_BT(I,K,JB,BF) = UTMP_BT(I,K,JJ) |
|---|
| 200 | V_B(I,K,JB,BF) = VTMP_B(I,K,JJ) |
|---|
| 201 | V_BT(I,K,JB,BF) = VTMP_BT(I,K,JJ) |
|---|
| 202 | ENDDO |
|---|
| 203 | ENDDO |
|---|
| 204 | |
|---|
| 205 | ENDIF |
|---|
| 206 | ENDDO |
|---|
| 207 | END SUBROUTINE NESTBC_PATCH |
|---|
| 208 | |
|---|
| 209 | !---------------------------------------------------------------------- |
|---|
| 210 | ! |
|---|
| 211 | SUBROUTINE STATS_FOR_MOVE (XLOC,YLOC,PDYN,MSLP,SQWS & |
|---|
| 212 | ,PINT,T,Q,U,V & |
|---|
| 213 | ,FIS,PD,SM,PDTOP,PTOP & |
|---|
| 214 | ,DETA1,DETA2 & |
|---|
| 215 | ,MOVED,MVNEST,NTSD,NPHS & |
|---|
| 216 | ,IDS,IDE,JDS,JDE,KDS,KDE & |
|---|
| 217 | ,IMS,IME,JMS,JME,KMS,KME & |
|---|
| 218 | ,ITS,ITE,JTS,JTE,KTS,KTE ) |
|---|
| 219 | |
|---|
| 220 | !********************************************************************** |
|---|
| 221 | !$$$ SUBPROGRAM DOCUMENTATION BLOCK |
|---|
| 222 | ! . . . |
|---|
| 223 | ! SUBPROGRAM: STATS_FOR_MOVE |
|---|
| 224 | ! PRGRMMR: gopal |
|---|
| 225 | ! |
|---|
| 226 | ! ABSTRACT: |
|---|
| 227 | ! THIS ROUTINE COMPUTES SOME STATS REQUIRED FOR AUTOMATIC GRID MOTION |
|---|
| 228 | ! PROGRAM HISTORY LOG: |
|---|
| 229 | ! 05-18-2005 : gopal |
|---|
| 230 | ! |
|---|
| 231 | ! USAGE: CALL STATS_FOR_MOVE FROM SUBROUTINE SOLVE_RUNSTREAM FOR NESTED DOMAIN ONLY |
|---|
| 232 | ! |
|---|
| 233 | ! ATTRIBUTES: |
|---|
| 234 | ! LANGUAGE: FORTRAN 90 |
|---|
| 235 | ! MACHINE : IBM SP |
|---|
| 236 | !$$$ |
|---|
| 237 | !********************************************************************** |
|---|
| 238 | |
|---|
| 239 | USE MODULE_MODEL_CONSTANTS |
|---|
| 240 | USE MODULE_DM |
|---|
| 241 | |
|---|
| 242 | IMPLICIT NONE |
|---|
| 243 | ! |
|---|
| 244 | LOGICAL,EXTERNAL :: wrf_dm_on_monitor |
|---|
| 245 | LOGICAL,INTENT(INOUT) :: MVNEST ! NMM SWITCH FOR GRID MOTION |
|---|
| 246 | LOGICAL,INTENT(IN) :: MOVED |
|---|
| 247 | INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE & |
|---|
| 248 | ,IMS,IME,JMS,JME,KMS,KME & |
|---|
| 249 | ,ITS,ITE,JTS,JTE,KTS,KTE & |
|---|
| 250 | ,NTSD,NPHS |
|---|
| 251 | ! |
|---|
| 252 | INTEGER, INTENT(OUT) :: XLOC,YLOC |
|---|
| 253 | REAL, DIMENSION(KMS:KME), INTENT(IN) :: DETA1,DETA2 |
|---|
| 254 | REAL, INTENT(IN) :: PDTOP,PTOP |
|---|
| 255 | REAL, DIMENSION(IMS:IME,JMS:JME), INTENT(IN) :: FIS,PD,SM |
|---|
| 256 | REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME), INTENT(IN) :: PINT,T,Q,U,V |
|---|
| 257 | REAL, DIMENSION(IMS:IME,JMS:JME), INTENT(OUT) :: PDYN,MSLP,SQWS |
|---|
| 258 | ! |
|---|
| 259 | ! LOCAL |
|---|
| 260 | |
|---|
| 261 | INTEGER,SAVE :: NTIME0 |
|---|
| 262 | INTEGER :: IM,JM,IP,JP |
|---|
| 263 | INTEGER :: I,K,J,XR,YR,DTMOVE,IDUM,JDUM,ITF,JTF |
|---|
| 264 | REAL, PARAMETER :: LAPSR=6.5E-3, GI=1./G,D608=0.608 |
|---|
| 265 | REAL, PARAMETER :: COEF3=287.05*GI*LAPSR, COEF2=-1./COEF3 |
|---|
| 266 | REAL, PARAMETER :: TRG=2.0*R_D*GI,LAPSI=1.0/LAPSR |
|---|
| 267 | REAL :: DZ,RTOPP,APELP,A,TSFC,STMP0,STMP1 |
|---|
| 268 | REAL :: SMSUM,SMOUT,XDIFF,YDIFF,PCUT,PGR |
|---|
| 269 | REAL :: MINGBL_PDYN,MAXGBL_PDYN,MAXGBL_SQWS |
|---|
| 270 | REAL :: MINGBL_MIJ |
|---|
| 271 | REAL, DIMENSION(IMS:IME,JMS:JME) :: MIJ |
|---|
| 272 | REAL, DIMENSION(IMS:IME,KMS:KME,JMS:JME) :: Z |
|---|
| 273 | |
|---|
| 274 | ! EXEC |
|---|
| 275 | |
|---|
| 276 | ITF=MIN(ITE,IDE-1) |
|---|
| 277 | JTF=MIN(JTE,JDE-1) |
|---|
| 278 | |
|---|
| 279 | !---------------------------------------------------------------------------------- |
|---|
| 280 | |
|---|
| 281 | ! KEEP NEST MOTION IN SINK WITH PHYSICS TIME STEPS |
|---|
| 282 | |
|---|
| 283 | IF(MOD(NTSD+1,NPHS)/=0)THEN |
|---|
| 284 | MVNEST=.FALSE. |
|---|
| 285 | RETURN |
|---|
| 286 | ENDIF |
|---|
| 287 | |
|---|
| 288 | WRITE(0,*)'PHYSICS IN SINK',NTSD,NPHS |
|---|
| 289 | |
|---|
| 290 | ! DETERMINE THE HEIGHTS ON THE PARENT DOMAIN |
|---|
| 291 | |
|---|
| 292 | DO J = JTS, MIN(JTE,JDE) |
|---|
| 293 | DO I = ITS, MIN(ITE,IDE) |
|---|
| 294 | Z(I,1,J)=FIS(I,J)*GI |
|---|
| 295 | ENDDO |
|---|
| 296 | ENDDO |
|---|
| 297 | ! |
|---|
| 298 | DO J = JTS, MIN(JTE,JDE) |
|---|
| 299 | DO K = KTS,KTE |
|---|
| 300 | DO I = ITS, MIN(ITE,IDE) |
|---|
| 301 | APELP = (PINT(I,K+1,J)+PINT(I,K,J)) |
|---|
| 302 | RTOPP = TRG*T(I,K,J)*(1.0+Q(I,K,J)*P608)/APELP |
|---|
| 303 | DZ = RTOPP*(DETA1(K)*PDTOP+DETA2(K)*PD(I,J)) |
|---|
| 304 | Z(I,K+1,J) = Z(I,K,J) + DZ |
|---|
| 305 | ENDDO |
|---|
| 306 | ENDDO |
|---|
| 307 | ENDDO |
|---|
| 308 | |
|---|
| 309 | ! DETERMINE THE MEAN SEA LEVEL PRESSURE, THE VERTICALLY AVERAGED WIND |
|---|
| 310 | ! SPEED AT ABOUT LEVELS 9 10 AND 11 AND THE DYNAMIC PRESSURES DEFINED |
|---|
| 311 | ! FROM BASIC BERNOULLI's THEOREM |
|---|
| 312 | |
|---|
| 313 | DO J = JTS, MIN(JTE,JDE) |
|---|
| 314 | DO I = ITS, MIN(ITE,IDE) |
|---|
| 315 | TSFC = T(I,1,J)*(1.+D608*Q(I,1,J)) + LAPSR*(Z(I,1,J)+Z(I,2,J))*0.5 |
|---|
| 316 | A = LAPSR*Z(I,1,J)/TSFC |
|---|
| 317 | MSLP(I,J) = PINT(I,1,J)*(1-A)**COEF2 |
|---|
| 318 | SQWS(I,J) = (U(I,9,J)*U(I,9,J) + V(I,9,J)*V(I,9,J) & |
|---|
| 319 | + U(I,10,J)*U(I,10,J) + V(I,10,J)*V(I,10,J) & |
|---|
| 320 | + U(I,11,J)*U(I,11,J) + V(I,11,J)*V(I,11,J))/3.0 |
|---|
| 321 | PDYN(I,J) = MSLP(I,J) + 1.1*SQWS(I,J)/2.0 |
|---|
| 322 | ENDDO |
|---|
| 323 | ENDDO |
|---|
| 324 | |
|---|
| 325 | ! FILTER OUT PDYN AND STORE THAT IN MIJ. THE MAXIMUM VALUE OF MIJ GIVES THE STORM CENTER |
|---|
| 326 | ! ALSO DO THAT WITHIN A SUB DOMAIN |
|---|
| 327 | |
|---|
| 328 | MAXGBL_PDYN=MAXVAL(PDYN(ITS:ITF,JTS:JTF)) |
|---|
| 329 | CALL WRF_DM_MAXVAL(MAXGBL_PDYN,IDUM,JDUM) |
|---|
| 330 | MINGBL_PDYN=MINVAL(PDYN(ITS:ITF,JTS:JTF)) |
|---|
| 331 | CALL WRF_DM_MINVAL(MINGBL_PDYN,IDUM,JDUM) |
|---|
| 332 | PCUT = 0.5*(MAXGBL_PDYN + MINGBL_PDYN) |
|---|
| 333 | ! |
|---|
| 334 | IM=IDE/2 - IDE/6 |
|---|
| 335 | IP=IDE/2 + IDE/6 |
|---|
| 336 | JM=JDE/2 - JDE/4 |
|---|
| 337 | JP=JDE/2 + JDE/4 |
|---|
| 338 | ! |
|---|
| 339 | DO J = JTS, MIN(JTE,JDE) |
|---|
| 340 | DO I = ITS, MIN(ITE,IDE) |
|---|
| 341 | IF(I .GE. IM .AND. I .LE. IP .AND. J .GE. JM .AND. J .LE. JP & |
|---|
| 342 | .AND. PCUT .GT. PDYN(I,J))THEN |
|---|
| 343 | MIJ(I,J) = PDYN(I,J) |
|---|
| 344 | ELSE |
|---|
| 345 | MIJ(I,J) = 105000. |
|---|
| 346 | ENDIF |
|---|
| 347 | ENDDO |
|---|
| 348 | ENDDO |
|---|
| 349 | |
|---|
| 350 | DO J = JTS, MIN(JTE,JDE) |
|---|
| 351 | DO I = ITS, MIN(ITE,IDE) |
|---|
| 352 | PDYN(I,J)=MIJ(I,J) |
|---|
| 353 | ENDDO |
|---|
| 354 | ENDDO |
|---|
| 355 | |
|---|
| 356 | ! DETERMINE THE LOCATION OF CENTER OF THE CIRCULATION DEFINED BY MIJ AND FIND THE CORRESPONDING MSLP |
|---|
| 357 | |
|---|
| 358 | MINGBL_MIJ=MINVAL(MIJ(ITS:ITF,JTS:JTF)) |
|---|
| 359 | DO J = JTS, MIN(JTE,JDE) |
|---|
| 360 | DO I = ITS, MIN(ITE,IDE) |
|---|
| 361 | IF(MIJ(I,J) .EQ. MINGBL_MIJ)THEN |
|---|
| 362 | XLOC=I |
|---|
| 363 | YLOC=J |
|---|
| 364 | STMP0=MSLP(I,J) |
|---|
| 365 | ENDIF |
|---|
| 366 | ENDDO |
|---|
| 367 | ENDDO |
|---|
| 368 | |
|---|
| 369 | CALL WRF_DM_MINVAL(MINGBL_MIJ,XLOC,YLOC) |
|---|
| 370 | CALL WRF_DM_MINVAL(STMP0,IDUM,JDUM) |
|---|
| 371 | |
|---|
| 372 | ! DETERMINE THE MAXIMUM MSLP AT ABOUT 18 GRID POINTS AWAY FROM THE STORM CENTER |
|---|
| 373 | |
|---|
| 374 | DO J = JTS, MIN(JTE,JDE) |
|---|
| 375 | DO I = ITS, MIN(ITE,IDE) |
|---|
| 376 | IF(I .EQ. XLOC+18)THEN |
|---|
| 377 | XR=I |
|---|
| 378 | YR=J |
|---|
| 379 | STMP1=MSLP(I,J) |
|---|
| 380 | ENDIF |
|---|
| 381 | ENDDO |
|---|
| 382 | ENDDO |
|---|
| 383 | |
|---|
| 384 | CALL WRF_DM_MAXVAL(STMP1,XR,YR) |
|---|
| 385 | |
|---|
| 386 | ! |
|---|
| 387 | ! DETERMINE IF THE ENTIRE NESTED DOMAIN IS OVER LAND (SM=0) |
|---|
| 388 | ! |
|---|
| 389 | |
|---|
| 390 | SMSUM = 0.0 |
|---|
| 391 | DO J = JTS, MIN(JTE,JDE) |
|---|
| 392 | DO I = ITS, MIN(ITE,IDE) |
|---|
| 393 | SMSUM = SMSUM + SM(I,J) |
|---|
| 394 | ENDDO |
|---|
| 395 | ENDDO |
|---|
| 396 | |
|---|
| 397 | SMOUT=WRF_DM_SUM_REAL(SMSUM)/(IDE*JDE) |
|---|
| 398 | |
|---|
| 399 | ! STOP GRID MOTION. AVOID MOVING TOO RAPID GRID MOTION, SAY SOMETHING LIKE EVERY |
|---|
| 400 | ! OTHER TIME STEP OR SO |
|---|
| 401 | |
|---|
| 402 | PGR=STMP1-STMP0 |
|---|
| 403 | XDIFF=ABS(XLOC - IDE/2) |
|---|
| 404 | YDIFF=ABS(YLOC - JDE/2) |
|---|
| 405 | IF(NTSD==0 .OR. MOVED)NTIME0=NTSD |
|---|
| 406 | DTMOVE=NTSD-NTIME0 ! TIME INTERVAL SINCE THE PREVIOUS MOVE |
|---|
| 407 | ! |
|---|
| 408 | IF(DTMOVE .LE. 45 .OR. PGR .LE. 200.)THEN |
|---|
| 409 | WRITE(0,*)'SUSPEND MOTION: SMALL DTMOVE OR WEAK PGF:','DTMOVE=',DTMOVE,'PGR=',PGR |
|---|
| 410 | MVNEST=.FALSE. ! SET STATIC GRID |
|---|
| 411 | ELSE IF(STMP0 .GE. STMP1)THEN |
|---|
| 412 | WRITE(0,*)'SUSPEND MOTION: THERE IS NO VORTEX IN THE DOMAIN:','STMP0=',STMP0,'STMP1=',STMP1 |
|---|
| 413 | MVNEST=.FALSE. |
|---|
| 414 | ELSE IF(XDIFF .GT. 24 .OR. YDIFF .GT. 24)THEN |
|---|
| 415 | WRITE(0,*)'SUSPEND MOTION: LOST VORTEX ','DTMOVE=',DTMOVE,'XDIFF=',XDIFF,'YDIFF=',YDIFF |
|---|
| 416 | MVNEST=.FALSE. |
|---|
| 417 | ELSE IF(SMOUT .LE. 0.2 .AND. XDIFF .GT. 12 .AND. YDIFF .GT. 12)THEN |
|---|
| 418 | WRITE(0,*)'SUSPEND MOTION: VORTEX LOST OVER LAND ','DTMOVE=',DTMOVE,'XDIFF=',XDIFF,'YDIFF=',YDIFF |
|---|
| 419 | MVNEST=.FALSE. |
|---|
| 420 | ELSE IF(SMOUT .LE. 0.2 .AND. PGR .LE. 400.)THEN |
|---|
| 421 | WRITE(0,*)'SUSPEND MOTION: VORTEX WEAK OVER LAND ','SMOUT=',SMOUT,'PGR=',PGR |
|---|
| 422 | MVNEST=.FALSE. |
|---|
| 423 | ELSE IF(SMOUT .LE. 0.2 .AND. DTMOVE .GE. 1500)THEN |
|---|
| 424 | WRITE(0,*)'SUSPEND MOTION: STOP MOTION OVER LAND','SMOUT=',SMOUT,'DTMOVE=',DTMOVE |
|---|
| 425 | MVNEST=.FALSE. |
|---|
| 426 | ELSE |
|---|
| 427 | MVNEST=.TRUE. |
|---|
| 428 | ENDIF |
|---|
| 429 | |
|---|
| 430 | RETURN |
|---|
| 431 | |
|---|
| 432 | END SUBROUTINE STATS_FOR_MOVE |
|---|
| 433 | !---------------------------------------------------------------------------------- |
|---|
| 434 | |
|---|
| 435 | END MODULE module_NEST_UTIL |
|---|
| 436 | |
|---|
