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 @ 7975

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

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