Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
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