Line |
Branch |
Exec |
Source |
1 |
|
✗ |
subroutine thermcell_condens(klon,active,zpspsk,pplev,ztla,zqta,zqla) |
2 |
|
|
implicit none |
3 |
|
|
|
4 |
|
|
! |
5 |
|
|
! $Header$ |
6 |
|
|
! |
7 |
|
|
! ATTENTION!!!!: ce fichier include est compatible format fixe/format libre |
8 |
|
|
! veillez � n'utiliser que des ! pour les commentaires |
9 |
|
|
! et � bien positionner les & des lignes de continuation |
10 |
|
|
! (les placer en colonne 6 et en colonne 73) |
11 |
|
|
! |
12 |
|
|
! |
13 |
|
|
! A1.0 Fundamental constants |
14 |
|
|
REAL RPI,RCLUM,RHPLA,RKBOL,RNAVO |
15 |
|
|
! A1.1 Astronomical constants |
16 |
|
|
REAL RDAY,REA,REPSM,RSIYEA,RSIDAY,ROMEGA |
17 |
|
|
! A1.1.bis Constantes concernant l'orbite de la Terre: |
18 |
|
|
REAL R_ecc, R_peri, R_incl |
19 |
|
|
! A1.2 Geoide |
20 |
|
|
REAL RA,RG,R1SA |
21 |
|
|
! A1.3 Radiation |
22 |
|
|
! REAL RSIGMA,RI0 |
23 |
|
|
REAL RSIGMA |
24 |
|
|
! A1.4 Thermodynamic gas phase |
25 |
|
|
REAL RMO3,RMCO2,RMC,RMCH4,RMN2O,RMCFC11,RMCFC12 |
26 |
|
|
REAL R,RMD,RMV,RD,RV,RCPD,RCPV,RCVD,RCVV |
27 |
|
|
REAL RKAPPA,RETV, eps_w |
28 |
|
|
! A1.5,6 Thermodynamic liquid,solid phases |
29 |
|
|
REAL RCW,RCS |
30 |
|
|
! A1.7 Thermodynamic transition of phase |
31 |
|
|
REAL RLVTT,RLSTT,RLMLT,RTT,RATM |
32 |
|
|
! A1.8 Curve of saturation |
33 |
|
|
REAL RESTT,RALPW,RBETW,RGAMW,RALPS,RBETS,RGAMS |
34 |
|
|
REAL RALPD,RBETD,RGAMD |
35 |
|
|
! |
36 |
|
|
COMMON/YOMCST/RPI ,RCLUM ,RHPLA ,RKBOL ,RNAVO & |
37 |
|
|
& ,RDAY ,REA ,REPSM ,RSIYEA,RSIDAY,ROMEGA & |
38 |
|
|
& ,R_ecc, R_peri, R_incl & |
39 |
|
|
& ,RA ,RG ,R1SA & |
40 |
|
|
& ,RSIGMA & |
41 |
|
|
& ,R ,RMD ,RMV ,RD ,RV ,RCPD & |
42 |
|
|
& ,RMO3 ,RMCO2 ,RMC ,RMCH4 ,RMN2O ,RMCFC11 ,RMCFC12 & |
43 |
|
|
& ,RCPV ,RCVD ,RCVV ,RKAPPA,RETV, eps_w & |
44 |
|
|
& ,RCW ,RCS & |
45 |
|
|
& ,RLVTT ,RLSTT ,RLMLT ,RTT ,RATM & |
46 |
|
|
& ,RESTT ,RALPW ,RBETW ,RGAMW ,RALPS ,RBETS ,RGAMS & |
47 |
|
|
& ,RALPD ,RBETD ,RGAMD |
48 |
|
|
! ------------------------------------------------------------------ |
49 |
|
|
!$OMP THREADPRIVATE(/YOMCST/) |
50 |
|
|
! |
51 |
|
|
! $Id: YOETHF.h 2799 2017-02-24 18:50:33Z jyg $ |
52 |
|
|
! |
53 |
|
|
! ATTENTION!!!!: ce fichier include est compatible format fixe/format libre |
54 |
|
|
! veillez n'utiliser que des ! pour les commentaires |
55 |
|
|
! et bien positionner les & des lignes de continuation |
56 |
|
|
! (les placer en colonne 6 et en colonne 73) |
57 |
|
|
! |
58 |
|
|
!* COMMON *YOETHF* DERIVED CONSTANTS SPECIFIC TO ECMWF THERMODYNAMICS |
59 |
|
|
! |
60 |
|
|
! *R__ES* *CONSTANTS USED FOR COMPUTATION OF SATURATION |
61 |
|
|
! MIXING RATIO OVER LIQUID WATER(*R_LES*) OR |
62 |
|
|
! ICE(*R_IES*). |
63 |
|
|
! *RVTMP2* *RVTMP2=RCPV/RCPD-1. |
64 |
|
|
! *RHOH2O* *DENSITY OF LIQUID WATER. (RATM/100.) |
65 |
|
|
! |
66 |
|
|
REAL R2ES, R3LES, R3IES, R4LES, R4IES, R5LES, R5IES |
67 |
|
|
REAL RVTMP2, RHOH2O |
68 |
|
|
REAL R5ALVCP,R5ALSCP,RALVDCP,RALSDCP,RALFDCP,RTWAT,RTBER,RTBERCU |
69 |
|
|
REAL RTICE,RTICECU,RTWAT_RTICE_R,RTWAT_RTICECU_R,RKOOP1,RKOOP2 |
70 |
|
|
LOGICAL OK_BAD_ECMWF_THERMO ! If TRUE, then variables set by rrtm/suphec.F90 |
71 |
|
|
! If FALSE, then variables set by suphel.F90 |
72 |
|
|
COMMON /YOETHF/R2ES, R3LES, R3IES, R4LES, R4IES, R5LES, R5IES, & |
73 |
|
|
& RVTMP2, RHOH2O, & |
74 |
|
|
& R5ALVCP,R5ALSCP,RALVDCP,RALSDCP, & |
75 |
|
|
& RALFDCP,RTWAT,RTBER,RTBERCU, & |
76 |
|
|
& RTICE,RTICECU,RTWAT_RTICE_R,RTWAT_RTICECU_R,RKOOP1,& |
77 |
|
|
& RKOOP2, & |
78 |
|
|
& OK_BAD_ECMWF_THERMO |
79 |
|
|
|
80 |
|
|
!$OMP THREADPRIVATE(/YOETHF/) |
81 |
|
|
! |
82 |
|
|
! $Header$ |
83 |
|
|
! |
84 |
|
|
! |
85 |
|
|
! ATTENTION!!!!: ce fichier include est compatible format fixe/format libre |
86 |
|
|
! veillez n'utiliser que des ! pour les commentaires |
87 |
|
|
! et bien positionner les & des lignes de continuation |
88 |
|
|
! (les placer en colonne 6 et en colonne 73) |
89 |
|
|
! |
90 |
|
|
! ------------------------------------------------------------------ |
91 |
|
|
! This COMDECK includes the Thermodynamical functions for the cy39 |
92 |
|
|
! ECMWF Physics package. |
93 |
|
|
! Consistent with YOMCST Basic physics constants, assuming the |
94 |
|
|
! partial pressure of water vapour is given by a first order |
95 |
|
|
! Taylor expansion of Qs(T) w.r.t. to Temperature, using constants |
96 |
|
|
! in YOETHF |
97 |
|
|
! ------------------------------------------------------------------ |
98 |
|
|
REAL PTARG, PDELARG, P5ARG, PQSARG, PCOARG |
99 |
|
|
REAL FOEEW, FOEDE, qsats, qsatl, dqsats, dqsatl |
100 |
|
|
LOGICAL thermcep |
101 |
|
|
PARAMETER (thermcep=.TRUE.) |
102 |
|
|
! |
103 |
|
|
FOEEW ( PTARG,PDELARG ) = EXP ( & |
104 |
|
|
& (R3LES*(1.-PDELARG)+R3IES*PDELARG) * (PTARG-RTT) & |
105 |
|
|
& / (PTARG-(R4LES*(1.-PDELARG)+R4IES*PDELARG)) ) |
106 |
|
|
! |
107 |
|
|
FOEDE ( PTARG,PDELARG,P5ARG,PQSARG,PCOARG ) = PQSARG*PCOARG*P5ARG & |
108 |
|
|
& / (PTARG-(R4LES*(1.-PDELARG)+R4IES*PDELARG))**2 |
109 |
|
|
! |
110 |
|
|
qsats(ptarg) = 100.0 * 0.622 * 10.0 & |
111 |
|
|
& ** (2.07023 - 0.00320991 * ptarg & |
112 |
|
|
& - 2484.896 / ptarg + 3.56654 * LOG10(ptarg)) |
113 |
|
|
qsatl(ptarg) = 100.0 * 0.622 * 10.0 & |
114 |
|
|
& ** (23.8319 - 2948.964 / ptarg & |
115 |
|
|
& - 5.028 * LOG10(ptarg) & |
116 |
|
|
& - 29810.16 * EXP( - 0.0699382 * ptarg) & |
117 |
|
|
& + 25.21935 * EXP( - 2999.924 / ptarg)) |
118 |
|
|
! |
119 |
|
|
dqsats(ptarg,pqsarg) = RLVTT/RCPD*pqsarg * (3.56654/ptarg & |
120 |
|
|
& +2484.896*LOG(10.)/ptarg**2 & |
121 |
|
|
& -0.00320991*LOG(10.)) |
122 |
|
|
dqsatl(ptarg,pqsarg) = RLVTT/RCPD*pqsarg*LOG(10.)* & |
123 |
|
|
& (2948.964/ptarg**2-5.028/LOG(10.)/ptarg & |
124 |
|
|
& +25.21935*2999.924/ptarg**2*EXP(-2999.924/ptarg) & |
125 |
|
|
& +29810.16*0.0699382*EXP(-0.0699382*ptarg)) |
126 |
|
|
|
127 |
|
|
|
128 |
|
|
!==================================================================== |
129 |
|
|
! DECLARATIONS |
130 |
|
|
!==================================================================== |
131 |
|
|
|
132 |
|
|
! Arguments |
133 |
|
|
INTEGER klon |
134 |
|
|
REAL zpspsk(klon),pplev(klon) |
135 |
|
|
REAL ztla(klon),zqta(klon),zqla(klon) |
136 |
|
|
LOGICAL active(klon) |
137 |
|
|
|
138 |
|
|
! Variables locales |
139 |
|
|
INTEGER ig,iter |
140 |
|
✗ |
REAL Tbef(klon),DT(klon) |
141 |
|
|
REAL tdelta,qsatbef,zcor,qlbef,zdelta,zcvm5,dqsat,num,denom,dqsat_dT |
142 |
|
|
logical Zsat |
143 |
|
|
REAL RLvCp |
144 |
|
|
REAL, SAVE :: DDT0=.01 |
145 |
|
|
!$OMP THREADPRIVATE(DDT0) |
146 |
|
|
|
147 |
|
✗ |
LOGICAL afaire(klon),tout_converge |
148 |
|
|
|
149 |
|
|
!==================================================================== |
150 |
|
|
! INITIALISATIONS |
151 |
|
|
!==================================================================== |
152 |
|
|
|
153 |
|
✗ |
RLvCp = RLVTT/RCPD |
154 |
|
|
tout_converge=.false. |
155 |
|
✗ |
afaire(:)=.false. |
156 |
|
✗ |
DT(:)=0. |
157 |
|
|
|
158 |
|
|
|
159 |
|
|
!==================================================================== |
160 |
|
|
! Routine a vectoriser en copiant active dans converge et en mettant |
161 |
|
|
! la boucle sur les iterations a l'exterieur est en mettant |
162 |
|
|
! converge= false des que la convergence est atteinte. |
163 |
|
|
!==================================================================== |
164 |
|
|
|
165 |
|
✗ |
do ig=1,klon |
166 |
|
✗ |
if (active(ig)) then |
167 |
|
✗ |
Tbef(ig)=ztla(ig)*zpspsk(ig) |
168 |
|
✗ |
zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig))) |
169 |
|
✗ |
qsatbef= R2ES * FOEEW(Tbef(ig),zdelta)/pplev(ig) |
170 |
|
✗ |
qsatbef=MIN(0.5,qsatbef) |
171 |
|
✗ |
zcor=1./(1.-retv*qsatbef) |
172 |
|
✗ |
qsatbef=qsatbef*zcor |
173 |
|
✗ |
qlbef=max(0.,zqta(ig)-qsatbef) |
174 |
|
✗ |
DT(ig) = 0.5*RLvCp*qlbef |
175 |
|
|
endif |
176 |
|
|
enddo |
177 |
|
|
|
178 |
|
✗ |
do iter=1,10 |
179 |
|
✗ |
afaire(:)=abs(DT(:)).gt.DDT0 |
180 |
|
✗ |
do ig=1,klon |
181 |
|
✗ |
if (afaire(ig)) then |
182 |
|
✗ |
Tbef(ig)=Tbef(ig)+DT(ig) |
183 |
|
✗ |
zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig))) |
184 |
|
✗ |
qsatbef= R2ES * FOEEW(Tbef(ig),zdelta)/pplev(ig) |
185 |
|
✗ |
qsatbef=MIN(0.5,qsatbef) |
186 |
|
✗ |
zcor=1./(1.-retv*qsatbef) |
187 |
|
✗ |
qsatbef=qsatbef*zcor |
188 |
|
✗ |
qlbef=zqta(ig)-qsatbef |
189 |
|
|
zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig))) |
190 |
|
✗ |
zcvm5=R5LES*(1.-zdelta) + R5IES*zdelta |
191 |
|
✗ |
zcor=1./(1.-retv*qsatbef) |
192 |
|
✗ |
dqsat_dT=FOEDE(Tbef(ig),zdelta,zcvm5,qsatbef,zcor) |
193 |
|
✗ |
num=-Tbef(ig)+ztla(ig)*zpspsk(ig)+RLvCp*qlbef |
194 |
|
✗ |
denom=1.+RLvCp*dqsat_dT |
195 |
|
✗ |
zqla(ig) = max(0.,zqta(ig)-qsatbef) |
196 |
|
✗ |
DT(ig)=num/denom |
197 |
|
|
endif |
198 |
|
|
enddo |
199 |
|
|
enddo |
200 |
|
|
|
201 |
|
✗ |
return |
202 |
|
|
end |
203 |
|
|
|