File ATSE.FT (FORTRAN source file)

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

C
C     ..................................................................
C
C        SUBROUTINE ATSE
C
C        PURPOSE
C           NDIM POINTS OF A GIVEN TABLE WITH EQUIDISTANT 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 ATSE (X,ZS,DZ,F,IROW,ICOL,ARG,VAL,NDIM)
C
C        DESCRIPTION OF PARAMETERS
C           X      - THE SEARCH ARGUMENT.
C           ZS     - THE STARTING VALUE OF ARGUMENTS.
C           DZ     - THE INCREMENT OF ARGUMENT VALUES.
C           F      - IN CASE ICOL=1, F IS THE VECTOR OF FUNCTION VALUES
C                    (DIMENSION IROW).
C                    IN CASE ICOL=2, F IS AN IROW BY 2 MATRIX. THE FIRST
C                    COLUMN SPECIFIES THE VECTOR OF FUNCTION VALUES AND
C                    THE SECOND THE VECTOR OF DERIVATIVES.
C           IROW   - THE DIMENSION OF EACH COLUMN IN MATRIX F.
C           ICOL   - THE NUMBER OF COLUMNS IN F (I.E. 1 OR 2).
C           ARG    - THE RESULTING VECTOR OF SELECTED AND ORDERED
C                    ARGUMENT VALUES (DIMENSION NDIM).
C           VAL    - THE RESULTING VECTOR OF SELECTED FUNCTION VALUES
C                    (DIMENSION NDIM) IN CASE ICOL=1. IN CASE ICOL=2,
C                    VAL IS THE VECTOR OF FUNCTION AND DERIVATIVE VALUES
C                    (DIMENSION 2*NDIM) WHICH ARE STORED IN PAIRS (I.E.
C                    EACH FUNCTION VALUE IS FOLLOWED BY ITS DERIVATIVE
C                    VALUE).
C           NDIM   - THE NUMBER OF POINTS WHICH MUST BE SELECTED OUT OF
C                    THE GIVEN TABLE.
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 ATSE.
C           SUBROUTINE ATSE ESPECIALLY CAN BE USED FOR GENERATING THE
C           TABLE (ARG,VAL) NEEDED IN SUBROUTINES ALI, AHI, AND ACFI.
C
C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
C           NONE
C
C        METHOD
C           SELECTION IS DONE BY COMPUTING THE SUBSCRIPT J OF THAT
C           ARGUMENT, WHICH IS NEXT TO X.
C           AFTERWARDS NEIGHBOURING ARGUMENT VALUES ARE TESTED AND
C           SELECTED IN THE ABOVE SENSE.
C
C     ..................................................................
C
      SUBROUTINE ATSE(X,ZS,DZ,F,IROW,ICOL,ARG,VAL,NDIM)
C
C
      DIMENSION F(1),ARG(1),VAL(1)
      IF(IROW-1)19,17,1
C
C     CASE DZ=0 IS CHECKED OUT
    1 IF(DZ)2,17,2
    2 N=NDIM
C
C     IF N IS GREATER THAN IROW, N IS SET EQUAL TO IROW.
      IF(N-IROW)4,4,3
    3 N=IROW
C
C     COMPUTATION OF STARTING SUBSCRIPT J.
    4 J=(X-ZS)/DZ+1.5
      IF(J)5,5,6
    5 J=1
    6 IF(J-IROW)8,8,7
    7 J=IROW
C
C     GENERATION OF TABLE ARG,VAL IN CASE DZ.NE.0.
    8 II=J
      JL=0
      JR=0
      DO 16 I=1,N
      ARG(I)=ZS+FLOAT(II-1)*DZ
      IF(ICOL-2)9,10,10
    9 VAL(I)=F(II)
      GOTO 11
   10 VAL(2*I-1)=F(II)
      III=II+IROW
      VAL(2*I)=F(III)
   11 IF(J+JR-IROW)12,15,12
   12 IF(J-JL-1)13,14,13
   13 IF((ARG(I)-X)*DZ)14,15,15
   14 JR=JR+1
      II=J+JR
      GOTO 16
   15 JL=JL+1
      II=J-JL
   16 CONTINUE
      RETURN
C
C     CASE DZ=0
   17 ARG(1)=ZS
      VAL(1)=F(1)
      IF(ICOL-2)19,19,18
   18 VAL(2)=F(2)
   19 RETURN
      END



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search