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

/wrfv2_fire/share/mediation_integrate.F

http://github.com/jbeezley/wrf-fire
FORTRAN Legacy | 2716 lines | 1364 code | 476 blank | 876 comment | 25 complexity | cf69e657a5d46c322b123daf75124687 MD5 | raw file
Possible License(s): AGPL-1.0

Large files files are truncated, but you can click here to view the full file

    

  1. !
    2. 

  2. !WRF:MEDIATION_LAYER:IO
    3. 

  3. !
    4. 

  4. #if (DA_CORE != 1)
    5. 

  5. 

  6. SUBROUTINE med_calc_model_time ( grid , config_flags )
    7. 

  7.   ! Driver layer
    8. 

  8.    USE module_domain	, ONLY : domain, domain_clock_get
    9. 

  9.    USE module_configure	, ONLY : grid_config_rec_type
    10. 

  10.   ! Model layer
    11. 

  11.    USE module_date_time
    12. 

  12. 

  13.    IMPLICIT NONE
    14. 

  14. 

  15.   ! Arguments
    16. 

  16.    TYPE(domain)                               :: grid
    17. 

  17.    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
    18. 

  18. 

  19.   ! Local data
    20. 

  20.    REAL                                       :: time 
    21. 

  21. 

  22. ! this is now handled by with calls to time manager
    23. 

  23. !   time = head_grid%dt * head_grid%total_time_steps
    24. 

  24. !   CALL calc_current_date (grid%id, time)
    25. 

  25. 

  26. 

  27. END SUBROUTINE med_calc_model_time
    28. 

  28. 

  29. SUBROUTINE med_before_solve_io ( grid , config_flags )
    30. 

  30.   ! Driver layer
    31. 

  31.    USE module_state_description
    32. 

  32.    USE module_domain	, ONLY : domain, domain_clock_get
    33. 

  33.    USE module_configure	, ONLY : grid_config_rec_type
    34. 

  34.    USE module_streams
    35. 

  35.   ! Model layer
    36. 

  36.    USE module_utility
    37. 

  37. 

  38.    IMPLICIT NONE
    39. 

  39. 

  40.   ! Arguments
    41. 

  41.    TYPE(domain)                               :: grid
    42. 

  42.    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
    43. 

  43.   ! Local
    44. 

  44.    INTEGER                                    :: ialarm
    45. 

  45.    INTEGER                                    :: rc
    46. 

  46.    TYPE(WRFU_Time) :: currTime, startTime
    47. 

  47. #ifdef HWRF
    48. 

  48. !zhang's doing
    49. 

  49. !   TYPE(WRFU_Time) :: CurrTime  !zhang new
    50. 

  50.    INTEGER :: hr, min, sec, ms,julyr,julday
    51. 

  51.    REAL :: GMT
    52. 

  52. !end of zhang's doing
    53. 

  53. #endif
    54. 

  54. 

  55.    CHARACTER*256          :: message
    56. 

  56. 

  57. ! #if (EM_CORE == 1)
    58. 

  58.    CALL WRFU_ClockGet( grid%domain_clock, CurrTime=currTime, StartTime=startTime )
    59. 

  59.    IF( WRFU_AlarmIsRinging( grid%alarms( HISTORY_ALARM ), rc=rc ) .AND. &
    60. 

  60.        (grid%dfi_write_dfi_history .OR. grid%dfi_stage == DFI_FST .OR. grid%dfi_opt == DFI_NODFI) ) THEN
    61. 

  61. ! #else
    62. 

  62. !   IF( WRFU_AlarmIsRinging( grid%alarms( HISTORY_ALARM ), rc=rc )) THEN
    63. 

  63. ! #endif
    64. 

  64.      IF  ( (config_flags%restart) .AND. ( currTime .EQ. startTime ) ) THEN
    65. 

  65.        !  output history at beginning of restart if alarm is ringing
    66. 

  66.        CALL med_hist_out ( grid , HISTORY_ALARM, config_flags )
    67. 

  67.      ELSE
    68. 

  68.        CALL med_hist_out ( grid , HISTORY_ALARM, config_flags )
    69. 

  69.      END IF
    70. 

  70.      CALL WRFU_AlarmRingerOff( grid%alarms( HISTORY_ALARM ), rc=rc )
    71. 

  71. #if (EM_CORE == 1)
    72. 

  72.    ELSE IF  ( (config_flags%restart) .AND. ( currTime .EQ. startTime ) .AND. &
    73. 

  73.               ( config_flags%write_hist_at_0h_rst ) ) THEN
    74. 

  74.      !  output history at beginning of restart even if alarm is not ringing
    75. 

  75.      CALL med_hist_out ( grid , HISTORY_ALARM, config_flags )
    76. 

  76.      CALL WRFU_AlarmRingerOff( grid%alarms( HISTORY_ALARM ), rc=rc )
    77. 

  77. #endif
    78. 

  78.    ENDIF
    79. 

  79. 

  80.    IF( WRFU_AlarmIsRinging( grid%alarms( INPUTOUT_ALARM ), rc=rc ) ) THEN
    81. 

  81.      CALL med_filter_out  ( grid , config_flags )
    82. 

  82.      CALL WRFU_AlarmRingerOff( grid%alarms( INPUTOUT_ALARM ), rc=rc )
    83. 

  83.    ENDIF
    84. 

  84. 

  85.    DO ialarm = first_auxhist, last_auxhist
    86. 

  86.      IF ( .FALSE.) THEN
    87. 

  87.        rc = 1  ! dummy statement
    88. 

  88.      ELSE IF( WRFU_AlarmIsRinging( grid%alarms( ialarm ), rc=rc ) ) THEN
    89. 

  89.        CALL med_hist_out ( grid , ialarm, config_flags )
    90. 

  90.        CALL WRFU_AlarmRingerOff( grid%alarms( ialarm ), rc=rc )
    91. 

  91.      ENDIF
    92. 

  92.    ENDDO
    93. 

  93. 

  94.    DO ialarm = first_auxinput, last_auxinput
    95. 

  95.      IF ( .FALSE.) THEN
    96. 

  96.        rc = 1  ! dummy statement
    97. 

  97. #ifdef WRF_CHEM
    98. 

  98. ! - Get chemistry data
    99. 

  99.      ELSE IF( ialarm .EQ. AUXINPUT5_ALARM .AND. config_flags%chem_opt > 0 ) THEN
    100. 

  100.        IF( config_flags%emiss_inpt_opt /= 0 ) THEN
    101. 

  101.          IF( WRFU_AlarmIsRinging( grid%alarms( ialarm ), rc=rc ) ) THEN
    102. 

  102.            call wrf_debug(15,' CALL med_read_wrf_chem_emiss ')
    103. 

  103.            CALL med_read_wrf_chem_emiss ( grid , config_flags )
    104. 

  104.            CALL WRFU_AlarmRingerOff( grid%alarms( ialarm ), rc=rc )
    105. 

  105.            call wrf_debug(15,' Back from CALL med_read_wrf_chem_emiss ')
    106. 

  106.          ENDIF
    107. 

  107.        ELSE
    108. 

  108.          IF( WRFU_AlarmIsRinging( grid%alarms( ialarm ), rc=rc ) ) THEN
    109. 

  109.            CALL med_auxinput_in ( grid, ialarm, config_flags )
    110. 

  110.            CALL WRFU_AlarmRingerOff( grid%alarms( ialarm ), rc=rc )
    111. 

  111.          ENDIF
    112. 

  112.        ENDIF
    113. 

  113.      ELSE IF( ialarm .EQ. AUXINPUT13_ALARM .AND. config_flags%chem_opt > 0 ) THEN
    114. 

  114.        IF( config_flags%emiss_opt_vol /= 0 ) THEN
    115. 

  115.          IF( WRFU_AlarmIsRinging( grid%alarms( ialarm ), rc=rc ) ) THEN
    116. 

  116.            call wrf_debug(15,' CALL med_read_wrf_volc_emiss ')
    117. 

  117.            CALL med_read_wrf_volc_emiss ( grid , config_flags )
    118. 

  118.            CALL WRFU_AlarmRingerOff( grid%alarms( ialarm ), rc=rc )
    119. 

  119.            call wrf_debug(15,' Back from CALL med_read_wrf_volc_emiss ')
    120. 

  120.          ENDIF
    121. 

  121.        ELSE
    122. 

  122.          IF( WRFU_AlarmIsRinging( grid%alarms( ialarm ), rc=rc ) ) THEN
    123. 

  123.            CALL med_auxinput_in ( grid, ialarm, config_flags )
    124. 

  124.            CALL WRFU_AlarmRingerOff( grid%alarms( ialarm ), rc=rc )
    125. 

  125.          ENDIF
    126. 

  126.        ENDIF
    127. 

  127. #endif
    128. 

  128. #if ( EM_CORE == 1 )
    129. 

  129.      ELSE IF( ialarm .EQ. AUXINPUT11_ALARM ) THEN
    130. 

  130.        IF( config_flags%obs_nudge_opt .EQ. 1) THEN
    131. 

  131.          CALL med_fddaobs_in ( grid , config_flags )
    132. 

  132.        ENDIF
    133. 

  133. #endif
    134. 

  134.      ELSE IF( WRFU_AlarmIsRinging( grid%alarms( ialarm ), rc=rc ) ) THEN
    135. 

  135.        CALL med_auxinput_in ( grid, ialarm, config_flags )
    136. 

  136.        WRITE ( message , FMT='(A,i3,A,i3)' )  'Input data processed for aux input ' , &
    137. 

  137.           ialarm - first_auxinput + 1, ' for domain ',grid%id
    138. 

  138.        CALL wrf_debug ( 0 , message )
    139. 

  139.        CALL WRFU_AlarmRingerOff( grid%alarms( ialarm ), rc=rc )
    140. 

  140.      ENDIF
    141. 

  141.    ENDDO
    142. 

  142. 

  143. ! - RESTART OUTPUT
    144. 

  144.    CALL WRFU_ClockGet( grid%domain_clock, CurrTime=currTime, StartTime=startTime )
    145. 

  145.    IF ( ( WRFU_AlarmIsRinging( grid%alarms( RESTART_ALARM ), rc=rc ) ) .AND. &
    146. 

  146.         ( currTime .NE. startTime ) ) THEN
    147. 

  147. #ifdef HWRF
    148. 

  148. !zhang's doing
    149. 

  149.      CALL domain_clock_get( grid, current_time=CurrTime )
    150. 

  150.      CALL WRFU_TimeGet( CurrTime, YY=julyr, dayOfYear=julday, H=hr, M=min, S=sec, MS=ms, rc=rc)
    151. 

  151.      gmt=hr+real(min)/60.+real(sec)/3600.+real(ms)/(1000*3600)
    152. 

  152.       if (grid%id .eq. 2) call med_namelist_out ( grid , config_flags )
    153. 

  153. !end of zhang's doing
    154. 

  154. #endif
    155. 

  155.      IF ( grid%id .EQ. 1 ) THEN
    156. 

  156.        ! Only the parent initiates the restart writing. Otherwise, different
    157. 

  157.        ! domains may be written out at different times and with different 
    158. 

  158.        ! time stamps in the file names.
    159. 

  159.        CALL med_restart_out ( grid , config_flags )
    160. 

  160.      ENDIF
    161. 

  161.      CALL WRFU_AlarmRingerOff( grid%alarms( RESTART_ALARM ), rc=rc )
    162. 

  162.    ELSE
    163. 

  163.      CALL WRFU_AlarmRingerOff( grid%alarms( RESTART_ALARM ), rc=rc )
    164. 

  164.    ENDIF
    165. 

  165. 

  166. ! - Look for boundary data after writing out history and restart files
    167. 

  167.    CALL med_latbound_in ( grid , config_flags )
    168. 

  168. 

  169.    RETURN
    170. 

  170. END SUBROUTINE med_before_solve_io
    171. 

  171. 

  172. SUBROUTINE med_after_solve_io ( grid , config_flags )
    173. 

  173.   ! Driver layer
    174. 

  174.    USE module_domain	, ONLY : domain
    175. 

  175.    USE module_timing
    176. 

  176.    USE module_configure	, ONLY : grid_config_rec_type
    177. 

  177.   ! Model layer
    178. 

  178. 

  179.    IMPLICIT NONE
    180. 

  180. 

  181.   ! Arguments
    182. 

  182.    TYPE(domain)                               :: grid
    183. 

  183.    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
    184. 

  184. 

  185.    ! Compute time series variables
    186. 

  186.    CALL calc_ts(grid)
    187. 

  187. 

  188.    ! Compute track variables 
    189. 

  189.    CALL track_driver(grid)
    190. 

  190. 

  191.    RETURN
    192. 

  192. END SUBROUTINE med_after_solve_io
    193. 

  193. 

  194. SUBROUTINE med_pre_nest_initial ( parent , newid , config_flags )
    195. 

  195.   ! Driver layer
    196. 

  196. #ifdef MOVE_NESTS
    197. 

  197.    USE module_domain	, ONLY : domain, domain_clock_get
    198. 

  198. #else
    199. 

  199.    USE module_domain	, ONLY : domain
    200. 

  200. #endif
    201. 

  201. #ifdef ESMFIO
    202. 

  202.    USE module_utility   , ONLY : WRFU_Time 
    203. 

  203. #else
    204. 

  204.    USE module_utility   , ONLY : WRFU_Time, WRFU_TimeEQ
    205. 

  205. #endif
    206. 

  206.    USE module_timing
    207. 

  207.    USE module_io_domain
    208. 

  208.    USE module_configure	, ONLY : grid_config_rec_type
    209. 

  209.   ! Model layer
    210. 

  210. 

  211.    IMPLICIT NONE
    212. 

  212. 

  213.   ! Arguments
    214. 

  214.    TYPE(domain) , POINTER                      :: parent
    215. 

  215.    INTEGER, INTENT(IN)                         :: newid
    216. 

  216.    TYPE (grid_config_rec_type) , INTENT(INOUT) :: config_flags
    217. 

  217.    TYPE (grid_config_rec_type)                 :: nest_config_flags
    218. 

  218. 

  219.   ! Local
    220. 

  220.    INTEGER                :: itmp, fid, ierr, icnt
    221. 

  221.    CHARACTER*256          :: rstname, message, timestr
    222. 

  222. 

  223.    TYPE(WRFU_Time)        :: strt_time, cur_time
    224. 

  224. 

  225. #ifdef MOVE_NESTS
    226. 

  226. 

  227.    CALL domain_clock_get( parent, current_timestr=timestr, start_time=strt_time, current_time=cur_time )
    228. 

  228.    CALL construct_filename2a ( rstname , config_flags%rst_inname , newid , 2 , timestr )
    229. 

  229. 

  230. #ifdef ESMFIO
    231. 

  231.     IF ( config_flags%restart .AND. (cur_time .EQ. strt_time) ) THEN
    232. 

  232. #else
    233. 

  233.     IF ( config_flags%restart .AND. WRFU_TimeEQ(cur_time,strt_time) ) THEN
    234. 

  234. #endif
    235. 

  235.      WRITE(message,*)'RESTART: nest, opening ',TRIM(rstname),' for reading header information only'
    236. 

  236.      CALL wrf_message ( message )
    237. 

  237.   ! note that the parent pointer is not strictly correct, but nest is not allocated yet and
    238. 

  238.   ! only the i/o communicator fields are used from "parent" (and those are dummies in current
    239. 

  239.   ! implementation.
    240. 

  240.      CALL open_r_dataset ( fid , TRIM(rstname) , parent , config_flags , "DATASET=RESTART", ierr )
    241. 

  241.      IF ( ierr .NE. 0 ) THEN
    242. 

  242.        WRITE( message , '("program wrf: error opening ",A32," for reading")') TRIM(rstname)
    243. 

  243.        CALL WRF_ERROR_FATAL ( message )
    244. 

  244.      ENDIF
    245. 

  245. 

  246.   ! update the values of parent_start that were read in from the namelist (nest may have moved)
    247. 

  247.      CALL wrf_get_dom_ti_integer ( fid , 'I_PARENT_START' ,  itmp  , 1 , icnt, ierr )
    248. 

  248.      IF ( ierr .EQ. 0 ) THEN
    249. 

  249.        config_flags%i_parent_start = itmp
    250. 

  250.        CALL nl_set_i_parent_start ( newid , config_flags%i_parent_start )
    251. 

  251.      ENDIF
    252. 

  252.      CALL wrf_get_dom_ti_integer ( fid , 'J_PARENT_START' ,  itmp  , 1 , icnt, ierr )
    253. 

  253.      IF ( ierr .EQ. 0 ) THEN
    254. 

  254.        config_flags%j_parent_start = itmp
    255. 

  255.        CALL nl_set_j_parent_start ( newid , config_flags%j_parent_start )
    256. 

  256.      ENDIF
    257. 

  257. 

  258.      CALL close_dataset ( fid , config_flags , "DATASET=RESTART" )
    259. 

  259.    ENDIF
    260. 

  260. #endif
    261. 

  261. 

  262. END SUBROUTINE med_pre_nest_initial
    263. 

  263. 

  264. 

  265. SUBROUTINE med_nest_initial ( parent , nest , config_flags )
    266. 

  266.   ! Driver layer
    267. 

  267.    USE module_domain	, ONLY : domain , domain_clock_get , get_ijk_from_grid
    268. 

  268.    USE module_timing
    269. 

  269.    USE module_io_domain
    270. 

  270.    USE module_configure	, ONLY : grid_config_rec_type
    271. 

  271.    USE module_utility
    272. 

  272.   ! Model layer
    273. 

  273. 

  274.    IMPLICIT NONE
    275. 

  275. 

  276.   ! Arguments
    277. 

  277.    TYPE(domain) , POINTER                     :: parent, nest
    278. 

  278.    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
    279. 

  279.    TYPE (grid_config_rec_type)                :: nest_config_flags
    280. 

  280. 

  281.   ! Local
    282. 

  282.    LOGICAL, EXTERNAL      :: wrf_dm_on_monitor
    283. 

  283.    TYPE(WRFU_Time)        :: strt_time, cur_time
    284. 

  284.    CHARACTER * 80         :: rstname , timestr
    285. 

  285.    CHARACTER * 256        :: message
    286. 

  286.    INTEGER                :: fid
    287. 

  287.    INTEGER                :: ierr
    288. 

  288.    INTEGER                :: i , j, rc
    289. 

  289.    INTEGER                :: ids , ide , jds , jde , kds , kde , &
    290. 

  290.                              ims , ime , jms , jme , kms , kme , &
    291. 

  291.                              ips , ipe , jps , jpe , kps , kpe
    292. 

  292. 

  293. #if (EM_CORE == 1)
    294. 

  294. #ifdef MOVE_NESTS
    295. 

  295.    TYPE (WRFU_TimeInterval) :: interval, TimeSinceStart
    296. 

  296.    INTEGER :: vortex_interval , n
    297. 

  297. #endif
    298. 

  298.    INTEGER                :: save_itimestep ! This is a kludge, correct fix will 
    299. 

  299.                                             ! involve integrating the time-step
    300. 

  300.                                             ! counting into the time manager.
    301. 

  301.                                             ! JM 20040604
    302. 

  302.    REAL, ALLOCATABLE, DIMENSION(:,:) ::   save_acsnow             &
    303. 

  303.                                          ,save_acsnom             &
    304. 

  304.                                          ,save_cuppt              &
    305. 

  305.                                          ,save_rainc              &
    306. 

  306.                                          ,save_rainnc             &
    307. 

  307.                                          ,save_sfcevp             &
    308. 

  308.                                          ,save_sfcrunoff          &
    309. 

  309.                                          ,save_udrunoff
    310. 

  310. 

  311. 

  312.    INTERFACE
    313. 

  313.      SUBROUTINE med_interp_domain ( parent , nest )
    314. 

  314.         USE module_domain	, ONLY : domain
    315. 

  315.         TYPE(domain) , POINTER                 :: parent , nest
    316. 

  316.      END SUBROUTINE med_interp_domain
    317. 

  317. 

  318.      SUBROUTINE med_initialdata_input_ptr( nest , config_flags )
    319. 

  319.         USE module_domain	, ONLY : domain
    320. 

  320.         USE module_configure	, ONLY : grid_config_rec_type
    321. 

  321.         TYPE (grid_config_rec_type), INTENT(IN) :: config_flags
    322. 

  322.         TYPE(domain) , POINTER :: nest
    323. 

  323.      END SUBROUTINE med_initialdata_input_ptr
    324. 

  324. 

  325.      SUBROUTINE med_nest_feedback ( parent , nest , config_flags )
    326. 

  326.        USE module_domain	, ONLY : domain
    327. 

  327.        USE module_configure	, ONLY : grid_config_rec_type
    328. 

  328.        TYPE (domain), POINTER ::  nest , parent
    329. 

  329.        TYPE (grid_config_rec_type), INTENT(IN) :: config_flags
    330. 

  330.      END SUBROUTINE med_nest_feedback
    331. 

  331. 

  332.      SUBROUTINE start_domain ( grid , allowed_to_move )
    333. 

  333.         USE module_domain	, ONLY : domain
    334. 

  334.         TYPE(domain) :: grid
    335. 

  335.         LOGICAL, INTENT(IN) :: allowed_to_move
    336. 

  336.      END SUBROUTINE start_domain
    337. 

  337. 

  338.      SUBROUTINE  blend_terrain ( ter_interpolated , ter_input , &
    339. 

  339.                            ids , ide , jds , jde , kds , kde , &
    340. 

  340.                            ims , ime , jms , jme , kms , kme , &
    341. 

  341.                            ips , ipe , jps , jpe , kps , kpe )
    342. 

  342.        INTEGER                           :: ids , ide , jds , jde , kds , kde , &
    343. 

  343.                                             ims , ime , jms , jme , kms , kme , &
    344. 

  344.                                             ips , ipe , jps , jpe , kps , kpe
    345. 

  345.        REAL , DIMENSION(ims:ime,jms:jme) :: ter_interpolated
    346. 

  346.        REAL , DIMENSION(ims:ime,jms:jme) :: ter_input
    347. 

  347.      END SUBROUTINE blend_terrain
    348. 

  348. 

  349.      SUBROUTINE  copy_3d_field ( ter_interpolated , ter_input , &
    350. 

  350.                            ids , ide , jds , jde , kds , kde , &
    351. 

  351.                            ims , ime , jms , jme , kms , kme , &
    352. 

  352.                            ips , ipe , jps , jpe , kps , kpe )
    353. 

  353.        INTEGER                           :: ids , ide , jds , jde , kds , kde , &
    354. 

  354.                                             ims , ime , jms , jme , kms , kme , &
    355. 

  355.                                             ips , ipe , jps , jpe , kps , kpe
    356. 

  356.        REAL , DIMENSION(ims:ime,jms:jme) :: ter_interpolated
    357. 

  357.        REAL , DIMENSION(ims:ime,jms:jme) :: ter_input
    358. 

  358.      END SUBROUTINE copy_3d_field
    359. 

  359. 

  360.      SUBROUTINE  input_terrain_rsmas ( grid ,                  &
    361. 

  361.                            ids , ide , jds , jde , kds , kde , &
    362. 

  362.                            ims , ime , jms , jme , kms , kme , &
    363. 

  363.                            ips , ipe , jps , jpe , kps , kpe )
    364. 

  364.        USE module_domain	, ONLY : domain
    365. 

  365.        TYPE ( domain ) :: grid
    366. 

  366.        INTEGER                           :: ids , ide , jds , jde , kds , kde , &
    367. 

  367.                                             ims , ime , jms , jme , kms , kme , &
    368. 

  368.                                             ips , ipe , jps , jpe , kps , kpe
    369. 

  369.      END SUBROUTINE input_terrain_rsmas
    370. 

  370. 

  371.      SUBROUTINE wrf_tsin ( grid , ierr )
    372. 

  372.         USE module_domain
    373. 

  373.         TYPE ( domain ), INTENT(INOUT) :: grid
    374. 

  374.         INTEGER, INTENT(INOUT) :: ierr
    375. 

  375.      END SUBROUTINE wrf_tsin
    376. 

  376. 

  377.    END INTERFACE
    378. 

  378. 

  379.    CALL domain_clock_get( parent, start_time=strt_time, current_time=cur_time )
    380. 

  380. 

  381.    IF ( .not. ( config_flags%restart .AND. strt_time .EQ. cur_time ) ) THEN
    382. 

  382.      nest%first_force = .true.
    383. 

  383. 

  384. ! initialize nest with interpolated data from the parent
    385. 

  385.      nest%imask_nostag = 1
    386. 

  386.      nest%imask_xstag = 1
    387. 

  387.      nest%imask_ystag = 1
    388. 

  388.      nest%imask_xystag = 1
    389. 

  389. 

  390. #ifdef MOVE_NESTS
    391. 

  391.      parent%nest_pos = parent%ht
    392. 

  392.      where ( parent%nest_pos .gt. 0. ) parent%nest_pos = parent%nest_pos + 500.  ! make a cliff
    393. 

  393. #endif
    394. 

  394. 

  395. ! initialize some other constants (and 1d arrays in z)
    396. 

  396.      CALL init_domain_constants ( parent, nest )
    397. 

  397. 

  398. ! fill in entire fine grid domain with interpolated coarse grid data
    399. 

  399.      CALL med_interp_domain( parent, nest )
    400. 

  400. 

  401. !  De-reference dimension information stored in the grid data structure.
    402. 

  402.      CALL get_ijk_from_grid (  nest ,                   &
    403. 

  403.                                ids, ide, jds, jde, kds, kde,    &
    404. 

  404.                                ims, ime, jms, jme, kms, kme,    &
    405. 

  405.                                ips, ipe, jps, jpe, kps, kpe    )
    406. 

  406.   
    407. 

  407. ! get the nest config flags
    408. 

  408.      CALL model_to_grid_config_rec ( nest%id , model_config_rec , nest_config_flags )
    409. 

  409. 

  410.      IF ( nest_config_flags%input_from_file .OR. nest_config_flags%input_from_hires ) THEN
    411. 

  411. 

  412.        WRITE(message,FMT='(A,I2,A)') '*** Initializing nest domain #',nest%id,&
    413. 

  413.                                       ' from an input file. ***'
    414. 

  414.        CALL wrf_debug ( 0 , message )
    415. 

  415. 

  416. ! Store horizontally interpolated terrain-based fields in temp location if the input
    417. 

  417. ! data is from a pristine, un-cycled model input file.  For the original topo from
    418. 

  418. ! the real program, we will need to adjust the terrain (and a couple of other base-
    419. 

  419. ! state fields) so reflect the smoothing and matching between the parent and child
    420. 

  420. ! domains.
    421. 

  421. 

  422.        CALL  copy_3d_field ( nest%ht_int  , nest%ht , &
    423. 

  423.                              ids , ide , jds , jde , 1   , 1   , &
    424. 

  424.                              ims , ime , jms , jme , 1   , 1   , &
    425. 

  425.                              ips , ipe , jps , jpe , 1   , 1   )
    426. 

  426.        CALL  copy_3d_field ( nest%mub_fine , nest%mub , &
    427. 

  427.                              ids , ide , jds , jde , 1   , 1   , &
    428. 

  428.                              ims , ime , jms , jme , 1   , 1   , &
    429. 

  429.                              ips , ipe , jps , jpe , 1   , 1   )
    430. 

  430.        CALL  copy_3d_field ( nest%phb_fine , nest%phb , &
    431. 

  431.                              ids , ide , jds , jde , kds , kde , &
    432. 

  432.                              ims , ime , jms , jme , kms , kme , &
    433. 

  433.                              ips , ipe , jps , jpe , kps , kpe )
    434. 

  434. 

  435.        IF ( nest_config_flags%input_from_file ) THEN
    436. 

  436. ! read input from dataset
    437. 

  437.           CALL med_initialdata_input_ptr( nest , nest_config_flags )
    438. 

  438. 

  439.        ELSE IF ( nest_config_flags%input_from_hires ) THEN
    440. 

  440. ! read in high res topography
    441. 

  441.           CALL  input_terrain_rsmas ( nest,                               &
    442. 

  442.                                       ids , ide , jds , jde , 1   , 1   , &
    443. 

  443.                                       ims , ime , jms , jme , 1   , 1   , &
    444. 

  444.                                       ips , ipe , jps , jpe , 1   , 1   )
    445. 

  445.        ENDIF
    446. 

  446. 

  447.        ! save elevation and mub for temp and qv adjustment
    448. 

  448. 

  449.        CALL  copy_3d_field ( nest%ht_fine , nest%ht , &
    450. 

  450.                              ids , ide , jds , jde , 1   , 1   , &
    451. 

  451.                              ims , ime , jms , jme , 1   , 1   , &
    452. 

  452.                              ips , ipe , jps , jpe , 1   , 1   )
    453. 

  453.        CALL  copy_3d_field ( nest%mub_save , nest%mub , &
    454. 

  454.                              ids , ide , jds , jde , 1   , 1   , &
    455. 

  455.                              ims , ime , jms , jme , 1   , 1   , &
    456. 

  456.                              ips , ipe , jps , jpe , 1   , 1   )
    457. 

  457. 

  458. ! blend parent and nest fields: terrain, mub, and phb.  The ht, mub and phb are used in start_domain.
    459. 

  459. 

  460.        IF ( nest%save_topo_from_real == 1 ) THEN
    461. 

  461.           CALL  blend_terrain ( nest%ht_int  , nest%ht , &
    462. 

  462.                                 ids , ide , jds , jde , 1   , 1   , &
    463. 

  463.                                 ims , ime , jms , jme , 1   , 1   , &
    464. 

  464.                                 ips , ipe , jps , jpe , 1   , 1   )
    465. 

  465.           CALL  blend_terrain ( nest%mub_fine , nest%mub , &
    466. 

  466.                                 ids , ide , jds , jde , 1   , 1   , &
    467. 

  467.                                 ims , ime , jms , jme , 1   , 1   , &
    468. 

  468.                                 ips , ipe , jps , jpe , 1   , 1   )
    469. 

  469.           CALL  blend_terrain ( nest%phb_fine , nest%phb , &
    470. 

  470.                                 ids , ide , jds , jde , kds , kde , &
    471. 

  471.                                 ims , ime , jms , jme , kms , kme , &
    472. 

  472.                                 ips , ipe , jps , jpe , kps , kpe )
    473. 

  473.        ENDIF
    474. 

  474. 

  475.        !  adjust temp and qv
    476. 

  476. 

  477.        CALL adjust_tempqv ( nest%mub , nest%mub_save , &
    478. 

  478.                             nest%znw , nest%p_top , &
    479. 

  479.                             nest%t_2 , nest%p , nest%moist(ims,kms,jms,P_QV) , &
    480. 

  480.                             ids , ide , jds , jde , kds , kde , &
    481. 

  481.                             ims , ime , jms , jme , kms , kme , &
    482. 

  482.                             ips , ipe , jps , jpe , kps , kpe )
    483. 

  483. 

  484.      ELSE
    485. 

  485.        WRITE(message,FMT='(A,I2,A,I2,A)') '*** Initializing nest domain #',nest%id,&
    486. 

  486.                                      ' by horizontally interpolating parent domain #' ,parent%id, &
    487. 

  487.                                      '. ***'
    488. 

  488.        CALL wrf_debug ( 0 , message )
    489. 

  489. 

  490. #if (DA_CORE != 1)
    491. 

  491.        ! For nests without an input file, we still need to read time series locations
    492. 

  492.        !   from the tslist file
    493. 

  493.        CALL wrf_tsin( nest , ierr )
    494. 

  494. #endif
    495. 

  495.      END IF
    496. 

  496. 

  497. 

  498. ! feedback, mostly for this new terrain, but it is the safe thing to do
    499. 

  499.      parent%ht_coarse = parent%ht
    500. 

  500. 

  501.      CALL med_nest_feedback ( parent , nest , config_flags )
    502. 

  502. 

  503. ! set some other initial fields, fill out halos, base fields; re-do parent due
    504. 

  504. ! to new terrain elevation from feedback
    505. 

  505.      nest%imask_nostag = 1
    506. 

  506.      nest%imask_xstag = 1
    507. 

  507.      nest%imask_ystag = 1
    508. 

  508.      nest%imask_xystag = 1
    509. 

  509.      nest%press_adj = .TRUE.
    510. 

  510.      CALL start_domain ( nest , .TRUE. )
    511. 

  511. ! kludge: 20040604
    512. 

  512.      CALL get_ijk_from_grid (  parent ,                   &
    513. 

  513.                                ids, ide, jds, jde, kds, kde,    &
    514. 

  514.                                ims, ime, jms, jme, kms, kme,    &
    515. 

  515.                                ips, ipe, jps, jpe, kps, kpe    )
    516. 

  516.   
    517. 

  517.      ALLOCATE( save_acsnow(ims:ime,jms:jme) )
    518. 

  518.      ALLOCATE( save_acsnom(ims:ime,jms:jme) )
    519. 

  519.      ALLOCATE( save_cuppt(ims:ime,jms:jme) )
    520. 

  520.      ALLOCATE( save_rainc(ims:ime,jms:jme) )
    521. 

  521.      ALLOCATE( save_rainnc(ims:ime,jms:jme) )
    522. 

  522.      ALLOCATE( save_sfcevp(ims:ime,jms:jme) )
    523. 

  523.      ALLOCATE( save_sfcrunoff(ims:ime,jms:jme) )
    524. 

  524.      ALLOCATE( save_udrunoff(ims:ime,jms:jme) )
    525. 

  525.      save_acsnow       = parent%acsnow
    526. 

  526.      save_acsnom       = parent%acsnom
    527. 

  527.      save_cuppt        = parent%cuppt
    528. 

  528.      save_rainc        = parent%rainc
    529. 

  529.      save_rainnc       = parent%rainnc
    530. 

  530.      save_sfcevp       = parent%sfcevp
    531. 

  531.      save_sfcrunoff    = parent%sfcrunoff
    532. 

  532.      save_udrunoff     = parent%udrunoff
    533. 

  533.      save_itimestep    = parent%itimestep
    534. 

  534.      parent%imask_nostag = 1
    535. 

  535.      parent%imask_xstag = 1
    536. 

  536.      parent%imask_ystag = 1
    537. 

  537.      parent%imask_xystag = 1
    538. 

  538. 

  539.      parent%press_adj = .FALSE.
    540. 

  540.      CALL start_domain ( parent , .TRUE. )
    541. 

  541. 

  542.      parent%acsnow     = save_acsnow
    543. 

  543.      parent%acsnom     = save_acsnom
    544. 

  544.      parent%cuppt      = save_cuppt
    545. 

  545.      parent%rainc      = save_rainc
    546. 

  546.      parent%rainnc     = save_rainnc
    547. 

  547.      parent%sfcevp     = save_sfcevp
    548. 

  548.      parent%sfcrunoff  = save_sfcrunoff
    549. 

  549.      parent%udrunoff   = save_udrunoff
    550. 

  550.      parent%itimestep  = save_itimestep
    551. 

  551.      DEALLOCATE( save_acsnow )
    552. 

  552.      DEALLOCATE( save_acsnom )
    553. 

  553.      DEALLOCATE( save_cuppt )
    554. 

  554.      DEALLOCATE( save_rainc )
    555. 

  555.      DEALLOCATE( save_rainnc )
    556. 

  556.      DEALLOCATE( save_sfcevp )
    557. 

  557.      DEALLOCATE( save_sfcrunoff )
    558. 

  558.      DEALLOCATE( save_udrunoff )
    559. 

  559. ! end of kludge: 20040604
    560. 

  560. 

  561. 

  562.   ELSE  ! restart
    563. 

  563. 

  564.      IF ( wrf_dm_on_monitor() ) CALL start_timing
    565. 

  565. 

  566.      CALL domain_clock_get( nest, current_timestr=timestr )
    567. 

  567.      CALL construct_filename2a ( rstname , config_flags%rst_inname , nest%id , 2 , timestr )
    568. 

  568. 

  569.      WRITE(message,*)'RESTART: nest, opening ',TRIM(rstname),' for reading'
    570. 

  570.      CALL wrf_message ( message )
    571. 

  571.      CALL model_to_grid_config_rec ( nest%id , model_config_rec , nest_config_flags )
    572. 

  572.      CALL open_r_dataset ( fid , TRIM(rstname) , nest , nest_config_flags , "DATASET=RESTART", ierr )
    573. 

  573.      IF ( ierr .NE. 0 ) THEN
    574. 

  574.        WRITE( message , '("program wrf: error opening ",A32," for reading")') TRIM(rstname)
    575. 

  575.        CALL WRF_ERROR_FATAL ( message )
    576. 

  576.      ENDIF
    577. 

  577.      CALL input_restart ( fid,   nest , nest_config_flags , ierr )
    578. 

  578.      CALL close_dataset ( fid , nest_config_flags , "DATASET=RESTART" )
    579. 

  579. 

  580.      IF ( wrf_dm_on_monitor() ) THEN
    581. 

  581.        WRITE ( message , FMT = '("processing restart file for domain ",I8)' ) nest%id
    582. 

  582.        CALL end_timing ( TRIM(message) )
    583. 

  583.      ENDIF
    584. 

  584. 

  585.      nest%imask_nostag = 1
    586. 

  586.      nest%imask_xstag = 1
    587. 

  587.      nest%imask_ystag = 1
    588. 

  588.      nest%imask_xystag = 1
    589. 

  589.      nest%press_adj = .FALSE.
    590. 

  590.      CALL start_domain ( nest , .TRUE. )
    591. 

  591. #ifndef MOVE_NESTS
    592. 

  592. ! this doesn't need to be done for moving nests, since ht_coarse is part of the restart
    593. 

  593.      parent%ht_coarse = parent%ht
    594. 

  594. #else
    595. 

  595. #  if 1
    596. 

  596. ! In case of a restart, assume that the movement has already occurred in the previous
    597. 

  597. ! run and turn off the alarm for the starting time. We must impose a requirement that the
    598. 

  598. ! run be restarted on-interval.  Test for that and print a warning if it isn't.
    599. 

  599. ! Note, simulation_start, etc. should be available as metadata in the restart file, and
    600. 

  600. ! these will have gotten, set, and retrievable as rconfig data been set in share/input_wrf.F
    601. 

  601. ! using the nl_get routines below.  JM 20060314
    602. 

  602. 

  603.      CALL nl_get_vortex_interval ( nest%id , vortex_interval )
    604. 

  604.      CALL WRFU_TimeIntervalSet( interval, M=vortex_interval, rc=rc )
    605. 

  605. 

  606.      CALL domain_clock_get( nest, timeSinceSimulationStart=TimeSinceStart )
    607. 

  607.      n = WRFU_TimeIntervalDIVQuot( TimeSinceStart , interval )
    608. 

  608.      IF ( ( interval * n ) .NE. TimeSinceStart ) THEN
    609. 

  609.        CALL wrf_message('WARNING: Restart is not on a vortex_interval time boundary.')
    610. 

  610.        CALL wrf_message('The code will work but results will not agree exactly with a ')
    611. 

  611.        CALL wrf_message('a run that was done straight-through, without a restart.') 
    612. 

  612.      ENDIF
    613. 

  613. !! In case of a restart, assume that the movement has already occurred in the previous
    614. 

  614. !! run and turn off the alarm for the starting time. We must impose a requirement that the
    615. 

  615. !! run be restarted on-interval.  Test for that and print a warning if it isn't.
    616. 

  616. !! Note, simulation_start, etc. should be available as metadata in the restart file, and
    617. 

  617. !! these will have gotten, set, and retrievable as rconfig data been set in share/input_wrf.F
    618. 

  618. !! using the nl_get routines below.  JM 20060314
    619. 

  619. !     CALL WRFU_AlarmRingerOff( nest%alarms( COMPUTE_VORTEX_CENTER_ALARM ), rc=rc )
    620. 

  620. 

  621. #  else
    622. 

  622. ! this code, currently commented out, is an attempt to have the
    623. 

  623. ! vortex centering interval be set according to simulation start
    624. 

  624. ! time (rather than run start time) in case of a restart. But
    625. 

  625. ! there are other problems (the WRF clock is currently using
    626. 

  626. ! run-start as it's start time) so the alarm still would not fire
    627. 

  627. ! right if the model were started off-interval.  Leave it here and
    628. 

  628. ! enable when the clock is changed to use sim-start for start time.
    629. 

  629. ! JM 20060314
    630. 

  630.      CALL nl_get_vortex_interval ( nest%id , vortex_interval )
    631. 

  631.      CALL WRFU_TimeIntervalSet( interval, M=vortex_interval, rc=rc )
    632. 

  632. 

  633.      CALL domain_clock_get( nest, timeSinceSimulationStart=TimeSinceStart )
    634. 

  634. 

  635.      CALL domain_alarm_create( nest,  COMPUTE_VORTEX_CENTER_ALARM, interval  )
    636. 

  636.      CALL WRFU_AlarmEnable( nest%alarms( COMPUTE_VORTEX_CENTER_ALARM ), rc=rc )
    637. 

  637.      n = WRFU_TimeIntervalDIVQuot( TimeSinceStart , interval )
    638. 

  638.      IF ( ( interval * n ) .EQ. TimeSinceStart ) THEN
    639. 

  639.        CALL WRFU_AlarmRingerOn( nest%alarms( COMPUTE_VORTEX_CENTER_ALARM ), rc=rc )
    640. 

  640.      ELSE 
    641. 

  641.        CALL WRFU_AlarmRingerOff( nest%alarms( COMPUTE_VORTEX_CENTER_ALARM ), rc=rc )
    642. 

  642.      ENDIF
    643. 

  643. #  endif
    644. 

  644. #endif
    645. 

  645. 

  646.   ENDIF
    647. 

  647. 

  648. #endif
    649. 

  649. 

  650. #if (NMM_CORE == 1 && NMM_NEST == 1)
    651. 

  651. !===================================================================================
    652. 

  652. !  Added for the NMM core. This is gopal's doing.
    653. 

  653. !===================================================================================
    654. 

  654. 

  655.    INTERFACE
    656. 

  656. 

  657.      SUBROUTINE med_nest_egrid_configure ( parent , nest )
    658. 

  658.         USE module_domain	, ONLY : domain
    659. 

  659.         TYPE(domain) , POINTER                 :: parent , nest
    660. 

  660.      END SUBROUTINE med_nest_egrid_configure 
    661. 

  661. 

  662.      SUBROUTINE med_construct_egrid_weights ( parent , nest )
    663. 

  663.         USE module_domain	, ONLY : domain
    664. 

  664.         TYPE(domain) , POINTER                 :: parent , nest
    665. 

  665.      END SUBROUTINE med_construct_egrid_weights
    666. 

  666. 

  667.      SUBROUTINE BASE_STATE_PARENT ( Z3d,Q3d,T3d,PSTD,        &
    668. 

  668.                                     PINT,T,Q,CWM,            &
    669. 

  669.                                     FIS,QSH,PD,PDTOP,PTOP,   &
    670. 

  670.                                     ETA1,ETA2,               &
    671. 

  671.                                     DETA1,DETA2,             &
    672. 

  672.                                     IDS,IDE,JDS,JDE,KDS,KDE, &
    673. 

  673.                                     IMS,IME,JMS,JME,KMS,KME, &
    674. 

  674.                                     IPS,IPE,JPS,JPE,KPS,KPE  )
    675. 

  675. !
    676. 

  676. 

  677.          USE MODULE_MODEL_CONSTANTS
    678. 

  678.          IMPLICIT NONE
    679. 

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

  680.          INTEGER,    INTENT(IN   )                            :: IMS,IME,JMS,JME,KMS,KME
    681. 

  681.          INTEGER,    INTENT(IN   )                            :: IPS,IPE,JPS,JPE,KPS,KPE
    682. 

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

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

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

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

  686.          REAL, DIMENSION(KMS:KME)                , INTENT(OUT):: PSTD
    687. 

  687.          REAL, DIMENSION(IMS:IME,JMS:JME,KMS:KME), INTENT(OUT):: Z3d,Q3d,T3d
    688. 

  688. 

  689.      END SUBROUTINE BASE_STATE_PARENT
    690. 

  690. 

  691.      SUBROUTINE NEST_TERRAIN ( nest, config_flags )
    692. 

  692.        USE module_domain	, ONLY : domain
    693. 

  693.        USE module_configure	, ONLY : grid_config_rec_type
    694. 

  694.        TYPE(domain) , POINTER                        :: nest
    695. 

  695.        TYPE(grid_config_rec_type) , INTENT(IN)       :: config_flags
    696. 

  696.      END SUBROUTINE NEST_TERRAIN
    697. 

  697. 

  698.     SUBROUTINE med_interp_domain ( parent , nest )
    699. 

  699.         USE module_domain	, ONLY : domain
    700. 

  700.         TYPE(domain) , POINTER                 :: parent , nest
    701. 

  701.     END SUBROUTINE med_interp_domain
    702. 

  702. 

  703.     SUBROUTINE med_init_domain_constants_nmm ( parent, nest )
    704. 

  704.         USE module_domain	, ONLY : domain
    705. 

  705.         TYPE(domain) , POINTER                    :: parent , nest
    706. 

  706.     END SUBROUTINE med_init_domain_constants_nmm
    707. 

  707. 

  708.     SUBROUTINE start_domain ( grid , allowed_to_move )
    709. 

  709.         USE module_domain	, ONLY : domain
    710. 

  710.         TYPE(domain) :: grid
    711. 

  711.         LOGICAL, INTENT(IN) :: allowed_to_move
    712. 

  712.     END SUBROUTINE start_domain
    713. 

  713. 

  714.    END INTERFACE
    715. 

  715. 

  716. #ifdef HWRF
    717. 

  717. !zhang's doing test
    718. 

  718.    if (config_flags%restart .or. nest%analysis) then
    719. 

  719.    nest%first_force = .true.
    720. 

  720.    else
    721. 

  721.    nest%first_force = .false.
    722. 

  722.    endif
    723. 

  723. !end of zhang's doing
    724. 

    725. 

  725. !zhang's doing for analysis option
    726. 

  726.   IF(.not. nest%analysis .and. .not. config_flags%restart)THEN    ! initialize for cold-start
    727. 

  727. #endif
    728. 

  728. 

  729. !----------------------------------------------------------------------------
    730. 

  730. !  initialize nested domain configurations including setting up wbd,sbd, etc 
    731. 

  731. !----------------------------------------------------------------------------
    732. 

  732. 

  733.    CALL med_nest_egrid_configure ( parent , nest )
    734. 

  734. 

  735. !-------------------------------------------------------------------------
    736. 

  736. !  initialize lat-lons and determine weights 
    737. 

  737. !-------------------------------------------------------------------------
    738. 

  738. 

  739.     CALL med_construct_egrid_weights ( parent, nest )
    740. 

  740. !
    741. 

  741. !
    742. 

  742. !  De-reference dimension information stored in the grid data structure.
    743. 

  743. !
    744. 

  744. !  From the hybrid, construct the GPMs on isobaric surfaces and then interpolate those
    745. 

  745. !  values on to the nested domain. 23 standard prssure levels are assumed here. For
    746. 

  746. !  levels below ground, lapse rate atmosphere is assumed before the use of vertical
    747. 

  747. !  spline interpolation 
    748. 

  748. !
    749. 

  749. 

  750. 

  751.     IDS = parent%sd31
    752. 

  752.     IDE = parent%ed31
    753. 

  753.     JDS = parent%sd32
    754. 

  754.     JDE = parent%ed32
    755. 

  755.     KDS = parent%sd33
    756. 

  756.     KDE = parent%ed33
    757. 

  757. 

  758.     IMS = parent%sm31
    759. 

  759.     IME = parent%em31
    760. 

  760.     JMS = parent%sm32
    761. 

  761.     JME = parent%em32
    762. 

  762.     KMS = parent%sm33
    763. 

  763.     KME = parent%em33
    764. 

  764. 

  765.     IPS = parent%sp31
    766. 

  766.     IPE = parent%ep31
    767. 

  767.     JPS = parent%sp32
    768. 

  768.     JPE = parent%ep32
    769. 

  769.     KPS = parent%sp33
    770. 

  770.     KPE = parent%ep33
    771. 

  771. 

  772.     CALL BASE_STATE_PARENT ( parent%Z3d,parent%Q3d,parent%T3d,parent%PSTD,  &
    773. 

  773.                              parent%PINT,parent%T,parent%Q,parent%CWM,      &
    774. 

  774.                              parent%FIS,parent%QSH,parent%PD,parent%pdtop,parent%pt,   &
    775. 

  775.                              parent%ETA1,parent%ETA2,                               &
    776. 

  776.                              parent%DETA1,parent%DETA2,                             &
    777. 

  777.                              IDS,IDE,JDS,JDE,KDS,KDE,                                       &
    778. 

  778.                              IMS,IME,JMS,JME,KMS,KME,                                       &
    779. 

  779.                              IPS,IPE,JPS,JPE,KPS,KPE                                        )
    780. 

  780. 

  781. !  
    782. 

  782. !   Set new terrain. Since some terrain adjustment is done within the interpolation calls
    783. 

  783. !   at the next step, the new terrain over the nested domain has to be called here.
    784. 

  784. !
    785. 

  785.     IDS = nest%sd31
    786. 

  786.     IDE = nest%ed31
    787. 

  787.     JDS = nest%sd32
    788. 

  788.     JDE = nest%ed32
    789. 

  789.     KDS = nest%sd33
    790. 

  790.     KDE = nest%ed33
    791. 

  791. 

  792.     IMS = nest%sm31
    793. 

  793.     IME = nest%em31
    794. 

  794.     JMS = nest%sm32
    795. 

  795.     JME = nest%em32
    796. 

  796.     KMS = nest%sm33
    797. 

  797.     KME = nest%em33
    798. 

  798. 

  799.     IPS = nest%sp31
    800. 

  800.     IPE = nest%ep31
    801. 

  801.     JPS = nest%sp32
    802. 

  802.     JPE = nest%ep32
    803. 

  803.     KPS = nest%sp33
    804. 

  804.     KPE = nest%ep33
    805. 

  805. 

  806. 

  807.     CALL NEST_TERRAIN ( nest, config_flags )
    808. 

  808. 

  809. !   Initialize some more constants required especially for terrain adjustment processes
    810. 

  810. 

  811.     nest%PSTD=parent%PSTD
    812. 

  812.     nest%KZMAX=KME
    813. 

  813.     parent%KZMAX=KME  ! just for safety
    814. 

  814. 

  815.     DO J = JPS, MIN(JPE,JDE-1)
    816. 

  816.       DO I = IPS, MIN(IPE,IDE-1)
    817. 

  817.        nest%fis(I,J)=nest%hres_fis(I,J)
    818. 

  818.      ENDDO
    819. 

  819.     ENDDO
    820. 

  820. 

  821. !--------------------------------------------------------------------------
    822. 

  822. !  interpolation call
    823. 

  823. !--------------------------------------------------------------------------
    824. 

  824. 

  825. ! initialize nest with interpolated data from the parent
    826. 

  826. 

  827.     nest%imask_nostag = 0 
    828. 

  828.     nest%imask_xstag  = 0 
    829. 

  829.     nest%imask_ystag  = 0 
    830. 

  830.     nest%imask_xystag = 0 
    831. 

  831. 

  832. #ifdef HWRF
    833. 

  833.    CALL med_interp_domain( parent, nest )
    834. 

  834. #else
    835. 

  835.     CALL domain_clock_get( parent, start_time=strt_time, current_time=cur_time )
    836. 

  836. 

  837.     IF ( .not. ( config_flags%restart .AND. strt_time .EQ. cur_time ) ) THEN
    838. 

  838. 

  839.      CALL med_interp_domain( parent, nest )
    840. 

  840. 

  841.     ELSE
    842. 

  842. 

  843.      CALL domain_clock_get( nest, current_timestr=timestr )
    844. 

  844.      CALL construct_filename2a ( rstname , config_flags%rst_inname , nest%id , 2 , timestr )
    845. 

  845. 

  846.      WRITE(message,*)'RESTART: nest, opening ',TRIM(rstname),' for reading'
    847. 

  847.      CALL wrf_message ( message )
    848. 

  848.      CALL model_to_grid_config_rec ( nest%id , model_config_rec , nest_config_flags )
    849. 

  849.      CALL open_r_dataset ( fid , TRIM(rstname) , nest , nest_config_flags , "DATASET=RESTART", ierr )
    850. 

  850.      IF ( ierr .NE. 0 ) THEN
    851. 

  851.        WRITE( message , '("program wrf: error opening ",A32," for reading")') TRIM(rstname)
    852. 

  852.        CALL WRF_ERROR_FATAL ( message )
    853. 

  853.      ENDIF
    854. 

  854.      CALL input_restart ( fid,   nest , nest_config_flags , ierr )
    855. 

  855.      CALL close_dataset ( fid , nest_config_flags , "DATASET=RESTART" )
    856. 

  856. 

  857.     END IF
    858. 

  858. 

  859. #endif
    860. 

  860. !------------------------------------------------------------------------------
    861. 

  861. !  set up constants (module_initialize_real.F for nested nmm domain)
    862. 

  862. !-----------------------------------------------------------------------------
    863. 

  863. 

  864.     CALL med_init_domain_constants_nmm ( parent, nest )
    865. 

  865. 

  866. !--------------------------------------------------------------------------------------
    867. 

  867. ! set some other initial fields, fill out halos, etc. 
    868. 

  868. !--------------------------------------------------------------------------------------
    869. 

  869. 

  870.     CALL start_domain ( nest, .TRUE.)
    871. 

  871. 

  872. #ifdef HWRF
    873. 

  873. !zhang's doing: else for analysis or restart option
    874. 

    875. 

  875. !zhang test
    876. 

  876.     CALL nl_set_isice ( nest%id , config_flags%isice )   
    877. 

  877.     CALL nl_set_isoilwater ( nest%id , config_flags%isoilwater )   
    878. 

  878.     CALL nl_set_isurban ( nest%id , config_flags%isurban )   
    879. 

  879.     CALL nl_set_gmt    ( nest%id , config_flags%gmt    )   
    880. 

  880.     CALL nl_set_julyr (nest%id, config_flags%julyr)       
    881. 

  881.     CALL nl_set_julday ( nest%id , config_flags%julday )
    882. 

  882. !zhang test ends
    883. 

  883.     CALL med_analysis_out ( nest, config_flags )
    884. 

  884. 

  885.    ELSE
    886. 

  886. 

  887. !------------------------------------------------------------------------------------
    888. 

  888. !  read in analysis (equivalent of restart for the nested domains)
    889. 

  889. !------------------------------------------------------------------------------------
    890. 

  890. 

  891. !zhang's doing
    892. 

  892.   IF( nest%analysis .and. .not. config_flags%restart)THEN
    893. 

  893.    CALL med_analysis_in ( nest, config_flags )
    894. 

  894.   ELSE IF (config_flags%restart)THEN
    895. 

  895.    CALL med_restart_in ( nest, config_flags )
    896. 

  896.   ENDIF
    897. 

  897. !end of zhang's doing
    898. 

    899. 

  899. !----------------------------------------------------------------------------
    900. 

  900. !  initialize nested domain configurations including setting up wbd,sbd, etc
    901. 

  901. !----------------------------------------------------------------------------
    902. 

  902. 

  903.    CALL med_nest_egrid_configure ( parent , nest )
    904. 

  904. 

  905. !-------------------------------------------------------------------------
    906. 

  906. !  initialize lat-lons and determine weights (overwrite for safety)
    907. 

  907. !-------------------------------------------------------------------------
    908. 

  908. 

  909.    CALL med_construct_egrid_weights ( parent, nest )
    910. 

  910. 

  911.    nest%imask_nostag = 0
    912. 

  912.    nest%imask_xstag  = 0
    913. 

  913.    nest%imask_ystag  = 0
    914. 

  914.    nest%imask_xystag = 0
    915. 

  915. 

  916. !------------------------------------------------------------------------------
    917. 

  917. !  set up constants (module_initialize_real.F for nested nmm domain)
    918. 

  918. !-----------------------------------------------------------------------------
    919. 

  919. 

  920.     CALL med_init_domain_constants_nmm ( parent, nest )
    921. 

  921. 

  922. !--------------------------------------------------------------------------------------
    923. 

  923. ! set some other initial fields, fill out halos, etc. (again, safety sake only)
    924. 

  924. ! Also, in order to accomodate some physics initialization after nest move, set
    925. 

  925. ! analysis back to false for future use
    926. 

  926. !--------------------------------------------------------------------------------------
    927. 

  927. 

  928.     CALL start_domain ( nest, .TRUE.)
    929. 

  929. 

  930.     nest%analysis=.FALSE.
    931. 

  931.     CALL nl_set_analysis( nest%id, nest%analysis)
    932. 

  932. 

  933.   ENDIF
    934. 

  934. 

  935. #endif
    936. 

  936. 

  937. !===================================================================================
    938. 

  938. !  Added for the NMM core. End of gopal's doing.
    939. 

  939. !===================================================================================
    940. 

  940. #endif
    941. 

  941.   RETURN
    942. 

  942. END SUBROUTINE med_nest_initial
    943. 

  943. 

  944. SUBROUTINE init_domain_constants ( parent , nest )
    945. 

  945.    USE module_domain	, ONLY : domain
    946. 

  946.    IMPLICIT NONE
    947. 

  947.    TYPE(domain) :: parent , nest
    948. 

  948. #if (EM_CORE == 1)
    949. 

  949.    CALL init_domain_constants_em ( parent, nest )
    950. 

  950. #endif
    951. 

  951. END SUBROUTINE init_domain_constants
    952. 

  952. 

  953. 

  954. SUBROUTINE med_nest_force ( parent , nest )
    955. 

  955.   ! Driver layer
    956. 

  956.    USE module_domain	, ONLY : domain
    957. 

  957.    USE module_timing
    958. 

  958.    USE module_configure	, ONLY : grid_config_rec_type
    959. 

  959.   ! Model layer
    960. 

  960.   ! External
    961. 

  961.    USE module_utility
    962. 

  962. 

  963.    IMPLICIT NONE
    964. 

  964. 

  965.   ! Arguments
    966. 

  966.    TYPE(domain) , POINTER                     :: parent, nest
    967. 

  967.   ! Local
    968. 

  968.    INTEGER                                    :: idum1 , idum2 , fid, rc
    969. 

  969. 

  970. #if (NMM_CORE == 1 && NMM_NEST == 1)
    971. 

  971.    INTEGER                  :: IDS,IDE,JDS,JDE,KDS,KDE     ! gopal
    972. 

  972.    INTEGER                  :: IMS,IME,JMS,JME,KMS,KME
    973. 

  973.    INTEGER                  :: ITS,ITE,JTS,JTE,KTS,KTE
    974. 

  974. #endif
    975. 

  975. 

  976.    INTERFACE
    977. 

  977.      SUBROUTINE med_force_domain ( parent , nest )
    978. 

  978.         USE module_domain	, ONLY : domain
    979. 

  979.         TYPE(domain) , POINTER                 :: parent , nest
    980. 

  980.      END SUBROUTINE med_force_domain
    981. 

  981.      SUBROUTINE med_interp_domain ( parent , nest )
    982. 

  982.         USE module_domain	, ONLY : domain
    983. 

  983.         TYPE(domain) , POINTER                 :: parent , nest
    984. 

  984.      END SUBROUTINE med_interp_domain
    985. 

  985. #if (NMM_CORE == 1 && NMM_NEST == 1)
    986. 

  986. !===================================================================================
    987. 

  987. !  Added for the NMM core. This is gopal's doing.
    988. 

  988. !===================================================================================
    989. 

  989. 

  990.      SUBROUTINE BASE_STATE_PARENT ( Z3d,Q3d,T3d,PSTD,        &
    991. 

  991.                                     PINT,T,Q,CWM,            &
    992. 

  992.                                     FIS,QSH,PD,PDTOP,PTOP,   &
    993. 

  993.                                     ETA1,ETA2,               &
    994. 

  994.                                     DETA1,DETA2,             &
    995. 

  995.                                     IDS,IDE,JDS,JDE,KDS,KDE, &
    996. 

  996.                                     IMS,IME,JMS,JME,KMS,KME, &
    997. 

  997.                                     ITS,ITE,JTS,JTE,KTS,KTE  )
    998. 

  998. !
    999. 

  999. 

  1000.          USE MODULE_MODEL_CONSTANTS
    1001. 

  1001.          IMPLICIT NONE
    1002. 

  1002.          INTEGER,    INTENT(IN   )                            :: IDS,IDE,JDS,JDE,KDS,KDE
    1003. 

  1003.          INTEGER,    INTENT(IN   )                            :: IMS,IME,JMS,JME,KMS,KME
    1004. 

  1004.          INTEGER,    INTENT(IN   )                            :: ITS,ITE,JTS,JTE,KTS,KTE
    1005. 

  1005.          REAL,       INTENT(IN   )                            :: PDTOP,PTOP
    1006. 

  1006.          REAL, DIMENSION(KMS:KME),                 INTENT(IN) :: ETA1,ETA2,DETA1,DETA2
    1007. 

  1007.          REAL, DIMENSION(IMS:IME,JMS:JME),         INTENT(IN) :: FIS,PD,QSH
    1008. 

  1008.          REAL, DIMENSION(IMS:IME,JMS:JME,KMS:KME), INTENT(IN) :: PINT,T,Q,CWM
    1009. 

  1009.          REAL, DIMENSION(KMS:KME)                , INTENT(OUT):: PSTD
    1010. 

  1010.          REAL, DIMENSION(IMS:IME,JMS:JME,KMS:KME), INTENT(OUT):: Z3d,Q3d,T3d
    1011. 

  1011. 

  1012.      END SUBROUTINE BASE_STATE_PARENT
    1013. 

  1013. 

  1014. #endif
    1015. 

  1015.    END INTERFACE
    1016. 

  1016. 

  1017. #if (NMM_CORE == 1 && NMM_NEST == 1)
    1018. 

  1018. 

  1019. !  De-reference dimension information stored in the grid data structure.
    1020. 

  1020. 

  1021.     IDS = parent%sd31
    1022. 

  1022.     IDE = parent%ed31
    1023. 

  1023.     JDS = parent%sd32
    1024. 

  1024.     JDE = parent%ed32
    1025. 

  1025.     KDS = parent%sd33
    1026. 

  1026.     KDE = parent%ed33
    1027. 

  1027. 

  1028.     IMS = parent%sm31
    1029. 

  1029.     IME = parent%em31
    1030. 

  1030.     JMS = parent%sm32
    1031. 

  1031.     JME = parent%em32
    1032. 

  1032.     KMS = parent%sm33
    1033. 

  1033.     KME = parent%em33
    1034. 

  1034. 

  1035.     ITS = parent%sp31
    1036. 

  1036.     ITE = parent%ep31
    1037. 

  1037.     JTS = parent%sp32
    1038. 

  1038.     JTE = parent%ep32
    1039. 

  1039.     KTS = parent%sp33
    1040. 

  1040.     KTE = parent%ep33
    1041. 

  1041. 

  1042. 

  1043.     CALL BASE_STATE_PARENT ( parent%Z3d,parent%Q3d,parent%T3d,parent%PSTD, &
    1044. 

  1044.                              parent%PINT,parent%T,parent%Q,parent%CWM,     &
    1045. 

  1045.                              parent%FIS,parent%QSH,parent%PD,parent%pdtop,parent%pt,  &
    1046. 

  1046.                              parent%ETA1,parent%ETA2,                              &
    1047. 

  1047.                              parent%DETA1,parent%DETA2,                            &
    1048. 

  1048.                              IDS,IDE,JDS,JDE,KDS,KDE,                                      &
    1049. 

  1049.                              IMS,IME,JMS,JME,KMS,KME,                                      &
    1050. 

  1050.                              ITS,ITE,JTS,JTE,KTS,KTE                                       )
    1051. 

  1051. 

  1052. #endif
    1053. 

  1053. 

  1054.    IF ( .NOT. WRFU_ClockIsStopTime(nest%domain_clock ,rc=rc) ) THEN
    1055. 

  1055. ! initialize nest with interpolated data from the parent
    1056. 

  1056.      nest%imask_nostag = 1
    1057. 

  1057.      nest%imask_xstag = 1
    1058. 

  1058.      nest%imask_ystag = 1
    1059. 

  1059.      nest%imask_xystag = 1
    1060. 

  1060.      CALL med_force_domain( parent, nest )
    1061. 

  1061.    ENDIF
    1062. 

  1062. 

  1063. ! might also have calls here to do input from a file into the nest
    1064. 

  1064. 

  1065.    RETURN
    1066. 

  1066. END SUBROUTINE med_nest_force
    1067. 

  1067. 

  1068. SUBROUTINE med_nest_feedback ( parent , nest , config_flags )
    1069. 

  1069.   ! Driver layer
    1070. 

  1070.    USE module_domain	, ONLY : domain , get_ijk_from_grid
    1071. 

  1071.    USE module_timing
    1072. 

  1072.    USE module_configure	, ONLY : grid_config_rec_type
    1073. 

  1073.   ! Model layer
    1074. 

  1074.   ! External
    1075. 

  1075.    USE module_utility
    1076. 

  1076.    IMPLICIT NONE
    1077. 

  1077. 

  1078. 

  1079.   ! Arguments
    1080. 

  1080.    TYPE(domain) , POINTER                     :: parent, nest
    1081. 

  1081.    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
    1082. 

  1082.   ! Local
    1083. 

  1083.    INTEGER                                    :: idum1 , idum2 , fid, rc
    1084. 

  1084.    INTEGER                         :: ids , ide , jds , jde , kds , kde , &
    1085. 

  1085.                                       ims , ime , jms , jme , kms , kme , &
    1086. 

  1086.                                       ips , ipe , jps , jpe , kps , kpe
    1087. 

  1087.    INTEGER i,j
    1088. 

  1088. 

  1089.    INTERFACE
    1090. 

  1090.      SUBROUTINE med_feedback_domain ( parent , nest )
    1091. 

  1091.         USE module_domain	, ONLY : domain
    1092. 

  1092.         TYPE(domain) , POINTER                 :: parent , nest
    1093. 

  1093.      END SUBROUTINE med_feedback_domain
    1094. 

  1094.    END INTERFACE
    1095. 

  1095. 

  1096. ! feedback nest to the parent
    1097. 

  1097.     IF ( config_flags%feedback .NE. 0 ) THEN
    1098. 

  1098.       CALL med_feedback_domain( parent, nest )
    1099. 

  1099. #ifdef MOVE_NESTS
    1100. 

  1100.       CALL get_ijk_from_grid (  parent ,                         &
    1101. 

  1101.                                 ids, ide, jds, jde, kds, kde,    &
    1102. 

  1102.                                 ims, ime, jms, jme, kms, kme,    &
    1103. 

  1103.                                 ips, ipe, jps, jpe, kps, kpe    )
    1104. 

  1104. ! gopal's change- added ifdef
    1105. 

  1105. #if ( EM_CORE == 1 )
    1106. 

  1106.       DO j = jps, MIN(jpe,jde-1)
    1107. 

  1107.       DO i = ips, MIN(ipe,ide-1)
    1108. 

  1108.         IF      ( parent%nest_pos(i,j) .EQ. 9021000. ) THEN
    1109. 

  1109.           parent%nest_pos(i,j) = parent%ht(i,j)*1.5 + 1000.
    1110. 

  1110.         ELSE IF ( parent%ht(i,j) .NE. 0. ) THEN
    1111. 

  1111.           parent%nest_pos(i,j) = parent%ht(i,j) + 500.
    1112. 

  1112.         ELSE 
    1113. 

  1113.           parent%nest_pos(i,j) = 0.
    1114. 

  1114.         ENDIF
    1115. 

  1115.       ENDDO
    1116. 

  1116.       ENDDO
    1117. 

  1117. #endif
    1118. 

  1118. #endif
    1119. 

  1119.     END IF
    1120. 

  1120. 

  1121.    RETURN
    1122. 

  1122. END SUBROUTINE med_nest_feedback
    1123. 

  1123. 

  1124. SUBROUTINE med_last_solve_io ( grid , config_flags )
    1125. 

  1125.   ! Driver layer
    1126. 

  1126.    USE module_state_description
    1127. 

  1127.    USE module_domain	, ONLY : domain, domain_clock_get
    1128. 

  1128.    USE module_configure	, ONLY : grid_config_rec_type
    1129. 

  1129.    USE module_utility
    1130. 

  1130.    USE module_streams
    1131. 

  1131.   ! Model layer
    1132. 

  1132. 

  1133.    IMPLICIT NONE
    1134. 

  1134. 

  1135.   ! Arguments
    1136. 

  1136.    TYPE(domain)                               :: grid
    1137. 

  1137.    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
    1138. 

  1138.   ! Local
    1139. 

  1139.    INTEGER                                    :: rc
    1140. 

  1140. #ifdef HWRF
    1141. 

  1141. !zhang's doing
    1142. 

  1142.    TYPE(WRFU_Time) :: CurrTime  !zhang new
    1143. 

  1143.    INTEGER :: hr, min, sec, ms,julyr,julday
    1144. 

  1144.    REAL :: GMT
    1145. 

  1145. !end of zhang's doing
    1146. 

  1146. #endif
    1147. 

  1147. 

  1148. ! #if (EM_CORE == 1)
    1149. 

  1149.    IF( WRFU_AlarmIsRinging( grid%alarms( HISTORY_ALARM ), rc=rc ) .AND. &
    1150. 

  1150.        (grid%dfi_write_dfi_history .OR. grid%dfi_stage == DFI_FST .OR. grid%dfi_opt == DFI_NODFI) ) THEN
    1151. 

  1151. ! #else
    1152. 

  1152. !    IF( WRFU_AlarmIsRinging( grid%alarms( HISTORY_ALARM ), rc=rc )) THEN
    1153. 

  1153. ! #endif
    1154. 

  1154.      CALL med_hist_out ( grid , HISTORY_ALARM , config_flags )
    1155. 

  1155.    ENDIF
    1156. 

  1156. 

  1157.    IF( WRFU_AlarmIsRinging( grid%alarms( INPUTOUT_ALARM ), rc=rc ) ) THEN
    1158. 

  1158.      CALL med_filter_out  ( grid , config_flags )
    1159. 

  1159.    ENDIF
    1160. 

  1160. 

  1161. ! registry-generated file of the following 
    1162. 

  1162. !   IF( WRFU_AlarmIsRinging( grid%alarms( AUXHIST1_ALARM ), rc=rc ) ) THEN
    1163. 

  1163. !     CALL med_hist_out ( grid , AUXHIST1_ALARM , config_flags )
    1164. 

  1164. !   ENDIF
    1165. 

  1165. #include "med_last_solve_io.inc"
    1166. 

  1166. 

  1167. ! - RESTART OUTPUT
    1168. 

  1168.    IF( WRFU_AlarmIsRinging( grid%alarms( RESTART_ALARM ), rc=rc ) ) THEN
    1169. 

  1169. #ifdef HWRF
    1170. 

  1170. !zhang's doing
    1171. 

  1171. !zhang new     CALL ESMF_TimeGet( grid%current_time, YY=julyr, dayOfYear=julday, H=hr, M=min, S=sec, MS=ms, rc=rc)
    1172. 

  1172.      CALL domain_clock_get( grid, current_time=CurrTime )
    1173. 

  1173.      CALL WRFU_TimeGet( CurrTime, YY=julyr, dayOfYear=julday, H=hr, M=min, S=sec, MS=ms, rc=rc)
    1174. 

  1174.      gmt=hr+real(min)/60.+real(sec)/3600.+real(ms)/(1000*3600)
    1175. 

  1175.       if (grid%id .eq. 2) call med_namelist_out ( grid , config_flags )
    1176. 

  1176. !end of zhang's doing
    1177. 

  1177. #endif
    1178. 

  1178.      IF ( grid%id .EQ. 1 ) THEN
    1179. 

  1179.        CALL med_restart_out ( grid , config_flags )
    1180. 

  1180.      ENDIF
    1181. 

  1181.    ENDIF
    1182. 

  1182. 

  1183.    ! Write out time series
    1184. 

  1184.    CALL write_ts( grid )
    1185. 

  1185. 

  1186.    RETURN
    1187. 

  1187. END SUBROUTINE med_last_solve_io
    1188. 

  1188. 

  1189. #endif
    1190. 

  1190. 

  1191. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    1192. 

  1192. 

  1193. #ifdef HWRF
    1194. 

  1194. !==================================================================================
    1195. 

  1195. !  Added for the NMM 3d var. This is simply an extension of med_restart_out.
    1196. 

  1196. !  The file is simply called wrfanal***. This is gopal's doing
    1197. 

  1197. !===================================================================================
    1198. 

  1198. !
    1199. 

  1199. SUBROUTINE med_analysis_in ( grid , config_flags )
    1200. 

  1200.   ! Driver layer
    1201. 

  1201.    USE module_domain	, ONLY : domain, domain_clock_get
    1202. 

  1202.    USE module_io_domain
    1203. 

  1203.    USE module_timing
    1204. 

  1204.   ! Model layer
    1205. 

  1205.    USE module_configure	, ONLY : grid_config_rec_type
    1206. 

  1206.    USE module_bc_time_utilities
    1207. 

  1207. !zhang   USE WRF_ESMF_MOD
    1208. 

  1208. 

  1209.    IMPLICIT NONE
    1210. 

  1210. 

  1211.   ! Arguments
    1212. 

  1212.    TYPE(domain)                               :: grid
    1213. 

  1213.    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
    1214. 

  1214. 

  1215.   ! Local
    1216. 

  1216.    LOGICAL, EXTERNAL :: wrf_dm_on_monitor
    1217. 

  1217.    CHARACTER*80                           :: rstname , outname
    1218. 

  1218.    INTEGER                                :: fid , rid
    1219. 

  1219.    CHARACTER (LEN=256)                    :: message
    1220. 

  1220.    INTEGER                                :: ierr
    1221. 

  1221.    INTEGER                                :: myproc
    1222. 

  1222. !zhang old    TYPE(ESMF_Time)                        :: CurrTime
    1223. 

  1223.    TYPE(WRFU_Time)                        :: CurrTime
    1224. 

  1224.    CHARACTER*80                           :: timestr
    1225. 

  1225. 

  1226.    IF ( wrf_dm_on_monitor() ) THEN
    1227. 

  1227.      CALL start_timing
    1228. 

  1228.    END IF
    1229. 

  1229. 

  1230.    rid=grid%id
    1231. 

  1231. 

  1232. !zhang's doing   CALL ESMF_ClockGet( grid%domain_clock, CurrTime=CurrTime, rc=ierr )
    1233. 

  1233. !zhang's doing   CALL wrf_timetoa ( CurrTime, timestr )
    1234. 

  1234.    CALL domain_clock_get( grid, current_timestr=timestr )
    1235. 

  1235.    CALL construct_filename2a ( rstname ,config_flags%anl_outname, grid%id , 2 , timestr )
    1236. 

  1236. 

  1237.    WRITE( message , '("med_analysis_in: opening ",A," for reading")' ) TRIM ( rstname )
    1238. 

  1238.    CALL wrf_debug( 1 , message )
    1239. 

  1239.    CALL open_r_dataset ( rid, TRIM(rstname), grid , &
    1240. 

  1240.                          config_flags , "DATASET=RESTART", ierr )
    1241. 

  1241. 

  1242.    IF ( ierr .NE. 0 ) THEN
    1243. 

  1243.       ! Could not open the analysis file, so notify user.
    1244. 

  1244. 

  1245.       write(message,'(A,I0,A,A,A)') 'WARNING: Domain ',grid%id,' analysis file ',trim(rstname),' is missing.'
    1246. 

  1246.       call wrf_message(message)
    1247. 

  1247.       write(message,'(A,I0,A)') '-------> Domain ',grid%id,' running as a cold start (interp from parent).'
    1248. 

  1248.       call wrf_message(message)
    1249. 

  1249. 

  1250.       IF ( wrf_dm_on_monitor() ) THEN
    1251. 

  1251.          WRITE (message, '("Failing to read restart for domain ",I8)') grid%id
    1252. 

  1252.          CALL end_timing ( TRIM(message) )
    1253. 

  1253.       END IF
    1254. 

  1254. 

  1255.       return
    1256. 

  1256.    ELSE
    1257. 

  1257.       ! Was able to open the analysis file.  Read it as a restart file.
    1258. 

  1258. 

  1259.       CALL input_restart ( rid, grid , config_flags , ierr )
    1260. 

  1260.       IF ( wrf_dm_on_monitor() ) THEN
    1261. 

  1261.          WRITE ( message , FMT = '("Reading restart for domain ",I8)' ) grid%id
    1262. 

  1262.          CALL end_timing ( TRIM(message) )
    1263. 

  1263.       END IF
    1264. 

  1264.       CALL close_dataset ( rid , config_flags , "DATASET=RESTART" )
    1265. 

  1265.    ENDIF
    1266. 

  1266. 

  1267.    RETURN
    1268. 

  1268. 

  1269. END SUBROUTINE med_analysis_in
    1270. 

  1270. !=========================================================================================================
    1271. 

  1271. !=========================================================================================================
    1272. 

  1272. SUBROUTINE med_analysis_out ( grid , config_flags )
    1273. 

  1273.   ! Driver layer
    1274. 

  1274.    USE module_domain	, ONLY : domain, domain_clock_get
    1275. 

  1275.    USE module_io_domain
    1276. 

  1276.    USE module_timing
    1277. 

  1277.   ! Model layer
    1278. 

  1278.    USE module_configure	, ONLY : grid_config_rec_type
    1279. 

  1279.    USE module_bc_time_utilities
    1280. 

  1280. !zhang   USE WRF_ESMF_MOD
    1281. 

  1281. 

  1282.    IMPLICIT NONE
    1283. 

  1283. 

  1284.   ! Arguments
    1285. 

  1285.    TYPE(domain)                               :: grid
    1286. 

  1286.    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
    1287. 

  1287. 

  1288.   ! Local
    1289. 

  1289.    LOGICAL, EXTERNAL :: wrf_dm_on_monitor
    1290. 

  1290.    CHARACTER*80                           :: rstname , outname
    1291. 

  1291.    INTEGER                                :: fid , rid
    1292. 

  1292.    CHARACTER (LEN=256)                    :: message
    1293. 

  1293.    INTEGER          …
    1294.

Large files files are truncated, but you can click here to view the full file