libf/phylmd/suphec.f90

module suphec_m

  implicit none

  ! A1.0 Fundamental constants
  REAL RPI
  real, parameter::    RCLUM=299792458.
  real, parameter::    RHPLA=6.6260755E-34
  real, parameter::    RKBOL=1.380658E-23
  real, parameter::    RNAVO=6.0221367E+23

  ! A1.1 Astronomical constants
  REAL RSIYEA,RSIDAY,ROMEGA
  real, parameter::    RDAY=86400.
  real, parameter::    REA=149597870000.
  real, parameter::    REPSM=0.409093

  ! A1.2 Geoide
  REAL R1SA
  real, parameter::    RG=9.80665
  real, parameter::    RA=6371229.

  ! A1.3 Radiation
  REAL RSIGMA

  ! A1.4 Thermodynamic gas phase
  REAL R,RD,RV,RCPD,RCPV,RCVD,RCVV
  real, parameter::    RMD=28.9644
  real, parameter::    RMO3=47.9942
  real, parameter::    RMV=18.0153
  REAL RKAPPA,RETV

  ! A1.5,6 Thermodynamic liquid,solid phases
  REAL RCW,RCS

  ! A1.7 Thermodynamic transition of phase
  REAL RLMLT
  real, parameter::    RTT=273.16
  real, parameter::    RLVTT=2.5008E+6
  real, parameter::    RLSTT=2.8345E+6
  real, parameter::    RATM=100000.

  ! A1.8 Curve of saturation
  REAL RALPW,RBETW,RGAMW,RALPS,RBETS,RGAMS
  real, parameter::    RESTT=611.14
  REAL RALPD,RBETD,RGAMD

  save

contains

  SUBROUTINE suphec

    ! From phylmd/suphec.F,v 1.2 2005/06/06 13:16:33
    ! Initialise certaines constantes et parametres physiques.

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

    PRINT *, 'Call sequence information: suphec'

    ! 1. DEFINE FUNDAMENTAL CONSTANTS

    print *, 'Constants of the ICM'
    RPI=2.*ASIN(1.)
    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

    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.

    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
    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.

    RLMLT=RLSTT-RLVTT
    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.

    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

  END SUBROUTINE suphec

end module suphec_m
1	module suphec_m
2
3	implicit none
4
5	! A1.0 Fundamental constants
6	REAL RPI
7	real, parameter:: RCLUM=299792458.
8	real, parameter:: RHPLA=6.6260755E-34
9	real, parameter:: RKBOL=1.380658E-23
10	real, parameter:: RNAVO=6.0221367E+23
11
12	! A1.1 Astronomical constants
13	REAL RSIYEA,RSIDAY,ROMEGA
14	real, parameter:: RDAY=86400.
15	real, parameter:: REA=149597870000.
16	real, parameter:: REPSM=0.409093
17
18	! A1.2 Geoide
19	REAL R1SA
20	real, parameter:: RG=9.80665
21	real, parameter:: RA=6371229.
22
23	! A1.3 Radiation
24	REAL RSIGMA
25
26	! A1.4 Thermodynamic gas phase
27	REAL R,RD,RV,RCPD,RCPV,RCVD,RCVV
28	real, parameter:: RMD=28.9644
29	real, parameter:: RMO3=47.9942
30	real, parameter:: RMV=18.0153
31	REAL RKAPPA,RETV
32
33	! A1.5,6 Thermodynamic liquid,solid phases
34	REAL RCW,RCS
35
36	! A1.7 Thermodynamic transition of phase
37	REAL RLMLT
38	real, parameter:: RTT=273.16
39	real, parameter:: RLVTT=2.5008E+6
40	real, parameter:: RLSTT=2.8345E+6
41	real, parameter:: RATM=100000.
42
43	! A1.8 Curve of saturation
44	REAL RALPW,RBETW,RGAMW,RALPS,RBETS,RGAMS
45	real, parameter:: RESTT=611.14
46	REAL RALPD,RBETD,RGAMD
47
48	save
49
50	contains
51
52	SUBROUTINE suphec
53
54	! From phylmd/suphec.F,v 1.2 2005/06/06 13:16:33
55	! Initialise certaines constantes et parametres physiques.
56
57	!------------------------------------------
58
59	PRINT *, 'Call sequence information: suphec'
60
61	! 1. DEFINE FUNDAMENTAL CONSTANTS
62
63	print *, 'Constants of the ICM'
64	RPI=2.*ASIN(1.)
65	print *, 'Fundamental constants '
66	print '('' PI = '',E13.7,'' -'')', RPI
67	print '('' c = '',E13.7,''m s-1'')', RCLUM
68	print '('' h = '',E13.7,''J s'')', RHPLA
69	print '('' K = '',E13.7,''J K-1'')', RKBOL
70	print '('' N = '',E13.7,''mol-1'')', RNAVO
71
72	! 2. DEFINE ASTRONOMICAL CONSTANTS
73
74	RSIYEA=365.25RDAY2.*RPI/6.283076
75	RSIDAY=RDAY/(1.+RDAY/RSIYEA)
76	ROMEGA=2.*RPI/RSIDAY
77
78	print *, 'Astronomical constants '
79	print '('' day = '',E13.7,'' s'')', RDAY
80	print '('' half g. axis = '',E13.7,'' m'')', REA
81	print '('' mean anomaly = '',E13.7,'' -'')', REPSM
82	print '('' sideral year = '',E13.7,'' s'')', RSIYEA
83	print '('' sideral day = '',E13.7,'' s'')', RSIDAY
84	print '('' omega = '',E13.7,'' s-1'')', ROMEGA
85
86	! 3. DEFINE GEOIDE.
87
88	R1SA=SNGL(1.D0/DBLE(RA))
89	print *, ' Geoide '
90	print '('' Gravity = '',E13.7,'' m s-2'')', RG
91	print '('' Earth radius = '',E13.7,'' m'')', RA
92	print '('' Inverse E.R. = '',E13.7,'' m'')', R1SA
93
94	! 4. DEFINE RADIATION CONSTANTS.
95
96	rsigma = 2.rpi5 (rkbol/rhpla)*3 rkbol/rclum/rclum/15.
97	print *, ' Radiation '
98	print '('' Stefan-Bol. = '',E13.7,'' W m-2 K-4'')', RSIGMA
99
100	! 5. DEFINE THERMODYNAMIC CONSTANTS, GAS PHASE.
101
102	R=RNAVO*RKBOL
103	RD=1000.*R/RMD
104	RV=1000.*R/RMV
105	RCPD=3.5*RD
106	RCVD=RCPD-RD
107	RCPV=4. *RV
108	RCVV=RCPV-RV
109	RKAPPA=RD/RCPD
110	RETV=RV/RD-1.
111	print *, 'Thermodynamic, gas '
112	print '('' Perfect gas = '',e13.7)', R
113	print '('' Dry air mass = '',e13.7)', RMD
114	print '('' Ozone mass = '',e13.7)', RMO3
115	print '('' Vapour mass = '',e13.7)', RMV
116	print '('' Dry air cst. = '',e13.7)', RD
117	print '('' Vapour cst. = '',e13.7)', RV
118	print '('' Cpd = '',e13.7)', RCPD
119	print '('' Cvd = '',e13.7)', RCVD
120	print '('' Cpv = '',e13.7)', RCPV
121	print '('' Cvv = '',e13.7)', RCVV
122	print '('' Rd/Cpd = '',e13.7)', RKAPPA
123	print '('' Rv/Rd-1 = '',e13.7)', RETV
124
125	! 6. DEFINE THERMODYNAMIC CONSTANTS, LIQUID PHASE.
126
127	RCW=RCPV
128	print *, 'Thermodynamic, liquid '
129	print '('' Cw = '',E13.7)', RCW
130
131	! 7. DEFINE THERMODYNAMIC CONSTANTS, SOLID PHASE.
132
133	RCS=RCPV
134	print *, 'thermodynamic, solid'
135	print '('' Cs = '',E13.7)', RCS
136
137	! 8. DEFINE THERMODYNAMIC CONSTANTS, TRANSITION OF PHASE.
138
139	RLMLT=RLSTT-RLVTT
140	print *, 'Thermodynamic, trans. '
141	print '('' Fusion point = '',E13.7)', RTT
142	print '('' RLvTt = '',E13.7)', RLVTT
143	print '('' RLsTt = '',E13.7)', RLSTT
144	print '('' RLMlt = '',E13.7)', RLMLT
145	print '('' Normal press. = '',E13.7)', RATM
146
147	! 9. SATURATED VAPOUR PRESSURE.
148
149	RGAMW=(RCW-RCPV)/RV
150	RBETW=RLVTT/RV+RGAMW*RTT
151	RALPW=LOG(RESTT)+RBETW/RTT+RGAMW*LOG(RTT)
152	RGAMS=(RCS-RCPV)/RV
153	RBETS=RLSTT/RV+RGAMS*RTT
154	RALPS=LOG(RESTT)+RBETS/RTT+RGAMS*LOG(RTT)
155	RGAMD=RGAMS-RGAMW
156	RBETD=RBETS-RBETW
157	RALPD=RALPS-RALPW
158
159	END SUBROUTINE suphec
160
161	end module suphec_m