module lalsq
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 GEQRF
  module procedure sGEQRF_95
  module procedure dGEQRF_95
  module procedure cGEQRF_95
  module procedure zGEQRF_95
end interface


public GEQRF



interface ORMQR
  module procedure sORMQR_95
  module procedure dORMQR_95
end interface


public ORMQR



interface UNMQR
  module procedure cUNMQR_95
  module procedure zUNMQR_95
end interface


public UNMQR



interface ORGQR
  module procedure sORGQR_95
  module procedure dORGQR_95
end interface


public ORGQR



interface UNGQR
  module procedure cUNGQR_95
  module procedure zUNGQR_95
end interface


public UNGQR




interface GELQF
  module procedure sGELQF_95
  module procedure dGELQF_95
  module procedure cGELQF_95
  module procedure zGELQF_95
end interface


public GELQF



interface ORMLQ
  module procedure sORMLQ_95
  module procedure dORMLQ_95
end interface


public ORMLQ



interface UNMLQ
  module procedure cUNMLQ_95
  module procedure zUNMLQ_95
end interface


public UNMLQ



interface ORGLQ
  module procedure sORGLQ_95
  module procedure dORGLQ_95
end interface


public ORGLQ



interface UNGLQ
  module procedure cUNGLQ_95
  module procedure zUNGLQ_95
end interface


public UNGLQ




interface GEQP3
  module procedure sGEQP3_95
  module procedure dGEQP3_95
  module procedure cGEQP3_95
  module procedure zGEQP3_95
end interface


public GEQP3




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


























! orthogonal factorizations

! QR factorization



subroutine sGEQRF_95(a,tau,info)

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




real(skind),dimension(:),intent(out),target:: tau
real(skind),pointer:: pptau,wwtau(:)




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



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


integer:: m



integer:: n



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


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

! end init



call svecext(tau,pptau,wwtau)



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

! end copy


call sGEQRF(m,n,ppa,lda,pptau,lwork,-1,vinfo)
allocate(work(int(lwork)))
call sGEQRF(m,n,ppa,lda,pptau,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(pptau,tau(1))) then
  tau = wwtau
  deallocate(pptau)
end if


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

! end cleanup




end subroutine



subroutine dGEQRF_95(a,tau,info)

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




real(dkind),dimension(:),intent(out),target:: tau
real(dkind),pointer:: pptau,wwtau(:)




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



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


integer:: m



integer:: n



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


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

! end init



call dvecext(tau,pptau,wwtau)



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

! end copy


call dGEQRF(m,n,ppa,lda,pptau,lwork,-1,vinfo)
allocate(work(int(lwork)))
call dGEQRF(m,n,ppa,lda,pptau,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(pptau,tau(1))) then
  tau = wwtau
  deallocate(pptau)
end if


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

! end cleanup




end subroutine



subroutine cGEQRF_95(a,tau,info)

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




complex(skind),dimension(:),intent(out),target:: tau
complex(skind),pointer:: pptau,wwtau(:)




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



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


integer:: m



integer:: n



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


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

! end init



call cvecext(tau,pptau,wwtau)



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

! end copy


call cGEQRF(m,n,ppa,lda,pptau,lwork,-1,vinfo)
allocate(work(int(lwork)))
call cGEQRF(m,n,ppa,lda,pptau,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(pptau,tau(1))) then
  tau = wwtau
  deallocate(pptau)
end if


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

! end cleanup




end subroutine



subroutine zGEQRF_95(a,tau,info)

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




complex(dkind),dimension(:),intent(out),target:: tau
complex(dkind),pointer:: pptau,wwtau(:)




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



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


integer:: m



integer:: n



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


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

! end init



call zvecext(tau,pptau,wwtau)



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

! end copy


call zGEQRF(m,n,ppa,lda,pptau,lwork,-1,vinfo)
allocate(work(int(lwork)))
call zGEQRF(m,n,ppa,lda,pptau,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(pptau,tau(1))) then
  tau = wwtau
  deallocate(pptau)
end if


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

! end cleanup




end subroutine





subroutine sORMQR_95(a,tau,c,side,trans,info)

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




real(skind),dimension(:),intent(in),target:: tau
real(skind),pointer:: pptau,wwtau(:)




real(skind),dimension(:,:),intent(inout),target:: c
real(skind),pointer:: ppc,wwc(:,:)
integer:: ldc



character,intent(in),optional:: side
character:: vside


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



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



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


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


vside = "L"
if (present(side)) vside = side

! end init



call smatext(c,ppc,ldc,wwc)
if (.not.associated(ppc,c(1,1))) wwc = c


call svecext(tau,pptau,wwtau)
if (.not.associated(pptau,tau(1))) wwtau = tau


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

! end copy



call sORMQR(vside,vtrans,size(c,1),size(c,2),size(tau),&
ppa,lda,pptau,ppc,ldc,lwork,-1,vinfo)
allocate(work(int(lwork)))
call sORMQR(vside,vtrans,size(c,1),size(c,2),size(tau),&
ppa,lda,pptau,ppc,ldc,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppc,c(1,1))) then
  c = wwc
  deallocate(ppc)
end if


if (.not.associated(pptau,tau(1))) then
  
  deallocate(pptau)
end if


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

! end cleanup





end subroutine



subroutine dORMQR_95(a,tau,c,side,trans,info)

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




real(dkind),dimension(:),intent(in),target:: tau
real(dkind),pointer:: pptau,wwtau(:)




real(dkind),dimension(:,:),intent(inout),target:: c
real(dkind),pointer:: ppc,wwc(:,:)
integer:: ldc



character,intent(in),optional:: side
character:: vside


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



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



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


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


vside = "L"
if (present(side)) vside = side

! end init



call dmatext(c,ppc,ldc,wwc)
if (.not.associated(ppc,c(1,1))) wwc = c


call dvecext(tau,pptau,wwtau)
if (.not.associated(pptau,tau(1))) wwtau = tau


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

! end copy



call dORMQR(vside,vtrans,size(c,1),size(c,2),size(tau),&
ppa,lda,pptau,ppc,ldc,lwork,-1,vinfo)
allocate(work(int(lwork)))
call dORMQR(vside,vtrans,size(c,1),size(c,2),size(tau),&
ppa,lda,pptau,ppc,ldc,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppc,c(1,1))) then
  c = wwc
  deallocate(ppc)
end if


if (.not.associated(pptau,tau(1))) then
  
  deallocate(pptau)
end if


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

! end cleanup





end subroutine





subroutine cUNMQR_95(a,tau,c,side,trans,info)

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




complex(skind),dimension(:),intent(in),target:: tau
complex(skind),pointer:: pptau,wwtau(:)




complex(skind),dimension(:,:),intent(inout),target:: c
complex(skind),pointer:: ppc,wwc(:,:)
integer:: ldc



character,intent(in),optional:: side
character:: vside


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



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



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


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


vside = "L"
if (present(side)) vside = side

! end init



call cmatext(c,ppc,ldc,wwc)
if (.not.associated(ppc,c(1,1))) wwc = c


call cvecext(tau,pptau,wwtau)
if (.not.associated(pptau,tau(1))) wwtau = tau


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

! end copy



call cUNMQR(vside,vtrans,size(c,1),size(c,2),size(tau),&
ppa,lda,pptau,ppc,ldc,lwork,-1,vinfo)
allocate(work(int(lwork)))
call cUNMQR(vside,vtrans,size(c,1),size(c,2),size(tau),&
ppa,lda,pptau,ppc,ldc,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppc,c(1,1))) then
  c = wwc
  deallocate(ppc)
end if


if (.not.associated(pptau,tau(1))) then
  
  deallocate(pptau)
end if


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

! end cleanup





end subroutine



subroutine zUNMQR_95(a,tau,c,side,trans,info)

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




complex(dkind),dimension(:),intent(in),target:: tau
complex(dkind),pointer:: pptau,wwtau(:)




complex(dkind),dimension(:,:),intent(inout),target:: c
complex(dkind),pointer:: ppc,wwc(:,:)
integer:: ldc



character,intent(in),optional:: side
character:: vside


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



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



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


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


vside = "L"
if (present(side)) vside = side

! end init



call zmatext(c,ppc,ldc,wwc)
if (.not.associated(ppc,c(1,1))) wwc = c


call zvecext(tau,pptau,wwtau)
if (.not.associated(pptau,tau(1))) wwtau = tau


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

! end copy



call zUNMQR(vside,vtrans,size(c,1),size(c,2),size(tau),&
ppa,lda,pptau,ppc,ldc,lwork,-1,vinfo)
allocate(work(int(lwork)))
call zUNMQR(vside,vtrans,size(c,1),size(c,2),size(tau),&
ppa,lda,pptau,ppc,ldc,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppc,c(1,1))) then
  c = wwc
  deallocate(ppc)
end if


if (.not.associated(pptau,tau(1))) then
  
  deallocate(pptau)
end if


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

! end cleanup





end subroutine





subroutine sORGQR_95(a,tau,info)

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




real(skind),dimension(:),intent(in),target:: tau
real(skind),pointer:: pptau,wwtau(:)




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



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

! end init

call svecext(tau,pptau,wwtau)
if (.not.associated(pptau,tau(1))) wwtau = tau


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

! end copy


call sORGQR(size(a,1),size(a,2),size(tau),&
ppa,lda,pptau,lwork,-1,vinfo)
allocate(work(int(lwork)))
call sORGQR(size(a,1),size(a,2),size(tau),&
ppa,lda,pptau,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(pptau,tau(1))) then
  
  deallocate(pptau)
end if


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

! end cleanup




end subroutine



subroutine dORGQR_95(a,tau,info)

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




real(dkind),dimension(:),intent(in),target:: tau
real(dkind),pointer:: pptau,wwtau(:)




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



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

! end init

call dvecext(tau,pptau,wwtau)
if (.not.associated(pptau,tau(1))) wwtau = tau


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

! end copy


call dORGQR(size(a,1),size(a,2),size(tau),&
ppa,lda,pptau,lwork,-1,vinfo)
allocate(work(int(lwork)))
call dORGQR(size(a,1),size(a,2),size(tau),&
ppa,lda,pptau,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(pptau,tau(1))) then
  
  deallocate(pptau)
end if


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

! end cleanup




end subroutine





subroutine cUNGQR_95(a,tau,info)

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




complex(skind),dimension(:),intent(in),target:: tau
complex(skind),pointer:: pptau,wwtau(:)




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



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

! end init

call cvecext(tau,pptau,wwtau)
if (.not.associated(pptau,tau(1))) wwtau = tau


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

! end copy


call cUNGQR(size(a,1),size(a,2),size(tau),&
ppa,lda,pptau,lwork,-1,vinfo)
allocate(work(int(lwork)))
call cUNGQR(size(a,1),size(a,2),size(tau),&
ppa,lda,pptau,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(pptau,tau(1))) then
  
  deallocate(pptau)
end if


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

! end cleanup




end subroutine



subroutine zUNGQR_95(a,tau,info)

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




complex(dkind),dimension(:),intent(in),target:: tau
complex(dkind),pointer:: pptau,wwtau(:)




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



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

! end init

call zvecext(tau,pptau,wwtau)
if (.not.associated(pptau,tau(1))) wwtau = tau


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

! end copy


call zUNGQR(size(a,1),size(a,2),size(tau),&
ppa,lda,pptau,lwork,-1,vinfo)
allocate(work(int(lwork)))
call zUNGQR(size(a,1),size(a,2),size(tau),&
ppa,lda,pptau,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(pptau,tau(1))) then
  
  deallocate(pptau)
end if


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

! end cleanup




end subroutine


! RQ factorization



subroutine sGERQF_95(a,tau,info)

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




real(skind),dimension(:),intent(out),target:: tau
real(skind),pointer:: pptau,wwtau(:)




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



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


integer:: m



integer:: n



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


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

! end init



call svecext(tau,pptau,wwtau)



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

! end copy


call sGERQF(m,n,ppa,lda,pptau,lwork,-1,vinfo)
allocate(work(int(lwork)))
call sGERQF(m,n,ppa,lda,pptau,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(pptau,tau(1))) then
  tau = wwtau
  deallocate(pptau)
end if


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

! end cleanup




end subroutine



subroutine dGERQF_95(a,tau,info)

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




real(dkind),dimension(:),intent(out),target:: tau
real(dkind),pointer:: pptau,wwtau(:)




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



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


integer:: m



integer:: n



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


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

! end init



call dvecext(tau,pptau,wwtau)



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

! end copy


call dGERQF(m,n,ppa,lda,pptau,lwork,-1,vinfo)
allocate(work(int(lwork)))
call dGERQF(m,n,ppa,lda,pptau,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(pptau,tau(1))) then
  tau = wwtau
  deallocate(pptau)
end if


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

! end cleanup




end subroutine



subroutine cGERQF_95(a,tau,info)

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




complex(skind),dimension(:),intent(out),target:: tau
complex(skind),pointer:: pptau,wwtau(:)




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



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


integer:: m



integer:: n



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


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

! end init



call cvecext(tau,pptau,wwtau)



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

! end copy


call cGERQF(m,n,ppa,lda,pptau,lwork,-1,vinfo)
allocate(work(int(lwork)))
call cGERQF(m,n,ppa,lda,pptau,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(pptau,tau(1))) then
  tau = wwtau
  deallocate(pptau)
end if


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

! end cleanup




end subroutine



subroutine zGERQF_95(a,tau,info)

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




complex(dkind),dimension(:),intent(out),target:: tau
complex(dkind),pointer:: pptau,wwtau(:)




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



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


integer:: m



integer:: n



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


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

! end init



call zvecext(tau,pptau,wwtau)



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

! end copy


call zGERQF(m,n,ppa,lda,pptau,lwork,-1,vinfo)
allocate(work(int(lwork)))
call zGERQF(m,n,ppa,lda,pptau,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(pptau,tau(1))) then
  tau = wwtau
  deallocate(pptau)
end if


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

! end cleanup




end subroutine





subroutine sORMRQ_95(a,tau,c,side,trans,info)

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




real(skind),dimension(:),intent(in),target:: tau
real(skind),pointer:: pptau,wwtau(:)




real(skind),dimension(:,:),intent(inout),target:: c
real(skind),pointer:: ppc,wwc(:,:)
integer:: ldc



character,intent(in),optional:: side
character:: vside


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



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



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


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


vside = "L"
if (present(side)) vside = side

! end init



call smatext(c,ppc,ldc,wwc)
if (.not.associated(ppc,c(1,1))) wwc = c


call svecext(tau,pptau,wwtau)
if (.not.associated(pptau,tau(1))) wwtau = tau


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

! end copy



call sORMRQ(vside,vtrans,size(c,1),size(c,2),size(tau),&
ppa,lda,pptau,ppc,ldc,lwork,-1,vinfo)
allocate(work(int(lwork)))
call sORMRQ(vside,vtrans,size(c,1),size(c,2),size(tau),&
ppa,lda,pptau,ppc,ldc,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppc,c(1,1))) then
  c = wwc
  deallocate(ppc)
end if


if (.not.associated(pptau,tau(1))) then
  
  deallocate(pptau)
end if


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

! end cleanup





end subroutine



subroutine dORMRQ_95(a,tau,c,side,trans,info)

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




real(dkind),dimension(:),intent(in),target:: tau
real(dkind),pointer:: pptau,wwtau(:)




real(dkind),dimension(:,:),intent(inout),target:: c
real(dkind),pointer:: ppc,wwc(:,:)
integer:: ldc



character,intent(in),optional:: side
character:: vside


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



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



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


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


vside = "L"
if (present(side)) vside = side

! end init



call dmatext(c,ppc,ldc,wwc)
if (.not.associated(ppc,c(1,1))) wwc = c


call dvecext(tau,pptau,wwtau)
if (.not.associated(pptau,tau(1))) wwtau = tau


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

! end copy



call dORMRQ(vside,vtrans,size(c,1),size(c,2),size(tau),&
ppa,lda,pptau,ppc,ldc,lwork,-1,vinfo)
allocate(work(int(lwork)))
call dORMRQ(vside,vtrans,size(c,1),size(c,2),size(tau),&
ppa,lda,pptau,ppc,ldc,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppc,c(1,1))) then
  c = wwc
  deallocate(ppc)
end if


if (.not.associated(pptau,tau(1))) then
  
  deallocate(pptau)
end if


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

! end cleanup





end subroutine





subroutine cUNMRQ_95(a,tau,c,side,trans,info)

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




complex(skind),dimension(:),intent(in),target:: tau
complex(skind),pointer:: pptau,wwtau(:)




complex(skind),dimension(:,:),intent(inout),target:: c
complex(skind),pointer:: ppc,wwc(:,:)
integer:: ldc



character,intent(in),optional:: side
character:: vside


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



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



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


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


vside = "L"
if (present(side)) vside = side

! end init



call cmatext(c,ppc,ldc,wwc)
if (.not.associated(ppc,c(1,1))) wwc = c


call cvecext(tau,pptau,wwtau)
if (.not.associated(pptau,tau(1))) wwtau = tau


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

! end copy



call cUNMRQ(vside,vtrans,size(c,1),size(c,2),size(tau),&
ppa,lda,pptau,ppc,ldc,lwork,-1,vinfo)
allocate(work(int(lwork)))
call cUNMRQ(vside,vtrans,size(c,1),size(c,2),size(tau),&
ppa,lda,pptau,ppc,ldc,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppc,c(1,1))) then
  c = wwc
  deallocate(ppc)
end if


if (.not.associated(pptau,tau(1))) then
  
  deallocate(pptau)
end if


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

! end cleanup





end subroutine



subroutine zUNMRQ_95(a,tau,c,side,trans,info)

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




complex(dkind),dimension(:),intent(in),target:: tau
complex(dkind),pointer:: pptau,wwtau(:)




complex(dkind),dimension(:,:),intent(inout),target:: c
complex(dkind),pointer:: ppc,wwc(:,:)
integer:: ldc



character,intent(in),optional:: side
character:: vside


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



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



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


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


vside = "L"
if (present(side)) vside = side

! end init



call zmatext(c,ppc,ldc,wwc)
if (.not.associated(ppc,c(1,1))) wwc = c


call zvecext(tau,pptau,wwtau)
if (.not.associated(pptau,tau(1))) wwtau = tau


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

! end copy



call zUNMRQ(vside,vtrans,size(c,1),size(c,2),size(tau),&
ppa,lda,pptau,ppc,ldc,lwork,-1,vinfo)
allocate(work(int(lwork)))
call zUNMRQ(vside,vtrans,size(c,1),size(c,2),size(tau),&
ppa,lda,pptau,ppc,ldc,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppc,c(1,1))) then
  c = wwc
  deallocate(ppc)
end if


if (.not.associated(pptau,tau(1))) then
  
  deallocate(pptau)
end if


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

! end cleanup





end subroutine





subroutine sORGRQ_95(a,tau,info)

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




real(skind),dimension(:),intent(in),target:: tau
real(skind),pointer:: pptau,wwtau(:)




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



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

! end init

call svecext(tau,pptau,wwtau)
if (.not.associated(pptau,tau(1))) wwtau = tau


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

! end copy


call sORGRQ(size(a,1),size(a,2),size(tau),&
ppa,lda,pptau,lwork,-1,vinfo)
allocate(work(int(lwork)))
call sORGRQ(size(a,1),size(a,2),size(tau),&
ppa,lda,pptau,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(pptau,tau(1))) then
  
  deallocate(pptau)
end if


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

! end cleanup




end subroutine



subroutine dORGRQ_95(a,tau,info)

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




real(dkind),dimension(:),intent(in),target:: tau
real(dkind),pointer:: pptau,wwtau(:)




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



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

! end init

call dvecext(tau,pptau,wwtau)
if (.not.associated(pptau,tau(1))) wwtau = tau


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

! end copy


call dORGRQ(size(a,1),size(a,2),size(tau),&
ppa,lda,pptau,lwork,-1,vinfo)
allocate(work(int(lwork)))
call dORGRQ(size(a,1),size(a,2),size(tau),&
ppa,lda,pptau,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(pptau,tau(1))) then
  
  deallocate(pptau)
end if


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

! end cleanup




end subroutine





subroutine cUNGRQ_95(a,tau,info)

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




complex(skind),dimension(:),intent(in),target:: tau
complex(skind),pointer:: pptau,wwtau(:)




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



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

! end init

call cvecext(tau,pptau,wwtau)
if (.not.associated(pptau,tau(1))) wwtau = tau


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

! end copy


call cUNGRQ(size(a,1),size(a,2),size(tau),&
ppa,lda,pptau,lwork,-1,vinfo)
allocate(work(int(lwork)))
call cUNGRQ(size(a,1),size(a,2),size(tau),&
ppa,lda,pptau,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(pptau,tau(1))) then
  
  deallocate(pptau)
end if


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

! end cleanup




end subroutine



subroutine zUNGRQ_95(a,tau,info)

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




complex(dkind),dimension(:),intent(in),target:: tau
complex(dkind),pointer:: pptau,wwtau(:)




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



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

! end init

call zvecext(tau,pptau,wwtau)
if (.not.associated(pptau,tau(1))) wwtau = tau


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

! end copy


call zUNGRQ(size(a,1),size(a,2),size(tau),&
ppa,lda,pptau,lwork,-1,vinfo)
allocate(work(int(lwork)))
call zUNGRQ(size(a,1),size(a,2),size(tau),&
ppa,lda,pptau,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(pptau,tau(1))) then
  
  deallocate(pptau)
end if


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

! end cleanup




end subroutine


! LQ factorization



subroutine sGELQF_95(a,tau,info)

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




real(skind),dimension(:),intent(out),target:: tau
real(skind),pointer:: pptau,wwtau(:)




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



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


integer:: m



integer:: n



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


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

! end init



call svecext(tau,pptau,wwtau)



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

! end copy


call sGELQF(m,n,ppa,lda,pptau,lwork,-1,vinfo)
allocate(work(int(lwork)))
call sGELQF(m,n,ppa,lda,pptau,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(pptau,tau(1))) then
  tau = wwtau
  deallocate(pptau)
end if


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

! end cleanup




end subroutine



subroutine dGELQF_95(a,tau,info)

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




real(dkind),dimension(:),intent(out),target:: tau
real(dkind),pointer:: pptau,wwtau(:)




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



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


integer:: m



integer:: n



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


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

! end init



call dvecext(tau,pptau,wwtau)



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

! end copy


call dGELQF(m,n,ppa,lda,pptau,lwork,-1,vinfo)
allocate(work(int(lwork)))
call dGELQF(m,n,ppa,lda,pptau,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(pptau,tau(1))) then
  tau = wwtau
  deallocate(pptau)
end if


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

! end cleanup




end subroutine



subroutine cGELQF_95(a,tau,info)

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




complex(skind),dimension(:),intent(out),target:: tau
complex(skind),pointer:: pptau,wwtau(:)




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



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


integer:: m



integer:: n



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


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

! end init



call cvecext(tau,pptau,wwtau)



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

! end copy


call cGELQF(m,n,ppa,lda,pptau,lwork,-1,vinfo)
allocate(work(int(lwork)))
call cGELQF(m,n,ppa,lda,pptau,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(pptau,tau(1))) then
  tau = wwtau
  deallocate(pptau)
end if


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

! end cleanup




end subroutine



subroutine zGELQF_95(a,tau,info)

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




complex(dkind),dimension(:),intent(out),target:: tau
complex(dkind),pointer:: pptau,wwtau(:)




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



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


integer:: m



integer:: n



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


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

! end init



call zvecext(tau,pptau,wwtau)



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

! end copy


call zGELQF(m,n,ppa,lda,pptau,lwork,-1,vinfo)
allocate(work(int(lwork)))
call zGELQF(m,n,ppa,lda,pptau,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(pptau,tau(1))) then
  tau = wwtau
  deallocate(pptau)
end if


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

! end cleanup




end subroutine





subroutine sORMLQ_95(a,tau,c,side,trans,info)

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




real(skind),dimension(:),intent(in),target:: tau
real(skind),pointer:: pptau,wwtau(:)




real(skind),dimension(:,:),intent(inout),target:: c
real(skind),pointer:: ppc,wwc(:,:)
integer:: ldc



character,intent(in),optional:: side
character:: vside


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



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



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


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


vside = "L"
if (present(side)) vside = side

! end init



call smatext(c,ppc,ldc,wwc)
if (.not.associated(ppc,c(1,1))) wwc = c


call svecext(tau,pptau,wwtau)
if (.not.associated(pptau,tau(1))) wwtau = tau


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

! end copy



call sORMLQ(vside,vtrans,size(c,1),size(c,2),size(tau),&
ppa,lda,pptau,ppc,ldc,lwork,-1,vinfo)
allocate(work(int(lwork)))
call sORMLQ(vside,vtrans,size(c,1),size(c,2),size(tau),&
ppa,lda,pptau,ppc,ldc,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppc,c(1,1))) then
  c = wwc
  deallocate(ppc)
end if


if (.not.associated(pptau,tau(1))) then
  
  deallocate(pptau)
end if


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

! end cleanup





end subroutine



subroutine dORMLQ_95(a,tau,c,side,trans,info)

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




real(dkind),dimension(:),intent(in),target:: tau
real(dkind),pointer:: pptau,wwtau(:)




real(dkind),dimension(:,:),intent(inout),target:: c
real(dkind),pointer:: ppc,wwc(:,:)
integer:: ldc



character,intent(in),optional:: side
character:: vside


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



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



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


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


vside = "L"
if (present(side)) vside = side

! end init



call dmatext(c,ppc,ldc,wwc)
if (.not.associated(ppc,c(1,1))) wwc = c


call dvecext(tau,pptau,wwtau)
if (.not.associated(pptau,tau(1))) wwtau = tau


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

! end copy



call dORMLQ(vside,vtrans,size(c,1),size(c,2),size(tau),&
ppa,lda,pptau,ppc,ldc,lwork,-1,vinfo)
allocate(work(int(lwork)))
call dORMLQ(vside,vtrans,size(c,1),size(c,2),size(tau),&
ppa,lda,pptau,ppc,ldc,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppc,c(1,1))) then
  c = wwc
  deallocate(ppc)
end if


if (.not.associated(pptau,tau(1))) then
  
  deallocate(pptau)
end if


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

! end cleanup





end subroutine





subroutine cUNMLQ_95(a,tau,c,side,trans,info)

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




complex(skind),dimension(:),intent(in),target:: tau
complex(skind),pointer:: pptau,wwtau(:)




complex(skind),dimension(:,:),intent(inout),target:: c
complex(skind),pointer:: ppc,wwc(:,:)
integer:: ldc



character,intent(in),optional:: side
character:: vside


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



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



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


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


vside = "L"
if (present(side)) vside = side

! end init



call cmatext(c,ppc,ldc,wwc)
if (.not.associated(ppc,c(1,1))) wwc = c


call cvecext(tau,pptau,wwtau)
if (.not.associated(pptau,tau(1))) wwtau = tau


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

! end copy



call cUNMLQ(vside,vtrans,size(c,1),size(c,2),size(tau),&
ppa,lda,pptau,ppc,ldc,lwork,-1,vinfo)
allocate(work(int(lwork)))
call cUNMLQ(vside,vtrans,size(c,1),size(c,2),size(tau),&
ppa,lda,pptau,ppc,ldc,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppc,c(1,1))) then
  c = wwc
  deallocate(ppc)
end if


if (.not.associated(pptau,tau(1))) then
  
  deallocate(pptau)
end if


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

! end cleanup





end subroutine



subroutine zUNMLQ_95(a,tau,c,side,trans,info)

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




complex(dkind),dimension(:),intent(in),target:: tau
complex(dkind),pointer:: pptau,wwtau(:)




complex(dkind),dimension(:,:),intent(inout),target:: c
complex(dkind),pointer:: ppc,wwc(:,:)
integer:: ldc



character,intent(in),optional:: side
character:: vside


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



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



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


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


vside = "L"
if (present(side)) vside = side

! end init



call zmatext(c,ppc,ldc,wwc)
if (.not.associated(ppc,c(1,1))) wwc = c


call zvecext(tau,pptau,wwtau)
if (.not.associated(pptau,tau(1))) wwtau = tau


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

! end copy



call zUNMLQ(vside,vtrans,size(c,1),size(c,2),size(tau),&
ppa,lda,pptau,ppc,ldc,lwork,-1,vinfo)
allocate(work(int(lwork)))
call zUNMLQ(vside,vtrans,size(c,1),size(c,2),size(tau),&
ppa,lda,pptau,ppc,ldc,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(ppc,c(1,1))) then
  c = wwc
  deallocate(ppc)
end if


if (.not.associated(pptau,tau(1))) then
  
  deallocate(pptau)
end if


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

! end cleanup





end subroutine





subroutine sORGLQ_95(a,tau,info)

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




real(skind),dimension(:),intent(in),target:: tau
real(skind),pointer:: pptau,wwtau(:)




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



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

! end init

call svecext(tau,pptau,wwtau)
if (.not.associated(pptau,tau(1))) wwtau = tau


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

! end copy


call sORGLQ(size(a,1),size(a,2),size(tau),&
ppa,lda,pptau,lwork,-1,vinfo)
allocate(work(int(lwork)))
call sORGLQ(size(a,1),size(a,2),size(tau),&
ppa,lda,pptau,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(pptau,tau(1))) then
  
  deallocate(pptau)
end if


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

! end cleanup




end subroutine



subroutine dORGLQ_95(a,tau,info)

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




real(dkind),dimension(:),intent(in),target:: tau
real(dkind),pointer:: pptau,wwtau(:)




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



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

! end init

call dvecext(tau,pptau,wwtau)
if (.not.associated(pptau,tau(1))) wwtau = tau


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

! end copy


call dORGLQ(size(a,1),size(a,2),size(tau),&
ppa,lda,pptau,lwork,-1,vinfo)
allocate(work(int(lwork)))
call dORGLQ(size(a,1),size(a,2),size(tau),&
ppa,lda,pptau,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(pptau,tau(1))) then
  
  deallocate(pptau)
end if


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

! end cleanup




end subroutine





subroutine cUNGLQ_95(a,tau,info)

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




complex(skind),dimension(:),intent(in),target:: tau
complex(skind),pointer:: pptau,wwtau(:)




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



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

! end init

call cvecext(tau,pptau,wwtau)
if (.not.associated(pptau,tau(1))) wwtau = tau


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

! end copy


call cUNGLQ(size(a,1),size(a,2),size(tau),&
ppa,lda,pptau,lwork,-1,vinfo)
allocate(work(int(lwork)))
call cUNGLQ(size(a,1),size(a,2),size(tau),&
ppa,lda,pptau,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(pptau,tau(1))) then
  
  deallocate(pptau)
end if


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

! end cleanup




end subroutine



subroutine zUNGLQ_95(a,tau,info)

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




complex(dkind),dimension(:),intent(in),target:: tau
complex(dkind),pointer:: pptau,wwtau(:)




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



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

! end init

call zvecext(tau,pptau,wwtau)
if (.not.associated(pptau,tau(1))) wwtau = tau


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

! end copy


call zUNGLQ(size(a,1),size(a,2),size(tau),&
ppa,lda,pptau,lwork,-1,vinfo)
allocate(work(int(lwork)))
call zUNGLQ(size(a,1),size(a,2),size(tau),&
ppa,lda,pptau,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(pptau,tau(1))) then
  
  deallocate(pptau)
end if


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

! end cleanup




end subroutine


! QR factorization with column pivoting



subroutine sGEQP3_95(a,jpvt,tau,info)

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




integer,dimension(:),intent(out),target:: jpvt
integer,pointer:: ppjpvt,wwjpvt(:)




real(skind),dimension(:),intent(out),target:: tau
real(skind),pointer:: pptau,wwtau(:)




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



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

! end init

call svecext(tau,pptau,wwtau)



call ivecext(jpvt,ppjpvt,wwjpvt)



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

! end copy



call sGEQP3(size(a,1),size(a,2),ppa,lda,&
ppjpvt,pptau,lwork,-1,vinfo)
allocate(work(int(lwork)))
call sGEQP3(size(a,1),size(a,2),ppa,lda,&
ppjpvt,pptau,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(pptau,tau(1))) then
  tau = wwtau
  deallocate(pptau)
end if


if (.not.associated(ppjpvt,jpvt(1))) then
  jpvt = wwjpvt
  deallocate(ppjpvt)
end if


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

! end cleanup





end subroutine



subroutine dGEQP3_95(a,jpvt,tau,info)

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




integer,dimension(:),intent(out),target:: jpvt
integer,pointer:: ppjpvt,wwjpvt(:)




real(dkind),dimension(:),intent(out),target:: tau
real(dkind),pointer:: pptau,wwtau(:)




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



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

! end init

call dvecext(tau,pptau,wwtau)



call ivecext(jpvt,ppjpvt,wwjpvt)



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

! end copy



call dGEQP3(size(a,1),size(a,2),ppa,lda,&
ppjpvt,pptau,lwork,-1,vinfo)
allocate(work(int(lwork)))
call dGEQP3(size(a,1),size(a,2),ppa,lda,&
ppjpvt,pptau,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(pptau,tau(1))) then
  tau = wwtau
  deallocate(pptau)
end if


if (.not.associated(ppjpvt,jpvt(1))) then
  jpvt = wwjpvt
  deallocate(ppjpvt)
end if


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

! end cleanup





end subroutine



subroutine cGEQP3_95(a,jpvt,tau,info)

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




integer,dimension(:),intent(out),target:: jpvt
integer,pointer:: ppjpvt,wwjpvt(:)




complex(skind),dimension(:),intent(out),target:: tau
complex(skind),pointer:: pptau,wwtau(:)




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



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

! end init

call cvecext(tau,pptau,wwtau)



call ivecext(jpvt,ppjpvt,wwjpvt)



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

! end copy



call cGEQP3(size(a,1),size(a,2),ppa,lda,&
ppjpvt,pptau,lwork,-1,vinfo)
allocate(work(int(lwork)))
call cGEQP3(size(a,1),size(a,2),ppa,lda,&
ppjpvt,pptau,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(pptau,tau(1))) then
  tau = wwtau
  deallocate(pptau)
end if


if (.not.associated(ppjpvt,jpvt(1))) then
  jpvt = wwjpvt
  deallocate(ppjpvt)
end if


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

! end cleanup





end subroutine



subroutine zGEQP3_95(a,jpvt,tau,info)

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




integer,dimension(:),intent(out),target:: jpvt
integer,pointer:: ppjpvt,wwjpvt(:)




complex(dkind),dimension(:),intent(out),target:: tau
complex(dkind),pointer:: pptau,wwtau(:)




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



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

! end init

call zvecext(tau,pptau,wwtau)



call ivecext(jpvt,ppjpvt,wwjpvt)



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

! end copy



call zGEQP3(size(a,1),size(a,2),ppa,lda,&
ppjpvt,pptau,lwork,-1,vinfo)
allocate(work(int(lwork)))
call zGEQP3(size(a,1),size(a,2),ppa,lda,&
ppjpvt,pptau,work,size(work),vinfo)

if (present(info)) info = vinfo


if (.not.associated(pptau,tau(1))) then
  tau = wwtau
  deallocate(pptau)
end if


if (.not.associated(ppjpvt,jpvt(1))) then
  jpvt = wwjpvt
  deallocate(ppjpvt)
end if


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

! end cleanup





end subroutine


end module