MODULE PARA_FILE 71
implicit none
!vertical layer parameters
integer, parameter :: &
! & nv = 27, &
! & nv1 = nv + 1, &
! & ndfs = nv, &
! & ndfs2 = ndfs * 2, &
! & mdfs = nv + 1, &
! & ndfs4 = 4 * ndfs, &
& nvx = 100, &
& nv1x = nvx + 1
!spectral band parameters
integer, parameter :: mbs = 6, &!number of sw bands
& mbir = 12, &!number of lw bands
& mb = 18, &!number of bands
& mbx = 18, &!number of bands
& mby = 10 !number of sub-bands in 0.2-0.7 um
!number of drop size distributions
integer, parameter :: nc = 8
!fractional cloud parameters
! integer, parameter :: ngroup = 3, &!number of cloud groups
integer, save :: ngroup = 3, &!number of cloud groups
& nclouds , &!number of total cloud layers
& nsubcld !number of cloud layers in a group
! & nclouds = 24, &!number of total cloud layers
! & nsubcld = 8 !number of cloud layers in a group
! & nclouds = nv, &!number of total cloud layers
! & nsubcld = nclouds/ngroup !number of cloud layers in a group
!aerosol parameters
integer, parameter :: nrh = 8, &!number of relative humidities for optical properties
& naer = 18, &!max number of aerosol types
& mxat = 7, &!max number of wavelength dependent aerosol optical depths
& mxac = naer !max number of aerosol constituents
!parameter for AOT_ SPLINEFIT
integer, parameter :: nsub = 5 , &
& nfuo = 15 , &
& nwo = 75
integer, parameter :: icoln = 3
END module PARA_FILE
!---------------------- Controlling Parameters -------------------------
MODULE control_para 11,1
use PARA_FILE
implicit none
integer, save :: NFRACT = 0, & !add for fractional cloud:=1, fraction; =0, no
& NAERO = 0, & !add for aerosol: =0, no aerosol; = 1, aerosol uniform value included; =2, get data from file
& NINHO = 0 , & ! if =0, horizontal homogenious; = 1, inhomogeneous
& NINHO_VERT, &
& NPDE = 2, & !add for ice crystal size parameterization:
! =4, para. via IWC & AOD using A-Tran satellite data;
! =3, para. via IWC using satellite data;
! =2, para. via IWC (Liou et al. 2008);
! =1, parameterize interms of T & IWC (Gu & Liou, 2006);
! =0, fixed value;
! NPDE = 3 & 4 is still under testing ---- CCCC
& NGAS = 0, & !add for new gases: =0, no new gases; = 1, new gases included and takes longer computer time
& NOZONE = 1 , & ! if =0, no ozone; = 1, predescribed profiles; = 2, input from WRF
& NICE = 2 !add for cloud:
!nice=0, use old ones (FLIce93);
!nice=1, use new coefficients for ice by Feng;
!nice=2, use new coefficients by Qing Yue 2006;
!seperate tropics and midlatitute: nice = 3, tropics; nice = 4, midlat
integer, save :: itps(mxac) = 0 , & !aerosol type: itps(iac)=1 stands for existing aerosol type iac
& nfraca = 1 , & ! --if nfraca=0, use aerosol types and fractions passed from the driver
! nfraca=1, use precribed total AOD, aerosol types and fractions;
! nfraca=2, input total AOD, aerosol types and fractions from screen;
! nfraca=3, input aerosol types and optical depths.
& ivd = 1 , & ! --if ivd=0, use Spinhirne Vertical tau distribution;
! ivd=1, use aer_scale_hgt;
! ivd=2, pass vertical tau from driver;
! ivd=3, inpput vertical AOD profile for each aerosol type
& ifg = 0 , & !aerosol humidity dependence
& iaform = 3 , & !iaform: 1 for CERES; 2 for CAGEX; 3 for AOT_ SPLINEFIT
& n_atau = 1 !n_atau:# Aerosol Tau / Wavelengths
logical, save :: d4s = .true. , &
& d2s = .false., &
& d4ir = .false., &
& d2ir = .true. , &
& edding, quadra, hemisp
logical, save :: pderandom = .false.
real, save :: umco2 = 345.0 , &
& umch4 = 1.6 , &
& umn2o = 0.28 , &
& umco = 0.16 , &
& umo2 = 2.0948E+05, &
& umno = 0.0005 , &
& umso2 = 0.001 , &
& umno2 = 0.001 , &
& umch3cl= 0.5E-3 , &
& umCFC11= 0.22E-3 , &
& umCFC12= 0.375E-3
!-- if ngas = 0, use old gas; if ngas = 1, add new trace gases following ZF et al. (2006)
integer, save :: no2s = 1, &
& nco2s = 1, &
& nso2s = 1, &
& nch4s = 1, &
& nnol = 1, &
& nno2l = 1, &
& nso2l = 1, &
& nch3cll = 1, &
& ncos = 1, &
& nn2os = 1, &
& nh2ocs = 1, &
& nh2os = 1, &
& no3s = 1, &
& nh2ol = 1, &
& no3l = 1, &
& nco2l = 1, &
& nn2ol = 1, &
& nch4l = 1, &
& nh2ocl = 1, &
& nrayle = 1, &
& nCFC11l = 1, &
& nCFC12l =1
end module control_para
!---------------------- begin ozone data -------------------------------
module module_ozone 1
implicit none
integer, parameter :: np = 75
integer :: i
real :: pres(np,5), ozone(np,5)
!--------------------------------------------------------------------------------
! data set 1
! mid-latitude summer (75 levels) : p(mb) o3(g/g)
! surface temp = 294.0
!
data (pres(i,1),i=1,np)/ &
0.0006244, 0.0008759, 0.0012286, 0.0017234, 0.0024174, &
0.0033909, 0.0047565, 0.0066720, 0.0093589, 0.0131278, &
0.0184145, 0.0258302, 0.0362323, 0.0508234, 0.0712906, &
0.1000000, 0.1402710, 0.1967600, 0.2759970, 0.3871430, &
0.5430, 0.7617, 1.0685, 1.4988, 2.1024, 2.9490, &
4.1366, 5.8025, 8.1392, 11.4170, 16.0147, 22.4640, &
31.5105, 44.2001, 62.0000, 85.7750, 109.5500, 133.3250, &
157.1000, 180.8750, 204.6500, 228.4250, 252.2000, 275.9750, &
299.7500, 323.5250, 347.3000, 371.0750, 394.8500, 418.6250, &
442.4000, 466.1750, 489.9500, 513.7250, 537.5000, 561.2750, &
585.0500, 608.8250, 632.6000, 656.3750, 680.1500, 703.9250, &
727.7000, 751.4750, 775.2500, 799.0250, 822.8000, 846.5750, &
870.3500, 894.1250, 917.9000, 941.6750, 965.4500, 989.2250, &
1013.0000/
!
data (ozone(i,1),i=1,np)/ &
0.1793E-06, 0.2228E-06, 0.2665E-06, 0.3104E-06, 0.3545E-06, &
0.3989E-06, 0.4435E-06, 0.4883E-06, 0.5333E-06, 0.5786E-06, &
0.6241E-06, 0.6698E-06, 0.7157E-06, 0.7622E-06, 0.8557E-06, &
0.1150E-05, 0.1462E-05, 0.1793E-05, 0.2143E-05, 0.2512E-05, &
0.2902E-05, 0.3313E-05, 0.4016E-05, 0.5193E-05, 0.6698E-05, &
0.8483E-05, 0.9378E-05, 0.9792E-05, 0.1002E-04, 0.1014E-04, &
0.9312E-05, 0.7834E-05, 0.6448E-05, 0.5159E-05, 0.3390E-05, &
0.1937E-05, 0.1205E-05, 0.8778E-06, 0.6935E-06, 0.5112E-06, &
0.3877E-06, 0.3262E-06, 0.2770E-06, 0.2266E-06, 0.2020E-06, &
0.1845E-06, 0.1679E-06, 0.1519E-06, 0.1415E-06, 0.1317E-06, &
0.1225E-06, 0.1137E-06, 0.1055E-06, 0.1001E-06, 0.9487E-07, &
0.9016E-07, 0.8641E-07, 0.8276E-07, 0.7930E-07, 0.7635E-07, &
0.7347E-07, 0.7065E-07, 0.6821E-07, 0.6593E-07, 0.6368E-07, &
0.6148E-07, 0.5998E-07, 0.5859E-07, 0.5720E-07, 0.5582E-07, &
0.5457E-07, 0.5339E-07, 0.5224E-07, 0.5110E-07, 0.4999E-07/
!--------------------------------------------------------------------------------
! data set 2
! mid-latitude winter (75 levels) : p(mb) o3(g/g)
! surface temp = 272.2
!
data (pres(i,2),i=1,np)/ &
0.0006244, 0.0008759, 0.0012286, 0.0017234, 0.0024174, &
0.0033909, 0.0047565, 0.0066720, 0.0093589, 0.0131278, &
0.0184145, 0.0258302, 0.0362323, 0.0508234, 0.0712906, &
0.1000000, 0.1402710, 0.1967600, 0.2759970, 0.3871430, &
0.5430, 0.7617, 1.0685, 1.4988, 2.1024, 2.9490, &
4.1366, 5.8025, 8.1392, 11.4170, 16.0147, 22.4640, &
31.5105, 44.2001, 62.0000, 85.9000, 109.8000, 133.7000, &
157.6000, 181.5000, 205.4000, 229.3000, 253.2000, 277.1000, &
301.0000, 324.9000, 348.8000, 372.7000, 396.6000, 420.5000, &
444.4000, 468.3000, 492.2000, 516.1000, 540.0000, 563.9000, &
587.8000, 611.7000, 635.6000, 659.5000, 683.4000, 707.3000, &
731.2000, 755.1000, 779.0000, 802.9000, 826.8000, 850.7000, &
874.6000, 898.5000, 922.4000, 946.3000, 970.2000, 994.1000, &
1018.0000/
!
data (ozone(i,2),i=1,np)/ &
0.2353E-06, 0.3054E-06, 0.3771E-06, 0.4498E-06, 0.5236E-06, &
0.5984E-06, 0.6742E-06, 0.7511E-06, 0.8290E-06, 0.9080E-06, &
0.9881E-06, 0.1069E-05, 0.1152E-05, 0.1319E-05, 0.1725E-05, &
0.2145E-05, 0.2581E-05, 0.3031E-05, 0.3497E-05, 0.3980E-05, &
0.4478E-05, 0.5300E-05, 0.6725E-05, 0.8415E-05, 0.1035E-04, &
0.1141E-04, 0.1155E-04, 0.1143E-04, 0.1093E-04, 0.1060E-04, &
0.9720E-05, 0.8849E-05, 0.7424E-05, 0.6023E-05, 0.4310E-05, &
0.2820E-05, 0.1990E-05, 0.1518E-05, 0.1206E-05, 0.9370E-06, &
0.7177E-06, 0.5450E-06, 0.4131E-06, 0.3277E-06, 0.2563E-06, &
0.2120E-06, 0.1711E-06, 0.1524E-06, 0.1344E-06, 0.1199E-06, &
0.1066E-06, 0.9516E-07, 0.8858E-07, 0.8219E-07, 0.7598E-07, &
0.6992E-07, 0.6403E-07, 0.5887E-07, 0.5712E-07, 0.5540E-07, &
0.5370E-07, 0.5214E-07, 0.5069E-07, 0.4926E-07, 0.4785E-07, &
0.4713E-07, 0.4694E-07, 0.4676E-07, 0.4658E-07, 0.4641E-07, &
0.4634E-07, 0.4627E-07, 0.4619E-07, 0.4612E-07, 0.4605E-07/
!--------------------------------------------------------------------------------
! data set 3
! sub-arctic summer (75 levels) : p(mb) o3(g/g)
! surface temp = 287.0
!
data (pres(i,3),i=1,np)/ &
0.0006244, 0.0008759, 0.0012286, 0.0017234, 0.0024174, &
0.0033909, 0.0047565, 0.0066720, 0.0093589, 0.0131278, &
0.0184145, 0.0258302, 0.0362323, 0.0508234, 0.0712906, &
0.1000000, 0.1402710, 0.1967600, 0.2759970, 0.3871430, &
0.5430, 0.7617, 1.0685, 1.4988, 2.1024, 2.9490, &
4.1366, 5.8025, 8.1392, 11.4170, 16.0147, 22.4640, &
31.5105, 44.2001, 62.0000, 85.7000, 109.4000, 133.1000, &
156.8000, 180.5000, 204.2000, 227.9000, 251.6000, 275.3000, &
299.0000, 322.7000, 346.4000, 370.1000, 393.8000, 417.5000, &
441.2000, 464.9000, 488.6000, 512.3000, 536.0000, 559.7000, &
583.4000, 607.1000, 630.8000, 654.5000, 678.2000, 701.9000, &
725.6000, 749.3000, 773.0000, 796.7000, 820.4000, 844.1000, &
867.8000, 891.5000, 915.2000, 938.9000, 962.6000, 986.3000, &
1010.0000/
!
data (ozone(i,3),i=1,np)/ &
0.1728E-06, 0.2131E-06, 0.2537E-06, 0.2944E-06, 0.3353E-06, &
0.3764E-06, 0.4176E-06, 0.4590E-06, 0.5006E-06, 0.5423E-06, &
0.5842E-06, 0.6263E-06, 0.6685E-06, 0.7112E-06, 0.7631E-06, &
0.1040E-05, 0.1340E-05, 0.1660E-05, 0.2001E-05, 0.2362E-05, &
0.2746E-05, 0.3153E-05, 0.3762E-05, 0.4988E-05, 0.6518E-05, &
0.8352E-05, 0.9328E-05, 0.9731E-05, 0.8985E-05, 0.7632E-05, &
0.6814E-05, 0.6384E-05, 0.5718E-05, 0.4728E-05, 0.4136E-05, &
0.3033E-05, 0.2000E-05, 0.1486E-05, 0.1121E-05, 0.8680E-06, &
0.6474E-06, 0.5164E-06, 0.3921E-06, 0.2996E-06, 0.2562E-06, &
0.2139E-06, 0.1723E-06, 0.1460E-06, 0.1360E-06, 0.1267E-06, &
0.1189E-06, 0.1114E-06, 0.1040E-06, 0.9678E-07, 0.8969E-07, &
0.8468E-07, 0.8025E-07, 0.7590E-07, 0.7250E-07, 0.6969E-07, &
0.6694E-07, 0.6429E-07, 0.6208E-07, 0.5991E-07, 0.5778E-07, &
0.5575E-07, 0.5403E-07, 0.5233E-07, 0.5067E-07, 0.4904E-07, &
0.4721E-07, 0.4535E-07, 0.4353E-07, 0.4173E-07, 0.3997E-07/
!--------------------------------------------------------------------------------
! data set 4
! sub-arctic winter (75 levels) : p(mb) o3(g/g)
! surface temp = 257.1
!
data (pres(i,4),i=1,np)/ &
0.0006244, 0.0008759, 0.0012286, 0.0017234, 0.0024174, &
0.0033909, 0.0047565, 0.0066720, 0.0093589, 0.0131278, &
0.0184145, 0.0258302, 0.0362323, 0.0508234, 0.0712906, &
0.1000000, 0.1402710, 0.1967600, 0.2759970, 0.3871430, &
0.5430, 0.7617, 1.0685, 1.4988, 2.1024, 2.9490, &
4.1366, 5.8025, 8.1392, 11.4170, 16.0147, 22.4640, &
31.5105, 44.2001, 62.0000, 85.7750, 109.5500, 133.3250, &
157.1000, 180.8750, 204.6500, 228.4250, 252.2000, 275.9750, &
299.7500, 323.5250, 347.3000, 371.0750, 394.8500, 418.6250, &
442.4000, 466.1750, 489.9500, 513.7250, 537.5000, 561.2750, &
585.0500, 608.8250, 632.6000, 656.3750, 680.1500, 703.9250, &
727.7000, 751.4750, 775.2500, 799.0250, 822.8000, 846.5750, &
870.3500, 894.1250, 917.9000, 941.6750, 965.4500, 989.2250, &
1013.0000/
!
data (ozone(i,4),i=1,np)/ &
0.2683E-06, 0.3562E-06, 0.4464E-06, 0.5387E-06, 0.6333E-06, &
0.7301E-06, 0.8291E-06, 0.9306E-06, 0.1034E-05, 0.1140E-05, &
0.1249E-05, 0.1360E-05, 0.1474E-05, 0.1855E-05, 0.2357E-05, &
0.2866E-05, 0.3383E-05, 0.3906E-05, 0.4437E-05, 0.4975E-05, &
0.5513E-05, 0.6815E-05, 0.8157E-05, 0.1008E-04, 0.1200E-04, &
0.1242E-04, 0.1250E-04, 0.1157E-04, 0.1010E-04, 0.9063E-05, &
0.8836E-05, 0.8632E-05, 0.8391E-05, 0.7224E-05, 0.6054E-05, &
0.4503E-05, 0.3204E-05, 0.2278E-05, 0.1833E-05, 0.1433E-05, &
0.9996E-06, 0.7440E-06, 0.5471E-06, 0.3944E-06, 0.2852E-06, &
0.1977E-06, 0.1559E-06, 0.1333E-06, 0.1126E-06, 0.9441E-07, &
0.7678E-07, 0.7054E-07, 0.6684E-07, 0.6323E-07, 0.6028E-07, &
0.5746E-07, 0.5468E-07, 0.5227E-07, 0.5006E-07, 0.4789E-07, &
0.4576E-07, 0.4402E-07, 0.4230E-07, 0.4062E-07, 0.3897E-07, &
0.3793E-07, 0.3697E-07, 0.3602E-07, 0.3506E-07, 0.3413E-07, &
0.3326E-07, 0.3239E-07, 0.3153E-07, 0.3069E-07, 0.2987E-07/
!--------------------------------------------------------------------------------
! data set 5
! tropical (75 levels) : p(mb) o3(g/g)
! surface temp = 300.0
!
data (pres(i,5),i=1,np)/ &
0.0006244, 0.0008759, 0.0012286, 0.0017234, 0.0024174, &
0.0033909, 0.0047565, 0.0066720, 0.0093589, 0.0131278, &
0.0184145, 0.0258302, 0.0362323, 0.0508234, 0.0712906, &
0.1000000, 0.1402710, 0.1967600, 0.2759970, 0.3871430, &
0.5430, 0.7617, 1.0685, 1.4988, 2.1024, 2.9490, &
4.1366, 5.8025, 8.1392, 11.4170, 16.0147, 22.4640, &
31.5105, 44.2001, 62.0000, 85.7750, 109.5500, 133.3250, &
157.1000, 180.8750, 204.6500, 228.4250, 252.2000, 275.9750, &
299.7500, 323.5250, 347.3000, 371.0750, 394.8500, 418.6250, &
442.4000, 466.1750, 489.9500, 513.7250, 537.5000, 561.2750, &
585.0500, 608.8250, 632.6000, 656.3750, 680.1500, 703.9250, &
727.7000, 751.4750, 775.2500, 799.0250, 822.8000, 846.5750, &
870.3500, 894.1250, 917.9000, 941.6750, 965.4500, 989.2250, &
1013.0000/
!
data (ozone(i,5),i=1,np)/ &
0.1993E-06, 0.2521E-06, 0.3051E-06, 0.3585E-06, 0.4121E-06, &
0.4661E-06, 0.5203E-06, 0.5748E-06, 0.6296E-06, 0.6847E-06, &
0.7402E-06, 0.7959E-06, 0.8519E-06, 0.9096E-06, 0.1125E-05, &
0.1450E-05, 0.1794E-05, 0.2156E-05, 0.2538E-05, 0.2939E-05, &
0.3362E-05, 0.3785E-05, 0.4753E-05, 0.6005E-05, 0.7804E-05, &
0.9635E-05, 0.1023E-04, 0.1067E-04, 0.1177E-04, 0.1290E-04, &
0.1134E-04, 0.9223E-05, 0.6667E-05, 0.3644E-05, 0.1545E-05, &
0.5355E-06, 0.2523E-06, 0.2062E-06, 0.1734E-06, 0.1548E-06, &
0.1360E-06, 0.1204E-06, 0.1074E-06, 0.9707E-07, 0.8960E-07, &
0.8419E-07, 0.7962E-07, 0.7542E-07, 0.7290E-07, 0.7109E-07, &
0.6940E-07, 0.6786E-07, 0.6635E-07, 0.6500E-07, 0.6370E-07, &
0.6244E-07, 0.6132E-07, 0.6022E-07, 0.5914E-07, 0.5884E-07, &
0.5855E-07, 0.5823E-07, 0.5772E-07, 0.5703E-07, 0.5635E-07, &
0.5570E-07, 0.5492E-07, 0.5412E-07, 0.5335E-07, 0.5260E-07, &
0.5167E-07, 0.5063E-07, 0.4961E-07, 0.4860E-07, 0.4761E-07/
end module module_ozone
!---------------------- begin ice block data ---------------------------
! block data ice0
module ice0 1,1
!c *********************************************************************
!c ap and bp are empirical coefficients of Eqs. (2.9) and (2.10) to
!c calculate the extiction coefficient (1/m) and single scattering
!c albedo, cps and dps are empirical coefficients of Eq. (2.13) to
!c compute the expansion coefficients of the phase function (1, 2,
!c 3, 4) in the solar bands, cpir is the empirical coefficients of
!c Eq. (2.15) to calculate the asymmetry factor in the IR bands (Fu
!c and Liou, 1992). The units of mean effective size and ice water
!c content are um and g/m*m*m, respectively, in these equations.
!c *********************************************************************
!# include "para.file"
USE PARA_FILE
! common /ic0/ ap(3,mb), bp(4,mb), cps(4,4,mbs), dps(4,mbs),&
! cpir(4,mbir)
implicit none
real, save :: ap(3,mb), bp(4,mb), cps(4,4,mbs), dps(4,mbs),&
& cpir(4,mbir)
data ap /-6.656e-3, 3.686, 0.00, &
& -6.656e-3, 3.686, 0.00, &
& -6.656e-3, 3.686, 0.00, &
& -6.656e-3, 3.686, 0.00, &
& -6.656e-3, 3.686, 0.00, &
& -6.656e-3, 3.686, 0.00, &
& -7.770e-3, 3.734, 11.85, &
& -8.088e-3, 3.717, 17.17, &
& -8.441e-3, 3.715, 19.48, &
& -9.061e-3, 3.741, 26.48, &
& -9.609e-3, 3.768, 34.11, &
& -1.153e-2, 4.109, 17.32, &
& -8.294e-3, 3.925, 1.315, &
& -1.026e-2, 4.105, 16.36, &
& -1.151e-2, 4.182, 31.13, &
& -1.704e-2, 4.830, 16.27, &
& -1.741e-2, 5.541, -58.42, &
& -7.752e-3, 4.624, -42.01 /
data bp /.10998E-05, -.26101E-07, .10896E-08, -.47387E-11, &
& .20208E-04, .96483E-05, .83009E-07, -.32217E-09, &
& .13590E-03, .73453E-03, .28281E-05, -.18272E-07, &
& -.16598E-02, .20933E-02, -.13977E-05, -.18703E-07, &
& .46180E+00, .24471E-03, -.27839E-05, .10379E-07, &
& .42362E-01, .86425E-02, -.75519E-04, .24056E-06, &
& .19960E+00, .37800E-02, -.14910E-04, .00000E+00, &
& .30140E+00, .26390E-02, -.11160E-04, .00000E+00, &
& .39080E+00, .12720E-02, -.55640E-05, .00000E+00, &
& .31050E+00, .26030E-02, -.11390E-04, .00000E+00, &
& .20370E+00, .42470E-02, -.18100E-04, .00000E+00, &
& .23070E+00, .38300E-02, -.16160E-04, .00000E+00, &
& .56310E+00, -.14340E-02, .62980E-05, .00000E+00, &
& .52070E+00, -.97780E-03, .37250E-05, .00000E+00, &
& .32540E+00, .34340E-02, -.30810E-04, .91430E-07, &
& .10280E+00, .50190E-02, -.20240E-04, .00000E+00, &
& .39640E+00, -.31550E-02, .64170E-04, -.29790E-06, &
& .80790E+00, -.70040E-02, .52090E-04, -.14250E-06 /
data cps / .22110E+01, -.10398E-02, .65199E-04, -.34498E-06, &
& .32201E+01, .94227E-03, .80947E-04, -.47428E-06, &
& .41610E+01, .74396E-03, .82690E-04, -.45251E-06, &
& .51379E+01, .51545E-02, .11881E-04, -.15556E-06, &
& .22151E+01, -.77982E-03, .63750E-04, -.34466E-06, &
& .31727E+01, .15597E-02, .82021E-04, -.49665E-06, &
& .40672E+01, .25800E-02, .71550E-04, -.43051E-06, &
& .49882E+01, .86489E-02, -.18318E-04, -.59275E-07, &
& .22376E+01, .10293E-02, .50842E-04, -.30135E-06, &
& .31549E+01, .47115E-02, .70684E-04, -.47622E-06, &
& .39917E+01, .82830E-02, .53927E-04, -.41778E-06, &
& .48496E+01, .15998E-01, -.39320E-04, -.43862E-07, &
& .23012E+01, .33854E-02, .23528E-04, -.20068E-06, &
& .31730E+01, .93439E-02, .36367E-04, -.38390E-06, &
& .39298E+01, .16424E-01, .10502E-04, -.35086E-06, &
& .47226E+01, .25872E-01, -.77542E-04, -.21999E-07, &
& .27975E+01, .29741E-02, -.32344E-04, .11636E-06, &
& .43532E+01, .11234E-01, -.12081E-03, .43435E-06, &
& .56835E+01, .24681E-01, -.26480E-03, .95314E-06, &
& .68271E+01, .42788E-01, -.45615E-03, .16368E-05, &
& .19655E+01, .20094E-01, -.17067E-03, .50806E-06, &
& .28803E+01, .36091E-01, -.28365E-03, .79656E-06, &
& .34613E+01, .58525E-01, -.46455E-03, .13444E-05, &
& .39568E+01, .81480E-01, -.64777E-03, .19022E-05 /
data dps / .12495E+00, -.43582E-03, .14092E-04, -.69565E-07,&
& .12363E+00, -.44419E-03, .14038E-04, -.68851E-07,&
& .12117E+00, -.48474E-03, .12495E-04, -.62411E-07,&
& .11581E+00, -.55031E-03, .98776E-05, -.50193E-07,&
& -.15968E-03, .10115E-04, -.12472E-06, .48667E-09,&
& .13830E+00, -.18921E-02, .12030E-04, -.31698E-07 /
data cpir / .79550, 2.524e-3, -1.022e-5, 0.000e+0,&
& .86010, 1.599e-3, -6.465e-6, 0.000e+0,&
& .89150, 1.060e-3, -4.171e-6, 0.000e+0,&
& .87650, 1.198e-3, -4.485e-6, 0.000e+0,&
& .88150, 9.858e-4, -3.116e-6, 0.000e+0,&
& .91670, 5.499e-4, -1.507e-6, 0.000e+0,&
& .90920, 9.295e-4, -3.877e-6, 0.000e+0,&
& .84540, 1.429e-3, -5.859e-6, 0.000e+0,&
& .76780, 2.571e-3, -1.041e-5, 0.000e+0,&
& .72900, 2.132e-3, -5.584e-6, 0.000e+0,&
& .70240, 4.581e-3, -3.054e-5, 6.684e-8,&
& .22920, 1.724e-2, -1.573e-4, 4.995e-7 /
! end
end module ice0
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
!C---- new coefficients for ice parameterization by Feng Zhang
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
! block data ice1
MODULE ice1 1,1
!c *********************************************************************
!c ap and bp are empirical coefficients of Eqs. (2.9) and (2.10) to
!c calculate the extiction coefficient (1/m) and single scattering
!c albedo, cps are empirical coefficients of Eq. (2.13) to
!c compute the expansion coefficients of the phase function (1, 2, &
!c 3, 4) in the solar bands, cpir is the empirical coefficients of
!c Eq. (2.15) to calculate the asymmetry factor in the IR bands (Fu
!c and Liou, 1992). The units of mean effective size and ice water
!c content are um and g/m*m*m, respectively, in these equations.
!c *********************************************************************
!# include "para.file"
USE PARA_FILE
!c changed by Z.F.
! common /ic1/ ap(3,mb), bp(4,mb), cps(4,4,mbs),&
! cpir(4,mbir)
!c changing over
implicit none
real, save :: ap(3,mb), bp(4,mb), cps(4,4,mbs),&
& cpir(4,mbir)
data ap / &
!c changed by Z.F.
& -0.67163E-03, 0.33056E+01,0.0,&
& 0.25307E-03, 0.32490E+01,0.0,&
& -0.75524E-03, 0.33083E+01,0.0,&
& -0.20332E-02, 0.33865E+01,0.0,&
& 0.40939E-02, 0.29870E+01,0.0,&
& -0.27583E-02, 0.34436E+01,0.0,&
!c changing over
& -7.770e-3, 3.734, 11.85,&
& -8.088e-3, 3.717, 17.17,&
& -8.441e-3, 3.715, 19.48,&
& -9.061e-3, 3.741, 26.48,&
!c-- changed by Z.F. for the windows domain in longwave spectral.^M
& 0.160239, 0.495375, -4.38738,&
& 0.165637, -0.438836, 1.54020,&
& 0.172217, -1.49513, 10.56623,&
!c changing over
!C-- old ones
!c 1 -9.609e-3, 3.768, 34.11, &
!c 1 -1.153e-2, 4.109, 17.32, &
!c 1 -8.294e-3, 3.925, 1.315, &
!c-- over
& -1.026e-2, 4.105, 16.36,&
& -1.151e-2, 4.182, 31.13,&
& -1.704e-2, 4.830, 16.27,&
& -1.741e-2, 5.541, -58.42,&
& -7.752e-3, 4.624, -42.01 /
data bp / &
!c changed by Z.F.
& -0.14661E-06, 0.79495E-07,-0.10422E-09, 0.40232E-12,&
& -0.15417E-05, 0.11489E-04,-0.77147E-08, 0.22160E-10,&
& -0.13287E-02, 0.91493E-03,-0.39410E-05, 0.12610E-07,&
& -0.21311E-02, 0.22827E-02,-0.13400E-04, 0.42169E-07,&
& 0.22764E+00, 0.21902E-02,-0.16743E-04, 0.53032E-07,&
& 0.59555E-01, 0.73777E-02,-0.66056E-04, 0.21750E-06,&
!c changing over
& .19960E+00, .37800E-02, -.14910E-04, .00000E+00,&
& .30140E+00, .26390E-02, -.11160E-04, .00000E+00,&
& .39080E+00, .12720E-02, -.55640E-05, .00000E+00,&
& .31050E+00, .26030E-02, -.11390E-04, .00000E+00,&
!c-- changed by Z.F. for the windows domain in longwave spectral.
& 0.236894, 2.10402E-03, -3.72955E-06, 0.0,&
& 0.315225, 9.38232E-04, 1.50649E-06, 0.0,&
& 0.605243, -3.92611E-03, 2.12776E-05, 0.0,&
!c-- changed over
!C-- old
!c 1 .20370E+00, .42470E-02, -.18100E-04, .00000E+00, &
!c 1 .23070E+00, .38300E-02, -.16160E-04, .00000E+00, &
!c 1 .56310E+00, -.14340E-02, .62980E-05, .00000E+00, &
!C-- over
& .52070E+00, -.97780E-03, .37250E-05, .00000E+00,&
& .32540E+00, .34340E-02, -.30810E-04, .91430E-07,&
& .10280E+00, .50190E-02, -.20240E-04, .00000E+00,&
& .39640E+00, -.31550E-02, .64170E-04, -.29790E-06,&
& .80790E+00, -.70040E-02, .52090E-04, -.14250E-06 /
data cps / &
!c changed by Z.F.
& 0.21669E+01, 0.60980E-02,-0.51311E-04, 0.16359E-06,&
& 0.31475E+01, 0.13021E-01,-0.11601E-03, 0.39174E-06,&
& 0.39659E+01, 0.19928E-01,-0.17921E-03, 0.61170E-06,&
& 0.47800E+01, 0.27383E-01,-0.25550E-03, 0.89151E-06,&
& 0.21239E+01, 0.77499E-02,-0.67918E-04, 0.22104E-06,&
& 0.29759E+01, 0.17892E-01,-0.16332E-03, 0.55093E-06,&
& 0.36695E+01, 0.28083E-01,-0.25791E-03, 0.87487E-06,&
& 0.43547E+01, 0.38785E-01,-0.36448E-03, 0.12530E-05,&
& 0.20993E+01, 0.96178E-02,-0.80757E-04, 0.26200E-06,&
& 0.28430E+01, 0.22690E-01,-0.19531E-03, 0.64687E-06,&
& 0.34225E+01, 0.36169E-01,-0.31196E-03, 0.10358E-05,&
& 0.39823E+01, 0.50008E-01,-0.43848E-03, 0.14699E-05,&
& 0.21425E+01, 0.11157E-01,-0.95207E-04, 0.31235E-06,&
& 0.28169E+01, 0.26990E-01,-0.22856E-03, 0.75086E-06,&
& 0.33128E+01, 0.43749E-01,-0.36819E-03, 0.12080E-05,&
& 0.37561E+01, 0.61160E-01,-0.51896E-03, 0.17125E-05,&
& 0.24200E+01, 0.10132E-01,-0.10016E-03, 0.34703E-06,&
& 0.33717E+01, 0.28367E-01,-0.27592E-03, 0.94834E-06,&
& 0.40569E+01, 0.50860E-01,-0.49069E-03, 0.16791E-05,&
& 0.45865E+01, 0.76301E-01,-0.73397E-03, 0.25063E-05,&
& 0.18487E+01, 0.21654E-01,-0.19873E-03, 0.65778E-06,&
& 0.24532E+01, 0.45341E-01,-0.40790E-03, 0.13452E-05,&
& 0.28329E+01, 0.71119E-01,-0.62733E-03, 0.20535E-05,&
& 0.31031E+01, 0.98340E-01,-0.86055E-03, 0.28151E-05/
!c changed over.
data cpir / .79550, 2.524e-3, -1.022e-5, 0.000e+0,&
& .86010, 1.599e-3, -6.465e-6, 0.000e+0,&
& .89150, 1.060e-3, -4.171e-6, 0.000e+0,&
& .87650, 1.198e-3, -4.485e-6, 0.000e+0,&
!c-- changed by Z.F. for the windows domain in longwave spectral.
& 0.884846, 7.52769E-05, 4.57733E-06, 0.0,&
& 0.901327, 2.03758E-04, 2.95010E-06, 0.0,&
& 0.873900, 1.45318E-03, -6.30462E-06, 0.0,&
!c-- changed over.
!C-- old
!c 1 .88150, 9.858e-4, -3.116e-6, 0.000e+0, &
!c 1 .91670, 5.499e-4, -1.507e-6, 0.000e+0, &
!c 1 .90920, 9.295e-4, -3.877e-6, 0.000e+0, &
!C--
& .84540, 1.429e-3, -5.859e-6, 0.000e+0,&
& .76780, 2.571e-3, -1.041e-5, 0.000e+0,&
& .72900, 2.132e-3, -5.584e-6, 0.000e+0,&
& .70240, 4.581e-3, -3.054e-5, 6.684e-8,&
& .22920, 1.724e-2, -1.573e-4, 4.995e-7 /
end module ice1
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
!C---- new coefficients for ice parameterization by Qing Yue
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
! block data ice2
module ice2 1,1
!c *********************************************************************
!c ap and bp are empirical coefficients of Eqs. (2.9) and (2.10) to
!c calculate the extiction coefficient (1/m) and single scattering
!c albedo, cps are empirical coefficients of Eq. (2.13) to
!c compute the expansion coefficients of the phase function (1, 2, &
!c 3, 4) in the solar bands, cpir is the empirical coefficients of
!c Eq. (2.15) to calculate the asymmetry factor in the IR bands (Fu
!c and Liou, 1992). The units of mean effective size and ice water
!c content are um and g/m*m*m, respectively, in these equations.
!c *********************************************************************
!# include "para.file"
USE PARA_FILE
! common /ic2/ ap(3,mb), bp(4,mb), cps(4,4,mbs), &
! cpir(4,mbir)
implicit none
real, save :: ap(3,mb), bp(4,mb), cps(4,4,mbs), &
& cpir(4,mbir)
data ap / &
!C--- solar bands
& -0.64677E-03, 0.33011E+01,0.0,&
& 0.23815E-03, 0.32478E+01,0.0,&
& -0.77298E-03, 0.33016E+01,0.0,&
& -0.19129E-02, 0.33670E+01,0.0,&
& 0.38836E-02, 0.29973E+01,0.0,&
& -0.25061E-02, 0.34079E+01,0.0,&
!c--- IR bands
& -0.72292E-02, 0.39678E+01,-0.46245E+01,&
& -0.67346E-02, 0.39617E+01,-0.79098E+01,&
& -0.47141E-02, 0.38009E+01,-0.81660E+01,&
& -0.56489E-02, 0.38568E+01,-0.10588E+02,&
& -0.33227E-02, 0.37198E+01,-0.13477E+02,&
& 0.19701E-02, 0.31871E+01,-0.14325E+02,&
& 0.37022E-02, 0.28155E+01,-0.79752E+01,&
& -0.35191E-02, 0.37224E+01,-0.83436E+01,&
& -0.34959E-02, 0.38216E+01,-0.13755E+02,&
& 0.20353E-02, 0.33879E+01,-0.18617E+02,&
& 0.16361E-01, 0.17992E+01,-0.11970E+02,&
& 0.14346E-01, 0.19940E+01,-0.10167E+02/
data bp / &
!c--- solar bands
& -0.15305E-06, 0.78389E-07,-0.93003E-10, 0.34497E-12,&
& -0.15038E-05, 0.11493E-04,-0.92019E-08, 0.29366E-10,&
& -0.10781E-02, 0.90739E-03,-0.41236E-05, 0.14202E-07,&
& -0.10333E-02, 0.22434E-02,-0.13639E-04, 0.45620E-07,&
& 0.22894E+00, 0.21857E-02,-0.17349E-04, 0.57582E-07,&
& 0.68828E-01, 0.69573E-02,-0.62363E-04, 0.20979E-06,&
!c--- IR bands
& 0.59839E-01, 0.75571E-02,-0.68839E-04, 0.23079E-06,&
& 0.13450E+00, 0.72025E-02,-0.68179E-04, 0.22822E-06,&
& 0.28174E+00, 0.42956E-02,-0.40260E-04, 0.12953E-06,&
& 0.24245E+00, 0.48477E-02,-0.43431E-04, 0.13681E-06,&
& 0.21341E+00, 0.46168E-02,-0.37410E-04, 0.11202E-06,&
& 0.32426E+00, 0.11704E-02, 0.24626E-05,-0.33332E-07,&
& 0.70501E+00,-0.66540E-02, 0.71716E-04,-0.25446E-06,&
& 0.55066E+00,-0.23799E-02, 0.23737E-04,-0.81566E-07,&
& 0.35188E+00, 0.18514E-02,-0.12929E-04, 0.30513E-07,&
& 0.21492E+00, 0.14011E-02, 0.29171E-05,-0.30313E-07,&
& 0.42357E+00,-0.49128E-02, 0.70966E-04,-0.27077E-06,&
& 0.87266E+00,-0.11806E-01, 0.12572E-03,-0.44277E-06/
data cps /&
!c-- solar bands
& 0.21950E+01, 0.64077E-02,-0.58201E-04, 0.19809E-06,&
& 0.31750E+01, 0.13464E-01,-0.12124E-03, 0.41560E-06,&
& 0.40066E+01, 0.20698E-01,-0.18702E-03, 0.64513E-06,&
& 0.48109E+01, 0.28022E-01,-0.25505E-03, 0.88452E-06,&
& 0.21409E+01, 0.83265E-02,-0.77257E-04, 0.26333E-06,&
& 0.29819E+01, 0.19038E-01,-0.17613E-03, 0.60173E-06,&
& 0.36742E+01, 0.29982E-01,-0.27781E-03, 0.95121E-06,&
& 0.43428E+01, 0.40884E-01,-0.38049E-03, 0.13067E-05,&
& 0.21134E+01, 0.10157E-01,-0.89914E-04, 0.30549E-06,&
& 0.28446E+01, 0.23970E-01,-0.21102E-03, 0.71452E-06,&
& 0.34206E+01, 0.38277E-01,-0.33655E-03, 0.11403E-05,&
& 0.39634E+01, 0.52522E-01,-0.46311E-03, 0.15716E-05,&
& 0.21606E+01, 0.11313E-01,-0.99848E-04, 0.34042E-06,&
& 0.28358E+01, 0.27652E-01,-0.23926E-03, 0.80881E-06,&
& 0.33357E+01, 0.44943E-01,-0.38565E-03, 0.13007E-05,&
& 0.37770E+01, 0.62525E-01,-0.53623E-03, 0.18096E-05,&
& 0.24414E+01, 0.96108E-02,-0.95027E-04, 0.33279E-06,&
& 0.34245E+01, 0.27146E-01,-0.26426E-03, 0.91883E-06,&
& 0.41454E+01, 0.48851E-01,-0.47192E-03, 0.16348E-05,&
& 0.47101E+01, 0.73455E-01,-0.70741E-03, 0.24459E-05,&
& 0.18737E+01, 0.20963E-01,-0.19401E-03, 0.65811E-06,&
& 0.24880E+01, 0.44265E-01,-0.40044E-03, 0.13519E-05,&
& 0.29039E+01, 0.69461E-01,-0.61988E-03, 0.20909E-05,&
& 0.32145E+01, 0.95849E-01,-0.84973E-03, 0.28707E-05/
!c--- IR bands
data cpir /&
& 0.79895E+00, 0.35846E-02,-0.31820E-04, 0.10048E-06,&
& 0.83578E+00, 0.33185E-02,-0.33102E-04, 0.11457E-06,&
& 0.84854E+00, 0.33870E-02,-0.34599E-04, 0.11851E-06,&
& 0.83022E+00, 0.35984E-02,-0.36656E-04, 0.12776E-06,&
& 0.82852E+00, 0.33183E-02,-0.31509E-04, 0.10367E-06,&
& 0.84345E+00, 0.35875E-02,-0.37050E-04, 0.12789E-06,&
& 0.79099E+00, 0.56487E-02,-0.64916E-04, 0.23789E-06,&
& 0.73544E+00, 0.60058E-02,-0.64662E-04, 0.22728E-06,&
& 0.68437E+00, 0.71137E-02,-0.73409E-04, 0.25328E-06,&
& 0.64675E+00, 0.70088E-02,-0.67836E-04, 0.22898E-06,&
& 0.60556E+00, 0.10268E-01,-0.11526E-03, 0.42515E-06,&
& 0.34014E+00, 0.18152E-01,-0.20230E-03, 0.72649E-06/
end module ice2
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
!C---- new coefficients for ice parameterization for tropics
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
! block data ice3
module ice3 1,1
!c *********************************************************************
!c ap and bp are empirical coefficients of Eqs. (2.9) and (2.10) to
!c calculate the extiction coefficient (1/m) and single scattering
!c albedo, cps are empirical coefficients of Eq. (2.13) to
!c compute the expansion coefficients of the phase function (1, 2, &
!c 3, 4) in the solar bands, cpir is the empirical coefficients of
!c Eq. (2.15) to calculate the asymmetry factor in the IR bands (Fu
!c and Liou, 1992). The units of mean effective size and ice water
!c content are um and g/m*m*m, respectively, in these equations.
!c *********************************************************************
!# include "para.file"
USE PARA_FILE
! common /ic3/ ap(3,mb), bp(4,mb), cps(4,4,mbs),&
! cpir(4,mbir)
implicit none
real, save :: ap(3,mb), bp(4,mb), cps(4,4,mbs),&
& cpir(4,mbir)
data ap / &
!C--- solar bands
& -0.22016E-04, 0.32681E+01,0.0,&
& 0.12188E-03, 0.32550E+01,0.0,&
& -0.18585E-03, 0.32718E+01,0.0,&
& 0.73530E-03, 0.32308E+01,0.0,&
& 0.73767E-03, 0.31625E+01,0.0,&
& 0.12974E-02, 0.32103E+01,0.0,&
!c--- IR bands
& -0.12934E-02, 0.34613E+01, 0.40581E+01,&
& -0.13767E-02, 0.34660E+01, 0.15185E+01,&
& 0.33221E-02, 0.30377E+01, 0.55140E+01,&
& 0.29569E-02, 0.31035E+01, 0.34176E+01,&
& -0.20300E-03, 0.35017E+01,-0.68412E+01,&
& 0.44879E-02, 0.31449E+01,-0.94957E+01,&
& 0.39821E-03, 0.29640E+01,-0.63663E+01,&
& 0.29569E-02, 0.31035E+01, 0.34176E+01,&
& 0.56276E-02, 0.30863E+01, 0.99194E+00,&
& 0.67180E-02, 0.31267E+01,-0.99073E+01,&
& 0.16936E-02, 0.28752E+01,-0.23543E+02,&
& 0.54571E-02, 0.27078E+01,-0.17463E+02/
data bp / &
!c--- solar bands
& 0.16316E-06, 0.54817E-07, 0.36986E-09,-0.22368E-11,&
& -0.85219E-06, 0.11496E-04,-0.88702E-08, 0.21682E-10,&
& -0.34149E-03, 0.87766E-03,-0.33187E-05, 0.68249E-08,&
& 0.26483E-02, 0.21342E-02,-0.11387E-04, 0.25795E-07,&
& 0.22760E+00, 0.24953E-02,-0.23548E-04, 0.85937E-07,&
& 0.10340E+00, 0.59974E-02,-0.51220E-04, 0.14912E-06,&
!c--- IR bands
& 0.55175E-01, 0.89243E-02,-0.86399E-04, 0.28587E-06,&
& 0.13600E+00, 0.82607E-02,-0.84916E-04, 0.29040E-06,&
& 0.28989E+00, 0.47980E-02,-0.50181E-04, 0.17083E-06,&
& 0.25460E+00, 0.47274E-02,-0.40477E-04, 0.11072E-06,&
& 0.18254E+00, 0.72527E-02,-0.77454E-04, 0.27677E-06,&
& 0.25897E+00, 0.50864E-02,-0.55346E-04, 0.20977E-06,&
& 0.66416E+00,-0.54835E-02, 0.62850E-04,-0.23567E-06,&
& 0.51584E+00,-0.48797E-03,-0.17487E-05, 0.21836E-07,&
& 0.30470E+00, 0.50329E-02,-0.59993E-04, 0.23202E-06,&
& 0.14576E+00, 0.51099E-02,-0.46454E-04, 0.16438E-06,&
& 0.31106E+00, 0.76981E-04, 0.13539E-04,-0.67635E-07,&
& 0.82940E+00,-0.10849E-01, 0.12883E-03,-0.49980E-06/
data cps / &
!c-- solar bands
& 0.22527E+01, 0.41826E-02,-0.27863E-04, 0.51918E-07,&
& 0.33013E+01, 0.84364E-02,-0.50901E-04, 0.73560E-07,&
& 0.42027E+01, 0.12899E-01,-0.78291E-04, 0.12000E-06,&
& 0.50756E+01, 0.17483E-01,-0.10792E-03, 0.17462E-06,&
& 0.21646E+01, 0.84005E-02,-0.87726E-04, 0.32575E-06,&
& 0.30331E+01, 0.19327E-01,-0.20159E-03, 0.75104E-06,&
& 0.37486E+01, 0.30803E-01,-0.32426E-03, 0.12203E-05,&
& 0.44480E+01, 0.41734E-01,-0.43891E-03, 0.16490E-05,&
& 0.21446E+01, 0.95320E-02,-0.84259E-04, 0.26274E-06,&
& 0.29123E+01, 0.22681E-01,-0.19885E-03, 0.61148E-06,&
& 0.35209E+01, 0.36583E-01,-0.32255E-03, 0.10010E-05,&
& 0.41047E+01, 0.49951E-01,-0.43946E-03, 0.13583E-05,&
& 0.22211E+01, 0.93276E-02,-0.73117E-04, 0.19007E-06,&
& 0.29628E+01, 0.23702E-01,-0.18567E-03, 0.48482E-06,&
& 0.35287E+01, 0.39121E-01,-0.30633E-03, 0.80293E-06,&
& 0.40513E+01, 0.54047E-01,-0.41858E-03, 0.10766E-05,&
& 0.25291E+01, 0.64430E-02,-0.55084E-04, 0.15403E-06,&
& 0.36475E+01, 0.19350E-01,-0.16755E-03, 0.47994E-06,&
& 0.45208E+01, 0.36084E-01,-0.31598E-03, 0.92179E-06,&
& 0.52466E+01, 0.55654E-01,-0.49374E-03, 0.14669E-05,&
& 0.20079E+01, 0.16692E-01,-0.13662E-03, 0.33622E-06,&
& 0.27495E+01, 0.35998E-01,-0.28704E-03, 0.68874E-06,&
& 0.33031E+01, 0.56774E-01,-0.44330E-03, 0.10408E-05,&
& 0.37818E+01, 0.77181E-01,-0.58492E-03, 0.13077E-05/
!c--- IR bands
data cpir / &
& 0.78501E+00, 0.36642E-02,-0.32975E-04, 0.10320E-06, &
& 0.84318E+00, 0.32789E-02,-0.35798E-04, 0.13097E-06,&
& 0.85345E+00, 0.35780E-02,-0.39064E-04, 0.13795E-06,&
& 0.84642E+00, 0.29944E-02,-0.29113E-04, 0.94027E-07,&
& 0.84123E+00, 0.32419E-02,-0.34203E-04, 0.12155E-06,&
& 0.88427E+00, 0.20139E-02,-0.16185E-04, 0.39207E-07,&
& 0.84345E+00, 0.35780E-02,-0.39064E-04, 0.13795E-06,&
& 0.76728E+00, 0.54533E-02,-0.64807E-04, 0.24744E-06,&
& 0.73460E+00, 0.47274E-02,-0.40477E-04, 0.11072E-06,&
& 0.71306E+00, 0.37901E-02,-0.31358E-04, 0.98649E-07,&
& 0.68108E+00, 0.68342E-02,-0.77162E-04, 0.29712E-06,&
& 0.36188E+00, 0.18668E-01,-0.23332E-03, 0.93219E-06/
end module ice3
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
!C---- new coefficients for ice parameterization for midlatitude
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
! block data ice4
module ice4 1,1
!c *********************************************************************
!c ap and bp are empirical coefficients of Eqs. (2.9) and (2.10) to
!c calculate the extiction coefficient (1/m) and single scattering
!c albedo, cps are empirical coefficients of Eq. (2.13) to
!c compute the expansion coefficients of the phase function (1, 2, &
!c 3, 4) in the solar bands, cpir is the empirical coefficients of
!c Eq. (2.15) to calculate the asymmetry factor in the IR bands (Fu
!c and Liou, 1992). The units of mean effective size and ice water
!c content are um and g/m*m*m, respectively, in these equations.
!c *********************************************************************
!# include "para.file"
USE PARA_FILE
! common /ic4/ ap(3,mb), bp(4,mb), cps(4,4,mbs), &
! cpir(4,mbir)
implicit none
real, save :: ap(3,mb), bp(4,mb), cps(4,4,mbs), &
& cpir(4,mbir)
data ap / &
!C--- solar bands
& -6.94267E-04, 3.31172, 0.0, &
& 2.42688E-04, 3.24538, 0.0,&
& -8.22686E-04, 3.31108, 0.0,&
& -2.12999E-03, 3.41040, 0.0,&
& 4.12799E-03, 2.94434, 0.0,&
& -2.81017E-03, 3.47101, 0.0,&
!c--- IR bands
& -0.54779E-02, 0.38141E+01,-0.35115E+01,&
& -0.36198E-02, 0.37028E+01,-0.60244E+01,&
& -0.12878E-02, 0.35247E+01,-0.61794E+01,&
& -0.13401E-02, 0.34879E+01,-0.78947E+01,&
& 0.21520E-02, 0.32356E+01,-0.98746E+01,&
& 0.90323E-02, 0.25316E+01,-0.94046E+01,&
& 0.95264E-02, 0.23578E+01,-0.45991E+01,&
& 0.31740E-03, 0.34090E+01,-0.60680E+01,&
& 0.25572E-02, 0.32852E+01,-0.97985E+01,&
& 0.99831E-02, 0.26650E+01,-0.13217E+02,&
& 0.23221E-01, 0.12725E+01,-0.80370E+01,&
& 0.19658E-01, 0.15584E+01,-0.68965E+01/
data bp / &
!c--- solar bands
& -1.90654E-07, 7.99431E-08, -1.11983E-10, 4.15792E-13,&
& -1.80331E-06, 1.14576E-05, -8.31389E-09, 2.49253E-11,&
& -1.26043E-03, 8.91064E-04, -3.69938E-06, 1.20770E-08,&
& -2.89280E-03, 2.22542E-03, -1.25859E-05, 3.96889E-08,&
& 0.227105 , 2.15505E-03, -1.60964E-05, 5.08333E-08,&
& 4.57593E-02, 7.37355E-03, -6.32047E-05, 2.02681E-07,&
!c--- IR bands
& 0.54473E-01, 0.71064E-02,-0.60728E-04, 0.19806E-06,&
& 0.12661E+00, 0.69131E-02,-0.61519E-04, 0.19884E-06,&
& 0.27278E+00, 0.41893E-02,-0.36266E-04, 0.10986E-06,&
& 0.23686E+00, 0.47057E-02,-0.39838E-04, 0.12117E-06,&
& 0.21461E+00, 0.41148E-02,-0.29280E-04, 0.79693E-07,&
& 0.33820E+00, 0.50237E-03, 0.10415E-04,-0.60484E-07,&
& 0.72475E+00,-0.70319E-02, 0.72574E-04,-0.24826E-06,&
& 0.55964E+00,-0.27349E-02, 0.27096E-04,-0.90958E-07,&
& 0.35859E+00, 0.13519E-02,-0.65991E-05, 0.77184E-08,&
& 0.23389E+00, 0.64041E-03, 0.10444E-04,-0.51927E-07,&
& 0.46362E+00,-0.61419E-02, 0.80126E-04,-0.28778E-06,&
& 0.89760E+00,-0.12410E-01, 0.12780E-03,-0.43608E-06/
data cps / &
!c-- solar bands
& 2.16219, 7.20717E-03, -6.34955E-05, 2.06684E-07,&
& 3.10521, 1.51838E-02, -1.32897E-04, 4.35736E-07,&
& 3.89785, 2.33975E-02, -2.05648E-04, 6.78808E-07,&
& 4.66416, 3.16646E-02, -2.80302E-04, 9.30739E-07,&
& 2.11638, 8.73893E-03, -7.75891E-05, 2.53203E-07,&
& 2.92743, 1.99400E-02, -1.76613E-04, 5.78123E-07,&
& 3.59051, 3.13439E-02, -2.78084E-04, 9.12872E-07,&
& 4.22785, 4.27741E-02, -3.81332E-04, 1.25635E-06,&
& 2.09066, 1.04640E-02, -8.85004E-05, 2.87737E-07,&
& 2.79526, 2.45527E-02, -2.06207E-04, 6.67845E-07,&
& 3.34547, 3.90920E-02, -3.27779E-04, 1.06251E-06,&
& 3.85962, 5.36759E-02, -4.51564E-04, 1.46690E-06,&
& 2.12392, 1.19818E-02, -1.01064E-04, 3.27937E-07,&
& 2.75806, 2.89005E-02, -2.38183E-04, 7.64875E-07,&
& 3.21670, 4.67146E-02, -3.81077E-04, 1.21969E-06,&
& 3.60999, 6.50332E-02, -5.30308E-04, 1.69843E-06,&
& 2.38854, 1.09261E-02, -1.04240E-04, 3.50074E-07,&
& 3.28763, 3.04339E-02, -2.85683E-04, 9.52203E-07,&
& 3.91175, 5.43371E-02, -5.05866E-04, 1.67954E-06,&
& 4.37193, 8.12484E-02, -7.53536E-04, 2.49656E-06,&
& 1.79111, 2.24369E-02, -1.96602E-04, 6.30520E-07,&
& 2.32802, 4.69355E-02, -4.01338E-04, 1.27852E-06,&
& 2.66199, 7.33749E-02, -6.18366E-04, 1.96580E-06,&
& 2.87716, 1.01409E-01, -8.49488E-04, 2.70447E-06/
!c--- IR bands
data cpir / &
& 0.80828E+00, 0.35457E-02,-0.32593E-04, 0.10616E-06,&
& 0.83099E+00, 0.33684E-02,-0.32271E-04, 0.10833E-06,&
& 0.84393E+00, 0.33526E-02,-0.32787E-04, 0.10919E-06,&
& 0.82449E+00, 0.36684E-02,-0.36170E-04, 0.12336E-06,&
& 0.82025E+00, 0.33894E-02,-0.30349E-04, 0.94896E-07,&
& 0.82851E+00, 0.38298E-02,-0.37428E-04, 0.12370E-06,&
& 0.77099E+00, 0.60819E-02,-0.67227E-04, 0.23893E-06,&
& 0.71680E+00, 0.62920E-02,-0.64410E-04, 0.21714E-06,&
& 0.66987E+00, 0.74566E-02,-0.75205E-04, 0.25469E-06,&
& 0.62566E+00, 0.77781E-02,-0.73834E-04, 0.24131E-06,&
& 0.57878E+00, 0.11177E-01,-0.12254E-03, 0.44038E-06,&
& 0.31494E+00, 0.18856E-01,-0.20582E-03, 0.72328E-06/
end module ice4
!**************************************
!c Fu 07-08-98
! block data ice5
module ice5 1,1
!c *********************************************************************
!c Following Fu (1996; J. Climate) and Fu et al. (1998; J. Climate), &
!c ap is the empirical coefficients of Eq. (3.9a) of Fu (1996) and
!c Eq. (3.1) of Fu et al. (1998) to calculate the extiction coefficient
!c (1/m). bps is for the single scattering albedo in the solar bands
!c (3.9b in Fu) and bpir is for the absorption coefficient (1/m) in the
!c IR bands (3.2 in Fu et al.). cp is the empirical coefficients of
!c Eq. (3.9c) in Fu or Eq. (3.3) in Fu et al. to compute the asymmetry
!c factor of the phase function. dps is the empirical coefficients of
!c Eq. (3.9d) of Fu to calculate the forward delta-fraction in the
!c solar bands. The units of generalized effective size and ice water
!c content are um and g/m**3, respectively, in these equations.
!c *********************************************************************
!# include "para.file"
USE PARA_FILE
!c## include 'rad_0698.h'
! common /ic5/ ap(3,mb), bps(4,mbs), bpir(4, mbir), &
! cp(4,mb), dps(4,mbs)
implicit none
real, save :: ap(3,mb), bps(4,mbs), bpir(4, mbir), &
& cp(4,mb), dps(4,mbs)
data ap / &
& -2.9172062e-05, 2.5192544e+00, 0.0,&
& -2.2948980e-05, 2.5212550e+00, 0.0,&
& -2.9772840e-04, 2.5400320e+00, 0.0,&
& 4.2668223e-04, 2.4933372e+00, 0.0,&
& 4.3226531e-04, 2.4642946e+00, 0.0,&
& 9.5918990e-05, 2.5232218e+00, 0.0,&
& -2.308881e-03, 2.814002e+00, 1.072211e+00,&
& -2.465236e-03, 2.833187e+00,-4.227573e-01,&
& -3.034573e-03, 2.900043e+00,-1.849911e+00,&
& -4.936610e-03, 3.087764e+00,-3.884262e+00,&
& -8.178608e-03, 3.401245e+00,-8.812820e+00,&
& -8.372696e-03, 3.455018e+00,-1.516692e+01,&
& -1.691632e-03, 2.765756e+00,-8.331033e+00,&
& -4.159424e-03, 3.047325e+00,-5.061568e+00,&
& -9.524174e-03, 3.587742e+00,-1.068895e+01,&
& -1.334860e-02, 4.043808e+00,-2.171029e+01,&
& 3.325756e-03, 2.601360e+00,-1.909602e+01,&
& 4.919685e-03, 2.327741e+00,-1.390858e+01 /
data bps / &
& 1.3540265e-07, 9.9282217e-08, -7.3843168e-11, 3.3111862e-13,&
& -2.1458450e-06, 2.1984010e-05, -4.4225520e-09, 1.0711940e-11,&
& 1.4027890e-04, 1.3919010e-03, -5.1005610e-06, 1.4032930e-08,&
& 5.7801650e-03, 2.4420420e-03, -1.1985030e-05, 3.3878720e-08,&
& 2.7122737e-01, 1.9809794e-03, -1.5071269e-05, 5.0103900e-08,&
& 1.6215025e-01, 6.3734393e-03, -5.7740959e-05, 1.9109300e-07 /
data bpir / &
& 4.346482e-01, 1.721457e-02,-1.623227e-04, 5.561523e-07,&
& 7.428957e-01, 1.279601e-02,-1.391803e-04, 5.180104e-07,&
& 8.862434e-01, 1.226538e-02,-1.523076e-04, 6.000892e-07,&
& 7.152274e-01, 1.621734e-02,-1.868544e-04, 7.078738e-07,&
& 5.874323e-01, 1.876628e-02,-2.045834e-04, 7.510080e-07,&
& 5.409536e-01, 1.949649e-02,-2.050908e-04, 7.364680e-07,&
& 1.195515e+00, 3.350616e-03,-5.266996e-05, 2.233377e-07,&
& 1.466481e+00,-2.129226e-03,-1.361630e-05, 1.193649e-07,&
& 9.551440e-01, 1.309792e-02,-1.793694e-04, 7.313392e-07,&
& 3.003701e-01, 2.051529e-02,-1.931684e-04, 6.583031e-07,&
& 2.005578e-01, 2.132614e-02,-1.751052e-04, 5.355885e-07,&
& 8.869787e-01, 2.118409e-02,-2.781429e-04, 1.094562e-06 /
data cp / &
& 7.4812728e-01, 9.5684492e-04, -1.1151708e-06, -8.1557303e-09,&
& 7.5212480e-01, 1.1045100e-03, -2.9157100e-06, -1.3429900e-09,&
& 7.5320460e-01, 1.8845180e-03, -9.7571460e-06, 2.2428270e-08,&
& 7.7381780e-01, 2.2260760e-03, -1.4052790e-05, 3.7896870e-08,&
& 8.7020490e-01, 1.6645530e-03, -1.4886030e-05, 4.9867270e-08,&
& 7.4212060e-01, 5.2621900e-03, -5.0877550e-05, 1.7307870e-07,&
& 7.962716e-01, 3.003488e-03,-2.082376e-05, 5.366545e-08,&
& 8.472918e-01, 2.559953e-03,-2.182660e-05, 6.879977e-08,&
& 8.741665e-01, 2.455409e-03,-2.456935e-05, 8.641223e-08,&
& 8.522816e-01, 2.523627e-03,-2.149196e-05, 6.685067e-08,&
& 8.609604e-01, 2.200445e-03,-1.748105e-05, 5.176616e-08,&
& 8.906280e-01, 1.903269e-03,-1.733552e-05, 5.855071e-08,&
& 8.663385e-01, 2.797934e-03,-3.187011e-05, 1.217209e-07,&
& 7.984021e-01, 3.977117e-03,-4.471984e-05, 1.694919e-07,&
& 7.363466e-01, 4.798266e-03,-4.513292e-05, 1.525774e-07,&
& 7.260484e-01, 2.664334e-03,-1.251136e-05, 2.243377e-08,&
& 6.891414e-01, 6.192281e-03,-6.459514e-05, 2.436963e-07,&
& 4.949276e-01, 1.186174e-02,-1.267629e-04, 4.603574e-07 /
data dps / &
& 1.1572963e-01, 2.5648064e-04, 1.9131293e-06, -1.2460341e-08,&
& 1.1360752e-01, 2.4156171e-04, 2.0185942e-06, -1.2876106e-08,&
& 1.1241170e-01, -1.7635186e-07, 2.1499248e-06, -1.2949304e-08,&
& 1.0855775e-01, -3.2496217e-04, 3.4207304e-06, -1.6247759e-08,&
& 5.7783360e-02, -4.1158260e-04, 4.2361240e-06, -1.7204950e-08,&
& 1.1367129e-01, -1.9711061e-03, 1.6078010e-05, -5.1736898e-08 /
!c *********************************************************************
end module ice5
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
!C---- new coefficients for single ice habit parameterization by Feng Zhang
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
! block data ice6
module ice6 1,1
!c *********************************************************************
!c ap and bp are empirical coefficients of Eqs. (2.9) and (2.10) to
!c calculate the extiction coefficient (1/m) and single scattering
!c albedo, cps and dps are empirical coefficients of Eq. (2.13) to
!c compute the expansion coefficients of the phase function (1, 2, &
!c 3, 4) in the solar bands, cpir is the empirical coefficients of
!c Eq. (2.15) to calculate the asymmetry factor in the IR bands (Fu
!c and Liou, 1992). The units of mean effective size and ice water
!c content are um and g/m*m*m, respectively, in these equations.
!c for a single habit calculated from Yang's 2000 datasets.
!c *********************************************************************
!# include "para.file"
USE PARA_FILE
! common /ic6/ ap(3,mb), bp(4,mb), cps(4,4,mbs), dps(4,mbs),&
! cpir(4,mbir)
implicit none
real, save :: ap(3,mb), bp(4,mb), cps(4,4,mbs), dps(4,mbs),&
& cpir(4,mbir)
data ap / &
& -0.38746E-03, 0.32973E+01,0.0,&
& -0.50694E-03, 0.32985E+01,0.0,&
& 0.71712E-03, 0.32223E+01,0.0,&
& -0.98125E-03, 0.33230E+01,0.0,&
& 0.87834E-03, 0.31841E+01,0.0,&
& -0.34512E-03, 0.32746E+01,0.0,&
& -7.770e-3, 3.734, 11.85,&
& -8.088e-3, 3.717, 17.17,&
& -8.441e-3, 3.715, 19.48,&
& -9.061e-3, 3.741, 26.48,&
& -9.609e-3, 3.768, 34.11,&
& -1.153e-2, 4.109, 17.32,&
& -8.294e-3, 3.925, 1.315,&
& -1.026e-2, 4.105, 16.36,&
& -1.151e-2, 4.182, 31.13,&
& -1.704e-2, 4.830, 16.27,&
& -1.741e-2, 5.541, -58.42,&
& -7.752e-3, 4.624, -42.01 /
data bp / &
& 0.38590E-07, 0.72370E-07, 0.31022E-10,-0.14691E-12,&
& 0.17300E-05, 0.11233E-04, 0.17393E-08,-0.12202E-10,&
& 0.18169E-02, 0.72681E-03,-0.26276E-06,-0.27928E-08,&
& 0.78700E-02, 0.17288E-02,-0.28655E-05,-0.20102E-08,&
& 0.23621E+00, 0.16462E-02,-0.78390E-05, 0.16004E-07,&
& 0.11644E+00, 0.52256E-02,-0.31336E-04, 0.69178E-07,&
& .19960E+00, .37800E-02, -.14910E-04, .00000E+00,&
& .30140E+00, .26390E-02, -.11160E-04, .00000E+00,&
& .39080E+00, .12720E-02, -.55640E-05, .00000E+00,&
& .31050E+00, .26030E-02, -.11390E-04, .00000E+00,&
& .20370E+00, .42470E-02, -.18100E-04, .00000E+00,&
& .23070E+00, .38300E-02, -.16160E-04, .00000E+00,&
& .56310E+00, -.14340E-02, .62980E-05, .00000E+00,&
& .52070E+00, -.97780E-03, .37250E-05, .00000E+00,&
& .32540E+00, .34340E-02, -.30810E-04, .91430E-07,&
& .10280E+00, .50190E-02, -.20240E-04, .00000E+00,&
& .39640E+00, -.31550E-02, .64170E-04, -.29790E-06,&
& .80790E+00, -.70040E-02, .52090E-04, -.14250E-06 /
data cps / &
& 0.21659E+01, 0.22216E-02,-0.59640E-05, 0.16482E-07,&
& 0.31725E+01, 0.52862E-02,-0.23595E-04, 0.68774E-07,&
& 0.39577E+01, 0.91975E-02,-0.59064E-04, 0.18597E-06,&
& 0.48731E+01, 0.13409E-01,-0.10001E-03, 0.29756E-06,&
& 0.21148E+01, 0.35792E-02,-0.14387E-04, 0.33916E-07,&
& 0.29802E+01, 0.86827E-02,-0.43013E-04, 0.10745E-06,&
& 0.36496E+01, 0.14548E-01,-0.88220E-04, 0.24029E-06,&
& 0.44246E+01, 0.21138E-01,-0.14383E-03, 0.38506E-06,&
& 0.21080E+01, 0.45474E-02,-0.12614E-04, 0.13394E-07,&
& 0.28827E+01, 0.10920E-01,-0.38268E-04, 0.62198E-07,&
& 0.34763E+01, 0.18024E-01,-0.76309E-04, 0.15170E-06,&
& 0.41410E+01, 0.26250E-01,-0.13345E-03, 0.29134E-06,&
& 0.21644E+01, 0.60657E-02,-0.23328E-04, 0.37156E-07,&
& 0.28683E+01, 0.14231E-01,-0.52725E-04, 0.81739E-07,&
& 0.34205E+01, 0.22708E-01,-0.86359E-04, 0.13936E-06,&
& 0.39875E+01, 0.32511E-01,-0.14175E-03, 0.26516E-06,&
& 0.24762E+01, 0.57563E-02,-0.37849E-04, 0.95587E-07,&
& 0.34989E+01, 0.16372E-01,-0.10394E-03, 0.25605E-06,&
& 0.42810E+01, 0.29538E-01,-0.18603E-03, 0.45460E-06,&
& 0.49398E+01, 0.44821E-01,-0.28585E-03, 0.70220E-06,&
& 0.19379E+01, 0.14271E-01,-0.83150E-04, 0.17824E-06,&
& 0.26709E+01, 0.29022E-01,-0.15863E-03, 0.32130E-06,&
& 0.31501E+01, 0.45697E-01,-0.23729E-03, 0.45482E-06,&
& 0.35520E+01, 0.63575E-01,-0.32729E-03, 0.62582E-06/
data cpir / .79550, 2.524e-3, -1.022e-5, 0.000e+0,&
& .86010, 1.599e-3, -6.465e-6, 0.000e+0,&
& .89150, 1.060e-3, -4.171e-6, 0.000e+0,&
& .87650, 1.198e-3, -4.485e-6, 0.000e+0,&
& .88150, 9.858e-4, -3.116e-6, 0.000e+0,&
& .91670, 5.499e-4, -1.507e-6, 0.000e+0,&
& .90920, 9.295e-4, -3.877e-6, 0.000e+0,&
& .84540, 1.429e-3, -5.859e-6, 0.000e+0,&
& .76780, 2.571e-3, -1.041e-5, 0.000e+0,&
& .72900, 2.132e-3, -5.584e-6, 0.000e+0,&
& .70240, 4.581e-3, -3.054e-5, 6.684e-8,&
& .22920, 1.724e-2, -1.573e-4, 4.995e-7 /
end module ice6
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
!C---- new coefficients for single habit ice parameterization
!C-----by Qing Yue, 2007. Solar from Yang 2000, IR from Yang 2005
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
! block data ice7
module ice7 1,1
!# include "para.file"
USE PARA_FILE
! common /ic7/ ap(3,mb), bp(4,mb), cps(4,4,mbs), &
! cpir(4,mbir)
implicit none
real, save :: ap(3,mb), bp(4,mb), cps(4,4,mbs), &
& cpir(4,mbir)
data ap / &
!C--- solar bands
& -0.38746E-03, 0.32973E+01,0.0,&
& -0.50694E-03, 0.32985E+01,0.0,&
& 0.71712E-03, 0.32223E+01,0.0,&
& -0.98125E-03, 0.33230E+01,0.0,&
& 0.87834E-03, 0.31841E+01,0.0,&
& -0.34512E-03, 0.32746E+01,0.0,&
!c--- IR bands
& -0.50589E-03, 0.33265E+01, 0.38436E+01,&
& -0.38765E-02, 0.37526E+01,-0.21254E+01,&
& -0.48168E-02, 0.38393E+01,-0.41956E+01,&
& -0.80184E-02, 0.42143E+01,-0.94178E+01,&
& -0.84545E-02, 0.42523E+01,-0.14044E+02,&
& -0.78583E-02, 0.43559E+01,-0.23802E+02,&
& 0.16759E-03, 0.32759E+01,-0.10914E+02,&
& -0.56504E-02, 0.40831E+01,-0.85350E+01,&
& -0.11870E-01, 0.48843E+01,-0.19757E+02,&
& -0.11976E-01, 0.49646E+01,-0.32042E+02,&
& 0.43393E-02, 0.30397E+01,-0.25740E+02,&
& 0.50587E-02, 0.29157E+01,-0.20003E+02/
data bp / &
!c--- solar bands
& 0.38590E-07, 0.72370E-07, 0.31022E-10,-0.14691E-12,&
& 0.17300E-05, 0.11233E-04, 0.17393E-08,-0.12202E-10,&
& 0.18169E-02, 0.72681E-03,-0.26276E-06,-0.27928E-08,&
& 0.78700E-02, 0.17288E-02,-0.28655E-05,-0.20102E-08,&
& 0.23621E+00, 0.16462E-02,-0.78390E-05, 0.16004E-07,&
& 0.11644E+00, 0.52256E-02,-0.31336E-04, 0.69178E-07,&
!c---IR bands
& 0.11837E+00, 0.59707E-02,-0.37381E-04, 0.82247E-07,&
& 0.18890E+00, 0.56695E-02,-0.39054E-04, 0.92022E-07,&
& 0.32556E+00, 0.35682E-02,-0.27697E-04, 0.70817E-07,&
& 0.26624E+00, 0.44710E-02,-0.32194E-04, 0.77848E-07,&
& 0.20286E+00, 0.52926E-02,-0.33796E-04, 0.73155E-07,&
& 0.26761E+00, 0.33641E-02,-0.16682E-04, 0.24691E-07,&
& 0.63681E+00,-0.32014E-02, 0.23511E-04,-0.59634E-07,&
& 0.53407E+00,-0.93014E-03, 0.46540E-05,-0.99015E-08,&
& 0.33019E+00, 0.30715E-02,-0.21409E-04, 0.47927E-07,&
& 0.15758E+00, 0.34101E-02,-0.11554E-04, 0.77336E-08,&
& 0.32540E+00,-0.24775E-03, 0.19549E-04,-0.79449E-07,&
& 0.81081E+00,-0.73585E-02, 0.60735E-04,-0.16801E-06/
data cps / &
!c-- solar bands
& 0.21659E+01, 0.22216E-02,-0.59640E-05, 0.16482E-07,&
& 0.31725E+01, 0.52862E-02,-0.23595E-04, 0.68774E-07,&
& 0.39577E+01, 0.91975E-02,-0.59064E-04, 0.18597E-06,&
& 0.48731E+01, 0.13409E-01,-0.10001E-03, 0.29756E-06,&
& 0.21148E+01, 0.35792E-02,-0.14387E-04, 0.33916E-07,&
& 0.29802E+01, 0.86827E-02,-0.43013E-04, 0.10745E-06,&
& 0.36496E+01, 0.14548E-01,-0.88220E-04, 0.24029E-06,&
& 0.44246E+01, 0.21138E-01,-0.14383E-03, 0.38506E-06,&
& 0.21080E+01, 0.45474E-02,-0.12614E-04, 0.13394E-07,&
& 0.28827E+01, 0.10920E-01,-0.38268E-04, 0.62198E-07,&
& 0.34763E+01, 0.18024E-01,-0.76309E-04, 0.15170E-06,&
& 0.41410E+01, 0.26250E-01,-0.13345E-03, 0.29134E-06,&
& 0.21644E+01, 0.60657E-02,-0.23328E-04, 0.37156E-07,&
& 0.28683E+01, 0.14231E-01,-0.52725E-04, 0.81739E-07,&
& 0.34205E+01, 0.22708E-01,-0.86359E-04, 0.13936E-06,&
& 0.39875E+01, 0.32511E-01,-0.14175E-03, 0.26516E-06,&
& 0.24762E+01, 0.57563E-02,-0.37849E-04, 0.95587E-07,&
& 0.34989E+01, 0.16372E-01,-0.10394E-03, 0.25605E-06,&
& 0.42810E+01, 0.29538E-01,-0.18603E-03, 0.45460E-06,&
& 0.49398E+01, 0.44821E-01,-0.28585E-03, 0.70220E-06,&
& 0.19379E+01, 0.14271E-01,-0.83150E-04, 0.17824E-06,&
& 0.26709E+01, 0.29022E-01,-0.15863E-03, 0.32130E-06,&
& 0.31501E+01, 0.45697E-01,-0.23729E-03, 0.45482E-06,&
& 0.35520E+01, 0.63575E-01,-0.32729E-03, 0.62582E-06/
!c--- IR bands
data cpir / &
& 0.81089E+00, 0.16243E-02,-0.31561E-05,-0.79532E-08,&
& 0.86014E+00, 0.17674E-02,-0.94067E-05, 0.17704E-07,&
& 0.86338E+00, 0.21946E-02,-0.15417E-04, 0.37614E-07,&
& 0.85780E+00, 0.17558E-02,-0.86896E-05, 0.13392E-07,&
& 0.86534E+00, 0.15068E-02,-0.65455E-05, 0.78494E-08,&
& 0.88588E+00, 0.18314E-02,-0.13509E-04, 0.34430E-07,&
& 0.83432E+00, 0.32058E-02,-0.26575E-04, 0.72447E-07,&
& 0.76777E+00, 0.37283E-02,-0.28309E-04, 0.72651E-07,&
& 0.73123E+00, 0.33814E-02,-0.19619E-04, 0.40249E-07,&
& 0.69978E+00, 0.29035E-02,-0.15833E-04, 0.35895E-07,&
& 0.65075E+00, 0.58411E-02,-0.46674E-04, 0.12976E-06,&
& 0.36707E+00, 0.12097E-01,-0.97415E-04, 0.26174E-06/
end module ice7
!CCCCCC---- end of ice block data------------------C
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
! block data water1
module water1 1,1
!c *********************************************************************
!c bz, wz and gz are the extinction coefficient(1/km), single scattering
!c albedo and asymmetry factor for the water clouds (St II, Sc I, St I, &
!c As, Ns, Sc II, Cu, and Cb) in different bands. re is the effective
!c radius and fl is the liquid water content (LWC). See Tables 4.2-4.4
!c of Fu (1991).
!c *********************************************************************
!# include "para.file"
USE PARA_FILE
! common /wat1/ re(nc), fl(nc), bz(nc,mb), wz(nc,mb), gz(nc,mb)
implicit none
real, save :: re(nc), fl(nc), bz(nc,mb), wz(nc,mb), gz(nc,mb)
data re / 4.18, 5.36, 5.89, 6.16, &
& 9.27, 9.84, 12.10, 31.23 /
data fl / 0.05, 0.14, 0.22, 0.28, &
& 0.50, 0.47, 1.00, 2.50 /
data bz / 15.11, 40.25, 59.81, 72.43,&
& 83.69, 73.99, 128.17, 120.91,&
& 15.74, 41.70, 61.52, 74.47,&
& 85.78, 75.59, 130.46, 121.84,&
& 16.38, 43.52, 64.84, 77.97,&
& 87.31, 77.36, 134.30, 124.06,&
& 17.57, 45.78, 66.44, 80.15,&
& 90.49, 79.90, 137.56, 125.92,&
& 18.19, 46.63, 69.39, 82.20,&
& 91.46, 79.99, 138.21, 126.08,&
& 21.30, 51.88, 77.77, 87.02,&
& 94.91, 83.55, 143.46, 128.45,&
& 22.44, 57.35, 84.41, 103.50,&
& 103.49, 84.17, 152.77, 132.07,&
& 18.32, 52.69, 76.67, 100.31,&
& 105.46, 92.86, 157.82, 133.03,&
& 17.27, 50.44, 74.18, 96.76,&
& 105.32, 95.25, 158.07, 134.48,&
& 13.73, 44.90, 67.70, 90.85,&
& 109.16, 105.48, 163.11, 136.21,&
& 10.30, 36.28, 57.23, 76.43,&
& 106.45, 104.90, 161.73, 136.62,&
& 7.16, 26.40, 43.51, 57.24,&
& 92.55, 90.55, 149.10, 135.13,&
& 6.39, 21.00, 33.81, 43.36,&
& 66.90, 63.58, 113.83, 125.65,&
& 10.33, 30.87, 47.63, 60.33,&
& 79.54, 73.92, 127.46, 128.21,&
& 11.86, 35.64, 54.81, 69.85,&
& 90.39, 84.16, 142.49, 135.25,&
& 10.27, 33.08, 51.81, 67.26,&
& 93.24, 88.60, 148.71, 140.42,&
& 6.72, 24.09, 39.42, 51.68,&
& 83.34, 80.72, 140.14, 143.57,&
& 3.92, 14.76, 25.32, 32.63,&
& 60.85, 58.81, 112.30, 145.62 /
data wz / .999999, .999999, .999999, .999999,&
& .999998, .999999, .999998, .999997,&
& .999753, .999700, .999667, .999646,&
& .999492, .999470, .999344, .998667,&
& .995914, .994967, .994379, .993842,&
& .991385, .990753, .988908, .974831,&
& .983761, .978981, .976568, .974700,&
& .963466, .959934, .953865, .897690,&
& .702949, .683241, .679723, .669045,&
& .642616, .632996, .629776, .588820,&
& .947343, .929619, .924806, .914557,&
& .877169, .867047, .853661, .737426,&
& .919356, .896274, .885924, .881097,&
& .812772, .781637, .775418, .637341,&
& .874717, .861122, .847850, .851677,&
& .787171, .772952, .753143, .618656,&
& .764750, .752410, .736529, .743435,&
& .671272, .659392, .639492, .549941,&
& .807536, .808700, .795994, .805489,&
& .750577, .755524, .709472, .571989,&
& .753346, .772026, .767273, .777079,&
& .751264, .760973, .712536, .568286,&
& .632722, .676332, .684631, .693552,&
& .707986, .717724, .682430, .552867,&
& .288885, .348489, .371653, .380367,&
& .454540, .465769, .475409, .493881,&
& .261827, .306283, .321340, .333051,&
& .392917, .406876, .417450, .484593,&
& .295804, .339929, .352494, .365502,&
& .416229, .430369, .435267, .491356,&
& .301214, .354746, .369346, .381906,&
& .433602, .447397, .447406, .486968,&
& .243714, .318761, .344642, .352770,&
& .427906, .438979, .445972, .477264,&
& .109012, .187230, .226849, .224976,&
& .331382, .335917, .374882, .457067 /
data gz / .838, .839, .844, .847,&
& .849, .860, .853, .859,&
& .809, .810, .819, .823,&
& .823, .849, .833, .843,&
& .774, .787, .781, .792,&
& .812, .836, .815, .833,&
& .801, .802, .793, .793,&
& .814, .829, .818, .832,&
& .877, .873, .879, .880,&
& .885, .899, .891, .908,&
& .783, .769, .777, .756,&
& .764, .776, .770, .797,&
& .818, .805, .824, .830,&
& .815, .801, .820, .845,&
& .810, .802, .826, .840,&
& .829, .853, .840, .868,&
& .774, .766, .799, .818,&
& .815, .869, .834, .869,&
& .734, .728, .767, .797,&
& .796, .871, .818, .854,&
& .693, .688, .736, .772,&
& .780, .880, .808, .846,&
& .643, .646, .698, .741,&
& .759, .882, .793, .839,&
& .564, .582, .637, .690,&
& .719, .871, .764, .819,&
& .466, .494, .546, .609,&
& .651, .823, .701, .766,&
& .375, .410, .455, .525,&
& .583, .773, .637, .710,&
& .262, .301, .334, .406,&
& .485, .695, .545, .631,&
& .144, .181, .200, .256,&
& .352, .562, .413, .517,&
& .060, .077, .088, .112,&
& .181, .310, .222, .327 /
end module water1
! block data rayle1
module rayle1 1,1
!c *********************************************************************
!c ri is the coefficient in Eq.(4.8) of Fu (1991) to compute the optical
!c depth due to Rayleigh scattering in the solar bands.
!c *********************************************************************
!# include "para.file"
USE PARA_FILE
! common /ray1/ ri(mbs)
implicit none
real, save :: ri(mbs)
data ri / 0.9022e-5, 0.5282e-6, 0.5722e-7, &
& 0.1433e-7, 0.4526e-8, 0.1529e-8 /
end module rayle1
! block data rain1
module rain1 1,1
!c *********************************************************************
!c brn, wrnf and grn are the extinction coefficient (1/km), single
!c scattering albedo and asymmetry factor for the rain. The size
!c distribution of rain is in the form of a truncated constant-slope
!c gamma function (Manton and Cotton, 1977) where rmin = 60 um, rmax =
!c 1800 um, rc = 162 um, density of water = 1 g/cm**3, and rain water
!c content (rwc) = 0.5 g/m**3.
!c Jan. 19, 1993
!c *********************************************************************
!# include "para.file"
USE PARA_FILE
! common /rai1/ rwc, brn(mb), wrnf(mb), grn(mb)
implicit none
real, save :: rwc, brn(mb), wrnf(mb), grn(mb)
data rwc / 0.5 /
data brn / 1.5377, 1.5377, 1.5379, 1.5385, 1.5396, 1.5417,&
& 1.5454, 1.5478, 1.5512, 1.5559, 1.5600, 1.5642,&
& 1.5647, 1.5741, 1.5862, 1.5993, 1.6149, 1.6765 /
data wrnf /.999932, .97096, .74627, .56719, .53023, .53815,&
& .53233, .52884, .53192, .52969, .52716, .52321,&
& .51904, .53859, .55169, .55488, .55334, .55218 /
data grn / .88323, .89067, .92835, .96626, .97553, .96626,&
& .97226, .97663, .97216, .97467, .97745, .98156,&
& .98584, .96374, .94218, .93266, .92990, .90729 /
end module rain1
! block data graup1
module graup1 1,1
!c *********************************************************************
!c The single-scattering properties of graupel here are replaced by
!c those of aesosols (rural model of Shettle and Fenn, 1979 with 50%
!c relative humidity). The extinction coefficients are normalized to
!c a number of density of 1.5e10 particles/m**3.
!c June 23, 1994
!c
!C For graupel
!c bg, wgf and gg are the extinction coefficient (1/km), single
!c scattering albedo and asymmetry factor for the graupel. The size
!c distribution of graupel is in the form of a truncated constant-slope
!c gamma function (Manton and Cotton, 1977) where rmin = 60 um, rmax =
!c 5000 um, rc = 500 um, density of graupel = 0.6 g/cm**3, and graupel
!c water content (gwc) = 0.5 g/m**3.
!c Jan. 19, 1993
!c *********************************************************************
!# include "para.file"
USE PARA_FILE
! common /gra1/ gwc, bg(mb), wgf(mb), gg(mb)
implicit none
real, save :: gwc, bg(mb), wgf(mb), gg(mb)
!c--- for aerosol in orig Fu-Liou
!c
! data gwc / 1.5e10 /
! data bg / 1.514e-01,6.361e-02,3.653e-02,2.024e-02,1.824e-02,&
! 1.520e-02,1.343e-02,1.196e-02,1.103e-02,9.383e-03,&
! 1.254e-02,1.658e-02,1.082e-02,8.567e-03,9.362e-03,&
! 9.319e-03,7.062e-03,6.603e-03 /
! data wgf / 0.9427,0.8653,0.7978,0.8492,0.6459,0.9137,&
! 0.8418,0.7947,0.6686,0.4676,0.2786,0.4632,&
! 0.6415,0.5105,0.4492,0.4094,0.2794,0.2137 /
! data gg / 0.6534,0.6220,0.6365,0.7277,0.7759,0.7311,&
! 0.7498,0.7685,0.7810,0.8104,0.7322,0.6162,&
! 0.6441,0.6802,0.6200,0.5404,0.5178,0.4399 /
!C
!C For graupel
data gwc / 0.5 /
data bg / 0.83939,0.83940,0.83940,0.83941,0.83946,0.83951, &
& 0.83967,0.83979,0.83995,0.84029,0.84058,0.84097, &
& 0.84143,0.84286,0.84418,0.84825,0.85421,0.87477 /
data wgf / 0.999911,0.97115,0.56192,0.53156,0.52579,0.53846, &
& 0.53296,0.53017,0.53182,0.53180,0.52959,0.52446, &
& 0.52342,0.54914,0.55258,0.54307,0.53160,0.55474 /
data gg / 0.89218,0.89940,0.96820,0.97816,0.98141,0.96373, &
& 0.97173,0.97559,0.97330,0.97327,0.97626,0.98274, &
& 0.98396,0.94673,0.94213,0.95539,0.97097,0.93183 /
end module graup1
module numericals 2
!c **********************************************************************
!c Double-Gauss quadratures and weights (Sykes, 1951).
!c **********************************************************************
! block data
! common /dis/ a(4)
! common /point/ u(4)
implicit none
real, dimension(4) :: a, u, p0d, p1d, p2d, p3d
real, dimension(4,4) :: p11d, p22d, p33d
data a / 0.5, 0.5, 0.5, 0.5 /
data u / -0.7886752, -0.2113247, 0.2113247, 0.7886752 /
! end
!c *********************************************************************
!c p0, p1, p2 and p3 are Legendre polynomials for l = 1, 2, 3.
!c *********************************************************************
!c function p0 ( x )
!c p0 = 1.0
!c return
!c end
!c function p1 ( x )
!c p1 = x
!c return
!c end
!c function p2 ( x )
!c p2 = 1.5 * x * x - 0.5
!c return
!c end
!c function p3 ( x )
!c p3 = ( 2.5 * x * x - 1.5 ) * x
!c return
!c end
!c **********************************************************************
!c p0d(4), p1d(4), p2d(4), and p3d(4) are Legendre polynomials p0(x),
!c p1(x), p2(x), and p3(x) when x = u(1), u(2), u(3), and u(4).
!c **********************************************************************
! block data legend
! common /legen/ p0d(4), p1d(4), p2d(4), p3d(4)
data p0d / .100000E+01, .100000E+01, .100000E+01, .100000E+01 /
data p1d / -.788675E+00, -.211325E+00, .211325E+00, .788675E+00 /
data p2d / .433013E+00, -.433013E+00, -.433013E+00, .433013E+00 /
data p3d / -.433940E-01, .293394E+00, -.293394E+00, .433940E-01 /
! end
!c *********************************************************************
!c p11d(4,4), p22d(4,4), and p33d(4,4) are defined as 0.5*p1d(i)*p1d(j), &
!c 0.5*p2d(i)*p2d(j), and 0.5*p3d(i)*p3d(j), respectively.
!c *********************************************************************
! block data legenf
! common /legen1/ p11d(4,4), p22d(4,4), p33d(4,4)
data p11d / .311004E+00, .833334E-01,-.833334E-01,-.311004E+00,&
& .833334E-01, .223291E-01,-.223291E-01,-.833334E-01,&
& -.833334E-01,-.223291E-01, .223291E-01, .833334E-01,&
& -.311004E+00,-.833334E-01, .833334E-01, .311004E+00 /
data p22d / .937501E-01,-.937501E-01,-.937501E-01, .937501E-01,&
& -.937501E-01, .937501E-01, .937501E-01,-.937501E-01,&
& -.937501E-01, .937501E-01, .937501E-01,-.937501E-01,&
& .937501E-01,-.937501E-01,-.937501E-01, .937501E-01 /
data p33d / .941520E-03,-.636577E-02, .636577E-02,-.941520E-03,&
& -.636577E-02, .430400E-01,-.430400E-01, .636577E-02,&
& .636577E-02,-.430400E-01, .430400E-01,-.636577E-02,&
& -.941520E-03, .636577E-02,-.636577E-02, .941520E-03 /
end module numericals
module band 1
implicit none
integer, private :: i, j, k
! block data ckd1
!c *********************************************************************
!c hk is the interval in the g (cumulative probability) space from 0 to
!c one. fko3 is the corresponding ozone absorption coefficient in units
!c of (cm-atm)**-1 (Fu, 1991). The spectral region is from 50000 cm**-1
!c to 14500 cm**-1.
!c *********************************************************************
real, save :: hk_1(10), fko3_1(10), &
& hk_2(8), coeh2o_2(3,11,8), &
& hk_3(12), coeh2o_3(3,11,12), &
& hk_4(7), coeh2o_4(3,11,7), &
& hk_5(12), coeh2o_5(3,11,12), &
& hk_6(5), coeh2o_6(3,11,5), &
& hk_7(2), coeh2o_7(3,19,2), &
& hk_8(3), coeh2o_8(3,19,3), &
& hk_9(4), coeh2o_9(3,19,4), &
& hk_10(4), coeh2o_10(3,19,4), &
& coech4_10(3,19), coen2o_10(3,19), &
& hk_11(3), coeh2o_11(3,19,3), &
& coech4_11(3,19), coen2o_11(3,19), &
& hk_12(5), coeo3_12(3,19,5), coeh2o_12(3,19), &
& hk_13(2), coeh2o_13(3,19,2), &
& hk_14(10), coehca_14(3,19,10), coehcb_14(3,19,10), &
& hk_15(12), coehca_15(3,19,12), coehcb_15(3,19,12), &
& hk_16(7), coeh2o_16(3,19,7), &
& hk_17(7), coeh2o_17(3,19,7), &
& hk_18(8), coeh2o_18(3,19,8)
! common /band1/ hk(10), fko3(10)
data hk_1 / .24, .16, .24, .28, .03,&
& .016, .01, .008, .008, .008 /
data fko3_1 / .2204e-08,.1207e-01,.4537e-01,.1032e+00,.1740e+00,&
& .1210e+01,.7367e+01,.2050e+02,.8100e+02,.2410e+03 /
! block data ckd2
!c *********************************************************************
!c hk is the interval in the g (cumulative probability) space from 0
!c to one. coeh2o is the coefficient to calculate the H2O absorption
!c coefficient in units of (cm-atm)**-1 at there temperatures, eleven
!c pressures, and eight cumulative probabilities ( Fu, 1991 ). The
!c spectral region is from 14500 to 7700 cm**-1.
!c *********************************************************************
! common /band2/ hk(8), coeh2o(3,11,8)
data hk_2 / .71, .11, .06, .06, .04, .016, .0034, .0006 /
!c .343849E+03 .532724E+02 .290577E+02 .290577E+02 .193718E+02
!c .774872E+01 .164660E+01 .290577E+00
data ( ( ( coeh2o_2(k,j,i), i = 1, 8 ), j = 1, 11 ), k = 1, 3 ) / &
& -.1735E+02,-.1407E+02,-.1268E+02,-.1131E+02,-.9261E+01,-.6666E+01,&
& -.3937E+01,-.5448E+00,-.1690E+02,-.1365E+02,-.1232E+02,-.1101E+02,&
& -.9058E+01,-.6574E+01,-.3914E+01,-.5529E+00,-.1643E+02,-.1323E+02,&
& -.1195E+02,-.1068E+02,-.8840E+01,-.6475E+01,-.3889E+01,-.6143E+00,&
& -.1598E+02,-.1282E+02,-.1157E+02,-.1035E+02,-.8598E+01,-.6339E+01,&
& -.3848E+01,-.6636E+00,-.1551E+02,-.1241E+02,-.1119E+02,-.1001E+02,&
& -.8342E+01,-.6178E+01,-.3788E+01,-.8181E+00,-.1506E+02,-.1201E+02,&
& -.1082E+02,-.9692E+01,-.8073E+01,-.6017E+01,-.3703E+01,-.9003E+00,&
& -.1446E+02,-.1154E+02,-.1042E+02,-.9332E+01,-.7810E+01,-.5846E+01,&
& -.3576E+01,-.1083E+01,-.1394E+02,-.1112E+02,-.1005E+02,-.8992E+01,&
& -.7548E+01,-.5674E+01,-.3477E+01,-.1266E+01,-.1351E+02,-.1076E+02,&
& -.9722E+01,-.8702E+01,-.7334E+01,-.5531E+01,-.3401E+01,-.1524E+01,&
& -.1311E+02,-.1044E+02,-.9422E+01,-.8423E+01,-.7117E+01,-.5383E+01,&
& -.3410E+01,-.1785E+01,-.1274E+02,-.1015E+02,-.9162E+01,-.8190E+01,&
& -.6949E+01,-.5236E+01,-.3477E+01,-.2082E+01, .2407E-02, .2847E-02,&
& .3768E-02, .4626E-02, .5631E-02, .4542E-02, .3475E-02,-.3085E-02,&
& .2428E-02, .2805E-02, .3412E-02, .3893E-02, .4773E-02, .3998E-02,&
& .2742E-02,-.2556E-02, .2428E-02, .2721E-02, .3077E-02, .3161E-02,&
& .4019E-02, .3224E-02, .2512E-02,-.1884E-02, .2449E-02, .2617E-02,&
& .2763E-02, .2658E-02, .3286E-02, .2617E-02, .1989E-02,-.1740E-02,&
& .2512E-02, .2470E-02, .2470E-02, .2282E-02, .2512E-02, .1926E-02,&
& .1465E-02,-.2612E-02, .2554E-02, .2303E-02, .2303E-02, .1842E-02,&
& .2030E-02, .1340E-02, .1068E-02,-.1413E-02, .2449E-02, .2198E-02,&
& .2030E-02, .1465E-02, .1528E-02, .9838E-03, .1005E-02,-.1099E-02,&
& .2868E-02, .2198E-02, .1968E-02, .1382E-02, .1172E-02, .5652E-03,&
& .6070E-03,-.1662E-02, .3077E-02, .2219E-02, .1800E-02, .1277E-02,&
& .1005E-02, .3349E-03, .2512E-03,-.1195E-02, .3182E-02, .2219E-02,&
& .1758E-02, .1172E-02, .7326E-03, .4815E-03, .6280E-04,-.1880E-02,&
& .3265E-02, .2114E-02, .1696E-02, .1298E-02, .4187E-03, .4187E-03,&
& -.3768E-03,-.1467E-02,-.1180E-04,-.1294E-04,-.1142E-04,-.7232E-05,&
& -.8754E-05,-.1484E-04,-.8373E-05, .1028E-04,-.1218E-04,-.1142E-04,&
& -.9515E-05,-.1522E-05,-.9134E-05,-.1484E-04,-.3425E-05, .1142E-06,&
& -.1294E-04,-.9895E-05,-.7231E-05,-.4187E-05,-.7612E-05,-.3806E-05,&
& .1522E-05,-.3882E-05,-.1256E-04,-.8754E-05,-.7612E-05,-.6470E-05,&
& -.4948E-05,-.3425E-05, .4948E-05,-.1054E-04,-.1370E-04,-.6089E-05,&
& -.8373E-05,-.5709E-05,-.3045E-05,-.3806E-05, .5328E-05, .8678E-05,&
& -.1370E-04,-.6851E-05,-.8373E-05,-.1522E-05,-.3425E-05, .0000E+00,&
& .1256E-04,-.1572E-04,-.1484E-04,-.7231E-05,-.7992E-05,-.4567E-05,&
& -.2664E-05,-.3807E-06,-.1522E-05, .2169E-05,-.1713E-04,-.9515E-05,&
& -.6089E-05,-.6851E-05,-.3045E-05,-.1142E-05, .1903E-05, .9363E-05,&
& -.1560E-04,-.9134E-05,-.5328E-05,-.4948E-05, .0000E+00, .7611E-06,&
& -.6851E-05, .1252E-04,-.1522E-04,-.8373E-05,-.6089E-05,-.6089E-05,&
& -.3805E-06,-.1142E-05,-.3807E-06, .2512E-05,-.1599E-04,-.7231E-05,&
& -.5709E-05,-.4567E-05, .1522E-05,-.2284E-05,-.3941E-10, .5290E-05/
! block data ckd3
!c *********************************************************************
!c hk is the interval in the g (cumulative probability) space from 0
!c to one. coeh2o is the coefficient to calculate the H2O absorption
!c coefficient in units of (cm-atm)**-1 at there temperatures, eleven
!c pressures, and twelve cumulative probabilities ( Fu, 1991 ). The
!c spectral region is from 7700 to 5250 cm**-1.
!c *********************************************************************
! common /band3/ hk(12), coeh2o(3,11,12)
data hk_3 / .34, .11, .1, .09, .12, .1, &
& .06, .04, .026, .01, .0035, .0005 /
!c .509474E+02 .164830E+02 .149845E+02 .134861E+02 .179814E+02
!c .149845E+02 .899071E+01 .599381E+01 .389597E+01 .149845E+01
!c .524458E+00 .749226E-01
data ( ( ( coeh2o_3(k,j,i), i = 1, 12 ), j = 1, 11 ), k = 1, 3 ) / &
& -.1900E+02,-.1515E+02,-.1344E+02,-.1224E+02,-.1081E+02,-.9337E+01,&
& -.7965E+01,-.6585E+01,-.4578E+01,-.2247E+01, .1747E+00, .3083E+01,&
& -.1854E+02,-.1471E+02,-.1300E+02,-.1181E+02,-.1039E+02,-.8927E+01,&
& -.7576E+01,-.6238E+01,-.4317E+01,-.2119E+01, .1888E+00, .3033E+01,&
& -.1808E+02,-.1426E+02,-.1257E+02,-.1137E+02,-.9966E+01,-.8513E+01,&
& -.7177E+01,-.5885E+01,-.4053E+01,-.1977E+01, .2245E+00, .3005E+01,&
& -.1763E+02,-.1381E+02,-.1213E+02,-.1094E+02,-.9542E+01,-.8094E+01,&
& -.6779E+01,-.5524E+01,-.3788E+01,-.1796E+01, .2961E+00, .2828E+01,&
& -.1716E+02,-.1337E+02,-.1170E+02,-.1051E+02,-.9116E+01,-.7677E+01,&
& -.6381E+01,-.5153E+01,-.3493E+01,-.1607E+01, .3850E+00, .2660E+01,&
& -.1670E+02,-.1295E+02,-.1127E+02,-.1008E+02,-.8690E+01,-.7265E+01,&
& -.5991E+01,-.4799E+01,-.3212E+01,-.1438E+01, .4582E+00, .2588E+01,&
& -.1596E+02,-.1231E+02,-.1067E+02,-.9501E+01,-.8151E+01,-.6793E+01,&
& -.5588E+01,-.4458E+01,-.2940E+01,-.1257E+01, .4888E+00, .2260E+01,&
& -.1530E+02,-.1184E+02,-.1017E+02,-.8992E+01,-.7661E+01,-.6369E+01,&
& -.5213E+01,-.4145E+01,-.2701E+01,-.1108E+01, .4239E+00, .1974E+01,&
& -.1481E+02,-.1144E+02,-.9756E+01,-.8573E+01,-.7255E+01,-.5994E+01,&
& -.4868E+01,-.3829E+01,-.2485E+01,-.9738E+00, .3343E+00, .1667E+01,&
& -.1439E+02,-.1108E+02,-.9360E+01,-.8183E+01,-.6885E+01,-.5646E+01,&
& -.4559E+01,-.3555E+01,-.2314E+01,-.8904E+00, .2169E+00, .1289E+01,&
& -.1402E+02,-.1073E+02,-.8987E+01,-.7817E+01,-.6551E+01,-.5335E+01,&
& -.4278E+01,-.3316E+01,-.2147E+01,-.8695E+00, .1587E-01, .8658E+00,&
& .1132E-01, .8855E-02, .6698E-02, .5296E-02, .4396E-02, .3370E-02,&
& .3245E-02, .4145E-02, .4731E-02, .4756E-02, .3116E-02,-.2763E-02,&
& .1135E-01, .8917E-02, .6657E-02, .5170E-02, .4207E-02, .3056E-02,&
& .2868E-02, .3433E-02, .3726E-02, .4109E-02, .2836E-02,-.3119E-02,&
& .1135E-01, .8980E-02, .6615E-02, .5045E-02, .4061E-02, .2847E-02,&
& .2491E-02, .2847E-02, .2910E-02, .2671E-02, .2396E-02,-.3245E-02,&
& .1135E-01, .9043E-02, .6594E-02, .4940E-02, .3914E-02, .2638E-02,&
& .2156E-02, .2261E-02, .2051E-02, .1978E-02, .1566E-02,-.3203E-02,&
& .1139E-01, .9085E-02, .6531E-02, .4835E-02, .3768E-02, .2428E-02,&
& .1842E-02, .1612E-02, .1591E-02, .1279E-02, .7201E-03,-.2763E-02,&
& .1143E-01, .9085E-02, .6447E-02, .4752E-02, .3684E-02, .2261E-02,&
& .1570E-02, .1235E-02, .1151E-02, .7243E-03, .6489E-04,-.2240E-02,&
& .1135E-01, .9001E-02, .5694E-02, .4438E-02, .3412E-02, .1968E-02,&
& .1235E-02, .9420E-03, .8792E-03, .5045E-03,-.1821E-03,-.1936E-02,&
& .1174E-01, .9273E-02, .5882E-02, .4689E-02, .3454E-02, .1947E-02,&
& .1151E-02, .6070E-03, .6698E-03, .9420E-04,-.6740E-03,-.2707E-02,&
& .1218E-01, .9336E-02, .6050E-02, .4731E-02, .3475E-02, .1863E-02,&
& .1151E-02, .4605E-03, .3768E-03,-.1214E-03,-.4396E-03,-.1903E-02,&
& .1235E-01, .9294E-02, .6029E-02, .4584E-02, .3370E-02, .1800E-02,&
& .1068E-02, .2303E-03, .1675E-03,-.4501E-03,-.7571E-03,-.1149E-02,&
& .1233E-01, .9315E-02, .6029E-02, .4438E-02, .3203E-02, .1842E-02,&
& .9629E-03, .0000E+00,-.2198E-03,-.5338E-03,-.9721E-03,-.7661E-03,&
& -.3692E-04,-.3844E-04,-.2588E-04,-.1180E-04,-.1066E-04,-.3426E-05,&
& -.2664E-05, .7611E-06, .6089E-05,-.4568E-06,-.2077E-04,-.1142E-04,&
& -.3730E-04,-.3806E-04,-.2360E-04,-.1256E-04,-.1180E-04,-.4567E-05,&
& -.3425E-05,-.2284E-05,-.1522E-05,-.4225E-05,-.9940E-05,-.4187E-05,&
& -.3501E-04,-.3844E-04,-.2131E-04,-.1256E-04,-.9896E-05,-.3806E-05,&
& -.4186E-05, .7612E-06,-.1903E-05, .4110E-05, .1789E-05,-.2169E-04,&
& -.3425E-04,-.3882E-04,-.1941E-04,-.1294E-04,-.9515E-05,-.4567E-05,&
& -.4186E-05, .1522E-05,-.4187E-10, .4605E-05,-.2588E-05, .6470E-05,&
& -.3501E-04,-.3730E-04,-.1751E-04,-.1332E-04,-.1066E-04,-.3806E-05,&
& -.4567E-05,-.1142E-05,-.3045E-05, .1104E-05,-.1058E-04, .2816E-04,&
& -.3578E-04,-.3501E-04,-.1751E-04,-.1332E-04,-.1218E-04,-.3806E-05,&
& -.3425E-05,-.3806E-06,-.4187E-05,-.6090E-06,-.6965E-05,-.3463E-04,&
& -.3578E-04,-.3349E-04,-.1675E-04,-.9895E-05,-.9515E-05,-.6090E-05,&
& -.6470E-05,-.3807E-06,-.5328E-05,-.4186E-06,-.3996E-05, .2074E-04,&
& -.3540E-04,-.3083E-04,-.1789E-04,-.9896E-05,-.1104E-04,-.6470E-05,&
& -.5709E-05, .3425E-05,-.4567E-05, .3463E-05, .5633E-05,-.3159E-05,&
& -.3730E-04,-.2740E-04,-.1484E-04,-.1066E-04,-.1142E-04,-.6470E-05,&
& -.6470E-05, .1522E-05,-.1522E-05,-.3045E-05, .3197E-05,-.1039E-04,&
& -.3425E-04,-.2284E-04,-.1370E-04,-.1028E-04,-.1104E-04,-.8373E-05,&
& -.4948E-05, .1903E-05,-.7612E-06,-.1104E-05, .2455E-05,-.3805E-07,&
& -.3235E-04,-.2093E-04,-.1294E-04,-.1142E-04,-.1180E-04,-.6851E-05,&
& -.3045E-05,-.7611E-06, .1256E-05,-.7231E-06, .9924E-05, .3578E-05/
! block data ckd4
!c *********************************************************************
!c hk is the interval in the g (cumulative probability) space from 0
!c to one. coeh2o is the coefficient to calculate the H2O absorption
!c coefficient in units of (cm-atm)**-1 at there temperatures, eleven
!c pressures, and seven cumulative probabilities ( Fu, 1991 ). The
!c spectral region is from 5250 to 4000 cm**-1.
!c *********************************************************************
! common /band4/ hk(7), coeh2o(3,11,7)
data hk_4 / .52, .21, .11, .1, .04, .015, .005 /
!c .253397E+02 .102333E+02 .536032E+01 .487302E+01 .194921E+01
!c .730953E+00 .243651E+00
data ( ( ( coeh2o_4(k,j,i), i = 1, 7 ), j = 1, 11 ), k = 1, 3 ) / &
& -.1722E+02,-.1402E+02,-.1202E+02,-.1001E+02,-.7702E+01,-.5273E+01, &
& -.6530E+00,-.1677E+02,-.1359E+02,-.1164E+02,-.9662E+01,-.7419E+01, &
& -.5001E+01,-.6040E+00,-.1630E+02,-.1316E+02,-.1125E+02,-.9303E+01, &
& -.7092E+01,-.4750E+01,-.5715E+00,-.1584E+02,-.1274E+02,-.1086E+02, &
& -.8939E+01,-.6751E+01,-.4458E+01,-.4928E+00,-.1538E+02,-.1232E+02, &
& -.1048E+02,-.8579E+01,-.6399E+01,-.4191E+01,-.4683E+00,-.1493E+02, &
& -.1192E+02,-.1011E+02,-.8241E+01,-.6065E+01,-.3910E+01,-.4310E+00, &
& -.1440E+02,-.1145E+02,-.9643E+01,-.7873E+01,-.5710E+01,-.3668E+01, &
& -.3304E+00,-.1391E+02,-.1104E+02,-.9238E+01,-.7479E+01,-.5367E+01, &
& -.3387E+01,-.3604E+00,-.1348E+02,-.1069E+02,-.8918E+01,-.7122E+01, &
& -.5086E+01,-.3152E+01,-.3030E+00,-.1310E+02,-.1037E+02,-.8626E+01, &
& -.6790E+01,-.4815E+01,-.2945E+01,-.4789E+00,-.1275E+02,-.1011E+02, &
& -.8347E+01,-.6484E+01,-.4584E+01,-.2788E+01,-.5807E+00, .7934E-02, &
& .9231E-02, .1005E-01, .9043E-02, .8164E-02, .8980E-02, .6403E-02, &
& .7954E-02, .9169E-02, .9797E-02, .8687E-02, .7724E-02, .7954E-02, &
& .6652E-02, .7954E-02, .9043E-02, .9608E-02, .8499E-02, .7347E-02, &
& .7473E-02, .6382E-02, .7996E-02, .8980E-02, .9378E-02, .8289E-02, &
& .7264E-02, .6594E-02, .6674E-02, .8059E-02, .8938E-02, .9294E-02, &
& .8227E-02, .7201E-02, .6678E-02, .7032E-02, .8122E-02, .8896E-02, &
& .9189E-02, .8038E-02, .7033E-02, .5987E-02, .5475E-02, .8268E-02, &
& .9064E-02, .8792E-02, .7975E-02, .6573E-02, .5087E-02, .4657E-02, &
& .8541E-02, .8980E-02, .9085E-02, .7996E-02, .6133E-02, .4501E-02, &
& .3860E-02, .8813E-02, .9043E-02, .9294E-02, .8122E-02, .5861E-02, &
& .4354E-02, .3964E-02, .8875E-02, .8834E-02, .9797E-02, .8164E-02, &
& .5463E-02, .4417E-02, .3270E-02, .8938E-02, .8771E-02, .1005E-01, &
& .8247E-02, .5589E-02, .4835E-02, .3033E-02,-.1484E-04,-.2169E-04, &
& -.2436E-04,-.2588E-04,-.1142E-04,-.1142E-05,-.1519E-04,-.1522E-04, &
& -.2055E-04,-.2131E-04,-.2398E-04,-.4948E-05,-.1675E-04,-.3593E-04, &
& -.1522E-04,-.2055E-04,-.1865E-04,-.2207E-04,-.4948E-05,-.1180E-04, &
& -.1237E-04,-.1598E-04,-.2017E-04,-.1903E-04,-.2284E-04,-.1028E-04, &
& -.1865E-04,-.2381E-04,-.1713E-04,-.2017E-04,-.1827E-04,-.2169E-04, &
& -.1218E-04,-.9515E-05,-.2415E-04,-.1827E-04,-.2093E-04,-.1637E-04, &
& -.1827E-04,-.9134E-05,-.8373E-05,-.1243E-04,-.1560E-04,-.1865E-04, &
& -.1599E-04,-.1256E-04,-.1066E-04,-.1142E-05,-.2181E-04,-.1675E-04, &
& -.1560E-04,-.1522E-04,-.1675E-04,-.1865E-04,-.1865E-04,-.9522E-05, &
& -.1332E-04,-.1370E-04,-.1446E-04,-.2055E-04,-.1142E-04,-.2512E-04, &
& -.3343E-04,-.1294E-04,-.1294E-04,-.1751E-04,-.2512E-04,-.1560E-04, &
& -.2854E-04,-.7003E-05,-.8753E-05,-.1028E-04,-.1751E-04,-.2512E-04, &
& -.1713E-04,-.1713E-04,-.1245E-04 /
! block data ckd5
!c *********************************************************************
!c hk is the interval in the g (cumulative probability) space from 0
!c to one. coeh2o is the coefficient to calculate the H2O absorption
!c coefficient in units of (cm-atm)**-1 at there temperatures, eleven
!c pressures, and twelve cumulative probabilities ( Fu, 1991 ). The
!c spectral region is from 4000 to 2850 cm**-1.
!c *********************************************************************
! common /band5/ hk(12), coeh2o(3,11,12)
data hk_5 / .13, .14, .13, .16, .18, .14, &
& .07, .02, .016, .008, .004, .002 /
!c .411549E+01 .443207E+01 .411549E+01 .506522E+01 .569837E+01
!c .443207E+01 .221603E+01 .633153E+00 .506522E+00 .253261E+00
!c .126631E+00 .633153E-01
data ( ( ( coeh2o_5(k,j,i), i = 1, 12 ), j = 1, 11 ), k = 1, 3 ) / &
& -.1499E+02,-.1267E+02,-.1118E+02,-.9696E+01,-.7992E+01,-.6323E+01, &
& -.4414E+01,-.2961E+01,-.1715E+01,-.1406E+00, .1612E+01, .3689E+01, &
& -.1454E+02,-.1223E+02,-.1075E+02,-.9277E+01,-.7576E+01,-.5915E+01, &
& -.4043E+01,-.2630E+01,-.1449E+01, .2314E-01, .1708E+01, .3744E+01, &
& -.1408E+02,-.1178E+02,-.1031E+02,-.8851E+01,-.7154E+01,-.5503E+01, &
& -.3666E+01,-.2288E+01,-.1141E+01, .2772E+00, .1819E+01, .3788E+01, &
& -.1363E+02,-.1134E+02,-.9876E+01,-.8423E+01,-.6733E+01,-.5091E+01, &
& -.3286E+01,-.1938E+01,-.8649E+00, .5349E+00, .1969E+01, .3795E+01, &
& -.1318E+02,-.1091E+02,-.9452E+01,-.8004E+01,-.6309E+01,-.4677E+01, &
& -.2904E+01,-.1595E+01,-.5641E+00, .7592E+00, .2109E+01, .3783E+01, &
& -.1275E+02,-.1048E+02,-.9028E+01,-.7585E+01,-.5892E+01,-.4267E+01, &
& -.2524E+01,-.1274E+01,-.2782E+00, .9376E+00, .2257E+01, .3714E+01, &
& -.1180E+02,-.9887E+01,-.8492E+01,-.7014E+01,-.5390E+01,-.3834E+01, &
& -.2156E+01,-.9775E+00,-.3129E-01, .1151E+01, .2330E+01, .3592E+01, &
& -.1114E+02,-.9367E+01,-.8002E+01,-.6514E+01,-.4928E+01,-.3435E+01, &
& -.1835E+01,-.7064E+00, .2153E+00, .1309E+01, .2422E+01, .3488E+01, &
& -.1074E+02,-.8941E+01,-.7582E+01,-.6116E+01,-.4536E+01,-.3072E+01, &
& -.1521E+01,-.4651E+00, .4053E+00, .1465E+01, .2374E+01, .3260E+01, &
& -.1041E+02,-.8545E+01,-.7180E+01,-.5745E+01,-.4177E+01,-.2735E+01, &
& -.1245E+01,-.2356E+00, .5786E+00, .1516E+01, .2263E+01, .3074E+01, &
& -.1008E+02,-.8149E+01,-.6804E+01,-.5409E+01,-.3855E+01,-.2427E+01, &
& -.9857E+00,-.4939E-01, .7060E+00, .1483E+01, .2159E+01, .2745E+01, &
& .9985E-02, .8373E-02, .7431E-02, .6866E-02, .4584E-02, .2952E-02, &
& .3098E-02, .3768E-02, .4013E-02, .3960E-02, .3228E-02, .3203E-02, &
& .1007E-01, .8436E-02, .7368E-02, .6657E-02, .4375E-02, .2617E-02, &
& .2742E-02, .3286E-02, .3192E-02, .2992E-02, .2612E-02, .1968E-02, &
& .1019E-01, .8457E-02, .7264E-02, .6426E-02, .4187E-02, .2365E-02, &
& .2324E-02, .2614E-02, .2736E-02, .2068E-02, .2085E-02, .1005E-02, &
& .1028E-01, .8478E-02, .7138E-02, .6259E-02, .3998E-02, .2156E-02, &
& .1926E-02, .1953E-02, .2250E-02, .1844E-02, .1869E-02,-.6489E-03, &
& .1030E-01, .8478E-02, .7033E-02, .6112E-02, .3852E-02, .1989E-02, &
& .1716E-02, .1763E-02, .1432E-02, .1193E-02, .1306E-02,-.5861E-03, &
& .1042E-01, .8499E-02, .6887E-02, .5987E-02, .3768E-02, .1800E-02, &
& .1549E-02, .1712E-02, .1287E-02, .7389E-03, .7222E-03,-.1130E-02, &
& .8227E-02, .7201E-02, .6866E-02, .5903E-02, .3412E-02, .1591E-02, &
& .1402E-02, .1346E-02, .1041E-02, .8185E-03, .3349E-03,-.4815E-03, &
& .8268E-02, .6992E-02, .7159E-02, .6384E-02, .3286E-02, .1591E-02, &
& .1271E-02, .1202E-02, .9187E-03, .6531E-03,-.4187E-03,-.7954E-03, &
& .8478E-02, .7159E-02, .7117E-02, .6447E-02, .3349E-02, .1528E-02, &
& .9964E-03, .9210E-03, .6112E-03, .6259E-03,-.3768E-03,-.1298E-02, &
& .8520E-02, .7075E-02, .7096E-02, .6405E-02, .3245E-02, .1528E-02, &
& .1011E-02, .7877E-03, .7536E-03, .9001E-04,-.6719E-03,-.1026E-02, &
& .8561E-02, .6950E-02, .7033E-02, .6280E-02, .2993E-02, .1528E-02, &
& .6698E-03, .5847E-03, .2847E-03,-.6280E-04,-.9420E-03,-.1444E-02, &
& -.1408E-04,-.2664E-04,-.1180E-04,-.1903E-04,-.9515E-05, .3806E-06, &
& -.6851E-05,-.3806E-05,-.4834E-05,-.3239E-05,-.2284E-05,-.1028E-04, &
& -.1484E-04,-.2550E-04,-.1142E-04,-.1827E-04,-.9515E-05, .3805E-06, &
& -.4948E-05, .3806E-06,-.2664E-06, .1058E-04,-.1012E-04,-.1142E-04, &
& -.1560E-04,-.2512E-04,-.1256E-04,-.1865E-04,-.9134E-05, .1142E-05, &
& -.3425E-05, .2474E-05,-.9781E-05,-.1519E-05,-.7916E-05,-.1294E-04, &
& -.1560E-04,-.2474E-04,-.1180E-04,-.2017E-04,-.7992E-05, .3805E-06, &
& -.2283E-05,-.4453E-05,-.1180E-05,-.5138E-05,-.4453E-05,-.3425E-05, &
& -.1522E-04,-.2550E-04,-.9896E-05,-.1903E-04,-.9134E-05,-.1142E-05, &
& -.7611E-06,-.5252E-05,-.4567E-06,-.4643E-05,-.4567E-06,-.4567E-05, &
& -.1294E-04,-.2512E-04,-.1028E-04,-.2055E-04,-.9896E-05,-.4567E-05, &
& -.2284E-05,-.5100E-05,-.4339E-06,-.9515E-06,-.1252E-04,-.7612E-06, &
& -.2246E-04,-.1370E-04,-.1066E-04,-.1598E-04,-.8754E-05,-.5328E-05, &
& -.6622E-05,-.5138E-05,-.8754E-07,-.9515E-06, .6090E-05, .4187E-05, &
& -.3463E-04,-.1599E-04,-.1218E-04,-.2093E-04,-.9515E-05,-.4567E-05, &
& -.1104E-05,-.1903E-05,-.1488E-05,-.3730E-05,-.4567E-05, .3045E-05, &
& -.3463E-04,-.1675E-04,-.1294E-04,-.1979E-04,-.1066E-04,-.4187E-05, &
& -.4034E-05,-.2893E-05,-.2588E-05,-.9401E-05, .2284E-05, .3045E-05, &
& -.2778E-04,-.1522E-04,-.1560E-04,-.1751E-04,-.1256E-04,-.5709E-05, &
& -.2474E-05,-.2577E-05,-.2284E-05,-.4187E-06, .7650E-05,-.3425E-05, &
& -.3083E-04,-.1827E-04,-.1370E-04,-.1751E-04,-.1104E-04,-.9515E-05, &
& -.6318E-05,-.4358E-05,-.7613E-07, .4643E-05, .4415E-05, .1028E-04/
! block data ckd6
!c *********************************************************************
!c hk is the interval in the g (cumulative probability) space from 0
!c to one. coeh2o is the coefficient to calculate the H2O absorption
!c coefficient in units of (cm-atm)**-1 at there temperatures, eleven
!c pressures, and five cumulative probabilities ( Fu, 1991 ). The
!c spectral region is from 2850 to 2500 cm**-1.
!c *********************************************************************
! common /band6/ hk(5), coeh2o(3,11,5)
data hk_6 / .3, .2, .2, .2, .1 /
!c .173978E+01 .115985E+01 .115985E+01 .115985E+01 .579927E+00
data ( ( ( coeh2o_6(k,j,i), i = 1, 5 ), j = 1, 11 ), k = 1, 3 ) / &
& -.1905E+02,-.1602E+02,-.1472E+02,-.1307E+02,-.1024E+02,-.1823E+02, &
& -.1555E+02,-.1427E+02,-.1266E+02,-.9938E+01,-.1749E+02,-.1508E+02, &
& -.1381E+02,-.1225E+02,-.9641E+01,-.1684E+02,-.1462E+02,-.1337E+02, &
& -.1185E+02,-.9367E+01,-.1630E+02,-.1417E+02,-.1294E+02,-.1145E+02, &
& -.9123E+01,-.1578E+02,-.1373E+02,-.1251E+02,-.1108E+02,-.8881E+01, &
& -.1517E+02,-.1327E+02,-.1209E+02,-.1072E+02,-.8653E+01,-.1463E+02, &
& -.1284E+02,-.1169E+02,-.1040E+02,-.8453E+01,-.1421E+02,-.1244E+02, &
& -.1133E+02,-.1014E+02,-.8312E+01,-.1382E+02,-.1207E+02,-.1100E+02, &
& -.9887E+01,-.8220E+01,-.1348E+02,-.1173E+02,-.1071E+02,-.9685E+01, &
& -.8220E+01, .1024E-01, .1842E-02, .6908E-03, .1737E-02, .3517E-02, &
& .8394E-02, .2072E-02, .8164E-03, .1716E-02, .2805E-02, .8143E-02, &
& .2240E-02, .9001E-03, .1570E-02, .1800E-02, .8227E-02, .2386E-02, &
& .9420E-03, .1486E-02, .1068E-02, .8373E-02, .2533E-02, .9210E-03, &
& .1319E-02, .9420E-03, .8394E-02, .2700E-02, .9629E-03, .1026E-02, &
& .5233E-03, .8917E-02, .2575E-02, .8792E-03, .7536E-03, .4187E-03, &
& .9378E-02, .2617E-02, .7955E-03, .6070E-03, .4815E-03, .9797E-02, &
& .2638E-02, .6908E-03, .5233E-03, .6280E-03, .1009E-01, .2638E-02, &
& .4815E-03, .2931E-03, .4815E-03, .1036E-01, .2428E-02, .3140E-03, &
& .3977E-03, .2093E-03,-.5366E-04,-.1522E-04,-.5709E-05,-.2664E-05, &
& .3806E-05,-.4301E-04,-.1484E-04,-.4948E-05,-.7610E-06, .7610E-06, &
& -.3920E-04,-.1484E-04,-.4948E-05, .3804E-06,-.3806E-05,-.3920E-04, &
& -.1522E-04,-.4948E-05, .3425E-05, .1903E-05,-.3806E-04,-.1484E-04, &
& -.3045E-05, .2664E-05, .7993E-05,-.4148E-04,-.1408E-04,-.3806E-05, &
& .4187E-05, .7993E-05,-.5481E-04,-.1180E-04,-.3045E-05, .3045E-05, &
& .2284E-05,-.5709E-04,-.1104E-04,-.2283E-05,-.2664E-05,-.1142E-05, &
& -.6090E-04,-.1218E-04,-.2664E-05, .3804E-06, .3045E-05,-.6698E-04, &
& -.1218E-04,-.2664E-05, .1523E-05,-.1142E-05,-.6508E-04,-.1218E-04, &
& -.3425E-05, .1903E-05, .7612E-06 /
! block data ckd7
!c *********************************************************************
!c hk is the interval in the g (cumulative probability) space from 0
!c to one. coeh2o is the coefficient to calculate the H2O absorption
!c coefficient in units of (cm-atm)**-1 at there temperatures, nine-
!c teen pressures, and two cumulative probabilities ( Fu, 1991 ).
!c The spectral region is from 2200 to 1900 cm**-1.
!c *********************************************************************
! common /band7/ hk(2), coeh2o(3,19,2)
data hk_7 / 0.7, 0.3 /
data ( ( ( coeh2o_7(k,j,i), i = 1, 2 ), j = 1, 19 ), k = 1, 3 ) / &
& -.2008E+02,-.1467E+02,-.2004E+02,-.1426E+02,-.2001E+02,-.1386E+02, &
& -.1998E+02,-.1345E+02,-.1995E+02,-.1304E+02,-.1992E+02,-.1263E+02, &
& -.1989E+02,-.1223E+02,-.1986E+02,-.1183E+02,-.1984E+02,-.1143E+02, &
& -.1758E+02,-.1038E+02,-.1602E+02,-.9480E+01,-.1469E+02,-.8752E+01, &
& -.1349E+02,-.8218E+01,-.1255E+02,-.7677E+01,-.1174E+02,-.7184E+01, &
& -.1110E+02,-.6735E+01,-.1056E+02,-.6332E+01,-.1019E+02,-.5975E+01, &
& -.9874E+01,-.5644E+01, .2533E-02, .2269E-01, .2575E-02, .2263E-01, &
& .2554E-02, .2267E-01, .2491E-02, .2250E-01, .2449E-02, .2244E-01, &
& .2344E-02, .2234E-01, .2219E-02, .2208E-01, .5694E-02, .2190E-01, &
& .9650E-02, .2162E-01, .3286E-01, .1848E-01, .2987E-01, .1578E-01, &
& .2527E-01, .1465E-01, .2175E-01, .1386E-01, .2056E-01, .1235E-01, &
& .1963E-01, .1116E-01, .1926E-01, .1040E-01, .2014E-01, .1040E-01, &
& .2024E-01, .1042E-01, .1972E-01, .1080E-01,-.8754E-05,-.6698E-04, &
& -.1104E-04,-.6432E-04,-.1142E-04,-.6051E-04,-.1180E-04,-.6128E-04, &
& -.1180E-04,-.6242E-04,-.1218E-04,-.6280E-04,-.1218E-04,-.6204E-04, &
& .5328E-04,-.5709E-04, .1275E-03,-.5214E-04,-.1370E-03,-.4148E-04, &
& -.1100E-03,-.3045E-04,-.9248E-04,-.3197E-04,-.7346E-04,-.2436E-04, &
& -.5100E-04,-.2131E-04,-.5861E-04,-.2550E-04,-.5328E-04,-.3311E-04, &
& -.6090E-04,-.4225E-04,-.5443E-04,-.4415E-04,-.4034E-04,-.4339E-04/
! block data ckd8
!c *********************************************************************
!c hk is the interval in the g (cumulative probability) space from 0
!c to one. coeh2o is the coefficient to calculate the H2O absorption
!c coefficient in units of (cm-atm)**-1 at there temperatures, nine-
!c teen pressures, and three cumulative probabilities ( Fu, 1991 ).
!c The spectral region is from 1900 to 1700 cm**-1.
!c *********************************************************************
! common /band8/ hk(3), coeh2o(3,19,3)
data hk_8 / 0.2, 0.7, 0.1 /
data ( ( ( coeh2o_8(k,j,i), i = 1, 3 ), j = 1, 19 ), k = 1, 3 ) / &
& -.2283E+02,-.1639E+02,-.6155E+01,-.2237E+02,-.1595E+02,-.5775E+01, &
& -.2191E+02,-.1551E+02,-.5381E+01,-.2145E+02,-.1507E+02,-.5004E+01, &
& -.2099E+02,-.1463E+02,-.4617E+01,-.2053E+02,-.1419E+02,-.4218E+01, &
& -.2025E+02,-.1375E+02,-.3806E+01,-.2021E+02,-.1330E+02,-.3403E+01, &
& -.2018E+02,-.1287E+02,-.2993E+01,-.1998E+02,-.1091E+02,-.2586E+01, &
& -.1744E+02,-.9171E+01,-.2162E+01,-.1490E+02,-.7642E+01,-.1763E+01, &
& -.1303E+02,-.6526E+01,-.1373E+01,-.1113E+02,-.5846E+01,-.9699E+00, &
& -.9814E+01,-.5280E+01,-.5955E+00,-.8582E+01,-.4787E+01,-.2510E+00, &
& -.8020E+01,-.4350E+01, .2770E-01,-.7571E+01,-.3942E+01, .2406E+00, &
& -.7140E+01,-.3537E+01, .3567E+00, .3722E-01, .1505E-01, .6615E-02, &
& .3722E-01, .1518E-01, .5840E-02, .3720E-01, .1526E-01, .5170E-02, &
& .3399E-01, .1530E-01, .4773E-02, .3012E-01, .1551E-01, .4333E-02, &
& .2625E-01, .1553E-01, .3956E-02, .2240E-01, .1562E-01, .3454E-02, &
& .1846E-01, .1574E-01, .3161E-02, .1446E-01, .1572E-01, .3098E-02, &
& .5924E-02, .8875E-02, .2658E-02, .2204E-01, .7096E-02, .2504E-02, &
& .1591E-01, .5233E-02, .2292E-02, .8855E-02, .4249E-02, .2190E-02, &
& .5422E-02, .3496E-02, .2041E-02, .4919E-02, .3621E-02, .2200E-02, &
& .6657E-02, .3663E-02, .2248E-02, .8645E-02, .3852E-02, .2118E-02, &
& .8771E-02, .3873E-02, .2176E-02, .9043E-02, .3747E-02, .2079E-02, &
& -.1568E-03,-.4681E-04, .4567E-05,-.1568E-03,-.4605E-04,-.3425E-05, &
& -.1572E-03,-.4605E-04,-.1104E-04,-.2154E-03,-.4453E-04,-.6851E-05, &
& -.2843E-03,-.4225E-04,-.7231E-05,-.3562E-03,-.4110E-04,-.7231E-05, &
& -.3692E-03,-.4110E-04,-.1028E-04,-.3007E-03,-.4263E-04,-.6470E-05, &
& -.2325E-03,-.3996E-04,-.8373E-05,-.5290E-04,-.7612E-05,-.4948E-05, &
& -.7422E-04,-.1256E-04,-.8449E-05,-.3501E-04,-.1446E-04,-.4834E-05, &
& .4529E-04,-.2246E-04,-.2893E-05, .6470E-05,-.1789E-04,-.7498E-05, &
& -.4948E-05,-.1713E-04,-.8183E-05,-.5481E-04,-.1713E-04,-.1447E-04, &
& -.4986E-04,-.1903E-04,-.1353E-04,-.5138E-04,-.1484E-04,-.1147E-04, &
& -.5328E-04,-.1560E-04,-.6588E-05/
! block data ckd9
!c *********************************************************************
!c hk is the interval in the g (cumulative probability) space from 0
!c to one. coeh2o is the coefficient to calculate the H2O absorption
!c coefficient in units of (cm-atm)**-1 at there temperatures, nine-
!c teen pressures, and four cumulative probabilities ( Fu, 1991 ).
!c The spectral region is from 1700 to 1400 cm**-1.
!c *********************************************************************
! common /band9/ hk(4), coeh2o(3,19,4)
data hk_9 / 0.22, 0.51, 0.22, 0.05 /
data ( ( ( coeh2o_9(k,j,i), i = 1, 4 ), j = 1, 19 ), k = 1, 3 ) / &
& -.2066E+02,-.1464E+02,-.8301E+01,-.3548E+01,-.2025E+02,-.1419E+02, &
& -.7905E+01,-.3260E+01,-.2019E+02,-.1374E+02,-.7495E+01,-.2927E+01, &
& -.2013E+02,-.1329E+02,-.7078E+01,-.2584E+01,-.2007E+02,-.1284E+02, &
& -.6675E+01,-.2247E+01,-.2001E+02,-.1239E+02,-.6268E+01,-.1890E+01, &
& -.1996E+02,-.1194E+02,-.5853E+01,-.1530E+01,-.1991E+02,-.1150E+02, &
& -.5441E+01,-.1133E+01,-.1987E+02,-.1105E+02,-.5022E+01,-.7447E+00, &
& -.1575E+02,-.9657E+01,-.4191E+01,-.3728E+00,-.1329E+02,-.8133E+01, &
& -.3638E+01, .1616E-01,-.1181E+02,-.6675E+01,-.3178E+01, .4083E+00, &
& -.1036E+02,-.5655E+01,-.2731E+01, .7953E+00,-.8628E+01,-.4990E+01, &
& -.2303E+01, .1153E+01,-.7223E+01,-.4453E+01,-.1877E+01, .1454E+01, &
& -.6567E+01,-.3974E+01,-.1461E+01, .1663E+01,-.6077E+01,-.3551E+01, &
& -.1071E+01, .1800E+01,-.5651E+01,-.3136E+01,-.7005E+00, .1809E+01, &
& -.5241E+01,-.2726E+01,-.3859E+00, .1781E+01, .1315E-01, .4542E-02, &
& .3496E-02, .4877E-02, .9650E-02, .4542E-02, .3098E-02, .3956E-02, &
& .6154E-02, .4626E-02, .2763E-02, .3077E-02, .2658E-02, .4626E-02, &
& .2512E-02, .2261E-02, .2658E-02, .4689E-02, .2219E-02, .1405E-02, &
& .2700E-02, .4752E-02, .1926E-02, .7473E-03, .2658E-02, .4773E-02, &
& .1737E-02, .5066E-03, .4668E-02, .4815E-02, .1507E-02, .1842E-03, &
& .8541E-02, .4794E-02, .1382E-02,-.2156E-03, .1022E-01, .2198E-02, &
& .3977E-03,-.2910E-03, .5484E-02, .6698E-03, .0000E+00,-.2339E-03, &
& .3349E-02, .1068E-02,-.2512E-03,-.4228E-03, .1884E-02, .2093E-03, &
& -.3977E-03,-.6405E-03,-.8373E-04,-.5233E-03,-.4124E-03,-.5945E-03, &
& .7536E-03,-.6698E-03,-.4919E-03,-.4794E-03, .3600E-02,-.4605E-03, &
& -.4375E-03,-.3517E-03, .3873E-02,-.5861E-03,-.3203E-03,-.4689E-03, &
& .3935E-02,-.7326E-03,-.2072E-03,-.4228E-03, .4124E-02,-.8582E-03, &
& -.4187E-04,-.5945E-03,-.8525E-04, .1865E-04,-.1142E-05, .2664E-05, &
& -.1313E-03, .1865E-04, .0000E+00, .1256E-04,-.6470E-04, .1865E-04, &
& -.3045E-05, .8754E-05, .3805E-06, .1789E-04,-.6851E-05, .5328E-05, &
& .1142E-05, .1827E-04,-.6090E-05, .4148E-05, .1142E-05, .1865E-04, &
& -.3806E-05,-.3768E-05,-.1903E-05, .1751E-04,-.4948E-05, .3121E-05, &
& .3159E-04, .1979E-04,-.3045E-05,-.9896E-06, .1005E-03, .1789E-04, &
& -.6089E-05,-.1865E-05,-.2207E-04, .1941E-04, .1903E-05, .2322E-05, &
& -.1675E-04, .6090E-05,-.7611E-06, .4397E-05, .3425E-04, .3806E-06, &
& .1522E-05, .3806E-05, .4796E-04, .1522E-05,-.3806E-06, .3654E-05, &
& -.6851E-05, .2664E-05,-.3920E-05,-.6850E-06,-.1370E-04, .5328E-05, &
& -.6584E-05,-.8716E-05,-.8374E-10, .1522E-05,-.6356E-05, .1294E-05, &
& -.9515E-05, .7612E-06,-.3235E-05,-.1066E-05,-.7612E-05, .1142E-05, &
& -.4529E-05, .3730E-05,-.2664E-05,-.3806E-06,-.3501E-05,-.5328E-06/
! block data ckd10
!c *********************************************************************
!c hk is the interval in the g (cumulative probability) space from 0
!c to one. coeh2o is the coefficient to calculate the H2O absorption
!c coefficient in units of (cm-atm)**-1 at there temperatures, nine-
!c teen pressures, and four cumulative probabilities ( Fu, 1991 ).
!c The spectral region is from 1400 to 1250 cm**-1. coech4 and coen2o
!c are the coefficients to calculate the CH4 and N2O absorption coe-
!c fficients in units of (cm-atm)**-1 at three temperature, nineteen
!c pressures, and one cumulative probability (Fu, 1991), respectively.
!c *********************************************************************
! common /band10/hk(4), coeh2o(3,19,4), coech4(3,19), coen2o(3,19)
data hk_10 / 0.28, 0.42, 0.25, 0.05 /
data ( ( ( coeh2o_10(k,j,i), i = 1, 4 ), j = 1, 19 ), k = 1, 3 ) / &
& -.2023E+02,-.1641E+02,-.1171E+02,-.6090E+01,-.2016E+02,-.1595E+02, &
& -.1133E+02,-.5867E+01,-.2011E+02,-.1550E+02,-.1095E+02,-.5660E+01, &
& -.2005E+02,-.1504E+02,-.1055E+02,-.5407E+01,-.2001E+02,-.1459E+02, &
& -.1015E+02,-.5137E+01,-.1997E+02,-.1413E+02,-.9749E+01,-.4852E+01, &
& -.1993E+02,-.1367E+02,-.9337E+01,-.4534E+01,-.1990E+02,-.1321E+02, &
& -.8920E+01,-.4211E+01,-.1987E+02,-.1276E+02,-.8506E+01,-.3889E+01, &
& -.1645E+02,-.1179E+02,-.7711E+01,-.3613E+01,-.1442E+02,-.1081E+02, &
& -.6942E+01,-.3316E+01,-.1308E+02,-.9950E+01,-.6344E+01,-.2950E+01, &
& -.1212E+02,-.9217E+01,-.5904E+01,-.2577E+01,-.1131E+02,-.8559E+01, &
& -.5519E+01,-.2256E+01,-.1064E+02,-.7962E+01,-.5183E+01,-.1929E+01, &
& -.1013E+02,-.7447E+01,-.4833E+01,-.1643E+01,-.9712E+01,-.7071E+01, &
& -.4485E+01,-.1410E+01,-.9305E+01,-.6760E+01,-.4145E+01,-.1249E+01, &
& -.8966E+01,-.6477E+01,-.3820E+01,-.1114E+01, .7913E-02, .8206E-02, &
& .1509E-01, .1869E-01, .4228E-02, .8247E-02, .1467E-01, .1783E-01, &
& .2010E-02, .8227E-02, .1442E-01, .1687E-01, .1947E-02, .8289E-02, &
& .1394E-01, .1568E-01, .1863E-02, .8289E-02, .1346E-01, .1484E-01, &
& .1842E-02, .8415E-02, .1310E-01, .1400E-01, .1800E-02, .8457E-02, &
& .1275E-01, .1377E-01, .1696E-02, .8478E-02, .1220E-01, .1321E-01, &
& .1842E-02, .8478E-02, .1189E-01, .1250E-01, .1409E-01, .8624E-02, &
& .1254E-01, .1214E-01, .9043E-02, .1045E-01, .1225E-01, .1260E-01, &
& .8561E-02, .1202E-01, .1181E-01, .1296E-01, .1114E-01, .1235E-01, &
& .1191E-01, .1330E-01, .1199E-01, .1271E-01, .1195E-01, .1371E-01, &
& .1415E-01, .1315E-01, .1218E-01, .1361E-01, .1478E-01, .1338E-01, &
& .1296E-01, .1306E-01, .1518E-01, .1375E-01, .1365E-01, .1334E-01, &
& .1530E-01, .1411E-01, .1392E-01, .1327E-01, .1547E-01, .1507E-01, &
& .1390E-01, .1264E-01,-.1089E-03,-.2740E-04,-.2017E-04,-.5519E-04, &
& -.4491E-04,-.2740E-04,-.1408E-04,-.5937E-04,-.6090E-05,-.2702E-04, &
& -.6470E-05,-.4719E-04,-.7232E-05,-.2740E-04,-.6089E-05,-.4910E-04, &
& -.7231E-05,-.2969E-04,-.4186E-05,-.5366E-04,-.6090E-05,-.3045E-04, &
& -.2284E-05,-.4986E-04,-.4568E-05,-.3121E-04,-.4948E-05,-.5100E-04, &
& -.3426E-05,-.3007E-04,-.7993E-05,-.4910E-04, .1522E-05,-.2931E-04, &
& -.9896E-05,-.5366E-04,-.5823E-04,-.1599E-04,-.1713E-04,-.4110E-04, &
& -.3121E-04,-.1713E-04,-.3159E-04,-.3578E-04,-.3996E-04,-.1598E-04, &
& -.3958E-04,-.4605E-04,-.3349E-04,-.1751E-04,-.3844E-04,-.5576E-04, &
& -.2626E-04,-.2474E-04,-.3920E-04,-.4464E-04,-.1979E-04,-.3045E-04, &
& -.3958E-04,-.5336E-04,-.2893E-04,-.3616E-04,-.3996E-04,-.4754E-04, &
& -.2398E-04,-.3083E-04,-.4415E-04,-.5119E-04,-.2702E-04,-.2664E-04, &
& -.4605E-04,-.4038E-04,-.2398E-04,-.2360E-04,-.4948E-04,-.5149E-04/
data ( ( coech4_10(k,j), j = 1, 19 ), k = 1, 3 ) / &
& -.8909E+01,-.8464E+01,-.8018E+01,-.7573E+01,-.7133E+01,-.6687E+01, &
& -.6240E+01,-.5803E+01,-.5377E+01,-.4534E+01,-.3983E+01,-.3502E+01, &
& -.3062E+01,-.2648E+01,-.2265E+01,-.1896E+01,-.1568E+01,-.1234E+01, &
& -.9298E+00, .9629E-03, .9838E-03, .1088E-02, .1172E-02, .1256E-02, &
& .1402E-02, .1528E-02, .1633E-02, .1716E-02, .4815E-03,-.3977E-03, &
& -.5652E-03,-.5024E-03,-.4605E-03,-.4563E-03,-.4438E-03,-.4521E-03, &
& -.4312E-03,-.3789E-03,-.1294E-04,-.1408E-04,-.1522E-04,-.1675E-04, &
& -.1751E-04,-.1941E-04,-.2246E-04,-.2207E-04,-.1827E-04,-.1256E-04, &
& -.9515E-05,-.6470E-05,-.3045E-05,-.3806E-05,-.2055E-05,-.3730E-05, &
& -.7612E-06,-.3806E-05, .1256E-05/
data ( ( coen2o_10(k,j), j = 1, 19 ), k = 1, 3 ) / &
& -.7863E+01,-.7412E+01,-.6963E+01,-.6514E+01,-.6065E+01,-.5611E+01, &
& -.5167E+01,-.4720E+01,-.4283E+01,-.3454E+01,-.2858E+01,-.2404E+01, &
& -.1922E+01,-.1491E+01,-.1097E+01,-.7177E+00,-.3548E+00, .1218E-01, &
& .3088E+00, .4459E-02, .4542E-02, .4668E-02, .4752E-02, .4815E-02, &
& .4919E-02, .5087E-02, .5254E-02, .5296E-02, .2324E-02, .2093E-02, &
& .2294E-02, .2125E-02, .2058E-02, .1920E-02, .1786E-02, .1689E-02, &
& .1788E-02, .2144E-02,-.7231E-05,-.7231E-05,-.7231E-05,-.6470E-05, &
& -.6851E-05,-.7231E-05,-.5709E-05,-.6470E-05,-.4186E-05, .8754E-05, &
& -.7612E-05,-.9134E-06,-.8640E-05,-.8487E-05,-.8259E-05,-.9553E-05, &
& -.8107E-05,-.1654E-04,-.1858E-04/
! block data ckd11
!c *********************************************************************
!c hk is the interval in the g (cumulative probability) space from 0
!c to one. coeh2o is the coefficient to calculate the H2O absorption
!c coefficient in units of (cm-atm)**-1 at there temperatures, nine-
!c teen pressures, and three cumulative probabilities ( Fu, 1991 ).
!c The spectral region is from 1250 to 1100 cm**-1. coech4 and coen2o
!c are the coefficients to calculate the CH4 and N2O absorption coe-
!c fficients in units of (cm-atm)**-1 at three temperature, nineteen
!c pressures, and one cumulative probability (Fu, 1991), respectively.
!c *********************************************************************
! common /band11/hk(3), coeh2o(3,19,3), coech4(3,19), coen2o(3,19)
data hk_11 / 0.80, 0.15, 0.05 /
data ( ( ( coeh2o_11(k,j,i), i = 1, 3 ), j = 1, 19 ), k = 1, 3 ) / &
& -.2005E+02,-.1548E+02,-.1021E+02,-.2001E+02,-.1504E+02,-.1001E+02, &
& -.1997E+02,-.1459E+02,-.9814E+01,-.1993E+02,-.1416E+02,-.9595E+01, &
& -.1989E+02,-.1373E+02,-.9349E+01,-.1985E+02,-.1328E+02,-.9072E+01, &
& -.1982E+02,-.1286E+02,-.8833E+01,-.1957E+02,-.1243E+02,-.8566E+01, &
& -.1911E+02,-.1200E+02,-.8276E+01,-.1743E+02,-.1134E+02,-.7958E+01, &
& -.1625E+02,-.1078E+02,-.7629E+01,-.1524E+02,-.1036E+02,-.7334E+01, &
& -.1429E+02,-.9970E+01,-.7051E+01,-.1348E+02,-.9620E+01,-.6749E+01, &
& -.1282E+02,-.9270E+01,-.6505E+01,-.1229E+02,-.8932E+01,-.6277E+01, &
& -.1186E+02,-.8628E+01,-.6120E+01,-.1148E+02,-.8345E+01,-.6049E+01, &
& -.1112E+02,-.8066E+01,-.5906E+01, .1842E-02, .2131E-01, .3033E-01, &
& .1905E-02, .2137E-01, .2841E-01, .1926E-02, .2135E-01, .2696E-01, &
& .1926E-02, .2133E-01, .2514E-01, .1884E-02, .2154E-01, .2401E-01, &
& .5589E-02, .2156E-01, .2321E-01, .9483E-02, .2156E-01, .2210E-01, &
& .1333E-01, .2150E-01, .2133E-01, .1725E-01, .2154E-01, .2074E-01, &
& .2254E-01, .1999E-01, .2005E-01, .2118E-01, .1926E-01, .1978E-01, &
& .1936E-01, .1920E-01, .1963E-01, .1905E-01, .1911E-01, .1934E-01, &
& .1909E-01, .1903E-01, .1920E-01, .1922E-01, .1901E-01, .1899E-01, &
& .1934E-01, .1930E-01, .1974E-01, .1966E-01, .1909E-01, .2014E-01, &
& .1976E-01, .1905E-01, .1984E-01, .1963E-01, .1940E-01, .1897E-01, &
& -.1522E-05,-.6013E-04,-.5062E-04,-.2665E-05,-.6204E-04,-.5519E-04, &
& -.3806E-05,-.6394E-04,-.5633E-04,-.4567E-05,-.6280E-04,-.5214E-04, &
& -.6090E-05,-.6128E-04,-.5290E-04, .6051E-04,-.6242E-04,-.5823E-04, &
& .1313E-03,-.6013E-04,-.5176E-04, .1336E-03,-.5747E-04,-.4072E-04, &
& .6318E-04,-.5671E-04,-.3996E-04,-.5595E-04,-.3996E-04,-.4263E-04, &
& -.3958E-04,-.4719E-04,-.4453E-04,-.3387E-04,-.5138E-04,-.5100E-04, &
& -.5252E-04,-.4986E-04,-.4491E-04,-.5100E-04,-.4453E-04,-.4529E-04, &
& -.5176E-04,-.4795E-04,-.4453E-04,-.5557E-04,-.5176E-04,-.5062E-04, &
& -.5747E-04,-.4795E-04,-.5633E-04,-.5709E-04,-.4643E-04,-.3806E-04, &
& -.5481E-04,-.5671E-04,-.4948E-04/
data ( ( coech4_11(k,j), j = 1, 19 ), k = 1, 3 ) / &
& -.1207E+02,-.1162E+02,-.1116E+02,-.1070E+02,-.1024E+02,-.9777E+01, &
& -.9319E+01,-.8858E+01,-.8398E+01,-.7384E+01,-.6643E+01,-.6081E+01, &
& -.5602E+01,-.5188E+01,-.4822E+01,-.4479E+01,-.4184E+01,-.3884E+01, &
& -.3627E+01, .1036E-01, .1036E-01, .1040E-01, .1040E-01, .1045E-01, &
& .1047E-01, .1049E-01, .1055E-01, .1059E-01, .1059E-01, .1026E-01, &
& .1011E-01, .1024E-01, .1049E-01, .1072E-01, .1089E-01, .1109E-01, &
& .1153E-01, .1191E-01,-.4910E-04,-.4834E-04,-.4910E-04,-.4910E-04, &
& -.4910E-04,-.4872E-04,-.4834E-04,-.4948E-04,-.5100E-04,-.5633E-04, &
& -.6166E-04,-.5595E-04,-.5366E-04,-.5366E-04,-.5328E-04,-.5328E-04, &
& -.4948E-04,-.5519E-04,-.5595E-04/
data ( ( coen2o_11(k,j), j = 1, 19 ), k = 1, 3 ) / &
-.9461E+01,-.9003E+01,-.8543E+01,-.8084E+01,-.7629E+01,-.7166E+01, &
& -.6707E+01,-.6249E+01,-.5793E+01,-.5312E+01,-.4847E+01,-.4393E+01, &
& -.3974E+01,-.3587E+01,-.3231E+01,-.2885E+01,-.2602E+01,-.2358E+01, &
& -.2108E+01, .4710E-02, .4752E-02, .4773E-02, .4773E-02, .4815E-02, &
& .4877E-02, .4898E-02, .4982E-02, .5066E-02, .5296E-02, .5149E-02, &
& .5129E-02, .5024E-02, .4752E-02, .4501E-02, .4270E-02, .4019E-02, &
& .3646E-02, .2759E-02,-.1484E-04,-.1408E-04,-.1446E-04,-.1446E-04, &
& -.1522E-04,-.1560E-04,-.1522E-04,-.1522E-04,-.1598E-04,-.1484E-04, &
& -.9895E-05,-.1028E-04,-.7612E-05,-.1903E-05, .1903E-05, .0000E+00, &
& .2283E-05, .6166E-05,-.2740E-05/
! block data ckd12
!c *********************************************************************
!c hk is the interval in the g (cumulative probability) space from 0
!c to one. coeo3 is the coefficient to calculate the ozone absorption
!c coefficient in units of (cm-atm)**-1 at there temperatures, nine-
!c teen pressures, and five cumulative probabilities ( Fu, 1991 ).
!c The spectral region is from 1100 to 980 cm**-1. coeh2o is the
!c coefficient to calculate the H2O absorption coefficient in units
!c of (cm-atm)**-1 at three temperature, nineteen pressures, and one
!c cumulative probability ( Fu, 1991 ).
!c *********************************************************************
! common /band12/ hk(5), coeo3(3,19,5), coeh2o(3,19)
data hk_12 / 0.45, 0.30, 0.2, 0.04, 0.01 /
data ( ( ( coeo3_12(k,j,i), i = 1, 5 ), j = 1, 19 ), k = 1, 3 ) / &
& -.6590E+01,-.3912E+01,-.8513E+00, .2731E+01, .5515E+01,-.6157E+01, &
& -.3583E+01,-.7292E+00, .2740E+01, .5508E+01,-.5731E+01,-.3242E+01, &
& -.5800E+00, .2782E+01, .5485E+01,-.5301E+01,-.2901E+01,-.4131E+00, &
& .2805E+01, .5455E+01,-.4879E+01,-.2551E+01,-.2288E+00, .2878E+01, &
& .5416E+01,-.4449E+01,-.2201E+01,-.2228E-01, .3000E+01, .5374E+01, &
& -.4018E+01,-.1843E+01, .2055E+00, .3143E+01, .5342E+01,-.3615E+01, &
& -.1502E+01, .4561E+00, .3288E+01, .5204E+01,-.3228E+01,-.1172E+01, &
& .7099E+00, .3396E+01, .5077E+01,-.2828E+01,-.8499E+00, .9664E+00, &
& .3463E+01, .4893E+01,-.2480E+01,-.5393E+00, .1229E+01, .3493E+01, &
& .4656E+01,-.2181E+01,-.2653E+00, .1504E+01, .3456E+01, .4398E+01, &
& -.1950E+01,-.1469E-01, .1735E+01, .3387E+01, .4115E+01,-.1788E+01, &
& .2517E+00, .1919E+01, .3251E+01, .3832E+01,-.1677E+01, .5027E+00, &
& .2032E+01, .3088E+01, .3581E+01,-.1637E+01, .7373E+00, .2100E+01, &
& .2910E+01, .3364E+01,-.1650E+01, .9383E+00, .2123E+01, .2793E+01, &
& .3150E+01,-.1658E+01, .1091E+01, .2112E+01, .2683E+01, .3021E+01, &
& -.1654E+01, .1163E+01, .2099E+01, .2602E+01, .2871E+01, .9498E-02, &
& .8894E-02, .1161E-01, .8828E-02,-.1669E-02, .9613E-02, .8347E-02, &
& .1053E-01, .8462E-02,-.1612E-02, .9700E-02, .7829E-02, .9101E-02, &
& .7915E-02,-.1439E-02, .9815E-02, .7167E-02, .7981E-02, .7282E-02, &
& -.1094E-02, .9671E-02, .6764E-02, .6930E-02, .5613E-02,-.8347E-03, &
& .9613E-02, .6312E-02, .6225E-02, .4145E-02,-.1295E-02, .9728E-02, &
& .6099E-02, .5293E-02, .2965E-02,-.1756E-02, .9844E-02, .5915E-02, &
& .4496E-02, .1871E-02,-.2044E-02, .9930E-02, .5817E-02, .3509E-02, &
& .1324E-02,-.2044E-02, .9988E-02, .5535E-02, .2711E-02, .6620E-03, &
& -.1813E-02, .1034E-01, .5247E-02, .1926E-02,-.2303E-03,-.1842E-02, &
& .1058E-01, .4795E-02, .1197E-02,-.9498E-03,-.2216E-02, .1084E-01, &
& .4414E-02, .6188E-03,-.1123E-02,-.2303E-02, .1079E-01, .3926E-02, &
& .1756E-03,-.1497E-02,-.2274E-02, .1039E-01, .3425E-02,-.1900E-03, &
& -.1353E-02,-.2389E-02, .9815E-02, .2769E-02,-.6620E-03,-.1756E-02, &
& -.1785E-02, .9818E-02, .2444E-02,-.1016E-02,-.1410E-02,-.1698E-02, &
& .1074E-01, .3218E-02,-.1235E-02,-.1900E-02,-.2533E-02, .1145E-01, &
& .3684E-02,-.1364E-02,-.1353E-02,-.1957E-02,-.4030E-04,-.2375E-04, &
& -.3814E-05,-.4943E-04,-.3166E-04,-.3742E-04,-.1871E-04,-.1137E-04, &
& -.4317E-04,-.2878E-04,-.3526E-04,-.2015E-04,-.1295E-04,-.4821E-04, &
& -.2303E-04,-.3382E-04,-.2087E-04,-.1519E-04,-.2231E-04,-.1871E-04, &
& -.3454E-04,-.2087E-04,-.8109E-05,-.6476E-05,-.1511E-04,-.3454E-04, &
& -.1820E-04,-.1269E-05,-.1439E-04,-.5037E-05,-.4173E-04,-.2598E-04, &
& .6645E-05,-.1943E-04,-.2087E-04,-.3454E-04,-.2267E-04, .2159E-05, &
& -.2231E-04,-.2159E-05,-.2950E-04,-.2080E-04, .2159E-06,-.4317E-05, &
& .1799E-04,-.3670E-04,-.1590E-04,-.4461E-05,-.9354E-05,-.3598E-05, &
& -.3216E-04,-.1475E-04,-.2231E-05,-.1295E-04,-.2878E-05,-.3576E-04, &
& -.7347E-05,-.1022E-04,-.2159E-05,-.7915E-05,-.3015E-04,-.5230E-05, &
& -.5109E-05,-.6476E-05,-.7196E-05,-.2331E-04,-.1079E-04,-.4102E-05, &
& .1439E-05,-.1223E-04,-.2216E-04,-.1094E-04,-.5325E-05,-.7196E-06, &
& -.1655E-04,-.1036E-04,-.7627E-05,-.2878E-05, .5037E-05,-.1295E-04, &
& .1029E-04,-.1346E-04,-.4821E-05,-.7915E-05, .7915E-05, .2835E-04, &
& -.2893E-04,-.1367E-05,-.7196E-05,-.1871E-04, .3965E-04,-.3310E-04, &
& -.3310E-05,-.7195E-06, .2303E-04/
data ( ( coeh2o_12(k,j), j = 1, 19 ), k = 1, 3 ) / &
& -.1984E+02,-.1983E+02,-.1982E+02,-.1981E+02,-.1963E+02,-.1917E+02, &
& -.1871E+02,-.1825E+02,-.1779E+02,-.1639E+02,-.1545E+02,-.1484E+02, &
& -.1433E+02,-.1387E+02,-.1345E+02,-.1305E+02,-.1268E+02,-.1231E+02, &
& -.1196E+02, .6071E-03, .2072E-02, .6196E-02, .1030E-01, .1436E-01, &
& .1846E-01, .2259E-01, .2667E-01, .2993E-01, .2878E-01, .2803E-01, &
& .2851E-01, .2864E-01, .2874E-01, .2862E-01, .2859E-01, .2853E-01, &
& .2868E-01, .2887E-01,-.3808E-06, .2474E-04, .9895E-04, .1728E-03, &
& .1911E-03, .1165E-03, .4225E-04,-.3121E-04,-.8982E-04,-.9553E-04, &
& -.9705E-04,-.9591E-04,-.9287E-04,-.9172E-04,-.9096E-04,-.9134E-04, &
& -.9248E-04,-.1050E-03,-.1031E-03/
! block data ckd13
!c *********************************************************************
!c hk is the interval in the g (cumulative probability) space from 0
!c to one. coeh2o is the coefficient to calculate the H2O absorption
!c coefficient in units of (cm-atm)**-1 at there temperatures, nine-
!c teen pressures, and two cumulative probabilities ( Fu, 1991 ).
!c The spectral region is from 980 to 800 cm**-1.
!c *********************************************************************
! common /band13/ hk(2), coeh2o(3,19,2)
data hk_13 / 0.95, 0.05 /
data ( ( ( coeh2o_13(k,j,i), i = 1, 2 ), j = 1, 19 ), k = 1, 3 ) / &
& -.1992E+02,-.1446E+02,-.1992E+02,-.1405E+02,-.1991E+02,-.1363E+02, &
& -.1990E+02,-.1322E+02,-.1989E+02,-.1282E+02,-.1989E+02,-.1242E+02, &
& -.1988E+02,-.1201E+02,-.1987E+02,-.1159E+02,-.1986E+02,-.1119E+02, &
& -.1982E+02,-.1079E+02,-.1817E+02,-.1039E+02,-.1659E+02,-.1000E+02, &
& -.1537E+02,-.9623E+01,-.1460E+02,-.9266E+01,-.1406E+02,-.8959E+01, &
& -.1354E+02,-.8676E+01,-.1309E+02,-.8411E+01,-.1267E+02,-.8232E+01, &
& -.1229E+02,-.8094E+01, .5024E-03, .3199E-01, .5652E-03, .3199E-01, &
& .6071E-03, .3211E-01, .6489E-03, .3199E-01, .6699E-03, .3178E-01, &
& .6908E-03, .3157E-01, .6908E-03, .3109E-01, .6698E-03, .3075E-01, &
& .6698E-03, .3054E-01, .1474E-01, .3000E-01, .3085E-01, .2960E-01, &
& .3659E-01, .2935E-01, .3016E-01, .2920E-01, .2834E-01, .2895E-01, &
& .2780E-01, .2870E-01, .2753E-01, .2843E-01, .2755E-01, .2820E-01, &
& .2765E-01, .2732E-01, .2769E-01, .2705E-01, .6299E-09,-.7993E-04, &
& -.3802E-06,-.7992E-04,-.3802E-06,-.8525E-04,-.3808E-06,-.8449E-04, &
& -.7610E-06,-.7764E-04,-.1142E-05,-.7231E-04,-.1142E-05,-.7345E-04, &
& -.2284E-05,-.8259E-04,-.2284E-05,-.8031E-04, .2436E-03,-.7878E-04, &
& .7612E-05,-.8525E-04,-.1248E-03,-.9439E-04,-.9477E-04,-.9172E-04, &
& -.8982E-04,-.8640E-04,-.7916E-04,-.6813E-04,-.7574E-04,-.6090E-04, &
& -.7612E-04,-.7117E-04,-.7498E-04,-.7041E-04,-.7269E-04,-.7992E-04/
! block data ckd14
!c **********************************************************************
!c hk is the interval in the g (cumulative probability) space from 0
!c to one. coehca and coehcb are the coefficients to calculate the
!c H2O and CO2 overlapping absorption coefficients in units of (cm-
!c atm)**-1 at three temperature, nineteen pressures, and ten cumu-
!c lative probabilities (Fu, 1991). The spectral region is from 800
!c to 670 cm**-1.
!c **********************************************************************
! common /band14/ hk(10), coehca(3,19,10), coehcb(3,19,10)
data hk_14 / .3,.3,.2,.12,.06,.012,.004,.0025,.0011,.0004 /
data ( ( ( coehca_14(k,j,i), i = 1, 10 ), j = 1, 19 ), k = 1, 3 ) / &
& -.1847E+02,-.1399E+02,-.1106E+02,-.8539E+01,-.5852E+01,-.3295E+01, &
& -.1208E+01,-.6272E-01, .2055E+01, .6071E+01,-.1801E+02,-.1357E+02, &
& -.1067E+02,-.8171E+01,-.5562E+01,-.3071E+01,-.1073E+01, .1033E+00, &
& .2055E+01, .6071E+01,-.1755E+02,-.1314E+02,-.1027E+02,-.7798E+01, &
& -.5224E+01,-.2823E+01,-.9280E+00, .2723E+00, .2165E+01, .5969E+01, &
& -.1709E+02,-.1272E+02,-.9868E+01,-.7404E+01,-.4880E+01,-.2569E+01, &
& -.6908E+00, .4453E+00, .2241E+01, .5969E+01,-.1663E+02,-.1230E+02, &
& -.9467E+01,-.7013E+01,-.4535E+01,-.2297E+01,-.4408E+00, .6353E+00, &
& .2359E+01, .5969E+01,-.1617E+02,-.1188E+02,-.9050E+01,-.6619E+01, &
& -.4160E+01,-.1967E+01,-.1687E+00, .8213E+00, .2421E+01, .5969E+01, &
& -.1571E+02,-.1147E+02,-.8629E+01,-.6230E+01,-.3771E+01,-.1648E+01, &
& .1573E+00, .1019E+01, .2511E+01, .5884E+01,-.1525E+02,-.1106E+02, &
& -.8215E+01,-.5841E+01,-.3393E+01,-.1331E+01, .4013E+00, .1198E+01, &
& .2654E+01, .5794E+01,-.1480E+02,-.1066E+02,-.7800E+01,-.5454E+01, &
& -.3032E+01,-.9870E+00, .6323E+00, .1373E+01, .2905E+01, .5647E+01, &
& -.1402E+02,-.9693E+01,-.7206E+01,-.4846E+01,-.2656E+01,-.6540E+00, &
& .8323E+00, .1530E+01, .3211E+01, .5355E+01,-.1343E+02,-.9060E+01, &
& -.6596E+01,-.4399E+01,-.2294E+01,-.3519E+00, .9823E+00, .1673E+01, &
& .3420E+01, .5083E+01,-.1279E+02,-.8611E+01,-.5785E+01,-.4010E+01, &
& -.1936E+01,-.1177E+00, .1134E+01, .1974E+01, .3591E+01, .4770E+01, &
& -.1230E+02,-.8174E+01,-.5298E+01,-.3611E+01,-.1607E+01, .3636E-01, &
& .1433E+01, .2260E+01, .3539E+01, .4439E+01,-.1192E+02,-.7763E+01, &
& -.4946E+01,-.3228E+01,-.1321E+01, .1991E+00, .1720E+01, .2420E+01, &
& .3383E+01, .4041E+01,-.1154E+02,-.7377E+01,-.4576E+01,-.2851E+01, &
& -.1093E+01, .4430E+00, .1896E+01, .2462E+01, .3122E+01, .3620E+01, &
& -.1118E+02,-.7003E+01,-.4210E+01,-.2524E+01,-.8973E+00, .7490E+00, &
& .1966E+01, .2363E+01, .2818E+01, .3182E+01,-.1080E+02,-.6677E+01, &
& -.3872E+01,-.2264E+01,-.6846E+00, .9392E+00, .1867E+01, .2138E+01, &
& .2505E+01, .2738E+01,-.1031E+02,-.6353E+01,-.3596E+01,-.1938E+01, &
& -.4537E+00, .1015E+01, .1659E+01, .1830E+01, .2142E+01, .2287E+01, &
& -.9695E+01,-.5977E+01,-.3427E+01,-.1596E+01,-.1979E+00, .9458E+00, &
& .1363E+01, .1545E+01, .1743E+01, .1832E+01, .3628E-01, .2728E-01, &
& .2213E-01, .1656E-01, .1507E-01, .1564E-01, .1623E-01, .1419E-01, &
& .1455E-01, .1089E-02, .3632E-01, .2740E-01, .2164E-01, .1606E-01, &
& .1369E-01, .1418E-01, .1444E-01, .1275E-01, .1331E-01, .9210E-03, &
& .3636E-01, .2746E-01, .2114E-01, .1557E-01, .1239E-01, .1285E-01, &
& .1237E-01, .1141E-01, .1141E-01, .9210E-03, .3640E-01, .2748E-01, &
& .2064E-01, .1516E-01, .1141E-01, .1125E-01, .1092E-01, .1026E-01, &
& .1011E-01,-.5652E-03, .3646E-01, .2746E-01, .2024E-01, .1478E-01, &
& .1036E-01, .9688E-02, .9610E-02, .9305E-02, .9399E-02,-.6489E-03, &
& .3651E-01, .2734E-01, .1984E-01, .1438E-01, .9436E-02, .8486E-02, &
& .8214E-02, .8995E-02, .7892E-02,-.8582E-03, .3655E-01, .2723E-01, &
& .1951E-01, .1402E-01, .8716E-02, .7433E-02, .7169E-02, .8072E-02, &
& .5443E-02,-.1172E-02, .3659E-01, .2709E-01, .1911E-01, .1379E-01, &
& .8107E-02, .6818E-02, .6818E-02, .7033E-02, .3056E-02,-.1047E-02, &
& .3670E-01, .2698E-01, .1890E-01, .1363E-01, .7502E-02, .6371E-02, &
& .6558E-02, .6489E-02,-.5652E-03,-.1340E-02, .3592E-01, .2238E-01, &
& .1804E-01, .1007E-01, .6730E-02, .5512E-02, .6194E-02, .4375E-02, &
& -.1109E-02,-.3559E-03, .3609E-01, .2242E-01, .1526E-01, .8582E-02, &
& .6284E-02, .5809E-02, .4501E-02, .9420E-03,-.9001E-03,-.1005E-02, &
& .3703E-01, .2196E-01, .1281E-01, .7860E-02, .5861E-02, .5842E-02, &
& .1800E-02,-.1591E-02,-.1235E-02,-.9420E-03, .3728E-01, .2114E-01, &
& .1347E-01, .6678E-02, .5449E-02, .4837E-02,-.1084E-02,-.1361E-02, &
& -.6699E-03,-.1256E-03, .3683E-01, .2061E-01, .1350E-01, .6133E-02, &
& .5449E-02, .2111E-02,-.1386E-02,-.1235E-02,-.5652E-03,-.8373E-04, &
& .3656E-01, .1988E-01, .1348E-01, .5441E-02, .5149E-02,-.8813E-03, &
& -.1116E-02,-.8373E-03,-.3140E-03,-.6280E-04, .3669E-01, .1934E-01, &
& .1363E-01, .5035E-02, .3585E-02,-.1250E-02,-.9357E-03,-.8227E-03, &
& -.3140E-03,-.4187E-04, .3618E-01, .1856E-01, .1390E-01, .3836E-02, &
& .1470E-02,-.1096E-02,-.8080E-03,-.4480E-03,-.2093E-03,-.2093E-04, &
& .3416E-01, .1741E-01, .1431E-01, .1951E-02,-.2923E-04,-.9422E-03, &
& -.4576E-03,-.2395E-03,-.1565E-03,-.2799E-04, .3219E-01, .1674E-01, &
& .1516E-01, .6652E-03,-.5051E-03,-.7052E-03,-.2002E-03,-.2135E-03, &
& -.7633E-04,-.7300E-04,-.1290E-03,-.9934E-04,-.5595E-04,-.3996E-04, &
& .1294E-04,-.9134E-05, .1294E-05,-.3121E-05,-.4757E-04,-.1979E-04, &
& -.1305E-03,-.9629E-04,-.5481E-04,-.4301E-04, .1827E-04,-.9363E-05, &
& .1777E-04,-.2185E-04,-.1903E-04,-.1675E-04,-.1313E-03,-.9439E-04, &
& -.5404E-04,-.4263E-04, .9134E-05,-.1020E-04, .3524E-04,-.2599E-04, &
& -.2093E-04, .1675E-04,-.1313E-03,-.9172E-04,-.5252E-04,-.4567E-04, &
& .4186E-05,-.3920E-05, .2552E-04,-.2059E-04,-.2246E-04,-.1028E-04, &
& -.1324E-03,-.9210E-04,-.5138E-04,-.4491E-04, .6470E-05,-.2131E-05, &
& .1496E-04,-.1572E-04,-.3311E-04,-.8754E-05,-.1324E-03,-.9058E-04, &
& -.5328E-04,-.4225E-04, .1827E-05,-.8411E-06, .4719E-05,-.6813E-05, &
& -.2474E-04,-.1256E-04,-.1340E-03,-.8868E-04,-.5633E-04,-.4187E-04, &
& -.4415E-05, .6055E-05,-.1648E-04,-.1507E-04, .1979E-04,-.2131E-04, &
& -.1340E-03,-.8373E-04,-.5899E-04,-.3920E-04,-.4072E-05, .1491E-04, &
& -.9781E-05,-.5328E-05, .3578E-04,-.1979E-04,-.1321E-03,-.7954E-04, &
& -.5899E-04,-.4072E-04, .1066E-05, .5728E-05,-.5138E-05,-.8373E-05, &
& .2626E-04,-.2436E-04,-.1363E-03,-.6432E-04,-.5176E-04,-.3083E-04, &
& .2169E-05,-.8944E-05, .3159E-05, .6470E-05,-.4187E-05, .4948E-05, &
& -.1302E-03,-.7802E-04,-.3311E-04,-.1903E-04, .5328E-05,-.1884E-04, &
& .1408E-04, .3311E-04, .1142E-05,-.7613E-06,-.1473E-03,-.6737E-04, &
& -.7536E-04,-.1085E-04,-.1903E-05,-.1458E-04, .4034E-04,-.3941E-10, &
& -.7992E-05, .2664E-05,-.1361E-03,-.5709E-04,-.8550E-04,-.5709E-05, &
& -.8640E-05, .6523E-05, .1903E-05,-.8221E-05,-.3045E-05,-.9134E-05, &
& -.1329E-03,-.5529E-04,-.7107E-04, .2664E-05,-.9020E-05, .3320E-04, &
& -.2131E-05,-.4187E-05,-.7231E-05,-.3806E-05,-.1278E-03,-.5247E-04, &
& -.6465E-04, .3806E-05,-.6091E-05, .1245E-04,-.3844E-05,-.6090E-05, &
& -.8754E-05,-.2664E-05,-.1321E-03,-.5632E-04,-.5897E-04, .1012E-04, &
& .1168E-04,-.4196E-06,-.8411E-05,-.8868E-05,-.1484E-04,-.1522E-05, &
& -.1252E-03,-.4907E-04,-.5932E-04, .3245E-04, .1996E-04,-.3325E-05, &
& -.5785E-05,-.6394E-05,-.6851E-05,-.1142E-05,-.1093E-03,-.4731E-04, &
& -.6761E-04, .1808E-04, .1754E-04,-.5079E-05,-.5809E-05,-.5649E-05, &
& -.3988E-05,-.5849E-06,-.1151E-03,-.4965E-04,-.7163E-04, .7839E-05, &
& .5505E-05,-.6084E-05,-.3344E-05,-.3894E-05,-.1391E-05,-.1327E-05/
data ( ( ( coehcb_14(k,j,i), i = 1, 10 ), j = 1, 19 ), k = 1, 3 ) / &
& -.9398E+01,-.5678E+01,-.3606E+01,-.2192E+01, .2104E+01, .3044E+01, &
& -.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.9094E+01,-.5422E+01, &
& -.3448E+01,-.1650E+01, .2046E+01, .2749E+01,-.4587E+02,-.4587E+02, &
& -.4587E+02,-.4587E+02,-.8760E+01,-.5270E+01,-.3329E+01,-.1147E+01, &
& .2112E+01, .2709E+01,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
& -.8537E+01,-.5152E+01,-.3129E+01,-.9544E+00, .2254E+01, .2771E+01, &
& -.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.8176E+01,-.4936E+01, &
& -.2680E+01,-.9259E+00, .2247E+01,-.4587E+02,-.4587E+02,-.4587E+02, &
& -.4587E+02,-.4587E+02,-.7836E+01,-.4676E+01,-.2378E+01,-.3550E+00, &
& .1396E+01, .1976E+01,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
& -.7419E+01,-.4122E+01,-.2407E+01,-.1204E-01, .1744E+01,-.4587E+02, &
& -.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.7124E+01,-.3727E+01, &
& -.2160E+01, .6158E+00, .1953E+01,-.4587E+02,-.4587E+02,-.4587E+02, &
& -.4587E+02,-.4587E+02,-.6823E+01,-.3324E+01,-.1748E+01,-.9806E-01, &
& .2319E+01,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
& -.5957E+01,-.3017E+01,-.1647E+01, .1398E+01,-.4587E+02,-.4587E+02, &
& -.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.5115E+01,-.2290E+01, &
& -.5273E+00, .5662E+00, .1459E+01,-.4587E+02,-.4587E+02,-.4587E+02, &
& -.4587E+02,-.4587E+02,-.4162E+01,-.1453E+01, .1116E+00,-.4587E+02, &
& .9569E+00,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
& -.3611E+01,-.9744E+00,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
& -.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.3075E+01,-.4176E+00, &
& -.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
& -.4587E+02,-.4587E+02,-.3469E+01,-.9395E+00, .5092E+00, .6200E+00, &
& -.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
& -.3808E+01,-.1505E+01, .3901E+00, .6264E+00,-.1155E+01,-.4587E+02, &
& -.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4058E+01,-.1818E+01, &
& .2693E+00, .7087E+00, .3820E+00,-.4587E+02,-.4587E+02,-.4587E+02, &
& -.4587E+02,-.4587E+02,-.4262E+01,-.2097E+01,-.5711E-01, .5681E+00, &
& .1310E+01, .7371E+00,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
& -.3997E+01,-.1784E+01, .4388E-01, .5167E+00, .6930E+00,-.6906E+00, &
& -.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, .2944E-01, .2723E-01, &
& .1854E-01, .2023E-01, .2254E-01, .3059E-02, .4788E+00, .3059E-02, &
& .3059E-02, .3059E-02, .3080E-01, .2549E-01, .1547E-01, .2225E-01, &
& .2107E-01, .3059E-02, .4737E+00, .3059E-02, .3059E-02, .3059E-02, &
& .3269E-01, .2656E-01, .2125E-01, .2179E-01, .2162E-01, .4589E+00, &
& .4643E+00, .3059E-02, .3059E-02, .3059E-02, .3322E-01, .2476E-01, &
& .2075E-01, .2139E-01, .1907E-01, .4501E+00, .4441E+00, .3059E-02, &
& .3059E-02, .3059E-02, .3387E-01, .2182E-01, .2665E-01, .1841E-01, &
& .2506E-01, .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
& .3532E-01, .2091E-01, .1995E-01, .2067E-01, .1949E-01, .4491E+00, &
& .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3468E-01, .2075E-01, &
& .2587E-01, .1401E-01, .8646E-02, .3059E-02, .3059E-02, .3059E-02, &
& .3059E-02, .3059E-02, .3666E-01, .2430E-01, .1919E-01, .2007E-01, &
& .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
& .3613E-01, .2147E-01, .1892E-01, .1361E-01, .3059E-02, .4506E+00, &
& .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3129E-01, .1954E-01, &
& .2442E-01, .1011E-01, .4420E+00, .3059E-02, .3059E-02, .3059E-02, &
& .3059E-02, .3059E-02, .3177E-01, .2101E-01, .1526E-01, .4376E+00, &
& .4379E+00, .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
& .2887E-01, .2044E-01, .1285E-01, .3059E-02,-.4862E-03, .3059E-02, &
& .3059E-02, .3059E-02, .3059E-02, .3059E-02, .2759E-01, .2114E-01, &
& .4303E+00, .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
& .3059E-02, .3059E-02, .2880E-01, .1690E-01,-.4187E+00, .3059E-02, &
& .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
& .2852E-01, .2255E-01, .2184E-01, .4334E+00, .4217E+00, .3059E-02, &
& .3059E-02, .3059E-02, .3059E-02, .3059E-02, .2840E-01, .2136E-01, &
& .1644E-01, .2812E-01, .4358E+00, .4288E+00, .3059E-02, .3059E-02, &
& .3059E-02, .3059E-02, .2809E-01, .2173E-01, .1708E-01, .3346E-01, &
& .4225E-01, .4419E+00, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
& .2702E-01, .2260E-01, .1607E-01, .2720E-01, .3982E-01, .4452E+00, &
& .4365E+00, .4345E+00, .4432E+00, .4623E+00, .2684E-01, .2328E-01, &
& .2099E-01, .3040E-01, .3867E-01, .4389E+00, .3132E-01, .3158E-01, &
& .4083E-01, .4580E+00,-.1581E-03,-.9707E-04,-.1250E-03, .2580E-03, &
& .7378E-04,-.1617E-01, .8646E-02,-.4656E-05,-.4656E-05,-.4656E-05, &
& -.1319E-03,-.9528E-04,-.1710E-03, .7118E-04, .2076E-04,-.1608E-01, &
& .8552E-02,-.4656E-05,-.4656E-05,-.4656E-05,-.1721E-03,-.4680E-04, &
& -.5522E-04,-.6242E-04, .4517E-04,-.7777E-02, .8382E-02,-.4656E-05, &
& -.4656E-05,-.4656E-05,-.1482E-03,-.4208E-04,-.5216E-04,-.6514E-04, &
& -.8378E-04,-.7956E-02, .8013E-02,-.4656E-05,-.4656E-05,-.4656E-05, &
& -.1501E-03,-.4002E-04,-.1664E-03, .2272E-04,-.1888E-03,-.4656E-05, &
& -.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.1201E-03,-.4709E-04, &
& -.5371E-04,-.1574E-03, .1854E-03,-.7712E-02,-.4656E-05,-.4656E-05, &
& -.4656E-05,-.4656E-05,-.1333E-03,-.1062E-03, .5785E-04,-.4150E-04, &
& -.5717E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
& -.1212E-03,-.8524E-04,-.5895E-04,-.2884E-03,-.1581E-01,-.4656E-05, &
& -.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.8148E-04,-.9361E-04, &
& -.2873E-03, .1883E-03,-.1594E-01, .8133E-02,-.4656E-05,-.4656E-05, &
& -.4656E-05,-.4656E-05,-.1221E-03,-.1430E-04, .6335E-04,-.2581E-03, &
& .7977E-02,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
& -.9257E-04,-.5008E-04, .6389E-04,-.7455E-02,-.7745E-02,-.4656E-05, &
& -.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.1186E-03,-.9037E-04, &
& -.7461E-04,-.4656E-05, .1168E-03,-.4656E-05,-.4656E-05,-.4656E-05, &
& -.4656E-05,-.4656E-05,-.8513E-04,-.5708E-04, .7763E-02,-.4656E-05, &
& -.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
& -.1124E-03,-.1228E-03, .7663E-02,-.4656E-05,-.4656E-05,-.4656E-05, &
& -.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.1015E-03,-.8369E-04, &
& -.2167E-03,-.7548E-02, .7608E-02,-.4656E-05,-.4656E-05,-.4656E-05, &
& -.4656E-05,-.4656E-05,-.1049E-03,-.6414E-04,-.1384E-03,-.1644E-03, &
& -.6919E-02, .7736E-02,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
& -.1008E-03,-.7047E-04,-.1276E-03,-.2445E-03,-.1860E-03, .7975E-02, &
& -.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.9629E-04,-.1007E-03, &
& -.1127E-03,-.1527E-03,-.3238E-03,-.7373E-02, .7877E-02, .7840E-02, &
& .7997E-02, .8345E-02,-.8800E-04,-.1072E-03,-.1046E-03,-.1777E-03, &
& -.2146E-03,-.7016E-02, .1516E-01, .1532E-01, .1509E-01, .8268E-02/
! block data ckd15
!c **********************************************************************
!c hk is the interval in the g (cumulative probability) space from 0
!c to one. coehca and coehcb are the coefficients to calculate the
!c H2O and CO2 overlapping absorption coefficients in units of (cm-
!c atm)**-1 at three temperatures, nineteen pressures, and 12 cumu-
!c lative probabilities (Fu, 1991). The spectral region is from 670
!c to 540 cm**-1.
!c **********************************************************************
! common /band15/ hk(12), coehca(3,19,12), coehcb(3,19,12)
data hk_15 /.24,.36,.18,.1,.05,.02,.016,.012,.01,.006,.0039,.0021/
data ( ( ( coehca_15(k,j,i), i = 1, 12 ), j = 1, 19 ), k = 1, 2 ) / &
& -.1921E+02,-.1363E+02,-.1080E+02,-.8392E+01,-.6776E+01,-.5696E+01, &
& -.4572E+01,-.3752E+01,-.2382E+01,-.1110E+01, .6803E+00, .3259E+01, &
& -.1875E+02,-.1321E+02,-.1040E+02,-.8026E+01,-.6449E+01,-.5401E+01, &
& -.4316E+01,-.3498E+01,-.2141E+01,-.9439E+00, .8103E+00, .3314E+01, &
& -.1829E+02,-.1278E+02,-.1000E+02,-.7646E+01,-.6089E+01,-.5085E+01, &
& -.4047E+01,-.3217E+01,-.1872E+01,-.7106E+00, .9573E+00, .3390E+01, &
& -.1783E+02,-.1236E+02,-.9596E+01,-.7264E+01,-.5735E+01,-.4740E+01, &
& -.3743E+01,-.2882E+01,-.1587E+01,-.4714E+00, .1120E+01, .3425E+01, &
& -.1737E+02,-.1195E+02,-.9193E+01,-.6877E+01,-.5371E+01,-.4404E+01, &
& -.3405E+01,-.2574E+01,-.1298E+01,-.1747E+00, .1327E+01, .3547E+01, &
& -.1691E+02,-.1153E+02,-.8776E+01,-.6490E+01,-.4993E+01,-.4049E+01, &
& -.3039E+01,-.2256E+01,-.1012E+01, .1103E+00, .1530E+01, .3651E+01, &
& -.1644E+02,-.1112E+02,-.8360E+01,-.6105E+01,-.4623E+01,-.3688E+01, &
& -.2694E+01,-.1915E+01,-.6855E+00, .3993E+00, .1714E+01, .3950E+01, &
& -.1598E+02,-.1073E+02,-.7943E+01,-.5723E+01,-.4236E+01,-.3314E+01, &
& -.2338E+01,-.1596E+01,-.3583E+00, .6963E+00, .1868E+01, .4127E+01, &
& -.1553E+02,-.1034E+02,-.7542E+01,-.5357E+01,-.3856E+01,-.2942E+01, &
& -.1986E+01,-.1299E+01,-.5472E-01, .9443E+00, .2149E+01, .4261E+01, &
& -.1485E+02,-.9661E+01,-.7008E+01,-.4830E+01,-.3458E+01,-.2566E+01, &
& -.1658E+01,-.9639E+00, .2083E+00, .1182E+01, .2458E+01, .4452E+01, &
& -.1427E+02,-.9166E+01,-.6373E+01,-.4404E+01,-.3073E+01,-.2209E+01, &
& -.1349E+01,-.6648E+00, .4023E+00, .1452E+01, .2739E+01, .4466E+01, &
& -.1380E+02,-.8726E+01,-.5772E+01,-.3982E+01,-.2732E+01,-.1874E+01, &
& -.1052E+01,-.4403E+00, .5763E+00, .1792E+01, .2999E+01, .4335E+01, &
& -.1305E+02,-.8270E+01,-.5304E+01,-.3586E+01,-.2392E+01,-.1568E+01, &
& -.8299E+00,-.2650E+00, .8584E+00, .2062E+01, .3141E+01, .4168E+01, &
& -.1269E+02,-.7900E+01,-.4956E+01,-.3205E+01,-.2065E+01,-.1332E+01, &
& -.6415E+00,-.7921E-01, .1170E+01, .2269E+01, .3198E+01, .4066E+01, &
& -.1227E+02,-.7536E+01,-.4576E+01,-.2859E+01,-.1815E+01,-.1139E+01, &
& -.4520E+00, .2272E+00, .1371E+01, .2351E+01, .3150E+01, .3935E+01, &
& -.1186E+02,-.7159E+01,-.4223E+01,-.2538E+01,-.1619E+01,-.9324E+00, &
& -.1566E+00, .5151E+00, .1520E+01, .2339E+01, .3132E+01, .3880E+01, &
& -.1120E+02,-.6777E+01,-.3919E+01,-.2330E+01,-.1387E+01,-.6737E+00, &
& .1108E+00, .6991E+00, .1531E+01, .2163E+01, .3150E+01, .3767E+01, &
& -.9973E+01,-.6279E+01,-.3638E+01,-.2048E+01,-.1098E+01,-.4407E+00, &
& .3043E+00, .7797E+00, .1424E+01, .2002E+01, .3122E+01, .3611E+01, &
& -.8483E+01,-.5607E+01,-.3357E+01,-.1744E+01,-.8884E+00,-.2264E+00, &
& .3800E+00, .7504E+00, .1245E+01, .2032E+01, .3097E+01, .3546E+01, &
& .3762E-01, .2372E-01, .1643E-01, .1208E-01, .1170E-01, .1164E-01, &
& .1214E-01, .1161E-01, .1028E-01, .9185E-02, .7712E-02, .1001E-01, &
& .3762E-01, .2382E-01, .1593E-01, .1145E-01, .1059E-01, .1049E-01, &
& .1080E-01, .1057E-01, .8894E-02, .7807E-02, .7132E-02, .1032E-01, &
& .3764E-01, .2386E-01, .1555E-01, .1080E-01, .9692E-02, .9231E-02, &
& .9585E-02, .9644E-02, .7711E-02, .6443E-02, .6223E-02, .9922E-02, &
& .3764E-01, .2395E-01, .1516E-01, .1028E-01, .8917E-02, .8415E-02, &
& .8457E-02, .8777E-02, .6436E-02, .5428E-02, .5499E-02, .8017E-02, &
& .3768E-01, .2399E-01, .1482E-01, .9692E-02, .8247E-02, .7640E-02, &
& .7582E-02, .7783E-02, .5432E-02, .4482E-02, .4919E-02, .5903E-02, &
& .3770E-01, .2401E-01, .1449E-01, .9252E-02, .7620E-02, .6678E-02, &
& .6845E-02, .6925E-02, .4939E-02, .3471E-02, .4124E-02, .3873E-02, &
& .3776E-01, .2395E-01, .1419E-01, .8959E-02, .7096E-02, .6184E-02, &
& .6110E-02, .6075E-02, .4419E-02, .2891E-02, .3056E-02, .1214E-02, &
& .3780E-01, .2391E-01, .1392E-01, .8687E-02, .6573E-02, .5733E-02, &
& .5359E-02, .5009E-02, .4034E-02, .2755E-02, .1968E-02,-.4187E-04, &
& .3791E-01, .2382E-01, .1373E-01, .8561E-02, .6060E-02, .5120E-02, &
& .4618E-02, .4713E-02, .3965E-02, .2481E-02, .8164E-03,-.1088E-02, &
& .3843E-01, .2148E-01, .1302E-01, .6384E-02, .5256E-02, .4260E-02, &
& .4077E-02, .4181E-02, .4132E-02, .2135E-02,-.2931E-03,-.1151E-02, &
& .3896E-01, .2081E-01, .1097E-01, .5568E-02, .4475E-02, .3795E-02, &
& .3828E-02, .3996E-02, .3766E-02, .1193E-02,-.1089E-02,-.9420E-03, &
& .3973E-01, .2024E-01, .9943E-02, .4815E-02, .3820E-02, .3663E-02, &
& .3568E-02, .3881E-02, .2859E-02, .6698E-03,-.1549E-02,-.6280E-03, &
& .3635E-01, .1963E-01, .1061E-01, .3812E-02, .3509E-02, .3429E-02, &
& .3693E-02, .3316E-02, .1120E-02, .6552E-03,-.1193E-02,-.1109E-02, &
& .3631E-01, .1893E-01, .1056E-01, .3172E-02, .3378E-02, .3164E-02, &
& .2751E-02, .1722E-02, .1112E-02, .4354E-03,-.7327E-03,-.1319E-02, &
& .3500E-01, .1828E-01, .1050E-01, .2831E-02, .2784E-02, .2564E-02, &
& .1469E-02, .7739E-03, .1209E-02, .7913E-03,-.2512E-03,-.1758E-02, &
& .3352E-01, .1763E-01, .1045E-01, .2401E-02, .1928E-02, .1340E-02, &
& .3753E-03, .5794E-03, .9060E-03, .1042E-02, .1465E-03,-.2533E-02, &
& .2880E-01, .1729E-01, .1077E-01, .1347E-02, .1194E-02,-.1191E-03, &
& .2828E-03, .6606E-03, .9743E-03, .1002E-02, .0000E+00,-.3140E-02, &
& .2040E-01, .1585E-01, .1165E-01, .3871E-05, .1509E-04,-.1046E-02, &
& .2444E-03, .4359E-03, .1041E-02, .2429E-02,-.1721E-03,-.2786E-02, &
& .1737E-01, .1560E-01, .1240E-01,-.2139E-03,-.1025E-02,-.1248E-02, &
& -.6934E-04, .1649E-03, .4062E-03, .1554E-02,-.4179E-03,-.7795E-03/
data ( ( ( coehca_15(k,j,i), i = 1, 12 ), j = 1, 19 ), k = 3, 3 ) / &
& -.1488E-03,-.9248E-04,-.2322E-04,-.4187E-05, .1104E-04, .9895E-05, &
& -.2283E-05, .2512E-05,-.9058E-05, .8449E-05, .8297E-05,-.3882E-04, &
& -.1488E-03,-.9058E-04,-.2398E-04,-.5709E-05, .1218E-04, .1180E-04, &
& .1522E-05, .6927E-05,-.1161E-04, .1714E-04,-.4948E-06,-.3540E-04, &
& -.1500E-03,-.8830E-04,-.2474E-04,-.8373E-05, .6470E-05, .7992E-05, &
& .9096E-05, .6737E-05,-.1485E-04, .1873E-04,-.4948E-06,-.4491E-04, &
& -.1500E-03,-.8601E-04,-.2664E-04,-.1028E-04, .6851E-05, .6851E-05, &
& .1294E-04,-.2550E-05,-.1520E-04, .2310E-04, .4948E-06,-.2017E-04, &
& -.1507E-03,-.8373E-04,-.2664E-04,-.1256E-04, .4567E-05, .1028E-04, &
& .9210E-05,-.2131E-05,-.6995E-05, .7498E-05,-.1104E-04,-.2284E-05, &
& -.1519E-03,-.8183E-04,-.2816E-04,-.1142E-04, .7611E-06, .7231E-05, &
& .1751E-05,-.7612E-06, .8312E-05, .2436E-05,-.7231E-05, .2398E-04, &
& -.1530E-03,-.7992E-04,-.2893E-04,-.9896E-05, .3806E-06, .8906E-05, &
& .3159E-05,-.5328E-05, .3692E-05,-.2093E-05,-.6851E-05,-.3045E-05, &
& -.1538E-03,-.7536E-04,-.3007E-04,-.8754E-05,-.3045E-05, .5138E-05, &
& .9134E-06,-.1979E-06, .1560E-05,-.1507E-04, .2284E-04, .9895E-05, &
& -.1541E-03,-.7688E-04,-.2969E-04,-.5709E-05,-.3996E-05, .1142E-05, &
& -.8373E-06, .1235E-04,-.7079E-05,-.6737E-05, .1028E-04, .3578E-04, &
& -.1560E-03,-.6851E-04,-.1903E-04,-.4187E-05,-.4605E-05,-.1142E-06, &
& .3878E-05, .3597E-05,-.9591E-05, .5328E-05, .7612E-05,-.4948E-05, &
& -.1587E-03,-.6546E-04,-.2740E-04,-.7612E-06,-.3578E-05, .1713E-05, &
& .6064E-05,-.9781E-05, .1408E-05, .5709E-05, .8373E-05,-.1256E-04, &
& -.1484E-03,-.5823E-04,-.4301E-04,-.1522E-05, .7498E-05,-.5328E-06, &
& -.7855E-05,-.1599E-05, .1964E-04,-.2284E-05, .7882E-10, .5328E-05, &
& -.1238E-03,-.5700E-04,-.5266E-04, .3286E-05, .4910E-05,-.8602E-05, &
& .6090E-06, .8454E-05, .1256E-05,-.4072E-05,-.1903E-05, .6470E-05, &
& -.1155E-03,-.5231E-04,-.4396E-04, .3626E-05,-.7051E-05,-.1743E-05, &
& .9667E-05, .2064E-04,-.2778E-05,-.6546E-05,-.4948E-05, .1903E-05, &
& -.1024E-03,-.5129E-04,-.4506E-04, .7943E-06, .3074E-06, .3243E-05, &
& .2754E-04,-.1479E-05, .1661E-05,-.2969E-05,-.1066E-04, .7612E-06, &
& -.8473E-04,-.5418E-04,-.4674E-04,-.3418E-05, .9460E-05, .1151E-04, &
& .5714E-05,-.1069E-04,-.2022E-05,-.9061E-05,-.1104E-04,-.3083E-04, &
& -.4283E-04,-.5037E-04,-.4476E-04, .1951E-04, .8922E-05, .1296E-04, &
& -.4053E-05,-.4355E-05,-.2355E-05,-.5004E-05,-.1218E-04,-.1522E-04, &
& .6411E-05,-.5937E-04,-.5331E-04, .1934E-04, .5284E-05, .1129E-04, &
& -.2166E-05,-.1484E-06,-.5407E-05,-.1364E-04,-.3115E-05, .3004E-04, &
& -.5074E-04,-.6256E-04,-.5097E-04, .2218E-04, .1228E-04,-.1160E-05, &
& -.1105E-05, .1618E-06,-.6089E-05,-.4216E-06,-.5314E-05, .7903E-05/
data ( ( ( coehcb_15(k,j,i), i = 1, 12 ), j = 1, 19 ), k = 1, 2 ) / &
& -.9593E+01,-.4078E+01,-.2812E+01,-.6506E+00,-.4123E+00, .2055E+01, &
& .4097E+01, .4671E+01, .4639E+01,-.4587E+02,-.4587E+02,-.4587E+02, &
& -.9276E+01,-.3757E+01,-.2467E+01,-.5784E+00, .8833E-01, .2232E+01, &
& .3826E+01, .4723E+01, .4942E+01, .5135E+01,-.4587E+02,-.4587E+02, &
& -.8968E+01,-.3508E+01,-.2116E+01,-.1363E+00, .1662E+00, .2424E+01, &
& .4220E+01, .4513E+01, .1375E+01, .4601E+01,-.4587E+02,-.4587E+02, &
& -.8662E+01,-.3164E+01,-.1722E+01, .5178E-01, .7288E+00, .2411E+01, &
& .3805E+01, .4766E+01, .4342E+01,-.4587E+02,-.4587E+02,-.4587E+02, &
& -.8292E+01,-.2799E+01,-.1359E+01, .3271E+00, .1650E+01, .2395E+01, &
& .4192E+01, .4758E+01, .2470E+01,-.4587E+02,-.4587E+02,-.4587E+02, &
& -.7812E+01,-.2404E+01,-.1085E+01, .7167E+00, .2202E+01, .2922E+01, &
& .4322E+01, .4591E+01, .4186E+01,-.4587E+02,-.4587E+02,-.4587E+02, &
& -.7441E+01,-.2066E+01,-.7142E+00, .1057E+01, .2524E+01, .2946E+01, &
& .4220E+01, .3607E+01,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
& -.7191E+01,-.1745E+01,-.3487E+00, .1453E+01, .2739E+01, .3660E+01, &
& .4114E+01, .3245E+01,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
& -.6895E+01,-.1326E+01,-.3500E+00, .1647E+01, .2899E+01, .4023E+01, &
& .3361E+01, .3360E+01,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
& -.5876E+01,-.9573E+00, .2014E+00, .2130E+01, .3493E+01, .4088E+01, &
& -.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
& -.4429E+01,-.3417E+00, .1204E+01, .2780E+01, .3843E+01, .3099E+01, &
& -.4587E+02, .3605E+01,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
& -.3122E+01, .2697E+00, .1866E+01, .3526E+01, .3569E+01, .1025E+01, &
& -.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
& -.2284E+01, .8186E+00, .2754E+01, .3206E+01, .3704E+01,-.4587E+02, &
& -.4587E+02, .4625E+01,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
& -.1711E+01, .1220E+01, .3248E+01,-.4587E+02, .2565E+01, .3297E+01, &
& -.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
& -.1758E+01, .7970E+00, .2758E+01, .2926E+01, .2613E+01, .1974E+01, &
& -.4587E+02, .2310E+01,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
& -.1737E+01, .3499E+00, .2246E+01, .2673E+01, .3308E+01, .3463E+01, &
& .3103E+01, .2611E+01, .2178E+01,-.4587E+02,-.4587E+02,-.4587E+02, &
& -.1559E+01, .2215E+00, .1875E+01, .2500E+01, .3346E+01, .3585E+01, &
& .3946E+01, .3533E+01, .3205E+01,-.4587E+02,-.4587E+02,-.4587E+02, &
& -.1601E+01, .5060E-01, .1275E+01, .2176E+01, .3081E+01, .3649E+01, &
& .3940E+01, .4106E+01, .4112E+01, .4349E+01, .2292E+01,-.4587E+02, &
& -.1222E+01, .3199E+00, .1642E+01, .2380E+01, .3254E+01, .3534E+01, &
& .3687E+01, .3717E+01, .3402E+01, .3868E+01,-.4587E+02,-.4587E+02, &
& .2967E-01, .1697E-01, .1795E-01, .1387E-01, .2032E-01, .1187E-01, &
& .2560E-01, .1044E-01,-.4560E+00, .3059E-02, .3059E-02, .3059E-02, &
& .2998E-01, .1586E-01, .1786E-01, .1521E-01, .1710E-01, .1061E-01, &
& .2030E-01, .1158E-01, .4452E+00, .3059E-02, .3059E-02, .3059E-02, &
& .2993E-01, .1551E-01, .1481E-01, .9846E-02, .2443E-01, .1150E-01, &
& .1865E-01, .1376E-01, .4617E+00, .3059E-02, .3059E-02, .3059E-02, &
& .3035E-01, .1417E-01, .1438E-01, .1511E-01, .1901E-01, .8582E-02, &
& .1746E-01, .1450E-01, .4523E+00, .3059E-02, .3059E-02, .3059E-02, &
& .2970E-01, .1347E-01, .1322E-01, .1252E-01, .1665E-01, .1037E-01, &
& .1320E-01, .1199E-01, .4436E+00, .3059E-02, .3059E-02, .3059E-02, &
& .2949E-01, .1291E-01, .1671E-01, .1111E-01, .1400E-01, .1318E-01, &
& .1060E-01, .1046E-01, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
& .3004E-01, .1300E-01, .1413E-01, .9085E-02, .9764E-02, .2260E-01, &
& .9778E-02, .4671E+00, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
& .3086E-01, .1436E-01, .1205E-01, .1081E-01, .4681E-02, .1479E-01, &
& .1888E-01, .3494E-01, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
& .3094E-01, .1500E-01, .1457E-01, .1060E-01, .8319E-02, .8983E-02, &
& .3791E-01, .2232E-01, .4631E+00, .3059E-02, .3059E-02, .3059E-02, &
& .3158E-01, .1585E-01, .1292E-01, .6531E-02, .1383E-01, .4605E+00, &
& .4662E+00, .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
& .3182E-01, .1586E-01, .8724E-02, .5798E-02, .2454E-01, .4607E+00, &
& .4560E+00, .4511E+00, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
& .2369E-01, .1606E-01, .5477E-02, .1228E-01, .4579E+00, .4561E+00, &
& .4497E+00, .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
& .2190E-01, .1779E-01, .6267E-02, .4535E+00, .4533E+00, .3059E-02, &
& .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
& .2100E-01, .1653E-01, .7449E-02, .4543E+00, .4472E+00, .4439E+00, &
& .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
& .1864E-01, .1771E-01, .7040E-02, .2877E-01, .3381E-01, .2691E-01, &
& .4466E+00, .3059E-02, .4613E+00, .3059E-02, .3059E-02, .3059E-02, &
& .1637E-01, .1641E-01, .8424E-02, .1318E-01, .2060E-01, .3426E-01, &
& .4122E-01, .4621E+00, .4555E+00, .4525E+00, .3059E-02, .3059E-02, &
& .1607E-01, .1452E-01, .8013E-02, .1213E-01, .1482E-01, .2125E-01, &
& .3379E-01, .3562E-01, .4619E+00, .4569E+00, .3059E-02, .3059E-02, &
& .1698E-01, .1538E-01, .6616E-02, .1147E-01, .1217E-01, .1696E-01, &
& .1871E-01, .2273E-01, .4513E-01, .4702E+00, .4617E+00, .4553E+00, &
& .1700E-01, .1547E-01, .6456E-02, .1324E-01, .1502E-01, .2095E-01, &
& .2547E-01, .2823E-01, .4107E-01, .4676E+00, .4583E+00, .4498E+00/
data ( ( ( coehcb_15(k,j,i), i = 1, 12 ), j = 1, 19 ), k = 3, 3 ) / &
& -.6747E-05,-.2483E-04, .6575E-04, .1026E-03, .3888E-03,-.8519E-04, &
& -.1629E-03,-.1808E-04,-.8355E-02,-.4656E-05,-.4656E-05,-.4656E-05, &
& -.2270E-04,-.3427E-04, .5118E-04, .1218E-03, .1245E-03,-.1245E-03, &
& .3841E-05,-.4151E-04,-.8763E-02,-.1687E-01,-.4656E-05,-.4656E-05, &
& -.4557E-04,-.3023E-04, .2286E-04, .5656E-04, .4113E-04,-.1407E-03, &
& -.1301E-03, .8503E-04,-.7284E-02,-.1669E-01,-.4656E-05,-.4656E-05, &
& -.5325E-04,-.5309E-04,-.1246E-04, .2244E-04, .5136E-04,-.1272E-03, &
& .4217E-04,-.1749E-04,-.8435E-02,-.4656E-05,-.4656E-05,-.4656E-05, &
& -.6857E-04,-.7217E-04, .1740E-05, .3653E-04,-.1490E-03,-.4090E-04, &
& -.2376E-04, .2047E-04,-.7974E-02,-.4656E-05,-.4656E-05,-.4656E-05, &
& -.1232E-03,-.9826E-04,-.2849E-04, .1703E-04,-.1895E-03,-.3363E-03, &
& .7102E-04,-.1838E-05,-.1655E-01,-.4656E-05,-.4656E-05,-.4656E-05, &
& -.9896E-04,-.5127E-04,-.2704E-04,-.1218E-04,-.1207E-03,-.5883E-04, &
& .6893E-04,-.7924E-02,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
& -.7837E-04,-.4980E-04, .6902E-05,-.1072E-03,-.4051E-04,-.1991E-05, &
& -.1173E-03,-.5195E-04,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
& -.8136E-04,-.8102E-04, .1254E-03,-.4658E-04, .3173E-04,-.4461E-05, &
& -.1558E-03,-.2036E-03, .8360E-02,-.4656E-05,-.4656E-05,-.4656E-05, &
& -.2232E-04,-.6411E-04, .9486E-04,-.2322E-03,-.8282E-04,-.8202E-02, &
& .8416E-02,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
& -.1398E-03,-.7165E-04,-.4258E-04,-.3970E-04,-.2839E-03,-.7873E-02, &
& .8231E-02,-.8213E-02,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
& -.6754E-04,-.7469E-04,-.6898E-04,-.1702E-03,-.8079E-02,-.7270E-02, &
& .8116E-02,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
& -.2396E-04,-.2361E-04,-.8664E-04,-.8038E-02,-.8207E-02,-.4656E-05, &
& -.4656E-05,-.1670E-01,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
& -.5479E-04,-.7593E-04,-.1005E-03, .8199E-02,-.7942E-02,-.8244E-02, &
& -.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
& -.3806E-04,-.5825E-04,-.1003E-03,-.2925E-03,-.1506E-03, .3148E-04, &
& .8060E-02,-.1593E-01, .8327E-02,-.4656E-05,-.4656E-05,-.4656E-05, &
& -.4706E-04,-.3630E-04,-.7811E-04,-.6881E-04,-.1822E-03,-.3091E-03, &
& -.3033E-03,-.7684E-02,-.7663E-02, .8167E-02,-.4656E-05,-.4656E-05, &
& -.7669E-04,-.4610E-04,-.8063E-04,-.7250E-04,-.1094E-03,-.1241E-03, &
& -.2944E-03,-.1736E-03,-.7886E-02, .8248E-02,-.4656E-05,-.4656E-05, &
& -.7138E-04,-.4545E-04,-.3653E-04,-.6075E-04,-.4528E-04,-.1077E-03, &
& -.1119E-03,-.1657E-03,-.4695E-03,-.8112E-02,-.7587E-02, .8217E-02, &
& -.6812E-04,-.4558E-04,-.6739E-04,-.8861E-04,-.9386E-04,-.1334E-03, &
& -.2007E-03,-.2179E-03,-.1650E-03,-.8001E-02, .8273E-02, .8118E-02/
! block data ckd16
!c *********************************************************************
!c hk is the interval in the g (cumulative probability) space from 0
!c to one. coeh2o is the coefficient to calculate the H2O absorption
!c coefficient in units of (cm-atm)**-1 at there temperatures, nine-
!c teen pressures, and seven cumulative probabilities ( Fu, 1991 ).
!c The spectral region is from 540 to 400 cm**-1.
!c *********************************************************************
! common /band16/ hk(7), coeh2o(3,19,7)
data hk_16 / .12, .24, .24, .20, .12, .06, .02 /
data ( ( ( coeh2o_16(k,j,i), i = 1, 7 ), j = 1, 19 ), k = 1, 3 ) / &
& -.2344E+02,-.2016E+02,-.1986E+02,-.1655E+02,-.1243E+02,-.8437E+01, &
& -.4858E+01,-.2298E+02,-.2014E+02,-.1984E+02,-.1609E+02,-.1198E+02, &
& -.8020E+01,-.4548E+01,-.2252E+02,-.2012E+02,-.1981E+02,-.1564E+02, &
& -.1153E+02,-.7596E+01,-.4239E+01,-.2206E+02,-.2009E+02,-.1957E+02, &
& -.1517E+02,-.1111E+02,-.7161E+01,-.3871E+01,-.2160E+02,-.2007E+02, &
& -.1911E+02,-.1472E+02,-.1065E+02,-.6721E+01,-.3479E+01,-.2113E+02, &
& -.2005E+02,-.1865E+02,-.1426E+02,-.1021E+02,-.6302E+01,-.3081E+01, &
& -.2067E+02,-.2003E+02,-.1819E+02,-.1379E+02,-.9765E+01,-.5883E+01, &
& -.2678E+01,-.2026E+02,-.2001E+02,-.1773E+02,-.1333E+02,-.9332E+01, &
& -.5443E+01,-.2253E+01,-.2024E+02,-.1999E+02,-.1727E+02,-.1288E+02, &
& -.8897E+01,-.5029E+01,-.1858E+01,-.2026E+02,-.1959E+02,-.1481E+02, &
& -.1147E+02,-.7477E+01,-.4555E+01,-.1464E+01,-.2022E+02,-.1632E+02, &
& -.1305E+02,-.9885E+01,-.6689E+01,-.4108E+01,-.1068E+01,-.1936E+02, &
& -.1438E+02,-.1163E+02,-.8499E+01,-.6146E+01,-.3673E+01,-.6816E+00, &
& -.1675E+02,-.1281E+02,-.1020E+02,-.7716E+01,-.5678E+01,-.3256E+01, &
& -.3125E+00,-.1510E+02,-.1124E+02,-.8821E+01,-.7140E+01,-.5243E+01, &
& -.2851E+01,-.2560E-01,-.1334E+02,-.9708E+01,-.8061E+01,-.6611E+01, &
& -.4842E+01,-.2459E+01, .1711E+00,-.1155E+02,-.8798E+01,-.7440E+01, &
& -.6123E+01,-.4439E+01,-.2089E+01, .2480E+00,-.1020E+02,-.8154E+01, &
& -.6945E+01,-.5681E+01,-.4055E+01,-.1737E+01, .2390E+00,-.9464E+01, &
& -.7677E+01,-.6512E+01,-.5284E+01,-.3707E+01,-.1453E+01, .2015E+00, &
& -.9033E+01,-.7246E+01,-.6093E+01,-.4882E+01,-.3346E+01,-.1264E+01, &
& .1033E+00, .4658E-01, .5840E-02, .4626E-02, .2688E-01, .2395E-01, &
& .1804E-01, .2074E-01, .4660E-01, .1884E-02, .8561E-02, .2690E-01, &
& .2403E-01, .1788E-01, .1934E-01, .4660E-01, .1800E-02, .1252E-01, &
& .2694E-01, .2393E-01, .1786E-01, .1825E-01, .4660E-01, .1779E-02, &
& .1649E-01, .2696E-01, .2397E-01, .1779E-01, .1765E-01, .4348E-01, &
& .1758E-02, .2043E-01, .2696E-01, .2393E-01, .1748E-01, .1675E-01, &
& .3944E-01, .1737E-02, .2445E-01, .2698E-01, .2384E-01, .1752E-01, &
& .1549E-01, .3538E-01, .1654E-02, .2847E-01, .2702E-01, .2384E-01, &
& .1714E-01, .1565E-01, .3127E-01, .1570E-02, .3245E-01, .2705E-01, &
& .2374E-01, .1712E-01, .1514E-01, .2715E-01, .1444E-02, .3540E-01, &
& .2711E-01, .2363E-01, .1702E-01, .1446E-01, .2960E-01, .1760E-01, &
& .2977E-01, .2397E-01, .2087E-01, .1618E-01, .1445E-01, .2466E-01, &
& .3039E-01, .2428E-01, .2217E-01, .1821E-01, .1593E-01, .1463E-01, &
& .2640E-01, .2545E-01, .2231E-01, .2060E-01, .1773E-01, .1555E-01, &
& .1473E-01, .3456E-01, .2135E-01, .2030E-01, .1844E-01, .1740E-01, &
& .1559E-01, .1428E-01, .3203E-01, .2047E-01, .1809E-01, .1760E-01, &
& .1725E-01, .1545E-01, .1541E-01, .2137E-01, .1857E-01, .1616E-01, &
& .1698E-01, .1700E-01, .1537E-01, .1636E-01, .1338E-01, .1518E-01, &
& .1580E-01, .1658E-01, .1710E-01, .1518E-01, .1513E-01, .1570E-01, &
& .1614E-01, .1603E-01, .1673E-01, .1706E-01, .1497E-01, .1439E-01, &
& .1987E-01, .1731E-01, .1601E-01, .1675E-01, .1681E-01, .1535E-01, &
& .1425E-01, .2018E-01, .1723E-01, .1597E-01, .1691E-01, .1666E-01, &
& .1509E-01, .1446E-01,-.2873E-03,-.8031E-04, .4225E-04,-.9287E-04, &
& -.6013E-04,-.4339E-04,-.2474E-04,-.2862E-03,-.8372E-05, .1146E-03, &
& -.9248E-04,-.6166E-04,-.3882E-04,-.1827E-04,-.2870E-03,-.6851E-05, &
& .1865E-03,-.9172E-04,-.6128E-04,-.3616E-04,-.7612E-05,-.2877E-03, &
& -.7231E-05, .1880E-03,-.9287E-04,-.5671E-04,-.4110E-04,-.1104E-04, &
& -.3429E-03,-.7612E-05, .1149E-03,-.9287E-04,-.6356E-04,-.4529E-04, &
& -.2436E-04,-.4187E-03,-.7992E-05, .4339E-04,-.9325E-04,-.6280E-04, &
& -.4225E-04,-.3197E-04,-.4925E-03,-.8754E-05,-.2740E-04,-.9477E-04, &
& -.6432E-04,-.3768E-04,-.3361E-04,-.5511E-03,-.8753E-05,-.9972E-04, &
& -.9515E-04,-.6394E-04,-.3806E-04,-.3787E-04,-.4792E-03,-.1028E-04, &
& -.1534E-03,-.9477E-04,-.6356E-04,-.3616E-04,-.2923E-04,-.5070E-03, &
& .1922E-03,-.1028E-03,-.5823E-04,-.7954E-04,-.2550E-04,-.3893E-04, &
& -.3776E-03,-.1043E-03,-.7993E-04,-.7422E-04,-.4948E-04,-.3007E-04, &
& -.3863E-04, .8335E-04,-.5709E-04,-.6090E-04,-.7840E-04,-.3692E-04, &
& -.3007E-04,-.4251E-04,-.6204E-04,-.4872E-04,-.3806E-04,-.4681E-04, &
& -.3463E-04,-.3007E-04,-.4312E-04,-.1142E-04,-.5176E-04,-.5024E-04, &
& -.3007E-04,-.3730E-04,-.3037E-04,-.3888E-04, .2550E-04,-.6508E-04, &
& -.2512E-04,-.3083E-04,-.3197E-04,-.3041E-04,-.3750E-04, .1484E-04, &
& -.1941E-04,-.2626E-04,-.3349E-04,-.3463E-04,-.2896E-04,-.1716E-04, &
& -.7231E-04,-.3920E-04,-.2893E-04,-.3540E-04,-.3311E-04,-.3734E-04, &
& -.2550E-05,-.7650E-04,-.3159E-04,-.2778E-04,-.3121E-04,-.2169E-04, &
& -.4365E-04,-.1546E-04,-.7916E-04,-.2931E-04,-.2854E-04,-.3654E-04, &
& -.1979E-04,-.4811E-04,-.1435E-04/
! block data ckd17
!c *********************************************************************
!c hk is the interval in the g (cumulative probability) space from 0
!c to one. coeh2o is the coefficient to calculate the H2O absorption
!c coefficient in units of (cm-atm)**-1 at there temperatures, nine-
!c teen pressures, and seven cumulative probabilities ( Fu, 1991 ).
!c The spectral region is from 400 to 280 cm**-1.
!c *********************************************************************
! common /band17/ hk(7), coeh2o(3,19,7)
data hk_17 / .12, .26, .22, .20, .10, .085, .015 /
data ( ( ( coeh2o_17(k,j,i), i = 1, 7 ), j = 1, 19 ), k = 1, 3 ) / &
& -.2255E+02,-.2000E+02,-.1703E+02,-.1282E+02,-.9215E+01,-.5938E+01, &
& -.2009E+01,-.2209E+02,-.1997E+02,-.1657E+02,-.1236E+02,-.8764E+01, &
& -.5499E+01,-.1582E+01,-.2163E+02,-.1993E+02,-.1611E+02,-.1191E+02, &
& -.8324E+01,-.5061E+01,-.1170E+01,-.2117E+02,-.1990E+02,-.1565E+02, &
& -.1146E+02,-.7889E+01,-.4631E+01,-.7737E+00,-.2071E+02,-.1987E+02, &
& -.1519E+02,-.1100E+02,-.7440E+01,-.4179E+01,-.3719E+00,-.2026E+02, &
& -.1985E+02,-.1473E+02,-.1054E+02,-.6995E+01,-.3721E+01, .0000E+00, &
& -.2024E+02,-.1982E+02,-.1426E+02,-.1009E+02,-.6549E+01,-.3284E+01, &
& .4053E+00,-.2022E+02,-.1980E+02,-.1381E+02,-.9639E+01,-.6097E+01, &
& -.2821E+01, .8375E+00,-.2021E+02,-.1933E+02,-.1335E+02,-.9187E+01, &
& -.5653E+01,-.2379E+01, .1272E+01,-.2010E+02,-.1503E+02,-.1125E+02, &
& -.7665E+01,-.4492E+01,-.1893E+01, .1642E+01,-.1747E+02,-.1278E+02, &
& -.9547E+01,-.6120E+01,-.3756E+01,-.1443E+01, .1995E+01,-.1529E+02, &
& -.1095E+02,-.8107E+01,-.5036E+01,-.3182E+01,-.1032E+01, .2429E+01, &
& -.1370E+02,-.9303E+01,-.6691E+01,-.4357E+01,-.2683E+01,-.6173E+00, &
& .2805E+01,-.1150E+02,-.7859E+01,-.5618E+01,-.3843E+01,-.2234E+01, &
& -.2171E+00, .2973E+01,-.9590E+01,-.6537E+01,-.4886E+01,-.3355E+01, &
& -.1805E+01, .1615E+00, .3157E+01,-.7530E+01,-.5699E+01,-.4306E+01, &
& -.2892E+01,-.1388E+01, .5448E+00, .3155E+01,-.6758E+01,-.5112E+01, &
& -.3809E+01,-.2464E+01,-.9947E+00, .8713E+00, .3203E+01,-.6245E+01, &
& -.4610E+01,-.3376E+01,-.2058E+01,-.6166E+00, .1073E+01, .3109E+01, &
& -.5777E+01,-.4175E+01,-.2963E+01,-.1671E+01,-.2556E+00, .1241E+01, &
& .3014E+01, .4264E-01, .1968E-02, .1863E-01, .1436E-01, .1101E-01, &
& .1055E-01, .1281E-01, .4264E-01, .1989E-02, .1861E-01, .1438E-01, &
& .1095E-01, .1030E-01, .1211E-01, .3996E-01, .1968E-02, .1861E-01, &
& .1434E-01, .1103E-01, .1019E-01, .1160E-01, .3600E-01, .1947E-02, &
& .1861E-01, .1442E-01, .1086E-01, .1003E-01, .1157E-01, .3203E-01, &
& .5756E-02, .1861E-01, .1444E-01, .1080E-01, .9922E-02, .1151E-01, &
& .2801E-01, .9713E-02, .1859E-01, .1446E-01, .1070E-01, .9880E-02, &
& .1066E-01, .2393E-01, .1369E-01, .1859E-01, .1451E-01, .1057E-01, &
& .9880E-02, .1072E-01, .1987E-01, .1767E-01, .1863E-01, .1451E-01, &
& .1040E-01, .9880E-02, .1057E-01, .1572E-01, .2169E-01, .1863E-01, &
& .1442E-01, .1022E-01, .9742E-02, .1036E-01, .3391E-02, .1884E-01, &
& .1566E-01, .1105E-01, .1011E-01, .1001E-01, .1017E-01, .1982E-01, &
& .1444E-01, .1189E-01, .1030E-01, .9859E-02, .9861E-02, .1038E-01, &
& .1748E-01, .1321E-01, .9922E-02, .1068E-01, .1013E-01, .9937E-02, &
& .9958E-02, .1346E-01, .9943E-02, .9566E-02, .1097E-01, .9815E-02, &
& .9964E-02, .1059E-01, .9817E-02, .7159E-02, .8687E-02, .1114E-01, &
& .1007E-01, .1014E-01, .1058E-01, .3370E-02, .7264E-02, .9378E-02, &
& .1112E-01, .9767E-02, .1016E-01, .1101E-01, .2993E-02, .8017E-02, &
& .9566E-02, .1116E-01, .9738E-02, .1025E-01, .1086E-01, .8331E-02, &
& .8771E-02, .1001E-01, .1117E-01, .9847E-02, .1076E-01, .1084E-01, &
& .7850E-02, .9378E-02, .1001E-01, .1105E-01, .9964E-02, .1113E-01, &
& .1168E-01, .8038E-02, .9336E-02, .9817E-02, .1096E-01, .1024E-01, &
& .1175E-01, .1107E-01,-.2188E-03,-.2283E-05,-.8069E-04,-.4415E-04, &
& -.2284E-04,-.4491E-04,-.4518E-04,-.2196E-03,-.2665E-05,-.8107E-04, &
& -.4301E-04,-.2398E-04,-.4795E-04,-.4693E-04,-.2683E-03,-.3045E-05, &
& -.8107E-04,-.4301E-04,-.2246E-04,-.4757E-04,-.4152E-04,-.3403E-03, &
& -.4187E-05,-.8031E-04,-.3996E-04,-.1865E-04,-.4301E-04,-.4350E-04, &
& -.4118E-03, .6584E-04,-.8107E-04,-.4034E-04,-.1903E-04,-.4643E-04, &
& -.4834E-04,-.4803E-03, .1378E-03,-.8069E-04,-.4072E-04,-.1713E-04, &
& -.5176E-04,-.3460E-04,-.4099E-03, .2101E-03,-.8069E-04,-.3920E-04, &
& -.1713E-04,-.5024E-04,-.3524E-04,-.3391E-03, .2809E-03,-.7992E-04, &
& -.3616E-04,-.2017E-04,-.5633E-04,-.4886E-04,-.2668E-03, .2078E-03, &
& -.8069E-04,-.3768E-04,-.2131E-04,-.5580E-04,-.5454E-04,-.2207E-04, &
& -.8601E-04,-.4643E-04,-.2436E-04,-.4148E-04,-.5458E-04,-.4579E-04, &
& -.5138E-04,-.2893E-04,-.3273E-04,-.3882E-04,-.3920E-04,-.5035E-04, &
& -.3170E-04,-.2169E-04,-.3007E-04,-.2740E-04,-.5328E-04,-.4491E-04, &
& -.4403E-04,-.6383E-04, .4834E-04,-.2702E-04,-.4453E-04,-.4339E-04, &
& -.4457E-04,-.4551E-04,-.8133E-04, .3768E-04,-.7611E-06,-.2626E-04, &
& -.4643E-04,-.4305E-04,-.4840E-04,-.5149E-04, .7193E-04,-.2169E-04, &
& -.4491E-04,-.3996E-04,-.4483E-04,-.4487E-04,-.6698E-04,-.4834E-04, &
& -.3463E-04,-.4986E-04,-.4377E-04,-.4514E-04,-.5377E-04,-.2626E-04, &
& -.4187E-04,-.3692E-04,-.5100E-04,-.4651E-04,-.4392E-04,-.5386E-04, &
& -.4643E-04,-.4301E-04,-.3578E-04,-.5176E-04,-.4594E-04,-.4551E-04, &
& -.3920E-04,-.3425E-04,-.4491E-04,-.3654E-04,-.5138E-04,-.4377E-04, &
& -.5614E-04,-.5758E-04,-.3600E-04/
! block data ckd18
!c *********************************************************************
!c hk is the interval in the g (cumulative probability) space from 0
!c to one. coeh2o is the coefficient to calculate the H2O absorption
!c coefficient in units of (cm-atm)**-1 at there temperatures, nine-
!c teen pressures, and eight cumulative probabilities ( Fu, 1991 ).
!c The spectral region is from 280 to 0 cm**-1.
!c *********************************************************************
! common /band18/ hk(8), coeh2o(3,19,8)
data hk_18 / .07, .1, .2, .25, .2, .1, .03, .02 /
data ( ( ( coeh2o_18(k,j,i), i = 1, 8 ), j = 1, 19 ), k = 1, 3 ) / &
& -.2121E+02,-.2002E+02,-.1676E+02,-.1274E+02,-.8780E+01,-.5167E+01, &
& -.2692E+01,-.6275E+00,-.2075E+02,-.1996E+02,-.1630E+02,-.1228E+02, &
& -.8324E+01,-.4718E+01,-.2260E+01,-.2303E+00,-.2029E+02,-.1990E+02, &
& -.1584E+02,-.1182E+02,-.7868E+01,-.4269E+01,-.1806E+01, .1645E+00, &
& -.2022E+02,-.1985E+02,-.1538E+02,-.1136E+02,-.7417E+01,-.3820E+01, &
& -.1373E+01, .5657E+00,-.2018E+02,-.1981E+02,-.1492E+02,-.1090E+02, &
& -.6965E+01,-.3369E+01,-.9319E+00, .9577E+00,-.2013E+02,-.1937E+02, &
& -.1446E+02,-.1044E+02,-.6512E+01,-.2917E+01,-.4928E+00, .1376E+01, &
& -.2009E+02,-.1891E+02,-.1400E+02,-.9984E+01,-.6063E+01,-.2466E+01, &
& -.6887E-01, .1768E+01,-.2006E+02,-.1845E+02,-.1354E+02,-.9530E+01, &
& -.5618E+01,-.2024E+01, .3615E+00, .2196E+01,-.2003E+02,-.1800E+02, &
& -.1308E+02,-.9075E+01,-.5174E+01,-.1593E+01, .7820E+00, .2600E+01, &
& -.1827E+02,-.1464E+02,-.1097E+02,-.7525E+01,-.3733E+01,-.1077E+01, &
& .1204E+01, .3014E+01,-.1525E+02,-.1210E+02,-.9275E+01,-.5876E+01, &
& -.2768E+01,-.6286E+00, .1622E+01, .3394E+01,-.1298E+02,-.1060E+02, &
& -.7764E+01,-.4462E+01,-.2154E+01,-.2001E+00, .2034E+01, .3756E+01, &
& -.1157E+02,-.8941E+01,-.5984E+01,-.3509E+01,-.1651E+01, .2279E+00, &
& .2422E+01, .4066E+01,-.9986E+01,-.7062E+01,-.4794E+01,-.2818E+01, &
& -.1196E+01, .6394E+00, .2791E+01, .4283E+01,-.8064E+01,-.5512E+01, &
& -.3933E+01,-.2274E+01,-.7559E+00, .1036E+01, .3085E+01, .4444E+01, &
& -.6440E+01,-.4863E+01,-.3219E+01,-.1791E+01,-.3279E+00, .1427E+01, &
& .3304E+01, .4527E+01,-.5902E+01,-.4207E+01,-.2756E+01,-.1350E+01, &
& .7686E-01, .1776E+01, .3475E+01, .4550E+01,-.5439E+01,-.3739E+01, &
& -.2330E+01,-.9233E+00, .4612E+00, .2066E+01, .3564E+01, .4502E+01, &
& -.5006E+01,-.3316E+01,-.1906E+01,-.5066E+00, .8352E+00, .2272E+01, &
& .3587E+01, .4419E+01, .2338E-01, .1968E-02, .9503E-02, .3412E-02, &
& .6280E-03,-.1109E-02,-.1089E-02,-.1026E-02, .1972E-01, .2093E-02, &
& .9503E-02, .3391E-02, .6489E-03,-.1172E-02,-.1164E-02,-.1158E-02, &
& .1603E-01, .3328E-02, .9524E-02, .3391E-02, .6489E-03,-.1277E-02, &
& -.1229E-02,-.1296E-02, .1229E-01, .7138E-02, .9524E-02, .3370E-02, &
& .6070E-03,-.1319E-02,-.1264E-02,-.1610E-02, .8478E-02, .1095E-01, &
& .9566E-02, .3412E-02, .5652E-03,-.1382E-02,-.1266E-02,-.1566E-02, &
& .4563E-02, .1480E-01, .9566E-02, .3412E-02, .5443E-03,-.1423E-02, &
& -.1199E-02,-.1679E-02, .2261E-02, .1865E-01, .9608E-02, .3454E-02, &
& .4815E-03,-.1423E-02,-.1296E-02,-.1555E-02, .2198E-02, .2250E-01, &
& .9671E-02, .3412E-02, .4187E-03,-.1426E-02,-.1472E-02,-.1800E-02, &
& .2072E-02, .2600E-01, .9734E-02, .3433E-02, .3977E-03,-.1428E-02, &
& -.1541E-02,-.1591E-02, .1987E-01, .8645E-02, .6280E-02, .1298E-02, &
& -.1151E-02,-.1509E-02,-.1662E-02,-.1570E-02, .4668E-02, .8373E-02, &
& .3956E-02,-.4187E-04,-.1968E-02,-.1624E-02,-.1700E-02,-.1947E-02, &
& .9231E-02, .5694E-02, .1444E-02,-.2512E-03,-.1827E-02,-.1662E-02, &
& -.1576E-02,-.1633E-02, .8666E-02, .3077E-02,-.1737E-02,-.1277E-02, &
& -.1507E-02,-.1757E-02,-.1612E-02,-.1612E-02, .8164E-03,-.4375E-02, &
& -.1884E-02,-.1277E-02,-.1564E-02,-.1853E-02,-.1591E-02,-.1486E-02, &
& -.1486E-02,-.2596E-02,-.1633E-02,-.1539E-02,-.1662E-02,-.1846E-02, &
& -.1423E-02,-.1277E-02,-.1423E-02,-.2617E-02,-.1005E-02,-.1379E-02, &
& -.1687E-02,-.1905E-02,-.1528E-02,-.1298E-02,-.1675E-03,-.1947E-02, &
& -.5024E-03,-.1325E-02,-.1696E-02,-.1698E-02,-.1486E-02,-.1277E-02, &
& .1047E-03,-.1109E-02,-.5861E-03,-.1363E-02,-.1620E-02,-.1666E-02, &
& -.1507E-02,-.9210E-03, .1047E-03,-.1047E-02,-.8394E-03,-.1342E-02, &
& -.1591E-02,-.1323E-02,-.1340E-02,-.9420E-03,-.1085E-03, .2283E-05, &
& -.4719E-04,-.3807E-06,-.1522E-05,-.3425E-05,-.7612E-06, .1751E-05, &
& -.1766E-03, .1523E-05,-.4719E-04,-.7609E-06,-.3807E-06,-.3045E-05, &
& .1599E-05, .8723E-05,-.2443E-03, .1941E-04,-.4757E-04,-.1522E-05, &
& -.3806E-06,-.1903E-05,-.2778E-05, .1294E-04,-.1838E-03, .8563E-04, &
& -.4757E-04,-.1903E-05, .1142E-05,-.2664E-05,-.6090E-06, .1321E-04, &
& -.1161E-03, .1526E-03,-.4757E-04,-.2664E-05,-.3805E-06,-.3806E-05, &
& -.2093E-05, .2253E-04,-.4795E-04, .9248E-04,-.4757E-04,-.1903E-05, &
& .0000E+00,-.3045E-05,-.7992E-06, .1393E-04,-.9134E-05, .2246E-04, &
& -.4834E-04,-.2664E-05, .3804E-06,-.5328E-05,-.1510E-05, .1465E-04, &
& -.1028E-04,-.4757E-04,-.4948E-04,-.1142E-05, .7614E-06,-.4910E-05, &
& -.5709E-06, .1477E-04,-.1256E-04,-.1066E-03,-.4910E-04,-.1523E-05, &
& -.3805E-06,-.3121E-05,-.2512E-05, .1142E-04,-.7878E-04,-.2664E-05, &
& -.8373E-05,-.7612E-06, .1104E-04,-.3311E-05,-.1979E-05, .5709E-05, &
& -.2626E-04,-.4872E-04,-.3808E-06,-.2283E-05, .2284E-05,-.3349E-05, &
& -.4034E-05, .7231E-05,-.4910E-04, .1599E-04, .1256E-04,-.7612E-05, &
& .1180E-05,-.1815E-05,-.7193E-05, .3045E-05, .1576E-09, .6470E-05, &
& -.1408E-04,-.1903E-05, .1522E-05,-.4746E-05,-.4948E-05, .3806E-06, &
& .9020E-04, .5214E-04, .6090E-05,-.1104E-04, .1180E-05,-.2778E-05, &
& -.6090E-05,-.2664E-05,-.6737E-04,-.1218E-04,-.3806E-05,-.5214E-05, &
& -.1066E-05,-.1294E-05,-.3045E-05,-.2664E-05,-.4643E-04, .1713E-04, &
& -.1218E-04,-.6204E-05,-.2360E-05,-.1979E-05,-.1903E-05,-.3806E-05, &
& -.3045E-04,-.1256E-04,-.9134E-05,-.6508E-05,-.1027E-05,-.7993E-06, &
& -.1142E-05,-.7992E-05,-.3616E-04,-.1028E-04,-.1066E-04,-.6051E-05, &
& .1066E-05,-.1751E-05,-.2284E-05,-.2284E-05,-.3920E-04,-.9895E-05, &
& -.1321E-04,-.3844E-05,-.2055E-05,-.2512E-05,-.3806E-05,-.3425E-05/
end module band
!c pgwc(nv) aerosol concentration ( # / m ** 3 )
!c---------- 4/1/97 (7) -- NEXT 1142 LINES -- Replaces old
!c aerosol1,aerosol2 block data.
! block data aerosol1
module aerosol1 1,1
!c 4/1/97
!c ********************************************************************
!c
!c mb: Number of bands in code (will always be 18)
!c naer: Number of aerosol types (will need to be changed here AND in
!c aerosol subroutine.
!c nrh: Number of different relative humidities (currently 8)
!c
!c Optical properties are dimensioned (18,8,naer): Number of bands, &
!c number of relative humidities, and number of aerosol types.
!c Properties for ocean, continental, and urban were extracted from
!c tables and interpolated (energy-weighted) into the Fu-Liou
!c spectral bands. Tegen and Lacis values are not RH-dependent,
!c so values are repeated.
!c
!c a_ssa: single-scattering albedo. One data statement for EACH type
!c of aerosol.
!c
!c a_ext: extinction coefficient. Normalization is not important.
!c These values are used for spectral weighting only!! One
!c data statement for EACH type of aerosol.
!c
!c a_asy: Asymmetry parameter.One data statement for EACH type of
!c aerosol.
!c
!c ********************************************************************
!c USE RadParams
!# include "para.file"
USE PARA_FILE
!c include 'para.file'
implicit none
!c## include 'rad_0698.h'
integer, private :: i,j
!c# real a_ssax(mbx,nrh,naer),a_extx(mbx,nrh,naer)
!c# real a_asyx(mbx,nrh,naer)
! common /aer_optx/ a_ssax,a_extx,a_asyx
real a_ssax(mbx,nrh,naer),a_extx(mbx,nrh,naer)
real a_asyx(mbx,nrh,naer)
!c *******************************************
!c Data statements for aerosol type 1 (marine)
!c *******************************************
data ((a_ssax(i,j,1),i=1,mbx),j=1,nrh) / &
& .1000E+01,.9984E+00,.9525E+00,.9053E+00,.7378E+00,.8873E+00, &
& .8528E+00,.8678E+00,.6329E+00,.7734E+00,.7571E+00,.7446E+00, &
& .5500E+00,.3973E+00,.4265E+00,.4511E+00,.4341E+00,.3346E+00, &
& .1000E+01,.9974E+00,.9586E+00,.9109E+00,.7298E+00,.8807E+00, &
& .8421E+00,.8447E+00,.6212E+00,.7637E+00,.7352E+00,.7322E+00, &
& .5276E+00,.3942E+00,.4226E+00,.4474E+00,.4344E+00,.3404E+00, &
& .1000E+01,.9980E+00,.9691E+00,.9182E+00,.7075E+00,.8584E+00, &
& .8072E+00,.8201E+00,.5870E+00,.7255E+00,.6977E+00,.6968E+00, &
& .4866E+00,.3946E+00,.4212E+00,.4429E+00,.4396E+00,.3688E+00, &
& .1000E+01,.9988E+00,.9820E+00,.9212E+00,.6840E+00,.8189E+00, &
& .7384E+00,.7583E+00,.5412E+00,.6484E+00,.6295E+00,.6340E+00, &
& .4620E+00,.4177E+00,.4341E+00,.4484E+00,.4522E+00,.4161E+00, &
& .1000E+01,.9989E+00,.9836E+00,.9178E+00,.6825E+00,.8084E+00, &
& .7180E+00,.7351E+00,.5334E+00,.6226E+00,.6058E+00,.6108E+00, &
& .4623E+00,.4255E+00,.4399E+00,.4518E+00,.4559E+00,.4284E+00, &
& .1000E+01,.9990E+00,.9832E+00,.9107E+00,.6815E+00,.7994E+00, &
& .7018E+00,.7143E+00,.5313E+00,.6011E+00,.5836E+00,.5877E+00, &
& .4635E+00,.4341E+00,.4456E+00,.4551E+00,.4589E+00,.4382E+00, &
& .1000E+01,.9987E+00,.9813E+00,.8925E+00,.6748E+00,.7865E+00, &
& .6908E+00,.6951E+00,.5373E+00,.5836E+00,.5624E+00,.5605E+00, &
& .4652E+00,.4443E+00,.4537E+00,.4598E+00,.4620E+00,.4474E+00, &
& .1000E+01,.9988E+00,.9800E+00,.8969E+00,.6654E+00,.7781E+00, &
& .6947E+00,.6954E+00,.5480E+00,.5842E+00,.5572E+00,.5477E+00, &
& .4642E+00,.4479E+00,.4572E+00,.4614E+00,.4620E+00,.4495E+00/
data ((a_extx(i,j,1),i=1,mbx),j=1,nrh) / &
& .2085E-03,.2085E-03,.1753E-03,.1667E-03,.1655E-03,.1667E-03, &
& .1721E-03,.1735E-03,.1698E-03,.1700E-03,.1691E-03,.1647E-03, &
& .1267E-03,.1256E-03,.1477E-03,.1473E-03,.1320E-03,.1206E-03, &
& .2442E-03,.2391E-03,.1959E-03,.1850E-03,.1841E-03,.1836E-03, &
& .1895E-03,.1909E-03,.1867E-03,.1895E-03,.1879E-03,.1794E-03, &
& .1379E-03,.1395E-03,.1642E-03,.1644E-03,.1482E-03,.1336E-03, &
& .3488E-03,.3479E-03,.3010E-03,.2796E-03,.2720E-03,.2663E-03, &
& .2693E-03,.2725E-03,.2678E-03,.2743E-03,.2717E-03,.2589E-03, &
& .2028E-03,.2152E-03,.2470E-03,.2496E-03,.2322E-03,.2076E-03, &
& .7848E-03,.7872E-03,.7928E-03,.7466E-03,.7085E-03,.6744E-03, &
& .6381E-03,.6362E-03,.6401E-03,.6470E-03,.6477E-03,.6350E-03, &
& .5307E-03,.5726E-03,.6321E-03,.6438E-03,.6297E-03,.5842E-03, &
& .1112E-02,.1113E-02,.1148E-02,.1112E-02,.1057E-02,.1004E-02, &
& .9203E-03,.9076E-03,.9195E-03,.9147E-03,.9172E-03,.9072E-03, &
& .7833E-03,.8441E-03,.9175E-03,.9317E-03,.9216E-03,.8724E-03, &
& .1636E-02,.1619E-02,.1667E-02,.1673E-02,.1619E-02,.1548E-02, &
& .1385E-02,.1345E-02,.1367E-02,.1335E-02,.1334E-02,.1324E-02, &
& .1184E-02,.1269E-02,.1366E-02,.1379E-02,.1373E-02,.1323E-02, &
& .2803E-02,.2748E-02,.2765E-02,.2829E-02,.2862E-02,.2813E-02, &
& .2508E-02,.2396E-02,.2421E-02,.2312E-02,.2280E-02,.2252E-02, &
& .2093E-02,.2240E-02,.2390E-02,.2388E-02,.2373E-02,.2328E-02, &
& .4213E-02,.4113E-02,.4088E-02,.4098E-02,.4248E-02,.4287E-02, &
& .3951E-02,.3743E-02,.3733E-02,.3520E-02,.3416E-02,.3331E-02, &
& .3154E-02,.3390E-02,.3609E-02,.3580E-02,.3527E-02,.3473E-02/
data ((a_asyx(i,j,1),i=1,mbx),j=1,nrh) / &
& .7972E+00,.8182E+00,.8172E+00,.8200E+00,.8119E+00,.7766E+00, &
& .8040E+00,.8212E+00,.8646E+00,.8447E+00,.8440E+00,.8411E+00, &
& .8880E+00,.8602E+00,.7911E+00,.7291E+00,.6673E+00,.5545E+00, &
& .8017E+00,.8218E+00,.8187E+00,.8216E+00,.8160E+00,.7809E+00, &
& .8095E+00,.8488E+00,.8715E+00,.8498E+00,.8488E+00,.8597E+00, &
& .8958E+00,.8652E+00,.7976E+00,.7375E+00,.6763E+00,.5685E+00, &
& .7986E+00,.8234E+00,.8312E+00,.8353E+00,.8296E+00,.7968E+00, &
& .8248E+00,.8507E+00,.8891E+00,.8648E+00,.8726E+00,.8853E+00, &
& .9177E+00,.8834E+00,.8248E+00,.7727E+00,.7198E+00,.6379E+00, &
& .7617E+00,.8120E+00,.8494E+00,.8614E+00,.8610E+00,.8308E+00, &
& .8540E+00,.8626E+00,.9124E+00,.8874E+00,.9025E+00,.9183E+00, &
& .9476E+00,.9123E+00,.8683E+00,.8336E+00,.7948E+00,.7445E+00, &
& .7412E+00,.7992E+00,.8491E+00,.8673E+00,.8711E+00,.8437E+00, &
& .8652E+00,.8700E+00,.9176E+00,.8950E+00,.9099E+00,.9256E+00, &
& .9550E+00,.9187E+00,.8787E+00,.8512E+00,.8183E+00,.7759E+00, &
& .7144E+00,.7752E+00,.8417E+00,.8684E+00,.8779E+00,.8554E+00, &
& .8775E+00,.8804E+00,.9226E+00,.9026E+00,.9169E+00,.9319E+00, &
& .9607E+00,.9236E+00,.8850E+00,.8645E+00,.8394E+00,.8044E+00, &
& .6858E+00,.7430E+00,.8251E+00,.8605E+00,.8799E+00,.8649E+00, &
& .8931E+00,.8955E+00,.9294E+00,.9133E+00,.9253E+00,.9394E+00, &
& .9660E+00,.9273E+00,.8877E+00,.8751E+00,.8610E+00,.8366E+00, &
& .6686E+00,.7251E+00,.8155E+00,.8500E+00,.8752E+00,.8642E+00, &
& .9001E+00,.9040E+00,.9324E+00,.9183E+00,.9292E+00,.9420E+00, &
& .9677E+00,.9280E+00,.8855E+00,.8724E+00,.8665E+00,.8517E+00/
!c ************************************************
!c Data statements for aerosol type 2 (continental)
!c ************************************************
data ((a_ssax(i,j,2),i=1,mbx),j=1,nrh) / &
& .9607E+00,.9253E+00,.7650E+00,.3869E+00,.7830E+00,.8196E+00, &
& .5468E+00,.3954E+00,.2303E+00,.6683E-01,.8012E-01,.1274E+00, &
& .1627E+00,.9903E-01,.5161E-01,.4431E-01,.2697E-01,.1631E-01, &
& .9606E+00,.9252E+00,.7650E+00,.3872E+00,.7821E+00,.8195E+00, &
& .5486E+00,.3983E+00,.2330E+00,.6891E-01,.8092E-01,.1285E+00, &
& .1625E+00,.1015E+00,.5113E-01,.4522E-01,.2781E-01,.1691E-01, &
& .9632E+00,.9301E+00,.7820E+00,.4110E+00,.7464E+00,.8202E+00, &
& .5511E+00,.4098E+00,.2105E+00,.7610E-01,.8126E-01,.1259E+00, &
& .1316E+00,.6796E-01,.4130E-01,.4058E-01,.2661E-01,.1672E-01, &
& .9730E+00,.9487E+00,.8461E+00,.5175E+00,.7033E+00,.8338E+00, &
& .5724E+00,.4600E+00,.1834E+00,.1095E+00,.8760E-01,.1199E+00, &
& .7362E-01,.2678E-01,.2572E-01,.3075E-01,.2423E-01,.1656E-01, &
& .9820E+00,.9667E+00,.9056E+00,.6542E+00,.7047E+00,.8543E+00, &
& .6027E+00,.5125E+00,.1824E+00,.1479E+00,.1006E+00,.1160E+00, &
& .4699E-01,.1763E-01,.2012E-01,.2466E-01,.2149E-01,.1529E-01, &
& .9859E+00,.9745E+00,.9303E+00,.7255E+00,.7137E+00,.8662E+00, &
& .6230E+00,.5426E+00,.1894E+00,.1718E+00,.1117E+00,.1168E+00, &
& .3984E-01,.1625E-01,.1928E-01,.2322E-01,.2079E-01,.1493E-01, &
& .9891E+00,.9808E+00,.9500E+00,.7911E+00,.7245E+00,.8778E+00, &
& .6552E+00,.5913E+00,.2128E+00,.2271E+00,.1459E+00,.1391E+00, &
& .4313E-01,.2095E-01,.2574E-01,.3247E-01,.3267E-01,.2510E-01, &
& .9914E+00,.9853E+00,.9630E+00,.8391E+00,.7353E+00,.8871E+00, &
& .6780E+00,.6222E+00,.2295E+00,.2635E+00,.1717E+00,.1553E+00, &
& .4561E-01,.2404E-01,.2966E-01,.3769E-01,.3967E-01,.3733E-01/
data ((a_extx(i,j,2),i=1,mbx),j=1,nrh) / &
& .1067E-04,.5658E-05,.1248E-05,.1317E-05,.2144E-06,.1635E-06, &
& .1051E-06,.1039E-06,.1074E-06,.1852E-06,.3665E-06,.2548E-06, &
& .8879E-07,.9337E-07,.1557E-06,.1269E-06,.1362E-06,.1536E-06, &
& .1067E-04,.5659E-05,.1250E-05,.1318E-05,.2156E-06,.1645E-06, &
& .1060E-06,.1047E-06,.1083E-06,.1859E-06,.3671E-06,.2554E-06, &
& .8921E-07,.9426E-07,.1563E-06,.1274E-06,.1366E-06,.1539E-06, &
& .1145E-04,.6089E-05,.1366E-05,.1390E-05,.2705E-06,.1893E-06, &
& .1202E-06,.1160E-06,.1392E-06,.1982E-06,.3933E-06,.2795E-06, &
& .1146E-06,.1395E-06,.1987E-06,.1543E-06,.1569E-06,.1719E-06, &
& .1554E-04,.8394E-05,.2017E-05,.1792E-05,.5780E-06,.3314E-06, &
& .1978E-06,.1767E-06,.3055E-06,.2637E-06,.5149E-06,.3873E-06, &
& .2577E-06,.4005E-06,.4371E-06,.3044E-06,.2654E-06,.2658E-06, &
& .2344E-04,.1308E-04,.3456E-05,.2666E-05,.1253E-05,.6574E-06, &
& .3619E-06,.3005E-06,.6400E-06,.3929E-06,.7060E-06,.5523E-06, &
& .5532E-06,.9393E-06,.9290E-06,.6129E-06,.4778E-06,.4448E-06, &
& .3004E-04,.1716E-04,.4801E-05,.3491E-05,.1886E-05,.9781E-06, &
& .5168E-06,.4150E-06,.9341E-06,.5071E-06,.8499E-06,.6765E-06, &
& .8087E-06,.1406E-05,.1356E-05,.8808E-06,.6589E-06,.5955E-06, &
& .3935E-04,.2315E-04,.6913E-05,.4819E-05,.2908E-05,.1535E-05, &
& .8007E-06,.6334E-06,.1408E-05,.7153E-06,.1081E-05,.8758E-06, &
& .1200E-05,.2109E-05,.2009E-05,.1301E-05,.9483E-06,.8356E-06, &
& .5037E-04,.3051E-04,.9659E-05,.6565E-05,.4238E-05,.2277E-05, &
& .1165E-05,.9083E-06,.1992E-05,.9700E-06,.1351E-05,.1111E-05, &
& .1676E-05,.2962E-05,.2801E-05,.1811E-05,.1302E-05,.9664E-06/
data ((a_asyx(i,j,2),i=1,mbx),j=1,nrh) / &
& .6406E+00,.6057E+00,.5447E+00,.4976E+00,.4323E+00,.4216E+00, &
& .4084E+00,.4038E+00,.3530E+00,.5334E+00,.4666E+00,.3619E+00, &
& .4654E+00,.5418E+00,.5190E+00,.4775E+00,.4633E+00,.3869E+00, &
& .6406E+00,.6057E+00,.5449E+00,.4982E+00,.4338E+00,.4240E+00, &
& .4135E+00,.4106E+00,.3639E+00,.5480E+00,.4744E+00,.3681E+00, &
& .4720E+00,.5471E+00,.5244E+00,.4836E+00,.4694E+00,.3936E+00, &
& .6514E+00,.6161E+00,.5532E+00,.5076E+00,.4378E+00,.4297E+00, &
& .4202E+00,.4202E+00,.3811E+00,.5519E+00,.4816E+00,.3768E+00, &
& .4809E+00,.5492E+00,.5237E+00,.4896E+00,.4800E+00,.4086E+00, &
& .6892E+00,.6537E+00,.5854E+00,.5436E+00,.4553E+00,.4509E+00, &
& .4419E+00,.4494E+00,.4211E+00,.5500E+00,.4860E+00,.4133E+00, &
& .5070E+00,.5397E+00,.5109E+00,.5082E+00,.5147E+00,.4602E+00, &
& .7238E+00,.6909E+00,.6212E+00,.5832E+00,.4777E+00,.4729E+00, &
& .4524E+00,.4581E+00,.4252E+00,.5112E+00,.4636E+00,.4340E+00, &
& .5076E+00,.4990E+00,.4697E+00,.4977E+00,.5255E+00,.4928E+00, &
& .7390E+00,.7084E+00,.6399E+00,.6042E+00,.4924E+00,.4874E+00, &
& .4601E+00,.4628E+00,.4269E+00,.4922E+00,.4535E+00,.4423E+00, &
& .5024E+00,.4712E+00,.4434E+00,.4853E+00,.5258E+00,.5079E+00, &
& .7522E+00,.7245E+00,.6593E+00,.6270E+00,.5142E+00,.5121E+00, &
& .4943E+00,.5049E+00,.4707E+00,.5452E+00,.5173E+00,.5260E+00, &
& .5827E+00,.5439E+00,.5142E+00,.5589E+00,.5958E+00,.5818E+00, &
& .7620E+00,.7371E+00,.6754E+00,.6456E+00,.5312E+00,.5297E+00, &
& .5112E+00,.5218E+00,.4872E+00,.5553E+00,.5396E+00,.5633E+00, &
& .6177E+00,.5629E+00,.5322E+00,.5821E+00,.6221E+00,.6250E+00/
!c ******************************************
!c Data statements for aerosol type 3 (urban)
!c ******************************************
data ((a_ssax(i,j,3),i=1,mbx),j=1,nrh) / &
& .9371E+00,.8999E+00,.7175E+00,.3628E+00,.6462E+00,.6564E+00, &
& .4011E+00,.2856E+00,.1754E+00,.3630E-01,.6500E-01,.8672E-01, &
& .8039E-01,.3570E-01,.1633E-01,.1202E-01,.4884E-02,.2383E-02, &
& .9365E+00,.8992E+00,.7160E+00,.3622E+00,.6417E+00,.6511E+00, &
& .3969E+00,.2828E+00,.1736E+00,.3634E-01,.6489E-01,.8637E-01, &
& .7938E-01,.3683E-01,.1618E-01,.1207E-01,.4972E-02,.2454E-02, &
& .9386E+00,.9035E+00,.7316E+00,.3838E+00,.6180E+00,.6530E+00, &
& .3951E+00,.2856E+00,.1549E+00,.3982E-01,.6398E-01,.8328E-01, &
& .6367E-01,.2501E-01,.1367E-01,.1095E-01,.4813E-02,.2445E-02, &
& .9522E+00,.9265E+00,.8037E+00,.4882E+00,.6214E+00,.7102E+00, &
& .4367E+00,.3326E+00,.1370E+00,.5985E-01,.6507E-01,.7825E-01, &
& .3715E-01,.1113E-01,.9892E-02,.9000E-02,.4744E-02,.2534E-02, &
& .9669E+00,.9502E+00,.8773E+00,.6289E+00,.6589E+00,.7812E+00, &
& .5069E+00,.4094E+00,.1465E+00,.9469E-01,.7425E-01,.7846E-01, &
& .2566E-01,.8722E-02,.9422E-02,.8668E-02,.5022E-02,.2619E-02, &
& .9733E+00,.9620E+00,.9086E+00,.7041E+00,.6797E+00,.8128E+00, &
& .5458E+00,.4545E+00,.1573E+00,.1192E+00,.8364E-01,.8086E-01, &
& .2264E-01,.8812E-02,.9970E-02,.9079E-02,.5429E-02,.2765E-02, &
& .9790E+00,.9710E+00,.9339E+00,.7734E+00,.6992E+00,.8399E+00, &
& .5866E+00,.5038E+00,.1729E+00,.1520E+00,.9926E-01,.8757E-01, &
& .2187E-01,.1003E-01,.1172E-01,.1103E-01,.7504E-02,.4245E-02, &
& .9832E+00,.9776E+00,.9511E+00,.8253E+00,.7164E+00,.8604E+00, &
& .6219E+00,.5461E+00,.1893E+00,.1831E+00,.1159E+00,.9521E-01, &
& .2208E-01,.1143E-01,.1350E-01,.1280E-01,.9112E-02,.6206E-02/
data ((a_extx(i,j,3),i=1,mbx),j=1,nrh) / &
& .6974E-05,.3689E-05,.8308E-06,.8639E-06,.1517E-06,.1172E-06, &
& .7603E-07,.7487E-07,.7732E-07,.1226E-06,.2351E-06,.1602E-06, &
& .5585E-07,.5913E-07,.9781E-07,.7830E-07,.8414E-07,.9499E-07, &
& .6982E-05,.3693E-05,.8327E-06,.8656E-06,.1529E-06,.1183E-06, &
& .7697E-07,.7577E-07,.7826E-07,.1234E-06,.2358E-06,.1609E-06, &
& .5659E-07,.6006E-07,.9840E-07,.7871E-07,.8445E-07,.9516E-07, &
& .7505E-05,.3978E-05,.9110E-06,.9159E-06,.1901E-06,.1358E-06, &
& .8773E-07,.8470E-07,.9992E-07,.1329E-06,.2542E-06,.1781E-06, &
& .7504E-07,.9126E-07,.1270E-06,.9669E-07,.9796E-07,.1067E-06, &
& .1017E-04,.5464E-05,.1328E-05,.1172E-05,.3857E-06,.2239E-06, &
& .1355E-06,.1219E-06,.2064E-06,.1743E-06,.3321E-06,.2476E-06, &
& .1704E-06,.2630E-06,.2819E-06,.1932E-06,.1672E-06,.1659E-06, &
& .1528E-04,.8466E-05,.2240E-05,.1723E-05,.8128E-06,.4251E-06, &
& .2346E-06,.1956E-06,.4180E-06,.2532E-06,.4515E-06,.3513E-06, &
& .3619E-06,.6124E-06,.5990E-06,.3904E-06,.3021E-06,.2789E-06, &
& .1963E-04,.1111E-04,.3099E-05,.2247E-05,.1219E-05,.6254E-06, &
& .3299E-06,.2652E-06,.6084E-06,.3245E-06,.5427E-06,.4307E-06, &
& .5313E-06,.9227E-06,.8816E-06,.5662E-06,.4201E-06,.3763E-06, &
& .2594E-04,.1505E-04,.4440E-05,.3077E-05,.1861E-05,.9545E-06, &
& .4851E-06,.3783E-06,.8998E-06,.4362E-06,.6725E-06,.5438E-06, &
& .7839E-06,.1386E-05,.1306E-05,.8310E-06,.5971E-06,.5214E-06, &
& .3343E-04,.1989E-04,.6191E-05,.4176E-05,.2703E-05,.1404E-05, &
& .6921E-06,.5279E-06,.3548E-06,.5771E-06,.8264E-06,.6774E-06, &
& .1089E-05,.1946E-05,.1820E-05,.1152E-05,.8146E-06,.5980E-06/
data ((a_asyx(i,j,3),i=1,mbx),j=1,nrh) / &
& .6381E+00,.6035E+00,.5386E+00,.4849E+00,.3957E+00,.3761E+00, &
& .3199E+00,.3006E+00,.2684E+00,.2713E+00,.2763E+00,.2241E+00, &
& .2351E+00,.2725E+00,.2616E+00,.2607E+00,.3195E+00,.3162E+00, &
& .6381E+00,.6035E+00,.5385E+00,.4849E+00,.3958E+00,.3764E+00, &
& .3207E+00,.3018E+00,.2700E+00,.2780E+00,.2836E+00,.2254E+00, &
& .2366E+00,.2730E+00,.2629E+00,.2658E+00,.3269E+00,.3239E+00, &
& .6490E+00,.6137E+00,.5468E+00,.4946E+00,.4020E+00,.3834E+00, &
& .3274E+00,.3089E+00,.2773E+00,.2849E+00,.2936E+00,.2285E+00, &
& .2374E+00,.2654E+00,.2526E+00,.2639E+00,.3284E+00,.3327E+00, &
& .6866E+00,.6512E+00,.5797E+00,.5327E+00,.4280E+00,.4121E+00, &
& .3550E+00,.3374E+00,.3039E+00,.3043E+00,.2931E+00,.2444E+00, &
& .2438E+00,.2427E+00,.2265E+00,.2565E+00,.3291E+00,.3575E+00, &
& .7213E+00,.6884E+00,.6168E+00,.5756E+00,.4606E+00,.4473E+00, &
& .3883E+00,.3700E+00,.3315E+00,.3171E+00,.2900E+00,.2650E+00, &
& .2506E+00,.2220E+00,.2017E+00,.2297E+00,.2957E+00,.3450E+00, &
& .7362E+00,.7055E+00,.6357E+00,.5977E+00,.4792E+00,.4674E+00, &
& .4080E+00,.3893E+00,.3483E+00,.3287E+00,.2983E+00,.2787E+00, &
& .2562E+00,.2159E+00,.1939E+00,.2169E+00,.2754E+00,.3308E+00, &
& .7488E+00,.7206E+00,.6539E+00,.6192E+00,.4991E+00,.4892E+00, &
& .4329E+00,.4163E+00,.3733E+00,.3608E+00,.3302E+00,.3274E+00, &
& .2936E+00,.2500E+00,.2283E+00,.2661E+00,.3470E+00,.4161E+00, &
& .7584E+00,.7326E+00,.6694E+00,.6376E+00,.5167E+00,.5082E+00, &
& .4535E+00,.4373E+00,.3927E+00,.3798E+00,.3500E+00,.3381E+00, &
& .3171E+00,.2640E+00,.2404E+00,.2809E+00,.3669E+00,.4590E+00/
!c ***********************************************
!c Data statements for T&L 0.5 micron dust aerosol
!c ***********************************************
data ((a_ssax(i,j,4),i=1,mbx),j=1,nrh) / &
& .9140E+00,.9726E+00,.9759E+00,.9737E+00,.8492E+00,.8986E+00, &
& .8344E+00,.6125E+00,.2537E+00,.9996E-01,.3744E-01,.1756E+00, &
& .6959E-01,.3767E-01,.1425E-01,.1772E-01,.7060E-02,.2826E-02, &
& .9140E+00,.9726E+00,.9759E+00,.9737E+00,.8492E+00,.8986E+00, &
& .8344E+00,.6125E+00,.2537E+00,.9996E-01,.3744E-01,.1756E+00, &
& .6959E-01,.3767E-01,.1425E-01,.1772E-01,.7060E-02,.2826E-02, &
& .9140E+00,.9726E+00,.9759E+00,.9737E+00,.8492E+00,.8986E+00, &
& .8344E+00,.6125E+00,.2537E+00,.9996E-01,.3744E-01,.1756E+00, &
& .6959E-01,.3767E-01,.1425E-01,.1772E-01,.7060E-02,.2826E-02, &
& .9140E+00,.9726E+00,.9759E+00,.9737E+00,.8492E+00,.8986E+00, &
& .8344E+00,.6125E+00,.2537E+00,.9996E-01,.3744E-01,.1756E+00, &
& .6959E-01,.3767E-01,.1425E-01,.1772E-01,.7060E-02,.2826E-02, &
& .9140E+00,.9726E+00,.9759E+00,.9737E+00,.8492E+00,.8986E+00, &
& .8344E+00,.6125E+00,.2537E+00,.9996E-01,.3744E-01,.1756E+00, &
& .6959E-01,.3767E-01,.1425E-01,.1772E-01,.7060E-02,.2826E-02, &
& .9140E+00,.9726E+00,.9759E+00,.9737E+00,.8492E+00,.8986E+00, &
& .8344E+00,.6125E+00,.2537E+00,.9996E-01,.3744E-01,.1756E+00, &
& .6959E-01,.3767E-01,.1425E-01,.1772E-01,.7060E-02,.2826E-02, &
& .9140E+00,.9726E+00,.9759E+00,.9737E+00,.8492E+00,.8986E+00, &
& .8344E+00,.6125E+00,.2537E+00,.9996E-01,.3744E-01,.1756E+00, &
& .6959E-01,.3767E-01,.1425E-01,.1772E-01,.7060E-02,.2826E-02, &
& .9140E+00,.9726E+00,.9759E+00,.9737E+00,.8492E+00,.8986E+00, &
& .8344E+00,.6125E+00,.2537E+00,.9996E-01,.3744E-01,.1756E+00, &
& .6959E-01,.3767E-01,.1425E-01,.1772E-01,.7060E-02,.2826E-02/
data ((a_extx(i,j,4),i=1,mbx),j=1,nrh) / &
& .1013E+01,.1046E+01,.7036E+00,.4361E+00,.1101E+00,.7263E-01, &
& .3980E-01,.3442E-01,.3402E-01,.3102E-01,.7158E-01,.1016E+00, &
& .5528E-01,.2937E-01,.3969E-01,.3820E-01,.2108E-01,.1806E-01, &
& .1013E+01,.1046E+01,.7036E+00,.4361E+00,.1101E+00,.7263E-01, &
& .3980E-01,.3442E-01,.3402E-01,.3102E-01,.7158E-01,.1016E+00, &
& .5528E-01,.2937E-01,.3969E-01,.3820E-01,.2108E-01,.1806E-01, &
& .1013E+01,.1046E+01,.7036E+00,.4361E+00,.1101E+00,.7263E-01, &
& .3980E-01,.3442E-01,.3402E-01,.3102E-01,.7158E-01,.1016E+00, &
& .5528E-01,.2937E-01,.3969E-01,.3820E-01,.2108E-01,.1806E-01, &
& .1013E+01,.1046E+01,.7036E+00,.4361E+00,.1101E+00,.7263E-01, &
& .3980E-01,.3442E-01,.3402E-01,.3102E-01,.7158E-01,.1016E+00, &
& .5528E-01,.2937E-01,.3969E-01,.3820E-01,.2108E-01,.1806E-01, &
& .1013E+01,.1046E+01,.7036E+00,.4361E+00,.1101E+00,.7263E-01, &
& .3980E-01,.3442E-01,.3402E-01,.3102E-01,.7158E-01,.1016E+00, &
& .5528E-01,.2937E-01,.3969E-01,.3820E-01,.2108E-01,.1806E-01, &
& .1013E+01,.1046E+01,.7036E+00,.4361E+00,.1101E+00,.7263E-01, &
& .3980E-01,.3442E-01,.3402E-01,.3102E-01,.7158E-01,.1016E+00, &
& .5528E-01,.2937E-01,.3969E-01,.3820E-01,.2108E-01,.1806E-01, &
& .1013E+01,.1046E+01,.7036E+00,.4361E+00,.1101E+00,.7263E-01, &
& .3980E-01,.3442E-01,.3402E-01,.3102E-01,.7158E-01,.1016E+00, &
& .5528E-01,.2937E-01,.3969E-01,.3820E-01,.2108E-01,.1806E-01, &
& .1013E+01,.1046E+01,.7036E+00,.4361E+00,.1101E+00,.7263E-01, &
& .3980E-01,.3442E-01,.3402E-01,.3102E-01,.7158E-01,.1016E+00, &
& .5528E-01,.2937E-01,.3969E-01,.3820E-01,.2108E-01,.1806E-01/
data ((a_asyx(i,j,4),i=1,mbx),j=1,nrh) / &
& .6727E+00,.6788E+00,.6599E+00,.6079E+00,.4306E+00,.3754E+00, &
& .2599E+00,.2139E+00,.1488E+00,.1066E+00,.8476E-01,.1280E+00, &
& .6212E-01,.4009E-01,.2821E-01,.2439E-01,.1238E-01,.7042E-02, &
& .6727E+00,.6788E+00,.6599E+00,.6079E+00,.4306E+00,.3754E+00, &
& .2599E+00,.2139E+00,.1488E+00,.1066E+00,.8476E-01,.1280E+00, &
& .6212E-01,.4009E-01,.2821E-01,.2439E-01,.1238E-01,.7042E-02, &
& .6727E+00,.6788E+00,.6599E+00,.6079E+00,.4306E+00,.3754E+00, &
& .2599E+00,.2139E+00,.1488E+00,.1066E+00,.8476E-01,.1280E+00, &
& .6212E-01,.4009E-01,.2821E-01,.2439E-01,.1238E-01,.7042E-02, &
& .6727E+00,.6788E+00,.6599E+00,.6079E+00,.4306E+00,.3754E+00, &
& .2599E+00,.2139E+00,.1488E+00,.1066E+00,.8476E-01,.1280E+00, &
& .6212E-01,.4009E-01,.2821E-01,.2439E-01,.1238E-01,.7042E-02, &
& .6727E+00,.6788E+00,.6599E+00,.6079E+00,.4306E+00,.3754E+00, &
& .2599E+00,.2139E+00,.1488E+00,.1066E+00,.8476E-01,.1280E+00, &
& .6212E-01,.4009E-01,.2821E-01,.2439E-01,.1238E-01,.7042E-02, &
& .6727E+00,.6788E+00,.6599E+00,.6079E+00,.4306E+00,.3754E+00, &
& .2599E+00,.2139E+00,.1488E+00,.1066E+00,.8476E-01,.1280E+00, &
& .6212E-01,.4009E-01,.2821E-01,.2439E-01,.1238E-01,.7042E-02, &
& .6727E+00,.6788E+00,.6599E+00,.6079E+00,.4306E+00,.3754E+00, &
& .2599E+00,.2139E+00,.1488E+00,.1066E+00,.8476E-01,.1280E+00, &
& .6212E-01,.4009E-01,.2821E-01,.2439E-01,.1238E-01,.7042E-02, &
& .6727E+00,.6788E+00,.6599E+00,.6079E+00,.4306E+00,.3754E+00, &
& .2599E+00,.2139E+00,.1488E+00,.1066E+00,.8476E-01,.1280E+00, &
& .6212E-01,.4009E-01,.2821E-01,.2439E-01,.1238E-01,.7042E-02/
!c ***********************************************
!c Data statements for T&L 1.0 micron dust aerosol
!c ***********************************************
data ((a_ssax(i,j,5),i=1,mbx),j=1,nrh) / &
& .8498E+00,.9415E+00,.9649E+00,.9728E+00,.9141E+00,.9502E+00, &
& .9317E+00,.8228E+00,.5514E+00,.3158E+00,.1352E+00,.3908E+00, &
& .2884E+00,.1955E+00,.8936E-01,.1136E+00,.5145E-01,.2186E-01, &
& .8498E+00,.9415E+00,.9649E+00,.9728E+00,.9141E+00,.9502E+00, &
& .9317E+00,.8228E+00,.5514E+00,.3158E+00,.1352E+00,.3908E+00, &
& .2884E+00,.1955E+00,.8936E-01,.1136E+00,.5145E-01,.2186E-01, &
& .8498E+00,.9415E+00,.9649E+00,.9728E+00,.9141E+00,.9502E+00, &
& .9317E+00,.8228E+00,.5514E+00,.3158E+00,.1352E+00,.3908E+00, &
& .2884E+00,.1955E+00,.8936E-01,.1136E+00,.5145E-01,.2186E-01, &
& .8498E+00,.9415E+00,.9649E+00,.9728E+00,.9141E+00,.9502E+00, &
& .9317E+00,.8228E+00,.5514E+00,.3158E+00,.1352E+00,.3908E+00, &
& .2884E+00,.1955E+00,.8936E-01,.1136E+00,.5145E-01,.2186E-01, &
& .8498E+00,.9415E+00,.9649E+00,.9728E+00,.9141E+00,.9502E+00, &
& .9317E+00,.8228E+00,.5514E+00,.3158E+00,.1352E+00,.3908E+00, &
& .2884E+00,.1955E+00,.8936E-01,.1136E+00,.5145E-01,.2186E-01, &
& .8498E+00,.9415E+00,.9649E+00,.9728E+00,.9141E+00,.9502E+00, &
& .9317E+00,.8228E+00,.5514E+00,.3158E+00,.1352E+00,.3908E+00, &
& .2884E+00,.1955E+00,.8936E-01,.1136E+00,.5145E-01,.2186E-01, &
& .8498E+00,.9415E+00,.9649E+00,.9728E+00,.9141E+00,.9502E+00, &
& .9317E+00,.8228E+00,.5514E+00,.3158E+00,.1352E+00,.3908E+00, &
& .2884E+00,.1955E+00,.8936E-01,.1136E+00,.5145E-01,.2186E-01, &
& .8498E+00,.9415E+00,.9649E+00,.9728E+00,.9141E+00,.9502E+00, &
& .9317E+00,.8228E+00,.5514E+00,.3158E+00,.1352E+00,.3908E+00, &
& .2884E+00,.1955E+00,.8936E-01,.1136E+00,.5145E-01,.2186E-01/
data ((a_extx(i,j,5),i=1,mbx),j=1,nrh) / &
& .1011E+01,.1126E+01,.1274E+01,.1194E+01,.5876E+00,.4705E+00, &
& .3210E+00,.2489E+00,.1574E+00,.1099E+00,.2069E+00,.5297E+00, &
& .1960E+00,.9338E-01,.1105E+00,.1188E+00,.5688E-01,.4516E-01, &
& .1011E+01,.1126E+01,.1274E+01,.1194E+01,.5876E+00,.4705E+00, &
& .3210E+00,.2489E+00,.1574E+00,.1099E+00,.2069E+00,.5297E+00, &
& .1960E+00,.9338E-01,.1105E+00,.1188E+00,.5688E-01,.4516E-01, &
& .1011E+01,.1126E+01,.1274E+01,.1194E+01,.5876E+00,.4705E+00, &
& .3210E+00,.2489E+00,.1574E+00,.1099E+00,.2069E+00,.5297E+00, &
& .1960E+00,.9338E-01,.1105E+00,.1188E+00,.5688E-01,.4516E-01, &
& .1011E+01,.1126E+01,.1274E+01,.1194E+01,.5876E+00,.4705E+00, &
& .3210E+00,.2489E+00,.1574E+00,.1099E+00,.2069E+00,.5297E+00, &
& .1960E+00,.9338E-01,.1105E+00,.1188E+00,.5688E-01,.4516E-01, &
& .1011E+01,.1126E+01,.1274E+01,.1194E+01,.5876E+00,.4705E+00, &
& .3210E+00,.2489E+00,.1574E+00,.1099E+00,.2069E+00,.5297E+00, &
& .1960E+00,.9338E-01,.1105E+00,.1188E+00,.5688E-01,.4516E-01, &
& .1011E+01,.1126E+01,.1274E+01,.1194E+01,.5876E+00,.4705E+00, &
& .3210E+00,.2489E+00,.1574E+00,.1099E+00,.2069E+00,.5297E+00, &
& .1960E+00,.9338E-01,.1105E+00,.1188E+00,.5688E-01,.4516E-01, &
& .1011E+01,.1126E+01,.1274E+01,.1194E+01,.5876E+00,.4705E+00, &
& .3210E+00,.2489E+00,.1574E+00,.1099E+00,.2069E+00,.5297E+00, &
& .1960E+00,.9338E-01,.1105E+00,.1188E+00,.5688E-01,.4516E-01, &
& .1011E+01,.1126E+01,.1274E+01,.1194E+01,.5876E+00,.4705E+00, &
& .3210E+00,.2489E+00,.1574E+00,.1099E+00,.2069E+00,.5297E+00, &
& .1960E+00,.9338E-01,.1105E+00,.1188E+00,.5688E-01,.4516E-01/
data ((a_asyx(i,j,5),i=1,mbx),j=1,nrh) / &
& .7338E+00,.6749E+00,.6812E+00,.6876E+00,.6653E+00,.6352E+00, &
& .5506E+00,.5123E+00,.4335E+00,.3460E+00,.2780E+00,.2550E+00, &
& .2217E+00,.1555E+00,.1096E+00,.9265E-01,.5052E-01,.2847E-01, &
& .7338E+00,.6749E+00,.6812E+00,.6876E+00,.6653E+00,.6352E+00, &
& .5506E+00,.5123E+00,.4335E+00,.3460E+00,.2780E+00,.2550E+00, &
& .2217E+00,.1555E+00,.1096E+00,.9265E-01,.5052E-01,.2847E-01, &
& .7338E+00,.6749E+00,.6812E+00,.6876E+00,.6653E+00,.6352E+00, &
& .5506E+00,.5123E+00,.4335E+00,.3460E+00,.2780E+00,.2550E+00, &
& .2217E+00,.1555E+00,.1096E+00,.9265E-01,.5052E-01,.2847E-01, &
& .7338E+00,.6749E+00,.6812E+00,.6876E+00,.6653E+00,.6352E+00, &
& .5506E+00,.5123E+00,.4335E+00,.3460E+00,.2780E+00,.2550E+00, &
& .2217E+00,.1555E+00,.1096E+00,.9265E-01,.5052E-01,.2847E-01, &
& .7338E+00,.6749E+00,.6812E+00,.6876E+00,.6653E+00,.6352E+00, &
& .5506E+00,.5123E+00,.4335E+00,.3460E+00,.2780E+00,.2550E+00, &
& .2217E+00,.1555E+00,.1096E+00,.9265E-01,.5052E-01,.2847E-01, &
& .7338E+00,.6749E+00,.6812E+00,.6876E+00,.6653E+00,.6352E+00, &
& .5506E+00,.5123E+00,.4335E+00,.3460E+00,.2780E+00,.2550E+00, &
& .2217E+00,.1555E+00,.1096E+00,.9265E-01,.5052E-01,.2847E-01, &
& .7338E+00,.6749E+00,.6812E+00,.6876E+00,.6653E+00,.6352E+00, &
& .5506E+00,.5123E+00,.4335E+00,.3460E+00,.2780E+00,.2550E+00, &
& .2217E+00,.1555E+00,.1096E+00,.9265E-01,.5052E-01,.2847E-01, &
& .7338E+00,.6749E+00,.6812E+00,.6876E+00,.6653E+00,.6352E+00, &
& .5506E+00,.5123E+00,.4335E+00,.3460E+00,.2780E+00,.2550E+00, &
& .2217E+00,.1555E+00,.1096E+00,.9265E-01,.5052E-01,.2847E-01/
!c ***********************************************
!c Data statements for T&L 2.0 micron dust aerosol
!c ***********************************************
data ((a_ssax(i,j,6),i=1,mbx),j=1,nrh) / &
& .7767E+00,.8913E+00,.9229E+00,.9437E+00,.9070E+00,.9518E+00, &
& .9450E+00,.8785E+00,.7097E+00,.5202E+00,.2521E+00,.4713E+00, &
& .4974E+00,.4416E+00,.2753E+00,.3267E+00,.2329E+00,.1353E+00, &
& .7767E+00,.8913E+00,.9229E+00,.9437E+00,.9070E+00,.9518E+00, &
& .9450E+00,.8785E+00,.7097E+00,.5202E+00,.2521E+00,.4713E+00, &
& .4974E+00,.4416E+00,.2753E+00,.3267E+00,.2329E+00,.1353E+00, &
& .7767E+00,.8913E+00,.9229E+00,.9437E+00,.9070E+00,.9518E+00, &
& .9450E+00,.8785E+00,.7097E+00,.5202E+00,.2521E+00,.4713E+00, &
& .4974E+00,.4416E+00,.2753E+00,.3267E+00,.2329E+00,.1353E+00, &
& .7767E+00,.8913E+00,.9229E+00,.9437E+00,.9070E+00,.9518E+00, &
& .9450E+00,.8785E+00,.7097E+00,.5202E+00,.2521E+00,.4713E+00, &
& .4974E+00,.4416E+00,.2753E+00,.3267E+00,.2329E+00,.1353E+00, &
& .7767E+00,.8913E+00,.9229E+00,.9437E+00,.9070E+00,.9518E+00, &
& .9450E+00,.8785E+00,.7097E+00,.5202E+00,.2521E+00,.4713E+00, &
& .4974E+00,.4416E+00,.2753E+00,.3267E+00,.2329E+00,.1353E+00, &
& .7767E+00,.8913E+00,.9229E+00,.9437E+00,.9070E+00,.9518E+00, &
& .9450E+00,.8785E+00,.7097E+00,.5202E+00,.2521E+00,.4713E+00, &
& .4974E+00,.4416E+00,.2753E+00,.3267E+00,.2329E+00,.1353E+00, &
& .7767E+00,.8913E+00,.9229E+00,.9437E+00,.9070E+00,.9518E+00, &
& .9450E+00,.8785E+00,.7097E+00,.5202E+00,.2521E+00,.4713E+00, &
& .4974E+00,.4416E+00,.2753E+00,.3267E+00,.2329E+00,.1353E+00, &
& .7767E+00,.8913E+00,.9229E+00,.9437E+00,.9070E+00,.9518E+00, &
& .9450E+00,.8785E+00,.7097E+00,.5202E+00,.2521E+00,.4713E+00, &
& .4974E+00,.4416E+00,.2753E+00,.3267E+00,.2329E+00,.1353E+00/
data ((a_extx(i,j,6),i=1,mbx),j=1,nrh) / &
& .1004E+01,.1058E+01,.1170E+01,.1268E+01,.1279E+01,.1229E+01, &
& .1090E+01,.9105E+00,.5986E+00,.3776E+00,.4888E+00,.1196E+01, &
& .6530E+00,.3654E+00,.3515E+00,.4897E+00,.2131E+00,.1327E+00, &
& .1004E+01,.1058E+01,.1170E+01,.1268E+01,.1279E+01,.1229E+01, &
& .1090E+01,.9105E+00,.5986E+00,.3776E+00,.4888E+00,.1196E+01, &
& .6530E+00,.3654E+00,.3515E+00,.4897E+00,.2131E+00,.1327E+00, &
& .1004E+01,.1058E+01,.1170E+01,.1268E+01,.1279E+01,.1229E+01, &
& .1090E+01,.9105E+00,.5986E+00,.3776E+00,.4888E+00,.1196E+01, &
& .6530E+00,.3654E+00,.3515E+00,.4897E+00,.2131E+00,.1327E+00, &
& .1004E+01,.1058E+01,.1170E+01,.1268E+01,.1279E+01,.1229E+01, &
& .1090E+01,.9105E+00,.5986E+00,.3776E+00,.4888E+00,.1196E+01, &
& .6530E+00,.3654E+00,.3515E+00,.4897E+00,.2131E+00,.1327E+00, &
& .1004E+01,.1058E+01,.1170E+01,.1268E+01,.1279E+01,.1229E+01, &
& .1090E+01,.9105E+00,.5986E+00,.3776E+00,.4888E+00,.1196E+01, &
& .6530E+00,.3654E+00,.3515E+00,.4897E+00,.2131E+00,.1327E+00, &
& .1004E+01,.1058E+01,.1170E+01,.1268E+01,.1279E+01,.1229E+01, &
& .1090E+01,.9105E+00,.5986E+00,.3776E+00,.4888E+00,.1196E+01, &
& .6530E+00,.3654E+00,.3515E+00,.4897E+00,.2131E+00,.1327E+00, &
& .1004E+01,.1058E+01,.1170E+01,.1268E+01,.1279E+01,.1229E+01, &
& .1090E+01,.9105E+00,.5986E+00,.3776E+00,.4888E+00,.1196E+01, &
& .6530E+00,.3654E+00,.3515E+00,.4897E+00,.2131E+00,.1327E+00, &
& .1004E+01,.1058E+01,.1170E+01,.1268E+01,.1279E+01,.1229E+01, &
& .1090E+01,.9105E+00,.5986E+00,.3776E+00,.4888E+00,.1196E+01, &
& .6530E+00,.3654E+00,.3515E+00,.4897E+00,.2131E+00,.1327E+00/
data ((a_asyx(i,j,6),i=1,mbx),j=1,nrh) / &
& .8134E+00,.7428E+00,.6826E+00,.6685E+00,.7403E+00,.7278E+00, &
& .6859E+00,.6902E+00,.6914E+00,.6552E+00,.5806E+00,.3985E+00, &
& .4769E+00,.4206E+00,.3269E+00,.2136E+00,.1687E+00,.1122E+00, &
& .8134E+00,.7428E+00,.6826E+00,.6685E+00,.7403E+00,.7278E+00, &
& .6859E+00,.6902E+00,.6914E+00,.6552E+00,.5806E+00,.3985E+00, &
& .4769E+00,.4206E+00,.3269E+00,.2136E+00,.1687E+00,.1122E+00, &
& .8134E+00,.7428E+00,.6826E+00,.6685E+00,.7403E+00,.7278E+00, &
& .6859E+00,.6902E+00,.6914E+00,.6552E+00,.5806E+00,.3985E+00, &
& .4769E+00,.4206E+00,.3269E+00,.2136E+00,.1687E+00,.1122E+00, &
& .8134E+00,.7428E+00,.6826E+00,.6685E+00,.7403E+00,.7278E+00, &
& .6859E+00,.6902E+00,.6914E+00,.6552E+00,.5806E+00,.3985E+00, &
& .4769E+00,.4206E+00,.3269E+00,.2136E+00,.1687E+00,.1122E+00, &
& .8134E+00,.7428E+00,.6826E+00,.6685E+00,.7403E+00,.7278E+00, &
& .6859E+00,.6902E+00,.6914E+00,.6552E+00,.5806E+00,.3985E+00, &
& .4769E+00,.4206E+00,.3269E+00,.2136E+00,.1687E+00,.1122E+00, &
& .8134E+00,.7428E+00,.6826E+00,.6685E+00,.7403E+00,.7278E+00, &
& .6859E+00,.6902E+00,.6914E+00,.6552E+00,.5806E+00,.3985E+00, &
& .4769E+00,.4206E+00,.3269E+00,.2136E+00,.1687E+00,.1122E+00, &
& .8134E+00,.7428E+00,.6826E+00,.6685E+00,.7403E+00,.7278E+00, &
& .6859E+00,.6902E+00,.6914E+00,.6552E+00,.5806E+00,.3985E+00, &
& .4769E+00,.4206E+00,.3269E+00,.2136E+00,.1687E+00,.1122E+00, &
& .8134E+00,.7428E+00,.6826E+00,.6685E+00,.7403E+00,.7278E+00, &
& .6859E+00,.6902E+00,.6914E+00,.6552E+00,.5806E+00,.3985E+00, &
& .4769E+00,.4206E+00,.3269E+00,.2136E+00,.1687E+00,.1122E+00/
!c ***********************************************
!c Data statements for T&L 4.0 micron dust aerosol
!c ***********************************************
data ((a_ssax(i,j,7),i=1,mbx),j=1,nrh) / &
& .6979E+00,.8213E+00,.8632E+00,.8896E+00,.8303E+00,.9082E+00, &
& .9083E+00,.8444E+00,.7304E+00,.6223E+00,.3484E+00,.4968E+00, &
& .5537E+00,.5626E+00,.4275E+00,.4462E+00,.4227E+00,.3573E+00, &
& .6979E+00,.8213E+00,.8632E+00,.8896E+00,.8303E+00,.9082E+00, &
& .9083E+00,.8444E+00,.7304E+00,.6223E+00,.3484E+00,.4968E+00, &
& .5537E+00,.5626E+00,.4275E+00,.4462E+00,.4227E+00,.3573E+00, &
& .6979E+00,.8213E+00,.8632E+00,.8896E+00,.8303E+00,.9082E+00, &
& .9083E+00,.8444E+00,.7304E+00,.6223E+00,.3484E+00,.4968E+00, &
& .5537E+00,.5626E+00,.4275E+00,.4462E+00,.4227E+00,.3573E+00, &
& .6979E+00,.8213E+00,.8632E+00,.8896E+00,.8303E+00,.9082E+00, &
& .9083E+00,.8444E+00,.7304E+00,.6223E+00,.3484E+00,.4968E+00, &
& .5537E+00,.5626E+00,.4275E+00,.4462E+00,.4227E+00,.3573E+00, &
& .6979E+00,.8213E+00,.8632E+00,.8896E+00,.8303E+00,.9082E+00, &
& .9083E+00,.8444E+00,.7304E+00,.6223E+00,.3484E+00,.4968E+00, &
& .5537E+00,.5626E+00,.4275E+00,.4462E+00,.4227E+00,.3573E+00, &
& .6979E+00,.8213E+00,.8632E+00,.8896E+00,.8303E+00,.9082E+00, &
& .9083E+00,.8444E+00,.7304E+00,.6223E+00,.3484E+00,.4968E+00, &
& .5537E+00,.5626E+00,.4275E+00,.4462E+00,.4227E+00,.3573E+00, &
& .6979E+00,.8213E+00,.8632E+00,.8896E+00,.8303E+00,.9082E+00, &
& .9083E+00,.8444E+00,.7304E+00,.6223E+00,.3484E+00,.4968E+00, &
& .5537E+00,.5626E+00,.4275E+00,.4462E+00,.4227E+00,.3573E+00, &
& .6979E+00,.8213E+00,.8632E+00,.8896E+00,.8303E+00,.9082E+00, &
& .9083E+00,.8444E+00,.7304E+00,.6223E+00,.3484E+00,.4968E+00, &
& .5537E+00,.5626E+00,.4275E+00,.4462E+00,.4227E+00,.3573E+00/
data ((a_extx(i,j,7),i=1,mbx),j=1,nrh) / &
& .1003E+01,.1034E+01,.1088E+01,.1130E+01,.1278E+01,.1325E+01, &
& .1396E+01,.1369E+01,.1214E+01,.8716E+00,.7715E+00,.1332E+01, &
& .1231E+01,.9736E+00,.8431E+00,.1167E+01,.8008E+00,.5356E+00, &
& .1003E+01,.1034E+01,.1088E+01,.1130E+01,.1278E+01,.1325E+01, &
& .1396E+01,.1369E+01,.1214E+01,.8716E+00,.7715E+00,.1332E+01, &
& .1231E+01,.9736E+00,.8431E+00,.1167E+01,.8008E+00,.5356E+00, &
& .1003E+01,.1034E+01,.1088E+01,.1130E+01,.1278E+01,.1325E+01, &
& .1396E+01,.1369E+01,.1214E+01,.8716E+00,.7715E+00,.1332E+01, &
& .1231E+01,.9736E+00,.8431E+00,.1167E+01,.8008E+00,.5356E+00, &
& .1003E+01,.1034E+01,.1088E+01,.1130E+01,.1278E+01,.1325E+01, &
& .1396E+01,.1369E+01,.1214E+01,.8716E+00,.7715E+00,.1332E+01, &
& .1231E+01,.9736E+00,.8431E+00,.1167E+01,.8008E+00,.5356E+00, &
& .1003E+01,.1034E+01,.1088E+01,.1130E+01,.1278E+01,.1325E+01, &
& .1396E+01,.1369E+01,.1214E+01,.8716E+00,.7715E+00,.1332E+01, &
& .1231E+01,.9736E+00,.8431E+00,.1167E+01,.8008E+00,.5356E+00, &
& .1003E+01,.1034E+01,.1088E+01,.1130E+01,.1278E+01,.1325E+01, &
& .1396E+01,.1369E+01,.1214E+01,.8716E+00,.7715E+00,.1332E+01, &
& .1231E+01,.9736E+00,.8431E+00,.1167E+01,.8008E+00,.5356E+00, &
& .1003E+01,.1034E+01,.1088E+01,.1130E+01,.1278E+01,.1325E+01, &
& .1396E+01,.1369E+01,.1214E+01,.8716E+00,.7715E+00,.1332E+01, &
& .1231E+01,.9736E+00,.8431E+00,.1167E+01,.8008E+00,.5356E+00, &
& .1003E+01,.1034E+01,.1088E+01,.1130E+01,.1278E+01,.1325E+01, &
& .1396E+01,.1369E+01,.1214E+01,.8716E+00,.7715E+00,.1332E+01, &
& .1231E+01,.9736E+00,.8431E+00,.1167E+01,.8008E+00,.5356E+00/
data ((a_asyx(i,j,7),i=1,mbx),j=1,nrh) / &
& .8694E+00,.8106E+00,.7632E+00,.7289E+00,.7415E+00,.7160E+00, &
& .6904E+00,.7315E+00,.8001E+00,.8185E+00,.7903E+00,.5996E+00, &
& .6566E+00,.6460E+00,.5866E+00,.3647E+00,.3224E+00,.2752E+00, &
& .8694E+00,.8106E+00,.7632E+00,.7289E+00,.7415E+00,.7160E+00, &
& .6904E+00,.7315E+00,.8001E+00,.8185E+00,.7903E+00,.5996E+00, &
& .6566E+00,.6460E+00,.5866E+00,.3647E+00,.3224E+00,.2752E+00, &
& .8694E+00,.8106E+00,.7632E+00,.7289E+00,.7415E+00,.7160E+00, &
& .6904E+00,.7315E+00,.8001E+00,.8185E+00,.7903E+00,.5996E+00, &
& .6566E+00,.6460E+00,.5866E+00,.3647E+00,.3224E+00,.2752E+00, &
& .8694E+00,.8106E+00,.7632E+00,.7289E+00,.7415E+00,.7160E+00, &
& .6904E+00,.7315E+00,.8001E+00,.8185E+00,.7903E+00,.5996E+00, &
& .6566E+00,.6460E+00,.5866E+00,.3647E+00,.3224E+00,.2752E+00, &
& .8694E+00,.8106E+00,.7632E+00,.7289E+00,.7415E+00,.7160E+00, &
& .6904E+00,.7315E+00,.8001E+00,.8185E+00,.7903E+00,.5996E+00, &
& .6566E+00,.6460E+00,.5866E+00,.3647E+00,.3224E+00,.2752E+00, &
& .8694E+00,.8106E+00,.7632E+00,.7289E+00,.7415E+00,.7160E+00, &
& .6904E+00,.7315E+00,.8001E+00,.8185E+00,.7903E+00,.5996E+00, &
& .6566E+00,.6460E+00,.5866E+00,.3647E+00,.3224E+00,.2752E+00, &
& .8694E+00,.8106E+00,.7632E+00,.7289E+00,.7415E+00,.7160E+00, &
& .6904E+00,.7315E+00,.8001E+00,.8185E+00,.7903E+00,.5996E+00, &
& .6566E+00,.6460E+00,.5866E+00,.3647E+00,.3224E+00,.2752E+00, &
& .8694E+00,.8106E+00,.7632E+00,.7289E+00,.7415E+00,.7160E+00, &
& .6904E+00,.7315E+00,.8001E+00,.8185E+00,.7903E+00,.5996E+00, &
& .6566E+00,.6460E+00,.5866E+00,.3647E+00,.3224E+00,.2752E+00/
!c ***********************************************
!c Data statements for T&L 8.0 micron dust aerosol
!c ***********************************************
data ((a_ssax(i,j,8),i=1,mbx),j=1,nrh) / &
& .6279E+00,.7298E+00,.7835E+00,.8196E+00,.7267E+00,.8274E+00, &
& .8228E+00,.7316E+00,.6350E+00,.6091E+00,.4227E+00,.5355E+00, &
& .5210E+00,.5494E+00,.4857E+00,.4905E+00,.4786E+00,.4606E+00, &
& .6279E+00,.7298E+00,.7835E+00,.8196E+00,.7267E+00,.8274E+00, &
& .8228E+00,.7316E+00,.6350E+00,.6091E+00,.4227E+00,.5355E+00, &
& .5210E+00,.5494E+00,.4857E+00,.4905E+00,.4786E+00,.4606E+00, &
& .6279E+00,.7298E+00,.7835E+00,.8196E+00,.7267E+00,.8274E+00, &
& .8228E+00,.7316E+00,.6350E+00,.6091E+00,.4227E+00,.5355E+00, &
& .5210E+00,.5494E+00,.4857E+00,.4905E+00,.4786E+00,.4606E+00, &
& .6279E+00,.7298E+00,.7835E+00,.8196E+00,.7267E+00,.8274E+00, &
& .8228E+00,.7316E+00,.6350E+00,.6091E+00,.4227E+00,.5355E+00, &
& .5210E+00,.5494E+00,.4857E+00,.4905E+00,.4786E+00,.4606E+00, &
& .6279E+00,.7298E+00,.7835E+00,.8196E+00,.7267E+00,.8274E+00, &
& .8228E+00,.7316E+00,.6350E+00,.6091E+00,.4227E+00,.5355E+00, &
& .5210E+00,.5494E+00,.4857E+00,.4905E+00,.4786E+00,.4606E+00, &
& .6279E+00,.7298E+00,.7835E+00,.8196E+00,.7267E+00,.8274E+00, &
& .8228E+00,.7316E+00,.6350E+00,.6091E+00,.4227E+00,.5355E+00, &
& .5210E+00,.5494E+00,.4857E+00,.4905E+00,.4786E+00,.4606E+00, &
& .6279E+00,.7298E+00,.7835E+00,.8196E+00,.7267E+00,.8274E+00, &
& .8228E+00,.7316E+00,.6350E+00,.6091E+00,.4227E+00,.5355E+00, &
& .5210E+00,.5494E+00,.4857E+00,.4905E+00,.4786E+00,.4606E+00, &
& .6279E+00,.7298E+00,.7835E+00,.8196E+00,.7267E+00,.8274E+00, &
& .8228E+00,.7316E+00,.6350E+00,.6091E+00,.4227E+00,.5355E+00, &
& .5210E+00,.5494E+00,.4857E+00,.4905E+00,.4786E+00,.4606E+00/
data ((a_extx(i,j,8),i=1,mbx),j=1,nrh) / &
& .1002E+01,.1022E+01,.1054E+01,.1076E+01,.1139E+01,.1159E+01, &
& .1207E+01,.1239E+01,.1280E+01,.1182E+01,.9419E+00,.1253E+01, &
& .1321E+01,.1320E+01,.1211E+01,.1372E+01,.1347E+01,.1223E+01, &
& .1002E+01,.1022E+01,.1054E+01,.1076E+01,.1139E+01,.1159E+01, &
& .1207E+01,.1239E+01,.1280E+01,.1182E+01,.9419E+00,.1253E+01, &
& .1321E+01,.1320E+01,.1211E+01,.1372E+01,.1347E+01,.1223E+01, &
& .1002E+01,.1022E+01,.1054E+01,.1076E+01,.1139E+01,.1159E+01, &
& .1207E+01,.1239E+01,.1280E+01,.1182E+01,.9419E+00,.1253E+01, &
& .1321E+01,.1320E+01,.1211E+01,.1372E+01,.1347E+01,.1223E+01, &
& .1002E+01,.1022E+01,.1054E+01,.1076E+01,.1139E+01,.1159E+01, &
& .1207E+01,.1239E+01,.1280E+01,.1182E+01,.9419E+00,.1253E+01, &
& .1321E+01,.1320E+01,.1211E+01,.1372E+01,.1347E+01,.1223E+01, &
& .1002E+01,.1022E+01,.1054E+01,.1076E+01,.1139E+01,.1159E+01, &
& .1207E+01,.1239E+01,.1280E+01,.1182E+01,.9419E+00,.1253E+01, &
& .1321E+01,.1320E+01,.1211E+01,.1372E+01,.1347E+01,.1223E+01, &
& .1002E+01,.1022E+01,.1054E+01,.1076E+01,.1139E+01,.1159E+01, &
& .1207E+01,.1239E+01,.1280E+01,.1182E+01,.9419E+00,.1253E+01, &
& .1321E+01,.1320E+01,.1211E+01,.1372E+01,.1347E+01,.1223E+01, &
& .1002E+01,.1022E+01,.1054E+01,.1076E+01,.1139E+01,.1159E+01, &
& .1207E+01,.1239E+01,.1280E+01,.1182E+01,.9419E+00,.1253E+01, &
& .1321E+01,.1320E+01,.1211E+01,.1372E+01,.1347E+01,.1223E+01, &
& .1002E+01,.1022E+01,.1054E+01,.1076E+01,.1139E+01,.1159E+01, &
& .1207E+01,.1239E+01,.1280E+01,.1182E+01,.9419E+00,.1253E+01, &
& .1321E+01,.1320E+01,.1211E+01,.1372E+01,.1347E+01,.1223E+01/
data ((a_asyx(i,j,8),i=1,mbx),j=1,nrh) / &
& .9078E+00,.8641E+00,.8296E+00,.8045E+00,.8136E+00,.7683E+00, &
& .7318E+00,.7706E+00,.8403E+00,.8819E+00,.8892E+00,.7333E+00, &
& .7707E+00,.7667E+00,.7564E+00,.5706E+00,.4955E+00,.4467E+00, &
& .9078E+00,.8641E+00,.8296E+00,.8045E+00,.8136E+00,.7683E+00, &
& .7318E+00,.7706E+00,.8403E+00,.8819E+00,.8892E+00,.7333E+00, &
& .7707E+00,.7667E+00,.7564E+00,.5706E+00,.4955E+00,.4467E+00, &
& .9078E+00,.8641E+00,.8296E+00,.8045E+00,.8136E+00,.7683E+00, &
& .7318E+00,.7706E+00,.8403E+00,.8819E+00,.8892E+00,.7333E+00, &
& .7707E+00,.7667E+00,.7564E+00,.5706E+00,.4955E+00,.4467E+00, &
& .9078E+00,.8641E+00,.8296E+00,.8045E+00,.8136E+00,.7683E+00, &
& .7318E+00,.7706E+00,.8403E+00,.8819E+00,.8892E+00,.7333E+00, &
& .7707E+00,.7667E+00,.7564E+00,.5706E+00,.4955E+00,.4467E+00, &
& .9078E+00,.8641E+00,.8296E+00,.8045E+00,.8136E+00,.7683E+00, &
& .7318E+00,.7706E+00,.8403E+00,.8819E+00,.8892E+00,.7333E+00, &
& .7707E+00,.7667E+00,.7564E+00,.5706E+00,.4955E+00,.4467E+00, &
& .9078E+00,.8641E+00,.8296E+00,.8045E+00,.8136E+00,.7683E+00, &
& .7318E+00,.7706E+00,.8403E+00,.8819E+00,.8892E+00,.7333E+00, &
& .7707E+00,.7667E+00,.7564E+00,.5706E+00,.4955E+00,.4467E+00, &
& .9078E+00,.8641E+00,.8296E+00,.8045E+00,.8136E+00,.7683E+00, &
& .7318E+00,.7706E+00,.8403E+00,.8819E+00,.8892E+00,.7333E+00, &
& .7707E+00,.7667E+00,.7564E+00,.5706E+00,.4955E+00,.4467E+00, &
& .9078E+00,.8641E+00,.8296E+00,.8045E+00,.8136E+00,.7683E+00, &
& .7318E+00,.7706E+00,.8403E+00,.8819E+00,.8892E+00,.7333E+00, &
& .7707E+00,.7667E+00,.7564E+00,.5706E+00,.4955E+00,.4467E+00/
!====================================================================
! OPAC X
!-----------------------------------------------------------
!9) inso Insoluble
data ((a_extx(i,j, 9 ),i=1,mbx), j=1,1 ) / &
& 0.9992E+00,0.1055E+01,0.1097E+01,0.9565E+00,0.7209E+00,0.8266E+00, &
& 0.6757E+00,0.4984E+00,0.4294E+00,0.4649E+00,0.5541E+00,0.8549E+00, &
& 0.6774E+00,0.5136E+00,0.4909E+00,0.4952E+00,0.4213E+00,0.3563E+00/
data ((a_ssax(i,j, 9 ),i=1,mbx), j=1,1 ) / &
& 0.7289E+00,0.7933E+00,0.8553E+00,0.8828E+00,0.8465E+00,0.8840E+00, &
& 0.8537E+00,0.7561E+00,0.5914E+00,0.6595E+00,0.5205E+00,0.5811E+00, &
& 0.6361E+00,0.6307E+00,0.6348E+00,0.5020E+00,0.4057E+00,0.3352E+00/
data ((a_asyx(i,j, 9 ),i=1,mbx), j=1,1 ) / &
& 0.8317E+00,0.7882E+00,0.8003E+00,0.8834E+00,0.9145E+00,0.8506E+00, &
& 0.8563E+00,0.8778E+00,0.8615E+00,0.8283E+00,0.7892E+00,0.6657E+00, &
& 0.6808E+00,0.6886E+00,0.6387E+00,0.5706E+00,0.4973E+00,0.3480E+00/
!-----------------------------------------------------------
!10) waso Water Soluble (8 RH%)
data ((a_extx(i,j,10 ),i=1,mbx), j=1,8 ) / &
& 0.1015E+01,0.4304E+00,0.1407E+00,0.4076E-01,0.2793E-01,0.9580E-02, &
& 0.8208E-02,0.8256E-02,0.1281E-01,0.1857E-01,0.3590E-01,0.2404E-01, &
& 0.8152E-02,0.8273E-02,0.2205E-01,0.1285E-01,0.1426E-01,0.2008E-01, &
& 0.1015E+01,0.4417E+00,0.1461E+00,0.4302E-01,0.7731E-01,0.1407E-01, &
& 0.1064E-01,0.1307E-01,0.1784E-01,0.1697E-01,0.3190E-01,0.2466E-01, &
& 0.1843E-01,0.3242E-01,0.3835E-01,0.2407E-01,0.1947E-01,0.2221E-01, &
& 0.1014E+01,0.4488E+00,0.1501E+00,0.4563E-01,0.9123E-01,0.1620E-01, &
& 0.1167E-01,0.1446E-01,0.1949E-01,0.1647E-01,0.2965E-01,0.2378E-01, &
& 0.2184E-01,0.4049E-01,0.4408E-01,0.2782E-01,0.2101E-01,0.2265E-01, &
& 0.1014E+01,0.4559E+00,0.1546E+00,0.4833E-01,0.1014E+00,0.1818E-01, &
& 0.1258E-01,0.1550E-01,0.2072E-01,0.1613E-01,0.2769E-01,0.2283E-01, &
& 0.2429E-01,0.4633E-01,0.4824E-01,0.3054E-01,0.2207E-01,0.2287E-01, &
& 0.1013E+01,0.4713E+00,0.1650E+00,0.5434E-01,0.1170E+00,0.2223E-01, &
& 0.1438E-01,0.1721E-01,0.2264E-01,0.1573E-01,0.2436E-01,0.2105E-01, &
& 0.2776E-01,0.5469E-01,0.5422E-01,0.3446E-01,0.2350E-01,0.2308E-01, &
& 0.1012E+01,0.4913E+00,0.1795E+00,0.6242E-01,0.1310E+00,0.2735E-01, &
& 0.1663E-01,0.1898E-01,0.2444E-01,0.1565E-01,0.2154E-01,0.1943E-01, &
& 0.3035E-01,0.6100E-01,0.5878E-01,0.3746E-01,0.2454E-01,0.2318E-01, &
& 0.1011E+01,0.5221E+00,0.2038E+00,0.7577E-01,0.1474E+00,0.3559E-01, &
& 0.2032E-01,0.2156E-01,0.2687E-01,0.1612E-01,0.1925E-01,0.1809E-01, &
& 0.3271E-01,0.6668E-01,0.6308E-01,0.4032E-01,0.2557E-01,0.2331E-01, &
& 0.1010E+01,0.5447E+00,0.2230E+00,0.8651E-01,0.1583E+00,0.4224E-01, &
& 0.2339E-01,0.2363E-01,0.2874E-01,0.1684E-01,0.1855E-01,0.1772E-01, &
& 0.3399E-01,0.6967E-01,0.6553E-01,0.4195E-01,0.2624E-01,0.2355E-01/
data ((a_ssax(i,j,10 ),i=1,mbx), j=1,8 ) / &
& 0.9633E+00,0.8961E+00,0.7687E+00,0.7940E+00,0.5192E+00,0.7595E+00, &
& 0.3996E+00,0.2073E+00,0.9201E-01,0.1337E-01,0.3585E-01,0.4407E-01, &
& 0.3943E-01,0.1419E-01,0.4977E-02,0.3965E-02,0.8396E-03,0.1067E-03, &
& 0.9776E+00,0.9357E+00,0.8539E+00,0.8702E+00,0.4324E+00,0.7956E+00, &
& 0.4373E+00,0.2277E+00,0.9151E-01,0.3219E-01,0.3617E-01,0.4094E-01, &
& 0.1815E-01,0.4240E-02,0.3668E-02,0.3164E-02,0.1059E-02,0.1485E-03, &
& 0.9820E+00,0.9484E+00,0.8829E+00,0.8940E+00,0.4503E+00,0.8121E+00, &
& 0.4596E+00,0.2482E+00,0.9977E-01,0.4317E-01,0.3868E-01,0.4120E-01, &
& 0.1566E-01,0.3913E-02,0.3780E-02,0.3268E-02,0.1219E-02,0.1749E-03, &
& 0.9850E+00,0.9577E+00,0.9041E+00,0.9111E+00,0.4686E+00,0.8259E+00, &
& 0.4808E+00,0.2680E+00,0.1088E+00,0.5411E-01,0.4245E-01,0.4209E-01, &
& 0.1441E-01,0.3948E-02,0.4031E-02,0.3475E-02,0.1394E-02,0.2031E-03, &
& 0.9895E+00,0.9710E+00,0.9349E+00,0.9351E+00,0.5035E+00,0.8496E+00, &
& 0.5230E+00,0.3079E+00,0.1297E+00,0.7788E-01,0.5266E-01,0.4537E-01, &
& 0.1346E-01,0.4473E-02,0.4808E-02,0.4116E-02,0.1823E-02,0.2823E-03, &
& 0.9928E+00,0.9810E+00,0.9578E+00,0.9527E+00,0.5393E+00,0.8720E+00, &
& 0.5707E+00,0.3541E+00,0.1579E+00,0.1089E+00,0.6886E-01,0.5146E-01, &
& 0.1377E-01,0.5552E-02,0.6102E-02,0.5203E-02,0.2488E-02,0.4103E-03, &
& 0.9956E+00,0.9891E+00,0.9761E+00,0.9670E+00,0.5805E+00,0.8959E+00, &
& 0.6318E+00,0.4163E+00,0.2022E+00,0.1575E+00,0.9848E-01,0.6388E-01, &
& 0.1577E-01,0.7723E-02,0.8602E-02,0.7370E-02,0.3795E-02,0.6676E-03, &
& 0.9968E+00,0.9924E+00,0.9834E+00,0.9730E+00,0.6038E+00,0.9087E+00, &
& 0.6692E+00,0.4563E+00,0.2352E+00,0.1938E+00,0.1231E+00,0.7513E-01, &
& 0.1802E-01,0.9667E-02,0.1084E-01,0.9370E-02,0.5020E-02,0.9152E-03/
data ((a_asyx(i,j,10 ),i=1,mbx), j=1,8 ) / &
& 0.6143E+00,0.5585E+00,0.4813E+00,0.4255E+00,0.3592E+00,0.3090E+00, &
& 0.2571E+00,0.2231E+00,0.1912E+00,0.1539E+00,0.1519E+00,0.1543E+00, &
& 0.1251E+00,0.9279E-01,0.7617E-01,0.6363E-01,0.3473E-01,0.1405E-01, &
& 0.6722E+00,0.6148E+00,0.5341E+00,0.4799E+00,0.3881E+00,0.3523E+00, &
& 0.2969E+00,0.2574E+00,0.2247E+00,0.1905E+00,0.1774E+00,0.1667E+00, &
& 0.1328E+00,0.9845E-01,0.8187E-01,0.6865E-01,0.4277E-01,0.1880E-01, &
& 0.6904E+00,0.6342E+00,0.5549E+00,0.5011E+00,0.4022E+00,0.3708E+00, &
& 0.3143E+00,0.2736E+00,0.2399E+00,0.2062E+00,0.1893E+00,0.1753E+00, &
& 0.1392E+00,0.1030E+00,0.8623E-01,0.7257E-01,0.4688E-01,0.2120E-01, &
& 0.7042E+00,0.6494E+00,0.5709E+00,0.5194E+00,0.4152E+00,0.3860E+00, &
& 0.3294E+00,0.2869E+00,0.2526E+00,0.2205E+00,0.2002E+00,0.1837E+00, &
& 0.1454E+00,0.1079E+00,0.9064E-01,0.7653E-01,0.5081E-01,0.2344E-01, &
& 0.7254E+00,0.6740E+00,0.5991E+00,0.5504E+00,0.4394E+00,0.4146E+00, &
& 0.3578E+00,0.3133E+00,0.2782E+00,0.2459E+00,0.2224E+00,0.2017E+00, &
& 0.1597E+00,0.1181E+00,0.1001E+00,0.8510E-01,0.5879E-01,0.2824E-01, &
& 0.7433E+00,0.6967E+00,0.6270E+00,0.5823E+00,0.4667E+00,0.4446E+00, &
& 0.3888E+00,0.3432E+00,0.3068E+00,0.2755E+00,0.2484E+00,0.2241E+00, &
& 0.1777E+00,0.1315E+00,0.1119E+00,0.9622E-01,0.6871E-01,0.3408E-01, &
& 0.7612E+00,0.7217E+00,0.6594E+00,0.6202E+00,0.5032E+00,0.4833E+00, &
& 0.4295E+00,0.3836E+00,0.3454E+00,0.3147E+00,0.2852E+00,0.2571E+00, &
& 0.2045E+00,0.1520E+00,0.1300E+00,0.1126E+00,0.8357E-01,0.4311E-01, &
& 0.7701E+00,0.7355E+00,0.6784E+00,0.6433E+00,0.5268E+00,0.5073E+00, &
& 0.4559E+00,0.4108E+00,0.3712E+00,0.3412E+00,0.3106E+00,0.2803E+00, &
& 0.2242E+00,0.1672E+00,0.1436E+00,0.1248E+00,0.9454E-01,0.5018E-01/
!-----------------------------------------------------------
!11) soot Soot
data ((a_extx(i,j,11 ),i=1,mbx), j=1,1 ) / &
& 0.1017E+01,0.5114E+00,0.2718E+00,0.1911E+00,0.1446E+00,0.1113E+00, &
& 0.8555E-01,0.7200E-01,0.6089E-01,0.5213E-01,0.4566E-01,0.4003E-01, &
& 0.3392E-01,0.2769E-01,0.2254E-01,0.1702E-01,0.1213E-01,0.7093E-02/
data ((a_ssax(i,j,11 ),i=1,mbx), j=1,1 ) / &
& 0.2102E+00,0.1127E+00,0.4250E-01,0.2007E-01,0.9655E-02,0.5070E-02, &
& 0.2738E-02,0.1795E-02,0.1192E-02,0.8190E-03,0.6116E-03,0.4481E-03, &
& 0.2918E-03,0.1761E-03,0.1049E-03,0.5490E-04,0.2308E-04,0.5530E-05/
data ((a_asyx(i,j,11 ),i=1,mbx), j=1,1 ) / &
& 0.3375E+00,0.2412E+00,0.1541E+00,0.1086E+00,0.7644E-01,0.5501E-01, &
& 0.3917E-01,0.3088E-01,0.2415E-01,0.1913E-01,0.1581E-01,0.1289E-01, &
& 0.9727E-02,0.6915E-02,0.4858E-02,0.3121E-02,0.1759E-02,0.1141E-02/
!-----------------------------------------------------------
!12) ssam Sea Salt (Accumulation Mode) (8 RH%)
data ((a_extx(i,j,12 ),i=1,mbx), j=1,8 ) / &
& 0.9977E+00,0.9420E+00,0.7044E+00,0.4678E+00,0.4148E+00,0.2336E+00, &
& 0.1493E+00,0.7957E-01,0.7247E-01,0.4367E-01,0.5551E-01,0.4474E-01, &
& 0.2241E-01,0.1365E-01,0.2654E-01,0.2912E-01,0.3158E-01,0.1472E+00, &
& 0.9989E+00,0.1010E+01,0.8520E+00,0.6085E+00,0.5675E+00,0.4096E+00, &
& 0.2546E+00,0.1694E+00,0.1644E+00,0.1067E+00,0.9235E-01,0.7284E-01, &
& 0.8140E-01,0.1443E+00,0.1495E+00,0.1081E+00,0.7115E-01,0.1054E+00, &
& 0.9984E+00,0.1028E+01,0.9029E+00,0.6677E+00,0.6213E+00,0.4742E+00, &
& 0.2993E+00,0.2035E+00,0.1981E+00,0.1314E+00,0.1092E+00,0.8514E-01, &
& 0.9789E-01,0.1765E+00,0.1827E+00,0.1321E+00,0.8473E-01,0.1036E+00, &
& 0.9991E+00,0.1045E+01,0.9466E+00,0.7224E+00,0.6693E+00,0.5337E+00, &
& 0.3425E+00,0.2364E+00,0.2303E+00,0.1556E+00,0.1262E+00,0.9751E-01, &
& 0.1125E+00,0.2040E+00,0.2118E+00,0.1541E+00,0.9772E-01,0.1055E+00, &
& 0.9984E+00,0.1066E+01,0.1022E+01,0.8298E+00,0.7614E+00,0.6542E+00, &
& 0.4369E+00,0.3089E+00,0.3009E+00,0.2109E+00,0.1665E+00,0.1265E+00, &
& 0.1427E+00,0.2574E+00,0.2702E+00,0.2006E+00,0.1267E+00,0.1155E+00, &
& 0.9990E+00,0.1079E+01,0.1088E+01,0.9476E+00,0.8625E+00,0.7960E+00, &
& 0.5610E+00,0.4073E+00,0.3966E+00,0.2898E+00,0.2262E+00,0.1696E+00, &
& 0.1816E+00,0.3214E+00,0.3426E+00,0.2624E+00,0.1681E+00,0.1363E+00, &
& 0.9994E+00,0.1075E+01,0.1141E+01,0.1086E+01,0.9872E+00,0.9866E+00, &
& 0.7578E+00,0.5745E+00,0.5599E+00,0.4348E+00,0.3419E+00,0.2551E+00, &
& 0.2490E+00,0.4208E+00,0.4585E+00,0.3704E+00,0.2469E+00,0.1830E+00, &
& 0.9998E+00,0.1066E+01,0.1149E+01,0.1154E+01,0.1059E+01,0.1105E+01, &
& 0.9090E+00,0.7161E+00,0.7000E+00,0.5694E+00,0.4561E+00,0.3430E+00, &
& 0.3119E+00,0.5031E+00,0.5565E+00,0.4695E+00,0.3264E+00,0.2343E+00/
data ((a_ssax(i,j,12 ),i=1,mbx), j=1,8 ) / &
& 0.1000E+01,0.9991E+00,0.9957E+00,0.9892E+00,0.9560E+00,0.9897E+00, &
& 0.9825E+00,0.9471E+00,0.9222E+00,0.8519E+00,0.7555E+00,0.8130E+00, &
& 0.7537E+00,0.5286E+00,0.2979E+00,0.1749E+00,0.6170E-01,0.1383E-01, &
& 0.1000E+01,0.9997E+00,0.9976E+00,0.9895E+00,0.7743E+00,0.9725E+00, &
& 0.9208E+00,0.8068E+00,0.6949E+00,0.7072E+00,0.6425E+00,0.5446E+00, &
& 0.2100E+00,0.9825E-01,0.1218E+00,0.1271E+00,0.8758E-01,0.1948E-01, &
& 0.1000E+01,0.9997E+00,0.9978E+00,0.9891E+00,0.7705E+00,0.9709E+00, &
& 0.9168E+00,0.8044E+00,0.6898E+00,0.7093E+00,0.6428E+00,0.5309E+00, &
& 0.1996E+00,0.1070E+00,0.1312E+00,0.1383E+00,0.1012E+00,0.2443E-01, &
& 0.1000E+01,0.9998E+00,0.9979E+00,0.9888E+00,0.7694E+00,0.9699E+00, &
& 0.9150E+00,0.8052E+00,0.6901E+00,0.7145E+00,0.6474E+00,0.5283E+00, &
& 0.1984E+00,0.1163E+00,0.1411E+00,0.1495E+00,0.1139E+00,0.2946E-01, &
& 0.1000E+01,0.9999E+00,0.9979E+00,0.9880E+00,0.7688E+00,0.9681E+00, &
& 0.9134E+00,0.8094E+00,0.6964E+00,0.7279E+00,0.6622E+00,0.5372E+00, &
& 0.2072E+00,0.1367E+00,0.1631E+00,0.1741E+00,0.1408E+00,0.4127E-01, &
& 0.1000E+01,0.9999E+00,0.9978E+00,0.9865E+00,0.7684E+00,0.9659E+00, &
& 0.9123E+00,0.8156E+00,0.7064E+00,0.7438E+00,0.6826E+00,0.5588E+00, &
& 0.2270E+00,0.1626E+00,0.1908E+00,0.2048E+00,0.1747E+00,0.5801E-01, &
& 0.1000E+01,0.9998E+00,0.9975E+00,0.9835E+00,0.7657E+00,0.9612E+00, &
& 0.9093E+00,0.8228E+00,0.7186E+00,0.7624E+00,0.7101E+00,0.5961E+00, &
& 0.2647E+00,0.2028E+00,0.2331E+00,0.2512E+00,0.2267E+00,0.9154E-01, &
& 0.1000E+01,0.9998E+00,0.9970E+00,0.9801E+00,0.7611E+00,0.9558E+00, &
& 0.9043E+00,0.8251E+00,0.7236E+00,0.7714E+00,0.7266E+00,0.6232E+00, &
& 0.2972E+00,0.2351E+00,0.2662E+00,0.2865E+00,0.2670E+00,0.1236E+00/
data ((a_asyx(i,j,12 ),i=1,mbx), j=1,8 ) / &
& 0.6925E+00,0.7030E+00,0.7037E+00,0.7018E+00,0.6290E+00,0.6210E+00, &
& 0.5823E+00,0.5754E+00,0.5304E+00,0.5025E+00,0.4631E+00,0.4344E+00, &
& 0.4025E+00,0.3539E+00,0.3069E+00,0.2526E+00,0.1773E+00,0.5475E-01, &
& 0.7710E+00,0.7780E+00,0.7844E+00,0.7895E+00,0.7592E+00,0.7110E+00, &
& 0.6965E+00,0.6880E+00,0.6458E+00,0.6223E+00,0.5924E+00,0.5645E+00, &
& 0.5042E+00,0.4073E+00,0.3515E+00,0.3059E+00,0.2449E+00,0.1281E+00, &
& 0.7783E+00,0.7853E+00,0.7928E+00,0.8012E+00,0.7771E+00,0.7257E+00, &
& 0.7169E+00,0.7105E+00,0.6705E+00,0.6489E+00,0.6225E+00,0.5962E+00, &
& 0.5341E+00,0.4315E+00,0.3729E+00,0.3270E+00,0.2664E+00,0.1485E+00, &
& 0.7840E+00,0.7886E+00,0.7979E+00,0.8088E+00,0.7893E+00,0.7363E+00, &
& 0.7324E+00,0.7284E+00,0.6893E+00,0.6702E+00,0.6456E+00,0.6215E+00, &
& 0.5591E+00,0.4524E+00,0.3921E+00,0.3454E+00,0.2847E+00,0.1658E+00, &
& 0.7933E+00,0.7934E+00,0.8035E+00,0.8182E+00,0.8105E+00,0.7519E+00, &
& 0.7564E+00,0.7580E+00,0.7218E+00,0.7047E+00,0.6859E+00,0.6656E+00, &
& 0.6055E+00,0.4947E+00,0.4303E+00,0.3819E+00,0.3207E+00,0.2002E+00, &
& 0.8009E+00,0.7966E+00,0.8065E+00,0.8250E+00,0.8289E+00,0.7651E+00, &
& 0.7777E+00,0.7851E+00,0.7526E+00,0.7388E+00,0.7254E+00,0.7104E+00, &
& 0.6555E+00,0.5434E+00,0.4756E+00,0.4249E+00,0.3629E+00,0.2389E+00, &
& 0.8136E+00,0.8017E+00,0.8068E+00,0.8283E+00,0.8495E+00,0.7764E+00, &
& 0.7991E+00,0.8159E+00,0.7883E+00,0.7786E+00,0.7723E+00,0.7651E+00, &
& 0.7221E+00,0.6129E+00,0.5424E+00,0.4883E+00,0.4249E+00,0.2973E+00, &
& 0.8244E+00,0.8072E+00,0.8066E+00,0.8277E+00,0.8617E+00,0.7812E+00, &
& 0.8112E+00,0.8339E+00,0.8106E+00,0.8033E+00,0.8011E+00,0.7995E+00, &
& 0.7670E+00,0.6642E+00,0.5932E+00,0.5376E+00,0.4736E+00,0.3449E+00/
!-----------------------------------------------------------
!13) sscm Sea Salt (Coarse Mode) (8 RH%)
data ((a_extx(i,j,13 ),i=1,mbx), j=1,8 ) / &
& 0.9980E+00,0.1032E+01,0.1084E+01,0.1141E+01,0.1180E+01,0.1239E+01, &
& 0.1267E+01,0.1223E+01,0.1223E+01,0.1131E+01,0.1187E+01,0.1193E+01, &
& 0.1003E+01,0.7764E+00,0.8981E+00,0.8734E+00,0.7043E+00,0.1087E+01, &
& 0.9993E+00,0.1023E+01,0.1062E+01,0.1112E+01,0.1116E+01,0.1186E+01, &
& 0.1231E+01,0.1199E+01,0.1211E+01,0.1190E+01,0.1166E+01,0.1088E+01, &
& 0.8417E+00,0.8725E+00,0.1002E+01,0.1018E+01,0.9030E+00,0.8425E+00, &
& 0.9997E+00,0.1023E+01,0.1056E+01,0.1100E+01,0.1103E+01,0.1170E+01, &
& 0.1217E+01,0.1196E+01,0.1210E+01,0.1203E+01,0.1176E+01,0.1094E+01, &
& 0.8508E+00,0.9063E+00,0.1030E+01,0.1053E+01,0.9529E+00,0.8484E+00, &
& 0.1000E+01,0.1022E+01,0.1054E+01,0.1094E+01,0.1097E+01,0.1157E+01, &
& 0.1208E+01,0.1194E+01,0.1209E+01,0.1213E+01,0.1186E+01,0.1105E+01, &
& 0.8661E+00,0.9329E+00,0.1052E+01,0.1081E+01,0.9940E+00,0.8664E+00, &
& 0.1000E+01,0.1020E+01,0.1045E+01,0.1079E+01,0.1084E+01,0.1135E+01, &
& 0.1183E+01,0.1182E+01,0.1200E+01,0.1219E+01,0.1201E+01,0.1130E+01, &
& 0.9010E+00,0.9733E+00,0.1084E+01,0.1122E+01,0.1062E+01,0.9151E+00, &
& 0.9997E+00,0.1015E+01,0.1039E+01,0.1066E+01,0.1070E+01,0.1111E+01, &
& 0.1154E+01,0.1163E+01,0.1181E+01,0.1209E+01,0.1205E+01,0.1153E+01, &
& 0.9422E+00,0.1006E+01,0.1107E+01,0.1153E+01,0.1123E+01,0.9803E+00, &
& 0.9997E+00,0.1013E+01,0.1034E+01,0.1052E+01,0.1058E+01,0.1087E+01, &
& 0.1119E+01,0.1132E+01,0.1150E+01,0.1181E+01,0.1193E+01,0.1172E+01, &
& 0.9974E+00,0.1041E+01,0.1125E+01,0.1178E+01,0.1183E+01,0.1076E+01, &
& 0.9997E+00,0.1011E+01,0.1027E+01,0.1043E+01,0.1048E+01,0.1071E+01, &
& 0.1097E+01,0.1109E+01,0.1124E+01,0.1152E+01,0.1169E+01,0.1167E+01, &
& 0.1027E+01,0.1055E+01,0.1127E+01,0.1180E+01,0.1203E+01,0.1130E+01/
data ((a_ssax(i,j,13 ),i=1,mbx), j=1,8 ) / &
& 0.1000E+01,0.9930E+00,0.9727E+00,0.9556E+00,0.8560E+00,0.9741E+00, &
& 0.9710E+00,0.9527E+00,0.9273E+00,0.9159E+00,0.8371E+00,0.8800E+00, &
& 0.9069E+00,0.8668E+00,0.6916E+00,0.5906E+00,0.4595E+00,0.2559E+00, &
& 0.1000E+01,0.9975E+00,0.9823E+00,0.9394E+00,0.7044E+00,0.9079E+00, &
& 0.8498E+00,0.8049E+00,0.7115E+00,0.7686E+00,0.7483E+00,0.7304E+00, &
& 0.5310E+00,0.3977E+00,0.4240E+00,0.4467E+00,0.4340E+00,0.2669E+00, &
& 0.1000E+01,0.9979E+00,0.9830E+00,0.9334E+00,0.6994E+00,0.8936E+00, &
& 0.8287E+00,0.7859E+00,0.6880E+00,0.7474E+00,0.7322E+00,0.7098E+00, &
& 0.5087E+00,0.4006E+00,0.4249E+00,0.4450E+00,0.4379E+00,0.2892E+00, &
& 0.1000E+01,0.9982E+00,0.9833E+00,0.9271E+00,0.6955E+00,0.8822E+00, &
& 0.8119E+00,0.7713E+00,0.6711E+00,0.7314E+00,0.7197E+00,0.6954E+00, &
& 0.4980E+00,0.4064E+00,0.4286E+00,0.4461E+00,0.4420E+00,0.3084E+00, &
& 0.1000E+01,0.9986E+00,0.9832E+00,0.9143E+00,0.6881E+00,0.8606E+00, &
& 0.7812E+00,0.7451E+00,0.6433E+00,0.7029E+00,0.6968E+00,0.6726E+00, &
& 0.4893E+00,0.4204E+00,0.4386E+00,0.4515E+00,0.4504E+00,0.3412E+00, &
& 0.1000E+01,0.9991E+00,0.9817E+00,0.8973E+00,0.6799E+00,0.8361E+00, &
& 0.7480E+00,0.7169E+00,0.6158E+00,0.6723E+00,0.6710E+00,0.6503E+00, &
& 0.4885E+00,0.4367E+00,0.4511E+00,0.4595E+00,0.4593E+00,0.3725E+00, &
& 0.1000E+01,0.9992E+00,0.9791E+00,0.8695E+00,0.6676E+00,0.8005E+00, &
& 0.7024E+00,0.6776E+00,0.5821E+00,0.6297E+00,0.6327E+00,0.6192E+00, &
& 0.4926E+00,0.4581E+00,0.4687E+00,0.4714E+00,0.4702E+00,0.4072E+00, &
& 0.1000E+01,0.9992E+00,0.9761E+00,0.8453E+00,0.6583E+00,0.7726E+00, &
& 0.6703E+00,0.6494E+00,0.5614E+00,0.6001E+00,0.6039E+00,0.5952E+00, &
& 0.4959E+00,0.4723E+00,0.4807E+00,0.4801E+00,0.4769E+00,0.4282E+00/
data ((a_asyx(i,j,13 ),i=1,mbx), j=1,8 ) / &
& 0.7964E+00,0.7818E+00,0.7631E+00,0.7611E+00,0.7325E+00,0.7164E+00, &
& 0.7131E+00,0.7702E+00,0.7411E+00,0.7655E+00,0.7186E+00,0.6815E+00, &
& 0.7176E+00,0.7450E+00,0.6774E+00,0.6201E+00,0.5680E+00,0.2940E+00, &
& 0.8469E+00,0.8377E+00,0.8242E+00,0.8204E+00,0.8874E+00,0.7840E+00, &
& 0.8116E+00,0.8563E+00,0.8519E+00,0.8503E+00,0.8474E+00,0.8563E+00, &
& 0.8891E+00,0.8556E+00,0.7968E+00,0.7386E+00,0.6789E+00,0.5294E+00, &
& 0.8506E+00,0.8444E+00,0.8319E+00,0.8316E+00,0.8958E+00,0.7934E+00, &
& 0.8231E+00,0.8648E+00,0.8639E+00,0.8604E+00,0.8618E+00,0.8742E+00, &
& 0.9029E+00,0.8659E+00,0.8120E+00,0.7583E+00,0.7014E+00,0.5713E+00, &
& 0.8570E+00,0.8500E+00,0.8384E+00,0.8389E+00,0.9015E+00,0.8023E+00, &
& 0.8313E+00,0.8704E+00,0.8722E+00,0.8666E+00,0.8712E+00,0.8855E+00, &
& 0.9122E+00,0.8744E+00,0.8241E+00,0.7736E+00,0.7190E+00,0.6019E+00, &
& 0.8604E+00,0.8566E+00,0.8500E+00,0.8528E+00,0.9109E+00,0.8159E+00, &
& 0.8449E+00,0.8796E+00,0.8850E+00,0.8777E+00,0.8852E+00,0.9014E+00, &
& 0.9259E+00,0.8882E+00,0.8437E+00,0.7991E+00,0.7488E+00,0.6523E+00, &
& 0.8629E+00,0.8628E+00,0.8581E+00,0.8642E+00,0.9207E+00,0.8332E+00, &
& 0.8599E+00,0.8889E+00,0.8985E+00,0.8885E+00,0.8968E+00,0.9141E+00, &
& 0.9375E+00,0.9015E+00,0.8625E+00,0.8239E+00,0.7785E+00,0.6962E+00, &
& 0.8680E+00,0.8658E+00,0.8674E+00,0.8815E+00,0.9323E+00,0.8570E+00, &
& 0.8826E+00,0.9038E+00,0.9169E+00,0.9042E+00,0.9111E+00,0.9276E+00, &
& 0.9504E+00,0.9180E+00,0.8843E+00,0.8539E+00,0.8157E+00,0.7501E+00, &
& 0.8671E+00,0.8679E+00,0.8732E+00,0.8919E+00,0.9398E+00,0.8746E+00, &
& 0.9008E+00,0.9166E+00,0.9314E+00,0.9176E+00,0.9221E+00,0.9365E+00, &
& 0.9578E+00,0.9277E+00,0.8974E+00,0.8722E+00,0.8395E+00,0.7834E+00/
!-----------------------------------------------------------
!14) minm Mineral Dust (Nucleation Mode)
data ((a_extx(i,j,14 ),i=1,mbx), j=1,1 ) / &
& 0.6970E+00,0.3724E+00,0.1420E+00,0.6483E-01,0.3820E-01,0.1519E-01, &
& 0.8261E-02,0.1004E-01,0.1296E-01,0.1639E-01,0.3130E-01,0.2811E-01, &
& 0.2521E-01,0.1703E-01,0.1988E-01,0.1697E-01,0.9376E-02,0.9107E-02/
data ((a_ssax(i,j,14 ),i=1,mbx), j=1,1 ) / &
& 0.9647E+00,0.9747E+00,0.9551E+00,0.9100E+00,0.6865E+00,0.7466E+00, &
& 0.5914E+00,0.2448E+00,0.1105E+00,0.2806E-01,0.1280E-01,0.9266E-01, &
& 0.2898E-01,0.1546E-01,0.4009E-02,0.7202E-02,0.3913E-02,0.4404E-03/
data ((a_asyx(i,j,14 ),i=1,mbx), j=1,1 ) / &
& 0.6649E+00,0.6163E+00,0.5404E+00,0.4736E+00,0.4018E+00,0.3402E+00, &
& 0.2763E+00,0.2324E+00,0.1920E+00,0.1511E+00,0.1181E+00,0.1573E+00, &
& 0.1089E+00,0.8380E-01,0.5339E-01,0.5149E-01,0.3630E-01,0.1260E-01/
!-----------------------------------------------------------
!15) miam Mineral Dust (Accumulation Mode)
data ((a_extx(i,j,15 ),i=1,mbx), j=1,1 ) / &
& 0.9984E+00,0.1086E+01,0.1096E+01,0.9933E+00,0.8202E+00,0.6341E+00, &
& 0.4556E+00,0.3471E+00,0.2878E+00,0.1996E+00,0.2565E+00,0.6046E+00, &
& 0.3391E+00,0.2277E+00,0.1790E+00,0.2234E+00,0.1218E+00,0.6990E-01/
data ((a_ssax(i,j,15 ),i=1,mbx), j=1,1 ) / &
& 0.8711E+00,0.9378E+00,0.9463E+00,0.9390E+00,0.8556E+00,0.9280E+00, &
& 0.9132E+00,0.7796E+00,0.6446E+00,0.3766E+00,0.1883E+00,0.4505E+00, &
& 0.3751E+00,0.3398E+00,0.1766E+00,0.2689E+00,0.2345E+00,0.6417E-01/
data ((a_asyx(i,j,15 ),i=1,mbx), j=1,1 ) / &
& 0.7372E+00,0.6959E+00,0.6875E+00,0.6870E+00,0.6976E+00,0.6754E+00, &
& 0.6587E+00,0.6577E+00,0.6356E+00,0.6194E+00,0.5500E+00,0.3734E+00, &
& 0.4415E+00,0.4217E+00,0.3678E+00,0.2494E+00,0.2310E+00,0.1612E+00/
!-----------------------------------------------------------
!16) micm Mineral Dust (Coarse Mode)
data ((a_extx(i,j,16 ),i=1,mbx), j=1,1 ) / &
& 0.9996E+00,0.1027E+01,0.1068E+01,0.1107E+01,0.1148E+01,0.1198E+01, &
& 0.1233E+01,0.1224E+01,0.1191E+01,0.1019E+01,0.8557E+00,0.1258E+01, &
& 0.1215E+01,0.1151E+01,0.9892E+00,0.1223E+01,0.1120E+01,0.8345E+00/
data ((a_ssax(i,j,16 ),i=1,mbx), j=1,1 ) / &
& 0.6601E+00,0.7660E+00,0.7855E+00,0.7760E+00,0.6695E+00,0.8055E+00, &
& 0.8213E+00,0.7032E+00,0.6400E+00,0.5581E+00,0.4115E+00,0.5215E+00, &
& 0.4952E+00,0.5059E+00,0.4368E+00,0.4754E+00,0.4695E+00,0.3922E+00/
data ((a_asyx(i,j,16 ),i=1,mbx), j=1,1 ) / &
& 0.8973E+00,0.8441E+00,0.8113E+00,0.7920E+00,0.8221E+00,0.7620E+00, &
& 0.7560E+00,0.8061E+00,0.8300E+00,0.8774E+00,0.8754E+00,0.6871E+00, &
& 0.7447E+00,0.7345E+00,0.7462E+00,0.5502E+00,0.4931E+00,0.4435E+00/
!-----------------------------------------------------------
!17) mitr Mineral Dust (Transported Mode)
data ((a_extx(i,j,17 ),i=1,mbx), j=1,1 ) / &
& 0.9986E+00,0.1075E+01,0.1146E+01,0.1147E+01,0.1071E+01,0.9633E+00, &
& 0.8081E+00,0.6535E+00,0.5407E+00,0.3475E+00,0.3921E+00,0.9254E+00, &
& 0.5998E+00,0.4218E+00,0.3044E+00,0.4378E+00,0.2417E+00,0.1079E+00/
data ((a_ssax(i,j,17 ),i=1,mbx), j=1,1 ) / &
& 0.8289E+00,0.9121E+00,0.9248E+00,0.9199E+00,0.8342E+00,0.9235E+00, &
& 0.9212E+00,0.8118E+00,0.7005E+00,0.4500E+00,0.2373E+00,0.4742E+00, &
& 0.4401E+00,0.4147E+00,0.2391E+00,0.3436E+00,0.2894E+00,0.6579E-01/
data ((a_asyx(i,j,17 ),i=1,mbx), j=1,1 ) / &
& 0.7784E+00,0.7216E+00,0.6970E+00,0.6933E+00,0.7183E+00,0.6974E+00, &
& 0.7035E+00,0.7204E+00,0.7080E+00,0.6903E+00,0.6241E+00,0.4321E+00, &
& 0.5088E+00,0.4685E+00,0.3810E+00,0.2530E+00,0.1987E+00,0.7565E-01/
!-----------------------------------------------------------
!18) suso Sulfate Droplets (8 RH%)
data ((a_extx(i,j,18 ),i=1,mbx), j=1,8 ) / &
& 0.1009E+01,0.5315E+00,0.1916E+00,0.7670E-01,0.7874E-01,0.9590E-01, &
& 0.6253E-01,0.7484E-01,0.4925E-01,0.9857E-01,0.1587E+00,0.9879E-01, &
& 0.4700E-01,0.2393E-01,0.3030E-01,0.5892E-02,0.9433E-02,0.7848E-02, &
& 0.1006E+01,0.5952E+00,0.2531E+00,0.1037E+00,0.1446E+00,0.7541E-01, &
& 0.4527E-01,0.5074E-01,0.4011E-01,0.5088E-01,0.8283E-01,0.6455E-01, &
& 0.4619E-01,0.5258E-01,0.5271E-01,0.2665E-01,0.1876E-01,0.1624E-01, &
& 0.1006E+01,0.6212E+00,0.2790E+00,0.1177E+00,0.1633E+00,0.7724E-01, &
& 0.4479E-01,0.4768E-01,0.4012E-01,0.4406E-01,0.6866E-01,0.5540E-01, &
& 0.4558E-01,0.5987E-01,0.5860E-01,0.3197E-01,0.2137E-01,0.1845E-01, &
& 0.1005E+01,0.6426E+00,0.3008E+00,0.1302E+00,0.1777E+00,0.8106E-01, &
& 0.4587E-01,0.4669E-01,0.4100E-01,0.4064E-01,0.6060E-01,0.4993E-01, &
& 0.4548E-01,0.6509E-01,0.6299E-01,0.3575E-01,0.2328E-01,0.2004E-01, &
& 0.1004E+01,0.6814E+00,0.3426E+00,0.1554E+00,0.2042E+00,0.9223E-01, &
& 0.5051E-01,0.4744E-01,0.4419E-01,0.3753E-01,0.5094E-01,0.4315E-01, &
& 0.4619E-01,0.7387E-01,0.7072E-01,0.4208E-01,0.2658E-01,0.2275E-01, &
& 0.1002E+01,0.7316E+00,0.4003E+00,0.1929E+00,0.2399E+00,0.1134E+00, &
& 0.6077E-01,0.5232E-01,0.5093E-01,0.3767E-01,0.4499E-01,0.3886E-01, &
& 0.4868E-01,0.8496E-01,0.8106E-01,0.5002E-01,0.3089E-01,0.2623E-01, &
& 0.1001E+01,0.8035E+00,0.4928E+00,0.2593E+00,0.2985E+00,0.1572E+00, &
& 0.8413E-01,0.6619E-01,0.6603E-01,0.4387E-01,0.4423E-01,0.3828E-01, &
& 0.5504E-01,0.1028E+00,0.9851E-01,0.6287E-01,0.3814E-01,0.3191E-01, &
& 0.1000E+01,0.8626E+00,0.5794E+00,0.3284E+00,0.3569E+00,0.2076E+00, &
& 0.1130E+00,0.8469E-01,0.8470E-01,0.5441E-01,0.4914E-01,0.4181E-01, &
& 0.6305E-01,0.1209E+00,0.1170E+00,0.7631E-01,0.4595E-01,0.3786E-01/
data ((a_ssax(i,j,18 ),i=1,mbx), j=1,8 ) / &
& 0.1000E+01,0.1000E+01,0.9976E+00,0.9708E+00,0.4906E+00,0.1774E+00, &
& 0.1232E+00,0.6446E-01,0.5671E-01,0.1527E-01,0.2826E-01,0.4081E-01, &
& 0.4101E-01,0.2760E-01,0.3588E-01,0.7646E-01,0.4123E-02,0.9668E-03, &
& 0.1000E+01,0.1000E+01,0.9983E+00,0.9788E+00,0.5812E+00,0.4741E+00, &
& 0.3407E+00,0.1657E+00,0.1505E+00,0.5469E-01,0.4088E-01,0.4982E-01, &
& 0.3349E-01,0.1680E-01,0.1471E-01,0.1438E-01,0.6970E-02,0.1126E-02, &
& 0.1000E+01,0.1000E+01,0.9985E+00,0.9808E+00,0.6104E+00,0.5805E+00, &
& 0.4312E+00,0.2226E+00,0.1945E+00,0.8345E-01,0.5229E-01,0.5785E-01, &
& 0.3432E-01,0.1778E-01,0.1680E-01,0.1577E-01,0.8189E-02,0.1382E-02, &
& 0.1000E+01,0.1000E+01,0.9986E+00,0.9821E+00,0.6299E+00,0.6530E+00, &
& 0.4985E+00,0.2720E+00,0.2305E+00,0.1115E+00,0.6457E-01,0.6601E-01, &
& 0.3573E-01,0.1918E-01,0.1896E-01,0.1750E-01,0.9418E-02,0.1639E-02, &
& 0.1000E+01,0.1000E+01,0.9987E+00,0.9839E+00,0.6588E+00,0.7549E+00, &
& 0.6029E+00,0.3635E+00,0.2943E+00,0.1715E+00,0.9478E-01,0.8494E-01, &
& 0.3964E-01,0.2273E-01,0.2375E-01,0.2170E-01,0.1224E-01,0.2239E-02, &
& 0.1000E+01,0.1000E+01,0.9988E+00,0.9856E+00,0.6855E+00,0.8382E+00, &
& 0.7003E+00,0.4687E+00,0.3675E+00,0.2569E+00,0.1474E+00,0.1163E+00, &
& 0.4669E-01,0.2869E-01,0.3127E-01,0.2874E-01,0.1698E-01,0.3285E-02, &
& 0.1000E+01,0.1000E+01,0.9988E+00,0.9871E+00,0.7126E+00,0.9027E+00, &
& 0.7880E+00,0.5850E+00,0.4549E+00,0.3788E+00,0.2437E+00,0.1737E+00, &
& 0.6041E-01,0.3976E-01,0.4490E-01,0.4222E-01,0.2651E-01,0.5546E-02, &
& 0.1000E+01,0.1000E+01,0.9988E+00,0.9880E+00,0.7286E+00,0.9306E+00, &
& 0.8321E+00,0.6533E+00,0.5139E+00,0.4686E+00,0.3312E+00,0.2294E+00, &
& 0.7508E-01,0.5140E-01,0.5907E-01,0.5688E-01,0.3758E-01,0.8392E-02/
data ((a_asyx(i,j,18 ),i=1,mbx), j=1,8 ) / &
& 0.7172E+00,0.6760E+00,0.6086E+00,0.5473E+00,0.4571E+00,0.3765E+00, &
& 0.3163E+00,0.2661E+00,0.2370E+00,0.1704E+00,0.1353E+00,0.1478E+00, &
& 0.1519E+00,0.1258E+00,0.9522E-01,0.8572E-01,0.5257E-01,0.2308E-01, &
& 0.7690E+00,0.7404E+00,0.6846E+00,0.6391E+00,0.5324E+00,0.4853E+00, &
& 0.4211E+00,0.3673E+00,0.3292E+00,0.2748E+00,0.2325E+00,0.2197E+00, &
& 0.1904E+00,0.1480E+00,0.1204E+00,0.1042E+00,0.7121E-01,0.3384E-01, &
& 0.7779E+00,0.7541E+00,0.7040E+00,0.6637E+00,0.5565E+00,0.5153E+00, &
& 0.4523E+00,0.3990E+00,0.3583E+00,0.3077E+00,0.2645E+00,0.2459E+00, &
& 0.2086E+00,0.1601E+00,0.1321E+00,0.1139E+00,0.7974E-01,0.3877E-01, &
& 0.7837E+00,0.7632E+00,0.7173E+00,0.6810E+00,0.5745E+00,0.5355E+00, &
& 0.4752E+00,0.4226E+00,0.3808E+00,0.3328E+00,0.2889E+00,0.2660E+00, &
& 0.2231E+00,0.1705E+00,0.1414E+00,0.1221E+00,0.8694E-01,0.4311E-01, &
& 0.7900E+00,0.7755E+00,0.7368E+00,0.7068E+00,0.6048E+00,0.5693E+00, &
& 0.5128E+00,0.4620E+00,0.4186E+00,0.3739E+00,0.3307E+00,0.3022E+00, &
& 0.2507E+00,0.1908E+00,0.1600E+00,0.1377E+00,0.1008E+00,0.5131E-01, &
& 0.7948E+00,0.7864E+00,0.7564E+00,0.7336E+00,0.6385E+00,0.6040E+00, &
& 0.5541E+00,0.5070E+00,0.4625E+00,0.4216E+00,0.3796E+00,0.3465E+00, &
& 0.2864E+00,0.2176E+00,0.1836E+00,0.1587E+00,0.1193E+00,0.6287E-01, &
& 0.7975E+00,0.7959E+00,0.7766E+00,0.7635E+00,0.6804E+00,0.6449E+00, &
& 0.6051E+00,0.5647E+00,0.5193E+00,0.4834E+00,0.4441E+00,0.4081E+00, &
& 0.3392E+00,0.2584E+00,0.2196E+00,0.1909E+00,0.1477E+00,0.8069E-01, &
& 0.7967E+00,0.8007E+00,0.7892E+00,0.7825E+00,0.7117E+00,0.6735E+00, &
& 0.6423E+00,0.6084E+00,0.5632E+00,0.5303E+00,0.4951E+00,0.4587E+00, &
& 0.3850E+00,0.2951E+00,0.2518E+00,0.2202E+00,0.1738E+00,0.9837E-01/
end module aerosol1
! block data aerosol2
module aerosol2 1,1
!c 4/1/97
!c ********************************************************************
!c
!c Data statements providing aerosol properties for the 10
!c subintervals in the first Fu-Liou SW band.
!c
!c mb: Number of bands in code (will always be 10)
!c naer: Number of aerosol types (will need to be changed here AND in
!c aerosol subroutine.
!c nrh: Number of different relative humidities (currently 8)
!c
!c Optical properties are dimensioned (10,8,naer): Number of
!c sw sunintervals, number of relative humidities, and number of
!c aerosol types. Properties were extracted from tables and mapped for
!c the most part into the Fu-Liou spectral bands. sub-intervals 1-4,
!c not available in the tables, were filled with properties from the
!c 5th sub-interval. Intervals 5-6 were filled by direct insertion
!c (1 table value per interval). The last two intervals were filled
!c with 2 table values per interval, which were averaged using
!c energy weighting. Tegen and Lacis values are not RH-dependent,
!c so values are repeated.
!c
!c a_ssa: single-scattering albedo. One data statement for EACH type
!c of aerosol.
!c
!c a_ext: extinction coefficient. Normalization is not important.
!c These values are used for spectral weighting only!! One
!c data statement for EACH type of aerosol.
!c
!c a_asy: Asymmetry parameter.One data statement for EACH type of
!c aerosol.
!c
!c ********************************************************************
!c USE RadParams
!# include "para.file"
USE PARA_FILE
!c include 'para.file'
implicit none
!c## include 'rad_0698.h'
integer, private :: i,j
real a_ssay(mby,nrh,naer),a_exty(mby,nrh,naer)
real a_asyy(mby,nrh,naer)
! common /aer_opty/ a_ssay,a_exty,a_asyy
!c ****************************************************
!c Data statements for aerosol type 1 (marine) sw bnd 1
!c ****************************************************
data ((a_ssay(i,j,1),i=1,mby),j=1,nrh) / &
& .1000E+01,.1000E+01,.1000E+01,.1000E+01,.1000E+01,.1000E+01, &
& .1000E+01,.1000E+01,.1000E+01,.1000E+01, &
& .1000E+01,.1000E+01,.1000E+01,.1000E+01,.1000E+01,.1000E+01, &
& .1000E+01,.1000E+01,.1000E+01,.1000E+01, &
& .1000E+01,.1000E+01,.1000E+01,.1000E+01,.1000E+01,.1000E+01, &
& .1000E+01,.1000E+01,.1000E+01,.1000E+01, &
& .9999E+00,.9999E+00,.9999E+00,.9999E+00,.9999E+00,.1000E+01, &
& .1000E+01,.1000E+01,.1000E+01,.1000E+01, &
& .1000E+01,.1000E+01,.1000E+01,.1000E+01,.1000E+01,.1000E+01, &
& .1000E+01,.1000E+01,.1000E+01,.1000E+01, &
& .9993E+00,.9993E+00,.9993E+00,.9993E+00,.9993E+00,.1000E+01, &
& .1000E+01,.1000E+01,.1000E+01,.1000E+01, &
& .1000E+01,.1000E+01,.1000E+01,.1000E+01,.1000E+01,.1000E+01, &
& .1000E+01,.1000E+01,.1000E+01,.1000E+01, &
& .1000E+01,.1000E+01,.1000E+01,.1000E+01,.1000E+01,.1000E+01, &
& .1000E+01,.1000E+01,.1000E+01,.1000E+01/
data ((a_exty(i,j,1),i=1,mby),j=1,nrh) / &
& .2071E-03,.2071E-03,.2071E-03,.2071E-03,.2071E-03,.2084E-03, &
& .2081E-03,.2065E-03,.2071E-03,.2101E-03, &
& .2448E-03,.2448E-03,.2448E-03,.2448E-03,.2448E-03,.2459E-03, &
& .2452E-03,.2437E-03,.2427E-03,.2447E-03, &
& .3519E-03,.3519E-03,.3519E-03,.3519E-03,.3519E-03,.3499E-03, &
& .3503E-03,.3510E-03,.3486E-03,.3468E-03, &
& .7975E-03,.7975E-03,.7975E-03,.7975E-03,.7975E-03,.7928E-03, &
& .7874E-03,.7863E-03,.7813E-03,.7843E-03, &
& .1135E-02,.1135E-02,.1135E-02,.1135E-02,.1135E-02,.1122E-02, &
& .1120E-02,.1113E-02,.1113E-02,.1106E-02, &
& .1685E-02,.1685E-02,.1685E-02,.1685E-02,.1685E-02,.1671E-02, &
& .1656E-02,.1644E-02,.1632E-02,.1626E-02, &
& .2879E-02,.2879E-02,.2879E-02,.2879E-02,.2879E-02,.2872E-02, &
& .2855E-02,.2832E-02,.2806E-02,.2770E-02, &
& .4241E-02,.4241E-02,.4241E-02,.4241E-02,.4241E-02,.4274E-02, &
& .4256E-02,.4255E-02,.4223E-02,.4171E-02/
data ((a_asyy(i,j,1),i=1,mby),j=1,nrh) / &
& .7513E+00,.7513E+00,.7513E+00,.7513E+00,.7513E+00,.7721E+00, &
& .7842E+00,.7893E+00,.7963E+00,.8072E+00, &
& .7568E+00,.7568E+00,.7568E+00,.7568E+00,.7568E+00,.7792E+00, &
& .7907E+00,.7940E+00,.8002E+00,.8113E+00, &
& .7412E+00,.7412E+00,.7412E+00,.7412E+00,.7412E+00,.7662E+00, &
& .7783E+00,.7912E+00,.8007E+00,.8096E+00, &
& .6857E+00,.6857E+00,.6857E+00,.6857E+00,.6857E+00,.7078E+00, &
& .7249E+00,.7462E+00,.7600E+00,.7868E+00, &
& .6639E+00,.6639E+00,.6639E+00,.6639E+00,.6639E+00,.6845E+00, &
& .7070E+00,.7252E+00,.7393E+00,.7655E+00, &
& .6515E+00,.6515E+00,.6515E+00,.6515E+00,.6515E+00,.6620E+00, &
& .6810E+00,.6925E+00,.7165E+00,.7380E+00, &
& .6220E+00,.6220E+00,.6220E+00,.6220E+00,.6220E+00,.6424E+00, &
& .6525E+00,.6656E+00,.6848E+00,.7081E+00, &
& .6129E+00,.6129E+00,.6129E+00,.6129E+00,.6129E+00,.6290E+00, &
& .6397E+00,.6509E+00,.6676E+00,.6865E+00/
!c *********************************************************
!c Data statements for aerosol type 2 (continental) sw bnd 1
!c *********************************************************
data ((a_ssay(i,j,2),i=1,mby),j=1,nrh) / &
& .9419E+00,.9419E+00,.9419E+00,.9419E+00,.9419E+00,.9634E+00, &
& .9640E+00,.9652E+00,.9628E+00,.9566E+00, &
& .9418E+00,.9418E+00,.9418E+00,.9418E+00,.9418E+00,.9633E+00, &
& .9640E+00,.9652E+00,.9627E+00,.9565E+00, &
& .9460E+00,.9460E+00,.9460E+00,.9460E+00,.9460E+00,.9650E+00, &
& .9667E+00,.9673E+00,.9650E+00,.9595E+00, &
& .9596E+00,.9596E+00,.9596E+00,.9596E+00,.9596E+00,.9744E+00, &
& .9754E+00,.9760E+00,.9742E+00,.9703E+00, &
& .9722E+00,.9722E+00,.9722E+00,.9722E+00,.9722E+00,.9827E+00, &
& .9833E+00,.9838E+00,.9828E+00,.9805E+00, &
& .9776E+00,.9776E+00,.9776E+00,.9776E+00,.9776E+00,.9861E+00, &
& .9869E+00,.9872E+00,.9865E+00,.9846E+00, &
& .9823E+00,.9823E+00,.9823E+00,.9823E+00,.9823E+00,.9892E+00, &
& .9895E+00,.9900E+00,.9896E+00,.9883E+00, &
& .9857E+00,.9857E+00,.9857E+00,.9857E+00,.9857E+00,.9912E+00, &
& .9917E+00,.9921E+00,.9919E+00,.9907E+00/
data ((a_exty(i,j,2),i=1,mby),j=1,nrh) / &
& .1763E-04,.1763E-04,.1763E-04,.1763E-04,.1763E-04,.1574E-04, &
& .1402E-04,.1248E-04,.1055E-04,.8482E-05, &
& .1763E-04,.1763E-04,.1763E-04,.1763E-04,.1763E-04,.1574E-04, &
& .1402E-04,.1249E-04,.1055E-04,.8483E-05, &
& .1890E-04,.1890E-04,.1890E-04,.1890E-04,.1890E-04,.1689E-04, &
& .1504E-04,.1339E-04,.1132E-04,.9110E-05, &
& .2535E-04,.2535E-04,.2535E-04,.2535E-04,.2535E-04,.2270E-04, &
& .2027E-04,.1811E-04,.1538E-04,.1244E-04, &
& .3707E-04,.3707E-04,.3707E-04,.3707E-04,.3707E-04,.3347E-04, &
& .3014E-04,.2714E-04,.2326E-04,.1903E-04, &
& .4636E-04,.4636E-04,.4636E-04,.4636E-04,.4636E-04,.4215E-04, &
& .3817E-04,.3459E-04,.2986E-04,.2465E-04, &
& .5890E-04,.5890E-04,.5890E-04,.5890E-04,.5890E-04,.5402E-04, &
& .4933E-04,.4501E-04,.3919E-04,.3269E-04, &
& .7312E-04,.7312E-04,.7312E-04,.7312E-04,.7312E-04,.6769E-04, &
& .6224E-04,.5721E-04,.5027E-04,.4240E-04/
data ((a_asyy(i,j,2),i=1,mby),j=1,nrh) / &
& .6740E+00,.6740E+00,.6740E+00,.6740E+00,.6740E+00,.6635E+00, &
& .6570E+00,.6507E+00,.6414E+00,.6293E+00, &
& .6740E+00,.6740E+00,.6740E+00,.6740E+00,.6740E+00,.6635E+00, &
& .6570E+00,.6507E+00,.6414E+00,.6293E+00, &
& .6809E+00,.6809E+00,.6809E+00,.6809E+00,.6809E+00,.6740E+00, &
& .6678E+00,.6616E+00,.6523E+00,.6403E+00, &
& .7167E+00,.7167E+00,.7167E+00,.7167E+00,.7167E+00,.7097E+00, &
& .7046E+00,.6988E+00,.6904E+00,.6785E+00, &
& .7447E+00,.7447E+00,.7447E+00,.7447E+00,.7447E+00,.7407E+00, &
& .7371E+00,.7325E+00,.7251E+00,.7146E+00, &
& .7561E+00,.7561E+00,.7561E+00,.7561E+00,.7561E+00,.7534E+00, &
& .7508E+00,.7468E+00,.7404E+00,.7308E+00, &
& .7656E+00,.7656E+00,.7656E+00,.7656E+00,.7656E+00,.7643E+00, &
& .7622E+00,.7589E+00,.7536E+00,.7451E+00, &
& .7723E+00,.7723E+00,.7723E+00,.7723E+00,.7723E+00,.7715E+00, &
& .7706E+00,.7678E+00,.7635E+00,.7559E+00/
!c ***************************************************
!c Data statements for aerosol type 3 (urban) sw bnd 1
!c ***************************************************
data ((a_ssay(i,j,3),i=1,mby),j=1,nrh) / &
& .9180E+00,.9180E+00,.9180E+00,.9180E+00,.9180E+00,.9394E+00, &
& .9404E+00,.9417E+00,.9391E+00,.9333E+00, &
& .9174E+00,.9174E+00,.9174E+00,.9174E+00,.9174E+00,.9388E+00, &
& .9397E+00,.9411E+00,.9384E+00,.9327E+00, &
& .9210E+00,.9210E+00,.9210E+00,.9210E+00,.9210E+00,.9400E+00, &
& .9421E+00,.9428E+00,.9403E+00,.9353E+00, &
& .9377E+00,.9377E+00,.9377E+00,.9377E+00,.9377E+00,.9527E+00, &
& .9543E+00,.9551E+00,.9533E+00,.9500E+00, &
& .9553E+00,.9553E+00,.9553E+00,.9553E+00,.9553E+00,.9663E+00, &
& .9675E+00,.9685E+00,.9676E+00,.9659E+00, &
& .9630E+00,.9630E+00,.9630E+00,.9630E+00,.9630E+00,.9722E+00, &
& .9736E+00,.9743E+00,.9739E+00,.9728E+00, &
& .9702E+00,.9702E+00,.9702E+00,.9702E+00,.9702E+00,.9776E+00, &
& .9786E+00,.9795E+00,.9795E+00,.9788E+00, &
& .9756E+00,.9756E+00,.9756E+00,.9756E+00,.9756E+00,.9816E+00, &
& .9827E+00,.9836E+00,.9837E+00,.9832E+00/
data ((a_exty(i,j,3),i=1,mby),j=1,nrh) / &
& .1160E-04,.1160E-04,.1160E-04,.1160E-04,.1160E-04,.1033E-04, &
& .9185E-05,.8166E-05,.6890E-05,.5530E-05, &
& .1161E-04,.1161E-04,.1161E-04,.1161E-04,.1161E-04,.1034E-04, &
& .9196E-05,.8175E-05,.6897E-05,.5536E-05, &
& .1248E-04,.1248E-04,.1248E-04,.1248E-04,.1248E-04,.1112E-04, &
& .9879E-05,.8785E-05,.7413E-05,.5952E-05, &
& .1675E-04,.1675E-04,.1675E-04,.1675E-04,.1675E-04,.1494E-04, &
& .1331E-04,.1187E-04,.1005E-04,.8106E-05, &
& .2446E-04,.2446E-04,.2446E-04,.2446E-04,.2446E-04,.2199E-04, &
& .1972E-04,.1772E-04,.1514E-04,.1235E-04, &
& .3079E-04,.3079E-04,.3079E-04,.3079E-04,.3079E-04,.2783E-04, &
& .2509E-04,.2265E-04,.1948E-04,.1601E-04, &
& .3977E-04,.3977E-04,.3977E-04,.3977E-04,.3977E-04,.3616E-04, &
& .3281E-04,.2978E-04,.2579E-04,.2139E-04, &
& .4994E-04,.4994E-04,.4994E-04,.4994E-04,.4994E-04,.4577E-04, &
& .4176E-04,.3815E-04,.3329E-04,.2788E-04/
data ((a_asyy(i,j,3),i=1,mby),j=1,nrh) / &
& .6710E+00,.6710E+00,.6710E+00,.6710E+00,.6710E+00,.6606E+00, &
& .6543E+00,.6481E+00,.6390E+00,.6271E+00, &
& .6711E+00,.6711E+00,.6711E+00,.6711E+00,.6711E+00,.6607E+00, &
& .6543E+00,.6481E+00,.6389E+00,.6270E+00, &
& .6811E+00,.6811E+00,.6811E+00,.6811E+00,.6811E+00,.6713E+00, &
& .6652E+00,.6590E+00,.6498E+00,.6379E+00, &
& .7143E+00,.7143E+00,.7143E+00,.7143E+00,.7143E+00,.7072E+00, &
& .7020E+00,.6962E+00,.6878E+00,.6760E+00, &
& .7425E+00,.7425E+00,.7425E+00,.7425E+00,.7425E+00,.7383E+00, &
& .7346E+00,.7299E+00,.7225E+00,.7121E+00, &
& .7541E+00,.7541E+00,.7541E+00,.7541E+00,.7541E+00,.7510E+00, &
& .7482E+00,.7440E+00,.7375E+00,.7279E+00, &
& .7637E+00,.7637E+00,.7637E+00,.7637E+00,.7637E+00,.7618E+00, &
& .7593E+00,.7557E+00,.7501E+00,.7414E+00, &
& .7707E+00,.7707E+00,.7707E+00,.7707E+00,.7707E+00,.7691E+00, &
& .7677E+00,.7645E+00,.7598E+00,.7519E+00/
!c ********************************************************
!c Data statements for T&L 0.5 micron dust aerosol sw bnd 1
!c ********************************************************
data ((a_ssay(i,j,4),i=1,mby),j=1,nrh) / &
& .7035E+00,.7035E+00,.7035E+00,.7035E+00,.7035E+00,.7798E+00, &
& .8284E+00,.8779E+00,.9276E+00,.9653E+00, &
& .7035E+00,.7035E+00,.7035E+00,.7035E+00,.7035E+00,.7798E+00, &
& .8284E+00,.8779E+00,.9276E+00,.9653E+00, &
& .7035E+00,.7035E+00,.7035E+00,.7035E+00,.7035E+00,.7798E+00, &
& .8284E+00,.8779E+00,.9276E+00,.9653E+00, &
& .7035E+00,.7035E+00,.7035E+00,.7035E+00,.7035E+00,.7798E+00, &
& .8284E+00,.8779E+00,.9276E+00,.9653E+00, &
& .7035E+00,.7035E+00,.7035E+00,.7035E+00,.7035E+00,.7798E+00, &
& .8284E+00,.8779E+00,.9276E+00,.9653E+00, &
& .7035E+00,.7035E+00,.7035E+00,.7035E+00,.7035E+00,.7798E+00, &
& .8284E+00,.8779E+00,.9276E+00,.9653E+00, &
& .7035E+00,.7035E+00,.7035E+00,.7035E+00,.7035E+00,.7798E+00, &
& .8284E+00,.8779E+00,.9276E+00,.9653E+00, &
& .7035E+00,.7035E+00,.7035E+00,.7035E+00,.7035E+00,.7798E+00, &
& .8284E+00,.8779E+00,.9276E+00,.9653E+00/
data ((a_exty(i,j,4),i=1,mby),j=1,nrh) / &
& .8783E+00,.8783E+00,.8783E+00,.8783E+00,.8783E+00,.9056E+00, &
& .9356E+00,.9674E+00,.1015E+01,.1067E+01, &
& .8783E+00,.8783E+00,.8783E+00,.8783E+00,.8783E+00,.9056E+00, &
& .9356E+00,.9674E+00,.1015E+01,.1067E+01, &
& .8783E+00,.8783E+00,.8783E+00,.8783E+00,.8783E+00,.9056E+00, &
& .9356E+00,.9674E+00,.1015E+01,.1067E+01, &
& .8783E+00,.8783E+00,.8783E+00,.8783E+00,.8783E+00,.9056E+00, &
& .9356E+00,.9674E+00,.1015E+01,.1067E+01, &
& .8783E+00,.8783E+00,.8783E+00,.8783E+00,.8783E+00,.9056E+00, &
& .9356E+00,.9674E+00,.1015E+01,.1067E+01, &
& .8783E+00,.8783E+00,.8783E+00,.8783E+00,.8783E+00,.9056E+00, &
& .9356E+00,.9674E+00,.1015E+01,.1067E+01, &
& .8783E+00,.8783E+00,.8783E+00,.8783E+00,.8783E+00,.9056E+00, &
& .9356E+00,.9674E+00,.1015E+01,.1067E+01, &
& .8783E+00,.8783E+00,.8783E+00,.8783E+00,.8783E+00,.9056E+00, &
& .9356E+00,.9674E+00,.1015E+01,.1067E+01/
data ((a_asyy(i,j,4),i=1,mby),j=1,nrh) / &
& .7678E+00,.7678E+00,.7678E+00,.7678E+00,.7678E+00,.7230E+00, &
& .6963E+00,.6754E+00,.6626E+00,.6622E+00, &
& .7678E+00,.7678E+00,.7678E+00,.7678E+00,.7678E+00,.7230E+00, &
& .6963E+00,.6754E+00,.6626E+00,.6622E+00, &
& .7678E+00,.7678E+00,.7678E+00,.7678E+00,.7678E+00,.7230E+00, &
& .6963E+00,.6754E+00,.6626E+00,.6622E+00, &
& .7678E+00,.7678E+00,.7678E+00,.7678E+00,.7678E+00,.7230E+00, &
& .6963E+00,.6754E+00,.6626E+00,.6622E+00, &
& .7678E+00,.7678E+00,.7678E+00,.7678E+00,.7678E+00,.7230E+00, &
& .6963E+00,.6754E+00,.6626E+00,.6622E+00, &
& .7678E+00,.7678E+00,.7678E+00,.7678E+00,.7678E+00,.7230E+00, &
& .6963E+00,.6754E+00,.6626E+00,.6622E+00, &
& .7678E+00,.7678E+00,.7678E+00,.7678E+00,.7678E+00,.7230E+00, &
& .6963E+00,.6754E+00,.6626E+00,.6622E+00, &
& .7678E+00,.7678E+00,.7678E+00,.7678E+00,.7678E+00,.7230E+00, &
& .6963E+00,.6754E+00,.6626E+00,.6622E+00/
!c ********************************************************
!c Data statements for T&L 1.0 micron dust aerosol sw bnd 1
!c ********************************************************
data ((a_ssay(i,j,5),i=1,mby),j=1,nrh) / &
& .6142E+00,.6142E+00,.6142E+00,.6142E+00,.6142E+00,.6812E+00, &
& .7317E+00,.7920E+00,.8629E+00,.9255E+00, &
& .6142E+00,.6142E+00,.6142E+00,.6142E+00,.6142E+00,.6812E+00, &
& .7317E+00,.7920E+00,.8629E+00,.9255E+00, &
& .6142E+00,.6142E+00,.6142E+00,.6142E+00,.6142E+00,.6812E+00, &
& .7317E+00,.7920E+00,.8629E+00,.9255E+00, &
& .6142E+00,.6142E+00,.6142E+00,.6142E+00,.6142E+00,.6812E+00, &
& .7317E+00,.7920E+00,.8629E+00,.9255E+00, &
& .6142E+00,.6142E+00,.6142E+00,.6142E+00,.6142E+00,.6812E+00, &
& .7317E+00,.7920E+00,.8629E+00,.9255E+00, &
& .6142E+00,.6142E+00,.6142E+00,.6142E+00,.6142E+00,.6812E+00, &
& .7317E+00,.7920E+00,.8629E+00,.9255E+00, &
& .6142E+00,.6142E+00,.6142E+00,.6142E+00,.6142E+00,.6812E+00, &
& .7317E+00,.7920E+00,.8629E+00,.9255E+00, &
& .6142E+00,.6142E+00,.6142E+00,.6142E+00,.6142E+00,.6812E+00, &
& .7317E+00,.7920E+00,.8629E+00,.9255E+00/
data ((a_exty(i,j,5),i=1,mby),j=1,nrh) / &
& .9410E+00,.9410E+00,.9410E+00,.9410E+00,.9410E+00,.9556E+00, &
& .9700E+00,.9848E+00,.1008E+01,.1040E+01, &
& .9410E+00,.9410E+00,.9410E+00,.9410E+00,.9410E+00,.9556E+00, &
& .9700E+00,.9848E+00,.1008E+01,.1040E+01, &
& .9410E+00,.9410E+00,.9410E+00,.9410E+00,.9410E+00,.9556E+00, &
& .9700E+00,.9848E+00,.1008E+01,.1040E+01, &
& .9410E+00,.9410E+00,.9410E+00,.9410E+00,.9410E+00,.9556E+00, &
& .9700E+00,.9848E+00,.1008E+01,.1040E+01, &
& .9410E+00,.9410E+00,.9410E+00,.9410E+00,.9410E+00,.9556E+00, &
& .9700E+00,.9848E+00,.1008E+01,.1040E+01, &
& .9410E+00,.9410E+00,.9410E+00,.9410E+00,.9410E+00,.9556E+00, &
& .9700E+00,.9848E+00,.1008E+01,.1040E+01, &
& .9410E+00,.9410E+00,.9410E+00,.9410E+00,.9410E+00,.9556E+00, &
& .9700E+00,.9848E+00,.1008E+01,.1040E+01, &
& .9410E+00,.9410E+00,.9410E+00,.9410E+00,.9410E+00,.9556E+00, &
& .9700E+00,.9848E+00,.1008E+01,.1040E+01/
data ((a_asyy(i,j,5),i=1,mby),j=1,nrh) / &
& .8661E+00,.8661E+00,.8661E+00,.8661E+00,.8661E+00,.8265E+00, &
& .7970E+00,.7654E+00,.7285E+00,.6931E+00, &
& .8661E+00,.8661E+00,.8661E+00,.8661E+00,.8661E+00,.8265E+00, &
& .7970E+00,.7654E+00,.7285E+00,.6931E+00, &
& .8661E+00,.8661E+00,.8661E+00,.8661E+00,.8661E+00,.8265E+00, &
& .7970E+00,.7654E+00,.7285E+00,.6931E+00, &
& .8661E+00,.8661E+00,.8661E+00,.8661E+00,.8661E+00,.8265E+00, &
& .7970E+00,.7654E+00,.7285E+00,.6931E+00, &
& .8661E+00,.8661E+00,.8661E+00,.8661E+00,.8661E+00,.8265E+00, &
& .7970E+00,.7654E+00,.7285E+00,.6931E+00, &
& .8661E+00,.8661E+00,.8661E+00,.8661E+00,.8661E+00,.8265E+00, &
& .7970E+00,.7654E+00,.7285E+00,.6931E+00, &
& .8661E+00,.8661E+00,.8661E+00,.8661E+00,.8661E+00,.8265E+00, &
& .7970E+00,.7654E+00,.7285E+00,.6931E+00, &
& .8661E+00,.8661E+00,.8661E+00,.8661E+00,.8661E+00,.8265E+00, &
& .7970E+00,.7654E+00,.7285E+00,.6931E+00/
!c ********************************************************
!c Data statements for T&L 2.0 micron dust aerosol sw bnd 1
!c ********************************************************
data ((a_ssay(i,j,6),i=1,mby),j=1,nrh) / &
& .5631E+00,.5631E+00,.5631E+00,.5631E+00,.5631E+00,.6011E+00, &
& .6403E+00,.6988E+00,.7839E+00,.8715E+00, &
& .5631E+00,.5631E+00,.5631E+00,.5631E+00,.5631E+00,.6011E+00, &
& .6403E+00,.6988E+00,.7839E+00,.8715E+00, &
& .5631E+00,.5631E+00,.5631E+00,.5631E+00,.5631E+00,.6011E+00, &
& .6403E+00,.6988E+00,.7839E+00,.8715E+00, &
& .5631E+00,.5631E+00,.5631E+00,.5631E+00,.5631E+00,.6011E+00, &
& .6403E+00,.6988E+00,.7839E+00,.8715E+00, &
& .5631E+00,.5631E+00,.5631E+00,.5631E+00,.5631E+00,.6011E+00, &
& .6403E+00,.6988E+00,.7839E+00,.8715E+00, &
& .5631E+00,.5631E+00,.5631E+00,.5631E+00,.5631E+00,.6011E+00, &
& .6403E+00,.6988E+00,.7839E+00,.8715E+00, &
& .5631E+00,.5631E+00,.5631E+00,.5631E+00,.5631E+00,.6011E+00, &
& .6403E+00,.6988E+00,.7839E+00,.8715E+00, &
& .5631E+00,.5631E+00,.5631E+00,.5631E+00,.5631E+00,.6011E+00, &
& .6403E+00,.6988E+00,.7839E+00,.8715E+00/
data ((a_exty(i,j,6),i=1,mby),j=1,nrh) / &
& .9650E+00,.9650E+00,.9650E+00,.9650E+00,.9650E+00,.9749E+00, &
& .9831E+00,.9916E+00,.1004E+01,.1019E+01, &
& .9650E+00,.9650E+00,.9650E+00,.9650E+00,.9650E+00,.9749E+00, &
& .9831E+00,.9916E+00,.1004E+01,.1019E+01, &
& .9650E+00,.9650E+00,.9650E+00,.9650E+00,.9650E+00,.9749E+00, &
& .9831E+00,.9916E+00,.1004E+01,.1019E+01, &
& .9650E+00,.9650E+00,.9650E+00,.9650E+00,.9650E+00,.9749E+00, &
& .9831E+00,.9916E+00,.1004E+01,.1019E+01, &
& .9650E+00,.9650E+00,.9650E+00,.9650E+00,.9650E+00,.9749E+00, &
& .9831E+00,.9916E+00,.1004E+01,.1019E+01, &
& .9650E+00,.9650E+00,.9650E+00,.9650E+00,.9650E+00,.9749E+00, &
& .9831E+00,.9916E+00,.1004E+01,.1019E+01, &
& .9650E+00,.9650E+00,.9650E+00,.9650E+00,.9650E+00,.9749E+00, &
& .9831E+00,.9916E+00,.1004E+01,.1019E+01, &
& .9650E+00,.9650E+00,.9650E+00,.9650E+00,.9650E+00,.9749E+00, &
& .9831E+00,.9916E+00,.1004E+01,.1019E+01/
data ((a_asyy(i,j,6),i=1,mby),j=1,nrh) / &
& .9183E+00,.9183E+00,.9183E+00,.9183E+00,.9183E+00,.8957E+00, &
& .8745E+00,.8466E+00,.8097E+00,.7725E+00, &
& .9183E+00,.9183E+00,.9183E+00,.9183E+00,.9183E+00,.8957E+00, &
& .8745E+00,.8466E+00,.8097E+00,.7725E+00, &
& .9183E+00,.9183E+00,.9183E+00,.9183E+00,.9183E+00,.8957E+00, &
& .8745E+00,.8466E+00,.8097E+00,.7725E+00, &
& .9183E+00,.9183E+00,.9183E+00,.9183E+00,.9183E+00,.8957E+00, &
& .8745E+00,.8466E+00,.8097E+00,.7725E+00, &
& .9183E+00,.9183E+00,.9183E+00,.9183E+00,.9183E+00,.8957E+00, &
& .8745E+00,.8466E+00,.8097E+00,.7725E+00, &
& .9183E+00,.9183E+00,.9183E+00,.9183E+00,.9183E+00,.8957E+00, &
& .8745E+00,.8466E+00,.8097E+00,.7725E+00, &
& .9183E+00,.9183E+00,.9183E+00,.9183E+00,.9183E+00,.8957E+00, &
& .8745E+00,.8466E+00,.8097E+00,.7725E+00, &
& .9183E+00,.9183E+00,.9183E+00,.9183E+00,.9183E+00,.8957E+00, &
& .8745E+00,.8466E+00,.8097E+00,.7725E+00/
!c ********************************************************
!c Data statements for T&L 4.0 micron dust aerosol sw bnd 1
!c ********************************************************
data ((a_ssay(i,j,7),i=1,mby),j=1,nrh) / &
& .5495E+00,.5495E+00,.5495E+00,.5495E+00,.5495E+00,.5603E+00, &
& .5775E+00,.6141E+00,.6914E+00,.7949E+00, &
& .5495E+00,.5495E+00,.5495E+00,.5495E+00,.5495E+00,.5603E+00, &
& .5775E+00,.6141E+00,.6914E+00,.7949E+00, &
& .5495E+00,.5495E+00,.5495E+00,.5495E+00,.5495E+00,.5603E+00, &
& .5775E+00,.6141E+00,.6914E+00,.7949E+00, &
& .5495E+00,.5495E+00,.5495E+00,.5495E+00,.5495E+00,.5603E+00, &
& .5775E+00,.6141E+00,.6914E+00,.7949E+00, &
& .5495E+00,.5495E+00,.5495E+00,.5495E+00,.5495E+00,.5603E+00, &
& .5775E+00,.6141E+00,.6914E+00,.7949E+00, &
& .5495E+00,.5495E+00,.5495E+00,.5495E+00,.5495E+00,.5603E+00, &
& .5775E+00,.6141E+00,.6914E+00,.7949E+00, &
& .5495E+00,.5495E+00,.5495E+00,.5495E+00,.5495E+00,.5603E+00, &
& .5775E+00,.6141E+00,.6914E+00,.7949E+00, &
& .5495E+00,.5495E+00,.5495E+00,.5495E+00,.5495E+00,.5603E+00, &
& .5775E+00,.6141E+00,.6914E+00,.7949E+00/
data ((a_exty(i,j,7),i=1,mby),j=1,nrh) / &
& .9779E+00,.9779E+00,.9779E+00,.9779E+00,.9779E+00,.9839E+00, &
& .9894E+00,.9948E+00,.1002E+01,.1012E+01, &
& .9779E+00,.9779E+00,.9779E+00,.9779E+00,.9779E+00,.9839E+00, &
& .9894E+00,.9948E+00,.1002E+01,.1012E+01, &
& .9779E+00,.9779E+00,.9779E+00,.9779E+00,.9779E+00,.9839E+00, &
& .9894E+00,.9948E+00,.1002E+01,.1012E+01, &
& .9779E+00,.9779E+00,.9779E+00,.9779E+00,.9779E+00,.9839E+00, &
& .9894E+00,.9948E+00,.1002E+01,.1012E+01, &
& .9779E+00,.9779E+00,.9779E+00,.9779E+00,.9779E+00,.9839E+00, &
& .9894E+00,.9948E+00,.1002E+01,.1012E+01, &
& .9779E+00,.9779E+00,.9779E+00,.9779E+00,.9779E+00,.9839E+00, &
& .9894E+00,.9948E+00,.1002E+01,.1012E+01, &
& .9779E+00,.9779E+00,.9779E+00,.9779E+00,.9779E+00,.9839E+00, &
& .9894E+00,.9948E+00,.1002E+01,.1012E+01, &
& .9779E+00,.9779E+00,.9779E+00,.9779E+00,.9779E+00,.9839E+00, &
& .9894E+00,.9948E+00,.1002E+01,.1012E+01/
data ((a_asyy(i,j,7),i=1,mby),j=1,nrh) / &
& .9364E+00,.9364E+00,.9364E+00,.9364E+00,.9364E+00,.9298E+00, &
& .9204E+00,.9026E+00,.8702E+00,.8309E+00, &
& .9364E+00,.9364E+00,.9364E+00,.9364E+00,.9364E+00,.9298E+00, &
& .9204E+00,.9026E+00,.8702E+00,.8309E+00, &
& .9364E+00,.9364E+00,.9364E+00,.9364E+00,.9364E+00,.9298E+00, &
& .9204E+00,.9026E+00,.8702E+00,.8309E+00, &
& .9364E+00,.9364E+00,.9364E+00,.9364E+00,.9364E+00,.9298E+00, &
& .9204E+00,.9026E+00,.8702E+00,.8309E+00, &
& .9364E+00,.9364E+00,.9364E+00,.9364E+00,.9364E+00,.9298E+00, &
& .9204E+00,.9026E+00,.8702E+00,.8309E+00, &
& .9364E+00,.9364E+00,.9364E+00,.9364E+00,.9364E+00,.9298E+00, &
& .9204E+00,.9026E+00,.8702E+00,.8309E+00, &
& .9364E+00,.9364E+00,.9364E+00,.9364E+00,.9364E+00,.9298E+00, &
& .9204E+00,.9026E+00,.8702E+00,.8309E+00, &
& .9364E+00,.9364E+00,.9364E+00,.9364E+00,.9364E+00,.9298E+00, &
& .9204E+00,.9026E+00,.8702E+00,.8309E+00/
!c ********************************************************
!c Data statements for T&L 8.0 micron dust aerosol sw bnd 1
!c ********************************************************
data ((a_ssay(i,j,8),i=1,mby),j=1,nrh) / &
& .5507E+00,.5507E+00,.5507E+00,.5507E+00,.5507E+00,.5512E+00, &
& .5542E+00,.5663E+00,.6106E+00,.6996E+00, &
& .5507E+00,.5507E+00,.5507E+00,.5507E+00,.5507E+00,.5512E+00, &
& .5542E+00,.5663E+00,.6106E+00,.6996E+00, &
& .5507E+00,.5507E+00,.5507E+00,.5507E+00,.5507E+00,.5512E+00, &
& .5542E+00,.5663E+00,.6106E+00,.6996E+00, &
& .5507E+00,.5507E+00,.5507E+00,.5507E+00,.5507E+00,.5512E+00, &
& .5542E+00,.5663E+00,.6106E+00,.6996E+00, &
& .5507E+00,.5507E+00,.5507E+00,.5507E+00,.5507E+00,.5512E+00, &
& .5542E+00,.5663E+00,.6106E+00,.6996E+00, &
& .5507E+00,.5507E+00,.5507E+00,.5507E+00,.5507E+00,.5512E+00, &
& .5542E+00,.5663E+00,.6106E+00,.6996E+00, &
& .5507E+00,.5507E+00,.5507E+00,.5507E+00,.5507E+00,.5512E+00, &
& .5542E+00,.5663E+00,.6106E+00,.6996E+00, &
& .5507E+00,.5507E+00,.5507E+00,.5507E+00,.5507E+00,.5512E+00, &
& .5542E+00,.5663E+00,.6106E+00,.6996E+00/
data ((a_exty(i,j,8),i=1,mby),j=1,nrh) / &
& .9859E+00,.9859E+00,.9859E+00,.9859E+00,.9859E+00,.9896E+00, &
& .9932E+00,.9967E+00,.1002E+01,.1007E+01, &
& .9859E+00,.9859E+00,.9859E+00,.9859E+00,.9859E+00,.9896E+00, &
& .9932E+00,.9967E+00,.1002E+01,.1007E+01, &
& .9859E+00,.9859E+00,.9859E+00,.9859E+00,.9859E+00,.9896E+00, &
& .9932E+00,.9967E+00,.1002E+01,.1007E+01, &
& .9859E+00,.9859E+00,.9859E+00,.9859E+00,.9859E+00,.9896E+00, &
& .9932E+00,.9967E+00,.1002E+01,.1007E+01, &
& .9859E+00,.9859E+00,.9859E+00,.9859E+00,.9859E+00,.9896E+00, &
& .9932E+00,.9967E+00,.1002E+01,.1007E+01, &
& .9859E+00,.9859E+00,.9859E+00,.9859E+00,.9859E+00,.9896E+00, &
& .9932E+00,.9967E+00,.1002E+01,.1007E+01, &
& .9859E+00,.9859E+00,.9859E+00,.9859E+00,.9859E+00,.9896E+00, &
& .9932E+00,.9967E+00,.1002E+01,.1007E+01, &
& .9859E+00,.9859E+00,.9859E+00,.9859E+00,.9859E+00,.9896E+00, &
& .9932E+00,.9967E+00,.1002E+01,.1007E+01/
data ((a_asyy(i,j,8),i=1,mby),j=1,nrh) / &
& .9401E+00,.9401E+00,.9401E+00,.9401E+00,.9401E+00,.9399E+00, &
& .9385E+00,.9327E+00,.9136E+00,.8795E+00, &
& .9401E+00,.9401E+00,.9401E+00,.9401E+00,.9401E+00,.9399E+00, &
& .9385E+00,.9327E+00,.9136E+00,.8795E+00, &
& .9401E+00,.9401E+00,.9401E+00,.9401E+00,.9401E+00,.9399E+00, &
& .9385E+00,.9327E+00,.9136E+00,.8795E+00, &
& .9401E+00,.9401E+00,.9401E+00,.9401E+00,.9401E+00,.9399E+00, &
& .9385E+00,.9327E+00,.9136E+00,.8795E+00, &
& .9401E+00,.9401E+00,.9401E+00,.9401E+00,.9401E+00,.9399E+00, &
& .9385E+00,.9327E+00,.9136E+00,.8795E+00, &
& .9401E+00,.9401E+00,.9401E+00,.9401E+00,.9401E+00,.9399E+00, &
& .9385E+00,.9327E+00,.9136E+00,.8795E+00, &
& .9401E+00,.9401E+00,.9401E+00,.9401E+00,.9401E+00,.9399E+00, &
& .9385E+00,.9327E+00,.9136E+00,.8795E+00, &
& .9401E+00,.9401E+00,.9401E+00,.9401E+00,.9401E+00,.9399E+00, &
& .9385E+00,.9327E+00,.9136E+00,.8795E+00/
!=====================================================================
!OPAC Y
!-----------------------------------------------------------
!9) inso Insoluble
data ((a_exty(i,j, 9 ),i=1,mby), j=1,1 ) / &
& 0.9429E+00,0.9453E+00,0.9513E+00,0.9558E+00,0.9595E+00,0.9650E+00, &
& 0.9753E+00,0.9866E+00,0.9992E+00,0.1015E+01/
data ((a_ssay(i,j, 9 ),i=1,mby), j=1,1 ) / &
& 0.4624E+00,0.5098E+00,0.6053E+00,0.6511E+00,0.6674E+00,0.6750E+00, &
& 0.6918E+00,0.7100E+00,0.7289E+00,0.7486E+00/
data ((a_asyy(i,j, 9 ),i=1,mby), j=1,1 ) / &
& 0.9788E+00,0.9585E+00,0.9122E+00,0.8872E+00,0.8773E+00,0.8720E+00, &
& 0.8597E+00,0.8458E+00,0.8317E+00,0.8163E+00/
!-----------------------------------------------------------
!10) waso Water Soluble (8 RH%)
data ((a_exty(i,j,10 ),i=1,mby), j=1,8 ) / &
& 0.2636E+01,0.2534E+01,0.2300E+01,0.2142E+01,0.2022E+01,0.1846E+01, &
& 0.1535E+01,0.1261E+01,0.1015E+01,0.7892E+00, &
& 0.2564E+01,0.2466E+01,0.2240E+01,0.2089E+01,0.1975E+01,0.1808E+01, &
& 0.1513E+01,0.1253E+01,0.1015E+01,0.7959E+00, &
& 0.2500E+01,0.2407E+01,0.2193E+01,0.2049E+01,0.1940E+01,0.1781E+01, &
& 0.1498E+01,0.1246E+01,0.1014E+01,0.8001E+00, &
& 0.2434E+01,0.2346E+01,0.2144E+01,0.2008E+01,0.1904E+01,0.1754E+01, &
& 0.1482E+01,0.1240E+01,0.1014E+01,0.8042E+00, &
& 0.2291E+01,0.2215E+01,0.2039E+01,0.1920E+01,0.1829E+01,0.1694E+01, &
& 0.1448E+01,0.1225E+01,0.1013E+01,0.8130E+00, &
& 0.2121E+01,0.2059E+01,0.1914E+01,0.1815E+01,0.1738E+01,0.1623E+01, &
& 0.1407E+01,0.1208E+01,0.1012E+01,0.8240E+00, &
& 0.1896E+01,0.1852E+01,0.1746E+01,0.1673E+01,0.1614E+01,0.1525E+01, &
& 0.1350E+01,0.1182E+01,0.1011E+01,0.8404E+00, &
& 0.1752E+01,0.1718E+01,0.1638E+01,0.1581E+01,0.1534E+01,0.1460E+01, &
& 0.1311E+01,0.1165E+01,0.1010E+01,0.8518E+00/
data ((a_ssay(i,j,10 ),i=1,mby), j=1,8 ) / &
& 0.6646E+00,0.7653E+00,0.8981E+00,0.9419E+00,0.9569E+00,0.9666E+00, &
& 0.9685E+00,0.9688E+00,0.9633E+00,0.9558E+00, &
& 0.7687E+00,0.8417E+00,0.9345E+00,0.9639E+00,0.9735E+00,0.9796E+00, &
& 0.9808E+00,0.9810E+00,0.9776E+00,0.9730E+00, &
& 0.8036E+00,0.8665E+00,0.9456E+00,0.9704E+00,0.9784E+00,0.9835E+00, &
& 0.9844E+00,0.9847E+00,0.9820E+00,0.9782E+00, &
& 0.8288E+00,0.8845E+00,0.9538E+00,0.9751E+00,0.9819E+00,0.9861E+00, &
& 0.9871E+00,0.9873E+00,0.9850E+00,0.9820E+00, &
& 0.8696E+00,0.9126E+00,0.9655E+00,0.9816E+00,0.9868E+00,0.9900E+00, &
& 0.9907E+00,0.9909E+00,0.9895E+00,0.9874E+00, &
& 0.9009E+00,0.9345E+00,0.9749E+00,0.9869E+00,0.9906E+00,0.9929E+00, &
& 0.9935E+00,0.9938E+00,0.9928E+00,0.9915E+00, &
& 0.9319E+00,0.9553E+00,0.9831E+00,0.9913E+00,0.9939E+00,0.9954E+00, &
& 0.9959E+00,0.9961E+00,0.9956E+00,0.9949E+00, &
& 0.9465E+00,0.9651E+00,0.9870E+00,0.9934E+00,0.9954E+00,0.9966E+00, &
& 0.9970E+00,0.9972E+00,0.9968E+00,0.9964E+00/
data ((a_asyy(i,j,10 ),i=1,mby), j=1,8 ) / &
& 0.7099E+00,0.6998E+00,0.6762E+00,0.6623E+00,0.6551E+00,0.6486E+00, &
& 0.6386E+00,0.6267E+00,0.6143E+00,0.5985E+00, &
& 0.7400E+00,0.7344E+00,0.7212E+00,0.7131E+00,0.7084E+00,0.7033E+00, &
& 0.6946E+00,0.6841E+00,0.6722E+00,0.6570E+00, &
& 0.7487E+00,0.7443E+00,0.7339E+00,0.7276E+00,0.7241E+00,0.7201E+00, &
& 0.7118E+00,0.7021E+00,0.6904E+00,0.6755E+00, &
& 0.7554E+00,0.7517E+00,0.7427E+00,0.7373E+00,0.7343E+00,0.7310E+00, &
& 0.7239E+00,0.7151E+00,0.7042E+00,0.6902E+00, &
& 0.7629E+00,0.7609E+00,0.7561E+00,0.7529E+00,0.7507E+00,0.7478E+00, &
& 0.7426E+00,0.7349E+00,0.7254E+00,0.7123E+00, &
& 0.7685E+00,0.7678E+00,0.7659E+00,0.7644E+00,0.7633E+00,0.7615E+00, &
& 0.7576E+00,0.7512E+00,0.7433E+00,0.7320E+00, &
& 0.7721E+00,0.7725E+00,0.7736E+00,0.7740E+00,0.7738E+00,0.7732E+00, &
& 0.7715E+00,0.7669E+00,0.7612E+00,0.7518E+00, &
& 0.7749E+00,0.7755E+00,0.7768E+00,0.7777E+00,0.7784E+00,0.7789E+00, &
& 0.7779E+00,0.7750E+00,0.7701E+00,0.7619E+00/
!-----------------------------------------------------------
!11) soot Soot
data ((a_exty(i,j,11 ),i=1,mby), j=1,1 ) / &
& 0.2564E+01,0.2504E+01,0.2357E+01,0.2233E+01,0.2108E+01,0.1900E+01, &
& 0.1552E+01,0.1267E+01,0.1017E+01,0.8078E+00/
data ((a_ssay(i,j,11 ),i=1,mby), j=1,1 ) / &
& 0.3009E+00,0.3045E+00,0.3124E+00,0.3138E+00,0.3091E+00,0.2954E+00, &
& 0.2666E+00,0.2384E+00,0.2102E+00,0.1789E+00/
data ((a_asyy(i,j,11 ),i=1,mby), j=1,1 ) / &
& 0.5324E+00,0.5169E+00,0.4811E+00,0.4589E+00,0.4449E+00,0.4272E+00, &
& 0.3957E+00,0.3664E+00,0.3375E+00,0.3079E+00/
!-----------------------------------------------------------
!12) ssam Sea Salt (Accumulation Mode) (8 RH%)
data ((a_exty(i,j,12 ),i=1,mby), j=1,8 ) / &
& 0.8629E+00,0.8715E+00,0.8930E+00,0.9073E+00,0.9173E+00,0.9311E+00, &
& 0.9576E+00,0.9787E+00,0.9977E+00,0.1004E+01, &
& 0.8793E+00,0.8838E+00,0.8954E+00,0.9047E+00,0.9137E+00,0.9279E+00, &
& 0.9519E+00,0.9771E+00,0.9989E+00,0.1019E+01, &
& 0.8777E+00,0.8831E+00,0.8965E+00,0.9062E+00,0.9141E+00,0.9262E+00, &
& 0.9497E+00,0.9737E+00,0.9984E+00,0.1021E+01, &
& 0.8839E+00,0.8886E+00,0.9002E+00,0.9086E+00,0.9155E+00,0.9268E+00, &
& 0.9508E+00,0.9735E+00,0.9991E+00,0.1024E+01, &
& 0.8990E+00,0.9021E+00,0.9098E+00,0.9160E+00,0.9219E+00,0.9322E+00, &
& 0.9531E+00,0.9738E+00,0.9984E+00,0.1025E+01, &
& 0.9067E+00,0.9113E+00,0.9224E+00,0.9293E+00,0.9335E+00,0.9397E+00, &
& 0.9585E+00,0.9766E+00,0.9990E+00,0.1023E+01, &
& 0.9296E+00,0.9329E+00,0.9409E+00,0.9461E+00,0.9497E+00,0.9550E+00, &
& 0.9668E+00,0.9813E+00,0.9994E+00,0.1018E+01, &
& 0.9437E+00,0.9462E+00,0.9524E+00,0.9566E+00,0.9596E+00,0.9641E+00, &
& 0.9729E+00,0.9851E+00,0.9998E+00,0.1013E+01/
data ((a_ssay(i,j,12 ),i=1,mby), j=1,8 ) / &
& 0.9998E+00,0.9998E+00,0.9998E+00,0.9999E+00,0.9999E+00,0.1000E+01, &
& 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.9995E+00,0.9998E+00,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.9995E+00,0.9998E+00,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01/
data ((a_asyy(i,j,12 ),i=1,mby), j=1,8 ) / &
& 0.7300E+00,0.7254E+00,0.7146E+00,0.7078E+00,0.7037E+00,0.6998E+00, &
& 0.6978E+00,0.6951E+00,0.6925E+00,0.6965E+00, &
& 0.7850E+00,0.7850E+00,0.7846E+00,0.7830E+00,0.7798E+00,0.7750E+00, &
& 0.7740E+00,0.7708E+00,0.7710E+00,0.7724E+00, &
& 0.8029E+00,0.8004E+00,0.7945E+00,0.7909E+00,0.7889E+00,0.7866E+00, &
& 0.7831E+00,0.7799E+00,0.7783E+00,0.7800E+00, &
& 0.8050E+00,0.8040E+00,0.8015E+00,0.7996E+00,0.7980E+00,0.7950E+00, &
& 0.7895E+00,0.7869E+00,0.7840E+00,0.7844E+00, &
& 0.8178E+00,0.8169E+00,0.8146E+00,0.8127E+00,0.8108E+00,0.8072E+00, &
& 0.8002E+00,0.7963E+00,0.7933E+00,0.7912E+00, &
& 0.8304E+00,0.8287E+00,0.8246E+00,0.8224E+00,0.8216E+00,0.8198E+00, &
& 0.8116E+00,0.8061E+00,0.8009E+00,0.7985E+00, &
& 0.8380E+00,0.8380E+00,0.8378E+00,0.8367E+00,0.8345E+00,0.8309E+00, &
& 0.8271E+00,0.8189E+00,0.8136E+00,0.8086E+00, &
& 0.8448E+00,0.8449E+00,0.8450E+00,0.8444E+00,0.8431E+00,0.8406E+00, &
& 0.8373E+00,0.8299E+00,0.8244E+00,0.8185E+00/
!-----------------------------------------------------------
!13) sscm Sea Salt (Coarse Mode) (8 RH%)
data ((a_exty(i,j,13 ),i=1,mby), j=1,8 ) / &
& 0.9630E+00,0.9648E+00,0.9695E+00,0.9730E+00,0.9758E+00,0.9790E+00, &
& 0.9821E+00,0.9899E+00,0.9980E+00,0.1007E+01, &
& 0.9727E+00,0.9743E+00,0.9783E+00,0.9809E+00,0.9829E+00,0.9856E+00, &
& 0.9907E+00,0.9950E+00,0.9993E+00,0.1006E+01, &
& 0.9761E+00,0.9773E+00,0.9805E+00,0.9827E+00,0.9844E+00,0.9866E+00, &
& 0.9897E+00,0.9943E+00,0.9997E+00,0.1006E+01, &
& 0.9762E+00,0.9780E+00,0.9824E+00,0.9849E+00,0.9862E+00,0.9877E+00, &
& 0.9924E+00,0.9962E+00,0.1000E+01,0.1007E+01, &
& 0.9811E+00,0.9821E+00,0.9844E+00,0.9861E+00,0.9874E+00,0.9893E+00, &
& 0.9931E+00,0.9972E+00,0.1000E+01,0.1005E+01, &
& 0.9831E+00,0.9837E+00,0.9852E+00,0.9861E+00,0.9868E+00,0.9880E+00, &
& 0.9925E+00,0.9962E+00,0.9997E+00,0.1004E+01, &
& 0.9858E+00,0.9865E+00,0.9882E+00,0.9894E+00,0.9904E+00,0.9918E+00, &
& 0.9948E+00,0.9969E+00,0.9997E+00,0.1003E+01, &
& 0.9901E+00,0.9891E+00,0.9872E+00,0.9870E+00,0.9887E+00,0.9911E+00, &
& 0.9895E+00,0.9966E+00,0.9997E+00,0.1002E+01/
data ((a_ssay(i,j,13 ),i=1,mby), j=1,8 ) / &
& 0.9974E+00,0.9980E+00,0.9990E+00,0.9994E+00,0.9996E+00,0.9998E+00, &
& 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.9995E+00,0.9995E+00,0.9995E+00,0.9997E+00,0.9999E+00,0.1000E+01, &
& 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.9994E+00,0.9995E+00,0.9997E+00,0.9999E+00,0.9999E+00,0.1000E+01, &
& 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.9994E+00,0.9995E+00,0.9997E+00,0.9999E+00,0.9999E+00,0.1000E+01, &
& 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.9996E+00,0.9997E+00,0.9998E+00,0.9999E+00,0.9999E+00,0.1000E+01, &
& 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.9998E+00,0.9998E+00,0.9998E+00,0.9999E+00,0.9999E+00,0.1000E+01, &
& 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.9995E+00,0.9998E+00,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.9995E+00,0.9998E+00,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01/
data ((a_asyy(i,j,13 ),i=1,mby), j=1,8 ) / &
& 0.8085E+00,0.8092E+00,0.8108E+00,0.8106E+00,0.8085E+00,0.8049E+00, &
& 0.8045E+00,0.8017E+00,0.7964E+00,0.7932E+00, &
& 0.8452E+00,0.8456E+00,0.8467E+00,0.8476E+00,0.8486E+00,0.8498E+00, &
& 0.8505E+00,0.8504E+00,0.8469E+00,0.8464E+00, &
& 0.8483E+00,0.8481E+00,0.8480E+00,0.8486E+00,0.8500E+00,0.8530E+00, &
& 0.8581E+00,0.8557E+00,0.8506E+00,0.8505E+00, &
& 0.8373E+00,0.8422E+00,0.8535E+00,0.8586E+00,0.8582E+00,0.8542E+00, &
& 0.8541E+00,0.8559E+00,0.8570E+00,0.8549E+00, &
& 0.8441E+00,0.8465E+00,0.8523E+00,0.8548E+00,0.8546E+00,0.8539E+00, &
& 0.8614E+00,0.8626E+00,0.8604E+00,0.8586E+00, &
& 0.8390E+00,0.8405E+00,0.8443E+00,0.8471E+00,0.8495E+00,0.8536E+00, &
& 0.8641E+00,0.8666E+00,0.8629E+00,0.8652E+00, &
& 0.8385E+00,0.8383E+00,0.8382E+00,0.8405E+00,0.8455E+00,0.8545E+00, &
& 0.8586E+00,0.8622E+00,0.8680E+00,0.8681E+00, &
& 0.8070E+00,0.8121E+00,0.8244E+00,0.8326E+00,0.8384E+00,0.8465E+00, &
& 0.8575E+00,0.8605E+00,0.8671E+00,0.8673E+00/
!-----------------------------------------------------------
!14) minm Mineral Dust (Nucleation Mode)
data ((a_exty(i,j,14 ),i=1,mby), j=1,1 ) / &
& 0.1013E+01,0.1007E+01,0.9897E+00,0.9760E+00,0.9624E+00,0.9367E+00, &
& 0.8702E+00,0.7911E+00,0.6970E+00,0.5919E+00/
data ((a_ssay(i,j,14 ),i=1,mby), j=1,1 ) / &
& 0.7841E+00,0.7925E+00,0.8134E+00,0.8331E+00,0.8543E+00,0.8839E+00, &
& 0.9211E+00,0.9491E+00,0.9647E+00,0.9740E+00/
data ((a_asyy(i,j,14 ),i=1,mby), j=1,1 ) / &
& 0.7398E+00,0.7359E+00,0.7260E+00,0.7185E+00,0.7118E+00,0.7018E+00, &
& 0.6876E+00,0.6759E+00,0.6649E+00,0.6521E+00/
!-----------------------------------------------------------
!15) miam Mineral Dust (Accumulation Mode)
data ((a_exty(i,j,15 ),i=1,mby), j=1,1 ) / &
& 0.8958E+00,0.8998E+00,0.9097E+00,0.9170E+00,0.9230E+00,0.9325E+00, &
& 0.9520E+00,0.9736E+00,0.9984E+00,0.1028E+01/
data ((a_ssay(i,j,15 ),i=1,mby), j=1,1 ) / &
& 0.5676E+00,0.5719E+00,0.5844E+00,0.6014E+00,0.6254E+00,0.6655E+00, &
& 0.7403E+00,0.8148E+00,0.8711E+00,0.9093E+00/
data ((a_asyy(i,j,15 ),i=1,mby), j=1,1 ) / &
& 0.9144E+00,0.9086E+00,0.8938E+00,0.8802E+00,0.8654E+00,0.8411E+00, &
& 0.8007E+00,0.7640E+00,0.7372E+00,0.7162E+00/
!-----------------------------------------------------------
!16) micm Mineral Dust (Coarse Mode)
data ((a_exty(i,j,16 ),i=1,mby), j=1,1 ) / &
& 0.9717E+00,0.9730E+00,0.9761E+00,0.9783E+00,0.9801E+00,0.9828E+00, &
& 0.9880E+00,0.9935E+00,0.9996E+00,0.1007E+01/
data ((a_ssay(i,j,16 ),i=1,mby), j=1,1 ) / &
& 0.5462E+00,0.5457E+00,0.5448E+00,0.5454E+00,0.5477E+00,0.5523E+00, &
& 0.5714E+00,0.6059E+00,0.6601E+00,0.7118E+00/
data ((a_asyy(i,j,16 ),i=1,mby), j=1,1 ) / &
& 0.9433E+00,0.9447E+00,0.9478E+00,0.9490E+00,0.9485E+00,0.9466E+00, &
& 0.9380E+00,0.9212E+00,0.8973E+00,0.8741E+00/
!-----------------------------------------------------------
!17) mitr Mineral Dust (Transported Mode)
data ((a_exty(i,j,17 ),i=1,mby), j=1,1 ) / &
& 0.9243E+00,0.9273E+00,0.9348E+00,0.9403E+00,0.9447E+00,0.9516E+00, &
& 0.9657E+00,0.9810E+00,0.9986E+00,0.1019E+01/
data ((a_ssay(i,j,17 ),i=1,mby), j=1,1 ) / &
& 0.5535E+00,0.5553E+00,0.5615E+00,0.5724E+00,0.5898E+00,0.6205E+00, &
& 0.6873E+00,0.7635E+00,0.8289E+00,0.8763E+00/
data ((a_asyy(i,j,17 ),i=1,mby), j=1,1 ) / &
& 0.9371E+00,0.9340E+00,0.9257E+00,0.9168E+00,0.9057E+00,0.8860E+00, &
& 0.8473E+00,0.8087E+00,0.7784E+00,0.7532E+00/
!-----------------------------------------------------------
!18) suso Sulfate Droplets (8 RH%)
data ((a_exty(i,j,18 ),i=1,mby), j=1,8 ) / &
& 0.1618E+01,0.1603E+01,0.1566E+01,0.1534E+01,0.1500E+01,0.1438E+01, &
& 0.1299E+01,0.1155E+01,0.1009E+01,0.8521E+00, &
& 0.1357E+01,0.1352E+01,0.1341E+01,0.1329E+01,0.1315E+01,0.1285E+01, &
& 0.1207E+01,0.1115E+01,0.1006E+01,0.8812E+00, &
& 0.1272E+01,0.1271E+01,0.1268E+01,0.1263E+01,0.1255E+01,0.1235E+01, &
& 0.1175E+01,0.1100E+01,0.1006E+01,0.8928E+00, &
& 0.1210E+01,0.1211E+01,0.1215E+01,0.1215E+01,0.1211E+01,0.1198E+01, &
& 0.1152E+01,0.1089E+01,0.1005E+01,0.9023E+00, &
& 0.1120E+01,0.1125E+01,0.1137E+01,0.1143E+01,0.1144E+01,0.1139E+01, &
& 0.1112E+01,0.1069E+01,0.1004E+01,0.9180E+00, &
& 0.1033E+01,0.1040E+01,0.1057E+01,0.1067E+01,0.1073E+01,0.1077E+01, &
& 0.1070E+01,0.1047E+01,0.1002E+01,0.9381E+00, &
& 0.9487E+00,0.9569E+00,0.9770E+00,0.9906E+00,0.1000E+01,0.1012E+01, &
& 0.1022E+01,0.1020E+01,0.1001E+01,0.9637E+00, &
& 0.9078E+00,0.9155E+00,0.9348E+00,0.9483E+00,0.9585E+00,0.9724E+00, &
& 0.9917E+00,0.1002E+01,0.1000E+01,0.9817E+00/
data ((a_ssay(i,j,18 ),i=1,mby), j=1,8 ) / &
& 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01, &
& 0.1000E+01,0.1000E+01,0.1000E+01,0.1000E+01/
data ((a_asyy(i,j,18 ),i=1,mby), j=1,8 ) / &
& 0.6955E+00,0.6978E+00,0.7034E+00,0.7076E+00,0.7112E+00,0.7165E+00, &
& 0.7227E+00,0.7231E+00,0.7172E+00,0.7080E+00, &
& 0.7408E+00,0.7444E+00,0.7532E+00,0.7586E+00,0.7617E+00,0.7650E+00, &
& 0.7706E+00,0.7717E+00,0.7690E+00,0.7634E+00, &
& 0.7498E+00,0.7529E+00,0.7606E+00,0.7656E+00,0.7690E+00,0.7729E+00, &
& 0.7779E+00,0.7797E+00,0.7779E+00,0.7743E+00, &
& 0.7559E+00,0.7590E+00,0.7664E+00,0.7709E+00,0.7734E+00,0.7762E+00, &
& 0.7818E+00,0.7840E+00,0.7837E+00,0.7803E+00, &
& 0.7601E+00,0.7631E+00,0.7703E+00,0.7748E+00,0.7776E+00,0.7810E+00, &
& 0.7867E+00,0.7894E+00,0.7900E+00,0.7891E+00, &
& 0.7657E+00,0.7684E+00,0.7749E+00,0.7789E+00,0.7814E+00,0.7842E+00, &
& 0.7890E+00,0.7928E+00,0.7948E+00,0.7949E+00, &
& 0.7749E+00,0.7765E+00,0.7802E+00,0.7825E+00,0.7836E+00,0.7853E+00, &
& 0.7906E+00,0.7940E+00,0.7975E+00,0.7987E+00, &
& 0.7795E+00,0.7808E+00,0.7838E+00,0.7856E+00,0.7865E+00,0.7876E+00, &
& 0.7909E+00,0.7937E+00,0.7967E+00,0.7995E+00/
!=====================================================================
end module aerosol2
!===========================================================
! block data opac_extinctions
module opac_ext 1
! common /opac_ext/ wl(24) ,edat(24,8,9:18)
implicit none
integer, private :: i, j
real :: wl(24) ,edat(24,8,9:18)
data wl / &
& 0.2500E+00,0.3000E+00,0.3500E+00,0.4000E+00,0.4500E+00,0.5000E+00, &
& 0.5500E+00,0.6000E+00,0.6500E+00,0.7000E+00,0.7500E+00,0.8000E+00, &
& 0.9000E+00,0.1000E+01,0.1250E+01,0.1500E+01,0.1750E+01,0.2000E+01, &
& 0.2500E+01,0.3000E+01,0.3200E+01,0.3390E+01,0.3500E+01,0.3750E+01/
!-----------------------------------------------------------
!9) inso Insoluble
data (( edat(i,j, 9),i=1,24), j=1,1 ) / &
& 0.9477E+00,0.9572E+00,0.9667E+00,0.9748E+00,0.9839E+00,0.9916E+00, &
& 0.1000E+01,0.1008E+01,0.1016E+01,0.1024E+01,0.1031E+01,0.1038E+01, &
& 0.1052E+01,0.1064E+01,0.1093E+01,0.1105E+01,0.1088E+01,0.1012E+01, &
& 0.7983E+00,0.6625E+00,0.7897E+00,0.8403E+00,0.8668E+00,0.8205E+00/
!-----------------------------------------------------------
!10) waso Water Soluble (8 RH%)
data (( edat(i,j,10),i=1,24), j=1,8 ) / &
& 0.2438E+01,0.2095E+01,0.1793E+01,0.1539E+01,0.1326E+01,0.1148E+01, &
& 0.1000E+01,0.8739E+00,0.7689E+00,0.6782E+00,0.6032E+00,0.5249E+00, &
& 0.4251E+00,0.3497E+00,0.2191E+00,0.1520E+00,0.9186E-01,0.4897E-01, &
& 0.3146E-01,0.2746E-01,0.1577E-01,0.1314E-01,0.1167E-01,0.9260E-02, &
& 0.2373E+01,0.2044E+01,0.1758E+01,0.1516E+01,0.1314E+01,0.1144E+01, &
& 0.1000E+01,0.8785E+00,0.7759E+00,0.6882E+00,0.6135E+00,0.5395E+00, &
& 0.4380E+00,0.3605E+00,0.2271E+00,0.1560E+00,0.9755E-01,0.5793E-01, &
& 0.3256E-01,0.1309E+00,0.5573E-01,0.2602E-01,0.1914E-01,0.1332E-01, &
& 0.2319E+01,0.2006E+01,0.1733E+01,0.1501E+01,0.1306E+01,0.1140E+01, &
& 0.1000E+01,0.8812E+00,0.7803E+00,0.6942E+00,0.6199E+00,0.5477E+00, &
& 0.4458E+00,0.3676E+00,0.2326E+00,0.1597E+00,0.1014E+00,0.6249E-01, &
& 0.3361E-01,0.1628E+00,0.6956E-01,0.3125E-01,0.2246E-01,0.1529E-01, &
& 0.2263E+01,0.1967E+01,0.1708E+01,0.1485E+01,0.1298E+01,0.1137E+01, &
& 0.1000E+01,0.8840E+00,0.7847E+00,0.7002E+00,0.6264E+00,0.5557E+00, &
& 0.4536E+00,0.3748E+00,0.2386E+00,0.1639E+00,0.1054E+00,0.6684E-01, &
& 0.3483E-01,0.1857E+00,0.8036E-01,0.3571E-01,0.2545E-01,0.1714E-01, &
& 0.2143E+01,0.1884E+01,0.1653E+01,0.1451E+01,0.1279E+01,0.1130E+01, &
& 0.1000E+01,0.8897E+00,0.7942E+00,0.7128E+00,0.6405E+00,0.5724E+00, &
& 0.4705E+00,0.3910E+00,0.2521E+00,0.1741E+00,0.1146E+00,0.7589E-01, &
& 0.3791E-01,0.2186E+00,0.9814E-01,0.4402E-01,0.3134E-01,0.2095E-01, &
& 0.2000E+01,0.1785E+01,0.1588E+01,0.1410E+01,0.1257E+01,0.1120E+01, &
& 0.1000E+01,0.8968E+00,0.8062E+00,0.7286E+00,0.6585E+00,0.5932E+00, &
& 0.4922E+00,0.4122E+00,0.2707E+00,0.1887E+00,0.1272E+00,0.8739E-01, &
& 0.4252E-01,0.2441E+00,0.1154E+00,0.5345E-01,0.3848E-01,0.2582E-01, &
& 0.1809E+01,0.1650E+01,0.1497E+01,0.1353E+01,0.1224E+01,0.1106E+01, &
& 0.1000E+01,0.9072E+00,0.8240E+00,0.7520E+00,0.6856E+00,0.6241E+00, &
& 0.5252E+00,0.4454E+00,0.3007E+00,0.2134E+00,0.1481E+00,0.1055E+00, &
& 0.5081E-01,0.2683E+00,0.1372E+00,0.6728E-01,0.4955E-01,0.3371E-01, &
& 0.1686E+01,0.1563E+01,0.1437E+01,0.1314E+01,0.1202E+01,0.1097E+01, &
& 0.1000E+01,0.9142E+00,0.8366E+00,0.7687E+00,0.7051E+00,0.6462E+00, &
& 0.5496E+00,0.4702E+00,0.3238E+00,0.2331E+00,0.1648E+00,0.1196E+00, &
& 0.5785E-01,0.2815E+00,0.1521E+00,0.7776E-01,0.5825E-01,0.4012E-01/
!-----------------------------------------------------------
!11) soot Soot
data (( edat(i,j,11),i=1,24), j=1,1 ) / &
& 0.2447E+01,0.2188E+01,0.1837E+01,0.1555E+01,0.1331E+01,0.1153E+01, &
& 0.1000E+01,0.8818E+00,0.7906E+00,0.7082E+00,0.6445E+00,0.5904E+00, &
& 0.5087E+00,0.4453E+00,0.3412E+00,0.2767E+00,0.2367E+00,0.2055E+00, &
& 0.1639E+00,0.1398E+00,0.1284E+00,0.1218E+00,0.1189E+00,0.1105E+00/
!-----------------------------------------------------------
!12) ssam Sea Salt (Accumulation Mode) (8 RH%)
data (( edat(i,j,12),i=1,24), j=1,8 ) / &
& 0.8801E+00,0.9114E+00,0.9354E+00,0.9580E+00,0.9733E+00,0.9887E+00, &
& 0.1000E+01,0.1002E+01,0.1005E+01,0.1003E+01,0.9963E+00,0.9846E+00, &
& 0.9618E+00,0.9232E+00,0.8315E+00,0.7230E+00,0.6190E+00,0.5382E+00, &
& 0.3864E+00,0.4589E+00,0.3172E+00,0.2808E+00,0.2656E+00,0.2284E+00, &
& 0.8883E+00,0.9080E+00,0.9321E+00,0.9508E+00,0.9715E+00,0.9866E+00, &
& 0.1000E+01,0.1013E+01,0.1021E+01,0.1026E+01,0.1030E+01,0.1030E+01, &
& 0.1023E+01,0.1009E+01,0.9498E+00,0.8710E+00,0.7792E+00,0.6931E+00, &
& 0.4881E+00,0.6444E+00,0.6217E+00,0.5226E+00,0.4772E+00,0.4012E+00, &
& 0.8884E+00,0.9093E+00,0.9300E+00,0.9493E+00,0.9672E+00,0.9853E+00, &
& 0.1000E+01,0.1012E+01,0.1023E+01,0.1031E+01,0.1036E+01,0.1040E+01, &
& 0.1041E+01,0.1032E+01,0.9874E+00,0.9212E+00,0.8368E+00,0.7534E+00, &
& 0.5404E+00,0.6945E+00,0.6969E+00,0.5975E+00,0.5486E+00,0.4654E+00, &
& 0.8932E+00,0.9113E+00,0.9305E+00,0.9508E+00,0.9671E+00,0.9850E+00, &
& 0.1000E+01,0.1016E+01,0.1025E+01,0.1035E+01,0.1044E+01,0.1050E+01, &
& 0.1054E+01,0.1052E+01,0.1020E+01,0.9637E+00,0.8874E+00,0.8075E+00, &
& 0.5909E+00,0.7366E+00,0.7591E+00,0.6629E+00,0.6126E+00,0.5246E+00, &
& 0.9051E+00,0.9182E+00,0.9355E+00,0.9528E+00,0.9682E+00,0.9843E+00, &
& 0.1000E+01,0.1014E+01,0.1028E+01,0.1040E+01,0.1050E+01,0.1059E+01, &
& 0.1072E+01,0.1077E+01,0.1070E+01,0.1036E+01,0.9774E+00,0.9089E+00, &
& 0.6961E+00,0.8117E+00,0.8691E+00,0.7870E+00,0.7377E+00,0.6452E+00, &
& 0.9158E+00,0.9311E+00,0.9419E+00,0.9586E+00,0.9717E+00,0.9857E+00, &
& 0.1000E+01,0.1015E+01,0.1025E+01,0.1037E+01,0.1052E+01,0.1062E+01, &
& 0.1080E+01,0.1094E+01,0.1109E+01,0.1098E+01,0.1064E+01,0.1013E+01, &
& 0.8218E+00,0.8883E+00,0.9782E+00,0.9207E+00,0.8777E+00,0.7878E+00, &
& 0.9361E+00,0.9476E+00,0.9567E+00,0.9668E+00,0.9761E+00,0.9905E+00, &
& 0.1000E+01,0.1010E+01,0.1019E+01,0.1030E+01,0.1041E+01,0.1051E+01, &
& 0.1075E+01,0.1090E+01,0.1126E+01,0.1144E+01,0.1141E+01,0.1122E+01, &
& 0.9894E+00,0.9762E+00,0.1094E+01,0.1079E+01,0.1052E+01,0.9811E+00, &
& 0.9487E+00,0.9578E+00,0.9655E+00,0.9729E+00,0.9804E+00,0.9933E+00, &
& 0.1000E+01,0.1008E+01,0.1014E+01,0.1023E+01,0.1033E+01,0.1042E+01, &
& 0.1064E+01,0.1079E+01,0.1119E+01,0.1148E+01,0.1164E+01,0.1166E+01, &
& 0.1091E+01,0.1025E+01,0.1148E+01,0.1162E+01,0.1150E+01,0.1102E+01/
!-----------------------------------------------------------
!13) sscm Sea Salt (Coarse Mode) (8 RH%)
data (( edat(i,j,13),i=1,24), j=1,8 ) / &
& 0.9667E+00,0.9741E+00,0.9797E+00,0.9810E+00,0.9885E+00,0.9930E+00, &
& 0.1000E+01,0.9993E+00,0.1010E+01,0.1015E+01,0.1013E+01,0.1015E+01, &
& 0.1029E+01,0.1039E+01,0.1062E+01,0.1075E+01,0.1107E+01,0.1123E+01, &
& 0.1170E+01,0.1175E+01,0.1208E+01,0.1222E+01,0.1228E+01,0.1241E+01, &
& 0.9759E+00,0.9817E+00,0.9864E+00,0.9907E+00,0.9941E+00,0.9969E+00, &
& 0.1000E+01,0.1001E+01,0.1008E+01,0.1011E+01,0.1014E+01,0.1016E+01, &
& 0.1023E+01,0.1027E+01,0.1041E+01,0.1060E+01,0.1073E+01,0.1093E+01, &
& 0.1134E+01,0.1094E+01,0.1129E+01,0.1156E+01,0.1167E+01,0.1188E+01, &
& 0.9786E+00,0.9834E+00,0.9872E+00,0.9894E+00,0.9929E+00,0.9969E+00, &
& 0.1000E+01,0.1003E+01,0.1006E+01,0.1010E+01,0.1013E+01,0.1014E+01, &
& 0.1019E+01,0.1028E+01,0.1040E+01,0.1051E+01,0.1070E+01,0.1082E+01, &
& 0.1121E+01,0.1083E+01,0.1116E+01,0.1140E+01,0.1151E+01,0.1172E+01, &
& 0.9798E+00,0.9855E+00,0.9882E+00,0.9925E+00,0.9953E+00,0.9978E+00, &
& 0.1000E+01,0.1005E+01,0.1007E+01,0.1010E+01,0.1015E+01,0.1014E+01, &
& 0.1021E+01,0.1023E+01,0.1040E+01,0.1051E+01,0.1064E+01,0.1078E+01, &
& 0.1113E+01,0.1079E+01,0.1109E+01,0.1130E+01,0.1141E+01,0.1159E+01, &
& 0.9830E+00,0.9866E+00,0.9899E+00,0.9929E+00,0.9965E+00,0.9983E+00, &
& 0.1000E+01,0.1003E+01,0.1006E+01,0.1009E+01,0.1012E+01,0.1014E+01, &
& 0.1018E+01,0.1024E+01,0.1035E+01,0.1042E+01,0.1054E+01,0.1065E+01, &
& 0.1097E+01,0.1069E+01,0.1095E+01,0.1111E+01,0.1120E+01,0.1136E+01, &
& 0.9843E+00,0.9864E+00,0.9885E+00,0.9925E+00,0.9954E+00,0.9977E+00, &
& 0.1000E+01,0.1002E+01,0.1005E+01,0.1006E+01,0.1010E+01,0.1010E+01, &
& 0.1015E+01,0.1016E+01,0.1029E+01,0.1038E+01,0.1044E+01,0.1056E+01, &
& 0.1078E+01,0.1060E+01,0.1080E+01,0.1093E+01,0.1100E+01,0.1112E+01, &
& 0.9872E+00,0.9898E+00,0.9923E+00,0.9948E+00,0.9966E+00,0.9977E+00, &
& 0.1000E+01,0.1002E+01,0.1004E+01,0.1002E+01,0.1007E+01,0.1009E+01, &
& 0.1013E+01,0.1016E+01,0.1025E+01,0.1032E+01,0.1040E+01,0.1046E+01, &
& 0.1060E+01,0.1052E+01,0.1066E+01,0.1075E+01,0.1079E+01,0.1087E+01, &
& 0.9882E+00,0.9875E+00,0.9913E+00,0.9877E+00,0.9953E+00,0.9983E+00, &
& 0.1000E+01,0.1001E+01,0.1003E+01,0.1004E+01,0.1006E+01,0.1007E+01, &
& 0.1010E+01,0.1013E+01,0.1020E+01,0.1026E+01,0.1032E+01,0.1038E+01, &
& 0.1049E+01,0.1044E+01,0.1056E+01,0.1063E+01,0.1066E+01,0.1071E+01/
!-----------------------------------------------------------
!14) minm Mineral Dust (Nucleation Mode)
data (( edat(i,j,14),i=1,24), j=1,1 ) / &
& 0.1000E+01,0.9711E+00,0.9279E+00,0.8725E+00,0.8129E+00,0.7512E+00, &
& 0.6916E+00,0.6347E+00,0.5817E+00,0.5327E+00,0.4879E+00,0.4470E+00, &
& 0.3760E+00,0.3175E+00,0.2129E+00,0.1474E+00,0.1051E+00,0.7735E-01, &
& 0.4556E-01,0.3771E-01,0.2699E-01,0.2199E-01,0.1993E-01,0.1462E-01/
!-----------------------------------------------------------
!15) miam Mineral Dust (Accumulation Mode)
data (( edat(i,j,15),i=1,24), j=1,1 ) / &
& 0.9037E+00,0.9193E+00,0.9354E+00,0.9513E+00,0.9682E+00,0.9837E+00, &
& 0.1000E+01,0.1015E+01,0.1031E+01,0.1045E+01,0.1056E+01,0.1069E+01, &
& 0.1088E+01,0.1103E+01,0.1117E+01,0.1105E+01,0.1074E+01,0.1030E+01, &
& 0.9115E+00,0.7974E+00,0.7466E+00,0.7089E+00,0.6875E+00,0.6277E+00/
!-----------------------------------------------------------
!16) micm Mineral Dust (Coarse Mode)
data (( edat(i,j,16),i=1,24), j=1,1 ) / &
& 0.9742E+00,0.9790E+00,0.9836E+00,0.9878E+00,0.9922E+00,0.9959E+00, &
& 0.1000E+01,0.1004E+01,0.1008E+01,0.1012E+01,0.1014E+01,0.1018E+01, &
& 0.1026E+01,0.1032E+01,0.1048E+01,0.1065E+01,0.1082E+01,0.1096E+01, &
& 0.1128E+01,0.1151E+01,0.1167E+01,0.1178E+01,0.1184E+01,0.1199E+01/
!-----------------------------------------------------------
!17) mitr Mineral Dust (Transported Mode)
data (( edat(i,j,17),i=1,24), j=1,1 ) / &
& 0.9303E+00,0.9420E+00,0.9537E+00,0.9652E+00,0.9773E+00,0.9879E+00, &
& 0.1000E+01,0.1010E+01,0.1021E+01,0.1032E+01,0.1042E+01,0.1052E+01, &
& 0.1073E+01,0.1089E+01,0.1124E+01,0.1145E+01,0.1158E+01,0.1155E+01, &
& 0.1123E+01,0.1056E+01,0.1031E+01,0.1010E+01,0.9970E+00,0.9592E+00/
!-----------------------------------------------------------
!18) suso Sulfate Droplets (8 RH%)
data (( edat(i,j,18),i=1,24), j=1,8 ) / &
& 0.1589E+01,0.1522E+01,0.1418E+01,0.1303E+01,0.1190E+01,0.1092E+01, &
& 0.1000E+01,0.9143E+00,0.8376E+00,0.7654E+00,0.6996E+00,0.6399E+00, &
& 0.5385E+00,0.4523E+00,0.2965E+00,0.1989E+00,0.1377E+00,0.9764E-01, &
& 0.4830E-01,0.9007E-01,0.1102E+00,0.1189E+00,0.1158E+00,0.9204E-01, &
& 0.1348E+01,0.1324E+01,0.1275E+01,0.1210E+01,0.1140E+01,0.1070E+01, &
& 0.1000E+01,0.9327E+00,0.8690E+00,0.8095E+00,0.7523E+00,0.6989E+00, &
& 0.6053E+00,0.5239E+00,0.3671E+00,0.2634E+00,0.1894E+00,0.1396E+00, &
& 0.6786E-01,0.2235E+00,0.1501E+00,0.1073E+00,0.9444E-01,0.7255E-01, &
& 0.1270E+01,0.1260E+01,0.1228E+01,0.1178E+01,0.1121E+01,0.1062E+01, &
& 0.1000E+01,0.9397E+00,0.8817E+00,0.8269E+00,0.7733E+00,0.7227E+00, &
& 0.6326E+00,0.5533E+00,0.3966E+00,0.2903E+00,0.2118E+00,0.1581E+00, &
& 0.7746E-01,0.2542E+00,0.1694E+00,0.1142E+00,0.9794E-01,0.7432E-01, &
& 0.1213E+01,0.1214E+01,0.1193E+01,0.1154E+01,0.1107E+01,0.1055E+01, &
& 0.1000E+01,0.9457E+00,0.8920E+00,0.8410E+00,0.7904E+00,0.7420E+00, &
& 0.6550E+00,0.5774E+00,0.4212E+00,0.3129E+00,0.2309E+00,0.1740E+00, &
& 0.8606E-01,0.2758E+00,0.1859E+00,0.1223E+00,0.1035E+00,0.7800E-01, &
& 0.1130E+01,0.1144E+01,0.1137E+01,0.1114E+01,0.1082E+01,0.1044E+01, &
& 0.1000E+01,0.9549E+00,0.9094E+00,0.8652E+00,0.8201E+00,0.7764E+00, &
& 0.6957E+00,0.6218E+00,0.4674E+00,0.3562E+00,0.2682E+00,0.2055E+00, &
& 0.1039E+00,0.3110E+00,0.2181E+00,0.1419E+00,0.1185E+00,0.8881E-01, &
& 0.1047E+01,0.1070E+01,0.1078E+01,0.1072E+01,0.1055E+01,0.1030E+01, &
& 0.1000E+01,0.9671E+00,0.9313E+00,0.8955E+00,0.8577E+00,0.8197E+00, &
& 0.7476E+00,0.6795E+00,0.5295E+00,0.4157E+00,0.3210E+00,0.2510E+00, &
& 0.1311E+00,0.3533E+00,0.2636E+00,0.1744E+00,0.1455E+00,0.1094E+00, &
& 0.9649E+00,0.9946E+00,0.1015E+01,0.1023E+01,0.1023E+01,0.1014E+01, &
& 0.1000E+01,0.9820E+00,0.9595E+00,0.9353E+00,0.9080E+00,0.8792E+00, &
& 0.8213E+00,0.7633E+00,0.6247E+00,0.5105E+00,0.4084E+00,0.3287E+00, &
& 0.1810E+00,0.4156E+00,0.3391E+00,0.2356E+00,0.1991E+00,0.1520E+00, &
& 0.9232E+00,0.9524E+00,0.9764E+00,0.9920E+00,0.1001E+01,0.1004E+01, &
& 0.1000E+01,0.9924E+00,0.9792E+00,0.9644E+00,0.9463E+00,0.9258E+00, &
& 0.8810E+00,0.8331E+00,0.7091E+00,0.5986E+00,0.4932E+00,0.4068E+00, &
& 0.2352E+00,0.4729E+00,0.4135E+00,0.3016E+00,0.2589E+00,0.2015E+00/
end module opac_ext
!=============================================================
! block data tegen_lacis_ext
module mineral_ext 1
implicit none
! common /mineral_ext/ wl(24) ,dat(24,4:8)
real :: wl(24) ,dat(24,4:8)
data wl / &
& 0.30, 0.35, 0.40, 0.45, 0.50, 0.55, &
& 0.60, 0.65, 0.70, 0.80, 1.00, 1.25, &
& 1.50, 2.00, 2.51, 2.61, 2.83, 2.96, &
& 3.04, 3.26, 3.47, 3.69, 3.90, 4.11/
data dat/ &
! 4
& 8.78E-01,9.06E-01,9.36E-01,9.67E-01,1.00E+00,1.03E+00, &
& 1.06E+00,1.08E+00,1.09E+00,1.09E+00,1.02E+00,8.70E-01, &
& 7.04E-01,4.36E-01,2.08E-01,1.95E-01,1.91E-01,1.73E-01, &
& 1.51E-01,1.35E-01,9.41E-02,7.95E-02,6.45E-02,5.36E-02, &
! 5
& 9.41E-01,9.56E-01,9.70E-01,9.85E-01,1.00E+00,1.02E+00, &
& 1.03E+00,1.05E+00,1.07E+00,1.10E+00,1.18E+00,1.25E+00, &
& 1.27E+00,1.19E+00,8.64E-01,8.36E-01,7.68E-01,7.25E-01, &
& 6.93E-01,6.92E-01,5.44E-01,4.96E-01,4.41E-01,3.93E-01, &
! 6
& 9.65E-01,9.75E-01,9.83E-01,9.92E-01,1.00E+00,1.01E+00, &
& 1.02E+00,1.02E+00,1.03E+00,1.05E+00,1.08E+00,1.12E+00, &
& 1.17E+00,1.27E+00,1.34E+00,1.34E+00,1.29E+00,1.29E+00, &
& 1.30E+00,1.33E+00,1.27E+00,1.24E+00,1.21E+00,1.17E+00, &
! 7
& 9.78E-01,9.84E-01,9.89E-01,9.95E-01,1.00E+00,1.00E+00, &
& 1.01E+00,1.01E+00,1.02E+00,1.03E+00,1.05E+00,1.07E+00, &
& 1.09E+00,1.13E+00,1.19E+00,1.20E+00,1.21E+00,1.22E+00, &
& 1.24E+00,1.25E+00,1.29E+00,1.31E+00,1.34E+00,1.36E+00, &
! 8
& 9.86E-01,9.90E-01,9.93E-01,9.97E-01,1.00E+00,1.00E+00, &
& 1.01E+00,1.01E+00,1.01E+00,1.02E+00,1.03E+00,1.04E+00, &
& 1.05E+00,1.08E+00,1.10E+00,1.11E+00,1.11E+00,1.12E+00, &
& 1.12E+00,1.13E+00,1.14E+00,1.15E+00,1.17E+00,1.18E+00 /
end module mineral_ext
!=============================================================
! block data dalmedia_ext
module dalm_ext 1
implicit none
! common /dalm_ext/ wl(24) ,dat(24,8,3)
real :: wl(24) ,dat(24,8,3)
data wl / &
& 0.30, 0.35, 0.40, 0.45, 0.50, 0.55, &
& 0.60, 0.65, 0.70, 0.75, 0.80, 0.90, &
& 1.00, 1.25, 1.50, 1.75, 2.00, 2.50, &
& 3.00, 3.20, 3.39, 3.50, 3.78, 4.00/
data dat/ &
! 1
& 2.07E-04,2.08E-04,2.08E-04,2.07E-04,2.07E-04,2.08E-04, &
& 2.09E-04,2.11E-04,2.12E-04,2.12E-04,2.12E-04,2.09E-04, &
& 2.04E-04,1.90E-04,1.79E-04,1.71E-04,1.67E-04,1.63E-04, &
& 1.72E-04,1.69E-04,1.62E-04,1.66E-04,1.67E-04,1.67E-04, &
& 2.45E-04,2.46E-04,2.45E-04,2.44E-04,2.43E-04,2.43E-04, &
& 2.44E-04,2.45E-04,2.46E-04,2.44E-04,2.43E-04,2.38E-04, &
& 2.31E-04,2.14E-04,2.01E-04,1.91E-04,1.85E-04,1.79E-04, &
& 1.90E-04,1.87E-04,1.83E-04,1.83E-04,1.84E-04,1.84E-04, &
& 3.52E-04,3.50E-04,3.50E-04,3.51E-04,3.50E-04,3.47E-04, &
& 3.47E-04,3.47E-04,3.49E-04,3.50E-04,3.51E-04,3.51E-04, &
& 3.48E-04,3.28E-04,3.10E-04,2.92E-04,2.80E-04,2.63E-04, &
& 2.85E-04,2.82E-04,2.71E-04,2.68E-04,2.65E-04,2.65E-04, &
& 7.98E-04,7.93E-04,7.87E-04,7.86E-04,7.82E-04,7.80E-04, &
& 7.83E-04,7.86E-04,7.86E-04,7.84E-04,7.82E-04,7.83E-04, &
& 7.90E-04,8.10E-04,8.05E-04,7.79E-04,7.47E-04,6.70E-04, &
& 7.23E-04,7.47E-04,7.11E-04,6.94E-04,6.68E-04,6.55E-04, &
& 1.14E-03,1.12E-03,1.12E-03,1.11E-03,1.11E-03,1.11E-03, &
& 1.11E-03,1.11E-03,1.11E-03,1.11E-03,1.11E-03,1.11E-03, &
& 1.11E-03,1.13E-03,1.15E-03,1.14E-03,1.11E-03,9.98E-04, &
& 1.05E-03,1.10E-03,1.06E-03,1.04E-03,9.94E-04,9.67E-04, &
& 1.69E-03,1.67E-03,1.66E-03,1.64E-03,1.64E-03,1.63E-03, &
& 1.63E-03,1.62E-03,1.62E-03,1.61E-03,1.62E-03,1.63E-03, &
& 1.63E-03,1.62E-03,1.65E-03,1.68E-03,1.67E-03,1.54E-03, &
& 1.56E-03,1.65E-03,1.64E-03,1.61E-03,1.53E-03,1.49E-03, &
& 2.88E-03,2.87E-03,2.86E-03,2.83E-03,2.82E-03,2.80E-03, &
& 2.78E-03,2.76E-03,2.74E-03,2.76E-03,2.75E-03,2.74E-03, &
& 2.74E-03,2.76E-03,2.75E-03,2.78E-03,2.83E-03,2.79E-03, &
& 2.69E-03,2.83E-03,2.89E-03,2.88E-03,2.81E-03,2.73E-03, &
& 4.24E-03,4.27E-03,4.26E-03,4.26E-03,4.24E-03,4.21E-03, &
& 4.18E-03,4.16E-03,4.14E-03,4.13E-03,4.11E-03,4.09E-03, &
& 4.09E-03,4.06E-03,4.09E-03,4.08E-03,4.10E-03,4.22E-03, &
& 4.02E-03,4.16E-03,4.26E-03,4.30E-03,4.31E-03,4.25E-03, &
! 2
& 1.76E-05,1.57E-05,1.40E-05,1.25E-05,1.11E-05,9.95E-06, &
& 8.91E-06,8.01E-06,7.21E-06,6.53E-06,5.78E-06,4.79E-06, &
& 4.05E-06,2.66E-06,1.46E-06,1.02E-06,1.33E-06,4.35E-07, &
& 3.49E-07,2.36E-07,2.02E-07,1.90E-07,1.54E-07,1.39E-07, &
& 1.76E-05,1.57E-05,1.40E-05,1.25E-05,1.11E-05,9.95E-06, &
& 8.91E-06,8.01E-06,7.21E-06,6.53E-06,5.79E-06,4.80E-06, &
& 4.05E-06,2.66E-06,1.46E-06,1.02E-06,1.33E-06,4.37E-07, &
& 3.50E-07,2.38E-07,2.03E-07,1.91E-07,1.55E-07,1.40E-07, &
& 1.89E-05,1.69E-05,1.50E-05,1.34E-05,1.19E-05,1.07E-05, &
& 9.57E-06,8.61E-06,7.75E-06,7.02E-06,6.23E-06,5.17E-06, &
& 4.36E-06,2.87E-06,1.59E-06,1.12E-06,1.40E-06,4.73E-07, &
& 5.67E-07,3.34E-07,2.44E-07,2.23E-07,1.77E-07,1.59E-07, &
& 2.54E-05,2.27E-05,2.03E-05,1.81E-05,1.62E-05,1.45E-05, &
& 1.31E-05,1.18E-05,1.06E-05,9.64E-06,8.61E-06,7.17E-06, &
& 6.06E-06,4.01E-06,2.35E-06,1.65E-06,1.81E-06,6.73E-07, &
& 1.72E-06,8.68E-07,4.78E-07,4.04E-07,3.02E-07,2.66E-07, &
& 3.71E-05,3.35E-05,3.01E-05,2.71E-05,2.44E-05,2.20E-05, &
& 1.99E-05,1.80E-05,1.64E-05,1.49E-05,1.35E-05,1.13E-05, &
& 9.58E-06,6.42E-06,4.02E-06,2.84E-06,2.68E-06,1.11E-06, &
& 4.01E-06,2.02E-06,1.01E-06,8.25E-07,5.90E-07,5.07E-07, &
& 4.64E-05,4.22E-05,3.82E-05,3.46E-05,3.13E-05,2.83E-05, &
& 2.57E-05,2.34E-05,2.14E-05,1.95E-05,1.77E-05,1.49E-05, &
& 1.27E-05,8.61E-06,5.57E-06,3.96E-06,3.51E-06,1.52E-06, &
& 5.97E-06,3.08E-06,1.54E-06,1.24E-06,8.75E-07,7.43E-07, &
& 5.89E-05,5.40E-05,4.93E-05,4.50E-05,4.10E-05,3.73E-05, &
& 3.41E-05,3.12E-05,2.86E-05,2.62E-05,2.39E-05,2.03E-05, &
& 1.74E-05,1.20E-05,7.99E-06,5.74E-06,4.85E-06,2.21E-06, &
& 8.84E-06,4.73E-06,2.40E-06,1.94E-06,1.38E-06,1.16E-06, &
& 7.31E-05,6.77E-05,6.22E-05,5.72E-05,5.24E-05,4.80E-05, &
& 4.41E-05,4.05E-05,3.73E-05,3.44E-05,3.15E-05,2.70E-05, &
& 2.32E-05,1.62E-05,1.11E-05,8.06E-06,6.61E-06,3.11E-06, &
& 1.23E-05,6.85E-06,3.56E-06,2.88E-06,2.05E-06,1.72E-06, &
! 3
& 1.16E-05,1.03E-05,9.18E-06,8.17E-06,7.28E-06,6.49E-06, &
& 5.81E-06,5.22E-06,4.70E-06,4.25E-06,3.77E-06,3.13E-06, &
& 2.64E-06,1.74E-06,9.67E-07,6.83E-07,8.71E-07,3.00E-07, &
& 2.42E-07,1.67E-07,1.44E-07,1.35E-07,1.11E-07,1.00E-07, &
& 1.16E-05,1.03E-05,9.20E-06,8.18E-06,7.28E-06,6.50E-06, &
& 5.82E-06,5.23E-06,4.70E-06,4.26E-06,3.78E-06,3.13E-06, &
& 2.64E-06,1.74E-06,9.69E-07,6.85E-07,8.72E-07,3.02E-07, &
& 2.44E-07,1.68E-07,1.45E-07,1.36E-07,1.12E-07,1.01E-07, &
& 1.25E-05,1.11E-05,9.88E-06,8.79E-06,7.83E-06,6.98E-06, &
& 6.25E-06,5.62E-06,5.06E-06,4.58E-06,4.07E-06,3.38E-06, &
& 2.85E-06,1.88E-06,1.06E-06,7.49E-07,9.23E-07,3.28E-07, &
& 3.90E-07,2.32E-07,1.72E-07,1.58E-07,1.28E-07,1.15E-07, &
& 1.68E-05,1.49E-05,1.33E-05,1.19E-05,1.06E-05,9.48E-06, &
& 8.51E-06,7.66E-06,6.92E-06,6.27E-06,5.61E-06,4.67E-06, &
& 3.94E-06,2.61E-06,1.55E-06,1.09E-06,1.18E-06,4.55E-07, &
& 1.14E-06,5.75E-07,3.19E-07,2.71E-07,2.05E-07,1.81E-07, &
& 2.45E-05,2.20E-05,1.97E-05,1.77E-05,1.59E-05,1.43E-05, &
& 1.29E-05,1.17E-05,1.06E-05,9.67E-06,8.71E-06,7.30E-06, &
& 6.19E-06,4.15E-06,2.60E-06,1.85E-06,1.73E-06,7.27E-07, &
& 2.63E-06,1.31E-06,6.55E-07,5.33E-07,3.82E-07,3.28E-07, &
& 3.08E-05,2.78E-05,2.51E-05,2.26E-05,2.05E-05,1.85E-05, &
& 1.67E-05,1.52E-05,1.39E-05,1.26E-05,1.15E-05,9.65E-06, &
& 8.21E-06,5.55E-06,3.60E-06,2.56E-06,2.26E-06,9.87E-07, &
& 3.93E-06,2.00E-06,9.86E-07,7.92E-07,5.59E-07,4.75E-07, &
& 3.98E-05,3.62E-05,3.28E-05,2.98E-05,2.70E-05,2.45E-05, &
& 2.23E-05,2.04E-05,1.86E-05,1.71E-05,1.55E-05,1.32E-05, &
& 1.12E-05,7.70E-06,5.14E-06,3.68E-06,3.10E-06,1.40E-06, &
& 5.86E-06,3.06E-06,1.52E-06,1.22E-06,8.51E-07,7.16E-07, &
& 4.99E-05,4.58E-05,4.18E-05,3.81E-05,3.48E-05,3.17E-05, &
& 2.90E-05,2.66E-05,2.44E-05,2.24E-05,2.06E-05,1.75E-05, &
& 1.51E-05,1.04E-05,7.15E-06,5.15E-06,4.20E-06,1.95E-06, &
& 8.20E-06,4.44E-06,2.24E-06,1.79E-06,1.25E-06,1.05E-06/
end module dalm_ext
!------------------------------------------------------------
! block data aerosol_convolve5
module aot_spect_5 !mark 1
implicit none
! common /aot_spect_5/ wlo(5,15) , hkas(5,15) ,sflx(5,15)
real :: wlo(5,15) , hkas(5,15) ,sflx(5,15)
data wlo / &
& 0.1794,0.1878,0.1970,0.2073,0.2186, &
& 0.2265,0.2301,0.2339,0.2378,0.2418, &
& 0.2475,0.2551,0.2632,0.2717,0.2809, &
& 0.2869,0.2894,0.2920,0.2946,0.2972, &
& 0.3008,0.3053,0.3100,0.3149,0.3199, &
& 0.3257,0.3323,0.3391,0.3462,0.3537, &
& 0.3642,0.3783,0.3935,0.4100,0.4279, &
& 0.4429,0.4539,0.4656,0.4778,0.4908, &
& 0.5059,0.5233,0.5419,0.5620,0.5836, &
& 0.6033,0.6206,0.6389,0.6583,0.6789, &
& 0.7236,0.8026,0.9009,1.0267,1.1933, &
& 1.3414,1.4358,1.5444,1.6708,1.8198, &
& 1.9512,2.0513,2.1622,2.2857,2.4242, &
& 2.5740,2.7360,2.9197,3.1299,3.3727, &
& 3.5524,3.6430,3.7383,3.8388,3.9448/
data hkas / &
& 1.9732E-02,8.2461E-03,1.9433E-02,2.5239E-01,7.0020E-01, &
& 1.7698E-01,1.9552E-01,1.8982E-01,2.0086E-01,2.3681E-01, &
& 6.1144E-02,9.1518E-02,2.0913E-01,3.0821E-01,3.3000E-01, &
& 1.1853E-01,1.6684E-01,2.5436E-01,2.2410E-01,2.3617E-01, &
& 1.3174E-01,1.8637E-01,2.1818E-01,2.1883E-01,2.4487E-01, &
& 1.6818E-01,1.9811E-01,1.7183E-01,2.1417E-01,2.4771E-01, &
& 1.3629E-01,1.4266E-01,1.6518E-01,2.7083E-01,2.8504E-01, &
& 1.6885E-01,1.9578E-01,2.0319E-01,2.1598E-01,2.1620E-01, &
& 1.7878E-01,1.8362E-01,1.9993E-01,2.1178E-01,2.2589E-01, &
& 1.9345E-01,1.9568E-01,2.0132E-01,2.0166E-01,2.0789E-01, &
& 1.9354E-01,2.0025E-01,2.0400E-01,2.0302E-01,1.9919E-01, &
& 2.1754E-01,2.1221E-01,2.0669E-01,1.9305E-01,1.7051E-01, &
& 2.3672E-01,2.1723E-01,1.9925E-01,1.8215E-01,1.6466E-01, &
& 2.4692E-01,2.2312E-01,1.9962E-01,1.7636E-01,1.5398E-01, &
& 2.2023E-01,2.0999E-01,1.9844E-01,1.9036E-01,1.8098E-01/
data sflx / &
& 1.4056E-02,5.8741E-03,1.3843E-02,1.7979E-01,4.9878E-01, &
& 1.5997E-01,1.7673E-01,1.7157E-01,1.8156E-01,2.1404E-01, &
& 4.0480E-01,6.0590E-01,1.3845E+00,2.0405E+00,2.1848E+00, &
& 7.6075E-01,1.0708E+00,1.6325E+00,1.4383E+00,1.5157E+00, &
& 2.1362E+00,3.0220E+00,3.5377E+00,3.5483E+00,3.9706E+00, &
& 5.6607E+00,6.6683E+00,5.7836E+00,7.2089E+00,8.3378E+00, &
& 1.4768E+01,1.5458E+01,1.7899E+01,2.9348E+01,3.0887E+01, &
& 1.9903E+01,2.3078E+01,2.3950E+01,2.5459E+01,2.5484E+01, &
& 3.2273E+01,3.3147E+01,3.6093E+01,3.8232E+01,4.0778E+01, &
& 2.9661E+01,3.0003E+01,3.0869E+01,3.0920E+01,3.1876E+01, &
& 9.5588E+01,9.8903E+01,1.0076E+02,1.0027E+02,9.8377E+01, &
& 3.3902E+01,3.3072E+01,3.2211E+01,3.0086E+01,2.6573E+01, &
& 1.2208E+01,1.1203E+01,1.0275E+01,9.3939E+00,8.4915E+00, &
& 7.0905E+00,6.4071E+00,5.7325E+00,5.0645E+00,4.4219E+00, &
& 1.2380E+00,1.1805E+00,1.1155E+00,1.0701E+00,1.0173E+00/
end module aot_spect_5
!----------------------------------------------------------------
! block data aerosol_convolve_25
module aot_spect_25
implicit none
! common /aot_spect_25/ wlo(25,15) , hkas(25,15) ,sflx(25,15)
real wlo_25(25,15) , hkas_25(25,15) ,sflx_25(25,15)
data wlo_25 / &
& 0.1762,0.1778,0.1794,0.1810,0.1826, &
& 0.1843,0.1860,0.1878,0.1896,0.1914, &
& 0.1932,0.1951,0.1970,0.1990,0.2010, &
& 0.2030,0.2051,0.2073,0.2094,0.2116, &
& 0.2139,0.2162,0.2186,0.2210,0.2235, &
& 0.2251,0.2258,0.2265,0.2272,0.2279, &
& 0.2287,0.2294,0.2301,0.2309,0.2316, &
& 0.2324,0.2332,0.2339,0.2347,0.2355, &
& 0.2362,0.2370,0.2378,0.2386,0.2394, &
& 0.2402,0.2410,0.2418,0.2427,0.2435, &
& 0.2446,0.2461,0.2475,0.2490,0.2505, &
& 0.2520,0.2535,0.2551,0.2567,0.2583, &
& 0.2599,0.2615,0.2632,0.2648,0.2665, &
& 0.2682,0.2700,0.2717,0.2735,0.2753, &
& 0.2772,0.2790,0.2809,0.2828,0.2847, &
& 0.2860,0.2865,0.2869,0.2874,0.2879, &
& 0.2884,0.2889,0.2894,0.2899,0.2904, &
& 0.2910,0.2915,0.2920,0.2925,0.2930, &
& 0.2935,0.2940,0.2946,0.2951,0.2956, &
& 0.2961,0.2966,0.2972,0.2977,0.2982, &
& 0.2991,0.3000,0.3009,0.3018,0.3027, &
& 0.3036,0.3045,0.3054,0.3064,0.3073, &
& 0.3082,0.3092,0.3101,0.3111,0.3120, &
& 0.3130,0.3140,0.3150,0.3159,0.3169, &
& 0.3179,0.3189,0.3199,0.3210,0.3220, &
& 0.3232,0.3245,0.3258,0.3271,0.3284, &
& 0.3297,0.3310,0.3323,0.3337,0.3350, &
& 0.3364,0.3378,0.3392,0.3406,0.3420, &
& 0.3434,0.3448,0.3463,0.3477,0.3492, &
& 0.3507,0.3522,0.3537,0.3552,0.3567, &
& 0.3590,0.3617,0.3643,0.3671,0.3698, &
& 0.3726,0.3755,0.3784,0.3813,0.3843, &
& 0.3874,0.3905,0.3936,0.3968,0.4000, &
& 0.4033,0.4067,0.4101,0.4135,0.4170, &
& 0.4206,0.4243,0.4280,0.4317,0.4356, &
& 0.4387,0.4408,0.4429,0.4451,0.4473, &
& 0.4495,0.4518,0.4540,0.4563,0.4586, &
& 0.4609,0.4633,0.4656,0.4680,0.4705, &
& 0.4729,0.4754,0.4779,0.4804,0.4830, &
& 0.4855,0.4881,0.4908,0.4934,0.4961, &
& 0.4996,0.5029,0.5062,0.5096,0.5130, &
& 0.5165,0.5200,0.5236,0.5272,0.5309, &
& 0.5346,0.5383,0.5422,0.5460,0.5500, &
& 0.5540,0.5580,0.5621,0.5663,0.5705, &
& 0.5748,0.5792,0.5836,0.5881,0.5927, &
& 0.5969,0.6002,0.6035,0.6069,0.6103, &
& 0.6137,0.6172,0.6207,0.6243,0.6279, &
& 0.6316,0.6352,0.6390,0.6428,0.6466, &
& 0.6504,0.6544,0.6583,0.6623,0.6664, &
& 0.6705,0.6747,0.6789,0.6832,0.6875, &
& 0.6962,0.7096,0.7236,0.7381,0.7532, &
& 0.7690,0.7854,0.8026,0.8205,0.8392, &
& 0.8588,0.8794,0.9009,0.9235,0.9473, &
& 0.9724,0.9988,1.0267,1.0562,1.0874, &
& 1.1206,1.1558,1.1933,1.2333,1.2762, &
& 1.3070,1.3240,1.3414,1.3592,1.3776, &
& 1.3965,1.4158,1.4358,1.4562,1.4773, &
& 1.4990,1.5214,1.5444,1.5681,1.5926, &
& 1.6179,1.6439,1.6708,1.6987,1.7274, &
& 1.7572,1.7879,1.8198,1.8529,1.8871, &
& 1.9139,1.9324,1.9512,1.9704,1.9900, &
& 2.0101,2.0305,2.0513,2.0725,2.0942, &
& 2.1164,2.1390,2.1622,2.1858,2.2099, &
& 2.2346,2.2599,2.2857,2.3121,2.3392, &
& 2.3669,2.3952,2.4242,2.4540,2.4845, &
& 2.5145,2.5439,2.5740,2.6048,2.6364, &
& 2.6688,2.7020,2.7360,2.7709,2.8066, &
& 2.8433,2.8810,2.9197,2.9595,3.0003, &
& 3.0423,3.0855,3.1299,3.1756,3.2227, &
& 3.2712,3.3212,3.3727,3.4258,3.4807, &
& 3.5174,3.5348,3.5524,3.5702,3.5881, &
& 3.6062,3.6245,3.6430,3.6617,3.6805, &
& 3.6996,3.7189,3.7383,3.7580,3.7779, &
& 3.7979,3.8183,3.8388,3.8595,3.8805, &
& 3.9017,3.9231,3.9448,3.9667,3.9888/
data hkas_25 / &
& 5.2799E-03,5.0829E-03,4.6490E-03,4.0241E-03,3.4829E-03, &
& 2.8976E-03,2.3480E-03,1.8516E-03,1.3749E-03,9.3841E-04, &
& 5.9685E-04,3.2885E-04,1.3047E-04,2.2220E-05,5.5991E-03, &
& 2.7673E-02,3.1899E-02,3.7975E-02,4.7693E-02,8.3620E-02, &
& 1.1867E-01,1.4080E-01,1.2000E-01,1.8402E-01,1.6904E-01, &
& 5.0121E-02,4.9452E-02,4.6279E-02,4.0956E-02,3.7858E-02, &
& 2.6053E-02,3.0795E-02,4.6226E-02,3.7153E-02,3.5560E-02, &
& 4.7180E-02,3.7850E-02,4.0573E-02,4.5254E-02,3.5590E-02, &
& 3.0742E-02,4.1064E-02,4.1940E-02,4.0586E-02,4.7516E-02, &
& 3.2378E-02,4.4837E-02,3.5456E-02,3.5664E-02,4.2917E-02, &
& 1.6466E-02,1.5248E-02,1.2129E-02,1.2876E-02,1.0915E-02, &
& 1.5288E-02,1.2174E-02,1.1518E-02,1.5566E-02,2.3291E-02, &
& 3.5784E-02,2.7197E-02,2.5602E-02,2.8189E-02,6.8271E-02, &
& 7.4253E-02,7.6509E-02,7.4379E-02,7.6454E-02,6.3299E-02, &
& 4.4999E-02,7.9458E-02,5.3948E-02,3.1778E-02,9.4411E-02, &
& 2.9705E-02,2.9759E-02,2.6074E-02,1.4967E-02,7.4578E-03, &
& 2.3107E-02,3.1405E-02,3.1772E-02,3.8404E-02,2.7981E-02, &
& 2.5950E-02,3.7908E-02,4.2120E-02,5.6514E-02,6.0159E-02, &
& 5.4489E-02,5.7136E-02,5.3536E-02,4.5756E-02,5.3907E-02, &
& 5.1124E-02,4.7270E-02,5.0278E-02,5.2757E-02,5.0463E-02, &
& 3.0474E-02,3.1978E-02,2.5582E-02,3.1001E-02,2.6341E-02, &
& 2.9467E-02,2.5155E-02,3.6947E-02,4.1472E-02,3.9135E-02, &
& 3.7515E-02,3.9334E-02,4.3622E-02,4.5644E-02,3.7261E-02, &
& 3.9516E-02,6.1067E-02,4.4004E-02,4.7490E-02,4.7719E-02, &
& 5.4569E-02,3.5377E-02,5.9282E-02,4.1212E-02,4.8834E-02, &
& 3.3110E-02,2.7957E-02,2.4541E-02,3.1640E-02,3.8452E-02, &
& 4.3699E-02,3.7692E-02,4.5887E-02,3.6735E-02,4.2471E-02, &
& 4.0508E-02,4.0549E-02,3.1263E-02,3.2911E-02,3.6471E-02, &
& 4.0021E-02,3.6207E-02,4.0685E-02,3.9095E-02,4.8464E-02, &
& 4.7468E-02,4.8137E-02,5.3969E-02,4.7248E-02,5.4817E-02, &
& 2.4834E-02,2.1951E-02,2.6050E-02,2.7710E-02,3.4553E-02, &
& 3.1715E-02,2.9451E-02,2.7336E-02,3.6347E-02,3.1034E-02, &
& 2.3427E-02,2.7237E-02,3.7576E-02,2.6206E-02,3.2126E-02, &
& 5.2125E-02,5.2807E-02,5.1698E-02,5.6664E-02,5.8765E-02, &
& 6.0530E-02,5.9962E-02,5.9826E-02,5.6824E-02,5.3245E-02, &
& 2.9942E-02,3.4314E-02,3.1576E-02,3.4169E-02,3.6263E-02, &
& 3.5425E-02,3.8424E-02,4.0153E-02,3.9218E-02,3.9656E-02, &
& 4.1712E-02,4.0169E-02,4.1568E-02,4.1185E-02,4.1190E-02, &
& 4.2675E-02,4.1942E-02,4.2627E-02,4.4241E-02,4.5120E-02, &
& 4.5103E-02,4.4734E-02,3.9963E-02,4.4448E-02,4.4182E-02, &
& 3.6238E-02,3.5264E-02,3.4319E-02,3.6506E-02,3.6858E-02, &
& 3.7418E-02,3.5769E-02,3.4340E-02,3.7866E-02,3.7059E-02, &
& 4.0566E-02,3.8579E-02,4.0826E-02,3.9780E-02,4.1088E-02, &
& 4.1249E-02,4.2418E-02,4.2017E-02,4.2620E-02,4.3139E-02, &
& 4.3749E-02,4.5394E-02,4.5299E-02,4.6414E-02,4.5227E-02, &
& 3.7723E-02,3.8411E-02,3.8671E-02,3.8195E-02,3.9511E-02, &
& 3.9418E-02,3.9055E-02,3.8240E-02,3.9599E-02,3.9985E-02, &
& 3.9300E-02,4.0631E-02,3.9929E-02,4.0581E-02,4.0475E-02, &
& 4.0624E-02,4.0457E-02,4.1359E-02,3.7988E-02,4.1377E-02, &
& 4.1472E-02,4.1668E-02,4.1660E-02,4.1838E-02,4.1834E-02, &
& 3.8155E-02,3.8333E-02,3.8502E-02,3.9057E-02,3.9013E-02, &
& 3.9461E-02,3.9758E-02,4.0111E-02,4.0243E-02,4.0392E-02, &
& 3.9720E-02,4.0458E-02,4.1065E-02,4.1312E-02,4.1326E-02, &
& 4.1240E-02,4.1154E-02,4.0773E-02,4.0305E-02,4.0042E-02, &
& 4.0018E-02,4.0038E-02,3.9956E-02,3.9901E-02,3.9668E-02, &
& 4.4043E-02,4.3956E-02,4.3412E-02,4.2920E-02,4.2591E-02, &
& 4.2487E-02,4.2451E-02,4.2278E-02,4.1980E-02,4.1849E-02, &
& 4.1556E-02,4.1621E-02,4.1312E-02,4.0978E-02,4.0676E-02, &
& 4.0101E-02,3.9593E-02,3.8711E-02,3.8058E-02,3.7376E-02, &
& 3.6255E-02,3.5384E-02,3.4555E-02,3.3467E-02,3.2390E-02, &
& 4.9085E-02,4.8014E-02,4.7452E-02,4.6084E-02,4.6143E-02, &
& 4.5126E-02,4.4490E-02,4.3771E-02,4.2825E-02,4.1722E-02, &
& 4.0817E-02,4.0346E-02,3.9877E-02,3.8934E-02,3.8461E-02, &
& 3.8034E-02,3.7265E-02,3.6323E-02,3.5726E-02,3.5049E-02, &
& 3.4210E-02,3.3481E-02,3.2891E-02,3.2285E-02,3.1588E-02, &
& 5.1217E-02,5.0595E-02,4.9284E-02,4.8233E-02,4.7849E-02, &
& 4.6488E-02,4.5516E-02,4.4685E-02,4.3738E-02,4.2612E-02, &
& 4.1889E-02,4.0913E-02,3.9819E-02,3.8998E-02,3.8111E-02, &
& 3.7139E-02,3.6048E-02,3.5235E-02,3.4379E-02,3.3489E-02, &
& 3.2579E-02,3.1537E-02,3.0736E-02,2.9824E-02,2.9085E-02, &
& 4.5112E-02,4.4731E-02,4.4278E-02,4.3820E-02,4.3350E-02, &
& 4.2925E-02,4.2577E-02,4.2229E-02,4.1713E-02,4.1188E-02, &
& 4.0646E-02,4.0021E-02,3.9857E-02,3.8890E-02,3.8999E-02, &
& 3.8626E-02,3.8315E-02,3.7974E-02,3.7671E-02,3.7171E-02, &
& 3.6752E-02,3.6471E-02,3.6046E-02,3.5548E-02,3.5090E-02/
data sflx_25/ &
& 3.3009E-03,3.1778E-03,2.9065E-03,2.5158E-03,2.1775E-03, &
& 1.8116E-03,1.4679E-03,1.1576E-03,8.5959E-04,5.8668E-04, &
& 3.7314E-04,2.0560E-04,8.1568E-05,1.3892E-05,3.5005E-03, &
& 1.7301E-02,1.9943E-02,2.3742E-02,2.9817E-02,5.2278E-02, &
& 7.4193E-02,8.8026E-02,7.5023E-02,1.1505E-01,1.0568E-01, &
& 4.4282E-02,4.3691E-02,4.0888E-02,3.6184E-02,3.3448E-02, &
& 2.3018E-02,2.7208E-02,4.0841E-02,3.2825E-02,3.1417E-02, &
& 4.1683E-02,3.3441E-02,3.5846E-02,3.9982E-02,3.1444E-02, &
& 2.7161E-02,3.6280E-02,3.7054E-02,3.5858E-02,4.1981E-02, &
& 2.8606E-02,3.9614E-02,3.1325E-02,3.1509E-02,3.7918E-02, &
& 1.0101E-01,9.3537E-02,7.4402E-02,7.8986E-02,6.6956E-02, &
& 9.3786E-02,7.4679E-02,7.0655E-02,9.5489E-02,1.4288E-01, &
& 2.1951E-01,1.6683E-01,1.5705E-01,1.7292E-01,4.1880E-01, &
& 4.5550E-01,4.6934E-01,4.5627E-01,4.6900E-01,3.8830E-01, &
& 2.7604E-01,4.8743E-01,3.3094E-01,1.9494E-01,5.7915E-01, &
& 1.7599E-01,1.7631E-01,1.5448E-01,8.8671E-02,4.4184E-02, &
& 1.3690E-01,1.8606E-01,1.8824E-01,2.2753E-01,1.6577E-01, &
& 1.5374E-01,2.2459E-01,2.4955E-01,3.3482E-01,3.5642E-01, &
& 3.2283E-01,3.3851E-01,3.1718E-01,2.7109E-01,3.1938E-01, &
& 3.0289E-01,2.8005E-01,2.9787E-01,3.1256E-01,2.9897E-01, &
& 4.7450E-01,4.9792E-01,3.9834E-01,4.8271E-01,4.1015E-01, &
& 4.5883E-01,3.9168E-01,5.7529E-01,6.4574E-01,6.0936E-01, &
& 5.8414E-01,6.1246E-01,6.7922E-01,7.1071E-01,5.8018E-01, &
& 6.1529E-01,9.5085E-01,6.8518E-01,7.3945E-01,7.4301E-01, &
& 8.4968E-01,5.5085E-01,9.2306E-01,6.4171E-01,7.6037E-01, &
& 1.0836E+00,9.1500E-01,8.0321E-01,1.0356E+00,1.2585E+00, &
& 1.4302E+00,1.2336E+00,1.5018E+00,1.2023E+00,1.3900E+00, &
& 1.3258E+00,1.3271E+00,1.0232E+00,1.0772E+00,1.1937E+00, &
& 1.3099E+00,1.1850E+00,1.3316E+00,1.2795E+00,1.5862E+00, &
& 1.5536E+00,1.5755E+00,1.7664E+00,1.5464E+00,1.7941E+00, &
& 2.6150E+00,2.3115E+00,2.7431E+00,2.9179E+00,3.6384E+00, &
& 3.3396E+00,3.1012E+00,2.8785E+00,3.8273E+00,3.2679E+00, &
& 2.4668E+00,2.8681E+00,3.9567E+00,2.7595E+00,3.3828E+00, &
& 5.4888E+00,5.5606E+00,5.4437E+00,5.9667E+00,6.1879E+00, &
& 6.3738E+00,6.3140E+00,6.2996E+00,5.9836E+00,5.6067E+00, &
& 3.4766E+00,3.9842E+00,3.6664E+00,3.9674E+00,4.2105E+00, &
& 4.1133E+00,4.4615E+00,4.6622E+00,4.5536E+00,4.6045E+00, &
& 4.8432E+00,4.6640E+00,4.8265E+00,4.7820E+00,4.7826E+00, &
& 4.9550E+00,4.8700E+00,4.9494E+00,5.1368E+00,5.2390E+00, &
& 5.2370E+00,5.1941E+00,4.6402E+00,5.1609E+00,5.1301E+00, &
& 6.4948E+00,6.3201E+00,6.1509E+00,6.5429E+00,6.6059E+00, &
& 6.7062E+00,6.4108E+00,6.1545E+00,6.7865E+00,6.6419E+00, &
& 7.2704E+00,6.9142E+00,7.3170E+00,7.1295E+00,7.3641E+00, &
& 7.3928E+00,7.6024E+00,7.5305E+00,7.6385E+00,7.7317E+00, &
& 7.8410E+00,8.1357E+00,8.1187E+00,8.3186E+00,8.1057E+00, &
& 5.7948E+00,5.9004E+00,5.9404E+00,5.8673E+00,6.0694E+00, &
& 6.0551E+00,5.9994E+00,5.8742E+00,6.0830E+00,6.1422E+00, &
& 6.0369E+00,6.2414E+00,6.1336E+00,6.2338E+00,6.2175E+00, &
& 6.2403E+00,6.2148E+00,6.3533E+00,5.8355E+00,6.3561E+00, &
& 6.3706E+00,6.4007E+00,6.3995E+00,6.4268E+00,6.4263E+00, &
& 1.8893E+01,1.8981E+01,1.9065E+01,1.9339E+01,1.9317E+01, &
& 1.9539E+01,1.9686E+01,1.9861E+01,1.9927E+01,2.0000E+01, &
& 1.9668E+01,2.0033E+01,2.0333E+01,2.0456E+01,2.0463E+01, &
& 2.0420E+01,2.0378E+01,2.0189E+01,1.9958E+01,1.9827E+01, &
& 1.9815E+01,1.9825E+01,1.9784E+01,1.9757E+01,1.9642E+01, &
& 6.9768E+00,6.9631E+00,6.8768E+00,6.7990E+00,6.7469E+00, &
& 6.7303E+00,6.7247E+00,6.6973E+00,6.6500E+00,6.6293E+00, &
& 6.5828E+00,6.5933E+00,6.5442E+00,6.4914E+00,6.4434E+00, &
& 6.3523E+00,6.2719E+00,6.1322E+00,6.0288E+00,5.9207E+00, &
& 5.7431E+00,5.6052E+00,5.4739E+00,5.3015E+00,5.1310E+00, &
& 2.6183E+00,2.5612E+00,2.5312E+00,2.4582E+00,2.4613E+00, &
& 2.4071E+00,2.3732E+00,2.3348E+00,2.2844E+00,2.2255E+00, &
& 2.1772E+00,2.1521E+00,2.1271E+00,2.0768E+00,2.0516E+00, &
& 2.0288E+00,1.9878E+00,1.9375E+00,1.9057E+00,1.8696E+00, &
& 1.8248E+00,1.7859E+00,1.7544E+00,1.7221E+00,1.6850E+00, &
& 1.5186E+00,1.5002E+00,1.4613E+00,1.4301E+00,1.4187E+00, &
& 1.3784E+00,1.3496E+00,1.3249E+00,1.2968E+00,1.2635E+00, &
& 1.2420E+00,1.2131E+00,1.1806E+00,1.1563E+00,1.1300E+00, &
& 1.1012E+00,1.0688E+00,1.0447E+00,1.0193E+00,9.9296E-01, &
& 9.6597E-01,9.3507E-01,9.1134E-01,8.8430E-01,8.6237E-01, &
& 2.6980E-01,2.6752E-01,2.6481E-01,2.6207E-01,2.5926E-01, &
& 2.5672E-01,2.5464E-01,2.5256E-01,2.4947E-01,2.4633E-01, &
& 2.4309E-01,2.3935E-01,2.3837E-01,2.3259E-01,2.3324E-01, &
& 2.3101E-01,2.2915E-01,2.2711E-01,2.2530E-01,2.2231E-01, &
& 2.1980E-01,2.1812E-01,2.1558E-01,2.1260E-01,2.0986E-01/
end module aot_spect_25
!-----------------------------------------------------------------------
!-------------------------------------------------------------------------------
! new data for nongray gas absorption
!-------------------------------------------------------------------------------
module band_new 1
implicit none
integer, private :: i, j, k
! block data ckd1_new
!c *********************************************************************
!c hk is the interval in the g (cumulative probability) space from 0 to
!c one. fko3 is the corresponding ozone absorption coefficient in units
!c of (cm-atm)**-1 (Fu, 1991). The spectral region is from 50000 cm**-1
!c to 14500 cm**-1.
!c *********************************************************************
! common /band1_new/ hk(10), fko3(10)
real hk_1_new(10), fko3_1_new(10)
data hk_1_new / .24, .16, .24, .28, .03, &
& .016, .01, .008, .008, .008 /
data fko3_1_new / .2204e-08,.1207e-01,.4537e-01,.1032e+00,.1740e+00, &
& .1210e+01,.7367e+01,.2050e+02,.8100e+02,.2410e+03 /
! block data ckd2_new
!c *********************************************************************
!c hk is the interval in the g (cumulative probability) space from 0
!c to one. coeh2o is the coefficient to calculate the H2O absorption
!c coefficient in units of (cm-atm)**-1 at there temperatures, eleven
!c pressures, and eight cumulative probabilities ( Fu, 1991 ). The
!c spectral region is from 14500 to 7700 cm**-1.
!c in this block data, Z.F. has added coefficients for O2 and Water vapor
!c continuum absorption in Jun,2003.
!c *********************************************************************
! common /band2_new/ hk(12),coehh22(3,11,12),coeo2(3,11,12) &
! ,coeh2o(3,11,12)
real hk_2_new(12),coehh22_2_new(3,11,12),coeo2_2_new(3,11,12) &
& ,coeh2o_2_new(3,11,12)
data hk_2_new /8.13791e-02,1.71362e-01,2.22259e-01,2.22259e-01, &
& 1.71362e-01,8.13791e-02,4.28311e-03,9.01904e-03, &
& 1.16978e-02,1.16978e-02,9.01904e-03,4.28311e-03/
data ( ( coehh22_2_new(1,j,i), i = 1, 12 ), j = 1, 11 ) / &
&-.1821E+02,-.1407E+02,-.1108E+02,-.8593E+01,-.6067E+01,-.3578E+01, &
&-.2358E+01,-.2027E+01,-.1428E+01,-.4851E+00,0.9785E+00,0.3279E+01, &
&-.1775E+02,-.1361E+02,-.1062E+02,-.8141E+01,-.5667E+01,-.3321E+01, &
&-.2164E+01,-.1850E+01,-.1285E+01,-.3751E+00,0.1043E+01,0.3303E+01, &
&-.1729E+02,-.1315E+02,-.1016E+02,-.7684E+01,-.5263E+01,-.3047E+01, &
&-.1950E+01,-.1647E+01,-.1117E+01,-.2376E+00,0.1122E+01,0.3332E+01, &
&-.1683E+02,-.1269E+02,-.9698E+01,-.7231E+01,-.4862E+01,-.2759E+01, &
&-.1717E+01,-.1436E+01,-.9149E+00,-.8219E-01,0.1243E+01,0.3375E+01, &
&-.1636E+02,-.1223E+02,-.9238E+01,-.6779E+01,-.4470E+01,-.2452E+01, &
&-.1468E+01,-.1204E+01,-.6986E+00,0.9617E-01,0.1358E+01,0.3457E+01, &
&-.1590E+02,-.1177E+02,-.8780E+01,-.6333E+01,-.4088E+01,-.2141E+01, &
&-.1215E+01,-.9557E+00,-.4736E+00,0.2885E+00,0.1475E+01,0.3482E+01, &
&-.1545E+02,-.1131E+02,-.8325E+01,-.5897E+01,-.3725E+01,-.1835E+01, &
&-.9593E+00,-.7167E+00,-.2586E+00,0.4937E+00,0.1604E+01,0.3545E+01, &
&-.1498E+02,-.1085E+02,-.7870E+01,-.5470E+01,-.3376E+01,-.1538E+01, &
&-.7021E+00,-.4709E+00,-.3576E-01,0.6926E+00,0.1718E+01,0.3590E+01, &
&-.1452E+02,-.1039E+02,-.7421E+01,-.5067E+01,-.3050E+01,-.1252E+01, &
&-.4701E+00,-.2477E+00,0.1768E+00,0.8375E+00,0.1814E+01,0.3606E+01, &
&-.1406E+02,-.9927E+01,-.6986E+01,-.4696E+01,-.2753E+01,-.9814E+00, &
&-.2519E+00,-.4112E-01,0.3549E+00,0.9703E+00,0.1910E+01,0.3559E+01, &
&-.1360E+02,-.9472E+01,-.6574E+01,-.4359E+01,-.2487E+01,-.7404E+00, &
&-.4451E-01,0.1383E+00,0.4923E+00,0.1085E+01,0.2017E+01,0.3453E+01/
data ( ( coehh22_2_new(2,j,i), i = 1, 12 ), j = 1, 11 ) / &
&-.2168E-01,-.7137E-02,-.2046E-02,-.6012E-03,0.1375E-02,0.3989E-02, &
&0.4886E-02,0.4990E-02,0.4812E-02,0.4351E-02,0.3974E-02,0.2008E-02, &
&-.2166E-01,-.7155E-02,-.2041E-02,-.6029E-03,0.1182E-02,0.3206E-02, &
&0.4093E-02,0.4055E-02,0.3902E-02,0.3741E-02,0.3299E-02,0.1692E-02, &
&-.2167E-01,-.7142E-02,-.2036E-02,-.5894E-03,0.1002E-02,0.2573E-02, &
&0.3263E-02,0.3213E-02,0.3053E-02,0.3087E-02,0.2730E-02,0.1736E-02, &
&-.2168E-01,-.7141E-02,-.2031E-02,-.5649E-03,0.8002E-03,0.1931E-02, &
&0.2491E-02,0.2393E-02,0.2325E-02,0.2442E-02,0.2186E-02,0.1413E-02, &
&-.2168E-01,-.7137E-02,-.2017E-02,-.5129E-03,0.6594E-03,0.1419E-02, &
&0.1780E-02,0.1713E-02,0.1783E-02,0.1866E-02,0.1721E-02,0.1210E-02, &
&-.2168E-01,-.7136E-02,-.2008E-02,-.4597E-03,0.5986E-03,0.8626E-03, &
&0.1188E-02,0.1271E-02,0.1314E-02,0.1275E-02,0.1135E-02,0.7870E-03, &
&-.2166E-01,-.7154E-02,-.1977E-02,-.3950E-03,0.6628E-03,0.5570E-03, &
&0.8196E-03,0.8767E-03,0.9092E-03,0.7797E-03,0.6736E-03,0.4020E-03, &
&-.2167E-01,-.7135E-02,-.1937E-02,-.3398E-03,0.7607E-03,0.2372E-03, &
&0.6595E-03,0.6433E-03,0.5461E-03,0.4611E-03,0.3156E-03,-.1029E-03, &
&-.2168E-01,-.7130E-02,-.1861E-02,-.2656E-03,0.8627E-03,0.4753E-04, &
&0.4097E-03,0.3685E-03,0.3269E-03,0.3406E-03,0.2222E-03,-.1134E-03, &
&-.2166E-01,-.7098E-02,-.1766E-02,-.1544E-03,0.8606E-03,-.1285E-03, &
&0.5824E-04,0.2334E-03,0.1791E-03,0.1358E-03,-.3466E-04,-.1864E-03, &
&-.2166E-01,-.7058E-02,-.1687E-02,-.1018E-04,0.8420E-03,-.1835E-03, &
&-.1922E-03,-.7330E-04,0.3881E-04,-.8928E-04,-.1939E-04,-.7279E-04/
data ( ( coehh22_2_new(3,j,i), i = 1, 12 ), j = 1, 11 ) / &
&0.5345E-05,0.3912E-04,0.2748E-04,0.1444E-05,-.4212E-05,-.2604E-05, &
&-.2211E-05,-.3476E-05,-.2656E-05,-.6117E-05,-.7721E-05,0.9503E-05, &
&0.5435E-05,0.3922E-04,0.2701E-04,0.7721E-06,-.4266E-05,-.1224E-05, &
&-.1462E-05,-.3870E-05,-.1057E-06,-.5089E-05,-.6126E-05,0.7750E-05, &
&0.5355E-05,0.3916E-04,0.2726E-04,0.5206E-06,-.3851E-05,0.1578E-05, &
&0.9728E-06,-.3372E-05,0.1778E-05,-.2598E-05,-.3351E-06,0.2366E-05, &
&0.5353E-05,0.3921E-04,0.2713E-04,0.4761E-07,-.4572E-05,0.5006E-05, &
&0.8988E-07,0.1673E-05,0.9565E-06,-.3223E-06,-.5420E-05,-.1326E-05, &
&0.5364E-05,0.3905E-04,0.2694E-04,-.2245E-06,-.3170E-05,0.4342E-05, &
&0.3347E-06,0.8541E-06,-.4142E-06,0.1542E-05,-.7389E-06,-.6179E-05, &
&0.5346E-05,0.3909E-04,0.2676E-04,0.5793E-07,-.1923E-05,0.4991E-05, &
&-.4133E-06,-.4665E-06,0.1344E-05,0.3320E-05,0.1297E-05,0.1052E-05, &
&0.5435E-05,0.3914E-04,0.2615E-04,-.5951E-07,-.2672E-06,0.4456E-05, &
&0.2792E-06,0.1402E-05,0.4331E-05,0.7323E-07,-.1674E-05,0.1962E-05, &
&0.5355E-05,0.3917E-04,0.2610E-04,0.8890E-06,0.1079E-05,0.3992E-05, &
&-.2672E-06,0.2250E-05,0.3658E-05,-.3284E-05,-.3928E-06,0.3088E-05, &
&0.5352E-05,0.3905E-04,0.2578E-04,0.1128E-05,0.2670E-05,0.2115E-05, &
&0.4263E-05,0.1726E-05,0.1125E-05,0.9597E-07,-.1567E-05,0.3222E-05, &
&0.5711E-05,0.3895E-04,0.2695E-04,0.2255E-05,0.2170E-05,0.1602E-05, &
&0.3974E-05,0.2949E-05,0.8487E-06,0.6461E-06,0.4729E-05,0.4043E-06, &
&0.5705E-05,0.3824E-04,0.2761E-04,0.2485E-05,0.1433E-05,0.2177E-05, &
&0.2933E-05,0.5048E-05,0.5340E-05,0.1356E-05,0.4762E-05,-.4439E-06/
data ( ( coeo2_2_new(1,j,i), i = 1, 12 ), j = 1, 11 ) / &
&-.4604E+02,-.4601E+02,-.4595E+02,-.4589E+02,-.4583E+02,-.2516E+02, &
&-.2171E+02,-.2105E+02,-.1975E+02,-.1772E+02,-.1573E+02,-.1210E+02, &
&-.4604E+02,-.4601E+02,-.4595E+02,-.4589E+02,-.4583E+02,-.2471E+02, &
&-.2126E+02,-.2060E+02,-.1932E+02,-.1732E+02,-.1534E+02,-.1185E+02, &
&-.4604E+02,-.4601E+02,-.4595E+02,-.4589E+02,-.4583E+02,-.2424E+02, &
&-.2080E+02,-.2015E+02,-.1889E+02,-.1692E+02,-.1495E+02,-.1159E+02, &
&-.4604E+02,-.4601E+02,-.4595E+02,-.4589E+02,-.4583E+02,-.2378E+02, &
&-.2034E+02,-.1970E+02,-.1847E+02,-.1652E+02,-.1455E+02,-.1136E+02, &
&-.4604E+02,-.4601E+02,-.4595E+02,-.4589E+02,-.4583E+02,-.2332E+02, &
&-.1989E+02,-.1925E+02,-.1805E+02,-.1613E+02,-.1413E+02,-.1108E+02, &
&-.4604E+02,-.4601E+02,-.4595E+02,-.4589E+02,-.4583E+02,-.2286E+02, &
&-.1945E+02,-.1881E+02,-.1763E+02,-.1573E+02,-.1369E+02,-.1074E+02, &
&-.4604E+02,-.4601E+02,-.4595E+02,-.4589E+02,-.4583E+02,-.2240E+02, &
&-.1900E+02,-.1837E+02,-.1723E+02,-.1534E+02,-.1326E+02,-.1044E+02, &
&-.4604E+02,-.4601E+02,-.4595E+02,-.4589E+02,-.4583E+02,-.2194E+02, &
&-.1857E+02,-.1795E+02,-.1683E+02,-.1495E+02,-.1283E+02,-.1015E+02, &
&-.4604E+02,-.4601E+02,-.4595E+02,-.4589E+02,-.4583E+02,-.2149E+02, &
&-.1816E+02,-.1753E+02,-.1644E+02,-.1454E+02,-.1244E+02,-.9817E+01, &
&-.4604E+02,-.4601E+02,-.4595E+02,-.4589E+02,-.4583E+02,-.2104E+02, &
&-.1778E+02,-.1713E+02,-.1606E+02,-.1413E+02,-.1206E+02,-.9475E+01, &
&-.4604E+02,-.4601E+02,-.4595E+02,-.4588E+02,-.4583E+02,-.2055E+02, &
&-.1738E+02,-.1672E+02,-.1566E+02,-.1373E+02,-.1170E+02,-.9193E+01/
data ( ( coeo2_2_new(2,j,i), i = 1, 12 ), j = 1, 11 ) / &
&-.3815E-06,-.2150E-05,-.4924E-05,-.8011E-05,-.1072E-04,0.1366E-01, &
&0.7135E-02,0.4556E-02,0.4852E-02,0.2572E-02,0.4399E-03,0.2910E-02, &
&-.3815E-06,-.2150E-05,-.4924E-05,-.8011E-05,-.1072E-04,0.1367E-01, &
&0.7211E-02,0.4590E-02,0.4885E-02,0.2295E-02,-.1277E-03,0.1699E-02, &
&-.3815E-06,-.2150E-05,-.4924E-05,-.8011E-05,-.1072E-04,0.1367E-01, &
&0.7271E-02,0.4660E-02,0.4926E-02,0.2230E-02,-.6077E-03,0.9087E-03, &
&-.3815E-06,-.2150E-05,-.4924E-05,-.8011E-05,-.1072E-04,0.1368E-01, &
&0.7344E-02,0.4702E-02,0.4860E-02,0.2109E-02,-.7692E-03,0.4872E-03, &
&-.3815E-06,-.2150E-05,-.4924E-05,-.8011E-05,-.1072E-04,0.1370E-01, &
&0.7449E-02,0.4758E-02,0.4803E-02,0.2056E-02,-.9399E-03,0.4198E-03, &
&-.3815E-06,-.2150E-05,-.4924E-05,-.8011E-05,-.1072E-04,0.1371E-01, &
&0.7573E-02,0.4859E-02,0.4630E-02,0.1992E-02,-.1122E-02,0.8852E-05, &
&-.3815E-06,-.2150E-05,-.4924E-05,-.8011E-05,-.1072E-04,0.1375E-01, &
&0.7719E-02,0.4959E-02,0.4513E-02,0.1875E-02,-.1294E-02,-.2601E-03, &
&-.3815E-06,-.2150E-05,-.4924E-05,-.8011E-05,-.1072E-04,0.1378E-01, &
&0.7919E-02,0.5059E-02,0.4343E-02,0.1973E-02,-.1403E-02,-.4933E-03, &
&-.3815E-06,-.2150E-05,-.4924E-05,-.8011E-05,-.1072E-04,0.1384E-01, &
&0.8042E-02,0.5232E-02,0.4213E-02,0.2020E-02,-.1381E-02,-.6582E-03, &
&-.3815E-06,-.2150E-05,-.4924E-05,-.8011E-05,-.1072E-04,0.1398E-01, &
&0.8357E-02,0.5262E-02,0.4275E-02,0.1935E-02,-.1254E-02,-.4774E-03, &
&-.4161E-06,-.2011E-05,-.4578E-05,-.7456E-05,-.1002E-04,0.1418E-01, &
&0.8342E-02,0.5315E-02,0.3932E-02,0.1758E-02,-.9858E-03,-.7214E-03/
data ( ( coeo2_2_new(3,j,i), i = 1, 12 ), j = 1, 11 ) / &
&-.6305E-09,-.2522E-08,-.3783E-08,-.5675E-08,-.9458E-08,-.2417E-04, &
&-.4086E-04,-.1231E-04,-.2747E-04,-.2066E-04,0.1113E-04,0.9287E-05, &
&-.6305E-09,-.2522E-08,-.3783E-08,-.5675E-08,-.9458E-08,-.2432E-04, &
&-.4252E-04,-.1328E-04,-.2484E-04,-.2011E-04,0.9843E-05,-.5839E-06, &
&-.6305E-09,-.2522E-08,-.3783E-08,-.5675E-08,-.9458E-08,-.2428E-04, &
&-.4226E-04,-.1416E-04,-.2158E-04,-.1958E-04,0.1067E-04,-.3985E-05, &
&-.6305E-09,-.2522E-08,-.3783E-08,-.5675E-08,-.9458E-08,-.2461E-04, &
&-.4324E-04,-.1462E-04,-.1828E-04,-.2116E-04,0.1271E-04,0.5814E-05, &
&-.6305E-09,-.2522E-08,-.3783E-08,-.5675E-08,-.9458E-08,-.2463E-04, &
&-.4351E-04,-.1427E-04,-.1314E-04,-.2016E-04,0.1150E-04,0.9943E-06, &
&-.6305E-09,-.2522E-08,-.3783E-08,-.5675E-08,-.9458E-08,-.2504E-04, &
&-.4237E-04,-.1326E-04,-.1001E-04,-.2134E-04,0.8825E-05,0.6250E-06, &
&-.6305E-09,-.2522E-08,-.3783E-08,-.5675E-08,-.9458E-08,-.2576E-04, &
&-.4232E-04,-.1489E-04,-.5905E-05,-.1889E-04,0.4480E-05,0.1725E-05, &
&-.6305E-09,-.2522E-08,-.3783E-08,-.5675E-08,-.9458E-08,-.2656E-04, &
&-.4117E-04,-.1467E-04,-.4666E-05,-.1198E-04,0.6646E-06,0.9255E-05, &
&-.6305E-09,-.2522E-08,-.3783E-08,-.5675E-08,-.9458E-08,-.2700E-04, &
&-.3805E-04,-.1800E-04,-.2492E-05,-.1327E-04,0.2149E-05,0.9164E-05, &
&-.6305E-09,-.2522E-08,-.3783E-08,-.5675E-08,-.9458E-08,-.2826E-04, &
&-.3420E-04,-.2047E-04,0.3207E-05,-.1336E-04,-.2036E-05,0.2122E-05, &
&0.1261E-08,0.6305E-08,0.1513E-07,0.2711E-07,0.3468E-07,-.2569E-04, &
&-.2710E-04,-.1924E-04,0.1073E-04,-.1587E-04,-.3022E-05,0.5785E-05/
data ( ( coeh2o_2_new(1,j,i), i = 1, 12 ), j = 1, 11 ) / &
&-.4596E+02,-.2279E+02,-.1864E+02,-.1594E+02,-.1336E+02,-.1074E+02, &
&-.9509E+01,-.9178E+01,-.8577E+01,-.7633E+01,-.6165E+01,-.3864E+01, &
&-.4596E+02,-.2233E+02,-.1818E+02,-.1549E+02,-.1296E+02,-.1049E+02, &
&-.9317E+01,-.9003E+01,-.8437E+01,-.7522E+01,-.6104E+01,-.3846E+01, &
&-.4596E+02,-.2187E+02,-.1772E+02,-.1503E+02,-.1256E+02,-.1022E+02, &
&-.9105E+01,-.8800E+01,-.8267E+01,-.7388E+01,-.6024E+01,-.3818E+01, &
&-.4596E+02,-.2141E+02,-.1726E+02,-.1458E+02,-.1216E+02,-.9934E+01, &
&-.8875E+01,-.8592E+01,-.8070E+01,-.7231E+01,-.5905E+01,-.3772E+01, &
&-.4596E+02,-.2095E+02,-.1680E+02,-.1412E+02,-.1177E+02,-.9636E+01, &
&-.8631E+01,-.8362E+01,-.7849E+01,-.7055E+01,-.5789E+01,-.3683E+01, &
&-.4596E+02,-.2049E+02,-.1634E+02,-.1368E+02,-.1139E+02,-.9329E+01, &
&-.8381E+01,-.8118E+01,-.7629E+01,-.6865E+01,-.5673E+01,-.3663E+01, &
&-.4596E+02,-.2003E+02,-.1589E+02,-.1324E+02,-.1103E+02,-.9034E+01, &
&-.8126E+01,-.7881E+01,-.7413E+01,-.6661E+01,-.5548E+01,-.3604E+01, &
&-.4596E+02,-.1957E+02,-.1543E+02,-.1282E+02,-.1068E+02,-.8753E+01, &
&-.7877E+01,-.7639E+01,-.7194E+01,-.6462E+01,-.5431E+01,-.3559E+01, &
&-.4596E+02,-.1911E+02,-.1498E+02,-.1242E+02,-.1035E+02,-.8478E+01, &
&-.7651E+01,-.7421E+01,-.6991E+01,-.6320E+01,-.5337E+01,-.3544E+01, &
&-.4596E+02,-.1864E+02,-.1455E+02,-.1205E+02,-.1006E+02,-.8228E+01, &
&-.7446E+01,-.7227E+01,-.6820E+01,-.6193E+01,-.5246E+01,-.3590E+01, &
&-.4596E+02,-.1818E+02,-.1415E+02,-.1173E+02,-.9797E+01,-.8011E+01, &
&-.7262E+01,-.7069E+01,-.6690E+01,-.6085E+01,-.5139E+01,-.3699E+01/
data ( ( coeh2o_2_new(2,j,i), i = 1, 12 ), j = 1, 11 ) / &
&-.1547E-04,0.5600E-02,0.2620E-02,0.7216E-03,0.2127E-02,0.4178E-02, &
&0.4942E-02,0.5022E-02,0.4865E-02,0.4364E-02,0.3928E-02,0.2032E-02, &
&-.1547E-04,0.5585E-02,0.2619E-02,0.7277E-03,0.1927E-02,0.3428E-02, &
&0.4165E-02,0.4110E-02,0.3921E-02,0.3774E-02,0.3313E-02,0.1773E-02, &
&-.1547E-04,0.5600E-02,0.2626E-02,0.7344E-03,0.1729E-02,0.2840E-02, &
&0.3350E-02,0.3289E-02,0.3081E-02,0.3093E-02,0.2778E-02,0.1820E-02, &
&-.1547E-04,0.5601E-02,0.2635E-02,0.7589E-03,0.1535E-02,0.2250E-02, &
&0.2581E-02,0.2472E-02,0.2365E-02,0.2492E-02,0.2252E-02,0.1356E-02, &
&-.1547E-04,0.5600E-02,0.2643E-02,0.8161E-03,0.1329E-02,0.1773E-02, &
&0.1904E-02,0.1792E-02,0.1826E-02,0.1918E-02,0.1714E-02,0.1239E-02, &
&-.1547E-04,0.5601E-02,0.2663E-02,0.8765E-03,0.1206E-02,0.1293E-02, &
&0.1344E-02,0.1350E-02,0.1367E-02,0.1310E-02,0.1119E-02,0.8026E-03, &
&-.1547E-04,0.5585E-02,0.2695E-02,0.9617E-03,0.1197E-02,0.9559E-03, &
&0.1008E-02,0.9791E-03,0.9892E-03,0.7806E-03,0.6872E-03,0.3329E-03, &
&-.1547E-04,0.5602E-02,0.2762E-02,0.1039E-02,0.1277E-02,0.7514E-03, &
&0.8401E-03,0.8117E-03,0.6529E-03,0.5337E-03,0.3562E-03,-.8344E-04, &
&-.1547E-04,0.5613E-02,0.2901E-02,0.1132E-02,0.1326E-02,0.6222E-03, &
&0.6984E-03,0.6159E-03,0.5078E-03,0.4187E-03,0.2222E-03,-.2135E-04, &
&-.5341E-05,0.5806E-02,0.3142E-02,0.1240E-02,0.1435E-02,0.5730E-03, &
&0.5152E-03,0.5664E-03,0.3897E-03,0.2327E-03,0.6928E-04,-.1874E-03, &
&-.1214E-05,0.5878E-02,0.3387E-02,0.1470E-02,0.1494E-02,0.6158E-03, &
&0.3543E-03,0.4093E-03,0.3208E-03,0.1312E-03,0.2899E-04,0.3038E-04/
data ( ( coeh2o_2_new(3,j,i), i = 1, 12 ), j = 1, 11 ) / &
&-.9206E-07,-.2814E-04,-.1404E-04,-.5340E-05,-.6889E-05,-.3128E-05, &
&-.2556E-05,-.3281E-05,-.2707E-05,-.5780E-05,-.9518E-05,0.8739E-05, &
&-.9206E-07,-.2836E-04,-.1414E-04,-.5943E-05,-.6749E-05,-.1934E-05, &
&-.1748E-05,-.3216E-05,0.1165E-05,-.5499E-05,-.6411E-05,0.8325E-05, &
&-.9206E-07,-.2806E-04,-.1418E-04,-.6399E-05,-.6072E-05,-.2554E-06, &
&0.5296E-06,-.3495E-05,0.1765E-05,-.2036E-05,-.9355E-06,0.4405E-05, &
&-.9206E-07,-.2803E-04,-.1418E-04,-.6912E-05,-.5556E-05,0.3016E-05, &
&-.5880E-07,0.1122E-05,0.2206E-05,-.1350E-05,-.4414E-05,-.9245E-06, &
&-.9206E-07,-.2827E-04,-.1435E-04,-.7685E-05,-.5245E-05,0.3400E-05, &
&0.5464E-06,0.6018E-06,-.9525E-06,0.2221E-05,-.1612E-05,-.1015E-04, &
&-.9206E-07,-.2811E-04,-.1466E-04,-.7855E-05,-.2958E-05,0.2385E-05, &
&0.3030E-06,-.2801E-06,0.1434E-05,0.4181E-05,0.1494E-05,0.2618E-05, &
&-.9206E-07,-.2846E-04,-.1513E-04,-.7776E-05,-.4817E-06,0.1369E-05, &
&-.8504E-06,0.5702E-06,0.2181E-05,0.1196E-05,0.8812E-07,0.7878E-06, &
&-.9206E-07,-.2815E-04,-.1581E-04,-.7683E-05,-.1405E-05,0.2806E-05, &
&-.1846E-05,0.8688E-06,0.2422E-05,-.4146E-05,-.1866E-06,0.3171E-05, &
&-.9206E-07,-.2826E-04,-.1619E-04,-.7683E-05,-.6600E-06,-.9242E-06, &
&0.1720E-05,0.1522E-06,0.4729E-09,-.4315E-06,-.1367E-05,0.3501E-05, &
&-.3279E-07,-.2706E-04,-.1617E-04,-.6712E-05,-.6983E-07,-.1014E-05, &
&0.1544E-05,0.4504E-06,-.8275E-06,-.8392E-06,0.4323E-05,0.1294E-05, &
&-.1702E-07,-.2656E-04,-.1525E-04,-.6871E-05,-.9906E-06,-.2592E-05, &
&0.6030E-06,0.1797E-05,0.1264E-05,-.1128E-05,0.3285E-05,-.3950E-06/
! block data ckd3_new
!c *********************************************************************
!c hk is the interval in the g (cumulative probability) space from 0
!c to one. coeh2o is the coefficient to calculate the H2O absorption
!c coefficient in units of (cm-atm)**-1 at there temperatures, eleven
!c pressures, and twelve cumulative probabilities ( Fu, 1991 ). The
!c spectral region is from 7700 to 5250 cm**-1.
!c in this block data, Z.F. has added the coefficients for water vapor
!c continuum absorption in Jun,2003.
!c *********************************************************************
! common /band3_new/ hk(12), coehh32(3,11,12),coeh2o(3,11,12)
real hk_3_new(12), coehh32_3_new(3,11,12),coeh2o_3_new(3,11,12)
data hk_3_new / .34, .11, .1, .09, .12, .1, &
& .06, .04, .026, .01, .0035, .0005 /
! .509474E+02 .164830E+02 .149845E+02 .134861E+02 .179814E+02
! .149845E+02 .899071E+01 .599381E+01 .389597E+01 .149845E+01
! .524458E+00 .749226E-01
data ( ( coehh32_3_new(1,j,i), i = 1, 12 ), j = 1, 11 ) / &
&-.1140E+02,-.7525E+01,-.5814E+01,-.4555E+01,-.3175E+01,-.1977E+01, &
&-.7382E+00,0.5912E+00,0.2334E+01,0.4617E+01,0.7094E+01,0.9666E+01, &
&-.1094E+02,-.7078E+01,-.5382E+01,-.4132E+01,-.2755E+01,-.1568E+01, &
&-.3533E+00,0.9220E+00,0.2592E+01,0.4754E+01,0.7102E+01,0.9641E+01, &
&-.1048E+02,-.6629E+01,-.4948E+01,-.3712E+01,-.2330E+01,-.1149E+01, &
&0.3496E-01,0.1275E+01,0.2866E+01,0.4924E+01,0.7135E+01,0.9589E+01, &
&-.1002E+02,-.6183E+01,-.4512E+01,-.3288E+01,-.1907E+01,-.7307E+00, &
&0.4287E+00,0.1624E+01,0.3172E+01,0.5106E+01,0.7176E+01,0.9479E+01, &
&-.9558E+01,-.5743E+01,-.4084E+01,-.2869E+01,-.1483E+01,-.3089E+00, &
&0.8212E+00,0.1986E+01,0.3462E+01,0.5289E+01,0.7259E+01,0.9382E+01, &
&-.9098E+01,-.5309E+01,-.3658E+01,-.2454E+01,-.1062E+01,0.1055E+00, &
&0.1213E+01,0.2328E+01,0.3752E+01,0.5488E+01,0.7330E+01,0.9255E+01, &
&-.8641E+01,-.4890E+01,-.3242E+01,-.2047E+01,-.6454E+00,0.5097E+00, &
&0.1591E+01,0.2676E+01,0.4022E+01,0.5656E+01,0.7384E+01,0.9047E+01, &
&-.8181E+01,-.4477E+01,-.2827E+01,-.1641E+01,-.2362E+00,0.9046E+00, &
&0.1957E+01,0.3004E+01,0.4284E+01,0.5793E+01,0.7383E+01,0.8799E+01, &
&-.7728E+01,-.4082E+01,-.2422E+01,-.1241E+01,0.1437E+00,0.1289E+01, &
&0.2302E+01,0.3309E+01,0.4496E+01,0.5935E+01,0.7325E+01,0.8520E+01, &
&-.7281E+01,-.3706E+01,-.2027E+01,-.8608E+00,0.4995E+00,0.1652E+01, &
&0.2638E+01,0.3588E+01,0.4673E+01,0.6047E+01,0.7160E+01,0.8173E+01, &
&-.6853E+01,-.3338E+01,-.1666E+01,-.5031E+00,0.8245E+00,0.2002E+01, &
&0.2935E+01,0.3822E+01,0.4822E+01,0.6086E+01,0.7027E+01,0.7818E+01/
data ( ( coehh32_3_new(2,j,i), i = 1, 12 ), j = 1, 11 ) / &
&-.7679E-02,0.3238E-02,0.2987E-02,0.4249E-02,0.2901E-02,0.2167E-02, &
&0.2925E-02,0.4139E-02,0.4569E-02,0.4988E-02,0.2235E-02,-.2988E-02, &
&-.7672E-02,0.3240E-02,0.2947E-02,0.4053E-02,0.2792E-02,0.1865E-02, &
&0.2479E-02,0.3235E-02,0.3444E-02,0.3847E-02,0.2077E-02,-.2416E-02, &
&-.7657E-02,0.3285E-02,0.2898E-02,0.3815E-02,0.2685E-02,0.1547E-02, &
&0.1957E-02,0.2503E-02,0.2512E-02,0.2851E-02,0.1523E-02,-.2436E-02, &
&-.7653E-02,0.3272E-02,0.2828E-02,0.3586E-02,0.2559E-02,0.1270E-02, &
&0.1506E-02,0.1783E-02,0.1874E-02,0.1916E-02,0.6173E-03,-.2229E-02, &
&-.7644E-02,0.3255E-02,0.2799E-02,0.3353E-02,0.2412E-02,0.1022E-02, &
&0.1142E-02,0.1176E-02,0.1232E-02,0.7776E-03,0.5063E-03,-.1687E-02, &
&-.7629E-02,0.3208E-02,0.2691E-02,0.3142E-02,0.2284E-02,0.8112E-03, &
&0.8972E-03,0.8189E-03,0.1037E-02,0.2834E-03,0.2208E-03,-.1248E-02, &
&-.7609E-02,0.3139E-02,0.2643E-02,0.2867E-02,0.2195E-02,0.6214E-03, &
&0.6478E-03,0.4260E-03,0.6003E-03,0.1406E-03,-.3815E-03,-.1049E-02, &
&-.7565E-02,0.3033E-02,0.2552E-02,0.2605E-02,0.2090E-02,0.4360E-03, &
&0.4645E-03,0.1280E-03,0.1882E-03,-.1575E-03,-.2542E-03,-.1080E-02, &
&-.7502E-02,0.2877E-02,0.2437E-02,0.2260E-02,0.2037E-02,0.2618E-03, &
&0.2812E-03,0.3817E-05,-.6310E-04,-.4294E-03,-.3730E-03,-.9895E-03, &
&-.7360E-02,0.2690E-02,0.2325E-02,0.1874E-02,0.2181E-02,0.1173E-03, &
&0.1688E-03,-.1824E-03,-.2441E-03,-.4165E-03,-.5805E-03,-.1071E-02, &
&-.7419E-02,0.2390E-02,0.2052E-02,0.1433E-02,0.2322E-02,-.5471E-04, &
&-.8958E-04,-.4855E-03,-.4562E-03,-.2567E-03,-.5348E-03,-.1002E-02/
data ( ( coehh32_3_new(3,j,i), i = 1, 12 ), j = 1, 11 ) / &
&0.9895E-04,0.1450E-04,0.5622E-05,0.5376E-05,-.8133E-05,0.5208E-05, &
&0.7027E-05,0.4079E-05,0.6760E-05,0.6037E-05,-.2982E-04,0.1999E-04, &
&0.9861E-04,0.1400E-04,0.7647E-05,0.5797E-05,-.9515E-05,0.6399E-05, &
&0.4014E-05,0.4009E-05,0.5595E-05,0.8374E-05,-.2634E-04,0.3155E-05, &
&0.9873E-04,0.1548E-04,0.9527E-05,0.7551E-05,-.1049E-04,0.5886E-05, &
&0.2869E-05,0.1650E-05,0.2065E-05,0.3039E-05,-.1560E-04,0.1586E-05, &
&0.9865E-04,0.1597E-04,0.9778E-05,0.8495E-05,-.1036E-04,0.5484E-05, &
&0.1870E-05,0.3864E-05,-.4029E-05,0.6126E-05,0.3827E-06,0.6381E-05, &
&0.9837E-04,0.1728E-04,0.1055E-04,0.1035E-04,-.9879E-05,0.3760E-05, &
&0.1997E-05,0.7611E-06,-.2375E-05,0.5047E-05,0.4114E-05,0.5342E-05, &
&0.9825E-04,0.1851E-04,0.1077E-04,0.1276E-04,-.1006E-04,0.4149E-05, &
&0.7659E-07,0.4621E-05,-.5107E-05,-.8457E-07,-.5272E-05,-.9818E-05, &
&0.9775E-04,0.2145E-04,0.1051E-04,0.1497E-04,-.1139E-04,0.4828E-05, &
&0.6559E-07,0.1238E-05,-.3051E-06,0.1022E-05,-.7287E-05,-.1105E-05, &
&0.9753E-04,0.2363E-04,0.9890E-05,0.1762E-04,-.1153E-04,0.4872E-05, &
&0.6813E-06,0.1176E-05,-.1294E-05,0.5104E-05,-.3532E-05,0.1211E-05, &
&0.9744E-04,0.2527E-04,0.9979E-05,0.1488E-04,-.7563E-05,0.2296E-05, &
&0.1495E-05,0.3083E-05,-.1193E-05,-.2592E-05,-.2489E-05,-.1576E-05, &
&0.9857E-04,0.2671E-04,0.7247E-05,0.1459E-04,-.7584E-05,0.3192E-05, &
&0.9343E-06,0.2911E-05,0.6984E-06,-.3093E-05,0.7175E-05,0.1806E-05, &
&0.9841E-04,0.2755E-04,0.6758E-05,0.1372E-04,-.8803E-05,0.2412E-05, &
&0.2694E-05,0.2623E-05,0.1088E-05,-.2540E-05,0.2750E-05,0.5326E-05/
data ( ( coeh2o_3_new(1,j,i), i = 1, 12 ), j = 1, 11 ) / &
&-.1960E+02,-.1506E+02,-.1330E+02,-.1196E+02,-.1062E+02,-.9237E+01, &
&-.7918E+01,-.6564E+01,-.4814E+01,-.2530E+01,-.4914E-01,0.2527E+01, &
&-.1914E+02,-.1462E+02,-.1287E+02,-.1154E+02,-.1020E+02,-.8835E+01, &
&-.7538E+01,-.6234E+01,-.4559E+01,-.2391E+01,-.3750E-01,0.2503E+01, &
&-.1868E+02,-.1417E+02,-.1243E+02,-.1112E+02,-.9776E+01,-.8422E+01, &
&-.7149E+01,-.5884E+01,-.4283E+01,-.2223E+01,-.9588E-02,0.2436E+01, &
&-.1822E+02,-.1372E+02,-.1200E+02,-.1070E+02,-.9358E+01,-.8009E+01, &
&-.6756E+01,-.5535E+01,-.3976E+01,-.2055E+01,0.3032E-01,0.2334E+01, &
&-.1776E+02,-.1328E+02,-.1157E+02,-.1028E+02,-.8937E+01,-.7592E+01, &
&-.6369E+01,-.5176E+01,-.3687E+01,-.1860E+01,0.1086E+00,0.2239E+01, &
&-.1730E+02,-.1285E+02,-.1115E+02,-.9859E+01,-.8522E+01,-.7183E+01, &
&-.5983E+01,-.4832E+01,-.3403E+01,-.1658E+01,0.1877E+00,0.2117E+01, &
&-.1684E+02,-.1243E+02,-.1074E+02,-.9457E+01,-.8110E+01,-.6787E+01, &
&-.5607E+01,-.4489E+01,-.3131E+01,-.1493E+01,0.2193E+00,0.1909E+01, &
&-.1638E+02,-.1203E+02,-.1034E+02,-.9054E+01,-.7703E+01,-.6400E+01, &
&-.5251E+01,-.4168E+01,-.2872E+01,-.1353E+01,0.2209E+00,0.1654E+01, &
&-.1593E+02,-.1165E+02,-.9951E+01,-.8662E+01,-.7319E+01,-.6031E+01, &
&-.4908E+01,-.3864E+01,-.2661E+01,-.1215E+01,0.1747E+00,0.1373E+01, &
&-.1548E+02,-.1129E+02,-.9578E+01,-.8296E+01,-.6966E+01,-.5686E+01, &
&-.4591E+01,-.3591E+01,-.2486E+01,-.1100E+01,0.9648E-02,0.1023E+01, &
&-.1505E+02,-.1095E+02,-.9232E+01,-.7959E+01,-.6652E+01,-.5370E+01, &
&-.4311E+01,-.3366E+01,-.2341E+01,-.1065E+01,-.1163E+00,0.6636E+00/
data ( ( coeh2o_3_new(2,j,i), i = 1, 12 ), j = 1, 11 ) / &
&0.1080E-01,0.8671E-02,0.6771E-02,0.6413E-02,0.4659E-02,0.3332E-02, &
&0.3277E-02,0.4236E-02,0.4596E-02,0.4920E-02,0.2400E-02,-.2756E-02, &
&0.1081E-01,0.8741E-02,0.6754E-02,0.6296E-02,0.4472E-02,0.3015E-02, &
&0.2806E-02,0.3375E-02,0.3436E-02,0.3821E-02,0.2081E-02,-.2471E-02, &
&0.1081E-01,0.8808E-02,0.6738E-02,0.6140E-02,0.4280E-02,0.2661E-02, &
&0.2328E-02,0.2561E-02,0.2459E-02,0.2849E-02,0.1478E-02,-.2399E-02, &
&0.1082E-01,0.8903E-02,0.6681E-02,0.5968E-02,0.4090E-02,0.2404E-02, &
&0.1916E-02,0.1893E-02,0.1906E-02,0.1952E-02,0.5999E-03,-.2229E-02, &
&0.1083E-01,0.8941E-02,0.6605E-02,0.5787E-02,0.3912E-02,0.2213E-02, &
&0.1585E-02,0.1285E-02,0.1237E-02,0.7659E-03,0.4732E-03,-.1905E-02, &
&0.1084E-01,0.8980E-02,0.6585E-02,0.5613E-02,0.3766E-02,0.2044E-02, &
&0.1267E-02,0.9222E-03,0.1021E-02,0.2873E-03,0.1324E-03,-.1448E-02, &
&0.1086E-01,0.9037E-02,0.6487E-02,0.5388E-02,0.3604E-02,0.1876E-02, &
&0.1078E-02,0.6028E-03,0.6251E-03,0.1348E-03,-.4624E-03,-.1049E-02, &
&0.1090E-01,0.9083E-02,0.6433E-02,0.5211E-02,0.3471E-02,0.1746E-02, &
&0.9677E-03,0.3372E-03,0.2223E-03,-.1395E-03,-.1094E-03,-.1187E-02, &
&0.1099E-01,0.9106E-02,0.6376E-02,0.4992E-02,0.3354E-02,0.1630E-02, &
&0.7864E-03,0.2293E-03,0.3187E-04,-.3573E-03,-.3777E-03,-.1101E-02, &
&0.1134E-01,0.9243E-02,0.6320E-02,0.4852E-02,0.3349E-02,0.1655E-02, &
&0.7483E-03,0.2039E-04,-.1645E-03,-.4325E-03,-.5380E-03,-.1237E-02, &
&0.1151E-01,0.9333E-02,0.6267E-02,0.4616E-02,0.3376E-02,0.1607E-02, &
&0.6461E-03,-.2321E-03,-.3088E-03,-.2537E-03,-.5030E-03,-.1011E-02/
data ( ( coeh2o_3_new(3,j,i), i = 1, 12 ), j = 1, 11 ) / &
&-.2773E-04,-.3392E-04,-.2223E-04,-.1340E-04,-.6529E-05,-.1665E-06, &
&0.4989E-05,0.3707E-05,0.6941E-05,0.6886E-05,-.3258E-04,0.1605E-04, &
&-.2813E-04,-.3300E-04,-.2007E-04,-.1154E-04,-.7740E-05,0.6775E-06, &
&0.2897E-05,0.3420E-05,0.6556E-05,0.5507E-05,-.2749E-04,0.2148E-05, &
&-.2809E-04,-.3275E-04,-.1888E-04,-.1024E-04,-.7943E-05,-.3963E-06, &
&0.2122E-06,0.2035E-05,0.2235E-05,0.3933E-05,-.1529E-04,0.5763E-05, &
&-.2800E-04,-.3250E-04,-.1684E-04,-.9307E-05,-.8034E-05,-.1375E-05, &
&-.2132E-05,0.2970E-05,-.4042E-05,0.9740E-05,0.2458E-05,0.8648E-05, &
&-.2806E-04,-.3208E-04,-.1568E-04,-.9145E-05,-.8411E-05,-.3020E-05, &
&-.1413E-05,0.9127E-07,-.3237E-05,0.3945E-05,0.5646E-05,0.2986E-05, &
&-.2830E-04,-.3068E-04,-.1482E-04,-.8674E-05,-.8443E-05,-.3934E-05, &
&-.1612E-05,0.2413E-05,-.3550E-05,-.6469E-06,-.5963E-05,-.1346E-04, &
&-.2883E-04,-.3028E-04,-.1561E-04,-.6705E-05,-.1033E-04,-.3342E-05, &
&-.3678E-05,0.1166E-07,0.1137E-06,0.1105E-05,-.2647E-06,-.1105E-05, &
&-.2925E-04,-.2750E-04,-.1669E-04,-.5725E-05,-.1279E-04,-.3634E-05, &
&-.2847E-05,0.7495E-06,-.6587E-06,0.3086E-05,0.7682E-06,0.1455E-05, &
&-.2996E-04,-.2666E-04,-.1496E-04,-.7764E-05,-.1307E-04,-.5851E-05, &
&-.2315E-05,0.1180E-05,-.1360E-05,-.3718E-05,-.1349E-06,-.1873E-05, &
&-.2948E-04,-.2562E-04,-.1348E-04,-.7023E-05,-.1216E-04,-.7633E-05, &
&-.2033E-05,0.1950E-05,-.6272E-06,-.3702E-05,0.5905E-05,0.1447E-05, &
&-.2863E-04,-.2574E-04,-.1508E-04,-.7480E-05,-.1153E-04,-.7744E-05, &
&0.9411E-06,0.1926E-05,0.1190E-05,-.2848E-05,-.1600E-05,0.9887E-05/
! block data ckd4_new
!c *********************************************************************
!c hk is the interval in the g (cumulative probability) space from 0
!c to one. coeh2o is the coefficient to calculate the H2O absorption
!c coefficient in units of (cm-atm)**-1 at there temperatures, eleven
!c pressures, and seven cumulative probabilities ( Fu, 1991 ). The
!c spectral region is from 5250 to 4000 cm**-1.
!c in this block data, Z.F. has added the coefficients for CO2, CO, and
!c water vapor continuum absorption in Jun,2003.
!c *********************************************************************
! common /band4_new/hk(20),coehh42(3,11,20),coeco2(3,11,20),coeco(3,11) &
! ,coeh2o(3,11,20)
real hk_4_new(20),coehh42_4_new(3,11,20),coeco2_4_new(3,11,20), &
& coeco_4_new(3,11),coeh2o_4_new(3,11,20)
data hk_4_new /8.13791E-02,0.171362,0.222259,0.222259,0.171362, &
& 8.13791E-02,8.77986E-04,2.00395E-03,3.03796E-03, &
& 3.93008E-03,4.63846E-03,5.12996E-03,5.38160E-03, &
& 5.38160E-03,5.12996E-03,4.63846E-03,3.93008E-03, &
& 3.03796E-03,2.00395E-03,8.77986E-04/
data ( ( coehh42_4_new(1,j,i), i = 1, 20 ), j = 1, 11 ) / &
&-.1059E+02,-.1006E+02,-.9085E+01,-.6921E+01,-.4346E+01,-.2053E+01, &
&-.9700E+00,-.9080E+00,-.7921E+00,-.6280E+00,-.4134E+00,-.1395E+00, &
&0.2112E+00,0.6492E+00,0.1147E+01,0.1906E+01,0.2740E+01,0.4002E+01, &
&0.5611E+01,0.8101E+01,-.1013E+02,-.9606E+01,-.8628E+01,-.6482E+01, &
&-.3962E+01,-.1702E+01,-.6681E+00,-.6004E+00,-.4818E+00,-.3260E+00, &
&-.1152E+00,0.1656E+00,0.5207E+00,0.9282E+00,0.1430E+01,0.2159E+01, &
&0.3014E+01,0.4178E+01,0.5686E+01,0.8104E+01,-.9666E+01,-.9143E+01, &
&-.8166E+01,-.6042E+01,-.3563E+01,-.1337E+01,-.3297E+00,-.2723E+00, &
&-.1627E+00,-.2127E-02,0.2080E+00,0.5053E+00,0.8329E+00,0.1248E+01, &
&0.1737E+01,0.2409E+01,0.3242E+01,0.4307E+01,0.5759E+01,0.8158E+01, &
&-.9206E+01,-.8682E+01,-.7706E+01,-.5605E+01,-.3170E+01,-.9765E+00, &
&0.1098E-01,0.6984E-01,0.1728E+00,0.3387E+00,0.5600E+00,0.8342E+00, &
&0.1168E+01,0.1573E+01,0.2072E+01,0.2687E+01,0.3461E+01,0.4470E+01, &
&0.5823E+01,0.8122E+01,-.8745E+01,-.8222E+01,-.7248E+01,-.5174E+01, &
&-.2782E+01,-.6221E+00,0.3791E+00,0.4282E+00,0.5328E+00,0.6929E+00, &
&0.9055E+00,0.1170E+01,0.1504E+01,0.1920E+01,0.2403E+01,0.2953E+01, &
&0.3729E+01,0.4647E+01,0.5941E+01,0.8096E+01,-.8285E+01,-.7761E+01, &
&-.6793E+01,-.4753E+01,-.2395E+01,-.2536E+00,0.7605E+00,0.8090E+00, &
&0.8938E+00,0.1037E+01,0.1244E+01,0.1517E+01,0.1851E+01,0.2249E+01, &
&0.2719E+01,0.3207E+01,0.3958E+01,0.4861E+01,0.6126E+01,0.7980E+01, &
&-.7826E+01,-.7305E+01,-.6349E+01,-.4348E+01,-.2028E+01,0.1151E+00, &
&0.1104E+01,0.1158E+01,0.1256E+01,0.1394E+01,0.1591E+01,0.1872E+01, &
&0.2188E+01,0.2554E+01,0.2989E+01,0.3500E+01,0.4182E+01,0.5051E+01, &
&0.6259E+01,0.7866E+01,-.7365E+01,-.6844E+01,-.5906E+01,-.3946E+01, &
&-.1673E+01,0.4781E+00,0.1462E+01,0.1516E+01,0.1610E+01,0.1743E+01, &
&0.1925E+01,0.2178E+01,0.2482E+01,0.2837E+01,0.3242E+01,0.3751E+01, &
&0.4390E+01,0.5180E+01,0.6277E+01,0.7674E+01,-.6905E+01,-.6387E+01, &
&-.5476E+01,-.3556E+01,-.1344E+01,0.8318E+00,0.1780E+01,0.1837E+01, &
&0.1933E+01,0.2066E+01,0.2228E+01,0.2448E+01,0.2739E+01,0.3084E+01, &
&0.3495E+01,0.4001E+01,0.4558E+01,0.5315E+01,0.6291E+01,0.7482E+01, &
&-.6446E+01,-.5933E+01,-.5061E+01,-.3187E+01,-.1022E+01,0.1175E+01, &
&0.2044E+01,0.2096E+01,0.2201E+01,0.2341E+01,0.2497E+01,0.2705E+01, &
&0.2967E+01,0.3307E+01,0.3735E+01,0.4209E+01,0.4730E+01,0.5379E+01, &
&0.6225E+01,0.7265E+01,-.5998E+01,-.5485E+01,-.4650E+01,-.2856E+01, &
&-.7081E+00,0.1480E+01,0.2292E+01,0.2343E+01,0.2434E+01,0.2565E+01, &
&0.2745E+01,0.2947E+01,0.3206E+01,0.3521E+01,0.3911E+01,0.4372E+01, &
&0.4866E+01,0.5390E+01,0.6151E+01,0.6998E+01/
data ( ( coehh42_4_new(2,j,i), i = 1, 20 ), j = 1, 11 ) / &
&-.1686E-01,-.1495E-01,-.6958E-02,0.1929E-02,0.6756E-02,0.6773E-02, &
&0.7527E-02,0.7564E-02,0.7523E-02,0.7354E-02,0.7233E-02,0.7332E-02, &
&0.7428E-02,0.7961E-02,0.8650E-02,0.8533E-02,0.9158E-02,0.8485E-02, &
&0.9356E-02,0.7225E-02,-.1686E-01,-.1497E-01,-.6942E-02,0.1907E-02, &
&0.6514E-02,0.6267E-02,0.6897E-02,0.6977E-02,0.7040E-02,0.6954E-02, &
&0.6723E-02,0.6728E-02,0.7165E-02,0.7471E-02,0.7648E-02,0.7649E-02, &
&0.8113E-02,0.6896E-02,0.8976E-02,0.6126E-02,-.1686E-01,-.1495E-01, &
&-.6923E-02,0.1859E-02,0.6233E-02,0.5923E-02,0.6185E-02,0.6298E-02, &
&0.6495E-02,0.6609E-02,0.6545E-02,0.6524E-02,0.6819E-02,0.6764E-02, &
&0.6654E-02,0.7157E-02,0.7238E-02,0.5959E-02,0.7561E-02,0.4312E-02, &
&-.1686E-01,-.1494E-01,-.6895E-02,0.1817E-02,0.5942E-02,0.5493E-02, &
&0.6054E-02,0.6100E-02,0.6215E-02,0.6398E-02,0.6618E-02,0.6199E-02, &
&0.6455E-02,0.6214E-02,0.5865E-02,0.6472E-02,0.6639E-02,0.5397E-02, &
&0.6081E-02,0.5363E-02,-.1686E-01,-.1493E-01,-.6888E-02,0.1785E-02, &
&0.5641E-02,0.5328E-02,0.5932E-02,0.5924E-02,0.5913E-02,0.6076E-02, &
&0.6245E-02,0.6044E-02,0.5884E-02,0.5806E-02,0.5469E-02,0.5944E-02, &
&0.5384E-02,0.4482E-02,0.4742E-02,0.4400E-02,-.1686E-01,-.1492E-01, &
&-.6890E-02,0.1669E-02,0.5318E-02,0.5178E-02,0.5663E-02,0.5657E-02, &
&0.5620E-02,0.5650E-02,0.5925E-02,0.5845E-02,0.5468E-02,0.5578E-02, &
&0.5364E-02,0.5421E-02,0.4804E-02,0.4654E-02,0.5170E-02,0.4096E-02, &
&-.1685E-01,-.1492E-01,-.6926E-02,0.1572E-02,0.5116E-02,0.5131E-02, &
&0.5408E-02,0.5409E-02,0.5461E-02,0.5484E-02,0.5455E-02,0.5428E-02, &
&0.5391E-02,0.5258E-02,0.4741E-02,0.4750E-02,0.4390E-02,0.4749E-02, &
&0.4977E-02,0.3296E-02,-.1685E-01,-.1489E-01,-.6974E-02,0.1415E-02, &
&0.4745E-02,0.5066E-02,0.5375E-02,0.5369E-02,0.5248E-02,0.5174E-02, &
&0.5074E-02,0.5260E-02,0.5230E-02,0.4768E-02,0.4736E-02,0.4192E-02, &
&0.4103E-02,0.4969E-02,0.4945E-02,0.4193E-02,-.1684E-01,-.1485E-01, &
&-.7176E-02,0.1146E-02,0.4580E-02,0.4956E-02,0.5185E-02,0.5109E-02, &
&0.5084E-02,0.4812E-02,0.4606E-02,0.4576E-02,0.4754E-02,0.4523E-02, &
&0.4452E-02,0.3939E-02,0.4254E-02,0.4827E-02,0.4612E-02,0.3346E-02, &
&-.1676E-01,-.1484E-01,-.7457E-02,0.9431E-03,0.4583E-02,0.4910E-02, &
&0.4708E-02,0.4745E-02,0.4669E-02,0.4511E-02,0.4329E-02,0.4111E-02, &
&0.4380E-02,0.4498E-02,0.4055E-02,0.4142E-02,0.4058E-02,0.4817E-02, &
&0.4007E-02,0.4288E-02,-.1667E-01,-.1487E-01,-.7891E-02,0.5511E-03, &
&0.4589E-02,0.4397E-02,0.3882E-02,0.3931E-02,0.4068E-02,0.4260E-02, &
&0.4260E-02,0.3976E-02,0.3757E-02,0.3894E-02,0.4240E-02,0.4461E-02, &
&0.4182E-02,0.4058E-02,0.3568E-02,0.3295E-02/
data ( ( coehh42_4_new(3,j,i), i = 1, 20 ), j = 1, 11 ) / &
&0.8719E-05,0.3152E-04,0.9387E-04,0.2700E-04,0.5308E-05,-.7286E-05, &
&-.9901E-05,-.1065E-04,-.1214E-04,-.1259E-04,-.6202E-05,-.3291E-05, &
&-.8684E-05,-.7201E-05,0.8522E-05,-.1956E-04,0.4919E-05,-.2685E-04, &
&-.2245E-04,-.4342E-04,0.8040E-05,0.3134E-04,0.9385E-04,0.2804E-04, &
&0.9804E-05,-.6042E-05,0.2345E-05,-.7401E-06,-.5213E-05,-.4646E-05, &
&-.4379E-05,-.6253E-05,-.1368E-04,-.8247E-05,0.1722E-05,-.2231E-04, &
&-.1394E-04,-.2746E-04,-.3332E-04,-.3498E-04,0.8456E-05,0.3128E-04, &
&0.9340E-04,0.2996E-04,0.8999E-05,-.5482E-05,0.3744E-05,0.3982E-05, &
&0.1368E-05,-.1608E-05,-.3430E-05,-.1283E-04,-.1160E-04,-.1210E-04, &
&-.1016E-06,-.1830E-04,-.9311E-05,-.2056E-04,-.2352E-04,-.2314E-04, &
&0.8600E-05,0.3118E-04,0.9319E-04,0.3020E-04,0.1066E-04,-.5770E-05, &
&0.2359E-05,0.2942E-05,0.3937E-05,-.2328E-05,-.7884E-05,-.1238E-04, &
&-.8395E-05,-.1025E-04,-.1413E-04,-.1782E-04,-.2784E-05,-.1649E-04, &
&-.7734E-05,-.2976E-04,0.8741E-05,0.3111E-04,0.9298E-04,0.3115E-04, &
&0.1174E-04,-.1947E-05,-.5477E-05,-.6249E-06,0.1779E-05,-.1587E-05, &
&-.6940E-05,-.7399E-05,-.6058E-05,-.1735E-04,-.2104E-04,-.7474E-05, &
&-.1182E-04,-.6828E-05,-.4701E-06,-.4709E-04,0.8759E-05,0.3085E-04, &
&0.9296E-04,0.3282E-04,0.1019E-04,-.3588E-05,-.1257E-04,-.9429E-05, &
&-.2057E-05,0.7564E-06,-.2274E-05,-.8163E-05,-.1011E-04,-.1911E-04, &
&-.2398E-04,0.7761E-05,-.1771E-04,-.2819E-04,-.2294E-04,-.2335E-04, &
&0.8000E-05,0.3064E-04,0.9416E-04,0.3569E-04,0.1276E-04,-.4103E-05, &
&-.1243E-04,-.1056E-04,-.7823E-05,-.2462E-05,-.1494E-05,-.1442E-04, &
&-.1914E-04,-.1664E-04,-.1548E-04,-.6351E-05,-.2185E-04,-.2480E-04, &
&-.3726E-04,-.2906E-04,0.8548E-05,0.3012E-04,0.9494E-04,0.3683E-04, &
&0.1404E-04,-.3293E-05,-.1665E-04,-.1670E-04,-.1434E-04,-.9419E-05, &
&-.6369E-05,-.1321E-04,-.1427E-04,-.1231E-04,-.6201E-05,-.9664E-05, &
&-.2175E-04,-.1135E-04,-.3686E-04,-.2543E-04,0.8691E-05,0.2988E-04, &
&0.9581E-04,0.3853E-04,0.1653E-04,-.3232E-05,-.1481E-04,-.1755E-04, &
&-.1914E-04,-.1633E-04,-.7166E-05,-.5494E-05,-.1207E-04,-.9202E-05, &
&-.1221E-04,-.2493E-04,-.1622E-04,-.1623E-04,-.2624E-04,-.2272E-04, &
&0.1032E-04,0.2902E-04,0.9786E-04,0.4246E-04,0.2006E-04,-.7937E-05, &
&-.1656E-05,-.4060E-05,-.1023E-04,-.1558E-04,-.8886E-05,-.6339E-05, &
&-.6686E-05,-.1247E-04,-.2124E-04,-.2543E-04,-.1466E-04,-.1779E-04, &
&-.1139E-04,-.1877E-04,0.1439E-04,0.2795E-04,0.9614E-04,0.4879E-04, &
&0.2421E-04,-.4735E-05,0.2733E-05,0.8715E-06,-.2560E-05,-.8553E-05, &
&-.1460E-04,-.1124E-04,-.1194E-04,-.1263E-04,-.9623E-05,-.1722E-04, &
&-.2157E-04,-.1558E-04,-.1516E-04,-.1386E-04/
data ( ( coeco2_4_new(1,j,i), i = 1, 20 ), j = 1, 11 ) / &
&-.4603E+02,-.4594E+02,-.2412E+02,-.1620E+02,-.1177E+02,-.9585E+01, &
&-.8622E+01,-.8562E+01,-.8456E+01,-.8309E+01,-.8107E+01,-.7852E+01, &
&-.7537E+01,-.7141E+01,-.6645E+01,-.5994E+01,-.5163E+01,-.4117E+01, &
&-.2456E+01,-.3656E+00,-.4603E+02,-.4594E+02,-.2366E+02,-.1574E+02, &
&-.1138E+02,-.9217E+01,-.8297E+01,-.8243E+01,-.8148E+01,-.8011E+01, &
&-.7826E+01,-.7537E+01,-.7217E+01,-.6864E+01,-.6334E+01,-.5711E+01, &
&-.4914E+01,-.3989E+01,-.2392E+01,-.3673E+00,-.4603E+02,-.4594E+02, &
&-.2320E+02,-.1528E+02,-.1099E+02,-.8825E+01,-.7972E+01,-.7919E+01, &
&-.7826E+01,-.7678E+01,-.7475E+01,-.7208E+01,-.6897E+01,-.6536E+01, &
&-.6027E+01,-.5422E+01,-.4695E+01,-.3791E+01,-.2191E+01,-.4829E+00, &
&-.4603E+02,-.4594E+02,-.2274E+02,-.1483E+02,-.1060E+02,-.8450E+01, &
&-.7620E+01,-.7570E+01,-.7472E+01,-.7334E+01,-.7150E+01,-.6892E+01, &
&-.6558E+01,-.6202E+01,-.5732E+01,-.5138E+01,-.4473E+01,-.3516E+01, &
&-.1970E+01,-.4839E+00,-.4603E+02,-.4594E+02,-.2228E+02,-.1438E+02, &
&-.1022E+02,-.8088E+01,-.7258E+01,-.7212E+01,-.7130E+01,-.6990E+01, &
&-.6798E+01,-.6544E+01,-.6229E+01,-.5865E+01,-.5438E+01,-.4882E+01, &
&-.4236E+01,-.3257E+01,-.1876E+01,-.4746E+00,-.4603E+02,-.4594E+02, &
&-.2182E+02,-.1396E+02,-.9852E+01,-.7715E+01,-.6899E+01,-.6850E+01, &
&-.6763E+01,-.6634E+01,-.6450E+01,-.6213E+01,-.5906E+01,-.5557E+01, &
&-.5172E+01,-.4648E+01,-.3944E+01,-.2971E+01,-.1842E+01,-.5561E+00, &
&-.4603E+02,-.4594E+02,-.2136E+02,-.1357E+02,-.9510E+01,-.7355E+01, &
&-.6550E+01,-.6505E+01,-.6422E+01,-.6301E+01,-.6129E+01,-.5896E+01, &
&-.5626E+01,-.5297E+01,-.4907E+01,-.4358E+01,-.3663E+01,-.2761E+01, &
&-.1908E+01,-.7289E+00,-.4603E+02,-.4594E+02,-.2090E+02,-.1323E+02, &
&-.9201E+01,-.6995E+01,-.6227E+01,-.6182E+01,-.6099E+01,-.5985E+01, &
&-.5826E+01,-.5616E+01,-.5355E+01,-.5017E+01,-.4620E+01,-.4072E+01, &
&-.3446E+01,-.2716E+01,-.2018E+01,-.9620E+00,-.4603E+02,-.4594E+02, &
&-.2044E+02,-.1297E+02,-.8905E+01,-.6661E+01,-.5914E+01,-.5872E+01, &
&-.5798E+01,-.5682E+01,-.5530E+01,-.5318E+01,-.5071E+01,-.4743E+01, &
&-.4329E+01,-.3853E+01,-.3294E+01,-.2761E+01,-.2106E+01,-.1277E+01, &
&-.4603E+02,-.4594E+02,-.1964E+02,-.1276E+02,-.8637E+01,-.6354E+01, &
&-.5583E+01,-.5545E+01,-.5474E+01,-.5373E+01,-.5234E+01,-.5044E+01, &
&-.4793E+01,-.4491E+01,-.4132E+01,-.3730E+01,-.3306E+01,-.2872E+01, &
&-.2235E+01,-.1592E+01,-.4603E+02,-.4593E+02,-.1896E+02,-.1262E+02, &
&-.8408E+01,-.6026E+01,-.5278E+01,-.5241E+01,-.5175E+01,-.5085E+01, &
&-.4950E+01,-.4782E+01,-.4573E+01,-.4327E+01,-.4035E+01,-.3728E+01, &
&-.3405E+01,-.3006E+01,-.2431E+01,-.2000E+01/
data ( ( coeco2_4_new(2,j,i), i = 1, 20 ), j = 1, 11 ) / &
&-.4786E-05,-.2403E-04,0.2072E-01,0.9662E-02,0.8712E-02,0.5356E-02, &
&0.5389E-02,0.5435E-02,0.5612E-02,0.5805E-02,0.6110E-02,0.6088E-02, &
&0.5988E-02,0.5956E-02,0.5210E-02,0.5759E-02,0.6807E-02,0.6879E-02, &
&0.4498E-02,0.8106E-03,-.4786E-05,-.2403E-04,0.2075E-01,0.9764E-02, &
&0.8516E-02,0.4715E-02,0.4838E-02,0.4893E-02,0.4981E-02,0.5072E-02, &
&0.5072E-02,0.5026E-02,0.5005E-02,0.4854E-02,0.4801E-02,0.4993E-02, &
&0.5714E-02,0.5394E-02,0.2506E-02,0.5935E-03,-.4786E-05,-.2403E-04, &
&0.2072E-01,0.9849E-02,0.8397E-02,0.4084E-02,0.4279E-02,0.4267E-02, &
&0.4226E-02,0.4131E-02,0.4163E-02,0.4449E-02,0.3956E-02,0.4184E-02, &
&0.4426E-02,0.4227E-02,0.4501E-02,0.3655E-02,0.6654E-03,0.2776E-03, &
&-.4786E-05,-.2403E-04,0.2072E-01,0.9987E-02,0.8372E-02,0.3617E-02, &
&0.3670E-02,0.3694E-02,0.3735E-02,0.3613E-02,0.3498E-02,0.3302E-02, &
&0.3386E-02,0.3718E-02,0.3896E-02,0.3861E-02,0.3237E-02,0.1668E-02, &
&0.2576E-03,0.3221E-03,-.4786E-05,-.2403E-04,0.2072E-01,0.1016E-01, &
&0.8369E-02,0.3237E-02,0.3168E-02,0.3134E-02,0.3018E-02,0.2996E-02, &
&0.2910E-02,0.3054E-02,0.3244E-02,0.3424E-02,0.3511E-02,0.3221E-02, &
&0.2240E-02,0.9645E-03,-.3647E-03,-.1492E-04,-.4786E-05,-.2403E-04, &
&0.2072E-01,0.1054E-01,0.8352E-02,0.2944E-02,0.2692E-02,0.2719E-02, &
&0.2786E-02,0.2721E-02,0.2762E-02,0.2862E-02,0.3180E-02,0.2981E-02, &
&0.2720E-02,0.1900E-02,0.8285E-03,-.1636E-03,-.4815E-03,0.2303E-03, &
&-.4786E-05,-.2403E-04,0.2075E-01,0.1081E-01,0.8350E-02,0.2716E-02, &
&0.2437E-02,0.2431E-02,0.2421E-02,0.2520E-02,0.2662E-02,0.2547E-02, &
&0.2587E-02,0.2341E-02,0.1632E-02,0.8147E-03,0.3410E-03,-.1676E-03, &
&-.1672E-03,0.9590E-03,-.4786E-05,-.2403E-04,0.2072E-01,0.1079E-01, &
&0.8543E-02,0.2851E-02,0.1950E-02,0.1962E-02,0.1952E-02,0.1953E-02, &
&0.1993E-02,0.2013E-02,0.1666E-02,0.1273E-02,0.7388E-03,-.1403E-03, &
&-.2617E-03,0.2904E-03,-.7046E-04,0.8429E-03,-.4786E-05,-.2403E-04, &
&0.2075E-01,0.1103E-01,0.8771E-02,0.2490E-02,0.1106E-02,0.1033E-02, &
&0.1039E-02,0.1066E-02,0.1137E-02,0.9681E-03,0.7354E-03,0.3735E-03, &
&-.1874E-03,-.3749E-03,-.3094E-04,0.4770E-03,0.2057E-03,0.6687E-03, &
&-.8358E-05,-.4182E-04,0.2145E-01,0.1057E-01,0.9132E-02,0.1834E-02, &
&0.3321E-03,0.3135E-03,0.2645E-03,0.1934E-03,0.2430E-03,0.2651E-03, &
&0.5755E-04,-.2891E-03,-.2060E-03,0.1168E-04,0.1601E-03,0.4466E-03, &
&0.4693E-03,0.1182E-02,-.5583E-05,-.2819E-04,0.2180E-01,0.1038E-01, &
&0.9786E-02,0.1269E-02,-.5402E-04,-.1102E-03,-.2084E-03,-.3490E-03, &
&-.3241E-03,-.3170E-03,-.2767E-03,-.1929E-03,0.8256E-04,0.2632E-03, &
&0.3831E-03,0.7473E-04,0.8686E-03,0.1146E-02/
data ( ( coeco2_4_new(3,j,i), i = 1, 20 ), j = 1, 11 ) / &
&0.1765E-07,0.9143E-07,-.1846E-03,0.8856E-05,-.3172E-04,0.1577E-04, &
&0.5529E-05,0.4630E-05,0.4415E-05,0.1105E-04,0.1481E-04,0.1697E-04, &
&0.2186E-04,0.2224E-04,0.1929E-04,0.1939E-04,0.8547E-05,-.3805E-05, &
&-.2759E-04,0.4665E-05,0.1765E-07,0.9143E-07,-.1851E-03,0.7178E-05, &
&-.2857E-04,0.1569E-04,0.1230E-04,0.1373E-04,0.1592E-04,0.2054E-04, &
&0.2810E-04,0.1609E-04,0.1396E-04,0.1831E-04,0.1049E-04,0.8116E-05, &
&-.8963E-05,0.2490E-04,0.1198E-04,-.1697E-05,0.1765E-07,0.9143E-07, &
&-.1846E-03,0.6871E-05,-.2871E-04,0.8531E-05,0.2124E-04,0.2059E-04, &
&0.2299E-04,0.2221E-04,0.2082E-04,0.1278E-04,0.6971E-05,0.1295E-04, &
&0.6508E-05,0.4034E-05,0.2943E-05,0.2663E-04,0.4140E-05,0.9827E-05, &
&0.1765E-07,0.9143E-07,-.1846E-03,0.5894E-05,-.2687E-04,0.8905E-05, &
&0.2267E-04,0.2275E-04,0.1966E-04,0.2027E-04,0.2032E-04,0.9168E-05, &
&0.2746E-05,0.6496E-05,0.6572E-05,0.2861E-05,0.1795E-04,0.2862E-04, &
&-.1103E-04,0.9369E-05,0.1765E-07,0.9143E-07,-.1846E-03,0.4515E-05, &
&-.2626E-04,0.1275E-04,0.1577E-04,0.1667E-04,0.1871E-04,0.1644E-04, &
&0.1360E-04,0.6632E-05,0.4221E-06,-.2254E-05,0.7433E-05,0.1725E-04, &
&0.1834E-04,0.2148E-04,-.2537E-05,0.9251E-05,0.1765E-07,0.9143E-07, &
&-.1846E-03,0.3060E-05,-.2709E-04,0.1159E-04,0.1195E-04,0.1081E-04, &
&0.1058E-04,0.1026E-04,0.8609E-05,0.4794E-05,-.9331E-06,0.3166E-05, &
&0.1340E-04,0.2067E-04,0.1223E-04,0.1459E-05,0.4914E-05,-.2115E-05, &
&0.1765E-07,0.9143E-07,-.1851E-03,0.5947E-05,-.2452E-04,0.7255E-05, &
&0.7111E-05,0.7851E-05,0.8384E-05,0.9930E-05,0.9285E-05,0.5097E-05, &
&0.6752E-05,0.1298E-04,0.1399E-04,0.1913E-04,0.5781E-05,-.1565E-05, &
&-.2180E-05,0.5621E-05,0.1765E-07,0.9143E-07,-.1846E-03,-.6184E-06, &
&-.1702E-04,0.1730E-05,0.1379E-04,0.1288E-04,0.1210E-04,0.1426E-04, &
&0.1402E-04,0.1163E-04,0.1156E-04,0.1250E-04,0.1988E-04,0.5954E-05, &
&0.7024E-05,0.3524E-05,0.6520E-05,0.9981E-06,0.1765E-07,0.9143E-07, &
&-.1851E-03,-.3396E-05,-.1723E-04,0.6361E-05,0.1388E-04,0.1304E-04, &
&0.1399E-04,0.1344E-04,0.1278E-04,0.1051E-04,0.1462E-04,0.1480E-04, &
&0.3949E-05,0.8595E-06,-.6487E-05,0.2725E-05,-.9187E-05,0.9898E-06, &
&0.3216E-07,0.1677E-06,-.1570E-03,-.4189E-05,-.2111E-04,0.1012E-04, &
&0.9510E-05,0.1072E-04,0.1242E-04,0.1382E-04,0.1744E-04,0.1622E-04, &
&0.9391E-05,0.5166E-05,0.1522E-05,0.3378E-06,-.1901E-06,-.7943E-06, &
&-.1324E-05,-.8822E-05,-.6747E-07,-.3373E-06,-.1785E-03,-.7169E-05, &
&-.2373E-04,0.5172E-05,0.5896E-05,0.6778E-05,0.8321E-05,0.1054E-04, &
&0.9381E-05,0.7614E-05,0.5371E-05,0.5089E-05,0.2464E-05,0.1010E-05, &
&0.9660E-06,0.1519E-05,0.3679E-05,-.7842E-05/
data ( ( coeco_4_new(k,j), j = 1, 11 ), k=1, 3) / &
&-.4589E+02,-.4589E+02,-.4589E+02,-.4589E+02,-.4589E+02,-.4589E+02, &
&-.4589E+02,-.4589E+02,-.4589E+02,-.4589E+02,-.4589E+02,-.5549E-06, &
&-.1040E-05,-.1040E-05,-.1283E-05,-.1491E-05,-.1491E-05,-.1769E-05, &
&-.1838E-05,-.1838E-05,-.3190E-05,0.4161E-06,-.2396E-07,-.1513E-07, &
&-.1513E-07,-.1072E-07,-.6936E-08,-.6936E-08,-.1892E-08,-.6305E-09, &
&-.6305E-09,0.6305E-08,-.7566E-08/
data ( ( coeh2o_4_new(1,j,i), i = 1, 20 ), j = 1, 11 ) / &
&-.2300E+02,-.1911E+02,-.1696E+02,-.1450E+02,-.1169E+02,-.9251E+01, &
&-.8138E+01,-.8075E+01,-.7958E+01,-.7791E+01,-.7572E+01,-.7300E+01, &
&-.6947E+01,-.6497E+01,-.6001E+01,-.5246E+01,-.4412E+01,-.3153E+01, &
&-.1527E+01,0.9630E+00,-.2254E+02,-.1865E+02,-.1651E+02,-.1406E+02, &
&-.1130E+02,-.8910E+01,-.7842E+01,-.7776E+01,-.7658E+01,-.7494E+01, &
&-.7276E+01,-.6996E+01,-.6636E+01,-.6224E+01,-.5726E+01,-.4992E+01, &
&-.4137E+01,-.2962E+01,-.1452E+01,0.9661E+00,-.2208E+02,-.1819E+02, &
&-.1604E+02,-.1362E+02,-.1091E+02,-.8556E+01,-.7509E+01,-.7448E+01, &
&-.7339E+01,-.7178E+01,-.6957E+01,-.6653E+01,-.6324E+01,-.5907E+01, &
&-.5410E+01,-.4741E+01,-.3912E+01,-.2840E+01,-.1379E+01,0.1020E+01, &
&-.2162E+02,-.1773E+02,-.1559E+02,-.1318E+02,-.1052E+02,-.8197E+01, &
&-.7172E+01,-.7118E+01,-.7004E+01,-.6836E+01,-.6610E+01,-.6327E+01, &
&-.5991E+01,-.5585E+01,-.5072E+01,-.4460E+01,-.3690E+01,-.2684E+01, &
&-.1315E+01,0.9195E+00,-.2115E+02,-.1727E+02,-.1513E+02,-.1276E+02, &
&-.1013E+02,-.7855E+01,-.6806E+01,-.6753E+01,-.6653E+01,-.6479E+01, &
&-.6268E+01,-.5993E+01,-.5651E+01,-.5234E+01,-.4751E+01,-.4200E+01, &
&-.3413E+01,-.2512E+01,-.1197E+01,0.9174E+00,-.2069E+02,-.1681E+02, &
&-.1468E+02,-.1234E+02,-.9755E+01,-.7502E+01,-.6437E+01,-.6384E+01, &
&-.6291E+01,-.6147E+01,-.5935E+01,-.5654E+01,-.5301E+01,-.4909E+01, &
&-.4434E+01,-.3939E+01,-.3183E+01,-.2278E+01,-.1012E+01,0.8419E+00, &
&-.2024E+02,-.1635E+02,-.1423E+02,-.1194E+02,-.9396E+01,-.7147E+01, &
&-.6092E+01,-.6039E+01,-.5942E+01,-.5795E+01,-.5585E+01,-.5315E+01, &
&-.4972E+01,-.4600E+01,-.4160E+01,-.3663E+01,-.2965E+01,-.2087E+01, &
&-.8820E+00,0.7279E+00,-.1977E+02,-.1589E+02,-.1381E+02,-.1155E+02, &
&-.9056E+01,-.6792E+01,-.5738E+01,-.5685E+01,-.5591E+01,-.5453E+01, &
&-.5267E+01,-.5001E+01,-.4691E+01,-.4326E+01,-.3921E+01,-.3404E+01, &
&-.2762E+01,-.1963E+01,-.8706E+00,0.5360E+00,-.1931E+02,-.1544E+02, &
&-.1341E+02,-.1118E+02,-.8753E+01,-.6453E+01,-.5432E+01,-.5371E+01, &
&-.5269E+01,-.5139E+01,-.4968E+01,-.4738E+01,-.4444E+01,-.4084E+01, &
&-.3677E+01,-.3155E+01,-.2593E+01,-.1848E+01,-.8530E+00,0.3441E+00, &
&-.1882E+02,-.1501E+02,-.1302E+02,-.1084E+02,-.8449E+01,-.6144E+01, &
&-.5173E+01,-.5114E+01,-.5012E+01,-.4870E+01,-.4708E+01,-.4498E+01, &
&-.4214E+01,-.3866E+01,-.3415E+01,-.2952E+01,-.2423E+01,-.1771E+01, &
&-.9135E+00,0.1144E+00,-.1832E+02,-.1460E+02,-.1267E+02,-.1053E+02, &
&-.8169E+01,-.5877E+01,-.4949E+01,-.4899E+01,-.4806E+01,-.4656E+01, &
&-.4471E+01,-.4258E+01,-.3995E+01,-.3665E+01,-.3251E+01,-.2786E+01, &
&-.2295E+01,-.1770E+01,-.1006E+01,-.1656E+00/
data ( ( coeh2o_4_new(2,j,i), i = 1, 20 ), j = 1, 11 ) / &
&0.9281E-02,0.7063E-02,0.6968E-02,0.8328E-02,0.9339E-02,0.7776E-02, &
&0.7936E-02,0.7936E-02,0.7875E-02,0.7744E-02,0.7441E-02,0.7480E-02, &
&0.7449E-02,0.8004E-02,0.8682E-02,0.8472E-02,0.9103E-02,0.8632E-02, &
&0.9273E-02,0.7225E-02,0.9289E-02,0.7079E-02,0.6967E-02,0.8315E-02, &
&0.9148E-02,0.7388E-02,0.7432E-02,0.7410E-02,0.7403E-02,0.7244E-02, &
&0.6958E-02,0.6883E-02,0.7329E-02,0.7612E-02,0.7700E-02,0.7688E-02, &
&0.7969E-02,0.6924E-02,0.9211E-02,0.6126E-02,0.9289E-02,0.7071E-02, &
&0.7001E-02,0.8291E-02,0.8952E-02,0.7112E-02,0.6841E-02,0.6893E-02, &
&0.6894E-02,0.6947E-02,0.6865E-02,0.6753E-02,0.6912E-02,0.6820E-02, &
&0.6682E-02,0.7168E-02,0.7151E-02,0.6037E-02,0.7499E-02,0.4312E-02, &
&0.9283E-02,0.7071E-02,0.7040E-02,0.8229E-02,0.8783E-02,0.6729E-02, &
&0.6602E-02,0.6697E-02,0.6842E-02,0.6773E-02,0.6847E-02,0.6511E-02, &
&0.6583E-02,0.6321E-02,0.5896E-02,0.6472E-02,0.6582E-02,0.5389E-02, &
&0.6017E-02,0.5314E-02,0.9277E-02,0.7075E-02,0.7085E-02,0.8209E-02, &
&0.8633E-02,0.6474E-02,0.6425E-02,0.6452E-02,0.6521E-02,0.6613E-02, &
&0.6682E-02,0.6400E-02,0.6030E-02,0.5932E-02,0.5521E-02,0.6027E-02, &
&0.5448E-02,0.4493E-02,0.4742E-02,0.4193E-02,0.9280E-02,0.7083E-02, &
&0.7145E-02,0.8235E-02,0.8507E-02,0.6615E-02,0.6202E-02,0.6202E-02, &
&0.6215E-02,0.6321E-02,0.6409E-02,0.6188E-02,0.5670E-02,0.5742E-02, &
&0.5332E-02,0.5431E-02,0.4760E-02,0.4682E-02,0.5189E-02,0.3815E-02, &
&0.9289E-02,0.7120E-02,0.7240E-02,0.8241E-02,0.8473E-02,0.7078E-02, &
&0.6049E-02,0.5961E-02,0.5985E-02,0.6066E-02,0.6185E-02,0.5823E-02, &
&0.5609E-02,0.5362E-02,0.4848E-02,0.4827E-02,0.4381E-02,0.4667E-02, &
&0.5201E-02,0.3296E-02,0.9283E-02,0.7181E-02,0.7373E-02,0.8216E-02, &
&0.8499E-02,0.7122E-02,0.6128E-02,0.6053E-02,0.5910E-02,0.5690E-02, &
&0.5731E-02,0.5727E-02,0.5558E-02,0.4958E-02,0.4759E-02,0.4226E-02, &
&0.3988E-02,0.5002E-02,0.4975E-02,0.3933E-02,0.9286E-02,0.7343E-02, &
&0.7485E-02,0.8212E-02,0.8729E-02,0.7269E-02,0.6253E-02,0.6173E-02, &
&0.5940E-02,0.5573E-02,0.5120E-02,0.5207E-02,0.5069E-02,0.4704E-02, &
&0.4552E-02,0.3975E-02,0.4286E-02,0.4832E-02,0.4471E-02,0.3344E-02, &
&0.9085E-02,0.7800E-02,0.7732E-02,0.8265E-02,0.9332E-02,0.7232E-02, &
&0.5979E-02,0.5903E-02,0.5651E-02,0.5311E-02,0.4955E-02,0.4721E-02, &
&0.4874E-02,0.4779E-02,0.4284E-02,0.4249E-02,0.4157E-02,0.4764E-02, &
&0.3974E-02,0.4288E-02,0.9157E-02,0.8265E-02,0.7739E-02,0.8207E-02, &
&0.9788E-02,0.6982E-02,0.5511E-02,0.5498E-02,0.5459E-02,0.5323E-02, &
&0.5261E-02,0.4914E-02,0.4383E-02,0.4399E-02,0.4525E-02,0.4712E-02, &
&0.4326E-02,0.4187E-02,0.3584E-02,0.4187E-02/
data ( ( coeh2o_4_new(3,j,i), i = 1, 20 ), j = 1, 11 ) / &
&-.3594E-04,-.2935E-04,-.1372E-04,-.1635E-04,-.2586E-04,-.2005E-04, &
&-.1430E-04,-.1428E-04,-.1519E-04,-.1535E-04,-.7834E-05,-.2346E-05, &
&-.6894E-05,-.1020E-04,0.8785E-05,-.1988E-04,0.8652E-05,-.2389E-04, &
&-.2397E-04,-.4342E-04,-.3474E-04,-.2966E-04,-.1397E-04,-.1630E-04, &
&-.2485E-04,-.1818E-04,-.3649E-05,-.4586E-05,-.6734E-05,-.6747E-05, &
&-.6591E-05,-.4976E-05,-.1452E-04,-.1011E-04,0.3594E-05,-.2053E-04, &
&-.1216E-04,-.3090E-04,-.3758E-04,-.3498E-04,-.3586E-04,-.2950E-04, &
&-.1402E-04,-.1533E-04,-.2308E-04,-.1634E-04,-.1098E-05,-.1829E-05, &
&-.2310E-05,-.3867E-05,-.6139E-05,-.1438E-04,-.1295E-04,-.1172E-04, &
&0.3873E-06,-.2013E-04,-.7255E-05,-.2163E-04,-.2465E-04,-.2314E-04, &
&-.3575E-04,-.2956E-04,-.1460E-04,-.1462E-04,-.2128E-04,-.1600E-04, &
&-.1606E-05,0.7761E-06,-.2217E-05,-.6117E-05,-.1079E-04,-.1517E-04, &
&-.9977E-05,-.1104E-04,-.1556E-04,-.1699E-04,-.2087E-05,-.1440E-04, &
&-.1211E-04,-.9464E-05,-.3587E-04,-.2960E-04,-.1525E-04,-.1364E-04, &
&-.1990E-04,-.1077E-04,-.8291E-05,-.5765E-05,-.2400E-05,-.8273E-05, &
&-.1099E-04,-.1108E-04,-.7577E-05,-.1875E-04,-.2055E-04,-.4535E-05, &
&-.1209E-04,-.2342E-05,-.4700E-06,-.3739E-04,-.3597E-04,-.2968E-04, &
&-.1525E-04,-.1480E-04,-.2008E-04,-.1345E-04,-.1418E-04,-.1143E-04, &
&-.6487E-05,-.3917E-05,-.6416E-05,-.1083E-04,-.1397E-04,-.2202E-04, &
&-.2461E-04,0.5422E-05,-.2146E-04,-.3011E-04,-.2330E-04,-.2846E-04, &
&-.3468E-04,-.3062E-04,-.1609E-04,-.1326E-04,-.1826E-04,-.1963E-04, &
&-.1664E-04,-.1385E-04,-.8541E-05,-.5488E-05,-.1020E-04,-.1546E-04, &
&-.2315E-04,-.2030E-04,-.1748E-04,-.3597E-05,-.2125E-04,-.2707E-04, &
&-.4030E-04,-.2906E-04,-.3574E-04,-.3152E-04,-.1497E-04,-.1229E-04, &
&-.1659E-04,-.2335E-04,-.2297E-04,-.2063E-04,-.1634E-04,-.1101E-04, &
&-.1141E-04,-.1646E-04,-.1662E-04,-.1417E-04,-.4462E-05,-.1003E-04, &
&-.2179E-04,-.1428E-04,-.3478E-04,-.3015E-04,-.3576E-04,-.3331E-04, &
&-.1147E-04,-.1347E-04,-.1500E-04,-.2464E-04,-.2425E-04,-.2656E-04, &
&-.2615E-04,-.1825E-04,-.8554E-05,-.1118E-04,-.1189E-04,-.1032E-04, &
&-.8288E-05,-.2485E-04,-.1816E-04,-.9669E-05,-.3007E-04,-.2275E-04, &
&-.3183E-04,-.3689E-04,-.8395E-05,-.1344E-04,-.1930E-04,-.2277E-04, &
&-.1976E-04,-.2256E-04,-.2241E-04,-.2075E-04,-.1129E-04,-.6102E-05, &
&-.1229E-04,-.1382E-04,-.2815E-04,-.2577E-04,-.1758E-04,-.1649E-04, &
&-.1184E-04,-.1458E-04,-.3974E-04,-.4074E-04,-.5256E-05,-.1088E-04, &
&-.2123E-04,-.1784E-04,-.1047E-04,-.1041E-04,-.1252E-04,-.2148E-04, &
&-.2472E-04,-.1897E-04,-.1358E-04,-.1416E-04,-.1574E-04,-.2061E-04, &
&-.2316E-04,-.1710E-04,-.1221E-04,-.2155E-04/
! block data ckd5_new
!c *********************************************************************
!c hk is the interval in the g (cumulative probability) space from 0
!c to one. coeh2o is the coefficient to calculate the H2O absorption
!c coefficient in units of (cm-atm)**-1 at there temperatures, eleven
!c pressures, and twelve cumulative probabilities ( Fu, 1991 ). The
!c spectral region is from 4000 to 2850 cm**-1.
!c in this block data, Z.F. has added the coefficients for CO2, CH4, &
!c N2O and water vapor continuum absorption in Jun,2003.
!c *********************************************************************
! common /band5_new/ hk(20), coehh52(3,11,20),coeco2(3,11,20), &
! coen2o(3,11),coech4(3,11),coeh2o(3,11,20)
real hk_5_new(20), coehh52_5_new(3,11,20),coeco2_5_new(3,11,20), &
& coen2o_5_new(3,11),coech4_5_new(3,11),coeh2o_5_new(3,11,20)
data hk_5_new /3.16689E-02,7.09894E-02,1.04066E-01,0.127902, &
& 0.140374,0.140374,0.127902,1.04066E-01,7.09894E-02,3.16689E-02 &
& ,1.66678E-03 &
& ,3.73628E-03,5.47716E-03,6.73167E-03,7.38811E-03,7.38811E-03, &
& 6.73167E-03,5.47716E-03,3.73628E-03,1.66678E-03/
data ( ( coehh52_5_new(1,j,i), i = 1, 20 ), j = 1, 11 ) / &
&-.8666E+01,-.6282E+01,-.5178E+01,-.4084E+01,-.2810E+01,-.1264E+01, &
&-.1987E+00,0.8437E+00,0.2082E+01,0.3324E+01,0.3804E+01,0.3917E+01, &
&0.4149E+01,0.4438E+01,0.4921E+01,0.5511E+01,0.6395E+01,0.7441E+01, &
&0.9063E+01,0.1126E+02,-.8209E+01,-.5829E+01,-.4729E+01,-.3644E+01, &
&-.2386E+01,-.8421E+00,0.2255E+00,0.1262E+01,0.2468E+01,0.3682E+01, &
&0.4154E+01,0.4264E+01,0.4467E+01,0.4766E+01,0.5233E+01,0.5806E+01, &
&0.6616E+01,0.7632E+01,0.9166E+01,0.1124E+02,-.7746E+01,-.5373E+01, &
&-.4276E+01,-.3198E+01,-.1956E+01,-.4081E+00,0.6594E+00,0.1689E+01, &
&0.2861E+01,0.4049E+01,0.4511E+01,0.4619E+01,0.4817E+01,0.5118E+01, &
&0.5534E+01,0.6112E+01,0.6849E+01,0.7847E+01,0.9268E+01,0.1129E+02, &
&-.7286E+01,-.4922E+01,-.3829E+01,-.2755E+01,-.1524E+01,0.2336E-01, &
&0.1095E+01,0.2107E+01,0.3259E+01,0.4414E+01,0.4865E+01,0.4977E+01, &
&0.5174E+01,0.5476E+01,0.5865E+01,0.6413E+01,0.7117E+01,0.8055E+01, &
&0.9446E+01,0.1133E+02,-.6826E+01,-.4478E+01,-.3383E+01,-.2321E+01, &
&-.1094E+01,0.4524E+00,0.1530E+01,0.2525E+01,0.3658E+01,0.4782E+01, &
&0.5225E+01,0.5326E+01,0.5512E+01,0.5800E+01,0.6184E+01,0.6696E+01, &
&0.7377E+01,0.8267E+01,0.9530E+01,0.1129E+02,-.6368E+01,-.4036E+01, &
&-.2942E+01,-.1892E+01,-.6687E+00,0.8758E+00,0.1958E+01,0.2938E+01, &
&0.4045E+01,0.5149E+01,0.5560E+01,0.5661E+01,0.5848E+01,0.6119E+01, &
&0.6458E+01,0.6961E+01,0.7638E+01,0.8463E+01,0.9684E+01,0.1119E+02, &
&-.5920E+01,-.3599E+01,-.2513E+01,-.1469E+01,-.2504E+00,0.1294E+01, &
&0.2377E+01,0.3339E+01,0.4416E+01,0.5481E+01,0.5868E+01,0.5960E+01, &
&0.6145E+01,0.6412E+01,0.6738E+01,0.7221E+01,0.7854E+01,0.8652E+01, &
&0.9763E+01,0.1102E+02,-.5471E+01,-.3175E+01,-.2080E+01,-.1046E+01, &
&0.1674E+00,0.1705E+01,0.2789E+01,0.3732E+01,0.4779E+01,0.5785E+01, &
&0.6155E+01,0.6239E+01,0.6407E+01,0.6664E+01,0.7010E+01,0.7456E+01, &
&0.8033E+01,0.8804E+01,0.9750E+01,0.1086E+02,-.5041E+01,-.2765E+01, &
&-.1655E+01,-.6275E+00,0.5725E+00,0.2093E+01,0.3186E+01,0.4105E+01, &
&0.5115E+01,0.6067E+01,0.6425E+01,0.6511E+01,0.6660E+01,0.6893E+01, &
&0.7240E+01,0.7641E+01,0.8204E+01,0.8886E+01,0.9714E+01,0.1061E+02, &
&-.4616E+01,-.2373E+01,-.1234E+01,-.2160E+00,0.9628E+00,0.2446E+01, &
&0.3569E+01,0.4462E+01,0.5415E+01,0.6340E+01,0.6668E+01,0.6750E+01, &
&0.6892E+01,0.7106E+01,0.7414E+01,0.7806E+01,0.8336E+01,0.8913E+01, &
&0.9567E+01,0.1035E+02,-.4207E+01,-.1980E+01,-.8165E+00,0.1865E+00, &
&0.1326E+01,0.2750E+01,0.3932E+01,0.4794E+01,0.5700E+01,0.6590E+01, &
&0.6882E+01,0.6954E+01,0.7084E+01,0.7279E+01,0.7567E+01,0.7953E+01, &
&0.8376E+01,0.8840E+01,0.9428E+01,0.1002E+02/
data ( ( coehh52_5_new(2,j,i), i = 1, 20 ), j = 1, 11 ) / &
&-.4007E-02,0.1426E-03,0.1446E-02,0.3557E-02,0.5610E-02,0.4265E-02, &
&0.1692E-02,0.1490E-02,0.2099E-02,0.3019E-02,0.2999E-02,0.3000E-02, &
&0.3171E-02,0.3501E-02,0.3801E-02,0.3549E-02,0.4267E-02,0.3041E-02, &
&0.2516E-02,0.1526E-02,-.4024E-02,0.1852E-03,0.1458E-02,0.3519E-02, &
&0.5393E-02,0.4196E-02,0.1492E-02,0.1262E-02,0.1774E-02,0.2484E-02, &
&0.2514E-02,0.2591E-02,0.2498E-02,0.2861E-02,0.2748E-02,0.2866E-02, &
&0.3072E-02,0.2328E-02,0.2928E-02,0.9786E-03,-.3997E-02,0.2973E-03, &
&0.1427E-02,0.3424E-02,0.5224E-02,0.4131E-02,0.1273E-02,0.1049E-02, &
&0.1466E-02,0.2090E-02,0.2115E-02,0.2151E-02,0.2149E-02,0.2113E-02, &
&0.2099E-02,0.2487E-02,0.2459E-02,0.1791E-02,0.2853E-02,0.5138E-03, &
&-.3990E-02,0.4035E-03,0.1355E-02,0.3351E-02,0.5057E-02,0.4015E-02, &
&0.1135E-02,0.9161E-03,0.1180E-02,0.1731E-02,0.1781E-02,0.1764E-02, &
&0.1684E-02,0.1413E-02,0.1821E-02,0.1858E-02,0.1430E-02,0.1006E-02, &
&0.2163E-02,0.2395E-03,-.3989E-02,0.5809E-03,0.1288E-02,0.3223E-02, &
&0.4918E-02,0.3901E-02,0.9747E-03,0.7342E-03,0.1006E-02,0.1242E-02, &
&0.1328E-02,0.1368E-02,0.1372E-02,0.1279E-02,0.1295E-02,0.1282E-02, &
&0.1032E-02,0.6375E-03,0.1563E-02,-.2982E-04,-.4014E-02,0.7514E-03, &
&0.1202E-02,0.3091E-02,0.4798E-02,0.3841E-02,0.8673E-03,0.5651E-03, &
&0.9085E-03,0.1049E-02,0.1294E-02,0.1288E-02,0.1183E-02,0.1140E-02, &
&0.9012E-03,0.9593E-03,0.1014E-02,0.1117E-02,0.1066E-02,-.1099E-02, &
&-.4075E-02,0.8802E-03,0.1042E-02,0.2937E-02,0.4657E-02,0.3814E-02, &
&0.6835E-03,0.4783E-03,0.8688E-03,0.8872E-03,0.1221E-02,0.1184E-02, &
&0.1061E-02,0.7615E-03,0.6239E-03,0.8406E-03,0.7873E-03,0.9015E-03, &
&0.1466E-03,-.5840E-03,-.4182E-02,0.1165E-02,0.8200E-03,0.2741E-02, &
&0.4498E-02,0.3771E-02,0.4988E-03,0.3560E-03,0.6538E-03,0.6745E-03, &
&0.8484E-03,0.8844E-03,0.7564E-03,0.7354E-03,0.4966E-03,0.6557E-03, &
&0.5528E-03,0.3779E-03,0.2114E-04,-.1370E-02,-.4411E-02,0.1337E-02, &
&0.5687E-03,0.2592E-02,0.4434E-02,0.3792E-02,0.2925E-03,0.2261E-03, &
&0.5712E-03,0.5103E-03,0.3708E-03,0.4357E-03,0.5158E-03,0.5609E-03, &
&0.4781E-03,0.4167E-03,0.4737E-03,0.1337E-03,-.4880E-03,-.1383E-02, &
&-.4715E-02,0.1462E-02,0.3031E-03,0.2423E-02,0.4282E-02,0.3804E-02, &
&0.1177E-03,0.2911E-03,0.3478E-03,0.2609E-03,0.9838E-04,0.2236E-03, &
&0.4689E-03,0.4508E-03,0.4734E-03,0.3268E-03,0.3338E-03,-.1376E-04, &
&-.4611E-03,-.6319E-03,-.5313E-02,0.1413E-02,0.1130E-03,0.2251E-02, &
&0.4041E-02,0.3676E-02,-.8065E-04,0.2368E-03,0.5349E-05,0.1502E-03, &
&0.1613E-03,0.2078E-03,0.2388E-03,0.2124E-03,0.2042E-03,0.8376E-04, &
&0.3356E-03,-.2620E-03,-.9731E-03,-.1027E-02/
data ( ( coehh52_5_new(3,j,i), i = 1, 20 ), j = 1, 11 ) / &
&0.1007E-03,0.2111E-04,0.1520E-04,0.7675E-05,0.4202E-05,-.1897E-04, &
&0.6318E-05,0.4970E-05,-.3149E-05,-.3635E-05,-.3746E-05,-.3696E-05, &
&-.5442E-05,0.9822E-05,0.4071E-05,0.3916E-05,-.2316E-04,0.5506E-05, &
&-.1083E-04,0.1991E-04,0.1008E-03,0.2003E-04,0.1652E-04,0.8137E-05, &
&0.4385E-05,-.1826E-04,0.6703E-05,0.4379E-05,-.1838E-05,-.4339E-05, &
&-.6329E-07,0.1229E-05,0.2146E-05,0.1085E-04,0.3753E-06,-.4002E-05, &
&-.4361E-05,0.5894E-05,-.5931E-05,0.1907E-04,0.1005E-03,0.1905E-04, &
&0.1699E-04,0.8546E-05,0.4699E-05,-.1959E-04,0.7236E-05,0.2594E-05, &
&-.5232E-06,-.5786E-05,0.2779E-05,0.4142E-05,0.3868E-05,0.5357E-05, &
&0.1154E-05,-.6563E-05,0.4403E-05,0.4716E-05,-.3646E-05,0.1643E-05, &
&0.1005E-03,0.1811E-04,0.1756E-04,0.8874E-05,0.3784E-05,-.2077E-04, &
&0.6903E-05,0.2352E-05,-.2308E-05,0.1285E-06,0.3476E-05,0.2272E-05, &
&0.1289E-05,-.9765E-05,-.3869E-05,-.5959E-05,0.4652E-05,0.2487E-05, &
&-.1458E-04,-.1865E-04,0.1003E-03,0.1777E-04,0.1840E-04,0.9793E-05, &
&0.3308E-05,-.2114E-04,0.5553E-05,0.2666E-05,-.4281E-05,-.1293E-05, &
&-.2118E-05,-.1122E-05,-.8954E-06,-.4337E-05,-.4615E-05,-.1896E-05, &
&0.4289E-05,-.5416E-06,0.1302E-04,0.6468E-06,0.1000E-03,0.1448E-04, &
&0.1911E-04,0.1125E-04,0.1673E-05,-.2045E-04,0.5796E-05,0.8374E-06, &
&-.2206E-05,-.3980E-05,-.2208E-05,-.2803E-05,-.3762E-05,-.4563E-05, &
&0.2444E-05,0.1631E-05,-.1026E-05,-.7909E-05,-.8622E-05,-.1181E-04, &
&0.1016E-03,0.9190E-05,0.2101E-04,0.1178E-04,0.3234E-05,-.2053E-04, &
&0.5534E-05,0.9896E-06,-.1037E-05,-.1935E-05,-.3589E-05,-.1289E-05, &
&-.3458E-05,-.6364E-05,0.1473E-05,0.4079E-05,-.6143E-05,-.1128E-04, &
&-.1329E-04,0.3675E-05,0.1016E-03,0.3449E-05,0.2094E-04,0.1269E-04, &
&0.3572E-05,-.1985E-04,0.4922E-05,0.1352E-05,-.9556E-06,-.1714E-05, &
&-.8815E-06,0.8366E-06,0.4805E-06,-.1632E-05,-.2761E-05,-.4128E-05, &
&-.3822E-05,-.6255E-05,0.1630E-06,0.9692E-05,0.1051E-03,-.3064E-05, &
&0.2106E-04,0.1404E-04,0.4135E-05,-.1707E-04,0.4493E-05,0.1264E-05, &
&-.2982E-05,-.4161E-06,-.2585E-05,-.1920E-05,0.1199E-05,-.2294E-05, &
&-.2828E-05,-.2647E-05,-.5113E-05,0.5922E-05,-.7602E-05,0.2036E-05, &
&0.1074E-03,-.2572E-05,0.2093E-04,0.1440E-04,0.5478E-05,-.1040E-04, &
&0.4462E-05,-.6851E-06,-.2301E-06,-.1729E-05,-.3216E-06,0.2235E-06, &
&0.7215E-06,-.2233E-05,-.3133E-05,0.3816E-05,-.3828E-05,-.2315E-05, &
&0.6354E-05,-.8020E-05,0.1078E-03,-.9762E-05,0.2073E-04,0.1379E-04, &
&0.7391E-05,0.2956E-05,0.1963E-05,-.3750E-05,0.2484E-05,-.2601E-05, &
&-.1286E-05,-.1258E-06,0.3129E-05,0.4531E-05,0.8059E-06,-.3833E-05, &
&-.6074E-05,0.1838E-05,0.2217E-05,-.2464E-05/
data ( ( coeco2_5_new(1,j,i), i = 1, 20 ), j = 1, 11 ) / &
&-.4604E+02,-.4597E+02,-.4585E+02,-.2145E+02,-.1886E+02,-.1697E+02, &
&-.1355E+02,-.8736E+01,-.6451E+01,-.5327E+01,-.4880E+01,-.4766E+01, &
&-.4553E+01,-.4233E+01,-.3790E+01,-.3222E+01,-.2504E+01,-.1414E+01, &
&0.1152E+00,0.3516E+01,-.4604E+02,-.4597E+02,-.4585E+02,-.2100E+02, &
&-.1840E+02,-.1651E+02,-.1315E+02,-.8370E+01,-.6038E+01,-.4934E+01, &
&-.4488E+01,-.4383E+01,-.4169E+01,-.3872E+01,-.3458E+01,-.2907E+01, &
&-.2169E+01,-.1160E+01,0.3362E+00,0.3496E+01,-.4604E+02,-.4597E+02, &
&-.4585E+02,-.2053E+02,-.1794E+02,-.1605E+02,-.1277E+02,-.7997E+01, &
&-.5617E+01,-.4523E+01,-.4097E+01,-.3991E+01,-.3790E+01,-.3501E+01, &
&-.3114E+01,-.2577E+01,-.1847E+01,-.8386E+00,0.5202E+00,0.3508E+01, &
&-.4604E+02,-.4597E+02,-.4585E+02,-.2007E+02,-.1748E+02,-.1559E+02, &
&-.1241E+02,-.7629E+01,-.5195E+01,-.4126E+01,-.3715E+01,-.3615E+01, &
&-.3440E+01,-.3146E+01,-.2763E+01,-.2235E+01,-.1564E+01,-.5597E+00, &
&0.7944E+00,0.3469E+01,-.4604E+02,-.4597E+02,-.4585E+02,-.1961E+02, &
&-.1702E+02,-.1514E+02,-.1209E+02,-.7259E+01,-.4779E+01,-.3739E+01, &
&-.3348E+01,-.3249E+01,-.3070E+01,-.2786E+01,-.2410E+01,-.1902E+01, &
&-.1214E+01,-.3116E+00,0.1099E+01,0.3322E+01,-.4604E+02,-.4597E+02, &
&-.4585E+02,-.1915E+02,-.1656E+02,-.1471E+02,-.1179E+02,-.6895E+01, &
&-.4369E+01,-.3368E+01,-.2981E+01,-.2886E+01,-.2717E+01,-.2442E+01, &
&-.2073E+01,-.1576E+01,-.8880E+00,-.9229E-01,0.1376E+01,0.3154E+01, &
&-.4604E+02,-.4597E+02,-.4585E+02,-.1869E+02,-.1611E+02,-.1430E+02, &
&-.1151E+02,-.6549E+01,-.3980E+01,-.3010E+01,-.2626E+01,-.2540E+01, &
&-.2365E+01,-.2107E+01,-.1741E+01,-.1267E+01,-.6970E+00,0.2205E+00, &
&0.1582E+01,0.2963E+01,-.4604E+02,-.4597E+02,-.4585E+02,-.1823E+02, &
&-.1566E+02,-.1394E+02,-.1126E+02,-.6234E+01,-.3614E+01,-.2632E+01, &
&-.2275E+01,-.2184E+01,-.2023E+01,-.1785E+01,-.1449E+01,-.1014E+01, &
&-.3839E+00,0.5345E+00,0.1650E+01,0.2685E+01,-.4604E+02,-.4597E+02, &
&-.4585E+02,-.1777E+02,-.1525E+02,-.1363E+02,-.1103E+02,-.5918E+01, &
&-.3280E+01,-.2270E+01,-.1945E+01,-.1870E+01,-.1722E+01,-.1499E+01, &
&-.1173E+01,-.7176E+00,-.7814E-01,0.7223E+00,0.1629E+01,0.2373E+01, &
&-.4603E+02,-.4596E+02,-.4584E+02,-.1726E+02,-.1488E+02,-.1336E+02, &
&-.1080E+02,-.5589E+01,-.2960E+01,-.1947E+01,-.1636E+01,-.1559E+01, &
&-.1420E+01,-.1204E+01,-.8742E+00,-.4450E+00,0.1392E+00,0.8142E+00, &
&0.1491E+01,0.2044E+01,-.4603E+02,-.4595E+02,-.2628E+02,-.1681E+02, &
&-.1452E+02,-.1308E+02,-.1059E+02,-.5284E+01,-.2681E+01,-.1610E+01, &
&-.1304E+01,-.1235E+01,-.1107E+01,-.9014E+00,-.5972E+00,-.2077E+00, &
&0.2692E+00,0.7754E+00,0.1252E+01,0.1693E+01/
data ( ( coeco2_5_new(2,j,i), i = 1, 20 ), j = 1, 11 ) / &
&-.6312E-05,-.3267E-04,-.7758E-04,0.2214E-01,0.1591E-01,0.1721E-01, &
&0.1878E-01,0.1462E-01,0.4258E-02,0.4565E-02,0.5099E-02,0.5116E-02, &
&0.5155E-02,0.5255E-02,0.5432E-02,0.5536E-02,0.5327E-02,0.4227E-02, &
&0.4953E-02,0.2251E-02,-.6312E-05,-.3267E-04,-.7758E-04,0.2212E-01, &
&0.1592E-01,0.1726E-01,0.1877E-01,0.1422E-01,0.3987E-02,0.4005E-02, &
&0.4434E-02,0.4494E-02,0.4307E-02,0.4702E-02,0.4999E-02,0.4552E-02, &
&0.4265E-02,0.3668E-02,0.3548E-02,0.1663E-02,-.6312E-05,-.3267E-04, &
&-.7758E-04,0.2215E-01,0.1594E-01,0.1730E-01,0.1863E-01,0.1362E-01, &
&0.3873E-02,0.3564E-02,0.3758E-02,0.3855E-02,0.3904E-02,0.4138E-02, &
&0.4326E-02,0.3744E-02,0.3562E-02,0.3639E-02,0.2931E-02,0.1193E-02, &
&-.6312E-05,-.3267E-04,-.7758E-04,0.2214E-01,0.1597E-01,0.1742E-01, &
&0.1801E-01,0.1297E-01,0.3689E-02,0.3099E-02,0.3337E-02,0.3439E-02, &
&0.3505E-02,0.3644E-02,0.3532E-02,0.3165E-02,0.3317E-02,0.3432E-02, &
&0.1006E-02,0.1082E-02,-.6312E-05,-.3267E-04,-.7758E-04,0.2214E-01, &
&0.1603E-01,0.1758E-01,0.1726E-01,0.1272E-01,0.3510E-02,0.2756E-02, &
&0.2947E-02,0.2952E-02,0.3065E-02,0.2918E-02,0.3096E-02,0.2699E-02, &
&0.3102E-02,0.2814E-02,-.2179E-03,0.6990E-03,-.6312E-05,-.3267E-04, &
&-.7758E-04,0.2216E-01,0.1612E-01,0.1777E-01,0.1654E-01,0.1256E-01, &
&0.3449E-02,0.2312E-02,0.2549E-02,0.2608E-02,0.2546E-02,0.2708E-02, &
&0.2767E-02,0.2637E-02,0.3097E-02,0.1237E-02,-.4737E-04,0.5654E-03, &
&-.6312E-05,-.3267E-04,-.7758E-04,0.2221E-01,0.1632E-01,0.1798E-01, &
&0.1640E-01,0.1251E-01,0.3583E-02,0.2044E-02,0.2266E-02,0.2295E-02, &
&0.2371E-02,0.2428E-02,0.2645E-02,0.2775E-02,0.2033E-02,-.4414E-03, &
&0.7038E-04,0.6883E-03,-.6312E-05,-.3267E-04,-.7758E-04,0.2228E-01, &
&0.1660E-01,0.1798E-01,0.1661E-01,0.1237E-01,0.3817E-02,0.1813E-02, &
&0.1990E-02,0.2030E-02,0.2120E-02,0.2236E-02,0.2441E-02,0.1824E-02, &
&0.6145E-03,-.6285E-03,-.5780E-03,0.1162E-02,-.6312E-05,-.3267E-04, &
&-.7758E-04,0.2238E-01,0.1689E-01,0.1747E-01,0.1641E-01,0.1189E-01, &
&0.4503E-02,0.1467E-02,0.1468E-02,0.1569E-02,0.1629E-02,0.1512E-02, &
&0.1310E-02,0.5937E-03,-.4280E-03,-.4761E-03,0.3077E-03,0.9290E-03, &
&-.1165E-04,-.6027E-04,-.1432E-03,0.2138E-01,0.1677E-01,0.1674E-01, &
&0.1554E-01,0.1120E-01,0.5419E-02,0.8517E-03,0.6131E-03,0.5899E-03, &
&0.6051E-03,0.3657E-03,0.1230E-03,-.2749E-03,-.2687E-03,-.3468E-04, &
&0.7365E-03,0.7334E-03,-.1127E-04,-.5826E-04,-.1552E+00,0.2054E-01, &
&0.1656E-01,0.1668E-01,0.1399E-01,0.1044E-01,0.5792E-02,-.4239E-04, &
&-.2550E-03,-.2478E-03,-.2417E-03,-.2311E-03,-.2848E-03,-.1873E-03, &
&-.1577E-03,0.3878E-03,0.7217E-03,0.9697E-03/
data ( ( coeco2_5_new(3,j,i), i = 1, 20 ), j = 1, 11 ) / &
&0.2396E-07,0.1261E-06,0.3020E-06,-.1186E-03,-.5048E-04,-.3367E-04, &
&-.2102E-04,-.1554E-04,0.4159E-05,0.1761E-04,0.1882E-04,0.1667E-04, &
&0.1088E-04,0.1876E-05,0.1609E-05,0.5874E-05,0.1421E-04,0.7607E-05, &
&0.6216E-05,-.1562E-04,0.2396E-07,0.1261E-06,0.3020E-06,-.1187E-03, &
&-.5049E-04,-.3458E-04,-.1636E-04,-.1029E-04,0.1143E-05,0.1624E-04, &
&0.1369E-04,0.1259E-04,0.4036E-05,0.4883E-05,0.8159E-05,0.1210E-04, &
&0.9429E-05,0.8813E-05,0.2454E-05,-.9511E-05,0.2396E-07,0.1261E-06, &
&0.3020E-06,-.1185E-03,-.5087E-04,-.3540E-04,-.6400E-05,-.6171E-05, &
&-.2561E-05,0.1174E-04,0.1127E-04,0.1079E-04,0.7710E-05,0.6127E-05, &
&0.1612E-04,0.1123E-04,0.8563E-05,-.2938E-05,0.2052E-04,-.2194E-04, &
&0.2396E-07,0.1261E-06,0.3020E-06,-.1186E-03,-.5148E-04,-.3651E-04, &
&-.4118E-05,-.1724E-05,-.6074E-05,0.1213E-04,0.1464E-04,0.1540E-04, &
&0.1913E-04,0.1291E-04,0.1741E-04,0.1012E-04,0.1822E-04,0.3557E-05, &
&0.1762E-04,-.2772E-04,0.2396E-07,0.1261E-06,0.3020E-06,-.1185E-03, &
&-.5213E-04,-.3815E-04,-.1397E-06,-.1479E-05,-.7361E-05,0.1723E-04, &
&0.1850E-04,0.1782E-04,0.1750E-04,0.1027E-04,0.7671E-05,0.7701E-05, &
&0.3498E-05,0.1747E-04,0.1203E-04,-.2956E-05,0.2396E-07,0.1261E-06, &
&0.3020E-06,-.1189E-03,-.5317E-04,-.3661E-04,0.3007E-05,-.2793E-05, &
&-.8225E-05,0.2099E-04,0.1500E-04,0.1313E-04,0.1216E-04,0.5368E-05, &
&0.3641E-05,0.2938E-05,-.7264E-05,0.3374E-04,0.7883E-05,0.5436E-05, &
&0.2396E-07,0.1261E-06,0.3020E-06,-.1203E-03,-.5628E-04,-.3268E-04, &
&0.3766E-05,-.5755E-05,-.1114E-04,0.2079E-04,0.4371E-05,0.6102E-05, &
&0.3752E-05,0.5406E-05,-.2422E-05,0.6568E-05,0.2813E-04,0.1828E-04, &
&-.6223E-05,-.3613E-05,0.2396E-07,0.1261E-06,0.3020E-06,-.1213E-03, &
&-.5831E-04,-.2293E-04,-.3905E-05,0.5474E-06,-.1410E-04,0.1069E-04, &
&0.6712E-05,0.3470E-05,0.4569E-05,0.9994E-05,0.9921E-05,0.2125E-04, &
&0.1623E-04,-.3732E-05,-.1921E-06,0.8500E-05,0.2396E-07,0.1261E-06, &
&0.3020E-06,-.1234E-03,-.5635E-04,-.1761E-04,-.6118E-05,0.2346E-05, &
&-.2320E-04,0.9271E-05,0.1258E-04,0.1470E-04,0.1474E-04,0.1461E-04, &
&0.1581E-04,0.1519E-04,0.2818E-05,-.2626E-06,0.3643E-05,0.5762E-05, &
&0.4918E-07,0.2573E-06,0.6085E-06,-.1192E-03,-.4535E-04,-.7103E-05, &
&-.2094E-06,0.4099E-05,-.2757E-04,0.1735E-04,0.1911E-04,0.1873E-04, &
&0.1672E-04,0.1528E-04,0.1183E-04,0.9506E-05,0.5285E-06,-.4482E-07, &
&-.4531E-05,0.5150E-05,-.1204E-06,-.6255E-06,-.3640E-02,-.1024E-03, &
&-.4800E-04,-.8273E-05,0.1008E-04,-.3693E-05,-.2388E-04,0.1612E-04, &
&0.1321E-04,0.1305E-04,0.1367E-04,0.9785E-05,0.3604E-05,0.1761E-05, &
&-.4489E-05,-.2160E-05,-.8970E-06,0.1082E-05/
data ( ( coen2o_5_new(k,i), i = 1, 11 ) , k= 1, 3 )/ &
&-.1547E+02,-.1501E+02,-.1455E+02,-.1409E+02,-.1363E+02,-.1317E+02, &
&-.1271E+02,-.1226E+02,-.1181E+02,-.1132E+02,-.1094E+02,0.1180E-01, &
&0.1179E-01,0.1180E-01,0.1180E-01,0.1181E-01,0.1182E-01,0.1187E-01, &
&0.1195E-01,0.1223E-01,0.1359E-01,0.1500E-01,-.6451E-04,-.6470E-04, &
&-.6455E-04,-.6446E-04,-.6448E-04,-.6467E-04,-.6578E-04,-.6657E-04, &
&-.7072E-04,-.8392E-04,-.1009E-03/
data ( ( coech4_5_new(k,i), i = 1, 11 ) , k= 1, 3 )/ &
&-.1469E+02,-.1423E+02,-.1377E+02,-.1331E+02,-.1285E+02,-.1239E+02, &
&-.1193E+02,-.1147E+02,-.1101E+02,-.1054E+02,-.1010E+02,0.2568E-02, &
&0.2559E-02,0.2564E-02,0.2575E-02,0.2568E-02,0.2575E-02,0.2566E-02, &
&0.2572E-02,0.2589E-02,0.2741E-02,0.2859E-02,-.2855E-04,-.2877E-04, &
&-.2893E-04,-.2867E-04,-.2855E-04,-.2867E-04,-.2857E-04,-.2876E-04, &
&-.2814E-04,-.2486E-04,-.2352E-04/
data ( ( coeh2o_5_new(1,j,i), i = 1, 20 ), j = 1, 11 ) / &
&-.1679E+02,-.1421E+02,-.1278E+02,-.1151E+02,-.1018E+02,-.8724E+01, &
&-.7519E+01,-.6371E+01,-.5087E+01,-.3831E+01,-.3343E+01,-.3229E+01, &
&-.3004E+01,-.2710E+01,-.2230E+01,-.1632E+01,-.7493E+00,0.2900E+00, &
&0.1916E+01,0.4118E+01,-.1633E+02,-.1375E+02,-.1233E+02,-.1108E+02, &
&-.9762E+01,-.8303E+01,-.7095E+01,-.5958E+01,-.4705E+01,-.3474E+01, &
&-.2994E+01,-.2883E+01,-.2680E+01,-.2381E+01,-.1923E+01,-.1338E+01, &
&-.5348E+00,0.4885E+00,0.2022E+01,0.4101E+01,-.1587E+02,-.1330E+02, &
&-.1188E+02,-.1063E+02,-.9334E+01,-.7878E+01,-.6672E+01,-.5539E+01, &
&-.4312E+01,-.3110E+01,-.2642E+01,-.2530E+01,-.2329E+01,-.2033E+01, &
&-.1611E+01,-.1034E+01,-.2899E+00,0.6953E+00,0.2117E+01,0.4148E+01, &
&-.1541E+02,-.1284E+02,-.1144E+02,-.1020E+02,-.8905E+01,-.7450E+01, &
&-.6247E+01,-.5120E+01,-.3917E+01,-.2751E+01,-.2289E+01,-.2173E+01, &
&-.1974E+01,-.1680E+01,-.1283E+01,-.7392E+00,-.2864E-01,0.9075E+00, &
&0.2298E+01,0.4193E+01,-.1495E+02,-.1240E+02,-.1100E+02,-.9766E+01, &
&-.8478E+01,-.7025E+01,-.5821E+01,-.4704E+01,-.3515E+01,-.2380E+01, &
&-.1926E+01,-.1825E+01,-.1634E+01,-.1347E+01,-.9673E+00,-.4638E+00, &
&0.2266E+00,0.1119E+01,0.2388E+01,0.4148E+01,-.1449E+02,-.1196E+02, &
&-.1056E+02,-.9341E+01,-.8058E+01,-.6604E+01,-.5401E+01,-.4297E+01, &
&-.3127E+01,-.2009E+01,-.1595E+01,-.1494E+01,-.1306E+01,-.1029E+01, &
&-.6861E+00,-.1851E+00,0.4845E+00,0.1324E+01,0.2538E+01,0.4048E+01, &
&-.1404E+02,-.1156E+02,-.1014E+02,-.8922E+01,-.7639E+01,-.6194E+01, &
&-.4995E+01,-.3903E+01,-.2766E+01,-.1675E+01,-.1293E+01,-.1197E+01, &
&-.1008E+01,-.7351E+00,-.4168E+00,0.7103E-01,0.7057E+00,0.1497E+01, &
&0.2607E+01,0.3866E+01,-.1359E+02,-.1117E+02,-.9728E+01,-.8507E+01, &
&-.7225E+01,-.5789E+01,-.4599E+01,-.3515E+01,-.2393E+01,-.1374E+01, &
&-.1003E+01,-.9204E+00,-.7472E+00,-.4912E+00,-.1385E+00,0.3020E+00, &
&0.8781E+00,0.1662E+01,0.2602E+01,0.3692E+01,-.1318E+02,-.1082E+02, &
&-.9323E+01,-.8101E+01,-.6826E+01,-.5402E+01,-.4214E+01,-.3147E+01, &
&-.2073E+01,-.1091E+01,-.7342E+00,-.6486E+00,-.4955E+00,-.2623E+00, &
&0.8325E-01,0.4929E+00,0.1056E+01,0.1739E+01,0.2560E+01,0.3475E+01, &
&-.1277E+02,-.1053E+02,-.8920E+01,-.7692E+01,-.6438E+01,-.5050E+01, &
&-.3854E+01,-.2803E+01,-.1782E+01,-.8295E+00,-.4914E+00,-.4098E+00, &
&-.2626E+00,-.4623E-01,0.2617E+00,0.6526E+00,0.1189E+01,0.1758E+01, &
&0.2414E+01,0.3215E+01,-.1240E+02,-.1026E+02,-.8528E+01,-.7299E+01, &
&-.6073E+01,-.4726E+01,-.3528E+01,-.2495E+01,-.1512E+01,-.5843E+00, &
&-.2852E+00,-.2171E+00,-.7673E-01,0.1243E+00,0.4100E+00,0.8000E+00, &
&0.1228E+01,0.1695E+01,0.2278E+01,0.2868E+01/
data ( ( coeh2o_5_new(2,j,i), i = 1, 20 ), j = 1, 11 ) / &
&0.1204E-01,0.7706E-02,0.6638E-02,0.7243E-02,0.7680E-02,0.5452E-02, &
&0.3557E-02,0.2130E-02,0.2271E-02,0.3087E-02,0.3014E-02,0.3048E-02, &
&0.3219E-02,0.3560E-02,0.3806E-02,0.3584E-02,0.4275E-02,0.2983E-02, &
&0.2555E-02,0.1260E-02,0.1205E-01,0.7751E-02,0.6707E-02,0.7213E-02, &
&0.7529E-02,0.5346E-02,0.3357E-02,0.1917E-02,0.2007E-02,0.2577E-02, &
&0.2549E-02,0.2596E-02,0.2542E-02,0.2886E-02,0.2759E-02,0.2819E-02, &
&0.3234E-02,0.2266E-02,0.2982E-02,0.9786E-03,0.1207E-01,0.7798E-02, &
&0.6725E-02,0.7193E-02,0.7357E-02,0.5232E-02,0.3185E-02,0.1721E-02, &
&0.1677E-02,0.2172E-02,0.2133E-02,0.2169E-02,0.2169E-02,0.2152E-02, &
&0.2124E-02,0.2462E-02,0.2520E-02,0.1767E-02,0.2956E-02,0.2229E-03, &
&0.1209E-01,0.7870E-02,0.6740E-02,0.7117E-02,0.7196E-02,0.5153E-02, &
&0.3017E-02,0.1577E-02,0.1401E-02,0.1784E-02,0.1860E-02,0.1845E-02, &
&0.1683E-02,0.1516E-02,0.1836E-02,0.1864E-02,0.1418E-02,0.8931E-03, &
&0.2304E-02,0.2570E-03,0.1215E-01,0.7968E-02,0.6728E-02,0.6976E-02, &
&0.7038E-02,0.5049E-02,0.2906E-02,0.1479E-02,0.1208E-02,0.1313E-02, &
&0.1452E-02,0.1438E-02,0.1389E-02,0.1262E-02,0.1286E-02,0.1193E-02, &
&0.1107E-02,0.6817E-03,0.1556E-02,-.1493E-03,0.1223E-01,0.8121E-02, &
&0.6734E-02,0.6903E-02,0.6912E-02,0.5013E-02,0.2808E-02,0.1337E-02, &
&0.1165E-02,0.1084E-02,0.1340E-02,0.1399E-02,0.1313E-02,0.1174E-02, &
&0.8843E-03,0.9987E-03,0.9803E-03,0.1086E-02,0.9965E-03,-.9692E-03, &
&0.1229E-01,0.8279E-02,0.6713E-02,0.6800E-02,0.6847E-02,0.5006E-02, &
&0.2661E-02,0.1253E-02,0.1035E-02,0.9595E-03,0.1264E-02,0.1258E-02, &
&0.1156E-02,0.8092E-03,0.7080E-03,0.8455E-03,0.8113E-03,0.8759E-03, &
&0.2292E-03,-.5840E-03,0.1244E-01,0.8559E-02,0.6642E-02,0.6655E-02, &
&0.6701E-02,0.5003E-02,0.2486E-02,0.1133E-02,0.9329E-03,0.7777E-03, &
&0.9160E-03,0.9158E-03,0.7865E-03,0.7290E-03,0.5881E-03,0.6781E-03, &
&0.5059E-03,0.3786E-03,-.2816E-04,-.1370E-02,0.1252E-01,0.8676E-02, &
&0.6502E-02,0.6573E-02,0.6754E-02,0.5131E-02,0.2346E-02,0.1110E-02, &
&0.8200E-03,0.6781E-03,0.5184E-03,0.5828E-03,0.6087E-03,0.6010E-03, &
&0.5973E-03,0.5822E-03,0.5167E-03,0.2478E-03,-.5116E-03,-.1448E-02, &
&0.1275E-01,0.9012E-02,0.6375E-02,0.6409E-02,0.6763E-02,0.5223E-02, &
&0.2154E-02,0.1186E-02,0.7161E-03,0.3788E-03,0.2895E-03,0.3548E-03, &
&0.5469E-03,0.5274E-03,0.5283E-03,0.3407E-03,0.3951E-03,-.5743E-04, &
&-.4179E-03,-.6078E-03,0.1267E-01,0.9445E-02,0.6244E-02,0.6370E-02, &
&0.6707E-02,0.5162E-02,0.2073E-02,0.1367E-02,0.5272E-03,0.3591E-03, &
&0.2973E-03,0.3340E-03,0.3241E-03,0.3011E-03,0.2689E-03,0.1879E-03, &
&0.3560E-03,-.2123E-03,-.9343E-03,-.9746E-03/
data ( ( coeh2o_5_new(3,j,i), i = 1, 20 ), j = 1, 11 ) / &
&-.1488E-04,-.4992E-04,-.1896E-04,-.1536E-04,-.1366E-04,-.1704E-04, &
&-.9149E-05,0.1797E-06,-.3830E-05,-.3421E-05,-.4354E-05,-.3941E-05, &
&-.5329E-05,0.9114E-05,0.6472E-05,0.2136E-05,-.2470E-04,0.6310E-05, &
&-.8523E-05,0.1507E-04,-.1526E-04,-.4992E-04,-.1852E-04,-.1385E-04, &
&-.1243E-04,-.1611E-04,-.1028E-04,0.1072E-05,-.7730E-06,-.3514E-05, &
&-.1722E-05,-.4966E-06,0.9349E-06,0.8705E-05,0.2239E-05,-.5156E-05, &
&-.3809E-05,0.5633E-05,-.6523E-05,0.1907E-04,-.1531E-04,-.5094E-04, &
&-.1711E-04,-.1402E-04,-.1158E-04,-.1541E-04,-.8994E-05,0.5836E-06, &
&-.7061E-06,-.2982E-05,0.2277E-05,0.3383E-05,0.3076E-05,0.4003E-05, &
&0.1708E-06,-.6581E-05,0.2710E-05,0.7203E-05,-.1286E-05,-.3646E-05, &
&-.1521E-04,-.5155E-04,-.1586E-04,-.1291E-04,-.1205E-04,-.1693E-04, &
&-.7853E-05,-.1132E-05,-.2090E-05,0.4380E-05,0.3341E-05,0.2540E-06, &
&0.4008E-07,-.7470E-05,-.3862E-05,-.4504E-05,0.5059E-05,0.1909E-05, &
&-.1382E-04,-.1918E-04,-.1593E-04,-.5295E-04,-.1580E-04,-.1262E-04, &
&-.1294E-04,-.1677E-04,-.7874E-05,-.1899E-05,-.5272E-05,-.1308E-06, &
&-.2730E-05,-.1780E-05,-.3794E-05,-.5488E-05,-.5482E-05,0.1685E-05, &
&0.5738E-05,0.8429E-07,0.1426E-04,-.8812E-05,-.1695E-04,-.5113E-04, &
&-.1454E-04,-.1172E-04,-.1348E-04,-.1736E-04,-.6866E-05,-.2326E-05, &
&-.4519E-05,-.3909E-05,-.2330E-05,-.2746E-05,-.4705E-05,-.7223E-05, &
&0.6654E-06,-.2541E-06,0.2110E-05,-.9119E-05,-.1092E-04,-.1416E-04, &
&-.1853E-04,-.4810E-04,-.1398E-04,-.1208E-04,-.1648E-04,-.1727E-04, &
&-.5378E-05,-.3338E-05,-.3626E-07,-.3219E-05,-.3313E-06,0.1342E-05, &
&-.2380E-05,-.7542E-05,0.2723E-05,0.3471E-05,-.5414E-05,-.8535E-05, &
&-.8649E-05,0.9000E-05,-.1941E-04,-.4399E-04,-.1103E-04,-.1223E-04, &
&-.1715E-04,-.1735E-04,-.3181E-05,-.4420E-05,-.4976E-05,-.2576E-05, &
&0.4882E-07,0.2550E-05,0.8227E-06,-.1540E-05,-.4379E-05,-.3666E-05, &
&-.1228E-05,-.6451E-05,0.3135E-06,0.1819E-04,-.1588E-04,-.3742E-04, &
&-.1046E-04,-.1117E-04,-.1555E-04,-.1810E-04,-.3538E-05,-.5237E-05, &
&-.4512E-05,-.4260E-05,-.1338E-05,-.1553E-05,-.2364E-06,-.2937E-05, &
&-.3000E-05,-.4404E-05,-.4429E-05,0.5089E-05,-.3497E-05,0.1401E-05, &
&-.1088E-04,-.1897E-04,-.1016E-04,-.1119E-04,-.1582E-04,-.1467E-04, &
&-.4144E-05,-.7074E-05,-.2523E-05,-.1621E-06,-.2316E-05,-.1536E-05, &
&-.1114E-05,-.3704E-05,-.4162E-05,0.5414E-05,-.6634E-05,0.7455E-06, &
&0.7533E-05,-.1057E-04,-.6807E-05,-.1136E-04,-.9631E-05,-.1372E-04, &
&-.1708E-04,-.1658E-04,-.4971E-05,-.8482E-05,0.4900E-06,-.2855E-05, &
&-.8621E-06,0.6185E-06,0.2429E-05,0.2445E-05,-.4034E-06,-.4563E-05, &
&-.8940E-05,0.1794E-05,0.2715E-05,-.5026E-06/
! block data ckd6_new
!c *********************************************************************
!c hk is the interval in the g (cumulative probability) space from 0
!c to one. coeh2o is the coefficient to calculate the H2O absorption
!c coefficient in units of (cm-atm)**-1 at there temperatures, eleven
!c pressures, and five cumulative probabilities ( Fu, 1991 ). The
!c spectral region is from 2850 to 2500 cm**-1.
!c in this block data, Z.F. has added the coefficients for SO2 and water
!c vapor continuum absorption in Jun,2003.
!c *********************************************************************
! common /band6_new/ hk(20), coehh62(3,11,20),coeso2(3,11) &
! ,coeh2o(3,11,20)
real hk_6_new(20), coehh62_6_new(3,11,20),coeso2_6_new(3,11) &
& ,coeh2o_6_new(3,11,20)
data hk_6_new /3.16689E-02,7.09894E-02,1.04066E-01,0.127902, &
& 0.140374,0.140374,0.127902,1.04066E-01,7.09894E-02,3.16689E-02 &
& ,1.66678E-03 &
& ,3.73628E-03,5.47716E-03,6.73167E-03,7.38811E-03,7.38811E-03, &
& 6.73167E-03,5.47716E-03,3.73628E-03,1.66678E-03/
data ( ( coehh62_6_new(1,j,i), i = 1, 20 ), j = 1, 11 ) / &
&-.9667E+01,-.9653E+01,-.9628E+01,-.9595E+01,-.9557E+01,-.9517E+01, &
&-.9479E+01,-.9446E+01,-.9230E+01,-.7739E+01,-.7157E+01,-.7028E+01, &
&-.6791E+01,-.6457E+01,-.5962E+01,-.5352E+01,-.4491E+01,-.3367E+01, &
&-.1470E+01,0.8809E+00,-.9207E+01,-.9192E+01,-.9168E+01,-.9135E+01, &
&-.9097E+01,-.9057E+01,-.9019E+01,-.8986E+01,-.8770E+01,-.7306E+01, &
&-.6729E+01,-.6600E+01,-.6371E+01,-.6060E+01,-.5555E+01,-.5004E+01, &
&-.4163E+01,-.3114E+01,-.1384E+01,0.8334E+00,-.8746E+01,-.8732E+01, &
&-.8707E+01,-.8674E+01,-.8636E+01,-.8596E+01,-.8558E+01,-.8525E+01, &
&-.8309E+01,-.6877E+01,-.6302E+01,-.6185E+01,-.5968E+01,-.5633E+01, &
&-.5160E+01,-.4635E+01,-.3842E+01,-.2820E+01,-.1245E+01,0.6736E+00, &
&-.8286E+01,-.8271E+01,-.8246E+01,-.8214E+01,-.8176E+01,-.8136E+01, &
&-.8098E+01,-.8065E+01,-.7849E+01,-.6445E+01,-.5890E+01,-.5769E+01, &
&-.5537E+01,-.5220E+01,-.4772E+01,-.4247E+01,-.3541E+01,-.2475E+01, &
&-.1109E+01,0.6606E+00,-.7825E+01,-.7811E+01,-.7786E+01,-.7753E+01, &
&-.7715E+01,-.7675E+01,-.7637E+01,-.7604E+01,-.7390E+01,-.6040E+01, &
&-.5476E+01,-.5348E+01,-.5133E+01,-.4827E+01,-.4384E+01,-.3904E+01, &
&-.3194E+01,-.2185E+01,-.9919E+00,0.4216E+00,-.7365E+01,-.7350E+01, &
&-.7325E+01,-.7293E+01,-.7254E+01,-.7215E+01,-.7177E+01,-.7144E+01, &
&-.6931E+01,-.5630E+01,-.5073E+01,-.4948E+01,-.4733E+01,-.4423E+01, &
&-.4029E+01,-.3538E+01,-.2879E+01,-.1939E+01,-.9645E+00,0.3446E+00, &
&-.6904E+01,-.6890E+01,-.6865E+01,-.6832E+01,-.6794E+01,-.6755E+01, &
&-.6717E+01,-.6684E+01,-.6477E+01,-.5223E+01,-.4684E+01,-.4561E+01, &
&-.4344E+01,-.4044E+01,-.3664E+01,-.3218E+01,-.2624E+01,-.1798E+01, &
&-.8307E+00,0.2102E+00,-.6444E+01,-.6429E+01,-.6405E+01,-.6372E+01, &
&-.6334E+01,-.6294E+01,-.6256E+01,-.6224E+01,-.6024E+01,-.4837E+01, &
&-.4301E+01,-.4177E+01,-.3957E+01,-.3694E+01,-.3340E+01,-.2917E+01, &
&-.2407E+01,-.1680E+01,-.8730E+00,-.1722E-01,-.5983E+01,-.5969E+01, &
&-.5944E+01,-.5912E+01,-.5874E+01,-.5834E+01,-.5797E+01,-.5764E+01, &
&-.5575E+01,-.4419E+01,-.3920E+01,-.3816E+01,-.3632E+01,-.3375E+01, &
&-.3093E+01,-.2728E+01,-.2243E+01,-.1594E+01,-.9797E+00,-.2503E+00, &
&-.5523E+01,-.5508E+01,-.5484E+01,-.5451E+01,-.5414E+01,-.5375E+01, &
&-.5337E+01,-.5305E+01,-.5124E+01,-.4022E+01,-.3593E+01,-.3506E+01, &
&-.3345E+01,-.3134E+01,-.2898E+01,-.2566E+01,-.2089E+01,-.1622E+01, &
&-.1140E+01,-.5877E+00,-.5062E+01,-.5048E+01,-.5024E+01,-.4992E+01, &
&-.4954E+01,-.4915E+01,-.4878E+01,-.4846E+01,-.4675E+01,-.3658E+01, &
&-.3312E+01,-.3239E+01,-.3113E+01,-.2949E+01,-.2766E+01,-.2396E+01, &
&-.2049E+01,-.1638E+01,-.1305E+01,-.9088E+00/
data ( ( coehh62_6_new(2,j,i), i = 1, 20 ), j = 1, 11 ) / &
&-.2708E-01,-.2651E-01,-.2545E-01,-.2385E-01,-.2324E-01,-.2349E-01, &
&-.2374E-01,-.2421E-01,-.1680E-01,-.2856E-03,0.1422E-02,0.1756E-02, &
&0.2525E-02,0.3960E-02,0.5646E-02,0.7334E-02,0.7621E-02,0.7548E-02, &
&0.5082E-02,0.5324E-02,-.2708E-01,-.2652E-01,-.2546E-01,-.2384E-01, &
&-.2322E-01,-.2347E-01,-.2371E-01,-.2419E-01,-.1683E-01,-.3282E-03, &
&0.1485E-02,0.1731E-02,0.2295E-02,0.3569E-02,0.5337E-02,0.5533E-02, &
&0.5841E-02,0.5607E-02,0.4539E-02,0.5602E-02,-.2708E-01,-.2651E-01, &
&-.2545E-01,-.2385E-01,-.2324E-01,-.2348E-01,-.2373E-01,-.2420E-01, &
&-.1682E-01,-.2929E-03,0.1377E-02,0.1590E-02,0.2159E-02,0.3440E-02, &
&0.4662E-02,0.5012E-02,0.4695E-02,0.3924E-02,0.3741E-02,0.4969E-02, &
&-.2708E-01,-.2651E-01,-.2545E-01,-.2385E-01,-.2324E-01,-.2348E-01, &
&-.2373E-01,-.2420E-01,-.1682E-01,-.3198E-03,0.1224E-02,0.1557E-02, &
&0.2048E-02,0.2705E-02,0.3888E-02,0.4160E-02,0.3778E-02,0.2669E-02, &
&0.2845E-02,0.5310E-02,-.2708E-01,-.2651E-01,-.2545E-01,-.2385E-01, &
&-.2324E-01,-.2348E-01,-.2373E-01,-.2420E-01,-.1697E-01,-.5133E-03, &
&0.9245E-03,0.1115E-02,0.1453E-02,0.1932E-02,0.3127E-02,0.2995E-02, &
&0.2403E-02,0.3104E-02,0.1342E-02,0.5079E-02,-.2708E-01,-.2651E-01, &
&-.2545E-01,-.2385E-01,-.2324E-01,-.2348E-01,-.2373E-01,-.2419E-01, &
&-.1707E-01,-.1177E-02,0.1868E-03,0.4750E-03,0.9348E-03,0.1296E-02, &
&0.2276E-02,0.2125E-02,0.2156E-02,0.3366E-02,0.2008E-02,0.4248E-02, &
&-.2708E-01,-.2652E-01,-.2546E-01,-.2384E-01,-.2321E-01,-.2346E-01, &
&-.2369E-01,-.2417E-01,-.1729E-01,-.2249E-02,-.4710E-03,-.4539E-03, &
&0.6080E-04,0.7048E-03,0.1538E-02,0.2074E-02,0.2281E-02,0.3636E-02, &
&0.3781E-02,0.5755E-02,-.2708E-01,-.2651E-01,-.2545E-01,-.2385E-01, &
&-.2323E-01,-.2347E-01,-.2371E-01,-.2418E-01,-.1797E-01,-.3309E-02, &
&-.1281E-02,-.1097E-02,-.5322E-03,0.2134E-04,0.7265E-03,0.1910E-02, &
&0.1981E-02,0.3826E-02,0.4608E-02,0.5151E-02,-.2708E-01,-.2651E-01, &
&-.2545E-01,-.2386E-01,-.2324E-01,-.2348E-01,-.2371E-01,-.2418E-01, &
&-.1947E-01,-.4529E-02,-.2135E-02,-.1786E-02,-.1108E-02,-.1966E-03, &
&0.8462E-03,0.1820E-02,0.2539E-02,0.4328E-02,0.3932E-02,0.5756E-02, &
&-.2708E-01,-.2651E-01,-.2546E-01,-.2390E-01,-.2324E-01,-.2349E-01, &
&-.2372E-01,-.2418E-01,-.2123E-01,-.5410E-02,-.2339E-02,-.2035E-02, &
&-.1348E-02,-.6070E-03,-.4833E-05,0.1460E-02,0.3117E-02,0.3868E-02, &
&0.4459E-02,0.5434E-02,-.2708E-01,-.2652E-01,-.2549E-01,-.2400E-01, &
&-.2327E-01,-.2351E-01,-.2374E-01,-.2418E-01,-.2291E-01,-.6281E-02, &
&-.2938E-02,-.2467E-02,-.2122E-02,-.1570E-02,-.3528E-03,0.1469E-02, &
&0.2665E-02,0.3666E-02,0.3621E-02,0.5081E-02/
data ( ( coehh62_6_new(3,j,i), i = 1, 20 ), j = 1, 11 ) / &
&-.3371E-04,-.1558E-04,0.1711E-04,0.6392E-04,0.9219E-04,0.1041E-03, &
&0.1157E-03,0.1304E-03,0.2195E-03,0.6023E-04,0.3354E-04,0.3098E-04, &
&0.2733E-04,0.3203E-04,0.1841E-04,0.3694E-04,0.2320E-04,0.2027E-04, &
&-.1302E-04,-.5543E-04,-.3379E-04,-.1599E-04,0.1634E-04,0.6315E-04, &
&0.9168E-04,0.1037E-03,0.1152E-03,0.1302E-03,0.2188E-03,0.6325E-04, &
&0.3944E-04,0.3620E-04,0.3270E-04,0.4286E-04,0.2168E-04,0.2955E-04, &
&0.1721E-04,0.8918E-05,-.6523E-05,-.5039E-04,-.3373E-04,-.1567E-04, &
&0.1694E-04,0.6372E-04,0.9205E-04,0.1040E-03,0.1155E-03,0.1303E-03, &
&0.2189E-03,0.7100E-04,0.4707E-04,0.4619E-04,0.4492E-04,0.4602E-04, &
&0.2443E-04,0.3433E-04,0.1585E-04,0.5867E-05,0.3420E-06,-.1850E-04, &
&-.3372E-04,-.1563E-04,0.1703E-04,0.6384E-04,0.9213E-04,0.1040E-03, &
&0.1155E-03,0.1302E-03,0.2189E-03,0.7705E-04,0.5640E-04,0.5543E-04, &
&0.4413E-04,0.4087E-04,0.2313E-04,0.2460E-04,0.2125E-04,-.4771E-05, &
&-.1355E-05,-.3365E-04,-.3372E-04,-.1559E-04,0.1709E-04,0.6387E-04, &
&0.9213E-04,0.1040E-03,0.1156E-03,0.1302E-03,0.2164E-03,0.8442E-04, &
&0.5958E-04,0.5325E-04,0.4425E-04,0.3852E-04,0.2133E-04,0.2273E-04, &
&0.1111E-05,-.6955E-05,-.1659E-04,0.1914E-04,-.3372E-04,-.1560E-04, &
&0.1708E-04,0.6385E-04,0.9210E-04,0.1040E-03,0.1155E-03,0.1301E-03, &
&0.2150E-03,0.8868E-04,0.5468E-04,0.5100E-04,0.4405E-04,0.3155E-04, &
&0.1870E-04,0.7819E-05,0.1052E-05,-.1769E-04,0.2584E-05,0.7410E-05, &
&-.3379E-04,-.1600E-04,0.1629E-04,0.6301E-04,0.9158E-04,0.1035E-03, &
&0.1149E-03,0.1298E-03,0.2127E-03,0.8664E-04,0.5114E-04,0.4597E-04, &
&0.3562E-04,0.2479E-04,0.1163E-04,0.9757E-05,0.3488E-05,-.1156E-04, &
&-.2332E-04,-.3154E-05,-.3374E-04,-.1571E-04,0.1685E-04,0.6352E-04, &
&0.9197E-04,0.1039E-03,0.1153E-03,0.1300E-03,0.2025E-03,0.9169E-04, &
&0.4326E-04,0.3635E-04,0.2582E-04,0.2002E-04,0.9380E-05,0.1084E-04, &
&-.1823E-05,-.1982E-04,-.1654E-04,-.1981E-04,-.3372E-04,-.1564E-04, &
&0.1696E-04,0.6357E-04,0.9211E-04,0.1040E-03,0.1154E-03,0.1300E-03, &
&0.1785E-03,0.8311E-04,0.3462E-04,0.3216E-04,0.2805E-04,0.1893E-04, &
&0.2209E-04,0.1619E-04,0.2757E-05,-.2293E-04,0.1417E-06,-.2688E-04, &
&-.3372E-04,-.1560E-04,0.1687E-04,0.6296E-04,0.9204E-04,0.1039E-03, &
&0.1152E-03,0.1297E-03,0.1489E-03,0.8721E-04,0.4197E-04,0.4071E-04, &
&0.3529E-04,0.2399E-04,0.2257E-04,0.1966E-04,-.4268E-05,-.7444E-05, &
&0.4240E-05,-.2269E-04,-.3374E-04,-.1570E-04,0.1632E-04,0.6129E-04, &
&0.9169E-04,0.1035E-03,0.1148E-03,0.1290E-03,0.1207E-03,0.1016E-03, &
&0.5146E-04,0.4638E-04,0.4090E-04,0.3605E-04,0.4308E-04,0.1763E-04, &
&0.1664E-04,-.4294E-05,0.1195E-04,-.6244E-05/
data ( ( coeso2_6_new(k,j), j = 1, 11 ), k=1, 3 ) / &
&-.1280E+02,-.1234E+02,-.1189E+02,-.1145E+02,-.1103E+02,-.1072E+02, &
&-.1049E+02,-.1032E+02,-.1020E+02,-.9898E+01,-.9803E+01,0.1000E-01, &
&0.1011E-01,0.1017E-01,0.1055E-01,0.1117E-01,0.1183E-01,0.1209E-01, &
&0.1229E-01,0.1207E-01,0.1084E-01,0.1142E-01,-.4992E-04,-.5246E-04, &
&-.5238E-04,-.5332E-04,-.6118E-04,-.5978E-04,-.5063E-04,-.4731E-04, &
&-.4110E-04,-.6332E-04,-.4993E-04/
data ( ( coeh2o_6_new(1,j,i), i = 1, 20 ), j = 1, 11 ) / &
&-.4600E+02,-.3047E+02,-.2846E+02,-.2708E+02,-.2564E+02,-.2430E+02, &
&-.2317E+02,-.2161E+02,-.1833E+02,-.1505E+02,-.1438E+02,-.1424E+02, &
&-.1400E+02,-.1363E+02,-.1317E+02,-.1251E+02,-.1163E+02,-.1052E+02, &
&-.8621E+01,-.6305E+01,-.4600E+02,-.3001E+02,-.2800E+02,-.2662E+02, &
&-.2518E+02,-.2384E+02,-.2271E+02,-.2115E+02,-.1787E+02,-.1462E+02, &
&-.1397E+02,-.1383E+02,-.1358E+02,-.1322E+02,-.1275E+02,-.1216E+02, &
&-.1132E+02,-.1025E+02,-.8523E+01,-.6305E+01,-.4600E+02,-.2955E+02, &
&-.2754E+02,-.2616E+02,-.2472E+02,-.2338E+02,-.2225E+02,-.2069E+02, &
&-.1741E+02,-.1419E+02,-.1354E+02,-.1340E+02,-.1317E+02,-.1280E+02, &
&-.1234E+02,-.1179E+02,-.1101E+02,-.9958E+01,-.8383E+01,-.6464E+01, &
&-.4600E+02,-.2909E+02,-.2708E+02,-.2570E+02,-.2425E+02,-.2292E+02, &
&-.2179E+02,-.2023E+02,-.1695E+02,-.1377E+02,-.1314E+02,-.1299E+02, &
&-.1275E+02,-.1239E+02,-.1195E+02,-.1141E+02,-.1070E+02,-.9646E+01, &
&-.8247E+01,-.6477E+01,-.4600E+02,-.2862E+02,-.2661E+02,-.2524E+02, &
&-.2379E+02,-.2246E+02,-.2133E+02,-.1977E+02,-.1651E+02,-.1338E+02, &
&-.1273E+02,-.1258E+02,-.1234E+02,-.1201E+02,-.1157E+02,-.1108E+02, &
&-.1038E+02,-.9328E+01,-.8163E+01,-.6721E+01,-.4600E+02,-.2816E+02, &
&-.2615E+02,-.2478E+02,-.2333E+02,-.2200E+02,-.2087E+02,-.1931E+02, &
&-.1608E+02,-.1297E+02,-.1233E+02,-.1219E+02,-.1196E+02,-.1163E+02, &
&-.1121E+02,-.1071E+02,-.1004E+02,-.9092E+01,-.8137E+01,-.6840E+01, &
&-.4600E+02,-.2771E+02,-.2570E+02,-.2432E+02,-.2288E+02,-.2154E+02, &
&-.2041E+02,-.1885E+02,-.1572E+02,-.1258E+02,-.1196E+02,-.1182E+02, &
&-.1158E+02,-.1125E+02,-.1085E+02,-.1037E+02,-.9773E+01,-.8976E+01, &
&-.7992E+01,-.6928E+01,-.4600E+02,-.2724E+02,-.2523E+02,-.2386E+02, &
&-.2241E+02,-.2108E+02,-.1995E+02,-.1840E+02,-.1542E+02,-.1221E+02, &
&-.1157E+02,-.1143E+02,-.1120E+02,-.1089E+02,-.1053E+02,-.1010E+02, &
&-.9581E+01,-.8824E+01,-.8043E+01,-.7155E+01,-.4600E+02,-.2678E+02, &
&-.2477E+02,-.2340E+02,-.2195E+02,-.2062E+02,-.1949E+02,-.1797E+02, &
&-.1517E+02,-.1180E+02,-.1121E+02,-.1108E+02,-.1086E+02,-.1062E+02, &
&-.1030E+02,-.9901E+01,-.9409E+01,-.8739E+01,-.8128E+01,-.7388E+01, &
&-.4595E+02,-.2593E+02,-.2418E+02,-.2290E+02,-.2147E+02,-.2015E+02, &
&-.1904E+02,-.1756E+02,-.1505E+02,-.1143E+02,-.1090E+02,-.1079E+02, &
&-.1061E+02,-.1038E+02,-.1012E+02,-.9753E+01,-.9284E+01,-.8780E+01, &
&-.8300E+01,-.7749E+01,-.4594E+02,-.2538E+02,-.2372E+02,-.2244E+02, &
&-.2101E+02,-.1970E+02,-.1860E+02,-.1723E+02,-.1497E+02,-.1109E+02, &
&-.1064E+02,-.1056E+02,-.1041E+02,-.1023E+02,-.9992E+01,-.9603E+01, &
&-.9239E+01,-.8818E+01,-.8469E+01,-.8081E+01/
data ( ( coeh2o_6_new(2,j,i), i = 1, 20 ), j = 1, 11 ) / &
&-.1732E-03,-.1040E+00,0.4355E-01,0.3802E-01,0.3763E-01,0.3498E-01, &
&0.3418E-01,0.3305E-01,0.2441E-01,0.5405E-02,0.4747E-02,0.4815E-02, &
&0.4948E-02,0.5712E-02,0.6499E-02,0.8091E-02,0.7739E-02,0.7929E-02, &
&0.5507E-02,0.5324E-02,-.1732E-03,-.1082E+00,0.4355E-01,0.3802E-01, &
&0.3761E-01,0.3500E-01,0.3418E-01,0.3308E-01,0.2480E-01,0.5392E-02, &
&0.4896E-02,0.4827E-02,0.4807E-02,0.5315E-02,0.6330E-02,0.6395E-02, &
&0.6155E-02,0.5730E-02,0.4539E-02,0.5602E-02,-.1732E-03,-.1124E+00, &
&0.4356E-01,0.3801E-01,0.3763E-01,0.3499E-01,0.3418E-01,0.3306E-01, &
&0.2507E-01,0.5563E-02,0.4808E-02,0.4727E-02,0.4704E-02,0.5231E-02, &
&0.5865E-02,0.5900E-02,0.4793E-02,0.3895E-02,0.3741E-02,0.4969E-02, &
&-.1732E-03,-.1165E+00,0.4356E-01,0.3802E-01,0.3763E-01,0.3498E-01, &
&0.3419E-01,0.3307E-01,0.2544E-01,0.5598E-02,0.4705E-02,0.4709E-02, &
&0.4613E-02,0.4609E-02,0.5258E-02,0.4956E-02,0.4074E-02,0.2861E-02, &
&0.2990E-02,0.5310E-02,-.1732E-03,-.1207E+00,0.4355E-01,0.3801E-01, &
&0.3763E-01,0.3498E-01,0.3420E-01,0.3307E-01,0.2585E-01,0.5504E-02, &
&0.4420E-02,0.4295E-02,0.4078E-02,0.3915E-02,0.4571E-02,0.3703E-02, &
&0.3252E-02,0.3150E-02,0.1358E-02,0.4710E-02,-.1732E-03,-.1249E+00, &
&0.4356E-01,0.3803E-01,0.3764E-01,0.3498E-01,0.3421E-01,0.3311E-01, &
&0.2631E-01,0.5258E-02,0.3788E-02,0.3741E-02,0.3749E-02,0.3160E-02, &
&0.3813E-02,0.2749E-02,0.2548E-02,0.3451E-02,0.2008E-02,0.4013E-02, &
&-.1732E-03,-.1291E+00,0.4355E-01,0.3803E-01,0.3762E-01,0.3501E-01, &
&0.3421E-01,0.3317E-01,0.2691E-01,0.4396E-02,0.3183E-02,0.2727E-02, &
&0.2707E-02,0.2743E-02,0.3062E-02,0.2843E-02,0.2648E-02,0.3747E-02, &
&0.3891E-02,0.5570E-02,-.1732E-03,-.1333E+00,0.4356E-01,0.3803E-01, &
&0.3764E-01,0.3502E-01,0.3422E-01,0.3333E-01,0.2696E-01,0.3569E-02, &
&0.2360E-02,0.2106E-02,0.2282E-02,0.2378E-02,0.2520E-02,0.3106E-02, &
&0.2731E-02,0.3933E-02,0.4528E-02,0.5413E-02,-.1732E-03,-.1375E+00, &
&0.4356E-01,0.3806E-01,0.3766E-01,0.3502E-01,0.3427E-01,0.3365E-01, &
&0.2573E-01,0.2764E-02,0.1964E-02,0.1815E-02,0.2121E-02,0.2308E-02, &
&0.2642E-02,0.2912E-02,0.3808E-02,0.4920E-02,0.4192E-02,0.5815E-02, &
&-.2013E-03,0.6002E-01,0.4420E-01,0.3855E-01,0.3797E-01,0.3514E-01, &
&0.3447E-01,0.3441E-01,0.2400E-01,0.2426E-02,0.2285E-02,0.2307E-02, &
&0.2456E-02,0.2597E-02,0.2516E-02,0.3262E-02,0.4367E-02,0.4726E-02, &
&0.4604E-02,0.5849E-02,0.0000E+00,0.6025E-01,0.4432E-01,0.3864E-01, &
&0.3801E-01,0.3526E-01,0.3472E-01,0.3484E-01,0.2350E-01,0.2538E-02, &
&0.2770E-02,0.2631E-02,0.2378E-02,0.2408E-02,0.2965E-02,0.4432E-02, &
&0.4542E-02,0.5035E-02,0.4633E-02,0.5444E-02/
data ( ( coeh2o_6_new(3,j,i), i = 1, 20 ), j = 1, 11 ) / &
&0.6305E-09,-.3186E-02,-.1769E-03,-.8462E-04,-.9882E-04,-.9498E-04, &
&-.9584E-04,-.9217E-04,-.4288E-07,-.1434E-04,-.9830E-05,-.9121E-05, &
&-.1076E-05,0.3692E-05,0.2042E-04,0.2711E-04,0.1446E-04,0.1809E-04, &
&-.1982E-04,-.3973E-04,0.6305E-09,-.3261E-02,-.1763E-03,-.8508E-04, &
&-.9858E-04,-.9520E-04,-.9582E-04,-.9287E-04,-.7187E-05,-.9534E-05, &
&-.2394E-05,-.9578E-06,0.4418E-05,0.9583E-05,0.1496E-04,0.2117E-04, &
&0.1408E-04,0.6408E-05,-.6277E-05,-.5039E-04,0.6305E-09,-.3338E-02, &
&-.1765E-03,-.8448E-04,-.9877E-04,-.9522E-04,-.9598E-04,-.9268E-04, &
&-.1109E-04,-.3322E-05,0.5691E-05,0.4565E-05,0.1416E-04,0.1524E-04, &
&0.1264E-04,0.2417E-04,0.1825E-04,0.4172E-05,0.3421E-06,-.1850E-04, &
&0.6305E-09,-.3414E-02,-.1767E-03,-.8451E-04,-.9882E-04,-.9486E-04, &
&-.9598E-04,-.9240E-04,-.1727E-04,0.4190E-05,0.1412E-04,0.1219E-04, &
&0.1657E-04,0.1401E-04,0.3647E-05,0.1615E-04,0.2174E-04,0.1934E-05, &
&-.4005E-05,-.3364E-04,0.6305E-09,-.3491E-02,-.1769E-03,-.8450E-04, &
&-.9913E-04,-.9498E-04,-.9614E-04,-.9239E-04,-.1977E-04,0.1724E-04, &
&0.1983E-04,0.1352E-04,0.9765E-05,0.1277E-04,0.5305E-05,0.1480E-04, &
&0.1430E-05,-.1099E-04,-.6924E-05,0.1404E-04,0.6305E-09,-.3567E-02, &
&-.1770E-03,-.8474E-04,-.9894E-04,-.9473E-04,-.9617E-04,-.9291E-04, &
&-.2151E-04,0.2346E-04,0.1371E-04,0.1147E-04,0.1094E-04,0.1407E-04, &
&0.2222E-05,-.1062E-05,0.1531E-05,-.1748E-04,0.1407E-04,0.1847E-04, &
&0.6305E-09,-.3642E-02,-.1764E-03,-.8523E-04,-.9892E-04,-.9513E-04, &
&-.9623E-04,-.9317E-04,-.7163E-05,0.1964E-04,0.1505E-04,0.1327E-04, &
&0.4409E-05,0.1338E-06,-.8370E-05,-.5770E-05,-.4403E-05,-.1135E-05, &
&-.1786E-04,-.1126E-04,0.6305E-09,-.3719E-02,-.1765E-03,-.8487E-04, &
&-.9882E-04,-.9518E-04,-.9627E-04,-.9435E-04,0.4101E-05,0.2025E-04, &
&0.1494E-05,0.2371E-05,-.4260E-05,-.1145E-04,-.1501E-04,-.5205E-05, &
&-.7078E-05,-.2613E-04,-.1220E-04,-.2457E-04,0.6305E-09,-.3795E-02, &
&-.1768E-03,-.8520E-04,-.9896E-04,-.9557E-04,-.9678E-04,-.9741E-04, &
&0.7907E-05,0.2320E-05,-.1138E-04,-.1181E-04,-.1171E-04,-.4526E-05, &
&-.9526E-06,-.1426E-05,-.1523E-04,-.3728E-04,-.7095E-05,-.3584E-04, &
&0.6154E-06,-.2967E-03,-.1664E-03,-.8674E-04,-.1013E-03,-.9641E-04, &
&-.9766E-04,-.1016E-03,0.3196E-04,-.2726E-05,-.9340E-05,-.8610E-05, &
&-.6137E-05,-.1048E-04,-.3945E-05,-.9921E-05,-.1724E-04,-.2295E-04, &
&0.4577E-05,-.2728E-04,0.0000E+00,-.3212E-03,-.1657E-03,-.8656E-04, &
&-.1007E-03,-.9824E-04,-.9977E-04,-.8734E-04,0.3091E-04,0.8470E-06, &
&-.1287E-04,-.1108E-04,-.8110E-05,-.7669E-05,-.7991E-05,-.1662E-04, &
&-.1272E-04,-.2306E-04,-.1398E-05,-.1044E-04/
! block data ckd7_new
!c *********************************************************************
!c hk is the interval in the g (cumulative probability) space from 0
!c to one. coeh2o is the coefficient to calculate the H2O absorption
!c coefficient in units of (cm-atm)**-1 at there temperatures, nine-
!c teen pressures, and two cumulative probabilities ( Fu, 1991 ).
!c The spectral region is from 2200 to 1900 cm**-1.
!c *********************************************************************
! common /band7_new/ hk(2), coeh2o(3,19,2)
real hk_7_new(2), coeh2o_7_new(3,19,2)
data hk_7_new / 0.7, 0.3 /
data ( ( ( coeh2o_7_new(k,j,i), i = 1, 2 ), j = 1, 19 ), k = 1, 3) / &
&-.2008E+02,-.1467E+02,-.2004E+02,-.1426E+02,-.2001E+02,-.1386E+02, &
&-.1998E+02,-.1345E+02,-.1995E+02,-.1304E+02,-.1992E+02,-.1263E+02, &
&-.1989E+02,-.1223E+02,-.1986E+02,-.1183E+02,-.1984E+02,-.1143E+02, &
&-.1758E+02,-.1038E+02,-.1602E+02,-.9480E+01,-.1469E+02,-.8752E+01, &
&-.1349E+02,-.8218E+01,-.1255E+02,-.7677E+01,-.1174E+02,-.7184E+01, &
&-.1110E+02,-.6735E+01,-.1056E+02,-.6332E+01,-.1019E+02,-.5975E+01, &
&-.9874E+01,-.5644E+01, .2533E-02, .2269E-01, .2575E-02, .2263E-01, &
& .2554E-02, .2267E-01, .2491E-02, .2250E-01, .2449E-02, .2244E-01, &
& .2344E-02, .2234E-01, .2219E-02, .2208E-01, .5694E-02, .2190E-01, &
& .9650E-02, .2162E-01, .3286E-01, .1848E-01, .2987E-01, .1578E-01, &
& .2527E-01, .1465E-01, .2175E-01, .1386E-01, .2056E-01, .1235E-01, &
& .1963E-01, .1116E-01, .1926E-01, .1040E-01, .2014E-01, .1040E-01, &
& .2024E-01, .1042E-01, .1972E-01, .1080E-01,-.8754E-05,-.6698E-04, &
&-.1104E-04,-.6432E-04,-.1142E-04,-.6051E-04,-.1180E-04,-.6128E-04, &
&-.1180E-04,-.6242E-04,-.1218E-04,-.6280E-04,-.1218E-04,-.6204E-04, &
& .5328E-04,-.5709E-04, .1275E-03,-.5214E-04,-.1370E-03,-.4148E-04, &
&-.1100E-03,-.3045E-04,-.9248E-04,-.3197E-04,-.7346E-04,-.2436E-04, &
&-.5100E-04,-.2131E-04,-.5861E-04,-.2550E-04,-.5328E-04,-.3311E-04, &
&-.6090E-04,-.4225E-04,-.5443E-04,-.4415E-04,-.4034E-04,-.4339E-04/
! block data ckd8_new
!c *********************************************************************
!c hk is the interval in the g (cumulative probability) space from 0
!c to one. coeh2o is the coefficient to calculate the H2O absorption
!c coefficient in units of (cm-atm)**-1 at there temperatures, nine-
!c teen pressures, and three cumulative probabilities ( Fu, 1991 ).
!c The spectral region is from 1900 to 1700 cm**-1.
!c *********************************************************************
! common /band8_new/ hk(3), coeh2o(3,19,3),coeno(3,19)
real hk_8_new(3), coeh2o_8_new(3,19,3),coeno_8_new(3,19)
data hk_8_new / 0.2, 0.7, 0.1 /
data ((( coeh2o_8_new(k,j,i), i = 1, 3), j = 1, 19), k = 1, 3)/ &
&-.2283E+02,-.1639E+02,-.6155E+01,-.2237E+02,-.1595E+02,-.5775E+01, &
&-.2191E+02,-.1551E+02,-.5381E+01,-.2145E+02,-.1507E+02,-.5004E+01, &
&-.2099E+02,-.1463E+02,-.4617E+01,-.2053E+02,-.1419E+02,-.4218E+01, &
&-.2025E+02,-.1375E+02,-.3806E+01,-.2021E+02,-.1330E+02,-.3403E+01, &
&-.2018E+02,-.1287E+02,-.2993E+01,-.1998E+02,-.1091E+02,-.2586E+01, &
&-.1744E+02,-.9171E+01,-.2162E+01,-.1490E+02,-.7642E+01,-.1763E+01, &
&-.1303E+02,-.6526E+01,-.1373E+01,-.1113E+02,-.5846E+01,-.9699E+00, &
&-.9814E+01,-.5280E+01,-.5955E+00,-.8582E+01,-.4787E+01,-.2510E+00, &
&-.8020E+01,-.4350E+01, .2770E-01,-.7571E+01,-.3942E+01, .2406E+00, &
&-.7140E+01,-.3537E+01, .3567E+00, .3722E-01, .1505E-01, .6615E-02, &
& .3722E-01, .1518E-01, .5840E-02, .3720E-01, .1526E-01, .5170E-02, &
& .3399E-01, .1530E-01, .4773E-02, .3012E-01, .1551E-01, .4333E-02, &
& .2625E-01, .1553E-01, .3956E-02, .2240E-01, .1562E-01, .3454E-02, &
& .1846E-01, .1574E-01, .3161E-02, .1446E-01, .1572E-01, .3098E-02, &
& .5924E-02, .8875E-02, .2658E-02, .2204E-01, .7096E-02, .2504E-02, &
& .1591E-01, .5233E-02, .2292E-02, .8855E-02, .4249E-02, .2190E-02, &
& .5422E-02, .3496E-02, .2041E-02, .4919E-02, .3621E-02, .2200E-02, &
& .6657E-02, .3663E-02, .2248E-02, .8645E-02, .3852E-02, .2118E-02, &
& .8771E-02, .3873E-02, .2176E-02, .9043E-02, .3747E-02, .2079E-02, &
&-.1568E-03,-.4681E-04, .4567E-05,-.1568E-03,-.4605E-04,-.3425E-05, &
&-.1572E-03,-.4605E-04,-.1104E-04,-.2154E-03,-.4453E-04,-.6851E-05, &
&-.2843E-03,-.4225E-04,-.7231E-05,-.3562E-03,-.4110E-04,-.7231E-05, &
&-.3692E-03,-.4110E-04,-.1028E-04,-.3007E-03,-.4263E-04,-.6470E-05, &
&-.2325E-03,-.3996E-04,-.8373E-05,-.5290E-04,-.7612E-05,-.4948E-05, &
&-.7422E-04,-.1256E-04,-.8449E-05,-.3501E-04,-.1446E-04,-.4834E-05, &
& .4529E-04,-.2246E-04,-.2893E-05, .6470E-05,-.1789E-04,-.7498E-05, &
&-.4948E-05,-.1713E-04,-.8183E-05,-.5481E-04,-.1713E-04,-.1447E-04, &
&-.4986E-04,-.1903E-04,-.1353E-04,-.5138E-04,-.1484E-04,-.1147E-04, &
&-.5328E-04,-.1560E-04,-.6588E-05/
data ( ( coeno_8_new(k,j), j = 1, 19 ), k = 1, 3 ) / &
&-.1164E+02,-.1119E+02,-.1074E+02,-.1030E+02,-.9853E+01,-.9400E+01, &
&-.8947E+01,-.8497E+01,-.8044E+01,-.7594E+01,-.7142E+01,-.6689E+01, &
&-.6245E+01,-.5808E+01,-.5399E+01,-.4998E+01,-.4544E+01,-.4134E+01, &
&-.3773E+01,0.4822E-02,0.4864E-02,0.4915E-02,0.4985E-02,0.5089E-02, &
&0.5150E-02,0.5189E-02,0.5210E-02,0.5268E-02,0.5291E-02,0.5348E-02, &
&0.5368E-02,0.5450E-02,0.5606E-02,0.5740E-02,0.6009E-02,0.6353E-02, &
&0.6841E-02,0.7601E-02,-.3353E-04,-.3355E-04,-.3262E-04,-.3182E-04, &
&-.3045E-04,-.3080E-04,-.3168E-04,-.3100E-04,-.3167E-04,-.3193E-04, &
&-.3146E-04,-.3226E-04,-.3289E-04,-.3499E-04,-.3260E-04,-.3156E-04, &
&-.3860E-04,-.4087E-04,-.4527E-04/
! block data ckd9_new
!c *********************************************************************
!c hk is the interval in the g (cumulative probability) space from 0
!c to one. coeh2o is the coefficient to calculate the H2O absorption
!c coefficient in units of (cm-atm)**-1 at there temperatures, nine-
!c teen pressures, and four cumulative probabilities ( Fu, 1991 ).
!c The spectral region is from 1700 to 1400 cm**-1.
!c *********************************************************************
! common /band9_new/ hk(4), coeh2o(3,19,4),coeno2(3,19)
real hk_9_new(4), coeh2o_9_new(3,19,4),coeno2_9_new(3,19)
data hk_9_new / 0.22, 0.51, 0.22, 0.05 /
data ( ( ( coeh2o_9_new(k,j,i), i = 1, 4 ), j = 1, 19), k = 1, 3)/ &
&-.2066E+02,-.1464E+02,-.8301E+01,-.3548E+01,-.2025E+02,-.1419E+02, &
&-.7905E+01,-.3260E+01,-.2019E+02,-.1374E+02,-.7495E+01,-.2927E+01, &
&-.2013E+02,-.1329E+02,-.7078E+01,-.2584E+01,-.2007E+02,-.1284E+02, &
&-.6675E+01,-.2247E+01,-.2001E+02,-.1239E+02,-.6268E+01,-.1890E+01, &
&-.1996E+02,-.1194E+02,-.5853E+01,-.1530E+01,-.1991E+02,-.1150E+02, &
&-.5441E+01,-.1133E+01,-.1987E+02,-.1105E+02,-.5022E+01,-.7447E+00, &
&-.1575E+02,-.9657E+01,-.4191E+01,-.3728E+00,-.1329E+02,-.8133E+01, &
&-.3638E+01, .1616E-01,-.1181E+02,-.6675E+01,-.3178E+01, .4083E+00, &
&-.1036E+02,-.5655E+01,-.2731E+01, .7953E+00,-.8628E+01,-.4990E+01, &
&-.2303E+01, .1153E+01,-.7223E+01,-.4453E+01,-.1877E+01, .1454E+01, &
&-.6567E+01,-.3974E+01,-.1461E+01, .1663E+01,-.6077E+01,-.3551E+01, &
&-.1071E+01, .1800E+01,-.5651E+01,-.3136E+01,-.7005E+00, .1809E+01, &
&-.5241E+01,-.2726E+01,-.3859E+00, .1781E+01, .1315E-01, .4542E-02, &
& .3496E-02, .4877E-02, .9650E-02, .4542E-02, .3098E-02, .3956E-02, &
& .6154E-02, .4626E-02, .2763E-02, .3077E-02, .2658E-02, .4626E-02, &
& .2512E-02, .2261E-02, .2658E-02, .4689E-02, .2219E-02, .1405E-02, &
& .2700E-02, .4752E-02, .1926E-02, .7473E-03, .2658E-02, .4773E-02, &
& .1737E-02, .5066E-03, .4668E-02, .4815E-02, .1507E-02, .1842E-03, &
& .8541E-02, .4794E-02, .1382E-02,-.2156E-03, .1022E-01, .2198E-02, &
& .3977E-03,-.2910E-03, .5484E-02, .6698E-03, .0000E+00,-.2339E-03, &
& .3349E-02, .1068E-02,-.2512E-03,-.4228E-03, .1884E-02, .2093E-03, &
&-.3977E-03,-.6405E-03,-.8373E-04,-.5233E-03,-.4124E-03,-.5945E-03, &
& .7536E-03,-.6698E-03,-.4919E-03,-.4794E-03, .3600E-02,-.4605E-03, &
&-.4375E-03,-.3517E-03, .3873E-02,-.5861E-03,-.3203E-03,-.4689E-03, &
& .3935E-02,-.7326E-03,-.2072E-03,-.4228E-03, .4124E-02,-.8582E-03, &
&-.4187E-04,-.5945E-03,-.8525E-04, .1865E-04,-.1142E-05, .2664E-05, &
&-.1313E-03, .1865E-04, .0000E+00, .1256E-04,-.6470E-04, .1865E-04, &
&-.3045E-05, .8754E-05, .3805E-06, .1789E-04,-.6851E-05, .5328E-05, &
& .1142E-05, .1827E-04,-.6090E-05, .4148E-05, .1142E-05, .1865E-04, &
&-.3806E-05,-.3768E-05,-.1903E-05, .1751E-04,-.4948E-05, .3121E-05, &
& .3159E-04, .1979E-04,-.3045E-05,-.9896E-06, .1005E-03, .1789E-04, &
&-.6089E-05,-.1865E-05,-.2207E-04, .1941E-04, .1903E-05, .2322E-05, &
&-.1675E-04, .6090E-05,-.7611E-06, .4397E-05, .3425E-04, .3806E-06, &
& .1522E-05, .3806E-05, .4796E-04, .1522E-05,-.3806E-06, .3654E-05, &
&-.6851E-05, .2664E-05,-.3920E-05,-.6850E-06,-.1370E-04, .5328E-05, &
&-.6584E-05,-.8716E-05,-.8374E-10, .1522E-05,-.6356E-05, .1294E-05, &
&-.9515E-05, .7612E-06,-.3235E-05,-.1066E-05,-.7612E-05, .1142E-05, &
&-.4529E-05, .3730E-05,-.2664E-05,-.3806E-06,-.3501E-05,-.5328E-06/
data ( ( coeno2_9_new(k,j), j = 1, 19 ), k = 1, 3 ) / &
&-.9663E+01,-.9349E+01,-.9029E+01,-.8713E+01,-.8379E+01,-.8038E+01, &
&-.7698E+01,-.7371E+01,-.7058E+01,-.6777E+01,-.6518E+01,-.6299E+01, &
&-.6124E+01,-.6005E+01,-.5938E+01,-.5904E+01,-.5890E+01,-.5868E+01, &
&-.5853E+01,0.2549E-01,0.2453E-01,0.2346E-01,0.2252E-01,0.2161E-01, &
&0.2069E-01,0.1963E-01,0.1875E-01,0.1790E-01,0.1709E-01,0.1646E-01, &
&0.1587E-01,0.1542E-01,0.1501E-01,0.1484E-01,0.1461E-01,0.1466E-01, &
&0.1455E-01,0.1414E-01,-.5673E-04,-.5248E-04,-.4935E-04,-.4199E-04, &
&-.3850E-04,-.3829E-04,-.4200E-04,-.4360E-04,-.4090E-04,-.3483E-04, &
&-.3077E-04,-.2846E-04,-.2721E-04,-.2576E-04,-.2186E-04,-.2060E-04, &
&-.1960E-04,-.2490E-04,-.2946E-04/
! block data ckd10_new
!c *********************************************************************
!c hk is the interval in the g (cumulative probability) space from 0
!c to one. coeh2o is the coefficient to calculate the H2O absorption
!c coefficient in units of (cm-atm)**-1 at there temperatures, nine-
!c teen pressures, and four cumulative probabilities ( Fu, 1991 ).
!c The spectral region is from 1400 to 1250 cm**-1. coech4 and coen2o
!c are the coefficients to calculate the CH4 and N2O absorption coe-
!c fficients in units of (cm-atm)**-1 at three temperature, nineteen
!c pressures, and one cumulative probability (Fu, 1991), respectively.
!c *********************************************************************
! common /band10_new/hk(4), coeh2o(3,19,4), coech4(3,19) &
! ,coen2o(3,19) &
! ,coeso2(3,19)
real hk_10_new(4), coeh2o_10_new(3,19,4), coech4_10_new(3,19) &
& ,coen2o_10_new(3,19) &
& ,coeso2_10_new(3,19)
data hk_10_new / 0.28, 0.42, 0.25, 0.05 /
data ( ( ( coeh2o_10_new(k,j,i), i = 1, 4), j = 1, 19), k = 1, 3)/ &
&-.2023E+02,-.1641E+02,-.1171E+02,-.6090E+01,-.2016E+02,-.1595E+02, &
&-.1133E+02,-.5867E+01,-.2011E+02,-.1550E+02,-.1095E+02,-.5660E+01, &
&-.2005E+02,-.1504E+02,-.1055E+02,-.5407E+01,-.2001E+02,-.1459E+02, &
&-.1015E+02,-.5137E+01,-.1997E+02,-.1413E+02,-.9749E+01,-.4852E+01, &
&-.1993E+02,-.1367E+02,-.9337E+01,-.4534E+01,-.1990E+02,-.1321E+02, &
&-.8920E+01,-.4211E+01,-.1987E+02,-.1276E+02,-.8506E+01,-.3889E+01, &
&-.1645E+02,-.1179E+02,-.7711E+01,-.3613E+01,-.1442E+02,-.1081E+02, &
&-.6942E+01,-.3316E+01,-.1308E+02,-.9950E+01,-.6344E+01,-.2950E+01, &
&-.1212E+02,-.9217E+01,-.5904E+01,-.2577E+01,-.1131E+02,-.8559E+01, &
&-.5519E+01,-.2256E+01,-.1064E+02,-.7962E+01,-.5183E+01,-.1929E+01, &
&-.1013E+02,-.7447E+01,-.4833E+01,-.1643E+01,-.9712E+01,-.7071E+01, &
&-.4485E+01,-.1410E+01,-.9305E+01,-.6760E+01,-.4145E+01,-.1249E+01, &
&-.8966E+01,-.6477E+01,-.3820E+01,-.1114E+01, .7913E-02, .8206E-02, &
& .1509E-01, .1869E-01, .4228E-02, .8247E-02, .1467E-01, .1783E-01, &
& .2010E-02, .8227E-02, .1442E-01, .1687E-01, .1947E-02, .8289E-02, &
& .1394E-01, .1568E-01, .1863E-02, .8289E-02, .1346E-01, .1484E-01, &
& .1842E-02, .8415E-02, .1310E-01, .1400E-01, .1800E-02, .8457E-02, &
& .1275E-01, .1377E-01, .1696E-02, .8478E-02, .1220E-01, .1321E-01, &
& .1842E-02, .8478E-02, .1189E-01, .1250E-01, .1409E-01, .8624E-02, &
& .1254E-01, .1214E-01, .9043E-02, .1045E-01, .1225E-01, .1260E-01, &
& .8561E-02, .1202E-01, .1181E-01, .1296E-01, .1114E-01, .1235E-01, &
& .1191E-01, .1330E-01, .1199E-01, .1271E-01, .1195E-01, .1371E-01, &
& .1415E-01, .1315E-01, .1218E-01, .1361E-01, .1478E-01, .1338E-01, &
& .1296E-01, .1306E-01, .1518E-01, .1375E-01, .1365E-01, .1334E-01, &
& .1530E-01, .1411E-01, .1392E-01, .1327E-01, .1547E-01, .1507E-01, &
& .1390E-01, .1264E-01,-.1089E-03,-.2740E-04,-.2017E-04,-.5519E-04, &
&-.4491E-04,-.2740E-04,-.1408E-04,-.5937E-04,-.6090E-05,-.2702E-04, &
&-.6470E-05,-.4719E-04,-.7232E-05,-.2740E-04,-.6089E-05,-.4910E-04, &
&-.7231E-05,-.2969E-04,-.4186E-05,-.5366E-04,-.6090E-05,-.3045E-04, &
&-.2284E-05,-.4986E-04,-.4568E-05,-.3121E-04,-.4948E-05,-.5100E-04, &
&-.3426E-05,-.3007E-04,-.7993E-05,-.4910E-04, .1522E-05,-.2931E-04, &
&-.9896E-05,-.5366E-04,-.5823E-04,-.1599E-04,-.1713E-04,-.4110E-04, &
&-.3121E-04,-.1713E-04,-.3159E-04,-.3578E-04,-.3996E-04,-.1598E-04, &
&-.3958E-04,-.4605E-04,-.3349E-04,-.1751E-04,-.3844E-04,-.5576E-04, &
&-.2626E-04,-.2474E-04,-.3920E-04,-.4464E-04,-.1979E-04,-.3045E-04, &
&-.3958E-04,-.5336E-04,-.2893E-04,-.3616E-04,-.3996E-04,-.4754E-04, &
&-.2398E-04,-.3083E-04,-.4415E-04,-.5119E-04,-.2702E-04,-.2664E-04, &
&-.4605E-04,-.4038E-04,-.2398E-04,-.2360E-04,-.4948E-04,-.5149E-04/
data ( ( coech4_10_new(k,j), j = 1, 19 ), k = 1, 3 ) / &
&-.8909E+01,-.8464E+01,-.8018E+01,-.7573E+01,-.7133E+01,-.6687E+01, &
&-.6240E+01,-.5803E+01,-.5377E+01,-.4534E+01,-.3983E+01,-.3502E+01, &
&-.3062E+01,-.2648E+01,-.2265E+01,-.1896E+01,-.1568E+01,-.1234E+01, &
&-.9298E+00, .9629E-03, .9838E-03, .1088E-02, .1172E-02, .1256E-02, &
& .1402E-02, .1528E-02, .1633E-02, .1716E-02, .4815E-03,-.3977E-03, &
&-.5652E-03,-.5024E-03,-.4605E-03,-.4563E-03,-.4438E-03,-.4521E-03, &
&-.4312E-03,-.3789E-03,-.1294E-04,-.1408E-04,-.1522E-04,-.1675E-04, &
&-.1751E-04,-.1941E-04,-.2246E-04,-.2207E-04,-.1827E-04,-.1256E-04, &
&-.9515E-05,-.6470E-05,-.3045E-05,-.3806E-05,-.2055E-05,-.3730E-05, &
&-.7612E-06,-.3806E-05, .1256E-05/
data ( ( coen2o_10_new(k,j), j = 1, 19 ), k = 1, 3 ) / &
&-.7863E+01,-.7412E+01,-.6963E+01,-.6514E+01,-.6065E+01,-.5611E+01, &
&-.5167E+01,-.4720E+01,-.4283E+01,-.3454E+01,-.2858E+01,-.2404E+01, &
&-.1922E+01,-.1491E+01,-.1097E+01,-.7177E+00,-.3548E+00, .1218E-01, &
& .3088E+00, .4459E-02, .4542E-02, .4668E-02, .4752E-02, .4815E-02, &
& .4919E-02, .5087E-02, .5254E-02, .5296E-02, .2324E-02, .2093E-02, &
& .2294E-02, .2125E-02, .2058E-02, .1920E-02, .1786E-02, .1689E-02, &
& .1788E-02, .2144E-02,-.7231E-05,-.7231E-05,-.7231E-05,-.6470E-05, &
&-.6851E-05,-.7231E-05,-.5709E-05,-.6470E-05,-.4186E-05, .8754E-05, &
&-.7612E-05,-.9134E-06,-.8640E-05,-.8487E-05,-.8259E-05,-.9553E-05, &
&-.8107E-05,-.1654E-04,-.1858E-04/
data ( ( coeso2_10_new(k,j), j = 1, 19 ), k = 1, 3 ) / &
&-.7207E+01,-.6750E+01,-.6292E+01,-.5835E+01,-.5384E+01,-.4925E+01, &
&-.4473E+01,-.4029E+01,-.3601E+01,-.3191E+01,-.2785E+01,-.2451E+01, &
&-.2170E+01,-.1973E+01,-.1819E+01,-.1732E+01,-.1612E+01,-.1532E+01, &
&-.1394E+01,0.1824E-01,0.1826E-01,0.1828E-01,0.1832E-01,0.1831E-01, &
&0.1837E-01,0.1848E-01,0.1864E-01,0.1885E-01,0.1913E-01,0.1972E-01, &
&0.2057E-01,0.2158E-01,0.2202E-01,0.2255E-01,0.2291E-01,0.2286E-01, &
&0.2112E-01,0.1848E-01,-.1230E-03,-.1229E-03,-.1228E-03,-.1232E-03, &
&-.1222E-03,-.1225E-03,-.1231E-03,-.1238E-03,-.1239E-03,-.1249E-03, &
&-.1298E-03,-.1263E-03,-.1288E-03,-.1230E-03,-.1238E-03,-.1111E-03, &
&-.1067E-03,-.7294E-04,-.4405E-04/
! block data ckd11_new
! *********************************************************************
! hk is the interval in the g (cumulative probability) space from 0
! to one. coeh2o is the coefficient to calculate the H2O absorption
! coefficient in units of (cm-atm)**-1 at there temperatures, nine-
! teen pressures, and three cumulative probabilities ( Fu, 1991 ).
! The spectral region is from 1250 to 1100 cm**-1. coech4 and coen2o
! are the coefficients to calculate the CH4 and N2O absorption coe-
! fficients in units of (cm-atm)**-1 at three temperature, nineteen
! pressures, and one cumulative probability (Fu, 1991), respectively.
! *********************************************************************
real hk_11_new(3), coeh2o_11_new(3,19,3), coech4_11_new(3,19) &
& , coen2o_11_new(3,19) &
& , c11CFC11_11_new, c11CFC12_11_new
data hk_11_new / 0.80, 0.15, 0.05 /
data c11CFC11_11_new / 0.13273E+02 /
data c11CFC12_11_new / 0.19158E+02 /
data ( ( ( coeh2o_11_new(k,j,i), i = 1, 3), j = 1, 19), k = 1, 3)/ &
&-.2005E+02,-.1548E+02,-.1021E+02,-.2001E+02,-.1504E+02,-.1001E+02, &
&-.1997E+02,-.1459E+02,-.9814E+01,-.1993E+02,-.1416E+02,-.9595E+01, &
&-.1989E+02,-.1373E+02,-.9349E+01,-.1985E+02,-.1328E+02,-.9072E+01, &
&-.1982E+02,-.1286E+02,-.8833E+01,-.1957E+02,-.1243E+02,-.8566E+01, &
&-.1911E+02,-.1200E+02,-.8276E+01,-.1743E+02,-.1134E+02,-.7958E+01, &
&-.1625E+02,-.1078E+02,-.7629E+01,-.1524E+02,-.1036E+02,-.7334E+01, &
&-.1429E+02,-.9970E+01,-.7051E+01,-.1348E+02,-.9620E+01,-.6749E+01, &
&-.1282E+02,-.9270E+01,-.6505E+01,-.1229E+02,-.8932E+01,-.6277E+01, &
&-.1186E+02,-.8628E+01,-.6120E+01,-.1148E+02,-.8345E+01,-.6049E+01, &
&-.1112E+02,-.8066E+01,-.5906E+01, .1842E-02, .2131E-01, .3033E-01, &
& .1905E-02, .2137E-01, .2841E-01, .1926E-02, .2135E-01, .2696E-01, &
& .1926E-02, .2133E-01, .2514E-01, .1884E-02, .2154E-01, .2401E-01, &
& .5589E-02, .2156E-01, .2321E-01, .9483E-02, .2156E-01, .2210E-01, &
& .1333E-01, .2150E-01, .2133E-01, .1725E-01, .2154E-01, .2074E-01, &
& .2254E-01, .1999E-01, .2005E-01, .2118E-01, .1926E-01, .1978E-01, &
& .1936E-01, .1920E-01, .1963E-01, .1905E-01, .1911E-01, .1934E-01, &
& .1909E-01, .1903E-01, .1920E-01, .1922E-01, .1901E-01, .1899E-01, &
& .1934E-01, .1930E-01, .1974E-01, .1966E-01, .1909E-01, .2014E-01, &
& .1976E-01, .1905E-01, .1984E-01, .1963E-01, .1940E-01, .1897E-01, &
&-.1522E-05,-.6013E-04,-.5062E-04,-.2665E-05,-.6204E-04,-.5519E-04, &
&-.3806E-05,-.6394E-04,-.5633E-04,-.4567E-05,-.6280E-04,-.5214E-04, &
&-.6090E-05,-.6128E-04,-.5290E-04, .6051E-04,-.6242E-04,-.5823E-04, &
& .1313E-03,-.6013E-04,-.5176E-04, .1336E-03,-.5747E-04,-.4072E-04, &
& .6318E-04,-.5671E-04,-.3996E-04,-.5595E-04,-.3996E-04,-.4263E-04, &
&-.3958E-04,-.4719E-04,-.4453E-04,-.3387E-04,-.5138E-04,-.5100E-04, &
&-.5252E-04,-.4986E-04,-.4491E-04,-.5100E-04,-.4453E-04,-.4529E-04, &
&-.5176E-04,-.4795E-04,-.4453E-04,-.5557E-04,-.5176E-04,-.5062E-04, &
&-.5747E-04,-.4795E-04,-.5633E-04,-.5709E-04,-.4643E-04,-.3806E-04, &
&-.5481E-04,-.5671E-04,-.4948E-04/
data ( ( coech4_11_new(k,j), j = 1, 19 ), k = 1, 3 ) / &
&-.1207E+02,-.1162E+02,-.1116E+02,-.1070E+02,-.1024E+02,-.9777E+01, &
&-.9319E+01,-.8858E+01,-.8398E+01,-.7384E+01,-.6643E+01,-.6081E+01, &
&-.5602E+01,-.5188E+01,-.4822E+01,-.4479E+01,-.4184E+01,-.3884E+01, &
&-.3627E+01, .1036E-01, .1036E-01, .1040E-01, .1040E-01, .1045E-01, &
& .1047E-01, .1049E-01, .1055E-01, .1059E-01, .1059E-01, .1026E-01, &
& .1011E-01, .1024E-01, .1049E-01, .1072E-01, .1089E-01, .1109E-01, &
& .1153E-01, .1191E-01,-.4910E-04,-.4834E-04,-.4910E-04,-.4910E-04, &
&-.4910E-04,-.4872E-04,-.4834E-04,-.4948E-04,-.5100E-04,-.5633E-04, &
&-.6166E-04,-.5595E-04,-.5366E-04,-.5366E-04,-.5328E-04,-.5328E-04, &
&-.4948E-04,-.5519E-04,-.5595E-04/
data ( ( coen2o_11_new(k,j), j = 1, 19 ), k = 1, 3 ) / &
&-.9461E+01,-.9003E+01,-.8543E+01,-.8084E+01,-.7629E+01,-.7166E+01, &
&-.6707E+01,-.6249E+01,-.5793E+01,-.5312E+01,-.4847E+01,-.4393E+01, &
&-.3974E+01,-.3587E+01,-.3231E+01,-.2885E+01,-.2602E+01,-.2358E+01, &
&-.2108E+01, .4710E-02, .4752E-02, .4773E-02, .4773E-02, .4815E-02, &
& .4877E-02, .4898E-02, .4982E-02, .5066E-02, .5296E-02, .5149E-02, &
& .5129E-02, .5024E-02, .4752E-02, .4501E-02, .4270E-02, .4019E-02, &
& .3646E-02, .2759E-02,-.1484E-04,-.1408E-04,-.1446E-04,-.1446E-04, &
&-.1522E-04,-.1560E-04,-.1522E-04,-.1522E-04,-.1598E-04,-.1484E-04, &
&-.9895E-05,-.1028E-04,-.7612E-05,-.1903E-05, .1903E-05, .0000E+00, &
& .2283E-05, .6166E-05,-.2740E-05/
! block data ckd12_new
! *********************************************************************
! hk is the interval in the g (cumulative probability) space from 0
! to one. coeo3 is the coefficient to calculate the ozone absorption
! coefficient in units of (cm-atm)**-1 at there temperatures, nine-
! teen pressures, and five cumulative probabilities ( Fu, 1991 ).
! The spectral region is from 1100 to 980 cm**-1. coeh2o is the
! coefficient to calculate the H2O absorption coefficient in units
! of (cm-atm)**-1 at three temperature, nineteen pressures, and one
! cumulative probability ( Fu, 1991 ).
! *********************************************************************
real hk_12_new(5), coeo3_12_new(3,19,5), coeh2o_12_new(3,19) , &
& c12CFC11_12_new, c12CFC12_12_new
data hk_12_new / 0.45, 0.30, 0.2, 0.04, 0.01 /
data c12CFC11_12_new / 0.13857E+02 /
data c12CFC12_12_new / 0.96058E+01 /
data ( ( ( coeo3_12_new(k,j,i), i = 1, 5 ), j = 1, 19), k = 1, 3)/ &
&-.6590E+01,-.3912E+01,-.8513E+00, .2731E+01, .5515E+01,-.6157E+01, &
&-.3583E+01,-.7292E+00, .2740E+01, .5508E+01,-.5731E+01,-.3242E+01, &
&-.5800E+00, .2782E+01, .5485E+01,-.5301E+01,-.2901E+01,-.4131E+00, &
& .2805E+01, .5455E+01,-.4879E+01,-.2551E+01,-.2288E+00, .2878E+01, &
& .5416E+01,-.4449E+01,-.2201E+01,-.2228E-01, .3000E+01, .5374E+01, &
&-.4018E+01,-.1843E+01, .2055E+00, .3143E+01, .5342E+01,-.3615E+01, &
&-.1502E+01, .4561E+00, .3288E+01, .5204E+01,-.3228E+01,-.1172E+01, &
& .7099E+00, .3396E+01, .5077E+01,-.2828E+01,-.8499E+00, .9664E+00, &
& .3463E+01, .4893E+01,-.2480E+01,-.5393E+00, .1229E+01, .3493E+01, &
& .4656E+01,-.2181E+01,-.2653E+00, .1504E+01, .3456E+01, .4398E+01, &
&-.1950E+01,-.1469E-01, .1735E+01, .3387E+01, .4115E+01,-.1788E+01, &
& .2517E+00, .1919E+01, .3251E+01, .3832E+01,-.1677E+01, .5027E+00, &
& .2032E+01, .3088E+01, .3581E+01,-.1637E+01, .7373E+00, .2100E+01, &
& .2910E+01, .3364E+01,-.1650E+01, .9383E+00, .2123E+01, .2793E+01, &
& .3150E+01,-.1658E+01, .1091E+01, .2112E+01, .2683E+01, .3021E+01, &
&-.1654E+01, .1163E+01, .2099E+01, .2602E+01, .2871E+01, .9498E-02, &
& .8894E-02, .1161E-01, .8828E-02,-.1669E-02, .9613E-02, .8347E-02, &
& .1053E-01, .8462E-02,-.1612E-02, .9700E-02, .7829E-02, .9101E-02, &
& .7915E-02,-.1439E-02, .9815E-02, .7167E-02, .7981E-02, .7282E-02, &
&-.1094E-02, .9671E-02, .6764E-02, .6930E-02, .5613E-02,-.8347E-03, &
& .9613E-02, .6312E-02, .6225E-02, .4145E-02,-.1295E-02, .9728E-02, &
& .6099E-02, .5293E-02, .2965E-02,-.1756E-02, .9844E-02, .5915E-02, &
& .4496E-02, .1871E-02,-.2044E-02, .9930E-02, .5817E-02, .3509E-02, &
& .1324E-02,-.2044E-02, .9988E-02, .5535E-02, .2711E-02, .6620E-03, &
&-.1813E-02, .1034E-01, .5247E-02, .1926E-02,-.2303E-03,-.1842E-02, &
& .1058E-01, .4795E-02, .1197E-02,-.9498E-03,-.2216E-02, .1084E-01, &
& .4414E-02, .6188E-03,-.1123E-02,-.2303E-02, .1079E-01, .3926E-02, &
& .1756E-03,-.1497E-02,-.2274E-02, .1039E-01, .3425E-02,-.1900E-03, &
&-.1353E-02,-.2389E-02, .9815E-02, .2769E-02,-.6620E-03,-.1756E-02, &
&-.1785E-02, .9818E-02, .2444E-02,-.1016E-02,-.1410E-02,-.1698E-02, &
& .1074E-01, .3218E-02,-.1235E-02,-.1900E-02,-.2533E-02, .1145E-01, &
& .3684E-02,-.1364E-02,-.1353E-02,-.1957E-02,-.4030E-04,-.2375E-04, &
&-.3814E-05,-.4943E-04,-.3166E-04,-.3742E-04,-.1871E-04,-.1137E-04, &
&-.4317E-04,-.2878E-04,-.3526E-04,-.2015E-04,-.1295E-04,-.4821E-04, &
&-.2303E-04,-.3382E-04,-.2087E-04,-.1519E-04,-.2231E-04,-.1871E-04, &
&-.3454E-04,-.2087E-04,-.8109E-05,-.6476E-05,-.1511E-04,-.3454E-04, &
&-.1820E-04,-.1269E-05,-.1439E-04,-.5037E-05,-.4173E-04,-.2598E-04, &
& .6645E-05,-.1943E-04,-.2087E-04,-.3454E-04,-.2267E-04, .2159E-05, &
&-.2231E-04,-.2159E-05,-.2950E-04,-.2080E-04, .2159E-06,-.4317E-05, &
& .1799E-04,-.3670E-04,-.1590E-04,-.4461E-05,-.9354E-05,-.3598E-05, &
&-.3216E-04,-.1475E-04,-.2231E-05,-.1295E-04,-.2878E-05,-.3576E-04, &
&-.7347E-05,-.1022E-04,-.2159E-05,-.7915E-05,-.3015E-04,-.5230E-05, &
&-.5109E-05,-.6476E-05,-.7196E-05,-.2331E-04,-.1079E-04,-.4102E-05, &
& .1439E-05,-.1223E-04,-.2216E-04,-.1094E-04,-.5325E-05,-.7196E-06, &
&-.1655E-04,-.1036E-04,-.7627E-05,-.2878E-05, .5037E-05,-.1295E-04, &
& .1029E-04,-.1346E-04,-.4821E-05,-.7915E-05, .7915E-05, .2835E-04, &
&-.2893E-04,-.1367E-05,-.7196E-05,-.1871E-04, .3965E-04,-.3310E-04, &
&-.3310E-05,-.7195E-06, .2303E-04/
data ( ( coeh2o_12_new(k,j), j = 1, 19 ), k = 1, 3 ) / &
&-.1984E+02,-.1983E+02,-.1982E+02,-.1981E+02,-.1963E+02,-.1917E+02, &
&-.1871E+02,-.1825E+02,-.1779E+02,-.1639E+02,-.1545E+02,-.1484E+02, &
&-.1433E+02,-.1387E+02,-.1345E+02,-.1305E+02,-.1268E+02,-.1231E+02, &
&-.1196E+02, .6071E-03, .2072E-02, .6196E-02, .1030E-01, .1436E-01, &
& .1846E-01, .2259E-01, .2667E-01, .2993E-01, .2878E-01, .2803E-01, &
& .2851E-01, .2864E-01, .2874E-01, .2862E-01, .2859E-01, .2853E-01, &
& .2868E-01, .2887E-01,-.3808E-06, .2474E-04, .9895E-04, .1728E-03, &
& .1911E-03, .1165E-03, .4225E-04,-.3121E-04,-.8982E-04,-.9553E-04, &
&-.9705E-04,-.9591E-04,-.9287E-04,-.9172E-04,-.9096E-04,-.9134E-04, &
&-.9248E-04,-.1050E-03,-.1031E-03/
! block data ckd13_new
! *********************************************************************
! hk is the interval in the g (cumulative probability) space from 0
! to one. coeh2o is the coefficient to calculate the H2O absorption
! coefficient in units of (cm-atm)**-1 at there temperatures, nine-
! teen pressures, and two cumulative probabilities ( Fu, 1991 ).
! The spectral region is from 980 to 800 cm**-1.
! *********************************************************************
real hk_13_new(2), coeh2o_13_new(3,19,2) &
& , c13CFC11_13_new, c13CFC12_13_new
data hk_13_new / 0.95, 0.05 /
data c13CFC11_13_new / 0.38552E+01 /
data c13CFC12_13_new / 0.84634E+01 /
data ( ( ( coeh2o_13_new(k,j,i), i = 1, 2), j = 1, 19), k = 1, 3)/ &
&-.1992E+02,-.1446E+02,-.1992E+02,-.1405E+02,-.1991E+02,-.1363E+02, &
&-.1990E+02,-.1322E+02,-.1989E+02,-.1282E+02,-.1989E+02,-.1242E+02, &
&-.1988E+02,-.1201E+02,-.1987E+02,-.1159E+02,-.1986E+02,-.1119E+02, &
&-.1982E+02,-.1079E+02,-.1817E+02,-.1039E+02,-.1659E+02,-.1000E+02, &
&-.1537E+02,-.9623E+01,-.1460E+02,-.9266E+01,-.1406E+02,-.8959E+01, &
&-.1354E+02,-.8676E+01,-.1309E+02,-.8411E+01,-.1267E+02,-.8232E+01, &
&-.1229E+02,-.8094E+01, .5024E-03, .3199E-01, .5652E-03, .3199E-01, &
& .6071E-03, .3211E-01, .6489E-03, .3199E-01, .6699E-03, .3178E-01, &
& .6908E-03, .3157E-01, .6908E-03, .3109E-01, .6698E-03, .3075E-01, &
& .6698E-03, .3054E-01, .1474E-01, .3000E-01, .3085E-01, .2960E-01, &
& .3659E-01, .2935E-01, .3016E-01, .2920E-01, .2834E-01, .2895E-01, &
& .2780E-01, .2870E-01, .2753E-01, .2843E-01, .2755E-01, .2820E-01, &
& .2765E-01, .2732E-01, .2769E-01, .2705E-01, .6299E-09,-.7993E-04, &
&-.3802E-06,-.7992E-04,-.3802E-06,-.8525E-04,-.3808E-06,-.8449E-04, &
&-.7610E-06,-.7764E-04,-.1142E-05,-.7231E-04,-.1142E-05,-.7345E-04, &
&-.2284E-05,-.8259E-04,-.2284E-05,-.8031E-04, .2436E-03,-.7878E-04, &
& .7612E-05,-.8525E-04,-.1248E-03,-.9439E-04,-.9477E-04,-.9172E-04, &
&-.8982E-04,-.8640E-04,-.7916E-04,-.6813E-04,-.7574E-04,-.6090E-04, &
&-.7612E-04,-.7117E-04,-.7498E-04,-.7041E-04,-.7269E-04,-.7992E-04/
! block data ckd14_new
! **********************************************************************
! hk is the interval in the g (cumulative probability) space from 0
! to one. coehca and coehcb are the coefficients to calculate the
! H2O and CO2 overlapping absorption coefficients in units of (cm-
! atm)**-1 at three temperature, nineteen pressures, and ten cumu-
! lative probabilities (Fu, 1991). The spectral region is from 800
! to 670 cm**-1.
! **********************************************************************
real hk_14_new(10), coehca_14_new(3,19,10), coehcb_14_new(3,19,10) &
& ,coech3cl_14_new(3,19)
data hk_14_new / .3,.3,.2,.12,.06,.012,.004,.0025,.0011,.0004 /
data ( ( (coehca_14_new(k,j,i), i = 1, 10), j = 1, 19), k = 1, 3)/ &
&-.1847E+02,-.1399E+02,-.1106E+02,-.8539E+01,-.5852E+01,-.3295E+01, &
&-.1208E+01,-.6272E-01, .2055E+01, .6071E+01,-.1801E+02,-.1357E+02, &
&-.1067E+02,-.8171E+01,-.5562E+01,-.3071E+01,-.1073E+01, .1033E+00, &
& .2055E+01, .6071E+01,-.1755E+02,-.1314E+02,-.1027E+02,-.7798E+01, &
&-.5224E+01,-.2823E+01,-.9280E+00, .2723E+00, .2165E+01, .5969E+01, &
&-.1709E+02,-.1272E+02,-.9868E+01,-.7404E+01,-.4880E+01,-.2569E+01, &
&-.6908E+00, .4453E+00, .2241E+01, .5969E+01,-.1663E+02,-.1230E+02, &
&-.9467E+01,-.7013E+01,-.4535E+01,-.2297E+01,-.4408E+00, .6353E+00, &
& .2359E+01, .5969E+01,-.1617E+02,-.1188E+02,-.9050E+01,-.6619E+01, &
&-.4160E+01,-.1967E+01,-.1687E+00, .8213E+00, .2421E+01, .5969E+01, &
&-.1571E+02,-.1147E+02,-.8629E+01,-.6230E+01,-.3771E+01,-.1648E+01, &
& .1573E+00, .1019E+01, .2511E+01, .5884E+01,-.1525E+02,-.1106E+02, &
&-.8215E+01,-.5841E+01,-.3393E+01,-.1331E+01, .4013E+00, .1198E+01, &
& .2654E+01, .5794E+01,-.1480E+02,-.1066E+02,-.7800E+01,-.5454E+01, &
&-.3032E+01,-.9870E+00, .6323E+00, .1373E+01, .2905E+01, .5647E+01, &
&-.1402E+02,-.9693E+01,-.7206E+01,-.4846E+01,-.2656E+01,-.6540E+00, &
& .8323E+00, .1530E+01, .3211E+01, .5355E+01,-.1343E+02,-.9060E+01, &
&-.6596E+01,-.4399E+01,-.2294E+01,-.3519E+00, .9823E+00, .1673E+01, &
& .3420E+01, .5083E+01,-.1279E+02,-.8611E+01,-.5785E+01,-.4010E+01, &
&-.1936E+01,-.1177E+00, .1134E+01, .1974E+01, .3591E+01, .4770E+01, &
&-.1230E+02,-.8174E+01,-.5298E+01,-.3611E+01,-.1607E+01, .3636E-01, &
& .1433E+01, .2260E+01, .3539E+01, .4439E+01,-.1192E+02,-.7763E+01, &
&-.4946E+01,-.3228E+01,-.1321E+01, .1991E+00, .1720E+01, .2420E+01, &
& .3383E+01, .4041E+01,-.1154E+02,-.7377E+01,-.4576E+01,-.2851E+01, &
&-.1093E+01, .4430E+00, .1896E+01, .2462E+01, .3122E+01, .3620E+01, &
&-.1118E+02,-.7003E+01,-.4210E+01,-.2524E+01,-.8973E+00, .7490E+00, &
& .1966E+01, .2363E+01, .2818E+01, .3182E+01,-.1080E+02,-.6677E+01, &
&-.3872E+01,-.2264E+01,-.6846E+00, .9392E+00, .1867E+01, .2138E+01, &
& .2505E+01, .2738E+01,-.1031E+02,-.6353E+01,-.3596E+01,-.1938E+01, &
&-.4537E+00, .1015E+01, .1659E+01, .1830E+01, .2142E+01, .2287E+01, &
&-.9695E+01,-.5977E+01,-.3427E+01,-.1596E+01,-.1979E+00, .9458E+00, &
& .1363E+01, .1545E+01, .1743E+01, .1832E+01, .3628E-01, .2728E-01, &
& .2213E-01, .1656E-01, .1507E-01, .1564E-01, .1623E-01, .1419E-01, &
& .1455E-01, .1089E-02, .3632E-01, .2740E-01, .2164E-01, .1606E-01, &
& .1369E-01, .1418E-01, .1444E-01, .1275E-01, .1331E-01, .9210E-03, &
& .3636E-01, .2746E-01, .2114E-01, .1557E-01, .1239E-01, .1285E-01, &
& .1237E-01, .1141E-01, .1141E-01, .9210E-03, .3640E-01, .2748E-01, &
& .2064E-01, .1516E-01, .1141E-01, .1125E-01, .1092E-01, .1026E-01, &
& .1011E-01,-.5652E-03, .3646E-01, .2746E-01, .2024E-01, .1478E-01, &
& .1036E-01, .9688E-02, .9610E-02, .9305E-02, .9399E-02,-.6489E-03, &
& .3651E-01, .2734E-01, .1984E-01, .1438E-01, .9436E-02, .8486E-02, &
& .8214E-02, .8995E-02, .7892E-02,-.8582E-03, .3655E-01, .2723E-01, &
& .1951E-01, .1402E-01, .8716E-02, .7433E-02, .7169E-02, .8072E-02, &
& .5443E-02,-.1172E-02, .3659E-01, .2709E-01, .1911E-01, .1379E-01, &
& .8107E-02, .6818E-02, .6818E-02, .7033E-02, .3056E-02,-.1047E-02, &
& .3670E-01, .2698E-01, .1890E-01, .1363E-01, .7502E-02, .6371E-02, &
& .6558E-02, .6489E-02,-.5652E-03,-.1340E-02, .3592E-01, .2238E-01, &
& .1804E-01, .1007E-01, .6730E-02, .5512E-02, .6194E-02, .4375E-02, &
&-.1109E-02,-.3559E-03, .3609E-01, .2242E-01, .1526E-01, .8582E-02, &
& .6284E-02, .5809E-02, .4501E-02, .9420E-03,-.9001E-03,-.1005E-02, &
& .3703E-01, .2196E-01, .1281E-01, .7860E-02, .5861E-02, .5842E-02, &
& .1800E-02,-.1591E-02,-.1235E-02,-.9420E-03, .3728E-01, .2114E-01, &
& .1347E-01, .6678E-02, .5449E-02, .4837E-02,-.1084E-02,-.1361E-02, &
&-.6699E-03,-.1256E-03, .3683E-01, .2061E-01, .1350E-01, .6133E-02, &
& .5449E-02, .2111E-02,-.1386E-02,-.1235E-02,-.5652E-03,-.8373E-04, &
& .3656E-01, .1988E-01, .1348E-01, .5441E-02, .5149E-02,-.8813E-03, &
&-.1116E-02,-.8373E-03,-.3140E-03,-.6280E-04, .3669E-01, .1934E-01, &
& .1363E-01, .5035E-02, .3585E-02,-.1250E-02,-.9357E-03,-.8227E-03, &
&-.3140E-03,-.4187E-04, .3618E-01, .1856E-01, .1390E-01, .3836E-02, &
& .1470E-02,-.1096E-02,-.8080E-03,-.4480E-03,-.2093E-03,-.2093E-04, &
& .3416E-01, .1741E-01, .1431E-01, .1951E-02,-.2923E-04,-.9422E-03, &
&-.4576E-03,-.2395E-03,-.1565E-03,-.2799E-04, .3219E-01, .1674E-01, &
& .1516E-01, .6652E-03,-.5051E-03,-.7052E-03,-.2002E-03,-.2135E-03, &
&-.7633E-04,-.7300E-04,-.1290E-03,-.9934E-04,-.5595E-04,-.3996E-04, &
& .1294E-04,-.9134E-05, .1294E-05,-.3121E-05,-.4757E-04,-.1979E-04, &
&-.1305E-03,-.9629E-04,-.5481E-04,-.4301E-04, .1827E-04,-.9363E-05, &
& .1777E-04,-.2185E-04,-.1903E-04,-.1675E-04,-.1313E-03,-.9439E-04, &
&-.5404E-04,-.4263E-04, .9134E-05,-.1020E-04, .3524E-04,-.2599E-04, &
&-.2093E-04, .1675E-04,-.1313E-03,-.9172E-04,-.5252E-04,-.4567E-04, &
& .4186E-05,-.3920E-05, .2552E-04,-.2059E-04,-.2246E-04,-.1028E-04, &
&-.1324E-03,-.9210E-04,-.5138E-04,-.4491E-04, .6470E-05,-.2131E-05, &
& .1496E-04,-.1572E-04,-.3311E-04,-.8754E-05,-.1324E-03,-.9058E-04, &
&-.5328E-04,-.4225E-04, .1827E-05,-.8411E-06, .4719E-05,-.6813E-05, &
&-.2474E-04,-.1256E-04,-.1340E-03,-.8868E-04,-.5633E-04,-.4187E-04, &
&-.4415E-05, .6055E-05,-.1648E-04,-.1507E-04, .1979E-04,-.2131E-04, &
&-.1340E-03,-.8373E-04,-.5899E-04,-.3920E-04,-.4072E-05, .1491E-04, &
&-.9781E-05,-.5328E-05, .3578E-04,-.1979E-04,-.1321E-03,-.7954E-04, &
&-.5899E-04,-.4072E-04, .1066E-05, .5728E-05,-.5138E-05,-.8373E-05, &
& .2626E-04,-.2436E-04,-.1363E-03,-.6432E-04,-.5176E-04,-.3083E-04, &
& .2169E-05,-.8944E-05, .3159E-05, .6470E-05,-.4187E-05, .4948E-05, &
&-.1302E-03,-.7802E-04,-.3311E-04,-.1903E-04, .5328E-05,-.1884E-04, &
& .1408E-04, .3311E-04, .1142E-05,-.7613E-06,-.1473E-03,-.6737E-04, &
&-.7536E-04,-.1085E-04,-.1903E-05,-.1458E-04, .4034E-04,-.3941E-10, &
&-.7992E-05, .2664E-05,-.1361E-03,-.5709E-04,-.8550E-04,-.5709E-05, &
&-.8640E-05, .6523E-05, .1903E-05,-.8221E-05,-.3045E-05,-.9134E-05, &
&-.1329E-03,-.5529E-04,-.7107E-04, .2664E-05,-.9020E-05, .3320E-04, &
&-.2131E-05,-.4187E-05,-.7231E-05,-.3806E-05,-.1278E-03,-.5247E-04, &
&-.6465E-04, .3806E-05,-.6091E-05, .1245E-04,-.3844E-05,-.6090E-05, &
&-.8754E-05,-.2664E-05,-.1321E-03,-.5632E-04,-.5897E-04, .1012E-04, &
& .1168E-04,-.4196E-06,-.8411E-05,-.8868E-05,-.1484E-04,-.1522E-05, &
&-.1252E-03,-.4907E-04,-.5932E-04, .3245E-04, .1996E-04,-.3325E-05, &
&-.5785E-05,-.6394E-05,-.6851E-05,-.1142E-05,-.1093E-03,-.4731E-04, &
&-.6761E-04, .1808E-04, .1754E-04,-.5079E-05,-.5809E-05,-.5649E-05, &
&-.3988E-05,-.5849E-06,-.1151E-03,-.4965E-04,-.7163E-04, .7839E-05, &
& .5505E-05,-.6084E-05,-.3344E-05,-.3894E-05,-.1391E-05,-.1327E-05/
data ( ( (coehcb_14_new(k,j,i), i = 1, 10), j = 1, 19), k = 1, 3)/ &
&-.9398E+01,-.5678E+01,-.3606E+01,-.2192E+01, .2104E+01, .3044E+01, &
&-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.9094E+01,-.5422E+01, &
&-.3448E+01,-.1650E+01, .2046E+01, .2749E+01,-.4587E+02,-.4587E+02, &
&-.4587E+02,-.4587E+02,-.8760E+01,-.5270E+01,-.3329E+01,-.1147E+01, &
& .2112E+01, .2709E+01,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
&-.8537E+01,-.5152E+01,-.3129E+01,-.9544E+00, .2254E+01, .2771E+01, &
&-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.8176E+01,-.4936E+01, &
&-.2680E+01,-.9259E+00, .2247E+01,-.4587E+02,-.4587E+02,-.4587E+02, &
&-.4587E+02,-.4587E+02,-.7836E+01,-.4676E+01,-.2378E+01,-.3550E+00, &
& .1396E+01, .1976E+01,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
&-.7419E+01,-.4122E+01,-.2407E+01,-.1204E-01, .1744E+01,-.4587E+02, &
&-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.7124E+01,-.3727E+01, &
&-.2160E+01, .6158E+00, .1953E+01,-.4587E+02,-.4587E+02,-.4587E+02, &
&-.4587E+02,-.4587E+02,-.6823E+01,-.3324E+01,-.1748E+01,-.9806E-01, &
& .2319E+01,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
&-.5957E+01,-.3017E+01,-.1647E+01, .1398E+01,-.4587E+02,-.4587E+02, &
&-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.5115E+01,-.2290E+01, &
&-.5273E+00, .5662E+00, .1459E+01,-.4587E+02,-.4587E+02,-.4587E+02, &
&-.4587E+02,-.4587E+02,-.4162E+01,-.1453E+01, .1116E+00,-.4587E+02, &
& .9569E+00,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
&-.3611E+01,-.9744E+00,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
&-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.3075E+01,-.4176E+00, &
&-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
&-.4587E+02,-.4587E+02,-.3469E+01,-.9395E+00, .5092E+00, .6200E+00, &
&-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
&-.3808E+01,-.1505E+01, .3901E+00, .6264E+00,-.1155E+01,-.4587E+02, &
&-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4058E+01,-.1818E+01, &
& .2693E+00, .7087E+00, .3820E+00,-.4587E+02,-.4587E+02,-.4587E+02, &
&-.4587E+02,-.4587E+02,-.4262E+01,-.2097E+01,-.5711E-01, .5681E+00, &
& .1310E+01, .7371E+00,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
&-.3997E+01,-.1784E+01, .4388E-01, .5167E+00, .6930E+00,-.6906E+00, &
&-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, .2944E-01, .2723E-01, &
& .1854E-01, .2023E-01, .2254E-01, .3059E-02, .4788E+00, .3059E-02, &
& .3059E-02, .3059E-02, .3080E-01, .2549E-01, .1547E-01, .2225E-01, &
& .2107E-01, .3059E-02, .4737E+00, .3059E-02, .3059E-02, .3059E-02, &
& .3269E-01, .2656E-01, .2125E-01, .2179E-01, .2162E-01, .4589E+00, &
& .4643E+00, .3059E-02, .3059E-02, .3059E-02, .3322E-01, .2476E-01, &
& .2075E-01, .2139E-01, .1907E-01, .4501E+00, .4441E+00, .3059E-02, &
& .3059E-02, .3059E-02, .3387E-01, .2182E-01, .2665E-01, .1841E-01, &
& .2506E-01, .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
& .3532E-01, .2091E-01, .1995E-01, .2067E-01, .1949E-01, .4491E+00, &
& .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3468E-01, .2075E-01, &
& .2587E-01, .1401E-01, .8646E-02, .3059E-02, .3059E-02, .3059E-02, &
& .3059E-02, .3059E-02, .3666E-01, .2430E-01, .1919E-01, .2007E-01, &
& .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
& .3613E-01, .2147E-01, .1892E-01, .1361E-01, .3059E-02, .4506E+00, &
& .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3129E-01, .1954E-01, &
& .2442E-01, .1011E-01, .4420E+00, .3059E-02, .3059E-02, .3059E-02, &
& .3059E-02, .3059E-02, .3177E-01, .2101E-01, .1526E-01, .4376E+00, &
& .4379E+00, .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
& .2887E-01, .2044E-01, .1285E-01, .3059E-02,-.4862E-03, .3059E-02, &
& .3059E-02, .3059E-02, .3059E-02, .3059E-02, .2759E-01, .2114E-01, &
& .4303E+00, .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
& .3059E-02, .3059E-02, .2880E-01, .1690E-01,-.4187E+00, .3059E-02, &
& .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
& .2852E-01, .2255E-01, .2184E-01, .4334E+00, .4217E+00, .3059E-02, &
& .3059E-02, .3059E-02, .3059E-02, .3059E-02, .2840E-01, .2136E-01, &
& .1644E-01, .2812E-01, .4358E+00, .4288E+00, .3059E-02, .3059E-02, &
& .3059E-02, .3059E-02, .2809E-01, .2173E-01, .1708E-01, .3346E-01, &
& .4225E-01, .4419E+00, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
& .2702E-01, .2260E-01, .1607E-01, .2720E-01, .3982E-01, .4452E+00, &
& .4365E+00, .4345E+00, .4432E+00, .4623E+00, .2684E-01, .2328E-01, &
& .2099E-01, .3040E-01, .3867E-01, .4389E+00, .3132E-01, .3158E-01, &
& .4083E-01, .4580E+00,-.1581E-03,-.9707E-04,-.1250E-03, .2580E-03, &
& .7378E-04,-.1617E-01, .8646E-02,-.4656E-05,-.4656E-05,-.4656E-05, &
&-.1319E-03,-.9528E-04,-.1710E-03, .7118E-04, .2076E-04,-.1608E-01, &
& .8552E-02,-.4656E-05,-.4656E-05,-.4656E-05,-.1721E-03,-.4680E-04, &
&-.5522E-04,-.6242E-04, .4517E-04,-.7777E-02, .8382E-02,-.4656E-05, &
&-.4656E-05,-.4656E-05,-.1482E-03,-.4208E-04,-.5216E-04,-.6514E-04, &
&-.8378E-04,-.7956E-02, .8013E-02,-.4656E-05,-.4656E-05,-.4656E-05, &
&-.1501E-03,-.4002E-04,-.1664E-03, .2272E-04,-.1888E-03,-.4656E-05, &
&-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.1201E-03,-.4709E-04, &
&-.5371E-04,-.1574E-03, .1854E-03,-.7712E-02,-.4656E-05,-.4656E-05, &
&-.4656E-05,-.4656E-05,-.1333E-03,-.1062E-03, .5785E-04,-.4150E-04, &
&-.5717E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
&-.1212E-03,-.8524E-04,-.5895E-04,-.2884E-03,-.1581E-01,-.4656E-05, &
&-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.8148E-04,-.9361E-04, &
&-.2873E-03, .1883E-03,-.1594E-01, .8133E-02,-.4656E-05,-.4656E-05, &
&-.4656E-05,-.4656E-05,-.1221E-03,-.1430E-04, .6335E-04,-.2581E-03, &
& .7977E-02,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
&-.9257E-04,-.5008E-04, .6389E-04,-.7455E-02,-.7745E-02,-.4656E-05, &
&-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.1186E-03,-.9037E-04, &
&-.7461E-04,-.4656E-05, .1168E-03,-.4656E-05,-.4656E-05,-.4656E-05, &
&-.4656E-05,-.4656E-05,-.8513E-04,-.5708E-04, .7763E-02,-.4656E-05, &
&-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
&-.1124E-03,-.1228E-03, .7663E-02,-.4656E-05,-.4656E-05,-.4656E-05, &
&-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.1015E-03,-.8369E-04, &
&-.2167E-03,-.7548E-02, .7608E-02,-.4656E-05,-.4656E-05,-.4656E-05, &
&-.4656E-05,-.4656E-05,-.1049E-03,-.6414E-04,-.1384E-03,-.1644E-03, &
&-.6919E-02, .7736E-02,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
&-.1008E-03,-.7047E-04,-.1276E-03,-.2445E-03,-.1860E-03, .7975E-02, &
&-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.9629E-04,-.1007E-03, &
&-.1127E-03,-.1527E-03,-.3238E-03,-.7373E-02, .7877E-02, .7840E-02, &
& .7997E-02, .8345E-02,-.8800E-04,-.1072E-03,-.1046E-03,-.1777E-03, &
&-.2146E-03,-.7016E-02, .1516E-01, .1532E-01, .1509E-01, .8268E-02/
data ( ( coech3cl_14_new(k,j), j = 1, 19 ), k = 1, 3 ) / &
&-.8278E+01,-.7818E+01,-.7357E+01,-.6897E+01,-.6439E+01,-.5976E+01, &
&-.5516E+01,-.5056E+01,-.4597E+01,-.4151E+01,-.3704E+01,-.3283E+01, &
&-.2888E+01,-.2545E+01,-.2263E+01,-.2015E+01,-.1785E+01,-.1572E+01, &
&-.1400E+01,0.4800E-02,0.4797E-02,0.4798E-02,0.4798E-02,0.4785E-02, &
&0.4801E-02,0.4802E-02,0.4831E-02,0.4874E-02,0.4964E-02,0.5198E-02, &
&0.5691E-02,0.6425E-02,0.7134E-02,0.7507E-02,0.7846E-02,0.7890E-02, &
&0.7674E-02,0.7747E-02,-.3590E-04,-.3585E-04,-.3560E-04,-.3570E-04, &
&-.3594E-04,-.3607E-04,-.3620E-04,-.3644E-04,-.3774E-04,-.3753E-04, &
&-.4034E-04,-.4465E-04,-.5313E-04,-.5958E-04,-.6406E-04,-.6210E-04, &
&-.5871E-04,-.6018E-04,-.5777E-04/
! block data ckd15_new
! **********************************************************************
! hk is the interval in the g (cumulative probability) space from 0
! to one. coehca and coehcb are the coefficients to calculate the
! H2O and CO2 overlapping absorption coefficients in units of (cm-
! atm)**-1 at three temperatures, nineteen pressures, and 12 cumu-
! lative probabilities (Fu, 1991). The spectral region is from 670
! to 540 cm**-1.
! **********************************************************************
real hk_15_new(12), coehca_15_new(3,19,12), coehcb_15_new(3,19,12)
data hk_15_new /.24,.36,.18,.1,.05,.02,.016,.012,.01 &
& ,.006,.0039,.0021/
data ( ( (coehca_15_new(k,j,i), i = 1, 12), j = 1, 19), k = 1, 2)/ &
&-.1921E+02,-.1363E+02,-.1080E+02,-.8392E+01,-.6776E+01,-.5696E+01, &
&-.4572E+01,-.3752E+01,-.2382E+01,-.1110E+01, .6803E+00, .3259E+01, &
&-.1875E+02,-.1321E+02,-.1040E+02,-.8026E+01,-.6449E+01,-.5401E+01, &
&-.4316E+01,-.3498E+01,-.2141E+01,-.9439E+00, .8103E+00, .3314E+01, &
&-.1829E+02,-.1278E+02,-.1000E+02,-.7646E+01,-.6089E+01,-.5085E+01, &
&-.4047E+01,-.3217E+01,-.1872E+01,-.7106E+00, .9573E+00, .3390E+01, &
&-.1783E+02,-.1236E+02,-.9596E+01,-.7264E+01,-.5735E+01,-.4740E+01, &
&-.3743E+01,-.2882E+01,-.1587E+01,-.4714E+00, .1120E+01, .3425E+01, &
&-.1737E+02,-.1195E+02,-.9193E+01,-.6877E+01,-.5371E+01,-.4404E+01, &
&-.3405E+01,-.2574E+01,-.1298E+01,-.1747E+00, .1327E+01, .3547E+01, &
&-.1691E+02,-.1153E+02,-.8776E+01,-.6490E+01,-.4993E+01,-.4049E+01, &
&-.3039E+01,-.2256E+01,-.1012E+01, .1103E+00, .1530E+01, .3651E+01, &
&-.1644E+02,-.1112E+02,-.8360E+01,-.6105E+01,-.4623E+01,-.3688E+01, &
&-.2694E+01,-.1915E+01,-.6855E+00, .3993E+00, .1714E+01, .3950E+01, &
&-.1598E+02,-.1073E+02,-.7943E+01,-.5723E+01,-.4236E+01,-.3314E+01, &
&-.2338E+01,-.1596E+01,-.3583E+00, .6963E+00, .1868E+01, .4127E+01, &
&-.1553E+02,-.1034E+02,-.7542E+01,-.5357E+01,-.3856E+01,-.2942E+01, &
&-.1986E+01,-.1299E+01,-.5472E-01, .9443E+00, .2149E+01, .4261E+01, &
&-.1485E+02,-.9661E+01,-.7008E+01,-.4830E+01,-.3458E+01,-.2566E+01, &
&-.1658E+01,-.9639E+00, .2083E+00, .1182E+01, .2458E+01, .4452E+01, &
&-.1427E+02,-.9166E+01,-.6373E+01,-.4404E+01,-.3073E+01,-.2209E+01, &
&-.1349E+01,-.6648E+00, .4023E+00, .1452E+01, .2739E+01, .4466E+01, &
&-.1380E+02,-.8726E+01,-.5772E+01,-.3982E+01,-.2732E+01,-.1874E+01, &
&-.1052E+01,-.4403E+00, .5763E+00, .1792E+01, .2999E+01, .4335E+01, &
&-.1305E+02,-.8270E+01,-.5304E+01,-.3586E+01,-.2392E+01,-.1568E+01, &
&-.8299E+00,-.2650E+00, .8584E+00, .2062E+01, .3141E+01, .4168E+01, &
&-.1269E+02,-.7900E+01,-.4956E+01,-.3205E+01,-.2065E+01,-.1332E+01, &
&-.6415E+00,-.7921E-01, .1170E+01, .2269E+01, .3198E+01, .4066E+01, &
&-.1227E+02,-.7536E+01,-.4576E+01,-.2859E+01,-.1815E+01,-.1139E+01, &
&-.4520E+00, .2272E+00, .1371E+01, .2351E+01, .3150E+01, .3935E+01, &
&-.1186E+02,-.7159E+01,-.4223E+01,-.2538E+01,-.1619E+01,-.9324E+00, &
&-.1566E+00, .5151E+00, .1520E+01, .2339E+01, .3132E+01, .3880E+01, &
&-.1120E+02,-.6777E+01,-.3919E+01,-.2330E+01,-.1387E+01,-.6737E+00, &
& .1108E+00, .6991E+00, .1531E+01, .2163E+01, .3150E+01, .3767E+01, &
&-.9973E+01,-.6279E+01,-.3638E+01,-.2048E+01,-.1098E+01,-.4407E+00, &
& .3043E+00, .7797E+00, .1424E+01, .2002E+01, .3122E+01, .3611E+01, &
&-.8483E+01,-.5607E+01,-.3357E+01,-.1744E+01,-.8884E+00,-.2264E+00, &
& .3800E+00, .7504E+00, .1245E+01, .2032E+01, .3097E+01, .3546E+01, &
& .3762E-01, .2372E-01, .1643E-01, .1208E-01, .1170E-01, .1164E-01, &
& .1214E-01, .1161E-01, .1028E-01, .9185E-02, .7712E-02, .1001E-01, &
& .3762E-01, .2382E-01, .1593E-01, .1145E-01, .1059E-01, .1049E-01, &
& .1080E-01, .1057E-01, .8894E-02, .7807E-02, .7132E-02, .1032E-01, &
& .3764E-01, .2386E-01, .1555E-01, .1080E-01, .9692E-02, .9231E-02, &
& .9585E-02, .9644E-02, .7711E-02, .6443E-02, .6223E-02, .9922E-02, &
& .3764E-01, .2395E-01, .1516E-01, .1028E-01, .8917E-02, .8415E-02, &
& .8457E-02, .8777E-02, .6436E-02, .5428E-02, .5499E-02, .8017E-02, &
& .3768E-01, .2399E-01, .1482E-01, .9692E-02, .8247E-02, .7640E-02, &
& .7582E-02, .7783E-02, .5432E-02, .4482E-02, .4919E-02, .5903E-02, &
& .3770E-01, .2401E-01, .1449E-01, .9252E-02, .7620E-02, .6678E-02, &
& .6845E-02, .6925E-02, .4939E-02, .3471E-02, .4124E-02, .3873E-02, &
& .3776E-01, .2395E-01, .1419E-01, .8959E-02, .7096E-02, .6184E-02, &
& .6110E-02, .6075E-02, .4419E-02, .2891E-02, .3056E-02, .1214E-02, &
& .3780E-01, .2391E-01, .1392E-01, .8687E-02, .6573E-02, .5733E-02, &
& .5359E-02, .5009E-02, .4034E-02, .2755E-02, .1968E-02,-.4187E-04, &
& .3791E-01, .2382E-01, .1373E-01, .8561E-02, .6060E-02, .5120E-02, &
& .4618E-02, .4713E-02, .3965E-02, .2481E-02, .8164E-03,-.1088E-02, &
& .3843E-01, .2148E-01, .1302E-01, .6384E-02, .5256E-02, .4260E-02, &
& .4077E-02, .4181E-02, .4132E-02, .2135E-02,-.2931E-03,-.1151E-02, &
& .3896E-01, .2081E-01, .1097E-01, .5568E-02, .4475E-02, .3795E-02, &
& .3828E-02, .3996E-02, .3766E-02, .1193E-02,-.1089E-02,-.9420E-03, &
& .3973E-01, .2024E-01, .9943E-02, .4815E-02, .3820E-02, .3663E-02, &
& .3568E-02, .3881E-02, .2859E-02, .6698E-03,-.1549E-02,-.6280E-03, &
& .3635E-01, .1963E-01, .1061E-01, .3812E-02, .3509E-02, .3429E-02, &
& .3693E-02, .3316E-02, .1120E-02, .6552E-03,-.1193E-02,-.1109E-02, &
& .3631E-01, .1893E-01, .1056E-01, .3172E-02, .3378E-02, .3164E-02, &
& .2751E-02, .1722E-02, .1112E-02, .4354E-03,-.7327E-03,-.1319E-02, &
& .3500E-01, .1828E-01, .1050E-01, .2831E-02, .2784E-02, .2564E-02, &
& .1469E-02, .7739E-03, .1209E-02, .7913E-03,-.2512E-03,-.1758E-02, &
& .3352E-01, .1763E-01, .1045E-01, .2401E-02, .1928E-02, .1340E-02, &
& .3753E-03, .5794E-03, .9060E-03, .1042E-02, .1465E-03,-.2533E-02, &
& .2880E-01, .1729E-01, .1077E-01, .1347E-02, .1194E-02,-.1191E-03, &
& .2828E-03, .6606E-03, .9743E-03, .1002E-02, .0000E+00,-.3140E-02, &
& .2040E-01, .1585E-01, .1165E-01, .3871E-05, .1509E-04,-.1046E-02, &
& .2444E-03, .4359E-03, .1041E-02, .2429E-02,-.1721E-03,-.2786E-02, &
& .1737E-01, .1560E-01, .1240E-01,-.2139E-03,-.1025E-02,-.1248E-02, &
&-.6934E-04, .1649E-03, .4062E-03, .1554E-02,-.4179E-03,-.7795E-03/
data ( ( (coehca_15_new(k,j,i), i = 1, 12), j = 1, 19), k = 3, 3)/ &
&-.1488E-03,-.9248E-04,-.2322E-04,-.4187E-05, .1104E-04, .9895E-05, &
&-.2283E-05, .2512E-05,-.9058E-05, .8449E-05, .8297E-05,-.3882E-04, &
&-.1488E-03,-.9058E-04,-.2398E-04,-.5709E-05, .1218E-04, .1180E-04, &
& .1522E-05, .6927E-05,-.1161E-04, .1714E-04,-.4948E-06,-.3540E-04, &
&-.1500E-03,-.8830E-04,-.2474E-04,-.8373E-05, .6470E-05, .7992E-05, &
& .9096E-05, .6737E-05,-.1485E-04, .1873E-04,-.4948E-06,-.4491E-04, &
&-.1500E-03,-.8601E-04,-.2664E-04,-.1028E-04, .6851E-05, .6851E-05, &
& .1294E-04,-.2550E-05,-.1520E-04, .2310E-04, .4948E-06,-.2017E-04, &
&-.1507E-03,-.8373E-04,-.2664E-04,-.1256E-04, .4567E-05, .1028E-04, &
& .9210E-05,-.2131E-05,-.6995E-05, .7498E-05,-.1104E-04,-.2284E-05, &
&-.1519E-03,-.8183E-04,-.2816E-04,-.1142E-04, .7611E-06, .7231E-05, &
& .1751E-05,-.7612E-06, .8312E-05, .2436E-05,-.7231E-05, .2398E-04, &
&-.1530E-03,-.7992E-04,-.2893E-04,-.9896E-05, .3806E-06, .8906E-05, &
& .3159E-05,-.5328E-05, .3692E-05,-.2093E-05,-.6851E-05,-.3045E-05, &
&-.1538E-03,-.7536E-04,-.3007E-04,-.8754E-05,-.3045E-05, .5138E-05, &
& .9134E-06,-.1979E-06, .1560E-05,-.1507E-04, .2284E-04, .9895E-05, &
&-.1541E-03,-.7688E-04,-.2969E-04,-.5709E-05,-.3996E-05, .1142E-05, &
&-.8373E-06, .1235E-04,-.7079E-05,-.6737E-05, .1028E-04, .3578E-04, &
&-.1560E-03,-.6851E-04,-.1903E-04,-.4187E-05,-.4605E-05,-.1142E-06, &
& .3878E-05, .3597E-05,-.9591E-05, .5328E-05, .7612E-05,-.4948E-05, &
&-.1587E-03,-.6546E-04,-.2740E-04,-.7612E-06,-.3578E-05, .1713E-05, &
& .6064E-05,-.9781E-05, .1408E-05, .5709E-05, .8373E-05,-.1256E-04, &
&-.1484E-03,-.5823E-04,-.4301E-04,-.1522E-05, .7498E-05,-.5328E-06, &
&-.7855E-05,-.1599E-05, .1964E-04,-.2284E-05, .7882E-10, .5328E-05, &
&-.1238E-03,-.5700E-04,-.5266E-04, .3286E-05, .4910E-05,-.8602E-05, &
& .6090E-06, .8454E-05, .1256E-05,-.4072E-05,-.1903E-05, .6470E-05, &
&-.1155E-03,-.5231E-04,-.4396E-04, .3626E-05,-.7051E-05,-.1743E-05, &
& .9667E-05, .2064E-04,-.2778E-05,-.6546E-05,-.4948E-05, .1903E-05, &
&-.1024E-03,-.5129E-04,-.4506E-04, .7943E-06, .3074E-06, .3243E-05, &
& .2754E-04,-.1479E-05, .1661E-05,-.2969E-05,-.1066E-04, .7612E-06, &
&-.8473E-04,-.5418E-04,-.4674E-04,-.3418E-05, .9460E-05, .1151E-04, &
& .5714E-05,-.1069E-04,-.2022E-05,-.9061E-05,-.1104E-04,-.3083E-04, &
&-.4283E-04,-.5037E-04,-.4476E-04, .1951E-04, .8922E-05, .1296E-04, &
&-.4053E-05,-.4355E-05,-.2355E-05,-.5004E-05,-.1218E-04,-.1522E-04, &
& .6411E-05,-.5937E-04,-.5331E-04, .1934E-04, .5284E-05, .1129E-04, &
&-.2166E-05,-.1484E-06,-.5407E-05,-.1364E-04,-.3115E-05, .3004E-04, &
&-.5074E-04,-.6256E-04,-.5097E-04, .2218E-04, .1228E-04,-.1160E-05, &
&-.1105E-05, .1618E-06,-.6089E-05,-.4216E-06,-.5314E-05, .7903E-05/
data ( ( (coehcb_15_new(k,j,i), i = 1, 12), j = 1, 19), k = 1, 2)/ &
&-.9593E+01,-.4078E+01,-.2812E+01,-.6506E+00,-.4123E+00, .2055E+01, &
& .4097E+01, .4671E+01, .4639E+01,-.4587E+02,-.4587E+02,-.4587E+02, &
&-.9276E+01,-.3757E+01,-.2467E+01,-.5784E+00, .8833E-01, .2232E+01, &
& .3826E+01, .4723E+01, .4942E+01, .5135E+01,-.4587E+02,-.4587E+02, &
&-.8968E+01,-.3508E+01,-.2116E+01,-.1363E+00, .1662E+00, .2424E+01, &
& .4220E+01, .4513E+01, .1375E+01, .4601E+01,-.4587E+02,-.4587E+02, &
&-.8662E+01,-.3164E+01,-.1722E+01, .5178E-01, .7288E+00, .2411E+01, &
& .3805E+01, .4766E+01, .4342E+01,-.4587E+02,-.4587E+02,-.4587E+02, &
&-.8292E+01,-.2799E+01,-.1359E+01, .3271E+00, .1650E+01, .2395E+01, &
& .4192E+01, .4758E+01, .2470E+01,-.4587E+02,-.4587E+02,-.4587E+02, &
&-.7812E+01,-.2404E+01,-.1085E+01, .7167E+00, .2202E+01, .2922E+01, &
& .4322E+01, .4591E+01, .4186E+01,-.4587E+02,-.4587E+02,-.4587E+02, &
&-.7441E+01,-.2066E+01,-.7142E+00, .1057E+01, .2524E+01, .2946E+01, &
& .4220E+01, .3607E+01,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
&-.7191E+01,-.1745E+01,-.3487E+00, .1453E+01, .2739E+01, .3660E+01, &
& .4114E+01, .3245E+01,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
&-.6895E+01,-.1326E+01,-.3500E+00, .1647E+01, .2899E+01, .4023E+01, &
& .3361E+01, .3360E+01,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
&-.5876E+01,-.9573E+00, .2014E+00, .2130E+01, .3493E+01, .4088E+01, &
&-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
&-.4429E+01,-.3417E+00, .1204E+01, .2780E+01, .3843E+01, .3099E+01, &
&-.4587E+02, .3605E+01,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
&-.3122E+01, .2697E+00, .1866E+01, .3526E+01, .3569E+01, .1025E+01, &
&-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
&-.2284E+01, .8186E+00, .2754E+01, .3206E+01, .3704E+01,-.4587E+02, &
&-.4587E+02, .4625E+01,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
&-.1711E+01, .1220E+01, .3248E+01,-.4587E+02, .2565E+01, .3297E+01, &
&-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
&-.1758E+01, .7970E+00, .2758E+01, .2926E+01, .2613E+01, .1974E+01, &
&-.4587E+02, .2310E+01,-.4587E+02,-.4587E+02,-.4587E+02,-.4587E+02, &
&-.1737E+01, .3499E+00, .2246E+01, .2673E+01, .3308E+01, .3463E+01, &
& .3103E+01, .2611E+01, .2178E+01,-.4587E+02,-.4587E+02,-.4587E+02, &
&-.1559E+01, .2215E+00, .1875E+01, .2500E+01, .3346E+01, .3585E+01, &
& .3946E+01, .3533E+01, .3205E+01,-.4587E+02,-.4587E+02,-.4587E+02, &
&-.1601E+01, .5060E-01, .1275E+01, .2176E+01, .3081E+01, .3649E+01, &
& .3940E+01, .4106E+01, .4112E+01, .4349E+01, .2292E+01,-.4587E+02, &
&-.1222E+01, .3199E+00, .1642E+01, .2380E+01, .3254E+01, .3534E+01, &
& .3687E+01, .3717E+01, .3402E+01, .3868E+01,-.4587E+02,-.4587E+02, &
& .2967E-01, .1697E-01, .1795E-01, .1387E-01, .2032E-01, .1187E-01, &
& .2560E-01, .1044E-01,-.4560E+00, .3059E-02, .3059E-02, .3059E-02, &
& .2998E-01, .1586E-01, .1786E-01, .1521E-01, .1710E-01, .1061E-01, &
& .2030E-01, .1158E-01, .4452E+00, .3059E-02, .3059E-02, .3059E-02, &
& .2993E-01, .1551E-01, .1481E-01, .9846E-02, .2443E-01, .1150E-01, &
& .1865E-01, .1376E-01, .4617E+00, .3059E-02, .3059E-02, .3059E-02, &
& .3035E-01, .1417E-01, .1438E-01, .1511E-01, .1901E-01, .8582E-02, &
& .1746E-01, .1450E-01, .4523E+00, .3059E-02, .3059E-02, .3059E-02, &
& .2970E-01, .1347E-01, .1322E-01, .1252E-01, .1665E-01, .1037E-01, &
& .1320E-01, .1199E-01, .4436E+00, .3059E-02, .3059E-02, .3059E-02, &
& .2949E-01, .1291E-01, .1671E-01, .1111E-01, .1400E-01, .1318E-01, &
& .1060E-01, .1046E-01, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
& .3004E-01, .1300E-01, .1413E-01, .9085E-02, .9764E-02, .2260E-01, &
& .9778E-02, .4671E+00, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
& .3086E-01, .1436E-01, .1205E-01, .1081E-01, .4681E-02, .1479E-01, &
& .1888E-01, .3494E-01, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
& .3094E-01, .1500E-01, .1457E-01, .1060E-01, .8319E-02, .8983E-02, &
& .3791E-01, .2232E-01, .4631E+00, .3059E-02, .3059E-02, .3059E-02, &
& .3158E-01, .1585E-01, .1292E-01, .6531E-02, .1383E-01, .4605E+00, &
& .4662E+00, .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
& .3182E-01, .1586E-01, .8724E-02, .5798E-02, .2454E-01, .4607E+00, &
& .4560E+00, .4511E+00, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
& .2369E-01, .1606E-01, .5477E-02, .1228E-01, .4579E+00, .4561E+00, &
& .4497E+00, .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
& .2190E-01, .1779E-01, .6267E-02, .4535E+00, .4533E+00, .3059E-02, &
& .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
& .2100E-01, .1653E-01, .7449E-02, .4543E+00, .4472E+00, .4439E+00, &
& .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, .3059E-02, &
& .1864E-01, .1771E-01, .7040E-02, .2877E-01, .3381E-01, .2691E-01, &
& .4466E+00, .3059E-02, .4613E+00, .3059E-02, .3059E-02, .3059E-02, &
& .1637E-01, .1641E-01, .8424E-02, .1318E-01, .2060E-01, .3426E-01, &
& .4122E-01, .4621E+00, .4555E+00, .4525E+00, .3059E-02, .3059E-02, &
& .1607E-01, .1452E-01, .8013E-02, .1213E-01, .1482E-01, .2125E-01, &
& .3379E-01, .3562E-01, .4619E+00, .4569E+00, .3059E-02, .3059E-02, &
& .1698E-01, .1538E-01, .6616E-02, .1147E-01, .1217E-01, .1696E-01, &
& .1871E-01, .2273E-01, .4513E-01, .4702E+00, .4617E+00, .4553E+00, &
& .1700E-01, .1547E-01, .6456E-02, .1324E-01, .1502E-01, .2095E-01, &
& .2547E-01, .2823E-01, .4107E-01, .4676E+00, .4583E+00, .4498E+00/
data ( ( (coehcb_15_new(k,j,i), i = 1, 12), j = 1, 19), k = 3, 3)/ &
&-.6747E-05,-.2483E-04, .6575E-04, .1026E-03, .3888E-03,-.8519E-04, &
&-.1629E-03,-.1808E-04,-.8355E-02,-.4656E-05,-.4656E-05,-.4656E-05, &
&-.2270E-04,-.3427E-04, .5118E-04, .1218E-03, .1245E-03,-.1245E-03, &
& .3841E-05,-.4151E-04,-.8763E-02,-.1687E-01,-.4656E-05,-.4656E-05, &
&-.4557E-04,-.3023E-04, .2286E-04, .5656E-04, .4113E-04,-.1407E-03, &
&-.1301E-03, .8503E-04,-.7284E-02,-.1669E-01,-.4656E-05,-.4656E-05, &
&-.5325E-04,-.5309E-04,-.1246E-04, .2244E-04, .5136E-04,-.1272E-03, &
& .4217E-04,-.1749E-04,-.8435E-02,-.4656E-05,-.4656E-05,-.4656E-05, &
&-.6857E-04,-.7217E-04, .1740E-05, .3653E-04,-.1490E-03,-.4090E-04, &
&-.2376E-04, .2047E-04,-.7974E-02,-.4656E-05,-.4656E-05,-.4656E-05, &
&-.1232E-03,-.9826E-04,-.2849E-04, .1703E-04,-.1895E-03,-.3363E-03, &
& .7102E-04,-.1838E-05,-.1655E-01,-.4656E-05,-.4656E-05,-.4656E-05, &
&-.9896E-04,-.5127E-04,-.2704E-04,-.1218E-04,-.1207E-03,-.5883E-04, &
& .6893E-04,-.7924E-02,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
&-.7837E-04,-.4980E-04, .6902E-05,-.1072E-03,-.4051E-04,-.1991E-05, &
&-.1173E-03,-.5195E-04,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
&-.8136E-04,-.8102E-04, .1254E-03,-.4658E-04, .3173E-04,-.4461E-05, &
&-.1558E-03,-.2036E-03, .8360E-02,-.4656E-05,-.4656E-05,-.4656E-05, &
&-.2232E-04,-.6411E-04, .9486E-04,-.2322E-03,-.8282E-04,-.8202E-02, &
& .8416E-02,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
&-.1398E-03,-.7165E-04,-.4258E-04,-.3970E-04,-.2839E-03,-.7873E-02, &
& .8231E-02,-.8213E-02,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
&-.6754E-04,-.7469E-04,-.6898E-04,-.1702E-03,-.8079E-02,-.7270E-02, &
& .8116E-02,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
&-.2396E-04,-.2361E-04,-.8664E-04,-.8038E-02,-.8207E-02,-.4656E-05, &
&-.4656E-05,-.1670E-01,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
&-.5479E-04,-.7593E-04,-.1005E-03, .8199E-02,-.7942E-02,-.8244E-02, &
&-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05,-.4656E-05, &
&-.3806E-04,-.5825E-04,-.1003E-03,-.2925E-03,-.1506E-03, .3148E-04, &
& .8060E-02,-.1593E-01, .8327E-02,-.4656E-05,-.4656E-05,-.4656E-05, &
&-.4706E-04,-.3630E-04,-.7811E-04,-.6881E-04,-.1822E-03,-.3091E-03, &
&-.3033E-03,-.7684E-02,-.7663E-02, .8167E-02,-.4656E-05,-.4656E-05, &
&-.7669E-04,-.4610E-04,-.8063E-04,-.7250E-04,-.1094E-03,-.1241E-03, &
&-.2944E-03,-.1736E-03,-.7886E-02, .8248E-02,-.4656E-05,-.4656E-05, &
&-.7138E-04,-.4545E-04,-.3653E-04,-.6075E-04,-.4528E-04,-.1077E-03, &
&-.1119E-03,-.1657E-03,-.4695E-03,-.8112E-02,-.7587E-02, .8217E-02, &
&-.6812E-04,-.4558E-04,-.6739E-04,-.8861E-04,-.9386E-04,-.1334E-03, &
&-.2007E-03,-.2179E-03,-.1650E-03,-.8001E-02, .8273E-02, .8118E-02/
! block data ckd16_new
! *********************************************************************
! hk is the interval in the g (cumulative probability) space from 0
! to one. coeh2o is the coefficient to calculate the H2O absorption
! coefficient in units of (cm-atm)**-1 at there temperatures, nine-
! teen pressures, and seven cumulative probabilities ( Fu, 1991 ).
! The spectral region is from 540 to 400 cm**-1.
! *********************************************************************
real hk_16_new(7), coeh2o_16_new(3,19,7)
data hk_16_new / .12, .24, .24, .20, .12, .06, .02 /
data ( ( ( coeh2o_16_new(k,j,i), i = 1, 7), j = 1, 19), k = 1, 3)/ &
&-.2344E+02,-.2016E+02,-.1986E+02,-.1655E+02,-.1243E+02,-.8437E+01, &
&-.4858E+01,-.2298E+02,-.2014E+02,-.1984E+02,-.1609E+02,-.1198E+02, &
&-.8020E+01,-.4548E+01,-.2252E+02,-.2012E+02,-.1981E+02,-.1564E+02, &
&-.1153E+02,-.7596E+01,-.4239E+01,-.2206E+02,-.2009E+02,-.1957E+02, &
&-.1517E+02,-.1111E+02,-.7161E+01,-.3871E+01,-.2160E+02,-.2007E+02, &
&-.1911E+02,-.1472E+02,-.1065E+02,-.6721E+01,-.3479E+01,-.2113E+02, &
&-.2005E+02,-.1865E+02,-.1426E+02,-.1021E+02,-.6302E+01,-.3081E+01, &
&-.2067E+02,-.2003E+02,-.1819E+02,-.1379E+02,-.9765E+01,-.5883E+01, &
&-.2678E+01,-.2026E+02,-.2001E+02,-.1773E+02,-.1333E+02,-.9332E+01, &
&-.5443E+01,-.2253E+01,-.2024E+02,-.1999E+02,-.1727E+02,-.1288E+02, &
&-.8897E+01,-.5029E+01,-.1858E+01,-.2026E+02,-.1959E+02,-.1481E+02, &
&-.1147E+02,-.7477E+01,-.4555E+01,-.1464E+01,-.2022E+02,-.1632E+02, &
&-.1305E+02,-.9885E+01,-.6689E+01,-.4108E+01,-.1068E+01,-.1936E+02, &
&-.1438E+02,-.1163E+02,-.8499E+01,-.6146E+01,-.3673E+01,-.6816E+00, &
&-.1675E+02,-.1281E+02,-.1020E+02,-.7716E+01,-.5678E+01,-.3256E+01, &
&-.3125E+00,-.1510E+02,-.1124E+02,-.8821E+01,-.7140E+01,-.5243E+01, &
&-.2851E+01,-.2560E-01,-.1334E+02,-.9708E+01,-.8061E+01,-.6611E+01, &
&-.4842E+01,-.2459E+01, .1711E+00,-.1155E+02,-.8798E+01,-.7440E+01, &
&-.6123E+01,-.4439E+01,-.2089E+01, .2480E+00,-.1020E+02,-.8154E+01, &
&-.6945E+01,-.5681E+01,-.4055E+01,-.1737E+01, .2390E+00,-.9464E+01, &
&-.7677E+01,-.6512E+01,-.5284E+01,-.3707E+01,-.1453E+01, .2015E+00, &
&-.9033E+01,-.7246E+01,-.6093E+01,-.4882E+01,-.3346E+01,-.1264E+01, &
& .1033E+00, .4658E-01, .5840E-02, .4626E-02, .2688E-01, .2395E-01, &
& .1804E-01, .2074E-01, .4660E-01, .1884E-02, .8561E-02, .2690E-01, &
& .2403E-01, .1788E-01, .1934E-01, .4660E-01, .1800E-02, .1252E-01, &
& .2694E-01, .2393E-01, .1786E-01, .1825E-01, .4660E-01, .1779E-02, &
& .1649E-01, .2696E-01, .2397E-01, .1779E-01, .1765E-01, .4348E-01, &
& .1758E-02, .2043E-01, .2696E-01, .2393E-01, .1748E-01, .1675E-01, &
& .3944E-01, .1737E-02, .2445E-01, .2698E-01, .2384E-01, .1752E-01, &
& .1549E-01, .3538E-01, .1654E-02, .2847E-01, .2702E-01, .2384E-01, &
& .1714E-01, .1565E-01, .3127E-01, .1570E-02, .3245E-01, .2705E-01, &
& .2374E-01, .1712E-01, .1514E-01, .2715E-01, .1444E-02, .3540E-01, &
& .2711E-01, .2363E-01, .1702E-01, .1446E-01, .2960E-01, .1760E-01, &
& .2977E-01, .2397E-01, .2087E-01, .1618E-01, .1445E-01, .2466E-01, &
& .3039E-01, .2428E-01, .2217E-01, .1821E-01, .1593E-01, .1463E-01, &
& .2640E-01, .2545E-01, .2231E-01, .2060E-01, .1773E-01, .1555E-01, &
& .1473E-01, .3456E-01, .2135E-01, .2030E-01, .1844E-01, .1740E-01, &
& .1559E-01, .1428E-01, .3203E-01, .2047E-01, .1809E-01, .1760E-01, &
& .1725E-01, .1545E-01, .1541E-01, .2137E-01, .1857E-01, .1616E-01, &
& .1698E-01, .1700E-01, .1537E-01, .1636E-01, .1338E-01, .1518E-01, &
& .1580E-01, .1658E-01, .1710E-01, .1518E-01, .1513E-01, .1570E-01, &
& .1614E-01, .1603E-01, .1673E-01, .1706E-01, .1497E-01, .1439E-01, &
& .1987E-01, .1731E-01, .1601E-01, .1675E-01, .1681E-01, .1535E-01, &
& .1425E-01, .2018E-01, .1723E-01, .1597E-01, .1691E-01, .1666E-01, &
& .1509E-01, .1446E-01,-.2873E-03,-.8031E-04, .4225E-04,-.9287E-04, &
&-.6013E-04,-.4339E-04,-.2474E-04,-.2862E-03,-.8372E-05, .1146E-03, &
&-.9248E-04,-.6166E-04,-.3882E-04,-.1827E-04,-.2870E-03,-.6851E-05, &
& .1865E-03,-.9172E-04,-.6128E-04,-.3616E-04,-.7612E-05,-.2877E-03, &
&-.7231E-05, .1880E-03,-.9287E-04,-.5671E-04,-.4110E-04,-.1104E-04, &
&-.3429E-03,-.7612E-05, .1149E-03,-.9287E-04,-.6356E-04,-.4529E-04, &
&-.2436E-04,-.4187E-03,-.7992E-05, .4339E-04,-.9325E-04,-.6280E-04, &
&-.4225E-04,-.3197E-04,-.4925E-03,-.8754E-05,-.2740E-04,-.9477E-04, &
&-.6432E-04,-.3768E-04,-.3361E-04,-.5511E-03,-.8753E-05,-.9972E-04, &
&-.9515E-04,-.6394E-04,-.3806E-04,-.3787E-04,-.4792E-03,-.1028E-04, &
&-.1534E-03,-.9477E-04,-.6356E-04,-.3616E-04,-.2923E-04,-.5070E-03, &
& .1922E-03,-.1028E-03,-.5823E-04,-.7954E-04,-.2550E-04,-.3893E-04, &
&-.3776E-03,-.1043E-03,-.7993E-04,-.7422E-04,-.4948E-04,-.3007E-04, &
&-.3863E-04, .8335E-04,-.5709E-04,-.6090E-04,-.7840E-04,-.3692E-04, &
&-.3007E-04,-.4251E-04,-.6204E-04,-.4872E-04,-.3806E-04,-.4681E-04, &
&-.3463E-04,-.3007E-04,-.4312E-04,-.1142E-04,-.5176E-04,-.5024E-04, &
&-.3007E-04,-.3730E-04,-.3037E-04,-.3888E-04, .2550E-04,-.6508E-04, &
&-.2512E-04,-.3083E-04,-.3197E-04,-.3041E-04,-.3750E-04, .1484E-04, &
&-.1941E-04,-.2626E-04,-.3349E-04,-.3463E-04,-.2896E-04,-.1716E-04, &
&-.7231E-04,-.3920E-04,-.2893E-04,-.3540E-04,-.3311E-04,-.3734E-04, &
&-.2550E-05,-.7650E-04,-.3159E-04,-.2778E-04,-.3121E-04,-.2169E-04, &
&-.4365E-04,-.1546E-04,-.7916E-04,-.2931E-04,-.2854E-04,-.3654E-04, &
&-.1979E-04,-.4811E-04,-.1435E-04/
! block data ckd17_new
! *********************************************************************
! hk is the interval in the g (cumulative probability) space from 0
! to one. coeh2o is the coefficient to calculate the H2O absorption
! coefficient in units of (cm-atm)**-1 at there temperatures, nine-
! teen pressures, and seven cumulative probabilities ( Fu, 1991 ).
! The spectral region is from 400 to 280 cm**-1.
! *********************************************************************
real hk_17_new(7), coeh2o_17_new(3,19,7)
data hk_17_new / .12, .26, .22, .20, .10, .085, .015 /
data ( ( ( coeh2o_17_new(k,j,i), i = 1, 7), j = 1, 19), k = 1, 3)/ &
&-.2255E+02,-.2000E+02,-.1703E+02,-.1282E+02,-.9215E+01,-.5938E+01, &
&-.2009E+01,-.2209E+02,-.1997E+02,-.1657E+02,-.1236E+02,-.8764E+01, &
&-.5499E+01,-.1582E+01,-.2163E+02,-.1993E+02,-.1611E+02,-.1191E+02, &
&-.8324E+01,-.5061E+01,-.1170E+01,-.2117E+02,-.1990E+02,-.1565E+02, &
&-.1146E+02,-.7889E+01,-.4631E+01,-.7737E+00,-.2071E+02,-.1987E+02, &
&-.1519E+02,-.1100E+02,-.7440E+01,-.4179E+01,-.3719E+00,-.2026E+02, &
&-.1985E+02,-.1473E+02,-.1054E+02,-.6995E+01,-.3721E+01, .0000E+00, &
&-.2024E+02,-.1982E+02,-.1426E+02,-.1009E+02,-.6549E+01,-.3284E+01, &
& .4053E+00,-.2022E+02,-.1980E+02,-.1381E+02,-.9639E+01,-.6097E+01, &
&-.2821E+01, .8375E+00,-.2021E+02,-.1933E+02,-.1335E+02,-.9187E+01, &
&-.5653E+01,-.2379E+01, .1272E+01,-.2010E+02,-.1503E+02,-.1125E+02, &
&-.7665E+01,-.4492E+01,-.1893E+01, .1642E+01,-.1747E+02,-.1278E+02, &
&-.9547E+01,-.6120E+01,-.3756E+01,-.1443E+01, .1995E+01,-.1529E+02, &
&-.1095E+02,-.8107E+01,-.5036E+01,-.3182E+01,-.1032E+01, .2429E+01, &
&-.1370E+02,-.9303E+01,-.6691E+01,-.4357E+01,-.2683E+01,-.6173E+00, &
& .2805E+01,-.1150E+02,-.7859E+01,-.5618E+01,-.3843E+01,-.2234E+01, &
&-.2171E+00, .2973E+01,-.9590E+01,-.6537E+01,-.4886E+01,-.3355E+01, &
&-.1805E+01, .1615E+00, .3157E+01,-.7530E+01,-.5699E+01,-.4306E+01, &
&-.2892E+01,-.1388E+01, .5448E+00, .3155E+01,-.6758E+01,-.5112E+01, &
&-.3809E+01,-.2464E+01,-.9947E+00, .8713E+00, .3203E+01,-.6245E+01, &
&-.4610E+01,-.3376E+01,-.2058E+01,-.6166E+00, .1073E+01, .3109E+01, &
&-.5777E+01,-.4175E+01,-.2963E+01,-.1671E+01,-.2556E+00, .1241E+01, &
& .3014E+01, .4264E-01, .1968E-02, .1863E-01, .1436E-01, .1101E-01, &
& .1055E-01, .1281E-01, .4264E-01, .1989E-02, .1861E-01, .1438E-01, &
& .1095E-01, .1030E-01, .1211E-01, .3996E-01, .1968E-02, .1861E-01, &
& .1434E-01, .1103E-01, .1019E-01, .1160E-01, .3600E-01, .1947E-02, &
& .1861E-01, .1442E-01, .1086E-01, .1003E-01, .1157E-01, .3203E-01, &
& .5756E-02, .1861E-01, .1444E-01, .1080E-01, .9922E-02, .1151E-01, &
& .2801E-01, .9713E-02, .1859E-01, .1446E-01, .1070E-01, .9880E-02, &
& .1066E-01, .2393E-01, .1369E-01, .1859E-01, .1451E-01, .1057E-01, &
& .9880E-02, .1072E-01, .1987E-01, .1767E-01, .1863E-01, .1451E-01, &
& .1040E-01, .9880E-02, .1057E-01, .1572E-01, .2169E-01, .1863E-01, &
& .1442E-01, .1022E-01, .9742E-02, .1036E-01, .3391E-02, .1884E-01, &
& .1566E-01, .1105E-01, .1011E-01, .1001E-01, .1017E-01, .1982E-01, &
& .1444E-01, .1189E-01, .1030E-01, .9859E-02, .9861E-02, .1038E-01, &
& .1748E-01, .1321E-01, .9922E-02, .1068E-01, .1013E-01, .9937E-02, &
& .9958E-02, .1346E-01, .9943E-02, .9566E-02, .1097E-01, .9815E-02, &
& .9964E-02, .1059E-01, .9817E-02, .7159E-02, .8687E-02, .1114E-01, &
& .1007E-01, .1014E-01, .1058E-01, .3370E-02, .7264E-02, .9378E-02, &
& .1112E-01, .9767E-02, .1016E-01, .1101E-01, .2993E-02, .8017E-02, &
& .9566E-02, .1116E-01, .9738E-02, .1025E-01, .1086E-01, .8331E-02, &
& .8771E-02, .1001E-01, .1117E-01, .9847E-02, .1076E-01, .1084E-01, &
& .7850E-02, .9378E-02, .1001E-01, .1105E-01, .9964E-02, .1113E-01, &
& .1168E-01, .8038E-02, .9336E-02, .9817E-02, .1096E-01, .1024E-01, &
& .1175E-01, .1107E-01,-.2188E-03,-.2283E-05,-.8069E-04,-.4415E-04, &
&-.2284E-04,-.4491E-04,-.4518E-04,-.2196E-03,-.2665E-05,-.8107E-04, &
&-.4301E-04,-.2398E-04,-.4795E-04,-.4693E-04,-.2683E-03,-.3045E-05, &
&-.8107E-04,-.4301E-04,-.2246E-04,-.4757E-04,-.4152E-04,-.3403E-03, &
&-.4187E-05,-.8031E-04,-.3996E-04,-.1865E-04,-.4301E-04,-.4350E-04, &
&-.4118E-03, .6584E-04,-.8107E-04,-.4034E-04,-.1903E-04,-.4643E-04, &
&-.4834E-04,-.4803E-03, .1378E-03,-.8069E-04,-.4072E-04,-.1713E-04, &
&-.5176E-04,-.3460E-04,-.4099E-03, .2101E-03,-.8069E-04,-.3920E-04, &
&-.1713E-04,-.5024E-04,-.3524E-04,-.3391E-03, .2809E-03,-.7992E-04, &
&-.3616E-04,-.2017E-04,-.5633E-04,-.4886E-04,-.2668E-03, .2078E-03, &
&-.8069E-04,-.3768E-04,-.2131E-04,-.5580E-04,-.5454E-04,-.2207E-04, &
&-.8601E-04,-.4643E-04,-.2436E-04,-.4148E-04,-.5458E-04,-.4579E-04, &
&-.5138E-04,-.2893E-04,-.3273E-04,-.3882E-04,-.3920E-04,-.5035E-04, &
&-.3170E-04,-.2169E-04,-.3007E-04,-.2740E-04,-.5328E-04,-.4491E-04, &
&-.4403E-04,-.6383E-04, .4834E-04,-.2702E-04,-.4453E-04,-.4339E-04, &
&-.4457E-04,-.4551E-04,-.8133E-04, .3768E-04,-.7611E-06,-.2626E-04, &
&-.4643E-04,-.4305E-04,-.4840E-04,-.5149E-04, .7193E-04,-.2169E-04, &
&-.4491E-04,-.3996E-04,-.4483E-04,-.4487E-04,-.6698E-04,-.4834E-04, &
&-.3463E-04,-.4986E-04,-.4377E-04,-.4514E-04,-.5377E-04,-.2626E-04, &
&-.4187E-04,-.3692E-04,-.5100E-04,-.4651E-04,-.4392E-04,-.5386E-04, &
&-.4643E-04,-.4301E-04,-.3578E-04,-.5176E-04,-.4594E-04,-.4551E-04, &
&-.3920E-04,-.3425E-04,-.4491E-04,-.3654E-04,-.5138E-04,-.4377E-04, &
&-.5614E-04,-.5758E-04,-.3600E-04/
! block data ckd18_new
! *********************************************************************
! hk is the interval in the g (cumulative probability) space from 0
! to one. coeh2o is the coefficient to calculate the H2O absorption
! coefficient in units of (cm-atm)**-1 at there temperatures, nine-
! teen pressures, and eight cumulative probabilities ( Fu, 1991 ).
! The spectral region is from 280 to 0 cm**-1.
! *********************************************************************
real hk_18_new(8), coeh2o_18_new(3,19,8)
data hk_18_new / .07, .1, .2, .25, .2, .1, .03, .02 /
data ( ( ( coeh2o_18_new(k,j,i), i = 1, 8), j = 1, 19), k = 1, 3)/ &
&-.2121E+02,-.2002E+02,-.1676E+02,-.1274E+02,-.8780E+01,-.5167E+01, &
&-.2692E+01,-.6275E+00,-.2075E+02,-.1996E+02,-.1630E+02,-.1228E+02, &
&-.8324E+01,-.4718E+01,-.2260E+01,-.2303E+00,-.2029E+02,-.1990E+02, &
&-.1584E+02,-.1182E+02,-.7868E+01,-.4269E+01,-.1806E+01, .1645E+00, &
&-.2022E+02,-.1985E+02,-.1538E+02,-.1136E+02,-.7417E+01,-.3820E+01, &
&-.1373E+01, .5657E+00,-.2018E+02,-.1981E+02,-.1492E+02,-.1090E+02, &
&-.6965E+01,-.3369E+01,-.9319E+00, .9577E+00,-.2013E+02,-.1937E+02, &
&-.1446E+02,-.1044E+02,-.6512E+01,-.2917E+01,-.4928E+00, .1376E+01, &
&-.2009E+02,-.1891E+02,-.1400E+02,-.9984E+01,-.6063E+01,-.2466E+01, &
&-.6887E-01, .1768E+01,-.2006E+02,-.1845E+02,-.1354E+02,-.9530E+01, &
&-.5618E+01,-.2024E+01, .3615E+00, .2196E+01,-.2003E+02,-.1800E+02, &
&-.1308E+02,-.9075E+01,-.5174E+01,-.1593E+01, .7820E+00, .2600E+01, &
&-.1827E+02,-.1464E+02,-.1097E+02,-.7525E+01,-.3733E+01,-.1077E+01, &
& .1204E+01, .3014E+01,-.1525E+02,-.1210E+02,-.9275E+01,-.5876E+01, &
&-.2768E+01,-.6286E+00, .1622E+01, .3394E+01,-.1298E+02,-.1060E+02, &
&-.7764E+01,-.4462E+01,-.2154E+01,-.2001E+00, .2034E+01, .3756E+01, &
&-.1157E+02,-.8941E+01,-.5984E+01,-.3509E+01,-.1651E+01, .2279E+00, &
& .2422E+01, .4066E+01,-.9986E+01,-.7062E+01,-.4794E+01,-.2818E+01, &
&-.1196E+01, .6394E+00, .2791E+01, .4283E+01,-.8064E+01,-.5512E+01, &
&-.3933E+01,-.2274E+01,-.7559E+00, .1036E+01, .3085E+01, .4444E+01, &
&-.6440E+01,-.4863E+01,-.3219E+01,-.1791E+01,-.3279E+00, .1427E+01, &
& .3304E+01, .4527E+01,-.5902E+01,-.4207E+01,-.2756E+01,-.1350E+01, &
& .7686E-01, .1776E+01, .3475E+01, .4550E+01,-.5439E+01,-.3739E+01, &
&-.2330E+01,-.9233E+00, .4612E+00, .2066E+01, .3564E+01, .4502E+01, &
&-.5006E+01,-.3316E+01,-.1906E+01,-.5066E+00, .8352E+00, .2272E+01, &
& .3587E+01, .4419E+01, .2338E-01, .1968E-02, .9503E-02, .3412E-02, &
& .6280E-03,-.1109E-02,-.1089E-02,-.1026E-02, .1972E-01, .2093E-02, &
& .9503E-02, .3391E-02, .6489E-03,-.1172E-02,-.1164E-02,-.1158E-02, &
& .1603E-01, .3328E-02, .9524E-02, .3391E-02, .6489E-03,-.1277E-02, &
&-.1229E-02,-.1296E-02, .1229E-01, .7138E-02, .9524E-02, .3370E-02, &
& .6070E-03,-.1319E-02,-.1264E-02,-.1610E-02, .8478E-02, .1095E-01, &
& .9566E-02, .3412E-02, .5652E-03,-.1382E-02,-.1266E-02,-.1566E-02, &
& .4563E-02, .1480E-01, .9566E-02, .3412E-02, .5443E-03,-.1423E-02, &
&-.1199E-02,-.1679E-02, .2261E-02, .1865E-01, .9608E-02, .3454E-02, &
& .4815E-03,-.1423E-02,-.1296E-02,-.1555E-02, .2198E-02, .2250E-01, &
& .9671E-02, .3412E-02, .4187E-03,-.1426E-02,-.1472E-02,-.1800E-02, &
& .2072E-02, .2600E-01, .9734E-02, .3433E-02, .3977E-03,-.1428E-02, &
&-.1541E-02,-.1591E-02, .1987E-01, .8645E-02, .6280E-02, .1298E-02, &
&-.1151E-02,-.1509E-02,-.1662E-02,-.1570E-02, .4668E-02, .8373E-02, &
& .3956E-02,-.4187E-04,-.1968E-02,-.1624E-02,-.1700E-02,-.1947E-02, &
& .9231E-02, .5694E-02, .1444E-02,-.2512E-03,-.1827E-02,-.1662E-02, &
&-.1576E-02,-.1633E-02, .8666E-02, .3077E-02,-.1737E-02,-.1277E-02, &
&-.1507E-02,-.1757E-02,-.1612E-02,-.1612E-02, .8164E-03,-.4375E-02, &
&-.1884E-02,-.1277E-02,-.1564E-02,-.1853E-02,-.1591E-02,-.1486E-02, &
&-.1486E-02,-.2596E-02,-.1633E-02,-.1539E-02,-.1662E-02,-.1846E-02, &
&-.1423E-02,-.1277E-02,-.1423E-02,-.2617E-02,-.1005E-02,-.1379E-02, &
&-.1687E-02,-.1905E-02,-.1528E-02,-.1298E-02,-.1675E-03,-.1947E-02, &
&-.5024E-03,-.1325E-02,-.1696E-02,-.1698E-02,-.1486E-02,-.1277E-02, &
& .1047E-03,-.1109E-02,-.5861E-03,-.1363E-02,-.1620E-02,-.1666E-02, &
&-.1507E-02,-.9210E-03, .1047E-03,-.1047E-02,-.8394E-03,-.1342E-02, &
&-.1591E-02,-.1323E-02,-.1340E-02,-.9420E-03,-.1085E-03, .2283E-05, &
&-.4719E-04,-.3807E-06,-.1522E-05,-.3425E-05,-.7612E-06, .1751E-05, &
&-.1766E-03, .1523E-05,-.4719E-04,-.7609E-06,-.3807E-06,-.3045E-05, &
& .1599E-05, .8723E-05,-.2443E-03, .1941E-04,-.4757E-04,-.1522E-05, &
&-.3806E-06,-.1903E-05,-.2778E-05, .1294E-04,-.1838E-03, .8563E-04, &
&-.4757E-04,-.1903E-05, .1142E-05,-.2664E-05,-.6090E-06, .1321E-04, &
&-.1161E-03, .1526E-03,-.4757E-04,-.2664E-05,-.3805E-06,-.3806E-05, &
&-.2093E-05, .2253E-04,-.4795E-04, .9248E-04,-.4757E-04,-.1903E-05, &
& .0000E+00,-.3045E-05,-.7992E-06, .1393E-04,-.9134E-05, .2246E-04, &
&-.4834E-04,-.2664E-05, .3804E-06,-.5328E-05,-.1510E-05, .1465E-04, &
&-.1028E-04,-.4757E-04,-.4948E-04,-.1142E-05, .7614E-06,-.4910E-05, &
&-.5709E-06, .1477E-04,-.1256E-04,-.1066E-03,-.4910E-04,-.1523E-05, &
&-.3805E-06,-.3121E-05,-.2512E-05, .1142E-04,-.7878E-04,-.2664E-05, &
&-.8373E-05,-.7612E-06, .1104E-04,-.3311E-05,-.1979E-05, .5709E-05, &
&-.2626E-04,-.4872E-04,-.3808E-06,-.2283E-05, .2284E-05,-.3349E-05, &
&-.4034E-05, .7231E-05,-.4910E-04, .1599E-04, .1256E-04,-.7612E-05, &
& .1180E-05,-.1815E-05,-.7193E-05, .3045E-05, .1576E-09, .6470E-05, &
&-.1408E-04,-.1903E-05, .1522E-05,-.4746E-05,-.4948E-05, .3806E-06, &
& .9020E-04, .5214E-04, .6090E-05,-.1104E-04, .1180E-05,-.2778E-05, &
&-.6090E-05,-.2664E-05,-.6737E-04,-.1218E-04,-.3806E-05,-.5214E-05, &
&-.1066E-05,-.1294E-05,-.3045E-05,-.2664E-05,-.4643E-04, .1713E-04, &
&-.1218E-04,-.6204E-05,-.2360E-05,-.1979E-05,-.1903E-05,-.3806E-05, &
&-.3045E-04,-.1256E-04,-.9134E-05,-.6508E-05,-.1027E-05,-.7993E-06, &
&-.1142E-05,-.7992E-05,-.3616E-04,-.1028E-04,-.1066E-04,-.6051E-05, &
& .1066E-05,-.1751E-05,-.2284E-05,-.2284E-05,-.3920E-04,-.9895E-05, &
&-.1321e-04,-.3844E-05,-.2055E-05,-.2512E-05,-.3806E-05,-.3425E-05/
end module band_new
!--------------------------------------------------------------------------------
MODULE module_ra_FLG 1
contains
!******************************************************************************
!* This subroutine drives the Fu-Liou radiation program which solves the solar
!* and IR radiation in the atmosphere.
!* ****************************************************************************
subroutine RAD_FLG & 1,8
& (peven, podd, t8w,degrees &
& , pi3d &
& , o3 &
& , G, Cp &
& , albedo &
& , tskin &
& , h2o,cld_iccld, cld_wlcld &
& , cld_prwc, cld_pgwc &
& , cld_snow &
& , F_QV,F_QC,F_QR,F_QI,F_QS,F_QG &
& , warm_rain &
!-- for partly cloudy &
& , cloudstrf &
& , emiss &
& , air_den &
& , dz3d &
& , SOLCON &
& , declin &
& , xtime, xlong, xlat, JULDAY, gmt, radt, degrad &
& , dtcolumn &
!-- change over
!-- add for aerosol indirect effect
! & , vertical_w
!-- add over
& , ids,ide, jds,jde, kds,kde &
& , ims,idim, jms,jdim, kms,kmax &
& , its,ite, jts,jte, kts,kte &
!-- output
! & , dswtop, dswbot, swinc &
! & , ulwtop, ulwbot, dlwbot, netlwstr, netlwbot &
& , uswtop, ulwtop,NETSWBOT,DLWBOT,DSWBOT &
& , deltat,dtshort, dtlongwv &
!-- for optional aerosol input
! & , tau_aer_2D, tau_aer_3D, fraca_in &
!-- change over
& )
!C$Id: driver_rad.F,v 1.8 2002/04/17 18:40:13 gu Exp gu $
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
!* Input:
!* PEVEN = Even level Atmospheric Pressure (mb, = 1000pa = 1hpa)
!* PODD = Odd level Atmospheric Pressure (mb)
!* PBIG = odd level dimensionless pressure
!* PHAT = even level dimensionless pressure (see eq. 4.14 AS83)
!* DEGREES = Odd level Atmospheric Temperature(K)
!* H2O = wate vapor mixing ratio (kg/kg)
!* O3 = Ozone mixing ratio (kg/kg)
!* CLD_ICCLD = Ice water mixing ratio (kg/kg). need to conver to content (g/m**3)
!* CLD_WLCLD = Liquid water mixing ratio (kg/kg). Need to convert content (g/m**3)
!* air_den: air density (kg/m**3)
!* dz3d: dz between full levels
!* COSZENTH = cosine of the zenith angle
!* emiss = IR surface emissivity
!* ALBEDO = surface albedo
!* TSKIN = ground temperature (degrees k)
!* TSURFACE = surface air temperature (degrees K)
!* TBOUND = temperature at even level between the PBL and troposphere
!* TEMP3D = temporary 3d array used to interpolate to pressure coord
!* add by Yu for aerosol indirect effect
!* VERTICAL_W = vertical velocity in m/s
!* Output:
!* USWTOP = upward solar flux at TOA (down-up)
!* DSWTOP = net downward solar flux at TOA (down-up)
!* DSWBOT = net downward solar flux at surface (down-up)
!* SWINC = solar flux incident at TOA
!* DELTAT = total column physics increment to theta
!
!* ULWBOT = upward IR flux at surface
!* DLWBOT = downward IR flux at surface
!* ULWTOP = upward IR flux at TOA
!* NETLWSTR = net IR flux at top of PBL stratus cloud layer
!* NETLWBOT = net IR flux at surface (up-down)
!* DELTAT = total column physics increment to theta (K)
!* 1D array input to Fu-Liou program:
!* pij = Atmospheric Pressure (mb)
!* tij = Atmospheric Temperature (K)
!* qij = Water vapor mixing ratio
!* o3ij = Ozone mixing ratio
!* piwc = Ice water content (g/m**3)
!* plwc = Liquid water content (g/m**3)
!* prwc = Rain water content (g/m**3)
!* pgwc = graupel water content (g/m**3) or aerosol concentration (m-3)
!* u0ij = cosine of the zenith angle
!* as = Solar surface albedo
!* tsij = Ground temperature
!* ee = IR surface emissivity
!
!* Prescribed inaut to Fu-Liou program:
!* pde = Effective size of ice cloud (um)
!* pre = Effective radius of water cloud (um)
!*****************************************************************************
!* INCLUDE files
!*****************************************************************************
USE PARA_FILE
! USE module_wrf_error
USE control_para
!************************************************************************
!* Declare all local variables
!************************************************************************
implicit none
real weight, FAC, CNVERT
integer i, j, k, icycle, i1,i2, j1,j2, k1x, k2x, ilo,ihi, jlo,jhi, ii
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,idim, jms,jdim, kms,kmax
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
INTEGER, INTENT(IN ) :: JULDAY
LOGICAL, INTENT(IN ) :: F_QV,F_QC,F_QR,F_QI,F_QS,F_QG
LOGICAL, INTENT(IN ) :: warm_rain
! real, INTENT(IN ), optional :: tau_aer_2D(ims:idim,jms:jdim) &
! & ,tau_aer_3D(ims:idim,jms:jdim,kms:kmax)
! real, INTENT(IN ), optional :: fraca_in(mxac)
real, INTENT(IN ) :: dtcolumn
real declin, solcon, G, FP, CP
real GMT, radt, degrad, xtime
real pi3d(ims:idim,kms:kmax,jms:jdim)
real peven(ims:idim,kms:kmax,jms:jdim)
real podd(ims:idim, kms:kmax,jms:jdim)
real dpeven(ims:idim,kms:kmax, jms:jdim)
real degrees(ims:idim,kms:kmax, jms:jdim)
real t8w(ims:idim,kms:kmax, jms:jdim)
real dz3d(ims:idim,kms:kmax, jms:jdim)
real air_den(ims:idim,kms:kmax, jms:jdim)
real emiss(ims:idim, jms:jdim)
real dz3dd(ims:idim,kms:kmax, jms:jdim)
real h2o(ims:idim,kms:kmax, jms:jdim)
real o3(ims:idim,kms:kmax, jms:jdim)
real po3(ims:idim,kms:kmax, jms:jdim)
real po3top(ims:idim, jms:jdim)
real cld_iccld(ims:idim,kms:kmax, jms:jdim)
real cld_wlcld(ims:idim,kms:kmax, jms:jdim)
real cld_prwc(ims:idim,kms:kmax, jms:jdim)
real cld_pgwc(ims:idim,kms:kmax, jms:jdim)
real cld_snow(ims:idim,kms:kmax, jms:jdim)
!--- change for fractional cloud
real cloudstrf(ims:idim,kms:kmax, jms:jdim)
!--- add for aerosol indirect effect
! real vertical_w(-1:idim, -1:jdim, kmax)
!---- add over
!--- add for cloud inhomogeneity
real ccc_inho(ims:idim,kms:kmax,jms:jdim)
real temp_inho_low(ims:idim,jms:jdim)
real temp_inho_mid(ims:idim, jms:jdim)
real temp_inho_high(ims:idim, jms:jdim)
!-- change over
!--- add by Yu for aerosol
real,dimension(mxat,mxac) :: a_wlis,a_taus
real,dimension(nvx,mxac) :: aprofs
real :: sh_aer(mxac)
! integer, dimension(mxac) :: itps
real :: tau_aer, tot = 0.0
real, dimension(mxac) :: fraca = -9999., tauindividual = -9999.
integer :: iac
character :: reading = "Y"
character*3 aerosol_type
!-- add over
!c--- add for de-iwc
real amean(4),bmean(4),cmean(4)
real amax(4),bmax(4),cmax(4)
real amin(4),bmin(4),cmin(4)
data amin /0.54763e01, 0, 0.43976e01, 0.47890e01/
data bmin /0.55175, 0, 0.11286, 0.34200/
data cmin /0.26934e-1, 0, 0, -0.58155e-2/
data amean /0.54199e01, 0.43257e01, 0.52375e01, 0.4851e01/
data bmean /0.35211, 0.26535, 0.13142, 0.33159/
data cmean /0.1268e-1, 0.21864e-1, 0., 0.26189e-1/
data amax /0.53544e01, 0.51222e01, 0.53341e01, 0.48755e01/
data bmax /0.30605, 0.38239, 0.10258, 0.35331/
data cmax /0.11531e-1, 0.27872e-1, 0, 0.36475e-1/
real pdeiwc_mean(4), pdeiwc_max(4), pdeiwc_min(4)
data pdeiwc_min /14.2067, 29, 0, 0/
data pdeiwc_mean /19.6, 33.81, 0, 0/
data pdeiwc_max /27.76, 45.18, 0, 55.7/
real iwc_mean(4), iwc_max(4), iwc_min(4)
data iwc_min /5.e-5, 0, 0, 0/
data iwc_mean /9.2125e-7, 0.0024, 0, 0/
data iwc_max /1.75e-6, 0.0011, 0, 0.0082/
integer ncoef, nsat
real temp_i, ran1, x
real diff, diff_min, diff_max
real pde_max, pde_mean, pde_min, pde_ran
real pde_min_temp, pde_max_temp
real palpha, pbeta, pgama, peta, pde0, piwc0, pco0, paot
real a1denom, a2num, a2denom
!c--- add over
!C--- for NPDE = 3, De-IWC using satellite data
logical clean
real a_sat(2),b_sat(2)
data a_sat /4.07, 4.03/
data b_sat /0.032, 0.046/
!C--- for NPDE = 4, De-IWC-AOT using satellite data
real palpha_all(4),pbeta_all(4), pgamma_all(4), peta_all(4)
real pde0_all(4), piwc0_all(4), pco0_all(4)
!C--- dim: 1=Global; 2=South America; 3=Africa; 4=Asia
data palpha_all /1.322, 1.396, 1.842, 1.509/
data pbeta_all /0.544, 1.095, 1.823, 0.973/
data pgamma_all /0.407, 0.533, 0.520, 0.921/
data peta_all /0.085, 0.007, 0.005, 0.188/
data pde0_all /48.383, 55.536, 53.144, 35.03/
data piwc0_all /1.165, 1.7, 2.277, 2.204/
data pco0_all /7.322, 88.532, 157.24, 6.723/
!c--- add over
real coszenth(ims:idim, jms:jdim), albedo(ims:idim, jms:jdim)
real tskin(ims:idim,jms:jdim), tbound(ims:idim,jms:jdim)
real tsurface(ims:idim,jms:jdim)
real xlat(ims:idim,jms:jdim), xlong(ims:idim, jms:jdim)
real dswtop(ims:idim,jms:jdim) , dswbot(ims:idim,jms:jdim)
real uswtop(ims:idim,jms:jdim)
real netswbot(ims:idim,jms:jdim)
real swinc(ims:idim,jms:jdim)
real ulwbot(ims:idim,jms:jdim), dlwbot(ims:idim,jms:jdim)
real ulwtop(ims:idim,jms:jdim)
real netlwstr(ims:idim,jms:jdim), netlwbot(ims:idim,jms:jdim)
real dtshort(ims:idim,kms:kmax,jms:jdim)
real dtlongwv(ims:idim,kms:kmax, jms:jdim)
real deltat(ims:idim,kms:kmax,jms:jdim)
! add for ozone profile
! iprof = 1 : mid-latitude summer profile
! = 2 : mid-latitude winter profile
! = 3 : sub-arctic summer profile
! = 4 : sub-arctic winter profile
! = 5 : tropical profile
integer :: iprof
integer :: is_summer, ie_summer
real :: center_lat
integer :: NK
real :: RZERO, tsij, xt24, tloctm, hrang, xxlat, u0ij, &
& temp_iwc, temp_t, temp_de
!************************************************************************
!* Variables used in Fu-Liou code
!************************************************************************
real as(mbs),as1(10), ee(mbir)
real pij(kmax), tij(kmax), qij(kmax), o3ij(kmax)
real piwc(kmax-1), pde(kmax-1)
real plwc(kmax-1), pre(kmax-1)
real prwc(kmax-1), pgwc(kmax-1)
real PHYD(kmax)
!C-- change for fractional cloud
real cldamnt(kmax-1)
real cc_inho(kmax-1)
!C-- change over
real fds(kmax), fus(kmax), dts(kmax-1)
real fdir(kmax), fuir(kmax), dtir(kmax-1)
real fd(kmax), fu(kmax), dt_rad(kmax-1)
!***************************************************************************
!* Use Fu-Liou radiation routine and algorithm
!***************************************************************************
!C FAC CONVERTS TO DEGREES / TIME STEP
! FAC = 9.8d-01 * dtcolumn / (1.0030d04)
FAC = 0.01*G /Cp
!C CNVERT INCLUDES STEFAN BOLTZMAN CONSTANT FOR CALCULATION OF netlwstr
CNVERT = 1.171d-07*420.0d0/864.0d0
RZERO = 0.
!C*************************************************************************
if (ngas.eq.0) then
umco = 0.0
umo2 = 0.0
umno = 0.0
umso2 = 0.0
umno2 = 0.0
umch3cl = 0.0
umCFC11 = 0.0
umCFC12 = 0.0
end if
!************************************************************************************
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
!C--- aerosol input
!C---- No aerosol
if (NAERO.eq.0) then
! do j=jms,jdim
! do i=ims,idim
tau_aer = 0.0
endif
if (NAERO.eq.1) then
! do j=jms,jdim
! do i=ims,idim
tau_aer = 0.2
endif
!C---- aerosol data use uniform optical depth
! if (NAERO.eq.2) then
! do j=jms,jdim
! do i=ims,idim
! if (present(fraca_in)) then
! fraca = fraca_in
! nfraca = 0
! if (present(tau_aer_3D)) ivd = 2
! end if
! endif
!C--- get aerosol data from file
! if (NAERO.eq.2) then
!C print *, 'b4 read aero'
! open (unit=97,file='aero_gcm_annual.climo_4x5', status='old')
! read(97,*) ((tau_aer_2D(i,j), i=1,72),j=1,44)
!c open (unit=87,file='aero_gcm_annual_china.climo_4x5', status='old')
!c read(87,*) tau_aer_2D
!C print *, 'a4 read aero'
!c close(87)
! close(97)
! endif
!C-- add over
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
!********************************************************************************
!* Begin loop over the horizontal domain
!* Note: The vertical levels of radiation program starts from top, end at surface
!********************************************************************************
!**** start column ***********************
HORIZONTAL_J: do j = jts,jte
HORIZONTAL_I: do i = its,ite
! do 300 j=jms, jmid
! do 200 i=ims,imid
!C--- Zero out all water contents
VERTICAL_PROFILE: do k=kts,kte
piwc(k) = rzero
pde(k) = rzero
plwc(k) = rzero
pre(k) = rzero
prwc(k) = rzero
pgwc(k) = rzero
o3ij(k) = rzero
!c--- change for fractional cloud
cldamnt(k) = rzero
!c--- add for inhomogeneous cloud
if (ninho.eq.0) then
cc_inho(k) = 1.0
else
cc_inho(k) = 0.7
endif
!C--- change over
fds(k)=rzero
fus(k)=rzero
fdir(k)=rzero
fuir(k)=rzero
fd(k)=rzero
fu(k)=rzero
dts(k)=rzero
dtir(k)=rzero
dt_rad(k)=rzero
enddo VERTICAL_PROFILE
fds(kmax)=rzero
fus(kmax)=rzero
fdir(kmax)=rzero
fuir(kmax)=rzero
fd(kmax)=rzero
fu(kmax)=rzero
o3ij(kmax) = rzero
!C---- ee is the IR surface emissivity
ee(1:mbir) = emiss(i,j)
! *** the model k=1 start from sfc. need to reverse variable for radiation
! calculation
!C
tsij = tskin(i,j)
!C-- change by 2Yu, 12/05/01, deal with too big ts
if (tsij.gt.320.) tsij = 320.
if (tsij.lt.180.) tsij = 180.
!C--- change over
qij(1) = h2o(i,kmax,j)
qij(kmax) = h2o(i,1,j)
!C---- give a larger value for surface qij if too small. by Yu Gu 11/13/01
!C---- not necessary now when rad.F set minimum deltau value
if (qij(kmax).lt. 1.0e-20) qij(kmax) = 1.0e-20
if (qij(1).lt. 1.0e-20) qij(1) = 1.0e-20
!C
! *** calculate coszenth
xt24 = mod(xtime + radt * 0.5, 1440.)
tloctm = GMT + xt24 / 60. + XLONG(i,j) / 15.
hrang = 15. * (tloctm - 12.) * degrad
xxlat = XLAT(i,j) * degrad
u0ij = sin(xxlat) * sin(declin) + &
cos(xxlat) * cos(declin) * cos(hrang)
!C--- as is the solar surface albedo
as(1:mbs) = albedo(i,j)
! *** begin to assign column values for radiation calculations ***!
! *** need to vertically reverse variables
! NEED HYDROSTATIC PRESSURE HERE (MONOTONIC CHANGE WITH HEIGHT)
! PHYD REPLACES P8W, PHYDMID REPLACES P3D
PHYD(kts) = peven(I,kts,J)
DO K = KTS,KTE
PHYD(K+1) = peven(I,k+1,J)
ENDDO
! pij(1) = peven(i,kmax,j)/100.
! pij(kmax) = peven(i,1,j)/100.
pij(1) = PHYD(kmax)/100.
pij(kmax) = PHYD(1)/100.
!--- get ozone profile
if (NOZONE.eq.0.) then ! no ozone
po3(i,kms:kmax,j) = 0.
else if (NOZONE.eq.1) then ! prescribed ozone profile
!*******************************************************************!
!**************************************************************************
!--- add ozone profile
! need to change iprof, which is function of lat and julian day
! iprof = 1 : mid-latitude summer profile
! = 2 : mid-latitude winter profile
! = 3 : sub-arctic summer profile
! = 4 : sub-arctic winter profile
! = 5 : tropical profile
center_lat = xlat(i,j)
is_summer = 80 !Northern Hemisphere summer start
ie_summer = 265 !Northern Hemisphere summer end
IF (abs(center_lat) .le. 30. ) THEN ! tropic
iprof = 5
ELSE
IF (center_lat .gt. 0.) THEN
IF (center_lat .gt. 60. ) THEN ! arctic
IF (JULDAY .gt. is_summer .and. JULDAY .lt. ie_summer ) THEN
! arctic summer
iprof = 3
ELSE
! arctic winter
iprof = 4
ENDIF
ELSE ! midlatitude
IF (JULDAY .gt. is_summer .and. JULDAY .lt. ie_summer ) THEN
! north midlatitude summer
iprof = 1
ELSE
! north midlatitude winter
iprof = 2
ENDIF
ENDIF
ELSE
IF (center_lat .lt. -60. ) THEN ! antarctic
IF (JULDAY .lt. is_summer .or. JULDAY .gt. ie_summer ) THEN
! antarctic summer
iprof = 3
ELSE
! antarctic winter
iprof = 4
ENDIF
ELSE ! midlatitude
IF (JULDAY .lt. is_summer .or. JULDAY .gt. ie_summer ) THEN
! south midlatitude summer
iprof = 1
ELSE
! south midlatitude winter
iprof = 2
ENDIF
ENDIF
ENDIF
ENDIF
!--- iprof change over
call o3prof(iprof,kms,kmax,PHYD(kms:kmax)/100.,po3(i,kms:kmax,j))
else if (NOZONE.eq.2) then !ozone profile passed from WRF
! no input at this time; do nothing
endif
o3ij(1) = po3(i,kmax,j)
o3ij(kmax) = po3(i,1,j)
tij(1) = t8w(i,kmax,j)
tij(kmax) = t8w(i,1,j)
!C--- if temp > 320, set to 320. by yu Gu, 11/14/01, if < 180, set to 180
!C--- if change rad.F, no need to do it here
!c if (tij(1) . gt. 320.) tij(1) = 320.
!c if (tij(1) . lt. 180.) tij(1) = 180.
!c if (tij(kmax) . gt. 320.) tij(1) = 320.
!c if (tij(kmax) . lt. 180.) tij(1) = 180.
!!!!!!!!!!!!!!! Assign Column Profile -----
VERTICAL_PROFILE2: do k=2,kte
NK=kmax-k+kms !mark
pij(k) = PHYD(NK)/100.
tij(k) = t8w(i,NK,j)
o3ij(k)= po3(i,NK,j)
!c--- for water vapor
IF (F_QV) THEN
qij(k) = h2o(i,NK,j)
ENDIF
if (qij(k).lt. 1.0e-20) qij(k) = 1.0e-20
!C
!c--- for liquid water
IF (F_QC) THEN
plwc(k) = cld_wlcld(i,NK-1,j)*air_den(i,NK-1,j)
! --- convert water content to g/m**3
plwc(k) = plwc(k)*1.e3
ENDIF
!c--- for rain water and graupel
IF (F_QR) THEN
prwc(k) = cld_prwc(i,NK-1,j)*air_den(i,NK-1,j)
prwc(k) = prwc(k)*1.e3
ENDIF
IF (F_QG) THEN
pgwc(k) = cld_pgwc(i,NK-1,j)*air_den(i,NK-1,j)
pgwc(k) = pgwc(k)*1.e3
ENDIF
!c--- for ice water
IF ( F_QI ) THEN
! -- add snow into ice
piwc(k) = (cld_iccld(i,NK-1,j)+cld_snow(i,NK-1,j)) &
*air_den(i,NK-1,j)
piwc(k) = piwc(k)*1.e3
ELSE
IF (.not.warm_rain) THEN
IF (tij(k).lt.273.15) then
! assign liquid as ice
piwc(k) = plwc(k)
plwc(k) = 0.
! assign rain as snow and add into ice
piwc(k) = piwc(k) + prwc(k)
prwc(k) = 0.
ENDIF
ENDIF
ENDIF
! --- radius of liquid water droplet
if (plwc(k).gt.0) then
!c pre(k) = 20.
!C--- test change to 10 um (04/23/02)
pre(k) = 10.
if (k.eq.kmax-1) pre(k) = 10.
endif
!C******************************************************************
!C******************************************************************
!C--- calculate ice crystal size
!C******************************************************************
!C******************************************************************
!C******************************************************************
!C--- NPDE=1, papa. in terms of IWC & T (Gu & Liou, 2006)
!C***********************************************************************
if (NPDE.eq.1.and.piwc(k).gt.0.) then
!C--- for temperature between 213K and 253K
if (degrees(i,NK,j).lt.253. &
.and.degrees(i,NK,j).gt.213.) then !mchen
TEMP_IWC = exp(-7.6 &
+4.*exp(-0.2443e-3*(253.-degrees(i,NK,j))**2.445)) !mchen
TEMP_T = degrees(i,NK,j) - 273. !mchen
TEMP_DE = 326.3+12.42*TEMP_T+0.197*TEMP_T*TEMP_T &
!c TEMP_DE = 326.3+12.42*TEMP_T-0.197*TEMP_T*TEMP_T
+0.0012*TEMP_T**3
pde(k) = (piwc(k)/TEMP_IWC)**(1./3.)*TEMP_DE
if (pde(k).gt.150.) pde(k)=150.
if (pde(k).lt.10.) pde(k)=10.
else
!C--- for temperature outside 213K and 253K
pde(k) = 85.
endif
!c--- end if temperature for NPDE=1
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
!C***********************************************************************
!C---- NPDE=2, new de para. in terms of iwc (Liou et al. 2008)
!C***********************************************************************
else if (NPDE.eq.2.and.piwc(k).gt.0.) then
!C--- for tropics
! if (j.ge.17.and.j.le.28) ncoef = 1
if (abs(xlat(i,j)).lt.30.) ncoef = 1
!C--- for midlatitude
! if (j.lt.17.and.j.gt.7.or.j.gt.28.and.j.le.38) then
if (abs(xlat(i,j)).ge.30.and.abs(xlat(i,j)).le.60.) then
!C--- for cold cirrus
if (degrees(i,NK,j).lt.233) then !mchen
ncoef = 2
else ! for warm cirrus
ncoef = 3
endif
endif
!C--- for polar region
if (abs(xlat(i,j)).gt.60.) ncoef = 4
!C--- calculate ln(De)
temp_i = log(piwc(k))
pde_mean = amean(ncoef)+bmean(ncoef)*temp_i &
+cmean(ncoef)*temp_i**2.
pde_max = amax(ncoef)+bmax(ncoef)*temp_i &
+cmax(ncoef)*temp_i**2.
pde_min = amin(ncoef)+bmin(ncoef)*temp_i &
+cmin(ncoef)*temp_i**2.
!C--- calculate de
pde_mean = exp(pde_mean)
pde_max = exp(pde_max)
pde_min = exp(pde_min)
!C--- if IWC smaller than critical, use a constant value
if (piwc(k).le.iwc_mean(ncoef)) pde_mean = pdeiwc_mean(ncoef)
if (piwc(k).le.iwc_max(ncoef)) pde_max = pdeiwc_max(ncoef)
if (piwc(k).le.iwc_min(ncoef)) pde_min = pdeiwc_min(ncoef)
if (pde_max.eq.1) pde_max = pdeiwc_max(ncoef)
if (pde_min.eq.1) pde_min = pdeiwc_min(ncoef)
! -- generate a random number between pde_min and pde_max
call random_number(x)
ran1 = x
diff_max = pde_max - pde_mean
diff_min = pde_mean - pde_min
diff = diff_max
!C-- using smaller difference
!c if (diff_min.lt.diff_max) diff = diff_min
!C-- using larger difference
if (diff_min.gt.diff_max) diff = diff_min
pde_min_temp = pde_mean - diff
pde_max_temp = pde_mean + diff
pde_ran = (pde_max_temp-pde_min_temp)*ran1 + pde_min_temp
!C---- constraint for larger difference if needed
!c if (pde_ran .gt. pde_max) pde_ran = pde_max
!c if (pde_ran .lt. pde_min) pde_ran = pde_min
!c print *, 'pde_mean, max, min,ran=', pde_mean,pde_max,pde_min
!c & , pde_ran
!C--- calculate De
if (pderandom) then
pde(k) = pde_ran
else
pde(k) = pde_mean
endif
!C--- end for different region
!C--- if para. out of De range
if (pde(k).gt.150.) pde(k)=150.
if (pde(k).lt.10.) pde(k)=10.
!c--- end of npde=2
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
!C******************************************************************
!C--- NPDE = 3
!C******************************************************************
else if (NPDE.eq.3.and.piwc(k).gt.0.) then
!C---- for clean
if (clean) then
ncoef = 1
else
ncoef = 2
endif
!C--- calculate ln(De)
temp_i = log(piwc(k))
pde_mean = a_sat(ncoef)+b_sat(ncoef)*temp_i
!C--- calculate de
pde_mean = exp(pde_mean)
pde(k) = pde_mean
!C--- if para. out of De range
if (pde(k).gt.150.) pde(k)=150.
if (pde(k).lt.10.) pde(k)=10.
!c--- end of npde=3
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
!C******************************************************************
!C--- NPDE =4
!C--- De-IWC-AOT relations from satellite data
!C******************************************************************
else if (NPDE.eq.4.and.piwc(k).gt.0.) then
!C--- Coefficients for De parameterizations
!c--- for South America: -40<lat<15(j), 270<lon<355(i)
if (j.ge.13.and.j.le.27.and.i.ge.19.and.i.le.32) then
NSAT = 2
palpha = palpha_all(nsat)
pbeta =pbeta_all(nsat)
pgama = pgamma_all(nsat)
peta = peta_all(nsat)
pde0 = pde0_all(nsat)
piwc0 = piwc0_all(nsat)
pco0 = pco0_all(nsat)
!C--- AOT for polluted (0.5) or clean (0.2)
!c paot = tau_aer_2D(i,j)
paot = 0.5
!C****piwc use mg/m**3
a1denom = (piwc(k)*1000./piwc0)**(-palpha) + 1.
a2num = (peta*paot-1.1108)**pgama
a2denom = (peta*paot-1.1108)**pbeta + 1.
!C--- effective radius
pde(k) = (pde0/a1denom)*(a2num/a2denom)
!C--- convert to mean effective size for hexagonal (Fu 1996)
!c pde(k) = pde(k) * 8./(3*sqrt(3))
!C--- convert to mean effective size for mixture
!C----(Francis et al 1994; Chou et al 2002)
pde(k) = 2. * pde(k)
!c print *, pde(k)
!C--- if para. out of De range
if (pde(k).gt.150.) pde(k)=150.
!c if (pde(k).lt.10.) pde(k)=10.
if (pde(k).le.15.) pde(k)=15.
!C--- for outside South America, use prescribed De
else
pde(k) = 85.
end if
!c--- end of npde=4
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
!c--- NPDE=0, prescribed pde
!C******************************************************************
else
if (piwc(k).gt.0.) then
!CCCCCCCCCCCC-------- CTRL value --------CCCCCCCCCCCCCC
pde(k) = 85.
endif
endif
!C------------ Over for pde calculation
!C***************************************************************************
!!!!!!!!!!!!!!!--- Cloud Fraction-----------
!C--- add for fractional cloud
if (nfract.eq.1) then
if (plwc(k).gt.0. .or. piwc(k).gt.0.) then
cldamnt(k) = cloudstrf(i,NK,j)
endif
endif
!--- if nfract=0, no cloud fraction
if (nfract.eq.0) then
if (plwc(k).gt.0. .or. piwc(k).gt.0.) then
cldamnt(k) = 1.
endif
endif
end do VERTICAL_PROFILE2
!100 continue
!C--- add by Yu for aerosol
if (NAERO.ge.1) then
if (nfraca.eq.0) then ! -- aerosol type information from driver
do iac = 1, mxac
if (fraca(iac).gt.0.0) itps(iac) =1
end do
else if (nfraca.eq.1) then ! -- precribed aerosol type information
fraca(2) = 0.9 !fraction of continental aerosols
fraca(11) = 0.1 !fraction of soot aerosols
do iac = 1, mxac
if (fraca(iac).gt.0.0) itps(iac) = 1
end do
else if (nfraca.eq.2) then ! -- type in aerosol types and fractions
else if (nfraca.eq.3) then ! -- type in aerosol optical depth for each type
end if
! if (present(tau_aer_3D)) then
! tau_aer = sum(tau_aer_3D(i,j,1:kmax-1))
! else if (present(tau_aer_2D)) then
! tau_aer = tau_aer_2D(i,j)
! else
! tau_aer = 0.2
! end if
do iac = 1, mxac
if (itps(iac).eq.1) then
Select case (ivd)
case default
CALL wrf_error_fatal('ivd: No VERTICAL Aerosol Profile') !mchen
case(0)
case(1)
sh_aer(iac) = 3.
call aer_scale_hgt(kmax-1,pij,sh_aer(iac),aprofs(1:kmax-1,iac))
! case(2)
! aprofs(1:kmax-1,iac) = tau_aer_3D(i,j,1:kmax-1) / tau_aer
! case(3) !ivd=3, inpput vertical AOD profile for each aerosol type
end Select
a_wlis(1,iac)= 0.53 !Wavelength (microns) corresponding to "a_tau"
a_taus(1,iac)= tau_aer * fraca(iac)
end if
end do
end if
!C--- aerosol type
! itp=0
! if( aerosol_type(1:3) == 'mar' ) itp=1
! if( aerosol_type(1:3) == 'con' ) itp=2
! if( aerosol_type(1:3) == 'urb' ) itp=3
! if( aerosol_type(1:3) == '0.5' ) itp=4
! if( aerosol_type(1:3) == '1.0' ) itp=5
! if( aerosol_type(1:3) == '2.0' ) itp=6
! if( aerosol_type(1:3) == '4.0' ) itp=7
! if( aerosol_type(1:3) == '8.0' ) itp=8
! if( aerosol_type(1:3) == 'INS' ) itp=9
! if( aerosol_type(1:3) == 'WAS' ) itp=10
! if( aerosol_type(1:3) == 'SOO' ) itp=11
! if( aerosol_type(1:3) == 'SSA' ) itp=12
! if( aerosol_type(1:3) == 'SSC' ) itp=13
! if( aerosol_type(1:3) == 'MIN' ) itp=14
! if( aerosol_type(1:3) == 'MIA' ) itp=15
! if( aerosol_type(1:3) == 'MIC' ) itp=16
! if( aerosol_type(1:3) == 'MIT' ) itp=17
! if( aerosol_type(1:3) == 'SUS' ) itp=18
!C--- aerosol humidity dependence
! ifg = 0
!C--- aerosol composition
!C--- fraction for the second type
! iafrac = 2
!C--- only one type
!c iafrac = 0
! if( iafrac == 0) fraca=0
! if( iafrac == 1) fraca=0.01
! if( iafrac == 2) fraca=0.10
! if( iafrac == 3) fraca=0.50
! if( iafrac == 4) fraca=1.0
!c do iclrcld=1,1 !!!! 0,1
!C-- cloudy(1) or clear (1)
! iclrcld = 1
! a_wlis =-9999.
! a_taus =-9999.
! itps = -9999
!C--- aerosol constiuents
!C-- two constituents
! nac=2
!C-- one constituent
! nac=1
! itps(1)=itp ! PRIMARY
! itps(2)=11 ! soot
! sh_aer(1)=3.
! sh_aer(2)=3.
! do iac=1,nac
! ivd=0 !! AEROSOL VERTICAL PROFILE
! ivd=1 !! USER PROVIDED AEROSOL VERTICAL PROFILE
!c print *, "b4 scale"
! if( ivd == 1) then
! call aer_scale_hgt(nv,pij,sh_aer(iac),aprofs(1:nv,iac))
! endif
! iaform = 3
! if (iaform == 1) then
! n_atau = 1
! a_wlis(1,iac)= 0.53
! a_taus(1,1)= tau_aer* (1.0-fraca)
! a_taus(1,2)= tau_aer* fraca
! a_taus(1,3)= tau_aer*0.20
!MFRSR
! n_atau = 5
! a_wlis(1:n_atau,iac) =(/0.413,0.500,0.609,0.664,0.860/)
! a_taus(1:n_atau,iac) =(/0.179,0.137,0.099,0.094,0.06/)
! a_taus(1:n_atau,iac) = a_taus(1:n_atau,iac)* (tau_aer/ a_taus(2,iac))
!CIMEL
! else if ( iaform == 3 ) then
! n_atau = 7
! a_wlis(1:n_atau,iac) = (/ .340, .380, .440, .500, .670, .870, 1.020/)
! a_taus(1:n_atau,iac) = (/0.275,0.232 , 0.180, 0.147, 0.087, 0.067, 0.063/)
! a_taus(1:n_atau,iac)=a_taus(1:n_atau,iac)*(tau_aer/ a_taus(4,iac))/float(nac)
! endif
!c print*,' Aerosol Constituent' ,iac ,itps(iac)
!c write(6,'(a15,10f8.4)') 'Wavelength :',a_wlis(1:n_atau,iac)
!c write(6,'(a15,10f8.4)') 'AEROSOL TAU :',a_taus(1:n_atau,iac)
! enddo
! endif
!C--- add for aerosol over
!--- calculate nclouds
nsubcld = (kmax-2)/ngroup
nclouds = nsubcld * ngroup
!*****************************************************************
!* Call Fu-Liou radiation program
!*****************************************************************
!C call rad(as, u0ij, solcon, tsij, ee)
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
!C---- unified program to include all choices
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
call rad_all ( kmax-1, kmax, &
& as, u0ij, solcon, tsij, ee &
!C--- atmospheric profile
& , pij, tij, qij, o3ij &
!C--- cloud water content and sizes
& , piwc, pde, plwc, pre, prwc, pgwc &
!C--- cloud amount
& , cldamnt &
!c--- cloud inhomogeneity factor
& , cc_inho &
!c--- for aerosol
& , a_wlis, a_taus, aprofs &
!C--- output: fluxes and heating rates
& , fds, fus, dts, fdir, fuir, dtir &
& , fd, fu, dt_rad &
& )
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
!**********************************************************************
!* Store the output from Fu-Liou code into standard arrays
!**********************************************************************
!*** surface
!*** net solar at sfc
netswbot(i,j) = fds(kmax) - fus(kmax)
!*** downward solar at sfc
dswbot(i,j) = fds(kmax)
!*** downward IR at sfc
dlwbot(i,j) = fdir(kmax)
!*** upward IR at sfc
ulwbot(i,j) = fuir(kmax)
!*** net IR at sfc
netlwbot(i,j) = fuir(kmax) - fdir(kmax)
!*** TOA
!*** downward solar at top
swinc(i,j) = fds(1)
!*** upward solar at toa
uswtop = fus(1)
!*** net solar at toa
dswtop(i,j) = fds(1) - fus(1)
!*** upward IR at TOA
ulwtop(i,j) = fuir(1)
!*** value test
if (abs(ulwtop(i,j)).gt.1000.) then
! write (0,*) 'i=',i,' j=',j,' ulwtop=',ulwtop(i,j)
! write(0,*) 'fd=', fds
! write(0,*) 'fus=', fus
! write(0,*) 'fdir=', fdir
! write(0,*) 'fuir=', fuir
! write (0,*) '---------------------------'
! write (0,*) as, u0ij, solcon, tsij,ee
! write (0,*) '---------------------------'
! do ii=1,kmax
! write (0,*) pij(ii), tij(ii), qij(ii), o3ij(ii)
! enddo
! write (0,*) '---------------------------'
! do ii=1,kmax-1
! write (0,*) piwc(ii), pde(ii), plwc(ii), pre(ii),prwc(ii), pgwc(ii) &
! , cldamnt(ii)
! enddo
CALL wrf_error_fatal('Flux out of range. Stop program') !mchen
endif
!C---test oevr
!**********************************************************************************
!* Update the total column physics increment to theta
!**********************************************************************************
do k = 1,kte
NK=kte-k+kms
!--- heating rate in k s-1
dtshort(i,k,j) = dts(NK) * FAC/pi3d(i,k,j)
dtlongwv(i,k,j) = dtir(NK) * FAC/pi3d(i,k,j)
! deltat(i,k,j) = dt_rad(NK) * FAC
deltat(i,k,j) = deltat(i,k,j) + dt_rad(Nk) * FAC/pi3d(i,k,j)
!--- heating rate in pa k s-1
! dtshort(i,k,j) = dtshort(i,k,j)*(pij(NK)-pij(NK-1))*100.
! dtlongwv(i,k,j) = dtlongwv(i,k,j)*(pij(NK)-pij(NK-1))*100.
! deltat(i,k,j) = deltat(i,k,j)*(pij(NK)-pij(NK-1))*100.
! dtshort(i,k,j) = dts(NK) * FAC/pi3d(i,K,j)
! dtlongwv(i,k,j) = dtir(NK) * FAC/pi3d(i,k,j)
!*** Value test
if (abs(dtir(Nk)).gt.100.) then
CALL wrf_error_fatal('Heating rate out of range. Stop program') !mchen
endif
!C---test oevr
enddo
200 continue
300 end do HORIZONTAL_I
end do HORIZONTAL_J
!*************************************************************************
!* End of routine driver_rad.F
!*************************************************************************
return
end subroutine RAD_FLG
!c
!c Liner interpolation between two points.
!c
subroutine intrpl(x1,y1,x2,y2,x,y)
implicit none
real x1, x2, y1, y2, x, y, slope
if (x2.eq.x1) then
y = y1
else
!C--- use p
slope=(y2-y1)/(x2-x1)
y=y1+slope*(x-x1)
!C--- use log(p)
!c if (x2.eq.x1) then
!c y = y1
!c else
!c slope=(y2-y1)/(alog(x2/x1))
!c y=y1+slope*(alog(x/x1))
endif
return
end subroutine intrpl
subroutine aer_scale_hgt(nv,pp,h,aprof) 1
implicit none
integer nv
real pp(nv+1)
real aprof(nv)
real pbar, z, tot, h
integer i
do i=1,nv
pbar= ( pp(i)+pp(i+1) ) *0.5
z= 8.0* log( pp(nv+1) /pbar )
aprof(i)= exp(-z/h)
! print'(4f10.1,f10.2)',pp(i),pp(i+1),pbar,z,aprof(i)
enddo
tot= sum(aprof(1:nv))
! print*,tot
aprof = 100*(aprof/tot) !! aprof in %
return
end subroutine aer_scale_hgt
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
!C---- radiation program for UCLA AGCM
!C-----with all modifications
!C---- with fractional cloud cover and aerosol
!C---- with new ice parameterization and gases
!C---- Control by parameters
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
subroutine rad_all ( nv, nv1 & 1,27
& , asij, u0, ss, pts, eeij &
!C--- atmospheric profile
& , pij, tij, qij, o3ij &
!C--- cloud water content and sizes
& , piwcij, pdeij, plwcij, preij &
& , prwcij, pgwcij &
!C--- cloud amount
& , cldamntij &
!c--- cloud inhomogeneity factor
& , cc_inhoij &
!c--- for aerosol
& , a_wlisij, a_tausij, aprofsij &
!C--- output: fluxes and heating rates
& , fdsij, fusij, dtsij &
& , fdirij, fuirij, dtirij &
& , fdij, fuij, dtij &
& )
!c *********************************************************************
!c In this radiation scheme, six and 12 bands are selected for solar
!c and thermal IR regions, respectively. The spectral division is below:
!c 0.2 - 0.7 um, 0.7 - 1.3 um, 1.3 - 1.9 um, 1.9 - 2.5 um, 2.5 -3.5 um, &
!c 3.5 - 4.0 um, and 2200 - 1900 cm**-1, 1900 - 1700 cm**-1, 1700 -1400
!c cm**-1, 1400 - 1250 cm**-1, 1250 - 1100 cm**-1, 1100 - 980 cm**-1, &
!c 980 - 800 cm**-1, 800 - 670 cm**-1, 670 - 540 cm**-1, 540 - 400 cm
!c **-1, 400 - 280 cm**-1, 280 - 0 cm**-1, where the index for the
!c spectral band ( ib = 1, 2, ..., 18 ) is defined.
!c
!c **********************
!c * INPUT PARAMETERS *
!c **********************
!c as(mbs) solar surface albedo, mbs = 6
!c u0 cosine of solar zenith angle
!c ss solar constant ( W / m ** 2 )
!c pts surface temperature ( K )
!c ee(mbir) IR surface emissivity, mbir = 12
!c pp(nv1) atmospheric pressure ( mb )
!c pt(nv1) atmospheric temperature ( K )
!c ph(nv1) water vapor mixing ratio ( kg / kg )
!c po(nv1) ozone mixing ratio ( kg / kg )
!c pre(nv) effective radius of water cloud ( um )
!c plwc(nv) liquid water content ( g / m ** 3 )
!c pde(nv) effective size of ice cloud ( um )
!c piwc(nv) ice water content ( g / m ** 3 )
!c prwc(nv) rain water content ( g / m ** 3 )
!c pgwc(nv) graupel water content ( g / m ** 3 )
!c or aerosol concentration (m-3)
!c umco2 concentration of CO2 (ppmv)
!c umch4 concentration of CH4 (ppmv)
!c umn2o concentration of N2O (ppmv)
!c
!c Note: (1) as(mbs) and ee(mbir) consider the substantial wavelength
!c dependence of surface albedos and emissivities.
!c (2) For CO2, CH4 and N2O, uniform mixing is assumed through
!c the atmosphere with concentrations of 330, 1.6 and 0.28
!c ppmv, respectively. The concentrations can be changed
!c through 'common /umcon/ umco2, umch4, umn2o '.
!c (3) nv, nv1, nv, nv1, nv * 4, mb, mbs, mbir, and nc are
!c given through 'para.file'.
!c (4) nv1 and 1 are the surface and top levels, respectively.
!c
!c **********************
!c * OUTPUT PARAMETERS *
!c **********************
!c fds(nv1) downward solar flux ( W / m ** 2 )
!c fus(nv1) upward solar flux ( W / m **2 )
!c dts(nv) solar heating rate ( K / day )
!c fdir(nv1) downward IR flux ( W / m ** 2 )
!c fuir(nv1) upward IR flux ( W / m **2 )
!c dtir(nv) IR heating rate ( K / day )
!c fd(nv1) downward net flux ( W / m ** 2 )
!c fu(nv1) upward net flux ( W / m **2 )
!c dt(nv) net heating rate ( K / day )
!c
!c Note: Solar, IR, and net represent 0.2 - 0.4 um, 2200 - 0 cm**-1, &
!c and entire spectral regions, respectively.
!c
!c *********************************************************************
!# include "para.file"
USE PARA_FILE
USE control_para, fourssl=>d4s,twossl=>d2s,foursir=>d4ir,twosir=>d2ir
implicit none
integer :: nv, nv1
!C--- input from GCM
real pij(nv1), tij(nv1), qij(nv1), o3ij(nv1)
real piwcij(nv), pdeij(nv)
real cldamntij(nv)
real cc_inhoij(nv)
real plwcij(nv), preij(nv)
real prwcij(nv), pgwcij(nv)
real fdsij(nv1), fusij(nv1), dtsij(nv)
real fdirij(nv1), fuirij(nv1), dtirij(nv)
real fdij(nv1), fuij(nv1), dtij(nv)
!C--- aerosol optical properties
real, dimension(mxat,mxac) :: a_wlisij,a_tausij
real, dimension(nvx,mxac) :: aprofsij
! integer, dimension(mxac) :: itpsij
!C--- variables in the offline version
real, dimension(nv1) :: pp, pt, ph, po
real, dimension(nv1) :: fds, fus, fdir, fuir, fd, fu
real, dimension(nv) :: dts, dtir, dt
real, dimension(nv) :: piwc, plwc, pgwc, prwc, &
& pde, pre, cldamnt
real :: asij(mbs), eeij(mbir)
real :: as(mbs), ss, ee(mbir)
real :: pts, u0
real, dimension(nv1) :: fu1, fd1
real :: bf(nv1), bs
real, dimension(nv) :: wc1, wc2, wc3, wc4, wc, tt
! -- add for partial clouds
real :: area_group(3,2), cld_group(3)
integer :: n_group(3), nb(3), n_loop(3)
real, dimension(nv,2) :: wc1_2, wc2_2, wc3_2, wc4_2, wc_2, &
& tt_2, tc_2
integer :: nc1, nc2, nc3, k, kl, kk
! -- add for partial clouds
real, dimension(nv1) :: fds_tot, fus_tot, fdir_tot, fuir_tot, &
& fd_tot, fu_tot
real :: ctau(nv)
real :: hk, fuq1, fuq2, xx, dz(nv), trp(nv)
integer :: ib, mbn, kg1_num, kg2_num, iac, ig1, ig2, i !cycle control
real, dimension(nvx,mbx,mxac) :: &
& a_tau1,a_ssa1,a_asy1, &
& a_tau2,a_ssa2,a_asy2
real, dimension(mxat,mxac) :: a_wlis,a_taus
real, dimension(nvx,mxac) :: aprofs
! integer, dimension(mxac) :: itps
real :: ti(nv), wi(nv), wwi(nv,4)
real :: tw(nv), ww(nv), www(nv,4)
real :: trn(nv), wrn(nv), wwrn(nv,4)
real :: tgr(nv), wgr(nv), wwgr(nv,4)
real :: tae(nvx,mxac), wae(nvx,mxac), wwae(nvx,4,mxac)
real :: tgm(nv)
real :: tr(nv), wr(nv), wwr (nv,4), tg(nv)
real :: area
real :: cc_inho(nv)
!c kg(mb) is the number of intervals to perform the g-quadrature in
!c each band to consider the nongray gaseous absorption. In total, &
!c we need to perform 121 spectral calculations in the scattering
!c problem for each atmospheric profile.
integer, dimension(mb) :: kg, kg1, kg2
data kg / 10, 8, 12, 7, 12, 5, &
& 2, 3, 4, 4, 3, 5, 2, 10, 12, 7, 7, 8 /
!!!!! -- change by Zhang Feng for trace gases
data kg1 / 10, 12, 12, 20, 20, 20, &
& 2, 3, 4, 4, 3, 5, 2, 10, 12, 7, 7, 8 /
data kg2 /1, 12, 1, 20, 20, 1, &
& 1, 1, 1, 1, 1, 1, 1, 1 , 1, 1, 1, 1 /
!CCCCCCCCCC-- change over
real :: f0 = 1.0 / 3.14159
!C-- add for aerosol
if (naero.ge.1) then
a_wlis = a_wlisij
a_taus = a_tausij
aprofs = aprofsij
! itps = itpsij
!
end if
!C-- over
!C---
do i = 1, nv1
!C---- assign input to fu-liou variables
pp(i) = pij(i)
pt(i) = tij(i)
ph(i) = qij(i)
po(i) = o3ij(i)
!C-----
fds(i) = 0.0
fus(i) = 0.0
fdir(i) = 0.0
fuir(i) = 0.0
10 end do
as = asij
ee = eeij
do i = 1, nv
!C---- assign input to fu-liou variables
piwc(i) = piwcij(i)
pde(i) = pdeij(i)
plwc(i) = plwcij(i)
pre(i) = preij(i)
prwc(i) = prwcij(i)
pgwc(i) = pgwcij(i)
cldamnt(i) = cldamntij(i)
cc_inho(i) = cc_inhoij(i)
end do
!C---
call thicks(nv,nv1,pp,pt,ph,po,dz)
call rayle2(nv,nv1,pp,pt,ph,po,trp)
!C--- add by Yu (01/2003) for aerosol
if (naero.ge.1) then
call aerosol_init(nv,nv1,pp,pt,ph,po,dz, &
a_tau1,a_ssa1,a_asy1, &
a_tau2,a_ssa2,a_asy2, &
a_wlis,a_taus,aprofs &
)
end if
!C-- over
if ( u0 .le. 1.0e-4 ) then
mbn = mbs + 1
else
mbn = 1
endif
do ib = mbn, mb
if (nice.eq.1) then
! --------- using new coefficients
call ice_new_ZF ( nv,nv1,ib,pre,pde,plwc,piwc,dz,ti,wi,wwi )
else if (nice.eq.2) then
! --------- using new coefficients by Qing for combine
call ice_new_comb ( nv,nv1,ib,pre,pde,plwc,piwc,dz,ti,wi,wwi )
else if (nice.eq.3) then
! --------- using new coefficients by Qing for tropics
call ice_new_trop ( nv,nv1,ib,pre,pde,plwc,piwc,dz,ti,wi,wwi )
else if (nice.eq.4) then
! --------- using new coefficients by Qing for midlat
call ice_new_midlat ( nv,nv1,ib,pre,pde,plwc,piwc,dz,ti,wi,wwi )
else if (nice.eq.5) then
! --------- using FLIce98
call ice_98 ( nv,nv1,ib,pre,pde,plwc,piwc,dz,ti,wi,wwi )
else if (nice.eq.6) then
! --------- using single ice by Feng using new data Ping Yang 2000
call ice_singleice ( nv,nv1,ib,pre,pde,plwc,piwc,dz,ti,wi,wwi )
else if (nice.eq.7) then
! --------- using single ice by Qing using new data Ping Yang 2005
call ice_new_Single ( nv,nv1,ib,pre,pde,plwc,piwc,dz,ti,wi,wwi )
else
! --------- use old ice coefficients FLIce93
call ice ( nv,nv1,ib,pre,pde,plwc,piwc,dz,ti,wi,wwi )
endif
call water_fl ( nv,nv1,ib,pre,plwc,pde,piwc,dz,tw,ww,www )
call rain ( nv,nv1,ib,prwc,dz,trn,wrn,wwrn )
call graup ( nv,nv1,ib,pgwc,dz, tgr,wgr,wwgr )
!C--- add for aerosol by Yu (01/2003)
!c---------- 4/1/97 (3)
! No more ipr option
!c if (ib.ne.1) then
!C-- nor sub-intervals
if (naero.ge.1) then
call aerosolxy (nv,nv1,ib,'x',a_tau1,a_ssa1,a_asy1, &
& a_tau2,a_ssa2,a_asy2,tae,wae,wwae &
& )
ctau(ib)=0.
do i=1,nv
do iac=1,mxac
if (itps(iac).eq.1) ctau(ib)=ctau(ib)+tae(i,iac)
end do
end do
endif
!c print *, 'ctau=',ctau
!c endif
!c---------- 4/1/97 (3)
!C-- over
call rayle ( nv,nv1,ib,trp,tr,wr,wwr,u0 )
call gascon ( nv,nv1,ib,tgm,pp,pt,ph,po )
if ( ib .gt. mbs ) then
call planck ( nv,nv1,ib,pts,pp,pt,ph,po,bf,bs )
endif
!C---- change by Yu for new trace gases
if (ngas.eq.0) then
kg1_num=kg(ib)
kg2_num=1
end if
if (ngas.eq.1) then
kg1_num=kg1(ib)
kg2_num=kg2(ib)
end if
!c do 30 ig = 1, kg(ib)
do ig1 = 1, kg1_num
do ig2 = 1, kg2_num
! -- changed by Yu for new gases, 11/2006
if (ngas.eq.0) then
! call gases ( ib, ig, hk )
call gases ( nv,nv1,ib, ig1, hk,pp,pt,ph,po,tg )
end if
if (ngas.eq.1) then
call gases_new ( nv,nv1,ib, ig1,ig2, hk,pp,pt,ph,po,tg )
end if
!C--- change over
!C--- with aerosol, partly cloudy, depending on parameter
call comscp_aero_cld ( nv,nv1 &
& ,cldamnt,area_group,cld_group &
& ,n_group,nb &
& ,ti,wi,wwi,tw,ww,www &
& ,trn,wrn,wwrn,tgr,wgr,wwgr &
& ,tr,wr,wwr,tgm,tg,tae,wae,wwae &
& ,wc1,wc2,wc3,wc4,wc,tt,tc_2 &
& ,wc1_2,wc2_2,wc3_2,wc4_2,wc_2,tt_2 &
& ,cc_inho &
& )
!C--- 02/13/02 Yu Gu
!C--- change by Yu for fractional cloud - calculate radiation for each section
do nc1 = nb(1), n_group(1)
do nc2 = nb(2), n_group(2)
do nc3 = nb(3), n_group(3)
n_loop(1) = nc1
n_loop(2) = nc2
n_loop(3) = nc3
!c--- fractional area for each section
area = area_group(1,nc1)*area_group(2,nc2) &
& *area_group(3,nc3)
!c print *, 'area=', area
!c--- calculated total tao for layer above cloud layers
tt_2(1,1) = tc_2(1,1)
tt_2(1,2) = tc_2(1,2)
! do i = 2, nv-nclouds
do i = 2, nv-nsubcld*ngroup
tt_2(i,1) = tt_2(i-1,1) + tc_2(i,1)
tt_2(i,2) = tt_2(i-1,2) + tc_2(i,2)
220 end do
!C--- assign the optical properties for each section
!c--- for layers above clouds
! do k = 1,nv-nclouds
do k = 1,nv-nsubcld*ngroup
wc1(k) = wc1_2(k,1)
wc2(k) = wc2_2(k,1)
wc3(k) = wc3_2(k,1)
wc4(k) = wc4_2(k,1)
wc(k) = wc_2(k,1)
tt(k) = tt_2(k,1)
enddo
! -- for cloudy layers
do k=1,ngroup
! kl = (k-1)*nsubcld + nv1-nclouds
kl = (k-1)*nsubcld + nv1-nsubcld*ngroup
do kk = kl, kl+nsubcld-1
wc1(kk) = wc1_2(kk, n_loop(k))
wc2(kk) = wc2_2(kk, n_loop(k))
wc3(kk) = wc3_2(kk, n_loop(k))
wc4(kk) = wc4_2(kk, n_loop(k))
wc(kk) = wc_2(kk, n_loop(k))
tt(kk) = tt(kk-1) + tc_2(kk,n_loop(k))
!c tt_2(kk,n_loop(k)) = tt_2(kk-1,n_loop(k)) + tc_2(kk,n_loop(k))
!c tt(kk) = tt_2(kk, n_loop(k))
enddo
enddo
!c 11/4/95 (begin)
if ( ib .le. mbs ) then
if ( fourssl ) then
call qfts ( nv,nv1,ib, as(ib), u0, f0, &
& wc1,wc2,wc3,wc4,wc,tt,fu1,fd1 )
endif
if ( twossl ) then
quadra = .false.
hemisp = .false.
edding = .true.
call qftsts ( nv,nv1,ib, as(ib), u0, f0, &
& wc1,wc2,wc3,wc4,wc,tt,fu1,fd1 )
endif
do i = 1, nv1
! fds(i) = fds(i) + fd1(i) * hk
! fus(i) = fus(i) + fu1(i) * hk
fds(i) = fds(i) + fd1(i) * hk * area
fus(i) = fus(i) + fu1(i) * hk * area
40 end do
else
if ( foursir ) then
call qfti ( nv,nv1,ib, ee(ib-mbs), bf, bs, &
& wc1,wc2,wc3,wc4,wc,tt,fu1,fd1 )
endif
if ( twosir ) then
quadra = .false.
edding = .false.
hemisp = .true.
! -- 2-4-stream combination for IR
call qftisf ( nv,nv1,ib, ee(ib-mbs), bf, bs, &
& wc1, wc2, wc3, wc4, wc, tt, &
& fu1, fd1 )
! -- 2-stream for IR
! call qftits ( ib, ee(ib-mbs) )
endif
!c 11/4/95 (end)
do i = 1, nv1
! fdir(i) = fdir(i) + fd1(i) * hk
! fuir(i) = fuir(i) + fu1(i) * hk
fdir(i) = fdir(i) + fd1(i) * hk * area
fuir(i) = fuir(i) + fu1(i) * hk * area
50 end do
endif
end do
end do
end do
31 end do
30 end do
20 end do
fuq1 = ss / 1340.0
!c In this model, we used the solar spectral irradiance determined by
!c Thekaekara (1973), and 1340.0 W/m**2 is the solar energy contained
!c in the spectral region 0.2 - 4.0 um.
fuq2 = bs * 0.03 * 3.14159 * ee(12)
!c fuq2 is the surface emitted flux in the band 0 - 280 cm**-1 with a
!c hk of 0.03.
do i = 1, nv1
fds(i) = fds(i) * fuq1
fus(i) = fus(i) * fuq1
fuir(i) = fuir(i) + fuq2
fd(i) = fds(i) + fdir(i)
fu(i) = fus(i) + fuir(i)
!C--- assign result to output variables
fdsij(i) = fds(i)
fusij(i) = fus(i)
fdirij(i) = fdir(i)
fuirij(i) = fuir(i)
fdij(i) = fd(i)
fuij(i) = fu(i)
!C---
60 end do
do i = 1, nv
xx = fds(i) -fus(i) - fds(i+1) + fus(i+1)
!c dts(i) = 8.4392 * xx / ( pp(i+1) - pp(i) )
dts(i) = xx / ( pp(i+1) - pp(i) )
xx = fdir(i) -fuir(i) - fdir(i+1) + fuir(i+1)
!c dtir(i) = 8.4392 * xx / ( pp(i+1) - pp(i) )
dtir(i) = xx / ( pp(i+1) - pp(i) )
dt(i) = dts(i) + dtir(i)
!C--- assign result to output variables
dtsij(i) = dts(i)
dtirij(i) = dtir(i)
dtij(i) = dt(i)
!C---
70 end do
return
end subroutine rad_all
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
subroutine thicks(nv,nv1,pp,pt,ph,po,dz) 1
! *********************************************************************
! dz is the thickness of a layer in units of km.
! *********************************************************************
implicit none
integer :: nv, nv1
real, dimension(nv1) :: pp, pt, ph, po
real, dimension(nv) :: dz(nv)
integer i
do i = 1, nv
dz(i) = 0.0146337 * ( pt(i) + pt(i+1) ) &
& * alog( pp(i+1) / pp(i) )
end do
return
end subroutine thicks
subroutine gases_new ( nv,nv1,ib, ig1, ig2, hk,pp,pt,ph,po,tg ) 1,78
!c *********************************************************************
!c tg(nv) are the optical depthes due to nongray gaseous absorption, in
!c nv layers for a given band ib and cumulative probability ig.
!c *********************************************************************
!# include "para.file"
USE PARA_FILE
USE band_new, only: hk1=>hk_1_new,fk1o3=>fko3_1_new, &
& hk2=>hk_2_new,c2hh2=>coehh22_2_new, &
& c2o2=>coeo2_2_new,c2h2o=>coeh2o_2_new, &
& hk3=>hk_3_new,c3hh2=>coehh32_3_new, &
& c3h2o=>coeh2o_3_new, &
& hk4=>hk_4_new,c4hh2=>coehh42_4_new, &
& c4co2=>coeco2_4_new,c4co=>coeco_4_new, &
& c4h2o=>coeh2o_4_new, &
& hk5=>hk_5_new,c5hh2=>coehh52_5_new, &
& c5co2=>coeco2_5_new,c5n2o=>coen2o_5_new, &
& c5ch4=>coech4_5_new,c5h2o=>coeh2o_5_new, &
& hk6=>hk_6_new,c6hh2=>coehh62_6_new, &
& c6so2=>coeso2_6_new,c6h2o=>coeh2o_6_new, &
& hk7=>hk_7_new,c7h2o=>coeh2o_7_new, &
& hk8=>hk_8_new,c8h2o=>coeh2o_8_new, &
& c8no=>coeno_8_new, &
& hk9=>hk_9_new,c9h2o=>coeh2o_9_new, &
& c9no2=>coeno2_9_new, &
& hk10=>hk_10_new,c10h2o=>coeh2o_10_new, &
& c10ch4=>coech4_10_new,c10n2o=>coen2o_10_new, &
& c10so2=>coeso2_10_new, &
& hk11=>hk_11_new,c11h2o=>coeh2o_11_new, &
& c11ch4=>coech4_11_new,c11n2o=>coen2o_11_new, &
& c11CFC11=>c11CFC11_11_new, &
& c11CFC12=>c11CFC12_11_new, &
& hk12=>hk_12_new,c12o3=>coeo3_12_new, &
& c12h2o=>coeh2o_12_new, &
& c12CFC11=>c12CFC11_12_new, &
& c12CFC12=>c12CFC12_12_new, &
& hk13=>hk_13_new,c13h2o=>coeh2o_13_new, &
& c13CFC11=>c13CFC11_13_new, &
& c13CFC12=>c13CFC12_13_new, &
& hk14=>hk_14_new,c14hca=>coehca_14_new, &
& c14hcb=>coehcb_14_new, &
& c14ch3cl=>coech3cl_14_new, &
& hk15=>hk_15_new,c15hca=>coehca_15_new, &
& c15hcb=>coehcb_15_new, &
& hk16=>hk_16_new,c16h2o=>coeh2o_16_new, &
& hk17=>hk_17_new,c17h2o=>coeh2o_17_new, &
& hk18=>hk_18_new,c18h2o=>coeh2o_18_new
USE control_para, only: umco2,umch4,umn2o,umo2, &
& umno,umso2,umno2,umch3cl, &
& umco,umCFC11,umCFC12, &
& no2s,nco2s,nso2s,nch4s,nnol, &
& nno2l,nso2l,nch3cll,ncos, &
& nn2os,nh2ocs,nh2os,no3s, &
& nh2ol,no3l,nco2l,nn2ol, &
& nch4l,nCFC11l,nCFC12l
implicit none
integer :: nv, nv1
real, dimension(nv1) :: pp, pt, ph, po
real :: tg(nv)
integer :: ib, ig, ig1, ig2
real :: hk
real, dimension(nv1) :: fkg, fkga, fkgb, fkgc, fkgd, fkge, &
& pq, fkg1
real, dimension(nv) :: tg1, tg2, tg3, tg4, tg5
real :: fk
integer :: i
select case(ib)
case default
stop
case(1)
1 ig=ig1
if(no3s.eq.1) then
fk = fk1o3(ig)
call qopo3s ( nv,nv1,fk,tg,pp,pt,ph,po )
! write(*,*)'tg=',tg
else
do i=1,nv
tg(i)=0.0
end do
end if
hk = 619.618 * hk1(ig)
! In this band ( 50000 - 14500 cm**-1 ), we have considered the nongray
! gaseous absorption of O3. 619.618 is the solar energy contained in
! the band in units of Wm**-2.
case(2)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! 2nd --- 6 nd bands have been changed by Z.F.in Jun.,2003
!
2 do i=1,nv1
fkg(i)=0.0
end do
call qks ( nv,nv1,c2hh2(1,1,ig1), fkgb,pp,pt,ph,po )
do i = 1, nv1
fkg(i) = fkgb(i)*ph(i)
end do
call qophc ( nv,nv1,fkg, tg1,pp,pt,ph,po )
call qks(nv,nv1,c2o2(1,1,ig2),fkgb,pp,pt,ph,po )
call qopo2 (nv,nv1,fkgb, tg2,pp,pt,ph,po )
do i=1,nv
tg(i)=tg1(i)+tg2(i)*umo2/2.0948E+05
end do
hk = 484.295 * hk2(ig1)*hk2(ig2)
! In this band ( 14500 - 7700 cm**-1 ), we have considered the nongray
! gaseous absorption of H2O. 484.295 is the solar energy contained in
! the band in units of Wm**-2.
case(3)
3 ig=ig1
do i=1,nv1
fkg(i)=0.0
end do
call qks ( nv,nv1,c3hh2(1,1,ig), fkgb,pp,pt,ph,po )
do i = 1, nv1
fkg(i) = fkgb(i)*ph(i)
end do
call qophc ( nv,nv1,fkg, tg,pp,pt,ph,po)
hk = 149.845 * hk3(ig)
! In this band ( 7700 - 5250 cm**-1 ), we have considered the nongray
! gaseous absorption of H2O. 149.845 is the solar energy contained in
! the band in units of Wm**-2.
case(4)
4 do i=1,nv1
fkg(i)=0.0
end do
call qks ( nv,nv1,c4hh2(1,1,ig1), fkgb,pp,pt,ph,po )
do i = 1, nv1
fkg(i) = fkgb(i)*ph(i)
end do
call qophc ( nv,nv1,fkg, tg1,pp,pt,ph,po)
call qks ( nv,nv1,c4co2(1,1,ig2), fkgb,pp,pt,ph,po )
call qopco2(nv,nv1,fkgb,tg2,pp,pt,ph,po)
call qks(nv,nv1,c4co,fkgc,pp,pt,ph,po)
call qopco(nv,nv1,fkgc,tg3,pp,pt,ph,po)
do i=1,nv
tg(i)=tg1(i)+tg2(i)/330.*umco2+tg3(i)/0.16*umco
end do
hk = 48.7302 * hk4(ig1)*hk4(ig2)
! In this band ( 5250 - 4000 cm**-1 ), we have considered the nongray
! gaseous absorption of H2O. 48.7302 is the solar energy contained in
! the band in units of Wm**-2.
case(5)
5 do i=1,nv1
fkg(i)=0.0
end do
call qks ( nv,nv1,c5hh2(1,1,ig1), fkgb,pp,pt,ph,po )
do i = 1, nv1
fkg(i) = fkgb(i)*ph(i)
end do
call qophc ( nv,nv1,fkg, tg1,pp,pt,ph,po)
call qks ( nv,nv1,c5co2(1,1,ig2), fkgb,pp,pt,ph,po )
call qopco2(nv,nv1,fkgb,tg2,pp,pt,ph,po)
call qks(nv,nv1,c5n2o,fkgc,pp,pt,ph,po)
call qopn2o(nv,nv1,fkgc,tg3,pp,pt,ph,po)
call qks(nv,nv1,c5ch4,fkgd,pp,pt,ph,po)
call qopch4(nv,nv1,fkgd,tg4,pp,pt,ph,po)
do i=1,nv
tg(i)=tg1(i)+tg2(i)/330.*umco2+tg3(i)/0.28*umn2o+ &
& tg4(i)/1.6*umch4
end do
hk = 31.6576 * hk5(ig1)*hk5(ig2)
! In this band ( 4000 - 2850 cm**-1 ), we have considered the nongray
! gaseous absorption of H2O. 31.6576 is the solar energy contained in
! the band in units of Wm**-2.
case(6)
6 ig=ig1
do i=1,nv1
fkg(i)=0.0
end do
call qks ( nv,nv1,c6hh2(1,1,ig), fkgb,pp,pt,ph,po )
do i = 1, nv1
fkg(i) = fkgb(i)*ph(i)
end do
call qophc ( nv,nv1,fkg, tg1,pp,pt,ph,po)
call qks(nv,nv1,c6so2,fkgb,pp,pt,ph,po)
call qopso2(nv,nv1,fkgb,tg2,pp,pt,ph,po)
do i=1,nv
tg(i)=tg1(i)+tg2(i)/0.001*umso2
end do
hk = 5.79927 * hk6(ig)
! In this band ( 2850 - 2500 cm**-1 ), we have considered the nongray
! gaseous absorption of H2O. 5.79927 is the solar energy contained in
! the band in units of Wm**-2.
case(7)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!cZ.F.
7 ig=ig1
if(nh2ol.eq.1) then
call qki ( nv,nv1,c7h2o(1,1,ig), fkg,pp,pt,ph,po )
call qoph2o ( nv,nv1,fkg, tg,pp,pt,ph,po )
else
do i=1,nv
tg(i)=0.0
end do
end if
hk = hk7(ig)
! In this band ( 2200 - 1900 cm**-1 ), we have considered the nongray
! gaseous absorption of H2O.
case(8)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! 8th---10th bands have been changed by Z.F. in Jun.2003
!
8 ig=ig1
if(nh2ol.eq.1) then
call qki ( nv,nv1,c8h2o(1,1,ig), fkg,pp,pt,ph,po )
call qoph2o ( nv,nv1,fkg, tg1,pp,pt,ph,po )
else
do i=1,nv
tg1(i)=0.0
end do
end if
call qki(nv,nv1,c8no,fkgb,pp,pt,ph,po)
call qopno(nv,nv1,fkgb,tg2,pp,pt,ph,po)
! print *, 'band 8, no, tg1=, tg2=', tg1,tg2
do i=1,nv
tg(i)=tg1(i)+tg2(i)*umno/0.0005
end do
hk = hk8(ig)
! In this band ( 1900 - 1700 cm**-1 ), we have considered the nongray
! gaseous absorption of H2O.
case(9)
9 ig=ig1
if(nh2ol.eq.1) then
call qki ( nv,nv1,c9h2o(1,1,ig), fkg,pp,pt,ph,po )
call qoph2o ( nv,nv1,fkg, tg1,pp,pt,ph,po )
else
do i=1,nv
tg1(i)=0.0
end do
end if
call qki(nv,nv1,c9no2,fkgb,pp,pt,ph,po)
call qopno(nv,nv1,fkgb,tg2,pp,pt,ph,po)
! print *, 'band 9, no, tg2=', tg1, tg2
do i=1,nv
tg(i)=tg1(i)+tg2(i)*umno2/0.001
end do
hk = hk9(ig)
! In this band ( 1700 - 1400 cm**-1 ), we have considered the nongray
! gaseous absorption of H2O.
case(10)
10 ig=ig1
if(nh2ol.eq.1) then
call qki ( nv,nv1,c10h2o(1,1,ig), fkg,pp,pt,ph,po )
call qoph2o ( nv,nv1,fkg, tg1,pp,pt,ph,po )
else
do i=1,nv
tg1(i)=0.0
end do
end if
if(nch4l.eq.1) then
call qki ( nv,nv1,c10ch4, fkg,pp,pt,ph,po )
call qopch4 ( nv,nv1,fkg, tg2,pp,pt,ph,po )
else
do i=1,nv
tg2(i)=0.0
end do
end if
if(nn2ol.eq.1) then
call qki ( nv,nv1,c10n2o, fkg,pp,pt,ph,po )
call qopn2o ( nv,nv1,fkg, tg3,pp,pt,ph,po )
else
do i=1,nv
tg3(i)=0.0
end do
end if
call qki(nv,nv1,c10so2,fkgb,pp,pt,ph,po)
call qopso2(nv,nv1,fkgb,tg4,pp,pt,ph,po)
do i=1,nv
tg(i) = tg1(i) + tg2(i)/1.6*umch4 + tg3(i)/0.28*umn2o &
& +tg4(i)/0.001*umso2
end do
hk = hk10(ig)
! In this band ( 1400 - 1250 cm**-1 ), we have considered the overlapping
! absorption of H2O, CH4, and N2O by approach one of Fu(1991).
! In this band ( 1400 - 1250 cm**-1 ), we have considered the overlapping
! absorption of H2O, CH4, and N2O by approach one of Fu(1991).
case(11)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!Z.F.
11 ig=ig1
if(nh2ol.eq.1) then
call qki ( nv,nv1,c11h2o(1,1,ig), fkg,pp,pt,ph,po )
call qoph2o ( nv,nv1,fkg, tg1,pp,pt,ph,po )
else
do i=1,nv
tg1(i)=0.0
end do
end if
if(nch4l.eq.1) then
call qki ( nv,nv1,c11ch4, fkg,pp,pt,ph,po )
call qopch4 ( nv,nv1,fkg, tg2,pp,pt,ph,po )
else
do i=1,nv
tg2(i)=0.0
end do
end if
if(nn2ol.eq.1) then
call qki ( nv,nv1,c11n2o, fkg,pp,pt,ph,po )
call qopn2o ( nv,nv1,fkg, tg3,pp,pt,ph,po )
else
do i=1,nv
tg3(i)=0.0
end do
end if
if(nCFC11l.eq.1) then
call qopCFC11(nv,nv1,c11CFC11,tg4,pp,pt,ph,po)
else
do i=1,nv
tg4(i)=0.0
enddo
end if
if(nCFC12l.eq.1) then
call qopCFC12(nv,nv1,c11CFC12,tg5,pp,pt,ph,po)
else
do i=1,nv
tg5(i)=0.0
enddo
end if
do i = 1, nv
tg(i) = tg1(i) + tg2(i)/1.6*umch4 + tg3(i)/0.28*umn2o + &
& tg4(i)/0.22e-3*umCFC11 + tg5(i)/0.375e-3*umCFC12
end do
hk = hk11(ig)
! In this band ( 1250 - 1100 cm**-1 ), we have considered the overlapping
! absorption of H2O, CH4, N2O, CFC11 and CFC12 by approach one of Fu(1991).
case(12)
12 ig=ig1
if(no3l.eq.1) then
call qkio3 ( nv,nv1,c12o3(1,1,ig), fkg,pp,pt,ph,po )
call qopo3i ( nv,nv1,fkg, tg1,pp,pt,ph,po )
else
do i=1,nv
tg1(i)=0.0
end do
end if
if(nh2ol.eq.1) then
call qki ( nv,nv1,c12h2o, fkg,pp,pt,ph,po )
call qoph2o ( nv,nv1,fkg, tg2,pp,pt,ph,po )
else
do i=1,nv
tg2(i)=0.0
end do
end if
if(nCFC11l.eq.1) then
call qopCFC11(nv,nv1,c12CFC11,tg3,pp,pt,ph,po)
else
do i=1,nv
tg3(i)=0.0
enddo
end if
if(nCFC12l.eq.1) then
call qopCFC12(nv,nv1,c12CFC12,tg4,pp,pt,ph,po)
else
do i=1,nv
tg4(i)=0.0
enddo
end if
do i = 1, nv
tg(i) = tg1(i) + tg2(i) + tg3(i)/0.22e-3*umCFC11 &
& +tg4(i)/0.375e-3*umCFC12
end do
hk = hk12(ig)
! In this band ( 1100 - 980 cm**-1 ), we have considered the overlapping
! absorption of H2O and O3, CFC11, CFC12 by approach one of Fu(1991).
case(13)
13 ig=ig1
if(nh2ol.eq.1) then
call qki ( nv,nv1,c13h2o(1,1,ig), fkg,pp,pt,ph,po )
call qoph2o ( nv,nv1,fkg, tg1,pp,pt,ph,po )
else
do i=1,nv
tg1(i)=0.0
end do
end if
if(nCFC11l.eq.1) then
call qopCFC11(nv,nv1,c13CFC11,tg2,pp,pt,ph,po)
else
do i=1,nv
tg2(i)=0.0
enddo
end if
if(nCFC12l.eq.1) then
call qopCFC12(nv,nv1,c13CFC12,tg3,pp,pt,ph,po)
else
do i=1,nv
tg3(i)=0.0
enddo
end if
do i = 1, nv
tg(i) = tg1(i) + tg2(i)/0.22e-3*umCFC11 + &
& tg3(i)/0.375e-3*umCFC12
enddo
hk = hk13(ig)
! In this band ( 980 - 800 cm**-1 ), we have considered the overlapping
! absorption of H2O, CFC11 and CFC12 by approach one of fu (1991).
case(14)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!c
! 14th band has been changed by Z.F. in Jun,2003
!
14 ig=ig1
do i = 1, nv1
if ( pp(i) .ge. 63.1 ) then
pq(i) = ph(i)
else
pq(i) = 0.0
endif
333 end do
if(nco2l.eq.1) then
call qki ( nv,nv1,c14hca(1,1,ig), fkga,pp,pt,ph,po )
else
do i=1,nv1
fkga(i)=0.0
end do
end if
if(nh2ol.eq.1) then
call qki ( nv,nv1,c14hcb(1,1,ig), fkgb,pp,pt,ph,po )
else
do i=1,nv1
fkgb(i)=0.0
end do
end if
do i = 1, nv1
fkg(i) = fkga(i)/330.0*umco2 + pq(i) * fkgb(i)
343 end do
call qophc ( nv,nv1,fkg, tg1,pp,pt,ph,po)
call qki(nv,nv1,c14ch3cl,fkgb,pp,pt,ph,po)
call qopch3cl(nv,nv1,fkgb,tg2,pp,pt,ph,po)
do i=1,nv
tg(i)=tg1(i)+tg2(i)*umch3cl/0.5e-3
end do
hk = hk14(ig)
! In this band ( 800 - 670 cm**-1), we have considered the overlapping
! absorption of H2O and CO2 by approach two of Fu(1991).
case(15)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!Z.F.
15 ig=ig1
do i = 1, nv1
if ( pp(i) .ge. 63.1 ) then
pq(i) = ph(i)
else
pq(i) = 0.0
endif
353 end do
if(nco2l.eq.1) then
call qki ( nv,nv1,c15hca(1,1,ig), fkga,pp,pt,ph,po )
else
do i=1,nv1
fkga(i)=0.0
end do
end if
if(nh2ol.eq.1) then
call qki ( nv,nv1,c15hcb(1,1,ig), fkgb,pp,pt,ph,po )
else
do i=1,nv1
fkgb(i)=0.0
end do
end if
do i = 1, nv1
fkg(i) = fkga(i)/330.0*umco2 + pq(i) * fkgb(i)
363 end do
call qophc ( nv,nv1,fkg, tg,pp,pt,ph,po)
hk = hk15(ig)
! In this band ( 670 - 540 cm**-1), we have considered the overlapping
! absorption of H2O and CO2 by approach two of Fu(1991).
case(16)
16 ig=ig1
if(nh2ol.eq.1) then
call qki ( nv,nv1,c16h2o(1,1,ig), fkg,pp,pt,ph,po )
call qoph2o ( nv,nv1,fkg, tg,pp,pt,ph,po )
else
do i=1,nv
tg(i)=0.0
end do
end if
hk = hk16(ig)
! In this band ( 540 - 400 cm**-1 ), we have considered the nongray
! gaseous absorption of H2O.
case(17)
17 ig=ig1
if(nh2ol.eq.1) then
call qki ( nv,nv1,c17h2o(1,1,ig), fkg,pp,pt,ph,po )
call qoph2o ( nv,nv1,fkg, tg,pp,pt,ph,po )
else
do i=1,nv
tg(i)=0.0
end do
end if
hk = hk17(ig)
! In this band ( 400 - 280 cm**-1 ), we have considered the nongray
! gaseous absorption of H2O.
case(18)
18 ig=ig1
if(nh2ol.eq.1) then
call qki ( nv,nv1,c18h2o(1,1,ig), fkg,pp,pt,ph,po )
call qoph2o ( nv,nv1,fkg, tg,pp,pt,ph,po )
else
do i=1,nv
tg(i)=0.0
end do
end if
hk = hk18(ig)
! In this band ( 280 - 000 cm**-1 ), we have considered the nongray
! gaseous absorption of H2O.
20 end select
return
end subroutine gases_new
subroutine ice ( nv,nv1,ib,pre,pde,plwc,piwc,dz,ti,wi,wwi ) 1,2
! *********************************************************************
! ti, wi, and wwi are the optical depth, single scattering albedo,
! and expansion coefficients of the phase function ( 1, 2, 3, and
! 4) due to the scattering of ice clouds for a given layer.
! *********************************************************************
use para_file
use ice0
implicit none
integer :: nv, nv1
real, dimension(nv) :: pre, plwc, pde, piwc, dz
real :: ti(nv), wi(nv), wwi(nv,4)
real :: fw1, fw2, fw3, wf1, wf2, wf3, wf4, gg, x1, x2, x3, x4, fd
integer :: i ,ib, ibr
do i = 1, nv
if ( piwc(i) .lt. 1.0e-5 ) then
ti(i) = 0.0
wi(i) = 0.0
wwi(i,1) = 0.0
wwi(i,2) = 0.0
wwi(i,3) = 0.0
wwi(i,4) = 0.0
else
! The constant 1000.0 below is to consider the units of dz(i) is km.
fw1 = pde(i)
fw2 = fw1 * pde(i)
fw3 = fw2 * pde(i)
ti(i) = dz(i) * 1000.0 * piwc(i) * ( ap(1,ib) + &
& ap(2,ib) / fw1 + ap(3,ib) / fw2 )
wi(i) = 1.0 - ( bp(1,ib) + bp(2,ib) * fw1 + &
& bp(3,ib) * fw2 + bp(4,ib) * fw3 )
!C--- test for 10% more high clouds but 10% reduced single-scattering albedo
!c if (i.ge.7.and.i.le.9) then
!c wi(i) = wi(i) * 0.98
!c endif
!c--- end test
if ( ib .le. mbs ) then
fd = dps(1,ib) + dps(2,ib) * fw1 + &
& dps(3,ib) * fw2 + dps(4,ib) * fw3
wf1 = cps(1,1,ib) + cps(2,1,ib) * fw1 + &
& cps(3,1,ib) * fw2 + cps(4,1,ib) * fw3
wwi(i,1) = ( 1.0 - fd ) * wf1 + 3.0 * fd
wf2 = cps(1,2,ib) + cps(2,2,ib) * fw1 + &
& cps(3,2,ib) * fw2 + cps(4,2,ib) * fw3
wwi(i,2) = ( 1.0 - fd ) * wf2 + 5.0 * fd
wf3 = cps(1,3,ib) + cps(2,3,ib) * fw1 + &
& cps(3,3,ib) * fw2 + cps(4,3,ib) * fw3
wwi(i,3) = ( 1.0 - fd ) * wf3 + 7.0 * fd
wf4 = cps(1,4,ib) + cps(2,4,ib) * fw1 + &
& cps(3,4,ib) * fw2 + cps(4,4,ib) * fw3
wwi(i,4) = ( 1.0 - fd ) * wf4 + 9.0 * fd
else
ibr = ib - mbs
gg = cpir(1,ibr) + cpir(2,ibr) * fw1 + &
& cpir(3,ibr) * fw2 + cpir(4,ibr) * fw3
x1 = gg
x2 = x1 * gg
x3 = x2 * gg
x4 = x3 * gg
wwi(i,1) = 3.0 * x1
wwi(i,2) = 5.0 * x2
wwi(i,3) = 7.0 * x3
wwi(i,4) = 9.0 * x4
endif
endif
10 end do
return
end subroutine
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
!C--- using new coefficients for ice single-scattering parameterization
subroutine ice_new_ZF ( nv,nv1,ib,pre,pde,plwc,piwc,dz,ti,wi,wwi ) 1,2
!c *********************************************************************
!c ti, wi, and wwi are the optical depth, single scattering albedo, &
!c and expansion coefficients of the phase function ( 1, 2, 3, and
!c 4) due to the scattering of ice clouds for a given layer.
!c *********************************************************************
!# include "para.file"
USE PARA_FILE
USE ice1
implicit none
integer :: nv, nv1
real, dimension(nv) :: pre, plwc, pde, piwc, dz
real :: ti(nv), wi(nv), wwi(nv,4)
real :: fw1, fw2, fw3, wf1, wf2, wf3, wf4, gg, x1, x2, x3, x4
integer :: i, ib, ibr
! changed by Z.F.
! common /zf_solar/tizfs(nv,mbs),wizfs(nv,mbs),wwi1s(nv,mbs),
! & wwi2s(nv,mbs),wwi3s(nv,mbs),wwi4s(nv,mbs)
! changing over
do i = 1, nv
if ( piwc(i) .lt. 1.0e-5 ) then
ti(i) = 0.0
wi(i) = 0.0
wwi(i,1) = 0.0
wwi(i,2) = 0.0
wwi(i,3) = 0.0
wwi(i,4) = 0.0
else
! The constant 1000.0 below is to consider the units of dz(i) is km.
fw1 = pde(i)
fw2 = fw1 * pde(i)
fw3 = fw2 * pde(i)
ti(i) = dz(i) * 1000.0 * piwc(i) * ( ap(1,ib) + &
& ap(2,ib) / fw1 + ap(3,ib) / fw2 )
if(ti(i).lt.0.0) write(*,*)'optical depth of ice=',ti(i)
wi(i) = 1.0 - ( bp(1,ib) + bp(2,ib) * fw1 + &
& bp(3,ib) * fw2 + bp(4,ib) * fw3 )
if ( ib .le. mbs ) then
! changed by Z.F.
wf1 = cps(1,1,ib) + cps(2,1,ib) * fw1 + &
& cps(3,1,ib) * fw2 + cps(4,1,ib) * fw3
wwi(i,1) = wf1
wf2 = cps(1,2,ib) + cps(2,2,ib) * fw1 + &
& cps(3,2,ib) * fw2 + cps(4,2,ib) * fw3
wwi(i,2) = wf2
wf3 = cps(1,3,ib) + cps(2,3,ib) * fw1 + &
& cps(3,3,ib) * fw2 + cps(4,3,ib) * fw3
wwi(i,3) = wf3
wf4 = cps(1,4,ib) + cps(2,4,ib) * fw1 + &
& cps(3,4,ib) * fw2 + cps(4,4,ib) * fw3
wwi(i,4) = wf4
! changing over
else
ibr = ib - mbs
gg = cpir(1,ibr) + cpir(2,ibr) * fw1 + &
& cpir(3,ibr) * fw2 + cpir(4,ibr) * fw3
x1 = gg
x2 = x1 * gg
x3 = x2 * gg
x4 = x3 * gg
wwi(i,1) = 3.0 * x1
wwi(i,2) = 5.0 * x2
wwi(i,3) = 7.0 * x3
wwi(i,4) = 9.0 * x4
endif
endif
10 end do
! added by Z.F.
! if(ib.le.mbs) then
! do i=1,nv
! tizfs(i,ib)=ti(i)
! wizfs(i,ib)=wi(i)
! wwi1s(i,ib)=wwi(i,1)
! wwi2s(i,ib)=wwi(i,2)
! wwi3s(i,ib)=wwi(i,3)
! wwi4s(i,ib)=wwi(i,4)
! end do
! end if
! write(*,*)'ti=',ti
! write(*,*)'wi=',wi
! write(*,*)'wwi1=',(wwi(i,1),i=1,nv)
! write(*,*)'wwi2=',(wwi(i,2),i=1,nv)
! write(*,*)'wwi3=',(wwi(i,3),i=1,nv)
! write(*,*)'wwi4=',(wwi(i,4),i=1,nv)
! adding over
return
end subroutine
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
!C--- using new coefficients for ice single-scattering parameterization
!C--- by Qing Yue 2006
subroutine ice_new_comb ( nv,nv1,ib,pre,pde,plwc,piwc,dz,ti,wi,wwi ) 1,2
!c *********************************************************************
!c ti, wi, and wwi are the optical depth, single scattering albedo, &
!c and expansion coefficients of the phase function ( 1, 2, 3, and
!c 4) due to the scattering of ice clouds for a given layer.
!c *********************************************************************
!# include "para.file"
USE PARA_FILE
USE ice2
implicit none
integer :: nv, nv1
real, dimension(nv) :: pre, plwc, pde, piwc, dz
real :: ti(nv), wi(nv), wwi(nv,4)
real :: fw1, fw2, fw3, wf1, wf2, wf3, wf4, gg, x1, x2, x3, x4
integer :: i, ib, ibr
! changed by Z.F.
! common /zf_solar/tizfs(nv,mbs),wizfs(nv,mbs),wwi1s(nv,mbs),
! & wwi2s(nv,mbs),wwi3s(nv,mbs),wwi4s(nv,mbs)
! changing over
do i = 1, nv
if ( piwc(i) .lt. 1.0e-5 ) then
ti(i) = 0.0
wi(i) = 0.0
wwi(i,1) = 0.0
wwi(i,2) = 0.0
wwi(i,3) = 0.0
wwi(i,4) = 0.0
else
! The constant 1000.0 below is to consider the units of dz(i) is km.
fw1 = pde(i)
fw2 = fw1 * pde(i)
fw3 = fw2 * pde(i)
ti(i) = dz(i) * 1000.0 * piwc(i) * ( ap(1,ib) + &
& ap(2,ib) / fw1 + ap(3,ib) / fw2 )
! -- uncomment the following if want to output optical depth for each band
! write(*,*)'level=', i, 'optical depth of ice=',ti(i)
wi(i) = 1.0 - ( bp(1,ib) + bp(2,ib) * fw1 + &
& bp(3,ib) * fw2 + bp(4,ib) * fw3 )
if ( ib .le. mbs ) then
! changed by Z.F.
wf1 = cps(1,1,ib) + cps(2,1,ib) * fw1 + &
& cps(3,1,ib) * fw2 + cps(4,1,ib) * fw3
wwi(i,1) = wf1
wf2 = cps(1,2,ib) + cps(2,2,ib) * fw1 + &
& cps(3,2,ib) * fw2 + cps(4,2,ib) * fw3
wwi(i,2) = wf2
wf3 = cps(1,3,ib) + cps(2,3,ib) * fw1 + &
& cps(3,3,ib) * fw2 + cps(4,3,ib) * fw3
wwi(i,3) = wf3
wf4 = cps(1,4,ib) + cps(2,4,ib) * fw1 + &
& cps(3,4,ib) * fw2 + cps(4,4,ib) * fw3
wwi(i,4) = wf4
! changing over
else
ibr = ib - mbs
gg = cpir(1,ibr) + cpir(2,ibr) * fw1 + &
& cpir(3,ibr) * fw2 + cpir(4,ibr) * fw3
x1 = gg
x2 = x1 * gg
x3 = x2 * gg
x4 = x3 * gg
wwi(i,1) = 3.0 * x1
wwi(i,2) = 5.0 * x2
wwi(i,3) = 7.0 * x3
wwi(i,4) = 9.0 * x4
endif
endif
10 end do
! added by Z.F.
! if(ib.le.mbs) then
! do i=1,nv
! tizfs(i,ib)=ti(i)
! wizfs(i,ib)=wi(i)
! wwi1s(i,ib)=wwi(i,1)
! wwi2s(i,ib)=wwi(i,2)
! wwi3s(i,ib)=wwi(i,3)
! wwi4s(i,ib)=wwi(i,4)
! end do
! end if
! write(*,*)'ti=',ti
! write(*,*)'wi=',wi
! write(*,*)'wwi1=',(wwi(i,1),i=1,nv)
! write(*,*)'wwi2=',(wwi(i,2),i=1,nv)
! write(*,*)'wwi3=',(wwi(i,3),i=1,nv)
! write(*,*)'wwi4=',(wwi(i,4),i=1,nv)
! adding over
return
end subroutine
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
!C--- using new coefficients for ice single-scattering parameterization
!C--- for tropics
subroutine ice_new_trop ( nv,nv1,ib,pre,pde,plwc,piwc,dz,ti,wi,wwi ) 1,2
!c *********************************************************************
!c ti, wi, and wwi are the optical depth, single scattering albedo, &
!c and expansion coefficients of the phase function ( 1, 2, 3, and
!c 4) due to the scattering of ice clouds for a given layer.
!c *********************************************************************
!# include "para.file"
USE PARA_FILE
USE ice3
implicit none
integer :: nv, nv1
real, dimension(nv) :: pre, plwc, pde, piwc, dz
real :: ti(nv), wi(nv), wwi(nv,4)
real :: fw1, fw2, fw3, wf1, wf2, wf3, wf4, gg, x1, x2, x3, x4
integer :: i ,ib, ibr
! changed by Z.F.
! common /zf_solar/tizfs(nv,mbs),wizfs(nv,mbs),wwi1s(nv,mbs),
! & wwi2s(nv,mbs),wwi3s(nv,mbs),wwi4s(nv,mbs)
! changing over
do i = 1, nv
if ( piwc(i) .lt. 1.0e-5 ) then
ti(i) = 0.0
wi(i) = 0.0
wwi(i,1) = 0.0
wwi(i,2) = 0.0
wwi(i,3) = 0.0
wwi(i,4) = 0.0
else
! The constant 1000.0 below is to consider the units of dz(i) is km.
fw1 = pde(i)
fw2 = fw1 * pde(i)
fw3 = fw2 * pde(i)
ti(i) = dz(i) * 1000.0 * piwc(i) * ( ap(1,ib) + &
& ap(2,ib) / fw1 + ap(3,ib) / fw2 )
if(ti(i).lt.0.0) write(*,*)'optical depth of ice=',ti(i)
wi(i) = 1.0 - ( bp(1,ib) + bp(2,ib) * fw1 + &
& bp(3,ib) * fw2 + bp(4,ib) * fw3 )
if ( ib .le. mbs ) then
! changed by Z.F.
wf1 = cps(1,1,ib) + cps(2,1,ib) * fw1 + &
& cps(3,1,ib) * fw2 + cps(4,1,ib) * fw3
wwi(i,1) = wf1
wf2 = cps(1,2,ib) + cps(2,2,ib) * fw1 + &
& cps(3,2,ib) * fw2 + cps(4,2,ib) * fw3
wwi(i,2) = wf2
wf3 = cps(1,3,ib) + cps(2,3,ib) * fw1 + &
& cps(3,3,ib) * fw2 + cps(4,3,ib) * fw3
wwi(i,3) = wf3
wf4 = cps(1,4,ib) + cps(2,4,ib) * fw1 + &
& cps(3,4,ib) * fw2 + cps(4,4,ib) * fw3
wwi(i,4) = wf4
! changing over
else
ibr = ib - mbs
gg = cpir(1,ibr) + cpir(2,ibr) * fw1 + &
& cpir(3,ibr) * fw2 + cpir(4,ibr) * fw3
x1 = gg
x2 = x1 * gg
x3 = x2 * gg
x4 = x3 * gg
wwi(i,1) = 3.0 * x1
wwi(i,2) = 5.0 * x2
wwi(i,3) = 7.0 * x3
wwi(i,4) = 9.0 * x4
endif
endif
10 end do
! added by Z.F.
! if(ib.le.mbs) then
! do i=1,nv
! tizfs(i,ib)=ti(i)
! wizfs(i,ib)=wi(i)
! wwi1s(i,ib)=wwi(i,1)
! wwi2s(i,ib)=wwi(i,2)
! wwi3s(i,ib)=wwi(i,3)
! wwi4s(i,ib)=wwi(i,4)
! end do
! end if
! write(*,*)'ti=',ti
! write(*,*)'wi=',wi
! write(*,*)'wwi1=',(wwi(i,1),i=1,nv)
! write(*,*)'wwi2=',(wwi(i,2),i=1,nv)
! write(*,*)'wwi3=',(wwi(i,3),i=1,nv)
! write(*,*)'wwi4=',(wwi(i,4),i=1,nv)
! adding over
return
end subroutine
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
!C--- using new coefficients for ice single-scattering parameterization
subroutine ice_new_midlat ( nv,nv1,ib,pre,pde,plwc,piwc,dz,ti,wi,wwi ) 1,2
!c *********************************************************************
!c ti, wi, and wwi are the optical depth, single scattering albedo, &
!c and expansion coefficients of the phase function ( 1, 2, 3, and
!c 4) due to the scattering of ice clouds for a given layer.
!c *********************************************************************
!# include "para.file"
USE PARA_FILE
USE ice4
implicit none
integer :: nv, nv1
real, dimension(nv) :: pre, plwc, pde, piwc, dz
real :: ti(nv), wi(nv), wwi(nv,4)
real :: fw1, fw2, fw3, wf1, wf2, wf3, wf4, gg, x1, x2, x3, x4
integer :: i, ib, ibr
! changed by Z.F.
! common /zf_solar/tizfs(nv,mbs),wizfs(nv,mbs),wwi1s(nv,mbs),
! & wwi2s(nv,mbs),wwi3s(nv,mbs),wwi4s(nv,mbs)
! changing over
do i = 1, nv
if ( piwc(i) .lt. 1.0e-5 ) then
ti(i) = 0.0
wi(i) = 0.0
wwi(i,1) = 0.0
wwi(i,2) = 0.0
wwi(i,3) = 0.0
wwi(i,4) = 0.0
else
! The constant 1000.0 below is to consider the units of dz(i) is km.
fw1 = pde(i)
fw2 = fw1 * pde(i)
fw3 = fw2 * pde(i)
ti(i) = dz(i) * 1000.0 * piwc(i) * ( ap(1,ib) + &
& ap(2,ib) / fw1 + ap(3,ib) / fw2 )
if(ti(i).lt.0.0) write(*,*)'optical depth of ice=',ti(i)
wi(i) = 1.0 - ( bp(1,ib) + bp(2,ib) * fw1 + &
& bp(3,ib) * fw2 + bp(4,ib) * fw3 )
if ( ib .le. mbs ) then
! changed by Z.F.
wf1 = cps(1,1,ib) + cps(2,1,ib) * fw1 + &
& cps(3,1,ib) * fw2 + cps(4,1,ib) * fw3
wwi(i,1) = wf1
wf2 = cps(1,2,ib) + cps(2,2,ib) * fw1 + &
& cps(3,2,ib) * fw2 + cps(4,2,ib) * fw3
wwi(i,2) = wf2
wf3 = cps(1,3,ib) + cps(2,3,ib) * fw1 + &
& cps(3,3,ib) * fw2 + cps(4,3,ib) * fw3
wwi(i,3) = wf3
wf4 = cps(1,4,ib) + cps(2,4,ib) * fw1 + &
& cps(3,4,ib) * fw2 + cps(4,4,ib) * fw3
wwi(i,4) = wf4
! changing over
else
ibr = ib - mbs
gg = cpir(1,ibr) + cpir(2,ibr) * fw1 + &
& cpir(3,ibr) * fw2 + cpir(4,ibr) * fw3
x1 = gg
x2 = x1 * gg
x3 = x2 * gg
x4 = x3 * gg
wwi(i,1) = 3.0 * x1
wwi(i,2) = 5.0 * x2
wwi(i,3) = 7.0 * x3
wwi(i,4) = 9.0 * x4
endif
endif
10 end do
! added by Z.F.
! if(ib.le.mbs) then
! do i=1,nv
! tizfs(i,ib)=ti(i)
! wizfs(i,ib)=wi(i)
! wwi1s(i,ib)=wwi(i,1)
! wwi2s(i,ib)=wwi(i,2)
! wwi3s(i,ib)=wwi(i,3)
! wwi4s(i,ib)=wwi(i,4)
! end do
! end if
! write(*,*)'ti=',ti
! write(*,*)'wi=',wi
! write(*,*)'wwi1=',(wwi(i,1),i=1,nv)
! write(*,*)'wwi2=',(wwi(i,2),i=1,nv)
! write(*,*)'wwi3=',(wwi(i,3),i=1,nv)
! write(*,*)'wwi4=',(wwi(i,4),i=1,nv)
! adding over
return
end subroutine
!************************************************
!C--- using FLIce98 for ice single-scattering parameterization
subroutine ice_98 ( nv,nv1,ib,pre,pde,plwc,piwc,dz,ti,wi,wwi ) 1,2
!c *********************************************************************
!c ti, wi, and wwi are the optical depth, single scattering albedo, &
!c and expansion coefficients of the phase function ( 1, 2, 3, and
!c 4) due to the scattering of ice clouds for a given layer.
!c *********************************************************************
!# include "para.file"
!c USE RadParams
USE PARA_FILE
USE ice5
implicit none
integer :: nv, nv1
real, dimension(nv) :: pre, plwc, pde, piwc, dz
real ti(nv), wi(nv), wwi(nv,4)
real fw1, fw2, fw3, tau, omega, asy, fd, f, fw, &
& gg, x1, x2, x3, x4, betae, betaa
integer i, ib, ibr
do i = 1, nv
if ( piwc(i) .lt. 1.0e-5 ) then
ti(i) = 0.0
wi(i) = 0.0
wwi(i,1) = 0.0
wwi(i,2) = 0.0
wwi(i,3) = 0.0
wwi(i,4) = 0.0
else
fw1 = pde(i)
fw2 = fw1 * pde(i)
fw3 = fw2 * pde(i)
if ( ib .le. mbs ) then
tau = dz(i) * 1000.0 * piwc(i) * ( ap(1,ib) + &
& ap(2,ib) / fw1 )
omega = 1.0 - ( bps(1,ib) + bps(2,ib) * fw1 + &
& bps(3,ib) * fw2 + bps(4,ib) * fw3 )
asy = cp(1,ib) + cp(2,ib) * fw1 + &
& cp(3,ib) * fw2 + cp(4,ib) * fw3
fd = dps(1,ib) + dps(2,ib) * fw1 + &
& dps(3,ib) * fw2 + dps(4,ib) * fw3
f = 0.5 / omega + fd
fw = f * omega
ti(i) = ( 1.0 - fw ) * tau
wi(i) = ( 1.0 - f ) * omega / ( 1.0 - fw )
gg = ( asy - f ) / ( 1.0 - f )
x1 = gg
x2 = x1 * gg
x3 = x2 * gg
x4 = x3 * gg
wwi(i,1) = 3.0 * x1
wwi(i,2) = 5.0 * x2
wwi(i,3) = 7.0 * x3
wwi(i,4) = 9.0 * x4
else
ibr = ib - mbs
betae = piwc(i) * ( ap(1,ib) + &
& ap(2,ib) / fw1 + ap(3,ib) / fw2 )
betaa = piwc(i) / fw1 * ( bpir(1,ibr) + bpir(2,ibr) * &
& fw1 + bpir(3,ibr) * fw2 + bpir(4,ibr) * fw3 )
asy = cp(1,ib) + cp(2,ib) * fw1 + &
& cp(3,ib) * fw2 + cp(4,ib) * fw3
ti(i) = dz(i) * 1000.0 * betae
wi(i) = 1.0 - betaa / betae
gg = asy
x1 = gg
x2 = x1 * gg
x3 = x2 * gg
x4 = x3 * gg
wwi(i,1) = 3.0 * x1
wwi(i,2) = 5.0 * x2
wwi(i,3) = 7.0 * x3
wwi(i,4) = 9.0 * x4
endif
endif
10 end do
return
end subroutine
!c Fu 07-08-98
!************************************************
!C--- ice single-scattering parameterization by Feng using Ping Yang 2000 data
subroutine ice_singleice ( nv,nv1,ib,pre,pde,plwc,piwc,dz,ti,wi,wwi ) 1,2
!c *********************************************************************
!c ti, wi, and wwi are the optical depth, single scattering albedo, &
!c and expansion coefficients of the phase function ( 1, 2, 3, and
!c 4) due to the scattering of ice clouds for a given layer.
!c *********************************************************************
!# include "para.file"
USE PARA_FILE
USE ice6
implicit none
integer :: nv, nv1
real, dimension(nv) :: pre, plwc, pde, piwc, dz
real :: ti(nv), wi(nv), wwi(nv,4)
real :: fw1, fw2, fw3, wf1, wf2, wf3, wf4, gg, x1, x2, x3, x4, fd
integer :: i, ib, ibr
do i = 1, nv
if ( piwc(i) .lt. 1.0e-5 ) then
ti(i) = 0.0
wi(i) = 0.0
wwi(i,1) = 0.0
wwi(i,2) = 0.0
wwi(i,3) = 0.0
wwi(i,4) = 0.0
else
! The constant 1000.0 below is to consider the units of dz(i) is km.
fw1 = pde(i)
fw2 = fw1 * pde(i)
fw3 = fw2 * pde(i)
ti(i) = dz(i) * 1000.0 * piwc(i) * ( ap(1,ib) + &
& ap(2,ib) / fw1 + ap(3,ib) / fw2 )
wi(i) = 1.0 - ( bp(1,ib) + bp(2,ib) * fw1 + &
& bp(3,ib) * fw2 + bp(4,ib) * fw3 )
if ( ib .le. mbs ) then
fd = dps(1,ib) + dps(2,ib) * fw1 + &
& dps(3,ib) * fw2 + dps(4,ib) * fw3
wf1 = cps(1,1,ib) + cps(2,1,ib) * fw1 + &
& cps(3,1,ib) * fw2 + cps(4,1,ib) * fw3
wwi(i,1) = ( 1.0 - fd ) * wf1 + 3.0 * fd
wf2 = cps(1,2,ib) + cps(2,2,ib) * fw1 + &
& cps(3,2,ib) * fw2 + cps(4,2,ib) * fw3
wwi(i,2) = ( 1.0 - fd ) * wf2 + 5.0 * fd
wf3 = cps(1,3,ib) + cps(2,3,ib) * fw1 + &
& cps(3,3,ib) * fw2 + cps(4,3,ib) * fw3
wwi(i,3) = ( 1.0 - fd ) * wf3 + 7.0 * fd
wf4 = cps(1,4,ib) + cps(2,4,ib) * fw1 + &
& cps(3,4,ib) * fw2 + cps(4,4,ib) * fw3
wwi(i,4) = ( 1.0 - fd ) * wf4 + 9.0 * fd
else
ibr = ib - mbs
gg = cpir(1,ibr) + cpir(2,ibr) * fw1 + &
& cpir(3,ibr) * fw2 + cpir(4,ibr) * fw3
x1 = gg
x2 = x1 * gg
x3 = x2 * gg
x4 = x3 * gg
wwi(i,1) = 3.0 * x1
wwi(i,2) = 5.0 * x2
wwi(i,3) = 7.0 * x3
wwi(i,4) = 9.0 * x4
endif
endif
10 end do
return
end subroutine
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
!C--- using new coefficients for ice single habit
!C--- by Qing Yue 2006
subroutine ice_new_Single ( nv,nv1,ib,pre,pde,plwc,piwc,dz,ti,wi,wwi ) 1,2
!c *********************************************************************
!c ti, wi, and wwi are the optical depth, single scattering albedo, &
!c and expansion coefficients of the phase function ( 1, 2, 3, and
!c 4) due to the scattering of ice clouds for a given layer.
!c *********************************************************************
!# include "para.file"
USE PARA_FILE
USE ice7
implicit none
integer :: nv, nv1
real, dimension(nv) :: pre, plwc, pde, piwc, dz
real :: ti(nv), wi(nv), wwi(nv,4)
real :: fw1, fw2, fw3, wf1, wf2, wf3, wf4, gg, x1, x2, x3, x4
integer :: i, ib, ibr
! changed by Z.F.
! common /zf_solar/tizfs(nv,mbs),wizfs(nv,mbs),wwi1s(nv,mbs),
! & wwi2s(nv,mbs),wwi3s(nv,mbs),wwi4s(nv,mbs)
! changing over
do i = 1, nv
if ( piwc(i) .lt. 1.0e-5 ) then
ti(i) = 0.0
wi(i) = 0.0
wwi(i,1) = 0.0
wwi(i,2) = 0.0
wwi(i,3) = 0.0
wwi(i,4) = 0.0
else
! The constant 1000.0 below is to consider the units of dz(i) is km.
fw1 = pde(i)
fw2 = fw1 * pde(i)
fw3 = fw2 * pde(i)
ti(i) = dz(i) * 1000.0 * piwc(i) * ( ap(1,ib) + &
& ap(2,ib) / fw1 + ap(3,ib) / fw2 )
if(ti(i).lt.0.0) write(*,*)'optical depth of ice=',ti(i)
wi(i) = 1.0 - ( bp(1,ib) + bp(2,ib) * fw1 + &
& bp(3,ib) * fw2 + bp(4,ib) * fw3 )
if ( ib .le. mbs ) then
! changed by Z.F.
wf1 = cps(1,1,ib) + cps(2,1,ib) * fw1 + &
& cps(3,1,ib) * fw2 + cps(4,1,ib) * fw3
wwi(i,1) = wf1
wf2 = cps(1,2,ib) + cps(2,2,ib) * fw1 + &
& cps(3,2,ib) * fw2 + cps(4,2,ib) * fw3
wwi(i,2) = wf2
wf3 = cps(1,3,ib) + cps(2,3,ib) * fw1 + &
& cps(3,3,ib) * fw2 + cps(4,3,ib) * fw3
wwi(i,3) = wf3
wf4 = cps(1,4,ib) + cps(2,4,ib) * fw1 + &
& cps(3,4,ib) * fw2 + cps(4,4,ib) * fw3
wwi(i,4) = wf4
! changing over
else
ibr = ib - mbs
gg = cpir(1,ibr) + cpir(2,ibr) * fw1 + &
& cpir(3,ibr) * fw2 + cpir(4,ibr) * fw3
x1 = gg
x2 = x1 * gg
x3 = x2 * gg
x4 = x3 * gg
wwi(i,1) = 3.0 * x1
wwi(i,2) = 5.0 * x2
wwi(i,3) = 7.0 * x3
wwi(i,4) = 9.0 * x4
endif
endif
10 end do
! added by Z.F.
! if(ib.le.mbs) then
! do i=1,nv
! tizfs(i,ib)=ti(i)
! wizfs(i,ib)=wi(i)
! wwi1s(i,ib)=wwi(i,1)
! wwi2s(i,ib)=wwi(i,2)
! wwi3s(i,ib)=wwi(i,3)
! wwi4s(i,ib)=wwi(i,4)
! end do
! end if
! write(*,*)'ti=',ti
! write(*,*)'wi=',wi
! write(*,*)'wwi1=',(wwi(i,1),i=1,nv)
! write(*,*)'wwi2=',(wwi(i,2),i=1,nv)
! write(*,*)'wwi3=',(wwi(i,3),i=1,nv)
! write(*,*)'wwi4=',(wwi(i,4),i=1,nv)
! adding over
return
end subroutine
subroutine water_fl ( nv,nv1,ib,pre,plwc,pde,piwc,dz,tw,ww,www ) 1,2
!c *********************************************************************
!c tw, ww, and www are the optical depth, single scattering albedo, &
!c and expansion coefficients of the phase function ( 1, 2, 3, and
!c 4) due to the Mie scattering of water clouds for a given layer.
!c By using the mean single scattering properties of the eight drop
!c size distributions in each spectral band, the single scattering
!c properties of a water cloud with the given liquid water content
!c and effective radius are obtained by interpolating (Eqs. 4.25 -
!c 4.27 of Fu, 1991).
!c *********************************************************************
!# include "para.file"
USE PARA_FILE
USE water1
implicit none
integer :: nv, nv1
real, dimension(nv) :: pre, plwc, pde, piwc, dz
real :: tw(nv), ww(nv), www(nv,4)
integer :: ib
real :: x1, x2, x3, x4, gg
integer :: i, j
do i = 1, nv
if ( plwc(i) .lt. 1.0e-5 ) then
tw(i) = 0.0
ww(i) = 0.0
www(i,1) = 0.0
www(i,2) = 0.0
www(i,3) = 0.0
www(i,4) = 0.0
else
if ( pre(i) .lt. re(1) ) then
! A cloud with the effective radius smaller than 4.18 um is assumed
! to have an effective radius of 4.18 um with respect to the single
! scattering properties.
tw(i) = dz(i) * plwc(i) * bz(1,ib) / fl(1)
ww(i) = wz(1,ib)
x1 = gz(1,ib)
x2 = x1 * gz(1,ib)
x3 = x2 * gz(1,ib)
x4 = x3 * gz(1,ib)
www(i,1) = 3.0 * x1
www(i,2) = 5.0 * x2
www(i,3) = 7.0 * x3
www(i,4) = 9.0 * x4
elseif ( pre(i) .gt. re(nc) ) then
! A cloud with the effective radius larger than 31.23 um is assumed
! to have an effective radius of 31.18 um with respect to the single
! scattering properties.
tw(i) = dz(i) * plwc(i) * bz(nc,ib) / fl(nc)
ww(i) = wz(nc,ib)
x1 = gz(nc,ib)
x2 = x1 * gz(nc,ib)
x3 = x2 * gz(nc,ib)
x4 = x3 * gz(nc,ib)
www(i,1) = 3.0 * x1
www(i,2) = 5.0 * x2
www(i,3) = 7.0 * x3
www(i,4) = 9.0 * x4
else
j = 1
do while (pre(i) .lt. re(j))
j = j + 1
end do
tw(i) = dz(i) * plwc(i) * ( bz(j,ib) / fl(j) + &
& ( bz(j+1,ib) / fl(j+1) - bz(j,ib) / fl(j) ) / &
& ( 1.0 / re(j+1) - 1.0 / re(j) ) * ( 1.0 / pre(i) &
& - 1.0 / re(j) ) )
ww(i) = wz(j,ib) + ( wz(j+1,ib) - wz(j,ib) ) / &
& ( re(j+1) - re(j) ) * ( pre(i) - re(j) )
gg = gz(j,ib) + ( gz(j+1,ib) - gz(j,ib) ) / &
& ( re(j+1) - re(j) ) * ( pre(i) - re(j) )
x1 = gg
x2 = x1 * gg
x3 = x2 * gg
x4 = x3 * gg
www(i,1) = 3.0 * x1
www(i,2) = 5.0 * x2
www(i,3) = 7.0 * x3
www(i,4) = 9.0 * x4
endif
endif
10 end do
return
end subroutine
subroutine rayle2(nv,nv1,pp,pt,ph,po,trp) 1,1
!c *********************************************************************
!c trp is P(mb)/T(K)*DZ(m) and the constant 14.6337=R(287)/g(9.806)/2.
!c *********************************************************************
!# include "para.file"
USE PARA_FILE
implicit none
integer :: nv, nv1
real, dimension(nv1) :: pp, pt, ph, po
real :: trp(nv)
integer :: i
do i = 1, nv
trp(i) = 14.6337 * ( pp(i) + pp(i+1) ) &
& * alog( pp(i+1) / pp(i) )
end do
return
end subroutine
subroutine rayle ( nv,nv1,ib,trp,tr,wr,wwr,u0 ) 1,2
!c *********************************************************************
!c tr, wr, and wwr are the optical depth, single scattering albedo, &
!c and expansion coefficients of the phase function ( 1, 2, 3, and
!c 4 ) due to the Rayleigh scattering for a given layer.
!c *********************************************************************
!# include "para.file"
USE PARA_FILE
use rayle1
implicit none
integer :: nv, nv1
real :: u0
real :: trp(nv)
real :: tr(nv), wr(nv), wwr(nv,4)
integer :: ib, i
real :: x
if ( ib .le. mbs ) then
if ( ib .eq. 1 ) then
x = -3.902860e-6 * u0 * u0+6.120070e-6 * u0+4.177440e-6
else
x = ri(ib)
endif
do i = 1, nv
tr(i) = trp(i) * x
wr(i) = 1.0
wwr(i,1) = 0.0
wwr(i,2) = 0.5
wwr(i,3) = 0.0
wwr(i,4) = 0.0
100 end do
else
do i = 1, nv
tr(i) = 0.0
wr(i) = 0.0
wwr(i,1) = 0.0
wwr(i,2) = 0.0
wwr(i,3) = 0.0
wwr(i,4) = 0.0
200 end do
endif
return
end subroutine
subroutine rain ( nv,nv1,ib,prwc,dz,trn,wrn,wwrn ) 1,2
!c *********************************************************************
!c trn, wrn, and wwrn are the optical depth, single scattering albedo, &
!c and expansion coefficients of the phase function ( 1, 2, 3, and 4 )
!c due to the Mie scattering of rain for a given layer.
!c Jan. 19, 1993
!c *********************************************************************
!# include "para.file"
USE PARA_FILE
USE rain1
implicit none
integer :: nv, nv1
real :: prwc(nv), dz(nv)
real :: trn(nv), wrn(nv), wwrn(nv,4)
integer :: ib, i
real :: x1, x2, x3, x4, y1, y2, y3, y4
x1 = grn(ib)
x2 = x1 * grn(ib)
x3 = x2 * grn(ib)
x4 = x3 * grn(ib)
y1 = 3.0 * x1
y2 = 5.0 * x2
y3 = 7.0 * x3
y4 = 9.0 * x4
do i = 1, nv
if ( prwc(i) .lt. 1.0e-5 ) then
trn(i) = 0.0
wrn(i) = 0.0
wwrn(i,1) = 0.0
wwrn(i,2) = 0.0
wwrn(i,3) = 0.0
wwrn(i,4) = 0.0
else
trn(i) = dz(i) * prwc(i) * brn(ib) / rwc
wrn(i) = wrnf(ib)
wwrn(i,1) = y1
wwrn(i,2) = y2
wwrn(i,3) = y3
wwrn(i,4) = y4
endif
10 end do
return
end subroutine
subroutine graup ( nv,nv1,ib,pgwc,dz, tgr,wgr,wwgr ) 1,2
!c *********************************************************************
!c tgr, wgr, and wwgr are the optical depth, single scattering albedo, &
!c and expansion coefficients of the phase function ( 1, 2, 3, and 4 )
!c due to the Mie scattering of graupel for a given layer.
!c Jan. 19, 1993
!c *********************************************************************
!# include "para.file"
USE PARA_FILE
USE graup1
implicit none
integer :: nv, nv1
real :: pgwc(nv), dz(nv)
real :: tgr(nv), wgr(nv), wwgr(nv,4)
integer :: ib, i
real :: x1, x2, x3, x4, y1, y2, y3, y4
x1 = gg(ib)
x2 = x1 * gg(ib)
x3 = x2 * gg(ib)
x4 = x3 * gg(ib)
y1 = 3.0 * x1
y2 = 5.0 * x2
y3 = 7.0 * x3
y4 = 9.0 * x4
do i = 1, nv
if ( pgwc(i) .lt. 1.0e-5 ) then
tgr(i) = 0.0
wgr(i) = 0.0
wwgr(i,1) = 0.0
wwgr(i,2) = 0.0
wwgr(i,3) = 0.0
wwgr(i,4) = 0.0
else
tgr(i) = dz(i) * pgwc(i) * bg(ib) / gwc
wgr(i) = wgf(ib)
wwgr(i,1) = y1
wwgr(i,2) = y2
wwgr(i,3) = y3
wwgr(i,4) = y4
endif
10 end do
return
end subroutine
subroutine gascon ( nv,nv1,ib,tgm,pp,pt,ph,po ) 1,2
!c *********************************************************************
!c tgm(nv) are the optical depthes due to water vapor continuum absorp-
!c tion in nv layers for a given band ib. We include continuum absorp-
!c tion in the 280 to 1250 cm**-1 region. vv(11)-vv(17) are the central
!c wavenumbers of each band in this region.
!c *********************************************************************
!# include "para.file"
USE PARA_FILE
implicit none
integer :: nv, nv1
real, dimension(nv1) :: pp, pt, ph, po
real :: tgm(nv)
real :: vv(18) = (/ 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
0.0, 0.0, 1175.0, 1040.0, 890.0, 735.0, &
& 605.0, 470.0, 340.0, 0.0 /)
integer :: ib, i
if ( ib .gt. 10 .and. ib .lt. 18 ) then
call qopcon ( nv, nv1, vv(ib),tgm,pp,pt,ph,po )
else
do i = 1, nv
tgm(i) = 0.0
10 end do
endif
return
end subroutine
subroutine gases ( nv,nv1,ib,ig,hk,pp,pt,ph,po,tg ) 1,50
! *********************************************************************
! tg(nv) are the optical depthes due to nongray gaseous absorption, in
! nv layers for a given band ib and cumulative probability ig.
! *********************************************************************
USE PARA_FILE
USE band, only: hk1=>hk_1,fk1o3=>fko3_1, &
& hk2=>hk_2,c2h2o=>coeh2o_2, &
& hk3=>hk_3,c3h2o=>coeh2o_3, &
& hk4=>hk_4,c4h2o=>coeh2o_4, &
& hk5=>hk_5,c5h2o=>coeh2o_5, &
& hk6=>hk_6,c6h2o=>coeh2o_6, &
& hk7=>hk_7,c7h2o=>coeh2o_7, &
& hk8=>hk_8,c8h2o=>coeh2o_8, &
& hk9=>hk_9,c9h2o=>coeh2o_9, &
& hk10=>hk_10,c10h2o=>coeh2o_10, &
& c10ch4=>coech4_10,c10n2o=>coen2o_10,&
& hk11=>hk_11,c11h2o=>coeh2o_11, &
& c11ch4=>coech4_11,c11n2o=>coen2o_11,&
& hk12=>hk_12,c12o3=>coeo3_12, &
& c12h2o=>coeh2o_12, &
& hk13=>hk_13,c13h2o=>coeh2o_13, &
& hk14=>hk_14,c14hca=>coehca_14, &
& c14hcb=>coehcb_14, &
& hk15=>hk_15,c15hca=>coehca_15, &
& c15hcb=>coehcb_15, &
& hk16=>hk_16,c16h2o=>coeh2o_16, &
& hk17=>hk_17,c17h2o=>coeh2o_17, &
& hk18=>hk_18,c18h2o=>coeh2o_18
use control_para, only: umco2,umch4,umn2o,umo2, &
& umno,umso2,umno2,umch3cl, &
& umco,umCFC11,umCFC12, &
& nco2s,nso2s,nch4s,nnol,no2s, &
& nno2l,nso2l,nch3cll,ncos, &
& nn2os,nh2ocs,nh2os,no3s, &
& nh2ol,no3l,nco2l,nn2ol, &
& nch4l,nCFC11l,nCFC12l
implicit none
integer :: nv, nv1
real, dimension(nv1) :: pp, pt, ph, po
real :: tg(nv)
integer :: ib, ig
real :: hk
!!!!!!!!!!!!!!!!!c
real, dimension(nv1) :: fkg, fkga, fkgb, pq
real, dimension(nv) :: tg1, tg2, tg3
real :: fk
integer :: i
select case(ib)
case default
stop
!-------------------------------------
case(1)
1 fk = fk1o3(ig)
call qopo3s ( nv,nv1,fk,tg,pp,pt,ph,po )
hk = 619.618 * hk1(ig)
! In this band ( 50000 - 14500 cm**-1 ), we have considered the nongray
! gaseous absorption of O3. 619.618 is the solar energy contained in
! the band in units of Wm**-2.
case(2)
2 call qks ( nv,nv1,c2h2o(1,1,ig),fkg,pp,pt,ph,po )
call qoph2o ( nv,nv1,fkg, tg,pp,pt,ph,po )
hk = 484.295 * hk2(ig)
! In this band ( 14500 - 7700 cm**-1 ), we have considered the nongray
! gaseous absorption of H2O. 484.295 is the solar energy contained in
! the band in units of Wm**-2.
case(3)
3 call qks ( nv,nv1,c3h2o(1,1,ig),fkg,pp,pt,ph,po )
call qoph2o ( nv,nv1,fkg, tg,pp,pt,ph,po )
hk = 149.845 * hk3(ig)
! In this band ( 7700 - 5250 cm**-1 ), we have considered the nongray
! gaseous absorption of H2O. 149.845 is the solar energy contained in
! the band in units of Wm**-2.
case(4)
4 call qks ( nv,nv1,c4h2o(1,1,ig),fkg,pp,pt,ph,po )
call qoph2o ( nv,nv1,fkg, tg,pp,pt,ph,po )
hk = 48.7302 * hk4(ig)
! In this band ( 5250 - 4000 cm**-1 ), we have considered the nongray
! gaseous absorption of H2O. 48.7302 is the solar energy contained in
! the band in units of Wm**-2.
case(5)
5 call qks ( nv,nv1,c5h2o(1,1,ig),fkg,pp,pt,ph,po )
call qoph2o ( nv,nv1,fkg, tg,pp,pt,ph,po )
hk = 31.6576 * hk5(ig)
! In this band ( 4000 - 2850 cm**-1 ), we have considered the nongray
! gaseous absorption of H2O. 31.6576 is the solar energy contained in
! the band in units of Wm**-2.
case(6)
6 call qks ( nv,nv1,c6h2o(1,1,ig),fkg,pp,pt,ph,po )
call qoph2o ( nv,nv1,fkg, tg,pp,pt,ph,po )
hk = 5.79927 * hk6(ig)
! In this band ( 2850 - 2500 cm**-1 ), we have considered the nongray
! gaseous absorption of H2O. 5.79927 is the solar energy contained in
! the band in units of Wm**-2.
case(7)
7 call qki ( nv,nv1,c7h2o(1,1,ig), fkg,pp,pt,ph,po )
call qoph2o ( nv,nv1,fkg, tg,pp,pt,ph,po )
hk = hk7(ig)
! In this band ( 2200 - 1900 cm**-1 ), we have considered the nongray
! gaseous absorption of H2O.
case(8)
8 call qki ( nv,nv1,c8h2o(1,1,ig), fkg,pp,pt,ph,po )
call qoph2o ( nv,nv1,fkg, tg,pp,pt,ph,po )
hk = hk8(ig)
! In this band ( 1900 - 1700 cm**-1 ), we have considered the nongray
! gaseous absorption of H2O.
case(9)
9 call qki ( nv,nv1,c9h2o(1,1,ig), fkg,pp,pt,ph,po )
call qoph2o ( nv,nv1,fkg, tg,pp,pt,ph,po )
hk = hk9(ig)
! In this band ( 1700 - 1400 cm**-1 ), we have considered the nongray
! gaseous absorption of H2O.
case(10)
10 call qki ( nv,nv1,c10h2o(1,1,ig), fkg,pp,pt,ph,po )
call qoph2o ( nv,nv1,fkg, tg1,pp,pt,ph,po )
call qki ( nv,nv1,c10ch4, fkg,pp,pt,ph,po )
call qopch4 ( nv,nv1,fkg, tg2,pp,pt,ph,po )
call qki ( nv,nv1,c10n2o, fkg,pp,pt,ph,po )
call qopn2o ( nv,nv1,fkg, tg3,pp,pt,ph,po )
do i = 1, nv
tg(i) = tg1(i) + tg2(i)/1.6*umch4 + tg3(i)/0.28*umn2o
205 end do
hk = hk10(ig)
! In this band ( 1400 - 1250 cm**-1 ), we have considered the overlapping
! absorption of H2O, CH4, and N2O by approach one of Fu(1991).
case(11)
11 call qki ( nv,nv1,c11h2o(1,1,ig), fkg,pp,pt,ph,po )
call qoph2o ( nv,nv1,fkg, tg1,pp,pt,ph,po )
call qki ( nv,nv1,c11ch4, fkg,pp,pt,ph,po )
call qopch4 ( nv,nv1,fkg, tg2,pp,pt,ph,po )
call qki ( nv,nv1,c11n2o, fkg,pp,pt,ph,po )
call qopn2o ( nv,nv1,fkg, tg3,pp,pt,ph,po )
do i = 1, nv
tg(i) = tg1(i) + tg2(i)/1.6*umch4 + tg3(i)/0.28*umn2o
215 end do
hk = hk11(ig)
! In this band ( 1250 - 1100 cm**-1 ), we have considered the overlapping
! absorption of H2O, CH4, and N2O by approach one of Fu(1991).
case(12)
12 call qkio3 ( nv,nv1,c12o3(1,1,ig), fkg,pp,pt,ph,po )
call qopo3i ( nv,nv1,fkg, tg1,pp,pt,ph,po )
call qki ( nv,nv1,c12h2o, fkg,pp,pt,ph,po )
call qoph2o ( nv,nv1,fkg, tg2,pp,pt,ph,po )
do i = 1, nv
tg(i) = tg1(i) + tg2(i)
225 end do
hk = hk12(ig)
! In this band ( 1100 - 980 cm**-1 ), we have considered the overlapping
! absorption of H2O and O3 by approach one of Fu(1991).
case(13)
13 call qki ( nv,nv1,c13h2o(1,1,ig), fkg,pp,pt,ph,po )
call qoph2o ( nv,nv1,fkg, tg,pp,pt,ph,po )
hk = hk13(ig)
! In this band ( 980 - 800 cm**-1 ), we have considered the nongray
! gaseous absorption of H2O.
case(14)
14 do i = 1, nv1
if ( pp(i) .ge. 63.1 ) then
pq(i) = ph(i)
else
pq(i) = 0.0
endif
333 end do
call qki ( nv,nv1,c14hca(1,1,ig), fkga,pp,pt,ph,po )
call qki ( nv,nv1,c14hcb(1,1,ig), fkgb,pp,pt,ph,po )
do i = 1, nv1
fkg(i) = fkga(i)/330.0*umco2 + pq(i) * fkgb(i)
343 end do
call qophc ( nv,nv1,fkg, tg,pp,pt,ph,po)
hk = hk14(ig)
! In this band ( 800 - 670 cm**-1), we have considered the overlapping
! absorption of H2O and CO2 by approach two of Fu(1991).
case(15)
15 do i = 1, nv1
if ( pp(i) .ge. 63.1 ) then
pq(i) = ph(i)
else
pq(i) = 0.0
endif
353 end do
call qki ( nv,nv1,c15hca(1,1,ig), fkga,pp,pt,ph,po )
call qki ( nv,nv1,c15hcb(1,1,ig), fkgb,pp,pt,ph,po )
do i = 1, nv1
fkg(i) = fkga(i)/330.0*umco2 + pq(i) * fkgb(i)
363 end do
call qophc ( nv,nv1,fkg, tg,pp,pt,ph,po)
hk = hk15(ig)
! In this band ( 670 - 540 cm**-1), we have considered the overlapping
! absorption of H2O and CO2 by approach two of Fu(1991).
case(16)
16 call qki ( nv,nv1,c16h2o(1,1,ig), fkg,pp,pt,ph,po )
call qoph2o ( nv,nv1,fkg, tg,pp,pt,ph,po )
hk = hk16(ig)
! In this band ( 540 - 400 cm**-1 ), we have considered the nongray
! gaseous absorption of H2O.
case(17)
17 call qki ( nv,nv1,c17h2o(1,1,ig), fkg,pp,pt,ph,po )
call qoph2o ( nv,nv1,fkg, tg,pp,pt,ph,po )
hk = hk17(ig)
! In this band ( 400 - 280 cm**-1 ), we have considered the nongray
! gaseous absorption of H2O.
case(18)
18 call qki ( nv,nv1,c18h2o(1,1,ig), fkg,pp,pt,ph,po )
call qoph2o ( nv,nv1,fkg, tg,pp,pt,ph,po )
hk = hk18(ig)
! In this band ( 280 - 000 cm**-1 ), we have considered the nongray
! gaseous absorption of H2O.
end select
return
end subroutine
subroutine qks ( nv,nv1,coefks,fkg,pp,pt,ph,po ) 17,1
!c *********************************************************************
!c fkg(nv1) are the gaseous absorption coefficients in units of (cm-atm)
!c **-1 for a given cumulative probability in nv1 layers. coefks(3,11)
!c are the coefficients to calculate the absorption coefficient at the
!c temperature t for the 11 pressures by
!c ln k = a + b * ( t - 245 ) + c * ( t - 245 ) ** 2
!c and the absorption coefficient at conditions other than those eleven
!c pressures is interpolated linearly with pressure (Fu, 1991).
!c *********************************************************************
!# include "para.file"
USE PARA_FILE
implicit none
integer :: nv, nv1
real, dimension(nv1) :: pp, pt, ph, po, fkg
real :: coefks(3,11)
real :: stanp(11) = (/ 10.0, 15.8, 25.1, 39.8, 63.1, 100.0, &
& 158.0, 251.0, 398.0, 631.0, 1000.0 /)
integer :: i1, i
real :: x1, x2, y1
i1 = 1
do i = 1, nv1
if ( pp(i) .lt. stanp(1) ) then
x1 = exp ( coefks(1,1) + coefks(2,1) * ( pt(i) - 245.0 ) &
& + coefks(3,1) * ( pt(i) - 245.0 ) ** 2 )
fkg(i) = x1 * pp(i) / stanp(1)
elseif ( pp(i) .ge. stanp(11) ) then
y1 = ( pt(i) - 245.0 ) * ( pt(i) - 245.0 )
x1 = exp ( coefks(1,10) + coefks(2,10) * ( pt(i) - 245.0 ) &
& + coefks(3,10) * y1 )
x2 = exp ( coefks(1,11) + coefks(2,11) * ( pt(i) - 245.0 ) &
& + coefks(3,11) * y1 )
fkg(i) = x1 + ( x2 - x1 ) / ( stanp(11) - stanp(10) ) &
& * ( pp(i) - stanp(10) )
else
do while ( pp(i) .ge. stanp(i1) )
i1 = i1 + 1
end do
y1 = ( pt(i) - 245.0 ) * ( pt(i) - 245.0 )
x1 = exp ( coefks(1,i1-1) + coefks(2,i1-1) * (pt(i)-245.0) &
& + coefks(3,i1-1) * y1 )
x2 = exp ( coefks(1,i1) + coefks(2,i1) * ( pt(i) - 245.0 ) &
& + coefks(3,i1) * y1 )
fkg(i) = x1 + ( x2 - x1 ) / ( stanp(i1) - stanp(i1-1) ) &
& * ( pp(i) - stanp(i1-1) )
endif
end do
return
end subroutine
subroutine qki ( nv,nv1,coefki, fkg,pp,pt,ph,po ) 40,1
!c *********************************************************************
!c fkg(nv1) are the gaseous absorption coefficients in units of (cm-atm)
!c **-1 for a given cumulative probability in nv1 layers. coefki(3,19)
!c are the coefficients to calculate the absorption coefficient at the
!c temperature t for the 19 pressures by
!c ln k = a + b * ( t - 245 ) + c * ( t - 245 ) ** 2
!c and the absorption coefficient at conditions other than those 19
!c pressures is interpolated linearly with pressure (Fu, 1991).
!c *********************************************************************
!# include "para.file"
USE PARA_FILE
implicit none
integer :: nv, nv1
real, dimension(nv1) :: pp, pt, ph, po, fkg
real :: coefki(3,19)
integer :: i, i1
real :: x1, x2, y1
real :: stanp(19) = (/ 0.251, 0.398, 0.631, 1.000, 1.58, 2.51, &
& 3.98, 6.31, 10.0, 15.8, 25.1, 39.8, 63.1, &
& 100.0, 158.0, 251.0, 398.0, 631.0, 1000.0 /)
i1 = 1
do i = 1, nv1
! -test
if (pt(i).gt.320.) then
pt(i) = 345.
endif
if (pt(i).lt.180.) then
pt(i) = 180.
endif
! -test over
if ( pp(i) .lt. stanp(1) ) then
x1 = exp ( coefki(1,1) + coefki(2,1) * ( pt(i) - 245.0 ) &
& + coefki(3,1) * ( pt(i) - 245.0 ) ** 2 )
fkg(i) = x1 * pp(i) / stanp(1)
elseif ( pp(i) .ge. stanp(19) ) then
y1 = ( pt(i) - 245.0 ) * ( pt(i) - 245.0 )
x1 = exp ( coefki(1,18) + coefki(2,18) * ( pt(i) - 245.0 ) &
& + coefki(3,18) * y1 )
x2 = exp ( coefki(1,19) + coefki(2,19) * ( pt(i) - 245.0 ) &
& + coefki(3,19) * y1 )
fkg(i) = x1 + ( x2 - x1 ) / ( stanp(19) - stanp(18) ) &
& * ( pp(i) - stanp(18) )
else
do while ( pp(i) .ge. stanp(i1) )
i1 = i1 + 1
end do
y1 = ( pt(i) - 245.0 ) * ( pt(i) - 245.0 )
x1 = exp ( coefki(1,i1-1) + coefki(2,i1-1) * (pt(i)-245.0) &
& + coefki(3,i1-1) * y1 )
x2 = exp ( coefki(1,i1) + coefki(2,i1) * ( pt(i) - 245.0 ) &
& + coefki(3,i1) * y1 )
fkg(i) = x1 + ( x2 - x1 ) / ( stanp(i1) - stanp(i1-1) ) &
& * ( pp(i) - stanp(i1-1) )
endif
end do
return
end subroutine
subroutine qkio3 ( nv,nv1,coefki, fkg,pp,pt,ph,po ) 2,1
!c *********************************************************************
!c fkg(nv1) are the gaseous absorption coefficients in units of (cm-atm)
!c **-1 for a given cumulative probability in nv1 layers. coefki(3,19)
!c are the coefficients to calculate the absorption coefficient at the
!c temperature t for the 19 pressures by
!c ln k = a + b * ( t - 250 ) + c * ( t - 250 ) ** 2
!c and the absorption coefficient at conditions other than those 19
!c pressures is interpolated linearly with pressure (Fu, 1991).
!c *********************************************************************
!# include "para.file"
USE PARA_FILE
implicit none
integer :: nv, nv1
real, dimension(nv1) :: pp, pt, ph, po
real :: coefki(3,19), fkg(nv1)
integer :: i, i1
real :: x1, x2, y1
real :: stanp(19) = (/0.251, 0.398, 0.631, 1.000, 1.58, 2.51, &
& 3.98, 6.31, 10.0, 15.8, 25.1, 39.8, 63.1, &
& 100.0, 158.0, 251.0, 398.0, 631.0, 1000.0/)
i1 = 1
do i = 1, nv1
if ( pp(i) .lt. stanp(1) ) then
x1 = exp ( coefki(1,1) + coefki(2,1) * ( pt(i) - 250.0 ) &
& + coefki(3,1) * ( pt(i) - 250.0 ) ** 2 )
fkg(i) = x1 * pp(i) / stanp(1)
elseif ( pp(i) .ge. stanp(19) ) then
y1 = ( pt(i) - 250.0 ) * ( pt(i) - 250.0 )
x1 = exp ( coefki(1,18) + coefki(2,18) * ( pt(i) - 250.0 ) &
& + coefki(3,18) * y1 )
x2 = exp ( coefki(1,19) + coefki(2,19) * ( pt(i) - 250.0 ) &
& + coefki(3,19) * y1 )
fkg(i) = x1 + ( x2 - x1 ) / ( stanp(19) - stanp(18) ) &
& * ( pp(i) - stanp(18) )
else
do while ( pp(i) .ge. stanp(i1) )
i1 = i1 + 1
end do
y1 = ( pt(i) - 250.0 ) * ( pt(i) - 250.0 )
x1 = exp ( coefki(1,i1-1) + coefki(2,i1-1) * (pt(i)-250.0) &
& + coefki(3,i1-1) * y1 )
x2 = exp ( coefki(1,i1) + coefki(2,i1) * ( pt(i) - 250.0 ) &
& + coefki(3,i1) * y1 )
fkg(i) = x1 + ( x2 - x1 ) / ( stanp(i1) - stanp(i1-1) ) &
& * ( pp(i) - stanp(i1-1) )
end if
5 end do
return
end subroutine
!---------------------------------------------------
subroutine qopo3s ( nv,nv1,fk,tg,pp,pt,ph,po ) 2,1
!# include "para.file"
USE PARA_FILE
implicit none
integer :: nv, nv1
real, dimension(nv1) :: pp, pt, ph, po
real, dimension(nv) :: tg
real :: fk, fq
integer :: i
fq = 238.08 * fk
do i = 1, nv
tg(i) = ( po(i) + po(i+1) ) * ( pp(i+1) - pp(i) ) * fq
10 end do
! do 20 i = 1, nv
! tg(i) = tg(i) * 476.16 * fk
!20 continue
! 476.16 = 2.24e4 / M * 10.0 / 9.8, where M = 48 for O3.?
return
end subroutine
!----------------------------------------------------
subroutine qoph2o ( nv,nv1,fkg, tg,pp,pt,ph,po ) 25,1
!# include "para.file"
USE PARA_FILE
implicit none
integer :: nv, nv1
real, dimension(nv1) :: pp, pt, ph, po
real :: fkg(nv1), tg(nv)
integer :: i
do i = 1, nv
tg(i) = ( fkg(i) * ph(i) + fkg(i+1) * ph(i+1) ) &
& * ( pp(i+1) - pp(i) ) * 634.9205
10 end do
! do 20 i = 1, nv
! tg(i) = tg(i) * 1269.841
!20 continue
! 1269.841 = 2.24e4 / M * 10.0 / 9.8, where M = 18 for H2O.
return
end subroutine
!-----------------------------------------------------
subroutine qopch4 ( nv,nv1,fkg, tg,pp,pt,ph,po ) 5,1
!# include "para.file"
USE PARA_FILE
implicit none
integer :: nv, nv1
real, dimension(nv1) :: pp, pt, ph, po
real :: fkg(nv1), tg(nv)
integer :: i
do i = 1, nv
tg(i) = ( fkg(i)+fkg(i+1) ) *( pp(i+1)-pp(i) )* 6.3119e-4
10 end do
! do 20 i = 1, nv
! tg(i) = tg(i) * 1.26238e-3
!20 continue
! 1.26238e-3 = 2.24e4 / M * 10.0 / 9.8 * 1.6e-6 * M / 28.97, where
! M = 16 for CH4.
return
end subroutine
!-------------------------------------------------------
subroutine qopn2o ( nv,nv1,fkg, tg,pp,pt,ph,po ) 5,1
!# include "para.file"
USE PARA_FILE
implicit none
integer :: nv, nv1
real, dimension(nv1) :: pp, pt, ph, po
real :: fkg(nv1), tg(nv)
integer :: i
do i = 1, nv
tg(i) = ( fkg(i)+fkg(i+1) ) * (pp(i+1)-pp(i))*1.10459e-4
10 end do
! do 20 i = 1, nv
! tg(i) = tg(i) * 2.20918e-4
!20 continue
! 2.20918e-4 = 2.24e4 / M * 10.0 / 9.8 * 0.28e-6 * M / 28.97, where
! M = 44 for N2O.
return
end subroutine
!--------------------------------------------------------
subroutine qopo3i ( nv,nv1,fkg, tg,pp,pt,ph,po ) 2,1
!# include "para.file"
USE PARA_FILE
implicit none
integer :: nv, nv1
real, dimension(nv1) :: pp, pt, ph, po
real :: fkg(nv1), tg(nv)
integer :: i
do i = 1, nv
tg(i) = ( fkg(i) * po(i) + fkg(i+1) * po(i+1) ) &
& * ( pp(i+1) - pp(i) ) * 238.08
10 end do
! do 20 i = 1, nv
! tg(i) = tg(i) * 476.16
!20 continue
return
end subroutine
!----------------------------------------------
subroutine qophc ( nv,nv1,fkg, tg,pp,pt,ph,po ) 9,1
!# include "para.file"
USE PARA_FILE
implicit none
integer :: nv, nv1
real, dimension(nv1) :: pp, pt, ph, po
real :: fkg(nv1), tg(nv)
integer :: i
do i = 1, nv
tg(i) = ( fkg(i) + fkg(i+1) ) * ( pp(i+1) - pp(i) ) * 0.5
10 end do
! See page 86 of Fu (1991).
return
end subroutine
!----------------------------------------------
subroutine qopcon ( nv,nv1,vv,tg,pp,pt,ph,po ) 1,1
!# include "para.file"
USE PARA_FILE
implicit none
integer :: nv, nv1
real, dimension(nv1) :: pp, pt, ph, po, &
& ff, pe
real :: vv, tg(nv)
real :: x, y, z, r, s, w
integer :: i
x = 4.18
y = 5577.8
z = 0.00787
r = 0.002
s = ( x + y * exp ( - z * vv ) ) / 1013.25
do i = 1, nv1
pe(i) = pp(i) * ph(i) / ( 0.622 + 0.378 * ph(i) )
w = exp ( 1800.0 / pt(i) - 6.08108 )
ff(i) = s * ( pe(i) + r * pp(i) ) * w
end do
do i = 1, nv
tg(i) = ( ff(i) * ph(i) + ff(i+1) * ph(i+1) )* &
& ( pp(i+1) - pp(i) ) * 0.5098835
end do
! do 7 i = 1, nv
! tg(i) = tg(i) * 10.0 / 9.80616
!7 continue
return
end subroutine
!c function fk ( v, e, p, t )
!c The units of fk is cm**2/g. See Eq. (A.19) of Fu (1991).
!c x = 4.18
!c y = 5577.8
!c z = 0.00787
!c r = 0.002
!c w = exp ( 1800.0 / t - 6.08108 )
!c fk = ( x + y * exp ( -z * v ) ) * ( e + r * p ) * w / 1013.25
!c return
!c end
!C--- add for new gases
!-------------------------------------------------------------
subroutine qopo2 ( nv,nv1,fkg, tg,pp,pt,ph,po ) 1,1
!# include "para.file"
USE PARA_FILE
implicit none
integer :: nv, nv1
real, dimension(nv1) :: pp, pt, ph, po
real :: fkg(nv1), tg(nv)
integer :: i
real :: am=32
do i = 1, nv
tg(i) = 0.5*(fkg(i)+fkg(i+1)) *(pp(i+1)-pp(i)) * &
& 2.24e4/aM*10.0/9.8*2.0948E+05*1.0e-6*aM/28.97
10 end do
return
end subroutine
!-------------------------------------------------------------
subroutine qopco2 ( nv,nv1,fkg, tg,pp,pt,ph,po ) 2,1
!# include "para.file"
USE PARA_FILE
implicit none
integer :: nv, nv1
real, dimension(nv1) :: pp, pt, ph, po
real :: fkg(nv1), tg(nv)
integer :: i
real :: am=44
do i = 1, nv
tg(i) = 0.5*( fkg(i)+fkg(i+1) ) * ( pp(i+1)-pp(i) ) * &
& 2.24e4 / aM * 10.0 / 9.8 * 330.0 *1.0e-6* aM / 28.97
10 end do
! 2.24e4 / M * 10.0 / 9.8 * 330.0 * M / 28.97, where
! M = 44 for CO2.
return
end subroutine
!---------------------------------------------------------------
subroutine qopco ( nv,nv1,fkg, tg,pp,pt,ph,po ) 1,1
!# include "para.file"
USE PARA_FILE
implicit none
integer :: nv, nv1
real, dimension(nv1) :: pp, pt, ph, po
real :: fkg(nv1), tg(nv)
integer :: i
real :: am=28
do i = 1, nv
tg(i) = 0.5*( fkg(i)+fkg(i+1) ) * ( pp(i+1)-pp(i) ) * &
& 2.24e4 / aM * 10.0 / 9.8 * 0.16 *1.0e-6* aM / 28.97
10 end do
return
end subroutine
!----------------------------------------------------------------------
subroutine qopno ( nv,nv1,fkg, tg,pp,pt,ph,po ) 2,1
!# include "para.file"
USE PARA_FILE
implicit none
integer :: nv, nv1
real, dimension(nv1) :: pp, pt, ph, po
real :: fkg(nv1), tg(nv)
integer :: i
real :: am=30
do i = 1, nv
tg(i) = 0.5*( fkg(i)+fkg(i+1) ) * ( pp(i+1)-pp(i) ) * &
& 2.24e4 / aM * 10.0 / 9.8 * 0.0005 *1.0e-6* aM / 28.97
10 end do
return
end subroutine
!----------------------------------------------------------------------
subroutine qopch3cl ( nv,nv1,fkg, tg,pp,pt,ph,po ) 1,1
!# include "para.file"
USE PARA_FILE
implicit none
integer :: nv, nv1
real, dimension(nv1) :: pp, pt, ph, po
real :: fkg(nv1), tg(nv)
integer :: i
real :: am=50.5
do i = 1, nv
tg(i) = 0.5*( fkg(i)+fkg(i+1) ) * ( pp(i+1)-pp(i) ) * &
& 2.24e4 / aM * 10.0 / 9.8 * 0.5e-3 *1.0e-6* aM / 28.97
10 end do
return
end subroutine
!-----------------------------------------------------------------------
subroutine qopso2 ( nv,nv1,fkg, tg,pp,pt,ph,po ) 2,1
!# include "para.file"
USE PARA_FILE
implicit none
integer :: nv, nv1
real, dimension(nv1) :: pp, pt, ph, po
real :: fkg(nv1), tg(nv)
integer :: i
real :: am=64
do i = 1, nv
tg(i) = 0.5*( fkg(i)+fkg(i+1) ) * ( pp(i+1)-pp(i) ) * &
& 2.24e4 / aM * 10.0 / 9.8 * 0.001 *1.0e-6* aM / 28.97
10 end do
return
end subroutine
!ccc- change for new gases over
!---------------------------------------------------------------
!! add CFC begin: 2007.06 Yue
subroutine qopCFC11 ( nv,nv1,coefCFC, tg,pp,pt,ph,po ) 3,1
use PARA_FILE
implicit none
integer :: nv, nv1
real, dimension(nv1) :: pp, pt, ph, po
real :: coefCFC, fkg(nv1), tg(nv)
integer :: i
real :: aM=137.3684
do i = 1,nv1
fkg(i) = coefCFC
enddo
do i = 1, nv
tg(i) = 0.5*( fkg(i)+fkg(i+1) ) * ( pp(i+1)-pp(i) ) * &
& 2.24e4/aM*10.0/9.8*0.22e-3*1.0e-6*aM/28.97
10 end do
return
end subroutine
!----------------------------------------------------------------
subroutine qopCFC12 ( nv,nv1,coefCFC, tg,pp,pt,ph,po ) 3,1
use PARA_FILE
implicit none
integer :: nv, nv1
real, dimension(nv1) :: pp, pt, ph, po
real :: coefCFC, fkg(nv1), tg(nv)
integer :: i
real :: aM=120.9138
do i = 1,nv1
fkg(i) = coefCFC
enddo
do i = 1, nv
tg(i) = 0.5* ( fkg(i)+fkg(i+1) ) * ( pp(i+1)-pp(i) ) * &
& 2.24e4/aM*10.0/9.8*0.375e-3*1.0e-6*aM/28.97
10 end do
return
end subroutine
!! CFC add end
!! -- with aerosol & partly cloudy
! subroutine comscp_aero( ti,wi,wwi,tw,ww,www, &
! & trn,wrn,wwrn,tgr,wgr,wwgr, &
! & tr,wr,wwr,tgm,tg,tae,wae,wwae, &
! & wc1,wc2,wc3,wc4,wc,tt &
! & )
!!c *********************************************************************
!!c This subroutine is used to COMbine Single-Scattering Properties due
!!c to ice crystals, water droplets, and Rayleigh molecules along with
!!c H2O continuum absorption and nongray gaseous absorption. See Section
!!c 3.4 of Fu (1991). wc, wc1, wc2, wc3, and wc4, are total (or combined)
!!c single - scattering albedo, and expansion coefficients of the
!!c phase function ( 1, 2, 3, and 4 ) in nv layers. tt(nv) are the normal
!!c optical depth ( from the top of the atmosphere to a given level ) for
!!c level 2 - level nv1( surface ). The single-scattering properties of
!!c rain and graupel are also incorporated in ( Jan. 19, 1993 ).
!!c *********************************************************************
!!c The single-scattering properties of aerosols are incorporated in
!!c (10/29/96) based on earlier version (5/17/95).
!!c *********************************************************************
!!# include "para.file"
! USE PARA_FILE
! USE control_para
!
! common /ic/ ti(nv), wi(nv), wwi(nv,4)
! common /wat/ tw(nv), ww(nv), www(nv,4)
! common /rai/ trn(nv), wrn(nv), wwrn(nv,4)
! common /gra/ tgr(nv), wgr(nv), wwgr(nv,4)
! common /ray/ tr(nv), wr(nv), wwr(nv,4)
! common /con/ tgm(nv)
! common /gas/ tg(nv)
!!C--- add by Yu for fractional cloud
! common /dfsin_2/ wc1_2(nv,2), wc2_2(nv,2), wc3_2(nv,2), &
! wc4_2(nv,2), &
! wc_2(nv,2), tt_2(nv,2)
! common /delta_tao/ tc_2(nv,2)
!!c-- change over
! common /dfsin/ wc1(nv), wc2(nv), wc3(nv), wc4(nv), &
! wc(nv), tt(nv)
!!C--- change by Yu, 02/13/02
!!c common /cld_a/cldamnt(nv), area_h(2), area_m(2), area_l(2)
!!c common /cld_c/n_h, n_m, n_l, cld_h, cld_m, cld_l
! common /cld_a/cldamnt(nv), area_group(3,2)
! common /cld_inho/cc_inho(nv)
! common /cld_c/n_group(3), cld_group(3)
! common /cld_loop/ nb(3)
!!c-- change over
!
!!C-- added by Yu Gu 11/2006 to add control parameter
! common /nctrl/ naero, nfract, nice,ngas
!
!!C-- change by Yu Gu 01/2003 to add aerosol
!!c---------- 10/29/96 (4)
! real tae,wae,wwae,taes(0:4)
! common /aer/ tae(nvx,mxac), wae(nvx,mxac), wwae(nvx,4,mxac)
! common /aero_ctrl/ ifg, ivd, itp, nac, iaform, n_atau
!!c---------- 10/29/96 (4)
!!C-- change over for aerosol
!
! dimension tc(nv)
!
!!c--- change by Yu, 02/13/02
!!c--- change by Yu, 02/13/02
!
!!c-- define inhomogeneity factor
!!c c_inho = 0.7
!!c--- test 0.8
!!c c_inho = 0.8
!
!!c--- determine n_group(k), cld_group(k), and area_group(k,1), area_group(k,2)
!!c--- hight,middle, and low three cloud groups
! do k=1,ngroup
!!c do k=1,3
!
! kl = (k-1)*nsubcld + nv1 - nclouds
!!c kl = (k-1)*3 + 7
! cld_group(k) = cldamnt(kl)
! do i=kl+1,kl+nsubcld-1
!!c do i=kl+1,kl+2
! if (cldamnt(i).gt.cld_group(k)) then
! cld_group(k) = cldamnt(i)
! endif
! enddo
!!c-- partly cloudy
! if (cld_group(k).gt.0.0.and.cld_group(k).lt.1.) then
! n_group(k) = 2
! nb(k) = 1
! area_group(k,1) = 1. - cld_group(k)
! area_group(k,2) = cld_group(k)
!!c-- clear
! elseif(cld_group(k).eq.0.0) then
! n_group(k) = 1
! nb(k) = 1
! area_group(k,1) = 1.
! area_group(k,2) = 0.
!!c-- overcast
! elseif(cld_group(k).eq.1.) then
! n_group(k) = 2
! nb(k) = 2
! area_group(k,1) = 0.
! area_group(k,2) = 1.
! endif
!
! enddo
!!c--- change over
!
! do 10 i = 1, nv
!!c-- add by Yu for clear
! tc_2(i,1) = tr(i) + tgm(i) + tg(i) + &
! trn(i) + tgr(i)
!
!!C-- add by Yu Gu for aerosol under clear(01/2003)
!!C
! if (naero.ge.1) then
! do iac = 1,nac
! tc_2(i,1) = tc_2(i,1) + tae(i,iac)
! enddo
! endif
!!c---------- 10/29/96 (5)
!!C --- change over
!
!!c-- change by Yu for overcast
!!c--- adjust tau according to cloud amount
! if (cldamnt(i).gt. 0.) then
!!c n_cld = (i-4)/3
! n_cld = (i-(nv1-nclouds))/nsubcld+1
! if (n_cld.gt.0) then
!!C--- determine adjust parameter
! fcloud = cldamnt(i) / cld_group(n_cld)
! if (fcloud.le.0.1) then
! if (ti(i).le.15.) then
! adj_pari = fcloud - fcloud * 0.5 * ti(i) / 15.
! else
! adj_pari = 0.5 * fcloud
! endif
! if (tw(i).le.15.) then
! adj_parw = fcloud - fcloud * 0.5 * tw(i) / 15.
! else
! adj_parw = 0.5 * fcloud
! endif
! endif
!
! if (fcloud.le.0.3.and.fcloud.gt.0.1) then
! if (ti(i).le.15.) then
! adj_pari = fcloud - fcloud * 0.33 * ti(i) / 15.
! else
! adj_pari = 0.67 * fcloud
! endif
! if (tw(i).le.15.) then
! adj_parw = fcloud - fcloud * 0.33 * tw(i) / 15.
! else
! adj_parw = 0.67 * fcloud
! endif
! endif
!
! if (fcloud.le.0.5.and.fcloud.gt.0.3) then
! if (ti(i).le.15.) then
! adj_pari = fcloud - fcloud * 0.4 * ti(i) / 15.
! else
! adj_pari = 0.6 * fcloud
! endif
! if (tw(i).le.15.) then
! adj_parw = fcloud - fcloud * 0.4 * tw(i) / 15.
! else
! adj_parw = 0.6 * fcloud
! endif
! endif
!
! if (fcloud.le.0.7.and.fcloud.gt.0.5) then
! if (ti(i).le.15.) then
! adj_pari = fcloud - fcloud * 0.286 * ti(i) / 15.
! else
! adj_pari = 0.714 * fcloud
! endif
! if (tw(i).le.15.) then
! adj_parw = fcloud - fcloud * 0.286 * tw(i) / 15.
! else
! adj_parw = 0.714 * fcloud
! endif
! endif
!
! if (fcloud.le.0.9.and.fcloud.gt.0.7) then
! if (ti(i).le.15.) then
! adj_pari = fcloud - fcloud * 0.11 * ti(i) / 15.
! else
! adj_pari = 0.89 * fcloud
! endif
! if (tw(i).le.15.) then
! adj_parw = fcloud - fcloud * 0.11 * tw(i) / 15.
! else
! adj_parw = 0.89 * fcloud
! endif
!
! endif
!
! if (fcloud.le.1..and.fcloud.gt.0.9) then
! adj_pari = fcloud
! adj_parw = fcloud
! endif
!
! if (ti(i).gt.0.) &
! ti(i) = ti(i) * adj_pari &
! * cc_inho(i)
!!c & * c_inho
!!C-- above: change by Yu: to include the inhomogeneity effect
!
!!c & ti(i) = ti(i) * cldamnt(i)
!!c & / cld_group(n_cld)
! if (tw(i).gt.0.) &
! tw(i) = tw(i) * adj_parw &
! * cc_inho(i)
!!c & * c_inho
!!C-- above: change by Yu: to include the inhomogeneity effect
!
!!c & tw(i) = tw(i) * cldamnt(i)
!!c & / cld_group(n_cld)
! endif
! endif
!!c-- adjust over
! tc_2(i,2) = ti(i) + tw(i) + tr(i) + tgm(i) + tg(i) + &
! trn(i) + tgr(i)
!
!!C-- add by Yu Gu for aerosol (01/2003)
!!C
! if (naero.ge.1) then
! do iac = 1,nac
! tc_2(i,2) = tc_2(i,2) + tae(i,iac)
! enddo
! endif
!
!!c---------- 10/29/96 (5)
!!C --- change over
!
!!c print *, 'i=',i,' tc=', tc_2(i,2)
! tis = ti(i) * wi(i)
! tws = tw(i) * ww(i)
! trns = trn(i) * wrn(i)
! tgrs = tgr(i) * wgr(i)
!!c fw1 = tr(i) + trns + tgrs
!!c fw2 = tis + tws + tr(i) + trns + tgrs
!
!!C--- add by Yu Gu (01/2003) for aerosol
!
!!c---------- 10/29/96 (6)
! if(naero.ge.1) then
! taes(0:4) = 0.0
! do iac = 1,nac
! taes(0)=taes(0)+tae(i,iac)*wae(i,iac)
! do j=1,4
! taes(j)=taes(j)+tae(i,iac)*wae(i,iac)*wwae(i,j,iac)
! enddo
! enddo
!
! fw1 = tr(i) + trns + tgrs + taes(0)
! fw2 = tis + tws + tr(i) + trns + tgrs + taes(0)
!
! else
! fw1 = tr(i) + trns + tgrs
! fw2 = tis + tws + tr(i) + trns + tgrs
! end if
!
!!c---------- 10/29/96 (6)
!
! wc_2(i,1) = fw1 / tc_2(i,1)
! wc_2(i,2) = fw2 / tc_2(i,2)
!!C-- change by Yu for overcast (add one dimension in the array)
! if ( fw2 .lt. 1.0e-20 ) then
! wc1_2(i,2) = 0.0
! wc2_2(i,2) = 0.0
! wc3_2(i,2) = 0.0
! wc4_2(i,2) = 0.0
! else
! if (naero.eq.0) then
! wc1_2(i,2) = ( tis * wwi(i,1) + tws * www(i,1) + &
! tr(i) * wwr(i,1) + trns * wwrn(i,1) + tgrs * wwgr(i,1) )/fw2
! wc2_2(i,2) = ( tis * wwi(i,2) + tws * www(i,2) + &
! tr(i) * wwr(i,2) + trns * wwrn(i,2) + tgrs * wwgr(i,2) )/fw2
! wc3_2(i,2) = ( tis * wwi(i,3) + tws * www(i,3) + &
! tr(i) * wwr(i,3) + trns * wwrn(i,3) + tgrs * wwgr(i,3) )/fw2
! wc4_2(i,2) = ( tis * wwi(i,4) + tws * www(i,4) + &
! tr(i) * wwr(i,4) + trns * wwrn(i,4) + tgrs * wwgr(i,4) )/fw2
!
!!C-- add by yu (01/2003) for aerosol
! else
! wc1_2(i,2) = ( tis * wwi(i,1) + tws * www(i,1) + &
! tr(i) * wwr(i,1) + trns * wwrn(i,1) + tgrs * wwgr(i,1) &
! +taes(1) )/fw2
! wc2_2(i,2) = ( tis * wwi(i,2) + tws * www(i,2) + &
! tr(i) * wwr(i,2) + trns * wwrn(i,2) + tgrs * wwgr(i,2) &
! +taes(2) )/fw2
! wc3_2(i,2) = ( tis * wwi(i,3) + tws * www(i,3) + &
! tr(i) * wwr(i,3) + trns * wwrn(i,3) + tgrs * wwgr(i,3) &
! +taes(3) )/fw2
! wc4_2(i,2) = ( tis * wwi(i,4) + tws * www(i,4) + &
! tr(i) * wwr(i,4) + trns * wwrn(i,4) + tgrs * wwgr(i,4) &
! +taes(4) )/fw2
! endif
! endif
!!C-- over for aerosol
!
!!C-- add by Yu for clear (add one dimension in the array)
! if ( fw1 .lt. 1.0e-20 ) then
! wc1_2(i,1) = 0.0
! wc2_2(i,1) = 0.0
! wc3_2(i,1) = 0.0
! wc4_2(i,1) = 0.0
! else
! if (naero.eq.0) then
! wc1_2(i,1) = ( &
! tr(i) * wwr(i,1) + trns * wwrn(i,1) + tgrs * wwgr(i,1) )/fw1
! wc2_2(i,1) = ( &
! tr(i) * wwr(i,2) + trns * wwrn(i,2) + tgrs * wwgr(i,2) )/fw1
! wc3_2(i,1) = ( &
! tr(i) * wwr(i,3) + trns * wwrn(i,3) + tgrs * wwgr(i,3) )/fw1
! wc4_2(i,1) = ( &
! tr(i) * wwr(i,4) + trns * wwrn(i,4) + tgrs * wwgr(i,4) )/fw1
!!C-- add by yu (01/2003) for aerosol
! else
! wc1_2(i,1) = ( &
! tr(i) * wwr(i,1) + trns * wwrn(i,1) + tgrs * wwgr(i,1) &
! +taes(1) )/fw1
! wc2_2(i,1) = ( &
! tr(i) * wwr(i,2) + trns * wwrn(i,2) + tgrs * wwgr(i,2) &
! +taes(2) )/fw1
! wc3_2(i,1) = ( &
! tr(i) * wwr(i,3) + trns * wwrn(i,3) + tgrs * wwgr(i,3) &
! +taes(3) )/fw1
! wc4_2(i,1) = ( &
! tr(i) * wwr(i,4) + trns * wwrn(i,4) + tgrs * wwgr(i,4) &
! +taes(4) )/fw1
! endif
! endif
!10 continue
!!c tt_2(1,1) = tc_2(1,1)
!!c tt_2(1,2) = tc_2(1,2)
!!c do 20 i = 2, nv
!!c tt_2(i,1) = tt_2(i-1,1) + tc_2(i,1)
!!c tt_2(i,2) = tt_2(i-1,2) + tc_2(i,2)
!!c20 continue
! return
! end subroutine
!C--- with aerosol & partly cloudy
subroutine comscp_aero_cld ( nv,nv1 & 1,2
& ,cldamnt,area_group,cld_group &
& ,n_group,nb &
& ,ti,wi,wwi,tw,ww,www &
& ,trn,wrn,wwrn,tgr,wgr,wwgr &
& ,tr,wr,wwr,tgm,tg,tae,wae,wwae &
& ,wc1,wc2,wc3,wc4,wc,tt,tc_2 &
& ,wc1_2,wc2_2,wc3_2,wc4_2,wc_2,tt_2 &
& ,cc_inho &
& )
!c *********************************************************************
!c This subroutine is used to COMbine Single-Scattering Properties due
!c to ice crystals, water droplets, and Rayleigh molecules along with
!c H2O continuum absorption and nongray gaseous absorption. See Section
!c 3.4 of Fu (1991). wc, wc1, wc2, wc3, and wc4, are total (or combined)
!c single - scattering albedo, and expansion coefficients of the
!c phase function ( 1, 2, 3, and 4 ) in nv layers. tt(nv) are the normal
!c optical depth ( from the top of the atmosphere to a given level ) for
!c level 2 - level nv1( surface ). The single-scattering properties of
!c rain and graupel are also incorporated in ( Jan. 19, 1993 ).
!c *********************************************************************
!c The single-scattering properties of aerosols are incorporated in
!c (10/29/96) based on earlier version (5/17/95).
!c *********************************************************************
!# include "para.file"
USE PARA_FILE
USE control_para
implicit none
integer :: nv, nv1
real, dimension(nv) :: cldamnt
real :: ti(nv), wi(nv), wwi(nv,4)
real :: tw(nv), ww(nv), www(nv,4)
real :: trn(nv), wrn(nv), wwrn(nv,4)
real :: tgr(nv), wgr(nv), wwgr(nv,4)
real :: tr(nv), wr(nv), wwr(nv,4)
real :: tgm(nv)
real :: tg(nv)
real :: tae(nvx,mxac), wae(nvx,mxac), wwae(nvx,4,mxac)
real, dimension(nv) :: wc1, wc2, wc3, wc4, wc, tt
real :: tc(nv), tc_2(nv,2),tis, tws, trns, tgrs, &
& taes(0:4), fw, fw1, fw2, &
& fcloud, adj_pari, adj_parw
integer :: i, iac, k, kl, n_cld, j
!--------------------------------------------------
! -- add by Yu for fractional cloud
real, dimension(nv,2) :: wc1_2, wc2_2, wc3_2, wc4_2, &
& wc_2, tt_2
real :: area_group(3,2), cld_group(3)
integer :: nb(3), n_group(3)
real, dimension(nv) :: cc_inho
! - change over
!c--- change by Yu, 02/13/02
!c-- define inhomogeneity factor
!c c_inho = 0.7
!c--- test 0.8
!c c_inho = 0.8
!c--- determine n_group(k), cld_group(k), and area_group(k,1), area_group(k,2)
!c--- hight,middle, and low three cloud groups
do k=1,ngroup
! kl = (k-1)*ngroup + nv1 - nclouds
kl = (k-1)*nsubcld + nv1 - nsubcld*ngroup
cld_group(k) = cldamnt(kl)
do i=kl+1,kl+nsubcld-1
if (cldamnt(i).gt.cld_group(k)) then
cld_group(k) = cldamnt(i)
endif
enddo
! - partly cloudy
if (cld_group(k).gt.0.0.and.cld_group(k).lt.1.) then
n_group(k) = 2
nb(k) = 1
area_group(k,1) = 1. - cld_group(k)
area_group(k,2) = cld_group(k)
! - clear
elseif(cld_group(k).eq.0.0) then
n_group(k) = 1
nb(k) = 1
area_group(k,1) = 1.
area_group(k,2) = 0.
! - overcast
elseif(cld_group(k).eq.1.) then
n_group(k) = 2
nb(k) = 2
area_group(k,1) = 0.
area_group(k,2) = 1.
endif
enddo
!c--- change over
do i = 1, nv
! - add by Yu for clear
tc_2(i,1) = tr(i) + tgm(i) + tg(i) + &
& trn(i) + tgr(i)
!--- value test
if(tc_2(i,1).lt.0.) then
write(0,*)'tau clear less then 0 at level ', i
write(0,*)'tau=', tc_2(i,1)
write(0,*)'tr=',tr(i)
write(0,*)'tgm=',tgm(i)
write(0,*)'tg=',tg(i)
write(0,*)'trn=',trn(i)
write(0,*)'tgr=',tgr(i)
endif
!--- test over
! - add by Yu Gu for aerosol for clear condition (01/2003)
!
if (naero.ge.1) then
do iac = 1,mxac
if (itps(iac).eq.1) tc_2(i,1) = tc_2(i,1) + tae(i,iac)
enddo
end if
!c---------- 10/29/96 (5)
!C --- change over
!c-- change by Yu for overcast
!c--- adjust tau according to cloud amount
adj_pari = 0.
adj_parw = 0.
if (cldamnt(i).gt. 0.) then
n_cld = (i-(nv1-nsubcld*ngroup))/nsubcld+1
if (n_cld.gt.0.and.cld_group(n_cld).ne.0) then !mchen
! -- determine adjust parameter
fcloud = cldamnt(i) / cld_group(n_cld)
if (fcloud.le.0.1) then
if (ti(i).le.15.) then
adj_pari = fcloud - fcloud * 0.5 * ti(i) / 15.
else
adj_pari = 0.5 * fcloud
endif
if (tw(i).le.15.) then
adj_parw = fcloud - fcloud * 0.5 * tw(i) / 15.
else
adj_parw = 0.5 * fcloud
endif
endif
if (fcloud.le.0.3.and.fcloud.gt.0.1) then
if (ti(i).le.15.) then
adj_pari = fcloud - fcloud * 0.33 * ti(i) / 15.
else
adj_pari = 0.67 * fcloud
endif
if (tw(i).le.15.) then
adj_parw = fcloud - fcloud * 0.33 * tw(i) / 15.
else
adj_parw = 0.67 * fcloud
endif
endif
if (fcloud.le.0.5.and.fcloud.gt.0.3) then
if (ti(i).le.15.) then
adj_pari = fcloud - fcloud * 0.4 * ti(i) / 15.
else
adj_pari = 0.6 * fcloud
endif
if (tw(i).le.15.) then
adj_parw = fcloud - fcloud * 0.4 * tw(i) / 15.
else
adj_parw = 0.6 * fcloud
endif
endif
if (fcloud.le.0.7.and.fcloud.gt.0.5) then
if (ti(i).le.15.) then
adj_pari = fcloud - fcloud * 0.286 * ti(i) / 15.
else
adj_pari = 0.714 * fcloud
endif
if (tw(i).le.15.) then
adj_parw = fcloud - fcloud * 0.286 * tw(i) / 15.
else
adj_parw = 0.714 * fcloud
endif
endif
if (fcloud.le.0.9.and.fcloud.gt.0.7) then
if (ti(i).le.15.) then
adj_pari = fcloud - fcloud * 0.11 * ti(i) / 15.
else
adj_pari = 0.89 * fcloud
endif
if (tw(i).le.15.) then
adj_parw = fcloud - fcloud * 0.11 * tw(i) / 15.
else
adj_parw = 0.89 * fcloud
endif
endif
if (fcloud.le.1..and.fcloud.gt.0.9) then
adj_pari = fcloud
adj_parw = fcloud
endif
if (ti(i).gt.0.) &
& ti(i) = ti(i) * adj_pari &
& * cc_inho(i)
!c & * c_inho
!C-- above: change by Yu: to include the inhomogeneity effect
!c & ti(i) = ti(i) * cldamnt(i)
!c & / cld_group(n_cld)
if (tw(i).gt.0.) &
& tw(i) = tw(i) * adj_parw &
& * cc_inho(i)
!c & * c_inho
!C-- above: change by Yu: to include the inhomogeneity effect
!c & tw(i) = tw(i) * cldamnt(i)
!c & / cld_group(n_cld)
endif
endif
!c-- adjust over
tc_2(i,2) = ti(i) + tw(i) + tr(i) + tgm(i) + tg(i) + &
& trn(i) + tgr(i)
! --- test value
if(tc_2(i,2).lt.0.) then
write(0,*)'tau cloudy less then 0 at level ', i
write(0,*)'tau=', tc_2(i,2)
write(0,*)'ti=',ti(i)
write(0,*)'tw=',tw(i)
write(0,*)'tr=',tr(i)
write(0,*)'tgm=',tgm(i)
write(0,*)'tg=',tg(i)
write(0,*)'trn=',trn(i)
write(0,*)'tgr=',tgr(i)
endif
!--- test over
!C-- add by Yu Gu for aerosol (01/2003)
!C
if (naero.ge.1) then
do iac = 1,mxac
if (itps(iac).eq.1) tc_2(i,2) = tc_2(i,2) + tae(i,iac)
enddo
endif
!c---------- 10/29/96 (5)
!C --- change over
!c print *, 'i=',i,' tc=', tc_2(i,2)
tis = ti(i) * wi(i)
tws = tw(i) * ww(i)
trns = trn(i) * wrn(i)
tgrs = tgr(i) * wgr(i)
!c fw1 = tr(i) + trns + tgrs
!c fw2 = tis + tws + tr(i) + trns + tgrs
!C--- add by Yu Gu (01/2003) for aerosol
!c---------- 10/29/96 (6)
if (naero.ge.1) then
taes(0:4) = 0.0
do iac = 1,mxac
if (itps(iac).eq.1) then
taes(0)=taes(0)+tae(i,iac)*wae(i,iac)
do j=1,4
taes(j)=taes(j)+tae(i,iac)*wae(i,iac)*wwae(i,j,iac)
enddo
end if
enddo
fw1 = tr(i) + trns + tgrs + taes(0)
fw2 = tis + tws + tr(i) + trns + tgrs + taes(0)
else
! -- no aerosol
fw1 = tr(i) + trns + tgrs
fw2 = tis + tws + tr(i) + trns + tgrs
end if
!c---------- 10/29/96 (6)
wc_2(i,1) = fw1 / tc_2(i,1)
wc_2(i,2) = fw2 / tc_2(i,2)
!C-- change by Yu for overcast (add one dimension in the array)
if ( fw2 .lt. 1.0e-20 ) then
wc1_2(i,2) = 0.0
wc2_2(i,2) = 0.0
wc3_2(i,2) = 0.0
wc4_2(i,2) = 0.0
else
if (naero.eq.0) then
wc1_2(i,2) = ( tis * wwi(i,1) + tws * www(i,1) + &
& tr(i) * wwr(i,1) + trns * wwrn(i,1) + tgrs * wwgr(i,1) )/fw2
wc2_2(i,2) = ( tis * wwi(i,2) + tws * www(i,2) + &
& tr(i) * wwr(i,2) + trns * wwrn(i,2) + tgrs * wwgr(i,2) )/fw2
wc3_2(i,2) = ( tis * wwi(i,3) + tws * www(i,3) + &
& tr(i) * wwr(i,3) + trns * wwrn(i,3) + tgrs * wwgr(i,3) )/fw2
wc4_2(i,2) = ( tis * wwi(i,4) + tws * www(i,4) + &
& tr(i) * wwr(i,4) + trns * wwrn(i,4) + tgrs * wwgr(i,4) )/fw2
else
! - add by yu (01/2003) for aerosol
wc1_2(i,2) = ( tis * wwi(i,1) + tws * www(i,1) + &
& tr(i) * wwr(i,1) + trns * wwrn(i,1) + tgrs * wwgr(i,1) &
& + taes(1) )/fw2
wc2_2(i,2) = ( tis * wwi(i,2) + tws * www(i,2) + &
& tr(i) * wwr(i,2) + trns * wwrn(i,2) + tgrs * wwgr(i,2) &
& + taes(2) )/fw2
wc3_2(i,2) = ( tis * wwi(i,3) + tws * www(i,3) + &
& tr(i) * wwr(i,3) + trns * wwrn(i,3) + tgrs * wwgr(i,3) &
& + taes(3) )/fw2
wc4_2(i,2) = ( tis * wwi(i,4) + tws * www(i,4) + &
& tr(i) * wwr(i,4) + trns * wwrn(i,4) + tgrs * wwgr(i,4) &
& + taes(4) )/fw2
endif
! - over for aerosol
endif
!C-- add by Yu for clear (add one dimension in the array)
if ( fw1 .lt. 1.0e-20 ) then
wc1_2(i,1) = 0.0
wc2_2(i,1) = 0.0
wc3_2(i,1) = 0.0
wc4_2(i,1) = 0.0
else
if (naero.eq.0) then
wc1_2(i,1) = ( &
& tr(i) * wwr(i,1) + trns * wwrn(i,1) + tgrs * wwgr(i,1) )/fw1
wc2_2(i,1) = ( &
& tr(i) * wwr(i,2) + trns * wwrn(i,2) + tgrs * wwgr(i,2) )/fw1
wc3_2(i,1) = ( &
& tr(i) * wwr(i,3) + trns * wwrn(i,3) + tgrs * wwgr(i,3) )/fw1
wc4_2(i,1) = ( &
& tr(i) * wwr(i,4) + trns * wwrn(i,4) + tgrs * wwgr(i,4) )/fw1
!C-- add by yu (01/2003) for aerosol
else
wc1_2(i,1) = ( &
& tr(i) * wwr(i,1) + trns * wwrn(i,1) + tgrs * wwgr(i,1) &
& + taes(1) )/fw1
wc2_2(i,1) = ( &
& tr(i) * wwr(i,2) + trns * wwrn(i,2) + tgrs * wwgr(i,2) &
& + taes(2) )/fw1
wc3_2(i,1) = ( &
& tr(i) * wwr(i,3) + trns * wwrn(i,3) + tgrs * wwgr(i,3) &
& + taes(3) )/fw1
wc4_2(i,1) = ( &
& tr(i) * wwr(i,4) + trns * wwrn(i,4) + tgrs * wwgr(i,4) &
& + taes(4) )/fw1
endif
endif
10 end do
!c tt_2(1,1) = tc_2(1,1)
!c tt_2(1,2) = tc_2(1,2)
!c do 20 i = 2, nv
!c tt_2(i,1) = tt_2(i-1,1) + tc_2(i,1)
!c tt_2(i,2) = tt_2(i-1,2) + tc_2(i,2)
!c20 continue
return
end subroutine
! subroutine comscp_new(icur,jcur)
!!c *********************************************************************
!!c This subroutine is used to COMbine Single-Scattering Properties due
!!c to ice crystals, water droplets, and Rayleigh molecules along with
!!c H2O continuum absorption and nongray gaseous absorption. See Section
!!c 3.4 of Fu (1991). wc, wc1, wc2, wc3, and wc4, are total (or combined)
!!c single - scattering albedo, and expansion coefficients of the
!!c phase function ( 1, 2, 3, and 4 ) in nv layers. tt(nv) are the normal
!!c optical depth ( from the top of the atmosphere to a given level ) for
!!c level 2 - level nv1( surface ). The single-scattering properties of
!!c rain and graupel(or aerosol) are also incorporated in ( Jan. 19, 1993 ).
!!c *********************************************************************
!!# include "para.file"
! USE PARA_FILE
! common /ic/ ti(nv), wi(nv), wwi(nv,4)
! common /wat/ tw(nv), ww(nv), www(nv,4)
! common /rai/ trn(nv), wrn(nv), wwrn(nv,4)
! common /gra/ tgr(nv), wgr(nv), wwgr(nv,4)
! common /ray/ tr(nv), wr(nv), wwr(nv,4)
! common /con/ tgm(nv)
! common /gas/ tg(nv)
!!C--- add by Yu for fractional cloud
! common /dfsin_2/ wc1_2(nv,2), wc2_2(nv,2), wc3_2(nv,2), &
! wc4_2(nv,2), &
! wc_2(nv,2), tt_2(nv,2)
! common /delta_tao/ tc_2(nv,2)
!!c-- change over
! common /dfsin/ wc1(nv), wc2(nv), wc3(nv), wc4(nv), &
! wc(nv), tt(nv)
!!C--- change by Yu, 02/13/02
!!c common /cld_a/cldamnt(nv), area_h(2), area_m(2), area_l(2)
!!c common /cld_c/n_h, n_m, n_l, cld_h, cld_m, cld_l
! common /cld_a/cldamnt(nv), area_group(3,2)
! common /cld_inho/cc_inho(nv)
! common /cld_c/n_group(3), cld_group(3)
! common /cld_loop/ nb(3)
!!c-- change over
! dimension tc(nv)
!
!!c--- change by Yu, 02/13/02
!
!!c-- define inhomogeneity factor
!!c c_inho = 0.7
!!c--- test 0.8
!!c c_inho = 0.8
!!c--- determine n_group(k), cld_group(k), and area_group(k,1), area_group(k,2)
!!c--- hight,middle, and low three cloud groups
!!c do k=1,3
! do k=1,ngroup
!!c kl = (k-1)*3 + 7
! kl = (k-1)*nsubcld + nv1-nclouds
! cld_group(k) = cldamnt(kl)
!!c do i=kl+1,kl+2
! do i=kl+1,kl+nsubcld-1
! if (cldamnt(i).gt.cld_group(k)) then
! cld_group(k) = cldamnt(i)
! endif
! enddo
!!c-- partly cloudy
! if (cld_group(k).gt.0.0.and.cld_group(k).lt.1.) then
! n_group(k) = 2
! nb(k) = 1
! area_group(k,1) = 1. - cld_group(k)
! area_group(k,2) = cld_group(k)
!!c-- clear
! elseif(cld_group(k).eq.0.0) then
! n_group(k) = 1
! nb(k) = 1
! area_group(k,1) = 1.
! area_group(k,2) = 0.
!!c-- overcast
! elseif(cld_group(k).eq.1.) then
! n_group(k) = 2
! nb(k) = 2
! area_group(k,1) = 0.
! area_group(k,2) = 1.
! endif
!
! enddo
!!c--- change over
!
! do 10 i = 1, nv
!!c-- add by Yu for clear
! tc_2(i,1) = tr(i) + tgm(i) + tg(i) + &
! trn(i) + tgr(i)
!!c-- change by Yu for overcast
!!c--- adjust tau according to cloud amount
! if (cldamnt(i).gt. 0.) then
!!c n_cld = (i-4)/3
! n_cld = (i-(nv1-nclouds))/nsubcld+1
! if (n_cld.gt.0) then
!!C--- determine adjust parameter
! fcloud = cldamnt(i) / cld_group(n_cld)
! if (fcloud.le.0.1) then
! if (ti(i).le.15.) then
! adj_pari = fcloud-fcloud*0.5*ti(i)/15.
! else
! adj_pari = 0.5 * fcloud
! endif
! if (tw(i).le.15.) then
! adj_parw = fcloud-fcloud*0.5*tw(i)/15.
! else
! adj_parw = 0.5 * fcloud
! endif
! endif
!
! if (fcloud.le.0.3.and.fcloud.gt.0.1) then
! if (ti(i).le.15.) then
! adj_pari = fcloud-fcloud*0.33*ti(i)/15.
! else
! adj_pari = 0.67 * fcloud
! endif
! if (tw(i).le.15.) then
! adj_parw = fcloud-fcloud*0.33*tw(i)/15.
! else
! adj_parw = 0.67 * fcloud
! endif
! endif
!
! if (fcloud.le.0.5.and.fcloud.gt.0.3) then
! if (ti(i).le.15.) then
! adj_pari = fcloud-fcloud*0.4*ti(i)/15.
! else
! adj_pari = 0.6 * fcloud
! endif
! if (tw(i).le.15.) then
! adj_parw = fcloud-fcloud*0.4*tw(i)/15.
! else
! adj_parw = 0.6 * fcloud
! endif
! endif
!
! if (fcloud.le.0.7.and.fcloud.gt.0.5) then
! if (ti(i).le.15.) then
! adj_pari = fcloud-fcloud*0.286*ti(i)/15.
! else
! adj_pari = 0.714 * fcloud
! endif
! if (tw(i).le.15.) then
! adj_parw = fcloud-fcloud*0.286*tw(i)/15.
! else
! adj_parw = 0.714 * fcloud
! endif
! endif
!
! if (fcloud.le.0.9.and.fcloud.gt.0.7) then
! if (ti(i).le.15.) then
! adj_pari = fcloud-fcloud*0.11*ti(i)/15.
! else
! adj_pari = 0.89 * fcloud
! endif
! if (tw(i).le.15.) then
! adj_parw = fcloud-fcloud*0.11*tw(i)/15.
! else
! adj_parw = 0.89 * fcloud
! endif
! endif
!
! if (fcloud.le.1..and.fcloud.gt.0.9) then
! adj_pari = fcloud
! adj_parw = fcloud
! endif
!
! if (ti(i).gt.0.) &
! ti(i) = ti(i) * adj_pari &
! * cc_inho(i)
!!c & * c_inho
!!C-- above: change by Yu: to include the inhomogeneity effect
!!c & ti(i) = ti(i) * cldamnt(i)
!!c & / cld_group(n_cld)
! if (tw(i).gt.0.) &
! tw(i) = tw(i) * adj_parw &
! * cc_inho(i)
!!c & * c_inho
!!C-- above: change by Yu: to include the inhomogeneity effect
!!c & tw(i) = tw(i) * cldamnt(i)
!!c & / cld_group(n_cld)
! endif
! endif
!
!!c-- adjust over
!!C
! tc_2(i,2) = ti(i) + tw(i) + &
! tr(i) + tgm(i) + tg(i) + &
! trn(i) + tgr(i)
! tis = ti(i) * wi(i)
! tws = tw(i) * ww(i)
! trns = trn(i) * wrn(i)
! tgrs = tgr(i) * wgr(i)
! fw1 = tr(i) + trns + tgrs
! fw2 = tis + tws + tr(i) + trns + tgrs
! wc_2(i,1) = fw1 / tc_2(i,1)
! wc_2(i,2) = fw2 / tc_2(i,2)
!!C-- change by Yu for overcast (add one dimension in the array)
! if ( fw2 .lt. 1.0e-20 ) then
! wc1_2(i,2) = 0.0
! wc2_2(i,2) = 0.0
! wc3_2(i,2) = 0.0
! wc4_2(i,2) = 0.0
! else
! wc1_2(i,2) = ( tis * wwi(i,1) + tws * www(i,1) + &
! tr(i) * wwr(i,1) + trns * wwrn(i,1) + &
! tgrs * wwgr(i,1) )/fw2
! wc2_2(i,2) = ( tis * wwi(i,2) + tws * www(i,2) + &
! tr(i) * wwr(i,2) + trns * wwrn(i,2) + &
! tgrs * wwgr(i,2) )/fw2
! wc3_2(i,2) = ( tis * wwi(i,3) + tws * www(i,3) + &
! tr(i) * wwr(i,3) + trns * wwrn(i,3) + &
! tgrs * wwgr(i,3) )/fw2
! wc4_2(i,2) = ( tis * wwi(i,4) + tws * www(i,4) + &
! tr(i) * wwr(i,4) + trns * wwrn(i,4) + &
! tgrs * wwgr(i,4) )/fw2
! endif
!!C-- add by Yu for clear (add one dimension in the array)
! if ( fw1 .lt. 1.0e-20 ) then
! wc1_2(i,1) = 0.0
! wc2_2(i,1) = 0.0
! wc3_2(i,1) = 0.0
! wc4_2(i,1) = 0.0
! else
! wc1_2(i,1) = ( &
! tr(i) * wwr(i,1) + trns * wwrn(i,1) + &
! tgrs * wwgr(i,1) )/fw1
! wc2_2(i,1) = ( &
! tr(i) * wwr(i,2) + trns * wwrn(i,2) + &
! tgrs * wwgr(i,2) )/fw1
! wc3_2(i,1) = (&
! tr(i) * wwr(i,3) + trns * wwrn(i,3) + &
! tgrs * wwgr(i,3) )/fw1
! wc4_2(i,1) = (&
! tr(i) * wwr(i,4) + trns * wwrn(i,4) + &
! tgrs * wwgr(i,4) )/fw1
! endif
!10 continue
!!c tt_2(1,1) = tc_2(1,1)
!!c tt_2(1,2) = tc_2(1,2)
!!c do 20 i = 2, nv
!!c tt_2(i,1) = tt_2(i-1,1) + tc_2(i,1)
!!c tt_2(i,2) = tt_2(i-1,2) + tc_2(i,2)
!!c20 continue
! return
! end subroutine
! subroutine comscp
!!c *********************************************************************
!!c This subroutine is used to COMbine Single-Scattering Properties due
!!c to ice crystals, water droplets, and Rayleigh molecules along with
!!c H2O continuum absorption and nongray gaseous absorption. See Section
!!c 3.4 of Fu (1991). wc, wc1, wc2, wc3, and wc4, are total (or combined)
!!c single - scattering albedo, and expansion coefficients of the
!!c phase function ( 1, 2, 3, and 4 ) in nv layers. tt(nv) are the normal
!!c optical depth ( from the top of the atmosphere to a given level ) for
!!c level 2 - level nv1( surface ). The single-scattering properties of
!!c rain and graupel are also incorporated in ( Jan. 19, 1993 ).
!!c *********************************************************************
!!# include "para.file"
! USE PARA_FILE
! common /ic/ ti(nv), wi(nv), wwi(nv,4)
! common /wat/ tw(nv), ww(nv), www(nv,4)
! common /rai/ trn(nv), wrn(nv), wwrn(nv,4)
! common /gra/ tgr(nv), wgr(nv), wwgr(nv,4)
! common /ray/ tr(nv), wr(nv), wwr(nv,4)
! common /con/ tgm(nv)
! common /gas/ tg(nv)
! common /dfsin/ wc1(nv), wc2(nv), wc3(nv), wc4(nv), &
! wc(nv), tt(nv)
! dimension tc(nv)
! do 10 i = 1, nv
! tc(i) = ti(i) + tw(i) + tr(i) + tgm(i) + tg(i) + &
! trn(i) + tgr(i)
! tis = ti(i) * wi(i)
! tws = tw(i) * ww(i)
! trns = trn(i) * wrn(i)
! tgrs = tgr(i) * wgr(i)
! fw = tis + tws + tr(i) + trns + tgrs
! wc(i) = fw / tc(i)
! if ( fw .lt. 1.0e-20 ) then
! wc1(i) = 0.0
! wc2(i) = 0.0
! wc3(i) = 0.0
! wc4(i) = 0.0
! else
! wc1(i) = ( tis * wwi(i,1) + tws * www(i,1) + &
! tr(i) * wwr(i,1) + trns * wwrn(i,1) + tgrs * wwgr(i,1) )/fw
! wc2(i) = ( tis * wwi(i,2) + tws * www(i,2) + &
! tr(i) * wwr(i,2) + trns * wwrn(i,2) + tgrs * wwgr(i,2) )/fw
! wc3(i) = ( tis * wwi(i,3) + tws * www(i,3) + &
! tr(i) * wwr(i,3) + trns * wwrn(i,3) + tgrs * wwgr(i,3) )/fw
! wc4(i) = ( tis * wwi(i,4) + tws * www(i,4) + &
! tr(i) * wwr(i,4) + trns * wwrn(i,4) + tgrs * wwgr(i,4) )/fw
! endif
!10 continue
! tt(1) = tc(1)
! do 20 i = 2, nv
! tt(i) = tt(i-1) + tc(i)
!20 continue
! return
! end subroutine
!c function planck1 ( t, w )
!c **********************************************************************
!c t is the temperature (K), w is the wavenumber (cm-1), and planck1 is
!c the blackbody intensity function (W/m**2/Sr/cm-1). See Eq. (2.8) of
!c Fu (1991).
!c **********************************************************************
!c a = 1.19107e-8
!c b = 1.43884
!c planck1 = a * w * w * w / ( exp ( b * w / t ) - 1.0 )
!c return
!c end
!c function bt ( t, ve, nd )
!c **********************************************************************
!c bt (W/m**2/Sr) is the blackbody intensity function integrated over a
!c given band, which has a band width of nd*10 (cm-1) from the ve (cm-1).
!c **********************************************************************
!c v1 = ve
!c bt = 0.0
!c do 10 j = 1, nd
!c v2 = v1 - 10.0
!c w = ( v1 + v2 ) * 0.5
!c x = planck1 ( t, w )
!c bt = bt + x
!c v1 = v2
!c10 continue
!c bt = bt * 10.0
!c return
!c end
subroutine planck ( nv,nv1,ib,pts,pp,pt,ph,po,bf,bs ) 1,1
!c **********************************************************************
!c bf and bs are the blackbody intensity function integrated over the
!c band ib at the nv1 levels and at the surface, respectively. The
!c units of bf and bs are W/m**2/Sr. nd*10 is the band width from ve.
!c **********************************************************************
!# include "para.file"
USE PARA_FILE
implicit none
integer :: nv, nv1
real, dimension(nv1) :: pp, pt, ph, po
real :: bf(nv1), bs, pts
real :: ve(mbir), bt(nv1)
integer :: nd(mbir)
integer :: ib, i, j, nv11, ibr
real :: v1, v2, w, fq1, fq2, bts, x
data ve / 2200.0, 1900.0, 1700.0, 1400.0, 1250.0, 1100.0, &
& 980.0, 800.0, 670.0, 540.0, 400.0, 280.001 /
data nd / 30, 20, 30, 15, 15, 12, &
& 18, 13, 13, 14, 12, 28 /
nv11 = nv1 + 1
ibr = ib - mbs
bts = 0.0
do i = 1, nv1
bt(i) = 0.0
end do
v1 = ve(ibr)
do j = 1, nd(ibr)
v2 = v1 - 10.0
w = ( v1 + v2 ) * 0.5
fq1 = 1.19107e-8 * w * w * w
fq2 = 1.43884 * w
do i = 1, nv11
if ( i .eq. nv11 ) then
x = fq1 / ( exp ( fq2 / pts ) - 1.0 )
bts = bts + x
else
x = fq1 / ( exp ( fq2 / pt(i) ) - 1.0 )
bt(i) = bt(i) + x
endif
end do
v1 = v2
end do
do i = 1, nv1
bf(i) = bt(i) * 10.0
end do
bs = bts * 10.0
return
end subroutine
!c **********************************************************************
!c coefficient calculations for four first-order differential equations.
!c **********************************************************************
subroutine coeff1 ( ib,w,w1,w2,w3,t0,t1,u0,f0,b ) 1,2
!# include "para.file"
USE PARA_FILE
USE numericals
! common /dis/ a(4)
! common /point/ u(4)
! common /legen/ p0d(4), p1d(4), p2d(4), p3d(4)
! common /legen1/ p11d(4,4), p22d(4,4), p33d(4,4)
! common /coedfi/ ib, w, w1, w2, w3, t0, t1, u0, f0
! common /coedf1/ b(4,3)
implicit none
integer, intent(in) :: ib
real, intent(in) :: w, w1, w2, w3, t0, t1, u0, f0
real, intent(out) :: b(4,3)
integer :: i, j
real :: x, w0w, w1w, w2w, w3w, fw, q1, q2, q3, fq, c(4,5)
x = 0.5 * w
w0w = x
w1w = x * w1
w2w = x * w2
w3w = x * w3
if ( ib .le. mbs ) then
fw = u0 * u0
q1 = - w1w * u0
q2 = w2w * ( 1.5 * fw - 0.5 )
q3 = - w3w * ( 2.5 * fw - 1.5 ) * u0
endif
fq = 0.5 * w0w
do i = 3, 4
do j = 1, 4
c(i,j) = fq + w1w * p11d(i,j) + &
& w2w * p22d(i,j) + w3w * p33d(i,j)
if ( i .eq. j ) then
c(i,j) = ( c(i,j) - 1.0 ) / u(i)
else
c(i,j) = c(i,j) / u(i)
endif
20 end do
10 end do
do i = 1, 4
if ( ib .le. mbs ) then
c(i,5) = w0w + q1 * p1d(i) + &
& q2 * p2d(i) + q3 * p3d(i)
else
c(i,5) = 1.0
endif
c(i,5) = c(i,5) / u(i)
30 end do
b(1,1) = c(4,4) - c(4,1)
b(1,2) = c(4,4) + c(4,1)
b(2,1) = c(4,3) - c(4,2)
b(2,2) = c(4,3) + c(4,2)
b(3,1) = c(3,4) - c(3,1)
b(3,2) = c(3,4) + c(3,1)
b(4,1) = c(3,3) - c(3,2)
b(4,2) = c(3,3) + c(3,2)
b(1,3) = c(4,5) - c(1,5)
b(2,3) = c(3,5) - c(2,5)
b(3,3) = c(3,5) + c(2,5)
b(4,3) = c(4,5) + c(1,5)
return
end subroutine
!c **********************************************************************
!c coefficient calculations for second order differential equations.
!c **********************************************************************
subroutine coeff2 ( u0,b,a,d ) 1
implicit none
real, intent(in) :: u0
real, intent(in) :: b(4,3)
real, intent(out) :: a(2,2,2), d(4)
real :: fw1, fw2, fw3, fw4
fw1 = b(1,1) * b(1,2)
fw2 = b(2,1) * b(3,2)
fw3 = b(3,1) * b(2,2)
fw4 = b(4,1) * b(4,2)
a(2,2,1) = fw1 + fw2
a(2,1,1) = b(1,1) * b(2,2) + b(2,1) * b(4,2)
a(1,2,1) = b(3,1) * b(1,2) + b(4,1) * b(3,2)
a(1,1,1) = fw3 + fw4
a(2,2,2) = fw1 + fw3
a(2,1,2) = b(1,2) * b(2,1) + b(2,2) * b(4,1)
a(1,2,2) = b(3,2) * b(1,1) + b(4,2) * b(3,1)
a(1,1,2) = fw2 + fw4
d(1) = b(3,2) * b(4,3) + b(4,2) * b(3,3) + b(2,3) / u0
d(2) = b(1,2) * b(4,3) + b(2,2) * b(3,3) + b(1,3) / u0
d(3) = b(3,1) * b(1,3) + b(4,1) * b(2,3) + b(3,3) / u0
d(4) = b(1,1) * b(1,3) + b(2,1) * b(2,3) + b(4,3) / u0
return
end subroutine
!c **********************************************************************
!c coefficient calculations for fourth-order differential equations.
!c **********************************************************************
subroutine coeff4 ( u0,a,d,z,b1,c1 ) 1
! common /coedfi/ ib, w, w1, w2, w3, t0, t1, u0, f0
! common /coedf2/ a(2,2,2), d(4)
! common /coedf4/ b1, c1, z(4)
implicit none
real, intent(in) :: u0
real, intent(in) :: a(2,2,2), d(4)
real, intent(out) :: z(4), b1, c1
real :: x
x = u0 * u0
b1 = a(2,2,1) + a(1,1,1)
c1 = a(2,1,1) * a(1,2,1) - a(1,1,1) * a(2,2,1)
z(1) = a(2,1,1) * d(3) + d(4) / x - a(1,1,1) * d(4)
z(2) = a(1,2,1) * d(4) - a(2,2,1) *d(3) + d(3) / x
z(3) = a(2,1,2) * d(1) + d(2) / x - a(1,1,2) * d(2)
z(4) = a(1,2,2) * d(2) - a(2,2,2) * d(1) + d(1) / x
return
end subroutine
!c **********************************************************************
!c fk1 and fk2 are the eigenvalues.
!c **********************************************************************
subroutine coeffl ( ib,t0,t1,u0,f0,b,a,d,z,b1,c1, & 1,1
& aa,zz,a1,z1,fk1,fk2 )
!# include "para.file"
USE PARA_FILE
! common /coedfi/ ib, w, w1, w2, w3, t0, t1, u0, f0
! common /coedf1/ b(4,3)
! common /coedf2/ a(2,2,2), d(4)
! common /coedf4/ b1, c1, z(4)
! common /coedfl/ aa(4,4,2), zz(4,2), a1(4,4), z1(4), fk1, fk2
implicit none
integer, intent(in) :: ib
real, intent(in) :: t0, t1, u0, f0
real, intent(in) :: b(4,3)
real, intent(in) :: a(2,2,2), d(4)
real, intent(inout) :: z(4), b1, c1
real, intent(out) :: aa(4,4,2), zz(4,2), a1(4,4), z1(4), &
& fk1, fk2
integer :: i
real :: dt, x, y, fw, fw1, fw2, a2, b2, zx, fq0, fq1
dt = t1 - t0
x = sqrt ( b1 * b1 + 4.0 * c1 )
fk1 = sqrt ( ( b1 + x ) * 0.5 )
fk2 = sqrt ( ( b1 - x ) * 0.5 )
fw = u0 * u0
x = 1.0 / ( fw * fw ) - b1 / fw - c1
! --------- 4/2/97 (4)
if (abs (x) .lt. 1.0E-16) THEN
if ( x .lt. 0.0) THEN
x = -1.0E-6
else
x = 1.0E-6
end if
end if
! --------- 4/2/97 (4)
fw = 0.5 * f0 / x
z(1) = fw * z(1)
z(2) = fw * z(2)
z(3) = fw * z(3)
z(4) = fw * z(4)
z1(1) = 0.5 * ( z(1) + z(3) )
z1(2) = 0.5 * ( z(2) + z(4) )
z1(3) = 0.5 * ( z(2) - z(4) )
z1(4) = 0.5 * ( z(1) - z(3) )
a2 = ( fk1 * fk1 - a(2,2,1) ) / a(2,1,1)
b2 = ( fk2 * fk2 - a(2,2,1) ) / a(2,1,1)
x = b(1,1) * b(4,1) - b(3,1) * b(2,1)
fw1 = fk1 / x
fw2 = fk2 / x
y = fw2 * ( b2 * b(2,1) - b(4,1) )
zx = fw1 * ( a2 * b(2,1) - b(4,1) )
a1(1,1) = 0.5 * ( 1 - y )
a1(1,2) = 0.5 * ( 1 - zx )
a1(1,3) = 0.5 * ( 1 + zx )
a1(1,4) = 0.5 * ( 1 + y )
y = fw2 * ( b(3,1) - b2 * b(1,1) )
zx = fw1 * ( b(3,1) - a2 * b(1,1) )
a1(2,1) = 0.5 * ( b2 - y )
a1(2,2) = 0.5 * ( a2 - zx )
a1(2,3) = 0.5 * ( a2 + zx )
a1(2,4) = 0.5 * ( b2 + y )
a1(3,1) = a1(2,4)
a1(3,2) = a1(2,3)
a1(3,3) = a1(2,2)
a1(3,4) = a1(2,1)
a1(4,1) = a1(1,4)
a1(4,2) = a1(1,3)
a1(4,3) = a1(1,2)
a1(4,4) = a1(1,1)
if ( ib .le. mbs ) then
fq0 = exp ( - t0 / u0 )
fq1 = exp ( - t1 / u0 )
else
fq0 = 1.0
fq1 = exp ( - dt / u0 )
endif
x = exp ( - fk1 * dt )
y = exp ( - fk2 * dt )
do i = 1, 4
zz(i,1) = z1(i) * fq0
zz(i,2) = z1(i) * fq1
aa(i,1,1) = a1(i,1)
aa(i,2,1) = a1(i,2)
aa(i,3,1) = a1(i,3) * x
aa(i,4,1) = a1(i,4) * y
aa(i,3,2) = a1(i,3)
aa(i,4,2) = a1(i,4)
aa(i,1,2) = a1(i,1) * y
aa(i,2,2) = a1(i,2) * x
40 end do
return
end subroutine
!c **********************************************************************
!c See the paper by Liou, Fu and Ackerman (1988) for the formulation of
!c the delta-four-stream approximation in a homogeneous layer.
!c **********************************************************************
subroutine coefft ( ib,w,w1,w2,w3,t0,t1,u0,f0, & 2,4
& b,a,d,z,b1,c1,aa,zz,a1,z1,fk1,fk2 )
implicit none
integer, intent(in) :: ib
real, intent(in) :: w, w1, w2, w3, t0, t1, u0, f0
real :: b(4,3), a(2,2,2), d(4), &
& z(4), b1, c1, &
& aa(4,4,2), zz(4,2), a1(4,4), z1(4), &
& fk1, fk2
call coeff1 ( ib,w,w1,w2,w3,t0,t1,u0,f0,b )
call coeff2 ( u0,b,a,d )
call coeff4 ( u0,a,d,z,b1,c1 )
call coeffl ( ib,t0,t1,u0,f0,b,a,d,z,b1,c1, &
& aa,zz,a1,z1,fk1,fk2 )
return
end subroutine
!c **********************************************************************
!c In the limits of no scattering ( Fu, 1991 ), fk1 = 1.0 / u(3) and
!c fk2 = 1.0 / u(4).
!c **********************************************************************
subroutine coefft0 ( ib,w,w1,w2,w3,t0,t1,u0,f0, & 2,2
& aa,zz,a1,z1,fk1,fk2 )
!# include "para.file"
USE PARA_FILE
use numericals
implicit none
integer, intent(in) :: ib
real, intent(in) :: w, w1, w2, w3, t0, t1, u0, f0
real, intent(out) :: aa(4,4,2), zz(4,2), a1(4,4), z1(4), &
& fk1, fk2
integer :: i, jj, j, k
real :: x, y, fw, temp, dt
fk1 = 4.7320545
fk2 = 1.2679491
y = exp ( - ( t1 - t0 ) / u0 )
fw = 0.5 * f0
do i = 1, 4
if ( ib .le. mbs ) then
z1(i) = 0.0
zz(i,1) = 0.0
zz(i,2) = 0.0
else
jj = 5 - i
! - change by Yu Gu, 11/19/01
temp = u(jj)/u0
! if (temp.eq.-1.) temp = -1.001
if (temp.eq.-1.) temp = -0.9999
z1(i) = fw / ( 1.0 + temp )
! z1(i) = fw / ( 1.0 + u(jj) / u0 )
! -- change over
zz(i,1) = z1(i)
zz(i,2) = z1(i) * y
endif
do j = 1, 4
a1(i,j) = 0.0
do k = 1, 2
aa(i,j,k) = 0.0
12 end do
11 end do
10 end do
do i = 1, 4
j = 5 - i
a1(i,j) = 1.0
20 end do
dt = t1 - t0
x = exp ( - fk1 * dt )
y = exp ( - fk2 * dt )
aa(1,4,1) = y
aa(2,3,1) = x
aa(3,2,1) = 1.0
aa(4,1,1) = 1.0
aa(1,4,2) = 1.0
aa(2,3,2) = 1.0
aa(3,2,2) = x
aa(4,1,2) = y
return
end subroutine
!c **********************************************************************
!c In the solar band asbs is the surface albedo, while in the infrared
!c band asbs is blackbody intensity emitted at the surface temperature
!c times surface emissivity. In this subroutine, the delta-four-stream
!c is applied to nonhomogeneous atmospheres. See comments in subroutine
!c 'qcfel' for array AB(13,4*n).
!c **********************************************************************
subroutine qcfe ( nv,nv1,ib,asbs,ee,w1,w2,w3,w,t,u0,f0, & 2,6
& fk1,fk2,a4,z4,g4 )
!# include "para.file"
USE PARA_FILE
implicit none
integer :: nv, nv1
integer, intent(in) :: ib
real, intent(in) :: asbs, ee
real, intent(in), dimension(nv) :: w1, w2, w3, w, t, u0, f0
real, intent(out) :: fk1(nv), fk2(nv), a4(4,4,nv), &
& z4(4,nv), g4(4,nv)
real :: b(4,3), a(2,2,2), d(4), z(4), b1, c1, &
& aa(4,4,2), zz(4,2), a1(4,4), z1(4), fk1t, fk2t
real :: ab(13,nv * 4), bx(nv * 4), xx(nv * 4)
integer :: n, n4, i, j, k, ibn, i8, kf, i1, i2, i3, j1, j2, j3, &
& m1, m2, m18, m28
real :: wn, w1n, w2n, w3n, t0n, t1n, u0n, f0n
real :: fu(4,4), wu(4)
real :: v1, v2, v3, fw1, fw2
! common /dis/ a(4)
! common /point/ u(4)
! common /qccfei/ w1(nv), w2(nv), w3(nv), w(nv), &
! t(nv), u0(nv), f0(nv)
! common /coedfi/ ibn, wn, w1n, w2n, w3n, t0n, t1n, u0n, f0n
! common /coedfl/ aa(4,4,2), zz(4,2), a1(4,4), z1(4), &
! fk1t, fk2t
! common /qccfeo/ fk1(nv), fk2(nv), a4(4,4,nv), &
! z4(4,nv), g4(4,nv)
! common /qcfelc/ ab(13,nv * 4), bx(nv * 4), xx(nv * 4)
! dimension fu(4,4), wu(4)
n = nv
n4 = nv * 4
do i = 1, n4
do j = 1, 13
ab(j,i) = 0.0
end do
end do
ibn = ib
wn = w(1)
w1n = w1(1)
w2n = w2(1)
w3n = w3(1)
t0n = 0.0
t1n = t(1)
u0n = u0(1)
f0n = f0(1)
if ( wn .ge. 0.999999 ) then
wn = 0.999999
endif
if ( wn .le. 1.0e-4 ) then
call coefft0 ( ibn,wn,w1n,w2n,w3n,t0n,t1n,u0n,f0n, &
& aa,zz,a1,z1,fk1t,fk2t )
fk1(1) = fk1t
fk2(1) = fk2t
else
call coefft ( ibn,wn,w1n,w2n,w3n,t0n,t1n,u0n,f0n, &
& b,a,d,z,b1,c1,aa,zz,a1,z1,fk1t,fk2t )
fk1(1) = fk1t
fk2(1) = fk2t
endif
do i = 1, 4
z4(i,1) = z1(i)
do j = 1, 4
a4(i,j,1) = a1(i,j)
end do
end do
do i = 1, 2
bx(i) = - zz(i+2,1)
i8 = i + 8
do j = 1, 4
ab(i8-j,j) = aa(i+2,j,1)
end do
end do
do i = 1, 4
wu(i) = zz(i,2)
do j = 1, 4
fu(i,j) = aa(i,j,2)
end do
end do
do k = 2, n
wn = w(k)
w1n = w1(k)
w2n = w2(k)
w3n = w3(k)
t0n = t(k-1)
t1n = t(k)
u0n = u0(k)
f0n = f0(k)
if ( wn .ge. 0.999999 ) then
wn = 0.999999
endif
if ( wn .le. 1.0e-4 ) then
call coefft0 ( ibn,wn,w1n,w2n,w3n,t0n,t1n,u0n,f0n, &
& aa,zz,a1,z1,fk1t,fk2t )
fk1(k) = fk1t
fk2(k) = fk2t
else
call coefft ( ibn,wn,w1n,w2n,w3n,t0n,t1n,u0n,f0n, &
& b,a,d,z,b1,c1,aa,zz,a1,z1,fk1t,fk2t )
fk1(k) = fk1t
fk2(k) = fk2t
endif
do i = 1, 4
z4(i,k) = z1(i)
do j = 1, 4
a4(i,j,k) = a1(i,j)
end do
end do
kf = k + k + k + k
i1 = kf - 5
i2 = i1 + 3
j1 = kf - 7
j2 = j1 + 3
i3 = 0
do i = i1, i2
i3 = i3 + 1
bx(i) = - wu(i3) + zz(i3,1)
j3 = 0
i8 = i + 8
do j = j1, j2
j3 = j3 + 1
ab(i8-j,j) = fu(i3,j3)
end do
j3 = 0
do j = j2 + 1, j2 + 4
j3 = j3 + 1
ab(i8-j,j) = - aa(i3,j3,1)
end do
end do
do i = 1, 4
wu(i) = zz(i,2)
do j = 1, 4
fu(i,j) = aa(i,j,2)
end do
end do
end do
if ( ib .le. mbs ) then
v1 = 0.2113247 * asbs
v2 = 0.7886753 * asbs
v3 = asbs * u0(1) * f0(1) * exp ( - t(n) / u0(1) )
m1 = n4 - 1
m2 = n4
m18 = m1 + 8
m28 = m2 + 8
fw1 = v1 * wu(3)
fw2 = v2 * wu(4)
bx(m1) = - ( wu(1) - fw1 - fw2 - v3 )
bx(m2) = - ( wu(2) - fw1 - fw2 - v3 )
do j = 1, 4
j1 = n4 - 4 + j
fw1 = v1 * fu(3,j)
fw2 = v2 * fu(4,j)
ab(m18-j1,j1) = fu(1,j) - fw1 - fw2
ab(m28-j1,j1) = fu(2,j) - fw1 - fw2
end do
else
v1 = 0.2113247 * ( 1.0 - ee )
v2 = 0.7886753 * ( 1.0 - ee )
v3 = asbs
m1 = n4 - 1
m2 = n4
m18 = m1 + 8
m28 = m2 + 8
fw1 = v1 * wu(3)
fw2 = v2 * wu(4)
bx(m1) = - ( wu(1) - fw1 - fw2 - v3 )
bx(m2) = - ( wu(2) - fw1 - fw2 - v3 )
do j = 1, 4
j1 = n4 - 4 + j
fw1 = v1 * fu(3,j)
fw2 = v2 * fu(4,j)
ab(m18-j1,j1) = fu(1,j) - fw1 - fw2
ab(m28-j1,j1) = fu(2,j) - fw1 - fw2
end do
endif
call qcfel (nv,nv1,ab,bx,xx)
do k = 1, n
j = k + k + k + k - 4
do i = 1, 4
j = j + 1
g4(i,k) = xx(j)
end do
end do
return
end subroutine
!c **********************************************************************
subroutine qcfel (nv, nv1, ab, b, x) 1,1
!c **********************************************************************
!c 1. `qcfel' is the abbreviation of ` qiu constants for each layer'.
!c 2. The inhomogeneous atmosphere is divided into n adjacent homogeneous
!c layers where the single scattering properties are constant in each
!c layer and allowed to vary from one to another. Delta-four-stream is
!c employed for each homogeneous layer. The boundary conditions at the
!c top and bottom of the atmosphere, together with continuity condi-
!c tions at layer interfaces lead to a system of algebraic equations
!c from which 4*n unknown constants in the problom can be solved.
!c 3. This subroutine is used for solving the 4*n unknowns of A *X = B by
!c considering the fact that the coefficient matrix is a sparse matrix
!c with the precise pattern in this special problom.
!c 4. The method is not different in principle from the general scheme of
!c Gaussian elimination with backsubstitution, but carefully optimized
!c so as to minimize arithmetic operations. Partial pivoting is used
!c to quarantee method's numerical stability, which will not change
!c the basic pattern of sparsity of the matrix.
!c 5. Scaling special problems so as to make its nonzero matrix elements
!c have comparable magnitudes, which will ameliorate the stability.
!c 6. a, b and x present A, B and X in A*X=B, respectively. and n4=4*n.
!c 7. AB(13,4*n) is the matrix A in band storage, in rows 3 to 13; rows 1
!c and 2 and other unset elements should be set to zero on entry.
!c 8. The jth column of A is stored in the jth column of the array AB as
!c follows:
!c AB(8+i-j,j) = A(i,j) for max(1,j-5) <= i <= min(4*n,j+5).
!c Reversedly, we have
!c A(ii+jj-8,jj) = AB(ii,jj).
!c **********************************************************************
!# include "para.file"
USE PARA_FILE
implicit none
integer :: nv, nv1
real :: ab(13,nv * 4), b(nv * 4), x(nv * 4)
integer :: i, j, k, l, m, n, &
& i0, i0f, i0m1, im1, ifq, k44, &
& m1f, m1, m2, m3, m4, m18, m28, m38, m48, &
& n1, n2, n3, n4, n44
real :: p, t, xx, yy
n = nv
n4 = nv * 4
do k = 1, n - 1
k44 = 4 * k - 4
do l= 1, 4
m1 = k44 + l
p = 0.0
do i = 8, 14 - l
if ( abs ( ab(i,m1) ) .gt. abs ( p ) ) then
p = ab(i,m1)
i0 = i
endif
10 end do
i0m1 = i0 + m1
m18 = m1 + 8
if ( i0 .ne. 8 ) then
do j = m1, m1 + 8 - l
i0f = i0m1 - j
m1f = m18 - j
t = ab(i0f,j)
ab(i0f,j) = ab(m1f,j)
ab(m1f,j) = t
15 end do
i0f = i0m1 - 8
t = b(i0f)
b(i0f) = b(m1)
b(m1) = t
20 end if
yy = ab(8,m1)
ab(8,m1) = 1.0
do j = m1 + 1, m1 + 8 - l
m1f = m18 - j
ab(m1f,j) = ab(m1f,j) / yy
25 end do
b(m1) = b(m1) / yy
do i = 9, 14 - l
xx = ab(i,m1)
ab(i,m1) = 0.0
im1 = i + m1
do j = m1 + 1, m1 + 8 - l
ifq = im1 - j
m1f = m18 - j
ab(ifq,j) = ab(ifq,j) - ab(m1f,j) * xx
35 end do
ifq = im1 - 8
b(ifq) = b(ifq) - b(m1) * xx
30 end do
3 end do
5 end do
n44 = n4 - 4
do l = 1, 3
m1 = n44 + l
p = 0.0
do i = 8, 12 - l
if ( abs ( ab(i,m1) ) .gt. abs ( p ) ) then
p = ab(i,m1)
i0 = i
endif
45 end do
i0m1 = i0 + m1
m18 = m1 + 8
if( i0 .ne. 8 ) then
do j = m1, m1 + 4 - l
i0f = i0m1 - j
m1f = m18 - j
t = ab(i0f,j)
ab(i0f,j) = ab(m1f,j)
ab(m1f,j) = t
50 end do
i0f = i0m1 - 8
t = b(i0f)
b(i0f) = b(m1)
b(m1) = t
55 end if
yy = ab(8,m1)
ab(8,m1) = 1.0
do j = m1 + 1, m1 + 4 - l
m1f = m18 - j
ab(m1f,j) = ab(m1f,j) / yy
60 end do
b(m1) = b(m1) / yy
do i = 9, 12 - l
xx = ab(i,m1)
ab(i,m1) = 0.0
im1 = i + m1
do j = m1 + 1, m1 + 4 - l
ifq = im1 - j
m1f = m18 - j
ab(ifq,j) = ab(ifq,j) - ab(m1f,j) * xx
70 end do
ifq = im1 - 8
b(ifq) = b(ifq) - b(m1) * xx
65 end do
40 end do
yy = ab(8,n4)
ab(8,n4) = 1.0
b(n4) = b(n4) / yy
n3 = n4 - 1
n2 = n3 - 1
n1 = n2 - 1
x(n4) = b(n4)
x(n3) = b(n3) - ab(7,n4) * x(n4)
x(n2) = b(n2) - ab(7,n3) * x(n3) - ab(6,n4) * x(n4)
x(n1) = b(n1) - ab(7,n2) * x(n2) - ab(6,n3) * x(n3) - &
& ab(5,n4) * x(n4)
do k = 1, n - 1
m4 = 4 * ( n - k )
m3 = m4 - 1
m2 = m3 - 1
m1 = m2 - 1
m48 = m4 + 8
m38 = m3 + 8
m28 = m2 + 8
m18 = m1 + 8
x(m4) = b(m4)
do m = m4 + 1, m4 + 4
x(m4) = x(m4) - ab(m48-m,m) * x(m)
85 end do
x(m3) = b(m3)
do m = m3 + 1, m3 + 5
x(m3) = x(m3) - ab(m38-m,m) * x(m)
90 end do
x(m2) = b(m2)
do m = m2 + 1, m2 + 6
x(m2) = x(m2) - ab(m28-m,m) * x(m)
95 end do
x(m1) = b(m1)
do m = m1 + 1, m1 + 7
x(m1) = x(m1) - ab(m18-m,m) * x(m)
100 end do
80 end do
return
end subroutine
!c **********************************************************************
!c In this subroutine, we incorporate a delta-function adjustment to
!c account for the forward diffraction peak in the context of the
!c four-stream or two stream approximations ( Liou, Fu and Ackerman, &
!c 1988 ). The w1(n), w2(n), w3(n), w(n), and t(n) are the adjusted
!c parameters.
!c **********************************************************************
subroutine adjust ( nv, nv1, ww1,ww2,ww3,ww4,ww,tt,w1,w2,w3,w,t ) 5,2
!# include "para.file"
USE PARA_FILE
USE control_para, dfsasl=>d4s, dtsasl=>d2s, dfsair=>d4ir, dtsair=>d2ir
implicit none
integer :: nv, nv1
real, intent(in), dimension(nv) :: ww1, ww2, ww3, ww4, ww, tt
real, intent(out), dimension(nv) :: w1, w2, w3, w, t
real, dimension(nv) :: dtt, dt
integer :: n, i
real :: tt0, f, fw
n = nv
tt0 = 0.0
do i = 1, n
! 11/4/95 (begin)
if ( dfsasl .or. dfsair ) then
f = ww4(i) / 9.0
else
f = ww2(i) / 5.0
endif
! 11/4/95 (end)
! - clear
fw = 1.0 - f * ww(i)
w1(i) = ( ww1(i) - 3.0 * f ) / ( 1.0 - f )
w2(i) = ( ww2(i) - 5.0 * f ) / ( 1.0 - f )
w3(i) = ( ww3(i) - 7.0 * f ) / ( 1.0 - f )
w(i) = ( 1.0 - f ) * ww(i) / fw
dtt(i) = tt(i) - tt0
tt0 = tt(i)
dt(i) = dtt(i) * fw
10 end do
t(1) = dt(1)
do i = 2, n
t(i) = dt(i) + t(i-1)
20 end do
return
end subroutine
!c **********************************************************************
!c The delta-four-stream approximation for nonhomogeneous atmospheres
!c in the solar wavelengths (Fu, 1991). The input parameters are nv, &
!c nv1, and nv * 4 through 'para.file', ib, as, u0, f0 for solar and
!c ib, bf, bs, ee for IR through arguments of 'qfts' and 'qfti', and
!c ww1(nv), ww2(nv), ww3(nv), ww4(nv), ww(nv), and tt(nv)
!c through common statement 'dfsin'.
!c **********************************************************************
subroutine qfts ( nv, nv1, ib,as,u0,f0,ww1,ww2,ww3,ww4,ww,tt,ffu,ffd ) 1,3
!# include "para.file"
USE PARA_FILE
! common /dis/ a(4)
! common /point/ u(4)
implicit none
integer :: nv, nv1
integer, intent(in) :: ib
real, intent(in) :: as, u0, f0
real, intent(in), dimension(nv) :: ww1, ww2, ww3, ww4, ww, tt
real, intent(out), dimension(nv1) :: ffu, ffd
real, dimension(nv) :: w1, w2, w3, w4, w, t, u0a, f0a
real :: fk1(nv), fk2(nv), a4(4,4,nv), &
& z4(4,nv), g4(4,nv)
integer :: i, n, m, k, ii,jj
real :: asbs, ee, fw1, fw2, fw3, fw4, y, y1, x(4), fi(4)
n = nv
m = nv1
ee = 0.0
asbs = as
call adjust ( nv,nv1,ww1,ww2,ww3,ww4,ww,tt,w1,w2,w3,w,t )
do i = 1, n
u0a(i) = u0
f0a(i) = f0
5 end do
call qcfe ( nv,nv1,ib,asbs,ee,w1,w2,w3,w,t,u0a,f0a, &
& fk1,fk2,a4,z4,g4 )
fw1 = 0.6638961
fw2 = 2.4776962
fw3 = u0 * 3.14159 * f0
do i = 1, m
if ( i .eq. 1 ) then
x(1) = 1.0
x(2) = 1.0
x(3) = exp ( - fk1(1) * t(1) )
x(4) = exp ( - fk2(1) * t(1) )
k = 1
y = 1.0
elseif ( i .eq. 2 ) then
x(1) = exp ( - fk2(1) * t(1) )
x(2) = exp ( - fk1(1) * t(1) )
x(3) = 1.0
x(4) = 1.0
k = 1
y = exp ( - t(1) / u0 )
else
k = i - 1
y1 = t(k) - t(k-1)
x(1) = exp ( - fk2(k) * y1 )
x(2) = exp ( - fk1(k) * y1 )
x(3) = 1.0
x(4) = 1.0
y = exp ( - t(k) / u0 )
endif
do jj = 1, 4
fi(jj) = z4(jj,k) * y
37 end do
do ii = 1, 4
fw4 = g4(ii,k) * x(ii)
do jj = 1, 4
fi(jj) = fi(jj) + a4(jj,ii,k) * fw4
45 end do
40 end do
ffu(i)= fw1 * fi(2) + fw2 * fi(1)
ffd(i)= fw1 * fi(3) + fw2 * fi(4) + fw3 * y
10 end do
return
end subroutine
!c **********************************************************************
!c The exponential approximation for the Planck function in optical depth
!c is used for the infrared ( Fu, 1991). Since the direct solar radiation
!c source has an exponential function form in terms of optical depth, the
!c formulation of the delta-four-stream approximation for infrared wave-
!c lengths is the same as that for solar wavelengths.
!c **********************************************************************
subroutine qfti ( nv, nv1, ib,ee,bf,bs,ww1,ww2,ww3,ww4,ww,tt,ffu,ffd ) 1,3
!# include "para.file"
USE PARA_FILE
implicit none
integer :: nv, nv1
integer, intent(in) :: ib
real, intent(in) :: ee, bf(nv1), bs
real, intent(in), dimension(nv) :: ww1, ww2, ww3, ww4, ww, tt
real, intent(out), dimension(nv1) :: ffu, ffd
real, dimension(nv) :: w1, w2, w3, w, t, u0, f0
integer :: n, m, i, ii, jj, k
real :: asbs, t0, deltau, q1, q2, fw1, fw2, fw3, xy, y1
real :: x(4), fi(4)
real :: fk1(nv), fk2(nv), a4(4,4,nv), &
& z4(4,nv), g4(4,nv)
n = nv
m = nv1
asbs = bs * ee
call adjust ( nv,nv1,ww1,ww2,ww3,ww4,ww,tt,w1,w2,w3,w,t )
t0 = 0.0
do i = 1, n
q1 = alog ( bf(i+1) / bf(i) )
! -- change by Yu Gu, 11/13/01
deltau = t(i) -t0
if (deltau .lt. 1.e-12) deltau = 1.e-12
q2 = 1.0 / deltau
! q2 = 1.0 / ( t(i) - t0 )
! --change over
f0(i) = 2.0 * ( 1.0 - w(i) ) * bf(i)
if ( abs(q1) .le. 1.0e-10 ) then
u0(i) = - 1.0e+10 / q2
else
u0(i) = - 1.0 / ( q1 * q2 )
endif
! --------- 4/2/97 (5)
if (abs(u0(i)) .gt. 4.25E+09) then
if (u0(i) .lt. 0.0) then
u0(i) = -4.25E+09
else
u0(i) = 4.25E+09
end if
end if
! --------- 4/2/97 (5)
t0 = t(i)
3 end do
call qcfe ( nv,nv1,ib,asbs,ee,w1,w2,w3,w,t,u0,f0,fk1,fk2,a4,z4,g4 )
fw1 = 0.6638958
fw2 = 2.4776962
do i = 1, m
if ( i .eq. 1 ) then
x(1) = 1.0
x(2) = 1.0
x(3) = exp ( - fk1(1) * t(1) )
x(4) = exp ( - fk2(1) * t(1) )
k = 1
xy = 1.0
elseif ( i .eq. 2 ) then
x(1) = exp ( - fk2(1) * t(1) )
x(2) = exp ( - fk1(1) * t(1) )
x(3) = 1.0
x(4) = 1.0
k = 1
xy = exp ( - t(1) / u0(1) )
else
k = i - 1
y1 = t(k) - t(k-1)
x(1) = exp ( - fk2(k) * y1 )
x(2) = exp ( - fk1(k) * y1 )
x(3) = 1.0
x(4) = 1.0
xy = exp ( - y1 / u0(k) )
endif
do jj = 1, 4
fi(jj) = z4(jj,k) * xy
37 end do
do ii = 1, 4
fw3 = g4(ii,k) * x(ii)
do jj = 1, 4
fi(jj) = fi(jj) + a4(jj,ii,k) * fw3
45 end do
40 end do
ffu(i)= fw1 * fi(2) + fw2 * fi(1)
ffd(i)= fw1 * fi(3) + fw2 * fi(4)
10 end do
return
end subroutine
!c 11/4/95 (begin)
subroutine cfgts0 ( ib, w, w1, t0, t1, u0, f0, & 1,2
& gamma1, gamma2, gamma3, gamma4, ugts1 )
!c **********************************************************************
!c This subroutine is used to calculate the Coefficients For Generalized
!c Two-Stream scheme. We can make choices between Eddington, quadrature
!c and hemispheric mean schemes through logical variables 'edding', &
!c 'quadra', and 'hemisp'. The Eddington and quadrature schemes are
!c discussed in detail by Liou (1992). The hemispheric mean scheme is
!c derived by assuming that the phase function is equal to 1 + g in the
!c forward scattering hemisphere and 1 - g in the backward scattering
!c hemisphere where g is the asymmetry factor. The hemispheric mean is
!c only used for infrared wavelengths (Toon et al. 1989).
!c **********************************************************************
!# include "para.file"
USE PARA_FILE
USE control_para
implicit none
integer, intent(in) :: ib
real, intent(in) :: w, w1, t0, t1, u0, f0
real, intent(out) :: gamma1, gamma2, gamma3, gamma4, ugts1
real x, y, z
if ( edding ) then
x = 0.25 * w1
y = w * x
gamma1 = 1.75 - w - y
gamma2 = - 0.25 + w - y
gamma3 = 0.0
gamma4 = 0.0
if ( ib .le. mbs ) then
gamma3 = 0.5 - x * u0
gamma4 = 1.0 - gamma3
endif
ugts1 = 0.5
endif
if ( quadra ) then
x = 0.866 * w
y = 0.2887 * w1
z = y * w
gamma1 = 1.732 - x - z
gamma2 = x - z
gamma3 = 0.0
gamma4 = 0.0
if ( ib .le. mbs ) then
gamma3 = 0.5 - y * u0
gamma4 = 1.0 - gamma3
endif
ugts1 = 0.57735
endif
if ( hemisp ) then
x = w * w1 / 3.0
gamma1 = 2.0 - w - x
gamma2 = w - x
gamma3 = 0.0
gamma4 = 0.0
ugts1 = 0.5
endif
return
end subroutine
subroutine cfgts ( ib, w, w1, t0, t1, u0, f0, & 1,2
& lamda,gamma,cadd0,cadd1,cmin0,cmin1,g1g2 )
!c **********************************************************************
!c This subroutine is used to calculate the Coefficients For Generalized
!c Two-Stream scheme.
!c **********************************************************************
!# include "para.file"
USE PARA_FILE
implicit none
integer, intent(in) :: ib
real, intent(in) :: w, w1, t0, t1, u0, f0
real :: lamda, gamma, cadd0, cadd1, cmin0, cmin1, g1g2
real :: gamma1, gamma2, gamma3, gamma4, ugts1
real :: fq, alfa, beta, fw, x, z
call cfgts0 ( ib, w, w1, t0, t1, u0, f0, &
& gamma1, gamma2, gamma3, gamma4, ugts1 )
lamda = sqrt ( ( gamma1 + gamma2 ) * ( gamma1 - gamma2 ) )
gamma = gamma2 / ( gamma1 + lamda )
g1g2 = gamma1 + gamma2
fq = 1.0 / u0
if ( ib .le. mbs ) then
alfa = gamma3
beta = gamma4
fw = 3.1415927 * f0 * w * exp ( - fq * t0 )
else
alfa = 1.0
beta = 1.0
fw = 3.1415927 * f0
endif
x = exp ( - fq * ( t1 - t0 ) )
z = lamda * lamda - fq * fq
! -- change by Yu Gu, 11/15/01; changed back in 3.5
if (abs(z).lt.1.e-4) then
if (z.ge.0.) z = 1.e-4
if (z.lt.0.) z = -1.e-4
endif
! -- the following line is commented out in 3.5
! if(abs(z).le.1.e-4) z = 1.e-4
! -- cgange over
cadd0 = fw * ( ( gamma1 - fq ) * alfa + &
& beta * gamma2 ) / z
cmin0 = fw * ( ( gamma1 + fq ) * beta + &
& alfa * gamma2 ) / z
cadd1 = cadd0 * x
cmin1 = cmin0 * x
return
end subroutine
subroutine qccgts ( nv, nv1, ib, asbs, ee, & 3,3
& w1,w2,w3,w,t,u0,f0, &
& lamdan,gamman,caddn,cminn, &
& caddn0,cminn0,aa,bb,expn,g1g2n )
!c **********************************************************************
!c In the solar band asbs is the surface albedo, while in the infrared
!c band asbs is blackbody intensity emitted at the surface temperature
!c times surface emissivity. In this subroutine, the generalized two-
!c stream is applied to nonhomogeneous atmospheres. ee is the IR surface
!c emissivity.
!c **********************************************************************
!# include "para.file"
USE PARA_FILE
implicit none
integer :: nv, nv1
integer, intent(in) :: ib
real, intent(in) :: asbs, ee
real, intent(in), dimension(nv) :: w1, w2, w3, w, t, u0, f0
real, dimension(nv) :: lamdan, gamman, caddn, cminn, &
& caddn0, cminn0, aa, bb, expn, g1g2n
integer :: ibn, k ,k1, k2
real :: wn, w1n, t0n, t1n, u0n, f0n, rsfc, ssfc, wm1, wm2
real, dimension(nv) :: xn, yn, zn
real, dimension(nv * 2) :: a, b, c, r, u, gam
ibn = ib
do k = 1, nv
wn = w(k)
w1n = w1(k)
if ( k .eq. 1 ) then
t0n = 0.0
else
t0n = t(k-1)
endif
t1n = t(k)
u0n = u0(k)
f0n = f0(k)
if ( wn .ge. 0.999999 ) then
wn = 0.999999
endif
call cfgts ( ib, wn, w1n, t0n, t1n, u0n, f0n, &
& lamdan(k), gamman(k), caddn0(k), caddn(k), &
& cminn0(k), cminn(k), g1g2n(k) )
expn(k) = exp ( - lamdan(k) * ( t1n - t0n ) )
xn(k) = gamman(k) * expn(k)
yn(k) = ( expn(k) - gamman(k) ) / ( xn(k) - 1.0 )
zn(k) = ( expn(k) + gamman(k) ) / ( xn(k) + 1.0 )
40 end do
a(1) = 0.0
b(1) = xn(1) + 1.0
c(1) = xn(1) - 1.0
r(1) = - cminn0(1)
do k = 1, nv - 1
k1 = k + k
k2 = k + k + 1
a(k1) = 1.0 + xn(k) - yn(k+1) * ( gamman(k) + expn(k) )
b(k1) = 1.0 - xn(k) - yn(k+1) * ( gamman(k) - expn(k) )
c(k1) = yn(k+1) * ( 1.0 + xn(k+1) ) - expn(k+1) - gamman(k+1)
r(k1) = caddn0(k+1) - caddn(k) - yn(k+1) * &
& ( cminn0(k+1) - cminn(k) )
a(k2) = gamman(k) - expn(k) - zn(k) * ( 1.0 - xn(k) )
b(k2) = -1.0 - xn(k+1) + zn(k) * ( expn(k+1) + gamman(k+1) )
c(k2) = zn(k) * ( expn(k+1) - gamman(k+1) ) - xn(k+1) + 1.0
r(k2) = cminn0(k+1) - cminn(k) - zn(k) * &
& ( caddn0(k+1) - caddn(k) )
50 end do
if ( ib .le. mbs ) then
rsfc = asbs
ssfc = 3.1415927 * u0(1) * exp(-t(nv)/u0(1)) * rsfc * &
& f0(1)
else
rsfc = 1.0 - ee
ssfc = 3.1415927 * asbs
endif
wm1 = 1.0 - rsfc * gamman(nv)
wm2 = xn(nv) - rsfc * expn(nv)
a(nv * 2) = wm1 + wm2
b(nv * 2) = wm1 - wm2
c(nv * 2) = 0.0
r(nv * 2) = rsfc * cminn(nv) - caddn(nv) + ssfc
! test
! write(0,*) 'a,b,gam=',a, b, gam
! write(0,*) 'rsfc,gamman, xn, expn=',rsfc,gamman,xn,expn
call tridag ( a, b, c, r, u, gam, nv * 2 )
do k = 1, nv
k1 = k + k - 1
k2 = k + k
aa(k) = u(k1) + u(k2)
bb(k) = u(k1) - u(k2)
60 end do
return
end subroutine
subroutine tridag ( a, b, c, r, u, gam, n ) 7,2
!c **********************************************************************
!c
!c | b1 c1 0 ... | | u1 | | r1 |
!c | a2 b2 c2 ... | | u2 | | r2 |
!c | ... | . | . | = | . |
!c | ... an-1 bn-1 cn-1 | | un-1 | | rn-1 |
!c | 0 an bn | | un | | rn |
!c
!c This subroutine solves for a vector U of length N the tridiagonal
!c linear set given by above equation. A, B, C and R are input vectors
!c and are not modified (Numerical Recipes by Press et al. 1989).
!c **********************************************************************
implicit none
integer :: n
real, dimension(n) :: a, b, c, r, u, gam
integer :: i, j
real :: bet
! if ( b(1) .eq. 0. ) pause
if ( b(1) .eq. 0. ) then
CALL wrf_error_fatal('subroutine tridag failed. Stop program') !mchen
endif
! If this happens then you should rewrite your equations as a set of
! order n-1, with u2 trivially eliminated.
bet = b(1)
u(1) = r(1) / bet
! Decomposition and forward substitution
do j = 2, n
gam(j) = c(j-1) / bet
bet = b(j) - a(j) * gam(j)
! if ( bet .eq. 0. ) pause
if ( bet .eq. 0. ) then
CALL wrf_error_fatal('subroutine tridag failed. Stop program') !mchen
endif
! Algorithm fails; see Numerical Recipes.
u(j) = ( r(j) - a(j) * u(j-1) ) / bet
11 end do
! Backsubstitution
do j = n - 1, 1, -1
u(j) = u(j) - gam(j+1) * u(j+1)
12 end do
return
end subroutine
subroutine qftsts ( nv, nv1, ib, as_in, u0, f0, & 1,3
& ww1,ww2,ww3,ww4,ww,tt, &
& ffu,ffd )
!c **********************************************************************
!c The generalized two stream approximation for nonhomgeneous atmospheres
!c in the solar wavelengths. The input parameters are those through
!c 'para.file', through argument of 'qftsts' and through common statement
!c 'dfsin' and 'gtslog'.
!c **********************************************************************
!# include "para.file"
USE PARA_FILE
implicit none
integer :: nv, nv1
integer, intent(in) :: ib
real, intent(in) :: as_in, u0, f0
real, intent(in), dimension(nv) :: ww1, ww2, ww3, ww4, ww, tt
real, dimension(nv) :: w1, w2, w3, w, t, u0a, f0a
real, intent(out), dimension(nv1) :: ffu, ffd
real, dimension(nv) :: lamdan, gamman, caddn, cminn, &
& caddn0, cminn0, aa, bb, expn, g1g2n
integer :: n, m, k, i
real :: ee, asbs, fw3, xx, yy(nv)
n = nv
m = nv1
ee = 0.0
asbs = as_in
call adjust ( nv,nv1,ww1,ww2,ww3,ww4,ww,tt,w1,w2,w3,w,t )
do i = 1, n
u0a(i) = u0
f0a(i) = f0
5 end do
call qccgts ( nv,nv1,ib, asbs, ee, &
& w1,w2,w3,w,t,u0a,f0a, &
& lamdan,gamman,caddn,cminn, &
& caddn0,cminn0,aa,bb,expn,g1g2n )
fw3 = u0 * 3.1415927 * f0
do k = 1, nv
yy(k) = exp(-t(k)/u0)
enddo
xx = aa(1) * expn(1)
ffu(1) = xx + gamman(1) * bb(1) + caddn0(1)
ffd(1) = gamman(1) * xx + bb(1) + cminn0(1) + fw3
do i = 2, m
k = i - 1
xx = bb(k) * expn(k)
ffu(i) = aa(k) + gamman(k) * xx + caddn(k)
ffd(i) = gamman(k) * aa(k) + xx + cminn(k) + fw3 * yy(k)
10 end do
return
end subroutine
subroutine qftits ( nv, nv1, ib, as_in, f0, u0, &,3
& ww1,ww2,ww3,ww4,ww,tt, &
& ffu,ffd )
!c **********************************************************************
!c The exponential approximation for the Planck function in optical depth
!c is used for the infrared ( Fu, 1991). Since the direct solar radiation
!c source has an exponential function form in terms of optical depth, the
!c formulation of generalized two stream approximation for infrared wave
!c lengths is the same as that for solar wavelengths.
!c The generalized two stream approximation for nonhomgeneous atmospheres
!c in the infrared wavelengths. The input parameters are those through
!c 'para.file', through argument of 'qftits' and through common statement
!c 'dfsin', 'gtslog', and 'planci'.
!c **********************************************************************
!# include "para.file"
USE PARA_FILE
implicit none
integer :: nv, nv1
integer, intent(in) :: ib
real, intent(in) :: as_in
real, dimension(nv) :: f0, u0
real, intent(in), dimension(nv) :: ww1, ww2, ww3, ww4, ww, tt
real, dimension(nv) :: w1, w2, w3, w, t, u0a, f0a
real, intent(out), dimension(nv1) :: ffu, ffd
real, dimension(nv) :: lamdan, gamman, caddn, cminn, &
& caddn0, cminn0, aa, bb, expn, g1g2n
integer :: n, m, k, i
real :: asbs, fw3, xx, yy(nv), t0, q1, q2, deltau
real :: ee, bf(nv1), bs
n = nv
m = nv1
asbs = bs * ee
call adjust ( nv,nv1,ww1,ww2,ww3,ww4,ww,tt,w1,w2,w3,w,t )
t0 = 0.0
do i = 1, n
q1 = alog ( bf(i+1) / bf(i) )
! -- change by Yu Gu, 11/13/01
deltau = t(i) -t0
if (deltau .lt. 1.e-12) deltau = 1.e-12
q2 = 1.0 / deltau
! q2 = 1.0 / ( t(i) - t0 )
! --change over
f0(i) = 2.0 * ( 1.0 - w(i) ) * bf(i)
if ( abs(q1) .le. 1.0e-10 ) then
u0(i) = - 1.0e+10 / q2
else
u0(i) = - 1.0 / ( q1 * q2 )
endif
t0 = t(i)
3 end do
call qccgts ( nv,nv1,ib, asbs, ee, &
& w1,w2,w3,w,t,u0a,f0a, &
& lamdan,gamman,caddn,cminn, &
& caddn0,cminn0,aa,bb,expn,g1g2n )
xx = aa(1) * expn(1)
ffu(1) = xx + gamman(1) * bb(1) + caddn0(1)
ffd(1) = gamman(1) * xx + bb(1) + cminn0(1)
do i = 2, m
k = i - 1
xx = bb(k) * expn(k)
ffu(i) = aa(k) + gamman(k) * xx + caddn(k)
ffd(i) = gamman(k) * aa(k) + xx + cminn(k)
10 end do
return
end subroutine
subroutine qftisf ( nv, nv1, ib, ee, bf, bs, & 1,4
& ww1, ww2, ww3, ww4, ww, tt, &
& ffu, ffd )
!c **********************************************************************
!c In this subroutine, the two- and four- stream combination scheme or
!c the source function technique (Toon et al. 1989) is used to calculate
!c the IR radiative fluxes. The exponential approximation for the Planck
!c function in optical depth is used ( Fu, 1991).
!c At IR wavelengths, the two-stream results are not exact in the limit
!c of no scattering. It also introduces large error in the case of sca-
!c ttering. Since the no-scattering limit is of considerable significance
!c at IR wavelengths, we have used the source function technique that
!c would be exact in the limit of the pure absorption and would also en-
!c hance the accuracy of the two-stream approach when scattering occurs
!c in the IR wavelengths.
!c Here, we use nq Gauss points to obtain the fluxes: when nq=2, we use
!c double Gaussian quadrature as in Fu and Liou (1993) for four-stream
!c approximation; when nq = 3, we use the regular Gauss quadrature but
!c u1*w1+u2*w2+u3*w3=1.0.
!c **********************************************************************
!# include "para.file"
USE PARA_FILE
USE control_para, only: quadra
implicit none
integer :: nv, nv1
integer, parameter :: nq = 2
integer :: ib
real :: ee, bf(nv1), bs
real, dimension(nv) :: ww1, ww2, ww3, ww4, ww, tt
real, dimension(nv) :: w1, w2, w3, w, t, u0, f0
real, dimension(nv1) :: ffu, ffd
real, dimension(nv) :: lamdan, gamman, caddn, cminn, &
caddn0, cminn0, aa, bb, expn, g1g2n
real, dimension(nv) :: fuq1, fuq2, fg, fh, fj, fk
real, dimension(nv1,nq) :: fiu, fid
integer :: n, m, i, j, i1
real :: ugts1, asbs, t0, q1, q2, deltau, xgy, x, y1, y, z, &
& xx, yy, tempugbeta, tempxxp1, tempxxm1, ugbeta
real :: alfa(nv+1), beta(nv)
real :: fx(nv,nq), fy(nv), fz1(nv,nq), fz2(nv,nq)
real :: ug(nq), wg(nq), ugwg(nq)
!c data ug / 0.238619, 0.661209, 0.932469 /
!c data wg / 0.467914, 0.360762, 0.171324 /
!c data ugwg / 0.109475, 0.233886, 0.156639 /
data ug / 0.2113248, 0.7886752 /
data wg / 0.5, 0.5 /
data ugwg / 0.105662, 0.394338 /
if ( quadra ) then
ugts1 = 0.57735
else
ugts1 = 0.5
endif
n = nv
m = nv1
asbs = bs * ee
call adjust ( nv,nv1,ww1,ww2,ww3,ww4,ww,tt,w1,w2,w3,w,t )
t0 = 0.0
do i = 1, n
q1 = alog ( bf(i+1) / bf(i) )
! -- change by Yu Gu, 11/13/01
deltau = t(i) -t0
if (deltau .lt. 1.e-12) deltau = 1.e-12
q2 = 1.0 / deltau
! q2 = 1.0 / ( t(i) - t0 )
! --change over
f0(i) = 2.0 * ( 1.0 - w(i) ) * bf(i)
if ( abs(q1) .le. 1.0e-10 ) then
u0(i) = - 1.0e+10 / q2
else
u0(i) = - 1.0 / ( q1 * q2 )
endif
t0 = t(i)
beta(i) = - 1.0 / u0(i)
enddo
call qccgts ( nv,nv1,ib, asbs, ee, &
& w1,w2,w3,w,t,u0,f0, &
& lamdan,gamman,caddn,cminn, &
& caddn0,cminn0,aa,bb,expn,g1g2n )
do i = 1, n
! --- change by Yu Gu, 11/15/01; changed back in 3.5
xgy = lamdan(i)*lamdan(i) - beta(i) * beta(i)
if (abs(xgy).lt.1.e-4) then
if (xgy.ge.0.) xgy = 1.e-4
if (xgy.lt.0.) xgy = -1.e-4
endif
! if(abs(xgy).le.1.e-4) xgy = 1.e-4 !mchen
x = 2.0 * ( 1.0 - w(i) ) * w(i) / xgy
! x = 2.0 * ( 1.0 - w(i) ) * w(i) / ( lamdan(i) *
! & lamdan(i) - beta(i) * beta(i) )
! -- change over
y1 = w1(i) / 3.0
y = 2.0 * ( 1.0 - w(i) * y1 )
z = -y1 * beta(i)
fuq1(i) = x * ( y - z ) + 1.0 - w(i)
fuq2(i) = x * ( y + z ) + 1.0 - w(i)
enddo
do i = 1, n + 1
alfa(i) = 6.2832 * bf(i)
enddo
x = 1.0 / ugts1
do i = 1, n
y = gamman(i) * ( x + lamdan(i) )
z = x - lamdan(i)
fg(i) = aa(i) * z
fh(i) = bb(i) * y
fj(i) = aa(i) * y
fk(i) = bb(i) * z
enddo
do j = 1, nq
fid(1,j) = 0.0
enddo
do j = 1, nq
t0 = 0.0
do i = 2, nv1
i1 = i - 1
fx(i1,j) = exp ( - ( t(i1) - t0 ) / ug(j) )
fy(i1) = expn(i1)
xx = lamdan(i1) * ug(j)
! --change by Yu Gu, 12/04/01
tempugbeta = ug(j) * beta(i1) + 1.0
tempxxp1 = xx + 1.0
tempxxm1 = xx - 1.0
if (tempugbeta.eq.0.) tempugbeta = 1.e-4
if (tempxxp1.eq.0.) tempxxp1 = 1.e-4
if (tempxxm1.eq.0.) tempxxm1 = 1.e-4
! if (tempugbeta.eq.0.) tempugbeta = 0.0001
! if (tempugbeta.eq.0.) tempugbeta = 1.e-4
! - change over
! fz1(i1,j) = ( 1.0 - fx(i1,j) * fy(i1) ) / ( xx + 1.0 )
! fz2(i1,j) = ( fx(i1,j) - fy(i1) ) / ( xx - 1.0 )
fz1(i1,j) = ( 1.0 - fx(i1,j) * fy(i1) ) / ( tempxxp1 )
fz2(i1,j) = ( fx(i1,j) - fy(i1) ) / ( tempxxm1 )
fid(i,j) = fid(i1,j) * fx(i1,j) + fj(i1) * fz1(i1,j) + &
& fk(i1) * fz2(i1,j) + &
& 1.0 / ( tempugbeta ) * &
! & 1.0 / ( ug(j) * beta(i1) + 1.0 ) *
& ( alfa(i) - alfa(i1) * fx(i1,j) ) * fuq2(i1)
!-- test
! if (abs(fid(i,j)).gt.1000.) then
! write(0,*) 'i,j,fid=',i,j,fid(i,j)
! write(0,*) 'tau b4 adjust=',tt
! write(0,*) 'tau=',t
! write(0,*) 'fx=', fx
! write(0,*) 'fj=', fj
! write(0,*) 'fz1=', fz1
! write(0,*) 'fk=', fk
! write(0,*) 'fz2=', fz2
! write(0,*) 'tempugbeta=', tempugbeta
! write(0,*) 'ug=', ug
! write(0,*) 'beta=', beta
! write(0,*) 'alfa=', alfa
! write(0,*) 'fuq2=', fuq2
! endif
t0 = t(i1)
enddo
enddo
yy = 0.0
do j = 1, nq
yy = yy + ugwg(j) * fid(nv1,j)
enddo
xx = yy * ( 1.0 - ee ) * 2.0 + 6.2831854 * ee * bs
do j = 1, nq
fiu(nv1,j) = xx
enddo
do j = 1, nq
do i = nv1 - 1, 1, -1
! -- change by Yu Gu, 11/15/01
ugbeta = ug(j)*beta(i)
if (ugbeta.eq.1.) ugbeta = 1.0001
! -- change over
fiu(i,j) = fiu(i+1,j) * fx(i,j) + fg(i) * fz2(i,j) + &
& fh(i) * fz1(i,j) + &
! -- change by Yu Gu, 11/15/01
! & 1.0 / ( ug(j) * beta(i) - 1.0 ) *
& 1.0 / ( ugbeta - 1.0 ) * &
! -- change over
& ( alfa(i+1) * fx(i,j) - alfa(i) ) * fuq1(i)
!-- test
! if (abs(fiu(i,j)).gt.1000.) then
! write(0,*) 'i,j,fiu=',i,j,fiu(i,j)
! write(0,*) 'fx=', fx
! write(0,*) 'fg=', fg
! write(0,*) 'fz1=', fz1
! write(0,*) 'fh=', fh
! write(0,*) 'fz2=', fz2
! write(0,*) 'ugbeta=', ugbeta
! write(0,*) 'alfa=', alfa
! write(0,*) 'fuq1=', fuq1
! endif
enddo
enddo
do i = 1, nv1
ffu(i) = 0.0
ffd(i) = 0.0
enddo
do i = 1, nv1
do j = 1, nq
ffu(i) = ffu(i) + ugwg(j) * fiu(i,j)
ffd(i) = ffd(i) + ugwg(j) * fid(i,j)
enddo
enddo
return
end subroutine
!c 11/4/95 (end)
!=========================================================================
subroutine atau_spline_iaform3(wli,aoti,aotf,wlf,irh,itp) 1,3
USE PARA_FILE
USE aot_spect_5, wlo2=>wlo
! USE aot_spect_25, wlo2=>wlo
! parameter(nsub=5 ,nfuo=15,nwo=nsub*nfuo)
! common /aot_spect_5/ wlo2(5,15) , hkas(5,15) ,sflx (5,15)
! parameter(nsub=25,nfuo=15 ,nwo=nsub*nfuo)
! common /aot_spect_25/ wlo2(25,15) , hkas(25,15) ,sflx (25,15) !!! Higer resolution Convolution
implicit none
integer :: irh,itp
real, dimension(mxat) :: aoti, wli
real, dimension(nwo) :: aoto, wlo
real, dimension(nsub,nfuo) :: aoto2
real, dimension(15) :: aotf, wlf
integer :: ii, jj, kk, i, j
real :: zord
! wlo = reshape(wlo2,(/nwo/))
kk=0
do jj=1,nfuo
do ii=1,nsub
kk=kk+1
wlo(kk) = wlo2(ii,jj)
enddo
enddo
call aot_ext &
& (aoti,wli,wlo,aoto,irh,itp)
! aoto2 = reshape(aoto,(/5,15/))
kk=0
do jj=1,nfuo
do ii=1,nsub
kk=kk+1
aoto2(ii,jj)=aoto(kk)
enddo
enddo
wlf=0.0 ; aotf =0.0
zord = 0.0
do j=1,nfuo
do i = 1,nsub
wlf(j) = wlf(j)+ wlo2(i,j) * hkas(i,j)
aotf(j)= aotf(j)+ aoto2(i,j) * hkas(i,j)
zord = zord + sflx (i,j)*exp(-aoto2(i,j))
enddo
enddo
!- WRITE OUT interpolated AOTs
! do i=1,nwo
! write(11) d1,d2,wlo(i),aoto(i),float(irec),log(wlo(i)),log(aoto(i)),float(ityp)
! enddo
! print'(A6,f10.3, 3i4)','FLUX= ',zord ,nsub,ityp,irh
return
end subroutine
!----------------------------------------------------------------
subroutine aot_ext (aotin,wlin,wlo,aoto,irh,ityp) 1,10
USE PARA_FILE
USE control_para, nwin=>n_atau
USE opac_ext, wlopac=>wl, datopac=>edat
USE mineral_ext, wlt=>wl, datt=>dat
USE dalm_ext, wld=>wl, datd=>dat
implicit none
integer :: irh,ityp
real ,dimension(mxat) :: aotin,wlin
! real ,allocatable,dimension(-100:100) :: aoti,wlix
real ,dimension(-100:100) :: aoti,wlix
real ,dimension(nwo) :: aoto,wlo
real ,dimension(24) :: wlp,extp
integer :: idtl, nes, nel, nb, nwi, iend, i, nq
integer :: ne = 24
real :: ext_norm1, ext_norm0
! common /dalm_ext/ wld(24) ,datd(24,8,3)
! common /mineral_ext/ wlt(24) ,datt(24,4:8)
! common /opac_ext/ wlopac(24) ,datopac(24,8,9:18)
! Wavelength MICRONS
! wlix,aoti = Monotonicly increasing
idtl=-1
if ( ityp >= 1 .and. ityp <=3 )then ! d'Almedia
wlp = wld
extp = datd(1:24,irh,ityp)
idtl=1
elseif ( ityp >=4 .and. ityp <= 8) then ! Tegen&Lacis
wlp = wlt
extp = datt(1:24,ityp)
idtl=2
elseif ( ityp >=9 .and. ityp <= 18) then ! OPAC
wlp = wlopac
if (ityp==10 .or. ityp==12 .or.ityp==13 .or.ityp==18 ) then
extp = datopac(1:24,irh,ityp)
else
extp = datopac(1:24, 1,ityp)
endif
idtl=3
else
CALL wrf_error_fatal('Bad Aerosol type. Stop program') !mchen
endif
! wavelength-dependent parameters
if(nwin==1)then
! nes=-3; nel=19 ! 1 chan @ 500nm
if(wlin(1)<=.325.or.wlin(1)>=.675) &
& CALL wrf_error_fatal('OUT OF ALLOWABLE ARANGE. STOP program') !mchen
nes=-(wlin(1)-0.325)/0.05;
if(idtl==3) nes=nes-1 ! OPAC starts at 0.25um instead of 0.30
nel=22+nes
! print*,'NES NEL',nes,nel,wlin(1)
else
nes=0
if(idtl==1)then ! >= 2um long d'Almedia
nel=8
elseif(idtl==2)then ! >= 2um long Tegin&Lacis
nel=11
elseif(idtl==3)then ! >= 2um long OPAC
nel=7
endif
endif
nb = ne+1-nel
nwi = nwin+nel-nes+1
iend = nwin+nel
! print*, icall,'in AOTEXT',nes,iend
! if ( allocated (aoti) ) deallocate ( aoti )
! allocate( aoti(nes:iend) )
! if ( allocated (wlix) ) deallocate ( wlix)
! allocate( wlix(nes:iend) )
! if(icall == 2) stop
wlix(1:nwin) =wlin(1:nwin)
aoti(1:nwin)=aotin(1:nwin)
LONGSIDE: do i=1,ne
if(wlix(nwin)>=wlp(i).and.wlix(nwin)<=wlp(i+1))then
ext_norm1=rlnintrp(wlp(i),wlp(i+1),extp(i),extp(i+1), &
& wlix(nwin))
! print*,dy,dx,dx1,yy,ext_norm1
exit LONGSIDE
endif
enddo LONGSIDE
!C--- change by Yu Gu
!wlix(nwin+1:nwi) = wlp(nb:ne)
!aoti(nwin+1:nwi) = aoti(nwin)*(extp(nb:ne)/ext_norm1)
wlix(nwin+1:iend)=wlp(nb:ne)
aoti(nwin+1:iend)=aoti(nwin)*(extp(nb:ne)/ext_norm1)
!C-- change over
!------
if(nwin==1)then
! print*,1,wlix(1),aoti(1)
SHORTSIDE: do i=1,ne
if(wlix(1)>=wlp(i).and.wlix(1)<=wlp(i+1))then
ext_norm0= rlnintrp( wlp(i),wlp(i+1), &
& extp(i),extp(i+1),wlix(1))
! print*,dy,dx,dx1,yy,ext_norm0
exit SHORTSIDE
endif
enddo SHORTSIDE
nq=-nes+1
wlix(nes:0)=wlp(1:nq)
aoti(nes:0)=aoti(1)*(extp(1:nq)/ext_norm0)
else
wlix(0)=0.001
aoti(0)=1
endif
!------------------------------------------------------------------
! print'(a18,40f7.3)','Wavelength input= ',wlix(nes:iend)
! print'(a18,40f7.3)',' AOT input= ',aoti(nes:iend)
! do i=nes,iend
! write(10) d1,d2,wlix(i),aoti(i),float(irec),log(wlix(i)),log(aoti(i)),float(ityp)
! enddo
call aotspline(nwi,aoti(nes:iend),wlix(nes:iend),nwo,wlo,aoto)
! print'(a18,500f7.3)','Wavelength Out= ',wlo
! print'(a18,500f7.3)',' AOT Out= ',aoto
return
end subroutine
!===================================================================
!===================================================================
real function rlnintrp(x1,x2,y1,y2, x) 2
implicit none
real :: x, x1, x2, y1, y2, dx, dy, dx1, yy
dx= log(x2) - log(x1)
dy= log(y2) - log(y1)
dx1=log(x) - log(x1)
yy= (dy/dx) * dx1
rlnintrp = exp(log(y1)+yy)
return
end function
!====================================================================
subroutine aotspline(nwi,aoti,wli,nwo,wlo,aoto) 1,2
implicit none
integer :: nwi, nwo
real ,dimension(nwi) :: aoti,wli
real ,dimension(nwi+1):: xa,ya,y2a
real ,dimension(nwo) :: aoto,wlo,aa
integer :: nwi2, iwo
real :: x, y
real :: yp1 = 1.0E+32, ypn = 1.0E+32
nwi2=nwi+1
xa(2:nwi+1)=log(wli(1:nwi))
ya(2:nwi+1)=log(aoti(1:nwi))
xa(1)=log(1.0E-6) !; xa(nwi2)=log(1.0E+6) !TENSION
ya(1)=0 !; ya(nwi2)= ya(nwi+1)!TENSION
call spline(xa,ya,nwi2,yp1,ypn,y2a)
do iwo = 1,nwo
x=log(wlo(iwo))
call splint(xa,ya,y2a,nwi2,x,y)
aoto(iwo)=exp(y)
enddo
return
end subroutine
!------------------------------------------------------
real function alphav(aot1,aot2,wl1,wl2)
implicit none
real :: aot1, aot2, wl1, wl2, ar, wr
ar= aot1/aot2
wr= wl1/wl2
alphav = - log(ar)/ log(wr)
return
end function
!---------------------------------------------------------------
SUBROUTINE spline(x,y,n,yp1,ypn,y2) 4
implicit none
INTEGER :: n
REAL :: yp1,ypn,x(n),y(n),y2(n)
INTEGER :: i,k
REAL :: p,qn,sig,un,u(500)
if (yp1.gt..99e30) then
y2(1)=0.
u(1)=0.
else
y2(1)=-0.5
u(1)=(3./(x(2)-x(1)))*((y(2)-y(1))/(x(2)-x(1))-yp1)
endif
do i=2,n-1
sig=(x(i)-x(i-1))/(x(i+1)-x(i-1))
p=sig*y2(i-1)+2.
y2(i)=(sig-1.)/p
u(i)=(6.*((y(i+1)-y(i))/(x(i+1)- &
& x(i))-(y(i)-y(i-1))/(x(i)-x(i-1)))/(x(i+1)-x(i-1))- &
& sig*u(i-1))/p
11 end do
if (ypn.gt..99e30) then
qn=0.
un=0.
else
qn=0.5
un=(3./(x(n)-x(n-1)))*(ypn-(y(n)-y(n-1))/(x(n)-x(n-1)))
endif
y2(n)=(un-qn*u(n-1))/(qn*y2(n-1)+1.)
do k=n-1,1,-1
y2(k)=y2(k)*y2(k+1)+u(k)
12 end do
return
END SUBROUTINE
!C (C) Copr. 1986-92 Numerical Recipes Software .
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SUBROUTINE splint(xa,ya,y2a,n,x,y) 1,1
implicit none
INTEGER :: n
REAL :: x,y,xa(n),y2a(n),ya(n)
INTEGER :: k,khi,klo
REAL :: a,b,h
klo=1
khi=n
do while (khi-klo.gt.1)
k=(khi+klo)/2
if(xa(k).gt.x)then
khi=k
else
klo=k
endif
end do
h=xa(khi)-xa(klo)
if (h.eq.0.) CALL wrf_error_fatal('bad xa input in splint. STOP program') !mchen
a=(xa(khi)-x)/h
b=(x-xa(klo))/h
y=a*ya(klo)+b*ya(khi)+((a**3-a)*y2a(klo)+(b**3-b)*y2a(khi))*(h** &
& 2)/6.
return
END subroutine
!C (C) Copr. 1986-92 Numerical Recipes Software .
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
SUBROUTINE polint(xa,ya,n,x,y,dy),2
implicit none
INTEGER :: n
REAL :: dy,x,y,xa(n),ya(n)
INTEGER :: i,m,ns
REAL :: den,dif,dift,ho,hp,w,c(10),d(10)
ns=1
dif=abs(x-xa(1))
do i=1,n
dift=abs(x-xa(i))
if (dift.lt.dif) then
ns=i
dif=dift
endif
c(i)=ya(i)
d(i)=ya(i)
11 end do
y=ya(ns)
ns=ns-1
do m=1,n-1
do i=1,n-m
ho=xa(i)-x
hp=xa(i+m)-x
w=c(i+1)-d(i)
den=ho-hp
if(den.eq.0.) CALL wrf_error_fatal('failure in polint. STOP program') !mchen
den=w/den
d(i)=hp*den
c(i)=ho*den
12 end do
if (2*ns.lt.n-m)then
dy=c(ns+1)
else
dy=d(ns)
ns=ns-1
endif
y=y+dy
13 end do
return
END SUBROUTINE
!C (C) Copr. 1986-92 Numerical Recipes Software .
!=============================================================
!ccc
subroutine ql_rh(rh,tl,pl,ql) 1,1
implicit none
real :: rh, tl, pl, ql
real :: es, ws
! rh (0-100)
! tl (K)
! pl (mb)
! q (g/g)
es=satvap(tl)
ws=0.622*es/(pl-es)
rh= ql/ws *100.
return
end subroutine
!--------------------------------------------------------------------
real function satvap(temp2) 2
implicit none
real :: temp2, temp, toot, toto, eilog, tsot, &
& ewlog, ewlog2, ewlog3, ewlog4
temp = temp2-273.155
if (temp.lt.-20.) then !!!! ice saturation
toot = 273.16 / temp2
toto = 1 / toot
eilog = -9.09718 * (toot - 1) - 3.56654 * (log(toot) / &
& log(10.)) + .876793 * (1 - toto) + (log(6.1071) / log(10.))
satvap = 10 ** eilog
else
tsot = 373.16 / temp2
ewlog = -7.90298 * (tsot - 1) + 5.02808 * &
& (log(tsot) / log(10.))
ewlog2 = ewlog - 1.3816e-07 * &
& (10 ** (11.344 * (1 - (1 / tsot))) - 1)
ewlog3 = ewlog2 + .0081328 * &
& (10 ** (-3.49149 * (tsot - 1)) - 1)
ewlog4 = ewlog3 + (log(1013.246) / log(10.))
satvap = 10 ** ewlog4
end if
return
end function
!-----------------------------------------------------------------------
subroutine aerosol_init(nv,nv1,pp,pt,ph,po,dz, & 2,15
a_tau1,a_ssa1,a_asy1, &
a_tau2,a_ssa2,a_asy2, &
a_wlis,a_taus,aprofs &
)
!c
!c 8/14/95, 4/1/97 , 2/10/2000
!c
!c **********************************************************************
!c Subroutine to create aerosol optical properties. There are several
!c inputs and 6 outputs.
!c
!c INPUTS FROM COMMON BLOCKS OR HEADER FILE:
!c
!c a_tau(nwi) : The input column aerosol optical depth
!c (real) (common block "aer_tau" - see header file).
!c
!c a_wli(nwi) : Wavelength in microns corresponding to aerosol tau in "a_tau"
!c
!c aprof(# layers): The input aerosol optical depth profile - LAYERS
!c (real) (common block "aer_prof").
!c
!c itp: Aerosol type, given in header file rad_0598.h.
!c
!c ifg: The table will compute vertical distributions based on
!c (integer) relative humidity (see explanation below). If ifg is
!c set to 0, each layer will have properties calculated
!c based on the relative humidity of that layer. If ifg
!c is set equal to another integer (1 through the number of
!c relative humidities given in the block data "aerosol")
!c the routine will calculate a vertical profile of optical
!c properties based on the relative humidity corresponding
!c to the index given. The indices are: 1: 0%; 2: 50%;
!c 3: 70%; 4: 80%; 5:90%; 6: 95%; 7: 98%; and 8: 99%.
!c If the number of relative humidities changes, these
!c numbers will have to be modified.
!c
!c ivd: Vertical tau distribution flag. If set to zero, the
!c distribution is based on Jim Spinhirne's marine
!c distribution formulation, and no user input is required.
!c If set to one, the user's own vertical distribution is
!c used, and must be present in the array aprof(nlayers).
!c NOTE: This vertical distribution is used as a weighting
!c factor ONLY, to distribute input column optical depths!
!c
!c----------------------------------------------------------------------------
!c a_ssa, a_ext, a_asy: Input single-scattering albedos, extinction
!c coefficients, and asymmetry parameters. These variables
!c are dimensioned (# of bands, # of relative humidities, &
!c # of aerosol types). An x or y is appended on these
!c variable names: if x, the numbers correspond to the 18
!c original bands. If y, the numbers are for the 10
!c sub-intervals in the first shortwave band (.2-.7 microns).
!c All of these variables come from the block data statements
!c aerosol# (# corresponds to an integer, eg. aerosol1) and
!c are in common blocks aer_optx and aer_opty.
!c
!c nv,mb,pp,pt,ph,dz: number of layers, number of bands, and the
!c pressure, temperature, humidity and thickness profiles.
!c These are shared by several subroutines.
!c
!c OUTPUTS:
!c
!c a_tau1,a_ssa1,a_asy1: The optical depth, single-scattering albedo, &
!c and asymmetry parameter vertical profiles for 18 bands. These
!c are dimensioned (nvx, 18) These are in the common block
!c aer_initx, which is shared by the subroutine "aerosolx".
!c
!c a_tau2,a_ssa2,a_asy2: Properties for SW band 1's 10 subintervals.
!c These are dimensioned (nvx, 10) These are in the common block
!c aer_inity, which is shared by the subroutine "aerosoly".
!c
!c **********************************************************************
!c USE RadParams
!# include "para.file"
USE PARA_FILE
USE control_para
USE aerosol1
USE aerosol2
!c include 'para.file'
!c## include 'rad_0698.h'
!c implicit none
implicit none
integer :: nv, nv1
real, dimension(nv1) :: pp, pt, ph, po
real :: dz(nv)
integer :: iq,mtop,n,m,ict,ix,iy,irh,krh,iac,itp
! real, dimension(mbx,nrh,naer) :: a_ssax,a_extx,a_asyx
! real, dimension(mby,nrh,naer) :: a_ssay,a_exty,a_asyy
real, dimension(nvx) :: tauxxx
real, dimension(nvx,mbx,mxac) :: a_tau1,a_ext1,a_ssa1,a_asy1
real, dimension(nvx,mby,mxac) :: a_tau2,a_ext2,a_ssa2,a_asy2
real ,dimension(nvx) :: taux1,taux2,rh,ht,rhp
real :: sumxxx
real,dimension(mxat) :: a_wli,a_tau
real,dimension(nvx) :: aprof
real,dimension(nvx,mbx) :: wvd_x
real,dimension(nvx,mby) :: wvd_y
real :: p1,h1,z,sig,tp
real :: rhx(nrh) = (/0.,50.,70.,80.,90.,95.,98.,99./)
real :: wts(4) = (/.23015,.28274,.25172,.23539/)
real :: tau3(2),tau3y(4)
real :: aotf(15),wlf(15),sump,rirh
! real, external :: spinhirne_sig, spinhirne_tau
! real :: spinhirne_sig, spinhirne_tau
real,dimension(mxat,mxac) :: a_wlis,a_taus
real,dimension(nvx,mxac) :: aprofs
!c Initialize.
rh = -9999.
a_ssa1 = 0. ; a_ext1 = 0. ; a_asy1 = 0. ; a_tau1 = 0.
a_ssa2 = 0. ; a_ext2 = 0. ; a_asy2 = 0. ; a_tau2 = 0.
if (n_atau<0 .or.n_atau>mxat) CALL wrf_error_fatal('errro in Aerosol Tau / Wavelengths. STOP program') !mchen
if (ifg < 0 .or. ifg > 8) CALL wrf_error_fatal('Error in ifg: Aerosol RH% Flag. STOP program') !mchen
AEROSOL_CONSTITUENTS : do iac = 1,mxac
if (itps(iac).eq.1) then
a_wli(1:n_atau) = a_wlis(1:n_atau,iac)
a_tau(1:n_atau) = a_taus(1:n_atau,iac)
aprof(1:nv) = aprofs(1:nv,iac)
itp = iac
if ( itp < 1 .or. itp > naer ) CALL wrf_error_fatal('Error in itp: bad Aerosol type. STOP program') !mchen
! print*,'CONSTITUENTS',iac,itp
! FOR Aerosol Optical Properties types that are constant with RH
if (itp==1 .or. itp==2 .or. itp==3 .or. &
& itp==10 .or. itp==12 .or.itp==13 .or. itp==18 ) then
!! Has already been filled in Block data
else
do krh=2,8
a_extx(1:mbx,krh,itp)= a_extx(1:mbx,1,itp)
a_ssax(1:mbx,krh,itp)= a_ssax(1:mbx,1,itp)
a_asyx(1:mbx,krh,itp)= a_asyx(1:mbx,1,itp)
a_exty(1:mby,krh,itp)= a_exty(1:mby,1,itp)
a_ssay(1:mby,krh,itp)= a_ssay(1:mby,1,itp)
a_asyy(1:mby,krh,itp)= a_asyy(1:mby,1,itp)
enddo
endif
! if ( ifg .ne.0) print*,'CHECK',ifg,itp,a_ssax(1:mbx,ifg,itp)
!c ******************************************************************
!c Calculate heights at center of layer - find highest layer to place
!c aerosols (15 km) - calculate relative humidities of each layer as
!c needed. Values of RH > 99% will be set equal to 99% to make table
!c lookup easier. "mtop" is the highest aerosol layer.
!c ******************************************************************
z=0.
m=nv
iq=0
do while (iq.eq.0 .and. m.ge.1)
ht(m)=(z*2.+dz(m))/2.
z=z+dz(m)
if (z.gt.15.) then
iq=1
mtop=m
endif
p1=(pp(m)+pp(m+1))/2.
tp=(pt(m)+pt(m+1))/2.
h1=(ph(m)+ph(m+1))/2.
call ql_rh(rh(m),tp,p1,h1)
if (rh(m).gt.98.9) rh(m)=98.9
if ((rh(m).lt..01).and.(rh(m).gt.-999.)) rh(m)=0.
m=m-1
end do
!c *************************************************************
!c Calculate vertical distribution of asymmetry, ss albedo and
!c extinction, based on aerosol type and relative humidity.
!c If ifg is not equal to 0, parameters will corresponds to a
!c single RH, as described in header file. Loop 31 deals with
!c the 18 original bands, loop 32 with the 10 band 1 subintervals.
!c *************************************************************
do m=mtop,nv
do n=1,mbx
if (rh(m).eq.-9999.) then
a_ext1(m,n,iac)=-9999.
a_ssa1(m,n,iac)=-9999.
a_asy1(m,n,iac)=-9999.
else
if (ifg.eq.0) then ! Dependence on layer RH.
ict=2
do while (rh(m).ge.rhx(ict))
ict=ict+1
end do
a_ext1(m,n,iac)=a_extx(n,ict-1,itp)+(rh(m)-rhx(ict-1))/ &
& (rhx(ict)-rhx(ict-1))*(a_extx(n,ict,itp)-a_extx(n,ict-1,itp))
a_ssa1(m,n,iac)=a_ssax(n,ict-1,itp)+(rh(m)-rhx(ict-1))/ &
& (rhx(ict)-rhx(ict-1))*(a_ssax(n,ict,itp)-a_ssax(n,ict-1,itp))
a_asy1(m,n,iac)=a_asyx(n,ict-1,itp)+(rh(m)-rhx(ict-1))/ &
& (rhx(ict)-rhx(ict-1))*(a_asyx(n,ict,itp)-a_asyx(n,ict-1,itp))
rhp(m) = rh(m)
else ! Dependence on prescribed RH.
a_ext1(m,n,iac)=a_extx(n,ifg,itp)
a_ssa1(m,n,iac)=a_ssax(n,ifg,itp)
a_asy1(m,n,iac)=a_asyx(n,ifg,itp)
endif
endif
end do
!-------------------------------------------
do n=1,mby
if (rh(m).eq.-9999.) then
a_ext2(m,n,iac)=-9999.
a_ssa2(m,n,iac)=-9999.
a_asy2(m,n,iac)=-9999.
else
if (ifg.eq.0) then ! Dependence on layer RH.
ict=2
do while (rh(m).ge.rhx(ict))
ict=ict+1
end do
a_ext2(m,n,iac)=a_exty(n,ict-1,itp)+(rh(m)-rhx(ict-1))/ &
& (rhx(ict)-rhx(ict-1))*(a_exty(n,ict,itp)-a_exty(n,ict-1,itp))
a_ssa2(m,n,iac)=a_ssay(n,ict-1,itp)+(rh(m)-rhx(ict-1))/ &
& (rhx(ict)-rhx(ict-1))*(a_ssay(n,ict,itp)-a_ssay(n,ict-1,itp))
a_asy2(m,n,iac)=a_asyy(n,ict-1,itp)+(rh(m)-rhx(ict-1))/ &
& (rhx(ict)-rhx(ict-1))*(a_asyy(n,ict,itp)-a_asyy(n,ict-1,itp))
else ! Dependence on prescribed RH.
a_ext2(m,n,iac)=a_exty(n,ifg,itp)
a_ssa2(m,n,iac)=a_ssay(n,ifg,itp)
a_asy2(m,n,iac)=a_asyy(n,ifg,itp)
endif
endif
end do
end do
!c ******************************************************************
!c Vertical distribution of aerosol optical depths - CAGEX and CERES.
!c --------------------------------------------------------------
!c Use Spinhirne's vertical distribution of scattering properties
!c to calculate vertical distribution of optical depths. The
!c distribution gives a scattering coefficient ("sig"). Use this,
!c along with the single-scattering albedo, to produce an
!c RH-dependent extinction coefficient (extx, exty, etc.), from
!c which optical depth is calculated (taux, tauy, etc.). This
!c optical depth is summed (sum1, sumy2, sum, etc.) to give
!c column tau for weighting purposes.
!c --------------------------------------------------------------
select case (ivd)
case default
CALL wrf_error_fatal('ivd : Aerosol Profile flag. STOP program') !mchen
case (0) !! DEFAULT VERTICAL DISTRIBUTION Spinhirne
sumxxx=0.0
do m=mtop,nv
sig = spinhirne_sig( ht(m))
tauxxx(m) = spinhirne_tau(sig,a_ssa2(m,9,iac),dz(m))
sumxxx = sumxxx + tauxxx(m)
! print*,m,sig,a_ssa2(m,9,iac)
enddo
do m=mtop,nv
tauxxx(m) = tauxxx(m) / sumxxx
!!! aprofs(m,iac) = tauxxx(m) !! See what the Sphinhirne profiles look like
enddo
! ----------------------------------------------------------------
case (1:2) ! USER'S OWN VERTICAL DISTRIBUTION IVD=1 & 2
sump = sum( aprof(mtop:nv) )
tauxxx(mtop:nv)= aprof(mtop:nv) / sump
if(sump.eq.0.) CALL wrf_error_fatal('No VERTICAL Profile OF AEROSOL TAU. STOP program') !mchen
end select
!c ********************************************************************
!c IAFORM=2
!c
!c Distribute optical depth spectrally into the first 2 Fu-Liou bands.
!c Band 1 will consist of the first 4 MFRSR bands, weighted with
!c respect to energy. Band two will be the fifth MFRSR band.
!c
!c Also, distribute optical depths into 4 of the 10 band 1 subintervals.
!c Subinterval 7 is directly inserted, since there is one MFRSR
!c measurement within the range of this band. Subintervals 7 and 8
!c straddle the .497 micron MFRSR measurement, so interpolated values
!c are inserted into these, using .409 and .497 measurements for 7, and
!c .497 and .606 for 8. Subinterval 10 contains two MFRSR measurements,
!c so it is filled using an energy-weighted average. This is all
!c hardwired, so we need all of the MFRSR bands (.409, .497, .606, and
!c .661) for it to work. (The .855 micron band is also needed, but not
!c for this interval distribution.
!c ********************************************************************
select case ( iaform )
case default
CALL wrf_error_fatal('iaform : Bad value of iaform . STOP program') !mchen
case(1) ! CERES
!! No operations necessary
case(2) ! For CAGEX
tau3(1)=a_tau(1)*wts(1)+a_tau(2)*wts(2)+ &
& a_tau(3)*wts(3)+a_tau(4)*wts(4)
tau3(2)=a_tau(5)
tau3y(1)=a_tau(1) ! For subinterval 7 of 1st band (.409)
tau3y(2)=a_tau(1)+.6705*(a_tau(2)-a_tau(1)) ! Subi 8 of band 1
tau3y(3)=a_tau(2)+.4541*(a_tau(3)-a_tau(2)) ! Subi 9 of band 1
tau3y(4)=a_tau(3)*.5175+a_tau(4)*.4825 ! Subi 10 of band 1
case(3) ! For AOT_SPLINEFIT
if ( ifg == 0 ) then ! Find Aerosol weighted collumn mean RH index
rirh=0
do m =mtop,nv
rirh = rirh + rhp(m)* tauxxx(m) !! Aerosol Profile weighted mean RH
! print*,m,rhp(m),tauxxx(m)
enddo
irh =1
do ix= 1,7
if( rirh >= rhx(ix) .and. rirh < rhx(ix+1) ) irh=ix
enddo
if( rirh >= rhx(8) ) irh =8
else ! Use assigned RH index
irh = ifg
endif
! Can't handle ZERO in Log interpolation
where ( a_tau .lt. 1.0E-20) a_tau = 1.0E-20
call atau_spline_iaform3(a_wli,a_tau,aotf,wlf,irh,itp)
! write(22,'(a20,15f8.3)') 'AOT in Fu Bands',aotf(1:15)
!!! A!OUNT FOR VERTICAL EXTINCTION VARIABILITY WITH HUMIDITY ABOUT THE MEAN RH "irh"
!!! ( IAFORM==3) only
do iy = 1,mby
wvd_y(mtop:nv,iy)=tauxxx(mtop:nv) &
& *a_ext2(mtop:nv,iy,iac)/a_exty(iy,irh,itp)
sump = sum( wvd_y(mtop:nv,iy) )
wvd_y(mtop:nv,iy) = wvd_y(mtop:nv,iy) /sump
enddo
do ix = 1,mbx
wvd_x(mtop:nv,ix)=tauxxx(mtop:nv) &
& *a_ext1(mtop:nv,ix,iac)/a_extx(ix,irh,itp)
sump = sum( wvd_x(mtop:nv,ix) )
wvd_x(mtop:nv,ix) = wvd_x(mtop:nv,ix) /sump
enddo
end select
! ----------------------------------------------------------------
!c Use weighted optical depths to distribute our input
!c column optical depths vertically and spectrally where needed.
!c For bands with "measured" input, we simply do the weighting.
!c For the remaining bands, we weight according to our vertically
!c distributed extinction coefficients (calculated in loop 30),
!c which carry all the spectral resolution we need. a_tau1 is for
!c the 18 original bands, a_tau2 is for the 10 band 1 subintervals.
! ----------------------------------------------------------------
VERTICAL : do m=mtop,nv
select case ( iaform )
case(1) ! For CERES
a_tau1(m,1,iac) = a_tau(1) * tauxxx(m)
a_tau1(m,2:18,iac)= a_tau1(m,1,iac)* &
& a_ext1(m,2:18,iac)/a_ext1(m,1,iac)
a_tau2(m,9,iac) = a_tau(1) * tauxxx(m)
a_tau2(m,1:10,iac)=a_tau2(m,9,iac)* &
& a_ext2(m,1:10,iac)/a_ext2(m,9,iac)
case(2) ! For CAGEX
a_tau1(m,1:2,iac) = tau3(1:2) * tauxxx(m)
a_tau1(m,3:18,iac)=a_tau1(m,2,iac)* &
& a_ext1(m,3:18,iac)/a_ext1(m,2,iac)
a_tau2(m,7:10,iac) = tau3y(1:4) * tauxxx(m)
a_tau2(m,1:6,iac) = a_tau2(m,7,iac)* &
& a_ext2(m,1:6,iac)/a_ext2(m,7,iac)
case(3) ! For AOT_SPLINEFIT
! a_tau2(m,1:10,iac) = aotf(1:10) * tauxxx(m)
a_tau2(m,1:10,iac) = aotf(1:10) * wvd_y(m,1:10)
! a_tau1(m,1,iac) = aotf(9) * tauxxx(m)
a_tau1(m,1,iac) = aotf(9) * wvd_x(m,1)
! a_tau1(m,2:6,iac) = aotf(11:15) * tauxxx(m)
a_tau1(m,2:6,iac) = aotf(11:15) * wvd_x(m,2:6)
a_tau1(m,7:18,iac) =a_tau1(m,2,iac)* &
& a_ext1(m,7:18,iac)/a_ext1(m,2,iac)
end select
! print'(3I4,2f8.2,16f7.3)', m,iac,itp,dz(m),rh(m),
! & (wvd_y(m,iy),iy=1,10),(wvd_x(m,ix),ix=1,6)
enddo VERTICAL
!------------------------------------------------------------------------------
!!!--- Diagnostic Output of Atau
! do ii=1,10
! xxx=0
! do jj=1,nv
! xxx =xxx+ a_tau2(jj,ii,iac)
! enddo
! aotf(ii)=xxx
! enddo
! do ii=2,6
! xxx=0
! do jj=1,nv
! xxx =xxx+ a_tau1(jj,ii,iac)
! enddo
! aotf(9+ii)=xxx
! enddo
! write(22,'(a20,15f8.3)') 'AOT in Fu Bands',aotf(1:15)
end if
enddo AEROSOL_CONSTITUENTS
return
end subroutine
!===========================================================================
subroutine aerosolxy ( nv, nv1, ib,cmode,a_tau1,a_ssa1,a_asy1, & 1,2
a_tau2,a_ssa2,a_asy2,tae,wae,wwae &
)
!c *********************************************************************
!c Modified 2/14/00
!c
!c tae, wae, and wwae are the optical depth, single scattering albedo, &
!c and expansion coefficients of the phase function ( 1, 2, 3, and 4 )
!c due to the Mie scattering of aerosols for a given layer.
!c
!c This subroutine is called for bands 2 - 18 (ib)
!c or vis subbands 1-10 (ig)
!c *********************************************************************
!c USE RadParams
!# include "para.file"
USE PARA_FILE
USE control_para
!c include 'para.file'
implicit none
integer :: nv, nv1
character*1 :: cmode
integer :: i,ib,iac
real :: x1,x2,x3,x4,y1,y2,y3,y4
real ,dimension(nvx,18,mxac) :: a_tau1,a_ssa1,a_asy1
real ,dimension(nvx,10,mxac) :: a_tau2,a_ssa2,a_asy2
real :: tae(nvx,mxac), wae(nvx,mxac), wwae(nvx,4,mxac)
AEROSOL_CONSTITUENTS : do iac=1,mxac
if (itps(iac).eq.1) then
LEVELS : do i = 1, nv
select case (cmode)
case ('x')
tae(i,iac) = a_tau1(i,ib,iac)
wae(i,iac) = a_ssa1(i,ib,iac)
x1 = a_asy1(i,ib,iac)
case ('y')
tae(i,iac) = a_tau2(i,ib,iac)
wae(i,iac) = a_ssa2(i,ib,iac)
x1 = a_asy2(i,ib,iac)
end select
x2 = x1 * x1
x3 = x2 * x1
x4 = x3 * x1
y1 = 3.0 * x1
y2 = 5.0 * x2
y3 = 7.0 * x3
y4 = 9.0 * x4
wwae(i,1,iac) = y1
wwae(i,2,iac) = y2
wwae(i,3,iac) = y3
wwae(i,4,iac) = y4
enddo LEVELS
end if
enddo AEROSOL_CONSTITUENTS
return
end subroutine
!----------------------------------------------------------------
real function spinhirne_sig(ht) 1
implicit none
real :: ht
real :: sig0 = 0.025 , &
& a = 0.4 , &
& ap = 2981.0, &
& b = 1.6 , &
& bp = 2.5 , &
& f = 1.5e-7
real t1, t2, t3, t4, t5, t6
t1= sig0*(1+a)**2
t4 = f*(1+ap)**2
t2 = exp(ht/b)
t3 = (a+exp(ht/b))**2
t5 = exp(ht/bp)
t6 = (a+exp(ht/bp))**2
spinhirne_sig=t1*t2/t3+t4*t5/t6 ! scattering coefficient
return
end function spinhirne_sig
!---------------------------------------------
real function spinhirne_tau(sig,ssa,dz) 1
implicit none
real sig, ssa, dz, ext
ext = sig / ssa
spinhirne_tau = ext / dz
return
end function spinhirne_tau
! ************ end of subroutines **************!
!*****************************************************************
subroutine o3prof (iprof, kts, kte, p, o3) 2,1
USE module_ozone
implicit none
integer iprof, kts, kte
integer k, kk, ks, ke
real p(kts:kte), o3(kts:kte), lp(kts:kte), lpres(np)
! Statement function
real Linear, x1, y1, x2, y2, x
Linear(x1, y1, x2, y2, x) = &
(y1 * (x2 - x) + y2 * (x - x1)) / (x2 - x1)
!
do k = 1,np
lpres(k) = alog(pres(k,iprof))
enddo
do k = kts,kte
lp(k) = alog(p(k))
end do
ks = kts
ke = kte
do while (lp(ke).le.lpres(1))
o3(ke) = Linear (lpres(1), ozone(1,iprof), &
lpres(2), ozone(2,iprof), &
lp(ke))
if (o3(ke).lt.0.0) o3(ke) = 0.0
ke = ke - 1
end do
do while (lp(ks).ge.lpres(np))
o3(ks) = Linear (lpres(np), ozone(np,iprof), &
lpres(np-1), ozone(np-1,iprof), &
lp(ks))
if (o3(ks).lt.0.0) o3(ks) = 0.0
ks = ks + 1
end do
kk = np
do k = ks, ke
do while (lp(k).lt.lpres(kk).and.kk.gt.1)
kk = kk - 1
end do
o3(k) = Linear (lpres(kk), ozone(kk,iprof), &
lpres(kk+1), ozone(kk+1,iprof), &
lp(k))
end do
end subroutine o3prof
END MODULE module_ra_FLG