File: RTAB.FT of Tape: Various/ETH/eth11-1
(Source file text) 

C     ..................................................................
C
C        SUBROUTINE RTAB
C
C        PURPOSE
C           TABULATE ROWS OF A MATRIX TO FORM A SUMMARY MATRIX
C
C        USAGE
C           CALL RTAB(A,B,R,S,N,M,MS,L)
C
C        DESCRIPTION OF PARAMETERS
C           A - NAME OF INPUT MATRIX
C           B - NAME OF INPUT VECTOR OF LENGTH N CONTAINING KEY
C           R - NAME OF OUTPUT MATRIX CONTAINING SUMMARY OF ROW DATA.
C               IT IS INITIALLY SET TO ZERO BY THIS SUBROUTINE.
C           S - NAME OF OUTPUT VECTOR OF LENGTH L+1 CONTAINING COUNTS
C           N - NUMBER OF ROWS IN A
C           M - NUMBER OF COLUMNS IN A AND R
C           L - NUMBER OF ROWS IN R
C           MS  - ONE DIGIT NUMBER FOR STORAGE MODE OF MATRIX A
C                  0 - GENERAL
C                  1 - SYMMETRIC
C                  2 - DIAGONAL
C
C        REMARKS
C           MATRIX R IS ALWAYS A GENERAL MATRIX
C
C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
C           LOC
C           RADD
C
C        METHOD
C           ROWS OF DATA IN MATRIX A ARE TABULATED BASED ON THE KEY
C           CONTAINED IN VECTOR B. THE FLOATING POINT NUMBER IN B(I) IS
C           TRUNCATED TO FORM J. THE ITH ROW OF A IS ADDED TO THE JTH
C           ROW OF R ELEMENT BY ELEMENT AND ONE IS ADDED TO S(J). IF J
C           IS NOT BETWEEN ONE AND L, ONE IS ADDED TO S(L+1). THIS
C           PROCEDURE IS REPEATED FOR EVERY ELEMENT IN VECTOR B.
C           UPON COMPLETION, THE OUTPUT MATRIX R CONTAINS A SUMMARY OF
C           ROW DATA AS SPECIFIED BY VECTOR B. EACH ELEMENT IN VECTOR S
C           CONTAINS A COUNT OF THE NUMBER OF ROWS OF A USED TO FORM THE
C           CORRESPONDING ROW OF R. ELEMENT S(L+1) CONTAINS A COUNT OF
C           THE NUMBER OF ROWS OF A NOT INCLUDED IN R AS A RESULT OF J
C           BEING LESS THAN ONE OR GREATER THAN L.
C
C     ..................................................................
C
      SUBROUTINE RTAB(A,B,R,S,N,M,MS,L)
      DIMENSION A(1),B(1),R(1),S(1)
C
C        CLEAR OUTPUT AREAS
C
      CALL LOC(M,L,IT,M,L,0)
      DO 10 IR=1,IT
   10 R(IR)=0.0
      DO 20 IS=1,L
   20 S(IS)=0.0
      S(L+1)=0.0
C
      DO 60 I=1,N
C
C        TEST FOR THE KEY OUTSIDE THE RANGE
C
      JR=B(I)
      IF (JR-1) 50,40,30
   30 IF (JR-L) 40,40,50
C
C
C        ADD ROW OF A TO ROW OF R AND 1 TO COUNT
C
   40 CALL RADD(A,I,R,JR,N,M,MS,L)
      S(JR)=S(JR)+1.0
      GO TO 60
C
   50 S(L+1)=S(L+1)+1.0
   60 CONTINUE
      RETURN
      END
C