scale_land_grid.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
module scale_land_grid
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_stdio
  use scale_prof
  use scale_grid_index
  use scale_land_grid_index
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: land_grid_setup

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  real(RP), public, allocatable :: grid_lcz  (:)
  real(RP), public, allocatable :: grid_lfz  (:)
  real(RP), public, allocatable :: grid_lcdz (:)

  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  private :: land_grid_read
  private :: land_grid_generate

  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  real(RP), private :: ldz(100)

  character(len=H_LONG), private :: land_grid_in_basename  = ''
  character(len=H_LONG), private :: land_grid_out_basename = ''

  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine land_grid_setup
    use scale_process, only: &
       prc_mpistop
    implicit none

    namelist / param_land_grid / &
       land_grid_in_basename,  &
       land_grid_out_basename, &
       ldz

    integer :: ierr
    integer :: k

    !---------------------------------------------------------------------------

    if( io_l ) write(io_fid_log,*)
    if( io_l ) write(io_fid_log,*) '++++++ Module[GRID] / Categ[LAND GRID] / Origin[SCALElib]'

    ldz(:) = 0.0_rp

    !--- read namelist
    rewind(io_fid_conf)
    read(io_fid_conf,nml=param_land_grid,iostat=ierr)
    if( ierr < 0 ) then !--- missing
       if( io_l ) write(io_fid_log,*) '*** Not found namelist. Default used.'
    elseif( ierr > 0 ) then !--- fatal error
       write(*,*) 'xxx Not appropriate names in namelist PARAM_LAND_GRID. Check!'
       call prc_mpistop
    endif
    if( io_nml ) write(io_fid_nml,nml=param_land_grid)

    allocate( grid_lcz(lks  :lke) )
    allocate( grid_lfz(lks-1:lke) )
    allocate( grid_lcdz(lks  :lke) )

    if( io_l ) write(io_fid_log,*)
    if( io_l ) write(io_fid_log,*) '*** Land grid information ***'

    if ( land_grid_in_basename /= '' ) then
       call land_grid_read
    else
       if( io_l ) write(io_fid_log,*) '*** Not found input grid file. Grid position is calculated.'

       call land_grid_generate
    endif

    if ( lke == lks ) then
       if( io_l ) write(io_fid_log,*)
       if( io_l ) write(io_fid_log,*) '*** Single layer. LDZ = ', ldz(1)
    else
       if( io_l ) write(io_fid_log,*)
       if( io_l ) write(io_fid_log,'(1x,A)') &
       '|====== Vertical Coordinate ======|'
       if( io_l ) write(io_fid_log,'(1x,A)') &
       '|   k       z      zh      dz   k |'
       if( io_l ) write(io_fid_log,'(1x,A)') &
       '|         [m]     [m]     [m]     |'
       k = lks-1
       if( io_l ) write(io_fid_log,'(1x,A,F8.3,A,I4,A)') &
       '|            ',grid_lfz(k),'        ',k,' | Atmosphere interface'
       do k = lks, lke-1
       if( io_l ) write(io_fid_log,'(1x,A,I4,F8.3,A,F8.3,A)') &
       '|',k,grid_lcz(k),'        ',grid_lcdz(k),'     | '
       if( io_l ) write(io_fid_log,'(1x,A,F8.3,A,I4,A)') &
       '|            ',grid_lfz(k),'       |',k,' | '
       enddo
       k = lke
       if( io_l ) write(io_fid_log,'(1x,A,I4,F8.3,A,F8.3,A)') &
       '|',k,grid_lcz(k),'        ',grid_lcdz(k),'     | '
       if( io_l ) write(io_fid_log,'(1x,A,F8.3,A,I4,A)') &
       '|            ',grid_lfz(k),'        ',k,' | bedrock'
       if( io_l ) write(io_fid_log,'(1x,A)') &
       '|=================================|'
    endif

    return
  end subroutine land_grid_setup

  !-----------------------------------------------------------------------------
  subroutine land_grid_read
    use gtool_file, only: &
       fileread
    use scale_process, only: &
       prc_myrank, &
       prc_mpistop
    use scale_grid, only: &
       grid_cbfz, &
       grid_cbfx, &
       grid_cbfy
    implicit none

    character(len=H_LONG) :: bname
    real(RP) :: tmp_cbfz(ka), tmp_cbfx(ia), tmp_cbfy(ja)
    integer :: i, j, k
    !---------------------------------------------------------------------------

    if( io_l ) write(io_fid_log,*)
    if( io_l ) write(io_fid_log,*) '*** Input land grid file ***'

    write(bname,'(A,A,F15.3)') trim(land_grid_in_basename)

    call fileread( grid_lcz(:),  bname, 'LCZ',  1, prc_myrank )
    call fileread( grid_lcdz(:), bname, 'LCDZ', 1, prc_myrank )
    call fileread( grid_lfz(:),  bname, 'LFZ',  1, prc_myrank )

    call fileread( tmp_cbfz(:),  bname, 'CBFZ', 1, prc_myrank )
    call fileread( tmp_cbfx(:),  bname, 'CBFX', 1, prc_myrank )
    call fileread( tmp_cbfy(:),  bname, 'CBFY', 1, prc_myrank )

    do i = 1, ia
       if( tmp_cbfx(i) /= grid_cbfx(i) ) then
          write(*,*) 'xxx Buffer layer in LAND_GRID_IN_BASENAME is different from GRID_IN_BASENAME'
          call prc_mpistop
       endif
    enddo

    do j = 1, ja
       if( tmp_cbfy(j) /= grid_cbfy(j) ) then
          write(*,*) 'xxx Buffer layer in LAND_GRID_IN_BASENAME is different from GRID_IN_BASENAME'
          call prc_mpistop
       endif
    enddo

    do k = 1, ka
       if ( tmp_cbfz(k) /= grid_cbfz(k) ) then
          write(*,*) 'xxx Buffer layer in LAND_GRID_IN_BASENAME is different from GRID_IN_BASENAME'
          call prc_mpistop
       endif
    enddo

    return
  end subroutine land_grid_read

  !-----------------------------------------------------------------------------
  subroutine land_grid_generate
    implicit none

    integer :: k
    !---------------------------------------------------------------------------

    do k = lks, lke
       grid_lcdz(k) = ldz(k)
    enddo

    grid_lfz(lks-1) = 0.0_rp

    do k = lks, lke
       grid_lcz(k) = grid_lcdz(k) / 2.0_rp + grid_lfz(k-1)
       grid_lfz(k) = grid_lcdz(k)          + grid_lfz(k-1)
    enddo

    return
  end subroutine land_grid_generate

end module scale_land_grid