external/RSL_LITE/feedback_domain_em_part1.F

   1 #if ( EM_CORE == 1 && DA_CORE != 1 )
   2
   3 !------------------------------------------------------------------
   4    SUBROUTINE feedback_domain_em_part1 ( grid, ngrid, config_flags    &
   5 !
   6 #include "dummy_new_args.inc"
   7 !
   8                  )
   9       USE module_state_description
  10       USE module_domain, ONLY : domain, get_ijk_from_grid
  11       USE module_configure, ONLY : grid_config_rec_type, model_config_rec, model_to_grid_config_rec
  12       USE module_dm, ONLY : ntasks, ntasks_x, ntasks_y, itrace, local_communicator, mytask, &
  13                             ipe_save, jpe_save, ips_save, jps_save,                         &
  14                             nest_pes_x, nest_pes_y
  15
  16       IMPLICIT NONE
  17 !
  18       TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
  19       TYPE(domain), POINTER :: ngrid
  20 #include "dummy_new_decl.inc"
  21       INTEGER nlev, msize
  22       INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k
  23       TYPE(domain), POINTER :: xgrid
  24       TYPE (grid_config_rec_type)            :: config_flags, nconfig_flags
  25       REAL xv(2000)
  26       INTEGER       ::          cids, cide, cjds, cjde, ckds, ckde,    &
  27                                 cims, cime, cjms, cjme, ckms, ckme,    &
  28                                 cips, cipe, cjps, cjpe, ckps, ckpe
  29       INTEGER       ::          nids, nide, njds, njde, nkds, nkde,    &
  30                                 nims, nime, njms, njme, nkms, nkme,    &
  31                                 nips, nipe, njps, njpe, nkps, nkpe
  32
  33       INTEGER idim1,idim2,idim3,idim4,idim5,idim6,idim7
  34
  35       INTEGER local_comm, myproc, nproc, idum1, idum2
  36       INTEGER thisdomain_max_halo_width
  37
  38 !cyl: add variables for trajectory
  39       integer tjk
  40
  41       INTERFACE
  42           SUBROUTINE feedback_nest_prep ( grid, config_flags    &
  43 !
  44 #include "dummy_new_args.inc"
  45 !
  46 )
  47              USE module_state_description
  48              USE module_domain, ONLY : domain
  49              USE module_configure, ONLY : grid_config_rec_type
  50 !
  51              TYPE (grid_config_rec_type)            :: config_flags
  52              TYPE(domain), TARGET                   :: grid
  53 #include "dummy_new_decl.inc"
  54           END SUBROUTINE feedback_nest_prep
  55       END INTERFACE
  56 !
  57
  58       CALL wrf_get_dm_communicator ( local_comm )
  59       CALL wrf_get_myproc( myproc )
  60       CALL wrf_get_nproc( nproc )
  61
  62 !
  63 ! intermediate grid
  64       CALL get_ijk_from_grid (  grid ,                                 &
  65                                 cids, cide, cjds, cjde, ckds, ckde,    &
  66                                 cims, cime, cjms, cjme, ckms, ckme,    &
  67                                 cips, cipe, cjps, cjpe, ckps, ckpe    )
  68 ! nest grid
  69       CALL get_ijk_from_grid (  ngrid ,                                &
  70                                 nids, nide, njds, njde, nkds, nkde,    &
  71                                 nims, nime, njms, njme, nkms, nkme,    &
  72                                 nips, nipe, njps, njpe, nkps, nkpe    )
  73
  74       nlev  = ckde - ckds + 1
  75
  76       ips_save = ngrid%i_parent_start   ! used in feedback_domain_em_part2 below
  77       jps_save = ngrid%j_parent_start
  78       ipe_save = ngrid%i_parent_start + (nide-nids+1) / ngrid%parent_grid_ratio - 1
  79       jpe_save = ngrid%j_parent_start + (njde-njds+1) / ngrid%parent_grid_ratio - 1
  80
  81 ! feedback_nest_prep invokes a halo exchange on the ngrid. It is done this way
  82 ! in a separate routine because the HALOs need the data to be dereference from the
  83 ! grid data structure and, in this routine, the dereferenced fields are related to
  84 ! the intermediate domain, not the nest itself. Save the current grid pointer to intermediate
  85 ! domain, switch grid to point to ngrid, invoke feedback_nest_prep,  then restore grid
  86 ! to point to intermediate domain.
  87
  88       CALL model_to_grid_config_rec ( ngrid%id , model_config_rec , nconfig_flags )
  89       CALL set_scalar_indices_from_config ( ngrid%id , idum1 , idum2 )
  90       xgrid => grid
  91       grid => ngrid
  92
  93       CALL feedback_nest_prep ( grid, nconfig_flags    &
  94 !
  95 #include "actual_new_args.inc"
  96 !
  97 )
  98
  99 ! put things back so grid is intermediate grid
 100
 101       grid => xgrid
 102       CALL set_scalar_indices_from_config ( grid%id , idum1 , idum2 )
 103
 104 ! "interp" (basically copy) ngrid onto intermediate grid
 105
 106 #include "nest_feedbackup_interp.inc"
 107
 108       RETURN
 109    END SUBROUTINE feedback_domain_em_part1
 110 #endif
 111