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

source: branches/NERC/dev_r5518_GO6_CO2_cmip/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_med_diag_iomput.F90 @ 9309

Last change on this file since 9309 was 8442, checked in by frrh, 7 years ago

Commit changes relating to Met Office GMED ticket 340 for the
tidying of MEDUSA related code and debugging statements in the TOP code.

Only code introduced at revision 8434 of branch
http://fcm3/projects/NEMO.xm/log/branches/NERC/dev_r5518_GO6_split_trcbiomedusa
is included here, all previous revisions of that branch having been dealt with
under GMED ticket 339.

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