home *** CD-ROM | disk | FTP | other *** search
/ Frostbyte's 1980s DOS Shareware Collection / floppyshareware.zip / floppyshareware / DOOG / PCSSP1.ZIP / ITRPAPSM.ZIP / DATSE.FOR < prev    next >
Text File  |  1985-11-29  |  4KB  |  111 lines
  1. C
  2. C     ..................................................................
  3. C
  4. C        SUBROUTINE DATSE
  5. C
  6. C        PURPOSE
  7. C           NDIM POINTS OF A GIVEN TABLE WITH EQUIDISTANT 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 DATSE (X,ZS,DZ,F,IROW,ICOL,ARG,VAL,NDIM)
  13. C
  14. C        DESCRIPTION OF PARAMETERS
  15. C           X      - DOUBLE PRECISION SEARCH ARGUMENT.
  16. C           ZS     - DOUBLE PRECISION STARTING VALUE OF ARGUMENTS.
  17. C           DZ     - DOUBLE PRECISION INCREMENT OF ARGUMENT VALUES.
  18. C           F      - IN CASE ICOL=1, F IS THE DOUBLE PRECISION VECTOR
  19. C                    OF FUNCTION VALUES (DIMENSION IROW).
  20. C                    IN CASE ICOL=2, F IS A DOUBLE PRECISION IROW BY 2
  21. C                    MATRIX. THE FIRST COLUMN SPECIFIES VECTOR OF FUNC-
  22. C                    TION VALUES AND THE SECOND VECTOR OF DERIVATIVES.
  23. C           IROW   - THE DIMENSION OF EACH COLUMN IN MATRIX F.
  24. C           ICOL   - THE NUMBER OF COLUMNS IN F (I.E. 1 OR 2).
  25. C           ARG    - RESULTING DOUBLE PRECISION VECTOR OF SELECTED AND
  26. C                    ORDERED ARGUMENT VALUES (DIMENSION NDIM).
  27. C           VAL    - RESULTING DOUBLE PRECISION VECTOR OF SELECTED
  28. C                    FUNCTION VALUES (DIMENSION NDIM) IN CASE ICOL=1.
  29. C                    IN CASE ICOL=2, VAL IS THE DOUBLE PRECISION VECTOR
  30. C                    OF FUNCTION AND DERIVATIVE VALUES (DIMENSION
  31. C                    2*NDIM) WHICH ARE STORED IN PAIRS (I.E. EACH FUNC-
  32. C                    TION VALUE IS FOLLOWED BY ITS DERIVATIVE VALUE).
  33. C           NDIM   - THE NUMBER OF POINTS WHICH MUST BE SELECTED OUT OF
  34. C                    THE GIVEN TABLE.
  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 DATSE.
  45. C           SUBROUTINE DATSE ESPECIALLY CAN BE USED FOR GENERATING THE
  46. C           TABLE (ARG,VAL) NEEDED IN SUBROUTINES DALI, DAHI, AND DACFI.
  47. C
  48. C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
  49. C           NONE
  50. C
  51. C        METHOD
  52. C           SELECTION IS DONE BY COMPUTING THE SUBSCRIPT J OF THAT
  53. C           ARGUMENT, WHICH IS NEXT TO X.
  54. C           AFTERWARDS NEIGHBOURING ARGUMENT VALUES ARE TESTED AND
  55. C           SELECTED IN THE ABOVE SENSE.
  56. C
  57. C     ..................................................................
  58. C
  59.       SUBROUTINE DATSE(X,ZS,DZ,F,IROW,ICOL,ARG,VAL,NDIM)
  60. C
  61. C
  62.       DIMENSION F(1),ARG(1),VAL(1)
  63.       DOUBLE PRECISION X,ZS,DZ,F,ARG,VAL
  64.       IF(IROW-1)19,17,1
  65. C
  66. C     CASE DZ=0 IS CHECKED OUT
  67.     1 IF(DZ)2,17,2
  68.     2 N=NDIM
  69. C
  70. C     IF N IS GREATER THAN IROW, N IS SET EQUAL TO IROW.
  71.       IF(N-IROW)4,4,3
  72.     3 N=IROW
  73. C
  74. C     COMPUTATION OF STARTING SUBSCRIPT J.
  75.     4 J=(X-ZS)/DZ+1.5D0
  76.       IF(J)5,5,6
  77.     5 J=1
  78.     6 IF(J-IROW)8,8,7
  79.     7 J=IROW
  80. C
  81. C     GENERATION OF TABLE ARG,VAL IN CASE DZ.NE.0.
  82.     8 II=J
  83.       JL=0
  84.       JR=0
  85.       DO 16 I=1,N
  86.       ARG(I)=ZS+DFLOAT(II-1)*DZ
  87.       IF(ICOL-2)9,10,10
  88.     9 VAL(I)=F(II)
  89.       GOTO 11
  90.    10 VAL(2*I-1)=F(II)
  91.       III=II+IROW
  92.       VAL(2*I)=F(III)
  93.    11 IF(J+JR-IROW)12,15,12
  94.    12 IF(J-JL-1)13,14,13
  95.    13 IF((ARG(I)-X)*DZ)14,15,15
  96.    14 JR=JR+1
  97.       II=J+JR
  98.       GOTO 16
  99.    15 JL=JL+1
  100.       II=J-JL
  101.    16 CONTINUE
  102.       RETURN
  103. C
  104. C     CASE DZ=0
  105.    17 ARG(1)=ZS
  106.       VAL(1)=F(1)
  107.       IF(ICOL-2)19,19,18
  108.    18 VAL(2)=F(2)
  109.    19 RETURN
  110.       END
  111.