trunk/phylmd/suphec.f

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	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, only: r2es, r3ies, r3les, r4ies, r4les, r5ies, r5les, rhoh2o, &
19	rvtmp2
20
21	!------------------------------------------
22
23	PRINT *, 'Call sequence information: suphec'
24
25	! 1. DEFINE FUNDAMENTAL CONSTANTS
26
27	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
40	! 2. DEFINE ASTRONOMICAL CONSTANTS
41
42	RDAY=86400.
43	REA=149597870000.
44	REPSM=0.409093
45
46	RSIYEA=365.25RDAY2.*RPI/6.283076
47	RSIDAY=RDAY/(1.+RDAY/RSIYEA)
48	ROMEGA=2.*RPI/RSIDAY
49
50	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
58	! 3. DEFINE GEOIDE.
59
60	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
68	! 4. DEFINE RADIATION CONSTANTS.
69
70	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
74	! 5. DEFINE THERMODYNAMIC CONSTANTS, GAS PHASE.
75
76	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
102	! 6. DEFINE THERMODYNAMIC CONSTANTS, LIQUID PHASE.
103
104	RCW=RCPV
105	print *, 'Thermodynamic, liquid '
106	print '('' Cw = '',E13.7)', RCW
107
108	! 7. DEFINE THERMODYNAMIC CONSTANTS, SOLID PHASE.
109
110	RCS=RCPV
111	print *, 'thermodynamic, solid'
112	print '('' Cs = '',E13.7)', RCS
113
114	! 8. DEFINE THERMODYNAMIC CONSTANTS, TRANSITION OF PHASE.
115
116	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
128	! 9. SATURATED VAPOUR PRESSURE.
129
130	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
141	! calculer les constantes pour les fonctions thermodynamiques
142
143	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
153	END SUBROUTINE suphec
154
155	end module suphec_m