share/mediation_interp_domain.F

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