scale_topography.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
module scale_topography
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_stdio
  use scale_prof
  use scale_grid_index
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: topo_setup
  public :: topo_fillhalo
  public :: topo_write

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  logical, public :: topo_exist = .false. 

  real(RP), public, allocatable :: topo_zsfc(:,:)

  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  private :: topo_read

  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  character(len=H_LONG), private :: topo_in_basename  = ''
  character(len=H_LONG), private :: topo_out_basename = ''
  character(len=H_MID),  private :: topo_out_title    = 'SCALE-RM TOPOGRAPHY'
  character(len=H_MID),  private :: topo_out_dtype    = 'DEFAULT'

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

    namelist / param_topo / &
       topo_in_basename,  &
       topo_out_basename, &
       topo_out_dtype

    integer :: ierr
    !---------------------------------------------------------------------------

    if( io_l ) write(io_fid_log,*)
    if( io_l ) write(io_fid_log,*) '++++++ Module[TOPOGRAPHY] / Categ[ATMOS-RM GRID] / Origin[SCALElib]'

    !--- read namelist
    rewind(io_fid_conf)
    read(io_fid_conf,nml=param_topo,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_TOPO. Check!'
       call prc_mpistop
    endif
    if( io_lnml ) write(io_fid_log,nml=param_topo)

    allocate( topo_zsfc(ia,ja) )
    topo_zsfc(:,:) = 0.0_rp

    ! read from file
    call topo_read

    return
  end subroutine topo_setup

  !-----------------------------------------------------------------------------
  subroutine topo_fillhalo( Zsfc )
    use scale_comm, only: &
       comm_vars8, &
       comm_wait
    implicit none
    real(RP), intent(inout), optional :: Zsfc(ia,ja)
    !---------------------------------------------------------------------------

    if ( present(zsfc) ) then
       call comm_vars8( zsfc(:,:), 1 )
       call comm_wait ( zsfc(:,:), 1 )
    else
       call comm_vars8( topo_zsfc(:,:), 1 )
       call comm_wait ( topo_zsfc(:,:), 1 )
    end if

    return
  end subroutine topo_fillhalo

  !-----------------------------------------------------------------------------
  subroutine topo_read
    use gtool_file, only: &
       fileread
    use scale_fileio, only: &
       fileio_read
    use scale_process, only: &
       prc_mpistop, &
       prc_myrank
    use scale_grid, only: &
       grid_cx, &
       grid_cy

    implicit none

    real(RP) :: tmp_CX(ia), tmp_CY(ja)
    real(RP) :: epsilon
    integer  :: i, j
    !---------------------------------------------------------------------------

    epsilon = 0.1_rp**(rp-1)

    if( io_l ) write(io_fid_log,*)
    if( io_l ) write(io_fid_log,*) '*** Input topography file ***'

    if ( topo_in_basename /= '' ) then

       call fileio_read( topo_zsfc(:,:),                        & ! [OUT]
                         topo_in_basename, 'TOPO', 'XY', step=1 ) ! [IN]

       call topo_fillhalo

       topo_exist = .true.

       call fileread( tmp_cx(:),  topo_in_basename, 'CX', 1, prc_myrank )
       call fileread( tmp_cy(:),  topo_in_basename, 'CY', 1, prc_myrank )

       do i = 1, ia
         if( abs(tmp_cx(i) - grid_cx(i)) > epsilon ) then
           write( io_fid_log,'(A)')  '*** X position in TOPO_IN_BASENAME is different from GRID_IN_BASENAME ***'
           write( io_fid_log,* )  "I", i, tmp_cx(i), grid_cx(i)
           call prc_mpistop
         endif
       enddo
       do j = 1, ja
         if( abs(tmp_cy(j) - grid_cy(j)) > epsilon ) then
           write( io_fid_log,'(A)')  '*** Y position in TOPO_IN_BASENAME is different from GRID_IN_BASENAME ***'
           write( io_fid_log,* )  "J", j, tmp_cy(j), grid_cy(j)
           call prc_mpistop
         endif
       enddo

    else
       if( io_l ) write(io_fid_log,*) '*** topography file is not specified.'

       topo_exist = .false.
    endif

    return
  end subroutine topo_read

  !-----------------------------------------------------------------------------
  subroutine topo_write
    use scale_fileio, only: &
       fileio_write
    implicit none
    !---------------------------------------------------------------------------

    if ( topo_out_basename /= '' ) then

       if( io_l ) write(io_fid_log,*)
       if( io_l ) write(io_fid_log,*) '*** Output topography file ***'

       call fileio_write( topo_zsfc(:,:), topo_out_basename, topo_out_title, & ! [IN]
                          'TOPO', 'Topography', 'm', 'XY',   topo_out_dtype, & ! [IN]
                          nozcoord=.true. )

    endif

    return
  end subroutine topo_write

end module scale_topography