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_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_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_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_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%sm31x, grid%em31x, grid%sm32x, grid%em32x, grid%sm33x, grid%em33x, &   ! x-xpose
 139                             grid%sm31y, grid%em31y, grid%sm32y, grid%em32y, grid%sm33y, grid%em33y  &   ! y-xpose
 140      )
 141 #  endif
 142
 143    ! couple parent domain
 144    grid => parent_grid
 145    ! swich config_flags to point to parent rconfig info
 146    CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
 147    CALL couple_or_uncouple_em ( grid , config_flags ,  .true. &
 148 !
 149 #         include "actual_new_args.inc"
 150 !
 151                                 )
 152    ! couple nested domain
 153    grid => nested_grid
 154    CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
 155    CALL couple_or_uncouple_em ( grid , config_flags ,  .true. &
 156 !
 157 #         include "actual_new_args.inc"
 158 !
 159                                    )
 160    ! perform first part: transfer data from parent to intermediate domain
 161    ! at the same resolution but on the same decomposition as the nest
 162    ! note that this will involve communication on multiple DM procs
 163    grid => parent_grid
 164    CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
 165    !
 166    ! Added following line to handle adaptive time step.  This should probably
 167    !   go somewhere else, but I'm not sure where.
 168    !
 169    ! T. Hutchinson, WSI  1/23/07
 170    !
 171    nested_grid%intermediate_grid%dt = grid%dt
 172
 173    CALL interp_domain_em_part1 ( grid , nested_grid%intermediate_grid, nested_grid, config_flags  &
 174 !
 175 #         include "actual_new_args.inc"
 176 !
 177                                     )
 178    grid => nested_grid%intermediate_grid
 179       ! perform 2nd part: run interpolation on the intermediate domain
 180       ! and compute the values for the nest boundaries
 181       ! note that this is all local (no communication)
 182    CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
 183    CALL force_domain_em_part2 ( grid, nested_grid, config_flags   &
 184 !
 185 #          include "actual_new_args.inc"
 186 !
 187                                    )
 188    ! uncouple the nest
 189    grid => nested_grid
 190    CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
 191    CALL couple_or_uncouple_em ( grid , config_flags ,  .false.  &
 192 !
 193 #          include "actual_new_args.inc"
 194 !
 195                                    )
 196    ! uncouple the parent
 197    grid => parent_grid
 198    CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
 199    CALL couple_or_uncouple_em ( grid , config_flags ,  .false.  &
 200 !
 201 #          include "actual_new_args.inc"
 202 !
 203                                 )
 204    IF ( nested_grid%first_force ) THEN
 205       nested_grid%first_force = .FALSE.
 206    ENDIF
 207    nested_grid%dtbc = 0.
 208 !
 209    grid => nested_grid%intermediate_grid
 210 #  if defined(MOVE_NESTS) || (!defined(SGIALTIX))
 211    CALL dealloc_space_field ( grid )
 212 #  endif
 213 # endif
 214 #endif
 215 ! ------------------------------------------------------
 216 !    End of Forcing calls for EM CORE.
 217 ! ------------------------------------------------------
 218 ! ------------------------------------------------------
 219 ! ------------------------------------------------------
 220 !    Forcing calls for NMM. (Placeholder)
 221 ! ------------------------------------------------------
 222 # if (NMM_CORE == 1 && NMM_NEST == 1)
 223 !=======================================================================
 224 !  Added for the NMM core. This is gopal's doing.
 225 !=======================================================================
 226
 227    CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
 228
 229    grid => nested_grid%intermediate_grid
 230 !dusan orig    CALL alloc_space_field ( grid, grid%id , 1 , 2 ,  .TRUE. ,    &
 231 #if defined(MOVE_NESTS) || (!defined(SGIALTIX))
 232    CALL alloc_space_field ( grid, grid%id , 1 , 3 ,  .FALSE. ,    &
 233                             grid%sd31, grid%ed31, grid%sd32, grid%ed32, grid%sd33, grid%ed33, &
 234                             grid%sm31,  grid%em31,  grid%sm32,  grid%em32,  grid%sm33,  grid%em33, &
 235                             grid%sm31x, grid%em31x, grid%sm32x, grid%em32x, grid%sm33x, grid%em33x, &   ! x-xpose
 236                             grid%sm31y, grid%em31y, grid%sm32y, grid%em32y, grid%sm33y, grid%em33y  &   ! y-xpose
 237       )
 238 #endif
 239
 240     ! couple parent domain
 241     grid => parent_grid
 242     ! swich config_flags to point to parent rconfig info
 243     CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
 244
 245     ! on restart do not force the nest the first time since it has already been forced
 246     ! prior to the writing of the restart file
 247     IF ( .NOT. ( config_flags%restart .AND. nested_grid%first_force ) ) THEN
 248        ! couple nested domain
 249        grid => nested_grid
 250        CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
 251        ! perform first part: transfer data from parent to intermediate domain
 252        ! at the same resolution but on the same decomposition as the nest
 253        ! note that this will involve communication on multiple DM procs
 254        grid => parent_grid
 255        CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
 256        CALL interp_domain_nmm_part1 ( grid , nested_grid%intermediate_grid, nested_grid, config_flags    &
 257 !
 258 #         include "actual_args.inc"
 259 !
 260                                      )
 261     ENDIF ! not restart and first force
 262
 263     grid => nested_grid%intermediate_grid
 264     IF ( .NOT. ( config_flags%restart .AND. nested_grid%first_force ) ) THEN
 265        ! perform 2nd part: run interpolation on the intermediate domain
 266        ! and compute the values for the nest boundaries
 267        ! note that this is all local (no communication)
 268        CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
 269        CALL force_domain_nmm_part2 ( grid, nested_grid, config_flags    &
 270 !
 271 #         include "actual_args.inc"
 272 !
 273                                     )
 274     ENDIF ! not restart and first_force
 275
 276     IF ( nested_grid%first_force ) THEN
 277        nested_grid%first_force = .FALSE.
 278     ENDIF
 279     nested_grid%dtbc = 0.
 280 !
 281     grid => nested_grid%intermediate_grid
 282 #if defined(MOVE_NESTS) || (!defined(SGIALTIX))
 283     CALL dealloc_space_field ( grid )
 284 #endif
 285 !=======================================================================
 286 !  End of gopal's doing.
 287 !=======================================================================
 288 # endif
 289 ! ------------------------------------------------------
 290 !    End of Forcing calls for NMM.
 291 ! ------------------------------------------------------
 292 ! ------------------------------------------------------
 293 ! ------------------------------------------------------
 294 !    Forcing calls for COAMPS. (Placeholder)
 295 ! ------------------------------------------------------
 296 # if (COAMPS_CORE == 1)
 297 # endif
 298 ! ------------------------------------------------------
 299 !    End of Forcing calls for COAMPS.
 300 ! ------------------------------------------------------
 301    RETURN
 302 END SUBROUTINE med_force_domain
 303
 304