Mercurial > hg > octave-max
changeset 3135:267b3a5c6b28
[project @ 1998-02-01 18:43:51 by jwe]
| author | jwe |
|---|---|
| date | Sun, 01 Feb 1998 18:43:51 +0000 |
| parents | 8bf70ba446d0 |
| children | af7ec9d3a5e6 |
| files | libcruft/quadpack/dqagi.f libcruft/quadpack/dqagie.f libcruft/quadpack/dqagp.f libcruft/quadpack/dqagpe.f libcruft/quadpack/dqk15i.f libcruft/quadpack/dqk21.f |
| diffstat | 6 files changed, 20 insertions(+), 26 deletions(-) [+] |
line wrap: on
line diff
--- a/libcruft/quadpack/dqagi.f +++ b/libcruft/quadpack/dqagi.f @@ -22,8 +22,7 @@ C C PARAMETERS C ON ENTRY -C F - DOUBLE PRECISION -C FUNCTION SUBPROGRAM DEFINING THE INTEGRAND +C F - SUBROUTINE F(X,RESULT) DEFINING THE INTEGRAND C FUNCTION F(X). THE ACTUAL NAME FOR F NEEDS TO BE C DECLARED E X T E R N A L IN THE DRIVER PROGRAM. C @@ -156,7 +155,7 @@ C***ROUTINES CALLED DQAGIE,XERROR C***END PROLOGUE DQAGI C - DOUBLE PRECISION ABSERR,BOUND,EPSABS,EPSREL,F,RESULT,WORK + DOUBLE PRECISION ABSERR,BOUND,EPSABS,EPSREL,RESULT,WORK INTEGER IER,INF,IWORK,LAST,LENW,LIMIT,LVL,L1,L2,L3,NEVAL C DIMENSION IWORK(LIMIT),WORK(LENW)
--- a/libcruft/quadpack/dqagie.f +++ b/libcruft/quadpack/dqagie.f @@ -20,8 +20,7 @@ C INTEGRATION OVER INFINITE INTERVALS C STANDARD FORTRAN SUBROUTINE C -C F - DOUBLE PRECISION -C FUNCTION SUBPROGRAM DEFINING THE INTEGRAND +C F - SUBROUTINE F(X,IERR,RESULT) DEFINING THE INTEGRAND C FUNCTION F(X). THE ACTUAL NAME FOR F NEEDS TO BE C DECLARED E X T E R N A L IN THE DRIVER PROGRAM. C @@ -153,7 +152,7 @@ DOUBLE PRECISION ABSEPS,ABSERR,ALIST,AREA,AREA1,AREA12,AREA2,A1, * A2,BLIST,BOUN,BOUND,B1,B2,CORREC,DABS,DEFABS,DEFAB1,DEFAB2, * DMAX1,DRES,D1MACH,ELIST,EPMACH,EPSABS,EPSREL,ERLARG,ERLAST, - * ERRBND,ERRMAX,ERROR1,ERROR2,ERRO12,ERRSUM,ERTEST,F,OFLOW,RESABS, + * ERRBND,ERRMAX,ERROR1,ERROR2,ERRO12,ERRSUM,ERTEST,OFLOW,RESABS, * RESEPS,RESULT,RES3LA,RLIST,RLIST2,SMALL,UFLOW INTEGER ID,IER,IERRO,INF,IORD,IROFF1,IROFF2,IROFF3,JUPBND,K,KSGN, * KTMIN,LAST,LIMIT,MAXERR,NEVAL,NRES,NRMAX,NUMRL2
--- a/libcruft/quadpack/dqagp.f +++ b/libcruft/quadpack/dqagp.f @@ -23,8 +23,7 @@ C C PARAMETERS C ON ENTRY -C F - DOUBLE PRECISION -C FUNCTION SUBPROGRAM DEFINING THE INTEGRAND +C F - SUBROUTINE F(X,IERR,RESULT) DEFINING THE INTEGRAND C FUNCTION F(X). THE ACTUAL NAME FOR F NEEDS TO BE C DECLARED E X T E R N A L IN THE DRIVER PROGRAM. C
--- a/libcruft/quadpack/dqagpe.f +++ b/libcruft/quadpack/dqagpe.f @@ -24,8 +24,7 @@ C C PARAMETERS C ON ENTRY -C F - DOUBLE PRECISION -C FUNCTION SUBPROGRAM DEFINING THE INTEGRAND +C F - SUBROUTINE F(X,IERR,RESULT) DEFINING THE INTEGRAND C FUNCTION F(X). THE ACTUAL NAME FOR F NEEDS TO BE C DECLARED E X T E R N A L IN THE DRIVER PROGRAM. C @@ -193,7 +192,7 @@ DOUBLE PRECISION A,ABSEPS,ABSERR,ALIST,AREA,AREA1,AREA12,AREA2,A1, * A2,B,BLIST,B1,B2,CORREC,DABS,DEFABS,DEFAB1,DEFAB2,DMAX1,DMIN1, * DRES,D1MACH,ELIST,EPMACH,EPSABS,EPSREL,ERLARG,ERLAST,ERRBND, - * ERRMAX,ERROR1,ERRO12,ERROR2,ERRSUM,ERTEST,F,OFLOW,POINTS,PTS, + * ERRMAX,ERROR1,ERRO12,ERROR2,ERRSUM,ERTEST,OFLOW,POINTS,PTS, * RESA,RESABS,RESEPS,RESULT,RES3LA,RLIST,RLIST2,SIGN,TEMP,UFLOW INTEGER I,ID,IER,IERRO,IND1,IND2,IORD,IP1,IROFF1,IROFF2,IROFF3,J, * JLOW,JUPBND,K,KSGN,KTMIN,LAST,LEVCUR,LEVEL,LEVMAX,LIMIT,MAXERR,
--- a/libcruft/quadpack/dqk15i.f +++ b/libcruft/quadpack/dqk15i.f @@ -20,8 +20,7 @@ C C PARAMETERS C ON ENTRY -C F - DOUBLE PRECISION -C FUCTION SUBPROGRAM DEFINING THE INTEGRAND +C F - SUBROUTINE F(X,IERR,RESULT) DEFINING THE INTEGRAND C FUNCTION F(X). THE ACTUAL NAME FOR F NEEDS TO BE C DECLARED E X T E R N A L IN THE CALLING PROGRAM. C @@ -151,10 +150,10 @@ HLGTH = 0.5D+00*(B-A) TABSC1 = BOUN+DINF*(0.1D+01-CENTR)/CENTR IERR = 0 - FVAL1 = F(TABSC1,IERR) + CALL F(TABSC1,IERR,FVAL1) IF (IERR .LT. 0) RETURN IF(INF.EQ.2) THEN - FVALT = F(-TABSC1,IERR) + CALL F(-TABSC1,IERR,FVALT) IF (IERR .LT. 0) RETURN FVAL1 = FVAL1+FVALT ENDIF @@ -172,17 +171,17 @@ ABSC2 = CENTR+ABSC TABSC1 = BOUN+DINF*(0.1D+01-ABSC1)/ABSC1 TABSC2 = BOUN+DINF*(0.1D+01-ABSC2)/ABSC2 - FVAL1 = F(TABSC1,IERR) + CALL F(TABSC1,IERR,FVAL1) IF (IERR .LT. 0) RETURN - FVAL2 = F(TABSC2,IERR) + CALL F(TABSC2,IERR,FVAL2) IF (IERR .LT. 0) RETURN IF(INF.EQ.2) THEN - FVALT = F(-TABSC1,IERR) + CALL F(-TABSC1,IERR,FVALT) IF (IERR .LT. 0) RETURN FVAL1 = FVAL1+FVALT ENDIF IF(INF.EQ.2) THEN - FVALT = F(-TABSC2,IERR) + CALL F(-TABSC2,IERR,FVALT) IF (IERR .LT. 0) RETURN FVAL2 = FVAL2+FVALT ENDIF
--- a/libcruft/quadpack/dqk21.f +++ b/libcruft/quadpack/dqk21.f @@ -17,8 +17,7 @@ C C PARAMETERS C ON ENTRY -C F - DOUBLE PRECISION -C FUNCTION SUBPROGRAM DEFINING THE INTEGRAND +C F - SUBROUTINE F(X,IERR,RESULT) DEFINING THE INTEGRAND C FUNCTION F(X). THE ACTUAL NAME FOR F NEEDS TO BE C DECLARED E X T E R N A L IN THE DRIVER PROGRAM. C @@ -140,16 +139,16 @@ C RESG = 0.0D+00 IERR = 0 - FC = F(CENTR,IERR) + CALL F (CENTR,IERR,FC) IF (IERR .LT. 0) RETURN RESK = WGK(11)*FC RESABS = DABS(RESK) DO 10 J=1,5 JTW = 2*J ABSC = HLGTH*XGK(JTW) - FVAL1 = F(CENTR-ABSC,IERR) + CALL F(CENTR-ABSC,IERR,FVAL1) IF (IERR .LT. 0) RETURN - FVAL2 = F(CENTR+ABSC,IERR) + CALL F(CENTR+ABSC,IERR,FVAL2) IF (IERR .LT. 0) RETURN FV1(JTW) = FVAL1 FV2(JTW) = FVAL2 @@ -161,9 +160,9 @@ DO 15 J = 1,5 JTWM1 = 2*J-1 ABSC = HLGTH*XGK(JTWM1) - FVAL1 = F(CENTR-ABSC,IERR) + CALL F(CENTR-ABSC,IERR,FVAL1) IF (IERR .LT. 0) RETURN - FVAL2 = F(CENTR+ABSC,IERR) + CALL F(CENTR+ABSC,IERR,FVAL2) IF (IERR .LT. 0) RETURN FV1(JTWM1) = FVAL1 FV2(JTWM1) = FVAL2