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/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/TOP_SRC/MEDUSA – NEMO

source: branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_med_diag_iomput.F90 @ 11738

Last change on this file since 11738 was 11738, checked in by marc, 5 years ago

The Dr Hook changes from my perl code.

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