Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
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