      SUBROUTINE DEFLAT(A,W,N,WORK1,WORK2,IUN)
CDEP  
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION A(N,N),W(N),WORK1(N),WORK2(N)
      EXTERNAL DOTVEC
C     
      zero = 0.0
      WLEN=DSQRT(DOTVEC(W,W,N))
      W(1)=W(1)-WLEN
      RECIP=1/DSQRT(DOTVEC(W,W,N))
      DO 100 I=1,N
         W(I)=W(I)*RECIP      
 100  CONTINUE
C     
      WRITE(6,*)'**DEFLAT: HOUSEHOLDER MATRIX DONE'
C     
      DO 200 J=1,N
         PRODCT=-2.0*DOTVEC(W,A(1,J),N)
         CALL ADDVEC(A(1,J),W,N,PRODCT,A(1,J))
 200  CONTINUE  
C     
      REWIND IUN
C     
      NN=N-1 
      DO 300 J=1,N                
         CALL COPVAL(WORK1,N,zero)
         WORK1(J)=1.0       
         PRODCT=-2.0*W(J)
         CALL ADDVEC(WORK1,W,N,PRODCT,WORK1)
         NC=N-J+1         
         CALL MATVE2(A,WORK1,N,WORK2(J),NC)
         IF (J.EQ.1) THEN
            WRITE(6,*) '**DEFLAT: CHECK VALUES=',WORK2(1),WORK2(N)
         ELSE
            CALL PUTSCR(IUN,WORK2(2),NN,1,0)
c--            CALL PUTSCR(work3(1,j-1),WORK2(2),NN,1,0)
         ENDIF
 300  CONTINUE                        
C     
      CALL GETSCR(IUN,A,NN,NN)
c--      CALL GETSCR(work3,A,NN,NN)
      CALL TRANSP(A,NN,A)
C     
      CALL MATPRT(A,NN)
      RETURN
      END
