scale_atmos_grid_cartesC_index.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "scalelib.h"
module scale_atmos_grid_cartesc_index
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_io
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: atmos_grid_cartesc_index_setup
  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
 
  integer, public, parameter :: zdir  = 1
  integer, public, parameter :: xdir  = 2
  integer, public, parameter :: ydir  = 3
 
  integer, public :: kmax   = -1
  integer, public :: imax   = -1
  integer, public :: jmax   = -1
 
  integer, public :: iblock = -1
  integer, public :: jblock = -1
 
  integer, public, parameter :: khalo  = 2
  integer, public            :: ihalo  = 2
  integer, public            :: jhalo  = 2
 
  integer, public :: ka
  integer, public :: ia
  integer, public :: ja
 
  integer, public :: ks
  integer, public :: ke
  integer, public :: is
  integer, public :: ie
  integer, public :: js
  integer, public :: je
  !$acc declare create(KA, KS, KE, IA, IS, IE, JA, JS, JE)
 
  integer, public :: kijmax = -1
 
  ! indices considering boundary
  integer, public :: imaxb
  integer, public :: jmaxb
  integer, public :: isb
  integer, public :: ieb
  integer, public :: jsb
  integer, public :: jeb
  integer, public :: ieh
  integer, public :: jeh
 
  ! global size and offset
  integer, public :: imaxg  = -1
  integer, public :: jmaxg  = -1
  integer, public :: iag
  integer, public :: jag
  integer, public :: iagb
  integer, public :: jagb
  integer, public :: is_ing
  integer, public :: ie_ing
  integer, public :: js_ing
  integer, public :: je_ing
  integer, public :: isga
  integer, public :: iega
  integer, public :: jsga
  integer, public :: jega
  integer, public :: isgb
  integer, public :: iegb
  integer, public :: jsgb
  integer, public :: jegb
 
  integer,  public :: i_xyz = 1 ! at (x,y,z)
  integer,  public :: i_xyw = 2 ! at (x,y,w)
  integer,  public :: i_uyw = 3 ! at (u,y,w)
  integer,  public :: i_xvw = 4 ! at (x,v,w)
  integer,  public :: i_uyz = 5 ! at (u,y,z)
  integer,  public :: i_xvz = 6 ! at (x,v,z)
  integer,  public :: i_uvz = 7 ! at (u,v,z)
 
  integer,  public :: i_xy  = 1 ! at (x,y)
  integer,  public :: i_uy  = 2 ! at (u,y)
  integer,  public :: i_xv  = 3 ! at (x,v)
  integer,  public :: i_uv  = 4 ! at (u,v)
 
  integer,  public :: i_fyz = 1 ! y-z face limiting x-flux
  integer,  public :: i_fxz = 2 ! x-z face limiting y-flux
  integer,  public :: i_fxy = 3 ! x-y face limiting z-flux
 
contains
 
  !-----------------------------------------------------------------------------
  subroutine atmos_grid_cartesc_index_setup( &
       KMAX,                &
       IMAXG, JMAXG,        &
       IMAX, JMAX,          &
       KHALO, IHALO, JHALO, &
       IBLOCK, JBLOCK       )
    use scale_prc_cartesc, only: &
       prc_twod
    implicit none
    integer, intent(in), optional :: kmax
    integer, intent(in), optional :: imaxg, jmaxg
    integer, intent(in), optional :: imax, jmax
    integer, intent(in), optional :: khalo, ihalo, jhalo
    integer, intent(in), optional :: iblock, jblock
 
    call atmos_grid_cartesc_index_setup_main( &
         kmax,                &
         imaxg, jmaxg,        &
         imax, jmax,          &
         khalo, ihalo, jhalo, &
         iblock, jblock       )
 
    if ( prc_twod ) then
       i_xyz = 1
       i_xyw = 2
       i_xvw = 3
       i_xvz = 4
       i_uyw = i_xyw
       i_uyz = i_xyz
       i_uvz = i_xvz
 
       i_xy  = 1
       i_xv  = 2
       i_uy  = i_xy
       i_uv  = i_xv
    end if
 
    return
  end subroutine atmos_grid_cartesc_index_setup
 
  subroutine atmos_grid_cartesc_index_setup_main( &
       KMAX_in,                      &
       IMAXG_in, JMAXG_in,           &
       IMAX_in, JMAX_in,             &
       KHALO_in, IHALO_in, JHALO_in, &
       IBLOCK_in, JBLOCK_in          )
    use scale_prc, only: &
       prc_abort, &
       prc_myrank
    use scale_prc_cartesc, only: &
       prc_periodic_x, &
       prc_periodic_y, &
       prc_twod,    &
       prc_2drank,  &
       prc_num_x,   &
       prc_num_y,   &
       prc_has_w,   &
       prc_has_e,   &
       prc_has_s,   &
       prc_has_n
    implicit none
    integer, intent(in), optional :: KMAX_in
    integer, intent(in), optional :: IMAXG_in, JMAXG_in
    integer, intent(in), optional :: IMAX_in, JMAX_in
    integer, intent(in), optional :: KHALO_in, IHALO_in, JHALO_in
    integer, intent(in), optional :: IBLOCK_in, JBLOCK_in
 
    namelist / param_atmos_grid_cartesc_index / &
       kmax,       &
       imaxg,      &
       jmaxg,      &
       imax,       &
       jmax,       &
       ihalo,      &
       jhalo,      &
       iblock,     &
       jblock
 
    integer :: ierr
    !---------------------------------------------------------------------------
 
    kmax = -1
    imax = -1
    jmax = -1
    iblock = -1
    jblock = -1
 
    if ( present(kmax_in)  ) kmax   = kmax_in
    if ( present(imaxg_in) ) imaxg  = imaxg_in
    if ( present(jmaxg_in) ) jmaxg  = jmaxg_in
    if ( present(imax_in)  ) imax   = imax_in
    if ( present(jmax_in)  ) jmax   = jmax_in
!    if ( present(KHALO_in) ) KHALO  = KHALO_in
    if ( present(ihalo_in) ) ihalo  = ihalo_in
    if ( present(jhalo_in) ) jhalo  = jhalo_in
    if ( present(iblock_in) ) iblock = iblock_in
    if ( present(jblock_in) ) jblock = jblock_in
 
    log_newline
    log_info("ATMOS_GRID_CARTESC_index_setup_main",*) 'Setup'
 
    !--- read namelist
    rewind(io_fid_conf)
    read(io_fid_conf,nml=param_atmos_grid_cartesc_index,iostat=ierr)
    if( ierr < 0 ) then !--- missing
       log_info("ATMOS_GRID_CARTESC_index_setup_main",*) 'Not found namelist. Default used.'
    elseif( ierr > 0 ) then !--- fatal error
       log_error("ATMOS_GRID_CARTESC_index_setup_main",*) 'Not appropriate names in namelist PARAM_ATMOS_GRID_CARTESC_INDEX. Check!'
       call prc_abort
    endif
    log_nml(param_atmos_grid_cartesc_index)
 
    if ( kmax < 2 ) then
       log_error("ATMOS_GRID_CARTESC_index_setup_main",*) 'KMAX must be >= 2! ', kmax
       call prc_abort
    end if
 
 
    if ( imaxg * jmaxg < 0 ) then
       log_error("ATMOS_GRID_CARTESC_index_setup_main",*) 'Both IMAXG and JMAXG must set! ', imaxg, jmaxg
       call prc_abort
    endif
    if ( imax * jmax < 0 ) then
       log_error("ATMOS_GRID_CARTESC_index_setup_main",*) 'Both IMAX and JMAX must set! ', imax, jmax
       call prc_abort
    endif
 
    if ( imax > 0 .AND. jmax > 0 ) then
       imaxg = imax * prc_num_x
       jmaxg = jmax * prc_num_y
    elseif( imaxg > 0 .AND. jmaxg > 0 ) then
       imax = (imaxg-1) / prc_num_x + 1
       jmax = (jmaxg-1) / prc_num_y + 1
 
       if ( mod(imaxg,prc_num_x) > 0 ) then
          log_error("ATMOS_GRID_CARTESC_index_setup_main",*) 'number of IMAXG should be divisible by PRC_NUM_X'
          call prc_abort
!           LOG_INFO("ATMOS_GRID_CARTESC_index_setup_main",*) 'number of IMAXG should be divisible by PRC_NUM_X'
!           LOG_INFO("ATMOS_GRID_CARTESC_index_setup_main",*) 'Small IMAX is used in ranks(X,*)=', PRC_NUM_X-1
!           if ( PRC_2Drank(PRC_myrank,1) == PRC_NUM_X-1 ) then
!              IMAX = IMAXG - IMAX * (PRC_NUM_X-1)
!              LOG_INFO("ATMOS_GRID_CARTESC_index_setup_main",*) 'Small IMAX is used in this rank. IMAX=', IMAX
!           endif
       endif
 
       if ( mod(jmaxg,prc_num_y) > 0 ) then
          log_error("ATMOS_GRID_CARTESC_index_setup_main",*) 'number of JMAXG should be divisible by PRC_NUM_Y'
          call prc_abort
!           LOG_INFO("ATMOS_GRID_CARTESC_index_setup_main",*) 'number of JMAXG should be divisible by PRC_NUM_Y'
!           LOG_INFO("ATMOS_GRID_CARTESC_index_setup_main",*) 'Small JMAX is used in ranks(*,Y)=', PRC_NUM_Y-1
!           if ( PRC_2Drank(PRC_myrank,2) == PRC_NUM_Y-1 ) then
!              JMAX = JMAXG - JMAX * (PRC_NUM_Y-1)
!              LOG_INFO("ATMOS_GRID_CARTESC_index_setup_main",*) 'Small JMAX is used in this rank. JMAX=', JMAX
!           endif
       endif
    else
       log_error("ATMOS_GRID_CARTESC_index_setup_main",*) 'IMAXG&JMAXG or IMAX&JMAX must set!'
       call prc_abort
    endif
 
 
    ! check if this is 2D experiment
    if ( imaxg == 1 ) then
       prc_twod = .true.
       ihalo = 0
    else
       prc_twod = .false.
    end if
 
 
    if ( imax < ihalo ) then
       log_error("ATMOS_GRID_CARTESC_index_setup_main",*) 'number of grid size IMAX must >= IHALO! ', imax, ihalo
       call prc_abort
    endif
    if ( jmax < jhalo ) then
       log_error("ATMOS_GRID_CARTESC_index_setup_main",*) 'number of grid size JMAX must >= JHALO! ', jmax, jhalo
       call prc_abort
    endif
 
    ka = kmax + khalo * 2
    ia = imax + ihalo * 2
    ja = jmax + jhalo * 2
 
    ks = 1    + khalo
    ke = kmax + khalo
    is = 1    + ihalo
    ie = imax + ihalo
    js = 1    + jhalo
    je = jmax + jhalo
    !$acc update device(KA, KS, KE, IA, IS, IE, JA, JS, JE)
 
    if( iblock == -1 ) iblock = imax
    if( jblock == -1 ) jblock = jmax
 
    kijmax = kmax * imax * jmax
 
 
    !-- Block size must be divisible
    if    ( mod(imax,iblock) > 0 ) then
       log_error("ATMOS_GRID_CARTESC_index_setup_main",*) 'number of grid size IMAX must be divisible by IBLOCK! ', imax, iblock
       call prc_abort
    elseif( mod(jmax,jblock) > 0 ) then
       log_error("ATMOS_GRID_CARTESC_index_setup_main",*) 'number of grid size JMAX must be divisible by JBLOCK! ', jmax, jblock
       call prc_abort
    endif
 
    ! array size (global domain)
    iag   = imaxg + ihalo * 2
    jag   = jmaxg + jhalo * 2
 
    ! horizontal index (global domain)
    is_ing = ihalo + 1    + prc_2drank(prc_myrank,1) * imax
    ie_ing = ihalo + imax + prc_2drank(prc_myrank,1) * imax
    js_ing = jhalo + 1    + prc_2drank(prc_myrank,2) * jmax
    je_ing = jhalo + jmax + prc_2drank(prc_myrank,2) * jmax
 
    if ( prc_2drank(prc_myrank,1) == 0 ) then
       isga = 1
    else
       isga = is_ing
    end if
    if ( prc_2drank(prc_myrank,1) == prc_num_x - 1 ) then
       iega = iag
    else
       iega = ie_ing
    end if
    if ( prc_2drank(prc_myrank,2) == 0 ) then
       jsga = 1
    else
       jsga = js_ing
    end if
    if ( prc_2drank(prc_myrank,2) == prc_num_y - 1 ) then
       jega = jag
    else
       jega = je_ing
    end if
 
    if ( prc_periodic_x .or. prc_twod ) then
       iagb = imaxg
       isgb = is_ing - ihalo
       iegb = ie_ing - ihalo
    else
       iagb = iag
       if ( prc_has_w ) then
          isgb = is_ing
       else ! western boundary
          isgb = is_ing - ihalo ! ISGB = 1
       end if
       if ( prc_has_e ) then
          iegb = ie_ing
       else ! eastern boundary
          iegb = ie_ing + ihalo
       end if
    end if
    if ( prc_periodic_y ) then
       jagb = jmaxg
       jsgb = js_ing - jhalo
       jegb = je_ing - jhalo
    else
       jagb = jag
       if ( prc_has_s ) then
          jsgb = js_ing
       else ! southern boundary
          jsgb = js_ing - jhalo ! JSGY = 1
       end if
       if ( prc_has_n ) then
          jegb = je_ing
       else ! northern boundary
          jegb = je_ing + jhalo
       end if
    end if
 
    ! index considering boundary region
    imaxb = imax
    jmaxb = jmax
    isb   = is
    ieb   = ie
    jsb   = js
    jeb   = je
    ieh   = ie
    jeh   = je
 
    if ( .NOT. prc_has_w ) then
       imaxb = imaxb + ihalo
       isb = 1
    endif
    if ( .NOT. prc_has_e ) then
       imaxb = imaxb + ihalo
       ieb = ia
       ieh = ie - 1
    endif
    if ( .NOT. prc_has_s ) then
       jmaxb = jmaxb + jhalo
       jsb = 1
    endif
    if ( .NOT. prc_has_n ) then
       jmaxb = jmaxb + jhalo
       jeb = ja
       jeh = je - 1
    endif
 
    log_newline
    log_info("ATMOS_GRID_CARTESC_index_setup_main",*) 'Atmosphere grid index information '
 
    ! global
    log_info_cont('(1x,3(A,I6))') 'No. of Computational Grid (global)  :', &
                                   kmax,' x ',imaxg,' x ',jmaxg
    log_info_cont('(1x,2(A,I6))') 'Global index of local grid (X)      :', &
                                   is_ing," - ",ie_ing
    log_info_cont('(1x,2(A,I6))') 'Global index of local grid (Y)      :', &
                                                js_ing," - ",je_ing
 
    ! local
    log_newline
    log_info_cont('(1x,3(A,I6))') 'No. of Computational Grid (local)   :', &
                                   kmax,' x ',imax,' x ',jmax
    log_info_cont('(1x,3(A,I6))') 'No. of Grid (including HALO, local) :', &
                                   ka," x ",ia," x ",ja
    log_info_cont('(1x,2(A,I6))') 'Local index of inner grid (X)       :', &
                                   isb," - ",ieb
    log_info_cont('(1x,2(A,I6))') 'Local index of inner grid (Y)       :', &
                                                jsb," - ",jeb
 
    return
  end subroutine atmos_grid_cartesc_index_setup_main
 
end module scale_atmos_grid_cartesc_index