MODULE p5zagg !!====================================================================== !! *** MODULE p5zagg *** !! TOP : PISCES aggregation of particles !!====================================================================== !! History : 1.0 ! 2004 (O. Aumont) Original code !! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90 !! 3.4 ! 2011-06 (O. Aumont, C. Ethe) Change aggregation formula !! 3.5 ! 2012-07 (O. Aumont) Introduce potential time-splitting !! 3.6 ! 2015-05 (O. Aumont) PISCES quota !!---------------------------------------------------------------------- #if defined key_pisces_quota !!---------------------------------------------------------------------- !! p5z_agg : Compute aggregation of particles !!---------------------------------------------------------------------- USE oce_trc ! shared variables between ocean and passive tracers USE trc ! passive tracers common variables USE sms_pisces ! PISCES Source Minus Sink variables USE p5zsink ! PISCES sinking of particles USE prtctl_trc ! print control for debugging USE iom ! I/O manager USE lib_mpp IMPLICIT NONE PRIVATE PUBLIC p5z_agg ! called in p5zbio.F90 !!* Substitution # include "top_substitute.h90" !!---------------------------------------------------------------------- !! NEMO/TOP 3.3 , NEMO Consortium (2010) !! $Id: p4zsink.F90 3160 2011-11-20 14:27:18Z cetlod $ !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) !!---------------------------------------------------------------------- CONTAINS #if ! defined key_kriest !!---------------------------------------------------------------------- !! 'standard particles parameterisation' ??? !!---------------------------------------------------------------------- SUBROUTINE p5z_agg ( kt, knt ) !!--------------------------------------------------------------------- !! *** ROUTINE p5z_agg *** !! !! ** Purpose : Compute aggregation of particles !! !! ** Method : - ??? !!--------------------------------------------------------------------- INTEGER, INTENT(in) :: kt, knt INTEGER :: ji, jj, jk REAL(wp) :: zaggpoc1, zaggpoc2, zaggpoc3, zaggpoc4 REAL(wp) :: zaggpoc , zaggfe, zaggdoc, zaggdoc2, zaggdoc3 REAL(wp) :: zaggpon , zaggdon, zaggdon2, zaggdon3 REAL(wp) :: zaggpop, zaggdop, zaggdop2, zaggdop3 REAL(wp) :: zaggtmp, zfact, zmax, zstep CHARACTER (len=25) :: charout !!--------------------------------------------------------------------- ! IF( nn_timing == 1 ) CALL timing_start('p5z_agg') ! ! Exchange between organic matter compartments due to coagulation/disaggregation ! --------------------------------------------------- DO jk = 1, jpkm1 DO jj = 1, jpj DO ji = 1, jpi ! zstep = xstep # if defined key_degrad zstep = zstep * facvol(ji,jj,jk) # endif zfact = zstep * xdiss(ji,jj,jk) ! Part I : Coagulation dependent on turbulence zaggtmp = 25.9 * zfact * trb(ji,jj,jk,jppoc) zaggpoc1 = zaggtmp * trb(ji,jj,jk,jppoc) zaggtmp = 4452. * zfact * trb(ji,jj,jk,jpgoc) zaggpoc2 = zaggtmp * trb(ji,jj,jk,jppoc) ! Part II : Differential settling ! Aggregation of small into large particles zaggtmp = 47.1 * zstep * trb(ji,jj,jk,jpgoc) zaggpoc3 = zaggtmp * trb(ji,jj,jk,jppoc) zaggtmp = 3.3 * zstep * trb(ji,jj,jk,jppoc) zaggpoc4 = zaggtmp * trb(ji,jj,jk,jppoc) zaggpoc = zaggpoc1 + zaggpoc2 + zaggpoc3 + zaggpoc4 zaggpon = zaggpoc * trb(ji,jj,jk,jppon) / ( trb(ji,jj,jk,jppoc) + rtrn) zaggpop = zaggpoc * trb(ji,jj,jk,jppop) / ( trb(ji,jj,jk,jppoc) + rtrn) zaggfe = zaggpoc * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn ) ! Aggregation of DOC to POC : ! 1st term is shear aggregation of DOC-DOC ! 2nd term is shear aggregation of DOC-POC ! 3rd term is differential settling of DOC-POC zaggtmp = ( ( 0.369 * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4 * trb(ji,jj,jk,jppoc) ) * zfact & & + 2.4 * zstep * trb(ji,jj,jk,jppoc) ) zaggdoc = zaggtmp * 0.3 * trb(ji,jj,jk,jpdoc) zaggdon = zaggtmp * 0.3 * trb(ji,jj,jk,jpdon) zaggdop = zaggtmp * 0.3 * trb(ji,jj,jk,jpdop) ! transfer of DOC to GOC : ! 1st term is shear aggregation ! 2nd term is differential settling zaggtmp = ( 3.53E3 * zfact + 0.1 * zstep ) * trb(ji,jj,jk,jpgoc) zaggdoc2 = zaggtmp * 0.3 * trb(ji,jj,jk,jpdoc) zaggdon2 = zaggtmp * 0.3 * trb(ji,jj,jk,jpdon) zaggdop2 = zaggtmp * 0.3 * trb(ji,jj,jk,jpdop) ! tranfer of DOC to POC due to brownian motion zaggtmp = ( 114. * 0.3 * trb(ji,jj,jk,jpdoc) ) *zstep zaggdoc3 = zaggtmp * 0.3 * trb(ji,jj,jk,jpdoc) zaggdon3 = zaggtmp * 0.3 * trb(ji,jj,jk,jpdon) zaggdop3 = zaggtmp * 0.3 * trb(ji,jj,jk,jpdop) ! Update the trends tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zaggpoc + zaggdoc + zaggdoc3 tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) - zaggpon + zaggdon + zaggdon3 tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) - zaggpop + zaggdop + zaggdop3 tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zaggpoc + zaggdoc2 tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) + zaggpon + zaggdon2 tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) + zaggpop + zaggdop2 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zaggfe tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zaggfe tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc - zaggdoc2 - zaggdoc3 tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) - zaggdon - zaggdon2 - zaggdon3 tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) - zaggdop - zaggdop2 - zaggdop3 ! conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zaggpoc + zaggdoc + zaggdoc3 prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zaggpoc + zaggdoc2 ! END DO END DO END DO ! IF(ln_ctl) THEN ! print mean trends (used for debugging) WRITE(charout, FMT="('agg')") CALL prt_ctl_trc_info(charout) CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) ENDIF ! IF( nn_timing == 1 ) CALL timing_stop('p5z_agg') ! END SUBROUTINE p5z_agg #else !!---------------------------------------------------------------------- !! 'Kriest parameterisation' key_kriest ??? !!---------------------------------------------------------------------- SUBROUTINE p5z_agg ( kt, knt ) !!--------------------------------------------------------------------- !! *** ROUTINE p5z_agg *** !! !! ** Purpose : Compute aggregation of particles !! !! ** Method : - ??? !!--------------------------------------------------------------------- ! INTEGER, INTENT(in) :: kt, knt ! INTEGER :: ji, jj, jk REAL(wp) :: zagg1, zagg2, zagg3, zagg4, zagg5, zfract, zaggsi, zaggsh REAL(wp) :: zagg , zaggdoc, zaggdoc1, znumdoc REAL(wp) :: znum , zeps, zfm, zgm, zsm, zfactn, zfactp REAL(wp) :: zdiv , zdiv1, zdiv2, zdiv3, zdiv4, zdiv5 REAL(wp) :: zval1, zval2, zval3, zval4 CHARACTER (len=25) :: charout !!--------------------------------------------------------------------- ! IF( nn_timing == 1 ) CALL timing_start('p5z_agg') ! ! Exchange between organic matter compartments due to coagulation/disaggregation ! --------------------------------------------------- zval1 = 1. + xkr_zeta zval2 = 1. + xkr_eta zval3 = 3. + xkr_eta zval4 = 4. + xkr_eta DO jk = 1,jpkm1 DO jj = 1,jpj DO ji = 1,jpi IF( tmask(ji,jj,jk) /= 0.e0 ) THEN znum = trb(ji,jj,jk,jppoc)/(trb(ji,jj,jk,jpnum)+rtrn) / xkr_massp !-------------- To avoid sinking speed over 50 m/day ------- znum = min(xnumm(jk),znum) znum = MAX( 1.1,znum) !------------------------------------------------------------ zeps = ( zval1 * znum - 1.) / ( znum - 1.) zdiv = MAX( 1.e-4, ABS( zeps - zval3) ) * SIGN( 1., zeps - zval3 ) zdiv1 = MAX( 1.e-4, ABS( zeps - 4. ) ) * SIGN( 1., zeps - 4. ) zdiv2 = zeps - 2. zdiv3 = zeps - 3. zdiv4 = zeps - zval2 zdiv5 = 2.* zeps - zval4 zfm = xkr_frac**( 1.- zeps ) zsm = xkr_frac**xkr_eta ! Part I : Coagulation dependant on turbulence ! ---------------------------------------------- zagg1 = 0.163 * trb(ji,jj,jk,jpnum)**2 & & * 2.*( (zfm-1.)*(zfm*xkr_mass_max**3-xkr_mass_min**3) & & * (zeps-1)/zdiv1 + 3.*(zfm*xkr_mass_max-xkr_mass_min) & & * (zfm*xkr_mass_max**2-xkr_mass_min**2) & & * (zeps-1.)**2/(zdiv2*zdiv3)) zagg2 = 2*0.163*trb(ji,jj,jk,jpnum)**2*zfm & & * ((xkr_mass_max**3+3.*(xkr_mass_max**2 & & * xkr_mass_min*(zeps-1.)/zdiv2 & & + xkr_mass_max*xkr_mass_min**2*(zeps-1.)/zdiv3) & & + xkr_mass_min**3*(zeps-1)/zdiv1) & & - zfm*xkr_mass_max**3*(1.+3.*((zeps-1.) & & / (zeps-2.)+(zeps-1.)/zdiv3)+(zeps-1.)/zdiv1)) zagg3 = 0.163*trb(ji,jj,jk,jpnum)**2*zfm**2*8. * xkr_mass_max**3 ! Aggregation of small into large particles ! Part II : Differential settling ! ---------------------------------------------- zagg4 = 2.*3.141*0.125*trb(ji,jj,jk,jpnum)**2* & & xkr_wsbio_min*(zeps-1.)**2 & & *(xkr_mass_min**2*((1.-zsm*zfm)/(zdiv3*zdiv4) & & -(1.-zfm)/(zdiv*(zeps-1.)))- & & ((zfm*zfm*xkr_mass_max**2*zsm-xkr_mass_min**2) & & *xkr_eta)/(zdiv*zdiv3*zdiv5) ) zagg5 = 2.*3.141*0.125*trb(ji,jj,jk,jpnum)**2 & & *(zeps-1.)*zfm*xkr_wsbio_min & & *(zsm*(xkr_mass_min**2-zfm*xkr_mass_max**2) & & /zdiv3-(xkr_mass_min**2-zfm*zsm*xkr_mass_max**2) & & /zdiv) ! ! Fractionnation by swimming organisms ! ------------------------------------ zfract = 2.*3.141*0.125*trb(ji,jj,jk,jpmes)*12./0.12/0.06**3*trb(ji,jj,jk,jpnum) & & * (0.01/xkr_mass_min)**(1.-zeps)*0.1**2 & & * 10000.*xstep ! Aggregation of DOC to small particles ! -------------------------------------- zaggdoc = 0.83 * trb(ji,jj,jk,jpdoc) * xstep * xdiss(ji,jj,jk) * trb(ji,jj,jk,jpdoc) & & + 0.005 * 231. * trb(ji,jj,jk,jpdoc) * xstep * trb(ji,jj,jk,jpdoc) zaggdoc1 = 271. * trb(ji,jj,jk,jppoc) * xstep * xdiss(ji,jj,jk) * trb(ji,jj,jk,jpdoc) & & + 0.02 * 16706. * trb(ji,jj,jk,jppoc) * xstep * trb(ji,jj,jk,jpdoc) # if defined key_degrad zagg1 = zagg1 * facvol(ji,jj,jk) zagg2 = zagg2 * facvol(ji,jj,jk) zagg3 = zagg3 * facvol(ji,jj,jk) zagg4 = zagg4 * facvol(ji,jj,jk) zagg5 = zagg5 * facvol(ji,jj,jk) zaggdoc = zaggdoc * facvol(ji,jj,jk) zaggdoc1 = zaggdoc1 * facvol(ji,jj,jk) # endif zaggsh = ( zagg1 + zagg2 + zagg3 ) * rfact2 * xdiss(ji,jj,jk) / 1000. zaggsi = ( zagg4 + zagg5 ) * xstep / 10. zagg = 0.5 * xkr_stick * ( zaggsh + zaggsi ) ! znumdoc = trb(ji,jj,jk,jpnum) / ( trb(ji,jj,jk,jppoc) + rtrn ) tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zaggdoc + zaggdoc1 zfactn = trb(ji,jj,jk,jpdon) / ( trb(ji,jj,jk,jpdoc) + rtrn ) tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + ( zaggdoc + zaggdoc1 ) * zfactn zfactp = trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdoc) + rtrn ) tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + ( zaggdoc + zaggdoc1 ) * zfactp tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zfract + zaggdoc / xkr_massp - zagg tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc - zaggdoc1 ENDIF END DO END DO END DO ! IF(ln_ctl) THEN ! print mean trends (used for debugging) WRITE(charout, FMT="('agg')") CALL prt_ctl_trc_info(charout) CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) ENDIF ! CALL wrk_dealloc( jpi, jpj, jpk, znum3d ) ! IF( nn_timing == 1 ) CALL timing_stop('p5z_agg') ! END SUBROUTINE p5z_agg #endif #else !!====================================================================== !! Dummy module : No PISCES bio-model !!====================================================================== CONTAINS SUBROUTINE p5z_agg ! Empty routine END SUBROUTINE p5z_agg #endif !!====================================================================== END MODULE p5zagg