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.
p2zopt.F90 in NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P2Z – NEMO

source: NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P2Z/p2zopt.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.7 KB
Line 
1MODULE p2zopt
2   !!======================================================================
3   !!                         ***  MODULE p2zopt  ***
4   !! TOP :   LOBSTER Compute the light availability in the water column
5   !!======================================================================
6   !! History :    -   !  1995-05  (M. Levy) Original code
7   !!              -   !  1999-09  (J.-M. Andre, M. Levy)
8   !!              -   !  1999-11  (C. Menkes, M.-A. Foujols) itabe initial
9   !!              -   !  2000-02  (M.A. Foujols) change x**y par exp(y*log(x))
10   !!   NEMO      2.0  !  2007-12  (C. Deltel, G. Madec)  F90
11   !!             3.2  !  2009-04  (C. Ethe, G. Madec)  minor optimisation + style
12   !!----------------------------------------------------------------------
13
14   !!----------------------------------------------------------------------
15   !!   p2z_opt        :   Compute the light availability in the water column
16   !!----------------------------------------------------------------------
17   USE oce_trc         !
18   USE trc
19   USE sms_pisces
20   USE prtctl_trc      ! Print control for debbuging
21
22   IMPLICIT NONE
23   PRIVATE
24
25   PUBLIC   p2z_opt   !
26   PUBLIC   p2z_opt_init   !
27
28   REAL(wp), PUBLIC ::  xkr0      !: water coefficient absorption in red     
29   REAL(wp), PUBLIC ::  xkg0      !: water coefficient absorption in green   
30   REAL(wp), PUBLIC ::  xkrp      !: pigment coefficient absorption in red   
31   REAL(wp), PUBLIC ::  xkgp      !: pigment coefficient absorption in green 
32   REAL(wp), PUBLIC ::  xlr       !: exposant for pigment absorption in red 
33   REAL(wp), PUBLIC ::  xlg       !: exposant for pigment absorption in green
34   REAL(wp), PUBLIC ::  rpig      !: chla/chla+phea ratio   
35   !                 
36   REAL(wp), PUBLIC ::  rcchl     ! Carbone/Chlorophyl ratio [mgC.mgChla-1]
37   REAL(wp), PUBLIC ::  redf      ! redfield ratio (C:N) for phyto
38   REAL(wp), PUBLIC ::  reddom    ! redfield ratio (C:N) for DOM
39
40   !! * Substitutions
41#  include "do_loop_substitute.h90"
42   !!----------------------------------------------------------------------
43   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
44   !! $Id$
45   !! Software governed by the CeCILL license (see ./LICENSE)
46   !!----------------------------------------------------------------------
47CONTAINS
48
49   SUBROUTINE p2z_opt( kt, Kmm )
50      !!---------------------------------------------------------------------
51      !!                     ***  ROUTINE p2z_opt  ***
52      !!
53      !! ** Purpose :   computes the light propagation in the water column
54      !!              and the euphotic layer depth
55      !!
56      !! ** Method  :   local par is computed in w layers using light propagation
57      !!              mean par in t layers are computed by integration
58      !!
59!!gm please remplace the '???' by true comments
60      !! ** Action  :   etot   ???
61      !!                neln   ???
62      !!---------------------------------------------------------------------
63      !!
64      INTEGER, INTENT( in ) ::   kt   ! index of the time stepping
65      INTEGER, INTENT( in ) ::   Kmm  ! time level index
66      !!
67      INTEGER  ::   ji, jj, jk          ! dummy loop indices
68      CHARACTER (len=25) ::   charout   ! temporary character
69      REAL(wp) ::   zpig                ! log of the total pigment
70      REAL(wp) ::   zkr, zkg            ! total absorption coefficient in red and green
71      REAL(wp) ::   zcoef               ! temporary scalar
72      REAL(wp), DIMENSION(jpi,jpj    ) :: zpar100, zpar0m
73      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zparr, zparg
74      !!---------------------------------------------------------------------
75      !
76      IF( ln_timing )   CALL timing_start('p2z_opt')
77      !
78
79      IF( kt == nittrc000 ) THEN
80         IF(lwp) WRITE(numout,*)
81         IF(lwp) WRITE(numout,*) ' p2z_opt : LOBSTER optic-model'
82         IF(lwp) WRITE(numout,*) ' ~~~~~~~ '
83      ENDIF
84
85      !                                          ! surface irradiance
86      !                                          ! ------------------
87      IF( ln_dm2dc ) THEN   ;   zpar0m(:,:) = qsr_mean(:,:) * 0.43
88      ELSE                  ;   zpar0m(:,:) = qsr     (:,:) * 0.43
89      ENDIF
90      zpar100(:,:)   = zpar0m(:,:) * 0.01
91      zparr  (:,:,1) = zpar0m(:,:) * 0.5
92      zparg  (:,:,1) = zpar0m(:,:) * 0.5
93
94      !                                          ! Photosynthetically Available Radiation (PAR)
95      zcoef = 12 * redf / rcchl / rpig           ! --------------------------------------
96      DO_3D_11_11( 2, jpk )
97         zpig = LOG(  MAX( TINY(0.), tr(ji,jj,jk-1,jpphy,Kmm) ) * zcoef  )
98         zkr  = xkr0 + xkrp * EXP( xlr * zpig )
99         zkg  = xkg0 + xkgp * EXP( xlg * zpig )
100         zparr(ji,jj,jk) = zparr(ji,jj,jk-1) * EXP( -zkr * e3t(ji,jj,jk-1,Kmm) )
101         zparg(ji,jj,jk) = zparg(ji,jj,jk-1) * EXP( -zkg * e3t(ji,jj,jk-1,Kmm) )
102      END_3D
103      DO_3D_11_11( 1, jpkm1 )
104         zpig = LOG(  MAX( TINY(0.), tr(ji,jj,jk,jpphy,Kmm) ) * zcoef  )
105         zkr  = xkr0 + xkrp * EXP( xlr * zpig )
106         zkg  = xkg0 + xkgp * EXP( xlg * zpig )
107         zparr(ji,jj,jk) = zparr(ji,jj,jk) / ( zkr * e3t(ji,jj,jk,Kmm) ) * ( 1 - EXP( -zkr * e3t(ji,jj,jk,Kmm) ) )
108         zparg(ji,jj,jk) = zparg(ji,jj,jk) / ( zkg * e3t(ji,jj,jk,Kmm) ) * ( 1 - EXP( -zkg * e3t(ji,jj,jk,Kmm) ) )
109         etot (ji,jj,jk) = MAX( zparr(ji,jj,jk) + zparg(ji,jj,jk), 1.e-15 )
110      END_3D
111
112      !                                          ! Euphotic layer
113      !                                          ! --------------
114      neln(:,:) = 1                                   ! euphotic layer level
115      DO_3D_11_11( 1, jpkm1 )
116        IF( etot(ji,jj,jk) >= zpar100(ji,jj) )   neln(ji,jj) = jk + 1 
117      END_3D
118      !                                               ! Euphotic layer depth
119      DO_2D_11_11
120         heup(ji,jj) = gdepw(ji,jj,neln(ji,jj),Kmm)
121      END_2D
122
123
124      IF(sn_cfctl%l_prttrc) THEN      ! print mean trends (used for debugging)
125         WRITE(charout, FMT="('opt')")
126         CALL prt_ctl_trc_info( charout )
127         CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Kmm), mask=tmask, clinfo=ctrcnm )
128      ENDIF
129      !
130      IF( ln_timing )   CALL timing_stop('p2z_opt')
131      !
132   END SUBROUTINE p2z_opt
133
134
135   SUBROUTINE p2z_opt_init
136      !!----------------------------------------------------------------------
137      !!                  ***  ROUTINE p2z_opt_init  ***
138      !!
139      !! ** Purpose :  optical parameters
140      !!
141      !! ** Method  :   Read the namlobopt namelist and check the parameters
142      !!
143      !!----------------------------------------------------------------------
144      INTEGER ::   ios   ! Local integer
145      !!
146      NAMELIST/namlobopt/ xkg0, xkr0, xkgp, xkrp, xlg, xlr, rpig
147      NAMELIST/namlobrat/ rcchl, redf, reddom
148      !!----------------------------------------------------------------------
149
150      READ  ( numnatp_ref, namlobopt, IOSTAT = ios, ERR = 901)
151901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobopt in reference namelist' )
152
153      READ  ( numnatp_cfg, namlobopt, IOSTAT = ios, ERR = 902 )
154902   IF( ios >  0 ) CALL ctl_nam ( ios , 'namlobopt in configuration namelist' )
155      IF(lwm) WRITE ( numonp, namlobopt )
156
157      IF(lwp) THEN
158         WRITE(numout,*)
159         WRITE(numout,*) ' Namelist namlobopt'
160         WRITE(numout,*) '    green   water absorption coeff                       xkg0  = ', xkg0
161         WRITE(numout,*) '    red water absorption coeff                           xkr0  = ', xkr0
162         WRITE(numout,*) '    pigment red absorption coeff                         xkrp  = ', xkrp
163         WRITE(numout,*) '    pigment green absorption coeff                       xkgp  = ', xkgp
164         WRITE(numout,*) '    green chl exposant                                   xlg   = ', xlg
165         WRITE(numout,*) '    red   chl exposant                                   xlr   = ', xlr
166         WRITE(numout,*) '    chla/chla+phea ratio                                 rpig  = ', rpig
167         WRITE(numout,*) ' '
168      ENDIF
169      !
170      READ  ( numnatp_ref, namlobrat, IOSTAT = ios, ERR = 903)
171903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namlobrat in reference namelist' )
172
173      READ  ( numnatp_cfg, namlobrat, IOSTAT = ios, ERR = 904 )
174904   IF( ios >  0 ) CALL ctl_nam ( ios , 'namlobrat in configuration namelist' )
175      IF(lwm) WRITE ( numonp, namlobrat )
176
177      IF(lwp) THEN
178          WRITE(numout,*) ' Namelist namlobrat'
179         WRITE(numout,*) '     carbone/chlorophyl ratio                             rcchl = ', rcchl
180          WRITE(numout,*) '    redfield ratio  c:n for phyto                        redf      =', redf
181          WRITE(numout,*) '    redfield ratio  c:n for DOM                          reddom    =', reddom
182          WRITE(numout,*) ' '
183      ENDIF
184      !
185   END SUBROUTINE p2z_opt_init
186
187   !!======================================================================
188END MODULE p2zopt
Note: See TracBrowser for help on using the repository browser.