external/RSL_LITE/interp_domain_em_part2.F

   1 !------------------------------------------------------------------
   2
   3 #if ( EM_CORE == 1 && DA_CORE != 1 )
   4
   5 !------------------------------------------------------------------
   6
   7    SUBROUTINE interp_domain_em_part2 ( grid, ngrid, pgrid, config_flags    &
   8 !
   9 #include "dummy_new_args.inc"
  10 !
  11                  )
  12       USE module_state_description
  13       USE module_domain, ONLY : domain, get_ijk_from_grid
  14       USE module_configure, ONLY : grid_config_rec_type
  15       USE module_dm, ONLY : ntasks, ntasks_x, ntasks_y, itrace, local_communicator, &
  16                             mytask, get_dm_max_halo_width, which_kid
  17                             ! push_communicators_for_domain,pop_communicators_for_domain
  18       USE module_comm_nesting_dm, ONLY : halo_interp_down_sub
  19       IMPLICIT NONE
  20 !
  21       TYPE(domain), POINTER :: grid          ! name of the grid being dereferenced (must be "grid")
  22       TYPE(domain), POINTER :: ngrid
  23       TYPE(domain), POINTER :: pgrid         !KAL added for vertical nesting
  24 #include "dummy_new_decl.inc"
  25       INTEGER nlev, msize
  26       INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k
  27       TYPE (grid_config_rec_type)            :: config_flags
  28       REAL xv(2000)
  29       INTEGER       ::          cids, cide, cjds, cjde, ckds, ckde,    &
  30                                 cims, cime, cjms, cjme, ckms, ckme,    &
  31                                 cips, cipe, cjps, cjpe, ckps, ckpe
  32       INTEGER       ::          nids, nide, njds, njde, nkds, nkde,    &
  33                                 nims, nime, njms, njme, nkms, nkme,    &
  34                                 nips, nipe, njps, njpe, nkps, nkpe
  35       INTEGER       ::          ids, ide, jds, jde, kds, kde,    &
  36                                 ims, ime, jms, jme, kms, kme,    &
  37                                 ips, ipe, jps, jpe, kps, kpe
  38
  39       INTEGER idim1,idim2,idim3,idim4,idim5,idim6,idim7
  40
  41       INTEGER myproc
  42       INTEGER ierr
  43       INTEGER thisdomain_max_halo_width
  44
  45       !KAL variables for vertical nesting
  46       REAL :: p_top_m  , p_surf_m , mu_m , hsca_m , pre_c ,pre_n
  47       REAL, DIMENSION(pgrid%s_vert:pgrid%e_vert) :: alt_w_c
  48       REAL, DIMENSION(pgrid%s_vert:pgrid%e_vert+1) :: alt_u_c
  49       REAL, DIMENSION(ngrid%s_vert:ngrid%e_vert) :: alt_w_n
  50       REAL, DIMENSION(ngrid%s_vert:ngrid%e_vert+1) :: alt_u_n
  51
  52
  53       !KAL change this for vertical nesting
  54       ! interp_domain_em_part1 packs up the interpolation onto the coarse (vertical) grid
  55       ! therefore the message size is based on the coarse grid number of levels
  56       ! here it is unpacked onto the intermediate grid
  57        CALL get_ijk_from_grid ( pgrid ,                   &
  58                                 cids, cide, cjds, cjde, ckds, ckde,    &
  59                                 cims, cime, cjms, cjme, ckms, ckme,    &
  60                                 cips, cipe, cjps, cjpe, ckps, ckpe    )
  61       !KAL this is the original WRF code
  62       !CALL get_ijk_from_grid (  grid ,                   &
  63       !                          cids, cide, cjds, cjde, ckds, ckde,    &
  64       !                          cims, cime, cjms, cjme, ckms, ckme,    &
  65       !                          cips, cipe, cjps, cjpe, ckps, ckpe    )
  66       CALL get_ijk_from_grid (  ngrid ,              &
  67                                 nids, nide, njds, njde, nkds, nkde,    &
  68                                 nims, nime, njms, njme, nkms, nkme,    &
  69                                 nips, nipe, njps, njpe, nkps, nkpe    )
  70
  71       nlev  = ckde - ckds + 1
  72
  73       CALL get_dm_max_halo_width ( ngrid%id , thisdomain_max_halo_width )
  74
  75 #include "nest_interpdown_unpack.inc"
  76
  77
  78 if (ngrid%vert_refine_method .NE. 0) then
  79
  80       !KAL calculating the vertical coordinate for parent and nest grid (code from ndown)
  81       ! assume that the parent and nest have the same p_top value (as in ndown)
  82
  83 !KAL ckde is equal to e_vert of the coarse grid. There are e_vert-1 u points.  The coarse 1D grid here is e_vert+1,
  84 !    so it is the e_vert-1 points from the coarse grid, plus a surface point plus a top point.  Extrapolation coefficients
  85 !    are used to get the surface and top points to fill out the pro_u_c 1D array of u values from the coarse grid.
  86
  87       hsca_m = 6.7 !KAL scale height of the atmosphere
  88       p_top_m = ngrid%p_top
  89       p_surf_m = 1.e5
  90       mu_m = p_surf_m - p_top_m
  91 !    parent
  92       do  k = 1,ckde
  93       pre_c = mu_m * pgrid%c3f(k) + p_top_m + pgrid%c4f(k)
  94       alt_w_c(k) =  -hsca_m * alog(pre_c/p_surf_m)
  95       enddo
  96       do  k = 1,ckde-1
  97       pre_c = mu_m * pgrid%c3h(k) + p_top_m + pgrid%c4h(k)
  98       alt_u_c(k+1) =  -hsca_m * alog(pre_c/p_surf_m)
  99       enddo
 100       alt_u_c(1) =  alt_w_c(1)
 101       alt_u_c(ckde+1) =  alt_w_c(ckde)
 102 !    nest
 103       do  k = 1,nkde
 104       pre_n = mu_m * ngrid%c3f(k) + p_top_m + ngrid%c4f(k)
 105       alt_w_n(k) =  -hsca_m * alog(pre_n/p_surf_m)
 106       enddo
 107       do  k = 1,nkde-1
 108       pre_n = mu_m * ngrid%c3h(k) + p_top_m + ngrid%c4h(k)
 109       alt_u_n(k+1) =  -hsca_m * alog(pre_n/p_surf_m)
 110       enddo
 111       alt_u_n(1) =  alt_w_n(1)
 112       alt_u_n(nkde+1) =  alt_w_n(nkde)
 113 endif
 114
 115
 116
 117       !KAL added this call for vertical nesting (return coarse grid dimensions to intended values)
 118       CALL get_ijk_from_grid (  grid ,                   &
 119                                 cids, cide, cjds, cjde, ckds, ckde,    &
 120                                 cims, cime, cjms, cjme, ckms, ckme,    &
 121                                 cips, cipe, cjps, cjpe, ckps, ckpe    )
 122
 123       CALL get_ijk_from_grid (  grid ,              &
 124                                 ids, ide, jds, jde, kds, kde,    &
 125                                 ims, ime, jms, jme, kms, kme,    &
 126                                 ips, ipe, jps, jpe, kps, kpe    )
 127
 128
 129 if (ngrid%vert_refine_method .NE. 0) then
 130
 131 !KAL added this code (the include file) for the vertical nesting
 132 #include "nest_interpdown_interp_vert.inc"
 133
 134
 135       !KAL finish off the 1-D variables (t_base, u_base, v_base, qv_base, and z_base) (move this out of here if alt_u_c and alt_u_n are calculated elsewhere)
 136       CALL vert_interp_vert_nesting_1d ( &
 137                                         ngrid%t_base,                                           &    ! CD field
 138                                         ids, ide, kds, kde, jds, jde,                           &    ! CD dims
 139                                         ims, ime, kms, kme, jms, jme,                           &    ! CD dims
 140                                         ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe,           &    ! CD dims
 141                                         pgrid%s_vert, pgrid%e_vert,                             &    ! vertical dimension of the parent grid
 142                                         pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, &    ! coarse grid extrapolation constants
 143                                         alt_u_c, alt_u_n)                                            ! coordinates for parent and nest
 144       CALL vert_interp_vert_nesting_1d ( &
 145                                         ngrid%u_base,                                           &    ! CD field
 146                                         ids, ide, kds, kde, jds, jde,                           &    ! CD dims
 147                                         ims, ime, kms, kme, jms, jme,                           &    ! CD dims
 148                                         ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe,           &    ! CD dims
 149                                         pgrid%s_vert, pgrid%e_vert,                             &    ! vertical dimension of the parent grid
 150                                         pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, &    ! coarse grid extrapolation constants
 151                                         alt_u_c, alt_u_n)                                            ! coordinates for parent and nest
 152       CALL vert_interp_vert_nesting_1d ( &
 153                                         ngrid%v_base,                                           &    ! CD field
 154                                         ids, ide, kds, kde, jds, jde,                           &    ! CD dims
 155                                         ims, ime, kms, kme, jms, jme,                           &    ! CD dims
 156                                         ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe,           &    ! CD dims
 157                                         pgrid%s_vert, pgrid%e_vert,                             &    ! vertical dimension of the parent grid
 158                                         pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, &    ! coarse grid extrapolation constants
 159                                         alt_u_c, alt_u_n)                                            ! coordinates for parent and nest
 160       CALL vert_interp_vert_nesting_1d ( &
 161                                         ngrid%qv_base,                                          &    ! CD field
 162                                         ids, ide, kds, kde, jds, jde,                           &    ! CD dims
 163                                         ims, ime, kms, kme, jms, jme,                           &    ! CD dims
 164                                         ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe,           &    ! CD dims
 165                                         pgrid%s_vert, pgrid%e_vert,                             &    ! vertical dimension of the parent grid
 166                                         pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, &    ! coarse grid extrapolation constants
 167                                         alt_u_c, alt_u_n)                                            ! coordinates for parent and nest
 168       CALL vert_interp_vert_nesting_1d ( &
 169                                         ngrid%z_base,                                           &    ! CD field
 170                                         ids, ide, kds, kde, jds, jde,                           &    ! CD dims
 171                                         ims, ime, kms, kme, jms, jme,                           &    ! CD dims
 172                                         ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe,           &    ! CD dims
 173                                         pgrid%s_vert, pgrid%e_vert,                             &    ! vertical dimension of the parent grid
 174                                         pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, &    ! coarse grid extrapolation constants
 175                                         alt_u_c, alt_u_n)                                            ! coordinates for parent and nest
 176
 177 endif
 178
 179         CALL push_communicators_for_domain( grid%id )
 180
 181 #include "HALO_INTERP_DOWN.inc"
 182
 183         CALL pop_communicators_for_domain
 184
 185       RETURN
 186    END SUBROUTINE interp_domain_em_part2
 187 #endif