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

Diff of /trunk/phylmd/suphec.f

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

trunk/libf/phylmd/suphec.f90 revision 3 by guez, Wed Feb 27 13:16:39 2008 UTC trunk/phylmd/suphec.f revision 266 by guez, Thu Apr 19 17:54:55 2018 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
8      real, parameter:: RCLUM = 299792458. ! speed of light, m s-1
9      real, parameter:: RHPLA = 6.6260755E-34 ! Planck constant, J s
10      real, parameter:: KBOL = 1.380658E-23 ! Boltzmann constant, in J K-1
11      real, parameter:: NAVO = 6.0221367E23 ! Avogadro number, in mol-1
12    
13      ! A1.1 Astronomical constants
14    
15      REAL ROMEGA
16      real, parameter:: RDAY = 86400.
17    
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
24      real, parameter:: RG = 9.80665 ! acceleration of gravity, in m s-2
25      real, parameter:: RA = 6371229.
26    
27      ! A1.3 Radiation
28      REAL, parameter:: rsigma = 2. * pi**5 * (kbol / rhpla)**3 * kbol / rclum**2 &
29           / 15.
30    
31      ! A1.4 Thermodynamic gas phase
32      REAL, parameter:: R = NAVO * KBOL ! ideal gas constant, in J K-1 mol-1
33      real, parameter:: MV = 18.0153 ! molar mass of water, in g mol-1
34    
35      real, parameter:: RV = 1e3 * R / MV
36      ! 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, parameter:: RETV = RV / RD - 1.
57    
58      ! A1.5, 6 Thermodynamic liquid, solid phases
59    
60      REAL, parameter:: RCW = RCPV ! LIQUID PHASE Cw
61      real, save:: RCS
62    
63      ! A1.7 Thermodynamic transition of phase
64      REAL, save:: RLMLT
65      real, parameter:: RTT = 273.16
66    
67      real, parameter:: RLVTT = 2.5008E+6
68      ! 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
74      REAL, save:: RALPW, RBETW, RGAMW, RALPS, RBETS, RGAMS
75      real, parameter:: RESTT = 611.14
76      REAL, save:: RALPD, RBETD, RGAMD
77    
78      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 certains paramètres physiques.
86    
87      ! Initialise certaines constantes et parametres physiques.      !------------------------------------------
88    
89      use YOMCST, only: rpi, rclum, rhpla, rkbol, rnavo, rday, rea, repsm, &      PRINT *, 'Call sequence information: suphec'
          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  
90    
91      LOGICAL:: firstcall = .TRUE.      ! 2. DEFINE ASTRONOMICAL CONSTANTS
92    
93      !------------------------------------------      ROMEGA = 2.*PI/RSIDAY
94    
95        print *, 'Astronomical constants '
96        print '('' omega = '', E13.7, '' s-1'')', ROMEGA
97    
98        ! 3. DEFINE GEOIDE.
99    
100        print *, ' Geoide '
101        print '('' Gravity = '', E13.7, '' m s-2'')', RG
102        print '('' Earth radius = '', E13.7, '' m'')', RA
103    
104        ! 4. DEFINE RADIATION CONSTANTS.
105    
106        print *, ' Radiation '
107        print '('' Stefan-Bol. = '', E13.7, '' W m-2 K-4'')', RSIGMA
108    
109        ! 5. DEFINE THERMODYNAMIC CONSTANTS, GAS PHASE.
110    
111        RCVD = RCPD-RD
112        RCVV = RCPV-RV
113        print *, 'Thermodynamics, gas'
114        print *, "rd = ", RD, "J K-1 kg-1"
115        print *, "rv = ", RV, "J K-1 kg-1"
116        print '('' Cpd = '', e13.7)', RCPD
117        print '('' Cvd = '', e13.7)', RCVD
118        print '('' Cvv = '', e13.7)', RCVV
119        print '('' Rd/Cpd = '', e13.7)', RKAPPA
120        print '('' Rv / Rd - 1 = '', e13.7)', RETV
121    
122        ! 7. DEFINE THERMODYNAMIC CONSTANTS, SOLID PHASE.
123    
124        RCS = RCPV
125        print *, 'thermodynamic, solid'
126        print '('' Cs = '', E13.7)', RCS
127    
128        ! 8. DEFINE THERMODYNAMIC CONSTANTS, TRANSITION OF PHASE.
129    
130        RLMLT = RLSTT-RLVTT
131        print *, 'Thermodynamic, transition of phase:'
132        print '('' Fusion point = '', E13.7)', RTT
133        print '('' RLsTt = '', E13.7)', RLSTT
134        print '('' RLMlt = '', E13.7)', RLMLT
135        print '('' Normal pressure = '', E13.7)', RATM
136    
137        ! 9. SATURATED VAPOUR PRESSURE.
138    
139      IF (firstcall) THEN      RGAMW = (RCW-RCPV)/RV
140         PRINT *, 'suphec initialise les constantes du GCM'      RBETW = RLVTT/RV+RGAMW*RTT
141         firstcall = .FALSE.      RALPW = LOG(RESTT)+RBETW/RTT+RGAMW*LOG(RTT)
142         !      RGAMS = (RCS-RCPV)/RV
143         !*       1.    DEFINE FUNDAMENTAL CONSTANTS.      RBETS = RLSTT/RV+RGAMS*RTT
144         !      RALPS = LOG(RESTT)+RBETS/RTT+RGAMS*LOG(RTT)
145         WRITE(UNIT=6,FMT='(''0*** Constants of the ICM   ***'')')      RGAMD = RGAMS-RGAMW
146         RPI=2.*ASIN(1.)      RBETD = RBETS-RBETW
147         RCLUM=299792458.      RALPD = RALPS-RALPW
        RHPLA=6.6260755E-34  
        RKBOL=1.380658E-23  
        RNAVO=6.0221367E+23  
        WRITE(UNIT=6,FMT='('' *** Fundamental constants ***'')')  
        WRITE(UNIT=6,FMT='(''           PI = '',E13.7,'' -'')')RPI  
        WRITE(UNIT=6,FMT='(''            c = '',E13.7,''m s-1'')') &  
             RCLUM  
        WRITE(UNIT=6,FMT='(''            h = '',E13.7,''J s'')') &  
             RHPLA  
        WRITE(UNIT=6,FMT='(''            K = '',E13.7,''J K-1'')') &  
             RKBOL  
        WRITE(UNIT=6,FMT='(''            N = '',E13.7,''mol-1'')') &  
             RNAVO  
        !  
        !  
        !*       2.    DEFINE ASTRONOMICAL CONSTANTS.  
        !  
        RDAY=86400.  
        REA=149597870000.  
        REPSM=0.409093  
        !  
        RSIYEA=365.25*RDAY*2.*RPI/6.283076  
        RSIDAY=RDAY/(1.+RDAY/RSIYEA)  
        ROMEGA=2.*RPI/RSIDAY  
        !  
        WRITE(UNIT=6,FMT='('' *** Astronomical constants ***'')')  
        WRITE(UNIT=6,FMT='(''          day = '',E13.7,'' s'')')RDAY  
        WRITE(UNIT=6,FMT='('' half g. axis = '',E13.7,'' m'')')REA  
        WRITE(UNIT=6,FMT='('' mean anomaly = '',E13.7,'' -'')')REPSM  
        WRITE(UNIT=6,FMT='('' sideral year = '',E13.7,'' s'')')RSIYEA  
        WRITE(UNIT=6,FMT='(''  sideral day = '',E13.7,'' s'')')RSIDAY  
        WRITE(UNIT=6,FMT='(''        omega = '',E13.7,'' s-1'')') &  
             ROMEGA  
        !  
        !*       3.    DEFINE GEOIDE.  
        !  
        RG=9.80665  
        RA=6371229.  
        R1SA=SNGL(1.D0/DBLE(RA))  
        WRITE(UNIT=6,FMT='('' ***         Geoide         ***'')')  
        WRITE(UNIT=6,FMT='(''      Gravity = '',E13.7,'' m s-2'')') &  
             RG  
        WRITE(UNIT=6,FMT='('' Earth radius = '',E13.7,'' m'')')RA  
        WRITE(UNIT=6,FMT='('' Inverse E.R. = '',E13.7,'' m'')')R1SA  
        !  
        !  
        !*       4.    DEFINE RADIATION CONSTANTS.  
        !  
        ! z.x.li      RSIGMA=2. * RPI**5 * RKBOL**4 /(15.* RCLUM**2 * RHPLA**3)  
        rsigma = 2.*rpi**5 * (rkbol/rhpla)**3 * rkbol/rclum/rclum/15.  
        !IM init. dans conf_phys.F90   RI0=1365.  
        WRITE(UNIT=6,FMT='('' ***        Radiation       ***'')')  
        WRITE(UNIT=6,FMT='('' Stefan-Bol.  = '',E13.7,'' W m-2 K-4'')')  RSIGMA  
   
        !  
        !*       5.    DEFINE THERMODYNAMIC CONSTANTS, GAS PHASE.  
        !  
        R=RNAVO*RKBOL  
        RMD=28.9644  
        RMO3=47.9942  
        RMV=18.0153  
        RD=1000.*R/RMD  
        RV=1000.*R/RMV  
        RCPD=3.5*RD  
        RCVD=RCPD-RD  
        RCPV=4. *RV  
        RCVV=RCPV-RV  
        RKAPPA=RD/RCPD  
        RETV=RV/RD-1.  
        WRITE(UNIT=6,FMT='('' *** Thermodynamic, gas     ***'')')  
        WRITE(UNIT=6,FMT='('' Perfect gas  = '',e13.7)') R  
        WRITE(UNIT=6,FMT='('' Dry air mass = '',e13.7)') RMD  
        WRITE(UNIT=6,FMT='('' Ozone   mass = '',e13.7)') RMO3  
        WRITE(UNIT=6,FMT='('' Vapour  mass = '',e13.7)') RMV  
        WRITE(UNIT=6,FMT='('' Dry air cst. = '',e13.7)') RD  
        WRITE(UNIT=6,FMT='('' Vapour  cst. = '',e13.7)') RV  
        WRITE(UNIT=6,FMT='(''         Cpd  = '',e13.7)') RCPD  
        WRITE(UNIT=6,FMT='(''         Cvd  = '',e13.7)') RCVD  
        WRITE(UNIT=6,FMT='(''         Cpv  = '',e13.7)') RCPV  
        WRITE(UNIT=6,FMT='(''         Cvv  = '',e13.7)') RCVV  
        WRITE(UNIT=6,FMT='(''      Rd/Cpd  = '',e13.7)') RKAPPA  
        WRITE(UNIT=6,FMT='(''     Rv/Rd-1  = '',e13.7)') RETV  
        !  
        !  
        !*       6.    DEFINE THERMODYNAMIC CONSTANTS, LIQUID PHASE.  
        !  
        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  
148    
149    END SUBROUTINE suphec    END SUBROUTINE suphec
150    
Legend:
Removed from v.3  
changed lines
  Added in v.266
  ViewVC Help
Powered by ViewVC 1.1.21