diff --git a/src/csv_kinds.f90 b/src/csv_kinds.f90 index 0abd677..f9e9c7c 100644 --- a/src/csv_kinds.f90 +++ b/src/csv_kinds.f90 @@ -4,11 +4,12 @@ module csv_kinds - use iso_fortran_env, only: real64,int32 + use iso_fortran_env, only: real64,real32,int32 private 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 end module csv_kinds diff --git a/src/csv_module.F90 b/src/csv_module.F90 index c9cb260..cf3b9e7 100644 --- a/src/csv_module.F90 +++ b/src/csv_module.F90 @@ -89,14 +89,16 @@ module csv_module ! after the file has been read. generic,public :: get => get_csv_data_as_str,& csv_get_value,& - get_real_column,& + get_real_sp_column,& + get_real_wp_column,& get_integer_column,& get_logical_column,& get_character_column,& get_csv_string_column procedure :: get_csv_data_as_str procedure :: csv_get_value - procedure :: get_real_column + procedure :: get_real_sp_column + procedure :: get_real_wp_column procedure :: get_integer_column procedure :: get_logical_column procedure :: get_character_column @@ -428,6 +430,14 @@ subroutine add_cell(me,val,int_fmt,real_fmt,trim_str) end if write(int_val,fmt=ifmt,iostat=istat) val write(me%iunit,fmt='(A)',advance='NO',iostat=istat) trim(adjustl(int_val)) + type is (real(sp)) + 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 (real(wp)) if (present(real_fmt)) then rfmt = trim(adjustl(real_fmt)) @@ -689,11 +699,36 @@ subroutine get_csv_data_as_str(me,csv_data,status_ok) end subroutine get_csv_data_as_str !***************************************************************************************** +!***************************************************************************************** +!> +! Convert a string to a `real(sp)` + + pure elemental subroutine to_real_sp(str,val,status_ok) + + implicit none + + character(len=*),intent(in) :: str + real(sp),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_sp +!***************************************************************************************** + !***************************************************************************************** !> ! Convert a string to a `real(wp)` - pure elemental subroutine to_real(str,val,status_ok) + pure elemental subroutine to_real_wp(str,val,status_ok) implicit none @@ -711,7 +746,7 @@ pure elemental subroutine to_real(str,val,status_ok) val = zero end if - end subroutine to_real + end subroutine to_real_wp !***************************************************************************************** !***************************************************************************************** @@ -840,7 +875,7 @@ subroutine infer_variable_type(str,itype) return end if - call to_real(str,rval,status_ok) + call to_real_wp(str,rval,status_ok) if (status_ok) then itype = csv_type_double return @@ -878,8 +913,10 @@ subroutine csv_get_value(me,row,col,val,status_ok) select type (val) type is (integer(ip)) call to_integer(me%csv_data(row,col)%str,val,status_ok) + type is (real(sp)) + call to_real_sp(me%csv_data(row,col)%str,val,status_ok) type is (real(wp)) - call to_real(me%csv_data(row,col)%str,val,status_ok) + call to_real_wp(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=*)) @@ -951,9 +988,13 @@ subroutine get_column(me,icol,r,status_ok) if (me%verbose) write(error_unit,'(A)') & 'Error converting string to integer: '//trim(me%csv_data(i,icol)%str) r(i) = 0 + type is (real(sp)) + if (me%verbose) write(error_unit,'(A)') & + 'Error converting string to real(real32): '//trim(me%csv_data(i,icol)%str) + r(i) = zero type is (real(wp)) if (me%verbose) write(error_unit,'(A)') & - 'Error converting string to real: '//trim(me%csv_data(i,icol)%str) + 'Error converting string to real(real64): '//trim(me%csv_data(i,icol)%str) r(i) = zero type is (logical) if (me%verbose) write(error_unit,'(A)') & @@ -972,11 +1013,35 @@ subroutine get_column(me,icol,r,status_ok) end subroutine get_column !***************************************************************************************** +!***************************************************************************************** +!> +! Return a column from a CSV file as a `real(sp)` vector. + + subroutine get_real_sp_column(me,icol,r,status_ok) + + implicit none + + class(csv_file),intent(inout) :: me + integer,intent(in) :: icol !! column number + real(sp),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_sp_column +!***************************************************************************************** + !***************************************************************************************** !> ! Return a column from a CSV file as a `real(wp)` vector. - subroutine get_real_column(me,icol,r,status_ok) + subroutine get_real_wp_column(me,icol,r,status_ok) implicit none @@ -993,7 +1058,7 @@ subroutine get_real_column(me,icol,r,status_ok) status_ok = .false. end if - end subroutine get_real_column + end subroutine get_real_wp_column !***************************************************************************************** !***************************************************************************************** diff --git a/src/tests/csv_test.f90 b/src/tests/csv_test.f90 index 758ee7c..e485869 100644 --- a/src/tests/csv_test.f90 +++ b/src/tests/csv_test.f90 @@ -7,7 +7,7 @@ program csv_test use csv_module - use iso_fortran_env, only: wp => real64 + use iso_fortran_env, only: wp => real64, sp => real32 implicit none @@ -27,7 +27,8 @@ subroutine csv_test_1() integer :: k !! counter character(len=30),dimension(:),allocatable :: header !! the header character(len=30),dimension(:,:),allocatable :: csv_data !! the data from the file as strings - real(wp),dimension(:),allocatable :: x !! for getting a real vector from a csv file + 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 logical :: status_ok !! error flag integer,dimension(:),allocatable :: itypes !! array of variable types in the file integer :: ifile !! file counter @@ -92,10 +93,16 @@ subroutine csv_test_1() write(*,*) 'get some vectors:' if (ifile==1) then write(*,*) '' + write(*,*) 'get real(wp) vector:' write(*,*) 'age:' call f%get(3,x,status_ok) write(*,'(F6.3,1x)',advance='NO') x write(*,*) '' + write(*,*) 'get real(sp) vector:' + write(*,*) 'age:' + call f%get(3,y,status_ok) + write(*,'(F6.3,1x)',advance='NO') y + write(*,*) '' else write(*,*) '' write(*,*) 'name:' @@ -120,6 +127,13 @@ subroutine csv_test_1() call f2%add([4.0_wp,5.0_wp,6.0_wp],real_fmt='(F5.3)') ! add as vectors call f2%add(.false.) call f2%next_row() + call f2%add(1.5_sp) ! add as scalars + call f2%add(2.5_sp) + call f2%add(3.5_sp) + call f2%add(.true.) + call f2%next_row() + call f2%add([4.5_sp,5.5_sp,6.5_sp],real_fmt='(F5.3)') ! add as vectors + call f2%add(.false.) end if call f2%close(status_ok) @@ -153,6 +167,12 @@ subroutine csv_write_test() call f%add([4.0_wp,5.0_wp,6.0_wp],real_fmt='(F5.3)') call f%add(.false.) call f%next_row() + call f%add([1.5_sp,2.5_sp,3.5_sp],real_fmt='(F5.3)') + call f%add(.true.) + call f%next_row() + call f%add([4.5_sp,5.5_sp,6.5_sp],real_fmt='(F5.3)') + call f%add(.false.) + call f%next_row() ! finished call f%close(status_ok) @@ -170,6 +190,7 @@ subroutine csv_read_test() type(csv_file) :: f character(len=30),dimension(:),allocatable :: header real(wp),dimension(:),allocatable :: x,y,z + real(sp),dimension(:),allocatable :: u,v,w logical,dimension(:),allocatable :: t logical :: status_ok integer,dimension(:),allocatable :: itypes @@ -199,6 +220,16 @@ subroutine csv_read_test() write(*,*) 'y=',y write(*,*) 'z=',z write(*,*) 't=',t + + call f%get(1,u,status_ok) + call f%get(2,v,status_ok) + call f%get(3,w,status_ok) + call f%get(4,t,status_ok) + + write(*,*) 'x=',u + write(*,*) 'y=',v + write(*,*) 'z=',w + write(*,*) 't=',t ! destroy the file call f%destroy()