wrfv2_fire/dyn_em/shift_domain_em.F

   1 SUBROUTINE shift_domain_em ( grid , disp_x, disp_y &
   2 !
   3 # include <dummy_new_args.inc>
   4 !
   5                            )
   6    USE module_state_description
   7    USE module_domain, ONLY : domain, get_ijk_from_grid
   8    USE module_timing
   9    USE module_configure, ONLY : grid_config_rec_type, model_config_rec, model_to_grid_config_rec
  10    USE module_dm
  11    IMPLICIT NONE
  12   ! Arguments
  13    INTEGER disp_x, disp_y       ! number of parent domain points to move
  14    TYPE(domain) , POINTER                     :: grid
  15   ! Local
  16    INTEGER i, j, ii
  17    INTEGER px, py       ! number and direction of nd points to move
  18    INTEGER                         :: ids , ide , jds , jde , kds , kde , &
  19                                       ims , ime , jms , jme , kms , kme , &
  20                                       ips , ipe , jps , jpe , kps , kpe
  21    TYPE (grid_config_rec_type)  :: config_flags
  22
  23    INTERFACE
  24        ! need to split this routine to avoid clobbering certain widely used compilers
  25        SUBROUTINE shift_domain_em2 ( grid , disp_x, disp_y &
  26 !
  27 # include <dummy_new_args.inc>
  28 !
  29                            )
  30           USE module_state_description
  31           USE module_domain, ONLY : domain
  32           IMPLICIT NONE
  33          ! Arguments
  34           INTEGER disp_x, disp_y       ! number of parent domain points to move
  35           TYPE(domain) , POINTER                     :: grid
  36
  37           !  Definitions of dummy arguments to solve
  38 #include <dummy_new_decl.inc>
  39        END SUBROUTINE shift_domain_em2
  40    END INTERFACE
  41
  42    !  Definitions of dummy arguments to solve
  43 #include <dummy_new_decl.inc>
  44
  45 #ifdef MOVE_NESTS
  46
  47    CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
  48
  49    CALL get_ijk_from_grid (  grid ,                   &
  50                              ids, ide, jds, jde, kds, kde,    &
  51                              ims, ime, jms, jme, kms, kme,    &
  52                              ips, ipe, jps, jpe, kps, kpe    )
  53
  54    px = isign(config_flags%parent_grid_ratio,disp_x)
  55    py = isign(config_flags%parent_grid_ratio,disp_y)
  56
  57    grid%imask_nostag = 1
  58    grid%imask_xstag = 1
  59    grid%imask_ystag = 1
  60    grid%imask_xystag = 1
  61
  62    grid%imask_nostag(ips:min(ide-1,ipe),jps:min(jde-1,jpe)) = 0
  63    grid%imask_xstag(ips:ipe,jps:min(jde-1,jpe)) = 0
  64    grid%imask_ystag(ips:min(ide-1,ipe),jps:jpe) = 0
  65    grid%imask_xystag(ips:ipe,jps:jpe) = 0
  66
  67 ! shift the nest domain in x
  68    do ii = 1,abs(disp_x)
  69 #include <SHIFT_HALO_X_HALO.inc>
  70 #include <shift_halo_x.inc>
  71    enddo
  72
  73    CALL shift_domain_em2 ( grid , disp_x, disp_y &
  74 !
  75 # include <dummy_new_args.inc>
  76 !
  77                            )
  78
  79 #endif
  80
  81 END SUBROUTINE shift_domain_em
  82
  83 SUBROUTINE shift_domain_em2 ( grid , disp_x, disp_y &
  84 !
  85 # include <dummy_new_args.inc>
  86 !
  87                            )
  88    USE module_state_description
  89    USE module_domain, ONLY : domain, get_ijk_from_grid
  90    USE module_timing
  91    USE module_configure, ONLY : grid_config_rec_type, model_config_rec, model_to_grid_config_rec
  92    USE module_dm
  93    IMPLICIT NONE
  94   ! Arguments
  95    INTEGER disp_x, disp_y       ! number of parent domain points to move
  96    TYPE(domain) , POINTER                     :: grid
  97   ! Local
  98    INTEGER i, j, ii
  99    INTEGER px, py       ! number and direction of nd points to move
 100    INTEGER                         :: ids , ide , jds , jde , kds , kde , &
 101                                       ims , ime , jms , jme , kms , kme , &
 102                                       ips , ipe , jps , jpe , kps , kpe
 103    TYPE (grid_config_rec_type)  :: config_flags
 104
 105    !  Definitions of dummy arguments to solve
 106 #include <dummy_new_decl.inc>
 107
 108 #ifdef MOVE_NESTS
 109
 110    CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
 111
 112    CALL get_ijk_from_grid (  grid ,                   &
 113                              ids, ide, jds, jde, kds, kde,    &
 114                              ims, ime, jms, jme, kms, kme,    &
 115                              ips, ipe, jps, jpe, kps, kpe    )
 116
 117    px = isign(config_flags%parent_grid_ratio,disp_x)
 118    py = isign(config_flags%parent_grid_ratio,disp_y)
 119
 120 ! shift the nest domain in y
 121    do ii = 1,abs(disp_y)
 122 #include <SHIFT_HALO_Y_HALO.inc>
 123 #include <shift_halo_y.inc>
 124    enddo
 125
 126 #endif
 127 END SUBROUTINE shift_domain_em2
 128