[2089] | 1 | subroutine Atm_RT_INI |
---|
| 2 | |
---|
| 3 | !--------------------------------------------------------------------------+ |
---|
| 4 | ! Mon 24-Jun-2013 MAR | |
---|
| 5 | ! subroutine Atm_RT_INI initializes MAR PHYsics interface | |
---|
| 6 | ! with ECMWF Solar/Infrared Radiative Transfer Scheme | |
---|
| 7 | ! | |
---|
| 8 | ! version 3.p.4.1 created by H. Gallee, Tue 2-Apr-2013 | |
---|
| 9 | ! Last Modification by H. Gallee, Mon 24-Jun-2013 | |
---|
| 10 | ! | |
---|
| 11 | !--------------------------------------------------------------------------+ |
---|
| 12 | ! | |
---|
| 13 | ! Content: CALL of - ECMWF Code initializing the Radiation Transfert | |
---|
| 14 | ! - ECMWF Radiation Transfert | |
---|
| 15 | ! | |
---|
| 16 | ! ECMWF Code Source: J.-J. Morcrette, 28 nov 2002 | |
---|
| 17 | ! | |
---|
| 18 | !--------------------------------------------------------------------------+ |
---|
| 19 | |
---|
| 20 | use Mod_Real |
---|
| 21 | use Mod_PHY_RT_dat |
---|
| 22 | use Mod_PHY____grd |
---|
| 23 | use Mod_PHY_S0_grd |
---|
| 24 | use Mod_PHY_RT_grd |
---|
| 25 | use Mod_PHY_DY_kkl |
---|
| 26 | use Mod_SISVAT_gpt |
---|
| 27 | |
---|
| 28 | |
---|
| 29 | |
---|
| 30 | #include "tsmbkind.h" |
---|
| 31 | |
---|
| 32 | |
---|
| 33 | |
---|
| 34 | |
---|
| 35 | ! Global Variables (ECMWF) |
---|
| 36 | ! ======================== |
---|
| 37 | |
---|
| 38 | USE PARRTM1D , ONLY : JP_LON ,JP_IDIA ,JP_FDIA ,JP_TDIA ,& |
---|
| 39 | & JP_LEV ,JP_LW ,JP_SW ,JP_NUA ,JP_MODE ,& |
---|
| 40 | & JP_AER ,JP_LEVP1 |
---|
| 41 | USE YOMCST , ONLY : RD ,RG ,RTT ,RSIGMA ,& |
---|
| 42 | & RCPD ,RPI ,RDAY ,REA ,RI0 ,& |
---|
| 43 | & REPSM ,RMD ,RKBOL ,RNAVO ,R ,& |
---|
| 44 | & RLVTT ,RLSTT |
---|
| 45 | USE YOERAD , ONLY : NSW ,NTSW ,NRADFR ,& |
---|
| 46 | & LRRTM ,LINHOM ,LOIFUEC ,LTEMPDS ,LOWASYF ,& |
---|
| 47 | & LOWHSSS,LONEWSW ,LNEWAER ,LHVOLCA ,& |
---|
| 48 | & NRADIP ,NRADLP ,NOZOCL ,& |
---|
| 49 | & NICEOPT,NLIQOPT ,NOVLP ,NHOWINH ,RMINICE |
---|
| 50 | USE YOEAERD , ONLY : CVDAES ,CVDAEL ,CVDAEU ,CVDAED ,& |
---|
| 51 | & RCTRBGA,RCVOBGA ,RCSTBGA ,RCAEOPS ,RCAEOPL ,RCAEOPU ,& |
---|
| 52 | & RCAEOPD,RCTRPT ,RCAEADK ,RCAEADM ,RCAEROS |
---|
| 53 | USE YOERDI , ONLY : RCH4 ,RN2O ,RO3 ,RCFC11 ,& |
---|
| 54 | & RCFC12 |
---|
| 55 | USE YOERDU , ONLY : RCDAY ,R10E ,DIFF ,REPLOG ,& |
---|
| 56 | & REPSC ,REPSCO ,REPSCQ ,REPSCT ,REPSCW ,& |
---|
| 57 | & NTRAER |
---|
| 58 | USE YOETHF , ONLY : R2ES ,R3LES ,R3IES ,R4LES ,& |
---|
| 59 | & R4IES ,R5LES ,R5IES ,R5ALVCP ,R5ALSCP ,& |
---|
| 60 | & RALVDCP,RALSDCP ,RTWAT ,RTICE ,RTICECU |
---|
| 61 | |
---|
| 62 | |
---|
| 63 | |
---|
| 64 | |
---|
| 65 | IMPLICIT NONE |
---|
| 66 | |
---|
| 67 | |
---|
| 68 | |
---|
| 69 | |
---|
| 70 | ! INTERNAL VARIABLES |
---|
| 71 | ! ================== |
---|
| 72 | |
---|
| 73 | integer :: i ,j ,ikl |
---|
| 74 | |
---|
| 75 | ! For Use in radlsw |
---|
| 76 | ! ^^^^^^^^^^^^^^^^^ |
---|
| 77 | INTEGER_M :: KIDIA ,KFDIA ,KTDIA ,KLON ,KLEV |
---|
| 78 | INTEGER_M :: KMODE ,KAER ,KSW |
---|
| 79 | |
---|
| 80 | INTEGER_M :: KBOX ,NBOX |
---|
| 81 | INTEGER_M :: NDUMP ,ILWRAD |
---|
| 82 | ! |
---|
| 83 | REAL_B :: PRII05 |
---|
| 84 | |
---|
| 85 | REAL_B :: PAER5(JP_LON,JP_AER,JP_LEV) ! Aerosol Optical Depth |
---|
| 86 | REAL_B :: PALBD5(JP_LON,JP_SW) |
---|
| 87 | REAL_B :: PALBP5(JP_LON,JP_SW) |
---|
| 88 | ! |
---|
| 89 | REAL_B :: PAPH5(JP_LON,JP_LEVP1) |
---|
| 90 | REAL_B :: PAP5(JP_LON,JP_LEV) |
---|
| 91 | ! |
---|
| 92 | REAL_B :: PCCO25 |
---|
| 93 | REAL_B :: PCLFR5(JP_LON,JP_LEV) |
---|
| 94 | REAL_B :: PDP5(JP_LON,JP_LEV) |
---|
| 95 | REAL_B :: PEMIS5(JP_LON) |
---|
| 96 | REAL_B :: PEMIW5(JP_LON) |
---|
| 97 | REAL_B :: PLSM5(JP_LON) |
---|
| 98 | REAL_B :: PMU05(JP_LON) |
---|
| 99 | REAL_B :: POZON5(JP_LON,JP_LEV) |
---|
| 100 | REAL_B :: PQ5(JP_LON,JP_LEV) |
---|
| 101 | ! |
---|
| 102 | REAL_B :: PQIWP5(JP_LON,JP_LEV) |
---|
| 103 | REAL_B :: PQLWP5(JP_LON,JP_LEV) ! Dropplets Concentration |
---|
| 104 | REAL_B :: PSQIW5(JP_LON,JP_LEV) ! Ice Crystals Concentration |
---|
| 105 | REAL_B :: PSQLW5(JP_LON,JP_LEV) ! |
---|
| 106 | REAL_B :: PQS5(JP_LON,JP_LEV) |
---|
| 107 | REAL_B :: PQRAIN5(JP_LON,JP_LEV) |
---|
| 108 | REAL_B :: PRAINT5(JP_LON,JP_LEV) |
---|
| 109 | REAL_B :: PRLVRI5(JP_LON,JP_LEV) |
---|
| 110 | REAL_B :: PRLVRL5(JP_LON,JP_LEV) |
---|
| 111 | REAL_B :: PTH5(JP_LON,JP_LEVP1) |
---|
| 112 | REAL_B :: PT5(JP_LON,JP_LEV) |
---|
| 113 | REAL_B :: PTS5(JP_LON) |
---|
| 114 | REAL_B :: PNBAS5(JP_LON) |
---|
| 115 | REAL_B :: PNTOP5(JP_LON) |
---|
| 116 | |
---|
| 117 | ! For Use in SUCLD |
---|
| 118 | ! ^^^^^^^^^^^^^^^^ |
---|
| 119 | REAL_B :: ZETA(JP_LEV) |
---|
| 120 | REAL_B :: ZETAH(JP_LEVP1) |
---|
| 121 | |
---|
| 122 | ! For Use in SUOVLP |
---|
| 123 | ! ^^^^^^^^^^^^^^^^^ |
---|
| 124 | REAL_B :: ZTVIR |
---|
| 125 | REAL_B :: ZFACT |
---|
| 126 | REAL_B :: ZAZ(JP_LEV) |
---|
| 127 | REAL_B :: ZAZH(JP_LEVP1) |
---|
| 128 | |
---|
| 129 | |
---|
| 130 | |
---|
| 131 | ! Local Variables |
---|
| 132 | ! ---------------- |
---|
| 133 | |
---|
| 134 | REAL_B :: RTIMTR |
---|
| 135 | |
---|
| 136 | INTEGER_M :: JL , JK , JAER ,JNU |
---|
| 137 | INTEGER_M :: KULOUT , NINDAT , NSSSSS ,KPRTLEV |
---|
| 138 | INTEGER_M :: IYR , MONTH , IDAY ,IMINUT |
---|
| 139 | INTEGER_M :: KPRINT , SKSHIFT |
---|
| 140 | |
---|
| 141 | |
---|
| 142 | |
---|
| 143 | |
---|
| 144 | ! Load External Functions |
---|
| 145 | ! ======================= |
---|
| 146 | |
---|
| 147 | #include "fctast.h" |
---|
| 148 | #include "fcttim.h" |
---|
| 149 | #include "fcttre.h" |
---|
| 150 | |
---|
| 151 | |
---|
| 152 | KPRTLEV= 1 |
---|
| 153 | KPRINT = 1 |
---|
| 154 | SKSHIFT= 0 |
---|
| 155 | |
---|
| 156 | |
---|
| 157 | |
---|
| 158 | |
---|
| 159 | ! Time Base |
---|
| 160 | ! ========= |
---|
| 161 | |
---|
| 162 | NINDAT = min(yearTU,2004)*10000+mon_TU*100+Day_TU ! Date in the form yyyyMMdd |
---|
| 163 | NSSSSS = HourTU * 3600+minuTU* 60+sec_TU ! Nb of second since day Begin |
---|
| 164 | IYR = NAA(NINDAT) |
---|
| 165 | MONTH = NMM(NINDAT) |
---|
| 166 | IDAY = NDD(NINDAT) |
---|
| 167 | RTIMTR = RTIME(IYR,MONTH,IDAY,NSSSSS) |
---|
| 168 | IMINUT = INT(FLOAT(NSSSSS)/60.) |
---|
| 169 | |
---|
| 170 | |
---|
| 171 | |
---|
| 172 | |
---|
| 173 | ! Basic Initialization |
---|
| 174 | ! ==================== |
---|
| 175 | |
---|
| 176 | ! Dimensions (auxiliary variables) |
---|
| 177 | ! -------------------------------- |
---|
| 178 | |
---|
| 179 | KIDIA = 1 ! DO'NT CHANGE |
---|
| 180 | KFDIA = JP_LON ! Nb Columns |
---|
| 181 | KTDIA = 1 ! |
---|
| 182 | KLON = JP_LON ! Nb Columns |
---|
| 183 | KLEV = JP_LEV ! Nb Levels |
---|
| 184 | KMODE = JP_MODE ! Used in Planck Fcts Specification |
---|
| 185 | KAER = JP_AER ! |
---|
| 186 | |
---|
| 187 | ! Nb of Solar Spectral Intervals |
---|
| 188 | ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ |
---|
| 189 | KSW = JP_SW ! SW Nb of Spectral Intervals (max is JP_SW=6) |
---|
| 190 | NSW = JP_SW ! SW Nb of Spectral Intervals (max is JP_SW=6) |
---|
| 191 | NTSW = JP_SW ! SW Nb of Spectral Intervals (max is JP_SW=6) |
---|
| 192 | |
---|
| 193 | KBOX = 0 ! \VER |
---|
| 194 | NBOX = 1 ! \VER |
---|
| 195 | |
---|
| 196 | ILWRAD = 1 ! 0: Morcrette, 1991 operational before 20000627 |
---|
| 197 | ! 1: Mlawer et al., 1997 now ECMWF-operational |
---|
| 198 | ! 2: Morcrette, 1991 original as in ERA-15' |
---|
| 199 | |
---|
| 200 | NDUMP = 3 ! No Print |
---|
| 201 | ! NDUMP = 2 ! 1D Results |
---|
| 202 | ! NDUMP = 1 ! Debug |
---|
| 203 | ! NDUMP = 0 ! ALL |
---|
| 204 | KULOUT = 6 ! Output Device for SUCST |
---|
| 205 | |
---|
| 206 | |
---|
| 207 | ! Verification of the Dimensions |
---|
| 208 | ! ------------------------------ |
---|
| 209 | |
---|
| 210 | write(6,*) 'INITIALISATION OF ECMWF RADIATIVE TRANSFERT: BEGIN' |
---|
| 211 | |
---|
| 212 | write(6,*) 'CONTROL' |
---|
| 213 | write(6,*) 'JP_LON=',JP_LON |
---|
| 214 | write(6,*) 'kcolp',kcolp |
---|
| 215 | IF (kcolp .GT.JP_LON) THEN |
---|
| 216 | write(6,6001) kcolp ,JP_LON |
---|
| 217 | 6001 format(' @!#& BAD dimensions SET-UP (kcolp > JP_LON); = ('& |
---|
| 218 | & ,i3,',',i3,')') |
---|
| 219 | STOP |
---|
| 220 | END IF |
---|
| 221 | IF (mzp .NE.JP_LEV) THEN |
---|
| 222 | write(6,6002) mzp ,JP_LEV |
---|
| 223 | 6002 format(' @!#& BAD dimensions SET-UP (mzp /= JP_LEV); = ('& |
---|
| 224 | & ,i3,',',i3,')') |
---|
| 225 | STOP |
---|
| 226 | END IF |
---|
| 227 | IF (naero .NE.JP_AER) THEN |
---|
| 228 | write(6,6003) naero ,JP_AER |
---|
| 229 | 6003 format(' @!#& BAD dimensions SET-UP (naero/= JP_AER); = ('& |
---|
| 230 | & ,i3,',',i3,')') |
---|
| 231 | STOP |
---|
| 232 | END IF |
---|
| 233 | |
---|
| 234 | |
---|
| 235 | ! Mathematical Constants |
---|
| 236 | ! ---------------------- |
---|
| 237 | |
---|
| 238 | REPLOG = 1.E-12 ! Minimum Logarithm Argument |
---|
| 239 | REPSC = 1.E-12 |
---|
| 240 | REPSCO = 1.E-12 |
---|
| 241 | REPSCQ = 1.E-12 |
---|
| 242 | REPSCT = 1.E-12 |
---|
| 243 | REPSCW = 1.E-12 |
---|
| 244 | |
---|
| 245 | |
---|
| 246 | ! Switches (general) |
---|
| 247 | ! ------------------ |
---|
| 248 | |
---|
| 249 | LONEWSW= .TRUE. ! .TRUE. SWSN radiative routine is used |
---|
| 250 | IF (ILWRAD.EQ.1) THEN |
---|
| 251 | LRRTM = .TRUE. ! .TRUE. RRTM radiative routine is used |
---|
| 252 | ELSE |
---|
| 253 | LRRTM = .FALSE. ! .FALSE.RRTM radiative routine is NOT used |
---|
| 254 | END IF |
---|
| 255 | LTEMPDS= .FALSE. ! .TRUE. ALLOWS FOR SURF. T DISCONTIN. IN RAD.COMPUT. |
---|
| 256 | |
---|
| 257 | NTRAER = 19 ! NUMBER OF TRANSMISSION FUNCTIONS W OR W/O AEROSOLS |
---|
| 258 | |
---|
| 259 | |
---|
| 260 | ! Switches (Clouds Optical Properties) |
---|
| 261 | ! ------------------------------------ |
---|
| 262 | |
---|
| 263 | LINHOM = .FALSE. ! Tiedke (1995) correct. factor (0.7) of tau not used |
---|
| 264 | NHOWINH= 2 ! Tau correction factor: exp(-(sig/tau)^2) |
---|
| 265 | ! (used if LINHOM = .TRUE.) |
---|
| 266 | LOIFUEC= .FALSE. ! .FALSE. IF ICE CLOUDS AS EBERT-CURRY (LW & SW) |
---|
| 267 | LOWASYF= .FALSE. ! .FALSE. IF WATER CLOUDS AS FOUQUART (SW) |
---|
| 268 | LOWHSSS= .FALSE. ! .FALSE. IF WATER CLOUDS AS SMITH-SHI (LW) |
---|
| 269 | NRADIP = 3 ! Ice effective Radius: |
---|
| 270 | ! 0 fixed 40 microns |
---|
| 271 | ! 1 f(T) 40 - 130 microns |
---|
| 272 | ! 2 f(T) 30 - 60 microns Jakob-Klein |
---|
| 273 | ! 3 f(T,IWC) Sun-Rikus, 1999 |
---|
| 274 | RMINICE= 15 ! Minimum Diameter for Ice Particles (micronm) |
---|
| 275 | ! Needed only if NRADIP = 3 |
---|
| 276 | ! (see von Walden et al., 2003 (Oct) Tab. 2 p.1393) |
---|
| 277 | NRADLP = 0 ! Liquid effective Radius: f(Pressure) |
---|
| 278 | ! 0 effective radius - liquid as f(Pressure) |
---|
| 279 | ! 1 fixed 10 microns over land, 13 over ocean |
---|
| 280 | ! 2 computed from LWC Martin et al, 1994 |
---|
| 281 | NLIQOPT= 1 ! Cloud Optical Properties (Water): 1=ECMWF Operat. |
---|
| 282 | ! 0 LW: Smith-Shi, 1992; SW: Fouquart, 1987 |
---|
| 283 | ! 1 LW: Savijarvi, 1997; SW: Slingo , 1989 |
---|
| 284 | ! 2 LW: Lindner,Li, 2000; SW: Slingo , 1989 |
---|
| 285 | NICEOPT= 1 ! Cloud Optical Properties (Ice) : 1=ECMWF Operat. |
---|
| 286 | ! 0 LW: Smith,Shi , 1992; SW: Ebert-Curry, 1992 |
---|
| 287 | ! 1 LW: Ebert,Curry, 1992; SW: Ebert-Curry, 1992 |
---|
| 288 | ! 2 LW: Fu,Liou , 1993; SW: Fu,Liou , 1993 |
---|
| 289 | ! 3 LW: Fu et al. , 1998; SW: Fu , 1996 |
---|
| 290 | NOVLP = 2 ! CLOUD OVERLAP CONFIGURATION: |
---|
| 291 | ! 1=MRN, 2=MAX, 3=RAN, 4=Hogan |
---|
| 292 | |
---|
| 293 | |
---|
| 294 | ! Switches (Aerosols/O3) |
---|
| 295 | ! ---------------------- |
---|
| 296 | |
---|
| 297 | LNEWAER= .TRUE. ! Climatology of Aerosols: TEGEN ET AL. 1997 / GADS |
---|
| 298 | LHVOLCA= .TRUE. ! .TRUE. IF GISS HISTORY OF VOLCANIC AEROSOLS IS ON |
---|
| 299 | ! NOZOCL = -1 ! TESTS the vertical quadrature (NO absorber) |
---|
| 300 | ! NOZOCL = 0 ! whatever is read for O3 as input profile |
---|
| 301 | ! NOZOCL = 1 ! OLD ECMWF O3 climatology and aerosols |
---|
| 302 | NOZOCL = 2 ! Fortuin-Langematz O3 climatology and aerosols |
---|
| 303 | ! NOZOCL = 3 ! OLD ECMWF O3 climatology and NO aerosols |
---|
| 304 | ! NOZOCL = 4 ! Fortuin-Langematz O3 climatology and NO aerosols |
---|
| 305 | |
---|
| 306 | |
---|
| 307 | ! BASIC CONSTANTS |
---|
| 308 | ! --------------- |
---|
| 309 | |
---|
| 310 | ! ***** |
---|
| 311 | CALL SUCST (KULOUT, NINDAT, NSSSSS, KPRTLEV) ! Initialize common YOMCST |
---|
| 312 | ! ***** ! (Basic Constants) |
---|
| 313 | ! Initialize common YOMRIP |
---|
| 314 | ! (only date and time) |
---|
| 315 | |
---|
| 316 | ! YOENCST - THERMODYNAMIC TRANSITION OF PHASE |
---|
| 317 | ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ |
---|
| 318 | RTT=273.16 ! |
---|
| 319 | |
---|
| 320 | ! YOETHF - DERIVED CONSTANTS SPECIFIC TO ECMWF THERMODYNAMICS |
---|
| 321 | ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ |
---|
| 322 | RTWAT=RTT ! |
---|
| 323 | RTICE=RTT-23. ! |
---|
| 324 | |
---|
| 325 | ! YOERDU - CONTROL, PARAMETERS AND SECURITY IN RADIATION |
---|
| 326 | ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ |
---|
| 327 | RCDAY = RDAY * RG / RCPD ! |
---|
| 328 | R10E = 0.4342945 ! DECIMAL / NATURAL |
---|
| 329 | ! LOG. FACTOR |
---|
| 330 | DIFF = 1.66 ! DIFFUSIVITY FACTOR |
---|
| 331 | |
---|
| 332 | |
---|
| 333 | ! Space/Time Independant Coefficients |
---|
| 334 | ! ----------------------------------- |
---|
| 335 | |
---|
| 336 | CALL SURDI ! ECMWF Surface Albedo, Emissivity |
---|
| 337 | CALL SULWN ! Initialize common YOELW (new LW Coeff.) |
---|
| 338 | CALL SUOLW ! Initialize common YOELW (old LW Coeff.) |
---|
| 339 | |
---|
| 340 | ! Initialization routine for RRTM |
---|
| 341 | ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ |
---|
| 342 | CALL SURRTAB ! AER'S RRTM LW RADIATION |
---|
| 343 | CALL SURRTPK ! Initialize common YOERRTWN |
---|
| 344 | ! (k-coefficients in spectral intervals) |
---|
| 345 | CALL SURRTRF ! Initialize common YOERRTRF |
---|
| 346 | ! (RRTM Reference Atmosphere) |
---|
| 347 | CALL SURRTFTR ! Initialize common YOERRTRF |
---|
| 348 | |
---|
| 349 | ! RRTM routine ! BAND [cm-1] ! low ! high |
---|
| 350 | ! ----------------------+---------------+---------------+--------- |
---|
| 351 | CALL RRTM_KGB1 ! 1: 10- 250 ! H2O ! H2O |
---|
| 352 | CALL RRTM_KGB2 ! 2: 250- 500 ! H2O ! H2O |
---|
| 353 | CALL RRTM_KGB3 ! 3: 500- 630 ! H2O,CO2 ! H2O,CO2 |
---|
| 354 | CALL RRTM_KGB4 ! 4: 630- 700 ! H2O,CO2 ! O3,CO2 |
---|
| 355 | CALL RRTM_KGB5 ! 5: 700- 820 ! H2O,CO2 ! O3,CO2 |
---|
| 356 | CALL RRTM_KGB6 ! 6: 820- 980 ! H2O ! nothing |
---|
| 357 | CALL RRTM_KGB7 ! 7: 980-1080 ! H2O,O3 ! O3 |
---|
| 358 | CALL RRTM_KGB8 ! 8: 1080-1180 ! (i.e.>~300mb) ! O3 |
---|
| 359 | ! ! H2O ! |
---|
| 360 | CALL RRTM_KGB9 ! 9: 1180-1390 ! H2O,CH4 ! CH4 |
---|
| 361 | CALL RRTM_KGB10 ! 10: 1390-1480 ! H2O ! H2O |
---|
| 362 | CALL RRTM_KGB11 ! 11: 1480-1800 ! H2O ! H2O |
---|
| 363 | CALL RRTM_KGB12 ! 12: 1800-2080 ! H2O,CO2 ! nothing |
---|
| 364 | CALL RRTM_KGB13 ! 13: 2080-2250 ! H2O,N2O ! nothing |
---|
| 365 | CALL RRTM_KGB14 ! 14: 2250-2380 ! CO2 ! CO2 |
---|
| 366 | CALL RRTM_KGB15 ! 15: 2380-2600 ! N2O,CO2 ! nothing |
---|
| 367 | CALL RRTM_KGB16 ! 16: 2600-3000 ! H2O,CH4 ! nothing |
---|
| 368 | |
---|
| 369 | ! Reduce absorption coefficient data from 256 to 140 g-points |
---|
| 370 | ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ |
---|
| 371 | CALL RRTM_INIT_140GP |
---|
| 372 | |
---|
| 373 | ! Initialization routine for SW (6 spectral interval resolution) |
---|
| 374 | ! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ |
---|
| 375 | CALL SUSWN ( NTSW , KSW ) ! Initialize common YOESW |
---|
| 376 | |
---|
| 377 | |
---|
| 378 | write(6,*) 'INITIALISATION OF ECMWF RADIATIVE TRANSFERT: END ' |
---|
| 379 | |
---|
| 380 | |
---|
| 381 | |
---|
| 382 | |
---|
| 383 | ! Radiation: Global (Time dependant) Parameters |
---|
| 384 | ! ============================================= |
---|
| 385 | |
---|
| 386 | PRII05 = RI0 ! INSOLATION |
---|
| 387 | ! PRII05 = RI0/(dST_UA*dST_UA) ! INSOLATION (dST_UA: Distance Soleil-Terre [UA]) |
---|
| 388 | PCCO25 = 360.E-06*44./29. ! CONCENTRATION IN CO2 [Pa/Pa] |
---|
| 389 | |
---|
| 390 | |
---|
| 391 | |
---|
| 392 | |
---|
| 393 | ! Surface Properties |
---|
| 394 | ! ================== |
---|
| 395 | |
---|
| 396 | ! Land/sea Mask |
---|
| 397 | ! ------------- |
---|
| 398 | |
---|
| 399 | ! Martin CONTROL |
---|
| 400 | !PRINT*, 'CONTROL dans Atm_RT_INI' |
---|
| 401 | !PRINT*,'SIZE(psa_DY)=)',SIZE(psa_DY) |
---|
| 402 | !PRINT*, 'psa_DY=',psa_DY |
---|
| 403 | ! Martin CONTROL |
---|
| 404 | |
---|
| 405 | DO jl=1,KLON |
---|
| 406 | ikl = min(jl,kcolp) |
---|
| 407 | i = ii__AP(ikl) |
---|
| 408 | j = jj__AP(ikl) |
---|
| 409 | PLSM5 (JL) = 1 - MaskSV_gpt(ikl) |
---|
| 410 | |
---|
| 411 | |
---|
| 412 | |
---|
| 413 | |
---|
| 414 | ! Atmospheric Thermodynamics (Time and Space dependant) |
---|
| 415 | ! ===================================================== |
---|
| 416 | |
---|
| 417 | ! Pressure Distribution |
---|
| 418 | ! -------------------------- |
---|
| 419 | |
---|
| 420 | JK=1+KLEV |
---|
| 421 | PAPH5 (JL,JK) = (psa_DY(ikl) + pt__DY) * 1000. ! Pressure (Layer Interface)[Pa] |
---|
| 422 | DO JK=1,KLEV |
---|
| 423 | PAPH5 (JL,JK) = (psa_DY(ikl) * sigma(JK) + pt__DY) * 1000. ! Pressure (Layer) [Pa] |
---|
| 424 | PAP5 (JL,JK) = (psa_DY(ikl) * sigmi(JK) + pt__DY) * 1000. ! Pressure (Layer Interface)[Pa] |
---|
| 425 | PDP5 (JL,JK) = psa_DY(ikl) *dsigmi(JK) * 1000. ! Pressure (Layer Thickness)[Pa] |
---|
| 426 | |
---|
| 427 | |
---|
| 428 | ! Temperature Distribution |
---|
| 429 | ! -------------------------- |
---|
| 430 | |
---|
| 431 | PT5 (JL,JK) = Ta__DY(ikl,JK) |
---|
| 432 | |
---|
| 433 | |
---|
| 434 | ! Water Species Distribution |
---|
| 435 | ! -------------------------- |
---|
| 436 | |
---|
| 437 | PQ5 (JL,JK) = qv__DY(ikl,JK) ! Water Vapor Concentr. [kg/kg] |
---|
| 438 | |
---|
| 439 | ENDDO |
---|
| 440 | ENDDO |
---|
| 441 | |
---|
| 442 | |
---|
| 443 | |
---|
| 444 | |
---|
| 445 | ! Initialization (Climatologies, Time independant) |
---|
| 446 | ! ================================================ |
---|
| 447 | |
---|
| 448 | ! Aerosols Radiative Characteristics (YOEAER) |
---|
| 449 | ! ---------------------------------- |
---|
| 450 | |
---|
| 451 | ! ******* |
---|
| 452 | CALL SUAERL ! Aerosols LW Radiative Charact. |
---|
| 453 | CALL SUAERSN ( NTSW , KSW ) ! Aerosols SW Radiative Charact. |
---|
| 454 | ! ******* |
---|
| 455 | |
---|
| 456 | |
---|
| 457 | ! Aerosols Optical Thickness Horizontal Distribution (model grid |
---|
| 458 | ! -------------------------------------------------- independant) |
---|
| 459 | |
---|
| 460 | ! ******** |
---|
| 461 | CALL SUAERH ! |
---|
| 462 | CALL SUECAEBC ! BLACK CARBON (URBAN/FOREST FIRE ORIGIN) |
---|
| 463 | CALL SUECAEOR ! ORGANIC-TYPE |
---|
| 464 | CALL SUECAESD ! SOIL-DUST ORIGIN |
---|
| 465 | CALL SUECAESS ! SEA -SALT ORIGIN |
---|
| 466 | CALL SUECAESU ! SULFATE-TYPE |
---|
| 467 | ! ******** |
---|
| 468 | |
---|
| 469 | |
---|
| 470 | ! Clouds (YOECLD) |
---|
| 471 | ! --------------- |
---|
| 472 | |
---|
| 473 | DO jk=1,klev |
---|
| 474 | ZETA(jk) =PAP5(1,jk) /PAPH5(1,klev+1) |
---|
| 475 | ENDDO |
---|
| 476 | DO jk=1,klev+1 |
---|
| 477 | ZETAH(jk)=PAPH5(1,jk)/PAPH5(1,klev+1) |
---|
| 478 | ENDDO |
---|
| 479 | ! Martin Control |
---|
| 480 | !PRINT*, 'PAPH5(1,:)=',PAPH5(1,:) |
---|
| 481 | !PRINT*, 'ZETAH=',ZETAH |
---|
| 482 | ! Martin Control |
---|
| 483 | |
---|
| 484 | ! ***** |
---|
| 485 | CALL SUCLD ( KLEV , ZETA ) |
---|
| 486 | ! ***** |
---|
| 487 | |
---|
| 488 | |
---|
| 489 | ! Cloud Optical Parameters SW/LW (all parameterizations) |
---|
| 490 | ! ------------------------------------------------------ |
---|
| 491 | |
---|
| 492 | ! ******* |
---|
| 493 | CALL SUCLOPN ( NTSW , KSW , KLEV ) ! Initialize YOECLOP |
---|
| 494 | ! ******* |
---|
| 495 | |
---|
| 496 | |
---|
| 497 | ! Radar Reflectivity |
---|
| 498 | ! ------------------ |
---|
| 499 | |
---|
| 500 | ZAZH(KLEV+1)= 0. |
---|
| 501 | ZAZ(1) =100000. |
---|
| 502 | JL=KIDIA |
---|
| 503 | DO jk=KLEV,2,-1 |
---|
| 504 | ZTVIR = PT5(JL,jk) /(1.-0.608*PQ5(jl,jk)) |
---|
| 505 | ZFACT = LOG(PAPH5(jl,jk+1))- LOG(PAPH5(jl,jk)) |
---|
| 506 | ZAZH(jk) = ZAZH(jk+1) + R * ZTVIR/(RMD*RG)*ZFACT |
---|
| 507 | ZAZ(jk) = 0.5*(ZAZH(jk+1)+ZAZH(jk))*1000. |
---|
| 508 | END DO |
---|
| 509 | |
---|
| 510 | ! ****** |
---|
| 511 | CALL SUOVLP ( KLEV , ZAZ ) ! Initialize ALPHA1 (%radar refl.) |
---|
| 512 | ! ****** ! (Hogan & Illingsworth, 1999) |
---|
| 513 | |
---|
| 514 | |
---|
| 515 | ! NO Absorber |
---|
| 516 | ! ----------- |
---|
| 517 | |
---|
| 518 | IF (NOZOCL.EQ.-1) THEN |
---|
| 519 | RCH4 = 1.E-18 |
---|
| 520 | RN2O = 1.E-18 |
---|
| 521 | RO3 = 1.E-18 |
---|
| 522 | RCFC11 = 1.E-18 |
---|
| 523 | RCFC12 = 1.E-18 |
---|
| 524 | PCCO25 = 1.E-18 |
---|
| 525 | DO jk=1,klev |
---|
| 526 | DO jl=KIDIA,KFDIA |
---|
| 527 | POZON5(JL,JK) = 0. |
---|
| 528 | ENDDO |
---|
| 529 | ENDDO |
---|
| 530 | DO JK=1,KLEV |
---|
| 531 | DO JAER=1,KAER |
---|
| 532 | DO JL=KIDIA,KFDIA |
---|
| 533 | PAER5(JL,JAER,JK)= ZEPAER |
---|
| 534 | ENDDO |
---|
| 535 | ENDDO |
---|
| 536 | ENDDO |
---|
| 537 | END IF |
---|
| 538 | |
---|
| 539 | |
---|
| 540 | |
---|
| 541 | return |
---|
| 542 | end subroutine Atm_RT_INI |
---|