From 4dd5e6f2b7a9239ea06b3a0a8e442937071e5039 Mon Sep 17 00:00:00 2001
From: sebastien masson <smasson@amphitrite.locean-ipsl.upmc.fr>
Date: Fri, 11 Feb 2022 15:23:02 +0100
Subject: [PATCH] 16-remove-tmask_h: do it
---
src/OCE/DIA/diahsb.F90 | 10 +--
src/OCE/DOM/dom_oce.F90 | 5 +-
src/OCE/DOM/domain.F90 | 2 +-
src/OCE/DOM/dommsk.F90 | 12 +--
src/OCE/DOM/domutl.F90 | 8 +-
src/OCE/ISF/isfcpl.F90 | 2 +-
src/OCE/ISF/isfutils.F90 | 2 +-
src/OCE/lib_fortran.F90 | 111 +---------------------------
src/OCE/lib_fortran_generic.h90 | 5 --
tests/DIA_GPU/MY_SRC/diahsb_gpu.h90 | 14 ++--
10 files changed, 26 insertions(+), 145 deletions(-)
diff --git a/src/OCE/DIA/diahsb.F90 b/src/OCE/DIA/diahsb.F90
index f8d6e5c0c..f9307c0af 100644
--- a/src/OCE/DIA/diahsb.F90
+++ b/src/OCE/DIA/diahsb.F90
@@ -149,7 +149,7 @@ CONTAINS
! --------------------------------- !
! 2 - Content variations with ssh !
! --------------------------------- !
- ! glob_sum_full is needed because you keep the full interior domain to compute the sum (iscpl)
+ ! glob_sum is needed because you keep only the interior domain to compute the sum (iscpl)
!
! ! volume variation (calculated with ssh)
ztmp(:,:,11) = surf(:,:)*ssh(:,:,Kmm) - surf_ini(:,:)*ssh_ini(:,:)
@@ -170,7 +170,7 @@ CONTAINS
ENDIF
! global sum
- zbg(11:13) = glob_sum_full_vec( 'dia_hsb', ztmp(:,:,11:13) )
+ zbg(11:13) = glob_sum_vec( 'dia_hsb', ztmp(:,:,11:13) )
zdiff_v1 = zbg(11)
! ! heat & salt content variation (associated with ssh)
@@ -182,7 +182,7 @@ CONTAINS
! --------------------------------- !
! 3 - Content variations with e3t !
! --------------------------------- !
- ! glob_sum_full is needed because you keep the full interior domain to compute the sum (iscpl)
+ ! glob_sum is needed because you keep only the interior domain to compute the sum (iscpl)
!
DO jk = 1, jpkm1 ! volume
ztmpk(:,:,jk,1) = surf (:,:) * e3t(:,:,jk,Kmm)*tmask(:,:,jk) &
@@ -201,9 +201,9 @@ CONTAINS
END DO
! global sum
- zbg(14:17) = glob_sum_full_vec( 'dia_hsb', ztmpk(:,:,:,1:4) )
+ zbg(14:17) = glob_sum_vec( 'dia_hsb', ztmpk(:,:,:,1:4) )
- zdiff_v2 = zbg(14) ! glob_sum_full needed as tmask and tmask_ini could be different
+ zdiff_v2 = zbg(14) ! glob_sum needed as tmask and tmask_ini could be different
zdiff_hc = zbg(15)
zdiff_sc = zbg(16)
zvol_tot = zbg(17)
diff --git a/src/OCE/DOM/dom_oce.F90 b/src/OCE/DOM/dom_oce.F90
index a978ef192..9cfa0f0c3 100644
--- a/src/OCE/DOM/dom_oce.F90
+++ b/src/OCE/DOM/dom_oce.F90
@@ -191,8 +191,7 @@ MODULE dom_oce
! INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbk_t, mbk_u, mbk_v !: bottom last wet T-, U-, and V-level
!!gm
INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbkt, mbku, mbkv, mbkf !: bottom last wet T-, U-, V- and F-level
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmask_i !: interior domain T-point mask
- REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmask_h !: internal domain T-point mask (Figure 8.5 NEMO book)
+ REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmask_i !: interior (excluding halos+duplicated points) domain T-point mask
INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mikt, miku, mikv, mikf !: top first wet T-, U-, V-, F-level (ISF)
@@ -326,7 +325,7 @@ CONTAINS
ALLOCATE( risfdep(jpi,jpj) , bathy(jpi,jpj) , STAT=ierr(ii) )
!
ii = ii+1
- ALLOCATE( tmask_i(jpi,jpj) , tmask_h(jpi,jpj) , &
+ ALLOCATE( tmask_i(jpi,jpj) , &
& ssmask (jpi,jpj) , ssumask(jpi,jpj) , ssvmask(jpi,jpj) , ssfmask(jpi,jpj) , &
& mbkt (jpi,jpj) , mbku (jpi,jpj) , mbkv (jpi,jpj) , mbkf(jpi,jpj) , STAT=ierr(ii) )
!
diff --git a/src/OCE/DOM/domain.F90 b/src/OCE/DOM/domain.F90
index e53cabbe4..65865ee69 100644
--- a/src/OCE/DOM/domain.F90
+++ b/src/OCE/DOM/domain.F90
@@ -532,7 +532,7 @@ CONTAINS
REAL(wp) :: zglmin, zglmax, zgpmin, zgpmax, ze1min, ze1max, ze2min, ze2max
!!----------------------------------------------------------------------
!
- llmsk = tmask_h(:,:) == 1._wp
+ llmsk = tmask_i(:,:) == 1._wp
!
CALL mpp_minloc( 'domain', glamt(:,:), llmsk, zglmin, imil )
CALL mpp_minloc( 'domain', gphit(:,:), llmsk, zgpmin, imip )
diff --git a/src/OCE/DOM/dommsk.F90 b/src/OCE/DOM/dommsk.F90
index f153b531a..3d349e1f1 100644
--- a/src/OCE/DOM/dommsk.F90
+++ b/src/OCE/DOM/dommsk.F90
@@ -77,9 +77,7 @@ CONTAINS
!! fmask : land/ocean mask at f-point (=0., or =1., or
!! =rn_shlat along lateral boundaries)
!! ssmask , ssumask, ssvmask, ssfmask : 2D ocean mask, i.e. at least 1 wet cell in the vertical
- !! tmask_h : halo mask at t-point, i.e. excluding all duplicated rows/lines
- !! due to cyclic or North Fold boundaries as well as MPP halos.
- !! tmask_i : ssmask * tmask_h
+ !! tmask_i : ssmask * ( excludes halo+duplicated points (NP folding) )
!!----------------------------------------------------------------------
INTEGER, DIMENSION(:,:), INTENT(in) :: k_top, k_bot ! first and last ocean level
!
@@ -192,13 +190,11 @@ CONTAINS
ENDIF
fe3mask(:,:,:) = fmask(:,:,:)
- ! Interior domain mask (used for global sum)
+ ! Interior domain mask (used for global sum) : 2D ocean mask x (halo+duplicated points) mask
! --------------------
!
- CALL dom_uniq( tmask_h, 'T' )
- !
- ! ! interior mask : 2D ocean mask x halo mask
- tmask_i(:,:) = ssmask(:,:) * tmask_h(:,:)
+ CALL dom_uniq( tmask_i, 'T' )
+ tmask_i(:,:) = ssmask(:,:) * tmask_i(:,:)
! Lateral boundary conditions on velocity (modify fmask)
! ---------------------------------------
diff --git a/src/OCE/DOM/domutl.F90 b/src/OCE/DOM/domutl.F90
index 7235715e0..0c56f8f1f 100644
--- a/src/OCE/DOM/domutl.F90
+++ b/src/OCE/DOM/domutl.F90
@@ -60,10 +60,10 @@ CONTAINS
IF ( PRESENT(kkk) ) ik=kkk
!
SELECT CASE( cdgrid )
- CASE( 'U' ) ; zglam(:,:) = glamu(:,:) ; zgphi(:,:) = gphiu(:,:) ; llmsk(:,:) = tmask_h(:,:) * umask(:,:,ik) == 1._wp
- CASE( 'V' ) ; zglam(:,:) = glamv(:,:) ; zgphi(:,:) = gphiv(:,:) ; llmsk(:,:) = tmask_h(:,:) * vmask(:,:,ik) == 1._wp
- CASE( 'F' ) ; zglam(:,:) = glamf(:,:) ; zgphi(:,:) = gphif(:,:) ; llmsk(:,:) = tmask_h(:,:) * fmask(:,:,ik) == 1._wp
- CASE DEFAULT; zglam(:,:) = glamt(:,:) ; zgphi(:,:) = gphit(:,:) ; llmsk(:,:) = tmask_h(:,:) * tmask(:,:,ik) == 1._wp
+ CASE( 'U' ) ; zglam(:,:) = glamu(:,:) ; zgphi(:,:) = gphiu(:,:) ; llmsk(:,:) = tmask_i(:,:) * umask(:,:,ik) == 1._wp
+ CASE( 'V' ) ; zglam(:,:) = glamv(:,:) ; zgphi(:,:) = gphiv(:,:) ; llmsk(:,:) = tmask_i(:,:) * vmask(:,:,ik) == 1._wp
+ CASE( 'F' ) ; zglam(:,:) = glamf(:,:) ; zgphi(:,:) = gphif(:,:) ; llmsk(:,:) = tmask_i(:,:) * fmask(:,:,ik) == 1._wp
+ CASE DEFAULT; zglam(:,:) = glamt(:,:) ; zgphi(:,:) = gphit(:,:) ; llmsk(:,:) = tmask_i(:,:) * tmask(:,:,ik) == 1._wp
END SELECT
!
zlon = MOD( plon + 720., 360. ) ! plon between 0 and 360
diff --git a/src/OCE/ISF/isfcpl.F90 b/src/OCE/ISF/isfcpl.F90
index 682bed16a..b035cd5e6 100644
--- a/src/OCE/ISF/isfcpl.F90
+++ b/src/OCE/ISF/isfcpl.F90
@@ -732,7 +732,7 @@ CONTAINS
IF ( PRESENT(kfind) ) THEN
ifind = kfind
ELSE
- ifind = ( 1 - tmask_h(ki,kj) ) * tmask(ki,kj,kk)
+ ifind = ( 1 - tmask_i(ki,kj) ) * tmask(ki,kj,kk)
END IF
!
! update isfpts structure
diff --git a/src/OCE/ISF/isfutils.F90 b/src/OCE/ISF/isfutils.F90
index ccb53a6be..63c489c59 100644
--- a/src/OCE/ISF/isfutils.F90
+++ b/src/OCE/ISF/isfutils.F90
@@ -14,7 +14,7 @@ MODULE isfutils
USE iom , ONLY: iom_open, iom_get, iom_close, jpdom_global ! read input file
USE lib_fortran , ONLY: glob_sum, glob_min, glob_max ! compute global value
USE par_oce , ONLY: jpi,jpj,jpk, jpnij, Nis0, Nie0, Njs0, Nje0 ! domain size
- USE dom_oce , ONLY: narea, tmask_h, tmask_i ! local domain
+ USE dom_oce , ONLY: narea ! local domain
USE in_out_manager, ONLY: i8, wp, lwp, numout ! miscelenious
USE lib_mpp
diff --git a/src/OCE/lib_fortran.F90 b/src/OCE/lib_fortran.F90
index c66c0fa1e..38a16862d 100644
--- a/src/OCE/lib_fortran.F90
+++ b/src/OCE/lib_fortran.F90
@@ -25,14 +25,12 @@ MODULE lib_fortran
IMPLICIT NONE
PRIVATE
- PUBLIC glob_sum ! used in many places (masked with tmask_i = ssmask * tmask_h)
- PUBLIC glob_sum_full ! used in many places (masked with tmask_h, excluding all duplicated points halos+periodicity)
+ PUBLIC glob_sum ! used in many places (masked with tmask_i = ssmask * (excludes halo+duplicated points (NP folding)) )
PUBLIC local_sum ! used in trcrad, local operation before glob_sum_delay
PUBLIC sum3x3 ! used in trcrad, do a sum over 3x3 boxes
PUBLIC DDPDD ! also used in closea module
PUBLIC glob_min, glob_max
PUBLIC glob_sum_vec
- PUBLIC glob_sum_full_vec
PUBLIC glob_min_vec, glob_max_vec
#if defined key_nosignedzero
PUBLIC SIGN
@@ -41,9 +39,6 @@ MODULE lib_fortran
INTERFACE glob_sum
MODULE PROCEDURE glob_sum_1d, glob_sum_2d, glob_sum_3d
END INTERFACE
- INTERFACE glob_sum_full
- MODULE PROCEDURE glob_sum_full_2d, glob_sum_full_3d
- END INTERFACE
INTERFACE local_sum
MODULE PROCEDURE local_sum_2d, local_sum_3d
END INTERFACE
@@ -59,9 +54,6 @@ MODULE lib_fortran
INTERFACE glob_sum_vec
MODULE PROCEDURE glob_sum_vec_3d, glob_sum_vec_4d
END INTERFACE
- INTERFACE glob_sum_full_vec
- MODULE PROCEDURE glob_sum_full_vec_3d, glob_sum_full_vec_4d
- END INTERFACE
INTERFACE glob_min_vec
MODULE PROCEDURE glob_min_vec_3d, glob_min_vec_4d
END INTERFACE
@@ -100,11 +92,6 @@ CONTAINS
# include "lib_fortran_generic.h90"
# undef FUNCTION_GLOBSUM
# undef OPERATION_GLOBSUM
-# define OPERATION_FULL_GLOBSUM
-# define FUNCTION_GLOBSUM glob_sum_full_2d
-# include "lib_fortran_generic.h90"
-# undef FUNCTION_GLOBSUM
-# undef OPERATION_FULL_GLOBSUM
# undef DIM_2d
# define DIM_3d
@@ -113,11 +100,6 @@ CONTAINS
# include "lib_fortran_generic.h90"
# undef FUNCTION_GLOBSUM
# undef OPERATION_GLOBSUM
-# define OPERATION_FULL_GLOBSUM
-# define FUNCTION_GLOBSUM glob_sum_full_3d
-# include "lib_fortran_generic.h90"
-# undef FUNCTION_GLOBSUM
-# undef OPERATION_FULL_GLOBSUM
# undef DIM_3d
# undef GLOBSUM_CODE
@@ -417,97 +399,6 @@ CONTAINS
DEALLOCATE( ctmp )
!
END FUNCTION glob_sum_vec_4d
-
- FUNCTION glob_sum_full_vec_3d( cdname, ptab ) RESULT( ptmp )
- !!----------------------------------------------------------------------
- CHARACTER(len=*), INTENT(in) :: cdname ! name of the calling subroutine
- REAL(wp), INTENT(in) :: ptab(:,:,:) ! array on which operation is applied
- REAL(wp), DIMENSION(SIZE(ptab,3)) :: ptmp
- !
- COMPLEX(dp), DIMENSION(:), ALLOCATABLE :: ctmp
- REAL(wp) :: ztmp
- INTEGER :: ji , jj , jk ! dummy loop indices
- INTEGER :: ipi, ipj, ipk ! dimensions
- INTEGER :: iis, iie, ijs, ije ! loop start and end
- !!-----------------------------------------------------------------------
- !
- ipi = SIZE(ptab,1) ! 1st dimension
- ipj = SIZE(ptab,2) ! 2nd dimension
- ipk = SIZE(ptab,3) ! 3rd dimension
- !
- IF( ipi == jpi .AND. ipj == jpj ) THEN ! do 2D loop only over the inner domain (-> avoid to use undefined values)
- iis = Nis0 ; iie = Nie0
- ijs = Njs0 ; ije = Nje0
- ELSE ! I think we are never in this case...
- iis = 1 ; iie = jpi
- ijs = 1 ; ije = jpj
- ENDIF
- !
- ALLOCATE( ctmp(ipk) )
- !
- DO jk = 1, ipk
- ctmp(jk) = CMPLX( 0.e0, 0.e0, dp ) ! warning ctmp is cumulated
- DO jj = ijs, ije
- DO ji = iis, iie
- ztmp = ptab(ji,jj,jk) * tmask_h(ji,jj)
- CALL DDPDD( CMPLX( ztmp, 0.e0, dp ), ctmp(jk) )
- END DO
- END DO
- END DO
- CALL mpp_sum( cdname, ctmp(:) ) ! sum over the global domain
- !
- ptmp = REAL( ctmp(:), wp )
- !
- DEALLOCATE( ctmp )
- !
- END FUNCTION glob_sum_full_vec_3d
-
- FUNCTION glob_sum_full_vec_4d( cdname, ptab ) RESULT( ptmp )
- !!----------------------------------------------------------------------
- CHARACTER(len=*), INTENT(in) :: cdname ! name of the calling subroutine
- REAL(wp), INTENT(in) :: ptab(:,:,:,:) ! array on which operation is applied
- REAL(wp), DIMENSION(SIZE(ptab,4)) :: ptmp
- !
- COMPLEX(dp), DIMENSION(:), ALLOCATABLE :: ctmp
- REAL(wp) :: ztmp
- INTEGER :: ji , jj , jk , jl ! dummy loop indices
- INTEGER :: ipi, ipj, ipk, ipl ! dimensions
- INTEGER :: iis, iie, ijs, ije ! loop start and end
- !!-----------------------------------------------------------------------
- !
- ipi = SIZE(ptab,1) ! 1st dimension
- ipj = SIZE(ptab,2) ! 2nd dimension
- ipk = SIZE(ptab,3) ! 3rd dimension
- ipl = SIZE(ptab,4) ! 4th dimension
- !
- IF( ipi == jpi .AND. ipj == jpj ) THEN ! do 2D loop only over the inner domain (-> avoid to use undefined values)
- iis = Nis0 ; iie = Nie0
- ijs = Njs0 ; ije = Nje0
- ELSE ! I think we are never in this case...
- iis = 1 ; iie = jpi
- ijs = 1 ; ije = jpj
- ENDIF
- !
- ALLOCATE( ctmp(ipl) )
- !
- DO jl = 1, ipl
- ctmp(jl) = CMPLX( 0.e0, 0.e0, dp ) ! warning ctmp is cumulated
- DO jk = 1, ipk
- DO jj = ijs, ije
- DO ji = iis, iie
- ztmp = ptab(ji,jj,jk,jl) * tmask_h(ji,jj)
- CALL DDPDD( CMPLX( ztmp, 0.e0, dp ), ctmp(jl) )
- END DO
- END DO
- END DO
- END DO
- CALL mpp_sum( cdname, ctmp(:) ) ! sum over the global domain
- !
- ptmp = REAL( ctmp(:), wp )
- !
- DEALLOCATE( ctmp )
- !
- END FUNCTION glob_sum_full_vec_4d
FUNCTION glob_min_vec_3d( cdname, ptab ) RESULT( ptmp )
!!----------------------------------------------------------------------
diff --git a/src/OCE/lib_fortran_generic.h90 b/src/OCE/lib_fortran_generic.h90
index 98ba45f16..92f136e82 100644
--- a/src/OCE/lib_fortran_generic.h90
+++ b/src/OCE/lib_fortran_generic.h90
@@ -21,12 +21,7 @@
# define ARRAY2_IN(i,j,k) ptab2(i,j,k)
# define J_SIZE(ptab) SIZE(ptab,2)
# define K_SIZE(ptab) SIZE(ptab,3)
-# endif
-# if defined OPERATION_GLOBSUM
# define MASK_ARRAY(i,j) tmask_i(i,j)
-# endif
-# if defined OPERATION_FULL_GLOBSUM
-# define MASK_ARRAY(i,j) tmask_h(i,j)
# endif
FUNCTION FUNCTION_GLOBSUM( cdname, ptab )
diff --git a/tests/DIA_GPU/MY_SRC/diahsb_gpu.h90 b/tests/DIA_GPU/MY_SRC/diahsb_gpu.h90
index 1d359b7ce..1c81ddb91 100644
--- a/tests/DIA_GPU/MY_SRC/diahsb_gpu.h90
+++ b/tests/DIA_GPU/MY_SRC/diahsb_gpu.h90
@@ -59,7 +59,7 @@ MODULE diahsb
!Device data associate to PUBLIC arrays
REAL(8), DIMENSION(:,:,:,:) , ALLOCATABLE, DEVICE :: d_e3t !
REAL(8), DIMENSION(:,:,:) , ALLOCATABLE, DEVICE :: d_tmask !
- REAL(8), DIMENSION(:,:) , ALLOCATABLE, DEVICE :: d_tmask_h !
+ REAL(8), DIMENSION(:,:) , ALLOCATABLE, DEVICE :: d_tmask_i !
REAL(8), DIMENSION(:,:,:) , ALLOCATABLE, DEVICE :: d_tmask_ini !
REAL(8), DIMENSION(:,:,:,:,:), ALLOCATABLE, DEVICE :: d_ts !
!Device data associate to LOCAL/DEVICE arrays
@@ -237,10 +237,10 @@ CONTAINS
& d_ts, d_hc_loc_ini, d_sc_loc_ini, d_tmask, d_tmask_ini, d_zwrkv, d_zwrkh, d_zwrks, d_zwrk, jpi, jpj, jpk, jpt, Kmm)
- CALL filter_cuda<<<dimGrid, dimBlock, 0, str>>>(d_zwrkv , d_tmask_h , jpi, jpj, jpk)
- CALL filter_cuda<<<dimGrid, dimBlock, 0, str>>>(d_zwrkh , d_tmask_h , jpi, jpj, jpk)
- CALL filter_cuda<<<dimGrid, dimBlock, 0, str>>>(d_zwrks , d_tmask_h , jpi, jpj, jpk)
- CALL filter_cuda<<<dimGrid, dimBlock, 0, str>>>(d_zwrk , d_tmask_h , jpi, jpj, jpk)
+ CALL filter_cuda<<<dimGrid, dimBlock, 0, str>>>(d_zwrkv , d_tmask_i , jpi, jpj, jpk)
+ CALL filter_cuda<<<dimGrid, dimBlock, 0, str>>>(d_zwrkh , d_tmask_i , jpi, jpj, jpk)
+ CALL filter_cuda<<<dimGrid, dimBlock, 0, str>>>(d_zwrks , d_tmask_i , jpi, jpj, jpk)
+ CALL filter_cuda<<<dimGrid, dimBlock, 0, str>>>(d_zwrk , d_tmask_i , jpi, jpj, jpk)
ztmpv = 0.e0
ztmph = 0.e0
@@ -597,7 +597,7 @@ CONTAINS
ALLOCATE(d_e3t (jpi,jpj,jpk,jpt) ) !
ALLOCATE(d_tmask (jpi,jpj,jpk) ) !
ALLOCATE(d_tmask_ini (jpi,jpj,jpk) ) !
- ALLOCATE(d_tmask_h (jpi,jpj) ) !
+ ALLOCATE(d_tmask_i (jpi,jpj) ) !
ALLOCATE(d_ts (jpi,jpj,jpk,2,jpj) ) !
!Device data associate to LOCAL/DEVICE arrays !
ALLOCATE(d_surf (jpi,jpj) ) !
@@ -647,7 +647,7 @@ CONTAINS
d_e3t_ini = e3t_ini
d_tmask = tmask
d_tmask_ini = tmask_ini
- d_tmask_h = tmask_h
+ d_tmask_i = tmask_i
h_ztmp = 0.0
IF( ln_bdy ) CALL ctl_warn( 'dia_hsb_init: heat/salt budget does not consider open boundary fluxes' )
--
GitLab