scale_atmos_grid_cartesC_metric.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "scalelib.h"
module scale_atmos_grid_cartesc_metric
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_io
  use scale_prof
  use scale_atmos_grid_cartesc_index
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: atmos_grid_cartesc_metric_setup
 
  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  real(rp), public, allocatable :: atmos_grid_cartesc_metric_mapf (:,:,:,:)
  real(rp), public, allocatable :: atmos_grid_cartesc_metric_rotc (:,:,:)
 
  real(rp), public, allocatable :: atmos_grid_cartesc_metric_gsqrt(:,:,:,:)
  real(rp), public, allocatable :: atmos_grid_cartesc_metric_j13g (:,:,:,:)
  real(rp), public, allocatable :: atmos_grid_cartesc_metric_j23g (:,:,:,:)
  real(rp), public              :: atmos_grid_cartesc_metric_j33g
 
  real(rp), public, allocatable :: atmos_grid_cartesc_metric_limyz(:,:,:,:)
  real(rp), public, allocatable :: atmos_grid_cartesc_metric_limxz(:,:,:,:)
  real(rp), public, allocatable :: atmos_grid_cartesc_metric_limxy(:,:,:,:)
 
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  private :: atmos_grid_cartesc_metric_mapfactor
  private :: atmos_grid_cartesc_metric_terrainfollowing
  private :: atmos_grid_cartesc_metric_thin_wall
  private :: atmos_grid_cartesc_metric_step_mountain
  private :: atmos_grid_cartesc_metric_write
 
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  character(len=H_LONG),  private :: atmos_grid_cartesc_metric_out_basename  = ''
  character(len=H_MID),   private :: atmos_grid_cartesc_metric_out_title     = 'SCALE-RM GEOMETRICS'
  character(len=H_SHORT), private :: atmos_grid_cartesc_metric_out_dtype     = 'DEFAULT'
 
  character(len=H_SHORT), private :: atmos_grid_cartesc_metric_topo_type     = 'TERRAINFOLLOWING'
  integer,                private :: atmos_grid_cartesc_metric_thinwall_xdiv = 50
  integer,                private :: atmos_grid_cartesc_metric_thinwall_ydiv = 50
  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine atmos_grid_cartesc_metric_setup
    use scale_prc, only: &
       prc_abort
    use scale_prc_cartesc, only: &
       prc_twod
    implicit none
 
    namelist / param_atmos_grid_cartesc_metric / &
       atmos_grid_cartesc_metric_out_basename,  &
       atmos_grid_cartesc_metric_out_dtype,     &
       atmos_grid_cartesc_metric_topo_type,     &
       atmos_grid_cartesc_metric_thinwall_xdiv, &
       atmos_grid_cartesc_metric_thinwall_ydiv
 
    integer :: ierr
    !---------------------------------------------------------------------------
 
    log_newline
    log_info("ATMOS_GRID_CARTESC_METRIC_setup",*) 'Setup'
 
    !--- read namelist
    rewind(io_fid_conf)
    read(io_fid_conf,nml=param_atmos_grid_cartesc_metric,iostat=ierr)
    if( ierr < 0 ) then !--- missing
       log_info("ATMOS_GRID_CARTESC_METRIC_setup",*) 'Not found namelist. Default used.'
    elseif( ierr > 0 ) then !--- fatal error
       log_error("ATMOS_GRID_CARTESC_METRIC_setup",*) 'Not appropriate names in namelist PARAM_ATMOS_GRID_CARTESC_METRIC. Check!'
       call prc_abort
    endif
    log_nml(param_atmos_grid_cartesc_metric)
 
    allocate( atmos_grid_cartesc_metric_mapf(ia,ja,2,4) )
 
    allocate( atmos_grid_cartesc_metric_rotc(ia,ja,2) )
 
    if ( prc_twod ) then
       allocate( atmos_grid_cartesc_metric_gsqrt(ka,ia,ja,4) )
       allocate( atmos_grid_cartesc_metric_j13g(ka,ia,ja,4) )
       allocate( atmos_grid_cartesc_metric_j23g(ka,ia,ja,4) )
    else
       allocate( atmos_grid_cartesc_metric_gsqrt(ka,ia,ja,7) )
       allocate( atmos_grid_cartesc_metric_j13g(ka,ia,ja,7) )
       allocate( atmos_grid_cartesc_metric_j23g(ka,ia,ja,7) )
    end if
 
    atmos_grid_cartesc_metric_gsqrt(:,:,:,:) = 1.0_rp
    atmos_grid_cartesc_metric_j13g(:,:,:,:) = 0.0_rp
    atmos_grid_cartesc_metric_j23g(:,:,:,:) = 0.0_rp
    atmos_grid_cartesc_metric_j33g = 1.0_rp
 
    allocate( atmos_grid_cartesc_metric_limyz(ka,ia,ja,7) )
    allocate( atmos_grid_cartesc_metric_limxz(ka,ia,ja,7) )
    allocate( atmos_grid_cartesc_metric_limxy(ka,ia,ja,7) )
    atmos_grid_cartesc_metric_limyz(:,:,:,:) = 1.0_rp
    atmos_grid_cartesc_metric_limxz(:,:,:,:) = 1.0_rp
    atmos_grid_cartesc_metric_limxy(:,:,:,:) = 1.0_rp
 
    ! calc metrics for orthogonal curvelinear coordinate
    call atmos_grid_cartesc_metric_mapfactor
 
    ! calc coeficient for rotaion of velocity vector
    call atmos_grid_cartesc_metric_rotcoef
 
    ! calc metrics for terrain-following,step-mountain,thin-wall coordinate
    log_newline
    log_info("ATMOS_GRID_CARTESC_METRIC_setup",*) 'Terrain coordinate type : ', trim(atmos_grid_cartesc_metric_topo_type)
    select case(atmos_grid_cartesc_metric_topo_type)
    case('TERRAINFOLLOWING')
      log_info_cont(*) '=> Terrain-following method'
      call atmos_grid_cartesc_metric_terrainfollowing
    case('STEPMOUNTAIN')
      log_info_cont(*) '=> Step-mountain method'
      call atmos_grid_cartesc_metric_thin_wall
      call atmos_grid_cartesc_metric_step_mountain
    case('THINWALL')
      log_info_cont(*) '=> Thin-wall approximation method'
      call atmos_grid_cartesc_metric_thin_wall
    case default
       log_error("ATMOS_GRID_CARTESC_METRIC_setup",*) 'Unsupported ATMOS_GRID_CARTESC_METRIC_TOPO_type. STOP'
       call prc_abort
    end select
 
    ! output metrics (for debug)
    call atmos_grid_cartesc_metric_write
 
    return
  end subroutine atmos_grid_cartesc_metric_setup
 
  !-----------------------------------------------------------------------------
  subroutine atmos_grid_cartesc_metric_mapfactor
    use scale_prc_cartesc, only: &
       prc_twod
    use scale_mapprojection, only: &
       mapprojection_mapfactor
    use scale_atmos_grid_cartesc, only: &
       atmos_grid_cartesc_rcdx, &
       atmos_grid_cartesc_rcdy
    use scale_atmos_grid_cartesc_real, only: &
       atmos_grid_cartesc_real_lat,          &
       atmos_grid_cartesc_real_latuy,        &
       atmos_grid_cartesc_real_latxv,        &
       atmos_grid_cartesc_real_latuv
    use scale_topography, only: &
       topography_calc_tan_slope
    implicit none
    !---------------------------------------------------------------------------
 
    call mapprojection_mapfactor( ia, 1, ia, ja, 1, ja,   &
         atmos_grid_cartesc_real_lat( :, :), atmos_grid_cartesc_metric_mapf(:,:,1,i_xy), atmos_grid_cartesc_metric_mapf(:,:,2,i_xy))
    call mapprojection_mapfactor( ia, 1, ia, ja, 1, ja, &
         atmos_grid_cartesc_real_latxv( :,1:), atmos_grid_cartesc_metric_mapf(:,:,1,i_xv), atmos_grid_cartesc_metric_mapf(:,:,2,i_xv))
    if ( .not. prc_twod ) then
    call mapprojection_mapfactor( ia, 1, ia, ja, 1, ja,   &
         atmos_grid_cartesc_real_latuy(1:, :), atmos_grid_cartesc_metric_mapf(:,:,1,i_uy), atmos_grid_cartesc_metric_mapf(:,:,2,i_uy))
    call mapprojection_mapfactor( ia, 1, ia, ja, 1, ja, &
         atmos_grid_cartesc_real_latuv(1:,1:), atmos_grid_cartesc_metric_mapf(:,:,1,i_uv), atmos_grid_cartesc_metric_mapf(:,:,2,i_uv))
    end if
 
    call topography_calc_tan_slope( ia, is, ie, ja, js, je, &
         atmos_grid_cartesc_rcdx(:), atmos_grid_cartesc_rcdy(:), &
         atmos_grid_cartesc_metric_mapf(:,:,:,i_xy) )
 
    return
  end subroutine atmos_grid_cartesc_metric_mapfactor
 
  !-----------------------------------------------------------------------------
  subroutine atmos_grid_cartesc_metric_rotcoef
    use scale_mapprojection, only: &
       mapprojection_rotcoef
    use scale_atmos_grid_cartesc_real, only: &
       atmos_grid_cartesc_real_lon,  &
       atmos_grid_cartesc_real_lat
    implicit none
    !---------------------------------------------------------------------------
 
    call mapprojection_rotcoef( ia, 1, ia, ja, 1, ja, &
         atmos_grid_cartesc_real_lon(:,:),   & ! [IN]
         atmos_grid_cartesc_real_lat(:,:),   & ! [IN]
         atmos_grid_cartesc_metric_rotc(:,:,1), & ! [OUT]
         atmos_grid_cartesc_metric_rotc(:,:,2)  ) ! [OUT]
 
    return
  end subroutine atmos_grid_cartesc_metric_rotcoef
 
  !-----------------------------------------------------------------------------
  subroutine atmos_grid_cartesc_metric_terrainfollowing
    use scale_prc_cartesc, only: &
       prc_twod
    use scale_atmos_grid_cartesc, only: &
       atmos_grid_cartesc_rcdz, &
       atmos_grid_cartesc_rcdx, &
       atmos_grid_cartesc_rcdy, &
       atmos_grid_cartesc_rfdz, &
       atmos_grid_cartesc_rfdx, &
       atmos_grid_cartesc_rfdy
    use scale_atmos_grid_cartesc_real, only: &
       atmos_grid_cartesc_real_cz,   &
       atmos_grid_cartesc_real_czuy, &
       atmos_grid_cartesc_real_czxv, &
       atmos_grid_cartesc_real_czuv, &
       atmos_grid_cartesc_real_fz,   &
       atmos_grid_cartesc_real_fzuy, &
       atmos_grid_cartesc_real_fzxv, &
       atmos_grid_cartesc_real_fzuv
    use scale_comm_cartesc, only: &
       comm_vars8, &
       comm_wait
    implicit none
 
    integer :: k, i, j
    integer :: i_start, i_end
    !---------------------------------------------------------------------------
 
    ! G^1/2
    !$omp parallel do
    do j = 1, ja
    do i = 1, ia
       ! at (x,y,z)
       do k = 1, ka
          atmos_grid_cartesc_metric_gsqrt(k,i,j,i_xyz) = ( atmos_grid_cartesc_real_fz(k,i,j) - atmos_grid_cartesc_real_fz(k-1,i,j) ) * atmos_grid_cartesc_rcdz(k)
       enddo
 
       ! at (x,y,w)
       do k = 1, ka-1
          atmos_grid_cartesc_metric_gsqrt(k,i,j,i_xyw) = ( atmos_grid_cartesc_real_cz(k+1,i,j) - atmos_grid_cartesc_real_cz(k,i,j) ) * atmos_grid_cartesc_rfdz(k)
       enddo
       atmos_grid_cartesc_metric_gsqrt(ka,i,j,i_xyw) = atmos_grid_cartesc_metric_gsqrt(ka-1,i,j,i_xyw)
 
       ! at (x,v,w)
       do k = 1, ka-1
          atmos_grid_cartesc_metric_gsqrt(k,i,j,i_xvw) = ( atmos_grid_cartesc_real_czxv(k+1,i,j) - atmos_grid_cartesc_real_czxv(k,i,j) ) * atmos_grid_cartesc_rfdz(k)
       enddo
       atmos_grid_cartesc_metric_gsqrt(ka,i,j,i_xvw) = atmos_grid_cartesc_metric_gsqrt(ka-1,i,j,i_xvw)
 
       ! at (x,v,z)
       do k = 1, ka
          atmos_grid_cartesc_metric_gsqrt(k,i,j,i_xvz) = ( atmos_grid_cartesc_real_fzxv(k,i,j) - atmos_grid_cartesc_real_fzxv(k-1,i,j) ) * atmos_grid_cartesc_rcdz(k)
       enddo
    enddo
    enddo
    if ( .not. prc_twod ) then
    !$omp parallel do
    do j = 1, ja
    do i = 1, ia
       ! at (u,y,w)
       do k = 1, ka-1
          atmos_grid_cartesc_metric_gsqrt(k,i,j,i_uyw) = ( atmos_grid_cartesc_real_czuy(k+1,i,j) - atmos_grid_cartesc_real_czuy(k,i,j) ) * atmos_grid_cartesc_rfdz(k)
       enddo
       atmos_grid_cartesc_metric_gsqrt(ka,i,j,i_uyw) = atmos_grid_cartesc_metric_gsqrt(ka-1,i,j,i_uyw)
 
       ! at (u,y,z)
       do k = 1, ka
          atmos_grid_cartesc_metric_gsqrt(k,i,j,i_uyz) = ( atmos_grid_cartesc_real_fzuy(k,i,j) - atmos_grid_cartesc_real_fzuy(k-1,i,j) ) * atmos_grid_cartesc_rcdz(k)
       enddo
 
       ! at (u,v,z)
       do k = 1, ka
          atmos_grid_cartesc_metric_gsqrt(k,i,j,i_uvz) = ( atmos_grid_cartesc_real_fzuv(k,i,j) - atmos_grid_cartesc_real_fzuv(k-1,i,j) ) * atmos_grid_cartesc_rcdz(k)
       enddo
    enddo
    enddo
    end if
 
    ! Jacobian * G^1/2
    if ( .not. prc_twod ) then
    !$omp parallel do
    do j = 1, ja
    do i = 2, ia
    do k = 1, ka
       atmos_grid_cartesc_metric_j13g(k,i,j,i_xyz) = -( atmos_grid_cartesc_real_czuy(k,i,j) - atmos_grid_cartesc_real_czuy(k,i-1,j) ) * atmos_grid_cartesc_rcdx(i)
       atmos_grid_cartesc_metric_j13g(k,i,j,i_xyw) = -( atmos_grid_cartesc_real_fzuy(k,i,j) - atmos_grid_cartesc_real_fzuy(k,i-1,j) ) * atmos_grid_cartesc_rcdx(i)
       atmos_grid_cartesc_metric_j13g(k,i,j,i_xvw) = -( atmos_grid_cartesc_real_fzuv(k,i,j) - atmos_grid_cartesc_real_fzuv(k,i-1,j) ) * atmos_grid_cartesc_rcdx(i)
       atmos_grid_cartesc_metric_j13g(k,i,j,i_xvz) = -( atmos_grid_cartesc_real_czuv(k,i,j) - atmos_grid_cartesc_real_czuv(k,i-1,j) ) * atmos_grid_cartesc_rcdx(i)
    enddo
    enddo
    enddo
    !$omp parallel do
    do j = 1, ja
    do i = 1, ia-1
    do k = 1, ka
       atmos_grid_cartesc_metric_j13g(k,i,j,i_uyw) = -( atmos_grid_cartesc_real_fz(k,i+1,j) - atmos_grid_cartesc_real_fz(k,i,j) ) * atmos_grid_cartesc_rfdx(i)
       atmos_grid_cartesc_metric_j13g(k,i,j,i_uyz) = -( atmos_grid_cartesc_real_cz(k,i+1,j) - atmos_grid_cartesc_real_cz(k,i,j) ) * atmos_grid_cartesc_rfdx(i)
       atmos_grid_cartesc_metric_j13g(k,i,j,i_uvz) = -( atmos_grid_cartesc_real_czxv(k,i+1,j) - atmos_grid_cartesc_real_czxv(k,i,j) ) * atmos_grid_cartesc_rfdx(i)
    enddo
    enddo
    enddo
    end if
 
    !$omp parallel do
    do j = 2, ja-1
    do i = 1, ia
    do k = 1, ka
       atmos_grid_cartesc_metric_j23g(k,i,j,i_xyz) = -( atmos_grid_cartesc_real_czxv(k,i,j  ) - atmos_grid_cartesc_real_czxv(k,i,j-1) ) * atmos_grid_cartesc_rcdy(j)
       atmos_grid_cartesc_metric_j23g(k,i,j,i_xyw) = -( atmos_grid_cartesc_real_fzxv(k,i,j  ) - atmos_grid_cartesc_real_fzxv(k,i,j-1) ) * atmos_grid_cartesc_rcdy(j)
       atmos_grid_cartesc_metric_j23g(k,i,j,i_xvw) = -( atmos_grid_cartesc_real_fz(k,i,j+1) - atmos_grid_cartesc_real_fz(k,i,j  ) ) * atmos_grid_cartesc_rfdy(j)
       atmos_grid_cartesc_metric_j23g(k,i,j,i_xvz) = -( atmos_grid_cartesc_real_cz(k,i,j+1) - atmos_grid_cartesc_real_cz(k,i,j  ) ) * atmos_grid_cartesc_rfdy(j)
    enddo
    enddo
    enddo
    if ( .not. prc_twod ) then
    !$omp parallel do
    do j = 2, ja-1
    do i = 1, ia
    do k = 1, ka
       atmos_grid_cartesc_metric_j23g(k,i,j,i_uyw) = -( atmos_grid_cartesc_real_fzuv(k,i,j  ) - atmos_grid_cartesc_real_fzuv(k,i,j-1) ) * atmos_grid_cartesc_rcdy(j)
       atmos_grid_cartesc_metric_j23g(k,i,j,i_uyz) = -( atmos_grid_cartesc_real_czuv(k,i,j  ) - atmos_grid_cartesc_real_czuv(k,i,j-1) ) * atmos_grid_cartesc_rcdy(j)
       atmos_grid_cartesc_metric_j23g(k,i,j,i_uvz) = -( atmos_grid_cartesc_real_czuy(k,i,j+1) - atmos_grid_cartesc_real_czuy(k,i,j  ) ) * atmos_grid_cartesc_rfdy(j)
    enddo
    enddo
    enddo
    end if
 
    atmos_grid_cartesc_metric_j33g = 1.0_rp ! - 1 / G^1/2 * G^1/2
 
    if ( .not. prc_twod ) then
    call comm_vars8( atmos_grid_cartesc_metric_j13g(:,:,:,i_xyz),  8 )
    call comm_vars8( atmos_grid_cartesc_metric_j13g(:,:,:,i_xyw),  9 )
    call comm_vars8( atmos_grid_cartesc_metric_j13g(:,:,:,i_xvw), 10 )
    call comm_vars8( atmos_grid_cartesc_metric_j13g(:,:,:,i_xvz), 11 )
    call comm_vars8( atmos_grid_cartesc_metric_j13g(:,:,:,i_uyw), 12 )
    call comm_vars8( atmos_grid_cartesc_metric_j13g(:,:,:,i_uyz), 13 )
    call comm_vars8( atmos_grid_cartesc_metric_j13g(:,:,:,i_uvz), 14 )
    call comm_wait ( atmos_grid_cartesc_metric_j13g(:,:,:,i_xyz),  8, .false. )
    call comm_wait ( atmos_grid_cartesc_metric_j13g(:,:,:,i_xyw),  9, .false. )
    call comm_wait ( atmos_grid_cartesc_metric_j13g(:,:,:,i_xvw), 10, .false. )
    call comm_wait ( atmos_grid_cartesc_metric_j13g(:,:,:,i_xvz), 11, .false. )
    call comm_wait ( atmos_grid_cartesc_metric_j13g(:,:,:,i_uyw), 12, .false. )
    call comm_wait ( atmos_grid_cartesc_metric_j13g(:,:,:,i_uyz), 13, .false. )
    call comm_wait ( atmos_grid_cartesc_metric_j13g(:,:,:,i_uvz), 14, .false. )
    end if
 
    call comm_vars8( atmos_grid_cartesc_metric_j23g(:,:,:,i_xyz), 15 )
    call comm_vars8( atmos_grid_cartesc_metric_j23g(:,:,:,i_xyw), 16 )
    call comm_vars8( atmos_grid_cartesc_metric_j23g(:,:,:,i_xvw), 17 )
    call comm_vars8( atmos_grid_cartesc_metric_j23g(:,:,:,i_xvz), 18 )
    if ( .not. prc_twod ) then
    call comm_vars8( atmos_grid_cartesc_metric_j23g(:,:,:,i_uyw), 19 )
    call comm_vars8( atmos_grid_cartesc_metric_j23g(:,:,:,i_uyz), 20 )
    call comm_vars8( atmos_grid_cartesc_metric_j23g(:,:,:,i_uvz), 21 )
    end if
    call comm_wait ( atmos_grid_cartesc_metric_j23g(:,:,:,i_xyz), 15, .false. )
    call comm_wait ( atmos_grid_cartesc_metric_j23g(:,:,:,i_xyw), 16, .false. )
    call comm_wait ( atmos_grid_cartesc_metric_j23g(:,:,:,i_xvw), 17, .false. )
    call comm_wait ( atmos_grid_cartesc_metric_j23g(:,:,:,i_xvz), 18, .false. )
    if ( .not. prc_twod ) then
    call comm_wait ( atmos_grid_cartesc_metric_j23g(:,:,:,i_uyw), 19, .false. )
    call comm_wait ( atmos_grid_cartesc_metric_j23g(:,:,:,i_uyz), 20, .false. )
    call comm_wait ( atmos_grid_cartesc_metric_j23g(:,:,:,i_uvz), 21, .false. )
    endif
 
    return
  end subroutine atmos_grid_cartesc_metric_terrainfollowing
 
  !-----------------------------------------------------------------------------
  subroutine atmos_grid_cartesc_metric_thin_wall
    use scale_prc, only: &
       prc_abort
    use scale_atmos_grid_cartesc, only: &
       atmos_grid_cartesc_cz, &
       atmos_grid_cartesc_cx, &
       atmos_grid_cartesc_cy, &
       atmos_grid_cartesc_fz, &
       atmos_grid_cartesc_fx, &
       atmos_grid_cartesc_fy
    use scale_topography, only : &
       topography_zsfc
    use scale_comm_cartesc, only : &
       comm_vars8, &
       comm_wait
    implicit none
 
    real(RP) :: TOPO_ZsfcALL(2*IA,2*JA)
    real(RP) :: TOPO_ZsfcXY (IA,JA)
    real(RP) :: TOPO_ZsfcUY (IA,JA)
    real(RP) :: TOPO_ZsfcXV (IA,JA)
    real(RP) :: TOPO_ZsfcUV (IA,JA)
 
    real(RP) :: ATMOS_GRID_CARTESC_METRIC_QLIM (2*KA,2*IA,2*JA,3)
    real(RP) :: QDZ(2*KA)
    real(RP) :: QDX(2*IA)
    real(RP) :: QDY(2*JA)
    real(RP) :: AQAF (3)
    real(RP) :: XSLOPE, YSLOPE
    real(RP) :: Ztop
    real(RP) :: DX_piece, DY_piece
    real(RP) :: DX, DY, DZ
 
    integer  :: I_QLIMtoLIM(3,7)
 
    integer  :: iii, jjj, n
    integer  :: k, i, j, kk, ii, jj
    !---------------------------------------------------------------------------
 
    ! calc absolute height at staggered position
    ! at (x,y)
    do j = 1, ja
    do i = 1, ia
      topo_zsfcxy(i,j) = topography_zsfc(i,j)
    enddo
    enddo
    ! at (u,y)
    do j = 1, ja
    do i = 1, ia-1
      topo_zsfcuy(i,j) = 0.5_rp * ( topography_zsfc(i,j) + topography_zsfc(i+1,j) )
    enddo
    enddo
    ! at (x,v)
    do j = 1, ja-1
    do i = 1, ia
      topo_zsfcxv(i,j) = 0.5_rp * ( topography_zsfc(i,j) + topography_zsfc(i,j+1) )
    enddo
    enddo
    ! at (u,v)
    do j = 1, ja-1
    do i = 1, ia-1
      topo_zsfcuv(i,j) = 0.25_rp * ( topography_zsfc(i  ,j  ) + topography_zsfc(i  ,j+1) &
                                   + topography_zsfc(i  ,j+1) + topography_zsfc(i+1,j+1) )
    enddo
    enddo
 
    ! reset topography
    topography_zsfc(:,:) = 0.d0
 
    call comm_vars8( topo_zsfcxy(:,:), 1 )
    call comm_vars8( topo_zsfcuy(:,:), 2 )
    call comm_vars8( topo_zsfcxv(:,:), 3 )
    call comm_vars8( topo_zsfcuv(:,:), 4 )
    call comm_wait ( topo_zsfcxy(:,:), 1 )
    call comm_wait ( topo_zsfcuy(:,:), 2 )
    call comm_wait ( topo_zsfcxv(:,:), 3 )
    call comm_wait ( topo_zsfcuv(:,:), 4 )
 
    ! all height
    do j = 1, ja
    do i = 1, ia
       ii = (i-1) * 2 + 1
       jj = (j-1) * 2 + 1
 
       topo_zsfcall(ii  ,jj  ) = topo_zsfcxy(i,j)
       topo_zsfcall(ii+1,jj  ) = topo_zsfcuy(i,j)
       topo_zsfcall(ii  ,jj+1) = topo_zsfcxv(i,j)
       topo_zsfcall(ii+1,jj+1) = topo_zsfcuv(i,j)
    enddo
    enddo
 
    ! length of control volume of quarter cell
    do k = 1, ka
       kk = (k-1) * 2 + 1
 
       qdz(kk  ) = atmos_grid_cartesc_cz(k) - atmos_grid_cartesc_fz(k-1)
       qdz(kk+1) = atmos_grid_cartesc_fz(k) - atmos_grid_cartesc_cz(k  )
    enddo
 
    do i = 1, ia-1
       ii = (i-1) * 2 + 1
 
       qdx(ii  ) = atmos_grid_cartesc_fx(i  ) - atmos_grid_cartesc_cx(i)
       qdx(ii+1) = atmos_grid_cartesc_cx(i+1) - atmos_grid_cartesc_fx(i)
    enddo
 
    do j = 1, ja-1
       jj = (j-1) * 2 + 1
 
       qdy(jj  ) = atmos_grid_cartesc_fy(j  ) - atmos_grid_cartesc_cy(j)
       qdy(jj+1) = atmos_grid_cartesc_cy(j+1) - atmos_grid_cartesc_fy(j)
    enddo
 
    ! quarter flux limiter
    do jj = 1, 2*(ja-1)
    do ii = 1, 2*(ia-1)
    do kk = ks, 2*ke
       dx_piece = qdx(ii) / real(atmos_grid_cartesc_metric_thinwall_xdiv,kind=rp)
       dy_piece = qdy(jj) / real(atmos_grid_cartesc_metric_thinwall_ydiv,kind=rp)
 
       aqaf(1:3) = 0.0_rp
       ztop = sum(qdz(ks:kk))
 
       !--- y-z face ---
       yslope = ( topo_zsfcall(ii,jj+1) - topo_zsfcall(ii,jj) ) / qdy(jj)
 
       do jjj = 1, atmos_grid_cartesc_metric_thinwall_ydiv
          dy = ( real(jjj,kind=rp) - 0.5_rp ) * dy_piece
          dz = ztop - topo_zsfcall(ii,jj) - yslope * dy
 
          if ( dz > 0.0_rp ) then
             if ( dz < qdz(kk) ) then
                aqaf(i_fyz) = aqaf(i_fyz) + dz      * dy_piece
             else
                aqaf(i_fyz) = aqaf(i_fyz) + qdz(kk) * dy_piece
             endif
          endif
       enddo
 
       !--- x-z face ---
       xslope = ( topo_zsfcall(ii+1,jj) - topo_zsfcall(ii,jj) ) / qdx(ii)
 
       do iii = 1, atmos_grid_cartesc_metric_thinwall_xdiv
          dx = ( real(iii,kind=rp) - 0.5_rp ) * dx_piece
          dz = ztop - topo_zsfcall(ii,jj) + xslope * dx
 
          if ( dz > 0.0_rp ) then
             if ( dz < qdz(kk) ) then
                aqaf(i_fxz) = aqaf(i_fxz) + dz      * dx_piece
             else
                aqaf(i_fxz) = aqaf(i_fxz) + qdz(kk) * dx_piece
             endif
          endif
       enddo
 
       !--- x-y face ---
       do jjj = 1, atmos_grid_cartesc_metric_thinwall_ydiv
       do iii = 1, atmos_grid_cartesc_metric_thinwall_xdiv
          dx = ( real(iii,kind=rp) - 0.5_rp ) * dx_piece
          dy = ( real(jjj,kind=rp) - 0.5_rp ) * dy_piece
          dz = ztop - topo_zsfcall(ii,jj) - xslope * dx - yslope * dy
 
          if ( dz > 0.0_rp ) then
             aqaf(i_fxy) = aqaf(i_fxy) + dx_piece * dy_piece
          endif
       enddo
       enddo
 
       atmos_grid_cartesc_metric_qlim(kk,ii,jj,i_fyz) = aqaf(i_fyz) / ( qdy(jj) * qdz(kk) )
       atmos_grid_cartesc_metric_qlim(kk,ii,jj,i_fxz) = aqaf(i_fxz) / ( qdx(ii) * qdz(kk) )
       atmos_grid_cartesc_metric_qlim(kk,ii,jj,i_fxy) = aqaf(i_fxy) / ( qdy(jj) * qdx(ii) )
    enddo
    enddo
    enddo
 
    ! index i,j,k
    i_qlimtolim(1:3,i_xyz) = (/ 1, 1, 1 /)
    i_qlimtolim(1:3,i_xyw) = (/ 1, 1, 0 /)
    i_qlimtolim(1:3,i_uyw) = (/ 0, 1, 0 /)
    i_qlimtolim(1:3,i_xvw) = (/ 1, 0, 0 /)
    i_qlimtolim(1:3,i_uyz) = (/ 0, 1, 1 /)
    i_qlimtolim(1:3,i_xvz) = (/ 1, 0, 1 /)
    i_qlimtolim(1:3,i_uvz) = (/ 0, 0, 1 /)
 
    do n = 1, 7
       do j = js, je
       do i = is, ie
       do k = ks, ke
          ii = (i-1) * 2 + 1 - i_qlimtolim(1,n)
          jj = (j-1) * 2 + 1 - i_qlimtolim(2,n)
          kk = (k-1) * 2 + 1 - i_qlimtolim(3,n)
 
         atmos_grid_cartesc_metric_limyz(k,i,j,n) = 0.25_rp * ( atmos_grid_cartesc_metric_qlim(kk  ,ii,jj,i_fyz) + atmos_grid_cartesc_metric_qlim(kk  ,ii  ,jj+1,i_fyz) &
                                           + atmos_grid_cartesc_metric_qlim(kk+1,ii,jj,i_fyz) + atmos_grid_cartesc_metric_qlim(kk+1,ii  ,jj+1,i_fyz) )
         atmos_grid_cartesc_metric_limxz(k,i,j,n) = 0.25_rp * ( atmos_grid_cartesc_metric_qlim(kk  ,ii,jj,i_fxz) + atmos_grid_cartesc_metric_qlim(kk  ,ii+1,jj  ,i_fxz) &
                                           + atmos_grid_cartesc_metric_qlim(kk+1,ii,jj,i_fxz) + atmos_grid_cartesc_metric_qlim(kk+1,ii+1,jj  ,i_fxz) )
         atmos_grid_cartesc_metric_limxy(k,i,j,n) = 0.25_rp * ( atmos_grid_cartesc_metric_qlim(kk  ,ii,jj,i_fxy) + atmos_grid_cartesc_metric_qlim(kk  ,ii+1,jj+1,i_fxy) &
                                           + atmos_grid_cartesc_metric_qlim(kk  ,ii,jj,i_fxy) + atmos_grid_cartesc_metric_qlim(kk  ,ii+1,jj  ,i_fxy) )
 
         if ( atmos_grid_cartesc_metric_limyz(k,i,j,n) > 1.d0 ) then
            log_error("ATMOS_GRID_CARTESC_METRIC_thin_wall",*) 'Facter miss! Check!'
            log_error_cont(*) k,i,j,n,atmos_grid_cartesc_metric_limyz(k,i,j,n)
            call prc_abort
         endif
       enddo
       enddo
       enddo
    enddo
 
    call comm_vars8( atmos_grid_cartesc_metric_limyz(:,:,:,i_xyz),  1 )
    call comm_vars8( atmos_grid_cartesc_metric_limyz(:,:,:,i_xyw),  2 )
    call comm_vars8( atmos_grid_cartesc_metric_limyz(:,:,:,i_uyw),  3 )
    call comm_vars8( atmos_grid_cartesc_metric_limyz(:,:,:,i_xvw),  4 )
    call comm_vars8( atmos_grid_cartesc_metric_limyz(:,:,:,i_uyz),  5 )
    call comm_vars8( atmos_grid_cartesc_metric_limyz(:,:,:,i_xvz),  6 )
    call comm_vars8( atmos_grid_cartesc_metric_limyz(:,:,:,i_uvz),  7 )
    call comm_wait ( atmos_grid_cartesc_metric_limyz(:,:,:,i_xyz),  1 )
    call comm_wait ( atmos_grid_cartesc_metric_limyz(:,:,:,i_xyw),  2 )
    call comm_wait ( atmos_grid_cartesc_metric_limyz(:,:,:,i_uyw),  3 )
    call comm_wait ( atmos_grid_cartesc_metric_limyz(:,:,:,i_xvw),  4 )
    call comm_wait ( atmos_grid_cartesc_metric_limyz(:,:,:,i_uyz),  5 )
    call comm_wait ( atmos_grid_cartesc_metric_limyz(:,:,:,i_xvz),  6 )
    call comm_wait ( atmos_grid_cartesc_metric_limyz(:,:,:,i_uvz),  7 )
 
    call comm_vars8( atmos_grid_cartesc_metric_limxz(:,:,:,i_xyz),  8 )
    call comm_vars8( atmos_grid_cartesc_metric_limxz(:,:,:,i_xyw),  9 )
    call comm_vars8( atmos_grid_cartesc_metric_limxz(:,:,:,i_uyw), 10 )
    call comm_vars8( atmos_grid_cartesc_metric_limxz(:,:,:,i_xvw), 11 )
    call comm_vars8( atmos_grid_cartesc_metric_limxz(:,:,:,i_uyz), 12 )
    call comm_vars8( atmos_grid_cartesc_metric_limxz(:,:,:,i_xvz), 13 )
    call comm_vars8( atmos_grid_cartesc_metric_limxz(:,:,:,i_uvz), 14 )
    call comm_wait ( atmos_grid_cartesc_metric_limxz(:,:,:,i_xyz),  8 )
    call comm_wait ( atmos_grid_cartesc_metric_limxz(:,:,:,i_xyw),  9 )
    call comm_wait ( atmos_grid_cartesc_metric_limxz(:,:,:,i_uyw), 10 )
    call comm_wait ( atmos_grid_cartesc_metric_limxz(:,:,:,i_xvw), 11 )
    call comm_wait ( atmos_grid_cartesc_metric_limxz(:,:,:,i_uyz), 12 )
    call comm_wait ( atmos_grid_cartesc_metric_limxz(:,:,:,i_xvz), 13 )
    call comm_wait ( atmos_grid_cartesc_metric_limxz(:,:,:,i_uvz), 14 )
 
    call comm_vars8( atmos_grid_cartesc_metric_limxy(:,:,:,i_xyz), 15 )
    call comm_vars8( atmos_grid_cartesc_metric_limxy(:,:,:,i_xyw), 16 )
    call comm_vars8( atmos_grid_cartesc_metric_limxy(:,:,:,i_uyw), 17 )
    call comm_vars8( atmos_grid_cartesc_metric_limxy(:,:,:,i_xvw), 18 )
    call comm_vars8( atmos_grid_cartesc_metric_limxy(:,:,:,i_uyz), 19 )
    call comm_vars8( atmos_grid_cartesc_metric_limxy(:,:,:,i_xvz), 20 )
    call comm_vars8( atmos_grid_cartesc_metric_limxy(:,:,:,i_uvz), 21 )
    call comm_wait ( atmos_grid_cartesc_metric_limxy(:,:,:,i_xyz), 15 )
    call comm_wait ( atmos_grid_cartesc_metric_limxy(:,:,:,i_xyw), 16 )
    call comm_wait ( atmos_grid_cartesc_metric_limxy(:,:,:,i_uyw), 17 )
    call comm_wait ( atmos_grid_cartesc_metric_limxy(:,:,:,i_xvw), 18 )
    call comm_wait ( atmos_grid_cartesc_metric_limxy(:,:,:,i_uyz), 19 )
    call comm_wait ( atmos_grid_cartesc_metric_limxy(:,:,:,i_xvz), 20 )
    call comm_wait ( atmos_grid_cartesc_metric_limxy(:,:,:,i_uvz), 21 )
 
    return
  end subroutine atmos_grid_cartesc_metric_thin_wall
 
  !-----------------------------------------------------------------------------
  subroutine atmos_grid_cartesc_metric_step_mountain
    use scale_comm_cartesc, only: &
       comm_vars8, &
       comm_wait
    implicit none
 
    integer :: i,j,k,n
    !---------------------------------------------------------------------------
 
    do n = 1, 7
       do j = js, je
       do i = is, ie
       do k = ks, ke
 
         if ( atmos_grid_cartesc_metric_limyz(k,i,j,n) > 0.0_rp ) then
            atmos_grid_cartesc_metric_limyz(k,i,j,n) = 1.0_rp
         endif
 
         if ( atmos_grid_cartesc_metric_limxz(k,i,j,n) > 0.0_rp ) then
            atmos_grid_cartesc_metric_limxz(k,i,j,n) = 1.0_rp
         endif
 
         if ( atmos_grid_cartesc_metric_limxy(k,i,j,n) > 0.0_rp ) then
            atmos_grid_cartesc_metric_limxy(k,i,j,n) = 1.0_rp
         endif
       enddo
       enddo
       enddo
    enddo
 
    call comm_vars8( atmos_grid_cartesc_metric_limyz(:,:,:,i_xyz),  1 )
    call comm_vars8( atmos_grid_cartesc_metric_limyz(:,:,:,i_xyw),  2 )
    call comm_vars8( atmos_grid_cartesc_metric_limyz(:,:,:,i_uyw),  3 )
    call comm_vars8( atmos_grid_cartesc_metric_limyz(:,:,:,i_xvw),  4 )
    call comm_vars8( atmos_grid_cartesc_metric_limyz(:,:,:,i_uyz),  5 )
    call comm_vars8( atmos_grid_cartesc_metric_limyz(:,:,:,i_xvz),  6 )
    call comm_vars8( atmos_grid_cartesc_metric_limyz(:,:,:,i_uvz),  7 )
    call comm_wait ( atmos_grid_cartesc_metric_limyz(:,:,:,i_xyz),  1 )
    call comm_wait ( atmos_grid_cartesc_metric_limyz(:,:,:,i_xyw),  2 )
    call comm_wait ( atmos_grid_cartesc_metric_limyz(:,:,:,i_uyw),  3 )
    call comm_wait ( atmos_grid_cartesc_metric_limyz(:,:,:,i_xvw),  4 )
    call comm_wait ( atmos_grid_cartesc_metric_limyz(:,:,:,i_uyz),  5 )
    call comm_wait ( atmos_grid_cartesc_metric_limyz(:,:,:,i_xvz),  6 )
    call comm_wait ( atmos_grid_cartesc_metric_limyz(:,:,:,i_uvz),  7 )
 
    call comm_vars8( atmos_grid_cartesc_metric_limxz(:,:,:,i_xyz),  8 )
    call comm_vars8( atmos_grid_cartesc_metric_limxz(:,:,:,i_xyw),  9 )
    call comm_vars8( atmos_grid_cartesc_metric_limxz(:,:,:,i_uyw), 10 )
    call comm_vars8( atmos_grid_cartesc_metric_limxz(:,:,:,i_xvw), 11 )
    call comm_vars8( atmos_grid_cartesc_metric_limxz(:,:,:,i_uyz), 12 )
    call comm_vars8( atmos_grid_cartesc_metric_limxz(:,:,:,i_xvz), 13 )
    call comm_vars8( atmos_grid_cartesc_metric_limxz(:,:,:,i_uvz), 14 )
    call comm_wait ( atmos_grid_cartesc_metric_limxz(:,:,:,i_xyz),  8 )
    call comm_wait ( atmos_grid_cartesc_metric_limxz(:,:,:,i_xyw),  9 )
    call comm_wait ( atmos_grid_cartesc_metric_limxz(:,:,:,i_uyw), 10 )
    call comm_wait ( atmos_grid_cartesc_metric_limxz(:,:,:,i_xvw), 11 )
    call comm_wait ( atmos_grid_cartesc_metric_limxz(:,:,:,i_uyz), 12 )
    call comm_wait ( atmos_grid_cartesc_metric_limxz(:,:,:,i_xvz), 13 )
    call comm_wait ( atmos_grid_cartesc_metric_limxz(:,:,:,i_uvz), 14 )
 
    call comm_vars8( atmos_grid_cartesc_metric_limxy(:,:,:,i_xyz), 15 )
    call comm_vars8( atmos_grid_cartesc_metric_limxy(:,:,:,i_xyw), 16 )
    call comm_vars8( atmos_grid_cartesc_metric_limxy(:,:,:,i_uyw), 17 )
    call comm_vars8( atmos_grid_cartesc_metric_limxy(:,:,:,i_xvw), 18 )
    call comm_vars8( atmos_grid_cartesc_metric_limxy(:,:,:,i_uyz), 19 )
    call comm_vars8( atmos_grid_cartesc_metric_limxy(:,:,:,i_xvz), 20 )
    call comm_vars8( atmos_grid_cartesc_metric_limxy(:,:,:,i_uvz), 21 )
    call comm_wait ( atmos_grid_cartesc_metric_limxy(:,:,:,i_xyz), 15 )
    call comm_wait ( atmos_grid_cartesc_metric_limxy(:,:,:,i_xyw), 16 )
    call comm_wait ( atmos_grid_cartesc_metric_limxy(:,:,:,i_uyw), 17 )
    call comm_wait ( atmos_grid_cartesc_metric_limxy(:,:,:,i_xvw), 18 )
    call comm_wait ( atmos_grid_cartesc_metric_limxy(:,:,:,i_uyz), 19 )
    call comm_wait ( atmos_grid_cartesc_metric_limxy(:,:,:,i_xvz), 20 )
    call comm_wait ( atmos_grid_cartesc_metric_limxy(:,:,:,i_uvz), 21 )
 
    return
  end subroutine atmos_grid_cartesc_metric_step_mountain
 
  !-----------------------------------------------------------------------------
  subroutine atmos_grid_cartesc_metric_write
    use scale_prc_cartesc, only: &
       prc_twod
    use scale_const, only: &
       const_radius
    use scale_vector, only: &
       vectr_distance
    use scale_file_cartesc, only: &
       file_cartesc_write
    use scale_atmos_grid_cartesc_real, only: &
       atmos_grid_cartesc_real_basepoint_lon, &
       atmos_grid_cartesc_real_basepoint_lat, &
       atmos_grid_cartesc_real_lon,           &
       atmos_grid_cartesc_real_lat
    use scale_mapprojection, only: &
       mapprojection_lonlat2xy
    implicit none
 
    real(RP) :: check_X_XY(IA,JA)
    real(RP) :: check_Y_XY(IA,JA)
    real(RP) :: distance  (IA,JA)
 
    integer  :: i, j
    !---------------------------------------------------------------------------
 
    if ( atmos_grid_cartesc_metric_out_basename /= '' ) then
 
       log_newline
       log_info("ATMOS_GRID_CARTESC_METRIC_write",*) 'Output metrics file '
 
       call file_cartesc_write( atmos_grid_cartesc_metric_mapf(:,:,1,i_xy),       atmos_grid_cartesc_metric_out_basename, atmos_grid_cartesc_metric_out_title, & ! [IN]
                          'MAPF_X_XY', 'Map factor x-dir at XY', 'NIL', 'XY', atmos_grid_cartesc_metric_out_dtype  ) ! [IN]
       call file_cartesc_write( atmos_grid_cartesc_metric_mapf(:,:,2,i_xy),       atmos_grid_cartesc_metric_out_basename, atmos_grid_cartesc_metric_out_title, & ! [IN]
                          'MAPF_Y_XY', 'Map factor y-dir at XY', 'NIL', 'XY', atmos_grid_cartesc_metric_out_dtype  ) ! [IN]
       if ( .not. prc_twod ) &
       call file_cartesc_write( atmos_grid_cartesc_metric_mapf(:,:,1,i_uy),       atmos_grid_cartesc_metric_out_basename, atmos_grid_cartesc_metric_out_title, & ! [IN]
                          'MAPF_X_UY', 'Map factor x-dir at UY', 'NIL', 'UY', atmos_grid_cartesc_metric_out_dtype  ) ! [IN]
       if ( .not. prc_twod ) &
       call file_cartesc_write( atmos_grid_cartesc_metric_mapf(:,:,2,i_uy),       atmos_grid_cartesc_metric_out_basename, atmos_grid_cartesc_metric_out_title, & ! [IN]
                          'MAPF_Y_UY', 'Map factor y-dir at UY', 'NIL', 'UY', atmos_grid_cartesc_metric_out_dtype  ) ! [IN]
       call file_cartesc_write( atmos_grid_cartesc_metric_mapf(:,:,1,i_xv),       atmos_grid_cartesc_metric_out_basename, atmos_grid_cartesc_metric_out_title, & ! [IN]
                          'MAPF_X_XV', 'Map factor x-dir at XV', 'NIL', 'XV', atmos_grid_cartesc_metric_out_dtype  ) ! [IN]
       call file_cartesc_write( atmos_grid_cartesc_metric_mapf(:,:,2,i_xv),       atmos_grid_cartesc_metric_out_basename, atmos_grid_cartesc_metric_out_title, & ! [IN]
                          'MAPF_Y_XV', 'Map factor y-dir at XV', 'NIL', 'XV', atmos_grid_cartesc_metric_out_dtype  ) ! [IN]
       if ( .not. prc_twod ) &
       call file_cartesc_write( atmos_grid_cartesc_metric_mapf(:,:,1,i_uv),       atmos_grid_cartesc_metric_out_basename, atmos_grid_cartesc_metric_out_title, & ! [IN]
                          'MAPF_X_UV', 'Map factor x-dir at UV', 'NIL', 'UV', atmos_grid_cartesc_metric_out_dtype  ) ! [IN]
       if ( .not. prc_twod ) &
       call file_cartesc_write( atmos_grid_cartesc_metric_mapf(:,:,2,i_uv),       atmos_grid_cartesc_metric_out_basename, atmos_grid_cartesc_metric_out_title, & ! [IN]
                          'MAPF_Y_UV', 'Map factor y-dir at UV', 'NIL', 'UV', atmos_grid_cartesc_metric_out_dtype  ) ! [IN]
 
       call file_cartesc_write( atmos_grid_cartesc_metric_rotc(:,:,1),            atmos_grid_cartesc_metric_out_basename, atmos_grid_cartesc_metric_out_title, & ! [IN]
                          'ROTC_COS',  'Rotation factor (cos)',  'NIL', 'XY', atmos_grid_cartesc_metric_out_dtype  ) ! [IN]
       call file_cartesc_write( atmos_grid_cartesc_metric_rotc(:,:,2),            atmos_grid_cartesc_metric_out_basename, atmos_grid_cartesc_metric_out_title, & ! [IN]
                          'ROTC_SIN',  'Rotation factor (sin)',  'NIL', 'XY', atmos_grid_cartesc_metric_out_dtype  ) ! [IN]
 
       call file_cartesc_write( atmos_grid_cartesc_metric_rotc(:,:,1),            atmos_grid_cartesc_metric_out_basename, atmos_grid_cartesc_metric_out_title, & ! [IN]
                          'ROTC_COS',  'Rotation factor (cos)',  'NIL', 'XY', atmos_grid_cartesc_metric_out_dtype  ) ! [IN]
 
       do j = 1, ja
       do i = 1, ia
          call mapprojection_lonlat2xy( atmos_grid_cartesc_real_lon(i,j), atmos_grid_cartesc_real_lat(i,j), check_x_xy(i,j), check_y_xy(i,j) )
       enddo
       enddo
 
       call file_cartesc_write( check_x_xy(:,:),     atmos_grid_cartesc_metric_out_basename, atmos_grid_cartesc_metric_out_title, & ! [IN]
                          'X_XY', 'x at XY for check', 'NIL', 'XY', atmos_grid_cartesc_metric_out_dtype  ) ! [IN]
       call file_cartesc_write( check_y_xy(:,:),     atmos_grid_cartesc_metric_out_basename, atmos_grid_cartesc_metric_out_title, & ! [IN]
                          'Y_XY', 'y at XY for check', 'NIL', 'XY', atmos_grid_cartesc_metric_out_dtype  ) ! [IN]
 
       do j = 1, ja
       do i = 1, ia
          call vectr_distance( const_radius,       & ! [IN]
                               atmos_grid_cartesc_real_basepoint_lon, & ! [IN]
                               atmos_grid_cartesc_real_basepoint_lat, & ! [IN]
                               atmos_grid_cartesc_real_lon(i,j),      & ! [IN]
                               atmos_grid_cartesc_real_lat(i,j),      & ! [IN]
                               distance(i,j)       ) ! [OUT]
       enddo
       enddo
 
       call file_cartesc_write( distance(:,:),               atmos_grid_cartesc_metric_out_basename, atmos_grid_cartesc_metric_out_title, & ! [IN]
                          'distance', 'distance from basepoint', 'm', 'XY', atmos_grid_cartesc_metric_out_dtype  ) ! [IN]
 
 
       ! metrics for terrain-following coordinate
       call file_cartesc_write( atmos_grid_cartesc_metric_gsqrt(:,:,:,i_xyz), atmos_grid_cartesc_metric_out_basename, atmos_grid_cartesc_metric_out_title, & ! [IN]
                                'GSQRT_ZXY',  'transformation metrics from Z to Xi, G^1/2 at ZXY', '1', 'ZXY',                                             & ! [IN]
                                atmos_grid_cartesc_metric_out_dtype  ) ! [IN]
       call file_cartesc_write( atmos_grid_cartesc_metric_gsqrt(:,:,:,i_xyw), atmos_grid_cartesc_metric_out_basename, atmos_grid_cartesc_metric_out_title, & ! [IN]
                                'GSQRT_WXY',  'transformation metrics from Z to Xi, G^1/2 at WXY', '1', 'ZHXY',                                            & ! [IN]
                                atmos_grid_cartesc_metric_out_dtype  ) ! [IN]
       if ( .not. prc_twod ) &
       call file_cartesc_write( atmos_grid_cartesc_metric_gsqrt(:,:,:,i_uyw), atmos_grid_cartesc_metric_out_basename, atmos_grid_cartesc_metric_out_title, & ! [IN]
                                'GSQRT_WUY',  'transformation metrics from Z to Xi, G^1/2 at WUY', '1', 'ZHXHY',                                           & ! [IN]
                                atmos_grid_cartesc_metric_out_dtype  ) ! [IN]
       call file_cartesc_write( atmos_grid_cartesc_metric_gsqrt(:,:,:,i_xvw), atmos_grid_cartesc_metric_out_basename, atmos_grid_cartesc_metric_out_title, & ! [IN]
                                'GSQRT_WXV',  'transformation metrics from Z to Xi, G^1/2 at WXV', '1', 'ZHXYH',                                           & ! [IN]
                                atmos_grid_cartesc_metric_out_dtype  ) ! [IN]
       if ( .not. prc_twod ) &
       call file_cartesc_write( atmos_grid_cartesc_metric_gsqrt(:,:,:,i_uyz), atmos_grid_cartesc_metric_out_basename, atmos_grid_cartesc_metric_out_title, & ! [IN]
                                'GSQRT_ZUY',  'transformation metrics from Z to Xi, G^1/2 at ZUY', '1', 'ZXHY',                                            & ! [IN]
                                atmos_grid_cartesc_metric_out_dtype  ) ! [IN]
       call file_cartesc_write( atmos_grid_cartesc_metric_gsqrt(:,:,:,i_xvz), atmos_grid_cartesc_metric_out_basename, atmos_grid_cartesc_metric_out_title, & ! [IN]
                                'GSQRT_ZXV',  'transformation metrics from Z to Xi, G^1/2 at ZXV', '1', 'ZXYH',                                            & ! [IN]
                                atmos_grid_cartesc_metric_out_dtype  ) ! [IN]
       if ( .not. prc_twod ) &
       call file_cartesc_write( atmos_grid_cartesc_metric_gsqrt(:,:,:,i_uvz), atmos_grid_cartesc_metric_out_basename, atmos_grid_cartesc_metric_out_title, & ! [IN]
                                'GSQRT_ZUV',  'transformation metrics from Z to Xi, G^1/2 at ZUV', '1', 'ZXHYH',                                           & ! [IN]
                                atmos_grid_cartesc_metric_out_dtype  ) ! [IN]
 
       call file_cartesc_write( atmos_grid_cartesc_metric_j13g(:,:,:,i_xyz), atmos_grid_cartesc_metric_out_basename, atmos_grid_cartesc_metric_out_title, & ! [IN]
                                'J13G_ZXY',  '(1,3) element of Jacobian matrix * {G}^1/2 at ZXY', '1', 'ZXY',                                             & ![IN]
                                atmos_grid_cartesc_metric_out_dtype  ) ! [IN]
       call file_cartesc_write( atmos_grid_cartesc_metric_j13g(:,:,:,i_xyw), atmos_grid_cartesc_metric_out_basename, atmos_grid_cartesc_metric_out_title, & ! [IN]
                                'J13G_WXY',  '(1,3) element of Jacobian matrix * {G}^1/2 at WXY', '1', 'ZHXY',                                            & ![IN]
                                atmos_grid_cartesc_metric_out_dtype  ) ! [IN]
       if ( .not. prc_twod ) &
       call file_cartesc_write( atmos_grid_cartesc_metric_j13g(:,:,:,i_uyw), atmos_grid_cartesc_metric_out_basename, atmos_grid_cartesc_metric_out_title, & ! [IN]
                                'J13G_WUY',  '(1,3) element of Jacobian matrix * {G}^1/2 at WUY', '1', 'ZHXHY',                                           & ![IN]
                                atmos_grid_cartesc_metric_out_dtype  ) ! [IN]
       call file_cartesc_write( atmos_grid_cartesc_metric_j13g(:,:,:,i_xvw), atmos_grid_cartesc_metric_out_basename, atmos_grid_cartesc_metric_out_title, & ! [IN]
                                'J13G_WXV',  '(1,3) element of Jacobian matrix * {G}^1/2 at WXV', '1', 'ZHXYH',                                           & ![IN]
                                atmos_grid_cartesc_metric_out_dtype  ) ! [IN]
       if ( .not. prc_twod ) &
       call file_cartesc_write( atmos_grid_cartesc_metric_j13g(:,:,:,i_uyz), atmos_grid_cartesc_metric_out_basename, atmos_grid_cartesc_metric_out_title, & ! [IN]
                                'J13G_ZUY',  '(1,3) element of Jacobian matrix * {G}^1/2 at ZUY', '1', 'ZXHY',                                            & ![IN]
                                atmos_grid_cartesc_metric_out_dtype  ) ! [IN]
       call file_cartesc_write( atmos_grid_cartesc_metric_j13g(:,:,:,i_xvz), atmos_grid_cartesc_metric_out_basename, atmos_grid_cartesc_metric_out_title, & ! [IN]
                                'J13G_ZXV',  '(1,3) element of Jacobian matrix * {G}^1/2 at ZXV', '1', 'ZXYH',                                            & ![IN]
                                atmos_grid_cartesc_metric_out_dtype  ) ! [IN]
       if ( .not. prc_twod ) &
       call file_cartesc_write( atmos_grid_cartesc_metric_j13g(:,:,:,i_uvz), atmos_grid_cartesc_metric_out_basename, atmos_grid_cartesc_metric_out_title, & ! [IN]
                                'J13G_ZUV',  '(1,3) element of Jacobian matrix * {G}^1/2 at ZUV', '1', 'ZXHYH',                                           & ![IN]
                                atmos_grid_cartesc_metric_out_dtype  ) ! [IN]
 
       call file_cartesc_write( atmos_grid_cartesc_metric_j23g(:,:,:,i_xyz), atmos_grid_cartesc_metric_out_basename, atmos_grid_cartesc_metric_out_title, & ! [IN]
                                'J23G_ZXY',  '(2,3) element of Jacobian matrix * {G}^1/2 at ZXY', '1', 'ZXY',                                             & ![IN]
                                atmos_grid_cartesc_metric_out_dtype  ) ! [IN]
       call file_cartesc_write( atmos_grid_cartesc_metric_j23g(:,:,:,i_xyw), atmos_grid_cartesc_metric_out_basename, atmos_grid_cartesc_metric_out_title, & ! [IN]
                                'J23G_WXY',  '(2,3) element of Jacobian matrix * {G}^1/2 at WXY', '1', 'ZHXY',                                            & ![IN]
                                atmos_grid_cartesc_metric_out_dtype  ) ! [IN]
       if ( .not. prc_twod ) &
       call file_cartesc_write( atmos_grid_cartesc_metric_j23g(:,:,:,i_uyw), atmos_grid_cartesc_metric_out_basename, atmos_grid_cartesc_metric_out_title, & ! [IN]
                                'J23G_WUY',  '(2,3) element of Jacobian matrix * {G}^1/2 at WUY', '1', 'ZHXHY',                                           & ![IN]
                                atmos_grid_cartesc_metric_out_dtype  ) ! [IN]
       call file_cartesc_write( atmos_grid_cartesc_metric_j23g(:,:,:,i_xvw), atmos_grid_cartesc_metric_out_basename, atmos_grid_cartesc_metric_out_title, & ! [IN]
                                'J23G_WXV',  '(2,3) element of Jacobian matrix * {G}^1/2 at WXV', '1', 'ZHXYH',                                           & ![IN]
                                atmos_grid_cartesc_metric_out_dtype  ) ! [IN]
       if ( .not. prc_twod ) &
       call file_cartesc_write( atmos_grid_cartesc_metric_j23g(:,:,:,i_uyz), atmos_grid_cartesc_metric_out_basename, atmos_grid_cartesc_metric_out_title, & ! [IN]
                                'J23G_ZUY',  '(2,3) element of Jacobian matrix * {G}^1/2 at ZUY', '1', 'ZXHY',                                            & ![IN]
                                atmos_grid_cartesc_metric_out_dtype  ) ! [IN]
       call file_cartesc_write( atmos_grid_cartesc_metric_j23g(:,:,:,i_xvz), atmos_grid_cartesc_metric_out_basename, atmos_grid_cartesc_metric_out_title, & ! [IN]
                                'J23G_ZXV',  '(2,3) element of Jacobian matrix * {G}^1/2 at ZXV', '1', 'ZXYH',                                            & ![IN]
                                atmos_grid_cartesc_metric_out_dtype  ) ! [IN]
       if ( .not. prc_twod ) &
       call file_cartesc_write( atmos_grid_cartesc_metric_j23g(:,:,:,i_uvz), atmos_grid_cartesc_metric_out_basename, atmos_grid_cartesc_metric_out_title, & ! [IN]
                                'J23G_ZUV',  '(2,3) element of Jacobian matrix * {G}^1/2 at ZUV', '1', 'ZXHYH',                                           & ![IN]
                                atmos_grid_cartesc_metric_out_dtype  ) ! [IN]
 
    endif
 
    return
  end subroutine atmos_grid_cartesc_metric_write
 
end module scale_atmos_grid_cartesc_metric