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 subroutine readcols(lunit,nhead,nread,ix,iy,x,y,z,n,nmax,
00021 & c1,info,iprompt,*)
00022 save
00023 c
00024 c Read data from the specified column(s) of a file. Skip the
00025 c first nhead lines, and read at most min(nread,nmax) lines.
00026 c
00027 dimension x(nmax),y(nmax),z(nmax)
00028 character*1 c1
00029 c
00030 c Read data in double precision, to allow offset if necessary.
00031 c
00032 real*8 dummy(1000)
00033 c
00034 character*4000 line
00035 character*40 column(200)
00036 c
00037 common /data offset/ delx,dely,delz,facx,facy,facz
00038 c
00039 common /file input/ inpmode
00040 c
00041 character*1 comment
00042 common /file comment/ icomment,comment
00043 c
00044 data icomment/0/comment/' '/
00045 c
00046 n=0
00047 i1 = min(ix,iy)
00048 i2 = max(ix,iy)
00049 c
00050 c Skip the header lines.
00051 c
00052 rewind lunit
00053 do 10 i=1,nhead
00054 10 read(lunit,*,err=120,end=120)
00055 c
00056 110 if (n.ge.nmax) then
00057 if (info.eq.1) then
00058 call devoff
00059 if (iprompt.eq.1) write(6,101)n
00060 101 format('Warning: maximum # of points (',i6,
00061 & ') reached.')
00062 end if
00063 n = n + 1
00064 else
00065 n = n + 1
00066 c
00067 c Note that the first line is read the hard way to check
00068 c that the number of columns is OK.
00069 c
00070 if (n.gt.1.and.inpmode.eq.0) then
00071 if (i2.gt.i1) then
00072 read(lunit,*,err=120,end=120)(dummy(i),i=1,i2)
00073 x(n) = facx * (dummy(i1) - delx)
00074 y(n) = facy * (dummy(i2) - dely)
00075 else
00076 read(lunit,*,err=120,end=120)(dummy(i),i=1,i1)
00077 if (c1.eq.'x') then
00078 x(n) = facx * (dummy(i1) - delx)
00079 else if (c1.eq.'y') then
00080 y(n) = facy * (dummy(i1) - dely)
00081 else if (c1.eq.'z') then
00082 z(n) = facz * (dummy(i1) - delz)
00083 else
00084 return 1
00085 end if
00086 end if
00087 else
00088 c
00089 c (MUCH) slower, but surer...
00090 c
00091 read(lunit,'(a)',err=120,end=120)line
00092 c
00093 c Locate the end of the string (' ').
00094 c This will fail if the intercolumn spacing is too great...
00095 c
00096 nl = index(line,' ') - 1
00097 c
00098 if (nl.le.0) then
00099 n = n - 1
00100 go to 118
00101 end if
00102 c
00103 c Check for comments.
00104 c
00105 if (icomment.ne.0.and.line(1:1).eq.comment) then
00106 n = n - 1
00107 go to 118
00108 end if
00109 c
00110 c Split line into columns.
00111 c
00112 call gettokens(line(1:nl),column,nc)
00113 if (nc.lt.max(i1,i2)) then
00114 if (iprompt.eq.1) write(6,'(a,i3,a)')
00115 & 'Data file has only ',nc,' columns'
00116 return 1
00117 end if
00118 c
00119 if (i2.gt.i1) then
00120 call readdtoken(column(i1),dummy,dummy)
00121 x(n) = dummy(1)
00122 call readdtoken(column(i2),dummy,dummy)
00123 y(n) = dummy(1)
00124 x(n) = facx * (x(n) - delx)
00125 y(n) = facy * (y(n) - dely)
00126 else
00127 if (c1.eq.'x') then
00128 call readrtoken(column(i1),x(n),x(n))
00129 x(n) = facx * (x(n) - delx)
00130 else if (c1.eq.'y') then
00131 call readrtoken(column(i1),y(n),y(n))
00132 y(n) = facy * (y(n) - dely)
00133 else if (c1.eq.'z') then
00134 call readrtoken(column(i1),z(n),z(n))
00135 z(n) = facz * (z(n) - delz)
00136 else
00137 return 1
00138 end if
00139 end if
00140 c
00141 if (iprompt.eq.1.and.100*(n/100).eq.n)
00142 & write(6,*)n,' lines read...'
00143 c
00144 end if
00145 c
00146 118 if (n.lt.nread) go to 110
00147 n = n + 1
00148 c
00149 end if
00150 c
00151 120 n = n - 1
00152 c
00153 if (info.eq.1) then
00154 call devoff
00155 if (iprompt.eq.1) write(6,125)n
00156 125 format(i6,' points')
00157 end if
00158 c
00159 if (ix.gt.iy.and.n.gt.0) call swap(x,y,n)
00160 c
00161 end
