[Genabel-commits] r2051 - pkg/MultiABEL/src

[noreply at r-forge.r-project.org]

Author: shenxia
Date: 2016-03-23 02:12:36 +0100 (Wed, 23 Mar 2016)
New Revision: 2051

Added:
   pkg/MultiABEL/src/MultiSummaryLoopDirect.f90
Log:


Added: pkg/MultiABEL/src/MultiSummaryLoopDirect.f90
===================================================================
--- pkg/MultiABEL/src/MultiSummaryLoopDirect.f90	                        (rev 0)
+++ pkg/MultiABEL/src/MultiSummaryLoopDirect.f90	2016-03-23 01:12:36 UTC (rev 2051)
@@ -0,0 +1,26 @@
+!
+!	MultiSummaryLoopDirect.f90	
+!
+!	Created by Xia Shen on 25/02/16.
+!
+
+subroutine MultiSummaryLoopDirect(k, m, nn, tmat, invR, pil, fstat)
+
+  implicit none
+  integer :: i, j, k, m
+  double precision, dimension(m, m) :: invR
+  double precision, dimension(1, m) :: t
+  double precision, dimension(k) :: nn, pil, fstat
+  double precision, dimension(k, m) :: tmat
+  double precision, dimension(1, 1) :: t2
+  do j = 1, k
+     do i = 1, m
+        t(1,i) = tmat(j,i)
+     end do
+     t2 =  matmul(matmul(t, invR), transpose(t))
+     pil(j) = t2(1,1)
+     fstat(j) = pil(j)*(nn(j) - m - 1)/m/(nn(j) - 1)
+  end do
+
+end subroutine MultiSummaryLoopDirect
+