home *** CD-ROM | disk | FTP | other *** search
/ Frostbyte's 1980s DOS Shareware Collection / floppyshareware.zip / floppyshareware / DOOG / PCSSP1.ZIP / ITRPAPSM.ZIP / ATSM.FOR < prev    next >
Text File  |  1985-11-29  |  4KB  |  123 lines
  1. C
  2. C     ..................................................................
  3. C
  4. C        SUBROUTINE ATSM
  5. C
  6. C        PURPOSE
  7. C           NDIM POINTS OF A GIVEN TABLE WITH MONOTONIC ARGUMENTS ARE
  8. C           SELECTED AND ORDERED SUCH THAT
  9. C           ABS(ARG(I)-X).GE.ABS(ARG(J)-X) IF I.GT.J.
  10. C
  11. C        USAGE
  12. C           CALL ATSM (X,Z,F,IROW,ICOL,ARG,VAL,NDIM)
  13. C
  14. C        DESCRIPTION OF PARAMETERS
  15. C           X      - THE SEARCH ARGUMENT.
  16. C           Z      - THE VECTOR OF ARGUMENT VALUES (DIMENSION IROW).
  17. C                    THE ARGUMENT VALUES MUST BE STORED IN INCREASING
  18. C                    OR DECREASING SEQUENCE.
  19. C           F      - IN CASE ICOL=1, F IS THE VECTOR OF FUNCTION VALUES
  20. C                    (DIMENSION IROW).
  21. C                    IN CASE ICOL=2, F IS AN IROW BY 2 MATRIX. THE FIRST
  22. C                    COLUMN SPECIFIES THE VECTOR OF FUNCTION VALUES AND
  23. C                    THE SECOND THE VECTOR OF DERIVATIVES.
  24. C           IROW   - THE DIMENSION OF VECTOR Z AND OF EACH COLUMN
  25. C                    IN MATRIX F.
  26. C           ICOL   - THE NUMBER OF COLUMNS IN F (I.E. 1 OR 2).
  27. C           ARG    - THE RESULTING VECTOR OF SELECTED AND ORDERED
  28. C                    ARGUMENT VALUES (DIMENSION NDIM).
  29. C           VAL    - THE RESULTING VECTOR OF SELECTED FUNCTION VALUES
  30. C                    (DIMENSION NDIM) IN CASE ICOL=1. IN CASE ICOL=2,
  31. C                    VAL IS THE VECTOR OF FUNCTION AND DERIVATIVE VALUES
  32. C                    (DIMENSION 2*NDIM) WHICH ARE STORED IN PAIRS (I.E.
  33. C                    EACH FUNCTION VALUE IS FOLLOWED BY ITS DERIVATIVE
  34. C                    VALUE).
  35. C           NDIM   - THE NUMBER OF POINTS WHICH MUST BE SELECTED OUT OF
  36. C                    THE GIVEN TABLE (Z,F).
  37. C
  38. C        REMARKS
  39. C           NO ACTION IN CASE IROW LESS THAN 1.
  40. C           IF INPUT VALUE NDIM IS GREATER THAN IROW, THE PROGRAM
  41. C           SELECTS ONLY A MAXIMUM TABLE OF IROW POINTS.  THEREFORE THE
  42. C           USER OUGHT TO CHECK CORRESPONDENCE BETWEEN TABLE (ARG,VAL)
  43. C           AND ITS DIMENSION BY COMPARISON OF NDIM AND IROW, IN ORDER
  44. C           TO GET CORRECT RESULTS IN FURTHER WORK WITH TABLE (ARG,VAL).
  45. C           THIS TEST MAY BE DONE BEFORE OR AFTER CALLING
  46. C           SUBROUTINE ATSM.
  47. C           SUBROUTINE ATSM ESPECIALLY CAN BE USED FOR GENERATING THE
  48. C           TABLE (ARG,VAL) NEEDED IN SUBROUTINES ALI, AHI, AND ACFI.
  49. C
  50. C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
  51. C           NONE
  52. C
  53. C        METHOD
  54. C           SELECTION IS DONE BY SEARCHING THE SUBSCRIPT J OF THAT
  55. C           ARGUMENT, WHICH IS NEXT TO X (BINARY SEARCH).
  56. C           AFTERWARDS NEIGHBOURING ARGUMENT VALUES ARE TESTED AND
  57. C           SELECTED IN THE ABOVE SENSE.
  58. C
  59. C     ..................................................................
  60. C
  61.       SUBROUTINE ATSM(X,Z,F,IROW,ICOL,ARG,VAL,NDIM)
  62. C
  63. C
  64.       DIMENSION Z(1),F(1),ARG(1),VAL(1)
  65. C
  66. C     CASE IROW=1 IS CHECKED OUT
  67.       IF(IROW-1)23,21,1
  68.     1 N=NDIM
  69. C
  70. C     IF N IS GREATER THAN IROW, N IS SET EQUAL TO IROW.
  71.       IF(N-IROW)3,3,2
  72.     2 N=IROW
  73. C
  74. C     CASE IROW.GE.2
  75. C     SEARCHING FOR SUBSCRIPT J SUCH THAT Z(J) IS NEXT TO X.
  76.     3 IF(Z(IROW)-Z(1))5,4,4
  77.     4 J=IROW
  78.       I=1
  79.       GOTO 6
  80.     5 I=IROW
  81.       J=1
  82.     6 K=(J+I)/2
  83.       IF(X-Z(K))7,7,8
  84.     7 J=K
  85.       GOTO 9
  86.     8 I=K
  87.     9 IF(IABS(J-I)-1)10,10,6
  88.    10 IF(ABS(Z(J)-X)-ABS(Z(I)-X))12,12,11
  89.    11 J=I
  90. C
  91. C     TABLE SELECTION
  92.    12 K=J
  93.       JL=0
  94.       JR=0
  95.       DO 20 I=1,N
  96.       ARG(I)=Z(K)
  97.       IF(ICOL-1)14,14,13
  98.    13 VAL(2*I-1)=F(K)
  99.       KK=K+IROW
  100.       VAL(2*I)=F(KK)
  101.       GOTO 15
  102.    14 VAL(I)=F(K)
  103.    15 JJR=J+JR
  104.       IF(JJR-IROW)16,18,18
  105.    16 JJL=J-JL
  106.       IF(JJL-1)19,19,17
  107.    17 IF(ABS(Z(JJR+1)-X)-ABS(Z(JJL-1)-X))19,19,18
  108.    18 JL=JL+1
  109.       K=J-JL
  110.       GOTO 20
  111.    19 JR=JR+1
  112.       K=J+JR
  113.    20 CONTINUE
  114.       RETURN
  115. C
  116. C     CASE IROW=1
  117.    21 ARG(1)=Z(1)
  118.       VAL(1)=F(1)
  119.       IF(ICOL-2)23,22,23
  120.    22 VAL(2)=F(2)
  121.    23 RETURN
  122.       END
  123.