module scm_io_default
    implicit none
    !type declaration
    type io_struct
        character(len = 160) :: fname
        integer :: status ! 0 - closed, 1 - opened
        integer :: unit_id
    end type io_struct

    character(len = 160) tmp_str
    integer, public, parameter :: nunits_max = 70
    public

    contains
        subroutine to_file_1d_2var(fname, var1, var2, n)
            implicit none
            character(*), intent(in):: fname
            integer, intent(in):: n
            real, dimension(n), intent(in):: var1, var2
            integer i
            integer istat
            character(len = 7) sta

            open(10, FILE=trim(fname))
            do i =1, n
                write(10,*) var1(i), var2(i)
            end do
            close(10,iostat = istat,STATUS = sta)
        end subroutine to_file_1d_2var

        subroutine to_file_1d_3var(fname, var1, var2, var3, n)
            implicit none
            character(*), intent(in):: fname
            integer, intent(in):: n
            real, dimension(n), intent(in):: var1, var2, var3
            integer i
            integer istat
            character(len = 7) sta

            open(10, FILE=trim(fname))
            do i =1, n
                write(10,*) var1(i), var2(i), var3(i)
            end do
            close(10,iostat = istat,STATUS = sta)
        end subroutine to_file_1d_3var

        subroutine set_file( f, fname )
            implicit none
            type(io_struct), intent(inout):: f
            character(*), intent(in):: fname

                f%unit_id = get_file_unit()
                open(f%unit_id, FILE=trim(fname))
                f%status = 1
                f%fname = trim(fname)

            write(*,*) 'file opened ', f%fname
            write(*,*) ' unit: ',f%unit_id
            write(*,*) 'max_units: ', nunits_max
        end subroutine set_file

        subroutine write_series(stamp, nlength, f)
            implicit none
            type(io_struct), intent(inout):: f
            integer, intent(in):: nlength
            real, intent(in), dimension(nlength)::stamp
            write(f%unit_id,*) stamp(:)
        end subroutine write_series

        subroutine write_timescan(stamp,nz, nlength, f)
            implicit none
            type(io_struct), intent(in):: f
            integer, intent(in):: nlength, nz
            real, intent(in), dimension(nlength, nz)::stamp
            integer k
            do k=1,nz
            write(f%unit_id,*) stamp(:, k)
            end do
        end subroutine  write_timescan

        subroutine close_file(f)
            implicit none
            type(io_struct), intent(inout):: f

            close(f%unit_id)
            write(*,*) 'file closed ', f%fname
            f%status = 0
        end subroutine close_file

        !   get_file_unit returns a unit number that is not in use
        integer function get_file_unit ()
            integer lu, iostat
            integer, save:: m
            logical, save:: initialized = .true.
            logical   opened

            if (initialized) then
                m = nunits_max
                initialized = .false.
            end if

            if (m < 8 ) then
                m = 2 * nunits_max
            end if

            do lu = m,7,-1
                inquire (unit=lu, opened=opened, iostat=iostat)
                if (iostat.ne.0) cycle
                if (.not.opened) exit
            end do
            !
            get_file_unit = lu
            return
        end function get_file_unit

    subroutine read_1d_plain(x, val, nrows, fname)
        implicit none
        real, allocatable, intent(inout) :: x(:), val(:)
        integer, intent(inout):: nrows
        character(*), intent(in):: fname

        integer ::  i, io

        ! get number of rows
        nrows = 0
        open (1, file = trim(fname))
        do
            read(1,*,iostat=io)
            if (io/=0) exit
            nrows = nrows + 1
        end do
        close (1)
        !check if arrays are already allocated
        if (allocated(x)) deallocate(x)
        if (allocated(val)) deallocate(val)
        !allocate arrays
        allocate(x(nrows))
        allocate(val(nrows))
        ! reopen file and read data
        open (1, file = trim(fname))
        do i = 1,nrows
            read(1,*) x(i), val(i)
        end do
    end subroutine read_1d_plain
end module scm_io_default