! ! !INTERFACE: module m_GSMapTest ! ! !USES: ! implicit none private ! except ! !PUBLIC MEMBER FUNCTIONS: public :: testall public :: Identical interface testall module procedure testGSMap_ end interface interface Identical module procedure Identical_ end interface ! !REVISION HISTORY: !EOP ___________________________________________________________________ character(len=*),parameter :: myname='m_GSMapTest' contains !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ! Math and Computer Science Division, Argonne National Laboratory ! !BOP ------------------------------------------------------------------- ! ! !IROUTINE: aVtest_ - Test the functions in the AttrVect module ! ! !DESCRIPTION: ! This routine writes diagnostic information about the input ! {\tt AttrVect}. Each line of the output will be preceded by the ! character argument {\tt identifier}. The output device is specified ! by the integer argument {\tt device}. ! ! !INTERFACE: subroutine testGSMap_(GSMap, identifier, mycomm, device) ! ! !USES: ! use m_GlobalSegMap ! Use all GlobalSegMap routines use m_GlobalToLocal ! Use all GlobalToLocal routines use m_stdio use m_die use m_mpif90 implicit none ! !INPUT PARAMETERS: type(GlobalSegMap), intent(in) :: GSMap character(len=*), intent(in) :: identifier integer, intent(in) :: device integer, intent(in) :: mycomm ! !REVISION HISTORY: ! 23Sep02 - E.T. Ong <eong@mcs.anl.gov> - initial prototype. !EOP ___________________________________________________________________ character(len=*),parameter :: myname_=myname//'::testGSMap_' integer :: myProc, mySize, ierr integer :: i, j, k, m, n, o integer :: first,last, owner, numlocs, nactive, npoints, proc integer, dimension(:), pointer :: points, owners, pelist, perm, & mystart, mylength integer, dimension(:), allocatable :: locs, slpArray logical :: found type(GlobalSegMap) :: PGSMap, P1GSMap !::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::! !:::::WRITE OUT INFO ABOUT THE GLOBALSEGMAP::::::::::::::::::::::::::::! !::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::! call MPI_COMM_RANK (mycomm, myProc, ierr) call MPI_COMM_SIZE(mycomm, mySize, ierr) write(device,*) identifier, ":: TYPE CHECK:" write(device,*) identifier, ":: COMP_ID = ", GSMap%comp_id write(device,*) identifier, ":: NGSEG = ", GSMap%ngseg write(device,*) identifier, ":: GSIZE = ", GSMap%gsize write(device,*) identifier, ":: START:: association status, & & size, values = ", associated(GSMap%start), size(GSMap%start) write(device,*) identifier, ":: START = ", GSMap%start write(device,*) identifier, ":: LENGTH:: association status, & &size, values = ", associated(GSMap%length), size(GSMap%length) write(device,*) identifier, ":: LENGTH = ", GSMap%length write(device,*) identifier, ":: PE_LOC:: association status, & &size, values = ", associated(GSMap%pe_loc), size(GSMap%pe_loc) write(device,*) identifier, ":: PE_LOC = ", GSMap%pe_loc write(device,*) identifier, ":: NGSEG_ = ", ngseg(GSMap) write(device,*) identifier, ":: NLSEG_ = ", nlseg(GSMap,myProc) write(device,*) identifier, ":: COMP_ID_ = ", comp_id(GSMap) write(device,*) identifier, ":: GSIZE_ = ", gsize(GSMap) write(device,*) identifier, ":: GLOBALSTORAGE = ", GlobalStorage(GSMap) write(device,*) identifier, ":: PROCESSSTORAGE = (PE, PE-STORAGE)" do i=1,mySize write(device,*) identifier, ":: PROCESSSTORAGE = ", & i-1, ProcessStorage(GSMap,i-1) enddo write(device,*) identifier, ":: LSIZE_ = ", lsize(GSMap,mycomm) write(device,*) identifier, ":: HALOED = ", haloed(GSMap) write(device,*) identifier, ":: SUBROUTINES CHECK:" write(device,*) identifier, ":: ORDERED POINTS = (PE, SIZE, FIRST, LAST)" do i=1,mySize first=1 last=0 proc = i-1 call OrderedPoints(GSMap,proc,points) npoints=size(points) if(npoints>0) then first = points(1) last = points(npoints) write(device,*) identifier, ":: ORDERED POINTS = ", proc, npoints, & first, last else write(device,*) identifier, ":: ORDERED POINTS :: EXTREME WARNING:: & &Process ", proc, " contains ", npoints, "points" write(device,*) identifier, ":: AS A RESULT, & &NOT TESTING RANK AND PELOCS::" EXIT ! call die(myname_,"OrderedPoints may have failed ") endif !:::CHECK THE CORRECTNESS OF ROUTINE RANK1_:::! !::NOT YET PUBLIC IN MODULE::! if(haloed(GSMap)) then do k=first,last call rank(GSMap,k,numlocs,owners) found = .false. do n=1,numlocs if(owners(n) /= proc) then found = .true. endif enddo if(.not.found) then call die(myname_,"SUBROUTINE RANKM_ failed!") endif enddo deallocate(owners,stat=ierr) if(ierr/=0) call die(myname_,"deallocate(owners)",ierr) else allocate(locs(npoints),stat=ierr) if(ierr/=0) call die(myname_,"allocate(locs)") call peLocs(GSMap,npoints,points,locs) do n=1,npoints if(locs(n) /= proc) then call die(myname_,"SUBROUTINE PELOCS FAILED!",locs(n)) endif enddo deallocate(locs,stat=ierr) if(ierr/=0) call die(myname_,"deallocate(locs)") do k=first,last call rank(GSMap,k,owner) if(owner /= proc) then write(device,*) identifier, ":: RANK1_ FAILED:: ", owner, proc, first, last, k call die(myname_,"SUBROUTINE RANK1_ failed!") endif enddo endif !:::::::::::::::::::::::::::::::::::::::::::::! deallocate(points,stat=ierr) if(ierr/=0) call die(myname_,"deallocate(points)",ierr) enddo call active_pes(GSMap, nactive, pelist) write(device,*) identifier, ":: ACTIVE PES (NUM_ACTIVE, PE_LIST) = ", & nactive, pelist deallocate(pelist,stat=ierr) if(ierr/=0) call die(myname_,"deallocate(pelist)",ierr) write(device,*) identifier, ":: TESTING INITP and INITP1" call init(PGSMAP, GSMap%comp_id, GSMap%ngseg, GSMap%gsize, GSMap%start, & GSMap%length, GSMap%pe_loc) k = size(GSMap%start)+size(GSMap%length)+size(GSMap%pe_loc) allocate(slparray(k),stat=ierr) if(ierr/=0) call die(myname_,"allocate(slparray)",ierr) slpArray(1:GSMap%ngseg) = GSMap%start(1:GSMap%ngseg) slpArray(GSMap%ngseg+1:2*GSMap%ngseg) = GSMap%length(1:GSMap%ngseg) slpArray(2*GSMap%ngseg+1:3*GSMap%ngseg) = GSMap%pe_loc(1:GSMap%ngseg) call init(P1GSMap, GSMap%comp_id, GSMap%ngseg, GSMap%gsize, slpArray) deallocate(slpArray,stat=ierr) if(ierr/=0) call die(myname_,"deallocate(slparray)",ierr) write(device,*) identifier, ":: COMPARE ALL GLOBALSEGMAPS: & & YOU SHOULD SEE 3 IDENTICAL COLUMNS OF NUMBERS:" write(device,*) identifier, ":: COMP_ID = ", & GSMap%comp_id, PGSMap%comp_id, P1GSMap%comp_id write(device,*) identifier, ":: NGSEG = ", & GSMap%ngseg, GSMap%ngseg, GSMap%ngseg write(device,*) identifier, ":: GSIZE = ", & GSMap%gsize, GSMap%gsize, GSMap%gsize write(device,*) identifier, ":: START:: association status = ", & associated(GSMap%start), associated(PGSMap%start), & associated(P1GSMap%start) write(device,*) identifier, ":: START:: size = ", & size(GSMap%start), size(PGSMap%start), size(P1GSMap%start) write(device,*) identifier, ":: LENGTH:: association status = ", & associated(GSMap%length), associated(PGSMap%length), & associated(P1GSMap%length) write(device,*) identifier, ":: LENGTH:: size = ", & size(GSMap%length), size(PGSMap%length), size(P1GSMap%length) write(device,*) identifier, ":: PE_LOC:: association status = ", & associated(GSMap%pe_loc), associated(PGSMap%pe_loc), & associated(P1GSMap%pe_loc) write(device,*) identifier, ":: PE_LOC:: size = ", & size(GSMap%pe_loc), size(PGSMap%pe_loc), size(P1GSMap%pe_loc) do i=1,GSMap%ngseg if( (GSMap%start(i) /= PGSMap%start(i)) .or. & (GSMap%start(i) /= P1GSMap%start(i)) ) then call die(myname_,"INITP or INITP1 failed -starts-!") endif if( (GSMap%length(i) /= PGSMap%length(i)) .or. & (GSMap%length(i) /= P1GSMap%length(i)) ) then call die(myname_,"INITP or INITP1 failed -lengths-!") endif if( (GSMap%pe_loc(i) /= PGSMap%pe_loc(i)) .or. & (GSMap%pe_loc(i) /= P1GSMap%pe_loc(i)) ) then call die(myname_,"INITP or INITP1 failed -pe_locs-!") endif enddo write(device,*) identifier, ":: TESTING SORT AND PERMUTE" call Sort(PGSMap,PGSMap%pe_loc,PGSMap%start,perm) call Permute(PGSMap, perm) deallocate(perm,stat=ierr) if(ierr/=0) call die(myname_,"deallocate(perm)") call SortPermute(P1GSMap,PGSMap%pe_loc,PGSMap%start) do i=1,GSMap%ngseg if( (P1GSMap%start(i) /= PGSMap%start(i)) ) then call die(myname_,"Sort or Permute failed -starts-!") endif if( (P1GSMap%length(i) /= PGSMap%length(i)) ) then call die(myname_,"Sort or Permute failed -lengths-!") endif if( (P1GSMap%pe_loc(i) /= PGSMap%pe_loc(i)) ) then call die(myname_,"Sort or Permute failed -pe_locs-!") endif enddo write(device,*) identifier, ":: TESTING GLOBALTOLOCAL FUNCTIONS ::" write(device,*) identifier, ":: TESTING GLOBALSEGMAPTOINDICES ::" call GlobalToLocalIndices(GSMap,mycomm,mystart,mylength) if(.NOT. (associated(mystart).and.associated(mylength)) ) then call die(myname_, "::GLOBALSEGMAPTOINDICES::& &mystart and/or mylength is not associated") endif if(size(mystart)<0) then call die(myname_, "::GLOBALSEGMAPTOINDICES::size(start) < 0") endif if(size(mystart) /= size(mylength)) then call die(myname_, "::GLOBALSEGMAPTOINDICES::size(start)/=size(length)") endif if(size(mystart) /= nlseg(GSMap,myProc)) then call die(myname_, "::GLOBALSEGMAPTOINDICES::size(start)/=nlseg") endif if(size(mystart)>0) then write(device,*) identifier, ":: GLOBALSEGMAPTOINDICES :: & &start = (size, values) ", & size(mystart), mystart else write(device,*) identifier, ":: GLOBALSEGMAPTOINDICES :: & &start has zero size" endif if(size(mylength)>0) then write(device,*) identifier, ":: GLOBALSEGMAPTOINDICES :: & &length = (size, values) ", & size(mylength), mylength else write(device,*) identifier, ":: GLOBALSEGMAPTOINDICES :: & &length has zero size" endif if(size(mystart)>0) then write(device,*) identifier, ":: GLOBALSEGMAPTOINDICES :: & &first, last indices = ", & mystart(1), mystart(size(mystart))+mylength(size(mylength))-1 else write(device,*) identifier, ":: GLOBALSEGMAPTOINDICES :: NOT TESTING& & THIS ROUTINE BECAUSE START AND LENGTH HAVE ZERO SIZE" endif deallocate(mystart,mylength,stat=ierr) if(ierr/=0) call die(myname_,"deallocate(mystart,mylength)") write(device,*) identifier, ":: TESTING GLOBALSEGMAPTOINDEX" j=-12345 k=-12345 do i=1,GlobalStorage(GSMap) if(GlobalToLocalIndex(GSMap,i,mycomm)/=-1) then j=GlobalToLocalIndex(GSMap,i,mycomm) EXIT endif enddo do i=1,GlobalStorage(GSMap) if(GlobalToLocalIndex(GSMap,i,mycomm)/=-1) then k=GlobalToLocalIndex(GSMap,i,mycomm) endif enddo if( (j==-12345).and.(k==-12345) ) then write(device,*) identifier, ":: GlobalSegMapToIndex :: & &THIS PROCESS OWNS ZERO POINTS" else write(device,*) identifier, ":: GlobalSegMapToIndex :: & &first, last indices = ", j, k endif end subroutine testGSMap_ logical function Identical_(GSMap1,GSMap2) use m_GlobalSegMap ! Use all GlobalSegMap routines implicit none type(GlobalSegMap), intent(in) :: GSMap1, GSMap2 integer :: i Identical_=.true. if(GSMap1%comp_id /= GSMap2%comp_id) Identical_=.false. if(GSMap1%ngseg /= GSMap2%ngseg) Identical_=.false. if(GSMap1%gsize /= GSMap2%gsize) Identical_=.false. do i=1,GSMap1%ngseg if(GSMap1%start(i) /= GSMap2%start(i)) Identical_=.false. if(GSMap1%length(i) /= GSMap2%length(i)) Identical_ =.false. if(GSMap1%pe_loc(i) /= GSMap2%pe_loc(i)) Identical_ =.false. enddo end function Identical_ end module m_GSMapTest