      subroutine likftn (nc,nc2,fn,nburst,n,g,o,s,phi,r,a,b,c,d,e,z,sl,
     1 sini,crval,ntrow,tr,sum,ind,storxy,nfixes,iolp)
      double precision g(1), o(1), s(1), phi(1), r(1), a(1), b(1), c(1),
     1 d(1), e(1), z(1), sl(1), sini(1), sum, tot, tr(1)
      integer nfixes, iolp
      real storxy(3,nfixes)
      dimension n(1)
      character*4 yes, no, hit
      data yes /' yes'/, no /'  no'/
c     gamma transpose in g.
c     i - gamma in o.
c     lambda in s.
c     phi in phi.
c     phi inverse in r.
c     lambda inverse in a.
c     mu in z.
      sum=0
      miss=0
      eps=1.e-14
      do 10 i=1,nc2
      d(i)=0
      sini(i)=0
      b(i)=0
      c(i)=0
   10 e(i)=0
      if (ind.eq.1.or.ind.eq.3) then
            call dphead
            write (unit=iolp,fmt=210)
         call linect (2)
      endif
      iobs=0
      do 130 i=1,nburst
      iobs=iobs+1
      call readxy (storxy(1,iobs),o,nc)
      do 20 j=1,nc
      o(j)=o(j)-z(j)
   20 b(j)=b(j)+o(j)
      do 30 j=1,nc
      do 30 k=1,nc
      l=(k-1)*nc+j
   30 sum=sum+a(l)*o(j)*o(k)
      l=0
      do 40 j=1,nc
      do 40 jj=1,nc
      l=l+1
   40 sini(l)=sini(l)+o(j)*o(jj)
      if (ind.eq.1.or.ind.eq.3.and.n(i).ne.0) then
            write (unit=iolp,fmt=220) n(i)
            call linect (4)
      endif
      if (n(i).eq.0) go to 130
      ll=n(i)
      do 120 ij=1,ll
      do 50 k=1,nc
   50 o(nc+k)=0
      do 70 ii=1,nc
      k=(ii-1)*nc
      do 60 jj=1,nc
   60 o(nc+ii)=o(nc+ii)+g(k+jj)*o(jj)
      o(nc+ii)=o(nc+ii)+z(ii)
   70 sl(ii)=o(nc+ii)
c     predicted resides in rhs of o.
      iobs=iobs+1
      call readxy (storxy(1,iobs),o(2*nc+1),nc)
      do 80 ii=1,nc
      o(nc+ii)=o(2*nc+ii)-o(nc+ii)
   80 c(ii)=c(ii)+o(nc+ii)
      tot=0
      do 90 j=1,nc
      do 90 k=1,nc
      l=(k-1)*nc+j
   90 tot=tot+r(l)*o(nc+j)*o(nc+k)
c     write (unit=iolp,fmt=21)tot
      if (tot.gt.crval) miss=miss+1
      hit=no
      if (tot.le.crval) hit=yes
      sum=sum+tot
      l=0
      do 100 j=1,nc
      do 100 jj=1,nc
      l=l+1
      d(l)=d(l)+o(nc+j)*o(nc+jj)
  100 e(l)=e(l)+o(j)*o(nc+jj)
      if (ind.eq.1.or.ind.eq.3) then
         write (unit=iolp,fmt=230) i,ij,(o(2*nc+j),j=1,nc),(sl(j),j=1,nc
     1   ),(o(nc+j),j=1,nc)
         call linect (3)
      endif
      if (ind.eq.1.or.ind.eq.3) then
         write (unit=iolp,fmt=240) nc,tot,hit
         call linect (2)
      endif
c     b contains sum v(0)
c     c contains sum v(j)
c     sini contains v(0)*v(0)
c     d contains v(j)*v(j)
c     e contains v(j)*(z(j-1)-mu)
      do 110 j=1,nc
  110 o(j)=o(2*nc+j)-z(j)
  120 continue
  130 continue
      tot=miss/fn
      if (ind.eq.1.or.ind.eq.3) then
         write (unit=iolp,fmt=250) miss,fn,tot
         call linect (5)
      endif
      call dgmprd (a,b,sl,nc,nc,1)
      call dgmprd (r,c,b,nc,nc,1)
      do 140 j=1,nc
  140 sl(j)=sl(j)+b(j)
      call dgmprd (g,b,c,nc,nc,1)
      do 150 j=1,nc
  150 sl(j)=sl(j)-c(j)
      if (ind.eq.2.or.ind.eq.3) then
         write (unit=iolp,fmt=260) (sl(j),j=1,nc)
         call linect (4+nc/6)
      endif
      call dgmprd (s,g,c,nc,nc,nc)
      call dgmtra (c,b,nc,nc)
      call dgmprd (r,b,c,nc,nc,nc)
      call dgmprd (d,c,sl,nc,nc,nc)
      do 160 j=1,nc2
  160 sl(j)=fn*b(j)+e(j)-sl(j)
      if (ind.eq.2.or.ind.eq.3) then
         write (unit=iolp,fmt=270) (sl(j),j=1,nc2)
         call linect (4+nc/6)
      endif
      call dgmprd (g,r,c,nc,nc,nc)
      call dgmtra (c,b,nc,nc)
      call dgmprd (d,b,e,nc,nc,nc)
      call dgmprd (c,e,sl,nc,nc,nc)
      call dgmprd (g,b,e,nc,nc,nc)
      do 170 j=1,nc2
  170 sl(j)=fn*e(j)-sl(j)
      call dgmprd (r,d,c,nc,nc,nc)
      call dgmprd (c,r,b,nc,nc,nc)
      call dgmprd (a,sini,d,nc,nc,nc)
      call dgmprd (d,a,c,nc,nc,nc)
      do 180 j=1,nc2
  180 sl(j)=sl(j)-float(nburst)*a(j)+c(j)-fn*r(j)+b(j)
      call dgmprd (tr,sl,c,ntrow,nc2,1)
      if (ind.eq.2.or.ind.eq.3) then
         write (unit=iolp,fmt=280) (c(j),j=1,ntrow)
         call linect (4+nc/6)
      endif
      l=0
      do 190 i=1,nc
      k=(i-1)*nc
      do 190 j=1,i
      l=l+1
      b(l)=s(k+j)
  190 c(l)=phi(k+j)
      call dmfsd (b,nc,eps,ier)
      call dmfsd (c,nc,eps,ier)
      sum=-sum/2.
      l=0
      do 200 i=1,nc
      l=l+i
  200 sum=sum-dlog(b(l))-dlog(c(l))
      sum=sum-float(nc)*(fn+float(nburst))*0.918938534
      if (ind.eq.2.or.ind.eq.3) then
            write (unit=iolp,fmt=290) sum
            call linect (2)
      endif
      return
c
  210 format (1h0,'residual analysis'/)
  220 format (1h0,'number of observations =',i5/1h0,'burst','  obs.',5x,
     1 'observed/predicted/residual')
  230 format (1h0,2i5,10f8.2/1h ,10x,8f10.2)
  240 format (12x,'chi-square (',i2,' d.f.) =',f10.3/
     1 12x,'observation in predicted confidence region ?',2x,a4)
  250 format (/1h0,'observation outside of single-step confidence region
     1 ',i6,' times in ',f6.0,' trials'/1h0,'error rate is ',g12.5)
  260 format (/1h0,'likelihood equation for mu'/(1h ,1p6d16.6))
  270 format (/1h0,'likelihood equation for gamma'/(1h ,1p6d16.6))
  280 format (/1h0,'likelihood equation for lambda'/(1h ,1p6d16.8))
  290 format (1h0,'log-likelihood is',g15.8)
      end
