wrfv2_fire/share/mediation_feedback_domain.F

   1 !
   2 !WRF:MEDIATION_LAYER:NESTING
   3 !
   4 SUBROUTINE med_feedback_domain ( parent_grid , nested_grid )
   5    USE module_domain
   6    USE module_configure
   7    IMPLICIT NONE
   8    TYPE(domain), POINTER :: parent_grid , nested_grid
   9    TYPE(domain), POINTER :: grid
  10    INTEGER nlev, msize
  11 #if !defined(MAC_KLUDGE)
  12    TYPE (grid_config_rec_type)            :: config_flags
  13 #endif
  14 !  see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
  15    INTEGER     :: sm31 , em31 , sm32 , em32 , sm33 , em33
  16    INTEGER     :: sm31x, em31x, sm32x, em32x, sm33x, em33x
  17    INTEGER     :: sm31y, em31y, sm32y, em32y, sm33y, em33y
  18 ! ----------------------------------------------------------
  19 ! ------------------------------------------------------
  20 ! Interface blocks
  21 ! ------------------------------------------------------
  22    INTERFACE
  23 ! ------------------------------------------------------
  24 !    Interface definitions for EM CORE
  25 ! ------------------------------------------------------
  26 #if (EM_CORE == 1)
  27 #if !defined(MAC_KLUDGE)
  28 ! ------------------------------------------------------
  29 !    These routines are supplied by module_dm.F from the
  30 !    external communication package (e.g. external/RSL)
  31 ! ------------------------------------------------------
  32       SUBROUTINE feedback_domain_em_part1 ( grid, nested_grid, config_flags   &
  33 !
  34 #          include "dummy_new_args.inc"
  35 !
  36                                           )
  37          USE module_domain
  38          USE module_configure
  39          TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
  40          TYPE(domain), POINTER :: nested_grid
  41          TYPE (grid_config_rec_type)            :: config_flags
  42 #        include <dummy_new_decl.inc>
  43       END SUBROUTINE feedback_domain_em_part1
  44       SUBROUTINE feedback_domain_em_part2 ( grid, intermediate_grid , nested_grid, config_flags   &
  45 !
  46 #          include "dummy_new_args.inc"
  47 !
  48                                           )
  49          USE module_domain
  50          USE module_configure
  51          TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
  52          TYPE(domain), POINTER :: intermediate_grid
  53          TYPE(domain), POINTER :: nested_grid
  54          TYPE (grid_config_rec_type)            :: config_flags
  55 #        include <dummy_new_decl.inc>
  56       END SUBROUTINE feedback_domain_em_part2
  57       SUBROUTINE update_after_feedback_em ( grid  &
  58 !
  59 #          include "dummy_new_args.inc"
  60 !
  61                                           )
  62          USE module_domain
  63          USE module_configure
  64          TYPE(domain), TARGET :: grid          ! name of the grid being dereferenced (must be "grid")
  65 #        include <dummy_new_decl.inc>
  66       END SUBROUTINE update_after_feedback_em
  67 #endif
  68 #endif
  69 ! ----------------------------------------------------------
  70 !    Interface definitions for NMM (placeholder)
  71 ! ----------------------------------------------------------
  72 #if (NMM_CORE == 1 && NMM_NEST == 1)
  73 ! ------------------------------------------------------
  74 !    These routines are supplied by module_dm.F from the
  75 !    external communication package (e.g. external/RSL)
  76 !    This is gopal's extension for the NMM core
  77 ! ------------------------------------------------------
  78       SUBROUTINE feedback_domain_nmm_part1 ( grid, nested_grid, config_flags   &
  79 !
  80 #          include "dummy_new_args.inc"
  81 !
  82                                           )
  83          USE module_domain
  84          USE module_configure
  85          TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
  86          TYPE(domain), POINTER :: nested_grid
  87          TYPE (grid_config_rec_type)            :: config_flags
  88 #        include <dummy_new_decl.inc>
  89       END SUBROUTINE feedback_domain_nmm_part1
  90 !
  91       SUBROUTINE feedback_domain_nmm_part2 ( grid, intermediate_grid , nested_grid, config_flags   &
  92 !
  93 #          include "dummy_new_args.inc"
  94 !
  95                                           )
  96          USE module_domain
  97          USE module_configure
  98          TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
  99          TYPE(domain), POINTER :: intermediate_grid
 100          TYPE(domain), POINTER :: nested_grid
 101          TYPE (grid_config_rec_type)            :: config_flags
 102 #        include <dummy_new_decl.inc>
 103
 104       END SUBROUTINE feedback_domain_nmm_part2
 105 #endif
 106 ! ----------------------------------------------------------
 107 !    Interface definitions for COAMPS (placeholder)
 108 ! ----------------------------------------------------------
 109 #if (COAMPS_CORE == 1 )
 110 #endif
 111    END INTERFACE
 112 ! ----------------------------------------------------------
 113 ! End of Interface blocks
 114 ! ----------------------------------------------------------
 115 ! ----------------------------------------------------------
 116 ! ----------------------------------------------------------
 117 ! Executable code
 118 ! ----------------------------------------------------------
 119 ! ----------------------------------------------------------
 120 !    Feedback calls for EM CORE.
 121 ! ----------------------------------------------------------
 122 #if (EM_CORE == 1 && defined( DM_PARALLEL ))
 123 # if !defined(MAC_KLUDGE)
 124    CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
 125    parent_grid%ht_coarse = parent_grid%ht
 126    grid => nested_grid%intermediate_grid
 127 #  if defined(MOVE_NESTS) || (!defined(SGIALTIX))
 128    CALL alloc_space_field ( grid, grid%id , 1 , 2 , .TRUE. ,     &
 129                             grid%sd31, grid%ed31, grid%sd32, grid%ed32, grid%sd33, grid%ed33, &
 130                             grid%sm31,  grid%em31,  grid%sm32,  grid%em32,  grid%sm33,  grid%em33, &
 131                             grid%sp31,  grid%ep31,  grid%sp32,  grid%ep32,  grid%sp33,  grid%ep33, &
 132                             grid%sp31x, grid%ep31x, grid%sp32x, grid%ep32x, grid%sp33x, grid%ep33x,&
 133                             grid%sp31y, grid%ep31y, grid%sp32y, grid%ep32y, grid%sp33y, grid%ep33y,&
 134                             grid%sm31x, grid%em31x, grid%sm32x, grid%em32x, grid%sm33x, grid%em33x, &   ! x-xpose
 135                             grid%sm31y, grid%em31y, grid%sm32y, grid%em32y, grid%sm33y, grid%em33y  &   ! y-xpose
 136      )
 137 #  endif
 138    grid => nested_grid%intermediate_grid
 139    CALL feedback_domain_em_part1 ( grid, nested_grid, config_flags   &
 140 !
 141 #      include "actual_new_args.inc"
 142 !
 143                                    )
 144    grid => parent_grid
 145
 146    grid%nest_mask = 0.
 147    CALL feedback_domain_em_part2 ( grid , nested_grid%intermediate_grid, nested_grid , config_flags   &
 148 !
 149 #      include "actual_new_args.inc"
 150
 151                                    )
 152    WHERE   ( grid%nest_pos .NE. 9021000.  ) grid%ht = grid%ht_coarse
 153    CALL update_after_feedback_em ( grid  &
 154 !
 155 #      include "actual_new_args.inc"
 156 !
 157                                    )
 158    grid => nested_grid%intermediate_grid
 159 #  if defined(MOVE_NESTS) || (!defined(SGIALTIX))
 160    CALL dealloc_space_field ( grid )
 161 #  endif
 162 # endif
 163 #endif
 164 ! ------------------------------------------------------
 165 !    End of Feedback calls for EM CORE.
 166 ! ------------------------------------------------------
 167 ! ------------------------------------------------------
 168 ! ------------------------------------------------------
 169 !    Feedback calls for NMM. (Placeholder)
 170 ! ------------------------------------------------------
 171 #if (NMM_CORE == 1 && NMM_NEST == 1)
 172 ! ------------------------------------------------------
 173 !    This is gopal's extension for the NMM core
 174 ! ------------------------------------------------------
 175
 176    CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
 177
 178    grid => nested_grid%intermediate_grid
 179 !dusan orig     CALL alloc_space_field ( grid, grid%id , 1 , 2 , .TRUE. ,     &
 180 #if defined(MOVE_NESTS) || (!defined(SGIALTIX))
 181 #   if defined(HWRF)
 182    CALL ensure_space_field &
 183 #   else
 184    CALL alloc_space_field &
 185 #endif
 186                           ( grid, grid%id , 1 , 3 , .FALSE. ,     &
 187                             grid%sd31, grid%ed31, grid%sd32, grid%ed32, grid%sd33, grid%ed33, &
 188                             grid%sm31,  grid%em31,  grid%sm32,  grid%em32,  grid%sm33,  grid%em33, &
 189                             grid%sp31,  grid%ep31,  grid%sp32,  grid%ep32,  grid%sp33,  grid%ep33, &
 190                             grid%sp31x, grid%ep31x, grid%sp32x, grid%ep32x, grid%sp33x, grid%ep33x,&
 191                             grid%sp31y, grid%ep31y, grid%sp32y, grid%ep32y, grid%sp33y, grid%ep33y,&
 192                             grid%sm31x, grid%em31x, grid%sm32x, grid%em32x, grid%sm33x, grid%em33x, &   ! x-xpose
 193                             grid%sm31y, grid%em31y, grid%sm32y, grid%em32y, grid%sm33y, grid%em33y  &   ! y-xpose
 194        )
 195 # endif
 196
 197    grid => nested_grid%intermediate_grid
 198 #    include "deref_kludge.h"
 199    CALL feedback_domain_nmm_part1 ( grid, nested_grid, config_flags    &
 200 !
 201 #      include "actual_new_args.inc"
 202 !
 203                                    )
 204    grid => parent_grid
 205 #    include "deref_kludge.h"
 206
 207 !
 208    CALL feedback_domain_nmm_part2 ( grid , nested_grid%intermediate_grid, nested_grid , config_flags    &
 209 !
 210 #      include "actual_new_args.inc"
 211 !
 212                                    )
 213    grid => nested_grid%intermediate_grid
 214 # if defined(MOVE_NESTS) || (!defined(SGIALTIX))
 215 #   if !defined(HWRF)
 216    CALL dealloc_space_field ( grid )
 217 #   endif
 218 # endif
 219 #endif
 220 ! ------------------------------------------------------
 221 !    End of Feedback calls for NMM.
 222 ! ------------------------------------------------------
 223 ! ------------------------------------------------------
 224 ! ------------------------------------------------------
 225 !    Feedback calls for COAMPS. (Placeholder)
 226 ! ------------------------------------------------------
 227 #if (COAMPS_CORE == 1)
 228 #endif
 229 ! ------------------------------------------------------
 230 !    End of Feedback calls for COAMPS.
 231 ! ------------------------------------------------------
 232    RETURN
 233 END SUBROUTINE med_feedback_domain
 234
 235