File: RCUT.FT of Tape: Various/ETH/eth11-1

(Source file text) 

---

C     ..................................................................
C
C        SUBROUTINE RCUT
C
C        PURPOSE
C           PARTITION A MATRIX BETWEEN SPECIFIED ROWS TO FORM TWO
C           RESULTANT MATRICES
C
C        USAGE
C           CALL RCUT (A,L,R,S,N,M,MS)
C
C        DESCRIPTION OF PARAMETERS
C           A - NAME OF INPUT MATRIX
C           L - ROW OF A ABOVE WHICH PARTITIONING TAKES PLACE
C           R - NAME OF MATRIX TO BE FORMED FROM UPPER PORTION OF A
C           S - NAME OF MATRIX TO BE FORMED FROM LOWER PORTION OF A
C           N - NUMBER OF ROWS IN A
C           M - NUMBER OF COLUMNS IN A
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 CANNOT BE IN SAME LOCATION AS MATRIX A
C           MATRIX S CANNOT BE IN SAME LOCATION AS MATRIX A
C           MATRIX R CANNOT BE IN SAME LOCATION AS MATRIX S
C           MATRIX R AND MATRIX S ARE ALWAYS GENERAL MATRICES
C
C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
C           LOC
C
C        METHOD
C           ELEMENTS OF MATRIX A ABOVE ROW L ARE MOVED TO FORM MATRIX R
C           OF L-1 ROWS AND M COLUMNS. ELEMENTS OF MATRIX A IN ROW L
C           AND BELOW ARE MOVED TO FORM MATRIX S OF N-L+1 ROWS AND M
C           COLUMNS
C
C     ..................................................................
C
      SUBROUTINE RCUT(A,L,R,S,N,M,MS)
      DIMENSION A(1),R(1),S(1)
C
      IR=0
      IS=0
      DO 70 J=1,M
      DO 70 I=1,N
C
C        FIND LOCATION IN OUTPUT MATRIX AND SET TO ZERO
C
      IF(I-L) 20,10,10
   10 IS=IS+1
      S(IS)=0.0
      GO TO 30
   20 IR=IR+1
      R(IR)=0.0
C
C        LOCATE ELEMENT FOR ANY MATRIX STORAGE MODE
C
   30 CALL LOC(I,J,IJ,N,M,MS)
C
C        TEST FOR ZERO ELEMENT IN DIAGONAL MATRIX
C
      IF(IJ) 40,70,40
C
C        DETERMINE WHETHER ABOVE OR BELOW L
C
   40 IF(I-L) 60,50,50
   50 S(IS)=A(IJ)
      GO TO 70
   60 R(IR)=A(IJ)
   70 CONTINUE
      RETURN
      END
C

---