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

source: trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90 @ 4641

Last change on this file since 4641 was 4624, checked in by acc, 10 years ago

#1305. Fix slow start-up problems on some systems by introducing and using lwm logical to restrict output of merged namelists to the first (or only) processor. lwm is true only on the first processor regardless of ln_ctl. Small changes to all flavours of nemogcm.F90 are also required to write namctl and namcfg after the call to mynode which now opens output.namelist.dyn and writes nammpp.
File size: 26.1 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   REAL(wp) :: ryyss                    !: number of seconds per year
83
84   !!* Substitution
85#  include "top_substitute.h90"
86   !!----------------------------------------------------------------------
87   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
88   !! $Header:$
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            dust(:,:) = sf_dust(1)%fnow(:,:,1)
121         ENDIF
122      ENDIF
123
124      IF( ll_solub ) THEN
125         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_solub > 1 ) ) THEN
126            CALL fld_read( kt, 1, sf_solub )
127            solub(:,:) = sf_solub(1)%fnow(:,:,1)
128         ENDIF
129      ENDIF
130
131      ! N/P and Si releases due to coastal rivers
132      ! Compute river at nit000 or only if there is more than 1 time record in river file
133      ! -----------------------------------------
134      IF( ln_river ) THEN
135         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_riv > 1 ) ) THEN
136            CALL fld_read( kt, 1, sf_river )
137            DO jj = 1, jpj
138               DO ji = 1, jpi
139                  zcoef = ryyss * cvol(ji,jj,1) 
140                  rivalk(ji,jj) =   sf_river(jr_dic)%fnow(ji,jj,1)                                    &
141                     &              * 1.E3        / ( 12. * zcoef + rtrn )
142                  rivdic(ji,jj) = ( sf_river(jr_dic)%fnow(ji,jj,1) + sf_river(jr_doc)%fnow(ji,jj,1) ) &
143                     &              * 1.E3         / ( 12. * zcoef + rtrn )
144                  rivdin(ji,jj) = ( sf_river(jr_din)%fnow(ji,jj,1) + sf_river(jr_don)%fnow(ji,jj,1) ) &
145                     &              * 1.E3 / rno3 / ( 14. * zcoef + rtrn )
146                  rivdip(ji,jj) = ( sf_river(jr_dip)%fnow(ji,jj,1) + sf_river(jr_dop)%fnow(ji,jj,1) ) &
147                     &              * 1.E3 / po4r / ( 31. * zcoef + rtrn )
148                  rivdsi(ji,jj) =   sf_river(jr_dsi)%fnow(ji,jj,1)                                    &
149                     &              * 1.E3        / ( 28.1 * zcoef + rtrn )
150               END DO
151            END DO
152         ENDIF
153      ENDIF
154
155      ! Compute N deposition at nit000 or only if there is more than 1 time record in N deposition file
156      IF( ln_ndepo ) THEN
157         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_ndep > 1 ) ) THEN
158            CALL fld_read( kt, 1, sf_ndepo )
159            DO jj = 1, jpj
160               DO ji = 1, jpi
161                  nitdep(ji,jj) = sf_ndepo(1)%fnow(ji,jj,1) / rno3 / ( 14E6 * ryyss * fse3t(ji,jj,1) + rtrn )
162               END DO
163            END DO
164         ENDIF
165      ENDIF
166      !
167      IF( nn_timing == 1 )  CALL timing_stop('p4z_sbc')
168      !
169   END SUBROUTINE p4z_sbc
170
171   SUBROUTINE p4z_sbc_init
172
173      !!----------------------------------------------------------------------
174      !!                  ***  routine p4z_sbc_init  ***
175      !!
176      !! ** purpose :   initialization of the external sources of nutrients
177      !!
178      !! ** method  :   read the files and compute the budget
179      !!                called at the first timestep (nittrc000)
180      !!
181      !! ** input   :   external netcdf files
182      !!
183      !!----------------------------------------------------------------------
184      !
185      INTEGER  :: ji, jj, jk, jm, ifpr
186      INTEGER  :: ii0, ii1, ij0, ij1
187      INTEGER  :: numdust, numsolub, numriv, numiron, numdepo, numhydro
188      INTEGER  :: ierr, ierr1, ierr2, ierr3
189      INTEGER  :: ios                 ! Local integer output status for namelist read
190      REAL(wp) :: zexpide, zdenitide, zmaskt
191      REAL(wp) :: ztimes_dust, ztimes_riv, ztimes_ndep 
192      REAL(wp), DIMENSION(nbtimes) :: zsteps                 ! times records
193      REAL(wp), DIMENSION(:), ALLOCATABLE :: rivinput
194      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zdust, zndepo, zriver, zcmask
195      !
196      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files
197      TYPE(FLD_N), DIMENSION(jpriv) ::  slf_river    ! array of namelist informations on the fields to read
198      TYPE(FLD_N) ::   sn_dust, sn_solub, sn_ndepo, sn_ironsed, sn_hydrofe   ! informations about the fields to be read
199      TYPE(FLD_N) ::   sn_riverdoc, sn_riverdic, sn_riverdsi   ! informations about the fields to be read
200      TYPE(FLD_N) ::   sn_riverdin, sn_riverdon, sn_riverdip, sn_riverdop
201      !
202      NAMELIST/nampissbc/cn_dir, sn_dust, sn_solub, sn_riverdic, sn_riverdoc, sn_riverdin, sn_riverdon,     &
203        &                sn_riverdip, sn_riverdop, sn_riverdsi, sn_ndepo, sn_ironsed, sn_hydrofe, &
204        &                ln_dust, ln_solub, ln_river, ln_ndepo, ln_ironsed, ln_ironice, ln_hydrofe,    &
205        &                sedfeinput, dustsolub, icefeinput, wdust, mfrac, nitrfix, diazolight, concfediaz, hratio
206      !!----------------------------------------------------------------------
207      !
208      IF( nn_timing == 1 )  CALL timing_start('p4z_sbc_init')
209      !
210      ryyss   = nyear_len(1) * rday    ! number of seconds per year and per month
211      !
212      !                            !* set file information
213      REWIND( numnatp_ref )              ! Namelist nampissbc in reference namelist : Pisces external sources of nutrients
214      READ  ( numnatp_ref, nampissbc, IOSTAT = ios, ERR = 901)
215901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampissbc in reference namelist', lwp )
216
217      REWIND( numnatp_cfg )              ! Namelist nampissbc in configuration namelist : Pisces external sources of nutrients
218      READ  ( numnatp_cfg, nampissbc, IOSTAT = ios, ERR = 902 )
219902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampissbc in configuration namelist', lwp )
220      IF(lwm) WRITE ( numonp, nampissbc )
221
222      IF(lwp) THEN
223         WRITE(numout,*) ' '
224         WRITE(numout,*) ' namelist : nampissbc '
225         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~ '
226         WRITE(numout,*) '    dust input from the atmosphere           ln_dust     = ', ln_dust
227         WRITE(numout,*) '    Variable solubility of iron input        ln_solub    = ', ln_solub
228         WRITE(numout,*) '    river input of nutrients                 ln_river    = ', ln_river
229         WRITE(numout,*) '    atmospheric deposition of n              ln_ndepo    = ', ln_ndepo
230         WRITE(numout,*) '    Fe input from sediments                  ln_ironsed  = ', ln_ironsed
231         WRITE(numout,*) '    Fe input from seaice                     ln_ironice  = ', ln_ironice
232         WRITE(numout,*) '    fe input from hydrothermal vents         ln_hydrofe  = ', ln_hydrofe
233         WRITE(numout,*) '    coastal release of iron                  sedfeinput  = ', sedfeinput
234         WRITE(numout,*) '    solubility of the dust                   dustsolub   = ', dustsolub
235         WRITE(numout,*) '    Mineral Fe content of the dust           mfrac       = ', mfrac
236         WRITE(numout,*) '    Iron concentration in sea ice            icefeinput  = ', icefeinput
237         WRITE(numout,*) '    sinking speed of the dust                wdust       = ', wdust
238         WRITE(numout,*) '    nitrogen fixation rate                   nitrfix     = ', nitrfix
239         WRITE(numout,*) '    nitrogen fixation sensitivty to light    diazolight  = ', diazolight
240         WRITE(numout,*) '    fe half-saturation cste for diazotrophs  concfediaz  = ', concfediaz
241         WRITE(numout,*) '    Fe to 3He ratio assumed for vent iron supply hratio  = ', hratio
242      END IF
243
244      IF( ln_dust .OR. ln_river .OR. ln_ndepo ) THEN  ;  ll_sbc = .TRUE.
245      ELSE                                            ;  ll_sbc = .FALSE.
246      ENDIF
247
248      IF( ln_dust .AND. ln_solub ) THEN               ;  ll_solub = .TRUE.
249      ELSE                                            ;  ll_solub = .FALSE.
250      ENDIF
251
252      ! dust input from the atmosphere
253      ! ------------------------------
254      IF( ln_dust ) THEN 
255         !
256         IF(lwp) WRITE(numout,*) '    initialize dust input from atmosphere '
257         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
258         !
259         ALLOCATE( dust(jpi,jpj) )    ! allocation
260         !
261         ALLOCATE( sf_dust(1), STAT=ierr )           !* allocate and fill sf_sst (forcing structure) with sn_sst
262         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_dust structure' )
263         !
264         CALL fld_fill( sf_dust, (/ sn_dust /), cn_dir, 'p4z_sed_init', 'Atmospheric dust deposition', 'nampissed' )
265                                   ALLOCATE( sf_dust(1)%fnow(jpi,jpj,1)   )
266         IF( sn_dust%ln_tint )     ALLOCATE( sf_dust(1)%fdta(jpi,jpj,1,2) )
267         !
268         IF( Agrif_Root() ) THEN   !  Only on the master grid
269            ! Get total input dust ; need to compute total atmospheric supply of Si in a year
270            CALL iom_open (  TRIM( sn_dust%clname ) , numdust )
271            CALL iom_gettime( numdust, zsteps, kntime=ntimes_dust)  ! get number of record in file
272            ALLOCATE( zdust(jpi,jpj,ntimes_dust) )
273            DO jm = 1, ntimes_dust
274               CALL iom_get( numdust, jpdom_data, TRIM( sn_dust%clvar ), zdust(:,:,jm), jm )
275            END DO
276            CALL iom_close( numdust )
277            ztimes_dust = 1._wp / FLOAT( ntimes_dust ) 
278            sumdepsi = 0.e0
279            DO jm = 1, ntimes_dust
280               sumdepsi = sumdepsi + glob_sum( zdust(:,:,jm) * e1e2t(:,:) * tmask(:,:,1) * ztimes_dust )
281            ENDDO
282            sumdepsi = sumdepsi / ( nyear_len(1) * rday ) * 12. * 8.8 * 0.075 * mfrac / 28.1 
283            DEALLOCATE( zdust)
284         ENDIF
285      ELSE
286         sumdepsi  = 0._wp
287      END IF
288
289      ! Solubility of dust deposition of iron
290      ! Only if ln_dust and ln_solubility set to true (ll_solub = .true.)
291      ! -----------------------------------------------------------------
292      IF( ll_solub ) THEN
293         !
294         IF(lwp) WRITE(numout,*) '    initialize variable solubility of Fe '
295         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
296         !
297         ALLOCATE( solub(jpi,jpj) )    ! allocation
298         !
299         ALLOCATE( sf_solub(1), STAT=ierr )           !* allocate and fill sf_sst (forcing structure) with sn_sst
300         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_solub structure' )
301         !
302         CALL fld_fill( sf_solub, (/ sn_solub /), cn_dir, 'p4z_sed_init', 'Solubility of atm. iron ', 'nampissed' )
303                                   ALLOCATE( sf_solub(1)%fnow(jpi,jpj,1)   )
304         IF( sn_solub%ln_tint )    ALLOCATE( sf_solub(1)%fdta(jpi,jpj,1,2) )
305         ! get number of record in file
306         CALL iom_open (  TRIM( sn_solub%clname ) , numsolub )
307         CALL iom_gettime( numsolub, zsteps, kntime=ntimes_solub)  ! get number of record in file
308         CALL iom_close( numsolub )
309      ENDIF
310
311      ! nutrient input from rivers
312      ! --------------------------
313      IF( ln_river ) THEN
314         !
315         slf_river(jr_dic) = sn_riverdic  ;  slf_river(jr_doc) = sn_riverdoc  ;  slf_river(jr_din) = sn_riverdin 
316         slf_river(jr_don) = sn_riverdon  ;  slf_river(jr_dip) = sn_riverdip  ;  slf_river(jr_dop) = sn_riverdop
317         slf_river(jr_dsi) = sn_riverdsi 
318         !
319         ALLOCATE( rivdic(jpi,jpj), rivalk(jpi,jpj), rivdin(jpi,jpj), rivdip(jpi,jpj), rivdsi(jpi,jpj) ) 
320         !
321         ALLOCATE( sf_river(jpriv), rivinput(jpriv), STAT=ierr1 )           !* allocate and fill sf_river (forcing structure) with sn_river_
322         rivinput(:) = 0.0
323
324         IF( ierr1 > 0 )   CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_irver structure' )
325         !
326         CALL fld_fill( sf_river, slf_river, cn_dir, 'p4z_sed_init', 'Input from river ', 'nampissed' )
327         DO ifpr = 1, jpriv
328                                          ALLOCATE( sf_river(ifpr)%fnow(jpi,jpj,1  ) )
329            IF( slf_river(ifpr)%ln_tint ) ALLOCATE( sf_river(ifpr)%fdta(jpi,jpj,1,2) )
330         END DO
331         IF( Agrif_Root() ) THEN   !  Only on the master grid
332            ! Get total input rivers ; need to compute total river supply in a year
333            DO ifpr = 1, jpriv
334               CALL iom_open ( TRIM( slf_river(ifpr)%clname ), numriv )
335               CALL iom_gettime( numriv, zsteps, kntime=ntimes_riv)
336               ALLOCATE( zriver(jpi,jpj,ntimes_riv) )
337               DO jm = 1, ntimes_riv
338                  CALL iom_get( numriv, jpdom_data, TRIM( slf_river(ifpr)%clvar ), zriver(:,:,jm), jm )
339               END DO
340               CALL iom_close( numriv )
341               ztimes_riv = 1._wp / FLOAT(ntimes_riv) 
342               DO jm = 1, ntimes_riv
343                  rivinput(ifpr) = rivinput(ifpr) + glob_sum( zriver(:,:,jm) * tmask(:,:,1) * ztimes_riv ) 
344               END DO
345               DEALLOCATE( zriver)
346            END DO
347            ! N/P and Si releases due to coastal rivers
348            ! -----------------------------------------
349            rivdicinput = (rivinput(jr_dic) + rivinput(jr_doc) ) * 1E3 / 12._wp
350            rivdininput = (rivinput(jr_din) + rivinput(jr_don) ) * 1E3 / rno3 / 14._wp
351            rivdipinput = (rivinput(jr_dip) + rivinput(jr_dop) ) * 1E3 / po4r / 31._wp
352            rivdsiinput = rivinput(jr_dsi) * 1E3 / 28.1_wp
353            rivalkinput = rivinput(jr_dic) * 1E3 / 12._wp
354            !
355         ENDIF
356      ELSE
357         rivdicinput = 0._wp
358         rivdininput = 0._wp
359         rivdipinput = 0._wp
360         rivdsiinput = 0._wp
361         rivalkinput = 0._wp
362      END IF 
363
364      ! nutrient input from dust
365      ! ------------------------
366      IF( ln_ndepo ) THEN
367         !
368         IF(lwp) WRITE(numout,*) '    initialize the nutrient input by dust from ndeposition.orca.nc'
369         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
370         !
371         ALLOCATE( nitdep(jpi,jpj) )    ! allocation
372         !
373         ALLOCATE( sf_ndepo(1), STAT=ierr3 )           !* allocate and fill sf_sst (forcing structure) with sn_sst
374         IF( ierr3 > 0 )   CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_ndepo structure' )
375         !
376         CALL fld_fill( sf_ndepo, (/ sn_ndepo /), cn_dir, 'p4z_sed_init', 'Nutrient atmospheric depositon ', 'nampissed' )
377                                   ALLOCATE( sf_ndepo(1)%fnow(jpi,jpj,1)   )
378         IF( sn_ndepo%ln_tint )    ALLOCATE( sf_ndepo(1)%fdta(jpi,jpj,1,2) )
379         !
380         IF( Agrif_Root() ) THEN   !  Only on the master grid
381            ! Get total input dust ; need to compute total atmospheric supply of N in a year
382            CALL iom_open ( TRIM( sn_ndepo%clname ), numdepo )
383            CALL iom_gettime( numdepo, zsteps, kntime=ntimes_ndep)
384            ALLOCATE( zndepo(jpi,jpj,ntimes_ndep) )
385            DO jm = 1, ntimes_ndep
386               CALL iom_get( numdepo, jpdom_data, TRIM( sn_ndepo%clvar ), zndepo(:,:,jm), jm )
387            END DO
388            CALL iom_close( numdepo )
389            ztimes_ndep = 1._wp / FLOAT( ntimes_ndep ) 
390            nitdepinput = 0._wp
391            DO jm = 1, ntimes_ndep
392              nitdepinput = nitdepinput + glob_sum( zndepo(:,:,jm) * e1e2t(:,:) * tmask(:,:,1) * ztimes_ndep )
393            ENDDO
394            nitdepinput = nitdepinput / rno3 / 14E6 
395            DEALLOCATE( zndepo)
396         ENDIF
397      ELSE
398         nitdepinput = 0._wp
399      ENDIF
400
401      ! coastal and island masks
402      ! ------------------------
403      IF( ln_ironsed ) THEN     
404         !
405         IF(lwp) WRITE(numout,*) '    computation of an island mask to enhance coastal supply of iron'
406         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
407         !
408         ALLOCATE( ironsed(jpi,jpj,jpk) )    ! allocation
409         !
410         CALL iom_open ( TRIM( sn_ironsed%clname ), numiron )
411         ALLOCATE( zcmask(jpi,jpj,jpk) )
412         CALL iom_get  ( numiron, jpdom_data, TRIM( sn_ironsed%clvar ), zcmask(:,:,:), 1 )
413         CALL iom_close( numiron )
414         !
415         DO jk = 1, 5
416            DO jj = 2, jpjm1
417               DO ji = fs_2, fs_jpim1
418                  IF( tmask(ji,jj,jk) /= 0. ) THEN
419                     zmaskt = tmask(ji+1,jj,jk) * tmask(ji-1,jj,jk) * tmask(ji,jj+1,jk)    &
420                        &                       * tmask(ji,jj-1,jk) * tmask(ji,jj,jk+1)
421                     IF( zmaskt == 0. )   zcmask(ji,jj,jk ) = MAX( 0.1, zcmask(ji,jj,jk) ) 
422                  END IF
423               END DO
424            END DO
425         END DO
426         IF( cp_cfg == 'orca' .AND. jp_cfg == 2 ) THEN
427            ii0 = 176   ;   ii1 =  176        ! Southern Island : Kerguelen
428            ij0 =  37   ;   ij1 =   37  ;   zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  0.3_wp 
429            !
430            ii0 = 119   ;   ii1 =  119        ! South Georgia
431            ij0 =  29   ;   ij1 =   29  ;   zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  0.3_wp 
432            !
433            ii0 = 111   ;   ii1 =  111        ! Falklands
434            ij0 =  35   ;   ij1 =   35  ;   zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  0.3_wp 
435            !
436            ii0 = 168   ;   ii1 =  168        ! Crozet
437            ij0 =  40   ;   ij1 =   40  ;   zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  0.3_wp 
438            !
439            ii0 = 119   ;   ii1 =  119        ! South Orkney
440            ij0 =  28   ;   ij1 =   28  ;   zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  0.3_wp 
441            !
442            ii0 = 140   ;   ii1 =  140        ! Bouvet Island
443            ij0 =  33   ;   ij1 =   33  ;   zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  0.3_wp 
444            !
445            ii0 = 178   ;   ii1 =  178        ! Prince edwards
446            ij0 =  34   ;   ij1 =   34  ;   zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  0.3_wp 
447            !
448            ii0 =  43   ;   ii1 =   43        ! Balleny islands
449            ij0 =  21   ;   ij1 =   21  ;   zcmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  0.3_wp 
450         ENDIF
451         CALL lbc_lnk( zcmask , 'T', 1. )      ! lateral boundary conditions on cmask   (sign unchanged)
452         DO jk = 1, jpk
453            DO jj = 1, jpj
454               DO ji = 1, jpi
455                  zexpide   = MIN( 8.,( fsdept(ji,jj,jk) / 500. )**(-1.5) )
456                  zdenitide = -0.9543 + 0.7662 * LOG( zexpide ) - 0.235 * LOG( zexpide )**2
457                  zcmask(ji,jj,jk) = zcmask(ji,jj,jk) * MIN( 1., EXP( zdenitide ) / 0.5 )
458               END DO
459            END DO
460         END DO
461         ! Coastal supply of iron
462         ! -------------------------
463         ironsed(:,:,jpk) = 0._wp
464         DO jk = 1, jpkm1
465            ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( fse3t(:,:,jk) * rday )
466         END DO
467         DEALLOCATE( zcmask)
468      ENDIF
469      !
470      ! Iron from Hydrothermal vents
471      ! ------------------------
472      IF( ln_hydrofe ) THEN
473         !
474         IF(lwp) WRITE(numout,*) '    Input of iron from hydrothermal vents '
475         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
476         !
477         ALLOCATE( hydrofe(jpi,jpj,jpk) )    ! allocation
478         !
479         CALL iom_open ( TRIM( sn_hydrofe%clname ), numhydro )
480         CALL iom_get  ( numhydro, jpdom_data, TRIM( sn_hydrofe%clvar ), hydrofe(:,:,:), 1 )
481         CALL iom_close( numhydro )
482         !
483         hydrofe(:,:,:) = ( hydrofe(:,:,:) * hratio ) / ( cvol(:,:,:) * ryyss + rtrn ) / 1000._wp
484         !
485      ENDIF
486      !
487      IF( ll_sbc ) CALL p4z_sbc( nit000 ) 
488      !
489      IF(lwp) THEN
490         WRITE(numout,*)
491         WRITE(numout,*) '    Total input of elements from river supply'
492         WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
493         WRITE(numout,*) '    N Supply   : ', rivdininput*rno3*1E3/1E12*14.,' TgN/yr'
494         WRITE(numout,*) '    Si Supply  : ', rivdsiinput*1E3/1E12*28.1,' TgSi/yr'
495         WRITE(numout,*) '    P Supply   : ', rivdipinput*1E3*po4r/1E12*31.,' TgP/yr'
496         WRITE(numout,*) '    Alk Supply : ', rivalkinput*1E3/1E12,' Teq/yr'
497         WRITE(numout,*) '    DIC Supply : ', rivdicinput*1E3*12./1E12,'TgC/yr'
498         WRITE(numout,*) 
499         WRITE(numout,*) '    Total input of elements from atmospheric supply'
500         WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
501         WRITE(numout,*) '    N Supply   : ', nitdepinput*rno3*1E3/1E12*14.,' TgN/yr'
502         WRITE(numout,*) 
503      ENDIF
504      !
505      IF( nn_timing == 1 )  CALL timing_stop('p4z_sbc_init')
506      !
507   END SUBROUTINE p4z_sbc_init
508
509#else
510   !!======================================================================
511   !!  Dummy module :                                   No PISCES bio-model
512   !!======================================================================
513CONTAINS
514   SUBROUTINE p4z_sbc                         ! Empty routine
515   END SUBROUTINE p4z_sbc
516#endif 
517
518   !!======================================================================
519END MODULE  p4zsbc
Note: See TracBrowser for help on using the repository browser.