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