[Vegan-commits] r1810 - pkg/vegan/src

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

Author: jarioksa
Date: 2011-09-09 11:16:55 +0200 (Fri, 09 Sep 2011)
New Revision: 1810

Modified:
   pkg/vegan/src/monoMDS.f
   pkg/vegan/src/ordering.f
Log:
-Wall -pedantic fixes

Modified: pkg/vegan/src/monoMDS.f
===================================================================
--- pkg/vegan/src/monoMDS.f	2011-09-08 11:13:07 UTC (rev 1809)
+++ pkg/vegan/src/monoMDS.f	2011-09-09 09:16:55 UTC (rev 1810)
@@ -596,9 +596,9 @@
 C
       ELSE
         FACTR1=4.0**COSAV
-        FACTR2=1.6/( (1.0+(MIN(1.0,SRATAV))**5) *
+        FACTR2=1.6/( (1.0+(MIN(1D0,SRATAV))**5) *
      .    (1.0+ACOSAV-ABS(COSAV)) )
-        FACTR3=SQRT(MIN(1.0,SRATIO))
+        FACTR3=SQRT(MIN(1D0,SRATIO))
         STEP=STEP*FACTR1*FACTR2*FACTR3
       ENDIF
       RETURN

Modified: pkg/vegan/src/ordering.f
===================================================================
--- pkg/vegan/src/ordering.f	2011-09-08 11:13:07 UTC (rev 1809)
+++ pkg/vegan/src/ordering.f	2011-09-09 09:16:55 UTC (rev 1810)
@@ -7,8 +7,8 @@
 C We compute the principal coordinate of the first axis only.
 C Set the precision level for eigenvalue estimation
       Integer mat(n,k)
-      Real sumrow(n),sumtot
-      real*8 rowscore(n),colscore(n),toler,epsilon
+      double precision sumrow(n), sumtot
+      double precision rowscore(n),colscore(n),toler,epsilon
       epsilon=0.000001
       toler=  0.000001
       if(n.gt.1000) then
@@ -26,8 +26,8 @@
 
       Subroutine Centre(mat, n, k, sumrow, sumtot)
       Integer mat(n,k)
-      Real d
-      Real sumrow(n),sumtot
+      double precision d
+      double precision sumrow(n),sumtot
       do i=1,n
          sumrow(i)=0.0
          enddo
@@ -56,7 +56,7 @@
 C Compute a simple matching coefficient from a table of K-means results (integers).
 C The 'n' rows are the objects; the 'k' columns are the partitions.
       Integer mat(n,k)
-      Real d
+      double precision d
 C
       a = 0.0
       do kk=1,k
@@ -69,8 +69,8 @@
      +                toler,epsilon)
       Integer n, niter
       Integer mat(n,k)
-      Real sumrow(n),sumtot,d
-      Real*8 rowscore(n),colscore(n),epsilon,oldS,newS,toler,
+      double precision sumrow(n),sumtot,d
+      double precision rowscore(n),colscore(n),epsilon,oldS,newS,toler,
      +       oldrowsc(n)
       niter=1000
 C      Step 2: Take the column order as arbitrary initial site scores
@@ -123,7 +123,7 @@
 C  101 format(' Convergence not reached for axis:',i3/
 C     +       ' Increase NITER or lower TOLER')
 C  102 format(' N. iterations to reach convergence for axis',i3,' =',i4)
-  103 format(' There are',i4,' eigenvalues different from 0')
+C  103 format(' There are',i4,' eigenvalues different from 0')
 C  104 format(' Eigenvector',i3,' is complex [multiply values*Sqrt(-1)]')
 C  105 format(" Tolerance is: ", F12.8, "  NIter is: ", i4)
 
@@ -134,7 +134,7 @@
 
       Subroutine NormTWWS(rowscore,n,newS)
       Integer n
-      Real*8 rowscore(n),s2,newS
+      double precision rowscore(n),s2,newS
 C      Normalization for two-way weighted summation algorithm for PCA
 C      (ter Braak 1987: 123)
 C      On output, vector 'rowscore' has length = 1.