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