base/comm/psb_dhalo.f90

@@ -58,6 +58,7 @@ subroutine  psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
   use psb_check_mod
   use psb_realloc_mod
   use psb_error_mod
+  use psb_string_mod
   use psb_penv_mod
   implicit none
 
@@ -74,7 +75,7 @@ subroutine  psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
        & err_act, m, n, iix, jjx, ix, ijx, k, maxk, nrow, imode, i,&
        & err, liwork,data_
   real(kind(1.d0)),pointer :: iwork(:), xp(:,:)
-  character                :: ltran
+  character                :: tran_
   character(len=20)        :: name, ch_err
   logical                  :: aliw
 
@@ -117,9 +118,9 @@ subroutine  psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
   end if
 
   if (present(tran)) then     
-    ltran = tran
+    tran_ = toupper(tran)
   else
-    ltran = 'N'
+    tran_ = 'N'
   endif
 
   if (present(data)) then     
@@ -189,12 +190,16 @@ subroutine  psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
 
   ! exchange halo elements
   xp => x(iix:size(x,1),jjx:jjx+k-1)
-  if(ltran.eq.'N') then
-    call psi_swapdata(imode,k,0.d0,xp,&
+  if(tran_ == 'N') then
+    call psi_swapdata(imode,k,dzero,xp,&
          & desc_a,iwork,info,data=data_)
-  else if((ltran.eq.'T').or.(ltran.eq.'H')) then
-    call psi_swaptran(imode,k,1.d0,xp,&
+  else if((tran_ == 'T').or.(tran_ == 'C')) then
+    call psi_swaptran(imode,k,done,xp,&
          &desc_a,iwork,info)
+  else
+    info = 4001
+    call psb_errpush(info,name,a_err='invalid tran')
+    goto 9999      
   end if
 
   if(info.ne.0) then
@@ -211,7 +216,7 @@ subroutine  psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
 9999 continue
   call psb_erractionrestore(err_act)
 
-  if (err_act.eq.psb_act_abort_) then
+  if (err_act == psb_act_abort_) then
     call psb_error(ictxt)
     return
   end if
@@ -278,6 +283,7 @@ subroutine  psb_dhalov(x,desc_a,info,alpha,work,tran,mode,data)
   use psb_check_mod
   use psb_realloc_mod
   use psb_error_mod
+  use psb_string_mod
   use psb_penv_mod
   implicit none
 
@@ -294,7 +300,7 @@ subroutine  psb_dhalov(x,desc_a,info,alpha,work,tran,mode,data)
        & err_act, m, n, iix, jjx, ix, ijx, nrow, imode,&
        & err, liwork,data_
   real(kind(1.d0)),pointer :: iwork(:)
-  character                :: ltran
+  character                :: tran_
   character(len=20)        :: name, ch_err
   logical                  :: aliw
 
@@ -321,9 +327,9 @@ subroutine  psb_dhalov(x,desc_a,info,alpha,work,tran,mode,data)
   nrow = psb_cd_get_local_rows(desc_a)
 
   if (present(tran)) then     
-    ltran = tran
+    tran_ = toupper(tran)
   else
-    ltran = 'N'
+    tran_ = 'N'
   endif
   if (present(data)) then     
     data_ = data
@@ -386,12 +392,16 @@ subroutine  psb_dhalov(x,desc_a,info,alpha,work,tran,mode,data)
   end if
 
   ! exchange halo elements
-  if(ltran.eq.'N') then
-    call psi_swapdata(imode,0.d0,x(iix:size(x)),&
+  if(tran_ == 'N') then
+    call psi_swapdata(imode,dzero,x(iix:size(x)),&
          & desc_a,iwork,info,data=data_)
-  else if((ltran.eq.'T').or.(ltran.eq.'H')) then
-    call psi_swaptran(imode,1.d0,x(iix:size(x)),&
+  else if((tran_ == 'T').or.(tran_ == 'C')) then
+    call psi_swaptran(imode,done,x(iix:size(x)),&
          & desc_a,iwork,info)
+  else
+    info = 4001
+    call psb_errpush(info,name,a_err='invalid tran')
+    goto 9999      
   end if
 
   if(info.ne.0) then
@@ -408,7 +418,7 @@ subroutine  psb_dhalov(x,desc_a,info,alpha,work,tran,mode,data)
 9999 continue
   call psb_erractionrestore(err_act)
 
-  if (err_act.eq.psb_act_abort_) then
+  if (err_act == psb_act_abort_) then
     call psb_error(ictxt)
     return
   end if

base/comm/psb_dovrl.f90

@@ -231,7 +231,7 @@ subroutine  psb_dovrlm(x,desc_a,info,jx,ik,work,update,mode)
 9999 continue
   call psb_erractionrestore(err_act)
 
-  if (err_act.eq.psb_act_abort_) then
+  if (err_act == psb_act_abort_) then
     call psb_error(ictxt)
     return
   end if
@@ -454,7 +454,7 @@ subroutine  psb_dovrlv(x,desc_a,info,work,update,mode)
 9999 continue
   call psb_erractionrestore(err_act)
 
-  if (err_act.eq.psb_act_abort_) then
+  if (err_act == psb_act_abort_) then
     call psb_error(ictxt)
     return
   end if

base/comm/psb_ihalo.f90

@@ -75,7 +75,7 @@ subroutine  psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
        & err_act, m, n, iix, jjx, ix, ijx, nrow, k, maxk, liwork,&
        & imode, err,data_
   integer, pointer         :: xp(:,:), iwork(:)
-  character                :: ltran
+  character                :: tran_
   character(len=20)        :: name, ch_err
   logical                  :: aliw
 
@@ -118,9 +118,9 @@ subroutine  psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
   end if
 
   if (present(tran)) then     
-    ltran = tran
+    tran_ = toupper(tran)
   else
-    ltran = 'N'
+    tran_ = 'N'
   endif
 
   if (present(data)) then     
@@ -191,12 +191,16 @@ subroutine  psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
 
   xp => x(iix:size(x,1),jjx:jjx+k-1)
   ! exchange halo elements
-  if(ltran.eq.'N') then
-    call psi_swapdata(imode,k,0,xp,&
+  if(tran_ == 'N') then
+    call psi_swapdata(imode,k,izero,xp,&
          & desc_a,iwork,info,data=data_)
-  else if((ltran.eq.'T').or.(ltran.eq.'H')) then
-    call psi_swaptran(imode,k,1,xp,&
+  else if((tran_ == 'T').or.(tran_ == 'C')) then
+    call psi_swaptran(imode,k,ione,xp,&
          & desc_a,iwork,info)
+  else
+    info = 4001
+    call psb_errpush(info,name,a_err='invalid tran')
+    goto 9999      
   end if
 
   if(info.ne.0) then
@@ -213,7 +217,7 @@ subroutine  psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
 9999 continue
   call psb_erractionrestore(err_act)
 
-  if (err_act.eq.psb_act_abort_) then
+  if (err_act == psb_act_abort_) then
     call psb_error(ictxt)
     return
   end if
@@ -298,7 +302,7 @@ subroutine  psb_ihalov(x,desc_a,info,alpha,work,tran,mode,data)
        & err_act, m, n, iix, jjx, ix, ijx, nrow, imode,&
        & err, liwork, data_
   integer,pointer          :: iwork(:)
-  character                :: ltran
+  character                :: tran_
   character(len=20)        :: name, ch_err
   logical                  :: aliw
 
@@ -327,9 +331,9 @@ subroutine  psb_ihalov(x,desc_a,info,alpha,work,tran,mode,data)
 
 
   if (present(tran)) then     
-    ltran = tran
+    tran_ = toupper(tran)
   else
-    ltran = 'N'
+    tran_ = 'N'
   endif
   if (present(data)) then     
     data_ = data
@@ -392,12 +396,16 @@ subroutine  psb_ihalov(x,desc_a,info,alpha,work,tran,mode,data)
   end if
 
   ! exchange halo elements
-  if(ltran.eq.'N') then
-    call psi_swapdata(imode,0,x(iix:size(x)),&
+  if(tran_ == 'N') then
+    call psi_swapdata(imode,izero,x(iix:size(x)),&
          & desc_a,iwork,info,data=data_)
-  else if((ltran.eq.'T').or.(ltran.eq.'H')) then
-    call psi_swaptran(imode,1,x(iix:size(x)),&
+  else if((tran_ == 'T').or.(tran_ == 'C')) then
+    call psi_swaptran(imode,ione,x(iix:size(x)),&
          & desc_a,iwork,info)
+  else
+    info = 4001
+    call psb_errpush(info,name,a_err='invalid tran')
+    goto 9999      
   end if
 
   if(info.ne.0) then
@@ -414,7 +422,7 @@ subroutine  psb_ihalov(x,desc_a,info,alpha,work,tran,mode,data)
 9999 continue
   call psb_erractionrestore(err_act)
 
-  if (err_act.eq.psb_act_abort_) then
+  if (err_act == psb_act_abort_) then
     call psb_error(ictxt)
     return
   end if

base/comm/psb_zhalo.f90

@@ -74,7 +74,7 @@ subroutine  psb_zhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
        & err_act, m, n, iix, jjx, ix, ijx, k, maxk, nrow, imode, i,&
        & err, liwork,data_
   complex(kind(1.d0)),pointer :: iwork(:), xp(:,:)
-  character                :: ltran
+  character                :: tran_
   character(len=20)        :: name, ch_err
   logical                  :: aliw
 
@@ -117,9 +117,9 @@ subroutine  psb_zhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
   end if
 
   if (present(tran)) then     
-    ltran = tran
+    tran_ = toupper(tran)
   else
-    ltran = 'N'
+    tran_ = 'N'
   endif
   if (present(mode)) then 
     imode = mode
@@ -187,12 +187,16 @@ subroutine  psb_zhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
 
   ! exchange halo elements
   xp => x(iix:size(x,1),jjx:jjx+k-1)
-  if(ltran.eq.'N') then
+  if(tran_ == 'N') then
     call psi_swapdata(imode,k,zzero,xp,&
          & desc_a,iwork,info,data=data_)
-  else if((ltran.eq.'T').or.(ltran.eq.'H')) then
+  else if((tran_ == 'T').or.(tran_ == 'C')) then
     call psi_swaptran(imode,k,zone,xp,&
          &desc_a,iwork,info)
+  else
+    info = 4001
+    call psb_errpush(info,name,a_err='invalid tran')
+    goto 9999      
   end if
 
   if(info.ne.0) then
@@ -210,7 +214,7 @@ subroutine  psb_zhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
 9999 continue
   call psb_erractionrestore(err_act)
 
-  if (err_act.eq.psb_act_abort_) then
+  if (err_act == psb_act_abort_) then
     call psb_error(ictxt)
     return
   end if
@@ -294,7 +298,7 @@ subroutine  psb_zhalov(x,desc_a,info,alpha,work,tran,mode,data)
   integer                  :: ictxt, np, me, err_act, &
        & m, n, iix, jjx, ix, ijx, nrow, imode, err, liwork,data_
   complex(kind(1.d0)),pointer :: iwork(:)
-  character                :: ltran
+  character                :: tran_
   character(len=20)        :: name, ch_err
   logical                  :: aliw
 
@@ -321,9 +325,9 @@ subroutine  psb_zhalov(x,desc_a,info,alpha,work,tran,mode,data)
   nrow = psb_cd_get_local_rows(desc_a)
 
   if (present(tran)) then     
-    ltran = tran
+    tran_ = toupper(tran)
   else
-    ltran = 'N'
+    tran_ = 'N'
   endif
   if (present(mode)) then 
     imode = mode
@@ -387,12 +391,16 @@ subroutine  psb_zhalov(x,desc_a,info,alpha,work,tran,mode,data)
   end if
 
   ! exchange halo elements
-  if(ltran.eq.'N') then
+  if(tran_ == 'N') then
     call psi_swapdata(imode,zzero,x(iix:size(x)),&
          & desc_a,iwork,info,data=data_)
-  else if((ltran.eq.'T').or.(ltran.eq.'H')) then
+  else if((tran_ == 'T').or.(tran_ == 'C')) then
     call psi_swaptran(imode,zone,x(iix:size(x)),&
          & desc_a,iwork,info)
+  else
+    info = 4001
+    call psb_errpush(info,name,a_err='invalid tran')
+    goto 9999      
   end if
 
   if(info.ne.0) then
@@ -410,7 +418,7 @@ subroutine  psb_zhalov(x,desc_a,info,alpha,work,tran,mode,data)
 9999 continue
   call psb_erractionrestore(err_act)
 
-  if (err_act.eq.psb_act_abort_) then
+  if (err_act == psb_act_abort_) then
     call psb_error(ictxt)
     return
   end if

base/comm/psb_zovrl.f90

@@ -232,7 +232,7 @@ subroutine  psb_zovrlm(x,desc_a,info,jx,ik,work,update,mode)
 9999 continue
   call psb_erractionrestore(err_act)
 
-  if (err_act.eq.psb_act_abort_) then
+  if (err_act == psb_act_abort_) then
     call psb_error(ictxt)
     return
   end if
@@ -453,7 +453,7 @@ subroutine  psb_zovrlv(x,desc_a,info,work,update,mode)
 9999 continue
   call psb_erractionrestore(err_act)
 
-  if (err_act.eq.psb_act_abort_) then
+  if (err_act == psb_act_abort_) then
     call psb_error(ictxt)
     return
   end if