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

source: branches/NERC/dev_r5518_GO6_conserv_check_up/NEMOGCM/NEMO/TOP_SRC/MEDUSA/zooplankton.F90 @ 9260

Last change on this file since 9260 was 8441, checked in by frrh, 7 years ago

Commit changes relating to Met Office GMED ticket 339 for the modularisation of
of trcbio_medusa.F90.

Branch http://fcm3/projects/NEMO.xm/log/branches/NERC/dev_r5518_GO6_split_trcbiomedusa
from revisions 8394 to 8423 inclusive refer.

File size: 15.3 KB
Line 
1MODULE zooplankton_mod
2   !!======================================================================
3   !!                         ***  MODULE zooplankton_mod  ***
4   !! Calculates the zooplankton grazing
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   zooplankton        ! Called in plankton.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 zooplankton( jk )
28      !!------------------------------------------------------------------
29      !!                     ***  ROUTINE zooplankton  ***
30      !! This called from PLANKTON and calculates the zooplankton
31      !! grazing
32      !!------------------------------------------------------------------
33      USE bio_medusa_mod,    ONLY: fgmed, fgmedc, fgmepd, fgmepds,       &
34                                   fgmepn, fgmezmi,                      & 
35                                   fgmid, fgmidc, fgmipn,                &
36                                   ficme, ficmi, finme, finmi,           &
37                                   fmeexcr, fmegrow, fmeresp,            &
38                                   fmiexcr, fmigrow, fmiresp,            & 
39                                   fsin,                                 &
40                                   fzme_i, fzme_o, fzmi_i, fzmi_o,       &
41                                   idf, idfval,                          &
42                                   zdet, zdtc, zphd, zphn, zzme, zzmi
43      USE dom_oce,           ONLY: e3t_0, e3t_n, tmask
44      USE par_kind,          ONLY: wp
45      USE in_out_manager,    ONLY: lwp, numout
46      USE par_oce,           ONLY: jpim1, jpjm1
47      USE phycst,            ONLY: rsmall
48      USE sms_medusa,        ONLY: xbetac, xbetan, xgme, xgmi,           &
49                                   xkc, xkme, xkmi, xphi,                &
50                                   xpmed, xpmepd, xpmepn, xpmezmi,       &
51                                   xpmid, xpmipn,                        &
52                                   xthetapd, xthetapn,                   &
53                                   xthetazme, xthetazmi
54
55   !!* Substitution
56#  include "domzgr_substitute.h90"
57
58      !! Level
59      INTEGER, INTENT( in ) :: jk
60
61      INTEGER :: ji, jj
62
63      !! Microzooplankton grazing
64      REAL(wp) :: fmi1, fmi
65      REAL(wp) :: fstarmi, fmith
66      !!
67      !! Mesozooplankton grazing
68      REAL(wp) :: fme1, fme
69      REAL(wp) :: fstarme, fmeth
70
71      DO jj = 2,jpjm1
72         DO ji = 2,jpim1
73            !! OPEN wet point IF..THEN loop
74            if (tmask(ji,jj,jk) == 1) then
75
76               !!----------------------------------------------------------
77               !! Zooplankton Grazing
78               !! this code supplements the base grazing model with one that
79               !! considers the C:N ratio of grazed food and balances this
80               !! against the requirements of zooplankton growth; this model
81               !! is derived from that of Anderson & Pondaven (2003)
82               !!
83               !! The current version of the code assumes a fixed C:N ratio
84               !! for detritus (in contrast to Anderson & Pondaven, 2003),
85               !! though the full equations are retained for future extension
86               !!----------------------------------------------------------
87               !!
88               !!----------------------------------------------------------
89               !! Microzooplankton first
90               !!----------------------------------------------------------
91               !!
92               fmi1           = (xkmi * xkmi) + (xpmipn * zphn(ji,jj) *      &
93                                                 zphn(ji,jj)) +              &
94                                (xpmid * zdet(ji,jj) * zdet(ji,jj))
95               fmi            = xgmi * zzmi(ji,jj) / fmi1
96               !! grazing on non-diatoms
97               fgmipn(ji,jj)  = fmi * xpmipn * zphn(ji,jj) * zphn(ji,jj)
98               !! grazing on detrital nitrogen
99               fgmid(ji,jj)   = fmi * xpmid  * zdet(ji,jj) * zdet(ji,jj)
100# if defined key_roam   
101               ! acc           
102               fgmidc(ji,jj)  = rsmall
103               !! grazing on detrital carbon
104               IF ( zdet(ji,jj) .GT. rsmall ) fgmidc(ji,jj)  =               &
105                  (zdtc(ji,jj) / (zdet(ji,jj) + tiny(zdet(ji,jj)))) *        &
106                  fgmid(ji,jj)
107# else
108               !! AXY (26/11/08): implicit detrital carbon change
109               !! grazing on detrital carbon
110               fgmidc(ji,jj)  = xthetad * fgmid(ji,jj)
111# endif
112# if defined key_debug_medusa
113               !! report microzooplankton grazing
114               if (idf.eq.1.AND.idfval.eq.1) then
115                  IF (lwp) write (numout,*) '------------------------------'
116                  IF (lwp) write (numout,*) 'fmi1(',jk,')    = ', fmi1
117               endif
118# endif
119            ENDIF
120         ENDDO
121      ENDDO
122
123      DO jj = 2,jpjm1
124         DO ji = 2,jpim1
125            if (tmask(ji,jj,jk) == 1) then
126               !!
127               !! which translates to these incoming N and C fluxes
128               finmi(ji,jj)   = (1.0 - xphi) * (fgmipn(ji,jj) + fgmid(ji,jj))
129               ficmi(ji,jj)   = (1.0 - xphi) * ((xthetapn * fgmipn(ji,jj)) + &
130                                                fgmidc(ji,jj))
131               !!
132               !! the ideal food C:N ratio for microzooplankton
133               !! xbetan = 0.77; xthetaz = 5.625; xbetac = 0.64; xkc = 0.80
134               fstarmi = (xbetan * xthetazmi) / (xbetac * xkc)
135               !!
136               !! process these to determine proportioning of grazed N and C
137               !! (since there is no explicit consideration of respiration,
138               !! only growth and excretion are calculated here)
139               fmith = (ficmi(ji,jj) / (finmi(ji,jj) + tiny(finmi(ji,jj))))
140               if (fmith.ge.fstarmi) then
141                  fmigrow(ji,jj) = xbetan * finmi(ji,jj)
142                  fmiexcr(ji,jj) = 0.0
143               else
144                  fmigrow(ji,jj) = (xbetac * xkc * ficmi(ji,jj)) / xthetazmi
145                  fmiexcr(ji,jj) = ficmi(ji,jj) *                            &
146                                   ((xbetan / (fmith + tiny(fmith))) -       &
147                                    ((xbetac * xkc) / xthetazmi))
148               endif
149# if defined key_roam
150               fmiresp(ji,jj) = (xbetac * ficmi(ji,jj)) -                    &
151                                (xthetazmi * fmigrow(ji,jj))
152# endif
153
154# if defined key_debug_medusa
155               !! report microzooplankton grazing
156               if (idf.eq.1.AND.idfval.eq.1) then
157                  IF (lwp) write (numout,*) '------------------------------'
158                  IF (lwp) write (numout,*) 'fgmipn(',jk,')  = ', fgmipn(ji,jj)
159                  IF (lwp) write (numout,*) 'fgmid(',jk,')   = ', fgmid(ji,jj)
160                  IF (lwp) write (numout,*) 'fgmidc(',jk,')  = ', fgmidc(ji,jj)
161                  IF (lwp) write (numout,*) 'finmi(',jk,')   = ', finmi(ji,jj)
162                  IF (lwp) write (numout,*) 'ficmi(',jk,')   = ', ficmi(ji,jj)
163                  IF (lwp) write (numout,*) 'fstarmi(',jk,') = ', fstarmi
164                  IF (lwp) write (numout,*) 'fmith(',jk,')   = ', fmith
165                  IF (lwp) write (numout,*) 'fmigrow(',jk,') = ', fmigrow(ji,jj)
166                  IF (lwp) write (numout,*) 'fmiexcr(',jk,') = ', fmiexcr(ji,jj)
167#  if defined key_roam
168                  IF (lwp) write (numout,*) 'fmiresp(',jk,') = ', fmiresp(ji,jj)
169#  endif
170               endif
171# endif
172            ENDIF
173         ENDDO
174      ENDDO
175
176      DO jj = 2,jpjm1
177         DO ji = 2,jpim1
178            if (tmask(ji,jj,jk) == 1) then
179               !!----------------------------------------------------------
180               !! Mesozooplankton second
181               !!----------------------------------------------------------
182               !!
183               fme1           = (xkme * xkme) + (xpmepn * zphn(ji,jj) *       &
184                                                 zphn(ji,jj)) +               &
185                                (xpmepd * zphd(ji,jj) * zphd(ji,jj)) +        & 
186                                (xpmezmi * zzmi(ji,jj) * zzmi(ji,jj)) +       &
187                                (xpmed * zdet(ji,jj) * zdet(ji,jj))
188               fme            = xgme * zzme(ji,jj) / fme1
189               !! grazing on non-diatoms
190               fgmepn(ji,jj)  = fme * xpmepn  * zphn(ji,jj) * zphn(ji,jj)
191               !! grazing on diatoms
192               fgmepd(ji,jj)  = fme * xpmepd  * zphd(ji,jj) * zphd(ji,jj)
193               !! grazing on diatom silicon
194               fgmepds(ji,jj) = fsin(ji,jj) * fgmepd(ji,jj)
195               !! grazing on microzooplankton
196               fgmezmi(ji,jj) = fme * xpmezmi * zzmi(ji,jj) * zzmi(ji,jj)
197               !! grazing on detrital nitrogen
198               fgmed(ji,jj)   = fme * xpmed   * zdet(ji,jj) * zdet(ji,jj)
199# if defined key_roam
200               !! acc
201               fgmedc(ji,jj)  = rsmall
202               !! grazing on detrital carbon
203               IF ( zdet(ji,jj) .GT. rsmall ) fgmedc(ji,jj)  = (zdtc(ji,jj) / &
204                  (zdet(ji,jj) + tiny(zdet(ji,jj)))) * fgmed(ji,jj)
205# else
206               !! AXY (26/11/08): implicit detrital carbon change
207               !! grazing on detrital carbon
208               fgmedc(ji,jj)  = xthetad * fgmed(ji,jj)
209# endif
210               !!
211               !! which translates to these incoming N and C fluxes
212               finme(ji,jj)   = (1.0 - xphi) *                               &
213                                (fgmepn(ji,jj) + fgmepd(ji,jj) +             &
214                                 fgmezmi(ji,jj) + fgmed(ji,jj))
215               ficme(ji,jj)   = (1.0 - xphi) *                               &
216                                ((xthetapn * fgmepn(ji,jj)) +                &
217                                (xthetapd * fgmepd(ji,jj)) +                 &
218                                (xthetazmi * fgmezmi(ji,jj)) + fgmedc(ji,jj))
219# if defined key_debug_medusa
220               !! report mesozooplankton grazing
221               if (idf.eq.1.AND.idfval.eq.1) then
222                  IF (lwp) write (numout,*) '------------------------------'
223                  IF (lwp) write (numout,*) 'fme1(',jk,')    = ', fme1
224                  IF (lwp) write (numout,*) 'fme(',jk,')     = ', fme
225               endif
226# endif
227            ENDIF
228         ENDDO
229      ENDDO
230
231      DO jj = 2,jpjm1
232         DO ji = 2,jpim1
233            if (tmask(ji,jj,jk) == 1) then
234               !!
235               !! the ideal food C:N ratio for mesozooplankton
236               !! xbetan = 0.77; xthetaz = 5.625; xbetac = 0.64; xkc = 0.80
237               fstarme        = (xbetan * xthetazme) / (xbetac * xkc)
238               !!
239               !! process these to determine proportioning of grazed N and C
240               !! (since there is no explicit consideration of respiration,
241               !! only growth and excretion are calculated here)
242               fmeth   = (ficme(ji,jj) / (finme(ji,jj) + tiny(finme(ji,jj))))
243               if (fmeth.ge.fstarme) then
244                  fmegrow(ji,jj) = xbetan * finme(ji,jj)
245                  fmeexcr(ji,jj) = 0.0
246               else
247                  fmegrow(ji,jj) = (xbetac * xkc * ficme(ji,jj)) / xthetazme
248                  fmeexcr(ji,jj) = ficme(ji,jj) *                            &
249                                   ((xbetan / (fmeth + tiny(fmeth))) -       &
250                                    ((xbetac * xkc) / xthetazme))
251               endif
252# if defined key_roam
253               fmeresp(ji,jj) = (xbetac * ficme(ji,jj)) - (xthetazme *       &
254                                                           fmegrow(ji,jj))
255# endif
256
257# if defined key_debug_medusa
258               !! report mesozooplankton grazing
259               if (idf.eq.1.AND.idfval.eq.1) then
260                  IF (lwp) write (numout,*) '------------------------------'
261                  IF (lwp) write (numout,*) 'fgmepn(',jk,')  = ', fgmepn(ji,jj)
262                  IF (lwp) write (numout,*) 'fgmepd(',jk,')  = ', fgmepd(ji,jj)
263                  IF (lwp) write (numout,*) 'fgmepds(',jk,') = ', fgmepds(ji,jj)
264                  IF (lwp) write (numout,*) 'fgmezmi(',jk,') = ', fgmezmi(ji,jj)
265                  IF (lwp) write (numout,*) 'fgmed(',jk,')   = ', fgmed(ji,jj)
266                  IF (lwp) write (numout,*) 'fgmedc(',jk,')  = ', fgmedc(ji,jj)
267                  IF (lwp) write (numout,*) 'finme(',jk,')   = ', finme(ji,jj)
268                  IF (lwp) write (numout,*) 'ficme(',jk,')   = ', ficme(ji,jj)
269                  IF (lwp) write (numout,*) 'fstarme(',jk,') = ', fstarme
270                  IF (lwp) write (numout,*) 'fmeth(',jk,')   = ', fmeth
271                  IF (lwp) write (numout,*) 'fmegrow(',jk,') = ', fmegrow(ji,jj)
272                  IF (lwp) write (numout,*) 'fmeexcr(',jk,') = ', fmeexcr(ji,jj)
273#  if defined key_roam
274                  IF (lwp) write (numout,*) 'fmeresp(',jk,') = ', fmeresp(ji,jj)
275#  endif
276               endif
277# endif
278            ENDIF
279         ENDDO
280      ENDDO
281
282      DO jj = 2,jpjm1
283         DO ji = 2,jpim1
284            if (tmask(ji,jj,jk) == 1) then
285               fzmi_i(ji,jj)  = fzmi_i(ji,jj)  + fse3t(ji,jj,jk) *          &
286                                ( fgmipn(ji,jj) + fgmid(ji,jj) )
287               fzmi_o(ji,jj)  = fzmi_o(ji,jj)  + fse3t(ji,jj,jk) *          &
288                                ( fmigrow(ji,jj) +                          &
289                                  (xphi * (fgmipn(ji,jj) + fgmid(ji,jj))) + &
290                                  fmiexcr(ji,jj) + ((1.0 - xbetan) *        &
291                                                    finmi(ji,jj)) )
292               fzme_i(ji,jj)  = fzme_i(ji,jj)  + fse3t(ji,jj,jk) *          &
293                                ( fgmepn(ji,jj) + fgmepd(ji,jj) +           &
294                                  fgmezmi(ji,jj) + fgmed(ji,jj) )
295               fzme_o(ji,jj)  = fzme_o(ji,jj)  + fse3t(ji,jj,jk) *          &
296                                ( fmegrow(ji,jj) +                          &
297                                  (xphi * (fgmepn(ji,jj) + fgmepd(ji,jj) +  &
298                                  fgmezmi(ji,jj) + fgmed(ji,jj))) +         &
299                                  fmeexcr(ji,jj) + ((1.0 - xbetan) *        &
300                                                    finme(ji,jj)) )
301            ENDIF
302         ENDDO
303      ENDDO
304
305   END SUBROUTINE zooplankton
306
307#else
308   !!======================================================================
309   !!  Dummy module :                                   No MEDUSA bio-model
310   !!======================================================================
311CONTAINS
312   SUBROUTINE zooplankton( )                    ! Empty routine
313      WRITE(*,*) 'zooplankton: You should not have seen this print! error?'
314   END SUBROUTINE zooplankton
315#endif 
316
317   !!======================================================================
318END MODULE zooplankton_mod
Note: See TracBrowser for help on using the repository browser.