fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

psblas3:

Browse Source 
base/comm/internals/psi_cswapdata.F90
 base/comm/internals/psi_cswaptran.F90
 base/comm/internals/psi_dswapdata.F90
 base/comm/internals/psi_dswaptran.F90
 base/comm/internals/psi_iswapdata.F90
 base/comm/internals/psi_iswaptran.F90
 base/comm/internals/psi_sswapdata.F90
 base/comm/internals/psi_sswaptran.F90
 base/comm/internals/psi_zswapdata.F90
 base/comm/internals/psi_zswaptran.F90
 base/comm/psb_cgather.f90
 base/comm/psb_chalo.f90
 base/comm/psb_covrl.f90
 base/comm/psb_cscatter.F90
 base/comm/psb_cspgather.F90
 base/comm/psb_dgather.f90
 base/comm/psb_dhalo.f90
 base/comm/psb_dovrl.f90
 base/comm/psb_dscatter.F90
 base/comm/psb_dspgather.F90
 base/comm/psb_igather.f90
 base/comm/psb_ihalo.f90
 base/comm/psb_iovrl.f90
 base/comm/psb_iscatter.F90
 base/comm/psb_sgather.f90
 base/comm/psb_shalo.f90
 base/comm/psb_sovrl.f90
 base/comm/psb_sscatter.F90
 base/comm/psb_sspgather.F90
 base/comm/psb_zgather.f90
 base/comm/psb_zhalo.f90
 base/comm/psb_zovrl.f90
 base/comm/psb_zscatter.F90
 base/comm/psb_zspgather.F90
 base/modules/desc/psb_hash_map_mod.f90
 base/modules/psb_error_impl.F90
 base/modules/psb_error_mod.F90
 base/modules/psb_realloc_mod.F90
 base/modules/serial/psb_c_base_vect_mod.f90
 base/modules/serial/psb_c_vect_mod.F90
 base/modules/serial/psb_d_base_vect_mod.f90
 base/modules/serial/psb_d_vect_mod.F90
 base/modules/serial/psb_i_base_vect_mod.f90
 base/modules/serial/psb_s_base_vect_mod.f90
 base/modules/serial/psb_s_vect_mod.F90
 base/modules/serial/psb_z_base_vect_mod.f90
 base/modules/serial/psb_z_vect_mod.F90
 base/tools/psb_ccdbldext.F90
 base/tools/psb_dcdbldext.F90
 base/tools/psb_icdasb.F90
 base/tools/psb_scdbldext.F90
 base/tools/psb_zcdbldext.F90
 krylov/psb_dcg.F90
 krylov/psb_scg.F90

Fixes for --enable-long-integers. Now compiles and runs correctly.
trunk
Salvatore Filippone 8 years ago
parent 246610998e
commit 9c4055f45c
54 changed files with 495 additions and 274 deletions
Show Stats Download Patch File Download Diff File

12
base/comm/internals/psi_cswapdata.F90
Unescape Escape View File

@ -516,7 +516,7 @@ subroutine psi_cswapidxm(iictxt,iicomm,flag,n,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return
end subroutine psi_cswapidxm end subroutine psi_cswapidxm
@ -1006,7 +1006,7 @@ subroutine psi_cswapidxv(iictxt,iicomm,flag,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return
end subroutine psi_cswapidxv end subroutine psi_cswapidxv
@ -1180,7 +1180,7 @@ subroutine psi_cswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
goto 9999 goto 9999
end if end if
if (debug) write(*,*) me,'do_send start' if (debug) write(*,*) me,'do_send start'
call y%new_buffer(size(idx%v),info) call y%new_buffer(ione*size(idx%v),info)
call y%new_comid(totxch,info) call y%new_comid(totxch,info)
call psb_realloc(totxch,prcid,info) call psb_realloc(totxch,prcid,info)
! First I post all the non blocking receives ! First I post all the non blocking receives
@ -1345,7 +1345,7 @@ subroutine psi_cswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return
end subroutine psi_cswap_vidx_vect end subroutine psi_cswap_vidx_vect
@ -1520,7 +1520,7 @@ subroutine psi_cswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
goto 9999 goto 9999
end if end if
if (debug) write(*,*) me,'do_send start' if (debug) write(*,*) me,'do_send start'
call y%new_buffer(size(idx%v),info) call y%new_buffer(ione*size(idx%v),info)
call y%new_comid(totxch,info) call y%new_comid(totxch,info)
call psb_realloc(totxch,prcid,info) call psb_realloc(totxch,prcid,info)
! First I post all the non blocking receives ! First I post all the non blocking receives
@ -1690,7 +1690,7 @@ subroutine psi_cswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return
end subroutine psi_cswap_vidx_multivect end subroutine psi_cswap_vidx_multivect

12
base/comm/internals/psi_cswaptran.F90
Unescape Escape View File

@ -516,7 +516,7 @@ subroutine psi_ctranidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return
end subroutine psi_ctranidxm end subroutine psi_ctranidxm
@ -1024,7 +1024,7 @@ subroutine psi_ctranidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return
end subroutine psi_ctranidxv end subroutine psi_ctranidxv
@ -1201,7 +1201,7 @@ subroutine psi_ctran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
goto 9999 goto 9999
end if end if
if (debug) write(*,*) me,'do_send start' if (debug) write(*,*) me,'do_send start'
call y%new_buffer(size(idx%v),info) call y%new_buffer(ione*size(idx%v),info)
call y%new_comid(totxch,info) call y%new_comid(totxch,info)
call psb_realloc(totxch,prcid,info) call psb_realloc(totxch,prcid,info)
! First I post all the non blocking receives ! First I post all the non blocking receives
@ -1372,7 +1372,7 @@ subroutine psi_ctran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return
@ -1551,7 +1551,7 @@ subroutine psi_ctran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
goto 9999 goto 9999
end if end if
if (debug) write(*,*) me,'do_send start' if (debug) write(*,*) me,'do_send start'
call y%new_buffer(size(idx%v),info) call y%new_buffer(ione*size(idx%v),info)
call y%new_comid(totxch,info) call y%new_comid(totxch,info)
call psb_realloc(totxch,prcid,info) call psb_realloc(totxch,prcid,info)
! First I post all the non blocking receives ! First I post all the non blocking receives
@ -1725,7 +1725,7 @@ subroutine psi_ctran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return

12
base/comm/internals/psi_dswapdata.F90
Unescape Escape View File

@ -516,7 +516,7 @@ subroutine psi_dswapidxm(iictxt,iicomm,flag,n,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return
end subroutine psi_dswapidxm end subroutine psi_dswapidxm
@ -1006,7 +1006,7 @@ subroutine psi_dswapidxv(iictxt,iicomm,flag,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return
end subroutine psi_dswapidxv end subroutine psi_dswapidxv
@ -1180,7 +1180,7 @@ subroutine psi_dswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
goto 9999 goto 9999
end if end if
if (debug) write(*,*) me,'do_send start' if (debug) write(*,*) me,'do_send start'
call y%new_buffer(size(idx%v),info) call y%new_buffer(ione*size(idx%v),info)
call y%new_comid(totxch,info) call y%new_comid(totxch,info)
call psb_realloc(totxch,prcid,info) call psb_realloc(totxch,prcid,info)
! First I post all the non blocking receives ! First I post all the non blocking receives
@ -1345,7 +1345,7 @@ subroutine psi_dswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return
end subroutine psi_dswap_vidx_vect end subroutine psi_dswap_vidx_vect
@ -1520,7 +1520,7 @@ subroutine psi_dswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
goto 9999 goto 9999
end if end if
if (debug) write(*,*) me,'do_send start' if (debug) write(*,*) me,'do_send start'
call y%new_buffer(size(idx%v),info) call y%new_buffer(ione*size(idx%v),info)
call y%new_comid(totxch,info) call y%new_comid(totxch,info)
call psb_realloc(totxch,prcid,info) call psb_realloc(totxch,prcid,info)
! First I post all the non blocking receives ! First I post all the non blocking receives
@ -1690,7 +1690,7 @@ subroutine psi_dswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return
end subroutine psi_dswap_vidx_multivect end subroutine psi_dswap_vidx_multivect

12
base/comm/internals/psi_dswaptran.F90
Unescape Escape View File

@ -516,7 +516,7 @@ subroutine psi_dtranidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return
end subroutine psi_dtranidxm end subroutine psi_dtranidxm
@ -1024,7 +1024,7 @@ subroutine psi_dtranidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return
end subroutine psi_dtranidxv end subroutine psi_dtranidxv
@ -1201,7 +1201,7 @@ subroutine psi_dtran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
goto 9999 goto 9999
end if end if
if (debug) write(*,*) me,'do_send start' if (debug) write(*,*) me,'do_send start'
call y%new_buffer(size(idx%v),info) call y%new_buffer(ione*size(idx%v),info)
call y%new_comid(totxch,info) call y%new_comid(totxch,info)
call psb_realloc(totxch,prcid,info) call psb_realloc(totxch,prcid,info)
! First I post all the non blocking receives ! First I post all the non blocking receives
@ -1372,7 +1372,7 @@ subroutine psi_dtran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return
@ -1551,7 +1551,7 @@ subroutine psi_dtran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
goto 9999 goto 9999
end if end if
if (debug) write(*,*) me,'do_send start' if (debug) write(*,*) me,'do_send start'
call y%new_buffer(size(idx%v),info) call y%new_buffer(ione*size(idx%v),info)
call y%new_comid(totxch,info) call y%new_comid(totxch,info)
call psb_realloc(totxch,prcid,info) call psb_realloc(totxch,prcid,info)
! First I post all the non blocking receives ! First I post all the non blocking receives
@ -1725,7 +1725,7 @@ subroutine psi_dtran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return

12
base/comm/internals/psi_iswapdata.F90
Unescape Escape View File

@ -516,7 +516,7 @@ subroutine psi_iswapidxm(iictxt,iicomm,flag,n,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return
end subroutine psi_iswapidxm end subroutine psi_iswapidxm
@ -1006,7 +1006,7 @@ subroutine psi_iswapidxv(iictxt,iicomm,flag,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return
end subroutine psi_iswapidxv end subroutine psi_iswapidxv
@ -1180,7 +1180,7 @@ subroutine psi_iswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
goto 9999 goto 9999
end if end if
if (debug) write(*,*) me,'do_send start' if (debug) write(*,*) me,'do_send start'
call y%new_buffer(size(idx%v),info) call y%new_buffer(ione*size(idx%v),info)
call y%new_comid(totxch,info) call y%new_comid(totxch,info)
call psb_realloc(totxch,prcid,info) call psb_realloc(totxch,prcid,info)
! First I post all the non blocking receives ! First I post all the non blocking receives
@ -1345,7 +1345,7 @@ subroutine psi_iswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return
end subroutine psi_iswap_vidx_vect end subroutine psi_iswap_vidx_vect
@ -1520,7 +1520,7 @@ subroutine psi_iswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
goto 9999 goto 9999
end if end if
if (debug) write(*,*) me,'do_send start' if (debug) write(*,*) me,'do_send start'
call y%new_buffer(size(idx%v),info) call y%new_buffer(ione*size(idx%v),info)
call y%new_comid(totxch,info) call y%new_comid(totxch,info)
call psb_realloc(totxch,prcid,info) call psb_realloc(totxch,prcid,info)
! First I post all the non blocking receives ! First I post all the non blocking receives
@ -1690,7 +1690,7 @@ subroutine psi_iswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return
end subroutine psi_iswap_vidx_multivect end subroutine psi_iswap_vidx_multivect

12
base/comm/internals/psi_iswaptran.F90
Unescape Escape View File

@ -516,7 +516,7 @@ subroutine psi_itranidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return
end subroutine psi_itranidxm end subroutine psi_itranidxm
@ -1024,7 +1024,7 @@ subroutine psi_itranidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return
end subroutine psi_itranidxv end subroutine psi_itranidxv
@ -1201,7 +1201,7 @@ subroutine psi_itran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
goto 9999 goto 9999
end if end if
if (debug) write(*,*) me,'do_send start' if (debug) write(*,*) me,'do_send start'
call y%new_buffer(size(idx%v),info) call y%new_buffer(ione*size(idx%v),info)
call y%new_comid(totxch,info) call y%new_comid(totxch,info)
call psb_realloc(totxch,prcid,info) call psb_realloc(totxch,prcid,info)
! First I post all the non blocking receives ! First I post all the non blocking receives
@ -1372,7 +1372,7 @@ subroutine psi_itran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return
@ -1551,7 +1551,7 @@ subroutine psi_itran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
goto 9999 goto 9999
end if end if
if (debug) write(*,*) me,'do_send start' if (debug) write(*,*) me,'do_send start'
call y%new_buffer(size(idx%v),info) call y%new_buffer(ione*size(idx%v),info)
call y%new_comid(totxch,info) call y%new_comid(totxch,info)
call psb_realloc(totxch,prcid,info) call psb_realloc(totxch,prcid,info)
! First I post all the non blocking receives ! First I post all the non blocking receives
@ -1725,7 +1725,7 @@ subroutine psi_itran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return

12
base/comm/internals/psi_sswapdata.F90
Unescape Escape View File

@ -516,7 +516,7 @@ subroutine psi_sswapidxm(iictxt,iicomm,flag,n,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return
end subroutine psi_sswapidxm end subroutine psi_sswapidxm
@ -1006,7 +1006,7 @@ subroutine psi_sswapidxv(iictxt,iicomm,flag,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return
end subroutine psi_sswapidxv end subroutine psi_sswapidxv
@ -1180,7 +1180,7 @@ subroutine psi_sswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
goto 9999 goto 9999
end if end if
if (debug) write(*,*) me,'do_send start' if (debug) write(*,*) me,'do_send start'
call y%new_buffer(size(idx%v),info) call y%new_buffer(ione*size(idx%v),info)
call y%new_comid(totxch,info) call y%new_comid(totxch,info)
call psb_realloc(totxch,prcid,info) call psb_realloc(totxch,prcid,info)
! First I post all the non blocking receives ! First I post all the non blocking receives
@ -1345,7 +1345,7 @@ subroutine psi_sswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return
end subroutine psi_sswap_vidx_vect end subroutine psi_sswap_vidx_vect
@ -1520,7 +1520,7 @@ subroutine psi_sswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
goto 9999 goto 9999
end if end if
if (debug) write(*,*) me,'do_send start' if (debug) write(*,*) me,'do_send start'
call y%new_buffer(size(idx%v),info) call y%new_buffer(ione*size(idx%v),info)
call y%new_comid(totxch,info) call y%new_comid(totxch,info)
call psb_realloc(totxch,prcid,info) call psb_realloc(totxch,prcid,info)
! First I post all the non blocking receives ! First I post all the non blocking receives
@ -1690,7 +1690,7 @@ subroutine psi_sswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return
end subroutine psi_sswap_vidx_multivect end subroutine psi_sswap_vidx_multivect

12
base/comm/internals/psi_sswaptran.F90
Unescape Escape View File

@ -516,7 +516,7 @@ subroutine psi_stranidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return
end subroutine psi_stranidxm end subroutine psi_stranidxm
@ -1024,7 +1024,7 @@ subroutine psi_stranidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return
end subroutine psi_stranidxv end subroutine psi_stranidxv
@ -1201,7 +1201,7 @@ subroutine psi_stran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
goto 9999 goto 9999
end if end if
if (debug) write(*,*) me,'do_send start' if (debug) write(*,*) me,'do_send start'
call y%new_buffer(size(idx%v),info) call y%new_buffer(ione*size(idx%v),info)
call y%new_comid(totxch,info) call y%new_comid(totxch,info)
call psb_realloc(totxch,prcid,info) call psb_realloc(totxch,prcid,info)
! First I post all the non blocking receives ! First I post all the non blocking receives
@ -1372,7 +1372,7 @@ subroutine psi_stran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return
@ -1551,7 +1551,7 @@ subroutine psi_stran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
goto 9999 goto 9999
end if end if
if (debug) write(*,*) me,'do_send start' if (debug) write(*,*) me,'do_send start'
call y%new_buffer(size(idx%v),info) call y%new_buffer(ione*size(idx%v),info)
call y%new_comid(totxch,info) call y%new_comid(totxch,info)
call psb_realloc(totxch,prcid,info) call psb_realloc(totxch,prcid,info)
! First I post all the non blocking receives ! First I post all the non blocking receives
@ -1725,7 +1725,7 @@ subroutine psi_stran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return

12
base/comm/internals/psi_zswapdata.F90
Unescape Escape View File

@ -516,7 +516,7 @@ subroutine psi_zswapidxm(iictxt,iicomm,flag,n,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return
end subroutine psi_zswapidxm end subroutine psi_zswapidxm
@ -1006,7 +1006,7 @@ subroutine psi_zswapidxv(iictxt,iicomm,flag,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return
end subroutine psi_zswapidxv end subroutine psi_zswapidxv
@ -1180,7 +1180,7 @@ subroutine psi_zswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
goto 9999 goto 9999
end if end if
if (debug) write(*,*) me,'do_send start' if (debug) write(*,*) me,'do_send start'
call y%new_buffer(size(idx%v),info) call y%new_buffer(ione*size(idx%v),info)
call y%new_comid(totxch,info) call y%new_comid(totxch,info)
call psb_realloc(totxch,prcid,info) call psb_realloc(totxch,prcid,info)
! First I post all the non blocking receives ! First I post all the non blocking receives
@ -1345,7 +1345,7 @@ subroutine psi_zswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return
end subroutine psi_zswap_vidx_vect end subroutine psi_zswap_vidx_vect
@ -1520,7 +1520,7 @@ subroutine psi_zswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
goto 9999 goto 9999
end if end if
if (debug) write(*,*) me,'do_send start' if (debug) write(*,*) me,'do_send start'
call y%new_buffer(size(idx%v),info) call y%new_buffer(ione*size(idx%v),info)
call y%new_comid(totxch,info) call y%new_comid(totxch,info)
call psb_realloc(totxch,prcid,info) call psb_realloc(totxch,prcid,info)
! First I post all the non blocking receives ! First I post all the non blocking receives
@ -1690,7 +1690,7 @@ subroutine psi_zswap_vidx_multivect(iictxt,iicomm,flag,beta,y,idx, &
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return
end subroutine psi_zswap_vidx_multivect end subroutine psi_zswap_vidx_multivect

12
base/comm/internals/psi_zswaptran.F90
Unescape Escape View File

@ -516,7 +516,7 @@ subroutine psi_ztranidxm(iictxt,iicomm,flag,n,beta,y,idx,totxch,totsnd,totrcv,wo
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return
end subroutine psi_ztranidxm end subroutine psi_ztranidxm
@ -1024,7 +1024,7 @@ subroutine psi_ztranidxv(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return
end subroutine psi_ztranidxv end subroutine psi_ztranidxv
@ -1201,7 +1201,7 @@ subroutine psi_ztran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
goto 9999 goto 9999
end if end if
if (debug) write(*,*) me,'do_send start' if (debug) write(*,*) me,'do_send start'
call y%new_buffer(size(idx%v),info) call y%new_buffer(ione*size(idx%v),info)
call y%new_comid(totxch,info) call y%new_comid(totxch,info)
call psb_realloc(totxch,prcid,info) call psb_realloc(totxch,prcid,info)
! First I post all the non blocking receives ! First I post all the non blocking receives
@ -1372,7 +1372,7 @@ subroutine psi_ztran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return
@ -1551,7 +1551,7 @@ subroutine psi_ztran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
goto 9999 goto 9999
end if end if
if (debug) write(*,*) me,'do_send start' if (debug) write(*,*) me,'do_send start'
call y%new_buffer(size(idx%v),info) call y%new_buffer(ione*size(idx%v),info)
call y%new_comid(totxch,info) call y%new_comid(totxch,info)
call psb_realloc(totxch,prcid,info) call psb_realloc(totxch,prcid,info)
! First I post all the non blocking receives ! First I post all the non blocking receives
@ -1725,7 +1725,7 @@ subroutine psi_ztran_vidx_multivect(iictxt,iicomm,flag,beta,y,idx,&
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(iictxt,err_act)
return return

12
base/comm/psb_cgather.f90
Unescape Escape View File

@ -59,7 +59,8 @@ subroutine psb_cgatherm(globx, locx, desc_a, info, iroot)
! locals ! locals
integer(psb_mpik_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank integer(psb_mpik_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank
integer(psb_ipk_) :: ierr(5), err_act, n, ilocx, iglobx, jlocx,& integer(psb_ipk_) :: ierr(5), err_act, n, ilocx, iglobx, jlocx,&
& jglobx, lda_locx, lda_globx, m, lock, globk, maxk, k, jlx, ilx, i, j, idx & jglobx, lda_locx, lda_globx, m, lock, globk, maxk, k, jlx, &
& ilx, i, j, idx
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -69,7 +70,6 @@ subroutine psb_cgatherm(globx, locx, desc_a, info, iroot)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=desc_a%get_context() ictxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -1) then if (np == -1) then
@ -160,7 +160,7 @@ subroutine psb_cgatherm(globx, locx, desc_a, info, iroot)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
@ -322,7 +322,7 @@ subroutine psb_cgatherv(globx, locx, desc_a, info, iroot)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
@ -436,7 +436,7 @@ subroutine psb_cgather_vect(globx, locx, desc_a, info, iroot)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
@ -548,7 +548,7 @@ subroutine psb_cgather_multivect(globx, locx, desc_a, info, iroot)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return

8
base/comm/psb_chalo.f90
Unescape Escape View File

@ -198,7 +198,7 @@ subroutine psb_chalom(x,desc_a,info,jx,ik,work,tran,mode,data)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_chalom end subroutine psb_chalom
@ -386,7 +386,7 @@ subroutine psb_chalov(x,desc_a,info,work,tran,mode,data)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_chalov end subroutine psb_chalov
@ -525,7 +525,7 @@ subroutine psb_chalo_vect(x,desc_a,info,work,tran,mode,data)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_chalo_vect end subroutine psb_chalo_vect
@ -664,7 +664,7 @@ subroutine psb_chalo_multivect(x,desc_a,info,work,tran,mode,data)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_chalo_multivect end subroutine psb_chalo_multivect

8
base/comm/psb_covrl.f90
Unescape Escape View File

@ -193,7 +193,7 @@ subroutine psb_covrlm(x,desc_a,info,jx,ik,work,update,mode)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_covrlm end subroutine psb_covrlm
@ -373,7 +373,7 @@ subroutine psb_covrlv(x,desc_a,info,work,update,mode)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_covrlv end subroutine psb_covrlv
@ -498,7 +498,7 @@ subroutine psb_covrl_vect(x,desc_a,info,work,update,mode)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_covrl_vect end subroutine psb_covrl_vect
@ -623,7 +623,7 @@ subroutine psb_covrl_multivect(x,desc_a,info,work,update,mode)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_covrl_multivect end subroutine psb_covrl_multivect

6
base/comm/psb_cscatter.F90
Unescape Escape View File

@ -227,7 +227,7 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, root)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
@ -456,7 +456,7 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, root)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
@ -540,7 +540,7 @@ subroutine psb_cscatter_vect(globx, locx, desc_a, info, root, mold)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return

2
base/comm/psb_cspgather.F90
Unescape Escape View File

@ -149,7 +149,7 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
9999 continue 9999 continue
call psb_errpush(info,name) call psb_errpush(info,name)
call psb_error_handler(ictxt,err_act) call psb_error_handler(ione*ictxt,err_act)
return return

12
base/comm/psb_dgather.f90
Unescape Escape View File

@ -59,7 +59,8 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot)
! locals ! locals
integer(psb_mpik_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank integer(psb_mpik_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank
integer(psb_ipk_) :: ierr(5), err_act, n, ilocx, iglobx, jlocx,& integer(psb_ipk_) :: ierr(5), err_act, n, ilocx, iglobx, jlocx,&
& jglobx, lda_locx, lda_globx, m, lock, globk, maxk, k, jlx, ilx, i, j, idx & jglobx, lda_locx, lda_globx, m, lock, globk, maxk, k, jlx, &
& ilx, i, j, idx
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -69,7 +70,6 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=desc_a%get_context() ictxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -1) then if (np == -1) then
@ -160,7 +160,7 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
@ -322,7 +322,7 @@ subroutine psb_dgatherv(globx, locx, desc_a, info, iroot)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
@ -436,7 +436,7 @@ subroutine psb_dgather_vect(globx, locx, desc_a, info, iroot)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
@ -548,7 +548,7 @@ subroutine psb_dgather_multivect(globx, locx, desc_a, info, iroot)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return

8
base/comm/psb_dhalo.f90
Unescape Escape View File

@ -198,7 +198,7 @@ subroutine psb_dhalom(x,desc_a,info,jx,ik,work,tran,mode,data)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_dhalom end subroutine psb_dhalom
@ -386,7 +386,7 @@ subroutine psb_dhalov(x,desc_a,info,work,tran,mode,data)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_dhalov end subroutine psb_dhalov
@ -525,7 +525,7 @@ subroutine psb_dhalo_vect(x,desc_a,info,work,tran,mode,data)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_dhalo_vect end subroutine psb_dhalo_vect
@ -664,7 +664,7 @@ subroutine psb_dhalo_multivect(x,desc_a,info,work,tran,mode,data)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_dhalo_multivect end subroutine psb_dhalo_multivect

8
base/comm/psb_dovrl.f90
Unescape Escape View File

@ -193,7 +193,7 @@ subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update,mode)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_dovrlm end subroutine psb_dovrlm
@ -373,7 +373,7 @@ subroutine psb_dovrlv(x,desc_a,info,work,update,mode)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_dovrlv end subroutine psb_dovrlv
@ -498,7 +498,7 @@ subroutine psb_dovrl_vect(x,desc_a,info,work,update,mode)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_dovrl_vect end subroutine psb_dovrl_vect
@ -623,7 +623,7 @@ subroutine psb_dovrl_multivect(x,desc_a,info,work,update,mode)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_dovrl_multivect end subroutine psb_dovrl_multivect

6
base/comm/psb_dscatter.F90
Unescape Escape View File

@ -227,7 +227,7 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, root)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
@ -456,7 +456,7 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, root)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
@ -540,7 +540,7 @@ subroutine psb_dscatter_vect(globx, locx, desc_a, info, root, mold)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return

2
base/comm/psb_dspgather.F90
Unescape Escape View File

@ -149,7 +149,7 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
9999 continue 9999 continue
call psb_errpush(info,name) call psb_errpush(info,name)
call psb_error_handler(ictxt,err_act) call psb_error_handler(ione*ictxt,err_act)
return return

12
base/comm/psb_igather.f90
Unescape Escape View File

@ -59,7 +59,8 @@ subroutine psb_igatherm(globx, locx, desc_a, info, iroot)
! locals ! locals
integer(psb_mpik_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank integer(psb_mpik_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank
integer(psb_ipk_) :: ierr(5), err_act, n, ilocx, iglobx, jlocx,& integer(psb_ipk_) :: ierr(5), err_act, n, ilocx, iglobx, jlocx,&
& jglobx, lda_locx, lda_globx, m, lock, globk, maxk, k, jlx, ilx, i, j, idx & jglobx, lda_locx, lda_globx, m, lock, globk, maxk, k, jlx, &
& ilx, i, j, idx
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -69,7 +70,6 @@ subroutine psb_igatherm(globx, locx, desc_a, info, iroot)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=desc_a%get_context() ictxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -1) then if (np == -1) then
@ -160,7 +160,7 @@ subroutine psb_igatherm(globx, locx, desc_a, info, iroot)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
@ -322,7 +322,7 @@ subroutine psb_igatherv(globx, locx, desc_a, info, iroot)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
@ -436,7 +436,7 @@ subroutine psb_igather_vect(globx, locx, desc_a, info, iroot)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
@ -548,7 +548,7 @@ subroutine psb_igather_multivect(globx, locx, desc_a, info, iroot)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return

8
base/comm/psb_ihalo.f90
Unescape Escape View File

@ -198,7 +198,7 @@ subroutine psb_ihalom(x,desc_a,info,jx,ik,work,tran,mode,data)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_ihalom end subroutine psb_ihalom
@ -386,7 +386,7 @@ subroutine psb_ihalov(x,desc_a,info,work,tran,mode,data)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_ihalov end subroutine psb_ihalov
@ -525,7 +525,7 @@ subroutine psb_ihalo_vect(x,desc_a,info,work,tran,mode,data)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_ihalo_vect end subroutine psb_ihalo_vect
@ -664,7 +664,7 @@ subroutine psb_ihalo_multivect(x,desc_a,info,work,tran,mode,data)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_ihalo_multivect end subroutine psb_ihalo_multivect

8
base/comm/psb_iovrl.f90
Unescape Escape View File

@ -193,7 +193,7 @@ subroutine psb_iovrlm(x,desc_a,info,jx,ik,work,update,mode)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_iovrlm end subroutine psb_iovrlm
@ -373,7 +373,7 @@ subroutine psb_iovrlv(x,desc_a,info,work,update,mode)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_iovrlv end subroutine psb_iovrlv
@ -498,7 +498,7 @@ subroutine psb_iovrl_vect(x,desc_a,info,work,update,mode)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_iovrl_vect end subroutine psb_iovrl_vect
@ -623,7 +623,7 @@ subroutine psb_iovrl_multivect(x,desc_a,info,work,update,mode)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_iovrl_multivect end subroutine psb_iovrl_multivect

6
base/comm/psb_iscatter.F90
Unescape Escape View File

@ -227,7 +227,7 @@ subroutine psb_iscatterm(globx, locx, desc_a, info, root)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
@ -456,7 +456,7 @@ subroutine psb_iscatterv(globx, locx, desc_a, info, root)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
@ -540,7 +540,7 @@ subroutine psb_iscatter_vect(globx, locx, desc_a, info, root, mold)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return

12
base/comm/psb_sgather.f90
Unescape Escape View File

@ -59,7 +59,8 @@ subroutine psb_sgatherm(globx, locx, desc_a, info, iroot)
! locals ! locals
integer(psb_mpik_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank integer(psb_mpik_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank
integer(psb_ipk_) :: ierr(5), err_act, n, ilocx, iglobx, jlocx,& integer(psb_ipk_) :: ierr(5), err_act, n, ilocx, iglobx, jlocx,&
& jglobx, lda_locx, lda_globx, m, lock, globk, maxk, k, jlx, ilx, i, j, idx & jglobx, lda_locx, lda_globx, m, lock, globk, maxk, k, jlx, &
& ilx, i, j, idx
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -69,7 +70,6 @@ subroutine psb_sgatherm(globx, locx, desc_a, info, iroot)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=desc_a%get_context() ictxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -1) then if (np == -1) then
@ -160,7 +160,7 @@ subroutine psb_sgatherm(globx, locx, desc_a, info, iroot)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
@ -322,7 +322,7 @@ subroutine psb_sgatherv(globx, locx, desc_a, info, iroot)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
@ -436,7 +436,7 @@ subroutine psb_sgather_vect(globx, locx, desc_a, info, iroot)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
@ -548,7 +548,7 @@ subroutine psb_sgather_multivect(globx, locx, desc_a, info, iroot)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return

8
base/comm/psb_shalo.f90
Unescape Escape View File

@ -198,7 +198,7 @@ subroutine psb_shalom(x,desc_a,info,jx,ik,work,tran,mode,data)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_shalom end subroutine psb_shalom
@ -386,7 +386,7 @@ subroutine psb_shalov(x,desc_a,info,work,tran,mode,data)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_shalov end subroutine psb_shalov
@ -525,7 +525,7 @@ subroutine psb_shalo_vect(x,desc_a,info,work,tran,mode,data)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_shalo_vect end subroutine psb_shalo_vect
@ -664,7 +664,7 @@ subroutine psb_shalo_multivect(x,desc_a,info,work,tran,mode,data)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_shalo_multivect end subroutine psb_shalo_multivect

8
base/comm/psb_sovrl.f90
Unescape Escape View File

@ -193,7 +193,7 @@ subroutine psb_sovrlm(x,desc_a,info,jx,ik,work,update,mode)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_sovrlm end subroutine psb_sovrlm
@ -373,7 +373,7 @@ subroutine psb_sovrlv(x,desc_a,info,work,update,mode)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_sovrlv end subroutine psb_sovrlv
@ -498,7 +498,7 @@ subroutine psb_sovrl_vect(x,desc_a,info,work,update,mode)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_sovrl_vect end subroutine psb_sovrl_vect
@ -623,7 +623,7 @@ subroutine psb_sovrl_multivect(x,desc_a,info,work,update,mode)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_sovrl_multivect end subroutine psb_sovrl_multivect

6
base/comm/psb_sscatter.F90
Unescape Escape View File

@ -227,7 +227,7 @@ subroutine psb_sscatterm(globx, locx, desc_a, info, root)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
@ -456,7 +456,7 @@ subroutine psb_sscatterv(globx, locx, desc_a, info, root)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
@ -540,7 +540,7 @@ subroutine psb_sscatter_vect(globx, locx, desc_a, info, root, mold)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return

2
base/comm/psb_sspgather.F90
Unescape Escape View File

@ -149,7 +149,7 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
9999 continue 9999 continue
call psb_errpush(info,name) call psb_errpush(info,name)
call psb_error_handler(ictxt,err_act) call psb_error_handler(ione*ictxt,err_act)
return return

12
base/comm/psb_zgather.f90
Unescape Escape View File

@ -59,7 +59,8 @@ subroutine psb_zgatherm(globx, locx, desc_a, info, iroot)
! locals ! locals
integer(psb_mpik_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank integer(psb_mpik_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank
integer(psb_ipk_) :: ierr(5), err_act, n, ilocx, iglobx, jlocx,& integer(psb_ipk_) :: ierr(5), err_act, n, ilocx, iglobx, jlocx,&
& jglobx, lda_locx, lda_globx, m, lock, globk, maxk, k, jlx, ilx, i, j, idx & jglobx, lda_locx, lda_globx, m, lock, globk, maxk, k, jlx, &
& ilx, i, j, idx
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
@ -69,7 +70,6 @@ subroutine psb_zgatherm(globx, locx, desc_a, info, iroot)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=desc_a%get_context() ictxt=desc_a%get_context()
! check on blacs grid ! check on blacs grid
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (np == -1) then if (np == -1) then
@ -160,7 +160,7 @@ subroutine psb_zgatherm(globx, locx, desc_a, info, iroot)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
@ -322,7 +322,7 @@ subroutine psb_zgatherv(globx, locx, desc_a, info, iroot)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
@ -436,7 +436,7 @@ subroutine psb_zgather_vect(globx, locx, desc_a, info, iroot)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
@ -548,7 +548,7 @@ subroutine psb_zgather_multivect(globx, locx, desc_a, info, iroot)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return

8
base/comm/psb_zhalo.f90
Unescape Escape View File

@ -198,7 +198,7 @@ subroutine psb_zhalom(x,desc_a,info,jx,ik,work,tran,mode,data)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_zhalom end subroutine psb_zhalom
@ -386,7 +386,7 @@ subroutine psb_zhalov(x,desc_a,info,work,tran,mode,data)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_zhalov end subroutine psb_zhalov
@ -525,7 +525,7 @@ subroutine psb_zhalo_vect(x,desc_a,info,work,tran,mode,data)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_zhalo_vect end subroutine psb_zhalo_vect
@ -664,7 +664,7 @@ subroutine psb_zhalo_multivect(x,desc_a,info,work,tran,mode,data)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_zhalo_multivect end subroutine psb_zhalo_multivect

8
base/comm/psb_zovrl.f90
Unescape Escape View File

@ -193,7 +193,7 @@ subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,update,mode)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_zovrlm end subroutine psb_zovrlm
@ -373,7 +373,7 @@ subroutine psb_zovrlv(x,desc_a,info,work,update,mode)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_zovrlv end subroutine psb_zovrlv
@ -498,7 +498,7 @@ subroutine psb_zovrl_vect(x,desc_a,info,work,update,mode)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_zovrl_vect end subroutine psb_zovrl_vect
@ -623,7 +623,7 @@ subroutine psb_zovrl_multivect(x,desc_a,info,work,update,mode)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
end subroutine psb_zovrl_multivect end subroutine psb_zovrl_multivect

6
base/comm/psb_zscatter.F90
Unescape Escape View File

@ -227,7 +227,7 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, root)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
@ -456,7 +456,7 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, root)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return
@ -540,7 +540,7 @@ subroutine psb_zscatter_vect(globx, locx, desc_a, info, root, mold)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return

2
base/comm/psb_zspgather.F90
Unescape Escape View File

@ -149,7 +149,7 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
9999 continue 9999 continue
call psb_errpush(info,name) call psb_errpush(info,name)
call psb_error_handler(ictxt,err_act) call psb_error_handler(ione*ictxt,err_act)
return return

2
base/modules/desc/psb_hash_map_mod.f90
Unescape Escape View File

@ -498,7 +498,7 @@ contains
integer(psb_ipk_) :: i, is, mglob, ip, lip, nrow, ncol, & integer(psb_ipk_) :: i, is, mglob, ip, lip, nrow, ncol, &
& nxt, err_act & nxt, err_act
integer(psb_mpik_) :: ictxt, me, np integer(psb_ipk_) :: ictxt, me, np
character(len=20) :: name,ch_err character(len=20) :: name,ch_err
info = psb_success_ info = psb_success_

10
base/modules/psb_error_impl.F90
Unescape Escape View File

@ -28,15 +28,15 @@ subroutine psb_par_error_handler(ictxt,err_act)
use psb_error_mod, psb_protect_name => psb_par_error_handler use psb_error_mod, psb_protect_name => psb_par_error_handler
use psb_penv_mod use psb_penv_mod
implicit none implicit none
integer(psb_mpik_), intent(in) :: ictxt integer(psb_ipk_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: err_act integer(psb_ipk_), intent(in) :: err_act
integer(psb_mpik_) :: iictxt
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
iictxt = ictxt
if (err_act == psb_act_print_) & if (err_act == psb_act_print_) &
& call psb_error(ictxt, abrt=.false.) & call psb_error(iictxt, abrt=.false.)
if (err_act == psb_act_abort_) & if (err_act == psb_act_abort_) &
& call psb_error(ictxt, abrt=.true.) & call psb_error(iictxt, abrt=.true.)
return return

2
base/modules/psb_error_mod.F90
Unescape Escape View File

@ -73,7 +73,7 @@ module psb_error_mod
end subroutine psb_ser_error_handler end subroutine psb_ser_error_handler
subroutine psb_par_error_handler(ictxt,err_act) subroutine psb_par_error_handler(ictxt,err_act)
import :: psb_ipk_,psb_mpik_ import :: psb_ipk_,psb_mpik_
integer(psb_mpik_), intent(in) :: ictxt integer(psb_ipk_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: err_act integer(psb_ipk_), intent(in) :: err_act
end subroutine psb_par_error_handler end subroutine psb_par_error_handler
end interface end interface

221
base/modules/psb_realloc_mod.F90
Unescape Escape View File

@ -59,7 +59,9 @@ module psb_realloc_mod
module procedure psb_reallocatec2 module procedure psb_reallocatec2
#if defined(LONG_INTEGERS) #if defined(LONG_INTEGERS)
module procedure psb_reallocate1i4 module procedure psb_reallocate1i4
module procedure psb_reallocatei4_2 module procedure psb_reallocate1i4_i8
module procedure psb_reallocate2i4
module procedure psb_reallocate2i4_i8
module procedure psb_rp1i1 module procedure psb_rp1i1
module procedure psb_rp1i2i2 module procedure psb_rp1i2i2
module procedure psb_ri1p2i2 module procedure psb_ri1p2i2
@ -101,6 +103,8 @@ module psb_realloc_mod
#else #else
module procedure psb_i4move_alloc1d module procedure psb_i4move_alloc1d
module procedure psb_i4move_alloc2d module procedure psb_i4move_alloc2d
module procedure psb_i4move_alloc1d_i8
module procedure psb_i4move_alloc2d_i8
#endif #endif
module procedure psb_cmove_alloc1d module procedure psb_cmove_alloc1d
module procedure psb_cmove_alloc2d module procedure psb_cmove_alloc2d
@ -3035,6 +3039,29 @@ Contains
#endif #endif
end Subroutine psb_i4move_alloc1d end Subroutine psb_i4move_alloc1d
Subroutine psb_i4move_alloc1d_i8(vin,vout,info)
use psb_error_mod
integer(psb_mpik_), allocatable, intent(inout) :: vin(:),vout(:)
integer(psb_ipk_), intent(out) :: info
!
!
info=psb_success_
#ifdef HAVE_MOVE_ALLOC
call move_alloc(vin,vout)
#else
if (allocated(vout)) then
deallocate(vout,stat=info)
end if
if (.not.allocated(vin) ) return
allocate(vout(lbound(vin,1):ubound(vin,1)),stat=info)
if (info /= psb_success_) return
vout = vin
deallocate(vin,stat=info)
#endif
end Subroutine psb_i4move_alloc1d_i8
Subroutine psb_i4move_alloc2d(vin,vout,info) Subroutine psb_i4move_alloc2d(vin,vout,info)
use psb_error_mod use psb_error_mod
integer(psb_mpik_), allocatable, intent(inout) :: vin(:,:),vout(:,:) integer(psb_mpik_), allocatable, intent(inout) :: vin(:,:),vout(:,:)
@ -3060,6 +3087,31 @@ Contains
#endif #endif
end Subroutine psb_i4move_alloc2d end Subroutine psb_i4move_alloc2d
Subroutine psb_i4move_alloc2d_i8(vin,vout,info)
use psb_error_mod
integer(psb_mpik_), allocatable, intent(inout) :: vin(:,:),vout(:,:)
integer(psb_ipk_), intent(out) :: info
!
!
info=psb_success_
#ifdef HAVE_MOVE_ALLOC
call move_alloc(vin,vout)
#else
if (allocated(vout)) then
deallocate(vout,stat=info)
end if
if (.not.allocated(vin) ) return
allocate(vout(lbound(vin,1):ubound(vin,1),&
& lbound(vin,2):ubound(vin,2)),stat=info)
if (info /= psb_success_) return
vout = vin
deallocate(vin,stat=info)
#endif
end Subroutine psb_i4move_alloc2d_i8
#endif #endif
#if defined(LONG_INTEGERS) #if defined(LONG_INTEGERS)
@ -3141,7 +3193,85 @@ Contains
End Subroutine psb_reallocate1i4 End Subroutine psb_reallocate1i4
Subroutine psb_reallocatei4_2(len1,len2,rrax,info,pad,lb1,lb2) Subroutine psb_reallocate1i4_i8(len,rrax,info,pad,lb)
use psb_error_mod
! ...Subroutine Arguments
integer(psb_ipk_),Intent(in) :: len
Integer(psb_mpik_),allocatable, intent(inout) :: rrax(:)
integer(psb_ipk_) :: info
integer(psb_mpik_), optional, intent(in) :: pad
integer(psb_ipk_), optional, intent(in) :: lb
! ...Local Variables
Integer(psb_mpik_),allocatable :: tmp(:)
integer(psb_mpik_) :: dim, lb_, lbi, ub_, iinfo
integer(psb_ipk_) :: err, err_act, ierr(5)
character(len=20) :: name
logical, parameter :: debug=.false.
name='psb_reallocate1i4'
call psb_erractionsave(err_act)
info=psb_success_
if (debug) write(psb_err_unit,*) 'reallocate I',len
if (psb_get_errstatus() /= 0) then
if (debug) write(psb_err_unit,*) 'reallocate errstatus /= 0'
info=psb_err_from_subroutine_
goto 9999
end if
if (present(lb)) then
lb_ = lb
else
lb_ = 1
endif
if ((len<0)) then
err=4025; ierr(1) = len
call psb_errpush(err,name,i_err=ierr,a_err='integer')
goto 9999
end if
ub_ = lb_+len-1
if (debug) write(psb_err_unit,*) 'reallocate : lb ub ',lb_, ub_
if (allocated(rrax)) then
dim = size(rrax)
lbi = lbound(rrax,1)
If ((dim /= len).or.(lbi /= lb_)) Then
Allocate(tmp(lb_:ub_),stat=info)
if (info /= psb_success_) then
err=4025; ierr(1) = len
call psb_errpush(err,name,i_err=ierr,a_err='integer')
goto 9999
end if
tmp(lb_:lb_-1+min(len,dim))=rrax(lbi:lbi-1+min(len,dim))
if (debug) write(psb_err_unit,*) 'reallocate : calling move_alloc '
call psb_move_alloc(tmp,rrax,iinfo)
if (debug) write(psb_err_unit,*) 'reallocate : from move_alloc ',iinfo
end if
else
dim = 0
allocate(rrax(lb_:ub_),stat=info)
if (info /= psb_success_) then
err=4025; ierr(1) = len
call psb_errpush(err,name,i_err=ierr,a_err='integer')
goto 9999
end if
endif
if (present(pad)) then
rrax(lb_-1+dim+1:lb_-1+len) = pad
endif
if (debug) write(psb_err_unit,*) 'end reallocate : ',info
call psb_erractionrestore(err_act)
return
9999 continue
info = err
call psb_error_handler(err_act)
return
End Subroutine psb_reallocate1i4_i8
Subroutine psb_reallocate2i4(len1,len2,rrax,info,pad,lb1,lb2)
use psb_error_mod use psb_error_mod
! ...Subroutine Arguments ! ...Subroutine Arguments
integer(psb_mpik_),Intent(in) :: len1,len2 integer(psb_mpik_),Intent(in) :: len1,len2
@ -3224,7 +3354,92 @@ Contains
call psb_error_handler(err_act) call psb_error_handler(err_act)
return return
End Subroutine psb_reallocatei4_2 End Subroutine psb_reallocate2i4
Subroutine psb_reallocate2i4_i8(len1,len2,rrax,info,pad,lb1,lb2)
use psb_error_mod
! ...Subroutine Arguments
integer(psb_ipk_),Intent(in) :: len1,len2
integer(psb_mpik_),allocatable :: rrax(:,:)
integer(psb_ipk_) :: info
integer(psb_mpik_), optional, intent(in) :: pad
integer(psb_ipk_),Intent(in), optional :: lb1,lb2
! ...Local Variables
integer(psb_mpik_),allocatable :: tmp(:,:)
integer(psb_mpik_) :: dim, dim2,lb1_, lb2_, ub1_, ub2_,&
& lbi1, lbi2
integer(psb_ipk_) :: err,err_act, ierr(5)
character(len=20) :: name
name='psb_reallocatei2'
call psb_erractionsave(err_act)
info=psb_success_
if (present(lb1)) then
lb1_ = lb1
else
lb1_ = 1
endif
if (present(lb2)) then
lb2_ = lb2
else
lb2_ = 1
endif
ub1_ = lb1_ + len1 -1
ub2_ = lb2_ + len2 -1
if (len1 < 0) then
err=4025; ierr(1) = len1
call psb_errpush(err,name,i_err=ierr,a_err='integer')
goto 9999
end if
if (len2 < 0) then
err=4025; ierr(1) = len2
call psb_errpush(err,name,i_err=ierr,a_err='integer')
goto 9999
end if
if (allocated(rrax)) then
dim = size(rrax,1)
lbi1 = lbound(rrax,1)
dim2 = size(rrax,2)
lbi2 = lbound(rrax,2)
If ((dim /= len1).or.(dim2 /= len2).or.(lbi1 /= lb1_)&
& .or.(lbi2 /= lb2_)) Then
Allocate(tmp(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025; ierr(1) = len1*len2
call psb_errpush(err,name,i_err=ierr,a_err='integer')
goto 9999
end if
tmp(lb1_:lb1_-1+min(len1,dim),lb2_:lb2_-1+min(len2,dim2)) = &
& rrax(lbi1:lbi1-1+min(len1,dim),lbi2:lbi2-1+min(len2,dim2))
call psb_move_alloc(tmp,rrax,info)
End If
else
dim = 0
dim2 = 0
Allocate(rrax(lb1_:ub1_,lb2_:ub2_),stat=info)
if (info /= psb_success_) then
err=4025; ierr(1) = len1*len2
call psb_errpush(err,name,i_err=ierr,a_err='integer')
goto 9999
end if
endif
if (present(pad)) then
rrax(lb1_-1+dim+1:lb1_-1+len1,:) = pad
rrax(lb1_:lb1_-1+dim,lb2_-1+dim2+1:lb2_-1+len2) = pad
endif
call psb_erractionrestore(err_act)
return
9999 continue
info = err
call psb_error_handler(err_act)
return
End Subroutine psb_reallocate2i4_i8
Subroutine psb_rp1i1(len,rrax,info,pad,lb) Subroutine psb_rp1i1(len,rrax,info,pad,lb)

45
base/modules/serial/psb_c_base_vect_mod.f90
Unescape Escape View File

@ -63,7 +63,7 @@ module psb_c_base_vect_mod
!> Values. !> Values.
complex(psb_spk_), allocatable :: v(:) complex(psb_spk_), allocatable :: v(:)
complex(psb_spk_), allocatable :: combuf(:) complex(psb_spk_), allocatable :: combuf(:)
integer(psb_ipk_), allocatable :: comid(:,:) integer(psb_mpik_), allocatable :: comid(:,:)
contains contains
! !
! Constructors/allocators ! Constructors/allocators
@ -722,10 +722,10 @@ contains
subroutine c_base_absval2(x,y) subroutine c_base_absval2(x,y)
class(psb_c_base_vect_type), intent(inout) :: x class(psb_c_base_vect_type), intent(inout) :: x
class(psb_c_base_vect_type), intent(inout) :: y class(psb_c_base_vect_type), intent(inout) :: y
integer(psb_ipk_) :: info
if (.not.x%is_host()) call x%sync() if (.not.x%is_host()) call x%sync()
if (allocated(x%v)) then if (allocated(x%v)) then
call y%axpby(min(x%get_nrows(),y%get_nrows()),cone,x,czero,info) call y%axpby(ione*min(x%get_nrows(),y%get_nrows()),cone,x,czero,info)
call y%absval() call y%absval()
end if end if
@ -1225,7 +1225,7 @@ contains
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
call psb_realloc(n,2,x%comid,info) call psb_realloc(n,2_psb_ipk_,x%comid,info)
end subroutine c_base_new_comid end subroutine c_base_new_comid
@ -1357,7 +1357,7 @@ module psb_c_base_multivect_mod
!> Values. !> Values.
complex(psb_spk_), allocatable :: v(:,:) complex(psb_spk_), allocatable :: v(:,:)
complex(psb_spk_), allocatable :: combuf(:) complex(psb_spk_), allocatable :: combuf(:)
integer(psb_ipk_), allocatable :: comid(:,:) integer(psb_mpik_), allocatable :: comid(:,:)
contains contains
! !
! Constructors/allocators ! Constructors/allocators
@ -1989,7 +1989,7 @@ contains
select type(yy => y) select type(yy => y)
type is (psb_c_base_multivect_type) type is (psb_c_base_multivect_type)
if (y%is_dev()) call y%sync() if (y%is_dev()) call y%sync()
nc = min(psb_size(x%v,2),psb_size(y%v,2)) nc = min(psb_size(x%v,2_psb_ipk_),psb_size(y%v,2_psb_ipk_))
allocate(res(nc)) allocate(res(nc))
do j=1,nc do j=1,nc
res(j) = cdotc(n,x%v(:,j),1,y%v(:,j),1) res(j) = cdotc(n,x%v(:,j),1,y%v(:,j),1)
@ -2020,7 +2020,7 @@ contains
integer(psb_ipk_) :: j,nc integer(psb_ipk_) :: j,nc
if (x%is_dev()) call x%sync() if (x%is_dev()) call x%sync()
nc = min(psb_size(x%v,2),size(y,2)) nc = min(psb_size(x%v,2_psb_ipk_),size(y,2_psb_ipk_))
allocate(res(nc)) allocate(res(nc))
do j=1,nc do j=1,nc
res(j) = cdotc(n,x%v(:,j),1,y(:,j),1) res(j) = cdotc(n,x%v(:,j),1,y(:,j),1)
@ -2056,7 +2056,7 @@ contains
if (present(n)) then if (present(n)) then
nc = n nc = n
else else
nc = min(psb_size(x%v,2),psb_size(y%v,2)) nc = min(psb_size(x%v,2_psb_ipk_),psb_size(y%v,2_psb_ipk_))
end if end if
select type(xx => x) select type(xx => x)
type is (psb_c_base_multivect_type) type is (psb_c_base_multivect_type)
@ -2093,7 +2093,7 @@ contains
if (present(n)) then if (present(n)) then
nc = n nc = n
else else
nc = min(size(x,2),psb_size(y%v,2)) nc = min(size(x,2),psb_size(y%v,2_psb_ipk_))
end if end if
call psb_geaxpby(m,nc,alpha,x,beta,y%v,info) call psb_geaxpby(m,nc,alpha,x,beta,y%v,info)
@ -2158,7 +2158,7 @@ contains
integer(psb_ipk_) :: i, n integer(psb_ipk_) :: i, n
info = 0 info = 0
n = min(psb_size(y%v,1), size(x)) n = min(psb_size(y%v,1_psb_ipk_), size(x))
do i=1, n do i=1, n
y%v(i,:) = y%v(i,:)*x(i) y%v(i,:) = y%v(i,:)*x(i)
end do end do
@ -2181,8 +2181,8 @@ contains
integer(psb_ipk_) :: i, nr,nc integer(psb_ipk_) :: i, nr,nc
info = 0 info = 0
nr = min(psb_size(y%v,1), size(x,1)) nr = min(psb_size(y%v,1_psb_ipk_), size(x,1))
nc = min(psb_size(y%v,2), size(x,2)) nc = min(psb_size(y%v,2_psb_ipk_), size(x,2))
y%v(1:nr,1:nc) = y%v(1:nr,1:nc)*x(1:nr,1:nc) y%v(1:nr,1:nc) = y%v(1:nr,1:nc)*x(1:nr,1:nc)
end subroutine c_base_mlv_mlt_ar2 end subroutine c_base_mlv_mlt_ar2
@ -2210,8 +2210,8 @@ contains
integer(psb_ipk_) :: i, nr, nc integer(psb_ipk_) :: i, nr, nc
info = 0 info = 0
nr = min(psb_size(z%v,1), size(x,1), size(y,1)) nr = min(psb_size(z%v,1_psb_ipk_), size(x,1), size(y,1))
nc = min(psb_size(z%v,2), size(x,2), size(y,2)) nc = min(psb_size(z%v,2_psb_ipk_), size(x,2), size(y,2))
if (alpha == czero) then if (alpha == czero) then
if (beta == cone) then if (beta == cone) then
return return
@ -2358,7 +2358,7 @@ contains
integer(psb_ipk_) :: j, nc integer(psb_ipk_) :: j, nc
if (x%is_dev()) call x%sync() if (x%is_dev()) call x%sync()
nc = psb_size(x%v,2) nc = psb_size(x%v,2_psb_ipk_)
allocate(res(nc)) allocate(res(nc))
do j=1,nc do j=1,nc
res(j) = scnrm2(n,x%v(:,j),1) res(j) = scnrm2(n,x%v(:,j),1)
@ -2379,7 +2379,7 @@ contains
integer(psb_ipk_) :: j, nc integer(psb_ipk_) :: j, nc
if (x%is_dev()) call x%sync() if (x%is_dev()) call x%sync()
nc = psb_size(x%v,2) nc = psb_size(x%v,2_psb_ipk_)
allocate(res(nc)) allocate(res(nc))
do j=1,nc do j=1,nc
res(j) = maxval(abs(x%v(1:n,j))) res(j) = maxval(abs(x%v(1:n,j)))
@ -2400,7 +2400,7 @@ contains
integer(psb_ipk_) :: j, nc integer(psb_ipk_) :: j, nc
if (x%is_dev()) call x%sync() if (x%is_dev()) call x%sync()
nc = psb_size(x%v,2) nc = psb_size(x%v,2_psb_ipk_)
allocate(res(nc)) allocate(res(nc))
do j=1,nc do j=1,nc
res(j) = sum(abs(x%v(1:n,j))) res(j) = sum(abs(x%v(1:n,j)))
@ -2429,6 +2429,7 @@ contains
subroutine c_base_mlv_absval2(x,y) subroutine c_base_mlv_absval2(x,y)
class(psb_c_base_multivect_type), intent(inout) :: x class(psb_c_base_multivect_type), intent(inout) :: x
class(psb_c_base_multivect_type), intent(inout) :: y class(psb_c_base_multivect_type), intent(inout) :: y
integer(psb_ipk_) :: info
if (x%is_dev()) call x%sync() if (x%is_dev()) call x%sync()
if (allocated(x%v)) then if (allocated(x%v)) then
@ -2464,7 +2465,7 @@ contains
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
call psb_realloc(n,2,x%comid,info) call psb_realloc(n,2_psb_ipk_,x%comid,info)
end subroutine c_base_mlv_new_comid end subroutine c_base_mlv_new_comid
@ -2512,7 +2513,7 @@ contains
if (.not.allocated(x%v)) then if (.not.allocated(x%v)) then
return return
end if end if
nc = psb_size(x%v,2) nc = psb_size(x%v,2_psb_ipk_)
call psi_gth(n,nc,idx,alpha,x%v,beta,y) call psi_gth(n,nc,idx,alpha,x%v,beta,y)
end subroutine c_base_mlv_gthab end subroutine c_base_mlv_gthab
@ -2557,7 +2558,7 @@ contains
if (.not.allocated(x%v)) then if (.not.allocated(x%v)) then
return return
end if end if
nc = psb_size(x%v,2) nc = psb_size(x%v,2_psb_ipk_)
call psi_gth(n,nc,idx,x%v,y) call psi_gth(n,nc,idx,x%v,y)
@ -2582,7 +2583,7 @@ contains
if (.not.allocated(x%v)) then if (.not.allocated(x%v)) then
return return
end if end if
nc = psb_size(x%v,2) nc = psb_size(x%v,2_psb_ipk_)
call psi_gth(n,nc,idx,x%v,y) call psi_gth(n,nc,idx,x%v,y)
@ -2630,7 +2631,7 @@ contains
integer(psb_ipk_) :: nc integer(psb_ipk_) :: nc
if (y%is_dev()) call y%sync() if (y%is_dev()) call y%sync()
nc = psb_size(y%v,2) nc = psb_size(y%v,2_psb_ipk_)
call psi_sct(n,nc,idx,x,beta,y%v) call psi_sct(n,nc,idx,x,beta,y%v)
call y%set_host() call y%set_host()

2
base/modules/serial/psb_c_vect_mod.F90
Unescape Escape View File

@ -746,7 +746,7 @@ contains
class(psb_c_vect_type), intent(inout) :: y class(psb_c_vect_type), intent(inout) :: y
if (allocated(x%v)) then if (allocated(x%v)) then
if (.not.allocated(y%v)) call y%bld(size(x%v%v)) if (.not.allocated(y%v)) call y%bld(psb_size(x%v%v))
call x%v%absval(y%v) call x%v%absval(y%v)
end if end if
end subroutine c_vect_absval2 end subroutine c_vect_absval2

45
base/modules/serial/psb_d_base_vect_mod.f90
Unescape Escape View File

@ -63,7 +63,7 @@ module psb_d_base_vect_mod
!> Values. !> Values.
real(psb_dpk_), allocatable :: v(:) real(psb_dpk_), allocatable :: v(:)
real(psb_dpk_), allocatable :: combuf(:) real(psb_dpk_), allocatable :: combuf(:)
integer(psb_ipk_), allocatable :: comid(:,:) integer(psb_mpik_), allocatable :: comid(:,:)
contains contains
! !
! Constructors/allocators ! Constructors/allocators
@ -722,10 +722,10 @@ contains
subroutine d_base_absval2(x,y) subroutine d_base_absval2(x,y)
class(psb_d_base_vect_type), intent(inout) :: x class(psb_d_base_vect_type), intent(inout) :: x
class(psb_d_base_vect_type), intent(inout) :: y class(psb_d_base_vect_type), intent(inout) :: y
integer(psb_ipk_) :: info
if (.not.x%is_host()) call x%sync() if (.not.x%is_host()) call x%sync()
if (allocated(x%v)) then if (allocated(x%v)) then
call y%axpby(min(x%get_nrows(),y%get_nrows()),done,x,dzero,info) call y%axpby(ione*min(x%get_nrows(),y%get_nrows()),done,x,dzero,info)
call y%absval() call y%absval()
end if end if
@ -1225,7 +1225,7 @@ contains
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
call psb_realloc(n,2,x%comid,info) call psb_realloc(n,2_psb_ipk_,x%comid,info)
end subroutine d_base_new_comid end subroutine d_base_new_comid
@ -1357,7 +1357,7 @@ module psb_d_base_multivect_mod
!> Values. !> Values.
real(psb_dpk_), allocatable :: v(:,:) real(psb_dpk_), allocatable :: v(:,:)
real(psb_dpk_), allocatable :: combuf(:) real(psb_dpk_), allocatable :: combuf(:)
integer(psb_ipk_), allocatable :: comid(:,:) integer(psb_mpik_), allocatable :: comid(:,:)
contains contains
! !
! Constructors/allocators ! Constructors/allocators
@ -1989,7 +1989,7 @@ contains
select type(yy => y) select type(yy => y)
type is (psb_d_base_multivect_type) type is (psb_d_base_multivect_type)
if (y%is_dev()) call y%sync() if (y%is_dev()) call y%sync()
nc = min(psb_size(x%v,2),psb_size(y%v,2)) nc = min(psb_size(x%v,2_psb_ipk_),psb_size(y%v,2_psb_ipk_))
allocate(res(nc)) allocate(res(nc))
do j=1,nc do j=1,nc
res(j) = ddot(n,x%v(:,j),1,y%v(:,j),1) res(j) = ddot(n,x%v(:,j),1,y%v(:,j),1)
@ -2020,7 +2020,7 @@ contains
integer(psb_ipk_) :: j,nc integer(psb_ipk_) :: j,nc
if (x%is_dev()) call x%sync() if (x%is_dev()) call x%sync()
nc = min(psb_size(x%v,2),size(y,2)) nc = min(psb_size(x%v,2_psb_ipk_),size(y,2_psb_ipk_))
allocate(res(nc)) allocate(res(nc))
do j=1,nc do j=1,nc
res(j) = ddot(n,x%v(:,j),1,y(:,j),1) res(j) = ddot(n,x%v(:,j),1,y(:,j),1)
@ -2056,7 +2056,7 @@ contains
if (present(n)) then if (present(n)) then
nc = n nc = n
else else
nc = min(psb_size(x%v,2),psb_size(y%v,2)) nc = min(psb_size(x%v,2_psb_ipk_),psb_size(y%v,2_psb_ipk_))
end if end if
select type(xx => x) select type(xx => x)
type is (psb_d_base_multivect_type) type is (psb_d_base_multivect_type)
@ -2093,7 +2093,7 @@ contains
if (present(n)) then if (present(n)) then
nc = n nc = n
else else
nc = min(size(x,2),psb_size(y%v,2)) nc = min(size(x,2),psb_size(y%v,2_psb_ipk_))
end if end if
call psb_geaxpby(m,nc,alpha,x,beta,y%v,info) call psb_geaxpby(m,nc,alpha,x,beta,y%v,info)
@ -2158,7 +2158,7 @@ contains
integer(psb_ipk_) :: i, n integer(psb_ipk_) :: i, n
info = 0 info = 0
n = min(psb_size(y%v,1), size(x)) n = min(psb_size(y%v,1_psb_ipk_), size(x))
do i=1, n do i=1, n
y%v(i,:) = y%v(i,:)*x(i) y%v(i,:) = y%v(i,:)*x(i)
end do end do
@ -2181,8 +2181,8 @@ contains
integer(psb_ipk_) :: i, nr,nc integer(psb_ipk_) :: i, nr,nc
info = 0 info = 0
nr = min(psb_size(y%v,1), size(x,1)) nr = min(psb_size(y%v,1_psb_ipk_), size(x,1))
nc = min(psb_size(y%v,2), size(x,2)) nc = min(psb_size(y%v,2_psb_ipk_), size(x,2))
y%v(1:nr,1:nc) = y%v(1:nr,1:nc)*x(1:nr,1:nc) y%v(1:nr,1:nc) = y%v(1:nr,1:nc)*x(1:nr,1:nc)
end subroutine d_base_mlv_mlt_ar2 end subroutine d_base_mlv_mlt_ar2
@ -2210,8 +2210,8 @@ contains
integer(psb_ipk_) :: i, nr, nc integer(psb_ipk_) :: i, nr, nc
info = 0 info = 0
nr = min(psb_size(z%v,1), size(x,1), size(y,1)) nr = min(psb_size(z%v,1_psb_ipk_), size(x,1), size(y,1))
nc = min(psb_size(z%v,2), size(x,2), size(y,2)) nc = min(psb_size(z%v,2_psb_ipk_), size(x,2), size(y,2))
if (alpha == dzero) then if (alpha == dzero) then
if (beta == done) then if (beta == done) then
return return
@ -2358,7 +2358,7 @@ contains
integer(psb_ipk_) :: j, nc integer(psb_ipk_) :: j, nc
if (x%is_dev()) call x%sync() if (x%is_dev()) call x%sync()
nc = psb_size(x%v,2) nc = psb_size(x%v,2_psb_ipk_)
allocate(res(nc)) allocate(res(nc))
do j=1,nc do j=1,nc
res(j) = dnrm2(n,x%v(:,j),1) res(j) = dnrm2(n,x%v(:,j),1)
@ -2379,7 +2379,7 @@ contains
integer(psb_ipk_) :: j, nc integer(psb_ipk_) :: j, nc
if (x%is_dev()) call x%sync() if (x%is_dev()) call x%sync()
nc = psb_size(x%v,2) nc = psb_size(x%v,2_psb_ipk_)
allocate(res(nc)) allocate(res(nc))
do j=1,nc do j=1,nc
res(j) = maxval(abs(x%v(1:n,j))) res(j) = maxval(abs(x%v(1:n,j)))
@ -2400,7 +2400,7 @@ contains
integer(psb_ipk_) :: j, nc integer(psb_ipk_) :: j, nc
if (x%is_dev()) call x%sync() if (x%is_dev()) call x%sync()
nc = psb_size(x%v,2) nc = psb_size(x%v,2_psb_ipk_)
allocate(res(nc)) allocate(res(nc))
do j=1,nc do j=1,nc
res(j) = sum(abs(x%v(1:n,j))) res(j) = sum(abs(x%v(1:n,j)))
@ -2429,6 +2429,7 @@ contains
subroutine d_base_mlv_absval2(x,y) subroutine d_base_mlv_absval2(x,y)
class(psb_d_base_multivect_type), intent(inout) :: x class(psb_d_base_multivect_type), intent(inout) :: x
class(psb_d_base_multivect_type), intent(inout) :: y class(psb_d_base_multivect_type), intent(inout) :: y
integer(psb_ipk_) :: info
if (x%is_dev()) call x%sync() if (x%is_dev()) call x%sync()
if (allocated(x%v)) then if (allocated(x%v)) then
@ -2464,7 +2465,7 @@ contains
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
call psb_realloc(n,2,x%comid,info) call psb_realloc(n,2_psb_ipk_,x%comid,info)
end subroutine d_base_mlv_new_comid end subroutine d_base_mlv_new_comid
@ -2512,7 +2513,7 @@ contains
if (.not.allocated(x%v)) then if (.not.allocated(x%v)) then
return return
end if end if
nc = psb_size(x%v,2) nc = psb_size(x%v,2_psb_ipk_)
call psi_gth(n,nc,idx,alpha,x%v,beta,y) call psi_gth(n,nc,idx,alpha,x%v,beta,y)
end subroutine d_base_mlv_gthab end subroutine d_base_mlv_gthab
@ -2557,7 +2558,7 @@ contains
if (.not.allocated(x%v)) then if (.not.allocated(x%v)) then
return return
end if end if
nc = psb_size(x%v,2) nc = psb_size(x%v,2_psb_ipk_)
call psi_gth(n,nc,idx,x%v,y) call psi_gth(n,nc,idx,x%v,y)
@ -2582,7 +2583,7 @@ contains
if (.not.allocated(x%v)) then if (.not.allocated(x%v)) then
return return
end if end if
nc = psb_size(x%v,2) nc = psb_size(x%v,2_psb_ipk_)
call psi_gth(n,nc,idx,x%v,y) call psi_gth(n,nc,idx,x%v,y)
@ -2630,7 +2631,7 @@ contains
integer(psb_ipk_) :: nc integer(psb_ipk_) :: nc
if (y%is_dev()) call y%sync() if (y%is_dev()) call y%sync()
nc = psb_size(y%v,2) nc = psb_size(y%v,2_psb_ipk_)
call psi_sct(n,nc,idx,x,beta,y%v) call psi_sct(n,nc,idx,x,beta,y%v)
call y%set_host() call y%set_host()

2
base/modules/serial/psb_d_vect_mod.F90
Unescape Escape View File

@ -746,7 +746,7 @@ contains
class(psb_d_vect_type), intent(inout) :: y class(psb_d_vect_type), intent(inout) :: y
if (allocated(x%v)) then if (allocated(x%v)) then
if (.not.allocated(y%v)) call y%bld(size(x%v%v)) if (.not.allocated(y%v)) call y%bld(psb_size(x%v%v))
call x%v%absval(y%v) call x%v%absval(y%v)
end if end if
end subroutine d_vect_absval2 end subroutine d_vect_absval2

16
base/modules/serial/psb_i_base_vect_mod.f90
Unescape Escape View File

@ -62,7 +62,7 @@ module psb_i_base_vect_mod
!> Values. !> Values.
integer(psb_ipk_), allocatable :: v(:) integer(psb_ipk_), allocatable :: v(:)
integer(psb_ipk_), allocatable :: combuf(:) integer(psb_ipk_), allocatable :: combuf(:)
integer(psb_ipk_), allocatable :: comid(:,:) integer(psb_mpik_), allocatable :: comid(:,:)
contains contains
! !
! Constructors/allocators ! Constructors/allocators
@ -766,7 +766,7 @@ contains
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
call psb_realloc(n,2,x%comid,info) call psb_realloc(n,2_psb_ipk_,x%comid,info)
end subroutine i_base_new_comid end subroutine i_base_new_comid
@ -898,7 +898,7 @@ module psb_i_base_multivect_mod
!> Values. !> Values.
integer(psb_ipk_), allocatable :: v(:,:) integer(psb_ipk_), allocatable :: v(:,:)
integer(psb_ipk_), allocatable :: combuf(:) integer(psb_ipk_), allocatable :: combuf(:)
integer(psb_ipk_), allocatable :: comid(:,:) integer(psb_mpik_), allocatable :: comid(:,:)
contains contains
! !
! Constructors/allocators ! Constructors/allocators
@ -1493,7 +1493,7 @@ contains
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
call psb_realloc(n,2,x%comid,info) call psb_realloc(n,2_psb_ipk_,x%comid,info)
end subroutine i_base_mlv_new_comid end subroutine i_base_mlv_new_comid
@ -1541,7 +1541,7 @@ contains
if (.not.allocated(x%v)) then if (.not.allocated(x%v)) then
return return
end if end if
nc = psb_size(x%v,2) nc = psb_size(x%v,2_psb_ipk_)
call psi_gth(n,nc,idx,alpha,x%v,beta,y) call psi_gth(n,nc,idx,alpha,x%v,beta,y)
end subroutine i_base_mlv_gthab end subroutine i_base_mlv_gthab
@ -1586,7 +1586,7 @@ contains
if (.not.allocated(x%v)) then if (.not.allocated(x%v)) then
return return
end if end if
nc = psb_size(x%v,2) nc = psb_size(x%v,2_psb_ipk_)
call psi_gth(n,nc,idx,x%v,y) call psi_gth(n,nc,idx,x%v,y)
@ -1611,7 +1611,7 @@ contains
if (.not.allocated(x%v)) then if (.not.allocated(x%v)) then
return return
end if end if
nc = psb_size(x%v,2) nc = psb_size(x%v,2_psb_ipk_)
call psi_gth(n,nc,idx,x%v,y) call psi_gth(n,nc,idx,x%v,y)
@ -1659,7 +1659,7 @@ contains
integer(psb_ipk_) :: nc integer(psb_ipk_) :: nc
if (y%is_dev()) call y%sync() if (y%is_dev()) call y%sync()
nc = psb_size(y%v,2) nc = psb_size(y%v,2_psb_ipk_)
call psi_sct(n,nc,idx,x,beta,y%v) call psi_sct(n,nc,idx,x,beta,y%v)
call y%set_host() call y%set_host()

45
base/modules/serial/psb_s_base_vect_mod.f90
Unescape Escape View File

@ -63,7 +63,7 @@ module psb_s_base_vect_mod
!> Values. !> Values.
real(psb_spk_), allocatable :: v(:) real(psb_spk_), allocatable :: v(:)
real(psb_spk_), allocatable :: combuf(:) real(psb_spk_), allocatable :: combuf(:)
integer(psb_ipk_), allocatable :: comid(:,:) integer(psb_mpik_), allocatable :: comid(:,:)
contains contains
! !
! Constructors/allocators ! Constructors/allocators
@ -722,10 +722,10 @@ contains
subroutine s_base_absval2(x,y) subroutine s_base_absval2(x,y)
class(psb_s_base_vect_type), intent(inout) :: x class(psb_s_base_vect_type), intent(inout) :: x
class(psb_s_base_vect_type), intent(inout) :: y class(psb_s_base_vect_type), intent(inout) :: y
integer(psb_ipk_) :: info
if (.not.x%is_host()) call x%sync() if (.not.x%is_host()) call x%sync()
if (allocated(x%v)) then if (allocated(x%v)) then
call y%axpby(min(x%get_nrows(),y%get_nrows()),sone,x,szero,info) call y%axpby(ione*min(x%get_nrows(),y%get_nrows()),sone,x,szero,info)
call y%absval() call y%absval()
end if end if
@ -1225,7 +1225,7 @@ contains
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
call psb_realloc(n,2,x%comid,info) call psb_realloc(n,2_psb_ipk_,x%comid,info)
end subroutine s_base_new_comid end subroutine s_base_new_comid
@ -1357,7 +1357,7 @@ module psb_s_base_multivect_mod
!> Values. !> Values.
real(psb_spk_), allocatable :: v(:,:) real(psb_spk_), allocatable :: v(:,:)
real(psb_spk_), allocatable :: combuf(:) real(psb_spk_), allocatable :: combuf(:)
integer(psb_ipk_), allocatable :: comid(:,:) integer(psb_mpik_), allocatable :: comid(:,:)
contains contains
! !
! Constructors/allocators ! Constructors/allocators
@ -1989,7 +1989,7 @@ contains
select type(yy => y) select type(yy => y)
type is (psb_s_base_multivect_type) type is (psb_s_base_multivect_type)
if (y%is_dev()) call y%sync() if (y%is_dev()) call y%sync()
nc = min(psb_size(x%v,2),psb_size(y%v,2)) nc = min(psb_size(x%v,2_psb_ipk_),psb_size(y%v,2_psb_ipk_))
allocate(res(nc)) allocate(res(nc))
do j=1,nc do j=1,nc
res(j) = sdot(n,x%v(:,j),1,y%v(:,j),1) res(j) = sdot(n,x%v(:,j),1,y%v(:,j),1)
@ -2020,7 +2020,7 @@ contains
integer(psb_ipk_) :: j,nc integer(psb_ipk_) :: j,nc
if (x%is_dev()) call x%sync() if (x%is_dev()) call x%sync()
nc = min(psb_size(x%v,2),size(y,2)) nc = min(psb_size(x%v,2_psb_ipk_),size(y,2_psb_ipk_))
allocate(res(nc)) allocate(res(nc))
do j=1,nc do j=1,nc
res(j) = sdot(n,x%v(:,j),1,y(:,j),1) res(j) = sdot(n,x%v(:,j),1,y(:,j),1)
@ -2056,7 +2056,7 @@ contains
if (present(n)) then if (present(n)) then
nc = n nc = n
else else
nc = min(psb_size(x%v,2),psb_size(y%v,2)) nc = min(psb_size(x%v,2_psb_ipk_),psb_size(y%v,2_psb_ipk_))
end if end if
select type(xx => x) select type(xx => x)
type is (psb_s_base_multivect_type) type is (psb_s_base_multivect_type)
@ -2093,7 +2093,7 @@ contains
if (present(n)) then if (present(n)) then
nc = n nc = n
else else
nc = min(size(x,2),psb_size(y%v,2)) nc = min(size(x,2),psb_size(y%v,2_psb_ipk_))
end if end if
call psb_geaxpby(m,nc,alpha,x,beta,y%v,info) call psb_geaxpby(m,nc,alpha,x,beta,y%v,info)
@ -2158,7 +2158,7 @@ contains
integer(psb_ipk_) :: i, n integer(psb_ipk_) :: i, n
info = 0 info = 0
n = min(psb_size(y%v,1), size(x)) n = min(psb_size(y%v,1_psb_ipk_), size(x))
do i=1, n do i=1, n
y%v(i,:) = y%v(i,:)*x(i) y%v(i,:) = y%v(i,:)*x(i)
end do end do
@ -2181,8 +2181,8 @@ contains
integer(psb_ipk_) :: i, nr,nc integer(psb_ipk_) :: i, nr,nc
info = 0 info = 0
nr = min(psb_size(y%v,1), size(x,1)) nr = min(psb_size(y%v,1_psb_ipk_), size(x,1))
nc = min(psb_size(y%v,2), size(x,2)) nc = min(psb_size(y%v,2_psb_ipk_), size(x,2))
y%v(1:nr,1:nc) = y%v(1:nr,1:nc)*x(1:nr,1:nc) y%v(1:nr,1:nc) = y%v(1:nr,1:nc)*x(1:nr,1:nc)
end subroutine s_base_mlv_mlt_ar2 end subroutine s_base_mlv_mlt_ar2
@ -2210,8 +2210,8 @@ contains
integer(psb_ipk_) :: i, nr, nc integer(psb_ipk_) :: i, nr, nc
info = 0 info = 0
nr = min(psb_size(z%v,1), size(x,1), size(y,1)) nr = min(psb_size(z%v,1_psb_ipk_), size(x,1), size(y,1))
nc = min(psb_size(z%v,2), size(x,2), size(y,2)) nc = min(psb_size(z%v,2_psb_ipk_), size(x,2), size(y,2))
if (alpha == szero) then if (alpha == szero) then
if (beta == sone) then if (beta == sone) then
return return
@ -2358,7 +2358,7 @@ contains
integer(psb_ipk_) :: j, nc integer(psb_ipk_) :: j, nc
if (x%is_dev()) call x%sync() if (x%is_dev()) call x%sync()
nc = psb_size(x%v,2) nc = psb_size(x%v,2_psb_ipk_)
allocate(res(nc)) allocate(res(nc))
do j=1,nc do j=1,nc
res(j) = snrm2(n,x%v(:,j),1) res(j) = snrm2(n,x%v(:,j),1)
@ -2379,7 +2379,7 @@ contains
integer(psb_ipk_) :: j, nc integer(psb_ipk_) :: j, nc
if (x%is_dev()) call x%sync() if (x%is_dev()) call x%sync()
nc = psb_size(x%v,2) nc = psb_size(x%v,2_psb_ipk_)
allocate(res(nc)) allocate(res(nc))
do j=1,nc do j=1,nc
res(j) = maxval(abs(x%v(1:n,j))) res(j) = maxval(abs(x%v(1:n,j)))
@ -2400,7 +2400,7 @@ contains
integer(psb_ipk_) :: j, nc integer(psb_ipk_) :: j, nc
if (x%is_dev()) call x%sync() if (x%is_dev()) call x%sync()
nc = psb_size(x%v,2) nc = psb_size(x%v,2_psb_ipk_)
allocate(res(nc)) allocate(res(nc))
do j=1,nc do j=1,nc
res(j) = sum(abs(x%v(1:n,j))) res(j) = sum(abs(x%v(1:n,j)))
@ -2429,6 +2429,7 @@ contains
subroutine s_base_mlv_absval2(x,y) subroutine s_base_mlv_absval2(x,y)
class(psb_s_base_multivect_type), intent(inout) :: x class(psb_s_base_multivect_type), intent(inout) :: x
class(psb_s_base_multivect_type), intent(inout) :: y class(psb_s_base_multivect_type), intent(inout) :: y
integer(psb_ipk_) :: info
if (x%is_dev()) call x%sync() if (x%is_dev()) call x%sync()
if (allocated(x%v)) then if (allocated(x%v)) then
@ -2464,7 +2465,7 @@ contains
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
call psb_realloc(n,2,x%comid,info) call psb_realloc(n,2_psb_ipk_,x%comid,info)
end subroutine s_base_mlv_new_comid end subroutine s_base_mlv_new_comid
@ -2512,7 +2513,7 @@ contains
if (.not.allocated(x%v)) then if (.not.allocated(x%v)) then
return return
end if end if
nc = psb_size(x%v,2) nc = psb_size(x%v,2_psb_ipk_)
call psi_gth(n,nc,idx,alpha,x%v,beta,y) call psi_gth(n,nc,idx,alpha,x%v,beta,y)
end subroutine s_base_mlv_gthab end subroutine s_base_mlv_gthab
@ -2557,7 +2558,7 @@ contains
if (.not.allocated(x%v)) then if (.not.allocated(x%v)) then
return return
end if end if
nc = psb_size(x%v,2) nc = psb_size(x%v,2_psb_ipk_)
call psi_gth(n,nc,idx,x%v,y) call psi_gth(n,nc,idx,x%v,y)
@ -2582,7 +2583,7 @@ contains
if (.not.allocated(x%v)) then if (.not.allocated(x%v)) then
return return
end if end if
nc = psb_size(x%v,2) nc = psb_size(x%v,2_psb_ipk_)
call psi_gth(n,nc,idx,x%v,y) call psi_gth(n,nc,idx,x%v,y)
@ -2630,7 +2631,7 @@ contains
integer(psb_ipk_) :: nc integer(psb_ipk_) :: nc
if (y%is_dev()) call y%sync() if (y%is_dev()) call y%sync()
nc = psb_size(y%v,2) nc = psb_size(y%v,2_psb_ipk_)
call psi_sct(n,nc,idx,x,beta,y%v) call psi_sct(n,nc,idx,x,beta,y%v)
call y%set_host() call y%set_host()

2
base/modules/serial/psb_s_vect_mod.F90
Unescape Escape View File

@ -746,7 +746,7 @@ contains
class(psb_s_vect_type), intent(inout) :: y class(psb_s_vect_type), intent(inout) :: y
if (allocated(x%v)) then if (allocated(x%v)) then
if (.not.allocated(y%v)) call y%bld(size(x%v%v)) if (.not.allocated(y%v)) call y%bld(psb_size(x%v%v))
call x%v%absval(y%v) call x%v%absval(y%v)
end if end if
end subroutine s_vect_absval2 end subroutine s_vect_absval2

45
base/modules/serial/psb_z_base_vect_mod.f90
Unescape Escape View File

@ -63,7 +63,7 @@ module psb_z_base_vect_mod
!> Values. !> Values.
complex(psb_dpk_), allocatable :: v(:) complex(psb_dpk_), allocatable :: v(:)
complex(psb_dpk_), allocatable :: combuf(:) complex(psb_dpk_), allocatable :: combuf(:)
integer(psb_ipk_), allocatable :: comid(:,:) integer(psb_mpik_), allocatable :: comid(:,:)
contains contains
! !
! Constructors/allocators ! Constructors/allocators
@ -722,10 +722,10 @@ contains
subroutine z_base_absval2(x,y) subroutine z_base_absval2(x,y)
class(psb_z_base_vect_type), intent(inout) :: x class(psb_z_base_vect_type), intent(inout) :: x
class(psb_z_base_vect_type), intent(inout) :: y class(psb_z_base_vect_type), intent(inout) :: y
integer(psb_ipk_) :: info
if (.not.x%is_host()) call x%sync() if (.not.x%is_host()) call x%sync()
if (allocated(x%v)) then if (allocated(x%v)) then
call y%axpby(min(x%get_nrows(),y%get_nrows()),zone,x,zzero,info) call y%axpby(ione*min(x%get_nrows(),y%get_nrows()),zone,x,zzero,info)
call y%absval() call y%absval()
end if end if
@ -1225,7 +1225,7 @@ contains
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
call psb_realloc(n,2,x%comid,info) call psb_realloc(n,2_psb_ipk_,x%comid,info)
end subroutine z_base_new_comid end subroutine z_base_new_comid
@ -1357,7 +1357,7 @@ module psb_z_base_multivect_mod
!> Values. !> Values.
complex(psb_dpk_), allocatable :: v(:,:) complex(psb_dpk_), allocatable :: v(:,:)
complex(psb_dpk_), allocatable :: combuf(:) complex(psb_dpk_), allocatable :: combuf(:)
integer(psb_ipk_), allocatable :: comid(:,:) integer(psb_mpik_), allocatable :: comid(:,:)
contains contains
! !
! Constructors/allocators ! Constructors/allocators
@ -1989,7 +1989,7 @@ contains
select type(yy => y) select type(yy => y)
type is (psb_z_base_multivect_type) type is (psb_z_base_multivect_type)
if (y%is_dev()) call y%sync() if (y%is_dev()) call y%sync()
nc = min(psb_size(x%v,2),psb_size(y%v,2)) nc = min(psb_size(x%v,2_psb_ipk_),psb_size(y%v,2_psb_ipk_))
allocate(res(nc)) allocate(res(nc))
do j=1,nc do j=1,nc
res(j) = zdotc(n,x%v(:,j),1,y%v(:,j),1) res(j) = zdotc(n,x%v(:,j),1,y%v(:,j),1)
@ -2020,7 +2020,7 @@ contains
integer(psb_ipk_) :: j,nc integer(psb_ipk_) :: j,nc
if (x%is_dev()) call x%sync() if (x%is_dev()) call x%sync()
nc = min(psb_size(x%v,2),size(y,2)) nc = min(psb_size(x%v,2_psb_ipk_),size(y,2_psb_ipk_))
allocate(res(nc)) allocate(res(nc))
do j=1,nc do j=1,nc
res(j) = zdotc(n,x%v(:,j),1,y(:,j),1) res(j) = zdotc(n,x%v(:,j),1,y(:,j),1)
@ -2056,7 +2056,7 @@ contains
if (present(n)) then if (present(n)) then
nc = n nc = n
else else
nc = min(psb_size(x%v,2),psb_size(y%v,2)) nc = min(psb_size(x%v,2_psb_ipk_),psb_size(y%v,2_psb_ipk_))
end if end if
select type(xx => x) select type(xx => x)
type is (psb_z_base_multivect_type) type is (psb_z_base_multivect_type)
@ -2093,7 +2093,7 @@ contains
if (present(n)) then if (present(n)) then
nc = n nc = n
else else
nc = min(size(x,2),psb_size(y%v,2)) nc = min(size(x,2),psb_size(y%v,2_psb_ipk_))
end if end if
call psb_geaxpby(m,nc,alpha,x,beta,y%v,info) call psb_geaxpby(m,nc,alpha,x,beta,y%v,info)
@ -2158,7 +2158,7 @@ contains
integer(psb_ipk_) :: i, n integer(psb_ipk_) :: i, n
info = 0 info = 0
n = min(psb_size(y%v,1), size(x)) n = min(psb_size(y%v,1_psb_ipk_), size(x))
do i=1, n do i=1, n
y%v(i,:) = y%v(i,:)*x(i) y%v(i,:) = y%v(i,:)*x(i)
end do end do
@ -2181,8 +2181,8 @@ contains
integer(psb_ipk_) :: i, nr,nc integer(psb_ipk_) :: i, nr,nc
info = 0 info = 0
nr = min(psb_size(y%v,1), size(x,1)) nr = min(psb_size(y%v,1_psb_ipk_), size(x,1))
nc = min(psb_size(y%v,2), size(x,2)) nc = min(psb_size(y%v,2_psb_ipk_), size(x,2))
y%v(1:nr,1:nc) = y%v(1:nr,1:nc)*x(1:nr,1:nc) y%v(1:nr,1:nc) = y%v(1:nr,1:nc)*x(1:nr,1:nc)
end subroutine z_base_mlv_mlt_ar2 end subroutine z_base_mlv_mlt_ar2
@ -2210,8 +2210,8 @@ contains
integer(psb_ipk_) :: i, nr, nc integer(psb_ipk_) :: i, nr, nc
info = 0 info = 0
nr = min(psb_size(z%v,1), size(x,1), size(y,1)) nr = min(psb_size(z%v,1_psb_ipk_), size(x,1), size(y,1))
nc = min(psb_size(z%v,2), size(x,2), size(y,2)) nc = min(psb_size(z%v,2_psb_ipk_), size(x,2), size(y,2))
if (alpha == zzero) then if (alpha == zzero) then
if (beta == zone) then if (beta == zone) then
return return
@ -2358,7 +2358,7 @@ contains
integer(psb_ipk_) :: j, nc integer(psb_ipk_) :: j, nc
if (x%is_dev()) call x%sync() if (x%is_dev()) call x%sync()
nc = psb_size(x%v,2) nc = psb_size(x%v,2_psb_ipk_)
allocate(res(nc)) allocate(res(nc))
do j=1,nc do j=1,nc
res(j) = dznrm2(n,x%v(:,j),1) res(j) = dznrm2(n,x%v(:,j),1)
@ -2379,7 +2379,7 @@ contains
integer(psb_ipk_) :: j, nc integer(psb_ipk_) :: j, nc
if (x%is_dev()) call x%sync() if (x%is_dev()) call x%sync()
nc = psb_size(x%v,2) nc = psb_size(x%v,2_psb_ipk_)
allocate(res(nc)) allocate(res(nc))
do j=1,nc do j=1,nc
res(j) = maxval(abs(x%v(1:n,j))) res(j) = maxval(abs(x%v(1:n,j)))
@ -2400,7 +2400,7 @@ contains
integer(psb_ipk_) :: j, nc integer(psb_ipk_) :: j, nc
if (x%is_dev()) call x%sync() if (x%is_dev()) call x%sync()
nc = psb_size(x%v,2) nc = psb_size(x%v,2_psb_ipk_)
allocate(res(nc)) allocate(res(nc))
do j=1,nc do j=1,nc
res(j) = sum(abs(x%v(1:n,j))) res(j) = sum(abs(x%v(1:n,j)))
@ -2429,6 +2429,7 @@ contains
subroutine z_base_mlv_absval2(x,y) subroutine z_base_mlv_absval2(x,y)
class(psb_z_base_multivect_type), intent(inout) :: x class(psb_z_base_multivect_type), intent(inout) :: x
class(psb_z_base_multivect_type), intent(inout) :: y class(psb_z_base_multivect_type), intent(inout) :: y
integer(psb_ipk_) :: info
if (x%is_dev()) call x%sync() if (x%is_dev()) call x%sync()
if (allocated(x%v)) then if (allocated(x%v)) then
@ -2464,7 +2465,7 @@ contains
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
call psb_realloc(n,2,x%comid,info) call psb_realloc(n,2_psb_ipk_,x%comid,info)
end subroutine z_base_mlv_new_comid end subroutine z_base_mlv_new_comid
@ -2512,7 +2513,7 @@ contains
if (.not.allocated(x%v)) then if (.not.allocated(x%v)) then
return return
end if end if
nc = psb_size(x%v,2) nc = psb_size(x%v,2_psb_ipk_)
call psi_gth(n,nc,idx,alpha,x%v,beta,y) call psi_gth(n,nc,idx,alpha,x%v,beta,y)
end subroutine z_base_mlv_gthab end subroutine z_base_mlv_gthab
@ -2557,7 +2558,7 @@ contains
if (.not.allocated(x%v)) then if (.not.allocated(x%v)) then
return return
end if end if
nc = psb_size(x%v,2) nc = psb_size(x%v,2_psb_ipk_)
call psi_gth(n,nc,idx,x%v,y) call psi_gth(n,nc,idx,x%v,y)
@ -2582,7 +2583,7 @@ contains
if (.not.allocated(x%v)) then if (.not.allocated(x%v)) then
return return
end if end if
nc = psb_size(x%v,2) nc = psb_size(x%v,2_psb_ipk_)
call psi_gth(n,nc,idx,x%v,y) call psi_gth(n,nc,idx,x%v,y)
@ -2630,7 +2631,7 @@ contains
integer(psb_ipk_) :: nc integer(psb_ipk_) :: nc
if (y%is_dev()) call y%sync() if (y%is_dev()) call y%sync()
nc = psb_size(y%v,2) nc = psb_size(y%v,2_psb_ipk_)
call psi_sct(n,nc,idx,x,beta,y%v) call psi_sct(n,nc,idx,x,beta,y%v)
call y%set_host() call y%set_host()

2
base/modules/serial/psb_z_vect_mod.F90
Unescape Escape View File

@ -746,7 +746,7 @@ contains
class(psb_z_vect_type), intent(inout) :: y class(psb_z_vect_type), intent(inout) :: y
if (allocated(x%v)) then if (allocated(x%v)) then
if (.not.allocated(y%v)) call y%bld(size(x%v%v)) if (.not.allocated(y%v)) call y%bld(psb_size(x%v%v))
call x%v%absval(y%v) call x%v%absval(y%v)
end if end if
end subroutine z_vect_absval2 end subroutine z_vect_absval2

2
base/tools/psb_ccdbldext.F90
Unescape Escape View File

@ -712,7 +712,7 @@ Subroutine psb_ccdbldext(a,desc_a,novr,desc_ov,info, extype)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return

2
base/tools/psb_dcdbldext.F90
Unescape Escape View File

@ -712,7 +712,7 @@ Subroutine psb_dcdbldext(a,desc_a,novr,desc_ov,info, extype)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return

2
base/tools/psb_icdasb.F90
Unescape Escape View File

@ -168,7 +168,7 @@ subroutine psb_icdasb(desc,info,ext_hv,mold)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return

2
base/tools/psb_scdbldext.F90
Unescape Escape View File

@ -712,7 +712,7 @@ Subroutine psb_scdbldext(a,desc_a,novr,desc_ov,info, extype)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return

2
base/tools/psb_zcdbldext.F90
Unescape Escape View File

@ -712,7 +712,7 @@ Subroutine psb_zcdbldext(a,desc_a,novr,desc_ov,info, extype)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
9999 call psb_error_handler(ictxt,err_act) 9999 call psb_error_handler(ione*ictxt,err_act)
return return

7
krylov/psb_dcg.F90
Unescape Escape View File

@ -292,12 +292,13 @@ subroutine psb_dcg_vect(a,prec,b,x,eps,desc_a,info,&
end do iteration end do iteration
end do restart end do restart
if (do_cond) then if (do_cond) then
if (me == 0) then if (me == psb_root_) then
#if defined(HAVE_LAPACK) #if defined(HAVE_LAPACK)
call dstebz('A','E',istebz,dzero,dzero,0,0,-done,td,tu,& call dstebz('A','E',istebz,dzero,dzero,0,0,-done,td,tu,&
& ieg,nspl,eig,ibl,ispl,ewrk,iwrk,info) & ieg,nspl,eig,ibl,ispl,ewrk,iwrk,info)
if (info < 0) then if (info < 0) then
call psb_errpush(psb_err_from_subroutine_ai_,name,a_err='dstebz',i_err=(/info,0,0,0,0/)) call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err='dstebz',i_err=(/info,izero,izero,izero,izero/))
info=psb_err_from_subroutine_ai_ info=psb_err_from_subroutine_ai_
goto 9999 goto 9999
end if end if
@ -307,7 +308,7 @@ subroutine psb_dcg_vect(a,prec,b,x,eps,desc_a,info,&
#endif #endif
info=psb_success_ info=psb_success_
end if end if
call psb_bcast(ictxt,cond,root=0) call psb_bcast(ictxt,cond)
end if end if

7
krylov/psb_scg.F90
Unescape Escape View File

@ -292,12 +292,13 @@ subroutine psb_scg_vect(a,prec,b,x,eps,desc_a,info,&
end do iteration end do iteration
end do restart end do restart
if (do_cond) then if (do_cond) then
if (me == 0) then if (me == psb_root_) then
#if defined(HAVE_LAPACK) #if defined(HAVE_LAPACK)
call sstebz('A','E',istebz,szero,szero,0,0,-sone,td,tu,& call sstebz('A','E',istebz,szero,szero,0,0,-sone,td,tu,&
& ieg,nspl,eig,ibl,ispl,ewrk,iwrk,info) & ieg,nspl,eig,ibl,ispl,ewrk,iwrk,info)
if (info < 0) then if (info < 0) then
call psb_errpush(psb_err_from_subroutine_ai_,name,a_err='sstebz',i_err=(/info,0,0,0,0/)) call psb_errpush(psb_err_from_subroutine_ai_,name,&
& a_err='sstebz',i_err=(/info,izero,izero,izero,izero/))
info=psb_err_from_subroutine_ai_ info=psb_err_from_subroutine_ai_
goto 9999 goto 9999
end if end if
@ -307,7 +308,7 @@ subroutine psb_scg_vect(a,prec,b,x,eps,desc_a,info,&
#endif #endif
info=psb_success_ info=psb_success_
end if end if
call psb_bcast(ictxt,cond,root=0) call psb_bcast(ictxt,cond)
end if end if

Write Preview
Loading…
Cancel
Save