C COPYRIGHT (c) 1997 Council for the Central Laboratory * of the Research Councils C######DATE 3 September 1997 SUBROUTINE MC56AZ(ICNTL,TITLE,KEY,CASEID,DATTYP,POSITN,ORGNIZ, * M,NVEC,NE,LIP,IP,LIND,IND,LVALUE,VALUE,INFO) INTEGER ICNTL(10) CHARACTER TITLE*72,KEY*8,CASEID*8,DATTYP*3, * POSITN*1,ORGNIZ*1 INTEGER M,NVEC,NE,LIP,IP(LIP),LIND,IND(LIND),LVALUE COMPLEX*16 VALUE(LVALUE) INTEGER INFO(5) C ================================================== C Code for reading files in Rutherford-Boeing format C ================================================== C There follows a quick resume of the arguments ... full details follow. C ICNTL(1) = input unit C TITLE = descriptive title for matrix C KEY = identifier for associated matrix C CASEID = identifier for supplementary data C DATTYP = type of supplementary file C POSITN = position qualifier C ORGNIZ = data organization qualifier C M = row dimension of vector data C NVEC = number of vectors C NE = number of entries C LIP = length of array IP C IP = pointer array C LIND = length of array IND C IND = index array C LVALUE = length of array VALUE C VALUE = numerical values C INFO = information and error flags C C ICNTL is an INTEGER array of length 10 that must be set by the user. C It holds information on the input matrix and input file and controls C the action of the subroutine. This argument is not altered by the C subroutine. C ICNTL(1) must be set by the user to the unit number for the C file on which the Rutherford-Boeing data is held. C ICNTL(2) to ICNTL(10) are not accessed by the routine. C C TITLE is a CHARACTER*72 variable that need not be set by the user. It will C hold the text for the title line for the supplementary data on output C from the routine. C C KEY is a CHARACTER*8 variable that need not be be set by the user. C It will be set by the subroutine to the C identifying key for the matrix associated with the data being read. C C CASEID is a CHARACTER*8 variable that need not be be set by the user. C It will be set by the subroutine to the C identifying key for the data. Different supplementary files of the C same type for the same matrix will have different values for CASEID. C C DATTYP is a CHARACTER*3 variable that need not be be set by the user. C It will be set by the subroutine to C indicate the type of data being read. Current C possible values are: C For matrix data: xyz, where C x ... r, c, i, p, or x. C y ... s, u, h, z, or r. C z ... a or e. C For supplementary data: C ord ... orderings C rhs ... right-hand sides C sln ... solutions C est ... estimates C evl ... eigenvalues C svl ... singular-values C evc ... eigenvectors C svc ... singular-vectors C sbv ... Schur basis vectors C sbm ... Schur basis matrix C sbp ... Schur basis parameters C ipt ... partition C icv ... covering C lvl ... Laplacian-values C lvc ... Laplacian-vectors C geo ... geometry C avl ... auxiliary values C C POSITN is a CHARACTER*1 that is not accessed if matrix data is being read. C For supplementary data, it is set to hold position attributes of the C problem defined by the supplementary data. It will be set by the C subroutine to a blank unless DATTYP has a value equal to ord, rhs, C sln, est, evc, svc, lvc, ipt, icv, or geo. Possible values are C s, l, r corresponding to symmetric application or operation on the C left or right. The exact meaning is dependent on the value of C DATTYP (see documentation for RBSMC). C C ORGNIZ is a CHARACTER*1 variable that that need not be be set by the user. C It is not accessed if matrix data is being read, for supplementary data, C it will be set by the subroutine to a blank unless DATTYP is equal to rhs. C In this case, ORGNIZ indicates whether the right-hand side is C sparse (s), dense (d), or elemental (e). C C M is an INTEGER variable that that need not be set by the user. C It will be set by the subroutine. The actual meaning depends on the C value of DATTYP. For ord, rhs, sln, est, evc, svc, lvc, sbv, ipt, C icv, avl it is the row dimension of the vectors involved; for evl, C svl, lvl, sbm, sbp, geo it is the number of values, vectors, or C points involved. For matrix data, it is the number of rows or the C largest index used depending on whether matrix is assembled or C unassembled. C C NVEC is an INTEGER variable that that need not be set by the user. C It will be set by the subroutine to the number of vectors in C the supplementary file. For matrix data, it is the number of columns or C the number of elements depending on whether matrix is assembled or C unassembled. C C NE is an INTEGER variable that need not be set by the user. C It will be set by the subroutine to the number of entries in the C supplementary file or matrix. C C LIP is an INTEGER variable that must be set by the user to the length C of array IP. It is not altered by the subroutine. C C IP is an INTEGER array of size LIP that need not be set by C the user. If DATTYP is equal to rhs (ORGNIZ equal to s), ipt, or icv C it will be set by the subroutine. For C rhs (ORGNIZ equal to s), it must be used to hold pointers to the start C of each sparse right-hand side in IND and VALUE; for ipt and icv C it will be set to point to the beginning of each partition or C covering in IND. For matrix data, it is set to position of column or C element starts in IND. C C LIND is an INTEGER variable that must be set by the user to the length C of array IND. It is not altered by the subroutine. C C IND is an INTEGER array of length LIND that need not be set by the user. C It will be set by the subroutine if DATTYP has C the value ord, rhs (ORGNIZ equal to s), ipt, or icv. For C ord, it will be set to the orderings; for C rhs (ORGNIZ equal to s), it will be set to the row indices of the C entries in the sparse right-hand sides; and for ipt and icv to the C indices for each partitioning or covering. For matrix data, it is set to C the row indices or element indices. C C LVALUE is an INTEGER variable that must be set by the user to the length C of array VALUE. It is not altered by the subroutine. C C VALUE is a COMPLEX*16 array of length LVALUE that need not be set C by the user. If DATTYP is not equal to ord, ipt, or icv, it will be set C by the subroutine to the value of the numerical data. For matrix entries, C it will be set to the values of the entries. C C INFO is an INTEGER variable that need not be set by the user. C On exit, it will be zero if no error is detected, positive for a C warning, and negative otherwise. Possible nonzero values are: C -1 Array IP too small. Suitable length returned in INFO(2). C -2 Array IND too small. Suitable length returned in INFO(2). C -3 Array VALUE too small. Suitable length returned in INFO(2). C Internal variables CHARACTER BUFFER1*80,BUFFER2*80 CHARACTER*20 AUXFM1,AUXFM2,AUXFM3 INTEGER I,K,LUNIT,NAUXD INTEGER NELTVL,NP1,NREAL CHARACTER MXTYPE*3,PTRFMT*16,INDFMT*16,VALFMT*20 DO 111 I=1,5 INFO(I) = 0 111 CONTINUE LUNIT = ICNTL(1) C ------------------------ C Read in header block C ------------------------ C READ (LUNIT,'(A72,A8/A80/A80)') TITLE, KEY, BUFFER1, BUFFER2 IF (BUFFER2(3:3).EQ.'e' .OR. BUFFER2(3:3).EQ.'a') THEN C Matrix data being read READ(BUFFER2,'(A3,11X,4(1X,I13))') MXTYPE, M, NVEC, NE, NELTVL READ(LUNIT,'(2A16,A20)') PTRFMT, INDFMT, VALFMT C Read IP array NP1 = NVEC+1 IF (MXTYPE(3:3).EQ.'e' .AND. MXTYPE(2:2).EQ.'r') NP1=2*NVEC+1 C Check to see if IP array is big enough IF (NP1.GT.LIP) THEN INFO(1) = -1 INFO(2) = NP1 GO TO 500 ENDIF READ(LUNIT,PTRFMT) (IP(I),I=1,NP1) C Read IND array C Check to see if IND array is big enough IF (NE.GT.LIND) THEN INFO(1) = -2 INFO(2) = NE GO TO 500 ENDIF READ(LUNIT,INDFMT) (IND(I),I=1,NE) C Jump if no reals IF (MXTYPE(1:1).EQ.'p' .OR. MXTYPE(1:1).EQ.'x') GO TO 500 C Read VALUE array NREAL = NE IF (NELTVL.GT.0) NREAL = NELTVL C Check to see if VALUE array is big enough IF (NREAL.GT.LVALUE) THEN INFO(1) = -3 INFO(2) = NREAL GO TO 500 ENDIF READ(LUNIT,VALFMT) (VALUE(I),I=1,NREAL) ELSE C Supplementary data being read READ(BUFFER1,999) * DATTYP, POSITN, ORGNIZ, CASEID, M, NVEC, NAUXD READ(BUFFER2,998) AUXFM1, AUXFM2, AUXFM3 999 FORMAT (A3, 2A1, 1X, A8, 2X, 3(1X, I13)) 998 FORMAT (3A20) C Read integer data IF ((DATTYP.EQ.'rhs' .AND. ORGNIZ.EQ.'s') .OR. 1 (DATTYP.EQ.'ipt') .OR. (DATTYP.EQ.'icv') .OR. 2 (DATTYP.EQ.'ord')) THEN IF (DATTYP.EQ.'ord') THEN NAUXD = M*NVEC ELSE C Read pointer array C Check to see if array IP is big enough IF (NVEC+1.GT.LIP) THEN INFO(1) = -1 INFO(2) = NVEC+1 GO TO 500 ENDIF READ(LUNIT,AUXFM1) (IP(K),K=1,NVEC+1) ENDIF C Read indices C Check to see if array IND is big enough IF (NAUXD.GT.LIND) THEN INFO(1) = -2 INFO(2) = NAUXD GO TO 500 ENDIF IF (DATTYP.EQ.'ord') THEN READ(LUNIT,AUXFM1) (IND(K),K=1,NAUXD) ELSE READ(LUNIT,AUXFM2) (IND(K),K=1,NAUXD) ENDIF IF (DATTYP.NE.'rhs') GO TO 500 ENDIF C Read values IF (DATTYP .NE. 'rhs') NAUXD = M*NVEC C Check to see if array VALUE is big enough IF (NAUXD.GT.LVALUE) THEN INFO(1) = -3 INFO(2) = NAUXD GO TO 500 ENDIF IF (DATTYP .EQ. 'rhs' .AND. ORGNIZ .EQ. 's') THEN READ(LUNIT,AUXFM3) (VALUE(K),K=1,NAUXD) ELSE READ(LUNIT,AUXFM1) (VALUE(K),K=1,NAUXD) ENDIF NE = NAUXD C End of read on supplementary data ENDIF 500 RETURN END