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.
trcbio.F90 in trunk/NEMO/TOP_SRC/LOBSTER – NEMO

source: trunk/NEMO/TOP_SRC/LOBSTER/trcbio.F90 @ 1071

Last change on this file since 1071 was 1071, checked in by cetlod, 16 years ago

update LOBSTER model, see ticket:190

File size: 17.5 KB
Line 
1MODULE trcbio
2   !!======================================================================
3   !!                         ***  MODULE trcbio  ***
4   !! TOP :   LOBSTER
5   !!======================================================================
6   !! History :    -   !  1999-07  (M. Levy) Original code
7   !!              -   !  2000-12  (E. Kestenare) assign a parameter to name individual tracers
8   !!              -   !  2001-03  (M. Levy)  LNO3 + dia2d
9   !!             2.0  !  2007-12  (C. Deltel, G. Madec)  F90
10   !!----------------------------------------------------------------------
11#if defined key_lobster
12   !!----------------------------------------------------------------------
13   !!   'key_lobster'                                     LOBSTER bio-model
14   !!----------------------------------------------------------------------
15   !!   trc_bio        : 
16   !!----------------------------------------------------------------------
17   USE oce_trc         !
18   USE trp_trc         !
19   USE sms_lobster     !
20   USE lbclnk          !
21   USE prtctl_trc      ! Print control for debbuging
22   
23   IMPLICIT NONE
24   PRIVATE
25
26   PUBLIC   trc_bio    ! called in ???
27
28   !!* Substitution
29#  include "domzgr_substitute.h90"
30   !!----------------------------------------------------------------------
31   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)
32   !! $Id: trcbio.F90 777 2007-12-19 18:40:57Z gm $
33   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
34   !!----------------------------------------------------------------------
35
36CONTAINS
37
38   SUBROUTINE trc_bio( kt )
39      !!---------------------------------------------------------------------
40      !!                     ***  ROUTINE trc_bio  ***
41      !!
42      !! ** Purpose :   compute the now trend due to biogeochemical processes
43      !!              and add it to the general trend of passive tracers equations
44      !!
45      !! ** Method  :   each now biological flux is calculated in function of now
46      !!              concentrations of tracers.
47      !!              depending on the tracer, these fluxes are sources or sinks.
48      !!              the total of the sources and sinks for each tracer
49      !!              is added to the general trend.
50      !!       
51      !!                      tra = tra + zf...tra - zftra...
52      !!                                     |         |
53      !!                                     |         |
54      !!                                  source      sink
55      !!       
56      !!              IF 'key_trc_diabio' defined , the biogeochemical trends
57      !!              for passive tracers are saved for futher diagnostics.
58      !!---------------------------------------------------------------------
59      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index     
60      !!
61      INTEGER  ::   ji, jj, jk
62      REAL(wp) ::   zdet, zzoo, zphy, zno3, znh4, zdom      ! now concentrations
63      REAL(wp) ::   zlno3, zlnh4, zle, zlt                  ! limitation terms for phyto
64      REAL(wp) ::   zno3phy, znh4phy, zphynh4, zphydom
65      REAL(wp) ::   zphydet, zphyzoo, zdetzoo
66      REAL(wp) ::   zzoonh4, zzoodom, zzoodet, zdetnh4, zdetdom
67      REAL(wp) ::   znh4no3, zdomnh4, zppz, zpdz, zpppz, zppdz, zfood
68      REAL(wp) ::   zfilpz, zfildz, zphya, zzooa, zno3a
69      REAL(wp) ::   znh4a, zdeta, zdoma, zzoobod, zboddet, zdomaju
70#if defined key_trc_diaadd
71      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze3t
72#endif
73      CHARACTER (len=25) :: charout
74      !!---------------------------------------------------------------------
75
76      IF( kt == nit000 ) THEN
77         IF(lwp) WRITE(numout,*)
78         IF(lwp) WRITE(numout,*) ' trc_bio: LOBSTER bio-model'
79         IF(lwp) WRITE(numout,*) ' ~~~~~~~'
80      ENDIF
81
82#if defined key_trc_diaadd
83      ! convert fluxes in per day
84      ze3t(:,:,:) = 0.e0
85      DO jk = 1, jpkbm1
86         ze3t(:,:,jk) = fse3t(:,:,jk) * 86400.
87      END DO 
88#endif
89
90      fbod(:,:) = 0.e0
91#if defined key_trc_diaadd
92      DO ji = 1, jpdia2d
93         trc2d(:,:,ji) = 0.e0
94      END DO 
95#endif
96
97
98      !                                      ! -------------------------- !
99      DO jk = 1, jpkbm1                      !  Upper ocean (bio-layers)  !
100         !                                   ! -------------------------- !
101         DO jj = 2, jpjm1
102            DO ji = 2, jpim1           !!gm  use of fs_2 fs_jpm1  required here
103
104               ! trophic variables( det, zoo, phy, no3, nh4, dom)
105               ! ------------------------------------------------
106
107               ! negative trophic variables DO not contribute to the fluxes
108               zdet = MAX( 0.e0, trn(ji,jj,jk,jpdet) )
109               zzoo = MAX( 0.e0, trn(ji,jj,jk,jpzoo) )
110               zphy = MAX( 0.e0, trn(ji,jj,jk,jpphy) )
111               zno3 = MAX( 0.e0, trn(ji,jj,jk,jpno3) )
112               znh4 = MAX( 0.e0, trn(ji,jj,jk,jpnh4) )
113               zdom = MAX( 0.e0, trn(ji,jj,jk,jpdom) )
114
115               ! Limitations
116               zlt   = 1.
117               zle   = 1. - EXP( -xpar(ji,jj,jk) / aki / zlt )
118               ! psinut,akno3,aknh4 added by asklod AS Kremeur 2005-03
119               zlno3 = zno3 * EXP( -psinut * znh4 ) / ( akno3 + zno3 )
120               zlnh4 = znh4 / (znh4+aknh4) 
121
122
123               ! sinks and sources
124               !    phytoplankton production and exsudation
125               zno3phy = tmumax * zle * zlt * zlno3 * zphy
126               znh4phy = tmumax * zle * zlt * zlnh4 * zphy
127
128               !    fphylab added by asklod AS Kremeur 2005-03
129               zphydom = rgamma * (1 - fphylab) * (zno3phy + znh4phy)
130               zphynh4 = rgamma * fphylab * (zno3phy + znh4phy)
131
132               ! zooplankton production
133               !    preferences
134               zppz = rppz
135               zpdz = 1. - rppz
136               zpppz = ( zppz * zphy ) / ( ( zppz * zphy + zpdz * zdet ) + 1.e-13 )
137               zppdz = ( zpdz * zdet ) / ( ( zppz * zphy + zpdz * zdet ) + 1.e-13 )
138               zfood = zpppz * zphy + zppdz * zdet
139               !    filtration
140               zfilpz = taus * zpppz / (aks + zfood)
141               zfildz = taus * zppdz / (aks + zfood)
142               !    grazing
143               zphyzoo = zfilpz * zphy * zzoo
144               zdetzoo = zfildz * zdet * zzoo
145
146               ! fecal pellets production
147               zzoodet = rpnaz * zphyzoo + rdnaz * zdetzoo
148 
149               ! zooplankton liquide excretion
150               zzoonh4 = tauzn * fzoolab * zzoo 
151               zzoodom = tauzn * (1 - fzoolab) * zzoo
152
153               ! mortality
154               !    phytoplankton mortality
155               zphydet = tmminp * zphy
156
157               !    zooplankton mortality
158               !    closure : flux fbod is redistributed below level jpkbio
159               zzoobod = tmminz * zzoo * zzoo
160               fbod(ji,jj) = fbod(ji,jj) + (1-fdbod) * zzoobod * fse3t(ji,jj,jk)
161               zboddet = fdbod * zzoobod
162
163               ! detritus and dom breakdown
164               zdetnh4 = taudn * fdetlab * zdet
165               zdetdom = taudn * (1 - fdetlab) * zdet 
166
167               zdomnh4 = taudomn * zdom
168
169               ! flux added to express how the excess of nitrogen from
170               ! PHY, ZOO and DET to DOM goes directly to NH4 (flux of ajustment)
171               zdomaju = (1 - redf/reddom) * (zphydom + zzoodom + zdetdom)
172
173               ! Nitrification
174               znh4no3 = taunn * znh4
175
176               ! determination of trends
177               !    total trend for each biological tracer
178               zphya =   zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet
179               zzooa =   zphyzoo + zdetzoo - zzoodet - zzoodom - zzoonh4 - zzoobod
180               zno3a = - zno3phy + znh4no3
181               znh4a = - znh4phy - znh4no3 + zphynh4 + zzoonh4 + zdomnh4 + zdetnh4 + zdomaju
182               zdeta =   zphydet + zzoodet - zdetzoo - zdetnh4 - zdetdom + zboddet
183               zdoma =   zphydom + zzoodom + zdetdom - zdomnh4 - zdomaju
184   
185#if defined key_trc_diabio
186               trbio(ji,jj,jk, 1) = zno3phy
187               trbio(ji,jj,jk, 2) = znh4phy
188               trbio(ji,jj,jk, 3) = zphynh4
189               trbio(ji,jj,jk, 4) = zphydom
190               trbio(ji,jj,jk, 5) = zphyzoo
191               trbio(ji,jj,jk, 6) = zphydet
192               trbio(ji,jj,jk, 7) = zdetzoo
193               trbio(ji,jj,jk, 9) = zzoodet
194               trbio(ji,jj,jk,10) = zzoobod
195               trbio(ji,jj,jk,11) = zzoonh4
196               trbio(ji,jj,jk,12) = zzoodom
197               trbio(ji,jj,jk,13) = znh4no3
198               trbio(ji,jj,jk,14) = zdomnh4
199               trbio(ji,jj,jk,15) = zdetnh4
200#endif
201#if defined key_trc_diaadd
202               trc2d(ji,jj, 1) = trc2d(ji,jj, 1) + zno3phy * ze3t(ji,jj,jk) 
203               trc2d(ji,jj, 2) = trc2d(ji,jj, 2) + znh4phy * ze3t(ji,jj,jk)
204               trc2d(ji,jj, 3) = trc2d(ji,jj, 3) + zphydom * ze3t(ji,jj,jk)
205               trc2d(ji,jj, 4) = trc2d(ji,jj, 4) + zphynh4 * ze3t(ji,jj,jk)
206               trc2d(ji,jj, 5) = trc2d(ji,jj, 5) + zphyzoo * ze3t(ji,jj,jk)
207               trc2d(ji,jj, 6) = trc2d(ji,jj, 6) + zphydet * ze3t(ji,jj,jk)
208               trc2d(ji,jj, 7) = trc2d(ji,jj, 7) + zdetzoo * ze3t(ji,jj,jk)
209! trend number 8 is in trcsed.F           
210               trc2d(ji,jj, 9) = trc2d(ji,jj, 9) + zzoodet * ze3t(ji,jj,jk)
211               trc2d(ji,jj,10) = trc2d(ji,jj,10) + zzoobod * ze3t(ji,jj,jk)
212               trc2d(ji,jj,11) = trc2d(ji,jj,11) + zzoonh4 * ze3t(ji,jj,jk)
213               trc2d(ji,jj,12) = trc2d(ji,jj,12) + zzoodom * ze3t(ji,jj,jk)
214               trc2d(ji,jj,13) = trc2d(ji,jj,13) + znh4no3 * ze3t(ji,jj,jk)
215               trc2d(ji,jj,14) = trc2d(ji,jj,14) + zdomnh4 * ze3t(ji,jj,jk)
216               trc2d(ji,jj,15) = trc2d(ji,jj,15) + zdetnh4 * ze3t(ji,jj,jk)
217             
218               trc2d(ji,jj,16) = trc2d(ji,jj,16) + (  zno3phy + znh4phy - zphynh4   &
219                  &                                 - zphydom - zphyzoo - zphydet ) * ze3t(ji,jj,jk)
220               trc2d(ji,jj,17) = trc2d(ji,jj,17) + (  zphyzoo + zdetzoo - zzoodet   &
221                  &                                 - zzoobod - zzoonh4 - zzoodom ) * ze3t(ji,jj,jk)
222               trc2d(ji,jj,18) = trc2d(ji,jj,18) + zdetdom * ze3t(ji,jj,jk)
223! trend number 19 is in trcexp.F
224               trc3d(ji,jj,jk,1) = zno3phy * 86400     
225               trc3d(ji,jj,jk,2) = znh4phy * 86400     
226               trc3d(ji,jj,jk,3) = znh4no3 * 86400     
227#endif
228
229               ! tracer flux at totox-point added to the general trend
230               tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + zdeta
231               tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) + zzooa
232               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zphya
233               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zno3a
234               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + znh4a
235               tra(ji,jj,jk,jpdom) = tra(ji,jj,jk,jpdom) + zdoma
236
237            END DO
238         END DO
239      END DO
240
241!!gm do loop until jpkm1 only!
242      !                                      ! -------------------------- !
243      DO jk = jpkb, jpk                      !  Upper ocean (bio-layers)  !
244         !                                   ! -------------------------- !
245
246         DO jj = 2, jpjm1
247            DO ji = 2,jpim1             !!gm use of fs_2 & fs_jpim1 required
248 
249               ! remineralisation of all quantities towards nitrate
250
251               !    trophic variables( det, zoo, phy, no3, nh4, dom)
252               !       negative trophic variables DO not contribute to the fluxes
253               zdet = MAX( 0.e0, trn(ji,jj,jk,jpdet) )
254               zzoo = MAX( 0.e0, trn(ji,jj,jk,jpzoo) )
255               zphy = MAX( 0.e0, trn(ji,jj,jk,jpphy) )
256               zno3 = MAX( 0.e0, trn(ji,jj,jk,jpno3) )
257               znh4 = MAX( 0.e0, trn(ji,jj,jk,jpnh4) )
258               zdom = MAX( 0.e0, trn(ji,jj,jk,jpdom) )
259
260               !    Limitations
261               zlt   = 0.e0
262               zle   = 0.e0
263               zlno3 = 0.e0
264               zlnh4 = 0.e0
265
266               !    sinks and sources
267               !       phytoplankton production and exsudation
268               zno3phy = 0.e0
269               znh4phy = 0.e0
270               zphydom = 0.e0
271               zphynh4 = 0.e0
272
273               !    zooplankton production
274               zphyzoo = 0.e0      ! grazing
275               zdetzoo = 0.e0
276
277               zzoodet = 0.e0      ! fecal pellets production
278
279               zzoonh4 = tauzn * fzoolab * zzoo         ! zooplankton liquide excretion
280               zzoodom = tauzn * (1 - fzoolab) * zzoo
281
282               !    mortality
283               zphydet = tmminp * zphy      ! phytoplankton mortality
284
285               zzoobod = 0.e0               ! zooplankton mortality
286               zboddet = 0.e0               ! closure : flux fbod is redistributed below level jpkbio
287
288               !    detritus and dom breakdown
289               zdetnh4 = taudn * fdetlab * zdet
290               zdetdom = taudn * (1 - fdetlab) * zdet 
291
292               zdomnh4 = taudomn * zdom
293               zdomaju = (1 - redf/reddom) * (zphydom + zzoodom + zdetdom)
294
295               !    Nitrification
296               znh4no3 = taunn * znh4
297
298
299               ! determination of trends
300               !     total trend for each biological tracer
301               zphya =   zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet
302               zzooa =   zphyzoo + zdetzoo - zzoodet - zzoodom - zzoonh4 - zzoobod
303               zno3a = - zno3phy + znh4no3
304               znh4a = - znh4phy - znh4no3 + zphynh4 + zzoonh4 + zdomnh4 + zdetnh4 + zdomaju
305               zdeta = zphydet + zzoodet  - zdetzoo - zdetnh4 - zdetdom + zboddet
306               zdoma = zphydom + zzoodom + zdetdom - zdomnh4 - zdomaju
307
308#if defined key_trc_diabio
309               trbio(ji,jj,jk, 1) = zno3phy
310               trbio(ji,jj,jk, 2) = znh4phy
311               trbio(ji,jj,jk, 3) = zphynh4
312               trbio(ji,jj,jk, 4) = zphydom
313               trbio(ji,jj,jk, 5) = zphyzoo
314               trbio(ji,jj,jk, 6) = zphydet
315               trbio(ji,jj,jk, 7) = zdetzoo
316               trbio(ji,jj,jk, 9) = zzoodet
317               trbio(ji,jj,jk,10) = zzoobod
318               trbio(ji,jj,jk,11) = zzoonh4
319               trbio(ji,jj,jk,12) = zzoodom
320               trbio(ji,jj,jk,13) = znh4no3
321               trbio(ji,jj,jk,14) = zdomnh4
322               trbio(ji,jj,jk,15) = zdetnh4
323#endif
324#if defined key_trc_diaadd
325               trc2d(ji,jj, 1) = trc2d(ji,jj, 1) + zno3phy * ze3t(ji,jj,jk)         
326               trc2d(ji,jj, 2) = trc2d(ji,jj, 2) + znh4phy * ze3t(ji,jj,jk)
327               trc2d(ji,jj, 3) = trc2d(ji,jj, 3) + zphydom * ze3t(ji,jj,jk)
328               trc2d(ji,jj, 4) = trc2d(ji,jj, 4) + zphynh4 * ze3t(ji,jj,jk)
329               trc2d(ji,jj, 5) = trc2d(ji,jj, 5) + zphyzoo * ze3t(ji,jj,jk)
330               trc2d(ji,jj, 6) = trc2d(ji,jj, 6) + zphydet * ze3t(ji,jj,jk)
331               trc2d(ji,jj, 7) = trc2d(ji,jj, 7) + zdetzoo * ze3t(ji,jj,jk)
332               ! trend number 8 is in trcsed.F           
333               trc2d(ji,jj, 9) = trc2d(ji,jj, 9) + zzoodet * ze3t(ji,jj,jk)
334               trc2d(ji,jj,10) = trc2d(ji,jj,10) + zzoobod * ze3t(ji,jj,jk)
335               trc2d(ji,jj,11) = trc2d(ji,jj,11) + zzoonh4 * ze3t(ji,jj,jk)
336               trc2d(ji,jj,12) = trc2d(ji,jj,12) + zzoodom * ze3t(ji,jj,jk)
337               trc2d(ji,jj,13) = trc2d(ji,jj,13) + znh4no3 * ze3t(ji,jj,jk)
338               trc2d(ji,jj,14) = trc2d(ji,jj,14) + zdomnh4 * ze3t(ji,jj,jk)
339               trc2d(ji,jj,15) = trc2d(ji,jj,15) + zdetnh4 * ze3t(ji,jj,jk)
340             
341               trc2d(ji,jj,16) = trc2d(ji,jj,16) + (  zno3phy + znh4phy - zphynh4   &
342                  &                                 - zphydom - zphyzoo - zphydet  ) * ze3t(ji,jj,jk)
343               trc2d(ji,jj,17) = trc2d(ji,jj,17) + (  zphyzoo + zdetzoo - zzoodet   &
344                  &                                 - zzoobod - zzoonh4 - zzoodom  ) * ze3t(ji,jj,jk)
345               trc2d(ji,jj,18) = trc2d(ji,jj,18) + zdetdom * ze3t(ji,jj,jk)
346
347               trc3d(ji,jj,jk,1) =  zno3phy * 86400     
348               trc3d(ji,jj,jk,2) =  znh4phy * 86400     
349               trc3d(ji,jj,jk,3) =  znh4no3 * 86400     
350#endif
351
352               ! tracer flux at totox-point added to the general trend
353               tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + zdeta
354               tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) + zzooa
355               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zphya
356               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zno3a
357               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + znh4a
358               tra(ji,jj,jk,jpdom) = tra(ji,jj,jk,jpdom) + zdoma
359               !
360            END DO
361         END DO
362      END DO
363
364#if defined key_trc_diaadd
365      ! Lateral boundary conditions on trc2d and trc3d
366      DO ji = 1, jpdia2d
367          CALL lbc_lnk( trc2d(:,:,ji),'T', 1. )
368      END DO
369      DO ji = 1, jpdia3d
370          CALL lbc_lnk( trc3d(:,:,1,ji),'T', 1. )
371      END DO 
372#endif
373
374#if defined key_trc_diabio
375      ! Lateral boundary conditions on trcbio
376      DO ji = 1, jpdiabio
377          CALL lbc_lnk( trbio(:,:,1,ji),'T', 1. )
378      END DO 
379#endif
380      !
381      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
382         WRITE(charout, FMT="('bio')")
383         CALL prt_ctl_trc_info(charout)
384         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
385      ENDIF
386
387   END SUBROUTINE trc_bio
388
389#else
390   !!======================================================================
391   !!  Dummy module :                                   No PISCES bio-model
392   !!======================================================================
393CONTAINS
394   SUBROUTINE trc_bio( kt )                   ! Empty routine
395      INTEGER, INTENT( in ) ::   kt
396      WRITE(*,*) 'trc_bio: You should not have seen this print! error?', kt
397   END SUBROUTINE trc_bio
398#endif 
399
400   !!======================================================================
401END MODULE  trcbio
Note: See TracBrowser for help on using the repository browser.