Trailing-Edge
-
PDP-10 Archives
-
decuslib20-02
-
decus/20-0026/rtab.ssp
There are 2 other files named rtab.ssp in the archive. Click here to see a list.
C RTAB 10
C ..................................................................RTAB 20
C RTAB 30
C SUBROUTINE RTAB RTAB 40
C RTAB 50
C PURPOSE RTAB 60
C TABULATE ROWS OF A MATRIX TO FORM A SUMMARY MATRIX RTAB 70
C RTAB 80
C USAGE RTAB 90
C CALL RTAB(A,B,R,S,N,M,MS,L) RTAB 100
C RTAB 110
C DESCRIPTION OF PARAMETERS RTAB 120
C A - NAME OF INPUT MATRIX RTAB 130
C B - NAME OF INPUT VECTOR OF LENGTH N CONTAINING KEY RTAB 140
C R - NAME OF OUTPUT MATRIX CONTAINING SUMMARY OF ROW DATA. RTAB 150
C IT IS INITIALLY SET TO ZERO BY THIS SUBROUTINE. RTAB 160
C S - NAME OF OUTPUT VECTOR OF LENGTH L+1 CONTAINING COUNTS RTAB 170
C N - NUMBER OF ROWS IN A RTAB 180
C M - NUMBER OF COLUMNS IN A AND R RTAB 190
C L - NUMBER OF ROWS IN R RTAB 200
C MS - ONE DIGIT NUMBER FOR STORAGE MODE OF MATRIX A RTAB 210
C 0 - GENERAL RTAB 220
C 1 - SYMMETRIC RTAB 230
C 2 - DIAGONAL RTAB 240
C RTAB 250
C REMARKS RTAB 260
C MATRIX R IS ALWAYS A GENERAL MATRIX RTAB 270
C RTAB 280
C SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED RTAB 290
C LOC RTAB 300
C RADD RTAB 310
C RTAB 320
C METHOD RTAB 330
C ROWS OF DATA IN MATRIX A ARE TABULATED BASED ON THE KEY RTAB 340
C CONTAINED IN VECTOR B. THE FLOATING POINT NUMBER IN B(I) IS RTAB 350
C TRUNCATED TO FORM J. THE ITH ROW OF A IS ADDED TO THE JTH RTAB 360
C ROW OF R ELEMENT BY ELEMENT AND ONE IS ADDED TO S(J). IF J RTAB 370
C IS NOT BETWEEN ONE AND L, ONE IS ADDED TO S(L+1). THIS RTAB 380
C PROCEDURE IS REPEATED FOR EVERY ELEMENT IN VECTOR B. RTAB 390
C UPON COMPLETION, THE OUTPUT MATRIX R CONTAINS A SUMMARY OF RTAB 400
C ROW DATA AS SPECIFIED BY VECTOR B. EACH ELEMENT IN VECTOR S RTAB 410
C CONTAINS A COUNT OF THE NUMBER OF ROWS OF A USED TO FORM THERTAB 420
C CORRESPONDING ROW OF R. ELEMENT S(L+1) CONTAINS A COUNT OF RTAB 430
C THE NUMBER OF ROWS OF A NOT INCLUDED IN R AS A RESULT OF J RTAB 440
C BEING LESS THAN ONE OR GREATER THAN L. RTAB 450
C RTAB 460
C ..................................................................RTAB 470
C RTAB 480
SUBROUTINE RTAB(A,B,R,S,N,M,MS,L) RTAB 490
DIMENSION A(1),B(1),R(1),S(1) RTAB 500
C RTAB 510
C CLEAR OUTPUT AREAS RTAB 520
C RTAB 530
CALL LOC(M,L,IT,M,L,0) RTAB 540
DO 10 IR=1,IT RTAB 550
10 R(IR)=0.0 RTAB 560
DO 20 IS=1,L RTAB 570
20 S(IS)=0.0 RTAB 580
S(L+1)=0.0 RTAB 590
C RTAB 600
DO 60 I=1,N RTAB 610
C RTAB 620
C TEST FOR THE KEY OUTSIDE THE RANGE RTAB 630
C RTAB 640
JR=B(I) RTAB 650
IF (JR-1) 50,40,30 RTAB 660
30 IF (JR-L) 40,40,50 RTAB 670
C RTAB 680
C RTAB 690
C ADD ROW OF A TO ROW OF R AND 1 TO COUNT RTAB 700
C RTAB 710
40 CALL RADD (A,I,R,JR,N,M,MS,L) RTAB 720
S(JR)=S(JR)+1.0 RTAB 730
GO TO 60 RTAB 740
C RTAB 750
50 S(L+1)=S(L+1)+1.0 RTAB 760
60 CONTINUE RTAB 770
RETURN RTAB 780
END RTAB 790