source: NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfdynatf.F90 @ 12340

Last change on this file since 12340 was 12340, checked in by acc, 15 months 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.

File size: 4.3 KB
Line 
1MODULE isfdynatf
2   !!=========================================================================
3   !!                       ***  MODULE  isfnxt  ***
4   !! Ice shelf update: compute the dynatf ice shelf contribution
5   !!=========================================================================
6   !! History :  OPA  !  2019-09  (P. Mathiot)  Original code
7   !!-------------------------------------------------------------------------
8 
9   !!-------------------------------------------------------------------------
10   !!   isfnxt       : apply correction needed for the ice shelf to ensure conservation
11   !!-------------------------------------------------------------------------
12
13   USE isf_oce
14
15   USE phycst , ONLY: r1_rau0         ! physical constant
16   USE dom_oce, ONLY: e3t, r1_e1e2t   ! time and space domain
17
18   USE in_out_manager
19
20   IMPLICIT NONE
21
22   PRIVATE
23
24   PUBLIC isf_dynatf
25   !! * Substitutions
26#  include "do_loop_substitute.h90"
27
28CONTAINS
29
30   SUBROUTINE isf_dynatf ( kt, Kmm, pe3t_f, pcoef )
31      !!--------------------------------------------------------------------
32      !!                  ***  ROUTINE isf_dynatf  ***
33      !!
34      !! ** Purpose : compute the ice shelf volume filter correction for cavity, param, ice sheet coupling case
35      !!
36      !!-------------------------- OUT -------------------------------------
37      INTEGER                         , INTENT(in   ) :: kt       ! ocean time step
38      INTEGER                         , INTENT(in   ) :: Kmm      ! ocean time level index
39      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pe3t_f   ! time filtered scale factor to be corrected
40      !
41      REAL(wp)                        , INTENT(in   ) :: pcoef    ! atfp * rdt * r1_rau0
42      !!--------------------------------------------------------------------
43      INTEGER :: jk  ! loop index
44      !!--------------------------------------------------------------------
45      !
46      ! ice shelf cavity
47      IF ( ln_isfcav_mlt ) CALL isf_dynatf_mlt(Kmm, pe3t_f, misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav, fwfisf_cav, fwfisf_cav_b, pcoef)
48      !
49      ! ice shelf parametrised
50      IF ( ln_isfpar_mlt ) CALL isf_dynatf_mlt(Kmm, pe3t_f, misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par, fwfisf_par, fwfisf_par_b, pcoef)
51      !
52      IF ( ln_isfcpl .AND. ln_rstart .AND. kt == nit000+1 ) THEN
53         DO jk = 1, jpkm1
54            pe3t_f(:,:,jk) =   pe3t_f(:,:,jk) - pcoef * risfcpl_vol(:,:,jk) * r1_e1e2t(:,:)
55         END DO
56      END IF
57      !
58   END SUBROUTINE isf_dynatf
59
60   SUBROUTINE isf_dynatf_mlt ( Kmm, pe3t_f, ktop, kbot, phtbl, pfrac, pfwf, pfwf_b, pcoef )
61      !!--------------------------------------------------------------------
62      !!                  ***  ROUTINE isf_dynatf_mlt  ***
63      !!
64      !! ** Purpose : compute the ice shelf volume filter correction for cavity or param
65      !!
66      !!-------------------------- IN  -------------------------------------
67      INTEGER                         , INTENT(in   ) :: Kmm             ! ocean time level index
68      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pe3t_f          ! time-filtered scale factor to be corrected
69      INTEGER , DIMENSION(jpi,jpj)    , INTENT(in   ) :: ktop , kbot     ! top and bottom level of tbl
70      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in   ) :: pfrac, phtbl    ! fraction of bottom cell included in tbl, tbl thickness
71      REAL(wp), DIMENSION(jpi,jpj)    , INTENT(in   ) :: pfwf , pfwf_b   ! now/before fwf
72      REAL(wp),                         INTENT(in   ) :: pcoef           ! atfp * rdt * r1_rau0
73      !!----------------------------------------------------------------------
74      INTEGER :: ji,jj,jk
75      REAL(wp), DIMENSION(jpi,jpj) :: zfwfinc
76      !!----------------------------------------------------------------------
77      !
78      ! compute fwf conservation correction
79      zfwfinc(:,:) = pcoef * ( pfwf_b(:,:) - pfwf(:,:) ) / phtbl(:,:) * r1_rau0
80      !
81      ! add the increment in the tbl
82      DO_3D_11_11( 1, jpkm1 )
83         IF( ktop(ji,jj) <= jk .AND. jk < kbot(ji,jj)  ) THEN
84            pe3t_f(ji,jj,jk) = pe3t_f(ji,jj,jk) - zfwfinc(ji,jj) * e3t(ji,jj,jk,Kmm)
85         ELSEIF ( jk == kbot(ji,jj) ) THEN
86            pe3t_f(ji,jj,jk) = pe3t_f(ji,jj,jk) - zfwfinc(ji,jj) * e3t(ji,jj,jk,Kmm) * pfrac(ji,jj)
87         ENDIF
88      END_3D
89      !
90   END SUBROUTINE isf_dynatf_mlt
91
92END MODULE isfdynatf
Note: See TracBrowser for help on using the repository browser.