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

Legend:
Removed from v.17  
changed lines
  Added in v.53

  ViewVC Help
Powered by ViewVC 1.1.21