Statistics
| Revision:

root / src / InString.f90 @ 5

History | View | Annotate | Download (1.9 kB)

1
! This function compares two strings 
2
! Input, 5 variables out of which 3 optionals
3
! Line: the line to search in
4
! String: the stuff to search in Line
5
! Case [optional]: if present and true, the case is respected
6
! Clean [optional]: if present, Line is cleaned 
7
! Back [optional] if present and true, the string is seach backwards
8

    
9
    FUNCTION InString(Line,String,Case,Clean,Back)  Result(Pos)
10

    
11
      Use VarTypes
12
      Use io_module
13

    
14
      implicit none
15

    
16

    
17
  INTERFACE
18
     function valid(string) result (isValid)
19
       CHARACTER(*), intent(in) :: string
20
       logical                  :: isValid
21
     END function VALID
22
  END INTERFACE
23

    
24
! Input
25
      CHARACTER(*), INTENT(IN) :: Line
26
      CHARACTER(*), INTENT(IN) :: String
27
      LOGICAL, OPTIONAL, INTENT(IN) :: Case
28
      LOGICAL, OPTIONAL, INTENT(IN) :: Back
29
      CHARACTER(*), OPTIONAL, INTENT(IN) :: Clean
30

    
31
! Output
32
! the position of String in Line (the first one) unless Back is present
33
      INTEGER(KINT) :: Pos
34

    
35
      CHARACTER(LCHARS) :: LineUp,UpString
36
      LOGICAL :: LCase, LBack, debug
37

    
38
      Debug=valid('InString')
39

    
40
      if (debug) Call header('Entering InString')
41

    
42
      if (present(Case)) THEN
43
         LCase=Case
44
      else 
45
         LCase=.FALSE.
46
      END IF
47

    
48
      if (present(Back)) THEN
49
         LBack=Back
50
      ELSE
51
         LBack=.FALSE.
52
      END IF
53

    
54
      UpString=String
55
      if (.NOT.LCase) Call upcase(UpString)
56

    
57
      if (debug) WRITE(*,*) 'Looking for:',Upstring
58

    
59
      IF (present(Clean)) THEN
60
         Call CleanString(UpString,Clean)
61
      END IF
62

    
63
      if (debug) WRITE(*,*) 'Looking for clean:',TRIM(Upstring)
64

    
65
      LineUp=Line
66
      if (.NOT.LCase) Call UpCase(LineUp)
67
      IF (present(Clean)) THEN
68
         Call CleanString(LineUp,Clean)
69
      END IF
70
      if (debug) WRITE(*,*) 'Comparing with:',Trim(LineUp)
71

    
72
      Pos=INDEX(LineUp,TRIM(UpString),Back=LBack)
73

    
74
      if (debug) Call header('Exiting InString')
75

    
76
      Return
77

    
78
    END FUNCTION InString