wrfv2_fire/dyn_nmm/module_NEST_UTIL.F

   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.05*GI*LAPSR, COEF2=-1./COEF3
 374       REAL, PARAMETER                                       :: TRG=2.0*R_D*GI,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      = TRG*T(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.+D608*Q(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