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

source: branches/UKMO/dev_r5518_GO6_package_FOAMv14_bgcupdates/NEMOGCM/NEMO/TOP_SRC/MEDUSA/zooplankton.F90 @ 10232

Last change on this file since 10232 was 10232, checked in by dford, 5 years ago

Merge in revisions 8447:10159 of dev_r5518_GO6_package.

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