module laleq
implicit none
private
integer,parameter:: skind = kind(1.e0), dkind = kind(1.d0)

! sizeof is a less common extension, so provide sizes manually
integer,parameter:: i_size = 4
integer,parameter:: s_size = 4 
integer,parameter:: d_size = 8 
integer,parameter:: c_size = 2*s_size
integer,parameter:: z_size = 2*d_size

real(skind),target:: s_empty
real(dkind),target:: d_empty
complex(skind),target:: c_empty
complex(dkind),target:: z_empty



! this is safe version







interface GETRF
  module procedure sGETRF_95
  module procedure dGETRF_95
  module procedure cGETRF_95
  module procedure zGETRF_95
end interface


public GETRF



interface GETRS
  module procedure sGETRS_95
  module procedure dGETRS_95
  module procedure cGETRS_95
  module procedure zGETRS_95
end interface


public GETRS



interface GETRI
  module procedure sGETRI_95
  module procedure dGETRI_95
  module procedure cGETRI_95
  module procedure zGETRI_95
end interface


public GETRI




interface POTRF
  module procedure sPOTRF_95
  module procedure dPOTRF_95
  module procedure cPOTRF_95
  module procedure zPOTRF_95
end interface


public POTRF



interface POTRS
  module procedure sPOTRS_95
  module procedure dPOTRS_95
  module procedure cPOTRS_95
  module procedure zPOTRS_95
end interface


public POTRS



interface POTRI
  module procedure sPOTRI_95
  module procedure dPOTRI_95
  module procedure cPOTRI_95
  module procedure zPOTRI_95
end interface


public POTRI




interface TRTRS
  module procedure sTRTRS_95
  module procedure dTRTRS_95
  module procedure cTRTRS_95
  module procedure zTRTRS_95
end interface


public TRTRS



interface TRTRI
  module procedure sTRTRI_95
  module procedure dTRTRI_95
  module procedure cTRTRI_95
  module procedure zTRTRI_95
end interface


public TRTRI




contains




subroutine svecext(vec,ppvec,wwvec)
real(skind),target:: vec(:)
real(skind),pointer:: ppvec,wwvec(:)
if (size(vec) > 1) then
  if ((loc(vec(2)) - loc(vec(1))) /= s_size) then
    allocate(wwvec(size(vec)))
    ppvec => wwvec(1)
    return
  end if
end if
ppvec => vec(1)
end subroutine


subroutine dvecext(vec,ppvec,wwvec)
real(dkind),target:: vec(:)
real(dkind),pointer:: ppvec,wwvec(:)
if (size(vec) > 1) then
  if ((loc(vec(2)) - loc(vec(1))) /= d_size) then
    allocate(wwvec(size(vec)))
    ppvec => wwvec(1)
    return
  end if
end if
ppvec => vec(1)
end subroutine


subroutine cvecext(vec,ppvec,wwvec)
complex(skind),target:: vec(:)
complex(skind),pointer:: ppvec,wwvec(:)
if (size(vec) > 1) then
  if ((loc(vec(2)) - loc(vec(1))) /= c_size) then
    allocate(wwvec(size(vec)))
    ppvec => wwvec(1)
    return
  end if
end if
ppvec => vec(1)
end subroutine


subroutine zvecext(vec,ppvec,wwvec)
complex(dkind),target:: vec(:)
complex(dkind),pointer:: ppvec,wwvec(:)
if (size(vec) > 1) then
  if ((loc(vec(2)) - loc(vec(1))) /= z_size) then
    allocate(wwvec(size(vec)))
    ppvec => wwvec(1)
    return
  end if
end if
ppvec => vec(1)
end subroutine


subroutine ivecext(vec,ppvec,wwvec)
integer,target:: vec(:)
integer,pointer:: ppvec,wwvec(:)
if (size(vec) > 1) then
  if ((loc(vec(2)) - loc(vec(1))) /= i_size) then
    allocate(wwvec(size(vec)))
    ppvec => wwvec(1)
    return
  end if
end if
ppvec => vec(1)
end subroutine




subroutine smatext(mat,ppmat,ldmat,wwmat)
real(skind),target:: mat(:,:)
real(skind),pointer:: ppmat,wwmat(:,:)
integer,intent(out):: ldmat
if (size(mat,1) > 1) then
  if (loc(mat(2,1)) - loc(mat(1,1)) /= s_size) goto 1
end if
ldmat = 1
if (size(mat,2) > 1) ldmat = (loc(mat(1,2)) - loc(mat(1,1))) / s_size
if (ldmat < 0) goto 1
ppmat => mat(1,1)
return
1 continue
allocate(wwmat(size(mat,1),size(mat,2)))
ppmat => wwmat(1,1)
ldmat = size(mat,1)
end subroutine


subroutine dmatext(mat,ppmat,ldmat,wwmat)
real(dkind),target:: mat(:,:)
real(dkind),pointer:: ppmat,wwmat(:,:)
integer,intent(out):: ldmat
if (size(mat,1) > 1) then
  if (loc(mat(2,1)) - loc(mat(1,1)) /= d_size) goto 1
end if
ldmat = 1
if (size(mat,2) > 1) ldmat = (loc(mat(1,2)) - loc(mat(1,1))) / d_size
if (ldmat < 0) goto 1
ppmat => mat(1,1)
return
1 continue
allocate(wwmat(size(mat,1),size(mat,2)))
ppmat => wwmat(1,1)
ldmat = size(mat,1)
end subroutine


subroutine cmatext(mat,ppmat,ldmat,wwmat)
complex(skind),target:: mat(:,:)
complex(skind),pointer:: ppmat,wwmat(:,:)
integer,intent(out):: ldmat
if (size(mat,1) > 1) then
  if (loc(mat(2,1)) - loc(mat(1,1)) /= c_size) goto 1
end if
ldmat = 1
if (size(mat,2) > 1) ldmat = (loc(mat(1,2)) - loc(mat(1,1))) / c_size
if (ldmat < 0) goto 1
ppmat => mat(1,1)
return
1 continue
allocate(wwmat(size(mat,1),size(mat,2)))
ppmat => wwmat(1,1)
ldmat = size(mat,1)
end subroutine


subroutine zmatext(mat,ppmat,ldmat,wwmat)
complex(dkind),target:: mat(:,:)
complex(dkind),pointer:: ppmat,wwmat(:,:)
integer,intent(out):: ldmat
if (size(mat,1) > 1) then
  if (loc(mat(2,1)) - loc(mat(1,1)) /= z_size) goto 1
end if
ldmat = 1
if (size(mat,2) > 1) ldmat = (loc(mat(1,2)) - loc(mat(1,1))) / z_size
if (ldmat < 0) goto 1
ppmat => mat(1,1)
return
1 continue
allocate(wwmat(size(mat,1),size(mat,2)))
ppmat => wwmat(1,1)
ldmat = size(mat,1)
end subroutine





























subroutine sGETRF_95(a,ipiv,info)

real(skind),dimension(:,:),intent(inout),target:: a
real(skind),pointer:: ppa,wwa(:,:)
integer:: lda




integer,dimension(:),intent(out),target:: ipiv
integer,pointer:: ppipiv,wwipiv(:)




integer,intent(out),optional:: info
integer:: vinfo



integer:: m



integer:: n



n = size(a,2)
if (n == 0) return


m = size(a,1)
if (m == 0) return

! end init



call ivecext(ipiv,ppipiv,wwipiv)



call smatext(a,ppa,lda,wwa)
if (.not.associated(ppa,a(1,1))) wwa = a

! end copy


call sGETRF(m,n,ppa,lda,ppipiv,vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppipiv,ipiv(1))) then
  ipiv = wwipiv
  deallocate(ppipiv)
end if


if (.not.associated(ppa,a(1,1))) then
  a = wwa
  deallocate(ppa)
end if

! end cleanup




end subroutine



subroutine dGETRF_95(a,ipiv,info)

real(dkind),dimension(:,:),intent(inout),target:: a
real(dkind),pointer:: ppa,wwa(:,:)
integer:: lda




integer,dimension(:),intent(out),target:: ipiv
integer,pointer:: ppipiv,wwipiv(:)




integer,intent(out),optional:: info
integer:: vinfo



integer:: m



integer:: n



n = size(a,2)
if (n == 0) return


m = size(a,1)
if (m == 0) return

! end init



call ivecext(ipiv,ppipiv,wwipiv)



call dmatext(a,ppa,lda,wwa)
if (.not.associated(ppa,a(1,1))) wwa = a

! end copy


call dGETRF(m,n,ppa,lda,ppipiv,vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppipiv,ipiv(1))) then
  ipiv = wwipiv
  deallocate(ppipiv)
end if


if (.not.associated(ppa,a(1,1))) then
  a = wwa
  deallocate(ppa)
end if

! end cleanup




end subroutine



subroutine cGETRF_95(a,ipiv,info)

complex(skind),dimension(:,:),intent(inout),target:: a
complex(skind),pointer:: ppa,wwa(:,:)
integer:: lda




integer,dimension(:),intent(out),target:: ipiv
integer,pointer:: ppipiv,wwipiv(:)




integer,intent(out),optional:: info
integer:: vinfo



integer:: m



integer:: n



n = size(a,2)
if (n == 0) return


m = size(a,1)
if (m == 0) return

! end init



call ivecext(ipiv,ppipiv,wwipiv)



call cmatext(a,ppa,lda,wwa)
if (.not.associated(ppa,a(1,1))) wwa = a

! end copy


call cGETRF(m,n,ppa,lda,ppipiv,vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppipiv,ipiv(1))) then
  ipiv = wwipiv
  deallocate(ppipiv)
end if


if (.not.associated(ppa,a(1,1))) then
  a = wwa
  deallocate(ppa)
end if

! end cleanup




end subroutine



subroutine zGETRF_95(a,ipiv,info)

complex(dkind),dimension(:,:),intent(inout),target:: a
complex(dkind),pointer:: ppa,wwa(:,:)
integer:: lda




integer,dimension(:),intent(out),target:: ipiv
integer,pointer:: ppipiv,wwipiv(:)




integer,intent(out),optional:: info
integer:: vinfo



integer:: m



integer:: n



n = size(a,2)
if (n == 0) return


m = size(a,1)
if (m == 0) return

! end init



call ivecext(ipiv,ppipiv,wwipiv)



call zmatext(a,ppa,lda,wwa)
if (.not.associated(ppa,a(1,1))) wwa = a

! end copy


call zGETRF(m,n,ppa,lda,ppipiv,vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppipiv,ipiv(1))) then
  ipiv = wwipiv
  deallocate(ppipiv)
end if


if (.not.associated(ppa,a(1,1))) then
  a = wwa
  deallocate(ppa)
end if

! end cleanup




end subroutine





subroutine sPOTRF_95(a,uplo,info)

real(skind),dimension(:,:),intent(inout),target:: a
real(skind),pointer:: ppa,wwa(:,:)
integer:: lda



character,intent(in),optional:: uplo
character:: vuplo



integer,intent(out),optional:: info
integer:: vinfo



integer:: n



n = size(a,2)
if (n == 0) return


vuplo = "U"
if (present(uplo)) vuplo = uplo

! end init



call smatext(a,ppa,lda,wwa)
if (.not.associated(ppa,a(1,1))) wwa = a

! end copy

call sPOTRF(vuplo,n,ppa,lda,vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppa,a(1,1))) then
  a = wwa
  deallocate(ppa)
end if

! end cleanup



end subroutine



subroutine dPOTRF_95(a,uplo,info)

real(dkind),dimension(:,:),intent(inout),target:: a
real(dkind),pointer:: ppa,wwa(:,:)
integer:: lda



character,intent(in),optional:: uplo
character:: vuplo



integer,intent(out),optional:: info
integer:: vinfo



integer:: n



n = size(a,2)
if (n == 0) return


vuplo = "U"
if (present(uplo)) vuplo = uplo

! end init



call dmatext(a,ppa,lda,wwa)
if (.not.associated(ppa,a(1,1))) wwa = a

! end copy

call dPOTRF(vuplo,n,ppa,lda,vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppa,a(1,1))) then
  a = wwa
  deallocate(ppa)
end if

! end cleanup



end subroutine



subroutine cPOTRF_95(a,uplo,info)

complex(skind),dimension(:,:),intent(inout),target:: a
complex(skind),pointer:: ppa,wwa(:,:)
integer:: lda



character,intent(in),optional:: uplo
character:: vuplo



integer,intent(out),optional:: info
integer:: vinfo



integer:: n



n = size(a,2)
if (n == 0) return


vuplo = "U"
if (present(uplo)) vuplo = uplo

! end init



call cmatext(a,ppa,lda,wwa)
if (.not.associated(ppa,a(1,1))) wwa = a

! end copy

call cPOTRF(vuplo,n,ppa,lda,vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppa,a(1,1))) then
  a = wwa
  deallocate(ppa)
end if

! end cleanup



end subroutine



subroutine zPOTRF_95(a,uplo,info)

complex(dkind),dimension(:,:),intent(inout),target:: a
complex(dkind),pointer:: ppa,wwa(:,:)
integer:: lda



character,intent(in),optional:: uplo
character:: vuplo



integer,intent(out),optional:: info
integer:: vinfo



integer:: n



n = size(a,2)
if (n == 0) return


vuplo = "U"
if (present(uplo)) vuplo = uplo

! end init



call zmatext(a,ppa,lda,wwa)
if (.not.associated(ppa,a(1,1))) wwa = a

! end copy

call zPOTRF(vuplo,n,ppa,lda,vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppa,a(1,1))) then
  a = wwa
  deallocate(ppa)
end if

! end cleanup



end subroutine





subroutine sTRTRS_95(a,b,uplo,trans,diag,info)

real(skind),dimension(:,:),intent(in),target:: a
real(skind),pointer:: ppa,wwa(:,:)
integer:: lda




real(skind),dimension(:,:),intent(inout),target:: b
real(skind),pointer:: ppb,wwb(:,:)
integer:: ldb



character,intent(in),optional:: uplo
character:: vuplo


character,intent(in),optional:: diag
character:: vdiag


character,intent(in),optional:: trans
character:: vtrans



integer,intent(out),optional:: info
integer:: vinfo



integer:: n



integer:: nrhs



nrhs = size(b,2)
if (nrhs == 0) return


n = size(a,2)
if (n == 0) return


vtrans = "N"
if (present(trans)) vtrans = trans


vdiag = "N"
if (present(diag)) vdiag = diag


vuplo = "U"
if (present(uplo)) vuplo = uplo

! end init






call smatext(b,ppb,ldb,wwb)
if (.not.associated(ppb,b(1,1))) wwb = b


call smatext(a,ppa,lda,wwa)
if (.not.associated(ppa,a(1,1))) wwa = a

! end copy


call sTRTRS(vuplo,vtrans,vdiag,n,nrhs,ppa,lda,ppb,ldb,vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppb,b(1,1))) then
  b = wwb
  deallocate(ppb)
end if


if (.not.associated(ppa,a(1,1))) then
  
  deallocate(ppa)
end if

! end cleanup




end subroutine



subroutine dTRTRS_95(a,b,uplo,trans,diag,info)

real(dkind),dimension(:,:),intent(in),target:: a
real(dkind),pointer:: ppa,wwa(:,:)
integer:: lda




real(dkind),dimension(:,:),intent(inout),target:: b
real(dkind),pointer:: ppb,wwb(:,:)
integer:: ldb



character,intent(in),optional:: uplo
character:: vuplo


character,intent(in),optional:: diag
character:: vdiag


character,intent(in),optional:: trans
character:: vtrans



integer,intent(out),optional:: info
integer:: vinfo



integer:: n



integer:: nrhs



nrhs = size(b,2)
if (nrhs == 0) return


n = size(a,2)
if (n == 0) return


vtrans = "N"
if (present(trans)) vtrans = trans


vdiag = "N"
if (present(diag)) vdiag = diag


vuplo = "U"
if (present(uplo)) vuplo = uplo

! end init






call dmatext(b,ppb,ldb,wwb)
if (.not.associated(ppb,b(1,1))) wwb = b


call dmatext(a,ppa,lda,wwa)
if (.not.associated(ppa,a(1,1))) wwa = a

! end copy


call dTRTRS(vuplo,vtrans,vdiag,n,nrhs,ppa,lda,ppb,ldb,vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppb,b(1,1))) then
  b = wwb
  deallocate(ppb)
end if


if (.not.associated(ppa,a(1,1))) then
  
  deallocate(ppa)
end if

! end cleanup




end subroutine



subroutine cTRTRS_95(a,b,uplo,trans,diag,info)

complex(skind),dimension(:,:),intent(in),target:: a
complex(skind),pointer:: ppa,wwa(:,:)
integer:: lda




complex(skind),dimension(:,:),intent(inout),target:: b
complex(skind),pointer:: ppb,wwb(:,:)
integer:: ldb



character,intent(in),optional:: uplo
character:: vuplo


character,intent(in),optional:: diag
character:: vdiag


character,intent(in),optional:: trans
character:: vtrans



integer,intent(out),optional:: info
integer:: vinfo



integer:: n



integer:: nrhs



nrhs = size(b,2)
if (nrhs == 0) return


n = size(a,2)
if (n == 0) return


vtrans = "N"
if (present(trans)) vtrans = trans


vdiag = "N"
if (present(diag)) vdiag = diag


vuplo = "U"
if (present(uplo)) vuplo = uplo

! end init






call cmatext(b,ppb,ldb,wwb)
if (.not.associated(ppb,b(1,1))) wwb = b


call cmatext(a,ppa,lda,wwa)
if (.not.associated(ppa,a(1,1))) wwa = a

! end copy


call cTRTRS(vuplo,vtrans,vdiag,n,nrhs,ppa,lda,ppb,ldb,vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppb,b(1,1))) then
  b = wwb
  deallocate(ppb)
end if


if (.not.associated(ppa,a(1,1))) then
  
  deallocate(ppa)
end if

! end cleanup




end subroutine



subroutine zTRTRS_95(a,b,uplo,trans,diag,info)

complex(dkind),dimension(:,:),intent(in),target:: a
complex(dkind),pointer:: ppa,wwa(:,:)
integer:: lda




complex(dkind),dimension(:,:),intent(inout),target:: b
complex(dkind),pointer:: ppb,wwb(:,:)
integer:: ldb



character,intent(in),optional:: uplo
character:: vuplo


character,intent(in),optional:: diag
character:: vdiag


character,intent(in),optional:: trans
character:: vtrans



integer,intent(out),optional:: info
integer:: vinfo



integer:: n



integer:: nrhs



nrhs = size(b,2)
if (nrhs == 0) return


n = size(a,2)
if (n == 0) return


vtrans = "N"
if (present(trans)) vtrans = trans


vdiag = "N"
if (present(diag)) vdiag = diag


vuplo = "U"
if (present(uplo)) vuplo = uplo

! end init






call zmatext(b,ppb,ldb,wwb)
if (.not.associated(ppb,b(1,1))) wwb = b


call zmatext(a,ppa,lda,wwa)
if (.not.associated(ppa,a(1,1))) wwa = a

! end copy


call zTRTRS(vuplo,vtrans,vdiag,n,nrhs,ppa,lda,ppb,ldb,vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppb,b(1,1))) then
  b = wwb
  deallocate(ppb)
end if


if (.not.associated(ppa,a(1,1))) then
  
  deallocate(ppa)
end if

! end cleanup




end subroutine





subroutine sGETRS_95(a,ipiv,b,trans,info)

real(skind),dimension(:,:),intent(in),target:: a
real(skind),pointer:: ppa,wwa(:,:)
integer:: lda




integer,dimension(:),intent(in),target:: ipiv
integer,pointer:: ppipiv,wwipiv(:)




real(skind),dimension(:,:),intent(inout),target:: b
real(skind),pointer:: ppb,wwb(:,:)
integer:: ldb



character,intent(in),optional:: trans
character:: vtrans



integer,intent(out),optional:: info
integer:: vinfo



integer:: n



integer:: nrhs



nrhs = size(b,2)
if (nrhs == 0) return


n = size(a,2)
if (n == 0) return


vtrans = "N"
if (present(trans)) vtrans = trans

! end init




call smatext(b,ppb,ldb,wwb)
if (.not.associated(ppb,b(1,1))) wwb = b


call ivecext(ipiv,ppipiv,wwipiv)
if (.not.associated(ppipiv,ipiv(1))) wwipiv = ipiv


call smatext(a,ppa,lda,wwa)
if (.not.associated(ppa,a(1,1))) wwa = a

! end copy



call sGETRS(vtrans,n,nrhs,ppa,lda,ppipiv,ppb,ldb,vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppb,b(1,1))) then
  b = wwb
  deallocate(ppb)
end if


if (.not.associated(ppipiv,ipiv(1))) then
  
  deallocate(ppipiv)
end if


if (.not.associated(ppa,a(1,1))) then
  
  deallocate(ppa)
end if

! end cleanup





end subroutine



subroutine dGETRS_95(a,ipiv,b,trans,info)

real(dkind),dimension(:,:),intent(in),target:: a
real(dkind),pointer:: ppa,wwa(:,:)
integer:: lda




integer,dimension(:),intent(in),target:: ipiv
integer,pointer:: ppipiv,wwipiv(:)




real(dkind),dimension(:,:),intent(inout),target:: b
real(dkind),pointer:: ppb,wwb(:,:)
integer:: ldb



character,intent(in),optional:: trans
character:: vtrans



integer,intent(out),optional:: info
integer:: vinfo



integer:: n



integer:: nrhs



nrhs = size(b,2)
if (nrhs == 0) return


n = size(a,2)
if (n == 0) return


vtrans = "N"
if (present(trans)) vtrans = trans

! end init




call dmatext(b,ppb,ldb,wwb)
if (.not.associated(ppb,b(1,1))) wwb = b


call ivecext(ipiv,ppipiv,wwipiv)
if (.not.associated(ppipiv,ipiv(1))) wwipiv = ipiv


call dmatext(a,ppa,lda,wwa)
if (.not.associated(ppa,a(1,1))) wwa = a

! end copy



call dGETRS(vtrans,n,nrhs,ppa,lda,ppipiv,ppb,ldb,vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppb,b(1,1))) then
  b = wwb
  deallocate(ppb)
end if


if (.not.associated(ppipiv,ipiv(1))) then
  
  deallocate(ppipiv)
end if


if (.not.associated(ppa,a(1,1))) then
  
  deallocate(ppa)
end if

! end cleanup





end subroutine



subroutine cGETRS_95(a,ipiv,b,trans,info)

complex(skind),dimension(:,:),intent(in),target:: a
complex(skind),pointer:: ppa,wwa(:,:)
integer:: lda




integer,dimension(:),intent(in),target:: ipiv
integer,pointer:: ppipiv,wwipiv(:)




complex(skind),dimension(:,:),intent(inout),target:: b
complex(skind),pointer:: ppb,wwb(:,:)
integer:: ldb



character,intent(in),optional:: trans
character:: vtrans



integer,intent(out),optional:: info
integer:: vinfo



integer:: n



integer:: nrhs



nrhs = size(b,2)
if (nrhs == 0) return


n = size(a,2)
if (n == 0) return


vtrans = "N"
if (present(trans)) vtrans = trans

! end init




call cmatext(b,ppb,ldb,wwb)
if (.not.associated(ppb,b(1,1))) wwb = b


call ivecext(ipiv,ppipiv,wwipiv)
if (.not.associated(ppipiv,ipiv(1))) wwipiv = ipiv


call cmatext(a,ppa,lda,wwa)
if (.not.associated(ppa,a(1,1))) wwa = a

! end copy



call cGETRS(vtrans,n,nrhs,ppa,lda,ppipiv,ppb,ldb,vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppb,b(1,1))) then
  b = wwb
  deallocate(ppb)
end if


if (.not.associated(ppipiv,ipiv(1))) then
  
  deallocate(ppipiv)
end if


if (.not.associated(ppa,a(1,1))) then
  
  deallocate(ppa)
end if

! end cleanup





end subroutine



subroutine zGETRS_95(a,ipiv,b,trans,info)

complex(dkind),dimension(:,:),intent(in),target:: a
complex(dkind),pointer:: ppa,wwa(:,:)
integer:: lda




integer,dimension(:),intent(in),target:: ipiv
integer,pointer:: ppipiv,wwipiv(:)




complex(dkind),dimension(:,:),intent(inout),target:: b
complex(dkind),pointer:: ppb,wwb(:,:)
integer:: ldb



character,intent(in),optional:: trans
character:: vtrans



integer,intent(out),optional:: info
integer:: vinfo



integer:: n



integer:: nrhs



nrhs = size(b,2)
if (nrhs == 0) return


n = size(a,2)
if (n == 0) return


vtrans = "N"
if (present(trans)) vtrans = trans

! end init




call zmatext(b,ppb,ldb,wwb)
if (.not.associated(ppb,b(1,1))) wwb = b


call ivecext(ipiv,ppipiv,wwipiv)
if (.not.associated(ppipiv,ipiv(1))) wwipiv = ipiv


call zmatext(a,ppa,lda,wwa)
if (.not.associated(ppa,a(1,1))) wwa = a

! end copy



call zGETRS(vtrans,n,nrhs,ppa,lda,ppipiv,ppb,ldb,vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppb,b(1,1))) then
  b = wwb
  deallocate(ppb)
end if


if (.not.associated(ppipiv,ipiv(1))) then
  
  deallocate(ppipiv)
end if


if (.not.associated(ppa,a(1,1))) then
  
  deallocate(ppa)
end if

! end cleanup





end subroutine





subroutine sPOTRS_95(a,b,uplo,info)

real(skind),dimension(:,:),intent(in),target:: a
real(skind),pointer:: ppa,wwa(:,:)
integer:: lda




real(skind),dimension(:,:),intent(inout),target:: b
real(skind),pointer:: ppb,wwb(:,:)
integer:: ldb



character,intent(in),optional:: uplo
character:: vuplo



integer,intent(out),optional:: info
integer:: vinfo



integer:: n



integer:: nrhs



nrhs = size(b,2)
if (nrhs == 0) return


n = size(a,2)
if (n == 0) return


vuplo = "U"
if (present(uplo)) vuplo = uplo

! end init




call smatext(b,ppb,ldb,wwb)
if (.not.associated(ppb,b(1,1))) wwb = b


call smatext(a,ppa,lda,wwa)
if (.not.associated(ppa,a(1,1))) wwa = a

! end copy


call sPOTRS(vuplo,n,nrhs,ppa,lda,ppb,ldb,vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppb,b(1,1))) then
  b = wwb
  deallocate(ppb)
end if


if (.not.associated(ppa,a(1,1))) then
  
  deallocate(ppa)
end if

! end cleanup




end subroutine



subroutine dPOTRS_95(a,b,uplo,info)

real(dkind),dimension(:,:),intent(in),target:: a
real(dkind),pointer:: ppa,wwa(:,:)
integer:: lda




real(dkind),dimension(:,:),intent(inout),target:: b
real(dkind),pointer:: ppb,wwb(:,:)
integer:: ldb



character,intent(in),optional:: uplo
character:: vuplo



integer,intent(out),optional:: info
integer:: vinfo



integer:: n



integer:: nrhs



nrhs = size(b,2)
if (nrhs == 0) return


n = size(a,2)
if (n == 0) return


vuplo = "U"
if (present(uplo)) vuplo = uplo

! end init




call dmatext(b,ppb,ldb,wwb)
if (.not.associated(ppb,b(1,1))) wwb = b


call dmatext(a,ppa,lda,wwa)
if (.not.associated(ppa,a(1,1))) wwa = a

! end copy


call dPOTRS(vuplo,n,nrhs,ppa,lda,ppb,ldb,vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppb,b(1,1))) then
  b = wwb
  deallocate(ppb)
end if


if (.not.associated(ppa,a(1,1))) then
  
  deallocate(ppa)
end if

! end cleanup




end subroutine



subroutine cPOTRS_95(a,b,uplo,info)

complex(skind),dimension(:,:),intent(in),target:: a
complex(skind),pointer:: ppa,wwa(:,:)
integer:: lda




complex(skind),dimension(:,:),intent(inout),target:: b
complex(skind),pointer:: ppb,wwb(:,:)
integer:: ldb



character,intent(in),optional:: uplo
character:: vuplo



integer,intent(out),optional:: info
integer:: vinfo



integer:: n



integer:: nrhs



nrhs = size(b,2)
if (nrhs == 0) return


n = size(a,2)
if (n == 0) return


vuplo = "U"
if (present(uplo)) vuplo = uplo

! end init




call cmatext(b,ppb,ldb,wwb)
if (.not.associated(ppb,b(1,1))) wwb = b


call cmatext(a,ppa,lda,wwa)
if (.not.associated(ppa,a(1,1))) wwa = a

! end copy


call cPOTRS(vuplo,n,nrhs,ppa,lda,ppb,ldb,vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppb,b(1,1))) then
  b = wwb
  deallocate(ppb)
end if


if (.not.associated(ppa,a(1,1))) then
  
  deallocate(ppa)
end if

! end cleanup




end subroutine



subroutine zPOTRS_95(a,b,uplo,info)

complex(dkind),dimension(:,:),intent(in),target:: a
complex(dkind),pointer:: ppa,wwa(:,:)
integer:: lda




complex(dkind),dimension(:,:),intent(inout),target:: b
complex(dkind),pointer:: ppb,wwb(:,:)
integer:: ldb



character,intent(in),optional:: uplo
character:: vuplo



integer,intent(out),optional:: info
integer:: vinfo



integer:: n



integer:: nrhs



nrhs = size(b,2)
if (nrhs == 0) return


n = size(a,2)
if (n == 0) return


vuplo = "U"
if (present(uplo)) vuplo = uplo

! end init




call zmatext(b,ppb,ldb,wwb)
if (.not.associated(ppb,b(1,1))) wwb = b


call zmatext(a,ppa,lda,wwa)
if (.not.associated(ppa,a(1,1))) wwa = a

! end copy


call zPOTRS(vuplo,n,nrhs,ppa,lda,ppb,ldb,vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppb,b(1,1))) then
  b = wwb
  deallocate(ppb)
end if


if (.not.associated(ppa,a(1,1))) then
  
  deallocate(ppa)
end if

! end cleanup




end subroutine





subroutine sTRTRI_95(a,uplo,diag,info)

real(skind),dimension(:,:),intent(inout),target:: a
real(skind),pointer:: ppa,wwa(:,:)
integer:: lda



character,intent(in),optional:: uplo
character:: vuplo


character,intent(in),optional:: diag
character:: vdiag



integer,intent(out),optional:: info
integer:: vinfo



integer:: n



n = size(a,2)
if (n == 0) return


vdiag = "N"
if (present(diag)) vdiag = diag


vuplo = "U"
if (present(uplo)) vuplo = uplo

! end init




call smatext(a,ppa,lda,wwa)
if (.not.associated(ppa,a(1,1))) wwa = a

! end copy

call sTRTRI(vuplo,vdiag,n,ppa,lda,vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppa,a(1,1))) then
  a = wwa
  deallocate(ppa)
end if

! end cleanup



end subroutine



subroutine dTRTRI_95(a,uplo,diag,info)

real(dkind),dimension(:,:),intent(inout),target:: a
real(dkind),pointer:: ppa,wwa(:,:)
integer:: lda



character,intent(in),optional:: uplo
character:: vuplo


character,intent(in),optional:: diag
character:: vdiag



integer,intent(out),optional:: info
integer:: vinfo



integer:: n



n = size(a,2)
if (n == 0) return


vdiag = "N"
if (present(diag)) vdiag = diag


vuplo = "U"
if (present(uplo)) vuplo = uplo

! end init




call dmatext(a,ppa,lda,wwa)
if (.not.associated(ppa,a(1,1))) wwa = a

! end copy

call dTRTRI(vuplo,vdiag,n,ppa,lda,vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppa,a(1,1))) then
  a = wwa
  deallocate(ppa)
end if

! end cleanup



end subroutine



subroutine cTRTRI_95(a,uplo,diag,info)

complex(skind),dimension(:,:),intent(inout),target:: a
complex(skind),pointer:: ppa,wwa(:,:)
integer:: lda



character,intent(in),optional:: uplo
character:: vuplo


character,intent(in),optional:: diag
character:: vdiag



integer,intent(out),optional:: info
integer:: vinfo



integer:: n



n = size(a,2)
if (n == 0) return


vdiag = "N"
if (present(diag)) vdiag = diag


vuplo = "U"
if (present(uplo)) vuplo = uplo

! end init




call cmatext(a,ppa,lda,wwa)
if (.not.associated(ppa,a(1,1))) wwa = a

! end copy

call cTRTRI(vuplo,vdiag,n,ppa,lda,vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppa,a(1,1))) then
  a = wwa
  deallocate(ppa)
end if

! end cleanup



end subroutine



subroutine zTRTRI_95(a,uplo,diag,info)

complex(dkind),dimension(:,:),intent(inout),target:: a
complex(dkind),pointer:: ppa,wwa(:,:)
integer:: lda



character,intent(in),optional:: uplo
character:: vuplo


character,intent(in),optional:: diag
character:: vdiag



integer,intent(out),optional:: info
integer:: vinfo



integer:: n



n = size(a,2)
if (n == 0) return


vdiag = "N"
if (present(diag)) vdiag = diag


vuplo = "U"
if (present(uplo)) vuplo = uplo

! end init




call zmatext(a,ppa,lda,wwa)
if (.not.associated(ppa,a(1,1))) wwa = a

! end copy

call zTRTRI(vuplo,vdiag,n,ppa,lda,vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppa,a(1,1))) then
  a = wwa
  deallocate(ppa)
end if

! end cleanup



end subroutine





subroutine sGETRI_95(a,ipiv,info)

real(skind),dimension(:,:),intent(inout),target:: a
real(skind),pointer:: ppa,wwa(:,:)
integer:: lda




integer,dimension(:),intent(in),target:: ipiv
integer,pointer:: ppipiv,wwipiv(:)




integer,intent(out),optional:: info
integer:: vinfo



real(skind),dimension(:),allocatable:: work
real(skind):: lwork


integer:: n



n = size(a,2)
if (n == 0) return

! end init


call ivecext(ipiv,ppipiv,wwipiv)
if (.not.associated(ppipiv,ipiv(1))) wwipiv = ipiv


call smatext(a,ppa,lda,wwa)
if (.not.associated(ppa,a(1,1))) wwa = a

! end copy


call sGETRI(n,ppa,lda,ppipiv,lwork,-1,vinfo)
allocate(work(int(lwork)))
call sGETRI(n,ppa,lda,ppipiv,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppipiv,ipiv(1))) then
  
  deallocate(ppipiv)
end if


if (.not.associated(ppa,a(1,1))) then
  a = wwa
  deallocate(ppa)
end if

! end cleanup




end subroutine



subroutine dGETRI_95(a,ipiv,info)

real(dkind),dimension(:,:),intent(inout),target:: a
real(dkind),pointer:: ppa,wwa(:,:)
integer:: lda




integer,dimension(:),intent(in),target:: ipiv
integer,pointer:: ppipiv,wwipiv(:)




integer,intent(out),optional:: info
integer:: vinfo



real(dkind),dimension(:),allocatable:: work
real(dkind):: lwork


integer:: n



n = size(a,2)
if (n == 0) return

! end init


call ivecext(ipiv,ppipiv,wwipiv)
if (.not.associated(ppipiv,ipiv(1))) wwipiv = ipiv


call dmatext(a,ppa,lda,wwa)
if (.not.associated(ppa,a(1,1))) wwa = a

! end copy


call dGETRI(n,ppa,lda,ppipiv,lwork,-1,vinfo)
allocate(work(int(lwork)))
call dGETRI(n,ppa,lda,ppipiv,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppipiv,ipiv(1))) then
  
  deallocate(ppipiv)
end if


if (.not.associated(ppa,a(1,1))) then
  a = wwa
  deallocate(ppa)
end if

! end cleanup




end subroutine



subroutine cGETRI_95(a,ipiv,info)

complex(skind),dimension(:,:),intent(inout),target:: a
complex(skind),pointer:: ppa,wwa(:,:)
integer:: lda




integer,dimension(:),intent(in),target:: ipiv
integer,pointer:: ppipiv,wwipiv(:)




integer,intent(out),optional:: info
integer:: vinfo



complex(skind),dimension(:),allocatable:: work
complex(skind):: lwork


integer:: n



n = size(a,2)
if (n == 0) return

! end init


call ivecext(ipiv,ppipiv,wwipiv)
if (.not.associated(ppipiv,ipiv(1))) wwipiv = ipiv


call cmatext(a,ppa,lda,wwa)
if (.not.associated(ppa,a(1,1))) wwa = a

! end copy


call cGETRI(n,ppa,lda,ppipiv,lwork,-1,vinfo)
allocate(work(int(lwork)))
call cGETRI(n,ppa,lda,ppipiv,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppipiv,ipiv(1))) then
  
  deallocate(ppipiv)
end if


if (.not.associated(ppa,a(1,1))) then
  a = wwa
  deallocate(ppa)
end if

! end cleanup




end subroutine



subroutine zGETRI_95(a,ipiv,info)

complex(dkind),dimension(:,:),intent(inout),target:: a
complex(dkind),pointer:: ppa,wwa(:,:)
integer:: lda




integer,dimension(:),intent(in),target:: ipiv
integer,pointer:: ppipiv,wwipiv(:)




integer,intent(out),optional:: info
integer:: vinfo



complex(dkind),dimension(:),allocatable:: work
complex(dkind):: lwork


integer:: n



n = size(a,2)
if (n == 0) return

! end init


call ivecext(ipiv,ppipiv,wwipiv)
if (.not.associated(ppipiv,ipiv(1))) wwipiv = ipiv


call zmatext(a,ppa,lda,wwa)
if (.not.associated(ppa,a(1,1))) wwa = a

! end copy


call zGETRI(n,ppa,lda,ppipiv,lwork,-1,vinfo)
allocate(work(int(lwork)))
call zGETRI(n,ppa,lda,ppipiv,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppipiv,ipiv(1))) then
  
  deallocate(ppipiv)
end if


if (.not.associated(ppa,a(1,1))) then
  a = wwa
  deallocate(ppa)
end if

! end cleanup




end subroutine





subroutine sPOTRI_95(a,uplo,info)

real(skind),dimension(:,:),intent(inout),target:: a
real(skind),pointer:: ppa,wwa(:,:)
integer:: lda



character,intent(in),optional:: uplo
character:: vuplo



integer,intent(out),optional:: info
integer:: vinfo



integer:: n



n = size(a,2)
if (n == 0) return


vuplo = "U"
if (present(uplo)) vuplo = uplo

! end init



call smatext(a,ppa,lda,wwa)
if (.not.associated(ppa,a(1,1))) wwa = a

! end copy

call sPOTRI(vuplo,n,ppa,lda,vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppa,a(1,1))) then
  a = wwa
  deallocate(ppa)
end if

! end cleanup



end subroutine



subroutine dPOTRI_95(a,uplo,info)

real(dkind),dimension(:,:),intent(inout),target:: a
real(dkind),pointer:: ppa,wwa(:,:)
integer:: lda



character,intent(in),optional:: uplo
character:: vuplo



integer,intent(out),optional:: info
integer:: vinfo



integer:: n



n = size(a,2)
if (n == 0) return


vuplo = "U"
if (present(uplo)) vuplo = uplo

! end init



call dmatext(a,ppa,lda,wwa)
if (.not.associated(ppa,a(1,1))) wwa = a

! end copy

call dPOTRI(vuplo,n,ppa,lda,vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppa,a(1,1))) then
  a = wwa
  deallocate(ppa)
end if

! end cleanup



end subroutine



subroutine cPOTRI_95(a,uplo,info)

complex(skind),dimension(:,:),intent(inout),target:: a
complex(skind),pointer:: ppa,wwa(:,:)
integer:: lda



character,intent(in),optional:: uplo
character:: vuplo



integer,intent(out),optional:: info
integer:: vinfo



integer:: n



n = size(a,2)
if (n == 0) return


vuplo = "U"
if (present(uplo)) vuplo = uplo

! end init



call cmatext(a,ppa,lda,wwa)
if (.not.associated(ppa,a(1,1))) wwa = a

! end copy

call cPOTRI(vuplo,n,ppa,lda,vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppa,a(1,1))) then
  a = wwa
  deallocate(ppa)
end if

! end cleanup



end subroutine



subroutine zPOTRI_95(a,uplo,info)

complex(dkind),dimension(:,:),intent(inout),target:: a
complex(dkind),pointer:: ppa,wwa(:,:)
integer:: lda



character,intent(in),optional:: uplo
character:: vuplo



integer,intent(out),optional:: info
integer:: vinfo



integer:: n



n = size(a,2)
if (n == 0) return


vuplo = "U"
if (present(uplo)) vuplo = uplo

! end init



call zmatext(a,ppa,lda,wwa)
if (.not.associated(ppa,a(1,1))) wwa = a

! end copy

call zPOTRI(vuplo,n,ppa,lda,vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppa,a(1,1))) then
  a = wwa
  deallocate(ppa)
end if

! end cleanup



end subroutine


!TODO: GERFS
!TODO: PORFS

! TODO: SY matrix factorizations

end module