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_r11708_aumont_PISCES_QUOTA/src/TOP/PISCES/P4Z – NEMO

source: NEMO/branches/2019/dev_r11708_aumont_PISCES_QUOTA/src/TOP/PISCES/P4Z/p4zagg.F90 @ 13233

Last change on this file since 13233 was 13233, checked in by aumont, 4 years ago

update of the PISCES comments
  • Property svn:keywords set to Id
File size: 10.4 KB
RevLine 
[7162]1MODULE p4zagg
2   !!======================================================================
3   !!                         ***  MODULE p4zagg  ***
[12537]4   !! TOP :  PISCES  aggregation of particles (DOC, POC, GOC)
5   !!        This module is the same for both PISCES and PISCES-QUOTA
[7162]6   !!======================================================================
7   !! History :   1.0  !  2004     (O. Aumont) Original code
8   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
9   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Change aggregation formula
10   !!             3.5  !  2012-07  (O. Aumont) Introduce potential time-splitting
[7176]11   !!             3.6  !  2015-05  (O. Aumont) PISCES quota
[7162]12   !!----------------------------------------------------------------------
[9124]13
[7162]14   !!----------------------------------------------------------------------
15   !!   p4z_agg       :  Compute aggregation of particles
16   !!----------------------------------------------------------------------
17   USE oce_trc         !  shared variables between ocean and passive tracers
18   USE trc             !  passive tracers common variables
19   USE sms_pisces      !  PISCES Source Minus Sink variables
20   USE prtctl_trc      !  print control for debugging
21
22   IMPLICIT NONE
23   PRIVATE
24
25   PUBLIC   p4z_agg         ! called in p4zbio.F90
26
27   !!----------------------------------------------------------------------
[10067]28   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
[10069]29   !! $Id$
[10068]30   !! Software governed by the CeCILL license (see ./LICENSE)
[7162]31   !!----------------------------------------------------------------------
32CONTAINS
33
34   SUBROUTINE p4z_agg ( kt, knt )
35      !!---------------------------------------------------------------------
36      !!                     ***  ROUTINE p4z_agg  ***
37      !!
[12537]38      !! ** Purpose :   Compute aggregation of particle. Aggregation by
39      !!                brownian motion, differential settling and shear
40      !!                are considered.
[7162]41      !!
[12537]42      !! ** Method  : - Aggregation rates are computed assuming a fixed and
43      !!                constant size spectrum in the different particulate
44      !!                pools. The coagulation rates have been computed
45      !!                externally using dedicated programs (O. Aumont). They
46      !!                are hard-coded because they can't be changed
47      !!                independently of each other.
[7162]48      !!---------------------------------------------------------------------
[9124]49      INTEGER, INTENT(in) ::   kt, knt   !
50      !
[7162]51      INTEGER  ::   ji, jj, jk
[7176]52      REAL(wp) ::   zagg, zagg1, zagg2, zagg3, zagg4
53      REAL(wp) ::   zaggpoc1, zaggpoc2, zaggpoc3, zaggpoc4
54      REAL(wp) ::   zaggpoc , zaggfe, zaggdoc, zaggdoc2, zaggdoc3
55      REAL(wp) ::   zaggpon , zaggdon, zaggdon2, zaggdon3
56      REAL(wp) ::   zaggpop, zaggdop, zaggdop2, zaggdop3
57      REAL(wp) ::   zaggtmp, zfact, zmax
[7162]58      CHARACTER (len=25) :: charout
59      !!---------------------------------------------------------------------
60      !
[9124]61      IF( ln_timing )   CALL timing_start('p4z_agg')
[7162]62      !
[12537]63      !  Exchange between organic matter compartments due to
64      !  coagulation/disaggregation
[7162]65      !  ---------------------------------------------------
[12537]66
67      ! PISCES part
[7176]68      IF( ln_p4z ) THEN
69         !
70         DO jk = 1, jpkm1
71            DO jj = 1, jpj
72               DO ji = 1, jpi
73                  !
74                  zfact = xstep * xdiss(ji,jj,jk)
[12537]75                  ! Part I : Coagulation dependent on turbulence
76                  ! The stickiness has been assumed to be 0.1
[7176]77                  zagg1 = 25.9  * zfact * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jppoc)
78                  zagg2 = 4452. * zfact * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpgoc)
[7162]79
[7176]80                  ! Part II : Differential settling
[12537]81                  ! Aggregation of small into large particles
82                  ! The stickiness has been assumed to be 0.1
[7176]83                  zagg3 =  47.1 * xstep * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpgoc)
84                  zagg4 =  3.3  * xstep * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jppoc)
[7162]85
[7176]86                  zagg   = zagg1 + zagg2 + zagg3 + zagg4
87                  zaggfe = zagg * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn )
[7162]88
[7176]89                  ! Aggregation of DOC to POC :
90                  ! 1st term is shear aggregation of DOC-DOC
91                  ! 2nd term is shear aggregation of DOC-POC
92                  ! 3rd term is differential settling of DOC-POC
[12537]93                  ! 1/3 of DOC is supposed to experience aggregation (HMW)
[7176]94                  zaggdoc  = ( ( 0.369 * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4 * trb(ji,jj,jk,jppoc) ) * zfact       &
95                  &            + 2.4 * xstep * trb(ji,jj,jk,jppoc) ) * 0.3 * trb(ji,jj,jk,jpdoc)
96                  ! transfer of DOC to GOC :
97                  ! 1st term is shear aggregation
98                  ! 2nd term is differential settling
[12537]99                  ! 1/3 of DOC is supposed to experience aggregation (HMW)
[7176]100                  zaggdoc2 = ( 3.53E3 * zfact + 0.1 * xstep ) * trb(ji,jj,jk,jpgoc) * 0.3 * trb(ji,jj,jk,jpdoc)
101                  ! tranfer of DOC to POC due to brownian motion
[13233]102                  ! The temperature dependency has been omitted.
[7176]103                  zaggdoc3 =  114. * 0.3 * trb(ji,jj,jk,jpdoc) *xstep * 0.3 * trb(ji,jj,jk,jpdoc)
[7162]104
[7176]105                  !  Update the trends
106                  tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zagg + zaggdoc + zaggdoc3
107                  tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zagg + zaggdoc2
108                  tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zaggfe
109                  tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zaggfe
110                  tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc - zaggdoc2 - zaggdoc3
111                  !
112                  conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zagg + zaggdoc + zaggdoc3
113                  prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zagg + zaggdoc2
114                  !
115               END DO
[7162]116            END DO
117         END DO
[7176]118      ELSE    ! ln_p5z
119        !
[12537]120        ! PISCES-QUOTA part
[7176]121         DO jk = 1, jpkm1
122            DO jj = 1, jpj
123               DO ji = 1, jpi
124                  !
125                  zfact = xstep * xdiss(ji,jj,jk)
[13233]126                  ! Part I : Coagulation dependent on turbulence
[12537]127                  ! The stickiness has been assumed to be 0.1
[7176]128                  zaggtmp = 25.9  * zfact * trb(ji,jj,jk,jppoc)
129                  zaggpoc1 = zaggtmp * trb(ji,jj,jk,jppoc)
130                  zaggtmp = 4452. * zfact * trb(ji,jj,jk,jpgoc)
131                  zaggpoc2 = zaggtmp * trb(ji,jj,jk,jppoc)
132
133                  ! Part II : Differential settling
[12537]134                  ! The stickiness has been assumed to be 0.1
[7176]135   
136                  !  Aggregation of small into large particles
137                  zaggtmp =  47.1 * xstep * trb(ji,jj,jk,jpgoc)
138                  zaggpoc3 = zaggtmp * trb(ji,jj,jk,jppoc)
139                  zaggtmp =  3.3  * xstep * trb(ji,jj,jk,jppoc)
140                  zaggpoc4 = zaggtmp * trb(ji,jj,jk,jppoc)
141
142                  zaggpoc   = zaggpoc1 + zaggpoc2 + zaggpoc3 + zaggpoc4
143                  zaggpon = zaggpoc * trb(ji,jj,jk,jppon) / ( trb(ji,jj,jk,jppoc) + rtrn)
144                  zaggpop = zaggpoc * trb(ji,jj,jk,jppop) / ( trb(ji,jj,jk,jppoc) + rtrn)
145                  zaggfe = zaggpoc * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc)  + rtrn )
146
147                  ! Aggregation of DOC to POC :
148                  ! 1st term is shear aggregation of DOC-DOC
149                  ! 2nd term is shear aggregation of DOC-POC
150                  ! 3rd term is differential settling of DOC-POC
[12537]151                  ! 1/3 of DOC is supposed to experience aggregation (HMW)
[7176]152                  zaggtmp = ( ( 0.369 * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4 * trb(ji,jj,jk,jppoc) ) * zfact       &
153                  &            + 2.4 * xstep * trb(ji,jj,jk,jppoc) )
154                  zaggdoc  = zaggtmp * 0.3 * trb(ji,jj,jk,jpdoc)
155                  zaggdon  = zaggtmp * 0.3 * trb(ji,jj,jk,jpdon)
156                  zaggdop  = zaggtmp * 0.3 * trb(ji,jj,jk,jpdop)
157
158                  ! transfer of DOC to GOC :
159                  ! 1st term is shear aggregation
160                  ! 2nd term is differential settling
[12537]161                  ! 1/3 of DOC is supposed to experience aggregation (HMW)
[7176]162                  zaggtmp = ( 3.53E3 * zfact + 0.1 * xstep ) * trb(ji,jj,jk,jpgoc)
163                  zaggdoc2 = zaggtmp * 0.3 * trb(ji,jj,jk,jpdoc)
164                  zaggdon2 = zaggtmp * 0.3 * trb(ji,jj,jk,jpdon)
165                  zaggdop2 = zaggtmp * 0.3 * trb(ji,jj,jk,jpdop)
166
167                  ! tranfer of DOC to POC due to brownian motion
[12537]168                  ! 1/3 of DOC is supposed to experience aggregation (HMW)
[7176]169                  zaggtmp = ( 114. * 0.3 * trb(ji,jj,jk,jpdoc) ) * xstep
170                  zaggdoc3 =  zaggtmp * 0.3 * trb(ji,jj,jk,jpdoc)
171                  zaggdon3 =  zaggtmp * 0.3 * trb(ji,jj,jk,jpdon)
172                  zaggdop3 =  zaggtmp * 0.3 * trb(ji,jj,jk,jpdop)
173
174                  !  Update the trends
175                  tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zaggpoc + zaggdoc + zaggdoc3
176                  tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) - zaggpon + zaggdon + zaggdon3
177                  tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) - zaggpop + zaggdop + zaggdop3
178                  tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zaggpoc + zaggdoc2
179                  tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) + zaggpon + zaggdon2
180                  tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) + zaggpop + zaggdop2
181                  tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zaggfe
182                  tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zaggfe
183                  tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc - zaggdoc2 - zaggdoc3
184                  tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) - zaggdon - zaggdon2 - zaggdon3
185                  tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) - zaggdop - zaggdop2 - zaggdop3
186                  !
187                  conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zaggpoc + zaggdoc + zaggdoc3
188                  prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zaggpoc + zaggdoc2
189                  !
190               END DO
191            END DO
192         END DO
193         !
194      ENDIF
[7162]195      !
196      IF(ln_ctl)   THEN  ! print mean trends (used for debugging)
197         WRITE(charout, FMT="('agg')")
198         CALL prt_ctl_trc_info(charout)
199         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
200      ENDIF
201      !
[9124]202      IF( ln_timing )   CALL timing_stop('p4z_agg')
[7162]203      !
204   END SUBROUTINE p4z_agg
205
206   !!======================================================================
207END MODULE p4zagg
Note: See TracBrowser for help on using the repository browser.