Oasis3-MCT
 All Classes Files Functions Variables Macros Pages
mod_oasis_part.F90
Go to the documentation of this file.
1 
2 !> OASIS partition data and methods
3 
5 
9  USE mod_oasis_sys
10  USE mod_oasis_mpi
11  USE mod_oasis_timer
12  USE mct_mod
13 
14  implicit none
15 
16  private
17 
18  !--- interfaces ---
19  public :: oasis_def_partition
20  public :: oasis_part_setup
21  public :: oasis_part_create
22 
23  !--- datatypes ---
24  public :: prism_part_type
25 
26  integer(kind=ip_intwp_p),parameter :: mpart = 100 !< maximum number of partitions allowed
27 
28  !> Partition (decomposition) data for variables
30  character(len=ic_lvar2):: partname !< partition name
31  type(mct_gsmap) :: gsmap !< gsmap on mpi_comm_local
32  integer(kind=ip_i4_p) :: gsize !< global size of grid
33  integer(kind=ip_i4_p) :: nx !< global nx size
34  integer(kind=ip_i4_p) :: ny !< global ny size
35  character(len=ic_lvar) :: gridname !< grid name
36  integer(kind=ip_i4_p) :: mpicom !< mpicom for partition tasks only
37  integer(kind=ip_i4_p) :: npes !< tasks count associated with partition
38  integer(kind=ip_i4_p) :: rank !< rank of each task
39  type(mct_gsmap) :: pgsmap !< same gsmap but on partition mpicom
40  !--- temporary storage from def_part inputs ---
41  integer(kind=ip_i4_p) :: ig_size !< def_part setting
42  integer(kind=ip_i4_p),pointer :: kparal(:) !< def_part setting
43  end type prism_part_type
44 
45  integer(kind=ip_intwp_p),public :: prism_npart = 0 !< number of partitions defined
46  type(prism_part_type) ,public :: prism_part(mpart) !< list of defined partitions
47 
48  !--- for automatic naming of partname
49  !--- better than prism_npart, counts only unnamed parts
50  integer(kind=ip_intwp_p) :: part_name_cnt = 0 !< used to define partition names internally
51 
52 CONTAINS
53 
54 !--------------------------------------------------------------------
55 
56 !> The OASIS user interface to define partitions
57 
58  SUBROUTINE oasis_def_partition (id_part, kparal, kinfo, ig_size, name)
59 
60 !* *** Def_partition *** PRISM 1.0
61 !
62 ! purpose:
63 ! --------
64 ! define a decomposition
65 !
66 ! interface:
67 ! ----------
68 ! id_part : field decomposition id
69 ! kparal : type of parallel decomposition
70 ! kinfo : output status
71 !
72 ! author:
73 ! -------
74 ! Arnaud Caubel - FECIT
75 !
76 ! ----------------------------------------------------------------
77  INTEGER(kind=ip_intwp_p) ,intent(out) :: id_part !< partition id
78  INTEGER(kind=ip_intwp_p), DIMENSION(:),intent(in) :: kparal !< decomposition information
79  INTEGER(kind=ip_intwp_p), optional ,intent(out) :: kinfo !< return code
80  INTEGER(kind=ip_intwp_p), optional ,intent(in) :: ig_size !< total size of partition
81  character(len=*) , optional ,intent(in) :: name !< name of partition
82 ! ----------------------------------------------------------------
83  integer(kind=ip_intwp_p) :: n
84  character(len=*),parameter :: subname = '(oasis_def_partition)'
85 ! ----------------------------------------------------------------
86 
87  call oasis_debug_enter(subname)
88 
89  if (.not. oasis_coupled) then
90  call oasis_debug_exit(subname)
91  return
92  endif
93 
94  kinfo = oasis_ok
95 
96  !-----------------------------------------------
97  !> * Increment partition number and store user values
98  !-----------------------------------------------
99 
100  call oasis_timer_start('part_definition')
101 
102  prism_npart = prism_npart + 1
103  if (prism_npart > mpart) then
104  write(nulprt,*) subname,estr,'prism_npart too large = ',prism_npart,mpart
105  write(nulprt,*) subname,estr,'increase mpart in mod_oasis_part.F90'
106  call oasis_abort()
107  endif
108  call oasis_part_zero(prism_part(prism_npart))
109  id_part = prism_npart
110 
111  if (present(name)) then
112  if (len_trim(name) > len(prism_part(prism_npart)%partname)) then
113  write(nulprt,*) subname,estr,'part name too long = ',trim(name)
114  write(nulprt,*) subname,estr,'part name max length = ',len(prism_part(prism_npart)%partname)
115  call oasis_abort()
116  endif
117  prism_part(prism_npart)%partname = trim(name)
118  else
119  part_name_cnt = part_name_cnt + 1
120  write(prism_part(prism_npart)%partname,'(a,i6.6)') trim(compnm)//'_part',part_name_cnt
121  endif
122 
123  if (present(ig_size)) then
124  prism_part(prism_npart)%ig_size = ig_size
125  endif
126 
127  allocate(prism_part(prism_npart)%kparal(size(kparal)))
128  prism_part(prism_npart)%kparal = kparal
129 
130  call oasis_timer_stop('part_definition')
131 
132  call oasis_debug_exit(subname)
133 
134  END SUBROUTINE oasis_def_partition
135 
136 !------------------------------------------------------------
137 
138 !> Synchronize partitions across all tasks, called at oasis enddef.
139 
140  SUBROUTINE oasis_part_setup()
141  IMPLICIT NONE
142 
143  !--------------------------------------------------------
144  integer(kind=ip_intwp_p) :: m,n,k,p,nsegs,numel,taskid
145  INTEGER(kind=ip_intwp_p) :: icpl,ierr,ilen
146  integer(kind=ip_intwp_p),pointer :: start(:),length(:)
147  integer(kind=ip_intwp_p),pointer :: kparal(:)
148  integer(kind=ip_intwp_p) :: ig_size
149  integer(kind=ip_intwp_p) :: pcnt
150  logical :: found
151  character(len=ic_lvar2), pointer :: pname0(:),pname(:)
152  logical, parameter :: local_timers_on = .false.
153  character(len=*),parameter :: subname = '(oasis_part_setup)'
154  !--------------------------------------------------------
155 
156  call oasis_debug_enter(subname)
157 
158  if (local_timers_on) then
159  call oasis_timer_start('part_setup_barrier')
160  if (mpi_comm_local /= mpi_comm_null) &
161  call mpi_barrier(mpi_comm_local, ierr)
162  call oasis_timer_stop('part_setup_barrier')
163  endif
164  call oasis_timer_start('part_setup')
165 
166  !-----------------------------------------------
167  !> * Generate reduced partname list
168  !-----------------------------------------------
169 
170  call oasis_timer_start('part_setup_reducelists')
171  allocate(pname0(prism_npart))
172  do n = 1,prism_npart
173  pname0(n) = prism_part(n)%partname
174  enddo
175  call oasis_mpi_reducelists(pname0,mpi_comm_local,pcnt,pname,'part_setup',fastcheck=.true.)
176  deallocate(pname0)
177  call oasis_timer_stop('part_setup_reducelists')
178 
179  !-------------------------------------------------
180  !> * Define all partitions on all tasks
181  !-------------------------------------------------
182 
183  if (local_timers_on) then
184  call oasis_timer_start('part_setup_initgsm_barrier')
185  if (mpi_comm_local /= mpi_comm_null) &
186  call mpi_barrier(mpi_comm_local, ierr)
187  call oasis_timer_stop('part_setup_initgsm_barrier')
188  endif
189  call oasis_timer_start('part_setup_initgsm')
190  do p = 1,pcnt
191 
192  if (local_timers_on) call oasis_timer_start('part_setup_initgsm_A')
193  !--- set m, either a prism_part that already exists
194  found = .false.
195  n = 0
196  do while (n < prism_npart .and. .not.found)
197  n = n + 1
198  if (prism_part(n)%partname == pname(p)) then
199  m = n
200  found = .true.
201  endif
202  enddo
203  if (local_timers_on) call oasis_timer_stop('part_setup_initgsm_A')
204 
205  if (local_timers_on) call oasis_timer_start('part_setup_initgsm_B')
206  !--- or m is a new prism_part that must be instantiated
207  !--- and set to have no data
208  if (.not.found) then
209  prism_npart = prism_npart + 1
210  m = prism_npart
211  call oasis_part_zero(prism_part(prism_npart))
212  prism_part(prism_npart)%partname = pname(p)
213  allocate(prism_part(prism_npart)%kparal(3))
214  prism_part(prism_npart)%kparal = 0
215  endif
216  if (local_timers_on) call oasis_timer_stop('part_setup_initgsm_B')
217 
218  !-------------------------------------------------
219  !> * Convert kparal information to data for the gsmap
220  !-------------------------------------------------
221 
222  if (local_timers_on) call oasis_timer_start('part_setup_initgsm_C')
223  allocate(kparal(size(prism_part(m)%kparal)))
224  kparal = prism_part(m)%kparal
225  ig_size = prism_part(m)%ig_size
226 
227  if (kparal(clim_strategy) == clim_serial) then
228  nsegs = 1
229  allocate(start(nsegs),length(nsegs))
230  start(1) = 1
231  length(1) = kparal(clim_length)
232  numel = nsegs
233  if (length(1) == 0) numel = 0
234  elseif (kparal(clim_strategy) == clim_apple) then
235  nsegs = 1
236  allocate(start(nsegs),length(nsegs))
237  start(1) = kparal(clim_offset) + 1
238  length(1) = kparal(clim_length)
239  numel = nsegs
240  if (length(1) == 0) numel = 0
241  elseif (kparal(clim_strategy) == clim_box) then
242  nsegs = kparal(clim_sizey)
243  allocate(start(nsegs),length(nsegs))
244  do n = 1,nsegs
245  start(n) = kparal(clim_offset) + (n-1)*kparal(clim_ldx) + 1
246  length(n) = kparal(clim_sizex)
247  enddo
248  numel = nsegs
249  if (kparal(clim_sizey)*kparal(clim_sizex) == 0) numel = 0
250  elseif (kparal(clim_strategy) == clim_orange) then
251  nsegs = kparal(clim_segments)
252  allocate(start(nsegs),length(nsegs))
253  numel = 0
254  DO n = 1,nsegs
255  ilen = kparal((n-1)*2 + 4)
256  IF (ilen > 0) THEN
257  numel = numel + 1
258  start(numel) = kparal((n-1)*2 + 3) + 1
259  length(numel) = ilen
260  ENDIF
261  ENDDO
262  elseif (kparal(clim_strategy) == clim_points) then
263  nsegs = kparal(clim_segments)
264  allocate(start(nsegs),length(nsegs))
265  !--- initialize first segment, nsegs=1,n=1,k=3
266  nsegs = 1
267  n = 1
268  k = n+2
269  start(nsegs) = kparal(k)
270  length(nsegs) = 1
271  !--- compute rest of segments from n=2,k=4
272  do n = 2,kparal(clim_segments)
273  k = n+2
274  if (kparal(k)-kparal(k-1) == 1) then
275  length(nsegs) = length(nsegs) + 1
276  else
277  nsegs = nsegs + 1
278  start(nsegs) = kparal(k)
279  length(nsegs) = 1
280  endif
281  enddo
282  numel = nsegs
283  else
284  write(nulprt,*) subname,estr,'part strategy unknown in def_part = ',kparal(clim_strategy)
285  write(nulprt,*) subname,estr,'strategy set in kparal array index ',clim_strategy
286  call oasis_abort()
287  endif
288  if (local_timers_on) call oasis_timer_stop('part_setup_initgsm_C')
289 
290  !-------------------------------------------------
291  !> * Initialize the local gsmap and partition gsmap
292  !-------------------------------------------------
293 
294  if (local_timers_on) call oasis_timer_start('part_setup_initgsm_D')
295  if (mpi_comm_local /= mpi_comm_null) then
296  if (ig_size > 0) then
297  call mct_gsmap_init(prism_part(m)%gsmap,start,length,mpi_root_local,&
298  mpi_comm_local,compid,numel=numel,gsize=ig_size)
299  else
300  call mct_gsmap_init(prism_part(m)%gsmap,start,length,mpi_root_local,&
301  mpi_comm_local,compid,numel=numel)
302  endif
303  prism_part(m)%gsize = mct_gsmap_gsize(prism_part(m)%gsmap)
304  icpl = mpi_undefined
305  if (numel > 0) icpl = 1
306  CALL mpi_comm_split(mpi_comm_local,icpl,1,prism_part(m)%mpicom,ierr)
307  if (numel > 0) then
308  CALL mpi_comm_size( prism_part(m)%mpicom, prism_part(m)%npes, ierr )
309  CALL mpi_comm_rank( prism_part(m)%mpicom, prism_part(m)%rank, ierr )
310  if (ig_size > 0) then
311  call mct_gsmap_init(prism_part(m)%pgsmap,start,length,0, &
312  prism_part(m)%mpicom,compid,numel=numel,gsize=ig_size)
313  else
314  call mct_gsmap_init(prism_part(m)%pgsmap,start,length,0, &
315  prism_part(m)%mpicom,compid,numel=numel)
316  endif
317  else
318  ! override mpicom created by split with null
319  prism_part(m)%mpicom = mpi_comm_null
320  endif
321  !else
322  !! set by default
323  ! prism_part(m)%gsize = -1
324  ! prism_part(m)%mpicom = MPI_COMM_NULL
325  endif
326  if (local_timers_on) call oasis_timer_stop('part_setup_initgsm_D')
327 
328  if (local_timers_on) call oasis_timer_start('part_setup_initgsm_E')
329  deallocate(start,length)
330  deallocate(kparal)
331  deallocate(prism_part(m)%kparal)
332 
333  if (oasis_debug >= 2) then
334  call oasis_part_write(prism_part(m),m)
335  endif
336  if (local_timers_on) call oasis_timer_stop('part_setup_initgsm_E')
337 
338  enddo ! p = 1,pcnt
339 
340  deallocate(pname)
341 
342  call oasis_timer_stop('part_setup_initgsm')
343  call oasis_timer_stop('part_setup')
344 
345  call oasis_debug_exit(subname)
346 
347  END SUBROUTINE oasis_part_setup
348 !------------------------------------------------------------
349 
350 !> Zero partition information
351 
352  SUBROUTINE oasis_part_zero(s_prism_part)
353 
354  IMPLICIT NONE
355 
356  type(prism_part_type),intent(inout) :: s_prism_part
357  !--------------------------------------------------------
358  character(len=*),parameter :: subname = '(oasis_part_zero)'
359  !--------------------------------------------------------
360 
361  call oasis_debug_enter(subname)
362 
363  s_prism_part%partname = trim(cspval)
364  s_prism_part%gsize = -1
365  s_prism_part%nx = -1
366  s_prism_part%ny = -1
367  s_prism_part%gridname = trim(cspval)
368  s_prism_part%mpicom = mpi_comm_null
369  s_prism_part%npes = -1
370  s_prism_part%rank = -1
371  s_prism_part%ig_size = -1
372 
373  call oasis_debug_exit(subname)
374 
375  END SUBROUTINE oasis_part_zero
376 !------------------------------------------------------------
377 
378 !> Print parition information
379 
380  SUBROUTINE oasis_part_write(s_prism_part,npart)
381 
382  IMPLICIT NONE
383 
384  type(prism_part_type),intent(in) :: s_prism_part
385  integer(ip_i4_p) ,intent(in) :: npart
386  !--------------------------------------------------------
387  character(len=*),parameter :: subname = '(oasis_part_write)'
388  !--------------------------------------------------------
389 
390  call oasis_debug_enter(subname)
391 
392  write(nulprt,*) ' '
393  write(nulprt,*) subname,' partnm = ',trim(s_prism_part%partname)
394  write(nulprt,*) subname,' npart = ',npart
395  write(nulprt,*) subname,' mpicom = ',s_prism_part%mpicom
396  write(nulprt,*) subname,' npes = ',s_prism_part%npes
397  write(nulprt,*) subname,' rank = ',s_prism_part%rank
398  write(nulprt,*) subname,' compid = ',s_prism_part%gsmap%comp_id
399  write(nulprt,*) subname,' ngseg = ',s_prism_part%gsmap%ngseg
400  write(nulprt,*) subname,' gsize = ',s_prism_part%gsmap%gsize
401  IF (mpi_comm_local /= mpi_comm_null) THEN
402  WRITE(nulprt,*) subname,' start = ',s_prism_part%gsmap%start
403  WRITE(nulprt,*) subname,' length = ',s_prism_part%gsmap%length
404  WRITE(nulprt,*) subname,' pe_loc = ',s_prism_part%gsmap%pe_loc
405  ENDIF
406  IF (s_prism_part%mpicom /= mpi_comm_null) THEN
407  WRITE(nulprt,*) subname,' pstart = ',s_prism_part%pgsmap%start
408  WRITE(nulprt,*) subname,' plength= ',s_prism_part%pgsmap%length
409  WRITE(nulprt,*) subname,' ppe_loc= ',s_prism_part%pgsmap%pe_loc
410  ENDIF
411  write(nulprt,*) ' '
412  CALL oasis_flush(nulprt)
413 
414  call oasis_debug_exit(subname)
415 
416  END SUBROUTINE oasis_part_write
417 !------------------------------------------------------------
418 
419 !> Create a new partition internally, needed for mapping
420 
421  SUBROUTINE oasis_part_create(id_part,TYPE,gsize,nx,ny,gridname,gscomm,mpicom)
422 
423  IMPLICIT NONE
424 
425  integer(ip_i4_p),intent(out) :: id_part !< partition id
426  character(len=*),intent(in) :: type !< type of decomposition specified
427  integer(ip_i4_p),intent(in) :: gsize !< global size of grid
428  integer(ip_i4_p),intent(in) :: nx !< global nx size
429  integer(ip_i4_p),intent(in) :: ny !< global ny size
430  character(len=*),intent(in) :: gridname !< grid name
431  integer(ip_i4_p),intent(in) :: gscomm !< global seg map communicator
432  integer(ip_i4_p),intent(in) :: mpicom !< local mpi comm
433  !--------------------------------------------------------
434  integer(ip_i4_p) :: gsrank
435  integer(ip_i4_p) :: gssize
436  integer(ip_i4_p) :: numel
437  integer(ip_i4_p),pointer :: start(:),length(:)
438  integer(ip_i4_p) :: pts
439  integer(ip_i4_p) :: found,foundall
440  integer(ip_i4_p) :: n
441  integer(ip_i4_p) :: ierr
442  character(len=*),parameter :: subname = '(oasis_part_create)'
443  !--------------------------------------------------------
444 
445  call oasis_debug_enter(subname)
446 
447  if (gscomm /= mpi_comm_null) then
448  call mpi_comm_rank(gscomm,gsrank,ierr)
449  call mpi_comm_size(gscomm,gssize,ierr)
450  else
451  gsrank = -1
452  gssize = -1
453  endif
454 
455  if (oasis_debug >= 15) then
456  write(nulprt,*) subname,' called with ',gsize,nx,ny,trim(gridname)
457  write(nulprt,*) subname,' local ',gsrank,gssize
458  endif
459 
460  !-----------------------------------------------
461  !> * Check if an existing gsmap can be reused
462  !-----------------------------------------------
463 
464  id_part = -1
465  found = 0
466  n = 0
467  do while (found == 0 .and. n < prism_npart)
468  n = n + 1
469  if (prism_part(n)%gsize == gsize .and. &
470  trim(prism_part(n)%gridname) == trim(gridname) .and. &
471  prism_part(n)%mpicom == gscomm .and. &
472  prism_part(n)%nx == nx .and. &
473  prism_part(n)%ny == ny) then
474  id_part = n
475  found = 1
476  endif
477  enddo
478 
479  !-----------------------------------------------
480  !> * Check that all tasks agree and if so, return with that partition id
481  !-----------------------------------------------
482 
483  foundall = -1
484  call oasis_mpi_min(found,foundall,mpicom,string=subname//' found',all=.true.)
485  if (foundall == 1) then
486  if (oasis_debug >= 2) then
487  write(nulprt,*) subname,' reuse part ',prism_npart,gsize
488  endif
489  call oasis_debug_exit(subname)
490  return
491  endif
492 
493  !-----------------------------------------------
494  !> * Instantiate a decomposition based on gsize and type
495  !-----------------------------------------------
496 
497  if (trim(type) == '1d') then
498  allocate(start(1),length(1))
499  start = 1
500  length = 0
501  numel = 0
502  pts = 0
503  if (gsrank >= 0) then
504  numel = 1
505  length(1) = gsize/gssize
506  pts = gsize - length(1)*gssize
507  if (gsrank < pts) length(1) = length(1) + 1
508  start(1) = gsize/gssize*(gsrank) + min(gsrank,pts) + 1
509  endif
510  prism_npart = prism_npart + 1
511  if (oasis_debug >= 15) then
512  write(nulprt,*) subname,' start ',numel,start,length,pts
513  endif
514  call oasis_part_zero(prism_part(prism_npart))
515 
516  !-----------------------------------------------
517  !> * Create a new partition and set values
518  !-----------------------------------------------
519 
520  part_name_cnt = part_name_cnt + 1
521  write(prism_part(prism_npart)%partname,'(a,i6.6)') trim(compnm)//'_part',part_name_cnt
522  prism_part(prism_npart)%gsize = gsize
523  prism_part(prism_npart)%nx = -1
524  prism_part(prism_npart)%ny = -1
525  prism_part(prism_npart)%mpicom = gscomm
526  prism_part(prism_npart)%npes = gssize
527  prism_part(prism_npart)%rank = gsrank
528 
529  !-----------------------------------------------
530  !> * Initialize the partition gsmap and pgsmap
531  !-----------------------------------------------
532 
533  call mct_gsmap_init(prism_part(prism_npart)%gsmap,start,length,0,mpicom,compid,numel=numel)
534  if (numel > 0) then
535  call mct_gsmap_init(prism_part(prism_npart)%pgsmap,start,length,0, &
536  prism_part(prism_npart)%mpicom,compid,numel=numel)
537  endif
538  deallocate(start,length)
539  if (oasis_debug >= 2) then
540  write(nulprt,*) subname,' create new part ',prism_npart,gsize
541  call oasis_part_write(prism_part(prism_npart),prism_npart)
542  endif
543  else
544  write(nulprt,*) subname,estr,'type argument unknown = ',trim(type)
545  call oasis_abort()
546  endif
547 
548  id_part = prism_npart
549 
550  call oasis_debug_exit(subname)
551 
552 END SUBROUTINE oasis_part_create
553 !------------------------------------------------------------
554 
555 END MODULE mod_oasis_part
subroutine, public oasis_debug_exit(string)
Used when a subroutine is exited, write info to log file at some debug level.
OASIS partition data and methods.
System type methods.
Provides a generic and simpler interface into MPI calls for OASIS.
subroutine oasis_part_write(s_prism_part, npart)
Print parition information.
subroutine, public oasis_timer_start(timer_label, barrier)
Start a timer.
subroutine, public oasis_timer_stop(timer_label)
Stop a timer.
Provides a common location for several OASIS variables.
subroutine, public oasis_mpi_reducelists(linp1, comm, cntout, lout1, callstr, fastcheck, fastcheckout, linp2, lout2, spval2, linp3, lout3, spval3)
Custom method for reducing MPI lists across pes for OASIS.
subroutine, public oasis_debug_enter(string)
Used when a subroutine is entered, write info to log file at some debug level.
Defines kinds for OASIS.
subroutine, public oasis_flush(nu)
Flushes output to file.
Generic overloaded interface into MPI min reduction.
subroutine, public oasis_def_partition(id_part, kparal, kinfo, ig_size, name)
The OASIS user interface to define partitions.
subroutine, public oasis_part_setup()
Synchronize partitions across all tasks, called at oasis enddef.
Performance timer methods.
subroutine oasis_part_zero(s_prism_part)
Zero partition information.
subroutine, public oasis_abort(id_compid, cd_routine, cd_message)
OASIS abort method, publically available to users.
Defines parameters for OASIS.
subroutine, public oasis_part_create(id_part, TYPE, gsize, nx, ny, gridname, gscomm, mpicom)
Create a new partition internally, needed for mapping.
Partition (decomposition) data for variables.