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.
p4zmicro.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/p4zmicro.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: 13.9 KB
Line 
1MODULE p4zmicro
2   !!======================================================================
3   !!                         ***  MODULE p4zmicro  ***
4   !! TOP :   PISCES Compute the sources/sinks for microzooplankton
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) Quota model for iron
9   !!----------------------------------------------------------------------
10   !!   p4z_micro      : Compute the sources/sinks for microzooplankton
11   !!   p4z_micro_init : Initialize and read the appropriate namelist
12   !!----------------------------------------------------------------------
13   USE oce_trc         ! shared variables between ocean and passive tracers
14   USE trc             ! passive tracers common variables
15   USE sms_pisces      ! PISCES Source Minus Sink variables
16   USE p4zlim          ! Co-limitations
17   USE p4zprod         ! production
18   USE iom             ! I/O manager
19   USE prtctl_trc      ! print control for debugging
20
21   IMPLICIT NONE
22   PRIVATE
23
24   PUBLIC   p4z_micro         ! called in p4zbio.F90
25   PUBLIC   p4z_micro_init    ! called in trcsms_pisces.F90
26
27   REAL(wp), PUBLIC ::   part        !: part of calcite not dissolved in microzoo guts
28   REAL(wp), PUBLIC ::   xprefc      !: microzoo preference for POC
29   REAL(wp), PUBLIC ::   xprefn      !: microzoo preference for nanophyto
30   REAL(wp), PUBLIC ::   xprefd      !: microzoo preference for diatoms
31   REAL(wp), PUBLIC ::   xthreshdia  !: diatoms feeding threshold for microzooplankton
32   REAL(wp), PUBLIC ::   xthreshphy  !: nanophyto threshold for microzooplankton
33   REAL(wp), PUBLIC ::   xthreshpoc  !: poc threshold for microzooplankton
34   REAL(wp), PUBLIC ::   xthresh     !: feeding threshold for microzooplankton
35   REAL(wp), PUBLIC ::   resrat      !: exsudation rate of microzooplankton
36   REAL(wp), PUBLIC ::   mzrat       !: microzooplankton mortality rate
37   REAL(wp), PUBLIC ::   grazrat     !: maximal microzoo grazing rate
38   REAL(wp), PUBLIC ::   xkgraz      !: Half-saturation constant of assimilation
39   REAL(wp), PUBLIC ::   unass       !: Non-assimilated part of food
40   REAL(wp), PUBLIC ::   sigma1      !: Fraction of microzoo excretion as DOM
41   REAL(wp), PUBLIC ::   epsher      !: growth efficiency for grazing 1
42   REAL(wp), PUBLIC ::   epshermin   !: minimum growth efficiency for grazing 1
43
44   !! * Substitutions
45#  include "do_loop_substitute.h90"
46   !!----------------------------------------------------------------------
47   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
48   !! $Id$
49   !! Software governed by the CeCILL license (see ./LICENSE)
50   !!----------------------------------------------------------------------
51CONTAINS
52
53   SUBROUTINE p4z_micro( kt, knt, Kbb, Krhs )
54      !!---------------------------------------------------------------------
55      !!                     ***  ROUTINE p4z_micro  ***
56      !!
57      !! ** Purpose :   Compute the sources/sinks for microzooplankton
58      !!
59      !! ** Method  : - ???
60      !!---------------------------------------------------------------------
61      INTEGER, INTENT(in) ::   kt    ! ocean time step
62      INTEGER, INTENT(in) ::   knt   ! ???
63      INTEGER, INTENT(in) ::   Kbb, Krhs  ! time level indices
64      !
65      INTEGER  :: ji, jj, jk
66      REAL(wp) :: zcompadi, zcompaz , zcompaph, zcompapoc
67      REAL(wp) :: zgraze  , zdenom, zdenom2
68      REAL(wp) :: zfact   , zfood, zfoodlim, zbeta
69      REAL(wp) :: zepsherf, zepshert, zepsherv, zgrarsig, zgraztotc, zgraztotn, zgraztotf
70      REAL(wp) :: zgrarem, zgrafer, zgrapoc, zprcaca, zmortz
71      REAL(wp) :: zrespz, ztortz, zgrasrat, zgrasratn
72      REAL(wp) :: zgrazp, zgrazm, zgrazsd
73      REAL(wp) :: zgrazmf, zgrazsf, zgrazpf
74      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazing, zfezoo, zzligprod
75      CHARACTER (len=25) :: charout
76      !!---------------------------------------------------------------------
77      !
78      IF( ln_timing )   CALL timing_start('p4z_micro')
79      !
80      DO_3D_11_11( 1, jpkm1 )
81         zcompaz = MAX( ( tr(ji,jj,jk,jpzoo,Kbb) - 1.e-9 ), 0.e0 )
82         zfact   = xstep * tgfunc2(ji,jj,jk) * zcompaz
83
84         !  Respiration rates of both zooplankton
85         !  -------------------------------------
86         zrespz = resrat * zfact * tr(ji,jj,jk,jpzoo,Kbb) / ( xkmort + tr(ji,jj,jk,jpzoo,Kbb) )  &
87            &   + resrat * zfact * 3. * nitrfac(ji,jj,jk)
88
89         !  Zooplankton mortality. A square function has been selected with
90         !  no real reason except that it seems to be more stable and may mimic predation.
91         !  ---------------------------------------------------------------
92         ztortz = mzrat * 1.e6 * zfact * tr(ji,jj,jk,jpzoo,Kbb) * (1. - nitrfac(ji,jj,jk))
93
94         zcompadi  = MIN( MAX( ( tr(ji,jj,jk,jpdia,Kbb) - xthreshdia ), 0.e0 ), xsizedia )
95         zcompaph  = MAX( ( tr(ji,jj,jk,jpphy,Kbb) - xthreshphy ), 0.e0 )
96         zcompapoc = MAX( ( tr(ji,jj,jk,jppoc,Kbb) - xthreshpoc ), 0.e0 )
97         
98         !     Microzooplankton grazing
99         !     ------------------------
100         zfood     = xprefn * zcompaph + xprefc * zcompapoc + xprefd * zcompadi
101         zfoodlim  = MAX( 0. , zfood - min(xthresh,0.5*zfood) )
102         zdenom    = zfoodlim / ( xkgraz + zfoodlim )
103         zdenom2   = zdenom / ( zfood + rtrn )
104         zgraze    = grazrat * xstep * tgfunc2(ji,jj,jk) * tr(ji,jj,jk,jpzoo,Kbb) * (1. - nitrfac(ji,jj,jk))
105
106         zgrazp    = zgraze  * xprefn * zcompaph  * zdenom2 
107         zgrazm    = zgraze  * xprefc * zcompapoc * zdenom2 
108         zgrazsd   = zgraze  * xprefd * zcompadi  * zdenom2 
109
110         zgrazpf   = zgrazp  * tr(ji,jj,jk,jpnfe,Kbb) / (tr(ji,jj,jk,jpphy,Kbb) + rtrn)
111         zgrazmf   = zgrazm  * tr(ji,jj,jk,jpsfe,Kbb) / (tr(ji,jj,jk,jppoc,Kbb) + rtrn)
112         zgrazsf   = zgrazsd * tr(ji,jj,jk,jpdfe,Kbb) / (tr(ji,jj,jk,jpdia,Kbb) + rtrn)
113         !
114         zgraztotc = zgrazp  + zgrazm  + zgrazsd 
115         zgraztotf = zgrazpf + zgrazsf + zgrazmf 
116         zgraztotn = zgrazp * quotan(ji,jj,jk) + zgrazm + zgrazsd * quotad(ji,jj,jk)
117
118         ! Grazing by microzooplankton
119         zgrazing(ji,jj,jk) = zgraztotc
120
121         !    Various remineralization and excretion terms
122         !    --------------------------------------------
123         zgrasrat  = ( zgraztotf + rtrn ) / ( zgraztotc + rtrn )
124         zgrasratn = ( zgraztotn + rtrn ) / ( zgraztotc + rtrn )
125         zepshert  =  MIN( 1., zgrasratn, zgrasrat / ferat3)
126         zbeta     = MAX(0., (epsher - epshermin) )
127         zepsherf  = epshermin + zbeta / ( 1.0 + 0.04E6 * 12. * zfood * zbeta )
128         zepsherv  = zepsherf * zepshert 
129
130         zgrafer   = zgraztotc * MAX( 0. , ( 1. - unass ) * zgrasrat - ferat3 * zepsherv ) 
131         zgrarem   = zgraztotc * ( 1. - zepsherv - unass )
132         zgrapoc   = zgraztotc * unass
133
134         !  Update of the TRA arrays
135         !  ------------------------
136         zgrarsig  = zgrarem * sigma1
137         tr(ji,jj,jk,jppo4,Krhs) = tr(ji,jj,jk,jppo4,Krhs) + zgrarsig
138         tr(ji,jj,jk,jpnh4,Krhs) = tr(ji,jj,jk,jpnh4,Krhs) + zgrarsig
139         tr(ji,jj,jk,jpdoc,Krhs) = tr(ji,jj,jk,jpdoc,Krhs) + zgrarem - zgrarsig
140         !
141         IF( ln_ligand ) THEN
142            tr(ji,jj,jk,jplgw,Krhs) = tr(ji,jj,jk,jplgw,Krhs) + (zgrarem - zgrarsig) * ldocz
143            zzligprod(ji,jj,jk) = (zgrarem - zgrarsig) * ldocz
144         ENDIF
145         !
146         tr(ji,jj,jk,jpoxy,Krhs) = tr(ji,jj,jk,jpoxy,Krhs) - o2ut * zgrarsig
147         tr(ji,jj,jk,jpfer,Krhs) = tr(ji,jj,jk,jpfer,Krhs) + zgrafer
148         zfezoo(ji,jj,jk)    = zgrafer
149         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zgrapoc
150         prodpoc(ji,jj,jk)   = prodpoc(ji,jj,jk) + zgrapoc
151         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + zgraztotf * unass
152         tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) + zgrarsig
153         tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + rno3 * zgrarsig
154         !   Update the arrays TRA which contain the biological sources and sinks
155         !   --------------------------------------------------------------------
156         zmortz = ztortz + zrespz
157         tr(ji,jj,jk,jpzoo,Krhs) = tr(ji,jj,jk,jpzoo,Krhs) - zmortz + zepsherv * zgraztotc 
158         tr(ji,jj,jk,jpphy,Krhs) = tr(ji,jj,jk,jpphy,Krhs) - zgrazp
159         tr(ji,jj,jk,jpdia,Krhs) = tr(ji,jj,jk,jpdia,Krhs) - zgrazsd
160         tr(ji,jj,jk,jpnch,Krhs) = tr(ji,jj,jk,jpnch,Krhs) - zgrazp  * tr(ji,jj,jk,jpnch,Kbb)/(tr(ji,jj,jk,jpphy,Kbb)+rtrn)
161         tr(ji,jj,jk,jpdch,Krhs) = tr(ji,jj,jk,jpdch,Krhs) - zgrazsd * tr(ji,jj,jk,jpdch,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn)
162         tr(ji,jj,jk,jpdsi,Krhs) = tr(ji,jj,jk,jpdsi,Krhs) - zgrazsd * tr(ji,jj,jk,jpdsi,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn)
163         tr(ji,jj,jk,jpgsi,Krhs) = tr(ji,jj,jk,jpgsi,Krhs) + zgrazsd * tr(ji,jj,jk,jpdsi,Kbb)/(tr(ji,jj,jk,jpdia,Kbb)+rtrn)
164         tr(ji,jj,jk,jpnfe,Krhs) = tr(ji,jj,jk,jpnfe,Krhs) - zgrazpf
165         tr(ji,jj,jk,jpdfe,Krhs) = tr(ji,jj,jk,jpdfe,Krhs) - zgrazsf
166         tr(ji,jj,jk,jppoc,Krhs) = tr(ji,jj,jk,jppoc,Krhs) + zmortz - zgrazm
167         prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortz
168         conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazm
169         tr(ji,jj,jk,jpsfe,Krhs) = tr(ji,jj,jk,jpsfe,Krhs) + ferat3 * zmortz - zgrazmf
170         !
171         ! calcite production
172         zprcaca = xfracal(ji,jj,jk) * zgrazp
173         prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo)
174         !
175         zprcaca = part * zprcaca
176         tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) - zprcaca
177         tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - 2. * zprcaca
178         tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) + zprcaca
179      END_3D
180      !
181      IF( lk_iomput .AND. knt == nrdttrc ) THEN
182        IF( iom_use("GRAZ1") ) THEN  !   Total grazing of phyto by zooplankton
183           zgrazing(:,:,jpk) = 0._wp   ; CALL iom_put( "GRAZ1" , zgrazing(:,:,:) * 1.e+3  * rfact2r * tmask(:,:,:) ) 
184         ENDIF
185         IF( iom_use("FEZOO") ) THEN 
186           zfezoo (:,:,jpk) = 0._wp    ; CALL iom_put( "FEZOO", zfezoo(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:) )
187         ENDIF
188         IF( ln_ligand ) THEN
189            zzligprod(:,:,jpk) = 0._wp ; CALL iom_put( "LPRODZ", zzligprod(:,:,:) * 1e9 * 1.e+3 * rfact2r * tmask(:,:,:))
190         ENDIF
191      ENDIF
192      !
193      IF(sn_cfctl%l_prttrc) THEN      ! print mean trends (used for debugging)
194         WRITE(charout, FMT="('micro')")
195         CALL prt_ctl_trc_info(charout)
196         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
197      ENDIF
198      !
199      IF( ln_timing )   CALL timing_stop('p4z_micro')
200      !
201   END SUBROUTINE p4z_micro
202
203
204   SUBROUTINE p4z_micro_init
205      !!----------------------------------------------------------------------
206      !!                  ***  ROUTINE p4z_micro_init  ***
207      !!
208      !! ** Purpose :   Initialization of microzooplankton parameters
209      !!
210      !! ** Method  :   Read the nampiszoo namelist and check the parameters
211      !!                called at the first timestep (nittrc000)
212      !!
213      !! ** input   :   Namelist nampiszoo
214      !!
215      !!----------------------------------------------------------------------
216      INTEGER ::   ios   ! Local integer
217      !
218      NAMELIST/namp4zzoo/ part, grazrat, resrat, mzrat, xprefn, xprefc, &
219         &                xprefd,  xthreshdia,  xthreshphy,  xthreshpoc, &
220         &                xthresh, xkgraz, epsher, epshermin, sigma1, unass
221      !!----------------------------------------------------------------------
222      !
223      IF(lwp) THEN
224         WRITE(numout,*) 
225         WRITE(numout,*) 'p4z_micro_init : Initialization of microzooplankton parameters'
226         WRITE(numout,*) '~~~~~~~~~~~~~~'
227      ENDIF
228      !
229      READ  ( numnatp_ref, namp4zzoo, IOSTAT = ios, ERR = 901)
230901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namp4zzoo in reference namelist' )
231      READ  ( numnatp_cfg, namp4zzoo, IOSTAT = ios, ERR = 902 )
232902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namp4zzoo in configuration namelist' )
233      IF(lwm) WRITE( numonp, namp4zzoo )
234      !
235      IF(lwp) THEN                         ! control print
236         WRITE(numout,*) '   Namelist : namp4zzoo'
237         WRITE(numout,*) '      part of calcite not dissolved in microzoo guts  part        =', part
238         WRITE(numout,*) '      microzoo preference for POC                     xprefc      =', xprefc
239         WRITE(numout,*) '      microzoo preference for nano                    xprefn      =', xprefn
240         WRITE(numout,*) '      microzoo preference for diatoms                 xprefd      =', xprefd
241         WRITE(numout,*) '      diatoms feeding threshold  for microzoo         xthreshdia  =', xthreshdia
242         WRITE(numout,*) '      nanophyto feeding threshold for microzoo        xthreshphy  =', xthreshphy
243         WRITE(numout,*) '      poc feeding threshold for microzoo              xthreshpoc  =', xthreshpoc
244         WRITE(numout,*) '      feeding threshold for microzooplankton          xthresh     =', xthresh
245         WRITE(numout,*) '      exsudation rate of microzooplankton             resrat      =', resrat
246         WRITE(numout,*) '      microzooplankton mortality rate                 mzrat       =', mzrat
247         WRITE(numout,*) '      maximal microzoo grazing rate                   grazrat     =', grazrat
248         WRITE(numout,*) '      non assimilated fraction of P by microzoo       unass       =', unass
249         WRITE(numout,*) '      Efficicency of microzoo growth                  epsher      =', epsher
250         WRITE(numout,*) '      Minimum efficicency of microzoo growth          epshermin   =', epshermin
251         WRITE(numout,*) '      Fraction of microzoo excretion as DOM           sigma1      =', sigma1
252         WRITE(numout,*) '      half sturation constant for grazing 1           xkgraz      =', xkgraz
253      ENDIF
254      !
255   END SUBROUTINE p4z_micro_init
256
257   !!======================================================================
258END MODULE p4zmicro
Note: See TracBrowser for help on using the repository browser.