MPI_TYPE_INDEXED_CACHED

base/internals/psi_dswapdata.F90

@@ -1130,7 +1130,8 @@ subroutine psi_dswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,
   volatile :: sndbuf, rcvbuf
 #endif
   character(len=20)  :: name
-  integer, dimension(totxch) :: sendtypes,recvtypes
+  !integer, dimension(totxch) :: sendtypes,recvtypes
+  integer, allocatable, save :: sendtypes(:),recvtypes(:)
   integer, allocatable :: blens(:), new_idx(:)
 
   info=psb_success_
@@ -1222,45 +1223,52 @@ subroutine psi_dswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,
   !Send/Gather
   pnti   = 1
   snd_pt = 1
-  do i=1, totxch
+  if(.not.allocated(sendtypes)) then
-    nerv = idx(pnti+psb_n_elem_recv_)
+  	allocate(sendtypes(totxch), stat=info)
-    nesd = idx(pnti+nerv+psb_n_elem_send_)
+  	do i=1, totxch
-    idx_pt = 1+pnti+nerv+psb_n_elem_send_
+		nerv = idx(pnti+psb_n_elem_recv_)
-    allocate(blens(nesd),stat=info)
+		nesd = idx(pnti+nerv+psb_n_elem_send_)
-    do j=1,nesd
+		idx_pt = 1+pnti+nerv+psb_n_elem_send_
-      blens(j) = 1
+		allocate(blens(nesd),stat=info)
-    end do
+		do j=1,nesd
-
+		  blens(j) = 1
-    call MPI_TYPE_INDEXED(nesd,blens,(idx(idx_pt:idx_pt+nesd-1)-1),&
+		end do
-         & mpi_double_precision,sendtypes(i),info)
+
-    call MPI_TYPE_COMMIT(sendtypes(i),info)
+		call MPI_TYPE_INDEXED(nesd,blens,(idx(idx_pt:idx_pt+nesd-1)-1),&
-    deallocate(blens,stat=info)
+		     & mpi_double_precision,sendtypes(i),info)
-    snd_pt = snd_pt + nesd 
+		call MPI_TYPE_COMMIT(sendtypes(i),info)
-    pnti   = pnti + nerv + nesd + 3
+		deallocate(blens,stat=info)
-  end do
+		snd_pt = snd_pt + nesd 
+		pnti   = pnti + nerv + nesd + 3
+  	end do
+  end if
+  
   !Recv/Scatter
   pnti   = 1
   snd_pt = 1
   rcv_pt = 1
-  do i=1, totxch
+  if(.not.allocated(recvtypes)) then
-    proc_to_comm = idx(pnti+psb_proc_id_)
+  	allocate(recvtypes(totxch), stat=info)
-    nerv = idx(pnti+psb_n_elem_recv_)
+	do i=1, totxch
-    nesd = idx(pnti+nerv+psb_n_elem_send_)
+		proc_to_comm = idx(pnti+psb_proc_id_)
-    idx_pt = 1+pnti+psb_n_elem_recv_
+		nerv = idx(pnti+psb_n_elem_recv_)
-    allocate(blens(nerv),stat=info)
+		nesd = idx(pnti+nerv+psb_n_elem_send_)
-    do j=1, nerv
+		idx_pt = 1+pnti+psb_n_elem_recv_
-      blens(j) = 1
+		allocate(blens(nerv),stat=info)
-    end do
+		do j=1, nerv
-
+		  blens(j) = 1
-    call MPI_TYPE_INDEXED(nerv,blens,(idx(idx_pt:idx_pt+nerv-1)-1),&
+		end do
-         & mpi_double_precision,recvtypes(i),info)
+
-    call MPI_TYPE_COMMIT(recvtypes(i),info)
+		call MPI_TYPE_INDEXED(nerv,blens,(idx(idx_pt:idx_pt+nerv-1)-1),&
-    deallocate(blens,stat=info)
+		     & mpi_double_precision,recvtypes(i),info)
-
+		call MPI_TYPE_COMMIT(recvtypes(i),info)
-    rcv_pt = rcv_pt + nerv
+		deallocate(blens,stat=info)
-    snd_pt = snd_pt + nesd
+
-    pnti   = pnti + nerv + nesd + 3
+		rcv_pt = rcv_pt + nerv
-  end do
+		snd_pt = snd_pt + nesd
+		pnti   = pnti + nerv + nesd + 3
+	end do
+  end if
 
 
   if (beta/=0 .and. do_send) then
@@ -1468,8 +1476,8 @@ subroutine psi_dswapidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,
     snd_pt = 1
     rcv_pt = 1
     do i=1, totxch
-      call mpi_type_free(sendtypes(i),info)
+      !call mpi_type_free(sendtypes(i),info)
-      call mpi_type_free(recvtypes(i),info)
+      !call mpi_type_free(recvtypes(i),info)
       if(beta/=0) then
 		  proc_to_comm = idx(pnti+psb_proc_id_)
 		  nerv = idx(pnti+psb_n_elem_recv_)