libf/phylmd/suphec.f90

module suphec_m

  implicit none

contains

  SUBROUTINE suphec

    ! From phylmd/suphec.F,v 1.2 2005/06/06 13:16:33

    ! Initialise certaines constantes et parametres physiques.

    use YOMCST, only: rpi, rclum, rhpla, rkbol, rnavo, rday, rea, repsm, &
         rsiyea, rsiday,romega, rg, ra, r1sa, rsigma, r, rmd, rmo3, rmv, rd, &
         rv, rcpd, rcvd, rcpv, rcvv, rkappa, retv, rcw, rcs, rtt, rlvtt, &
         rlstt, rlmlt, ratm, restt, rgamw, rbetw, ralpw, rgams, rbets, ralps, &
         rgamd, rbetd, ralpd
    use yoethf, only: r2es, r3ies, r3les, r4ies, r4les, r5ies, r5les, rhoh2o, &
         rvtmp2

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

    PRINT *, 'Call sequence information: suphec'

    ! 1. DEFINE FUNDAMENTAL CONSTANTS

    print *, 'Constants of the ICM'
    RPI=2.*ASIN(1.)
    RCLUM=299792458.
    RHPLA=6.6260755E-34
    RKBOL=1.380658E-23
    RNAVO=6.0221367E+23
    print *, 'Fundamental constants '
    print '(''           PI = '',E13.7,'' -'')', RPI
    print '(''            c = '',E13.7,''m s-1'')', RCLUM
    print '(''            h = '',E13.7,''J s'')', RHPLA
    print '(''            K = '',E13.7,''J K-1'')', RKBOL
    print '(''            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

    print *, 'Astronomical constants '
    print '(''          day = '',E13.7,'' s'')', RDAY
    print '('' half g. axis = '',E13.7,'' m'')', REA
    print '('' mean anomaly = '',E13.7,'' -'')', REPSM
    print '('' sideral year = '',E13.7,'' s'')', RSIYEA
    print '(''  sideral day = '',E13.7,'' s'')', RSIDAY
    print '(''        omega = '',E13.7,'' s-1'')', ROMEGA

    ! 3.    DEFINE GEOIDE.

    RG=9.80665
    RA=6371229.
    R1SA=SNGL(1.D0/DBLE(RA))
    print *, '        Geoide      '
    print '(''      Gravity = '',E13.7,'' m s-2'')', RG
    print '('' Earth radius = '',E13.7,'' m'')', RA
    print '('' Inverse E.R. = '',E13.7,'' m'')', R1SA

    ! 4.    DEFINE RADIATION CONSTANTS.

    rsigma = 2.*rpi**5 * (rkbol/rhpla)**3 * rkbol/rclum/rclum/15.
    print *, '       Radiation    '
    print '('' 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.
    print *, 'Thermodynamic, gas  '
    print '('' Perfect gas  = '',e13.7)',  R
    print '('' Dry air mass = '',e13.7)',  RMD
    print '('' Ozone   mass = '',e13.7)',  RMO3
    print '('' Vapour  mass = '',e13.7)',  RMV
    print '('' Dry air cst. = '',e13.7)',  RD
    print '('' Vapour  cst. = '',e13.7)',  RV
    print '(''         Cpd  = '',e13.7)',  RCPD
    print '(''         Cvd  = '',e13.7)',  RCVD
    print '(''         Cpv  = '',e13.7)',  RCPV
    print '(''         Cvv  = '',e13.7)',  RCVV
    print '(''      Rd/Cpd  = '',e13.7)',  RKAPPA
    print '(''     Rv/Rd-1  = '',e13.7)',  RETV

    ! 6.    DEFINE THERMODYNAMIC CONSTANTS, LIQUID PHASE.

    RCW=RCPV
    print *, 'Thermodynamic, liquid  '
    print '(''         Cw   = '',E13.7)',  RCW

    ! 7.    DEFINE THERMODYNAMIC CONSTANTS, SOLID PHASE.

    RCS=RCPV
    print *, 'thermodynamic, solid'
    print '(''         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.
    print *, 'Thermodynamic, trans.  '
    print '('' Fusion point  = '',E13.7)',  RTT
    print '(''        RLvTt  = '',E13.7)',  RLVTT
    print '(''        RLsTt  = '',E13.7)',  RLSTT
    print '(''        RLMlt  = '',E13.7)',  RLMLT
    print '('' Normal press. = '',E13.7)',  RATM

    ! 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)

  END SUBROUTINE suphec

end module suphec_m
1	guez	3	module suphec_m
2
3			implicit none
4
5			contains
6
7			SUBROUTINE suphec
8
9			! From phylmd/suphec.F,v 1.2 2005/06/06 13:16:33
10
11			! Initialise certaines constantes et parametres physiques.
12
13			use YOMCST, only: rpi, rclum, rhpla, rkbol, rnavo, rday, rea, repsm, &
14			rsiyea, rsiday,romega, rg, ra, r1sa, rsigma, r, rmd, rmo3, rmv, rd, &
15			rv, rcpd, rcvd, rcpv, rcvv, rkappa, retv, rcw, rcs, rtt, rlvtt, &
16			rlstt, rlmlt, ratm, restt, rgamw, rbetw, ralpw, rgams, rbets, ralps, &
17			rgamd, rbetd, ralpd
18	guez	37	use yoethf, only: r2es, r3ies, r3les, r4ies, r4les, r5ies, r5les, rhoh2o, &
19			rvtmp2
20	guez	3
21			!------------------------------------------
22
23	guez	37	PRINT *, 'Call sequence information: suphec'
24	guez	17
25	guez	37	! 1. DEFINE FUNDAMENTAL CONSTANTS
26	guez	17
27	guez	37	print *, 'Constants of the ICM'
28			RPI=2.*ASIN(1.)
29			RCLUM=299792458.
30			RHPLA=6.6260755E-34
31			RKBOL=1.380658E-23
32			RNAVO=6.0221367E+23
33			print *, 'Fundamental constants '
34			print '('' PI = '',E13.7,'' -'')', RPI
35			print '('' c = '',E13.7,''m s-1'')', RCLUM
36			print '('' h = '',E13.7,''J s'')', RHPLA
37			print '('' K = '',E13.7,''J K-1'')', RKBOL
38			print '('' N = '',E13.7,''mol-1'')', RNAVO
39	guez	17
40	guez	37	! 2. DEFINE ASTRONOMICAL CONSTANTS
41	guez	17
42	guez	37	RDAY=86400.
43			REA=149597870000.
44			REPSM=0.409093
45	guez	17
46	guez	37	RSIYEA=365.25RDAY2.*RPI/6.283076
47			RSIDAY=RDAY/(1.+RDAY/RSIYEA)
48			ROMEGA=2.*RPI/RSIDAY
49	guez	17
50	guez	37	print *, 'Astronomical constants '
51			print '('' day = '',E13.7,'' s'')', RDAY
52			print '('' half g. axis = '',E13.7,'' m'')', REA
53			print '('' mean anomaly = '',E13.7,'' -'')', REPSM
54			print '('' sideral year = '',E13.7,'' s'')', RSIYEA
55			print '('' sideral day = '',E13.7,'' s'')', RSIDAY
56			print '('' omega = '',E13.7,'' s-1'')', ROMEGA
57	guez	17
58	guez	37	! 3. DEFINE GEOIDE.
59	guez	17
60	guez	37	RG=9.80665
61			RA=6371229.
62			R1SA=SNGL(1.D0/DBLE(RA))
63			print *, ' Geoide '
64			print '('' Gravity = '',E13.7,'' m s-2'')', RG
65			print '('' Earth radius = '',E13.7,'' m'')', RA
66			print '('' Inverse E.R. = '',E13.7,'' m'')', R1SA
67	guez	17
68	guez	37	! 4. DEFINE RADIATION CONSTANTS.
69	guez	17
70	guez	37	rsigma = 2.rpi5 (rkbol/rhpla)*3 rkbol/rclum/rclum/15.
71			print *, ' Radiation '
72			print '('' Stefan-Bol. = '',E13.7,'' W m-2 K-4'')', RSIGMA
73	guez	3
74	guez	37	! 5. DEFINE THERMODYNAMIC CONSTANTS, GAS PHASE.
75	guez	17
76	guez	37	R=RNAVO*RKBOL
77			RMD=28.9644
78			RMO3=47.9942
79			RMV=18.0153
80			RD=1000.*R/RMD
81			RV=1000.*R/RMV
82			RCPD=3.5*RD
83			RCVD=RCPD-RD
84			RCPV=4. *RV
85			RCVV=RCPV-RV
86			RKAPPA=RD/RCPD
87			RETV=RV/RD-1.
88			print *, 'Thermodynamic, gas '
89			print '('' Perfect gas = '',e13.7)', R
90			print '('' Dry air mass = '',e13.7)', RMD
91			print '('' Ozone mass = '',e13.7)', RMO3
92			print '('' Vapour mass = '',e13.7)', RMV
93			print '('' Dry air cst. = '',e13.7)', RD
94			print '('' Vapour cst. = '',e13.7)', RV
95			print '('' Cpd = '',e13.7)', RCPD
96			print '('' Cvd = '',e13.7)', RCVD
97			print '('' Cpv = '',e13.7)', RCPV
98			print '('' Cvv = '',e13.7)', RCVV
99			print '('' Rd/Cpd = '',e13.7)', RKAPPA
100			print '('' Rv/Rd-1 = '',e13.7)', RETV
101	guez	17
102	guez	37	! 6. DEFINE THERMODYNAMIC CONSTANTS, LIQUID PHASE.
103	guez	17
104	guez	37	RCW=RCPV
105			print *, 'Thermodynamic, liquid '
106			print '('' Cw = '',E13.7)', RCW
107	guez	17
108	guez	37	! 7. DEFINE THERMODYNAMIC CONSTANTS, SOLID PHASE.
109	guez	17
110	guez	37	RCS=RCPV
111			print *, 'thermodynamic, solid'
112			print '('' Cs = '',E13.7)', RCS
113	guez	17
114	guez	37	! 8. DEFINE THERMODYNAMIC CONSTANTS, TRANSITION OF PHASE.
115	guez	17
116	guez	37	RTT=273.16
117			RLVTT=2.5008E+6
118			RLSTT=2.8345E+6
119			RLMLT=RLSTT-RLVTT
120			RATM=100000.
121			print *, 'Thermodynamic, trans. '
122			print '('' Fusion point = '',E13.7)', RTT
123			print '('' RLvTt = '',E13.7)', RLVTT
124			print '('' RLsTt = '',E13.7)', RLSTT
125			print '('' RLMlt = '',E13.7)', RLMLT
126			print '('' Normal press. = '',E13.7)', RATM
127	guez	17
128	guez	37	! 9. SATURATED VAPOUR PRESSURE.
129	guez	17
130	guez	37	RESTT=611.14
131			RGAMW=(RCW-RCPV)/RV
132			RBETW=RLVTT/RV+RGAMW*RTT
133			RALPW=LOG(RESTT)+RBETW/RTT+RGAMW*LOG(RTT)
134			RGAMS=(RCS-RCPV)/RV
135			RBETS=RLSTT/RV+RGAMS*RTT
136			RALPS=LOG(RESTT)+RBETS/RTT+RGAMS*LOG(RTT)
137			RGAMD=RGAMS-RGAMW
138			RBETD=RBETS-RBETW
139			RALPD=RALPS-RALPW
140	guez	17
141	guez	37	! calculer les constantes pour les fonctions thermodynamiques
142	guez	17
143	guez	37	RVTMP2=RCPV/RCPD-1.
144			RHOH2O=RATM/100.
145			R2ES=RESTT*RD/RV
146			R3LES=17.269
147			R3IES=21.875
148			R4LES=35.86
149			R4IES=7.66
150			R5LES=R3LES*(RTT-R4LES)
151			R5IES=R3IES*(RTT-R4IES)
152	guez	3
153			END SUBROUTINE suphec
154
155			end module suphec_m