Skip to content
Snippets Groups Projects
Commit 2a26fa92 authored by Sebastien Masson's avatar Sebastien Masson
Browse files

Merge branch '16-remove-tmask_h' into 'main'

16-remove-tmask_h: do it

Closes #16

See merge request nemo/core!26
parents 4d3c97ac 4dd5e6f2
No related branches found
No related tags found
No related merge requests found
......@@ -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)
......
......@@ -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) )
!
......
......@@ -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 )
......
......@@ -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)
! ---------------------------------------
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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 )
!!----------------------------------------------------------------------
......
......@@ -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 )
......
......@@ -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' )
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment