source: LMDZ6/trunk/libf/phymar/sucst.F90 @ 3601

Last change on this file since 3601 was 2089, checked in by Laurent Fairhead, 10 years ago

Inclusion de la physique de MAR

Integration of MAR physics
File size: 8.9 KB
Line 
1SUBROUTINE 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!     ------------------------------------------------------------------
49
50#include "tsmbkind.h"
51
52USE YOMCST   , ONLY : RPI      ,RCLUM    ,RHPLA    ,RKBOL    ,&
53            &RNAVO    ,RDAY     ,REA      ,REPSM    ,RSIYEA   ,&
54            &RSIDAY   ,ROMEGA   ,RA       ,RG       ,R1SA     ,&
55            &RSIGMA   ,RI0      ,R        ,RMD      ,RMV      ,&
56            &RMO3     ,RD       ,RV       ,RCPD     ,RCPV     ,&
57            &RCVD     ,RCVV     ,RKAPPA   ,RETV     ,RCW      ,&
58            &RCS      ,RLVTT    ,RLSTT    ,RLVZER   ,RLSZER   ,&
59            &RLMLT    ,RTT      ,RATM     ,RDT      ,RESTT    ,&
60            &RALPW    ,RBETW    ,RGAMW    ,RALPS    ,RBETS    ,&
61            &RGAMS    ,RALPD    ,RBETD    ,RGAMD
62USE YOMRIP   , ONLY : RTIMST   ,RTIMTR
63
64IMPLICIT NONE
65
66
67!     DUMMY INTEGER SCALARS
68INTEGER_M :: KDAT
69INTEGER_M :: KPRINTLEV
70INTEGER_M :: KSSS
71INTEGER_M :: KULOUT
72
73
74!     LOCAL INTEGER SCALARS
75INTEGER_M :: IA, ID, IDAT, IM, ISSS, J
76
77!     LOCAL REAL SCALARS
78REAL_B :: ZDE, ZET, ZJU, ZRS, ZRSREL, ZTETA, ZTI
79
80
81#include "fctast.h"
82#include "fcttrm.h"
83#include "fcttim.h"
84!      -----------------------------------------------------------------
85
86!*       1.    DEFINE FUNDAMENTAL CONSTANTS.
87!              -----------------------------
88
89
90RPI=_TWO_*ASIN(_ONE_)
91RCLUM=299792458._JPRB
92RHPLA=6.6260755E-34_JPRB
93RKBOL=1.380658E-23_JPRB
94RNAVO=6.0221367E+23_JPRB
95
96!     ------------------------------------------------------------------
97
98!*       2.    DEFINE ASTRONOMICAL CONSTANTS.
99!              ------------------------------
100
101RDAY=86400._JPRB
102REA=149597870000._JPRB
103REPSM=0.409093_JPRB
104
105RSIYEA=365.25_JPRB*RDAY*_TWO_*RPI/6.283076_JPRB
106RSIDAY=RDAY/(_ONE_+RDAY/RSIYEA)
107ROMEGA=_TWO_*RPI/RSIDAY
108
109IDAT=KDAT
110ISSS=KSSS
111ID=NDD(IDAT)
112IM=NMM(IDAT)
113IA=NCCAA(IDAT)
114ZJU=RJUDAT(IA,IM,ID)
115ZTI=RTIME(IA,IM,ID,ISSS)
116RTIMST=ZTI
117RTIMTR=ZTI
118ZTETA=RTETA(ZTI)
119ZRS=RRS(ZTETA)
120ZDE=RDS(ZTETA)
121ZET=RET(ZTETA)
122ZRSREL=ZRS/REA
123
124!     ------------------------------------------------------------------
125
126!*       3.    DEFINE GEOIDE.
127!              --------------
128
129RG=9.80665_JPRB
130RA=6371229._JPRB
131R1SA=REAL(_ONE_/REAL(RA,KIND(_ONE_)),KIND(R1SA))
132
133!     ------------------------------------------------------------------
134
135!*       4.    DEFINE RADIATION CONSTANTS.
136!              ---------------------------
137
138RSIGMA=_TWO_ * RPI**5 * RKBOL**4 /(15._JPRB* RCLUM**2 * RHPLA**3)
139RI0=1370._JPRB
140
141!     ------------------------------------------------------------------
142
143!*       5.    DEFINE THERMODYNAMIC CONSTANTS, GAS PHASE.
144!              ------------------------------------------
145
146R=RNAVO*RKBOL
147RMD=28.9644_JPRB
148RMV=18.0153_JPRB
149RMO3=47.9942_JPRB
150RD=1000._JPRB*R/RMD
151RV=1000._JPRB*R/RMV
152RCPD=3.5_JPRB*RD
153RCVD=RCPD-RD
154RCPV=4._JPRB *RV
155RCVV=RCPV-RV
156RKAPPA=RD/RCPD
157RETV=RV/RD-_ONE_
158
159!     ------------------------------------------------------------------
160
161!*       6.    DEFINE THERMODYNAMIC CONSTANTS, LIQUID PHASE.
162!              ---------------------------------------------
163
164RCW=4218._JPRB
165
166!     ------------------------------------------------------------------
167
168!*       7.    DEFINE THERMODYNAMIC CONSTANTS, SOLID PHASE.
169!              --------------------------------------------
170
171RCS=2106._JPRB
172
173!     ------------------------------------------------------------------
174
175!*       8.    DEFINE THERMODYNAMIC CONSTANTS, TRANSITION OF PHASE.
176!              ----------------------------------------------------
177
178RTT=273.16_JPRB
179RDT=11.82_JPRB
180RLVTT=2.5008E+6_JPRB
181RLSTT=2.8345E+6_JPRB
182RLVZER=RLVTT+RTT*(RCW-RCPV)
183RLSZER=RLSTT+RTT*(RCS-RCPV)
184RLMLT=RLSTT-RLVTT
185RATM=100000._JPRB
186
187!     ------------------------------------------------------------------
188
189!*       9.    SATURATED VAPOUR PRESSURE.
190!              --------------------------
191
192RESTT=611.14_JPRB
193RGAMW=(RCW-RCPV)/RV
194RBETW=RLVTT/RV+RGAMW*RTT
195RALPW=LOG(RESTT)+RBETW/RTT+RGAMW*LOG(RTT)
196RGAMS=(RCS-RCPV)/RV
197RBETS=RLSTT/RV+RGAMS*RTT
198RALPS=LOG(RESTT)+RBETS/RTT+RGAMS*LOG(RTT)
199RGAMD=RGAMS-RGAMW
200RBETD=RBETS-RBETW
201RALPD=RALPS-RALPW
202
203!     ------------------------------------------------------------------
204
205!*      10.    PRINTS
206
207IF (KPRINTLEV >= 1) THEN
208  WRITE(KULOUT,'(''0*** Constants of the ICM   ***'')')
209  WRITE(KULOUT,'('' *** Fundamental constants ***'')')
210  WRITE(KULOUT,'(''           PI = '',E13.7,'' -'')')RPI
211  WRITE(KULOUT,'(''            c = '',E13.7,''m s-1'')')RCLUM
212  WRITE(KULOUT,'(''            h = '',E13.7,''J s'')')RHPLA
213  WRITE(KULOUT,'(''            K = '',E13.7,''J K-1'')')RKBOL
214  WRITE(KULOUT,'(''            N = '',E13.7,''mol-1'')')RNAVO
215  WRITE(KULOUT,'('' *** Astronomical constants ***'')')
216  WRITE(KULOUT,'(''          day = '',E13.7,'' s'')')RDAY
217  WRITE(KULOUT,'('' half g. axis = '',E13.7,'' m'')')REA
218  WRITE(KULOUT,'('' mean anomaly = '',E13.7,'' -'')')REPSM
219  WRITE(KULOUT,'('' sideral year = '',E13.7,'' s'')')RSIYEA
220  WRITE(KULOUT,'(''  sideral day = '',E13.7,'' s'')')RSIDAY
221  WRITE(KULOUT,'(''        omega = '',E13.7,'' s-1'')')ROMEGA
222
223  WRITE(KULOUT,'('' The initial date of the run is :'')')
224  WRITE(KULOUT,'(1X,I8,1X,I5,5X,I4,1X,I2,1X,I2)')IDAT,ISSS,IA,IM,ID
225  WRITE(KULOUT,'('' The Julian date is : '',F11.2)') ZJU
226  WRITE(KULOUT,'('' Time of the model  : '',F15.2,'' s'')')ZTI
227  WRITE(KULOUT,'('' Distance Earth-Sun : '',E13.7,'' m'')')ZRS
228  WRITE(KULOUT,'('' Relative Dist. E-S : '',E13.7,'' m'')')ZRSREL
229  WRITE(KULOUT,'('' Declination        : '',F12.5)') ZDE
230  WRITE(KULOUT,'('' Eq. of time        : '',F12.5,'' s'')')ZET
231  WRITE(KULOUT,'('' ***         Geoide         ***'')')
232  WRITE(KULOUT,'(''      Gravity = '',E13.7,'' m s-2'')')RG
233  WRITE(KULOUT,'('' Earth radius = '',E13.7,'' m'')')RA
234  WRITE(KULOUT,'('' Inverse E.R. = '',E13.7,'' m'')')R1SA
235  WRITE(KULOUT,'('' ***        Radiation       ***'')')
236  WRITE(KULOUT,'('' Stefan-Bol.  = '',E13.7,'' W m-2 K-4'')')  RSIGMA
237  WRITE(KULOUT,'('' Solar const. = '',E13.7,'' W m-2'')')RI0
238  WRITE(KULOUT,'('' *** Thermodynamic, gas     ***'')')
239  WRITE(KULOUT,'('' Perfect gas  = '',e13.7)') R
240  WRITE(KULOUT,'('' Dry air mass = '',e13.7)') RMD
241  WRITE(KULOUT,'('' Vapour  mass = '',e13.7)') RMV
242  WRITE(KULOUT,'('' Ozone   mass = '',e13.7)') RMO3
243  WRITE(KULOUT,'('' Dry air cst. = '',e13.7)') RD
244  WRITE(KULOUT,'('' Vapour  cst. = '',e13.7)') RV
245  WRITE(KULOUT,'(''         Cpd  = '',e13.7)') RCPD
246  WRITE(KULOUT,'(''         Cvd  = '',e13.7)') RCVD
247  WRITE(KULOUT,'(''         Cpv  = '',e13.7)') RCPV
248  WRITE(KULOUT,'(''         Cvv  = '',e13.7)') RCVV
249  WRITE(KULOUT,'(''      Rd/Cpd  = '',e13.7)') RKAPPA
250  WRITE(KULOUT,'(''     Rv/Rd-1  = '',e13.7)') RETV
251  WRITE(KULOUT,'('' *** Thermodynamic, liquid  ***'')')
252  WRITE(KULOUT,'(''         Cw   = '',E13.7)') RCW
253  WRITE(KULOUT,'('' *** thermodynamic, solid   ***'')')
254  WRITE(KULOUT,'(''         Cs   = '',E13.7)') RCS
255  WRITE(KULOUT,'('' *** Thermodynamic, trans.  ***'')')
256  WRITE(KULOUT,'('' Fusion point  = '',E13.7)') RTT
257  WRITE(KULOUT,'('' RTT-Tx(ew-ei) = '',E13.7)') RDT
258  WRITE(KULOUT,'(''        RLvTt  = '',E13.7)') RLVTT
259  WRITE(KULOUT,'(''        RLsTt  = '',E13.7)') RLSTT
260  WRITE(KULOUT,'(''        RLv0   = '',E13.7)') RLVZER
261  WRITE(KULOUT,'(''        RLs0   = '',E13.7)') RLSZER
262  WRITE(KULOUT,'(''        RLMlt  = '',E13.7)') RLMLT
263  WRITE(KULOUT,'('' Normal press. = '',E13.7)') RATM
264  WRITE(KULOUT,'('' Latent heat :  '')')
265  WRITE(KULOUT,'(10(1X,E10.4))') (10._JPRB*J,J=-4,4)
266  WRITE(KULOUT,'(10(1X,E10.4))') (RLV(RTT+10._JPRB*J),J=-4,4)
267  WRITE(KULOUT,'(10(1X,E10.4))') (RLS(RTT+10._JPRB*J),J=-4,4)
268  WRITE(KULOUT,'('' *** Thermodynamic, satur.  ***'')')
269  WRITE(KULOUT,'('' Fusion point = '',E13.7)') RTT
270  WRITE(KULOUT,'(''      es(Tt)  = '',e13.7)') RESTT
271  WRITE(KULOUT,'('' es(T) :  '')')
272  WRITE(KULOUT,'(10(1X,E10.4))') (10._JPRB*J,J=-4,4)
273  WRITE(KULOUT,'(10(1X,E10.4))') (ESW(RTT+10._JPRB*J),J=-4,4)
274  WRITE(KULOUT,'(10(1X,E10.4))') (ESS(RTT+10._JPRB*J),J=-4,4)
275  WRITE(KULOUT,'(10(1X,E10.4))') (ES (RTT+10._JPRB*J),J=-4,4)
276ENDIF
277
278!     ------------------------------------------------------------------
279
280RETURN
281END SUBROUTINE SUCST
282
283
284
285
286
287
Note: See TracBrowser for help on using the repository browser.