Skip to content

Add additional real kind: real32 #21

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Apr 14, 2022
Merged

Add additional real kind: real32 #21

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 2 additions & 1 deletion src/csv_kinds.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
83 changes: 74 additions & 9 deletions src/csv_module.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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))
Expand Down Expand Up @@ -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

Expand All @@ -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
!*****************************************************************************************

!*****************************************************************************************
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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=*))
Expand Down Expand Up @@ -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)') &
Expand All @@ -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

Expand All @@ -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
!*****************************************************************************************

!*****************************************************************************************
Expand Down
35 changes: 33 additions & 2 deletions src/tests/csv_test.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand All @@ -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
Expand Down Expand Up @@ -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:'
Expand All @@ -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)

Expand Down Expand Up @@ -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)
Expand All @@ -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
Expand Down Expand Up @@ -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()
Expand Down