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_med_diag_trc.F90 in branches/NERC/dev_r5518_GO6_split_trcbiomedusa/NEMOGCM/NEMO/TOP_SRC/MEDUSA – NEMO

source: branches/NERC/dev_r5518_GO6_split_trcbiomedusa/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_med_diag_trc.F90 @ 8395

Last change on this file since 8395 was 8395, checked in by jpalmier, 7 years ago

JPALM -- GMED #339 - split trcbio_medusa only

File size: 45.4 KB
Line 
1MODULE bio_med_diag_trc_mod
2   !!======================================================================
3   !!                         ***  MODULE bio_med_diag_trc_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_med_diag_trc        ! Called in bio_medusa_diag.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_med_diag_trc( jk )
28      !!-------------------------------------------------------------------
29      !!                     ***  ROUTINE bio_med_diag_trc  ***
30      !! Calculates diagnostics without using iom_use
31      !!-------------------------------------------------------------------
32      USE bio_medusa_mod
33      USE dom_oce,           ONLY: e3t_0, e3t_n, mbathy, tmask
34      USE in_out_manager,    ONLY: lwp, numout
35      USE par_oce,           ONLY: jpim1, jpjm1
36      USE phycst,            ONLY: rsmall
37      USE sbc_oce,           ONLY: qsr, wndm
38      USE sms_medusa,        ONLY: f2_ccd_arg, f2_ccd_cal,               &
39                                   f3_omarg, f3_omcal, f3_pH,            &
40                                   i0100, i0150, i0200, i0500, i1000,    &
41                                   jdms, ocal_ccd,                       &
42                                   xbetac, xbetan, xpar, xphi,           &
43                                   xthetapd, xthetapn, xthetazme,        &
44                                   xthetazmi, xze
45      USE trc,               ONLY: med_diag, trc2d, trc3d 
46
47   !!* Substitution
48#  include "domzgr_substitute.h90"
49
50      !! level
51      INTEGER, INTENT( in ) :: jk
52
53      !! Loop avariables
54      INTEGER :: ji, jj, jn
55
56      !!
57      !! ** Without using iom_use
58#   if defined key_debug_medusa
59      IF (lwp) write (numout,*) 'trc_bio_medusa: diag in ij-jj-jk ln_diatrc'
60      CALL flush(numout)
61#   endif
62      DO jj = 2,jpjm1
63         DO ji = 2,jpim1
64            IF (tmask(ji,jj,jk) == 1) then
65               !!-------------------------------------------------------
66               !! Prepare 2D diagnostics
67               !!-------------------------------------------------------
68               !!
69               !! if ((kt / 240*240).eq.kt) then
70               !!    IF (lwp) write (*,*) '*******!MEDUSA DIAADD!*******',kt
71               !! endif     
72               !! nitrogen inventory
73               trc2d(ji,jj,1)  =  ftot_n(ji,jj)
74               !! silicon  inventory
75               trc2d(ji,jj,2)  =  ftot_si(ji,jj)
76               !! iron     inventory
77               trc2d(ji,jj,3)  =  ftot_fe(ji,jj)
78            ENDIF
79         ENDDO
80      ENDDO
81
82      DO jj = 2,jpjm1
83         DO ji = 2,jpim1
84            IF (tmask(ji,jj,jk) == 1) THEN
85               !! non-diatom production
86               trc2d(ji,jj,4)  = trc2d(ji,jj,4)  +                           &
87                                 (fprn(ji,jj)  * zphn(ji,jj) *               &
88                                  fse3t(ji,jj,jk))
89               !! non-diatom non-grazing losses
90               trc2d(ji,jj,5)  = trc2d(ji,jj,5)  +                           &
91                                 (fdpn(ji,jj) * fse3t(ji,jj,jk))
92               !! diatom production
93               trc2d(ji,jj,6)  = trc2d(ji,jj,6)  +                           &
94                                 (fprd(ji,jj) * zphd(ji,jj) *                &
95                                  fse3t(ji,jj,jk))
96               !! diatom non-grazing losses
97               !! diagnostic field  8 is (ostensibly) supplied by trcsed.F
98               trc2d(ji,jj,7)  = trc2d(ji,jj,7)  +                           &
99                                 (fdpd(ji,jj) * fse3t(ji,jj,jk))
100               !! diatom silicon production
101               trc2d(ji,jj,9)  = trc2d(ji,jj,9)  +                           &
102                                 (fprds(ji,jj) * zpds(ji,jj) *               &
103                                  fse3t(ji,jj,jk))
104               !! diatom silicon dissolution
105               trc2d(ji,jj,10) = trc2d(ji,jj,10) +                           &
106                                 (fsdiss(ji,jj)  * fse3t(ji,jj,jk))
107            ENDIF
108         ENDDO
109      ENDDO
110
111      DO jj = 2,jpjm1
112         DO ji = 2,jpim1
113            IF (tmask(ji,jj,jk) == 1) THEN
114               !! microzoo grazing on non-diatoms
115               trc2d(ji,jj,11) = trc2d(ji,jj,11) +                           &
116                                 (fgmipn(ji,jj)  * fse3t(ji,jj,jk))
117               !! microzoo grazing on detrital nitrogen
118               trc2d(ji,jj,12) = trc2d(ji,jj,12) +                           &
119                                 (fgmid(ji,jj) * fse3t(ji,jj,jk))
120               !! microzoo non-grazing losses
121               trc2d(ji,jj,13) = trc2d(ji,jj,13) +                           &
122                                 (fdzmi(ji,jj) * fse3t(ji,jj,jk))
123            ENDIF
124         ENDDO
125      ENDDO
126
127      DO jj = 2,jpjm1
128         DO ji = 2,jpim1
129            IF (tmask(ji,jj,jk) == 1) THEN
130               !! mesozoo  grazing on non-diatoms
131               trc2d(ji,jj,14) = trc2d(ji,jj,14) +                           &
132                                 (fgmepn(ji,jj)  * fse3t(ji,jj,jk))
133               !! mesozoo  grazing on diatoms
134               trc2d(ji,jj,15) = trc2d(ji,jj,15) +                           &
135                                 (fgmepd(ji,jj)  * fse3t(ji,jj,jk))
136               !! mesozoo  grazing on microzoo
137               trc2d(ji,jj,16) = trc2d(ji,jj,16) +                           &
138                                 (fgmezmi(ji,jj) * fse3t(ji,jj,jk))
139               !! mesozoo  grazing on detrital nitrogen
140               trc2d(ji,jj,17) = trc2d(ji,jj,17) +                           &
141                                 (fgmed(ji,jj) * fse3t(ji,jj,jk))
142               !! mesozoo  non-grazing losses
143               trc2d(ji,jj,18) = trc2d(ji,jj,18) +                           &
144                                 (fdzme(ji,jj)   * fse3t(ji,jj,jk))
145            ENDIF
146         ENDDO
147      ENDDO
148
149      DO jj = 2,jpjm1
150         DO ji = 2,jpim1
151            IF (tmask(ji,jj,jk) == 1) THEN
152               !! diagnostic field 19 is (ostensibly) supplied by trcexp.F
153               !! slow sinking detritus N production
154               trc2d(ji,jj,20) = trc2d(ji,jj,20) +                           &
155                                 (fslown(ji,jj) * fse3t(ji,jj,jk))
156               !! detrital remineralisation
157               trc2d(ji,jj,21) = trc2d(ji,jj,21) +                           &
158                                 (fdd(ji,jj) * fse3t(ji,jj,jk))
159               !! aeolian  iron addition
160               trc2d(ji,jj,22) = trc2d(ji,jj,22) +                           &
161                                 (ffetop(ji,jj) * fse3t(ji,jj,jk))
162               !! seafloor iron addition
163               trc2d(ji,jj,23) = trc2d(ji,jj,23) +                           &
164                                 (ffebot(ji,jj) * fse3t(ji,jj,jk))
165               !! "free" iron scavenging
166               trc2d(ji,jj,24) = trc2d(ji,jj,24) +                           &
167                                 (ffescav(ji,jj) * fse3t(ji,jj,jk))
168            ENDIF
169         ENDDO
170      ENDDO
171
172      DO jj = 2,jpjm1
173         DO ji = 2,jpim1
174            IF (tmask(ji,jj,jk) == 1) THEN
175               !! non-diatom J  limitation term
176               trc2d(ji,jj,25) = trc2d(ji,jj,25) +                           &
177                                 (fjlim_pn(ji,jj) * zphn(ji,jj) *            &
178                                  fse3t(ji,jj,jk))
179               !! non-diatom N  limitation term
180               trc2d(ji,jj,26) = trc2d(ji,jj,26) +                           &
181                                 (fnln(ji,jj) * zphn(ji,jj) *                &
182                                  fse3t(ji,jj,jk))
183               !! non-diatom Fe limitation term
184               trc2d(ji,jj,27) = trc2d(ji,jj,27) +                           &
185                                 (ffln2(ji,jj) * zphn(ji,jj) *               &
186                                  fse3t(ji,jj,jk))
187               !! diatom     J  limitation term
188               trc2d(ji,jj,28) = trc2d(ji,jj,28) +                           &
189                                 (fjlim_pd(ji,jj) * zphd(ji,jj) *            &
190                                  fse3t(ji,jj,jk))
191               !! diatom     N  limitation term
192               trc2d(ji,jj,29) = trc2d(ji,jj,29) +                           &
193                                 (fnld(ji,jj) * zphd(ji,jj) *                &
194                                  fse3t(ji,jj,jk))
195               !! diatom     Fe limitation term
196               trc2d(ji,jj,30) = trc2d(ji,jj,30) +                           &
197                                 (ffld(ji,jj) * zphd(ji,jj) *                &
198                                  fse3t(ji,jj,jk))
199               !! diatom     Si limitation term
200               trc2d(ji,jj,31) = trc2d(ji,jj,31) +                           &
201                                 (fsld2(ji,jj) * zphd(ji,jj) *               &
202                                  fse3t(ji,jj,jk))
203               !! diatom     Si uptake limitation term
204               trc2d(ji,jj,32) = trc2d(ji,jj,32) +                           &
205                                 (fsld(ji,jj) * zphd(ji,jj) *                &
206                                  fse3t(ji,jj,jk))
207            ENDIF
208         ENDDO
209      ENDDO
210
211      IF (jk.eq.i0100) THEN
212         DO jj = 2,jpjm1
213            DO ji = 2,jpim1
214               IF (tmask(ji,jj,jk) == 1) THEN
215                  !! slow detritus flux at  100 m
216                  trc2d(ji,jj,33) = fslownflux(ji,jj)
217               ENDIF
218            ENDDO
219         ENDDO
220      ENDIF
221
222      IF (jk.eq.i0200) THEN
223         DO jj = 2,jpjm1
224            DO ji = 2,jpim1
225               IF (tmask(ji,jj,jk) == 1) THEN
226                  !! slow detritus flux at  200 m
227                  trc2d(ji,jj,34) = fslownflux(ji,jj)
228               ENDIF
229            ENDDO
230         ENDDO
231      ENDIF
232
233      IF (jk.eq.i0500) THEN
234         DO jj = 2,jpjm1
235            DO ji = 2,jpim1
236               IF (tmask(ji,jj,jk) == 1) THEN
237                  !! slow detritus flux at  500 m
238                  trc2d(ji,jj,35) = fslownflux(ji,jj)
239               ENDIF
240            ENDDO
241         ENDDO
242      ENDIF
243
244      IF (jk.eq.i1000) THEN
245         DO jj = 2,jpjm1
246            DO ji = 2,jpim1
247               IF (tmask(ji,jj,jk) == 1) THEN
248                  !! slow detritus flux at 1000 m
249                  trc2d(ji,jj,36) = fslownflux(ji,jj)
250               ENDIF
251            ENDDO
252         ENDDO
253      ENDIF
254
255      DO jj = 2,jpjm1
256         DO ji = 2,jpim1
257            IF (tmask(ji,jj,jk) == 1) THEN
258               !! non-fast N  full column regeneration
259               trc2d(ji,jj,37) = trc2d(ji,jj,37) + fregen(ji,jj)
260               !! non-fast Si full column regeneration
261               trc2d(ji,jj,38) = trc2d(ji,jj,38) + fregensi(ji,jj)
262               !! non-fast N  regeneration to  100 m
263            ENDIF
264         ENDDO
265      ENDDO
266
267      IF (jk.eq.i0100) THEN
268         DO jj = 2,jpjm1
269            DO ji = 2,jpim1
270               IF (tmask(ji,jj,jk) == 1) THEN
271                  trc2d(ji,jj,39) = trc2d(ji,jj,37)
272               ENDIF
273            ENDDO
274         ENDDO
275      ENDIF
276
277      IF (jk.eq.i0200) THEN
278         DO jj = 2,jpjm1
279            DO ji = 2,jpim1
280               IF (tmask(ji,jj,jk) == 1) THEN
281                  !! non-fast N  regeneration to  200 m
282                  trc2d(ji,jj,40) = trc2d(ji,jj,37)
283               ENDIF
284            ENDDO
285         ENDDO
286      ENDIF
287
288      IF (jk.eq.i0500) THEN
289         DO jj = 2,jpjm1
290            DO ji = 2,jpim1
291               IF (tmask(ji,jj,jk) == 1) THEN
292                  !! non-fast N  regeneration to  500 m
293                  trc2d(ji,jj,41) = trc2d(ji,jj,37)
294               ENDIF
295            ENDDO
296         ENDDO
297      ENDIF
298
299      IF (jk.eq.i1000) THEN
300         DO jj = 2,jpjm1
301            DO ji = 2,jpim1
302               IF (tmask(ji,jj,jk) == 1) THEN
303                  !! non-fast N  regeneration to 1000 m
304                  trc2d(ji,jj,42) = trc2d(ji,jj,37)
305               ENDIF
306            ENDDO
307         ENDDO
308      ENDIF
309
310      DO jj = 2,jpjm1
311         DO ji = 2,jpim1
312            IF (tmask(ji,jj,jk) == 1) THEN
313               !! fast sinking detritus N production
314               trc2d(ji,jj,43) = trc2d(ji,jj,43) +                           &
315                                 (ftempn(ji,jj) * fse3t(ji,jj,jk))
316               !! fast sinking detritus Si production
317               trc2d(ji,jj,44) = trc2d(ji,jj,44) +                           &
318                                 (ftempsi(ji,jj) * fse3t(ji,jj,jk))
319               !! fast sinking detritus Fe production
320               trc2d(ji,jj,45) = trc2d(ji,jj,45) +                           &
321                                 (ftempfe(ji,jj) * fse3t(ji,jj,jk))
322               !! fast sinking detritus C production
323               trc2d(ji,jj,46) = trc2d(ji,jj,46) +                           &
324                                 (ftempc(ji,jj)  * fse3t(ji,jj,jk))
325               !! fast sinking detritus CaCO3 production
326               trc2d(ji,jj,47) = trc2d(ji,jj,47) +                           &
327                                 (ftempca(ji,jj) * fse3t(ji,jj,jk))
328            ENDIF
329         ENDDO
330      ENDDO
331
332      IF (jk.eq.i0100) THEN
333         DO jj = 2,jpjm1
334            DO ji = 2,jpim1
335               IF (tmask(ji,jj,jk) == 1) THEN
336                  !! fast detritus N  flux at  100 m
337                  trc2d(ji,jj,48) = ffastn(ji,jj)
338               ENDIF
339            ENDDO
340         ENDDO
341      ENDIF
342
343      IF (jk.eq.i0200) THEN
344         DO jj = 2,jpjm1
345            DO ji = 2,jpim1
346               IF (tmask(ji,jj,jk) == 1) THEN
347                  !! fast detritus N  flux at  200 m
348                  trc2d(ji,jj,49) = ffastn(ji,jj)
349               ENDIF
350            ENDDO
351         ENDDO
352      ENDIF
353
354      IF (jk.eq.i0500) THEN
355         DO jj = 2,jpjm1
356            DO ji = 2,jpim1
357               IF (tmask(ji,jj,jk) == 1) THEN
358                  !! fast detritus N  flux at  500 m
359                  trc2d(ji,jj,50) = ffastn(ji,jj)
360               ENDIF
361            ENDDO
362         ENDDO
363      ENDIF
364
365      IF (jk.eq.i1000) THEN
366         DO jj = 2,jpjm1
367            DO ji = 2,jpim1
368               IF (tmask(ji,jj,jk) == 1) THEN
369                  !! fast detritus N  flux at 1000 m
370                  trc2d(ji,jj,51) = ffastn(ji,jj)
371               ENDIF
372            ENDDO
373         ENDDO
374      ENDIF
375
376      IF (jk.eq.i0100) THEN
377         DO jj = 2,jpjm1
378            DO ji = 2,jpim1
379               IF (tmask(ji,jj,jk) == 1) THEN
380                  !! N  regeneration to  100 m
381                  trc2d(ji,jj,52) = fregenfast(ji,jj)
382               ENDIF
383            ENDDO
384         ENDDO
385      ENDIF
386
387      IF (jk.eq.i0200) THEN
388         DO jj = 2,jpjm1
389            DO ji = 2,jpim1
390               IF (tmask(ji,jj,jk) == 1) THEN
391                  !! N  regeneration to  200 m
392                  trc2d(ji,jj,53) = fregenfast(ji,jj)
393               ENDIF
394            ENDDO
395         ENDDO
396      ENDIF
397
398      IF (jk.eq.i0500) THEN
399         DO jj = 2,jpjm1
400            DO ji = 2,jpim1
401               IF (tmask(ji,jj,jk) == 1) THEN
402                  !! N  regeneration to  500 m
403                  trc2d(ji,jj,54) = fregenfast(ji,jj)
404               ENDIF
405            ENDDO
406         ENDDO
407      ENDIF
408
409      IF (jk.eq.i1000) THEN
410         DO jj = 2,jpjm1
411            DO ji = 2,jpim1
412               IF (tmask(ji,jj,jk) == 1) THEN
413                  !! N  regeneration to 1000 m
414                  trc2d(ji,jj,55) = fregenfast(ji,jj)
415               ENDIF
416            ENDDO
417         ENDDO
418      ENDIF
419
420      IF (jk.eq.i0100) THEN
421         DO jj = 2,jpjm1
422            DO ji = 2,jpim1
423               IF (tmask(ji,jj,jk) == 1) THEN
424                  !! fast detritus Si flux at  100 m
425                  trc2d(ji,jj,56) = ffastsi(ji,jj)
426               ENDIF
427            ENDDO
428         ENDDO
429      ENDIF
430
431      IF (jk.eq.i0200) THEN
432         DO jj = 2,jpjm1
433            DO ji = 2,jpim1
434               IF (tmask(ji,jj,jk) == 1) THEN
435                  !! fast detritus Si flux at  200 m
436                  trc2d(ji,jj,57) = ffastsi(ji,jj)
437               ENDIF
438            ENDDO
439         ENDDO
440      ENDIF
441
442      IF (jk.eq.i0500) THEN
443         DO jj = 2,jpjm1
444            DO ji = 2,jpim1
445               IF (tmask(ji,jj,jk) == 1) THEN
446                  !! fast detritus Si flux at  500 m
447                  trc2d(ji,jj,58) = ffastsi(ji,jj)
448               ENDIF
449            ENDDO
450         ENDDO
451      ENDIF
452
453      IF (jk.eq.i1000) THEN
454         DO jj = 2,jpjm1
455            DO ji = 2,jpim1
456               IF (tmask(ji,jj,jk) == 1) THEN
457                  !! fast detritus Si flux at 1000 m
458                  trc2d(ji,jj,59) = ffastsi(ji,jj)
459               ENDIF
460            ENDDO
461         ENDDO
462      ENDIF
463
464      IF (jk.eq.i0100) THEN
465         DO jj = 2,jpjm1
466            DO ji = 2,jpim1
467               IF (tmask(ji,jj,jk) == 1) THEN
468                  !! Si regeneration to  100 m
469                  trc2d(ji,jj,60) = fregenfastsi(ji,jj)
470               ENDIF
471            ENDDO
472         ENDDO
473      ENDIF
474
475      IF (jk.eq.i0200) THEN
476         DO jj = 2,jpjm1
477            DO ji = 2,jpim1
478               IF (tmask(ji,jj,jk) == 1) THEN
479                  !! Si regeneration to  200 m
480                  trc2d(ji,jj,61) = fregenfastsi(ji,jj)
481               ENDIF
482            ENDDO
483         ENDDO
484      ENDIF
485
486      IF (jk.eq.i0500) THEN
487         DO jj = 2,jpjm1
488            DO ji = 2,jpim1
489               IF (tmask(ji,jj,jk) == 1) THEN
490                  !! Si regeneration to  500 m
491                  trc2d(ji,jj,62) = fregenfastsi(ji,jj)
492               ENDIF
493            ENDDO
494         ENDDO
495      ENDIF
496
497      IF (jk.eq.i1000) THEN
498         DO jj = 2,jpjm1
499            DO ji = 2,jpim1
500               IF (tmask(ji,jj,jk) == 1) THEN
501                  !! Si regeneration to 1000 m
502                  trc2d(ji,jj,63) = fregenfastsi(ji,jj)
503               ENDIF
504            ENDDO
505         ENDDO
506      ENDIF
507
508      DO jj = 2,jpjm1
509         DO ji = 2,jpim1
510            IF (tmask(ji,jj,jk) == 1) THEN
511               !! sum of fast-sinking N  fluxes
512               trc2d(ji,jj,64) = trc2d(ji,jj,64) +                           &
513                                 (freminn(ji,jj) * fse3t(ji,jj,jk))
514               !! sum of fast-sinking Si fluxes
515               trc2d(ji,jj,65) = trc2d(ji,jj,65) +                           &
516                                 (freminsi(ji,jj) * fse3t(ji,jj,jk))
517               !! sum of fast-sinking Fe fluxes
518               trc2d(ji,jj,66) = trc2d(ji,jj,66) +                           &
519                                 (freminfe(ji,jj) * fse3t(ji,jj,jk))
520               !! sum of fast-sinking C  fluxes
521               trc2d(ji,jj,67) = trc2d(ji,jj,67) +                           &
522                                 (freminc(ji,jj) * fse3t(ji,jj,jk))
523               !! sum of fast-sinking Ca fluxes
524               trc2d(ji,jj,68) = trc2d(ji,jj,68) +                           &
525                                 (freminca(ji,jj) * fse3t(ji,jj,jk))
526            ENDIF
527         ENDDO
528      ENDDO
529
530
531      DO jj = 2,jpjm1
532         DO ji = 2,jpim1
533            IF (tmask(ji,jj,jk) == 1) THEN
534               if (jk.eq.mbathy(ji,jj)) then
535                  !! N  sedimentation flux
536                  trc2d(ji,jj,69) = fsedn(ji,jj)
537                  !! Si sedimentation flux
538                  trc2d(ji,jj,70) = fsedsi(ji,jj)
539                  !! Fe sedimentation flux
540                  trc2d(ji,jj,71) = fsedfe(ji,jj)
541                  !! C  sedimentation flux
542                  trc2d(ji,jj,72) = fsedc(ji,jj)
543                  !! Ca sedimentation flux
544                  trc2d(ji,jj,73) = fsedca(ji,jj)
545               endif
546            ENDIF
547         ENDDO
548      ENDDO
549
550      if (jk.eq.1) then
551         DO jj = 2,jpjm1
552            DO ji = 2,jpim1
553               IF (tmask(ji,jj,jk) == 1) THEN
554                  trc2d(ji,jj,74) = qsr(ji,jj)
555                  trc2d(ji,jj,75) = xpar(ji,jj,jk)
556                  !! trc2d(ji,jj,75) = real(iters(ji,jj))
557               ENDIF
558            ENDDO
559         ENDDO
560      endif
561
562      DO jj = 2,jpjm1
563         DO ji = 2,jpim1
564            IF (tmask(ji,jj,jk) == 1) THEN
565               !! diagnostic fields 76 to 80 calculated below
566               !! mixed layer non-diatom production
567               trc2d(ji,jj,81) = trc2d(ji,jj,81) + fprn_ml(ji,jj)
568               !! mixed layer     diatom production
569               trc2d(ji,jj,82) = trc2d(ji,jj,82) + fprd_ml(ji,jj)
570            ENDIF
571         ENDDO
572      ENDDO
573
574# if defined key_gulf_finland
575      if (jk.eq.1) then
576         DO jj = 2,jpjm1
577            DO ji = 2,jpim1
578               IF (tmask(ji,jj,jk) == 1) THEN
579                  !! Gulf of Finland check
580                  trc2d(ji,jj,83) = real(ibio_switch)
581               ENDIF
582            ENDDO
583         ENDDO
584      endif
585# else
586      DO jj = 2,jpjm1
587         DO ji = 2,jpim1
588            IF (tmask(ji,jj,jk) == 1) THEN
589               !! calcite CCD depth
590               trc2d(ji,jj,83) = ocal_ccd(ji,jj)
591            ENDIF
592         ENDDO
593      ENDDO
594# endif
595      DO jj = 2,jpjm1
596         DO ji = 2,jpim1
597            IF (tmask(ji,jj,jk) == 1) THEN
598               !! last model level above calcite CCD depth
599               trc2d(ji,jj,84) = fccd(ji,jj)
600            ENDIF
601         ENDDO
602      ENDDO
603
604      IF (jk.eq.1) THEN
605         DO jj = 2,jpjm1
606            DO ji = 2,jpim1
607               IF (tmask(ji,jj,jk) == 1) THEN
608                  !! surface "free" iron
609                  trc2d(ji,jj,85) = xFree(ji,jj)
610               ENDIF
611            ENDDO
612         ENDDO
613      ENDIF
614
615! I'm keeping this the same as before for reproducibility, but it looks
616! like it should be i0100 and not i0200 - marc 8/5/17
617      IF (jk.eq.i0200) THEN
618         DO jj = 2,jpjm1
619            DO ji = 2,jpim1
620               IF (tmask(ji,jj,jk) == 1) THEN
621                  !! "free" iron at  100 m
622                  trc2d(ji,jj,86) = xFree(ji,jj)
623               ENDIF
624            ENDDO
625         ENDDO
626      ENDIF
627
628
629      IF (jk.eq.i0200) THEN
630         DO jj = 2,jpjm1
631            DO ji = 2,jpim1
632               IF (tmask(ji,jj,jk) == 1) THEN
633                  !! "free" iron at  200 m
634                  trc2d(ji,jj,87) = xFree(ji,jj)
635               ENDIF
636            ENDDO
637         ENDDO
638      ENDIF
639
640
641      IF (jk.eq.i0500) THEN
642         DO jj = 2,jpjm1
643            DO ji = 2,jpim1
644               IF (tmask(ji,jj,jk) == 1) THEN
645                  !! "free" iron at  500 m
646                  trc2d(ji,jj,88) = xFree(ji,jj)
647               ENDIF
648            ENDDO
649         ENDDO
650      ENDIF
651
652
653      IF (jk.eq.i1000) THEN
654         DO jj = 2,jpjm1
655            DO ji = 2,jpim1
656               IF (tmask(ji,jj,jk) == 1) THEN
657                  !! "free" iron at 1000 m
658                  trc2d(ji,jj,89) = xFree(ji,jj)
659               ENDIF
660            ENDDO
661         ENDDO
662      ENDIF
663
664
665      IF (jk.eq.1) THEN
666         DO jj = 2,jpjm1
667            DO ji = 2,jpim1
668               IF (tmask(ji,jj,jk) == 1) THEN
669                  !! AXY (27/06/12): extract "euphotic depth"
670                  trc2d(ji,jj,90) = xze(ji,jj)
671               ENDIF
672            ENDDO
673         ENDDO
674      ENDIF
675
676# if defined key_roam
677      if (jk .eq. 1) then
678         DO jj = 2,jpjm1
679            DO ji = 2,jpim1
680               IF (tmask(ji,jj,jk) == 1) THEN
681                  !! ROAM provisionally has access to a further 20 2D
682                  !! diagnostics
683                  !! surface wind
684                  trc2d(ji,jj,91)  = trc2d(ji,jj,91)  + wndm(ji,jj)
685                  !! atmospheric pCO2
686                  trc2d(ji,jj,92)  = trc2d(ji,jj,92)  + f_pco2atm(ji,jj)
687                  !! ocean pH
688                  trc2d(ji,jj,93)  = trc2d(ji,jj,93)  + f_ph(ji,jj)
689                  !! ocean pCO2
690                  trc2d(ji,jj,94)  = trc2d(ji,jj,94)  + f_pco2w(ji,jj)
691                  !! ocean H2CO3 conc.
692                  trc2d(ji,jj,95)  = trc2d(ji,jj,95)  + f_h2co3(ji,jj)
693                  !! ocean HCO3 conc.
694                  trc2d(ji,jj,96)  = trc2d(ji,jj,96)  + f_hco3(ji,jj)
695                  !! ocean CO3 conc.
696                  trc2d(ji,jj,97)  = trc2d(ji,jj,97)  + f_co3(ji,jj)
697                  !! air-sea CO2 flux
698                  trc2d(ji,jj,98)  = trc2d(ji,jj,98)  + f_co2flux(ji,jj)
699               ENDIF
700            ENDDO
701        ENDDO
702
703         DO jj = 2,jpjm1
704            DO ji = 2,jpim1
705               IF (tmask(ji,jj,jk) == 1) THEN
706                  !! ocean omega calcite
707                  trc2d(ji,jj,99)  = trc2d(ji,jj,99)  + f_omcal(ji,jj)
708                  !! ocean omega aragonite
709                  trc2d(ji,jj,100) = trc2d(ji,jj,100) + f_omarg(ji,jj)
710                  !! ocean TDIC
711                  trc2d(ji,jj,101) = trc2d(ji,jj,101) + f_TDIC(ji,jj)
712                  !! ocean TALK
713                  trc2d(ji,jj,102) = trc2d(ji,jj,102) + f_TALK(ji,jj)
714                  !! surface kw660
715                  trc2d(ji,jj,103) = trc2d(ji,jj,103) + f_kw660(ji,jj)
716                  !! surface pressure
717                  trc2d(ji,jj,104) = trc2d(ji,jj,104) + f_pp0(ji,jj)
718                  !! air-sea O2 flux
719                  trc2d(ji,jj,105) = trc2d(ji,jj,105) + f_o2flux(ji,jj)
720                  !! ocean O2 saturation
721                  trc2d(ji,jj,106) = trc2d(ji,jj,106) + f_o2sat(ji,jj)
722                  !! depth calcite CCD
723                  trc2d(ji,jj,107) = f2_ccd_cal(ji,jj)
724                  !! depth aragonite CCD
725                  trc2d(ji,jj,108) = f2_ccd_arg(ji,jj)
726               ENDIF
727            ENDDO
728         ENDDO
729      endif
730
731      DO jj = 2,jpjm1
732         DO ji = 2,jpim1
733            IF (tmask(ji,jj,jk) == 1) THEN
734               if (jk .eq. mbathy(ji,jj)) then
735                  !! seafloor omega calcite
736                  trc2d(ji,jj,109) = f3_omcal(ji,jj,jk)
737                  !! seafloor omega aragonite
738                  trc2d(ji,jj,110) = f3_omarg(ji,jj,jk)
739               endif
740            ENDIF
741         ENDDO
742      ENDDO
743
744      if (jk.eq.i0100) then
745         DO jj = 2,jpjm1
746            DO ji = 2,jpim1
747               IF (tmask(ji,jj,jk) == 1) THEN
748                  !! diagnostic fields 111 to 117 calculated below
749                  !! rain ratio at  100 m
750                  trc2d(ji,jj,118) =                                         &
751                                   ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall)
752               ENDIF
753            ENDDO
754         ENDDO
755      endif
756
757      if (jk.eq.i0500) then
758         DO jj = 2,jpjm1
759            DO ji = 2,jpim1
760               IF (tmask(ji,jj,jk) == 1) THEN
761                  !! rain ratio at  500 m
762                  trc2d(ji,jj,119) =                                         &
763                                   ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall)
764               ENDIF
765            ENDDO
766         ENDDO
767      endif
768
769      if (jk.eq.i1000) then
770         DO jj = 2,jpjm1
771            DO ji = 2,jpim1
772               IF (tmask(ji,jj,jk) == 1) THEN
773                  !! rain ratio at 1000 m
774                  trc2d(ji,jj,120) =                                         &
775                                   ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall)
776               ENDIF
777            ENDDO
778         ENDDO
779      endif
780
781      DO jj = 2,jpjm1
782         DO ji = 2,jpim1
783            IF (tmask(ji,jj,jk) == 1) THEN
784               if (jk.eq.mbathy(ji,jj)) then
785                  !! AXY (18/01/12): benthic flux diagnostics
786                  trc2d(ji,jj,121) = f_sbenin_n(ji,jj)  + f_fbenin_n(ji,jj)
787                  trc2d(ji,jj,122) = f_sbenin_fe(ji,jj) + f_fbenin_fe(ji,jj)
788                  trc2d(ji,jj,123) = f_sbenin_c(ji,jj)  + f_fbenin_c(ji,jj)
789                  trc2d(ji,jj,124) = f_fbenin_si(ji,jj)
790                  trc2d(ji,jj,125) = f_fbenin_ca(ji,jj)
791                  trc2d(ji,jj,126) = f_benout_n(ji,jj)
792                  trc2d(ji,jj,127) = f_benout_fe(ji,jj)
793                  trc2d(ji,jj,128) = f_benout_c(ji,jj)
794                  trc2d(ji,jj,129) = f_benout_si(ji,jj)
795                  trc2d(ji,jj,130) = f_benout_ca(ji,jj)
796               endif
797            ENDIF
798         ENDDO
799      ENDDO
800
801      DO jj = 2,jpjm1
802         DO ji = 2,jpim1
803            IF (tmask(ji,jj,jk) == 1) THEN
804               !! diagnostics fields 131 to 135 calculated below
805               trc2d(ji,jj,136) = f_runoff(ji,jj)
806               !! AXY (19/07/12): amended to allow for riverine
807               !! nutrient addition below surface
808               trc2d(ji,jj,137) = trc2d(ji,jj,137) +                         &
809                                     (f_riv_loc_n(ji,jj) * fse3t(ji,jj,jk))
810               trc2d(ji,jj,138) = trc2d(ji,jj,138) +                         &
811                                     (f_riv_loc_si(ji,jj) * fse3t(ji,jj,jk))
812               trc2d(ji,jj,139) = trc2d(ji,jj,139) +                         &
813                                     (f_riv_loc_c(ji,jj) * fse3t(ji,jj,jk))
814               trc2d(ji,jj,140) = trc2d(ji,jj,140) +                         &
815                                     (f_riv_loc_alk(ji,jj) * fse3t(ji,jj,jk))
816               !! slow sinking detritus C production
817               trc2d(ji,jj,141) = trc2d(ji,jj,141) +                         &
818                                     (fslowc(ji,jj)  * fse3t(ji,jj,jk))
819            ENDIF
820         ENDDO
821      ENDDO
822
823      if (jk.eq.i0100) then
824         DO jj = 2,jpjm1
825            DO ji = 2,jpim1
826               IF (tmask(ji,jj,jk) == 1) THEN
827                  !! slow detritus flux at  100 m
828                  trc2d(ji,jj,142) = fslowcflux(ji,jj)
829               ENDIF
830            ENDDO
831         ENDDO
832      endif
833
834      if (jk.eq.i0200) then
835         DO jj = 2,jpjm1
836            DO ji = 2,jpim1
837               IF (tmask(ji,jj,jk) == 1) THEN
838                  !! slow detritus flux at  200 m
839                  trc2d(ji,jj,143) = fslowcflux(ji,jj)
840               ENDIF
841            ENDDO
842         ENDDO
843      endif
844
845
846      if (jk.eq.i0500) then
847         DO jj = 2,jpjm1
848            DO ji = 2,jpim1
849               IF (tmask(ji,jj,jk) == 1) THEN
850                  !! slow detritus flux at  500 m
851                  trc2d(ji,jj,144) = fslowcflux(ji,jj)
852               ENDIF
853            ENDDO
854         ENDDO
855      endif
856
857
858      if (jk.eq.i1000) then
859         DO jj = 2,jpjm1
860            DO ji = 2,jpim1
861               IF (tmask(ji,jj,jk) == 1) THEN
862                  !! slow detritus flux at 1000 m
863                  trc2d(ji,jj,145) = fslowcflux(ji,jj)
864               ENDIF
865            ENDDO
866         ENDDO
867      endif
868
869      DO jj = 2,jpjm1
870         DO ji = 2,jpim1
871            IF (tmask(ji,jj,jk) == 1) THEN
872               !! carbon     inventory
873               trc2d(ji,jj,146)  = trc2d(ji,jj,146)  + ftot_c(ji,jj)
874               !! alkalinity inventory
875               trc2d(ji,jj,147)  = trc2d(ji,jj,147)  + ftot_a(ji,jj)
876               !! oxygen     inventory
877               trc2d(ji,jj,148)  = trc2d(ji,jj,148)  + ftot_o2(ji,jj)
878
879               if (jk.eq.mbathy(ji,jj)) then
880                  trc2d(ji,jj,149) = f_benout_lyso_ca(ji,jj)
881               endif
882
883               !! community respiration
884               trc2d(ji,jj,150) = fcomm_resp(ji,jj) * fse3t(ji,jj,jk)
885            ENDIF
886         ENDDO
887      ENDDO
888
889      DO jj = 2,jpjm1
890         DO ji = 2,jpim1
891            IF (tmask(ji,jj,jk) == 1) THEN
892          !!
893          !! AXY (14/02/14): a Valentines Day gift to BASIN - a
894               !!                 shedload of new diagnostics that
895               !!                 they'll most likely never need!
896               !!                 (actually, as with all such gifts,
897               !!                 I'm giving them some things I'd like
898               !!                 myself!)
899               !!
900               !! ------------------------------------------------------
901               !! linear losses
902               !! non-diatom
903               trc2d(ji,jj,151) = trc2d(ji,jj,151) +                         &
904                                  (fdpn2(ji,jj) * fse3t(ji,jj,jk))
905               !! diatom
906               trc2d(ji,jj,152) = trc2d(ji,jj,152) +                         &
907                                  (fdpd2(ji,jj)  * fse3t(ji,jj,jk))
908               !! microzooplankton
909               trc2d(ji,jj,153) = trc2d(ji,jj,153) +                         &
910                                  (fdzmi2(ji,jj) * fse3t(ji,jj,jk))
911               !! mesozooplankton
912               trc2d(ji,jj,154) = trc2d(ji,jj,154) +                         &
913                                  (fdzme2(ji,jj) * fse3t(ji,jj,jk))
914            ENDIF
915         ENDDO
916      ENDDO
917
918      DO jj = 2,jpjm1
919         DO ji = 2,jpim1
920            IF (tmask(ji,jj,jk) == 1) THEN
921               !! ------------------------------------------------------
922               !! microzooplankton grazing
923               !! microzooplankton messy -> N
924               trc2d(ji,jj,155) = trc2d(ji,jj,155) +                         &
925                                  (xphi * (fgmipn(ji,jj) +                   &
926                                           fgmid(ji,jj)) * fse3t(ji,jj,jk))
927               !! microzooplankton messy -> D
928               trc2d(ji,jj,156) = trc2d(ji,jj,156) +                         &
929                                  ((1. - xbetan) * finmi(ji,jj) *            &
930                                   fse3t(ji,jj,jk))
931               !! microzooplankton messy -> DIC
932               trc2d(ji,jj,157) = trc2d(ji,jj,157) +                         &
933                                  (xphi * ((xthetapn * fgmipn(ji,jj)) +      &
934                                           fgmidc(ji,jj)) *                  &
935                                   fse3t(ji,jj,jk))
936               !! microzooplankton messy -> Dc
937               trc2d(ji,jj,158) = trc2d(ji,jj,158) +                         &
938                                  ((1. - xbetac) * ficmi(ji,jj) *            &
939                                   fse3t(ji,jj,jk))
940               !! microzooplankton excretion
941               trc2d(ji,jj,159) = trc2d(ji,jj,159) +                         &
942                                  (fmiexcr(ji,jj) * fse3t(ji,jj,jk))
943               !! microzooplankton respiration
944               trc2d(ji,jj,160) = trc2d(ji,jj,160) +                         &
945                                  (fmiresp(ji,jj) * fse3t(ji,jj,jk))
946               !! microzooplankton growth
947               trc2d(ji,jj,161) = trc2d(ji,jj,161) +                         &
948                                  (fmigrow(ji,jj) * fse3t(ji,jj,jk))
949            ENDIF
950         ENDDO
951      ENDDO
952
953      DO jj = 2,jpjm1
954         DO ji = 2,jpim1
955            IF (tmask(ji,jj,jk) == 1) THEN
956               !! ------------------------------------------------------
957               !! mesozooplankton grazing
958               !! mesozooplankton messy -> N
959               trc2d(ji,jj,162) = trc2d(ji,jj,162) +                         &
960                                  (xphi *                                    &
961                                   (fgmepn(ji,jj) + fgmepd(ji,jj) +          &
962                                    fgmezmi(ji,jj) + fgmed(ji,jj)) *         &
963                                   fse3t(ji,jj,jk))
964               !! mesozooplankton messy -> D
965               trc2d(ji,jj,163) = trc2d(ji,jj,163) +                         &
966                                  ((1. - xbetan) * finme(ji,jj) *            &
967                                   fse3t(ji,jj,jk))
968               !! mesozooplankton messy -> DIC
969               trc2d(ji,jj,164) = trc2d(ji,jj,164) +                         &
970                                  (xphi *                                    &
971                                   ((xthetapn * fgmepn(ji,jj)) +             &
972                                    (xthetapd * fgmepd(ji,jj)) +             &
973                                    (xthetazmi * fgmezmi(ji,jj)) +           &
974                                   fgmedc(ji,jj)) * fse3t(ji,jj,jk))
975               !! mesozooplankton messy -> Dc
976               trc2d(ji,jj,165) = trc2d(ji,jj,165) +                         &
977                                  ((1. - xbetac) * ficme(ji,jj) *            &
978                                   fse3t(ji,jj,jk))
979               !! mesozooplankton excretion
980               trc2d(ji,jj,166) = trc2d(ji,jj,166) +                         &
981                                  (fmeexcr(ji,jj) * fse3t(ji,jj,jk))
982               !! mesozooplankton respiration
983               trc2d(ji,jj,167) = trc2d(ji,jj,167) +                         &
984                                  (fmeresp(ji,jj) * fse3t(ji,jj,jk))
985               !! mesozooplankton growth
986               trc2d(ji,jj,168) = trc2d(ji,jj,168) +                         &
987                                  (fmegrow(ji,jj) * fse3t(ji,jj,jk))
988            ENDIF
989         ENDDO
990      ENDDO
991
992      DO jj = 2,jpjm1
993         DO ji = 2,jpim1
994            IF (tmask(ji,jj,jk) == 1) THEN
995               !! ------------------------------------------------------
996               !! miscellaneous
997               !! detrital C remineralisation
998               trc2d(ji,jj,169) = trc2d(ji,jj,169) +                         &
999                                  (fddc(ji,jj) * fse3t(ji,jj,jk))
1000               !! microzoo grazing on detrital carbon
1001               trc2d(ji,jj,170) = trc2d(ji,jj,170) +                         &
1002                                  (fgmidc(ji,jj)  * fse3t(ji,jj,jk))
1003               !! mesozoo  grazing on detrital carbon
1004               trc2d(ji,jj,171) = trc2d(ji,jj,171) +                         &
1005                                  (fgmedc(ji,jj)  * fse3t(ji,jj,jk))
1006               !!
1007            ENDIF
1008         ENDDO
1009      ENDDO
1010
1011      !! ------------------------------------------------------
1012      !!
1013      !! AXY (23/10/14): extract primary production related
1014      !!                 surface fields to deal with diel
1015      !!                 cycle issues; hijacking BASIN 150m
1016      !!                 diagnostics to do so (see commented
1017      !!                 out diagnostics below this section)
1018      !!
1019      !! extract relevant BASIN fields at 150m
1020      if (jk .eq. i0150) then
1021         DO jj = 2,jpjm1
1022            DO ji = 2,jpim1
1023               IF (tmask(ji,jj,jk) == 1) THEN
1024                  !! Pn PP
1025                  trc2d(ji,jj,172) = trc2d(ji,jj,4)
1026                  !! Pn linear loss
1027                  trc2d(ji,jj,173) = trc2d(ji,jj,151)
1028                  !! Pn non-linear loss
1029                  trc2d(ji,jj,174) = trc2d(ji,jj,5)
1030                  !! Pn grazing to Zmi
1031                  trc2d(ji,jj,175) = trc2d(ji,jj,11)
1032                  !! Pn grazing to Zme
1033                  trc2d(ji,jj,176) = trc2d(ji,jj,14)
1034                  !! Pd PP
1035                  trc2d(ji,jj,177) = trc2d(ji,jj,6)
1036                  !! Pd linear loss
1037                  trc2d(ji,jj,178) = trc2d(ji,jj,152)
1038                  !! Pd non-linear loss
1039                  trc2d(ji,jj,179) = trc2d(ji,jj,7)
1040                  !! Pd grazing to Zme
1041                  trc2d(ji,jj,180) = trc2d(ji,jj,15)
1042                  !! Zmi grazing on D
1043                  trc2d(ji,jj,181) = trc2d(ji,jj,12)
1044                  !! Zmi grazing on Dc
1045                  trc2d(ji,jj,182) = trc2d(ji,jj,170)
1046                  !! Zmi messy feeding loss to N
1047                  trc2d(ji,jj,183) = trc2d(ji,jj,155)
1048                  !! Zmi messy feeding loss to D
1049                  trc2d(ji,jj,184) = trc2d(ji,jj,156)
1050                  !! Zmi messy feeding loss to DIC
1051                  trc2d(ji,jj,185) = trc2d(ji,jj,157)
1052                  !! Zmi messy feeding loss to Dc
1053                  trc2d(ji,jj,186) = trc2d(ji,jj,158)
1054                  !! Zmi excretion
1055                  trc2d(ji,jj,187) = trc2d(ji,jj,159)
1056                  !! Zmi respiration
1057                  trc2d(ji,jj,188) = trc2d(ji,jj,160)
1058                  !! Zmi growth
1059                  trc2d(ji,jj,189) = trc2d(ji,jj,161)
1060                  !! Zmi linear loss
1061                  trc2d(ji,jj,190) = trc2d(ji,jj,153)
1062                  !! Zmi non-linear loss
1063                  trc2d(ji,jj,191) = trc2d(ji,jj,13)
1064                  !! Zmi grazing to Zme
1065                  trc2d(ji,jj,192) = trc2d(ji,jj,16)
1066                  !! Zme grazing on D
1067                  trc2d(ji,jj,193) = trc2d(ji,jj,17)
1068                  !! Zme grazing on Dc
1069                  trc2d(ji,jj,194) = trc2d(ji,jj,171)
1070                  !! Zme messy feeding loss to N
1071                  trc2d(ji,jj,195) = trc2d(ji,jj,162)
1072                  !! Zme messy feeding loss to D
1073                  trc2d(ji,jj,196) = trc2d(ji,jj,163)
1074                  !! Zme messy feeding loss to DIC
1075                  trc2d(ji,jj,197) = trc2d(ji,jj,164)
1076                  !! Zme messy feeding loss to Dc
1077                  trc2d(ji,jj,198) = trc2d(ji,jj,165)
1078                  !! Zme excretion
1079                  trc2d(ji,jj,199) = trc2d(ji,jj,166)
1080                  !! Zme respiration
1081                  trc2d(ji,jj,200) = trc2d(ji,jj,167)
1082                  !! Zme growth
1083                  trc2d(ji,jj,201) = trc2d(ji,jj,168)
1084                  !! Zme linear loss
1085                  trc2d(ji,jj,202) = trc2d(ji,jj,154)
1086                  !! Zme non-linear loss
1087                  trc2d(ji,jj,203) = trc2d(ji,jj,18)
1088                  !! Slow detritus production, N
1089                  trc2d(ji,jj,204) = trc2d(ji,jj,20)
1090                  !! Slow detritus remineralisation, N
1091                  trc2d(ji,jj,205) = trc2d(ji,jj,21)
1092                  !! Slow detritus production, C
1093                  trc2d(ji,jj,206) = trc2d(ji,jj,141)
1094                  !! Slow detritus remineralisation, C
1095                  trc2d(ji,jj,207) = trc2d(ji,jj,169)
1096                  !! Fast detritus production, N
1097                  trc2d(ji,jj,208) = trc2d(ji,jj,43)
1098                  !! Fast detritus remineralisation, N
1099                  trc2d(ji,jj,209) = trc2d(ji,jj,21)
1100                  !! Fast detritus production, C
1101                  trc2d(ji,jj,210) = trc2d(ji,jj,64)
1102                  !! Fast detritus remineralisation, C
1103                  trc2d(ji,jj,211) = trc2d(ji,jj,67)
1104                  !! Community respiration
1105                  trc2d(ji,jj,212) = trc2d(ji,jj,150)
1106                  !! Slow detritus N flux at 150 m
1107                  trc2d(ji,jj,213) = fslownflux(ji,jj)
1108                  !! Slow detritus C flux at 150 m
1109                  trc2d(ji,jj,214) = fslowcflux(ji,jj)
1110                  !! Fast detritus N flux at 150 m
1111                  trc2d(ji,jj,215) = ffastn(ji,jj)
1112                  !! Fast detritus C flux at 150 m
1113                  trc2d(ji,jj,216) = ffastc(ji,jj)
1114               ENDIF
1115            ENDDO
1116         ENDDO
1117      endif
1118
1119      !!
1120      !! Jpalm (11-08-2014)
1121      !! Add UKESM1 diagnoatics
1122      !!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
1123      if ((jk .eq. 1) .and.( jdms.eq.1)) then
1124         DO jj = 2,jpjm1
1125            DO ji = 2,jpim1
1126               IF (tmask(ji,jj,jk) == 1) THEN
1127                  !! DMS surface concentration
1128                  trc2d(ji,jj,221) = dms_surf(ji,jj)
1129                  !! AXY (13/03/15): add in other DMS estimates
1130                  !! DMS surface concentration
1131                  trc2d(ji,jj,222) = dms_andr(ji,jj)
1132                  !! DMS surface concentration
1133                  trc2d(ji,jj,223) = dms_simo(ji,jj)
1134                  !! DMS surface concentration
1135                  trc2d(ji,jj,224) = dms_aran(ji,jj)
1136                  !! DMS surface concentration
1137                  trc2d(ji,jj,225) = dms_hall(ji,jj)
1138               ENDIF
1139            ENDDO
1140         ENDDO
1141      endif
1142# endif
1143
1144      DO jj = 2,jpjm1
1145         DO ji = 2,jpim1
1146            IF (tmask(ji,jj,jk) == 1) THEN
1147               !! other possible future diagnostics include:
1148               !!   - integrated tracer values (esp. biological)
1149               !!   - mixed layer tracer values
1150               !!   - sub-surface chlorophyll maxima (plus depth)
1151               !!   - different mixed layer depth criteria (T, sigma,
1152               !!     var. sigma)
1153               !!-------------------------------------------------------
1154               !! Prepare 3D diagnostics
1155               !!-------------------------------------------------------
1156               !!
1157               !! primary production 
1158               trc3d(ji,jj,jk,1)  = ((fprn(ji,jj) + fprd(ji,jj)) *           &
1159                                     zphn(ji,jj))
1160               !! detrital flux
1161               trc3d(ji,jj,jk,2)  = fslownflux(ji,jj) + ffastn(ji,jj)
1162               !! remineralisation
1163               trc3d(ji,jj,jk,3)  = fregen(ji,jj) +                          &
1164                                    (freminn(ji,jj) * fse3t(ji,jj,jk))
1165            ENDIF
1166         ENDDO
1167      ENDDO
1168# if defined key_roam
1169      DO jj = 2,jpjm1
1170         DO ji = 2,jpim1
1171            IF (tmask(ji,jj,jk) == 1) THEN
1172               !! pH
1173               trc3d(ji,jj,jk,4)  = f3_pH(ji,jj,jk)
1174               !! omega calcite
1175               trc3d(ji,jj,jk,5)  = f3_omcal(ji,jj,jk)
1176            ENDIF
1177         ENDDO
1178      ENDDO
1179# else
1180      DO jj = 2,jpjm1
1181         DO ji = 2,jpim1
1182            IF (tmask(ji,jj,jk) == 1) THEN
1183               !! fast Si flux
1184               trc3d(ji,jj,jk,4)  = ffastsi(ji,jj)
1185            ENDIF
1186         ENDDO
1187      ENDDO
1188# endif
1189
1190   END SUBROUTINE bio_med_diag_trc
1191
1192#else
1193   !!======================================================================
1194   !!  Dummy module :                                   No MEDUSA bio-model
1195   !!======================================================================
1196CONTAINS
1197   SUBROUTINE bio_med_diag_trc( )                    ! Empty routine
1198      WRITE(*,*) 'bio_med_diag_trc: You should not have seen this print! error?'
1199   END SUBROUTINE bio_med_diag_trc
1200#endif 
1201
1202   !!======================================================================
1203END MODULE bio_med_diag_trc_mod
Note: See TracBrowser for help on using the repository browser.