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.
p4zrem.F90 in branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z – NEMO

source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90 @ 8356

Last change on this file since 8356 was 8356, checked in by davestorkey, 7 years ago

UKMO/dev_r5518_GO6_package branch: merge in changes from rev 6917 to 6959 of the 3.6_stable branch.

File size: 17.9 KB
Line 
1MODULE p4zrem
2   !!======================================================================
3   !!                         ***  MODULE p4zrem  ***
4   !! TOP :   PISCES Compute remineralization/dissolution of organic compounds
5   !!=========================================================================
6   !! History :   1.0  !  2004     (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#if defined key_pisces
11   !!----------------------------------------------------------------------
12   !!   'key_top'       and                                      TOP models
13   !!   'key_pisces'                                       PISCES bio-model
14   !!----------------------------------------------------------------------
15   !!   p4z_rem       :  Compute remineralization/dissolution of organic compounds
16   !!   p4z_rem_init  :  Initialisation of parameters for remineralisation
17   !!   p4z_rem_alloc :  Allocate remineralisation variables
18   !!----------------------------------------------------------------------
19   USE oce_trc         !  shared variables between ocean and passive tracers
20   USE trc             !  passive tracers common variables
21   USE sms_pisces      !  PISCES Source Minus Sink variables
22   USE p4zopt          !  optical model
23   USE p4zche          !  chemical model
24   USE p4zprod         !  Growth rate of the 2 phyto groups
25   USE p4zmeso         !  Sources and sinks of mesozooplankton
26   USE p4zint          !  interpolation and computation of various fields
27   USE p4zlim
28   USE prtctl_trc      !  print control for debugging
29   USE iom             !  I/O manager
30
31
32   IMPLICIT NONE
33   PRIVATE
34
35   PUBLIC   p4z_rem         ! called in p4zbio.F90
36   PUBLIC   p4z_rem_init    ! called in trcsms_pisces.F90
37   PUBLIC   p4z_rem_alloc
38
39   !! * Shared module variables
40   REAL(wp), PUBLIC ::  xremik     !: remineralisation rate of POC
41   REAL(wp), PUBLIC ::  xremip     !: remineralisation rate of DOC
42   REAL(wp), PUBLIC ::  nitrif     !: NH4 nitrification rate
43   REAL(wp), PUBLIC ::  xsirem     !: remineralisation rate of POC
44   REAL(wp), PUBLIC ::  xsiremlab  !: fast remineralisation rate of POC
45   REAL(wp), PUBLIC ::  xsilab     !: fraction of labile biogenic silica
46
47   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   denitr     !: denitrification array
48   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   denitnh4   !: -    -    -    -   -
49
50   !!* Substitution
51#  include "top_substitute.h90"
52   !!----------------------------------------------------------------------
53   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
54   !! $Id$
55   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
56   !!----------------------------------------------------------------------
57CONTAINS
58
59   SUBROUTINE p4z_rem( kt, knt )
60      !!---------------------------------------------------------------------
61      !!                     ***  ROUTINE p4z_rem  ***
62      !!
63      !! ** Purpose :   Compute remineralization/scavenging of organic compounds
64      !!
65      !! ** Method  : - ???
66      !!---------------------------------------------------------------------
67      !
68      INTEGER, INTENT(in) ::   kt, knt ! ocean time step
69      !
70      INTEGER  ::   ji, jj, jk
71      REAL(wp) ::   zremip, zremik, zsiremin 
72      REAL(wp) ::   zsatur, zsatur2, znusil, znusil2, zdep, zdepmin, zfactdep
73      REAL(wp) ::   zbactfer, zorem, zorem2, zofer, zolimit
74      REAL(wp) ::   zosil, ztem
75#if ! defined key_kriest
76      REAL(wp) ::   zofer2
77#endif
78      REAL(wp) ::   zonitr, zstep, zfact
79      CHARACTER (len=25) :: charout
80      REAL(wp), POINTER, DIMENSION(:,:  ) :: ztempbac
81      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepbac, zolimi, zdepprod, zw3d
82      !!---------------------------------------------------------------------
83      !
84      IF( nn_timing == 1 )  CALL timing_start('p4z_rem')
85      !
86      ! Allocate temporary workspace
87      CALL wrk_alloc( jpi, jpj,      ztempbac                  )
88      CALL wrk_alloc( jpi, jpj, jpk, zdepbac, zdepprod, zolimi )
89
90      ! Initialisation of temprary arrys
91      zdepprod(:,:,:) = 1._wp
92      ztempbac(:,:)   = 0._wp
93
94      ! Computation of the mean phytoplankton concentration as
95      ! a crude estimate of the bacterial biomass
96      ! this parameterization has been deduced from a model version
97      ! that was modeling explicitely bacteria
98      ! -------------------------------------------------------
99      DO jk = 1, jpkm1
100         DO jj = 1, jpj
101            DO ji = 1, jpi
102               zdep = MAX( hmld(ji,jj), heup(ji,jj) )
103               IF( fsdept(ji,jj,jk) < zdep ) THEN
104                  zdepbac(ji,jj,jk) = MIN( 0.7 * ( trb(ji,jj,jk,jpzoo) + 2.* trb(ji,jj,jk,jpmes) ), 4.e-6 )
105                  ztempbac(ji,jj)   = zdepbac(ji,jj,jk)
106               ELSE
107                  zdepmin = MIN( 1., zdep / fsdept(ji,jj,jk) )
108                  zdepbac (ji,jj,jk) = zdepmin**0.683 * ztempbac(ji,jj)
109                  zdepprod(ji,jj,jk) = zdepmin**0.273
110               ENDIF
111            END DO
112         END DO
113      END DO
114
115      DO jk = 1, jpkm1
116         DO jj = 1, jpj
117            DO ji = 1, jpi
118               zstep   = xstep
119# if defined key_degrad
120               zstep = zstep * facvol(ji,jj,jk)
121# endif
122               ! DOC ammonification. Depends on depth, phytoplankton biomass
123               ! and a limitation term which is supposed to be a parameterization
124               !     of the bacterial activity.
125               zremik = xremik * zstep / 1.e-6 * xlimbac(ji,jj,jk) * zdepbac(ji,jj,jk) 
126               zremik = MAX( zremik, 2.74e-4 * xstep )
127               ! Ammonification in oxic waters with oxygen consumption
128               ! -----------------------------------------------------
129               zolimit = zremik * ( 1.- nitrfac(ji,jj,jk) ) * trb(ji,jj,jk,jpdoc) 
130               zolimi(ji,jj,jk) = MIN( ( trb(ji,jj,jk,jpoxy) - rtrn ) / o2ut, zolimit ) 
131               ! Ammonification in suboxic waters with denitrification
132               ! -------------------------------------------------------
133               denitr(ji,jj,jk)  = MIN(  ( trb(ji,jj,jk,jpno3) - rtrn ) / rdenit,   &
134                  &                     zremik * nitrfac(ji,jj,jk) * trb(ji,jj,jk,jpdoc)  )
135               !
136               zolimi (ji,jj,jk) = MAX( 0.e0, zolimi (ji,jj,jk) )
137               denitr (ji,jj,jk) = MAX( 0.e0, denitr (ji,jj,jk) )
138               !
139            END DO
140         END DO
141      END DO
142
143
144      DO jk = 1, jpkm1
145         DO jj = 1, jpj
146            DO ji = 1, jpi
147               zstep   = xstep
148# if defined key_degrad
149               zstep = zstep * facvol(ji,jj,jk)
150# endif
151               ! NH4 nitrification to NO3. Ceased for oxygen concentrations
152               ! below 2 umol/L. Inhibited at strong light
153               ! ----------------------------------------------------------
154               zonitr  =nitrif * zstep * trb(ji,jj,jk,jpnh4) / ( 1.+ emoy(ji,jj,jk) ) * ( 1.- nitrfac(ji,jj,jk) ) 
155               denitnh4(ji,jj,jk) = nitrif * zstep * trb(ji,jj,jk,jpnh4) * nitrfac(ji,jj,jk) 
156               ! Update of the tracers trends
157               ! ----------------------------
158               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zonitr - denitnh4(ji,jj,jk)
159               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zonitr - rdenita * denitnh4(ji,jj,jk)
160               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2nit * zonitr
161               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2 * rno3 * zonitr + rno3 * ( rdenita - 1. ) * denitnh4(ji,jj,jk)
162            END DO
163         END DO
164      END DO
165
166       IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
167         WRITE(charout, FMT="('rem1')")
168         CALL prt_ctl_trc_info(charout)
169         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
170       ENDIF
171
172      DO jk = 1, jpkm1
173         DO jj = 1, jpj
174            DO ji = 1, jpi
175
176               ! Bacterial uptake of iron. No iron is available in DOC. So
177               ! Bacteries are obliged to take up iron from the water. Some
178               ! studies (especially at Papa) have shown this uptake to be significant
179               ! ----------------------------------------------------------
180               zbactfer = 10.e-6 *  rfact2 * prmax(ji,jj,jk) * xlimbacl(ji,jj,jk)             &
181                  &              * trb(ji,jj,jk,jpfer) / ( 2.5E-10 + trb(ji,jj,jk,jpfer) )    &
182                  &              * zdepprod(ji,jj,jk) * zdepbac(ji,jj,jk)
183#if defined key_kriest
184               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zbactfer*0.05
185               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zbactfer*0.05
186#else
187               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zbactfer*0.16
188               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zbactfer*0.12
189               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zbactfer*0.04
190#endif
191            END DO
192         END DO
193      END DO
194
195       IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
196         WRITE(charout, FMT="('rem2')")
197         CALL prt_ctl_trc_info(charout)
198         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
199       ENDIF
200
201      DO jk = 1, jpkm1
202         DO jj = 1, jpj
203            DO ji = 1, jpi
204               zstep   = xstep
205# if defined key_degrad
206               zstep = zstep * facvol(ji,jj,jk)
207# endif
208               ! POC disaggregation by turbulence and bacterial activity.
209               ! --------------------------------------------------------
210               zremip = xremip * zstep * tgfunc(ji,jj,jk) * ( 1.- 0.55 * nitrfac(ji,jj,jk) ) 
211
212               ! POC disaggregation rate is reduced in anoxic zone as shown by
213               ! sediment traps data. In oxic area, the exponent of the martin s
214               ! law is around -0.87. In anoxic zone, it is around -0.35. This
215               ! means a disaggregation constant about 0.5 the value in oxic zones
216               ! -----------------------------------------------------------------
217               zorem  = zremip * trb(ji,jj,jk,jppoc)
218               zofer  = zremip * trb(ji,jj,jk,jpsfe)
219#if ! defined key_kriest
220               zorem2 = zremip * trb(ji,jj,jk,jpgoc)
221               zofer2 = zremip * trb(ji,jj,jk,jpbfe)
222#else
223               zorem2 = zremip * trb(ji,jj,jk,jpnum)
224#endif
225
226               ! Update the appropriate tracers trends
227               ! -------------------------------------
228
229               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zorem
230               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer
231#if defined key_kriest
232               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zorem
233               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) - zorem2
234               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zofer
235#else
236               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zorem2 - zorem
237               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) - zorem2
238               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zofer2 - zofer
239               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) - zofer2
240#endif
241
242            END DO
243         END DO
244      END DO
245
246       IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
247         WRITE(charout, FMT="('rem3')")
248         CALL prt_ctl_trc_info(charout)
249         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
250       ENDIF
251
252      DO jk = 1, jpkm1
253         DO jj = 1, jpj
254            DO ji = 1, jpi
255               zstep   = xstep
256# if defined key_degrad
257               zstep = zstep * facvol(ji,jj,jk)
258# endif
259               ! Remineralization rate of BSi depedant on T and saturation
260               ! ---------------------------------------------------------
261               zsatur   = ( sio3eq(ji,jj,jk) - trb(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn )
262               zsatur   = MAX( rtrn, zsatur )
263               zsatur2  = ( 1. + tsn(ji,jj,jk,jp_tem) / 400.)**37
264               znusil   = 0.225  * ( 1. + tsn(ji,jj,jk,jp_tem) / 15.) * zsatur + 0.775 * zsatur2 * zsatur**9.25
265               znusil2  = 0.225  * ( 1. + tsn(ji,jj,1,jp_tem) / 15.) + 0.775 * zsatur2
266
267               ! Two classes of BSi are considered : a labile fraction and
268               ! a more refractory one. The ratio between both fractions is
269               ! constant and specified in the namelist.
270               ! ----------------------------------------------------------
271               zdep     = MAX( hmld(ji,jj), heup(ji,jj) ) 
272               zdep     = MAX( 0., fsdept(ji,jj,jk) - zdep )
273               ztem     = MAX( tsn(ji,jj,1,jp_tem), 0. )
274               zfactdep = xsilab * EXP(-( xsiremlab - xsirem ) * znusil2 * zdep / wsbio2 ) * ztem / ( ztem + 10. )
275               zsiremin = ( xsiremlab * zfactdep + xsirem * ( 1. - zfactdep ) ) * zstep * znusil
276               zosil    = zsiremin * trb(ji,jj,jk,jpgsi)
277               !
278               tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) - zosil
279               tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) + zosil
280               !
281            END DO
282         END DO
283      END DO
284
285      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
286         WRITE(charout, FMT="('rem4')")
287         CALL prt_ctl_trc_info(charout)
288         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
289       ENDIF
290
291      ! Update the arrays TRA which contain the biological sources and sinks
292      ! --------------------------------------------------------------------
293
294      DO jk = 1, jpkm1
295         tra(:,:,jk,jppo4) = tra(:,:,jk,jppo4) + zolimi (:,:,jk) + denitr(:,:,jk)
296         tra(:,:,jk,jpnh4) = tra(:,:,jk,jpnh4) + zolimi (:,:,jk) + denitr(:,:,jk)
297         tra(:,:,jk,jpno3) = tra(:,:,jk,jpno3) - denitr (:,:,jk) * rdenit
298         tra(:,:,jk,jpdoc) = tra(:,:,jk,jpdoc) - zolimi (:,:,jk) - denitr(:,:,jk)
299         tra(:,:,jk,jpoxy) = tra(:,:,jk,jpoxy) - zolimi (:,:,jk) * o2ut
300         tra(:,:,jk,jpdic) = tra(:,:,jk,jpdic) + zolimi (:,:,jk) + denitr(:,:,jk)
301         tra(:,:,jk,jptal) = tra(:,:,jk,jptal) + rno3 * ( zolimi(:,:,jk) + ( rdenit + 1.) * denitr(:,:,jk) )
302      END DO
303
304      IF( knt == nrdttrc ) THEN
305          CALL wrk_alloc( jpi, jpj, jpk, zw3d )
306          zfact = 1.e+3 * rfact2r  !  conversion from mol/l/kt to  mol/m3/s
307          !
308          IF( iom_use( "REMIN" ) )  THEN
309              zw3d(:,:,:) = zolimi(:,:,:) * tmask(:,:,:) * zfact !  Remineralisation rate
310              CALL iom_put( "REMIN"  , zw3d )
311          ENDIF
312          IF( iom_use( "DENIT" ) )  THEN
313              zw3d(:,:,:) = denitr(:,:,:) * rdenit * rno3 * tmask(:,:,:) * zfact ! Denitrification
314              CALL iom_put( "DENIT"  , zw3d )
315          ENDIF
316          !
317          CALL wrk_dealloc( jpi, jpj, jpk, zw3d )
318       ENDIF
319
320      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
321         WRITE(charout, FMT="('rem6')")
322         CALL prt_ctl_trc_info(charout)
323         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
324      ENDIF
325      !
326      CALL wrk_dealloc( jpi, jpj,      ztempbac                  )
327      CALL wrk_dealloc( jpi, jpj, jpk, zdepbac, zdepprod, zolimi )
328      !
329      IF( nn_timing == 1 )  CALL timing_stop('p4z_rem')
330      !
331   END SUBROUTINE p4z_rem
332
333
334   SUBROUTINE p4z_rem_init
335      !!----------------------------------------------------------------------
336      !!                  ***  ROUTINE p4z_rem_init  ***
337      !!
338      !! ** Purpose :   Initialization of remineralization parameters
339      !!
340      !! ** Method  :   Read the nampisrem namelist and check the parameters
341      !!      called at the first timestep
342      !!
343      !! ** input   :   Namelist nampisrem
344      !!
345      !!----------------------------------------------------------------------
346      NAMELIST/nampisrem/ xremik, xremip, nitrif, xsirem, xsiremlab, xsilab
347      INTEGER :: ios                 ! Local integer output status for namelist read
348
349      REWIND( numnatp_ref )              ! Namelist nampisrem in reference namelist : Pisces remineralization
350      READ  ( numnatp_ref, nampisrem, IOSTAT = ios, ERR = 901)
351901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisrem in reference namelist', lwp )
352
353      REWIND( numnatp_cfg )              ! Namelist nampisrem in configuration namelist : Pisces remineralization
354      READ  ( numnatp_cfg, nampisrem, IOSTAT = ios, ERR = 902 )
355902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisrem in configuration namelist', lwp )
356      IF(lwm) WRITE ( numonp, nampisrem )
357
358      IF(lwp) THEN                         ! control print
359         WRITE(numout,*) ' '
360         WRITE(numout,*) ' Namelist parameters for remineralization, nampisrem'
361         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
362         WRITE(numout,*) '    remineralisation rate of POC              xremip    =', xremip
363         WRITE(numout,*) '    remineralization rate of DOC              xremik    =', xremik
364         WRITE(numout,*) '    remineralization rate of Si               xsirem    =', xsirem
365         WRITE(numout,*) '    fast remineralization rate of Si          xsiremlab =', xsiremlab
366         WRITE(numout,*) '    fraction of labile biogenic silica        xsilab    =', xsilab
367         WRITE(numout,*) '    NH4 nitrification rate                    nitrif    =', nitrif
368      ENDIF
369      !
370      denitr  (:,:,:) = 0._wp
371      denitnh4(:,:,:) = 0._wp
372      !
373   END SUBROUTINE p4z_rem_init
374
375
376   INTEGER FUNCTION p4z_rem_alloc()
377      !!----------------------------------------------------------------------
378      !!                     ***  ROUTINE p4z_rem_alloc  ***
379      !!----------------------------------------------------------------------
380      ALLOCATE( denitr(jpi,jpj,jpk), denitnh4(jpi,jpj,jpk), STAT=p4z_rem_alloc )
381      !
382      IF( p4z_rem_alloc /= 0 )   CALL ctl_warn('p4z_rem_alloc: failed to allocate arrays')
383      !
384   END FUNCTION p4z_rem_alloc
385
386#else
387   !!======================================================================
388   !!  Dummy module :                                   No PISCES bio-model
389   !!======================================================================
390CONTAINS
391   SUBROUTINE p4z_rem                    ! Empty routine
392   END SUBROUTINE p4z_rem
393#endif 
394
395   !!======================================================================
396END MODULE p4zrem
Note: See TracBrowser for help on using the repository browser.