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