Statistics
| Revision:

root / src / SearchInput.f90 @ 5

History | View | Annotate | Download (1.8 kB)

1
! This function search a string in an input block
2
    FUNCTION SearchInput(Input,String,Line,Clean)  Result(Found)
3

    
4
      Use VarTypes
5
      Use io_module
6

    
7
      implicit none
8

    
9

    
10
  INTERFACE
11
     function valid(string) result (isValid)
12
       CHARACTER(*), intent(in) :: string
13
       logical                  :: isValid
14
     END function VALID
15
  END INTERFACE
16

    
17
! Input
18
      TYPE (Input_line), POINTER, INTENT(IN) :: Input
19
      CHARACTER(*), INTENT(IN) :: String
20
      CHARACTER(*), OPTIONAL, INTENT(IN) :: Clean
21

    
22
! Output
23
      TYPE (Input_line), POINTER, INTENT(OUT) :: Line
24

    
25
      LOGICAL :: Found, Debug
26
      CHARACTER(LCHARS) :: LineUp,UpString
27

    
28
      Debug=valid('SearchInput')
29

    
30
      if (debug) Call header('Entering SearchInput')
31

    
32
      UpString=String
33
      Call upcase(UpString)
34

    
35
      if (debug) WRITE(*,*) 'Looking for:',Upstring
36

    
37
      IF (present(Clean)) THEN
38
         Call CleanString(UpString,Clean)
39
      END IF
40

    
41
      if (debug) WRITE(*,*) 'Looking for clean:',TRIM(Upstring)
42

    
43
      Line => Input
44
      LineUp=Line%line
45
      Call UpCase(LineUp)
46
      IF (present(Clean)) THEN
47
         Call CleanString(LineUp,Clean)
48
      END IF
49
      if (debug) WRITE(*,*) 'Comparing with:',Trim(LineUp)
50

    
51
      Found=(INDEX(LineUp,TRIM(UpString))>0)
52
      DO WHILE (Associated(Line%next).AND.(.NOT.Found))
53
         Line => Line%Next
54
         LineUp=Line%line
55
         Call UpCase(LineUp)
56
         IF (present(Clean)) THEN
57
            Call CleanString(LineUp,Clean)
58
         END IF
59
         if (debug) WRITE(*,*) 'Comparing with:',Trim(LineUp)
60

    
61
         Found=(INDEX(LineUp,TRIM(UpString))>0)
62
      END DO
63

    
64
      If (.NOT.Found) Nullify(Line)
65

    
66
      if (debug) Call header('Exiting SearchInput')
67

    
68
      Return
69
!--------------------------------------------------------------------------- END
70
    END FUNCTION SearchInput