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 branches/dev_001_GM/NEMO/TOP_SRC/LOBSTER – NEMO

source: branches/dev_001_GM/NEMO/TOP_SRC/LOBSTER/trcbio.F90 @ 777

Last change on this file since 777 was 777, checked in by gm, 16 years ago

dev_001_GM - LOBSTER in F90 encapsulation of LOBSTER routines in module - compilation OK

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