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.
p4zmeso.F90 in NEMO/branches/2019/dev_r11708_aumont_PISCES_QUOTA/src/TOP/PISCES/P4Z – NEMO

source: NEMO/branches/2019/dev_r11708_aumont_PISCES_QUOTA/src/TOP/PISCES/P4Z/p4zmeso.F90 @ 12524

Last change on this file since 12524 was 12524, checked in by aumont, 5 years ago

DVM of mesozooplankton + slight changes on prognostic ligands
  • Property svn:keywords set to Id
File size: 27.8 KB
Line 
1MODULE p4zmeso
2   !!======================================================================
3   !!                         ***  MODULE p4zmeso  ***
4   !! TOP :   PISCES Compute the sources/sinks for mesozooplankton
5   !!======================================================================
6   !! History :   1.0  !  2002     (O. Aumont) Original code
7   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
8   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Quota model for iron
9   !!----------------------------------------------------------------------
10   !!   p4z_meso       : Compute the sources/sinks for mesozooplankton
11   !!   p4z_meso_init  : Initialization of the parameters for mesozooplankton
12   !!----------------------------------------------------------------------
13   USE oce_trc         ! shared variables between ocean and passive tracers
14   USE trc             ! passive tracers common variables
15   USE sms_pisces      ! PISCES Source Minus Sink variables
16   USE p4zprod         ! production
17   USE prtctl_trc      ! print control for debugging
18   USE iom             ! I/O manager
19
20   IMPLICIT NONE
21   PRIVATE
22
23   PUBLIC   p4z_meso              ! called in p4zbio.F90
24   PUBLIC   p4z_meso_init         ! called in trcsms_pisces.F90
25   PUBLIC   p4z_meso_alloc
26
27   REAL(wp), PUBLIC ::  part2        !: part of calcite not dissolved in mesozoo guts
28   REAL(wp), PUBLIC ::  xpref2d      !: mesozoo preference for diatoms
29   REAL(wp), PUBLIC ::  xpref2n      !: mesozoo preference for nanophyto
30   REAL(wp), PUBLIC ::  xpref2z      !: mesozoo preference for microzooplankton
31   REAL(wp), PUBLIC ::  xpref2c      !: mesozoo preference for POC
32   REAL(wp), PUBLIC ::  xthresh2zoo  !: zoo feeding threshold for mesozooplankton
33   REAL(wp), PUBLIC ::  xthresh2dia  !: diatoms feeding threshold for mesozooplankton
34   REAL(wp), PUBLIC ::  xthresh2phy  !: nanophyto feeding threshold for mesozooplankton
35   REAL(wp), PUBLIC ::  xthresh2poc  !: poc feeding threshold for mesozooplankton
36   REAL(wp), PUBLIC ::  xthresh2     !: feeding threshold for mesozooplankton
37   REAL(wp), PUBLIC ::  resrat2      !: exsudation rate of mesozooplankton
38   REAL(wp), PUBLIC ::  mzrat2       !: microzooplankton mortality rate
39   REAL(wp), PUBLIC ::  grazrat2     !: maximal mesozoo grazing rate
40   REAL(wp), PUBLIC ::  xkgraz2      !: non assimilated fraction of P by mesozoo
41   REAL(wp), PUBLIC ::  unass2       !: Efficicency of mesozoo growth
42   REAL(wp), PUBLIC ::  sigma2       !: Fraction of mesozoo excretion as DOM
43   REAL(wp), PUBLIC ::  epsher2      !: growth efficiency
44   REAL(wp), PUBLIC ::  epsher2min   !: minimum growth efficiency at high food for grazing 2
45   REAL(wp), PUBLIC ::  grazflux     !: mesozoo flux feeding rate
46   REAL(wp), PUBLIC ::  xfracmig     !: Fractional biomass of meso that performs DVM
47   LOGICAL , PUBLIC ::  ln_dvm_meso  !: Boolean to activate DVM of mesozooplankton
48   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: depmig
49   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:) :: kmig 
50
51   !!----------------------------------------------------------------------
52   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
53   !! $Id$
54   !! Software governed by the CeCILL license (see ./LICENSE)
55   !!----------------------------------------------------------------------
56CONTAINS
57
58   SUBROUTINE p4z_meso( kt, knt )
59      !!---------------------------------------------------------------------
60      !!                     ***  ROUTINE p4z_meso  ***
61      !!
62      !! ** Purpose :   Compute the sources/sinks for mesozooplankton
63      !!
64      !! ** Method  : - ???
65      !!---------------------------------------------------------------------
66      INTEGER, INTENT(in) ::   kt, knt   ! ocean time step and ???
67      !
68      INTEGER  :: ji, jj, jk, jkt
69      REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz, zcompam
70      REAL(wp) :: zgraze2 , zdenom, zdenom2
71      REAL(wp) :: zfact   , zfood, zfoodlim, zproport, zbeta
72      REAL(wp) :: zmortzgoc, zfrac, zfracfe, zratio, zratio2, zfracal, zgrazcal
73      REAL(wp) :: zepsherf, zepshert, zepsherq, zepsherv, zgrarsig, zgraztotc, zgraztotn, zgraztotf
74      REAL(wp) :: zmigreltime, zprcaca, zmortz, zgrasrat, zgrasratn
75      REAL(wp) :: zrespz, ztortz, zgrazd, zgrazz, zgrazpof
76      REAL(wp) :: zgrazn, zgrazpoc, zgraznf, zgrazf
77      REAL(wp) :: zgrazfffp, zgrazfffg, zgrazffep, zgrazffeg
78      REAL(wp) :: zrum, zcodel, zargu, zval
79      CHARACTER (len=25) :: charout
80      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing, zfezoo2
81      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrarem, zgraref, zgrapoc, zgrapof
82      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   zgramigrem, zgramigref, zgramigpoc, zgramigpof, zstrn
83      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zw3d, zz2ligprod
84      !!---------------------------------------------------------------------
85      !
86      IF( ln_timing )   CALL timing_start('p4z_meso')
87      !
88      zgrazing(:,:,:) = 0._wp
89      zfezoo2 (:,:,:) = 0._wp
90      !
91      IF (ln_ligand) THEN
92         ALLOCATE( zz2ligprod(jpi,jpj,jpk) )
93         zz2ligprod(:,:,:) = 0._wp
94      ENDIF
95      !
96      ! Diurnal vertical migration of mesozooplankton
97      ! ---------------------------------------------
98      IF (ln_dvm_meso) CALL p4z_meso_depmig
99      !
100      DO jk = 1, jpkm1
101         DO jj = 1, jpj
102            DO ji = 1, jpi
103               zcompam   = MAX( ( trb(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 )
104               zfact     = xstep * tgfunc2(ji,jj,jk) * zcompam
105
106               !  Respiration rates of both zooplankton
107               !  -------------------------------------
108               zrespz    = resrat2 * zfact * ( trb(ji,jj,jk,jpmes) / ( xkmort + trb(ji,jj,jk,jpmes) )  &
109               &           + 3. * nitrfac(ji,jj,jk) )
110
111               !  Zooplankton mortality. A square function has been selected with
112               !  no real reason except that it seems to be more stable and may mimic predation
113               !  ---------------------------------------------------------------
114               ztortz    = mzrat2 * 1.e6 * zfact * trb(ji,jj,jk,jpmes)  * (1. - nitrfac(ji,jj,jk) )
115               !
116               zcompadi  = MAX( ( trb(ji,jj,jk,jpdia) - xthresh2dia ), 0.e0 )
117               zcompaz   = MAX( ( trb(ji,jj,jk,jpzoo) - xthresh2zoo ), 0.e0 )
118               zcompapoc = MAX( ( trb(ji,jj,jk,jppoc) - xthresh2poc ), 0.e0 )
119               ! Size effect of nanophytoplankton on grazing : the smaller it is, the less prone
120               ! it is to predation by mesozooplankton
121               ! -------------------------------------------------------------------------------
122               zcompaph  = MAX( ( trb(ji,jj,jk,jpphy) - xthresh2phy ), 0.e0 ) &
123                  &      * MIN(1., MAX( 0., ( quotan(ji,jj,jk) - 0.2) / 0.3 ) )
124
125               ! Mesozooplankton grazing
126               ! ------------------------
127               zfood     = xpref2d * zcompadi + xpref2z * zcompaz + xpref2n * zcompaph + xpref2c * zcompapoc 
128               zfoodlim  = MAX( 0., zfood - MIN( 0.5 * zfood, xthresh2 ) )
129               zdenom    = zfoodlim / ( xkgraz2 + zfoodlim )
130               zdenom2   = zdenom / ( zfood + rtrn )
131               zgraze2   = grazrat2 * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpmes) * (1. - nitrfac(ji,jj,jk)) 
132
133               zgrazd    = zgraze2  * xpref2d  * zcompadi  * zdenom2 
134               zgrazz    = zgraze2  * xpref2z  * zcompaz   * zdenom2 
135               zgrazn    = zgraze2  * xpref2n  * zcompaph  * zdenom2 
136               zgrazpoc  = zgraze2  * xpref2c  * zcompapoc * zdenom2 
137
138               zgraznf   = zgrazn   * trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn)
139               zgrazf    = zgrazd   * trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn)
140               zgrazpof  = zgrazpoc * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn)
141
142               !  Mesozooplankton flux feeding on GOC
143               !  ----------------------------------
144               zgrazffeg = grazflux  * xstep * wsbio4(ji,jj,jk)      &
145               &           * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes) &
146               &           * (1. - nitrfac(ji,jj,jk))
147               zgrazfffg = zgrazffeg * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn)
148               zgrazffep = grazflux  * xstep *  wsbio3(ji,jj,jk)     &
149               &           * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpmes) &
150               &           * (1. - nitrfac(ji,jj,jk))
151               zgrazfffp = zgrazffep * trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn)
152               !
153               zgraztotc = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep + zgrazffeg
154               ! Compute the proportion of filter feeders
155               zproport  = (zgrazffep + zgrazffeg)/(rtrn + zgraztotc)
156               ! Compute fractionation of aggregates. It is assumed that
157               ! diatoms based aggregates are more prone to fractionation
158               ! since they are more porous (marine snow instead of fecal pellets)
159               zratio    = trb(ji,jj,jk,jpgsi) / ( trb(ji,jj,jk,jpgoc) + rtrn )
160               zratio2   = zratio * zratio
161               zfrac     = zproport * grazflux  * xstep * wsbio4(ji,jj,jk)      &
162               &          * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes)          &
163               &          * ( 0.2 + 3.8 * zratio2 / ( 1.**2 + zratio2 ) )
164               zfracfe   = zfrac * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn)
165
166               zgrazffep = zproport * zgrazffep
167               zgrazffeg = zproport * zgrazffeg
168               zgrazfffp = zproport * zgrazfffp
169               zgrazfffg = zproport * zgrazfffg
170               zgraztotc = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep + zgrazffeg
171               zgraztotn = zgrazd * quotad(ji,jj,jk) + zgrazz + zgrazn * quotan(ji,jj,jk)   &
172               &   + zgrazpoc + zgrazffep + zgrazffeg
173               zgraztotf = zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfffp + zgrazfffg
174
175               ! Total grazing ( grazing by microzoo is already computed in p4zmicro )
176               zgrazing(ji,jj,jk) = zgraztotc
177
178               !    Mesozooplankton efficiency
179               !    --------------------------
180               zgrasrat  =  ( zgraztotf + rtrn )/ ( zgraztotc + rtrn )
181               zgrasratn =  ( zgraztotn + rtrn )/ ( zgraztotc + rtrn )
182               zepshert  = MIN( 1., zgrasratn, zgrasrat / ferat3)
183               zbeta     = MAX(0., (epsher2 - epsher2min) )
184               zepsherf  = epsher2min + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta ) 
185               zepsherq  = 0.5 + (1.0 - 0.5) * zepshert * ( 1.0 + 1.0 ) / ( zepshert + 1.0 )
186               zepsherv  = zepsherf * zepshert * zepsherq
187               !
188               ! Impact of grazing on the prognostic variables
189               ! ---------------------------------------------
190               zmortz = ztortz + zrespz
191               zmortzgoc = unass2 / ( 1. - epsher2 ) * ztortz + zrespz
192               tra(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) - zmortz + zepsherv * zgraztotc
193               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazd
194               tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zgrazz
195               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazn
196               tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) - zgrazn * trb(ji,jj,jk,jpnch) / ( trb(ji,jj,jk,jpphy) + rtrn )
197               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) - zgrazd * trb(ji,jj,jk,jpdch) / ( trb(ji,jj,jk,jpdia) + rtrn )
198               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zgrazd * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn )
199               tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zgrazd * trb(ji,jj,jk,jpdsi) / ( trb(ji,jj,jk,jpdia) + rtrn )
200               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zgraznf
201               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazf
202               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zgrazpoc - zgrazffep + zfrac
203               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zfrac
204               conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc - zgrazffep
205               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) - zgrazffeg - zfrac
206               consgoc(ji,jj,jk) = consgoc(ji,jj,jk) - zgrazffeg - zfrac
207               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zgrazpof - zgrazfffp + zfracfe
208               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) - zgrazfffg - zfracfe
209               ! Calcite remineralization due to zooplankton activity
210               zfracal = trb(ji,jj,jk,jpcal) / (trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpgoc) + rtrn )
211               zgrazcal = (zgrazffeg + zgrazpoc) * (1. - part2) * zfracal
212               ! calcite production by zooplankton activity
213               zprcaca = xfracal(ji,jj,jk) * zgrazn
214               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo)
215               !
216               zprcaca = part2 * zprcaca
217               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrazcal - zprcaca
218               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * ( zgrazcal + zprcaca )
219               tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) - zgrazcal + zprcaca
220               
221               ! Correct the fluxes for the effect of DVM
222               ! A fixed fraction of mesozooplankton is assumed to migrate
223               ! ---------------------------------------------------------
224               zgrarem(ji,jj,jk) = zgraztotc * ( 1. - zepsherv - unass2 ) &
225               &         + ( 1. - epsher2 - unass2 ) / ( 1. - epsher2 ) * ztortz
226               zgraref(ji,jj,jk) = zgraztotc * MAX( 0. , ( 1. - unass2 ) * zgrasrat - ferat3 * zepsherv )    &
227               &         + ferat3 * ( ( 1. - epsher2 - unass2 ) /( 1. - epsher2 ) * ztortz )
228               zgrapoc(ji,jj,jk) = zgraztotc * unass2 + zmortzgoc
229               zgrapof(ji,jj,jk) = zgraztotf * unass2 + ferat3 * zmortzgoc
230            END DO
231         END DO
232      END DO
233
234      IF (ln_dvm_meso) THEN
235         ALLOCATE( zgramigrem(jpi,jpj), zgramigref(jpi,jpj), zgramigpoc(jpi,jpj), zgramigpof(jpi,jpj) )
236         ALLOCATE( zstrn(jpi,jpj) )
237         zgramigrem(:,:) = 0.0    ;   zgramigref(:,:) = 0.0
238         zgramigpoc(:,:)  = 0.0   ;   zgramigpof(:,:) = 0.0
239
240         ! compute the day length depending on latitude and the day
241         zrum = REAL( nday_year - 80, wp ) / REAL( nyear_len(1), wp )
242         zcodel = ASIN(  SIN( zrum * rpi * 2._wp ) * SIN( rad * 23.5_wp )  )
243
244         ! day length in hours
245         zstrn(:,:) = 0.
246         DO jj = 1, jpj
247            DO ji = 1, jpi
248               zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad )
249               zargu = MAX( -1., MIN(  1., zargu ) )
250               zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. )
251               zstrn(ji,jj) = MIN(0.75, MAX( 0.25, zstrn(ji,jj) / 24.) )
252            END DO
253         END DO
254
255
256         DO jk = 1, jpk
257            DO jj = 1, jpj
258               DO ji = 1, jpi
259
260                  !   Compute the amount of materials that will go into vertical migration
261                  zmigreltime = (1. - zstrn(ji,jj))
262                  IF ( gdept_n(ji,jj,jk) <= heup(ji,jj) ) THEN
263                     zgramigrem(ji,jj) = zgramigrem(ji,jj) + xfracmig * zgrarem(ji,jj,jk) * (1. - zmigreltime )    &
264                     &                   * e3t_n(ji,jj,jk) * tmask(ji,jj,jk)
265                     zgramigref(ji,jj) = zgramigref(ji,jj) + xfracmig * zgraref(ji,jj,jk) * (1. - zmigreltime )   &
266                     &                   * e3t_n(ji,jj,jk) * tmask(ji,jj,jk)
267                     zgramigpoc(ji,jj) = zgramigpoc(ji,jj) + xfracmig * zgrapoc(ji,jj,jk) * (1. - zmigreltime )   &
268                     &                   * e3t_n(ji,jj,jk) * tmask(ji,jj,jk)
269                     zgramigpof(ji,jj) = zgramigpof(ji,jj) + xfracmig * zgrapof(ji,jj,jk) * (1. - zmigreltime )   &
270                     &                   * e3t_n(ji,jj,jk) * tmask(ji,jj,jk)
271
272                     zgrarem(ji,jj,jk) = zgrarem(ji,jj,jk) * ( (1.0 - xfracmig) + xfracmig * zmigreltime )
273                     zgraref(ji,jj,jk) = zgraref(ji,jj,jk) * ( (1.0 - xfracmig) + xfracmig * zmigreltime )
274                     zgrapoc(ji,jj,jk) = zgrapoc(ji,jj,jk) * ( (1.0 - xfracmig) + xfracmig * zmigreltime )
275                     zgrapof(ji,jj,jk) = zgrapof(ji,jj,jk) * ( (1.0 - xfracmig) + xfracmig * zmigreltime )
276                  ENDIF
277               END DO
278            END DO
279         END DO
280     
281         DO jj = 1, jpj
282            DO ji = 1, jpi
283               IF (tmask(ji,jj,1) == 1.) THEN
284                  jkt = kmig(ji,jj)
285                  zgrarem(ji,jj,jkt) = zgrarem(ji,jj,jkt) + zgramigrem(ji,jj) / e3t_n(ji,jj,jkt) 
286                  zgraref(ji,jj,jkt) = zgraref(ji,jj,jkt) + zgramigref(ji,jj) / e3t_n(ji,jj,jkt)
287                  zgrapoc(ji,jj,jkt) = zgrapoc(ji,jj,jkt) + zgramigpoc(ji,jj) / e3t_n(ji,jj,jkt)
288                  zgrapof(ji,jj,jkt) = zgrapof(ji,jj,jkt) + zgramigpof(ji,jj) / e3t_n(ji,jj,jkt)
289               ENDIF
290            END DO
291         END DO
292         !
293         ! Deallocate temporary variables
294         ! ------------------------------
295         DEALLOCATE( zgramigrem, zgramigref, zgramigpoc, zgramigpof )
296         DEALLOCATE( zstrn )
297
298      ENDIF
299
300      DO jk = 1, jpk
301         DO jj = 1, jpj
302            DO ji = 1, jpi
303               !   Update the arrays TRA which contain the biological sources and sinks
304               zgrarsig  = zgrarem(ji,jj,jk) * sigma2
305               tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarsig
306               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarsig
307               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem(ji,jj,jk) - zgrarsig
308               !
309               IF( ln_ligand ) THEN
310                  tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + (zgrarem(ji,jj,jk) - zgrarsig) * ldocz
311                  zz2ligprod(ji,jj,jk) = (zgrarem(ji,jj,jk) - zgrarsig) * ldocz
312               ENDIF
313               !
314               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarsig
315               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgraref(ji,jj,jk)
316               zfezoo2(ji,jj,jk)   = zgraref(ji,jj,jk)
317               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarsig
318               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgrarsig             
319               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zgrapoc(ji,jj,jk)
320               prodgoc(ji,jj,jk)   = prodgoc(ji,jj,jk)   + zgrapoc(ji,jj,jk)
321               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zgrapof(ji,jj,jk)
322            END DO
323         END DO
324      END DO
325      !
326      IF( lk_iomput .AND. knt == nrdttrc ) THEN
327         ALLOCATE( zw3d(jpi,jpj,jpk) )
328         IF( iom_use( "GRAZ2" ) ) THEN
329            zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:)  !   Total grazing of phyto by zooplankton
330            CALL iom_put( "GRAZ2", zw3d )
331         ENDIF
332         IF( iom_use( "PCAL" ) ) THEN
333            zw3d(:,:,:) = prodcal(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:)   !  Calcite production
334            CALL iom_put( "PCAL", zw3d ) 
335         ENDIF
336         IF( iom_use( "FEZOO2" ) ) THEN
337            zw3d(:,:,:) = zfezoo2(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:)   !
338            CALL iom_put( "FEZOO2", zw3d )
339         ENDIF
340         IF( iom_use( "LPRODZ2" ) .AND. ln_ligand )  THEN
341            zw3d(:,:,:) = zz2ligprod(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:)
342            CALL iom_put( "LPRODZ2"  , zw3d )
343         ENDIF
344         DEALLOCATE( zw3d )
345      ENDIF
346      !
347      IF (ln_ligand)  DEALLOCATE( zz2ligprod )
348      !
349      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
350        WRITE(charout, FMT="('meso')")
351        CALL prt_ctl_trc_info(charout)
352        CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
353      ENDIF
354      !
355      IF( ln_timing )   CALL timing_stop('p4z_meso')
356      !
357   END SUBROUTINE p4z_meso
358
359
360   SUBROUTINE p4z_meso_init
361      !!----------------------------------------------------------------------
362      !!                  ***  ROUTINE p4z_meso_init  ***
363      !!
364      !! ** Purpose :   Initialization of mesozooplankton parameters
365      !!
366      !! ** Method  :   Read the nampismes namelist and check the parameters
367      !!      called at the first timestep (nittrc000)
368      !!
369      !! ** input   :   Namelist nampismes
370      !!----------------------------------------------------------------------
371      INTEGER ::   ios   ! Local integer
372      !
373      NAMELIST/namp4zmes/ part2, grazrat2, resrat2, mzrat2, xpref2n, xpref2d, xpref2z,   &
374         &                xpref2c, xthresh2dia, xthresh2phy, xthresh2zoo, xthresh2poc, &
375         &                xthresh2, xkgraz2, epsher2, epsher2min, sigma2, unass2, grazflux, ln_dvm_meso,  &
376         &                xfracmig
377      !!----------------------------------------------------------------------
378      !
379      IF(lwp) THEN
380         WRITE(numout,*) 
381         WRITE(numout,*) 'p4z_meso_init : Initialization of mesozooplankton parameters'
382         WRITE(numout,*) '~~~~~~~~~~~~~'
383      ENDIF
384      !
385      REWIND( numnatp_ref )              ! Namelist nampismes in reference namelist : Pisces mesozooplankton
386      READ  ( numnatp_ref, namp4zmes, IOSTAT = ios, ERR = 901)
387901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namp4zmes in reference namelist' )
388      REWIND( numnatp_cfg )              ! Namelist nampismes in configuration namelist : Pisces mesozooplankton
389      READ  ( numnatp_cfg, namp4zmes, IOSTAT = ios, ERR = 902 )
390902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namp4zmes in configuration namelist' )
391      IF(lwm) WRITE( numonp, namp4zmes )
392      !
393      IF(lwp) THEN                         ! control print
394         WRITE(numout,*) '   Namelist : namp4zmes'
395         WRITE(numout,*) '      part of calcite not dissolved in mesozoo guts  part2        =', part2
396         WRITE(numout,*) '      mesozoo preference for phyto                   xpref2n      =', xpref2n
397         WRITE(numout,*) '      mesozoo preference for diatoms                 xpref2d      =', xpref2d
398         WRITE(numout,*) '      mesozoo preference for zoo                     xpref2z      =', xpref2z
399         WRITE(numout,*) '      mesozoo preference for poc                     xpref2c      =', xpref2c
400         WRITE(numout,*) '      microzoo feeding threshold  for mesozoo        xthresh2zoo  =', xthresh2zoo
401         WRITE(numout,*) '      diatoms feeding threshold  for mesozoo         xthresh2dia  =', xthresh2dia
402         WRITE(numout,*) '      nanophyto feeding threshold for mesozoo        xthresh2phy  =', xthresh2phy
403         WRITE(numout,*) '      poc feeding threshold for mesozoo              xthresh2poc  =', xthresh2poc
404         WRITE(numout,*) '      feeding threshold for mesozooplankton          xthresh2     =', xthresh2
405         WRITE(numout,*) '      exsudation rate of mesozooplankton             resrat2      =', resrat2
406         WRITE(numout,*) '      mesozooplankton mortality rate                 mzrat2       =', mzrat2
407         WRITE(numout,*) '      maximal mesozoo grazing rate                   grazrat2     =', grazrat2
408         WRITE(numout,*) '      mesozoo flux feeding rate                      grazflux     =', grazflux
409         WRITE(numout,*) '      non assimilated fraction of P by mesozoo       unass2       =', unass2
410         WRITE(numout,*) '      Efficiency of Mesozoo growth                   epsher2      =', epsher2
411         WRITE(numout,*) '      Minimum Efficiency of Mesozoo growth           epsher2min   =', epsher2min
412         WRITE(numout,*) '      Fraction of mesozoo excretion as DOM           sigma2       =', sigma2
413         WRITE(numout,*) '      half sturation constant for grazing 2          xkgraz2      =', xkgraz2
414         WRITE(numout,*) '      Diurnal vertical migration of mesozoo.         ln_dvm_meso  =', ln_dvm_meso
415         WRITE(numout,*) '      Fractional biomass of meso  that performs DVM  xfracmig     =', xfracmig
416      ENDIF
417      !
418   END SUBROUTINE p4z_meso_init
419
420   SUBROUTINE p4z_meso_depmig 
421      !!----------------------------------------------------------------------
422      !!                  ***  ROUTINE p4z_meso_depmig  ***
423      !!
424      !! ** Purpose :   Computation the migration depth of mesozooplankton
425      !!
426      !! ** Method  :   Computes the DVM depth of mesozooplankton from oxygen
427      !!      temperature and chlorophylle following the parameterization
428      !!      proposed by Bianchi et al. (2013)
429      !!
430      !! ** input   :   
431      !!----------------------------------------------------------------------
432      INTEGER  :: ji, jj, jk
433      !
434      REAL(wp) :: totchl
435      REAL(wp), DIMENSION(jpi,jpj) :: oxymoy, tempmoy, zdepmoy
436
437      !!---------------------------------------------------------------------
438      !
439      IF( ln_timing == 1 )  CALL timing_start('p4z_meso_zdepmig')
440      !
441      oxymoy(:,:)  = 0.
442      tempmoy(:,:) = 0.
443      zdepmoy(:,:) = 0.
444      depmig (:,:) = 5.
445      kmig   (:,:) = 1
446      !
447      ! Compute the averaged values of oxygen, temperature over the domain
448      ! 150m to 500 m depth.
449      !
450      DO jk =1, jpk
451         DO jj = 1, jpj
452            DO ji = 1, jpi
453               IF (tmask(ji,jj,jk) == 1.) THEN
454                  IF (gdept_n(ji,jj,jk) >= 150. .AND. gdept_n(ji,jj,jk) <= 500.) THEN
455                     oxymoy(ji,jj) = oxymoy(ji,jj) + trb(ji,jj,jk,jpoxy)*e3t_n(ji,jj,jk)*1E6
456                     tempmoy(ji,jj) = tempmoy(ji,jj) + tsn(ji,jj,jk,jp_tem)*e3t_n(ji,jj,jk)
457                     zdepmoy(ji,jj) = zdepmoy(ji,jj) + e3t_n(ji,jj,jk)
458                  ENDIF
459               ENDIF
460            END DO
461         END DO
462      END DO
463
464      DO jj = 1, jpj
465         DO ji = 1, jpi
466            oxymoy(ji,jj) = trb(ji,jj,1,jpoxy)*1E6 - oxymoy(ji,jj) / (zdepmoy(ji,jj) + rtrn)
467            tempmoy(ji,jj) = tsn(ji,jj,1,jp_tem)-tempmoy(ji,jj) / (zdepmoy(ji,jj) + rtrn)
468         END DO
469      END DO
470      !
471      ! Computation of the migration depth based on the parameterization of
472      ! Bianchi et al. (2013)
473      ! -------------------------------------------------------------------
474      !
475      DO jj = 1, jpj
476         DO ji = 1, jpi
477            IF (tmask(ji,jj,1) == 1.) THEN
478               totchl = (trb(ji,jj,1,jpnch)+trb(ji,jj,1,jpdch))*1E6
479               depmig(ji,jj) = 398. - 0.56 * oxymoy(ji,jj) -115. * log10(totchl) + 0.36 * hmld(ji,jj) -2.4 * tempmoy(ji,jj)
480            ENDIF
481         END DO
482      END DO
483      !
484      ! Computation of the corresponding jk indice
485      ! ------------------------------------------
486      !
487      DO jk = 1, jpk-1
488         DO jj = 1, jpj
489            DO ji = 1, jpi
490               IF (depmig(ji,jj) .GE. gdepw_n(ji,jj,jk) .AND. depmig(ji,jj) .LT. gdepw_n(ji,jj,jk+1) ) THEN
491                  kmig(ji,jj) = jk
492               ENDIF
493            END DO
494         END DO
495      END DO
496      !
497      ! Correction of the migration depth and indice based on O2 levels
498      ! If O2 is too low, imposing a migration depth at this low O2 levels
499      ! would lead to negative O2 concentrations (respiration while O2 is close
500      ! to 0. Thus, to avoid that problem, the migration depth is adjusted so
501      ! that it falls above the OMZ
502      ! -----------------------------------------------------------------------
503      !
504      DO ji =1, jpi
505         DO jj = 1, jpj
506            IF (trb(ji,jj,kmig(ji,jj),jpoxy) < 5E-6) THEN
507               DO jk = kmig(ji,jj),1,-1
508                  IF (trb(ji,jj,jk,jpoxy) >= 5E-6 .AND. trb(ji,jj,jk+1,jpoxy)  < 5E-6) THEN
509                     kmig(ji,jj) = jk
510                     depmig(ji,jj) = gdept_n(ji,jj,jk)
511                  ENDIF
512               END DO
513            ENDIF
514         END DO
515      END DO
516      !
517      IF( ln_timing )   CALL timing_stop('p4z_meso_depmig')
518      !
519   END SUBROUTINE p4z_meso_depmig
520
521   INTEGER FUNCTION p4z_meso_alloc()
522      !!----------------------------------------------------------------------
523      !!                     ***  ROUTINE p4z_meso_alloc  ***
524      !!----------------------------------------------------------------------
525      !
526      ALLOCATE( depmig(jpi,jpj), kmig(jpi,jpj), STAT= p4z_meso_alloc  )
527      !
528      IF( p4z_meso_alloc /= 0 ) CALL ctl_stop( 'STOP', 'p4z_meso_alloc : failed to allocate arrays.' )
529      !
530   END FUNCTION p4z_meso_alloc
531
532
533   !!======================================================================
534END MODULE p4zmeso
Note: See TracBrowser for help on using the repository browser.