mod_cpl_admin.f90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
module mod_cpl_admin
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_stdio
  use scale_prof
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: cpl_admin_setup
  public :: cpl_admin_getscheme

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  logical, public :: cpl_sw ! do coupler calculation?

  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine cpl_admin_setup
    use scale_process, only: &
       prc_mpistop
    use mod_atmos_admin, only: &
       atmos_phy_sf_type, &
       atmos_sw_phy_sf
    use mod_ocean_admin, only: &
       ocean_sw
    use mod_land_admin, only: &
       land_sw
    use mod_urban_admin, only: &
       urban_sw
    use scale_landuse, only: &
       landuse_fact_ocean, &
       landuse_fact_land,  &
       landuse_fact_urban
    implicit none

    real(RP) :: checkfact
    !---------------------------------------------------------------------------

    if( io_l ) write(io_fid_log,*)
    if( io_l ) write(io_fid_log,*) '++++++ Module[ADMIN] / Categ[CPL] / Origin[SCALE-RM]'

    !-----< module component check >-----

    if( io_l ) write(io_fid_log,*)
    if( io_l ) write(io_fid_log,*) '*** Coupler components ***'

    ! Atoms-Ocean/Land/Urban Switch
    if ( ocean_sw .OR. land_sw .OR. urban_sw ) then
       cpl_sw = .true.
    else
       cpl_sw = .false.
    endif

    ! Check consistency of OCEAN_sw and LANDUSE_fact_ocean
    checkfact = maxval( landuse_fact_ocean(:,:) )
    if ( .NOT. ocean_sw .AND. checkfact > 0.0_rp ) then
       if( io_l ) write(io_fid_log,*) 'xxx Ocean fraction exists, but ocean components never called. STOP.', checkfact
       write(*,*)                     'xxx Ocean fraction exists, but ocean components never called. STOP.', checkfact
       call prc_mpistop
    endif

    ! Check consistency of LAND_sw and LANDUSE_fact_land
    checkfact = maxval( landuse_fact_land(:,:) )
    if ( .NOT. land_sw .AND. checkfact > 0.0_rp ) then
       if( io_l ) write(io_fid_log,*) 'xxx Land  fraction exists, but land  components never called. STOP.', checkfact
       write(*,*)                     'xxx Land  fraction exists, but land  components never called. STOP.', checkfact
       call prc_mpistop
    endif

    ! Check consistency of URBAN_sw and LANDUSE_fact_urban
    checkfact = maxval( landuse_fact_urban(:,:) )
    if ( .NOT. urban_sw .AND. checkfact > 0.0_rp ) then
       if( io_l ) write(io_fid_log,*) 'xxx URBAN fraction exists, but urban components never called. STOP.', checkfact
       write(*,*)                     'xxx URBAN fraction exists, but urban components never called. STOP.', checkfact
       call prc_mpistop
    endif

    ! Check Atmos_Surface setting
    if ( cpl_sw ) then
       if( io_l ) write(io_fid_log,*) '*** Coupler : ON'

       if ( atmos_phy_sf_type == 'COUPLE' ) then
          ! do nothing
       elseif( atmos_phy_sf_type == 'NONE' ) then
          if( io_l ) write(io_fid_log,*) '*** -> Surface Flux Type is forced to change from NONE to COUPLE.'
          ! overwrite
          atmos_phy_sf_type = 'COUPLE'
          atmos_sw_phy_sf   = .true.
       else
          if( io_l ) write(io_fid_log,*) '*** Surface Flux : ', trim(atmos_phy_sf_type)
          if( io_l ) write(io_fid_log,*) 'xxx Setting conflicts between coupler and surface flux! STOP.'
          write(*,*)                     'xxx Setting conflicts between coupler and surface flux! STOP.'
          call prc_mpistop
       endif
    else
       if( io_l ) write(io_fid_log,*) '*** Coupler : OFF'
    endif

    return
  end subroutine cpl_admin_setup

  !-----------------------------------------------------------------------------
  subroutine cpl_admin_getscheme
    implicit none
    !---------------------------------------------------------------------------

    return
  end subroutine cpl_admin_getscheme

end module mod_cpl_admin