suphel.F90

Go to the documentation of this file.

! $Id$

SUBROUTINE suphel

  include "YOMCST.h"
  include "YOETHF.h"
  ! IM cf. JLD
  LOGICAL firstcall
  SAVE firstcall
  !$OMP THREADPRIVATE(firstcall)
  DATA firstcall/.true./

  IF (firstcall) THEN
    print *, 'suphel initialise les constantes du GCM'
    firstcall = .false.
  ELSE
    print *, 'suphel DEJA APPELE '
    RETURN
  END IF
  ! -----------------------------------------------------------------

  ! *       1.    DEFINE FUNDAMENTAL CONSTANTS.
  ! -----------------------------

  WRITE (unit=6, 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=6, fmt='('' *** Fundamental constants ***'')')
  WRITE (unit=6, fmt='(''           PI = '',E13.7,'' -'')') rpi
  WRITE (unit=6, fmt='(''            c = '',E13.7,''m s-1'')') rclum
  WRITE (unit=6, fmt='(''            h = '',E13.7,''J s'')') rhpla
  WRITE (unit=6, fmt='(''            K = '',E13.7,''J K-1'')') rkbol
  WRITE (unit=6, 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

  ! exp1      R_ecc = 0.05
  ! exp1      R_peri = 102.04
  ! exp1      R_incl = 22.5
  ! exp1      print*, 'Parametres orbitaux modifies'
  ! ref      R_ecc = 0.016724
  ! ref      R_peri = 102.04
  ! ref      R_incl = 23.5

  ! IM 161002 : pour avoir les ctes AMIP II
  ! IM 161002   R_ecc = 0.016724
  ! IM 161002   R_peri = 102.04
  ! IM 161002   R_incl = 23.5
  ! IM on mets R_ecc, R_peri, R_incl dans conf_phys.F90
  ! R_ecc = 0.016715
  ! R_peri = 102.7
  ! R_incl = 23.441

  WRITE (unit=6, fmt='('' *** Astronomical constants ***'')')
  WRITE (unit=6, fmt='(''          day = '',E13.7,'' s'')') rday
  WRITE (unit=6, fmt='('' half g. axis = '',E13.7,'' m'')') rea
  WRITE (unit=6, fmt='('' mean anomaly = '',E13.7,'' -'')') repsm
  WRITE (unit=6, fmt='('' sideral year = '',E13.7,'' s'')') rsiyea
  WRITE (unit=6, fmt='(''  sideral day = '',E13.7,'' s'')') rsiday
  WRITE (unit=6, fmt='(''        omega = '',E13.7,'' s-1'')') romega
  ! write(unit=6,fmt='('' excentricite = '',e13.7,''-'')')R_ecc
  ! write(unit=6,fmt='(''     equinoxe = '',e13.7,''-'')')R_peri
  ! write(unit=6,fmt='(''  inclinaison = '',e13.7,''-'')')R_incl

  ! ------------------------------------------------------------------

  ! *       3.    DEFINE GEOIDE.
  ! --------------

  rg = 9.80665
  ra = 6371229.
  r1sa = sngl(1.d0/dble(ra))
  WRITE (unit=6, fmt='('' ***         Geoide         ***'')')
  WRITE (unit=6, fmt='(''      Gravity = '',E13.7,'' m s-2'')') rg
  WRITE (unit=6, fmt='('' Earth radius = '',E13.7,'' m'')') ra
  WRITE (unit=6, 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.
  ! IM init. dans conf_phys.F90   RI0=1365.
  WRITE (unit=6, fmt='('' ***        Radiation       ***'')')
  WRITE (unit=6, fmt='('' Stefan-Bol.  = '',E13.7,'' W m-2 K-4'' &
    &                                                         &
    &         )') rsigma
  ! IM init. dans conf_phys.F90   WRITE(UNIT=6,FMT='('' Solar const. =
  ! '',E13.7,'' W m-2'')')
  ! IM init. dans conf_phys.F90  S      RI0

  ! -----------------------------------------------------------------

  ! *       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=6, fmt='('' *** Thermodynamic, gas     ***'')')
  WRITE (unit=6, fmt='('' Perfect gas  = '',e13.7)') r
  WRITE (unit=6, fmt='('' Dry air mass = '',e13.7)') rmd
  WRITE (unit=6, fmt='('' Ozone   mass = '',e13.7)') rmo3
  WRITE (unit=6, fmt='('' Vapour  mass = '',e13.7)') rmv
  WRITE (unit=6, fmt='('' Dry air cst. = '',e13.7)') rd
  WRITE (unit=6, fmt='('' Vapour  cst. = '',e13.7)') rv
  WRITE (unit=6, fmt='(''         Cpd  = '',e13.7)') rcpd
  WRITE (unit=6, fmt='(''         Cvd  = '',e13.7)') rcvd
  WRITE (unit=6, fmt='(''         Cpv  = '',e13.7)') rcpv
  WRITE (unit=6, fmt='(''         Cvv  = '',e13.7)') rcvv
  WRITE (unit=6, fmt='(''      Rd/Cpd  = '',e13.7)') rkappa
  WRITE (unit=6, fmt='(''     Rv/Rd-1  = '',e13.7)') retv

  ! ----------------------------------------------------------------

  ! *       6.    DEFINE THERMODYNAMIC CONSTANTS, LIQUID PHASE.
  ! ---------------------------------------------

  rcw = rcpv
  WRITE (unit=6, fmt='('' *** Thermodynamic, liquid  ***'')')
  WRITE (unit=6, fmt='(''         Cw   = '',E13.7)') rcw

  ! ----------------------------------------------------------------

  ! *       7.    DEFINE THERMODYNAMIC CONSTANTS, SOLID PHASE.
  ! --------------------------------------------

  rcs = rcpv
  WRITE (unit=6, fmt='('' *** thermodynamic, solid   ***'')')
  WRITE (unit=6, 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=6, fmt='('' *** Thermodynamic, trans.  ***'')')
  WRITE (unit=6, fmt='('' Fusion point  = '',E13.7)') rtt
  WRITE (unit=6, fmt='(''        RLvTt  = '',E13.7)') rlvtt
  WRITE (unit=6, fmt='(''        RLsTt  = '',E13.7)') rlstt
  WRITE (unit=6, fmt='(''        RLMlt  = '',E13.7)') rlmlt
  WRITE (unit=6, fmt='('' Normal press. = '',E13.7)') ratm
  WRITE (unit=6, 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

  ! ------------------------------------------------------------------

  ! *       10.   CONSTANTS FOR THERMODYNAMICAL FUNCTIONS.
  ! ----------------------------------------

  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)

  ! ------------------------------------------------------------------

  ! *       10.   CONSTANTS FOR METHANE OXIDATION AND PHOTOLYSIS.
  ! -----------------------------------------------

  CALL sumethox()

  RETURN
END SUBROUTINE suphel