submodule(forlab_io) forlab__io_txt

    use forlab_time, only: time_string
    implicit none

contains

    module procedure loadtxt_1_rsp
    integer :: i, data_dim
    type(File) :: infile
    character(*), parameter :: type = 'rsp'
    character(8) :: datatype
    integer, allocatable :: nsize(:)

    allocate (nsize(1))
    infile = file(filename, 'r t')
    if (infile%exist()) then
        call infile%open()
        read (infile%unit, '(6X,A8,I8)') datatype, data_dim
        if (trim(adjustl(datatype)) /= type) then
            call error_stop('Error: The program failed to try to read a ' &
                            //type//' array, but the file '//trim(filename)// &
                            'stored an array with a '//datatype//'.')
        end if
        if (data_dim /= 1) then
            call error_stop('Error: The program failed to read the ' &
                            //to_string(1)//'-dimensional array. It may be that the file ' &
                            //trim(filename)//' stores an array of different dimensions.')
        end if
        read (infile%unit, *)
        read (infile%unit, '(11X,1I8)') nsize(:)
        read (infile%unit, *)

        allocate (X(nsize(1)))
        do i = 1, nsize(1)
            read (infile%unit, *) X(i)
        end do
        call infile%close()
    else
        call error_stop("Error: '"//trim(filename)//"' not found")
    end if
    return
    end procedure loadtxt_1_rsp
    module procedure loadtxt_1_rdp
    integer :: i, data_dim
    type(File) :: infile
    character(*), parameter :: type = 'rdp'
    character(8) :: datatype
    integer, allocatable :: nsize(:)

    allocate (nsize(1))
    infile = file(filename, 'r t')
    if (infile%exist()) then
        call infile%open()
        read (infile%unit, '(6X,A8,I8)') datatype, data_dim
        if (trim(adjustl(datatype)) /= type) then
            call error_stop('Error: The program failed to try to read a ' &
                            //type//' array, but the file '//trim(filename)// &
                            'stored an array with a '//datatype//'.')
        end if
        if (data_dim /= 1) then
            call error_stop('Error: The program failed to read the ' &
                            //to_string(1)//'-dimensional array. It may be that the file ' &
                            //trim(filename)//' stores an array of different dimensions.')
        end if
        read (infile%unit, *)
        read (infile%unit, '(11X,1I8)') nsize(:)
        read (infile%unit, *)

        allocate (X(nsize(1)))
        do i = 1, nsize(1)
            read (infile%unit, *) X(i)
        end do
        call infile%close()
    else
        call error_stop("Error: '"//trim(filename)//"' not found")
    end if
    return
    end procedure loadtxt_1_rdp
    module procedure loadtxt_1_iint8
    integer :: i, data_dim
    type(File) :: infile
    character(*), parameter :: type = 'iint8'
    character(8) :: datatype
    integer, allocatable :: nsize(:)

    allocate (nsize(1))
    infile = file(filename, 'r t')
    if (infile%exist()) then
        call infile%open()
        read (infile%unit, '(6X,A8,I8)') datatype, data_dim
        if (trim(adjustl(datatype)) /= type) then
            call error_stop('Error: The program failed to try to read a ' &
                            //type//' array, but the file '//trim(filename)// &
                            'stored an array with a '//datatype//'.')
        end if
        if (data_dim /= 1) then
            call error_stop('Error: The program failed to read the ' &
                            //to_string(1)//'-dimensional array. It may be that the file ' &
                            //trim(filename)//' stores an array of different dimensions.')
        end if
        read (infile%unit, *)
        read (infile%unit, '(11X,1I8)') nsize(:)
        read (infile%unit, *)

        allocate (X(nsize(1)))
        do i = 1, nsize(1)
            read (infile%unit, *) X(i)
        end do
        call infile%close()
    else
        call error_stop("Error: '"//trim(filename)//"' not found")
    end if
    return
    end procedure loadtxt_1_iint8
    module procedure loadtxt_1_iint16
    integer :: i, data_dim
    type(File) :: infile
    character(*), parameter :: type = 'iint16'
    character(8) :: datatype
    integer, allocatable :: nsize(:)

    allocate (nsize(1))
    infile = file(filename, 'r t')
    if (infile%exist()) then
        call infile%open()
        read (infile%unit, '(6X,A8,I8)') datatype, data_dim
        if (trim(adjustl(datatype)) /= type) then
            call error_stop('Error: The program failed to try to read a ' &
                            //type//' array, but the file '//trim(filename)// &
                            'stored an array with a '//datatype//'.')
        end if
        if (data_dim /= 1) then
            call error_stop('Error: The program failed to read the ' &
                            //to_string(1)//'-dimensional array. It may be that the file ' &
                            //trim(filename)//' stores an array of different dimensions.')
        end if
        read (infile%unit, *)
        read (infile%unit, '(11X,1I8)') nsize(:)
        read (infile%unit, *)

        allocate (X(nsize(1)))
        do i = 1, nsize(1)
            read (infile%unit, *) X(i)
        end do
        call infile%close()
    else
        call error_stop("Error: '"//trim(filename)//"' not found")
    end if
    return
    end procedure loadtxt_1_iint16
    module procedure loadtxt_1_iint32
    integer :: i, data_dim
    type(File) :: infile
    character(*), parameter :: type = 'iint32'
    character(8) :: datatype
    integer, allocatable :: nsize(:)

    allocate (nsize(1))
    infile = file(filename, 'r t')
    if (infile%exist()) then
        call infile%open()
        read (infile%unit, '(6X,A8,I8)') datatype, data_dim
        if (trim(adjustl(datatype)) /= type) then
            call error_stop('Error: The program failed to try to read a ' &
                            //type//' array, but the file '//trim(filename)// &
                            'stored an array with a '//datatype//'.')
        end if
        if (data_dim /= 1) then
            call error_stop('Error: The program failed to read the ' &
                            //to_string(1)//'-dimensional array. It may be that the file ' &
                            //trim(filename)//' stores an array of different dimensions.')
        end if
        read (infile%unit, *)
        read (infile%unit, '(11X,1I8)') nsize(:)
        read (infile%unit, *)

        allocate (X(nsize(1)))
        do i = 1, nsize(1)
            read (infile%unit, *) X(i)
        end do
        call infile%close()
    else
        call error_stop("Error: '"//trim(filename)//"' not found")
    end if
    return
    end procedure loadtxt_1_iint32
    module procedure loadtxt_1_iint64
    integer :: i, data_dim
    type(File) :: infile
    character(*), parameter :: type = 'iint64'
    character(8) :: datatype
    integer, allocatable :: nsize(:)

    allocate (nsize(1))
    infile = file(filename, 'r t')
    if (infile%exist()) then
        call infile%open()
        read (infile%unit, '(6X,A8,I8)') datatype, data_dim
        if (trim(adjustl(datatype)) /= type) then
            call error_stop('Error: The program failed to try to read a ' &
                            //type//' array, but the file '//trim(filename)// &
                            'stored an array with a '//datatype//'.')
        end if
        if (data_dim /= 1) then
            call error_stop('Error: The program failed to read the ' &
                            //to_string(1)//'-dimensional array. It may be that the file ' &
                            //trim(filename)//' stores an array of different dimensions.')
        end if
        read (infile%unit, *)
        read (infile%unit, '(11X,1I8)') nsize(:)
        read (infile%unit, *)

        allocate (X(nsize(1)))
        do i = 1, nsize(1)
            read (infile%unit, *) X(i)
        end do
        call infile%close()
    else
        call error_stop("Error: '"//trim(filename)//"' not found")
    end if
    return
    end procedure loadtxt_1_iint64
    module procedure loadtxt_1_csp
    integer :: i, data_dim
    type(File) :: infile
    character(*), parameter :: type = 'csp'
    character(8) :: datatype
    integer, allocatable :: nsize(:)

    allocate (nsize(1))
    infile = file(filename, 'r t')
    if (infile%exist()) then
        call infile%open()
        read (infile%unit, '(6X,A8,I8)') datatype, data_dim
        if (trim(adjustl(datatype)) /= type) then
            call error_stop('Error: The program failed to try to read a ' &
                            //type//' array, but the file '//trim(filename)// &
                            'stored an array with a '//datatype//'.')
        end if
        if (data_dim /= 1) then
            call error_stop('Error: The program failed to read the ' &
                            //to_string(1)//'-dimensional array. It may be that the file ' &
                            //trim(filename)//' stores an array of different dimensions.')
        end if
        read (infile%unit, *)
        read (infile%unit, '(11X,1I8)') nsize(:)
        read (infile%unit, *)

        allocate (X(nsize(1)))
        do i = 1, nsize(1)
            read (infile%unit, *) X(i)
        end do
        call infile%close()
    else
        call error_stop("Error: '"//trim(filename)//"' not found")
    end if
    return
    end procedure loadtxt_1_csp
    module procedure loadtxt_1_cdp
    integer :: i, data_dim
    type(File) :: infile
    character(*), parameter :: type = 'cdp'
    character(8) :: datatype
    integer, allocatable :: nsize(:)

    allocate (nsize(1))
    infile = file(filename, 'r t')
    if (infile%exist()) then
        call infile%open()
        read (infile%unit, '(6X,A8,I8)') datatype, data_dim
        if (trim(adjustl(datatype)) /= type) then
            call error_stop('Error: The program failed to try to read a ' &
                            //type//' array, but the file '//trim(filename)// &
                            'stored an array with a '//datatype//'.')
        end if
        if (data_dim /= 1) then
            call error_stop('Error: The program failed to read the ' &
                            //to_string(1)//'-dimensional array. It may be that the file ' &
                            //trim(filename)//' stores an array of different dimensions.')
        end if
        read (infile%unit, *)
        read (infile%unit, '(11X,1I8)') nsize(:)
        read (infile%unit, *)

        allocate (X(nsize(1)))
        do i = 1, nsize(1)
            read (infile%unit, *) X(i)
        end do
        call infile%close()
    else
        call error_stop("Error: '"//trim(filename)//"' not found")
    end if
    return
    end procedure loadtxt_1_cdp
    module procedure loadtxt_2_rsp
    integer :: i, data_dim
    type(File) :: infile
    character(*), parameter :: type = 'rsp'
    character(8) :: datatype
    integer, allocatable :: nsize(:)

    allocate (nsize(2))
    infile = file(filename, 'r t')
    if (infile%exist()) then
        call infile%open()
        read (infile%unit, '(6X,A8,I8)') datatype, data_dim
        if (trim(adjustl(datatype)) /= type) then
            call error_stop('Error: The program failed to try to read a ' &
                            //type//' array, but the file '//trim(filename)// &
                            'stored an array with a '//datatype//'.')
        end if
        if (data_dim /= 2) then
            call error_stop('Error: The program failed to read the ' &
                            //to_string(2)//'-dimensional array. It may be that the file ' &
                            //trim(filename)//' stores an array of different dimensions.')
        end if
        read (infile%unit, *)
        read (infile%unit, '(11X,2I8)') nsize(:)
        read (infile%unit, *)

        allocate (X(nsize(1), nsize(2)))
        do i = 1, nsize(1)
            read (infile%unit, *) X(i, :)
        end do
        call infile%close()
    else
        call error_stop("Error: '"//trim(filename)//"' not found")
    end if
    return
    end procedure loadtxt_2_rsp
    module procedure loadtxt_2_rdp
    integer :: i, data_dim
    type(File) :: infile
    character(*), parameter :: type = 'rdp'
    character(8) :: datatype
    integer, allocatable :: nsize(:)

    allocate (nsize(2))
    infile = file(filename, 'r t')
    if (infile%exist()) then
        call infile%open()
        read (infile%unit, '(6X,A8,I8)') datatype, data_dim
        if (trim(adjustl(datatype)) /= type) then
            call error_stop('Error: The program failed to try to read a ' &
                            //type//' array, but the file '//trim(filename)// &
                            'stored an array with a '//datatype//'.')
        end if
        if (data_dim /= 2) then
            call error_stop('Error: The program failed to read the ' &
                            //to_string(2)//'-dimensional array. It may be that the file ' &
                            //trim(filename)//' stores an array of different dimensions.')
        end if
        read (infile%unit, *)
        read (infile%unit, '(11X,2I8)') nsize(:)
        read (infile%unit, *)

        allocate (X(nsize(1), nsize(2)))
        do i = 1, nsize(1)
            read (infile%unit, *) X(i, :)
        end do
        call infile%close()
    else
        call error_stop("Error: '"//trim(filename)//"' not found")
    end if
    return
    end procedure loadtxt_2_rdp
    module procedure loadtxt_2_iint8
    integer :: i, data_dim
    type(File) :: infile
    character(*), parameter :: type = 'iint8'
    character(8) :: datatype
    integer, allocatable :: nsize(:)

    allocate (nsize(2))
    infile = file(filename, 'r t')
    if (infile%exist()) then
        call infile%open()
        read (infile%unit, '(6X,A8,I8)') datatype, data_dim
        if (trim(adjustl(datatype)) /= type) then
            call error_stop('Error: The program failed to try to read a ' &
                            //type//' array, but the file '//trim(filename)// &
                            'stored an array with a '//datatype//'.')
        end if
        if (data_dim /= 2) then
            call error_stop('Error: The program failed to read the ' &
                            //to_string(2)//'-dimensional array. It may be that the file ' &
                            //trim(filename)//' stores an array of different dimensions.')
        end if
        read (infile%unit, *)
        read (infile%unit, '(11X,2I8)') nsize(:)
        read (infile%unit, *)

        allocate (X(nsize(1), nsize(2)))
        do i = 1, nsize(1)
            read (infile%unit, *) X(i, :)
        end do
        call infile%close()
    else
        call error_stop("Error: '"//trim(filename)//"' not found")
    end if
    return
    end procedure loadtxt_2_iint8
    module procedure loadtxt_2_iint16
    integer :: i, data_dim
    type(File) :: infile
    character(*), parameter :: type = 'iint16'
    character(8) :: datatype
    integer, allocatable :: nsize(:)

    allocate (nsize(2))
    infile = file(filename, 'r t')
    if (infile%exist()) then
        call infile%open()
        read (infile%unit, '(6X,A8,I8)') datatype, data_dim
        if (trim(adjustl(datatype)) /= type) then
            call error_stop('Error: The program failed to try to read a ' &
                            //type//' array, but the file '//trim(filename)// &
                            'stored an array with a '//datatype//'.')
        end if
        if (data_dim /= 2) then
            call error_stop('Error: The program failed to read the ' &
                            //to_string(2)//'-dimensional array. It may be that the file ' &
                            //trim(filename)//' stores an array of different dimensions.')
        end if
        read (infile%unit, *)
        read (infile%unit, '(11X,2I8)') nsize(:)
        read (infile%unit, *)

        allocate (X(nsize(1), nsize(2)))
        do i = 1, nsize(1)
            read (infile%unit, *) X(i, :)
        end do
        call infile%close()
    else
        call error_stop("Error: '"//trim(filename)//"' not found")
    end if
    return
    end procedure loadtxt_2_iint16
    module procedure loadtxt_2_iint32
    integer :: i, data_dim
    type(File) :: infile
    character(*), parameter :: type = 'iint32'
    character(8) :: datatype
    integer, allocatable :: nsize(:)

    allocate (nsize(2))
    infile = file(filename, 'r t')
    if (infile%exist()) then
        call infile%open()
        read (infile%unit, '(6X,A8,I8)') datatype, data_dim
        if (trim(adjustl(datatype)) /= type) then
            call error_stop('Error: The program failed to try to read a ' &
                            //type//' array, but the file '//trim(filename)// &
                            'stored an array with a '//datatype//'.')
        end if
        if (data_dim /= 2) then
            call error_stop('Error: The program failed to read the ' &
                            //to_string(2)//'-dimensional array. It may be that the file ' &
                            //trim(filename)//' stores an array of different dimensions.')
        end if
        read (infile%unit, *)
        read (infile%unit, '(11X,2I8)') nsize(:)
        read (infile%unit, *)

        allocate (X(nsize(1), nsize(2)))
        do i = 1, nsize(1)
            read (infile%unit, *) X(i, :)
        end do
        call infile%close()
    else
        call error_stop("Error: '"//trim(filename)//"' not found")
    end if
    return
    end procedure loadtxt_2_iint32
    module procedure loadtxt_2_iint64
    integer :: i, data_dim
    type(File) :: infile
    character(*), parameter :: type = 'iint64'
    character(8) :: datatype
    integer, allocatable :: nsize(:)

    allocate (nsize(2))
    infile = file(filename, 'r t')
    if (infile%exist()) then
        call infile%open()
        read (infile%unit, '(6X,A8,I8)') datatype, data_dim
        if (trim(adjustl(datatype)) /= type) then
            call error_stop('Error: The program failed to try to read a ' &
                            //type//' array, but the file '//trim(filename)// &
                            'stored an array with a '//datatype//'.')
        end if
        if (data_dim /= 2) then
            call error_stop('Error: The program failed to read the ' &
                            //to_string(2)//'-dimensional array. It may be that the file ' &
                            //trim(filename)//' stores an array of different dimensions.')
        end if
        read (infile%unit, *)
        read (infile%unit, '(11X,2I8)') nsize(:)
        read (infile%unit, *)

        allocate (X(nsize(1), nsize(2)))
        do i = 1, nsize(1)
            read (infile%unit, *) X(i, :)
        end do
        call infile%close()
    else
        call error_stop("Error: '"//trim(filename)//"' not found")
    end if
    return
    end procedure loadtxt_2_iint64
    module procedure loadtxt_2_csp
    integer :: i, data_dim
    type(File) :: infile
    character(*), parameter :: type = 'csp'
    character(8) :: datatype
    integer, allocatable :: nsize(:)

    allocate (nsize(2))
    infile = file(filename, 'r t')
    if (infile%exist()) then
        call infile%open()
        read (infile%unit, '(6X,A8,I8)') datatype, data_dim
        if (trim(adjustl(datatype)) /= type) then
            call error_stop('Error: The program failed to try to read a ' &
                            //type//' array, but the file '//trim(filename)// &
                            'stored an array with a '//datatype//'.')
        end if
        if (data_dim /= 2) then
            call error_stop('Error: The program failed to read the ' &
                            //to_string(2)//'-dimensional array. It may be that the file ' &
                            //trim(filename)//' stores an array of different dimensions.')
        end if
        read (infile%unit, *)
        read (infile%unit, '(11X,2I8)') nsize(:)
        read (infile%unit, *)

        allocate (X(nsize(1), nsize(2)))
        do i = 1, nsize(1)
            read (infile%unit, *) X(i, :)
        end do
        call infile%close()
    else
        call error_stop("Error: '"//trim(filename)//"' not found")
    end if
    return
    end procedure loadtxt_2_csp
    module procedure loadtxt_2_cdp
    integer :: i, data_dim
    type(File) :: infile
    character(*), parameter :: type = 'cdp'
    character(8) :: datatype
    integer, allocatable :: nsize(:)

    allocate (nsize(2))
    infile = file(filename, 'r t')
    if (infile%exist()) then
        call infile%open()
        read (infile%unit, '(6X,A8,I8)') datatype, data_dim
        if (trim(adjustl(datatype)) /= type) then
            call error_stop('Error: The program failed to try to read a ' &
                            //type//' array, but the file '//trim(filename)// &
                            'stored an array with a '//datatype//'.')
        end if
        if (data_dim /= 2) then
            call error_stop('Error: The program failed to read the ' &
                            //to_string(2)//'-dimensional array. It may be that the file ' &
                            //trim(filename)//' stores an array of different dimensions.')
        end if
        read (infile%unit, *)
        read (infile%unit, '(11X,2I8)') nsize(:)
        read (infile%unit, *)

        allocate (X(nsize(1), nsize(2)))
        do i = 1, nsize(1)
            read (infile%unit, *) X(i, :)
        end do
        call infile%close()
    else
        call error_stop("Error: '"//trim(filename)//"' not found")
    end if
    return
    end procedure loadtxt_2_cdp

    module procedure savetxt_1_rsp
    integer :: i, m
    type(file) :: outfile
    character(8), parameter :: type = 'rsp'

    outfile = file(filename, 'w t')
    m = size(x, 1)

    call outfile%open()
    write (outfile%unit, '(A6,A8,I8)') 'TYPE: ', type, int(1, 4)
    write (outfile%unit, '(A6,A)') 'DATA: ', time_string()

    write (outfile%unit, '(A11,1(I8))') 'DIMENSION: ', size(X, 1)
    write (outfile%unit, '(A)') '---'

    do i = 1, m
        write (outfile%unit, *) X(i)
    end do
    call outfile%close()
    return
    end procedure savetxt_1_rsp
    module procedure savetxt_1_rdp
    integer :: i, m
    type(file) :: outfile
    character(8), parameter :: type = 'rdp'

    outfile = file(filename, 'w t')
    m = size(x, 1)

    call outfile%open()
    write (outfile%unit, '(A6,A8,I8)') 'TYPE: ', type, int(1, 4)
    write (outfile%unit, '(A6,A)') 'DATA: ', time_string()

    write (outfile%unit, '(A11,1(I8))') 'DIMENSION: ', size(X, 1)
    write (outfile%unit, '(A)') '---'

    do i = 1, m
        write (outfile%unit, *) X(i)
    end do
    call outfile%close()
    return
    end procedure savetxt_1_rdp
    module procedure savetxt_1_iint8
    integer :: i, m
    type(file) :: outfile
    character(8), parameter :: type = 'iint8'

    outfile = file(filename, 'w t')
    m = size(x, 1)

    call outfile%open()
    write (outfile%unit, '(A6,A8,I8)') 'TYPE: ', type, int(1, 4)
    write (outfile%unit, '(A6,A)') 'DATA: ', time_string()

    write (outfile%unit, '(A11,1(I8))') 'DIMENSION: ', size(X, 1)
    write (outfile%unit, '(A)') '---'

    do i = 1, m
        write (outfile%unit, *) X(i)
    end do
    call outfile%close()
    return
    end procedure savetxt_1_iint8
    module procedure savetxt_1_iint16
    integer :: i, m
    type(file) :: outfile
    character(8), parameter :: type = 'iint16'

    outfile = file(filename, 'w t')
    m = size(x, 1)

    call outfile%open()
    write (outfile%unit, '(A6,A8,I8)') 'TYPE: ', type, int(1, 4)
    write (outfile%unit, '(A6,A)') 'DATA: ', time_string()

    write (outfile%unit, '(A11,1(I8))') 'DIMENSION: ', size(X, 1)
    write (outfile%unit, '(A)') '---'

    do i = 1, m
        write (outfile%unit, *) X(i)
    end do
    call outfile%close()
    return
    end procedure savetxt_1_iint16
    module procedure savetxt_1_iint32
    integer :: i, m
    type(file) :: outfile
    character(8), parameter :: type = 'iint32'

    outfile = file(filename, 'w t')
    m = size(x, 1)

    call outfile%open()
    write (outfile%unit, '(A6,A8,I8)') 'TYPE: ', type, int(1, 4)
    write (outfile%unit, '(A6,A)') 'DATA: ', time_string()

    write (outfile%unit, '(A11,1(I8))') 'DIMENSION: ', size(X, 1)
    write (outfile%unit, '(A)') '---'

    do i = 1, m
        write (outfile%unit, *) X(i)
    end do
    call outfile%close()
    return
    end procedure savetxt_1_iint32
    module procedure savetxt_1_iint64
    integer :: i, m
    type(file) :: outfile
    character(8), parameter :: type = 'iint64'

    outfile = file(filename, 'w t')
    m = size(x, 1)

    call outfile%open()
    write (outfile%unit, '(A6,A8,I8)') 'TYPE: ', type, int(1, 4)
    write (outfile%unit, '(A6,A)') 'DATA: ', time_string()

    write (outfile%unit, '(A11,1(I8))') 'DIMENSION: ', size(X, 1)
    write (outfile%unit, '(A)') '---'

    do i = 1, m
        write (outfile%unit, *) X(i)
    end do
    call outfile%close()
    return
    end procedure savetxt_1_iint64
    module procedure savetxt_1_csp
    integer :: i, m
    type(file) :: outfile
    character(8), parameter :: type = 'csp'

    outfile = file(filename, 'w t')
    m = size(x, 1)

    call outfile%open()
    write (outfile%unit, '(A6,A8,I8)') 'TYPE: ', type, int(1, 4)
    write (outfile%unit, '(A6,A)') 'DATA: ', time_string()

    write (outfile%unit, '(A11,1(I8))') 'DIMENSION: ', size(X, 1)
    write (outfile%unit, '(A)') '---'

    do i = 1, m
        write (outfile%unit, *) X(i)
    end do
    call outfile%close()
    return
    end procedure savetxt_1_csp
    module procedure savetxt_1_cdp
    integer :: i, m
    type(file) :: outfile
    character(8), parameter :: type = 'cdp'

    outfile = file(filename, 'w t')
    m = size(x, 1)

    call outfile%open()
    write (outfile%unit, '(A6,A8,I8)') 'TYPE: ', type, int(1, 4)
    write (outfile%unit, '(A6,A)') 'DATA: ', time_string()

    write (outfile%unit, '(A11,1(I8))') 'DIMENSION: ', size(X, 1)
    write (outfile%unit, '(A)') '---'

    do i = 1, m
        write (outfile%unit, *) X(i)
    end do
    call outfile%close()
    return
    end procedure savetxt_1_cdp
    module procedure savetxt_2_rsp
    integer :: i, m
    type(file) :: outfile
    character(8), parameter :: type = 'rsp'

    outfile = file(filename, 'w t')
    m = size(x, 1)

    call outfile%open()
    write (outfile%unit, '(A6,A8,I8)') 'TYPE: ', type, int(2, 4)
    write (outfile%unit, '(A6,A)') 'DATA: ', time_string()

    write (outfile%unit, '(A11,2(I8))') 'DIMENSION: ', size(X, 1), size(X, 2)
    write (outfile%unit, '(A)') '---'

    do i = 1, m
        write (outfile%unit, *) X(i, :)
    end do
    call outfile%close()
    return
    end procedure savetxt_2_rsp
    module procedure savetxt_2_rdp
    integer :: i, m
    type(file) :: outfile
    character(8), parameter :: type = 'rdp'

    outfile = file(filename, 'w t')
    m = size(x, 1)

    call outfile%open()
    write (outfile%unit, '(A6,A8,I8)') 'TYPE: ', type, int(2, 4)
    write (outfile%unit, '(A6,A)') 'DATA: ', time_string()

    write (outfile%unit, '(A11,2(I8))') 'DIMENSION: ', size(X, 1), size(X, 2)
    write (outfile%unit, '(A)') '---'

    do i = 1, m
        write (outfile%unit, *) X(i, :)
    end do
    call outfile%close()
    return
    end procedure savetxt_2_rdp
    module procedure savetxt_2_iint8
    integer :: i, m
    type(file) :: outfile
    character(8), parameter :: type = 'iint8'

    outfile = file(filename, 'w t')
    m = size(x, 1)

    call outfile%open()
    write (outfile%unit, '(A6,A8,I8)') 'TYPE: ', type, int(2, 4)
    write (outfile%unit, '(A6,A)') 'DATA: ', time_string()

    write (outfile%unit, '(A11,2(I8))') 'DIMENSION: ', size(X, 1), size(X, 2)
    write (outfile%unit, '(A)') '---'

    do i = 1, m
        write (outfile%unit, *) X(i, :)
    end do
    call outfile%close()
    return
    end procedure savetxt_2_iint8
    module procedure savetxt_2_iint16
    integer :: i, m
    type(file) :: outfile
    character(8), parameter :: type = 'iint16'

    outfile = file(filename, 'w t')
    m = size(x, 1)

    call outfile%open()
    write (outfile%unit, '(A6,A8,I8)') 'TYPE: ', type, int(2, 4)
    write (outfile%unit, '(A6,A)') 'DATA: ', time_string()

    write (outfile%unit, '(A11,2(I8))') 'DIMENSION: ', size(X, 1), size(X, 2)
    write (outfile%unit, '(A)') '---'

    do i = 1, m
        write (outfile%unit, *) X(i, :)
    end do
    call outfile%close()
    return
    end procedure savetxt_2_iint16
    module procedure savetxt_2_iint32
    integer :: i, m
    type(file) :: outfile
    character(8), parameter :: type = 'iint32'

    outfile = file(filename, 'w t')
    m = size(x, 1)

    call outfile%open()
    write (outfile%unit, '(A6,A8,I8)') 'TYPE: ', type, int(2, 4)
    write (outfile%unit, '(A6,A)') 'DATA: ', time_string()

    write (outfile%unit, '(A11,2(I8))') 'DIMENSION: ', size(X, 1), size(X, 2)
    write (outfile%unit, '(A)') '---'

    do i = 1, m
        write (outfile%unit, *) X(i, :)
    end do
    call outfile%close()
    return
    end procedure savetxt_2_iint32
    module procedure savetxt_2_iint64
    integer :: i, m
    type(file) :: outfile
    character(8), parameter :: type = 'iint64'

    outfile = file(filename, 'w t')
    m = size(x, 1)

    call outfile%open()
    write (outfile%unit, '(A6,A8,I8)') 'TYPE: ', type, int(2, 4)
    write (outfile%unit, '(A6,A)') 'DATA: ', time_string()

    write (outfile%unit, '(A11,2(I8))') 'DIMENSION: ', size(X, 1), size(X, 2)
    write (outfile%unit, '(A)') '---'

    do i = 1, m
        write (outfile%unit, *) X(i, :)
    end do
    call outfile%close()
    return
    end procedure savetxt_2_iint64
    module procedure savetxt_2_csp
    integer :: i, m
    type(file) :: outfile
    character(8), parameter :: type = 'csp'

    outfile = file(filename, 'w t')
    m = size(x, 1)

    call outfile%open()
    write (outfile%unit, '(A6,A8,I8)') 'TYPE: ', type, int(2, 4)
    write (outfile%unit, '(A6,A)') 'DATA: ', time_string()

    write (outfile%unit, '(A11,2(I8))') 'DIMENSION: ', size(X, 1), size(X, 2)
    write (outfile%unit, '(A)') '---'

    do i = 1, m
        write (outfile%unit, *) X(i, :)
    end do
    call outfile%close()
    return
    end procedure savetxt_2_csp
    module procedure savetxt_2_cdp
    integer :: i, m
    type(file) :: outfile
    character(8), parameter :: type = 'cdp'

    outfile = file(filename, 'w t')
    m = size(x, 1)

    call outfile%open()
    write (outfile%unit, '(A6,A8,I8)') 'TYPE: ', type, int(2, 4)
    write (outfile%unit, '(A6,A)') 'DATA: ', time_string()

    write (outfile%unit, '(A11,2(I8))') 'DIMENSION: ', size(X, 1), size(X, 2)
    write (outfile%unit, '(A)') '---'

    do i = 1, m
        write (outfile%unit, *) X(i, :)
    end do
    call outfile%close()
    return
    end procedure savetxt_2_cdp
end submodule forlab__io_txt


text:
        SUBROUTINE YRCCS3(CCS3,DET,BCKMD,BCKMN,SKYMD,SKYMN,
     *                    PEDGRE,DESCRP,ISTAT)
*
*  Module number:
*
*  Module name: YRCCS3
*
*  Keyphrase:
*  ----------
*       read filter width table
*
*  Description:
*  ------------
*       This routine reads the table contianing the filter widths for
*       smoothing the background and sky spectra.  The proper values are
*       selected by detector.
*
*  FORTRAN name: YRCCS3.for
*
*  Keywords of accessed files and tables:
*  --------------------------------------
*  Name                         I/O     Description / Comments
*       CCS3                    I       table containing CCS3 coeffecients
*  Subroutines Called:
*  -------------------
*  CDBS
*       ymsput
*  SDAS:
*       uttopn, utpgti, utcfnd, utrgt*, uttclo
*
*  History:
*  --------
*  Version      Date        Author          Description
*       1       July 89  D. Lindler      Designed and coded
*	2	Mar 94	 H. Bushouse	 Mods to handle PEDIGREE keywords
*-------------------------------------------------------------------------------
*
* Input parameters
*
*       CCS3 - table name
*       DET  - detector name ('AMBER' or 'BLUE')
*
* Output parameters
*       BCKMD - background median filter width
*       BCKMN - background mean filter width
*       SKYMD - sky median filter width
*       SKYMN - sky mean filter width
*	PEDGRE - CCS3 PEDIGREE keyword string
*	DESCRP - CCS3 DESCRIP  keyword string
*       ISTAT - error status
*
*-----------------------------------------------------------------------------
        INTEGER ISTAT
        CHARACTER*64 CCS3
        CHARACTER*5 DET
	CHARACTER*68 PEDGRE,DESCRP
        INTEGER BCKMD,BCKMN,SKYMD,SKYMN
C
C     FILE I/O ACCESS MODES
C
      INTEGER   RDONLY
      PARAMETER (RDONLY = 1)
C
C     UMSPUT DESTINATIONS -- CB, DAO, 4-SEP-87
C
      INTEGER STDOUT
      PARAMETER (STDOUT = 1)
      INTEGER STDERR
      PARAMETER (STDERR = 2)
C
C     THESE MAY BE READ BY UTPGTI BUT MAY NOT BE SET:
C
C                                       NUMBER OF ROWS WRITTEN TO
      INTEGER   TBNROW
      PARAMETER (TBNROW = 21)
C     END IRAF77.INC
C
C local variables
C
        INTEGER IDIN,COLIDS(5),ROW,I,NROWS,ISTATS(4)
        CHARACTER*80 CONTXT
        CHARACTER*15 COLNAM(5)
        CHARACTER*5 DET1
        LOGICAL NULL
        DATA COLNAM/'DETECTOR','BCK_MD','BCK_MN','SKY_MD','SKY_MN'/
C---------------------------------------------------------------------------
C
C Open table
C
        CALL UTTOPN(CCS3,RDONLY,IDIN,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='ERROR opening CCS3 table '//CCS3
                GO TO 998
        ENDIF
C
C get PEDIGREE and DESCRIP header keywords
C
        CALL UTHGTT(IDIN,'PEDIGREE',PEDGRE,ISTAT)
        CALL UTHGTT(IDIN,'DESCRIP',DESCRP,ISTAT)
C
C get number of rows
C
        CALL UTPGTI(IDIN,TBNROW,NROWS,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='ERROR reading CCS3 table '//CCS3
                GO TO 999
        ENDIF
C
C Get column ids.
C
        CALL UTCFND(IDIN,COLNAM,5,COLIDS,ISTAT)
        IF(ISTAT.NE.0)THEN
                CONTXT='ERROR locating needed columns in CCS3 table '//
     *                  CCS3
                GO TO 999
        ENDIF
C
C Loop on rows
C
        DO 500 ROW=1,NROWS
C
C check detector
C
                CONTXT='ERROR reading CCS3 table '//CCS3
                CALL UTRGTT(IDIN,COLIDS(1),1,ROW,DET1,NULL,ISTAT)
                IF(ISTAT.NE.0)GO TO 999
                IF(DET1.NE.DET) GO TO 500
C
C read values
C
                CALL UTRGTI(IDIN,COLIDS(2),1,ROW,BCKMD,NULL,ISTATS(1))
                CALL UTRGTI(IDIN,COLIDS(3),1,ROW,BCKMN,NULL,ISTATS(2))
                CALL UTRGTI(IDIN,COLIDS(4),1,ROW,SKYMD,NULL,ISTATS(3))
                CALL UTRGTI(IDIN,COLIDS(5),1,ROW,SKYMN,NULL,ISTATS(4))
                DO 450 I=1,4
                    IF(ISTATS(I).NE.0)THEN
                        CONTXT='ERROR reading CCR3 table '//CCS3
                        GO TO 999
                    ENDIF
450             CONTINUE
                GO TO 600
500     CONTINUE
C
C If we got here (no row found)
C
        WRITE(CONTXT,99)DET
99      FORMAT('ERROR: No rows found in CCS3 for ',A5,' detector')
        GO TO 999
600     CALL UTTCLO(IDIN,ISTAT)
        ISTAT=0
        GO TO 1000
999     CALL UTTCLO(IDIN,ISTAT)
998     CALL YMSPUT(CONTXT,STDOUT+STDERR,0,ISTAT)
        ISTAT=1
1000    RETURN
        END

ext: f

max_stars_repo_name: iraf-community/stsdas


text:
!
!     Copyright (c) 2017, NVIDIA CORPORATION.  All rights reserved.
!
! NVIDIA CORPORATION and its licensors retain all intellectual property
! and proprietary rights in and to this software, related documentation
! and any modifications thereto.  Any use, reproduction, disclosure or
! distribution of this software and related documentation without an express
! license agreement from NVIDIA CORPORATION is strictly prohibited.
!

!          THIS CODE AND INFORMATION ARE PROVIDED "AS IS" WITHOUT
!   WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT
!   NOT LIMITED TO THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR
!   FITNESS FOR A PARTICULAR PURPOSE.
!

module matrix

type :: base_matrix(k,c,r)
  private
    integer, kind :: k = 4
    integer, len :: c = 1
    integer, len :: r = 1
end type base_matrix

type, extends(base_matrix) ::  adj_matrix
  private
    class(*), pointer :: m(:,:) => null()
end type adj_matrix

interface getKind
  module procedure getKind4
  module procedure getKind8
end interface getKind

interface getColumns
  module procedure getNumCols4
  module procedure getNumCols8
end interface getColumns

interface getRows
  module procedure getNumRows4
  module procedure getNumRows8
end interface getRows

interface adj_matrix
   module procedure construct_4   ! kind=4 constructor
   module procedure construct_8   ! kind=8 constructor
end interface adj_matrix

interface assignment(=)
   module procedure m2m4          ! assign kind=4 matrix
   module procedure a2m4          ! assign kind=4 array
   module procedure m2m8          ! assign kind=8 matrix
   module procedure a2m8          ! assign kind=8 array
   module procedure m2a4          ! assign kind=4 matrix to array
   module procedure m2a8          ! assign kind=8 matrix to array
end interface assignment(=)

contains

  function getKind4(this) result(rslt)
   class(adj_matrix(4,*,*)) :: this
   integer :: rslt
   rslt = this%k
  end function getKind4

 function getKind8(this) result(rslt)
   class(adj_matrix(8,*,*)) :: this
   integer :: rslt
   rslt = this%k
 end function getKind8

  function getNumCols4(this) result(rslt)
   class(adj_matrix(4,*,*)) :: this
   integer :: rslt
   rslt = this%c
  end function getNumCols4

  function getNumCols8(this) result(rslt)
   class(adj_matrix(8,*,*)) :: this
   integer :: rslt
   rslt = this%c
  end function getNumCols8

  function getNumRows4(this) result(rslt)
   class(adj_matrix(4,*,*)) :: this
   integer :: rslt
   rslt = this%r
  end function getNumRows4

  function getNumRows8(this) result(rslt)
   class(adj_matrix(8,*,*)) :: this
   integer :: rslt
   rslt = this%r
  end function getNumRows8

 function construct_4(k,c,r) result(mat)
     integer(4) :: k
     integer :: c
     integer :: r
     class(adj_matrix(4,:,:)),allocatable :: mat

     allocate(adj_matrix(4,c,r)::mat)

  end function construct_4

  function construct_8(k,c,r) result(mat)
     integer(8) :: k
     integer :: c
     integer :: r
     class(adj_matrix(8,:,:)),allocatable :: mat

     allocate(adj_matrix(8,c,r)::mat)

  end function construct_8

  subroutine a2m4(d,s)
   class(adj_matrix(4,:,:)),allocatable :: d
   class(*),dimension(:,:) :: s

   if (allocated(d)) deallocate(d)
   allocate(adj_matrix(4,size(s,1),size(s,2))::d)
   allocate(d%m(size(s,1),size(s,2)),source=s)
 end subroutine a2m4

 subroutine a2m8(d,s)
   class(adj_matrix(8,:,:)),allocatable :: d
   class(*),dimension(:,:) :: s

   if (allocated(d)) deallocate(d)
   allocate(adj_matrix(8,size(s,1),size(s,2))::d)
   allocate(d%m(size(s,1),size(s,2)),source=s)
 end subroutine a2m8

subroutine m2a8(a,this)
class(adj_matrix(8,*,*)) :: this
class(*),allocatable :: a(:,:)
  if (allocated(a)) deallocate(a)
  allocate(a(size(this%m,1),size(this%m,2)),source=this%m)
 end subroutine m2a8

 subroutine m2a4(a,this)
 class(adj_matrix(4,*,*)) :: this
 class(*),allocatable :: a(:,:)
   if (allocated(a)) deallocate(a)
   allocate(a(size(this%m,1),size(this%m,2)),source=this%m)
 end subroutine m2a4

  subroutine m2m4(d,s)
   class(adj_matrix(4,:,:)),allocatable :: d
   class(adj_matrix(4,*,*)) :: s

   if (allocated(d)) deallocate(d)
   allocate(d,source=s)
 end subroutine m2m4

 subroutine m2m8(d,s)
   type(adj_matrix(8,:,:)),allocatable :: d
   type(adj_matrix(8,*,*)) :: s

   if (allocated(d)) deallocate(d)
   allocate(d,source=s)
 end subroutine m2m8

end module matrix

program adj3

  use matrix
  implicit none
  integer(8) :: i,j,k,nerrors

  type(adj_matrix(8,:,:)),allocatable :: adj
  real(8) :: a(2,3)
  real(8),allocatable :: b(:,:)

  nerrors = 0
  adj = adj_matrix(INT(8,8),2,4)

  k = 1
  do i=1,2
   do j=1, 3
    a(i,j) = k
    k = k + 1
   enddo
  enddo

  adj = a
  b = adj

  do i=1,2
   do j=1, 3
    if (b(i,j) .ne. a(i,j)) then
      nerrors = nerrors + 1
    endif
   enddo
  enddo

  if (nerrors .ne. 0) then
     print *, "Test FAILED"
  else
     print *, "Test PASSED"
  endif

end program adj3

max_stars_repo_name: shubiuh/PGIexample

max_issues_repo_name: shubiuh/PGIexample

max_forks_repo_name: shubiuh/PGIexample


text: A major fire broke out in the city of Davis at about 11 AM on the morning of November 13, 1916. The fire started out, through mechanisms still unknown, in a pool hall in the area now known as Old North Davis Neighborhood Association Old North Davis. The damage the fire was estimated at $75,000  $100,000 ($1.4 million to $1.9 million in 2007 dollars). This event was a major catalyst for the efforts to incorporate the City of Davis in order to provide services like a Fire Department.

max_stars_repo_name: voflo/Search

max_issues_repo_name: voflo/Search

max_forks_repo_name: voflo/Search


!
! input/output routines
!
!=============================================================================
module mod_io
   use mod_prec
   use mod_params, only: nx, ny, nl, tables_dir, output_dir
   use mod_field,  only: field

   implicit none
!=============================================================================
   private
   public :: set_arr, write_csv
!=============================================================================
   interface set_arr
      module procedure set_arr_1d, set_arr_2d, set_arr_3d
   end interface

   interface write_csv
      module procedure &
         write_field_csv, &
         write_array_0d_real_csv, &
         write_array_1d_real_csv, &
         write_array_1d_complex_csv, &
         write_array_2d_complex_csv
   end interface
!=============================================================================
contains
!=============================================================================
   subroutine set_arr_1d(fn, n1, arr)
      character(*), intent(in)  :: fn
      integer(ip),  intent(in)  :: n1
      real(rp),     intent(out) :: arr(n1)

      character(:), allocatable :: rn
      integer(ip) :: ierror
      integer(ip) :: uf
      ! set the file fname to read from
      rn = tables_dir // '/' // fn

      ! Note: here we ASSUME the input file is correctly formatted
      open(newunit=uf,file=rn,status='old',action='read',iostat=ierror)
         if (ierror/=0) then
            write (*,*) "Error(read_arr): ierror=", ierror
            write (*,*) "file = ", rn
            stop
         end if
         read (uf,*,iostat=ierror) arr
      close(uf)
   end subroutine set_arr_1d
!=============================================================================
   subroutine set_arr_2d(fn, n1, n2, arr)
      character(*), intent(in)  :: fn
      integer(ip),  intent(in)  :: n1, n2
      real(rp),     intent(out) :: arr(n1,n2)

      character(:), allocatable :: rn
      integer(ip) :: i1, ierror
      integer(ip) :: uf
      ! set the file fname to read from
      rn = tables_dir // '/' // fn

      ! Note: here we ASSUME the input file is correctly formatted
      open(newunit=uf,file=rn,status='old',action='read',iostat=ierror)
         if (ierror/=0) then
            write (*,*) "Error(read_arr): ierror=", ierror
            write (*,*) "file = ", rn
            stop
         end if
         do i1=1,n1
            read (uf,*,iostat=ierror) arr(i1,:)
         end do
      close(uf)
   end subroutine set_arr_2d
!=============================================================================
   subroutine set_arr_3d(fn, n1, n2, n3, arr)
      character(*), intent(in)  :: fn
      integer(ip),  intent(in)  :: n1, n2, n3
      real(rp),     intent(out) :: arr(n1,n2,n3)

      character(:), allocatable :: rn
      integer(ip) :: i1, i2, ierror
      integer(ip) :: uf
      ! set the file fname to read from
      rn = tables_dir // '/' // fn

      ! Note: here we ASSUME the input file is correctly formatted
      open(newunit=uf,file=rn,status='old',action='read',iostat=ierror)
         if (ierror/=0) then
            write (*,*) "Error(read_arr): ierror=", ierror
            write (*,*) "file = ", rn
            stop
         end if
         do i1=1,n1
         do i2=1,n2
            read (uf,*,iostat=ierror) arr(i1,i2,:)
         end do
         end do
      close(uf)
   end subroutine set_arr_3d
!=============================================================================
! writes to one line, row by row
   subroutine write_array_0d_real_csv(fn, time, m_ang, val)
      character(*), intent(in) :: fn
      real(rp),     intent(in) :: time
      integer(ip),  intent(in) :: m_ang
      real(rp),     intent(in) :: val

      character(:), allocatable  :: mstr, fn_re
      logical :: exists
      integer(ip) :: ierror = 0
      integer(ip) :: uf

      ! inelegant int to str conversion
      mstr = '     '
      write (mstr,'(i5)') m_ang
      mstr = trim(adjustl(mstr))
      ! set the file fname to read from
      fn_re = output_dir // '/' // fn // '_m' // mstr // '.csv'
      !----------------------------------------------------------------------
      ! save real part
      !----------------------------------------------------------------------
      inquire(file=fn_re,exist=exists)
      if (exists) then
         open(newunit=uf,file=fn_re,status='old',position='append',action='write',iostat=ierror)
      else
         open(newunit=uf,file=fn_re,status='new',action='write',iostat=ierror)
      end if

      write (uf,'(e20.12,e20.12)',iostat=ierror) time, val

      close(uf)

      if (ierror/=0) then
         write (*,*) "Error(read_arr): ierror=", ierror
         write (*,*) "file = ", fn_re
         stop
      end if
   end subroutine write_array_0d_real_csv
!=============================================================================
! writes to one line, row by row
   subroutine write_array_1d_real_csv(fn, time, m_ang, arr)
      character(*), intent(in) :: fn
      real(rp),     intent(in) :: time
      integer(ip),  intent(in) :: m_ang
      real(rp),     intent(in) :: arr(:)

      character(:), allocatable  :: mstr, fn_re
      integer(ip) :: ubx, lbx
      logical :: exists
      integer(ip) :: i, ierror = 0
      integer(ip) :: uf

      lbx = lbound(arr,1)
      ubx = ubound(arr,1)

      ! inelegant int to str conversion
      mstr = '     '
      write (mstr,'(i5)') m_ang
      mstr = trim(adjustl(mstr))
      ! set the file fname to read from
      fn_re = output_dir // '/' // fn // '_m' // mstr // '.csv'
      !----------------------------------------------------------------------
      inquire(file=fn_re,exist=exists)
      if (exists) then
         open(newunit=uf,file=fn_re,status='old',position='append',action='write',iostat=ierror)
      else
         open(newunit=uf,file=fn_re,status='new',action='write',iostat=ierror)
      end if

      write (uf,'(e20.12,a1,i3,a1)',advance='no',iostat=ierror) &
         time, ',', ubx-lbx+1, ','

      do i=lbx,ubx
         write (uf,'(e20.12,a1)',advance='no',iostat=ierror) arr(i), ','
      end do
      ! line break
      write (uf,*)

      close(uf)

      if (ierror/=0) then
         write (*,*) "Error(read_arr): ierror=", ierror
         write (*,*) "file = ", fn_re
         stop
      end if
   end subroutine write_array_1d_real_csv
!=============================================================================
! writes to one line, row by row
   subroutine write_array_1d_complex_csv(fn, time, m_ang, arr)
      character(*), intent(in) :: fn
      real(rp),     intent(in) :: time
      integer(ip),  intent(in) :: m_ang
      complex(rp),  intent(in) :: arr(:)

      character(:), allocatable  :: mstr, fn_re, fn_im
      integer(ip) :: ubx, lbx
      logical :: exists
      integer(ip) :: i, ierror = 0
      integer(ip) :: uf

      lbx = lbound(arr,1)
      ubx = ubound(arr,1)

      ! inelegant int to str conversion
      mstr = '     '
      write (mstr,'(i5)') m_ang
      mstr = trim(adjustl(mstr))
      ! set the file fname to read from
      fn_re = output_dir // '/' // fn // '_m' // mstr // '_re.csv'
      fn_im = output_dir // '/' // fn // '_m' // mstr // '_im.csv'
      !----------------------------------------------------------------------
      ! save real part
      !----------------------------------------------------------------------
      inquire(file=fn_re,exist=exists)
      if (exists) then
         open(newunit=uf,file=fn_re,status='old',position='append',action='write',iostat=ierror)
      else
         open(newunit=uf,file=fn_re,status='new',action='write',iostat=ierror)
      end if

      write (uf,'(e20.12,a1,i3,a1)',advance='no',iostat=ierror) &
         time, ',', ubx-lbx+1, ','

      do i=lbx,ubx
         write (uf,'(e20.12,a1)',advance='no',iostat=ierror) &
            real(arr(i),kind=rp), ','
      end do
      ! line break
      write (uf,*)

      close(uf)

      if (ierror/=0) then
         write (*,*) "Error(read_arr): ierror=", ierror
         write (*,*) "file = ", fn_re
         stop
      end if
      !----------------------------------------------------------------------
      ! save imaginary part
      !----------------------------------------------------------------------
      inquire(file=fn_im,exist=exists)
      if (exists) then
         open(newunit=uf,file=fn_im,status='old',position='append',action='write',iostat=ierror)
      else
         open(newunit=uf,file=fn_im,status='new',action='write',iostat=ierror)
      end if

      write (uf,'(e20.12,a1,i3,a1)',advance='no',iostat=ierror) &
         time, ',', ubx-lbx+1, ','

      do i=lbx,ubx
         write (uf,'(e20.12,a1)',advance='no',iostat=ierror) &
            aimag(arr(i)), ','
      end do
      ! line break
      write (uf,*)

      close(uf)

      if (ierror/=0) then
         write (*,*) "Error(read_arr): ierror=", ierror
         write (*,*) "file = ", fn_im
         stop
      end if
   end subroutine write_array_1d_complex_csv
!=============================================================================
! writes to one line, row by row
   subroutine write_array_2d_complex_csv(fn, time, m_ang, arr)
      character(*), intent(in) :: fn
      real(rp),     intent(in) :: time
      integer(ip),  intent(in) :: m_ang
      complex(rp),  intent(in) :: arr(:,:)

      character(:), allocatable  :: mstr, fn_re, fn_im
      integer(ip) :: ubx, uby, lbx, lby
      logical :: exists
      integer(ip) :: i, j, ierror = 0
      integer(ip) :: uf

      lbx = lbound(arr,1)
      lby = lbound(arr,2)

      ubx = ubound(arr,1)
      uby = ubound(arr,2)

      ! inelegant int to str conversion
      mstr = '     '
      write (mstr,'(i5)') m_ang
      mstr = trim(adjustl(mstr))
      ! set the file fname to read from
      fn_re = output_dir // '/' // fn // '_m' // mstr // '_re.csv'
      fn_im = output_dir // '/' // fn // '_m' // mstr // '_im.csv'
      !----------------------------------------------------------------------
      ! save real part
      !----------------------------------------------------------------------
      inquire(file=fn_re,exist=exists)
      if (exists) then
         open(newunit=uf,file=fn_re,status='old',position='append',action='write',iostat=ierror)
      else
         open(newunit=uf,file=fn_re,status='new',action='write',iostat=ierror)
      end if

      write (uf,'(e20.12,a1,i3,a1,i3,a1)',advance='no',iostat=ierror) &
         time, ',', ubx-lbx+1, ',', uby-lby+1, ','

      do i=lbx,ubx
      do j=lby,uby
         write (uf,'(e20.12,a1)',advance='no',iostat=ierror) &
            real(arr(i,j),kind=rp), ','
      end do
      end do
      ! line break
      write (uf,*)

      close(uf)

      if (ierror/=0) then
         write (*,*) "Error(read_arr): ierror=", ierror
         write (*,*) "file = ", fn_re
         stop
      end if
      !----------------------------------------------------------------------
      ! save imaginary part
      !----------------------------------------------------------------------
      inquire(file=fn_im,exist=exists)
      if (exists) then
         open(newunit=uf,file=fn_im,status='old',position='append',action='write',iostat=ierror)
      else
         open(newunit=uf,file=fn_im,status='new',action='write',iostat=ierror)
      end if

      write (uf,'(e20.12,a1,i3,a1,i3,a1)',advance='no',iostat=ierror) &
         time, ',', ubx-lbx+1, ',', uby-lby+1, ','

      do i=lbx,ubx
      do j=lby,uby
         write (uf,'(e20.12,a1)',advance='no',iostat=ierror) &
            aimag(arr(i,j)), ','
      end do
      end do
      ! line break
      write (uf,*)

      close(uf)

      if (ierror/=0) then
         write (*,*) "Error(read_arr): ierror=", ierror
         write (*,*) "file = ", fn_im
         stop
      end if
   end subroutine write_array_2d_complex_csv
!=============================================================================
   subroutine write_field_csv(time,m_ang,f)
      real(rp),    intent(in) :: time
      integer(ip), intent(in) :: m_ang
      type(field), intent(in) :: f

      call write_csv(f%fname, time, m_ang, f%np1(:,:,m_ang))

   end subroutine write_field_csv
!=============================================================================
end module mod_io


text:
!start qawa wrapper ##########################################
Subroutine sub1(x, y, z)

use omp_lib
use module
integer :: i

integer :: q_sys_start, q_sys_end
real(kind=8) :: q_wtime_start, q_wtime_end, q_cpu_start, q_cpu_end
real(kind=8) :: cpu_rate
character(len=256) :: q_file
integer :: th, ths, count_rate, count_max, q_unit
call system_clock(count_rate=count_rate)
call system_clock(count_max=count_max)
cpu_rate = real(count_rate)
th = OMP_GET_THREAD_NUM() + 1
ths = OMP_GET_NUM_THREADS()

write (q_file, '(A, A)')&
&'/home/adam.sokol/QCHEM/PROFILING/QAWA&
&/outs/&
&qawa.out'

q_wtime_start = omp_get_wtime()
call cpu_time(q_cpu_start)
call SYSTEM_CLOCK(q_sys_start)

!$OMP CRITICAL
open(newunit=q_unit,file=&
&q_file,&
&action='write',position='append')
write(q_unit,'(A, 2I3)')&
&'-> test_data.f90 &
&sub1 S',&
&th, ths
close(q_unit)
!$OMP END CRITICAL
call qawa_sub1(x, y, z)

q_wtime_end = omp_get_wtime()
call cpu_time(q_cpu_end)
call SYSTEM_CLOCK(q_sys_end)

!$OMP CRITICAL
open(newunit=q_unit,file=&
&q_file,&
&action='write',position='append')
write(q_unit,'(A, 2I3, 3F14.6)')&
&'<- test_data.f90 &
&sub1 S',&
&th, ths,&
&(q_sys_end-q_sys_start)/cpu_rate, q_cpu_end-q_cpu_start, &
&q_wtime_end-q_wtime_start
close(q_unit)
!$OMP END CRITICAL
return
end
!end qawa wrapper ############################################

Subroutine qawa_sub1&
(x, y, z)
    use module
    integer :: i
    <some code>
End subroutine qawa_sub1

!start qawa wrapper ##########################################
Subroutine sub2 &
(x, y, z)

use omp_lib
use module
real :: r

integer :: q_sys_start, q_sys_end
real(kind=8) :: q_wtime_start, q_wtime_end, q_cpu_start, q_cpu_end
real(kind=8) :: cpu_rate
character(len=256) :: q_file
integer :: th, ths, count_rate, count_max, q_unit
call system_clock(count_rate=count_rate)
call system_clock(count_max=count_max)
cpu_rate = real(count_rate)
th = OMP_GET_THREAD_NUM() + 1
ths = OMP_GET_NUM_THREADS()

write (q_file, '(A, A)')&
&'/home/adam.sokol/QCHEM/PROFILING/QAWA&
&/outs/&
&qawa.out'

q_wtime_start = omp_get_wtime()
call cpu_time(q_cpu_start)
call SYSTEM_CLOCK(q_sys_start)

!$OMP CRITICAL
open(newunit=q_unit,file=&
&q_file,&
&action='write',position='append')
write(q_unit,'(A, 2I3)')&
&'-> test_data.f90 &
&sub2 S',&
&th, ths
close(q_unit)
!$OMP END CRITICAL
call qawa_sub2 &
(x, y, z)

q_wtime_end = omp_get_wtime()
call cpu_time(q_cpu_end)
call SYSTEM_CLOCK(q_sys_end)

!$OMP CRITICAL
open(newunit=q_unit,file=&
&q_file,&
&action='write',position='append')
write(q_unit,'(A, 2I3, 3F14.6)')&
&'<- test_data.f90 &
&sub2 S',&
&th, ths,&
&(q_sys_end-q_sys_start)/cpu_rate, q_cpu_end-q_cpu_start, &
&q_wtime_end-q_wtime_start
close(q_unit)
!$OMP END CRITICAL
return
end
!end qawa wrapper ############################################

Subroutine qawa_sub2 &
    (x, y, z)
    use module
    real :: r
    <some code>
End subroutine

!start qawa wrapper ##########################################
subroutine sub3&
(x, y, z)

use omp_lib
real :: r

integer :: q_sys_start, q_sys_end
real(kind=8) :: q_wtime_start, q_wtime_end, q_cpu_start, q_cpu_end
real(kind=8) :: cpu_rate
character(len=256) :: q_file
integer :: th, ths, count_rate, count_max, q_unit
call system_clock(count_rate=count_rate)
call system_clock(count_max=count_max)
cpu_rate = real(count_rate)
th = OMP_GET_THREAD_NUM() + 1
ths = OMP_GET_NUM_THREADS()

write (q_file, '(A, A)')&
&'/home/adam.sokol/QCHEM/PROFILING/QAWA&
&/outs/&
&qawa.out'

q_wtime_start = omp_get_wtime()
call cpu_time(q_cpu_start)
call SYSTEM_CLOCK(q_sys_start)

!$OMP CRITICAL
open(newunit=q_unit,file=&
&q_file,&
&action='write',position='append')
write(q_unit,'(A, 2I3)')&
&'-> test_data.f90 &
&sub3 S',&
&th, ths
close(q_unit)
!$OMP END CRITICAL
call qawa_sub3&
(x, y, z)

q_wtime_end = omp_get_wtime()
call cpu_time(q_cpu_end)
call SYSTEM_CLOCK(q_sys_end)

!$OMP CRITICAL
open(newunit=q_unit,file=&
&q_file,&
&action='write',position='append')
write(q_unit,'(A, 2I3, 3F14.6)')&
&'<- test_data.f90 &
&sub3 S',&
&th, ths,&
&(q_sys_end-q_sys_start)/cpu_rate, q_cpu_end-q_cpu_start, &
&q_wtime_end-q_wtime_start
close(q_unit)
!$OMP END CRITICAL
return
end
!end qawa wrapper ############################################

subroutine qawa_sub3&
    (x, y, z)
    real :: r
    <some code>
end

subroutine not_sub1(x,y)
    <some code>
end

function fun1(x) result(y)
      use omp_lib
integer :: j
real :: y
!start qawa open_qawa_fun1 ##################################
integer :: q_sys_start, q_sys_end
real(kind=8) :: q_wtime_start, q_wtime_end, q_cpu_start, q_cpu_end
real(kind=8) :: cpu_rate
character(len=256) :: q_file
integer :: th, ths, count_rate, count_max, q_unit
call system_clock(count_rate=count_rate)
call system_clock(count_max=count_max)
cpu_rate = real(count_rate)
th = OMP_GET_THREAD_NUM() + 1
ths = OMP_GET_NUM_THREADS()

write (q_file, '(A, A)')&
&'/home/adam.sokol/QCHEM/PROFILING/QAWA&
&/outs/&
&qawa.out'

q_wtime_start = omp_get_wtime()
call cpu_time(q_cpu_start)
call SYSTEM_CLOCK(q_sys_start)

!$OMP CRITICAL
open(newunit=q_unit,file=&
&q_file,&
&action='write',position='append')
write(q_unit,'(A, 2I3)')&
&'-> test_data.f90 &
&fun1 F',&
&th, ths
close(q_unit)
!$OMP END CRITICAL
!end qawa  ##################################

<some code>
!start qawa close_qawa_fun1 ##################################
q_wtime_end = omp_get_wtime()
call cpu_time(q_cpu_end)
call SYSTEM_CLOCK(q_sys_end)

!$OMP CRITICAL
open(newunit=q_unit,file=&
&q_file,&
&action='write',position='append')
write(q_unit,'(A, 2I3, 3F14.6)')&
&'<- test_data.f90 &
&fun1 F',&
&th, ths,&
&(q_sys_end-q_sys_start)/cpu_rate, q_cpu_end-q_cpu_start, &
&q_wtime_end-q_wtime_start
close(q_unit)
!$OMP END CRITICAL
!end qawa  ##################################

return
end

REAL*8 Function fun2(x)
      use omp_lib
integer :: j
!start qawa open_qawa_fun2 ##################################
integer :: q_sys_start, q_sys_end
real(kind=8) :: q_wtime_start, q_wtime_end, q_cpu_start, q_cpu_end
real(kind=8) :: cpu_rate
character(len=256) :: q_file
integer :: th, ths, count_rate, count_max, q_unit
call system_clock(count_rate=count_rate)
call system_clock(count_max=count_max)
cpu_rate = real(count_rate)
th = OMP_GET_THREAD_NUM() + 1
ths = OMP_GET_NUM_THREADS()

write (q_file, '(A, A)')&
&'/home/adam.sokol/QCHEM/PROFILING/QAWA&
&/outs/&
&qawa.out'

q_wtime_start = omp_get_wtime()
call cpu_time(q_cpu_start)
call SYSTEM_CLOCK(q_sys_start)

!$OMP CRITICAL
open(newunit=q_unit,file=&
&q_file,&
&action='write',position='append')
write(q_unit,'(A, 2I3)')&
&'-> test_data.f90 &
&fun2 F',&
&th, ths
close(q_unit)
!$OMP END CRITICAL
!end qawa  ##################################

<some code>
!start qawa close_qawa_fun2 ##################################
q_wtime_end = omp_get_wtime()
call cpu_time(q_cpu_end)
call SYSTEM_CLOCK(q_sys_end)

!$OMP CRITICAL
open(newunit=q_unit,file=&
&q_file,&
&action='write',position='append')
write(q_unit,'(A, 2I3, 3F14.6)')&
&'<- test_data.f90 &
&fun2 F',&
&th, ths,&
&(q_sys_end-q_sys_start)/cpu_rate, q_cpu_end-q_cpu_start, &
&q_wtime_end-q_wtime_start
close(q_unit)
!$OMP END CRITICAL
!end qawa  ##################################

Return
!start qawa close_qawa_fun2 ##################################
q_wtime_end = omp_get_wtime()
call cpu_time(q_cpu_end)
call SYSTEM_CLOCK(q_sys_end)

!$OMP CRITICAL
open(newunit=q_unit,file=&
&q_file,&
&action='write',position='append')
write(q_unit,'(A, 2I3, 3F14.6)')&
&'<- test_data.f90 &
&fun2 F',&
&th, ths,&
&(q_sys_end-q_sys_start)/cpu_rate, q_cpu_end-q_cpu_start, &
&q_wtime_end-q_wtime_start
close(q_unit)
!$OMP END CRITICAL
!end qawa  ##################################

End function fun2

function not_fun1(x) result(y)
<some code>
end function

max_stars_repo_name: SokolAK/QAWA

max_issues_repo_name: SokolAK/QAWA

max_forks_repo_name: SokolAK/QAWA