Directory: | ./ |
---|---|
File: | rad/sucst.f90 |
Date: | 2022-01-11 19:19:34 |
Exec | Total | Coverage | |
---|---|---|---|
Lines: | 156 | 156 | 100.0% |
Branches: | 26 | 36 | 72.2% |
Line | Branch | Exec | Source |
---|---|---|---|
1 | 1 | SUBROUTINE SUCST(KULOUT,KDAT,KSSS,KPRINTLEV) | |
2 | |||
3 | !**** *SUCST * - Routine to initialize the constants of the model. | ||
4 | |||
5 | ! Purpose. | ||
6 | ! -------- | ||
7 | ! Initialize and print the common YOMCST + initialize | ||
8 | ! date and time of YOMRIP. | ||
9 | |||
10 | !** Interface. | ||
11 | ! ---------- | ||
12 | ! *CALL* *SUCST (..) | ||
13 | |||
14 | ! Explicit arguments : | ||
15 | ! -------------------- | ||
16 | |||
17 | ! KULOUT - logical unit for the output | ||
18 | ! KDAT - date in the form AAAAMMDD | ||
19 | ! KSSS - number of seconds in the day | ||
20 | ! KPRINTLEV - printing level | ||
21 | |||
22 | ! Implicit arguments : | ||
23 | ! -------------------- | ||
24 | ! COMMON YOMCST | ||
25 | ! COMMON YOMRIP | ||
26 | |||
27 | ! Method. | ||
28 | ! ------- | ||
29 | ! See documentation | ||
30 | |||
31 | ! Externals. | ||
32 | ! ---------- | ||
33 | |||
34 | ! Reference. | ||
35 | ! ---------- | ||
36 | ! ECMWF Research Department documentation of the IFS | ||
37 | |||
38 | ! Author. | ||
39 | ! ------- | ||
40 | ! Mats Hamrud and Philippe Courtier *ECMWF* | ||
41 | |||
42 | ! Modifications. | ||
43 | ! -------------- | ||
44 | ! Original : 87-10-15 | ||
45 | ! Additions : 90-07-30 (J.-F. Geleyn) | ||
46 | ! 91-11-15 (M. Deque) | ||
47 | ! 96-08-12 M.Hamrud - Reduce printing | ||
48 | ! M.Hamrud 01-Oct-2003 CY28 Cleaning | ||
49 | ! ------------------------------------------------------------------ | ||
50 | |||
51 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
52 | USE YOMHOOK ,ONLY : LHOOK, DR_HOOK | ||
53 | |||
54 | USE YOMCST , ONLY : RPI ,RCLUM ,RHPLA ,RKBOL ,& | ||
55 | & RNAVO ,RDAY ,REA ,REPSM ,RSIYEA ,& | ||
56 | & RSIDAY ,ROMEGA ,RA ,RG ,R1SA ,& | ||
57 | & RSIGMA ,RI0 ,R ,RMD ,RMV ,& | ||
58 | & RMO3 ,RD ,RV ,RCPD ,RCPV ,& | ||
59 | & RMCO2 ,RMCH4 ,RMN2O ,RMCO ,RMHCHO ,& | ||
60 | & RMSO2 ,RMNO2 ,RMSF6 ,RMRA ,& | ||
61 | & RCVD ,RCVV ,RKAPPA ,RETV ,RCW ,& | ||
62 | & RCS ,RLVTT ,RLSTT ,RLVZER ,RLSZER ,& | ||
63 | & RLMLT ,RTT ,RATM ,RDT ,RESTT ,& | ||
64 | & RALPW ,RBETW ,RGAMW ,RALPS ,RBETS ,& | ||
65 | & RGAMS ,RALPD ,RBETD ,RGAMD | ||
66 | USE YOMRIP , ONLY : RTIMST ,RTIMTR | ||
67 | |||
68 | IMPLICIT NONE | ||
69 | |||
70 | INTEGER(KIND=JPIM),INTENT(IN) :: KULOUT | ||
71 | INTEGER(KIND=JPIM),INTENT(IN) :: KDAT | ||
72 | INTEGER(KIND=JPIM),INTENT(IN) :: KSSS | ||
73 | INTEGER(KIND=JPIM),INTENT(IN) :: KPRINTLEV | ||
74 | INTEGER(KIND=JPIM) :: IA, ID, IDAT, IM, ISSS, J | ||
75 | |||
76 | REAL(KIND=JPRB) :: ZDE, ZET, ZJU, ZRS, ZRSREL, ZTETA, ZTI | ||
77 | REAL(KIND=JPRB) :: ZHOOK_HANDLE | ||
78 | |||
79 | ! ----------------------------------------------------------- | ||
80 | |||
81 | ! - Astronomical functions | ||
82 | ! you will find the description in the annex 1 of the documentation | ||
83 | ! RRS is the distance Sun-Earth | ||
84 | ! RDS is the declination of the Earth | ||
85 | ! RET is the equation of time | ||
86 | |||
87 | ! Orbit of the earth | ||
88 | |||
89 | REAL(KIND=JPRB) :: RTETA,REL,REM,RRS,RLLS,RLLLS,RDS,RET | ||
90 | REAL(KIND=JPRB) :: PTIME,PTETA | ||
91 | |||
92 | RTETA(PTIME)=PTIME/(RDAY*365.25_JPRB) | ||
93 | REL(PTETA)=1.7535_JPRB+6.283076_JPRB*PTETA | ||
94 | REM(PTETA)=6.240075_JPRB+6.283020_JPRB*PTETA | ||
95 | RRS(PTETA)=REA*(1.0001_JPRB-0.0163_JPRB*SIN(REL(PTETA))& | ||
96 | &+0.0037_JPRB*COS(REL(PTETA))) | ||
97 | ! Relative movement Sun/Earth | ||
98 | RLLS(PTETA)=4.8951_JPRB+6.283076_JPRB*PTETA | ||
99 | RLLLS(PTETA)=4.8952_JPRB+6.283320_JPRB*PTETA-0.0075_JPRB*SIN(REL(PTETA))& | ||
100 | &-0.0326_JPRB*COS(REL(PTETA))-0.0003_JPRB*SIN(2.0_JPRB*REL(PTETA))& | ||
101 | &+0.0002_JPRB*COS(2.0_JPRB*REL(PTETA)) | ||
102 | RDS(PTETA)=ASIN(SIN(REPSM)*SIN(RLLLS(PTETA))) | ||
103 | RET(PTETA)=591.8_JPRB*SIN(2.0_JPRB*RLLS(PTETA))-459.4_JPRB*SIN(REM(PTETA))& | ||
104 | &+39.5_JPRB*SIN(REM(PTETA))*COS(2.0_JPRB*RLLS(PTETA))& | ||
105 | &-12.7_JPRB*SIN(4._JPRB*RLLS(PTETA))-4.8_JPRB*SIN(2.0_JPRB*REM(PTETA)) | ||
106 | ! ------------------------------------------------------------- | ||
107 | |||
108 | !* | ||
109 | ! ------------------------------------------------------------------ | ||
110 | ! ABSOLUTE THERMODYNAMICAL FUNCTIONS . | ||
111 | |||
112 | |||
113 | ! RLV : LATENT HEAT OF VAPOURISATION | ||
114 | ! RLS : LATENT HEAT OF SUBLIMATION | ||
115 | ! RLF : LATENT HEAT OF FUSION | ||
116 | ! ESW : SATURATION IN PRESENCE OF WATER | ||
117 | ! ESS : SATURATION IN PRESENCE OF ICE | ||
118 | ! ES : SATURATION (IF T>RTT THEN WATER ; IF T<RTT THEN ICE) | ||
119 | ! INPUT (FOR ALL SIX FUNCTIONS) : PTARG = TEMPERATURE . | ||
120 | REAL(KIND=JPRB) :: RLV,RLS,RLF,ESW,ESS,ES | ||
121 | REAL(KIND=JPRB) :: PTARG | ||
122 | |||
123 | RLV(PTARG)=RLVTT+(RCPV-RCW)*(PTARG-RTT) | ||
124 | RLS(PTARG)=RLSTT+(RCPV-RCS)*(PTARG-RTT) | ||
125 | RLF(PTARG)=RLS(PTARG)-RLV(PTARG) | ||
126 | ESW(PTARG)=EXP(RALPW-RBETW/PTARG-RGAMW*LOG(PTARG)) | ||
127 | ESS(PTARG)=EXP(RALPS-RBETS/PTARG-RGAMS*LOG(PTARG)) | ||
128 | ES (PTARG)=EXP(& | ||
129 | &(RALPW+RALPD*MAX(0.0_JPRB,SIGN(1.0_JPRB,RTT-PTARG)))& | ||
130 | &-(RBETW+RBETD*MAX(0.0_JPRB,SIGN(1.0_JPRB,RTT-PTARG)))/PTARG & | ||
131 | &-(RGAMW+RGAMD*MAX(0.0_JPRB,SIGN(1.0_JPRB,RTT-PTARG)))*LOG(PTARG)) | ||
132 | |||
133 | ! ------------------------------------------------------------------ | ||
134 | ! FONCTIONS THERMODYNAMIQUES : FONCTIONS DEFINIES DE LA PHYSIQUE . | ||
135 | |||
136 | |||
137 | ! FONCTION DE LA TENSION DE VAPEUR SATURANTE . | ||
138 | ! INPUT : PTARG = TEMPERATURE | ||
139 | ! PDELARG = 0 SI EAU (QUELQUE SOIT PTARG) | ||
140 | ! 1 SI GLACE (QUELQUE SOIT PTARG). | ||
141 | REAL(KIND=JPRB) :: FOEW | ||
142 | REAL(KIND=JPRB) :: PDELARG | ||
143 | FOEW ( PTARG,PDELARG ) = EXP (& | ||
144 | &( RALPW+PDELARG*RALPD )& | ||
145 | &- ( RBETW+PDELARG*RBETD ) / PTARG & | ||
146 | &- ( RGAMW+PDELARG*RGAMD ) * LOG(PTARG) ) | ||
147 | |||
148 | ! FONCTION DERIVEE DU LOGARITHME NEPERIEN DE LA PRECEDENTE (FOEW) . | ||
149 | ! INPUT : PTARG = TEMPERATURE | ||
150 | ! PDELARG = 0 SI EAU (QUELQUE SOIT PTARG) | ||
151 | ! 1 SI GLACE (QUELQUE SOIT PTARG). | ||
152 | REAL(KIND=JPRB) :: FODLEW | ||
153 | FODLEW ( PTARG,PDELARG ) = (& | ||
154 | &( RBETW+PDELARG*RBETD )& | ||
155 | &- ( RGAMW+PDELARG*RGAMD ) * PTARG )& | ||
156 | &/ ( PTARG*PTARG ) | ||
157 | |||
158 | ! FONCTION HUMIDITE SPECIFIQUE SATURANTE . | ||
159 | ! INPUT : PESPFAR = RAPPORT FOEW SUR PRESSION. | ||
160 | REAL(KIND=JPRB) :: FOQS | ||
161 | REAL(KIND=JPRB) :: PESPFAR | ||
162 | FOQS ( PESPFAR ) = PESPFAR / ( 1.0_JPRB+RETV*MAX(0.0_JPRB,& | ||
163 | &(1.0_JPRB-PESPFAR)) ) | ||
164 | |||
165 | ! FONCTION DERIVEE EN TEMPERATURE DE LA PRECEDENTE (FOQS) . | ||
166 | ! INPUT : PQSFARG = FOQS | ||
167 | ! PESPFAR = RAPPORT FOEW SUR PRESSION | ||
168 | ! PDLEFAR = FODLEW. | ||
169 | REAL(KIND=JPRB) :: FODQS | ||
170 | REAL(KIND=JPRB) :: PQSFARG,PDLEFAR | ||
171 | FODQS ( PQSFARG,PESPFAR,PDLEFAR ) = ( PQSFARG & | ||
172 | &* (1.0_JPRB-PQSFARG)*PDLEFAR ) / (1.0_JPRB-PESPFAR) | ||
173 | |||
174 | ! FONCTION CHALEUR LATENTE . | ||
175 | ! INPUT : PTARG = TEMPERATURE | ||
176 | ! PDELARG = 0 SI EAU (QUELQUE SOIT PTARG) | ||
177 | ! 1 SI GLACE (QUELQUE SOIT PTARG). | ||
178 | REAL(KIND=JPRB) :: FOLH | ||
179 | FOLH ( PTARG,PDELARG ) = RV * (& | ||
180 | &( RBETW+PDELARG*RBETD )& | ||
181 | &- ( RGAMW+PDELARG*RGAMD ) * PTARG ) | ||
182 | ! ------------------------------------------------------------------ | ||
183 | |||
184 | ! ------------------------------------------------------------------ | ||
185 | |||
186 | ! - Time functions | ||
187 | ! the descriptions are in the annex 1 of the documentation | ||
188 | |||
189 | ! TIME | ||
190 | |||
191 | ! NDD : extraxt dd from ccaammdd | ||
192 | ! NMM : extract mm from ccaammdd | ||
193 | ! NAA : extract aa from ccaammdd | ||
194 | ! NCCAA : extract ccaa from ccaammdd | ||
195 | ! NAMD : extract aammdd from ccaammdd | ||
196 | ! NCENT : return centuary of ccaammdd | ||
197 | ! NYEARC: returns year of the centuary from ccaammdd | ||
198 | ! NCONSTRUCT_DATE : returns ccaammdd given centuary,year,month and day | ||
199 | ! NCTH : turn seconds into hours | ||
200 | ! RTIME : returns the time of the model (in seconds of course!) | ||
201 | |||
202 | INTEGER(KIND=JPIM) :: NDD,NMM,NCCAA,NAA,NAMD,NCTH,NZZAA,NZZMM,NCENT,NYEARC,& | ||
203 | &NCONSTRUCT_DATE | ||
204 | REAL(KIND=JPRB) :: RJUDAT,RTIME | ||
205 | INTEGER(KIND=JPIM) :: KGRDAT,KSEC,KAAAA,KMM,KDD,KSS | ||
206 | INTEGER(KIND=JPIM) :: KCENT,KYEARC,KMONTH,KDAY | ||
207 | |||
208 | NDD(KGRDAT) =MOD(KGRDAT,100) | ||
209 | NMM(KGRDAT) =MOD((KGRDAT-NDD(KGRDAT))/100,100) | ||
210 | NCCAA(KGRDAT)=KGRDAT/10000 | ||
211 | NAA(KGRDAT)=MOD(NCCAA(KGRDAT),100) | ||
212 | NAMD(KGRDAT)=MOD(KGRDAT,1000000) | ||
213 | NCTH(KSEC)=KSEC/3600 | ||
214 | NCENT(KGRDAT)=NCCAA(KGRDAT)/100+MIN(NAA(KGRDAT),1) | ||
215 | NYEARC(KGRDAT)=NAA(KGRDAT)+100*(1-MIN(NAA(KGRDAT),1)) | ||
216 | NCONSTRUCT_DATE(KCENT,KYEARC,KMONTH,KDAY)=& | ||
217 | &(KCENT-1)*10**6+KYEARC*10**4+KMONTH*10**2+KDAY | ||
218 | |||
219 | NZZAA(KAAAA,KMM)=KAAAA-( (1-SIGN(1,KMM-3))/2 ) | ||
220 | NZZMM(KMM)=KMM+6*(1-SIGN(1,KMM-3)) | ||
221 | RJUDAT(KAAAA,KMM,KDD)=1720994.5_JPRB + REAL(& | ||
222 | &2-NZZAA(KAAAA,KMM)/100 + (NZZAA(KAAAA,KMM)/100)/4 & | ||
223 | &+ INT(365.25_JPRB*REAL(NZZAA(KAAAA,KMM),JPRB))& | ||
224 | &+ INT(30.601_JPRB*REAL(NZZMM(KMM)+1,JPRB))& | ||
225 | &+ KDD,JPRB) | ||
226 | RTIME(KAAAA,KMM,KDD,KSS)=(RJUDAT(KAAAA,KMM,KDD)-2451545._JPRB)& | ||
227 | &*RDAY+REAL(KSS,JPRB) | ||
228 | ! ------------------------------------------------------------- | ||
229 | |||
230 | ! ----------------------------------------------------------------- | ||
231 | |||
232 | !* 1. DEFINE FUNDAMENTAL CONSTANTS. | ||
233 | ! ----------------------------- | ||
234 | |||
235 | 1 | print*,'DANS SUCST CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC' | |
236 |
1/2✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
|
1 | IF (LHOOK) CALL DR_HOOK('SUCST',0,ZHOOK_HANDLE) |
237 | 1 | RPI=2.0_JPRB*ASIN(1.0_JPRB) | |
238 | 1 | RCLUM=299792458._JPRB | |
239 | 1 | RHPLA=6.6260755E-34_JPRB | |
240 | 1 | RKBOL=1.380658E-23_JPRB | |
241 | 1 | RNAVO=6.0221367E+23_JPRB | |
242 | |||
243 | ! ------------------------------------------------------------------ | ||
244 | |||
245 | !* 2. DEFINE ASTRONOMICAL CONSTANTS. | ||
246 | ! ------------------------------ | ||
247 | |||
248 | 1 | RDAY=86400._JPRB | |
249 | 1 | REA=149597870000._JPRB | |
250 | 1 | REPSM=0.409093_JPRB | |
251 | |||
252 | 1 | RSIYEA=365.25_JPRB*RDAY*2.0_JPRB*RPI/6.283076_JPRB | |
253 | 1 | RSIDAY=RDAY/(1.0_JPRB+RDAY/RSIYEA) | |
254 | 1 | ROMEGA=2.0_JPRB*RPI/RSIDAY | |
255 | |||
256 | 1 | IDAT=KDAT | |
257 | 1 | ISSS=KSSS | |
258 | 1 | ID=NDD(IDAT) | |
259 | 1 | IM=NMM(IDAT) | |
260 | 1 | IA=NCCAA(IDAT) | |
261 | 1 | ZJU=RJUDAT(IA,IM,ID) | |
262 | 1 | ZTI=RTIME(IA,IM,ID,ISSS) | |
263 | 1 | RTIMST=ZTI | |
264 | 1 | RTIMTR=ZTI | |
265 | 1 | ZTETA=RTETA(ZTI) | |
266 | 1 | ZRS=RRS(ZTETA) | |
267 | 1 | ZDE=RDS(ZTETA) | |
268 | 1 | ZET=RET(ZTETA) | |
269 | 1 | ZRSREL=ZRS/REA | |
270 | |||
271 | ! ------------------------------------------------------------------ | ||
272 | |||
273 | !* 3. DEFINE GEOIDE. | ||
274 | ! -------------- | ||
275 | |||
276 | 1 | RG=9.80665_JPRB | |
277 | 1 | RA=6371229._JPRB | |
278 | 1 | R1SA=REAL(1.0_JPRB/REAL(RA,KIND(1.0_JPRB)),KIND(R1SA)) | |
279 | |||
280 | ! ------------------------------------------------------------------ | ||
281 | |||
282 | !* 4. DEFINE RADIATION CONSTANTS. | ||
283 | ! --------------------------- | ||
284 | |||
285 | 1 | RSIGMA=2.0_JPRB * RPI**5 * RKBOL**4 /(15._JPRB* RCLUM**2 * RHPLA**3) | |
286 | 1 | RI0=1370._JPRB | |
287 | |||
288 | ! ------------------------------------------------------------------ | ||
289 | |||
290 | !* 5. DEFINE THERMODYNAMIC CONSTANTS, GAS PHASE. | ||
291 | ! ------------------------------------------ | ||
292 | |||
293 | 1 | R=RNAVO*RKBOL | |
294 | 1 | RMD=28.9644_JPRB | |
295 | 1 | RMV=18.0153_JPRB | |
296 | 1 | RMO3=47.9942_JPRB | |
297 | 1 | RD=1000._JPRB*R/RMD | |
298 | 1 | RV=1000._JPRB*R/RMV | |
299 | 1 | RCPD=3.5_JPRB*RD | |
300 | 1 | RCVD=RCPD-RD | |
301 | 1 | RCPV=4._JPRB *RV | |
302 | 1 | RCVV=RCPV-RV | |
303 | 1 | RKAPPA=RD/RCPD | |
304 | 1 | RETV=RV/RD-1.0_JPRB | |
305 | 1 | RMCO2=44.0095_JPRB | |
306 | 1 | RMCH4=16.04_JPRB | |
307 | 1 | RMN2O=44.013_JPRB | |
308 | 1 | RMSF6=146.05_JPRB | |
309 | 1 | RMRA=222._JPRB | |
310 | 1 | RMCO=28.01_JPRB | |
311 | 1 | RMHCHO=30.03_JPRB | |
312 | 1 | RMNO2=46.01_JPRB | |
313 | 1 | RMSO2=64.07_JPRB | |
314 | |||
315 | ! ------------------------------------------------------------------ | ||
316 | |||
317 | !* 6. DEFINE THERMODYNAMIC CONSTANTS, LIQUID PHASE. | ||
318 | ! --------------------------------------------- | ||
319 | |||
320 | 1 | RCW=4218._JPRB | |
321 | |||
322 | ! ------------------------------------------------------------------ | ||
323 | |||
324 | !* 7. DEFINE THERMODYNAMIC CONSTANTS, SOLID PHASE. | ||
325 | ! -------------------------------------------- | ||
326 | |||
327 | 1 | RCS=2106._JPRB | |
328 | |||
329 | ! ------------------------------------------------------------------ | ||
330 | |||
331 | !* 8. DEFINE THERMODYNAMIC CONSTANTS, TRANSITION OF PHASE. | ||
332 | ! ---------------------------------------------------- | ||
333 | |||
334 | 1 | RTT=273.16_JPRB | |
335 | 1 | RDT=11.82_JPRB | |
336 | 1 | RLVTT=2.5008E+6_JPRB | |
337 | 1 | RLSTT=2.8345E+6_JPRB | |
338 | 1 | RLVZER=RLVTT+RTT*(RCW-RCPV) | |
339 | 1 | RLSZER=RLSTT+RTT*(RCS-RCPV) | |
340 | 1 | RLMLT=RLSTT-RLVTT | |
341 | 1 | RATM=100000._JPRB | |
342 | |||
343 | ! ------------------------------------------------------------------ | ||
344 | |||
345 | !* 9. SATURATED VAPOUR PRESSURE. | ||
346 | ! -------------------------- | ||
347 | |||
348 | 1 | RESTT=611.14_JPRB | |
349 | 1 | RGAMW=(RCW-RCPV)/RV | |
350 | 1 | RBETW=RLVTT/RV+RGAMW*RTT | |
351 | 1 | RALPW=LOG(RESTT)+RBETW/RTT+RGAMW*LOG(RTT) | |
352 | 1 | print *,'SUCST: RESTT,RBETW,RTT,RGAMW',RESTT,RBETW,RTT,RGAMW | |
353 | 1 | print *,'SUCST: RALPW',RALPW | |
354 | 1 | RGAMS=(RCS-RCPV)/RV | |
355 | 1 | RBETS=RLSTT/RV+RGAMS*RTT | |
356 | 1 | RALPS=LOG(RESTT)+RBETS/RTT+RGAMS*LOG(RTT) | |
357 | 1 | print *,'SUCST: RESTT,RBETS,RTT,RGAMS',RESTT,RBETS,RTT,RGAMS | |
358 | 1 | print *,'SUCST: RALPS',RALPS | |
359 | 1 | RGAMS=(RCS-RCPV)/RV | |
360 | 1 | RGAMD=RGAMS-RGAMW | |
361 | 1 | RBETD=RBETS-RBETW | |
362 | 1 | RALPD=RALPS-RALPW | |
363 | |||
364 | ! ------------------------------------------------------------------ | ||
365 | |||
366 | !* 10. PRINTS | ||
367 | |||
368 | 1 | print*,'KPRINTLEV ',KPRINTLEV | |
369 | 1 | print*,'KULOUT ',KULOUT | |
370 | |||
371 |
1/2✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
|
1 | IF (KPRINTLEV >= 1) THEN |
372 | 1 | WRITE(KULOUT,'(''0*** Constants of the ICM ***'')') | |
373 | 1 | WRITE(KULOUT,'('' *** Fundamental constants ***'')') | |
374 | 1 | WRITE(KULOUT,'('' PI = '',E13.7,'' -'')')RPI | |
375 | 1 | WRITE(KULOUT,'('' c = '',E13.7,''m s-1'')')RCLUM | |
376 | 1 | WRITE(KULOUT,'('' h = '',E13.7,''J s'')')RHPLA | |
377 | 1 | WRITE(KULOUT,'('' K = '',E13.7,''J K-1'')')RKBOL | |
378 | 1 | WRITE(KULOUT,'('' N = '',E13.7,''mol-1'')')RNAVO | |
379 | 1 | WRITE(KULOUT,'('' *** Astronomical constants ***'')') | |
380 | 1 | WRITE(KULOUT,'('' day = '',E13.7,'' s'')')RDAY | |
381 | 1 | WRITE(KULOUT,'('' half g. axis = '',E13.7,'' m'')')REA | |
382 | 1 | WRITE(KULOUT,'('' mean anomaly = '',E13.7,'' -'')')REPSM | |
383 | 1 | WRITE(KULOUT,'('' sideral year = '',E13.7,'' s'')')RSIYEA | |
384 | 1 | WRITE(KULOUT,'('' sideral day = '',E13.7,'' s'')')RSIDAY | |
385 | 1 | WRITE(KULOUT,'('' omega = '',E13.7,'' s-1'')')ROMEGA | |
386 | |||
387 | 1 | WRITE(KULOUT,'('' The initial date of the run is :'')') | |
388 | 1 | WRITE(KULOUT,'(1X,I8,1X,I5,5X,I4,1X,I2,1X,I2)')IDAT,ISSS,IA,IM,ID | |
389 | 1 | WRITE(KULOUT,'('' The Julian date is : '',F11.2)') ZJU | |
390 | 1 | WRITE(KULOUT,'('' Time of the model : '',F15.2,'' s'')')ZTI | |
391 | 1 | WRITE(KULOUT,'('' Distance Earth-Sun : '',E13.7,'' m'')')ZRS | |
392 | 1 | WRITE(KULOUT,'('' Relative Dist. E-S : '',E13.7,'' m'')')ZRSREL | |
393 | 1 | WRITE(KULOUT,'('' Declination : '',F12.5)') ZDE | |
394 | 1 | WRITE(KULOUT,'('' Eq. of time : '',F12.5,'' s'')')ZET | |
395 | 1 | WRITE(KULOUT,'('' *** Geoide ***'')') | |
396 | 1 | WRITE(KULOUT,'('' Gravity = '',E13.7,'' m s-2'')')RG | |
397 | 1 | WRITE(KULOUT,'('' Earth radius = '',E13.7,'' m'')')RA | |
398 | 1 | WRITE(KULOUT,'('' Inverse E.R. = '',E13.7,'' m'')')R1SA | |
399 | 1 | WRITE(KULOUT,'('' *** Radiation ***'')') | |
400 | 1 | WRITE(KULOUT,'('' Stefan-Bol. = '',E13.7,'' W m-2 K-4'')') RSIGMA | |
401 | 1 | WRITE(KULOUT,'('' Solar const. = '',E13.7,'' W m-2'')')RI0 | |
402 | 1 | WRITE(KULOUT,'('' *** Thermodynamic, gas ***'')') | |
403 | 1 | WRITE(KULOUT,'('' Perfect gas = '',e13.7)') R | |
404 | 1 | WRITE(KULOUT,'('' Dry air mass = '',e13.7)') RMD | |
405 | 1 | WRITE(KULOUT,'('' Vapour mass = '',e13.7)') RMV | |
406 | 1 | WRITE(KULOUT,'('' Ozone mass = '',e13.7)') RMO3 | |
407 | 1 | WRITE(KULOUT,'('' Dry air cst. = '',e13.7)') RD | |
408 | 1 | WRITE(KULOUT,'('' Vapour cst. = '',e13.7)') RV | |
409 | 1 | WRITE(KULOUT,'('' Cpd = '',e13.7)') RCPD | |
410 | 1 | WRITE(KULOUT,'('' Cvd = '',e13.7)') RCVD | |
411 | 1 | WRITE(KULOUT,'('' Cpv = '',e13.7)') RCPV | |
412 | 1 | WRITE(KULOUT,'('' Cvv = '',e13.7)') RCVV | |
413 | 1 | WRITE(KULOUT,'('' Rd/Cpd = '',e13.7)') RKAPPA | |
414 | 1 | WRITE(KULOUT,'('' Rv/Rd-1 = '',e13.7)') RETV | |
415 | 1 | WRITE(KULOUT,'('' *** Thermodynamic, liquid ***'')') | |
416 | 1 | WRITE(KULOUT,'('' Cw = '',E13.7)') RCW | |
417 | 1 | WRITE(KULOUT,'('' *** thermodynamic, solid ***'')') | |
418 | 1 | WRITE(KULOUT,'('' Cs = '',E13.7)') RCS | |
419 | 1 | WRITE(KULOUT,'('' *** Thermodynamic, trans. ***'')') | |
420 | 1 | WRITE(KULOUT,'('' Fusion point = '',E13.7)') RTT | |
421 | 1 | WRITE(KULOUT,'('' RTT-Tx(ew-ei) = '',E13.7)') RDT | |
422 | 1 | WRITE(KULOUT,'('' RLvTt = '',E13.7)') RLVTT | |
423 | 1 | WRITE(KULOUT,'('' RLsTt = '',E13.7)') RLSTT | |
424 | 1 | WRITE(KULOUT,'('' RLv0 = '',E13.7)') RLVZER | |
425 | 1 | WRITE(KULOUT,'('' RLs0 = '',E13.7)') RLSZER | |
426 | 1 | WRITE(KULOUT,'('' RLMlt = '',E13.7)') RLMLT | |
427 | 1 | WRITE(KULOUT,'('' Normal press. = '',E13.7)') RATM | |
428 | 1 | WRITE(KULOUT,'('' Latent heat : '')') | |
429 |
3/4✓ Branch 1 taken 10 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 9 times.
✓ Branch 4 taken 1 times.
|
10 | WRITE(KULOUT,'(10(1X,E10.4))') (10._JPRB*J,J=-4,4) |
430 |
3/4✓ Branch 1 taken 10 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 9 times.
✓ Branch 4 taken 1 times.
|
10 | WRITE(KULOUT,'(10(1X,E10.4))') (RLV(RTT+10._JPRB*J),J=-4,4) |
431 |
3/4✓ Branch 1 taken 10 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 9 times.
✓ Branch 4 taken 1 times.
|
10 | WRITE(KULOUT,'(10(1X,E10.4))') (RLS(RTT+10._JPRB*J),J=-4,4) |
432 | 1 | WRITE(KULOUT,'('' *** Thermodynamic, satur. ***'')') | |
433 | 1 | WRITE(KULOUT,'('' Fusion point = '',E13.7)') RTT | |
434 | 1 | WRITE(KULOUT,'('' es(Tt) = '',e13.7)') RESTT | |
435 | 1 | WRITE(KULOUT,'('' es(T) : '')') | |
436 |
3/4✓ Branch 1 taken 10 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 9 times.
✓ Branch 4 taken 1 times.
|
10 | WRITE(KULOUT,'(10(1X,E10.4))') (10._JPRB*J,J=-4,4) |
437 |
3/4✓ Branch 1 taken 10 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 9 times.
✓ Branch 4 taken 1 times.
|
10 | WRITE(KULOUT,'(10(1X,E10.4))') (ESW(RTT+10._JPRB*J),J=-4,4) |
438 |
3/4✓ Branch 1 taken 10 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 9 times.
✓ Branch 4 taken 1 times.
|
10 | WRITE(KULOUT,'(10(1X,E10.4))') (ESS(RTT+10._JPRB*J),J=-4,4) |
439 | ! call flush(0) !!!!! A REVOIR (MPL) les 7 lignes qui suivent | ||
440 |
2/2✓ Branch 0 taken 9 times.
✓ Branch 1 taken 1 times.
|
10 | do j=1,9 |
441 | 9 | print*,'TEST J',j | |
442 | 9 | print*,'RTT...',RTT+10._JPRB*(J-5) | |
443 | 10 | print*,'ES(RTT...',ES(RTT+10._JPRB*(J-5)) | |
444 | enddo | ||
445 | 1 | call flush(0) | |
446 | |||
447 |
3/4✓ Branch 1 taken 10 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 9 times.
✓ Branch 4 taken 1 times.
|
10 | WRITE(KULOUT,'(10(1X,E10.4))') (ES (RTT+10._JPRB*J),J=-4,4) |
448 | ENDIF | ||
449 | |||
450 | ! ------------------------------------------------------------------ | ||
451 | |||
452 |
1/2✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
|
1 | IF (LHOOK) CALL DR_HOOK('SUCST',1,ZHOOK_HANDLE) |
453 | 1 | END SUBROUTINE SUCST | |
454 | |||
455 |