home *** CD-ROM | disk | FTP | other *** search
/ Frostbyte's 1980s DOS Shareware Collection / floppyshareware.zip / floppyshareware / DOOG / PCSSP1.ZIP / ITRPAPSM.ZIP / DSG13.FOR < prev    next >
Text File  |  1985-11-29  |  3KB  |  81 lines
  1. C
  2. C     ..................................................................
  3. C
  4. C        SUBROUTINE DSG13
  5. C
  6. C        PURPOSE
  7. C           TO COMPUTE A VECTOR OF SMOOTHED FUNCTION VALUES GIVEN
  8. C           VECTORS OF ARGUMENT VALUES AND CORRESPONDING FUNCTION
  9. C           VALUES.
  10. C
  11. C        USAGE
  12. C           CALL DSG13(X,Y,Z,NDIM,IER)
  13. C
  14. C        DESCRIPTION OF PARAMETERS
  15. C           X     -  GIVEN VECTOR OF DOUBLE PRECISION ARGUMENT VALUES
  16. C                    (DIMENSION NDIM)
  17. C           Y     -  GIVEN VECTOR OF DOUBLE PRECISION FUNCTION VALUES
  18. C                    CORRESPONDING TO X (DIMENSION NDIM)
  19. C           Z     -  RESULTING VECTOR OF DOUBLE PRECISION SMOOTHED
  20. C                    FUNCTION VALUES (DIMENSION NDIM)
  21. C           NDIM  -  DIMENSION OF VECTORS X,Y,AND Z
  22. C           IER   -  RESULTING ERROR PARAMETER
  23. C                    IER = -1  - NDIM IS LESS THAN 3
  24. C                    IER =  0  - NO ERROR
  25. C
  26. C        REMARKS
  27. C           (1)  IF IER=-1 THERE HAS BEEN NO COMPUTATION.
  28. C           (2)   Z CAN HAVE THE SAME STORAGE ALLOCATION AS X OR Y.  IF
  29. C                 X OR Y IS DISTINCT FROM Z, THEN IT IS NOT DESTROYED.
  30. C
  31. C        SUBROUTINES AND SUBPROGRAMS REQUIRED
  32. C           NONE
  33. C
  34. C        METHOD
  35. C           EXCEPT AT THE ENDPOINTS X(1) AND X(NDIM), EACH SMOOTHED
  36. C           VALUE Z(I) IS OBTAINED BY EVALUATING AT X(I) THE LEAST-
  37. C           SQUARES POLYNOMIAL OF DEGREE 1 RELEVANT TO THE 3 SUCCESSIVE
  38. C           POINTS (X(I+K),Y(I+K)) K = -1,0,1.(SEE HILDEBRAND, F.B.,
  39. C           INTRODUCTION  TO NUMERICAL ANALYSIS, MC GRAW-HILL, NEW YORK/
  40. C           TORONTO/LONDON, 1956, PP.258-311.)
  41. C
  42. C     ..................................................................
  43. C
  44.       SUBROUTINE DSG13(X,Y,Z,NDIM,IER)
  45. C
  46. C
  47.       DIMENSION X(1),Y(1),Z(1)
  48.       DOUBLE PRECISION X,Y,Z,XM,YM,T1,T2,T3,H
  49. C
  50. C        TEST OF DIMENSION
  51.       IF(NDIM-3)7,1,1
  52. C
  53. C        START LOOP
  54.     1 DO 6 I=3,NDIM
  55.       XM=.33333333333333333D0*(X(I-2)+X(I-1)+X(I))
  56.       YM=.33333333333333333D0*(Y(I-2)+Y(I-1)+Y(I))
  57.       T1=X(I-2)-XM
  58.       T2=X(I-1)-XM
  59.       T3=X(I)-XM
  60.       XM=T1*T1+T2*T2+T3*T3
  61.       IF(XM)3,3,2
  62.     2 XM=(T1*(Y(I-2)-YM)+T2*(Y(I-1)-YM)+T3*(Y(I)-YM))/XM
  63. C
  64. C        CHECK FIRST POINT
  65.     3 IF(I-3)4,4,5
  66.     4 H=XM*T1+YM
  67.     5 Z(I-2)=H
  68.     6 H=XM*T2+YM
  69. C        END OF LOOP
  70. C
  71. C        UPDATE LAST TWO COMPONENTS
  72.       Z(NDIM-1)=H
  73.       Z(NDIM)=XM*T3+YM
  74.       IER=0
  75.       RETURN
  76. C
  77. C        ERROR EXIT IN CASE NDIM IS LESS THAN 3
  78.     7 IER=-1
  79.       RETURN
  80.       END
  81.