diff --git a/Make.inc b/Make.inc index 46ecd6ea..35619377 100644 --- a/Make.inc +++ b/Make.inc @@ -1,6 +1,6 @@ .mod=.mod .fh=.fh -.SUFFIXES: .f90 $(.mod) +.SUFFIXES: .f90 $(.mod) .F90 ####################### Section 1 ####################### @@ -10,9 +10,9 @@ F90=/usr/local/gcc42/bin/gfortran FC=/usr/local/gcc42/bin/gfortran F77=$(FC) CC=/usr/local/gcc42/bin/gcc -F90COPT= -O3 -march=pentium4 -msse2 -mfpmath=sse -FCOPT=-O3 -march=pentium4 -msse2 -mfpmath=sse -CCOPT=-O3 -march=pentium4 -msse2 -mfpmath=sse +F90COPT= -O3 -march=pentium4 -msse2 -mfpmath=sse -ggdb -fbounds-check +FCOPT=-O3 -march=pentium4 -msse2 -mfpmath=sse -ggdb -fbounds-check +CCOPT=-O3 -march=pentium4 -msse2 -mfpmath=sse -ggdb ####################### Section 2 ####################### # Define your linker and linker flags here # @@ -28,7 +28,6 @@ MPCC=/usr/local/mpich-gcc42/bin/mpicc ########################################################## BLAS=-lblas-gcc42 -L$(HOME)/LIB BLACS=-lmpiblacs-gcc42 -L$(HOME)/LIB -EXTRA_BLACS_ENV_OBJS=extra_env.o ####################### Section 4 ####################### @@ -44,6 +43,7 @@ UMFDEF=-DHave_UMF_ -I$(UMFDIR) # Add -DLargeFptr for 64-bit addresses CDEFINES=-DAdd_ $(SLUDEF) $(UMFDEF) +FDEFINES=-DNORMAL AR=ar -cur RANLIB=ranlib @@ -82,6 +82,9 @@ $(.mod).o: $(F90) $(F90COPT) $(INCDIRS) -c $< .f90.o: $(F90) $(F90COPT) $(INCDIRS) -c $< +.F90.o: + $(F90) $(F90COPT) $(INCDIRS) $(FDEFINES) -c $< + diff --git a/Make.inc.g95 b/Make.inc.g95 index f39aacbc..524f0829 100644 --- a/Make.inc.g95 +++ b/Make.inc.g95 @@ -27,7 +27,6 @@ MPCC=/usr/local/mpich-g95/bin/mpicc ########################################################## BLAS=-lblasg95 -L$(HOME)/LIB BLACS=-lmpiblacsg95 -L$(HOME)/LIB -EXTRA_BLACS_ENV_OBJS=extra_env.o ####################### Section 4 ####################### @@ -43,6 +42,7 @@ EXTRA_BLACS_ENV_OBJS=extra_env.o # Add -DLargeFptr for 64-bit addresses CDEFINES=-DAdd_ $(SLUDEF) $(UMFDEF) +FDEFINES=-DNORMAL AR=ar -cur RANLIB=ranlib @@ -81,4 +81,5 @@ $(.mod).o: $(F90) $(F90COPT) $(INCDIRS) -c $< .f90.o: $(F90) $(F90COPT) $(INCDIRS) -c $< - +.F90.o: + $(F90) $(F90COPT) $(INCDIRS) $(FDEFINES) -c $< diff --git a/Make.inc.gcc42 b/Make.inc.gcc42 index 46ecd6ea..95cf8255 100644 --- a/Make.inc.gcc42 +++ b/Make.inc.gcc42 @@ -28,7 +28,6 @@ MPCC=/usr/local/mpich-gcc42/bin/mpicc ########################################################## BLAS=-lblas-gcc42 -L$(HOME)/LIB BLACS=-lmpiblacs-gcc42 -L$(HOME)/LIB -EXTRA_BLACS_ENV_OBJS=extra_env.o ####################### Section 4 ####################### @@ -44,6 +43,7 @@ UMFDEF=-DHave_UMF_ -I$(UMFDIR) # Add -DLargeFptr for 64-bit addresses CDEFINES=-DAdd_ $(SLUDEF) $(UMFDEF) +FDEFINES=-DNORMAL AR=ar -cur RANLIB=ranlib @@ -82,6 +82,8 @@ $(.mod).o: $(F90) $(F90COPT) $(INCDIRS) -c $< .f90.o: $(F90) $(F90COPT) $(INCDIRS) -c $< +.F90.o: + $(F90) $(F90COPT) $(INCDIRS) $(FDEFINES) -c $< diff --git a/Make.inc.ifc9 b/Make.inc.ifc9 index 2566c0a2..4c41dce0 100644 --- a/Make.inc.ifc9 +++ b/Make.inc.ifc9 @@ -29,7 +29,7 @@ MPCC=/usr/local/mpich-ifc91/bin/mpicc -g -CB -no_cpprt ########################################################## BLAS=-lblas-intel -L$(HOME)/NUMERICAL/LIB BLACS=-lmpiblacs-intel -L$(HOME)/NUMERICAL/LIB -EXTRA_BLACS_ENV_OBJS=extra_env.o + ####################### Section 4 ####################### @@ -45,6 +45,7 @@ UMFDEF=-DHave_UMF_ -I$(UMFDIR) # Add -DLargeFptr for 64-bit addresses CDEFINES=-DAdd_ $(SLUDEF) $(UMFDEF) +FDEFINES=-DNORMAL AR=ar -cur RANLIB=ranlib @@ -83,6 +84,8 @@ $(.mod).o: $(F90) $(F90COPT) $(INCDIRS) -c $< .f90.o: $(F90) $(F90COPT) $(INCDIRS) -c $< +.F90.o: + $(F90) $(F90COPT) $(INCDIRS) $(FDEFINES) -c $< diff --git a/Make.inc.rs6k b/Make.inc.rs6k index f57b233c..dc8aedb7 100644 --- a/Make.inc.rs6k +++ b/Make.inc.rs6k @@ -28,11 +28,6 @@ MPCC=mpxlc ########################################################## BLAS=-lessl BLACS=-lmpiblacs -EXTRA_BLACS_ENV_OBJS=extra_env.o -#These should be uncommented when using the ESSL BLACS library -#EXTRA_BLACS_P2P_OBJS= krecvid.o ksendid.o -#EXTRA_BLACS_ENV_OBJS=extra_env_essl.o - ####################### Section 4 ####################### @@ -48,6 +43,7 @@ EXTRA_BLACS_ENV_OBJS=extra_env.o # Add -DLargeFptr for 64-bit addresses CDEFINES=-DAdd_ $(SLUDEF) $(UMFDEF) -DLargeFptr +FDEFINES=-DHAVE_ESSL AR=ar -cur RANLIB=ranlib @@ -86,6 +82,9 @@ $(.mod).o: $(F90) $(F90COPT) $(INCDIRS) -c $< .f90.o: $(F90) $(F90COPT) $(INCDIRS) -c $< +.F90.o: + $(F90) $(F90COPT) $(INCDIRS) $(FDEFINES) -c $< + diff --git a/src/internals/Makefile b/src/internals/Makefile index 83a37c00..08c868ae 100644 --- a/src/internals/Makefile +++ b/src/internals/Makefile @@ -3,7 +3,7 @@ include ../../Make.inc FOBJS = psi_compute_size.o psi_crea_bnd_elem.o psi_crea_index.o \ psi_crea_ovr_elem.o psi_dl_check.o \ psi_gthsct.o \ - psi_sort_dl.o $(EXTRA_BLACS_P2P_OBJS) + psi_sort_dl.o FOBJS2 = psi_exist_ovr_elem.o psi_list_search.o srtlist.o COBJS = avltree.o srcht.o diff --git a/src/internals/krecvid.f90 b/src/internals/krecvid.f90 deleted file mode 100644 index 8a552d85..00000000 --- a/src/internals/krecvid.f90 +++ /dev/null @@ -1,7 +0,0 @@ - integer function krecvid(contxt,proc_to_comm,myrow) - integer contxt,proc_to_comm,myrow - - krecvid=32766 - - return - end diff --git a/src/internals/ksendid.f90 b/src/internals/ksendid.f90 deleted file mode 100644 index c9c5bc48..00000000 --- a/src/internals/ksendid.f90 +++ /dev/null @@ -1,7 +0,0 @@ - integer function ksendid(contxt,proc_to_comm,myrow) - integer contxt,proc_to_comm,myrow - - ksendid=32766 - - return - end diff --git a/src/internals/psi_crea_bnd_elem.f90 b/src/internals/psi_crea_bnd_elem.f90 index 591dc40c..097ed198 100644 --- a/src/internals/psi_crea_bnd_elem.f90 +++ b/src/internals/psi_crea_bnd_elem.f90 @@ -28,12 +28,13 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine psi_crea_bnd_elem(desc_a,info) - +subroutine psi_crea_bnd_elem(bndel,desc_a,info) + use psb_realloc_mod use psb_descriptor_type use psb_error_mod implicit none - + + integer, pointer :: bndel(:) type(psb_desc_type) :: desc_a integer, intent(out) :: info @@ -82,20 +83,26 @@ subroutine psi_crea_bnd_elem(desc_a,info) if (.true.) then - allocate(desc_a%bnd_elem(j),stat=info) - if (info /= 0) then - call psb_errpush(4010,name,a_err='Allocate') - goto 9999 + if (j>0) then + allocate(bndel(j),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + bndel(1:j) = work(1:j) + else + if (associated(bndel)) then + deallocate(bndel) + end if end if - desc_a%bnd_elem(1:j) = work(1:j) else - allocate(desc_a%bnd_elem(j+1),stat=info) + allocate(bndel(j+1),stat=info) if (info /= 0) then call psb_errpush(4010,name,a_err='Allocate') goto 9999 end if - desc_a%bnd_elem(1:j) = work(1:j) - desc_a%bnd_elem(j+1) = -1 + bndel(1:j) = work(1:j) + bndel(j+1) = -1 endif deallocate(work) diff --git a/src/modules/Makefile b/src/modules/Makefile index aac91487..9de6976e 100644 --- a/src/modules/Makefile +++ b/src/modules/Makefile @@ -6,7 +6,7 @@ MODULES = psb_realloc_mod.o psb_string_mod.o psb_spmat_type.o \ psb_prec_type.o psb_error_mod.o psb_prec_mod.o \ psb_methd_mod.o psb_const_mod.o \ psb_comm_mod.o psb_psblas_mod.o psi_mod.o \ - psb_check_mod.o $(EXTRA_BLACS_ENV_OBJS) + psb_check_mod.o blacs_env.o MPFOBJS = psb_penv_mod.o @@ -21,10 +21,13 @@ psb_spmat_type.o : psb_realloc_mod.o psb_const_mod.o psb_error_mod.o: psb_const_mod.o psb_penv_mod.o: psb_const_mod.o psb_error_mod.o psi_mod.o: psb_penv_mod.o psb_error_mod.o psb_desc_type.o +psb_desc_type.o: psb_const_mod.o psb_methd_mod.o: psb_serial_mod.o psb_desc_type.o psb_prec_type.o +psb_tools_mod.o: psb_spmat_type.o psb_desc_type.o psi_mod.o psb_sparse_mod.o: $(MODULES) $(MPFOBJS) -lib: mpfobjs $(MODULES) $(OBJS) + +lib: mpfobjs $(MODULES) $(OBJS) $(AR) $(LIBDIR)/$(LIBNAME) $(MODULES) $(OBJS) $(MPFOBJS) $(RANLIB) $(LIBDIR)/$(LIBNAME) /bin/cp *$(.mod) ./parts.fh ../../lib diff --git a/src/modules/extra_env.f90 b/src/modules/extra_env.f90 deleted file mode 100644 index 4a17f8bb..00000000 --- a/src/modules/extra_env.f90 +++ /dev/null @@ -1,20 +0,0 @@ -subroutine psb_set_coher(ictxt,isvch) - integer :: ictxt, isvch - ! Ensure global coherence for convergence checks. - Call blacs_get(ictxt,16,isvch) - Call blacs_set(ictxt,16,1) -end subroutine psb_set_coher -subroutine psb_restore_coher(ictxt,isvch) - integer :: ictxt, isvch - ! Ensure global coherence for convergence checks. - Call blacs_set(ictxt,16,isvch) -end subroutine psb_restore_coher -subroutine psb_get_mpicomm(ictxt,comm) - integer :: ictxt, comm - call blacs_get(ictxt,10,comm) -end subroutine psb_get_mpicomm -subroutine psb_get_rank(rank,ictxt,id) - integer :: rank,ictxt, id - integer :: blacs_pnum - rank = blacs_pnum(ictxt,id,0) -end subroutine psb_get_rank diff --git a/src/modules/extra_env_essl.f90 b/src/modules/extra_env_essl.f90 deleted file mode 100644 index d39b9514..00000000 --- a/src/modules/extra_env_essl.f90 +++ /dev/null @@ -1,17 +0,0 @@ -subroutine psb_set_coher(ictxt,isvch) - integer :: ictxt, isvch - ! Ensure global coherence for convergence checks. - ! Do nothing: ESSL does coherence by default, - ! and does not handle req=16 -!!$ Call blacs_get(ictxt,16,isvch) -!!$ Call blacs_set(ictxt,16,1) -end subroutine psb_set_coher -subroutine psb_restore_coher(ictxt,isvch) - integer :: ictxt, isvch - ! Ensure global coherence for convergence checks. -!!$ Call blacs_set(ictxt,16,isvch) -end subroutine psb_restore_coher -subroutine psb_get_mpicomm(ictxt,comm) - integer :: ictxt, comm - call blacs_get(ictxt,10,comm) -end subroutine psb_get_mpicomm diff --git a/src/modules/psb_desc_type.f90 b/src/modules/psb_desc_type.f90 index 6e9ff1be..ed24d28b 100644 --- a/src/modules/psb_desc_type.f90 +++ b/src/modules/psb_desc_type.f90 @@ -49,10 +49,10 @@ module psb_descriptor_type ! contain indices of boundary elements integer, pointer :: bnd_elem(:)=>null() ! contain index of overlap elements to send/receive - integer, pointer :: ovrlap_elem(:)=>null() + integer, pointer :: ovrlap_index(:)=>null() ! contain for each local overlap element, the number of times ! that is duplicated - integer, pointer :: ovrlap_index(:)=>null() + integer, pointer :: ovrlap_elem(:)=>null() ! contain for each local element the corresponding global index integer, pointer :: loc_to_glob(:)=>null() ! contain for each global element the corresponding local index, diff --git a/src/modules/psb_realloc_mod.f90 b/src/modules/psb_realloc_mod.f90 index 5649f720..568fccf7 100644 --- a/src/modules/psb_realloc_mod.f90 +++ b/src/modules/psb_realloc_mod.f90 @@ -49,9 +49,94 @@ module psb_realloc_mod & psb_dcpy1d, psb_dcpy2d, psb_zcpy1d, psb_zcpy2d end Interface - + interface psb_size + module procedure psb_isize1d, psb_isize2d,& + & psb_dsize1d, psb_dsize2d,& + & psb_zsize1d, psb_zsize2d + end interface + contains + function psb_isize1d(vin) + integer :: psb_isize1d + integer, pointer :: vin(:) + + if (.not.associated(vin)) then + psb_isize1d = 0 + else + psb_isize1d = size(vin) + end if + end function psb_isize1d + function psb_isize2d(vin,dim) + integer :: psb_isize2d + integer, pointer :: vin(:,:) + integer, optional :: dim + + if (.not.associated(vin)) then + psb_isize2d = 0 + else + if (present(dim)) then + psb_isize2d = size(vin,dim=dim) + else + psb_isize2d = size(vin) + end if + end if + end function psb_isize2d + + function psb_dsize1d(vin) + integer :: psb_dsize1d + real(kind(1.d0)), pointer :: vin(:) + + if (.not.associated(vin)) then + psb_dsize1d = 0 + else + psb_dsize1d = size(vin) + end if + end function psb_dsize1d + function psb_dsize2d(vin,dim) + integer :: psb_dsize2d + real(kind(1.d0)), pointer :: vin(:,:) + integer, optional :: dim + + if (.not.associated(vin)) then + psb_dsize2d = 0 + else + if (present(dim)) then + psb_dsize2d = size(vin,dim=dim) + else + psb_dsize2d = size(vin) + end if + end if + end function psb_dsize2d + + + function psb_zsize1d(vin) + integer :: psb_zsize1d + complex(kind(1.d0)), pointer :: vin(:) + + if (.not.associated(vin)) then + psb_zsize1d = 0 + else + psb_zsize1d = size(vin) + end if + end function psb_zsize1d + function psb_zsize2d(vin,dim) + integer :: psb_zsize2d + complex(kind(1.d0)), pointer :: vin(:,:) + integer, optional :: dim + + if (.not.associated(vin)) then + psb_zsize2d = 0 + else + if (present(dim)) then + psb_zsize2d = size(vin,dim=dim) + else + psb_zsize2d = size(vin) + end if + end if + end function psb_zsize2d + + subroutine psb_icpy1d(vin,vout,info) use psb_error_mod diff --git a/src/modules/psb_tools_mod.f90 b/src/modules/psb_tools_mod.f90 index 0ae51997..3befe0e1 100644 --- a/src/modules/psb_tools_mod.f90 +++ b/src/modules/psb_tools_mod.f90 @@ -632,4 +632,34 @@ Module psb_tools_mod end subroutine psb_cddec end interface + interface psb_get_boundary + module procedure psb_get_boundary + end interface + + interface psb_get_overlap + subroutine psb_get_ovrlap(ovrel,desc,info) + use psb_descriptor_type + implicit none + integer, pointer :: ovrel(:) + type(psb_desc_type), intent(in) :: desc + integer, intent(out) :: info + end subroutine psb_get_ovrlap + end interface + + + +contains + + subroutine psb_get_boundary(bndel,desc,info) + use psb_descriptor_type + use psi_mod + implicit none + integer, pointer :: bndel(:) + type(psb_desc_type), intent(in) :: desc + integer, intent(out) :: info + + call psb_crea_bnd_elem(bndel,desc,info) + + end subroutine psb_get_boundary + end module psb_tools_mod diff --git a/src/modules/psi_mod.f90 b/src/modules/psi_mod.f90 index d1f915e4..4581b8e5 100644 --- a/src/modules/psi_mod.f90 +++ b/src/modules/psi_mod.f90 @@ -43,10 +43,11 @@ module psi_mod end interface interface - subroutine psi_crea_bnd_elem(desc_a,info) + subroutine psi_crea_bnd_elem(bndel,desc_a,info) use psb_descriptor_type - type(psb_desc_type) :: desc_a - integer, intent(out) :: info + integer, pointer :: bndel(:) + type(psb_desc_type), intent(in) :: desc_a + integer, intent(out) :: info end subroutine psi_crea_bnd_elem end interface @@ -317,7 +318,13 @@ contains if (debug) write(0,*) me,'Done crea_ovr_elem' ! finally bnd_elem - call psi_crea_bnd_elem(cdesc,info) + idx_out => null() + call psi_crea_bnd_elem(idx_out,cdesc,info) + if (associated(idx_out)) then + cdesc%bnd_elem => idx_out + else + cdesc%bnd_elem => null() + endif if(info /= 0) then call psb_errpush(4010,name,a_err='psi_crea_bnd_elem') goto 9999 diff --git a/src/tools/Makefile b/src/tools/Makefile index 891125d9..9fdba620 100644 --- a/src/tools/Makefile +++ b/src/tools/Makefile @@ -4,7 +4,7 @@ FOBJS = psb_dallc.o psb_dasb.o psb_dcsrp.o psb_cdprt.o \ psb_dfree.o psb_dgelp.o psb_dins.o \ psb_cdall.o psb_cdalv.o psb_cdasb.o psb_cdcpy.o \ psb_cddec.o psb_cdfree.o psb_cdins.o psb_dcdovr.o \ - psb_cdren.o psb_cdrep.o psb_cdtransfer.o \ + psb_cdren.o psb_cdrep.o psb_cdtransfer.o psb_get_overlap.o\ psb_dspalloc.o psb_dspasb.o \ psb_dspcnv.o psb_dspfree.o psb_dspins.o psb_dsprn.o \ psb_glob_to_loc.o psb_ialloc.o psb_iasb.o \ diff --git a/src/tools/psb_cdfree.f90 b/src/tools/psb_cdfree.f90 index ce1501d6..98bc24f6 100644 --- a/src/tools/psb_cdfree.f90 +++ b/src/tools/psb_cdfree.f90 @@ -115,20 +115,21 @@ subroutine psb_cdfree(desc_a,info) goto 9999 end if - if (.not.associated(desc_a%bnd_elem)) then - info=296 - call psb_errpush(info,name) - goto 9999 - end if +!!$ if (.not.associated(desc_a%bnd_elem)) then +!!$ info=296 +!!$ call psb_errpush(info,name) +!!$ goto 9999 +!!$ end if !deallocate halo_index field - deallocate(desc_a%bnd_elem,stat=info) - if (info /= 0) then - info=2054 - call psb_errpush(info,name) - goto 9999 + if (associated(desc_a%bnd_elem)) then + deallocate(desc_a%bnd_elem,stat=info) + if (info /= 0) then + info=2054 + call psb_errpush(info,name) + goto 9999 + end if end if - if (.not.associated(desc_a%ovrlap_index)) then info=295 call psb_errpush(info,name) diff --git a/src/tools/psb_get_overlap.f90 b/src/tools/psb_get_overlap.f90 new file mode 100644 index 00000000..ab71482b --- /dev/null +++ b/src/tools/psb_get_overlap.f90 @@ -0,0 +1,64 @@ +subroutine psb_get_ovrlap(ovrel,desc,info) + use psb_descriptor_type + use psb_realloc_mod + use psb_error_mod + implicit none + integer, pointer :: ovrel(:) + type(psb_desc_type), intent(in) :: desc + integer, intent(out) :: info + + integer :: i,j, err_act + character(len=20) :: name + + info = 0 + name='psi_get_overlap' + call psb_erractionsave(err_act) + + i=0 + j=1 + do while(desc%ovrlap_elem(j) /= -1) + i = i +1 + j = j + 2 + enddo + + if (i > 0) then + + allocate(ovrel(i),stat=info) + if (info /= 0 ) then + info = 4000 + call psb_errpush(info,name) + goto 9999 + end if + + i=0 + j=1 + do while(desc%ovrlap_elem(j) /= -1) + i = i +1 + ovrel(i) = desc%ovrlap_elem(j) + j = j + 2 + enddo + + else + + if (associated(ovrel)) then + deallocate(ovrel,stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Deallocate') + goto 9999 + end if + end if + + end if + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act.eq.act_abort) then + call psb_error() + return + end if + return + +end subroutine psb_get_ovrlap