Changes from NEMO/trunk/src/OCE/DOM/domtile.F90 at r14090 to NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/DOM/domtile.F90 at r14787
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/DOM/domtile.F90
r14090 r14787 13 13 ! 14 14 USE prtctl ! Print control (prt_ctl_info routine) 15 USE lib_mpp , ONLY : ctl_stop, ctl_warn 15 16 USE in_out_manager ! I/O manager 16 17 … … 18 19 PRIVATE 19 20 20 PUBLIC dom_tile ! called by step.F90 21 PUBLIC dom_tile ! called by step.F90 22 PUBLIC dom_tile_start ! called by various 23 PUBLIC dom_tile_stop ! " " 24 PUBLIC dom_tile_init ! called by domain.F90 25 26 LOGICAL, ALLOCATABLE, DIMENSION(:) :: l_tilefin ! whether a tile is finished or not 21 27 22 28 !!---------------------------------------------------------------------- … … 27 33 CONTAINS 28 34 29 SUBROUTINE dom_tile( ktsi, ktsj, ktei, ktej, ktile ) 35 SUBROUTINE dom_tile_init 36 !!---------------------------------------------------------------------- 37 !! *** ROUTINE dom_tile_init *** 38 !! 39 !! ** Purpose : Initialise tile domain variables 40 !! 41 !! ** Action : - ntsi, ntsj : start of internal part of domain 42 !! - ntei, ntej : end of internal part of domain 43 !! - ntile : current tile number 44 !! - nijtile : total number of tiles 45 !! - nthl, nthr : modifier on DO loop macro bound offset (left, right) 46 !! - nthb, ntht : " " (bottom, top) 47 !! - l_istiled : whether tiling is currently active or not 48 !! - l_tilefin : whether a tile is finished or not 49 !!---------------------------------------------------------------------- 50 INTEGER :: jt ! dummy loop argument 51 INTEGER :: iitile, ijtile ! Local integers 52 !!---------------------------------------------------------------------- 53 IF( ln_tile .AND. nn_hls /= 2 ) CALL ctl_stop('dom_tile_init: Tiling is only supported for nn_hls = 2') 54 55 ntile = 0 ! Initialise to full domain 56 nijtile = 1 57 ntsi = Nis0 58 ntsj = Njs0 59 ntei = Nie0 60 ntej = Nje0 61 nthl = 0 62 nthr = 0 63 nthb = 0 64 ntht = 0 65 l_istiled = .FALSE. 66 67 IF( ln_tile ) THEN ! Calculate tile domain indices 68 iitile = Ni_0 / nn_ltile_i ! Number of tiles 69 ijtile = Nj_0 / nn_ltile_j 70 IF( MOD( Ni_0, nn_ltile_i ) /= 0 ) iitile = iitile + 1 71 IF( MOD( Nj_0, nn_ltile_j ) /= 0 ) ijtile = ijtile + 1 72 73 nijtile = iitile * ijtile 74 ALLOCATE( ntsi_a(0:nijtile), ntsj_a(0:nijtile), ntei_a(0:nijtile), ntej_a(0:nijtile), l_tilefin(nijtile) ) 75 76 l_tilefin(:) = .FALSE. 77 78 ntsi_a(0) = Nis0 ! Full domain 79 ntsj_a(0) = Njs0 80 ntei_a(0) = Nie0 81 ntej_a(0) = Nje0 82 83 DO jt = 1, nijtile ! Tile domains 84 ntsi_a(jt) = Nis0 + nn_ltile_i * MOD(jt - 1, iitile) 85 ntsj_a(jt) = Njs0 + nn_ltile_j * ((jt - 1) / iitile) 86 ntei_a(jt) = MIN(ntsi_a(jt) + nn_ltile_i - 1, Nie0) 87 ntej_a(jt) = MIN(ntsj_a(jt) + nn_ltile_j - 1, Nje0) 88 ENDDO 89 ENDIF 90 91 IF(lwp) THEN ! control print 92 WRITE(numout,*) 93 WRITE(numout,*) 'dom_tile : Domain tiling decomposition' 94 WRITE(numout,*) '~~~~~~~~' 95 IF( ln_tile ) THEN 96 WRITE(numout,*) iitile, 'tiles in i' 97 WRITE(numout,*) ' Starting indices' 98 WRITE(numout,*) ' ', (ntsi_a(jt), jt=1, iitile) 99 WRITE(numout,*) ' Ending indices' 100 WRITE(numout,*) ' ', (ntei_a(jt), jt=1, iitile) 101 WRITE(numout,*) ijtile, 'tiles in j' 102 WRITE(numout,*) ' Starting indices' 103 WRITE(numout,*) ' ', (ntsj_a(jt), jt=1, nijtile, iitile) 104 WRITE(numout,*) ' Ending indices' 105 WRITE(numout,*) ' ', (ntej_a(jt), jt=1, nijtile, iitile) 106 ELSE 107 WRITE(numout,*) 'No domain tiling' 108 WRITE(numout,*) ' i indices =', ntsi, ':', ntei 109 WRITE(numout,*) ' j indices =', ntsj, ':', ntej 110 ENDIF 111 ENDIF 112 END SUBROUTINE dom_tile_init 113 114 115 SUBROUTINE dom_tile( ktsi, ktsj, ktei, ktej, ktile, ldhold, cstr ) 30 116 !!---------------------------------------------------------------------- 31 117 !! *** ROUTINE dom_tile *** 32 118 !! 33 !! ** Purpose : Set t ile domain variables119 !! ** Purpose : Set the current tile and its domain indices 34 120 !! 35 121 !! ** Action : - ktsi, ktsj : start of internal part of domain 36 122 !! - ktei, ktej : end of internal part of domain 37 !! - ntile : current tile number 38 !! - nijtile : total number of tiles 123 !! - nthl, nthr : modifier on DO loop macro bound offset (left, right) 124 !! - nthb, ntht : " " (bottom, top) 125 !! - ktile : set the current tile number (ntile) 39 126 !!---------------------------------------------------------------------- 40 127 INTEGER, INTENT(out) :: ktsi, ktsj, ktei, ktej ! Tile domain indices 41 INTEGER, INTENT(in), OPTIONAL :: ktile ! Tile number 42 INTEGER :: jt ! dummy loop argument 43 INTEGER :: iitile, ijtile ! Local integers 44 CHARACTER (len=11) :: charout 45 !!---------------------------------------------------------------------- 46 IF( PRESENT(ktile) .AND. ln_tile ) THEN 47 ntile = ktile ! Set domain indices for tile 48 ktsi = ntsi_a(ktile) 49 ktsj = ntsj_a(ktile) 50 ktei = ntei_a(ktile) 51 ktej = ntej_a(ktile) 52 128 INTEGER, INTENT(in) :: ktile ! Tile number 129 LOGICAL, INTENT(in), OPTIONAL :: ldhold ! Pause/resume (.true.) or set (.false.) current tile 130 CHARACTER(len=*), INTENT(in), OPTIONAL :: cstr ! Debug information (added to warnings) 131 CHARACTER(len=23) :: clstr 132 LOGICAL :: llhold 133 CHARACTER(len=11) :: charout 134 INTEGER :: iitile 135 !!---------------------------------------------------------------------- 136 llhold = .FALSE. 137 IF( PRESENT(ldhold) ) llhold = ldhold 138 clstr = '' 139 IF( PRESENT(cstr) ) clstr = TRIM(' ('//TRIM(cstr)//')') 140 141 IF( .NOT. ln_tile ) CALL ctl_stop('Cannot use dom_tile with ln_tile = .false.') 142 IF( .NOT. llhold ) THEN 143 IF( .NOT. l_istiled ) THEN 144 CALL ctl_warn('Cannot call dom_tile when tiling is inactive'//clstr) 145 RETURN 146 ENDIF 147 148 IF( ntile /= 0 ) l_tilefin(ntile) = .TRUE. ! If setting a new tile, the current tile is complete 149 150 ntile = ktile ! Set the new tile 53 151 IF(sn_cfctl%l_prtctl) THEN 54 WRITE(charout, FMT="('ntile =', I4)") ktile152 WRITE(charout, FMT="('ntile =', I4)") ntile 55 153 CALL prt_ctl_info( charout ) 56 154 ENDIF 57 ELSE 58 ntile = 0 ! Initialise to full domain 59 nijtile = 1 60 ktsi = Nis0 61 ktsj = Njs0 62 ktei = Nie0 63 ktej = Nje0 64 65 IF( ln_tile ) THEN ! Calculate tile domain indices 66 iitile = Ni_0 / nn_ltile_i ! Number of tiles 67 ijtile = Nj_0 / nn_ltile_j 68 IF( MOD( Ni_0, nn_ltile_i ) /= 0 ) iitile = iitile + 1 69 IF( MOD( Nj_0, nn_ltile_j ) /= 0 ) ijtile = ijtile + 1 70 71 nijtile = iitile * ijtile 72 ALLOCATE( ntsi_a(0:nijtile), ntsj_a(0:nijtile), ntei_a(0:nijtile), ntej_a(0:nijtile) ) 73 74 ntsi_a(0) = ktsi ! Full domain 75 ntsj_a(0) = ktsj 76 ntei_a(0) = ktei 77 ntej_a(0) = ktej 78 79 DO jt = 1, nijtile ! Tile domains 80 ntsi_a(jt) = Nis0 + nn_ltile_i * MOD(jt - 1, iitile) 81 ntsj_a(jt) = Njs0 + nn_ltile_j * ((jt - 1) / iitile) 82 ntei_a(jt) = MIN(ntsi_a(jt) + nn_ltile_i - 1, Nie0) 83 ntej_a(jt) = MIN(ntsj_a(jt) + nn_ltile_j - 1, Nje0) 84 ENDDO 85 ENDIF 86 87 IF(lwp) THEN ! control print 88 WRITE(numout,*) 89 WRITE(numout,*) 'dom_tile : Domain tiling decomposition' 90 WRITE(numout,*) '~~~~~~~~' 91 IF( ln_tile ) THEN 92 WRITE(numout,*) iitile, 'tiles in i' 93 WRITE(numout,*) ' Starting indices' 94 WRITE(numout,*) ' ', (ntsi_a(jt), jt=1, iitile) 95 WRITE(numout,*) ' Ending indices' 96 WRITE(numout,*) ' ', (ntei_a(jt), jt=1, iitile) 97 WRITE(numout,*) ijtile, 'tiles in j' 98 WRITE(numout,*) ' Starting indices' 99 WRITE(numout,*) ' ', (ntsj_a(jt), jt=1, nijtile, iitile) 100 WRITE(numout,*) ' Ending indices' 101 WRITE(numout,*) ' ', (ntej_a(jt), jt=1, nijtile, iitile) 102 ELSE 103 WRITE(numout,*) 'No domain tiling' 104 WRITE(numout,*) ' i indices =', ktsi, ':', ktei 105 WRITE(numout,*) ' j indices =', ktsj, ':', ktej 106 ENDIF 107 ENDIF 108 ENDIF 155 ENDIF 156 157 ktsi = ntsi_a(ktile) ! Set the domain indices 158 ktsj = ntsj_a(ktile) 159 ktei = ntei_a(ktile) 160 ktej = ntej_a(ktile) 161 162 ! Calculate the modifying factor on DO loop bounds (1 = do not work on points that have already been processed by a neighbouring tile) 163 nthl = 0 ; nthr = 0 ; nthb = 0 ; ntht = 0 164 iitile = Ni_0 / nn_ltile_i 165 IF( MOD( Ni_0, nn_ltile_i ) /= 0 ) iitile = iitile + 1 166 IF( ktsi > Nis0 ) THEN ; IF( l_tilefin(ktile - 1 ) ) nthl = 1 ; ENDIF ! Left adjacent tile 167 IF( ktei < Nie0 ) THEN ; IF( l_tilefin(ktile + 1 ) ) nthr = 1 ; ENDIF ! Right " " 168 IF( ktsj > Njs0 ) THEN ; IF( l_tilefin(ktile - iitile) ) nthb = 1 ; ENDIF ! Bottom " " 169 IF( ktej < Nje0 ) THEN ; IF( l_tilefin(ktile + iitile) ) ntht = 1 ; ENDIF ! Top " " 109 170 END SUBROUTINE dom_tile 110 171 172 173 SUBROUTINE dom_tile_start( ldhold, cstr ) 174 !!---------------------------------------------------------------------- 175 !! *** ROUTINE dom_tile_start *** 176 !! 177 !! ** Purpose : Start or resume the use of tiling 178 !! 179 !! ** Method : dom_tile_start & dom_tile_stop are used to declare a tiled region of code. 180 !! 181 !! Tiling is active/inactive (l_istiled = .true./.false.) within/outside of this code region. 182 !! After enabling tiling, no tile will initially be set (the full domain will be used) and dom_tile must 183 !! be called to set a specific tile to work on. Furthermore, all tiles will be marked as incomplete 184 !! (ln_tilefin(:) = .false.). 185 !! 186 !! Tiling can be paused/resumed within the tiled code region by calling dom_tile_stop/dom_tile_start 187 !! with ldhold = .true.. This can be used to temporarily revert back to using the full domain. 188 !! 189 !! CALL dom_tile_start ! Enable tiling 190 !! CALL dom_tile(ntsi, ntei, ntsj, ntej, ktile=n) ! Set current tile "n" 191 !! ... 192 !! CALL dom_tile_stop(.TRUE.) ! Pause tiling (temporarily disable) 193 !! ... 194 !! CALL dom_tile_start(.TRUE.) ! Resume tiling 195 !! CALL dom_tile_stop ! Disable tiling 196 !!---------------------------------------------------------------------- 197 LOGICAL, INTENT(in), OPTIONAL :: ldhold ! Resume (.true.) or start (.false.) 198 LOGICAL :: llhold 199 CHARACTER(len=*), INTENT(in), OPTIONAL :: cstr ! Debug information (added to warnings) 200 CHARACTER(len=23) :: clstr 201 !!---------------------------------------------------------------------- 202 llhold = .FALSE. 203 IF( PRESENT(ldhold) ) llhold = ldhold 204 clstr = '' 205 IF( PRESENT(cstr) ) clstr = TRIM(' ('//TRIM(cstr)//')') 206 207 IF( .NOT. ln_tile ) CALL ctl_stop('Cannot resume/start tiling as ln_tile = .false.') 208 IF( l_istiled ) THEN 209 CALL ctl_warn('Cannot resume/start tiling as it is already active'//clstr) 210 RETURN 211 ! TODO: [tiling] this warning will always be raised outside a tiling loop (cannot check for pause rather than stop) 212 ELSE IF( llhold .AND. ntile == 0 ) THEN 213 CALL ctl_warn('Cannot resume tiling as it is not paused'//clstr) 214 RETURN 215 ENDIF 216 217 ! Whether resumed or started, the tiling is made active. If resumed, the domain indices for the current tile are used. 218 IF( llhold ) CALL dom_tile(ntsi, ntsj, ntei, ntej, ktile=ntile, ldhold=.TRUE., cstr='dom_tile_start'//clstr) 219 l_istiled = .TRUE. 220 END SUBROUTINE dom_tile_start 221 222 223 SUBROUTINE dom_tile_stop( ldhold, cstr ) 224 !!---------------------------------------------------------------------- 225 !! *** ROUTINE dom_tile_stop *** 226 !! 227 !! ** Purpose : End or pause the use of tiling 228 !! 229 !! ** Method : See dom_tile_start 230 !!---------------------------------------------------------------------- 231 LOGICAL, INTENT(in), OPTIONAL :: ldhold ! Pause (.true.) or stop (.false.) 232 LOGICAL :: llhold 233 CHARACTER(len=*), INTENT(in), OPTIONAL :: cstr ! Debug information (added to warnings) 234 CHARACTER(len=23) :: clstr 235 !!---------------------------------------------------------------------- 236 llhold = .FALSE. 237 IF( PRESENT(ldhold) ) llhold = ldhold 238 clstr = '' 239 IF( PRESENT(cstr) ) clstr = TRIM(' ('//TRIM(cstr)//')') 240 241 IF( .NOT. ln_tile ) CALL ctl_stop('Cannot pause/stop tiling as ln_tile = .false.') 242 IF( .NOT. l_istiled ) THEN 243 CALL ctl_warn('Cannot pause/stop tiling as it is inactive'//clstr) 244 RETURN 245 ENDIF 246 247 ! Whether paused or stopped, the tiling is made inactive and the full domain indices are used. 248 ! If stopped, there is no active tile (ntile = 0) and the finished tile indicators are reset 249 CALL dom_tile(ntsi, ntsj, ntei, ntej, ktile=0, ldhold=llhold, cstr='dom_tile_stop'//clstr) 250 IF( .NOT. llhold ) l_tilefin(:) = .FALSE. 251 l_istiled = .FALSE. 252 END SUBROUTINE dom_tile_stop 111 253 !!====================================================================== 112 254 END MODULE domtile
Note: See TracChangeset
for help on using the changeset viewer.
