1 | MODULE domtile |
---|
2 | !!====================================================================== |
---|
3 | !! *** MODULE domtile *** |
---|
4 | !! Tiling utilities |
---|
5 | !!====================================================================== |
---|
6 | !! History : 4.2 ! 2020-12 (D. Calvert) Original code |
---|
7 | !!---------------------------------------------------------------------- |
---|
8 | |
---|
9 | !!---------------------------------------------------------------------- |
---|
10 | !! dom_tile : Set/initialise the current tile and domain indices |
---|
11 | !!---------------------------------------------------------------------- |
---|
12 | USE dom_oce ! ocean space and time domain |
---|
13 | ! |
---|
14 | USE prtctl ! Print control (prt_ctl_info routine) |
---|
15 | USE lib_mpp , ONLY : ctl_stop, ctl_warn |
---|
16 | USE in_out_manager ! I/O manager |
---|
17 | |
---|
18 | IMPLICIT NONE |
---|
19 | PRIVATE |
---|
20 | |
---|
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 |
---|
27 | |
---|
28 | !!---------------------------------------------------------------------- |
---|
29 | !! NEMO/OCE 4.2 , NEMO Consortium (2020) |
---|
30 | !! $Id: domtile.F90 13982 2020-12-04 10:57:05Z hadcv $ |
---|
31 | !! Software governed by the CeCILL license (see ./LICENSE) |
---|
32 | !!---------------------------------------------------------------------- |
---|
33 | CONTAINS |
---|
34 | |
---|
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 ) |
---|
116 | !!---------------------------------------------------------------------- |
---|
117 | !! *** ROUTINE dom_tile *** |
---|
118 | !! |
---|
119 | !! ** Purpose : Set the current tile and its domain indices |
---|
120 | !! |
---|
121 | !! ** Action : - ktsi, ktsj : start of internal part of domain |
---|
122 | !! - ktei, ktej : end of internal part of domain |
---|
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) |
---|
126 | !!---------------------------------------------------------------------- |
---|
127 | INTEGER, INTENT(out) :: ktsi, ktsj, ktei, ktej ! Tile domain indices |
---|
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 |
---|
151 | IF(sn_cfctl%l_prtctl) THEN |
---|
152 | WRITE(charout, FMT="('ntile =', I4)") ntile |
---|
153 | CALL prt_ctl_info( charout ) |
---|
154 | 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 " " |
---|
170 | END SUBROUTINE dom_tile |
---|
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 |
---|
253 | !!====================================================================== |
---|
254 | END MODULE domtile |
---|