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

source: branches/UKMO/dev_r5518_medusa_chg_trc_bio_medusa/NEMOGCM/NEMO/TOP_SRC/MEDUSA/zooplankton.F90 @ 8076

Last change on this file since 8076 was 8076, checked in by marc, 7 years ago

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