! !//////////////////////////////////////////////////////////////////////// ! ! LatexTable.f90 ! Created: February 25, 2014 6:10 PM ! By: David Kopriva ! Copyright (c) <2014> ! ! Permission is hereby granted, free of charge, to any person obtaining a copy ! of this software and associated documentation files (the "Software"), to deal ! in the Software without restriction, including without limitation the rights ! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell ! copies of the Software, and to permit persons to whom the Software is ! furnished to do so, subject to the following conditions: ! ! The above copyright notice and this permission notice shall be included in ! all copies or substantial portions of the Software. ! ! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR ! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, ! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE ! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER ! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, ! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN ! THE SOFTWARE. ! !//////////////////////////////////////////////////////////////////////// ! Module LatexTableColumnClass IMPLICIT NONE INTEGER, PARAMETER :: COLUMN_CHARACTER_TYPE = 0, COLUMN_INTEGER_TYPE = 1 INTEGER, PARAMETER :: COLUMN_DOUBLEPRECISION_TYPE = 2, COLUMN_UNDEFINED_TYPE = -1 TYPE LatexTableColumn CHARACTER(LEN=256) :: title = "column" CHARACTER(LEN=256) :: columnFormat = "(A)" INTEGER :: dataType = COLUMN_UNDEFINED_TYPE REAL(KIND=KIND(1.0d0)), ALLOCATABLE :: doubleValues(:) CHARACTER(LEN=256) , ALLOCATABLE :: characterValues(:) INTEGER , ALLOCATABLE :: integerValues(:) END TYPE LatexTableColumn INTERFACE constructLatexTableColumn MODULE PROCEDURE :: newRealLatexTableColumn MODULE PROCEDURE :: newIntegerLatexTableColumn MODULE PROCEDURE :: newCharacterLatexTableColumn MODULE PROCEDURE :: newDPLatexTableColumn END INTERFACE PRIVATE :: newRealLatexTableColumn, newIntegerLatexTableColumn, newCharacterLatexTableColumn PRIVATE :: newDPLatexTableColumn CONTAINS ! !//////////////////////////////////////////////////////////////////////// ! SUBROUTINE newRealLatexTableColumn(tableColumn,title,columnData,columnFormat) IMPLICIT NONE TYPE(LatexTableColumn) :: tableColumn CHARACTER(LEN=*) :: title, columnFormat REAL(KIND=KIND(1.e0)) :: columnData(:) tableColumn % title = title tableColumn % columnFormat = columnFormat tableColumn % dataType = COLUMN_DOUBLEPRECISION_TYPE ALLOCATE(tableColumn % doubleValues(SIZE(columnData))) tableColumn % doubleValues = columnData END SUBROUTINE newRealLatexTableColumn ! !//////////////////////////////////////////////////////////////////////// ! SUBROUTINE newDPLatexTableColumn(tableColumn,title,columnData,columnFormat) IMPLICIT NONE TYPE(LatexTableColumn) :: tableColumn CHARACTER(LEN=*) :: title, columnFormat REAL(KIND=KIND(1.0d0)) :: columnData(:) tableColumn % title = title tableColumn % columnFormat = columnFormat tableColumn % dataType = COLUMN_DOUBLEPRECISION_TYPE ALLOCATE(tableColumn % doubleValues(SIZE(columnData))) tableColumn % doubleValues = columnData END SUBROUTINE newDPLatexTableColumn ! !//////////////////////////////////////////////////////////////////////// ! SUBROUTINE newIntegerLatexTableColumn(tableColumn,title,columnData,columnFormat) IMPLICIT NONE TYPE(LatexTableColumn) :: tableColumn CHARACTER(LEN=*) :: title, columnFormat INTEGER :: columnData(:) tableColumn % title = title tableColumn % columnFormat = columnFormat tableColumn % dataType = COLUMN_INTEGER_TYPE ALLOCATE(tableColumn % integerValues(SIZE(columnData))) tableColumn % integerValues = columnData END SUBROUTINE newIntegerLatexTableColumn ! !//////////////////////////////////////////////////////////////////////// ! SUBROUTINE newCharacterLatexTableColumn(tableColumn,title,columnData,columnFormat) IMPLICIT NONE TYPE(LatexTableColumn) :: tableColumn CHARACTER(LEN=*) :: title, columnFormat CHARACTER(LEN=*) :: columnData(:) tableColumn % title = title tableColumn % columnFormat = columnFormat tableColumn % dataType = COLUMN_CHARACTER_TYPE ALLOCATE(tableColumn % characterValues(SIZE(columnData))) tableColumn % characterValues = columnData END SUBROUTINE newCharacterLatexTableColumn ! !//////////////////////////////////////////////////////////////////////// ! FUNCTION numberOfRows(tableColumn) RESULT(N) IMPLICIT NONE TYPE(LatexTableColumn) :: tableColumn INTEGER :: N SELECT CASE ( tableColumn % dataType ) CASE( COLUMN_DOUBLEPRECISION_TYPE ) N = SIZE(tableColumn % doubleValues) CASE( COLUMN_CHARACTER_TYPE ) N = SIZE(tableColumn % characterValues) CASE( COLUMN_INTEGER_TYPE ) N = SIZE(tableColumn % integerValues) CASE DEFAULT N = 0 END SELECT END FUNCTION numberOfRows END MODULE LatexTableColumnClass !@mark - ! !//////////////////////////////////////////////////////////////////////// ! Module LatexTableMakerClass USE LatexTableColumnClass IMPLICIT NONE TYPE LatexTableMaker LOGICAL , PRIVATE :: hasLines_ = .TRUE. CHARACTER(LEN=256), PRIVATE :: tableEntryFormat_ = "g12.5" CHARACTER(LEN=2) , PRIVATE :: tabularString_ = "c|" CONTAINS PROCEDURE :: setHasLines PROCEDURE :: setTableEntryFormat PROCEDURE :: tableEntryFormat PROCEDURE :: hasLines PROCEDURE, PRIVATE :: writeDoublePrecisionTableAsLatex PROCEDURE, PRIVATE :: writeRealTableAsLatex PROCEDURE, PRIVATE :: writeIntegerTableAsLatex PROCEDURE, PRIVATE :: writeTableColumnArrayAsLatex GENERIC :: writeTableAsLatex => writeDoublePrecisionTableAsLatex, & writeIntegerTableAsLatex, & writeTableColumnArrayAsLatex, & writeRealTableAsLatex END TYPE LatexTableMaker ! ! ======== CONTAINS ! ======== ! !//////////////////////////////////////////////////////////////////////// ! SUBROUTINE setHasLines(self,set) IMPLICIT NONE CLASS(LatexTableMaker) :: self LOGICAL :: set self % hasLines_ = set IF ( set ) THEN self % tabularString_ = "c|" ELSE self % tabularString_ = "c" END IF END SUBROUTINE setHasLines ! !//////////////////////////////////////////////////////////////////////// ! LOGICAL FUNCTION hasLines(self) IMPLICIT NONE CLASS(LatexTableMaker) :: self hasLines = self % hasLines_ END FUNCTION hasLines ! !//////////////////////////////////////////////////////////////////////// ! SUBROUTINE setTableEntryFormat(self,formatString) IMPLICIT NONE CLASS(LatexTableMaker) :: self CHARACTER(LEN=*) :: formatString self % tableEntryFormat_ = formatString END SUBROUTINE setTableEntryFormat ! !//////////////////////////////////////////////////////////////////////// ! CHARACTER(LEN=256) FUNCTION tableEntryFormat(self) IMPLICIT NONE CLASS(LatexTableMaker) :: self tableEntryFormat = self % tableEntryFormat_ END FUNCTION tableEntryFormat ! !//////////////////////////////////////////////////////////////////////// ! SUBROUTINE writeDoublePrecisionTableAsLatex(self, tableData, headers, caption, label, fileUnit) IMPLICIT NONE CLASS(LatexTableMaker) :: self REAL(KIND(1.0d0)) :: tableData(:,:) CHARACTER(LEN=*) :: headers(:) CHARACTER(LEN=*) :: caption, label INTEGER :: fileUnit INTEGER :: nRows,nColumns,row, column CHARACTER(LEN=256) :: fmtStr1,fmtStr2 nRows = SIZE(tableData,1) nColumns = SIZE(tableData,2) CALL writeLatexHeader(self,nColumns,caption,fileUnit) CALL writeTableHeader(self,headers,fileUnit) ! ! ---------------- ! Write table data ! ---------------- ! fmtStr1 = "(*(1x," // TRIM(self % tableEntryFormat()) // ",' & ') )" fmtStr2 = "(" // TRIM(self % tableEntryFormat()) //",A )" DO row = 1, nRows WRITE(fileUnit,TRIM(fmtStr1), ADVANCE = "NO") (tableData(row,column), column=1,nColumns-1) WRITE(fileUnit,TRIM(fmtStr2)) tableData(row,nColumns),"\\" IF(self % hasLines()) WRITE(fileUnit,*) "\hline" END DO CALL writeLatexFooter(label,fileUnit) END SUBROUTINE writeDoublePrecisionTableAsLatex ! !//////////////////////////////////////////////////////////////////////// ! SUBROUTINE writeRealTableAsLatex(self, tableData, headers, caption, label, fileUnit) IMPLICIT NONE CLASS(LatexTableMaker) :: self REAL(KIND(1.0e0)) :: tableData(:,:) CHARACTER(LEN=*) :: headers(:) CHARACTER(LEN=*) :: caption, label INTEGER :: fileUnit INTEGER :: nRows,nColumns,row, column CHARACTER(LEN=256) :: fmtStr1,fmtStr2 nRows = SIZE(tableData,1) nColumns = SIZE(tableData,2) CALL writeLatexHeader(self,nColumns,caption,fileUnit) CALL writeTableHeader(self,headers,fileUnit) ! ! ---------------- ! Write table data ! ---------------- ! fmtStr1 = "(*(1x," // TRIM(self % tableEntryFormat()) // ",' & ') )" fmtStr2 = "(" // TRIM(self % tableEntryFormat()) //",A )" DO row = 1, nRows WRITE(fileUnit,TRIM(fmtStr1), ADVANCE = "NO") (tableData(row,column), column=1,nColumns-1) WRITE(fileUnit,TRIM(fmtStr2)) tableData(row,nColumns),"\\" IF(self % hasLines()) WRITE(fileUnit,*) "\hline" END DO CALL writeLatexFooter(label,fileUnit) END SUBROUTINE writeRealTableAsLatex ! !//////////////////////////////////////////////////////////////////////// ! SUBROUTINE writeIntegerTableAsLatex(self, tableData, headers, caption, label, fileUnit) IMPLICIT NONE CLASS(LatexTableMaker) :: self INTEGER :: tableData(:,:) CHARACTER(LEN=*) :: headers(:) CHARACTER(LEN=*) :: caption, label INTEGER :: fileUnit INTEGER :: nRows,nColumns,row, column CHARACTER(LEN=256) :: fmtStr1,fmtStr2 nRows = SIZE(tableData,1) nColumns = SIZE(tableData,2) CALL writeLatexHeader(self,nColumns,caption,fileUnit) CALL writeTableHeader(self,headers,fileUnit) ! ! ---------------- ! Write table data ! ---------------- ! fmtStr1 = "(*(1x," // TRIM(self % tableEntryFormat()) // ",' & ') )" fmtStr2 = "(" // TRIM(self % tableEntryFormat()) //",A )" DO row = 1, nRows WRITE(fileUnit,TRIM(fmtStr1), ADVANCE = "NO") (tableData(row,column), column=1,nColumns-1) WRITE(fileUnit,TRIM(fmtStr2)) tableData(row,nColumns),"\\" IF(self % hasLines()) WRITE(fileUnit,*) "\hline" END DO CALL writeLatexFooter(label,fileUnit) END SUBROUTINE writeIntegerTableAsLatex ! !//////////////////////////////////////////////////////////////////////// ! SUBROUTINE writeTableColumnArrayAsLatex(self, tableColumnsArray, caption, label, fileUnit, transpose) IMPLICIT NONE CLASS(LatexTableMaker) :: self TYPE(LatexTableColumn) :: tableColumnsArray(:) CHARACTER(LEN=*) :: caption, label INTEGER :: fileUnit INTEGER :: nRows,nColumns,row, column INTEGER :: k LOGICAL, OPTIONAL :: transpose CHARACTER(LEN=256), ALLOCATABLE :: headers(:) LOGICAL :: outputAsTranspose ! ! ----------------------------------- ! See what form the table should take ! ----------------------------------- ! outputAsTranspose = .FALSE. IF ( PRESENT(transpose) ) THEN outputAsTranspose = transpose END IF ! ! ------------------ ! Gather header data ! ------------------ ! nColumns = SIZE(tableColumnsArray) ALLOCATE(headers(nColumns)) nRows = 0 DO k = 1, nColumns nRows = MAX(nRows,numberOfRows(tableColumn = tableColumnsArray(k))) headers(k) = tableColumnsArray(k) % title END DO ! ! ---------------- ! Write out header ! ---------------- ! ! ! ----------------------------- ! Write out table in row format ! ----------------------------- ! IF ( outputAsTranspose ) THEN CALL writeLatexHeader( self, nRows+1, caption, fileUnit) IF(self % hasLines()) WRITE(fileUnit,*) "\hline" DO column = 1, nColumns WRITE(fileUnit,'(A)', ADVANCE = "NO") TRIM(headers(column)) WRITE(fileUnit,"(A)", ADVANCE = "NO") " & " DO row = 1, nRows IF( row > numberOfRows(tableColumnsArray(column)) ) THEN WRITE(fileUnit,"(A)",ADVANCE = "NO") " " ELSE SELECT CASE ( tableColumnsArray(column) % dataType ) CASE( COLUMN_INTEGER_TYPE ) WRITE(fileUnit,TRIM(tableColumnsArray(column) % columnFormat),ADVANCE = "NO") & tableColumnsArray(column) % integerValues(row) CASE( COLUMN_CHARACTER_TYPE ) WRITE(fileUnit,TRIM(tableColumnsArray(column) % columnFormat),ADVANCE = "NO") & TRIM(tableColumnsArray(column) % characterValues(row)) CASE( COLUMN_DOUBLEPRECISION_TYPE ) WRITE(fileUnit,TRIM(tableColumnsArray(column) % columnFormat),ADVANCE = "NO") & tableColumnsArray(column) % doubleValues(row) CASE DEFAULT WRITE(fileUnit,*) " " END SELECT END IF IF(row < nRows) WRITE(fileUnit,"(A)", ADVANCE = "NO") " & " END DO WRITE(fileUnit,"(A)") "\\" IF(self % hasLines()) WRITE(fileUnit,*) "\hline" END DO ELSE CALL writeLatexHeader( self, nRows, caption, fileUnit) CALL writeTableHeader( self, headers, fileUnit) ! ! --------------------------------- ! Write table data in column format ! --------------------------------- ! DO row = 1, nRows DO column = 1, nColumns IF( row > numberOfRows(tableColumn = tableColumnsArray(column)) ) THEN WRITE(fileUnit,"(A)",ADVANCE = "NO") " " ELSE SELECT CASE ( tableColumnsArray(column) % dataType ) CASE( COLUMN_INTEGER_TYPE ) WRITE(fileUnit,TRIM(tableColumnsArray(column) % columnFormat),ADVANCE = "NO") & tableColumnsArray(column) % integerValues(row) CASE( COLUMN_CHARACTER_TYPE ) WRITE(fileUnit,TRIM(tableColumnsArray(column) % columnFormat),ADVANCE = "NO") & TRIM(tableColumnsArray(column) % characterValues(row)) CASE( COLUMN_DOUBLEPRECISION_TYPE ) WRITE(fileUnit,TRIM(tableColumnsArray(column) % columnFormat),ADVANCE = "NO") & tableColumnsArray(column) % doubleValues(row) CASE DEFAULT WRITE(fileUnit,*) " " END SELECT END IF IF(column < nColumns) WRITE(fileUnit,"(A)", ADVANCE = "NO") " & " END DO WRITE(fileUnit,"(A)") "\\" IF(self % hasLines()) WRITE(fileUnit,*) "\hline" END DO END IF ! ! ---------------- ! Write out footer ! ---------------- ! CALL writeLatexFooter( label, fileUnit ) END SUBROUTINE writeTableColumnArrayAsLatex ! !//////////////////////////////////////////////////////////////////////// ! SUBROUTINE writeLatexHeader(self,n,caption,iUnit) IMPLICIT NONE CLASS(LatexTableMaker) :: self INTEGER :: n, iUnit CHARACTER(LEN=*) :: caption INTEGER :: j WRITE(iUnit,*) "\begin{table}[htdp]" WRITE(iUnit,*) "\caption{",TRIM(caption),"}" WRITE(iUnit,*) "\begin{center}" WRITE(iUnit,'(A)',ADVANCE = "NO") "\begin{tabular}{" IF(self % hasLines()) THEN WRITE(iUnit,'(A)',ADVANCE = "NO") "|" END IF WRITE(iUnit,"(*(A2) )",ADVANCE = "NO") (self % tabularString_, j=1,n) WRITE(iUnit,'(A)') "}" END SUBROUTINE writeLatexHeader ! !//////////////////////////////////////////////////////////////////////// ! SUBROUTINE writeLatexFooter(label,fileUnit) IMPLICIT NONE INTEGER :: fileUnit CHARACTER(LEN=*) :: label WRITE(fileUnit,*) "\end{tabular}" WRITE(fileUnit,*) "\end{center}" WRITE(fileUnit,*) "\label{tab:",TRIM(label),"}" WRITE(fileUnit,*) "\end{table}" END SUBROUTINE writeLatexFooter ! !//////////////////////////////////////////////////////////////////////// ! SUBROUTINE writeTableHeader(self,headers,fileUnit) IMPLICIT NONE CLASS(LatexTableMaker) :: self CHARACTER(LEN=*) :: headers(:) INTEGER :: fileUnit INTEGER :: nColumns, j nColumns = SIZE(headers) IF(self % hasLines()) WRITE(fileUnit,*) "\hline" WRITE(fileUnit,"(*(1x,A,' & ') )",ADVANCE="NO") (TRIM(headers(j)), j=1,nColumns-1) WRITE(fileUnit,"(A,A)") TRIM(headers(nColumns)),"\\" IF(self % hasLines()) WRITE(fileUnit,*) "\hline" END SUBROUTINE writeTableHeader END MODULE LatexTableMakerClass