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

C
C     ..................................................................
C
C        SUBROUTINE CTAB
C
C        PURPOSE
C           TABULATE COLUMNS OF A MATRIX TO FORM A SUMMARY MATRIX
C
C        USAGE
C           CALL CTAB(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 M CONTAINING KEY
C           R - NAME OF OUTPUT MATRIX CONTAINING SUMMARY OF COLUMN 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 AND R
C           M - NUMBER OF COLUMNS IN A
C           L - NUMBER OF COLUMNS 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           CADD
C
C        METHOD
C           COLUMNS 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 COLUMN OF A IS ADDED TO THE JTH
C           COLUMN OF MATRIX R AND ONE IS ADDED TO S(J). IF THE VALUE OF
C           J IS NOT BETWEEN 1 AND L, ONE IS ADDED TO S(L+1)
C           UPON COMPLETION, THE OUTPUT MATRIX R CONTAINS A SUMMARY OF
C           COLUMN DATA AS SPECIFIED BY VECTOR B. EACH ELEMENT IN VECTOR
C           S CONTAINS A COUNT OF THE NUMBER OF COLUMNS OF A USED TO
C           FORM R. ELEMENT S(L+1) CONTAINS THE NUMBER OF COLUMNS OF A
C           NOT INCLUDED IN R AS A RESULT OF J BEING LESS THAN ONE OR
C           GREATER THAN L.
C
C     ..................................................................
C
      SUBROUTINE CTAB(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(N,L,IT,N,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,M
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 COLUMN OF A TO COLUMN OF R AND 1 TO COUNT
C
   40 CALL CADD (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