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

source: trunk/NEMO/TOP_SRC/PISCES/p4zsed.F90 @ 1255

Last change on this file since 1255 was 1255, checked in by cetlod, 15 years ago

minor modifications in all top models, see ticket:299
  • Property svn:executable set to *
  • Property svn:keywords set to Id
File size: 23.1 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 lib_mpp
21   USE prtctl_trc
22   USE p4zbio
23   USE p4zint
24   USE p4zopt
25   USE p4zsink
26   USE p4zrem
27   USE p4zlim
28   USE lbclnk
29   USE iom
30
31
32   IMPLICIT NONE
33   PRIVATE
34
35   PUBLIC   p4z_sed   
36
37   !! * Shared module variables
38   LOGICAL, PUBLIC ::    &
39     bdustfer  = .FALSE.      ,  &  !:
40     briver    = .FALSE.      ,  &  !:
41     bndepo    = .FALSE.      ,  &  !:
42     bsedinput = .FALSE.            !:
43
44   REAL(wp), PUBLIC ::   &
45     sedfeinput = 1.E-9_wp   ,  &  !:
46     dustsolub  = 0.014_wp         !:
47
48   !! * Module variables
49   INTEGER ::          &
50      numdust,          &  ! logical unit for surface fluxes data
51      nflx1 , nflx2,   &  !  first and second record used
52      nflx11, nflx12      ! ???
53   REAL(wp), DIMENSION(jpi,jpj,2) ::    &  !:
54     dustmo                                !: 2 consecutive set of dust fields
55   REAL(wp), DIMENSION(jpi,jpj)   ::    &
56     rivinp, cotdep, nitdep, dust
57   REAL(wp), DIMENSION(jpi,jpj,jpk)  ::   &
58     ironsed
59   REAL(wp) :: sumdepsi, rivalkinput, rivpo4input, nitdepinput
60
61   !!* Substitution
62#  include "domzgr_substitute.h90"
63   !!----------------------------------------------------------------------
64   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)
65   !! $Header:$
66   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
67   !!----------------------------------------------------------------------
68
69CONTAINS
70
71   SUBROUTINE p4z_sed(kt, jnt)
72      !!---------------------------------------------------------------------
73      !!                     ***  ROUTINE p4z_sed  ***
74      !!
75      !! ** Purpose :   Compute loss of organic matter in the sediments. This
76      !!              is by no way a sediment model. The loss is simply
77      !!              computed to balance the inout from rivers and dust
78      !!
79      !! ** Method  : - ???
80      !!---------------------------------------------------------------------
81      INTEGER, INTENT(in) ::   kt, jnt ! ocean time step
82      INTEGER  ::   ji, jj, jk
83      INTEGER  ::   ikt
84#if ! defined key_sed
85      REAL(wp) ::   zsumsedsi, zsumsedpo4, zsumsedcal
86#endif
87      REAL(wp) ::   zconctmp , zdenitot  , znitrpottot
88      REAL(wp) ::   zlim, zconctmp2, zstep, zfact
89      REAL(wp), DIMENSION(jpi,jpj)     ::   zsidep
90      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   znitrpot, zirondep
91      CHARACTER (len=25) :: charout
92      !!---------------------------------------------------------------------
93
94
95      IF( ( kt * jnt ) == nittrc000  )   CALL p4z_sed_init      ! Initialization (first time-step only)
96
97      IF( (jnt == 1) .and. (bdustfer) )  CALL p4z_sbc( kt )
98
99      zstep = rfact2 / rjjss      ! Time step duration for the biology
100
101      zirondep(:,:,:) = 0.e0          ! Initialisation of variables used to compute deposition
102      zsidep  (:,:)   = 0.e0
103
104      ! Iron and Si deposition at the surface
105      ! -------------------------------------
106
107      DO jj = 1, jpj
108         DO ji = 1, jpi
109            zirondep(ji,jj,1) = ( dustsolub * dust(ji,jj) / ( 55.85 * rmoss ) + 3.e-10 / raass )   &
110               &             * rfact2 / fse3t(ji,jj,1)
111            zsidep  (ji,jj)   = 8.8 * 0.075 * dust(ji,jj) * rfact2 / ( fse3t(ji,jj,1) * 28.1 * rmoss )
112         END DO
113      END DO
114
115      ! Iron solubilization of particles in the water column
116      ! ----------------------------------------------------
117
118      DO jk = 2, jpkm1
119         zirondep(:,:,jk) = dust(:,:) / ( 10. * 55.85 * rmoss ) * rfact2 * 1.e-4
120      END DO
121
122      ! Add the external input of nutrients, carbon and alkalinity
123      ! ----------------------------------------------------------
124
125      trn(:,:,1,jppo4) = trn(:,:,1,jppo4) + rivinp(:,:) * rfact2 
126      trn(:,:,1,jpno3) = trn(:,:,1,jpno3) + (rivinp(:,:) + nitdep(:,:)) * rfact2
127      trn(:,:,1,jpfer) = trn(:,:,1,jpfer) + rivinp(:,:) * 3.e-5 * rfact2
128      trn(:,:,1,jpsil) = trn(:,:,1,jpsil) + zsidep (:,:) + cotdep(:,:)   * rfact2 / 6.
129      trn(:,:,1,jpdic) = trn(:,:,1,jpdic) + rivinp(:,:) * 2.631 * rfact2
130      trn(:,:,1,jptal) = trn(:,:,1,jptal) + (cotdep(:,:) - rno3*(rivinp(:,:) +  nitdep(:,:) ) ) * rfact2
131
132
133      ! Add the external input of iron which is 3D distributed
134      ! (dust, river and sediment mobilization)
135      ! ------------------------------------------------------
136
137      DO jk = 1, jpkm1
138         trn(:,:,jk,jpfer) = trn(:,:,jk,jpfer)   &
139         &       + zirondep(:,:,jk) + ironsed(:,:,jk) * rfact2
140      END DO
141
142
143#if ! defined key_sed
144
145      ! Initialisation of variables used to compute Sinking Speed
146      ! ---------------------------------------------------------
147
148      zsumsedsi  = 0.e0
149      zsumsedpo4 = 0.e0
150      zsumsedcal = 0.e0
151
152      ! Loss of biogenic silicon, Caco3 organic carbon in the sediments.
153      ! First, the total loss is computed.
154      ! The factor for calcite comes from the alkalinity effect
155      ! -------------------------------------------------------------
156
157      DO jj = 1, jpj
158         DO ji = 1, jpi
159            ikt = MAX( mbathy(ji,jj)-1, 1 )
160            zfact = e1t(ji,jj) * e2t(ji,jj) / rjjss * tmask_i(ji,jj)
161
162# if defined key_kriest
163            zsumsedsi  = zsumsedsi  + zfact *  trn(ji,jj,ikt,jpdsi) * wscal (ji,jj,ikt)
164            zsumsedpo4 = zsumsedpo4 + zfact *  trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt)
165# else
166            zsumsedsi  = zsumsedsi  + zfact *  trn(ji,jj,ikt,jpdsi) * wsbio4(ji,jj,ikt)
167            zsumsedpo4 = zsumsedpo4 + zfact *( trn(ji,jj,ikt,jpgoc) * wsbio4(ji,jj,ikt)   &
168               &       + trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt) )
169# endif
170
171            zsumsedcal = zsumsedcal + zfact *  trn(ji,jj,ikt,jpcal) * wscal (ji,jj,ikt) * 2.e0
172
173         END DO
174      END DO
175
176      IF( lk_mpp ) THEN
177         CALL mpp_sum( zsumsedsi  )   ! sums over the global domain
178         CALL mpp_sum( zsumsedcal )   ! sums over the global domain
179         CALL mpp_sum( zsumsedpo4 )   ! sums over the global domain
180      ENDIF
181
182#endif
183
184      ! Then this loss is scaled at each bottom grid cell for
185      ! equilibrating the total budget of silica in the ocean.
186      ! Thus, the amount of silica lost in the sediments equal
187      ! the supply at the surface (dust+rivers)
188      ! ------------------------------------------------------
189
190      DO jj = 1, jpj
191         DO ji = 1, jpi
192            ikt = MAX( mbathy(ji,jj) - 1, 1 )
193            zconctmp = trn(ji,jj,ikt,jpdsi) * zstep / fse3t(ji,jj,ikt)   &
194# if ! defined key_kriest
195     &             * wscal (ji,jj,ikt)
196# else
197     &             * wsbio4(ji,jj,ikt)
198# endif
199
200            trn(ji,jj,ikt,jpdsi) = trn(ji,jj,ikt,jpdsi) - zconctmp
201
202#if ! defined key_sed
203            trn(ji,jj,ikt,jpsil) = trn(ji,jj,ikt,jpsil) + zconctmp   &
204            &      * ( 1.- ( sumdepsi + rivalkinput / raass / 6. ) / zsumsedsi )
205#endif
206         END DO
207      END DO
208
209      DO jj = 1, jpj
210         DO ji = 1, jpi
211            ikt = MAX( mbathy(ji,jj) - 1, 1 )
212            zconctmp = trn(ji,jj,ikt,jpcal) * wscal(ji,jj,ikt) * zstep / fse3t(ji,jj,ikt)
213            trn(ji,jj,ikt,jpcal) = trn(ji,jj,ikt,jpcal) - zconctmp
214
215#if ! defined key_sed
216            trn(ji,jj,ikt,jptal) = trn(ji,jj,ikt,jptal) + zconctmp   &
217               &   * ( 1.- ( rivalkinput / raass ) / zsumsedcal ) * 2.e0
218            trn(ji,jj,ikt,jpdic) = trn(ji,jj,ikt,jpdic) + zconctmp   &
219               &   * ( 1.- ( rivalkinput / raass ) / zsumsedcal )
220#endif
221         END DO
222      END DO
223
224      DO jj = 1, jpj
225         DO ji = 1, jpi
226            ikt = MAX( mbathy(ji,jj) - 1, 1 )
227            zfact = zstep / fse3t(ji,jj,ikt)
228
229# if ! defined key_kriest
230            zconctmp  = trn(ji,jj,ikt,jpgoc)
231            zconctmp2 = trn(ji,jj,ikt,jppoc)
232            trn(ji,jj,ikt,jpgoc) = trn(ji,jj,ikt,jpgoc) - zconctmp  * wsbio4(ji,jj,ikt) * zfact
233            trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) - zconctmp2 * wsbio3(ji,jj,ikt) * zfact
234#if ! defined key_sed
235            trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc)    &
236            &      + ( zconctmp  * wsbio4(ji,jj,ikt) + zconctmp2 * wsbio3(ji,jj,ikt) ) * zfact   &
237            &      * ( 1.- rivpo4input / (raass * zsumsedpo4 ) )
238#endif
239            trn(ji,jj,ikt,jpbfe) = trn(ji,jj,ikt,jpbfe) - trn(ji,jj,ikt,jpbfe) * wsbio4(ji,jj,ikt) * zfact
240            trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) - trn(ji,jj,ikt,jpsfe) * wsbio3(ji,jj,ikt) * zfact
241
242# else
243
244            zconctmp  = trn(ji,jj,ikt,jpnum)
245            zconctmp2 = trn(ji,jj,ikt,jppoc)
246            trn(ji,jj,ikt,jpnum) = trn(ji,jj,ikt,jpnum)   &
247            &      - zconctmp  * wsbio4(ji,jj,ikt) * zfact
248            trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc)   &
249            &      - zconctmp2 * wsbio3(ji,jj,ikt) * zfact
250#if ! defined key_sed
251            trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc)    &
252            &      + ( zconctmp2 * wsbio3(ji,jj,ikt) )   &
253            &      * zfact * ( 1.- rivpo4input / ( raass * zsumsedpo4 ) )
254#endif
255            trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe)   &
256            &      - trn(ji,jj,ikt,jpsfe) * wsbio3(ji,jj,ikt) * zfact
257
258# endif
259         END DO
260      END DO
261
262      ! Nitrogen fixation (simple parameterization). The total gain
263      ! from nitrogen fixation is scaled to balance the loss by
264      ! denitrification
265      ! -------------------------------------------------------------
266
267      zdenitot = 0.e0
268      DO jk = 1, jpkm1
269         DO jj = 1,jpj
270            DO ji = 1,jpi
271               zdenitot = zdenitot + denitr(ji,jj,jk) * rdenit * cvol(ji,jj,jk) * xnegtr(ji,jj,jk)
272            END DO
273         END DO
274      END DO
275
276      IF( lk_mpp )   CALL mpp_sum( zdenitot )      ! sum over the global domain
277
278      ! Potential nitrogen fication dependant on temperature and iron
279      ! -------------------------------------------------------------
280
281!CDIR NOVERRCHK
282      DO jk = 1, jpk
283!CDIR NOVERRCHK
284         DO jj = 1, jpj
285!CDIR NOVERRCHK
286            DO ji = 1, jpi
287               zlim = ( 1.- xnanono3(ji,jj,jk) - xnanonh4(ji,jj,jk) )
288               IF( zlim <= 0.2 )   zlim = 0.01
289               znitrpot(ji,jj,jk) = MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) / rjjss )   &
290# if defined key_off_degrad
291               &                  * facvol(ji,jj,jk)   &
292# endif
293               &                  * zlim * rfact2 * trn(ji,jj,jk,jpfer)   &
294               &                  / ( conc3 + trn(ji,jj,jk,jpfer) ) * ( 1.- EXP( -etot(ji,jj,jk) / 50.) )
295            END DO
296         END DO
297      END DO
298
299      znitrpottot = 0.e0
300      DO jk = 1, jpkm1
301         DO jj = 1, jpj
302            DO ji = 1, jpi
303               znitrpottot = znitrpottot + znitrpot(ji,jj,jk) * cvol(ji,jj,jk)
304            END DO
305         END DO
306      END DO
307
308      IF( lk_mpp )   CALL mpp_sum( znitrpottot )  ! sum over the global domain
309
310      ! Nitrogen change due to nitrogen fixation
311      ! ----------------------------------------
312
313      DO jk = 1, jpk
314         DO jj = 1, jpj
315            DO ji = 1, jpi
316# if ! defined key_c1d && ( defined key_orca_r4 || defined key_orca_r2 || defined key_orca_r05 || defined key_orca_r025 )
317!!             zfact = znitrpot(ji,jj,jk) * zdenitot / znitrpottot
318               zfact = znitrpot(ji,jj,jk) * 1.e-7
319# else
320               zfact = znitrpot(ji,jj,jk) * 1.e-7
321# endif
322               trn(ji,jj,jk,jpnh4) = trn(ji,jj,jk,jpnh4) + zfact
323               trn(ji,jj,jk,jpoxy) = trn(ji,jj,jk,jpoxy) + zfact   * o2nit
324               trn(ji,jj,jk,jppo4) = trn(ji,jj,jk,jppo4) + 30./ 46.* zfact
325            END DO
326         END DO
327      END DO
328
329# if defined key_trc_diaadd
330      DO jj = 1,jpj
331         DO ji = 1,jpi
332            trc2d(ji,jj,jp_pcs0_2d + 11) = zirondep(ji,jj,1) * 1.e+3 * rfact2r * fse3t(ji,jj,1)
333            trc2d(ji,jj,jp_pcs0_2d + 12) = znitrpot(ji,jj,1) * 1.e-7 * fse3t(ji,jj,1) * 1.e+3 / rfact2
334         END DO
335      END DO
336# endif
337      !
338       IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
339         WRITE(charout, FMT="('sed ')")
340         CALL prt_ctl_trc_info(charout)
341         CALL prt_ctl_trc(tab4d=trn, mask=tmask, clinfo=ctrcnm)
342       ENDIF
343
344   END SUBROUTINE p4z_sed
345
346   SUBROUTINE p4z_sbc(kt)
347
348      !!----------------------------------------------------------------------
349      !!                  ***  ROUTINE p4z_sbc  ***
350      !!
351      !! ** Purpose :   Read and interpolate the external sources of
352      !!                nutrients
353      !!
354      !! ** Method  :   Read the files and interpolate the appropriate variables
355      !!
356      !! ** input   :   external netcdf files
357      !!
358      !!----------------------------------------------------------------------
359      !! * arguments
360      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
361
362      !! * Local declarations
363      INTEGER ::   &
364         imois, imois2,       &  ! temporary integers
365         i15  , iman             !    "          "
366      REAL(wp) ::   &
367         zxy                     !    "         "
368
369
370      !!---------------------------------------------------------------------
371
372      ! Initialization
373      ! --------------
374
375      i15 = nday / 16
376      iman  = INT( raamo )
377      imois = nmonth + i15 - 1
378      IF( imois == 0 ) imois = iman
379      imois2 = nmonth
380
381      ! 1. first call kt=nit000
382      ! -----------------------
383
384      IF( kt == nit000 ) THEN
385         ! initializations
386         nflx1  = 0
387         nflx11 = 0
388         ! open the file
389         IF(lwp) THEN
390            WRITE(numout,*) ' '
391            WRITE(numout,*) ' **** Routine p4z_sbc'
392         ENDIF
393         CALL iom_open ( 'dust.orca.nc', numdust )
394      ENDIF
395
396
397     ! Read monthly file
398      ! ----------------
399
400      IF( kt == nit000 .OR. imois /= nflx1 ) THEN
401
402         ! Calendar computation
403
404         ! nflx1 number of the first file record used in the simulation
405         ! nflx2 number of the last  file record
406
407         nflx1 = imois
408         nflx2 = nflx1+1
409         nflx1 = MOD( nflx1, iman )
410         nflx2 = MOD( nflx2, iman )
411         IF( nflx1 == 0 )   nflx1 = iman
412         IF( nflx2 == 0 )   nflx2 = iman
413         IF(lwp) WRITE(numout,*) 'first record file used nflx1 ',nflx1
414         IF(lwp) WRITE(numout,*) 'last  record file used nflx2 ',nflx2
415
416         ! Read monthly fluxes data
417
418         ! humidity
419         CALL iom_get ( numdust, jpdom_data, 'dust', dustmo(:,:,1), nflx1 )
420         CALL iom_get ( numdust, jpdom_data, 'dust', dustmo(:,:,2), nflx2 )
421
422         IF(lwp .AND. nitend-nit000 <= 100 ) THEN
423            WRITE(numout,*)
424            WRITE(numout,*) ' read clio flx ok'
425            WRITE(numout,*)
426               WRITE(numout,*)
427               WRITE(numout,*) 'Clio month: ',nflx1,'  field: dust'
428               CALL prihre( dustmo(:,:,1),jpi,jpj,1,jpi,20,1,jpj,10,1e9,numout )
429         ENDIF
430
431      ENDIF
432
433     ! 3. at every time step interpolation of fluxes
434      ! ---------------------------------------------
435
436      zxy = FLOAT( nday + 15 - 30 * i15 ) / 30
437      dust(:,:) = ( (1.-zxy) * dustmo(:,:,1) + zxy * dustmo(:,:,2) )
438
439      IF( kt == nitend ) CALL iom_close (numdust)
440
441   END SUBROUTINE p4z_sbc
442
443
444   SUBROUTINE p4z_sed_init
445
446      !!----------------------------------------------------------------------
447      !!                  ***  ROUTINE p4z_sed_init  ***
448      !!
449      !! ** Purpose :   Initialization of the external sources of nutrients
450      !!
451      !! ** Method  :   Read the files and compute the budget
452      !!      called at the first timestep (nittrc000)
453      !!
454      !! ** input   :   external netcdf files
455      !!
456      !!----------------------------------------------------------------------
457
458      INTEGER ::   ji, jj, jk, jm
459      INTEGER , PARAMETER ::   jpmois = 12, jpan = 1
460      INTEGER :: numriv, numbath, numdep
461
462
463      REAL(wp) ::   zcoef
464      REAL(wp) ::   expide, denitide,zmaskt
465      REAL(wp) , DIMENSION (jpi,jpj)     ::   riverdoc, river, ndepo
466      REAL(wp) , DIMENSION (jpi,jpj,jpk) ::   cmask
467      REAL(wp), DIMENSION(jpi,jpj,12)    ::   zdustmo
468
469      NAMELIST/nampissed/ bdustfer, briver, bndepo, bsedinput, sedfeinput, dustsolub
470
471
472      REWIND( numnat )                     ! read numnat
473      READ  ( numnat, nampissed )
474
475      IF(lwp) THEN
476         WRITE(numout,*) ' '
477         WRITE(numout,*) ' Namelist : nampissed '
478         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~ '
479         WRITE(numout,*) '    Dust input from the atmosphere           bdustfer  = ', bdustfer
480         WRITE(numout,*) '    River input of nutrients                 briver    = ', briver
481         WRITE(numout,*) '    Atmospheric deposition of N              bndepo    = ', bndepo
482         WRITE(numout,*) '    Fe input from sediments                  bsedinput = ', bsedinput
483         WRITE(numout,*) '    Coastal release of Iron                  sedfeinput =', sedfeinput
484         WRITE(numout,*) '    Solubility of the dust                   dustsolub  =', dustsolub
485      ENDIF
486
487      ! Dust input from the atmosphere
488      ! ------------------------------
489      IF( bdustfer ) THEN
490         IF(lwp) WRITE(numout,*) '    Initialize dust input from atmosphere '
491         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
492         CALL iom_open ( 'dust.orca.nc', numdust )
493         DO jm = 1, jpmois
494            CALL iom_get( numdust, jpdom_data, 'dust', zdustmo(:,:,jm), jm )
495         END DO
496         CALL iom_close( numdust )
497      ELSE
498         zdustmo(:,:,:) = 0.e0
499         dust(:,:) = 0.0
500      ENDIF
501
502      ! Nutrient input from rivers
503      ! --------------------------
504      IF( briver ) THEN
505         IF(lwp) WRITE(numout,*) '    Initialize the nutrient input by rivers from river.orca.nc file'
506         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
507         CALL iom_open ( 'river.orca.nc', numriv )
508         CALL iom_get  ( numriv, jpdom_data, 'riverdic', river   (:,:), jpan )
509         CALL iom_get  ( numriv, jpdom_data, 'riverdoc', riverdoc(:,:), jpan )
510         CALL iom_close( numriv )
511      ELSE
512         river   (:,:) = 0.e0
513         riverdoc(:,:) = 0.e0
514      endif
515
516      ! Nutrient input from dust
517      ! ------------------------
518      IF( bndepo ) THEN
519         IF(lwp) WRITE(numout,*) '    Initialize the nutrient input by dust from ndeposition.orca.nc'
520         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
521         CALL iom_open ( 'ndeposition.orca.nc', numdep )
522         CALL iom_get  ( numdep, jpdom_data, 'ndep', ndepo(:,:), jpan )
523         CALL iom_close( numdep )
524      ELSE
525         ndepo(:,:) = 0.e0
526      ENDIF
527
528      ! Coastal and island masks
529      ! ------------------------
530      IF( bsedinput ) THEN     
531         IF(lwp) WRITE(numout,*) '    Computation of an island mask to enhance coastal supply of iron'
532         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
533         IF(lwp) WRITE(numout,*) '       from bathy.orca.nc file '
534         CALL iom_open ( 'bathy.orca.nc', numbath )
535         CALL iom_get  ( numbath, jpdom_data, 'bathy', cmask(:,:,:), jpan )
536         CALL iom_close( numbath )
537         !
538         DO jk = 1, 5
539            DO jj = 2, jpjm1
540               DO ji = 2, jpim1
541                  IF( tmask(ji,jj,jk) /= 0. ) THEN
542                     zmaskt = tmask(ji+1,jj,jk) * tmask(ji-1,jj,jk) * tmask(ji,jj+1,jk)    &
543                        &                       * tmask(ji,jj-1,jk) * tmask(ji,jj,jk+1)
544                     IF( zmaskt == 0. )   cmask(ji,jj,jk ) = 0.1
545                  ENDIF
546               END DO
547            END DO
548         END DO
549         DO jk = 1, jpk
550            DO jj = 1, jpj
551               DO ji = 1, jpi
552                  expide   = MIN( 8.,( fsdept(ji,jj,jk) / 500. )**(-1.5) )
553                  denitide = -0.9543 + 0.7662 * LOG( expide ) - 0.235 * LOG( expide )**2
554                  cmask(ji,jj,jk) = cmask(ji,jj,jk) * MIN( 1., EXP( denitide ) / 0.5 )
555               END DO
556            END DO
557         END DO
558      ELSE
559         cmask(:,:,:) = 0.e0
560      ENDIF
561
562      CALL lbc_lnk( cmask , 'T', 1. )      ! Lateral boundary conditions on cmask   (sign unchanged)
563
564
565      ! total atmospheric supply of Si
566      ! ------------------------------
567      sumdepsi = 0.e0
568      DO jm = 1, jpmois
569         DO jj = 2, jpjm1
570            DO ji = 2, jpim1
571               sumdepsi = sumdepsi + zdustmo(ji,jj,jm) / (12.*rmoss) * 8.8        &
572                  &     * 0.075/28.1 * e1t(ji,jj) * e2t(ji,jj) * tmask(ji,jj,1) * tmask_i(ji,jj)
573            END DO
574         END DO
575      END DO
576      IF( lk_mpp )   CALL mpp_sum( sumdepsi )  ! sum over the global domain
577
578      ! N/P and Si releases due to coastal rivers
579      ! -----------------------------------------
580      DO jj = 1, jpj
581         DO ji = 1, jpi
582            zcoef = raass * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1)
583            cotdep(ji,jj) =  river(ji,jj)                  *1E9 / ( 12. * zcoef + rtrn ) * tmask(ji,jj,1)
584            rivinp(ji,jj) = (river(ji,jj)+riverdoc(ji,jj)) *1E9 / ( 31.6* zcoef + rtrn ) * tmask(ji,jj,1)
585            nitdep(ji,jj) = 7.6 * ndepo(ji,jj)                  / ( 14E6*raass*fse3t(ji,jj,1) + rtrn ) * tmask(ji,jj,1)
586         END DO
587      END DO
588      ! Lateral boundary conditions on ( cotdep, rivinp, nitdep )   (sign unchanged)
589      CALL lbc_lnk( cotdep , 'T', 1. )  ;  CALL lbc_lnk( rivinp , 'T', 1. )  ;  CALL lbc_lnk( nitdep , 'T', 1. )
590
591      rivpo4input=0.e0
592      rivalkinput=0.e0
593      nitdepinput=0.e0
594      DO jj = 2 , jpjm1
595         DO ji = 2, jpim1
596            zcoef = cvol(ji,jj,1) * raass
597            rivpo4input = rivpo4input + rivinp(ji,jj) * zcoef
598            rivalkinput = rivalkinput + cotdep(ji,jj) * zcoef
599            nitdepinput = nitdepinput + nitdep(ji,jj) * zcoef
600         END DO
601     END DO
602      IF( lk_mpp ) THEN
603         CALL mpp_sum( rivpo4input )  ! sum over the global domain
604         CALL mpp_sum( rivalkinput )  ! sum over the global domain
605         CALL mpp_sum( nitdepinput )  ! sum over the global domain
606      ENDIF
607
608
609      ! Coastal supply of iron
610      ! -------------------------
611      DO jk = 1, jpkm1
612         ironsed(:,:,jk) = sedfeinput * cmask(:,:,jk) / ( fse3t(:,:,jk) * rjjss )
613      END DO
614      CALL lbc_lnk( ironsed , 'T', 1. )      ! Lateral boundary conditions on ( ironsed )   (sign unchanged)
615
616
617   END SUBROUTINE p4z_sed_init
618
619
620
621#else
622   !!======================================================================
623   !!  Dummy module :                                   No PISCES bio-model
624   !!======================================================================
625CONTAINS
626   SUBROUTINE p4z_sed                         ! Empty routine
627   END SUBROUTINE p4z_sed
628#endif 
629
630   !!======================================================================
631END MODULE  p4zsed
Note: See TracBrowser for help on using the repository browser.