Revision ade4b694b3f416d6b195ddcd584d6f89ef36ea2f authored by M. Helena Gon\xe7alves on 28 January 2012, 00:00:00 UTC, committed by Gabor Csardi on 28 January 2012, 00:00:00 UTC
1 parent 8cb2c8d
Raw File
mlik2i.f
C # Calculates the log-likelihood for the second
C# order dependence model

      subroutine mlik2i(logL,pij,npar,n)
      implicit double precision (a-h,o-z)
      DIMENSION x1(4500,10),theta1(4500),
     *work1(4500),y1(4500),lpsi1(2),
     *beta1(10),bt1(10),pij(n),psi(2),tpr(2),tpr1(4),
     *P0(2,2), P1(2,2), P2(2,2),P3(4,4), P4(4,4), P5(4,4), 
     *P6(4,4),Pc(4,1),Pr(2,1),Pr0(4,1),Pr1(2,1),Paux(2,2),
     *Pres(2,2)

      double precision logL,lpsi,lpsi1,pij
      integer y1,i0,i1,i2,npar,n,n0,k,iaux, iaux1, iaux2,
     *m,mpar

      COMMON/param/x1,theta1,work1,
     *y1,lpsi1,beta1,bt1,m,mpar,omega1

      psi(1) = dexp(lpsi1(1))
      psi(2) = dexp(lpsi1(2))
      psi1 = psi(1)
      psi2 = psi(2)
      ps1 = psi1-1
      ps2 = psi2-1

      call mati(x1,beta1,work1,4500,10,1,n,npar)

      do 20 i=1,n
        theta1(i) = 1/(1+dexp(-work1(i)))
   20 continue

      i0 = 1  
   25   if (y1(i0).eq.(-1)) then
      i0=i0+1
      go to 25
      end if

      n0 = n
   30   if (y1(n0).eq.(-1)) then
      n0=n0-1
      go to 30
      end if

      logL = 0
      p  = theta1(i0)
      pij(i0)=p
      logL = y1(i0)*dlog(p/(1-p))+dlog(1-p)
      if (i0.eq.n0) return
      i = i0+1
      i1 = i
   40   if (y1(i1).eq.(-1)) then
      i1=i1+1
      go to 40
      end if

C  i0 is the most recent (past) observation time
C  i1 is the next observation time
      if (i1.eq.i) then
      th1 = theta1(i)
      th2 = theta1(i-1)
      call mcpj(th1,th2,psi1,tpr)
      else 
C    (one or more intermediate missing datum)
      call mat2 (0.0D0,1.0D0,P0)
      do 50 k=(i0+1),i1
        th1 = theta1(k)
        th2 = theta1(k-1)
        call mcpj (th1,th2,psi1,tpr)
        call mat2 (tpr(1),tpr(2),P1)   
        call matp(P0,P1,P2,2,2,2)
        call matc(P2,P0,2,2)
   50 continue
      tpr(1)= P0(1,2)
      tpr(2)= P0(2,2)
      end if
      p=tpr(y1(i0)+1)
      pij(i1)=p
      logL = logL+y1(i1)*dlog(p/(1-p))+dlog(1-p)

      if (i1.eq.n0) return
      i=i1+1
   60 if (i.le.n0) then
      i2 = i
   70   if (y1(i2).eq.(-1)) then
      i2=i2+1
      go to 70
      end if

      if (i2.eq.i.and.i1.eq.(i0+1)) then
        th = theta1(i2)
        th1 = theta1(i1)
        th2 = theta1(i0)
      call mcpij(th,th1,th2,psi1,psi2,tpr1)
        p=tpr1(y1(i0)+2*y1(i1)+1)
        pij(i2)=p
        logL = logL+y1(i2)*dlog(p/(1-p))+dlog(1-p)
        i0=i1
        i1=i2
        i=i1+1

      else if (i1.ne.(i0+1).and.i2.eq.(i1+1)) then
C    (one intermediate missing datum between i0 and i1)
      call mat2 (0.0D0,1.0D0,P0)
      do 75 k=(i0+1),(i1-1)
        th1 = theta1(k)
        th2 = theta1(k-1)
        call mcpj (th1,th2,psi1,tpr)
        call mat2 (tpr(1),tpr(2),P1)   
        call matp(P0,P1,P2,2,2,2)
        call matc(P2,P0,2,2)
   75 continue
        th = theta1(i2)
        th1 = theta1(i1)
        th2 = theta1(i1-1)
        call mcpij (th,th1,th2,psi1,psi2,tpr1)
        Pr(1,1)=tpr1(2*y1(i1)+1)
        Pr(2,1)=tpr1(2*y1(i1)+2)
        call matp(P0,Pr,Pr1,2,2,1)
        p=Pr1(y1(i0)+1,1)
	pij(i2)=p
        logL = logL+y1(i2)*dlog(p/(1-p))+dlog(1-p)
        i0=i1
        i1=i2
        i=i1+1

      else if (i2.ne.(i1+1).and.i2.ne.n0) then
C    (one or more intermediate missing datum between i1 and i2)
      call mat4 (0.0D0,0.0D0,1.0D0,1.0D0,P3)
      call matp (P3,P3,P4,4,4,4)
      do 80 k=(i1+1),i2
        th = theta1(k)
        th1 = theta1(k-1)
        th2 = theta1(k-2)
        call mcpij (th,th1,th2,psi1,psi2,tpr1)
        call mat4 (tpr1(1),tpr1(3),tpr1(2),tpr1(4),P5)
        call matp(P4,P5,P6,4,4,4)
        call matc(P6,P4,4,4)
   80 continue

        i3=i2+1
        th = theta1(i3)
        th1 = theta1(i3-1)
        th2 = theta1(i3-2)
        call mcpij (th,th1,th2,psi1,psi2,tpr1)
        call mat4 (tpr1(1),tpr1(3),tpr1(2),tpr1(4),P5)
        call matp(P4,P5,P6,4,4,4)
        pstar=P6(2*y1(i0)+y1(i1)+1,2*y1(i2)+y1(i3)+1)
	pij(i2)=pstar
        logL = logL+dlog(pstar)
        i0=i2
        i1=i3
        i=i1+1

      else if (i2.ne.(i1+1).and.i2.eq.n0) then
C    (one intermediate missing datum between i1 and i2(last value))
      call mat4 (0.0D0,0.0D0,1.0D0,1.0D0,P3)
      call matp (P3,P3,P4,4,4,4)
      do 90 k=(i1+1),i2
        th = theta1(k)
        th1 = theta1(k-1)
        th2 = theta1(k-2)
        call mcpij (th,th1,th2,psi1,psi2,tpr1)
        call mat4 (tpr1(1),tpr1(3),tpr1(2),tpr1(4),P5)
        call matp(P4,P5,P6,4,4,4)
        call matc(P6,P4,4,4)
   90 continue
        Pc(1,1)=0
        Pc(2,1)=1
        Pc(3,1)=0
        Pc(4,1)=1
        call matp(P4,Pc,Pr0,4,4,1)
        p=Pr0(2*y1(i0)+y1(i1)+1,1)
	pij(i2)=p
        logL = logL+y1(i2)*dlog(p/(1-p))+dlog(1-p)
        i0=i1
        i1=i2
        i=i1+1
       end if
      go to 60
      end if
      return
      end
back to top