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.
isfdiags.F90 in NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF – NEMO

source: NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/ISF/isfdiags.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.
File size: 6.1 KB
RevLine 
[11395]1MODULE isfdiags
2   !!======================================================================
[12077]3   !!                       ***  MODULE  isfdiags  ***
4   !! ice shelf diagnostics module :  manage the 2d and 3d flux outputs from the ice shelf module
[11395]5   !!======================================================================
6   !! History :  3.2  !  2011-02  (C.Harris  ) Original code isf cav
7   !!            X.X  !  2006-02  (C. Wang   ) Original code bg03
8   !!            3.4  !  2013-03  (P. Mathiot) Merging + parametrization
9   !!----------------------------------------------------------------------
10
11   !!----------------------------------------------------------------------
12   !!   sbc_isf       : update sbc under ice shelf
13   !!----------------------------------------------------------------------
14
15   USE in_out_manager ! I/O manager
16   USE dom_oce
[12077]17   USE isf_oce        ! ice shelf variable
[11395]18   USE iom            !
19
20   IMPLICIT NONE
21
22   PRIVATE
23
24   PUBLIC   isf_diags_flx
25
[12340]26   !! * Substitutions
27#  include "do_loop_substitute.h90"
[11395]28   !!----------------------------------------------------------------------
29   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
30   !! $Id: sbcisf.F90 10536 2019-01-16 19:21:09Z mathiot $
31   !! Software governed by the CeCILL license (see ./LICENSE)
32   !!----------------------------------------------------------------------
33
34CONTAINS
35
[12068]36   SUBROUTINE isf_diags_flx(Kmm, ktop, kbot, phtbl, pfrac, cdisf, pqfwf, pqoce, pqlat, pqhc)
[11395]37      !!---------------------------------------------------------------------
[12068]38      !!                  ***  ROUTINE isf_diags_flx ***
[11395]39      !!
[12077]40      !! ** Purpose : manage the 2d and 3d flux outputs of the ice shelf module
41      !!              fwf, latent heat flux, heat content flux, oce->ice heat flux
[11395]42      !!
43      !!----------------------------------------------------------------------
44      !!-------------------------- OUT -------------------------------------
45      !!-------------------------- IN  -------------------------------------
[12068]46      INTEGER,                      INTENT(in) :: Kmm                       ! ocean time level index
[11395]47      INTEGER , DIMENSION(jpi,jpj), INTENT(in) :: ktop , kbot               ! top and bottom level of the tbl
48      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: phtbl, pfrac              ! thickness of the tbl and fraction of last cell affected by the tbl
49      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pqfwf, pqoce, pqlat, pqhc ! 2d var to map in 3d
[11931]50      CHARACTER(LEN=3), INTENT(in) :: cdisf                                 ! parametrisation or interactive melt
[11395]51      !!---------------------------------------------------------------------
52      CHARACTER(LEN=256) :: cvarqfwf  , cvarqoce  , cvarqlat  , cvarqhc
53      CHARACTER(LEN=256) :: cvarqfwf3d, cvarqoce3d, cvarqlat3d, cvarqhc3d
54      !!---------------------------------------------------------------------
55      !
56      ! output melt
57      cvarqfwf = 'fwfisf_'//cdisf  ; cvarqfwf3d = 'fwfisf3d_'//cdisf
58      cvarqoce = 'qoceisf_'//cdisf ; cvarqoce3d = 'qoceisf3d_'//cdisf
59      cvarqlat = 'qlatisf_'//cdisf ; cvarqlat3d = 'qlatisf3d_'//cdisf 
60      cvarqhc  = 'qhcisf_'//cdisf  ; cvarqhc3d  = 'qhcisf3d_'//cdisf
61      !
[12077]62      ! output 2d melt rate, latent heat and heat content flux from the injected water
63      CALL iom_put( TRIM(cvarqfwf), pqfwf(:,:) )   ! mass         flux ( >0 out )
64      CALL iom_put( TRIM(cvarqoce), pqoce(:,:) )   ! oce to ice   flux ( >0 out )
65      CALL iom_put( TRIM(cvarqlat), pqlat(:,:) )   ! latent heat  flux ( >0 out )
66      CALL iom_put( TRIM(cvarqhc) , pqhc (:,:) )   ! heat content flux ( >0 out )
[11395]67      !
68      ! output 3d Diagnostics
[12068]69      IF ( iom_use( TRIM(cvarqfwf3d) ) ) CALL isf_diags_2dto3d( Kmm, ktop, kbot, phtbl, pfrac, TRIM(cvarqfwf3d) , pqfwf(:,:))
70      IF ( iom_use( TRIM(cvarqoce3d) ) ) CALL isf_diags_2dto3d( Kmm, ktop, kbot, phtbl, pfrac, TRIM(cvarqoce3d) , pqoce(:,:))
71      IF ( iom_use( TRIM(cvarqlat3d) ) ) CALL isf_diags_2dto3d( Kmm, ktop, kbot, phtbl, pfrac, TRIM(cvarqlat3d) , pqoce(:,:))
72      IF ( iom_use( TRIM(cvarqhc3d)  ) ) CALL isf_diags_2dto3d( Kmm, ktop, kbot, phtbl, pfrac, TRIM(cvarqhc3d)  , pqhc (:,:))
[11395]73      !
74   END SUBROUTINE
75
[12068]76   SUBROUTINE isf_diags_2dto3d(Kmm, ktop, kbot, phtbl, pfrac, cdvar, pvar2d)
[11395]77      !!---------------------------------------------------------------------
78      !!                  ***  ROUTINE isf_diags_2dto3d ***
79      !!
[12077]80      !! ** Purpose : compute the 3d flux outputs as they are injected into NEMO
81      !!              (ie uniformaly spread into the top boundary layer or parametrisation layer)
[11395]82      !!
83      !!----------------------------------------------------------------------
84      !!-------------------------- OUT -------------------------------------
85      !!-------------------------- IN  -------------------------------------
[12068]86      INTEGER,                      INTENT(in) :: Kmm           ! ocean time level index
[11395]87      INTEGER , DIMENSION(jpi,jpj), INTENT(in) :: ktop , kbot   ! top and bottom level of the tbl
88      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: phtbl, pfrac  ! thickness of the tbl and fraction of last cell affected by the tbl
89      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pvar2d        ! 2d var to map in 3d
90      CHARACTER(LEN=256), INTENT(in) :: cdvar
91      !!---------------------------------------------------------------------
92      INTEGER  :: ji, jj, jk                       ! loop indices
93      INTEGER  :: ikt, ikb                         ! top and bottom level of the tbl
94      REAL(wp), DIMENSION(jpi,jpj)     :: zvar2d   !
95      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvar3d   ! 3d var to output
96      !!---------------------------------------------------------------------
97      !
98      ! compute 3d output
99      zvar2d(:,:) = pvar2d(:,:) / phtbl(:,:)
[11521]100      zvar3d(:,:,:) = 0._wp
101      !
[12340]102      DO_2D_11_11
103         ikt = ktop(ji,jj)
104         ikb = kbot(ji,jj)
105         DO jk = ikt, ikb - 1
106            zvar3d(ji,jj,jk) = zvar2d(ji,jj) * e3t(ji,jj,jk,Kmm)
[11395]107         END DO
[12340]108         zvar3d(ji,jj,ikb) = zvar2d(ji,jj) * e3t(ji,jj,ikb,Kmm) * pfrac(ji,jj)
109      END_2D
[11395]110      !
111      CALL iom_put( TRIM(cdvar) , zvar3d(:,:,:))
112      !
113   END SUBROUTINE isf_diags_2dto3d
114
115END MODULE isfdiags
Note: See TracBrowser for help on using the repository browser.