/[lmdze]/trunk/Sources/phylmd/suphec.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/suphec.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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