| [3331] | 1 | !OPTIONS XOPT(NOEVAL) |
|---|
| 2 | 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 | 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 | ETQSAT=0._JPRB |
|---|
| 120 | ETDIFU=0._JPRB |
|---|
| 121 | ETCOEF=0._JPRB |
|---|
| 122 | ETDRAG=0._JPRB |
|---|
| 123 | ETCVIM=0._JPRB |
|---|
| 124 | ETPLUI=0._JPRB |
|---|
| 125 | ETRADI=0._JPRB |
|---|
| 126 | ETNEBU=0._JPRB |
|---|
| 127 | ETOZON=0._JPRB |
|---|
| 128 | ETDRME=0._JPRB |
|---|
| 129 | ETCOET=0._JPRB |
|---|
| 130 | ETAJUC=0._JPRB |
|---|
| 131 | NTQSAT=1 |
|---|
| 132 | NTDIFU=1 |
|---|
| 133 | NTCOEF=1 |
|---|
| 134 | NTDRAG=1 |
|---|
| 135 | NTCVIM=1 |
|---|
| 136 | NTPLUI=1 |
|---|
| 137 | NTRADI=1 |
|---|
| 138 | NTNEBU=1 |
|---|
| 139 | NTOZON=1 |
|---|
| 140 | NTDRME=1 |
|---|
| 141 | NTCOET=1 |
|---|
| 142 | NTAJUC=1 |
|---|
| 143 | |
|---|
| 144 | XDRMUK=0._JPRB |
|---|
| 145 | XDRMUX=0._JPRB |
|---|
| 146 | XDRMUP=0._JPRB |
|---|
| 147 | XDRMTK=0._JPRB |
|---|
| 148 | XDRMTX=0._JPRB |
|---|
| 149 | XDRMTP=0._JPRB |
|---|
| 150 | XDRMQK=0._JPRB |
|---|
| 151 | XDRMQP=0._JPRB |
|---|
| 152 | |
|---|
| 153 | RFMESOQ=3.725E-06_JPRB |
|---|
| 154 | RCLX=0.0_JPRB |
|---|
| 155 | 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 | 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 | & ETQSAT,NTQSAT,ETDIFU,NTDIFU & |
|---|
| 220 | & ,ETCOEF,NTCOEF,ETDRAG,NTDRAG & |
|---|
| 221 | & ,ETCVIM,NTCVIM,ETPLUI,NTPLUI & |
|---|
| 222 | & ,ETRADI,NTRADI,ETNEBU,NTNEBU & |
|---|
| 223 | & ,ETOZON,NTOZON,ETDRME,NTDRME & |
|---|
| 224 | & ,ETCOET,NTCOET & |
|---|
| 225 | & ,ETAJUC,NTAJUC & |
|---|
| 226 | & ,XDRMUK,XDRMUP,XDRMUX,XDRMTK,XDRMTP,XDRMTX & |
|---|
| 227 | & ,XDRMQK,XDRMQP,RFMESOQ,RCLX |
|---|
| 228 | |
|---|
| 229 | ! VERIFICATION OF CONSISTENCY BETWEEN PHYSICAL PARAMETERIZATION |
|---|
| 230 | |
|---|
| 231 | IF (ETCOEF > ETDIFU.OR.ETCOEF > ETDRAG)THEN |
|---|
| 232 | WRITE(UNIT=KULOUT,FMT='('' ETCOEF TOO LOW '')') |
|---|
| 233 | CALL ABOR1('SUTOPH') |
|---|
| 234 | ENDIF |
|---|
| 235 | 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 | 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 | 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 | IF (LHOOK) CALL DR_HOOK('SUTOPH',1,ZHOOK_HANDLE) |
|---|
| 272 | END SUBROUTINE SUTOPH |
|---|
