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.
p4zsbc.F90 in branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z – NEMO

source: branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90 @ 5870

Last change on this file since 5870 was 5870, checked in by acc, 8 years ago

Branch 2015/dev_r5803_NOC_WAD. Merge in trunk changes from 5803 to 5869 in preparation for merge. Also tidied and reorganised some wetting and drying code. Renamed wadlmt.F90 to wetdry.F90. Wetting drying code changes restricted to domzgr.F90, domvvl.F90 nemogcm.F90 sshwzv.F90, dynspg_ts.F90, wetdry.F90 and dynhpg.F90. Code passes full SETTE tests with ln_wd=.false.. Still awaiting test case for checking with ln_wd=.false.
  • Property svn:keywords set to Id
File size: 25.8 KB
Line 
1MODULE p4zsbc
2   !!======================================================================
3   !!                         ***  MODULE p4sbc  ***
4   !! TOP :   PISCES surface boundary conditions of external inputs of nutrients
5   !!======================================================================
6   !! History :   3.5  !  2012-07 (O. Aumont, C. Ethe) Original code
7   !!----------------------------------------------------------------------
8#if defined key_pisces
9   !!----------------------------------------------------------------------
10   !!   'key_pisces'                                       PISCES bio-model
11   !!----------------------------------------------------------------------
12   !!   p4z_sbc        :  Read and interpolate time-varying nutrients fluxes
13   !!   p4z_sbc_init   :  Initialization of p4z_sbc
14   !!----------------------------------------------------------------------
15   USE oce_trc         !  shared variables between ocean and passive tracers
16   USE trc             !  passive tracers common variables
17   USE sms_pisces      !  PISCES Source Minus Sink variables
18   USE iom             !  I/O manager
19   USE fldread         !  time interpolation
20
21   IMPLICIT NONE
22   PRIVATE
23
24   PUBLIC   p4z_sbc
25   PUBLIC   p4z_sbc_init   
26
27   !! * Shared module variables
28   LOGICAL , PUBLIC  :: ln_dust     !: boolean for dust input from the atmosphere
29   LOGICAL , PUBLIC  :: ln_solub    !: boolean for variable solubility of atmospheric iron
30   LOGICAL , PUBLIC  :: ln_river    !: boolean for river input of nutrients
31   LOGICAL , PUBLIC  :: ln_ndepo    !: boolean for atmospheric deposition of N
32   LOGICAL , PUBLIC  :: ln_ironsed  !: boolean for Fe input from sediments
33   LOGICAL , PUBLIC  :: ln_hydrofe  !: boolean for Fe input from hydrothermal vents
34   LOGICAL , PUBLIC  :: ln_ironice  !: boolean for Fe input from sea ice
35   REAL(wp), PUBLIC  :: sedfeinput  !: Coastal release of Iron
36   REAL(wp), PUBLIC  :: dustsolub   !: Solubility of the dust
37   REAL(wp), PUBLIC  :: mfrac       !: Mineral Content of the dust
38   REAL(wp), PUBLIC  :: icefeinput  !: Iron concentration in sea ice
39   REAL(wp), PUBLIC  :: wdust       !: Sinking speed of the dust
40   REAL(wp), PUBLIC  :: nitrfix     !: Nitrogen fixation rate   
41   REAL(wp), PUBLIC  :: diazolight  !: Nitrogen fixation sensitivty to light
42   REAL(wp), PUBLIC  :: concfediaz  !: Fe half-saturation Cste for diazotrophs
43   REAL(wp)          :: hratio      !: Fe:3He ratio assumed for vent iron supply
44
45   LOGICAL , PUBLIC  :: ll_sbc
46
47   !! * Module variables
48   LOGICAL  ::  ll_solub
49
50   INTEGER , PARAMETER  :: jpriv  = 7   !: Maximum number of river input fields
51   INTEGER , PARAMETER  :: jr_dic = 1   !: index of dissolved inorganic carbon
52   INTEGER , PARAMETER  :: jr_doc = 2   !: index of dissolved organic carbon
53   INTEGER , PARAMETER  :: jr_din = 3   !: index of dissolved inorganic nitrogen
54   INTEGER , PARAMETER  :: jr_don = 4   !: index of dissolved organic nitrogen
55   INTEGER , PARAMETER  :: jr_dip = 5   !: index of dissolved inorganic phosporus
56   INTEGER , PARAMETER  :: jr_dop = 6   !: index of dissolved organic phosphorus
57   INTEGER , PARAMETER  :: jr_dsi = 7   !: index of dissolved silicate
58
59
60   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_dust      ! structure of input dust
61   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_solub      ! structure of input dust
62   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_river  ! structure of input riverdic
63   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_ndepo     ! structure of input nitrogen deposition
64   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_ironsed   ! structure of input iron from sediment
65   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_hydrofe   ! structure of input iron from hydrothermal vents
66
67   INTEGER , PARAMETER :: nbtimes = 365  !: maximum number of times record in a file
68   INTEGER  :: ntimes_dust, ntimes_riv, ntimes_ndep       ! number of time steps in a file
69   INTEGER  :: ntimes_solub, ntimes_hydro                 ! number of time steps in a file
70
71   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:) :: dust, solub       !: dust fields
72   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:) :: rivdic, rivalk    !: river input fields
73   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:) :: rivdin, rivdip    !: river input fields
74   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:) :: rivdsi    !: river input fields
75   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:) :: nitdep    !: atmospheric N deposition
76   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ironsed   !: Coastal supply of iron
77   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hydrofe   !: Hydrothermal vent supply of iron
78
79   REAL(wp), PUBLIC :: sumdepsi, rivalkinput, rivdicinput, nitdepinput
80   REAL(wp), PUBLIC :: rivdininput, rivdipinput, rivdsiinput
81
82
83   !! * Substitutions
84#  include "domzgr_substitute.h90"
85#  include "vectopt_loop_substitute.h90"
86   !!----------------------------------------------------------------------
87   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
88   !! $Id$
89   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
90   !!----------------------------------------------------------------------
91
92CONTAINS
93
94   SUBROUTINE p4z_sbc( kt )
95      !!----------------------------------------------------------------------
96      !!                  ***  routine p4z_sbc  ***
97      !!
98      !! ** purpose :   read and interpolate the external sources of nutrients
99      !!
100      !! ** method  :   read the files and interpolate the appropriate variables
101      !!
102      !! ** input   :   external netcdf files
103      !!
104      !!----------------------------------------------------------------------
105      !! * arguments
106      INTEGER, INTENT( in  ) ::   kt   ! ocean time step
107
108      !! * local declarations
109      INTEGER  :: ji,jj 
110      REAL(wp) :: zcoef, zyyss
111      !!---------------------------------------------------------------------
112      !
113      IF( nn_timing == 1 )  CALL timing_start('p4z_sbc')
114
115      !
116      ! Compute dust at nit000 or only if there is more than 1 time record in dust file
117      IF( ln_dust ) THEN
118         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_dust > 1 ) ) THEN
119            CALL fld_read( kt, 1, sf_dust )
120            IF( nn_ice_tr == -1 .AND. .NOT. ln_ironice ) THEN
121               dust(:,:) = sf_dust(1)%fnow(:,:,1)
122            ELSE
123               dust(:,:) = sf_dust(1)%fnow(:,:,1) * ( 1.0 - fr_i(:,:) )
124            ENDIF
125         ENDIF
126      ENDIF
127
128      IF( ll_solub ) THEN
129         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_solub > 1 ) ) THEN
130            CALL fld_read( kt, 1, sf_solub )
131            solub(:,:) = sf_solub(1)%fnow(:,:,1)
132         ENDIF
133      ENDIF
134
135      ! N/P and Si releases due to coastal rivers
136      ! Compute river at nit000 or only if there is more than 1 time record in river file
137      ! -----------------------------------------
138      IF( ln_river ) THEN
139         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_riv > 1 ) ) THEN
140            CALL fld_read( kt, 1, sf_river )
141            DO jj = 1, jpj
142               DO ji = 1, jpi
143                  zcoef = ryyss * e1e2t(ji,jj) * h_rnf(ji,jj) 
144                  rivalk(ji,jj) =   sf_river(jr_dic)%fnow(ji,jj,1)                                    &
145                     &              * 1.E3        / ( 12. * zcoef + rtrn )
146                  rivdic(ji,jj) = ( sf_river(jr_dic)%fnow(ji,jj,1) + sf_river(jr_doc)%fnow(ji,jj,1) ) &
147                     &              * 1.E3         / ( 12. * zcoef + rtrn )
148                  rivdin(ji,jj) = ( sf_river(jr_din)%fnow(ji,jj,1) + sf_river(jr_don)%fnow(ji,jj,1) ) &
149                     &              * 1.E3 / rno3 / ( 14. * zcoef + rtrn )
150                  rivdip(ji,jj) = ( sf_river(jr_dip)%fnow(ji,jj,1) + sf_river(jr_dop)%fnow(ji,jj,1) ) &
151                     &              * 1.E3 / po4r / ( 31. * zcoef + rtrn )
152                  rivdsi(ji,jj) =   sf_river(jr_dsi)%fnow(ji,jj,1)                                    &
153                     &              * 1.E3        / ( 28.1 * zcoef + rtrn )
154               END DO
155            END DO
156         ENDIF
157      ENDIF
158
159      ! Compute N deposition at nit000 or only if there is more than 1 time record in N deposition file
160      IF( ln_ndepo ) THEN
161         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_ndep > 1 ) ) THEN
162            CALL fld_read( kt, 1, sf_ndepo )
163            DO jj = 1, jpj
164               DO ji = 1, jpi
165                  nitdep(ji,jj) = sf_ndepo(1)%fnow(ji,jj,1) / rno3 / ( 14E6 * ryyss * fse3t(ji,jj,1) + rtrn )
166               END DO
167            END DO
168         ENDIF
169      ENDIF
170      !
171      IF( nn_timing == 1 )  CALL timing_stop('p4z_sbc')
172      !
173   END SUBROUTINE p4z_sbc
174
175   SUBROUTINE p4z_sbc_init
176
177      !!----------------------------------------------------------------------
178      !!                  ***  routine p4z_sbc_init  ***
179      !!
180      !! ** purpose :   initialization of the external sources of nutrients
181      !!
182      !! ** method  :   read the files and compute the budget
183      !!                called at the first timestep (nittrc000)
184      !!
185      !! ** input   :   external netcdf files
186      !!
187      !!----------------------------------------------------------------------
188      !
189      INTEGER  :: ji, jj, jk, jm, ifpr
190      INTEGER  :: ii0, ii1, ij0, ij1
191      INTEGER  :: numdust, numsolub, numriv, numiron, numdepo, numhydro
192      INTEGER  :: ierr, ierr1, ierr2, ierr3
193      INTEGER  :: ios                 ! Local integer output status for namelist read
194      INTEGER  :: ik50                !  last level where depth less than 50 m
195      INTEGER  :: isrow             ! index for ORCA1 starting row
196      REAL(wp) :: zexpide, zdenitide, zmaskt
197      REAL(wp) :: ztimes_dust, ztimes_riv, ztimes_ndep 
198      REAL(wp), DIMENSION(nbtimes) :: zsteps                 ! times records
199      REAL(wp), DIMENSION(:), ALLOCATABLE :: rivinput
200      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zdust, zndepo, zriver, zcmask
201      !
202      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files
203      TYPE(FLD_N), DIMENSION(jpriv) ::  slf_river    ! array of namelist informations on the fields to read
204      TYPE(FLD_N) ::   sn_dust, sn_solub, sn_ndepo, sn_ironsed, sn_hydrofe   ! informations about the fields to be read
205      TYPE(FLD_N) ::   sn_riverdoc, sn_riverdic, sn_riverdsi   ! informations about the fields to be read
206      TYPE(FLD_N) ::   sn_riverdin, sn_riverdon, sn_riverdip, sn_riverdop
207      !
208      NAMELIST/nampissbc/cn_dir, sn_dust, sn_solub, sn_riverdic, sn_riverdoc, sn_riverdin, sn_riverdon,     &
209        &                sn_riverdip, sn_riverdop, sn_riverdsi, sn_ndepo, sn_ironsed, sn_hydrofe, &
210        &                ln_dust, ln_solub, ln_river, ln_ndepo, ln_ironsed, ln_ironice, ln_hydrofe,    &
211        &                sedfeinput, dustsolub, icefeinput, wdust, mfrac, nitrfix, diazolight, concfediaz, hratio
212      !!----------------------------------------------------------------------
213      !
214      IF( nn_timing == 1 )  CALL timing_start('p4z_sbc_init')
215      !
216      !                            !* set file information
217      REWIND( numnatp_ref )              ! Namelist nampissbc in reference namelist : Pisces external sources of nutrients
218      READ  ( numnatp_ref, nampissbc, IOSTAT = ios, ERR = 901)
219901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampissbc in reference namelist', lwp )
220
221      REWIND( numnatp_cfg )              ! Namelist nampissbc in configuration namelist : Pisces external sources of nutrients
222      READ  ( numnatp_cfg, nampissbc, IOSTAT = ios, ERR = 902 )
223902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampissbc in configuration namelist', lwp )
224      IF(lwm) WRITE ( numonp, nampissbc )
225
226      IF ( ( nn_ice_tr >= 0 ) .AND. ln_ironice ) THEN
227         IF(lwp) THEN
228            WRITE(numout,*) ' ln_ironice incompatible with nn_ice_tr = ', nn_ice_tr
229            WRITE(numout,*) ' Specify your sea ice iron concentration in nampisice instead '
230            WRITE(numout,*) ' ln_ironice is forced to .FALSE. '
231            ln_ironice = .FALSE.
232         ENDIF
233      ENDIF
234
235      IF(lwp) THEN
236         WRITE(numout,*) ' '
237         WRITE(numout,*) ' namelist : nampissbc '
238         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~ '
239         WRITE(numout,*) '    dust input from the atmosphere           ln_dust     = ', ln_dust
240         WRITE(numout,*) '    Variable solubility of iron input        ln_solub    = ', ln_solub
241         WRITE(numout,*) '    river input of nutrients                 ln_river    = ', ln_river
242         WRITE(numout,*) '    atmospheric deposition of n              ln_ndepo    = ', ln_ndepo
243         WRITE(numout,*) '    Fe input from sediments                  ln_ironsed  = ', ln_ironsed
244         WRITE(numout,*) '    Fe input from seaice                     ln_ironice  = ', ln_ironice
245         WRITE(numout,*) '    fe input from hydrothermal vents         ln_hydrofe  = ', ln_hydrofe
246         WRITE(numout,*) '    coastal release of iron                  sedfeinput  = ', sedfeinput
247         WRITE(numout,*) '    solubility of the dust                   dustsolub   = ', dustsolub
248         WRITE(numout,*) '    Mineral Fe content of the dust           mfrac       = ', mfrac
249         WRITE(numout,*) '    Iron concentration in sea ice            icefeinput  = ', icefeinput
250         WRITE(numout,*) '    sinking speed of the dust                wdust       = ', wdust
251         WRITE(numout,*) '    nitrogen fixation rate                   nitrfix     = ', nitrfix
252         WRITE(numout,*) '    nitrogen fixation sensitivty to light    diazolight  = ', diazolight
253         WRITE(numout,*) '    fe half-saturation cste for diazotrophs  concfediaz  = ', concfediaz
254         WRITE(numout,*) '    Fe to 3He ratio assumed for vent iron supply hratio  = ', hratio
255      END IF
256
257      IF( ln_dust .OR. ln_river .OR. ln_ndepo ) THEN  ;  ll_sbc = .TRUE.
258      ELSE                                            ;  ll_sbc = .FALSE.
259      ENDIF
260
261      IF( ln_dust .AND. ln_solub ) THEN               ;  ll_solub = .TRUE.
262      ELSE                                            ;  ll_solub = .FALSE.
263      ENDIF
264
265      ! set the number of level over which river runoffs are applied
266      ! online configuration : computed in sbcrnf
267      IF( lk_offline ) THEN
268        nk_rnf(:,:) = 1
269        h_rnf (:,:) = fsdept(:,:,1)
270      ENDIF
271
272      ! dust input from the atmosphere
273      ! ------------------------------
274      IF( ln_dust ) THEN 
275         !
276         IF(lwp) WRITE(numout,*) '    initialize dust input from atmosphere '
277         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
278         !
279         ALLOCATE( dust(jpi,jpj) )    ! allocation
280         !
281         ALLOCATE( sf_dust(1), STAT=ierr )           !* allocate and fill sf_sst (forcing structure) with sn_sst
282         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_dust structure' )
283         !
284         CALL fld_fill( sf_dust, (/ sn_dust /), cn_dir, 'p4z_sed_init', 'Atmospheric dust deposition', 'nampissed' )
285                                   ALLOCATE( sf_dust(1)%fnow(jpi,jpj,1)   )
286         IF( sn_dust%ln_tint )     ALLOCATE( sf_dust(1)%fdta(jpi,jpj,1,2) )
287         !
288         IF( Agrif_Root() ) THEN   !  Only on the master grid
289            ! Get total input dust ; need to compute total atmospheric supply of Si in a year
290            CALL iom_open (  TRIM( sn_dust%clname ) , numdust )
291            CALL iom_gettime( numdust, zsteps, kntime=ntimes_dust)  ! get number of record in file
292            ALLOCATE( zdust(jpi,jpj,ntimes_dust) )
293            DO jm = 1, ntimes_dust
294               CALL iom_get( numdust, jpdom_data, TRIM( sn_dust%clvar ), zdust(:,:,jm), jm )
295            END DO
296            CALL iom_close( numdust )
297            ztimes_dust = 1._wp / FLOAT( ntimes_dust ) 
298            sumdepsi = 0.e0
299            DO jm = 1, ntimes_dust
300               sumdepsi = sumdepsi + glob_sum( zdust(:,:,jm) * e1e2t(:,:) * tmask(:,:,1) * ztimes_dust )
301            ENDDO
302            sumdepsi = sumdepsi / ( nyear_len(1) * rday ) * 12. * 8.8 * 0.075 * mfrac / 28.1 
303            DEALLOCATE( zdust)
304         ENDIF
305      ELSE
306         sumdepsi  = 0._wp
307      END IF
308
309      ! Solubility of dust deposition of iron
310      ! Only if ln_dust and ln_solubility set to true (ll_solub = .true.)
311      ! -----------------------------------------------------------------
312      IF( ll_solub ) THEN
313         !
314         IF(lwp) WRITE(numout,*) '    initialize variable solubility of Fe '
315         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
316         !
317         ALLOCATE( solub(jpi,jpj) )    ! allocation
318         !
319         ALLOCATE( sf_solub(1), STAT=ierr )           !* allocate and fill sf_sst (forcing structure) with sn_sst
320         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_solub structure' )
321         !
322         CALL fld_fill( sf_solub, (/ sn_solub /), cn_dir, 'p4z_sed_init', 'Solubility of atm. iron ', 'nampissed' )
323                                   ALLOCATE( sf_solub(1)%fnow(jpi,jpj,1)   )
324         IF( sn_solub%ln_tint )    ALLOCATE( sf_solub(1)%fdta(jpi,jpj,1,2) )
325         ! get number of record in file
326         CALL iom_open (  TRIM( sn_solub%clname ) , numsolub )
327         CALL iom_gettime( numsolub, zsteps, kntime=ntimes_solub)  ! get number of record in file
328         CALL iom_close( numsolub )
329      ENDIF
330
331      ! nutrient input from rivers
332      ! --------------------------
333      IF( ln_river ) THEN
334         !
335         slf_river(jr_dic) = sn_riverdic  ;  slf_river(jr_doc) = sn_riverdoc  ;  slf_river(jr_din) = sn_riverdin 
336         slf_river(jr_don) = sn_riverdon  ;  slf_river(jr_dip) = sn_riverdip  ;  slf_river(jr_dop) = sn_riverdop
337         slf_river(jr_dsi) = sn_riverdsi 
338         !
339         ALLOCATE( rivdic(jpi,jpj), rivalk(jpi,jpj), rivdin(jpi,jpj), rivdip(jpi,jpj), rivdsi(jpi,jpj) ) 
340         !
341         ALLOCATE( sf_river(jpriv), rivinput(jpriv), STAT=ierr1 )           !* allocate and fill sf_river (forcing structure) with sn_river_
342         rivinput(:) = 0.0
343
344         IF( ierr1 > 0 )   CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_irver structure' )
345         !
346         CALL fld_fill( sf_river, slf_river, cn_dir, 'p4z_sed_init', 'Input from river ', 'nampissed' )
347         DO ifpr = 1, jpriv
348                                          ALLOCATE( sf_river(ifpr)%fnow(jpi,jpj,1  ) )
349            IF( slf_river(ifpr)%ln_tint ) ALLOCATE( sf_river(ifpr)%fdta(jpi,jpj,1,2) )
350         END DO
351         IF( Agrif_Root() ) THEN   !  Only on the master grid
352            ! Get total input rivers ; need to compute total river supply in a year
353            DO ifpr = 1, jpriv
354               CALL iom_open ( TRIM( slf_river(ifpr)%clname ), numriv )
355               CALL iom_gettime( numriv, zsteps, kntime=ntimes_riv)
356               ALLOCATE( zriver(jpi,jpj,ntimes_riv) )
357               DO jm = 1, ntimes_riv
358                  CALL iom_get( numriv, jpdom_data, TRIM( slf_river(ifpr)%clvar ), zriver(:,:,jm), jm )
359               END DO
360               CALL iom_close( numriv )
361               ztimes_riv = 1._wp / FLOAT(ntimes_riv) 
362               DO jm = 1, ntimes_riv
363                  rivinput(ifpr) = rivinput(ifpr) + glob_sum( zriver(:,:,jm) * tmask(:,:,1) * ztimes_riv ) 
364               END DO
365               DEALLOCATE( zriver)
366            END DO
367            ! N/P and Si releases due to coastal rivers
368            ! -----------------------------------------
369            rivdicinput = (rivinput(jr_dic) + rivinput(jr_doc) ) * 1E3 / 12._wp
370            rivdininput = (rivinput(jr_din) + rivinput(jr_don) ) * 1E3 / rno3 / 14._wp
371            rivdipinput = (rivinput(jr_dip) + rivinput(jr_dop) ) * 1E3 / po4r / 31._wp
372            rivdsiinput = rivinput(jr_dsi) * 1E3 / 28.1_wp
373            rivalkinput = rivinput(jr_dic) * 1E3 / 12._wp
374            !
375         ENDIF
376      ELSE
377         rivdicinput = 0._wp
378         rivdininput = 0._wp
379         rivdipinput = 0._wp
380         rivdsiinput = 0._wp
381         rivalkinput = 0._wp
382      END IF 
383      ! nutrient input from dust
384      ! ------------------------
385      IF( ln_ndepo ) THEN
386         !
387         IF(lwp) WRITE(numout,*) '    initialize the nutrient input by dust from ndeposition.orca.nc'
388         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
389         !
390         ALLOCATE( nitdep(jpi,jpj) )    ! allocation
391         !
392         ALLOCATE( sf_ndepo(1), STAT=ierr3 )           !* allocate and fill sf_sst (forcing structure) with sn_sst
393         IF( ierr3 > 0 )   CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_ndepo structure' )
394         !
395         CALL fld_fill( sf_ndepo, (/ sn_ndepo /), cn_dir, 'p4z_sed_init', 'Nutrient atmospheric depositon ', 'nampissed' )
396                                   ALLOCATE( sf_ndepo(1)%fnow(jpi,jpj,1)   )
397         IF( sn_ndepo%ln_tint )    ALLOCATE( sf_ndepo(1)%fdta(jpi,jpj,1,2) )
398         !
399         IF( Agrif_Root() ) THEN   !  Only on the master grid
400            ! Get total input dust ; need to compute total atmospheric supply of N in a year
401            CALL iom_open ( TRIM( sn_ndepo%clname ), numdepo )
402            CALL iom_gettime( numdepo, zsteps, kntime=ntimes_ndep)
403            ALLOCATE( zndepo(jpi,jpj,ntimes_ndep) )
404            DO jm = 1, ntimes_ndep
405               CALL iom_get( numdepo, jpdom_data, TRIM( sn_ndepo%clvar ), zndepo(:,:,jm), jm )
406            END DO
407            CALL iom_close( numdepo )
408            ztimes_ndep = 1._wp / FLOAT( ntimes_ndep ) 
409            nitdepinput = 0._wp
410            DO jm = 1, ntimes_ndep
411              nitdepinput = nitdepinput + glob_sum( zndepo(:,:,jm) * e1e2t(:,:) * tmask(:,:,1) * ztimes_ndep )
412            ENDDO
413            nitdepinput = nitdepinput / rno3 / 14E6 
414            DEALLOCATE( zndepo)
415         ENDIF
416      ELSE
417         nitdepinput = 0._wp
418      ENDIF
419
420      ! coastal and island masks
421      ! ------------------------
422      IF( ln_ironsed ) THEN     
423         !
424         IF(lwp) WRITE(numout,*) '    computation of an island mask to enhance coastal supply of iron'
425         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
426         !
427         ALLOCATE( ironsed(jpi,jpj,jpk) )    ! allocation
428         !
429         CALL iom_open ( TRIM( sn_ironsed%clname ), numiron )
430         ALLOCATE( zcmask(jpi,jpj,jpk) )
431         CALL iom_get  ( numiron, jpdom_data, TRIM( sn_ironsed%clvar ), zcmask(:,:,:), 1 )
432         CALL iom_close( numiron )
433         !
434         ik50 = 5        !  last level where depth less than 50 m
435         DO jk = jpkm1, 1, -1
436            IF( gdept_1d(jk) > 50. )  ik50 = jk - 1
437         END DO
438         IF (lwp) WRITE(numout,*)
439         IF (lwp) WRITE(numout,*) ' Level corresponding to 50m depth ',  ik50,' ', gdept_1d(ik50+1)
440         IF (lwp) WRITE(numout,*)
441         DO jk = 1, ik50
442            DO jj = 2, jpjm1
443               DO ji = fs_2, fs_jpim1
444                  IF( tmask(ji,jj,jk) /= 0. ) THEN
445                     zmaskt = tmask(ji+1,jj,jk) * tmask(ji-1,jj,jk) * tmask(ji,jj+1,jk)    &
446                        &                       * tmask(ji,jj-1,jk) * tmask(ji,jj,jk+1)
447                     IF( zmaskt == 0. )   zcmask(ji,jj,jk ) = MAX( 0.1, zcmask(ji,jj,jk) ) 
448                  END IF
449               END DO
450            END DO
451         END DO
452         !
453         CALL lbc_lnk( zcmask , 'T', 1. )      ! lateral boundary conditions on cmask   (sign unchanged)
454         !
455         DO jk = 1, jpk
456            DO jj = 1, jpj
457               DO ji = 1, jpi
458                  zexpide   = MIN( 8.,( fsdept(ji,jj,jk) / 500. )**(-1.5) )
459                  zdenitide = -0.9543 + 0.7662 * LOG( zexpide ) - 0.235 * LOG( zexpide )**2
460                  zcmask(ji,jj,jk) = zcmask(ji,jj,jk) * MIN( 1., EXP( zdenitide ) / 0.5 )
461               END DO
462            END DO
463         END DO
464         ! Coastal supply of iron
465         ! -------------------------
466         ironsed(:,:,jpk) = 0._wp
467         DO jk = 1, jpkm1
468            ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( fse3t(:,:,jk) * rday )
469         END DO
470         DEALLOCATE( zcmask)
471      ENDIF
472      !
473      ! Iron from Hydrothermal vents
474      ! ------------------------
475      IF( ln_hydrofe ) THEN
476         !
477         IF(lwp) WRITE(numout,*) '    Input of iron from hydrothermal vents '
478         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
479         !
480         ALLOCATE( hydrofe(jpi,jpj,jpk) )    ! allocation
481         !
482         CALL iom_open ( TRIM( sn_hydrofe%clname ), numhydro )
483         CALL iom_get  ( numhydro, jpdom_data, TRIM( sn_hydrofe%clvar ), hydrofe(:,:,:), 1 )
484         CALL iom_close( numhydro )
485         !
486         hydrofe(:,:,:) = ( hydrofe(:,:,:) * hratio ) / ( cvol(:,:,:) * ryyss + rtrn ) / 1000._wp
487         !
488      ENDIF
489      !
490      IF( ll_sbc ) CALL p4z_sbc( nit000 ) 
491      !
492      IF(lwp) THEN
493         WRITE(numout,*)
494         WRITE(numout,*) '    Total input of elements from river supply'
495         WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
496         WRITE(numout,*) '    N Supply   : ', rivdininput*rno3*1E3/1E12*14.,' TgN/yr'
497         WRITE(numout,*) '    Si Supply  : ', rivdsiinput*1E3/1E12*28.1,' TgSi/yr'
498         WRITE(numout,*) '    P Supply   : ', rivdipinput*1E3*po4r/1E12*31.,' TgP/yr'
499         WRITE(numout,*) '    Alk Supply : ', rivalkinput*1E3/1E12,' Teq/yr'
500         WRITE(numout,*) '    DIC Supply : ', rivdicinput*1E3*12./1E12,'TgC/yr'
501         WRITE(numout,*) 
502         WRITE(numout,*) '    Total input of elements from atmospheric supply'
503         WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
504         WRITE(numout,*) '    N Supply   : ', nitdepinput*rno3*1E3/1E12*14.,' TgN/yr'
505         WRITE(numout,*) 
506      ENDIF
507      !
508      IF( nn_timing == 1 )  CALL timing_stop('p4z_sbc_init')
509      !
510   END SUBROUTINE p4z_sbc_init
511
512#else
513   !!======================================================================
514   !!  Dummy module :                                   No PISCES bio-model
515   !!======================================================================
516CONTAINS
517   SUBROUTINE p4z_sbc                         ! Empty routine
518   END SUBROUTINE p4z_sbc
519#endif 
520
521   !!======================================================================
522END MODULE p4zsbc
Note: See TracBrowser for help on using the repository browser.