26 integer(kind=ip_intwp_p),
parameter :: mpart = 100
30 character(len=ic_lvar2):: partname
31 type(mct_gsmap) :: gsmap
32 integer(kind=ip_i4_p) :: gsize
33 integer(kind=ip_i4_p) :: nx
34 integer(kind=ip_i4_p) :: ny
35 character(len=ic_lvar) :: gridname
36 integer(kind=ip_i4_p) :: mpicom
37 integer(kind=ip_i4_p) :: npes
38 integer(kind=ip_i4_p) :: rank
39 type(mct_gsmap) :: pgsmap
41 integer(kind=ip_i4_p) :: ig_size
42 integer(kind=ip_i4_p),
pointer :: kparal(:)
45 integer(kind=ip_intwp_p),
public :: prism_npart = 0
50 integer(kind=ip_intwp_p) :: part_name_cnt = 0
77 INTEGER(kind=ip_intwp_p) ,
intent(out) :: id_part
78 INTEGER(kind=ip_intwp_p),
DIMENSION(:),
intent(in) :: kparal
79 INTEGER(kind=ip_intwp_p),
optional ,
intent(out) :: kinfo
80 INTEGER(kind=ip_intwp_p),
optional ,
intent(in) :: ig_size
81 character(len=*) ,
optional ,
intent(in) :: name
83 integer(kind=ip_intwp_p) :: n
84 character(len=*),
parameter :: subname =
'(oasis_def_partition)'
89 if (.not. oasis_coupled)
then
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'
109 id_part = prism_npart
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)
117 prism_part(prism_npart)%partname = trim(name)
119 part_name_cnt = part_name_cnt + 1
120 write(prism_part(prism_npart)%partname,
'(a,i6.6)') trim(compnm)//
'_part',part_name_cnt
123 if (
present(ig_size))
then
124 prism_part(prism_npart)%ig_size = ig_size
127 allocate(prism_part(prism_npart)%kparal(
size(kparal)))
128 prism_part(prism_npart)%kparal = kparal
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
151 character(len=ic_lvar2),
pointer :: pname0(:),pname(:)
152 logical,
parameter :: local_timers_on = .false.
153 character(len=*),
parameter :: subname =
'(oasis_part_setup)'
158 if (local_timers_on)
then
160 if (mpi_comm_local /= mpi_comm_null) &
161 call mpi_barrier(mpi_comm_local, ierr)
171 allocate(pname0(prism_npart))
173 pname0(n) = prism_part(n)%partname
183 if (local_timers_on)
then
185 if (mpi_comm_local /= mpi_comm_null) &
186 call mpi_barrier(mpi_comm_local, ierr)
196 do while (n < prism_npart .and. .not.found)
198 if (prism_part(n)%partname == pname(p))
then
209 prism_npart = prism_npart + 1
212 prism_part(prism_npart)%partname = pname(p)
213 allocate(prism_part(prism_npart)%kparal(3))
214 prism_part(prism_npart)%kparal = 0
223 allocate(kparal(
size(prism_part(m)%kparal)))
224 kparal = prism_part(m)%kparal
225 ig_size = prism_part(m)%ig_size
227 if (kparal(clim_strategy) == clim_serial)
then
229 allocate(start(nsegs),length(nsegs))
231 length(1) = kparal(clim_length)
233 if (length(1) == 0) numel = 0
234 elseif (kparal(clim_strategy) == clim_apple)
then
236 allocate(start(nsegs),length(nsegs))
237 start(1) = kparal(clim_offset) + 1
238 length(1) = kparal(clim_length)
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))
245 start(n) = kparal(clim_offset) + (n-1)*kparal(clim_ldx) + 1
246 length(n) = kparal(clim_sizex)
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))
255 ilen = kparal((n-1)*2 + 4)
258 start(numel) = kparal((n-1)*2 + 3) + 1
262 elseif (kparal(clim_strategy) == clim_points)
then
263 nsegs = kparal(clim_segments)
264 allocate(start(nsegs),length(nsegs))
269 start(nsegs) = kparal(k)
272 do n = 2,kparal(clim_segments)
274 if (kparal(k)-kparal(k-1) == 1)
then
275 length(nsegs) = length(nsegs) + 1
278 start(nsegs) = kparal(k)
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
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)
300 call mct_gsmap_init(prism_part(m)%gsmap,start,length,mpi_root_local,&
301 mpi_comm_local,compid,numel=numel)
303 prism_part(m)%gsize = mct_gsmap_gsize(prism_part(m)%gsmap)
305 if (numel > 0) icpl = 1
306 CALL mpi_comm_split(mpi_comm_local,icpl,1,prism_part(m)%mpicom,ierr)
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)
314 call mct_gsmap_init(prism_part(m)%pgsmap,start,length,0, &
315 prism_part(m)%mpicom,compid,numel=numel)
319 prism_part(m)%mpicom = mpi_comm_null
329 deallocate(start,length)
331 deallocate(prism_part(m)%kparal)
333 if (oasis_debug >= 2)
then
358 character(len=*),
parameter :: subname =
'(oasis_part_zero)'
363 s_prism_part%partname = trim(cspval)
364 s_prism_part%gsize = -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
385 integer(ip_i4_p) ,
intent(in) :: npart
387 character(len=*),
parameter :: subname =
'(oasis_part_write)'
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
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
425 integer(ip_i4_p),
intent(out) :: id_part
426 character(len=*),
intent(in) ::
type
427 integer(ip_i4_p),
intent(in) :: gsize
428 integer(ip_i4_p),
intent(in) :: nx
429 integer(ip_i4_p),
intent(in) :: ny
430 character(len=*),
intent(in) :: gridname
431 integer(ip_i4_p),
intent(in) :: gscomm
432 integer(ip_i4_p),
intent(in) :: mpicom
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)'
447 if (gscomm /= mpi_comm_null)
then
448 call mpi_comm_rank(gscomm,gsrank,ierr)
449 call mpi_comm_size(gscomm,gssize,ierr)
455 if (oasis_debug >= 15)
then
456 write(nulprt,*) subname,
' called with ',gsize,nx,ny,trim(gridname)
457 write(nulprt,*) subname,
' local ',gsrank,gssize
467 do while (found == 0 .and. n < prism_npart)
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
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
497 if (trim(type) ==
'1d')
then
498 allocate(start(1),length(1))
503 if (gsrank >= 0)
then
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
510 prism_npart = prism_npart + 1
511 if (oasis_debug >= 15)
then
512 write(nulprt,*) subname,
' start ',numel,start,length,pts
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
533 call mct_gsmap_init(prism_part(prism_npart)%gsmap,start,length,0,mpicom,compid,numel=numel)
535 call mct_gsmap_init(prism_part(prism_npart)%pgsmap,start,length,0, &
536 prism_part(prism_npart)%mpicom,compid,numel=numel)
538 deallocate(start,length)
539 if (oasis_debug >= 2)
then
540 write(nulprt,*) subname,
' create new part ',prism_npart,gsize
544 write(nulprt,*) subname,estr,
'type argument unknown = ',trim(type)
548 id_part = prism_npart
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.
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.
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.