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 !!---------------------------------------------------------------------- USE oce_trc ! USE trp_trc USE sms USE lib_mpp USE prtctl_trc IMPLICIT NONE PRIVATE PUBLIC p4z_sed ! called in p4zprg.F90 !!* Substitution # include "domzgr_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) !! $Header:$ !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- CONTAINS SUBROUTINE p4z_sed !!--------------------------------------------------------------------- !! *** 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 :: ji, jj, jk INTEGER :: ikt REAL(wp) :: zsumsedsi, zsumsedpo4, zsumsedcal REAL(wp) :: zconctmp , zdenitot , znitrpottot REAL(wp) :: zlim, zconctmp2, zstep, zfact REAL(wp), DIMENSION(jpi,jpj) :: zsidep REAL(wp), DIMENSION(jpi,jpj,jpk) :: znitrpot, zirondep CHARACTER (len=25) :: charout !!--------------------------------------------------------------------- zstep = rfact2 / rjjss ! Time step duration for the biology 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) = ( 0.014 * dust(ji,jj) / ( 55.85 * rmoss ) + 3.e-10 / raass ) & & * rfact2 / fse3t(ji,jj,1) zsidep (ji,jj) = 8.8 * 0.075 * dust(ji,jj) * rfact2 / ( fse3t(ji,jj,1) * 28.1 * rmoss ) END DO END DO ! Iron solubilization of particles in the water column ! ---------------------------------------------------- DO jk = 2, jpkm1 DO jj = 1, jpj DO ji = 1, jpi zirondep(ji,jj,jk) = dust(ji,jj) / ( 10. * 55.85 * rmoss ) * rfact2 * 0.0001 END DO END DO END DO ! Add the external input of nutrients, carbon and alkalinity ! ---------------------------------------------------------- DO jj = 1, jpj DO ji = 1, jpi trn(ji,jj,1,jppo4) = trn(ji,jj,1,jppo4) + rivinp(ji,jj) * rfact2 trn(ji,jj,1,jpno3) = trn(ji,jj,1,jpno3) + ( rivinp(ji,jj) + nitdep(ji,jj) ) * rfact2 trn(ji,jj,1,jpfer) = trn(ji,jj,1,jpfer) + rivinp(ji,jj) * 3.e-5 * rfact2 trn(ji,jj,1,jpsil) = trn(ji,jj,1,jpsil) + zsidep (ji,jj) + cotdep(ji,jj) * rfact2 / 6. trn(ji,jj,1,jpdic) = trn(ji,jj,1,jpdic) + rivinp(ji,jj) * 2.631 * rfact2 trn(ji,jj,1,jptal) = trn(ji,jj,1,jptal) + ( cotdep(ji,jj) - rno3*(rivinp(ji,jj) & & + nitdep(ji,jj) ) ) * rfact2 END DO END DO ! Add the external input of iron which is 3D distributed ! (dust, river and sediment mobilization) ! ------------------------------------------------------ DO jk = 1, jpkm1 DO jj = 1, jpj DO ji = 1, jpi trn(ji,jj,jk,jpfer) = trn(ji,jj,jk,jpfer) & & + zirondep(ji,jj,jk) + ironsed(ji,jj,jk) * rfact2 END DO END DO END DO ! 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) / rjjss * tmask_i(ji,jj) # if ! defined key_kriest zsumsedsi = zsumsedsi + zfact * trn(ji,jj,ikt,jpdsi) * wsbio4(ji,jj,ikt) # else zsumsedsi = zsumsedsi + zfact * trn(ji,jj,ikt,jpdsi) * wscal (ji,jj,ikt) # endif zsumsedcal = zsumsedcal + zfact * trn(ji,jj,ikt,jpcal) * wscal (ji,jj,ikt) * 2.e0 # if defined key_kriest zsumsedpo4 = zsumsedpo4 + zfact * trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt) # else zsumsedpo4 = zsumsedpo4 + zfact *( trn(ji,jj,ikt,jpgoc) * wsbio4(ji,jj,ikt) & & + trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt) ) # endif 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 ! 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 ) zconctmp = trn(ji,jj,ikt,jpdsi) * zstep / fse3t(ji,jj,ikt) & # if ! defined key_kriest & * wsbio4(ji,jj,ikt) # else & * wscal (ji,jj,ikt) # endif trn(ji,jj,ikt,jpdsi) = trn(ji,jj,ikt,jpdsi) - zconctmp trn(ji,jj,ikt,jpsil) = trn(ji,jj,ikt,jpsil) + zconctmp & & * ( 1.- ( sumdepsi + rivalkinput / raass / 6. ) / zsumsedsi ) 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) * zstep / fse3t(ji,jj,ikt) trn(ji,jj,ikt,jpcal) = trn(ji,jj,ikt,jpcal) - zconctmp trn(ji,jj,ikt,jptal) = trn(ji,jj,ikt,jptal) + zconctmp & & * ( 1.- ( rivalkinput / raass ) / zsumsedcal ) * 2.e0 trn(ji,jj,ikt,jpdic) = trn(ji,jj,ikt,jpdic) + zconctmp & & * ( 1.- ( rivalkinput / raass ) / zsumsedcal ) END DO END DO DO jj = 1, jpj DO ji = 1, jpi ikt = MAX( mbathy(ji,jj) - 1, 1 ) # 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) * zstep / fse3t(ji,jj,ikt) trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) - zconctmp2 * wsbio3(ji,jj,ikt) * zstep / fse3t(ji,jj,ikt) trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc) & & + ( zconctmp * wsbio4(ji,jj,ikt) + zconctmp2 * wsbio3(ji,jj,ikt) ) * zstep / fse3t(ji,jj,ikt) & & * ( 1.- rivpo4input / (raass * zsumsedpo4 ) ) trn(ji,jj,ikt,jpbfe) = trn(ji,jj,ikt,jpbfe) - trn(ji,jj,ikt,jpbfe) * wsbio4(ji,jj,ikt) * zstep & & /fse3t(ji,jj,ikt) trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) - trn(ji,jj,ikt,jpsfe) * wsbio3(ji,jj,ikt) * zstep & & /fse3t(ji,jj,ikt) # 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) * zstep / fse3t(ji,jj,ikt) trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) & & - zconctmp2 * wsbio3(ji,jj,ikt) * zstep / fse3t(ji,jj,ikt) trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc) & & + ( zconctmp2 * wsbio3(ji,jj,ikt) ) & & * zstep / fse3t(ji,jj,ikt) * ( 1.- rivpo4input / ( raass * zsumsedpo4 ) ) trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) & & - trn(ji,jj,ikt,jpsfe) * wsbio3(ji,jj,ikt) * zstep / fse3t(ji,jj,ikt) # endif END DO END DO ! Nitrogen fixation (simple parameterization). The total gain ! from nitrogen fixation is scaled to balance the loss by ! denitrification ! ------------------------------------------------------------- !!gm optimisation : use fs do loop index... or 1 to jpi/j zdenitot = 0.e0 DO jk = 1, jpkm1 DO jj= 2, jpjm1 DO ji = 2, jpim1 zdenitot = zdenitot + denitr(ji,jj,jk) * rdenit * e1t(ji,jj) * e2t(ji,jj) & & *fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) * xnegtr(ji,jj,jk) END DO END DO END DO IF( lk_mpp ) CALL mpp_sum( zdenitot ) ! sum over the global domain ! Potential nitrogen fication 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 ) / rjjss ) & # if defined key_off_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) * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) & & * tmask(ji,jj,jk) * tmask_i(ji,jj) 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_cfg_1d && ( 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_trc_diaadd DO jj = 1,jpj DO ji = 1,jpi trc2d(ji,jj,13) = znitrpot(ji,jj,1) * 1.e-7 * fse3t(ji,jj,1) * 1.e+3 / rfact2 trc2d(ji,jj,12) = zirondep(ji,jj,1) * 1.e+3 * rfact2r * fse3t(ji,jj,1) END DO END DO # 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 #else !!====================================================================== !! Dummy module : No PISCES bio-model !!====================================================================== CONTAINS SUBROUTINE p4z_sed ! Empty routine END SUBROUTINE p4z_sed #endif !!====================================================================== END MODULE p4zsed