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.
trcldf.F90 in NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/TRP – NEMO

source: NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/TRP/trcldf.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: 10.7 KB
Line 
1MODULE trcldf
2   !!======================================================================
3   !!                       ***  MODULE  trcldf  ***
4   !! Ocean Passive tracers : lateral diffusive trends
5   !!=====================================================================
6   !! History :  1.0  ! 2005-11  (G. Madec)  Original code
7   !!            3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA
8   !!            3.7  ! 2014-03  (G. Madec)  LDF simplification
9   !!----------------------------------------------------------------------
10#if defined key_top
11   !!----------------------------------------------------------------------
12   !!   'key_top'                                                TOP models
13   !!----------------------------------------------------------------------
14   !!   trc_ldf       : update the tracer trend with the lateral diffusion
15   !!   trc_ldf_ini   : initialization, namelist read, and parameters control
16   !!----------------------------------------------------------------------
17   USE trc            ! ocean passive tracers variables
18   USE oce_trc        ! ocean dynamics and active tracers
19   USE ldftra         ! lateral diffusion: eddy diffusivity & EIV coeff.
20   USE ldfslp         ! Lateral diffusion: slopes of neutral surfaces
21   USE traldf_lap_blp ! lateral diffusion: lap/bilaplacian iso-level      operator  (tra_ldf_lap/_blp   routine)
22   USE traldf_iso     ! lateral diffusion: laplacian iso-neutral standard operator  (tra_ldf_iso        routine)
23   USE traldf_triad   ! lateral diffusion: laplacian iso-neutral triad    operator  (tra_ldf_     triad routine)
24   USE trd_oce        ! trends: ocean variables
25   USE trdtra         ! trends manager: tracers
26   !
27   USE prtctl_trc     ! Print control
28
29   IMPLICIT NONE
30   PRIVATE
31
32   PUBLIC   trc_ldf   
33   PUBLIC   trc_ldf_ini   
34   !
35   !                                      !!: ** lateral mixing namelist (nam_trcldf) **
36   LOGICAL , PUBLIC ::   ln_trcldf_OFF     !: No operator (no explicit lateral diffusion)
37   LOGICAL , PUBLIC ::   ln_trcldf_tra     !: use active tracer operator
38   REAL(wp), PUBLIC ::      rn_ldf_multi      !: multiplier of T-S eddy diffusivity to obtain the passive tracer one
39   REAL(wp), PUBLIC ::      rn_fact_lap       !: enhanced Equatorial zonal diffusivity coefficent
40   !
41   INTEGER  ::   nldf_trc = 0   ! type of lateral diffusion used defined from ln_traldf_... (namlist logicals)
42   REAL(wp) ::   rldf           ! multiplier between active and passive tracers eddy diffusivity   [-]
43   
44   !! * Substitutions
45#  include "vectopt_loop_substitute.h90"
46#  include "do_loop_substitute.h90"
47   !!----------------------------------------------------------------------
48   !! NEMO/TOP 4.0 , NEMO Consortium (2018)
49   !! $Id$
50   !! Software governed by the CeCILL license (see ./LICENSE)
51   !!----------------------------------------------------------------------
52CONTAINS
53
54   SUBROUTINE trc_ldf( kt, Kbb, Kmm, ptr, Krhs )
55      !!----------------------------------------------------------------------
56      !!                  ***  ROUTINE tra_ldf  ***
57      !!
58      !! ** Purpose :   compute the lateral ocean tracer physics.
59      !!
60      !!----------------------------------------------------------------------
61      INTEGER,                                    INTENT(in   ) :: kt              ! ocean time-step index
62      INTEGER,                                    INTENT(in   ) :: Kbb, Kmm, Krhs  ! ocean time-level index
63      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr             ! passive tracers and RHS of tracer equation
64      !
65      INTEGER            :: ji, jj, jk, jn
66      REAL(wp)           :: zdep
67      CHARACTER (len=22) :: charout
68      REAL(wp),          DIMENSION(jpi,jpj,jpk) ::   zahu, zahv
69      REAL(wp), POINTER, DIMENSION(:,:,:,:)     ::   ztrtrd
70      !!----------------------------------------------------------------------
71      !
72      IF( ln_trcldf_OFF )   RETURN        ! not lateral diffusion applied on passive tracers
73      !
74      IF( ln_timing )   CALL timing_start('trc_ldf')
75      !
76      IF( l_trdtrc )  THEN
77         ALLOCATE( ztrtrd(jpi,jpj,jpk,jptra) )
78         ztrtrd(:,:,:,:)  = ptr(:,:,:,:,Krhs)
79      ENDIF
80      !                                  !* set the lateral diffusivity coef. for passive tracer     
81      zahu(:,:,:) = rldf * ahtu(:,:,:) 
82      zahv(:,:,:) = rldf * ahtv(:,:,:)
83      !                                  !* Enhanced zonal diffusivity coefficent in the equatorial domain
84      DO_3D_11_11( 1, jpk )
85         IF( gdept(ji,jj,jk,Kmm) > 200. .AND. gphit(ji,jj) < 5. .AND. gphit(ji,jj) > -5. ) THEN
86            zdep = MAX( gdept(ji,jj,jk,Kmm) - 1000., 0. ) / 1000.
87            zahu(ji,jj,jk) = zahu(ji,jj,jk) * MAX( 1., rn_fact_lap * EXP( -zdep ) )
88         ENDIF
89      END_3D
90      !
91      SELECT CASE ( nldf_trc )                 !* compute lateral mixing trend and add it to the general trend
92      !
93      CASE ( np_lap   )                                                                                    ! iso-level laplacian
94         CALL tra_ldf_lap  ( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi,            &
95           &                     ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs),                   jptra, 1 )
96      CASE ( np_lap_i )                                                                                    ! laplacian : standard iso-neutral operator (Madec)
97         CALL tra_ldf_iso  ( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi,            &
98           &                     ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, 1 )
99      CASE ( np_lap_it )                                                                                   ! laplacian : triad iso-neutral operator (griffies)
100         CALL tra_ldf_triad( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi,            &
101           &                     ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, 1 )
102      CASE ( np_blp , np_blp_i , np_blp_it )                                                               ! bilaplacian: all operator (iso-level, -neutral)
103         CALL tra_ldf_blp  ( kt, Kmm, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi,            &
104           &                     ptr(:,:,:,:,Kbb) , ptr(:,:,:,:,Krhs),                 jptra, nldf_trc )
105      END SELECT
106      !
107      IF( l_trdtrc )   THEN                    ! send the trends for further diagnostics
108        DO jn = 1, jptra
109           ztrtrd(:,:,:,jn) = ptr(:,:,:,jn,Krhs) - ztrtrd(:,:,:,jn)
110           CALL trd_tra( kt, Kmm, Krhs, 'TRC', jn, jptra_ldf, ztrtrd(:,:,:,jn) )
111        END DO
112        DEALLOCATE( ztrtrd )
113      ENDIF
114      !               
115      IF( sn_cfctl%l_prttrc ) THEN ! print mean trends (used for debugging)
116         WRITE(charout, FMT="('ldf ')")
117         CALL prt_ctl_trc_info(charout)
118         CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
119      ENDIF
120      !
121      IF( ln_timing )   CALL timing_stop('trc_ldf')
122      !
123   END SUBROUTINE trc_ldf
124
125
126   SUBROUTINE trc_ldf_ini
127      !!----------------------------------------------------------------------
128      !!                  ***  ROUTINE ldf_ctl  ***
129      !!
130      !! ** Purpose :   Define the operator for the lateral diffusion
131      !!
132      !! ** Method  : - ln_trcldf_tra=T : use nldf_tra set in ldftra module
133      !!              to defined the passive tracer lateral diffusive operator
134      !!              - ln_trcldf_OFF=T : no explicit diffusion used
135      !!----------------------------------------------------------------------
136      INTEGER ::   ios, ioptio   ! local integers
137      !!
138      NAMELIST/namtrc_ldf/ ln_trcldf_OFF , ln_trcldf_tra,   &   ! operator & direction
139         &                 rn_ldf_multi  , rn_fact_lap          ! coefficient
140      !!----------------------------------------------------------------------
141      !
142      IF(lwp) THEN
143         WRITE(numout,*)
144         WRITE(numout,*) 'trc_ldf_ini : lateral passive tracer diffusive operator'
145         WRITE(numout,*) '~~~~~~~~~~~'
146      ENDIF
147      !
148      READ  ( numnat_ref, namtrc_ldf, IOSTAT = ios, ERR = 903)
149903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_ldf in reference namelist' )
150      !
151      READ  ( numnat_cfg, namtrc_ldf, IOSTAT = ios, ERR = 904 )
152904   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_ldf in configuration namelist' )
153      IF(lwm) WRITE ( numont, namtrc_ldf )
154      !
155      IF(lwp) THEN                     ! Namelist print
156         WRITE(numout,*) '   Namelist namtrc_ldf : set lateral mixing parameters (type, direction, coefficients)'
157         WRITE(numout,*) '      no explicit diffusion                 ln_trcldf_OFF   = ', ln_trcldf_OFF
158         WRITE(numout,*) '      use active tracer operator            ln_trcldf_tra   = ', ln_trcldf_tra
159         WRITE(numout,*) '      diffusivity coefficient :'
160         WRITE(numout,*) '         multiplier of TRA coef. for TRC       rn_ldf_multi = ', rn_ldf_multi
161         WRITE(numout,*) '         enhanced zonal Eq. laplacian coef.    rn_fact_lap  = ', rn_fact_lap
162
163      ENDIF
164      !     
165      !                                ! control the namelist parameters
166      nldf_trc = np_ERROR
167      ioptio   = 0
168      IF( ln_trcldf_OFF  ) THEN   ;   nldf_trc = np_no_ldf   ;   ioptio = ioptio + 1   ;   ENDIF
169      IF( ln_trcldf_tra  ) THEN   ;   nldf_trc = nldf_tra    ;   ioptio = ioptio + 1   ;   ENDIF
170      IF( ioptio /=  1   )   CALL ctl_stop( 'trc_ldf_ini: use ONE of the 2 operator options (OFF/tra)' )
171     
172      !                                ! multiplier : passive/active tracers ration
173      IF( ln_traldf_lap ) THEN               ! laplacian operator
174         rldf = rn_ldf_multi                       ! simple multiplier
175      ELSEIF( ln_traldf_blp ) THEN           ! bilaplacian operator:
176         rldf = SQRT( ABS( rn_ldf_multi )  )       ! the coef. used is the SQRT of the bilaplacian coef.
177      ENDIF
178      !
179      IF(lwp) THEN
180         WRITE(numout,*)
181         SELECT CASE( nldf_trc )
182         CASE( np_no_ldf )   ;   WRITE(numout,*) '      ===>>   NO lateral diffusion'
183         CASE( np_lap    )   ;   WRITE(numout,*) '      ===>>   laplacian iso-level operator'
184         CASE( np_lap_i  )   ;   WRITE(numout,*) '      ===>>   Rotated laplacian operator (standard)'
185         CASE( np_lap_it )   ;   WRITE(numout,*) '      ===>>   Rotated laplacian operator (triad)'
186         CASE( np_blp    )   ;   WRITE(numout,*) '      ===>>   bilaplacian iso-level operator'
187         CASE( np_blp_i  )   ;   WRITE(numout,*) '      ===>>   Rotated bilaplacian operator (standard)'
188         CASE( np_blp_it )   ;   WRITE(numout,*) '      ===>>   Rotated bilaplacian operator (triad)'
189         END SELECT
190      ENDIF
191      !
192   END SUBROUTINE trc_ldf_ini
193
194#endif
195   !!======================================================================
196END MODULE trcldf
Note: See TracBrowser for help on using the repository browser.