Directory of image this file is from
This file as a plain text file

C
C     ..................................................................
C
C        SUBROUTINE DATSM
C
C        PURPOSE
C           NDIM POINTS OF A GIVEN TABLE WITH MONOTONIC ARGUMENTS ARE
C           SELECTED AND ORDERED SUCH THAT
C           ABS(ARG(I)-X).GE.ABS(ARG(J)-X) IF I.GT.J.
C
C        USAGE
C           CALL DATSM (X,Z,F,IROW,ICOL,ARG,VAL,NDIM)
C
C        DESCRIPTION OF PARAMETERS
C           X      - DOUBLE PRECISION SEARCH ARGUMENT.
C           Z      - DOUBLE PRECISION VECTOR OF ARGUMENT VALUES (DIMEN-
C                    SION IROW). THE ARGUMENT VALUES MUST BE STORED IN
C                    INCREASING OR DECREASING SEQUENCE.
C           F      - IN CASE ICOL=1, F IS THE DOUBLE PRECISION VECTOR
C                    OF FUNCTION VALUES (DIMENSION IROW).
C                    IN CASE ICOL=2, F IS A DOUBLE PRECISION IROW BY 2
C                    MATRIX. THE FIRST COLUMN SPECIFIES VECTOR OF FUNC-
C                   TION VALUES AND THE SECOND VECTOR OF DERIVATIVES.
C           IROW   - THE DIMENSION OF VECTOR Z AND OF EACH COLUMN
C                    IN MATRIX F.
C           ICOL   - THE NUMBER OF COLUMNS IN F (I.E. 1 OR 2).
C           ARG    - RESULTING DOUBLE PRECISION VECTOR OF SELECTED AND
C                    ORDERED ARGUMENT VALUES (DIMENSION NDIM).
C           VAL    - RESULTING DOUBLE PRECISION VECTOR OF SELECTED
C                    FUNCTION VALUES (DIMENSION NDIM) IN CASE ICOL=1.
C                    IN CASE ICOL=2, VAL IS THE DOUBLE PRECISION VECTOR
C                    OF FUNCTION AND DERIVATIVE VALUES (DIMENSION
C                    2*NDIM) WHICH ARE STORED IN PAIRS (I.E. EACH FUNC-
C                    TION VALUE IS FOLLOWED BY ITS DERIVATIVE VALUE).
C           NDIM   - THE NUMBER OF POINTS WHICH MUST BE SELECTED OUT OF
C                    THE GIVEN TABLE (Z,F).
C
C        REMARKS
C           NO ACTION IN CASE IROW LESS THAN 1.
C           IF INPUT VALUE NDIM IS GREATER THAN IROW, THE PROGRAM
C           SELECTS ONLY A MAXIMUM TABLE OF IROW POINTS.  THEREFORE THE
C           USER OUGHT TO CHECK CORRESPONDENCE BETWEEN TABLE (ARG,VAL)
C           AND ITS DIMENSION BY COMPARISON OF NDIM AND IROW, IN ORDER
C           TO GET CORRECT RESULTS IN FURTHER WORK WITH TABLE (ARG,VAL).
C           THIS TEST MAY BE DONE BEFORE OR AFTER CALLING
C           SUBROUTINE DATSM.
C           SUBROUTINE DATSM ESPECIALLY CAN BE USED FOR GENERATING THE
C           TABLE (ARG,VAL) NEEDED IN SUBROUTINES DALI, DAHI, AND DACFI.
C
C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
C           NONE
C
C        METHOD
C           SELECTION IS DONE BY SEARCHING THE SUBSCRIPT J OF THAT
C           ARGUMENT, WHICH IS NEXT TO X (BINARY SEARCH).
C           AFTERWARDS NEIGHBOURING ARGUMENT VALUES ARE TESTED AND
C           SELECTED IN THE ABOVE SENSE.
C
C     ..................................................................
C
      SUBROUTINE DATSM(X,Z,F,IROW,ICOL,ARG,VAL,NDIM)
C
C
      DIMENSION Z(1),F(1),ARG(1),VAL(1)
      DOUBLE PRECISION X,Z,F,ARG,VAL
C
C     CASE IROW=1 IS CHECKED OUT
      IF(IROW-1)23,21,1
    1 N=NDIM
C
C     IF N IS GREATER THAN IROW, N IS SET EQUAL TO IROW.
      IF(N-IROW)3,3,2
    2 N=IROW
C
C     CASE IROW.GE.2
C     SEARCHING FOR SUBSCRIPT J SUCH THAT Z(J) IS NEXT TO X.
    3 IF(Z(IROW)-Z(1))5,4,4
    4 J=IROW
      I=1
      GOTO 6
    5 I=IROW
      J=1
    6 K=(J+I)/2
      IF(X-Z(K))7,7,8
    7 J=K
      GOTO 9
    8 I=K
    9 IF(IABS(J-I)-1)10,10,6
   10 IF(DABS(Z(J)-X)-DABS(Z(I)-X))12,12,11
   11 J=I
C
C     TABLE SELECTION
   12 K=J
      JL=0
      JR=0
      DO 20 I=1,N
      ARG(I)=Z(K)
      IF(ICOL-1)14,14,13
   13 VAL(2*I-1)=F(K)
      KK=K+IROW
      VAL(2*I)=F(KK)
      GOTO 15
   14 VAL(I)=F(K)
   15 JJR=J+JR
      IF(JJR-IROW)16,18,18
   16 JJL=J-JL
      IF(JJL-1)19,19,17
   17 IF(DABS(Z(JJR+1)-X)-DABS(Z(JJL-1)-X))19,19,18
   18 JL=JL+1
      K=J-JL
      GOTO 20
   19 JR=JR+1
      K=J+JR
   20 CONTINUE
      RETURN
C
C     CASE IROW=1
   21 ARG(1)=Z(1)
      VAL(1)=F(1)
      IF(ICOL-2)23,22,23
   22 VAL(2)=F(2)
   23 RETURN
      END