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

source: NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P4Z/p4zagg.F90 @ 12340

Last change on this file since 12340 was 12340, checked in by acc, 4 years ago

Branch 2019/dev_r11943_MERGE_2019. This commit introduces basic do loop macro
substitution to the 2019 option 1, merge branch. These changes have been SETTE
tested. The only addition is the do_loop_substitute.h90 file in the OCE directory but
the macros defined therein are used throughout the code to replace identifiable, 2D-
and 3D- nested loop opening and closing statements with single-line alternatives. Code
indents are also adjusted accordingly.

The following explanation is taken from comments in the new header file:

This header file contains preprocessor definitions and macros used in the do-loop
substitutions introduced between version 4.0 and 4.2. The primary aim of these macros
is to assist in future applications of tiling to improve performance. This is expected
to be achieved by alternative versions of these macros in selected locations. The
initial introduction of these macros simply replaces all identifiable nested 2D- and
3D-loops with single line statements (and adjusts indenting accordingly). Do loops
are identifiable if they comform to either:

DO jk = ....

DO jj = .... DO jj = ...

DO ji = .... DO ji = ...
. OR .
. .

END DO END DO

END DO END DO

END DO

and white-space variants thereof.

Additionally, only loops with recognised jj and ji loops limits are treated; these are:
Lower limits of 1, 2 or fs_2
Upper limits of jpi, jpim1 or fs_jpim1 (for ji) or jpj, jpjm1 or fs_jpjm1 (for jj)

The macro naming convention takes the form: DO_2D_BT_LR where:

B is the Bottom offset from the PE's inner domain;
T is the Top offset from the PE's inner domain;
L is the Left offset from the PE's inner domain;
R is the Right offset from the PE's inner domain

So, given an inner domain of 2,jpim1 and 2,jpjm1, a typical example would replace:

DO jj = 2, jpj

DO ji = 1, jpim1
.
.

END DO

END DO

with:

DO_2D_01_10
.
.
END_2D

similar conventions apply to the 3D loops macros. jk loop limits are retained
through macro arguments and are not restricted. This includes the possibility of
strides for which an extra set of DO_3DS macros are defined.

In the example definition below the inner PE domain is defined by start indices of
(kIs, kJs) and end indices of (kIe, KJe)

#define DO_2D_00_00 DO jj = kJs, kJe ; DO ji = kIs, kIe
#define END_2D END DO ; END DO

TO DO:

Only conventional nested loops have been identified and replaced by this step. There are constructs such as:

DO jk = 2, jpkm1

z2d(:,:) = z2d(:,:) + e3w(:,:,jk,Kmm) * z3d(:,:,jk) * wmask(:,:,jk)

END DO

which may need to be considered.
  • Property svn:keywords set to Id
File size: 8.8 KB
Line 
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
10   !!             3.6  !  2015-05  (O. Aumont) PISCES quota
11   !!----------------------------------------------------------------------
12
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
19   USE prtctl_trc      !  print control for debugging
20
21   IMPLICIT NONE
22   PRIVATE
23
24   PUBLIC   p4z_agg         ! called in p4zbio.F90
25
26   !! * Substitutions
27#  include "do_loop_substitute.h90"
28   !!----------------------------------------------------------------------
29   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
30   !! $Id$
31   !! Software governed by the CeCILL license (see ./LICENSE)
32   !!----------------------------------------------------------------------
33CONTAINS
34
35   SUBROUTINE p4z_agg ( kt, knt, Kbb, Krhs )
36      !!---------------------------------------------------------------------
37      !!                     ***  ROUTINE p4z_agg  ***
38      !!
39      !! ** Purpose :   Compute aggregation of particles
40      !!
41      !! ** Method  : - ???
42      !!---------------------------------------------------------------------
43      INTEGER, INTENT(in) ::   kt, knt   !
44      INTEGER, INTENT(in) ::   Kbb, Krhs ! time level indices
45      !
46      INTEGER  ::   ji, jj, jk
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
53      CHARACTER (len=25) :: charout
54      !!---------------------------------------------------------------------
55      !
56      IF( ln_timing )   CALL timing_start('p4z_agg')
57      !
58      !  Exchange between organic matter compartments due to coagulation/disaggregation
59      !  ---------------------------------------------------
60      IF( ln_p4z ) THEN
61         !
62         DO_3D_11_11( 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)
68
69            ! Part II : Differential settling
70
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)
74
75            zagg   = zagg1 + zagg2 + zagg3 + zagg4
76            zaggfe = zagg * tr(ji,jj,jk,jpsfe,Kbb) / ( tr(ji,jj,jk,jppoc,Kbb) + rtrn )
77
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)
90
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
102      ELSE    ! ln_p5z
103        !
104         DO_3D_11_11( 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)
112
113            ! Part II : Differential settling
114
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)
120
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 )
125
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)
135
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)
143
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
167         !
168      ENDIF
169      !
170      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging)
171         WRITE(charout, FMT="('agg')")
172         CALL prt_ctl_trc_info(charout)
173         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
174      ENDIF
175      !
176      IF( ln_timing )   CALL timing_stop('p4z_agg')
177      !
178   END SUBROUTINE p4z_agg
179
180   !!======================================================================
181END MODULE p4zagg
Note: See TracBrowser for help on using the repository browser.