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

Diff of /trunk/phylmd/suphec.f90

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

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