1!
2! Copyright (C) 1996-2016	The SIESTA group
3!  This file is distributed under the terms of the
4!  GNU General Public License: see COPYING in the top directory
5!  or http://www.gnu.org/copyleft/gpl.txt.
6! See Docs/Contributors.txt for a list of contributors.
7!
8
9      subroutine parse_vibra( line, nn, lc, names, nv, values,
10     .                  ni, integers, nr, reals )
11
12c **********************************************************************
13c Extracts the names and numbers in an input line.
14c Written by J.M.Soler. August 1997.
15c ********* Input ******************************************************
16c character line*(*) : Input string.
17c ********* Output *****************************************************
18c integer   nn          : Number of names present in line
19c integer   lc(0:*)     : Last character of each name in names string.
20c                         Notice that first index is 0.
21c character names*(*)   : Non-number strings present in line
22c integer   nv          : Number of values present in line
23c real*8    values(*)   : Numbers present in line (integer or real)
24c integer   ni          : Number of integers present in line
25c integer   integers(*) : Integer numbers present in line
26c integer   nr          : Number of reals present in line
27c real*8    reals(*)    : Real numbers present in line
28c ********* Behaviour **************************************************
29c Names are returned consecutively in string names. Name i may be
30c   extracted as name = names(lc(i-1)+1:lc(i))
31c Names and numbers in line may be separated by blanks (including tabs),
32c or commas. Other characters are considered part of names or numbers,
33c not separators.
34c Names are any non-number strings present in the line.
35c Integers are numbers without a dot.
36c Real numbers are i.e. 5.0, 2., -.25, +1.d6, 2.E-3
37c Apostrophes enclosing strings are removed in output names.
38c Double apostrophes inside a name are left unchanged.
39c The size of arrays names, values, integers and reals must be long
40c   enough to contain all instances present in line. No check is made.
41c **********************************************************************
42      implicit          none
43      integer           integers(*), lc(0:*), ni, nn, nr, nv
44      character         line*(*), names*(*)
45      double precision  reals(*), values(*)
46c **********************************************************************
47
48c     Internal variables
49      integer maxl
50      parameter ( maxl = 200 )
51      logical    isblank(0:maxl+1), isdigit(0:maxl+1), isdot(0:maxl+1),
52     .           isexp(0:maxl+1), isinteger, issign(0:maxl+1),
53     .           isother(0:maxl+1), isreal, opened
54      character  c
55      character fmtstr*10
56      integer    i, i1, i2, ic, iw, ll, ndot, nexp, nsign
57
58c     Check line length
59      ll = len(line)
60      if (ll.gt.maxl) stop 'parse: parameter maxl too small'
61
62c     Clasify line characters
63      isblank(0) = .true.
64      isdigit(0) = .false.
65      isdot(0)   = .false.
66      isexp(0)   = .false.
67      issign(0)  = .false.
68      isother(0) = .false.
69      do i = 1,ll
70        c = line(i:i)
71        ic = ichar(c)
72        isblank(i) = (c.eq.' ' .or. c.eq.',' .or. ic.eq.9)
73        isdigit(i) = (ic.ge.48 .and. ic.le.57)
74        isdot(i)   = (c.eq.'.')
75        isexp(i)   = (c.eq.'e' .or. c.eq.'E' .or.
76     .                c.eq.'d' .or. c.eq.'D')
77        issign(i)  = (c.eq.'+' .or. c.eq.'-')
78        isother(i) = (.not.isblank(i) .and. .not.isdigit(i) .and.
79     .                .not.isdot(i)   .and. .not.isexp(i)   .and.
80     .                .not.issign(i))
81      enddo
82      isblank(ll+1) = .true.
83      isdigit(ll+1) = .false.
84      isdot(ll+1)   = .false.
85      isexp(ll+1)   = .false.
86      issign(ll+1)  = .false.
87      isother(ll+1) = .false.
88
89c     Initialize number of instances
90      nn = 0
91      nv = 0
92      ni = 0
93      nr = 0
94      lc(0) = 0
95
96c     Iterate on 'words'
97      i2 = 0
98      do iw = 1,ll
99
100c       Locate first character of word
101        do i1 = i2+1,ll
102          if (.not.isblank(i1)) goto 10
103        enddo
104          return
105   10   continue
106
107c       Locate last character of word, while checking if
108c       a pair of enclosing apostrophes is 'open'
109        opened = .false.
110        do i2 = i1,ll
111          if (line(i2:i2).eq.'''') opened = .not.opened
112          if (.not.opened .and. isblank(i2+1)) goto 15
113        enddo
114   15   continue
115
116c       Find if word is a number
117        isinteger = .true.
118        isreal    = .true.
119        ndot  = 0
120        nexp  = 0
121        nsign = 0
122        do i = i1,i2
123
124c         Non-allowed characters for any number (label 30 is loop exit)
125          if (isother(i)) then
126            isinteger = .false.
127            isreal    = .false.
128            goto 30
129          endif
130
131c         Allowed for integer and real numbers (label 20 is loop cont)
132          if (isdigit(i)) goto 20
133          if (issign(i) .and. isblank(i-1) .and.
134     .        .not.isblank(i+1)) goto 20
135
136          isinteger = .false.
137
138c         Allowed only for real number
139          if (isdot(i) .and.
140     .        (isblank(i-1) .or. isdigit(i-1) .or. issign(i-1)) .and.
141     .        (isblank(i+1) .or. isdigit(i+1) .or. isexp(i+1))) goto 20
142          if (isexp(i) .and.
143     .        (isdigit(i-1) .or. isdot(i-1)) .and.
144     .        (isdigit(i+1) .or. issign(i+1))) goto 20
145          if (issign(i) .and. isexp(i-1) .and. isdigit(i+1)) goto 20
146
147          isreal = .false.
148          goto 30
149
150   20     continue
151          if (isdot(i))  ndot  = ndot  + 1
152          if (isexp(i))  nexp  = nexp  + 1
153          if (issign(i)) nsign = nsign + 1
154        enddo
155
156c       Check that there are not too many dots and so on
157        if (ndot.gt.1)  isreal = .false.
158        if (nexp.gt.1)  isreal = .false.
159        if (nsign.gt.2) isreal = .false.
160
161   30   continue
162
163c       Some printout for debugging
164*       write(6,'(a,2i4,3x,a10,2l3)')
165*    .    'parse: i1, i2, word, isinteger, isreal =',
166*    .    i1, i2, line(i1:i2), isinteger, isreal
167
168c       Add word to proper class
169        if (isinteger) then
170          ni = ni + 1
171          nv = nv + 1
172          write(fmtstr,9000) i2-i1+1
173 9000     format('(i',i2.2,')')
174          read(line(i1:i2),fmt=fmtstr) integers(ni)
175          values(nv) = integers(ni)
176        elseif (isreal) then
177          nr = nr + 1
178          nv = nv + 1
179          write(fmtstr,9020) i2-i1+1
180 9020     format('(g',i2.2,'.0)')
181          read(line(i1:i2),fmt=fmtstr) reals(nr)
182          values(nv) = reals(nr)
183        else
184          nn = nn + 1
185c         Remove enclosing apostrophes if present
186          if (line(i1:i1).eq.'''' .and. line(i2:i2).eq.'''') then
187            lc(nn) = lc(nn-1) + i2 - i1 - 1
188            names(lc(nn-1)+1:lc(nn)) = line(i1+1:i2-1)
189          else
190            lc(nn) = lc(nn-1) + i2 - i1 + 1
191            names(lc(nn-1)+1:lc(nn)) = line(i1:i2)
192          endif
193        endif
194      enddo
195
196      end
197
198
199
200
201
202