scale_urban_grid_cartesC.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "scalelib.h"
module scale_urban_grid_cartesc
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_io
  use scale_prof
  use scale_atmos_grid_cartesc_index
  use scale_urban_grid_cartesc_index
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: urban_grid_cartesc_setup
  public :: urban_grid_cartesc_finalize
 
  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  real(rp), public, allocatable :: urban_grid_cartesc_cz  (:)
  real(rp), public, allocatable :: urban_grid_cartesc_fz  (:)
  real(rp), public, allocatable :: urban_grid_cartesc_cdz (:)
 
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  private :: urban_grid_cartesc_read
  private :: urban_grid_cartesc_generate
 
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  real(rp), private :: udz(200)
 
  character(len=H_LONG) :: urban_grid_cartesc_in_basename  = ''
  logical               :: urban_grid_cartesc_in_aggregate
 
  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine urban_grid_cartesc_setup
    use scale_prc, only: &
       prc_abort
    use scale_file, only: &
       file_aggregate
    implicit none
 
    namelist / param_urban_grid_cartesc / &
       urban_grid_cartesc_in_basename,  &
       urban_grid_cartesc_in_aggregate, &
       udz
 
    integer :: ierr
    integer :: k
    !---------------------------------------------------------------------------
 
    log_newline
    log_info("URBAN_GRID_CARTESC_setup",*) 'Setup'
 
    if ( ukmax < 1 ) then
       log_info("URBAN_GRID_CARTESC_setup",*) 'Skip because UKMAX < 1'
       return
    end if
 
    udz(:) = 0.0_rp
 
    urban_grid_cartesc_in_aggregate = file_aggregate
 
    !--- read namelist
    rewind(io_fid_conf)
    read(io_fid_conf,nml=param_urban_grid_cartesc,iostat=ierr)
    if( ierr < 0 ) then !--- missing
       log_info("URBAN_GRID_CARTESC_setup",*) 'Not found namelist. Default used.'
    elseif( ierr > 0 ) then !--- fatal error
       log_error("URBAN_GRID_CARTESC_setup",*) 'Not appropriate names in namelist PARAM_URBAN_GRID_CARTESC. Check!'
       call prc_abort
    endif
    log_nml(param_urban_grid_cartesc)
 
    allocate( urban_grid_cartesc_cz(uks  :uke) )
    allocate( urban_grid_cartesc_fz(uks-1:uke) )
    allocate( urban_grid_cartesc_cdz(uks  :uke) )
    !$acc enter data create(URBAN_GRID_CARTESC_CZ,URBAN_GRID_CARTESC_FZ,URBAN_GRID_CARTESC_CDZ)
 
    log_newline
    log_info("URBAN_GRID_CARTESC_setup",*) 'Urban grid information '
 
    if ( urban_grid_cartesc_in_basename /= '' ) then
       call urban_grid_cartesc_read
    else
       log_info("URBAN_GRID_CARTESC_setup",*) 'Not found input grid file. Grid position is calculated.'
 
       call urban_grid_cartesc_generate
    endif
 
    if ( uke == uks ) then
       log_newline
       log_info("URBAN_GRID_CARTESC_setup",*) 'Single layer. LDZ = ', udz(1)
    else
       log_newline
       log_info("URBAN_GRID_CARTESC_setup",'(1x,A)') 'Vertical Coordinate'
       log_info_cont('(1x,A)')                  '|   k       z      zh      dz   k |'
       log_info_cont('(1x,A)')                  '|         [m]     [m]     [m]     |'
       k = uks-1
       log_info_cont('(1x,A,F8.3,A,I4,A)')      '|            ',urban_grid_cartesc_fz(k),'        ',k,' | Atmosphere interface'
       do k = uks, uke-1
       log_info_cont('(1x,A,I4,F8.3,A,F8.3,A)') '|',k,urban_grid_cartesc_cz(k),'        ',urban_grid_cartesc_cdz(k),'     | '
       log_info_cont('(1x,A,F8.3,A,I4,A)')      '|            ',urban_grid_cartesc_fz(k),'       |',k,' | '
       enddo
       k = uke
       log_info_cont('(1x,A,I4,F8.3,A,F8.3,A)') '|',k,urban_grid_cartesc_cz(k),'        ',urban_grid_cartesc_cdz(k),'     | '
       log_info_cont('(1x,A,F8.3,A,I4,A)')      '|            ',urban_grid_cartesc_fz(k),'        ',k,' | bedrock'
       log_info_cont('(1x,A)')                  '|=================================|'
    endif
 
    !$acc update device(URBAN_GRID_CARTESC_CZ,URBAN_GRID_CARTESC_FZ,URBAN_GRID_CARTESC_CDZ)
 
    return
  end subroutine urban_grid_cartesc_setup
 
  !-----------------------------------------------------------------------------
  subroutine urban_grid_cartesc_finalize
    implicit none
    !---------------------------------------------------------------------------
 
    log_newline
    log_info("URBAN_GRID_CARTESC_finalize",*) 'Finalize'
 
    !$acc exit data delete(URBAN_GRID_CARTESC_CZ,URBAN_GRID_CARTESC_FZ,URBAN_GRID_CARTESC_CDZ)
    deallocate( urban_grid_cartesc_cz  )
    deallocate( urban_grid_cartesc_fz  )
    deallocate( urban_grid_cartesc_cdz )
 
    return
  end subroutine urban_grid_cartesc_finalize
 
  !-----------------------------------------------------------------------------
  subroutine urban_grid_cartesc_read
    use scale_file, only: &
       file_open, &
       file_read
    use scale_prc, only: &
       prc_myrank
    implicit none
 
    integer :: fid
    !---------------------------------------------------------------------------
 
    log_newline
    log_info("URBAN_GRID_CARTESC_read",*) 'Input urban grid file '
 
    call file_open( urban_grid_cartesc_in_basename, fid, rankid=prc_myrank, aggregate=urban_grid_cartesc_in_aggregate )
 
    call file_read( fid, 'UCZ',  urban_grid_cartesc_cz(:)  )
    call file_read( fid, 'UCDZ', urban_grid_cartesc_cdz(:) )
    call file_read( fid, 'UFZ',  urban_grid_cartesc_fz(:)  )
 
    return
  end subroutine urban_grid_cartesc_read
 
  !-----------------------------------------------------------------------------
  subroutine urban_grid_cartesc_generate
    implicit none
 
    integer :: k
    !---------------------------------------------------------------------------
 
    do k = uks, uke
       urban_grid_cartesc_cdz(k) = udz(k)
    enddo
 
    urban_grid_cartesc_fz(uks-1) = 0.0_rp
 
    do k = uks, uke
       urban_grid_cartesc_cz(k) = urban_grid_cartesc_cdz(k) / 2.0_rp + urban_grid_cartesc_fz(k-1)
       urban_grid_cartesc_fz(k) = urban_grid_cartesc_cdz(k)          + urban_grid_cartesc_fz(k-1)
    enddo
 
    return
  end subroutine urban_grid_cartesc_generate
 
end module scale_urban_grid_cartesc