| 1 |
module suphec_m |
| 2 |
|
| 3 |
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, parameter:: RG = 9.80665 |
| 20 |
real, parameter:: RA = 6371229. |
| 21 |
|
| 22 |
! A1.3 Radiation |
| 23 |
REAL RSIGMA |
| 24 |
|
| 25 |
! A1.4 Thermodynamic gas phase |
| 26 |
REAL R, RD, RV, RCPD, RCPV, RCVD, RCVV |
| 27 |
real, parameter:: RMD = 28.9644 |
| 28 |
real, parameter:: RMO3 = 47.9942 |
| 29 |
real, parameter:: RMV = 18.0153 |
| 30 |
REAL RKAPPA, RETV |
| 31 |
|
| 32 |
! A1.5, 6 Thermodynamic liquid, solid phases |
| 33 |
REAL RCW, RCS |
| 34 |
|
| 35 |
! A1.7 Thermodynamic transition of phase |
| 36 |
REAL RLMLT |
| 37 |
real, parameter:: RTT = 273.16 |
| 38 |
real, parameter:: RLVTT = 2.5008E+6 |
| 39 |
real, parameter:: RLSTT = 2.8345E+6 |
| 40 |
real, parameter:: RATM = 100000. |
| 41 |
|
| 42 |
! A1.8 Curve of saturation |
| 43 |
REAL RALPW, RBETW, RGAMW, RALPS, RBETS, RGAMS |
| 44 |
real, parameter:: RESTT = 611.14 |
| 45 |
REAL RALPD, RBETD, RGAMD |
| 46 |
|
| 47 |
save |
| 48 |
|
| 49 |
contains |
| 50 |
|
| 51 |
SUBROUTINE suphec |
| 52 |
|
| 53 |
! From phylmd/suphec.F, v 1.2 2005/06/06 13:16:33 |
| 54 |
! Initialise certaines constantes et parametres physiques. |
| 55 |
|
| 56 |
!------------------------------------------ |
| 57 |
|
| 58 |
PRINT *, 'Call sequence information: suphec' |
| 59 |
|
| 60 |
! 1. DEFINE FUNDAMENTAL CONSTANTS |
| 61 |
|
| 62 |
print *, 'Constants of the ICM' |
| 63 |
RPI = 2.*ASIN(1.) |
| 64 |
print *, 'Fundamental constants ' |
| 65 |
print '('' PI = '', E13.7, '' -'')', RPI |
| 66 |
print '('' c = '', E13.7, ''m s-1'')', RCLUM |
| 67 |
print '('' h = '', E13.7, ''J s'')', RHPLA |
| 68 |
print '('' K = '', E13.7, ''J K-1'')', RKBOL |
| 69 |
print '('' N = '', E13.7, ''mol-1'')', RNAVO |
| 70 |
|
| 71 |
! 2. DEFINE ASTRONOMICAL CONSTANTS |
| 72 |
|
| 73 |
RSIYEA = 365.25*RDAY*2.*RPI/6.283076 |
| 74 |
RSIDAY = RDAY/(1.+RDAY/RSIYEA) |
| 75 |
ROMEGA = 2.*RPI/RSIDAY |
| 76 |
|
| 77 |
print *, 'Astronomical constants ' |
| 78 |
print '('' day = '', E13.7, '' s'')', RDAY |
| 79 |
print '('' half g. axis = '', E13.7, '' m'')', REA |
| 80 |
print '('' mean anomaly = '', E13.7, '' -'')', REPSM |
| 81 |
print '('' sideral year = '', E13.7, '' s'')', RSIYEA |
| 82 |
print '('' sideral day = '', E13.7, '' s'')', RSIDAY |
| 83 |
print '('' omega = '', E13.7, '' s-1'')', ROMEGA |
| 84 |
|
| 85 |
! 3. DEFINE GEOIDE. |
| 86 |
|
| 87 |
print *, ' Geoide ' |
| 88 |
print '('' Gravity = '', E13.7, '' m s-2'')', RG |
| 89 |
print '('' Earth radius = '', E13.7, '' m'')', RA |
| 90 |
|
| 91 |
! 4. DEFINE RADIATION CONSTANTS. |
| 92 |
|
| 93 |
rsigma = 2.*rpi**5 * (rkbol/rhpla)**3 * rkbol/rclum/rclum/15. |
| 94 |
print *, ' Radiation ' |
| 95 |
print '('' Stefan-Bol. = '', E13.7, '' W m-2 K-4'')', RSIGMA |
| 96 |
|
| 97 |
! 5. DEFINE THERMODYNAMIC CONSTANTS, GAS PHASE. |
| 98 |
|
| 99 |
R = RNAVO * RKBOL |
| 100 |
RD = 1000. * R / RMD |
| 101 |
RV = 1000.*R/RMV |
| 102 |
RCPD = 3.5*RD |
| 103 |
RCVD = RCPD-RD |
| 104 |
RCPV = 4. *RV |
| 105 |
RCVV = RCPV-RV |
| 106 |
RKAPPA = RD/RCPD |
| 107 |
RETV = RV/RD-1. |
| 108 |
print *, 'Thermodynamic, gas ' |
| 109 |
print '('' Perfect gas = '', e13.7)', R |
| 110 |
print '('' Dry air mass = '', e13.7)', RMD |
| 111 |
print '('' Ozone mass = '', e13.7)', RMO3 |
| 112 |
print '('' Vapour mass = '', e13.7)', RMV |
| 113 |
print '('' Dry air constant = '', e13.7)', RD |
| 114 |
print '('' Vapour constant = '', e13.7)', RV |
| 115 |
print '('' Cpd = '', e13.7)', RCPD |
| 116 |
print '('' Cvd = '', e13.7)', RCVD |
| 117 |
print '('' Cpv = '', e13.7)', RCPV |
| 118 |
print '('' Cvv = '', e13.7)', RCVV |
| 119 |
print '('' Rd/Cpd = '', e13.7)', RKAPPA |
| 120 |
print '('' Rv/Rd-1 = '', e13.7)', RETV |
| 121 |
|
| 122 |
! 6. DEFINE THERMODYNAMIC CONSTANTS, LIQUID PHASE. |
| 123 |
|
| 124 |
RCW = RCPV |
| 125 |
print *, 'Thermodynamic, liquid ' |
| 126 |
print '('' Cw = '', E13.7)', RCW |
| 127 |
|
| 128 |
! 7. DEFINE THERMODYNAMIC CONSTANTS, SOLID PHASE. |
| 129 |
|
| 130 |
RCS = RCPV |
| 131 |
print *, 'thermodynamic, solid' |
| 132 |
print '('' Cs = '', E13.7)', RCS |
| 133 |
|
| 134 |
! 8. DEFINE THERMODYNAMIC CONSTANTS, TRANSITION OF PHASE. |
| 135 |
|
| 136 |
RLMLT = RLSTT-RLVTT |
| 137 |
print *, 'Thermodynamic, trans. ' |
| 138 |
print '('' Fusion point = '', E13.7)', RTT |
| 139 |
print '('' RLvTt = '', E13.7)', RLVTT |
| 140 |
print '('' RLsTt = '', E13.7)', RLSTT |
| 141 |
print '('' RLMlt = '', E13.7)', RLMLT |
| 142 |
print '('' Normal press. = '', E13.7)', RATM |
| 143 |
|
| 144 |
! 9. SATURATED VAPOUR PRESSURE. |
| 145 |
|
| 146 |
RGAMW = (RCW-RCPV)/RV |
| 147 |
RBETW = RLVTT/RV+RGAMW*RTT |
| 148 |
RALPW = LOG(RESTT)+RBETW/RTT+RGAMW*LOG(RTT) |
| 149 |
RGAMS = (RCS-RCPV)/RV |
| 150 |
RBETS = RLSTT/RV+RGAMS*RTT |
| 151 |
RALPS = LOG(RESTT)+RBETS/RTT+RGAMS*LOG(RTT) |
| 152 |
RGAMD = RGAMS-RGAMW |
| 153 |
RBETD = RBETS-RBETW |
| 154 |
RALPD = RALPS-RALPW |
| 155 |
|
| 156 |
END SUBROUTINE suphec |
| 157 |
|
| 158 |
end module suphec_m |
Parent Directory
| 
Revision Log