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