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