[6610] | 1 | ! |
---|
| 2 | ! $Header$ |
---|
| 3 | ! |
---|
| 4 | SUBROUTINE suphel_I |
---|
| 5 | USE PRINT_INCA |
---|
| 6 | #include "YOMCST_I.h" |
---|
| 7 | #include "YOETHF_I.h" |
---|
| 8 | |
---|
| 9 | |
---|
| 10 | |
---|
| 11 | !IM cf. JLD |
---|
| 12 | LOGICAL firstcall |
---|
| 13 | SAVE firstcall |
---|
| 14 | !$OMP THREADPRIVATE(firstcall) |
---|
| 15 | DATA firstcall /.TRUE./ |
---|
| 16 | |
---|
| 17 | IF (firstcall) THEN |
---|
| 18 | WRITE(lunout,*) 'suphel initialise les constantes du GCM' |
---|
| 19 | firstcall = .FALSE. |
---|
| 20 | ELSE |
---|
| 21 | WRITE(lunout,*) 'suphel DEJA APPELE ' |
---|
| 22 | RETURN |
---|
| 23 | ENDIF |
---|
| 24 | ! ----------------------------------------------------------------- |
---|
| 25 | ! |
---|
| 26 | !* 1. DEFINE FUNDAMENTAL CONSTANTS. |
---|
| 27 | ! ----------------------------- |
---|
| 28 | ! |
---|
| 29 | ! WRITE(UNIT=lunout,FMT='(''0*** Constants of the ICM ***'')') |
---|
| 30 | RPI=2.*ASIN(1.) |
---|
| 31 | RCLUM=299792458. |
---|
| 32 | RHPLA=6.6260755E-34 |
---|
| 33 | RKBOL=1.380658E-23 |
---|
| 34 | RNAVO=6.0221367E+23 |
---|
| 35 | ! WRITE(UNIT=lunout,FMT='('' *** Fundamental constants ***'')') |
---|
| 36 | ! WRITE(UNIT=lunout,FMT='('' PI = '',E13.7,'' -'')')RPI |
---|
| 37 | ! WRITE(UNIT=lunout,FMT='('' c = '',E13.7,''m s-1'')') RCLUM |
---|
| 38 | ! WRITE(UNIT=lunout,FMT='('' h = '',E13.7,''J s'')') RHPLA |
---|
| 39 | ! WRITE(UNIT=lunout,FMT='('' K = '',E13.7,''J K-1'')') RKBOL |
---|
| 40 | ! WRITE(UNIT=lunout,FMT='('' N = '',E13.7,''mol-1'')') RNAVO |
---|
| 41 | |
---|
| 42 | ! ---------------------------------------------------------------- |
---|
| 43 | ! |
---|
| 44 | !* 2. DEFINE ASTRONOMICAL CONSTANTS. |
---|
| 45 | ! ------------------------------ |
---|
| 46 | ! |
---|
| 47 | RDAY=86400. |
---|
| 48 | REA=149597870000. |
---|
| 49 | REPSM=0.409093 |
---|
| 50 | |
---|
| 51 | RSIYEA=365.25*RDAY*2.*RPI/6.283076 |
---|
| 52 | RSIDAY=RDAY/(1.+RDAY/RSIYEA) |
---|
| 53 | ROMEGA=2.*RPI/RSIDAY |
---|
| 54 | ! WRITE(UNIT=lunout,FMT='('' *** Astronomical constants ***'')') |
---|
| 55 | ! WRITE(UNIT=lunout,FMT='('' day = '',E13.7,'' s'')')RDAY |
---|
| 56 | ! WRITE(UNIT=lunout,FMT='('' half g. axis = '',E13.7,'' m'')')REA |
---|
| 57 | ! WRITE(UNIT=lunout,FMT='('' mean anomaly = '',E13.7,'' -'')')REPSM |
---|
| 58 | ! WRITE(UNIT=lunout,FMT='('' sideral year = '',E13.7,'' s'')')RSIYEA |
---|
| 59 | ! WRITE(UNIT=lunout,FMT='('' sideral day = '',E13.7,'' s'')')RSIDAY |
---|
| 60 | ! WRITE(UNIT=lunout,FMT='('' omega = '',E13.7,'' s-1'')')ROMEGA |
---|
| 61 | |
---|
| 62 | ! ------------------------------------------------------------------ |
---|
| 63 | ! |
---|
| 64 | !* 3. DEFINE GEOIDE. |
---|
| 65 | ! -------------- |
---|
| 66 | ! |
---|
| 67 | RG=9.80665 |
---|
| 68 | RA=6371229. |
---|
| 69 | R1SA=SNGL(1.D0/DBLE(RA)) |
---|
| 70 | ! WRITE(UNIT=lunout,FMT='('' *** Geoide ***'')') |
---|
| 71 | ! WRITE(UNIT=lunout,FMT='('' Gravity = '',E13.7,'' m s-2'')')RG |
---|
| 72 | ! WRITE(UNIT=lunout,FMT='('' Earth radius = '',E13.7,'' m'')')RA |
---|
| 73 | ! WRITE(UNIT=lunout,FMT='('' Inverse E.R. = '',E13.7,'' m'')')R1SA |
---|
| 74 | ! |
---|
| 75 | ! ----------------------------------------------------------------- |
---|
| 76 | ! |
---|
| 77 | !* 4. DEFINE RADIATION CONSTANTS. |
---|
| 78 | ! --------------------------- |
---|
| 79 | ! |
---|
| 80 | ! z.x.li RSIGMA=2. * RPI**5 * RKBOL**4 /(15.* RCLUM**2 * RHPLA**3) |
---|
| 81 | rsigma = 2.*rpi**5 * (rkbol/rhpla)**3 * rkbol/rclum/rclum/15. |
---|
| 82 | ! WRITE(UNIT=lunout,FMT='('' *** Radiation ***'')') |
---|
| 83 | ! WRITE(UNIT=lunout,FMT='('' Stefan-Bol. = '',E13.7,'' W m-2 K-4'')') RSIGMA |
---|
| 84 | ! |
---|
| 85 | ! ----------------------------------------------------------------- |
---|
| 86 | ! |
---|
| 87 | !* 5. DEFINE THERMODYNAMIC CONSTANTS, GAS PHASE. |
---|
| 88 | ! ------------------------------------------ |
---|
| 89 | ! |
---|
| 90 | R=RNAVO*RKBOL |
---|
| 91 | RMD=28.9644 |
---|
| 92 | RMO3=47.9942 |
---|
| 93 | RMV=18.0153 |
---|
| 94 | RD=1000.*R/RMD |
---|
| 95 | RV=1000.*R/RMV |
---|
| 96 | RCPD=3.5*RD |
---|
| 97 | RCVD=RCPD-RD |
---|
| 98 | RCPV=4. *RV |
---|
| 99 | RCVV=RCPV-RV |
---|
| 100 | RKAPPA=RD/RCPD |
---|
| 101 | RETV=RV/RD-1. |
---|
| 102 | ! WRITE(UNIT=lunout,FMT='('' *** Thermodynamic, gas ***'')') |
---|
| 103 | ! WRITE(UNIT=lunout,FMT='('' Perfect gas = '',e13.7)') R |
---|
| 104 | ! WRITE(UNIT=lunout,FMT='('' Dry air mass = '',e13.7)') RMD |
---|
| 105 | ! WRITE(UNIT=lunout,FMT='('' Ozone mass = '',e13.7)') RMO3 |
---|
| 106 | ! WRITE(UNIT=lunout,FMT='('' Vapour mass = '',e13.7)') RMV |
---|
| 107 | ! WRITE(UNIT=lunout,FMT='('' Dry air cst. = '',e13.7)') RD |
---|
| 108 | ! WRITE(UNIT=lunout,FMT='('' Vapour cst. = '',e13.7)') RV |
---|
| 109 | ! WRITE(UNIT=lunout,FMT='('' Cpd = '',e13.7)') RCPD |
---|
| 110 | ! WRITE(UNIT=lunout,FMT='('' Cvd = '',e13.7)') RCVD |
---|
| 111 | ! WRITE(UNIT=lunout,FMT='('' Cpv = '',e13.7)') RCPV |
---|
| 112 | ! WRITE(UNIT=lunout,FMT='('' Cvv = '',e13.7)') RCVV |
---|
| 113 | ! WRITE(UNIT=lunout,FMT='('' Rd/Cpd = '',e13.7)') RKAPPA |
---|
| 114 | ! WRITE(UNIT=lunout,FMT='('' Rv/Rd-1 = '',e13.7)') RETV |
---|
| 115 | ! |
---|
| 116 | ! ---------------------------------------------------------------- |
---|
| 117 | ! |
---|
| 118 | !* 6. DEFINE THERMODYNAMIC CONSTANTS, LIQUID PHASE. |
---|
| 119 | ! --------------------------------------------- |
---|
| 120 | ! |
---|
| 121 | RCW=RCPV |
---|
| 122 | ! WRITE(UNIT=lunout,FMT='('' *** Thermodynamic, liquid ***'')') |
---|
| 123 | ! WRITE(UNIT=lunout,FMT='('' Cw = '',E13.7)') RCW |
---|
| 124 | ! |
---|
| 125 | ! ---------------------------------------------------------------- |
---|
| 126 | ! |
---|
| 127 | !* 7. DEFINE THERMODYNAMIC CONSTANTS, SOLID PHASE. |
---|
| 128 | ! -------------------------------------------- |
---|
| 129 | ! |
---|
| 130 | RCS=RCPV |
---|
| 131 | ! WRITE(UNIT=lunout,FMT='('' *** thermodynamic, solid ***'')') |
---|
| 132 | ! WRITE(UNIT=lunout,FMT='('' Cs = '',E13.7)') RCS |
---|
| 133 | ! |
---|
| 134 | ! ---------------------------------------------------------------- |
---|
| 135 | ! |
---|
| 136 | !* 8. DEFINE THERMODYNAMIC CONSTANTS, TRANSITION OF PHASE. |
---|
| 137 | ! ---------------------------------------------------- |
---|
| 138 | ! |
---|
| 139 | RTT=273.16 |
---|
| 140 | RLVTT=2.5008E+6 |
---|
| 141 | RLSTT=2.8345E+6 |
---|
| 142 | RLMLT=RLSTT-RLVTT |
---|
| 143 | RATM=100000. |
---|
| 144 | ! WRITE(UNIT=lunout,FMT='('' *** Thermodynamic, trans. ***'')') |
---|
| 145 | ! WRITE(UNIT=lunout,FMT='('' Fusion point = '',E13.7)') RTT |
---|
| 146 | ! WRITE(UNIT=lunout,FMT='('' RLvTt = '',E13.7)') RLVTT |
---|
| 147 | ! WRITE(UNIT=lunout,FMT='('' RLsTt = '',E13.7)') RLSTT |
---|
| 148 | ! WRITE(UNIT=lunout,FMT='('' RLMlt = '',E13.7)') RLMLT |
---|
| 149 | ! WRITE(UNIT=lunout,FMT='('' Normal press. = '',E13.7)') RATM |
---|
| 150 | ! WRITE(UNIT=lunout,FMT='('' Latent heat : '')') |
---|
| 151 | ! |
---|
| 152 | ! ---------------------------------------------------------------- |
---|
| 153 | ! |
---|
| 154 | !* 9. SATURATED VAPOUR PRESSURE. |
---|
| 155 | ! -------------------------- |
---|
| 156 | ! |
---|
| 157 | RESTT=611.14 |
---|
| 158 | RGAMW=(RCW-RCPV)/RV |
---|
| 159 | RBETW=RLVTT/RV+RGAMW*RTT |
---|
| 160 | RALPW=LOG(RESTT)+RBETW/RTT+RGAMW*LOG(RTT) |
---|
| 161 | RGAMS=(RCS-RCPV)/RV |
---|
| 162 | RBETS=RLSTT/RV+RGAMS*RTT |
---|
| 163 | RALPS=LOG(RESTT)+RBETS/RTT+RGAMS*LOG(RTT) |
---|
| 164 | RGAMD=RGAMS-RGAMW |
---|
| 165 | RBETD=RBETS-RBETW |
---|
| 166 | RALPD=RALPS-RALPW |
---|
| 167 | ! |
---|
| 168 | ! ------------------------------------------------------------------ |
---|
| 169 | ! |
---|
| 170 | ! calculer les constantes pour les fonctions thermodynamiques |
---|
| 171 | ! |
---|
| 172 | RVTMP2=RCPV/RCPD-1. |
---|
| 173 | RHOH2O=RATM/100. |
---|
| 174 | R2ES=RESTT*RD/RV |
---|
| 175 | R3LES=17.269 |
---|
| 176 | R3IES=21.875 |
---|
| 177 | R4LES=35.86 |
---|
| 178 | R4IES=7.66 |
---|
| 179 | R5LES=R3LES*(RTT-R4LES) |
---|
| 180 | R5IES=R3IES*(RTT-R4IES) |
---|
| 181 | |
---|
| 182 | RETURN |
---|
| 183 | END SUBROUTINE suphel_I |
---|