add quad precision support

Fixes #40

Author: jacobwilliams

src/csv_kinds.f90

@@ -4,10 +4,11 @@
 
     module csv_kinds
 
-    use iso_fortran_env, only: real64,real32,int32
+    use iso_fortran_env, only: real128,real64,real32,int32
 
     private
 
+    integer,parameter,public :: qp = real128 !! quad real kind
     integer,parameter,public :: wp = real64  !! default real kind
     integer,parameter,public :: sp = real32  !! additional real kind, single precision
     integer,parameter,public :: ip = int32   !! default integer kind

src/csv_module.F90

@@ -91,6 +91,7 @@ module csv_module
                                  csv_get_value,&
                                  get_real_sp_column,&
                                  get_real_wp_column,&
+                                 get_real_qp_column,&
                                  get_integer_column,&
                                  get_logical_column,&
                                  get_character_column,&
@@ -99,6 +100,7 @@ module csv_module
         procedure :: csv_get_value
         procedure :: get_real_sp_column
         procedure :: get_real_wp_column
+        procedure :: get_real_qp_column
         procedure :: get_integer_column
         procedure :: get_logical_column
         procedure :: get_character_column
@@ -453,6 +455,14 @@ subroutine add_cell(me,val,int_fmt,real_fmt,trim_str)
             end if
             write(real_val,fmt=rfmt,iostat=istat) val
             write(me%iunit,fmt='(A)',advance='NO',iostat=istat) trim(adjustl(real_val))
+        type is (real(qp))
+            if (present(real_fmt)) then
+                rfmt = trim(adjustl(real_fmt))
+            else
+                rfmt = default_real_fmt
+            end if
+            write(real_val,fmt=rfmt,iostat=istat) val
+            write(me%iunit,fmt='(A)',advance='NO',iostat=istat) trim(adjustl(real_val))
         type is (logical)
             if (val) then
                 write(me%iunit,fmt='(A)',advance='NO',iostat=istat) me%logical_true_string
@@ -756,6 +766,31 @@ pure elemental subroutine to_real_wp(str,val,status_ok)
     end subroutine to_real_wp
 !*****************************************************************************************
 
+!*****************************************************************************************
+!>
+!  Convert a string to a `real(qp)`
+
+    pure elemental subroutine to_real_qp(str,val,status_ok)
+
+    implicit none
+
+    character(len=*),intent(in) :: str
+    real(qp),intent(out) :: val
+    logical,intent(out) :: status_ok
+
+    integer :: istat  !! read `iostat` error code
+
+    read(str,fmt=*,iostat=istat) val
+    if (istat==0) then
+        status_ok = .true.
+    else
+        status_ok = .false.
+        val = zero
+    end if
+
+    end subroutine to_real_qp
+!*****************************************************************************************
+
 !*****************************************************************************************
 !>
 !  Convert a string to a `integer(ip)`
@@ -924,6 +959,8 @@ subroutine csv_get_value(me,row,col,val,status_ok)
         call to_real_sp(me%csv_data(row,col)%str,val,status_ok)
     type is (real(wp))
         call to_real_wp(me%csv_data(row,col)%str,val,status_ok)
+    type is (real(qp))
+        call to_real_qp(me%csv_data(row,col)%str,val,status_ok)
     type is (logical)
         call to_logical(me%csv_data(row,col)%str,val,status_ok)
     type is (character(len=*))
@@ -1003,6 +1040,10 @@ subroutine get_column(me,icol,r,status_ok)
                     if (me%verbose) write(error_unit,'(A)') &
                         'Error converting string to real(real64): '//trim(me%csv_data(i,icol)%str)
                     r(i) = zero
+                type is (real(qp))
+                    if (me%verbose) write(error_unit,'(A)') &
+                        'Error converting string to real(real128): '//trim(me%csv_data(i,icol)%str)
+                    r(i) = zero
                 type is (logical)
                     if (me%verbose) write(error_unit,'(A)') &
                         'Error converting string to logical: '//trim(me%csv_data(i,icol)%str)
@@ -1068,6 +1109,30 @@ subroutine get_real_wp_column(me,icol,r,status_ok)
     end subroutine get_real_wp_column
 !*****************************************************************************************
 
+!*****************************************************************************************
+!>
+!  Return a column from a CSV file as a `real(qp)` vector.
+
+    subroutine get_real_qp_column(me,icol,r,status_ok)
+
+    implicit none
+
+    class(csv_file),intent(inout) :: me
+    integer,intent(in) :: icol  !! column number
+    real(qp),dimension(:),allocatable,intent(out) :: r
+    logical,intent(out) :: status_ok
+
+    if (allocated(me%csv_data)) then
+        allocate(r(me%n_rows))  ! size the output vector
+        call me%get_column(icol,r,status_ok)
+    else
+        if (me%verbose) write(error_unit,'(A,1X,I5)') 'Error: class has not been initialized'
+        status_ok = .false.
+    end if
+
+    end subroutine get_real_qp_column
+!*****************************************************************************************
+
 !*****************************************************************************************
 !>
 !  Return a column from a CSV file as a `integer(ip)` vector.

test/csv_test.f90

@@ -7,7 +7,7 @@
     program csv_test
 
     use csv_module
-    use iso_fortran_env, only: wp => real64, sp => real32
+    use iso_fortran_env, only: wp => real64, sp => real32, qp => real128
 
     implicit none
 
@@ -29,6 +29,7 @@ subroutine csv_test_1()
         character(len=30),dimension(:,:),allocatable :: csv_data  !! the data from the file as strings
         real(wp),dimension(:),allocatable :: x  !! for getting a real(wp) vector from a csv file
         real(sp),dimension(:),allocatable :: y  !! for getting a real(sp) vector from a csv file
+        real(qp),dimension(:),allocatable :: z  !! for getting a real(qp) vector from a csv file
         logical :: status_ok  !! error flag
         integer,dimension(:),allocatable :: itypes  !! array of variable types in the file
         integer :: ifile !! file counter
@@ -103,6 +104,9 @@ subroutine csv_test_1()
                 call f%get(3,y,status_ok)
                 write(*,'(F6.3,1x)',advance='NO') y
                 write(*,*) ''
+
+                call f%get(3,z,status_ok) ! also try as quad precision
+
             else
                 write(*,*) ''
                 write(*,*) 'name:'