match_string_multi_val Subroutine

private subroutine match_string_multi_val(match_str, unit_in, unit_output, val, n_val)

Arguments

Type IntentOptional Attributes Name
character(len=*) :: match_str
integer :: unit_in
integer :: unit_output
real :: val(n_val)
integer :: n_val

Source Code

    subroutine match_string_multi_val(match_str,unit_in,unit_output,val,n_val)
        !Finds a leading string and returns all the integer variables that follows it
        !Tab delimitted before and free format after
        implicit none

        integer n_val
        real val(n_val)
        character (*) match_str
        character(256) temp_str1,temp_str2,temp_str
        integer unit_in,unit_output
        integer index_val
        character(len=:), allocatable :: fmt

        val=-999.
        temp_str1=''
        temp_str2='Not available'
        rewind(unit_in)
        do while (index(temp_str1,match_str).eq.0)
            read(unit_in,'(a)',end=10) temp_str
            index_val=index(temp_str,achar(9))
            temp_str1=temp_str(1:index_val-1)
            temp_str=temp_str(index_val+1:)
            index_val=index(temp_str,achar(9))
            !if (index_val.gt.0) then
            !    temp_str2=temp_str(1:index_val-1)
            !else
            !    temp_str2=temp_str
            !endif
        end do
        if (LEN(trim(temp_str)).gt.0) then
            read(temp_str,*) val(1:n_val)
        else
            goto 15
        endif

        if (unit_output.ge.0) then
            write(fmt,'(A,I0,A)') '(A40,A3', n_val, 'es10.2)'
            write(unit_output,fmt) trim(match_str),' = ',val
        endif
        return

10      write(unit_output,*) 'WARNING: No match found to "'//trim(match_str)//'" in input files. Set to -999'
        return
15      write(unit_output,*) 'WARNING: No values for "'//trim(match_str)//'" in input files'

    end subroutine match_string_multi_val