New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
bio_medusa_diag.F90 in branches/UKMO/dev_r5518_GO6_fix_cpp_keys/NEMOGCM/NEMO/TOP_SRC/MEDUSA – NEMO

source: branches/UKMO/dev_r5518_GO6_fix_cpp_keys/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_medusa_diag.F90 @ 10004

Last change on this file since 10004 was 10004, checked in by frrh, 6 years ago

Various fixes
File size: 8.9 KB
Line 
1MODULE bio_medusa_diag_mod
2   !!======================================================================
3   !!                         ***  MODULE bio_medusa_diag_mod  ***
4   !! Calculates diagnostics
5   !!======================================================================
6   !! History :
7   !!   -   ! 2017-04 (M. Stringer)        Code taken from trcbio_medusa.F90
8   !!----------------------------------------------------------------------
9#if defined key_medusa
10   !!----------------------------------------------------------------------
11   !!                                                   MEDUSA bio-model
12   !!----------------------------------------------------------------------
13
14   IMPLICIT NONE
15   PRIVATE
16     
17   PUBLIC   bio_medusa_diag        ! Called in trcbio_medusa.F90
18
19   !!----------------------------------------------------------------------
20   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)
21   !! $Id$
22   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
23   !!----------------------------------------------------------------------
24
25CONTAINS
26
27   SUBROUTINE bio_medusa_diag( jk )
28      !!-------------------------------------------------------------------
29      !!                     ***  ROUTINE bio_medusa_diag  ***
30      !! This called from TRC_BIO_MEDUSA and calculates diagnostics
31      !!-------------------------------------------------------------------
32      USE bio_med_diag_iomput_mod,  ONLY: bio_med_diag_iomput
33      USE bio_medusa_mod
34      USE dom_oce,                  ONLY: e3t_0, gdepw_0, tmask
35      USE in_out_manager,           ONLY: lwp, numout
36      USE iom,                      ONLY: lk_iomput
37      USE par_oce,                  ONLY: jpim1, jpjm1
38      USE sms_medusa,               ONLY: xrfn, xthetapd, xthetapn,      &
39                                          xthetazme, xthetazmi
40      USE trc,                      ONLY: med_diag 
41# if defined key_roam
42      USE trcoxy_medusa,            ONLY: oxy_sato
43# endif
44
45   !!* Substitution
46#  include "domzgr_substitute.h90"
47
48      !! level
49      INTEGER, INTENT( in ) :: jk
50
51      !! Loop avariables
52      INTEGER :: ji, jj, jn
53
54# if defined key_trc_diabio
55      !!==========================================================
56      !! LOCAL GRID CELL DIAGNOSTICS
57      !!==========================================================
58      !!
59      !!----------------------------------------------------------
60      !! Full diagnostics key_trc_diabio:
61      !! LOBSTER and PISCES support full diagnistics option
62      !! key_trc_diabio which gives an option of FULL output of
63      !! biological sourses and sinks. I cannot see any reason
64      !! for doing this. If needed, it can be done as shown
65      !! below.
66      !!----------------------------------------------------------
67      !!
68      IF(lwp) WRITE(numout,*) ' MEDUSA does not support key_trc_diabio'
69# endif
70
71      !! The section below, down to calculation of zo2min, was moved
72      !! from before the call to AIR_SEA in trcbio_medusa.F90 - marc 9/5/17
73      IF( lk_iomput ) THEN
74         DO jj = 2,jpjm1
75            DO ji = 2,jpim1
76               if (tmask(ji,jj,jk) == 1) then
77                  !! sum tracers for inventory checks
78                  IF ( med_diag%INVTN%dgsave )   THEN
79                     ftot_n(ji,jj)  = ftot_n(ji,jj) +                        &
80                        (fse3t(ji,jj,jk) * (zphn(ji,jj) + zphd(ji,jj) +      &
81                                            zzmi(ji,jj) + zzme(ji,jj) +      &
82                                            zdet(ji,jj) + zdin(ji,jj)))
83                  ENDIF
84                  IF ( med_diag%INVTSI%dgsave )  THEN
85                     ftot_si(ji,jj) = ftot_si(ji,jj) +                       & 
86                       (fse3t(ji,jj,jk) * (zpds(ji,jj) + zsil(ji,jj)))
87                  ENDIF
88                  IF ( med_diag%INVTFE%dgsave )  THEN
89                     ftot_fe(ji,jj) = ftot_fe(ji,jj) +                       & 
90                        (fse3t(ji,jj,jk) * (xrfn *                           &
91                                            (zphn(ji,jj) + zphd(ji,jj) +     &
92                                             zzmi(ji,jj) + zzme(ji,jj) +     &
93                                             zdet(ji,jj)) +                  &
94                                            zfer(ji,jj)))
95                  ENDIF
96               ENDIF
97            ENDDO
98         ENDDO
99
100# if defined key_roam
101         DO jj = 2,jpjm1
102            DO ji = 2,jpim1
103               if (tmask(ji,jj,jk) == 1) then
104                  IF ( med_diag%INVTC%dgsave )  THEN
105                     ftot_c(ji,jj)  = ftot_c(ji,jj) +                        & 
106                        (fse3t(ji,jj,jk) * ((xthetapn * zphn(ji,jj)) +       &
107                                            (xthetapd * zphd(ji,jj)) +       &
108                                            (xthetazmi * zzmi(ji,jj)) +      &
109                                            (xthetazme * zzme(ji,jj)) +      &
110                                            zdtc(ji,jj) + zdic(ji,jj)))
111                  ENDIF
112                  IF ( med_diag%INVTALK%dgsave ) THEN
113                     ftot_a(ji,jj)  = ftot_a(ji,jj) + (fse3t(ji,jj,jk) *     &
114                                                       zalk(ji,jj))
115                  ENDIF
116                  IF ( med_diag%INVTO2%dgsave )  THEN
117                     ftot_o2(ji,jj) = ftot_o2(ji,jj) + (fse3t(ji,jj,jk) *    &
118                                                        zoxy(ji,jj))
119                  ENDIF
120               ENDIF
121            ENDDO
122         ENDDO
123
124         DO jj = 2,jpjm1
125            DO ji = 2,jpim1
126               if (tmask(ji,jj,jk) == 1) then
127                  IF ( med_diag%INVTC%dgsave )  THEN
128                     !!
129                     !! AXY (10/11/16): CMIP6 diagnostics
130                     IF ( med_diag%INTDISSIC%dgsave ) THEN
131                        intdissic(ji,jj) = intdissic(ji,jj) +                &
132                                           (fse3t(ji,jj,jk) * zdic(ji,jj))
133                     ENDIF
134                     IF ( med_diag%INTDISSIN%dgsave ) THEN
135                        intdissin(ji,jj) = intdissin(ji,jj) +                &
136                                           (fse3t(ji,jj,jk) * zdin(ji,jj))
137                     ENDIF
138                     IF ( med_diag%INTDISSISI%dgsave ) THEN
139                        intdissisi(ji,jj) = intdissisi(ji,jj) +              &
140                                            (fse3t(ji,jj,jk) * zsil(ji,jj))
141                     ENDIF
142                     IF ( med_diag%INTTALK%dgsave ) THEN
143                        inttalk(ji,jj) = inttalk(ji,jj) +                    &
144                                         (fse3t(ji,jj,jk) * zalk(ji,jj))
145                     ENDIF
146                  ENDIF
147               ENDIF
148            ENDDO
149         ENDDO
150
151         DO jj = 2,jpjm1
152            DO ji = 2,jpim1
153               if (tmask(ji,jj,jk) == 1) then
154                  IF ( med_diag%O2min%dgsave ) THEN
155                     if ( zoxy(ji,jj) < o2min(ji,jj) ) then
156                        o2min(ji,jj)  = zoxy(ji,jj)
157                        IF ( med_diag%ZO2min%dgsave ) THEN
158                           !! layer midpoint
159                           zo2min(ji,jj) = (fsdepw(ji,jj,jk) +               &
160                                            fdep1(ji,jj)) / 2.0
161                        ENDIF
162                     endif
163                  ENDIF
164               ENDIF
165            ENDDO
166         ENDDO
167# endif
168      ENDIF
169
170# if defined key_roam
171      !! This section is moved from just below CALL to AIR_SEA in
172      !! trcbio_medusa.F90 - marc 9/5/17
173      DO jj = 2,jpjm1
174         DO ji = 2,jpim1
175            !! OPEN wet point IF..THEN loop
176            if (tmask(ji,jj,jk) == 1) then
177
178               !! AXY (11/11/16): CMIP6 oxygen saturation 3D diagnostic
179               IF ( med_diag%O2SAT3%dgsave ) THEN
180! Remove f_o2sat3 - marc 9/5/17
181!                  call oxy_sato( ztmp(ji,jj), zsal(ji,jj), f_o2sat3 )
182!                  o2sat3(ji, jj, jk) = f_o2sat3
183                  call oxy_sato( ztmp(ji,jj), zsal(ji,jj),                   &
184                                 o2sat3(ji,jj,jk) )
185               ENDIF
186            ENDIF
187         ENDDO
188      ENDDO
189# endif
190
191      !!---------------------------------------------------------------
192      !! Calculates the diagnostics used with iom_put
193      !!---------------------------------------------------------------
194      CALL bio_med_diag_iomput( jk )
195
196   END SUBROUTINE bio_medusa_diag
197
198#else
199   !!======================================================================
200   !!  Dummy module :                                   No MEDUSA bio-model
201   !!======================================================================
202CONTAINS
203   SUBROUTINE bio_medusa_diag( )                    ! Empty routine
204      WRITE(*,*) 'bio_medusa_diag: You should not have seen this print! error?'
205   END SUBROUTINE bio_medusa_diag
206#endif 
207
208   !!======================================================================
209END MODULE bio_medusa_diag_mod
Note: See TracBrowser for help on using the repository browser.