set_locate Subroutine

public subroutine set_locate(lstring, lset, number_hits, hit_loc)

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: lstring
character(len=*), intent(in) :: lset
integer, intent(inout) :: number_hits
integer, intent(inout), dimension(:) :: hit_loc

Source Code

    subroutine set_locate(lstring, lset, number_hits, hit_loc)
    
    !---------------------------------------------------------------------------
    ! Locates in STRING, any elements of SET and places their location 
    ! in hit_loc. 
    !---------------------------------------------------------------------------
 
    ! arguments
    character(len=*),     intent(in   ) :: lstring
    character(len=*),     intent(in   ) :: lset
    integer,              intent(inout) :: number_hits
    integer, dimension(:),intent(inout) :: hit_loc       ! of size number_hits
    
    ! local variables
    integer :: k, klast, ncount
    integer :: len_string, len_set

    ! initialize variables
    ncount = 0
    klast = 0
    len_string = len(lstring)
    len_set = len( trim(adjustL(lset) ))

    !---------------------------------------------------------------------------
    ! error check - conduct the scan only if the set and string are not empty.
    !---------------------------------------------------------------------------
    if( (len_set > 0) .and. (len_string > 0) ) then
       !------------------------------------------------------------------------
       ! examine the string to find the find the FIRST instance of an 
       ! element in the set.
       !------------------------------------------------------------------------
       k = scan(lstring(klast+1:len_string), trim(adjustL(lset) ))
       do while( k > 0 )
          ncount = ncount + 1 ! count match.
          hit_loc(ncount) = k+klast  ! save location of set match.
          klast = k + klast ! slide forward in string looking for next match.
          k = scan(lstring(klast+1:len_string), trim(adjustL(lset) ))
       enddo     ! while
    endif
    ! sanity check - if these do not agree something has failed.
    if (number_hits /= ncount) ncount = 0
    ! return value
    number_hits = ncount

    !---------------------------------------------------------------------------
    end subroutine set_locate