!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> This module contains helpers for processing matrix market files. MODULE MatrixMarketModule USE DataTypesModule, ONLY : NTREAL, NTLONG IMPLICIT NONE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ENUM, BIND(c) !> Sparse coordinate file. ENUMERATOR :: MM_COORDINATE=1 !> Dense array file. ENUMERATOR :: MM_ARRAY=2 !> Real data being read in. ENUMERATOR :: MM_REAL=1 !> Integer data being read in. ENUMERATOR :: MM_INTEGER=2 !>Complex numbers being read in. ENUMERATOR :: MM_COMPLEX=3 !> Just a pattern of non zeros. ENUMERATOR :: MM_PATTERN=4 !> File lacks symmetry. ENUMERATOR :: MM_GENERAL=1 !> File is symmetric ENUMERATOR :: MM_SYMMETRIC=2 !> File is skew symmetric. ENUMERATOR :: MM_SKEW_SYMMETRIC=3 !> File is hermitian. ENUMERATOR :: MM_HERMITIAN=4 END ENUM !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> The longest line size possible according to the spec. INTEGER, PARAMETER :: MAX_LINE_LENGTH = 1024 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! PUBLIC :: ParseMMHeader PUBLIC :: WriteMMSize PUBLIC :: WriteMMLine !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! INTERFACE WriteMMLine MODULE PROCEDURE WriteMMLine_ii MODULE PROCEDURE WriteMMLine_iif MODULE PROCEDURE WriteMMLine_iiff MODULE PROCEDURE WriteMMLine_f MODULE PROCEDURE WriteMMLine_ff END INTERFACE CONTAINS!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Parse a matrix market header. FUNCTION ParseMMHeader(line,sparsity_type,data_type,pattern_type) & & RESULT(no_error) !> String to parse. CHARACTER(len=*), INTENT(IN) :: line !> If coordinate or array type. INTEGER, INTENT(OUT) :: sparsity_type !> If real, integer, complex, pattern. INTEGER, INTENT(OUT) :: data_type !> If general, symmetric, skew_symmetric, hermitian. INTEGER, INTENT(OUT) :: pattern_type !> True if no errors. LOGICAL :: no_error !! Local Data INTEGER :: pos1, pos2 no_error = .TRUE. !! This part is just "MatrixMarket". pos1 = 1 pos2 = INDEX(line(pos1:), ' ') !! This part is just "matrix". pos1 = pos2+pos1 pos2 = INDEX(line(pos1:), ' ') !! This part is coordinate or array. pos1 = pos2+pos1 pos2 = INDEX(line(pos1:), ' ') SELECT CASE(TRIM(line(pos1:pos1+pos2-1))) CASE('coordinate') sparsity_type = MM_COORDINATE CASE('array') sparsity_type = MM_ARRAY CASE DEFAULT no_error = .FALSE. END SELECT !! This part is real, integer, complex, pattern. pos1 = pos2+pos1 pos2 = INDEX(line(pos1:), ' ') SELECT CASE(TRIM(line(pos1:pos1+pos2-1))) CASE('real') data_type = MM_REAL CASE('array') data_type = MM_INTEGER CASE('complex') data_type = MM_COMPLEX CASE('pattern') data_type = MM_PATTERN CASE DEFAULT no_error = .FALSE. END SELECT !! This part is general, symmetric, skew-symmetric, hermitian. pos1 = pos2+pos1 SELECT CASE(TRIM(line(pos1:))) CASE('general') pattern_type = MM_GENERAL CASE('symmetric') pattern_type = MM_SYMMETRIC CASE('skew-symmetric') pattern_type = MM_SKEW_SYMMETRIC CASE('hermitian') pattern_type = MM_HERMITIAN CASE DEFAULT no_error = .FALSE. END SELECT END FUNCTION ParseMMHeader !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Write the line describing the size of the matrix PURE SUBROUTINE WriteMMSize(outstring, rows, columns, values_in) !> The final string is written to this variable. CHARACTER(LEN=MAX_LINE_LENGTH), INTENT(INOUT) :: outstring !> The number of rows of the matrix INTEGER, INTENT(IN) :: rows !> The number of columns of the matrix INTEGER, INTENT(IN) :: columns !> The total number of non zero values in the matrix (for sparse format). INTEGER(KIND=NTLONG), INTENT(IN), OPTIONAL :: values_in !! Local variables CHARACTER(LEN=MAX_LINE_LENGTH) :: temp1, temp2, temp3 !! Write everything to strings. WRITE(temp1, *) rows WRITE(temp2, *) columns IF (PRESENT(values_in)) THEN WRITE(temp3, *) values_in ELSE WRITE(temp3, *) "" END IF !! Combine WRITE(outstring, *) ADJUSTL(TRIM(temp1)), ADJUSTL(TRIM(temp2)), & & ADJUSTL(TRIM(temp3)) END SUBROUTINE WriteMMSize !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Write a single line that would correspond to a matrix market entry. PURE SUBROUTINE WriteMMLine_ii(outstring, row, column, add_newline_in) !> The final string is written to this variable. CHARACTER(LEN=MAX_LINE_LENGTH), INTENT(INOUT) :: outstring !> The first coordinate value INTEGER, INTENT(IN) :: row !> The second coordinate value INTEGER, INTENT(IN) :: column !> Whether to append a new line to the output (default=F) LOGICAL, INTENT(IN), OPTIONAL :: add_newline_in !! Local variables CHARACTER(LEN=MAX_LINE_LENGTH) :: temp1, temp2 LOGICAL :: add_newline !! Process Optional Arguments IF (PRESENT(add_newline_in)) THEN add_newline = add_newline_in ELSE add_newline = .FALSE. END IF !! Write everything to strings. WRITE(temp1, *) row WRITE(temp2, *) column !! Combine IF (add_newline) THEN WRITE(outstring, *) ADJUSTL(TRIM(temp1)), & & ADJUSTL(TRIM(temp2))//NEW_LINE('A') ELSE WRITE(outstring, *) ADJUSTL(TRIM(temp1)), ADJUSTL(TRIM(temp2)) END IF END SUBROUTINE WriteMMLine_ii !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Write a single line that would correspond to a matrix market entry. PURE SUBROUTINE WriteMMLine_iif(outstring, row, column, val, add_newline_in) !> The final string is written to this variable. CHARACTER(LEN=MAX_LINE_LENGTH), INTENT(INOUT) :: outstring !> The first coordinate value INTEGER, INTENT(IN) :: row !> The second coordinate value INTEGER, INTENT(IN) :: column !> The value at that coordinate REAL(NTREAL), INTENT(IN) :: val !> Whether to append a new line to the output (default=F) LOGICAL, INTENT(IN), OPTIONAL :: add_newline_in !! Local variables CHARACTER(LEN=MAX_LINE_LENGTH) :: temp1, temp2, temp3 LOGICAL :: add_newline !! Process Optional Arguments IF (PRESENT(add_newline_in)) THEN add_newline = add_newline_in ELSE add_newline = .FALSE. END IF !! Write everything to strings. WRITE(temp1, *) row WRITE(temp2, *) column WRITE(temp3, *) val !! Combine IF (add_newline) THEN WRITE(outstring, *) ADJUSTL(TRIM(temp1)), ADJUSTL(TRIM(temp2)), & & ADJUSTL(TRIM(temp3))//NEW_LINE('A') ELSE WRITE(outstring, *) ADJUSTL(TRIM(temp1)), ADJUSTL(TRIM(temp2)), & & ADJUSTL(TRIM(temp3)) END IF END SUBROUTINE WriteMMLine_iif !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Write a single line that would correspond to a matrix market entry. PURE SUBROUTINE WriteMMLine_iiff(outstring, row, column, val1, val2, & & add_newline_in) !> The final string is written to this variable. CHARACTER(LEN=MAX_LINE_LENGTH), INTENT(INOUT) :: outstring !> The first coordinate value INTEGER, INTENT(IN) :: row !> The second coordinate value INTEGER, INTENT(IN) :: column !> The value at that coordinate REAL(NTREAL), INTENT(IN) :: val1 !> The second value at the coordinate REAL(NTREAL), INTENT(IN) :: val2 !> Whether to append a new line to the output (default=F) LOGICAL, INTENT(IN), OPTIONAL :: add_newline_in !! Local variables CHARACTER(LEN=MAX_LINE_LENGTH) :: temp1, temp2, temp3, temp4 LOGICAL :: add_newline !! Process Optional Arguments IF (PRESENT(add_newline_in)) THEN add_newline = add_newline_in ELSE add_newline = .FALSE. END IF !! Write everything to strings. WRITE(temp1, *) row WRITE(temp2, *) column WRITE(temp3, *) val1 WRITE(temp4, *) val2 !! Combine IF (add_newline) THEN WRITE(outstring, *) ADJUSTL(TRIM(temp1)), & & ADJUSTL(TRIM(temp2)), ADJUSTL(TRIM(temp3)), & & ADJUSTL(TRIM(temp4))//NEW_LINE('A') ELSE WRITE(outstring, *) ADJUSTL(TRIM(temp1)), & & ADJUSTL(TRIM(temp2)), ADJUSTL(TRIM(temp3)), ADJUSTL(TRIM(temp4)) END IF END SUBROUTINE WriteMMLine_iiff !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Write a single line that would correspond to a matrix market entry. PURE SUBROUTINE WriteMMLine_f(outstring, val, add_newline_in) !> The final string is written to this variable. CHARACTER(LEN=MAX_LINE_LENGTH), INTENT(INOUT) :: outstring !> The value at that coordinate REAL(NTREAL), INTENT(IN) :: val !> Whether to append a new line to the output (default=F) LOGICAL, INTENT(IN), OPTIONAL :: add_newline_in !! Local Variables CHARACTER(LEN=MAX_LINE_LENGTH) :: temp1 LOGICAL :: add_newline !! Process Optional Arguments IF (PRESENT(add_newline_in)) THEN add_newline = add_newline_in ELSE add_newline = .FALSE. END IF !! Write everything to strings. WRITE(temp1, *) val !! Combine IF (add_newline) THEN WRITE(outstring, *) ADJUSTL(TRIM(temp1))//NEW_LINE('A') ELSE WRITE(outstring, *) ADJUSTL(TRIM(temp1)) END IF END SUBROUTINE WriteMMLine_f !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !> Write a single line that would correspond to a matrix market entry. PURE SUBROUTINE WriteMMLine_ff(outstring, val1, val2, add_newline_in) !> The final string is written to this variable. CHARACTER(LEN=MAX_LINE_LENGTH), INTENT(INOUT) :: outstring !> The value at that coordinate REAL(NTREAL), INTENT(IN) :: val1 !> The second value at that coordinate REAL(NTREAL), INTENT(IN) :: val2 !> Whether to append a new line to the output (default=F) LOGICAL, INTENT(IN), OPTIONAL :: add_newline_in !! Local variables CHARACTER(LEN=MAX_LINE_LENGTH) :: temp1, temp2 LOGICAL :: add_newline !! Process Optional Arguments IF (PRESENT(add_newline_in)) THEN add_newline = add_newline_in ELSE add_newline = .FALSE. END IF !! Write everything to strings. WRITE(temp1, *) val1 WRITE(temp2, *) val2 !! Combine IF (add_newline) THEN WRITE(outstring, *) ADJUSTL(TRIM(temp1)), ADJUSTL(TRIM(temp2)) & & //NEW_LINE('A') ELSE WRITE(outstring, *) ADJUSTL(TRIM(temp1)), ADJUSTL(TRIM(temp2)) END IF END SUBROUTINE WriteMMLine_ff !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! END MODULE MatrixMarketModule