! mod_rw_csv.f90
! THIS MODULE CONTAINS ROUTINES TO READ & WRITE SIMPLE CSV FILES WITH A HEADER 
!
! RULES FOR THE CSV FILES:
!    THE HEADER DESCRIBING THE VARIABLES IN THE COLUMNS MUST BE ON THE FIRST LINE
!    FIELD SEPARATORS ARE COMMAS (or see c_sep definitions)
!    COMMENTED LINES ARE INDICATED BY A '#' ON THE FIRST CHARACTER (or see c_comment)
!    NO COMMAS ARE ALLOWED INSIDE FIELDS
! Parameters defined automatically within mod_rw_csv.f90:
!    maxlinelen IS THE MAXIMUM LENGTH OF A DATA LINE
!    maxentrylen IS THE MAXIMUM LENGTH OF A DATA ENTRY
!    maxheaderlen IS THE MAXIMUM LENGTH OF A HEADER ENTRY
!    maxentrynum IS THE MAXIMUM NUMBER OF DATA PARAMETERS
!    csvunit IS THE LOGICAL UNIT USED TO READ THE CSV FILE (CHECK THAT IT IS NOT IN CONFLICT WITH ANOTHER OPENED FILE)
!
! FUNCTIONS AND SUBROUTINES IN THIS MODULE
!    COUNTCOLS: counts the number of (comma-separated) columns in a line
!    COUNTLINES: counts the number of (data) lines in a file
!    EXTRACTCOLS: as COUNTCOLS, but extracts the columns as a string array
!    READ_CSV_TAB: reads a .csv file and outputs headers and array of values(line,col)
!    READ_CSV_VEC: reads a .csv file into a number of real vectors 
!    ISTRINARRAY: compares a simple string to a string array (such as the header array)
!    WRITECSV: given an array of headers and a matrix of vectors, writes a csv file 
!    ONE2TWOD: subroutine to transform a matrix (x_i,y_i,z_i) into vectors x_i and y_i and a 2D array z(x_i,y_i)
! 
! AUTHOR:
!    Tristan Guillot, Observatoire de la Cote d'Azur
!
! VERSION:
!    2014/05/12
! 
! EXAMPLE OF A PROGRAM TO USE THE SUBROUTINES IN THIS MODULE
! ! program test_rw_csv
! !   use mod_rw_csv
! !   implicit none
! !   character(len=80) :: line
! !   integer i,j,k
! !   character(len=maxentrylen), DIMENSION(:), ALLOCATABLE :: cvalues
! !   character(len=maxheaderlen), dimension(:), ALLOCATABLE :: headers
! !   real(kind=8), dimension(:,:), ALLOCATABLE :: values
! !   real(kind=8), dimension(:), ALLOCATABLE :: test1,test2,test3,test4

! !   line="M,R,P,T"
! !   write(*,*)'------------ Testing EXTRACTCOLS ---------------'
! !   write(*,*)COUNTCOLS(line),' vs 4'
! !   call EXTRACTCOLS(line,cvalues)
! !   write(*,*)' => ',('"'//trim(cvalues(j))//'" ',j=1,size(cvalues)),'<='

! !   write(*,*)'------------ Testing COUNTLINES ---------------'
! !   j=COUNTLINES("cities.csv",ncommentlines=k)
! !   write(*,*)"cities.csv => ",j," comments=",k

! !   write(*,*)'------------ Testing READ_CSV_TAB ---------------'
! !   call READ_CSV_TAB("grades.csv",headers,values)
! !   write(*,*)'------------------'
! !   write(*,*)(headers(j),j=1,size(headers))
! !   do i=1,size(values(:,0))
! !      write(*,*)(real(values(i,j)),j=1,size(values(0,:)))
! !   enddo
! !   write(*,*)'Note: the procedure handles real values only (no characters!)'

! !   write(*,*)'------------ Testing ISTRINARRAY ---------------'
! !   write(*,*)headers
! !   write(*,*)ISTRINARRAY(headers,'Test1')
! !   write(*,*)headers(ISTRINARRAY(headers,'"Test1"'))

! !   write(*,*)'------------ Testing READ_CSV_VEC ---------------'
! !   call READ_CSV_VEC("grades.csv",'Test1',test1,'Test2',test2,'Test3',test3,'Test4',test4)
! !   write(*,*)'Test1,Test2,Test3,Test4'
! !   do i=1,size(test1)
! !      write(*,*)real(test1(i)),real(test2(i)),real(test3(i)),real(test4(i))
! !   enddo

! !   write(*,*)'------------ Testing WRITE_CSV ---------------'
! !   call WRITE_CSV("test.csv",(/"Test1","Test2","Test3"/),(/test1,test2,test3/))

! ! end program test_rw_csv

module MOD_RW_CSV

  implicit none
  integer, parameter :: maxlinelen=1000,maxentrylen=100,maxheaderlen=20,maxentrynum=100,csvunit=67
  character, parameter :: c_sep=',', c_comment='#'
contains

  !____________________________________________________________________________________________________
  function COUNTCOLS(line)
    ! returns the number of columns (separated by commas) in a line
    character(len=*), INTENT(in) :: line
    integer :: COUNTCOLS
    !---local---
    integer :: icomma,icomma0,strlen
    !-----------
    COUNTCOLS=1
    strlen=len(line)
    icomma0=scan(line,c_sep)
    icomma=icomma0
    do while (icomma0.ne.0.and.icomma.le.strlen)
       COUNTCOLS=COUNTCOLS+1
       icomma0=scan(line(icomma+1:),c_sep)
       icomma=icomma+icomma0
    enddo

  end function COUNTCOLS

  !____________________________________________________________________________________________________
  function COUNTLINES(file,ncommentlines,ierr)
    ! returns the number of lines in a file EXCEPT the first one (header) and the commented ones
    ! ncommentlines is the number of commented lines (i.e. beginning with "#")
    character(len=*), INTENT(in) :: file
    integer, INTENT(out), OPTIONAL :: ncommentlines,ierr
    integer :: COUNTLINES
    !---local---
    character(len=1) :: car
    integer :: ios
    !-----------
    open(unit=csvunit,file=file,status='old',err=167)
    COUNTLINES=0
    if (present(ncommentlines)) ncommentlines=0
    read(csvunit,'(a)',iostat=ios)car
    read(csvunit,'(a)',iostat=ios)car
    do while (ios.EQ.0)
       if (car.ne.c_comment) then
          COUNTLINES=COUNTLINES+1
       else if (present(ncommentlines)) then
          ncommentlines=ncommentlines+1
       endif
       read(csvunit,'(a)',iostat=ios)car
    enddo
    close(unit=csvunit)
    if (present(ierr)) ierr=0
    return
167 if (PRESENT(ierr)) then
       ierr=1
    else 
       write(*,*)'COUNTLINES: ERROR with file ',file
       write(*,*)'            I must stop.'
       stop
    endif

  end function COUNTLINES

  !____________________________________________________________________________________________________
  subroutine EXTRACTCOLS(line,cvalues)
    ! extracts the columns (separated by commas) in a line
    character(len=*), INTENT(in) :: line
    character(len=*), DIMENSION(:), INTENT(out), ALLOCATABLE :: cvalues
    !---local---
    integer, dimension(maxentrynum) :: ipos
    integer :: i,countcols,icomma,icomma0,strlen
    !-----------
    countcols=1
    ipos(countcols)=0
    strlen=len(line)
    icomma0=scan(line,c_sep)
    icomma=icomma0
    do while (icomma0.ne.0.and.icomma.le.strlen)
       countcols=countcols+1
       ipos(countcols)=icomma
       icomma0=scan(line(icomma+1:),c_sep)
       icomma=icomma+icomma0
    enddo
    ipos(countcols+1)=strlen+1

    allocate(cvalues(countcols))

    do i=1,countcols
       if (ipos(i)+1.gt.ipos(i+1)-1) then
          cvalues(i)=''
       else 
          cvalues(i)=line(ipos(i)+1:ipos(i+1)-1)
       endif
    enddo

  end subroutine EXTRACTCOLS

  !____________________________________________________________________________________________________
  subroutine READ_CSV_TAB(file,headers,values,ierr)
    character(len=*), INTENT(in) :: file
    character(len=maxheaderlen), dimension(:), ALLOCATABLE, INTENT(out) :: headers
    real(kind=8), dimension(:,:), ALLOCATABLE, INTENT(out) :: values
    integer, OPTIONAL, INTENT(out) :: ierr
    !---local---
    integer :: i,j,ieff,ndata,ncols,io
    character(len=maxlinelen) :: oneline
    real(kind=8), dimension(:,:), ALLOCATABLE :: tmpvalues
    character(len=maxentrylen), dimension(:), ALLOCATABLE :: cvalues
    !-----------

    ndata=COUNTLINES(file,ierr=ierr)
    if (present(ierr)) then
       if (ierr.gt.0) goto 167
    endif
    write(*,*)'file "',TRIM(file),'" has ',ndata,' data lines'
    open(unit=csvunit,file=file,status='old',err=167)
    read(csvunit,'(a)')oneline
    call EXTRACTCOLS(oneline,headers)
    ncols=size(headers)
    allocate(tmpvalues(ndata,ncols))
    ieff=1
    do i=1,ndata
       read(csvunit,'(a)')oneline
       call EXTRACTCOLS(oneline,cvalues)
       !       write(*,*)('<',trim(cvalues(j)),'>',j=1,size(cvalues))
       if (size(cvalues).eq.ncols) then
          do j=1,ncols
             read(cvalues(j),*,IOSTAT=io)tmpvalues(ieff,j)
          enddo
          ieff=ieff+1
       else if (size(cvalues).gt.ncols) then
          write(*,*)'READ_CSV_TAB: Warning: there is a larger number of entries at line ',i,' in file ',file
          do j=1,ncols
             read(cvalues(j),*,IOSTAT=io)tmpvalues(ieff,j)
          enddo
          ieff=ieff+1
       else 
          write(*,*)'READ_CSV_TAB: Warning: there is a smaller number of entries at line ',i,' in file ',file
          write(*,*)'              ... line skipped'
       endif
    enddo
    if (ieff.le.1) then 
       write(*,*)'READ_CSV_TAB: No valid data entry.'
    else 
       allocate(values(ieff-1,ncols))
       values=tmpvalues(:ieff-1,:)
    endif
    close(unit=csvunit)
    if (present(ierr)) ierr=0
    return
167 continue
    if (PRESENT(ierr)) then
       ierr=1
    else 
       write(*,*)'READ_CSV_TAB: ERROR with file ',file
       write(*,*)'            I must stop.'
       stop
    endif
  end subroutine READ_CSV_TAB

  !____________________________________________________________________________________________________
  subroutine READ_CSV_VEC(file,c1,x1,c2,x2,c3,x3,c4,x4,c5,x5,c6,x6,c7,x7,c8,x8,c9,x9,c10,x10,ierr)
    character(len=*), INTENT(in) :: file
    character(len=*), OPTIONAL, INTENT(in) :: c1,c2,c3,c4,c5,c6,c7,c8,c9,c10
    REAL(KIND=8), DIMENSION(:), ALLOCATABLE, OPTIONAL, INTENT(out) :: x1,x2,x3,x4,x5,x6,x7,x8,x9,x10
    integer, OPTIONAL, INTENT(out) :: ierr

    character(len=maxheaderlen), dimension(:), ALLOCATABLE :: headers
    real(kind=8), dimension(:,:), ALLOCATABLE :: values
    integer :: nh

    write(*,*)'Reading file ',file
    if (present(ierr)) then
       call READ_CSV_TAB(file,headers,values,ierr)
       if (ierr.gt.0) return
    else 
       call READ_CSV_TAB(file,headers,values)
    endif
    nh=SIZE(headers)

    if (PRESENT(c1).and.PRESENT(x1)) then
       call associate(headers,nh,values,c1,x1)
       if (PRESENT(c2).and.PRESENT(x2)) then
          call associate(headers,nh,values,c2,x2)
          if (PRESENT(c3).and.PRESENT(x3)) then
             call associate(headers,nh,values,c3,x3)
             if (PRESENT(c4).and.PRESENT(x4)) then
                call associate(headers,nh,values,c4,x4)
                if (PRESENT(c5).and.PRESENT(x5)) then
                   call associate(headers,nh,values,c5,x5)
                   if (PRESENT(c6).and.PRESENT(x6)) then
                      call associate(headers,nh,values,c6,x6)
                      if (PRESENT(c7).and.PRESENT(x7)) then
                         call associate(headers,nh,values,c7,x7)
                         if (PRESENT(c8).and.PRESENT(x8)) then
                            call associate(headers,nh,values,c8,x8)
                            if (PRESENT(c9).and.PRESENT(x9)) then
                               call associate(headers,nh,values,c9,x9)
                               if (PRESENT(c10).and.PRESENT(x10)) then
                                  call associate(headers,nh,values,c10,x10)
                               endif
                            endif
                         endif
                      endif
                   endif
                endif
             endif
          endif
       endif
    else 
       write(*,*)'READ_CSV_VEC: No vectors'
       write(*,*)'File ',TRIM(file),' has ',SIZE(headers),' columns and ',SIZE(values(1,:)),' rows'
    endif

  end subroutine READ_CSV_VEC

  !____________________________________________________________________________________________________
  ! subroutine ASSOCIATE
  ! Given a vector of headers of size nh, a corresponding array "values" of nh columns and some rows, find vector xx whose header=cc 
  subroutine ASSOCIATE(headers,nh,values,cc,xx,ierr,lstop)
    character(len=*), dimension(:), INTENT(in) :: headers
    integer, INTENT(in) :: nh
    real(kind=8), DIMENSION(:,:), INTENT(in) :: values
    character(len=*), INTENT(IN) :: cc
    real(kind=8), DIMENSION(:), ALLOCATABLE, INTENT(out) :: xx
    integer, OPTIONAL, INTENT(out) :: ierr
    logical, OPTIONAL, INTENT(in) :: lstop
    integer :: istr

    if (present(ierr)) ierr=0
    ! We first test for an exact match
    istr=ISTRINARRAY(headers,TRIM(cc),exact=.TRUE.)
    ! If it does not work, a partial match will do !
    if (istr.eq.0) istr=ISTRINARRAY(headers,TRIM(cc))
    if (istr.gt.0) then
       allocate(xx(SIZE(values(:,istr))))
       xx=values(:,istr)
    else 
       write(*,*)'MOD_RW_CSV/ASSOCIATE: Could not find header ',TRIM(cc)
       if (present(ierr)) ierr=1
       if (present(lstop)) then
          if (lstop) stop
       endif
    endif
  end subroutine ASSOCIATE

  !____________________________________________________________________________________________________
  function ISTRINARRAY(arrstr,str,exact)
    character(len=*), DIMENSION(:), INTENT(in) :: arrstr
    character(len=*), INTENT(in) :: str
    logical, INTENT(in), OPTIONAL :: exact
    integer :: ISTRINARRAY
    !---local---
    logical exact0
    integer i
    !-----------

    exact0=.FALSE.
    if (present(exact)) exact0=exact 
    ISTRINARRAY=0
    do i=1,size(arrstr)
       if ((.not.exact0.and.(INDEX(arrstr(i),str).gt.0).or.(exact0.and.(trim(arrstr(i)).eq.trim(str))))) then
          ISTRINARRAY=i
          exit
       endif
    enddo
  end function ISTRINARRAY

  !____________________________________________________________________________________________________
  subroutine WRITE_CSV(file,headers,vector)
    character(len=*), INTENT(in) :: file
    character(len=*), dimension(:), intent(in) :: headers 
    real(kind=8), dimension(:), intent(in) :: vector
    integer :: i,j,cols,rows
    integer, PARAMETER :: xlen=12
    real(kind=8), dimension(:,:), allocatable :: array
    character(len=xlen+1) :: fixedstr

    cols=size(headers)
    rows=size(vector)/cols
    if (mod(size(vector),cols).ne.0) then
       write(*,*)'WRITE_CSV ERROR: The input vector is not transformable into an array.'
       write(*,*)'Number of columns: ',cols,'; Length of input vector=',cols,'x',rows,'+',mod(size(vector),cols)
       write(*,*)'File ',TRIM(file),' will not be written.'
       write(*,*)'I must stop'
       stop
    endif
    ALLOCATE(array(rows,cols))
    array=reshape(vector,(/rows,cols/))

    open(unit=csvunit,file=file,status='unknown')
    do j=1,size(headers)
       if (LEN_TRIM(headers(j)).gt.xlen) then
          write(*,*)'WRITE_CSV ERROR: a header is longer than the maximum length=',xlen
          write(*,'("Header(",i3,")=",a)')j,headers(j)
          write(*,*)'File ',TRIM(file),' will not be written.'
          write(*,*)'I must stop'
          stop
       endif
       if (j.eq.1) then
          write(fixedstr,'(a)')' '//TRIM(headers(1))
       else 
          write(fixedstr,'(a)')','//TRIM(headers(j))
       endif
       write(csvunit,'(a)',advance='no')fixedstr
    enddo
    write(csvunit,*)
    do i=1,size(array(:,1))
       write(fixedstr,'(1x,es12.5)')array(i,1)
       write(csvunit,'(a)',advance='no')fixedstr
       do j=2,size(headers)
          write(fixedstr,'(",",es12.5)')array(i,j)
          write(csvunit,'(a)',advance='no')fixedstr
       enddo
       write(csvunit,*)
    enddo
    close(unit=csvunit)
    write(*,*)'I have created file ',TRIM(file)
  end subroutine WRITE_CSV

  !____________________________________________________________________________________________________
  ! subroutine one2twod
  ! This subroutine transform an array from a csv file into vectors x,y and z(x,y)
  ! example:
  ! array=     x    y    z
  !            0    1    0
  !            1    1    1
  !            2    1    2
  !            0    4    0
  !            1    4    4
  !            2    4    8
  ! call one2twod((/'x','y','z'/),array,'x',vx,'y',vy,'z',vz) yields:
  !   vx=(/ 0, 1, 2 /)
  !   vy=(/ 1, 4 /)
  !   vz=(/ 0, 1, 2, 0, 4, 8 /) but as an array of (3 x 2)
  ! 
  ! Here is the program to test the subroutine
  !
  ! ! program test_one2twod
  ! !   use mod_rw_csv
  ! !   implicit none
  ! !   real(kind=8) :: x(3),y(5),z(3,5),xz(15),yz(15),zz(15),array(15,3)
  ! !   real(kind=8), ALLOCATABLE :: vx(:),vy(:),vz(:,:)
  ! !   integer i,j,k

  ! !   x=(/ 1,2,3 /)
  ! !   y=(/ 0,1,10,20,30 /)
  ! !   do i=1,size(x)
  ! !      do j=1,size(y)
  ! !         k=i+(j-1)*size(x)
  ! !         z(i,j)=x(i)*y(j)
  ! !         xz(k)=x(i)
  ! !         yz(k)=y(j)
  ! !         zz(k)=z(i,j)
  ! !         array(k,:)=(/xz(k),yz(k),zz(k)/)
  ! !      enddo
  ! !   enddo
  ! !   call one2twod((/'x','y','z'/),array,'x',vx,'y',vy,'z',vz)
  ! !   write(*,*)'vz:',vz
  ! !     call one2twod((/'x','y','z'/),array,'y',vx,'x',vy,'z',vz)
  ! !   write(*,*)'vz:',vz
  ! ! end program test_one2twod

  subroutine ONE2TWOD(headers,array,namex,vx,namey,vy,namez,vz,namez2,vz2)
    character(len=*), dimension(:), INTENT(in) :: headers
    real(kind=8), dimension(:,:), INTENT(in) :: array
    character(len=*), INTENT(in) :: namex,namey,namez
    real(kind=8), ALLOCATABLE, INTENT(out) :: vx(:), vy(:), vz(:,:)
    character(len=*), INTENT(in), OPTIONAL :: namez2
    real(kind=8), ALLOCATABLE, INTENT(out), OPTIONAL :: vz2(:,:)

    integer :: i,ix,iy,iz,iz2,nx,ny,nz,nh,ierr
    real(kind=8), ALLOCATABLE :: xtmp(:),ytmp(:),ztmp(:),z2tmp(:)

    nh=size(headers)
    nz=size(array(:,1))
    call ASSOCIATE(headers,nh,array,namex,xtmp,lstop=.true.)
    call ASSOCIATE(headers,nh,array,namey,ytmp,lstop=.true.)
    call ASSOCIATE(headers,nh,array,namez,ztmp,lstop=.true.)
    if (PRESENT(namez2)) call ASSOCIATE(headers,nh,array,namez2,z2tmp,lstop=.true.)
    nx=0
    ny=0
    do i=1,nz
       if (xtmp(i).eq.xtmp(1)) ny=ny+1
       if (ytmp(i).eq.ytmp(1)) nx=nx+1
    enddo
    ALLOCATE(vx(nx))
    ALLOCATE(vy(ny))
    ALLOCATE(vz(nx,ny))
    if (present(vz2)) ALLOCATE(vz2(nx,ny))
    iy=0
    ix=0
    do i=1,nz
       if (xtmp(i).eq.xtmp(1)) then
          iy=iy+1
          vy(iy)=ytmp(i)
       endif
       if (ytmp(i).eq.ytmp(1)) then
          ix=ix+1
          vx(ix)=xtmp(i)
       endif
    enddo
    if (ytmp(2).eq.ytmp(1)) then
       vz=RESHAPE(ztmp,(/nx,ny/))
       if (present(vz2)) vz2=RESHAPE(z2tmp,(/nx,ny/))
    else 
       vz=TRANSPOSE(RESHAPE(ztmp,(/ny,nx/)))
       if (present(vz2)) vz2=TRANSPOSE(RESHAPE(z2tmp,(/ny,nx/)))
    endif
  end subroutine ONE2TWOD

end module MOD_RW_CSV