| 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, save:: RETV |
| 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 |
IF (firstcall) THEN |
! 3. DEFINE GEOIDE. |
| 99 |
PRINT *, 'suphec initialise les constantes du GCM' |
|
| 100 |
firstcall = .FALSE. |
print *, ' Geoide ' |
| 101 |
|
print '('' Gravity = '', E13.7, '' m s-2'')', RG |
| 102 |
!* 1. DEFINE FUNDAMENTAL CONSTANTS. |
print '('' Earth radius = '', E13.7, '' m'')', RA |
| 103 |
|
|
| 104 |
WRITE(UNIT=6,FMT='(''0*** Constants of the ICM ***'')') |
! 4. DEFINE RADIATION CONSTANTS. |
| 105 |
RPI=2.*ASIN(1.) |
|
| 106 |
RCLUM=299792458. |
print *, ' Radiation ' |
| 107 |
RHPLA=6.6260755E-34 |
print '('' Stefan-Bol. = '', E13.7, '' W m-2 K-4'')', RSIGMA |
| 108 |
RKBOL=1.380658E-23 |
|
| 109 |
RNAVO=6.0221367E+23 |
! 5. DEFINE THERMODYNAMIC CONSTANTS, GAS PHASE. |
| 110 |
WRITE(UNIT=6,FMT='('' *** Fundamental constants ***'')') |
|
| 111 |
WRITE(UNIT=6,FMT='('' PI = '',E13.7,'' -'')')RPI |
RCVD = RCPD-RD |
| 112 |
WRITE(UNIT=6,FMT='('' c = '',E13.7,''m s-1'')') & |
RCVV = RCPV-RV |
| 113 |
RCLUM |
RETV = RV / RD - 1. |
| 114 |
WRITE(UNIT=6,FMT='('' h = '',E13.7,''J s'')') & |
print *, 'Thermodynamics, gas' |
| 115 |
RHPLA |
print *, "rd = ", RD, "J K-1 kg-1" |
| 116 |
WRITE(UNIT=6,FMT='('' K = '',E13.7,''J K-1'')') & |
print *, "rv = ", RV, "J K-1 kg-1" |
| 117 |
RKBOL |
print '('' Cpd = '', e13.7)', RCPD |
| 118 |
WRITE(UNIT=6,FMT='('' N = '',E13.7,''mol-1'')') & |
print '('' Cvd = '', e13.7)', RCVD |
| 119 |
RNAVO |
print '('' Cvv = '', e13.7)', RCVV |
| 120 |
|
print '('' Rd/Cpd = '', e13.7)', RKAPPA |
| 121 |
!* 2. DEFINE ASTRONOMICAL CONSTANTS. |
print '('' Rv / Rd - 1 = '', e13.7)', RETV |
| 122 |
|
|
| 123 |
RDAY=86400. |
! 7. DEFINE THERMODYNAMIC CONSTANTS, SOLID PHASE. |
| 124 |
REA=149597870000. |
|
| 125 |
REPSM=0.409093 |
RCS = RCPV |
| 126 |
|
print *, 'thermodynamic, solid' |
| 127 |
RSIYEA=365.25*RDAY*2.*RPI/6.283076 |
print '('' Cs = '', E13.7)', RCS |
| 128 |
RSIDAY=RDAY/(1.+RDAY/RSIYEA) |
|
| 129 |
ROMEGA=2.*RPI/RSIDAY |
! 8. DEFINE THERMODYNAMIC CONSTANTS, TRANSITION OF PHASE. |
| 130 |
|
|
| 131 |
WRITE(UNIT=6,FMT='('' *** Astronomical constants ***'')') |
RLMLT = RLSTT-RLVTT |
| 132 |
WRITE(UNIT=6,FMT='('' day = '',E13.7,'' s'')')RDAY |
print *, 'Thermodynamic, transition of phase:' |
| 133 |
WRITE(UNIT=6,FMT='('' half g. axis = '',E13.7,'' m'')')REA |
print '('' Fusion point = '', E13.7)', RTT |
| 134 |
WRITE(UNIT=6,FMT='('' mean anomaly = '',E13.7,'' -'')')REPSM |
print '('' RLsTt = '', E13.7)', RLSTT |
| 135 |
WRITE(UNIT=6,FMT='('' sideral year = '',E13.7,'' s'')')RSIYEA |
print '('' RLMlt = '', E13.7)', RLMLT |
| 136 |
WRITE(UNIT=6,FMT='('' sideral day = '',E13.7,'' s'')')RSIDAY |
print '('' Normal pressure = '', E13.7)', RATM |
| 137 |
WRITE(UNIT=6,FMT='('' omega = '',E13.7,'' s-1'')') & |
|
| 138 |
ROMEGA |
! 9. SATURATED VAPOUR PRESSURE. |
| 139 |
|
|
| 140 |
!* 3. DEFINE GEOIDE. |
RGAMW = (RCW-RCPV)/RV |
| 141 |
|
RBETW = RLVTT/RV+RGAMW*RTT |
| 142 |
RG=9.80665 |
RALPW = LOG(RESTT)+RBETW/RTT+RGAMW*LOG(RTT) |
| 143 |
RA=6371229. |
RGAMS = (RCS-RCPV)/RV |
| 144 |
R1SA=SNGL(1.D0/DBLE(RA)) |
RBETS = RLSTT/RV+RGAMS*RTT |
| 145 |
WRITE(UNIT=6,FMT='('' *** Geoide ***'')') |
RALPS = LOG(RESTT)+RBETS/RTT+RGAMS*LOG(RTT) |
| 146 |
WRITE(UNIT=6,FMT='('' Gravity = '',E13.7,'' m s-2'')') & |
RGAMD = RGAMS-RGAMW |
| 147 |
RG |
RBETD = RBETS-RBETW |
| 148 |
WRITE(UNIT=6,FMT='('' Earth radius = '',E13.7,'' m'')')RA |
RALPD = RALPS-RALPW |
|
WRITE(UNIT=6,FMT='('' Inverse E.R. = '',E13.7,'' m'')')R1SA |
|
|
|
|
|
!* 4. DEFINE RADIATION CONSTANTS. |
|
|
|
|
|
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 |
|
| 149 |
|
|
| 150 |
END SUBROUTINE suphec |
END SUBROUTINE suphec |
| 151 |
|
|
Parent Directory
| 
Revision Log
| 
Patch