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.
bio_medusa_diag.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/bio_medusa_diag.F90 @ 8012

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

Pulled further code from trcbio_medusa.F90 into other files
File size: 90.2 KB
Line 
1MODULE bio_medusa_diag_mod
2   !!======================================================================
3   !!                         ***  MODULE bio_medusa_diag_mod  ***
4   !! Calculates diagnostics
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   bio_medusa_diag        ! 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 bio_medusa_diag( kt, jk )
28      !!-------------------------------------------------------------------
29      !!                     ***  ROUTINE bio_medusa_diag  ***
30      !! This called from TRC_BIO_MEDUSA and calculates diagnostics
31      !!-------------------------------------------------------------------
32      USE bio_medusa_mod,    ONLY: dcalc3, dms_andr, dms_aran,           &
33                                   dms_hall, dms_simo, dms_surf,         &
34                                   f_benout_c, f_benout_ca, f_benout_fe, &
35                                   f_benout_lyso_ca, f_benout_n,         &
36                                   f_benout_si,                          &
37                                   f_co2flux, f_co3,                     &
38                                   f_fbenin_c, f_fbenin_ca, f_fbenin_fe, &
39                                   f_fbenin_n, f_fbenin_si,              &
40                                   f_h2co3, f_hco3,                      &
41                                   f_kw660,                              &
42                                   f_o2flux, f_o2sat, f_omarg, f_omcal,  &
43                                   f_pco2atm, f_pco2w, f_ph, f_pp0,      &
44                                   f_riv_loc_alk, f_riv_loc_c,           &
45                                   f_riv_loc_n, f_riv_loc_si,            &
46                                   f_runoff,                             &
47                                   f_sbenin_c, f_sbenin_fe,              &
48                                   f_sbenin_n,                           &
49                                   f_TALK, f_TDIC,                       &
50                                   fccd, fcomm_resp,                     &
51                                   fd_cal3, fd_car3, fd_nit3, fd_sil3,   &
52                                   fdep1,                                &
53                                   fdd, fdd2d, fddc,                     &
54                                   fdpd, fdpd2, fdpd22d, fdpd2d,         &
55                                   fdpn, fdpn2, fdpn22d, fdpn2d,         &
56                                   fdzme, fdzme2, fdzme22d, fdzme2d,     &
57                                   fdzmi, fdzmi2, fdzmi22d, fdzmi2d,     &
58                                   fediss3, fescav3,                     &
59                                   ffastc, ffastca, ffastca2d,           &
60                                   ffastn, ffastsi,                      &
61                                   ffebot, ffebot2d, ffescav, ffescav2d, &
62                                   ffetop, ffetop2d,                     &
63                                   ffld, ffld2d, ffln2, ffln2d,          &
64                                   fgmed, fgmed2d, fgmedc,               &
65                                   fgmepd, fgmepd2d, fgmepn, fgmepn2d,   &
66                                   fgmezmi, fgmezmi2d,                   &
67                                   fgmid, fgmid2d, fgmidc,               &
68                                   fgmipn, fgmipn2d,                     &
69                                   ficme, ficmi, finme, finmi,           &
70                                   fjlim_pd, fjlim_pn, fjld2d, fjln2d,   &
71                                   fmeexcr, fmegrow, fmeresp,            &
72                                   fmiexcr, fmigrow, fmiresp,            &
73                                   fnld, fnld2d, fnln, fnln2d,           &
74                                   fprd, fprd_ml, fprd2d,                &
75                                   fprds, fprds2d,                       & 
76                                   fprn, fprn_ml, fprn2d,                &
77                                   fregen, fregen2d,                     &
78                                   fregenfast, fregenfastsi,             &
79                                   fregensi, fregensi2d,                 &
80                                   freminc, freminc2d,                   &
81                                   freminca, freminca2d,                 & 
82                                   freminfe, freminfe2d,                 &
83                                   freminn, freminn2d,                   &
84                                   freminsi, freminsi2d,                 &
85                                   fsdiss, fsdiss2d,                     &
86                                   fsedc, fsedca, fsedfe, fsedn, fsedsi, &
87                                   fsld, fsld2, fsld2d, fsld2d2,         &
88                                   fslown, fslowc, fslown2d,             &
89                                   fslowc2d, fslowcflux, fslownflux,     &
90                                   ftempc, ftempc2d, ftempca, ftempca2d, &
91                                   ftempfe, ftempfe2d,                   &
92                                   ftempn, ftempn2d, ftempsi, ftempsi2d, &
93                                   ftot_a, ftot_c, ftot_fe, ftot_n,      &
94                                   ftot_o2, ftot_si,                     &
95                                   gmedc2d, gmidc2d,                     &
96                                   iben_c2d, iben_ca2d, iben_fe2d,       &
97                                   iben_n2d, iben_si2d,                  &
98                                   intdissic, intdissin,                 &
99                                   intdissisi, inttalk,                  &
100                                   iters, lyso_ca2d,                     &
101                                   mdetc2d, megrazd3, megrazp3,          &
102                                   megrazz3,                             & 
103                                   migrazd3, migrazp3,                   &
104                                   o2min, o2sat3,                        &
105                                   oben_c2d, oben_ca2d, oben_fe2d,       &
106                                   oben_n2d, oben_si2d,                  &
107                                   pbsi3, pcal3,                         &
108                                   pdlimfe3, pdlimj3, pdlimn3,           &
109                                   pnlimfe3, pnlimj3, pnlimn3, pdlimsi3, &
110                                   remin3dn, remoc3,                     &
111                                   rivalk2d, rivc2d, rivn2d, rivsi2d,    &
112                                   sfr_oarg2d, sfr_ocal2d,               &
113                                   tpp3d, tppd3, xFree,                  &
114                                   zeexcr2d, zegrow2d, zemesc2d,         &
115                                   zemesd2d, zemesdc2d, zemesn2d,        &
116                                   zeresp2d,                             &
117                                   ziexcr2d, zigrow2d, zimesc2d,         &
118                                   zimesd2d, zimesdc2d, zimesn2d,        &
119                                   ziresp2d,                             &
120                                   zo2min,                               &
121                                   zalk, zdet, zdic, zdin, zdtc,         &
122                                   zfer, zoxy, zpds, zphd, zphn,         &
123                                   zsal, zsil, ztmp, zzme, zzmi
124      USE dom_oce,           ONLY: e3t_0, e3t_n, gdepw_0, gdepw_n,       &
125                                   mbathy, tmask
126      USE in_out_manager,    ONLY: lwp, numout
127      USE iom,               ONLY: lk_iomput
128      USE par_kind,          ONLY: wp
129      USE par_oce,           ONLY: jpim1, jpjm1
130      USE phycst,            ONLY: rsmall
131      USE sbc_oce,           ONLY: qsr, wndm
132      USE sms_medusa,        ONLY: f2_ccd_arg, f2_ccd_cal,               &
133                                   f3_omarg, f3_omcal, f3_pH,            &
134                                   i0100, i0150, i0200, i0500, i1000,    &
135                                   jdms, ocal_ccd,                       &
136                                   xbetac, xbetan, xpar, xphi, xrfn,     &
137                                   xthetapd, xthetapn, xthetazme, xthetazmi, xze
138      USE trc,               ONLY: ln_diatrc, med_diag, trc2d, trc3d 
139      USE trcoxy_medusa,     ONLY: oxy_sato
140
141   !!* Substitution
142#  include "domzgr_substitute.h90"
143
144      !! time (integer timestep)
145      INTEGER, INTENT( in ) :: kt
146      !! level
147      INTEGER, INTENT( in ) :: jk
148
149      !! Loop avariables
150      INTEGER :: ji, jj, jn
151
152# if defined key_trc_diabio
153      !!==========================================================
154      !! LOCAL GRID CELL DIAGNOSTICS
155      !!==========================================================
156      !!
157      !!----------------------------------------------------------
158      !! Full diagnostics key_trc_diabio:
159      !! LOBSTER and PISCES support full diagnistics option
160      !! key_trc_diabio which gives an option of FULL output of
161      !! biological sourses and sinks. I cannot see any reason
162      !! for doing this. If needed, it can be done as shown
163      !! below.
164      !!----------------------------------------------------------
165      !!
166      IF(lwp) WRITE(numout,*) ' MEDUSA does not support key_trc_diabio'
167# endif
168
169      !! The section below, down to calculation of zo2min, was moved
170      !! from before the call to AIR_SEA in trcbio_medusa.F90 - marc 9/5/17
171      IF( lk_iomput ) THEN
172         DO jj = 2,jpjm1
173            DO ji = 2,jpim1
174               if (tmask(ji,jj,1) == 1) then
175                  !! sum tracers for inventory checks
176                  IF ( med_diag%INVTN%dgsave )   THEN
177                     ftot_n(ji,jj)  = ftot_n(ji,jj) +                        &
178                        (fse3t(ji,jj,jk) * (zphn(ji,jj) + zphd(ji,jj) +      &
179                                            zzmi(ji,jj) + zzme(ji,jj) +      &
180                                            zdet(ji,jj) + zdin(ji,jj)))
181                  ENDIF
182                  IF ( med_diag%INVTSI%dgsave )  THEN
183                     ftot_si(ji,jj) = ftot_si(ji,jj) +                       & 
184                       (fse3t(ji,jj,jk) * (zpds(ji,jj) + zsil(ji,jj)))
185                  ENDIF
186                  IF ( med_diag%INVTFE%dgsave )  THEN
187                     ftot_fe(ji,jj) = ftot_fe(ji,jj) +                       & 
188                        (fse3t(ji,jj,jk) * (xrfn *                           &
189                                            (zphn(ji,jj) + zphd(ji,jj) +     &
190                                             zzmi(ji,jj) + zzme(ji,jj) +     &
191                                             zdet(ji,jj)) +                  &
192                                            zfer(ji,jj)))
193                  ENDIF
194               ENDIF
195            ENDDO
196         ENDDO
197
198# if defined key_roam
199         DO jj = 2,jpjm1
200            DO ji = 2,jpim1
201               if (tmask(ji,jj,1) == 1) then
202                  IF ( med_diag%INVTC%dgsave )  THEN
203                     ftot_c(ji,jj)  = ftot_c(ji,jj) +                        & 
204                        (fse3t(ji,jj,jk) * ((xthetapn * zphn(ji,jj)) +       &
205                                            (xthetapd * zphd(ji,jj)) +       &
206                                            (xthetazmi * zzmi(ji,jj)) +      &
207                                            (xthetazme * zzme(ji,jj)) +      &
208                                            zdtc(ji,jj) + zdic(ji,jj)))
209                  ENDIF
210                  IF ( med_diag%INVTALK%dgsave ) THEN
211                     ftot_a(ji,jj)  = ftot_a(ji,jj) + (fse3t(ji,jj,jk) *     &
212                                                       zalk(ji,jj))
213                  ENDIF
214                  IF ( med_diag%INVTO2%dgsave )  THEN
215                     ftot_o2(ji,jj) = ftot_o2(ji,jj) + (fse3t(ji,jj,jk) *    &
216                                                        zoxy(ji,jj))
217                  ENDIF
218               ENDIF
219            ENDDO
220         ENDDO
221
222         DO jj = 2,jpjm1
223            DO ji = 2,jpim1
224               if (tmask(ji,jj,1) == 1) then
225                  IF ( med_diag%INVTC%dgsave )  THEN
226                     !!
227                     !! AXY (10/11/16): CMIP6 diagnostics
228                     IF ( med_diag%INTDISSIC%dgsave ) THEN
229                        intdissic(ji,jj) = intdissic(ji,jj) +                &
230                                           (fse3t(ji,jj,jk) * zdic(ji,jj))
231                     ENDIF
232                     IF ( med_diag%INTDISSIN%dgsave ) THEN
233                        intdissin(ji,jj) = intdissin(ji,jj) +                &
234                                           (fse3t(ji,jj,jk) * zdin(ji,jj))
235                     ENDIF
236                     IF ( med_diag%INTDISSISI%dgsave ) THEN
237                        intdissisi(ji,jj) = intdissisi(ji,jj) +              &
238                                            (fse3t(ji,jj,jk) * zsil(ji,jj))
239                     ENDIF
240                     IF ( med_diag%INTTALK%dgsave ) THEN
241                        inttalk(ji,jj) = inttalk(ji,jj) +                    &
242                                         (fse3t(ji,jj,jk) * zalk(ji,jj))
243                     ENDIF
244                  ENDIF
245               ENDIF
246            ENDDO
247         ENDDO
248
249         DO jj = 2,jpjm1
250            DO ji = 2,jpim1
251               if (tmask(ji,jj,1) == 1) then
252                  IF ( med_diag%O2min%dgsave ) THEN
253                     if ( zoxy(ji,jj) < o2min(ji,jj) ) then
254                        o2min(ji,jj)  = zoxy(ji,jj)
255                        IF ( med_diag%ZO2min%dgsave ) THEN
256                           !! layer midpoint
257                           zo2min(ji,jj) = (fsdepw(ji,jj,jk) +               &
258                                            fdep1(ji,jj)) / 2.0
259                        ENDIF
260                     endif
261                  ENDIF
262               ENDIF
263            ENDDO
264         ENDDO
265# endif
266      ENDIF
267
268# if defined key_roam
269      !! This section is moved from just below CALL to AIR_SEA in
270      !! trcbio_medusa.F90 - marc 9/5/17
271      DO jj = 2,jpjm1
272         DO ji = 2,jpim1
273            !! OPEN wet point IF..THEN loop
274            if (tmask(ji,jj,jk) == 1) then
275
276               !! AXY (11/11/16): CMIP6 oxygen saturation 3D diagnostic
277               IF ( med_diag%O2SAT3%dgsave ) THEN
278! Remove f_o2sat3 - marc 9/5/17
279!                  call oxy_sato( ztmp(ji,jj), zsal(ji,jj), f_o2sat3 )
280!                  o2sat3(ji, jj, jk) = f_o2sat3
281                  call oxy_sato( ztmp(ji,jj), zsal(ji,jj),                   &
282                                 o2sat3(ji,jj,jk) )
283               ENDIF
284            ENDIF
285         ENDDO
286      ENDDO
287# endif
288
289      IF( lk_iomput  .AND.  .NOT.  ln_diatrc  ) THEN
290
291         DO jj = 2,jpjm1
292            DO ji = 2,jpim1
293               !! OPEN wet point IF..THEN loop
294               IF (tmask(ji,jj,jk) == 1) THEN
295                  !!-------------------------------------------------------
296                  !! Add in XML diagnostics stuff
297                  !!-------------------------------------------------------
298                  !!
299                  !! ** 2D diagnostics
300#   if defined key_debug_medusa
301                  IF (lwp) write (numout,*)                                  &
302                     'trc_bio_medusa: diag in ij-jj-jk loop'
303                  CALL flush(numout)
304#   endif
305                  IF ( med_diag%PRN%dgsave ) THEN
306                      fprn2d(ji,jj) = fprn2d(ji,jj) +                        &
307                                      (fprn(ji,jj)  * zphn(ji,jj) *          &
308                                       fse3t(ji,jj,jk)) 
309                  ENDIF
310                  IF ( med_diag%MPN%dgsave ) THEN
311                      fdpn2d(ji,jj) = fdpn2d(ji,jj) + (fdpn(ji,jj) *         &
312                                                       fse3t(ji,jj,jk))
313                  ENDIF
314                  IF ( med_diag%PRD%dgsave ) THEN
315                      fprd2d(ji,jj) = fprd2d(ji,jj) +                        &
316                                      (fprd(ji,jj)  * zphd(ji,jj) *          &
317                                       fse3t(ji,jj,jk))
318                  ENDIF
319                  IF( med_diag%MPD%dgsave ) THEN
320                      fdpd2d(ji,jj) = fdpd2d(ji,jj) + (fdpd(ji,jj) *         &
321                                                       fse3t(ji,jj,jk)) 
322                  ENDIF
323                  !  IF( med_diag%DSED%dgsave ) THEN
324                  !      CALL iom_put( "DSED"  , ftot_n )
325                  !  ENDIF
326                  IF( med_diag%OPAL%dgsave ) THEN
327                      fprds2d(ji,jj) = fprds2d(ji,jj) +                      &
328                                       (fprds(ji,jj) * zpds(ji,jj) *         &
329                                        fse3t(ji,jj,jk)) 
330                  ENDIF
331               ENDIF
332            ENDDO
333         ENDDO
334
335         DO jj = 2,jpjm1
336            DO ji = 2,jpim1
337               IF (tmask(ji,jj,jk) == 1) THEN
338                  IF( med_diag%OPALDISS%dgsave ) THEN
339                      fsdiss2d(ji,jj) = fsdiss2d(ji,jj) + (fsdiss(ji,jj) *   &
340                                                           fse3t(ji,jj,jk)) 
341                  ENDIF
342                  IF( med_diag%GMIPn%dgsave ) THEN
343                      fgmipn2d(ji,jj) = fgmipn2d(ji,jj) +                    &
344                                        (fgmipn(ji,jj)  * fse3t(ji,jj,jk)) 
345                  ENDIF
346                  IF( med_diag%GMID%dgsave ) THEN
347                      fgmid2d(ji,jj) = fgmid2d(ji,jj) + (fgmid(ji,jj) *      &
348                                                         fse3t(ji,jj,jk)) 
349                  ENDIF
350                  IF( med_diag%MZMI%dgsave ) THEN
351                      fdzmi2d(ji,jj) = fdzmi2d(ji,jj) + (fdzmi(ji,jj) *      &
352                                                         fse3t(ji,jj,jk)) 
353                  ENDIF
354               ENDIF
355            ENDDO
356         ENDDO
357
358         DO jj = 2,jpjm1
359            DO ji = 2,jpim1
360               IF (tmask(ji,jj,jk) == 1) THEN
361                  IF( med_diag%GMEPN%dgsave ) THEN
362                      fgmepn2d(ji,jj) = fgmepn2d(ji,jj) + (fgmepn(ji,jj) *   &
363                                                           fse3t(ji,jj,jk))
364                  ENDIF
365                  IF( med_diag%GMEPD%dgsave ) THEN
366                      fgmepd2d(ji,jj) = fgmepd2d(ji,jj) + (fgmepd(ji,jj) *   &
367                                                           fse3t(ji,jj,jk)) 
368                  ENDIF
369                  IF( med_diag%GMEZMI%dgsave ) THEN
370                      fgmezmi2d(ji,jj) = fgmezmi2d(ji,jj) +                  &
371                                         (fgmezmi(ji,jj) * fse3t(ji,jj,jk)) 
372                  ENDIF
373                  IF( med_diag%GMED%dgsave ) THEN
374                      fgmed2d(ji,jj) = fgmed2d(ji,jj) +                      &
375                                       (fgmed(ji,jj) * fse3t(ji,jj,jk)) 
376                  ENDIF
377                  IF( med_diag%MZME%dgsave ) THEN
378                      fdzme2d(ji,jj) = fdzme2d(ji,jj) +                      &
379                                       (fdzme(ji,jj) * fse3t(ji,jj,jk)) 
380                  ENDIF
381                  !  IF( med_diag%DEXP%dgsave ) THEN
382                  !      CALL iom_put( "DEXP"  , ftot_n )
383                  !  ENDIF
384               ENDIF
385            ENDDO
386         ENDDO
387
388         DO jj = 2,jpjm1
389            DO ji = 2,jpim1
390               IF (tmask(ji,jj,jk) == 1) THEN
391                  IF( med_diag%DETN%dgsave ) THEN
392                      fslown2d(ji,jj) = fslown2d(ji,jj) +                    &
393                                        (fslown(ji,jj) * fse3t(ji,jj,jk)) 
394                  ENDIF
395                  IF( med_diag%MDET%dgsave ) THEN
396                      fdd2d(ji,jj) = fdd2d(ji,jj) +                          &
397                                     (fdd(ji,jj) * fse3t(ji,jj,jk)) 
398                  ENDIF
399               ENDIF
400            ENDDO
401         ENDDO
402
403         DO jj = 2,jpjm1
404            DO ji = 2,jpim1
405               IF (tmask(ji,jj,jk) == 1) THEN
406                  IF( med_diag%AEOLIAN%dgsave ) THEN
407                      ffetop2d(ji,jj) = ffetop2d(ji,jj) +                    &
408                                        (ffetop(ji,jj) * fse3t(ji,jj,jk)) 
409                  ENDIF
410                  IF( med_diag%BENTHIC%dgsave ) THEN
411                      ffebot2d(ji,jj) = ffebot2d(ji,jj) +                    &
412                                        (ffebot(ji,jj) * fse3t(ji,jj,jk)) 
413                  ENDIF
414                  IF( med_diag%SCAVENGE%dgsave ) THEN
415                      ffescav2d(ji,jj) = ffescav2d(ji,jj) +                  &
416                                         (ffescav(ji,jj) * fse3t(ji,jj,jk)) 
417                  ENDIF
418               ENDIF
419            ENDDO
420         ENDDO
421
422         DO jj = 2,jpjm1
423            DO ji = 2,jpim1
424               IF (tmask(ji,jj,jk) == 1) THEN
425                  IF( med_diag%PN_JLIM%dgsave ) THEN
426                      ! fjln2d(ji,jj) = fjln2d(ji,jj) +                       &
427                      !                 (fjln(ji,jj)  * zphn(ji,jj) *         &
428                      !                  fse3t(ji,jj,jk))
429                      fjln2d(ji,jj) = fjln2d(ji,jj) +                        &
430                                      (fjlim_pn(ji,jj) * zphn(ji,jj) *       &
431                                       fse3t(ji,jj,jk)) 
432                  ENDIF
433                  IF( med_diag%PN_NLIM%dgsave ) THEN
434                      fnln2d(ji,jj) = fnln2d(ji,jj) +                        &
435                                      (fnln(ji,jj) * zphn(ji,jj) *           &
436                                       fse3t(ji,jj,jk)) 
437                  ENDIF
438                  IF( med_diag%PN_FELIM%dgsave ) THEN
439                      ffln2d(ji,jj) = ffln2d(ji,jj) +                        &
440                                      (ffln2(ji,jj) * zphn(ji,jj) *          &
441                                       fse3t(ji,jj,jk)) 
442                  ENDIF
443               ENDIF
444            ENDDO
445         ENDDO
446
447         DO jj = 2,jpjm1
448            DO ji = 2,jpim1
449               IF (tmask(ji,jj,jk) == 1) THEN
450                  IF( med_diag%PD_JLIM%dgsave ) THEN
451                      ! fjld2d(ji,jj) = fjld2d(ji,jj) +                       &
452                      !                 (fjld(ji,jj)  * zphd(ji,jj) *         &
453                      !                  fse3t(ji,jj,jk))
454                      fjld2d(ji,jj) = fjld2d(ji,jj) +                        &
455                                      (fjlim_pd(ji,jj) * zphd(ji,jj) *       &
456                                       fse3t(ji,jj,jk)) 
457                  ENDIF
458                  IF( med_diag%PD_NLIM%dgsave ) THEN
459                      fnld2d(ji,jj) = fnld2d(ji,jj) +                        &
460                                      (fnld(ji,jj) * zphd(ji,jj) *           &
461                                       fse3t(ji,jj,jk)) 
462                  ENDIF
463                  IF( med_diag%PD_FELIM%dgsave ) THEN
464                      ffld2d(ji,jj) = ffld2d(ji,jj) +                        &
465                                      (ffld(ji,jj) * zphd(ji,jj) *           &
466                                       fse3t(ji,jj,jk)) 
467                  ENDIF
468                  IF( med_diag%PD_SILIM%dgsave ) THEN
469                      fsld2d2(ji,jj) = fsld2d2(ji,jj) +                      &
470                                       (fsld2(ji,jj) * zphd(ji,jj) *         &
471                                        fse3t(ji,jj,jk)) 
472                  ENDIF
473                  IF( med_diag%PDSILIM2%dgsave ) THEN
474                      fsld2d(ji,jj) = fsld2d(ji,jj) +                        &
475                                      (fsld(ji,jj) * zphd(ji,jj) *           &
476                                       fse3t(ji,jj,jk))
477                  ENDIF
478               ENDIF
479            ENDDO
480         ENDDO
481
482         DO jj = 2,jpjm1
483            DO ji = 2,jpim1
484               IF (tmask(ji,jj,jk) == 1) THEN
485                  !!
486                  IF( med_diag%TOTREG_N%dgsave ) THEN
487                      fregen2d(ji,jj) = fregen2d(ji,jj) + fregen(ji,jj)
488                  ENDIF
489                  IF( med_diag%TOTRG_SI%dgsave ) THEN
490                      fregensi2d(ji,jj) = fregensi2d(ji,jj) + fregensi(ji,jj)
491                  ENDIF
492               ENDIF
493            ENDDO
494         ENDDO
495
496         DO jj = 2,jpjm1
497            DO ji = 2,jpim1
498               IF (tmask(ji,jj,jk) == 1) THEN
499                  !!
500                  IF( med_diag%FASTN%dgsave ) THEN
501                      ftempn2d(ji,jj) = ftempn2d(ji,jj) +                    &
502                                        (ftempn(ji,jj)  * fse3t(ji,jj,jk))
503                  ENDIF
504                  IF( med_diag%FASTSI%dgsave ) THEN
505                      ftempsi2d(ji,jj) = ftempsi2d(ji,jj) +                  &
506                                         (ftempsi(ji,jj) * fse3t(ji,jj,jk))
507                  ENDIF
508                  IF( med_diag%FASTFE%dgsave ) THEN
509                      ftempfe2d(ji,jj) = ftempfe2d(ji,jj) +                  &
510                                         (ftempfe(ji,jj) * fse3t(ji,jj,jk)) 
511                  ENDIF
512                  IF( med_diag%FASTC%dgsave ) THEN
513                      ftempc2d(ji,jj) = ftempc2d(ji,jj) +                    &
514                                        (ftempc(ji,jj) * fse3t(ji,jj,jk))
515                  ENDIF
516                  IF( med_diag%FASTCA%dgsave ) THEN
517                      ftempca2d(ji,jj) = ftempca2d(ji,jj) +                  &
518                                         (ftempca(ji,jj) * fse3t(ji,jj,jk))
519                  ENDIF
520               ENDIF
521            ENDDO
522         ENDDO
523
524         DO jj = 2,jpjm1
525            DO ji = 2,jpim1
526               IF (tmask(ji,jj,jk) == 1) THEN
527                  !!
528                  IF( med_diag%REMINN%dgsave ) THEN
529                      freminn2d(ji,jj) = freminn2d(ji,jj) +                  &
530                                         (freminn(ji,jj)  * fse3t(ji,jj,jk))
531                  ENDIF
532                  IF( med_diag%REMINSI%dgsave ) THEN
533                      freminsi2d(ji,jj) = freminsi2d(ji,jj) +                &
534                                          (freminsi(ji,jj) * fse3t(ji,jj,jk))
535                  ENDIF
536                  IF( med_diag%REMINFE%dgsave ) THEN
537                      freminfe2d(ji,jj) = freminfe2d(ji,jj) +                &
538                                          (freminfe(ji,jj) * fse3t(ji,jj,jk)) 
539                  ENDIF
540                  IF( med_diag%REMINC%dgsave ) THEN
541                      freminc2d(ji,jj) = freminc2d(ji,jj) +                  &
542                                         (freminc(ji,jj)  * fse3t(ji,jj,jk)) 
543                  ENDIF
544                  IF( med_diag%REMINCA%dgsave ) THEN
545                      freminca2d(ji,jj) = freminca2d(ji,jj) +                &
546                                          (freminca(ji,jj) * fse3t(ji,jj,jk)) 
547                  ENDIF
548                  !!
549               ENDIF
550            ENDDO
551         ENDDO
552
553# if defined key_roam
554         DO jj = 2,jpjm1
555            DO ji = 2,jpim1
556               IF (tmask(ji,jj,jk) == 1) THEN
557                  !!
558                  !! AXY (09/11/16): CMIP6 diagnostics
559                  IF( med_diag%FD_NIT3%dgsave ) THEN
560                     fd_nit3(ji,jj,jk) = ffastn(ji,jj)
561                  ENDIF
562                  IF( med_diag%FD_SIL3%dgsave ) THEN
563                     fd_sil3(ji,jj,jk) = ffastsi(ji,jj)
564                  ENDIF
565                  IF( med_diag%FD_CAR3%dgsave ) THEN
566                     fd_car3(ji,jj,jk) = ffastc(ji,jj)
567                  ENDIF
568                  IF( med_diag%FD_CAL3%dgsave ) THEN
569                     fd_cal3(ji,jj,jk) = ffastca(ji,jj)
570                  ENDIF
571               ENDIF
572            ENDDO
573         ENDDO
574
575         IF (jk.eq.i0100) THEN
576            DO jj = 2,jpjm1
577               DO ji = 2,jpim1
578                  IF (tmask(ji,jj,jk) == 1) THEN
579                     IF( med_diag%RR_0100%dgsave ) THEN
580                        ffastca2d(ji,jj) =                                   &
581                           ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall)
582                     ENDIF
583                  ENDIF
584               ENDDO
585            ENDDO
586         ELSE IF (jk.eq.i0500) THEN
587            DO jj = 2,jpjm1
588               DO ji = 2,jpim1
589                  IF (tmask(ji,jj,jk) == 1) THEN
590                     IF( med_diag%RR_0500%dgsave ) THEN
591                        ffastca2d(ji,jj) =                                   &
592                           ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall)
593                     ENDIF
594                  ENDIF
595               ENDDO
596            ENDDO
597         ELSE IF (jk.eq.i1000) THEN
598            DO jj = 2,jpjm1
599               DO ji = 2,jpim1
600                  IF (tmask(ji,jj,jk) == 1) THEN
601                     IF( med_diag%RR_1000%dgsave ) THEN
602                        ffastca2d(ji,jj) =                                   &
603                           ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall)
604                     ENDIF
605                  ENDIF
606               ENDDO
607            ENDDO
608         ELSE IF (jk.eq.mbathy(ji,jj)) THEN
609            DO jj = 2,jpjm1
610               DO ji = 2,jpim1
611                  IF (tmask(ji,jj,jk) == 1) THEN
612                     IF( med_diag%IBEN_N%dgsave ) THEN
613                        iben_n2d(ji,jj) = f_sbenin_n(ji,jj) +                &
614                                          f_fbenin_n(ji,jj)
615                     ENDIF
616                     IF( med_diag%IBEN_FE%dgsave ) THEN
617                        iben_fe2d(ji,jj) = f_sbenin_fe(ji,jj) +              &
618                                           f_fbenin_fe(ji,jj)
619                     ENDIF
620                     IF( med_diag%IBEN_C%dgsave ) THEN
621                        iben_c2d(ji,jj) = f_sbenin_c(ji,jj) +                &
622                                          f_fbenin_c(ji,jj)
623                     ENDIF
624                     IF( med_diag%IBEN_SI%dgsave ) THEN
625                        iben_si2d(ji,jj) = f_fbenin_si(ji,jj)
626                     ENDIF
627                     IF( med_diag%IBEN_CA%dgsave ) THEN
628                        iben_ca2d(ji,jj) = f_fbenin_ca(ji,jj)
629                     ENDIF
630                     IF( med_diag%OBEN_N%dgsave ) THEN
631                        oben_n2d(ji,jj) = f_benout_n(ji,jj)
632                     ENDIF
633                     IF( med_diag%OBEN_FE%dgsave ) THEN
634                        oben_fe2d(ji,jj) = f_benout_fe(ji,jj)
635                     ENDIF
636                     IF( med_diag%OBEN_C%dgsave ) THEN
637                        oben_c2d(ji,jj) = f_benout_c(ji,jj)
638                     ENDIF
639                     IF( med_diag%OBEN_SI%dgsave ) THEN
640                        oben_si2d(ji,jj) = f_benout_si(ji,jj)
641                     ENDIF
642                     IF( med_diag%OBEN_CA%dgsave ) THEN
643                        oben_ca2d(ji,jj) = f_benout_ca(ji,jj)
644                     ENDIF
645                     IF( med_diag%SFR_OCAL%dgsave ) THEN
646                        sfr_ocal2d(ji,jj) = f3_omcal(ji,jj,jk)
647                     ENDIF
648                     IF( med_diag%SFR_OARG%dgsave ) THEN
649                        sfr_oarg2d(ji,jj) =  f3_omarg(ji,jj,jk)
650                     ENDIF
651                     IF( med_diag%LYSO_CA%dgsave ) THEN
652                        lyso_ca2d(ji,jj) = f_benout_lyso_ca(ji,jj)
653                     ENDIF
654                  ENDIF
655               ENDDO
656            ENDDO
657         ENDIF
658         !! end bathy-1 diags
659
660         DO jj = 2,jpjm1
661            DO ji = 2,jpim1
662               IF (tmask(ji,jj,jk) == 1) THEN
663                  !!
664                  IF( med_diag%RIV_N%dgsave ) THEN
665                     rivn2d(ji,jj) = rivn2d(ji,jj) +                         &
666                                     (f_riv_loc_n(ji,jj) * fse3t(ji,jj,jk))
667                  ENDIF
668                  IF( med_diag%RIV_SI%dgsave ) THEN
669                     rivsi2d(ji,jj) = rivsi2d(ji,jj) +                       &
670                                      (f_riv_loc_si(ji,jj) * fse3t(ji,jj,jk))
671                  ENDIF
672                  IF( med_diag%RIV_C%dgsave ) THEN
673                     rivc2d(ji,jj) = rivc2d(ji,jj) +                         &
674                                     (f_riv_loc_c(ji,jj) * fse3t(ji,jj,jk))
675                  ENDIF
676                  IF( med_diag%RIV_ALK%dgsave ) THEN
677                     rivalk2d(ji,jj) = rivalk2d(ji,jj) +                     &
678                                       (f_riv_loc_alk(ji,jj) *               &
679                                        fse3t(ji,jj,jk))
680                  ENDIF
681                  IF( med_diag%DETC%dgsave ) THEN
682                     fslowc2d(ji,jj) = fslowc2d(ji,jj) +                     &
683                                       (fslowc(ji,jj)  * fse3t(ji,jj,jk))   
684                  ENDIF
685               ENDIF
686            ENDDO
687         ENDDO
688
689         DO jj = 2,jpjm1
690            DO ji = 2,jpim1
691               IF (tmask(ji,jj,jk) == 1) THEN
692                  !!
693                  IF( med_diag%PN_LLOSS%dgsave ) THEN
694                     fdpn22d(ji,jj) = fdpn22d(ji,jj) +                       &
695                                      (fdpn2(ji,jj)  * fse3t(ji,jj,jk))
696                  ENDIF
697                  IF( med_diag%PD_LLOSS%dgsave ) THEN
698                     fdpd22d(ji,jj) = fdpd22d(ji,jj) +                       &
699                                      (fdpd2(ji,jj)  * fse3t(ji,jj,jk))
700                  ENDIF
701               ENDIF
702            ENDDO
703         ENDDO
704
705         DO jj = 2,jpjm1
706            DO ji = 2,jpim1
707               IF (tmask(ji,jj,jk) == 1) THEN
708                  IF( med_diag%ZI_LLOSS%dgsave ) THEN
709                     fdzmi22d(ji,jj) = fdzmi22d(ji,jj) +                     &
710                                       (fdzmi2(ji,jj) * fse3t(ji,jj,jk))
711                  ENDIF
712                  IF( med_diag%ZE_LLOSS%dgsave ) THEN
713                     fdzme22d(ji,jj) = fdzme22d(ji,jj) +                     &
714                                       (fdzme2(ji,jj) * fse3t(ji,jj,jk))
715                  ENDIF
716               ENDIF
717            ENDDO
718         ENDDO
719
720         DO jj = 2,jpjm1
721            DO ji = 2,jpim1
722               IF (tmask(ji,jj,jk) == 1) THEN
723                  IF( med_diag%ZI_MES_N%dgsave ) THEN
724                     zimesn2d(ji,jj) = zimesn2d(ji,jj) +                     &
725                                       (xphi * (fgmipn(ji,jj) +              &
726                                                fgmid(ji,jj)) *              &
727                                        fse3t(ji,jj,jk))
728                  ENDIF
729                  IF( med_diag%ZI_MES_D%dgsave ) THEN
730                     zimesd2d(ji,jj) = zimesd2d(ji,jj) +                     & 
731                                       ((1. - xbetan) * finmi(ji,jj) *       &
732                                        fse3t(ji,jj,jk))
733                  ENDIF
734                  IF( med_diag%ZI_MES_C%dgsave ) THEN
735                     zimesc2d(ji,jj) = zimesc2d(ji,jj) +                     &
736                                       (xphi * ((xthetapn * fgmipn(ji,jj)) + &
737                                                fgmidc(ji,jj)) *             &
738                                                fse3t(ji,jj,jk))
739                  ENDIF
740                  IF( med_diag%ZI_MESDC%dgsave ) THEN
741                     zimesdc2d(ji,jj) = zimesdc2d(ji,jj) +                   &
742                                        ((1. - xbetac) * ficmi(ji,jj) *      &
743                                         fse3t(ji,jj,jk))
744                  ENDIF
745                  IF( med_diag%ZI_EXCR%dgsave ) THEN
746                     ziexcr2d(ji,jj) = ziexcr2d(ji,jj) +                     &
747                                       (fmiexcr(ji,jj) * fse3t(ji,jj,jk))
748                  ENDIF
749                  IF( med_diag%ZI_RESP%dgsave ) THEN
750                     ziresp2d(ji,jj) = ziresp2d(ji,jj) +                     &
751                                       (fmiresp(ji,jj) * fse3t(ji,jj,jk))
752                  ENDIF
753                  IF( med_diag%ZI_GROW%dgsave ) THEN
754                     zigrow2d(ji,jj) = zigrow2d(ji,jj) +                     &
755                                       (fmigrow(ji,jj) * fse3t(ji,jj,jk))
756                  ENDIF
757               ENDIF
758            ENDDO
759         ENDDO
760
761         DO jj = 2,jpjm1
762            DO ji = 2,jpim1
763               IF (tmask(ji,jj,jk) == 1) THEN
764                  IF( med_diag%ZE_MES_N%dgsave ) THEN
765                     zemesn2d(ji,jj) = zemesn2d(ji,jj) +                     &
766                                       (xphi *                               &
767                                        (fgmepn(ji,jj) + fgmepd(ji,jj) +     &
768                                         fgmezmi(ji,jj) + fgmed(ji,jj)) *    &
769                                        fse3t(ji,jj,jk))
770                  ENDIF
771                  IF( med_diag%ZE_MES_D%dgsave ) THEN
772                     zemesd2d(ji,jj) = zemesd2d(ji,jj) +                     &
773                                       ((1. - xbetan) * finme(ji,jj) *       &
774                                        fse3t(ji,jj,jk))
775                  ENDIF
776                  IF( med_diag%ZE_MES_C%dgsave ) THEN
777                     zemesc2d(ji,jj) = zemesc2d(ji,jj) +                     & 
778                                       (xphi *                               &
779                                        ((xthetapn * fgmepn(ji,jj)) +        &
780                                         (xthetapd * fgmepd(ji,jj)) +        &
781                                         (xthetazmi * fgmezmi(ji,jj)) +      &
782                                         fgmedc(ji,jj)) * fse3t(ji,jj,jk))
783                  ENDIF
784                  IF( med_diag%ZE_MESDC%dgsave ) THEN
785                     zemesdc2d(ji,jj) = zemesdc2d(ji,jj) +                   &
786                                        ((1. - xbetac) * ficme(ji,jj) *      &
787                                         fse3t(ji,jj,jk))
788                  ENDIF
789                  IF( med_diag%ZE_EXCR%dgsave ) THEN
790                     zeexcr2d(ji,jj) = zeexcr2d(ji,jj) +                     &
791                                       (fmeexcr(ji,jj) * fse3t(ji,jj,jk))
792                  ENDIF
793                  IF( med_diag%ZE_RESP%dgsave ) THEN
794                     zeresp2d(ji,jj) = zeresp2d(ji,jj) +                     &
795                                       (fmeresp(ji,jj) * fse3t(ji,jj,jk))
796                  ENDIF
797                  IF( med_diag%ZE_GROW%dgsave ) THEN
798                     zegrow2d(ji,jj) = zegrow2d(ji,jj) +                     &
799                                       (fmegrow(ji,jj) * fse3t(ji,jj,jk))
800                  ENDIF
801               ENDIF
802            ENDDO
803         ENDDO
804
805         DO jj = 2,jpjm1
806            DO ji = 2,jpim1
807               IF (tmask(ji,jj,jk) == 1) THEN
808                  IF( med_diag%MDETC%dgsave ) THEN
809                     mdetc2d(ji,jj) = mdetc2d(ji,jj) +                       &
810                                      (fddc(ji,jj) * fse3t(ji,jj,jk))
811                  ENDIF
812                  IF( med_diag%GMIDC%dgsave ) THEN
813                     gmidc2d(ji,jj) = gmidc2d(ji,jj) +                       &
814                                      (fgmidc(ji,jj) * fse3t(ji,jj,jk))
815                  ENDIF
816                  IF( med_diag%GMEDC%dgsave ) THEN
817                     gmedc2d(ji,jj) = gmedc2d(ji,jj) +                       &
818                                      (fgmedc(ji,jj) * fse3t(ji,jj,jk))
819                  ENDIF
820               ENDIF
821            ENDDO
822         ENDDO
823# endif                   
824
825         DO jj = 2,jpjm1
826            DO ji = 2,jpim1
827               IF (tmask(ji,jj,jk) == 1) THEN
828                  !!
829                  !! ** 3D diagnostics
830                  IF( med_diag%TPP3%dgsave ) THEN
831                     tpp3d(ji,jj,jk) = (fprn(ji,jj) * zphn(ji,jj)) +         &
832                                       (fprd(ji,jj) * zphd(ji,jj))
833                     !CALL iom_put( "TPP3"  , tpp3d )
834                  ENDIF
835                  IF( med_diag%TPPD3%dgsave ) THEN
836                     tppd3(ji,jj,jk) = (fprd(ji,jj) * zphd(ji,jj))
837                  ENDIF
838               ENDIF
839            ENDDO
840         ENDDO
841
842         DO jj = 2,jpjm1
843            DO ji = 2,jpim1
844               IF (tmask(ji,jj,jk) == 1) THEN
845                 
846                  IF( med_diag%REMIN3N%dgsave ) THEN
847                     !! remineralisation
848                     remin3dn(ji,jj,jk) = fregen(ji,jj) +                    &
849                                          (freminn(ji,jj) * fse3t(ji,jj,jk))
850                     !CALL iom_put( "REMIN3N"  , remin3dn )
851                  ENDIF
852                  !! IF( med_diag%PH3%dgsave ) THEN
853                  !!     CALL iom_put( "PH3"  , f3_pH )
854                  !! ENDIF
855                  !! IF( med_diag%OM_CAL3%dgsave ) THEN
856                  !!     CALL iom_put( "OM_CAL3"  , f3_omcal )
857                  !! ENDIF
858        !!
859        !! AXY (09/11/16): CMIP6 diagnostics
860        IF ( med_diag%DCALC3%dgsave   ) THEN
861                     dcalc3(ji,jj,jk) = freminca(ji,jj)
862                  ENDIF
863               ENDIF
864            ENDDO
865         ENDDO
866
867         DO jj = 2,jpjm1
868            DO ji = 2,jpim1
869               IF (tmask(ji,jj,jk) == 1) THEN
870        IF ( med_diag%FEDISS3%dgsave  ) THEN
871                     fediss3(ji,jj,jk) = ffetop(ji,jj)
872                  ENDIF
873        IF ( med_diag%FESCAV3%dgsave  ) THEN
874                     fescav3(ji,jj,jk) = ffescav(ji,jj)
875                  ENDIF
876               ENDIF
877            ENDDO
878         ENDDO
879
880         DO jj = 2,jpjm1
881            DO ji = 2,jpim1
882               IF (tmask(ji,jj,jk) == 1) THEN
883        IF ( med_diag%MIGRAZP3%dgsave ) THEN
884                     migrazp3(ji,jj,jk) = fgmipn(ji,jj) * xthetapn
885                  ENDIF
886        IF ( med_diag%MIGRAZD3%dgsave ) THEN
887                     migrazd3(ji,jj,jk) = fgmidc(ji,jj)
888                  ENDIF
889        IF ( med_diag%MEGRAZP3%dgsave ) THEN
890                     megrazp3(ji,jj,jk) = (fgmepn(ji,jj) * xthetapn) +       &
891                                          (fgmepd(ji,jj) * xthetapd)
892                  ENDIF
893        IF ( med_diag%MEGRAZD3%dgsave ) THEN
894                     megrazd3(ji,jj,jk) = fgmedc(ji,jj)
895                  ENDIF
896        IF ( med_diag%MEGRAZZ3%dgsave ) THEN
897                     megrazz3(ji,jj,jk) = (fgmezmi(ji,jj) * xthetazmi)
898                  ENDIF
899               ENDIF
900            ENDDO
901         ENDDO
902
903         DO jj = 2,jpjm1
904            DO ji = 2,jpim1
905               IF (tmask(ji,jj,jk) == 1) THEN
906        IF ( med_diag%PBSI3%dgsave    ) THEN
907                     pbsi3(ji,jj,jk)    = (fprds(ji,jj) * zpds(ji,jj))
908                  ENDIF
909        IF ( med_diag%PCAL3%dgsave    ) THEN
910                     pcal3(ji,jj,jk)    = ftempca(ji,jj)
911                  ENDIF
912        IF ( med_diag%REMOC3%dgsave   ) THEN
913                     remoc3(ji,jj,jk)   = freminc(ji,jj)
914                  ENDIF
915               ENDIF
916            ENDDO
917         ENDDO
918
919         DO jj = 2,jpjm1
920            DO ji = 2,jpim1
921               IF (tmask(ji,jj,jk) == 1) THEN
922        IF ( med_diag%PNLIMJ3%dgsave  ) THEN
923                     ! pnlimj3(ji,jj,jk)  = fjln(ji,jj)
924                     pnlimj3(ji,jj,jk)  = fjlim_pn(ji,jj)
925                  ENDIF
926        IF ( med_diag%PNLIMN3%dgsave  ) THEN
927                     pnlimn3(ji,jj,jk)  = fnln(ji,jj)
928                  ENDIF
929        IF ( med_diag%PNLIMFE3%dgsave ) THEN
930                     pnlimfe3(ji,jj,jk) = ffln2(ji,jj)
931                  ENDIF
932        IF ( med_diag%PDLIMJ3%dgsave  ) THEN
933                     ! pdlimj3(ji,jj,jk)  = fjld(ji,jj)
934                     pdlimj3(ji,jj,jk)  = fjlim_pd(ji,jj)
935                  ENDIF
936        IF ( med_diag%PDLIMN3%dgsave  ) THEN
937                     pdlimn3(ji,jj,jk)  = fnld(ji,jj)
938                  ENDIF
939        IF ( med_diag%PDLIMFE3%dgsave ) THEN
940                     pdlimfe3(ji,jj,jk) = ffld(ji,jj)
941                  ENDIF
942        IF ( med_diag%PDLIMSI3%dgsave ) THEN
943                     pdlimsi3(ji,jj,jk) = fsld2(ji,jj)
944                  ENDIF
945               ENDIF
946            ENDDO
947         ENDDO
948
949      ELSE IF( ln_diatrc ) THEN
950
951         !!
952         !! ** Without using iom_use
953#   if defined key_debug_medusa
954         IF (lwp) write (numout,*) 'trc_bio_medusa: diag in ij-jj-jk ln_diatrc'
955         CALL flush(numout)
956#   endif
957         DO jj = 2,jpjm1
958            DO ji = 2,jpim1
959               IF (tmask(ji,jj,jk) == 1) then
960                  !!-------------------------------------------------------
961                  !! Prepare 2D diagnostics
962                  !!-------------------------------------------------------
963                  !!
964                  !! if ((kt / 240*240).eq.kt) then
965                  !!    IF (lwp) write (*,*) '*******!MEDUSA DIAADD!*******',kt
966                  !! endif     
967                  !! nitrogen inventory
968                  trc2d(ji,jj,1)  =  ftot_n(ji,jj)
969                  !! silicon  inventory
970                  trc2d(ji,jj,2)  =  ftot_si(ji,jj)
971                  !! iron     inventory
972                  trc2d(ji,jj,3)  =  ftot_fe(ji,jj)
973               ENDIF
974            ENDDO
975         ENDDO
976
977         DO jj = 2,jpjm1
978            DO ji = 2,jpim1
979               IF (tmask(ji,jj,jk) == 1) THEN
980                  !! non-diatom production
981                  trc2d(ji,jj,4)  = trc2d(ji,jj,4)  +                        &
982                                    (fprn(ji,jj)  * zphn(ji,jj) *            &
983                                     fse3t(ji,jj,jk))
984                  !! non-diatom non-grazing losses
985                  trc2d(ji,jj,5)  = trc2d(ji,jj,5)  +                        &
986                                    (fdpn(ji,jj) * fse3t(ji,jj,jk))
987                  !! diatom production
988                  trc2d(ji,jj,6)  = trc2d(ji,jj,6)  +                        &
989                                    (fprd(ji,jj) * zphd(ji,jj) *             &
990                                     fse3t(ji,jj,jk))
991                  !! diatom non-grazing losses
992                  !! diagnostic field  8 is (ostensibly) supplied by trcsed.F
993                  trc2d(ji,jj,7)  = trc2d(ji,jj,7)  +                        &
994                                    (fdpd(ji,jj) * fse3t(ji,jj,jk))
995                  !! diatom silicon production
996                  trc2d(ji,jj,9)  = trc2d(ji,jj,9)  +                        &
997                                    (fprds(ji,jj) * zpds(ji,jj) *            &
998                                     fse3t(ji,jj,jk))
999                  !! diatom silicon dissolution
1000                  trc2d(ji,jj,10) = trc2d(ji,jj,10) +                        &
1001                                    (fsdiss(ji,jj)  * fse3t(ji,jj,jk))
1002               ENDIF
1003            ENDDO
1004         ENDDO
1005
1006         DO jj = 2,jpjm1
1007            DO ji = 2,jpim1
1008               IF (tmask(ji,jj,jk) == 1) THEN
1009                  !! microzoo grazing on non-diatoms
1010                  trc2d(ji,jj,11) = trc2d(ji,jj,11) +                        &
1011                                    (fgmipn(ji,jj)  * fse3t(ji,jj,jk))
1012                  !! microzoo grazing on detrital nitrogen
1013                  trc2d(ji,jj,12) = trc2d(ji,jj,12) +                        &
1014                                    (fgmid(ji,jj) * fse3t(ji,jj,jk))
1015                  !! microzoo non-grazing losses
1016                  trc2d(ji,jj,13) = trc2d(ji,jj,13) +                        &
1017                                    (fdzmi(ji,jj) * fse3t(ji,jj,jk))
1018               ENDIF
1019            ENDDO
1020         ENDDO
1021
1022         DO jj = 2,jpjm1
1023            DO ji = 2,jpim1
1024               IF (tmask(ji,jj,jk) == 1) THEN
1025                  !! mesozoo  grazing on non-diatoms
1026                  trc2d(ji,jj,14) = trc2d(ji,jj,14) +                        &
1027                                    (fgmepn(ji,jj)  * fse3t(ji,jj,jk))
1028                  !! mesozoo  grazing on diatoms
1029                  trc2d(ji,jj,15) = trc2d(ji,jj,15) +                        &
1030                                    (fgmepd(ji,jj)  * fse3t(ji,jj,jk))
1031                  !! mesozoo  grazing on microzoo
1032                  trc2d(ji,jj,16) = trc2d(ji,jj,16) +                        &
1033                                    (fgmezmi(ji,jj) * fse3t(ji,jj,jk))
1034                  !! mesozoo  grazing on detrital nitrogen
1035                  trc2d(ji,jj,17) = trc2d(ji,jj,17) +                        &
1036                                    (fgmed(ji,jj) * fse3t(ji,jj,jk))
1037                  !! mesozoo  non-grazing losses
1038                  trc2d(ji,jj,18) = trc2d(ji,jj,18) +                        &
1039                                    (fdzme(ji,jj)   * fse3t(ji,jj,jk))
1040               ENDIF
1041            ENDDO
1042         ENDDO
1043
1044         DO jj = 2,jpjm1
1045            DO ji = 2,jpim1
1046               IF (tmask(ji,jj,jk) == 1) THEN
1047                  !! diagnostic field 19 is (ostensibly) supplied by trcexp.F
1048                  !! slow sinking detritus N production
1049                  trc2d(ji,jj,20) = trc2d(ji,jj,20) +                        &
1050                                    (fslown(ji,jj) * fse3t(ji,jj,jk))
1051                  !! detrital remineralisation
1052                  trc2d(ji,jj,21) = trc2d(ji,jj,21) +                        &
1053                                    (fdd(ji,jj) * fse3t(ji,jj,jk))
1054                  !! aeolian  iron addition
1055                  trc2d(ji,jj,22) = trc2d(ji,jj,22) +                        &
1056                                    (ffetop(ji,jj) * fse3t(ji,jj,jk))
1057                  !! seafloor iron addition
1058                  trc2d(ji,jj,23) = trc2d(ji,jj,23) +                        &
1059                                    (ffebot(ji,jj) * fse3t(ji,jj,jk))
1060                  !! "free" iron scavenging
1061                  trc2d(ji,jj,24) = trc2d(ji,jj,24) +                        &
1062                                    (ffescav(ji,jj) * fse3t(ji,jj,jk))
1063               ENDIF
1064            ENDDO
1065         ENDDO
1066
1067         DO jj = 2,jpjm1
1068            DO ji = 2,jpim1
1069               IF (tmask(ji,jj,jk) == 1) THEN
1070                  !! non-diatom J  limitation term
1071                  trc2d(ji,jj,25) = trc2d(ji,jj,25) +                        &
1072                                    (fjlim_pn(ji,jj) * zphn(ji,jj) *         &
1073                                     fse3t(ji,jj,jk))
1074                  !! non-diatom N  limitation term
1075                  trc2d(ji,jj,26) = trc2d(ji,jj,26) +                        &
1076                                    (fnln(ji,jj) * zphn(ji,jj) *             &
1077                                     fse3t(ji,jj,jk))
1078                  !! non-diatom Fe limitation term
1079                  trc2d(ji,jj,27) = trc2d(ji,jj,27) +                        &
1080                                    (ffln2(ji,jj) * zphn(ji,jj) *            &
1081                                     fse3t(ji,jj,jk))
1082                  !! diatom     J  limitation term
1083                  trc2d(ji,jj,28) = trc2d(ji,jj,28) +                        &
1084                                    (fjlim_pd(ji,jj) * zphd(ji,jj) *         &
1085                                     fse3t(ji,jj,jk))
1086                  !! diatom     N  limitation term
1087                  trc2d(ji,jj,29) = trc2d(ji,jj,29) +                        &
1088                                    (fnld(ji,jj) * zphd(ji,jj) *             &
1089                                     fse3t(ji,jj,jk))
1090                  !! diatom     Fe limitation term
1091                  trc2d(ji,jj,30) = trc2d(ji,jj,30) +                        &
1092                                    (ffld(ji,jj) * zphd(ji,jj) *             &
1093                                     fse3t(ji,jj,jk))
1094                  !! diatom     Si limitation term
1095                  trc2d(ji,jj,31) = trc2d(ji,jj,31) +                        &
1096                                    (fsld2(ji,jj) * zphd(ji,jj) *            &
1097                                     fse3t(ji,jj,jk))
1098                  !! diatom     Si uptake limitation term
1099                  trc2d(ji,jj,32) = trc2d(ji,jj,32) +                        &
1100                                    (fsld(ji,jj) * zphd(ji,jj) *             &
1101                                     fse3t(ji,jj,jk))
1102               ENDIF
1103            ENDDO
1104         ENDDO
1105
1106         IF (jk.eq.i0100) THEN
1107            DO jj = 2,jpjm1
1108               DO ji = 2,jpim1
1109                  IF (tmask(ji,jj,jk) == 1) THEN
1110                     !! slow detritus flux at  100 m
1111                     trc2d(ji,jj,33) = fslownflux(ji,jj)
1112                  ENDIF
1113               ENDDO
1114            ENDDO
1115         ENDIF
1116
1117         IF (jk.eq.i0200) THEN
1118            DO jj = 2,jpjm1
1119               DO ji = 2,jpim1
1120                  IF (tmask(ji,jj,jk) == 1) THEN
1121                     !! slow detritus flux at  200 m
1122                     trc2d(ji,jj,34) = fslownflux(ji,jj)
1123                  ENDIF
1124               ENDDO
1125            ENDDO
1126         ENDIF
1127
1128         IF (jk.eq.i0500) THEN
1129            DO jj = 2,jpjm1
1130               DO ji = 2,jpim1
1131                  IF (tmask(ji,jj,jk) == 1) THEN
1132                     !! slow detritus flux at  500 m
1133                     trc2d(ji,jj,35) = fslownflux(ji,jj)
1134                  ENDIF
1135               ENDDO
1136            ENDDO
1137         ENDIF
1138
1139         IF (jk.eq.i1000) THEN
1140            DO jj = 2,jpjm1
1141               DO ji = 2,jpim1
1142                  IF (tmask(ji,jj,jk) == 1) THEN
1143                     !! slow detritus flux at 1000 m
1144                     trc2d(ji,jj,36) = fslownflux(ji,jj)
1145                  ENDIF
1146               ENDDO
1147            ENDDO
1148         ENDIF
1149
1150         DO jj = 2,jpjm1
1151            DO ji = 2,jpim1
1152               IF (tmask(ji,jj,jk) == 1) THEN
1153                  !! non-fast N  full column regeneration
1154                  trc2d(ji,jj,37) = trc2d(ji,jj,37) + fregen(ji,jj)
1155                  !! non-fast Si full column regeneration
1156                  trc2d(ji,jj,38) = trc2d(ji,jj,38) + fregensi(ji,jj)
1157                  !! non-fast N  regeneration to  100 m
1158               ENDIF
1159            ENDDO
1160         ENDDO
1161
1162         IF (jk.eq.i0100) THEN
1163            DO jj = 2,jpjm1
1164               DO ji = 2,jpim1
1165                  IF (tmask(ji,jj,jk) == 1) THEN
1166                     trc2d(ji,jj,39) = trc2d(ji,jj,37)
1167                  ENDIF
1168               ENDDO
1169            ENDDO
1170         ENDIF
1171
1172         IF (jk.eq.i0200) THEN
1173            DO jj = 2,jpjm1
1174               DO ji = 2,jpim1
1175                  IF (tmask(ji,jj,jk) == 1) THEN
1176                     !! non-fast N  regeneration to  200 m
1177                     trc2d(ji,jj,40) = trc2d(ji,jj,37)
1178                  ENDIF
1179               ENDDO
1180            ENDDO
1181         ENDIF
1182
1183         IF (jk.eq.i0500) THEN
1184            DO jj = 2,jpjm1
1185               DO ji = 2,jpim1
1186                  IF (tmask(ji,jj,jk) == 1) THEN
1187                     !! non-fast N  regeneration to  500 m
1188                     trc2d(ji,jj,41) = trc2d(ji,jj,37)
1189                  ENDIF
1190               ENDDO
1191            ENDDO
1192         ENDIF
1193
1194         IF (jk.eq.i1000) THEN
1195            DO jj = 2,jpjm1
1196               DO ji = 2,jpim1
1197                  IF (tmask(ji,jj,jk) == 1) THEN
1198                     !! non-fast N  regeneration to 1000 m
1199                     trc2d(ji,jj,42) = trc2d(ji,jj,37)
1200                  ENDIF
1201               ENDDO
1202            ENDDO
1203         ENDIF
1204
1205         DO jj = 2,jpjm1
1206            DO ji = 2,jpim1
1207               IF (tmask(ji,jj,jk) == 1) THEN
1208                  !! fast sinking detritus N production
1209                  trc2d(ji,jj,43) = trc2d(ji,jj,43) +                        &
1210                                    (ftempn(ji,jj) * fse3t(ji,jj,jk))
1211                  !! fast sinking detritus Si production
1212                  trc2d(ji,jj,44) = trc2d(ji,jj,44) +                        &
1213                                    (ftempsi(ji,jj) * fse3t(ji,jj,jk))
1214                  !! fast sinking detritus Fe production
1215                  trc2d(ji,jj,45) = trc2d(ji,jj,45) +                        &
1216                                    (ftempfe(ji,jj) * fse3t(ji,jj,jk))
1217                  !! fast sinking detritus C production
1218                  trc2d(ji,jj,46) = trc2d(ji,jj,46) +                        &
1219                                    (ftempc(ji,jj)  * fse3t(ji,jj,jk))
1220                  !! fast sinking detritus CaCO3 production
1221                  trc2d(ji,jj,47) = trc2d(ji,jj,47) +                        &
1222                                    (ftempca(ji,jj) * fse3t(ji,jj,jk))
1223               ENDIF
1224            ENDDO
1225         ENDDO
1226
1227         IF (jk.eq.i0100) THEN
1228            DO jj = 2,jpjm1
1229               DO ji = 2,jpim1
1230                  IF (tmask(ji,jj,jk) == 1) THEN
1231                     !! fast detritus N  flux at  100 m
1232                     trc2d(ji,jj,48) = ffastn(ji,jj)
1233                  ENDIF
1234               ENDDO
1235            ENDDO
1236         ENDIF
1237
1238         IF (jk.eq.i0200) THEN
1239            DO jj = 2,jpjm1
1240               DO ji = 2,jpim1
1241                  IF (tmask(ji,jj,jk) == 1) THEN
1242                     !! fast detritus N  flux at  200 m
1243                     trc2d(ji,jj,49) = ffastn(ji,jj)
1244                  ENDIF
1245               ENDDO
1246            ENDDO
1247         ENDIF
1248
1249         IF (jk.eq.i0500) THEN
1250            DO jj = 2,jpjm1
1251               DO ji = 2,jpim1
1252                  IF (tmask(ji,jj,jk) == 1) THEN
1253                     !! fast detritus N  flux at  500 m
1254                     trc2d(ji,jj,50) = ffastn(ji,jj)
1255                  ENDIF
1256               ENDDO
1257            ENDDO
1258         ENDIF
1259
1260         IF (jk.eq.i1000) THEN
1261            DO jj = 2,jpjm1
1262               DO ji = 2,jpim1
1263                  IF (tmask(ji,jj,jk) == 1) THEN
1264                     !! fast detritus N  flux at 1000 m
1265                     trc2d(ji,jj,51) = ffastn(ji,jj)
1266                  ENDIF
1267               ENDDO
1268            ENDDO
1269         ENDIF
1270
1271         IF (jk.eq.i0100) THEN
1272            DO jj = 2,jpjm1
1273               DO ji = 2,jpim1
1274                  IF (tmask(ji,jj,jk) == 1) THEN
1275                     !! N  regeneration to  100 m
1276                     trc2d(ji,jj,52) = fregenfast(ji,jj)
1277                  ENDIF
1278               ENDDO
1279            ENDDO
1280         ENDIF
1281
1282         IF (jk.eq.i0200) THEN
1283            DO jj = 2,jpjm1
1284               DO ji = 2,jpim1
1285                  IF (tmask(ji,jj,jk) == 1) THEN
1286                     !! N  regeneration to  200 m
1287                     trc2d(ji,jj,53) = fregenfast(ji,jj)
1288                  ENDIF
1289               ENDDO
1290            ENDDO
1291         ENDIF
1292
1293         IF (jk.eq.i0500) THEN
1294            DO jj = 2,jpjm1
1295               DO ji = 2,jpim1
1296                  IF (tmask(ji,jj,jk) == 1) THEN
1297                     !! N  regeneration to  500 m
1298                     trc2d(ji,jj,54) = fregenfast(ji,jj)
1299                  ENDIF
1300               ENDDO
1301            ENDDO
1302         ENDIF
1303
1304         IF (jk.eq.i1000) THEN
1305            DO jj = 2,jpjm1
1306               DO ji = 2,jpim1
1307                  IF (tmask(ji,jj,jk) == 1) THEN
1308                     !! N  regeneration to 1000 m
1309                     trc2d(ji,jj,55) = fregenfast(ji,jj)
1310                  ENDIF
1311               ENDDO
1312            ENDDO
1313         ENDIF
1314
1315         IF (jk.eq.i0100) THEN
1316            DO jj = 2,jpjm1
1317               DO ji = 2,jpim1
1318                  IF (tmask(ji,jj,jk) == 1) THEN
1319                     !! fast detritus Si flux at  100 m
1320                     trc2d(ji,jj,56) = ffastsi(ji,jj)
1321                  ENDIF
1322               ENDDO
1323            ENDDO
1324         ENDIF
1325
1326         IF (jk.eq.i0200) THEN
1327            DO jj = 2,jpjm1
1328               DO ji = 2,jpim1
1329                  IF (tmask(ji,jj,jk) == 1) THEN
1330                     !! fast detritus Si flux at  200 m
1331                     trc2d(ji,jj,57) = ffastsi(ji,jj)
1332                  ENDIF
1333               ENDDO
1334            ENDDO
1335         ENDIF
1336
1337         IF (jk.eq.i0500) THEN
1338            DO jj = 2,jpjm1
1339               DO ji = 2,jpim1
1340                  IF (tmask(ji,jj,jk) == 1) THEN
1341                     !! fast detritus Si flux at  500 m
1342                     trc2d(ji,jj,58) = ffastsi(ji,jj)
1343                  ENDIF
1344               ENDDO
1345            ENDDO
1346         ENDIF
1347
1348         IF (jk.eq.i1000) THEN
1349            DO jj = 2,jpjm1
1350               DO ji = 2,jpim1
1351                  IF (tmask(ji,jj,jk) == 1) THEN
1352                     !! fast detritus Si flux at 1000 m
1353                     trc2d(ji,jj,59) = ffastsi(ji,jj)
1354                  ENDIF
1355               ENDDO
1356            ENDDO
1357         ENDIF
1358
1359         IF (jk.eq.i0100) THEN
1360            DO jj = 2,jpjm1
1361               DO ji = 2,jpim1
1362                  IF (tmask(ji,jj,jk) == 1) THEN
1363                     !! Si regeneration to  100 m
1364                     trc2d(ji,jj,60) = fregenfastsi(ji,jj)
1365                  ENDIF
1366               ENDDO
1367            ENDDO
1368         ENDIF
1369
1370         IF (jk.eq.i0200) THEN
1371            DO jj = 2,jpjm1
1372               DO ji = 2,jpim1
1373                  IF (tmask(ji,jj,jk) == 1) THEN
1374                     !! Si regeneration to  200 m
1375                     trc2d(ji,jj,61) = fregenfastsi(ji,jj)
1376                  ENDIF
1377               ENDDO
1378            ENDDO
1379         ENDIF
1380
1381         IF (jk.eq.i0500) THEN
1382            DO jj = 2,jpjm1
1383               DO ji = 2,jpim1
1384                  IF (tmask(ji,jj,jk) == 1) THEN
1385                     !! Si regeneration to  500 m
1386                     trc2d(ji,jj,62) = fregenfastsi(ji,jj)
1387                  ENDIF
1388               ENDDO
1389            ENDDO
1390         ENDIF
1391
1392         IF (jk.eq.i1000) THEN
1393            DO jj = 2,jpjm1
1394               DO ji = 2,jpim1
1395                  IF (tmask(ji,jj,jk) == 1) THEN
1396                     !! Si regeneration to 1000 m
1397                     trc2d(ji,jj,63) = fregenfastsi(ji,jj)
1398                  ENDIF
1399               ENDDO
1400            ENDDO
1401         ENDIF
1402
1403         DO jj = 2,jpjm1
1404            DO ji = 2,jpim1
1405               IF (tmask(ji,jj,jk) == 1) THEN
1406                  !! sum of fast-sinking N  fluxes
1407                  trc2d(ji,jj,64) = trc2d(ji,jj,64) +                        &
1408                                    (freminn(ji,jj) * fse3t(ji,jj,jk))
1409                  !! sum of fast-sinking Si fluxes
1410                  trc2d(ji,jj,65) = trc2d(ji,jj,65) +                        &
1411                                    (freminsi(ji,jj) * fse3t(ji,jj,jk))
1412                  !! sum of fast-sinking Fe fluxes
1413                  trc2d(ji,jj,66) = trc2d(ji,jj,66) +                        &
1414                                    (freminfe(ji,jj) * fse3t(ji,jj,jk))
1415                  !! sum of fast-sinking C  fluxes
1416                  trc2d(ji,jj,67) = trc2d(ji,jj,67) +                        &
1417                                    (freminc(ji,jj) * fse3t(ji,jj,jk))
1418                  !! sum of fast-sinking Ca fluxes
1419                  trc2d(ji,jj,68) = trc2d(ji,jj,68) +                        &
1420                                    (freminca(ji,jj) * fse3t(ji,jj,jk))
1421               ENDIF
1422            ENDDO
1423         ENDDO
1424
1425
1426         if (jk.eq.mbathy(ji,jj)) then
1427            DO jj = 2,jpjm1
1428               DO ji = 2,jpim1
1429                  IF (tmask(ji,jj,jk) == 1) THEN
1430                     !! N  sedimentation flux
1431                     trc2d(ji,jj,69) = fsedn(ji,jj)
1432                     !! Si sedimentation flux
1433                     trc2d(ji,jj,70) = fsedsi(ji,jj)
1434                     !! Fe sedimentation flux
1435                     trc2d(ji,jj,71) = fsedfe(ji,jj)
1436                     !! C  sedimentation flux
1437                     trc2d(ji,jj,72) = fsedc(ji,jj)
1438                     !! Ca sedimentation flux
1439                     trc2d(ji,jj,73) = fsedca(ji,jj)
1440                  ENDIF
1441               ENDDO
1442            ENDDO
1443         endif
1444
1445         if (jk.eq.1) then
1446            DO jj = 2,jpjm1
1447               DO ji = 2,jpim1
1448                  IF (tmask(ji,jj,jk) == 1) THEN
1449                     trc2d(ji,jj,74) = qsr(ji,jj)
1450                     trc2d(ji,jj,75) = xpar(ji,jj,jk)
1451                     !! trc2d(ji,jj,75) = real(iters(ji,jj))
1452                  ENDIF
1453               ENDDO
1454            ENDDO
1455         endif
1456
1457         DO jj = 2,jpjm1
1458            DO ji = 2,jpim1
1459               IF (tmask(ji,jj,jk) == 1) THEN
1460                  !! diagnostic fields 76 to 80 calculated below
1461                  !! mixed layer non-diatom production
1462                  trc2d(ji,jj,81) = trc2d(ji,jj,81) + fprn_ml(ji,jj)
1463                  !! mixed layer     diatom production
1464                  trc2d(ji,jj,82) = trc2d(ji,jj,82) + fprd_ml(ji,jj)
1465               ENDIF
1466            ENDDO
1467         ENDDO
1468
1469# if defined key_gulf_finland
1470         if (jk.eq.1) then
1471            DO jj = 2,jpjm1
1472               DO ji = 2,jpim1
1473                  IF (tmask(ji,jj,jk) == 1) THEN
1474                     !! Gulf of Finland check
1475                     trc2d(ji,jj,83) = real(ibio_switch)
1476                  ENDIF
1477               ENDDO
1478            ENDDO
1479         endif
1480# else
1481         DO jj = 2,jpjm1
1482            DO ji = 2,jpim1
1483               IF (tmask(ji,jj,jk) == 1) THEN
1484                  !! calcite CCD depth
1485                  trc2d(ji,jj,83) = ocal_ccd(ji,jj)
1486               ENDIF
1487            ENDDO
1488         ENDDO
1489# endif
1490         DO jj = 2,jpjm1
1491            DO ji = 2,jpim1
1492               IF (tmask(ji,jj,jk) == 1) THEN
1493                  !! last model level above calcite CCD depth
1494                  trc2d(ji,jj,84) = fccd(ji,jj)
1495               ENDIF
1496            ENDDO
1497         ENDDO
1498
1499         IF (jk.eq.1) THEN
1500            DO jj = 2,jpjm1
1501               DO ji = 2,jpim1
1502                  IF (tmask(ji,jj,jk) == 1) THEN
1503                     !! surface "free" iron
1504                     trc2d(ji,jj,85) = xFree(ji,jj)
1505                  ENDIF
1506               ENDDO
1507            ENDDO
1508         ENDIF
1509
1510! I'm keeping this the same as before, but it looks like it should
1511! be i0100 and not i0200 - marc 8/5/17
1512         IF (jk.eq.i0200) THEN
1513            DO jj = 2,jpjm1
1514               DO ji = 2,jpim1
1515                  IF (tmask(ji,jj,jk) == 1) THEN
1516                     !! "free" iron at  100 m
1517                     trc2d(ji,jj,86) = xFree(ji,jj)
1518                  ENDIF
1519               ENDDO
1520            ENDDO
1521         ENDIF
1522
1523
1524         IF (jk.eq.i0200) THEN
1525            DO jj = 2,jpjm1
1526               DO ji = 2,jpim1
1527                  IF (tmask(ji,jj,jk) == 1) THEN
1528                     !! "free" iron at  200 m
1529                     trc2d(ji,jj,87) = xFree(ji,jj)
1530                  ENDIF
1531               ENDDO
1532            ENDDO
1533         ENDIF
1534
1535
1536         IF (jk.eq.i0500) THEN
1537            DO jj = 2,jpjm1
1538               DO ji = 2,jpim1
1539                  IF (tmask(ji,jj,jk) == 1) THEN
1540                     !! "free" iron at  500 m
1541                     trc2d(ji,jj,88) = xFree(ji,jj)
1542                  ENDIF
1543               ENDDO
1544            ENDDO
1545         ENDIF
1546
1547
1548         IF (jk.eq.i1000) THEN
1549            DO jj = 2,jpjm1
1550               DO ji = 2,jpim1
1551                  IF (tmask(ji,jj,jk) == 1) THEN
1552                     !! "free" iron at 1000 m
1553                     trc2d(ji,jj,89) = xFree(ji,jj)
1554                  ENDIF
1555               ENDDO
1556            ENDDO
1557         ENDIF
1558
1559
1560         IF (jk.eq.1) THEN
1561            DO jj = 2,jpjm1
1562               DO ji = 2,jpim1
1563                  IF (tmask(ji,jj,jk) == 1) THEN
1564                     !! AXY (27/06/12): extract "euphotic depth"
1565                     trc2d(ji,jj,90) = xze(ji,jj)
1566                  ENDIF
1567               ENDDO
1568            ENDDO
1569         ENDIF
1570
1571# if defined key_roam
1572         if (jk .eq. 1) then
1573            DO jj = 2,jpjm1
1574               DO ji = 2,jpim1
1575                  IF (tmask(ji,jj,jk) == 1) THEN
1576                     !! ROAM provisionally has access to a further 20 2D
1577                     !! diagnostics
1578                     !! surface wind
1579                     trc2d(ji,jj,91)  = trc2d(ji,jj,91)  + wndm(ji,jj)
1580                     !! atmospheric pCO2
1581                     trc2d(ji,jj,92)  = trc2d(ji,jj,92)  + f_pco2atm(ji,jj)
1582                     !! ocean pH
1583                     trc2d(ji,jj,93)  = trc2d(ji,jj,93)  + f_ph(ji,jj)
1584                     !! ocean pCO2
1585                     trc2d(ji,jj,94)  = trc2d(ji,jj,94)  + f_pco2w(ji,jj)
1586                     !! ocean H2CO3 conc.
1587                     trc2d(ji,jj,95)  = trc2d(ji,jj,95)  + f_h2co3(ji,jj)
1588                     !! ocean HCO3 conc.
1589                     trc2d(ji,jj,96)  = trc2d(ji,jj,96)  + f_hco3(ji,jj)
1590                     !! ocean CO3 conc.
1591                     trc2d(ji,jj,97)  = trc2d(ji,jj,97)  + f_co3(ji,jj)
1592                     !! air-sea CO2 flux
1593                     trc2d(ji,jj,98)  = trc2d(ji,jj,98)  + f_co2flux(ji,jj)
1594                  ENDIF
1595               ENDDO
1596           ENDDO
1597
1598            DO jj = 2,jpjm1
1599               DO ji = 2,jpim1
1600                  IF (tmask(ji,jj,jk) == 1) THEN
1601                     !! ocean omega calcite
1602                     trc2d(ji,jj,99)  = trc2d(ji,jj,99)  + f_omcal(ji,jj)
1603                     !! ocean omega aragonite
1604                     trc2d(ji,jj,100) = trc2d(ji,jj,100) + f_omarg(ji,jj)
1605                     !! ocean TDIC
1606                     trc2d(ji,jj,101) = trc2d(ji,jj,101) + f_TDIC(ji,jj)
1607                     !! ocean TALK
1608                     trc2d(ji,jj,102) = trc2d(ji,jj,102) + f_TALK(ji,jj)
1609                     !! surface kw660
1610                     trc2d(ji,jj,103) = trc2d(ji,jj,103) + f_kw660(ji,jj)
1611                     !! surface pressure
1612                     trc2d(ji,jj,104) = trc2d(ji,jj,104) + f_pp0(ji,jj)
1613                     !! air-sea O2 flux
1614                     trc2d(ji,jj,105) = trc2d(ji,jj,105) + f_o2flux(ji,jj)
1615                     !! ocean O2 saturation
1616                     trc2d(ji,jj,106) = trc2d(ji,jj,106) + f_o2sat(ji,jj)
1617                     !! depth calcite CCD
1618                     trc2d(ji,jj,107) = f2_ccd_cal(ji,jj)
1619                     !! depth aragonite CCD
1620                     trc2d(ji,jj,108) = f2_ccd_arg(ji,jj)
1621                  ENDIF
1622               ENDDO
1623            ENDDO
1624         endif
1625
1626         if (jk .eq. mbathy(ji,jj)) then
1627            DO jj = 2,jpjm1
1628               DO ji = 2,jpim1
1629                  IF (tmask(ji,jj,jk) == 1) THEN
1630                     !! seafloor omega calcite
1631                     trc2d(ji,jj,109) = f3_omcal(ji,jj,jk)
1632                     !! seafloor omega aragonite
1633                     trc2d(ji,jj,110) = f3_omarg(ji,jj,jk)
1634                  ENDIF
1635               ENDDO
1636            ENDDO
1637         endif
1638
1639         if (jk.eq.i0100) then
1640            DO jj = 2,jpjm1
1641               DO ji = 2,jpim1
1642                  IF (tmask(ji,jj,jk) == 1) THEN
1643                     !! diagnostic fields 111 to 117 calculated below
1644                     !! rain ratio at  100 m
1645                     trc2d(ji,jj,118) =                                      &
1646                                   ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall)
1647                  ENDIF
1648               ENDDO
1649            ENDDO
1650         endif
1651
1652         if (jk.eq.i0500) then
1653            DO jj = 2,jpjm1
1654               DO ji = 2,jpim1
1655                  IF (tmask(ji,jj,jk) == 1) THEN
1656                     !! rain ratio at  500 m
1657                     trc2d(ji,jj,119) =                                      &
1658                                   ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall)
1659                  ENDIF
1660               ENDDO
1661            ENDDO
1662         endif
1663
1664         if (jk.eq.i1000) then
1665            DO jj = 2,jpjm1
1666               DO ji = 2,jpim1
1667                  IF (tmask(ji,jj,jk) == 1) THEN
1668                     !! rain ratio at 1000 m
1669                     trc2d(ji,jj,120) =                                      &
1670                                   ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall)
1671                  ENDIF
1672               ENDDO
1673            ENDDO
1674         endif
1675
1676         if (jk.eq.mbathy(ji,jj)) then
1677            DO jj = 2,jpjm1
1678               DO ji = 2,jpim1
1679                  IF (tmask(ji,jj,jk) == 1) THEN
1680                     !! AXY (18/01/12): benthic flux diagnostics
1681                     trc2d(ji,jj,121) = f_sbenin_n(ji,jj)  + f_fbenin_n(ji,jj)
1682                     trc2d(ji,jj,122) = f_sbenin_fe(ji,jj) + f_fbenin_fe(ji,jj)
1683                     trc2d(ji,jj,123) = f_sbenin_c(ji,jj)  + f_fbenin_c(ji,jj)
1684                     trc2d(ji,jj,124) = f_fbenin_si(ji,jj)
1685                     trc2d(ji,jj,125) = f_fbenin_ca(ji,jj)
1686                     trc2d(ji,jj,126) = f_benout_n(ji,jj)
1687                     trc2d(ji,jj,127) = f_benout_fe(ji,jj)
1688                     trc2d(ji,jj,128) = f_benout_c(ji,jj)
1689                     trc2d(ji,jj,129) = f_benout_si(ji,jj)
1690                     trc2d(ji,jj,130) = f_benout_ca(ji,jj)
1691                  ENDIF
1692               ENDDO
1693            ENDDO
1694         endif
1695
1696         DO jj = 2,jpjm1
1697            DO ji = 2,jpim1
1698               IF (tmask(ji,jj,jk) == 1) THEN
1699                  !! diagnostics fields 131 to 135 calculated below
1700                  trc2d(ji,jj,136) = f_runoff(ji,jj)
1701                  !! AXY (19/07/12): amended to allow for riverine
1702                  !! nutrient addition below surface
1703                  trc2d(ji,jj,137) = trc2d(ji,jj,137) +                      &
1704                                     (f_riv_loc_n(ji,jj) * fse3t(ji,jj,jk))
1705                  trc2d(ji,jj,138) = trc2d(ji,jj,138) +                      &
1706                                     (f_riv_loc_si(ji,jj) * fse3t(ji,jj,jk))
1707                  trc2d(ji,jj,139) = trc2d(ji,jj,139) +                      &
1708                                     (f_riv_loc_c(ji,jj) * fse3t(ji,jj,jk))
1709                  trc2d(ji,jj,140) = trc2d(ji,jj,140) +                      &
1710                                     (f_riv_loc_alk(ji,jj) * fse3t(ji,jj,jk))
1711                  !! slow sinking detritus C production
1712                  trc2d(ji,jj,141) = trc2d(ji,jj,141) +                      &
1713                                     (fslowc(ji,jj)  * fse3t(ji,jj,jk))
1714               ENDIF
1715            ENDDO
1716         ENDDO
1717
1718         if (jk.eq.i0100) then
1719            DO jj = 2,jpjm1
1720               DO ji = 2,jpim1
1721                  IF (tmask(ji,jj,jk) == 1) THEN
1722                     !! slow detritus flux at  100 m
1723                     trc2d(ji,jj,142) = fslowcflux(ji,jj)
1724                  ENDIF
1725               ENDDO
1726            ENDDO
1727         endif
1728
1729         if (jk.eq.i0200) then
1730            DO jj = 2,jpjm1
1731               DO ji = 2,jpim1
1732                  IF (tmask(ji,jj,jk) == 1) THEN
1733                     !! slow detritus flux at  200 m
1734                     trc2d(ji,jj,143) = fslowcflux(ji,jj)
1735                  ENDIF
1736               ENDDO
1737            ENDDO
1738         endif
1739
1740
1741         if (jk.eq.i0500) then
1742            DO jj = 2,jpjm1
1743               DO ji = 2,jpim1
1744                  IF (tmask(ji,jj,jk) == 1) THEN
1745                     !! slow detritus flux at  500 m
1746                     trc2d(ji,jj,144) = fslowcflux(ji,jj)
1747                  ENDIF
1748               ENDDO
1749            ENDDO
1750         endif
1751
1752
1753         if (jk.eq.i1000) then
1754            DO jj = 2,jpjm1
1755               DO ji = 2,jpim1
1756                  IF (tmask(ji,jj,jk) == 1) THEN
1757                     !! slow detritus flux at 1000 m
1758                     trc2d(ji,jj,145) = fslowcflux(ji,jj)
1759                  ENDIF
1760               ENDDO
1761            ENDDO
1762         endif
1763
1764         DO jj = 2,jpjm1
1765            DO ji = 2,jpim1
1766               IF (tmask(ji,jj,jk) == 1) THEN
1767                  !! carbon     inventory
1768                  trc2d(ji,jj,146)  = trc2d(ji,jj,146)  + ftot_c(ji,jj)
1769                  !! alkalinity inventory
1770                  trc2d(ji,jj,147)  = trc2d(ji,jj,147)  + ftot_a(ji,jj)
1771                  !! oxygen     inventory
1772                  trc2d(ji,jj,148)  = trc2d(ji,jj,148)  + ftot_o2(ji,jj)
1773               ENDIF
1774            ENDDO
1775         ENDDO
1776
1777         if (jk.eq.mbathy(ji,jj)) then
1778            DO jj = 2,jpjm1
1779               DO ji = 2,jpim1
1780                  IF (tmask(ji,jj,jk) == 1) THEN
1781                     trc2d(ji,jj,149) = f_benout_lyso_ca(ji,jj)
1782                  ENDIF
1783               ENDDO
1784            ENDDO
1785         endif
1786
1787         DO jj = 2,jpjm1
1788            DO ji = 2,jpim1
1789               IF (tmask(ji,jj,jk) == 1) THEN
1790                  !! community respiration
1791                  trc2d(ji,jj,150) = fcomm_resp(ji,jj) * fse3t(ji,jj,jk)
1792               ENDIF
1793            ENDDO
1794         ENDDO
1795
1796         DO jj = 2,jpjm1
1797            DO ji = 2,jpim1
1798               IF (tmask(ji,jj,jk) == 1) THEN
1799        !!
1800        !! AXY (14/02/14): a Valentines Day gift to BASIN - a
1801                  !!                 shedload of new diagnostics that
1802                  !!                 they'll most likely never need!
1803                  !!                 (actually, as with all such gifts,
1804                  !!                 I'm giving them some things I'd like
1805                  !!                 myself!)
1806                  !!
1807                  !! ------------------------------------------------------
1808                  !! linear losses
1809                  !! non-diatom
1810                  trc2d(ji,jj,151) = trc2d(ji,jj,151) +                      &
1811                                     (fdpn2(ji,jj) * fse3t(ji,jj,jk))
1812                  !! diatom
1813                  trc2d(ji,jj,152) = trc2d(ji,jj,152) +                      &
1814                                     (fdpd2(ji,jj)  * fse3t(ji,jj,jk))
1815                  !! microzooplankton
1816                  trc2d(ji,jj,153) = trc2d(ji,jj,153) +                      &
1817                                     (fdzmi2(ji,jj) * fse3t(ji,jj,jk))
1818                  !! mesozooplankton
1819                  trc2d(ji,jj,154) = trc2d(ji,jj,154) +                      &
1820                                     (fdzme2(ji,jj) * fse3t(ji,jj,jk))
1821               ENDIF
1822            ENDDO
1823         ENDDO
1824
1825         DO jj = 2,jpjm1
1826            DO ji = 2,jpim1
1827               IF (tmask(ji,jj,jk) == 1) THEN
1828                  !! ------------------------------------------------------
1829                  !! microzooplankton grazing
1830                  !! microzooplankton messy -> N
1831                  trc2d(ji,jj,155) = trc2d(ji,jj,155) +                      &
1832                                     (xphi * (fgmipn(ji,jj) +                &
1833                                              fgmid(ji,jj)) * fse3t(ji,jj,jk))
1834                  !! microzooplankton messy -> D
1835                  trc2d(ji,jj,156) = trc2d(ji,jj,156) +                      &
1836                                     ((1. - xbetan) * finmi(ji,jj) *         &
1837                                      fse3t(ji,jj,jk))
1838                  !! microzooplankton messy -> DIC
1839                  trc2d(ji,jj,157) = trc2d(ji,jj,157) +                      &
1840                                     (xphi * ((xthetapn * fgmipn(ji,jj)) +   &
1841                                              fgmidc(ji,jj)) *               &
1842                                      fse3t(ji,jj,jk))
1843                  !! microzooplankton messy -> Dc
1844                  trc2d(ji,jj,158) = trc2d(ji,jj,158) +                      &
1845                                     ((1. - xbetac) * ficmi(ji,jj) *         &
1846                                      fse3t(ji,jj,jk))
1847                  !! microzooplankton excretion
1848                  trc2d(ji,jj,159) = trc2d(ji,jj,159) +                      &
1849                                     (fmiexcr(ji,jj) * fse3t(ji,jj,jk))
1850                  !! microzooplankton respiration
1851                  trc2d(ji,jj,160) = trc2d(ji,jj,160) +                      &
1852                                     (fmiresp(ji,jj) * fse3t(ji,jj,jk))
1853                  !! microzooplankton growth
1854                  trc2d(ji,jj,161) = trc2d(ji,jj,161) +                      &
1855                                     (fmigrow(ji,jj) * fse3t(ji,jj,jk))
1856               ENDIF
1857            ENDDO
1858         ENDDO
1859
1860         DO jj = 2,jpjm1
1861            DO ji = 2,jpim1
1862               IF (tmask(ji,jj,jk) == 1) THEN
1863                  !! ------------------------------------------------------
1864                  !! mesozooplankton grazing
1865                  !! mesozooplankton messy -> N
1866                  trc2d(ji,jj,162) = trc2d(ji,jj,162) +                      &
1867                                     (xphi *                                 &
1868                                      (fgmepn(ji,jj) + fgmepd(ji,jj) +       &
1869                                       fgmezmi(ji,jj) + fgmed(ji,jj)) *      &
1870                                      fse3t(ji,jj,jk))
1871                  !! mesozooplankton messy -> D
1872                  trc2d(ji,jj,163) = trc2d(ji,jj,163) +                      &
1873                                     ((1. - xbetan) * finme(ji,jj) *         &
1874                                      fse3t(ji,jj,jk))
1875                  !! mesozooplankton messy -> DIC
1876                  trc2d(ji,jj,164) = trc2d(ji,jj,164) +                      &
1877                                     (xphi *                                 &
1878                                      ((xthetapn * fgmepn(ji,jj)) +          &
1879                                       (xthetapd * fgmepd(ji,jj)) +          &
1880                                       (xthetazmi * fgmezmi(ji,jj)) +        &
1881                                      fgmedc(ji,jj)) * fse3t(ji,jj,jk))
1882                  !! mesozooplankton messy -> Dc
1883                  trc2d(ji,jj,165) = trc2d(ji,jj,165) +                      &
1884                                     ((1. - xbetac) * ficme(ji,jj) *         &
1885                                      fse3t(ji,jj,jk))
1886                  !! mesozooplankton excretion
1887                  trc2d(ji,jj,166) = trc2d(ji,jj,166) +                      &
1888                                     (fmeexcr(ji,jj) * fse3t(ji,jj,jk))
1889                  !! mesozooplankton respiration
1890                  trc2d(ji,jj,167) = trc2d(ji,jj,167) +                      &
1891                                     (fmeresp(ji,jj) * fse3t(ji,jj,jk))
1892                  !! mesozooplankton growth
1893                  trc2d(ji,jj,168) = trc2d(ji,jj,168) +                      &
1894                                     (fmegrow(ji,jj) * fse3t(ji,jj,jk))
1895               ENDIF
1896            ENDDO
1897         ENDDO
1898
1899         DO jj = 2,jpjm1
1900            DO ji = 2,jpim1
1901               IF (tmask(ji,jj,jk) == 1) THEN
1902                  !! ------------------------------------------------------
1903                  !! miscellaneous
1904                  !! detrital C remineralisation
1905                  trc2d(ji,jj,169) = trc2d(ji,jj,169) +                      &
1906                                     (fddc(ji,jj) * fse3t(ji,jj,jk))
1907                  !! microzoo grazing on detrital carbon
1908                  trc2d(ji,jj,170) = trc2d(ji,jj,170) +                      &
1909                                     (fgmidc(ji,jj)  * fse3t(ji,jj,jk))
1910                  !! mesozoo  grazing on detrital carbon
1911                  trc2d(ji,jj,171) = trc2d(ji,jj,171) +                      &
1912                                     (fgmedc(ji,jj)  * fse3t(ji,jj,jk))
1913                  !!
1914               ENDIF
1915            ENDDO
1916         ENDDO
1917
1918         !! ------------------------------------------------------
1919    !!
1920         !! AXY (23/10/14): extract primary production related
1921         !!                 surface fields to deal with diel
1922         !!                 cycle issues; hijacking BASIN 150m
1923         !!                 diagnostics to do so (see commented
1924         !!                 out diagnostics below this section)
1925         !!
1926         !! extract relevant BASIN fields at 150m
1927         if (jk .eq. i0150) then
1928            DO jj = 2,jpjm1
1929               DO ji = 2,jpim1
1930                  IF (tmask(ji,jj,jk) == 1) THEN
1931                     !! Pn PP
1932                     trc2d(ji,jj,172) = trc2d(ji,jj,4)
1933                     !! Pn linear loss
1934                     trc2d(ji,jj,173) = trc2d(ji,jj,151)
1935                     !! Pn non-linear loss
1936                     trc2d(ji,jj,174) = trc2d(ji,jj,5)
1937                     !! Pn grazing to Zmi
1938                     trc2d(ji,jj,175) = trc2d(ji,jj,11)
1939                     !! Pn grazing to Zme
1940                     trc2d(ji,jj,176) = trc2d(ji,jj,14)
1941                     !! Pd PP
1942                     trc2d(ji,jj,177) = trc2d(ji,jj,6)
1943                     !! Pd linear loss
1944                     trc2d(ji,jj,178) = trc2d(ji,jj,152)
1945                     !! Pd non-linear loss
1946                     trc2d(ji,jj,179) = trc2d(ji,jj,7)
1947                     !! Pd grazing to Zme
1948                     trc2d(ji,jj,180) = trc2d(ji,jj,15)
1949                     !! Zmi grazing on D
1950                     trc2d(ji,jj,181) = trc2d(ji,jj,12)
1951                     !! Zmi grazing on Dc
1952                     trc2d(ji,jj,182) = trc2d(ji,jj,170)
1953                     !! Zmi messy feeding loss to N
1954                     trc2d(ji,jj,183) = trc2d(ji,jj,155)
1955                     !! Zmi messy feeding loss to D
1956                     trc2d(ji,jj,184) = trc2d(ji,jj,156)
1957                     !! Zmi messy feeding loss to DIC
1958                     trc2d(ji,jj,185) = trc2d(ji,jj,157)
1959                     !! Zmi messy feeding loss to Dc
1960                     trc2d(ji,jj,186) = trc2d(ji,jj,158)
1961                     !! Zmi excretion
1962                     trc2d(ji,jj,187) = trc2d(ji,jj,159)
1963                     !! Zmi respiration
1964                     trc2d(ji,jj,188) = trc2d(ji,jj,160)
1965                     !! Zmi growth
1966                     trc2d(ji,jj,189) = trc2d(ji,jj,161)
1967                     !! Zmi linear loss
1968                     trc2d(ji,jj,190) = trc2d(ji,jj,153)
1969                     !! Zmi non-linear loss
1970                     trc2d(ji,jj,191) = trc2d(ji,jj,13)
1971                     !! Zmi grazing to Zme
1972                     trc2d(ji,jj,192) = trc2d(ji,jj,16)
1973                     !! Zme grazing on D
1974                     trc2d(ji,jj,193) = trc2d(ji,jj,17)
1975                     !! Zme grazing on Dc
1976                     trc2d(ji,jj,194) = trc2d(ji,jj,171)
1977                     !! Zme messy feeding loss to N
1978                     trc2d(ji,jj,195) = trc2d(ji,jj,162)
1979                     !! Zme messy feeding loss to D
1980                     trc2d(ji,jj,196) = trc2d(ji,jj,163)
1981                     !! Zme messy feeding loss to DIC
1982                     trc2d(ji,jj,197) = trc2d(ji,jj,164)
1983                     !! Zme messy feeding loss to Dc
1984                     trc2d(ji,jj,198) = trc2d(ji,jj,165)
1985                     !! Zme excretion
1986                     trc2d(ji,jj,199) = trc2d(ji,jj,166)
1987                     !! Zme respiration
1988                     trc2d(ji,jj,200) = trc2d(ji,jj,167)
1989                     !! Zme growth
1990                     trc2d(ji,jj,201) = trc2d(ji,jj,168)
1991                     !! Zme linear loss
1992                     trc2d(ji,jj,202) = trc2d(ji,jj,154)
1993                     !! Zme non-linear loss
1994                     trc2d(ji,jj,203) = trc2d(ji,jj,18)
1995                     !! Slow detritus production, N
1996                     trc2d(ji,jj,204) = trc2d(ji,jj,20)
1997                     !! Slow detritus remineralisation, N
1998                     trc2d(ji,jj,205) = trc2d(ji,jj,21)
1999                     !! Slow detritus production, C
2000                     trc2d(ji,jj,206) = trc2d(ji,jj,141)
2001                     !! Slow detritus remineralisation, C
2002                     trc2d(ji,jj,207) = trc2d(ji,jj,169)
2003                     !! Fast detritus production, N
2004                     trc2d(ji,jj,208) = trc2d(ji,jj,43)
2005                     !! Fast detritus remineralisation, N
2006                     trc2d(ji,jj,209) = trc2d(ji,jj,21)
2007                     !! Fast detritus production, C
2008                     trc2d(ji,jj,210) = trc2d(ji,jj,64)
2009                     !! Fast detritus remineralisation, C
2010                     trc2d(ji,jj,211) = trc2d(ji,jj,67)
2011                     !! Community respiration
2012                     trc2d(ji,jj,212) = trc2d(ji,jj,150)
2013                     !! Slow detritus N flux at 150 m
2014                     trc2d(ji,jj,213) = fslownflux(ji,jj)
2015                     !! Slow detritus C flux at 150 m
2016                     trc2d(ji,jj,214) = fslowcflux(ji,jj)
2017                     !! Fast detritus N flux at 150 m
2018                     trc2d(ji,jj,215) = ffastn(ji,jj)
2019                     !! Fast detritus C flux at 150 m
2020                     trc2d(ji,jj,216) = ffastc(ji,jj)
2021                  ENDIF
2022               ENDDO
2023            ENDDO
2024         endif
2025
2026         !!
2027         !! Jpalm (11-08-2014)
2028         !! Add UKESM1 diagnoatics
2029         !!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
2030         if ((jk .eq. 1) .and.( jdms.eq.1)) then
2031            DO jj = 2,jpjm1
2032               DO ji = 2,jpim1
2033                  IF (tmask(ji,jj,jk) == 1) THEN
2034                     !! DMS surface concentration
2035                     trc2d(ji,jj,221) = dms_surf(ji,jj)
2036                     !! AXY (13/03/15): add in other DMS estimates
2037                     !! DMS surface concentration
2038                     trc2d(ji,jj,222) = dms_andr(ji,jj)
2039                     !! DMS surface concentration
2040                     trc2d(ji,jj,223) = dms_simo(ji,jj)
2041                     !! DMS surface concentration
2042                     trc2d(ji,jj,224) = dms_aran(ji,jj)
2043                     !! DMS surface concentration
2044                     trc2d(ji,jj,225) = dms_hall(ji,jj)
2045                  ENDIF
2046               ENDDO
2047            ENDDO
2048         endif
2049# endif
2050
2051         DO jj = 2,jpjm1
2052            DO ji = 2,jpim1
2053               IF (tmask(ji,jj,jk) == 1) THEN
2054                  !! other possible future diagnostics include:
2055                  !!   - integrated tracer values (esp. biological)
2056                  !!   - mixed layer tracer values
2057                  !!   - sub-surface chlorophyll maxima (plus depth)
2058                  !!   - different mixed layer depth criteria (T, sigma,
2059                  !!     var. sigma)
2060                  !!-------------------------------------------------------
2061                  !! Prepare 3D diagnostics
2062                  !!-------------------------------------------------------
2063                  !!
2064                  !! primary production 
2065                  trc3d(ji,jj,jk,1)  = ((fprn(ji,jj) + fprd(ji,jj)) *        &
2066                                        zphn(ji,jj))
2067                  !! detrital flux
2068                  trc3d(ji,jj,jk,2)  = fslownflux(ji,jj) + ffastn(ji,jj)
2069                  !! remineralisation
2070                  trc3d(ji,jj,jk,3)  = fregen(ji,jj) +                       &
2071                                       (freminn(ji,jj) * fse3t(ji,jj,jk))
2072               ENDIF
2073            ENDDO
2074         ENDDO
2075# if defined key_roam
2076         DO jj = 2,jpjm1
2077            DO ji = 2,jpim1
2078               IF (tmask(ji,jj,jk) == 1) THEN
2079                  !! pH
2080                  trc3d(ji,jj,jk,4)  = f3_pH(ji,jj,jk)
2081                  !! omega calcite
2082                  trc3d(ji,jj,jk,5)  = f3_omcal(ji,jj,jk)
2083               ENDIF
2084            ENDDO
2085         ENDDO
2086# else
2087         DO jj = 2,jpjm1
2088            DO ji = 2,jpim1
2089               IF (tmask(ji,jj,jk) == 1) THEN
2090                  !! fast Si flux
2091                  trc3d(ji,jj,jk,4)  = ffastsi(ji,jj)
2092               ENDIF
2093            ENDDO
2094         ENDDO
2095# endif
2096
2097      ENDIF   ! end of ln_diatrc option
2098
2099   END SUBROUTINE bio_medusa_diag
2100
2101#else
2102   !!======================================================================
2103   !!  Dummy module :                                   No MEDUSA bio-model
2104   !!======================================================================
2105CONTAINS
2106   SUBROUTINE bio_medusa_diag( )                    ! Empty routine
2107      WRITE(*,*) 'bio_medusa_diag: You should not have seen this print! error?'
2108   END SUBROUTINE bio_medusa_diag
2109#endif 
2110
2111   !!======================================================================
2112END MODULE bio_medusa_diag_mod
Note: See TracBrowser for help on using the repository browser.