*...:....1....:....2....:....3....:....4....:....5....:....6....:....7....:....8
      program quinplot
      implicit real*8 (a-h,o-z)
      implicit integer*4 (i-n)
      save

      real*8 time,conc,dose
      real*8 album,glyco
      real*8 tbig,tsmall

      integer*4 form,observ,change,steady
      integer*4 dinter,age,height,weight
      integer*4 race,smoker,lush
      integer*4 heart,creatn
      integer*4 i,j
      integer*4 id0,id0lag,iptr
      integer*4 count,point
      integer*4 repeat

      real*8 pinc

      integer*4 mcols
      integer*4 incrmt,tics

      parameter (pinc=1.d0)
      parameter (mcols=5000)
      parameter (incrmt=50)
      parameter (tics=3)

      dimension time(mcols),conc(mcols),dose(mcols)
      dimension dinter(mcols),age(mcols),height(mcols),weight(mcols)
      dimension album(mcols),glyco(mcols)
      dimension form(mcols),observ(mcols),change(mcols),steady(mcols)
      dimension race(mcols),smoker(mcols),lush(mcols)
      dimension heart(mcols),creatn(mcols)
      dimension count(mcols),point(mcols)

      open (unit=14,file='quin.dat',
     &  status='old',form='formatted')

      open (unit=15,file='quinplot.dat',
     &  status='unknown',form='formatted')

      iptr=1
      count(iptr)=0
      point(iptr)=1
      id0lag=1

      do i=1,mcols

        read(14,14001,end=10)
     &    id0,
     &    time(i),conc(i),dose(i),
     &    form(i),observ(i),change(i),steady(i),
     &    dinter(i),age(i),height(i),weight(i),
     &    race(i),smoker(i),lush(i),
     &    heart(i),creatn(i),
     &    album(i),glyco(i)

        if ((id0lag.eq.id0).or.(i.eq.1)) then
          count(iptr)=count(iptr)+1
        else
          iptr=iptr+1
          count(iptr)=1
          id0lag=id0
          point(iptr)=i
        end if

        repeat=0
        if (count(iptr).ge.2) then
          repeat = (time(i)-time(i-1))/incrmt
          tbig=time(i-1)+dfloat(repeat*incrmt)
          tsmall=time(i)-tics*pinc
          if (tbig.gt.tsmall) then
            repeat=repeat-1
          end if
        end if

        if (repeat.ge.1) then
          do j=1,repeat
            tbig=time(i-1)+dfloat(j*incrmt)
            write(15,14001)
     &        id0,
     &        tbig,0.d0,0.d0,
     &        form(i),1,3,0,
     &        0,age(i),height(i),weight(i),
     &        race(i),smoker(i),lush(i),
     &        heart(i),creatn(i),
     &        album(i),glyco(i)
          end do
        end if

        do j=1,tics
          tsmall=time(i)-(tics-j+1)*pinc
          if ((dose(i).gt.0.d0).and.(time(i-1).lt.tsmall)) then
            write(15,14001)
     &        id0,
     &        tsmall,0.d0,0.d0,
     &        form(i),1,3,0,
     &        0,age(i),height(i),weight(i),
     &        race(i),smoker(i),lush(i),
     &        heart(i),creatn(i),
     &        album(i),glyco(i)
          end if
        end do

        write(15,14001)
     &    id0,
     &    time(i),conc(i),dose(i),
     &    form(i),observ(i),change(i),steady(i),
     &    dinter(i),age(i),height(i),weight(i),
     &    race(i),smoker(i),lush(i),
     &    heart(i),creatn(i),
     &    album(i),glyco(i)

      end do

10    continue
      close(14)
      close(15)
      stop

14001 format(
     &  1x,i3,
     &  1x,f7.2,1x,f3.1,1x,f4.0,
     &  1x,i1,1x,i1,1x,i1,1x,i1,
     &  1x,i2,1x,i2,1x,i2,1x,i3,
     &  1x,i1,1x,i1,1x,i1,
     &  1x,i1,1x,i1,
     &  1x,f3.1,1x,f4.0
     &  )

      end
