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.
p4zlys.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/p4zlys.F90 @ 12353

Last change on this file since 12353 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.0 KB
Line 
1MODULE p4zlys
2   !!======================================================================
3   !!                         ***  MODULE p4zlys  ***
4   !! TOP :   PISCES
5   !!======================================================================
6   !! History :    -   !  1988-07  (E. MAIER-REIMER) Original code
7   !!              -   !  1998     (O. Aumont) additions
8   !!              -   !  1999     (C. Le Quere) modifications
9   !!             1.0  !  2004     (O. Aumont) modifications
10   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
11   !!                  !  2011-02  (J. Simeon, J. Orr)  Calcon salinity dependence
12   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Improvment of calcite dissolution
13   !!             3.6  !  2015-05  (O. Aumont) PISCES quota
14   !!----------------------------------------------------------------------
15   !!   p4z_lys        :   Compute the CaCO3 dissolution
16   !!   p4z_lys_init   :   Read the namelist parameters
17   !!----------------------------------------------------------------------
18   USE oce_trc         !  shared variables between ocean and passive tracers
19   USE trc             !  passive tracers common variables
20   USE sms_pisces      !  PISCES Source Minus Sink variables
21   USE p4zche          !  Chemical model
22   USE prtctl_trc      !  print control for debugging
23   USE iom             !  I/O manager
24
25   IMPLICIT NONE
26   PRIVATE
27
28   PUBLIC   p4z_lys         ! called in trcsms_pisces.F90
29   PUBLIC   p4z_lys_init    ! called in trcsms_pisces.F90
30
31   REAL(wp), PUBLIC ::   kdca   !: diss. rate constant calcite
32   REAL(wp), PUBLIC ::   nca    !: order of reaction for calcite dissolution
33
34   INTEGER  ::   rmtss              ! number of seconds per month
35   REAL(wp) ::   calcon = 1.03E-2   ! mean calcite concentration [Ca2+] in sea water [mole/kg solution]
36 
37   !! * Substitutions
38#  include "do_loop_substitute.h90"
39   !!----------------------------------------------------------------------
40   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
41   !! $Id$
42   !! Software governed by the CeCILL license (see ./LICENSE)
43   !!----------------------------------------------------------------------
44
45CONTAINS
46
47   SUBROUTINE p4z_lys( kt, knt, Kbb, Krhs )
48      !!---------------------------------------------------------------------
49      !!                     ***  ROUTINE p4z_lys  ***
50      !!
51      !! ** Purpose :   CALCULATES DEGREE OF CACO3 SATURATION IN THE WATER
52      !!                COLUMN, DISSOLUTION/PRECIPITATION OF CACO3 AND LOSS
53      !!                OF CACO3 TO THE CACO3 SEDIMENT POOL.
54      !!
55      !! ** Method  : - ???
56      !!---------------------------------------------------------------------
57      INTEGER, INTENT(in) ::   kt, knt   ! ocean time step and ???
58      INTEGER, INTENT(in)  ::  Kbb, Krhs ! time level indices
59      !
60      INTEGER  ::   ji, jj, jk, jn
61      REAL(wp) ::   zdispot, zfact, zcalcon
62      REAL(wp) ::   zomegaca, zexcess, zexcess0
63      CHARACTER (len=25) ::   charout
64      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zco3, zcaldiss, zhinit, zhi, zco3sat
65      !!---------------------------------------------------------------------
66      !
67      IF( ln_timing )  CALL timing_start('p4z_lys')
68      !
69      zhinit  (:,:,:) = hi(:,:,:) * 1000. / ( rhop(:,:,:) + rtrn )
70      !
71      !     -------------------------------------------
72      !     COMPUTE [CO3--] and [H+] CONCENTRATIONS
73      !     -------------------------------------------
74
75      CALL solve_at_general( zhinit, zhi, Kbb )
76
77      DO_3D_11_11( 1, jpkm1 )
78         zco3(ji,jj,jk) = tr(ji,jj,jk,jpdic,Kbb) * ak13(ji,jj,jk) * ak23(ji,jj,jk) / (zhi(ji,jj,jk)**2   &
79            &             + ak13(ji,jj,jk) * zhi(ji,jj,jk) + ak13(ji,jj,jk) * ak23(ji,jj,jk) + rtrn )
80         hi  (ji,jj,jk) = zhi(ji,jj,jk) * rhop(ji,jj,jk) / 1000.
81      END_3D
82
83      !     ---------------------------------------------------------
84      !        CALCULATE DEGREE OF CACO3 SATURATION AND CORRESPONDING
85      !        DISSOLOUTION AND PRECIPITATION OF CACO3 (BE AWARE OF
86      !        MGCO3)
87      !     ---------------------------------------------------------
88
89      DO_3D_11_11( 1, jpkm1 )
90
91         ! DEVIATION OF [CO3--] FROM SATURATION VALUE
92         ! Salinity dependance in zomegaca and divide by rhop/1000 to have good units
93         zcalcon  = calcon * ( salinprac(ji,jj,jk) / 35._wp )
94         zfact    = rhop(ji,jj,jk) / 1000._wp
95         zomegaca = ( zcalcon * zco3(ji,jj,jk) ) / ( aksp(ji,jj,jk) * zfact + rtrn )
96         zco3sat(ji,jj,jk) = aksp(ji,jj,jk) * zfact / ( zcalcon + rtrn )
97
98         ! SET DEGREE OF UNDER-/SUPERSATURATION
99         excess(ji,jj,jk) = 1._wp - zomegaca
100         zexcess0 = MAX( 0., excess(ji,jj,jk) )
101         zexcess  = zexcess0**nca
102
103         ! AMOUNT CACO3 (12C) THAT RE-ENTERS SOLUTION
104         !       (ACCORDING TO THIS FORMULATION ALSO SOME PARTICULATE
105         !       CACO3 GETS DISSOLVED EVEN IN THE CASE OF OVERSATURATION)
106         zdispot = kdca * zexcess * tr(ji,jj,jk,jpcal,Kbb)
107        !  CHANGE OF [CO3--] , [ALK], PARTICULATE [CACO3],
108        !       AND [SUM(CO2)] DUE TO CACO3 DISSOLUTION/PRECIPITATION
109        zcaldiss(ji,jj,jk)  = zdispot * rfact2 / rmtss ! calcite dissolution
110        !
111        tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) + 2. * zcaldiss(ji,jj,jk)
112        tr(ji,jj,jk,jpcal,Krhs) = tr(ji,jj,jk,jpcal,Krhs) -      zcaldiss(ji,jj,jk)
113        tr(ji,jj,jk,jpdic,Krhs) = tr(ji,jj,jk,jpdic,Krhs) +      zcaldiss(ji,jj,jk)
114      END_3D
115      !
116
117      IF( lk_iomput .AND. knt == nrdttrc ) THEN
118         CALL iom_put( "PH" , -1. * LOG10( MAX( hi(:,:,:), rtrn ) ) * tmask(:,:,:) )
119         IF( iom_use( "CO3" ) ) THEN
120            zco3(:,:,jpk) = 0.    ; CALL iom_put( "CO3"   , zco3(:,:,:)     * 1.e+3           * tmask(:,:,:) )
121         ENDIF
122         IF( iom_use( "CO3sat" ) ) THEN
123           zco3sat(:,:,jpk) = 0.  ; CALL iom_put( "CO3sat", zco3sat(:,:,:)  * 1.e+3           * tmask(:,:,:) )
124         ENDIF
125         IF( iom_use( "DCAL" ) ) THEN
126           zcaldiss(:,:,jpk) = 0. ; CALL iom_put( "DCAL"  , zcaldiss(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) )
127         ENDIF             
128      ENDIF
129      !
130      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging)
131        WRITE(charout, FMT="('lys ')")
132        CALL prt_ctl_trc_info(charout)
133        CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm)
134      ENDIF
135      !
136      IF( ln_timing )   CALL timing_stop('p4z_lys')
137      !
138   END SUBROUTINE p4z_lys
139
140
141   SUBROUTINE p4z_lys_init
142      !!----------------------------------------------------------------------
143      !!                  ***  ROUTINE p4z_lys_init  ***
144      !!
145      !! ** Purpose :   Initialization of CaCO3 dissolution parameters
146      !!
147      !! ** Method  :   Read the nampiscal namelist and check the parameters
148      !!      called at the first timestep (nittrc000)
149      !!
150      !! ** input   :   Namelist nampiscal
151      !!
152      !!----------------------------------------------------------------------
153      INTEGER ::   ios   ! Local integer
154      !
155      NAMELIST/nampiscal/ kdca, nca
156      !!----------------------------------------------------------------------
157      IF(lwp) THEN
158         WRITE(numout,*)
159         WRITE(numout,*) 'p4z_lys_init : initialization of CaCO3 dissolution'
160         WRITE(numout,*) '~~~~~~~~~~~~'
161      ENDIF
162      !
163      READ  ( numnatp_ref, nampiscal, IOSTAT = ios, ERR = 901)
164901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampiscal in reference namelist' )
165      READ  ( numnatp_cfg, nampiscal, IOSTAT = ios, ERR = 902 )
166902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampiscal in configuration namelist' )
167      IF(lwm) WRITE( numonp, nampiscal )
168      !
169      IF(lwp) THEN                         ! control print
170         WRITE(numout,*) '   Namelist : nampiscal'
171         WRITE(numout,*) '      diss. rate constant calcite (per month)        kdca =', kdca
172         WRITE(numout,*) '      order of reaction for calcite dissolution      nca  =', nca
173      ENDIF
174      !
175      ! Number of seconds per month
176      rmtss =  nyear_len(1) * rday / raamo
177      !
178   END SUBROUTINE p4z_lys_init
179
180   !!======================================================================
181END MODULE p4zlys
Note: See TracBrowser for help on using the repository browser.