/[lmdze]/trunk/libf/phylmd/suphec.f90
ViewVC logotype

Diff of /trunk/libf/phylmd/suphec.f90

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

revision 37 by guez, Tue Dec 21 15:45:48 2010 UTC revision 38 by guez, Thu Jan 6 17:52:19 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 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  contains
51    
52    SUBROUTINE suphec    SUBROUTINE suphec
53    
54      ! 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
   
55      ! Initialise certaines constantes et parametres physiques.      ! Initialise certaines constantes et parametres physiques.
56    
     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  
   
57      !------------------------------------------      !------------------------------------------
58    
59      PRINT *, 'Call sequence information: suphec'      PRINT *, 'Call sequence information: suphec'
# Line 26  contains Line 62  contains
62    
63      print *, 'Constants of the ICM'      print *, 'Constants of the ICM'
64      RPI=2.*ASIN(1.)      RPI=2.*ASIN(1.)
     RCLUM=299792458.  
     RHPLA=6.6260755E-34  
     RKBOL=1.380658E-23  
     RNAVO=6.0221367E+23  
65      print *, 'Fundamental constants '      print *, 'Fundamental constants '
66      print '(''           PI = '',E13.7,'' -'')', RPI      print '(''           PI = '',E13.7,'' -'')', RPI
67      print '(''            c = '',E13.7,''m s-1'')', RCLUM      print '(''            c = '',E13.7,''m s-1'')', RCLUM
# Line 39  contains Line 71  contains
71    
72      ! 2. DEFINE ASTRONOMICAL CONSTANTS      ! 2. DEFINE ASTRONOMICAL CONSTANTS
73    
     RDAY=86400.  
     REA=149597870000.  
     REPSM=0.409093  
   
74      RSIYEA=365.25*RDAY*2.*RPI/6.283076      RSIYEA=365.25*RDAY*2.*RPI/6.283076
75      RSIDAY=RDAY/(1.+RDAY/RSIYEA)      RSIDAY=RDAY/(1.+RDAY/RSIYEA)
76      ROMEGA=2.*RPI/RSIDAY      ROMEGA=2.*RPI/RSIDAY
# Line 57  contains Line 85  contains
85    
86      ! 3.    DEFINE GEOIDE.      ! 3.    DEFINE GEOIDE.
87    
     RG=9.80665  
     RA=6371229.  
88      R1SA=SNGL(1.D0/DBLE(RA))      R1SA=SNGL(1.D0/DBLE(RA))
89      print *, '        Geoide      '      print *, '        Geoide      '
90      print '(''      Gravity = '',E13.7,'' m s-2'')', RG      print '(''      Gravity = '',E13.7,'' m s-2'')', RG
# Line 74  contains Line 100  contains
100      ! 5.    DEFINE THERMODYNAMIC CONSTANTS, GAS PHASE.      ! 5.    DEFINE THERMODYNAMIC CONSTANTS, GAS PHASE.
101    
102      R=RNAVO*RKBOL      R=RNAVO*RKBOL
     RMD=28.9644  
     RMO3=47.9942  
     RMV=18.0153  
103      RD=1000.*R/RMD      RD=1000.*R/RMD
104      RV=1000.*R/RMV      RV=1000.*R/RMV
105      RCPD=3.5*RD      RCPD=3.5*RD
# Line 113  contains Line 136  contains
136    
137      ! 8.    DEFINE THERMODYNAMIC CONSTANTS, TRANSITION OF PHASE.      ! 8.    DEFINE THERMODYNAMIC CONSTANTS, TRANSITION OF PHASE.
138    
     RTT=273.16  
     RLVTT=2.5008E+6  
     RLSTT=2.8345E+6  
139      RLMLT=RLSTT-RLVTT      RLMLT=RLSTT-RLVTT
     RATM=100000.  
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
# Line 127  contains Line 146  contains
146    
147      ! 9.    SATURATED VAPOUR PRESSURE.      ! 9.    SATURATED VAPOUR PRESSURE.
148    
     RESTT=611.14  
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)
# Line 138  contains Line 156  contains
156      RBETD=RBETS-RBETW      RBETD=RBETS-RBETW
157      RALPD=RALPS-RALPW      RALPD=RALPS-RALPW
158    
     ! 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)  
   
159    END SUBROUTINE suphec    END SUBROUTINE suphec
160    
161  end module suphec_m  end module suphec_m
Legend:
Removed from v.37  
changed lines
  Added in v.38
  ViewVC Help
Powered by ViewVC 1.1.21