SUBROUTINE scriptol (OAP,M,N,MD,ND,c,iii,tipo,occup)
IMPLICIT REAL*8(A-H,O-Z)
character*8 c(md)
character*80 cc
character(*) tipo(n)
DIMENSION OAP(MD,ND),iii(n),occup(n)
dimension aa(8)
nnn=8
seuil=1.d-6
seuil=0.2
NN=N/nnn
IF(NN.EQ.0) GOTO 85
DO KK=1,NN
   N1=nnn*(KK-1)+1
   N2=nnn*KK
   IF(N2.LT.N1) RETURN
   WRITE(6,*) ' '
   WRITE(6,1024) (iii(i),I=N1,N2)
   write(6,1026) (occup(i),I=N1,N2)
   write(6,1027) (tipo(i)(1:6),I=N1,N2)
   write(6,1027) (tipo(i)(7:12),I=N1,N2)
   WRITE(6,*) ' '
   DO JJ=n1,n2
      aa(jj-n1+1)=maxval(dabs(oap(:,jj)))
   enddo
   DO JJ=1,M
      if(any(dabs(oap(jj,n1:n2))/aa(1:8).gt.seuil)) then
         cc=' '
         do kkk=n1,n2
            cc((kkk-n1)*8+1:(kkk-n1+1)*8)='   . . .'
            if(dabs(oap(jj,kkk))/aa(kkk-n1+1).gt.seuil) then
               write(cc((kkk-n1)*8+1:(kkk-n1+1)*8),'(f8.4)') &
               oap(jj,kkk)
            endif
         enddo
         write(6,1028) jj,c(jj),trim(cc)
      endif
   enddo
enddo
WRITE(6,*) ' '
85    N1=nnn*NN+1
N2=N
IF(N2.LT.N1) RETURN
WRITE(6,*) ' '
WRITE(6,1024) (iii(i),I=N1,N2)
write(6,1026) (occup(i),I=N1,N2)
write(6,1027) (tipo(i)(1:2),I=N1,N2)
write(6,1027) (tipo(i)(3:8),I=N1,N2)
write(6,1027) (tipo(i)(9:14),I=N1,N2)
write(6,1027) (tipo(i)(15:20),I=N1,N2)
WRITE(6,*) ' '
cc=' '
DO JJ=n1,n2
   aa(jj-n1+1)=maxval(dabs(oap(:,jj)))
enddo
DO JJ=1,M
   if(any(dabs(oap(jj,n1:n2))/aa(1:8).gt.seuil)) then
      cc=' '
      do kkk=n1,n2
         cc((kkk-n1)*8+1:(kkk-n1+1)*8)=' . . . .'
         if(dabs(oap(jj,kkk))/aa(kkk-n1+1).gt.seuil) then
            write(cc((kkk-n1)*8+1:(kkk-n1+1)*8),'(f8.4)') &
            oap(jj,kkk)
         endif
      enddo
      write(6,1028) jj,c(jj),trim(cc)
   endif
enddo
WRITE(6,*) ' '
1024  FORMAT(14X,8(3X,I5))
1026  FORMAT(14X,8(f8.4))
1027  FORMAT(14X,8(2X,a6))
1028  FORMAT(1x,i3,1x,a8,1x,a)
RETURN
END
 SUBROUTINE scriptol2 (OAP,M,N,MD,ND,c,iii,tipo,occup,file)
IMPLICIT REAL*8(A-H,O-Z)
character*10 c(md)
character*80 cc
character(*) tipo(n)
DIMENSION OAP(MD,ND),iii(n),occup(n)
dimension aa(8)
integer,optional :: file
nnn=8
seuil=1.d-6
seuil=0.2
NN=N/nnn
IF(NN.EQ.0) GOTO 85
DO KK=1,NN
   N1=nnn*(KK-1)+1
   N2=nnn*KK
   IF(N2.LT.N1) RETURN
   WRITE(6,*) ' '
   WRITE(6,1024) (iii(i),I=N1,N2)
   write(6,1026) (occup(i),I=N1,N2)
   write(6,1027) (tipo(i)(1:2),I=N1,N2)
   write(6,1027) (tipo(i)(3:8),I=N1,N2)
   write(6,1027) (tipo(i)(9:14),I=N1,N2)
   write(6,1027) (tipo(i)(15:20),I=N1,N2)
   WRITE(6,*) ' '
   DO JJ=n1,n2
      aa(jj-n1+1)=0.d0
      aa(jj-n1+1)=maxval(oap(:,jj))
      aa(jj-n1+1)=maxval(dabs(oap(:,jj)))
   enddo
   DO JJ=1,M
      if(any(dabs(oap(jj,n1:n2))/aa(1:8).gt.seuil)) then
         cc=' '
         do kkk=n1,n2
            cc((kkk-n1)*8+1:(kkk-n1+1)*8)='   . . .'
            if(dabs(oap(jj,kkk))/aa(kkk-n1+1).gt.seuil) then
               write(cc((kkk-n1)*8+1:(kkk-n1+1)*8),'(f8.4)') &
               oap(jj,kkk)
            endif
         enddo
         write(6,1028) jj,c(jj),trim(cc)
      endif
   enddo
enddo
WRITE(6,*) ' '
85    N1=nnn*NN+1
N2=N
IF(N2.LT.N1) RETURN
WRITE(6,*) ' '
WRITE(6,1024) (iii(i),I=N1,N2)
write(6,1026) (occup(i),I=N1,N2)
write(6,1027) (tipo(i)(1:2),I=N1,N2)
write(6,1027) (tipo(i)(3:8),I=N1,N2)
write(6,1027) (tipo(i)(9:14),I=N1,N2)
write(6,1027) (tipo(i)(15:20),I=N1,N2)
WRITE(6,*) ' '
cc=' '
DO JJ=n1,n2
   aa(jj-n1+1)=maxval(dabs(oap(:,jj)))
enddo
DO JJ=1,M
   if(any(dabs(oap(jj,n1:n2))/aa(1:8).gt.seuil)) then
      cc=' '
      do kkk=n1,n2
         cc((kkk-n1)*8+1:(kkk-n1+1)*8)=' . . . .'
         if(dabs(oap(jj,kkk))/aa(kkk-n1+1).gt.seuil) then
            write(cc((kkk-n1)*8+1:(kkk-n1+1)*8),'(f8.4)') &
            oap(jj,kkk)
         endif
      enddo
      write(6,1028) jj,c(jj),trim(cc)
   endif
enddo
WRITE(6,*) ' '
1024  FORMAT(16X,8(3X,I5))
1026  FORMAT(16X,8(f8.4))
1027  FORMAT(16X,8(2X,a6))
1028  FORMAT(1x,i3,1x,a10,1x,a)
RETURN
END
 SUBROUTINE scriptol3 (OAP,M,N,MD,ND,c,iii,tipo,occup)
IMPLICIT REAL*8(A-H,O-Z)
character*8 c(md)
character*80 cc
character(*) tipo(n)
DIMENSION OAP(MD,ND),iii(n),occup(n)
dimension aa(8)
nnn=8
seuil=1.d-6
seuil=0.2
NN=N/nnn
IF(NN.EQ.0) GOTO 85
DO KK=1,NN
   N1=nnn*(KK-1)+1
   N2=nnn*KK
   IF(N2.LT.N1) RETURN
   WRITE(6,*) ' '
   WRITE(6,1024) (iii(i),I=N1,N2)
   write(6,1026) (occup(i),I=N1,N2)
   write(6,1027) (tipo(i)(1:2),I=N1,N2)
   write(6,1027) (tipo(i)(3:8),I=N1,N2)
   write(6,1027) (tipo(i)(9:14),I=N1,N2)
   write(6,1027) (tipo(i)(15:20),I=N1,N2)
   WRITE(6,*) ' '
   DO JJ=n1,n2
      aa(jj-n1+1)=0.d0
      aa(jj-n1+1)=maxval(oap(:,jj))
      aa(jj-n1+1)=maxval(dabs(oap(:,jj)))
   enddo
   DO JJ=1,M
      if(any(dabs(oap(jj,n1:n2))/aa(1:8).gt.seuil)) then
         cc=' '
         do kkk=n1,n2
            cc((kkk-n1)*8+1:(kkk-n1+1)*8)='   . . .'
            if(dabs(oap(jj,kkk))/aa(kkk-n1+1).gt.seuil) then
               write(cc((kkk-n1)*8+1:(kkk-n1+1)*8),'(f8.4)') &
               oap(jj,kkk)
            endif
         enddo
         write(6,1028) jj,c(jj),trim(cc)
      endif
   enddo
enddo
WRITE(6,*) ' '
85    N1=nnn*NN+1
N2=N
IF(N2.LT.N1) RETURN
WRITE(6,*) ' '
WRITE(6,1024) (iii(i),I=N1,N2)
write(6,1026) (occup(i),I=N1,N2)
write(6,1027) (tipo(i)(1:2),I=N1,N2)
write(6,1027) (tipo(i)(3:8),I=N1,N2)
write(6,1027) (tipo(i)(9:14),I=N1,N2)
write(6,1027) (tipo(i)(15:20),I=N1,N2)
WRITE(6,*) ' '
cc=' '
DO JJ=n1,n2
   aa(jj-n1+1)=maxval(dabs(oap(:,jj)))
enddo
DO JJ=1,M
   if(any(dabs(oap(jj,n1:n2))/aa(1:8).gt.seuil)) then
      cc=' '
      do kkk=n1,n2
         cc((kkk-n1)*8+1:(kkk-n1+1)*8)=' . . . .'
         if(dabs(oap(jj,kkk))/aa(kkk-n1+1).gt.seuil) then
            write(cc((kkk-n1)*8+1:(kkk-n1+1)*8),'(f8.4)') &
            oap(jj,kkk)
         endif
      enddo
      write(6,1028) jj,c(jj),trim(cc)
   endif
enddo
WRITE(6,*) ' '
1024  FORMAT(16X,8(3X,I5))
1026  FORMAT(16X,8(f8.4))
1027  FORMAT(16X,8(2X,a6))
1028  FORMAT(1x,i3,1x,a10,1x,a)
RETURN
END
