      subroutine scril
      character(10000) aa,bb
      rewind(75)
      ideb=0
      aa=' '
      do
         read(75,'(a10000)') bb
         l=len_trim(bb)
         aa(ideb+1:ideb+l)=trim(bb)
         if(bb(l:l)=='$') then
            aa(ideb+l:ideb+l)=' '
            call suppdb(aa,ideb+l)
            write(6,'(a)')trim(aa)
            exit
         endif
         ideb=ideb+l+2
      enddo
      rewind(75)
!      do
!         read(75,'(a10000)') aa(ideb:)
!         aa=adjustl(aa)
!         l=len_trim(aa)
!         print*,'AA',trim(aa)
!         if(aa(l:l)=='$') exit
!         ideb=l+2
!      enddo
!      do i=l,1,-1
!         if(aa(l:l)=='$') then
!            aa(l:l)=' '
!            exit
!         endif
!      enddo
!      call suppdb(aa,l)
!      l=len_trim(aa)
!      print*,trim(aa)
      end
       subroutine scril2(ifil)
      logical yibm
      parameter(nligne=100)
c      character*500 scr500(10)
      character*80 scr500(nligne)
      character*8000 scr500l
      equivalence (scr500(1),scr500l)
c      character*8000 scr500
      common/sri/ scr500
c      print *, 'entree scril2'
      rewind 75
      read(75,'(a8000)') scr500l
      yibm=.true.
      ii=index(scr500l,'#')
      if(ii.eq.0) yibm=.false.
      if(.not.yibm) then
         rewind 75
         read(75,'(a80)',err=2,end=2) scr500
      endif
  2   continue
      rewind 75
      call scri2(scr500,ifil)
      return
      end
       subroutine scri2(scr,ifil)
      parameter(nligne=100)
      character*1 scr(80*nligne),scr1(80*nligne)
      common/sri/scr1
      k=1
      scr1(1)=scr(1)
      do i=2,8000
c        write(6,*)'SCR',i,'    ',scr(i)
         if(scr(i).eq.'#') goto 1
         if(scr(i).eq.' ') goto2
         k=k+1
c        write(6,*)'k',k
         if(scr(i).eq.'~') then
            scr1(k)=' '
         else
            scr1(k)=scr(i)
         endif
c        write(6,*)'scr(i),scr1(k)',scr(i)
 2       continue
      enddo
c     pas de '#' trouve
      write(6,*)'ecriture formattee sans ''#'' a la fin'
      write(6,*)'scr',(scr(k),k=1,800)
c      return
 1    continue
c      write(6,*)k
      write(ifil,'(80a1)')(scr1(l),l=1,k)
c     write(6,'(80a1)')(scr1(l),l=1,k)
      return
      end
!      subroutine scril
!      parameter(nligne=100)
!      character(80) scr500(nligne)
!      common/sri/ scr500
!      rewind 75
!      read(75,'(a80)',err=2,end=2) scr500
!  2   continue
!      rewind 75
!      call scri(scr500)
!      return
!      end
!       subroutine scri(scr)
!      parameter(nligne=100)
!      character(1) scr(80*nligne),scr1(80*nligne)
!      common/sri/scr1
!      ifil=6
!      k=1
!      scr1(1)=scr(1)
!      do i=2,8000
!c        write(6,*)'SCR',i,'    ',scr(i)
!         if(scr(i).eq.'$') goto 1
!         if(scr(i).eq.' ') then
!            if(scr(i-1).eq.' ') goto 2
!c           write(6,*)'scr(i-1)',scr(i-1)
!         endif
!         k=k+1
!c        write(6,*)'k',k
!         scr1(k)=scr(i)
!c        write(6,*)'scr(i),scr1(k)',scr(i)
! 2       continue
!      enddo
!c     pas de '$' trouve
!      write(6,*)'ecriture formattee sans ''$'' a la fin'
!      return
! 1    continue
!c      write(6,*)k
!      write(6,'(80a1)')(scr1(l),l=1,k)
!      return
!      end
