diff --git a/srcF/parser_subfunctions.f90 b/srcF/parser_subfunctions.f90 index fd9e0bd423b6323b04b8f076948e1ad7496a6aa4..39b06d9bae9c90184aa473a74aea3ea3c6e4279a 100644 --- a/srcF/parser_subfunctions.f90 +++ b/srcF/parser_subfunctions.f90 @@ -2,20 +2,29 @@ module PARSER_SUB_F contains - FUNCTION compare_char_arrays(arr1, arr2, N) RESULT(isEqual) + FUNCTION compare_char_arrays(arr1, arr2) RESULT(isEqual) IMPLICIT NONE - CHARACTER, intent(in) :: arr1(N) - CHARACTER, intent(in) :: arr2(N) - INTEGER, intent(in) :: N - LOGICAL :: isEqual - INTEGER :: i + INTEGER :: size1, size2 + CHARACTER, intent(in) :: arr1(:) + CHARACTER(len=*), intent(in) :: arr2 + LOGICAL:: isEqual + INTEGER :: N, i + size1 = size(arr1) + size2 = len(arr2) isEqual = .TRUE. + IF (size1.NE.size2) THEN + isEqual = .FALSE. + RETURN + END IF + + N = size1 + DO i = 1, N - IF (arr1(i) .NE. arr2(i)) THEN + IF (arr1(i) .NE. arr2(i:i)) THEN isEqual = .FALSE. ! Найдено неравенство - EXIT + RETURN END IF END DO END FUNCTION compare_char_arrays @@ -30,11 +39,11 @@ module PARSER_SUB_F call get_charf(config_var_name, sfx_type) - if ( compare_char_arrays(sfx_type, "ocean", SIZE(sfx_type)) ) then + if ( compare_char_arrays(sfx_type, "ocean") ) then type = surface_ocean - else if ( compare_char_arrays(sfx_type, "lake", SIZE(sfx_type)) ) then + else if ( compare_char_arrays(sfx_type, "lake") ) then type = surface_lake - else if ( compare_char_arrays(sfx_type, "land", SIZE(sfx_type)) ) then + else if ( compare_char_arrays(sfx_type, "land") ) then type = surface_land end if @@ -43,3 +52,4 @@ module PARSER_SUB_F end module PARSER_SUB_F #endif +