co2 (ppmv), ch4 (ppbv), n2o (ppbv), f11 (pptv), f12 (pptv), adj (unitless), semis (Tg S/yr)
c##############################################################################
subroutine ramp
C-----------------------------------------------------------------------
C
C Computes scale factor for ramping sulfate mass mixing ratios and the
C trace gas volume mixing ratios via interpolation of yearly input data.
C
C-----------------------------------------------------------------------
c
c $Id: implicit.h,v 1.1.14.1 1998/04/02 23:08:46 rosinski Exp $
c $Author: rosinski $
c
implicit none
C-----------------------------------------------------------------------
c
c $Id: pmgrid.h,v 1.1.2.1 1998/04/02 23:10:51 rosinski Exp $
c $Author: rosinski $
c
C
C Grid point resolution parameters
C
integer plon ! number of longitudes
integer plev ! number of vertical levels
integer plat ! number of latitudes
integer pcnst ! number of constituents (including water vapor)
integer pnats ! number of non-advected trace species
integer plevmx ! number of subsurface levels
C
integer plevp ! plev + 1
integer nxpt ! no.of pts outside active domain of interpolant
integer jintmx ! number of extra latitudes in polar region
integer plond ! slt extended domain longitude
integer platd ! slt extended domain lat.
integer p3d ! dimensioning construct: num. of 3-d flds in /com3d/
C
integer plevd ! fold plev,pcnst indices into one
integer i1 ! model starting longitude index
integer j1 ! model starting latitude index
integer numbnd ! no.of latitudes passed N and S of forecast lat
C
integer beglat ! beg. index for latitudes owned by a given proc
integer endlat ! end. index for latitudes owned by a given proc
integer beglatex ! extended grid beglat
integer endlatex ! extended grid endlat
integer numlats ! number of latitudes owned by a given proc
C
logical masterproc ! Flag for (iam eq 0)
C
parameter (plon = 128)
parameter (plev = 18)
parameter (plat = 64)
parameter (pcnst = 6)
parameter (pnats = 0)
parameter (plevmx = 4)
parameter (plevp = plev + 1)
parameter (nxpt = 1)
parameter (jintmx = 1)
parameter (plond = plon + 1 + 2*nxpt)
parameter (platd = plat + 2*nxpt + 2*jintmx)
parameter (p3d = 3 + pcnst + pnats)
parameter (plevd = plev*p3d)
parameter (i1 = 1 + nxpt)
parameter (j1 = 1 + nxpt + jintmx)
parameter (numbnd = nxpt + jintmx)
C
parameter (beglat = 1)
parameter (endlat = plat)
parameter (numlats = plat)
parameter (beglatex = 1)
parameter (endlatex = platd)
parameter (masterproc = .true.)
C
c
c $Id: pagrid.h,v 1.1.2.1 1998/04/02 23:10:50 rosinski Exp $
c $Author: rosinski $
c
C
C Model grid point resolution parameters.
C
integer plnlv ! Length of multilevel field slice
integer plndlv ! Length of multilevel 3-d field slice
integer pbflnb ! Length of buffer 1
integer pbflna ! Length of buffer 2
integer pbflnm1 ! Length of buffer m1
C
integer pflenb ! Length of buffer 1, padded for unblocked I/O
integer pflena ! Length of buffer 2, padded for unblocked I/O
integer plenalcl ! Length of buffer 2, needed in SPEGRD
integer ptifld ! No. of fields on time-invariant bndary dataset
integer ptvsfld ! No. of fields on time-variant boundary dataset
C
integer plenhi ! Length of integer header record
integer plenhc ! Length of character header record
integer plenhr ! Length of real header record
integer plexbuf ! Len. of communication buffer for flux coupling
C
integer ptapes ! Maximum number of history tapes allowed
integer pflds ! Maximum number of fields in all history files
integer ptileni ! Length of time-invariant integer header
integer ptilenc ! Length of time-invariant character header
C
integer ptvsleni ! Length of time-variant integer header
integer ptvslenc ! Length of time-variant character header
integer plenhis ! Length of integer header scalars
integer plenhcs ! Length of character header scalars
C
integer ptilenis ! Length of time-invariant integer scalars
integer ptilencs ! Length of time-invariant character scalars
integer ptolenis ! Length of ozone integer header scalars
integer ptolencs ! Length of ozone character header scalars
integer ptslenis ! Length of time-variant integer header scalars
integer ptslencs ! Length of time-variant character header scalars
C
parameter(plnlv=plon*plev,plndlv=plond*plev)
C
C In pbflnb, 9 multi-level fields include the plev levels of plol and
C plos. 2 multi-level fields are pcnst-dependent.
C PJR added 3 multi and 3 singl.
C
parameter(pbflnb=(10 + 2*pcnst + 1*pnats)*plndlv +
$ (8+pcnst)*plond)
C
C In pbflna, there are 3 multi-level and 3 single-level fields.
C
parameter(pbflna = (3 + 3*plev)*plond)
parameter(pbflnm1 = (1 + 2*plev)*plond)
parameter(pflenb = ((pbflnb + pbflnm1)/512 + 1)*512)
parameter(pflena = (pbflna/512 + 1)*512)
C
C plenalcl is the buffer size as required in SPEGRD.
C Only pflena is read/written.
C
parameter(plenalcl = ((pbflna + 2*plndlv + plond)/512 + 1)*512)
parameter(plexbuf = (((1 + 6*plev)*plond)/512+1)*512)
parameter(ptapes = 6)
C
C Maximum total number of fields in all history files
C (primary and auxillary files)
C
parameter(pflds=1000)
C
C Add 2 extra fields for tvbds 6 April 1995
C
parameter(ptifld = 11, ptvsfld = 3)
C
C There are 37 scalar words in the integer header and 89 scalar words
C in the character header
C
parameter(plenhis=37)
parameter(plenhcs=89)
C
parameter(plenhi=plenhis+3*pflds)
parameter(plenhc=plenhcs+2*pflds)
parameter(plenhr=3*(2*plev + 1) + 2*plat)
parameter(ptilenis=plenhis)
parameter(ptilencs=plenhcs)
C
parameter(ptileni=ptilenis+3*ptifld)
parameter(ptilenc=ptilencs+2*ptifld)
parameter(ptolenis=plenhis)
parameter(ptolencs=plenhcs)
C
parameter(ptslenis=plenhis)
parameter(ptslencs=plenhcs)
parameter(ptvsleni=ptslenis+3*ptvsfld)
parameter(ptvslenc=ptslencs+2*ptvsfld)
C
c
c $Id: pspect.h,v 1.1.2.1 1998/04/02 23:09:35 rosinski Exp $
c $Author: rosinski $
c
C
C Parameters related to spectral domain
C
integer ptrm ! M truncation parameter
integer ptrn ! N truncation parameter
integer ptrk ! K truncation parameter
integer pmax ! Number of diagonals
integer pmaxp ! Number of diagonals plus 1
integer pnmax ! Number of values of N
integer pmmax ! Number of values of M
integer par0 ! Intermediate parameter
integer par2 ! Intermediate parameter
integer pspt ! Total no. of complex spectral coeff's retained
integer psp ! 2 * pspt (real) size of coeff array per level
C
parameter(ptrm=42 ,ptrn=42 ,ptrk=42)
parameter(pmax=ptrn+1 ,pmaxp=pmax+1 ,pnmax=ptrk+1 ,pmmax=ptrm+1)
parameter(par0=ptrm+ptrn-ptrk ,par2=par0*(par0+1)/2)
parameter(pspt=(ptrn+1)*pmmax-par2 ,psp=2*pspt)
C
C-----------------------------------------------------------------------
logical fixYear ! true => Ramped gases fixed at specified year.
common /ramp_l/ fixYear
integer rampYear ! ramped gases fixed at this year
common /ramp_i/ rampYear
C-----------------------------------------------------------------------
C
C Molecular weights
C
real mwdry ! molecular weight dry air
real mwco2 ! molecular weight co2
real mwh2o ! molecular weight h2o
real mwn2o ! molecular weight n2o
real mwch4 ! molecular weight ch4
real mwf11 ! molecular weight cfc11
real mwf12 ! molecular weight cfc12
parameter (mwdry = 29.)
parameter (mwco2 = 44.)
parameter (mwh2o = 18.)
parameter (mwn2o = 44.)
parameter (mwch4 = 16.)
parameter (mwf11 = 136.)
parameter (mwf12 = 120.)
C
C Ratios of molecular weights
C
real rmwn2o ! ratio of molecular weight n2o to dry air
real rmwch4 ! ratio of molecular weight ch4 to dry air
real rmwf11 ! ratio of molecular weight cfc11 to dry air
real rmwf12 ! ratio of molecular weight cfc12 to dry air
real rmwco2 ! ratio of molecular weight co2 to dry air
real rh2och4 ! ratio of molecular weight h2o to ch4
parameter (rmwco2 = mwco2/mwdry)
parameter (rmwn2o = mwn2o/mwdry)
parameter (rmwch4 = mwch4/mwdry)
parameter (rmwf11 = mwf11/mwdry)
parameter (rmwf12 = mwf12/mwdry)
parameter (rh2och4= mwh2o/mwch4)
C
C Volume mixing ratios
C
real co2vmr ! co2 volume mixing ratio
real n2ovmr ! n2o volume mixing ratio
real ch4vmr ! ch4 volume mixing ratio
real f11vmr ! cfc11 volume mixing ratio
real f12vmr ! cfc12 volume mixing ratio
common /commrat/ co2vmr, n2ovmr, ch4vmr, f11vmr, f12vmr
C-----------------------------------------------------------------------
c
c $Id: crdcon.h,v 1.1.2.1 1998/04/02 23:12:11 rosinski Exp $
c $Author: rosinski $
c
C
C Radiation constants
C
common/crdcon/gravit ,rga ,cpair ,epsilo ,sslp ,
$ stebol ,rgsslp ,co2mmr ,dpfo3 ,dpfco2 ,
$ dayspy ,pie
C
real gravit ! Acceleration of gravity
real rga ! 1./gravit
real cpair ! Specific heat of dry air
real epsilo ! Ratio of mol. wght of H2O to dry air
real sslp ! Standard sea-level pressure
real stebol ! Stefan-Boltzmann's constant
real rgsslp ! 0.5/(gravit*sslp)
real co2mmr ! CO2 mass mixing ratio
real dpfo3 ! Voigt correction factor for O3
real dpfco2 ! Voigt correction factor for CO2
real dayspy ! Number of days per 1 year
real pie ! 3.14.....
C
C-----------------------------------------------------------------------
c
c $Id: comtim.h,v 1.1.2.1 1998/04/02 23:09:16 rosinski Exp $
c $Author: rosinski $
c
C
C Model time variables
C
common/comtim/calday ,dtime ,twodt ,divdampn,nrstrt ,
$ nstep ,nstepr ,nestep ,nelapse ,nstop ,
$ mdbase ,msbase ,mdcur ,mscur ,mbdate ,
$ mbsec ,mcdate ,mcsec ,nndbas ,nnsbas ,
$ nnbdat ,nnbsec ,doabsems,dosw ,dolw
C
real calday ! Current calendar day = julian day + fraction
real dtime ! Time step in seconds (delta t)
real twodt ! 2 * delta t
real divdampn ! Number of days to invoke divergence damper
integer nrstrt ! Starting time step of restart run (constant)
integer nstep ! Current time step
integer nstepr ! Current time step of restart (updated w/nstep)
integer nestep ! Time step on which to stop run
integer nelapse ! Requested elapsed time for model run
integer nstop ! nestep + 1
integer mdbase ! Base day of run
integer msbase ! Base seconds of base day
integer mdcur ! Current day of run
integer mscur ! Current seconds of current day
integer mbdate ! Base date of run (yymmdd format)
integer mbsec ! Base seconds of base date
integer mcdate ! Current date of run (yymmdd format)
integer mcsec ! Current seconds of current date
integer nndbas ! User input base day
integer nnsbas ! User input base seconds of input base day
integer nnbdat ! User input base date (yymmdd format)
integer nnbsec ! User input base seconds of input base date
logical doabsems ! True => abs/emiss calculation this timestep
logical dosw ! True => shortwave calculation this timestep
logical dolw ! True => longwave calculation this timestep
C
C---------------------------Local variables-----------------------------
integer ntim
parameter(ntim=130)
real semis_ref ! reference value for sulfer emissions (1985)
parameter (semis_ref = 65.0) ! Hardwired as per discussion with Byron (1May98)
integer yrmodel ! model year
integer yrdata(ntim) ! yearly data values
integer nyrm ! year index
integer nyrp ! year index
real doymodel ! model day of year
real doydatam ! day of year for input data yrdata(nyrm)
real doydatap ! day or year for input data yrdata(nyrp)
real deltat ! delta time
real fact1, fact2 ! time interpolation factors
real cfcscl ! cfc scale factor for f11
real co2(ntim) ! input co2 in ppmv
real ch4(ntim) ! input ch4 in ppbv
real n2o(ntim) ! input n2o in ppbv
real f11(ntim) ! input cfc11 in pptv
real f12(ntim) ! input cfc12 in pptv
real adj(ntim) ! input adjustment factor for f11 and f12
real semis(ntim) ! input Global sulfer emissisions (Tg S/yr)
C Input data values
data yrdata /
$ 1870 ,1871 ,1872 ,1873 ,1874 ,
$ 1875 ,1876 ,1877 ,1878 ,1879 ,
$ 1880 ,1881 ,1882 ,1883 ,1884 ,
$ 1885 ,1886 ,1887 ,1888 ,1889 ,
$ 1890 ,1891 ,1892 ,1893 ,1894 ,
$ 1895 ,1896 ,1897 ,1898 ,1899 ,
$ 1900 ,1901 ,1902 ,1903 ,1904 ,
$ 1905 ,1906 ,1907 ,1908 ,1909 ,
$ 1910 ,1911 ,1912 ,1913 ,1914 ,
$ 1915 ,1916 ,1917 ,1918 ,1919 ,
$ 1920 ,1921 ,1922 ,1923 ,1924 ,
$ 1925 ,1926 ,1927 ,1928 ,1929 ,
$ 1930 ,1931 ,1932 ,1933 ,1934 ,
$ 1935 ,1936 ,1937 ,1938 ,1939 ,
$ 1940 ,1941 ,1942 ,1943 ,1944 ,
$ 1945 ,1946 ,1947 ,1948 ,1949 ,
$ 1950 ,1951 ,1952 ,1953 ,1954 ,
$ 1955 ,1956 ,1957 ,1958 ,1959 ,
$ 1960 ,1961 ,1962 ,1963 ,1964 ,
$ 1965 ,1966 ,1967 ,1968 ,1969 ,
$ 1970 ,1971 ,1972 ,1973 ,1974 ,
$ 1975 ,1976 ,1977 ,1978 ,1979 ,
$ 1980 ,1981 ,1982 ,1983 ,1984 ,
$ 1985 ,1986 ,1987 ,1988 ,1989 ,
$ 1990 ,1991 ,1992 ,1993 ,1994 ,
$ 1995 ,1996 ,1997 ,1998 ,1999 /
data co2 / ! ppmv
$ 289.263, 289.416, 289.577, 289.745, 289.919,
$ 290.102, 290.293, 290.491, 290.696, 290.909,
$ 291.129, 291.355, 291.587, 291.824, 292.066,
$ 292.313, 292.563, 292.815, 293.071, 293.328,
$ 293.586, 293.843, 294.098, 294.350, 294.598,
$ 294.842, 295.082, 295.320, 295.558, 295.797,
$ 296.038, 296.284, 296.535, 296.794, 297.062,
$ 297.338, 297.620, 297.910, 298.204, 298.504,
$ 298.806, 299.111, 299.419, 299.729, 300.040,
$ 300.352, 300.666, 300.980, 301.294, 301.608,
$ 301.923, 302.237, 302.551, 302.863, 303.172,
$ 303.478, 303.779, 304.075, 304.366, 304.651,
$ 304.930, 305.206, 305.478, 305.746, 306.013,
$ 306.280, 306.546, 306.815, 307.087, 307.365,
$ 307.650, 307.943, 308.246, 308.560, 308.887,
$ 309.228, 309.584, 309.956, 310.344, 310.749,
$ 311.172, 311.614, 312.077, 312.561, 313.068,
$ 313.599, 314.154, 314.737, 315.347, 315.984,
$ 316.646, 317.328, 318.026, 318.742, 319.489,
$ 320.282, 321.133, 322.045, 323.021, 324.060,
$ 325.155, 326.299, 327.484, 328.698, 329.933,
$ 331.194, 332.499, 333.854, 335.254, 336.690,
$ 338.150, 339.628, 341.125, 342.650, 344.206,
$ 345.797, 347.397, 348.980, 350.551, 352.100,
$ 353.636, 354.46, 355.86, 356.56, 358.45 ,
$ 360.47, 362.14, 363.98, 365.86, 367.82 /
data ch4 / ! ppbv
$ 901.355, 903.486, 905.637, 907.809, 910.001,
$ 912.213, 914.445, 916.697, 918.969, 921.262,
$ 923.575, 925.908, 928.261, 930.635, 933.029,
$ 935.443, 937.877, 940.331, 942.805, 945.300,
$ 947.815, 950.350, 952.905, 955.481, 958.077,
$ 960.693, 963.329, 965.985, 968.661, 971.358,
$ 974.075, 976.812, 979.569, 982.347, 985.145,
$ 987.963, 990.801, 993.659, 996.537, 999.436,
$ 1002.355, 1005.294, 1008.253, 1011.233, 1014.233,
$ 1017.253, 1020.293, 1023.353, 1026.433, 1029.534,
$ 1032.655, 1035.796, 1038.957, 1042.139, 1045.341,
$ 1048.563, 1051.805, 1055.067, 1058.349, 1061.652,
$ 1064.975, 1068.318, 1071.681, 1075.065, 1078.469,
$ 1081.893, 1085.337, 1088.801, 1092.285, 1095.790,
$ 1099.325, 1102.968, 1106.796, 1110.819, 1115.037,
$ 1119.451, 1124.060, 1128.865, 1133.864, 1139.059,
$ 1144.450, 1150.035, 1155.816, 1161.792, 1167.964,
$ 1174.414, 1181.578, 1189.860, 1199.279, 1209.776,
$ 1221.286, 1233.749, 1247.103, 1261.286, 1276.237,
$ 1291.892, 1308.192, 1325.074, 1342.476, 1360.336,
$ 1378.593, 1397.185, 1416.049, 1435.126, 1454.351,
$ 1473.665, 1493.005, 1512.308, 1531.514, 1550.561,
$ 1569.302, 1587.137, 1603.569, 1618.667, 1632.584,
$ 1645.476, 1657.498, 1668.806, 1679.553, 1689.896,
$ 1700.000, 1710.234, 1720.943, 1732.080, 1743.612,
$ 1755.507, 1767.774, 1780.418, 1793.410, 1806.725/
data n2o / ! ppbv
$ 281.351, 281.459, 281.568, 281.676, 281.784,
$ 281.892, 282.000, 282.108, 282.216, 282.324,
$ 282.432, 282.541, 282.649, 282.757, 282.865,
$ 282.973, 283.081, 283.189, 283.297, 283.405,
$ 283.514, 283.622, 283.730, 283.838, 283.946,
$ 284.054, 284.162, 284.270, 284.378, 284.486,
$ 284.595, 284.703, 284.811, 284.919, 285.027,
$ 285.135, 285.243, 285.351, 285.459, 285.568,
$ 285.676, 285.784, 285.892, 286.000, 286.108,
$ 286.216, 286.324, 286.432, 286.541, 286.649,
$ 286.757, 286.865, 286.973, 287.081, 287.189,
$ 287.297, 287.405, 287.514, 287.622, 287.730,
$ 287.838, 287.946, 288.054, 288.162, 288.270,
$ 288.378, 288.486, 288.595, 288.703, 288.811,
$ 288.919, 289.027, 289.135, 289.243, 289.351,
$ 289.459, 289.568, 289.676, 289.784, 289.892,
$ 290.018, 290.186, 290.381, 290.588, 290.808,
$ 291.039, 291.282, 291.537, 291.803, 292.082,
$ 292.372, 292.674, 292.988, 293.314, 293.652,
$ 294.037, 294.500, 295.000, 295.500, 296.000,
$ 296.500, 297.000, 297.500, 298.000, 298.500,
$ 299.000, 299.500, 300.000, 300.500, 301.000,
$ 301.500, 302.000, 302.500, 303.000, 303.500,
$ 304.075, 304.800, 305.600, 306.400, 307.200,
$ 308.000, 308.801, 309.607, 310.424, 311.250,
$ 312.086, 312.934, 313.795, 314.670, 315.558/
data f11 / ! pptv
$ 0.0000 ,0.0000 ,0.0000 ,0.0000 ,0.0000 ,
$ 0.0000 ,0.0000 ,0.0000 ,0.0000 ,0.0000 ,
$ 0.0000 ,0.0000 ,0.0000 ,0.0000 ,0.0000 ,
$ 0.0000 ,0.0000 ,0.0000 ,0.0000 ,0.0000 ,
$ 0.0000 ,0.0000 ,0.0000 ,0.0000 ,0.0000 ,
$ 0.0000 ,0.0000 ,0.0000 ,0.0000 ,0.0000 ,
$ 0.0000 ,0.0000 ,0.0000 ,0.0000 ,0.0000 ,
$ 0.0000 ,0.0000 ,0.0000 ,0.0000 ,0.0000 ,
$ 0.0000 ,0.0000 ,0.0000 ,0.0000 ,0.0000 ,
$ 0.0000 ,0.0000 ,0.0000 ,0.0000 ,0.0000 ,
$ 0.0000 ,0.0000 ,0.0000 ,0.0000 ,0.0000 ,
$ 0.0000 ,0.0000 ,0.0000 ,0.0000 ,0.0000 ,
$ 0.0000 ,0.0000 ,0.0000 ,0.0000 ,0.0000 ,
$ 0.0000 ,0.0000 ,0.0000 ,0.0000 ,0.01000 ,
$ 0.01000 ,0.01000 ,0.02000 ,0.02000 ,0.03000 ,
$ 0.04000 ,0.05000 ,0.08000 ,0.13000 ,0.23000 ,
$ 0.40000 ,0.63000 ,0.96000 ,1.4400 ,2.0700 ,
$ 2.8600 ,3.8300 ,5.0300 ,6.3700 ,7.5900 ,
$ 8.8100 ,10.440 ,12.550 ,15.200 ,18.450 ,
$ 22.300 ,26.660 ,31.510 ,36.990 ,43.210 ,
$ 50.410 ,58.820 ,68.270 ,79.000 ,91.400 ,
$ 105.12 ,118.19 ,130.66 ,142.86 ,153.92 ,
$ 163.49 ,172.26 ,180.82 ,188.67 ,197.22 ,
$ 206.06 ,215.24 ,225.80 ,237.18 ,247.38 ,
$ 255.61 ,263.70 ,267.82 ,270.17 ,270.97 ,
$ 270.87 ,270.19 ,269.72 ,268.96 ,267.94 /
data f12 / ! pptv
$ 0.0000 ,0.0000 ,0.0000 ,0.0000 ,0.0000 ,
$ 0.0000 ,0.0000 ,0.0000 ,0.0000 ,0.0000 ,
$ 0.0000 ,0.0000 ,0.0000 ,0.0000 ,0.0000 ,
$ 0.0000 ,0.0000 ,0.0000 ,0.0000 ,0.0000 ,
$ 0.0000 ,0.0000 ,0.0000 ,0.0000 ,0.0000 ,
$ 0.0000 ,0.0000 ,0.0000 ,0.0000 ,0.0000 ,
$ 0.0000 ,0.0000 ,0.0000 ,0.0000 ,0.0000 ,
$ 0.0000 ,0.0000 ,0.0000 ,0.0000 ,0.0000 ,
$ 0.0000 ,0.0000 ,0.0000 ,0.0000 ,0.0000 ,
$ 0.0000 ,0.0000 ,0.0000 ,0.0000 ,0.0000 ,
$ 0.0000 ,0.0000 ,0.0000 ,0.0000 ,0.0000 ,
$ 0.0000 ,0.0000 ,0.0000 ,0.0000 ,0.0000 ,
$ 0.0000 ,0.0000 ,0.0000 ,0.0000 ,0.0100 ,
$ 0.0200 ,0.0400 ,0.0600 ,0.1000 ,0.1600 ,
$ 0.2400 ,0.3500 ,0.4900 ,0.6700 ,0.8800 ,
$ 1.1700 ,1.5500 ,2.2200 ,3.2400 ,4.4200 ,
$ 5.6900 ,7.0800 ,8.6000 ,10.160 ,11.920 ,
$ 13.910 ,16.130 ,18.710 ,21.660 ,24.730 ,
$ 28.150 ,32.240 ,36.810 ,42.060 ,48.190 ,
$ 55.320 ,63.370 ,72.300 ,82.360 ,94.210 ,
$ 107.96 ,123.02 ,139.18 ,156.72 ,176.18 ,
$ 197.22 ,217.36 ,236.41 ,254.20 ,270.21 ,
$ 286.69 ,303.60 ,320.09 ,336.09 ,352.72 ,
$ 370.10 ,387.83 ,406.13 ,424.91 ,444.14 ,
$ 462.67 ,481.09 ,493.66 ,505.03 ,513.77 ,
$ 520.35 ,523.77 ,528.35 ,531.51 ,533.62 /
data adj / ! unitless
$ 0.000 , 0.000 , 0.000 , 0.000 , 0.000 ,
$ 0.000 , 0.000 , 0.000 , 0.000 , 0.000 ,
$ 0.000 , 0.000 , 0.000 , 0.000 , 0.000 ,
$ 0.000 , 0.000 , 0.000 , 0.000 , 0.000 ,
$ 0.000 , 0.000 , 0.000 , 0.000 , 0.000 ,
$ 0.000 , 0.000 , 0.000 , 0.000 , 0.000 ,
$ 0.000 , 0.000 , 0.000 , 0.000 , 0.000 ,
$ 0.000 , 0.000 , 0.000 , 0.000 , 0.000 ,
$ 0.000 , 0.000 , 0.000 , 0.000 , 0.000 ,
$ 0.000 , 0.000 , 0.000 , 0.000 , 0.000 ,
$ 0.000 , 0.000 , 0.000 , 0.000 , 0.000 ,
$ 0.000 , 0.000 , 0.000 , 0.000 , 0.000 ,
$ 0.000 , 0.000 , 0.000 , 0.000 , 0.000 ,
$ 0.000 , 0.000 , 0.000 , 0.000 , 0.000 ,
$ 0.000 , 0.000 , 0.000 , 0.000 , 0.000 ,
$ 0.000 , 0.000 , 0.000 , 0.000 ,32.000 ,
$ 34.000 ,36.000 ,19.500 ,13.667 ,8.6000 ,
$ 7.3333 ,5.7500 ,4.2727 ,3.4286 ,3.0000 ,
$ 2.8421 ,2.4348 ,2.1071 ,1.8788 ,1.6098 ,
$ 1.4490 ,1.3051 ,1.2464 ,1.1975 ,1.1368 ,
$ 1.0721 ,1.0388 ,0.98667 ,0.92529 ,0.87065 ,
$ 0.83550 ,0.80385 ,0.79443 ,0.78981 ,0.79351 ,
$ 0.81111 ,0.83377 ,0.85176 ,0.86988 ,0.88249 ,
$ 0.90066 ,0.91772 ,0.93360 ,0.95019 ,0.97426 ,
$ 1.0107 ,1.08966 ,1.11885 ,1.15320 ,1.17282 ,
$ 1.18960 ,1.20707 ,1.21585 ,1.23311 ,1.30153 /
data semis / ! Tg S/yr
$ 2.18 ,2.36 ,2.54 ,2.72 ,2.9 ,
$ 3.08 ,3.26 ,3.44 ,3.62 ,3.8 ,
$ 3.98 ,4.222 ,4.464 ,4.706 ,4.948 ,
$ 5.19 ,5.432 ,5.674 ,5.916 ,6.158 ,
$ 6.4 ,6.761 ,7.122 ,7.483 ,7.844 ,
$ 8.205 ,8.566 ,8.927 ,9.288 ,9.649 ,
$ 10.01 ,10.545 ,11.08 ,11.615 ,12.15 ,
$ 12.685 ,13.22 ,13.755 ,14.29 ,14.825 ,
$ 15.36 ,15.601 ,15.842 ,16.083 ,16.324 ,
$ 16.565 ,16.806 ,17.047 ,17.288 ,17.529 ,
$ 17.77 ,18.018 ,18.266 ,18.514 ,18.762 ,
$ 19.01 ,19.258 ,19.506 ,19.754 ,20.002 ,
$ 20.25 ,20.525 ,20.8 ,21.075 ,21.35 ,
$ 21.625 ,21.9 ,22.175 ,22.45 ,22.725 ,
$ 23. ,23.528 ,24.056 ,24.584 ,25.112 ,
$ 25.64 ,26.168 ,26.696 ,27.224 ,27.752 ,
$ 28.28 ,29.794 ,31.308 ,32.822 ,34.336 ,
$ 35.85 ,37.364 ,38.878 ,40.392 ,41.906 ,
$ 43.42 ,45.384 ,47.348 ,49.312 ,51.276 ,
$ 53.24 ,55.204 ,57.168 ,59.132 ,61.096 ,
$ 63.06 ,63.821 ,64.582 ,65.343 ,66.104 ,
$ 66.865 ,67.626 ,68.387 ,69.148 ,69.909 ,
$ 70.67 ,71.1242 ,71.5785 ,72.0327 ,72.4869 ,
$ 72.9412 ,73.1671 ,73.393 ,73.6189 ,73.8448 ,
$ 74.0707 ,74.0707 ,74.8608 ,75.2558 ,75.6509 ,
$ 76.0459 ,76.2434 ,76.4410 ,76.6385 ,76.8360 /
c
c ---------------------------------------------------------------------
c
c determine index into input data
c
if ( fixYear ) then
yrmodel = rampYear
else
yrmodel = mcdate/10000
end if
nyrm = yrmodel - yrdata(1) + 1
nyrp = nyrm + 1
c
c if current date is before 1870, quit
c
if (nyrm .lt. 1) then
write(6,*)'RAMP: data time index is out of bounds'
write(6,*)'nyrm = ',nyrm,' nyrp= ',nyrp, ' mcdate= ', mcdate
call endrun
endif
c
c if current date later than 1998, just use 1998 values
c
if (nyrp .gt. ntim) then
co2vmr = co2(ntim)*1.e-06
ch4vmr = ch4(ntim)*1.e-09
n2ovmr = n2o(ntim)*1.e-09
cfcscl = adj(ntim)
f11vmr = f11(ntim)*1.e-12*(1.+cfcscl)
f12vmr = f12(ntim)*1.e-12
call setso4ramp( semis(ntim)/semis_ref )
co2mmr = rmwco2 * co2vmr
return
endif
c
c determine time interpolation factors, check sanity
c of interpolation factors to within 32-bit roundoff
c assume that day of year is 1 for all input data
c
doymodel = yrmodel*365. + calday
doydatam = yrdata(nyrm)*365. + 1.
doydatap = yrdata(nyrp)*365. + 1.
deltat = doydatap - doydatam
fact1 = (doydatap - doymodel)/deltat
fact2 = (doymodel - doydatam)/deltat
if (abs(fact1+fact2-1.).gt.1.e-6 .or.
$ fact1.gt.1.000001 .or. fact1.lt.-1.e-6 .or.
$ fact2.gt.1.000001 .or. fact2.lt.-1.e-6) then
write(6,*)'RAMP: Bad fact1 and/or fact2=',fact1,fact2
call endrun
end if
c
c do time interpolation:
c co2 in ppmv
c n2o,ch4 in ppbv
c f11,f12 in pptv
c
co2vmr = (co2(nyrm)*fact1 + co2(nyrp)*fact2)*1.e-06
ch4vmr = (ch4(nyrm)*fact1 + ch4(nyrp)*fact2)*1.e-09
n2ovmr = (n2o(nyrm)*fact1 + n2o(nyrp)*fact2)*1.e-09
cfcscl = (adj(nyrm)*fact1 + adj(nyrp)*fact2)
f11vmr = (f11(nyrm)*fact1 + f11(nyrp)*fact2)*1.e-12*(1.+cfcscl)
f12vmr = (f12(nyrm)*fact1 + f12(nyrp)*fact2)*1.e-12
call setso4ramp((semis(nyrm)*fact1 + semis(nyrp)*fact2)/semis_ref)
co2mmr = rmwco2 * co2vmr
write(6,'(a,f8.2,6(1pe22.14))') 'calday1 = ',calday
$ ,co2vmr/1.e-06
$ ,ch4vmr/1.e-09
$ ,n2ovmr/1.e-09
write(6,'(a,f8.2,6(1pe22.14))') 'calday2 = ',calday
$ ,cfcscl
$ ,(f11(nyrm)*fact1 + f11(nyrp)*fact2)
$ ,f12vmr/1.e-12
return
end
subroutine setso4ramp( x )
c Set so4 ramp value.
implicit none
C-----------------------------------------------------------------------
c
c $Id: pmgrid.h,v 1.1.2.1 1998/04/02 23:10:51 rosinski Exp $
c $Author: rosinski $
c
C
C Grid point resolution parameters
C
integer plon ! number of longitudes
integer plev ! number of vertical levels
integer plat ! number of latitudes
integer pcnst ! number of constituents (including water vapor)
integer pnats ! number of non-advected trace species
integer plevmx ! number of subsurface levels
C
integer plevp ! plev + 1
integer nxpt ! no.of pts outside active domain of interpolant
integer jintmx ! number of extra latitudes in polar region
integer plond ! slt extended domain longitude
integer platd ! slt extended domain lat.
integer p3d ! dimensioning construct: num. of 3-d flds in /com3d/
C
integer plevd ! fold plev,pcnst indices into one
integer i1 ! model starting longitude index
integer j1 ! model starting latitude index
integer numbnd ! no.of latitudes passed N and S of forecast lat
C
integer beglat ! beg. index for latitudes owned by a given proc
integer endlat ! end. index for latitudes owned by a given proc
integer beglatex ! extended grid beglat
integer endlatex ! extended grid endlat
integer numlats ! number of latitudes owned by a given proc
C
logical masterproc ! Flag for (iam eq 0)
C
parameter (plon = 128)
parameter (plev = 18)
parameter (plat = 64)
parameter (pcnst = 6)
parameter (pnats = 0)
parameter (plevmx = 4)
parameter (plevp = plev + 1)
parameter (nxpt = 1)
parameter (jintmx = 1)
parameter (plond = plon + 1 + 2*nxpt)
parameter (platd = plat + 2*nxpt + 2*jintmx)
parameter (p3d = 3 + pcnst + pnats)
parameter (plevd = plev*p3d)
parameter (i1 = 1 + nxpt)
parameter (j1 = 1 + nxpt + jintmx)
parameter (numbnd = nxpt + jintmx)
C
parameter (beglat = 1)
parameter (endlat = plat)
parameter (numlats = plat)
parameter (beglatex = 1)
parameter (endlatex = platd)
parameter (masterproc = .true.)
C
C-----------------------------------------------------------------------
!
! Floating point data
!
real sulfbioi(plon,plev,plat,2) ! input sulfate bio mixing ratios
real sulfbio (plond,plev,plat) ! time imterpolated sulfate bio mixing ratios
real sulfanti(plon,plev,plat,2) ! input sulfate ant mixing ratios
real sulfant (plond,plev,plat) ! time imterpolated sulfate ant mixing ratios
real sulfscalef ! Sulfate scale factor (for 1870->1990 ramp)
real cdaysulfm ! calendar day for prv. month sulfate values read in
real cdaysulfp ! calendar day for nxt. month sulfate values read in
common /sulf_r/ sulfbioi, sulfanti, sulfbio, sulfant, sulfscalef,
$ cdaysulfm, cdaysulfp
!
! Pointers to dynamic memory
!
pointer (pdate_sulf,date_sulf)
pointer (psec_sulf ,sec_sulf )
integer date_sulf(*) ! Date on sulfate dataset (YYYYMMDD)
integer sec_sulf(*) ! seconds of date on sulfate dataset (0-86399)
common/sulf_date/ pdate_sulf, psec_sulf
!
! Integer data
!
integer nm,np ! Array indices for prv., nxt month sulfate data
integer np1 ! current forward time index of sulfate dataset
integer ncid_sulf ! sulfate dataset id
integer sulfbio_id ! netcdf id for sulfate mmr bio variable
integer sulfant_id ! netcdf id for sulfate mmr anth variable
integer lonsiz ! size of longitude dimension on sulfate dataset
integer levsiz ! size of level dimension on sulfate dataset
integer latsiz ! size of latitude dimension on sulfate dataset
integer timsiz ! size of time dimension on sulfate dataset
common/sulf_i/nm, np, np1, ncid_sulf, sulfbio_id, sulfant_id,
$ lonsiz, levsiz, latsiz, timsiz
!
! Logical variables
!
logical sulfcyc
common/ sulf_l/ sulfcyc
character*80 sulfdata ! full pathname for sulfate dataset
common /sulf_c/ sulfdata
C-----------------------------------------------------------------------
c Input arg.
real x ! sulfate scale factor computed in ramp subroutine
C-----------------------------------------------------------------------
sulfscalef = x
return
end