c
      subroutine TMtrx(npts, Dk2de, Wgf, Vsuper, Tonshl)
c
c***********************************************************************
c     Tmtrx calculates scattering length flj(ich, jch) from a Wgf 
c        array and a symmetric vlj potential matrix by formular
c       T = V + VGT ===> T = 1/(1-VG)*V ===> T = 1/G*1/(1/G-V)*V
c	input Super V matrix, output on-shell channel T matrix 
c***********************************************************************
c
      implicit none
c     LOCAL variables
      integer first
      integer npts1, nchpt, nch, lmax
      integer ichpt, jchpt, l, ich, jch, id, j
      double precision one, zero
      double complex Fmtrx(128, 128), temp
c     SHARED variables
      integer npts, Nifty, Kpvt(128)
      double complex Dk2de(2), Wgf(128), B(128)
      double complex Vsuper(128,128,6), Tonshl(2,2,6)
      double complex Thalf(64),Tdiag(64)
      common /half/ Thalf,Tdiag
      common /control/ Nifty(15)

      parameter (zero = 0.0d0, one = 1.0d0)
      data first/1/
c      zabs1(zdumy) = abs(dble(zdumy)) + abs(imag(zdumy))

c***********************************************************************
c
      nch = nifty(2)
      lmax = nifty(6)
      npts1 = npts + 1
      nchpt = nch*npts1

c     solve Matrix Lippmann-Schwinger Eq.
      if (nifty(7) .eq. 1) then
c  #undef 1
      if (Nifty(11) .eq. 1) then
c        write(8,*) '@tmatrx, nifty(11)=1, not implemented'
c	stop
      endif

      do 10050 l = 1, lmax
         do jchpt = 1, nchpt
            do ichpt = 1, nchpt
               Fmtrx(ichpt, jchpt) = -Vsuper(ichpt, jchpt, l)*Wgf(jchpt)
	    enddo
            Fmtrx(jchpt, jchpt) = one + Fmtrx(jchpt, jchpt)
   	 enddo

         call ludcmp(Fmtrx, nchpt, 128, Kpvt, temp, id)

         do ich = 1, nch
            do ichpt = 1, nchpt
               B(ichpt) = Vsuper(ichpt, ich*npts1, l)
       	    enddo
            call lubksb(Fmtrx, nchpt, 128, Kpvt, B)
            do jch = 1, nch
               Tonshl(jch, ich, l) = B(jch*npts1)
     	    enddo
	 enddo

c	 calc diagonal t matrix
             if (Nifty(8).eq.1 .and. l.eq.nifty(6)) then
                do j = 1, npts
                  do ichpt = 1, nchpt
                    B(ichpt) = Vsuper(ichpt, j, l)
                  enddo
                  call lubksb(Fmtrx, nchpt, 128, Kpvt, B)
                  Tdiag(j) = B(j)
                enddo
             endif
10050 continue
     
      else

c     using born approximation
         do 10200 l = 1, lmax
            do jch = 1, nch
               jchpt = jch*npts1
               do ich = 1, nch
                  ichpt = ich*npts1
                  Tonshl(ich, jch, l) = Vsuper(ichpt, jchpt, l)
	       enddo
 	    enddo
10200    continue
      endif

      return
      end