GCC Code Coverage Report

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