scale_const.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
module scale_const
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_stdio
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: const_setup

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  real(RP), public            :: const_pi      = 3.14159265358979_rp 
  real(RP), public            :: const_d2r
  real(RP), public            :: const_eps     = 1.e-16_rp           
  real(RP), public            :: const_eps1    = 0.99999999999999_rp 
  real(RP), public            :: const_huge    = 1.e+30_rp           

  integer,  public, parameter :: const_undef2  = -32768
  real(SP), public, parameter :: const_undef4  = -9.9999e30          
  real(DP), public, parameter :: const_undef8  = -9.9999d30          
  real(RP), public            :: const_undef

  ! adopted constants
  real(RP), public            :: const_radius  = 6.37122e+6_rp       
  real(RP), public            :: const_ohm     = 7.2920e-5_rp        
  real(RP), public            :: const_grav    = 9.80665_rp          

  ! physical constants
  real(RP), public, parameter :: const_stb     = 5.670373e-8_rp      
  real(RP), public, parameter :: const_karman  = 0.4_rp              
  real(RP), public, parameter :: const_r       = 8.3144621_rp        

  ! dry air constants
  real(RP), public            :: const_mdry    =   28.97_rp          
  real(RP), public            :: const_rdry    =  287.04_rp          
  real(RP), public            :: const_cpdry   = 1004.64_rp          
  real(RP), public            :: const_cvdry
  real(RP), public            :: const_laps    = 6.5e-3_rp           
  real(RP), public            :: const_lapsdry

  ! water constants
  real(RP), public            :: const_mvap    =  18.02_rp           
  real(RP), public, parameter :: const_rvap    = 461.46_rp           
  real(RP), public, parameter :: const_cpvap   = 1845.60_rp          
  real(RP), public            :: const_cvvap
  real(RP), public, parameter :: const_cl      = 4218.0_rp           
  real(RP), public, parameter :: const_ci      = 2006.0_rp           

  real(RP), public            :: const_epsvap
  real(RP), public            :: const_epstvap

  real(RP), public, parameter :: const_emelt   = 3.4e5_rp
  real(RP), public, parameter :: const_tmelt   = 273.15_rp

  real(RP), public            :: const_lhv
  real(RP), public            :: const_lhs
  real(RP), public            :: const_lhf
  real(RP), public, parameter :: const_lhv0    = 2.5008e6_rp         
  real(RP), public            :: const_lhv00
  real(RP), public, parameter :: const_lhs0    = 2.8342e6_rp         
  real(RP), public            :: const_lhs00
  real(RP), public            :: const_lhf0
  real(RP), public            :: const_lhf00
  real(RP), public, parameter :: const_psat0   =  610.7_rp           
  real(RP), public, parameter :: const_dwatr   = 1000.0_rp           
  real(RP), public, parameter :: const_dice    =  916.8_rp           

  real(RP), public            :: const_sound

  real(RP), public            :: const_pstd    = 101325.0_rp         
  real(RP), public            :: const_pre00   = 100000.0_rp         
  real(RP), public            :: const_tstd    = 288.15_rp           
  real(RP), public, parameter :: const_tem00   = 273.15_rp           
  real(RP), public, parameter :: const_ppm     = 1.e-6_rp            

  integer,  public            :: const_i_lw    = 1
  integer,  public            :: const_i_sw    = 2

  character(len=H_SHORT), public :: const_thermodyn_type = 'EXACT'

  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine const_setup
    use scale_process, only: &
       prc_mpistop
    implicit none

    real(RP) :: CONST_SmallPlanetFactor = 1.0_rp 

    namelist / param_const / &
       const_radius,           &
       const_ohm,              &
       const_grav,             &
       const_rdry,             &
       const_cpdry,            &
       const_laps,             &
       const_pstd,             &
       const_pre00,            &
       const_tstd,             &
       const_thermodyn_type,   &
       const_smallplanetfactor

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

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

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

    if    ( rp == sp ) then
       const_undef = real(const_undef4,kind=rp)
    elseif( rp == dp ) then
       const_undef = real(const_undef8,kind=rp)
    else
       write(*,*) 'xxx unsupported precision: ', rp
       call prc_mpistop
    endif

    const_pi      = 4.e0_rp * atan( 1.0_rp )
    const_d2r     = const_pi / 180.0_rp
    const_eps     =          epsilon(0.0_rp)
    const_eps1    = 1.0_rp - epsilon(0.0_rp)
    const_huge    =             huge(0.0_rp)

    const_radius  = const_radius / const_smallplanetfactor
    const_ohm     = const_ohm    * const_smallplanetfactor

    const_cvdry   = const_cpdry - const_rdry
    const_lapsdry = const_grav / const_cpdry

    const_cvvap   = const_cpvap - const_rvap
    const_epsvap  = const_rdry / const_rvap
    const_epstvap = 1.e0_rp / const_epsvap - 1.e0_rp

    const_lhf0    = const_lhs0 - const_lhv0

    const_lhv00   = const_lhv0 - ( const_cpvap - const_cl ) * const_tem00
    const_lhs00   = const_lhs0 - ( const_cpvap - const_ci ) * const_tem00
    const_lhf00   = const_lhf0 - ( const_cl    - const_ci ) * const_tem00

    if ( const_thermodyn_type == 'EXACT' ) then
       const_lhv = const_lhv00
       const_lhs = const_lhs00
       const_lhf = const_lhf00
    elseif( const_thermodyn_type == 'SIMPLE' ) then
       const_lhv = const_lhv0
       const_lhs = const_lhs0
       const_lhf = const_lhf0
    else
       write(*,*) 'xxx Not appropriate ATMOS_THERMODYN_ENERGY_TYPE. Check!', trim(const_thermodyn_type)
       call prc_mpistop
    endif

    const_sound = sqrt( const_cpdry * const_rdry / ( const_cpdry - const_rdry ) * const_tem00 )

    if( io_l ) write(io_fid_log,*)
    if( io_l ) write(io_fid_log,*) '*** List of constants ***'
    if( io_l ) write(io_fid_log,*) '*** PI                                                : PI      = ', const_pi
    if( io_l ) write(io_fid_log,*) '*** Small number                                      : EPS     = ', const_eps
    if( io_l ) write(io_fid_log,*) '*** Small number (1-EPS)                              : EPS1    = ', const_eps1
    if( io_l ) write(io_fid_log,*) '*** Huge  number                                      : HUGE    = ', const_huge
    if( io_l ) write(io_fid_log,*) '*** undefined number (INT2)                           : UNDEF2  = ', const_undef2
    if( io_l ) write(io_fid_log,*) '*** undefined number (REAL,general use)               : UNDEF   = ', const_undef
    if( io_l ) write(io_fid_log,*) '*** undefined number (REAL4)                          : UNDEF4  = ', const_undef4
    if( io_l ) write(io_fid_log,*) '*** undefined number (REAL8)                          : UNDEF8  = ', const_undef8

    if( io_l ) write(io_fid_log,*) '*** radius of the planet                          [m] : RADIUS  = ', const_radius
    if( io_l ) write(io_fid_log,*) '*** angular velocity of the planet              [1/s] : OHM     = ', const_ohm
    if( io_l ) write(io_fid_log,*) '*** standard acceleration of gravity           [m/s2] : GRAV    = ', const_grav

    if( io_l ) write(io_fid_log,*) '*** Stefan-Boltzman constant                [W/m2/K4] : STB     = ', const_stb
    if( io_l ) write(io_fid_log,*) '*** von Karman constant                               : KARMAN  = ', const_karman
    if( io_l ) write(io_fid_log,*) '*** universal gas constant                  [J/mol/K] : R       = ', const_r

    if( io_l ) write(io_fid_log,*) '*** mass weight (dry air)                     [g/mol] : Mdry    = ', const_mdry
    if( io_l ) write(io_fid_log,*) '*** specific gas constant (dry air)          [J/kg/K] : Rdry    = ', const_rdry
    if( io_l ) write(io_fid_log,*) '*** specific heat (dry air, const. pressure) [J/kg/K] : CPdry   = ', const_cpdry
    if( io_l ) write(io_fid_log,*) '*** specific heat (dry air, const. volume)   [J/kg/K] : Cvdry   = ', const_cvdry
    if( io_l ) write(io_fid_log,*) '*** lapse rate of ISA                           [K/m] : LAPS    = ', const_laps
    if( io_l ) write(io_fid_log,*) '*** dry adiabatic lapse rate                    [K/m] : LAPSdry = ', const_lapsdry

    if( io_l ) write(io_fid_log,*) '*** mass weight (water vapor)                 [g/mol] : Rvap    = ', const_rvap
    if( io_l ) write(io_fid_log,*) '*** specific gas constant (water vapor)      [J/kg/K] : Rvap    = ', const_rvap
    if( io_l ) write(io_fid_log,*) '*** specific heat (vapor, const. pressure)   [J/kg/K] : CPvap   = ', const_cpvap
    if( io_l ) write(io_fid_log,*) '*** specific heat (vapor, const. volume)     [J/kg/K] : CVvap   = ', const_cvvap
    if( io_l ) write(io_fid_log,*) '*** specific heat (liquid water)             [J/kg/K] : CL      = ', const_cl
    if( io_l ) write(io_fid_log,*) '*** specific heat (ice)                      [J/kg/K] : CI      = ', const_ci
    if( io_l ) write(io_fid_log,*) '*** Rdry / Rvap                                       : EPSvap  = ', const_epsvap
    if( io_l ) write(io_fid_log,*) '*** 1 / EPSvap - 1                                    : EPSTvap = ', const_epstvap

    if( io_l ) write(io_fid_log,*) '*** latent heat of vaporizaion at 0C           [J/kg] : LHV0    = ', const_lhv0
    if( io_l ) write(io_fid_log,*) '*** latent heat of sublimation at 0C           [J/kg] : LHS0    = ', const_lhs0
    if( io_l ) write(io_fid_log,*) '*** latent heat of fusion      at 0C           [J/kg] : LHF0    = ', const_lhf0
    if( io_l ) write(io_fid_log,*) '*** latent heat of vaporizaion at 0K           [J/kg] : LHV00   = ', const_lhv00
    if( io_l ) write(io_fid_log,*) '*** latent heat of sublimation at 0K           [J/kg] : LHS00   = ', const_lhs00
    if( io_l ) write(io_fid_log,*) '*** latent heat of fusion      at 0K           [J/kg] : LHF00   = ', const_lhf00
    if( io_l ) write(io_fid_log,*) '*** Thermodynamics calculation type : ', trim(const_thermodyn_type)
    if( io_l ) write(io_fid_log,*) '*** latent heat of vaporizaion (used)          [J/kg] : LHV     = ', const_lhv
    if( io_l ) write(io_fid_log,*) '*** latent heat of sublimation (used)          [J/kg] : LHS     = ', const_lhs
    if( io_l ) write(io_fid_log,*) '*** latent heat of fusion      (used)          [J/kg] : LHF     = ', const_lhf
    if( io_l ) write(io_fid_log,*) '*** saturate pressure of water vapor at 0C       [Pa] : PSAT0   = ', const_psat0
    if( io_l ) write(io_fid_log,*) '*** density of water                          [kg/m3] : DWATR   = ', const_dwatr
    if( io_l ) write(io_fid_log,*) '*** density of ice                            [kg/m3] : DICE    = ', const_dice

    if( io_l ) write(io_fid_log,*) '*** speed of sound (dry air at 0C)              [m/s] : SOUND   = ', const_sound
    if( io_l ) write(io_fid_log,*) '*** standard pressure                            [Pa] : Pstd    = ', const_pstd
    if( io_l ) write(io_fid_log,*) '*** pressure reference                           [Pa] : PRE00   = ', const_pre00
    if( io_l ) write(io_fid_log,*) '*** standard temperature (15C)                    [K] : Tstd    = ', const_tstd
    if( io_l ) write(io_fid_log,*) '*** temperature reference (0C)                    [K] : TEM00   = ', const_tem00

    return
  end subroutine const_setup

end module scale_const