home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Frostbyte's 1980s DOS Shareware Collection
/
floppyshareware.zip
/
floppyshareware
/
DOOG
/
PCSSP1.ZIP
/
ITRPAPSM.ZIP
/
DSE13.FOR
< prev
next >
Wrap
Text File
|
1985-11-29
|
2KB
|
72 lines
C
C ..................................................................
C
C SUBROUTINE DSE13
C
C PURPOSE
C TO COMPUTE A VECTOR OF SMOOTHED FUNCTION VALUES GIVEN A
C VECTOR OF FUNCTION VALUES WHOSE ENTRIES CORRESPOND TO
C EQUIDISTANTLY SPACED ARGUMENT VALUES.
C
C USAGE
C CALL DSE13(Y,Z,NDIM,IER)
C
C DESCRIPTION OF PARAMETERS
C Y - GIVEN VECTOR OF DOUBLE PRECISION FUNCTION VALUES
C (DIMENSION NDIM)
C Z - RESULTING VECTOR OF DOUBLE PRECISION SMOOTHED
C FUNCTION VALUES (DIMENSION NDIM)
C NDIM - DIMENSION OF VECTORS Y AND Z
C IER - RESULTING ERROR PARAMETER
C IER = -1 - NDIM IS LESS THAN 3
C IER = 0 - NO ERROR
C
C REMARKS
C (1) IF IER=-1 THERE HAS BEEN NO COMPUTATION.
C (2) Z CAN HAVE THE SAME STORAGE ALLOCATION AS Y. IF Y
C IS DISTINCT FROM Z, THEN IT IS NOT DESTROYED.
C
C SUBROUTINES AND SUBPROGRAMS REQUIRED
C NONE
C
C METHOD
C IF X IS THE (SUPPRESSED) VECTOR OF ARGUMENT VALUES, THEN
C EXCEPT AT THE ENDPOINTS X(1) AND X(NDIM), EACH SMOOTHED
C VALUE Z(I) IS OBTAINED BY EVALUATING AT X(I) THE LEAST-
C SQUARES POLYNOMIAL OF DEGREE 1 RELEVANT TO THE 3 SUCCESSIVE
C POINTS (X(I+K),Y(I+K)) K = -1,0,1. (SEE HILDEBRAND, F.B.,
C INTRODUCTION TO NUMERICAL ANALYSIS, MC GRAW-HILL, NEW YORK/
C TORONTO/LONDON, 1956, PP. 295-302.)
C
C ..................................................................
C
SUBROUTINE DSE13(Y,Z,NDIM,IER)
C
DIMENSION Y(1),Z(1)
DOUBLE PRECISION Y,Z,A,B,C
C
C TEST OF DIMENSION
IF(NDIM-3)3,1,1
C
C PREPARE LOOP
1 B=.16666666666666667D0*(5.D0*Y(1)+Y(2)+Y(2)-Y(3))
C=.16666666666666667*(5.D0*Y(NDIM)+Y(NDIM-1)+Y(NDIM-1)-Y(NDIM-2))
C
C START LOOP
DO 2 I=3,NDIM
A=B
B=.33333333333333333D0*(Y(I-2)+Y(I-1)+Y(I))
2 Z(I-2)=A
C END OF LOOP
C
C UPDATE LAST TWO COMPONENTS
Z(NDIM-1)=B
Z(NDIM)=C
IER=0
RETURN
C
C ERROR EXIT IN CASE NDIM IS LESS THAN 3
3 IER=-1
RETURN
END