PageRenderTime 51ms CodeModel.GetById 10ms RepoModel.GetById 0ms app.codeStats 0ms

/wrfv2_fire/dyn_em/start_em.F

http://github.com/jbeezley/wrf-fire
FORTRAN Legacy | 1384 lines | 921 code | 179 blank | 284 comment | 21 complexity | e3c03e161a53959e527bf6ad04cf0a39 MD5 | raw file
Possible License(s): AGPL-1.0 
    

  1. !-------------------------------------------------------------------
    2. 

  2. 

  3.    SUBROUTINE start_domain_em ( grid, allowed_to_read &
    4. 

  4. ! Actual arguments generated from Registry
    5. 

  5. # include "dummy_new_args.inc"
    6. 

  6. !
    7. 

  7. )
    8. 

  8. 

  9.    USE module_domain, ONLY : domain, wrfu_timeinterval, get_ijk_from_grid, &
    10. 

  10.         domain_setgmtetc
    11. 

  11.    USE module_state_description
    12. 

  12.    USE module_model_constants
    13. 

  13.    USE module_bc, ONLY : boundary_condition_check, set_physical_bc2d
    14. 

  14.    USE module_bc_em
    15. 

  15.    USE module_configure, ONLY : grid_config_rec_type
    16. 

  16.    USE module_tiles, ONLY : set_tiles
    17. 

  17. #ifdef DM_PARALLEL
    18. 

  18.    USE module_dm, ONLY : wrf_dm_min_real, wrf_dm_max_real, wrf_dm_maxval, &
    19. 

  19.         ntasks_x, ntasks_y, &
    20. 

  20.         local_communicator_periodic, local_communicator, mytask, ntasks 
    21. 

  21. #else
    22. 

  22.    USE module_dm, ONLY : wrf_dm_min_real, wrf_dm_max_real
    23. 

  23. #endif
    24. 

  24.    USE module_comm_dm
    25. 

  25. 

  26.    USE module_physics_init
    27. 

  27.    USE module_fr_sfire_driver_wrf, ONLY : sfire_driver_em_init
    28. 

  28.    USE module_stoch, ONLY : SETUP_STOCH,rand_seed, update_stoch
    29. 

  29. #ifdef WRF_CHEM
    30. 

  30.    USE module_aerosols_sorgam, ONLY: sum_pm_sorgam
    31. 

  31.    USE module_gocart_aerosols, ONLY: sum_pm_gocart
    32. 

  32.    USE module_mosaic_driver, ONLY: sum_pm_mosaic
    33. 

  33.    USE module_input_tracer, ONLY: initialize_tracer
    34. 

  34.    USE module_aerosols_soa_vbs, only: sum_pm_soa_vbs
    35. 

  35. #endif
    36. 

  36. 

  37. !!debug
    38. 

  38. !USE module_compute_geop
    39. 

  39. 

  40.    USE module_model_constants
    41. 

  41.    USE module_avgflx_em, ONLY : zero_avgflx
    42. 

  42. 

  43.    IMPLICIT NONE
    44. 

  44.    !  Input data.
    45. 

  45.    TYPE (domain)          :: grid
    46. 

  46. 

  47.    LOGICAL , INTENT(IN)   :: allowed_to_read
    48. 

  48. 

  49.    !  Definitions of dummy arguments to this routine (generated from Registry).
    50. 

  50. # include "dummy_new_decl.inc"
    51. 

  51. 

  52.    !  Structure that contains run-time configuration (namelist) data for domain
    53. 

  53.    TYPE (grid_config_rec_type)              :: config_flags
    54. 

  54. 

  55.    !  Local data
    56. 

  56.    INTEGER                             ::                       &
    57. 

  57.                                   ids, ide, jds, jde, kds, kde, &
    58. 

  58.                                   ims, ime, jms, jme, kms, kme, &
    59. 

  59.                                   ips, ipe, jps, jpe, kps, kpe, &
    60. 

  60.                                   its, ite, jts, jte, kts, kte, &
    61. 

  61.                                   ij,i,j,k,ii,jj,kk,loop,error,l
    62. 

  62. 

  63.    INTEGER ::              imsx, imex, jmsx, jmex, kmsx, kmex,    &
    64. 

  64.                            ipsx, ipex, jpsx, jpex, kpsx, kpex,    &
    65. 

  65.                            imsy, imey, jmsy, jmey, kmsy, kmey,    &
    66. 

  66.                            ipsy, ipey, jpsy, jpey, kpsy, kpey
    67. 

  67. 

  68.    INTEGER     :: i_m
    69. 

  69. 

  70.    REAL        :: p00, t00, a, tiso, p_surf, pd_surf, temp
    71. 

  71. #ifdef WRF_CHEM
    72. 

  72.    REAL        RGASUNIV ! universal gas constant [ J/mol-K ]
    73. 

  73.    PARAMETER ( RGASUNIV = 8.314510 )
    74. 

  74.       REAL,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: &
    75. 

  75.                       z_at_w,convfac
    76. 

  76.    REAL :: tempfac
    77. 

  77. #endif
    78. 

  78. 

  79.    REAL :: qvf1, qvf2, qvf
    80. 

  80.    REAL :: pfu, pfd, phm
    81. 

  81.    REAL :: MPDT
    82. 

  82.    REAL :: spongeweight
    83. 

  83.    LOGICAL :: first_trip_for_this_domain, start_of_simulation, fill_w_flag
    84. 

  84.    LOGICAL, EXTERNAL :: wrf_dm_on_monitor
    85. 

  85. 

  86. #ifndef WRF_CHEM
    87. 

  87.       REAL,ALLOCATABLE,DIMENSION(:,:,:) :: cldfra_old
    88. 

  88. #endif
    89. 

  89. 

  90.    REAL :: lat1 , lat2 , lat3 , lat4
    91. 

  91.    REAL :: lon1 , lon2 , lon3 , lon4
    92. 

  92.    INTEGER :: num_points_lat_lon , iloc , jloc
    93. 

  93.    CHARACTER (LEN=132) :: message
    94. 

  94.    TYPE(WRFU_TimeInterval) :: stepTime
    95. 

  95.    REAL, DIMENSION(:,:), ALLOCATABLE :: clat_glob
    96. 

  96.    logical :: f_flux  ! flag for computing averaged fluxes in cu_gd
    97. 

  97. 

  98.    INTEGER :: idex, jdex
    99. 

  99.    INTEGER :: im1,ip1,jm1,jp1
    100. 

  100.    REAL :: hx,hy,pi
    101. 

  101. 

  102.    REAL :: w_max, w_min
    103. 

  103.    LOGICAL :: w_needs_to_be_set
    104. 

  104. !  
    105. 

  105. ! paj: define variable local
    106. 

  106.    REAL    :: alpha
    107. 

  107. 

  108.    CALL get_ijk_from_grid ( grid ,                              &
    109. 

  109.                            ids, ide, jds, jde, kds, kde,        &
    110. 

  110.                            ims, ime, jms, jme, kms, kme,        &
    111. 

  111.                            ips, ipe, jps, jpe, kps, kpe,        &
    112. 

  112.                            imsx, imex, jmsx, jmex, kmsx, kmex,  &
    113. 

  113.                            ipsx, ipex, jpsx, jpex, kpsx, kpex,  &
    114. 

  114.                            imsy, imey, jmsy, jmey, kmsy, kmey,  &
    115. 

  115.                            ipsy, ipey, jpsy, jpey, kpsy, kpey )
    116. 

  116. 

  117.    kts = kps ; kte = kpe     ! note that tile is entire patch
    118. 

  118.    its = ips ; ite = ipe     ! note that tile is entire patch
    119. 

  119.    jts = jps ; jte = jpe    ! note that tile is entire patch
    120. 

  120. #ifndef WRF_CHEM
    121. 

  121.          ALLOCATE(CLDFRA_OLD(IMS:IME,KMS:KME,JMS:JME),STAT=I)  ; CLDFRA_OLD = 0.
    122. 

  122. #endif
    123. 

  123.    CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
    124. 

  124. 

  125.    IF ( ( MOD (ide-ids,config_flags%parent_grid_ratio) .NE. 0 ) .OR. &
    126. 

  126.         ( MOD (jde-jds,config_flags%parent_grid_ratio) .NE. 0 ) ) THEN
    127. 

  127.       WRITE(message, FMT='("Nested dimensions are illegal for domain ",I2,":  Both &
    128. 

  128.          &MOD(",I4,"-",I1,",",I2,") and MOD(",I4,"-",I1,",",I2,") must = 0" )') &
    129. 

  129.          grid%id,ide,ids,config_flags%parent_grid_ratio,jde,jds,config_flags%parent_grid_ratio
    130. 

  130.       CALL wrf_error_fatal ( message )
    131. 

  131.    END IF
    132. 

  132. 

  133.    IF ( config_flags%polar ) THEN
    134. 

  134. !write(0,*)__FILE__,__LINE__,' clat ',ips,ipe,jps,jpe
    135. 

  135. !do j = jps,jpe
    136. 

  136. !write(0,*)__FILE__,__LINE__,' clat ',ids,j,grid%clat(ips,j)
    137. 

  137. !enddo
    138. 

  138. 

  139. #ifdef DM_PARALLEL
    140. 

  140. ! WARNING:  this might present scaling issues on very large numbers of processors
    141. 

  141.      ALLOCATE( clat_glob(ids:ide,jds:jde) )
    142. 

  142. 

  143.      CALL wrf_patch_to_global_real ( grid%clat, clat_glob, grid%domdesc, 'xy', 'xy', &
    144. 

  144.                                      ids, ide, jds, jde, 1, 1, &
    145. 

  145.                                      ims, ime, jms, jme, 1, 1, &
    146. 

  146.                                      its, ite, jts, jte, 1, 1 )
    147. 

  147. 

  148.      CALL wrf_dm_bcast_real ( clat_glob , (ide-ids+1)*(jde-jds+1) )
    149. 

  149. 

  150.      grid%clat_xxx(ipsx:ipex,jpsx:jpex) = clat_glob(ipsx:ipex,jpsx:jpex)
    151. 

  151. 

  152.      DEALLOCATE( clat_glob )
    153. 

  153. #endif
    154. 

  154.    ENDIF
    155. 

  155. 

  156. ! here we check to see if the boundary conditions are set properly
    157. 

  157. 

  158.    CALL boundary_condition_check( config_flags, bdyzone, error, grid%id )
    159. 

  159. 

  160. !kludge - need to stop CG from resetting precip and phys tendencies to zero
    161. 

  161. !         when we are in here due to a nest being spawned, we want to still
    162. 

  162. !         recompute the base state, but that is about it
    163. 

  163.    !  This is temporary and will need to be changed when grid%itimestep is removed.
    164. 

  164. 

  165.    IF ( grid%itimestep .EQ. 0 ) THEN
    166. 

  166.       first_trip_for_this_domain = .TRUE.
    167. 

  167.    ELSE
    168. 

  168.       first_trip_for_this_domain = .FALSE.
    169. 

  169.    END IF
    170. 

  170. 

  171.    IF ( .not. ( config_flags%restart .or. grid%moved ) ) THEN
    172. 

  172.        grid%itimestep=0
    173. 

  173.    ENDIF
    174. 

  174. 

  175.    IF ( config_flags%restart .or. grid%moved ) THEN
    176. 

  176.        first_trip_for_this_domain = .TRUE.
    177. 

  177.    ENDIF
    178. 

  178. 

  179. !   --- SETUP AND INITIALIZE STOCHASTIC KINETIC ENERGY BACKSCATTER SCHEME ---
    180. 

  180. 

  181.    IF ( first_trip_for_this_domain ) THEN
    182. 

  182.      grid%did_stoch = .FALSE.
    183. 

  183.    END IF
    184. 

  184. 

  185.    IF ( ( grid%id == 1 ) .AND. &
    186. 

  186.         ( NINT(grid%stoch_force_global_opt) == 1 ) .AND. &
    187. 

  187.         ( .NOT. grid%did_stoch ) ) THEN
    188. 

  188. 

  189.      grid%did_stoch = .TRUE.
    190. 

  190.      IF ( wrf_dm_on_monitor () ) THEN
    191. 

  191.        CALL rand_seed ( config_flags, grid%SEED1, grid%SEED2, grid%NENS )
    192. 

  192.      ENDIF
    193. 

  193. #ifdef DM_PARALLEL
    194. 

  194.      CALL wrf_dm_bcast_bytes ( grid%SEED1, IWORDSIZE )
    195. 

  195.      CALL wrf_dm_bcast_bytes ( grid%SEED2, IWORDSIZE )
    196. 

  196. #endif
    197. 

  197. 

  198.      call SETUP_STOCH(grid%VERTSTRUCC,grid%VERTSTRUCS,                   &
    199. 

  199.                       grid%SPT_AMP,grid%SPSTREAM_AMP,                    &
    200. 

  200.                       grid%stoch_vertstruc_opt,                          & 
    201. 

  201.                       grid%SEED1,grid%SEED2,grid%time_step,              &
    202. 

  202.                       grid%DX,grid%DY,                                   &
    203. 

  203.                       grid%TOT_BACKSCAT_PSI,grid%TOT_BACKSCAT_T,         &
    204. 

  204.                       ids, ide, jds, jde, kds, kde,                      &
    205. 

  205.                       ims, ime, jms, jme, kms, kme,                      &
    206. 

  206.                       its, ite, jts, jte, kts, kte                       )
    207. 

  207.     
    208. 

  208.     END IF
    209. 

  209. !   --- END SETUP STOCHASTIC KINETIC ENERGY BACKSCATTER SCHEME ----------
    210. 

  210. 

  211. ! wig: Add a combined exponential+linear weight on the mother boundaries
    212. 

  212. !      following code changes by Ruby Leung. For the nested grid, there
    213. 

  213. !      appears to be some problems when a sponge is used. The points where
    214. 

  214. !      processors meet have problematic values.
    215. 

  215. 

  216.    CALL lbc_fcx_gcx ( grid%fcx , grid%gcx , grid%spec_bdy_width , &
    217. 

  217.                       grid%spec_zone , grid%relax_zone , grid%dt , config_flags%spec_exp , &
    218. 

  218.                       config_flags%specified , config_flags%nested )
    219. 

  219. 

  220.    IF ( config_flags%nested ) THEN
    221. 

  221.      grid%dtbc = 0.
    222. 

  222.    ENDIF
    223. 

  223. 

  224.    IF ( ( grid%id .NE. 1 ) .AND. ( .NOT. config_flags%input_from_file ) ) THEN
    225. 

  225. 

  226.       !  Every time a domain starts or every time a domain moves, this routine is called.  We want
    227. 

  227.       !  the center (middle) lat/lon of the grid for the metacode.  The lat/lon values are
    228. 

  228.       !  defined at mass points.  Depending on the even/odd points in the SN and WE directions,
    229. 

  229.       !  we end up with the middle point as either 1 point or an average of either 2 or 4 points.
    230. 

  230.       !  Add to this, the need to make sure that we are on the correct patch to retrieve the
    231. 

  231.       !  value of the lat/lon, AND that the lat/lons (for an average) may not all be on the same
    232. 

  232.       !  patch.  Once we find the correct value for lat lon, we need to keep it around on all patches,
    233. 

  233.       !  which is where the wrf_dm_min_real calls come in.
    234. 

  234.       !  If this is the most coarse domain, we do not go in here.  Also, if there is an input file
    235. 

  235.       !  (which has the right values for the middle lat/lon) we do not go in this IF test.
    236. 

  236. 

  237.       IF      ( ( MOD(ide,2) .EQ. 0 ) .AND. ( MOD(jde,2) .EQ. 0 ) ) THEN
    238. 

  238.          num_points_lat_lon = 1
    239. 

  239.          iloc = ide/2
    240. 

  240.          jloc = jde/2
    241. 

  241.          IF ( ( ips .LE. iloc ) .AND. ( ipe .GE. iloc ) .AND. &
    242. 

  242.               ( jps .LE. jloc ) .AND. ( jpe .GE. jloc ) ) THEN
    243. 

  243.             lat1 = grid%xlat (iloc,jloc)
    244. 

  244.             lon1 = grid%xlong(iloc,jloc)
    245. 

  245.          ELSE
    246. 

  246.             lat1 = 99999.
    247. 

  247.             lon1 = 99999.
    248. 

  248.          END IF
    249. 

  249.          lat1 = wrf_dm_min_real ( lat1 )
    250. 

  250.          lon1 = wrf_dm_min_real ( lon1 )
    251. 

  251.          CALL nl_set_cen_lat ( grid%id , lat1 )
    252. 

  252.          CALL nl_set_cen_lon ( grid%id , lon1 )
    253. 

  253.       ELSE IF ( ( MOD(ide,2) .NE. 0 ) .AND. ( MOD(jde,2) .EQ. 0 ) ) THEN
    254. 

  254.          num_points_lat_lon = 2
    255. 

  255.          iloc = (ide-1)/2
    256. 

  256.          jloc =  jde   /2
    257. 

  257.          IF ( ( ips .LE. iloc ) .AND. ( ipe .GE. iloc ) .AND. &
    258. 

  258.               ( jps .LE. jloc ) .AND. ( jpe .GE. jloc ) ) THEN
    259. 

  259.             lat1 = grid%xlat (iloc,jloc)
    260. 

  260.             lon1 = grid%xlong(iloc,jloc)
    261. 

  261.          ELSE
    262. 

  262.             lat1 = 99999.
    263. 

  263.             lon1 = 99999.
    264. 

  264.          END IF
    265. 

  265.          lat1 = wrf_dm_min_real ( lat1 )
    266. 

  266.          lon1 = wrf_dm_min_real ( lon1 )
    267. 

  267. 

  268.          iloc = (ide+1)/2
    269. 

  269.          jloc =  jde   /2
    270. 

  270.          IF ( ( ips .LE. iloc ) .AND. ( ipe .GE. iloc ) .AND. &
    271. 

  271.               ( jps .LE. jloc ) .AND. ( jpe .GE. jloc ) ) THEN
    272. 

  272.             lat2 = grid%xlat (iloc,jloc)
    273. 

  273.             lon2 = grid%xlong(iloc,jloc)
    274. 

  274.          ELSE
    275. 

  275.             lat2 = 99999.
    276. 

  276.             lon2 = 99999.
    277. 

  277.          END IF
    278. 

  278.          lat2 = wrf_dm_min_real ( lat2 )
    279. 

  279.          lon2 = wrf_dm_min_real ( lon2 )
    280. 

  280. 

  281.          CALL nl_set_cen_lat ( grid%id , ( lat1 + lat2 ) * 0.50 )
    282. 

  282.          CALL nl_set_cen_lon ( grid%id , ( lon1 + lon2 ) * 0.50 )
    283. 

  283.       ELSE IF ( ( MOD(ide,2) .EQ. 0 ) .AND. ( MOD(jde,2) .NE. 0 ) ) THEN
    284. 

  284.          num_points_lat_lon = 2
    285. 

  285.          iloc =  ide   /2
    286. 

  286.          jloc = (jde-1)/2
    287. 

  287.          IF ( ( ips .LE. iloc ) .AND. ( ipe .GE. iloc ) .AND. &
    288. 

  288.               ( jps .LE. jloc ) .AND. ( jpe .GE. jloc ) ) THEN
    289. 

  289.             lat1 = grid%xlat (iloc,jloc)
    290. 

  290.             lon1 = grid%xlong(iloc,jloc)
    291. 

  291.          ELSE
    292. 

  292.             lat1 = 99999.
    293. 

  293.             lon1 = 99999.
    294. 

  294.          END IF
    295. 

  295.          lat1 = wrf_dm_min_real ( lat1 )
    296. 

  296.          lon1 = wrf_dm_min_real ( lon1 )
    297. 

  297. 

  298.          iloc =  ide   /2
    299. 

  299.          jloc = (jde+1)/2
    300. 

  300.          IF ( ( ips .LE. iloc ) .AND. ( ipe .GE. iloc ) .AND. &
    301. 

  301.               ( jps .LE. jloc ) .AND. ( jpe .GE. jloc ) ) THEN
    302. 

  302.             lat2 = grid%xlat (iloc,jloc)
    303. 

  303.             lon2 = grid%xlong(iloc,jloc)
    304. 

  304.          ELSE
    305. 

  305.             lat2 = 99999.
    306. 

  306.             lon2 = 99999.
    307. 

  307.          END IF
    308. 

  308.          lat2 = wrf_dm_min_real ( lat2 )
    309. 

  309.          lon2 = wrf_dm_min_real ( lon2 )
    310. 

  310. 

  311.          CALL nl_set_cen_lat ( grid%id , ( lat1 + lat2 ) * 0.50 )
    312. 

  312.          CALL nl_set_cen_lon ( grid%id , ( lon1 + lon2 ) * 0.50 )
    313. 

  313.       ELSE IF ( ( MOD(ide,2) .NE. 0 ) .AND. ( MOD(jde,2) .NE. 0 ) ) THEN
    314. 

  314.          num_points_lat_lon = 4
    315. 

  315.          iloc = (ide-1)/2
    316. 

  316.          jloc = (jde-1)/2
    317. 

  317.          IF ( ( ips .LE. iloc ) .AND. ( ipe .GE. iloc ) .AND. &
    318. 

  318.               ( jps .LE. jloc ) .AND. ( jpe .GE. jloc ) ) THEN
    319. 

  319.             lat1 = grid%xlat (iloc,jloc)
    320. 

  320.             lon1 = grid%xlong(iloc,jloc)
    321. 

  321.          ELSE
    322. 

  322.             lat1 = 99999.
    323. 

  323.             lon1 = 99999.
    324. 

  324.          END IF
    325. 

  325.          lat1 = wrf_dm_min_real ( lat1 )
    326. 

  326.          lon1 = wrf_dm_min_real ( lon1 )
    327. 

  327. 

  328.          iloc = (ide+1)/2
    329. 

  329.          jloc = (jde-1)/2
    330. 

  330.          IF ( ( ips .LE. iloc ) .AND. ( ipe .GE. iloc ) .AND. &
    331. 

  331.               ( jps .LE. jloc ) .AND. ( jpe .GE. jloc ) ) THEN
    332. 

  332.             lat2 = grid%xlat (iloc,jloc)
    333. 

  333.             lon2 = grid%xlong(iloc,jloc)
    334. 

  334.          ELSE
    335. 

  335.             lat2 = 99999.
    336. 

  336.             lon2 = 99999.
    337. 

  337.          END IF
    338. 

  338.          lat2 = wrf_dm_min_real ( lat2 )
    339. 

  339.          lon2 = wrf_dm_min_real ( lon2 )
    340. 

  340. 

  341.          iloc = (ide-1)/2
    342. 

  342.          jloc = (jde+1)/2
    343. 

  343.          IF ( ( ips .LE. iloc ) .AND. ( ipe .GE. iloc ) .AND. &
    344. 

  344.               ( jps .LE. jloc ) .AND. ( jpe .GE. jloc ) ) THEN
    345. 

  345.             lat3 = grid%xlat (iloc,jloc)
    346. 

  346.             lon3 = grid%xlong(iloc,jloc)
    347. 

  347.          ELSE
    348. 

  348.             lat3 = 99999.
    349. 

  349.             lon3 = 99999.
    350. 

  350.          END IF
    351. 

  351.          lat3 = wrf_dm_min_real ( lat3 )
    352. 

  352.          lon3 = wrf_dm_min_real ( lon3 )
    353. 

  353. 

  354.          iloc = (ide+1)/2
    355. 

  355.          jloc = (jde+1)/2
    356. 

  356.          IF ( ( ips .LE. iloc ) .AND. ( ipe .GE. iloc ) .AND. &
    357. 

  357.               ( jps .LE. jloc ) .AND. ( jpe .GE. jloc ) ) THEN
    358. 

  358.             lat4 = grid%xlat (iloc,jloc)
    359. 

  359.             lon4 = grid%xlong(iloc,jloc)
    360. 

  360.          ELSE
    361. 

  361.             lat4 = 99999.
    362. 

  362.             lon4 = 99999.
    363. 

  363.          END IF
    364. 

  364.          lat4 = wrf_dm_min_real ( lat4 )
    365. 

  365.          lon4 = wrf_dm_min_real ( lon4 )
    366. 

  366. 

  367.          CALL nl_set_cen_lat ( grid%id , ( lat1 + lat2 + lat3 + lat4 ) * 0.25 )
    368. 

  368.          CALL nl_set_cen_lon ( grid%id , ( lon1 + lon2 + lon3 + lon4 ) * 0.25 )
    369. 

  369.       END IF
    370. 

  370.    END IF
    371. 

  371. 

  372.    IF ( .NOT. config_flags%restart .AND. &
    373. 

  373.         (( config_flags%input_from_hires ) .OR. ( config_flags%input_from_file ))) THEN
    374. 

  374. 

  375.       IF ( config_flags%map_proj .EQ. 0 ) THEN
    376. 

  376.          CALL wrf_error_fatal ( 'start_domain: Idealized case cannot have a separate nested input file' )
    377. 

  377.       END IF
    378. 

  378. 

  379.       IF ( config_flags%use_baseparam_fr_nml ) then
    380. 

  380.       CALL nl_get_base_pres  ( 1 , p00 )
    381. 

  381.       CALL nl_get_base_temp  ( 1 , t00 )
    382. 

  382.       CALL nl_get_base_lapse ( 1 , a   )
    383. 

  383.       CALL nl_get_iso_temp   ( 1 , tiso )
    384. 

  384. 

  385.       ELSE
    386. 

  386.       ! get these constants from model data
    387. 

  387. 

  388.       t00  = grid%t00
    389. 

  389.       p00  = grid%p00
    390. 

  390.       a    = grid%tlp
    391. 

  391.       tiso = grid%tiso
    392. 

  392. 

  393.       IF (t00 .LT. 100. .or. p00 .LT. 10000.) THEN
    394. 

  394.       WRITE(wrf_err_message,*)&
    395. 

  395.       'start_em: did not find base state parameters in wrfinput. Add use_baseparam_fr_nml = .t. in &dynamics and rerun'
    396. 

  396.       CALL wrf_error_fatal(TRIM(wrf_err_message))
    397. 

  397.       ENDIF
    398. 

  398. 

  399.       ENDIF
    400. 

  400. 

  401.       !  Base state potential temperature and inverse density (alpha = 1/rho) from
    402. 

  402.       !  the half eta levels and the base-profile surface pressure.  Compute 1/rho
    403. 

  403.       !  from equation of state.  The potential temperature is a perturbation from t0.
    404. 

  404. 

  405.       DO j = jts, MIN(jte,jde-1)
    406. 

  406.          DO i = its, MIN(ite,ide-1)
    407. 

  407. 

  408.             !  Base state pressure is a function of eta level and terrain, only, plus
    409. 

  409.             !  the hand full of constants: p00 (sea level pressure, Pa), t00 (sea level
    410. 

  410.             !  temperature, K), and A (temperature difference, from 1000 mb to 300 mb, K).
    411. 

  411. 

  412.             p_surf = p00 * EXP ( -t00/a + ( (t00/a)**2 - 2.*g*grid%ht(i,j)/a/r_d ) **0.5 )
    413. 

  413. 

  414.             DO k = 1, kte-1
    415. 

  415.                grid%pb(i,k,j) = grid%znu(k)*(p_surf - grid%p_top) + grid%p_top
    416. 

  416.                temp = MAX ( tiso, t00 + A*LOG(grid%pb(i,k,j)/p00) )
    417. 

  417.                grid%t_init(i,k,j) = temp*(p00/grid%pb(i,k,j))**(r_d/cp) - t0
    418. 

  418. !              grid%t_init(i,k,j) = (t00 + A*LOG(grid%pb(i,k,j)/p00))*(p00/grid%pb(i,k,j))**(r_d/cp) - t0
    419. 

  419.                grid%alb(i,k,j) = (r_d/p1000mb)*(grid%t_init(i,k,j)+t0)*(grid%pb(i,k,j)/p1000mb)**cvpm
    420. 

  420.             END DO
    421. 

  421. 

  422.             !  Base state mu is defined as base state surface pressure minus grid%p_top
    423. 

  423. 

  424.             grid%mub(i,j) = p_surf - grid%p_top
    425. 

  425. 

  426.             !  Integrate base geopotential, starting at terrain elevation.  This assures that
    427. 

  427.             !  the base state is in exact hydrostatic balance with respect to the model equations.
    428. 

  428.             !  This field is on full levels.
    429. 

  429. 

  430.             grid%phb(i,1,j) = grid%ht(i,j) * g
    431. 

  431. 

  432.             IF ( config_flags%hypsometric_opt .EQ. 1 ) THEN
    433. 

  433.                DO k  = 2,kte
    434. 

  434.                   grid%phb(i,k,j) = grid%phb(i,k-1,j) - grid%dnw(k-1)*grid%mub(i,j)*grid%alb(i,k-1,j)
    435. 

  435.                END DO
    436. 

  436.             ELSE IF ( config_flags%hypsometric_opt .EQ. 2 ) THEN
    437. 

  437.                DO k  = 2,kte
    438. 

  438.                   pfu = grid%mub(i,j)*grid%znw(k)   + grid%p_top
    439. 

  439.                   pfd = grid%mub(i,j)*grid%znw(k-1) + grid%p_top
    440. 

  440.                   phm = grid%mub(i,j)*grid%znu(k-1) + grid%p_top
    441. 

  441.                   grid%phb(i,k,j) = grid%phb(i,k-1,j) + grid%alb(i,k-1,j)*phm*LOG(pfd/pfu)
    442. 

  442.                END DO
    443. 

  443.             END IF
    444. 

  444.          END DO
    445. 

  445.       END DO
    446. 

  446. 

  447.    ENDIF
    448. 

  448. 

  449.    IF(.not.config_flags%restart)THEN
    450. 

  450. 

  451. !  if this is for a nested domain, the defined/interpolated fields are the _2
    452. 

  452. 

  453.      IF ( first_trip_for_this_domain ) THEN
    454. 

  454. 

  455. ! data that is expected to be zero must be explicitly initialized as such
    456. 

  456. !    grid%h_diabatic = 0.
    457. 

  457. 

  458.        DO j = jts,min(jte,jde-1)
    459. 

  459.        DO k = kts,kte-1
    460. 

  460.        DO i = its, min(ite,ide-1)
    461. 

  461.            IF ( grid%imask_nostag(i,j) .EQ. 1 ) THEN
    462. 

  462.              grid%t_1(i,k,j)=grid%t_2(i,k,j)
    463. 

  463.            ENDIF
    464. 

  464.        ENDDO
    465. 

  465.        ENDDO
    466. 

  466.        ENDDO
    467. 

  467. 

  468.        DO j = jts,min(jte,jde-1)
    469. 

  469.        DO k = kts,kte
    470. 

  470.        DO i = its, min(ite,ide-1)
    471. 

  471.           grid%ph_1(i,k,j)=grid%ph_2(i,k,j)
    472. 

  472.        ENDDO
    473. 

  473.        ENDDO
    474. 

  474.        ENDDO
    475. 

  475. 

  476.        DO j = jts,min(jte,jde-1)
    477. 

  477.        DO i = its, min(ite,ide-1)
    478. 

  478.            IF ( grid%imask_nostag(i,j) .EQ. 1 ) THEN
    479. 

  479.              grid%mu_1(i,j)=grid%mu_2(i,j)
    480. 

  480.            ENDIF
    481. 

  481.        ENDDO
    482. 

  482.        ENDDO
    483. 

  483.      END IF
    484. 

  484. 

  485. !  reconstitute base-state fields
    486. 

  486. 

  487.     IF(config_flags%max_dom .EQ. 1)THEN
    488. 

  488. ! with single domain, grid%t_init from wrfinput is OK to use
    489. 

  489.      DO j = jts,min(jte,jde-1)
    490. 

  490.      DO k = kts,kte-1
    491. 

  491.      DO i = its, min(ite,ide-1)
    492. 

  492.        IF ( grid%imask_nostag(i,j) .EQ. 1 ) THEN
    493. 

  493.          grid%pb(i,k,j) = grid%znu(k)*grid%mub(i,j)+grid%p_top
    494. 

  494.          grid%alb(i,k,j) = (r_d/p1000mb)*(grid%t_init(i,k,j)+t0)*(grid%pb(i,k,j)/p1000mb)**cvpm
    495. 

  495.        ENDIF
    496. 

  496.      ENDDO
    497. 

  497.      ENDDO
    498. 

  498.      ENDDO
    499. 

  499.     ELSE
    500. 

  500. ! with nests, grid%t_init generally needs recomputations (since it is not interpolated)
    501. 

  501.      DO j = jts,min(jte,jde-1)
    502. 

  502.      DO k = kts,kte-1
    503. 

  503.      DO i = its, min(ite,ide-1)
    504. 

  504.        IF ( grid%imask_nostag(i,j) .EQ. 1 ) THEN
    505. 

  505.          grid%pb(i,k,j) = grid%znu(k)*grid%mub(i,j)+grid%p_top
    506. 

  506.          grid%alb(i,k,j) = -grid%rdnw(k)*(grid%phb(i,k+1,j)-grid%phb(i,k,j))/grid%mub(i,j)
    507. 

  507.          grid%t_init(i,k,j) = grid%alb(i,k,j)*(p1000mb/r_d)/((grid%pb(i,k,j)/p1000mb)**cvpm) - t0
    508. 

  508.        ENDIF
    509. 

  509.      ENDDO
    510. 

  510.      ENDDO
    511. 

  511.      ENDDO
    512. 

  512.     ENDIF
    513. 

  513. 

  514. ! Use equations from calc_p_rho_phi to derive p and al from ph: linear in log p
    515. 

  515. 

  516.     IF ( config_flags%hypsometric_opt .EQ. 1 ) THEN
    517. 

  517.        DO j=jts,min(jte,jde-1)
    518. 

  518.        DO k=kts,kte-1
    519. 

  519.        DO i=its,min(ite,ide-1)
    520. 

  520.           grid%al(i,k,j)=-1./(grid%mub(i,j)+grid%mu_1(i,j))*(grid%alb(i,k,j)*grid%mu_1(i,j)  &
    521. 

  521.                      +grid%rdnw(k)*(grid%ph_1(i,k+1,j)-grid%ph_1(i,k,j)))
    522. 

  522.        ENDDO
    523. 

  523.        ENDDO
    524. 

  524.        ENDDO
    525. 

  525.     ELSE IF ( config_flags%hypsometric_opt .EQ. 2 ) THEN
    526. 

  526.        DO j=jts,min(jte,jde-1)
    527. 

  527.        DO k=kts,kte-1
    528. 

  528.        DO i=its,min(ite,ide-1)
    529. 

  529.           pfu = (grid%mub(i,j)+grid%mu_1(i,j))*grid%znw(k+1)+grid%p_top
    530. 

  530.           pfd = (grid%mub(i,j)+grid%mu_1(i,j))*grid%znw(k)  +grid%p_top
    531. 

  531.           phm = (grid%mub(i,j)+grid%mu_1(i,j))*grid%znu(k)  +grid%p_top
    532. 

  532.           grid%al(i,k,j) = (grid%ph_1(i,k+1,j)-grid%ph_1(i,k,j)+grid%phb(i,k+1,j)-grid%phb(i,k,j)) &
    533. 

  533.                             /phm/LOG(pfd/pfu)-grid%alb(i,k,j)
    534. 

  534.        ENDDO
    535. 

  535.        ENDDO
    536. 

  536.        ENDDO
    537. 

  537.     END IF
    538. 

  538.     DO j=jts,min(jte,jde-1)
    539. 

  539.     DO k=kts,kte-1
    540. 

  540.     DO i=its,min(ite,ide-1)
    541. 

  541.        qvf = 1.+rvovrd*moist(i,k,j,P_QV)
    542. 

  542.        grid%p(i,k,j)=p1000mb*( (r_d*(t0+grid%t_1(i,k,j))*qvf)/                     &
    543. 

  543.                   (p1000mb*(grid%al(i,k,j)+grid%alb(i,k,j))) )**cpovcv  &
    544. 

  544.                   -grid%pb(i,k,j)
    545. 

  545.        grid%p_hyd(i,k,j) = grid%p(i,k,j) + grid%pb(i,k,j)
    546. 

  546.        grid%alt(i,k,j) = grid%al(i,k,j) + grid%alb(i,k,j)
    547. 

  547.     ENDDO
    548. 

  548.     ENDDO
    549. 

  549.     ENDDO
    550. 

  550. 

  551.    ENDIF
    552. 

  552. 

  553.    IF ( grid%press_adj .and. ( grid%id .NE. 1 ) .AND. .NOT. ( config_flags%restart ) .AND. &
    554. 

  554.        ( ( config_flags%input_from_hires ) .OR. ( config_flags%input_from_file ) ) ) THEN
    555. 

  555.       DO j = jts, MIN(jte,jde-1)
    556. 

  556.          DO i = its, MIN(ite,ide-1)
    557. 

  557.             grid%mu_2(i,j) = grid%mu_2(i,j) + grid%al(i,1,j) / ( grid%alt(i,1,j) * grid%alb(i,1,j) ) * &
    558. 

  558.                                     g * ( grid%ht(i,j) - grid%ht_fine(i,j) )
    559. 

  559.          END DO
    560. 

  560.        END DO
    561. 

  561.        DO j = jts,min(jte,jde-1)
    562. 

  562.        DO i = its, min(ite,ide-1)
    563. 

  563.           grid%mu_1(i,j)=grid%mu_2(i,j)
    564. 

  564.        ENDDO
    565. 

  565.        ENDDO
    566. 

  566. 

  567.    END IF
    568. 

  568. 

  569.    IF ( first_trip_for_this_domain ) THEN
    570. 

  570. 

  571.    CALL wrf_debug ( 100 , 'start_domain_em: Before call to phy_init' )
    572. 

  572. 

  573. ! namelist MPDT does not exist yet, so set it here
    574. 

  574. ! MPDT is the call frequency for microphysics in minutes (0 means every step)
    575. 

  575.    MPDT = 0.
    576. 

  576. 

  577. ! set GMT outside of phy_init because phy_init may not be called on this
    578. 

  578. ! process if, for example, it is a moving nest and if this part of the domain is not
    579. 

  579. ! being initialized (not the leading edge).
    580. 

  580.    CALL domain_setgmtetc( grid, start_of_simulation )
    581. 

  581. 

  582. !-----------------------------------------------------------------------------
    583. 

  583. ! Adaptive time step: Added by T. Hutchinson, WSI  11/6/07
    584. 

  584. !
    585. 

  585. !
    586. 

  586. 

  587.    IF ( ( grid%use_adaptive_time_step ) .AND. &
    588. 

  588.         ( ( grid%dfi_opt .EQ. DFI_NODFI ) .OR. ( grid%dfi_stage .EQ. DFI_FST ) ) ) THEN
    589. 

  589. 

  590. !  Calculate any variables that were not set
    591. 

  591. 

  592.       if (grid%starting_time_step == -1) then
    593. 

  593.          grid%starting_time_step = NINT(6 * MIN(grid%dx,grid%dy) / 1000)
    594. 

  594.       endif
    595. 

  595. 

  596.       if (grid%max_time_step == -1) then
    597. 

  597.          grid%max_time_step = 3*grid%starting_time_step
    598. 

  598.       endif
    599. 

  599. 

  600.       if (grid%min_time_step == -1) then
    601. 

  601.          grid%min_time_step = 0.5*grid%starting_time_step
    602. 

  602.       endif
    603. 

  603. 

  604. !     Set a starting timestep.
    605. 

  605. 

  606.       grid%dt = grid%starting_time_step
    607. 

  607. 

  608. !     Initialize max cfl values
    609. 

  609.       
    610. 

  610.       grid%last_max_vert_cfl = 0
    611. 

  611.       grid%last_max_horiz_cfl = 0
    612. 

  612. 

  613. !     Check to assure that time_step_sound is to be dynamically set.
    614. 

  614. 

  615.       CALL nl_set_time_step_sound ( 1 , 0 )
    616. 

  616.       grid%time_step_sound = 0
    617. 

  617. 

  618.       grid%max_msftx=MAXVAL(grid%msftx)
    619. 

  619.       grid%max_msfty=MAXVAL(grid%msfty)
    620. 

  620. #ifdef DM_PARALLEL
    621. 

  621.       CALL wrf_dm_maxval(grid%max_msftx, idex, jdex)
    622. 

  622.       CALL wrf_dm_maxval(grid%max_msfty, idex, jdex)
    623. 

  623. #endif
    624. 

  624. 

  625. !     This first call just initializes variables.
    626. 

  626. !     If a restart, get initialized variables from restart file
    627. 

  627. 

  628.       IF ( .NOT. ( config_flags%restart ) ) then
    629. 

  629.          CALL adapt_timestep(grid, config_flags)
    630. 

  630.       END IF
    631. 

  631. 

  632. 

  633.    END IF
    634. 

  634. 

  635. ! End of adaptive time step modifications
    636. 

  636. !-----------------------------------------------------------------------------
    637. 

  637. 

  638. 

  639.    CALL set_tiles ( grid , grid%imask_nostag, ims, ime, jms, jme, ips, ipe, jps, jpe )
    640. 

  640. !
    641. 

  641. ! Phy init can do reads and broadcasts when initializing physics -- landuse for example. However, if
    642. 

  642. ! we're running on a reduced mesh (that is, some tasks don't have any work) we have to at least let them
    643. 

  643. ! pass through this code so the broadcasts don't hang on the other, active tasks.  Set the number of
    644. 

  644. ! tiles to a minimum of 1 and assume that the backwards patch ranges (ips=0, ipe=-1) will prevent
    645. 

  645. ! anything else from happening on the blank tasks.  JM 20080605
    646. 

  646. !
    647. 

  647.    if ( allowed_to_read ) grid%num_tiles = max(1,grid%num_tiles)
    648. 

  648. !
    649. 

  649. ! Phy_init is not necessarily thread-safe; do not multi-thread this loop.
    650. 

  650. ! The tiling is to handle the fact that we may be masking off part of the computation.
    651. 

  651. !
    652. 

  652.    DO ij = 1, grid%num_tiles
    653. 

  653. 

  654. !tgs do not need physics initialization for backward DFI integration
    655. 

  655.      IF ( grid%dfi_opt .NE. DFI_NODFI .and. grid%dfi_stage .EQ. DFI_FST) THEN     !tgs
    656. 

  656.         grid%stepra=nint(grid%RADT*60./grid%DT)
    657. 

  657.         grid%stepra=max(grid%stepra,1)
    658. 

  658.         grid%stepbl=nint(grid%BLDT*60./grid%DT)
    659. 

  659.         grid%stepbl=max(grid%stepbl,1)
    660. 

  660.         grid%stepcu=nint(grid%CUDT*60./grid%DT)
    661. 

  661.         grid%stepcu=max(grid%stepcu,1)
    662. 

  662.         grid%stepfg=nint(grid%FGDT*60./grid%DT)
    663. 

  663.         grid%stepfg=max(grid%stepfg,1)
    664. 

  664.      ENDIF
    665. 

  665.      
    666. 

  666.     IF ( ( grid%dfi_opt .EQ. DFI_NODFI ) .or. &
    667. 

  667.           ( ( grid%dfi_stage .NE. DFI_BCK ) .and. &
    668. 

  668.           ( grid%dfi_stage .NE. DFI_STARTBCK ) ) ) THEN    !tgs, mods by tah
    669. 

  669. 

  670.      CALL phy_init (  grid%id , config_flags, grid%DT, grid%RESTART, grid%znw, grid%znu,   &
    671. 

  671.                       grid%p_top, grid%tsk, grid%RADT,grid%BLDT,grid%CUDT, MPDT, &
    672. 

  672.                       grid%rucuten, grid%rvcuten, grid%rthcuten,             &
    673. 

  673.                       grid%rqvcuten, grid%rqrcuten, grid%rqccuten,           &
    674. 

  674.                       grid%rqscuten, grid%rqicuten,                          &
    675. 

  675.                       grid%rushten, grid%rvshten, grid%rthshten,             &
    676. 

  676.                       grid%rqvshten, grid%rqrshten, grid%rqcshten,           &
    677. 

  677.                       grid%rqsshten, grid%rqishten, grid%rqgshten,           &
    678. 

  678.                       grid%rublten,grid%rvblten,grid%rthblten,               &
    679. 

  679.                       grid%rqvblten,grid%rqcblten,grid%rqiblten,             &
    680. 

  680.                       grid%rthraten,grid%rthratenlw,grid%rthratensw,         &
    681. 

  681.                       grid%stepbl,grid%stepra,grid%stepcu,                   &
    682. 

  682.                       grid%w0avg, grid%rainnc, grid%rainc, grid%raincv, grid%rainncv,  &
    683. 

  683.                       grid%snownc, grid%snowncv, grid%graupelnc, grid%graupelncv,  &
    684. 

  684.                       grid%nca,grid%swrad_scat,                    &
    685. 

  685.                       grid%cldefi,grid%lowlyr,                          &
    686. 

  686.                       grid%mass_flux,                              &
    687. 

  687.                       grid%rthften, grid%rqvften,                       &
    688. 

  688.                       grid%cldfra,                                      &
    689. 

  689. #ifdef WRF_CHEM
    690. 

  690.                       grid%cldfra_old,                                  &
    691. 

  691. #endif
    692. 

  692. #ifndef WRF_CHEM
    693. 

  693.                       cldfra_old,                                  &
    694. 

  694. #endif
    695. 

  695.                       grid%glw,grid%gsw,grid%emiss,grid%embck,            &
    696. 

  696.                       grid%lu_index,                                      &
    697. 

  697.                       grid%landuse_ISICE, grid%landuse_LUCATS,            &
    698. 

  698.                       grid%landuse_LUSEAS, grid%landuse_ISN,              &
    699. 

  699.                       grid%lu_state,                                      &
    700. 

  700.                       grid%xlat,grid%xlong,grid%albedo,grid%albbck,grid%GMT,grid%JULYR,grid%JULDAY,     &
    701. 

  701.                       grid%levsiz, num_ozmixm, num_aerosolc, grid%paerlev,  &
    702. 

  702.                       grid%tmn,grid%xland,grid%znt,grid%z0,grid%ust,grid%mol,grid%pblh,grid%tke_pbl,    &
    703. 

  703.                       grid%exch_h,grid%thc,grid%snowc,grid%mavail,grid%hfx,grid%qfx,grid%rainbl, &
    704. 

  704.                       grid%tslb,grid%zs,grid%dzs,config_flags%num_soil_layers,grid%warm_rain,  &
    705. 

  705.                       grid%adv_moist_cond,                         &
    706. 

  706.                       grid%apr_gr,grid%apr_w,grid%apr_mc,grid%apr_st,grid%apr_as,      &
    707. 

  707.                       grid%apr_capma,grid%apr_capme,grid%apr_capmi,          &
    708. 

  708.                       grid%xice,grid%xicem,grid%vegfra,grid%snow,grid%canwat,grid%smstav,         &
    709. 

  709.                       grid%smstot, grid%sfcrunoff,grid%udrunoff,grid%grdflx,grid%acsnow,      &
    710. 

  710.                       grid%acsnom,grid%ivgtyp,grid%isltyp, grid%sfcevp,grid%smois,     &
    711. 

  711.                       grid%sh2o, grid%snowh, grid%smfr3d,                    &
    712. 

  712.                       grid%snoalb,                 &
    713. 

  713.                       grid%DX,grid%DY,grid%f_ice_phy,grid%f_rain_phy,grid%f_rimef_phy, &
    714. 

  714.                       grid%mp_restart_state,grid%tbpvs_state,grid%tbpvs0_state,&
    715. 

  715.                       allowed_to_read, grid%moved, start_of_simulation,               &
    716. 

  716.                       grid%LAGDAY, &
    717. 

  717.                       ids, ide, jds, jde, kds, kde,           &
    718. 

  718.                       ims, ime, jms, jme, kms, kme,           &
    719. 

  719.                       grid%i_start(ij), grid%i_end(ij), grid%j_start(ij), grid%j_end(ij), kts, kte, &
    720. 

  720.                       config_flags%num_urban_layers,                        & !multi-layer urban
    721. 

  721.                       grid%raincv_a,grid%raincv_b,                                    &
    722. 

  722.                       grid%gd_cloud, grid%gd_cloud2,                                  & ! Optional
    723. 

  723.                       grid%gd_cloud_a, grid%gd_cloud2_a,                              & ! Optional
    724. 

  724.                       grid%gd_cloud_b, grid%gd_cloud2_b,                              & ! Optional
    725. 

  725.                       ozmixm,grid%pin,                             &     ! Optional
    726. 

  726.                       grid%m_ps_1,grid%m_ps_2,grid%m_hybi,aerosolc_1,aerosolc_2,&  ! Optional
    727. 

  727.                       grid%rundgdten,grid%rvndgdten,grid%rthndgdten,         &     ! Optional
    728. 

  728.                       grid%rphndgdten,grid%rqvndgdten,grid%rmundgdten,       &     ! Optional
    729. 

  729.                       grid%FGDT,grid%stepfg,                        &     ! Optional
    730. 

  730.                       grid%cugd_tten,grid%cugd_ttens,grid%cugd_qvten,        &   ! Optional
    731. 

  731.                       grid%cugd_qvtens,grid%cugd_qcten,                 &   ! Optional
    732. 

  732.                       grid%ISNOWXY, grid%ZSNSOXY, grid%TSNOXY,                                  &   ! Optional Noah-MP
    733. 

  733.                       grid%SNICEXY, grid%SNLIQXY, grid%TVXY, grid%TGXY, grid%CANICEXY,          &   ! Optional Noah-MP
    734. 

  734.                       grid%CANLIQXY, grid%EAHXY, grid%TAHXY, grid%CMXY,                         &   ! Optional Noah-MP
    735. 

  735.                       grid%CHXY, grid%FWETXY, grid%SNEQVOXY, grid%ALBOLDXY, grid%QSNOWXY,       &   ! Optional Noah-MP
    736. 

  736.                       grid%WSLAKEXY, grid%ZWTXY, grid%WAXY, grid%WTXY, grid%LFMASSXY, grid%RTMASSXY, & ! Optional Noah-MP
    737. 

  737.                       grid%STMASSXY, grid%WOODXY, grid%STBLCPXY, grid%FASTCPXY,                 &   ! Optional Noah-MP
    738. 

  738.                       grid%XSAIXY,                                                              &   ! Optional Noah-MP
    739. 

  739.                       grid%T2MVXY, grid%T2MBXY, grid%CHSTARXY,                                  &   ! Optional Noah-MP
    740. 

  740.                       grid%DZR, grid%DZB, grid%DZG,                          & !Optional urban
    741. 

  741.                       grid%TR_URB2D,grid%TB_URB2D,grid%TG_URB2D,grid%TC_URB2D,    & !Optional urban
    742. 

  742.                       grid%QC_URB2D, grid%XXXR_URB2D,grid%XXXB_URB2D,        & !Optional urban
    743. 

  743.                       grid%XXXG_URB2D, grid%XXXC_URB2D,                 & !Optional urban
    744. 

  744.                       grid%TRL_URB3D, grid%TBL_URB3D, grid%TGL_URB3D,        & !Optional urban
    745. 

  745.                       grid%SH_URB2D, grid%LH_URB2D, grid%G_URB2D, grid%RN_URB2D,  & !Optional urban
    746. 

  746.                       grid%TS_URB2D, grid%FRC_URB2D, grid%UTYPE_URB2D,      & !Optional urban
    747. 

  747.                       grid%TRB_URB4D,grid%TW1_URB4D,grid%TW2_URB4D,grid%TGB_URB4D,grid%TLEV_URB3D,  & !multi-layer urban
    748. 

  748.                       grid%QLEV_URB3D,grid%TW1LEV_URB3D,grid%TW2LEV_URB3D,        & !multi-layer urban
    749. 

  749.                       grid%TGLEV_URB3D,grid%TFLEV_URB3D,grid%SF_AC_URB3D,         & !multi-layer urban 
    750. 

  750.                       grid%LF_AC_URB3D,grid%CM_AC_URB3D,grid%SFVENT_URB3D,grid%LFVENT_URB3D,   & !multi-layer urban
    751. 

  751.                       grid%SFWIN1_URB3D,grid%SFWIN2_URB3D, & !multi-layer urban
    752. 

  752.                       grid%SFW1_URB3D,grid%SFW2_URB3D,grid%SFR_URB3D,grid%SFG_URB3D,     & !multi-layer urban
    753. 

  753.                       grid%A_U_BEP,grid%A_V_BEP,grid%A_T_BEP,grid%A_Q_BEP,             & !multi-layer urban
    754. 

  754.                       grid%A_E_BEP,grid%B_U_BEP,grid%B_V_BEP,grid%B_T_BEP,             & !multi-layer urban
    755. 

  755.                       grid%B_Q_BEP,grid%B_E_BEP,grid%DLG_BEP,                          & !multi-layer urban
    756. 

  756.                       grid%DL_U_BEP,grid%SF_BEP,grid%VL_BEP,                           & !multi-layer urban
    757. 

  757.                       grid%TML,grid%T0ML,grid%HML,grid%H0ML,grid%HUML,grid%HVML,grid%TMOML,     & !Optional oml
    758. 

  758.                       grid%itimestep, grid%fdob,            &
    759. 

  759.                       t00, p00, a,                      & ! for obs_nudge base state
    760. 

  760.                       grid%TYR, grid%TYRA, grid%TDLY, grid%TLAG, grid%NYEAR, grid%NDAY,grid%tmn_update, &
    761. 

  761.                       grid%achfx, grid%aclhf, grid%acgrdflx                 &
    762. 

  762.                       ,grid%te_temf,grid%cf3d_temf,grid%wm_temf        & ! WA
    763. 

  763.                       ,grid%massflux_EDKF, grid%entr_EDKF, grid%detr_EDKF                & 
    764. 

  764.                       ,grid%thl_up,grid%thv_up,grid%rt_up                                &
    765. 

  765.                       ,grid%rv_up,grid%rc_up,grid%u_up,grid%v_up,grid%frac_up            &
    766. 

  766.                       )
    767. 

  767.        ENDIF   !tgs
    768. 

  768. 

  769.    ENDDO
    770. 

  770. 

  771.    CALL wrf_debug ( 100 , 'start_domain_em: After call to phy_init' )
    772. 

  772. 

  773.    IF (config_flags%do_avgflx_em .EQ. 1) THEN
    774. 

  774.       WRITE ( message , FMT = '("start_em: initializing avgflx on domain ",I3)' ) &
    775. 

  775.            & grid%id
    776. 

  776.       CALL wrf_message(trim(message)) 
    777. 

  777.       grid%avgflx_count = 0
    778. 

  778.       f_flux = config_flags%do_avgflx_cugd .EQ. 1  ! WA 9/24/10
    779. 

  779.       DO ij = 1, grid%num_tiles
    780. 

  780.          call wrf_debug(200,'In start_em, before zero_avgflx call')
    781. 

  781.          if (.not. grid%restart) call zero_avgflx(grid%avgflx_rum,grid%avgflx_rvm,grid%avgflx_wwm, &
    782. 

  782.               &   ids, ide, jds, jde, kds, kde,           &
    783. 

  783.               &   ims, ime, jms, jme, kms, kme,           &
    784. 

  784.               &   grid%i_start(ij), grid%i_end(ij), grid%j_start(ij), grid%j_end(ij), kts, kte, f_flux, &
    785. 

  785.               &   grid%avgflx_cfu1,grid%avgflx_cfd1,grid%avgflx_dfu1, &
    786. 

  786.               &   grid%avgflx_efu1,grid%avgflx_dfd1,grid%avgflx_efd1 )
    787. 

  787.          call wrf_debug(200,'In start_em, after zero_avgflx call')
    788. 

  788.       ENDDO
    789. 

  789.    ENDIF
    790. 

  790. 

  791. #ifdef MCELIO
    792. 

  792.    grid%LU_MASK = 0.
    793. 

  793.    WHERE ( grid%lu_index .EQ. 16 ) grid%LU_MASK = 1.
    794. 

  794. #endif
    795. 

  795. 

  796.    END IF
    797. 

  797. 

  798. #if 0
    799. 

  799. #include "CYCLE_TEST.inc"
    800. 

  800. #endif
    801. 

  801. 

  802. !
    803. 

  803. !
    804. 

  804. 

  805.  !  set physical boundary conditions for all initialized variables
    806. 

  806. 

  807. !-----------------------------------------------------------------------
    808. 

  808. !  Stencils for patch communications  (WCS, 29 June 2001)
    809. 

  809. !  Note:  the size of this halo exchange reflects the
    810. 

  810. !         fact that we are carrying the uncoupled variables
    811. 

  811. !         as state variables in the mass coordinate model, as
    812. 

  812. !         opposed to the coupled variables as in the height
    813. 

  813. !         coordinate model.
    814. 

  814. !
    815. 

  815. !                           * * * * *
    816. 

  816. !         *        * * *    * * * * *
    817. 

  817. !       * + *      * + *    * * + * *
    818. 

  818. !         *        * * *    * * * * *
    819. 

  819. !                           * * * * *
    820. 

  820. !
    821. 

  821. !j  grid%u_1                          x
    822. 

  822. !j  grid%u_2                          x
    823. 

  823. !j  grid%v_1                          x
    824. 

  824. !j  grid%v_2                          x
    825. 

  825. !j  grid%w_1                          x
    826. 

  826. !j  grid%w_2                          x
    827. 

  827. !j  grid%t_1                          x
    828. 

  828. !j  grid%t_2                          x
    829. 

  829. !j grid%ph_1                          x
    830. 

  830. !j grid%ph_2                          x
    831. 

  831. !
    832. 

  832. !j  grid%t_init                       x
    833. 

  833. !
    834. 

  834. !j  grid%phb   x
    835. 

  835. !j  grid%ph0   x
    836. 

  836. !j  grid%php   x
    837. 

  837. !j   grid%pb   x
    838. 

  838. !j   grid%al   x
    839. 

  839. !j  grid%alt   x
    840. 

  840. !j  grid%alb   x
    841. 

  841. !
    842. 

  842. !  the following are 2D (xy) variables
    843. 

  843. !
    844. 

  844. !j grid%mu_1                          x
    845. 

  845. !j grid%mu_2                          x
    846. 

  846. !j grid%mub   x
    847. 

  847. !j grid%mu0   x
    848. 

  848. !j grid%ht    x
    849. 

  849. !j grid%msftx x
    850. 

  850. !j grid%msfty x
    851. 

  851. !j grid%msfux x
    852. 

  852. !j grid%msfuy x
    853. 

  853. !j grid%msfvx x
    854. 

  854. !j grid%msfvy x
    855. 

  855. !j grid%sina  x
    856. 

  856. !j grid%cosa  x
    857. 

  857. !j grid%e     x
    858. 

  858. !j grid%f     x
    859. 

  859. !
    860. 

  860. !  4D variables
    861. 

  861. !
    862. 

  862. ! moist                        x
    863. 

  863. !  chem                        x
    864. 

  864. !scalar                        x
    865. 

  865. 

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

  867. 

  868. #ifdef DM_PARALLEL
    869. 

  869. #  include "HALO_EM_INIT_1.inc"
    870. 

  870. #  include "HALO_EM_INIT_2.inc"
    871. 

  871. #  include "HALO_EM_INIT_3.inc"
    872. 

  872. #  include "HALO_EM_INIT_4.inc"
    873. 

  873. #  include "HALO_EM_INIT_5.inc"
    874. 

  874. #  include "PERIOD_BDY_EM_INIT.inc"
    875. 

  875. #  include "PERIOD_BDY_EM_MOIST.inc"
    876. 

  876. #  include "PERIOD_BDY_EM_TKE.inc"
    877. 

  877. #  include "PERIOD_BDY_EM_SCALAR.inc"
    878. 

  878. #  include "PERIOD_BDY_EM_CHEM.inc"
    879. 

  879. #endif
    880. 

  880. 

  881. 

  882.    CALL set_physical_bc3d( grid%u_1 , 'U' , config_flags ,                  &
    883. 

  883.                          ids , ide , jds , jde , kds , kde ,        &
    884. 

  884.                          ims , ime , jms , jme , kms , kme ,        &
    885. 

  885.                          its , ite , jts , jte , kts , kte ,        &
    886. 

  886.                          its , ite , jts , jte , kts , kte )
    887. 

  887.    CALL set_physical_bc3d( grid%u_2 , 'U' , config_flags ,                  &
    888. 

  888.                          ids , ide , jds , jde , kds , kde ,        &
    889. 

  889.                          ims , ime , jms , jme , kms , kme ,        &
    890. 

  890.                          its , ite , jts , jte , kts , kte ,        &
    891. 

  891.                          its , ite , jts , jte , kts , kte )
    892. 

  892. 

  893.    CALL set_physical_bc3d( grid%v_1 , 'V' , config_flags ,                  &
    894. 

  894.                          ids , ide , jds , jde , kds , kde ,        &
    895. 

  895.                          ims , ime , jms , jme , kms , kme ,        &
    896. 

  896.                          its , ite , jts , jte , kts , kte ,        &
    897. 

  897.                          its , ite , jts , jte , kts , kte )
    898. 

  898.    CALL set_physical_bc3d( grid%v_2 , 'V' , config_flags ,                  &
    899. 

  899.                          ids , ide , jds , jde , kds , kde ,        &
    900. 

  900.                          ims , ime , jms , jme , kms , kme ,        &
    901. 

  901.                          its , ite , jts , jte , kts , kte ,        &
    902. 

  902.                          its , ite , jts , jte , kts , kte )
    903. 

  903. 

  904. ! set kinematic condition for w
    905. 

  905. 

  906.    CALL set_physical_bc2d( grid%ht , 'r' , config_flags ,                &
    907. 

  907.                            ids , ide , jds , jde , &
    908. 

  908.                            ims , ime , jms , jme , &
    909. 

  909.                            its , ite , jts , jte , &
    910. 

  910.                            its , ite , jts , jte   )
    911. 

  911. 

  912. ! Set the w at the surface.  If this is the start of a forecast, or if this is a cycled run
    913. 

  913. ! and the start of that forecast, we define the w field.  However, if this a restart, then 
    914. 

  914. ! we leave w alone.  Initial value is V dot grad(topo) at surface, then smoothly decaying
    915. 

  915. ! above that.
    916. 

  916. 

  917.    IF ( ( start_of_simulation .OR. config_flags%cycling ) .AND. ( .NOT. config_flags%restart ) ) THEN
    918. 

  918. 

  919. ! If W already exists (not zero), then we leave it alone.  How to do this?  We find the
    920. 

  920. ! max/min on this node at the surface.  If parallel, we collect the max/min from all procs.
    921. 

  921. ! If the max/min throughout the entire domain at the surface is identically 0, then we say 
    922. 

  922. ! that the W field is NOT initialized, and we run the set_w_surface routines for the 
    923. 

  923. ! two time levels of W.  If the field is already initialized, we do NOT run those two
    924. 

  924. ! routines.
    925. 

  925. 

  926.       w_max = grid%w_2(its,1,jts)
    927. 

  927.       w_min = grid%w_2(its,1,jts)
    928. 

  928.       DO j = jts, MIN(jte,jde-1)
    929. 

  929.          DO i = its, MIN(ite,ide-1)
    930. 

  930.          w_max = MAX ( w_max , grid%w_2(i,1,j) )
    931. 

  931.          w_min = MIN ( w_min , grid%w_2(i,1,j) )
    932. 

  932.          END DO
    933. 

  933.       END DO
    934. 

  934. #ifdef DM_PARALLEL
    935. 

  935.       w_max = wrf_dm_max_real ( w_max )
    936. 

  936.       w_min = wrf_dm_min_real ( w_min )
    937. 

  937. #endif
    938. 

  938. 

  939.       IF ( ( ABS(w_max) .LT. 1.E-6 ) .AND. &
    940. 

  940.            ( ABS(w_min) .LT. 1.E-6 ) ) THEN
    941. 

  941.          w_needs_to_be_set = .TRUE.
    942. 

  942.       ELSE
    943. 

  943.          IF ( config_flags%use_input_w ) THEN
    944. 

  944.             w_needs_to_be_set = .FALSE.
    945. 

  945.          ELSE
    946. 

  946.             w_needs_to_be_set = .TRUE.
    947. 

  947.          END IF
    948. 

  948.       END IF
    949. 

  949. 

  950.       IF ( w_needs_to_be_set ) THEN
    951. 

  951. 

  952.          ! setting kinematic condition for w at the surface
    953. 

  953. 

  954.          fill_w_flag = .true.
    955. 

  955.          CALL set_w_surface(  config_flags, grid%znw, fill_w_flag,             &
    956. 

  956.                               grid%w_1, grid%ht, grid%u_1, grid%v_1, grid%cf1, &
    957. 

  957.                               grid%cf2, grid%cf3, grid%rdx, grid%rdy, grid%msftx, grid%msfty, &
    958. 

  958.                               ids, ide, jds, jde, kds, kde,                    &
    959. 

  959.                               ims, ime, jms, jme, kms, kme,                    &
    960. 

  960.                               its, ite, jts, jte, kts, kte                     )
    961. 

  961.          CALL set_w_surface(  config_flags, grid%znw, fill_w_flag,             &
    962. 

  962.                               grid%w_2, grid%ht, grid%u_2, grid%v_2, grid%cf1, &
    963. 

  963.                               grid%cf2, grid%cf3, grid%rdx, grid%rdy, grid%msftx, grid%msfty, &
    964. 

  964.                               ids, ide, jds, jde, kds, kde,                    &
    965. 

  965.                               ims, ime, jms, jme, kms, kme,                    &
    966. 

  966.                               its, ite, jts, jte, kts, kte                     ) 
    967. 

  967.       END IF
    968. 

  968. 

  969. 

  970. ! set up slope-radiation constant arrays based on topography
    971. 

  971. ! paj: also computes laplacian for topo_wind
    972. 

  972. !
    973. 

  973.        DO j = jts,min(jte,jde-1)
    974. 

  974.        DO i = its, min(ite,ide-1)
    975. 

  975.           im1 = max(i-1,ids)
    976. 

  976.           ip1 = min(i+1,ide-1)
    977. 

  977.           jm1 = max(j-1,jds)
    978. 

  978.           jp1 = min(j+1,jde-1)
    979. 

  979.           grid%toposlpx(i,j)=(grid%ht(ip1,j)-grid%ht(im1,j))*grid%msftx(i,j)*grid%rdx/(ip1-im1)
    980. 

  980.           grid%toposlpy(i,j)=(grid%ht(i,jp1)-grid%ht(i,jm1))*grid%msfty(i,j)*grid%rdy/(jp1-jm1)
    981. 

  981.           grid%lap_hgt(i,j)=(grid%ht(ip1,j)+grid%ht(im1,j)+grid%ht(i,jp1)+grid%ht(i,jm1)-grid%ht(i,j)*4.)/4.
    982. 

  982.              hx = grid%toposlpx(i,j)
    983. 

  983.              hy = grid%toposlpy(i,j)
    984. 

  984.              pi = 4.*atan(1.)
    985. 

  985.              grid%slope(i,j) = atan((hx**2+hy**2)**.5)
    986. 

  986.              if (grid%slope(i,j).lt.1.e-4) then
    987. 

  987.                grid%slope(i,j) = 0.
    988. 

  988.                grid%slp_azi(i,j) = 0.
    989. 

  989.              else
    990. 

  990.                grid%slp_azi(i,j) = atan2(hx,hy)+pi
    991. 

  991. 

  992. ! Rotate slope azimuth to lat-lon grid
    993. 

  993.                if (grid%cosa(i,j).ge.0) then
    994. 

  994.                  grid%slp_azi(i,j) = grid%slp_azi(i,j) - asin(grid%sina(i,j))
    995. 

  995.                else
    996. 

  996.                  grid%slp_azi(i,j) = grid%slp_azi(i,j) - (pi - asin(grid%sina(i,j)))
    997. 

  997.                endif
    998. 

  998.              endif
    999. 

  999.        ENDDO
    1000. 

  1000.        ENDDO
    1001. 

  1001. !
    1002. 

  1002. ! paj: computes ct and ct2 for topo_wind
    1003. 

  1003. !
    1004. 

  1004.        grid%ctopo=1.
    1005. 

  1005.        grid%ctopo2=1.
    1006. 

  1006. !
    1007. 

  1007.        if (config_flags%topo_wind.eq.1) then
    1008. 

  1008.          DO j = jts,min(jte,jde-1)
    1009. 

  1009.          DO i = its, min(ite,ide-1)
    1010. 

  1010.             if(grid%xland(i,j).lt.1.5)grid%ctopo(i,j)=sqrt(grid%var_sso(i,j))
    1011. 

  1011.             if (grid%ctopo(i,j).le.2.718) then
    1012. 

  1012.             grid%ctopo(i,j)=1.
    1013. 

  1013.             else
    1014. 

  1014.             grid%ctopo(i,j)=alog(grid%ctopo(i,j))
    1015. 

  1015.             endif
    1016. 

  1016. !
    1017. 

  1017.             if (grid%lap_hgt(i,j).gt.-10.) then
    1018. 

  1018.               grid%ctopo(i,j)=grid%ctopo(i,j)
    1019. 

  1019.             else
    1020. 

  1020.                if (grid%lap_hgt(i,j).ge.-20) then
    1021. 

  1021.                  alpha=(grid%lap_hgt(i,j)+20.)/10.
    1022. 

  1022.                  grid%ctopo(i,j)=alpha*grid%ctopo(i,j)+(1-alpha)
    1023. 

  1023.                else
    1024. 

  1024.                   if (grid%lap_hgt(i,j).ge.-30.) then
    1025. 

  1025.                   grid%ctopo(i,j)=(grid%lap_hgt(i,j)+30.)/10.
    1026. 

  1026.                   grid%ctopo2(i,j)=(grid%lap_hgt(i,j)+30.)/10.
    1027. 

  1027.                   else
    1028. 

  1028.                   grid%ctopo(i,j)=0.
    1029. 

  1029.                   grid%ctopo2(i,j)=0.
    1030. 

  1030.                   endif
    1031. 

  1031.                endif
    1032. 

  1032.             endif
    1033. 

  1033.          ENDDO
    1034. 

  1034.          ENDDO
    1035. 

  1035.        endif
    1036. 

  1036. 

  1037.    END IF
    1038. 

  1038. 

  1039.    CALL set_physical_bc3d( grid%w_1 , 'W' , config_flags ,                 &
    1040. 

  1040.                          ids , ide , jds , jde , kds , kde ,        &
    1041. 

  1041.                          ims , ime , jms , jme , kms , kme ,        &
    1042. 

  1042.                          its , ite , jts , jte , kts , kte ,        &
    1043. 

  1043.                          its , ite , jts , jte , kts , kte )
    1044. 

  1044.    CALL set_physical_bc3d( grid%w_2 , 'W' , config_flags ,                 &
    1045. 

  1045.                          ids , ide , jds , jde , kds , kde ,        &
    1046. 

  1046.                          ims , ime , jms , jme , kms , kme ,        &
    1047. 

  1047.                          its , ite , jts , jte , kts , kte ,        &
    1048. 

  1048.                          its , ite , jts , jte , kts , kte )
    1049. 

  1049. 

  1050.    CALL set_physical_bc3d( grid%ph_1 , 'W' , config_flags ,                 &
    1051. 

  1051.                          ids , ide , jds , jde , kds , kde ,        &
    1052. 

  1052.                          ims , ime , jms , jme , kms , kme ,        &
    1053. 

  1053.                          its , ite , jts , jte , kts , kte ,        &
    1054. 

  1054.                          its , ite , jts , jte , kts , kte )
    1055. 

  1055. 

  1056.    CALL set_physical_bc3d( grid%ph_2 , 'W' , config_flags ,                 &
    1057. 

  1057.                          ids , ide , jds , jde , kds , kde ,        &
    1058. 

  1058.                          ims , ime , jms , jme , kms , kme ,        &
    1059. 

  1059.                          its , ite , jts , jte , kts , kte ,        &
    1060. 

  1060.                          its , ite , jts , jte , kts , kte )
    1061. 

  1061. 

  1062.    CALL set_physical_bc3d( grid%t_1 , 't' , config_flags ,                 &
    1063. 

  1063.                          ids , ide , jds , jde , kds , kde ,        &
    1064. 

  1064.                          ims , ime , jms , jme , kms , kme ,        &
    1065. 

  1065.                          its , ite , jts , jte , kts , kte ,        &
    1066. 

  1066.                          its , ite , jts , jte , kts , kte )
    1067. 

  1067. 

  1068.    CALL set_physical_bc3d( grid%t_2 , 't' , config_flags ,                 &
    1069. 

  1069.                          ids , ide , jds , jde , kds , kde ,        &
    1070. 

  1070.                          ims , ime , jms , jme , kms , kme ,        &
    1071. 

  1071.                          its , ite , jts , jte , kts , kte ,        &
    1072. 

  1072.                          its , ite , jts , jte , kts , kte )
    1073. 

  1073. 

  1074.    CALL set_physical_bc2d( grid%mu_1, 't' , config_flags ,   &
    1075. 

  1075.                            ids , ide , jds , jde ,  &
    1076. 

  1076.                            ims , ime , jms , jme ,  &
    1077. 

  1077.                            its , ite , jts , jte ,  &
    1078. 

  1078.                            its , ite , jts , jte   )
    1079. 

  1079.    CALL set_physical_bc2d( grid%mu_2, 't' , config_flags ,   &
    1080. 

  1080.                            ids , ide , jds , jde ,  &
    1081. 

  1081.                            ims , ime , jms , jme ,  &
    1082. 

  1082.                            its , ite , jts , jte ,  &
    1083. 

  1083.                            its , ite , jts , jte   )
    1084. 

  1084.    CALL set_physical_bc2d( grid%mub , 't' , config_flags ,   &
    1085. 

  1085.                            ids , ide , jds , jde ,  &
    1086. 

  1086.                            ims , ime , jms , jme ,  &
    1087. 

  1087.                            its , ite , jts , jte ,  &
    1088. 

  1088.                            its , ite , jts , jte   )
    1089. 

  1089. !  CALL set_physical_bc2d( grid%mu0 , 't' , config_flags ,   &
    1090. 

  1090. !                          ids , ide , jds , jde ,  &
    1091. 

  1091. !                          ims , ime , jms , jme ,  &
    1092. 

  1092. !                          its , ite , jts , jte ,  &
    1093. 

  1093. !                          its , ite , jts , jte   )
    1094. 

  1094. 

  1095. 

  1096.    CALL set_physical_bc3d( grid%phb , 'W' , config_flags ,                 &
    1097. 

  1097.                          ids , ide , jds , jde , kds , kde ,        &
    1098. 

  1098.                          ims , ime , jms , jme , kms , kme ,        &
    1099. 

  1099.                          its , ite , jts , jte , kts , kte ,        &
    1100. 

  1100.                          its , ite , jts , jte , kts , kte )
    1101. 

  1101.    CALL set_physical_bc3d( grid%ph0 , 'W' , config_flags ,                 &
    1102. 

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

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

  1104.                          its , ite , jts , jte , kts , kte ,        &
    1105. 

  1105.                          its , ite , jts , jte , kts , kte )
    1106. 

  1106.    CALL set_physical_bc3d( grid%php , 'W' , config_flags ,                 &
    1107. 

  1107.                          ids , ide , jds , jde , kds , kde ,        &
    1108. 

  1108.                          ims , ime , jms , jme , kms , kme ,        &
    1109. 

  1109.                          its , ite , jts , jte , kts , kte ,        &
    1110. 

  1110.                          its , ite , jts , jte , kts , kte )
    1111. 

  1111. 

  1112.    CALL set_physical_bc3d( grid%pb , 't' , config_flags ,                 &
    1113. 

  1113.                          ids , ide , jds , jde , kds , kde ,        &
    1114. 

  1114.                          ims , ime , jms , jme , kms , kme ,        &
    1115. 

  1115.                          its , ite , jts , jte , kts , kte ,        &
    1116. 

  1116.                          its , ite , jts , jte , kts , kte )
    1117. 

  1117.    CALL set_physical_bc3d( grid%al , 't' , config_flags ,                 &
    1118. 

  1118.                          ids , ide , jds , jde , kds , kde ,        &
    1119. 

  1119.                          ims , ime , jms , jme , kms , kme ,        &
    1120. 

  1120.                          its , ite , jts , jte , kts , kte ,        &
    1121. 

  1121.                          its , ite , jts , jte , kts , kte )
    1122. 

  1122.    CALL set_physical_bc3d( grid%alt , 't' , config_flags ,                 &
    1123. 

  1123.                          ids , ide , jds , jde , kds , kde ,        &
    1124. 

  1124.                          ims , ime , jms , jme , kms , kme ,        &
    1125. 

  1125.                          its , ite , jts , jte , kts , kte ,        &
    1126. 

  1126.                          its , ite , jts , jte , kts , kte )
    1127. 

  1127.    CALL set_physical_bc3d( grid%alb , 't' , config_flags ,                 &
    1128. 

  1128.                          ids , ide , jds , jde , kds , kde ,        &
    1129. 

  1129.                          ims , ime , jms , jme , kms , kme ,        &
    1130. 

  1130.                          its , ite , jts , jte , kts , kte ,        &
    1131. 

  1131.                          its , ite , jts , jte , kts , kte )
    1132. 

  1132.    CALL set_physical_bc3d(grid%t_init, 't' , config_flags ,                 &
    1133. 

  1133.                          ids , ide , jds , jde , kds , kde ,        &
    1134. 

  1134.                          ims , ime , jms , jme , kms , kme ,        &
    1135. 

  1135.                          its , ite , jts , jte , kts , kte ,        &
    1136. 

  1136.                          its , ite , jts , jte , kts , kte )
    1137. 

  1137.    CALL set_physical_bc3d(grid%tke_2, 't' , config_flags ,                 &
    1138. 

  1138.                          ids , ide , jds , jde , kds , kde ,        &
    1139. 

  1139.                          ims , ime , jms , jme , kms , kme ,        &
    1140. 

  1140.                          its , ite , jts , jte , kts , kte ,        &
    1141. 

  1141.                          its , ite , jts , jte , kts , kte )
    1142. 

  1142. 

  1143.    IF (num_moist > 0) THEN
    1144. 

  1144. 

  1145. ! use of (:,:,:,loop) not efficient on DEC, but (ims,kms,jms,loop) not portable to SGI/Cray
    1146. 

  1146. 

  1147.       loop_3d_m   : DO loop = 1 , num_moist
    1148. 

  1148.          CALL set_physical_bc3d( moist(:,:,:,loop) , 'r' , config_flags ,                 &
    1149. 

  1149.                                  ids , ide , jds , jde , kds , kde ,        &
    1150. 

  1150.                                  ims , ime , jms , jme , kms , kme ,        &
    1151. 

  1151.                                  its , ite , jts , jte , kts , kte ,        &
    1152. 

  1152.                                  its , ite , jts , jte , kts , kte )
    1153. 

  1153.       END DO loop_3d_m
    1154. 

  1154. 

  1155.    ENDIF
    1156. 

  1156. 

  1157.    IF (num_scalar > 0) THEN
    1158. 

  1158. 

  1159. ! use of (:,:,:,loop) not efficient on DEC, but (ims,kms,jms,loop) not portable to SGI/Cray
    1160. 

  1160. 

  1161.       loop_3d_s   : DO loop = 1 , num_scalar
    1162. 

  1162.          CALL set_physical_bc3d( scalar(:,:,:,loop) , 'r' , config_flags ,                 &
    1163. 

  1163.                                  ids , ide , jds , jde , kds , kde ,        &
    1164. 

  1164.                                  ims , ime , jms , jme , kms , kme ,        &
    1165. 

  1165.                                  its , ite , jts , jte , kts , kte ,        &
    1166. 

  1166.                                  its , ite , jts , jte , kts , kte )
    1167. 

  1167.       END DO loop_3d_s
    1168. 

  1168. 

  1169.    ENDIF
    1170. 

  1170. 

  1171. 

  1172. #ifdef WRF_CHEM
    1173. 

  1173.         if(config_flags%tracer_opt > 0 )then
    1174. 

  1174.            call initialize_tracer (tracer,config_flags%chem_in_opt, &
    1175. 

  1175.                                config_flags%tracer_opt,num_tracer,  &
    1176. 

  1176.                                ids,ide, jds,jde, kds,kde,      & ! domain dims
    1177. 

  1177.                                ims,ime, jms,jme, kms,kme,      & ! memory dims
    1178. 

  1178.                                ips,ipe, jps,jpe, kps,kpe,      & ! patch  dims
    1179. 

  1179.                                its,ite, jts,jte, kts,kte )
    1180. 

  1180. 

  1181.         endif
    1182. 

  1182. !
    1183. 

  1183. !   we do this here, so we only have one chem_init routine for either core....
    1184. 

  1184. !
    1185. 

  1185.          do j=jts,min(jte,jde-1)
    1186. 

  1186.             do i=its,min(ite,ide-1)
    1187. 

  1187.                do k=kts,kte
    1188. 

  1188.                  z_at_w(i,k,j)=(grid%ph_2(i,k,j)+grid%phb(i,k,j))/g
    1189. 

  1189.                enddo
    1190. 

  1190.                do k=kts,min(kte,kde-1)
    1191. 

  1191.                  tempfac=(grid%t_1(i,k,j) + t0)*((grid%p(i,k,j) + grid%pb(i,k,j))/p1000mb)**rcp
    1192. 

  1192.                  convfac(i,k,j) = (grid%p(i,k,j)+grid%pb(i,k,j))/rgasuniv/tempfac
    1193. 

  1193.                enddo
    1194. 

  1194.             enddo
    1195. 

  1195.          enddo
    1196. 

  1196. 

  1197.          CALL chem_init (grid%id,chem,emis_ant,scalar,grid%dt,grid%bioemdt,grid%photdt,     &
    1198. 

  1198.                          grid%chemdt,                                       &
    1199. 

  1199.                          grid%stepbioe,grid%stepphot,grid%stepchem,grid%stepfirepl,      &
    1200. 

  1200.                          grid%plumerisefire_frq,z_at_w,grid%xlat,grid%xlong,g,           &
    1201. 

  1201.                          grid%aerwrf,config_flags,grid,            &
    1202. 

  1202.                          grid%alt,grid%t_1,grid%p,convfac,grid%ttday,grid%tcosz,         &
    1203. 

  1203.                          grid%julday,grid%gmt,&
    1204. 

  1204.                          grid%tauaer1,grid%tauaer2,grid%tauaer3,grid%tauaer4,                   &
    1205. 

  1205.                          grid%gaer1,grid%gaer2,grid%gaer3,grid%gaer4,                           &
    1206. 

  1206.                          grid%waer1,grid%waer2,grid%waer3,grid%waer4,                           &
    1207. 

  1207.                          grid%l2aer,grid%l3aer,grid%l4aer,grid%l5aer,grid%l6aer,grid%l7aer,     &
    1208. 

  1208.                          grid%extaerlw1,grid%extaerlw2,grid%extaerlw3,grid%extaerlw4,           &
    1209. 

  1209.                          grid%extaerlw5,grid%extaerlw6,grid%extaerlw7,grid%extaerlw8,           &
    1210. 

  1210.                          grid%extaerlw9,grid%extaerlw10,grid%extaerlw11,grid%extaerlw12,        &
    1211. 

  1211.                          grid%extaerlw13,grid%extaerlw14,grid%extaerlw15,grid%extaerlw16,       &
    1212. 

  1212.                          grid%tauaerlw1,grid%tauaerlw2,grid%tauaerlw3,grid%tauaerlw4,           &
    1213. 

  1213.                          grid%tauaerlw5,grid%tauaerlw6,grid%tauaerlw7,grid%tauaerlw8,           &
    1214. 

  1214.                          grid%tauaerlw9,grid%tauaerlw10,grid%tauaerlw11,grid%tauaerlw12,        &
    1215. 

  1215.                          grid%tauaerlw13,grid%tauaerlw14,grid%tauaerlw15,grid%tauaerlw16,       &
    1216. 

  1216.                          grid%pm2_5_dry,grid%pm2_5_water,grid%pm2_5_dry_ec,                &
    1217. 

  1217.                          grid%last_chem_time_year,grid%last_chem_time_month,               &
    1218. 

  1218.                          grid%last_chem_time_day,grid%last_chem_time_hour,                 &
    1219. 

  1219.                          grid%last_chem_time_minute,grid%last_chem_time_second,            &
    1220. 

  1220.                          grid%chem_in_opt,grid%kemit,                       &
    1221. 

  1221.                          ids , ide , jds , jde , kds , kde ,                &
    1222. 

  1222.                          ims , ime , jms , jme , kms , kme ,                &
    1223. 

  1223.                          its , ite , jts , jte , kts , kte                  )
    1224. 

  1224. 

  1225. !
    1226. 

  1226. ! calculate initial pm
    1227. 

  1227. !
    1228. 

  1228. !       print *,'calculating initial pm'
    1229. 

  1229.         select case (config_flags%chem_opt)
    1230. 

  1230.         case (GOCART_SIMPLE,GOCARTRACM_KPP,GOCARTRADM2,GOCARTRADM2_KPP)
    1231. 

  1231.            call sum_pm_gocart (                                             &
    1232. 

  1232.                 grid%alt, chem, grid%pm2_5_dry, grid%pm2_5_dry_ec,grid%pm10,&
    1233. 

  1233.                 ids,ide, jds,jde, kds,kde,                                  &
    1234. 

  1234.                 ims,ime, jms,jme, kms,kme,                                  &
    1235. 

  1235.                 its,ite, jts,jte, kts,kte-1                                 )
    1236. 

  1236.         case (RADM2SORG,RADM2SORG_AQ,RADM2SORG_AQCHEM,RADM2SORG_KPP,RACMSORG_AQ,RACMSORG_AQCHEM,RACMSORG_KPP)
    1237. 

  1237.            call sum_pm_sorgam (                                             &
    1238. 

  1238.                 grid%alt, chem, grid%h2oaj, grid%h2oai,                                    &
    1239. 

  1239.                 grid%pm2_5_dry, grid%pm2_5_water, grid%pm2_5_dry_ec, grid%pm10,                 &
    1240. 

  1240.                 grid%dust_opt,ids,ide, jds,jde, kds,kde,                    &
    1241. 

  1241.                 ims,ime, jms,jme, kms,kme,                                  &
    1242. 

  1242.                 its,ite, jts,jte, kts,kte-1                                 )
    1243. 

  1243.          case (RACM_SOA_VBS_KPP)
    1244. 

  1244.              call sum_pm_soa_vbs (                                           &
    1245. 

  1245.                  grid%alt, chem, grid%h2oaj, grid%h2oai,                                   &
    1246. 

  1246.                  grid%pm2_5_dry, grid%pm2_5_water, grid%pm2_5_dry_ec, grid%pm10,                &
    1247. 

  1247.                  config_flags%dust_opt,ids,ide, jds,jde, kds,kde,           &
    1248. 

  1248.                  ims,ime, jms,jme, kms,kme,                                 &
    1249. 

  1249.                  its,ite, jts,jte, kts,kte-1                                )
    1250. 

  1250. 

  1251.         case (CBMZ_MOSAIC_4BIN,CBMZ_MOSAIC_8BIN,CBMZ_MOSAIC_4BIN_AQ,CBMZ_MOSAIC_8BIN_AQ, &
    1252. 

  1252.               CBMZ_MOSAIC_DMS_4BIN, CBMZ_MOSAIC_DMS_8BIN, CBMZ_MOSAIC_DMS_4BIN_AQ,       &
    1253. 

  1253.               CBMZ_MOSAIC_DMS_8BIN_AQ)
    1254. 

  1254.            call sum_pm_mosaic (                                             &
    1255. 

  1255.                 grid%alt, chem,                                                  &
    1256. 

  1256.                 grid%pm2_5_dry, grid%pm2_5_water, grid%pm2_5_dry_ec, grid%pm10,                 &
    1257. 

  1257.                 ids,ide, jds,jde, kds,kde,                                  &
    1258. 

  1258.                 ims,ime, jms,jme, kms,kme,                                  &
    1259. 

  1259.                 its,ite, jts,jte, kts,kte-1                                 )
    1260. 

  1260. 

  1261.         case default
    1262. 

  1262.            do j=jts,min(jte,jde-1)
    1263. 

  1263.               do k=kts,min(kte,kde-1)
    1264. 

  1264.                  do i=its,min(ite,ide-1)
    1265. 

  1265.                     grid%pm2_5_dry(i,k,j)    = 0.
    1266. 

  1266.                     grid%pm2_5_water(i,k,j)  = 0.
    1267. 

  1267.                     grid%pm2_5_dry_ec(i,k,j) = 0.
    1268. 

  1268.                     grid%pm10(i,k,j)         = 0.
    1269. 

  1269.                  enddo
    1270. 

  1270.               enddo
    1271. 

  1271.            enddo
    1272. 

  1272.         end select
    1273. 

  1273.         
    1274. 

  1274.         ! initialize advective tendency diagnostics for chem
    1275. 

  1275.         if ( grid%itimestep .eq. 0 .and. config_flags%chemdiag .eq. USECHEMDIAG ) then
    1276. 

  1276.           grid%advh_ct(:,:,:,:) = 0.
    1277. 

  1277.           grid%advz_ct(:,:,:,:) = 0.
    1278. 

  1278.         endif
    1279. 

  1279. #endif
    1280. 

  1280. 

  1281.         ! initialize advective tendency diagnostics for non-chem
    1282. 

  1282.         if ( grid%itimestep .eq. 0 .and. config_flags%tenddiag .eq. USETENDDIAG ) then
    1283. 

  1283.           grid%advh_t(:,:,:,:) = 0.
    1284. 

  1284.           grid%advz_t(:,:,:,:) = 0.
    1285. 

  1285.         endif
    1286. 

  1286. 

  1287.    IF (num_chem >= PARAM_FIRST_SCALAR ) THEN
    1288. 

  1288. ! use of (:,:,:,loop) not efficient on DEC, but (ims,kms,jms,loop) not portable to SGI/Cray
    1289. 

  1289. 

  1290.       loop_3d_c   : DO loop = PARAM_FIRST_SCALAR , num_chem
    1291. 

  1291.          CALL set_physical_bc3d( chem(:,:,:,loop) , 'r' , config_flags ,                 &
    1292. 

  1292.                                  ids , ide , jds , jde , kds , kde ,        &
    1293. 

  1293.                                  ims , ime , jms , jme , kms , kme ,        &
    1294. 

  1294.                                  its , ite , jts , jte , kts , kte ,        &
    1295. 

  1295.                                  its , ite , jts , jte , kts , kte )
    1296. 

  1296.       END DO loop_3d_c
    1297. 

  1297. 

  1298.    ENDIF
    1299. 

  1299. 

  1300.    CALL set_physical_bc2d( grid%msftx , 'r' , config_flags ,              &
    1301. 

  1301.                          ids , ide , jds , jde , &
    1302. 

  1302.                          ims , ime , jms , jme , &
    1303. 

  1303.                          its , ite , jts , jte , &
    1304. 

  1304.                          its , ite , jts , jte   )
    1305. 

  1305.    CALL set_physical_bc2d( grid%msfty , 'r' , config_flags ,              &
    1306. 

  1306.                          ids , ide , jds , jde , &
    1307. 

  1307.                          ims , ime , jms , jme , &
    1308. 

  1308.                          its , ite , jts , jte , &
    1309. 

  1309.                          its , ite , jts , jte   )
    1310. 

  1310.    CALL set_physical_bc2d( grid%msfux , 'x' , config_flags ,              &
    1311. 

  1311.                          ids , ide , jds , jde , &
    1312. 

  1312.                          ims , ime , jms , jme , &
    1313. 

  1313.                          its , ite , jts , jte , &
    1314. 

  1314.                          its , ite , jts , jte   )
    1315. 

  1315.    CALL set_physical_bc2d( grid%msfuy , 'x' , config_flags ,              &
    1316. 

  1316.                          ids , ide , jds , jde , &
    1317. 

  1317.                          ims , ime , jms , jme , &
    1318. 

  1318.                          its , ite , jts , jte , &
    1319. 

  1319.                          its , ite , jts , jte   )
    1320. 

  1320.    CALL set_physical_bc2d( grid%msfvx , 'y' , config_flags ,              &
    1321. 

  1321.                          ids , ide , jds , jde , &
    1322. 

  1322.                          ims , ime , jms , jme , &
    1323. 

  1323.                          its , ite , jts , jte , &
    1324. 

  1324.                          its , ite , jts , jte   )
    1325. 

  1325.    CALL set_physical_bc2d( grid%msfvy , 'y' , config_flags ,              &
    1326. 

  1326.                          ids , ide , jds , jde , &
    1327. 

  1327.                          ims , ime , jms , jme , &
    1328. 

  1328.                          its , ite , jts , jte , &
    1329. 

  1329.                          its , ite , jts , jte   )
    1330. 

  1330.    CALL set_physical_bc2d( grid%sina , 'r' , config_flags ,              &
    1331. 

  1331.                          ids , ide , jds , jde , &
    1332. 

  1332.                          ims , ime , jms , jme , &
    1333. 

  1333.                          its , ite , jts , jte , &
    1334. 

  1334.                          its , ite , jts , jte   )
    1335. 

  1335.    CALL set_physical_bc2d( grid%cosa , 'r' , config_flags ,              &
    1336. 

  1336.                          ids , ide , jds , jde , &
    1337. 

  1337.                          ims , ime , jms , jme , &
    1338. 

  1338.                          its , ite , jts , jte , &
    1339. 

  1339.                          its , ite , jts , jte   )
    1340. 

  1340.    CALL set_physical_bc2d( grid%e , 'r' , config_flags ,                 &
    1341. 

  1341.                          ids , ide , jds , jde , &
    1342. 

  1342.                          ims , ime , jms , jme , &
    1343. 

  1343.                          its , ite , jts , jte , &
    1344. 

  1344.                          its , ite , jts , jte   )
    1345. 

  1345.    CALL set_physical_bc2d( grid%f , 'r' , config_flags ,                 &
    1346. 

  1346.                          ids , ide , jds , jde , &
    1347. 

  1347.                          ims , ime , jms , jme , &
    1348. 

  1348.                          its , ite , jts , jte , &
    1349. 

  1349.                          its , ite , jts , jte   )
    1350. 

  1350. 

  1351. #ifndef WRF_CHEM
    1352. 

  1352.       DEALLOCATE(CLDFRA_OLD)
    1353. 

  1353. #endif
    1354. 

  1354. #ifdef DM_PARALLEL
    1355. 

  1355. #   include "HALO_EM_INIT_1.inc"
    1356. 

  1356. #   include "HALO_EM_INIT_2.inc"
    1357. 

  1357. #   include "HALO_EM_INIT_3.inc"
    1358. 

  1358. #   include "HALO_EM_INIT_4.inc"
    1359. 

  1359. #   include "HALO_EM_INIT_5.inc"
    1360. 

  1360. #  include "PERIOD_BDY_EM_INIT.inc"
    1361. 

  1361. #  include "PERIOD_BDY_EM_MOIST.inc"
    1362. 

  1362. #  include "PERIOD_BDY_EM_TKE.inc"
    1363. 

  1363. #  include "PERIOD_BDY_EM_SCALAR.inc"
    1364. 

  1364. #  include "PERIOD_BDY_EM_CHEM.inc"
    1365. 

  1365. #endif
    1366. 

  1366. 

  1367. !  FIRE
    1368. 

  1368. if(config_flags%ifire.eq.2)then
    1369. 

  1369. 

  1370.    call sfire_driver_em_init ( grid , config_flags    &
    1371. 

  1371.             ,ids,ide, kds,kde, jds,jde                &
    1372. 

  1372.             ,ims,ime, kms,kme, jms,jme                &
    1373. 

  1373.             ,ips,ipe, kps,kpe, jps,jpe ) 
    1374. 

  1374. 

  1375.    CALL wrf_debug ( 100 , 'start_domain_em: After call to sfire_driver_em_init' )
    1376. 

  1376. endif
    1377. 

  1377. 

  1378. 

  1379.      CALL wrf_debug ( 100 , 'start_domain_em: Returning' )
    1380. 

  1380. 

  1381.      RETURN
    1382. 

  1382. 

  1383.    END SUBROUTINE start_domain_em
    1384. 

  1384. 

  1385.