/[MITgcm]/MITgcm_contrib/bling/pkg/bling_production.F
ViewVC logotype

Annotation of /MITgcm_contrib/bling/pkg/bling_production.F

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


Revision 1.1 - (hide annotations) (download)
Fri May 23 17:33:43 2014 UTC (11 years, 2 months ago) by mmazloff
Branch: MAIN
Adding package BLING

1 mmazloff 1.1 C $Header: $
2     C $Name: $
3    
4     #include "BLING_OPTIONS.h"
5    
6     CBOP
7     subroutine BLING_PROD(
8     I PTR_NUT, PTR_FE, PTR_DOM, PTR_O2,
9     O NUT_uptake, POM_prod, DOM_prod,
10     O Fe_uptake, CaCO3_prod,
11     I bi, bj, imin, imax, jmin, jmax,
12     I myIter, myTime, myThid )
13    
14     C =================================================================
15     C | subroutine bling_prod
16     C | o Nutrient uptake and partitioning between organic pools.
17     C | - Phytoplankton biomass-specific growth rate is calculated
18     C | as a function of light, nutrient limitation, and
19     C | temperature.
20     C | - A simple relationship between growth rate,
21     C | biomass, and uptake is derived by assuming that growth is
22     C | exactly balanced by losses.
23     C =================================================================
24    
25     implicit none
26    
27     C === Global variables ===
28     C P_sm :: Small phytoplankton biomass
29     C P_lg :: Large phytoplankton biomass
30     C irr_mem :: Phyto irradiance memory
31    
32     #include "SIZE.h"
33     #include "DYNVARS.h"
34     #include "EEPARAMS.h"
35     #include "PARAMS.h"
36     #include "GRID.h"
37     #include "BLING_VARS.h"
38     #include "PTRACERS_SIZE.h"
39     #include "PTRACERS_PARAMS.h"
40     #ifdef ALLOW_AUTODIFF_TAMC
41     # include "tamc.h"
42     #endif
43    
44     C === Routine arguments ===
45     C bi,bj :: tile indices
46     C iMin,iMax :: computation domain: 1rst index range
47     C jMin,jMax :: computation domain: 2nd index range
48     C myTime :: current time
49     C myIter :: current timestep
50     C myThid :: thread Id. number
51     INTEGER bi, bj, imin, imax, jmin, jmax
52     _RL myTime
53     INTEGER myIter
54     INTEGER myThid
55     C === Input ===
56     C PTR_NUT :: macro-nutrient concentration
57     C PTR_FE :: iron concentration
58     C PTR_DOM :: dissolved organic matter concentration
59     C PTR_O2 :: oxygen concentration
60     _RL PTR_NUT(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
61     _RL PTR_FE (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
62     _RL PTR_DOM(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
63     _RL PTR_O2 (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
64     C === Output ===
65     C DOM_prod :: production of dissolved organic matter
66     C POM_prod :: production of particulate organic matter
67     C Fe_uptake :: production of particulate iron
68     C CaCO3_prod :: CaCO3 uptake for growth
69     _RL DOM_prod (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
70     _RL POM_prod (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
71     _RL Fe_uptake (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
72     _RL CaCO3_prod(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
73    
74     #ifdef ALLOW_BLING
75     C === Local variables ===
76     C i,j,k :: loop indices
77     C irr_eff :: effective irradiance
78     C NUT_lim :: macro-nutrient limitation
79     C FetoP_up :: ratio of iron to phosphorus uptake
80     C Fe_lim :: iron limitation
81     C alpha_Fe :: initial slope of the P-I curve
82     C theta_Fe :: Chl:C ratio
83     C theta_Fe_max :: Fe-replete maximum Chl:C ratio
84     C irrk :: nut-limited efficiency of algal photosystems
85     C Pc_m :: light-saturated maximal photosynthesis rate
86     C Pc_tot :: carbon-specific photosynthesis rate
87     C expkT :: temperature function
88     C mu :: net carbon-specific growth rate
89     C biomass_sm :: nutrient concentration in small phyto biomass
90     C biomass_lg :: nutrient concentration in large phyto biomass
91     C NUT_uptake :: nutrient uptake
92     C C_flux :: carbon export flux 3d field
93     C chl :: chlorophyll diagnostic
94     INTEGER i,j,k
95     _RL irr_eff(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
96     _RL NUT_lim
97     _RL FetoP_up
98     _RL Fe_lim
99     _RL alpha_Fe
100     _RL theta_Fe
101     _RL theta_Fe_max
102     _RL irrk
103     _RL Pc_m
104     _RL Pc_tot
105     _RL expkT
106     _RL mu
107     _RL biomass_sm
108     _RL biomass_lg
109     _RL NUT_uptake(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
110     _RL C_flux(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
111     _RL chl(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
112     CEOP
113    
114     c ---------------------------------------------------------------------
115     c Initialize output and diagnostics
116     DO k=1,Nr
117     DO j=jmin,jmax
118     DO i=imin,imax
119     POM_prod(i,j,k) = 0. _d 0
120     DOM_prod(i,j,k) = 0. _d 0
121     Fe_uptake(i,j,k) = 0. _d 0
122     CaCO3_prod(i,j,k) = 0. _d 0
123     C_flux(i,j,k) = 0. _d 0
124     chl(i,j,k) = 0. _d 0
125     irr_eff(i,j,k) = 0. _d 0
126     ENDDO
127     ENDDO
128     ENDDO
129    
130     c ---------------------------------------------------------------------
131     c Available light
132     CALL BLING_LIGHT(
133     U irr_eff,
134     I bi, bj, imin, imax, jmin, jmax,
135     I myIter, myTime, myThid )
136    
137     c ---------------------------------------------------------------------
138     c Nutrient uptake and partitioning between organic pools
139    
140     DO k=1,Nr
141     DO j=jmin,jmax
142     DO i=imin,imax
143    
144     IF (hFacC(i,j,k,bi,bj) .gt. 0. _d 0) THEN
145    
146     #ifndef BLING_ADJOINT_SAFE
147     #ifdef BLING_NO_NEG
148     PTR_NUT(i,j,k) = max( 0. _d 0, PTR_NUT(i,j,k) )
149     PTR_FE(i,j,k) = max( 0. _d 0, PTR_FE(i,j,k) )
150     #endif
151     #endif
152    
153     c ---------------------------------------------------------------------
154     c First, calculate the limitation terms for NUT and Fe, and the
155     c Fe-limited Chl:C maximum. The light-saturated maximal photosynthesis
156     c rate term (Pc_m) is simply the product of a prescribed maximal
157     c photosynthesis rate (Pc_0), the Eppley temperature dependence, and a
158     c resource limitation term. The iron limitation term has a lower limit
159     c of Fe_lim_min and is scaled by (k_Fe2P + Fe2P_max) / Fe2P_max so that
160     c it approaches 1 as Fe approaches infinity. Thus, it is of comparable
161     c magnitude to the macro-nutrient limitation term.
162    
163     c Macro-nutrient limitation
164     NUT_lim = PTR_NUT(i,j,k)/(PTR_NUT(i,j,k)+k_NUT)
165    
166     c Iron to macro-nutrient uptake. More iron is utilized relative
167     c to macro-nutrient under iron-replete conditions.
168     FetoP_up = FetoP_max*PTR_FE(i,j,k)/(k_Fe+PTR_FE(i,j,k))
169    
170     c Iron limitation
171     Fe_lim = Fe_lim_min + (1-Fe_lim_min)*(FetoP_up/(k_FetoP
172     & + FetoP_up))*(k_FetoP+FetoP_max)/FetoP_max
173    
174     c ---------------------------------------------------------------------
175     c For the effective resource limitation, there is an option to replace
176     c the default Liebig limitation (the minimum of Michaelis-Menton
177     c NUT-limitation, or iron-limitation) by the product (safer for adjoint)
178    
179     c Light-saturated maximal photosynthesis rate
180     #ifdef MULT_NUT_LIM
181     Pc_m = Pc_0*exp(kappa_eppley*theta(i,j,k,bi,bj))
182     & *NUT_lim*Fe_lim*maskC(i,j,k,bi,bj)
183     #else
184     Pc_m = Pc_0*exp(kappa_eppley*theta(i,j,k,bi,bj))
185     & *min( NUT_lim, Fe_lim )*maskC(i,j,k,bi,bj)
186     #endif
187    
188    
189     c ---------------------------------------------------------------------
190     c Fe limitation 1) reduces photosynthetic efficiency (alpha_Fe)
191     c and 2) reduces the maximum achievable Chl:C ratio (theta_Fe)
192     c below a prescribed, Fe-replete maximum value (theta_Fe_max),
193     c to approach a prescribed minimum Chl:C (theta_Fe_min) under extreme
194     c Fe-limitation.
195    
196     alpha_Fe = alpha_min + (alpha_max-alpha_min)*Fe_lim
197     theta_Fe_max = theta_Fe_max_lo+
198     & (theta_Fe_max_hi-theta_Fe_max_lo)*Fe_lim
199     theta_Fe = theta_Fe_max/(1. _d 0 + alpha_Fe*theta_Fe_max
200     & *irr_mem(i,j,k,bi,bj)/(2. _d 0*Pc_m))
201    
202     c ---------------------------------------------------------------------
203     c Nutrient-limited efficiency of algal photosystems, irrk, is calculated
204     c with the iron limitation term included as a multiplier of the
205     c theta_Fe_max to represent the importance of Fe in forming chlorophyll
206     c accessory antennae, which do not affect the Chl:C but still affect the
207     c phytoplankton ability to use light (eg Stzrepek & Harrison, Nature 2004).
208    
209     irrk = Pc_m/(alpha_Fe*theta_Fe_max) +
210     & irr_mem(i,j,k,bi,bj)/2. _d 0
211    
212     c Carbon-specific photosynthesis rate
213     Pc_tot = Pc_m * ( 1. _d 0 - exp(-irr_eff(i,j,k)
214     & /(epsln + irrk)))
215    
216     c ---------------------------------------------------------------------
217     c Account for the maintenance effort that phytoplankton must exert in
218     c order to combat decay. This is prescribed as a fraction of the
219     c light-saturated photosynthesis rate, resp_frac. The result of this
220     c is to set a level of energy availability below which net growth
221     c (and therefore nutrient uptake) is zero, given by resp_frac * Pc_m.
222    
223     mu = max(0., Pc_tot - resp_frac*Pc_m)
224    
225     c ---------------------------------------------------------------------
226     c Since there is no explicit biomass tracer, use the result of Dunne
227     c et al. (GBC, 2005) to calculate an implicit biomass from the uptake
228     c rate through the application of a simple idealized grazing law.
229    
230     c instantaneous nutrient concentration in phyto biomass
231     biomass_lg = Pstar*(mu/(lambda_0
232     & *exp(kappa_eppley*theta(i,j,k,bi,bj))))**3
233     biomass_sm = Pstar*(mu/(lambda_0
234     & *exp(kappa_eppley*theta(i,j,k,bi,bj))))
235    
236     c phytoplankton biomass diagnostic
237     c for no lag: set gamma_biomass to 0
238     P_sm(i,j,k,bi,bj) = P_sm(i,j,k,bi,bj) +
239     & (biomass_sm - P_sm(i,j,k,bi,bj))
240     & *min(1., gamma_biomass*PTRACERS_dTLev(k))
241     P_lg(i,j,k,bi,bj) = P_lg(i,j,k,bi,bj) +
242     & (biomass_lg - P_lg(i,j,k,bi,bj))
243     & *min(1., gamma_biomass*PTRACERS_dTLev(k))
244    
245     c use the diagnostic biomass to calculate the chl concentration
246     chl(i,j,k) = (P_lg(i,j,k,bi,bj)+P_sm(i,j,k,bi,bj))
247     & *CtoP/NUTfac*theta_Fe*12.01
248    
249     c Nutrient uptake
250     NUT_uptake(i,j,k) = mu*(P_sm(i,j,k,bi,bj)
251     & + P_lg(i,j,k,bi,bj))
252    
253     c ---------------------------------------------------------------------
254     c Partitioning between organic pools
255    
256     c The uptake of nutrients is assumed to contribute to the growth of
257     c phytoplankton, which subsequently die and are consumed by heterotrophs.
258     c This can involve the transfer of nutrient elements between many
259     c organic pools, both particulate and dissolved, with complex histories.
260     c We take a simple approach here, partitioning the total uptake into two
261     c fractions - sinking and non-sinking - as a function of temperature,
262     c following Dunne et al. (2005).
263     c Then, the non-sinking fraction is further subdivided, such that the
264     c majority is recycled instantaneously to the inorganic nutrient pool,
265     c representing the fast turnover of labile dissolved organic matter via
266     c the microbial loop, and the remainder is converted to semi-labile
267     c dissolved organic matter. Iron and macro-nutrient are treated
268     c identically for the first step, but all iron is recycled
269     c instantaneously in the second step (i.e. there is no dissolved organic
270     c iron pool).
271    
272     c sinking fraction: particulate organic matter
273     expkT = exp(-kappa_remin*theta(i,j,k,bi,bj))
274     POM_prod(i,j,k) = phi_sm*expkT*mu*P_sm(i,j,k,bi,bj)
275     & + phi_lg*expkT*mu*P_lg(i,j,k,bi,bj)
276    
277     c the remainder is divided between instantaneously recycled and
278     c long-lived dissolved organic matter.
279     c (recycling = NUT_uptake - NUT_to_POM - NUT_to_DOM)
280    
281     DOM_prod(i,j,k) = phi_DOM*(NUT_uptake(i,j,k)
282     & - POM_prod(i,j,k))
283    
284     c Carbon flux diagnostic
285     C_flux(i,j,k) = CtoP/NUTfac*POM_prod(i,j,k)
286    
287     c Iron is then taken up as a function of nutrient uptake and iron
288     c limitation, with a maximum Fe:P uptake ratio of Fe2p_max
289     Fe_uptake(i,j,k) = POM_prod(i,j,k)*FetoP_up/NUTfac
290    
291     c ---------------------------------------------------------------------
292     c Alkalinity is consumed through the production of CaCO3. Here, this is
293     c simply a linear function of the implied growth rate of small
294     c phytoplankton, which gave a reasonably good fit to the global
295     c observational synthesis of Dunne (2009). This is consistent
296     c with the findings of Jin et al. (GBC,2006).
297    
298     CaCO3_prod(i,j,k) = P_sm(i,j,k,bi,bj)*phi_sm*expkT
299     & *mu*CatoP/NUTfac
300    
301     ENDIF
302     ENDDO
303     ENDDO
304     ENDDO
305    
306     c ---------------------------------------------------------------------
307    
308     #ifdef ALLOW_DIAGNOSTICS
309     IF ( useDiagnostics ) THEN
310     CALL DIAGNOSTICS_FILL(C_flux ,'BLGCflux',0,Nr,2,bi,bj,myThid)
311     CALL DIAGNOSTICS_FILL(P_sm*CtoP/NUTfac
312     & ,'BLGPsm ',0,Nr,1,bi,bj,myThid)
313     CALL DIAGNOSTICS_FILL(P_lg*CtoP/NUTfac
314     & ,'BLGPlg ',0,Nr,1,bi,bj,myThid)
315     CALL DIAGNOSTICS_FILL(chl ,'BLGchl ',0,Nr,2,bi,bj,myThid)
316     ENDIF
317     #endif /* ALLOW_DIAGNOSTICS */
318    
319     #endif /* ALLOW_BLING */
320    
321     RETURN
322     END
323    

  ViewVC Help
Powered by ViewVC 1.1.22