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

source: branches/2011/dev_r2802_TOP_substepping/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsed.F90 @ 2830

Last change on this file since 2830 was 2830, checked in by kpedwards, 13 years ago

Updates to average physics variables for TOP substepping.
  • Property svn:keywords set to Id
File size: 22.4 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 == nittrc000 .OR. imois /= nflx1 ) THEN
332
333         IF( kt == nittrc000 )  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      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released
373      USE wrk_nemo, ONLY: zriverdoc => wrk_2d_1, zriver => wrk_2d_2, zndepo => wrk_2d_3
374      USE wrk_nemo, ONLY: zcmask => wrk_3d_2
375      !
376      INTEGER :: ji, jj, jk, jm
377      INTEGER :: numriv, numbath, numdep
378      REAL(wp) ::   zcoef
379      REAL(wp) ::   expide, denitide,zmaskt
380      !
381      NAMELIST/nampissed/ ln_dustfer, ln_river, ln_ndepo, ln_sedinput, sedfeinput, dustsolub
382      !!----------------------------------------------------------------------
383
384      IF( ( wrk_in_use(2, 1,2,3) ) .OR. ( wrk_in_use(3, 2) ) ) THEN
385         CALL ctl_stop('p4z_sed_init: requested workspace arrays unavailable')  ;  RETURN
386      END IF
387      !
388      REWIND( numnat )                     ! read numnat
389      READ  ( numnat, nampissed )
390
391      IF(lwp) THEN
392         WRITE(numout,*) ' '
393         WRITE(numout,*) ' Namelist : nampissed '
394         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~ '
395         WRITE(numout,*) '    Dust input from the atmosphere           ln_dustfer  = ', ln_dustfer
396         WRITE(numout,*) '    River input of nutrients                 ln_river    = ', ln_river
397         WRITE(numout,*) '    Atmospheric deposition of N              ln_ndepo    = ', ln_ndepo
398         WRITE(numout,*) '    Fe input from sediments                  ln_sedinput = ', ln_sedinput
399         WRITE(numout,*) '    Coastal release of Iron                  sedfeinput  =', sedfeinput
400         WRITE(numout,*) '    Solubility of the dust                   dustsolub   =', dustsolub
401      ENDIF
402
403      ! Dust input from the atmosphere
404      ! ------------------------------
405      IF( ln_dustfer ) THEN
406         IF(lwp) WRITE(numout,*) '    Initialize dust input from atmosphere '
407         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
408         CALL iom_open ( 'dust.orca.nc', numdust )
409         DO jm = 1, jpmth
410            CALL iom_get( numdust, jpdom_data, 'dust', dustmo(:,:,jm), jm )
411         END DO
412         CALL iom_close( numdust )
413      ELSE
414         dustmo(:,:,:) = 0.e0
415         dust(:,:) = 0.0
416      ENDIF
417
418      ! Nutrient input from rivers
419      ! --------------------------
420      IF( ln_river ) THEN
421         IF(lwp) WRITE(numout,*) '    Initialize the nutrient input by rivers from river.orca.nc file'
422         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
423         CALL iom_open ( 'river.orca.nc', numriv )
424         CALL iom_get  ( numriv, jpdom_data, 'riverdic', zriver   (:,:), jpyr )
425         CALL iom_get  ( numriv, jpdom_data, 'riverdoc', zriverdoc(:,:), jpyr )
426         CALL iom_close( numriv )
427      ELSE
428         zriver   (:,:) = 0.e0
429         zriverdoc(:,:) = 0.e0
430      endif
431
432      ! Nutrient input from dust
433      ! ------------------------
434      IF( ln_ndepo ) THEN
435         IF(lwp) WRITE(numout,*) '    Initialize the nutrient input by dust from ndeposition.orca.nc'
436         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
437         CALL iom_open ( 'ndeposition.orca.nc', numdep )
438         CALL iom_get  ( numdep, jpdom_data, 'ndep', zndepo(:,:), jpyr )
439         CALL iom_close( numdep )
440      ELSE
441         zndepo(:,:) = 0.e0
442      ENDIF
443
444      ! Coastal and island masks
445      ! ------------------------
446      IF( ln_sedinput ) THEN     
447         IF(lwp) WRITE(numout,*) '    Computation of an island mask to enhance coastal supply of iron'
448         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
449         IF(lwp) WRITE(numout,*) '       from bathy.orca.nc file '
450         CALL iom_open ( 'bathy.orca.nc', numbath )
451         CALL iom_get  ( numbath, jpdom_data, 'bathy', zcmask(:,:,:), jpyr )
452         CALL iom_close( numbath )
453         !
454         DO jk = 1, 5
455            DO jj = 2, jpjm1
456               DO ji = fs_2, fs_jpim1
457                  IF( tmask(ji,jj,jk) /= 0. ) THEN
458                     zmaskt = tmask(ji+1,jj,jk) * tmask(ji-1,jj,jk) * tmask(ji,jj+1,jk)    &
459                        &                       * tmask(ji,jj-1,jk) * tmask(ji,jj,jk+1)
460                     IF( zmaskt == 0. )   zcmask(ji,jj,jk ) = MAX( 0.1, zcmask(ji,jj,jk) ) 
461                  ENDIF
462               END DO
463            END DO
464         END DO
465         DO jk = 1, jpk
466            DO jj = 1, jpj
467               DO ji = 1, jpi
468                  expide   = MIN( 8.,( fsdept(ji,jj,jk) / 500. )**(-1.5) )
469                  denitide = -0.9543 + 0.7662 * LOG( expide ) - 0.235 * LOG( expide )**2
470                  zcmask(ji,jj,jk) = zcmask(ji,jj,jk) * MIN( 1., EXP( denitide ) / 0.5 )
471               END DO
472            END DO
473         END DO
474      ELSE
475         zcmask(:,:,:) = 0.e0
476      ENDIF
477
478      CALL lbc_lnk( zcmask , 'T', 1. )      ! Lateral boundary conditions on zcmask   (sign unchanged)
479
480
481      !                                    ! Number of seconds per year and per month
482      ryyss  = nyear_len(1) * rday
483      rmtss  = ryyss / raamo
484      rday1  = 1. / rday
485      ryyss1 = 1. / ryyss
486      !                                    ! ocean surface cell
487
488      ! total atmospheric supply of Si
489      ! ------------------------------
490      sumdepsi = 0.e0
491      DO jm = 1, jpmth
492         zcoef = 1. / ( 12. * rmtss ) * 8.8 * 0.075 / 28.1       
493         sumdepsi = sumdepsi + glob_sum( dustmo(:,:,jm) * e1e2t(:,:) ) * zcoef
494      ENDDO
495
496      ! N/P and Si releases due to coastal rivers
497      ! -----------------------------------------
498      DO jj = 1, jpj
499         DO ji = 1, jpi
500            zcoef = ryyss * e1e2t(ji,jj)  * fse3t(ji,jj,1) * tmask(ji,jj,1) 
501            cotdep(ji,jj) =  zriver(ji,jj)                  *1E9 / ( 12. * zcoef + rtrn )
502            rivinp(ji,jj) = (zriver(ji,jj)+zriverdoc(ji,jj)) *1E9 / ( 31.6* zcoef + rtrn )
503            nitdep(ji,jj) = 7.6 * zndepo(ji,jj)                  / ( 14E6*ryyss*fse3t(ji,jj,1) + rtrn )
504         END DO
505      END DO
506      ! Lateral boundary conditions on ( cotdep, rivinp, nitdep )   (sign unchanged)
507      CALL lbc_lnk( cotdep , 'T', 1. )  ;  CALL lbc_lnk( rivinp , 'T', 1. )  ;  CALL lbc_lnk( nitdep , 'T', 1. )
508
509      rivpo4input = glob_sum( rivinp(:,:) * cvol(:,:,1) ) * ryyss
510      rivalkinput = glob_sum( cotdep(:,:) * cvol(:,:,1) ) * ryyss
511      nitdepinput = glob_sum( nitdep(:,:) * cvol(:,:,1) ) * ryyss
512
513
514      ! Coastal supply of iron
515      ! -------------------------
516      DO jk = 1, jpkm1
517         ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( fse3t(:,:,jk) * rday )
518      END DO
519      CALL lbc_lnk( ironsed , 'T', 1. )      ! Lateral boundary conditions on ( ironsed )   (sign unchanged)
520
521      IF( ( wrk_not_released(2, 1,2,3) ) .OR. ( wrk_not_released(3, 2) ) )   &
522        &         CALL ctl_stop('p4z_sed_init: failed to release workspace arrays')
523
524   END SUBROUTINE p4z_sed_init
525
526   INTEGER FUNCTION p4z_sed_alloc()
527      !!----------------------------------------------------------------------
528      !!                     ***  ROUTINE p4z_sed_alloc  ***
529      !!----------------------------------------------------------------------
530
531      ALLOCATE( dustmo(jpi,jpj,jpmth), dust(jpi,jpj)       ,     &
532        &       rivinp(jpi,jpj)      , cotdep(jpi,jpj)     ,     &
533        &       nitdep(jpi,jpj)      , ironsed(jpi,jpj,jpk), STAT=p4z_sed_alloc ) 
534
535      IF( p4z_sed_alloc /= 0 ) CALL ctl_warn('p4z_sed_alloc : failed to allocate arrays.')
536
537   END FUNCTION p4z_sed_alloc
538#else
539   !!======================================================================
540   !!  Dummy module :                                   No PISCES bio-model
541   !!======================================================================
542CONTAINS
543   SUBROUTINE p4z_sed                         ! Empty routine
544   END SUBROUTINE p4z_sed
545#endif 
546
547   !!======================================================================
548END MODULE  p4zsed
Note: See TracBrowser for help on using the repository browser.