/[MITgcm]/MITgcm/pkg/dic/dic_biotic_forcing.F
ViewVC logotype

Contents of /MITgcm/pkg/dic/dic_biotic_forcing.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.13 - (show annotations) (download)
Tue Dec 12 22:37:28 2006 UTC (17 years, 5 months ago) by stephd
Branch: MAIN
CVS Tags: checkpoint58u_post, checkpoint58w_post, checkpoint58x_post, checkpoint58t_post, checkpoint59a, checkpoint59, checkpoint58y_post, checkpoint58v_post, checkpoint58s_post
Changes since 1.12: +6 -2 lines
o add new diagnostic (phosphorus export production)

1 C $Header: /u/gcmpack/MITgcm/pkg/dic/dic_biotic_forcing.F,v 1.12 2006/11/28 21:16:03 stephd Exp $
2 C $Name: $
3
4 #include "DIC_OPTIONS.h"
5 #include "GCHEM_OPTIONS.h"
6
7 CBOP
8 C !ROUTINE: DIC_BIOTIC_FORCING
9
10 C !INTERFACE: ==========================================================
11 SUBROUTINE DIC_BIOTIC_FORCING( PTR_DIC, PTR_ALK, PTR_PO4,
12 & PTR_DOP, PTR_O2,
13 #ifdef ALLOW_FE
14 & PTR_FE,
15 #endif
16 & bi,bj,imin,imax,jmin,jmax,
17 & myIter,myTime,myThid)
18
19 C !DESCRIPTION:
20 C updates all the tracers for the effects of air-sea exchange, biological
21 c activity and remineralization
22
23 C !USES: ===============================================================
24 IMPLICIT NONE
25 #include "SIZE.h"
26 #include "DYNVARS.h"
27 #include "EEPARAMS.h"
28 #include "PARAMS.h"
29 #include "GRID.h"
30 #include "DIC_BIOTIC.h"
31 #include "DIC_ABIOTIC.h"
32
33 C !INPUT PARAMETERS: ===================================================
34 C myThid :: thread number
35 C myIter :: current timestep
36 C myTime :: current time
37 C PTR_DIC :: dissolced inorganic carbon
38 C PTR_ALK :: alkalinity
39 C PTR_PO4 :: phosphate
40 c PTR_DOP :: dissolve organic phosphurous
41 c PTR_O2 :: oxygen
42 C PTR_FE :: iron
43 INTEGER myIter
44 _RL myTime
45 INTEGER myThid
46 _RL PTR_DIC(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
47 _RL PTR_ALK(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
48 _RL PTR_PO4(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
49 _RL PTR_DOP(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
50 _RL PTR_O2(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
51 #ifdef ALLOW_FE
52 _RL PTR_FE(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
53 #endif
54 INTEGER bi, bj, imin, imax, jmin, jmax
55
56 #ifdef ALLOW_PTRACERS
57 #ifdef DIC_BIOTIC
58
59 C !LOCAL VARIABLES: ====================================================
60 C i,j,k :: loop indices
61 C G* :: tendency term for the tracers
62 C SURA :: tendency of alkalinity due to freshwater
63 C SURC :: tendency of DIC due to air-sea exchange
64 C and virtual flux
65 C SURO :: tendency of O2 due to air-sea exchange
66 C BIO :: tendency of PO4 due to biological productivity,
67 C exchange with DOP pool and reminerization
68 C CAR :: carbonate changes due to biological
69 C productivity and reminerization
70 C bioac :: biological productivity
71 C pflux :: changes to PO4 due to flux and reminerlization
72 c cflux :: carbonate changes due to flux and reminerlization
73 c freefe :: iron not bound to ligand
74 _RL GDIC(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
75 _RL GALK(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
76 _RL GPO4(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
77 _RL GDOP(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
78 _RL GO2(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
79 _RL SURA(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
80 _RL SURC(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
81 _RL SURO(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
82 _RL BIO(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
83 _RL BIO_kar(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
84 _RL CAR(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
85 _RL bioac(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
86 _RL pflux(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
87 _RL exportflux(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
88 _RL cflux(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
89 #ifdef ALLOW_FE
90 _RL GFE(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
91 _RL freefe(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
92 #endif
93 INTEGER I,J,k
94 INTEGER nCALCITEstep
95 CEOP
96 jmin=1
97 jmax=sNy
98 imin=1
99 imax=sNx
100
101 DO k=1,Nr
102 DO j=1-OLy,sNy+OLy
103 DO i=1-OLx,sNx+OLx
104 GDIC(i,j,k)=0.d0
105 GALK(i,j,k)=0.d0
106 GPO4(i,j,k)=0.d0
107 GDOP(i,j,k)=0.d0
108 GO2(i,j,k)=0.d0
109 SURA(i,j)=0.d0
110 SURC(i,j)=0.d0
111 CAR(i,j,k)=0.d0
112 BIO(i,j,k)=0.d0
113 BIO_kar(i,j,k)=0.d0
114 bioac(i,j,k)=0.d0
115 pflux(i,j,k)=0.d0
116 exportflux(i,j,k)=0.d0
117 cflux(i,j,k)=0.d0
118 #ifdef ALLOW_FE
119 GFE(i,j,k)=0.d0
120 freefe(i,j,k)=0.d0
121 #endif
122 ENDDO
123 ENDDO
124 ENDDO
125
126 c carbon air-sea interaction
127 CALL DIC_SURFFORCING( PTR_DIC, PTR_ALK, PTR_PO4, SURC,
128 & bi,bj,imin,imax,jmin,jmax,
129 & myIter,myTime,myThid)
130
131 c alkalinity air-sea interaction
132 CALL ALK_SURFFORCING( PTR_ALK, SURA,
133 & bi,bj,imin,imax,jmin,jmax,
134 & myIter,myTime,myThid)
135
136 c carbon air-sea interaction
137 CALL O2_SURFFORCING( PTR_O2, SURO,
138 & bi,bj,imin,imax,jmin,jmax,
139 & myIter,myTime,myThid)
140
141 #ifdef ALLOW_FE
142 c find free iron
143 call fe_chem(bi,bj,iMin,iMax,jMin,jMax, PTR_FE, freefe,
144 & myIter, mythid)
145 #endif
146
147
148 c biological activity
149 CALL BIO_EXPORT( PTR_PO4 ,
150 #ifdef ALLOW_FE
151 I PTR_FE,
152 #endif
153 I bioac,
154 I bi,bj,imin,imax,jmin,jmax,
155 I myIter,myTime,myThid)
156
157 c flux of po4 from layers with biological activity
158 CALL PHOS_FLUX( bioac, pflux, exportflux,
159 & bi,bj,imin,imax,jmin,jmax,
160 & myIter,myTime,myThid)
161
162 c carbonate
163 #ifdef CAR_DISS
164 c dissolution only below saturation horizon
165 c code following methid by Karsten Friis
166 nCALCITEstep = 3600
167 IF(myIter .lt. (nIter0+5) .or.
168 & mod(myIter,nCALCITEstep) .eq. 0)THEN
169 CALL CALCITE_SATURATION(PTR_DIC, PTR_ALK, PTR_PO4,
170 I bi,bj,imin,imax,jmin,jmax,
171 I myIter,myTime,myThid)
172 ENDIF
173 c
174 CALL CAR_FLUX_OMEGA_TOP( bioac, cflux,
175 & bi,bj,imin,imax,jmin,jmax,
176 & myIter,myTime,myThid)
177 #else
178 c old OCMIP way
179 CALL CAR_FLUX( bioac, cflux,
180 & bi,bj,imin,imax,jmin,jmax,
181 & myIter,myTime,myThid)
182 #endif
183
184 c add all tendencies for PO4, DOP, ALK, DIC
185 DO k=1,Nr
186 DO j=jmin,jmax
187 DO i=imin,imax
188 bio(i,j,k)=-bioac(i,j,k)+pflux(i,j,k)
189 & + maskC(i,j,k,bi,bj)*Kdopremin*PTR_DOP(i,j,k)
190 car(i,j,k)=-bioac(i,j,k)* R_cp*rain_ratio(i,j,bi,bj)*
191 & (1.0-DOPfraction)+cflux(i,j,k)
192 GPO4(i,j,k)=bio(i,j,k)
193 GDOP(i,j,k)=+bioac(i,j,k)*DOPfraction
194 & - maskC(i,j,k,bi,bj)*Kdopremin*PTR_DOP(i,j,k)
195 GALK(i,j,k)=+2.d0*car(i,j,k)-R_NP*bio(i,j,k)
196 BIO_kar(i,j,k)=R_NP*bio(i,j,k)
197 GDIC(i,j,k)=car(i,j,k)+R_CP*bio(i,j,k)
198 if (PTR_O2(i,j,k).gt.o2crit) then
199 GO2(i,j,k)=R_OP*bio(i,j,k)
200 else
201 GO2(i,j,k)=0.d0
202 endif
203 #ifdef ALLOW_FE
204 GFE(i,j,k)=R_FeP*bio(i,j,k)
205 & -Kscav*freefe(i,j,k)
206 #endif
207 IF (K.eq.1) then
208 GALK(i,j,1)=GALK(i,j,1)+SURA(i,j)
209 GDIC(i,j,1)=GDIC(i,j,1)+SURC(i,j)
210 GO2(i,j,1)=GO2(i,j,1)+SURO(i,j)
211 #ifdef ALLOW_FE
212 GFE(i,j,1)=GFE(i,j,1)+alpfe*
213 & InputFe(i,j,bi,bj)*recip_drF(1)
214 & *recip_hFacC(i,j,1,bi,bj)
215 #endif
216 ENDIF
217 ENDDO
218 ENDDO
219 ENDDO
220
221
222 C update
223 DO k=1,Nr
224 DO j=jmin,jmax
225 DO i=imin,imax
226 PTR_DIC(i,j,k)=
227 & PTR_DIC(i,j,k)+GDIC(i,j,k)*dTtracerLev(k)
228 PTR_ALK(i,j,k)=
229 & PTR_ALK(i,j,k)+GALK(i,j,k)*dTtracerLev(k)
230 PTR_PO4(i,j,k)=
231 & PTR_PO4(i,j,k)+GPO4(i,j,k)*dTtracerLev(k)
232 PTR_DOP(i,j,k)=
233 & PTR_DOP(i,j,k)+GDOP(i,j,k)*dTtracerLev(k)
234 PTR_O2(i,j,k)=
235 & PTR_O2(i,j,k)+GO2(i,j,k)*dTtracerLev(k)
236 #ifdef ALLOW_FE
237 PTR_FE(i,j,k)=
238 & PTR_FE(i,j,k)+GFE(i,j,k)*dTtracerLev(k)
239 #endif
240 ENDDO
241 ENDDO
242 ENDDO
243
244 #ifdef ALLOW_FE
245 #ifdef MINFE
246 c find free iron and get rid of insoluble part
247 call fe_chem(bi,bj,iMin,iMax,jMin,jMax, PTR_FE, freefe,
248 & myIter, mythid)
249 #endif
250 #endif
251
252
253 #ifdef ALLOW_TIMEAVE
254 c save averages
255 DO k=1,Nr
256 DO j=jmin,jmax
257 DO i=imin,imax
258 BIOave(i,j,k,bi,bj)=BIOave(i,j,k,bi,bj)+
259 & BIOac(i,j,k)*deltaTclock
260 CARave(i,j,k,bi,bj)=CARave(i,j,k,bi,bj)+
261 & CAR(i,j,k)*deltaTclock
262 OmegaCave(i,j,k,bi,bj)= OmegaCave(i,j,k,bi,bj)+
263 & OmegaC(i,j,k,bi,bj)*deltaTclock
264 pfluxave(i,j,k,bi,bj)= pfluxave(i,j,k,bi,bj) +
265 & pflux(i,j,k)*deltaTclock
266 epfluxave(i,j,k,bi,bj)= epfluxave(i,j,k,bi,bj) +
267 & exportflux(i,j,k)*deltaTclock
268 cfluxave(i,j,k,bi,bj)= cfluxave(i,j,k,bi,bj) +
269 & cflux(i,j,k)*deltaTclock
270 if (k.eq.1) then
271 SURave(i,j,bi,bj)=SURave(i,j,bi,bj)+
272 & SURC(i,j)*deltaTclock
273 SUROave(i,j,bi,bj)=SUROave(i,j,bi,bj)+
274 & SURO(i,j)*deltaTclock
275 pCO2ave(i,j,bi,bj)=pCO2ave(i,j,bi,bj)+
276 & pCO2(i,j,bi,bj)*deltaTclock
277 pHave(i,j,bi,bj)=pHave(i,j,bi,bj)+
278 & pH(i,j,bi,bj)*deltaTclock
279 fluxCO2ave(i,j,bi,bj)=fluxCO2ave(i,j,bi,bj)+
280 & fluxCO2(i,j,bi,bj)*deltaTclock
281 endif
282 ENDDO
283 ENDDO
284 ENDDO
285 do k=1,Nr
286 dic_timeave(bi,bj,k)=dic_timeave(bi,bj,k)+deltaTclock
287 enddo
288 #endif
289
290 #endif
291 #endif
292
293 c
294 RETURN
295 END

  ViewVC Help
Powered by ViewVC 1.1.22