trunk/phylmd/suphec.f

module suphec_m

  use nr_util, only: pi

  implicit none

  ! A1.0 Fundamental constants
  real, parameter:: RCLUM = 299792458. ! speed of light, m s-1
  real, parameter:: RHPLA = 6.6260755E-34 ! Planck constant, J s
  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 ROMEGA
  real, parameter:: RDAY = 86400.

  REAL, parameter:: RSIYEA = 365.25 * RDAY * 2. * PI / 6.283076
  ! sideral year, in s

  REAL, parameter:: RSIDAY = RDAY / (1. + RDAY / RSIYEA) ! sideral day, in s

  ! A1.2 Geoide
  real, parameter:: RG = 9.80665 ! acceleration of gravity, in m s-2
  real, parameter:: RA = 6371229.

  ! A1.3 Radiation
  REAL, parameter:: rsigma = 2. * pi**5 * (kbol / rhpla)**3 * kbol / rclum**2 &
       / 15.

  ! 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, save:: 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, save:: RETV

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

  ! A1.7 Thermodynamic transition of phase
  REAL, save:: 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, save:: RALPW, RBETW, RGAMW, RALPS, RBETS, RGAMS
  real, parameter:: RESTT = 611.14
  REAL, save:: RALPD, RBETD, RGAMD

  private pi

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'

    ! 2. DEFINE ASTRONOMICAL CONSTANTS

    ROMEGA = 2.*PI/RSIDAY

    print *, 'Astronomical constants '
    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.

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