SUBROUTINE DPRTMT( NROW, NCOL, A, JA, IA, RHS, TITLE, KEY, TYPE, $ IFMT, JOB, IOUNIT ) * .. * .. Scalar Arguments .. CHARACTER TITLE*72, KEY*8, TYPE*3 INTEGER IFMT, JOB, IOUNIT, NROW, NCOL * .. * .. Array Arguments .. INTEGER JA(*), IA(*) DOUBLE PRECISION A( * ), RHS( * ) * * * Purpose * ======= * * writes a matrix into a standard Harwell-Boeing format file. The matrix * on input is assumed to be stored in compressed column format. * * This routine is a modified version of the routine prtmt in SPARSKIT * by Y. Saad (Univ. of Minnesota). * * Arguments * ========= * * NROW (input) INTEGER * number of rows in matrix * * NCOL (input) INTEGER * number of columns in matrix * * A (input) DOUBLE PRECISION array, dimension (NNZ) * containing the values of the matrix stored columnwise * * JA (input) INTEGER array, dimension (NNZ) * integer array of size at least NNZ (see dreadm) of row * indices that correspond to matrix elements in the array A. * * IA (input) INTEGER array, dimension (NCOL+1) * integer array containing the pointers to the beginning of * each column in the arrays A, JA. Also IA(NCOL+1) = NNZ + 1. * * RHS (input) DOUBLE PRECISION * array containing the right-hand-side(s). Accessed only if * JOB .GT. 2 (see job) * * TITLE (input) CHARACTER*72 * title of matrix * * KEY (input) CHARACTER*8 * key of matrix * * TYPE (input) CHARATCER*3 * type of matrix. * * IFMT (input) INTEGER * parameter to specify the format for the numerical values of * the matrix to be output (i.e., for the array A and RHS, if * applicable). * if IFMT < 100, then the format chosen is Dxx.yy, in which yy * is precisely the integer IFMT (and xx is IFMT+6) * if IFMT > 100, then the format chosen is Fxx.yy, in which * the length of the mantissa yy is the integer MOD(IFMT,100) * and the length of the integer part is IFMT/100. * For examples, * IFMT = 4 means D10.4 .xxxxD+ee * IFMT = 104 means F7.4 x.xxxx * Note that formats for JA and IA are internally computed. * * JOB (input) INTEGER * indicates whether the array A or A and RHS is to be output * JOB = 1, write srtucture only, i.e., the arrays JA and IA. * JOB = 2, write matrix including values, i.e., a, JA, IA * JOB = 3, write matrix and one right hand side: A,JA,IA,RHS. * JOB = k+2, write matrix and k successive sides right hand * sides * Note that there cannot be any right-hand-side if the matrix * has no values. * * IOUNIT (input) INTEGER * logical unit number in which to write the matrix. * * Notes: 1) This implementation packs as many elements as possible per * 80-character line. * 2) This implementation also avoids putting blanks in the * formats that are written in the 4-line header * (This is done for purely esthetical reasons since blanks * are ignored in format descriptors.) * * Local variables: * * Parameters suffixed -crd indicate the number of 80 character * cards required to print the corresponding data. A card * corresponds to a line in a file. * * ====================================================================== * * .. Local variables .. CHARACTER PTRFMT*16,INDFMT*16,VALFMT*20 INTEGER IX, IHEAD, I, TOTCRD, PTRCRD, INDCRD, VALCRD, $ RHSCRD, NNZ, NRHS, LEN, NPERLI * .. * .. Intrinsich functions .. INTRINSIC INT, ALOG10, REAL * * Executable statements * VALCRD = 0 RHSCRD = 0 * * compute pointer format * NNZ = IA(NCOL+1) - 1 LEN = INT ( ALOG10( 0.1+REAL( NNZ+1 ) ) ) + 1 NPERLI = 80/LEN PTRCRD = NCOL/NPERLI + 1 IF (LEN .GT. 9) THEN ASSIGN 101 TO IX ELSE ASSIGN 100 TO IX END IF * WRITE (PTRFMT,IX) NPERLI,LEN 100 FORMAT( 1H(,I2,1HI,I1,1H) ) 101 FORMAT( 1H(,I2,1HI,I2,1H) ) * * compute ROW index format * NPERLI = MIN0(80/LEN,NNZ) INDCRD = (NNZ-1)/NPERLI+1 WRITE (INDFMT,100) NPERLI,LEN * * compute values and rhs format (using the same format for both) * quit this part if no values provided. * IF (JOB .LE. 1) $ GOTO 20 * IF (IFMT .GE. 100) THEN IHEAD = IFMT/100 IFMT = IFMT-100*IHEAD LEN = IHEAD+IFMT+2 NPERLI = 80/LEN * IF (LEN .LE. 9 ) THEN ASSIGN 102 TO IX ELSEIF (IFMT .LE. 9) THEN ASSIGN 103 TO IX ELSE ASSIGN 104 TO IX ENDIF * WRITE(VALFMT,IX) NPERLI,LEN,IFMT 102 FORMAT(1H(,I2,1HF,I1,1H.,I1,1H) ) 103 FORMAT(1H(,I2,1HF,I2,1H.,I1,1H) ) 104 FORMAT(1H(,I2,1HF,I2,1H.,I2,1H) ) * ELSE LEN = IFMT + 6 NPERLI = 80/LEN * * try to minimize the blanks in the format strings. * IF (NPERLI .LE. 9) THEN IF (LEN .LE. 9 ) THEN ASSIGN 105 TO IX ELSEIF (IFMT .LE. 9) THEN ASSIGN 106 TO IX ELSE ASSIGN 107 TO IX ENDIF ELSE IF (LEN .LE. 9 ) THEN ASSIGN 108 TO IX ELSEIF (IFMT .LE. 9) THEN ASSIGN 109 TO IX ELSE ASSIGN 110 TO IX ENDIF ENDIF * WRITE(VALFMT,IX) NPERLI,LEN,IFMT 105 FORMAT(1H(,I1,1HD,I1,1H.,I1,1H) ) 106 FORMAT(1H(,I1,1HD,I2,1H.,I1,1H) ) 107 FORMAT(1H(,I1,1HD,I2,1H.,I2,1H) ) 108 FORMAT(1H(,I2,1HD,I1,1H.,I1,1H) ) 109 FORMAT(1H(,I2,1HD,I2,1H.,I1,1H) ) 110 FORMAT(1H(,I2,1HD,I2,1H.,I2,1H) ) * ENDIF * VALCRD = (NNZ-1)/NPERLI+1 NRHS = JOB - 2 IF (NRHS .GE. 1) $ RHSCRD = (NRHS*NROW-1)/NPERLI+1 20 CONTINUE TOTCRD = PTRCRD+INDCRD+VALCRD+RHSCRD * * write 4-line header * WRITE(IOUNIT,10) TITLE,KEY,TOTCRD,PTRCRD,INDCRD,VALCRD, $ RHSCRD,TYPE,NROW,NCOL,NNZ,NRHS,PTRFMT, $ INDFMT,VALFMT,VALFMT 10 FORMAT(A72,A8/5I14/A3,11X,4I14/2A16,2A20) * * write pointers * WRITE(IOUNIT,PTRFMT) (IA(I), I = 1, NCOL+1) WRITE(IOUNIT,INDFMT) (JA(I), I = 1, NNZ) IF (JOB .LE. 1) $ RETURN * * write the numerical values of the matrix * WRITE(IOUNIT,VALFMT) (A(I), I = 1, NNZ) IF (JOB .LE. 2) $ RETURN * * write the right hand side if exists * WRITE(IOUNIT,VALFMT) (RHS(I), I = 1, NROW*NRHS) * RETURN * * End of DPRTMT * END