Fix METIS partition module for Intel compilers.

util/psb_metispart_mod.F90

@@ -65,12 +65,8 @@ module psb_metispart_mod
   integer(psb_ipk_), allocatable, save :: graph_vect(:)
 
   interface build_mtpart
-    module procedure build_mtpart,&
+    module procedure d_mat_build_mtpart, s_mat_build_mtpart,&
-         & d_mat_build_mtpart, s_mat_build_mtpart,&
+         & z_mat_build_mtpart, c_mat_build_mtpart
-         & z_mat_build_mtpart, c_mat_build_mtpart, &
-         & d_csr_build_mtpart, s_csr_build_mtpart,&
-         & z_csr_build_mtpart, c_csr_build_mtpart
-
   end interface
 
 contains
@@ -180,9 +176,9 @@ contains
       end if
     end if
     if (allocated(wgh_)) then 
-      call build_mtpart(a%get_nrows(),a%get_fmt(),a%ja,a%irp,nparts,wgh_)
+      call inner_build_mtpart(a%get_nrows(),a%ja,a%irp,nparts,wgh_)
     else
-      call build_mtpart(a%get_nrows(),a%get_fmt(),a%ja,a%irp,nparts)
+      call inner_build_mtpart(a%get_nrows(),a%ja,a%irp,nparts)
     end if
 
   end subroutine d_csr_build_mtpart
@@ -219,9 +215,9 @@ contains
       end if
     end if
     if (allocated(wgh_)) then 
-      call build_mtpart(a%get_nrows(),a%get_fmt(),a%ja,a%irp,nparts,wgh_)
+      call inner_build_mtpart(a%get_nrows(),a%ja,a%irp,nparts,wgh_)
     else
-      call build_mtpart(a%get_nrows(),a%get_fmt(),a%ja,a%irp,nparts)
+      call inner_build_mtpart(a%get_nrows(),a%ja,a%irp,nparts)
     end if
 
   end subroutine z_csr_build_mtpart
@@ -268,7 +264,7 @@ contains
     real(psb_spk_), optional :: weights(:)
     
     
-    call build_mtpart(a%get_nrows(),a%get_fmt(),a%ja,a%irp,nparts,weights)
+    call inner_build_mtpart(a%get_nrows(),a%ja,a%irp,nparts,weights)
 
   end subroutine c_csr_build_mtpart
   
@@ -280,21 +276,20 @@ contains
     real(psb_spk_), optional :: weights(:)
     
 
-    call build_mtpart(a%get_nrows(),a%get_fmt(),a%ja,a%irp,nparts,weights)
+    call inner_build_mtpart(a%get_nrows(),a%ja,a%irp,nparts,weights)
 
   end subroutine s_csr_build_mtpart
 
-  subroutine build_mtpart(n,fida,ja,irp,nparts,weights)
+  subroutine inner_build_mtpart(n,ja,irp,nparts,weights)
     use psb_base_mod
+    use iso_c_binding
     implicit none 
-    integer(psb_ipk_) :: nparts
+    integer(psb_ipk_), intent(in) :: nparts
-    integer(psb_ipk_) :: ja(:), irp(:)
+    integer(psb_ipk_), intent(in) :: ja(:), irp(:)
+    real(psb_spk_),optional, intent(in) :: weights(:)
+    ! local variables
     integer(psb_ipk_) :: n, i,numflag,nedc,wgflag
-    character(len=5)     :: fida
-    integer(psb_ipk_), parameter :: nb=512
-    real(psb_dpk_), parameter :: seed=12345.d0
     integer(psb_ipk_) :: iopt(10),idummy(2),jdummy(2), info
-    real(psb_spk_),optional :: weights(:)
     integer(psb_ipk_) :: nl,nptl
     integer(psb_ipk_), allocatable :: irpl(:),jal(:),gvl(:)
     real(psb_spk_),allocatable  :: wgh_(:)
@@ -332,46 +327,40 @@ contains
       return
     endif
     if (nparts > 1) then
-      if (psb_toupper(fida) == 'CSR') then 
+      iopt(1) = 0
-        iopt(1) = 0
+      numflag  = 1
-        numflag  = 1
+      wgflag   = 0
-        wgflag   = 0
 
 !!$        write(*,*) 'Before allocation',nparts
 
-        irpl=irp
+      irpl=irp
-        jal = ja
+      jal = ja
-        nl = n
+      nl = n
-        nptl = nparts
+      nptl = nparts
-        wgh_ = -1.0
+      wgh_ = -1.0
-        if(present(weights)) then
+      if(present(weights)) then
-          if (size(weights) == nptl) then 
+        if (size(weights) == nptl) then 
 !!$            write(*,*) 'weights present',weights
-            ! call METIS_PartGraphKway(n,irp,ja,idummy,jdummy,&
+          ! call METIS_PartGraphKway(n,irp,ja,idummy,jdummy,&
-            !      & wgflag,numflag,nparts,weights,iopt,nedc,graph_vect)
+          !      & wgflag,numflag,nparts,weights,iopt,nedc,graph_vect)
-            info = METIS_PartGraphKway(nl,irpl,jal,idummy,jdummy,&
+          info = METIS_PartGraphKway(nl,irpl,jal,idummy,jdummy,&
-                 & nptl,weights,gvl)
+               & nptl,weights,gvl)
 
-          else
-!!$            write(*,*) 'weights absent',wgh_
-            info = METIS_PartGraphKway(nl,irpl,jal,idummy,jdummy,&
-                 & nptl,wgh_,gvl)
-          end if
         else
-!!$          write(*,*) 'weights absent',wgh_
+!!$            write(*,*) 'weights absent',wgh_
           info = METIS_PartGraphKway(nl,irpl,jal,idummy,jdummy,&
                & nptl,wgh_,gvl)
-        endif
+        end if
-!!$        write(*,*) 'after allocation',info
-
-        do i=1, n
-          graph_vect(i) = gvl(i) - 1 
-        enddo
       else
-        write(psb_err_unit,*) 'Fatal error in BUILD_MTPART: matrix format ',&
+!!$          write(*,*) 'weights absent',wgh_
-             & ' failure. ', FIDA
+        info = METIS_PartGraphKway(nl,irpl,jal,idummy,jdummy,&
-        return
+             & nptl,wgh_,gvl)
       endif
+!!$        write(*,*) 'after allocation',info
+
+      do i=1, n
+        graph_vect(i) = gvl(i) - 1 
+      enddo
     else
       do i=1, n
         graph_vect(i) = 0
@@ -383,7 +372,7 @@ contains
 
     return
 
-  end subroutine build_mtpart
+  end subroutine inner_build_mtpart
 
   !
   ! WARNING: called IRET otherwise Intel compiler complains,