MODULE SURF_ALBEDO 6
!@sum SURF_ALBEDO contains parameters/variables needed for albedo calc
!@auth A. Lacis/V. Oinas (modifications by I. Alienov/G. Schmidt)
implicit none
save
!@var NKBAND number of K-bands
integer, parameter :: NKBAND=33
!@var NVEG number of real vegetation types (not including bare soil)
!@var NV total number of vegetation types
integer, parameter :: NVEG = 9, NV=11
!@var SRFOAM look up table for ocean foam as a function of wind speed
real*8, parameter, dimension(25) :: SRFOAM = (/
* 0.000,0.000,0.000,0.000,0.001,0.002,0.003,0.005,0.007,0.010,
* 0.014,0.019,0.025,0.032,0.041,0.051,0.063,0.077,0.094,0.112,
* 0.138,0.164,0.191,0.218,0.246/)
!@var SEASON julian day for start of season (used for veg albedo calc)
C 1 2 3 4
C WINTER SPRING SUMMER AUTUMN
real*8, parameter, dimension(4)::
* SEASON=(/ 15.00, 105.0, 196.0, 288.0/)
C**** parameters used for vegetation albedo
!@var albvnd veg alb by veg type, season and band
real*8, parameter :: ALBVND(NV,4,6) = RESHAPE(C (1) >SRBALB(6) = VIS (300 - 770 nm)
C 1 2 3 4 5 6 7 8 9 10 11
C BSAND TNDRA GRASS SHRUB TREES DECID EVERG RAINF CROPS BDIRT ALGAE
1 .500, .067, .089, .089, .078, .100, .067, .061, .089, .000, .200,
2 .500, .062, .100, .100, .073, .055, .067, .061, .100, .000, .200,
3 .500, .085, .091, .139, .085, .058, .083, .061, .091, .000, .200,
4 .500, .080, .090, .111, .064, .055, .061, .061, .090, .000, .200,
C
C (2) >SRBALB(5) = NIR (770 - 860 nm) (ANIR=Ref)
C 1 2 3 4 5 6 7 8 9 10 11
C BSAND TNDRA GRASS SHRUB TREES DECID EVERG RAINF CROPS BDIRT ALGAE
1 .500, .200, .267, .267, .233, .300, .200, .183, .267, .000, .200,
2 .500, .206, .350, .300, .241, .218, .200, .183, .350, .000, .200,
3 .500, .297, .364, .417, .297, .288, .250, .183, .364, .000, .200,
4 .500, .255, .315, .333, .204, .218, .183, .183, .315, .000, .200,
C
C (3) >SRBALB(4) = NIR (860 -1250 nm) (ANIR*1.0)
C 1 2 3 4 5 6 7 8 9 10 11
C BSAND TNDRA GRASS SHRUB TREES DECID EVERG RAINF CROPS BDIRT ALGAE
1 .500, .200, .267, .267, .233, .300, .200, .183, .267, .000, .200,
2 .500, .206, .350, .300, .241, .218, .200, .183, .350, .000, .200,
3 .500, .297, .364, .417, .297, .288, .250, .183, .364, .000, .200,
4 .500, .255, .315, .333, .204, .218, .183, .183, .315, .000, .200,
C
C (4) >SRBALB(3) = NIR (1250-1500 nm) (ANIR*0.4)
C 1 2 3 4 5 6 7 8 9 10 11
C BSAND TNDRA GRASS SHRUB TREES DECID EVERG RAINF CROPS BDIRT ALGAE
1 .500, .080, .107, .107, .093, .120, .080, .073, .107, .000, .200,
2 .500, .082, .140, .120, .096, .083, .080, .073, .140, .000, .200,
3 .500, .119, .145, .167, .119, .115, .100, .073, .145, .000, .200,
4 .500, .102, .126, .132, .081, .087, .073, .073, .126, .000, .200,
C
C (5) >SRBALB(2) = NIR (1500-2200 nm) (ANIR*0.5)
C 1 2 3 4 5 6 7 8 9 10 11
C BSAND TNDRA GRASS SHRUB TREES DECID EVERG RAINF CROPS BDIRT ALGAE
1 .500, .100, .133, .133, .116, .150, .100, .091, .133, .000, .200,
2 .500, .103, .175, .150, .120, .109, .100, .091, .175, .000, .200,
3 .500, .148, .182, .208, .148, .144, .125, .091, .182, .000, .200,
4 .500, .127, .157, .166, .102, .109, .091, .091, .157, .000, .200,
C
C (6) >SRBALB(1) = NIR (2200-4000 nm) (ANIR*0.1)
C 1 2 3 4 5 6 7 8 9 10 11
C BSAND TNDRA GRASS SHRUB TREES DECID EVERG RAINF CROPS BDIRT ALGAE
1 .500, .020, .027, .027, .023, .030, .020, .018, .027, .000, .200,
2 .500, .021, .035, .030, .024, .022, .020, .018, .035, .000, .200,
3 .500, .030, .036, .042, .030, .029, .025, .018, .036, .000, .200,
4 .500, .026, .032, .033, .020, .022, .018, .018, .032, .000, .200
* /), (/11,4,6/) )
C
!@var VTMASK vegetation depth mask by type (kg/m^2)
real*8, parameter :: VTMASK(NV) = (/
C 1 2 3 4 5 6 7 8 9 10 11
C BSAND TNDRA GRASS SHRUB TREES DECID EVERG RAINF CROPS BDIRT ALGAE
* 1d1, 2d1, 2d1, 5d1, 2d2, 5d2, 1d3, 25d2, 2d1, 1d1, .001d0
* /)
!@var ASHZOI,ANHZOI hemisph.Ice Albedo half-max depth (m) (orig.version)
real*8, parameter :: ASHZOI=.1d0, ANHZOI=.1d0
!@var ASNALB snow albedo (original version)
!@var AOIALB seaice albedo (original version)
!@var ALIALB land ice albedo (original version)
C**** albedo = asnalb+snowage*snowage_fac so these numbers are the min
real*8 ::
C VIS NIR1 NIR2 NIR3 NIR4 NIR5 NIR
* ASNALB(7)=(/.60d0,.55d0,.55d0,.30d0,.10d0,.05d0, .35d0/),
* AOIALB(7)=(/.55d0,.50d0,.45d0,.25d0,.10d0,.05d0, .30d0/),
* ALIALB(7)=(/.60d0,.55d0,.50d0,.30d0,.10d0,.05d0, .35d0/)
C**** shorthand for the 2 band version
real*8 ASNVIS,ASNNIR, AOIVIS,AOINIR, ALIVIS,ALINIR
equivalence (ASNVIS,ASNALB(1)),(ASNNIR,ASNALB(7))
equivalence (AOIVIS,AOIALB(1)),(AOINIR,AOIALB(7))
equivalence (ALIVIS,ALIALB(1)),(ALINIR,ALIALB(7))
C**** variables that control original snow aging calculation
!@var AGEXPF exponent in snowage calculation depends on hemi/surf type
!@var ALBDIF difference in albedo as function of snowage
REAL*8, PARAMETER, DIMENSION(3,2) ::
* AGEXPF = RESHAPE(C SH EA SH OC SH LI NH EA NH OC NH LI
* 0.2d0, 0.2d0, 0.2d0, 0.2d0, 0.2d0, 0.2d0 /), (/3,2/) ),
* ALBDIF = RESHAPE(C SH EA SH OC SH LI NH EA NH OC NH LI
* 0.35d0, 0.35d0, 0.35d0, 0.35d0, 0.35d0, 0.35d0/), (/3,2/) )
!@var DMOICE, DMLICE masking depth for snow on ice and land ice
real*8, parameter :: DMOICE = 10., DMLICE = 10.
!@var AOImin seaice albedo (Hansen)
!@var AOImax seaice albedo (Hansen)
!@var ASNwet wet snow albedo (Hansen)
!@var ASNdry dry snow albedo (Hansen)
!@var AMPmin min melt pond albedo (Hansen)
real*8, parameter ::
C VIS NIR1 NIR2 NIR3 NIR4 NIR5
* AOImin(6)=(/ .05d0, .05d0, .05d0, .050d0, .05d0, .03d0/),
* AOImax(6)=(/ .62d0, .42d0, .30d0, .120d0, .05d0, .03d0/),
* ASNwet(6)=(/ .85d0, .75d0, .50d0, .175d0, .03d0, .01d0/),
* ASNdry(6)=(/ .90d0, .85d0, .65d0, .450d0, .10d0, .10d0/),
* AMPmin(6)=(/ .10d0, .05d0, .05d0, .050d0, .05d0, .03d0/)
!@var AOCEAN K-band dependent Thermal radiation characteristics for ocn
real*8, parameter, dimension(NKBAND) :: AOCEAN = (/
+ 0.04000,0.09566,0.10273,0.10389,0.10464,0.10555,0.10637,
+ 0.10666,0.10697,0.10665,0.10719,0.10728,0.11007,0.04009,
+ 0.04553,0.05554,0.08178,0.09012,0.09464,0.09548,0.09532,
+ 0.09558,0.09558,0.09568,0.09565,0.05771,0.04985,0.04670,
+ 0.04630,0.04575,0.04474,0.04468,0.04500/)
!@var AGSIDV K-band dependent Thermal radiation for other types
C AGSNOW AGLICE AGROCK AGVEG
real*8, parameter, dimension(NKBAND,4) :: AGSIDV = RESHAPE( + 0.01400,0.09262,0.09170,0.07767,0.07130,0.06603,0.06540,
+ 0.06397,0.06358,0.06361,0.06365,0.06386,0.06564,0.01354,
+ 0.01537,0.02320,0.04156,0.03702,0.03633,0.03417,0.03346,
+ 0.03342,0.03322,0.03350,0.03170,0.01967,0.01845,0.01977,
+ 0.01986,0.01994,0.02013,0.02041,0.02100,
+ 0.01400,0.09262,0.09170,0.07767,0.07130,0.06603,0.06540,
+ 0.06397,0.06358,0.06361,0.06365,0.06386,0.06564,0.01354,
+ 0.01537,0.02320,0.04156,0.03702,0.03633,0.03417,0.03346,
+ 0.03342,0.03322,0.03350,0.03170,0.01967,0.01845,0.01977,
+ 0.01986,0.01994,0.02013,0.02041,0.02100,
+ 0.04500,0.10209,0.08806,0.05856,0.04835,0.04052,0.04001,
+ 0.03775,0.03687,0.03740,0.03637,0.03692,0.03570,0.07001,
+ 0.05665,0.05326,0.05349,0.04356,0.03845,0.03589,0.03615,
+ 0.03610,0.03602,0.03613,0.03471,0.13687,0.14927,0.16484,
+ 0.16649,0.16820,0.17199,0.17484,0.18000,
+ 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,
* 0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0. /),
* (/ NKBAND,4 /) )
!@var AVSCAT,ANSCAT,AVFOAM,ANFOAM for ocean albedo calc
real*8, parameter ::
* AVSCAT=0.0156d0, ANSCAT=0d0, AVFOAM=0.2197d0, ANFOAM=0.1514d0
C**** miscellaneous tuning parameters
real*8 ::
!@var WETTRA,WETSRA adjustment factors for wet earth albedo calc
* WETTRA=1.0, WETSRA=1.0,
!@var ZOCSRA,ZSNSRA,ZICSRA,ZDSSRA,ZVGSRA adjustment factors for
!@+ solar zenith angle effects (not fully enabled)
* ZOCSRA=1.0, ZSNSRA=1.0, ZICSRA=1.0, ZDSSRA=1.0, ZVGSRA=1.0,
!@var EOCTRA,ESNTRA,EICTRA,EDSTRA,EVGTRA adjustment factors for
!@+ thermal radiation effects (not fully enabled)
* EOCTRA=1.0, EDSTRA=1.0, ESNTRA=1.0, EICTRA=1.0, EVGTRA=1.0
C**** ALBVNH is set only once a day then saved
!@var ALBVNH hemispherically varying vegetation albedo
real*8, dimension(NV,6,2) :: ALBVNH
!@var GZSNOW asymmetry parameter for snow over three types
!@+ from Wiscombe and Warren (1980) JAS
!@+ Note this is used for ice + melt-ponds as well.
REAL*8, PARAMETER, DIMENSION(7,3,2) :: GZSNOW = RESHAPE(C VIS NIR1 NIR2 NIR3 NIR4 NIR5 NIRT
* 0.95d0, 0.94d0, 0.905d0, 0.896d0, 0.894d0, 0.89d0, 0.91d0,! SH EA
* 0.95d0, 0.94d0, 0.905d0, 0.896d0, 0.894d0, 0.89d0, 0.91d0,! OI
* 0.95d0, 0.94d0, 0.905d0, 0.896d0, 0.894d0, 0.89d0, 0.91d0,! LI
* 0.95d0, 0.94d0, 0.905d0, 0.896d0, 0.894d0, 0.89d0, 0.91d0,! NH EA
* 0.95d0, 0.94d0, 0.905d0, 0.896d0, 0.894d0, 0.89d0, 0.91d0,! OI
* 0.95d0, 0.94d0, 0.905d0, 0.896d0, 0.894d0, 0.89d0, 0.91d0 ! LI
* /), (/7,3,2/) )
END MODULE SURF_ALBEDO
MODULE RADPAR 8
!@sum radiation module based originally on rad00b.radcode1.F
!@auth A. Lacis/V. Oinas/R. Ruedy
IMPLICIT NONE
C-----------------------------------------
C Grid parameters: Vertical resolution
C-----------------------------------------
!@var LX max.number of vertical layer edges of the radiation (1D)-model
!@+
!@+ The Radiation Model can accomodate arbitrary vertical resolution,
!@+ the number of layers may be time or location dependent,
!@+ but it cannot exceed LX-1.
!@+ Since the GCM uses 3 radiative equilibrium layers on top of the
!@+ model atmosphere, the number LM of GCM layers may be at most LX-4.
integer, parameter :: LX = 53+4
!@var PTOPTR top of sigma layer part of vertical grid (mb), i.e.
!@+ for purposes of repartitioning the prescribed constituents,
!@+ the pressure levels above PTOPTR mb are assumed to be
!@+ fixed in time and space, below PTOPTR mb the RATIOS of
!@+ the layer thicknesses are fixed in time and space.
!@+ (altern.: Use REPART to go from mean to current P-levels)
real*8 :: PTOPTR = 150.d0
!@var MRELAY if not 0, gases/aerosols are repartitioned to new layering
!@+ KEEP10, RO3COL, NO3COL may be used to modify this repartitioning:
!@+ if NO3COL=1, column amount of O3 is reset to RO3COL
!@+ (for OFF-line use if number of layers is time-dependent only)
integer :: MRELAY=0, KEEP10=0, NO3COL=0 ; real*8 :: RO3COL=1.
C------------------------------------------- This should eventually
C Grid parameters: Horizontal resolution be moved outside RADPAR
C------------------------------------------- into the driver
!@var MLAT46,MLON72 horizontal grid dimensions referred to in this model
!@+ The Radiation Model utilizes Data with 72x46 (lon,lat) resolution.
!@+ For GCM resolution other than 72x46, set JLAT and ILON
!@+ to appropriately Sample (rather than interpolate) the
!@+ 72x46 aerosol, ozone, cloud heterogeneity data sets
integer, parameter :: MLAT46=46,MLON72=72
!@var JNORTH latitude index defining northern hemisphere : jlat>jnorth
integer, parameter :: JNORTH=MLAT46/2
!@var DLAT46 latitudes of box centers (degrees)
real*8, parameter, dimension(46) :: DLAT46=(/
A -90.,-86.,-82.,-78.,-74.,-70.,-66.,-62.,-58.,-54.,-50.,-46.,
B -42.,-38.,-34.,-30.,-26.,-22.,-18.,-14.,-10., -6., -2., 2.,
C 6., 10., 14., 18., 22., 26., 30., 34., 38., 42., 46., 50.,
D 54., 58., 62., 66., 70., 74., 78., 82., 86., 90./)
!@var DLON72 longitude difference to date line (degrees)
real*8, parameter, dimension(72) :: DLON72=(/
A 0., 5., 10., 15., 20., 25., 30., 35., 40., 45., 50., 55.,
B 60., 65., 70., 75., 80., 85., 90., 95.,100.,105.,110.,115.,
C 120.,125.,130.,135.,140.,145.,150.,155.,160.,165.,170.,175.,
D 180.,185.,190.,195.,200.,205.,210.,215.,220.,225.,230.,235.,
E 240.,245.,250.,255.,260.,265.,270.,275.,280.,285.,290.,295.,
F 300.,305.,310.,315.,320.,325.,330.,335.,340.,345.,350.,355./)
C----------------
C Input data for the 1-d radiation
C----------------
!@var LASTVC if not < zero, atmosph. and ground data are being set
integer :: LASTVC=-123456 ! for OFF-line use only (set_io)
!@var COSZ cosine of zenith angle (1)
real*8 cosz
!@var JLAT,ILON lat,lon index w.r.to 72x46 lon-lat grid
!@var NL,NLP number of rad. model layers, layer edges (NLP=NL+1)
!@var LS1_loc local tropopause level, used to limit H2O-scaling
integer :: JLAT,ILON,NL,NLP, LS1_loc
!@var JYEAR,JDAY current year, Julian date
integer :: JYEAR=1980, JDAY=1
!@var PLB layer pressure (mb) at bottom of layer
!@var HLB height (km) at bottom of layer - currently NOT Used
!@var TLm mean layer temperature (K)
!@var TLb,TLt bottom,top layer temperature (K) - computed from TLm
!@+ except if TLGRAD<0 ; TLGRAD,PTLISO control T-profile
real*8 :: PLB(LX),HLB(LX),TLB(LX),TLT(LX),TLM(LX)
!@var TLGRAD 0<TLGRAD<1 controls T-profile within a layer, but
!@var PTLISO tlt=tlb=tlm above PTLISO mb independent of TLGRAD
real*8 :: TLGRAD=1., PTLISO=2.5d0 ! control param
!@var ULGAS,U0GAS gas amounts: curr.,ref.values (cm atm) (get/setgas)
!@var TAUWC,TAUIC opt.depth of water,ice cloud layer (1)
!@var SIZEWC,SIZEIC particle size of water,ice clouds (micron)
!@var CLDEPS cloud heterogeneity; is computed using KCLDEP,EPSCON
real*8 :: ULGAS(LX,13),TAUWC(LX),TAUIC(LX),SIZEWC(LX),SIZEIC(LX)
* ,CLDEPS(LX)
!@var EPSCON cldeps=EPSCON if KCLDEP=1
!@var KCLDEP KCLDEP=0->CLDEPS=0, 1->=EPSCON, 2->as is, 3,4->isccp
real*8 :: EPSCON=0. ; integer :: KCLDEP=4 ! control param
!@var SHL,RHL layer specific,relative humidity (1)
real*8 :: SHL(LX),RHL(LX)
!@var KEEPRH if 0: find RH from SH, 1: find SH from RH, 2: keep both
integer :: KEEPRH=2 ! control param
!@var KDELIQ Flag for dry(0) or wet(1) air deliquescence
integer :: KDELIQ(LX,4)
!@var KRHDTK if 1, RHlevel for deliquescence is temperature dependent
integer :: KRHDTK=1 ! control parameter
!@var SRBALB,SRXALB diffuse,direct surface albedo (1); see KEEPAL
real*8 :: SRBALB(6),SRXALB(6)
!@var KEEPAL if 0, SRBALB,SRXALB are computed in SET/GETSUR
integer :: KEEPAL=0 ! control param
!@dbparm KSIALB sea ice albedo computation flag: 0=Hansen 1=Lacis
integer :: KSIALB=0
!@var PVT frac. of surf.type (bareWhite+veg*8+bareDark+ocn)(1)
!@var AGESN 1-3 age of snow (over soil,oice,land ice) (days)
!@var SNOWE,SNOWLI amount of snow (over soil,land ice) (kg/m^2)
!@var SNOWOI amount of snow (over ocean/lake ice) (kg/m^2)
!@var WEARTH soil wetness (1)
!@var WMAG wind speed (m/s)
!@var POCEAN fraction of box covered by ocean or lake (1)
!@var PLAKE fraction of box covered by lake (1)
!@var PEARTH fraction of box covered by soil (1)
!@var POICE fraction of box covered by ocean/lakeice (1)
!@var PLICE fraction of box covered by glacial ice (1)
!@var TGO top layer water temperature (K) of ocean/lake
!@var TGE,TGOI,TGLI top layer ground temperature (K) soil,seaice,landice
!@var TSL surface air temperature (K)
real*8 PVT(11),AGESN(3),SNOWE,SNOWOI,SNOWLI,WEARTH,WMAG,POCEAN
* ,PEARTH,POICE,PLICE,PLAKE,TGO,TGE,TGOI,TGLI,TSL
!@var KZSNOW =1 for snow/ice albedo zenith angle dependence
integer :: KZSNOW=1
! Additional info for Schramm/Schmidt/Hansen sea ice albedo KSIALB=0
!@var ZSNWOI depth of snow over ocean ice (m)
!@var zoice depth of ocean ice (m)
!@var zmp depth of melt pond (m)
!@var fmp fraction of melt pond area (1)
!@var zlake lake depth (m)
!@var flags true if snow is wet
!@var snow_frac(2) fraction of snow over bare(1),vegetated(2) soil (1)
!@var snoage_fac_max max snow age reducing-factor for sea ice albedo
REAL*8 :: zsnwoi,zoice,zmp,fmp,zlake,snow_frac(2)
REAL*8 :: snoage_fac_max=.5d0
!@var ITRMAX maximum number of optional tracers
integer, parameter :: ITRMAX=20
!@var TRACER array to add up to ITRMAX additional aerosol species
real*8 :: TRACER(LX,ITRMAX)
!@var FSTOPX,FTTOPX scales optional aerosols (solar,thermal component)
real*8 :: FSTOPX(ITRMAX),FTTOPX(ITRMAX)
!@var O3_IN column variable for importing ozone field from rest of model
!@var use_tracer_ozone =0 normal case, =1 means that
!@+ RCOMPX will use O3_IN(L) for U0GAS(L,3) for GCM levels
real*8, dimension(lx) :: O3_IN
integer use_tracer_ozone
LOGICAL*4 :: flags
COMMON/RADPAR_INPUT_IJDATA/ ! Input data to RCOMPX
A PLB,HLB,TLB,TLT,TLM,ULGAS
B ,TAUWC,TAUIC,SIZEWC,SIZEIC,CLDEPS
C ,SHL,RHL,TRACER,SRBALB,SRXALB
D ,PVT,AGESN,SNOWE,SNOWOI,SNOWLI,WEARTH,WMAG
E ,POCEAN,PEARTH,POICE,PLICE,PLAKE
F ,TGO,TGE,TGOI,TGLI,TSL,COSZ,FSTOPX,FTTOPX,O3_IN
X ,zsnwoi,zoice,zmp,fmp,snow_frac,zlake
C integer variables start here, followed by logicals
Y ,JLAT,ILON,NL,NLP, LS1_loc,flags,use_tracer_ozone
Z ,KDELIQ ! is updated by rad. after use
!$OMP THREADPRIVATE(/RADPAR_INPUT_IJDATA/)
C array with local and global entries: repeat this section in driver
REAL*8 U0GAS(LX,13)
COMMON/RADPAR_hybrid/U0GAS
!$OMP THREADPRIVATE(/RADPAR_hybrid/)
C end of section to be repeated in driver (needed for 'copyin')
C--------------------------------------------------------
C Output data (from RCOMPX) grid point dependent
C--------------------------------------------------------
!@var TRDFLB,TRUFLB,TRNFLB thrml down,up,net flux at layr bottom (W/m2)
!@var SRDFLB,SRUFLB,SRNFLB solar down,up,net flux at layr bottom (W/m2)
!@var TRFCRL,SRFHRL layer LW cooling rate,SW heating rate (W/m2)
!@var etc etc
!@var etc etc
!sl!@var FTAUSL,TAUSL,... surface layer computations commented out: !sl
!@var LBOTCL,LTOPCL bottom and top cloud level (lbot < ltop)
!@var O3_OUT column variable for exporting ozone field to rest of model
!@var TTAUSV saves special aerosol optical thickness for diagnostic
real*8, dimension(lx) :: TRDFLB,TRUFLB,TRNFLB,TRFCRL,
* SRDFLB,SRUFLB,SRNFLB,SRFHRL,O3_OUT
real*8 :: SRIVIS,SROVIS,PLAVIS,SRINIR,SRONIR,PLANIR,
* SRDVIS,SRUVIS,ALBVIS,SRDNIR,SRUNIR,ALBNIR,
* SRTVIS,SRRVIS,SRAVIS,SRTNIR,SRRNIR,SRANIR,
* TRDFGW,TRUFGW,TRUFTW,BTEMPW,SRXVIS,SRXNIR
real*8, dimension(4) :: FSRNFG,FTRUFG,DTRUFG !,SRXATM
real*8 :: WINDZF(3),WINDZT(3),TOTLZF(3),TOTLZT(3),SRKINC(16),
* SRKALB(16),SRKGAX(16,4),SRKGAD(16,4),SKDFLB(LX,17),
* SKUFLB(LX,17),SKNFLB(LX,17),SKFHRL(LX,17)
!sl K ,FTAUSL(33),TAUSL(33) ! input rather than output ?
!nu K ,TRDFSL,TRUFSL,TRSLCR,SRSLHR,TRSLWV !nu = not used
!sl K ,TRSLTS,TRSLTG,TRSLBS
real*8 TTAUSV(LX,ITRMAX)
integer :: LBOTCL,LTOPCL
COMMON/RADPAR_OUTPUT_IJDATA/
A TRDFLB,TRUFLB,TRNFLB,TRFCRL
B ,SRDFLB,SRUFLB,SRNFLB,SRFHRL
C ,SRIVIS,SROVIS,PLAVIS,SRINIR,SRONIR,PLANIR !,SRXATM
D ,SRDVIS,SRUVIS,ALBVIS,SRDNIR,SRUNIR,ALBNIR,FSRNFG
E ,SRTVIS,SRRVIS,SRAVIS,SRTNIR,SRRNIR,SRANIR,FTRUFG
F ,TRDFGW,TRUFGW,TRUFTW,BTEMPW,DTRUFG
G ,WINDZF,WINDZT,TOTLZF,TOTLZT,SRKINC
I ,SRKALB,SRKGAX,SRKGAD,SKDFLB
J ,SKUFLB,SKNFLB,SKFHRL,SRXVIS,SRXNIR
!sl K ,FTAUSL,TAUSL ! input rather than output ?
!nu K ,TRDFSL,TRUFSL,TRSLCR,SRSLHR,TRSLWV !nu = not used
!sl K ,TRSLTS,TRSLTG,TRSLBS
K ,O3_OUT,TTAUSV
L ,LBOTCL,LTOPCL ! integers last for alignment
!$OMP THREADPRIVATE(/RADPAR_OUTPUT_IJDATA/)
!nu EQUIVALENCE (SRXATM(1),SRXVIS),(SRXATM(2),SRXNIR)
!nu EQUIVALENCE (SRXATM(3),XXAVIS),(SRXATM(4),XXANIR) !nu = not used
C---------------- scratch pad for temporary arrays that are passed to
C Work arrays other routines while working on a lat/lon point; but
C---------------- in multi-cpu mode, each cpu needs its own copy !!
real*8, dimension(LX,6) ::
* SRAEXT,SRASCT,SRAGCB,SRBEXT,SRBSCT,SRBGCB,
* SRDEXT,SRDSCT,SRDGCB,SRVEXT,SRVSCT,SRVGCB,
* SRCEXT,SRCSCT,SRCGCB,DBLEXT,DBLSCT,DBLGCB,DBLPI0,SRCPI0
real*8, dimension(LX,33) :: TRCALK,TRAALK,TRBALK,TRTAUK,TRDALK
* ,TRVALK,TRGXLK,DFLB,UFLB,WFLB
real*8, dimension(33) :: TRCTCA,DFSL,UFSL,WFSL,CLPI0,TXCTPG,TSCTPG
* ,TGCTPG,AVH2S,TRGALB,BGFEMT,BGFEMD
real*8, dimension(LX) :: PL,DPL,WTLB,WTLT
* ,ENA,ENB,ENC,TRA,TRB,TRC,AERX1,AERS1,AERG1,TRAXNL,AERX2,AERS2
* ,AERG2,UGAS0,UGASR,RNB,RNX,TNB,TNX,XNB,XNX,SRB,SRX,VRU,VRD
* ,FAC,DNA,DNB,DNC,O2FHRL,SRAXNL,SRASNL,SRAGNL,AO3X,O2FHRB,AO3D
* ,AO3U,HTPROF
real*8 :: UXGAS(LX,9),TAUN(33*LX),BXA(7),PRNB(6,4),PRNX(6,4)
* ,Q55H2S,RIJTCK(6,33),FDXTCK(3,33),ALBTCK(3,33),FEMTCK(3,33)
* ,QVH2S(6),SVH2S(6),GVH2S(6),XTRU(LX,4),XTRD(LX,4)
integer, dimension(LX) :: ITLB,ITLT
C**** local except for special radiative aerosol diagnostics aadiag
real*8 ATAULX(LX,6)
integer NRHNAN(LX,8)
COMMON/WORKDATA/ ! Temp data generated by RCOMPX
A SRAEXT,SRASCT,SRAGCB,TRCALK
B ,SRBEXT,SRBSCT,SRBGCB,TRAALK
C ,SRDEXT,SRDSCT,SRDGCB,TRBALK
D ,SRVEXT,SRVSCT,SRVGCB,TRTAUK
E ,DBLEXT,DBLSCT,DBLGCB,DBLPI0
F ,SRCEXT,SRCSCT,SRCGCB,SRCPI0
G ,TRDALK,TRVALK,TRGXLK,TRCTCA
H ,DFLB,UFLB,WFLB,PL,DPL
I ,TRGALB,BGFEMT,BGFEMD,WTLB,WTLT
J ,ENA,ENB,ENC,TRA,TRB,TRC
K ,DFSL,UFSL,WFSL
L ,AERX1,AERS1,AERG1,TRAXNL
M ,AERX2,AERS2,AERG2,UGAS0,UGASR
N ,RNB,RNX,TNB,TNX,XNB,XNX
O ,SRB,SRX,VRU,VRD,FAC
P ,UXGAS,TAUN,BXA,PRNB,PRNX
Q ,DNA,DNB,DNC,Q55H2S
R ,RIJTCK,FDXTCK,ALBTCK,CLPI0
S ,FEMTCK,TXCTPG,TSCTPG,TGCTPG
V ,O2FHRL,SRAXNL,SRASNL,SRAGNL,AO3X
W ,O2FHRB,AO3D,AO3U
X ,HTPROF,QVH2S,SVH2S,GVH2S,AVH2S
F ,XTRU,XTRD, ATAULX
I ,ITLB,ITLT, NRHNAN ! integers last
!$OMP THREADPRIVATE(/WORKDATA/)
real*8 :: ! Temp data used by WRITER, WRITET
A SRCQPI(6,15),TRCQPI(33,15),
B TRAQAB(33,11),TRBQAB(33,10),TRCQAB(33,15),TRDQAB(33,25)
integer :: NORDER(16),NMWAVA(16),NMWAVB(16)
C------------------------------------------
C Reference data, Tables, Climatologies
C------------------------------------------
real*8, parameter, dimension(16) :: DKS0=(/
* .010, .030, .040, .040, .040, .002, .004, .013,
+ .002, .003, .003, .072, .200, .480, .050, .011/)
integer :: NKSLAM=14
integer,parameter,dimension(16) ::
* KSLAM=(/1,1,2,2,5,5,5,5,1,1,1,3,4,6,6,1/)
real*8 :: ! Model parameters generated by RCOMP1
H HLB0(LX),PLB0(LX),TLM0(LX),U0GAS3(LX)
A ,TKPFW(630),TKPFT(900),AO3(460)
D ,FPXCO2(LX),FPXOZO(LX) !nu ,PIAERO(10)
C ,SRAX(LX,6,5),SRAS(LX,6,5),SRAC(LX,6,5),ZTABLE(LX,11)
E ,QXDUST(6,8),QSDUST(6,8),QCDUST(6,8),ATDUST(33,8)
D ,QDST55(8),TRAX(LX,33,5),DBLN(30),TCLMIN
C RADDAT_TR_SGP_TABLES read from radfile1, radfile2
real*8 ::
A TAUTBL(154000),PLANCK(8250),XKCFC(12,8,4)
B ,TAUWV0(154000),H2OCN8(33,8,14),H2OCF8(33,8,5)
D ,ULOX(285),DUX(285),GTAU(51,11,143),TGDATA(122,13)
E ,SALBTG(768,14),TAUGSA(1001,14),TAUTGD(122),TAUTGS(768)
F ,XUCH4(9,15),XUN2O(9,15),XTRUP(24,3,15),XTRDN(24,3,15)
G ,CXUO3(7,15),CXUCO2(7,15),XTU0(24,3)
H ,XTD0(24,3),XUCH40(9),XUN2O0(9)
integer, parameter :: ITPFT0=123 ,ITNEXT=250 ! offsets for lookups
C RADDAT_AERCLD_MIEPAR read from radfile3
real*8 ::
A SRAQEX( 6,11),SRAQSC( 6,11),SRAQCB( 6,11),Q55A11(11)
B ,TRAQEX(33,11),TRAQSC(33,11),TRAQCB(33,11),REFA11(11)
C ,SRBQEX( 6,10),SRBQSC( 6,10),SRBQCB( 6,10),Q55B10(10)
D ,TRBQEX(33,10),TRBQSC(33,10),TRBQCB(33,10),REFB10(10)
E ,SRCQEX( 6,15),SRCQSC( 6,15),SRCQCB( 6,15),Q55C15(15)
F ,TRCQEX(33,15),TRCQSC(33,15),TRCQCB(33,15),REFC15(15)
G ,TRCQAL(33,15),VEFC15(15) ,VEFA11( 11),VEFB10(10)
H ,SRDQEX( 6,25),SRDQSC( 6,25),SRDQCB( 6,25),Q55D25(25)
I ,TRDQEX(33,25),TRDQSC(33,25),TRDQCB(33,25),REFD25(25)
J ,TRDQAL(33,25),VEFD25(25)
K ,SRVQEX( 6,20,6),SRVQSC( 6,20,6),SRVQCB( 6,20,6)
L ,TRVQEX(33,20,6),TRVQSC(33,20,6),TRVQCB(33,20,6)
M ,TRVQAL(33,20,6),Q55V20(20,6),REFV20(20,6),VEFV20(20,6)
N ,SRUQEX( 6,120),SRUQSC( 6,120),SRUQCB( 6,120),Q55U22(120)
O ,TRUQEX(33,120),TRUQSC(33,120),TRUQCB(33,120),REFU22(120)
P ,TRUQAL(33,120),VEFU22(120),TRSQAL(33,25),VEFS25(25)
Q ,SRSQEX( 6,25),SRSQSC( 6,25),SRSQCB( 6,25),Q55S25(25)
R ,TRSQEX(33,25),TRSQSC(33,25),TRSQCB(33,25),REFS25(25)
real*8 SRQV( 6,20),SRSV( 6,20),SRGV( 6,20),Q55V( 20),REFV(20)
real*8 TRQV(33,20),TRSV(33,20),TRGV(33,20),TRAV(33,20),VEFV(20)
EQUIVALENCE (SRVQEX(1,1,6),SRQV(1,1)), (SRVQSC(1,1,6),SRSV(1,1))
EQUIVALENCE (SRVQCB(1,1,6),SRGV(1,1)), (Q55V20(1,6),Q55V(1))
EQUIVALENCE (TRVQEX(1,1,6),TRQV(1,1)), (TRVQSC(1,1,6),TRSV(1,1))
EQUIVALENCE (TRVQCB(1,1,6),TRGV(1,1)), (TRVQAL(1,1,6),TRAV(1,1))
EQUIVALENCE (REFV20(1,6),REFV(1)), (VEFV20(1,6),VEFV(1))
C RADDAT_CLDCOR_TRSCAT read from radfileE
real*8 :: RIJTPG(6,49,17,21),FDXTPG(3,49,17,21),FEMTPG(3,49,17,21)
C-------------------------------------- This also should be moved out
C History files (+ control options) of RADPAR, which should just
C-------------------------------------- have to deal 1 point in time
! -------------------------------------------------------i/o control
!@var MADxxx Model Add-on Data of Extended Climatology Enable Parameter
!@+ ------ if 0 input process is skipped
!@+ 2 MADAER = 1 Reads Aerosol tropospheric climatology
!@+ 3 MADDST = 1 Reads Dust-windblown mineral climatology RFILE6
!@+ 4 MADVOL = 1 Reads Volcanic 1950-00 aerosol climatology RFILE7
!@+ 5 MADEPS = 1 Reads Epsilon cloud heterogeneity data RFILE8
!@+ 6 MADLUV = 1 Reads Lean's SolarUV 1882-1998 variability RFILE9
!@+ MADGHG = 1 Enables UPDGHG update. MADGHG=0: no update
!@+ MADSUR = 1 Reads Vegetation,Topography data RFILEC,RFILED
!@+ MADBAK if 1 Adds background aerosols
! ------------------------------------------------------------------
integer :: MADO3M=1,MADAER=1,MADDST=1,MADVOL=1,MADEPS=1,MADLUV=1
integer :: MADGHG=1,MADSUR=0,MADBAK=0 ! MADSUR=1 for OFF-line only
! ------------------------------------------------------time control
!@var KYEARx,KJDAYx if both are 0 : data are updated to current yr/day
!@+ ------------- only KJDAYx=0: data cycle through year KYEARx
!@+ neither is 0 : yr/day=KYEARx/KJDAYx data are used
!@+ KYEARS,KJDAYS: Solar Trend
!@+ KYEARO,KJDAYO: Ozone Trend
!@+ KYEARD,KJDAYD: Dust Trend
!@+ KYEARE,KJDAYE: CldEps Trend
!@+ KYEARG,KJDAYG: GHG Trend
!@+ KYEARR,KJDAYR: RVegeTrend (Ground Albedo)
!@+ KYEARV,KJDAYV: Volc.Aerosol Trend
!@+ KYEARA,KJDAYA: trop.Aerosol Trend
! ------------------------------------------------------------------
integer :: KYEARS=0,KJDAYS=0, KYEARG=0,KJDAYG=0
* ,KYEARO=0,KJDAYO=0, KYEARA=0,KJDAYA=0, KYEARD=0,KJDAYD=0
* ,KYEARV=0,KJDAYV=0, KYEARE=0,KJDAYE=0, KYEARR=0,KJDAYR=0
INTEGER, PARAMETER :: NLO3=49 ! # of layers in ozone data files
real*8 :: O3JDAY(NLO3,MLON72,MLAT46)
COMMON/O3JCOM/O3JDAY
C**** PLBO3(NLO3+1) could be read off the titles of the decadal files
REAL*8, PARAMETER, DIMENSION(NLO3+1) :: PLBO3 = (/
* 1010d0, 934d0, 854d0, 720d0, 550d0, 390d0, 285d0, 210d0,
* 150d0, 125d0, 100d0, 80d0, 60d0, 55d0, 50d0,
* 45d0, 40d0, 35d0, 30d0, 25d0, 20d0, 15d0,
* 10.d0, 7.d0, 5.d0, 4.d0, 3.d0, 2.d0, 1.5d0,
* 1.d0, 7d-1, 5d-1, 4d-1, 3d-1, 2d-1, 1.5d-1,
* 1d-1, 7d-2, 5d-2, 4d-2, 3d-2, 2d-2, 1.5d-2,
* 1d-2, 7d-3, 5d-3, 4d-3, 3d-3, 1d-3, 1d-7/)
!@var PLBA09 Vert. Layering for tropospheric aerosols/dust (reference)
real*8, parameter, dimension(10) :: PLBA09=(/
* 1010.,934.,854.,720.,550.,390.,255.,150., 70., 10./)
C Layer 1 2 3 4 5 6 7 8 9
C RADMAD3_DUST_SEASONAL (user SETDST) radfile6
real*4 TDUST(72,46,9,8,12)
real*8 DDJDAY(9,8,72,46)
C RADMAD4_VOLCAER_DECADAL (user SETVOL) radfile7
real*8 V4TAUR(1800,24,5),FDATA(80),GDATA(80)
C ,HTFLAT(49,4),TAULAT(49),SIZLAT(49)
C RADMAD5_CLDEPS_3D_SEASONAL (user SETCLD) radfile8
real*4 EPLMHC(72,46,12,4)
real*8 EPLOW(72,46),EPMID(72,46),EPHIG(72,46),EPCOL(72,46)
C RADMAD6_SOLARUV_DECADAL (user SETSOL) radfile9
!@var iy1S0,MS0X first year, max.number of months for S0 history
!@var icycs0,mcycs0 solar cycle in yrs,months used to extend S0 history
!@var KSOLAR controls which data are used: <0 Thekaekara, else Lean:
!@+ 1: use monthly data, 2: use annual data, 0: constant data
integer :: KSOLAR=1 ! MADLUV=KSOLAR=0 only possible OFF-line
integer, parameter :: iy1S0=1882, MS0X=12*(1998-iy1S0+1)
integer, parameter :: icycs0=11, mcycs0=icycs0*12
real*4 UVLEAN(Ms0X,190),yr1S0,yr2S0
real*8 TSI1(Ms0X),TSI2(Ms0X),FSLEAN(190),W1LEAN(190)
real*8 :: S00WM2=1366.2911d0, S0=1366.d0, RATLS0=1.
real*8 :: WSOLAR(190),FSOLAR(190)
C*** alternate sources to get WSOLAR,FSOLAR:
real*8, dimension(190) :: WSLEAN,DSLEAN,FRLEAN
common/LEAN1950/ WSLEAN,DSLEAN,FRLEAN ! if MADLUV=0
real*8, parameter, dimension(190) :: WTHEK=(/ ! if KSOLAR<0
* .115,.120,.125,.130,.140,.150,.160,.170,.180,.190,.200,
1 .210,.220,.225,.230,.235,.240,.245,.250,.255,.260,.265,.270,.275,
2 .280,.285,.290,.295,.300,.305,.310,.315,.320,.325,.330,.335,
3 .340,.345,.350,.355,.360,.365,.370,.375,.380,.385,.390,
4 .395,.400,.405,.410,.415,.420,.425,.430,.435,.440,.445,
5 .450,.455,.460,.465,.470,.475,.480,.485,.490,.495,.500,
6 .505,.510,.515,.520,.525,.530,.535,.540,.545,.550,.555,
7 .560,.565,.570,.575,.580,.585,.590,.595,.600,.605,.610,
8 .620,.630,.640,.650,.660,.670,.680,.690,.700,.710,.720,
9 .730,.740,.750,.760,.770,.780,.790,.800,.810,.820,.830,
A .840,.850,.860,.870,.880,.890,.900,.910,.920,.930,.940,.950,.960,
B 0.97,0.98,0.99,1.00,1.05,1.10,1.15,1.20,1.25,1.30,1.35,1.40,1.45,
C 1.50,1.55,1.60,1.65,1.70,1.75,1.80,1.85,1.90,1.95,2.00,2.10,2.20,
D 2.30,2.40,2.50,2.60,2.70,2.80,2.90,3.00,3.10,3.20,3.30,3.40,3.50,
E 3.60,3.70,3.80,3.90,4.00,4.10,4.20,4.30,4.40,4.50,4.60,4.70,4.80,
F 4.9, 5.0, 6.0, 7.0, 8.0, 9.0,10.0,11.0,12.0,13.0,14.0,15.00/)
real*8, parameter, dimension(190) :: FTHEK=(/
* .007,.900,.007,.007,.030,.070,.230,.630,1.25,2.71,10.7,
1 22.9,57.5,64.9,66.7,59.3,63.0,72.3,70.4,104.,130.,185.,232.,204.,
2 222.,315.,482.,584.,514.,603.,689.,764.,830.,975.,1059.,1081.,
31074.,1069.,1093.,1083.,1068.,1132.,1181.,1157.,1120.,1098.,1098.,
41189.,1429.,1644.,1751.,1774.,1747.,1693.,1639.,1663.,1810.,1922.,
52006.,2057.,2066.,2048.,2033.,2044.,2074.,1976.,1950.,1960.,1942.,
61920.,1882.,1833.,1833.,1852.,1842.,1818.,1783.,1754.,1725.,1720.,
71695.,1705.,1712.,1719.,1715.,1712.,1700.,1682.,1666.,1647.,1635.,
81602.,1570.,1544.,1511.,1486.,1456.,1427.,1402.,1389.,1344.,1314.,
91290.,1260.,1235.,1211.,1185.,1159.,1134.,1109.,1085.,1060.,1036.,
A1013.,990.,968.,947.,926.,908.,891.,880.,869.,858.,847.,837.,820.,
B 803.,785.,767.,748.,668.,593.,535.,485.,438.,397.,358.,337.,312.,
C 288.,267.,245.,223.,202.,180.,159.,142.,126.,114.,103., 90., 79.,
D 69.0,62.0,55.0,48.0,43.0,39.0,35.0,31.0,26.0,22.6,19.2,16.6,14.6,
E 13.5,12.3,11.1,10.3, 9.5,8.70,7.80,7.10,6.50,5.92,5.35,4.86,4.47,
F 4.11,3.79,1.82,0.99,.585,.367,.241,.165,.117,.0851,.0634,.0481/)
!icb RADMAD7_VEG_TOPOG (user SETSUR) radfileC,radfileD
!icb FVEG11(72,46,11),FOLGIZ(72,46,9)
C RADMAD8_RELHUM_AERDATA (user SETAER,SETREL) radfileH
!nu KRHAER(4) -1/0/1 flag to base aeros.sizes on 70%/0%/model rel.humi
!nu integer, dimension(4) :: KRHAER=(/1,1,1,1/) ! SO4,SSalt,NO3,OC
!@var KRHTRA(ITRMAX) 0/1 to make tracer aerosols rel.humid dependent
integer, dimension(ITRMAX) :: KRHTRA= 1
real*8 ::
A SRHQEX(6,190,4),SRHQSC(6,190,4),SRHQCB( 6,190,4)
B ,TRHQAB(33,190,4),RHINFO(190,15,4),A6JDAY(9,6,72,46)
C ,SRTQEX(6,190,ITRMAX),SRTQSC(6,190,ITRMAX),SRTQCB(6,190,ITRMAX)
D ,TRTQAB(33,190,ITRMAX),RTINFO(190,15,ITRMAX)
!new
!new save TSOIL,TVEGE (not implemented)
!nu DIMENSION PI0TRA(11)
!new save FTRUFS,FTRUFV,DTRUFS,DTRUFV (not implemented)
C -----------------------
C Ozone absorption tables
C -----------------------
real*8, parameter, dimension(226) :: XWAVO3=(/
* .2002,.2012,.2022,.2032,.2042,.2052,.2062,.2072,.2082,
A.2092,.2102,.2112,.2122,.2132,.2142,.2152,.2162,.2172,.2182,.2192,
B.2202,.2212,.2222,.2232,.2242,.2252,.2262,.2272,.2282,.2292,.2302,
C.2312,.2322,.2332,.2342,.2352,.2362,.2372,.2382,.2392,.2400,.2402,
D.2412,.2422,.2432,.2438,.2444,.2452,.2458,.2463,.2472,.2478,.2482,
E.2490,.2492,.2500,.2508,.2519,.2527,.2539,.2543,.2553,.2562,.2566,
F.2571,.2575,.2579,.2587,.2597,.2604,.2617,.2624,.2635,.2643,.2650,
G.2654,.2662,.2669,.2675,.2682,.2692,.2695,.2702,.2712,.2718,.2722,
H.2732,.2742,.2746,.2752,.2762,.2772,.2782,.2792,.2802,.2812,.2822,
I.2830,.2842,.2852,.2862,.2872,.2882,.2892,.2902,.2912,.2922,.2932,
J.2942,.2952,.2962,.2972,.2982,.2992,.2998,
& .3004,.3016,.3021,.3029,.3036,.3037,.3051,.3053,.3059,
A.3061,.3066,.3075,.3077,.3083,.3085,.3092,.3098,.3100,.3104,.3106,
B.3109,.3112,.3130,.3135,.3146,.3148,.3151,.3154,.3167,.3170,.3173,
C.3176,.3190,.3194,.3199,.3200,.3209,.3210,.3216,.3220,.3223,.3226,
D.3239,.3242,.3245,.3248,.3253,.3255,.3269,.3272,.3275,.3279,.3292,
E.3295,.3299,.3303,.3309,.3312,.3328,.3332,.3334,.3338,.3357,.3365,
F.3369,.3372,.3391,.3395,.3398,.3401,.3417,.3421,.3426,.3430,.3437,
G.3439,.3451,.3455,.3460,.3463,.3466,.3472,.3481,.3485,.3489,.3493,
H.3499,.3501,.3506,.3514,.3521,.3523,.3546,.3550,.3554,.3556,.3561,
I.3567,.3572,.3573,.3588,.3594,.3599,.3600,.3604,.3606,.3639,.3647,
J.3650,.3654,.3660/)
real*8, dimension(226) :: UVA
real*8, parameter, dimension(226) :: FUVKO3=(/
* 8.3, 8.3, 8.1, 8.3, 8.6, 9.0, 9.7, 10.8, 11.7,
A 13.0, 14.3, 16.0, 18.0, 20.6, 23.0, 26.1, 29.3, 32.6, 36.9, 40.8,
B 46.9, 51.4, 56.7, 63.4, 69.1, 76.6, 84.0, 91.4, 99.9,110.0,118.0,
C126.0,136.0,145.0,154.0,164.0,175.0,186.0,192.0,201.0,210.0,212.0,
D221.0,230.0,239.0,248.0,250.0,259.0,264.0,264.0,273.0,277.0,275.0,
E283.0,283.0,290.0,283.0,297.0,290.0,300.0,290.0,302.0,295.0,283.0,
F293.0,290.0,286.0,297.0,281.0,280.0,271.0,275.0,254.0,264.0,250.0,
G248.0,242.0,228.0,230.0,216.0,213.0,211.0,199.0,188.0,188.0,178.0,
H169.0,153.0,155.0,148.0,136.0,127.0,117.0,108.0, 97.0, 88.7, 81.3,
I 78.7, 67.9, 61.4, 54.3, 49.6, 43.1, 38.9, 34.6, 30.2, 27.5, 23.9,
J 21.0, 18.6, 16.2, 14.2, 12.3, 10.7, 9.5,
& 8.880,7.520,6.960,6.160,5.810,5.910,4.310,4.430,4.130,
A4.310,4.020,3.330,3.390,3.060,3.100,2.830,2.400,2.490,2.330,2.320,
B2.120,2.200,1.436,1.595,1.074,1.138,1.068,1.262,0.818,0.948,0.860,
C1.001,0.543,0.763,0.665,0.781,0.382,0.406,0.373,0.608,0.484,0.601,
D0.209,0.276,0.259,0.470,0.319,0.354,0.131,0.223,0.185,0.339,0.080,
E0.093,0.079,0.184,0.139,0.214,0.053,0.074,0.068,0.152,0.038,0.070,
F.0540000,.1030000,.0240000,.0382500,.0292500,.0550000,.0135000,
G.0155250,.0127500,.0188250,.0167250,.0262500,.0115500,.0140250,
H.0099750,.0115500,.0081000,.0104250,.0050100,.0057000,.0046650,
I.0073425,.0051825,.0055275,.0040575,.0077700,.0048900,.0054600,
J.0015375,.0017775,.0013275,.0014100,.0011550,.0023325,.0018825,
K.0019650,.0009600,.0013650,.0011925,.0013200,.0008925,.0009825,
L.0001350,.0006300,.0004500,.0006225,0.0/)
C ------------------------------------------------------------------
C NO2 Trace Gas Vertical Distribution and Concentration Profile
C ------------------------------------------------------------------
real*8, parameter, dimension(42) ::
* CMANO2=(/ ! every 2 km starting at 0km
1 8.66E-06,5.15E-06,2.85E-06,1.50E-06,9.89E-07,6.91E-07,7.17E-07,
2 8.96E-07,3.67E-06,4.85E-06,5.82E-06,6.72E-06,7.77E-06,8.63E-06,
3 8.77E-06,8.14E-06,6.91E-06,5.45E-06,4.00E-06,2.67E-06,1.60E-06,
4 8.36E-07,3.81E-07,1.58E-07,6.35E-08,2.57E-08,1.03E-08,4.18E-09,
5 1.66E-09,6.57E-10,2.58E-10,1.02E-10,4.11E-11,1.71E-11,7.73E-12,
6 9.07E-12,4.63E-12,2.66E-12,1.73E-12,1.28E-12,1.02E-12,1.00E-30/)
C ------------------------------------------------------------------
C TRACE GAS REFERENCE AMOUNTS & DISTRIBUTIONS ARE DEFINED IN SETGAS
C ------------------------------------------------------------------
C-------------------------
C Scaling/kill factors
C-------------------------
!@var FULGAS scales the various atmospheric constituents:
!@+ H2O CO2 O3 O2 NO2 N2O CH4 F11 F12 N2C CFC11 CFC12 SO2
!@+ Note: FULGAS(1) only acts in the stratosphere (unless LS1_loc=1)
real*8, dimension(13) :: FULGAS = (/ ! scales ULGAS
C H2O CO2 O3 O2 NO2 N2O CH4 F11 F12 N2C CFC11+ CFC12+ SO2
C 1 2 3 4 5 6 7 8 9 10 11 12 13
+ 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 1., 0./)
!@var FGOLDH scales background aerosols for Glb Ocn Land Desert Haze
real*8, dimension(5) :: ! used by setbak/getbak only
C GLOBAL OCEAN LAND DESERT HAZE
C 1 2 3 4 5
+ FGOLDH=(/ 1d0, .68d0, .32d0, 1.d-20, 1.d-20 /)
!@var FSXAER,FTXAER scales solar,thermal opt.depth for var. aerosols:
!@+ 1: total 2:background 3: AClim 4:dust 5:volcanic
real*8, dimension(5) :: FSXAER=(/1.,1.,1.,1.,1./)
real*8, dimension(5) :: FTXAER=(/1.,1.,1.,1.,1./)
real*8 FSTAER,FSBAER,FSAAER,FSDAER,FSVAER
* ,FTTAER,FTBAER,FTAAER,FTDAER,FTVAER
EQUIVALENCE (FSXAER(1),FSTAER), (FTXAER(1),FTTAER)
EQUIVALENCE (FSXAER(2),FSBAER), (FTXAER(2),FTBAER)
EQUIVALENCE (FSXAER(3),FSAAER), (FTXAER(3),FTAAER)
EQUIVALENCE (FSXAER(4),FSDAER), (FTXAER(4),FTDAER)
EQUIVALENCE (FSXAER(5),FSVAER), (FTXAER(5),FTVAER)
!@var PIVMAX limits PI0 of volcanic aerosols
real*8 :: PIVMAX=1.0
!@var ECLTRA,KCLDEM scales,enables full cloud scattering correction
real*8 :: ECLTRA=1. ; integer :: KCLDEM=1
!@var FCLDTR,FCLDSR scales opt.depth of clouds - not used (yet)
!@var FRAYLE scales Rayleigh parameter
real*8 :: FCLDTR=1., FCLDSR=1., FRAYLE=1.
!@var KUVFAC,UVFACT,UVWAVL,KSNORM rescale UV spectral flux distribution
integer :: KUVFAC=0, KSNORM=0 ! no rescaling
real*8, dimension(3) :: UVWAVL=(/0.0010,0.0020,0.0030/)
real*8, dimension(3) :: UVFACT=(/1.0000,1.0000,1.0000/)
!@var SRCGSF Scaling Factors for Cloud Asymmetry Parameter for
!@+ Water Ice MieIce
real*8, dimension(3) :: SRCGSF=(/ 1.000, 1.000, 1.000/)
!@var TAUWC0,TAUIC0 lower limits for water/ice cloud opt.depths
real*8 :: TAUWC0=1d-3, TAUIC0=1d-3
!@var KPFCO2,KPFOZO if > 0 scale CO2,O3 to stand. vertical profile
integer :: KPFCO2=0, KPFOZO=0
!@var KANORM,KCNORM if > 0 renormalize aerosols,cloud albedos
integer :: KANORM=0, KCNORM=0
!@var KWVCON ON/OFF flag for water vapor continuum absorption
!@var KUFH2O,KUFCO2 H2O,CO2 column absorb.scaling
!@var KCSELF,KCFORN H2O_ContSelf-Broadening,CO2_ContForeign-Broadening
integer :: KWVCON=1, KUFH2O=1, KUFCO2=1, KCSELF=1, KCFORN=1
!@var ICE012 pick ice droplet type: 0 liquid, 1 ice non-spher, 2 ice Mie
integer :: ICE012=1
!@var VEFF0 effective volc. aerosol size distribution variance
real*8 :: VEFF0=0.35d0, REFF0=0.30d0 ! REFF0 not used
!@var NORMS0 if =1, Incident (TOA) Solar flux is normalized to equal S0
integer :: NORMS0=1
!@var KORDER,KWTRAB controls WRITER-output (Mie-scattering info)
integer :: KWTRAB=0, KORDER=0
C-----------------------------------------------------------------------
C COMPOSITION & VERTICAL DISTRIBUTION FOR 5 SPECIFIED AEROSOL TYPES
C-----------------------------------------------------------------------
C TYPE
C 1 STRATOSPHERIC GLOBAL AEROSOL A,B,C ARE GLOBAL AVERAGE VALUES
C 2 TROPOSPHERIC OCEAN AEROSOL A,B,C ARE GLOBAL AVERAGE VALUES
C 3 TROPOSPHERIC LAND AEROSOL A,B,C ARE GLOBAL AVERAGE VALUES
C 4 TROPOSPHERIC DESERT AEROSOL A,B,C ARE LOCAL AVERAGE VALUES
C 5 TROPOSPHERIC HAZE AEROSOL A,B,C ARE LOCAL AVERAGE VALUES
C 1 2 3 4 5 6 7 8 9 10 11
C ACID1 SSALT SLFT1 SLFT2 BSLT1 BSLT2 DUST1 DUST2 DUST3 CARB1 CARB2
real*8, dimension(11,5) :: AGOLDH=reshape( 1 .005, .0, .0, .0, .0, .0, .0, .0, .0, .0, .0,
2 .0, .020, .010, .010, .005, .0, .010, .0, .0, .005, .0,
3 .0, .0, .0, .020, .005, .0, .010, .010, .0, .0, .015,
4 .0, .0, .0, .0, .0, .0, .0, .020, .010, .0, .0,
5 .0, .0, .0, .010, .0, .0, .0, .0, .0, .0, .005/
* ),(/11,5/) )
real*8, dimension(11,5) :: BGOLDH=reshape( 1 20.0, .0, .0, .0, .0, .0, .0, .0, .0, .0, .0,
2 .0, 1.00, 4.00, 1.00, 4.00, 1.00, 4.00, .0, .0, 1.00, .0,
3 .0, .0, .0, 0.00, 2.00, .0, 4.00, 2.00, .0, .0, 0.00,
4 .0, .0, .0, .0, .0, .0, .0, 2.00, 0.00, .0, .0,
5 .0, .0, .0, .0, .0, .0, .0, .0, .0, .0, 0.00/
* ),(/11,5/) )
real*8, dimension(11,5) :: CGOLDH=reshape( 1 3.00, .0, .0, .0, .0, .0, .0, .0, .0, .0, .0,
2 .0, 1.00, 3.00, 2.00, 3.00, 1.00, 2.00, .0, .0, 1.00, .0,
3 .0, .0, .0, 1.00, 3.00, .0, 1.00, 1.00, .0, .0, 1.00,
4 .0, .0, .0, .0, .0, .0, .0, 1.00, 1.00, .0, .0,
5 .0, .0, .0, 1.00, .0, .0, .0, .0, .0, .0, 1.00/
* ),(/11,5/) )
!nu real*8, dimension(11) :: PI0VIS=(/
!nu 1 2 3 4 5 6
!nu ACID1 SSALT SLFT1 SLFT2 BSLT1 BSLT2
!nu 1 1.00000, 1.00000, 1.00000, 1.00000, 0.98929, 0.95609,
!nu
!nu 7 8 9 10 11
!nu DUST1 DUST2 DUST3 CARB1 CARB2
!nu 2 0.91995, 0.78495, 0.63594, 0.31482, 0.47513/)
real*8, dimension(8) ::
C TROPOSPHERIC AEROSOL COMPOSITIONAL/TYPE PARAMETERS
C SO4 SEA ANT OCX BCI BCB DST VOL
* REFDRY=(/0.200, 1.000, 0.300, 0.300, 0.100, 0.100, 1.000,1.000/)
!nu * ,REFWET=(/0.272, 1.808, 0.398, 0.318, 0.100, 0.100, 1.000,1.000/)
* ,DRYM2G=(/4.667, 0.866, 4.448, 5.017, 9.000, 9.000, 1.000,1.000/)
CKoch DRYM2G=(/5.000, 2.866, 8.000, 8.000, 9.000, 9.000, 1.000,1.000/)
!nu RHTMAG=(/1.788, 3.310, 1.756, 1.163, 1.000, 1.000, 1.000,1.000/)
!nu alt RHTMAG=(/1.982, 3.042, 1.708, 1.033, 1.000, 1.000, 1.000,1.000/)
!old * WETM2G=(/8.345, 2.866, 7.811, 5.836, 9.000, 9.000, 1.000,1.000/)
!nu * ,WETM2G=(/9.250, 2.634, 7.598, 5.180, 9.000, 9.000, 1.000,1.000/)
* ,Q55DRY=(/2.191, 2.499, 3.069, 3.010, 1.560, 1.560, 1.000,1.000/)
* ,DENAER=(/1.760, 2.165, 1.725, 1.500, 1.300, 1.300, 2.000,2.000/)
C TROP AEROSOL 1850 BACKGROUND, INDUSTRIAL & BIO-BURNING PARAMETERS
real*8, dimension(13) :: AERMIX=(/
C Pre-Industrial+Natural 1850 Level Industrial Process BioMBurn
C --------------------------------- ------------------ --------
C 1 2 3 4 5 6 7 8 9 10 11 12 13
C SNP SBP SSP ANP ONP OBP BBP SUI ANI OCI BCI OCB BCB
+ 1.0, 1.0, 1.0, 1.0, 2.5, 2.5, 1.9, 1.0, 1.0, 2.5, 1.9, 2.5, 1.9/)
real*8, dimension(8) ::
C TROPOSPHERIC AEROSOL COMPOSITIONAL/TYPE PARAMETERS
C SO4 SEA ANT OCX BCI BCB DST VOL
* FS8OPX=(/1.000, 1.000, 1.000, 1.000, 2.000, 2.000, 1.000, 1.00/)
* ,FT8OPX=(/1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.300, 1.00/)
* ,FRSULF=(/0.000, 0.000, 0.000, 0.330, 0.000, 0.000, 0.000, 1.00/)
* ,PI0MAX=(/1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.00/)
!nu * ,A8VEFF=(/ .200, .200, .200, .200, .200, .200, .200, .200/)
real*8, dimension(8) ::
C MINERAL DUST PARAMETERS
C CLAY SILT
* REDUST=(/ 0.1, 0.2, 0.4, 0.8, 1.0, 2.0, 4.0, 8.0/)
!nu * ,VEDUST=(/ 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2, 0.2/)
!nu * ,RODUST=(/ 2.5, 2.5, 2.5, 2.5, 2.6, 2.6, 2.6, 2.6/)
!nu * ,FSDUST=(/ 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0/)
!nu * ,FTDUST=(/ 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0/)
C-----------------------------------------------------------------------
C GHG 1980 Reference Concentrations and Vertical Profile Definitions
C-----------------------------------------------------------------------
!@var KTREND if > 0 table GHG concentrations (Trend G) are used for
!@+ yr/day KYEARG/KJDAYG; if KTREND=0, GHG are set to PPMVK0
integer :: KTREND=1
!@var PPMV80 reference GHG concentrations (ppm)
real*8, dimension(13) ::
C GAS NUMBER 1 2 3 4 5 6 7
C H2O CO2 O3 O2 NO2 N2O CH4
* PPMV80=(/0d0, 337.90d0, 0d0, 21d4, 0d0, .3012d0, 1.5470d0
* ,.1666d-03,.3003d-03, 0d0, .978D-04, .0010D-10, .0420d0/)
C CCL3F1 CCL2F2 N2 CFC-Y CFC-Z SO2
C GAS NUMBER 8 9 10 11 12 13
!@var PPMVK0 user set GHG concentrations (ppm), used if KTREND=0
real*8, dimension(12) ::
C GAS NUMBER 1 2 3 4 5 6 7
C H2O CO2 O3 O2 NO2 N2O CH4
* PPMVK0=(/0d0, 337.90d0, 0d0, 21.d4, 0d0, .3012d0, 1.5470d0
* ,.1666d-03, .3003d-03, 0d0, .978D-04, 0.0010D-10/)
C CCL3F1 CCL2F2 N2 CFC-Y CFC-Z
C GAS NUMBER 8 9 10 11 12
C Makiko's GHG Trend Compilation GHG.1850-2050.Dec1999 in GTREND
C ---------------------------------------------------------------
!@var nghg nr. of well-mixed GHgases: CO2 N2O CH4 CFC-11 CFC-12 others
!@var nyrsghg max.number of years of prescr. greenhouse gas history
integer, parameter :: nghg=6, nyrsghg=2050-1850+1
!@var ghgyr1,ghgyr2 first and last year of GHG history
integer ghgyr1,ghgyr2
!@var ghgam,xref,xnow GHG-mixing ratios in ppm,ppm,ppm,ppb,ppb,ppb
real*8 GHGAM(nghg,nyrsghg),XREF(nghg+1),XNOW(nghg+1)
common/ghgcom/ghgyr1,ghgyr2,ghgam,xref,xnow
C GTREND: 1980., 337.9, .3012, 1.547, .1666, .3003, .0978,
C ---------------------------------------------------------------
!@var KGGVDF,KPGRAD,KLATZ0 control parameters for vertical GHG profiles
!@+ -----------------------------------------------------------------
!@+ Minschwaner et al JGR (1998) CH4, N2O, CFC-12 Vertical profiles
!@+ IF(KGGVDF.GT.0) Then:
!@+ Gas decreases are linear with pressure, from unity at ground to
!@+ the fractional value PPMVDF(NGAS) at the top of the atmosphere.
!@+ Exponential decrease by EXP(-(Z-Z0)/H) is superimposed on this.
!@+ IF(KLATZ0.GT.0) Then: Z0 depends on latitude, KGGVDF not used
!@+ KPGRAD>0: Pole-to-Pole lat. gradient (PPGRAD) is also superimposed
!@+ ------------------------------------------------------------------
!@var Z0,ZH scale heights used for vertical profile (km)
!@var PPMVDF frac. value at top of atmosphere (used if KGGVDF > 0)
!@var PPGRAD Pole-to-Pole latitud.gradient for GHG (used if KPGRAD > 0)
integer :: KGGVDF=0, KPGRAD=1, KLATZ0=1
real*8, dimension(12) ::
C NUMBER 1 2 3 4 5 6 7 8 9 10 11 12
C H2O CO2 O3 O2 NO2 N2O CH4 CFC11 CFC12 N2 CF-Y CF-Z
* Z0=(/0.0, 0.0,0.0, 0.0,0.0, 16., 16., 16., 16., 0.0, 16., 16./)
* ,ZH=(/8.0, 8.0,8.0, 8.0,8.0, 30., 50., 30., 30., 0.0, 30., 30./)
C GAS NUMBER 1 2 3 4 5 6 7
C H2O CO2 O3 O2 NO2 N2O CH4
* ,PPMVDF=(/1.0, 1.0, 1.0, 1.0, 1.0, 0.88888, 0.88888,
* 0.88888, 0.88888, 1.0, 0.88888, 0.88888/)
C CCL3F1 CCL2F2 N2 CFC-Y CFC-Z
C GAS NUMBER 8 9 10 11 12
C GAS NUMBER 1 2 3 4 5 6 7
C H2O CO2 O3 O2 NO2 N2O CH4
* ,PPGRAD=(/0.0, 0.0, 0.0, 0.0, 0.0, 0.0100, 0.0900,
* 0.0600, 0.0600, 0.0, 0.0600, 0.0600/)
C CCL3F1 CCL2F2 N2 CFC-Y CFC-Z
C GAS NUMBER 8 9 10 11 12
C---------------------
C Optional Tracers used via setbak/getbak
C---------------------
integer, dimension(ITRMAX) :: ITR=1
integer :: NTRACE=0
real*8, dimension(ITRMAX) ::
C TRACER AEROSOL COMPOSITIONAL/TYPE PARAMETERS
* TRRDRY= .1d0
!nu * ,TRVEFF= .2d0
!nu * ,TRADEN= 1.d0
!loc * ,FSTOPX= 1.d0
!loc * ,FTTOPX= 1.d0
SAVE
CONTAINS
SUBROUTINE RCOMP1(NRFUN) 1,20
IMPLICIT NONE
C ------------------------------------------------------------------
C Solar,GHG Trend, VolcAer Size Selection Parameters: Defaults
C Process KYEARX KJDAYX
c SolarCon, UV 0 0
c GH Gas Trend 0 0
c REFF0= 0.3
c VEFF0= 0.35
C ------------------------------------------------------------------
c NRFUN is now set as an argument from calling routine so that unit
c numbers can be set automatically
INTEGER, DIMENSION(14) :: NRFUN
C radfile1 2 3 4 5 6 7 8 9 A B C D E
!? DATA NRFN0/71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84/
INTEGER, SAVE :: IFIRST=1 ! ,NRFN0
CHARACTER*80 EPSTAG,TITLE
REAL*4 OZONLJ(44,46),R72X46(72,46),VTAUR4(1800,24)
REAL*8 :: EJMLAT(47),E20LAT(20)
INTEGER :: I,J,K,L,M,N,N1,N2,NRFU,KK,NN,IYEAR,IMONTH,JJDAYS,JYEARS
* ,JJDAYG,JYEARG
REAL*8 :: WAVNA,WAVNB,PFWI,TKOFPF,SUM,EPK,EPL,DEP,SFNORM,D,O,Q,S
* ,OCM,WCM
!? IF(LASTVC.GT.0) NRFUN=NRFN0
IF(IFIRST.LT.1) GO TO 9999
C ------------------------------------------------------------------
C Input data are read as specified in the first CALL RCOMP1 (NRFUN).
C Subsequent calls to RCOMP1 can be used to re-initialize parameters
C in SETXXX subroutines to different values, but no new data is read
C ------------------------------------------------------------------
C ------------------------------------------------------------------
C MADVEL Model Add-on Data of Extended Climatology Enable Parameter
C Each MADVEL digit is ON/OFF switch for corresponding input
C e.g. MADVEL=123456 (zero digit skips input process)
C
C MADO3M = 1 Reads Decadal Ozone files and Ozone trend file
C MADAER = 2 Reads Aerosol 50y tropospheric climatology RFILE5
C MADDST = 3 Reads Dust-windblown mineral climatology RFILE6
C MADVOL = 4 Reads Volcanic 1950-00 aerosol climatology RFILE7
C MADEPS = 5 Reads Epsilon cloud heterogeneity data RFILE8
C MADLUV = 6 Reads Lean's SolarUV 1882-1998 variability RFILE9
C
C Related Model Add-on Data Parameters set in RADPAR
C
C MADGHG = 1 Default Enables UPDGHG update. (MADGHG=0),no update
C MADSUR = 1 Reads V72X46N.1.cor Vegetation type data RFILEC
C Z72X46N Ocean fraction, topography RFILED
C ------------------------------------------------------------------
C Initialize variables that might not otherwise get defined
C ---------------------------------------------------------
DO 110 L=1,LX
TAUWC(L)=0.D0
TAUIC(L)=0.D0
SIZEWC(L)=0.D0
SIZEIC(L)=0.D0
CLDEPS(L)=0.D0
FPXCO2(L)=1.D0
FPXOZO(L)=1.D0
TLB(L)=250.D0
TLT(L)=250.D0
TLM(L)=250.D0
SHL(L)=0.D0
RHL(L)=0.D0
DO 101 I=1,6
SRAEXT(L,I)=0.D0
SRASCT(L,I)=0.D0
SRAGCB(L,I)=0.D0
SRBEXT(L,I)=0.D0
SRBSCT(L,I)=0.D0
SRBGCB(L,I)=0.D0
SRDEXT(L,I)=0.D0
SRDSCT(L,I)=0.D0
SRDGCB(L,I)=0.D0
SRVEXT(L,I)=0.D0
SRVSCT(L,I)=0.D0
SRVGCB(L,I)=0.D0
DBLEXT(L,I)=0.D0
DBLSCT(L,I)=0.D0
DBLGCB(L,I)=0.D0
DBLPI0(L,I)=0.D0
SRCEXT(L,I)=0.D0
SRCSCT(L,I)=0.D0
SRCGCB(L,I)=0.D0
SRCPI0(L,I)=0.D0
101 CONTINUE
DO 102 I=1,33
TRAALK(L,I)=0.D0
TRBALK(L,I)=0.D0
TRDALK(L,I)=0.D0
TRVALK(L,I)=0.D0
TRCALK(L,I)=0.D0
TRGXLK(L,I)=0.D0
102 CONTINUE
DO 103 I=1,13
U0GAS(L,I)=0.D0
ULGAS(L,I)=0.D0
103 CONTINUE
DO 104 I=1,ITRMAX
TRACER(L,I)=0.D0
104 CONTINUE
110 CONTINUE
IF(LASTVC.GT.0) CALL SETATM
IF(NLP.GT.LX) call stop_model('rcomp1: increase LX',255)
C**** Use (global mean) pressures to get standard mid-latitude summer
C**** values for height, density, temperature, ozone, water vapor
DO 120 L=1,NLP
PLB0(L)=PLB(L)
CALL PHATMO(PLB0(L),HLB0(L),D,TLB(L),O,Q,S,OCM,WCM,1,2)
120 CONTINUE
DO 121 L=1,NL
TLT(L)=TLB(L+1)
TLM(L)=0.5D0*(TLB(L)+TLT(L))
121 CONTINUE
!sl De-activate surface layer computations
!sl DO I=1,33
!sl TAUSL(I)=0.0
!sl FTAUSL(I)=0.0
!sl END DO
C-----------------------------------------------------------------------
CR(1) Reads GTAU Asymmetry Parameter Conversion Table used within SGPGXG
C
C (SGPGXG does Multiple Scattering Parameterization used in SOLAR)
C ----------------------------------------------------------------
NRFU=NRFUN(1)
READ (NRFU) GTAU,TGDATA
CALL SETGTS
C-----------------------------------------------------------------------
CR(2) Reads in Merged k-Distribution Tau Tables for Thermal Radiation
C CFCs, H2O Continuum Tau Table, Merged k-Distr Planck Flux Table
C
C (Reads: TAUTBL,TAUWV0,PLANCK,XKCFC,H2OCN8,H2OCF8
c DUCH4,SDUCH4,DUN2O,SDUN2O,ULOX,DUX used in TAUGAS)
C ----------------------------------------------------------------
NRFU=NRFUN(2)
READ(NRFU) TAUTBL,TAUWV0,PLANCK,XKCFC,H2OCN8,H2OCF8, XUN2O,XUN2O0,
* XUCH4,XUCH40, XTRUP,XTU0, XTRDN,XTD0, CXUCO2,CXUO3,ULOX,DUX
C Define Window Flux to Brightness Temperature Conversion Factors
C ---------------------------------------------------------------
WAVNA=850.D0
WAVNB=900.D0
DO I=1,630
PFWI=0.001D0*I
IF(I.GT.100) PFWI=(0.1D0+0.01D0*(I-100))
IF(I.GT.190) PFWI=(1.0D0+0.10D0*(I-190))
TKPFW(I)=TKOFPF(WAVNA,WAVNB,PFWI)
END DO
DO I=1,900
PFWI=I
TKPFT(I)=TKOFPF(0.D0,10000.D0,PFWI)
END DO
C PLANCK Table interpolation limit parameters
C -------------------------------------------
C ITPFT0=123
C ITNEXT=250
C-----------------------------------------------------------------------
CR(3) Read Mie Scattering Parameters [Qext, Qscat, AsymParameter]
C (1) Tropospheric Aerosols [11 Background, 8 Trop8 Aerosols]
C (2) Clouds [5 Water, 5 non-spherical Ice, 5 Mie Ice Clouds]
C (3) Desert Dust Aerosols [25 particle sizes - to select 8]
C (4) Volcanic Aerosols [20 particle sizes, 5 size variances]
C (5) Sulfate Aerosols [22 particle sizes, 0.1 - 10. micron]
C (6) Soot Aerosols [25 particle sizes, 0.001 - 5.0 micron]
C -----------------------------------------------------------
NRFU=NRFUN(3)
C GCM 11 background aerosol Mie parameters
C ----------------------------------------
DO 301 N=1,11
READ (NRFU,3000) TITLE
3000 FORMAT(A80)
READ (NRFU,3001) (SRAQEX(K,N),K=1,6)
3001 FORMAT( 18X,6(F7.5,1X))
READ (NRFU,3001) (SRAQSC(K,N),K=1,6)
READ (NRFU,3001) (SRAQCB(K,N),K=1,6)
301 CONTINUE
READ (NRFU,3002) (Q55A11(N),N=1,11)
3002 FORMAT( 18X,6(F7.5,1X)/18X,6(F7.5,1X))
READ (NRFU,3003) (REFA11(N),N=1,11)
3003 FORMAT( 18X,6(F7.3,1X)/18X,5(F7.3,1X))
READ (NRFU,3003) (VEFA11(N),N=1,11)
DO 302 N=1,11
READ (NRFU,3000) TITLE
READ (NRFU,3004) (TRAQEX(K,N),K=1,33)
3004 FORMAT( 14X,7(F7.5,1X),4(/14X,7(F7.5,1X)))
3005 FORMAT(/14X,7(F7.5,1X),4(/14X,7(F7.5,1X)))
READ (NRFU,3005) (TRAQSC(K,N),K=1,33)
READ (NRFU,3005) (TRAQCB(K,N),K=1,33)
302 CONTINUE
C GCM 9 (of 10) climatology aerosol Mie parameters
C ------------------------------------------------
DO 303 N=1,10
IF(N.EQ.6) GO TO 303
READ (NRFU,3000) TITLE
READ (NRFU,3001) (SRBQEX(K,N),K=1,6)
READ (NRFU,3001) (SRBQSC(K,N),K=1,6)
READ (NRFU,3001) (SRBQCB(K,N),K=1,6)
303 CONTINUE
READ (NRFU,3002) (Q55B10(N),N=1,5),(Q55B10(N),N=7,10)
READ (NRFU,3003) (REFB10(N),N=1,5),(REFB10(N),N=7,10)
READ (NRFU,3003) (VEFB10(N),N=1,5),(VEFB10(N),N=7,10)
DO 304 N=1,10
IF(N.EQ.6) GO TO 304
READ (NRFU,3000) TITLE
READ (NRFU,3004) (TRBQEX(K,N),K=1,33)
READ (NRFU,3005) (TRBQSC(K,N),K=1,33)
READ (NRFU,3005) (TRBQCB(K,N),K=1,33)
304 CONTINUE
C Cloud Water, Ice-non, Ice-Mie parameters
C ----------------------------------------
DO 305 N=1,15
READ (NRFU,3000) TITLE
READ (NRFU,3001) (SRCQEX(K,N),K=1,6)
READ (NRFU,3001) (SRCQSC(K,N),K=1,6)
READ (NRFU,3001) (SRCQCB(K,N),K=1,6)
305 CONTINUE
READ (NRFU,3006) (Q55C15(N),N=1,15)
3006 FORMAT( 18X,6(F7.5,1X)/18X,6(F7.5,1X)/18X,6(F7.5,1X))
READ (NRFU,3007) (REFC15(N),N=1,15)
3007 FORMAT( 18X,6(F7.3,1X)/18X,6(F7.3,1X)/18X,6(F7.3,1X))
READ (NRFU,3007) (VEFC15(N),N=1,15)
DO 306 N=1,15
READ (NRFU,3000) TITLE
READ (NRFU,3004) (TRCQEX(K,N),K=1,33)
READ (NRFU,3005) (TRCQSC(K,N),K=1,33)
READ (NRFU,3005) (TRCQCB(K,N),K=1,33)
READ (NRFU,3005) (TRCQAL(K,N),K=1,33)
306 CONTINUE
C Desert Dust 25 sizes, Mie parameter data
C ----------------------------------------
DO 307 N=1,25
READ (NRFU,3001) (SRDQEX(K,N),K=1,6)
READ (NRFU,3001) (SRDQSC(K,N),K=1,6)
READ (NRFU,3001) (SRDQCB(K,N),K=1,6)
307 CONTINUE
READ (NRFU,3008) (Q55D25(N),N=1,25)
3008 FORMAT( 18X,5(F7.5,1X),4(/18X,5(F7.5,1X)))
READ (NRFU,3009) (REFD25(N),N=1,25)
3009 FORMAT( 18X,12(F3.1,1X)/18X,12(F3.1,1X)/18X,F3.0)
READ (NRFU,3010) (VEFD25(N),N=1,25)
3010 FORMAT( 18X,12(F3.1,1X)/18X,12(F3.1,1X)/18X,F3.1)
DO 308 N=1,25
READ (NRFU,3000) TITLE
READ (NRFU,3004) (TRDQEX(K,N),K=1,33)
READ (NRFU,3005) (TRDQSC(K,N),K=1,33)
READ (NRFU,3005) (TRDQCB(K,N),K=1,33)
READ (NRFU,3005) (TRDQAL(K,N),K=1,33)
308 CONTINUE
TRDQAB(:,:)=TRDQEX(:,:)-TRDQSC(:,:) ! used in writer only
C Volcanic aerosol Mie size, variance data
C ----------------------------------------
DO 313 M=1,5
IF(M.EQ.4) GO TO 313
DO 311 N=1,20
READ (NRFU,3001) (SRVQEX(K,N,M),K=1,6)
READ (NRFU,3001) (SRVQSC(K,N,M),K=1,6)
READ (NRFU,3001) (SRVQCB(K,N,M),K=1,6)
311 CONTINUE
READ (NRFU,3011) (Q55V20(N,M),N=1,20)
3011 FORMAT( 18X,5(F7.5,1X),3(/18X,5(F7.5,1X)))
READ (NRFU,3012) (REFV20(N,M),N=1,20)
3012 FORMAT( 18X,12(F3.1,1X)/18X,8(F3.1,1X))
READ (NRFU,3012) (VEFV20(N,M),N=1,20)
DO 312 N=1,20
READ (NRFU,3000) TITLE
READ (NRFU,3004) (TRVQEX(K,N,M),K=1,33)
READ (NRFU,3005) (TRVQSC(K,N,M),K=1,33)
READ (NRFU,3005) (TRVQCB(K,N,M),K=1,33)
READ (NRFU,3005) (TRVQAL(K,N,M),K=1,33)
312 CONTINUE
313 CONTINUE
DO 316 N=1,20
DO 314 K=1,6
SRVQEX(K,N,4)=(SRVQEX(K,N,3)+SRVQEX(K,N,5))/2.D0
SRVQSC(K,N,4)=(SRVQSC(K,N,3)+SRVQSC(K,N,5))/2.D0
SRVQCB(K,N,4)=(SRVQCB(K,N,3)+SRVQCB(K,N,5))/2.D0
314 CONTINUE
Q55V20(N,4)=(Q55V20(N,3)+Q55V20(N,5))/2.D0
REFV20(N,4)=(REFV20(N,3)+REFV20(N,5))/2.D0
VEFV20(N,4)=(VEFV20(N,3)+VEFV20(N,5))/2.D0
DO 315 K=1,33
TRVQEX(K,N,4)=(TRVQEX(K,N,3)+TRVQEX(K,N,5))/2.D0
TRVQSC(K,N,4)=(TRVQSC(K,N,3)+TRVQSC(K,N,5))/2.D0
TRVQCB(K,N,4)=(TRVQCB(K,N,3)+TRVQCB(K,N,5))/2.D0
TRVQAL(K,N,4)=(TRVQAL(K,N,3)+TRVQAL(K,N,5))/2.D0
315 CONTINUE
316 CONTINUE
C Sulfate aerosol, Mie parameter 22-size data
C -------------------------------------------
DO 321 N=1,22
READ (NRFU,3000) TITLE
READ (NRFU,3001) (SRUQEX(K,N),K=1,6)
READ (NRFU,3001) (SRUQSC(K,N),K=1,6)
READ (NRFU,3001) (SRUQCB(K,N),K=1,6)
321 CONTINUE
READ (NRFU,3008) (Q55U22(N),N=1,22)
READ (NRFU,3013) (REFU22(N),N=1,22)
3013 FORMAT( 18X,5(F7.3,1X),4(/18X,5(F7.3,1X)))
READ (NRFU,3013) (VEFU22(N),N=1,22)
DO 322 N=1,22
READ (NRFU,3000) TITLE
READ (NRFU,3004) (TRUQEX(K,N),K=1,33)
READ (NRFU,3005) (TRUQSC(K,N),K=1,33)
READ (NRFU,3005) (TRUQCB(K,N),K=1,33)
READ (NRFU,3005) (TRUQAL(K,N),K=1,33)
322 CONTINUE
C Soot aerosol, Mie parameter 25-size data
C ----------------------------------------
DO 323 N=1,25
READ (NRFU,3000) TITLE
READ (NRFU,3001) (SRSQEX(K,N),K=1,6)
READ (NRFU,3001) (SRSQSC(K,N),K=1,6)
READ (NRFU,3001) (SRSQCB(K,N),K=1,6)
323 CONTINUE
READ (NRFU,3008) (Q55S25(N),N=1,25)
READ (NRFU,3013) (REFS25(N),N=1,25)
READ (NRFU,3013) (VEFS25(N),N=1,25)
DO 324 N=1,25
READ (NRFU,3000) TITLE
READ (NRFU,3004) (TRSQEX(K,N),K=1,33)
READ (NRFU,3005) (TRSQSC(K,N),K=1,33)
READ (NRFU,3005) (TRSQCB(K,N),K=1,33)
READ (NRFU,3005) (TRSQAL(K,N),K=1,33)
324 CONTINUE
C Seasalt aerosol, Mie parameter 22-size data
C Nitrate aerosol, Mie parameter 22-size data
C (Water) aerosol, Mie parameter 22-size data
C Organic aerosol, Mie parameter 22-size data
C -------------------------------------------
N1=23
DO 326 KK=1,4
N2=N1+21
DO 325 N=N1,N2
READ (NRFU,3000) TITLE
READ (NRFU,3001) (SRUQEX(K,N),K=1,6)
READ (NRFU,3001) (SRUQSC(K,N),K=1,6)
READ (NRFU,3001) (SRUQCB(K,N),K=1,6)
325 CONTINUE
READ (NRFU,3008) (Q55U22(N),N=N1,N2)
READ (NRFU,3013) (REFU22(N),N=N1,N2)
READ (NRFU,3013) (VEFU22(N),N=N1,N2)
N1=N2+1
326 CONTINUE
N1=23
DO 328 KK=1,4
N2=N1+21
DO 327 N=N1,N2
READ (NRFU,3000) TITLE
READ (NRFU,3004) (TRUQEX(K,N),K=1,33)
READ (NRFU,3005) (TRUQSC(K,N),K=1,33)
READ (NRFU,3005) (TRUQCB(K,N),K=1,33)
READ (NRFU,3005) (TRUQAL(K,N),K=1,33)
327 CONTINUE
N1=N2+1
328 CONTINUE
C Sinyuk Desert Dust 25 sizes, Mie parameter data
C -----------------------------------------------
DO 347 N=1,25
READ (NRFU,3001) (SRDQEX(K,N),K=1,6)
READ (NRFU,3001) (SRDQSC(K,N),K=1,6)
READ (NRFU,3001) (SRDQCB(K,N),K=1,6)
347 CONTINUE
READ (NRFU,3008) (Q55D25(N),N=1,25)
READ (NRFU,3009) (REFD25(N),N=1,25)
READ (NRFU,3010) (VEFD25(N),N=1,25)
DO 348 N=1,25
READ (NRFU,3000) TITLE
READ (NRFU,3004) (TRDQEX(K,N),K=1,33)
READ (NRFU,3005) (TRDQSC(K,N),K=1,33)
READ (NRFU,3005) (TRDQCB(K,N),K=1,33)
READ (NRFU,3005) (TRDQAL(K,N),K=1,33)
348 CONTINUE
TRDQAB(:,:)=TRDQEX(:,:)-TRDQSC(:,:) ! used in writer only
C-----------------------------------------------------------------------
CR(6) DUST: Monthly-Mean Desert Dust (Clay,Silt) 8-Size Optical Depths
C Map: IJ=72x46, Lay: L=1-9, Siz: S=1-8, Month: M=1-12
C -----------------------------------------------------
IF(MADDST.LT.1) GO TO 699
NRFU=NRFUN(6)
READ (NRFU) TDUST
699 CONTINUE
C-----------------------------------------------------------------------
CR(7) Read Makiko's Stratospheric binary data made in April, 2002
C (1800 months (1850-1999) x 24 latitudes)
C ----------------------------------------
IF(MADVOL.LT.1) GO TO 799
NRFU=NRFUN(7)
READ (NRFU) TITLE
IF(TITLE(1:13).eq.'Optical Depth')
& call stop_model('rcomp1: use new RADN7',255)
REWIND (NRFU)
DO K=1,5
READ (NRFU) TITLE,VTAUR4
DO J=1,24
DO I=1,1800
V4TAUR(I,J,K)=VTAUR4(I,J)
END DO
END DO
END DO
799 CONTINUE
C-----------------------------------------------------------------------
CR(8) ISCCP Derived Cloud Variance (EPSILON) Cloud Optical Depth Factor
C Low, Mid, High Cloud Optical Depths are Reduced by (1 - EPSILON)
C
C INPUT DATA FILE: UNIT = INFILE
C TAG = EPSTAG (CHARACTER*80)
C DATA = EPLMHC (72,46,12,4) REAL*4
C
C Data are 72X46 Monthly Mean Low, Mid, High, Column EPSILON Values
C Cloud Heterogeneity selections used in UPDEPS, GETEPS (in SETCLD)
C
C EPSCON Column Cloud Inhomogeneity EPSILON (when KCLDEP=1)
C KCLDEP Selects Cloud Inhomogeneity Option (0-4):
C KCLDEP = 0 Sets Column CLDEPS to Zero
C KCLDEP = 1 Sets Column CLDEPS to EPSCON
C KCLDEP = 2 Keeps whatever is specified in CLDEPS
C KCLDEP = 3 Uses: Column EPCOL(72,46) Climatology
C KCLDEP = 4 Uses: Ht Dep EPLOW, EPMID, EPHIG Data
C --------------------------------------------------------
IF(MADEPS.LT.1) GO TO 899
NRFU=NRFUN(8)
READ (NRFU) EPSTAG,EPLMHC
DO 811 N=1,4
DO 810 M=1,12
DO 809 I=1,72
L=0
801 CONTINUE
L=L+1
IF(EPLMHC(I,L,M,N).LT.0.0) GO TO 801
IF(L.GT.1) THEN
DO 802 J=1,L
EPLMHC(I,J,M,N)=EPLMHC(I,L,M,N)
802 CONTINUE
ENDIF
L=47
803 CONTINUE
L=L-1
IF(EPLMHC(I,L,M,N).LT.0.0) GO TO 803
IF(L.LT.46) THEN
DO 804 J=L,46
EPLMHC(I,J,M,N)=EPLMHC(I,L,M,N)
804 CONTINUE
ENDIF
J=0
805 CONTINUE
J=J+1
IF(J.GT.46) GO TO 808
IF(EPLMHC(I,J,M,N).GE.0.0) GO TO 805
K=J-1
EPK=EPLMHC(I,K,M,N)
806 CONTINUE
J=J+1
IF(J.GT.46) GO TO 808
IF(EPLMHC(I,J,M,N).LT.0.0) GO TO 806
L=J
EPL=EPLMHC(I,L,M,N)
NN=L-K-1
DEP=(EPL-EPK)/(L-K)
DO 807 L=1,NN
EPLMHC(I,K+L,M,N)=EPK+L*DEP
807 CONTINUE
GO TO 805
808 CONTINUE
809 CONTINUE
810 CONTINUE
811 CONTINUE
899 CONTINUE
C-----------------------------------------------------------------------
CR(E)
C KCLDEM Selects: Top-Cloud (Thermal) Scattering Correction
C KCLDEM = 0 Utilizes Non-scattering approximation
C KCLDEM = 1 Modifies emission and transmission by
C top cloud (over-rides old correction)
C ----------------------------------------------------------
NRFU=NRFUN(14)
READ (NRFU) RIJTPG,FDXTPG,FEMTPG
C-----------------------------------------------------------------------
CR(9) Read Judith Lean's Solar UV and Solar Constant Variability
C Monthly-Mean Solar UV (1882-1998)
C ---------------------------------
IF(KSOLAR.LT.0) GO TO 949
IF(MADLUV.LT.1) GO TO 909
NRFU=NRFUN(9)
READ(NRFU,'(a80)') TITLE
if(ksolar.ge.2 .and. TITLE(1:3).ne.'ANN')
& call stop_model('rcomp1: change RADN9 to ann.file',255)
if(ksolar.lt.2 .and. TITLE(1:3).eq.'ANN')
& call stop_model('rcomp1: change RADN9 to monthly file',255)
READ(NRFU,'(5F14.2)') (WSLEAN(I),I=1,190)
READ(NRFU,'(a80)') TITLE
READ(NRFU,'(5E14.3)') (DSLEAN(I),I=1,190)
DO I=1,190
WSLEAN(I)=WSLEAN(I)/1000.D0
DSLEAN(I)=DSLEAN(I)/1000.D0
W1LEAN(I)=WSLEAN(I)-0.5D0*DSLEAN(I)
END DO
READ(NRFU,'(a80)') TITLE
READ(NRFU,'(a80)') TITLE
IF(KSOLAR.LT.2) THEN
C**** Read in monthly-mean data
DO I=1,Ms0X
READ(NRFU,'(2I6,3F17.6)') IYEAR,IMONTH,TSI1(I),TSI2(I)
READ(NRFU,'(5E14.6)') (FSLEAN(K),K=1,190)
SUM=0.D0
DO K=1,190
SUM=SUM+FSLEAN(K)*DSLEAN(K)
END DO
SFNORM=TSI1(I)/SUM
DO K=1,190
UVLEAN(I,K)=FSLEAN(K)*SFNORM
END DO
END DO
ELSE
C**** Read in annual-mean data
DO I=1,Ms0X
READ(NRFU,'(F12.1,2F15.4)',end=908) yr2S0,TSI1(I),TSI2(I)
if(I.eq.1) yr1S0 = yr2S0
READ(NRFU,'(5E14.6)') (UVLEAN(I,K),K=1,190)
END DO
908 write(6,*) 'read S0-history: ',yr1S0,' - ',yr2S0
END IF
GO TO 949
909 CONTINUE
DO I=1,190
WSLEAN(I)=WSLEAN(I)/1000.D0
DSLEAN(I)=DSLEAN(I)/1000.D0
W1LEAN(I)=WSLEAN(I)-0.5D0*DSLEAN(I)
END DO
949 CONTINUE
C-----------------------------------------------------------------------
CR(C) Read: Elaine Mathews 10 Fractional Vegetation Distributions
C 10 global maps (72x46) depict fractional vegetation/soil types
C Map-1 (bright sand) + Map-10 (black dirt) define desert albedo
C (sum of Maps 1-10 over land-area (ILON,JLAT) grid boxes = 1.0)
C
C Map-11 refers to plankton concentrations over ocean areas that
C are yet to be implemented.
C --------------------------------------------------------------
C-----------------------------------------------------------------------
CR(D) Read: 1 FOCEAN 72x46 ocean fraction (FOCEAN = 0 or 1)
C 2 FLAKE 72x46 lake fraction
C 3 FGRND 72x46 lake fraction
C 4 FGICE 72x46 glacial ice fraction
C (FLAKE + FGRND + FGICE + FOCEAN = 1.000)
C
C 5 ZATMO 72x46 topography (ocean = 0.0)
C 6 HOCEAN 72x46 ocean depth
C 7 HLAKE 72x46 lake depth
C 8 HGICE 72x46 glice depth
C 9 ZSOLID 72x46 topography of solid ground surface
C -----------------------------------------------------
C
C FOLGIZ is for off-line use only, and is not used in GCM radiation.
C GCM supplies dynamically changing POCEAN,POICE,PEARTH,PLICE values
C ------------------------------------------------------------------
999 CONTINUE
IFIRST=0
9999 CONTINUE
C ---------------------------------------------------------------
C LASTVC Initialize: Default Atmospheric Layering, Structure
C (for Off-Line use) as Specified by LASTVC Parameter
C If LASTVC < 0, GCM defines all Radiation Model Input
C otherwise:
C Each LASTVC digit(6) specifies a model configuration
C e.g.: LASTVC= 123456
C L=0,1,..9 Layers NL= Any,GCM12,GCM23,Pset,Hset,etc
C A=0,1,..6 Atmosphere Any,Trop,MLS,MLW,SAS,SAW,Std
C S=0,1,..9 Surf Types POCEAN=1,PEARTH=1,POICE=1,etc
C T=0,1,..9 Tracer Aer Tau=0, Tau=0.1 Aer Comp(1-9)
C V=0,1,..9 Vegetation Sand,Tundra,Grass,Shrubs, etc
C C=0,1,..9 Cloud,R=10 Clim Cloud Tau in Layer(1,-9)
C ----------------------------------------------------
IF(LASTVC.GE.0) CALL SETATM
C -------------------------------------------------------
C Set Solar Constant for Default Reference Time: Jan 1950
C Default used for KSOLAR(=1) is that specified in RADPAR
C -------------------------------------------------------
JJDAYS=1
JYEARS=1950
IF(KJDAYS.GT.0) JJDAYS=KJDAYS
IF(KYEARS.GT.0) JYEARS=KYEARS
C----------------------------------------------
CALL SETSOL(JYEARS,JJDAYS)
C----------------------------------------------
C -------------------------------------------------------
C Set Default Greenhouse Gas Reference Year to: Mid 1980
C Default used for KTREND(=1) is that specified in RADPAR
C -------------------------------------------------------
JJDAYG=184
JYEARG=1980
C----------------------------------------------
CALL SETGHG(JYEARG,JJDAYG)
C----------------------------------------------
IF(KJDAYG.GT.0) JJDAYG=KJDAYG
IF(KYEARG.GT.0) JYEARG=KYEARG
C----------------------------------------------
CALL UPDGHG(JYEARG,JJDAYG)
C----------------------------------------------
C--------------------------------
CALL SETGAS
C
CALL SETBAK
IF(MADAER.GT.0.or.NTRACE.gt.0) CALL SETAER
IF(MADDST.GT.0) CALL SETDST
C--------------------------------
C -----------------------------------------------------
C Set Volcanic Aerosol Effective Variance Default Value
C Particle Size(REFF0=0.3) when not known from data
C (VEFF0=0.35 is value based on thermal ISAMS data)
C -------------------------------------------------
C----------------------------------------------
IF(MADVOL.GT.0) CALL SETVOL
C----------------------------------------------
C--------------------------------
CALL SETCLD
C--------------------------------
CALL SOLAR0
RETURN
END SUBROUTINE RCOMP1
SUBROUTINE RCOMPT 1,8
IMPLICIT NONE
C-----------------------------------------------------------------------
C
C Time Trend Selection Parameters and Options:
C -------------------------------------------
C
C The Nominal Default Values are KYEARX = 0, and KJDAYX = 0,
C in which case RADPAR supplied Time JYEAR and JDAY are used
C
C When Non-Zero Values are specified for KYEARX and KJDAYX,
C the JYEAR,JDAY Time Dependence of the Specified Process is
C over-ridden by the Non-Zero KYEARX and KJDAYX Value.
C ----------------------------------------------------------
C Process KYEARX KJDAYX
c KYEARS,KJDAYS SolarCon, UV 0 0
c KYEARG,KJDAYG GH Gas Trend 0 0
c KYEARO,KJDAYO Ozone Distr 0 0
c KYEARA,KJDAYA AerClimtolgy 0 0
c KYEARD,KJDAYD Desert Dust 0 0
c KYEARV,KJDAYV Volcanic Aer 0 0
c KYEARE,KJDAYE Epsilon Clds 0 0
c KYEARR,KJDAYR Refl Surface 0 0
C ------------------------------------------------------------------
C MADVEL Model Add-on Data of Extended Climatology Enable Parameter
C Each MADVEL digit is ON/OFF switch for corresponding input
C e.g. MADVEL=123456 (zero digit skips input process)
C
C MADAER = 2 Updates Aerosol 50y tropospheric climatology RFILE5
C MADDST = 3 Updates Dust-windblown mineral climatology RFILE6
C MADVOL = 4 Updates Volcanic 1950-00 aerosol climatology RFILE7
C MADEPS = 5 Updates Epsilon cloud heterogeneity data RFILE8
C MADLUV = 6 Updates Lean's SolarUV 1882-1998 variability RFILE9
C
C Related Model Add-on Data Parameters set in RADPAR
C
C MADGHG = 1 Default Enables UPDGHG update. (MADGHG=0),no update
C MADSUR = 1 V72X46N.1.cor Vegetation type data RFILEC
C Z72X46N Ocean fraction, topography RFILED
C ------------------------------------------------------------------
INTEGER JJDAYS,JYEARS,JJDAYG,JYEARG,JJDAYO,JYEARO,JJDAYA,JYEARA
* ,JJDAYD,JYEARD,JJDAYV,JYEARV,JJDAYE,JYEARE,JJDAYR,JYEARR
C -------------------------------------------------
C Set Seasonal and Time (JDAY) Dependent Quantities
C -------------------------------------------------
JJDAYS=JDAY
JYEARS=JYEAR
IF(KJDAYS.GT.0) JJDAYS=KJDAYS
IF(KYEARS.GT.0) JYEARS=KYEARS
C----------------------------------------------
IF(MADLUV.GT.0) CALL UPDSOL(JYEARS,JJDAYS)
C----------------------------------------------
JJDAYG=JDAY
JYEARG=JYEAR
IF(KJDAYG.GT.0) JJDAYG=KJDAYG
IF(KYEARG.GT.0) JYEARG=KYEARG
C----------------------------------------------
IF(MADGHG.GT.0) CALL UPDGHG(JYEARG,JJDAYG)
C----------------------------------------------
JJDAYO=JDAY
JYEARO=JYEAR
IF(KJDAYO.NE.0) JJDAYO=KJDAYO
IF(KYEARO.NE.0) JYEARO=KYEARO
C----------------------------------------------
CALL UPDO3D(JYEARO,JJDAYO)
C----------------------------------------------
JJDAYA=JDAY
JYEARA=JYEAR
IF(KJDAYA.GT.0) JJDAYA=KJDAYA
IF(KYEARA.GT.0) JYEARA=KYEARA
C----------------------------------------------
IF(MADAER.NE.0) CALL UPDAER(JYEARA,JJDAYA)
C----------------------------------------------
JJDAYD=JDAY
JYEARD=JYEAR
IF(KJDAYD.GT.0) JJDAYD=KJDAYD
IF(KYEARD.GT.0) JYEARD=KYEARD
C----------------------------------------------
IF(MADDST.GT.0) CALL UPDDST(JYEARD,JJDAYD)
C----------------------------------------------
JJDAYV=JDAY
JYEARV=JYEAR
IF(KJDAYV.GT.0) JJDAYV=KJDAYV
IF(KYEARV.GT.0) JYEARV=KYEARV
C----------------------------------------------
IF(MADVOL.GT.0) CALL UPDVOL(JYEARV,JJDAYV)
C----------------------------------------------
JJDAYE=JDAY
JYEARE=JYEAR
IF(KJDAYE.GT.0) JJDAYE=KJDAYE
IF(KYEARE.GT.0) JYEARE=KYEARE
C----------------------------------------------
IF(MADEPS.GT.0) CALL UPDEPS(JYEARE,JJDAYE)
C----------------------------------------------
JJDAYR=JDAY
JYEARR=JYEAR
IF(KJDAYR.GT.0) JJDAYR=KJDAYR
IF(KYEARR.GT.0) JYEARR=KYEARR
C----------------------------------------------
CALL UPDSUR(JYEARR,JJDAYR)
C----------------------------------------------
RETURN
END SUBROUTINE RCOMPT
SUBROUTINE RCOMPX 1,11
IMPLICIT NONE
C ------------------------------------------------------------------
C MADVEL Model Add-on Data of Extended Climatology Enable Parameter
C Each MADVEL digit is ON/OFF switch for corresponding input
C e.g. MADVEL=123456 (zero digit skips process)
C
C MADO3M = 1 Makiko's 1951-1997 Ozone climatology RFILEA
C MADAER = 2 Updates Aerosol 50y tropospheric climatology RFILE5
C MADDST = 3 Updates Dust-windblown mineral climatology RFILE6
C MADVOL = 4 Updates Volcanic 1950-00 aerosol climatology RFILE7
C MADEPS = 5 Epsilon cloud heterogeneity data RFILE8
C MADLUV = 6 Lean's SolarUV 1882-1998 variability RFILE9
C
C Related Model Add-on Data Parameters set in RADPAR
C
C MADGHG = 1 Default Enables UPDGHG update. (MADGHG=0),no update
C MADSUR = 1 V72X46N.1.cor Vegetation type data RFILEC
C Z72X46N Ocean fraction, topography RFILED
C ------------------------------------------------------------------
C
C -----------------------------------------------------------------
C Get Surface, Atmosphere, Sun Angle, Radiative Forcing, etc. Input
C to compute Solar/Thermal Radiation for given (JLAT,ILON) Grid-box
C
C The Radiation Model utilizes Data with 72x46 (lon,lat) resolution
C for GCM resolution other than 72x46, set JLAT and ILON
C to appropriately Sample (rather than interpolate) the
C 72x46 aerosol, ozone, cloud heterogeneity data sets
C
C The Radiation Model can accommodate arbitrary vertical resolution
C -----------------------------------------------------------------
C--------------------------------
!!! CALL GETO3D(ILON,JLAT)
CALL REPART(O3JDAY(1,ILON,JLAT),PLBO3,NLO3+1,U0GAS(1,3),PLB0,NL+1)
O3_OUT(:)=U0GAS(:,3) ! to save 3D ozone field in SUBR. RADIA
if(use_tracer_ozone .eq. 1) U0GAS(1:NL-3,3)=O3_IN(1:NL-3)
! The -3 in the line above is just a fudge for the 23-layer model.
! Gavin said he'd think about how to do this properly.
CALL GETGAS
C--------------------------------
C--------------------------------
SRBEXT=1.d-20 ; SRBSCT=0. ; SRBGCB=0. ; TRBALK=0.
IF(MADBAK.GT.0) CALL GETBAK
IF(MADAER.NE.0.OR.NTRACE.GT.0) THEN ; CALL GETAER
ELSE ; SRAEXT=0. ; SRASCT=0. ; SRAGCB=0. ; TRAALK=0. ; END IF
IF(MADDST.GT.0) THEN ; CALL GETDST
ELSE ; SRDEXT=0. ; SRDSCT=0. ; SRDGCB=0. ; TRDALK=0. ; END IF
IF(MADVOL.GT.0) THEN ; CALL GETVOL
ELSE ; SRVEXT=0. ; SRVSCT=0. ; SRVGCB=0. ; TRVALK=0. ; END IF
C--------------------------------
C-------------------------------- (GETSUR sets albedo needed by GETCLD)
CALL GETSUR
CALL GETEPS
CALL GETCLD
C--------------------------------
C--------------------------------
CALL THERML
CALL SOLARM
C--------------------------------
RETURN
END SUBROUTINE RCOMPX
SUBROUTINE SETSOL(JYEARS,JJDAYS) 1,2
IMPLICIT NONE
C-----------------------------------------------------------------------
C
C SETSOL Parameters:
C----------------------
C KSOLAR Selects Solar Spectrum, (Lean vs Thekaekara Flux)
C JYEARS JYEAR Proxy: Sets: Solar Constant Reference Year
C JJDAYS JDAY Proxy: Sets Reference Year Month JDAY/30.5
C (Nominal Reference: JYEARS= 1950 JJDAYS= January)
C
C-----------------------------------------------------------------------
C KSOLAR SOLSPEC UVWAVLs UVFACTs KUVFAC
C-----------------------------------------------------------------------
C -1 THEK Can be set Can be set (if KUVFAC=1)
C-----------------------------------------------------------------------
C 0 LEAN Can be set Can be set (if KUVFAC=1)
C-----------------------------------------------------------------------
C 1 LEAN Can be set Can be set (if KUVFAC=1)
C-----------------------------------------------------------------------
C
C (Option to Modify Solar UV Fluxes)
C UVWAVL Specified Edges of UV Flux Variation SubIntervals
C UVFACT Factors to Change the Amplitude of UV Variability
C
C KUVFAC ON/OFF switch for activating UV Flux Modification
C KSNORM Re-Normalize S0 (VIS) (after UV Amplitude Change)
C (Nominal UVWAVLs are: 0.295,0.310,0.366)
C
C-----------------------------------------------------------------------
C SETSOL Output:
C------------------
C
C AO3 = Ozone Absorption Table AO3(460)
C (Solar UV Flux Weighted Absorption Table is used by the
C FUNCTION AO3ABS(OCM) in SOLAR to compute Ozone Heating)
C AO3 is the fraction of total Solar Flux absorbed by O3.
C
C S00WM2 = Solar Constant Reference Value for Time = JYEARS,JJDAYS
C (Thekaekara, if KSOLAR=-1, Reference = 1367 WATTS/M**2)
C
C
C SETSOL is Generally Called once at Model Initialization to Select
C Solar Flux (LEAN,THEK), and to Define S00WM2 (RATLS0=1)
C
C-----------------------------------------------------------------------
C NOTE:
C-----
C S00WM2 = Nominal Reference Solar Constant 1366.448785D0 WATTS/M**2
C (Spectral Integral: Lean99 Solar Flux for January 1950)
C
C KSOLAR=-1 Reproduces Thekaekhara Ozone Absorption, e.g., XRAD83XX
C KSOLAR= 0 Uses Lean99 Solar Flux as set for Time= (JYEARS,JJDAYS)
C KSOLAR= 1 Sets Lean99 Solar Flux to Current Time= (JYEARS,JJDAYS)
C KSOLAR= 2 same as 1 but based on annual (not monthly) data
C (JJDAYS used to select the specified Monthly-Mean Flux)
C
C-----------------------------------------------------------------------
C
C UPDSOL Parameters:
C----------------------
C JYEARS JYEAR Proxy: Selects Solar Constant Current Year
C JJDAYS JDAY Proxy: Selects Lean Data Month JJDAYS/30.5
C
C UPDSOL Output:
C------------------
C
C AO3 = Ozone Absorption Table AO3(460)
C (Solar UV Flux Weighted Absorption Table is used by the
C FUNCTION AO3ABS(OCM) in SOLAR to compute Ozone Heating)
C AO3 is the fraction of total Solar Flux absorbed by O3.
C
C RATLS0 = Ratio: Current-Time Solar Constant to Reference S00WM2
C
C-----------------------------------------------------------------------
C Remark:
C
C UPDSOL is Called in RCOMPT to Update Solar Constant and Ozone AO3
C Solar UV Absorption Dependence. (Monthly-Mean Data are
C NOT Interpolated in Time, but get Updated with Changing
C Month, i.e., whenever JDAY/30.5 Reaches Integer Value.)
C
C-----------------------------------------------------------------------
REAL*8, PARAMETER :: CORFAC=1366.2911D0/1366.4487855D0
INTEGER, INTENT(IN) :: JYEARS,JJDAYS
INTEGER, SAVE :: LMOREF=0
INTEGER JMO,LMO,Is0x,K,I,NWSUV,II,J
REAL*8 FLXSUM,F1FLUX,F2FLUX,F3FLUX,UVNORM,XX,OCM
* ,TAUK,UVWAVA,UVWAVB,AO33
IF(KSOLAR.GE.0) THEN
C Lean99 Solar Flux, UV Option
C ----------------------------
if(Ksolar.lt.2) then ! monthly data
JMO=1+JJDAYS/30.5D0
IF(JMO.GT.12) JMO=12
LMO=(JYEARS-iy1S0)*12+JMO
IF(LMO.GT.Ms0X) LMO=LMO-mcycs0*((LMO-Ms0X+mcycs0-1)/mcycs0)
IF(LMO.LT.1) LMO=LMO+mcycs0*((mcycs0-lmo)/mcycs0)
else ! annual data
Is0x = nint( yr2s0-yr1s0+1 )
lmo = nint( jyears - yr1s0 + 1.5 )
IF(LMO.GT.Is0X) LMO=LMO-icycs0*((LMO-Is0X+icycs0-1)/icycs0)
IF(LMO.LT.1) LMO=LMO+icycs0*((icycs0-lmo)/icycs0)
end if
LMOREF=LMO
C IF(MADLUV.EQ.0) Default Option is then in force
C Default (FRLEAN) = Lean 1950 Jan Solar, UV flux
C CORFAC accounts for DSLEAN units in BLOCK DATA,
C and TSI1/TSI2 normalization of Lean input data.
C -----------------------------------------------
c CORFAC=1366.2911D0/1366.4487855D0
FLXSUM=0.D0
DO 110 K=1,190
IF(MADLUV.EQ.0) FLXSUM=FLXSUM+FRLEAN(K)*DSLEAN(K)*CORFAC
IF(MADLUV.GT.0) FLXSUM=FLXSUM+UVLEAN(LMO,K)*DSLEAN(K)
110