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/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/TOP_SRC/LOBSTER – NEMO

source: branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcbio.F90 @ 2819

Last change on this file since 2819 was 2819, checked in by cetlod, 13 years ago

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