mod_realinput_scale.f90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
module mod_realinput_scale
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_stdio
  use scale_tracer
  use scale_process, only: &
       myrank => prc_myrank,  &
       prc_mpistop
  use scale_grid_nest, only: &
       parent_kmax,     &
       parent_imax,     &
       parent_jmax,     &
       parent_lkmax,    &
       nest_tile_num_x, &
       nest_tile_num_y, &
       nest_tile_id

  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: parentatomsetupscale
  public :: parentatomopenscale
  public :: parentatominputscale
  public :: parentlandsetupscale
  public :: parentlandinputscale
  public :: parentoceansetupscale
  public :: parentoceanopenscale
  public :: parentoceaninputscale

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  integer, parameter    :: handle = 1

  real(RP), allocatable :: read2d(:,:)
  real(RP), allocatable :: read3d(:,:,:)
  real(RP), allocatable :: read3dl(:,:,:)

  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine parentatomsetupscale( &
       dims )
    implicit none

    integer,          intent(out) :: dims(6)

    integer :: i
    !---------------------------------------------------------------------------

    if( io_l ) write(io_fid_log,*) '+++ Real Case/Atom Input File Type: SCALE-RM'
    ! full level
    dims(1) = parent_kmax(handle)
    dims(2) = parent_imax(handle) * nest_tile_num_x
    dims(3) = parent_jmax(handle) * nest_tile_num_y
    ! half level
    dims(4) = dims(1)
    dims(5) = dims(2)
    dims(6) = dims(3)

    allocate( read2d( parent_imax(handle), parent_jmax(handle) ) )
    allocate( read3d( parent_imax(handle), parent_jmax(handle), dims(1) ) )

    return
  end subroutine parentatomsetupscale

  !-----------------------------------------------------------------------------
  subroutine parentatomopenscale( &
       lon_org,      &
       lat_org,      &
       cz_org,       &
       basename_org, &
       dims          )
    use scale_const, only: &
         d2r => const_d2r
    use gtool_file, only: &
         fileread
    implicit none
    real(RP), intent(out) :: lon_org(:,:)
    real(RP), intent(out) :: lat_org(:,:)
    real(RP), intent(out) :: cz_org (:,:,:)
    character(len=*), intent(in)  :: basename_org
    integer,  intent(in)  :: dims(6)

    integer :: rank
    integer :: xloc, yloc
    integer :: xs, xe, ys, ye

    integer :: i, k

    if( io_l ) write(io_fid_log,*) '+++ ScaleLib/IO[realinput]/Categ[AtomOpenSCALE]'

    do i = 1, size( nest_tile_id(:) )
       ! read data from split files
       rank = nest_tile_id(i)

       xloc = mod( i-1, nest_tile_num_x ) + 1
       yloc = int( real(i-1) / real(NEST_TILE_NUM_X) ) + 1

       xs = parent_imax(handle) * (xloc-1) + 1
       xe = parent_imax(handle) * xloc
       ys = parent_jmax(handle) * (yloc-1) + 1
       ye = parent_jmax(handle) * yloc

       call fileread( read2d(:,:),   basename_org, "lon",        1, rank )
       lon_org(xs:xe,ys:ye)  = read2d(:,:) * d2r

       call fileread( read2d(:,:),   basename_org, "lat",        1, rank )
       lat_org(xs:xe,ys:ye)  = read2d(:,:) * d2r

       call fileread( read3d(:,:,:), basename_org, "height",     1, rank )
       do k = 1, dims(1)
          cz_org(k+2,xs:xe,ys:ye) = read3d(:,:,k)
       end do

       call fileread( read2d(:,:),   basename_org, "topo",       1, rank )
       cz_org(2,xs:xe,ys:ye)  = read2d(:,:)

    end do

    cz_org(1,:,:)  = 0.0_rp
    return
  end subroutine parentatomopenscale

  !-----------------------------------------------------------------------------
  subroutine parentatominputscale( &
       velz_org,      &
       velx_org,      &
       vely_org,      &
       pres_org,      &
       dens_org,      &
       pott_org,      &
       qtrc_org,      &
       flg_bin,       &
       flg_intrp,     &
       basename_org,  &
       mptype_parent, &
       dims,          &
       it             ) ! (in)
    use scale_const, only: &
       p00 => const_pre00, &
       cpdry => const_cpdry, &
       rdry => const_rdry
    use scale_comm, only: &
       comm_vars8, &
       comm_wait
    use gtool_file, only: &
       fileread
    use scale_atmos_hydrostatic, only: &
       hydrostatic_buildrho_real => atmos_hydrostatic_buildrho_real
    use scale_atmos_thermodyn, only: &
       thermodyn_temp_pres => atmos_thermodyn_temp_pres, &
       thermodyn_pott      => atmos_thermodyn_pott
    use scale_gridtrans, only: &
       rotc => gtrans_rotc
    use scale_topography, only: &
       topo => topo_zsfc
    use scale_interpolation_nest, only: &
       intrpnest_interp_fact_llz,  &
       intrpnest_interp_2d,        &
       intrpnest_interp_3d
    use scale_atmos_phy_mp_convert, only: &
       atmos_phy_mp_bulk2bin
    implicit none

    real(RP),         intent(out) :: velz_org(:,:,:)
    real(RP),         intent(out) :: velx_org(:,:,:)
    real(RP),         intent(out) :: vely_org(:,:,:)
    real(RP),         intent(out) :: pres_org(:,:,:)
    real(RP),         intent(out) :: dens_org(:,:,:)
    real(RP),         intent(out) :: pott_org(:,:,:)
    real(RP),         intent(out) :: qtrc_org(:,:,:,:)
    logical,          intent(in)  :: flg_bin            ! flag for SBM(S10)
    logical,          intent(in)  :: flg_intrp          ! flag for interpolation of SBM
    character(len=*), intent(in)  :: basename_org
    integer,          intent(in)  :: mptype_parent
    integer,          intent(in)  :: dims(6)
    integer,          intent(in)  :: it

    ! work

    real(RP) :: momz_org(dims(1)+2,dims(2),dims(3))
    real(RP) :: momx_org(dims(1)+2,dims(2),dims(3))
    real(RP) :: momy_org(dims(1)+2,dims(2),dims(3))
    real(RP) :: rhot_org(dims(1)+2,dims(2),dims(3))
    real(RP) :: tsfc_org(          dims(2),dims(3))
    real(RP) :: temp_org

    integer :: xs, xe
    integer :: ys, ye
    integer :: xloc, yloc
    integer :: rank

    integer :: k, i, j, iq
    logical :: lack_of_val
    !---------------------------------------------------------------------------


    if( io_l ) write(io_fid_log,*) '+++ ScaleLib/IO[realinput]/Categ[AtomInputSCALE]'

    do i = 1, size( nest_tile_id(:) )
       ! read data from split files
       rank = nest_tile_id(i)

       xloc = mod( i-1, nest_tile_num_x ) + 1
       yloc = int( real(i-1) / real(NEST_TILE_NUM_X) ) + 1

       xs = parent_imax(handle) * (xloc-1) + 1
       xe = parent_imax(handle) * xloc
       ys = parent_jmax(handle) * (yloc-1) + 1
       ye = parent_jmax(handle) * yloc

       call fileread( read2d(:,:), basename_org, "T2", it, rank )
       tsfc_org(xs:xe,ys:ye) = read2d(:,:)

       call fileread( read2d(:,:), basename_org, "MSLP", it, rank )
       pres_org(1,xs:xe,ys:ye) = read2d(:,:)

       call fileread( read3d(:,:,:), basename_org, "DENS", it, rank )
       do k = 1, dims(1)
          dens_org(k+2,xs:xe,ys:ye) = read3d(:,:,k)
       end do

       call fileread( read3d(:,:,:), basename_org, "MOMZ", it, rank )
       do k = 1, dims(1)
          momz_org(k+2,xs:xe,ys:ye) = read3d(:,:,k)
       end do

       call fileread( read3d(:,:,:), basename_org, "MOMX", it, rank )
       do k = 1, dims(1)
          momx_org(k+2,xs:xe,ys:ye) = read3d(:,:,k)
       end do

       call fileread( read3d(:,:,:), basename_org, "MOMY", it, rank )
       do k = 1, dims(1)
          momy_org(k+2,xs:xe,ys:ye) = read3d(:,:,k)
       end do

       call fileread( read3d(:,:,:), basename_org, "RHOT", it, rank )
       do k = 1, dims(1)
          rhot_org(k+2,xs:xe,ys:ye) = read3d(:,:,k)
       end do

       if( flg_bin .and. flg_intrp ) then  !--- tracers created from parent domain by interpolation

          if( io_l ) write(io_fid_log,*) '+++ SDF of SBM(S10) is interpolated from Qxx and Nxx'
          if( io_l ) write(io_fid_log,*) '+++ of outer bulk MP model'

          call atmos_phy_mp_bulk2bin( xs, xe,       & ! [IN]
                                      ys, ye,       & ! [IN]
                                      dims,         & ! [IN]
                                      it,           & ! [IN]
                                      rank,         & ! [IN]
                                      handle,       & ! [IN]
                                      basename_org, & ! [IN]
                                      dens_org,     & ! [IN]
                                      qtrc_org      ) ! [INOUT]
          do iq = 1, qa
             qtrc_org(2,xs:xe,ys:ye,iq) = qtrc_org(3,xs:xe,ys:ye,iq)
          enddo

       else !--- tracers of paremt domain directly used

          do iq = 1, mptype_parent
             call fileread( read3d(:,:,:), basename_org, aq_name(iq), it, rank )
             do k = 1, dims(1)
                qtrc_org(k+2,xs:xe,ys:ye,iq) = read3d(:,:,k)
             end do
             qtrc_org(2,xs:xe,ys:ye,iq) = qtrc_org(3,xs:xe,ys:ye,iq)
          end do
          do iq = mptype_parent+1, qa
             qtrc_org(:,xs:xe,ys:ye,iq) = 0.0_rp
          end do

       endif

!       call FileRead( read2D(:,:), BASENAME_ORG, "Q2", it, rank )
!       qtrc_org(2,xs:xe,ys:ye,I_QV) = read2D(:,:)

    end do

    ! convert from momentum to velocity
    do j = 1, dims(3)
    do i = 1, dims(2)
    do k = 4, dims(1)+2
       velz_org(k,i,j) = ( momz_org(k-1,i,j) + momz_org(k,i,j) ) / dens_org(k,i,j) * 0.5_rp
    end do
    end do
    end do
    do j = 1, dims(3)
    do i = 1, dims(2)
       velz_org(1:3    ,i,j) = 0.0_rp
       velz_org(dims(1)+2,i,j) = 0.0_rp
    end do
    end do

    ! convert from momentum to velocity
    do j = 1, dims(3)
    do i = 2, dims(2)
    do k = 3, dims(1)+2
       velx_org(k,i,j) = ( momx_org(k,i-1,j) + momx_org(k,i,j) ) / dens_org(k,i,j) * 0.5_rp
    end do
    end do
    end do
    do j = 1, dims(3)
    do k = 3, dims(1)+2
       velx_org(k,1,j) = momx_org(k,1,j) / dens_org(k,1,j)
    end do
    end do
    velx_org(1:2,:,:) = 0.0_rp

    ! convert from momentum to velocity
    do j = 2, dims(3)
    do i = 1, dims(2)
    do k = 3, dims(1)+2
       vely_org(k,i,j) = ( momy_org(k,i,j-1) + momy_org(k,i,j) ) / dens_org(k,i,j) * 0.5_rp
    end do
    end do
    end do
    do i = 1, dims(2)
    do k = 3, dims(1)+2
       vely_org(k,i,1) = momy_org(k,i,1) / dens_org(k,i,1)
    end do
    end do
    vely_org(1:2,:,:) = 0.0_rp


    !!! must be rotate !!!


    do j = 1, dims(3)
    do i = 1, dims(2)
       do k = 3, dims(1)+2
          ! diagnose temp and pres
          call thermodyn_temp_pres( temp_org,          & ! [OUT]
                                    pres_org(k,i,j),   & ! [OUT]
                                    dens_org(k,i,j),   & ! [IN]
                                    rhot_org(k,i,j),   & ! [IN]
                                    qtrc_org(k,i,j,:)  ) ! [IN]
          pott_org(k,i,j) = rhot_org(k,i,j) / dens_org(k,i,j)
       end do
       pott_org(1:2,i,j) = pott_org(3,i,j)
       pres_org(2,i,j) = p00 * ( tsfc_org(i,j) / pott_org(2,i,j) )**(cpdry/rdry)
       dens_org(1,i,j) = p00 * ( p00/pres_org(1,i,j) )**(rdry/cpdry-1.0_rp)
       dens_org(2,i,j) = pres_org(2,i,j) / ( tsfc_org(i,j) * rdry )
       qtrc_org(1,i,j,:) = qtrc_org(2,i,j,:)
    end do
    end do

    return
  end subroutine parentatominputscale

  !-----------------------------------------------------------------------------
  subroutine parentlandsetupscale( &
       ldims )
    implicit none

    integer, intent(out) :: ldims(3)

    integer :: i
    !---------------------------------------------------------------------------

    if( io_l ) write(io_fid_log,*) '+++ Real Case/Land Input File Type: SCALE-RM'
    ldims(1) = parent_lkmax(handle)
    ldims(2) = parent_imax(handle) * nest_tile_num_x
    ldims(3) = parent_jmax(handle) * nest_tile_num_y

    if ( .not. allocated(read2d) ) then
       allocate( read2d( parent_imax(handle), parent_jmax(handle) ) )
    end if
    allocate( read3dl( parent_imax(handle), parent_jmax(handle), ldims(1) ) )

    return
  end subroutine parentlandsetupscale

  !-----------------------------------------------------------------------------
  subroutine parentlandinputscale( &
      tg_org,             &
      strg_org,           &
      lst_org,            &
      ust_org,            &
      albg_org,           &
      topo_org,           &
      lmask_org,          &
      llon_org,           &
      llat_org,           &
      lz_org,             &
      basename_land,      &
      ldims,              &
      use_file_landwater, &
      it                  )
    use gtool_file, only: &
         fileread
    use scale_const, only: &
         d2r => const_d2r
    implicit none

    real(RP), intent(out) :: tg_org(:,:,:)
    real(RP), intent(out) :: strg_org(:,:,:)
    real(RP), intent(out) :: lst_org(:,:)
    real(RP), intent(out) :: ust_org(:,:)
    real(RP), intent(out) :: albg_org(:,:,:)
    real(RP), intent(out) :: topo_org(:,:)
    real(RP), intent(out) :: lmask_org(:,:)
    real(RP), intent(out) :: llon_org(:,:)
    real(RP), intent(out) :: llat_org(:,:)
    real(RP), intent(out) :: lz_org(:)

    character(len=*), intent(in) :: basename_land
    integer,          intent(in) :: ldims(3)
    logical,          intent(in) :: use_file_landwater   ! use land water data from files
    integer,          intent(in) :: it

    integer :: rank

    integer :: k, i, j, n
    integer :: xloc, yloc
    integer :: xs, xe
    integer :: ys, ye
    !---------------------------------------------------------------------------

    if( io_l ) write(io_fid_log,*) '+++ ScaleLib/IO[realinput]/Categ[LandInputSCALE]'

    do i = 1, size( nest_tile_id(:) )
       ! read data from split files
       rank = nest_tile_id(i)

       xloc = mod( i-1, nest_tile_num_x ) + 1
       yloc = int( real(i-1) / real(NEST_TILE_NUM_X) ) + 1

       xs = parent_imax(handle) * (xloc-1) + 1
       xe = parent_imax(handle) * xloc
       ys = parent_jmax(handle) * (yloc-1) + 1
       ye = parent_jmax(handle) * yloc

       call fileread( read3dl(:,:,:), basename_land, "LAND_TEMP",  it, rank )
       do k = 1, ldims(1)
         tg_org(k,xs:xe,ys:ye) = read3dl(:,:,k)
       end do

       if( use_file_landwater )then
          call fileread( read3dl(:,:,:), basename_land, "LAND_WATER", it, rank )
          do k = 1, ldims(1)
             strg_org(k,xs:xe,ys:ye) = read3dl(:,:,k)
          end do
       endif

       call fileread( read2d(:,:),   basename_land, "lon",        1, rank )
       llon_org(xs:xe,ys:ye)  = read2d(:,:) * d2r

       call fileread( read2d(:,:),   basename_land, "lat",        1, rank )
       llat_org(xs:xe,ys:ye)  = read2d(:,:) * d2r

       call fileread( read2d(:,:), basename_land, "LAND_SFC_TEMP",  it, rank )
       lst_org(xs:xe,ys:ye) = read2d(:,:)

       call fileread( read2d(:,:), basename_land, "URBAN_SFC_TEMP", it, rank )
       ust_org(xs:xe,ys:ye) = read2d(:,:)

       call fileread( read2d(:,:), basename_land, "LAND_ALB_LW",    it, rank )
       albg_org(xs:xe,ys:ye,1) = read2d(:,:)

       call fileread( read2d(:,:), basename_land, "LAND_ALB_SW",    it, rank )
       albg_org(xs:xe,ys:ye,2) = read2d(:,:)

       call fileread( read2d(:,:), basename_land, "topo",           it, rank )
       topo_org(xs:xe,ys:ye) = read2d(:,:)

       call fileread( read2d(:,:), basename_land, "lsmask",         it, rank )
       lmask_org(xs:xe,ys:ye) = read2d(:,:)

    end do

    call fileread( lz_org(:),   basename_land, "lz",  1, rank )

    return
  end subroutine parentlandinputscale

  !-----------------------------------------------------------------------------
  subroutine parentoceansetupscale( &
       odims )
    implicit none

    integer,          intent(out) :: odims(2)

    integer :: i
    !---------------------------------------------------------------------------

    if( io_l ) write(io_fid_log,*) '+++ Real Case/Ocean Input File Type: SCALE-RM'
    odims(1) = parent_imax(handle) * nest_tile_num_x
    odims(2) = parent_jmax(handle) * nest_tile_num_y

    if ( .not. allocated(read2d) ) then
       allocate( read2d( parent_imax(handle), parent_jmax(handle) ) )
    end if

    return
  end subroutine parentoceansetupscale

  !-----------------------------------------------------------------------------
  subroutine parentoceanopenscale( &
       olon_org,      &
       olat_org,      &
       omask_org, &
       basename_ocean, &
       odims          )
    use scale_const, only: &
         d2r => const_d2r
    use gtool_file, only: &
         fileread
    implicit none
    real(RP), intent(out) :: olon_org (:,:)
    real(RP), intent(out) :: olat_org (:,:)
    real(RP), intent(out) :: omask_org(:,:)
    character(len=*), intent(in)  :: basename_ocean
    integer,  intent(in)  :: odims(2)

    integer :: rank
    integer :: xloc, yloc
    integer :: xs, xe, ys, ye

    integer :: i, k

    if( io_l ) write(io_fid_log,*) '+++ ScaleLib/IO[realinput]/Categ[OceanOpenSCALE]'

    do i = 1, size( nest_tile_id(:) )
       ! read data from split files
       rank = nest_tile_id(i)

       xloc = mod( i-1, nest_tile_num_x ) + 1
       yloc = int( real(i-1) / real(NEST_TILE_NUM_X) ) + 1

       xs = parent_imax(handle) * (xloc-1) + 1
       xe = parent_imax(handle) * xloc
       ys = parent_jmax(handle) * (yloc-1) + 1
       ye = parent_jmax(handle) * yloc

       call fileread( read2d(:,:), basename_ocean, "lon",    1, rank )
       olon_org(xs:xe,ys:ye)  = read2d(:,:) * d2r

       call fileread( read2d(:,:), basename_ocean, "lat",    1, rank )
       olat_org(xs:xe,ys:ye)  = read2d(:,:) * d2r

       call fileread( read2d(:,:), basename_ocean, "lsmask", 1, rank )
       omask_org(xs:xe,ys:ye)  = read2d(:,:)

    end do

    return
  end subroutine parentoceanopenscale

  !-----------------------------------------------------------------------------
  subroutine parentoceaninputscale( &
      tw_org,         &
      sst_org,        &
      albw_org,       &
      z0w_org,        &
      omask_org,      &
      basename_ocean, &
      odims,          &
      it              )
    use gtool_file, only: &
         fileread
    implicit none

    real(RP), intent(out) :: tw_org(:,:)
    real(RP), intent(out) :: sst_org(:,:)
    real(RP), intent(out) :: albw_org(:,:,:)
    real(RP), intent(out) :: z0w_org(:,:)
    real(RP), intent(out) :: omask_org(:,:)

    character(len=*), intent(in) :: basename_ocean
    integer,          intent(in) :: odims(2)
    integer,          intent(in) :: it

    integer :: rank

    integer :: i, j, n
    integer :: xloc, yloc
    integer :: xs, xe
    integer :: ys, ye
    !---------------------------------------------------------------------------

    if( io_l ) write(io_fid_log,*) '+++ ScaleLib/IO[realinput]/Categ[OceanInputSCALE]'

    do i = 1, size( nest_tile_id(:) )
       ! read data from split files
       rank = nest_tile_id(i)

       xloc = mod( i-1, nest_tile_num_x ) + 1
       yloc = int( real(i-1) / real(NEST_TILE_NUM_X) ) + 1

       xs = parent_imax(handle) * (xloc-1) + 1
       xe = parent_imax(handle) * xloc
       ys = parent_jmax(handle) * (yloc-1) + 1
       ye = parent_jmax(handle) * yloc

       call fileread( read2d(:,:), basename_ocean, "OCEAN_TEMP",     it, rank )
       tw_org(xs:xe,ys:ye) = read2d(:,:)

       call fileread( read2d(:,:), basename_ocean, "OCEAN_SFC_TEMP", it, rank )
       sst_org(xs:xe,ys:ye) = read2d(:,:)

       call fileread( read2d(:,:), basename_ocean, "OCEAN_ALB_LW",   it, rank )
       albw_org(xs:xe,ys:ye,1) = read2d(:,:)

       call fileread( read2d(:,:), basename_ocean, "OCEAN_ALB_SW",   it, rank )
       albw_org(xs:xe,ys:ye,2) = read2d(:,:)

       call fileread( read2d(:,:), basename_ocean, "OCEAN_SFC_Z0M",  it, rank )
       z0w_org(xs:xe,ys:ye) = read2d(:,:)

       call fileread( read2d(:,:), basename_ocean, "lsmask",         it, rank )
       omask_org(xs:xe,ys:ye) = read2d(:,:)

    end do

    return
  end subroutine parentoceaninputscale

end module mod_realinput_scale