Forked from
NEMO Workspace / Nemo
951 commits behind, 66 commits ahead of the upstream repository.
-
Sebastien MASSON authored5ab7d9dd
Code owners
Assign users and groups as approvers for specific file changes. Learn more.
domtile.F90 11.94 KiB
MODULE domtile
!!======================================================================
!! *** MODULE domtile ***
!! Tiling utilities
!!======================================================================
!! History : 4.2 ! 2020-12 (D. Calvert) Original code
!!----------------------------------------------------------------------
!!----------------------------------------------------------------------
!! dom_tile : Set/initialise the current tile and domain indices
!!----------------------------------------------------------------------
USE dom_oce ! ocean space and time domain
!
USE prtctl ! Print control (prt_ctl_info routine)
USE lib_mpp , ONLY : ctl_stop, ctl_warn
USE in_out_manager ! I/O manager
IMPLICIT NONE
PRIVATE
PUBLIC dom_tile ! called by step.F90
PUBLIC dom_tile_start ! called by various
PUBLIC dom_tile_stop ! " "
PUBLIC dom_tile_init ! called by domain.F90
LOGICAL, ALLOCATABLE, DIMENSION(:) :: l_tilefin ! whether a tile is finished or not
!!----------------------------------------------------------------------
!! NEMO/OCE 4.2 , NEMO Consortium (2020)
!! $Id: domtile.F90 13982 2020-12-04 10:57:05Z hadcv $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
SUBROUTINE dom_tile_init
!!----------------------------------------------------------------------
!! *** ROUTINE dom_tile_init ***
!!
!! ** Purpose : Initialise tile domain variables
!!
!! ** Action : - ntsi, ntsj : start of internal part of domain
!! - ntei, ntej : end of internal part of domain
!! - ntile : current tile number
!! - nijtile : total number of tiles
!! - nthl, nthr : modifier on DO loop macro bound offset (left, right)
!! - nthb, ntht : " " (bottom, top)
!! - l_istiled : whether tiling is currently active or not
!! - l_tilefin : whether a tile is finished or not
!!----------------------------------------------------------------------
INTEGER :: jt ! dummy loop argument
INTEGER :: iitile, ijtile ! Local integers
!!----------------------------------------------------------------------
IF( ln_tile .AND. nn_hls /= 2 ) CALL ctl_stop('dom_tile_init: Tiling is only supported for nn_hls = 2')
l_istiled = .FALSE.
IF( ln_tile ) THEN ! Calculate tile domain indices
iitile = Ni_0 / nn_ltile_i ! Number of tiles
ijtile = Nj_0 / nn_ltile_j
IF( MOD( Ni_0, nn_ltile_i ) /= 0 ) iitile = iitile + 1
IF( MOD( Nj_0, nn_ltile_j ) /= 0 ) ijtile = ijtile + 1
nijtile = iitile * ijtile
ALLOCATE( ntsi_a(0:nijtile), ntsj_a(0:nijtile), ntei_a(0:nijtile), ntej_a(0:nijtile), l_tilefin(nijtile) )
l_tilefin(:) = .FALSE.
ntsi_a(0) = Nis0 ! Full domain
ntsj_a(0) = Njs0
ntei_a(0) = Nie0 ntej_a(0) = Nje0
DO jt = 1, nijtile ! Tile domains
ntsi_a(jt) = Nis0 + nn_ltile_i * MOD(jt - 1, iitile)
ntsj_a(jt) = Njs0 + nn_ltile_j * ((jt - 1) / iitile)
ntei_a(jt) = MIN(ntsi_a(jt) + nn_ltile_i - 1, Nie0)
ntej_a(jt) = MIN(ntsj_a(jt) + nn_ltile_j - 1, Nje0)
ENDDO
ENDIF
IF(lwp) THEN ! control print
WRITE(numout,*)
WRITE(numout,*) 'dom_tile : Domain tiling decomposition'
WRITE(numout,*) '~~~~~~~~'
IF( ln_tile ) THEN
WRITE(numout,*) iitile, 'tiles in i'
WRITE(numout,*) ' Starting indices'
WRITE(numout,*) ' ', (ntsi_a(jt), jt=1, iitile)
WRITE(numout,*) ' Ending indices'
WRITE(numout,*) ' ', (ntei_a(jt), jt=1, iitile)
WRITE(numout,*) ijtile, 'tiles in j'
WRITE(numout,*) ' Starting indices'
WRITE(numout,*) ' ', (ntsj_a(jt), jt=1, nijtile, iitile)
WRITE(numout,*) ' Ending indices'
WRITE(numout,*) ' ', (ntej_a(jt), jt=1, nijtile, iitile)
ELSE
WRITE(numout,*) 'No domain tiling'
WRITE(numout,*) ' i indices =', ntsi, ':', ntei
WRITE(numout,*) ' j indices =', ntsj, ':', ntej
ENDIF
ENDIF
END SUBROUTINE dom_tile_init
SUBROUTINE dom_tile( ktsi, ktsj, ktei, ktej, ktile, ldhold, cstr )
!!----------------------------------------------------------------------
!! *** ROUTINE dom_tile ***
!!
!! ** Purpose : Set the current tile and its domain indices
!!
!! ** Action : - ktsi, ktsj : start of internal part of domain
!! - ktei, ktej : end of internal part of domain
!! - nthl, nthr : modifier on DO loop macro bound offset (left, right)
!! - nthb, ntht : " " (bottom, top)
!! - ktile : set the current tile number (ntile)
!!----------------------------------------------------------------------
INTEGER, INTENT(out) :: ktsi, ktsj, ktei, ktej ! Tile domain indices
INTEGER, INTENT(in) :: ktile ! Tile number
LOGICAL, INTENT(in), OPTIONAL :: ldhold ! Pause/resume (.true.) or set (.false.) current tile
CHARACTER(len=*), INTENT(in), OPTIONAL :: cstr ! Debug information (added to warnings)
CHARACTER(len=23) :: clstr
LOGICAL :: llhold
CHARACTER(len=11) :: charout
INTEGER :: iitile
!!----------------------------------------------------------------------
llhold = .FALSE.
IF( PRESENT(ldhold) ) llhold = ldhold
clstr = ''
IF( PRESENT(cstr) ) clstr = TRIM(' ('//TRIM(cstr)//')')
IF( .NOT. ln_tile ) CALL ctl_stop('Cannot use dom_tile with ln_tile = .false.')
IF( .NOT. llhold ) THEN
IF( .NOT. l_istiled ) THEN
CALL ctl_warn('Cannot call dom_tile when tiling is inactive'//clstr)
RETURN
ENDIF
IF( ntile /= 0 ) l_tilefin(ntile) = .TRUE. ! If setting a new tile, the current tile is complete
ntile = ktile ! Set the new tile IF(sn_cfctl%l_prtctl) THEN
WRITE(charout, FMT="('ntile =', I4)") ntile
CALL prt_ctl_info( charout )
ENDIF
ENDIF
ktsi = ntsi_a(ktile) ! Set the domain indices
ktsj = ntsj_a(ktile)
ktei = ntei_a(ktile)
ktej = ntej_a(ktile)
! Calculate the modifying factor on DO loop bounds (1 = do not work on points that have already been processed by a neighbouring tile)
nthl = 0 ; nthr = 0 ; nthb = 0 ; ntht = 0
iitile = Ni_0 / nn_ltile_i
IF( MOD( Ni_0, nn_ltile_i ) /= 0 ) iitile = iitile + 1
IF( ktsi > Nis0 ) THEN ; IF( l_tilefin(ktile - 1 ) ) nthl = 1 ; ENDIF ! Left adjacent tile
IF( ktei < Nie0 ) THEN ; IF( l_tilefin(ktile + 1 ) ) nthr = 1 ; ENDIF ! Right " "
IF( ktsj > Njs0 ) THEN ; IF( l_tilefin(ktile - iitile) ) nthb = 1 ; ENDIF ! Bottom " "
IF( ktej < Nje0 ) THEN ; IF( l_tilefin(ktile + iitile) ) ntht = 1 ; ENDIF ! Top " "
END SUBROUTINE dom_tile
SUBROUTINE dom_tile_start( ldhold, cstr )
!!----------------------------------------------------------------------
!! *** ROUTINE dom_tile_start ***
!!
!! ** Purpose : Start or resume the use of tiling
!!
!! ** Method : dom_tile_start & dom_tile_stop are used to declare a tiled region of code.
!!
!! Tiling is active/inactive (l_istiled = .true./.false.) within/outside of this code region.
!! After enabling tiling, no tile will initially be set (the full domain will be used) and dom_tile must
!! be called to set a specific tile to work on. Furthermore, all tiles will be marked as incomplete
!! (ln_tilefin(:) = .false.).
!!
!! Tiling can be paused/resumed within the tiled code region by calling dom_tile_stop/dom_tile_start
!! with ldhold = .true.. This can be used to temporarily revert back to using the full domain.
!!
!! CALL dom_tile_start ! Enable tiling
!! CALL dom_tile(ntsi, ntei, ntsj, ntej, ktile=n) ! Set current tile "n"
!! ...
!! CALL dom_tile_stop(.TRUE.) ! Pause tiling (temporarily disable)
!! ...
!! CALL dom_tile_start(.TRUE.) ! Resume tiling
!! CALL dom_tile_stop ! Disable tiling
!!----------------------------------------------------------------------
LOGICAL, INTENT(in), OPTIONAL :: ldhold ! Resume (.true.) or start (.false.)
LOGICAL :: llhold
CHARACTER(len=*), INTENT(in), OPTIONAL :: cstr ! Debug information (added to warnings)
CHARACTER(len=23) :: clstr
!!----------------------------------------------------------------------
llhold = .FALSE.
IF( PRESENT(ldhold) ) llhold = ldhold
clstr = ''
IF( PRESENT(cstr) ) clstr = TRIM(' ('//TRIM(cstr)//')')
IF( .NOT. ln_tile ) CALL ctl_stop('Cannot resume/start tiling as ln_tile = .false.')
IF( l_istiled ) THEN
CALL ctl_warn('Cannot resume/start tiling as it is already active'//clstr)
RETURN
! TODO: [tiling] this warning will always be raised outside a tiling loop (cannot check for pause rather than stop)
ELSE IF( llhold .AND. ntile == 0 ) THEN
CALL ctl_warn('Cannot resume tiling as it is not paused'//clstr)
RETURN
ENDIF
! Whether resumed or started, the tiling is made active. If resumed, the domain indices for the current tile are used.
IF( llhold ) CALL dom_tile(ntsi, ntsj, ntei, ntej, ktile=ntile, ldhold=.TRUE., cstr='dom_tile_start'//clstr)
l_istiled = .TRUE.
END SUBROUTINE dom_tile_start
SUBROUTINE dom_tile_stop( ldhold, cstr )
!!----------------------------------------------------------------------
!! *** ROUTINE dom_tile_stop ***
!!
!! ** Purpose : End or pause the use of tiling
!!
!! ** Method : See dom_tile_start
!!----------------------------------------------------------------------
LOGICAL, INTENT(in), OPTIONAL :: ldhold ! Pause (.true.) or stop (.false.)
LOGICAL :: llhold
CHARACTER(len=*), INTENT(in), OPTIONAL :: cstr ! Debug information (added to warnings)
CHARACTER(len=23) :: clstr
!!----------------------------------------------------------------------
llhold = .FALSE.
IF( PRESENT(ldhold) ) llhold = ldhold
clstr = ''
IF( PRESENT(cstr) ) clstr = TRIM(' ('//TRIM(cstr)//')')
IF( .NOT. ln_tile ) CALL ctl_stop('Cannot pause/stop tiling as ln_tile = .false.')
IF( .NOT. l_istiled ) THEN
CALL ctl_warn('Cannot pause/stop tiling as it is inactive'//clstr)
RETURN
ENDIF
! Whether paused or stopped, the tiling is made inactive and the full domain indices are used.
! If stopped, there is no active tile (ntile = 0) and the finished tile indicators are reset
CALL dom_tile(ntsi, ntsj, ntei, ntej, ktile=0, ldhold=llhold, cstr='dom_tile_stop'//clstr)
IF( .NOT. llhold ) l_tilefin(:) = .FALSE.
l_istiled = .FALSE.
END SUBROUTINE dom_tile_stop
!!======================================================================
END MODULE domtile