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 #endif
  55    END INTERFACE
  56 ! ----------------------------------------------------------
  57 ! End of Interface blocks
  58 ! ----------------------------------------------------------
  59 ! ----------------------------------------------------------
  60 ! ----------------------------------------------------------
  61 ! Executable code
  62 ! ----------------------------------------------------------
  63 ! ----------------------------------------------------------
  64 !    Interpolation calls for EM CORE.  The called
  65 !    routines below are supplied by module_dm.F
  66 !    from the external communications package (e.g. RSL)
  67 ! ----------------------------------------------------------
  68 #if (EM_CORE == 1 && defined( DM_PARALLEL ))
  69
  70   CALL wrf_dm_nestexchange_init
  71
  72   CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
  73   grid => nested_grid%intermediate_grid
  74 #  if (defined(MOVE_NESTS) || ((!defined(KEEP_INT_AROUND)) && (!defined(SGIALTIX)) && (!defined(FUJITSU_FX10))))
  75
  76     CALL alloc_space_field ( grid, grid%id , 1 , 2 , .TRUE. , nested_grid%active_this_task,  &
  77                            grid%sd31, grid%ed31, grid%sd32, grid%ed32, grid%sd33, grid%ed33, &
  78                            grid%sm31,  grid%em31,  grid%sm32,  grid%em32,  grid%sm33,  grid%em33, &
  79                            grid%sp31,  grid%ep31,  grid%sp32,  grid%ep32,  grid%sp33,  grid%ep33, &
  80                            grid%sp31x, grid%ep31x, grid%sp32x, grid%ep32x, grid%sp33x, grid%ep33x,&
  81                            grid%sp31y, grid%ep31y, grid%sp32y, grid%ep32y, grid%sp33y, grid%ep33y,&
  82                            grid%sm31x, grid%em31x, grid%sm32x, grid%em32x, grid%sm33x, grid%em33x, &   ! x-xpose
  83                            grid%sm31y, grid%em31y, grid%sm32y, grid%em32y, grid%sm33y, grid%em33y  &   ! y-xpose
  84     )
  85 # endif
  86
  87   grid => parent_grid
  88
  89   CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
  90   CALL interp_domain_em_part1 ( grid , nested_grid%intermediate_grid, nested_grid, config_flags   &
  91 !
  92 #     include "actual_new_args.inc"
  93 !
  94                                 )
  95   IF ( nested_grid%active_this_task ) THEN
  96   grid => nested_grid%intermediate_grid
  97   CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
  98
  99   CALL interp_domain_em_part2 ( grid, nested_grid, parent_grid, config_flags   &
 100 !
 101 #     include "actual_new_args.inc"
 102 !
 103                                 )
 104   ENDIF
 105
 106   grid => nested_grid%intermediate_grid
 107   CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
 108 # if (defined(MOVE_NESTS) || ((!defined(KEEP_INT_AROUND)) && (!defined(SGIALTIX)) && (!defined(FUJITSU_FX10))))
 109   IF ( grid%active_this_task ) THEN
 110     CALL dealloc_space_field ( grid )
 111   ENDIF
 112 # endif
 113 #endif
 114 ! ------------------------------------------------------
 115 !    End of Interpolation calls for EM CORE.
 116 ! ------------------------------------------------------
 117    RETURN
 118 END SUBROUTINE med_interp_domain
 119
 120 !
 121 SUBROUTINE med_interp_domain_small ( parent_grid , nested_grid )
 122    USE module_domain
 123    USE module_configure
 124    USE module_timing
 125 #if (defined(MOVE_NESTS) || ((!defined(KEEP_INT_AROUND)) && (!defined(SGIALTIX)) && (!defined(FUJITSU_FX10))))
 126    USE module_dm, ONLY : intercomm_active
 127 #endif
 128    IMPLICIT NONE
 129    TYPE(domain), POINTER :: parent_grid , nested_grid
 130    TYPE(domain), POINTER :: grid
 131    INTEGER nlev, msize
 132    TYPE (grid_config_rec_type)            :: config_flags
 133
 134    INTERFACE
 135 #if (EM_CORE == 1)
 136 ! ----------------------------------------------------------
 137       SUBROUTINE interp_domain_em_small_part1 ( grid, intermediate_grid, ngrid, config_flags   &
 138 !
 139 #        include "dummy_new_args.inc"
 140 !
 141                  )
 142          USE module_domain
 143          USE module_configure
 144          TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
 145          TYPE(domain), POINTER :: intermediate_grid
 146          TYPE(domain), POINTER :: ngrid
 147          TYPE (grid_config_rec_type)            :: config_flags
 148 #        include "dummy_new_decl.inc"
 149       END SUBROUTINE interp_domain_em_small_part1
 150
 151       SUBROUTINE interp_domain_em_small_part2 ( grid, nested_grid, config_flags   &
 152 !
 153 #        include "dummy_new_args.inc"
 154 !
 155                  )
 156          USE module_domain
 157          USE module_configure
 158          TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
 159          TYPE(domain), POINTER :: nested_grid
 160          TYPE (grid_config_rec_type)            :: config_flags
 161 #        include "dummy_new_decl.inc"
 162       END SUBROUTINE interp_domain_em_small_part2
 163 #endif
 164    END INTERFACE
 165
 166 ! ----------------------------------------------------------
 167 !    Interpolation calls for EM CORE.  The called
 168 !    routines below are supplied by module_dm.F
 169 !    from the external communications package (e.g. RSL)
 170 ! ----------------------------------------------------------
 171
 172 #if (EM_CORE == 1 && defined( DM_PARALLEL ))
 173   CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
 174   grid => nested_grid%intermediate_grid
 175 #  if (defined(MOVE_NESTS) || ((!defined(KEEP_INT_AROUND)) && (!defined(SGIALTIX)) && (!defined(FUJITSU_FX10))))
 176
 177   CALL alloc_space_field ( grid, grid%id , 1 , 2 , .TRUE. , nested_grid%active_this_task,   &
 178                            grid%sd31, grid%ed31, grid%sd32, grid%ed32, grid%sd33, grid%ed33, &
 179                            grid%sm31,  grid%em31,  grid%sm32,  grid%em32,  grid%sm33,  grid%em33, &
 180                            grid%sp31,  grid%ep31,  grid%sp32,  grid%ep32,  grid%sp33,  grid%ep33, &
 181                            grid%sp31x, grid%ep31x, grid%sp32x, grid%ep32x, grid%sp33x, grid%ep33x,&
 182                            grid%sp31y, grid%ep31y, grid%sp32y, grid%ep32y, grid%sp33y, grid%ep33y,&
 183                            grid%sm31x, grid%em31x, grid%sm32x, grid%em32x, grid%sm33x, grid%em33x, &   ! x-xpose
 184                            grid%sm31y, grid%em31y, grid%sm32y, grid%em32y, grid%sm33y, grid%em33y  &   ! y-xpose
 185     )
 186 # endif
 187
 188   grid => parent_grid
 189
 190   CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
 191   CALL interp_domain_em_small_part1 ( grid , nested_grid%intermediate_grid, nested_grid, config_flags   &
 192 !
 193 #     include "actual_new_args.inc"
 194 !
 195                                 )
 196   grid => nested_grid%intermediate_grid
 197   CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
 198   CALL interp_domain_em_small_part2 ( grid, nested_grid, config_flags   &
 199 !
 200 #     include "actual_new_args.inc"
 201 !
 202                                 )
 203
 204   grid => nested_grid%intermediate_grid
 205   CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
 206 #  if (defined(MOVE_NESTS) || ((!defined(KEEP_INT_AROUND)) && (!defined(SGIALTIX)) && (!defined(FUJITSU_FX10))))
 207   IF ( intercomm_active( grid%id ) ) THEN
 208   CALL dealloc_space_field ( grid )
 209   ENDIF
 210 # endif
 211 #endif
 212 ! ------------------------------------------------------
 213 !    End of Interpolation calls for EM CORE.
 214 ! ------------------------------------------------------
 215 call wrf_debug(0,'FILE: share/mediation_interp_domain.F  ROUTINE: med_interp_domain_small   CALLING: done ')
 216    RETURN
 217 END SUBROUTINE med_interp_domain_small
 218