trunk/phylmd/suphec.f

module suphec_m

  implicit none

  ! A1.0 Fundamental constants
  REAL RPI
  real, parameter:: RCLUM = 299792458.
  real, parameter:: RHPLA = 6.6260755E-34
  real, parameter:: KBOL = 1.380658E-23 ! Boltzmann constant, in J K-1
  real, parameter:: NAVO = 6.0221367E23 ! Avogadro number, in mol-1

  ! 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, parameter:: RG = 9.80665 ! acceleration of gravity, in m s-2
  real, parameter:: RA = 6371229.

  ! A1.3 Radiation
  REAL RSIGMA

  ! A1.4 Thermodynamic gas phase
  REAL, parameter:: R = NAVO * KBOL ! ideal gas constant, in J K-1 mol-1
  real, parameter:: MV = 18.0153 ! molar mass of water, in g mol-1

  real, parameter:: RV = 1e3 * R / MV
  ! specific ideal gas constant for water vapor, in J K-1 kg-1
  ! (factor 1e3: conversion from g to kg)

  real, parameter:: MD = 28.9644 ! molar mass of dry air, in g mol-1

  real, parameter:: RD = 1e3 * R / MD
  ! specific ideal gas constant for dry air, in J K-1 kg-1
  ! (factor 1e3: conversion from g to kg)

  real RCPV, RCVD, RCVV

  real, parameter:: RCPD = 7. / 2 * RD 
  ! specific heat capacity for dry air, in J K-1 kg-1

  real, parameter:: RMO3 = 47.9942
  REAL, parameter:: RKAPPA = RD/RCPD
  real 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 = 1e5

  ! 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, version 1.2 2005/06/06 13:16:33
    ! Initialise certaines constantes et certains paramètres 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

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

    print *, ' Geoide '
    print '('' Gravity = '', E13.7, '' m s-2'')', RG
    print '('' Earth radius = '', E13.7, '' m'')', RA

    ! 4. DEFINE RADIATION CONSTANTS.

    rsigma = 2.*rpi**5 * (kbol/rhpla)**3 * kbol/rclum/rclum/15.
    print *, ' Radiation '
    print '('' Stefan-Bol. = '', E13.7, '' W m-2 K-4'')', RSIGMA

    ! 5. DEFINE THERMODYNAMIC CONSTANTS, GAS PHASE.

    RCVD = RCPD-RD
    RCPV = 4. * RV
    RCVV = RCPV-RV
    RETV = RV / RD - 1.
    print *, 'Thermodynamics, gas'
    print '('' Ozone mass = '', e13.7)', RMO3
    print *, "rd = ", RD, "J K-1 kg-1"
    print *, "rv = ", RV, "J K-1 kg-1"
    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, transition of phase:'
    print '('' Fusion point = '', E13.7)', RTT
    print '('' RLvTt = '', E13.7)', RLVTT
    print '('' RLsTt = '', E13.7)', RLSTT
    print '('' RLMlt = '', E13.7)', RLMLT
    print '('' Normal pressure = '', 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:: KBOL = 1.380658E-23 ! Boltzmann constant, in J K-1
10	real, parameter:: NAVO = 6.0221367E23 ! Avogadro number, in mol-1
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, parameter:: RG = 9.80665 ! acceleration of gravity, in m s-2
20	real, parameter:: RA = 6371229.
21
22	! A1.3 Radiation
23	REAL RSIGMA
24
25	! A1.4 Thermodynamic gas phase
26	REAL, parameter:: R = NAVO * KBOL ! ideal gas constant, in J K-1 mol-1
27	real, parameter:: MV = 18.0153 ! molar mass of water, in g mol-1
28
29	real, parameter:: RV = 1e3 * R / MV
30	! specific ideal gas constant for water vapor, in J K-1 kg-1
31	! (factor 1e3: conversion from g to kg)
32
33	real, parameter:: MD = 28.9644 ! molar mass of dry air, in g mol-1
34
35	real, parameter:: RD = 1e3 * R / MD
36	! specific ideal gas constant for dry air, in J K-1 kg-1
37	! (factor 1e3: conversion from g to kg)
38
39	real RCPV, RCVD, RCVV
40
41	real, parameter:: RCPD = 7. / 2 * RD
42	! specific heat capacity for dry air, in J K-1 kg-1
43
44	real, parameter:: RMO3 = 47.9942
45	REAL, parameter:: RKAPPA = RD/RCPD
46	real RETV
47
48	! A1.5, 6 Thermodynamic liquid, solid phases
49	REAL RCW, RCS
50
51	! A1.7 Thermodynamic transition of phase
52	REAL RLMLT
53	real, parameter:: RTT = 273.16
54	real, parameter:: RLVTT = 2.5008E+6
55	real, parameter:: RLSTT = 2.8345E+6
56	real, parameter:: RATM = 1e5
57
58	! A1.8 Curve of saturation
59	REAL RALPW, RBETW, RGAMW, RALPS, RBETS, RGAMS
60	real, parameter:: RESTT = 611.14
61	REAL RALPD, RBETD, RGAMD
62
63	save
64
65	contains
66
67	SUBROUTINE suphec
68
69	! From phylmd/suphec.F, version 1.2 2005/06/06 13:16:33
70	! Initialise certaines constantes et certains paramètres physiques.
71
72	!------------------------------------------
73
74	PRINT *, 'Call sequence information: suphec'
75
76	! 1. DEFINE FUNDAMENTAL CONSTANTS
77
78	print *, 'Constants of the ICM'
79	RPI = 2.*ASIN(1.)
80	print *, 'Fundamental constants '
81	print '('' PI = '', E13.7, '' -'')', RPI
82	print '('' c = '', E13.7, ''m s-1'')', RCLUM
83	print '('' h = '', E13.7, ''J s'')', RHPLA
84
85	! 2. DEFINE ASTRONOMICAL CONSTANTS
86
87	RSIYEA = 365.25RDAY2.*RPI/6.283076
88	RSIDAY = RDAY/(1.+RDAY/RSIYEA)
89	ROMEGA = 2.*RPI/RSIDAY
90
91	print *, 'Astronomical constants '
92	print '('' day = '', E13.7, '' s'')', RDAY
93	print '('' half g. axis = '', E13.7, '' m'')', REA
94	print '('' mean anomaly = '', E13.7, '' -'')', REPSM
95	print '('' sideral year = '', E13.7, '' s'')', RSIYEA
96	print '('' sideral day = '', E13.7, '' s'')', RSIDAY
97	print '('' omega = '', E13.7, '' s-1'')', ROMEGA
98
99	! 3. DEFINE GEOIDE.
100
101	print *, ' Geoide '
102	print '('' Gravity = '', E13.7, '' m s-2'')', RG
103	print '('' Earth radius = '', E13.7, '' m'')', RA
104
105	! 4. DEFINE RADIATION CONSTANTS.
106
107	rsigma = 2.rpi5 (kbol/rhpla)*3 kbol/rclum/rclum/15.
108	print *, ' Radiation '
109	print '('' Stefan-Bol. = '', E13.7, '' W m-2 K-4'')', RSIGMA
110
111	! 5. DEFINE THERMODYNAMIC CONSTANTS, GAS PHASE.
112
113	RCVD = RCPD-RD
114	RCPV = 4. * RV
115	RCVV = RCPV-RV
116	RETV = RV / RD - 1.
117	print *, 'Thermodynamics, gas'
118	print '('' Ozone mass = '', e13.7)', RMO3
119	print *, "rd = ", RD, "J K-1 kg-1"
120	print *, "rv = ", RV, "J K-1 kg-1"
121	print '('' Cpd = '', e13.7)', RCPD
122	print '('' Cvd = '', e13.7)', RCVD
123	print '('' Cpv = '', e13.7)', RCPV
124	print '('' Cvv = '', e13.7)', RCVV
125	print '('' Rd/Cpd = '', e13.7)', RKAPPA
126	print '('' Rv / Rd - 1 = '', e13.7)', RETV
127
128	! 6. DEFINE THERMODYNAMIC CONSTANTS, LIQUID PHASE.
129
130	RCW = RCPV
131	print *, 'Thermodynamic, liquid '
132	print '('' Cw = '', E13.7)', RCW
133
134	! 7. DEFINE THERMODYNAMIC CONSTANTS, SOLID PHASE.
135
136	RCS = RCPV
137	print *, 'thermodynamic, solid'
138	print '('' Cs = '', E13.7)', RCS
139
140	! 8. DEFINE THERMODYNAMIC CONSTANTS, TRANSITION OF PHASE.
141
142	RLMLT = RLSTT-RLVTT
143	print *, 'Thermodynamic, transition of phase:'
144	print '('' Fusion point = '', E13.7)', RTT
145	print '('' RLvTt = '', E13.7)', RLVTT
146	print '('' RLsTt = '', E13.7)', RLSTT
147	print '('' RLMlt = '', E13.7)', RLMLT
148	print '('' Normal pressure = '', E13.7)', RATM
149
150	! 9. SATURATED VAPOUR PRESSURE.
151
152	RGAMW = (RCW-RCPV)/RV
153	RBETW = RLVTT/RV+RGAMW*RTT
154	RALPW = LOG(RESTT)+RBETW/RTT+RGAMW*LOG(RTT)
155	RGAMS = (RCS-RCPV)/RV
156	RBETS = RLSTT/RV+RGAMS*RTT
157	RALPS = LOG(RESTT)+RBETS/RTT+RGAMS*LOG(RTT)
158	RGAMD = RGAMS-RGAMW
159	RBETD = RBETS-RBETW
160	RALPD = RALPS-RALPW
161
162	END SUBROUTINE suphec
163
164	end module suphec_m