module PARSER_SUB_F
    contains

    FUNCTION compare_char_arrays(arr1, arr2, N) RESULT(isEqual)
        IMPLICIT NONE
        CHARACTER, intent(in) :: arr1(N)
        CHARACTER, intent(in) :: arr2(N)
        INTEGER, intent(in) :: N
        LOGICAL :: isEqual
        INTEGER :: i

        isEqual = .TRUE.

        DO i = 1, N
            IF (arr1(i) .NE. arr2(i)) THEN
                isEqual = .FALSE.  ! Найдено неравенство
                EXIT
            END IF
        END DO
    END FUNCTION compare_char_arrays 

    FUNCTION get_sfx_type(config_var_name) RESULT(type)
        USE PARSER
        USE sfx_surface
        IMPLICIT NONE
        CHARACTER, intent(in) :: config_var_name(*)
        CHARACTER, allocatable :: sfx_type(:)
        INTEGER :: type

        call get_charf(config_var_name, sfx_type)

        if ( compare_char_arrays(sfx_type, "ocean", SIZE(sfx_type)) ) then
            type = surface_ocean
        else if ( compare_char_arrays(sfx_type, "lake", SIZE(sfx_type)) ) then
            type = surface_lake
        else if ( compare_char_arrays(sfx_type, "land", SIZE(sfx_type)) ) then
            type = surface_land
        end if

        deallocate(sfx_type)
    END FUNCTION get_sfx_type 

end module PARSER_SUB_F