Directory: | ./ |
---|---|
File: | rad/sutoph.f90 |
Date: | 2022-01-11 19:19:34 |
Exec | Total | Coverage | |
---|---|---|---|
Lines: | 53 | 72 | 73.6% |
Branches: | 9 | 26 | 34.6% |
Line | Branch | Exec | Source |
---|---|---|---|
1 | !OPTIONS XOPT(NOEVAL) | ||
2 | 1 | SUBROUTINE SUTOPH(KULOUT) | |
3 | |||
4 | !**** *SUTOPH* - Initialize common YOMTOPH top parameterization | ||
5 | |||
6 | ! Purpose. | ||
7 | ! -------- | ||
8 | ! Initialize YOMTOPH, the common that contains the top pressure | ||
9 | ! and the first level of parameterization | ||
10 | ! it also contains mesospheric drag vertical profil | ||
11 | |||
12 | !** Interface. | ||
13 | ! ---------- | ||
14 | ! *CALL* *SUTOPH(KULOUT) | ||
15 | |||
16 | ! Explicit arguments : | ||
17 | ! -------------------- | ||
18 | ! KULOUT : Logical unit for the output | ||
19 | |||
20 | ! Implicit arguments : | ||
21 | ! -------------------- | ||
22 | ! COMMON YOMTOPH, YOMSTA | ||
23 | |||
24 | ! Method. | ||
25 | ! ------- | ||
26 | ! See documentation | ||
27 | |||
28 | ! Externals. | ||
29 | ! ---------- | ||
30 | |||
31 | ! Reference. | ||
32 | ! ---------- | ||
33 | ! Documentation ARPEGE | ||
34 | |||
35 | ! Author. | ||
36 | ! ------- | ||
37 | ! A. Lasserre-Bigorry | ||
38 | |||
39 | ! Modifications. | ||
40 | ! -------------- | ||
41 | ! Original : 91-06-10 | ||
42 | ! Modified 92-02-22 by M. Deque (test of consistency between phys. para.) | ||
43 | ! Modified by R. EL Khatib : 93-04-02 Set-up defaults controled by LECMWF | ||
44 | ! Modified 93-11-17 by Ph. Dandin : FMR scheme with MF physics | ||
45 | ! Modified 97-05-17 by M. Deque : frozen FMR | ||
46 | ! M.Hamrud 01-Oct-2003 CY28 Cleaning | ||
47 | ! F.Bouyssel 04-11-22 : NTCOET,ETCOET | ||
48 | ! P. Marquet 05-09-12 : NTAJUC | ||
49 | ! M. Deque 05-09-12 : default RCLX | ||
50 | ! M. Deque 05-09-12 : default TPSCLIM | ||
51 | ! ------------------------------------------------------------------ | ||
52 | |||
53 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
54 | USE YOMHOOK ,ONLY : LHOOK, DR_HOOK | ||
55 | |||
56 | USE YOMDIM , ONLY : NFLEVG | ||
57 | ! Ce qui concerne NULNAM commente par MPL le 15.04.09 | ||
58 | !USE YOMLUN , ONLY : NULNAM | ||
59 | USE YOMCT0B , ONLY : LECMWF | ||
60 | USE YOMSTA , ONLY : STPRE | ||
61 | USE YOMTOPH , ONLY : RMESOU ,RMESOT ,NTQSAT ,NTDIFU ,& | ||
62 | & NTCOEF ,NTDRAG ,NTCVIM ,NTPLUI ,NTRADI ,& | ||
63 | & NTNEBU ,NTOZON ,NTDRME ,ETQSAT ,ETDIFU ,& | ||
64 | & ETCOEF ,ETDRAG ,ETCVIM ,ETPLUI ,ETRADI ,& | ||
65 | & ETNEBU ,ETOZON ,ETDRME ,XDRMUK ,XDRMUX ,XDRMUP ,& | ||
66 | & XDRMTK ,XDRMTX ,XDRMTP ,NTCOET ,ETCOET ,& | ||
67 | & RMESOQ ,XDRMQK ,XDRMQP ,RFMESOQ ,RCLX ,& | ||
68 | & NTAJUC ,ETAJUC ,TPSCLIM | ||
69 | USE YOMPHY , ONLY : LRAY ,LRAYFM ,LRAYFM15 ,LRRMES | ||
70 | USE YOEPHY , ONLY : LAGPHY | ||
71 | |||
72 | ! ------------------------------------------------------------------ | ||
73 | |||
74 | IMPLICIT NONE | ||
75 | |||
76 | INTEGER(KIND=JPIM),INTENT(IN) :: KULOUT | ||
77 | |||
78 | ! ------------------------------------------------------------------ | ||
79 | |||
80 | INTEGER(KIND=JPIM) :: JLEV | ||
81 | |||
82 | REAL(KIND=JPRB) :: PAP, PAPX, ZMEST, ZMESU, ZMESQ | ||
83 | |||
84 | REAL(KIND=JPRB) :: PMESQF | ||
85 | REAL(KIND=JPRB) :: PMESTF | ||
86 | REAL(KIND=JPRB) :: PMESUF | ||
87 | REAL(KIND=JPRB) :: ZHOOK_HANDLE | ||
88 | |||
89 | ! ------------------------------------------------------------------ | ||
90 | |||
91 | ! ------------------------------------------------------------------ | ||
92 | NAMELIST/NAMTOPH/& | ||
93 | &ETQSAT,ETDIFU,ETCOEF,ETDRAG,ETCVIM,ETPLUI,ETRADI,ETNEBU & | ||
94 | &,ETOZON,ETDRME,ETCOET & | ||
95 | &,XDRMUK,XDRMUX,XDRMUP,XDRMTK,XDRMTX,XDRMTP & | ||
96 | &,XDRMQK,XDRMQP,RFMESOQ & | ||
97 | &,ETAJUC,NTAJUC,RCLX,TPSCLIM | ||
98 | ! ------------------------------------------------------------------ | ||
99 | |||
100 | |||
101 | ! ------------------------------------------------------------------ | ||
102 | |||
103 | !* Mesospheric drag shape function | ||
104 | |||
105 | ! PMESUF(PAP,PAPX) = MAX( (PAPX-PAP)/MAX(PAP**1.5,1.E-10),0. ) | ||
106 | PMESUF(PAP,PAPX) = MAX( (PAPX-PAP)/MAX(PAP,1.E-10_JPRB),0.0_JPRB ) | ||
107 | PMESTF(PAP,PAPX) = MAX( (PAPX-PAP)/MAX(PAP,1.E-10_JPRB),0.0_JPRB ) | ||
108 | PMESQF(PAP,PAPX) = MAX( (PAPX-PAP)/MAX(PAP,1.E-10_JPRB),0.0_JPRB ) | ||
109 | |||
110 | ! ------------------------------------------------------------------ | ||
111 | |||
112 | INTERFACE | ||
113 | SUBROUTINE ABOR1(CDTEXT) | ||
114 | CHARACTER(LEN=*) :: CDTEXT | ||
115 | END SUBROUTINE ABOR1 | ||
116 | END INTERFACE | ||
117 | INTERFACE | ||
118 | SUBROUTINE POSNAM(KULNAM,CDNAML) | ||
119 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
120 | INTEGER(KIND=JPIM),INTENT(IN) :: KULNAM | ||
121 | CHARACTER(LEN=*) ,INTENT(IN) :: CDNAML | ||
122 | END SUBROUTINE POSNAM | ||
123 | END INTERFACE | ||
124 | INTERFACE | ||
125 | SUBROUTINE SEAPRE(PARA,KPARA,PSTPRE,KLEV) | ||
126 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
127 | INTEGER(KIND=JPIM),INTENT(IN) :: KLEV | ||
128 | REAL(KIND=JPRB) ,INTENT(IN) :: PARA | ||
129 | INTEGER(KIND=JPIM),INTENT(OUT) :: KPARA | ||
130 | REAL(KIND=JPRB) ,INTENT(IN) :: PSTPRE(KLEV) | ||
131 | END SUBROUTINE SEAPRE | ||
132 | END INTERFACE | ||
133 | |||
134 | ! ------------------------------------------------------------------ | ||
135 | |||
136 |
1/2✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
|
1 | IF (LHOOK) CALL DR_HOOK('SUTOPH',0,ZHOOK_HANDLE) |
137 | |||
138 | ! ------------------------------------------------------------------ | ||
139 | |||
140 | !* 1. Set default values. | ||
141 | ! ------------------- | ||
142 | |||
143 | ! 1.1 Set implicit default values | ||
144 | |||
145 | 1 | ETQSAT=0._JPRB | |
146 | 1 | ETDIFU=0._JPRB | |
147 | 1 | ETCOEF=0._JPRB | |
148 | 1 | ETDRAG=0._JPRB | |
149 | 1 | ETCVIM=0._JPRB | |
150 | 1 | ETPLUI=0._JPRB | |
151 | 1 | ETRADI=0._JPRB | |
152 | 1 | ETNEBU=0._JPRB | |
153 | 1 | ETOZON=0._JPRB | |
154 | 1 | ETDRME=0._JPRB | |
155 | 1 | ETCOET=0._JPRB | |
156 | 1 | ETAJUC=0._JPRB | |
157 | 1 | NTQSAT=1 | |
158 | 1 | NTDIFU=1 | |
159 | 1 | NTCOEF=1 | |
160 | 1 | NTDRAG=1 | |
161 | 1 | NTCVIM=1 | |
162 | 1 | NTPLUI=1 | |
163 | 1 | NTRADI=1 | |
164 | 1 | NTNEBU=1 | |
165 | 1 | NTOZON=1 | |
166 | 1 | NTDRME=1 | |
167 | 1 | NTCOET=1 | |
168 | 1 | NTAJUC=1 | |
169 | |||
170 | 1 | XDRMUK=0._JPRB | |
171 | 1 | XDRMUX=0._JPRB | |
172 | 1 | XDRMUP=0._JPRB | |
173 | 1 | XDRMTK=0._JPRB | |
174 | 1 | XDRMTX=0._JPRB | |
175 | 1 | XDRMTP=0._JPRB | |
176 | 1 | XDRMQK=0._JPRB | |
177 | 1 | XDRMQP=0._JPRB | |
178 | |||
179 | 1 | RFMESOQ=3.725E-06_JPRB | |
180 | 1 | RCLX=0.0_JPRB | |
181 | 1 | TPSCLIM=197._JPRB | |
182 | |||
183 | ! 1.2 Modify default values according to LECMWF | ||
184 | |||
185 | IF (LECMWF) THEN | ||
186 | ELSE | ||
187 | ENDIF | ||
188 | |||
189 | ! ------------------------------------------------------------------ | ||
190 | |||
191 | !* 2. Modify default values. | ||
192 | ! ---------------------- | ||
193 | |||
194 | ! Ce qui concerne NAMTOPH commente par MPL le 15.04.09 | ||
195 | !CALL POSNAM(NULNAM,'NAMTOPH') | ||
196 | !READ(NULNAM,NAMTOPH) | ||
197 | |||
198 | !* 2.1 Search corresponding level, to pressure in NAMTOPH | ||
199 | ! for each parameterization | ||
200 | |||
201 | IF(ETQSAT /= 0.0_JPRB) CALL SEAPRE (ETQSAT,NTQSAT,STPRE,NFLEVG) | ||
202 | IF(ETDIFU /= 0.0_JPRB) CALL SEAPRE (ETDIFU,NTDIFU,STPRE,NFLEVG) | ||
203 | IF(ETCOEF /= 0.0_JPRB) CALL SEAPRE (ETCOEF,NTCOEF,STPRE,NFLEVG) | ||
204 | IF(ETDRAG /= 0.0_JPRB) CALL SEAPRE (ETDRAG,NTDRAG,STPRE,NFLEVG) | ||
205 | IF(ETCVIM /= 0.0_JPRB) CALL SEAPRE (ETCVIM,NTCVIM,STPRE,NFLEVG) | ||
206 | IF(ETPLUI /= 0.0_JPRB) CALL SEAPRE (ETPLUI,NTPLUI,STPRE,NFLEVG) | ||
207 | IF(ETRADI /= 0.0_JPRB) THEN | ||
208 | IF (LRAY) THEN | ||
209 | CALL SEAPRE (ETRADI,NTRADI,STPRE,NFLEVG) | ||
210 | ENDIF | ||
211 | IF (LRAYFM.OR.LRAYFM15) THEN | ||
212 | ETRADI=0._JPRB | ||
213 | NTRADI=1 | ||
214 | ENDIF | ||
215 | ENDIF | ||
216 | IF(ETNEBU /= 0.0_JPRB) CALL SEAPRE (ETNEBU,NTNEBU,STPRE,NFLEVG) | ||
217 | IF(ETOZON /= 0.0_JPRB) CALL SEAPRE (ETOZON,NTOZON,STPRE,NFLEVG) | ||
218 | IF(ETDRME /= 0.0_JPRB) CALL SEAPRE (ETDRME,NTDRME,STPRE,NFLEVG) | ||
219 | IF(ETCOET /= 0.0_JPRB) CALL SEAPRE (ETCOET,NTCOET,STPRE,NFLEVG) | ||
220 | IF(ETAJUC /= 0.0_JPRB) CALL SEAPRE (ETAJUC,NTAJUC,STPRE,NFLEVG) | ||
221 | ! ------------------------------------------------------------------ | ||
222 | |||
223 | !* 3. Print final values. | ||
224 | ! ------------------- | ||
225 | |||
226 | 1 | WRITE(UNIT=KULOUT,FMT='('' COMMON YOMTOPH '')') | |
227 | WRITE(UNIT=KULOUT,FMT='('' ETQSAT = '',E10.4,'' NTQSAT = '',I10 & | ||
228 | & ,'' ETDIFU = '',E10.4,'' NTDIFU = '',I10 & | ||
229 | & ,/,'' ETCOEF = '',E10.4,'' NTCOEF = '',I10 & | ||
230 | & ,'' ETDRAG = '',E10.4,'' NTDRAG = '',I10 & | ||
231 | & ,/,'' ETCVIM = '',E10.4,'' NTCVIM = '',I10 & | ||
232 | & ,'' ETPLUI = '',E10.4,'' NTPLUI = '',I10 & | ||
233 | & ,/,'' ETRADI = '',E10.4,'' NTRADI = '',I10 & | ||
234 | & ,'' ETNEBU = '',E10.4,'' NTNEBU = '',I10 & | ||
235 | & ,/,'' ETOZON = '',E10.4,'' NTOZON = '',I10 & | ||
236 | & ,'' ETDRME = '',E10.4,'' NTDRME = '',I10 & | ||
237 | & ,/,'' ETCOET = '',E10.4,'' NTCOET = '',I10 & | ||
238 | & ,/,'' ETAJUC = '',E10.4,'' NTAJUC = '',I10 & | ||
239 | & ,/,'' XDRMUK = '',E10.4,'' XDRMUP = '',E10.4 & | ||
240 | & ,'' XDRMUX = '',E10.4,'' XDRMTK = '',E10.4 & | ||
241 | & ,'' XDRMTP = '',E10.4,'' XDRMTX = '',E10.4 & | ||
242 | & ,'' XDRMQK = '',E11.4,'' XDRMQP = '',E11.4 & | ||
243 | & ,/,'' RFMESOQ= '',E11.4,'' RCLX = '',E11.4 & | ||
244 | & )')& | ||
245 | 1 | & ETQSAT,NTQSAT,ETDIFU,NTDIFU & | |
246 | 1 | & ,ETCOEF,NTCOEF,ETDRAG,NTDRAG & | |
247 | 1 | & ,ETCVIM,NTCVIM,ETPLUI,NTPLUI & | |
248 | 1 | & ,ETRADI,NTRADI,ETNEBU,NTNEBU & | |
249 | 1 | & ,ETOZON,NTOZON,ETDRME,NTDRME & | |
250 | 1 | & ,ETCOET,NTCOET & | |
251 | 1 | & ,ETAJUC,NTAJUC & | |
252 | 1 | & ,XDRMUK,XDRMUP,XDRMUX,XDRMTK,XDRMTP,XDRMTX & | |
253 | 2 | & ,XDRMQK,XDRMQP,RFMESOQ,RCLX | |
254 | |||
255 | ! VERIFICATION OF CONSISTENCY BETWEEN PHYSICAL PARAMETERIZATION | ||
256 | |||
257 |
2/4✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
|
1 | IF (ETCOEF > ETDIFU.OR.ETCOEF > ETDRAG)THEN |
258 | ✗ | WRITE(UNIT=KULOUT,FMT='('' ETCOEF TOO LOW '')') | |
259 | ✗ | CALL ABOR1('SUTOPH') | |
260 | ENDIF | ||
261 |
3/6✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 1 times.
|
1 | IF (ETQSAT > ETNEBU.OR.ETQSAT > ETPLUI.OR.ETQSAT > ETCVIM)THEN |
262 | ✗ | WRITE(UNIT=KULOUT,FMT='('' ETQSAT TOO LOW '')') | |
263 | ✗ | CALL ABOR1('SUTOPH') | |
264 | ENDIF | ||
265 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
|
1 | IF (ETCVIM > ETNEBU)THEN |
266 | ✗ | WRITE(UNIT=KULOUT,FMT='('' ETCVIM TOO LOW '')') | |
267 | ✗ | CALL ABOR1('SUTOPH') | |
268 | ENDIF | ||
269 | |||
270 | ! ------------------------------------------------------------------ | ||
271 | |||
272 | !* 4. INITIALIZE MESOSPHERIC DRAG FOR U,V AND T | ||
273 | ! ----------------------------------------- | ||
274 | |||
275 |
1/4✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
|
1 | IF (LRRMES.AND..NOT.LAGPHY) THEN |
276 | WRITE (UNIT=KULOUT,FMT='('' PROFIL VERTICAL DE DRAG MESO'',/& | ||
277 | & ,'' LEV'',T15,''VITESSE'',T45,''TEMPERATURE'' & | ||
278 | ✗ | & , T65, ''HUMIDITE'' )') | |
279 | ✗ | DO JLEV=1,NFLEVG | |
280 | ✗ | RMESOU(JLEV)=XDRMUK*PMESUF(STPRE(JLEV),XDRMUP) | |
281 | ✗ | RMESOT(JLEV)=XDRMTK*PMESTF(STPRE(JLEV),XDRMTP) | |
282 | ✗ | RMESOQ(JLEV)=XDRMQK*PMESQF(STPRE(JLEV),XDRMQP) | |
283 | ✗ | IF (XDRMUX /= 0.0_JPRB) RMESOU(JLEV)=MIN(RMESOU(JLEV),XDRMUX) | |
284 | ✗ | IF (XDRMTX /= 0.0_JPRB) RMESOT(JLEV)=MIN(RMESOT(JLEV),XDRMTX) | |
285 | ✗ | ZMESU=1.0_JPRB/MAX(1.E-8_JPRB,RMESOU(JLEV)*3600._JPRB*24._JPRB) | |
286 | ✗ | ZMEST=1.0_JPRB/MAX(1.E-8_JPRB,RMESOT(JLEV)*3600._JPRB*24._JPRB) | |
287 | ✗ | ZMESQ=1.0_JPRB/MAX(1.E-8_JPRB,RMESOQ(JLEV)*3600._JPRB*24._JPRB) | |
288 | WRITE (UNIT=KULOUT,FMT='(I3,T10,E9.3,T20,G9.3,T40,E9.3,T50 & | ||
289 | ✗ | & ,G9.3, T70,E9.3, T80,G9.3)') JLEV,RMESOU(JLEV),ZMESU, & | |
290 | ✗ | & RMESOT(JLEV),ZMEST, & | |
291 | ✗ | & RMESOQ(JLEV),ZMESQ | |
292 | ENDDO | ||
293 | ENDIF | ||
294 | |||
295 | ! ------------------------------------------------------------------ | ||
296 | |||
297 |
1/2✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
|
1 | IF (LHOOK) CALL DR_HOOK('SUTOPH',1,ZHOOK_HANDLE) |
298 | 1 | END SUBROUTINE SUTOPH | |
299 |