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

README.md

+# 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.
+

demo/demo.f90

+! 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

demo/demo_dt.f90

+! 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
+
+

demo/zzz.csv

+"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

tests/tests.f90

+! 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