MODULE p4zsed !!====================================================================== !! *** MODULE p4sed *** !! TOP : PISCES Compute loss of organic matter in the sediments !!====================================================================== !! History : 1.0 ! 2004-03 (O. Aumont) Original code !! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90 !!---------------------------------------------------------------------- #if defined key_pisces !!---------------------------------------------------------------------- !! 'key_pisces' PISCES bio-model !!---------------------------------------------------------------------- !! p4z_sed : Compute loss of organic matter in the sediments !! p4z_sbc : Read and interpolate time-varying nutrients fluxes !! p4z_sed_init : Initialization of p4z_sed !!---------------------------------------------------------------------- USE trc USE oce_trc ! USE sms_pisces USE lib_mpp USE prtctl_trc USE p4zbio USE p4zint USE p4zopt USE p4zsink USE p4zrem USE p4zlim USE lbclnk USE iom IMPLICIT NONE PRIVATE PUBLIC p4z_sed PUBLIC p4z_sed_init !! * Shared module variables LOGICAL, PUBLIC :: & ln_dustfer = .FALSE. , & !: ln_river = .FALSE. , & !: ln_ndepo = .FALSE. , & !: ln_sedinput = .FALSE. !: REAL(wp), PUBLIC :: & sedfeinput = 1.E-9_wp , & !: dustsolub = 0.014_wp !: !! * Module variables INTEGER :: & ryyss, & !: number of seconds per year rmtss !: number of seconds per month INTEGER :: & numdust, & !: logical unit for surface fluxes data nflx1 , nflx2, & !: first and second record used nflx11, nflx12 ! ??? REAL(wp), DIMENSION(jpi,jpj,2) :: & !: dustmo !: 2 consecutive set of dust fields REAL(wp), DIMENSION(jpi,jpj) :: & rivinp, cotdep, nitdep, dust REAL(wp), DIMENSION(jpi,jpj,jpk) :: & ironsed REAL(wp) :: sumdepsi, rivalkinput, rivpo4input, nitdepinput !!* Substitution # include "top_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/TOP 3.3 , NEMO Consortium (2010) !! $Header:$ !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- CONTAINS SUBROUTINE p4z_sed(kt, jnt) !!--------------------------------------------------------------------- !! *** ROUTINE p4z_sed *** !! !! ** Purpose : Compute loss of organic matter in the sediments. This !! is by no way a sediment model. The loss is simply !! computed to balance the inout from rivers and dust !! !! ** Method : - ??? !!--------------------------------------------------------------------- INTEGER, INTENT(in) :: kt, jnt ! ocean time step INTEGER :: ji, jj, jk INTEGER :: ikt #if ! defined key_sed REAL(wp) :: zsumsedsi, zsumsedpo4, zsumsedcal #endif REAL(wp) :: zconctmp , zdenitot , znitrpottot REAL(wp) :: zlim, zconctmp2, zfact, zrivalk REAL(wp), DIMENSION(jpi,jpj) :: zsidep REAL(wp), DIMENSION(jpi,jpj,jpk) :: znitrpot, zirondep #if defined key_diatrc REAL(wp) :: zrfact2 # if defined key_iomput REAL(wp), DIMENSION(jpi,jpj) :: zw2d # endif #endif CHARACTER (len=25) :: charout !!--------------------------------------------------------------------- IF( ( jnt == 1 ) .AND. ( ln_dustfer ) ) CALL p4z_sbc( kt ) zirondep(:,:,:) = 0.e0 ! Initialisation of variables used to compute deposition zsidep (:,:) = 0.e0 ! Iron and Si deposition at the surface ! ------------------------------------- DO jj = 1, jpj DO ji = 1, jpi zirondep(ji,jj,1) = ( dustsolub * dust(ji,jj) / ( 55.85 * rmtss ) + 3.e-10 / ryyss ) & & * rfact2 / fse3t(ji,jj,1) zsidep (ji,jj) = 8.8 * 0.075 * dust(ji,jj) * rfact2 / ( fse3t(ji,jj,1) * 28.1 * rmtss ) END DO END DO ! Iron solubilization of particles in the water column ! ---------------------------------------------------- DO jk = 2, jpkm1 zirondep(:,:,jk) = dust(:,:) / ( 10. * 55.85 * rmtss ) * rfact2 * 1.e-4 END DO ! Add the external input of nutrients, carbon and alkalinity ! ---------------------------------------------------------- trn(:,:,1,jppo4) = trn(:,:,1,jppo4) + rivinp(:,:) * rfact2 trn(:,:,1,jpno3) = trn(:,:,1,jpno3) + (rivinp(:,:) + nitdep(:,:)) * rfact2 trn(:,:,1,jpfer) = trn(:,:,1,jpfer) + rivinp(:,:) * 3.e-5 * rfact2 trn(:,:,1,jpsil) = trn(:,:,1,jpsil) + zsidep (:,:) + cotdep(:,:) * rfact2 / 6. trn(:,:,1,jpdic) = trn(:,:,1,jpdic) + rivinp(:,:) * 2.631 * rfact2 trn(:,:,1,jptal) = trn(:,:,1,jptal) + (cotdep(:,:) - rno3*(rivinp(:,:) + nitdep(:,:) ) ) * rfact2 ! Add the external input of iron which is 3D distributed ! (dust, river and sediment mobilization) ! ------------------------------------------------------ DO jk = 1, jpkm1 trn(:,:,jk,jpfer) = trn(:,:,jk,jpfer) + zirondep(:,:,jk) + ironsed(:,:,jk) * rfact2 END DO #if ! defined key_sed ! Initialisation of variables used to compute Sinking Speed zsumsedsi = 0.e0 zsumsedpo4 = 0.e0 zsumsedcal = 0.e0 ! Loss of biogenic silicon, Caco3 organic carbon in the sediments. ! First, the total loss is computed. ! The factor for calcite comes from the alkalinity effect ! ------------------------------------------------------------- DO jj = 1, jpj DO ji = 1, jpi ikt = MAX( mbathy(ji,jj)-1, 1 ) zfact = e1t(ji,jj) * e2t(ji,jj) / rday * tmask_i(ji,jj) # if defined key_kriest zsumsedsi = zsumsedsi + zfact * trn(ji,jj,ikt,jpdsi) * wscal (ji,jj,ikt) zsumsedpo4 = zsumsedpo4 + zfact * trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt) # else zsumsedsi = zsumsedsi + zfact * trn(ji,jj,ikt,jpdsi) * wsbio4(ji,jj,ikt) zsumsedpo4 = zsumsedpo4 + zfact *( trn(ji,jj,ikt,jpgoc) * wsbio4(ji,jj,ikt) & & + trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt) ) # endif zsumsedcal = zsumsedcal + zfact * trn(ji,jj,ikt,jpcal) * wscal (ji,jj,ikt) * 2.e0 END DO END DO IF( lk_mpp ) THEN CALL mpp_sum( zsumsedsi ) ! sums over the global domain CALL mpp_sum( zsumsedcal ) ! sums over the global domain CALL mpp_sum( zsumsedpo4 ) ! sums over the global domain ENDIF #endif ! Then this loss is scaled at each bottom grid cell for ! equilibrating the total budget of silica in the ocean. ! Thus, the amount of silica lost in the sediments equal ! the supply at the surface (dust+rivers) ! ------------------------------------------------------ DO jj = 1, jpj DO ji = 1, jpi ikt = MAX( mbathy(ji,jj) - 1, 1 ) # if ! defined key_kriest zconctmp = trn(ji,jj,ikt,jpdsi) * xstep / fse3t(ji,jj,ikt) * wscal (ji,jj,ikt) # else zconctmp = trn(ji,jj,ikt,jpdsi) * xstep / fse3t(ji,jj,ikt) * wsbio4(ji,jj,ikt) # endif trn(ji,jj,ikt,jpdsi) = trn(ji,jj,ikt,jpdsi) - zconctmp #if ! defined key_sed zrivalk = ( 1.- ( sumdepsi + rivalkinput / ryyss / 6. ) / zsumsedsi ) trn(ji,jj,ikt,jpsil) = trn(ji,jj,ikt,jpsil) + zconctmp * zrivalk #endif END DO END DO DO jj = 1, jpj DO ji = 1, jpi ikt = MAX( mbathy(ji,jj) - 1, 1 ) zconctmp = trn(ji,jj,ikt,jpcal) * wscal(ji,jj,ikt) * xstep / fse3t(ji,jj,ikt) trn(ji,jj,ikt,jpcal) = trn(ji,jj,ikt,jpcal) - zconctmp #if ! defined key_sed zrivalk = ( 1.- ( rivalkinput / ryyss ) / zsumsedcal ) trn(ji,jj,ikt,jptal) = trn(ji,jj,ikt,jptal) + zconctmp * zrivalk * 2.0 trn(ji,jj,ikt,jpdic) = trn(ji,jj,ikt,jpdic) + zconctmp * zrivalk #endif END DO END DO DO jj = 1, jpj DO ji = 1, jpi ikt = MAX( mbathy(ji,jj) - 1, 1 ) zfact = xstep / fse3t(ji,jj,ikt) # if ! defined key_kriest zconctmp = trn(ji,jj,ikt,jpgoc) zconctmp2 = trn(ji,jj,ikt,jppoc) trn(ji,jj,ikt,jpgoc) = trn(ji,jj,ikt,jpgoc) - zconctmp * wsbio4(ji,jj,ikt) * zfact trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) - zconctmp2 * wsbio3(ji,jj,ikt) * zfact #if ! defined key_sed trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc) & & + ( zconctmp * wsbio4(ji,jj,ikt) + zconctmp2 * wsbio3(ji,jj,ikt) ) * zfact & & * ( 1.- rivpo4input / (ryyss * zsumsedpo4 ) ) #endif trn(ji,jj,ikt,jpbfe) = trn(ji,jj,ikt,jpbfe) - trn(ji,jj,ikt,jpbfe) * wsbio4(ji,jj,ikt) * zfact trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) - trn(ji,jj,ikt,jpsfe) * wsbio3(ji,jj,ikt) * zfact # else zconctmp = trn(ji,jj,ikt,jpnum) zconctmp2 = trn(ji,jj,ikt,jppoc) trn(ji,jj,ikt,jpnum) = trn(ji,jj,ikt,jpnum) - zconctmp * wsbio4(ji,jj,ikt) * zfact trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) - zconctmp2 * wsbio3(ji,jj,ikt) * zfact #if ! defined key_sed trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc) + ( zconctmp2 * wsbio3(ji,jj,ikt) ) & * zfact * ( 1.- rivpo4input / ( ryyss * zsumsedpo4 ) ) #endif trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) - trn(ji,jj,ikt,jpsfe) * wsbio3(ji,jj,ikt) * zfact # endif END DO END DO ! Nitrogen fixation (simple parameterization). The total gain ! from nitrogen fixation is scaled to balance the loss by ! denitrification ! ------------------------------------------------------------- zdenitot = 0.e0 DO jk = 1, jpkm1 DO jj = 1,jpj DO ji = 1,jpi zdenitot = zdenitot + denitr(ji,jj,jk) * rdenit * cvol(ji,jj,jk) * xnegtr(ji,jj,jk) END DO END DO END DO IF( lk_mpp ) CALL mpp_sum( zdenitot ) ! sum over the global domain ! Potential nitrogen fixation dependant on temperature and iron ! ------------------------------------------------------------- !CDIR NOVERRCHK DO jk = 1, jpk !CDIR NOVERRCHK DO jj = 1, jpj !CDIR NOVERRCHK DO ji = 1, jpi zlim = ( 1.- xnanono3(ji,jj,jk) - xnanonh4(ji,jj,jk) ) IF( zlim <= 0.2 ) zlim = 0.01 znitrpot(ji,jj,jk) = MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) / rday ) & # if defined key_degrad & * facvol(ji,jj,jk) & # endif & * zlim * rfact2 * trn(ji,jj,jk,jpfer) & & / ( conc3 + trn(ji,jj,jk,jpfer) ) * ( 1.- EXP( -etot(ji,jj,jk) / 50.) ) END DO END DO END DO znitrpottot = 0.e0 DO jk = 1, jpkm1 DO jj = 1, jpj DO ji = 1, jpi znitrpottot = znitrpottot + znitrpot(ji,jj,jk) * cvol(ji,jj,jk) END DO END DO END DO IF( lk_mpp ) CALL mpp_sum( znitrpottot ) ! sum over the global domain ! Nitrogen change due to nitrogen fixation ! ---------------------------------------- DO jk = 1, jpk DO jj = 1, jpj DO ji = 1, jpi # if ! defined key_c1d && ( defined key_orca_r4 || defined key_orca_r2 || defined key_orca_r05 || defined key_orca_r025 ) !! zfact = znitrpot(ji,jj,jk) * zdenitot / znitrpottot zfact = znitrpot(ji,jj,jk) * 1.e-7 # else zfact = znitrpot(ji,jj,jk) * 1.e-7 # endif trn(ji,jj,jk,jpnh4) = trn(ji,jj,jk,jpnh4) + zfact trn(ji,jj,jk,jpoxy) = trn(ji,jj,jk,jpoxy) + zfact * o2nit trn(ji,jj,jk,jppo4) = trn(ji,jj,jk,jppo4) + 30./ 46.* zfact END DO END DO END DO #if defined key_diatrc zrfact2 = 1.e+3 * rfact2r # if ! defined key_iomput trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1) * zrfact2 * fse3t(:,:,1) * tmask(:,:,1) trc2d(:,:,jp_pcs0_2d + 12) = znitrpot(:,:,1) * 1.e-7 * zrfact2 * fse3t(:,:,1) * tmask(:,:,1) # else ! surface downward net flux of iron zw2d(:,:) = ( zirondep(:,:,1) + ironsed(:,:,1) * rfact2 ) * zrfact2 * fse3t(:,:,1) * tmask(:,:,1) IF( jnt == nrdttrc ) CALL iom_put( "Irondep", zw2d ) ! nitrogen fixation at surface zw2d(:,:) = znitrpot(:,:,1) * 1.e-7 * zrfact2 * fse3t(:,:,1) * tmask(:,:,1) IF( jnt == nrdttrc ) CALL iom_put( "Nfix" , zw2d ) # endif # endif ! IF(ln_ctl) THEN ! print mean trends (used for debugging) WRITE(charout, FMT="('sed ')") CALL prt_ctl_trc_info(charout) CALL prt_ctl_trc(tab4d=trn, mask=tmask, clinfo=ctrcnm) ENDIF END SUBROUTINE p4z_sed SUBROUTINE p4z_sbc(kt) !!---------------------------------------------------------------------- !! *** ROUTINE p4z_sbc *** !! !! ** Purpose : Read and interpolate the external sources of !! nutrients !! !! ** Method : Read the files and interpolate the appropriate variables !! !! ** input : external netcdf files !! !!---------------------------------------------------------------------- !! * arguments INTEGER, INTENT( in ) :: kt ! ocean time step !! * Local declarations INTEGER :: & imois, imois2, & ! temporary integers i15 , iman ! " " REAL(wp) :: & zxy ! " " !!--------------------------------------------------------------------- ! Initialization ! -------------- i15 = nday / 16 iman = INT( raamo ) imois = nmonth + i15 - 1 IF( imois == 0 ) imois = iman imois2 = nmonth ! 1. first call kt=nit000 ! ----------------------- IF( kt == nit000 ) THEN ! initializations nflx1 = 0 nflx11 = 0 ! open the file IF(lwp) THEN WRITE(numout,*) ' ' WRITE(numout,*) ' **** Routine p4z_sbc' ENDIF CALL iom_open ( 'dust.orca.nc', numdust ) ENDIF ! Read monthly file ! ---------------- IF( kt == nit000 .OR. imois /= nflx1 ) THEN ! Calendar computation ! nflx1 number of the first file record used in the simulation ! nflx2 number of the last file record nflx1 = imois nflx2 = nflx1+1 nflx1 = MOD( nflx1, iman ) nflx2 = MOD( nflx2, iman ) IF( nflx1 == 0 ) nflx1 = iman IF( nflx2 == 0 ) nflx2 = iman IF(lwp) WRITE(numout,*) 'first record file used nflx1 ',nflx1 IF(lwp) WRITE(numout,*) 'last record file used nflx2 ',nflx2 ! Read monthly fluxes data ! humidity CALL iom_get ( numdust, jpdom_data, 'dust', dustmo(:,:,1), nflx1 ) CALL iom_get ( numdust, jpdom_data, 'dust', dustmo(:,:,2), nflx2 ) ENDIF ! 3. at every time step interpolation of fluxes ! --------------------------------------------- zxy = FLOAT( nday + 15 - 30 * i15 ) / 30 dust(:,:) = ( (1.-zxy) * dustmo(:,:,1) + zxy * dustmo(:,:,2) ) IF( kt == nitend ) CALL iom_close (numdust) END SUBROUTINE p4z_sbc SUBROUTINE p4z_sed_init !!---------------------------------------------------------------------- !! *** ROUTINE p4z_sed_init *** !! !! ** Purpose : Initialization of the external sources of nutrients !! !! ** Method : Read the files and compute the budget !! called at the first timestep (nit000) !! !! ** input : external netcdf files !! !!---------------------------------------------------------------------- INTEGER :: ji, jj, jk, jm INTEGER , PARAMETER :: jpmois = 12, jpan = 1 INTEGER :: numriv, numbath, numdep REAL(wp) :: zcoef REAL(wp) :: expide, denitide,zmaskt REAL(wp) , DIMENSION (jpi,jpj) :: riverdoc, river, ndepo REAL(wp) , DIMENSION (jpi,jpj,jpk) :: cmask REAL(wp) , DIMENSION(jpi,jpj,12) :: zdustmo NAMELIST/nampissed/ ln_dustfer, ln_river, ln_ndepo, ln_sedinput, sedfeinput, dustsolub REWIND( numnat ) ! read numnat READ ( numnat, nampissed ) IF(lwp) THEN WRITE(numout,*) ' ' WRITE(numout,*) ' Namelist : nampissed ' WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~ ' WRITE(numout,*) ' Dust input from the atmosphere ln_dustfer = ', ln_dustfer WRITE(numout,*) ' River input of nutrients ln_river = ', ln_river WRITE(numout,*) ' Atmospheric deposition of N ln_ndepo = ', ln_ndepo WRITE(numout,*) ' Fe input from sediments ln_sedinput = ', ln_sedinput WRITE(numout,*) ' Coastal release of Iron sedfeinput =', sedfeinput WRITE(numout,*) ' Solubility of the dust dustsolub =', dustsolub ENDIF ! Dust input from the atmosphere ! ------------------------------ IF( ln_dustfer ) THEN IF(lwp) WRITE(numout,*) ' Initialize dust input from atmosphere ' IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' CALL iom_open ( 'dust.orca.nc', numdust ) DO jm = 1, jpmois CALL iom_get( numdust, jpdom_data, 'dust', zdustmo(:,:,jm), jm ) END DO CALL iom_close( numdust ) ELSE zdustmo(:,:,:) = 0.e0 dust(:,:) = 0.0 ENDIF ! Nutrient input from rivers ! -------------------------- IF( ln_river ) THEN IF(lwp) WRITE(numout,*) ' Initialize the nutrient input by rivers from river.orca.nc file' IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' CALL iom_open ( 'river.orca.nc', numriv ) CALL iom_get ( numriv, jpdom_data, 'riverdic', river (:,:), jpan ) CALL iom_get ( numriv, jpdom_data, 'riverdoc', riverdoc(:,:), jpan ) CALL iom_close( numriv ) ELSE river (:,:) = 0.e0 riverdoc(:,:) = 0.e0 endif ! Nutrient input from dust ! ------------------------ IF( ln_ndepo ) THEN IF(lwp) WRITE(numout,*) ' Initialize the nutrient input by dust from ndeposition.orca.nc' IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' CALL iom_open ( 'ndeposition.orca.nc', numdep ) CALL iom_get ( numdep, jpdom_data, 'ndep', ndepo(:,:), jpan ) CALL iom_close( numdep ) ELSE ndepo(:,:) = 0.e0 ENDIF ! Coastal and island masks ! ------------------------ IF( ln_sedinput ) THEN IF(lwp) WRITE(numout,*) ' Computation of an island mask to enhance coastal supply of iron' IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' IF(lwp) WRITE(numout,*) ' from bathy.orca.nc file ' CALL iom_open ( 'bathy.orca.nc', numbath ) CALL iom_get ( numbath, jpdom_data, 'bathy', cmask(:,:,:), jpan ) CALL iom_close( numbath ) ! DO jk = 1, 5 DO jj = 2, jpjm1 DO ji = fs_2, fs_jpim1 IF( tmask(ji,jj,jk) /= 0. ) THEN zmaskt = tmask(ji+1,jj,jk) * tmask(ji-1,jj,jk) * tmask(ji,jj+1,jk) & & * tmask(ji,jj-1,jk) * tmask(ji,jj,jk+1) IF( zmaskt == 0. ) cmask(ji,jj,jk ) = 0.1 ENDIF END DO END DO END DO DO jk = 1, jpk DO jj = 1, jpj DO ji = 1, jpi expide = MIN( 8.,( fsdept(ji,jj,jk) / 500. )**(-1.5) ) denitide = -0.9543 + 0.7662 * LOG( expide ) - 0.235 * LOG( expide )**2 cmask(ji,jj,jk) = cmask(ji,jj,jk) * MIN( 1., EXP( denitide ) / 0.5 ) END DO END DO END DO ELSE cmask(:,:,:) = 0.e0 ENDIF CALL lbc_lnk( cmask , 'T', 1. ) ! Lateral boundary conditions on cmask (sign unchanged) ! Number of seconds per year and per month ryyss = nyear_len(1) * rday rmtss = ryyss / raamo ! total atmospheric supply of Si ! ------------------------------ sumdepsi = 0.e0 DO jm = 1, jpmois DO jj = 2, jpjm1 DO ji = fs_2, fs_jpim1 sumdepsi = sumdepsi + zdustmo(ji,jj,jm) / (12.*rmtss) * 8.8 & & * 0.075/28.1 * e1t(ji,jj) * e2t(ji,jj) * tmask(ji,jj,1) * tmask_i(ji,jj) END DO END DO END DO IF( lk_mpp ) CALL mpp_sum( sumdepsi ) ! sum over the global domain ! N/P and Si releases due to coastal rivers ! ----------------------------------------- DO jj = 1, jpj DO ji = 1, jpi zcoef = ryyss * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1) * tmask(ji,jj,1) * tmask_i(ji,jj) cotdep(ji,jj) = river(ji,jj) *1E9 / ( 12. * zcoef + rtrn ) rivinp(ji,jj) = (river(ji,jj)+riverdoc(ji,jj)) *1E9 / ( 31.6* zcoef + rtrn ) nitdep(ji,jj) = 7.6 * ndepo(ji,jj) / ( 14E6*ryyss*fse3t(ji,jj,1) + rtrn ) END DO END DO ! Lateral boundary conditions on ( cotdep, rivinp, nitdep ) (sign unchanged) CALL lbc_lnk( cotdep , 'T', 1. ) ; CALL lbc_lnk( rivinp , 'T', 1. ) ; CALL lbc_lnk( nitdep , 'T', 1. ) rivpo4input = 0.e0 rivalkinput = 0.e0 nitdepinput = 0.e0 DO jj = 2 , jpjm1 DO ji = fs_2, fs_jpim1 zcoef = cvol(ji,jj,1) * ryyss rivpo4input = rivpo4input + rivinp(ji,jj) * zcoef rivalkinput = rivalkinput + cotdep(ji,jj) * zcoef nitdepinput = nitdepinput + nitdep(ji,jj) * zcoef END DO END DO IF( lk_mpp ) THEN CALL mpp_sum( rivpo4input ) ! sum over the global domain CALL mpp_sum( rivalkinput ) ! sum over the global domain CALL mpp_sum( nitdepinput ) ! sum over the global domain ENDIF ! Coastal supply of iron ! ------------------------- DO jk = 1, jpkm1 ironsed(:,:,jk) = sedfeinput * cmask(:,:,jk) / ( fse3t(:,:,jk) * rday ) END DO CALL lbc_lnk( ironsed , 'T', 1. ) ! Lateral boundary conditions on ( ironsed ) (sign unchanged) END SUBROUTINE p4z_sed_init #else !!====================================================================== !! Dummy module : No PISCES bio-model !!====================================================================== CONTAINS SUBROUTINE p4z_sed ! Empty routine END SUBROUTINE p4z_sed #endif !!====================================================================== END MODULE p4zsed