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.
p4zagg.F90 in NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/P4Z – NEMO

source: NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/P4Z/p4zagg.F90 @ 13463

Last change on this file since 13463 was 13463, checked in by andmirek, 4 years ago

Ticket #2195:update to trunk 13461
  • Property svn:keywords set to Id
File size: 8.8 KB
RevLine 
[7162]1MODULE p4zagg
2   !!======================================================================
3   !!                         ***  MODULE p4zagg  ***
4   !! TOP :  PISCES  aggregation of particles
5   !!======================================================================
6   !! History :   1.0  !  2004     (O. Aumont) Original code
7   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
8   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Change aggregation formula
9   !!             3.5  !  2012-07  (O. Aumont) Introduce potential time-splitting
[7176]10   !!             3.6  !  2015-05  (O. Aumont) PISCES quota
[7162]11   !!----------------------------------------------------------------------
[9124]12
[7162]13   !!----------------------------------------------------------------------
14   !!   p4z_agg       :  Compute aggregation of particles
15   !!----------------------------------------------------------------------
16   USE oce_trc         !  shared variables between ocean and passive tracers
17   USE trc             !  passive tracers common variables
18   USE sms_pisces      !  PISCES Source Minus Sink variables
[13463]19   USE prtctl          !  print control for debugging
[7162]20
21   IMPLICIT NONE
22   PRIVATE
23
24   PUBLIC   p4z_agg         ! called in p4zbio.F90
25
[13463]26   !! * Substitutions
27#  include "do_loop_substitute.h90"
[7162]28   !!----------------------------------------------------------------------
[10067]29   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
[10069]30   !! $Id$
[10068]31   !! Software governed by the CeCILL license (see ./LICENSE)
[7162]32   !!----------------------------------------------------------------------
33CONTAINS
34
[13463]35   SUBROUTINE p4z_agg ( kt, knt, Kbb, Krhs )
[7162]36      !!---------------------------------------------------------------------
37      !!                     ***  ROUTINE p4z_agg  ***
38      !!
39      !! ** Purpose :   Compute aggregation of particles
40      !!
41      !! ** Method  : - ???
42      !!---------------------------------------------------------------------
[9124]43      INTEGER, INTENT(in) ::   kt, knt   !
[13463]44      INTEGER, INTENT(in) ::   Kbb, Krhs ! time level indices
[9124]45      !
[7162]46      INTEGER  ::   ji, jj, jk
[7176]47      REAL(wp) ::   zagg, zagg1, zagg2, zagg3, zagg4
48      REAL(wp) ::   zaggpoc1, zaggpoc2, zaggpoc3, zaggpoc4
49      REAL(wp) ::   zaggpoc , zaggfe, zaggdoc, zaggdoc2, zaggdoc3
50      REAL(wp) ::   zaggpon , zaggdon, zaggdon2, zaggdon3
51      REAL(wp) ::   zaggpop, zaggdop, zaggdop2, zaggdop3
52      REAL(wp) ::   zaggtmp, zfact, zmax
[7162]53      CHARACTER (len=25) :: charout
54      !!---------------------------------------------------------------------
55      !
[9124]56      IF( ln_timing )   CALL timing_start('p4z_agg')
[7162]57      !
58      !  Exchange between organic matter compartments due to coagulation/disaggregation
59      !  ---------------------------------------------------
[7176]60      IF( ln_p4z ) THEN
61         !
[13463]62         DO_3D( 1, 1, 1, 1, 1, jpkm1 )
63            !
64            zfact = xstep * xdiss(ji,jj,jk)
65            !  Part I : Coagulation dependent on turbulence
66            zagg1 = 25.9  * zfact * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jppoc,Kbb)
67            zagg2 = 4452. * zfact * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jpgoc,Kbb)
[7162]68
[13463]69            ! Part II : Differential settling
[7162]70
[13463]71            !  Aggregation of small into large particles
72            zagg3 =  47.1 * xstep * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jpgoc,Kbb)
73            zagg4 =  3.3  * xstep * tr(ji,jj,jk,jppoc,Kbb) * tr(ji,jj,jk,jppoc,Kbb)
[7162]74
[13463]75            zagg   = zagg1 + zagg2 + zagg3 + zagg4
76            zaggfe = zagg * tr(ji,jj,jk,jpsfe,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn )
[7162]77
[13463]78            ! Aggregation of DOC to POC :
79            ! 1st term is shear aggregation of DOC-DOC
80            ! 2nd term is shear aggregation of DOC-POC
81            ! 3rd term is differential settling of DOC-POC
82            zaggdoc  = ( ( 0.369 * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) + 102.4 * tr(ji,jj,jk,jppoc,Kbb) ) * zfact       &
83            &            + 2.4 * xstep * tr(ji,jj,jk,jppoc,Kbb) ) * 0.3 * tr(ji,jj,jk,jpdoc,Kbb)
84            ! transfer of DOC to GOC :
85            ! 1st term is shear aggregation
86            ! 2nd term is differential settling
87            zaggdoc2 = ( 3.53E3 * zfact + 0.1 * xstep ) * tr(ji,jj,jk,jpgoc,Kbb) * 0.3 * tr(ji,jj,jk,jpdoc,Kbb)
88            ! tranfer of DOC to POC due to brownian motion
89            zaggdoc3 =  114. * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) *xstep * 0.3 * tr(ji,jj,jk,jpdoc,Kbb)
[7162]90
[13463]91            !  Update the trends
92            tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zagg + zaggdoc + zaggdoc3
93            tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zagg + zaggdoc2
94            tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zaggfe
95            tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zaggfe
96            tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) - zaggdoc - zaggdoc2 - zaggdoc3
97            !
98            conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zagg + zaggdoc + zaggdoc3
99            prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zagg + zaggdoc2
100            !
101         END_3D
[7176]102      ELSE    ! ln_p5z
103        !
[13463]104         DO_3D( 1, 1, 1, 1, 1, jpkm1 )
105            !
106            zfact = xstep * xdiss(ji,jj,jk)
107            !  Part I : Coagulation dependent on turbulence
108            zaggtmp = 25.9  * zfact * tr(ji,jj,jk,jppoc,Kbb)
109            zaggpoc1 = zaggtmp * tr(ji,jj,jk,jppoc,Kbb)
110            zaggtmp = 4452. * zfact * tr(ji,jj,jk,jpgoc,Kbb)
111            zaggpoc2 = zaggtmp * tr(ji,jj,jk,jppoc,Kbb)
[7176]112
[13463]113            ! Part II : Differential settling
[7176]114
[13463]115            !  Aggregation of small into large particles
116            zaggtmp =  47.1 * xstep * tr(ji,jj,jk,jpgoc,Kbb)
117            zaggpoc3 = zaggtmp * tr(ji,jj,jk,jppoc,Kbb)
118            zaggtmp =  3.3  * xstep * tr(ji,jj,jk,jppoc,Kbb)
119            zaggpoc4 = zaggtmp * tr(ji,jj,jk,jppoc,Kbb)
[7176]120
[13463]121            zaggpoc   = zaggpoc1 + zaggpoc2 + zaggpoc3 + zaggpoc4
122            zaggpon = zaggpoc * tr(ji,jj,jk,jppon,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn)
123            zaggpop = zaggpoc * tr(ji,jj,jk,jppop,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn)
124            zaggfe = zaggpoc * tr(ji,jj,jk,jpsfe,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb)  + rtrn )
[7176]125
[13463]126            ! Aggregation of DOC to POC :
127            ! 1st term is shear aggregation of DOC-DOC
128            ! 2nd term is shear aggregation of DOC-POC
129            ! 3rd term is differential settling of DOC-POC
130            zaggtmp = ( ( 0.369 * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) + 102.4 * tr(ji,jj,jk,jppoc,Kbb) ) * zfact       &
131            &            + 2.4 * xstep * tr(ji,jj,jk,jppoc,Kbb) )
132            zaggdoc  = zaggtmp * 0.3 * tr(ji,jj,jk,jpdoc,Kbb)
133            zaggdon  = zaggtmp * 0.3 * tr(ji,jj,jk,jpdon,Kbb)
134            zaggdop  = zaggtmp * 0.3 * tr(ji,jj,jk,jpdop,Kbb)
[7176]135
[13463]136            ! transfer of DOC to GOC :
137            ! 1st term is shear aggregation
138            ! 2nd term is differential settling
139            zaggtmp = ( 3.53E3 * zfact + 0.1 * xstep ) * tr(ji,jj,jk,jpgoc,Kbb)
140            zaggdoc2 = zaggtmp * 0.3 * tr(ji,jj,jk,jpdoc,Kbb)
141            zaggdon2 = zaggtmp * 0.3 * tr(ji,jj,jk,jpdon,Kbb)
142            zaggdop2 = zaggtmp * 0.3 * tr(ji,jj,jk,jpdop,Kbb)
[7176]143
[13463]144            ! tranfer of DOC to POC due to brownian motion
145            zaggtmp = ( 114. * 0.3 * tr(ji,jj,jk,jpdoc,Kbb) ) * xstep
146            zaggdoc3 =  zaggtmp * 0.3 * tr(ji,jj,jk,jpdoc,Kbb)
147            zaggdon3 =  zaggtmp * 0.3 * tr(ji,jj,jk,jpdon,Kbb)
148            zaggdop3 =  zaggtmp * 0.3 * tr(ji,jj,jk,jpdop,Kbb)
149
150            !  Update the trends
151            tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) - zaggpoc + zaggdoc + zaggdoc3
152            tr(ji,jj,jk,jppon,Krhs) = tr(ji,jj,jk,jppon,Krhs) - zaggpon + zaggdon + zaggdon3
153            tr(ji,jj,jk,jppop,Krhs) = tr(ji,jj,jk,jppop,Krhs) - zaggpop + zaggdop + zaggdop3
154            tr(ji,jj,jk,jpgoc,Krhs) = tr(ji,jj,jk,jpgoc,Krhs) + zaggpoc + zaggdoc2
155            tr(ji,jj,jk,jpgon,Krhs) = tr(ji,jj,jk,jpgon,Krhs) + zaggpon + zaggdon2
156            tr(ji,jj,jk,jpgop,Krhs) = tr(ji,jj,jk,jpgop,Krhs) + zaggpop + zaggdop2
157            tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) - zaggfe
158            tr(ji,jj,jk,jpbfe,Krhs) = tr(ji,jj,jk,jpbfe,Krhs) + zaggfe
159            tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) - zaggdoc - zaggdoc2 - zaggdoc3
160            tr(ji,jj,jk,jpdon,Krhs) = tr(ji,jj,jk,jpdon,Krhs) - zaggdon - zaggdon2 - zaggdon3
161            tr(ji,jj,jk,jpdop,Krhs) = tr(ji,jj,jk,jpdop,Krhs) - zaggdop - zaggdop2 - zaggdop3
162            !
163            conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zaggpoc + zaggdoc + zaggdoc3
164            prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zaggpoc + zaggdoc2
165            !
166         END_3D
[7176]167         !
168      ENDIF
[7162]169      !
[13463]170      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging)
[7162]171         WRITE(charout, FMT="('agg')")
[13463]172         CALL prt_ctl_info( charout, cdcomp = 'top' )
173         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm)
[7162]174      ENDIF
175      !
[9124]176      IF( ln_timing )   CALL timing_stop('p4z_agg')
[7162]177      !
178   END SUBROUTINE p4z_agg
179
180   !!======================================================================
181END MODULE p4zagg
Note: See TracBrowser for help on using the repository browser.