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 |
|
|
#include "namtoph.h" |
92 |
|
|
|
93 |
|
|
! ------------------------------------------------------------------ |
94 |
|
|
|
95 |
|
|
!* Mesospheric drag shape function |
96 |
|
|
|
97 |
|
|
! PMESUF(PAP,PAPX) = MAX( (PAPX-PAP)/MAX(PAP**1.5,1.E-10),0. ) |
98 |
|
|
PMESUF(PAP,PAPX) = MAX( (PAPX-PAP)/MAX(PAP,1.E-10_JPRB),0.0_JPRB ) |
99 |
|
|
PMESTF(PAP,PAPX) = MAX( (PAPX-PAP)/MAX(PAP,1.E-10_JPRB),0.0_JPRB ) |
100 |
|
|
PMESQF(PAP,PAPX) = MAX( (PAPX-PAP)/MAX(PAP,1.E-10_JPRB),0.0_JPRB ) |
101 |
|
|
|
102 |
|
|
! ------------------------------------------------------------------ |
103 |
|
|
|
104 |
|
|
#include "abor1.intfb.h" |
105 |
|
|
#include "posnam.intfb.h" |
106 |
|
|
#include "seapre.intfb.h" |
107 |
|
|
|
108 |
|
|
! ------------------------------------------------------------------ |
109 |
|
|
|
110 |
✓✗ |
1 |
IF (LHOOK) CALL DR_HOOK('SUTOPH',0,ZHOOK_HANDLE) |
111 |
|
|
|
112 |
|
|
! ------------------------------------------------------------------ |
113 |
|
|
|
114 |
|
|
!* 1. Set default values. |
115 |
|
|
! ------------------- |
116 |
|
|
|
117 |
|
|
! 1.1 Set implicit default values |
118 |
|
|
|
119 |
|
1 |
ETQSAT=0._JPRB |
120 |
|
1 |
ETDIFU=0._JPRB |
121 |
|
1 |
ETCOEF=0._JPRB |
122 |
|
1 |
ETDRAG=0._JPRB |
123 |
|
1 |
ETCVIM=0._JPRB |
124 |
|
1 |
ETPLUI=0._JPRB |
125 |
|
1 |
ETRADI=0._JPRB |
126 |
|
1 |
ETNEBU=0._JPRB |
127 |
|
1 |
ETOZON=0._JPRB |
128 |
|
1 |
ETDRME=0._JPRB |
129 |
|
1 |
ETCOET=0._JPRB |
130 |
|
1 |
ETAJUC=0._JPRB |
131 |
|
1 |
NTQSAT=1 |
132 |
|
1 |
NTDIFU=1 |
133 |
|
1 |
NTCOEF=1 |
134 |
|
1 |
NTDRAG=1 |
135 |
|
1 |
NTCVIM=1 |
136 |
|
1 |
NTPLUI=1 |
137 |
|
1 |
NTRADI=1 |
138 |
|
1 |
NTNEBU=1 |
139 |
|
1 |
NTOZON=1 |
140 |
|
1 |
NTDRME=1 |
141 |
|
1 |
NTCOET=1 |
142 |
|
1 |
NTAJUC=1 |
143 |
|
|
|
144 |
|
1 |
XDRMUK=0._JPRB |
145 |
|
1 |
XDRMUX=0._JPRB |
146 |
|
1 |
XDRMUP=0._JPRB |
147 |
|
1 |
XDRMTK=0._JPRB |
148 |
|
1 |
XDRMTX=0._JPRB |
149 |
|
1 |
XDRMTP=0._JPRB |
150 |
|
1 |
XDRMQK=0._JPRB |
151 |
|
1 |
XDRMQP=0._JPRB |
152 |
|
|
|
153 |
|
1 |
RFMESOQ=3.725E-06_JPRB |
154 |
|
1 |
RCLX=0.0_JPRB |
155 |
|
1 |
TPSCLIM=197._JPRB |
156 |
|
|
|
157 |
|
|
! 1.2 Modify default values according to LECMWF |
158 |
|
|
|
159 |
|
|
IF (LECMWF) THEN |
160 |
|
|
ELSE |
161 |
|
|
ENDIF |
162 |
|
|
|
163 |
|
|
! ------------------------------------------------------------------ |
164 |
|
|
|
165 |
|
|
!* 2. Modify default values. |
166 |
|
|
! ---------------------- |
167 |
|
|
|
168 |
|
|
! Ce qui concerne NAMTOPH commente par MPL le 15.04.09 |
169 |
|
|
!CALL POSNAM(NULNAM,'NAMTOPH') |
170 |
|
|
!READ(NULNAM,NAMTOPH) |
171 |
|
|
|
172 |
|
|
!* 2.1 Search corresponding level, to pressure in NAMTOPH |
173 |
|
|
! for each parameterization |
174 |
|
|
|
175 |
|
|
IF(ETQSAT /= 0.0_JPRB) CALL SEAPRE (ETQSAT,NTQSAT,STPRE,NFLEVG) |
176 |
|
|
IF(ETDIFU /= 0.0_JPRB) CALL SEAPRE (ETDIFU,NTDIFU,STPRE,NFLEVG) |
177 |
|
|
IF(ETCOEF /= 0.0_JPRB) CALL SEAPRE (ETCOEF,NTCOEF,STPRE,NFLEVG) |
178 |
|
|
IF(ETDRAG /= 0.0_JPRB) CALL SEAPRE (ETDRAG,NTDRAG,STPRE,NFLEVG) |
179 |
|
|
IF(ETCVIM /= 0.0_JPRB) CALL SEAPRE (ETCVIM,NTCVIM,STPRE,NFLEVG) |
180 |
|
|
IF(ETPLUI /= 0.0_JPRB) CALL SEAPRE (ETPLUI,NTPLUI,STPRE,NFLEVG) |
181 |
|
|
IF(ETRADI /= 0.0_JPRB) THEN |
182 |
|
|
IF (LRAY) THEN |
183 |
|
|
CALL SEAPRE (ETRADI,NTRADI,STPRE,NFLEVG) |
184 |
|
|
ENDIF |
185 |
|
|
IF (LRAYFM.OR.LRAYFM15) THEN |
186 |
|
|
ETRADI=0._JPRB |
187 |
|
|
NTRADI=1 |
188 |
|
|
ENDIF |
189 |
|
|
ENDIF |
190 |
|
|
IF(ETNEBU /= 0.0_JPRB) CALL SEAPRE (ETNEBU,NTNEBU,STPRE,NFLEVG) |
191 |
|
|
IF(ETOZON /= 0.0_JPRB) CALL SEAPRE (ETOZON,NTOZON,STPRE,NFLEVG) |
192 |
|
|
IF(ETDRME /= 0.0_JPRB) CALL SEAPRE (ETDRME,NTDRME,STPRE,NFLEVG) |
193 |
|
|
IF(ETCOET /= 0.0_JPRB) CALL SEAPRE (ETCOET,NTCOET,STPRE,NFLEVG) |
194 |
|
|
IF(ETAJUC /= 0.0_JPRB) CALL SEAPRE (ETAJUC,NTAJUC,STPRE,NFLEVG) |
195 |
|
|
! ------------------------------------------------------------------ |
196 |
|
|
|
197 |
|
|
!* 3. Print final values. |
198 |
|
|
! ------------------- |
199 |
|
|
|
200 |
|
1 |
WRITE(UNIT=KULOUT,FMT='('' COMMON YOMTOPH '')') |
201 |
|
|
WRITE(UNIT=KULOUT,FMT='('' ETQSAT = '',E10.4,'' NTQSAT = '',I10 & |
202 |
|
|
& ,'' ETDIFU = '',E10.4,'' NTDIFU = '',I10 & |
203 |
|
|
& ,/,'' ETCOEF = '',E10.4,'' NTCOEF = '',I10 & |
204 |
|
|
& ,'' ETDRAG = '',E10.4,'' NTDRAG = '',I10 & |
205 |
|
|
& ,/,'' ETCVIM = '',E10.4,'' NTCVIM = '',I10 & |
206 |
|
|
& ,'' ETPLUI = '',E10.4,'' NTPLUI = '',I10 & |
207 |
|
|
& ,/,'' ETRADI = '',E10.4,'' NTRADI = '',I10 & |
208 |
|
|
& ,'' ETNEBU = '',E10.4,'' NTNEBU = '',I10 & |
209 |
|
|
& ,/,'' ETOZON = '',E10.4,'' NTOZON = '',I10 & |
210 |
|
|
& ,'' ETDRME = '',E10.4,'' NTDRME = '',I10 & |
211 |
|
|
& ,/,'' ETCOET = '',E10.4,'' NTCOET = '',I10 & |
212 |
|
|
& ,/,'' ETAJUC = '',E10.4,'' NTAJUC = '',I10 & |
213 |
|
|
& ,/,'' XDRMUK = '',E10.4,'' XDRMUP = '',E10.4 & |
214 |
|
|
& ,'' XDRMUX = '',E10.4,'' XDRMTK = '',E10.4 & |
215 |
|
|
& ,'' XDRMTP = '',E10.4,'' XDRMTX = '',E10.4 & |
216 |
|
|
& ,'' XDRMQK = '',E11.4,'' XDRMQP = '',E11.4 & |
217 |
|
|
& ,/,'' RFMESOQ= '',E11.4,'' RCLX = '',E11.4 & |
218 |
|
|
& )')& |
219 |
|
1 |
& ETQSAT,NTQSAT,ETDIFU,NTDIFU & |
220 |
|
1 |
& ,ETCOEF,NTCOEF,ETDRAG,NTDRAG & |
221 |
|
1 |
& ,ETCVIM,NTCVIM,ETPLUI,NTPLUI & |
222 |
|
1 |
& ,ETRADI,NTRADI,ETNEBU,NTNEBU & |
223 |
|
1 |
& ,ETOZON,NTOZON,ETDRME,NTDRME & |
224 |
|
1 |
& ,ETCOET,NTCOET & |
225 |
|
1 |
& ,ETAJUC,NTAJUC & |
226 |
|
1 |
& ,XDRMUK,XDRMUP,XDRMUX,XDRMTK,XDRMTP,XDRMTX & |
227 |
|
2 |
& ,XDRMQK,XDRMQP,RFMESOQ,RCLX |
228 |
|
|
|
229 |
|
|
! VERIFICATION OF CONSISTENCY BETWEEN PHYSICAL PARAMETERIZATION |
230 |
|
|
|
231 |
✓✗✗✓
|
1 |
IF (ETCOEF > ETDIFU.OR.ETCOEF > ETDRAG)THEN |
232 |
|
|
WRITE(UNIT=KULOUT,FMT='('' ETCOEF TOO LOW '')') |
233 |
|
|
CALL ABOR1('SUTOPH') |
234 |
|
|
ENDIF |
235 |
✓✗✓✗
✗✓ |
1 |
IF (ETQSAT > ETNEBU.OR.ETQSAT > ETPLUI.OR.ETQSAT > ETCVIM)THEN |
236 |
|
|
WRITE(UNIT=KULOUT,FMT='('' ETQSAT TOO LOW '')') |
237 |
|
|
CALL ABOR1('SUTOPH') |
238 |
|
|
ENDIF |
239 |
✗✓ |
1 |
IF (ETCVIM > ETNEBU)THEN |
240 |
|
|
WRITE(UNIT=KULOUT,FMT='('' ETCVIM TOO LOW '')') |
241 |
|
|
CALL ABOR1('SUTOPH') |
242 |
|
|
ENDIF |
243 |
|
|
|
244 |
|
|
! ------------------------------------------------------------------ |
245 |
|
|
|
246 |
|
|
!* 4. INITIALIZE MESOSPHERIC DRAG FOR U,V AND T |
247 |
|
|
! ----------------------------------------- |
248 |
|
|
|
249 |
✗✓✗✗
|
1 |
IF (LRRMES.AND..NOT.LAGPHY) THEN |
250 |
|
|
WRITE (UNIT=KULOUT,FMT='('' PROFIL VERTICAL DE DRAG MESO'',/& |
251 |
|
|
& ,'' LEV'',T15,''VITESSE'',T45,''TEMPERATURE'' & |
252 |
|
|
& , T65, ''HUMIDITE'' )') |
253 |
|
|
DO JLEV=1,NFLEVG |
254 |
|
|
RMESOU(JLEV)=XDRMUK*PMESUF(STPRE(JLEV),XDRMUP) |
255 |
|
|
RMESOT(JLEV)=XDRMTK*PMESTF(STPRE(JLEV),XDRMTP) |
256 |
|
|
RMESOQ(JLEV)=XDRMQK*PMESQF(STPRE(JLEV),XDRMQP) |
257 |
|
|
IF (XDRMUX /= 0.0_JPRB) RMESOU(JLEV)=MIN(RMESOU(JLEV),XDRMUX) |
258 |
|
|
IF (XDRMTX /= 0.0_JPRB) RMESOT(JLEV)=MIN(RMESOT(JLEV),XDRMTX) |
259 |
|
|
ZMESU=1.0_JPRB/MAX(1.E-8_JPRB,RMESOU(JLEV)*3600._JPRB*24._JPRB) |
260 |
|
|
ZMEST=1.0_JPRB/MAX(1.E-8_JPRB,RMESOT(JLEV)*3600._JPRB*24._JPRB) |
261 |
|
|
ZMESQ=1.0_JPRB/MAX(1.E-8_JPRB,RMESOQ(JLEV)*3600._JPRB*24._JPRB) |
262 |
|
|
WRITE (UNIT=KULOUT,FMT='(I3,T10,E9.3,T20,G9.3,T40,E9.3,T50 & |
263 |
|
|
& ,G9.3, T70,E9.3, T80,G9.3)') JLEV,RMESOU(JLEV),ZMESU, & |
264 |
|
|
& RMESOT(JLEV),ZMEST, & |
265 |
|
|
& RMESOQ(JLEV),ZMESQ |
266 |
|
|
ENDDO |
267 |
|
|
ENDIF |
268 |
|
|
|
269 |
|
|
! ------------------------------------------------------------------ |
270 |
|
|
|
271 |
✓✗ |
1 |
IF (LHOOK) CALL DR_HOOK('SUTOPH',1,ZHOOK_HANDLE) |
272 |
|
1 |
END SUBROUTINE SUTOPH |