Statistiques
| Révision :

root / src / InString.f90 @ 12

Historique | Voir | Annoter | Télécharger (3,21 ko)

1 12 pfleura2
    FUNCTION InString(Line,String,Case,Clean,Back)  Result(Pos)
2 12 pfleura2
3 5 pfleura2
! This function compares two strings
4 5 pfleura2
! Input, 5 variables out of which 3 optionals
5 5 pfleura2
! Line: the line to search in
6 5 pfleura2
! String: the stuff to search in Line
7 5 pfleura2
! Case [optional]: if present and true, the case is respected
8 5 pfleura2
! Clean [optional]: if present, Line is cleaned
9 5 pfleura2
! Back [optional] if present and true, the string is seach backwards
10 5 pfleura2
11 5 pfleura2
12 12 pfleura2
!----------------------------------------------------------------------
13 12 pfleura2
!  Copyright 2003-2014 Ecole Normale Supérieure de Lyon,
14 12 pfleura2
!  Centre National de la Recherche Scientifique,
15 12 pfleura2
!  Université Claude Bernard Lyon 1. All rights reserved.
16 12 pfleura2
!
17 12 pfleura2
!  This work is registered with the Agency for the Protection of Programs
18 12 pfleura2
!  as IDDN.FR.001.100009.000.S.P.2014.000.30625
19 12 pfleura2
!
20 12 pfleura2
!  Authors: P. Fleurat-Lessard, P. Dayal
21 12 pfleura2
!  Contact: optnpath@gmail.com
22 12 pfleura2
!
23 12 pfleura2
! This file is part of "Opt'n Path".
24 12 pfleura2
!
25 12 pfleura2
!  "Opt'n Path" is free software: you can redistribute it and/or modify
26 12 pfleura2
!  it under the terms of the GNU Affero General Public License as
27 12 pfleura2
!  published by the Free Software Foundation, either version 3 of the License,
28 12 pfleura2
!  or (at your option) any later version.
29 12 pfleura2
!
30 12 pfleura2
!  "Opt'n Path" is distributed in the hope that it will be useful,
31 12 pfleura2
!  but WITHOUT ANY WARRANTY; without even the implied warranty of
32 12 pfleura2
!
33 12 pfleura2
!  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
34 12 pfleura2
!  GNU Affero General Public License for more details.
35 12 pfleura2
!
36 12 pfleura2
!  You should have received a copy of the GNU Affero General Public License
37 12 pfleura2
!  along with "Opt'n Path". If not, see <http://www.gnu.org/licenses/>.
38 12 pfleura2
!
39 12 pfleura2
! Contact The Office of Technology Licensing, valorisation@ens-lyon.fr,
40 12 pfleura2
! for commercial licensing opportunities.
41 12 pfleura2
!----------------------------------------------------------------------
42 12 pfleura2
43 5 pfleura2
      Use VarTypes
44 5 pfleura2
      Use io_module
45 5 pfleura2
46 5 pfleura2
      implicit none
47 5 pfleura2
48 5 pfleura2
49 5 pfleura2
  INTERFACE
50 5 pfleura2
     function valid(string) result (isValid)
51 5 pfleura2
       CHARACTER(*), intent(in) :: string
52 5 pfleura2
       logical                  :: isValid
53 5 pfleura2
     END function VALID
54 5 pfleura2
  END INTERFACE
55 5 pfleura2
56 5 pfleura2
! Input
57 5 pfleura2
      CHARACTER(*), INTENT(IN) :: Line
58 5 pfleura2
      CHARACTER(*), INTENT(IN) :: String
59 5 pfleura2
      LOGICAL, OPTIONAL, INTENT(IN) :: Case
60 5 pfleura2
      LOGICAL, OPTIONAL, INTENT(IN) :: Back
61 5 pfleura2
      CHARACTER(*), OPTIONAL, INTENT(IN) :: Clean
62 5 pfleura2
63 5 pfleura2
! Output
64 5 pfleura2
! the position of String in Line (the first one) unless Back is present
65 5 pfleura2
      INTEGER(KINT) :: Pos
66 5 pfleura2
67 5 pfleura2
      CHARACTER(LCHARS) :: LineUp,UpString
68 5 pfleura2
      LOGICAL :: LCase, LBack, debug
69 5 pfleura2
70 5 pfleura2
      Debug=valid('InString')
71 5 pfleura2
72 5 pfleura2
      if (debug) Call header('Entering InString')
73 5 pfleura2
74 5 pfleura2
      if (present(Case)) THEN
75 5 pfleura2
         LCase=Case
76 5 pfleura2
      else
77 5 pfleura2
         LCase=.FALSE.
78 5 pfleura2
      END IF
79 5 pfleura2
80 5 pfleura2
      if (present(Back)) THEN
81 5 pfleura2
         LBack=Back
82 5 pfleura2
      ELSE
83 5 pfleura2
         LBack=.FALSE.
84 5 pfleura2
      END IF
85 5 pfleura2
86 5 pfleura2
      UpString=String
87 5 pfleura2
      if (.NOT.LCase) Call upcase(UpString)
88 5 pfleura2
89 5 pfleura2
      if (debug) WRITE(*,*) 'Looking for:',Upstring
90 5 pfleura2
91 5 pfleura2
      IF (present(Clean)) THEN
92 5 pfleura2
         Call CleanString(UpString,Clean)
93 5 pfleura2
      END IF
94 5 pfleura2
95 5 pfleura2
      if (debug) WRITE(*,*) 'Looking for clean:',TRIM(Upstring)
96 5 pfleura2
97 5 pfleura2
      LineUp=Line
98 5 pfleura2
      if (.NOT.LCase) Call UpCase(LineUp)
99 5 pfleura2
      IF (present(Clean)) THEN
100 5 pfleura2
         Call CleanString(LineUp,Clean)
101 5 pfleura2
      END IF
102 5 pfleura2
      if (debug) WRITE(*,*) 'Comparing with:',Trim(LineUp)
103 5 pfleura2
104 5 pfleura2
      Pos=INDEX(LineUp,TRIM(UpString),Back=LBack)
105 5 pfleura2
106 5 pfleura2
      if (debug) Call header('Exiting InString')
107 5 pfleura2
108 5 pfleura2
      Return
109 5 pfleura2
110 5 pfleura2
    END FUNCTION InString