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

source: branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/TOP_SRC/MEDUSA/zooplankton.F90 @ 11738

Last change on this file since 11738 was 11738, checked in by marc, 5 years ago

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