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.
p4zbc.F90 in NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/TOP/PISCES/P4Z – NEMO

source: NEMO/branches/2020/dev_r12563_ASINTER-06_ABL_improvement/src/TOP/PISCES/P4Z/p4zbc.F90 @ 13891

Last change on this file since 13891 was 12377, checked in by acc, 4 years ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

File size: 16.4 KB
Line 
1MODULE p4zbc
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   !!   p4z_bc        :  Read and interpolate time-varying nutrients fluxes
9   !!   p4z_bc_init   :  Initialization of p4z_bc
10   !!----------------------------------------------------------------------
11   USE oce_trc         !  shared variables between ocean and passive tracers
12   USE trc             !  passive tracers common variables
13   USE sms_pisces      !  PISCES Source Minus Sink variables
14   USE iom             !  I/O manager
15   USE fldread         !  time interpolation
16   USE trcbc
17
18   IMPLICIT NONE
19   PRIVATE
20
21   PUBLIC   p4z_bc
22   PUBLIC   p4z_bc_init   
23
24   LOGICAL , PUBLIC ::   ln_ironsed   !: boolean for Fe input from sediments
25   LOGICAL , PUBLIC ::   ln_hydrofe   !: boolean for Fe input from hydrothermal vents
26   REAL(wp), PUBLIC ::   sedfeinput   !: Coastal release of Iron
27   REAL(wp), PUBLIC ::   icefeinput   !: Iron concentration in sea ice
28   REAL(wp), PUBLIC ::   wdust        !: Sinking speed of the dust
29   REAL(wp), PUBLIC ::   mfrac        !: Mineral Content of the dust
30   REAL(wp)         ::   hratio       !: Fe:3He ratio assumed for vent iron supply
31   REAL(wp)         ::   distcoast    !: Distance off the coast for Iron from sediments
32   REAL(wp), PUBLIC ::   lgw_rath     !: Weak ligand ratio from hydro sources
33
34   LOGICAL , PUBLIC ::   ll_bc
35   LOGICAL , PUBLIC ::   ll_dust      !: boolean for dust input from the atmosphere
36   LOGICAL , PUBLIC ::   ll_river     !: boolean for river input of nutrients
37   LOGICAL , PUBLIC ::   ll_ndepo     !: boolean for atmospheric deposition of N
38   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_dust      ! structure of input dust
39   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_ironsed   ! structure of input iron from sediment
40   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_hydrofe   ! structure of input iron from sediment
41
42   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   dust    !: dust fields
43   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ironsed          !: Coastal supply of iron
44   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hydrofe          !: Hydrothermal vent supply of iron
45
46   REAL(wp), PUBLIC :: sedsilfrac, sedcalfrac
47
48   !! * Substitutions
49#  include "do_loop_substitute.h90"
50   !!----------------------------------------------------------------------
51   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
52   !! $Id: p4zbc.F90 10869 2019-04-15 10:34:03Z cetlod $
53   !! Software governed by the CeCILL license (see ./LICENSE)
54   !!----------------------------------------------------------------------
55CONTAINS
56
57   SUBROUTINE p4z_bc( kt, Kbb, Kmm, Krhs )
58      !!----------------------------------------------------------------------
59      !!                  ***  routine p4z_bc  ***
60      !!
61      !! ** purpose :   read and interpolate the external sources of nutrients
62      !!
63      !! ** method  :   read the files and interpolate the appropriate variables
64      !!
65      !! ** input   :   external netcdf files
66      !!
67      !!----------------------------------------------------------------------
68      INTEGER, INTENT(in) ::   kt              ! ocean time step
69      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! time level index
70      !
71      INTEGER  ::  ji, jj, jk, jl 
72      REAL(wp) ::  zcoef, zyyss
73      REAL(wp) ::  zdep, ztrfer, zwdust, zwflux, zrivdin
74      !
75      CHARACTER (len=25) :: charout
76      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zirondep
77      REAL(wp), ALLOCATABLE, DIMENSION(:,:  ) :: zironice, zndep
78      !!---------------------------------------------------------------------
79      !
80      IF( ln_timing )   CALL timing_start('p4z_bc')
81      !
82      IF( ll_dust )  THEN
83         ALLOCATE(  zirondep(jpi,jpj,jpk) )
84         !
85         CALL fld_read( kt, 1, sf_dust )
86         dust(:,:) = MAX( rtrn, sf_dust(1)%fnow(:,:,1) )
87         !
88         jl = n_trc_indsbc(jpfer)
89         zirondep(:,:,1) = rf_trsfac(jl) * sf_trcsbc(jl)%fnow(:,:,1) / e3t(:,:,1,Kmm) / rn_sbc_time
90         !                                              ! Iron solubilization of particles in the water column
91         !                                              ! dust in kg/m2/s ---> 1/55.85 to put in mol/Fe ;  wdust in m/j
92         zwdust = 0.03 / ( wdust / rday ) / ( 270. * rday )
93         DO jk = 2, jpkm1
94            zirondep(:,:,jk) = ( mfrac * dust(:,:) * zwdust / mMass_Fe ) * rfact * EXP( -gdept(:,:,jk,Kmm) / 540. )
95            tr(:,:,jk,jpfer,Krhs) = tr(:,:,jk,jpfer,Krhs) + zirondep(:,:,jk)
96            tr(:,:,jk,jppo4,Krhs) = tr(:,:,jk,jppo4,Krhs) + zirondep(:,:,jk) * 0.023
97         ENDDO
98         !
99         IF( lk_iomput ) THEN
100             CALL iom_put( "Irondep", zirondep(:,:,1) * 1.e+3 * rfactr * e3t(:,:,1,Kmm) * tmask(:,:,1) ) ! surface downward dust depo of iron
101             CALL iom_put( "pdust"  , dust(:,:) / ( wdust * rday ) * tmask(:,:,1) ) ! dust concentration at surface
102         ENDIF
103         DEALLOCATE( zirondep )
104      ENDIF
105
106      ! N/P and Si releases due to coastal rivers
107      ! Compute river at nit000 or only if there is more than 1 time record in river file
108      ! -----------------------------------------
109            ! Add the external input of nutrients from river
110      ! ----------------------------------------------------------
111      IF( ll_river ) THEN
112          jl = n_trc_indcbc(jpno3)
113          DO_2D_11_11
114             DO jk = 1, nk_rnf(ji,jj)
115                zcoef = rn_rfact / ( e1e2t(ji,jj) * h_rnf(ji,jj) * rn_cbc_time ) * tmask(ji,jj,1)
116                zrivdin = rf_trcfac(jl) * sf_trccbc(jl)%fnow(ji,jj,1) * zcoef
117                tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - rno3 * zrivdin * rfact
118            ENDDO
119          END_2D
120      ENDIF
121     
122      ! Add the external input of nutrients from nitrogen deposition
123      ! ----------------------------------------------------------
124      IF( ll_ndepo ) THEN
125         ALLOCATE( zndep(jpi,jpj) )
126         IF( ln_trc_sbc(jpno3) ) THEN
127            jl = n_trc_indsbc(jpno3)
128            zndep(:,:) = rf_trsfac(jl) * sf_trcsbc(jl)%fnow(:,:,1) / e3t(:,:,1,Kmm) / rn_sbc_time
129            tr(:,:,1,jptal,Krhs) = tr(:,:,1,jptal,Krhs) - rno3 * zndep(:,:) * rfact
130         ENDIF
131         IF( ln_trc_sbc(jpnh4) ) THEN
132            jl = n_trc_indsbc(jpnh4)
133            zndep(:,:) = rf_trsfac(jl) * sf_trcsbc(jl)%fnow(:,:,1) / e3t(:,:,1,Kmm) / rn_sbc_time
134            tr(:,:,1,jptal,Krhs) = tr(:,:,1,jptal,Krhs) - rno3 * zndep(:,:) * rfact
135         ENDIF
136         DEALLOCATE( zndep )
137      ENDIF
138      !
139      ! Iron input/uptake due to sea ice : Crude parameterization based on
140      ! Lancelot et al.
141      ! ----------------------------------------------------
142      IF( ln_ironice ) THEN
143         !
144         ALLOCATE( zironice(jpi,jpj) )
145         !
146         DO_2D_11_11
147            zdep    = rfact / e3t(ji,jj,1,Kmm)
148            zwflux  = fmmflx(ji,jj) / 1000._wp
149            zironice(ji,jj) =  MAX( -0.99 * tr(ji,jj,1,jpfer,Kbb), -zwflux * icefeinput * zdep )
150         END_2D
151         !
152         tr(:,:,1,jpfer,Krhs) = tr(:,:,1,jpfer,Krhs) + zironice(:,:)
153         !
154         IF( lk_iomput )  CALL iom_put( "Ironice", zironice(:,:) * 1.e+3 * rfactr * e3t(:,:,1,Kmm) * tmask(:,:,1) ) ! iron flux from ice
155         !
156         DEALLOCATE( zironice )
157         !
158      ENDIF
159
160      ! Add the external input of iron from sediment mobilization
161      ! ------------------------------------------------------
162      IF( ln_ironsed .AND. .NOT.lk_sed ) THEN
163          tr(:,:,:,jpfer,Krhs) = tr(:,:,:,jpfer,Krhs) + ironsed(:,:,:) * rfact
164          !
165          IF( lk_iomput )  CALL iom_put( "Ironsed", ironsed(:,:,:) * 1.e+3 * tmask(:,:,:) ) 
166      ENDIF
167
168      ! Add the external input of iron from hydrothermal vents
169      ! ------------------------------------------------------
170      IF( ln_hydrofe ) THEN
171         CALL fld_read( kt, 1, sf_hydrofe )
172         DO jk = 1, jpk
173            hydrofe(:,:,jk) = ( MAX( rtrn, sf_hydrofe(1)%fnow(:,:,jk) ) * hratio ) &
174              &              / ( e1e2t(:,:) * e3t(:,:,jk,Kmm) * ryyss + rtrn ) / 1000._wp &
175              &              * tmask(:,:,jk)
176         ENDDO
177                         tr(:,:,:,jpfer,Krhs) = tr(:,:,:,jpfer,Krhs) + hydrofe(:,:,:) * rfact
178         IF( ln_ligand ) tr(:,:,:,jplgw,Krhs) = tr(:,:,:,jplgw,Krhs) + ( hydrofe(:,:,:) * lgw_rath ) * rfact
179         !
180         IF( lk_iomput ) CALL iom_put( "HYDR", hydrofe(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! hydrothermal iron input
181      ENDIF
182      IF( ln_timing )  CALL timing_stop('p4z_bc')
183      !
184   END SUBROUTINE p4z_bc
185
186
187   SUBROUTINE p4z_bc_init( Kmm ) 
188      !!----------------------------------------------------------------------
189      !!                  ***  routine p4z_bc_init  ***
190      !!
191      !! ** purpose :   initialization of the external sources of nutrients
192      !!
193      !! ** method  :   read the files and compute the budget
194      !!                called at the first timestep (nittrc000)
195      !!
196      !! ** input   :   external netcdf files
197      !!
198      !!----------------------------------------------------------------------
199      INTEGER, INTENT( in ) ::   Kmm  ! time level index
200      INTEGER  :: ji, jj, jk, jm
201      INTEGER  :: ii0, ii1, ij0, ij1
202      INTEGER  :: numiron
203      INTEGER  :: ierr, ierr1, ierr2, ierr3
204      INTEGER  :: ios                 ! Local integer output status for namelist read
205      INTEGER  :: ik50                !  last level where depth less than 50 m
206      REAL(wp) :: zexpide, zdenitide, zmaskt, zsurfc, zsurfp,ze3t, ze3t2, zcslp
207      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zriver, zcmask
208      !
209      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files
210      TYPE(FLD_N) ::   sn_dust, sn_ironsed, sn_hydrofe   ! informations about the fields to be read
211      !!
212      NAMELIST/nampisbc/cn_dir, sn_dust, sn_ironsed, sn_hydrofe, &
213        &                ln_ironsed, ln_ironice, ln_hydrofe,    &
214        &                sedfeinput, distcoast, icefeinput, wdust, mfrac,  &
215        &                hratio, lgw_rath
216      !!----------------------------------------------------------------------
217      !
218      IF(lwp) THEN
219         WRITE(numout,*)
220         WRITE(numout,*) 'p4z_bc_init : initialization of the external sources of nutrients '
221         WRITE(numout,*) '~~~~~~~~~~~~ '
222      ENDIF
223      !                            !* set file information
224      READ  ( numnatp_ref, nampisbc, IOSTAT = ios, ERR = 901)
225901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampisbc in reference namelist' )
226      READ  ( numnatp_cfg, nampisbc, IOSTAT = ios, ERR = 902 )
227902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisbc in configuration namelist' )
228      IF(lwm) WRITE ( numonp, nampisbc )
229
230
231      IF(lwp) THEN
232         WRITE(numout,*) '   Namelist : nampissbc '
233         WRITE(numout,*) '      Fe input from sediments                  ln_ironsed  = ', ln_ironsed
234         WRITE(numout,*) '      Fe input from seaice                     ln_ironice  = ', ln_ironice
235         WRITE(numout,*) '      fe input from hydrothermal vents         ln_hydrofe  = ', ln_hydrofe
236         IF( ln_ironsed ) THEN
237            WRITE(numout,*) '      coastal release of iron                  sedfeinput  = ', sedfeinput
238            WRITE(numout,*) '      distance off the coast                   distcoast   = ', distcoast
239         ENDIF
240         IF( ln_ligand ) THEN
241            WRITE(numout,*) '      Weak ligand ratio from sed hydro sources  lgw_rath   = ', lgw_rath
242         ENDIF
243         IF( ln_ironice ) THEN
244            WRITE(numout,*) '      Iron concentration in sea ice            icefeinput  = ', icefeinput
245         ENDIF
246         IF( ln_trc_sbc(jpfer) ) THEN
247            WRITE(numout,*) '      Mineral Fe content of the dust           mfrac       = ', mfrac
248            WRITE(numout,*) '      sinking speed of the dust                wdust       = ', wdust
249         ENDIF
250         IF( ln_hydrofe ) THEN
251            WRITE(numout,*) '      Fe to 3He ratio assumed for vent iron supply hratio  = ', hratio
252         ENDIF
253      END IF
254
255      ll_bc    = ( ln_trcbc .AND. lltrcbc )  .OR. ln_hydrofe .OR. ln_ironsed .OR. ln_ironice
256      ll_dust  =  ln_trc_sbc(jpfer)   
257      ll_ndepo =  ln_trc_sbc(jpno3) .OR. ln_trc_sbc(jpnh4)   
258      ll_river =  ln_trc_cbc(jpno3) 
259
260      ! dust input from the atmosphere
261      ! ------------------------------
262      IF( ll_dust ) THEN
263         !
264         IF(lwp) WRITE(numout,*) '    initialize dust input from atmosphere '
265         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
266         !
267         ALLOCATE( dust(jpi,jpj) ) 
268         !
269         ALLOCATE( sf_dust(1), STAT=ierr )           !* allocate and fill sf_sst (forcing structure) with sn_sst
270         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_dust structure' )
271         !
272         CALL fld_fill( sf_dust, (/ sn_dust /), cn_dir, 'p4z_sed_init', 'Atmospheric dust deposition', 'nampissed' )
273                                   ALLOCATE( sf_dust(1)%fnow(jpi,jpj,1)   )
274         IF( sn_dust%ln_tint )     ALLOCATE( sf_dust(1)%fdta(jpi,jpj,1,2) )
275         !
276      END IF
277
278      ! coastal and island masks
279      ! ------------------------
280      IF( ln_ironsed ) THEN     
281         !
282         IF(lwp) WRITE(numout,*)
283         IF(lwp) WRITE(numout,*) '   ==>>>   ln_ironsed=T , computation of an island mask to enhance coastal supply of iron'
284         !
285         ALLOCATE( ironsed(jpi,jpj,jpk) )    ! allocation
286         !
287         CALL iom_open ( TRIM( sn_ironsed%clname ), numiron )
288         ALLOCATE( zcmask(jpi,jpj,jpk) )
289         CALL iom_get  ( numiron, jpdom_data, TRIM( sn_ironsed%clvar ), zcmask(:,:,:), 1 )
290         CALL iom_close( numiron )
291         !
292         ik50 = 5        !  last level where depth less than 50 m
293         DO jk = jpkm1, 1, -1
294            IF( gdept_1d(jk) > 50. )   ik50 = jk - 1
295         END DO
296         IF(lwp) WRITE(numout,*)
297         IF(lwp) WRITE(numout,*) ' Level corresponding to 50m depth ',  ik50,' ', gdept_1d(ik50+1)
298         DO_3D_00_00( 1, ik50 )
299            ze3t   = e3t_0(ji,jj,jk)
300            zsurfc =  e1u(ji,jj) * ( 1. - umask(ji  ,jj  ,jk) )   &
301                    + e1u(ji,jj) * ( 1. - umask(ji-1,jj  ,jk) )   &
302                    + e2v(ji,jj) * ( 1. - vmask(ji  ,jj  ,jk) )   &
303                    + e2v(ji,jj) * ( 1. - vmask(ji  ,jj-1,jk) )
304            zsurfp = zsurfc * ze3t / e1e2t(ji,jj)
305            ! estimation of the coastal slope : 5 km off the coast
306            ze3t2 = ze3t * ze3t
307            zcslp = SQRT( ( distcoast*distcoast + ze3t2 ) / ze3t2 )
308            !
309            zcmask(ji,jj,jk) = zcmask(ji,jj,jk) + zcslp * zsurfp
310         END_3D
311         !
312         CALL lbc_lnk( 'p4zbc', zcmask , 'T', 1. )      ! lateral boundary conditions on cmask   (sign unchanged)
313         !
314         DO_3D_11_11( 1, jpk )
315            zexpide   = MIN( 8.,( gdept(ji,jj,jk,Kmm) / 500. )**(-1.5) )
316            zdenitide = -0.9543 + 0.7662 * LOG( zexpide ) - 0.235 * LOG( zexpide )**2
317            zcmask(ji,jj,jk) = zcmask(ji,jj,jk) * MIN( 1., EXP( zdenitide ) / 0.5 )
318         END_3D
319         ! Coastal supply of iron
320         ! -------------------------
321         ironsed(:,:,jpk) = 0._wp
322         DO jk = 1, jpkm1
323            ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( e3t_0(:,:,jk) * rday )
324         END DO
325         DEALLOCATE( zcmask)
326      ENDIF
327      !
328      ! Iron from Hydrothermal vents
329      ! ------------------------
330      IF( ln_hydrofe ) THEN
331         !
332         IF(lwp) WRITE(numout,*)
333         IF(lwp) WRITE(numout,*) '   ==>>>   ln_hydrofe=T , Input of iron from hydrothermal vents'
334         !
335         ALLOCATE( hydrofe(jpi,jpj,jpk) )    ! allocation
336         !
337         ALLOCATE( sf_hydrofe(1), STAT=ierr )           !* allocate and fill sf_sst (forcing structure) with sn_sst
338         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_hydro structure' )
339         !
340         CALL fld_fill( sf_hydrofe, (/ sn_hydrofe /), cn_dir, 'p4z_sed_init', 'Input of iron from hydrothermal vents', 'nampisbc' )
341                                   ALLOCATE( sf_hydrofe(1)%fnow(jpi,jpj,jpk)   )
342         IF( sn_hydrofe%ln_tint )    ALLOCATE( sf_hydrofe(1)%fdta(jpi,jpj,jpk,2) )
343         !
344      ENDIF
345      !
346   END SUBROUTINE p4z_bc_init
347
348   !!======================================================================
349END MODULE p4zbc
Note: See TracBrowser for help on using the repository browser.