/[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 3 by guez, Wed Feb 27 13:16:39 2008 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    
57      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  
58    
59      LOGICAL:: firstcall = .TRUE.      PRINT *, 'Call sequence information: suphec'
60    
61      !------------------------------------------      ! 1. DEFINE FUNDAMENTAL CONSTANTS
62    
63      IF (firstcall) THEN      print *, 'Constants of the ICM'
64         PRINT *, 'suphec initialise les constantes du GCM'      RPI=2.*ASIN(1.)
65         firstcall = .FALSE.      print *, 'Fundamental constants '
66         !      print '(''           PI = '',E13.7,'' -'')', RPI
67         !*       1.    DEFINE FUNDAMENTAL CONSTANTS.      print '(''            c = '',E13.7,''m s-1'')', RCLUM
68         !      print '(''            h = '',E13.7,''J s'')', RHPLA
69         WRITE(UNIT=6,FMT='(''0*** Constants of the ICM   ***'')')      print '(''            K = '',E13.7,''J K-1'')', RKBOL
70         RPI=2.*ASIN(1.)      print '(''            N = '',E13.7,''mol-1'')', RNAVO
71         RCLUM=299792458.  
72         RHPLA=6.6260755E-34      ! 2. DEFINE ASTRONOMICAL CONSTANTS
73         RKBOL=1.380658E-23  
74         RNAVO=6.0221367E+23      RSIYEA=365.25*RDAY*2.*RPI/6.283076
75         WRITE(UNIT=6,FMT='('' *** Fundamental constants ***'')')      RSIDAY=RDAY/(1.+RDAY/RSIYEA)
76         WRITE(UNIT=6,FMT='(''           PI = '',E13.7,'' -'')')RPI      ROMEGA=2.*RPI/RSIDAY
77         WRITE(UNIT=6,FMT='(''            c = '',E13.7,''m s-1'')') &  
78              RCLUM      print *, 'Astronomical constants '
79         WRITE(UNIT=6,FMT='(''            h = '',E13.7,''J s'')') &      print '(''          day = '',E13.7,'' s'')', RDAY
80              RHPLA      print '('' half g. axis = '',E13.7,'' m'')', REA
81         WRITE(UNIT=6,FMT='(''            K = '',E13.7,''J K-1'')') &      print '('' mean anomaly = '',E13.7,'' -'')', REPSM
82              RKBOL      print '('' sideral year = '',E13.7,'' s'')', RSIYEA
83         WRITE(UNIT=6,FMT='(''            N = '',E13.7,''mol-1'')') &      print '(''  sideral day = '',E13.7,'' s'')', RSIDAY
84              RNAVO      print '(''        omega = '',E13.7,'' s-1'')', ROMEGA
85         !  
86         !      ! 3.    DEFINE GEOIDE.
87         !*       2.    DEFINE ASTRONOMICAL CONSTANTS.  
88         !      R1SA=SNGL(1.D0/DBLE(RA))
89         RDAY=86400.      print *, '        Geoide      '
90         REA=149597870000.      print '(''      Gravity = '',E13.7,'' m s-2'')', RG
91         REPSM=0.409093      print '('' Earth radius = '',E13.7,'' m'')', RA
92         !      print '('' Inverse E.R. = '',E13.7,'' m'')', R1SA
93         RSIYEA=365.25*RDAY*2.*RPI/6.283076  
94         RSIDAY=RDAY/(1.+RDAY/RSIYEA)      ! 4.    DEFINE RADIATION CONSTANTS.
95         ROMEGA=2.*RPI/RSIDAY  
96         !      rsigma = 2.*rpi**5 * (rkbol/rhpla)**3 * rkbol/rclum/rclum/15.
97         WRITE(UNIT=6,FMT='('' *** Astronomical constants ***'')')      print *, '       Radiation    '
98         WRITE(UNIT=6,FMT='(''          day = '',E13.7,'' s'')')RDAY      print '('' Stefan-Bol.  = '',E13.7,'' W m-2 K-4'')',   RSIGMA
99         WRITE(UNIT=6,FMT='('' half g. axis = '',E13.7,'' m'')')REA  
100         WRITE(UNIT=6,FMT='('' mean anomaly = '',E13.7,'' -'')')REPSM      ! 5.    DEFINE THERMODYNAMIC CONSTANTS, GAS PHASE.
101         WRITE(UNIT=6,FMT='('' sideral year = '',E13.7,'' s'')')RSIYEA  
102         WRITE(UNIT=6,FMT='(''  sideral day = '',E13.7,'' s'')')RSIDAY      R=RNAVO*RKBOL
103         WRITE(UNIT=6,FMT='(''        omega = '',E13.7,'' s-1'')') &      RD=1000.*R/RMD
104              ROMEGA      RV=1000.*R/RMV
105         !      RCPD=3.5*RD
106         !*       3.    DEFINE GEOIDE.      RCVD=RCPD-RD
107         !      RCPV=4. *RV
108         RG=9.80665      RCVV=RCPV-RV
109         RA=6371229.      RKAPPA=RD/RCPD
110         R1SA=SNGL(1.D0/DBLE(RA))      RETV=RV/RD-1.
111         WRITE(UNIT=6,FMT='('' ***         Geoide         ***'')')      print *, 'Thermodynamic, gas  '
112         WRITE(UNIT=6,FMT='(''      Gravity = '',E13.7,'' m s-2'')') &      print '('' Perfect gas  = '',e13.7)',  R
113              RG      print '('' Dry air mass = '',e13.7)',  RMD
114         WRITE(UNIT=6,FMT='('' Earth radius = '',E13.7,'' m'')')RA      print '('' Ozone   mass = '',e13.7)',  RMO3
115         WRITE(UNIT=6,FMT='('' Inverse E.R. = '',E13.7,'' m'')')R1SA      print '('' Vapour  mass = '',e13.7)',  RMV
116         !      print '('' Dry air cst. = '',e13.7)',  RD
117         !      print '('' Vapour  cst. = '',e13.7)',  RV
118         !*       4.    DEFINE RADIATION CONSTANTS.      print '(''         Cpd  = '',e13.7)',  RCPD
119         !      print '(''         Cvd  = '',e13.7)',  RCVD
120         ! z.x.li      RSIGMA=2. * RPI**5 * RKBOL**4 /(15.* RCLUM**2 * RHPLA**3)      print '(''         Cpv  = '',e13.7)',  RCPV
121         rsigma = 2.*rpi**5 * (rkbol/rhpla)**3 * rkbol/rclum/rclum/15.      print '(''         Cvv  = '',e13.7)',  RCVV
122         !IM init. dans conf_phys.F90   RI0=1365.      print '(''      Rd/Cpd  = '',e13.7)',  RKAPPA
123         WRITE(UNIT=6,FMT='('' ***        Radiation       ***'')')      print '(''     Rv/Rd-1  = '',e13.7)',  RETV
124         WRITE(UNIT=6,FMT='('' Stefan-Bol.  = '',E13.7,'' W m-2 K-4'')')  RSIGMA  
125        ! 6.    DEFINE THERMODYNAMIC CONSTANTS, LIQUID PHASE.
126         !  
127         !*       5.    DEFINE THERMODYNAMIC CONSTANTS, GAS PHASE.      RCW=RCPV
128         !      print *, 'Thermodynamic, liquid  '
129         R=RNAVO*RKBOL      print '(''         Cw   = '',E13.7)',  RCW
130         RMD=28.9644  
131         RMO3=47.9942      ! 7.    DEFINE THERMODYNAMIC CONSTANTS, SOLID PHASE.
132         RMV=18.0153  
133         RD=1000.*R/RMD      RCS=RCPV
134         RV=1000.*R/RMV      print *, 'thermodynamic, solid'
135         RCPD=3.5*RD      print '(''         Cs   = '',E13.7)',  RCS
136         RCVD=RCPD-RD  
137         RCPV=4. *RV      ! 8.    DEFINE THERMODYNAMIC CONSTANTS, TRANSITION OF PHASE.
138         RCVV=RCPV-RV  
139         RKAPPA=RD/RCPD      RLMLT=RLSTT-RLVTT
140         RETV=RV/RD-1.      print *, 'Thermodynamic, trans.  '
141         WRITE(UNIT=6,FMT='('' *** Thermodynamic, gas     ***'')')      print '('' Fusion point  = '',E13.7)',  RTT
142         WRITE(UNIT=6,FMT='('' Perfect gas  = '',e13.7)') R      print '(''        RLvTt  = '',E13.7)',  RLVTT
143         WRITE(UNIT=6,FMT='('' Dry air mass = '',e13.7)') RMD      print '(''        RLsTt  = '',E13.7)',  RLSTT
144         WRITE(UNIT=6,FMT='('' Ozone   mass = '',e13.7)') RMO3      print '(''        RLMlt  = '',E13.7)',  RLMLT
145         WRITE(UNIT=6,FMT='('' Vapour  mass = '',e13.7)') RMV      print '('' Normal press. = '',E13.7)',  RATM
146         WRITE(UNIT=6,FMT='('' Dry air cst. = '',e13.7)') RD  
147         WRITE(UNIT=6,FMT='('' Vapour  cst. = '',e13.7)') RV      ! 9.    SATURATED VAPOUR PRESSURE.
148         WRITE(UNIT=6,FMT='(''         Cpd  = '',e13.7)') RCPD  
149         WRITE(UNIT=6,FMT='(''         Cvd  = '',e13.7)') RCVD      RGAMW=(RCW-RCPV)/RV
150         WRITE(UNIT=6,FMT='(''         Cpv  = '',e13.7)') RCPV      RBETW=RLVTT/RV+RGAMW*RTT
151         WRITE(UNIT=6,FMT='(''         Cvv  = '',e13.7)') RCVV      RALPW=LOG(RESTT)+RBETW/RTT+RGAMW*LOG(RTT)
152         WRITE(UNIT=6,FMT='(''      Rd/Cpd  = '',e13.7)') RKAPPA      RGAMS=(RCS-RCPV)/RV
153         WRITE(UNIT=6,FMT='(''     Rv/Rd-1  = '',e13.7)') RETV      RBETS=RLSTT/RV+RGAMS*RTT
154         !      RALPS=LOG(RESTT)+RBETS/RTT+RGAMS*LOG(RTT)
155         !      RGAMD=RGAMS-RGAMW
156         !*       6.    DEFINE THERMODYNAMIC CONSTANTS, LIQUID PHASE.      RBETD=RBETS-RBETW
157         !      RALPD=RALPS-RALPW
        RCW=RCPV  
        WRITE(UNIT=6,FMT='('' *** Thermodynamic, liquid  ***'')')  
        WRITE(UNIT=6,FMT='(''         Cw   = '',E13.7)') RCW  
        !  
        !  
        !*       7.    DEFINE THERMODYNAMIC CONSTANTS, SOLID PHASE.  
        !  
        RCS=RCPV  
        WRITE(UNIT=6,FMT='('' *** thermodynamic, solid   ***'')')  
        WRITE(UNIT=6,FMT='(''         Cs   = '',E13.7)') RCS  
        !  
        !  
        !*       8.    DEFINE THERMODYNAMIC CONSTANTS, TRANSITION OF PHASE.  
        !  
        RTT=273.16  
        RLVTT=2.5008E+6  
        RLSTT=2.8345E+6  
        RLMLT=RLSTT-RLVTT  
        RATM=100000.  
        WRITE(UNIT=6,FMT='('' *** Thermodynamic, trans.  ***'')')  
        WRITE(UNIT=6,FMT='('' Fusion point  = '',E13.7)') RTT  
        WRITE(UNIT=6,FMT='(''        RLvTt  = '',E13.7)') RLVTT  
        WRITE(UNIT=6,FMT='(''        RLsTt  = '',E13.7)') RLSTT  
        WRITE(UNIT=6,FMT='(''        RLMlt  = '',E13.7)') RLMLT  
        WRITE(UNIT=6,FMT='('' Normal press. = '',E13.7)') RATM  
        WRITE(UNIT=6,FMT='('' Latent heat :  '')')  
        !  
        !  
        !*       9.    SATURATED VAPOUR PRESSURE.  
        !  
        RESTT=611.14  
        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  
        !  
        !  
        ! 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)  
   
     ELSE  
        PRINT *, 'suphec DEJA APPELE '  
     ENDIF  
158    
159    END SUBROUTINE suphec    END SUBROUTINE suphec
160    
Legend:
Removed from v.3  
changed lines
  Added in v.38
  ViewVC Help
Powered by ViewVC 1.1.21