PageRenderTime 53ms CodeModel.GetById 21ms RepoModel.GetById 1ms app.codeStats 0ms

/wrfv2_fire/dyn_nmm/module_NEST_UTIL.F

http://github.com/jbeezley/wrf-fire
FORTRAN Legacy | 729 lines | 457 code | 84 blank | 188 comment | 1 complexity | 371a740adb10afa605eea6b5266221e7 MD5 | raw file
Possible License(s): AGPL-1.0 
    

  1. !
    2. 

  2. !NCEP_MESO:MODEL_LAYER: BOUNDARY CONDITION UPDATES
    3. 

  3. !
    4. 

  4. !----------------------------------------------------------------------
    5. 

  5. !
    6. 

  6.       MODULE module_NEST_UTIL
    7. 

  7. !
    8. 

  8. !----------------------------------------------------------------------
    9. 

  9.       USE MODULE_MPP
    10. 

  10.       USE MODULE_STATE_DESCRIPTION
    11. 

  11.       USE MODULE_DM
    12. 

  12. !
    13. 

  13. !#ifdef DM_PARALLEL
    14. 

  14. !      INCLUDE "mpif.h"
    15. 

  15. !#endif
    16. 

  16. !----------------------------------------------------------------------
    17. 

  17.       CONTAINS
    18. 

  18. !
    19. 

  19. !*********************************************************************************************
    20. 

  20.       SUBROUTINE NESTBC_PATCH(PD_BXS,PD_BXE,PD_BYS,PD_BYE                                 &
    21. 

  21.                              ,T_BXS,T_BXE,T_BYS,T_BYE,Q_BXS,Q_BXE,Q_BYS,Q_BYE             &
    22. 

  22.                              ,U_BXS,U_BXE,U_BYS,U_BYE,V_BXS,V_BXE,V_BYS,V_BYE             &
    23. 

  23.                              ,Q2_BXS,Q2_BXE,Q2_BYS,Q2_BYE                                 &
    24. 

  24.                              ,CWM_BXS,CWM_BXE,CWM_BYS,CWM_BYE                             &
    25. 

  25.                              ,PD_BTXS,PD_BTXE,PD_BTYS,PD_BTYE                             &
    26. 

  26.                              ,T_BTXS,T_BTXE,T_BTYS,T_BTYE,Q_BTXS,Q_BTXE,Q_BTYS,Q_BTYE     &
    27. 

  27.                              ,U_BTXS,U_BTXE,U_BTYS,U_BTYE,V_BTXS,V_BTXE,V_BTYS,V_BTYE     &
    28. 

  28.                              ,Q2_BTXS,Q2_BTXE,Q2_BTYS,Q2_BTYE                             &
    29. 

  29.                              ,CWM_BTXS,CWM_BTXE,CWM_BTYS,CWM_BTYE                         &
    30. 

  30. !
    31. 

  31.                              ,PDTMP_B,TTMP_B, QTMP_B,UTMP_B,VTMP_B,Q2TMP_B,CWMTMP_B       &
    32. 

  32.                              ,PDTMP_BT,TTMP_BT,QTMP_BT,UTMP_BT,VTMP_BT,Q2TMP_BT,CWMTMP_BT &
    33. 

  33. !
    34. 

  34.                              ,SPEC_BDY_WIDTH                                              &  
    35. 

  35.                              ,IDS,IDE,JDS,JDE,KDS,KDE                                     &
    36. 

  36.                              ,IMS,IME,JMS,JME,KMS,KME                                     &
    37. 

  37.                              ,ITS,ITE,JTS,JTE,KTS,KTE                                     )
    38. 

  38. !**********************************************************************
    39. 

  39. !$$$  SUBPROGRAM DOCUMENTATION BLOCK
    40. 

  40. !                .      .    .     
    41. 

  41. ! SUBPROGRAM:    PATCH       
    42. 

  42. !   PRGRMMR: gopal 
    43. 

  43. !     
    44. 

  44. ! ABSTRACT:
    45. 

  45. !         THIS IS JUST A FIX FOR USING NESTED BOUNDARIES IN THE HALO REGION     
    46. 

  46. ! PROGRAM HISTORY LOG:
    47. 

  47. !   09-23-2004  : gopal 
    48. 

  48. !     
    49. 

  49. ! USAGE: CALL PATCH FROM SUBROUTINE SOLVE_RUNSTREAM FOR NESTED DOMAIN ONLY
    50. 

  50. !  
    51. 

  51. ! ATTRIBUTES:
    52. 

  52. !   LANGUAGE: FORTRAN 90
    53. 

  53. !   MACHINE : IBM SP
    54. 

  54. !$$$  
    55. 

  55. !**********************************************************************
    56. 

  56. !----------------------------------------------------------------------
    57. 

  57. !
    58. 

  58.       IMPLICIT NONE
    59. 

  59. !
    60. 

  60. !----------------------------------------------------------------------
    61. 

  61. !
    62. 

  62. 

  63.       INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                    &
    64. 

  64.                            ,IMS,IME,JMS,JME,KMS,KME                    &
    65. 

  65.                            ,ITS,ITE,JTS,JTE,KTS,KTE
    66. 

  66.       INTEGER,INTENT(IN) :: SPEC_BDY_WIDTH
    67. 

  67. !
    68. 

  68. !
    69. 

  69.       REAL,DIMENSION(IMS:IME,1,SPEC_BDY_WIDTH)                     &
    70. 

  70.                                            ,INTENT(INOUT) :: PD_BYS,PD_BYE &
    71. 

  71.                                                           ,PD_BTYS,PD_BTYE
    72. 

  72. 

  73.       REAL,DIMENSION(IMS:IME,KMS:KME,SPEC_BDY_WIDTH)                &
    74. 

  74.                                       ,INTENT(INOUT) :: CWM_BYS,CWM_BYE &
    75. 

  75.                                                        ,Q_BYS,Q_BYE     &
    76. 

  76.                                                        ,Q2_BYS,Q2_BYE   &
    77. 

  77.                                                        ,T_BYS,T_BYE     &
    78. 

  78.                                                        ,U_BYS,U_BYE     &
    79. 

  79.                                                        ,V_BYS,V_BYE     
    80. 

  80. 

  81.       REAL,DIMENSION(IMS:IME,KMS:KME,SPEC_BDY_WIDTH)                &
    82. 

  82.                                       ,INTENT(INOUT) :: CWM_BTYS,CWM_BTYE &
    83. 

  83.                                                        ,Q_BTYS,Q_BTYE     &
    84. 

  84.                                                        ,Q2_BTYS,Q2_BTYE   &
    85. 

  85.                                                        ,T_BTYS,T_BTYE     &
    86. 

  86.                                                        ,U_BTYS,U_BTYE     &
    87. 

  87.                                                        ,V_BTYS,V_BTYE     
    88. 

  88. 

  89. !
    90. 

  90. 

  91.       REAL,DIMENSION(JMS:JME,1,SPEC_BDY_WIDTH)                     &
    92. 

  92.                                            ,INTENT(INOUT) :: PD_BXS,PD_BXE &
    93. 

  93.                                                           ,PD_BTXS,PD_BTXE
    94. 

  94. 

  95.       REAL,DIMENSION(JMS:JME,KMS:KME,SPEC_BDY_WIDTH)                &
    96. 

  96.                                       ,INTENT(INOUT) :: CWM_BXS,CWM_BXE &
    97. 

  97.                                                        ,Q_BXS,Q_BXE     &
    98. 

  98.                                                        ,Q2_BXS,Q2_BXE   &
    99. 

  99.                                                        ,T_BXS,T_BXE     &
    100. 

  100.                                                        ,U_BXS,U_BXE     &
    101. 

  101.                                                        ,V_BXS,V_BXE     
    102. 

  102. 

  103.       REAL,DIMENSION(JMS:JME,KMS:KME,SPEC_BDY_WIDTH)                &
    104. 

  104.                                       ,INTENT(INOUT) :: CWM_BTXS,CWM_BTXE &
    105. 

  105.                                                        ,Q_BTXS,Q_BTXE     &
    106. 

  106.                                                        ,Q2_BTXS,Q2_BTXE   &
    107. 

  107.                                                        ,T_BTXS,T_BTXE     &
    108. 

  108.                                                        ,U_BTXS,U_BTXE     &
    109. 

  109.                                                        ,V_BTXS,V_BTXE     
    110. 

  110. 

  111. !
    112. 

  112. 

  113.       REAL,DIMENSION(IMS:IME,JMS:JME)                     &
    114. 

  114.                                       ,INTENT(IN) :: PDTMP_B,PDTMP_BT
    115. 

  115. 

  116.       REAL,DIMENSION(IMS:IME,JMS:JME,KMS:KME)                     &
    117. 

  117.                                       ,INTENT(IN) :: CWMTMP_B,CWMTMP_BT  &
    118. 

  118.                                                     ,QTMP_B,QTMP_BT     &
    119. 

  119.                                                     ,Q2TMP_B,Q2TMP_BT   &
    120. 

  120.                                                     ,TTMP_B,TTMP_BT     &
    121. 

  121.                                                     ,UTMP_B,UTMP_BT     &
    122. 

  122.                                                     ,VTMP_B,VTMP_BT    
    123. 

  123. 

  124. !
    125. 

  125. 

  126. !----------------------------------------------------------------------
    127. 

  127. !
    128. 

  128. !***  LOCAL VARIABLES
    129. 

  129. !
    130. 

  130.       LOGICAL :: E_BDY,W_BDY,N_BDY,S_BDY
    131. 

  131.       INTEGER :: I,J,K,IBDY,II,JJ,IB,JB,IIM,JJM,BF
    132. 

  132. !----------------------------------------------------------------------
    133. 

  133. !**********************************************************************
    134. 

  134. !----------------------------------------------------------------------
    135. 

  135. !
    136. 

  136.       W_BDY=(ITS==IDS)
    137. 

  137.       E_BDY=(ITE==IDE)
    138. 

  138.       S_BDY=(JTS==JDS)
    139. 

  139.       N_BDY=(JTE==JDE)
    140. 

  140. 

  141. !----------------------------------------------------------------------
    142. 

  142. !***  WEST AND EAST BOUNDARIES
    143. 

  143. !----------------------------------------------------------------------
    144. 

  144. !
    145. 

  145. !***  USE IBDY=1 FOR WEST; 2 FOR EAST.
    146. 

  146. 

  147. !      WRITE(0,*)'WESTERN BC FOR PATCH',IDS,MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2)
    148. 

  148. !
    149. 

  149. 

  150.       DO IBDY=1,2
    151. 

  151. !
    152. 

  152. !***  MAKE SURE THE PROCESSOR HAS THIS BOUNDARY.
    153. 

  153. !
    154. 

  154.         IF(W_BDY.AND.IBDY.EQ.1)THEN
    155. 

  155. !            BF=P_XSB     ! Which boundary (XSB=the boundary where X is at its start)
    156. 

  156.             IB=1         ! Which cell in from boundary
    157. 

  157.             II=1         ! Which cell in the domain
    158. 

  158. 

  159.           DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2)
    160. 

  160.              IF(MOD(J,2).EQ.1)THEN                 ! J=3,5,7,9
    161. 

  161.                 PD_BXS(J,1,IB)  =PDTMP_B(II,J)
    162. 

  162.                 PD_BTXS(J,1,IB) =PDTMP_BT(II,J)
    163. 

  163.              ENDIF
    164. 

  164.           ENDDO
    165. 

  165. !
    166. 

  166.           DO K=KTS,KTE
    167. 

  167.             DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2)
    168. 

  168.               IF(MOD(J,2).EQ.1)THEN                  ! J=3,5,7,9
    169. 

  169.                 T_BXS(J,K,IB)    = TTMP_B(II,J,K)
    170. 

  170.                 T_BTXS(J,K,IB)   = TTMP_BT(II,J,K)
    171. 

  171.                 Q_BXS(J,K,IB)    = QTMP_B(II,J,K)
    172. 

  172.                 Q_BTXS(J,K,IB)   = QTMP_BT(II,J,K)
    173. 

  173.                 Q2_BXS(J,K,IB)   = Q2TMP_B(II,J,K)
    174. 

  174.                 Q2_BTXS(J,K,IB)  = Q2TMP_BT(II,J,K)
    175. 

  175.                 CWM_BXS(J,K,IB)  = CWMTMP_B(II,J,K)
    176. 

  176.                 CWM_BTXS(J,K,IB) = CWMTMP_BT(II,J,K)
    177. 

  177.               ENDIF
    178. 

  178.             ENDDO
    179. 

  179.           ENDDO
    180. 

  180. 

  181.           DO K=KTS,KTE
    182. 

  182.             DO J=MAX(JTS-1,JDS+2-1),MIN(JTE+1,JDE-1)
    183. 

  183.               IF(MOD(J,2).EQ.0)THEN                  ! J=2,4,6,8  
    184. 

  184.                 U_BXS(J,K,IB)    = UTMP_B(II,J,K)
    185. 

  185.                 U_BTXS(J,K,IB)   = UTMP_BT(II,J,K)
    186. 

  186.                 V_BXS(J,K,IB)    = VTMP_B(II,J,K)
    187. 

  187.                 V_BTXS(J,K,IB)   = VTMP_BT(II,J,K)
    188. 

  188.               ENDIF
    189. 

  189.             ENDDO
    190. 

  190.           ENDDO
    191. 

  191. 

  192.         ELSEIF (E_BDY.AND.IBDY.EQ.2) THEN
    193. 

  193. 

  194. !            BF=P_XEB     ! Which boundary (XEB=the boundary where X is at its end)
    195. 

  195.             IB=1         ! Which cell in from boundary
    196. 

  196.             II=IDE       ! Which cell in the domain
    197. 

  197. 

  198.           DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2)
    199. 

  199.              IF(MOD(J,2).EQ.1)THEN                 ! J=3,5,7,9
    200. 

  200.                 PD_BXE(J,1,IB)  =PDTMP_B(II,J)
    201. 

  201.                 PD_BTXE(J,1,IB) =PDTMP_BT(II,J)
    202. 

  202.              ENDIF
    203. 

  203.           ENDDO
    204. 

  204. !
    205. 

  205.           DO K=KTS,KTE
    206. 

  206.             DO J=MAX(JTS-1,JDS+3-1),MIN(JTE+1,JDE-2)
    207. 

  207.               IF(MOD(J,2).EQ.1)THEN                  ! J=3,5,7,9
    208. 

  208.                 T_BXE(J,K,IB)    = TTMP_B(II,J,K)
    209. 

  209.                 T_BTXE(J,K,IB)   = TTMP_BT(II,J,K)
    210. 

  210.                 Q_BXE(J,K,IB)    = QTMP_B(II,J,K)
    211. 

  211.                 Q_BTXE(J,K,IB)   = QTMP_BT(II,J,K)
    212. 

  212.                 Q2_BXE(J,K,IB)   = Q2TMP_B(II,J,K)
    213. 

  213.                 Q2_BTXE(J,K,IB)  = Q2TMP_BT(II,J,K)
    214. 

  214.                 CWM_BXE(J,K,IB)  = CWMTMP_B(II,J,K)
    215. 

  215.                 CWM_BTXE(J,K,IB) = CWMTMP_BT(II,J,K)
    216. 

  216.               ENDIF
    217. 

  217.             ENDDO
    218. 

  218.           ENDDO
    219. 

  219. 

  220.           DO K=KTS,KTE
    221. 

  221.             DO J=MAX(JTS-1,JDS+2-1),MIN(JTE+1,JDE-1)
    222. 

  222.               IF(MOD(J,2).EQ.0)THEN                  ! J=2,4,6,8  
    223. 

  223.                 U_BXE(J,K,IB)    = UTMP_B(II,J,K)
    224. 

  224.                 U_BTXE(J,K,IB)   = UTMP_BT(II,J,K)
    225. 

  225.                 V_BXE(J,K,IB)    = VTMP_B(II,J,K)
    226. 

  226.                 V_BTXE(J,K,IB)   = VTMP_BT(II,J,K)
    227. 

  227.               ENDIF
    228. 

  228.             ENDDO
    229. 

  229.           ENDDO
    230. 

  230. 

  231.         ENDIF
    232. 

  232.       ENDDO
    233. 

  233. !
    234. 

  234. !----------------------------------------------------------------------
    235. 

  235. !***  SOUTH AND NORTH BOUNDARIES
    236. 

  236. !----------------------------------------------------------------------
    237. 

  237. !
    238. 

  238. !***  USE IBDY=1 FOR SOUTH; 2 FOR NORTH
    239. 

  239. !
    240. 

  240.       DO IBDY=1,2
    241. 

  241. !
    242. 

  242. !***  MAKE SURE THE PROCESSOR HAS THIS BOUNDARY.
    243. 

  243. !
    244. 

  244.         IF(S_BDY.AND.IBDY.EQ.1) THEN 
    245. 

  245. !
    246. 

  246. !            BF=P_YSB     ! Which boundary (YSB=the boundary where Y is at its start)
    247. 

  247.             JB=1         ! Which cell in from boundary
    248. 

  248.             JJ=1         ! Which cell in the domain
    249. 

  249. !
    250. 

  250.           DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
    251. 

  251.             PD_BYS(I,1,JB) = PDTMP_B(I,JJ)
    252. 

  252.             PD_BTYS(I,1,JB)= PDTMP_BT(I,JJ)
    253. 

  253.           ENDDO
    254. 

  254. 

  255. !
    256. 

  256.           DO K=KTS,KTE
    257. 

  257.             DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
    258. 

  258.               T_BYS(I,K,JB)   = TTMP_B(I,JJ,K)
    259. 

  259.               T_BTYS(I,K,JB)  = TTMP_BT(I,JJ,K)
    260. 

  260.               Q_BYS(I,K,JB)   = QTMP_B(I,JJ,K)
    261. 

  261.               Q_BTYS(I,K,JB)  = QTMP_BT(I,JJ,K)
    262. 

  262.               Q2_BYS(I,K,JB)  = Q2TMP_B(I,JJ,K)
    263. 

  263.               Q2_BTYS(I,K,JB) = Q2TMP_BT(I,JJ,K)
    264. 

  264.               CWM_BYS(I,K,JB) = CWMTMP_B(I,JJ,K)
    265. 

  265.               CWM_BTYS(I,K,JB)= CWMTMP_BT(I,JJ,K)
    266. 

  266.             ENDDO
    267. 

  267.           ENDDO
    268. 

  268. 

  269.           DO K=KTS,KTE
    270. 

  270.            DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
    271. 

  271.               U_BYS(I,K,JB)   = UTMP_B(I,JJ,K)
    272. 

  272.               U_BTYS(I,K,JB)  = UTMP_BT(I,JJ,K)
    273. 

  273.               V_BYS(I,K,JB)   = VTMP_B(I,JJ,K)
    274. 

  274.               V_BTYS(I,K,JB)  = VTMP_BT(I,JJ,K)
    275. 

  275.            ENDDO
    276. 

  276.           ENDDO
    277. 

  277. 

  278.           ELSEIF (N_BDY.AND.IBDY.EQ.2) THEN
    279. 

  279. !            BF=P_YEB      ! Which boundary (YEB=the boundary where Y is at its end)
    280. 

  280.             JB=1          ! Which cell in from boundary
    281. 

  281.             JJ=JDE        ! Which cell in the domain
    282. 

  282. 

  283.           DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
    284. 

  284.             PD_BYE(I,1,JB) = PDTMP_B(I,JJ)
    285. 

  285.             PD_BTYE(I,1,JB)= PDTMP_BT(I,JJ)
    286. 

  286.           ENDDO
    287. 

  287. 

  288. !
    289. 

  289.           DO K=KTS,KTE
    290. 

  290.             DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
    291. 

  291.               T_BYE(I,K,JB)   = TTMP_B(I,JJ,K)
    292. 

  292.               T_BTYE(I,K,JB)  = TTMP_BT(I,JJ,K)
    293. 

  293.               Q_BYE(I,K,JB)   = QTMP_B(I,JJ,K)
    294. 

  294.               Q_BTYE(I,K,JB)  = QTMP_BT(I,JJ,K)
    295. 

  295.               Q2_BYE(I,K,JB)  = Q2TMP_B(I,JJ,K)
    296. 

  296.               Q2_BTYE(I,K,JB) = Q2TMP_BT(I,JJ,K)
    297. 

  297.               CWM_BYE(I,K,JB) = CWMTMP_B(I,JJ,K)
    298. 

  298.               CWM_BTYE(I,K,JB)= CWMTMP_BT(I,JJ,K)
    299. 

  299.             ENDDO
    300. 

  300.           ENDDO
    301. 

  301. 

  302.           DO K=KTS,KTE
    303. 

  303.            DO I=MAX(ITS-1,IDS),MIN(ITE+1,IDE)
    304. 

  304.               U_BYE(I,K,JB)   = UTMP_B(I,JJ,K)
    305. 

  305.               U_BTYE(I,K,JB)  = UTMP_BT(I,JJ,K)
    306. 

  306.               V_BYE(I,K,JB)   = VTMP_B(I,JJ,K)
    307. 

  307.               V_BTYE(I,K,JB)  = VTMP_BT(I,JJ,K)
    308. 

  308.            ENDDO
    309. 

  309.           ENDDO
    310. 

  310. 

  311. 

  312. 

  313.         ENDIF
    314. 

  314.       ENDDO
    315. 

  315. END  SUBROUTINE NESTBC_PATCH
    316. 

  316. 

  317. !----------------------------------------------------------------------
    318. 

  318. !
    319. 

  319. SUBROUTINE STATS_FOR_MOVE (XLOC,YLOC,PDYN,MSLP,SQWS              &
    320. 

  320.                           ,PINT,T,Q,U,V                          &
    321. 

  321.                           ,FIS,PD,SM,PDTOP,PTOP                  &
    322. 

  322.                           ,DETA1,DETA2                           &
    323. 

  323. #ifdef HWRF
    324. 

  324.                           ,RESTART,NTIME0                        & ! zhang's doing
    325. 

  325.                           ,MOVED,MVNEST,NTSD,NPHS,CFREQ          & ! CFREQ*DT*NPHS=540s
    326. 

  326. #else
    327. 

  327.                           ,MOVED,MVNEST,NTSD,NPHS                &
    328. 

  328. #endif
    329. 

  329.                           ,vortex_tracker                        &
    330. 

  330.                           ,IDS,IDE,JDS,JDE,KDS,KDE               &
    331. 

  331.                           ,IMS,IME,JMS,JME,KMS,KME               &
    332. 

  332.                           ,ITS,ITE,JTS,JTE,KTS,KTE               )
    333. 

  333. 

  334. !**********************************************************************
    335. 

  335. !$$$  SUBPROGRAM DOCUMENTATION BLOCK
    336. 

  336. !                .      .    .
    337. 

  337. ! SUBPROGRAM:  STATS_FOR_MOVE  
    338. 

  338. !   PRGRMMR: gopal
    339. 

  339. !
    340. 

  340. ! ABSTRACT:
    341. 

  341. !         THIS ROUTINE COMPUTES SOME STATS REQUIRED FOR AUTOMATIC GRID MOTION 
    342. 

  342. !         THERE ARE THREE DIFFERENT MODES:
    343. 

  343. !             vortex_tracker=1 -- follow vortex using old algorithm
    344. 

  344. !             vortex_tracker=2 -- follow child
    345. 

  345. !             vortex_tracker=3 -- follow vortex using new HRD algorithm
    346. 

  346. !               otherwise   -- do nothing
    347. 

  347. ! PROGRAM HISTORY LOG:
    348. 

  348. !   05-18-2005  : gopal
    349. 

  349. !
    350. 

  350. ! USAGE: CALL STATS_FOR_MOVE FROM SUBROUTINE SOLVE_RUNSTREAM FOR NESTED DOMAIN ONLY
    351. 

  351. !
    352. 

  352. ! ATTRIBUTES:
    353. 

  353. !   LANGUAGE: FORTRAN 90
    354. 

  354. !   MACHINE : IBM SP
    355. 

  355. !$$$
    356. 

  356. !**********************************************************************
    357. 

  357. 

  358.       USE MODULE_MODEL_CONSTANTS
    359. 

  359.       USE MODULE_DM
    360. 

  360. 

  361.       IMPLICIT NONE
    362. 

  362. !
    363. 

  363.       LOGICAL,EXTERNAL                                      :: wrf_dm_on_monitor
    364. 

  364.       LOGICAL,INTENT(INOUT)                                 :: MVNEST  ! NMM SWITCH FOR GRID MOTION
    365. 

  365.       LOGICAL,INTENT(IN)                                    :: MOVED
    366. 

  366.       INTEGER,INTENT(IN)                                    :: vortex_tracker
    367. 

  367.       INTEGER,INTENT(IN)                                    :: IDS,IDE,JDS,JDE,KDS,KDE   &
    368. 

  368.                                                               ,IMS,IME,JMS,JME,KMS,KME   &
    369. 

  369.                                                               ,ITS,ITE,JTS,JTE,KTS,KTE   &
    370. 

  370. #ifdef HWRF
    371. 

  371.                                                               ,NTSD,NPHS,CFREQ
    372. 

  372. #else
    373. 

  373.                                                               ,NTSD,NPHS
    374. 

  374. #endif
    375. 

  375. !
    376. 

  376.       INTEGER, INTENT(OUT)                                  :: XLOC,YLOC
    377. 

  377.       INTEGER                                               :: NXLOC,NYLOC
    378. 

  378.       REAL                                                  :: NSUM1,NSUM2,NSUM3
    379. 

  379.       REAL, DIMENSION(KMS:KME),                 INTENT(IN)  :: DETA1,DETA2
    380. 

  380.       REAL,                                     INTENT(IN)  :: PDTOP,PTOP
    381. 

  381.       REAL, DIMENSION(IMS:IME,JMS:JME),         INTENT(IN)  :: FIS,PD,SM
    382. 

  382.       REAL, DIMENSION(IMS:IME,JMS:JME,KMS:KME), INTENT(IN)  :: PINT,T,Q,U,V
    383. 

  383.       REAL, DIMENSION(IMS:IME,JMS:JME),         INTENT(OUT) :: PDYN,MSLP,SQWS
    384. 

  384. !
    385. 

  385. !     LOCAL
    386. 

  386. 

  387. #ifdef HWRF
    388. 

  388. !zhang's doing
    389. 

  389.       INTEGER,INTENT(INOUT)                                 :: NTIME0
    390. 

  390.       LOGICAL,INTENT(IN)                                    :: RESTART
    391. 

  391. #else
    392. 

  392.       INTEGER,SAVE                                          :: NTIME0
    393. 

  393. #endif
    394. 

  394.       INTEGER                                               :: IM,JM,IP,JP
    395. 

  395.       INTEGER                                               :: I,K,J,XR,YR,DTMOVE,IDUM,JDUM,ITF,JTF
    396. 

  396.       REAL, PARAMETER                                       :: LAPSR=6.5E-3, GI=1./G,D608=0.608
    397. 

  397.       REAL, PARAMETER                                       :: COEF3=287.05*GI*LAPSR, COEF2=-1./COEF3
    398. 

  398.       REAL, PARAMETER                                       :: TRG=2.0*R_D*GI,LAPSI=1.0/LAPSR
    399. 

  399.       REAL                                                  :: DZ,RTOPP,APELP,A,TSFC,STMP0,STMP1
    400. 

  400.       REAL                                                  :: SMSUM,SMOUT,XDIFF,YDIFF,PCUT,PGR
    401. 

  401.       REAL                                                  :: MINGBL_PDYN,MAXGBL_PDYN,MAXGBL_SQWS
    402. 

  402.       REAL                                                  :: MINGBL_MIJ
    403. 

  403.       REAL, DIMENSION(IMS:IME,JMS:JME)                      :: MIJ
    404. 

  404.       REAL, DIMENSION(IMS:IME,JMS:JME,KMS:KME)              :: Z
    405. 

  405. 

  406. !    EXEC 
    407. 

  407. 

  408.      ITF=MIN(ITE,IDE-1)
    409. 

  409.      JTF=MIN(JTE,JDE-1)
    410. 

  410. 

  411. !----------------------------------------------------------------------------------
    412. 

  412. 

  413. !     KEEP NEST MOTION IN SINK WITH PHYSICS TIME STEPS
    414. 

  414. #ifdef HWRF
    415. 

  415.       IF(MOD(NTSD+1,CFREQ*NPHS)/=0)THEN   !FOR FULL COUPLING
    416. 

  416.         IF(MOVED) NTIME0=NTSD             !FOR UPDATING NTIM0
    417. 

  417. #else
    418. 

  418.       IF(MOD(NTSD+1,NPHS)/=0)THEN
    419. 

  419. #endif
    420. 

  420.         MVNEST=.FALSE.
    421. 

  421.         RETURN
    422. 

  422.       ENDIF
    423. 

  423. 

  424. !     DETERMINE THE HEIGHTS ON THE PARENT DOMAIN
    425. 

  425. 

  426.       DO J = JTS, MIN(JTE,JDE)
    427. 

  427.        DO I = ITS, MIN(ITE,IDE)
    428. 

  428.          Z(I,J,1)=FIS(I,J)*GI
    429. 

  429.        ENDDO
    430. 

  430.       ENDDO
    431. 

  431. !
    432. 

  432.       DO K = KTS,KTE
    433. 

  433.        DO J = JTS, MIN(JTE,JDE)
    434. 

  434.         DO I = ITS, MIN(ITE,IDE)
    435. 

  435.           APELP      = (PINT(I,J,K+1)+PINT(I,J,K))
    436. 

  436.           RTOPP      = TRG*T(I,J,K)*(1.0+Q(I,J,K)*P608)/APELP
    437. 

  437.           DZ         = RTOPP*(DETA1(K)*PDTOP+DETA2(K)*PD(I,J))
    438. 

  438.           Z(I,J,K+1) = Z(I,J,K) + DZ
    439. 

  439.         ENDDO
    440. 

  440.        ENDDO
    441. 

  441.       ENDDO
    442. 

  442. 

  443. !     DETERMINE THE MEAN SEA LEVEL PRESSURE, THE VERTICALLY AVERAGED WIND
    444. 

  444. !     SPEED AT ABOUT LEVELS 9 10 AND 11 AND THE DYNAMIC PRESSURES DEFINED
    445. 

  445. !     FROM BASIC BERNOULLI's THEOREM
    446. 

    447. 

  447.       DO J = JTS, MIN(JTE,JDE)
    448. 

  448.         DO I = ITS, MIN(ITE,IDE)
    449. 

  449.             TSFC      = T(I,J,1)*(1.+D608*Q(I,J,1)) + LAPSR*(Z(I,J,1)+Z(I,J,2))*0.5
    450. 

  450.             A         = LAPSR*Z(I,J,1)/TSFC
    451. 

  451.             MSLP(I,J) = PINT(I,J,1)*(1-A)**COEF2
    452. 

  452.             SQWS(I,J) =  (U(I,J,9)*U(I,J,9) + V(I,J,9)*V(I,J,9)           &
    453. 

  453.                       +   U(I,J,10)*U(I,J,10) + V(I,J,10)*V(I,J,10)       &
    454. 

  454.                       +   U(I,J,11)*U(I,J,11) + V(I,J,11)*V(I,J,11))/3.0
    455. 

  455. #ifdef HWRF
    456. 

  456.             PDYN(I,J) =   MSLP(I,J)
    457. 

  457. #else
    458. 

  458.             PDYN(I,J) =   MSLP(I,J)  + 1.1*SQWS(I,J)/2.0
    459. 

  459. #endif
    460. 

  460.         ENDDO
    461. 

  461.       ENDDO
    462. 

  462. 

  463. !     FILTER OUT PDYN AND STORE THAT IN MIJ. THE MAXIMUM VALUE OF MIJ GIVES THE STORM CENTER
    464. 

  464. !     ALSO DO THAT WITHIN A SUB DOMAIN
    465. 

  465. 

  466.       MAXGBL_PDYN=MAXVAL(PDYN(ITS:ITF,JTS:JTF))
    467. 

  467.       CALL WRF_DM_MAXVAL(MAXGBL_PDYN,IDUM,JDUM)
    468. 

  468.       MINGBL_PDYN=MINVAL(PDYN(ITS:ITF,JTS:JTF))
    469. 

  469.       CALL WRF_DM_MINVAL(MINGBL_PDYN,IDUM,JDUM)
    470. 

  470.       PCUT = 0.5*(MAXGBL_PDYN + MINGBL_PDYN)
    471. 

  471. !
    472. 

  472.       IM=IDE/2 - IDE/6
    473. 

  473.       IP=IDE/2 + IDE/6
    474. 

  474.       JM=JDE/2 - JDE/4
    475. 

  475.       JP=JDE/2 + JDE/4
    476. 

  476. !
    477. 

  477.       DO J = JTS, MIN(JTE,JDE)
    478. 

  478.         DO I = ITS, MIN(ITE,IDE)
    479. 

  479.           IF(I .GE. IM .AND. I .LE. IP .AND. J .GE. JM .AND. J .LE. JP  &
    480. 

  480.                        .AND. PCUT .GT. PDYN(I,J))THEN
    481. 

  481.              MIJ(I,J) = PDYN(I,J)
    482. 

  482.           ELSE
    483. 

  483.              MIJ(I,J) = 105000.0
    484. 

  484.           ENDIF
    485. 

  485.         ENDDO
    486. 

  486.       ENDDO
    487. 

  487. 

  488.       DO J = JTS, MIN(JTE,JDE)
    489. 

  489.         DO I = ITS, MIN(ITE,IDE)
    490. 

  490.           PDYN(I,J)=MIJ(I,J)
    491. 

  491.         ENDDO
    492. 

  492.       ENDDO
    493. 

  493. 

  494. !   BEGIN OLD TRACKER CODE ----------------------------------------------------
    495. 

  495.     old_tracker_1: if(vortex_tracker == 1) then
    496. 

  496. !
    497. 

  497. !     DETERMINE THE LOCATION OF CENTER OF THE CIRCULATION DEFINED BY MIJ AND FIND THE CORRESPONDING MSLP 
    498. 

  498. !
    499. 

  499.       STMP0=MAXGBL_PDYN*100.                 ! define arbitrary maximum
    500. 

  500.       MINGBL_MIJ=MINVAL(MIJ(ITS:ITF,JTS:JTF))
    501. 

  501.       DO J = JTS, MIN(JTE,JDE)
    502. 

  502.         DO I = ITS, MIN(ITE,IDE)
    503. 

  503.            IF(MIJ(I,J) .EQ. MINGBL_MIJ)THEN
    504. 

  504.              XLOC=I
    505. 

  505.              YLOC=J
    506. 

  506.              STMP0=MSLP(I,J)
    507. 

  507.            ENDIF
    508. 

  508.         ENDDO
    509. 

  509.       ENDDO
    510. 

  510. 

  511.       CALL WRF_DM_MINVAL(MINGBL_MIJ,XLOC,YLOC)
    512. 

  512.       CALL WRF_DM_MINVAL(STMP0,IDUM,JDUM)
    513. 

  513.    endif old_tracker_1
    514. 

  514. !   END OLD TRACKER CODE ------------------------------------------------------
    515. 

  515. 

  516. 

  517. !   BEGIN HRD TRACKER CODE ----------------------------------------------------
    518. 

  518.     hwrfx_tracker: if(vortex_tracker == 3) then
    519. 

  519. !     USE CENTROID TO FIND THE CENTER    Xuejin's doing
    520. 

    521. 

  521.       NSUM1=0.0
    522. 

  522.       NSUM2=0.0
    523. 

  523.       NSUM3=0.0
    524. 

  524.       DO J = JTS, MIN(JTE,JDE)
    525. 

  525.        DO I = ITS, MIN(ITE,IDE)
    526. 

  526.         IF(I .GE. IM .AND. I .LE. IP .AND. J .GE. JM .AND. J .LE. JP )THEN
    527. 

  527. !       IF(I .EQ. IM .AND. J .EQ. JM)THEN
    528. 

  528.           NSUM1 = NSUM1 + I*(105000.1 - PDYN(I,J))
    529. 

  529.           NSUM2 = NSUM2 + J*(105000.1 - PDYN(I,J))
    530. 

  530.           NSUM3 = NSUM3 + (105000.1 - PDYN(I,J))
    531. 

  531. !         WRITE(0,*)'TEST',NSUM1,I,J,0.01*(105000.0 - PDYN(I,J)),PDYN(I,J) 
    532. 

  532.         ENDIF
    533. 

  533.        ENDDO
    534. 

  534.       ENDDO
    535. 

  535.       NSUM1 = WRF_DM_SUM_REAL(NSUM1)
    536. 

  536.       NSUM2 = WRF_DM_SUM_REAL(NSUM2)
    537. 

  537.       NSUM3 = WRF_DM_SUM_REAL(NSUM3)
    538. 

  538.       NXLOC = NINT(NSUM1/NSUM3)
    539. 

  539.       NYLOC = NINT(NSUM2/NSUM3)
    540. 

  540. 

  541.       WRITE(0,*)'NEW CALC',NSUM1,NSUM2,NSUM3
    542. 

  542.       WRITE(0,*)'XLOC,YLOC',NXLOC,XLOC,NYLOC,YLOC
    543. 

  543. 

  544.       XLOC = NXLOC
    545. 

  545.       YLOC = NYLOC
    546. 

  546. 

  547.     endif hwrfx_tracker
    548. 

  548. !   END HRD TRACKER CODE ------------------------------------------------------
    549. 

  549.  
    550. 

  550. 

  551. !   BEGIN OLD TRACKER CODE ----------------------------------------------------
    552. 

  552. !     DETERMINE THE MAXIMUM MSLP AT ABOUT 18 GRID POINTS AWAY FROM THE STORM CENTER 
    553. 

  553.     old_tracker_2: if ( vortex_tracker == 1 ) then
    554. 

  554. 

  555.       STMP1=0.0
    556. 

  556.       DO J = JTS, MIN(JTE,JDE)
    557. 

  557.         DO I = ITS, MIN(ITE,IDE)
    558. 

  558.            IF(I .EQ. XLOC+18)THEN
    559. 

  559.              XR=I
    560. 

  560.              YR=J
    561. 

  561.              STMP1=MSLP(I,J)
    562. 

  562.            ENDIF
    563. 

  563.         ENDDO
    564. 

  564.       ENDDO
    565. 

  565. 

  566.       CALL WRF_DM_MAXVAL(STMP1,XR,YR)
    567. 

  567. 

  568. !
    569. 

  569. !     DETERMINE IF THE ENTIRE NESTED DOMAIN IS OVER LAND (SM=0)
    570. 

  570. !
    571. 

  571. 

  572.       SMSUM = 0.0
    573. 

  573.       DO J = JTS, MIN(JTE,JDE)
    574. 

  574.        DO I = ITS, MIN(ITE,IDE)
    575. 

  575.          SMSUM = SMSUM + SM(I,J)
    576. 

  576.        ENDDO
    577. 

  577.       ENDDO
    578. 

  578. 

  579.       SMOUT=WRF_DM_SUM_REAL(SMSUM)/(IDE*JDE)
    580. 

  580. 

  581. !     STOP GRID MOTION. AVOID MOVING TOO RAPID GRID MOTION, SAY SOMETHING LIKE EVERY
    582. 

  582. !     OTHER TIME STEP OR SO  
    583. 

  583. 

  584.       PGR=STMP1-STMP0
    585. 

  585.    endif old_tracker_2
    586. 

  586. !   END OLD TRACKER CODE ------------------------------------------------
    587. 

  587. 

  588.  
    589. 

  589.       XDIFF=ABS(XLOC - IDE/2)
    590. 

  590.       YDIFF=ABS(YLOC - JDE/2)
    591. 

  591. #ifdef HWRF
    592. 

  592. !zhang's doing
    593. 

  593.       IF((.NOT.RESTART .AND. NTSD==0) .OR. MOVED)NTIME0=NTSD
    594. 

  594. #else
    595. 

  595.       IF(NTSD==0 .OR. MOVED)NTIME0=NTSD
    596. 

  596. #endif
    597. 

  597.       DTMOVE=NTSD-NTIME0                    ! TIME INTERVAL SINCE THE PREVIOUS MOVE
    598. 

  598. !
    599. 

  599. !    DECIDE IF NEST MOTION SHOULD HAPPEN
    600. 

  600. !
    601. 

  601.     if(vortex_tracker == 3) then
    602. 

  602.       ! Using new HRD tracker.  Move if centroid moved.
    603. 

  603.        IF(XDIFF .GE. 1 .OR. YDIFF .GE. 2) THEN
    604. 

  604.         MVNEST=.TRUE.
    605. 

  605.         NTIME0=NTSD
    606. 

  606.        ELSE
    607. 

  607.         ! Centroid has not moved one parent gridpoint yet.
    608. 

  608.         MVNEST=.FALSE.
    609. 

  609.        ENDIF
    610. 

  610.     elseif(vortex_tracker==2) then
    611. 

  611.        ! Tracking child domain.  Nest motion check happens in
    612. 

  612.        ! direction_of_move2, but we MUST set mvnest=true here:
    613. 

  613.        MVNEST=.TRUE.
    614. 

  614.     elseif(vortex_tracker==1) then
    615. 

  615.       ! Using old HWRF tracker.  Decide if it wants to move.
    616. 

  616.       IF(DTMOVE .LE. 45 .OR. PGR .LE. 200.)THEN
    617. 

  617.         WRITE(0,*)'SUSPEND MOTION: SMALL DTMOVE OR WEAK PGF:','DTMOVE=',DTMOVE,'PGR=',PGR
    618. 

  618.         MVNEST=.FALSE.                               ! SET STATIC GRID
    619. 

  619.       ELSE IF(STMP0 .GE. STMP1)THEN
    620. 

  620.         WRITE(0,*)'SUSPEND MOTION: THERE IS NO VORTEX IN THE DOMAIN:','STMP0=',STMP0,'STMP1=',STMP1
    621. 

  621.         MVNEST=.FALSE.
    622. 

  622.       ELSE IF(XDIFF .GT. 24 .OR. YDIFF .GT. 24)THEN
    623. 

  623.         WRITE(0,*)'SUSPEND MOTION: LOST VORTEX ','DTMOVE=',DTMOVE,'XDIFF=',XDIFF,'YDIFF=',YDIFF
    624. 

  624.         MVNEST=.FALSE.
    625. 

  625.       ELSE IF(SMOUT .LE. 0.2 .AND. XDIFF .GT. 12 .AND. YDIFF .GT. 12)THEN
    626. 

  626.         WRITE(0,*)'SUSPEND MOTION: VORTEX LOST OVER LAND ','DTMOVE=',DTMOVE,'XDIFF=',XDIFF,'YDIFF=',YDIFF
    627. 

  627.         MVNEST=.FALSE.
    628. 

  628.       ELSE IF(SMOUT .LE. 0.2 .AND. PGR .LE. 400.)THEN
    629. 

  629.         WRITE(0,*)'SUSPEND MOTION: VORTEX WEAK OVER LAND ','SMOUT=',SMOUT,'PGR=',PGR
    630. 

  630.         MVNEST=.FALSE.
    631. 

  631.       ELSE IF(SMOUT .LE. 0.2 .AND. DTMOVE .GE. 1500)THEN
    632. 

  632.         WRITE(0,*)'SUSPEND MOTION: STOP MOTION  OVER LAND','SMOUT=',SMOUT,'DTMOVE=',DTMOVE
    633. 

  633.         MVNEST=.FALSE.
    634. 

  634.       ELSE
    635. 

  635.         MVNEST=.TRUE.
    636. 

  636.       ENDIF
    637. 

  637.    else
    638. 

  638.       ! Not using any valid trackers, so set MVNEST to false.
    639. 

  639.       MVNEST=.false.
    640. 

  640.    endif
    641. 

  641. 

  642.       RETURN
    643. 

  643. 

  644. END SUBROUTINE STATS_FOR_MOVE
    645. 

  645. !----------------------------------------------------------------------------------
    646. 

  646. SUBROUTINE MSLP_DIAG (MSLP,PINT,T,Q               &
    647. 

  647.                      ,FIS,PD,DETA1,DETA2,PDTOP    &
    648. 

  648.                      ,IDS,IDE,JDS,JDE,KDS,KDE     &
    649. 

  649.                      ,IMS,IME,JMS,JME,KMS,KME     &
    650. 

  650.                      ,ITS,ITE,JTS,JTE,KTS,KTE     )
    651. 

  651. 

  652. 

  653. !**********************************************************************
    654. 

  654. !$$$  SUBPROGRAM DOCUMENTATION BLOCK
    655. 

  655. !                .      .    .
    656. 

  656. ! SUBPROGRAM:  MSLP_DIAG 
    657. 

  657. !   PRGRMMR: gopal
    658. 

  658. !
    659. 

  659. ! ABSTRACT:
    660. 

  660. !         THIS ROUTINE COMPUTES MSLP OVER THE PARENT DOMAIN FOR DIAGONOSTIC PURPOSE 
    661. 

  661. ! PROGRAM HISTORY LOG:
    662. 

  662. !   07-21-2005  : gopal
    663. 

  663. !
    664. 

  664. ! USAGE: CALL MSLP_DIAG FROM THE SOLVER 
    665. 

  665. !
    666. 

  666. ! ATTRIBUTES:
    667. 

  667. !   LANGUAGE: FORTRAN 90
    668. 

  668. !   MACHINE : IBM SP/Linux cluster
    669. 

  669. !$$$
    670. 

  670. 

  671.       USE MODULE_MODEL_CONSTANTS
    672. 

  672.       USE MODULE_DM
    673. 

  673. 

  674.       IMPLICIT NONE
    675. 

  675. 

  676. !     global variables
    677. 

  677. 

  678.       INTEGER,INTENT(IN)                                      :: IDS,IDE,JDS,JDE,KDS,KDE   &
    679. 

  679.                                                                 ,IMS,IME,JMS,JME,KMS,KME   & 
    680. 

  680.                                                                 ,ITS,ITE,JTS,JTE,KTS,KTE   
    681. 

  681. 

  682.       REAL,                                     INTENT(IN)    :: PDTOP
    683. 

  683.       REAL, DIMENSION(KMS:KME),                 INTENT(IN)    :: DETA1,DETA2
    684. 

  684.       REAL, DIMENSION(IMS:IME,JMS:JME),         INTENT(INOUT) :: MSLP
    685. 

  685.       REAL, DIMENSION(IMS:IME,JMS:JME),         INTENT(IN)    :: FIS,PD
    686. 

  686.       REAL, DIMENSION(IMS:IME,JMS:JME,KMS:KME), INTENT(IN)    :: PINT,T,Q
    687. 

  687. 

  688. !     local variables
    689. 

  689. 

  690.       REAL, PARAMETER                                       :: LAPSR=6.5E-3, GI=1./G,D608=0.608
    691. 

  691.       REAL, PARAMETER                                       :: COEF3=287.05*GI*LAPSR, COEF2=-1./COEF3
    692. 

  692.       REAL, PARAMETER                                       :: TRG=2.0*R_D*GI,LAPSI=1.0/LAPSR
    693. 

  693.       REAL                                                  :: RTOPP,APELP,DZ,SFCT,A
    694. 

  694.       REAL, DIMENSION(IMS:IME,JMS:JME,KMS:KME)              :: Z
    695. 

  695.       INTEGER                                               :: I,J,K
    696. 

  696. !-----------------------------------------------------------------------------------------------------
    697. 

  697. 

  698. 

  699.      DO J = JTS, MIN(JTE,JDE)
    700. 

  700.       DO I = ITS, MIN(ITE,IDE)
    701. 

  701.          Z(I,J,1)=FIS(I,J)*GI
    702. 

  702.       ENDDO
    703. 

  703.      ENDDO
    704. 

  704. 

  705.      DO K = KTS,KTE
    706. 

  706.       DO J = JTS, MIN(JTE,JDE)
    707. 

  707.        DO I = ITS, MIN(ITE,IDE)
    708. 

  708.          APELP      = (PINT(I,J,K+1)+PINT(I,J,K))
    709. 

  709.          RTOPP      = TRG*T(I,J,K)*(1.0+Q(I,J,K)*P608)/APELP
    710. 

  710.          DZ         = RTOPP*(DETA1(K)*PDTOP+DETA2(K)*PD(I,J))
    711. 

  711.          Z(I,J,K+1) = Z(I,J,K) + DZ
    712. 

  712.        ENDDO
    713. 

  713.       ENDDO
    714. 

  714.      ENDDO
    715. 

  715. 

  716.      MSLP=-9999.99
    717. 

  717.      DO J = JTS, MIN(JTE,JDE)
    718. 

  718.        DO I = ITS, MIN(ITE,IDE)
    719. 

  719.          SFCT      = T(I,J,1)*(1.+D608*Q(I,J,1)) + LAPSR*(Z(I,J,1)+Z(I,J,2))*0.5
    720. 

  720.          A         = LAPSR*Z(I,J,1)/SFCT
    721. 

  721.          MSLP(I,J) = PINT(I,J,1)*(1-A)**COEF2
    722. 

  722.        ENDDO
    723. 

  723.      ENDDO
    724. 

  724. 

  725. 

  726. END SUBROUTINE MSLP_DIAG
    727. 

  727. !------------------------------------------------------------------------------------------------------
    728. 

  728. 

  729. END  MODULE module_NEST_UTIL
    730. 

  730.