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