New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
iron_chem_scav.F90 in branches/UKMO/dev_r5518_medusa_chg_trc_bio_medusa/NEMOGCM/NEMO/TOP_SRC/MEDUSA – NEMO

source: branches/UKMO/dev_r5518_medusa_chg_trc_bio_medusa/NEMOGCM/NEMO/TOP_SRC/MEDUSA/iron_chem_scav.F90 @ 8062

Last change on this file since 8062 was 8062, checked in by marc, 7 years ago

Fixes to do with tmask(ji,jj,1) and mbathy(ji,jj) outside DO loop

File size: 24.9 KB
Line 
1MODULE iron_chem_scav_mod
2   !!======================================================================
3   !!                         ***  MODULE iron_chem_scav_mod  ***
4   !! Calculate the iron chemistry and scavenging.
5   !!======================================================================
6   !! History :
7   !!   -   ! 2017-04 (M. Stringer)        Code taken from trcbio_medusa.F90
8   !!----------------------------------------------------------------------
9#if defined key_medusa
10   !!----------------------------------------------------------------------
11   !!                                                   MEDUSA bio-model
12   !!----------------------------------------------------------------------
13
14   IMPLICIT NONE
15   PRIVATE
16     
17   PUBLIC   iron_chem_scav        ! Called in trcbio_medusa.F90
18
19   !!----------------------------------------------------------------------
20   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)
21   !! $Id$
22   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
23   !!----------------------------------------------------------------------
24
25CONTAINS
26
27   SUBROUTINE iron_chem_scav( jk )
28      !!-------------------------------------------------------------------
29      !!                     ***  ROUTINE iron_chem_scav  ***
30      !! This called from TRC_BIO_MEDUSA and
31      !!  -
32      !!-------------------------------------------------------------------
33      USE bio_medusa_mod,    ONLY: ffastc, ffastca, ffastsi,              &
34                                   ffetop, ffebot, ffescav, xfree,        & 
35                                   zdet, zfer, zphd, zphn, zzme, zzmi 
36      USE dom_oce,           ONLY: e3t_0, e3t_n, gdepw_0, gdepw_n,        &
37                                   mbathy, tmask
38      USE par_kind,          ONLY: wp
39      USE par_oce,           ONLY: jpi, jpim1, jpj, jpjm1
40      USE sms_medusa,        ONLY: i0500, jiron, xfe_sed, xfe_sol,        &
41                                   xk_FeL, xk_sc_Fe, xLgT,                &
42                                   xmassc, xmassca, xmasssi,              &
43                                   xthetad, xthetapd, xthetapn,           &
44                                   xthetazme, xthetazmi,                  &
45                                   zirondep
46
47   !!* Substitution
48#  include "domzgr_substitute.h90"
49
50      !! Level
51      INTEGER, INTENT( in ) :: jk
52
53      !! iron cycle; includes parameters for Parekh et al. (2005) iron scheme
54      !! state variables for iron-ligand system
55      REAL(wp), DIMENSION(jpi,jpj) :: xFeT, xFeF, xFeL
56      REAL(wp) :: xLgF
57      !! iron-ligand parameters
58      REAL(wp) :: xb_coef_tmp, xb2M4ac
59      !! max Fe' parameters
60      REAL(wp) :: xmaxFeF,fdeltaFe
61      !!
62      !! local parameters for Moore et al. (2004) alternative scavenging
63      !! scheme
64      REAL(wp) :: fbase_scav,fscal_sink,fscal_part,fscal_scav
65      !!
66      !! local parameters for Moore et al. (2008) alternative scavenging
67      !! scheme
68      REAL(wp) :: fscal_csink,fscal_sisink,fscal_casink
69      !!
70      !! local parameters for Galbraith et al. (2010) alternative
71      !! scavenging scheme.
72      !! organic portion of scavenging
73      REAL(wp) :: xCscav1, xCscav2, xk_org, xORGscav
74      !! inorganic portion of scavenging
75      REAL(wp) :: xk_inorg, xINORGscav
76
77      INTEGER :: ji, jj
78
79      !!------------------------------------------------------------------
80      !! Iron chemistry and fractionation
81      !! following the Parekh et al. (2004) scheme adopted by the Met.
82      !! Office, Medusa models total iron but considers "free" and
83      !! ligand-bound forms for the purposes of scavenging (only "free"
84      !! iron can be scavenged
85      !!------------------------------------------------------------------
86      DO jj = 2,jpjm1
87         DO ji = 2,jpim1
88            !! OPEN wet point IF..THEN loop
89            if (tmask(ji,jj,jk) == 1) then
90               !!
91               !! total iron concentration (mmol Fe / m3 -> umol Fe / m3)
92               xFeT(ji,jj) = zfer(ji,jj) * 1.e3
93               !!
94               !! calculate fractionation (based on Diat-HadOCC; in turn
95               !! based on Parekh et al., 2004)
96               xb_coef_tmp = xk_FeL * (xLgT - xFeT(ji,jj)) - 1.0
97               xb2M4ac     = max(((xb_coef_tmp * xb_coef_tmp) +              &
98                                  (4.0 * xk_FeL * xLgT)), 0.0)
99               !!
100               !! "free" ligand concentration
101               xLgF        = 0.5 * (xb_coef_tmp + (xb2M4ac**0.5)) / xk_FeL
102               !!
103               !! ligand-bound iron concentration
104               xFeL(ji,jj) = xLgT - xLgF
105               !!
106               !! "free" iron concentration (and convert to mmol Fe / m3)
107               xFeF(ji,jj) = (xFeT(ji,jj) - xFeL(ji,jj)) * 1.e-3
108               xFree(ji,jj)= xFeF(ji,jj) / (zfer(ji,jj) + tiny(zfer(ji,jj)))
109            ENDIF
110         ENDDO
111      ENDDO
112
113
114      !!
115      !! scavenging of iron (multiple schemes); I'm only really
116      !! happy with the first one at the moment - the others
117      !! involve assumptions (sometimes guessed at by me) that
118      !! are potentially questionable
119      !!
120      if (jiron.eq.1) then
121         !!------------------------------------------------------
122         !! Scheme 1: Dutkiewicz et al. (2005)
123         !! This scheme includes a single scavenging term based
124         !! solely on a fixed rate and the availablility of
125         !! "free" iron
126         !!------------------------------------------------------
127         DO jj = 2,jpjm1
128            DO ji = 2,jpim1
129               IF (tmask(ji,jj,jk) == 1) THEN
130                  !! = mmol/m3/d
131                  ffescav(ji,jj)     = xk_sc_Fe * xFeF(ji,jj)
132                  !!
133                  !!------------------------------------------------------
134                  !!
135                  !! Mick's code contains a further (optional) implicit
136                  !! "scavenging" of iron that sets an upper bound on
137                  !! "free" iron concentration, and essentially caps the
138                  !! concentration of total iron as xFeL + "free" iron;
139                  !! since the former is constrained by a fixed total
140                  !! ligand concentration (= 1.0 umol/m3), and the latter
141                  !! isn't allowed above this upper bound, total iron is
142                  !! constrained to a maximum of ...
143                  !!
144                  !!    xFeL(ji,jj) + min(xFeF(ji,jj), 0.3 umol/m3) = 1.0 + 0.3
145                  !!                                  = 1.3 umol / m3
146                  !!
147                  !! In Mick's code, the actual value of total iron is
148                  !! reset to this sum (i.e. TFe = FeL + Fe'; but
149                  !! Fe' <= 0.3 umol/m3); this isn't our favoured approach
150                  !! to tracer updating here (not least because of the
151                  !! leapfrog), so here the amount scavenged is augmented
152                  !! by an additional amount that serves to drag total
153                  !! iron back towards that expected from this limitation
154                  !! on iron concentration ...
155                  !!
156                  !! = umol/m3
157                  xmaxFeF     = min((xFeF(ji,jj) * 1.e3), 0.3)
158                  !!
159                  !! Here, the difference between current total Fe and
160                  !! (FeL + Fe') is calculated and added to the scavenging
161                  !! flux already calculated above ...
162                  !!
163                  !! = mmol/m3
164                  fdeltaFe    = (xFeT(ji,jj) - (xFeL(ji,jj) + xmaxFeF)) * 1.e-3
165                  !!
166                  !! This assumes that the "excess" iron is dissipated
167                  !! with a time-scale of 1 day; seems reasonable to me
168                  !! ... (famous last words)
169                  !!
170                  !! = mmol/m3/d
171                  ffescav(ji,jj)     = ffescav(ji,jj) + fdeltaFe
172                  !!
173# if defined key_deep_fe_fix
174                  !! AXY (17/01/13)
175                  !! stop scavenging for iron concentrations below
176                  !! 0.5 umol / m3 at depths greater than 1000 m; this
177                  !! aims to end MEDUSA's continual loss of iron at depth
178                  !! without impacting things at the surface too much; the
179                  !! justification for this is that it appears to be what
180                  !! Mick Follows et al. do in their work (as evidenced by
181                  !! the iron initial condition they supplied me with); to
182                  !! be honest, it looks like Follow et al. do this at
183                  !! shallower depths than 1000 m, but I'll stick with this
184                  !! for now; I suspect that this seemingly arbitrary
185                  !! approach effectively "parameterises" the
186                  !! particle-based scavenging rates that other models use
187                  !! (i.e. at depth there are no sinking particles, so
188                  !! scavenging stops); it might be fun justifying this in
189                  !! a paper though!
190                  !!
191                  if ((fsdepw(ji,jj,jk).gt.1000.) .and.                       &
192                       (xFeT(ji,jj).lt.0.5)) then
193                     ffescav(ji,jj) = 0.
194                  endif
195# endif
196               ENDIF
197            ENDDO
198         ENDDO
199      elseif (jiron.eq.2) then
200         !!------------------------------------------------------
201         !! Scheme 2: Moore et al. (2004)
202         !! This scheme includes a single scavenging term that
203         !! accounts for both suspended and sinking particles in
204         !! the water column; this term scavenges total iron rather
205         !! than "free" iron
206         !!------------------------------------------------------
207         DO jj = 2,jpjm1
208            DO ji = 2,jpim1
209               IF (tmask(ji,jj,jk) == 1) THEN
210                  !!
211                  !! total iron concentration (mmol Fe / m3 -> umol Fe / m3)
212                  xFeT(ji,jj) = zfer(ji,jj) * 1.e3
213                  !!
214                  !! this has a base scavenging rate (12% / y) which is
215                  !! modified by local particle concentration and sinking
216                  !! flux (and dust - but I'm ignoring that here for now)
217                  !! and which is accelerated when Fe concentration gets
218                  !! 0.6 nM (= 0.6 umol/m3 = 0.0006 mmol/m3), and decreased
219                  !! as concentrations below 0.4 nM (= 0.4 umol/m3 =
220                  !! 0.0004 mmol/m3)
221                  !!
222                  !! base scavenging rate (0.12 / y)
223                  fbase_scav = 0.12 / 365.25
224                  !!
225                  !! calculate sinking particle part of scaling factor
226                  !! this takes local fast sinking carbon (mmol C / m2 / d)
227                  !! and gets it into nmol C / cm3 / s ("rdt" below is the
228                  !! number of seconds in a model timestep)
229                  !!
230                  !! fscal_sink = ffastc(ji,jj) * 1.e2 / (86400.)
231                  !!
232                  !! ... actually, re-reading Moore et al.'s equations, it
233                  !! looks like he uses his sinking flux directly, without
234                  !! scaling it by time-step or anything, so I'll copy this
235                  !! here ...
236                  !!
237                  fscal_sink = ffastc(ji,jj) * 1.e2
238                  !!
239                  !! calculate particle part of scaling factor
240                  !! this totals up the carbon in suspended particles
241                  !! (Pn, Pd, Zmi, Zme, D),
242                  !! which comes out in mmol C / m3 (= nmol C / cm3), and
243                  !! then multiplies it by a magic factor, 0.002, to get it
244                  !! into nmol C / cm2 / s
245                  !!
246                  fscal_part = ( (xthetapn * zphn(ji,jj)) +                  &
247                                 (xthetapd * zphd(ji,jj)) +                  &
248                                 (xthetazmi * zzmi(ji,jj)) +                 &
249                                 (xthetazme * zzme(ji,jj)) +                 &
250                                 (xthetad * zdet(ji,jj)) ) * 0.002
251                  !!
252                  !! calculate scaling factor for base scavenging rate
253                  !! this uses the (now correctly scaled) sinking flux and
254                  !! standing
255                  !! particle concentration, divides through by some sort
256                  !! of reference value (= 0.0066 nmol C / cm2 / s) and
257                  !! then uses this, or not if its too high, to rescale the
258                  !! base scavenging rate
259                  !!
260                  fscal_scav = fbase_scav *                                  &
261                               min(((fscal_sink + fscal_part) / 0.0066), 4.0)
262                  !!
263                  !! the resulting scavenging rate is then scaled further
264                  !! according to the local iron concentration (i.e.
265                  !! diminished in low iron regions; enhanced in high iron
266                  !! regions; less alone in intermediate iron regions)
267                  !!
268                  if (xFeT(ji,jj).lt.0.4) then
269                     !!
270                     !! low iron region
271                     !!
272                     fscal_scav = fscal_scav * (xFeT(ji,jj) / 0.4)
273                     !!
274                  elseif (xFeT(ji,jj).gt.0.6) then
275                     !!
276                     !! high iron region
277                     !!
278                     fscal_scav = fscal_scav + ((xFeT(ji,jj) / 0.6) *        &
279                                                (6.0 / 1.4))
280                     !!
281                  else
282                     !!
283                     !! intermediate iron region: do nothing
284                     !!
285                  endif
286                  !!
287                  !! apply the calculated scavenging rate ...
288                  !!
289                  ffescav(ji,jj) = fscal_scav * zfer(ji,jj)
290                  !!
291               ENDIF
292            ENDDO
293         ENDDO
294      elseif (jiron.eq.3) then
295         !!------------------------------------------------------
296         !! Scheme 3: Moore et al. (2008)
297         !! This scheme includes a single scavenging term that
298         !! accounts for sinking particles in the water column,
299         !! and includes organic C, biogenic opal, calcium
300         !! carbonate and dust in this (though the latter is
301         !! ignored here until I work out what units the incoming
302         !! "dust" flux is in); this term scavenges total iron
303         !! rather than "free" iron
304         !!------------------------------------------------------
305         DO jj = 2,jpjm1
306            DO ji = 2,jpim1
307               IF (tmask(ji,jj,jk) == 1) THEN
308                  !!
309                  !! total iron concentration (mmol Fe / m3 -> umol Fe / m3)
310                  xFeT(ji,jj) = zfer(ji,jj) * 1.e3
311                  !!
312                  !! this has a base scavenging rate which is modified by
313                  !! local particle sinking flux (including dust - but I'm
314                  !! ignoring that here for now) and which is accelerated
315                  !! when Fe concentration is > 0.6 nM (= 0.6 umol/m3 =
316                  !! 0.0006 mmol/m3), and decreased as concentrations <
317                  !! 0.5 nM (= 0.5 umol/m3 = 0.0005 mmol/m3)
318                  !!
319                  !! base scavenging rate (Fe_b in paper; units may be
320                  !! wrong there)
321                  fbase_scav = 0.00384 ! (ng)^-1 cm
322                  !!
323                  !! calculate sinking particle part of scaling factor;
324                  !! this converts mmol / m2 / d fluxes of organic carbon,
325                  !! silicon and calcium carbonate into ng / cm2 / s
326                  !! fluxes; it is assumed here that the mass conversions
327                  !! simply consider the mass of the main element
328                  !! (C, Si and Ca) and *not* the mass of the molecules
329                  !! that they are part of; Moore et al. (2008) is unclear
330                  !! on the conversion that should be used
331                  !!
332                  !! milli -> nano; mol -> gram; /m2 -> /cm2; /d -> /s
333                  !! ng C  / cm2 / s
334                  fscal_csink  = (ffastc(ji,jj)  * 1.e6 * xmassc  *          &
335                                  1.e-4 / 86400.)
336                  !! ng Si / cm2 / s
337                  fscal_sisink = (ffastsi(ji,jj) * 1.e6 * xmasssi *          &
338                                  1.e-4 / 86400.)
339                  !! ng Ca / cm2 / s
340                  fscal_casink = (ffastca(ji,jj) * 1.e6 * xmassca *          &
341                                  1.e-4 / 86400.)
342                  !!
343                  !! sum up these sinking fluxes and convert to ng / cm
344                  !! by dividing through by a sinking rate of
345                  !! 100 m / d = 1.157 cm / s
346                  !! ng / cm
347                  fscal_sink   = ((fscal_csink * 6.) + fscal_sisink +        &
348                                  fscal_casink) / (100. * 1.e3 / 86400)
349                  !!
350                  !! now calculate the scavenging rate based upon the base
351                  !! rate and this particle flux scaling; according to the
352                  !! published units, the result actually has *no* units,
353                  !! but as it must be expressed per unit time for it to
354                  !! make any sense, I'm assuming a missing "per second"
355                  !! / s
356                  fscal_scav = fbase_scav * fscal_sink
357                  !!
358                  !! the resulting scavenging rate is then scaled further
359                  !! according to the local iron concentration (i.e.
360                  !! diminished in low iron regions; enhanced in high iron
361                  !! regions; less alone in intermediate iron regions)
362                  !!
363                  if (xFeT(ji,jj).lt.0.5) then
364                     !!
365                     !! low iron region (0.5 instead of the 0.4 in Moore
366                     !! et al., 2004)
367                     !!
368                     fscal_scav = fscal_scav * (xFeT(ji,jj) / 0.5)
369                     !!
370                  elseif (xFeT(ji,jj).gt.0.6) then
371                     !!
372                     !! high iron region (functional form different in
373                     !! Moore et al., 2004)
374                     !!
375                     fscal_scav = fscal_scav + ((xFeT(ji,jj) - 0.6) * 0.00904)
376                     !!
377                  else
378                     !!
379                     !! intermediate iron region: do nothing
380                     !!
381                  endif
382                  !!
383                  !! apply the calculated scavenging rate ...
384                  !!
385                  ffescav(ji,jj) = fscal_scav * zfer(ji,jj)
386               ENDIF
387            ENDDO
388         ENDDO
389      elseif (jiron.eq.4) then
390         !!------------------------------------------------------
391         !! Scheme 4: Galbraith et al. (2010)
392         !! This scheme includes two scavenging terms, one for
393         !! organic, particle-based scavenging, and another for
394         !! inorganic scavenging; both terms scavenge "free" iron
395         !! only
396         !!------------------------------------------------------
397         DO jj = 2,jpjm1
398            DO ji = 2,jpim1
399               IF (tmask(ji,jj,jk) == 1) THEN
400                  !!
401                  !! Galbraith et al. (2010) present a more straightforward
402                  !! outline of the scheme in Parekh et al. (2005) ...
403                  !!
404                  !! sinking particulate carbon available for scavenging
405                  !! this assumes a sinking rate of 100 m / d (Moore &
406                  !! Braucher, 2008),
407                  xCscav1    = (ffastc(ji,jj) * xmassc) / 100. ! = mg C / m3
408                  !!
409                  !! scale by Honeyman et al. (1981) exponent coefficient
410                  !! multiply by 1.e-3 to express C flux in g C rather than
411                  !! mg C
412                  xCscav2    = (xCscav1 * 1.e-3)**0.58
413                  !!
414                  !! multiply by Galbraith et al. (2010) scavenging rate
415                  xk_org     = 0.5 ! ((g C m/3)^-1) / d
416                  xORGscav   = xk_org * xCscav2 * xFeF(ji,jj)
417                  !!
418                  !! Galbraith et al. (2010) also include an inorganic bit ...
419                  !!
420                  !! this occurs at a fixed rate, again based on the
421                  !! availability of "free" iron
422                  !!
423                  !! k_inorg = 1000 d**-1 nmol Fe**-0.5 kg**-0.5
424                  !!
425                  !! to implement this here, scale xFeF by 1026 to put in
426                  !! units of umol/m3 which approximately equal nmol/kg
427                  !!
428                  xk_inorg   = 1000. ! ((nmol Fe / kg)^1.5)
429                  xINORGscav = (xk_inorg * (xFeF(ji,jj) * 1026.)**1.5) * 1.e-3
430                  !!
431                  !! sum these two terms together
432                  ffescav(ji,jj) = xORGscav + xINORGscav
433               ENDIF
434            ENDDO
435         ENDDO
436      else
437         !!------------------------------------------------------
438         !! No Scheme: you coward!
439         !! This scheme puts its head in the sand and eskews any
440         !! decision about how iron is removed from the ocean;
441         !! prepare to get deluged in iron you fool!
442         !!------------------------------------------------------
443         DO jj = 2,jpjm1
444            DO ji = 2,jpim1
445               IF (tmask(ji,jj,jk) == 1) THEN
446                  ffescav(ji,jj) = 0.
447               ENDIF
448            ENDDO
449         ENDDO
450      endif
451
452      !!---------------------------------------------------------
453      !! Other iron cycle processes
454      !!---------------------------------------------------------
455      !!
456      !! aeolian iron deposition
457      !! zirondep      is in mmol-Fe / m2 / day
458      !! ffetop(ji,jj) is in mmol-dissolved-Fe / m3 / day
459      if (jk == 1) then
460         DO jj = 2,jpjm1
461            DO ji = 2,jpim1
462               IF (tmask(ji,jj,jk) == 1) THEN
463                  ffetop(ji,jj)  = zirondep(ji,jj) * xfe_sol / fse3t(ji,jj,jk) 
464               ENDIF
465            ENDDO
466         ENDDO
467      else
468         DO jj = 2,jpjm1
469            DO ji = 2,jpim1
470               IF (tmask(ji,jj,jk) == 1) THEN
471                  ffetop(ji,jj)  = 0.0
472                ENDIF
473            ENDDO
474         ENDDO
475      endif
476      !!
477      !! seafloor iron addition
478      DO jj = 2,jpjm1
479         DO ji = 2,jpim1
480            IF (tmask(ji,jj,jk) == 1) THEN
481               !! AXY (10/07/12): amended to only apply sedimentary flux up
482               !! to ~500 m down
483               !! if (jk.eq.(mbathy(ji,jj)-1).AND.jk.lt.i1100) then
484               if ((jk.eq.mbathy(ji,jj)).AND.jk.le.i0500) then
485                  !! Moore et al. (2004) cite a coastal California value of
486                  !! 5 umol/m2/d, but adopt a global value of 2 umol/m2/d
487                  !! for all areas < 1100 m; here we use this latter value
488                  !! but apply it everywhere
489                  !! AXY (21/07/09): actually, let's just apply it below
490                  !! 1100 m (levels 1-37)
491                  ffebot(ji,jj)  = (xfe_sed / fse3t(ji,jj,jk))
492               else
493                  ffebot(ji,jj)  = 0.0
494               endif
495            ENDIF
496         ENDDO
497      ENDDO
498
499      !! AXY (16/12/09): remove iron addition/removal processes
500      !! For the purposes of the quarter degree run, the iron
501      !! cycle is being pegged to the initial condition supplied
502      !! by Mick Follows via restoration with a 30 day period;
503      !! iron addition at the seafloor is still permitted with
504      !! the idea that this extra iron will be removed by the
505      !! restoration away from the source
506      !! ffescav(ji,jj) = 0.0
507      !! ffetop(ji,jj)  = 0.0
508      !! ffebot(ji,jj)  = 0.0
509
510# if defined key_debug_medusa
511      !! report miscellaneous calculations
512      !! report miscellaneous calculations
513      if (idf.eq.1.AND.idfval.eq.1) then
514         DO jj = 2,jpjm1
515            DO ji = 2,jpim1
516               IF (tmask(ji,jj,jk) == 1) THEN
517                  IF (lwp) write (numout,*) '------------------------------'
518                  IF (lwp) write (numout,*) 'xfe_sol  = ', xfe_sol
519                  IF (lwp) write (numout,*) 'xfe_mass = ', xfe_mass
520                  IF (lwp) write (numout,*) 'ffetop(',jk,')  = ', ffetop(ji,jj)
521                  IF (lwp) write (numout,*) 'ffebot(',jk,')  = ', ffebot(ji,jj)
522                  IF (lwp) write (numout,*) 'xFree(',jk,')   = ', xFree(ji,jj)
523                  IF (lwp) write (numout,*) 'ffescav(',jk,') = ', ffescav(ji,jj)
524               ENDIF
525            ENDDO
526         ENDDO
527      endif
528# endif
529
530   END SUBROUTINE iron_chem_scav
531
532#else
533   !!======================================================================
534   !!  Dummy module :                                   No MEDUSA bio-model
535   !!======================================================================
536CONTAINS
537   SUBROUTINE iron_chem_scav( )                    ! Empty routine
538      WRITE(*,*) 'iron_chem_scav: You should not have seen this print! error?'
539   END SUBROUTINE iron_chem_scav
540#endif 
541
542   !!======================================================================
543END MODULE iron_chem_scav_mod
Note: See TracBrowser for help on using the repository browser.