[Stpp-commits] r54 - pkg/src

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

Author: gabriele
Date: 2012-06-04 14:28:50 +0200 (Mon, 04 Jun 2012)
New Revision: 54

Modified:
   pkg/src/stikfunction.f
Log:


Modified: pkg/src/stikfunction.f
===================================================================
--- pkg/src/stikfunction.f	2012-04-26 15:50:04 UTC (rev 53)
+++ pkg/src/stikfunction.f	2012-06-04 12:28:50 UTC (rev 54)
@@ -33,16 +33,25 @@
 
       two=2d0
 
-      do iv=1,nt
-        nv=0
-        do i=1,n
-        if (txy(i).lt.(bsupt-t(iv))) then
-            nv=nv+1
-        end if
-        end do
-        nev(iv)=nv
-      end do
 
+	if (infd.eq.1) then
+      	do iv=1,nt
+        	nv=0
+        	do i=1,n
+        	if (txy(i).lt.(bsupt-t(iv))) then
+            	nv=nv+1
+	        end if	
+      	  end do
+        	nev(iv)=nv
+      	end do
+	end if
+	if (infd.eq.0) then
+      	do iv=1,nt
+        	nev(iv)=n
+      	end do
+	end if
+
+
       do iu=1,ns
       do iv=1,nt
         nv=nev(iv)