Changed extra environment file by adding preprocessing directives to
Fortran compilation in a single environment-dependent file.psblas3-type-indexed
parent
75e60971e6
commit
32339d43a5
@ -1,7 +0,0 @@
|
||||
integer function krecvid(contxt,proc_to_comm,myrow)
|
||||
integer contxt,proc_to_comm,myrow
|
||||
|
||||
krecvid=32766
|
||||
|
||||
return
|
||||
end
|
@ -1,7 +0,0 @@
|
||||
integer function ksendid(contxt,proc_to_comm,myrow)
|
||||
integer contxt,proc_to_comm,myrow
|
||||
|
||||
ksendid=32766
|
||||
|
||||
return
|
||||
end
|
@ -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
|
@ -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
|
@ -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
|
Loading…
Reference in New Issue