Merge pull request #46 from jacobwilliams/40-quad-precision

add quad precision support

Author: jacobwilliams

.github/workflows/CI.yml

@@ -10,8 +10,8 @@ jobs:
       fail-fast: false
       matrix:
         os: [ubuntu-latest]
-        gcc_v: [9,10,11,12]  # gfortran versions to test
-        python-version: [3.9]
+        gcc_v: [12, 13]  # gfortran versions to test
+        python-version: [3.12]
     env:
       FC: gfortran-${{ matrix.gcc_v }}
       GCC_V: ${{ matrix.gcc_v }}
@@ -23,22 +23,22 @@ jobs:
         submodules: recursive
 
     - name: Install Python
-      if: contains( matrix.gcc_v, 10 )
-      uses: actions/setup-python@v4 # Use pip to install latest CMake, & FORD/Jin2For, etc.
+      if: contains( matrix.gcc_v, 12 )
+      uses: actions/setup-python@v5.4.0 # Use pip to install latest CMake, & FORD/Jin2For, etc.
       with:
         python-version: ${{ matrix.python-version }}
 
     - name: Setup Graphviz
-      if: contains( matrix.gcc_v, 10 )
+      if: contains( matrix.gcc_v, 12 )
       uses: ts-graphviz/setup-graphviz@v1
 
     - name: Setup Fortran Package Manager
-      uses: fortran-lang/setup-fpm@v5
+      uses: fortran-lang/setup-fpm@v7
       with:
         github-token: ${{ secrets.GITHUB_TOKEN }}
 
     - name: Install Python dependencies
-      if: contains( matrix.gcc_v, 10 )
+      if: contains( matrix.gcc_v, 12 )
       run: |
         python -m pip install --upgrade pip
         pip install ford numpy matplotlib
@@ -59,7 +59,7 @@ jobs:
       run: fpm test --profile debug --flag -coverage
 
     - name: Create coverage report
-      if: contains( matrix.gcc_v, 10 )
+      if: contains( matrix.gcc_v, 12 )
       run: |
         mkdir -p ${{ env.COV_DIR }}
         mv ./build/gfortran_*/*/* ${{ env.COV_DIR }}
@@ -70,18 +70,19 @@ jobs:
         COV_DIR: build/coverage
 
     - name: Upload coverage report
-      if: contains( matrix.gcc_v, 10 )
+      if: contains( matrix.gcc_v, 12 )
       uses: codecov/codecov-action@v3
       with:
         files: build/coverage/coverage.info
 
     - name: Build documentation
-      if: contains( matrix.gcc_v, 10 )
+      if: contains( matrix.gcc_v, 12 )
       run: ford ./ford.md
 
     - name: Deploy Documentation
-      if: contains( matrix.gcc_v, 10 ) && github.ref == 'refs/heads/master'
-      uses: JamesIves/github-pages-deploy-action@v4.4.1
+      if: contains( matrix.gcc_v, 12 ) && github.ref == 'refs/heads/master'
+      uses: JamesIves/github-pages-deploy-action@v4.7.3
       with:
         branch: gh-pages # The branch the action should deploy to.
         folder: doc  # The folder the action should deploy.
+        single-commit: true

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
@@ -441,15 +443,23 @@ subroutine add_cell(me,val,int_fmt,real_fmt,trim_str)
             if (present(real_fmt)) then
                 rfmt = trim(adjustl(real_fmt))
             else
-                rfmt = default_real_fmt
+                rfmt = default_sp_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 (real(wp))
             if (present(real_fmt)) then
                 rfmt = trim(adjustl(real_fmt))
             else
-                rfmt = default_real_fmt
+                rfmt = default_wp_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 (real(qp))
+            if (present(real_fmt)) then
+                rfmt = trim(adjustl(real_fmt))
+            else
+                rfmt = default_qp_fmt
             end if
             write(real_val,fmt=rfmt,iostat=istat) val
             write(me%iunit,fmt='(A)',advance='NO',iostat=istat) trim(adjustl(real_val))
@@ -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.

src/csv_parameters.f90

@@ -8,13 +8,15 @@ module csv_parameters
 
     private
 
-    integer(ip),parameter,public :: max_real_str_len = 27 !! maximum string length of a real number
-    character(len=*),parameter,public :: default_real_fmt = '(E27.17E4)'
-        !! default real number format statement (for writing real values to strings and files).
+    integer(ip),parameter,public :: max_real_str_len = 256 !! maximum string length of a real number
+
+    character(len=*),parameter,public :: default_sp_fmt = '(E17.8E3)'  !! default single number format statement
+    character(len=*),parameter,public :: default_wp_fmt = '(E27.17E4)' !! default double number format statement 
+    character(len=*),parameter,public :: default_qp_fmt = '(E46.35E5)' !! default quad number format statement
 
     integer(ip),parameter,public :: max_integer_str_len = 256 !! maximum string length of an integer.
     character(len=*),parameter,public :: default_int_fmt  = '(I256)'
-        !! default integer number format statement (for writing real values to strings and files).
+        !! default integer number format statement (for writing integer values to strings and files).
 
     end module csv_parameters
 !*******************************************************************************

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:'