home *** CD-ROM | disk | FTP | other *** search
/ Frostbyte's 1980s DOS Shareware Collection / floppyshareware.zip / floppyshareware / DOOG / PCSSP1.ZIP / ITRPAPSM.ZIP / DATSG.FOR < prev    next >
Text File  |  1985-11-29  |  4KB  |  100 lines
  1. C
  2. C     ..................................................................
  3. C
  4. C        SUBROUTINE DATSG
  5. C
  6. C        PURPOSE
  7. C           NDIM POINTS OF A GIVEN GENERAL TABLE ARE SELECTED AND
  8. C           ORDERED SUCH THAT ABS(ARG(I)-X).GE.ABS(ARG(J)-X) IF I.GT.J.
  9. C
  10. C        USAGE
  11. C           CALL DATSG (X,Z,F,WORK,IROW,ICOL,ARG,VAL,NDIM)
  12. C
  13. C        DESCRIPTION OF PARAMETERS
  14. C           X      - DOUBLE PRECISION SEARCH ARGUMENT.
  15. C           Z      - DOUBLE PRECISION VECTOR OD ARGUMENT VALUES
  16. C                    (DIMENSION IROW).
  17. C           F      - IN CASE ICOL=1, F IS THE DOUBLE PRECISION VECTOR
  18. C                    OF FUNCTION VALUES (DIMENSION IROW).
  19. C                    IN CASE ICOL=2, F IS A DOUBLE PRECISION IROW BY 2
  20. C                    MATRIX. THE FIRST COLUMN SPECIFIES VECTOR OF FUNC-
  21. C                    TION VALUES AND THE SECOND VECTOR OF DERIVATIVES.
  22. C           WORK   - DOUBLE PRECISION WORKING STORAGE (DIMENSION IROW).
  23. C           IROW   - THE DIMENSION OF VECTORS Z AND WORK AND OF EACH
  24. C                    COLUMN IN MATRIX F.
  25. C           ICOL   - THE NUMBER OF COLUMNS IN F (I.E. 1 OR 2).
  26. C           ARG    - RESULTING DOUBLE PRECISION VECTOR OF SELECTED AND
  27. C                    ORDERED ARGUMENT VALUES (DIMENSION NDIM).
  28. C           VAL    - RESULTING DOUBLE PRECISION VECTOR OF SELECTED
  29. C                    FUNCTION VALUES (DIMENSION NDIM) IN CASE ICOL=1.
  30. C                    IN CASE ICOL=2, VAL IS THE DOUBLE PRECISION VECTOR
  31. C                    OF FUNCTION AND DERIVATIVE VALUES (DIMENSION
  32. C                    2*NDIM) WHICH ARE STORED IN PAIRS (I.E. EACH FUNC-
  33. C                    TION VALUE IS FOLLOWED BY ITS DERIVATIVE VALUE).
  34. C           NDIM   - THE NUMBER OF POINTS WHICH MUST BE SELECTED OUT OF
  35. C                    THE GIVEN TABLE (Z,F).
  36. C
  37. C        REMARKS
  38. C           NO ACTION IN CASE IROW LESS THAN 1.
  39. C           IF INPUT VALUE NDIM IS GREATER THAN IROW, THE PROGRAM
  40. C           SELECTS ONLY A MAXIMUM TABLE OF IROW POINTS.  THEREFORE THE
  41. C           USER OUGHT TO CHECK CORRESPONDENCE BETWEEN TABLE (ARG,VAL)
  42. C           AND ITS DIMENSION BY COMPARISON OF NDIM AND IROW, IN ORDER
  43. C           TO GET CORRECT RESULTS IN FURTHER WORK WITH TABLE (ARG,VAL).
  44. C           THIS TEST MAY BE DONE BEFORE OR AFTER CALLING
  45. C           SUBROUTINE DATSG.
  46. C           SUBROUTINE DATSG ESPECIALLY CAN BE USED FOR GENERATING THE
  47. C           TABLE (ARG,VAL) NEEDED IN SUBROUTINES DALI, DAHI, AND DACFI.
  48. C
  49. C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
  50. C           NONE
  51. C
  52. C        METHOD
  53. C           SELECTION IS DONE BY GENERATING THE VECTOR WORK WITH
  54. C           COMPONENTS WORK(I)=ABS(Z(I)-X) AND AT EACH OF THE NDIM STEPS
  55. C           (OR IROW STEPS IF NDIM IS GREATER THAN IROW)
  56. C           SEARCHING FOR THE SUBSCRIPT OF THE SMALLEST COMPONENT, WHICH
  57. C           IS AFTERWARDS REPLACED BY A NUMBER GREATER THAN
  58. C           MAX(WORK(I)).
  59. C
  60. C     ..................................................................
  61. C
  62.       SUBROUTINE DATSG(X,Z,F,WORK,IROW,ICOL,ARG,VAL,NDIM)
  63. C
  64. C
  65.       DIMENSION Z(1),F(1),WORK(1),ARG(1),VAL(1)
  66.       DOUBLE PRECISION X,Z,F,WORK,ARG,VAL,B,DELTA
  67.       IF(IROW)11,11,1
  68.     1 N=NDIM
  69. C     IF N IS GREATER THAN IROW, N IS SET EQUAL TO IROW.
  70.       IF(N-IROW)3,3,2
  71.     2 N=IROW
  72. C
  73. C     GENERATION OF VECTOR WORK AND COMPUTATION OF ITS GREATEST ELEMENT.
  74.     3 B=0.D0
  75.       DO 5 I=1,IROW
  76.       DELTA=DABS(Z(I)-X)
  77.       IF(DELTA-B)5,5,4
  78.     4 B=DELTA
  79.     5 WORK(I)=DELTA
  80. C
  81. C     GENERATION OF TABLE (ARG,VAL)
  82.       B=B+1.D0
  83.       DO 10 J=1,N
  84.       DELTA=B
  85.       DO 7 I=1,IROW
  86.       IF(WORK(I)-DELTA)6,7,7
  87.     6 II=I
  88.       DELTA=WORK(I)
  89.     7 CONTINUE
  90.       ARG(J)=Z(II)
  91.       IF(ICOL-1)8,9,8
  92.     8 VAL(2*J-1)=F(II)
  93.       III=II+IROW
  94.       VAL(2*J)=F(III)
  95.       GOTO 10
  96.     9 VAL(J)=F(II)
  97.    10 WORK(II)=B
  98.    11 RETURN
  99.       END
  100.