-
Notifications
You must be signed in to change notification settings - Fork 0
A java translation of the most recent form of Bob Berner's GEOCARBSULFVOLC with added functionality for testing variations in input parameters along their expected deviations. This version itself is based on a fortran translation of the original model, which was created by Jeff Park (http://earth.geology.yale.edu/~jjpark/Code/gcsv10_export.f) an…
spencerewall/GEOCARBON
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Folders and files
Name | Name | Last commit message | Last commit date | |
---|---|---|---|---|
Repository files navigation
------------------------------------------------------------------------ This is a Java version of Jefferey Park's GEOCARBSULF fortran code converted in turn from Bob Burner's basic code of the same name. The file name "gcsv" stands for GeoCarbSulfVolc. ------------------------------------------------------------------------ PROJECT TITLE: GEOCARBSULF AUTHORS: SPENCER J. EWALL When running it is reccomended that javas heap size be increased. This can be achieved with the command: java -Xmx512m -cp .:Libraries/jsc.jar GCSVDriver The following is the original fortran code: c program gcsv10_export.f c fortran version of bob berner's GEOCARBSULF BASIC code c gcsv10 stands for GeoCarbSulfVolc algorithm for 2010 c THIS CODE CAN READ EITHER THE 2006/7 proxy-CO2 data file c OR THE 2010 DATA FILE. c 8/17/2010 -- confirmed the VNV parameter as 4, though Berner asked for 5, c as motivated by Aaron Taylors thesis -- but other Taylor source is vnv=3 c this code developed in MacOS 10.4, using gcc compiler, c takes 90minutes to run on a 2006-vintage Macbook Pro with 2 GHz Intel Core Duo processor c takes 45minutes to run on a 2009-vintage Macbook Pro with 2.53 GHz Intel Core 2 Duo processor c -- looped over range of input parameters, set up to fit proxy data for CO2 ppm c 11/22/06 JJP c proxy data has uncertainties that are sometimes large. To make the data-fitting robust, c compute chi-squared using an uncertainty in the log-domain. c xf77 -o /Users/jjpark/bin/gcsv10_export gcsv10_export.f /Users/jjpark/Plotxy/plotlib.a c c code uses plotit, a standalone fortran/C plotting subroutine in Xwindows c this code can be found on JPark's website http://earth.geology.yale.edu/~jjpark/Code/plotit.tar c c code updated from the code used for the paper c c Royer, D. L., Berner, R. A., and Park, J., 2007, Climate sensitivity constrained by carbon c dioxide concentrations over the last 420 million years: Nature, v.446, p.530-532. c c and used for this paper c c Park, J., and D. L. Royer, Geologic constraints on the glacial amplification of Phanerozoic c climate sensitivity, American J. Science, V.311, 2011, P. 1-26, DOI 10.2475/01.2011.01 c c there are many test computations in Park and Royer (2011) that were effected c with modified versions of this gcsv10_export.f?code c c Output of this code is written to two files c outoutout.dat is a simple table of CO2proxy data values averaged in 10My intervals c out_gcsv10.dat is a large ASCII file (>50 Mb) that contains the GEOCARB carbon-cycle simulations c for all parameter choices. This allows the user to examine the statistical behavior of the c carbon-cycle simulations offline this code (e.g. in gcsv_ppdf.f) c c code converted from BASIC to run grid search over parameters c Newton-Raphson damping applied here, to avoid NaN. c divergent transition over 380-350My is interpolated better, c correcting earlier convergence error c the code reads a file proxydata.txt that contains proxy CO2 PPM data c the GEOCARBSULF carbon-cycle model is computed at time steps of 1-My from 570Ma to present c the proxy data ranges only from 420Ma to the present c c Five nested loops comprise the heart of the code, from outermost to innermost c DeltaT = temp increase with CO2 doubling c ACT = dimensionless activation-energy for silicate weathering c FERT = plant CO2-fertilization coefficient c LIFE = liverwort-based weathering factor -- less than vascular plants c GYM = gymnosperm-based weathering factor (1=angiosperm weathering parameter) c gymnosperms (e.g. conifers) might be better at weathering than angiosperms c c for each choice of parameters, we compute the carbon flux balance between terms c that depend on silicate weathering (fBBS) and carbon burial/degassing (fB), c each normalized with common factors derived by Bob Berner many years ago c The carbon-cycle balance depends on CO2 level, c because the weathering of silicates accelerates with warmer temps induced by greenhouse gases c c the code solves for the CO2 level that achieves the balance of carbon fluxes c The CO2-dependent parameter fB is calculated at each time step from carbon and c carbon isotope mass balance and values of all other parameters, based on c geological and biological data, that affect the carbon cycle. Then the value of c RCO2 (CO2 concentration normalized to the mean value for the past 1 million c years = 250 ppm) is calculated by inversion from a complex expression for fB based on the c greenhouse effect, CO2 fertilization of plant weathering, solar evolution, and c changes in land temperature). c c for detailed exposition of the theoretical GEOCARB models, see c c Berner, R. A., The Phanerozoic Carbon Cycle: CO2 and O2, 150pp. Oxford University Press, 2004. c c and a collection of GEOCARB and GEOCARBSULF papers published over the past decade by c Berner and Colleagues. c c Berner, R. A., 2006a, GEOCARBSULF: A combined model for Phanerozoic atmospheric O2 and CO2: c Geochimica et Cosmochimica Acta, v.70, p.5653-5664. c c Berner, R. A., 2006b, Inclusion of the weathering of volcanic rocks in the GEOCARBSULF model: c American Journal of Science, v.306, p.295-302, doi:10.2475/052006.01. c c Berner, R. A., 2008, Addendum to Inclusion of the weathering of volcanic rocks in the c GEOCARBSULF model (Berner, R. A., 2006, v.306, p.295-302) American Journal of Science, c v.308, p.100-103, doi:10.2475/01.2008.04. c c Berner, R. A., 2009, Phanerozoic atmospheric oxygen: New results using the GEOCARBSULF Model: c American Journal of Science, v.309, p.603-606, doi:10.2475/07.2009.03. c c The code computes the aggregate data fit of GEOCARBSULF for each choice c of the combined parameters, expressed as the fractional variance residual when expressed c in the log domain without uncertainty weighting. c description of the proxy data can be found in c c Royer et al, CO2 as a primary driver of Phanerozoic climate, GSA Today, March 2004. c c The data variance is expressed as the log-domain deviation from pre-industrial CO2-ppm c the code stores all the variance residuals for all parameter combinations and computes the c percentiles of the model runs at each value of DeltaT. The code also computes the fraction c of parameter space that achieves at most a chosen variance residual -- these fractions c are used to generate Bayesian PDFs. c c percentile curves and empirical Bayesian PDFs are written in out1.dat and out2.dat c implicit real*4 (a-h,o-z) implicit integer*4 (i-n) real*4 kwpy,kwgy,kwsy,kwcy,LIFE character*80 title,name common/gcs1/DLSOC(600),DLCOC(600),alphac(600), GEOG(600) common/gcs2/fA(600),fSR(600),fD(600),fL(600),S(600) common/gcs3/temp(600),fAD(600),xx(600) common/gcs20/fA0(58),fSR0(72),fD0(58),fL0(58),S0(60) common/gcs30/temp0(58),fAD0(60),DLS0(58),DLC0(58),al0(58) common/gcs4/Sr(600),R(600),DELTOT(600),DELRIV(600),Bas(600), x DELBAS(600),fR(600),SRBAS(600),Sr0(68),fRT(600) common/loop/pp(10,10,10,10,60),dum(10000),weight(10000),wt(10) common/percento/p01(90),p10(90),p33(90),p50(90), x p66(90),p90(90),p99(90),ama(90) common/percentp/q25(90),q30(90),q35(90),q40(90),qq25(90),qq30(90), x qq35(90),jkk(10,4,2) common/proxy/age0(800),iage0(800),ppm0(800),dppm0(800),aage(800) common/dataf/gcsppm(800),pppm(80),iage(80),age(80),dppm(80) c fA is the factor of past continental area, relative to modern (10My time steps) data fA0/1.0,1.0,1.0,1.0,0.91,0.92,0.94,0.87,0.79,0.81, x 0.82,0.85,0.88,0.86,0.84,0.83,0.85,0.87,0.89,0.91, x 0.91,0.90,0.90,0.88,0.89,0.86,0.84,0.81,0.81,0.80, x 0.80,0.80,0.79,0.77,0.76,0.73,0.70,0.69,0.69,0.72, x 0.74,0.74,0.74,0.62,0.63,0.67,0.62,0.62,0.62,0.65, x 0.65,0.66,0.64,0.66,0.85,0.90,0.95,1.00/ c data based on Christie, suggested by BobBerner -- gives bad results c data fA0/1.0,1.0,1.0,1.0,1.12,1.24,1.15,1.07,1.10,1.10,1.10, c x 1.10,1.10,1.10,1.10,1.10,1.10,1.10,1.10,1.10,1.10,1.10,1.10, c x 1.10,1.10,1.10,1.10,1.10,1.08,1.07,1.06,1.05,1.02,0.97,0.94, c x 0.90,0.85,0.80,0.75,0.70,0.65,0.60,0.55,0.50,0.46,0.46,0.46, c x 0.46,0.46,0.46,0.46,0.46,0.46,0.46,0.62,0.79,0.90,1.0/ c fD is the factor of water runoff per unit continental area, relative to modern data fD0/1.00,1.02,1.04,1.06,1.08,1.10,1.15,1.20,1.19,1.19, x 1.18,1.18,1.18,1.17,1.15,1.13,1.12,1.10,1.05,1.03, x 1.02,1.01,0.98,0.96,0.94,0.96,0.97,1.02,1.08,1.10, x 1.13,1.14,1.15,1.19,1.21,1.21,1.21,1.21,1.21,1.22, x 1.23,1.25,1.28,1.31,1.10,1.00,0.90,0.92,0.96,1.03, x 1.07,1.10,1.12,1.12,1.12,1.12,1.12,1.12/ c data based on Christie, suggested by BobBerner -- gives bad results c data fD0/1.00,1.02,1.04,1.06,1.08,1.16,1.16,1.17,1.18,1.18, c x 1.18,1.18,1.16,1.14,1.12,1.10,1.05,1.02,1.00,0.95,0.90,0.85, c x 0.80,0.75,0.70,0.65,0.68,0.72,0.75,0.78,0.81,0.83,0.85,0.87, c x 0.90,0.92,0.94,0.96,0.98,1.00,1.02,1.04,1.06,1.08,1.10,1.00, c x 0.90,0.92,0.96,1.03,1.07,1.10,1.12,1.12,1.12,1.12,1.12,1.12/ c temp0 is the average land temperature in past times, degrees C c used in defining the GEOG variable data temp0/12.4,12.4,12.4,12.5,12.5,12.5,11.6,11.0,11.2,11.3, x 11.5,11.7,11.9,12.0,12.4,12.8,13.1,13.4,13.7,14.0, x 14.2,14.2,14.1,14.1,14.1,14.3,14.2,13.9,13.7,13.5, x 13.3,13.1,13.0,13.0,12.9,13.0,13.1,13.3,13.4,13.5, x 12.5,11.5,10.5,12.5,15.0,17.0,18.2,17.0,16.3,15.5, x 14.5,13.5,13.0,13.0,13.0,12.0,12.0,12.0/ c data based on Christie, suggested by BobBerner -- gives bad results c data temp0/11.2,11.5,11.5,11.5,12.3,13.0,12.2,11.4,10.4,9.4,8.4, c x 8.4,8.4,8.4,8.4,8.4,8.4,8.5,8.6,8.7,8.8,8.9,9.0,9.1,9.2,9.3,9.6, c x 9.9,10.2,10.5,10.8,11.3,11.6,11.9,12.2,12.5,12.8,13.1,13.4, c x 13.7,14.0,14.2,14.5,14.7,15.5,15.5,15.5,15.5,15.5,15.5, c x 14.5,13.5,13.0,13.0,13.0,12.0,12.0,12.0/ c for the most recent 140My, the fSR parameter is given every 5My, not 10My c fSR is the factor twixt Sr isotopes and silicate weathering data fSR0/1.00,0.98,0.98,0.98,0.98,1.02,1.04,1.11,1.22,1.41, x 1.46,1.41,1.35,1.30,1.35,1.37,1.33,1.30,1.37,1.52, x 1.65,1.76,1.74,1.67,1.63,1.67,1.52,1.26,1.27,1.27, x 1.27,1.21,1.14,1.09,1.10,1.14,1.12,1.10,1.09,1.11, x 1.14,1.10,1.07,1.21,1.21,1.14,1.07,1.07,1.28,1.43, x 1.43,1.40,1.38,1.36,1.38,1.48,1.53,1.55,1.55,1.52, x 1.52,1.50,1.49,1.50,1.52,1.62,1.70,1.59,1.35,1.20,1.04,1.00/ c FOR T= 0 TO 579 c IF T=<140 AND INT(T/5)=T/5 THEN READ fSR(T) c IF T>140 AND INT(T/10)=T/10 THEN READ fSR(T) c IF T=<140 AND INT(T/5)<>T/5 THEN fSR(T)=fSR(T-1) c IF T>140 AND INT(T/10)<>T/10 THEN fSR(T)=fSR(T-1) c c Sulfur isotope data (d34S) below are from Kampschulte and Strauss (2004) data DLS0/20.0,21.0,21.0,21.0,21.0,19.0,18.0,17.5,17.8,17.5, x 15.0,15.0,15.3,16.3,16.2,16.0,17.0,17.0,18.0,18.5, x 16.0,16.0,17.5,18.0,22.0,20.0,12.0,12.5,12.5,12.2, x 13.5,14.8,15.5,14.5,15.5,17.0,25.0,24.5,20.0,19.0, x 22.0,27.0,26.5,26.0,26.7,25.5,25.0,24.3,26.0,30.0, x 27.8,35.3,36.4,33.0,30.3,32.0,34.4,35.2/ c FOR T = 0 TO 579 c IF INT(T/10)=T/10 THEN READ DLSOC(T) c IF INT (T/10)<>T/10 THEN DLSOC(T) =DLSOC(T-1) c NEXT T c Carbon isotope data (d13C) c following array is smoothed fit TO maximum Veizer data with smoothed Silurian bump c also data of Korte (Tr),Grossman et al Permo-Carb,Krischvink(Camb), Saltzman (Ord, Sil), c Van Geld (Devonian), Lindh (Jurassic to 0) c line 485 is 260-390 Ma c several changes to values in this array between 2006 and 2010 GEOCARBSULF versions data DLC0/1.50,1.70,2.00,2.20,2.20,2.20,2.30,2.40,2.40,2.50, x 2.60,2.70,2.50,2.00,1.20,1.70,1.54,1.38,1.22,1.06, x 2.00,2.50,3.50,2.50,2.00,1.00,4.00,4.70,4.40,4.70, x 4.40,4.60,3.20,2.50,2.90,2.80,1.40,1.00,1.00,1.50, x 0.50,2.00,1.50,1.00,0.70,0.00,0.00,-1.0,-1.0,1.00, x -1.0,-0.5,0.00,0.00,-2.0,0.00,0.00,0.00/ c data are from Hayes ey al (1999) c is difference in d13C between coexisting marine orgC and marine carbonate data al0/22.5,25.9,27.5,30.0,29.6,30.5,30.2,28.5,27.8,29.7, x 28.8,30.0,31.5,29.3,30.3,31.0,31.3,34.0,33.7,32.0, x 30.4,30.7,31.0,31.5,32.1,32.6,33.0,33.0,32.9,32.8, x 32.7,32.6,32.6,32.5,32.4,32.1,31.8,31.0,30.3,29.4, x 28.6,28.8,29.0,30.3,31.5,31.0,30.6,29.8,29.0,29.0, x 29.0,29.2,29.4,29.2,29.0,30.0,30.0,30.0/ c FOR T= 0 TO 579 c IF INT(T/10) =T/10 THEN READ alphac(T) c IF INT(T/10)<>T/10 THEN alphac(T)=alphac(T-1) c fL is the fraction of land area covered by carbonate rocks, normalized to modern data fL0/1.00,1.00,0.99,1.29,1.10,1.10,1.26,0.88,0.88,0.88, x 1.04,1.04,1.04,1.04,1.04,1.24,1.25,1.25,1.25,1.36, x 1.36,1.23,1.23,1.39,1.36,1.43,1.31,1.31,1.31,1.45, x 1.45,1.45,1.41,1.41,1.41,1.41,1.40,1.47,1.47,1.47, x 1.63,1.63,1.54,1.43,1.43,1.15,1.07,1.07,0.99,0.99, x 0.99,0.97,1.05,1.05,0.63,0.63,0.63,0.63/ c FOR T = 0 TO 579 c IF INT (T/10)=T/10 THEN READ fL(T) c IF INT (T/10)<>T/10 THEN fL(T) = fL(T-1) c Sr0 is specified every 5my to 100Ma, prior times is 10My spacing c Sr0 is the normalized difference of basalt-predicted and measured Sr isotope ratios c measured every 10 My data Sr0/92.0,90.5,89.5,89.0,85.0,82.5,81.0,79.0,78.0,78.0, x 78.0,78.0,78.5,79.0,78.0,77.0,76.0,75.5,75.0,75.0, x 74.0,73.0,72.0,73.0,71.0,69.0,68.0,69.0,75.0,76.0, x 75.0,78.0,78.0,78.0,75.0,73.0,71.0,77.0,82.0,83.0, x 82.0,82.0,81.0,78.0,75.0,78.0,82.0,82.0,78.0,80.0, x 85.0,87.0,86.0,81.0,79.0,78.0,80.0,82.0,85.0,87.0, x 89.0,89.0,89.0,89.0,90.0,90.0,90.0,90.0/ c FOR T=0 TO 579 c IF T >100 AND INT(T/10)=T/10 THEN READ Sr(T) c IF T>100 AND INT(T/10)<>T/10 THEN Sr(T)=Sr(T-1) c IF T=<100 AND INT(T/5)=T/5 THEN READ Sr(T) c IF T=<100 AND INT(T/5)<>T/5 THEN Sr(T)=Sr(T-1) c c here is a change in the weatherable land area in the Eocene (30-50 Ma) c and the Jurassic (150-200 Ma). fA0(1) is 0 Ma, fA0(2) is 10 Ma c reduc=0.5 c fA0(4)=fA0(4)*(1.0-reduc) c fA0(5)=fA0(5)*(1.0-reduc) c fA0(6)=fA0(6)*(1.0-reduc) c fA0(16)=fA0(16)*(1.0-reduc) c fA0(17)=fA0(17)*(1.0-reduc) c fA0(18)=fA0(18)*(1.0-reduc) c fA0(19)=fA0(19)*(1.0-reduc) c fA0(20)=fA0(20)*(1.0-reduc) c fA0(21)=fA0(21)*(1.0-reduc) c read proxydata file c uncertainties provided by Dana Royer are in a range, a max and min. c I compute a factor-of-X uncertainty by dividing the upper bound by the value c and convert the 1-sigma into logarithmic misfit c 2006 data set name='proxydata.txt' nscan=488 c 2010 data set name='co2proxy_2010.txt' nscan=635 c name='co2proxy_2010_nostomata.txt' c nscan=438 c name='co2proxy_2010_nopaleosol.txt' c nscan=420 c name='co2proxy_2010_noplankton.txt' c nscan=451 c we have data from 0Ma to 419 Ma c so we make averages over 10 Ma intervals, and set the ages to 5Ma, 15Ma etc mdat=42 open(8,file=name,form='formatted') read(8,101) name 101 format(a) do i=1,nscan read(8,*) age0(i),ppm0(i),plo,phi dppm0(i)=alog(phi/ppm0(i)) dum(i)=alog(ppm0(i)) iage0(i)=1+(age0(i)+0.5001) c print *,age0(i),ppm0(i),plo,phi,dum(i),dppm0(i) end do close(8) blob=0. call plotit(age0,dum,dppm0,nscan,'proxydata','age(Ma)', x 'log\\sub{e} CO\\sub{2} ppm', x 3,0,0.1,1,21) call plotit_axes(0.,75.,0.,0.) call plotit(age0,dum,dppm0,nscan,'proxydata','age(Ma)', x 'log\\sub{e} CO\\sub{2} ppm', x 3,0,0.1,1,22) c pause call plotit_axes(0.,0.,0.,0.) c if(blob.eq.1.0) then c compute 10Ma moving average of CO2 PPM estimates c the average is weighted by inverse-variance in the log domain. c It is interesting that the PPM estimates since the Eocene are so much c lower than GEOCARB. If the proxy data are unbiased, this implies that c there are more factors that control CO2 than GEOCARB includes -- an c inference that we probably would not dismiss. Short-term disagreement c doesnt invalidate the argument about the longer-term changes. jdat=0 do i=1,mdat sum=0. nsum=0 dsum=0 do j=1,nscan if((iage0(j)-1)/10+1.eq.i) then nsum=nsum+1 sum=sum+alog(ppm0(j))/(dppm0(j)**2) dsum=dsum+1.0/(dppm0(j)**2) endif end do if(nsum.gt.0) then jdat=jdat+1 age(jdat)=10.*i-5. iage(jdat)=10*i-4 dum(jdat)=exp(sum/dsum) dum(mdat+jdat)=sqrt(1.0/dsum) dum(jdat+3*mdat)=10.*i-4. c compute the chi-square of the moving average in log domain c can scale up the variance of the moving-average for large chi-square c sum=0. c do j=1,nscan c if((iage0(j)-1)/10+1.eq.i) then c sum=sum+(alog(dum(jdat)/ppm0(j))/dppm0(j))**2 c endif c end do c if(nsum.gt.0) then c sum=sum/nsum c dum(2*mdat+jdat)=sum c if(nsum.eq.1) dum(2*mdat+jdat)=sum+1. cc print *,dum(jdat),dum(mdat+jdat),sum c if(sum.gt.1.0) dum(mdat+jdat)=dum(mdat+jdat)*sqrt(sum) c endif c INSTEAD: compute the sample variance of the PPM estimates within the moving average c in log domain -- dont use uncertainty weighting, so we are using log-ppm units c for the case where nsum=1 (one data point in sum) the uncertainty is the sample uncertainty sum=0. do j=1,nscan if((iage0(j)-1)/10+1.eq.i) then sum=sum+(alog(dum(jdat)/ppm0(j)))**2 endif end do if(nsum.gt.1) then sum=sum/(nsum-1) dum(mdat+jdat)=sqrt(sum) endif c if(nsum.gt.0) print *,age(jdat),dum(jdat),dum(mdat+jdat),nsum endif end do print *,mdat,jdat ndat=jdat ppmin=1000. ppmax=1. do i=1,nscan ppmin=amin1(ppmin,ppm0(i)) ppmax=amax1(ppmax,ppm0(i)) end do ppmin=ppmin*0.8 ppmax=ppmax*1.5 call plotit_axes(0.,0.,10.,ppmax) call plotit(age0,ppm0,dm,nscan,'proxydata','age(Ma)', x 'CO\\sub{2} ppm', x 2,2,0.1,1,0) open(14,file='outoutout.dat',form='formatted') do i=1,ndat pppm(i)=dum(i) dppm(i)=dum(mdat+i) dum(i)=pppm(i)*exp(dppm(i)) dum(i+ndat)=pppm(i)*exp(-dppm(i)) agee=-age(i) print *,agee,pppm(i),dum(i),dum(i+ndat),dppm(i) write(14,111) agee,pppm(i),dum(i),dum(i+ndat),dppm(i) end do 111 format(f8.1,3f10.1,f7.3) close(14) call plotit(age,dum,dm,ndat,'proxydata','age(Ma)', x 'CO\\sub{2} ppm', x 2,2,0.0,0,0) call plotit(age,dum(ndat+1),dm,ndat,'proxydata','age(Ma)', x 'CO\\sub{2} ppm', x 2,2,0.0,0,0) call plotit(age,pppm,dm,ndat,'proxydata','age(Ma)', x 'CO\\sub{2} ppm', x 2,2,0.0,0,21) call plotit_axes(0.,0.,10.,ppmax) call plotit(age0,ppm0,dm,nscan,'proxydata','age(Ma)', x 'CO\\sub{2} ppm', x 2,0,0.1,1,0) call plotit(age,dum,dm,ndat,'proxydata','age(Ma)', x 'CO\\sub{2} ppm', x 2,0,0.0,0,0) call plotit(age,dum(ndat+1),dm,ndat,'proxydata','age(Ma)', x 'CO\\sub{2} ppm', x 2,0,0.0,0,0) call plotit(age,pppm,dm,ndat,'proxydata','age(Ma)', x 'CO\\sub{2} ppm', x 2,0,0.0,0,22) print *,'go on with program? (0=no)' read (5,*) ick if(ick.eq.0) stop c endif c GEOCARB III + Rapid Recyc, Hayes alphac, n for alphas, c NO MIMI. Korte Triassic c McDougall 87Sr at P/YTr boundary c vary delta T from 0.4 to 10.1 for each value of ACT, FERT,LIFE and GYM c ndel=82 c the baseline CO2 level is 250 ppm, the average for the last million years. open(14,file='out_gcsv10.dat',form='unformatted') sumsq0=0.0 do i=1,ndat diff=alog(250.0/pppm(i))/dppm(i) sumsq0=sumsq0+(diff)**2 end do stdev_dof=sqrt(sumsq0/ndat) write(14) sumsq0,stdev_dof print *,'baseline variance, stdev/dof',sumsq0,stdev_dof c time step 1 million years Dt=1 c total cooling due to weaker solar radiation at 570Ma (degrees C) Ws=7.4 St=600 dlst=4 CT=6252 dlct=-3.5 kwpy=0.01 kwsy=0.01 kwgy=0.018 kwcy=0.018 Fwpa1=0.25 c Fws is the Cflux of weathering silicates Fwsa1=0.5 c Fwg is carbon flux from sedimentary organic matter Fwga1=0.5 c Fwc is carbon flux from Ca and Mg carbonates Fwca1=2 c Fmg is C-degassing from volcanism, metamorphism and diagenesis of organic matter Fmg1=1.25 c Fmc is C-degassing from volcanism, metamorphism and diagenesis of carbonate Fmc1=6.67 Fmp1=0.25 Fms1=0.5 ZM=12.5 RBAS=.703 FBASO=.92 RRIV=.711 FRIV=3.37 c fill in the Sr array c Sr is the normalized difference of basalt-predicted and measured Sr isotope ratios do i=1,20 jj=1+(i-1)*5 do j=0,4 Sr(jj+j)=(j*Sr0(i+1)+(5-j)*Sr0(i))/5. end do end do do i=21,67 jj=101+(i-21)*10 do j=0,9 Sr(jj+j)=(j*Sr0(i+1)+(10-j)*Sr0(i))/10. end do end do Sr(571)=Sr0(68) c fill in the fSR array do i=1,28 jj=1+(i-1)*5 do j=0,4 fSR(jj+j)=(j*fSR0(i+1)+(5-j)*fSR0(i))/5. end do end do do i=29,71 jj=141+(i-29)*10 do j=0,9 fSR(jj+j)=(j*fSR0(i+1)+(10-j)*fSR0(i))/10. end do end do fSR(571)=fSR0(72) do it=571,1,-1 c test case would be fSR(T)=1 c Bas calculated oceanic Sr-isotope ratio for basalt-seawater reactions c starts with Bas(571)=0.709 FBAS=FBASO*fSR(it) IF(it.lt.571) Bas(it)=Bas(it+1)+DELTOT(it+1) IF(it.eq.571) Bas(it)=0.709 c fR is dimensionless effect of mountain uplift on CO2 uptake by silicate weathering IF(it.eq.571) fR(it)=1 DELRIV(it)=((RRIV-Bas(it))/ZM)*FRIV DELBAS(it)=((RBAS-Bas(it))/ZM)*FBAS DELTOT(it)=DELBAS(it)+DELRIV(it) c R is the actual measured Sr-isotope ratio R(it)=0.7+Sr(it)/10000. c SRBAS is basalt-seawater Sr-isotope normalization, see Berner (2004) eq 2.1 SRBAS(it)=(Bas(it)-0.7)*10000 c PL is Berner's adjustable empirical parameter L for Sr-ratio vs. silcate weathering c PL=2 obtains approximate fit between Sr-isotopes and physical erosion estimates c from siliclastic sediments, see Berner (2004) PL=2 c Sr is the normalized difference of basalt-predicted and measured Sr isotope ratios c fR is dimensionless effect of mountain uplift on CO2 uptake by silicate weathering xx(it)=1-it fR(it)=1-PL*(1-(Sr(it)/SRBAS(it))) end do c call plotit(xx,fR,dum,571,' ',' ',' ',2,0,0.0,0,0) c fill in the other arrays do i=1,57 jj=1+(i-1)*10 do j=0,9 fA(jj+j)=(j*fA0(i+1)+(10-j)*fA0(i))/10. fD(jj+j)=(j*fD0(i+1)+(10-j)*fD0(i))/10. temp(jj+j)=(j*temp0(i+1)+(10-j)*temp0(i))/10. DLSOC(jj+j)=(j*DLS0(i+1)+(10-j)*DLS0(i))/10. DLCOC(jj+j)=(j*DLC0(i+1)+(10-j)*DLC0(i))/10. alphac(jj+j)=(j*al0(i+1)+(10-j)*al0(i))/10. fL(jj+j)=(j*fL0(i+1)+(10-j)*fL0(i))/10. end do end do fA(571)=fA0(58) fD(571)=fD0(58) temp(571)=temp0(58) DLSOC(571)=DLS0(58) DLCOC(571)=DLC0(58) alphac(571)=al0(58) fL(571)=fL0(58) c OK, we finally have all initialized do i=1,579 xx(i)=1-i c cubic fit to Ronov sediment data fRT(i)=25.269*((1-i)/1000.)**3+26.561*((1-i)/1000.)**2 x +6.894*((1-i)/1000.)+1.063 fR(i)=(fRT(i)/1.063)**(0.67) end do ndel=28 deltaT=0.28 c deltaT=1.88 c deltaT=0.88 do iiit=1,ndel c deltaT = 0.28+iiit*0.12 deltaT = deltaT+0.12*(1.0+4.0*float(iiit-1)/float(ndel-1)) c GCM is the DT for CO2-doubling, divided by ln 2, so when you mult by log(RCO2) c you obtain deltaT when RCO2=2 GCM0 = deltaT/alog(2.0) varredmin=1000. do k1=10,1,-1 ACT=0.03+(k1-1)*0.10/9. do k2=10,1,-1 c limit plant response to CO2 enrichment to range of 20% to 80% efficiency c in this loop (over counter k2) we place c the alternate variable GLAC for glacial amplification of climate response c also included a test loopp on the variable fob0 c for these alternate loops, FERT=0.5 -- because the standard computations showed that c this seemed a most-probable value, with weak dependence on deviations from FERT=0.5 FERT=0.2+(k2-1)*0.2/3. c FERT=0.5 c GLAC=2.0**(float(k2-1)/3.0-1.0) c GLAC=2.0 GLAC=1.0 c FOBO=float(k2-1)/2.25+1. do k3=10,1,-1 c assume vascular-plant acceleration of weathering lies between factor of 2 and 10 LIFE=0.1+(k3-1)*0.4/9. do k4=10,1,-1 c assume gymnosperms accelerate weathering by 0.5 to 1.2, relative to angiosperms GYM=0.5+(k4-1)*0.7/9. c oxy is oxygen level in atmosphere, in percent mass (Berner 2009) oxy=25. c RCO2 is ratio of CO2 to pre-industrial level, c initial RCO2 level in the calculation is moot, because it will be solved for RCO2 =10. Spy=20. Spa=280. Ssy=150. Ssa=150. Gy=250. Ga=1000. Cy=1000. Ca=4000. dlsy=35. dlcy=3. dlpy=-10. dlpa=-10. dlsa= (dlst*St-(dlpy*Spy+dlsy*Ssy+dlpa*Spa))/Ssa dlgy= -23.5 dlga=-23.5 dlca= (dlct*CT-(dlgy*Gy +dlcy*Cy +dlga*Ga))/Ca Rcy=0.7095 Rca=0.709 c iberner is a counter for correspondence to earlier codes c I decimate by 10 to match the 10My-averaged CO2 values do iberner=571,1,-1 i=iberner GCM=GCM0 c Dana Royer's suggested glacial intervals c if(i.le.363.and.i.ge.346) GCM=GCM0*GLAC c if(i.le.30.and.i.ge.0) GCM=GCM0*GLAC c if(i.le.327.and.i.ge.290) GCM=GCM0*GLAC c glacial intervals in Bob's GEOCARB code if(i.le.340.and.i.ge.260) GCM=GCM0*GLAC if(i.le.40.and.i.ge.0) GCM=GCM0*GLAC c glacial intervals in Bob's GEOCARB code -- ALTERNATE GLACIAL INTERVALS c if(i.le.340.and.i.ge.240) GCM=GCM0*GLAC c if(i.le.30.and.i.ge.0) GCM=GCM0*GLAC c glacial intervals in Bob's GEOCARB code -- reverse Glacial and interglacial c if(i.gt.340) GCM=GCM0/GLAC c if(i.le.260.and.i.ge.40) GCM=GCM0/GLAC fac=(i-1)/570. c RT is Y in Berner (2004), & RUN in Berner and Kothavala (2001) c is the coefficient of continental runoff versus temperature change c that is, runoff/runoff0 = 1 + RT*(T-T0), gotten from GCM runs if(i.gt.341) then RT=0.025 elseif(i.le.341.and.i.gt.261) then RT=0.045 elseif(i.le.261.and.i.gt.41) then RT=0.025 else RT=0.045 endif GAS =0.75 if(i.gt.151) then Fc=GAS else Fc=(GAS)+((1.0-GAS)/150.)*(151-i) endif c fE is the factor of plant-assisted silicate weathering, relative to modern angiosperms if(i.gt.381) then fE=LIFE elseif(i.le.381.and.i.gt.351) then fE=(GYM-LIFE)*((381.-i)/30.)+LIFE elseif(i.le.351.and.i.gt.131) then fE=GYM elseif(i.le.131.and.i.gt.81) then fE=(1.-GYM)*((131-i)/50.)+GYM else fE=1 endif c GEOG is the change in avg land temp due to geography only, obtained via GCM runs GEOG(i) = temp(i)-12.4 c fBB is the CO2-assisted acceleration of silicate weathering c (looks like time-stepped value??? CHECK!) c in Berner (2004) fbb is biological negative feedbacks, but in this code c fbb includes other terms and factors c c (2.0*RCO2/(1.0+RCO2))**FERT -- CO2-fertilization of plant growth c GCM*alog(RCO2) - Ws*fac + GEOG(i) -- the change in temperature relative to modern c includes CO2-warming, solar waxing, and geographic effect, equation 2.28 c c Berner's GEOCARB modelling assumes a long-term balance of carbon fluxes, c in two terms, fBB and fB c if(i.eq.571) then fBB=1 elseif(i.le.570.and.i.gt.381) then fBB=(1+0.087*GCM*alog(RCO2)-0.087*Ws*fac x +0.087*GEOG(i))*sqrt(RCO2) elseif(i.le.381.and.i.gt.351) then fBB=((381.-i)/30.)*((1.0+0.087*GCM*alog(RCO2)-0.087*Ws*fac x +0.087*GEOG(i))*(2.0*RCO2/(1.0+RCO2))**FERT) x +((i-351)/30.)*(1.0+0.087*GCM*alog(RCO2) x -0.087*Ws*fac+0.087*GEOG(i))*sqrt(RCO2) else c print *,fBB,GCM,RCO2,Ws,fac,FERT,GEOG(i) fBB=(1.0+0.087*GCM*alog(RCO2)-0.087*Ws*fac x +0.087*GEOG(i))*(2.0*RCO2/(1.0+RCO2))**FERT endif Fwpy=fA(i)*fR(i)*kwpy*Spy Fwsy=fA(i)*fD(i)*kwsy*Ssy Fwgy=fA(i)*fR(i)*kwgy*Gy Fwcy=fA(i)*fD(i)*fL(i)*fE*fBB*kwcy*Cy Fwpa=fR(i)*Fwpa1 Fwsa=fA(i)*fD(i)*Fwsa1 Fwga=fR(i)*Fwga1 Fwca=fA(i)*fD(i)*fL(i)*fE*fBB*Fwca1 Fmp=fSR(i)*Fmp1 Fms=fSR(i)*Fms1 Fmg=fSR(i)*Fmg1 Fmc=fSR(i)*Fc*Fmc1 Fyop=Fwpa+Fmp Fyos=Fwsa+Fms Fyog=Fwga+Fmg Fyoc=Fwca+Fmc zzn=1.5 aaJ=4. alphas =35.0*((oxy/38.0)**zzn) c start test alphac(i)=27.0+aaJ*(oxy/38.0-1.0) c print *,i,oxy,zzn,aaJ,alphas,alphacc,alphac(i) c if(i.eq.1) then c pause c endif c end test Fbp = (1/alphas)*((DLSOC(i)-dlsy)*Fwsy+(DLSOC(i)-dlsa)*Fwsa x +(DLSOC(i)-dlpy)*Fwpy+(DLSOC(i)-dlpa)*Fwpa +(DLSOC(i)-dlsa)*Fms x +(DLSOC(i)-dlpa)*Fmp) c Fbg is burial Cflux of organic sediments Fbg=(1/alphac(i))*((DLCOC(i)-dlcy)*Fwcy+(DLCOC(i)-dlca)*Fwca x +(DLCOC(i)-dlgy)*Fwgy+(DLCOC(i)-dlga)*Fwga +(DLCOC(i)-dlca)*Fmc x +(DLCOC(i)-dlga)*Fmg) Fbs=Fwpy+Fwpa+Fwsy+Fwsa +Fms +Fmp-Fbp c Fbc is burial Cflux of carbonate sediments Fbc=Fwgy+Fwga+Fwcy+Fwca +Fmc +Fmg-Fbg c the following few statements were necessary because the commented line c just below (if(i.lt.571) . . . ) would not compile correctly. aaa1=(Fbg+(15./8.)*Fbp)*Dt aaa2=(Fwgy+Fwga+Fmg)*Dt aaa3=(15./8.)*(Fwpy+Fwpa+Fmp)*Dt aaa4=aaa1-aaa2-aaa3 if(i.lt.571) oxy = oxy + aaa4 c if(i.lt.571) oxy = oxy +(Fbg+(15./8.)*Fbp)*Dt -(Fwgy+Fwga+Fmg)*Dt c x -(15./8.)*(Fwpy+Fwpa+Fmp)*Dt Spy=Spy+(Fbp-Fwpy-Fyop)*Dt Ssy =Ssy +(Fbs-Fwsy-Fyos)*Dt Gy= Gy+ (Fbg-Fwgy-Fyog)*Dt Cy=Cy + (Fbc-Fwcy-Fyoc)*Dt c CT is set near the start of the program Ca = CT-Gy - Ga - Cy -2.0 dlpy = dlpy +((DLSOC(i)-dlpy-alphas)*Fbp/Spy)*Dt dlpa = dlpa + (Fyop*(dlpy-dlpa)/Spa)*Dt dlsy = dlsy+((DLSOC(i)-dlsy)*Fbs/Ssy)*Dt dlsa = dlsa + (Fyos*(dlsy-dlsa)/Ssa)*Dt dlgy=dlgy+((DLCOC(i)-dlgy-alphac(i))*Fbg/Gy)*Dt dlga =dlga+(Fyog*(dlgy-dlga)/Ga)*Dt dlcy=dlcy+((DLCOC(i)-dlcy)*Fbc/Cy)*Dt dlca=dlca+(Fyoc*(dlcy-dlca)/Ca)*Dt c commented out: print out some values for diagnostics c if(k1.eq.10.and.k2.eq.9.and.k3.eq.1.and.k4.eq.1) c x print *, i,fBB,ewfBB,oldfBB,Fwcy,Fwpa,Fwsa,Fwga,Fwca,Fmp, c x Fms,Fmg,Fmc c if(k1.eq.10.and.k2.eq.9.and.k3.eq.1.and.k4.eq.1) c x print *, i,DLSOC(i),dlsy,dlsa,dlpy,dlpa,RCO2 c STARTING HERE IS NEW CODE FOR geocarbsulf volc c fAD is total runoff factor for silicate weathering c obtained with GCM simulations and continental reconstructions Roc = (Sr(i)/10000.)+0.7 c vary anv from 0 to 0.015, is Berner parameter NV c anv is a parameter that scales the influence of volcanic weathering on Sr-87/86 ratios. c anv=0 means no accelerated weathering of volcanic rocks, as opposed to plutonic/metamorphic anv=0.015 Rg =0.722-anv*(1-fRT(i)/1.063) Rv =0.704 c avnv is the ratio of volcanic weathering CO2-consumption rate (basalts) c to plutonic weathering CO2-consumption rate (granites) c avnv=4 in the version of code used for 2010 GoldSchmidt conference poster. c obtained by averaging values from Taylor's dissertation (5) and Taylor et al 1999 (3) c avnv=5 is Berner's preferred value for GEOCARBSULF, c gotten from Aaron Taylor's dissertation avnv=4.0 c Fv0 =.3 of total Fwsi0=6.67 at x=0; Fob0 is basalt-seawater c flux =1/3 of total ocean imbalance with Fv0 = 2/3 c Fob0=0.75 c for GEOCARBSULF volcanic, there are two flavors of code. The first code uses BoB's 2007 c algorithm, enshrined in a BASIC code he gave me in 2007. These codes have the letter "v" in the c filename, in place of "l". For the newer 2010 GEOCARBSULF-volcanic algorithm, based on a 2010 c BBerner Basic code, the letters "v10" are in the filename. The new-improved aspects of the 2010 c code includes slightly different carbon-isotope data-inputs, one change in the strontium c data-input time series, a change in the formula for fR, involving a power to the 0.67(!), and the c parameters VNV (increase from 2 to 4) and NV (increase from 0.008 to 0.015), and the parameter c Fob0 (from 0.75 to 4), and switching alphac(i) from a table of values to being computed from the c model-generated oxygen time series. The Newton-Raphson rootfinding algorithm c works OK with estimating the alphac(i) parameter from model-derived oxygen, but c the quasi-bisection routine had difficulty with this last feature. For this reason, and the previous c experience that the bisection and Newton-Raphson results were not dramatically different (largest c differences were for unlikely parameter choices where the datafit was already poor.), c I retain Newton-Raphson for the export codes. Fob0=4.0 c Fob0=FOBO --- this was an option to sample a range of values in the K2 loop Xvolc0=0.35 Fwsi0 =6.67 Rcy = Rcy +((Roc-Rcy)*Fbc/Cy)*Dt Rca = Rca +((Rcy-Rca)*Fyoc/Ca)*Dt Avlc =((Rv-Roc)*fSR(i)*Fob0)/(Fbc-Fwcy-Fwca) Bvlc = Fwcy/(Fbc-Fwcy-Fwca) Dvlc = Fwca/(Fbc-Fwcy-Fwca) Evlc = Fbc/(Fbc-Fwcy-Fwca) Xvolc= (Avlc +Bvlc*Rcy+Dvlc*Rca -Evlc*Roc+Rg)/(Rg-Rv) fAD(i)=fA(i)*fD(i) fvolc=(avnv*Xvolc+1.0-Xvolc)/(avnv*Xvolc0+1.0-Xvolc0) fB=(Fbc-Fwcy-Fwca)/((fAD(i)**(0.65))*fE*fR(i)*fvolc*Fwsi0) c ENDING HERE IS NEW CODE FOR geocarbsulf volc c print *,fB,Fbc,Fwcy,Fwca,fAD(i),fE,fR(i),Fwsi0 c print *,Xvolc,Avlc,Bvlc,Dvlc,Evlc,Rg,Rv c pause c print *,'GYM,LIFE,ACT,FERT' n=0 if(i.gt.381) then c this first step is an initialization kluge to ensure that the convergence condition c is not satisfied accidentally at the first step RCO2old=RCO2*2. c if((i/10)*10.eq.i) print *,'in loop ',i do while(abs(RCO2/RCO2old-1.0).gt.0.001) RCO2old=RCO2 Fbbs= (RCO2**(0.5+ACT*GCM))*((1.0+RT*GCM*alog(RCO2) x -RT*Ws*fac+RT*GEOG(i))**0.65) x *exp(-ACT*Ws*(fac))*exp(ACT*GEOG(i)) W=((0.5+ACT*GCM)*RCO2**(-0.5+ACT*GCM))*((1+RT*GCM*alog(RCO2) x -RT*Ws*(fac)+RT*GEOG(i))**0.65) x *exp(-ACT*Ws*(fac))*exp(ACT*GEOG(i)) V=(RCO2**(0.5+ACT*GCM))*0.65*((1.0+RT*GCM*alog(RCO2) x -RT*Ws*(fac)+RT*GEOG(i))**(-0.35))*(RT*GCM/RCO2) x *exp(-ACT*Ws*fac)*exp(ACT*GEOG(i)) fPBS = W + V if(RCO2.gt.((Fbbs-fB)/fPBS)) then c damp the iteration to avoid overshoot RCO2=RCO2-0.9*((Fbbs-fB)/fPBS) else c convert the iteration to geometric shrinkage to avoid nonpositive value in overshoot RCO2=RCO2*0.2 endif end do 777 format(i5,8g13.5) elseif(i.le.381.and.i.gt.349) then RCO2old=RCO2*2. n=0 do while(abs(RCO2/RCO2old-1.0).gt.0.001) RCO2old=RCO2 oldfBBS=(RCO2**(0.5+ACT*GCM))*((1+RT*GCM*alog(RCO2) x -RT*Ws*(fac)+RT*GEOG(i))**0.65) x *exp(-ACT*Ws*(fac))*exp(ACT*GEOG(i)) oldW=(0.5+ACT*GCM)*RCO2**(-0.5+ACT*GCM) x *((1.0+RT*GCM*alog(RCO2)-RT*Ws*(fac) x +RT*GEOG(i))**0.65) x *exp(-ACT*Ws*(fac))*exp(ACT*GEOG(i)) oldV=RCO2**(0.5+ACT*GCM)*0.65*((1.0+RT*GCM*alog(RCO2) x -RT*Ws*(fac)+RT*GEOG(i))**(-0.35))*(RT*GCM/RCO2) x *exp(-ACT*Ws*fac)*exp(ACT*GEOG(i)) oldfPBS = oldW + oldV oldX=0. ewfBBS=((2.0**FERT)*RCO2**(FERT+ACT*GCM)) x *((1+RCO2)**(-FERT)) x *((1.0+RT*GCM*alog(RCO2)-RT*Ws*fac+RT*GEOG(i))**0.65) x *exp(-ACT*Ws*(fac))*exp(ACT*GEOG(i)) ewW=(2.0**FERT)*(FERT+ACT*GCM)*(RCO2**(FERT+ACT*GCM-1.0)) x *((1.0+RCO2)**(-FERT))*((1.0+RT*GCM*alog(RCO2) x -RT*Ws*(fac)+RT*GEOG(i))**0.65) x *exp(-ACT*Ws*(fac))*exp(ACT*GEOG(i)) ewV=(-FERT*(1.0+RCO2)**(-(1.0+FERT))) x *((2**FERT)*RCO2**(FERT+ACT*GCM))*((1.0+RT*GCM*alog(RCO2) x -RT*Ws*(fac)+RT*GEOG(i))**0.65) x *exp(-ACT*Ws*(fac))*exp(ACT*GEOG(i)) ewX=0.65*((1.0+RT*GCM*alog(RCO2)-RT*Ws*(fac) x +RT*GEOG(i))**(-0.35))*(RT*GCM/RCO2) x *(2**FERT*RCO2**(FERT+ACT*GCM))*((1+RCO2)**(-FERT)) x *exp(-ACT*Ws*fac)*exp(ACT*GEOG(i)) ewfPBS=ewW+ewV+ewX fBBS=((i-349)/32.)*oldfBBS + ((381-i)/32.)*ewfBBS fPBS=((i-349)/32.)*oldfPBS + ((381-i)/32.)*ewfPBS c oldfBBs=(float(i-349)/32.)*oldfBBs c ewfBBs=(float(381-i)/32.)*ewfBBs if(RCO2.gt.((fBBS-fB)/fPBS)) then c damp the iteration to avoid overshoot RCO2=RCO2-0.9*((fBBS-fB)/fPBS) else c convert the iteration to geometric shrinkage to avoid nonpositive value in overshoot RCO2=RCO2*0.2 endif n=n+1 end do else RCO2old=RCO2*2. c if((i/10)*10.eq.i) print *,'in loop ',i do while(abs(RCO2/RCO2old-1.0).gt.0.001) RCO2old=RCO2 Fbbs=((2**FERT)*RCO2**(FERT+ACT*GCM))*((1+RCO2)**(-FERT)) x *((1+RT*GCM*alog(RCO2)-RT*Ws*(fac)+RT*GEOG(i))**0.65) x *exp(-ACT*Ws*(fac))*exp(ACT*GEOG(i)) W=(2**FERT)*(FERT+ACT*GCM)*(RCO2**(FERT+ACT*GCM-1)) x *((1+RCO2)**(-FERT))*((1+RT*GCM*alog(RCO2) x -RT*Ws*(fac)+RT*GEOG(i))**0.65) x *exp(-ACT*Ws*(fac))*exp(ACT*GEOG(i)) V=(-FERT*(1+RCO2)**(-(1.+FERT)))*((2**FERT)*RCO2**(FERT+ACT*GCM)) x *((1+RT*GCM*alog(RCO2)-RT*Ws*(fac)+RT*GEOG(i))**0.65) x *exp(-ACT*Ws*(fac))*exp(ACT*GEOG(i)) X=0.65*((1+RT*GCM*alog(RCO2)-RT*Ws*(fac) x +RT*GEOG(i))**(-0.35))*(RT*GCM/RCO2) x *(2**FERT*RCO2**(FERT+ACT*GCM))*((1+RCO2)**(-FERT)) x *exp(-ACT*Ws*fac)*exp(ACT*GEOG(i)) fPBS=W+V+X if(RCO2.gt.((Fbbs-fB)/fPBS)) then c damp the iteration to avoid overshoot RCO2=RCO2-0.9*((Fbbs-fB)/fPBS) else c convert the iteration to geometric shrinkage to avoid nonpositive value in overshoot RCO2=RCO2*0.2 endif end do endif c if(k1.eq.10.and.k2.eq.9.and.k3.eq.1.and.k4.eq.1) c x print *,i,' fB, fBBs ',fB, fBBs,ewfBBs,oldfBBs,RCO2 c if(k1.eq.10.and.k2.eq.9.and.k3.eq.1.and.k4.eq.1.and.i.eq.346)then c print *,i,' fB, fBBs ',fB, fBBs,ewfBBs,oldfBBs,RCO2 c stop c endif c the CO2 ppm is converted from RCO2 by last My average value = 250 ppm tau=15 + 6*alog(RCO2)-12.8*fac+GEOG(i) oxy2 =100*(oxy/(oxy+143.)) ppm=250.*RCO2 c the indexing here is time equals (i-1)Ma, save the ppm values at 10-Ma intervals, c K=1 --> 0Ma if(((i-1)/10)*10.eq.i-1) then Ma=-i+1 c print *, Ma, ppm c write(8,*) -i,ppm k=1+i/10 c save CO2 level (ppm) or oxygen (mass percent) pp(k1,k2,k3,k4,k)=ppm c pp(k1,k2,k3,k4,k)=oxy2 endif gcsppm(i)=ppm aage(i)=i-1 end do c compute variance reduction -- compare variance of residual to variance of data c normalized -- sum(pred-data)^2/sum(data)^2 c two quantities saved: c sqrt(chisq/dof) for datafit of the ndat (40?) interval averaged PPM values c misfit variance normalized by variance explained by constant ppm=250 c variance ratio is not square-rooted. sumsq=0. c sumdatsq=0. c do i=1,ndat c diff=alog(gcsppm(iage(i))/pppm(i)) c sumsq=sumsq+(diff)**2 c diff=alog(pppm(i)/250.) c sumdatsq=sumdatsq+(diff)**2 c end do c varred=sumsq/sumdatsq c note that the array iage() holds the times at which the data-averages have been centered c this enables the code to skip over the gap in the CO2-proxy data at roughly 255Ma. do i=1,ndat diff=alog(gcsppm(iage(i))/pppm(i))/dppm(i) sumsq=sumsq+(diff)**2 end do chisq_dof=sqrt(sumsq/ndat) varred=sumsq/sumsq0 c print *, varred pp(k1,k2,k3,k4,59)=chisq_dof pp(k1,k2,k3,k4,60)=varred varredmin=amin1(varredmin,pp(k1,k2,k3,k4,60)) end do end do c print *,'GYM,LIFE,ACT,FERT,deltaT' c print *,GYM,LIFE,ACT,FERT,deltaT c print *,'varredmin ',varredmin c pause end do c print *,'GYM,LIFE,ACT,FERT' c print *,GYM,LIFE,ACT,FERT if(k1.eq.10) print *,'GYM,LIFE,ACT,FERT,deltaT,varredmin' print *,GYM,LIFE,ACT,FERT,deltaT,varredmin end do c print *,'GYM,LIFE,ACT,FERT,deltaT' c print *,GYM,LIFE,ACT,FERT,deltaT c close(8) c sift through the runs to find acceptable data fits (chiquare <= NDAT; bias < 0.3) do k=1,2 do j=1,4 do i=1,10 jkk(i,j,k)=0 end do end do end do do k1=1,10 do k2=1,10 do k3=1,10 do k4=1,10 if(pp(k1,k2,k3,k4,60).le.varredmin*1.5) then jkk(k1,1,1)=jkk(k1,1,1)+1 jkk(k2,2,1)=jkk(k2,2,1)+1 jkk(k3,3,1)=jkk(k3,3,1)+1 jkk(k4,4,1)=jkk(k4,4,1)+1 endif if(pp(k1,k2,k3,k4,60).le.varredmin*1.2) then jkk(k1,1,2)=jkk(k1,1,2)+1 jkk(k2,2,2)=jkk(k2,2,2)+1 jkk(k3,3,2)=jkk(k3,3,2)+1 jkk(k4,4,2)=jkk(k4,4,2)+1 endif end do end do end do end do print *,'deltaT=',deltaT,iiit,ndel print *,'minimum chi-squared misfit',varredmin print *,'parameters for runs that fit with varred 50% from min' print *,'ACT' print *,(jkk(i,1,1),i=1,10) print *,'FERT' print *,(jkk(i,2,1),i=1,10) print *,'LIFE' print *,(jkk(i,3,1),i=1,10) print *,'GYM' print *,(jkk(i,4,1),i=1,10) print *,' ' print *,'parameters for runs that fit with varred 20% from min' print *,'ACT' print *,(jkk(i,1,2),i=1,10) print *,'FERT' print *,(jkk(i,2,2),i=1,10) print *,'LIFE' print *,(jkk(i,3,2),i=1,10) print *,'GYM' print *,(jkk(i,4,2),i=1,10) c pause print *,'writing chisq to disk',deltaT write(14) deltaT write(14)((((pp(k1,k2,k3,k4,59),k4=1,10),k3=1,10) x ,k2=1,10),k1=1,10) do k1=1,10 do k2=1,10 do k3=1,10 do k4=1,10 write(14)(pp(k1,k2,k3,k4,j),j=1,58) end do end do end do end do end do close(14) stop end
About
A java translation of the most recent form of Bob Berner's GEOCARBSULFVOLC with added functionality for testing variations in input parameters along their expected deviations. This version itself is based on a fortran translation of the original model, which was created by Jeff Park (http://earth.geology.yale.edu/~jjpark/Code/gcsv10_export.f) an…
Resources
Stars
Watchers
Forks
Releases
No releases published
Packages 0
No packages published