Commit 9b490500 authored by Sergey.Budaev's avatar Sergey.Budaev
Browse files

synchronized stand-alone CSV_IO module with latest HEDTOOLS 1.3


git-svn-id: https://tegsvn.uib.no/svn/tegsvn/tags/CSV_IO/1.3@9009 ad98353e-09f0-4531-9f56-ca5884d0cf98
parents
# CSV_IO STANDALONE #
This is a stand-alone version of the CSV_IO module from HEDTOOLS that
can be used independently of all other HEDTOOLS procedures.
## Tests
To build the test program in `tests` directory do this:
gfortran -o csvtest m_CSV_IO.f90 tests/tests.f90
and then run the `csvtest` program.
! This program illustrates how to copy data across two arrays, one
! of which is allocatable (X) and is read from CSV file, whereas the other
! is fixed non-allocatable (Y).
! Then, the data read from the CSV file (X), and only these data are copied
! into the fixed array Y.
! Note: The code uses the DISPMODULE
! Jonasson, K. 2009. Algorithm 892: DISPMODULE, a Fortran 95 module for
! pretty-printing matrices. ACM Trans. Math. Softw. 36, 1, Article 6
! (March 2009), 7 pages. DOI: https://doi.org/10.1145/1486525.1486531.
! Code: https://github.com/radiganm/dispmodule
!-------------------------------------------------------------------------------
! Compile and build this demo:
! gfortran m_dispmd.f90 ../m_CSV_IO.f90 demo.f90
!-------------------------------------------------------------------------------
program test_part_matrix
use CSV_IO, only : CSV_MATRIX_READ, CSV_MATRIX_WRITE
use DISPMODULE, only: DISP ! DISPMODULE is used for pretty printing
! 'X' is dynamic size array, it is allocated depending on the valid data that
! is read from the CSV data file. So, 'X' can be either small or big as the
! data in the file.
real, allocatable, dimension(:,:) :: X
! 'Y' data is fixed size array, change dimensions to play with the data.
real, dimension(20,8) :: Y
integer :: xrows, xcols, yrows, ycols
X = CSV_MATRIX_READ("zzz.csv", missing_code = -9999.0)
xrows = size(X,1)
xcols = size(X,2)
print *, "X (CSV) size ", xrows, xcols
print *, "X (CSV) is allocated automatically ", allocated(X)
call DISP(' X = ', X)
print *, "------------------------------------"
! Initialize the 'Y' matrix with some empty or missing code, or zero data.
Y = -9999.0
yrows = size(Y, 1)
ycols = size(Y, 2)
print *, "Y size ", yrows, ycols, "(fixed array)"
! Here we check if 'Y' matrix dimensions are bigger than 'X' (that comes
! from the CSV file and is allocatable/dynamic). If yes, only a subset of
! the 'Y' is filled with data from 'X'. If 'Y' is smaller than the 'X' data,
! then only the fitting part of Y is filled by data from X.
if ( yrows > xrows ) yrows = xrows
if ( ycols > xcols ) ycols = xcols
Y( 1:yrows, 1:ycols ) = X ! Copy only the X-sized part of data into Y
call DISP(' Y = ', Y)
call CSV_MATRIX_WRITE(Y,"zzz_out.csv")
end program test_part_matrix
! This program illustrates how to convert an array of derived type, some
! data component of which is also an array into a two-dimensional array.
! This may be helpful to use the CSV_MATRIX_WRITE subroutine to save data
! array into a CSV file.
! Note: The code uses the DISPMODULE
! Jonasson, K. 2009. Algorithm 892: DISPMODULE, a Fortran 95 module for
! pretty-printing matrices. ACM Trans. Math. Softw. 36, 1, Article 6
! (March 2009), 7 pages. DOI: https://doi.org/10.1145/1486525.1486531.
! Code: https://github.com/radiganm/dispmodule
!-------------------------------------------------------------------------------
! Compile and build this demo:
! gfortran m_dispmd.f90 ../m_CSV_IO.f90 demo_dt.f90
!-------------------------------------------------------------------------------
program test_csv_type
use CSV_IO, only : CSV_MATRIX_WRITE
use DISPMODULE, only: DISP ! DISPMODULE is used for pretty printing
integer, parameter :: TYPE_MAX = 3, N_OBJECTS = 5
integer :: i,j
real, parameter :: MISSING = -9999.0
! Declare the derived type `struct_def`
type :: struct_def
real :: real_comp
integer :: intg_comp
real, dimension(TYPE_MAX) :: array_comp
end type struct_def
! Declare an array of the objects of the type `struct_def`
type(struct_def), dimension(N_OBJECTS) :: objects_array
! Temporary array
real, dimension(N_OBJECTS, TYPE_MAX) :: tmp_data
! Initialise the objects array of the type `struct_def`
! using the type constructor.
objects_array(1) = struct_def( 1.0, 1, [1.1, 1.2, 1.3] )
objects_array(2) = struct_def( 2.0, 2, [2.1, 2.2, 2.3] )
objects_array(3) = struct_def( 3.0, 3, [3.1, 3.2, 3.3] )
objects_array(4) = struct_def( 4.0, 4, [4.1, 4.2, 4.3] )
objects_array(5) = struct_def( 5.0, 5, [5.1, 5.2, 5.3] )
!-----------------------------------------------------------------------------
! Convert the derived type components into a 2-D temporary array
do i = 1, N_OBJECTS
do j=1, TYPE_MAX
tmp_data(i,j) = objects_array(i)%array_comp(j)
end do
end do
print *, "Array composed from the derived type through nested loops:"
call disp(" tmp array = ", tmp_data)
! Write the temporary array to the CSV output file.
call CSV_MATRIX_WRITE( tmp_data, "data_file_1_tmp_loops.csv" )
print *, ""
!-----------------------------------------------------------------------------
print *, ""
print *, "Array composed from the derived type inline, via implied loops:"
call disp( " construct = ", &
reshape( [( [( objects_array(i)%array_comp(j), i=1,N_OBJECTS )], &
j=1, TYPE_MAX )], &
[N_OBJECTS,TYPE_MAX] ) )
! The derived type can be converted to the array inline by combination of
! reshape with two implied loops. This is a short version of the code.
call CSV_MATRIX_WRITE( &
reshape( [( [( objects_array(i)%array_comp(j), i=1,N_OBJECTS )], &
j=1, TYPE_MAX )], &
[N_OBJECTS,TYPE_MAX] ), &
"data_file_2_inline.csv" )
end program test_csv_type
This diff is collapsed.
"V1","V2","V3","V4","V5"
1,2,3,4,5
11,12,13,14,15
21,22,23,24,25
31,32,33,34,35
This diff is collapsed.
! Testing m_CSV_IO.f90
! Build command:
! gfortran ../m_CSV_IO.f90 tests.f90
module m_tests
contains
!> This is called whenever test fails. In this case, the test program
!! terminates with the exit code 255.
subroutine fail_test(name)
character(*), intent(in) :: name
character(*), parameter :: MESSAGE = "Fail test "
print *, MESSAGE, name
stop 255
end subroutine fail_test
!> This is called whenever test passes
subroutine pass_test(name)
character(*), intent(in) :: name
print *, "Passed ", name
end subroutine pass_test
end module m_tests
!===============================================================================
program tests_hedtools
use m_tests
print *, "*** Tests started ***"
call test_CSV_IO()
print *, "*** Tests completed ***"
contains
subroutine test_CSV_IO
use CSV_IO
integer :: unum
logical :: fstat
integer, parameter :: ROWS=100, COLS=20
real, dimension(ROWS,COLS) :: DATA_OUT, DATA_IN
character(len=*), parameter :: TESTNAME="test_CSV_IO"
print *, "Test: ", TESTNAME
if (.not. CHECK_UNIT_VALID(1) .eqv. .TRUE.) &
call fail_test("CHECK_UNIT_VALID 1")
if (.not. CHECK_UNIT_VALID(0) .eqv. .FALSE.) &
call fail_test("CHECK_UNIT_VALID 0")
if (.not. CHECK_UNIT_VALID(-1) .eqv. .FALSE.) &
call fail_test("CHECK_UNIT_VALID -1")
if (.not. CHECK_UNIT_VALID(500) .eqv. .FALSE.) &
call fail_test("CHECK_UNIT_VALID 500")
! This file does not exist so far
if (.not. CHECK_FILE_OPEN("i_dont_exist.csv") .eqv. .FALSE.) &
call fail_test("CHECK_FILE_OPEN non-exist")
! Opening new file for writing CHECK_FILE_OPEN returns TRUE
! test_file_1.csv is not used, no content
call CSV_OPEN_WRITE("test_file_1.csv", unum, fstat)
if (.not. fstat .eqv. .TRUE.) call fail_test("Exist file write T")
if (.not. CHECK_FILE_OPEN("test_file_1.csv") .eqv. .TRUE.) &
call fail_test("CHECK_FILE_OPEN exist T")
! Opening non-existing file for reading CHECK_FILE_OPEN returns FALSE
call CSV_OPEN_READ("i_dont_exist.csv", unum, fstat)
if (.not. fstat .eqv. .FALSE.) call fail_test("Non-exist read file F")
if (.not. CHECK_FILE_OPEN("i_dont_exist.csv") .eqv. .FALSE.) &
call fail_test("CHECK_FILE_OPEN non-exist F")
DATA_OUT = 1.1
call CSV_MATRIX_WRITE(DATA_OUT, "file_1.csv" )
DATA_IN = CSV_MATRIX_READ("file_1.csv")
if ( any(DATA_OUT /= DATA_IN) ) call fail_test("DATA IN /= OUT")
end subroutine test_CSV_IO
end program tests_hedtools
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment