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.
p4zsed.F90 in branches/dev_001_GM/NEMO/TOP_SRC/PISCES – NEMO

source: branches/dev_001_GM/NEMO/TOP_SRC/PISCES/p4zsed.F90 @ 3197

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

include the new version of PISCES model , see ticket:91
  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 12.8 KB
Line 
1MODULE p4zsed
2   !!======================================================================
3   !!                         ***  MODULE p4sed  ***
4   !! TOP :   PISCES Compute loss of organic matter in the sediments
5   !!======================================================================
6   !! History :   1.0  !  2004-03 (O. Aumont) Original code
7   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
8   !!----------------------------------------------------------------------
9#if defined key_pisces
10   !!----------------------------------------------------------------------
11   !!   'key_pisces'                                       PISCES bio-model
12   !!----------------------------------------------------------------------
13   !!   p4z_sed        :  Compute loss of organic matter in the sediments
14   !!----------------------------------------------------------------------
15   USE oce_trc         !
16   USE trp_trc
17   USE sms
18   USE lib_mpp
19   USE prtctl_trc
20
21
22   IMPLICIT NONE
23   PRIVATE
24
25   PUBLIC   p4z_sed    ! called in p4zprg.F90
26
27   !!* Substitution
28#  include "domzgr_substitute.h90"
29   !!----------------------------------------------------------------------
30   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)
31   !! $Header:$
32   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
33   !!----------------------------------------------------------------------
34
35CONTAINS
36
37   SUBROUTINE p4z_sed
38      !!---------------------------------------------------------------------
39      !!                     ***  ROUTINE p4z_sed  ***
40      !!
41      !! ** Purpose :   Compute loss of organic matter in the sediments. This
42      !!              is by no way a sediment model. The loss is simply
43      !!              computed to balance the inout from rivers and dust
44      !!
45      !! ** Method  : - ???
46      !!---------------------------------------------------------------------
47      INTEGER  ::   ji, jj, jk
48      INTEGER  ::   ikt
49      REAL(wp) ::   zsumsedsi, zsumsedpo4, zsumsedcal
50      REAL(wp) ::   zconctmp , zdenitot  , znitrpottot
51      REAL(wp) ::   zlim, zconctmp2, zstep, zfact
52      REAL(wp), DIMENSION(jpi,jpj)     ::   zsidep
53      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   znitrpot, zirondep
54      CHARACTER (len=25) :: charout
55      !!---------------------------------------------------------------------
56
57
58      zstep = rfact2 / rjjss      ! Time step duration for the biology
59
60      zirondep(:,:,:) = 0.e0          ! Initialisation of variables used to compute deposition
61      zsidep  (:,:)   = 0.e0
62
63      ! Iron and Si deposition at the surface
64      ! -------------------------------------
65
66      DO jj = 1, jpj
67         DO ji = 1, jpi
68            zirondep(ji,jj,1) = ( 0.014 * dust(ji,jj) / ( 55.85 * rmoss ) + 3.e-10 / raass )   &
69               &             * rfact2 / fse3t(ji,jj,1)
70            zsidep  (ji,jj)   = 8.8 * 0.075 * dust(ji,jj) * rfact2 / ( fse3t(ji,jj,1) * 28.1 * rmoss )
71         END DO
72      END DO
73
74      ! Iron solubilization of particles in the water column
75      ! ----------------------------------------------------
76
77      DO jk = 2, jpkm1
78         DO jj = 1, jpj
79            DO ji = 1, jpi
80               zirondep(ji,jj,jk) = dust(ji,jj) / ( 10. * 55.85 * rmoss ) * rfact2 * 0.0001
81            END DO
82         END DO
83      END DO
84
85      ! Add the external input of nutrients, carbon and alkalinity
86      ! ----------------------------------------------------------
87
88      DO jj = 1, jpj
89         DO ji = 1, jpi
90            trn(ji,jj,1,jppo4) = trn(ji,jj,1,jppo4) +   rivinp(ji,jj)                   * rfact2
91            trn(ji,jj,1,jpno3) = trn(ji,jj,1,jpno3) + ( rivinp(ji,jj) + nitdep(ji,jj) ) * rfact2
92            trn(ji,jj,1,jpfer) = trn(ji,jj,1,jpfer) +   rivinp(ji,jj) * 3.e-5           * rfact2
93            trn(ji,jj,1,jpsil) = trn(ji,jj,1,jpsil) +   zsidep (ji,jj) + cotdep(ji,jj)   * rfact2 / 6.
94            trn(ji,jj,1,jpdic) = trn(ji,jj,1,jpdic) +   rivinp(ji,jj) * 2.631           * rfact2
95            trn(ji,jj,1,jptal) = trn(ji,jj,1,jptal) + ( cotdep(ji,jj) - rno3*(rivinp(ji,jj)   &
96               &                                                      + nitdep(ji,jj) ) ) * rfact2
97         END DO
98      END DO
99
100
101      ! Add the external input of iron which is 3D distributed
102      ! (dust, river and sediment mobilization)
103      ! ------------------------------------------------------
104
105      DO jk = 1, jpkm1
106         DO jj = 1, jpj
107            DO ji = 1, jpi
108               trn(ji,jj,jk,jpfer) = trn(ji,jj,jk,jpfer)   &
109                  &                + zirondep(ji,jj,jk) + ironsed(ji,jj,jk) * rfact2
110            END DO
111         END DO
112      END DO
113
114      ! Initialisation of variables used to compute Sinking Speed
115      ! ---------------------------------------------------------
116
117      zsumsedsi  = 0.e0
118      zsumsedpo4 = 0.e0
119      zsumsedcal = 0.e0
120
121      ! Loss of biogenic silicon, Caco3 organic carbon in the sediments.
122      ! First, the total loss is computed.
123      ! The factor for calcite comes from the alkalinity effect
124      ! -------------------------------------------------------------
125
126      DO jj = 1, jpj
127         DO ji = 1, jpi
128            ikt = MAX( mbathy(ji,jj)-1, 1 )
129            zfact = e1t(ji,jj) * e2t(ji,jj) / rjjss * tmask_i(ji,jj)
130# if ! defined key_kriest
131            zsumsedsi  = zsumsedsi  + zfact *  trn(ji,jj,ikt,jpdsi) * wsbio4(ji,jj,ikt) 
132# else
133            zsumsedsi  = zsumsedsi  + zfact *  trn(ji,jj,ikt,jpdsi) * wscal (ji,jj,ikt)
134# endif
135            zsumsedcal = zsumsedcal + zfact *  trn(ji,jj,ikt,jpcal) * wscal (ji,jj,ikt) * 2.e0
136# if  defined key_kriest
137            zsumsedpo4 = zsumsedpo4 + zfact *  trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt)
138# else
139            zsumsedpo4 = zsumsedpo4 + zfact *( trn(ji,jj,ikt,jpgoc) * wsbio4(ji,jj,ikt)   &
140               &                             + trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt) )
141# endif
142         END DO
143      END DO
144
145      IF( lk_mpp ) THEN
146         CALL mpp_sum( zsumsedsi  )   ! sums over the global domain
147         CALL mpp_sum( zsumsedcal )   ! sums over the global domain
148         CALL mpp_sum( zsumsedpo4 )   ! sums over the global domain
149      ENDIF
150
151      ! Then this loss is scaled at each bottom grid cell for
152      ! equilibrating the total budget of silica in the ocean.
153      ! Thus, the amount of silica lost in the sediments equal
154      ! the supply at the surface (dust+rivers)
155      ! ------------------------------------------------------
156
157      DO jj = 1, jpj
158         DO ji = 1, jpi
159            ikt = MAX( mbathy(ji,jj) - 1, 1 )
160            zconctmp = trn(ji,jj,ikt,jpdsi) * zstep / fse3t(ji,jj,ikt)   &
161# if ! defined key_kriest
162     &               * wsbio4(ji,jj,ikt) 
163# else
164     &               * wscal (ji,jj,ikt)
165# endif
166            trn(ji,jj,ikt,jpdsi) = trn(ji,jj,ikt,jpdsi) - zconctmp
167            trn(ji,jj,ikt,jpsil) = trn(ji,jj,ikt,jpsil) + zconctmp   &
168               &                 * ( 1.- ( sumdepsi + rivalkinput / raass / 6. ) / zsumsedsi )
169         END DO
170      END DO
171
172      DO jj = 1, jpj
173         DO ji = 1, jpi
174            ikt = MAX( mbathy(ji,jj) - 1, 1 )
175            zconctmp = trn(ji,jj,ikt,jpcal) * wscal(ji,jj,ikt) * zstep / fse3t(ji,jj,ikt)
176            trn(ji,jj,ikt,jpcal) = trn(ji,jj,ikt,jpcal) - zconctmp
177            trn(ji,jj,ikt,jptal) = trn(ji,jj,ikt,jptal) + zconctmp   &
178               &                 * ( 1.- ( rivalkinput / raass ) / zsumsedcal ) * 2.e0
179            trn(ji,jj,ikt,jpdic) = trn(ji,jj,ikt,jpdic) + zconctmp   &
180               &                 * ( 1.- ( rivalkinput / raass ) / zsumsedcal )
181         END DO
182      END DO
183
184      DO jj = 1, jpj
185         DO ji = 1, jpi
186            ikt = MAX( mbathy(ji,jj) - 1, 1 )
187# if ! defined key_kriest
188            zconctmp  = trn(ji,jj,ikt,jpgoc)
189            zconctmp2 = trn(ji,jj,ikt,jppoc)
190            trn(ji,jj,ikt,jpgoc) = trn(ji,jj,ikt,jpgoc) - zconctmp  * wsbio4(ji,jj,ikt)   * zstep / fse3t(ji,jj,ikt)
191            trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) - zconctmp2 * wsbio3(ji,jj,ikt)   * zstep / fse3t(ji,jj,ikt)
192            trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc)    &
193               &      + ( zconctmp  * wsbio4(ji,jj,ikt) + zconctmp2 * wsbio3(ji,jj,ikt) ) * zstep / fse3t(ji,jj,ikt)   &
194               &                                        * ( 1.- rivpo4input / (raass * zsumsedpo4 ) )
195            trn(ji,jj,ikt,jpbfe) = trn(ji,jj,ikt,jpbfe) - trn(ji,jj,ikt,jpbfe) * wsbio4(ji,jj,ikt) * zstep   &
196               &          /fse3t(ji,jj,ikt)
197            trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) - trn(ji,jj,ikt,jpsfe) * wsbio3(ji,jj,ikt) * zstep   &
198               &          /fse3t(ji,jj,ikt)
199# else
200            zconctmp  = trn(ji,jj,ikt,jpnum)
201            zconctmp2 = trn(ji,jj,ikt,jppoc)
202            trn(ji,jj,ikt,jpnum) = trn(ji,jj,ikt,jpnum)   &
203               &          - zconctmp * wsbio4(ji,jj,ikt) * zstep / fse3t(ji,jj,ikt)
204            trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc)   &
205               &          - zconctmp2 * wsbio3(ji,jj,ikt) * zstep / fse3t(ji,jj,ikt)
206            trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc)    &
207               &          + ( zconctmp2 * wsbio3(ji,jj,ikt) )   &
208               &          * zstep / fse3t(ji,jj,ikt) * ( 1.- rivpo4input / ( raass * zsumsedpo4 ) )
209            trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe)   &
210               &                 - trn(ji,jj,ikt,jpsfe) * wsbio3(ji,jj,ikt) * zstep / fse3t(ji,jj,ikt)
211# endif
212         END DO
213      END DO
214
215      ! Nitrogen fixation (simple parameterization). The total gain
216      ! from nitrogen fixation is scaled to balance the loss by
217      ! denitrification
218      ! -------------------------------------------------------------
219
220!!gm optimisation : use fs do loop index... or 1 to jpi/j
221      zdenitot = 0.e0
222      DO jk = 1, jpkm1
223         DO jj= 2, jpjm1
224            DO ji = 2, jpim1
225               zdenitot = zdenitot + denitr(ji,jj,jk) * rdenit * e1t(ji,jj) * e2t(ji,jj)   &
226                  &    *fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) * xnegtr(ji,jj,jk)
227            END DO
228         END DO
229      END DO
230
231      IF( lk_mpp )   CALL mpp_sum( zdenitot )      ! sum over the global domain
232
233      ! Potential nitrogen fication dependant on temperature and iron
234      ! -------------------------------------------------------------
235
236!CDIR NOVERRCHK
237      DO jk = 1, jpk
238!CDIR NOVERRCHK
239         DO jj = 1, jpj
240!CDIR NOVERRCHK
241            DO ji = 1, jpi
242               zlim = ( 1.- xnanono3(ji,jj,jk) - xnanonh4(ji,jj,jk) )
243               IF( zlim <= 0.2 )   zlim = 0.01
244               znitrpot(ji,jj,jk) = MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) / rjjss )   &
245# if defined key_off_degrad
246                  &               * facvol(ji,jj,jk)   &
247# endif
248                  &               * zlim * rfact2 * trn(ji,jj,jk,jpfer)   &
249                  &               / ( conc3 + trn(ji,jj,jk,jpfer) ) * ( 1.- EXP( -etot(ji,jj,jk) / 50.) )
250            END DO
251         END DO
252      END DO
253
254      znitrpottot = 0.e0
255      DO jk = 1, jpkm1
256         DO jj = 1, jpj
257            DO ji = 1, jpi
258               znitrpottot = znitrpottot + znitrpot(ji,jj,jk) * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)   &
259                  &                                           * tmask(ji,jj,jk) * tmask_i(ji,jj) 
260            END DO
261         END DO
262      END DO
263
264      IF( lk_mpp )   CALL mpp_sum( znitrpottot )  ! sum over the global domain
265
266      ! Nitrogen change due to nitrogen fixation
267      ! ----------------------------------------
268
269      DO jk = 1, jpk
270         DO jj = 1, jpj
271            DO ji = 1, jpi
272# if ! defined key_cfg_1d && ( defined key_orca_r4 || defined key_orca_r2 || defined key_orca_r05 || defined key_orca_r025 )
273!!               zfact = znitrpot(ji,jj,jk) * zdenitot / znitrpottot
274               zfact = znitrpot(ji,jj,jk) * 1.e-7
275# else
276               zfact = znitrpot(ji,jj,jk) * 1.e-7
277# endif
278               trn(ji,jj,jk,jpnh4) = trn(ji,jj,jk,jpnh4) + zfact
279               trn(ji,jj,jk,jpoxy) = trn(ji,jj,jk,jpoxy) + zfact   * o2nit
280               trn(ji,jj,jk,jppo4) = trn(ji,jj,jk,jppo4) + 30./ 46.* zfact
281            END DO
282         END DO
283      END DO
284
285# if defined key_trc_diaadd
286      DO jj = 1,jpj
287         DO ji = 1,jpi
288            trc2d(ji,jj,13) = znitrpot(ji,jj,1) * 1.e-7 * fse3t(ji,jj,1) * 1.e+3 / rfact2
289            trc2d(ji,jj,12) = zirondep(ji,jj,1) * 1.e+3 * rfact2r * fse3t(ji,jj,1)
290         END DO
291      END DO
292# endif
293      !
294       IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
295         WRITE(charout, FMT="('sed ')")
296         CALL prt_ctl_trc_info(charout)
297         CALL prt_ctl_trc(tab4d=trn, mask=tmask, clinfo=ctrcnm)
298       ENDIF
299
300   END SUBROUTINE p4z_sed
301
302#else
303   !!======================================================================
304   !!  Dummy module :                                   No PISCES bio-model
305   !!======================================================================
306CONTAINS
307   SUBROUTINE p4z_sed                         ! Empty routine
308   END SUBROUTINE p4z_sed
309#endif 
310
311   !!======================================================================
312END MODULE  p4zsed
Note: See TracBrowser for help on using the repository browser.