[an error occurred while processing this directive] [an error occurred while processing this directive]
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