source: CONFIG/publications/ICOLMDZORINCA_CO2_Transport_GMD_2023/INCA/src/INCA_SRC/suphel_inca.F90 @ 6610

!
! $Header$
!
SUBROUTINE suphel_I
  USE PRINT_INCA
#include "YOMCST_I.h"
#include "YOETHF_I.h"



  !IM cf. JLD
  LOGICAL firstcall
  SAVE firstcall
!$OMP THREADPRIVATE(firstcall)
  DATA firstcall /.TRUE./
  
  IF (firstcall) THEN
      WRITE(lunout,*) 'suphel initialise les constantes du GCM'
      firstcall = .FALSE.
  ELSE
      WRITE(lunout,*) 'suphel DEJA APPELE '
      RETURN
  ENDIF
  !      -----------------------------------------------------------------
  !
  !*       1.    DEFINE FUNDAMENTAL CONSTANTS.
  !              -----------------------------
  !
!  WRITE(UNIT=lunout,FMT='(''0*** Constants of the ICM   ***'')')
  RPI=2.*ASIN(1.)
  RCLUM=299792458.
  RHPLA=6.6260755E-34
  RKBOL=1.380658E-23
  RNAVO=6.0221367E+23
!  WRITE(UNIT=lunout,FMT='('' *** Fundamental constants ***'')')
!  WRITE(UNIT=lunout,FMT='(''           PI = '',E13.7,'' -'')')RPI
!  WRITE(UNIT=lunout,FMT='(''            c = '',E13.7,''m s-1'')') RCLUM
!  WRITE(UNIT=lunout,FMT='(''            h = '',E13.7,''J s'')') RHPLA
!  WRITE(UNIT=lunout,FMT='(''            K = '',E13.7,''J K-1'')') RKBOL
!  WRITE(UNIT=lunout,FMT='(''            N = '',E13.7,''mol-1'')') RNAVO
  
  !     ----------------------------------------------------------------
  !
  !*       2.    DEFINE ASTRONOMICAL CONSTANTS.
  !              ------------------------------
  !
  RDAY=86400.
  REA=149597870000.
  REPSM=0.409093
  
  RSIYEA=365.25*RDAY*2.*RPI/6.283076
  RSIDAY=RDAY/(1.+RDAY/RSIYEA)
  ROMEGA=2.*RPI/RSIDAY
!  WRITE(UNIT=lunout,FMT='('' *** Astronomical constants ***'')')
!  WRITE(UNIT=lunout,FMT='(''          day = '',E13.7,'' s'')')RDAY
!  WRITE(UNIT=lunout,FMT='('' half g. axis = '',E13.7,'' m'')')REA
!  WRITE(UNIT=lunout,FMT='('' mean anomaly = '',E13.7,'' -'')')REPSM
!  WRITE(UNIT=lunout,FMT='('' sideral year = '',E13.7,'' s'')')RSIYEA
!  WRITE(UNIT=lunout,FMT='(''  sideral day = '',E13.7,'' s'')')RSIDAY
!  WRITE(UNIT=lunout,FMT='(''        omega = '',E13.7,'' s-1'')')ROMEGA
  
  !     ------------------------------------------------------------------
  !
  !*       3.    DEFINE GEOIDE.
  !              --------------
  !
  RG=9.80665
  RA=6371229.
  R1SA=SNGL(1.D0/DBLE(RA))
!  WRITE(UNIT=lunout,FMT='('' ***         Geoide         ***'')')
!  WRITE(UNIT=lunout,FMT='(''      Gravity = '',E13.7,'' m s-2'')')RG
!  WRITE(UNIT=lunout,FMT='('' Earth radius = '',E13.7,'' m'')')RA
!  WRITE(UNIT=lunout,FMT='('' Inverse E.R. = '',E13.7,'' m'')')R1SA
  !
  !     -----------------------------------------------------------------
  !
  !*       4.    DEFINE RADIATION CONSTANTS.
  !              ---------------------------
  !
  ! z.x.li      RSIGMA=2. * RPI**5 * RKBOL**4 /(15.* RCLUM**2 * RHPLA**3)
  rsigma = 2.*rpi**5 * (rkbol/rhpla)**3 * rkbol/rclum/rclum/15.
!  WRITE(UNIT=lunout,FMT='('' ***        Radiation       ***'')')
!  WRITE(UNIT=lunout,FMT='('' Stefan-Bol.  = '',E13.7,'' W m-2 K-4'')')  RSIGMA
  !
  !     -----------------------------------------------------------------
  !
  !*       5.    DEFINE THERMODYNAMIC CONSTANTS, GAS PHASE.
  !              ------------------------------------------
  !
  R=RNAVO*RKBOL
  RMD=28.9644
  RMO3=47.9942
  RMV=18.0153
  RD=1000.*R/RMD
  RV=1000.*R/RMV
  RCPD=3.5*RD
  RCVD=RCPD-RD
  RCPV=4. *RV
  RCVV=RCPV-RV
  RKAPPA=RD/RCPD
  RETV=RV/RD-1.
!  WRITE(UNIT=lunout,FMT='('' *** Thermodynamic, gas     ***'')')
!  WRITE(UNIT=lunout,FMT='('' Perfect gas  = '',e13.7)') R
!  WRITE(UNIT=lunout,FMT='('' Dry air mass = '',e13.7)') RMD
!  WRITE(UNIT=lunout,FMT='('' Ozone   mass = '',e13.7)') RMO3
!  WRITE(UNIT=lunout,FMT='('' Vapour  mass = '',e13.7)') RMV
!  WRITE(UNIT=lunout,FMT='('' Dry air cst. = '',e13.7)') RD
!  WRITE(UNIT=lunout,FMT='('' Vapour  cst. = '',e13.7)') RV
!  WRITE(UNIT=lunout,FMT='(''         Cpd  = '',e13.7)') RCPD
!  WRITE(UNIT=lunout,FMT='(''         Cvd  = '',e13.7)') RCVD
!  WRITE(UNIT=lunout,FMT='(''         Cpv  = '',e13.7)') RCPV
!  WRITE(UNIT=lunout,FMT='(''         Cvv  = '',e13.7)') RCVV
!  WRITE(UNIT=lunout,FMT='(''      Rd/Cpd  = '',e13.7)') RKAPPA
!  WRITE(UNIT=lunout,FMT='(''     Rv/Rd-1  = '',e13.7)') RETV
  !
  !     ----------------------------------------------------------------
  !
  !*       6.    DEFINE THERMODYNAMIC CONSTANTS, LIQUID PHASE.
  !              ---------------------------------------------
  !
  RCW=RCPV
!  WRITE(UNIT=lunout,FMT='('' *** Thermodynamic, liquid  ***'')')
!  WRITE(UNIT=lunout,FMT='(''         Cw   = '',E13.7)') RCW
  !
  !     ----------------------------------------------------------------
  !
  !*       7.    DEFINE THERMODYNAMIC CONSTANTS, SOLID PHASE.
  !              --------------------------------------------
  !
  RCS=RCPV
!  WRITE(UNIT=lunout,FMT='('' *** thermodynamic, solid   ***'')')
!  WRITE(UNIT=lunout,FMT='(''         Cs   = '',E13.7)') RCS
  !
  !     ----------------------------------------------------------------
  !
  !*       8.    DEFINE THERMODYNAMIC CONSTANTS, TRANSITION OF PHASE.
  !              ----------------------------------------------------
  !
  RTT=273.16
  RLVTT=2.5008E+6
  RLSTT=2.8345E+6
  RLMLT=RLSTT-RLVTT
  RATM=100000.
!  WRITE(UNIT=lunout,FMT='('' *** Thermodynamic, trans.  ***'')')
!  WRITE(UNIT=lunout,FMT='('' Fusion point  = '',E13.7)') RTT
!  WRITE(UNIT=lunout,FMT='(''        RLvTt  = '',E13.7)') RLVTT
!  WRITE(UNIT=lunout,FMT='(''        RLsTt  = '',E13.7)') RLSTT
!  WRITE(UNIT=lunout,FMT='(''        RLMlt  = '',E13.7)') RLMLT
!  WRITE(UNIT=lunout,FMT='('' Normal press. = '',E13.7)') RATM
!  WRITE(UNIT=lunout,FMT='('' Latent heat :  '')')
  !
  !     ----------------------------------------------------------------
  !
  !*       9.    SATURATED VAPOUR PRESSURE.
  !              --------------------------
  !
  RESTT=611.14
  RGAMW=(RCW-RCPV)/RV
  RBETW=RLVTT/RV+RGAMW*RTT
  RALPW=LOG(RESTT)+RBETW/RTT+RGAMW*LOG(RTT)
  RGAMS=(RCS-RCPV)/RV
  RBETS=RLSTT/RV+RGAMS*RTT
  RALPS=LOG(RESTT)+RBETS/RTT+RGAMS*LOG(RTT)
  RGAMD=RGAMS-RGAMW
  RBETD=RBETS-RBETW
  RALPD=RALPS-RALPW
  !
  !     ------------------------------------------------------------------
  !
  ! calculer les constantes pour les fonctions thermodynamiques
  !
  RVTMP2=RCPV/RCPD-1.
  RHOH2O=RATM/100.
  R2ES=RESTT*RD/RV
  R3LES=17.269
  R3IES=21.875
  R4LES=35.86
  R4IES=7.66
  R5LES=R3LES*(RTT-R4LES)
  R5IES=R3IES*(RTT-R4IES)
  
  RETURN
END SUBROUTINE suphel_I