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 trunk/NEMOGCM/NEMO/TOP_SRC/PISCES – NEMO

source: trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsed.F90 @ 2715

Last change on this file since 2715 was 2715, checked in by rblod, 13 years ago

First attempt to put dynamic allocation on the trunk
  • Property svn:keywords set to Id
File size: 21.9 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   !!   p4z_sbc        :  Read and interpolate time-varying nutrients fluxes
15   !!   p4z_sed_init   :  Initialization of p4z_sed
16   !!----------------------------------------------------------------------
17   USE trc
18   USE oce_trc         !
19   USE sms_pisces
20   USE prtctl_trc
21   USE p4zbio
22   USE p4zint
23   USE p4zopt
24   USE p4zsink
25   USE p4zrem
26   USE p4zlim
27   USE iom
28
29
30   IMPLICIT NONE
31   PRIVATE
32
33   PUBLIC   p4z_sed   
34   PUBLIC   p4z_sed_init   
35   PUBLIC   p4z_sed_alloc
36
37   !! * Shared module variables
38   LOGICAL, PUBLIC :: ln_dustfer  = .FALSE.    !: boolean for dust input from the atmosphere
39   LOGICAL, PUBLIC :: ln_river    = .FALSE.    !: boolean for river input of nutrients
40   LOGICAL, PUBLIC :: ln_ndepo    = .FALSE.    !: boolean for atmospheric deposition of N
41   LOGICAL, PUBLIC :: ln_sedinput = .FALSE.    !: boolean for Fe input from sediments
42
43   REAL(wp), PUBLIC :: sedfeinput = 1.E-9_wp   !: Coastal release of Iron
44   REAL(wp), PUBLIC :: dustsolub  = 0.014_wp   !: Solubility of the dust
45
46   !! * Module variables
47   REAL(wp) :: ryyss                  !: number of seconds per year
48   REAL(wp) :: ryyss1                 !: inverse of ryyss
49   REAL(wp) :: rmtss                  !: number of seconds per month
50   REAL(wp) :: rday1                  !: inverse of rday
51
52   INTEGER , PARAMETER :: jpmth = 12  !: number of months per year
53   INTEGER , PARAMETER :: jpyr  = 1   !: one year
54
55   INTEGER ::  numdust                !: logical unit for surface fluxes data
56   INTEGER ::  nflx1 , nflx2          !: first and second record used
57   INTEGER ::  nflx11, nflx12
58
59   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dustmo    !: set of dust fields
60   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:) :: dust      !: dust fields
61   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:) :: rivinp, cotdep    !: river input fields
62   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:) :: nitdep    !: atmospheric N deposition
63   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ironsed   !: Coastal supply of iron
64
65   REAL(wp) :: sumdepsi, rivalkinput, rivpo4input, nitdepinput
66
67   !!* Substitution
68#  include "top_substitute.h90"
69   !!----------------------------------------------------------------------
70   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
71   !! $Header:$
72   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
73   !!----------------------------------------------------------------------
74
75CONTAINS
76
77
78   SUBROUTINE p4z_sed( kt, jnt )
79      !!---------------------------------------------------------------------
80      !!                     ***  ROUTINE p4z_sed  ***
81      !!
82      !! ** Purpose :   Compute loss of organic matter in the sediments. This
83      !!              is by no way a sediment model. The loss is simply
84      !!              computed to balance the inout from rivers and dust
85      !!
86      !! ** Method  : - ???
87      !!---------------------------------------------------------------------
88      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released
89      USE wrk_nemo, ONLY: zsidep => wrk_2d_1, zwork => wrk_2d_2, zwork1 => wrk_2d_3
90      USE wrk_nemo, ONLY: znitrpot => wrk_3d_2, zirondep => wrk_3d_3
91      !
92      INTEGER, INTENT(in) ::   kt, jnt ! ocean time step
93      INTEGER  ::   ji, jj, jk, ikt
94#if ! defined key_sed
95      REAL(wp) ::   zsumsedsi, zsumsedpo4, zsumsedcal
96      REAL(wp) ::   zrivalk, zrivsil, zrivpo4
97#endif
98      REAL(wp) ::   zdenitot, znitrpottot, zlim, zfact
99      REAL(wp) ::   zwsbio3, zwsbio4, zwscal
100      CHARACTER (len=25) :: charout
101      !!---------------------------------------------------------------------
102
103      IF( ( wrk_in_use(2, 1,2,3) ) .OR. ( wrk_in_use(3, 2,3) ) ) THEN
104         CALL ctl_stop('p4z_sed: requested workspace arrays unavailable')  ;  RETURN
105      END IF
106
107      IF( jnt == 1  .AND.  ln_dustfer  )  CALL p4z_sbc( kt )
108
109      ! Iron and Si deposition at the surface
110      ! -------------------------------------
111
112      DO jj = 1, jpj
113         DO ji = 1, jpi
114            zirondep(ji,jj,1) = ( dustsolub * dust(ji,jj) / ( 55.85 * rmtss ) + 3.e-10 * ryyss1 )   &
115               &             * rfact2 / fse3t(ji,jj,1)
116            zsidep  (ji,jj)   = 8.8 * 0.075 * dust(ji,jj) * rfact2 / ( fse3t(ji,jj,1) * 28.1 * rmtss )
117         END DO
118      END DO
119
120      ! Iron solubilization of particles in the water column
121      ! ----------------------------------------------------
122
123      DO jk = 2, jpkm1
124         zirondep(:,:,jk) = dust(:,:) / ( 10. * 55.85 * rmtss ) * rfact2 * 1.e-4
125      END DO
126
127      ! Add the external input of nutrients, carbon and alkalinity
128      ! ----------------------------------------------------------
129
130      trn(:,:,1,jppo4) = trn(:,:,1,jppo4) + rivinp(:,:) * rfact2 
131      trn(:,:,1,jpno3) = trn(:,:,1,jpno3) + (rivinp(:,:) + nitdep(:,:)) * rfact2
132      trn(:,:,1,jpfer) = trn(:,:,1,jpfer) + rivinp(:,:) * 3.e-5 * rfact2
133      trn(:,:,1,jpsil) = trn(:,:,1,jpsil) + zsidep (:,:) + cotdep(:,:)   * rfact2 / 6.
134      trn(:,:,1,jpdic) = trn(:,:,1,jpdic) + rivinp(:,:) * 2.631 * rfact2
135      trn(:,:,1,jptal) = trn(:,:,1,jptal) + (cotdep(:,:) - rno3*(rivinp(:,:) +  nitdep(:,:) ) ) * rfact2
136
137
138      ! Add the external input of iron which is 3D distributed
139      ! (dust, river and sediment mobilization)
140      ! ------------------------------------------------------
141
142      DO jk = 1, jpkm1
143         trn(:,:,jk,jpfer) = trn(:,:,jk,jpfer) + zirondep(:,:,jk) + ironsed(:,:,jk) * rfact2
144      END DO
145
146
147#if ! defined key_sed
148      ! Loss of biogenic silicon, Caco3 organic carbon in the sediments.
149      ! First, the total loss is computed.
150      ! The factor for calcite comes from the alkalinity effect
151      ! -------------------------------------------------------------
152      DO jj = 1, jpj
153         DO ji = 1, jpi
154            ikt = mbkt(ji,jj) 
155# if defined key_kriest
156            zwork (ji,jj) = trn(ji,jj,ikt,jpdsi) * wscal (ji,jj,ikt)
157            zwork1(ji,jj) = trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt)
158# else
159            zwork (ji,jj) = trn(ji,jj,ikt,jpdsi) * wsbio4(ji,jj,ikt)
160            zwork1(ji,jj) = trn(ji,jj,ikt,jpgoc) * wsbio4(ji,jj,ikt) + trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt) 
161# endif
162         END DO
163      END DO
164      zsumsedsi  = glob_sum( zwork (:,:) * e1e2t(:,:) ) * rday1
165      zsumsedpo4 = glob_sum( zwork1(:,:) * e1e2t(:,:) ) * rday1
166      DO jj = 1, jpj
167         DO ji = 1, jpi
168            ikt = mbkt(ji,jj) 
169            zwork (ji,jj) = trn(ji,jj,ikt,jpcal) * wscal (ji,jj,ikt)
170         END DO
171      END DO
172      zsumsedcal = glob_sum( zwork (:,:) * e1e2t(:,:) ) * 2.0 * rday1
173#endif
174
175      ! Then this loss is scaled at each bottom grid cell for
176      ! equilibrating the total budget of silica in the ocean.
177      ! Thus, the amount of silica lost in the sediments equal
178      ! the supply at the surface (dust+rivers)
179      ! ------------------------------------------------------
180
181      DO jj = 1, jpj
182         DO ji = 1, jpi
183            ikt = mbkt(ji,jj)
184            zfact = xstep / fse3t(ji,jj,ikt)
185            zwsbio3 = 1._wp - zfact * wsbio3(ji,jj,ikt)
186            zwsbio4 = 1._wp - zfact * wsbio4(ji,jj,ikt)
187            zwscal  = 1._wp - zfact * wscal (ji,jj,ikt)
188            !
189# if defined key_kriest
190            trn(ji,jj,ikt,jpdsi) = trn(ji,jj,ikt,jpdsi) * zwsbio4
191            trn(ji,jj,ikt,jpnum) = trn(ji,jj,ikt,jpnum) * zwsbio4
192            trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) * zwsbio3
193            trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) * zwsbio3
194# else
195            trn(ji,jj,ikt,jpdsi) = trn(ji,jj,ikt,jpdsi) * zwscal 
196            trn(ji,jj,ikt,jpgoc) = trn(ji,jj,ikt,jpgoc) * zwsbio4
197            trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) * zwsbio3
198            trn(ji,jj,ikt,jpbfe) = trn(ji,jj,ikt,jpbfe) * zwsbio4
199            trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) * zwsbio3
200# endif
201            trn(ji,jj,ikt,jpcal) = trn(ji,jj,ikt,jpcal) * zwscal
202         END DO
203      END DO
204
205#if ! defined key_sed
206      zrivsil =  1._wp - ( sumdepsi + rivalkinput * ryyss1 / 6. ) / zsumsedsi 
207      zrivalk =  1._wp - ( rivalkinput * ryyss1 ) / zsumsedcal 
208      zrivpo4 =  1._wp - ( rivpo4input * ryyss1 ) / zsumsedpo4 
209      DO jj = 1, jpj
210         DO ji = 1, jpi
211            ikt = mbkt(ji,jj)
212            zfact = xstep / fse3t(ji,jj,ikt)
213            zwsbio3 = zfact * wsbio3(ji,jj,ikt)
214            zwsbio4 = zfact * wsbio4(ji,jj,ikt)
215            zwscal  = zfact * wscal (ji,jj,ikt)
216            trn(ji,jj,ikt,jptal) =  trn(ji,jj,ikt,jptal) + trn(ji,jj,ikt,jpcal) * zwscal  * zrivalk * 2.0
217            trn(ji,jj,ikt,jpdic) =  trn(ji,jj,ikt,jpdic) + trn(ji,jj,ikt,jpcal) * zwscal  * zrivalk
218# if defined key_kriest
219            trn(ji,jj,ikt,jpsil) =  trn(ji,jj,ikt,jpsil) + trn(ji,jj,ikt,jpdsi) * zwsbio4 * zrivsil 
220            trn(ji,jj,ikt,jpdoc) =  trn(ji,jj,ikt,jpdoc) + trn(ji,jj,ikt,jppoc) * zwsbio3 * zrivpo4 
221# else
222            trn(ji,jj,ikt,jpsil) =  trn(ji,jj,ikt,jpsil) + trn(ji,jj,ikt,jpdsi) * zwscal  * zrivsil 
223            trn(ji,jj,ikt,jpdoc) =  trn(ji,jj,ikt,jpdoc)   &
224            &                     + ( trn(ji,jj,ikt,jppoc) * zwsbio3 + trn(ji,jj,ikt,jpgoc) * zwsbio4 ) * zrivpo4
225# endif
226         END DO
227      END DO
228# endif
229
230      ! Nitrogen fixation (simple parameterization). The total gain
231      ! from nitrogen fixation is scaled to balance the loss by
232      ! denitrification
233      ! -------------------------------------------------------------
234
235      zdenitot = glob_sum( denitr(:,:,:)  * cvol(:,:,:) * xnegtr(:,:,:) ) * rdenit
236
237      ! Potential nitrogen fixation dependant on temperature and iron
238      ! -------------------------------------------------------------
239
240!CDIR NOVERRCHK
241      DO jk = 1, jpk
242!CDIR NOVERRCHK
243         DO jj = 1, jpj
244!CDIR NOVERRCHK
245            DO ji = 1, jpi
246               zlim = ( 1.- xnanono3(ji,jj,jk) - xnanonh4(ji,jj,jk) )
247               IF( zlim <= 0.2 )   zlim = 0.01
248               znitrpot(ji,jj,jk) = MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) * rday1 )   &
249# if defined key_degrad
250               &                  * facvol(ji,jj,jk)   &
251# endif
252               &                  * zlim * rfact2 * trn(ji,jj,jk,jpfer)   &
253               &                  / ( conc3 + trn(ji,jj,jk,jpfer) ) * ( 1.- EXP( -etot(ji,jj,jk) / 50.) )
254            END DO
255         END DO
256      END DO
257
258      znitrpottot = glob_sum( znitrpot(:,:,:) * cvol(:,:,:) )
259
260      ! Nitrogen change due to nitrogen fixation
261      ! ----------------------------------------
262
263      DO jk = 1, jpk
264         DO jj = 1, jpj
265            DO ji = 1, jpi
266               zfact = znitrpot(ji,jj,jk) * 1.e-7
267               trn(ji,jj,jk,jpnh4) = trn(ji,jj,jk,jpnh4) + zfact
268               trn(ji,jj,jk,jpoxy) = trn(ji,jj,jk,jpoxy) + zfact   * o2nit
269               trn(ji,jj,jk,jppo4) = trn(ji,jj,jk,jppo4) + 30./ 46.* zfact
270            END DO
271         END DO
272      END DO
273
274#if defined key_diatrc
275      zfact = 1.e+3 * rfact2r
276#  if  ! defined key_iomput
277      trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1)         * zfact * fse3t(:,:,1) * tmask(:,:,1)
278      trc2d(:,:,jp_pcs0_2d + 12) = znitrpot(:,:,1) * 1.e-7 * zfact * fse3t(:,:,1) * tmask(:,:,1)
279#  else
280      zwork (:,:)  =  ( zirondep(:,:,1) + ironsed(:,:,1) * rfact2 ) * zfact * fse3t(:,:,1) * tmask(:,:,1) 
281      zwork1(:,:)  =  znitrpot(:,:,1) * 1.e-7                       * zfact * fse3t(:,:,1) * tmask(:,:,1)
282      IF( jnt == nrdttrc ) THEN
283         CALL iom_put( "Irondep", zwork  )  ! surface downward net flux of iron
284         CALL iom_put( "Nfix"   , zwork1 )  ! nitrogen fixation at surface
285      ENDIF
286#  endif
287#endif
288      !
289       IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
290         WRITE(charout, FMT="('sed ')")
291         CALL prt_ctl_trc_info(charout)
292         CALL prt_ctl_trc(tab4d=trn, mask=tmask, clinfo=ctrcnm)
293       ENDIF
294
295      IF( ( wrk_not_released(2, 1,2,3) ) .OR. ( wrk_not_released(3, 2,3) ) )   &
296        &         CALL ctl_stop('p4z_sed: failed to release workspace arrays')
297
298   END SUBROUTINE p4z_sed
299
300   SUBROUTINE p4z_sbc( kt )
301
302      !!----------------------------------------------------------------------
303      !!                  ***  ROUTINE p4z_sbc  ***
304      !!
305      !! ** Purpose :   Read and interpolate the external sources of
306      !!                nutrients
307      !!
308      !! ** Method  :   Read the files and interpolate the appropriate variables
309      !!
310      !! ** input   :   external netcdf files
311      !!
312      !!----------------------------------------------------------------------
313      !! * arguments
314      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
315
316      !! * Local declarations
317      INTEGER :: imois, i15, iman 
318      REAL(wp) :: zxy
319
320      !!---------------------------------------------------------------------
321
322      ! Initialization
323      ! --------------
324
325      i15 = nday / 16
326      iman  = INT( raamo )
327      imois = nmonth + i15 - 1
328      IF( imois == 0 ) imois = iman
329
330      ! Calendar computation
331      IF( kt == nit000 .OR. imois /= nflx1 ) THEN
332
333         IF( kt == nit000 )  nflx1  = 0
334
335         ! nflx1 number of the first file record used in the simulation
336         ! nflx2 number of the last  file record
337
338         nflx1 = imois
339         nflx2 = nflx1 + 1
340         nflx1 = MOD( nflx1, iman )
341         nflx2 = MOD( nflx2, iman )
342         IF( nflx1 == 0 )   nflx1 = iman
343         IF( nflx2 == 0 )   nflx2 = iman
344         IF(lwp) WRITE(numout,*) 
345         IF(lwp) WRITE(numout,*) ' p4z_sbc : first record file used nflx1 ',nflx1
346         IF(lwp) WRITE(numout,*) ' p4z_sbc : last  record file used nflx2 ',nflx2
347
348      ENDIF
349
350      ! 3. at every time step interpolation of fluxes
351      ! ---------------------------------------------
352
353      zxy = FLOAT( nday + 15 - 30 * i15 ) / 30
354      dust(:,:) = ( (1.-zxy) * dustmo(:,:,nflx1) + zxy * dustmo(:,:,nflx2) )
355
356   END SUBROUTINE p4z_sbc
357
358
359   SUBROUTINE p4z_sed_init
360
361      !!----------------------------------------------------------------------
362      !!                  ***  ROUTINE p4z_sed_init  ***
363      !!
364      !! ** Purpose :   Initialization of the external sources of nutrients
365      !!
366      !! ** Method  :   Read the files and compute the budget
367      !!      called at the first timestep (nit000)
368      !!
369      !! ** input   :   external netcdf files
370      !!
371      !!----------------------------------------------------------------------
372
373      INTEGER :: ji, jj, jk, jm
374      INTEGER :: numriv, numbath, numdep
375
376
377      REAL(wp) ::   zcoef
378      REAL(wp) ::   expide, denitide,zmaskt
379      REAL(wp) , DIMENSION (jpi,jpj)     ::   riverdoc, river, ndepo
380      REAL(wp) , DIMENSION (jpi,jpj,jpk) ::   cmask
381
382      NAMELIST/nampissed/ ln_dustfer, ln_river, ln_ndepo, ln_sedinput, sedfeinput, dustsolub
383
384
385      REWIND( numnat )                     ! read numnat
386      READ  ( numnat, nampissed )
387
388      IF(lwp) THEN
389         WRITE(numout,*) ' '
390         WRITE(numout,*) ' Namelist : nampissed '
391         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~ '
392         WRITE(numout,*) '    Dust input from the atmosphere           ln_dustfer  = ', ln_dustfer
393         WRITE(numout,*) '    River input of nutrients                 ln_river    = ', ln_river
394         WRITE(numout,*) '    Atmospheric deposition of N              ln_ndepo    = ', ln_ndepo
395         WRITE(numout,*) '    Fe input from sediments                  ln_sedinput = ', ln_sedinput
396         WRITE(numout,*) '    Coastal release of Iron                  sedfeinput  =', sedfeinput
397         WRITE(numout,*) '    Solubility of the dust                   dustsolub   =', dustsolub
398      ENDIF
399
400      ! Dust input from the atmosphere
401      ! ------------------------------
402      IF( ln_dustfer ) THEN
403         IF(lwp) WRITE(numout,*) '    Initialize dust input from atmosphere '
404         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
405         CALL iom_open ( 'dust.orca.nc', numdust )
406         DO jm = 1, jpmth
407            CALL iom_get( numdust, jpdom_data, 'dust', dustmo(:,:,jm), jm )
408         END DO
409         CALL iom_close( numdust )
410      ELSE
411         dustmo(:,:,:) = 0.e0
412         dust(:,:) = 0.0
413      ENDIF
414
415      ! Nutrient input from rivers
416      ! --------------------------
417      IF( ln_river ) THEN
418         IF(lwp) WRITE(numout,*) '    Initialize the nutrient input by rivers from river.orca.nc file'
419         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
420         CALL iom_open ( 'river.orca.nc', numriv )
421         CALL iom_get  ( numriv, jpdom_data, 'riverdic', river   (:,:), jpyr )
422         CALL iom_get  ( numriv, jpdom_data, 'riverdoc', riverdoc(:,:), jpyr )
423         CALL iom_close( numriv )
424      ELSE
425         river   (:,:) = 0.e0
426         riverdoc(:,:) = 0.e0
427      endif
428
429      ! Nutrient input from dust
430      ! ------------------------
431      IF( ln_ndepo ) THEN
432         IF(lwp) WRITE(numout,*) '    Initialize the nutrient input by dust from ndeposition.orca.nc'
433         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
434         CALL iom_open ( 'ndeposition.orca.nc', numdep )
435         CALL iom_get  ( numdep, jpdom_data, 'ndep', ndepo(:,:), jpyr )
436         CALL iom_close( numdep )
437      ELSE
438         ndepo(:,:) = 0.e0
439      ENDIF
440
441      ! Coastal and island masks
442      ! ------------------------
443      IF( ln_sedinput ) THEN     
444         IF(lwp) WRITE(numout,*) '    Computation of an island mask to enhance coastal supply of iron'
445         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
446         IF(lwp) WRITE(numout,*) '       from bathy.orca.nc file '
447         CALL iom_open ( 'bathy.orca.nc', numbath )
448         CALL iom_get  ( numbath, jpdom_data, 'bathy', cmask(:,:,:), jpyr )
449         CALL iom_close( numbath )
450         !
451         DO jk = 1, 5
452            DO jj = 2, jpjm1
453               DO ji = fs_2, fs_jpim1
454                  IF( tmask(ji,jj,jk) /= 0. ) THEN
455                     zmaskt = tmask(ji+1,jj,jk) * tmask(ji-1,jj,jk) * tmask(ji,jj+1,jk)    &
456                        &                       * tmask(ji,jj-1,jk) * tmask(ji,jj,jk+1)
457                     IF( zmaskt == 0. )   cmask(ji,jj,jk ) = MAX( 0.1, cmask(ji,jj,jk) ) 
458                  ENDIF
459               END DO
460            END DO
461         END DO
462         DO jk = 1, jpk
463            DO jj = 1, jpj
464               DO ji = 1, jpi
465                  expide   = MIN( 8.,( fsdept(ji,jj,jk) / 500. )**(-1.5) )
466                  denitide = -0.9543 + 0.7662 * LOG( expide ) - 0.235 * LOG( expide )**2
467                  cmask(ji,jj,jk) = cmask(ji,jj,jk) * MIN( 1., EXP( denitide ) / 0.5 )
468               END DO
469            END DO
470         END DO
471      ELSE
472         cmask(:,:,:) = 0.e0
473      ENDIF
474
475      CALL lbc_lnk( cmask , 'T', 1. )      ! Lateral boundary conditions on cmask   (sign unchanged)
476
477
478      !                                    ! Number of seconds per year and per month
479      ryyss  = nyear_len(1) * rday
480      rmtss  = ryyss / raamo
481      rday1  = 1. / rday
482      ryyss1 = 1. / ryyss
483      !                                    ! ocean surface cell
484
485      ! total atmospheric supply of Si
486      ! ------------------------------
487      sumdepsi = 0.e0
488      DO jm = 1, jpmth
489         zcoef = 1. / ( 12. * rmtss ) * 8.8 * 0.075 / 28.1       
490         sumdepsi = sumdepsi + glob_sum( dustmo(:,:,jm) * e1e2t(:,:) ) * zcoef
491      ENDDO
492
493      ! N/P and Si releases due to coastal rivers
494      ! -----------------------------------------
495      DO jj = 1, jpj
496         DO ji = 1, jpi
497            zcoef = ryyss * e1e2t(ji,jj)  * fse3t(ji,jj,1) * tmask(ji,jj,1) 
498            cotdep(ji,jj) =  river(ji,jj)                  *1E9 / ( 12. * zcoef + rtrn )
499            rivinp(ji,jj) = (river(ji,jj)+riverdoc(ji,jj)) *1E9 / ( 31.6* zcoef + rtrn )
500            nitdep(ji,jj) = 7.6 * ndepo(ji,jj)                  / ( 14E6*ryyss*fse3t(ji,jj,1) + rtrn )
501         END DO
502      END DO
503      ! Lateral boundary conditions on ( cotdep, rivinp, nitdep )   (sign unchanged)
504      CALL lbc_lnk( cotdep , 'T', 1. )  ;  CALL lbc_lnk( rivinp , 'T', 1. )  ;  CALL lbc_lnk( nitdep , 'T', 1. )
505
506      rivpo4input = glob_sum( rivinp(:,:) * cvol(:,:,1) ) * ryyss
507      rivalkinput = glob_sum( cotdep(:,:) * cvol(:,:,1) ) * ryyss
508      nitdepinput = glob_sum( nitdep(:,:) * cvol(:,:,1) ) * ryyss
509
510
511      ! Coastal supply of iron
512      ! -------------------------
513      DO jk = 1, jpkm1
514         ironsed(:,:,jk) = sedfeinput * cmask(:,:,jk) / ( fse3t(:,:,jk) * rday )
515      END DO
516      CALL lbc_lnk( ironsed , 'T', 1. )      ! Lateral boundary conditions on ( ironsed )   (sign unchanged)
517
518
519   END SUBROUTINE p4z_sed_init
520
521   INTEGER FUNCTION p4z_sed_alloc()
522      !!----------------------------------------------------------------------
523      !!                     ***  ROUTINE p4z_sed_alloc  ***
524      !!----------------------------------------------------------------------
525
526      ALLOCATE( dustmo(jpi,jpj,jpmth), dust(jpi,jpj)       ,     &
527        &       rivinp(jpi,jpj)      , cotdep(jpi,jpj)     ,     &
528        &       nitdep(jpi,jpj)      , ironsed(jpi,jpj,jpk), STAT=p4z_sed_alloc ) 
529
530      IF( p4z_sed_alloc /= 0 ) CALL ctl_warn('p4z_sed_alloc : failed to allocate arrays.')
531
532   END FUNCTION p4z_sed_alloc
533#else
534   !!======================================================================
535   !!  Dummy module :                                   No PISCES bio-model
536   !!======================================================================
537CONTAINS
538   SUBROUTINE p4z_sed                         ! Empty routine
539   END SUBROUTINE p4z_sed
540#endif 
541
542   !!======================================================================
543END MODULE  p4zsed
Note: See TracBrowser for help on using the repository browser.