! !//////////////////////////////////////////////////////////////////////// ! ! main.f90 ! Created: February 24, 2014 3:49 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. ! !//////////////////////////////////////////////////////////////////////// ! PROGRAM TestTable USE LatexTableMakerClass IMPLICIT NONE TYPE(LatexTableMaker) :: TMaker REAL(KIND(1.0d0)) :: tableData(4,5) REAL(KIND(1.0d0)) :: realData(5) = [0.1,0.2,0.3,0.4,0.5] INTEGER :: intData(5) = [1,2,3,4,5] CHARACTER(LEN=5) :: headers(5) = ["one ","two ","three","four ","five "] CHARACTER(LEN=23) :: caption = "Table Caption" CHARACTER(LEN=10) :: label = "TabLab" TYPE(LatexTableColumn), DIMENSION(3) :: tableColumns ! ! ---------------------- ! Bare bones array table ! ---------------------- ! tableData = 0.1 CALL TMaker % setHasLines(set = .FALSE.) CALL TMaker % setTableEntryFormat(formatString = "f12.3") CALL TMaker % writeTableAsLatex(tableData = tableData, & headers = headers, & caption = caption, & label = label, & fileUnit = 6) WRITE(6,*) ! ! ------------------- ! Using table columns ! ------------------- ! CALL constructLatexTableColumn(tableColumn = tableColumns(1),& title = "Names",& columnData = headers,& columnFormat = "(A)") CALL constructLatexTableColumn(tableColumn = tableColumns(2),& title = "Integers",& columnData = intData,& columnFormat = "(i6)") CALL constructLatexTableColumn(tableColumn = tableColumns(3),& title = "Doubles",& columnData = realData,& columnFormat = "(f12.5)") CALL TMaker % setHasLines(set = .TRUE.) CALL TMaker % writeTableAsLatex(tableColumnsArray = tableColumns,& caption = caption, & label = label, & fileUnit = 6) ! ! --------------------- ! Transposing the table ! --------------------- ! CALL TMaker % writeTableAsLatex(tableColumnsArray = tableColumns,& caption = caption, & label = label, & fileUnit = 6, & TRANSPOSE = .TRUE.) END PROGRAM TestTable