      SUBROUTINE scripto(OAP,M,N,MD,ND,c)
      IMPLICIT REAL*8(A-H,O-Z)
      character*8 c(md)
      DIMENSION OAP(MD,ND)
      nnn=10
      NN=N/nnn
      IF(NN.EQ.0) GOTO 85
      DO 83 KK=1,NN
      N1=nnn*(KK-1)+1
      N2=nnn*KK
      IF(N2.LT.N1) RETURN
      WRITE(6,*) ' '
      WRITE(6,1024) (I,I=N1,N2)
      WRITE(6,*) ' '
      DO 83 JJ=1,M
83    WRITE(6,1025) jj,c(jj),(OAP(JJ,II),II=N1,N2)
      WRITE(6,*) ' '
85    N1=nnn*NN+1
      N2=N
      IF(N2.LT.N1) RETURN
      WRITE(6,*) ' '
      WRITE(6,1024) (I,I=N1,N2)
      WRITE(6,*) ' '
      DO 84 JJ=1,M
84    WRITE(6,1025) jj,c(jj),(OAP(JJ,II),II=N1,N2)
      WRITE(6,*) ' '
1024  FORMAT(10X,10(3X,I5))
1025  FORMAT(1x,i3,1x,a8,1x,10F8.4)
      RETURN
      END
       SUBROUTINE scripto3 (OAP,M,N,MD,ND,c,iunit)
      IMPLICIT REAL*8(A-H,O-Z)
      character*8 c(md)
      DIMENSION OAP(MD,ND)
      nnn=10
      NN=N/nnn
      IF(NN.EQ.0) GOTO 85
      DO 83 KK=1,NN
      N1=nnn*(KK-1)+1
      N2=nnn*KK
      IF(N2.LT.N1) RETURN
      WRITE(iunit,*) ' '
      WRITE(iunit,1024) (I,I=N1,N2)
      WRITE(iunit,*) ' '
      DO 83 JJ=1,M
83    WRITE(iunit,1025) jj,c(jj),(OAP(JJ,II),II=N1,N2)
      WRITE(iunit,*) ' '
85    N1=nnn*NN+1
      N2=N
      IF(N2.LT.N1) RETURN
      WRITE(iunit,*) ' '
      WRITE(iunit,1024) (I,I=N1,N2)
      WRITE(iunit,*) ' '
      DO 84 JJ=1,M
84    WRITE(iunit,1025) jj,c(jj),(OAP(JJ,II),II=N1,N2)
      WRITE(iunit,*) ' '
1024  FORMAT(10X,10(3X,I5))
1025  FORMAT(1x,i3,1x,a8,1x,10F8.4)
      RETURN
      END
       SUBROUTINE scripto1 (OAP,M,N,MD,ND,c)
      IMPLICIT REAL*8(A-H,O-Z)
      character*8 c(md)
      DIMENSION OAP(MD,ND)
c      print*,'entree scripto',n,m,nd,md
      nnn=10
      NN=N/nnn
      IF(NN.EQ.0) GOTO 85
      DO 83 KK=1,NN
      N1=nnn*(KK-1)+1
      N2=nnn*KK
      IF(N2.LT.N1) RETURN
      WRITE(6,*) ' '
      WRITE(6,1024) (I,I=N1,N2)
      WRITE(6,*) ' '
      DO 83 JJ=1,M
83    if(any(dabs(oap(jj,n1:n2)).gt.1.d-6))
     *WRITE(6,1025) jj,c(jj),(OAP(JJ,II),II=N1,N2)
      WRITE(6,*) ' '
85    N1=nnn*NN+1
      N2=N
      IF(N2.LT.N1) RETURN
      WRITE(6,*) ' '
      WRITE(6,1024) (I,I=N1,N2)
      WRITE(6,*) ' '
      DO 84 JJ=1,M
84    if(any(dabs(oap(jj,n1:n2)).gt.1.d-6))
     *WRITE(6,1025) jj,c(jj),(OAP(JJ,II),II=N1,N2)
      WRITE(6,*) ' '
1024  FORMAT(10X,10(3X,I5))
1025  FORMAT(1x,i3,1x,a8,1x,10F8.4)
      RETURN
      END
       SUBROUTINE scripto2 (OAP,M,N,MD,ND,c,idep)
      IMPLICIT REAL*8(A-H,O-Z)
      character*8 c(md)
      DIMENSION OAP(MD,ND)
      nnn=10
      NN=N/nnn
      IF(NN.EQ.0) GOTO 85
      DO 83 KK=1,NN
      N1=nnn*(KK-1)+1
      N2=nnn*KK
      IF(N2.LT.N1) RETURN
      WRITE(6,*) ' '
      WRITE(6,1024) (I,I=N1+idep,N2+idep)
      WRITE(6,*) ' '
      DO 83 JJ=1,M
      if(any(dabs(oap(jj,n1:n2)).gt.1.d-6))
     *WRITE(6,1025) jj,c(jj),(OAP(JJ,II),II=N1,N2)
 83   continue
      WRITE(6,*) ' '
85    N1=nnn*NN+1
      N2=N
      IF(N2.LT.N1) RETURN
      WRITE(6,*) ' '
      WRITE(6,1024) (I,I=N1+idep,N2+idep)
      WRITE(6,*) ' '
      DO 84 JJ=1,M
      if(any(dabs(oap(jj,n1:n2)).gt.1.d-6))
     *WRITE(6,1025) jj,c(jj),(OAP(JJ,II),II=N1,N2)
 84   continue
      WRITE(6,*) ' '
1024  FORMAT(10X,10(3X,I5))
1025  FORMAT(1x,i3,1x,a8,1x,10F8.4)
      RETURN
      END
       SUBROUTINE scripto6 (OAP,M,N,MD,ND,c,iunit,focvir,flab,focc,fsym
     *,fdat1,iwk)
      IMPLICIT REAL*8(A-H,O-Z)
      character*8 c(md)
      DIMENSION OAP(MD,ND),iwk(m)
      character(4) focvir(n)
      character(18) flab(n)
      dimension focc(n)
      integer fsym(n),fdat1(n)
      nnn=8
      NN=N/nnn
      IF(NN.EQ.0) GOTO 85
      DO 83 KK=1,NN
      N1=nnn*(KK-1)+1
      N2=nnn*KK
      IF(N2.LT.N1) goto 86
      WRITE(iunit,*) ' '
      WRITE(iunit,1024) (iwk(i),I=N1,N2)
      WRITE(iunit,1028) (flab(i)(1:6),I=N1,N2)
      WRITE(iunit,1028) (flab(i)(7:12),I=N1,N2)
      if(any(flab(n1:n2)(13:18)/=' '))
     *WRITE(iunit,1028) (flab(i)(13:18),I=N1,N2)
      WRITE(iunit,1030) ('D',fdat1(i),I=N1,N2)
      WRITE(iunit,1029) ('SY ',fsym(i),I=N1,N2)
      WRITE(iunit,1026) (focvir(i),I=N1,N2)
      WRITE(iunit,1027) (focc(i),I=N1,N2)
      WRITE(iunit,*) ' '
      DO 83 JJ=1,M
      if(any(dabs(oap(jj,n1:n2)).gt.1.d-6))
     *WRITE(iunit,1025) jj,c(jj),(OAP(JJ,II),II=N1,N2)
 83   continue
      WRITE(iunit,*) ' '
85    N1=nnn*NN+1
      N2=N
      IF(N2.LT.N1) goto 86
      WRITE(iunit,*) ' '
      WRITE(iunit,1024) (iwk(i),I=N1,N2)
      WRITE(iunit,1028) (flab(i)(1:6),I=N1,N2)
      WRITE(iunit,1028) (flab(i)(7:12),I=N1,N2)
      if(any(flab(n1:n2)(13:18)/=' '))
     *WRITE(iunit,1028) (flab(i)(13:18),I=N1,N2)
      WRITE(iunit,1030) ('D',fdat1(i),I=N1,N2)
      WRITE(iunit,1029) ('SY ',fsym(i),I=N1,N2)
      WRITE(iunit,1026) (focvir(i),I=N1,N2)
      WRITE(iunit,1027) (focc(i),I=N1,N2)
      WRITE(iunit,*) ' '
      DO 84 JJ=1,M
      if(any(dabs(oap(jj,n1:n2)).gt.1.d-6))
     *WRITE(iunit,1025) jj,c(jj),(OAP(JJ,II),II=N1,N2)
 84   continue
 86   continue
      WRITE(iunit,*) ' '
1024  FORMAT(14X,10(3X,I5))
1025  FORMAT(1x,i3,1x,a8,1x,10F8.4)
1026  FORMAT(14X,10(5X,a3))
1027  FORMAT(14X,10(f8.4))
1028  FORMAT(14X,10(2X,a6))
1029  FORMAT(14X,10(4X,a3,i1))
1030  FORMAT(14X,10(4X,a1,i3))
      call overl(n,iunit)
      write(iunit,*)' '
      write(iunit,'(a,i4,a)')'(',n,' Orbitals)'
      RETURN
      END
       SUBROUTINE scripto7 (OAP,M,N,MD,ND,c,iunit,focvir,flab,focc,fsym
     *,fdat1,iwk)
      IMPLICIT REAL*8(A-H,O-Z)
      character*8 c(md)
      DIMENSION OAP(MD,ND),iwk(m)
      character(4) focvir(n)
      character(18) flab(n)
      dimension focc(n)
      integer fsym(n),fdat1(n)
      nnn=8
      NN=N/nnn
      IF(NN.EQ.0) GOTO 85
      DO 83 KK=1,NN
      N1=nnn*(KK-1)+1
      N2=nnn*KK
      IF(N2.LT.N1) goto 86
      WRITE(iunit,*) ' '
      WRITE(iunit,1024) (iwk(i),I=N1,N2)
      WRITE(iunit,1028) (flab(i)(1:6),I=N1,N2)
      WRITE(iunit,1028) (flab(i)(7:12),I=N1,N2)
      if(any(flab(n1:n2)(13:14)/=' '))
     *WRITE(iunit,1028) (flab(i)(13:14),I=N1,N2)
      WRITE(iunit,1030) ('D',fdat1(i),I=N1,N2)
      WRITE(iunit,1029) ('SY ',fsym(i),I=N1,N2)
      WRITE(iunit,1026) (focvir(i),I=N1,N2)
      WRITE(iunit,1027) (focc(i),I=N1,N2)
      WRITE(iunit,*) ' '
      DO 83 JJ=1,M
      if(any(dabs(oap(jj,n1:n2)).gt.1.d-6))
     *WRITE(iunit,1025) jj,c(jj),(OAP(JJ,II),II=N1,N2)
 83   continue
      WRITE(iunit,*) ' '
85    N1=nnn*NN+1
      N2=N
      IF(N2.LT.N1) goto 86
      WRITE(iunit,*) ' '
      WRITE(iunit,1024) (iwk(i),I=N1,N2)
      WRITE(iunit,1028) (flab(i)(1:6),I=N1,N2)
      WRITE(iunit,1028) (flab(i)(7:12),I=N1,N2)
      if(any(flab(n1:n2)(13:14)/=' '))
     *WRITE(iunit,1028) (flab(i)(13:14),I=N1,N2)
      WRITE(iunit,1030) ('D',fdat1(i),I=N1,N2)
      WRITE(iunit,1029) ('SY ',fsym(i),I=N1,N2)
      WRITE(iunit,1026) (focvir(i),I=N1,N2)
      WRITE(iunit,1027) (focc(i),I=N1,N2)
      WRITE(iunit,*) ' '
      DO 84 JJ=1,M
      if(any(dabs(oap(jj,n1:n2)).gt.1.d-6))
     *WRITE(iunit,1025) jj,c(jj),(OAP(JJ,II),II=N1,N2)
 84   continue
 86   continue
      WRITE(iunit,*) ' '
1024  FORMAT(14X,10(3X,I5))
1025  FORMAT(1x,i3,1x,a8,1x,10F8.4)
1026  FORMAT(14X,10(5X,a3))
1027  FORMAT(14X,10(f8.4))
1028  FORMAT(14X,10(2X,a6))
1029  FORMAT(14X,10(4X,a3,i1))
1030  FORMAT(14X,10(4X,a1,i3))
      RETURN
      END
