! ! Global.f - NUMERICAL CALCULATIONS FOR THE CO2-CCD SYSTEM WITH ! DISSOLUTION OF PREDEPOSITED CACO3 ! ! Ref1. Boudreau et al., 2010, GBC ! Pre-set parameters IMPLICIT REAL*8 (A-H,O-Z) REAL*8 KEQS,KEQH,KEQD,KB,KC REAL*8 K2S,K2H,K2D,KHA,KSA DIMENSION Y(6),X(6),BFC(6251),U(2),YO(2) DIMENSION XT(3),YT(3) EXTERNAL AREA,ARSAT,CH4,CH5,CH6,PDC,PDCS,PDCEN DATA ZERO/0.0D+00/,ONE/1.0D+00/,TWO/2.0D+00/,TEN/1.0D+01/ DATA THREE/3.0D+00/,FOUR/4.0D+00/,FIVE/5.0D+00/,SIX/6.0D+00/ DATA HUN/1.0D+02/ COMMON /CONCDATL/ TCO2D,CALKD,CO2D,HCO3D,CO3D COMMON /CONCSATL/ TCO2S,CALKS,CO2S,HCO3S,CO3S COMMON /CONCHATL/ TCO2H,CALKH,CO2H,HCO3H,CO3H COMMON /SOURCES/ F,B,P COMMON /SAT/ C0,C1,CA,KC COMMON /DEPTHS/ ZS,ZB,ZH,ZSNOW,ZCCD COMMON /AREA/ AREAD,AREAZD COMMON /THERMO/ KEQS,KEQH,KEQD COMMON /RATES/ EXS,EXH,RD COMMON /VOLUMES/ VS,VH,VD COMMON /PDC/ BFC COMMON /PH/ PHS,PHH,PHD COMMON /T/ TS,TH,TD,TAS,TAH,TASini,TAHini COMMON /HEAT/ HH,HS,KHA,KSA ! Open files to store results OPEN(18,FILE="TODAY.TXT",STATUS="UNKNOWN") ! Input parameter values ! 1) Temperature of air and water (Table 1 in ref1, same) TS=21.5; TD=2.0; TH=2.0; TASini=22.0; TAHini=0.0 ! 2) Salinity & pressure (atm) (Table 1 in ref1, different) S=35.0; PS=5.0; PH=12.5; PD=500.0 ! 3) Surface Area (KM^2) and Volumes of the boxes (KM^3) (Table 1 in Ref1, different) SareaD = 3.49D+08; SareaH = SareaD*0.15; SareaS = SareaD*0.85 VS = 2.97D+07; VH = 1.31D+07; VD = 1.25D+09 ZB = 6.5D+00; ZS = 0.25D+00; ZH = 0.25D+00 ! in KM ZCCD = 4.76142D+00; ZSNOW = 4.76142D+00 AREAD = AREA(ZS, ZB) ! 4) Atm concentration (atm), gas solubility and exchange coefficients AMA = 1.80D+11; PCO20 = 2.83D-04 ! Number of Gmoles total gas in atmosphere (Sarmiento 2006, p.400) ALS = 0.3704996759D-01; ALH = 0.5420629426D-01 EXS = 4.8*365.0/1000.0; EXH = EXS ! 5) Calculate the thermodynamic KEQS (See line 445) CALL EQUIL(TD,PD,S,KEQD,K2D); CALL EQUIL(TH,PH,S,KEQH,K2H); CALL EQUIL(TS,PS,S,KEQS,K2S) ! 6) Set TCO2 and CAlk in boxes in Gmol/Km^3 (See table 3, ref1) TCO2S = 2.058; TCO2H = 2.1849; TCO2D = 2.280 TALKS = 2.310; CALKH = 2.3144; TALKD = 2.385 ! 7) THE CALCIUM CONCENTRATION [Ca2+] and CaCO3 dissolution constant (mass transfer controlled) (! refer to eq. 9a in ref1 Unit = km/yr) CA = 0.010282D+03 KC = 0.0069087!UNIT [KM/YR] ! 8) Borate correction to the TAlk values to get CAlk TB = (1.185*S)*1.0D-05; CALL BORATE(KB,TD,S,PD) HB = TB/(ONE + KB/TEN**(-7.6)); BM = TB - HB CALKD = (TALKD/1000.0 - BM)*1000.0 CALL BORATE(KB,TS,S,PS) HB = TB/(ONE + KB/TEN**(-7.6)); BM = TB - HB CALKS = (TALKS/1000.0 - BM)*1000.0 ! 9) Calculate the initial equilibrium concentrations in the boxes (See ) ! BOX D AAD = (ONE - KEQD/FOUR); BBD = KEQD*TCO2D/TWO CCD = KEQD*CALKD/TWO*(CALKD/TWO-TCO2D) HCO3D = (-BBD + SQRT(BBD**2 - FOUR*AAD*CCD))/TWO/AAD CO3D = (CALKD - HCO3D)/TWO; CO2D = TCO2D - HCO3D - CO3D ! BOX HA AH = (ONE - KEQH/FOUR); BH = KEQH*TCO2H/TWO CH = KEQH*CALKH/TWO*(CALKH/TWO-TCO2H) HCO3H = (-BH + SQRT(BH**2 - FOUR*AH*CH))/TWO/AH CO3H = (CALKH - HCO3H)/TWO; CO2H = TCO2H - HCO3H - CO3H ! BOX SA AS = (ONE - KEQS/FOUR); BS = KEQS*TCO2S/TWO CS = KEQS*CALKS/TWO*(CALKS/TWO-TCO2S) HCO3S = (-BS + SQRT(BS**2 - FOUR*AS*CS))/TWO/AS CO3S = (CALKS - HCO3S)/TWO; CO2S = TCO2S - HCO3S - CO3S C0 = 4.384D-01; C1 = 0.001939 ! C0=K0sp ! 14) Input the water flow rates between boxes (KM^3/YR, ! See Table 4, ref1) U(1) = 24.218*3.156D+04; U(2) = 30.0*3.156D+04 !U(1) = UT; U(2) = UM U1 = U(1); U2 = U(2) ! 15) SET THE ALKALINITY FLUX TO THE SURFACE BOX (! Falk in Table 4 ref1, Unit = Gmol C/yr) F = 0.24D+05 F0 = F ! 16) GAS EXCHANGE RATES (Gmol C/yr) ES = 0.18946D+05; EH = 0.06946D+05 ! 17) VALUES OF THE INTERNAL SOURCES AND SINKS (! See Table 4, ref1; P = organic, B = inorganic ) PCO2 = 2.83D-04 P = 0.13478D+06; B = 0.399531D+05; BD = 0.279531D+05 B0 = B BNS = 1.04127D+04; BDS = 0.55408D+04; BCC = 0.119996D+05 ! At steady-state, BCC = BDB BPDC = 0.0D+04 ! At steady-state, BPDC = 0 RD = 0.627075 ! ALPHA-RD IN EQ.8, REF 1 PZD = ZCCD*100.0 CSAT = C0*EXP(C1*PZD)/CA; CSATS = C0*EXP(C1*5.0)/CA; CSATH = C0*EXP(C1*17.5)/CA ZSAT = ONE/(C1*100.0)*LOG((CA*CO3D)/C0) BB = B; PP = P OMS = CO3S/CSATS; OMH = CO3H/CSATH; OMD = CO3D/CSAT OMSK = OMS CALL PDCS(ZCCD,CO3D,ZSNOW,Z10,B2000,B3000,B4000) ! 19) HEAT FLUX VIA AIR-SEA INTERFACE HH = U(1)*(TH-TS)/VH; HS = U(1)*(TS-TD)/VS KHA = HH/(TAHini-TH); KSA = HS/(TASini-TS) ! 20) O2 related ! O2S = 0.2359; O2H = 0.3342; O2D = 0.22 ! [O2] in Gmol/Km3 PRO2 = P*1.45 !Gmol/yr ! PO2 = 0.20946 ! EAH = 0.0035*SareaH !Gmol/yr ! EAS = EAH ! ALO2H = 0.1605D-02; ALO2S = 0.1125D-02; !PREIN SOLUBILITY OF O2 O2H = O2SOLU(TH,S); O2S = O2SOLU(TS,S) O2D = O2H - PRO2/(U(1)+U(2)) TCO2SK=TCO2S; CALKSK=CALKS TCO2HK=TCO2H; CALKHK=CALKH !!! NUMERICALLY SOLVE THE MODEL EQUATIONS ! SET INITIAL CONDITIONS SUMDTD=0.0;CH4IN=0.0;CH42=0.0;T=0.05;DT=0.05;KOUNT=0 Y(1)=TCO2S;Y(3)=TCO2H;Y(5)=TCO2D Y(2)=CALKS;Y(4)=CALKH;Y(6)=CALKD c WRITE(*,210) T,PCO2,ZSAT,ZCCD,ZSNOW,CO3D, c # B,BD,Y(1),Y(2),Y(3),Y(4),Y(5),Y(6) !!!!!!SOLVE THE EQUATIONS VIA THE EULER METHOD!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 200 CONTINUE KOUNT = KOUNT + 1 !!!!!!GLOBAL!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! X(1)=Y(1)+DT/VS*(U(1)*(Y(5)-Y(1)) - (B + P) + F - ES) X(2)=Y(2)+DT/VS*(U(1)*(Y(6)-Y(2)) + F - TWO*B) X(3)=Y(3)+DT/VH*(U(1)*(Y(1)-Y(3)) + U(2)*(Y(5)-Y(3))+EH) X(4)=Y(4)+DT/VH*(U(1)*(Y(2)-Y(4)) + U(2)*(Y(6)-Y(4))) X(5)=Y(5)+DT/VD*((U(1)+U(2))*(Y(3)-Y(5))+P+BD+CH4IN) X(6)=Y(6)+DT/VD*((U(1)+U(2))*(Y(4)-Y(6)) + TWO*BD) ! DELIVER THE NEW VALUES BACK AND CALCULATE THREE FRACTIONS DO 201 J=1,6 201 Y(J) = X(J) TCO2S = Y(1); TCO2H = Y(3); TCO2D = Y(5) CALKS = Y(2); CALKH = Y(4); CALKD = Y(6) ! BOX D AAD = (ONE - KEQD/FOUR); BBD = KEQD*TCO2D/TWO CCD = KEQD*CALKD/TWO*(CALKD/TWO-TCO2D) HCO3D = (-BBD + SQRT(BBD**2 - FOUR*AAD*CCD))/TWO/AAD CO3D = (CALKD - HCO3D)/TWO; CO2D = TCO2D - HCO3D - CO3D ! BOX HA AH = (ONE - KEQH/FOUR); BH = KEQH*TCO2H/TWO CH = KEQH*CALKH/TWO*(CALKH/TWO-TCO2H) HCO3H = (-BH + SQRT(BH**2 - FOUR*AH*CH))/TWO/AH CO3H = (CALKH - HCO3H)/TWO; CO2H = TCO2H - HCO3H - CO3H ! BOX SA AS = (ONE - KEQS/FOUR); BS = KEQS*TCO2S/TWO CS = KEQS*CALKS/TWO*(CALKS/TWO-TCO2S) HCO3S = (-BS + SQRT(BS**2 - FOUR*AS*CS))/TWO/AS CO3S = (CALKS - HCO3S)/TWO; CO2S = TCO2S - HCO3S - CO3S IF (T.LE.1850.0) THEN TCO2SK=TCO2S; CALKSK=CALKS;TCO2HK=TCO2H; CALKHK=CALKH END IF ! TCO2SK=TCO2S; CALKSK=CALKS ! NONvalid if 0 ! TCO2HK=TCO2H; CALKHK=CALKH ! CALCULATE PH AND OMEGA IN DIFFERENT BOXES PHS = -LOG10(K2S*HCO3S/CO3S); PHH = -LOG10(K2H*HCO3H/CO3H) PHD = -LOG10(K2D*HCO3D/CO3D) OMS = CO3S/CSATS; OMH = CO3H/CSATH; OMD = CO3D/CSAT ! DONE ! SET DYNAMIC PCO2 DPCO2 = 0.0 IF (T.GT.1850.0) THEN DPCO2 = DT*(CH4IN+CO2EM(T)-EH+ES-0.5*F)/AMA !!!Change 0.0 to CO2EM(T) END IF PCO2 = PCO2 +DPCO2 c c The quasi-Anthropogenic release c c AEM = 1.65D+04 c BEM = 2.084D+03 c CEM = 9.263D+01 c c The quasi-PETM release c AEM = 1.65D+03 BEM = 4.0D+03 CEM = 9.263D+02 c c The quasi-K/T relase c c AEM = 1.65D+05 c BEM = 2.0D+03 c CEM = 9.267D+00 CO2EMAX =AEM*1000.0/12.0 THALF = 5.0D+04 c c B drop funstions c B = 0.5*B0*(ONE - CO2EM(T)/CO2EMAX) + 0.50*B0 c B = 0.10*B0*(ONE - CO2EM(T)/CO2EMAX) + 0.90*B0 c B = 0.25*B0*(ONE - CO2EM(T)/CO2EMAX) + 0.75*B0 IF(T.LE.BEM) B = 0.50*B0*(ONE - CO2EM(T)/CO2EMAX) + 0.50*B0 IF(T.GT.BEM) B = 0.50*B0 IF(T.GT.THALF) B = 0.50*B0 + 0.50*B0*((T-THALF)/T) c IF(T.LE.BEM) B = 0.25*B0*(ONE - CO2EM(T)/CO2EMAX) + 0.75*B0 c IF(T.GT.BEM) B = 0.75*B0 c IF(T.GE.THALF) B = 0.75*B0 + 0.25*B0*((T-THALF)/T) c IF(T.LE.BEM) B = 0.10*B0*(ONE - CO2EM(T)/CO2EMAX) + 0.90*B0 c IF(T.GT.BEM) B = 0.90*B0 c IF(T.GE.THALF) B = 0.90*B0 + 0.10*B0*((T-THALF)/T) c IF(T.LE.BEM) B = B0 c IF(T.GT.BEM) B = B0 c c c c F changes with time in accord with Lenton and Britton (2006) c c c c IF(T.LT.1850.0) RFALK = ONE c IF(T.GE.1850.0.AND.T.LE.2260.0) THEN c TAU = (T-1850.0)/1850.0 c RFALK = 3.055 + (1.038-3.055)/(ONE+(TAU/0.1370)**4.52) c ENDIF c IF(T.GT.2260.0) THEN c TAU = (T-2200.0)/2200.0 c RFALK = 1.065 + (3.437-1.065)/(ONE+(TAU/0.2257)**0.6180) c ENDIF c F = F0*RFALK C C ! SET ATMOSPHERIC T AND OCEAN T ACCORDING TO PCO2 CHANGE TAS = 4.7*LOG(PCO2/PCO20) + TASini TAH = 4.7*LOG(PCO2/PCO20) + TAHini YT(1) = TS; YT(2) = TH; YT(3) = TD XT(1) = YT(1) + DT*(HS+U(1)*(YT(3)-YT(1))/VS) XT(2) = YT(2) + DT*(HH+U(1)*(YT(1)-YT(2))/VH) XT(3) = YT(3) + DT*U(1)*(YT(2) - YT(3))/VD DTD = XT(3) - YT(3) DO 202 J=1,3 202 YT(J) = XT(J) TS = YT(1); TH = YT(2); TD = YT(3) HH = KHA*(TAH-TH); HS = KSA*(TAS-TS) SUMDTD = SUMDTDS + DTD; CH41 = CH5(SUMDTD) CH4IN = (CH41 - CH42)/DT; CH42 = CH5(SUMDTD) SUMDTDS = SUMDTD IF(CH4IN.LT.0.0) CH4IN = 0.0 CH4IN = CH6(T)*1.0 CH4IN = 0.0 !VOID THIS LINE TO ADD CH4, CH6 IS THE JAPANESE VERSION CH4 RELEASE ! DEALING WITH O2 (PO2 IS SET CONSTANT) O2H = O2SOLU(TH,S); O2S = O2SOLU(TS,S) YO(1) =O2D; YO(2)=YO(1)+DT/VD*((U(1)+U(2))*(O2H-YO(1))-PRO2-2.0*CH4IN) IF (YO(2).LT.0.0) YO(2)=0.0 O2D = YO(2); ! PRINT VALUES AND RESET COUNTS TO 0 AT 100YR SCALE IF(KOUNT.EQ.100) THEN WRITE(18,210) T,PCO2,ZSAT,ZCCD,ZSNOW,Y(1),Y(2),Y(3),Y(4),Y(5), # Y(6),PHS,PHH,PHD,OMS,OMH,OMD,Z10, # B2000,B3000,B4000,B,CO2S,HCO3S,CO3S,CO2H,HCO3H,CO3H, # BD,BDS,BNS,BCC,BPDC,O2S,O2H,O2D,TS,TH,TD,TAS,TAH,CH4IN c WRITE(*,210) T,PCO2,ZSAT,ZCCD,ZSNOW,CO3D KOUNT = 0 END IF !!!!!!CRITICAL LINES IN GLOBAL OCEANS WITH REGARD TO CACO3!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ZSAT = ONE/(C1*100.0D+00)*LOG((CA*CO3D)/C0) ! ZCCD = LOG((B*CA/C0/AREAD/KC) + CA*CO3D/C0)/(C1*100.0D+00) C IF(ZSAT.GT.ZB) ZSAT = ZB IF(ZCCD.GT.ZB) ZCCD = ZB IF(ZSNOW.GT.ZB) ZSNOW = ZB C ! ! ZSNOW=ZCCD ! IF (T.GT.1850.0) THEN ! CALL PDC(DT,B,ZCCD,CO3D,ZSNOW,Z10,B2000,B3000,B4000) END IF IF(ZSAT.LE.ZS) ZSAT = ZS IF(ZCCD.LE.ZS) ZCCD = ZS !STOP AREAZD = AREA(ZCCD,ZB) RA = AREAZD/AREAD BDS1 = ARSAT(ZSAT,ZCCD)*C0/CA BDS2 = CO3D*AREA(ZSAT,ZCCD) BDS = KC*(BDS1 - BDS2) ! TERM 1 BCC = B*RA ! TERM 2 BNS = RD*B*AREA(ZS,ZSAT)/AREAD BPDC1 = ARSAT(ZCCD,ZSNOW)*C0/CA BPDC2 = CO3D*AREA(ZCCD,ZSNOW) BPDC3 = 0.0 !BFCLSUM BPDC = KC*(BPDC1 - BPDC2 - BPDC3) ! TERM 4 BD = BDS + BCC + BNS + BPDC ! ECO2H = EH/EXH/SareaH + CO2H; ALH = ECO2H/PCO2/1000.0 ! ECO2S = CO2S-ES/EXS/SareaS; ALS = ECO2S/PCO2/1000.0 ! ECO2H = ALH*PCO2*1000.0; EH = - EXH*SareaH*(CO2H-ECO2H) ! ECO2S = ALS*PCO2*1000.0; ES = EXS*SareaS*(CO2S-ECO2S) ! T = T + DT IF(T.GT.1000000.0) GO TO 205 GO TO 200 205 CONTINUE CALL PDCEN(DT,B,ZCCD,CO3D,ZSNOW,Z10,B2000,B3000,B4000) 210 FORMAT(42(D12.5,3X)) write(*,215) 215 format('DONE') STOP END SUBROUTINE PDC(DT,B,ZCCD,CO3D,ZSNOW,Z10,B1,B2,B3) IMPLICIT REAL*8 (A-H,O-Z) DIMENSION BFC(6251),DBFC(6251) REAL*8 DEPTH,ZL,DP,FINDSAT,DBFC,BFC,KC,C0,C1,CA,KS COMMON /PDC/ BFC DATA ZERO/0.0D+00/,ONE/1.0D+00/,TWO/2.0D+00/,TEN/1.0D+01/ DATA THREE/3.0D+00/,FOUR/4.0D+00/,FIVE/5.0D+00/,SIX/6.0D+00/ DATA HUN/1.0D+02/ INTEGER I AREAD = 3.4655D+08; C0 = 4.384D-01 C1 = 0.001939; CA = 0.010282D+03; KC = 0.0069087 F = B/AREAD; PCACO3 = 2.5D+04 ! Gmol/Km3 DP = 251.0; FM = 0.3D+07; PM = 2.5D+15 ! Unit: [FMg]/km2/yr, [PM]g/km3 501 CONTINUE DEPTH = DP; PZD = DEPTH*100.0/1000.0 ! pressure at saturation horison CSAT = C0*EXP(C1*PZD)/CA ! EQ.1 IN ref3 I = NINT(DEPTH) - 250 +1 KS = 0.0127*365.0*(BFC(I)**0.45)/(12.7+365.0*(BFC(I)**0.45)) ! (KM/YR, see figure 3, ref2) ALFAN = 3.0; ALFAW = 0.25*BFC(I)+3.0*(1.0-BFC(I)) ! [cm] TmaxN = 1.0-0.483/2.5; TmaxW = 1.0-(0.483+0.0045*BFC(I))/2.5 ! PSIN = TmaxN-ALFAN*(1.0-TmaxN)*(EXP(-10.0/ALFAN)-1.0)/10.0 PSIW = TmaxW-ALFAW*(1.0-TmaxW)*(EXP(-10.0/ALFAW)-1.0)/10.0 ZL = 10.0*(1.0-PSIN)/(1.0-PSIW)/(1.0-BFC(I))/100000.0 ! Unit in [KM] PSI = PSIW FINDSAT = CO3D-CSAT ! IF(FINDSAT.GT.0.0) THEN ! DBFCP(I) = 0.0 ! BFCP(I) = BFCP(I) + DBFCP(I) ! GO TO 503 ! END IF W = (F+KC*(CO3D-CSAT))/(1.0-PSI)/PCACO3+FM/(1.0-PSI)/PM DBFC(I)=DT*(F+KC*(CO3D-CSAT)-(1.0-PSI)*W*PCACO3*BFC(I))/ # PCACO3/ZL BFC(I) = BFC(I) + DBFC(I) 503 CONTINUE IF(DEPTH.EQ.2000.0) B1=BFC(I) IF(DEPTH.EQ.3000.0) B2=BFC(I) IF(DEPTH.EQ.4000.0) B3=BFC(I) IF((BFC(I).LT.0.1).AND.(BFC(I-1).GE.0.1)) Z10=DEPTH IF((BFC(I).GT.BFC(I-1)).OR.(BFC(I).LE.0.0)) GO TO 510 DP = DP + 1.0; GO TO 501 510 CONTINUE ZSNOW = DEPTH/1000.0; BFC(I:6251)=0.0 IF (ZSNOW.LT.ZCCD) ZSNOW = ZCCD 560 FORMAT(10(D12.5,3X)) RETURN END SUBROUTINE PDC SUBROUTINE PDCS(ZCCD,CO3D,ZSNOW,Z10,B1,B2,B3) IMPLICIT REAL*8 (A-H,O-Z) DIMENSION BFC(6251) REAL*8 DEPTH,ZL,DP,FINDSAT,C0,C1,CA,KC,BFC,KS REAL*8 B,AREAD ! COMMON /SAT/ C0,C1,CA,KC ! COMMON /SOURCES/ FA,BA,PA,BP,PP,FP ! COMMON /AREA/ AREADA,AREAZDA,AREADP,AREAZDP COMMON /PDC/ BFC INTEGER I DATA ZERO/0.0D+00/,ONE/1.0D+00/,TWO/2.0D+00/,TEN/1.0D+01/ DATA THREE/3.0D+00/,FOUR/4.0D+00/,FIVE/5.0D+00/,SIX/6.0D+00/ DATA HUN/1.0D+02/ OPEN(750,FILE="PRE.TXT",STATUS="UNKNOWN") B = 0.39953D+05; AREAD = 3.4655D+08; C0 = 4.384D-01 C1 = 0.001939; CA = 0.010282D+03; KC = 0.0069087 F = B/AREAD; PCACO3 = 2.5D+04 ! Gmol/Km3 DP = 251.0; FM = 0.3D+07; PM = 2.5D+15 ! Unit: [FMg]/km2/yr, [PM]g/km3 BFC = 1.0 701 CONTINUE DEPTH = DP; PZD = DEPTH*100.0/1000.0 ! pressure at saturation horison CSAT = C0*EXP(C1*PZD)/CA ! EQ.1 IN ref3 I = NINT(DEPTH) - 250 +1 KS = 0.0127*365.0*(BFC(I)**0.45)/(12.7+365.0*(BFC(I)**0.45)) ! (KM/YR, see figure 3, ref2) ALFAN = 3.0; ALFAW = 0.25*BFC(I)+3.0*(1.0-BFC(I)) ! [cm] TmaxN = 1.0-0.483/2.5; TmaxW = 1.0-(0.483+0.0045*BFC(I))/2.5 ! PSIN = TmaxN-ALFAN*(1.0-TmaxN)*(EXP(-10.0/ALFAN)-1.0)/10.0 PSIW = TmaxW-ALFAW*(1.0-TmaxW)*(EXP(-10.0/ALFAW)-1.0)/10.0 ZL = 10.0*(1.0-PSIN)/(1.0-PSIW)/(1.0-BFC(I))/100000.0 ! Unit in [KM] PSI = PSIW FINDSAT = CO3D-CSAT IF(FINDSAT.GT.0.0) THEN W = F/(1.0-PSI)/PCACO3+FM/(1.0-PSI)/PM !!!!!!!!!!!!!!!!!! PCACO3+FM/(1.0-PSI)/PM not defined BFC(I) = F/(1.0-PSI)/PCACO3/W A = (F-(1.0-PSI)*W*BFC(I)*PCACO3)**2.0 GO TO 702 END IF Y = F+KC*(CO3D-CSAT) W = (F+KC*(CO3D-CSAT))/(1.0-PSI)/PCACO3+FM/(1.0-PSI)/PM BFC(I) = (F+KC*(CO3D-CSAT))/(1.0-PSI)/PCACO3/W A = (F+KC*(CO3D-CSAT)-(1.0-PSI)*W*BFC(I)*PCACO3)**2.0 702 IF(A.LT.1.0D-20) GO TO 703 GO TO 701 703 CONTINUE IF(DEPTH.EQ.2000.0) B1=BFC(I) IF(DEPTH.EQ.3000.0) B2=BFC(I) IF(DEPTH.EQ.4000.0) B3=BFC(I) IF((BFC(I).LT.0.1).AND.(BFC(I-1).GE.0.1)) Z10=DEPTH IF((BFC(I).GT.BFC(I-1)).OR.(BFC(I).LE.0.0)) GO TO 710 ! WRITE(*,760) DEPTH,BFC(I),CO3DP,CSAT,F,Y,W,PSI DP = DP + 1.0 GO TO 701 710 CONTINUE ZSNOW = DEPTH/1000.0;BFC(I:6251)=0.0 WRITE(750,760) DEPTH,BFC(I),CO3D,CSAT,F,Y,W,PSI IF (ZSNOW.LE.ZCCD) ZSNOW = ZCCD 760 FORMAT(20(D12.5,3X)) RETURN END SUBROUTINE PDCS ! SUBROUTINE PDCEN(DT,B,ZCCD,CO3D,ZSNOW,Z10,B1,B2,B3) IMPLICIT REAL*8 (A-H,O-Z) DIMENSION BFC(6251),DBFC(6251),OMEGA(6251) REAL*8 DEPTH,ZL,DP,FINDSAT,DBFC,BFC,KC,C0,C1,CA,KS ! COMMON /SAT/ C0,C1,CA,KC ! COMMON /SOURCES/ FA,BA,PA,BP,PP,FP ! COMMON /AREA/ AREADA,AREAZDA,AREADP,AREAZDP COMMON /PDC/ BFC DATA ZERO/0.0D+00/,ONE/1.0D+00/,TWO/2.0D+00/,TEN/1.0D+01/ DATA THREE/3.0D+00/,FOUR/4.0D+00/,FIVE/5.0D+00/,SIX/6.0D+00/ DATA HUN/1.0D+02/ INTEGER I OPEN(950,FILE="FINAL.dat",STATUS="UNKNOWN") AREAD = 3.4655D+08; C0 = 4.384D-01 C1 = 0.001939; CA = 0.010282D+03; KC = 0.0069087 F = B/AREAD; PCACO3 = 2.5D+04 ! Gmol/Km3 DP = 251.0; FM = 0.3D+07; PM = 2.5D+15 ! Unit: [FMg]/km2/yr, [PM]g/km3 901 CONTINUE DEPTH = DP; PZD = DEPTH*100.0/1000.0 ! pressure at saturation horison CSAT = C0*EXP(C1*PZD)/CA ! EQ.1 IN ref3 I = NINT(DEPTH) - 250 +1 KS = 0.0127*365.0*(BFC(I)**0.45)/(12.7+365.0*(BFC(I)**0.45)) ! (KM/YR, see figure 3, ref2) ALFAN = 3.0; ALFAW = 0.25*BFC(I)+3.0*(1.0-BFC(I)) ! [cm] TmaxN = 1.0-0.483/2.5; TmaxW = 1.0-(0.483+0.0045*BFC(I))/2.5 ! PSIN = TmaxN-ALFAN*(1.0-TmaxN)*(EXP(-10.0/ALFAN)-1.0)/10.0 PSIW = TmaxW-ALFAW*(1.0-TmaxW)*(EXP(-10.0/ALFAW)-1.0)/10.0 ZL = 10.0*(1.0-PSIN)/(1.0-PSIW)/(1.0-BFC(I))/100000.0 ! Unit in [KM] PSI = PSIW FINDSAT = CO3D-CSAT ! IF(FINDSAT.GT.0.0) THEN ! DBFCP(I) = 0.0 ! BFCP(I) = BFCP(I) + DBFCP(I) ! GO TO 903 ! END IF Y = F+KC*(CO3D-CSAT) W = (F+KC*(CO3D-CSAT))/(1.0-PSI)/PCACO3+FM/(1.0-PSI)/PM DBFC(I)=DT*(F+KC*(CO3D-CSAT)-(1.0-PSI)*W*PCACO3*BFC(I))/ # PCACO3/ZL BFC(I) = BFC(I) + DBFC(I) OMEGA(I) = CO3D/CSAT 903 CONTINUE IF(BFC(I).GT.0.81706) BFC(I)=0.81706 IF(DEPTH.EQ.2000.0) B1=BFC(I) IF(DEPTH.EQ.3000.0) B2=BFC(I) IF(DEPTH.EQ.4000.0) B3=BFC(I) IF((BFC(I).LT.0.1).AND.(BFC(I-1).GE.0.1)) Z10=DEPTH IF((BFC(I).GT.BFC(I-1)).OR.(BFC(I).LE.0.0)) GO TO 910 ! WRITE(*,960) DEPTH,BFC(I),OMEGA(I),DBFC(I),CO3D,CSAT,F,Y,W,PSI,FINDSAT ! WRITE(950,960) DEPTH,BFC(I),OMEGA(I),DBFC(I),CO3D,CSAT,F,Y,W,PSI,FINDSAT DP = DP + 1.0; GO TO 901 910 CONTINUE ZSNOW = DEPTH/1000.0; BFC(I:6251)=0.0;OMEGA(I:6251)=0.0 ! WRITE(*,960) DEPTH,BFC(I),OMEGA(I),DBFC(I),CO3D,CSAT,F,Y,W,PSI,FINDSAT ! WRITE(950,960) DEPTH,BFC(I),OMEGA(I),DBFC(I),CO3D,CSAT,F,Y,W,PSI,FINDSAT IF (ZSNOW.LT.ZCCD) ZSNOW = ZCCD 960 FORMAT(20(D12.5,3X)) RETURN END SUBROUTINE PDCEN ! SUBROUTINE EQUIL Calculates the equilibrium constant for ! the reaction: CO2 + CO3 + H2O <-> 2 HCO3 ! ! THIS PROGRAMS USES THE NEW FORMULAS FROM MILERO (GCA, 1995) ! AND CLEGG AND WHITFIELD (GCA, 1995), WITH CORRECTIONS FOR PRESSURE ! FROM MILERO (1983, CHEM. OCEAN. v. 8), AND UNESCO (1983). SUBROUTINE EQUIL(T,P,S,KEQ,K2EQ) IMPLICIT REAL*8 (A-H,K,L,O-Z) DIMENSION K(2) DATA ONE/1.0D+00/,TEN/1.0D+01/ TK = T + 273.15D+00 LNTK = LOG(TK) S2 = S*S SQS = SQRT(S) S23 = SQRT(S*S*S) PP = (P-1.0)*1.013D+00 R = 83.147D+00 LNKC1 = 2.18867 - 2275.036/TK - 1.468591*LNTK LNKC1 = LNKC1 + (-0.138681 - 9.33291/TK)*SQS LNKC1 = LNKC1 + 0.0726483*S - 0.00574938*S23 pK1 = 3670.7/TK-62.008+9.7944*LNTK-0.0118*S+0.000116*S2 ! New LNKC1=LOG(10**(-pK1)) ! New A0 = 25.50; A1 = 0.151; A2 = - 0.1271 DV = -(A0 + A1*(S-34.8) + A2*T) B0 = 3.08; B1 = 0.578; B2 = - 0.0877 DK = - (B0 + B1*(S-34.8) + B2*T)/1000.0 LNKC1 = - DV/(R*TK)*PP + 0.5*DK/(R*TK)*PP*PP + LNKC1 K(1) = EXP(LNKC1) LNKC2 = -0.84226 - 3741.1288/TK - 1.437139*LNTK LNKC2 = LNKC2 + (-0.128417 - 24.41239/TK)*SQS LNKC2 = LNKC2 + 0.1195308*S - 0.0091284*S23 pK2 = 1394.7/TK+4.777-0.0184*S+0.000118*S2 LNKC2=LOG(10**(-pK2)); A0 = 15.82; A1 = - 0.321; A2 = 0.0219 DV = -(A0 + A1*(S-34.8) + A2*T) B0 = - 1.13; B1 = 0.314; B2 = 0.1475 DK = - (B0 + B1*(S-34.8) + B2*T)/1000.0 LNKC2 = - DV/(R*TK)*PP + 0.5*DK/(R*TK)*PP*PP + LNKC2 K(2) = EXP(LNKC2) KEQ = K(1)/K(2); K2EQ = EXP(LNKC2) LK1 = LOG10(K(1)) LK2 = LOG10(K(2)) LKEQ = LOG10(KEQ) RETURN END ! BORATE Calculates the value of thermodynamic "STOICHIOMETRIC" constant ! Borate SUBROUTINE BORATE(KB,T,S,P) IMPLICIT REAL*8 (A-H,K,L,O-Z) DIMENSION K(12) DATA ONE/1.0D+00/,TEN/1.0D+01/ TK = T + 273.15D+00 LNTK = LOG(TK) S2 = S*S SQS = DSQRT(S) S23 = DSQRT(S*S*S) PP = (P-1.0)*1.013D+00 R = 83.147D+00 ! BORIC ACID LNKB = (-8966.90 -2890.51*SQS -77.942*S +1.726*S23 -0.0993*S2)/TK LNKB = LNKB + (148.0248 + 137.194*SQS + 1.62247*S) LNKB = LNKB + (-24.4344 - 25.085*SQS - 0.2474*S)*LNTK LNKB = LNKB + 0.053105*SQS*TK A0 = 29.48; A1 = - 0.295; A2 = - 0.1622; A3 = 2.608E-03 DV = -(A0 + A1*(S-34.8) + A2*T + A3*T*T) B0 = 2.84; B1 = - 0.354 DK = - (B0 + B1*(S-34.8))/1000.0 LNKB = - DV/(R*TK)*PP + 0.5*DK/(R*TK)*PP*PP + LNKB K(4) = DEXP(LNKB); KB = K(4) RETURN END ! METHANE RELEASE INTO BOTH OCEAN BASINS ! NOW AT 5% BUBLE CONDITION AS IN ARCHER ET AL. 2009 DOUBLE PRECISION FUNCTION CH4(T) ! Archer's medium condition IMPLICIT REAL*8 (A-I,O-Z) DATA ONE/1.0D+00/,TWO/2.0D+00/,TEN/1.0D+01/ IF(T.GT.0.0) THEN CH4 = 230.5*(T**0.771)*1000000.0/12.0 ELSE CH4 = 0.0 ENDIF RETURN END DOUBLE PRECISION FUNCTION CH5(T) ! Archer's extreme IMPLICIT REAL*8 (A-I,O-Z) DATA ONE/1.0D+00/,TWO/2.0D+00/,TEN/1.0D+01/ IF(T.GT.0.0) THEN CH5 = 563.7*(T**0.602)*1000000.0/12.0 ELSE CH5 = 0.0 ENDIF RETURN END DOUBLE PRECISION FUNCTION CH6(T) ! Japanese emission IMPLICIT REAL*8 (A-I,O-Z) DATA ONE/1.0D+00/,TWO/2.0D+00/,TEN/1.0D+01/ A0=-128.01; A1 = 0.10974; A2 = -3.0771D-05; A3 = 4.2559D-9 A4 = -3.1588D-13; A5 = 1.2055D-17; A6 = -1.8585D-22 IF(T.GT.2100.0) THEN CH6 = (A0+A1*T**1+A2*T**2+A3*T**3+A4*T**4+A5*T**5+A6*T**6) # *10000.0/12.0 ELSE CH6 = 0.0 ENDIF RETURN END c c ! HUMAN CO2 INPUT INTO THE ATMOSPHERE DOUBLE PRECISION FUNCTION CO2EM(T) IMPLICIT REAL*8 (A-I,O-Z) DATA ONE/1.0D+00/,TWO/2.0D+00/,TEN/1.0D+01/ c c The quasi-Anthropogenic release c c A = 1.65D+04 c B = 2.084D+03 c C = 9.263D+01 c c The quasi-PETM release c A = 1.65D+03 B = 4.0D+03 C = 9.263D+02 c c The quasi-K/T relase c c A = 1.65D+05 c B = 2.0D+03 c C = 9.267D+00 CO2EM = A*EXP(-((T-B)/C)**TWO)*1000.0/12.0 IF(T.GT.1.5D+05) CO2EM = 0.0 RETURN END ! O2SOLU Function subroutine calculates the SOLUBILITY OF O2 ! Based on 'Oxygen solubility in seawater: Better fitting equations (1992)' on L.O. DOUBLE PRECISION FUNCTION O2SOLU(T,S) IMPLICIT REAL*8 (A-H,O-Z) A1 = 5.80818; A2 = 3.20684; A3 = 4.11890 A4 = 4.93845; A5 = 1.01567; A6 = 1.41575 B1 = -0.00701211; B2 = -0.00725958; B3 = -0.00793334 B4 = -0.00554491; C = -0.132412 R = LOG((298.15-T)/(273.15+T)) TCS = EXP(A1+A2*R+A3*R**2+A4*R**3+A5*R**4+A6*R**5 # +S*(B1+B2*R+B3*R**2+B4*R**3)+C*S**2*0.000001) O2SOLU = TCS/1000.0 RETURN END !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! AREA Function subroutine calculates the area of bottom ! between depth Z1 and the depth Z2. Based on ! simple polynoal fit to averaged hypsographic data. DOUBLE PRECISION FUNCTION AREA(Z1,Z2) IMPLICIT REAL*8 (A-H,O-Z) DIMENSION H(6) H(1) = 9.1429D+07; H(2) = -1.1357D+08; H(3) = 2.4103D+07 H(4) = 1.4012D+07; H(5) = -4.4352D+06; H(6) = 3.1851D+05 AREA = H(1)*(Z2-Z1) + H(2)/2.0*(Z2**2 - Z1**2) + H(3)/3.0 # *(Z2**3 - Z1**3) + H(4)/4.0*(Z2**4 - Z1**4) # + H(5)/5.0*(Z2**5 - Z1**5) + H(6)/6.0*(Z2**6 - Z1**6) RETURN END ! ARSAT Function subroutine that calculates the integral of the ! differential area multiplied by the saturation concentration DOUBLE PRECISION FUNCTION ARSAT(ZS,ZD) IMPLICIT REAL*8 (A-H,O-Z) COMMON /SAT/ C0,C1!,CA,KC,C0DA,C1DA,C0DE,C1DE,C0SA,C1SA,C0SE, ! # C1SE,C0IA,C1IA,C0IE,C1IE A0 = 9.1429D+07; A1 = -1.1357D+08; A2 = 2.4103D+07 A3 = 1.4012D+07; A4 = -4.4352D+06; A5 = 3.1851D+05 C1 = C1*100.0 T1 = EXP(C1*ZD)/(C1**6)*(C1**5*(A5*ZD**5 + A4*ZD**4 + A3*ZD**3 # + A2*ZD**2 + A1*ZD + A0) - C1**4*(5.0*A5*ZD**4 + 4.0*A4*ZD**3 # + 3.0*A3*ZD**2 + 2.0*A2*ZD + A1) + C1**3*(20.0*A5*ZD**3 # + 12.0*A4*ZD**2 + 6.0*A3*ZD + 2.0*A2) - C1**2*(60.0*A5*ZD**2 # + 24.0*A4*ZD + 6.0*A3) + C1*(120.0*A5*ZD + 24.0*A4) -120.0*A5) T2 = EXP(C1*ZS)/(C1**6)*(C1**5*(A5*ZS**5 + A4*ZS**4 + A3*ZS**3 # + A2*ZS**2 + A1*ZS + A0) - C1**4*(5.0*A5*ZS**4 + 4.0*A4*ZS**3 # + 3.0*A3*ZS**2 + 2.0*A2*ZS + A1) + C1**3*(20.0*A5*ZS**3 # + 12.0*A4*ZS**2 + 6.0*A3*ZS + 2.0*A2) - C1**2*(60.0*A5*ZS**2 # + 24.0*A4*ZS + 6.0*A3) + C1*(120.0*A5*ZS + 24.0*A4) -120.0*A5) ARSAT = T1 - T2; C1 = C1/100.0 RETURN END