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/trunk/src/OCE/DOM – NEMO

source: NEMO/trunk/src/OCE/DOM/domtile.F90

Last change on this file was 14834, checked in by hadcv, 3 years ago

#2600: Merge in dev_r14273_HPC-02_Daley_Tiling
File size: 12.2 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      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   !!======================================================================
254END MODULE domtile
Note: See TracBrowser for help on using the repository browser.