new version of TecsServer and conversion utility M.Z.
This commit is contained in:
cvs
735
tecs/conv.f
Normal file
735
tecs/conv.f
Normal file
@@ -0,0 +1,735 @@
|
||||
program conv
|
||||
|
||||
include 'conv.inc'
|
||||
|
||||
logical init
|
||||
integer i,j,l,lin,iostat
|
||||
character*128 line
|
||||
character*2048 input
|
||||
|
||||
data lun/0/,pos/0/,nlist/0/
|
||||
|
||||
path=' '
|
||||
lp=0
|
||||
verbose=.false.
|
||||
call sys_get_cmdpar(input, l)
|
||||
if (input .eq. ' ') then
|
||||
verbose=.true.
|
||||
print '(a,$)',
|
||||
1' File(s) (separated with space): '
|
||||
read(*,'(a)',end=99) input
|
||||
if (input .eq. ' ') goto 99
|
||||
endif
|
||||
i=index(input, '-p')
|
||||
if (i .ne. 0) then ! first path option valid from start
|
||||
j=index(input(i+1:), ' ')
|
||||
call str_trim(path, input(i+2:i+j), lp)
|
||||
endif
|
||||
i=0
|
||||
do while (input(i+1:) .ne. ' ')
|
||||
j=index(input(i+1:), ' ')
|
||||
if (j .le. 1) then
|
||||
i=i+1
|
||||
else if (input(i+1:i+2) .eq. '-p') then
|
||||
call str_trim(path, input(i+3:i+j), lp)
|
||||
i=i+j
|
||||
else if (input(i+1:i+1) .eq. '-') then
|
||||
print *,'unknown option: ',input(i+1:i+j)
|
||||
i=i+j
|
||||
else
|
||||
call str_trim(file, input(i+1:i+j), lf)
|
||||
i=i+j
|
||||
if (verbose) print *
|
||||
open(1,name=file(1:lf),status='old',iostat=iostat)
|
||||
if (iostat .ne. 0) then
|
||||
if (verbose) then
|
||||
print *,'can not open ',file(1:lf)
|
||||
print "(x,60('-'))"
|
||||
endif
|
||||
nlist=nlist+1
|
||||
list(nlist)='can not open '//file(1:lf)
|
||||
else
|
||||
lin=0
|
||||
do
|
||||
call lsc_errinit(1) ! 1=lun
|
||||
call lsc_convert_table(lin)
|
||||
if (lin .lt. 0) goto 19
|
||||
if (verbose) print "(x,60('-'))"
|
||||
enddo
|
||||
19 continue
|
||||
close(1)
|
||||
endif
|
||||
endif
|
||||
enddo
|
||||
|
||||
do i=1,nlist
|
||||
call str_trim(list(i), list(i), l)
|
||||
print *,list(i)(1:l)
|
||||
enddo
|
||||
|
||||
99 continue
|
||||
end
|
||||
|
||||
|
||||
subroutine pack(line, l, x, y, offset, m)
|
||||
character line*(*)
|
||||
integer l, offset, m
|
||||
real x(m), y(m)
|
||||
|
||||
integer j,p
|
||||
|
||||
p=0
|
||||
do j=1,m
|
||||
call str_append(line, p, '#0,')
|
||||
call cvt_real_str(line(p+1:), l, 1.0*(offset+j), 1, 0, 6, 3)
|
||||
p=p+l
|
||||
call str_append(line, p, ':')
|
||||
call cvt_real_str(line(p+1:), l, x(j), 1, 0, 6, 3)
|
||||
p=p+l
|
||||
call str_append(line, p, ',')
|
||||
call cvt_real_str(line(p+1:), l, y(j), 1, 0, 6, 3)
|
||||
p=p+l
|
||||
call str_append(line, p, ';')
|
||||
enddo
|
||||
line(p:p)=' '
|
||||
l=p-1
|
||||
end
|
||||
|
||||
|
||||
subroutine lsc_convert_table(lin)
|
||||
|
||||
implicit none
|
||||
include 'conv.inc'
|
||||
|
||||
integer lin
|
||||
|
||||
integer ntypes,nvolts, namps
|
||||
parameter (ntypes=12, nvolts=12, namps=12)
|
||||
integer np
|
||||
|
||||
real x(200), y(200), ex, ey
|
||||
integer i,j,l,p,li,crc,form,iostat
|
||||
|
||||
character name*15, sensor*10, header*64, line*128, old*128, intype*16
|
||||
character crcmp*3, filnam*128, cfgdir*128
|
||||
character c40*40/'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ$+-&'/
|
||||
integer unit, stype, excit, irange, coef, iunit, stdcurv
|
||||
! codes
|
||||
character types(0:ntypes)*12/'Special','Si Diode','GaAlAs Diode'
|
||||
1 ,'Pt250 Ohm','Pt500 Ohm','Pt2500 Ohm','RhFe','C-Glass'
|
||||
1 ,'Cernox','RuOx','Ge','Cap','Tc'/
|
||||
integer nunits
|
||||
parameter (nunits=3)
|
||||
character units(nunits)*5/'mV','V','Ohm'/
|
||||
integer nexcits
|
||||
parameter (nexcits=12)
|
||||
character excits(0:nexcits)*8/'Off','30nA','100nA','300nA','1uA','3uA'
|
||||
1 ,'10uA','30uA','100uA','300uA','1mA','10mV','1mV'/
|
||||
integer nforms
|
||||
parameter (nforms=5)
|
||||
character forms(nforms)*6/'ill','ill','lin','log','loglog'/
|
||||
|
||||
! default values
|
||||
integer defu(ntypes)/ 1, 1, 2, 2,2, 2, 2, 2, 2, 2, 3, 1/ ! unit
|
||||
integer defe(ntypes)/ 6, 6,10,10,8,10,11,11,11,12, 0, 0/ ! excit
|
||||
integer defr(ntypes)/11,12, 8, 9,8, 8, 4, 4, 4, 1, 1, 6/ ! range
|
||||
integer defc(ntypes)/ 1, 1, 2, 2,2, 2, 1, 1, 1, 1, 2, 2/ ! coef
|
||||
real volts(nvolts)/1E-3,2.5E-3,5E-3,1E-2,2.5E-2,5E-2
|
||||
1 ,1E-1,2.5E-1,5E-1,1E-0,2.5E-0,5E-0/
|
||||
real amps(namps)/3E-8,1E-7,3E-7,1E-6,3E-6,1E-5,3E-5,1E-4,3E-4,1E-3
|
||||
1 ,3E-8,3E-8/ ! minimal values are for voltage excitation
|
||||
integer stdmax
|
||||
parameter (stdmax=10)
|
||||
character*40 stdhdr(stdmax)/
|
||||
1 'DT-470 ,Standard ,2,+475.000E+0,1',
|
||||
1 'DT-500-D ,Standard ,2,+365.000E+0,1',
|
||||
1 'DT-500-E1 ,Standard ,2,+330.000E+0,1',
|
||||
1 'PT-100 ,Standard ,3,+800.000E+0,2',
|
||||
1 'PT-1000 ,Standard ,3,+800.000E+0,2',
|
||||
1 'TYPE K ,Standard ,1,+1645.00E+0,2',
|
||||
1 'TYPE E ,Standard ,1,+1188.50E+0,2',
|
||||
1 'TYPE T ,Standard ,1,+673.000E+0,2',
|
||||
1 'CrAuFe.03%,Standard ,1,+500.000E+0,2',
|
||||
1 'CrAuFe.07%,Standard ,1,+610.000E+0,2'/
|
||||
integer stdtype(stdmax)/1,1,1,4,5,12,12,12,12,12/
|
||||
|
||||
real tlim, range, xmax, ymax, curr, rl
|
||||
|
||||
real x1,x2,xi,y1,y2,yi,sum,sum1,sum2,mum,mum1,mum2,d,at,at1,at2
|
||||
logical eof, first, inverted
|
||||
|
||||
! functions
|
||||
integer lsc_getno
|
||||
external lsc_getno, pack
|
||||
|
||||
first=.true.
|
||||
eof=.false.
|
||||
np=0
|
||||
name=' '
|
||||
sensor=' '
|
||||
unit=0
|
||||
tlim=0
|
||||
stype=0
|
||||
excit=0
|
||||
form=0
|
||||
range=-1.0
|
||||
stdcurv=0
|
||||
1 read(1,'(a)',err=97,end=97) line
|
||||
call str_trim(line, line, l)
|
||||
lin=lin+1
|
||||
call str_first_nonblank(line, i)
|
||||
if (i .eq. 0) goto 1
|
||||
if (line(i:i) .eq. '!') goto 1
|
||||
first=.false.
|
||||
call str_upcase(line(1:l),line(i:l))
|
||||
i=index(line(1:l),'!')
|
||||
if (i .ne. 0) line=line(1:i-1)
|
||||
call str_trim(line(1:l),line(1:l),l)
|
||||
if (line(1:4) .ne. 'CURV') then
|
||||
i=index(line,'=')
|
||||
if (i .eq. 0) then
|
||||
call lsc_error(lin, 'missing "="')
|
||||
goto 1
|
||||
endif
|
||||
if (i .eq. l) then
|
||||
call lsc_error(lin, 'missing value')
|
||||
goto 1
|
||||
endif
|
||||
call str_first_nonblank(line(i+1:l), j)
|
||||
i=i+j
|
||||
if (line(1:4) .eq. 'SENS') then
|
||||
sensor=line(i:l)
|
||||
name=sensor
|
||||
elseif (line(1:4) .eq. 'UNIT') then
|
||||
unit=lsc_getno(units, nunits, line(i:l))
|
||||
if (unit .le. 0) call lsc_error(lin, 'illegal unit')
|
||||
elseif (line(1:4) .eq. 'TLIM') then
|
||||
read(line(i:l),*,err=92,end=92) tlim
|
||||
elseif (line(1:4) .eq. 'TYPE') then
|
||||
stype=lsc_getno(types, ntypes+1, line(i:l))-1
|
||||
if (stype .lt. 0) call lsc_error(lin, 'illegal type')
|
||||
elseif (line(1:4) .eq. 'EXCI') then
|
||||
call str_substitute(line(1:8),line(i:l),' ',char(0))
|
||||
excit=lsc_getno(excits, nexcits, line(1:8))-1
|
||||
if (excit .lt. 0) call lsc_error(lin, 'illegal excitation')
|
||||
elseif (line(1:4) .eq. 'RANG') then
|
||||
read(line(i:l),*,err=93,end=93) range
|
||||
if (range .lt. 0) goto 93
|
||||
elseif (line(1:4) .eq. 'FORM') then
|
||||
form=lsc_getno(forms, nforms, line(i:l))
|
||||
if (form .lt. 3) call lsc_error(lin, 'illegal format')
|
||||
else
|
||||
call lsc_error(lin, 'unknown parameter name')
|
||||
endif
|
||||
goto 1
|
||||
endif
|
||||
if (sensor .eq. ' ') call lsc_error(lin, 'missing sensor name')
|
||||
i=index(line,'=')
|
||||
if (i .ne. 0) then
|
||||
read(line(i+1:l), *, err=2,end=2) stdcurv
|
||||
2 continue
|
||||
if (stdcurv .lt. 0 .or. stdcurv .gt. stdmax) then
|
||||
call lsc_error(lin, 'illegal standard curve no.')
|
||||
goto 101
|
||||
endif
|
||||
if (unit .ne. 0 .or. stype .ne. 0 .or.
|
||||
1 excit .ne. 0 .or. tlim .ne. 0) then
|
||||
if (verbose) then
|
||||
print *,'Warning: all parameters except "sens"'
|
||||
1 ,', "range" and "curv" are ignored',char(7)
|
||||
endif
|
||||
errstat=max(errstat,1)
|
||||
endif
|
||||
line=stdhdr(stdcurv)
|
||||
i=index(line, ',')
|
||||
if (i .eq. 0) goto 96 ! illegal stdhdr
|
||||
j=index(line(i+1:), ',')
|
||||
if (j .eq. 0) goto 96 ! illegal stdhdr
|
||||
|
||||
read(line(i+j+1:), *, err=96, end=96) unit, ymax, coef
|
||||
stype=stdtype(stdcurv)
|
||||
! if (range .lt. 0) then
|
||||
! range=stdrange(stdcurv)
|
||||
! end if
|
||||
xmax=0
|
||||
excit=0
|
||||
tlim=0
|
||||
goto 100
|
||||
endif
|
||||
if (line(5:) .ne. ' ') then
|
||||
call lsc_error(lin, 'missing "="')
|
||||
goto 101
|
||||
end if
|
||||
! user curve
|
||||
if (unit .eq. 0) call lsc_error(lin, 'missing unit')
|
||||
if (stype .eq. 0) then
|
||||
if (excit .le. 0) call lsc_error(lin, 'missing excitation')
|
||||
if (range .lt. 0) call lsc_error(lin, 'missing range')
|
||||
else
|
||||
if (excit .eq. 0) excit=defe(stype)
|
||||
endif
|
||||
3 np=np+1
|
||||
read(1,'(a)',err=98,end=98) line
|
||||
lin=lin+1
|
||||
if (line .eq. ' ') goto 9
|
||||
read(line, *, err=94, end=94) x(np), y(np)
|
||||
goto 3
|
||||
|
||||
|
||||
92 call lsc_error(lin,'illegal tlim')
|
||||
goto 1
|
||||
93 call lsc_error(lin,'illegal range')
|
||||
goto 1
|
||||
94 call lsc_error(lin,'illegal datapoint')
|
||||
goto 101
|
||||
95 call lsc_error(lin,'illegal table no')
|
||||
goto 1
|
||||
96 stop 'internal error: illegal stdhdr'
|
||||
97 if (.not. first) then
|
||||
call lsc_error(lin,'unexpected end of file')
|
||||
endif
|
||||
lin=-1
|
||||
RETURN
|
||||
98 eof=.true.
|
||||
|
||||
9 np=np-1 ! point (np) is not valid
|
||||
|
||||
if (np .lt. 2) call lsc_error(lin+np, 'not enough data points')
|
||||
if (x(np) .lt. x(1)) then ! inverse order
|
||||
j=np
|
||||
do i=1,np/2
|
||||
ex=x(i)
|
||||
ey=y(i)
|
||||
x(i)=x(j)
|
||||
y(i)=y(j)
|
||||
x(j)=ex
|
||||
y(j)=ey
|
||||
j=j-1
|
||||
enddo
|
||||
inverted=.true.
|
||||
else
|
||||
inverted=.false.
|
||||
endif
|
||||
do i=2,np
|
||||
if (x(i) .le. x(i-1)) then
|
||||
j=i
|
||||
if (inverted) j=np-i+1
|
||||
call lsc_error(lin+j, 'table not ordered')
|
||||
goto 101
|
||||
endif
|
||||
enddo
|
||||
xmax=x(np)
|
||||
if (y(np) .lt. y(1)) then
|
||||
coef=1
|
||||
do i=2,np
|
||||
if (y(i) .ge. y(i-1)) then
|
||||
j=i
|
||||
if (inverted) j=np-i+1
|
||||
call lsc_error(lin+j, 'table not ordered')
|
||||
goto 101
|
||||
endif
|
||||
enddo
|
||||
ymax=y(1)
|
||||
else
|
||||
coef=2
|
||||
do i=2,np
|
||||
if (y(i) .le. y(i-1)) then
|
||||
j=i
|
||||
if (inverted) j=np-i+1
|
||||
call lsc_error(lin+j, 'table not ordered')
|
||||
goto 101
|
||||
endif
|
||||
enddo
|
||||
ymax=y(np)
|
||||
endif
|
||||
101 continue
|
||||
do i=1,np
|
||||
if (x(i) .eq. 0.0) then
|
||||
j=i
|
||||
if (inverted) j=np-i+1
|
||||
call lsc_error(lin+j, 'illegal sensor value')
|
||||
endif
|
||||
if (y(i) .le. 0.0) then
|
||||
j=i
|
||||
if (inverted) j=np-i+1
|
||||
call lsc_error(lin+j, 'illegal temperature')
|
||||
endif
|
||||
enddo
|
||||
if (errstat .gt. 1) goto 999
|
||||
|
||||
sum=0
|
||||
sum1=0
|
||||
sum2=0
|
||||
mum=0
|
||||
mum1=0
|
||||
mum2=0
|
||||
do i=2,np-1
|
||||
xi=x(i)
|
||||
x1=x(i-1)
|
||||
x2=x(i+1)
|
||||
yi=log(y(i))
|
||||
y1=y(i-1)
|
||||
y2=y(i+1)
|
||||
d=abs(yi-log(y1+(xi-x1)/(x2-x1)*(y2-y1)))
|
||||
sum=sum+d*d
|
||||
if (d .gt. mum) then
|
||||
mum=d
|
||||
at=y(i)
|
||||
endif
|
||||
xi=log(abs(xi))
|
||||
x1=log(abs(x1))
|
||||
x2=log(abs(x2))
|
||||
d=abs(yi-log(y1+(xi-x1)/(x2-x1)*(y2-y1)))
|
||||
sum1=sum1+d*d
|
||||
if (d .gt. mum1) then
|
||||
mum1=d
|
||||
at1=y(i)
|
||||
endif
|
||||
y1=log(y1)
|
||||
y2=log(y2)
|
||||
d=abs(yi-(y1+(xi-x1)/(x2-x1)*(y2-y1)))
|
||||
sum2=sum2+d*d
|
||||
if (d .gt. mum2) then
|
||||
mum2=d
|
||||
at2=y(i)
|
||||
endif
|
||||
enddo
|
||||
if (np .gt. 2) then
|
||||
sum=sqrt(sum/(np-1))*25
|
||||
sum1=sqrt(sum1/(np-1))*25
|
||||
sum2=sqrt(sum2/(np-1))*25
|
||||
|
||||
if (verbose) then
|
||||
print '(x,a)','Interpolation accuracy mean worst at'
|
||||
print '(13x,a,3(f8.2,a))','linear ',sum, '%',mum *25,'%',at,' K'
|
||||
print '(13x,a,3(f8.2,a))','log/lin ',sum1,'%',mum1*25,'%',at1,' K'
|
||||
print '(13x,a,3(f8.2,a))','log/log ',sum2,'%',mum2*25,'%',at2,' K'
|
||||
endif
|
||||
|
||||
if (unit .eq. 3) then
|
||||
sum1=(sum1/sum)**2+(mum1/mum)**2
|
||||
sum2=(sum2/sum)**2+(mum2/mum)**2
|
||||
if (form .eq. 0 .and. (sum1 .lt. 1.0 .or. sum2 .lt. 1.0)
|
||||
1 .or. form .gt. 3) then
|
||||
if (form .eq. 0 .and. sum2 .lt. sum1 .or. form .eq. 5) then
|
||||
unit=5
|
||||
do i=1,np
|
||||
y(i)=log10(y(i))
|
||||
enddo
|
||||
else
|
||||
unit=4
|
||||
endif
|
||||
do i=1,np
|
||||
x(i)=log10(x(i))
|
||||
enddo
|
||||
endif
|
||||
else
|
||||
if (form .gt. 3 .and. verbose)
|
||||
1 print *,'FORM ignored (not unit Ohm)'
|
||||
endif
|
||||
endif
|
||||
|
||||
100 continue
|
||||
|
||||
if (unit .eq. 1) then ! check for mV / V consistency
|
||||
if (xmax .gt. 990) then
|
||||
unit=2
|
||||
do i=1,np
|
||||
x(i)=x(i)/1000.0
|
||||
enddo
|
||||
endif
|
||||
xmax=xmax/1000.0
|
||||
range=range/1000.0
|
||||
elseif (unit .eq. 2) then
|
||||
if (xmax .lt. 0.5) then
|
||||
unit=1
|
||||
do i=1,np
|
||||
x(i)=x(i)*1000.0
|
||||
enddo
|
||||
endif
|
||||
endif
|
||||
if (range .eq. 0) range=xmax
|
||||
if (tlim .eq. 0 .or. tlim .gt. ymax) tlim=ymax
|
||||
irange=0
|
||||
if (range .gt. 0) then
|
||||
if (unit .ge. 3) then ! Ohm
|
||||
curr=amps(excit)
|
||||
rl=range*curr ! convert Ohm to V
|
||||
if (rl .gt. 5.0) then
|
||||
! print *,'Warning: maximum range exceeded: '
|
||||
! 1 , range,'>',5/curr,' Ohm',char(7)
|
||||
! errstat=max(errstat,1)
|
||||
irange=12
|
||||
endif
|
||||
else
|
||||
rl=range ! V
|
||||
endif
|
||||
if (irange .eq. 0) then
|
||||
if (stype.eq.12) then
|
||||
j=6
|
||||
else
|
||||
j=nvolts
|
||||
end if
|
||||
do i=1,j
|
||||
if (rl .le. volts(i)) then
|
||||
irange=i
|
||||
goto 150
|
||||
endif
|
||||
enddo
|
||||
! print *,'Warning: maximum range exceeded: ', range,' > ',volts(j),' V',char(7)
|
||||
! errstat=max(errstat,1)
|
||||
irange=j
|
||||
150 continue
|
||||
if (excit .eq. 11) then ! 10 mV excit -> min. 10 mV range
|
||||
if (irange .lt. 4) irange=4
|
||||
endif
|
||||
endif
|
||||
else
|
||||
irange=defr(stype)
|
||||
range=xmax
|
||||
endif
|
||||
if (stdcurv.eq.0) then
|
||||
if (unit .ge. 3) then
|
||||
if (range*amps(excit) .gt. volts(irange)) then
|
||||
print *,'Warning: max. range exceeded: '
|
||||
1 ,range,' > ',volts(irange)/amps(excit),' Ohm',char(7)
|
||||
errstat=max(errstat,1)
|
||||
endif
|
||||
else if (range .gt. volts(irange)) then
|
||||
print *,'Warning: max. range exceeded: '
|
||||
1 ,range,' > ',volts(irange), ' V',char(7)
|
||||
errstat=max(errstat,1)
|
||||
endif
|
||||
endif
|
||||
|
||||
if (stype .gt. 0) then
|
||||
if (excit .le. 0) excit=defe(stype)
|
||||
if (irange .eq. 0) irange=defr(stype)
|
||||
endif
|
||||
if (verbose) then
|
||||
print *,'Sensor type: ',types(stype)
|
||||
print *,'Excitation: ',excits(excit)
|
||||
if (unit .eq. 1) then
|
||||
print *,'Sensor Range: ',volts(irange)*1000,' mV'
|
||||
elseif (unit .eq. 2) then
|
||||
print *,'Sensor Range: ',volts(irange),' V'
|
||||
else
|
||||
print *,'Sensor Range: ',volts(irange)/amps(excit),' Ohm'
|
||||
if (unit .eq. 5) then
|
||||
print *,'table double logarithmic'
|
||||
elseif (unit .eq. 4) then
|
||||
print *,'table logarithmic'
|
||||
else
|
||||
print *,'table linear'
|
||||
endif
|
||||
endif
|
||||
if (coef .eq. 1) then
|
||||
print *,'negative characteristic'
|
||||
else
|
||||
print *,'positive characteristic'
|
||||
endif
|
||||
print *
|
||||
endif
|
||||
|
||||
if (stype .eq. 0) then
|
||||
if (unit .ge. 3) then
|
||||
iunit=2
|
||||
else
|
||||
iunit=1
|
||||
endif
|
||||
else
|
||||
if (unit .le. 2) then ! mV / V
|
||||
iunit=1
|
||||
else ! Ohm
|
||||
iunit=2
|
||||
endif
|
||||
if (iunit .ne. defu(stype) .or.
|
||||
1 coef .ne. defc(stype) .or.
|
||||
1 excit .ne. defe(stype) .or.
|
||||
1 irange.ne. defr(stype)) then
|
||||
if (stype .ne. 12) stype=0
|
||||
endif
|
||||
endif
|
||||
|
||||
|
||||
if (stype .eq. 12) then
|
||||
l=5
|
||||
write (line(1:l), '(a,i1)') ',,,,',max(0,irange-5)
|
||||
elseif (stype .eq. 0) then
|
||||
l=14
|
||||
write (line(1:l), '(i2,4(a,i2.0))')
|
||||
1 stype,',',iunit,',',coef,',',excit,',',irange
|
||||
else
|
||||
l=2
|
||||
write(line(1:l), '(i2)') stype
|
||||
endif
|
||||
|
||||
call str_substitute(intype, line(1:l), ' ', char(0))
|
||||
call str_trim(intype, intype, li)
|
||||
|
||||
if (tlim .gt. 1500) tlim=1500
|
||||
if (tlim .lt. 0) tlim=0
|
||||
|
||||
if (stdcurv.eq.0) then
|
||||
! calculate crc of table
|
||||
crc=0
|
||||
do i=1,np
|
||||
call pack(line, l, x(i), y(i), i-1, 1)
|
||||
call str_crc(crc, line(1:l))
|
||||
enddo
|
||||
call str_crc_comp(crc, crcmp)
|
||||
write (header, "(a,x,a,',',a,',',i1,',',f8.3,',',i1)")
|
||||
1 name(1:11), crcmp,sensor,unit,tlim,coef
|
||||
else
|
||||
crc=0
|
||||
header=stdhdr(stdcurv)
|
||||
endif
|
||||
|
||||
! compare with old file
|
||||
call str_trim(filnam, sensor, l)
|
||||
call str_lowcase(filnam, filnam)
|
||||
filnam(l+1:)='.crv'
|
||||
if (path(1:lp) .ne. ' ') then
|
||||
filnam=path(1:lp)//filnam
|
||||
endif
|
||||
open(unit=2, file=filnam, status='old', iostat=iostat)
|
||||
if (iostat .ne. 0) goto 198
|
||||
read(2, '(a)',end=199) old
|
||||
if (old .ne. header) goto 199
|
||||
read(2, '(a)', end=199) old
|
||||
if (old .ne. intype) goto 199
|
||||
if (stdcurv .ne. 0) then
|
||||
write(line, '(a, i2)') '$',stdcurv
|
||||
read(2, '(a)', end=199) old
|
||||
if (line .ne. old) goto 199
|
||||
read(2, '(a)', end=197) old ! goto end (o.k.) if no more line
|
||||
goto 199
|
||||
endif
|
||||
do i=1,np,ncolumn
|
||||
read(2, '(a)', end=199) old
|
||||
call pack(line, l, x(i), y(i), i-1, min(ncolumn,np-i+1))
|
||||
if (line .ne. old) goto 199
|
||||
enddo
|
||||
read(2, '(a)', end=199) old
|
||||
call pack(line, l, 0.0, 0.0, np, 1)
|
||||
if (line .ne. old) goto 199
|
||||
read(2, '(a)', end=197) old ! goto end (o.k.) if no more line
|
||||
goto 199
|
||||
197 close(2)
|
||||
if (verbose) print *,'curve file has not changed: ',filnam
|
||||
goto 200
|
||||
! goto 999
|
||||
|
||||
198 if (verbose) print *,'create new curve file: ',filnam
|
||||
nlist=nlist+1
|
||||
list(nlist)='created '//filnam
|
||||
goto 200
|
||||
|
||||
199 close(2)
|
||||
if (verbose) print *,'modify curve file: ',filnam
|
||||
nlist=nlist+1
|
||||
list(nlist)='modified '//filnam
|
||||
200 continue
|
||||
open(unit=2, file=filnam, status='unknown', iostat=iostat)
|
||||
if (iostat .ne. 0) then
|
||||
call str_trim(filnam, filnam, l)
|
||||
print *,'can not open ',filnam(1:l)
|
||||
nlist=nlist-1
|
||||
lin=-1
|
||||
return
|
||||
endif
|
||||
call str_trim(header, header, l)
|
||||
write(2, '(a)') header(1:l)
|
||||
write(2, '(a)') intype(1:li)
|
||||
if (stdcurv .ne. 0) then
|
||||
write(2, '(a,i2)') '$',stdcurv
|
||||
else
|
||||
do i=1,np,ncolumn
|
||||
call pack(line, l, x(i), y(i), i-1, min(ncolumn,np-i+1))
|
||||
write(2,'(a)') line(1:l)
|
||||
enddo
|
||||
call pack(line, l, 0.0, 0.0, np, 1)
|
||||
write(2,'(a)') line(1:l)
|
||||
endif
|
||||
close(2)
|
||||
999 continue
|
||||
if (errstat .gt. 0) then
|
||||
if (name.eq.' ') name='<unknown>'
|
||||
nlist=nlist+1
|
||||
if (errstat .gt. 1) then
|
||||
list(nlist)='error in '//file(1:lf)//', curve '//name
|
||||
if (verbose) print *,'no curve file written'
|
||||
lin=-1
|
||||
else
|
||||
list(nlist)='warning in '//file(1:lf)//', curve '//name
|
||||
endif
|
||||
endif
|
||||
if (eof) lin=-1
|
||||
return
|
||||
end
|
||||
|
||||
|
||||
integer function lsc_getno(list, n, name)
|
||||
|
||||
integer n
|
||||
character list(n)*(*), name*(*)
|
||||
character str*32
|
||||
|
||||
integer i,l
|
||||
|
||||
call str_trim(name, name, l)
|
||||
l=min(l,len(str))
|
||||
do i=1,n
|
||||
call str_upcase(str(1:l), list(i))
|
||||
if (name(1:l) .eq. str(1:l)) then
|
||||
lsc_getno=i
|
||||
RETURN
|
||||
endif
|
||||
enddo
|
||||
lsc_getno=0
|
||||
end
|
||||
|
||||
|
||||
subroutine lsc_errinit(lunit)
|
||||
|
||||
include 'conv.inc'
|
||||
|
||||
integer lunit
|
||||
|
||||
lun=lunit
|
||||
pos=0
|
||||
errstat=0
|
||||
end
|
||||
|
||||
|
||||
subroutine lsc_error(lin, text)
|
||||
|
||||
include 'conv.inc'
|
||||
|
||||
integer lin
|
||||
character text*(*)
|
||||
|
||||
integer i,l
|
||||
character line*132
|
||||
|
||||
if (pos .eq. 0) then
|
||||
print *
|
||||
endif
|
||||
if (lin .gt. pos) then
|
||||
rewind lun
|
||||
do i=1,lin-1
|
||||
read(lun, '(a)', end=8) line
|
||||
call str_trim(line, line, l)
|
||||
if (i .gt. max(pos,lin-3)) then
|
||||
print '(5x,a)',line(1:l)
|
||||
endif
|
||||
enddo
|
||||
read(lun, '(a)', end=8) line
|
||||
call str_trim(line, line, l)
|
||||
print '(x,2a)','>>> ',line(1:l)
|
||||
8 pos=lin
|
||||
errstat=2
|
||||
endif
|
||||
|
||||
9 print '(x,a)', text
|
||||
end
|
||||
Reference in New Issue
Block a user