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

Diff of /trunk/phylmd/suphec.f

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

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