
C	Ilkka Karasalo's EULETRAC.FOR mildly adapted by Sven Ivansson 1990
 
C---------------------------------------------------------------
C
C	EULERACC
C	computes the sum of a COMPLEX*16 valued series with slowly 
C	decreasing, oscillating terms 
C	convergence acceleration by the Euler transformation
C
C	Euler's transformation (see DBA, Sec 7.6, Problem 3), is intended 
C	for a series whose n:th term is of the form 
C	          term(n)  =  u(n) * (zosc**n)
C	where  cdabs(zosc) <= 1  (preferably zosc should be close to -1)
C	and  u(n) is smooth
C
C---------------------------------------------------------------

	SUBROUTINE EULERACC (MTOT,TERFUN,ZOSC, NSTA,NEND, KMAX,EPS, 
     $	N,K,SUM, ICWORKLIM0,ICWORKDIM,CWORK)
C	mtot         dimension of vector-valued terms
C	terfun       name of routine such that  
C	             " call terfun (n, term, icworklim0,icworkdim,cwork) "  
C	             returns for given n with  nsta <= n <= nend  
C	                term(1:mtot)    n:th (vector-valued) term in series
C	zosc         base of (the oscillating) geometric factors of the terms
C	nsta,nend    starting value and final value (unless convergence 
C	             occurs before final value is reached) of index n of 
C	             the series,  "nend < nsta"  implies  "nend = +infinity"
C	kmax         max number of columns to be used in the difference 
C	             scheme = 1 + max number of terms in the transformed 
C	             series,  must have  2 <= kmax
C	eps          absolute tolerance (strictly valid under certain 
C	             conditions, see DBA)
C	n            index of last term needed (value of n at last call to 
C	             "terfun")  (output)
C	k            column index in difference table for the accepted 
C	             elements  (output)
C	sum          (mtot-dimensional vector-valued) sum  (output)
C	icworklim0
C	icworkdim
C	cwork(1:icworkdim)   "containing cwork(icworklim0+1,icworkdim)" 
C	                     for user's own work-space  < but note that 
C	                     cwork(1:icworklim0) must not be accessed here >

	IMPLICIT NONE

	INTEGER MTOTDIM, KMAXDIM
	PARAMETER ( MTOTDIM = 550 , KMAXDIM = 40 )

	INTEGER NSTA,NEND, KMAX
	REAL*8 EPS
	COMPLEX*16 ZOSC
	EXTERNAL TERFUN

	INTEGER N, K
	COMPLEX*16 SUM(*)

	INTEGER ICWORKLIM0,ICWORKDIM
	COMPLEX*16 CWORK(*)

	INTEGER MTOT, KCOL, I, KM1
	REAL*8 ZOSCA
	COMPLEX*16 ZEXP, CSLASK, 
     $	TERM(mtotdim), TABLE(mtotdim,kmaxdim), DIFF(mtotdim), 
     $	VOLD(mtotdim)

	IF (MTOT.GT.mtotdim .OR. KMAX.LT.2 .OR. 
     $	KMAX.GT.(kmaxdim+1) ) STOP 111
 
	ZOSCA = CDABS(ZOSC)
	ZEXP = 1.0D0 - ZOSC
	IF (ZEXP.EQ.DCMPLX(0.D0,0.D0)) STOP 222
	ZEXP = 1.0D0/ZEXP     ! zexp := 1/(1-zosc)

	N = NSTA
	CALL TERFUN (N, TERM, ICWORKLIM0,ICWORKDIM,CWORK)
	DO I = 1, MTOT
	  TABLE(I,1) = TERM(I)
	END DO

	KCOL = 2
 
	DO WHILE (N.NE.NEND)    ! loop over terms

	  N = N + 1
	  CALL TERFUN (N, TERM, ICWORKLIM0,ICWORKDIM,CWORK)
	  DO I = 1, MTOT
	    VOLD(I) = TABLE(I,1)
	    TABLE(I,1) = VOLD(I) + TERM(I)
	  END DO
 
	  DO K = 2, KCOL    ! loop over columns
 
	    KM1 = K - 1
	    DO I = 1, MTOT
	      DIFF(I) = ZEXP * (TABLE(I,KM1)-VOLD(I))  ! * "vert diff in col k"
	    END DO
 
	    DO I = 1, MTOT
	      IF ( DMAX1(DABS(DREAL(DIFF(I))),DABS(DIMAG(DIFF(I))))*
     $	      ZOSCA .GT. EPS ) GOTO 11  ! convergence test
	    END DO
	    DO I = 1, MTOT
	      SUM(I) = VOLD(I) + DIFF(I)
	    END DO
	    RETURN

 11	    IF (K.LT.KMAX) THEN
	      DO I = 1, MTOT
	        CSLASK = VOLD(I)
	        VOLD(I) = TABLE(I,K)
	        TABLE(I,K) = CSLASK + DIFF(I)     ! update next column
	      END DO
	    END IF
 
	  END DO   ! end extrapolation loop
 
	  IF (KCOL.LT.KMAX) KCOL = KCOL + 1

	END DO  ! end loop over terms
 
	STOP 66      ! no convergence

	END
