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

    LOGICAL:: firstcall = .TRUE.

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

    IF (firstcall) THEN
       PRINT *, 'suphec initialise les constantes du GCM'
       firstcall = .FALSE.
       !
       !*       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
       !
       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
       !
       !*       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

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

    ELSE
       PRINT *, 'suphec DEJA APPELE '
    ENDIF

  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			use yoethf
19
20			LOGICAL:: firstcall = .TRUE.
21
22			!------------------------------------------
23
24			IF (firstcall) THEN
25			PRINT *, 'suphec initialise les constantes du GCM'
26			firstcall = .FALSE.
27			!
28			!* 1. DEFINE FUNDAMENTAL CONSTANTS.
29			!
30			WRITE(UNIT=6,FMT='(''0* Constants of the ICM *'')')
31			RPI=2.*ASIN(1.)
32			RCLUM=299792458.
33			RHPLA=6.6260755E-34
34			RKBOL=1.380658E-23
35			RNAVO=6.0221367E+23
36			WRITE(UNIT=6,FMT='('' * Fundamental constants *'')')
37			WRITE(UNIT=6,FMT='('' PI = '',E13.7,'' -'')')RPI
38			WRITE(UNIT=6,FMT='('' c = '',E13.7,''m s-1'')') &
39			RCLUM
40			WRITE(UNIT=6,FMT='('' h = '',E13.7,''J s'')') &
41			RHPLA
42			WRITE(UNIT=6,FMT='('' K = '',E13.7,''J K-1'')') &
43			RKBOL
44			WRITE(UNIT=6,FMT='('' N = '',E13.7,''mol-1'')') &
45			RNAVO
46			!
47			!
48			!* 2. DEFINE ASTRONOMICAL CONSTANTS.
49			!
50			RDAY=86400.
51			REA=149597870000.
52			REPSM=0.409093
53			!
54			RSIYEA=365.25RDAY2.*RPI/6.283076
55			RSIDAY=RDAY/(1.+RDAY/RSIYEA)
56			ROMEGA=2.*RPI/RSIDAY
57			!
58			WRITE(UNIT=6,FMT='('' * Astronomical constants *'')')
59			WRITE(UNIT=6,FMT='('' day = '',E13.7,'' s'')')RDAY
60			WRITE(UNIT=6,FMT='('' half g. axis = '',E13.7,'' m'')')REA
61			WRITE(UNIT=6,FMT='('' mean anomaly = '',E13.7,'' -'')')REPSM
62			WRITE(UNIT=6,FMT='('' sideral year = '',E13.7,'' s'')')RSIYEA
63			WRITE(UNIT=6,FMT='('' sideral day = '',E13.7,'' s'')')RSIDAY
64			WRITE(UNIT=6,FMT='('' omega = '',E13.7,'' s-1'')') &
65			ROMEGA
66			!
67			!* 3. DEFINE GEOIDE.
68			!
69			RG=9.80665
70			RA=6371229.
71			R1SA=SNGL(1.D0/DBLE(RA))
72			WRITE(UNIT=6,FMT='('' * Geoide *'')')
73			WRITE(UNIT=6,FMT='('' Gravity = '',E13.7,'' m s-2'')') &
74			RG
75			WRITE(UNIT=6,FMT='('' Earth radius = '',E13.7,'' m'')')RA
76			WRITE(UNIT=6,FMT='('' Inverse E.R. = '',E13.7,'' m'')')R1SA
77			!
78			!
79			!* 4. DEFINE RADIATION CONSTANTS.
80			!
81			! z.x.li RSIGMA=2. * RPI*5 RKBOL*4 /(15. RCLUM*2 RHPLA**3)
82			rsigma = 2.rpi5 (rkbol/rhpla)*3 rkbol/rclum/rclum/15.
83			!IM init. dans conf_phys.F90 RI0=1365.
84			WRITE(UNIT=6,FMT='('' * Radiation *'')')
85			WRITE(UNIT=6,FMT='('' Stefan-Bol. = '',E13.7,'' W m-2 K-4'')') RSIGMA
86
87			!
88			!* 5. DEFINE THERMODYNAMIC CONSTANTS, GAS PHASE.
89			!
90			R=RNAVO*RKBOL
91			RMD=28.9644
92			RMO3=47.9942
93			RMV=18.0153
94			RD=1000.*R/RMD
95			RV=1000.*R/RMV
96			RCPD=3.5*RD
97			RCVD=RCPD-RD
98			RCPV=4. *RV
99			RCVV=RCPV-RV
100			RKAPPA=RD/RCPD
101			RETV=RV/RD-1.
102			WRITE(UNIT=6,FMT='('' * Thermodynamic, gas *'')')
103			WRITE(UNIT=6,FMT='('' Perfect gas = '',e13.7)') R
104			WRITE(UNIT=6,FMT='('' Dry air mass = '',e13.7)') RMD
105			WRITE(UNIT=6,FMT='('' Ozone mass = '',e13.7)') RMO3
106			WRITE(UNIT=6,FMT='('' Vapour mass = '',e13.7)') RMV
107			WRITE(UNIT=6,FMT='('' Dry air cst. = '',e13.7)') RD
108			WRITE(UNIT=6,FMT='('' Vapour cst. = '',e13.7)') RV
109			WRITE(UNIT=6,FMT='('' Cpd = '',e13.7)') RCPD
110			WRITE(UNIT=6,FMT='('' Cvd = '',e13.7)') RCVD
111			WRITE(UNIT=6,FMT='('' Cpv = '',e13.7)') RCPV
112			WRITE(UNIT=6,FMT='('' Cvv = '',e13.7)') RCVV
113			WRITE(UNIT=6,FMT='('' Rd/Cpd = '',e13.7)') RKAPPA
114			WRITE(UNIT=6,FMT='('' Rv/Rd-1 = '',e13.7)') RETV
115			!
116			!
117			!* 6. DEFINE THERMODYNAMIC CONSTANTS, LIQUID PHASE.
118			!
119			RCW=RCPV
120			WRITE(UNIT=6,FMT='('' * Thermodynamic, liquid *'')')
121			WRITE(UNIT=6,FMT='('' Cw = '',E13.7)') RCW
122			!
123			!
124			!* 7. DEFINE THERMODYNAMIC CONSTANTS, SOLID PHASE.
125			!
126			RCS=RCPV
127			WRITE(UNIT=6,FMT='('' * thermodynamic, solid *'')')
128			WRITE(UNIT=6,FMT='('' Cs = '',E13.7)') RCS
129			!
130			!
131			!* 8. DEFINE THERMODYNAMIC CONSTANTS, TRANSITION OF PHASE.
132			!
133			RTT=273.16
134			RLVTT=2.5008E+6
135			RLSTT=2.8345E+6
136			RLMLT=RLSTT-RLVTT
137			RATM=100000.
138			WRITE(UNIT=6,FMT='('' * Thermodynamic, trans. *'')')
139			WRITE(UNIT=6,FMT='('' Fusion point = '',E13.7)') RTT
140			WRITE(UNIT=6,FMT='('' RLvTt = '',E13.7)') RLVTT
141			WRITE(UNIT=6,FMT='('' RLsTt = '',E13.7)') RLSTT
142			WRITE(UNIT=6,FMT='('' RLMlt = '',E13.7)') RLMLT
143			WRITE(UNIT=6,FMT='('' Normal press. = '',E13.7)') RATM
144			WRITE(UNIT=6,FMT='('' Latent heat : '')')
145			!
146			!
147			!* 9. SATURATED VAPOUR PRESSURE.
148			!
149			RESTT=611.14
150			RGAMW=(RCW-RCPV)/RV
151			RBETW=RLVTT/RV+RGAMW*RTT
152			RALPW=LOG(RESTT)+RBETW/RTT+RGAMW*LOG(RTT)
153			RGAMS=(RCS-RCPV)/RV
154			RBETS=RLSTT/RV+RGAMS*RTT
155			RALPS=LOG(RESTT)+RBETS/RTT+RGAMS*LOG(RTT)
156			RGAMD=RGAMS-RGAMW
157			RBETD=RBETS-RBETW
158			RALPD=RALPS-RALPW
159			!
160			!
161			! calculer les constantes pour les fonctions thermodynamiques
162			!
163			RVTMP2=RCPV/RCPD-1.
164			RHOH2O=RATM/100.
165			R2ES=RESTT*RD/RV
166			R3LES=17.269
167			R3IES=21.875
168			R4LES=35.86
169			R4IES=7.66
170			R5LES=R3LES*(RTT-R4LES)
171			R5IES=R3IES*(RTT-R4IES)
172
173			ELSE
174			PRINT *, 'suphec DEJA APPELE '
175			ENDIF
176
177			END SUBROUTINE suphec
178
179			end module suphec_m