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

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

Author: jarioksa
Date: 2011-08-29 16:56:47 +0200 (Mon, 29 Aug 2011)
New Revision: 1772

Modified:
   pkg/vegan/src/decorana.f
   pkg/vegan/src/ordering.f
Log:
R 2.14.0 (under development) r56813 warns on Fortran write

Modified: pkg/vegan/src/decorana.f
===================================================================
--- pkg/vegan/src/decorana.f	2011-08-29 07:36:07 UTC (rev 1771)
+++ pkg/vegan/src/decorana.f	2011-08-29 14:56:47 UTC (rev 1772)
@@ -177,9 +177,9 @@
       double precision xeig1(mi),xeig2(mi),xeig3(mi),aidot(mi),adotj(n)
       double precision qidat(nid)
       integer ibegin(mi),iend(mi),idat(nid),ix1(mi),ix2(mi),ix3(mi)
-c string to print R warnings: this must be long enough to fit format
-c statement 1012
+c strings to print R warnings
       character*64 warning
+      character*2 axnam
       tot=0.0
       do 10 j=1,n
       tot=tot+adotj(j)
@@ -331,9 +331,11 @@
 c R version of the above warning. You must change the length of
 c character*n warning definition if you change the warning text
       if (a12 .gt. tol) then
-         write(warning, 1012) a12, tol, neig+1
- 1012    format("residual", f10.7, " bigger than tolerance", f10.7, 
-     1 " for axis ", i1)
+         if (neig .eq. 0) axnam = "1"
+         if (neig .eq. 1) axnam = "2"
+         if (neig .eq. 2) axnam = "3"
+         if (neig .eq. 3) axnam = "4"
+         warning = "residual bigger than tolerance on axis "//axnam
          call rwarn(warning)
       end if
 c we calculate x from y, and set x to unit length if reciprocal

Modified: pkg/vegan/src/ordering.f
===================================================================
--- pkg/vegan/src/ordering.f	2011-08-29 07:36:07 UTC (rev 1771)
+++ pkg/vegan/src/ordering.f	2011-08-29 14:56:47 UTC (rev 1772)
@@ -93,9 +93,9 @@
 C      Step 6: Normalize the site scores
       call NormTWWS(rowscore,n,newS)
       if(newS.lt.epsilon) then
-         write(*,103) 0
+C         write(*,103) 0
          goto 52
-         endif
+      endif
 C When convergence has been attained, check sign of eigenvalue.
 C If ALL rowscores have changed sign during the last iteration, 
 C this is a negative eigenvalue.