
C	subroutine for rpress.f

C	Sven Ivansson 1990




	SUBROUTINE TERFUN ( N, TERM, ICWORKLIM0,ICWORKDIM,CWORK )
C	must be called initially (outside euleracc) with n=-1

	USE INMODELa
	USE INRANGEa
	USE INTWORKa

	IMPLICIT NONE

	INCLUDE 'RPPARAMETER.INC'
C       nol <= noldim , nhyd <= nhyddim , li <= lidim , 

	INCLUDE 'INPINT.INC'
	INCLUDE 'INTAIL.INC'
	INCLUDE 'INTWORK.INC'

	INTEGER N

	COMPLEX*16 TERM(*)

	INTEGER ICWORKLIM0,ICWORKDIM
	COMPLEX*16 CWORK(*)

	INTEGER IH, NKVAR, NFCAL, ISLASK
	REAL*8 SLASK
	COMPLEX*16 CSLASK, UPHTAIL(2)
	COMPLEX*16, DIMENSION(:), ALLOCATABLE :: OLDCOS
	LOGICAL DIMDONE
	EXTERNAL DHCOMP, R1COMP,R1COMPPOS
	SAVE OLDCOS

	SAVE DIMDONE
	DATA DIMDONE /.FALSE./

	IF (NHYD.GT.nhyddim) STOP '%%% terfun, nhyddim'
	IF (.NOT.DIMDONE) THEN
	  ALLOCATE ( OLDCOS(nhyddim) )
	  DIMDONE = .TRUE.
	END IF
	IF (N.GE.0) THEN
	  DO IH = 1, NHYD
	    ISLASK = 2*IH
	    TERM(ISLASK-1) = OLDCOS(IH)
	    TERM(ISLASK) = (0.0D0,0.0D0)
	  END DO
	  IF (IT.EQ.1) THEN
	    UPHTAIL(1) = UPH1AS + N*UPPID
	    UPHTAIL(2) = UPHTAIL(1) + UPPIDH
	    TEXTLOG(9:12) = 'righ'
	  ELSE
	    UPHTAIL(2) = UPH1AS - N*UPPID
	    UPHTAIL(1) = UPHTAIL(2) - UPPIDH
	    TEXTLOG(9:12) = 'left'
	  END IF
	  IF (IADINTXFI.EQ.0) THEN
	    CALL TRAPEZFI (NHYD,2, DHCOMP,R1COMP, IFILON,
     $	    R1COMPPOS,GAMMAS, 2,UPHTAIL, HMAXAS, NHYD2,TERM, 
     $	    NFCAL, DHFAKT,RFAKT, ICWORKLIM0,ICWORKDIM,CWORK)
	  ELSE
	    CALL ADINTXFI (NHYD,2, DHCOMP,R1COMP, IFILON,
     $	    R1COMPPOS,GAMMAS, 2,UPHTAIL, HMAXAS,SMAXPRE,0.0D0,EPSAS,
     $	    NELMAXPRE,NBACKMAX, IXTYP,NRUS,IRUS,JRUS, ARGDIFLIM1,
     $	    ARGDIFLIM0,ARGDIFLIM2, 0.0D0,0,NKVAR, IADTAILLOG,TEXTLOG, 
     $	    NHYD2,TERM, SLASK, NFCAL, DHFAKT,RFAKT, 
     $	    ICWORKLIM0,ICWORKDIM,CWORK)
	  END IF
	  IF (IT.EQ.1) THEN
	    NFCALLS(5) = NFCALLS(5) + NFCAL
	  ELSE
	    NFCALLS(6) = NFCALLS(6) + NFCAL
	  END IF
	  DO IH = 1, NHYD
	    ISLASK = 2*IH-1
	    OLDCOS(IH) = TERM(ISLASK)       ! temporary storage
	    TERM(ISLASK) = (0.0D0,0.0D0)
	  END DO
	ELSE
	  IF (N.NE.-1) STOP 741
	  DO IH = 1, NHYD2
	    TERM(IH) = (0.0D0,0.0D0)
	  END DO
	END IF

	IF (IT.EQ.1) THEN
	  UPHTAIL(1) = UPH1AS + (N+0.5D0)*UPPID  ! uph0as if n=-1
	  UPHTAIL(2) = UPHTAIL(1) + UPPIDH       ! uph1as if n=-1
	  TEXTLOG(9:12) = 'righ'
	ELSE
	  UPHTAIL(2) = UPH1AS - (N+0.5D0)*UPPID  ! uph0as if n=-1
	  UPHTAIL(1) = UPHTAIL(2) - UPPIDH       ! uph1as if n=-1
	  TEXTLOG(9:12) = 'left'
	END IF
	IF (IADINTXFI.EQ.0) THEN
	  CALL TRAPEZFI (NHYD,2, DHCOMP,R1COMP, IFILON,
     $	  R1COMPPOS,GAMMAS, 2,UPHTAIL, HMAXAS, NHYD2,TERM, 
     $	  NFCAL, DHFAKT,RFAKT, ICWORKLIM0,ICWORKDIM,CWORK)
	ELSE
	  CALL ADINTXFI (NHYD,2, DHCOMP,R1COMP, IFILON,
     $	  R1COMPPOS,GAMMAS, 2,UPHTAIL, HMAXAS,SMAXPRE,0.0D0,EPSAS,
     $	  NELMAXPRE,NBACKMAX, IXTYP,NRUS,IRUS,JRUS, ARGDIFLIM1,
     $	  ARGDIFLIM0,ARGDIFLIM2, 0.0D0,0,NKVAR, IADTAILLOG,TEXTLOG, 
     $	  NHYD2,TERM, SLASK, NFCAL, DHFAKT,RFAKT, 
     $	  ICWORKLIM0,ICWORKDIM,CWORK)
	END IF
	IF (IT.EQ.1) THEN
	  NFCALLS(5) = NFCALLS(5) + NFCAL
	ELSE
	  NFCALLS(6) = NFCALLS(6) + NFCAL
	END IF

	IF (N.GE.0) THEN
	  DO IH = 1, NHYD
	    ISLASK = 2*IH-1
	    CSLASK = TERM(ISLASK)
	    TERM(ISLASK) = OLDCOS(IH)
	    OLDCOS(IH) = CSLASK
	  END DO
	ELSE
	  DO IH = 1, NHYD
	    OLDCOS(IH) = TERM(2*IH-1)
	  END DO
	END IF

	RETURN
	END

