module mod_script_lab
contains        
subroutine mscript_lab(oap,label_g,label_h,m,n,thr_in)
IMPLICIT REAL(8)(A-H,O-Z)
dimension oap(m,n)
character(*) label_g(*)
character(*) label_h(*)
character(20) formg,formh,formh0
character(3) c
real(8),optional :: thr_in
real(8) :: thr

print*,'present',present(thr_in),m,n
if(present(thr_in)) then
   thr=thr_in
else
   thr=0.d0
endif

ifg=len(label_g(1))
ifh=len(label_h(1))
write(c,'(i3)') ifg
      !formg='a'//trim(adjustl(c))//',10f8.4'
formg='(i4,1x,a'//c//',10f8.4)'
formh='(5x,'//trim(c)//'x,10(2X,a6))'
formh0='(5x,'//trim(c)//'X,10(3X,I5))'
      !print*,'formh',formh
      !print*,'formg',formg
      !m=size(oap,dim=1)
      !n=size(oap,dim=2)
      !print*,'m,n',m,n
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
print*,' '

! ecriture numeros et labels hauts
WRITE(6,formh0) (I,I=N1,N2)
do k=1,ifh,6
   write(6,formh) label_h(n1:n2)(k:min(k+5,ifh))
enddo

! ecriture vecteurs
print*,' '
DO 83 JJ=1,M
if(any(abs(oap(jj,n1:n2))>=thr)) WRITE(6,formg) JJ,label_g(jj),(OAP(JJ,II),II=N1,N2)
83   continue
print*,' '
85    N1=nnn*NN+1
N2=N
IF(N2.LT.N1) RETURN

! ecriture numeros et labels hauts
print*,' '
WRITE(6,formh0) (I,I=N1,N2)
do k=1,ifh,6
   write(6,formh) label_h(n1:n2)(k:min(k+5,ifh))
enddo
print*,' '

! ecriture vecteurs
DO 84 JJ=1,M
if(any(abs(oap(jj,n1:n2))>=thr)) WRITE(6,formg) JJ,label_g(jj),(OAP(JJ,II),II=N1,N2)
84   continue
print*,' '
1024  FORMAT(1X,10(3X,I5))
1025  FORMAT(I5,10F8.4)
RETURN
end subroutine
end module
