source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_med_diag_iomput.F90 @ 10020

Last change on this file since 10020 was 10020, checked in by marc, 2 years ago

GMED ticket 406. CPP key fixes.

File size: 30.3 KB
Line 
1MODULE bio_med_diag_iomput_mod
2   !!======================================================================
3   !!                         ***  MODULE bio_med_diag_iomput_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_iomput        ! 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_iomput( jk )
28      !!-------------------------------------------------------------------
29      !!                     ***  ROUTINE bio_med_diag_iomput  ***
30      !! Calculates the diagnostics used with iom_put
31      !!-------------------------------------------------------------------
32      USE bio_medusa_mod
33      USE dom_oce,           ONLY: e3t_0, mbathy, tmask
34# if defined key_vvl
35      USE dom_oce,           ONLY: e3t_n
36# endif
37      USE in_out_manager,    ONLY: lwp, numout
38      USE par_oce,           ONLY: jpim1, jpjm1
39      USE phycst,            ONLY: rsmall
40      USE sms_medusa,        ONLY: f3_omarg, f3_omcal,                   &
41                                   i0100, i0500, i1000,                  &
42                                   xbetac, xbetan, xphi,                 &
43                                   xthetapd, xthetapn, xthetazmi
44      USE trc,               ONLY: med_diag
45
46   !!* Substitution
47#  include "domzgr_substitute.h90"
48
49      !! level
50      INTEGER, INTENT( in ) :: jk
51
52      !! Loop avariables
53      INTEGER :: ji, jj, jn
54
55      DO jj = 2,jpjm1
56         DO ji = 2,jpim1
57            !! OPEN wet point IF..THEN loop
58            IF (tmask(ji,jj,jk) == 1) THEN
59               !!-------------------------------------------------------
60               !! Add in XML diagnostics stuff
61               !!-------------------------------------------------------
62               !!
63               !! ** 2D diagnostics
64#   if defined key_debug_medusa
65               IF (lwp) write (numout,*)                                     &
66                  'bio_med_diag_iomput: in ij-jj loop jk = ', jk
67               CALL flush(numout)
68#   endif
69               IF ( med_diag%PRN%dgsave ) THEN
70                   fprn2d(ji,jj) = fprn2d(ji,jj) +                           &
71                                   (fprn(ji,jj)  * zphn(ji,jj) *             &
72                                    fse3t(ji,jj,jk)) 
73               ENDIF
74               IF ( med_diag%MPN%dgsave ) THEN
75                   fdpn2d(ji,jj) = fdpn2d(ji,jj) + (fdpn(ji,jj) *            &
76                                                    fse3t(ji,jj,jk))
77               ENDIF
78               IF ( med_diag%PRD%dgsave ) THEN
79                   fprd2d(ji,jj) = fprd2d(ji,jj) +                           &
80                                   (fprd(ji,jj)  * zphd(ji,jj) *             &
81                                    fse3t(ji,jj,jk))
82               ENDIF
83               IF( med_diag%MPD%dgsave ) THEN
84                   fdpd2d(ji,jj) = fdpd2d(ji,jj) + (fdpd(ji,jj) *            &
85                                                    fse3t(ji,jj,jk)) 
86               ENDIF
87               !  IF( med_diag%DSED%dgsave ) THEN
88               !      CALL iom_put( "DSED"  , ftot_n )
89               !  ENDIF
90               IF( med_diag%OPAL%dgsave ) THEN
91                   fprds2d(ji,jj) = fprds2d(ji,jj) +                         &
92                                    (fprds(ji,jj) * zpds(ji,jj) *            &
93                                     fse3t(ji,jj,jk)) 
94               ENDIF
95            ENDIF
96         ENDDO
97      ENDDO
98
99      DO jj = 2,jpjm1
100         DO ji = 2,jpim1
101            IF (tmask(ji,jj,jk) == 1) THEN
102               IF( med_diag%OPALDISS%dgsave ) THEN
103                   fsdiss2d(ji,jj) = fsdiss2d(ji,jj) + (fsdiss(ji,jj) *      &
104                                                        fse3t(ji,jj,jk)) 
105               ENDIF
106               IF( med_diag%GMIPn%dgsave ) THEN
107                   fgmipn2d(ji,jj) = fgmipn2d(ji,jj) +                       &
108                                     (fgmipn(ji,jj)  * fse3t(ji,jj,jk)) 
109               ENDIF
110               IF( med_diag%GMID%dgsave ) THEN
111                   fgmid2d(ji,jj) = fgmid2d(ji,jj) + (fgmid(ji,jj) *         &
112                                                      fse3t(ji,jj,jk)) 
113               ENDIF
114               IF( med_diag%MZMI%dgsave ) THEN
115                   fdzmi2d(ji,jj) = fdzmi2d(ji,jj) + (fdzmi(ji,jj) *         &
116                                                      fse3t(ji,jj,jk)) 
117               ENDIF
118            ENDIF
119         ENDDO
120      ENDDO
121
122      DO jj = 2,jpjm1
123         DO ji = 2,jpim1
124            IF (tmask(ji,jj,jk) == 1) THEN
125               IF( med_diag%GMEPN%dgsave ) THEN
126                   fgmepn2d(ji,jj) = fgmepn2d(ji,jj) + (fgmepn(ji,jj) *      &
127                                                        fse3t(ji,jj,jk))
128               ENDIF
129               IF( med_diag%GMEPD%dgsave ) THEN
130                   fgmepd2d(ji,jj) = fgmepd2d(ji,jj) + (fgmepd(ji,jj) *      &
131                                                        fse3t(ji,jj,jk)) 
132               ENDIF
133               IF( med_diag%GMEZMI%dgsave ) THEN
134                   fgmezmi2d(ji,jj) = fgmezmi2d(ji,jj) +                     &
135                                      (fgmezmi(ji,jj) * fse3t(ji,jj,jk)) 
136               ENDIF
137               IF( med_diag%GMED%dgsave ) THEN
138                   fgmed2d(ji,jj) = fgmed2d(ji,jj) +                         &
139                                       (fgmed(ji,jj) * fse3t(ji,jj,jk)) 
140               ENDIF
141               IF( med_diag%MZME%dgsave ) THEN
142                  fdzme2d(ji,jj) = fdzme2d(ji,jj) +                          &
143                                    (fdzme(ji,jj) * fse3t(ji,jj,jk)) 
144               ENDIF
145               !  IF( med_diag%DEXP%dgsave ) THEN
146               !      CALL iom_put( "DEXP"  , ftot_n )
147               !  ENDIF
148            ENDIF
149         ENDDO
150      ENDDO
151
152      DO jj = 2,jpjm1
153         DO ji = 2,jpim1
154            IF (tmask(ji,jj,jk) == 1) THEN
155               IF( med_diag%DETN%dgsave ) THEN
156                  fslown2d(ji,jj) = fslown2d(ji,jj) +                        &
157                                    (fslown(ji,jj) * fse3t(ji,jj,jk)) 
158               ENDIF
159               IF( med_diag%MDET%dgsave ) THEN
160                  fdd2d(ji,jj) = fdd2d(ji,jj) +                              &
161                                 (fdd(ji,jj) * fse3t(ji,jj,jk)) 
162               ENDIF
163            ENDIF
164         ENDDO
165      ENDDO
166
167      DO jj = 2,jpjm1
168         DO ji = 2,jpim1
169            IF (tmask(ji,jj,jk) == 1) THEN
170               IF( med_diag%AEOLIAN%dgsave ) THEN
171                  ffetop2d(ji,jj) = ffetop2d(ji,jj) +                        &
172                                    (ffetop(ji,jj) * fse3t(ji,jj,jk)) 
173               ENDIF
174               IF( med_diag%BENTHIC%dgsave ) THEN
175                  ffebot2d(ji,jj) = ffebot2d(ji,jj) +                        &
176                                    (ffebot(ji,jj) * fse3t(ji,jj,jk)) 
177               ENDIF
178               IF( med_diag%SCAVENGE%dgsave ) THEN
179                  ffescav2d(ji,jj) = ffescav2d(ji,jj) +                      &
180                                     (ffescav(ji,jj) * fse3t(ji,jj,jk)) 
181               ENDIF
182            ENDIF
183         ENDDO
184      ENDDO
185
186      DO jj = 2,jpjm1
187         DO ji = 2,jpim1
188            IF (tmask(ji,jj,jk) == 1) THEN
189               IF( med_diag%PN_JLIM%dgsave ) THEN
190                  ! fjln2d(ji,jj) = fjln2d(ji,jj) +                          &
191                  !                 (fjln(ji,jj)  * zphn(ji,jj) *            &
192                  !                  fse3t(ji,jj,jk))
193                  fjln2d(ji,jj) = fjln2d(ji,jj) +                            &
194                                  (fjlim_pn(ji,jj) * zphn(ji,jj) *           &
195                                   fse3t(ji,jj,jk)) 
196               ENDIF
197               IF( med_diag%PN_NLIM%dgsave ) THEN
198                  fnln2d(ji,jj) = fnln2d(ji,jj) +                            &
199                                  (fnln(ji,jj) * zphn(ji,jj) *               &
200                                   fse3t(ji,jj,jk)) 
201               ENDIF
202               IF( med_diag%PN_FELIM%dgsave ) THEN
203                  ffln2d(ji,jj) = ffln2d(ji,jj) +                            &
204                                  (ffln2(ji,jj) * zphn(ji,jj) *              &
205                                   fse3t(ji,jj,jk)) 
206               ENDIF
207            ENDIF
208         ENDDO
209      ENDDO
210
211      DO jj = 2,jpjm1
212         DO ji = 2,jpim1
213            IF (tmask(ji,jj,jk) == 1) THEN
214               IF( med_diag%PD_JLIM%dgsave ) THEN
215                   ! fjld2d(ji,jj) = fjld2d(ji,jj) +                          &
216                   !                 (fjld(ji,jj)  * zphd(ji,jj) *            &
217                   !                  fse3t(ji,jj,jk))
218                   fjld2d(ji,jj) = fjld2d(ji,jj) +                           &
219                                   (fjlim_pd(ji,jj) * zphd(ji,jj) *          &
220                                    fse3t(ji,jj,jk)) 
221               ENDIF
222               IF( med_diag%PD_NLIM%dgsave ) THEN
223                   fnld2d(ji,jj) = fnld2d(ji,jj) +                           &
224                                   (fnld(ji,jj) * zphd(ji,jj) *              &
225                                    fse3t(ji,jj,jk)) 
226               ENDIF
227               IF( med_diag%PD_FELIM%dgsave ) THEN
228                   ffld2d(ji,jj) = ffld2d(ji,jj) +                           &
229                                   (ffld(ji,jj) * zphd(ji,jj) *              &
230                                    fse3t(ji,jj,jk)) 
231               ENDIF
232               IF( med_diag%PD_SILIM%dgsave ) THEN
233                   fsld2d2(ji,jj) = fsld2d2(ji,jj) +                         &
234                                    (fsld2(ji,jj) * zphd(ji,jj) *            &
235                                     fse3t(ji,jj,jk)) 
236               ENDIF
237               IF( med_diag%PDSILIM2%dgsave ) THEN
238                   fsld2d(ji,jj) = fsld2d(ji,jj) +                           &
239                                   (fsld(ji,jj) * zphd(ji,jj) *              &
240                                    fse3t(ji,jj,jk))
241               ENDIF
242            ENDIF
243         ENDDO
244      ENDDO
245
246      DO jj = 2,jpjm1
247         DO ji = 2,jpim1
248            IF (tmask(ji,jj,jk) == 1) THEN
249               !!
250               IF( med_diag%TOTREG_N%dgsave ) THEN
251                  fregen2d(ji,jj) = fregen2d(ji,jj) + fregen(ji,jj)
252               ENDIF
253               IF( med_diag%TOTRG_SI%dgsave ) THEN
254                  fregensi2d(ji,jj) = fregensi2d(ji,jj) + fregensi(ji,jj)
255               ENDIF
256            ENDIF
257         ENDDO
258      ENDDO
259
260      DO jj = 2,jpjm1
261         DO ji = 2,jpim1
262            IF (tmask(ji,jj,jk) == 1) THEN
263               !!
264               IF( med_diag%FASTN%dgsave ) THEN
265                   ftempn2d(ji,jj) = ftempn2d(ji,jj) +                       &
266                                     (ftempn(ji,jj)  * fse3t(ji,jj,jk))
267               ENDIF
268               IF( med_diag%FASTSI%dgsave ) THEN
269                   ftempsi2d(ji,jj) = ftempsi2d(ji,jj) +                     &
270                                      (ftempsi(ji,jj) * fse3t(ji,jj,jk))
271               ENDIF
272               IF( med_diag%FASTFE%dgsave ) THEN
273                   ftempfe2d(ji,jj) = ftempfe2d(ji,jj) +                     &
274                                      (ftempfe(ji,jj) * fse3t(ji,jj,jk)) 
275               ENDIF
276               IF( med_diag%FASTC%dgsave ) THEN
277                   ftempc2d(ji,jj) = ftempc2d(ji,jj) +                       &
278                                     (ftempc(ji,jj) * fse3t(ji,jj,jk))
279               ENDIF
280               IF( med_diag%FASTCA%dgsave ) THEN
281                   ftempca2d(ji,jj) = ftempca2d(ji,jj) +                     &
282                                      (ftempca(ji,jj) * fse3t(ji,jj,jk))
283               ENDIF
284            ENDIF
285         ENDDO
286      ENDDO
287
288      DO jj = 2,jpjm1
289         DO ji = 2,jpim1
290            IF (tmask(ji,jj,jk) == 1) THEN
291               !!
292               IF( med_diag%REMINN%dgsave ) THEN
293                   freminn2d(ji,jj) = freminn2d(ji,jj) +                     &
294                                      (freminn(ji,jj)  * fse3t(ji,jj,jk))
295               ENDIF
296               IF( med_diag%REMINSI%dgsave ) THEN
297                   freminsi2d(ji,jj) = freminsi2d(ji,jj) +                   &
298                                       (freminsi(ji,jj) * fse3t(ji,jj,jk))
299               ENDIF
300               IF( med_diag%REMINFE%dgsave ) THEN
301                   freminfe2d(ji,jj) = freminfe2d(ji,jj) +                   &
302                                       (freminfe(ji,jj) * fse3t(ji,jj,jk)) 
303               ENDIF
304               IF( med_diag%REMINC%dgsave ) THEN
305                   freminc2d(ji,jj) = freminc2d(ji,jj) +                     &
306                                      (freminc(ji,jj)  * fse3t(ji,jj,jk)) 
307               ENDIF
308               IF( med_diag%REMINCA%dgsave ) THEN
309                   freminca2d(ji,jj) = freminca2d(ji,jj) +                   &
310                                       (freminca(ji,jj) * fse3t(ji,jj,jk)) 
311               ENDIF
312               !!
313            ENDIF
314         ENDDO
315      ENDDO
316
317# if defined key_roam
318      DO jj = 2,jpjm1
319         DO ji = 2,jpim1
320            IF (tmask(ji,jj,jk) == 1) THEN
321               !!
322               !! AXY (09/11/16): CMIP6 diagnostics
323               IF( med_diag%FD_NIT3%dgsave ) THEN
324                  fd_nit3(ji,jj,jk) = ffastn(ji,jj)
325               ENDIF
326               IF( med_diag%FD_SIL3%dgsave ) THEN
327                  fd_sil3(ji,jj,jk) = ffastsi(ji,jj)
328               ENDIF
329               IF( med_diag%FD_CAR3%dgsave ) THEN
330                  fd_car3(ji,jj,jk) = ffastc(ji,jj)
331               ENDIF
332               IF( med_diag%FD_CAL3%dgsave ) THEN
333                  fd_cal3(ji,jj,jk) = ffastca(ji,jj)
334               ENDIF
335            ENDIF
336         ENDDO
337      ENDDO
338
339      IF (jk.eq.i0100) THEN
340         DO jj = 2,jpjm1
341            DO ji = 2,jpim1
342               IF (tmask(ji,jj,jk) == 1) THEN
343                  IF( med_diag%RR_0100%dgsave ) THEN
344                     ffastca2d(ji,jj) =                                      &
345                                ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall)
346                  ENDIF
347               ENDIF
348            ENDDO
349         ENDDO
350      ELSE IF (jk.eq.i0500) THEN
351         DO jj = 2,jpjm1
352            DO ji = 2,jpim1
353               IF (tmask(ji,jj,jk) == 1) THEN
354                  IF( med_diag%RR_0500%dgsave ) THEN
355                     ffastca2d(ji,jj) =                                      &
356                                ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall)
357                  ENDIF
358               ENDIF
359            ENDDO
360         ENDDO
361      ELSE IF (jk.eq.i1000) THEN
362         DO jj = 2,jpjm1
363            DO ji = 2,jpim1
364               IF (tmask(ji,jj,jk) == 1) THEN
365                  IF( med_diag%RR_1000%dgsave ) THEN
366                     ffastca2d(ji,jj) =                                      &
367                                ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall)
368                  ENDIF
369               ENDIF
370            ENDDO
371         ENDDO
372      ELSE
373         DO jj = 2,jpjm1
374            DO ji = 2,jpim1
375               IF (jk.eq.mbathy(ji,jj)) THEN
376                  IF (tmask(ji,jj,jk) == 1) THEN
377                     IF( med_diag%IBEN_N%dgsave ) THEN
378                        iben_n2d(ji,jj) = f_sbenin_n(ji,jj) +                &
379                                          f_fbenin_n(ji,jj)
380                     ENDIF
381                     IF( med_diag%IBEN_FE%dgsave ) THEN
382                        iben_fe2d(ji,jj) = f_sbenin_fe(ji,jj) +              &
383                                           f_fbenin_fe(ji,jj)
384                     ENDIF
385                     IF( med_diag%IBEN_C%dgsave ) THEN
386                        iben_c2d(ji,jj) = f_sbenin_c(ji,jj) +                &
387                                          f_fbenin_c(ji,jj)
388                     ENDIF
389                     IF( med_diag%IBEN_SI%dgsave ) THEN
390                        iben_si2d(ji,jj) = f_fbenin_si(ji,jj)
391                     ENDIF
392                     IF( med_diag%IBEN_CA%dgsave ) THEN
393                        iben_ca2d(ji,jj) = f_fbenin_ca(ji,jj)
394                     ENDIF
395                     IF( med_diag%OBEN_N%dgsave ) THEN
396                        oben_n2d(ji,jj) = f_benout_n(ji,jj)
397                     ENDIF
398                     IF( med_diag%OBEN_FE%dgsave ) THEN
399                        oben_fe2d(ji,jj) = f_benout_fe(ji,jj)
400                     ENDIF
401                     IF( med_diag%OBEN_C%dgsave ) THEN
402                        oben_c2d(ji,jj) = f_benout_c(ji,jj)
403                     ENDIF
404                     IF( med_diag%OBEN_SI%dgsave ) THEN
405                        oben_si2d(ji,jj) = f_benout_si(ji,jj)
406                     ENDIF
407                     IF( med_diag%OBEN_CA%dgsave ) THEN
408                        oben_ca2d(ji,jj) = f_benout_ca(ji,jj)
409                     ENDIF
410                     IF( med_diag%SFR_OCAL%dgsave ) THEN
411                        sfr_ocal2d(ji,jj) = f3_omcal(ji,jj,jk)
412                     ENDIF
413                     IF( med_diag%SFR_OARG%dgsave ) THEN
414                        sfr_oarg2d(ji,jj) =  f3_omarg(ji,jj,jk)
415                     ENDIF
416                     IF( med_diag%LYSO_CA%dgsave ) THEN
417                        lyso_ca2d(ji,jj) = f_benout_lyso_ca(ji,jj)
418                     ENDIF
419                  ENDIF
420               ENDIF
421            ENDDO
422         ENDDO
423      ENDIF
424      !! end bathy-1 diags
425
426      DO jj = 2,jpjm1
427         DO ji = 2,jpim1
428            IF (tmask(ji,jj,jk) == 1) THEN
429               !!
430               IF( med_diag%RIV_N%dgsave ) THEN
431                  rivn2d(ji,jj) = rivn2d(ji,jj) +                            &
432                                  (f_riv_loc_n(ji,jj) * fse3t(ji,jj,jk))
433               ENDIF
434               IF( med_diag%RIV_SI%dgsave ) THEN
435                  rivsi2d(ji,jj) = rivsi2d(ji,jj) +                          &
436                                   (f_riv_loc_si(ji,jj) * fse3t(ji,jj,jk))
437               ENDIF
438               IF( med_diag%RIV_C%dgsave ) THEN
439                  rivc2d(ji,jj) = rivc2d(ji,jj) +                            &
440                                  (f_riv_loc_c(ji,jj) * fse3t(ji,jj,jk))
441               ENDIF
442               IF( med_diag%RIV_ALK%dgsave ) THEN
443                  rivalk2d(ji,jj) = rivalk2d(ji,jj) +                        &
444                                    (f_riv_loc_alk(ji,jj) *                  &
445                                     fse3t(ji,jj,jk))
446               ENDIF
447               IF( med_diag%DETC%dgsave ) THEN
448                  fslowc2d(ji,jj) = fslowc2d(ji,jj) +                        &
449                                    (fslowc(ji,jj)  * fse3t(ji,jj,jk))   
450               ENDIF
451            ENDIF
452         ENDDO
453      ENDDO
454
455      DO jj = 2,jpjm1
456         DO ji = 2,jpim1
457            IF (tmask(ji,jj,jk) == 1) THEN
458               !!
459               IF( med_diag%PN_LLOSS%dgsave ) THEN
460                  fdpn22d(ji,jj) = fdpn22d(ji,jj) +                          &
461                                   (fdpn2(ji,jj)  * fse3t(ji,jj,jk))
462               ENDIF
463               IF( med_diag%PD_LLOSS%dgsave ) THEN
464                  fdpd22d(ji,jj) = fdpd22d(ji,jj) +                          &
465                                   (fdpd2(ji,jj)  * fse3t(ji,jj,jk))
466               ENDIF
467            ENDIF
468         ENDDO
469      ENDDO
470
471      DO jj = 2,jpjm1
472         DO ji = 2,jpim1
473            IF (tmask(ji,jj,jk) == 1) THEN
474               IF( med_diag%ZI_LLOSS%dgsave ) THEN
475                  fdzmi22d(ji,jj) = fdzmi22d(ji,jj) +                        &
476                                    (fdzmi2(ji,jj) * fse3t(ji,jj,jk))
477               ENDIF
478               IF( med_diag%ZE_LLOSS%dgsave ) THEN
479                  fdzme22d(ji,jj) = fdzme22d(ji,jj) +                        &
480                                    (fdzme2(ji,jj) * fse3t(ji,jj,jk))
481               ENDIF
482            ENDIF
483         ENDDO
484      ENDDO
485
486      DO jj = 2,jpjm1
487         DO ji = 2,jpim1
488            IF (tmask(ji,jj,jk) == 1) THEN
489               IF( med_diag%ZI_MES_N%dgsave ) THEN
490                  zimesn2d(ji,jj) = zimesn2d(ji,jj) +                        &
491                                    (xphi * (fgmipn(ji,jj) +                 &
492                                             fgmid(ji,jj)) *                 &
493                                     fse3t(ji,jj,jk))
494               ENDIF
495               IF( med_diag%ZI_MES_D%dgsave ) THEN
496                  zimesd2d(ji,jj) = zimesd2d(ji,jj) +                        & 
497                                    ((1. - xbetan) * finmi(ji,jj) *          &
498                                     fse3t(ji,jj,jk))
499               ENDIF
500               IF( med_diag%ZI_MES_C%dgsave ) THEN
501                  zimesc2d(ji,jj) = zimesc2d(ji,jj) +                        &
502                                    (xphi * ((xthetapn * fgmipn(ji,jj)) +    &
503                                             fgmidc(ji,jj)) *                &
504                                             fse3t(ji,jj,jk))
505               ENDIF
506               IF( med_diag%ZI_MESDC%dgsave ) THEN
507                  zimesdc2d(ji,jj) = zimesdc2d(ji,jj) +                      &
508                                     ((1. - xbetac) * ficmi(ji,jj) *         &
509                                      fse3t(ji,jj,jk))
510               ENDIF
511               IF( med_diag%ZI_EXCR%dgsave ) THEN
512                  ziexcr2d(ji,jj) = ziexcr2d(ji,jj) +                        &
513                                    (fmiexcr(ji,jj) * fse3t(ji,jj,jk))
514               ENDIF
515               IF( med_diag%ZI_RESP%dgsave ) THEN
516                  ziresp2d(ji,jj) = ziresp2d(ji,jj) +                        &
517                                    (fmiresp(ji,jj) * fse3t(ji,jj,jk))
518               ENDIF
519               IF( med_diag%ZI_GROW%dgsave ) THEN
520                  zigrow2d(ji,jj) = zigrow2d(ji,jj) +                        &
521                                    (fmigrow(ji,jj) * fse3t(ji,jj,jk))
522               ENDIF
523            ENDIF
524         ENDDO
525      ENDDO
526
527      DO jj = 2,jpjm1
528         DO ji = 2,jpim1
529            IF (tmask(ji,jj,jk) == 1) THEN
530               IF( med_diag%ZE_MES_N%dgsave ) THEN
531                  zemesn2d(ji,jj) = zemesn2d(ji,jj) +                        &
532                                    (xphi *                                  &
533                                     (fgmepn(ji,jj) + fgmepd(ji,jj) +        &
534                                      fgmezmi(ji,jj) + fgmed(ji,jj)) *       &
535                                     fse3t(ji,jj,jk))
536               ENDIF
537               IF( med_diag%ZE_MES_D%dgsave ) THEN
538                  zemesd2d(ji,jj) = zemesd2d(ji,jj) +                        &
539                                    ((1. - xbetan) * finme(ji,jj) *          &
540                                     fse3t(ji,jj,jk))
541               ENDIF
542               IF( med_diag%ZE_MES_C%dgsave ) THEN
543                  zemesc2d(ji,jj) = zemesc2d(ji,jj) +                        & 
544                                    (xphi *                                  &
545                                     ((xthetapn * fgmepn(ji,jj)) +           &
546                                      (xthetapd * fgmepd(ji,jj)) +           &
547                                      (xthetazmi * fgmezmi(ji,jj)) +         &
548                                      fgmedc(ji,jj)) * fse3t(ji,jj,jk))
549               ENDIF
550               IF( med_diag%ZE_MESDC%dgsave ) THEN
551                  zemesdc2d(ji,jj) = zemesdc2d(ji,jj) +                      &
552                                     ((1. - xbetac) * ficme(ji,jj) *         &
553                                      fse3t(ji,jj,jk))
554               ENDIF
555               IF( med_diag%ZE_EXCR%dgsave ) THEN
556                  zeexcr2d(ji,jj) = zeexcr2d(ji,jj) +                        &
557                                    (fmeexcr(ji,jj) * fse3t(ji,jj,jk))
558               ENDIF
559               IF( med_diag%ZE_RESP%dgsave ) THEN
560                  zeresp2d(ji,jj) = zeresp2d(ji,jj) +                        &
561                                    (fmeresp(ji,jj) * fse3t(ji,jj,jk))
562               ENDIF
563               IF( med_diag%ZE_GROW%dgsave ) THEN
564                  zegrow2d(ji,jj) = zegrow2d(ji,jj) +                        &
565                                    (fmegrow(ji,jj) * fse3t(ji,jj,jk))
566               ENDIF
567            ENDIF
568         ENDDO
569      ENDDO
570
571      DO jj = 2,jpjm1
572         DO ji = 2,jpim1
573            IF (tmask(ji,jj,jk) == 1) THEN
574              IF( med_diag%MDETC%dgsave ) THEN
575                  mdetc2d(ji,jj) = mdetc2d(ji,jj) +                          &
576                                   (fddc(ji,jj) * fse3t(ji,jj,jk))
577               ENDIF
578               IF( med_diag%GMIDC%dgsave ) THEN
579                  gmidc2d(ji,jj) = gmidc2d(ji,jj) +                          &
580                                   (fgmidc(ji,jj) * fse3t(ji,jj,jk))
581               ENDIF
582               IF( med_diag%GMEDC%dgsave ) THEN
583                  gmedc2d(ji,jj) = gmedc2d(ji,jj) +                          &
584                                   (fgmedc(ji,jj) * fse3t(ji,jj,jk))
585               ENDIF
586            ENDIF
587         ENDDO
588      ENDDO
589# endif                   
590
591      DO jj = 2,jpjm1
592         DO ji = 2,jpim1
593            IF (tmask(ji,jj,jk) == 1) THEN
594               !!
595               !! ** 3D diagnostics
596               IF( med_diag%TPP3%dgsave ) THEN
597                  tpp3d(ji,jj,jk) = (fprn(ji,jj) * zphn(ji,jj)) +            &
598                                    (fprd(ji,jj) * zphd(ji,jj))
599                  !CALL iom_put( "TPP3"  , tpp3d )
600               ENDIF
601               IF( med_diag%TPPD3%dgsave ) THEN
602                  tppd3(ji,jj,jk) = (fprd(ji,jj) * zphd(ji,jj))
603               ENDIF
604            ENDIF
605         ENDDO
606      ENDDO
607
608      DO jj = 2,jpjm1
609         DO ji = 2,jpim1
610            IF (tmask(ji,jj,jk) == 1) THEN
611                 
612               IF( med_diag%REMIN3N%dgsave ) THEN
613                  !! remineralisation
614                  remin3dn(ji,jj,jk) = fregen(ji,jj) +                       &
615                                       (freminn(ji,jj) * fse3t(ji,jj,jk))
616                  !CALL iom_put( "REMIN3N"  , remin3dn )
617               ENDIF
618               !! IF( med_diag%PH3%dgsave ) THEN
619               !!     CALL iom_put( "PH3"  , f3_pH )
620               !! ENDIF
621               !! IF( med_diag%OM_CAL3%dgsave ) THEN
622               !!     CALL iom_put( "OM_CAL3"  , f3_omcal )
623               !! ENDIF
624          !!
625          !! AXY (09/11/16): CMIP6 diagnostics
626          IF ( med_diag%DCALC3%dgsave   ) THEN
627                  dcalc3(ji,jj,jk) = freminca(ji,jj)
628               ENDIF
629            ENDIF
630         ENDDO
631      ENDDO
632
633      DO jj = 2,jpjm1
634         DO ji = 2,jpim1
635            IF (tmask(ji,jj,jk) == 1) THEN
636          IF ( med_diag%FEDISS3%dgsave  ) THEN
637                  fediss3(ji,jj,jk) = ffetop(ji,jj)
638               ENDIF
639          IF ( med_diag%FESCAV3%dgsave  ) THEN
640                  fescav3(ji,jj,jk) = ffescav(ji,jj)
641               ENDIF
642            ENDIF
643         ENDDO
644      ENDDO
645
646      DO jj = 2,jpjm1
647         DO ji = 2,jpim1
648            IF (tmask(ji,jj,jk) == 1) THEN
649          IF ( med_diag%MIGRAZP3%dgsave ) THEN
650                  migrazp3(ji,jj,jk) = fgmipn(ji,jj) * xthetapn
651               ENDIF
652          IF ( med_diag%MIGRAZD3%dgsave ) THEN
653                  migrazd3(ji,jj,jk) = fgmidc(ji,jj)
654               ENDIF
655          IF ( med_diag%MEGRAZP3%dgsave ) THEN
656                  megrazp3(ji,jj,jk) = (fgmepn(ji,jj) * xthetapn) +          &
657                                       (fgmepd(ji,jj) * xthetapd)
658               ENDIF
659          IF ( med_diag%MEGRAZD3%dgsave ) THEN
660                  megrazd3(ji,jj,jk) = fgmedc(ji,jj)
661               ENDIF
662          IF ( med_diag%MEGRAZZ3%dgsave ) THEN
663                   megrazz3(ji,jj,jk) = (fgmezmi(ji,jj) * xthetazmi)
664               ENDIF
665            ENDIF
666         ENDDO
667      ENDDO
668
669      DO jj = 2,jpjm1
670         DO ji = 2,jpim1
671            IF (tmask(ji,jj,jk) == 1) THEN
672          IF ( med_diag%PBSI3%dgsave    ) THEN
673                  pbsi3(ji,jj,jk)    = (fprds(ji,jj) * zpds(ji,jj))
674               ENDIF
675          IF ( med_diag%PCAL3%dgsave    ) THEN
676                  pcal3(ji,jj,jk)    = ftempca(ji,jj)
677               ENDIF
678          IF ( med_diag%REMOC3%dgsave   ) THEN
679                  remoc3(ji,jj,jk)   = freminc(ji,jj)
680               ENDIF
681            ENDIF
682         ENDDO
683      ENDDO
684
685      DO jj = 2,jpjm1
686         DO ji = 2,jpim1
687            IF (tmask(ji,jj,jk) == 1) THEN
688          IF ( med_diag%PNLIMJ3%dgsave  ) THEN
689                  ! pnlimj3(ji,jj,jk)  = fjln(ji,jj)
690                  pnlimj3(ji,jj,jk)  = fjlim_pn(ji,jj)
691               ENDIF
692          IF ( med_diag%PNLIMN3%dgsave  ) THEN
693                  pnlimn3(ji,jj,jk)  = fnln(ji,jj)
694               ENDIF
695          IF ( med_diag%PNLIMFE3%dgsave ) THEN
696                  pnlimfe3(ji,jj,jk) = ffln2(ji,jj)
697               ENDIF
698          IF ( med_diag%PDLIMJ3%dgsave  ) THEN
699                  ! pdlimj3(ji,jj,jk)  = fjld(ji,jj)
700                  pdlimj3(ji,jj,jk)  = fjlim_pd(ji,jj)
701               ENDIF
702          IF ( med_diag%PDLIMN3%dgsave  ) THEN
703                  pdlimn3(ji,jj,jk)  = fnld(ji,jj)
704               ENDIF
705          IF ( med_diag%PDLIMFE3%dgsave ) THEN
706                  pdlimfe3(ji,jj,jk) = ffld(ji,jj)
707               ENDIF
708          IF ( med_diag%PDLIMSI3%dgsave ) THEN
709                  pdlimsi3(ji,jj,jk) = fsld2(ji,jj)
710               ENDIF
711            ENDIF
712         ENDDO
713      ENDDO
714
715   END SUBROUTINE bio_med_diag_iomput
716
717#else
718   !!======================================================================
719   !!  Dummy module :                                   No MEDUSA bio-model
720   !!======================================================================
721CONTAINS
722   SUBROUTINE bio_med_diag_iomput( )                    ! Empty routine
723      IMPLICIT NONE
724      WRITE(*,*) 'bio_med_diag_iomput: You should not have seen this print! error?'
725   END SUBROUTINE bio_med_diag_iomput
726#endif 
727
728   !!======================================================================
729END MODULE bio_med_diag_iomput_mod
Note: See TracBrowser for help on using the repository browser.