New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
domtile.F90 in NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/DOM – NEMO

source: NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/DOM/domtile.F90 @ 14576

Last change on this file since 14576 was 14537, checked in by hadcv, 3 years ago

#2600: Reorganise dom_tile code
File size: 11.9 KB
Line 
1MODULE 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   !!----------------------------------------------------------------------
33CONTAINS
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      ntile = 0                     ! Initialise to full domain
54      nijtile = 1
55      ntsi = Nis0
56      ntsj = Njs0
57      ntei = Nie0
58      ntej = Nje0
59      nthl = 0
60      nthr = 0
61      nthb = 0
62      ntht = 0
63      l_istiled = .FALSE.
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), l_tilefin(nijtile) )
73
74         l_tilefin(:) = .FALSE.
75
76         ntsi_a(0) = Nis0                 ! Full domain
77         ntsj_a(0) = Njs0
78         ntei_a(0) = Nie0
79         ntej_a(0) = Nje0
80
81         DO jt = 1, nijtile               ! Tile domains
82            ntsi_a(jt) = Nis0 + nn_ltile_i * MOD(jt - 1, iitile)
83            ntsj_a(jt) = Njs0 + nn_ltile_j * ((jt - 1) / iitile)
84            ntei_a(jt) = MIN(ntsi_a(jt) + nn_ltile_i - 1, Nie0)
85            ntej_a(jt) = MIN(ntsj_a(jt) + nn_ltile_j - 1, Nje0)
86         ENDDO
87      ENDIF
88
89      IF(lwp) THEN                  ! control print
90         WRITE(numout,*)
91         WRITE(numout,*) 'dom_tile : Domain tiling decomposition'
92         WRITE(numout,*) '~~~~~~~~'
93         IF( ln_tile ) THEN
94            WRITE(numout,*) iitile, 'tiles in i'
95            WRITE(numout,*) '    Starting indices'
96            WRITE(numout,*) '        ', (ntsi_a(jt), jt=1, iitile)
97            WRITE(numout,*) '    Ending indices'
98            WRITE(numout,*) '        ', (ntei_a(jt), jt=1, iitile)
99            WRITE(numout,*) ijtile, 'tiles in j'
100            WRITE(numout,*) '    Starting indices'
101            WRITE(numout,*) '        ', (ntsj_a(jt), jt=1, nijtile, iitile)
102            WRITE(numout,*) '    Ending indices'
103            WRITE(numout,*) '        ', (ntej_a(jt), jt=1, nijtile, iitile)
104         ELSE
105            WRITE(numout,*) 'No domain tiling'
106            WRITE(numout,*) '    i indices =', ntsi, ':', ntei
107            WRITE(numout,*) '    j indices =', ntsj, ':', ntej
108         ENDIF
109      ENDIF
110   END SUBROUTINE dom_tile_init
111
112
113   SUBROUTINE dom_tile( ktsi, ktsj, ktei, ktej, ktile, ldhold, cstr )
114      !!----------------------------------------------------------------------
115      !!                     ***  ROUTINE dom_tile  ***
116      !!
117      !! ** Purpose :   Set the current tile and its domain indices
118      !!
119      !! ** Action  : - ktsi, ktsj     : start of internal part of domain
120      !!              - ktei, ktej     : end of internal part of domain
121      !!              - nthl, nthr     : modifier on DO loop macro bound offset (left, right)
122      !!              - nthb, ntht     :              "         "               (bottom, top)
123      !!              - ktile          : set the current tile number (ntile)
124      !!----------------------------------------------------------------------
125      INTEGER, INTENT(out) :: ktsi, ktsj, ktei, ktej      ! Tile domain indices
126      INTEGER, INTENT(in)  :: ktile                       ! Tile number
127      LOGICAL, INTENT(in), OPTIONAL :: ldhold             ! Pause/resume (.true.) or set (.false.) current tile
128      ! TEMP: [tiling] DEBUG
129      CHARACTER(len=*), INTENT(in), OPTIONAL   :: cstr
130      CHARACTER(len=23) :: clstr
131      LOGICAL :: llhold
132      CHARACTER(len=11)   :: charout
133      !!----------------------------------------------------------------------
134      llhold = .FALSE.
135      IF( PRESENT(ldhold) ) llhold = ldhold
136      clstr = ''
137      IF( PRESENT(cstr) ) clstr = TRIM(' ('//TRIM(cstr)//')')
138
139      IF( .NOT. ln_tile ) CALL ctl_stop('Cannot use dom_tile with ln_tile = .false.')
140      IF( .NOT. llhold ) THEN
141         IF( .NOT. l_istiled ) THEN
142            CALL ctl_warn('Cannot call dom_tile when tiling is inactive'//clstr)
143            RETURN
144         ENDIF
145
146         IF( ntile /= 0 ) l_tilefin(ntile) = .TRUE.         ! If setting a new tile, the current tile is complete
147
148         ntile = ktile                                      ! Set the new tile
149         IF(sn_cfctl%l_prtctl) THEN
150            WRITE(charout, FMT="('ntile =', I4)") ntile
151            CALL prt_ctl_info( charout )
152         ENDIF
153      ENDIF
154
155      ktsi = ntsi_a(ktile)                                  ! Set the domain indices
156      ktsj = ntsj_a(ktile)
157      ktei = ntei_a(ktile)
158      ktej = ntej_a(ktile)
159
160      ! Calculate the modifying factor on DO loop bounds (1 = do not work on halo of a tile that has already been processed)
161      nthl = 0 ; nthr = 0 ; nthb = 0 ; ntht = 0
162      IF( ktsi > Nis0 ) THEN ; IF( l_tilefin(ktile - 1         ) ) nthl = 1 ; ENDIF    ! Left adjacent tile
163      IF( ktei < Nie0 ) THEN ; IF( l_tilefin(ktile + 1         ) ) nthr = 1 ; ENDIF    ! Right  "  "
164      IF( ktsj > Njs0 ) THEN ; IF( l_tilefin(ktile - nn_ltile_i) ) nthb = 1 ; ENDIF    ! Bottom "  "
165      IF( ktej < Nje0 ) THEN ; IF( l_tilefin(ktile + nn_ltile_i) ) ntht = 1 ; ENDIF    ! Top    "  "
166   END SUBROUTINE dom_tile
167
168
169   SUBROUTINE dom_tile_start( ldhold, cstr )
170      !!----------------------------------------------------------------------
171      !!                     ***  ROUTINE dom_tile_start  ***
172      !!
173      !! ** Purpose : Start or resume the use of tiling
174      !!
175      !! ** Method  : dom_tile_start & dom_tile_stop are used to declare a tiled region of code.
176      !!
177      !!              Tiling is active/inactive (l_istiled = .true./.false.) within/outside of this code region.
178      !!              After enabling tiling, no tile will initially be set (the full domain will be used) and dom_tile must
179      !!              be called to set a specific tile to work on. Furthermore, all tiles will be marked as incomplete
180      !!              (ln_tilefin(:) = .false.).
181      !!
182      !!              Tiling can be paused/resumed within the tiled code region by calling dom_tile_stop/dom_tile_start
183      !!              with ldhold = .true.. This can be used to temporarily revert back to using the full domain.
184      !!
185      !!                 CALL dom_tile_start                                  ! Enable tiling
186      !!                    CALL dom_tile(ntsi, ntei, ntsj, ntej, ktile=n)    ! Set current tile "n"
187      !!                    ...
188      !!                    CALL dom_tile_stop(.TRUE.)                        ! Pause tiling (temporarily disable)
189      !!                    ...
190      !!                    CALL dom_tile_start(.TRUE.)                       ! Resume tiling
191      !!                 CALL dom_tile_stop                                   ! Disable tiling
192      !!----------------------------------------------------------------------
193      LOGICAL, INTENT(in), OPTIONAL :: ldhold      ! Resume (.true.) or start (.false.)
194      LOGICAL :: llhold
195      ! TEMP: [tiling] DEBUG
196      CHARACTER(len=*), INTENT(in), OPTIONAL   :: cstr
197      CHARACTER(len=23) :: clstr
198      !!----------------------------------------------------------------------
199      llhold = .FALSE.
200      IF( PRESENT(ldhold) ) llhold = ldhold
201      clstr = ''
202      IF( PRESENT(cstr) ) clstr = TRIM(' ('//TRIM(cstr)//')')
203
204      IF( .NOT. ln_tile ) CALL ctl_stop('Cannot resume/start tiling as ln_tile = .false.')
205      IF( l_istiled ) THEN
206         CALL ctl_warn('Cannot resume/start tiling as it is already active'//clstr)
207         RETURN
208      ! TODO: This warning will always be raised outside a tiling loop (cannot check for pause rather than stop)
209      ELSE IF( llhold .AND. ntile == 0 ) THEN
210         CALL ctl_warn('Cannot resume tiling as it is not paused'//clstr)
211         RETURN
212      ENDIF
213
214      ! Whether resumed or started, the tiling is made active. If resumed, the domain indices for the current tile are used.
215      IF( llhold ) CALL dom_tile(ntsi, ntsj, ntei, ntej, ktile=ntile, ldhold=.TRUE., cstr='dom_tile_start'//clstr)
216      l_istiled = .TRUE.
217   END SUBROUTINE dom_tile_start
218
219
220   SUBROUTINE dom_tile_stop( ldhold, cstr )
221      !!----------------------------------------------------------------------
222      !!                     ***  ROUTINE dom_tile_stop  ***
223      !!
224      !! ** Purpose : End or pause the use of tiling
225      !!
226      !! ** Method  : See dom_tile_start
227      !!----------------------------------------------------------------------
228      LOGICAL, INTENT(in), OPTIONAL :: ldhold      ! Pause (.true.) or stop (.false.)
229      LOGICAL :: llhold
230      ! TEMP: [tiling] DEBUG
231      CHARACTER(len=*), INTENT(in), OPTIONAL   :: cstr
232      CHARACTER(len=23) :: clstr
233      !!----------------------------------------------------------------------
234      llhold = .FALSE.
235      IF( PRESENT(ldhold) ) llhold = ldhold
236      clstr = ''
237      IF( PRESENT(cstr) ) clstr = TRIM(' ('//TRIM(cstr)//')')
238
239      IF( .NOT. ln_tile ) CALL ctl_stop('Cannot pause/stop tiling as ln_tile = .false.')
240      IF( .NOT. l_istiled ) THEN
241         CALL ctl_warn('Cannot pause/stop tiling as it is inactive'//clstr)
242         RETURN
243      ENDIF
244
245      ! Whether paused or stopped, the tiling is made inactive and the full domain indices are used.
246      ! If stopped, there is no active tile (ntile = 0) and the finished tile indicators are reset
247      CALL dom_tile(ntsi, ntsj, ntei, ntej, ktile=0, ldhold=llhold, cstr='dom_tile_stop'//clstr)
248      IF( .NOT. llhold ) l_tilefin(:) = .FALSE.
249      l_istiled = .FALSE.
250   END SUBROUTINE dom_tile_stop
251   !!======================================================================
252END MODULE domtile
Note: See TracBrowser for help on using the repository browser.