SND@LHC Software
Loading...
Searching...
No Matches
Modules | Functions/Subroutines | Variables
mptext.f90 File Reference

Analyse text string. More...

Go to the source code of this file.

Modules

module  mptext
 Keyword position.
 

Functions/Subroutines

subroutine ratext (text, nums, dnum)
 Translate text.
 
subroutine rltext (text, ia, ib, nab)
 Analyse text range.
 
integer(mpi) function matint (pat, text, npat, ntext)
 Approximate string matching.
 

Variables

integer(mpi) mptext::keya
 start (position) of keyword
 
integer(mpi) mptext::keyb
 end (position) of keyword
 

Detailed Description

Analyse text string.

Author
Volker Blobel, University Hamburg, 2005-2009 (initial Fortran77 version)
Claus Kleinwort, DESY (maintenance and developement)
Copyright
Copyright (c) 2009 - 2015 Deutsches Elektronen-Synchroton, Member of the Helmholtz Association, (DESY), HAMBURG, GERMANY

This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version.

This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details.

You should have received a copy of the GNU Library General Public License along with this program (see the file COPYING.LIB for more details); if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

Definition in file mptext.f90.

Function/Subroutine Documentation

◆ matint()

integer(mpi) function matint ( character (len=*), intent(in)  pat,
character (len=*), intent(in)  text,
integer(mpi), intent(out)  npat,
integer(mpi), intent(out)  ntext 
)

Approximate string matching.

Approximate string matching - case insensitive. Return number of matches of string PAT in string TEXT, and number NPAT, NTEXT of characters of string PAT and string TEXT. Strings are considered from first to last non-blank character.

Example: 

 MATCH = MATINT(' keYs ','keyWO RD',NPAT,NTEXT)
 returns MATCH=3, NPAT=4, NTEXT=8
Parameters
[in]patpattern
[in]texttext
[out]npatnumber of characters in pattern
[out]ntextnumber of characters in text
Returns
number of matching characters of pattern in text

Definition at line 289 of file mptext.f90.

290 USE mpdef
291
292 IMPLICIT NONE
293 INTEGER(mpi) :: i
294 INTEGER(mpi) :: ic
295 INTEGER(mpi) :: ideq
296 INTEGER(mpi) :: ip
297 INTEGER(mpi) :: ipa
298 INTEGER(mpi) :: ipb
299 INTEGER(mpi) :: ita
300 INTEGER(mpi) :: itb
301 INTEGER(mpi) :: j
302 INTEGER(mpi) :: jc
303 INTEGER(mpi) :: jot
304 INTEGER(mpi) :: jt
305 INTEGER(mpi) :: npatma
306
307 CHARACTER (LEN=*), INTENT(IN) :: pat
308 CHARACTER (LEN=*), INTENT(IN) :: text
309 INTEGER(mpi), INTENT(OUT) :: npat
310 INTEGER(mpi), INTENT(OUT) :: ntext
311
312 !GF
313 ! INTEGER ID(0:100,2)
314 parameter(npatma=512)
315 INTEGER(mpi) :: id(0:npatma,2)
316 ! end GF
317 LOGICAL :: start ! for case conversion
318 CHARACTER (LEN=26) :: chu
319 CHARACTER (LEN=26) :: chl
320 INTEGER(mpi) :: nj(0:255)
321 SAVE
322 DATA chu/'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
323 DATA chl/'abcdefghijklmnopqrstuvwxyz'/
324 DATA start/.true./
325 DATA nj/256*0/
326 ! ...
327 IF(start) THEN
328 start=.false.
329 DO j=0,255
330 nj(j)=j
331 END DO
332 DO i=1,26
333 nj(ichar(chl(i:i)))=ichar(chu(i:i))
334 END DO
335 END IF
336 ! ...
337 matint=0
338 ntext=0
339 DO i=1,len(text) ! find indices ITA...ITB
340 IF(text(i:i) /= ' ') GO TO 10
341 END DO
342 GO TO 15
34310 ita=i
344 DO i=ita,len(text)
345 IF(text(i:i) /= ' ') itb=i
346 END DO
347 ntext=itb-ita+1 ! number of charcaters in TEXT
348
34915 npat=0
350 DO i=1,len(pat) ! find indices IPA...IPB
351 IF(pat(i:i) /= ' ') GO TO 20
352 END DO
353 RETURN
35420 ipa=i
355 DO i=ipa,len(pat)
356 IF(pat(i:i) /= ' ') ipb=i
357 END DO
358 npat=ipb-ipa+1
359 !GF IF(NPAT.GT.100) STOP 'MATINT: string PAT too long! '
360 IF(npat > npatma) THEN
361 WRITE(*,*) 'too long PAT (', pat,'):', npat, ' >', npatma
362 CALL peend(34,'Aborted, pattern string too long')
363 stop 'MATINT: string PAT too long! '
364 END IF
365 !GF end
366 id(0,1)=0
367 DO i=0,npat
368 id(i,2)=i
369 END DO
370 jot=2
371
372 DO j=1,ntext
373 jot=3-jot
374 jt=j+ita-1
375 jc=nj(ichar(text(jt:jt)))
376 DO i=1,npat
377 ip=i+ipa-1
378 ideq=id(i-1,3-jot)
379 ic=nj(ichar(pat(ip:ip)))
380 IF(ic /= jc) ideq=ideq+1
381 id(i,jot)=min(ideq,id(i,3-jot)+1,id(i-1,jot)+1)
382 END DO
383 matint=max(matint,npat-id(npat,jot))
384 END DO
matint
integer(mpi) function matint(pat, text, npat, ntext)
Approximate string matching.
Definition mptext.f90:290
mpdef
Definition of constants.
Definition mpdef.f90:24
mpdef::parameter
integer, parameter parameter
Definition mpdef.f90:34
peend
subroutine peend(icode, cmessage)
Print exit code.
Definition pede.f90:8890

◆ ratext()

subroutine ratext ( character (len=*), intent(in)  text,
integer(mpi), intent(out)  nums,
real(mpd), dimension(*), intent(out)  dnum 
)

Translate text.

Translate TEXT into arrays of double precision numbers DNUMS(NUMS). Text preceeding numbers is TEXT(KEYA:KEYB), if KEYB >= KEYA.

Parameters
[in]texttext
[out]numsnumber of numbers found
[out]dnumarray of numbers found

Definition at line 48 of file mptext.f90.

49 USE mptext
50
51 IMPLICIT NONE
52 INTEGER(mpi) :: i
53 INTEGER(mpi) :: ia
54 INTEGER(mpi) :: ib
55 INTEGER(mpi) :: ic
56 INTEGER(mpi) :: ich
57 INTEGER(mpi) :: icl
58 INTEGER(mpi) :: icode
59 INTEGER(mpi) :: j
60 INTEGER(mpi) :: k
61
62 INTEGER(mpi) :: lent
63 INTEGER(mpi) :: num
64
65 CHARACTER (LEN=*), INTENT(IN) :: text
66 INTEGER(mpi), INTENT(OUT) :: nums
67 REAL(mpd), INTENT(OUT) :: dnum(*)
68
69 INTEGER(mpi) :: last ! last non-blank character
70 INTEGER(mpi), PARAMETER :: ndim=1000
71 INTEGER(mpi), DIMENSION(2,ndim):: icd
72 CHARACTER (LEN=16) :: keywrd
73 CHARACTER (LEN=1) :: ch
74 REAL(mpd) :: dic(ndim)
75 REAL(mpd) :: dumber
76 INTEGER(mpi) :: icdt(ndim)
77 SAVE
78 ! ...
79 nums=0
80 last=0
81 keya=0
82 keyb=0
83 IF(text(1:1) == '*') RETURN
84 num=ichar('0')
85 lent=0
86 last=0
87 DO i=1,len(text) ! find comment and end
88 IF(lent == 0.AND.(text(i:i) == '!'.OR.text(i:i) == '%')) lent=i
89 IF(text(i:i) /= ' ') last=i
90 END DO
91 IF(lent == 0) lent=last+1
92 icd(1,1)=lent
93
94 j=1
95 icdt(1)=0
96 icl=0
97 DO i=1,lent-1
98 ch =text(i:i)
99 ich=ichar(ch)
100 ic=0
101 IF(ch == '.') ic=1
102 IF(ch == '+') ic=2
103 IF(ch == '-') ic=3
104 IF(ch == 'E') ic=4
105 IF(ch == 'D') ic=4
106 IF(ch == 'e') ic=4
107 IF(ch == 'd') ic=4
108 IF(ic > 0) THEN
109 j=j+1
110 icd(1,j)=i
111 icd(2,j)=i
112 icdt(j)=ic
113 ELSE
114 ic=6
115 IF(ich >= num.AND.ich <= num+9) ic=5 ! digit
116 IF(ic /= icl) THEN
117 j=j+1
118 icd(1,j)=i
119 icdt(j)=ic
120 END IF
121 icd(2,j)=i
122 END IF
123 icl=ic ! previous IC
124 END DO
125 icdt(j+1)=0
126
127 DO i=1,j ! define number
128 IF(icdt(i) == 5) THEN
129 dumber=0.0d0
130 DO k=icd(1,i),icd(2,i)
131 dumber=10.0_mpd*dumber+real(ichar(text(k:k))-num,mpd)
132 END DO
133 dic(i)=dumber
134 END IF
135 END DO
136 icdt(j+1)=0
137
138 DO i=2,j ! get dots
139 IF(icdt(i) == 1) THEN
140 icode=0
141 IF(icdt(i-1) == 5.AND.icd(2,i-1)+1 == icd(1,i)) icode=1
142 IF(icdt(i+1) == 5.AND.icd(1,i+1)-1 == icd(2,i)) icode=icode+2
143 IF(icode == 1) THEN ! 123.
144 icd(2,i-1)=icd(2,i)
145 icdt(i)=0
146 ELSE IF(icode == 2) THEN ! .456
147 dic(i)=10.0d0**(icd(1,i+1)-icd(2,i+1)-1)*dic(i+1)
148 icdt(i)=5
149 icd(2,i)=icd(2,i+1)
150 icdt(i+1)=0
151 ELSE IF(icode == 3) THEN ! 123.456
152 dic(i-1)=dic(i-1)+ 10.0d0**(icd(1,i+1)-icd(2,i+1)-1)*dic(i+1)
153 icd(2,i-1)=icd(2,i+1)
154 icdt(i)=0
155 icdt(i+1)=0
156 END IF
157 END IF
158 END DO
159
160 k=1 ! remove blanks, compress
161 DO i=2,j
162 IF(icdt(i) == 6.AND.text(icd(1,i):icd(2,i)) == ' ') icdt(i)=0
163 IF(icdt(i) /= 0) THEN
164 k=k+1
165 icd(1,k)=icd(1,i)
166 icd(2,k)=icd(2,i)
167 icdt(k)=icdt(i)
168 dic(k)=dic(i)
169 END IF
170 END DO
171 j=k
172
173 DO i=2,j-1
174 IF(icdt(i) == 2.OR.icdt(i) == 3) THEN ! +-
175 IF(icdt(i+1) == 5) THEN
176 icd(1,i+1)=icd(1,i)
177 IF(icdt(i) == 3) dic(i+1)=-dic(i+1)
178 icdt(i)=0
179 END IF
180 END IF
181 END DO
182
183 k=1 ! compress
184 DO i=2,j
185 IF(icdt(i) == 6.AND.text(icd(1,i):icd(2,i)) == ' ') icdt(i)=0
186 IF(icdt(i) /= 0) THEN
187 k=k+1
188 icd(1,k)=icd(1,i)
189 icd(2,k)=icd(2,i)
190 icdt(k)=icdt(i)
191 dic(k)=dic(i)
192 END IF
193 END DO
194 j=k
195
196 DO i=2,j-1
197 IF(icdt(i) == 4) THEN ! E or D
198 IF(icdt(i-1) == 5.AND.icdt(i+1) == 5) THEN
199 icd(2,i-1)=icd(2,i+1)
200 dic(i-1)=dic(i-1)*10.0d0**dic(i+1)
201 icdt(i)=0
202 icdt(i+1)=0
203 END IF
204 END IF
205 END DO
206
207 nums=0 ! compress
208 DO i=1,j
209 IF(icdt(i) == 5) THEN
210 nums=nums+1
211 icd(1,nums)=icd(1,i)
212 icd(2,nums)=icd(2,i)
213 dnum(nums)=dic(i)
214 END IF
215 END DO
216
217 keywrd=' ' ! assemble keyword
218 ia=0
219 ib=-1
220 DO i=1,icd(1,1)-1
221 IF(ia == 0.AND.text(i:i) /= ' ') ia=i
222 IF(text(i:i) /= ' ') ib=i
223 END DO
224 IF(ib >= 0) keywrd=text(ia:ib)
225 keya=ia
226 keyb=max(0,ib)
mptext
Keyword position.
Definition mptext.f90:29
mptext::keyb
integer(mpi) keyb
end (position) of keyword
Definition mptext.f90:35
mptext::keya
integer(mpi) keya
start (position) of keyword
Definition mptext.f90:34

◆ rltext()

subroutine rltext ( character (len=*), intent(in)  text,
integer(mpi), intent(out)  ia,
integer(mpi), intent(out)  ib,
integer(mpi), intent(out)  nab 
)

Analyse text range.

Parameters
[in]texttext
[out]iaindex of first non-blank character, or =1
[out]ibindex of last non-blank character, or =0 - comment excluded
[out]nabindex of last non-blank character (=0 for blank text)

Definition at line 236 of file mptext.f90.

237 USE mpdef
238
239 IMPLICIT NONE
240 INTEGER(mpi) :: i
241 INTEGER(mpi) :: lim
242
243 CHARACTER (LEN=*), INTENT(IN) :: text
244 INTEGER(mpi), INTENT(OUT) :: ia
245 INTEGER(mpi), INTENT(OUT) :: ib
246 INTEGER(mpi), INTENT(OUT) :: nab
247
248 SAVE
249 ! ...
250 ia=0
251 ib=0
252 nab=0
253 lim=0
254 DO i=1,len(text)
255 IF(text(i:i) /= ' ') nab=i
256 IF((i == 1.AND.text(1:1) == '*').OR.text(i:i) == '!') THEN
257 IF(lim == 0) lim=i
258 END IF
259 END DO
260 IF(lim == 0) THEN
261 lim=nab
262 ELSE
263 lim=lim-1
264 END IF
265 DO i=1,lim
266 IF(ia == 0.AND.text(i:i) /= ' ') ia=i
267 IF(text(i:i) /= ' ') ib=i
268 END DO