putone.f

      SUBROUTINE PUTONE(ONEMAT,NBAS,IW)
      IMPLICIT REAL*8(A-H,O,P,R-Z),LOGICAL*1(Q)
      CHARACTER*1 QCC,QSKIP,QEJECT
C-----------------------------------------------------------------------
C
C     PUTONE...
C
C        THIS ROUTINE WRITES OUT A SYMMETRY PACKED MATRIX IN LOWER
C     TRIANGULAR FORM WITH 10 COLUMNS PER PAGE.
C
C     VARIABLE DEFINITIONS:
C
C        ONEMAT(*)... PACKED MATRIX.  (DIMENSIONED NBAS*(NBAS+1)/2).
C        NBAS........ DIMENSION OF BASIS (NUMBER OF ROWS AND COLUMNS).
C        IW.......... FORTRAN I/O UNIT FOR WRITING.
C
C     ROUTINES CALLED:  $PAGE($NLINE); MIN0, DABS
C
C-----------------------------------------------------------------------
      DIMENSION ONEMAT(1),ROW(10)
      DATA ZERO/0.0D0/,TOLER/5.0D-5/,MAXCOL/10/,LINECT/80/
      DATA QSKIP/' '/,QEJECT/' '/
      QCC=QSKIP
      LAST=0
	  
      DO 30 IBEGIN=1,NBAS,MAXCOL
      LAST=MIN0(LAST+MAXCOL,NBAS)
      NCOL=LAST-IBEGIN+1
      IJ=(IBEGIN*(IBEGIN-1))/2
      WRITE (IW,1000) QCC,(I,I=IBEGIN,LAST)
      WRITE (IW,2000)
      IEND=0
	  
      DO 20 J=IBEGIN,NBAS
      IEND=MIN0(IEND+1,NCOL)
      IJ=IJ+J-1
      QDELET=.TRUE.
	  
      DO 10 K=1,IEND
      ROWK=ONEMAT(IJ+K)
      IF (DABS(ROWK).LT.TOLER) ROWK=ZERO
      IF (ROWK.NE.ZERO) QDELET=.FALSE.
      ROW(K)=ROWK
   10 CONTINUE
   
      IF (QDELET) GO TO 20
      WRITE (IW,2000) J,(ROW(K),K=1,IEND)
   20 CONTINUE
   
C      CALL $NLINE(LINES)
	LINES = 0
      LEFT=LINECT-LINES
      NEED=NBAS-IBEGIN-MAXCOL+3
      QCC=QSKIP
      IF (NEED.GT.LEFT) QCC=QEJECT
   30 CONTINUE
   
      RETURN
	  
 1000 FORMAT(A1,I9,9I12)
 2000 FORMAT(' ',I2,F10.4,9F12.4)
      END