      SUBROUTINE scriptol2 (OAP,M,N,MD,ND,c,iii,tipo,occup)
      IMPLICIT REAL*8(A-H,O-Z)
      character*8 c(md)
      character(*) tipo(n)
      DIMENSION OAP(MD,ND),iii(n),occup(n)
      character(40),allocatable,dimension(:) :: col1,col2
      allocate(col1(m+7),col2(m+7))
      ncol=3
      ifin2=0
      seuil=1.d-1
      if(m>100) seuil=3.d-1
1024  FORMAT(14X,10(3X,I5))
1026  FORMAT(14X,10(f8.4))
1027  FORMAT(14X,10(2X,a6))
1025  FORMAT(1x,i3,1x,a8,1x,10F8.4)
      do i1=1,n,ncol+ncol
         ideb1=ifin2+1
         ideb2=min(ideb1+ncol,n)
         ifin1=min(ideb1+ncol-1,n)
         ifin2=min(ideb2+ncol-1,n)
         col1=' '
         WRITE(col1(2),1024) (iii(i),I=ideb1,ifin1)
         write(col1(3),1026) (occup(i),I=ideb1,ifin1)
         write(col1(4),1027) (tipo(i)(1:6),I=ideb1,ifin1)
         write(col1(5),1027) (tipo(i)(7:12),I=ideb1,ifin1)
         col2=' '
         WRITE(col2(2),1024) (iii(i),I=ideb2,ifin2)
         write(col2(3),1026) (occup(i),I=ideb2,ifin2)
         write(col2(4),1027) (tipo(i)(1:6),I=ideb2,ifin2)
         write(col2(5),1027) (tipo(i)(7:12),I=ideb2,ifin2)
 
         icol1=6
!         do j=ideb1,ifin1
            DO JJ=1,M
               if(any(dabs(oap(jj,ideb1:ifin1)).gt.seuil)) then
                  icol1=icol1+1 
                  WRITE(col1(icol1),1025) jj,c(jj),
     *            (OAP(JJ,II),II=ideb1,ifin1)
               endif
            enddo
!         enddo
         icol2=6
!         do j=ideb2,ifin2
            DO JJ=1,M
               if(any(dabs(oap(jj,ideb2:ifin2)).gt.seuil)) then
                  icol2=icol2+1 
                  WRITE(col2(icol2),1025) jj,c(jj),
     *            (OAP(JJ,II),II=ideb2,ifin2)
               endif
            enddo
!         enddo
         print'(10x,80a1)',('_',k=10,70)
         do k=1,max(icol1,icol2)
            write(6,'(a40,'' |'',a38)') col1(k),col2(k)
         enddo
      enddo
      deallocate(col1,col2)
      RETURN
      END
