wrfv2_fire/share/mediation_force_domain.F

   1 !
   2 !WRF:MEDIATION_LAYER:NESTING
   3 !
   4 SUBROUTINE med_force_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
  15 ! ----------------------------------------------------------
  16 ! ------------------------------------------------------
  17 ! Interface blocks
  18 ! ------------------------------------------------------
  19    INTERFACE
  20 ! ------------------------------------------------------
  21 !    Interface definitions for EM CORE
  22 ! ------------------------------------------------------
  23 #if (EM_CORE == 1)
  24 #if !defined(MAC_KLUDGE)
  25 ! ------------------------------------------------------
  26 !    These routines are supplied by module_dm.F from the
  27 !    external communication package (e.g. external/RSL)
  28 ! ------------------------------------------------------
  29       SUBROUTINE interp_domain_em_part1 ( grid, intermediate_grid, ngrid, config_flags   &
  30 !
  31 #        include "dummy_new_args.inc"
  32 !
  33                  )
  34          USE module_domain
  35          USE module_configure
  36          TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
  37          TYPE(domain), POINTER :: intermediate_grid
  38          TYPE(domain), POINTER :: ngrid
  39          TYPE (grid_config_rec_type)            :: config_flags
  40 #        include <dummy_new_decl.inc>
  41       END SUBROUTINE interp_domain_em_part1
  42
  43       SUBROUTINE force_domain_em_part2 ( grid, nested_grid, config_flags   &
  44 !
  45 #        include "dummy_new_args.inc"
  46 !
  47                  )
  48          USE module_domain
  49          USE module_configure
  50          TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
  51          TYPE(domain), POINTER :: nested_grid
  52          TYPE (grid_config_rec_type)            :: config_flags
  53 #        include <dummy_new_decl.inc>
  54       END SUBROUTINE force_domain_em_part2
  55
  56 ! ----------------------------------------------------------
  57 !    This routine is supplied by dyn_em/couple_or_uncouple_em.F
  58 ! ----------------------------------------------------------
  59       SUBROUTINE couple_or_uncouple_em ( grid, config_flags , couple  &
  60 !
  61 #        include "dummy_new_args.inc"
  62 !
  63                  )
  64          USE module_domain
  65          USE module_configure
  66          TYPE(domain), INTENT(INOUT)            :: grid
  67          TYPE (grid_config_rec_type)            :: config_flags
  68          LOGICAL, INTENT(   IN) :: couple
  69 #        include <dummy_new_decl.inc>
  70       END SUBROUTINE couple_or_uncouple_em
  71 #endif
  72 #endif
  73 ! ----------------------------------------------------------
  74 !    Interface definitions for NMM (placeholder)
  75 ! ----------------------------------------------------------
  76 #if (NMM_CORE == 1 && NMM_NEST ==1)
  77 !=======================================================================
  78 !  Added for the NMM core. This is gopal's doing.
  79 !=======================================================================
  80
  81       SUBROUTINE interp_domain_nmm_part1 ( grid, intermediate_grid, ngrid, config_flags    &
  82 !
  83 # include "dummy_new_args.inc"
  84 !
  85                  )
  86          USE module_domain
  87          USE module_configure
  88          TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
  89          TYPE(domain), POINTER :: intermediate_grid
  90          TYPE(domain), POINTER :: ngrid
  91          TYPE (grid_config_rec_type)            :: config_flags
  92 # include <dummy_new_decl.inc>
  93       END SUBROUTINE interp_domain_nmm_part1
  94
  95       SUBROUTINE force_domain_nmm_part2 ( grid, nested_grid, config_flags    &
  96 !
  97 # include "dummy_new_args.inc"
  98 !
  99                  )
 100          USE module_domain
 101          USE module_configure
 102          TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
 103          TYPE(domain), POINTER :: nested_grid
 104          TYPE (grid_config_rec_type)            :: config_flags
 105
 106 # include <dummy_new_decl.inc>
 107       END SUBROUTINE force_domain_nmm_part2
 108 !=======================================================================
 109 !  End of gopal's doing.
 110 !=======================================================================
 111 #endif
 112 ! ----------------------------------------------------------
 113 !    Interface definitions for COAMPS (placeholder)
 114 ! ----------------------------------------------------------
 115 #if (COAMPS_CORE == 1)
 116 #endif
 117    END INTERFACE
 118 ! ----------------------------------------------------------
 119 ! End of Interface blocks
 120 ! ----------------------------------------------------------
 121
 122 ! ----------------------------------------------------------
 123 ! ----------------------------------------------------------
 124 ! Executable code
 125 ! ----------------------------------------------------------
 126 ! ----------------------------------------------------------
 127 !    Forcing calls for EM CORE.
 128 ! ----------------------------------------------------------
 129 #if (EM_CORE == 1 && defined( DM_PARALLEL ))
 130 # if !defined(MAC_KLUDGE)
 131    CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
 132
 133    grid => nested_grid%intermediate_grid
 134 #  if defined(MOVE_NESTS) || (!defined(SGIALTIX))
 135    CALL alloc_space_field ( grid, grid%id , 1 , 2 ,  .TRUE. ,    &
 136                             grid%sd31, grid%ed31, grid%sd32, grid%ed32, grid%sd33, grid%ed33, &
 137                             grid%sm31,  grid%em31,  grid%sm32,  grid%em32,  grid%sm33,  grid%em33, &
 138                             grid%sp31,  grid%ep31,  grid%sp32,  grid%ep32,  grid%sp33,  grid%ep33, &
 139                             grid%sm31x, grid%em31x, grid%sm32x, grid%em32x, grid%sm33x, grid%em33x, &   ! x-xpose
 140                             grid%sm31y, grid%em31y, grid%sm32y, grid%em32y, grid%sm33y, grid%em33y  &   ! y-xpose
 141      )
 142 #  endif
 143
 144    ! couple parent domain
 145    grid => parent_grid
 146    ! swich config_flags to point to parent rconfig info
 147    CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
 148    CALL couple_or_uncouple_em ( grid , config_flags ,  .true. &
 149 !
 150 #         include "actual_new_args.inc"
 151 !
 152                                 )
 153    ! couple nested domain
 154    grid => nested_grid
 155    CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
 156    CALL couple_or_uncouple_em ( grid , config_flags ,  .true. &
 157 !
 158 #         include "actual_new_args.inc"
 159 !
 160                                    )
 161    ! perform first part: transfer data from parent to intermediate domain
 162    ! at the same resolution but on the same decomposition as the nest
 163    ! note that this will involve communication on multiple DM procs
 164    grid => parent_grid
 165    CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
 166    !
 167    ! Added following line to handle adaptive time step.  This should probably
 168    !   go somewhere else, but I'm not sure where.
 169    !
 170    ! T. Hutchinson, WSI  1/23/07
 171    !
 172    nested_grid%intermediate_grid%dt = grid%dt
 173
 174    CALL interp_domain_em_part1 ( grid , nested_grid%intermediate_grid, nested_grid, config_flags  &
 175 !
 176 #         include "actual_new_args.inc"
 177 !
 178                                     )
 179    grid => nested_grid%intermediate_grid
 180       ! perform 2nd part: run interpolation on the intermediate domain
 181       ! and compute the values for the nest boundaries
 182       ! note that this is all local (no communication)
 183    CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
 184    CALL force_domain_em_part2 ( grid, nested_grid, config_flags   &
 185 !
 186 #          include "actual_new_args.inc"
 187 !
 188                                    )
 189    ! uncouple the nest
 190    grid => nested_grid
 191    CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
 192    CALL couple_or_uncouple_em ( grid , config_flags ,  .false.  &
 193 !
 194 #          include "actual_new_args.inc"
 195 !
 196                                    )
 197    ! uncouple the parent
 198    grid => parent_grid
 199    CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
 200    CALL couple_or_uncouple_em ( grid , config_flags ,  .false.  &
 201 !
 202 #          include "actual_new_args.inc"
 203 !
 204                                 )
 205    IF ( nested_grid%first_force ) THEN
 206       nested_grid%first_force = .FALSE.
 207    ENDIF
 208    nested_grid%dtbc = 0.
 209 !
 210    grid => nested_grid%intermediate_grid
 211 #  if defined(MOVE_NESTS) || (!defined(SGIALTIX))
 212    CALL dealloc_space_field ( grid )
 213 #  endif
 214 # endif
 215 #endif
 216 ! ------------------------------------------------------
 217 !    End of Forcing calls for EM CORE.
 218 ! ------------------------------------------------------
 219 ! ------------------------------------------------------
 220 ! ------------------------------------------------------
 221 !    Forcing calls for NMM. (Placeholder)
 222 ! ------------------------------------------------------
 223 # if (NMM_CORE == 1 && NMM_NEST == 1)
 224 !=======================================================================
 225 !  Added for the NMM core. This is gopal's doing.
 226 !=======================================================================
 227
 228    CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
 229
 230    grid => nested_grid%intermediate_grid
 231 !dusan orig    CALL alloc_space_field ( grid, grid%id , 1 , 2 ,  .TRUE. ,    &
 232 #if defined(MOVE_NESTS) || (!defined(SGIALTIX))
 233    CALL alloc_space_field ( grid, grid%id , 1 , 3 ,  .FALSE. ,    &
 234                             grid%sd31, grid%ed31, grid%sd32, grid%ed32, grid%sd33, grid%ed33, &
 235                             grid%sm31,  grid%em31,  grid%sm32,  grid%em32,  grid%sm33,  grid%em33, &
 236                             grid%sp31,  grid%ep31,  grid%sp32,  grid%ep32,  grid%sp33,  grid%ep33, &
 237                             grid%sm31x, grid%em31x, grid%sm32x, grid%em32x, grid%sm33x, grid%em33x, &   ! x-xpose
 238                             grid%sm31y, grid%em31y, grid%sm32y, grid%em32y, grid%sm33y, grid%em33y  &   ! y-xpose
 239       )
 240 #endif
 241
 242     ! couple parent domain
 243     grid => parent_grid
 244     ! swich config_flags to point to parent rconfig info
 245     CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
 246
 247     ! on restart do not force the nest the first time since it has already been forced
 248     ! prior to the writing of the restart file
 249     IF ( .NOT. ( config_flags%restart .AND. nested_grid%first_force ) ) THEN
 250        ! couple nested domain
 251        grid => nested_grid
 252        CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
 253        ! perform first part: transfer data from parent to intermediate domain
 254        ! at the same resolution but on the same decomposition as the nest
 255        ! note that this will involve communication on multiple DM procs
 256        grid => parent_grid
 257        CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
 258        CALL interp_domain_nmm_part1 ( grid , nested_grid%intermediate_grid, nested_grid, config_flags    &
 259 !
 260 #         include "actual_new_args.inc"
 261 !
 262                                      )
 263     ENDIF ! not restart and first force
 264
 265     grid => nested_grid%intermediate_grid
 266     IF ( .NOT. ( config_flags%restart .AND. nested_grid%first_force ) ) THEN
 267        ! perform 2nd part: run interpolation on the intermediate domain
 268        ! and compute the values for the nest boundaries
 269        ! note that this is all local (no communication)
 270        CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
 271        CALL force_domain_nmm_part2 ( grid, nested_grid, config_flags    &
 272 !
 273 #         include "actual_new_args.inc"
 274 !
 275                                     )
 276     ENDIF ! not restart and first_force
 277
 278     IF ( nested_grid%first_force ) THEN
 279        nested_grid%first_force = .FALSE.
 280     ENDIF
 281     nested_grid%dtbc = 0.
 282 !
 283     grid => nested_grid%intermediate_grid
 284 #if defined(MOVE_NESTS) || (!defined(SGIALTIX))
 285     CALL dealloc_space_field ( grid )
 286 #endif
 287 !=======================================================================
 288 !  End of gopal's doing.
 289 !=======================================================================
 290 # endif
 291 ! ------------------------------------------------------
 292 !    End of Forcing calls for NMM.
 293 ! ------------------------------------------------------
 294 ! ------------------------------------------------------
 295 ! ------------------------------------------------------
 296 !    Forcing calls for COAMPS. (Placeholder)
 297 ! ------------------------------------------------------
 298 # if (COAMPS_CORE == 1)
 299 # endif
 300 ! ------------------------------------------------------
 301 !    End of Forcing calls for COAMPS.
 302 ! ------------------------------------------------------
 303    RETURN
 304 END SUBROUTINE med_force_domain
 305
 306