Moved some function parameters into a common block to reduce the size of the

argument list. Now it compiles again with the Portland compiler.


git-svn-id: http://svn.einsteintoolkit.org/cactus/EinsteinAnalysis/AHFinder/trunk@241 89daf98e-ef62-4674-b946-b8ff9de2216c

1 files changed, 17 insertions, 23 deletions

diff --git a/src/AHFinder_pow.F b/src/AHFinder_pow.F
index 505ef79..702978d 100644
--- a/src/AHFinder_pow.F
+++ b/src/AHFinder_pow.F
@@ -25,6 +25,9 @@
 
       CCTK_REAL, allocatable, dimension(:) :: PCOM,XICOM
 
+      CCTK_REAL XMIN
+      logical error
+
 
 !     ***************
 !     ***   END   ***
@@ -227,13 +230,11 @@
 
       DECLARE_CCTK_ARGUMENTS
 
-      logical error
-
       integer i,j,N
       integer l,m
 
       CCTK_REAL XA,XB,XX,FA,FB,FX
-      CCTK_REAL FRET,PARABOLA,XMIN,TOL
+      CCTK_REAL FRET,PARABOLA,TOL
       CCTK_REAL zero
       CCTK_REAL dx,dy,dz
 
@@ -278,25 +279,25 @@
 
 !     Check if function is constant.
 
-      if ((FA.eq.FX).and.(FB.eq.FX)) goto 10
+      if ((FA.ne.FX).or.(FB.ne.FX)) then
 
-!     Call 1D minimization.
+!        Call 1D minimization.
 
-      FRET = PARABOLA(CCTK_ARGUMENTS,XA,XX,XB,FA,FX,FB,F1DIM,TOL,XMIN,error)
+         FRET = PARABOLA(CCTK_ARGUMENTS,XA,XX,XB,FA,FX,FB,F1DIM,TOL)
 
-!     Construct the vector results to return.
+!        Construct the vector results to return.
 
-      do j=1,N
-         XI(j) = XMIN*XI(j)
-         P(j)  = P(j) + XI(j)
-      end do
+         XI = XMIN*XI
+         P  = P + XI
+
+      end if
 
       
 !     ******************************
 !     ***   DEALLOCATE STORAGE   ***
 !     ******************************
 
- 10   deallocate(PCOM,XICOM)
+      deallocate(PCOM,XICOM)
 
 
 !     ***************
@@ -524,7 +525,7 @@
 
 
       CCTK_REAL function PARABOLA(CCTK_ARGUMENTS,XA,XB,XC,FXA,FXB,FXC,
-     .  FUNC,TOL,XMIN,error)
+     .  FUNC,TOL)
 
 !     Given a function F, and given a bracketing triplet of abscissas
 !     XA, XB, XC (such that XB is between XA and XC, and F(XB) is less
@@ -534,15 +535,15 @@
 !     and the minimum function value is returned as PARABOLA, the
 !     returned function value.
 
+      use F1COM
+
       implicit none
 
       DECLARE_CCTK_ARGUMENTS
 
-      logical error
-
       integer ITER,ITMAX
 
-      CCTK_REAL XA,XB,XC,FXA,FXB,FXC,FUNC,TOL,XMIN
+      CCTK_REAL XA,XB,XC,FXA,FXB,FXC,FUNC,TOL
       CCTK_REAL A,B,D,P,Q,S,U,XX,XM,TOL1
       CCTK_REAL FA,FB,FU,FX,FP,ZEPS
 
@@ -1085,10 +1086,3 @@
 !     ***************
 
       end function FUNC
-
-
-
-
-
-
-