PageRenderTime 55ms CodeModel.GetById 23ms RepoModel.GetById 0ms app.codeStats 0ms

/wrfv2_fire/dyn_em/nest_init_utils.F

http://github.com/jbeezley/wrf-fire
FORTRAN Legacy | 416 lines | 259 code | 67 blank | 90 comment | 1 complexity | c636ff88e4b88012042b731342f19319 MD5 | raw file
Possible License(s): AGPL-1.0 
    

  1. SUBROUTINE init_domain_constants_em ( parent , nest )
    2. 

  2.    USE module_domain, ONLY : domain
    3. 

  3.    IMPLICIT NONE
    4. 

  4.    TYPE(domain)  :: parent , nest
    5. 

  5. 

  6.    INTEGER iswater, islake, isice, isurban, isoilwater, map_proj, julyr, julday
    7. 

  7.    REAL    truelat1 , truelat2 , gmt , moad_cen_lat , stand_lon, pole_lat, pole_lon
    8. 

  8.    CHARACTER (LEN=256) :: char_junk
    9. 

  9. 

  10. ! single-value constants
    11. 

  11. 

  12.    nest%p_top   = parent%p_top
    13. 

  13.    nest%save_topo_from_real   = parent%save_topo_from_real
    14. 

  14.    nest%cfn     = parent%cfn
    15. 

  15.    nest%cfn1    = parent%cfn1
    16. 

  16.    nest%rdx     = 1./nest%dx
    17. 

  17.    nest%rdy     = 1./nest%dy
    18. 

  18. !  nest%dts     = nest%dt/float(nest%time_step_sound)
    19. 

  19.    nest%dtseps  = parent%dtseps  ! used in height model only?
    20. 

  20.    nest%resm    = parent%resm    ! used in height model only?
    21. 

  21.    nest%zetatop = parent%zetatop ! used in height model only?
    22. 

  22.    nest%cf1     = parent%cf1
    23. 

  23.    nest%cf2     = parent%cf2
    24. 

  24.    nest%cf3     = parent%cf3
    25. 

  25.    nest%gmt     = parent%gmt
    26. 

  26.    nest%julyr   = parent%julyr
    27. 

  27.    nest%julday  = parent%julday
    28. 

  28.    nest%iswater = parent%iswater
    29. 

  29.    nest%isice   = parent%isice
    30. 

  30.    nest%isurban = parent%isurban
    31. 

  31.    nest%islake  = parent%islake
    32. 

  32.    nest%isoilwater = parent%isoilwater
    33. 

  33.    nest%mminlu  = trim(parent%mminlu)
    34. 

  34.    nest%tiso    = parent%tiso
    35. 

  35.    nest%tlp     = parent%tlp
    36. 

  36.    nest%p00     = parent%p00
    37. 

  37.    nest%t00     = parent%t00
    38. 

  38. 

  39.    CALL nl_get_mminlu ( 1, char_junk )
    40. 

  40.    CALL nl_get_iswater( 1, iswater )
    41. 

  41.    CALL nl_get_islake ( 1, islake )
    42. 

  42.    CALL nl_get_isice  ( 1, isice )
    43. 

  43.    CALL nl_get_isurban( 1, isurban )
    44. 

  44.    CALL nl_get_isoilwater(1, isoilwater )
    45. 

  45.    CALL nl_get_truelat1 ( 1 , truelat1 )
    46. 

  46.    CALL nl_get_truelat2 ( 1 , truelat2 )
    47. 

  47.    CALL nl_get_moad_cen_lat ( 1 , moad_cen_lat )
    48. 

  48.    CALL nl_get_stand_lon ( 1 , stand_lon )
    49. 

  49.    CALL nl_get_pole_lat ( 1 , pole_lat )
    50. 

  50.    CALL nl_get_pole_lon ( 1 , pole_lon )
    51. 

  51.    CALL nl_get_map_proj ( 1 , map_proj )
    52. 

  52.    CALL nl_get_gmt ( 1 , gmt)
    53. 

  53.    CALL nl_get_julyr ( 1 , julyr)
    54. 

  54.    CALL nl_get_julday ( 1 , julday)
    55. 

  55.    IF ( nest%id .NE. 1 ) THEN
    56. 

  56.      CALL nl_set_gmt (nest%id, gmt)
    57. 

  57.      CALL nl_set_julyr (nest%id, julyr)
    58. 

  58.      CALL nl_set_julday (nest%id, julday)
    59. 

  59.      CALL nl_set_iswater ( nest%id, iswater )
    60. 

  60.      CALL nl_set_islake  ( nest%id, islake )
    61. 

  61.      CALL nl_set_isice   ( nest%id, isice )
    62. 

  62.      CALL nl_set_isurban ( nest%id, isurban )
    63. 

  63.      CALL nl_set_isoilwater ( nest%id, isoilwater )
    64. 

  64.      CALL nl_set_mminlu ( nest%id, char_junk )
    65. 

  65.      CALL nl_set_truelat1 ( nest%id , truelat1 )
    66. 

  66.      CALL nl_set_truelat2 ( nest%id , truelat2 )
    67. 

  67.      CALL nl_set_moad_cen_lat ( nest%id , moad_cen_lat )
    68. 

  68.      CALL nl_set_stand_lon ( nest%id , stand_lon )
    69. 

  69.      CALL nl_set_pole_lat ( nest%id , pole_lat )
    70. 

  70.      CALL nl_set_pole_lon ( nest%id , pole_lon )
    71. 

  71.      CALL nl_set_map_proj ( nest%id , map_proj )
    72. 

  72.    END IF
    73. 

  73.    nest%gmt     = gmt
    74. 

  74.    nest%julday  = julday
    75. 

  75.    nest%julyr   = julyr
    76. 

  76.    nest%iswater = iswater
    77. 

  77.    nest%islake  = islake
    78. 

  78.    nest%isice   = isice
    79. 

  79.    nest%isoilwater = isoilwater
    80. 

  80.    nest%mminlu  = trim(char_junk)
    81. 

  81.    nest%truelat1= truelat1
    82. 

  82.    nest%truelat2= truelat2
    83. 

  83.    nest%moad_cen_lat= moad_cen_lat
    84. 

  84.    nest%stand_lon= stand_lon
    85. 

  85.    nest%pole_lat= pole_lat
    86. 

  86.    nest%pole_lon= pole_lon
    87. 

  87.    nest%map_proj= map_proj
    88. 

  88. 

  89.    nest%step_number  = parent%step_number
    90. 

  90. 

  91. ! 1D constants (Z)
    92. 

  92. 

  93.    nest%fnm    = parent%fnm
    94. 

  94.    nest%fnp    = parent%fnp
    95. 

  95.    nest%rdnw   = parent%rdnw
    96. 

  96.    nest%rdn    = parent%rdn
    97. 

  97.    nest%dnw    = parent%dnw
    98. 

  98.    nest%dn     = parent%dn
    99. 

  99.    nest%znu    = parent%znu
    100. 

  100.    nest%znw    = parent%znw
    101. 

  101.    nest%t_base = parent%t_base
    102. 

  102.    nest%u_base    = parent%u_base
    103. 

  103.    nest%v_base    = parent%v_base
    104. 

  104.    nest%qv_base   = parent%qv_base
    105. 

  105.    nest%z_base    = parent%z_base
    106. 

  106.    nest%dzs       = parent%dzs
    107. 

  107.    nest%zs        = parent%zs
    108. 

  108. 

  109. END SUBROUTINE init_domain_constants_em
    110. 

  110. 

  111. SUBROUTINE blend_terrain ( ter_interpolated , ter_input , &
    112. 

  112.                            ids , ide , jds , jde , kds , kde , &
    113. 

  113.                            ims , ime , jms , jme , kms , kme , &
    114. 

  114.                            ips , ipe , jps , jpe , kps , kpe )
    115. 

  115. 

  116.    USE module_configure
    117. 

  117.    IMPLICIT NONE
    118. 

  118. 

  119.    INTEGER , INTENT(IN)                       :: ids , ide , jds , jde , kds , kde , &
    120. 

  120.                                                  ims , ime , jms , jme , kms , kme , &
    121. 

  121.                                                  ips , ipe , jps , jpe , kps , kpe
    122. 

  122.    REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(IN)    :: ter_interpolated
    123. 

  123.    REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(INOUT) :: ter_input
    124. 

  124. 

  125.    REAL , DIMENSION(ims:ime,kms:kme,jms:jme) :: ter_temp
    126. 

  126.    INTEGER :: i , j , k , spec_bdy_width
    127. 

  127.    REAL    :: r_blend_zones
    128. 

  128.    INTEGER blend_cell, blend_width
    129. 

  129. 

  130.    !  The fine grid elevation comes from the horizontally interpolated
    131. 

  131.    !  parent elevation for the first spec_bdy_width row/columns, so we need
    132. 

  132.    !  to get that value.  We blend the coarse and fine in the next blend_width
    133. 

  133.    !  rows and columns.  After that, in the interior, it is 100% fine grid.
    134. 

  134. 

  135.    CALL nl_get_spec_bdy_width ( 1, spec_bdy_width)
    136. 

  136.    CALL nl_get_blend_width ( 1, blend_width)
    137. 

  137. 

  138.    !  Initialize temp values to the nest ter elevation.  This fills in the values
    139. 

  139.    !  that will not be modified below.
    140. 

  140. 

  141.    DO j = jps , MIN(jpe, jde-1)
    142. 

  142.       DO k = kps , kpe
    143. 

  143.          DO i = ips , MIN(ipe, ide-1)
    144. 

  144.             ter_temp(i,k,j) = ter_input(i,k,j)
    145. 

  145.          END DO
    146. 

  146.       END DO
    147. 

  147.    END DO
    148. 

  148. 

  149.    !  To avoid some tricky indexing, we fill in the values inside out.  This allows
    150. 

  150.    !  us to overwrite incorrect assignments.  There are replicated assignments, and
    151. 

  151.    !  there is much unnecessary "IF test inside of a loop" stuff.  For a large
    152. 

  152.    !  domain, this is only a patch; for a small domain, this is not a biggy.
    153. 

  153. 

  154.    r_blend_zones = 1./(blend_width+1)
    155. 

  155.    DO j = jps , MIN(jpe, jde-1)
    156. 

  156.       DO k = kps , kpe
    157. 

  157.          DO i = ips , MIN(ipe, ide-1)
    158. 

  158.             DO blend_cell = blend_width,1,-1
    159. 

  159.                IF   ( ( i .EQ.       spec_bdy_width + blend_cell ) .OR.  ( j .EQ.       spec_bdy_width + blend_cell ) .OR. &
    160. 

  160.                       ( i .EQ. ide - spec_bdy_width - blend_cell ) .OR.  ( j .EQ. jde - spec_bdy_width - blend_cell ) ) THEN
    161. 

  161.                   ter_temp(i,k,j) = ( (blend_cell)*ter_input(i,k,j) + (blend_width+1-blend_cell)*ter_interpolated(i,k,j) ) &
    162. 

  162.                                     * r_blend_zones
    163. 

  163.                END IF
    164. 

  164.             ENDDO
    165. 

  165.             IF      ( ( i .LE.       spec_bdy_width     ) .OR.  ( j .LE.       spec_bdy_width     ) .OR. &
    166. 

  166.                       ( i .GE. ide - spec_bdy_width     ) .OR.  ( j .GE. jde - spec_bdy_width     ) ) THEN
    167. 

  167.                ter_temp(i,k,j) =      ter_interpolated(i,k,j)
    168. 

  168.             END IF
    169. 

  169.          END DO
    170. 

  170.       END DO
    171. 

  171.    END DO
    172. 

  172. 

  173.    !  Set nest elevation with temp values.  All values not overwritten in the above
    174. 

  174.    !  loops have been previously set in the initial assignment.
    175. 

  175. 

  176.    DO j = jps , MIN(jpe, jde-1)
    177. 

  177.       DO k = kps , kpe
    178. 

  178.          DO i = ips , MIN(ipe, ide-1)
    179. 

  179.             ter_input(i,k,j) = ter_temp(i,k,j)
    180. 

  180.          END DO
    181. 

  181.       END DO
    182. 

  182.    END DO
    183. 

  183. 

  184. END SUBROUTINE blend_terrain
    185. 

  185. 

  186. SUBROUTINE copy_3d_field ( ter_interpolated , ter_input , &
    187. 

  187.                            ids , ide , jds , jde , kds , kde , &
    188. 

  188.                            ims , ime , jms , jme , kms , kme , &
    189. 

  189.                            ips , ipe , jps , jpe , kps , kpe )
    190. 

  190. 

  191.    IMPLICIT NONE
    192. 

  192. 

  193.    INTEGER , INTENT(IN)                       :: ids , ide , jds , jde , kds , kde , &
    194. 

  194.                                                  ims , ime , jms , jme , kms , kme , &
    195. 

  195.                                                  ips , ipe , jps , jpe , kps , kpe
    196. 

  196.    REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(OUT) :: ter_interpolated
    197. 

  197.    REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(IN)  :: ter_input
    198. 

  198. 

  199.    INTEGER :: i , j , k
    200. 

  200. 

  201.    DO j = jps , MIN(jpe, jde-1)
    202. 

  202.       DO k = kps , kpe
    203. 

  203.          DO i = ips , MIN(ipe, ide-1)
    204. 

  204.             ter_interpolated(i,k,j) = ter_input(i,k,j)
    205. 

  205.          END DO
    206. 

  206.       END DO
    207. 

  207.    END DO
    208. 

  208. 

  209. END SUBROUTINE copy_3d_field
    210. 

  210. 

  211. SUBROUTINE adjust_tempqv ( mub, save_mub, znw, p_top, &
    212. 

  212.                            th, pp, qv,  &
    213. 

  213.                            ids , ide , jds , jde , kds , kde , &
    214. 

  214.                            ims , ime , jms , jme , kms , kme , &
    215. 

  215.                            ips , ipe , jps , jpe , kps , kpe )
    216. 

  216. 

  217.    !USE module_configure
    218. 

  218.    !USE module_domain
    219. 

  219.    USE module_model_constants
    220. 

  220. 

  221.    !USE module_bc
    222. 

  222.    !USE module_io_domain
    223. 

  223.    !USE module_state_description
    224. 

  224.    !USE module_timing
    225. 

  225.    !USE module_soil_pre
    226. 

  226.    IMPLICIT NONE
    227. 

  227. 

  228.    INTEGER , INTENT(IN)                       :: ids , ide , jds , jde , kds , kde , &
    229. 

  229.                                                  ims , ime , jms , jme , kms , kme , &
    230. 

  230.                                                  ips , ipe , jps , jpe , kps , kpe
    231. 

  231.    REAL , DIMENSION(ims:ime,jms:jme) , INTENT(IN)    :: mub, save_mub
    232. 

  232.    REAL , DIMENSION(kms:kme) , INTENT(IN)    :: znw
    233. 

  233.    REAL , DIMENSION(ims:ime,kms:kme,jms:jme) , INTENT(INOUT) :: th, pp, qv
    234. 

  234. 

  235.    REAL , DIMENSION(ims:ime,kms:kme,jms:jme) :: p_old, p_new, rh
    236. 

  236.    REAL :: es,dth,tc,e,dth1
    237. 

  237.    INTEGER :: i , j , k
    238. 

  238. 

  239.    real p_top
    240. 

  240. 

  241. 

  242. ! p_old = full pressure before terrain blending; also compute initial RH
    243. 

  243. ! which is going to be conserved during terrain blending
    244. 

  244.    DO j = jps , MIN(jpe, jde-1)
    245. 

  245.       DO k = kps , kpe-1
    246. 

  246.          DO i = ips , MIN(ipe, ide-1)
    247. 

  247.             p_old(i,k,j) = 0.5*(znw(k+1)+znw(k))*save_mub(i,j) + p_top + pp(i,k,j)
    248. 

  248.             tc = (th(i,k,j)+300.)*(p_old(i,k,j)/1.e5)**(2./7.) - 273.15
    249. 

  249.             es = 610.78*exp(17.0809*tc/(234.175+tc))
    250. 

  250.             e = qv(i,k,j)*p_old(i,k,j)/(0.622+qv(i,k,j))
    251. 

  251.             rh(i,k,j) = e/es
    252. 

  252.          END DO
    253. 

  253.       END DO
    254. 

  254.    END DO
    255. 

  255. 

  256. ! p_new = full pressure after terrain blending; also compute temperature correction and convert RH back to QV
    257. 

  257.    DO j = jps , MIN(jpe, jde-1)
    258. 

  258.       DO k = kps , kpe-1
    259. 

  259.          DO i = ips , MIN(ipe, ide-1)
    260. 

  260.             p_new(i,k,j) = 0.5*(znw(k+1)+znw(k))*mub(i,j) + p_top + pp(i,k,j)
    261. 

  261. ! 2*(g/cp-6.5e-3)*R_dry/g = -191.86e-3
    262. 

  262.             dth1 = -191.86e-3*(th(i,k,j)+300.)/(p_new(i,k,j)+p_old(i,k,j))*(p_new(i,k,j)-p_old(i,k,j))
    263. 

  263.             dth = -191.86e-3*(th(i,k,j)+0.5*dth1+300.)/(p_new(i,k,j)+p_old(i,k,j))*(p_new(i,k,j)-p_old(i,k,j))
    264. 

  264.             th(i,k,j) = th(i,k,j)+dth
    265. 

  265.             tc = (th(i,k,j)+300.)*(p_new(i,k,j)/1.e5)**(2./7.) - 273.15
    266. 

  266.             es = 610.78*exp(17.0809*tc/(234.175+tc))
    267. 

  267.             e = rh(i,k,j)*es
    268. 

  268.             qv(i,k,j) = 0.622*e/(p_new(i,k,j)-e)
    269. 

  269.          END DO
    270. 

  270.       END DO
    271. 

  271.    END DO
    272. 

  272. 

  273. 

  274. END SUBROUTINE adjust_tempqv
    275. 

  275. 

  276. SUBROUTINE input_terrain_rsmas ( grid ,                        &
    277. 

  277.                            ids , ide , jds , jde , kds , kde , &
    278. 

  278.                            ims , ime , jms , jme , kms , kme , &
    279. 

  279.                            ips , ipe , jps , jpe , kps , kpe )
    280. 

  280. 

  281.    USE module_domain, ONLY : domain
    282. 

  282.    IMPLICIT NONE
    283. 

  283.    TYPE ( domain ) :: grid
    284. 

  284. 

  285.    INTEGER , INTENT(IN)                       :: ids , ide , jds , jde , kds , kde , &
    286. 

  286.                                                  ims , ime , jms , jme , kms , kme , &
    287. 

  287.                                                  ips , ipe , jps , jpe , kps , kpe
    288. 

  288. 

  289.    LOGICAL, EXTERNAL ::  wrf_dm_on_monitor
    290. 

  290. 

  291.    INTEGER :: i , j , k , myproc
    292. 

  292.    INTEGER, DIMENSION(256) :: ipath  ! array for integer coded ascii for passing path down to get_terrain
    293. 

  293.    CHARACTER*256 :: message, message2
    294. 

  294.    CHARACTER*256 :: rsmas_data_path
    295. 

  295. 

  296. #if DM_PARALLEL
    297. 

  297. ! Local globally sized arrays
    298. 

  298.    REAL , DIMENSION(ids:ide,jds:jde) :: ht_g, xlat_g, xlon_g
    299. 

  299. #endif
    300. 

  300. 

  301.    CALL wrf_get_myproc ( myproc )
    302. 

  302. 

  303. #if 0
    304. 

  304. CALL domain_clock_get ( grid, current_timestr=message2 )
    305. 

  305. WRITE ( message , FMT = '(A," HT before ",I3)' ) TRIM(message2), grid%id
    306. 

  306. write(30+myproc,*)ipe-ips+1,jpe-jps+1,trim(message)
    307. 

  307. do j = jps,jpe
    308. 

  308. do i = ips,ipe
    309. 

  309. write(30+myproc,*)grid%ht(i,j)
    310. 

  310. enddo
    311. 

  311. enddo
    312. 

  312. #endif
    313. 

  313. 

  314.    CALL nl_get_rsmas_data_path(1,rsmas_data_path)
    315. 

  315.    do i = 1, LEN(TRIM(rsmas_data_path))
    316. 

  316.       ipath(i) = ICHAR(rsmas_data_path(i:i))
    317. 

  317.    enddo
    318. 

  318. 

  319. #if ( defined( DM_PARALLEL ) && ( ! defined( STUBMPI ) ) )
    320. 

  320. 

  321.    CALL wrf_patch_to_global_real ( grid%xlat , xlat_g , grid%domdesc, ' ' , 'xy' ,       &
    322. 

  322.                                    ids, ide-1 , jds , jde-1 , 1 , 1 , &
    323. 

  323.                                    ims, ime   , jms , jme   , 1 , 1 , &
    324. 

  324.                                    ips, ipe   , jps , jpe   , 1 , 1   )
    325. 

  325.    CALL wrf_patch_to_global_real ( grid%xlong , xlon_g , grid%domdesc, ' ' , 'xy' ,       &
    326. 

  326.                                    ids, ide-1 , jds , jde-1 , 1 , 1 , &
    327. 

  327.                                    ims, ime   , jms , jme   , 1 , 1 , &
    328. 

  328.                                    ips, ipe   , jps , jpe   , 1 , 1   )
    329. 

  329. 

  330.    IF ( wrf_dm_on_monitor() ) THEN
    331. 

  331.      CALL get_terrain ( grid%dx/1000., xlat_g(ids:ide,jds:jde), xlon_g(ids:ide,jds:jde), ht_g(ids:ide,jds:jde), &
    332. 

  332.                         ide-ids+1,jde-jds+1,ide-ids+1,jde-jds+1, ipath, LEN(TRIM(rsmas_data_path)) )
    333. 

  333.      WHERE ( ht_g(ids:ide,jds:jde) < -1000. ) ht_g(ids:ide,jds:jde) = 0.
    334. 

  334.    ENDIF
    335. 

  335. 

  336.    CALL wrf_global_to_patch_real ( ht_g , grid%ht , grid%domdesc, ' ' , 'xy' ,         &
    337. 

  337.                                    ids, ide-1 , jds , jde-1 , 1 , 1 , &
    338. 

  338.                                    ims, ime   , jms , jme   , 1 , 1 , &
    339. 

  339.                                    ips, ipe   , jps , jpe   , 1 , 1   )
    340. 

  340. #else
    341. 

  341. 

  342.    CALL get_terrain ( grid%dx/1000., grid%xlat(ids:ide,jds:jde), grid%xlong(ids:ide,jds:jde), grid%ht(ids:ide,jds:jde), &
    343. 

  343.                        ide-ids+1,jde-jds+1,ide-ids+1,jde-jds+1, ipath, LEN(TRIM(rsmas_data_path)) )
    344. 

  344.    WHERE ( grid%ht(ids:ide,jds:jde) < -1000. ) grid%ht(ids:ide,jds:jde) = 0.
    345. 

  345. 

  346. #endif
    347. 

  347. 

  348. #if 0
    349. 

  349. CALL domain_clock_get ( grid, current_timestr=message2 )
    350. 

  350. WRITE ( message , FMT = '(A," HT after ",I3)' ) TRIM(message2), grid%id
    351. 

  351. write(30+myproc,*)ipe-ips+1,jpe-jps+1,trim(message)
    352. 

  352. do j = jps,jpe
    353. 

  353. do i = ips,ipe
    354. 

  354. write(30+myproc,*)grid%ht(i,j)
    355. 

  355. enddo
    356. 

  356. enddo
    357. 

  357. #endif
    358. 

  358. 

  359. END SUBROUTINE input_terrain_rsmas
    360. 

  360. 

  361. SUBROUTINE update_after_feedback_em ( grid  &
    362. 

  362. !
    363. 

  363. #include "dummy_new_args.inc"
    364. 

  364. !
    365. 

  365.                  )
    366. 

  366. !
    367. 

  367. ! perform core specific updates, exchanges after
    368. 

  368. ! model feedback  (called from med_feedback_domain) -John
    369. 

  369. !
    370. 

  370. 

  371. ! Driver layer modules
    372. 

  372.    USE module_domain, ONLY : domain, get_ijk_from_grid
    373. 

  373.    USE module_configure
    374. 

  374.    USE module_driver_constants
    375. 

  375.    USE module_machine
    376. 

  376.    USE module_tiles
    377. 

  377. #ifdef DM_PARALLEL
    378. 

  378.    USE module_dm, ONLY : ntasks, ntasks_x, ntasks_y, itrace, local_communicator, mytask
    379. 

  379.    USE module_comm_dm, ONLY : HALO_EM_FEEDBACK_sub
    380. 

  380. #else
    381. 

  381.    USE module_dm
    382. 

  382. #endif
    383. 

  383.    USE module_bc
    384. 

  384. ! Mediation layer modules
    385. 

  385. ! Registry generated module
    386. 

  386.    USE module_state_description
    387. 

  387. 

  388.    IMPLICIT NONE
    389. 

  389. 

  390.    !  Subroutine interface block.
    391. 

  391. 

  392.    TYPE(domain) , TARGET         :: grid
    393. 

  393. 

  394.    !  Definitions of dummy arguments
    395. 

  395. #include <dummy_new_decl.inc>
    396. 

  396. 

  397.    INTEGER                         :: ids , ide , jds , jde , kds , kde , &
    398. 

  398.                                       ims , ime , jms , jme , kms , kme , &
    399. 

  399.                                       ips , ipe , jps , jpe , kps , kpe
    400. 

  400. 

  401.   CALL wrf_debug( 500, "entering update_after_feedback_em" )
    402. 

  402. 

  403. !  Obtain dimension information stored in the grid data structure.
    404. 

  404.   CALL get_ijk_from_grid (  grid ,                   &
    405. 

  405.                             ids, ide, jds, jde, kds, kde,    &
    406. 

  406.                             ims, ime, jms, jme, kms, kme,    &
    407. 

  407.                             ips, ipe, jps, jpe, kps, kpe    )
    408. 

  408. 

  409.   CALL wrf_debug( 500, "before HALO_EM_FEEDBACK.inc in update_after_feedback_em" )
    410. 

  410. #ifdef DM_PARALLEL
    411. 

  411. #include "HALO_EM_FEEDBACK.inc"
    412. 

  412. #endif
    413. 

  413.   CALL wrf_debug( 500, "leaving update_after_feedback_em" )
    414. 

  414. 

  415. END SUBROUTINE update_after_feedback_em
    416. 

  416. 

  417.