00001
00002 c
00003 c Copyright (c) 1986,1987,1988,1989,1990,1991,1992,1993,
00004 c by Steve McMillan, Drexel University, Philadelphia, PA.
00005 c
00006 c All rights reserved.
00007 c
00008 c Redistribution and use in source and binary forms are permitted
00009 c provided that the above copyright notice and this paragraph are
00010 c duplicated in all such forms and that any documentation,
00011 c advertising materials, and other materials related to such
00012 c distribution and use acknowledge that the software was developed
00013 c by the author named above.
00014 c
00015 c THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
00016 c IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
00017 c WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
00018 c
00019
00020 c------------------------------------------------------------------------
00021 c
00022 c String-decomposition and reading.
00023 c
00024 c Contents: gettokens - split a string into pieces
00025 c readrtoken - read a real number from a string
00026 c readitoken - read an integer from a string
00027 c
00028 c------------------------------------------------------------------------
00029
00030 subroutine gettokens(string,token,ntoken)
00031 save
00032 c
00033 c Extract a list of separate "words" from a given string.
00034 c
00035 character*(*) string,token(1)
00036 c
00037 parameter (NSEPMAX = 3)
00038 character*1 sep(NSEPMAX),c
00039 c
00040 common /token delim/ nsep
00041 c
00042 c Present delimiters are tab, space, and comma, in that order.
00043 c Thus, setting nsep = 3 allows all three; nsep = 2 allows
00044 c "whitespace" only; nsep = 1 allows only tabs.
00045 c
00046 data sep/' ',' ',','/nsep/3/
00047 c
00048 ntoken = 0
00049 itoken = 0
00050 do 100 i=1,len(string)+1
00051 if (i.le.len(string)) then
00052 c = string(i:i)
00053 else
00054 c = ' '
00055 end if
00056 c
00057 c Is this character a separator?
00058 c
00059 do 25 k=1,nsep
00060 if (c.eq.sep(k)) go to 50
00061 25 continue
00062 c
00063 if (itoken.eq.0) istart = i
00064 itoken = 1
00065 go to 100
00066 c
00067 50 if (itoken.eq.1) then
00068 ntoken = ntoken + 1
00069 token(ntoken) = string(istart:i-1)
00070 end if
00071 itoken = 0
00072 100 continue
00073 c
00074 end
00075
00076
00077 subroutine readrtoken(token,xread,xx)
00078 save
00079 character*(*) token
00080 character*1 per
00081 character*1000 temp
00082 c
00083 common /read_token_stat/ istat
00084 c
00085 c Read a real quantity xread from the specified token, subject
00086 c to certain rules:
00087 c
00088 c = --> do nothing
00089 c number --> use number
00090 c x --> 1
00091 c y --> 2
00092 c z --> 3
00093 c . or * --> use xx
00094 c >number --> use xx, with number as a lower limit
00095 c <number --> use xx, with number as an upper limit
00096 c
00097 c anything else (for now) means "do nothing"
00098 c
00099 c Assume it is OK to tack a period onto the string, following
00100 c the last nonblank character. Note that we should make NO
00101 c assumptions about what follows the digits in the string.
00102 c
00103 c Find the last legal character in the string.
00104 c
00105 do iend=1,len(token)
00106 if (token(iend:iend).le.' ') go to 100
00107 end do
00108 100 iend = iend - 1
00109 c
00110 if (token(1:1).eq.'*'.and.iend.eq.1) token(1:1) = '.'
00111 c
00112 isingledot = 0
00113 if (token(1:1).eq.'.'.and.iend.eq.1) isingledot = 1
00114 if (token(1:1).eq.'-'.and.iend.eq.1) isingledot = 1
00115 c
00116 c Add a trailing period, if necessary (assume < 1000 characters):
00117 c
00118 per = ' '
00119 if (index(token(1:iend),'.').eq.0) per = '.'
00120 c
00121 istat = 0
00122 c
00123 c Trying to read ". " or "- " will get NaN and io = 0...
00124 c
00125 temp = token(1:iend)
00126 if (isingledot.eq.0) then
00127 read(temp(1:iend+1),'(f32.16)',iostat=io)yy
00128 else
00129 io = 1
00130 end if
00131 c
00132 if (io.eq.0) then
00133 xread = yy
00134 else if (token(1:1).eq.'x'.or.token(1:1).eq.'X') then
00135 xread = 1.
00136 else if (token(1:1).eq.'y'.or.token(1:1).eq.'Y') then
00137 xread = 2.
00138 else if (token(1:1).eq.'z'.or.token(1:1).eq.'Z') then
00139 xread = 3.
00140 else if (token(1:1).eq.'=') then
00141 else if (token(1:1).eq.'.') then
00142 xread = xx
00143 else if (token(1:1).eq.'>'.and.iend.gt.2) then
00144 read(temp(2:iend+1),'(f32.16)',iostat=io)yy
00145 if (io.eq.0) xread = max(xx,yy)
00146 istat = io
00147 else if (token(1:1).eq.'<'.and.iend.gt.2) then
00148 read(token(2:iend+1),'(f32.16)',iostat=io)yy
00149 if (io.eq.0) xread = min(xx,yy)
00150 istat = io
00151 else
00152 istat = io
00153 end if
00154 c
00155 end
00156
00157
00158 subroutine readdtoken(token,xread,xx)
00159
00160 c IDENTICAL to readrtoken, but for real*8 xread.
00161
00162 save
00163 character*(*) token
00164 character*1 per
00165 character*1000 temp
00166
00167 real*8 xread,yy
00168 c
00169 common /read_token_stat/ istat
00170 c
00171 c Read a real quantity xread from the specified token, subject
00172 c to certain rules:
00173 c
00174 c = --> do nothing
00175 c number --> use number
00176 c x --> 1
00177 c y --> 2
00178 c z --> 3
00179 c . or * --> use xx
00180 c >number --> use xx, with number as a lower limit
00181 c <number --> use xx, with number as an upper limit
00182 c
00183 c anything else (for now) means "do nothing"
00184 c
00185 c Assume it is OK to tack a period onto the string, following
00186 c the last nonblank character. Note that we should make NO
00187 c assumptions about what follows the digits in the string.
00188 c
00189 c Find the last legal character in the string.
00190 c
00191 do iend=1,len(token)
00192 if (token(iend:iend).le.' ') go to 100
00193 end do
00194 100 iend = iend - 1
00195
00196 if (token(1:1).eq.'*'.and.iend.eq.1) token(1:1) = '.'
00197
00198 isingledot = 0
00199 if (token(1:1).eq.'.'.and.iend.eq.1) isingledot = 1
00200 if (token(1:1).eq.'-'.and.iend.eq.1) isingledot = 1
00201 c
00202 c Add a trailing period, if necessary (assume < 1000 characters):
00203 c
00204 per = ' '
00205 if (index(token(1:iend),'.').eq.0) per = '.'
00206 c
00207 istat = 0
00208 c
00209 c Trying to read ". " or "- " will get NaN and io = 0...
00210 c
00211 temp = token(1:iend)
00212 if (isingledot.eq.0) then
00213 read(temp(1:iend+1),'(f32.16)',iostat=io)yy
00214 else
00215 io = 1
00216 end if
00217 c
00218 if (io.eq.0) then
00219 xread = yy
00220 else if (token(1:1).eq.'x'.or.token(1:1).eq.'X') then
00221 xread = 1.
00222 else if (token(1:1).eq.'y'.or.token(1:1).eq.'Y') then
00223 xread = 2.
00224 else if (token(1:1).eq.'z'.or.token(1:1).eq.'Z') then
00225 xread = 3.
00226 else if (token(1:1).eq.'=') then
00227 else if (token(1:1).eq.'.') then
00228 xread = xx
00229 else if (token(1:1).eq.'>'.and.iend.gt.2) then
00230 read(temp(2:iend+1),'(f32.16)',iostat=io)yy
00231 if (io.eq.0) xread = max(xx,yy)
00232 istat = io
00233 else if (token(1:1).eq.'<'.and.iend.gt.2) then
00234 read(token(2:iend+1),'(f32.16)',iostat=io)yy
00235 if (io.eq.0) xread = min(xx,yy)
00236 istat = io
00237 else
00238 istat = io
00239 end if
00240 c
00241 end
00242
00243
00244 subroutine readitoken(token,iread,ii)
00245 save
00246 character*(*) token
00247 c
00248 c Read an integer quantity iread from the specified token, subject
00249 c to the same rules as for real quantities.
00250 c
00251 call readrtoken(token,xread,float(ii))
00252 iread = nint(xread)
00253 c
00254 end