source: branches/NERC/dev_r5518_GO6_under_ice_relax/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_medusa_update.F90 @ 10047

Last change on this file since 10047 was 10047, checked in by jpalmier, 3 years ago

merge with GO6_package_branch 9385-10020 ; plus debug OMIP_DIC

File size: 44.1 KB
Line 
1MODULE bio_medusa_update_mod
2   !!======================================================================
3   !!                         ***  MODULE bio_medusa_update_mod  ***
4   !! Update tracer fields
5   !!======================================================================
6   !! History :
7   !!   -   ! 2017-04 (M. Stringer)        Code taken from trcbio_medusa.F90
8   !!   -   ! 2017-08 (A. Yool)            Amend slow-detritus bug
9   !!   -   ! 2017-08 (A. Yool)            Reformatting for clarity
10   !!   -   ! 2018-08 (A. Yool)            add OMIP preindustrial DIC
11   !!----------------------------------------------------------------------
12#if defined key_medusa
13   !!----------------------------------------------------------------------
14   !!                                                   MEDUSA bio-model
15   !!----------------------------------------------------------------------
16
17   IMPLICIT NONE
18   PRIVATE
19     
20   PUBLIC   bio_medusa_update        ! Called in trcbio_medusa.F90
21
22   !!----------------------------------------------------------------------
23   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)
24   !! $Id$
25   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
26   !!----------------------------------------------------------------------
27
28CONTAINS
29
30   SUBROUTINE bio_medusa_update( kt, jk )
31      !!---------------------------------------------------------------------
32      !!                     ***  ROUTINE bio_medusa_update  ***
33      !! This called from TRC_BIO_MEDUSA and updates the tracer fields
34      !!---------------------------------------------------------------------
35      USE bio_medusa_mod,    ONLY: b0, bddtalk3, bddtdic3, bddtdife3,        &
36                                   bddtdin3, bddtdisi3,                      &
37                                   ibenthic, ibio_switch, idf, idfval,       &
38                                   f_benout_c, f_benout_ca, f_benout_n,      &
39                                   f_benout_si,                              &
40                                   f_co2flux, f_o2flux,                      &
41# if defined key_omip_dic
42                                   f_pi_co2flux,                             & ! AXY (06/08/18)
43# endif                                   
44                                   f_riv_loc_alk, f_riv_loc_c,               &
45                                   f_riv_loc_n, f_riv_loc_si,                & 
46                                   f_riv_alk, f_riv_c, f_riv_n, f_riv_si,    &
47                                   fbddtalk, fbddtdic, fbddtdife,            &
48                                   fbddtdin, fbddtdisi,                      & 
49                                   fdd, fdpd, fdpd2, fdpds, fdpds2,          &
50                                   fdpn, fdpn2,                              &
51                                   fdzme, fdzme2, fdzmi, fdzmi2,             &
52                                   ffast2slowc, ffast2slown,                 &
53                                   ffebot, ffetop, ffescav,                  &
54                                   fflx_fe, fflx_n, fflx_si,                 &
55                                   fgmed, fgmepd, fgmedc, fgmepd, fgmepds,   &
56                                   fgmepn, fgmezmi,                          &
57                                   fgmid, fgmidc, fgmipn,                    &
58                                   ficme, ficmi, finme, finmi,               &
59                                   fmeexcr, fmegrow, fmeresp,                &
60                                   fmiexcr, fmigrow, fmiresp,                &
61                                   fnit_cons, fnit_prod,                     &
62                                   fprd, fprds, fprn,                        &
63                                   frd,                                      &
64                                   freminc, freminca, freminn, freminsi,     &
65                                   frn,                                      &
66                                   fsil_cons, fsil_prod, fsdiss,             &
67                                   ftempca, fthetad, fthetan,                &
68                                   fslowsink, fslowgain, fslowloss,          & ! AXY (22/08/17)
69                                   f_sbenin_n, f_sbenin_c,                   &
70# if defined key_roam
71                                   fslowsinkc, fslowgainc, fslowlossc,       & ! AXY (22/08/17)
72                                   fcar_cons, fcar_prod, fcomm_resp,         &
73                                   fddc, fflx_a, fflx_c, fflx_o2, zoxy,      &
74                                   foxy_anox, foxy_cons, foxy_prod,          &
75# endif
76                                   zpds, zphd, zphn
77      USE dom_oce,           ONLY: e3t_0, gphit, mbathy, tmask
78# if defined key_vvl
79      USE dom_oce,           ONLY: e3t_n
80# endif
81      USE in_out_manager,    ONLY: lwp, numout
82      USE lib_mpp,           ONLY: ctl_stop
83      USE par_kind,          ONLY: wp
84      USE par_medusa,        ONLY: jp_medusa, jp_msa0, jp_msa1,              &
85                                   jpalk, jpchd, jpchn, jpdet, jpdic,        &
86                                   jpdin, jpdtc, jpfer, jpoxy, jppds,        &
87                                   jpphd, jpphn, jpsil, jpzme, jpzmi,        &
88                                   jpalk_lc, jpchd_lc, jpchn_lc, jpdet_lc,   & 
89                                   jpdic_lc, jpdin_lc, jpdtc_lc, jpfer_lc,   & 
90                                   jpoxy_lc, jppds_lc, jpphd_lc, jpphn_lc,   &
91# if defined key_omip_dic
92                                   jpomd, jpomd_lc,                          &
93# endif
94                                   jpsil_lc, jpzme_lc, jpzmi_lc             
95      USE par_oce,           ONLY: jpi, jpim1, jpj, jpjm1, jpk
96      USE par_trc,           ONLY: jptra
97      USE sms_medusa,        ONLY: friver_dep,                               &
98                                   jinorgben, jorgben,                       &
99                                   jriver_alk, jriver_c,                     &
100                                   jriver_n, jriver_si,                      &
101                                   xbetac, xbetan,                           &
102                                   xfdfrac1, xfdfrac2, xfdfrac3,             &
103                                   xo2min, xphi, xrfn,                       &
104                                   xthetanit, xthetapd, xthetapn,            &
105                                   xthetarem, xthetazme, xthetazmi,          &
106                                   xxi
107      USE trc,               ONLY: med_diag, tra
108
109   !!* Substitution
110#  include "domzgr_substitute.h90"
111
112      !! time (integer timestep)
113      INTEGER, INTENT( in ) :: kt
114      !! Level
115      INTEGER, INTENT( in ) :: jk
116
117      !! Loop variables
118      INTEGER :: ji, jj, jn
119
120      !! AXY (23/08/13): changed from individual variables for each flux to
121      !!                 an array that holds all fluxes
122      REAL(wp), DIMENSION(jpi,jpj,jp_medusa) :: btra
123
124      !! nitrogen and silicon production and consumption
125      REAL(wp) :: fn_prod, fn_cons, fs_prod, fs_cons
126
127      !! carbon, alkalinity production and consumption
128      REAL(wp) :: fc_prod, fc_cons, fa_prod, fa_cons
129
130      !! oxygen production and consumption (and non-consumption)
131      REAL(wp), DIMENSION(jpi,jpj) :: fo2_prod, fo2_cons
132      REAL(wp), DIMENSION(jpi,jpj) :: fo2_ncons, fo2_ccons
133
134      !! temporary variables
135      REAL(wp) :: fq0
136
137      !!==========================================================
138      !! LOCAL GRID CELL TRENDS
139      !!==========================================================
140      !!
141      !!----------------------------------------------------------
142      !! Determination of trends
143      !!----------------------------------------------------------
144      DO jj = 2,jpjm1
145         DO ji = 2,jpim1
146            !! OPEN wet point IF..THEN loop
147            if (tmask(ji,jj,jk) == 1) then
148               !!
149               !!----------------------------------------------------------
150               !! chlorophyll
151               btra(ji,jj,jpchn_lc) = b0 * ( ( (frn(ji,jj) * fprn(ji,jj) *      &
152                                             zphn(ji,jj) ) -                 &
153                                           fgmipn(ji,jj) - fgmepn(ji,jj) -   &
154                                           fdpn(ji,jj) - fdpn2(ji,jj) ) *    &
155                                          (fthetan(ji,jj) / xxi) )
156               btra(ji,jj,jpchd_lc) = b0 * ( ( (frd(ji,jj) * fprd(ji,jj) *      &
157                                             zphd(ji,jj) ) -                 &
158                                           fgmepd(ji,jj) - fdpd(ji,jj) -     &
159                                           fdpd2(ji,jj) ) *                  &
160                                          (fthetad(ji,jj) / xxi) )
161            ENDIF
162         ENDDO
163      ENDDO
164
165      DO jj = 2,jpjm1
166         DO ji = 2,jpim1
167            if (tmask(ji,jj,jk) == 1) then
168               !!
169               !!----------------------------------------------------------
170               !! phytoplankton
171               btra(ji,jj,jpphn_lc) = b0 * ( (fprn(ji,jj) * zphn(ji,jj)) -      &
172                                          fgmipn(ji,jj) - fgmepn(ji,jj) -    &
173                                          fdpn(ji,jj) - fdpn2(ji,jj) )
174               btra(ji,jj,jpphd_lc) = b0 * ( (fprd(ji,jj) * zphd(ji,jj)) -      &
175                                          fgmepd(ji,jj) - fdpd(ji,jj) -      &
176                                          fdpd2(ji,jj) )
177               btra(ji,jj,jppds_lc) = b0 * ( (fprds(ji,jj) * zpds(ji,jj)) -     &
178                                          fgmepds(ji,jj) - fdpds(ji,jj) -    &
179                                          fsdiss(ji,jj) - fdpds2(ji,jj) )
180            ENDIF
181         ENDDO
182      ENDDO
183
184      DO jj = 2,jpjm1
185         DO ji = 2,jpim1
186            if (tmask(ji,jj,jk) == 1) then
187               !!
188               !!----------------------------------------------------------
189               !! zooplankton
190               btra(ji,jj,jpzmi_lc) = b0 * (fmigrow(ji,jj) - fgmezmi(ji,jj) -   &
191                                         fdzmi(ji,jj) - fdzmi2(ji,jj))
192               btra(ji,jj,jpzme_lc) = b0 * (fmegrow(ji,jj) - fdzme(ji,jj) -     &
193                                         fdzme2(ji,jj))
194            ENDIF
195         ENDDO
196      ENDDO
197
198      !!----------------------------------------------------------
199      !! detritus
200      DO jj = 2,jpjm1
201         DO ji = 2,jpim1
202            if (tmask(ji,jj,jk) == 1) then
203               !!
204               btra(ji,jj,jpdet_lc) = b0 * (                           &
205                   fdpn(ji,jj)                                         & ! mort. losses
206                 + ((1.0 - xfdfrac1) * fdpd(ji,jj))                    & ! mort. losses
207                 + fdzmi(ji,jj)                                        & ! mort. losses
208                 + ((1.0 - xfdfrac2) * fdzme(ji,jj))                   & ! mort. losses
209                 + ((1.0 - xbetan) * (finmi(ji,jj) + finme(ji,jj)))    & ! assim. inefficiency
210                 - fgmid(ji,jj) - fgmed(ji,jj)                         & ! grazing
211                 - fdd(ji,jj)                                          & ! remin.
212                 + fslowgain(ji,jj) - fslowloss(ji,jj)                 & ! slow-sinking
213                 - (f_sbenin_n(ji,jj) / fse3t(ji,jj,jk))               & ! slow-sinking loss to seafloor
214                 + ffast2slown(ji,jj) )                                  ! seafloor fast->slow
215            ENDIF
216         ENDDO
217      ENDDO
218
219      DO jj = 2,jpjm1
220         DO ji = 2,jpim1
221            if (tmask(ji,jj,jk) == 1) then
222               !!----------------------------------------------------------
223               !! dissolved inorganic nitrogen nutrient
224               !! primary production
225               fn_cons = - (fprn(ji,jj) * zphn(ji,jj)) -                     &
226                           (fprd(ji,jj) * zphd(ji,jj))
227               !!
228               fn_prod =                                                     &
229                                         ! messy feeding remin.
230                         (xphi * (fgmipn(ji,jj) + fgmid(ji,jj))) +           &
231                         (xphi * (fgmepn(ji,jj) + fgmepd(ji,jj) +            &
232                                  fgmezmi(ji,jj) + fgmed(ji,jj))) +          &
233                                         ! excretion and remin.
234                         fmiexcr(ji,jj) + fmeexcr(ji,jj) + fdd(ji,jj) +      &
235                         freminn(ji,jj) +                                    &
236                                         ! metab. losses
237                         fdpn2(ji,jj) + fdpd2(ji,jj) + fdzmi2(ji,jj) +       &
238                         fdzme2(ji,jj)
239               !!
240               !! riverine flux
241               if ( jriver_n .gt. 0 ) then
242                  f_riv_loc_n(ji,jj) = f_riv_n(ji,jj) *                      &
243                     friver_dep(jk,mbathy(ji,jj)) / fse3t(ji,jj,jk)
244                  fn_prod = fn_prod + f_riv_loc_n(ji,jj)
245               endif
246               !! 
247               !! benthic remineralisation
248               if (jk.eq.mbathy(ji,jj) .and. jorgben.eq.1 .and.              &
249                   ibenthic.eq.1) then
250                  fn_prod = fn_prod + (f_benout_n(ji,jj) / fse3t(ji,jj,jk))
251               endif
252               !!
253               btra(ji,jj,jpdin_lc) = b0 * ( fn_prod + fn_cons )
254               !!
255               !! consumption of dissolved nitrogen
256               fnit_cons(ji,jj) = fnit_cons(ji,jj) + ( fse3t(ji,jj,jk) *     &
257                                                       fn_cons )
258               !! production of dissolved nitrogen
259               fnit_prod(ji,jj) = fnit_prod(ji,jj) + ( fse3t(ji,jj,jk) *     &
260                                                       fn_prod )
261            ENDIF
262         ENDDO
263      ENDDO
264
265      DO jj = 2,jpjm1
266         DO ji = 2,jpim1
267            if (tmask(ji,jj,jk) == 1) then
268               !!
269               !!----------------------------------------------------------
270               !! dissolved silicic acid nutrient
271               !! opal production
272               fs_cons = - (fprds(ji,jj) * zpds(ji,jj))
273               !!
274               fs_prod =                                                     &
275                             ! opal dissolution
276                         fsdiss(ji,jj) +                                     &
277                             ! mort. loss
278                         ((1.0 - xfdfrac1) * fdpds(ji,jj)) +                 &
279                             ! egestion of grazed Si
280                         ((1.0 - xfdfrac3) * fgmepds(ji,jj)) +               &
281                             ! fast diss. and metab. losses
282                         freminsi(ji,jj) + fdpds2(ji,jj)
283               !!
284               !! riverine flux
285               if ( jriver_si .gt. 0 ) then
286                  f_riv_loc_si(ji,jj) = f_riv_si(ji,jj) *                    &
287                                        friver_dep(jk,mbathy(ji,jj)) /       &
288                                        fse3t(ji,jj,jk)
289                  fs_prod = fs_prod + f_riv_loc_si(ji,jj)
290               endif
291               !! 
292               !! benthic remineralisation
293               if (jk.eq.mbathy(ji,jj) .and. jinorgben.eq.1 .and.            &
294                   ibenthic.eq.1) then
295                  fs_prod = fs_prod + (f_benout_si(ji,jj) / fse3t(ji,jj,jk))
296               endif
297               !!
298               btra(ji,jj,jpsil_lc) = b0 * ( &
299                 fs_prod + fs_cons )
300               !! consumption of dissolved silicon
301               fsil_cons(ji,jj) = fsil_cons(ji,jj) + ( fse3t(ji,jj,jk) *     &
302                                                       fs_cons )
303               !! production of dissolved silicon
304               fsil_prod(ji,jj) = fsil_prod(ji,jj) + ( fse3t(ji,jj,jk) *     &
305                                                       fs_prod )
306            ENDIF
307         ENDDO
308      ENDDO
309
310      DO jj = 2,jpjm1
311         DO ji = 2,jpim1
312            if (tmask(ji,jj,jk) == 1) then !!
313               !!----------------------------------------------------------
314               !! dissolved "iron" nutrient
315               btra(ji,jj,jpfer_lc) = b0 * ( (xrfn * btra(ji,jj,jpdin_lc)) +       &
316                                          ffetop(ji,jj) + ffebot(ji,jj) -    &
317                                          ffescav(ji,jj) )
318            ENDIF
319         ENDDO
320      ENDDO
321
322# if defined key_roam
323      !!----------------------------------------------------------
324      !! AXY (26/11/08): implicit detrital carbon change
325      DO jj = 2,jpjm1
326         DO ji = 2,jpim1
327            if (tmask(ji,jj,jk) == 1) then 
328               !!
329               btra(ji,jj,jpdtc_lc) = b0 * (                           &
330                   (xthetapn * fdpn(ji,jj))                            & ! mort. losses
331                 + ((1.0 - xfdfrac1) * (xthetapd * fdpd(ji,jj)))       & ! mort. losses
332                 + (xthetazmi * fdzmi(ji,jj))                          & ! mort. losses
333                 + ((1.0 - xfdfrac2) * (xthetazme * fdzme(ji,jj)))     & ! mort. losses
334                 + ((1.0 - xbetac) * (ficmi(ji,jj) + ficme(ji,jj)))    & ! assim. inefficiency
335                 - fgmidc(ji,jj) - fgmedc(ji,jj)                       & ! grazing
336                 - fddc(ji,jj)                                         & ! remin.
337                 + fslowgainc(ji,jj) - fslowlossc(ji,jj)               & ! slow-sinking
338                 - (f_sbenin_c(ji,jj) / fse3t(ji,jj,jk))               & ! slow-sinking loss to seafloor
339                 + ffast2slowc(ji,jj) )                                  ! seafloor fast->slow
340            ENDIF
341         ENDDO
342      ENDDO
343
344      DO jj = 2,jpjm1
345         DO ji = 2,jpim1
346            if (tmask(ji,jj,jk) == 1) then
347               !!
348               !!----------------------------------------------------------
349               !! dissolved inorganic carbon
350               !! primary production
351               fc_cons = - (xthetapn * fprn(ji,jj) * zphn(ji,jj)) -          &
352                           (xthetapd * fprd(ji,jj) * zphd(ji,jj))
353               !!
354               fc_prod =                                                     &
355                            ! messy feeding remin
356                         (xthetapn * xphi * fgmipn(ji,jj)) +                 &
357                         (xphi * fgmidc(ji,jj)) +                            &
358                         (xthetapn * xphi * fgmepn(ji,jj)) +                 &
359                         (xthetapd * xphi * fgmepd(ji,jj)) +                 &
360                         (xthetazmi * xphi * fgmezmi(ji,jj)) +               &
361                         (xphi * fgmedc(ji,jj)) +                            &
362                            ! resp., remin., losses
363                         fmiresp(ji,jj) + fmeresp(ji,jj) + fddc(ji,jj) +     &
364                         freminc(ji,jj) + (xthetapn * fdpn2(ji,jj)) +        &
365                            ! losses
366                         (xthetapd * fdpd2(ji,jj)) +                         &
367                         (xthetazmi * fdzmi2(ji,jj)) +                       &
368                         (xthetazme * fdzme2(ji,jj))
369               !!
370               !! riverine flux
371               if ( jriver_c .gt. 0 ) then
372                  f_riv_loc_c(ji,jj) = f_riv_c(ji,jj) *                      &
373                                       friver_dep(jk,mbathy(ji,jj)) /        &
374                                       fse3t(ji,jj,jk)
375                  fc_prod = fc_prod + f_riv_loc_c(ji,jj)
376               endif
377               !! 
378               !! benthic remineralisation
379               if (jk.eq.mbathy(ji,jj) .and. jorgben.eq.1 .and.              &
380                   ibenthic.eq.1) then
381                  fc_prod = fc_prod + (f_benout_c(ji,jj) / fse3t(ji,jj,jk))
382               endif
383               if (jk.eq.mbathy(ji,jj) .and. jinorgben.eq.1 .and.            &
384                   ibenthic.eq.1) then
385                  fc_prod = fc_prod + (f_benout_ca(ji,jj) / fse3t(ji,jj,jk))
386               endif
387               !!
388               !! community respiration (does not include CaCO3 terms -
389               !! obviously!)
390               fcomm_resp(ji,jj) = fcomm_resp(ji,jj) + fc_prod
391               !!
392               !! CaCO3
393               fc_prod = fc_prod - ftempca(ji,jj) + freminca(ji,jj)
394               !!
395               !! riverine flux
396               if ( jk .eq. 1 .and. jriver_c .gt. 0 ) then
397                  fc_prod = fc_prod + f_riv_c(ji,jj)
398               endif
399               !!
400               btra(ji,jj,jpdic_lc) = b0 * ( fc_prod + fc_cons )
401               !! consumption of dissolved carbon
402               fcar_cons(ji,jj) = fcar_cons(ji,jj) + ( fse3t(ji,jj,jk) *     &
403                                                       fc_cons )
404               !! production of dissolved carbon
405               fcar_prod(ji,jj) = fcar_prod(ji,jj) + ( fse3t(ji,jj,jk) *     &
406                                                       fc_prod )
407#  if defined key_omip_dic
408               !! AXY (06/08/18): OMIP PI DIC has the same BGC fluxes as
409               !!                 normal DIC, with the exception of its
410               !!                 air-sea exchange; see below
411               btra(ji,jj,jpomd_lc) = btra(ji,jj,jpdic_lc)
412#  endif               
413            ENDIF
414         ENDDO
415      ENDDO
416
417      DO jj = 2,jpjm1
418         DO ji = 2,jpim1
419            if (tmask(ji,jj,jk) == 1) then
420               !!
421               !!----------------------------------------------------------
422               !! alkalinity
423               !! CaCO3 dissolution
424               fa_prod = 2.0 * freminca(ji,jj)
425               !! CaCO3 production
426               fa_cons = - 2.0 * ftempca(ji,jj)
427               !!
428               !! riverine flux
429               if ( jriver_alk .gt. 0 ) then
430                  f_riv_loc_alk(ji,jj) = f_riv_alk(ji,jj) *                  &
431                                         friver_dep(jk,mbathy(ji,jj)) /      &
432                                         fse3t(ji,jj,jk)
433                  fa_prod = fa_prod + f_riv_loc_alk(ji,jj)
434               endif
435               !! 
436               !! benthic remineralisation
437               if (jk.eq.mbathy(ji,jj) .and. jinorgben.eq.1 .and.            &
438                   ibenthic.eq.1) then
439                  fa_prod = fa_prod + (2.0 * f_benout_ca(ji,jj) /            &
440                                       fse3t(ji,jj,jk))
441               endif
442               !!
443               btra(ji,jj,jpalk_lc) = b0 * ( fa_prod + fa_cons )
444            ENDIF
445         ENDDO
446      ENDDO
447
448      DO jj = 2,jpjm1
449         DO ji = 2,jpim1
450            if (tmask(ji,jj,jk) == 1) then
451               !!
452               !!----------------------------------------------------------
453               !! oxygen (has protection at low O2 concentrations;
454               !! OCMIP-2 style)
455               fo2_prod(ji,jj) =                                             &
456                                     ! Pn primary production, N
457                                 (xthetanit * fprn(ji,jj) * zphn(ji,jj)) +   &
458                                     ! Pd primary production, N
459                                 (xthetanit * fprd(ji,jj) * zphd(ji,jj)) +   &
460                                     ! Pn primary production, C
461                                 (xthetarem * xthetapn * fprn(ji,jj) *       &
462                                  zphn(ji,jj)) +                             &
463                                     ! Pd primary production, C
464                                  (xthetarem * xthetapd * fprd(ji,jj) *      &
465                                   zphd(ji,jj))
466               fo2_ncons(ji,jj) =                                            &
467                                     ! Pn messy feeding remin., N
468                                   - (xthetanit * xphi * fgmipn(ji,jj))      &
469                                     ! D  messy feeding remin., N
470                                   - (xthetanit * xphi * fgmid(ji,jj))       &
471                                     ! Pn messy feeding remin., N
472                                   - (xthetanit * xphi * fgmepn(ji,jj))      &
473                                     ! Pd messy feeding remin., N
474                                   - (xthetanit * xphi * fgmepd(ji,jj))      &
475                                     ! Zi messy feeding remin., N
476                                   - (xthetanit * xphi * fgmezmi(ji,jj))     &
477                                     ! D  messy feeding remin., N
478                                   - (xthetanit * xphi * fgmed(ji,jj))       &
479                                     ! microzoo excretion, N
480                                   - (xthetanit * fmiexcr(ji,jj))            &
481                                     ! mesozoo  excretion, N
482                                   - (xthetanit * fmeexcr(ji,jj))            &
483                                     ! slow detritus remin., N
484                                   - (xthetanit * fdd(ji,jj))                &
485                                     ! fast detritus remin., N
486                                   - (xthetanit * freminn(ji,jj))            &
487                                     ! Pn  losses, N
488                                   - (xthetanit * fdpn2(ji,jj))              &
489                                     ! Pd  losses, N
490                                   - (xthetanit * fdpd2(ji,jj))              &
491                                     ! Zmi losses, N
492                                   - (xthetanit * fdzmi2(ji,jj))             &
493                                     ! Zme losses, N
494                                   - (xthetanit * fdzme2(ji,jj))
495               !! 
496               !! benthic remineralisation
497               if (jk.eq.mbathy(ji,jj) .and. jorgben.eq.1 .and.              &
498                   ibenthic.eq.1) then
499                  fo2_ncons(ji,jj) = fo2_ncons(ji,jj) -                      &
500                                     (xthetanit * f_benout_n(ji,jj) /        &
501                                      fse3t(ji,jj,jk))
502               endif
503            ENDIF
504         ENDDO
505      ENDDO
506
507      DO jj = 2,jpjm1
508         DO ji = 2,jpim1
509            if (tmask(ji,jj,jk) == 1) then
510               fo2_ccons(ji,jj) =                                            &
511                                     ! Pn messy feeding remin., C
512                                  - (xthetarem * xthetapn * xphi *           &
513                                     fgmipn(ji,jj))                          &
514                                     ! D  messy feeding remin., C
515                                  - (xthetarem * xphi * fgmidc(ji,jj))       &
516                                     ! Pn messy feeding remin., C
517                                  - (xthetarem * xthetapn * xphi *           &
518                                     fgmepn(ji,jj))                          &
519                                     ! Pd messy feeding remin., C
520                                  - (xthetarem * xthetapd * xphi *           &
521                                     fgmepd(ji,jj))                          &
522                                     ! Zi messy feeding remin., C
523                                  - (xthetarem * xthetazmi * xphi *          &
524                                     fgmezmi(ji,jj))                         &
525                                     ! D  messy feeding remin., C
526                                  - (xthetarem * xphi * fgmedc(ji,jj))       &
527                                     ! microzoo respiration, C
528                                  - (xthetarem * fmiresp(ji,jj))             &
529                                     ! mesozoo  respiration, C
530                                  - (xthetarem * fmeresp(ji,jj))             &
531                                     ! slow detritus remin., C
532                                  - (xthetarem * fddc(ji,jj))                &
533                                     ! fast detritus remin., C
534                                  - (xthetarem * freminc(ji,jj))             &
535                                     ! Pn  losses, C
536                                  - (xthetarem * xthetapn * fdpn2(ji,jj))    &
537                                     ! Pd  losses, C
538                                  - (xthetarem * xthetapd * fdpd2(ji,jj))    &
539                                     ! Zmi losses, C
540                                  - (xthetarem * xthetazmi * fdzmi2(ji,jj))  &
541                                     ! Zme losses, C
542                                  - (xthetarem * xthetazme * fdzme2(ji,jj))
543               !! 
544               !! benthic remineralisation
545               if (jk.eq.mbathy(ji,jj) .and. jorgben.eq.1 .and.              &
546                   ibenthic.eq.1) then
547                  fo2_ccons(ji,jj) = fo2_ccons(ji,jj) - (xthetarem *         &
548                                                         f_benout_c(ji,jj) / &
549                                                         fse3t(ji,jj,jk))
550               endif
551               fo2_cons(ji,jj) = fo2_ncons(ji,jj) + fo2_ccons(ji,jj)
552            ENDIF
553         ENDDO
554      ENDDO
555
556      DO jj = 2,jpjm1
557         DO ji = 2,jpim1
558            if (tmask(ji,jj,jk) == 1) then
559               !!
560               !! is this a suboxic zone?
561               !! deficient O2; production fluxes only
562               if (zoxy(ji,jj).lt.xo2min) then
563                  btra(ji,jj,jpoxy_lc) = b0 * fo2_prod(ji,jj)
564                  foxy_prod(ji,jj) = foxy_prod(ji,jj) + ( fse3t(ji,jj,jk) *  &
565                                                          fo2_prod(ji,jj) )
566                  foxy_anox(ji,jj) = foxy_anox(ji,jj) + ( fse3t(ji,jj,jk) *  &
567                                                          fo2_cons(ji,jj) )
568               else
569                  !! sufficient O2; production + consumption fluxes
570                  btra(ji,jj,jpoxy_lc) = b0 * ( fo2_prod(ji,jj) +               &
571                                             fo2_cons(ji,jj) )
572                  foxy_prod(ji,jj) = foxy_prod(ji,jj) +                      &
573                                     ( fse3t(ji,jj,jk) * fo2_prod(ji,jj) )
574                  foxy_cons(ji,jj) = foxy_cons(ji,jj) +                      &
575                                     ( fse3t(ji,jj,jk) * fo2_cons(ji,jj) )
576               endif
577            ENDIF
578         ENDDO
579      ENDDO
580
581      DO jj = 2,jpjm1
582         DO ji = 2,jpim1
583            if (tmask(ji,jj,jk) == 1) then
584               !!
585               !! air-sea fluxes (if this is the surface box)
586               if (jk.eq.1) then
587                  !!
588                  !! CO2 flux
589                  btra(ji,jj,jpdic_lc) = btra(ji,jj,jpdic_lc) + (b0 *              &
590                                                           f_co2flux(ji,jj))
591#  if defined key_omip_dic
592                  !! AXY (06/08/18): air-sea CO2 flux is the only difference
593                  !!                 between DIC and OMIP PI DIC tracers
594                  btra(ji,jj,jpomd_lc) = btra(ji,jj,jpomd_lc) + (b0 *              &
595                                                           f_pi_co2flux(ji,jj))                 
596#  endif                   
597                  !!
598                  !! O2 flux (mol/m3/s -> mmol/m3/d)
599                  btra(ji,jj,jpoxy_lc) = btra(ji,jj,jpoxy_lc) + (b0 *              &
600                                                           f_o2flux(ji,jj))
601               endif
602            ENDIF
603         ENDDO
604      ENDDO
605# endif
606
607# if defined key_debug_medusa
608! I DON'T THIS IS MUCH USE, NOW IT'S BEEN PULLED OUT OF THE MAIN DO LOOP
609! - marc 5/5/17
610      DO jj = 2,jpjm1
611         DO ji = 2,jpim1
612            if (tmask(ji,jj,jk) == 1) then
613               !! report state variable fluxes (not including
614               !! fast-sinking detritus)
615               if (idf.eq.1.AND.idfval.eq.1) then
616                  IF (lwp) write (numout,*) '------------------------------'
617                  IF (lwp) write (numout,*) 'btra(ji,jj,jpchn_lc)(',jk,')  = ', &
618                                            btra(ji,jj,jpchn_lc)
619                  IF (lwp) write (numout,*) 'btra(ji,jj,jpchd_lc)(',jk,')  = ', &
620                                            btra(ji,jj,jpchd_lc)
621                  IF (lwp) write (numout,*) 'btra(ji,jj,jpphn_lc)(',jk,')  = ', &
622                                            btra(ji,jj,jpphn_lc)
623                  IF (lwp) write (numout,*) 'btra(ji,jj,jpphd_lc)(',jk,')  = ', &
624                                            btra(ji,jj,jpphd_lc)
625                  IF (lwp) write (numout,*) 'btra(ji,jj,jppds_lc)(',jk,')  = ', &
626                                            btra(ji,jj,jppds_lc)
627                  IF (lwp) write (numout,*) 'btra(ji,jj,jpzmi_lc)(',jk,')  = ', &
628                                            btra(ji,jj,jpzmi_lc)
629                  IF (lwp) write (numout,*) 'btra(ji,jj,jpzme_lc)(',jk,')  = ', &
630                                            btra(ji,jj,jpzme_lc)
631                  IF (lwp) write (numout,*) 'btra(ji,jj,jpdet_lc)(',jk,')  = ', &
632                                            btra(ji,jj,jpdet_lc)
633                  IF (lwp) write (numout,*) 'btra(ji,jj,jpdin_lc)(',jk,')  = ', &
634                                            btra(ji,jj,jpdin_lc)
635                  IF (lwp) write (numout,*) 'btra(ji,jj,jpsil_lc)(',jk,')  = ', &
636                                            btra(ji,jj,jpsil_lc)
637                  IF (lwp) write (numout,*) 'btra(ji,jj,jpfer_lc)(',jk,')  = ', &
638                                            btra(ji,jj,jpfer_lc)
639#  if defined key_roam
640                  IF (lwp) write (numout,*) 'btra(ji,jj,jpdtc_lc)(',jk,')  = ', &
641                                            btra(ji,jj,jpdtc_lc)
642                  IF (lwp) write (numout,*) 'btra(ji,jj,jpdic_lc)(',jk,')  = ', &
643                                            btra(ji,jj,jpdic_lc)
644                  IF (lwp) write (numout,*) 'btra(ji,jj,jpalk_lc)(',jk,')  = ', &
645                                            btra(ji,jj,jpalk_lc)
646                  IF (lwp) write (numout,*) 'btra(ji,jj,jpoxy_lc)(',jk,')  = ', &
647                                            btra(ji,jj,jpoxy_lc)
648#   if defined key_omip_dic
649                  IF (lwp) write (numout,*) 'btra(ji,jj,jpomd_lc)(',jk,')  = ', &
650                                            btra(ji,jj,jpomd_lc)
651#   endif
652#  endif
653               endif
654            ENDIF
655         ENDDO
656      ENDDO
657# endif
658
659      !!----------------------------------------------------------
660      !! Integrate calculated fluxes for mass balance
661      !!----------------------------------------------------------
662      DO jj = 2,jpjm1
663         DO ji = 2,jpim1
664            if (tmask(ji,jj,jk) == 1) then
665               !!
666               !! === nitrogen ===
667               fflx_n(ji,jj)  = fflx_n(ji,jj) + fse3t(ji,jj,jk) *            &
668                                ( btra(ji,jj,jpphn_lc) + btra(ji,jj,jpphd_lc) +    &
669                                  btra(ji,jj,jpzmi_lc) + btra(ji,jj,jpzme_lc) +    &
670                                  btra(ji,jj,jpdet_lc) + btra(ji,jj,jpdin_lc) )
671               !! === silicon ===
672               fflx_si(ji,jj) = fflx_si(ji,jj) + fse3t(ji,jj,jk) *           &
673                                ( btra(ji,jj,jppds_lc) + btra(ji,jj,jpsil_lc) )
674               !! === iron ===
675               fflx_fe(ji,jj) = fflx_fe(ji,jj) + fse3t(ji,jj,jk) *           &
676                                ( (xrfn *                                    &
677                                   (btra(ji,jj,jpphn_lc) + btra(ji,jj,jpphd_lc) +  &
678                                    btra(ji,jj,jpzmi_lc) + btra(ji,jj,jpzme_lc) +  &
679                                    btra(ji,jj,jpdet_lc))) + btra(ji,jj,jpfer_lc) )
680# if defined key_roam
681               !! === carbon ===
682               fflx_c(ji,jj)  = fflx_c(ji,jj) + fse3t(ji,jj,jk) *            &
683                                ( (xthetapn * btra(ji,jj,jpphn_lc)) +           &
684                                  (xthetapd * btra(ji,jj,jpphd_lc)) +           &
685                                  (xthetazmi * btra(ji,jj,jpzmi_lc)) +          &
686                                  (xthetazme * btra(ji,jj,jpzme_lc)) +          &
687                                  btra(ji,jj,jpdtc_lc) + btra(ji,jj,jpdic_lc) )
688               !! === alkalinity ===
689               fflx_a(ji,jj)  = fflx_a(ji,jj) + fse3t(ji,jj,jk) *            &
690                                btra(ji,jj,jpalk_lc)
691               !! === oxygen ===
692               fflx_o2(ji,jj) = fflx_o2(ji,jj) + fse3t(ji,jj,jk) *           &
693                                btra(ji,jj,jpoxy_lc)
694# endif
695            ENDIF
696         ENDDO
697      ENDDO
698
699      !!----------------------------------------------------------
700      !! Apply calculated tracer fluxes
701      !!----------------------------------------------------------
702      !!
703      !! units: [unit of tracer] per second (fluxes are calculated
704      !! above per day)
705      !!
706      DO jj = 2,jpjm1
707         DO ji = 2,jpim1
708            if (tmask(ji,jj,jk) == 1) then
709               ibio_switch = 1
710# if defined key_gulf_finland
711               !! AXY (17/05/13): fudge in a Gulf of Finland correction;
712               !!                 uses longitude-latitude range to
713               !!                 establish if this is a Gulf of Finland
714               !!                 grid cell; if so, then BGC fluxes are
715               !!                 ignored (though still calculated); for
716               !!                 reference, this is meant to be a
717               !!                 temporary fix to see if all of my
718               !!                 problems can be done away with if I
719               !!                 switch off BGC fluxes in the Gulf of
720               !!                 Finland, which currently appears the
721               !!                 source of trouble
722               if ( glamt(ji,jj).gt.24.7 .and. glamt(ji,jj).lt.27.8 .and.    &
723                    gphit(ji,jj).gt.59.2 .and. gphit(ji,jj).lt.60.2 ) then
724                  ibio_switch = 0
725               endif
726# endif               
727               if (ibio_switch.eq.1) then
728                  tra(ji,jj,jk,jpchn) = tra(ji,jj,jk,jpchn) +                &
729                                        (btra(ji,jj,jpchn_lc) / 86400.)
730                  tra(ji,jj,jk,jpchd) = tra(ji,jj,jk,jpchd) +                &
731                                        (btra(ji,jj,jpchd_lc) / 86400.)
732                  tra(ji,jj,jk,jpphn) = tra(ji,jj,jk,jpphn) +                &
733                                        (btra(ji,jj,jpphn_lc) / 86400.)
734                  tra(ji,jj,jk,jpphd) = tra(ji,jj,jk,jpphd) +                &
735                                        (btra(ji,jj,jpphd_lc) / 86400.)
736                  tra(ji,jj,jk,jppds) = tra(ji,jj,jk,jppds) +                &
737                                        (btra(ji,jj,jppds_lc) / 86400.)
738                  tra(ji,jj,jk,jpzmi) = tra(ji,jj,jk,jpzmi) +                &
739                                        (btra(ji,jj,jpzmi_lc) / 86400.)
740                  tra(ji,jj,jk,jpzme) = tra(ji,jj,jk,jpzme) +                &
741                                        (btra(ji,jj,jpzme_lc) / 86400.)
742                  tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) +                &
743                                        (btra(ji,jj,jpdet_lc) / 86400.)
744                  tra(ji,jj,jk,jpdin) = tra(ji,jj,jk,jpdin) +                &
745                                        (btra(ji,jj,jpdin_lc) / 86400.)
746                  tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) +                &
747                                        (btra(ji,jj,jpsil_lc) / 86400.)
748                  tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) +                &
749                                        (btra(ji,jj,jpfer_lc) / 86400.)
750# if defined key_roam
751                  tra(ji,jj,jk,jpdtc) = tra(ji,jj,jk,jpdtc) +                &
752                                        (btra(ji,jj,jpdtc_lc) / 86400.)
753                  tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) +                &
754                                        (btra(ji,jj,jpdic_lc) / 86400.)
755                  tra(ji,jj,jk,jpalk) = tra(ji,jj,jk,jpalk) +                &
756                                        (btra(ji,jj,jpalk_lc) / 86400.)
757                  tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) +                &
758                                        (btra(ji,jj,jpoxy_lc) / 86400.)
759#  if defined key_omip_dic
760                  tra(ji,jj,jk,jpomd) = tra(ji,jj,jk,jpomd) +                &
761                                        (btra(ji,jj,jpomd_lc) / 86400.)
762#  endif
763# endif
764               endif
765            ENDIF
766         ENDDO
767      ENDDO
768
769      DO jj = 2,jpjm1
770         DO ji = 2,jpim1
771            if (tmask(ji,jj,jk) == 1) then
772
773               !! AXY (18/11/16): CMIP6 diagnostics
774               IF( med_diag%FBDDTALK%dgsave )  THEN
775                  fbddtalk(ji,jj)  =  fbddtalk(ji,jj)  +                     &
776                                      (btra(ji,jj,jpalk_lc) * fse3t(ji,jj,jk))
777               ENDIF
778               IF( med_diag%FBDDTDIC%dgsave )  THEN
779                  fbddtdic(ji,jj)  =  fbddtdic(ji,jj)  +                     &
780                                      (btra(ji,jj,jpdic_lc) * fse3t(ji,jj,jk))
781               ENDIF
782               IF( med_diag%FBDDTDIFE%dgsave ) THEN
783                  fbddtdife(ji,jj) =  fbddtdife(ji,jj) +                     &
784                                      (btra(ji,jj,jpfer_lc) * fse3t(ji,jj,jk))
785               ENDIF
786               IF( med_diag%FBDDTDIN%dgsave )  THEN
787                  fbddtdin(ji,jj)  =  fbddtdin(ji,jj)  +                     &
788                                      (btra(ji,jj,jpdin_lc) * fse3t(ji,jj,jk))
789               ENDIF
790               IF( med_diag%FBDDTDISI%dgsave ) THEN
791                  fbddtdisi(ji,jj) =  fbddtdisi(ji,jj) +                     &
792                                      (btra(ji,jj,jpsil_lc) * fse3t(ji,jj,jk))
793               ENDIF
794          !!
795               IF( med_diag%BDDTALK3%dgsave )  THEN
796                  bddtalk3(ji,jj,jk)  =  btra(ji,jj,jpalk_lc)
797               ENDIF
798               IF( med_diag%BDDTDIC3%dgsave )  THEN
799                  bddtdic3(ji,jj,jk)  =  btra(ji,jj,jpdic_lc)
800               ENDIF
801               IF( med_diag%BDDTDIFE3%dgsave ) THEN
802                  bddtdife3(ji,jj,jk) =  btra(ji,jj,jpfer_lc)
803               ENDIF
804               IF( med_diag%BDDTDIN3%dgsave )  THEN
805                  bddtdin3(ji,jj,jk)  =  btra(ji,jj,jpdin_lc)
806               ENDIF
807               IF( med_diag%BDDTDISI3%dgsave ) THEN
808                  bddtdisi3(ji,jj,jk) =  btra(ji,jj,jpsil_lc)
809               ENDIF
810            ENDIF
811         ENDDO
812      ENDDO
813
814#   if defined key_debug_medusa
815      IF (lwp) write (numout,*) '------'
816      IF (lwp) write (numout,*) 'bio_medusa_update: end all calculations'
817      IF (lwp) write (numout,*) 'bio_medusa_update: now outputs kt = ', kt
818      CALL flush(numout)
819#   endif
820
821# if defined key_axy_nancheck
822      !!----------------------------------------------------------
823      !! Check calculated tracer fluxes
824      !!----------------------------------------------------------
825      DO jj = 2,jpjm1
826         DO ji = 2,jpim1
827            if (tmask(ji,jj,jk) == 1) then
828               !!
829               DO jn = 1,jp_medusa
830                  fq0 = btra(ji,jj,jn)
831                  !! AXY (30/01/14): "isnan" problem on HECTOR
832                  !! if (fq0 /= fq0 ) then
833                  if ( ieee_is_nan( fq0 ) ) then
834                     !! there's a NaN here
835                     if (lwp) write(numout,*) 'NAN detected in btra(ji,jj,',  &
836                        ji, ',', jj, ',', jk, ',', jn, ') at time', kt
837           CALL ctl_stop( 'trcbio_medusa, NAN in btra field' )
838                  endif
839               ENDDO
840               DO jn = jp_msa0,jp_msa1
841                  fq0 = tra(ji,jj,jk,jn)
842                  !! AXY (30/01/14): "isnan" problem on HECTOR
843                  !! if (fq0 /= fq0 ) then
844                  if ( ieee_is_nan( fq0 ) ) then
845                     !! there's a NaN here
846                     if (lwp) write(numout,*) 'NAN detected in tra(', ji, &
847                        ',', jj, ',', jk, ',', jn, ') at time', kt
848              CALL ctl_stop( 'trcbio_medusa, NAN in tra field' )
849                  endif
850               ENDDO
851               CALL flush(numout)
852            ENDIF
853         ENDDO
854      ENDDO
855# endif
856
857
858   END SUBROUTINE bio_medusa_update
859
860#else
861   !!======================================================================
862   !!  Dummy module :                                   No MEDUSA bio-model
863   !!======================================================================
864CONTAINS
865   SUBROUTINE bio_medusa_update( )                    ! Empty routine
866      WRITE(*,*) 'bio_medusa_update: You should not have seen this print! error?'
867   END SUBROUTINE bio_medusa_update
868#endif 
869
870   !!======================================================================
871END MODULE bio_medusa_update_mod
Note: See TracBrowser for help on using the repository browser.