c     Copyright 2012 Leon van Dommelen.  This software is made available
c     under the GNU Public License version 3.



      subroutine openw(filnam,iunit)

c     Open a file for writing.

c     Note that according to the Fortran 77 standard, the default
c     status='unknown' is "processor dependent", whatever that means,
c     while status='new' demands that the file does not exist.

      implicit none

c input:

c     file to open
      character*(*) filnam

c     unit to open it on
      integer iunit

c local:

c     whether the file exists
      logical exists

c executable:

c     see whether the file exists
      inquire(file=filnam,exist=exists,err=10)
      goto 20
 10   call fatal2('Disk error looking for file ',filnam)
 20   if(.not.exists)goto 100

c     delete the existing file
      open(iunit,file=filnam,status='old',err=30)
      goto 40
 30   call fatal2('Unable to access old file ',filnam)
 40   continue
      close(iunit,status='delete',err=50)
      goto 60
 50   call fatal2('Unable to replace old file ',filnam)
 60   continue

c     open the new file
 100  open(iunit,file=filnam,status='new',err=110)
      goto 120
 110  call fatal2('Unable to create file ',filnam)
 120  continue

      return
      end



      subroutine openru(filnam,iunit)

c     Open a file for unformatted reading.

      implicit none

c input:

c     file to open
      character*(*) filnam

c     unit to open it on
      integer iunit

c local:

c     whether the file exists
      logical exists

c executable:

c     see whether the file exists
      inquire(file=filnam,exist=exists,err=10)
      goto 20
 10   call fatal2('Disk error looking for file ',filnam)
 20   if(.not.exists)call fatal2('File not found: ',filnam)

c     open it
      open(iunit,file=filnam,status='old',form='unformatted',err=30)
      goto 40
 30   call fatal2('Unable to open file ',filnam)
 40   continue

      return
      end



      subroutine openwu(filnam,iunit)

c     Open a file for unformatted writing.

c     Note that according to the Fortran 77 standard, the default
c     status='unknown' is "processor dependent", whatever that means,
c     while status='new' demands that the file does not exist.

      implicit none

c input:

c     file to open
      character*(*) filnam

c     unit to open it on
      integer iunit

c local:

c     whether the file exists
      logical exists

c executable:

c     see whether the file exists
      inquire(file=filnam,exist=exists,err=10)
      goto 20
 10   call fatal2('Disk error looking for file ',filnam)
 20   if(.not.exists)goto 100

c     delete the existing file
      open(iunit,file=filnam,status='old',err=30)
      goto 40
 30   call fatal2('Unable to access old file ',filnam)
 40   continue
      close(iunit,status='delete',err=50)
      goto 60
 50   call fatal2('Unable to replace old file ',filnam)
 60   continue

c     open the new file
 100  open(iunit,file=filnam,status='new',form='unformatted',err=110)
      goto 120
 110  call fatal2('Unable to create file ',filnam)
 120  continue

      return
      end



      subroutine closu(iunit,filnam)

c     Close unit iunit.

      implicit none

c input:

c     unit to close
      integer iunit

c     file name open on it
      character*(*) filnam

c executable:


c     close the file
      close(iunit,err=10)
      goto 20
 10   call fatal2('Disk error closing file ',filnam)
 20   continue

      return
      end



      subroutine readfu(fil,fillt,iunit,bufdim,bufmax,bufchr,term)

c     Reads a line of file fil into buffer bufchr using unformatted I/O.

c     It can handle only one file.

c     The file must have been opened with 'openru(fil(1:fillt),iunit)'

      implicit none

c input:

c     name of file to read
      character*(*) fil
      integer fillt

c     I/O unit to use
      integer iunit

c     declared buffer size
      integer bufdim

c output:

c     actual buffer size
      integer bufmax

c     buffer
      character*1 bufchr(bufdim)

c     line terminator (0: EOF, 1: LF, 2: CRLF)
      integer term

c common

c     input file encoding and backslash escape
      integer enc,besc
c     utf-8 bom
      character*3 bom
      common/cmenc/enc,besc,bom

c local:

c     unicode character numbers reserved range and limit
      integer ucresb,ucrese
      parameter (ucresb=55296,ucrese=57343)

c     initial line terminator
      integer term0
      data term0/0/
      save term0

c     unicode character number
      integer ucno
c     second UTF-16 16 bit integer
      integer int2

c     utf-8 character
      character*4 utf8
      integer utf8l,utf8i
      save utf8,utf8l,utf8i
      data utf8l/0/,utf8i/0/

c     file header string
      character*3 head

c     read character
      character*1 chr,chr2

c executable:

c     generic format
    1 format(a,a)

c     initialize the buffer size
   10 bufmax=0

c     read the next character
  100 if(utf8i.ge.utf8l)call getchr(iunit,chr,*800,*910)

c     case of no UTF-16 encoding (yet)
      if(enc.le.0 .or. utf8i.lt.utf8l)then

c        next utf-8 character
         if(utf8i.lt.utf8l)then
            utf8i=utf8i+1
            chr=utf8(utf8i:utf8i)
         endif

c        put the character in the buffer
         bufmax=bufmax+1
         if(bufmax.gt.bufdim)call fatal2(
     &    'File is too big to process: ',fil(1:fillt))
         bufchr(bufmax)=chr

c        perform BOM checks
         if(enc.eq.0 .and. bufmax.le.3)then
            head(bufmax:bufmax)=chr
c           check for utf-16
            if(bufmax.eq.2)then
c              check for utf-16be
               if(head(1:2).eq.char(254)//char(255))then
                  print1,' ** Warning: UTF-16BE file: ',fil(1:fillt)
                  write(3,1,err=930)
     &             ' ** Warning: UTF-16BE file: ',fil(1:fillt)
                  print*
                  write(3,*,err=930)
                  call savbuf(3,bom)
                  enc=1
                  goto 10
               endif
c              check for utf-16le
               if(head(1:2).eq.char(255)//char(254))then
                  print1,' ** Warning: UTF-16LE file: ',fil(1:fillt)
                  write(3,1,err=930)
     &             ' ** Warning: UTF-16LE file: ',fil(1:fillt)
                  print*
                  write(3,*,err=930)
                  call savbuf(3,bom)
                  enc=2
                  goto 10
               endif
c           check for utf-8
            else if(bufmax.eq.3)then
c              check for utf-8 BOM
               if(head(1:3).eq.bom)then
                  print1,' ** Warning: UTF-8 BOM in ',fil(1:fillt)
                  write(3,1,err=930)
     &             ' ** Warning: UTF-8 BOM in ',fil(1:fillt)
                  print*
                  write(3,*,err=930)
                  call savbuf(3,bom)
                  enc=-2
                  goto 10
               endif
               enc=-1
            endif
         endif

c     case of UTF-16 encoding
      else

c        get the second utf-16 byte
         call getchr(iunit,chr2,*920,*910)
c        compute the character number integer
         if(enc.eq.1)then
            ucno=ichar(chr)*256+ichar(chr2)
         else
            ucno=ichar(chr2)*256+ichar(chr)
         endif
c        if in the reserved range we need the second int
         if(ucno.ge.ucresb .and. ucno.le.ucrese)then
c           bad if not a valid first int
            if(ucno.ge.56320)
     &       call fatal2('Bad UTF-16 first int in ',fil(1:fillt))
c           get the second utf-16 pair of bytes
            call getchr(iunit,chr,*920,*910)
            call getchr(iunit,chr2,*920,*910)
c           set the second int
            if(enc.eq.1)then
               int2=ichar(chr)*256+ichar(chr2)
            else
               int2=ichar(chr2)*256+ichar(chr)
            endif
c           check that this is indeed a second int
            if(int2.lt.56320 .or. int2.gt.ucrese)
     &       call fatal2('Bad UTF-16 second int in ',fil(1:fillt))
c           find the number
            ucno=(ucno-ucresb)*1024+(int2-56320)+65536
         endif
c        convert to utf-8
         call wutf8(ucno,utf8l,utf8)
         utf8i=0
         goto 100

      endif

c     on linefeed exit
      if(chr.eq.char(10))then
c        find the line terminator
         term=1
         if(bufmax.gt.1)then
            if(bufchr(bufmax-1).eq.char(13))term=2
         endif
c        set encoding if not done yet
         if(enc.eq.0)enc=-1
c        set the initial terminator if not done yet
         if(term0.eq.0)term0=term
         if(term.ne.term0)call fatal2(
     &    'Mix of Unix and DOS newlines in ',fil(1:fillt))
         return
      endif

c     next character
      goto 100

c     close the file
 800  call closu(iunit,fil(1:fillt))
c     mark as EOF
      term=0
c     done
      return

c     errors
  910 call  fatal2('Error reading file ',fil(1:fillt))
  920 call  fatal2('Incomplete UTF-16 character ends ',fil(1:fillt))
  930 call  fatal('Error writing to log file')
      end



      subroutine readcv(fil,fillt,iunit,cs,cq,coladd,
     & bufdim,bufmax,bufadd,fldlt,bufchr,term)

c     Reads a line of CSV-formatted file fil into buffer bufchr using
c     unformatted I/O.

c     It can handle only one file.

c     The file must have been opened with 'openru(fil(1:fillt),iunit)'

c     Note on CSV files as created by Microsoft Excel (2019 version):
c     - No spaces before or after the commas (Microsoft does not eat
c       them on reading a csv file either, apparently).
c     - Columns are double-quoted if they contain double quotes or
c       commas or newlines as entered with Alt+Enter.
c     - Double quotes inside the columns are doubled (but do not count
c       on it with stupid LibreOffice in the first column).
c     - Newline inside the columns is entered as LF, nor CRLF like row
c       ends (but do not count on it).
c     - The final row ends in CRLF (but do not count on it; Canvas uses
c       a bare LF).

c     If you look at the specs logically, an empty line in a CSV file
c     still contains one empty column.  (Columns can be terminated by
c     either a comma-like separator, or by end of line/file.  So there
c     is always at least one column in the input lines, by definition.)
c     However, a completely empty line ended by end-of-file should be
c     ignored.

c     https://www.loc.gov/preservation/digital/formats/fdd/fdd000323.shtml
c     https://tools.ietf.org/html/rfc4180

      implicit none

c input:

c     name of file to read
      character*(*) fil
      integer fillt

c     I/O unit to use
      integer iunit

c     separator character and quote character (cs must be writable)
      character*1 cs,cq

c     number of a new column to be added to the buffer (1: first, 0: last)
      integer coladd

c     declared buffer size
      integer bufdim

c output:

c     actual buffer size
      integer bufmax

c     offset of the new column to be added in the buffer
c     (if bufadd is 0, the added column must end in cs, else start with it)
      integer bufadd
c     length of the field ending in bufadd
      integer fldlt

c     buffer
      character*1 bufchr(bufdim)

c     line terminator (0: EOF, 1: LF, 2: CRLF)
      integer term

c common

c     input file encoding and backslash escape
      integer enc,besc
c     utf-8 bom
      character*3 bom
      common/cmenc/enc,besc,bom

c local:

c     unicode character numbers reserved range and limit
      integer ucresb,ucrese
      parameter (ucresb=55296,ucrese=57343)

c     initial line terminator
      integer term0
      data term0/0/
      save term0

c     whether we have issued a warning for the blackboard bug
      integer warnbb
      data warnbb/0/
      save warnbb

c     whether we have issued a warning for CRLF inside a field
      integer warncl
      data warncl/0/
      save warncl

c     unicode character number
      integer ucno
c     second UTF-16 16 bit integer
      integer int2

c     utf-8 character
      character*4 utf8
      integer utf8l,utf8i
      save utf8,utf8l,utf8i
      data utf8l/0/,utf8i/0/

c     number of columns in the file
      integer colmax
      data colmax/0/
      save colmax

c     number of columns read
      integer colcnt

c     buffer offset of the current column
      integer bufofc

c     whether we are in a quoted string
c     0: no
c     1: yes
c     2: yes, must have a [cq,] cs, CR, LF, or EOF next
c     3: yes, must have LF next
      integer inquot

c     whether the character is escaped
      integer escapd

c     read character
      character*1 chr,chr2

c     file header string
      character*9 head

c     index
      integer i

c executable:

c     generic format
    1 format(a,a,a)

c     check column to find
      if(coladd.lt.0)call fatal('readcv: bad number of column to find')

c     initialize the buffer offset to add the desired column
   10 bufadd=-1
      if(coladd.eq.1)then
         bufadd=0
         fldlt=0
      endif

c     initialize the count of read columns
      colcnt=0

c     initialize the offset of the current column
      bufofc=0

c     initialize as not being in a quoted string
      inquot=0

c     initialize as not being escaped
      escapd=0

c     initialize the number of characters read
      bufmax=0

c     read the next character
 100  if(utf8i.ge.utf8l)call getchr(iunit,chr,*800,*910)

c     case of no UTF-16 encoding (yet)
      if(enc.le.0 .or. utf8i.lt.utf8l)then

c        next utf-8 character
         if(utf8i.lt.utf8l)then
            utf8i=utf8i+1
            chr=utf8(utf8i:utf8i)
         endif

c        put the character in the buffer
         bufmax=bufmax+1
         if(bufmax.gt.bufdim)call fatal2(
     &    'Bad quoting or row is too big to process in ',fil(1:fillt))
         bufchr(bufmax)=chr

c        read header bytes
         if(term0.eq.0 .and. bufmax.le.9)head(bufmax:bufmax)=chr

c        handle escaping
         if(besc.ge.0)then
            if(escapd.ne.0)then
               chr=char(besc)
               escapd=0
            else
               if(ichar(chr).eq.besc)escapd=1
            endif
         endif

c        perform BOM checks
         if(enc.eq.0 .and. bufmax.le.3)then
c           check for utf-16
            if(bufmax.eq.2)then
c              check for utf-16be
               if(head(1:2).eq.char(254)//char(255))then
                  print1,' ** Warning: UTF-16BE file: ',fil(1:fillt)
                  write(3,1,err=930)
     &             ' ** Warning: UTF-16BE file: ',fil(1:fillt)
                  print*
                  write(3,*,err=930)
                  call savbuf(3,bom)
                  enc=1
                  goto 10
               endif
c              check for utf-16le
               if(head(1:2).eq.char(255)//char(254))then
                  print1,' ** Warning: UTF-16LE file: ',fil(1:fillt)
                  write(3,1,err=930)
     &             ' ** Warning: UTF-16LE file: ',fil(1:fillt)
                  print*
                  write(3,*,err=930)
                  call savbuf(3,bom)
                  enc=2
                  goto 10
               endif
c           check for utf-8
            else if(bufmax.eq.3)then
c              check for utf-8 BOM
               if(head(1:3).eq.bom)then
                  print1,' ** Warning: UTF-8 BOM in ',fil(1:fillt)
                  write(3,1,err=930)
     &             ' ** Warning: UTF-8 BOM in ',fil(1:fillt)
                  print*
                  write(3,*,err=930)
                  call savbuf(3,bom)
                  enc=-2
                  goto 10
               endif
               enc=-1
            endif
         endif

c     case of UTF-16 encoding
      else

c        get the second utf-16 byte
         call getchr(iunit,chr2,*920,*910)
c        compute the character number integer
         if(enc.eq.1)then
            ucno=ichar(chr)*256+ichar(chr2)
         else
            ucno=ichar(chr2)*256+ichar(chr)
         endif
c        if in the reserved range we need the second int
         if(ucno.ge.ucresb .and. ucno.le.ucrese)then
c           bad if not a valid first int
            if(ucno.ge.56320)
     &       call fatal2('Bad UTF-16 first int in ',fil(1:fillt))
c           get the second utf-16 pair of bytes
            call getchr(iunit,chr,*920,*910)
            call getchr(iunit,chr2,*920,*910)
c           set the second int
            if(enc.eq.1)then
               int2=ichar(chr)*256+ichar(chr2)
            else
               int2=ichar(chr2)*256+ichar(chr)
            endif
c           check that this is indeed a second int
            if(int2.lt.56320 .or. int2.gt.ucrese)
     &       call fatal2('Bad UTF-16 second int in ',fil(1:fillt))
c           find the number
            ucno=(ucno-ucresb)*1024+(int2-56320)+65536
         endif
c        convert to utf-8
         call wutf8(ucno,utf8l,utf8)
         utf8i=0
         goto 100

      endif

c     handle linefeed
      if(chr.eq.char(10))then
         if(inquot.eq.0 .or. inquot.eq.2 .or. inquot.eq.3)then
c           no longer quoted
            inquot=0
c           set the terminator
            term=1
            if(bufmax.gt.1)then
               if(bufchr(bufmax-1).eq.char(13))term=2
            endif
c           set encoding if not done yet
            if(enc.eq.0)enc=-1
c           set the initial terminator if not done yet and check the line
            if(term0.eq.0)then
               term0=term
               if(term.eq.1)then
                  print1,
     &             ' ** WARNING: Unix, not Microsoft, CSV file: ',
     &             fil(1:fillt)
                  write(3,1,err=930)
     &             ' ** WARNING: Unix, not Microsoft, CSV file: ',
     &             fil(1:fillt)
                  print*
                  write(3,*,err=930)
               endif
c              check for a "sep=CHR" line
               i=0
               if(bufmax.eq.7+term)then
                  if(head(1:1).eq.'"' .and. head(7:7).eq.'"')i=1
               endif
               if(bufmax.eq.5+2*i+term)then
                  if(head(4+i:4+i).eq.'=' .and.
     &             (head(1+i:1+i).eq.'S'.or.head(1+i:1+i).eq.'s') .and.
     &             (head(2+i:2+i).eq.'E'.or.head(2+i:2+i).eq.'e') .and.
     &             (head(3+i:3+i).eq.'P'.or.head(3+i:3+i).eq.'p'))then
                     call savbuf(bufmax,head)
                     print1,
     &                ' ** Warning: CSV field separator set to "',cs,'"'
                     write(3,1,err=930)
     &                ' ** Warning: CSV field separator set to "',cs,'"'
                     print*
                     write(3,*,err=930)
                     cs=head(5+i:5+i)
                     goto 10
                  endif
               endif
            endif
            if(term.ne.term0)call fatal2(
     &       'Mix of Unix and DOS newlines in ',fil(1:fillt))
c           end of the last column
            colcnt=colcnt+1
            if(colmax.le.0)colmax=colcnt
            if(colcnt.ne.colmax)then
               if(colcnt.eq.colmax+1 .and.
     &          bufchr(max(1,bufmax-term)).eq.cs)then
                  if(warnbb.eq.0)then
                     print1,' ** Warning: Blackboard Bug: ',
     &                'Additional separator at the end of the line!'
                     write(3,1,err=930)' ** Warning: Blackboard Bug: ',
     &                'Additional separator at the end of the line!'
                     print*
                     write(3,*,err=930)
                     warnbb=1
                  endif
                  bufchr(bufmax-term)=bufchr(bufmax-term+1)
                  if(term.eq.2)bufchr(bufmax-1)=bufchr(bufmax)
                  bufmax=bufmax-1
                  colcnt=colcnt-1
               else
                  call fatal2(
     &             'Variable number of columns in ',fil(1:fillt))
               endif
            endif
c           set bufadd if appropriate
            if(bufadd.lt.0)then
               if(coladd.ne.0 .and. colcnt.ne.coladd-1)call fatal2(
     &          'Not enough columns in ',fil(1:fillt))
               bufadd=bufmax-term
               fldlt=bufadd-bufofc
            endif
            return
         endif
c        since the linefeed is quoted, it does not do anything
         if(bufchr(bufmax-1).eq.char(13))then
            if(warncl.eq.0)then
               print1,
     &          ' ** WARNING: CRLF instead of LF inside a column of ',
     &          fil(1:fillt)
               write(3,1,err=930)
     &          ' ** WARNING: CRLF instead of LF inside a column of ',
     &          fil(1:fillt)
               print*
               write(3,*,err=930)
               warncl=1
            endif
         endif
         goto 100
      endif
      if(inquot.eq.3)call fatal2(
     & 'Bad quoting (terminated before bare CR) in ',fil(1:fillt))

c     handle carriage return
      if(chr.eq.char(13))then
         if(inquot.eq.2)inquot=3
         goto 100
      endif

c     handle the separator
      if(chr.eq.cs)then
         if(inquot.eq.0 .or. inquot.eq.2)then
c           no longer quoted
            inquot=0
c           end of column
            colcnt=colcnt+1
c           set bufadd if appropriate
            if(bufadd.lt.0 .and. coladd.ne.0)then
               if(colcnt.eq.coladd-1)then
                  bufadd=bufmax-1
                  fldlt=bufadd-bufofc
               endif
            endif
c           update the field offset
            bufofc=bufmax
         endif
         goto 100
      endif

c     handle quote
      if(chr.eq.cq)then
c        check the quoting status
         if(inquot.eq.0)then
c           quoting must be started immediately or microsoft won't eat it
            if(bufmax.gt.1)then
               if(bufchr(bufmax-1).ne.cs)call fatal2(
     &          'Bad quoting (started too late) in ',fil(1:fillt))
            endif
c           mark as being inside a quoted string
            inquot=1
         else if(inquot.eq.1)then
c           mark as finding a quote while reading a quoted string
            inquot=2
         else
c           for inquot=2, a second quote is not allowed in backslash escaping
            if(besc.ge.0)call fatal2(
     &       'Bad quoting (terminated before a quote) in ',fil(1:fillt))
c           otherwise a doubled quote inside a quoted string does nothing
            inquot=1
         endif
         goto 100
      endif

c     handle other characters
      if(inquot.eq.2)call fatal2(
     & 'Bad quoting (terminated too early) in ',fil(1:fillt))
      goto 100

c     handle eof
  800 if(inquot.eq.1)call fatal2(
     & 'File ended inside a quoted string: ',fil(1:fillt))
      if(inquot.eq.3)call fatal2(
     & 'Bad quoting (terminated before CR EOF) in ',fil(1:fillt))
c     no longer quoted
      inquot=0
c     mark as end of file
      term=0
c     if a nil line, ignore it
      if(bufmax.eq.0)return
c     end of the last column
      colcnt=colcnt+1
      if(colmax.le.0)colmax=colcnt
      if(colcnt.ne.colmax)then
         if(colcnt.eq.colmax+1 .and. bufchr(max(1,bufmax)).eq.cs)then
            if(warnbb.eq.0)then
               print1,' ** Warning: ',
     &          'Additional separator at the end of file!'
               write(3,1,err=930)' ** Warning: ',
     &          'Additional separator at the end of file!'
               print*
               write(3,*,err=930)
               warnbb=1
            endif
            bufmax=bufmax-1
            colcnt=colcnt-1
         else
            call fatal2('Variable number of columns in ',fil(1:fillt))
         endif
      endif
c     set bufadd if appropriate
      if(bufadd.lt.0)then
         if(coladd.ne.0 .and. colcnt.ne.coladd-1)call fatal2(
     &    'Not enough columns in ',fil(1:fillt))
         bufadd=bufmax
         fldlt=bufadd-bufofc
      endif

c     done
      return

c     errors
  910 call  fatal2('Error reading file ',fil(1:fillt))
  920 call  fatal2('Incomplete UTF-16 character ends ',fil(1:fillt))
  930 call  fatal('Error writing to log file')
      end



      subroutine csvfnd(bufdim,bufmax,bufchr,term,cs,cq,colfnd,
     & fndlt,fnd,fldlt,bufnxt,colnum)

c     Finds a field in CSV-formatted line bufchr.

c     Assumes that the form of the line is as accepted by readcv.

      implicit none

c input:

c     declared buffer size
      integer bufdim

c     actual buffer size
      integer bufmax

c     buffer
      character*1 bufchr(bufdim)

c     line terminator (0: EOF, 1: LF, 2: CRLF)
      integer term

c     separator character and quote character
      character*1 cs,cq

c     column number to find (1: first, 0: last)
      integer colfnd

c input/output:

c     if fndlt >= 0 (decoded) contents of the field to find at or beyond colfnd
c                   fnd may contain a trailing * wildcard
c     if fndlt = -1 do not worry about the field contents
c     if fndlt = -9 return the field as fnd(1:fndlt), truncated as needed
      integer fndlt
      character*(*) fnd

c output:

c     length of the found field [bufnxt-fldlt:bufnxt-1] or -1 if not found
      integer fldlt

c     offset of the next field (actually existing or not) or -1 if not found
      integer bufnxt

c     column ending at bufnxt-1 or 0 if not found
      integer colnum

c common

c     input file encoding and backslash escape
      integer enc,besc
c     utf-8 bom
      character*3 bom
      common/cmenc/enc,besc,bom

c local:

c     whether there is a trailing * in fnd (0: no, 1: yes)
      integer star

c     whether we are in a quoted string
      integer inquot

c     available length in fnd if used as output
      integer lenfnd

c     length decrease for the decoded field
      integer ltdec

c     read character
      character*1 chr

c     character index and offset
      integer i,i2

c executable:

c     check the input line
      if(bufmax-term.lt.0)call fatal('csvfnd: Nonexisting line')

c     check colfnd
      if(colfnd.lt.0)call fatal('csvfnd: Bad column to find')

c     check the length of the field contents to find or found
      lenfnd=len(fnd)
      star=0
      if(fndlt.ne.-1)then
         if(fndlt.ge.0)then
            if(fndlt.gt.lenfnd)
     &       call fatal('csvfnd: Bad contents to find')
            if(fndlt.gt.0)then
               if(fnd(fndlt:fndlt).eq.'*')star=1
            endif
         else if(fndlt.ne.-9)then
            call fatal('csvfnd: Bad value for fndlt')
         endif
      endif

c     initialize bufnxt
      bufnxt=0

c     initialize colnum
      colnum=0

c     return in shame if no field left
   10 if(bufnxt.gt.bufmax-term)then
         fldlt=-1
         bufnxt=-1
         colnum=0
         return
      endif

c     initialize the field length
      fldlt=0
      ltdec=0

c     initialize as not being in a quoted string
      inquot=0

c     look at the next character
  100 bufnxt=bufnxt+1
      if(bufnxt.gt.bufmax-term)then
         if(inquot.ne.0 .and. inquot.ne.2)
     &    call fatal('Program bug 1 in csvfnd or readcv')
         goto 200
      endif

c     check the next character
      chr=bufchr(bufnxt)

c     check for the separator
      if(chr.eq.cs)then
         if(inquot.eq.0 .or. inquot.eq.2)goto 200
      endif

c     one more field character
      fldlt=fldlt+1

c     check for escaping
      if(besc.ge.0)then
         if(chr.eq.char(besc))then
            bufnxt=bufnxt+1
            if(bufnxt.gt.bufmax-term)
     &       call fatal('Program bug 2 in csvfnd or readcv')
            fldlt=fldlt+1
            ltdec=ltdec+1
         endif
      endif

c     check for the quote character
      if(chr.eq.cq)then
         if(inquot.eq.0)then
            if(fldlt.ne.1)
     &       call fatal('Program bug 3 in csvfnd or readcv')
            inquot=1
            ltdec=2
         else if(inquot.eq.1)then
            inquot=2
         else if(inquot.eq.2)then
            if(besc.ge.0)
     &       call fatal('Program bug 4 in csvfnd or readcv')
            inquot=1
            ltdec=ltdec+1
         endif
         goto 100
      endif

c     abort if a final quote is not at field end
      if(inquot.eq.2)call fatal('Program bug 5 in csvfnd or readcv')

c     otherwise the character is just a character of the field
      goto 100

c     see whether we are done or repeat
  200 continue

c     next column
      colnum=colnum+1

c     if we did not yet reach colfnd, repeat
      if(colfnd.gt.0 .and. colnum.lt.colfnd)goto 10
      if(colfnd.eq.0 .and. bufnxt.le.bufmax-term)goto 10

c     if fndlt is -1, we are done
      if(fndlt.eq.-1)return

c     otherwise, if fndlt >= 0, check the decoded field contents
      if(fndlt.ge.0)then
         if(star.eq.0 .and. fndlt.ne.fldlt-ltdec)goto 10
         if(star.eq.1 .and. fndlt-star.gt.fldlt-ltdec)goto 10
         if(fndlt-star.eq.0)return
         i2=bufnxt-fldlt-1
         if(bufchr(i2+1).eq.cq)i2=i2+1
         do 250 i=1,fndlt-star
            i2=i2+1
            if(besc.ge.0)then
               if(ichar(bufchr(i2)).eq.besc)i2=i2+1
            else
               if(bufchr(i2).eq.cq)i2=i2+1
            endif
            if(bufchr(i2).ne.fnd(i:i))goto 10
  250    continue
c     otherwise, if fndlt = -9, return the decoded trimmed field contents
      else
         fndlt=min(fldlt-ltdec,lenfnd)
         i2=bufnxt-fldlt-1
         if(bufchr(i2+1).eq.cq)i2=i2+1
         do 260 i=1,fndlt
            i2=i2+1
            if(besc.ge.0)then
               if(ichar(bufchr(i2)).eq.besc)i2=i2+1
            else
               if(bufchr(i2).eq.cq)i2=i2+1
            endif
            fnd(i:i)=bufchr(i2)
  260    continue
      endif

c     done
      return
      end



      subroutine savbuf(bufmax,bufchr)

c     Adds buffer bufchr to buffer savchr.

      implicit none

c common

c     saved buffer data
      integer savdim
      parameter (savdim=200000)
      integer savmax
      character*1 savchr(savdim)
      common/cmsav/savmax,savchr

c input

c     buffer string size
      integer bufmax
c     buffer string
      character*1 bufchr(*)

c local:

c     buffer position
      integer buf

c executable:

c     nothing to do if bufmax is zero
      if(bufmax.le.0)return

c     check storage
      if(savmax+bufmax.gt.savdim)
     & call fatal('Program Error: savbuf: Out of storage')

c     copy to storage
      do 100 buf=1,bufmax
         savchr(savmax+buf)=bufchr(buf)
  100 continue

c     increment savemax
      savmax=savmax+bufmax

      return
      end



      subroutine writfu(fil,fillt,iunit,bufmax,bufchr)

c     Writes buffer bufchr to file fil(1:fillt) using unformatted I/O.

c     If bufmax is -1, the file is closed.

      implicit none

c input:

c     name of file to write
      character*(*) fil
      integer fillt

c     unit to use
      integer iunit

c     buffer string size
      integer bufmax
c     buffer string
      character*1 bufchr(*)

c common

c     input file encoding and backslash escape
      integer enc,besc
c     utf-8 bom
      character*3 bom
      common/cmenc/enc,besc,bom

c local:

c     utf-16 character
      character*4 utf16
      integer utf16l,utf16i

c     unicode character number
      integer ucno

c     buffer position
      integer buf

c executable:

c     nothing to do if bufmax is zero
      if(bufmax.le.0)return

c     write the buffer
      if(enc.le.0)then

c        write as is
         do 100 buf=1,bufmax
            call putchr(iunit,bufchr(buf),*910)
  100    continue

      else

c        convert to utf-16
         buf=0
  200    call rutf8(bufchr,bufmax,buf,ucno)
         if(ucno.eq.-1)goto 290
         if(ucno.lt.0)call fatal('Program error 1 in writfu')
         call wutf16(enc-1,ucno,utf16l,utf16)
         do 250 utf16i=1,utf16l
            call putchr(iunit,utf16(utf16i:utf16i),*910)
  250    continue
         goto 200
  290    continue

      endif

c     close the file if bufmax is -1
      if(bufmax.eq.-1)close(iunit,err=920)

c     done
      return

c     errors
  910 call fatal2('Error writing to file ',fil(1:fillt))
  920 call fatal2('Error finishing file ',fil(1:fillt))
      end



      subroutine inttos(int,cint,cintl)

c     Convert an integer to a string.

      implicit none

c input:

c     integer to show
      integer int

c     integer as string
      character*(*) cint
      integer cintl

c local:

c     printed integer as string
      character*12 ci

c executable

c     print the integer
      write(ci,10,err=90)int
 10   format(i12)

c     trim leading and trailing spaces
      cintl=12
      call trimlt(ci,cintl)

c     copy it to output
      if(cintl.gt.len(cint))goto 90
      cint=ci(1:cintl)
      return

c     error
 90   cint='************'
      cintl=min(12,len(cint))
      return
      end



      subroutine trimlt(str,strlt)

c     Trim leading and trailing spaces and tabs from string str(1:strlt).

      implicit none

c input/output:

c     string to trim
      character*(*) str
      integer strlt

c local:

c     character number
      integer ichr

c     character indices
      integer i,i1

c executable

c     done if nil
      if(strlt.le.0)return

c     find number of leading whitespace characters
      i1=0
      do 100 i=1,strlt
         ichr=ichar(str(i:i))
         if(ichr.gt.32)goto 110
         i1=i
  100 continue
  110 continue

c     remove them
      if(i1.gt.0)then
         strlt=strlt-i1
         if(strlt.le.0)return
         do 120 i=1,strlt
            str(i:i)=str(i+i1:i+i1)
  120    continue
         str(strlt+1:strlt+i1)=' '
      endif

c     remove trailing spaces and tabs
      do 200 i=strlt,1,-1
         ichr=ichar(str(i:i))
         if(ichr.gt.32)goto 210
         str(i:i)=' '
         strlt=i-1
  200 continue
  210 continue

      return
      end



      subroutine wutf8(ucno,strmax,strchr)

c     Write a UTF-8 character to string strchr.

      implicit none

c input

c     character number to write
      integer ucno

c output

c     number of characters in string
      integer strmax

c     string
      character*4 strchr

c local

c     unicode character numbers reserved range and limit
      integer ucresb,ucrese,uclim
      parameter (ucresb=55296,ucrese=57343,uclim=1114111)

c     local value of ucno
      integer ichr
c     subparts of ichr
      integer i1,i2,i3

c     temporary
      integer itemp

c executable

c     copy the number to a local variable
      ichr=ucno

c     check validity
      if((ichr.ge.ucresb .and. ichr.le.ucrese) .or.
     & ichr.lt.0 .or. ichr.gt.uclim)call fatal('Program error in wutf8')

c     standard ASCII
      if(ichr.le.127)then
         strmax=1
         strchr(1:1)=char(ichr)
         return
      endif

c     put the last 6 bits in i1 and remove them from ichr
      itemp=ichr/64
      i1=ichr-itemp*64
      ichr=itemp
c     a two-byte string can hold 5 more bits, i.e. up to 31
      if(ichr.le.31)then
         strmax=2
         strchr(1:1)=char(ichr+192)
         strchr(2:2)=char(i1+128)
         return
      endif

c     put the next 6 bits in i2 and remove them from ichr
      itemp=ichr/64
      i2=ichr-itemp*64
      ichr=itemp
c     a three-byte string can hold 4 more bits, i.e. up to 15
      if(ichr.le.15)then
         strmax=3
         strchr(1:1)=char(ichr+224)
         strchr(2:2)=char(i2+128)
         strchr(3:3)=char(i1+128)
         return
      endif

c     put the next 6 bits in i3 and remove them from ichr
      itemp=ichr/64
      i3=ichr-itemp*64
      ichr=itemp
c     a four-byte string can hold 3 more bits, i.e. up to 7
      if(ichr.gt.7)call fatal('Program error 2 in wutf8')
      strmax=4
      strchr(1:1)=char(ichr+240)
      strchr(2:2)=char(i3+128)
      strchr(3:3)=char(i2+128)
      strchr(4:4)=char(i1+128)
      return
      end



      subroutine wutf16(le,ucno,strmax,strchr)

c     Write a UTF-16 character to string strchr.

      implicit none

c input

c     0 for big endian byte order of the 16 bit ints, nonzero for little endian
      integer le

c     character number to write
      integer ucno

c output

c     number of characters in string
      integer strmax

c     string
      character*4 strchr

c local

c     unicode character numbers reserved range and limit
      integer ucresb,ucrese,uclim
      parameter (ucresb=55296,ucrese=57343,uclim=1114111)

c     the two 16 bit integers
      integer int1,int2

c     the two bytes of a 16 bit number
      integer byt1,byt2

c     local value of ucno
      integer ichr

c executable

c     copy the number to a local variable
      ichr=ucno

c     check validity
      if(ichr.lt.0 .or. ichr.gt.uclim .or.
     & (ichr.ge.ucresb .and. ichr.le.ucrese))call fatal(
     & 'Program error 1 in wutf16')

c     jump for 4-byte case
      if(ichr.ge.65536)goto 500

c     find the two byte numbers
      byt1=ichr/256
      byt2=ichr-byt1*256

c     put them in
      if(le.eq.0)then
         strchr(1:1)=char(byt1)
         strchr(2:2)=char(byt2)
      else
         strchr(1:1)=char(byt2)
         strchr(2:2)=char(byt1)
      endif
      strmax=2

c     done
      return

c     4 byte case
 500  continue

c     subtract the 2-byte range
      ichr=ichr-65536

c     take apart into two ten bit integers
      int1=ichr/1024
      int2=ichr-int1*1024

c     put int1 plus offset into two bytes
      int1=int1+ucresb
      byt1=int1/256
      byt2=int1-byt1*256
      if(le.eq.0)then
         strchr(1:1)=char(byt1)
         strchr(2:2)=char(byt2)
      else
         strchr(1:1)=char(byt2)
         strchr(2:2)=char(byt1)
      endif

c     put int2 plus offset into two bytes
      int2=int2+56320
      byt1=int2/256
      byt2=int2-byt1*256
      if(le.eq.0)then
         strchr(3:3)=char(byt1)
         strchr(4:4)=char(byt2)
      else
         strchr(3:3)=char(byt2)
         strchr(4:4)=char(byt1)
      endif
      strmax=4

c     jump back
      return
      end


      subroutine rutf8(linchr,linmax,i,ucno)

c     Copyright 2012 Leon van Dommelen.  This software is made available
c     under the GNU Public License version 3.

c     Tries to read a valid UTF-8 character behind current position i.
c     If successful, advances i to the end of that character and returns
c     ucno as the Unicode number.  If not, leaves i as is and sets ucno
c     to -1 if the reason is end of line, or to -2 if the reason is an
c     invalid UTF-8 character.

c     avoid typos
      implicit none

c input

c     line being read and its length
      character*1 linchr(*)
      integer linmax

c input/output

c     last read position in the line
      integer i

c output

c     unicode number or -1 for none or -2 for a bad character
      integer ucno

c local

c     unicode character numbers reserved range and limit
      integer ucresb,ucrese,uclim
      parameter (ucresb=55296,ucrese=57343,uclim=1114111)
c     unicode number and lowest valid value
      integer uc,uclo
c     number of trailing bytes
      integer bytes
c     byte index
      integer byt

c     read character number
      integer ichr

c executable

c     done if at end of line
      if(i.ge.linmax)then
         ucno=-1
         return
      endif

c     look at the next byte
      ichr=ichar(linchr(i+1))
      if(ichr.lt.128)then
         ucno=ichr
         i=i+1
         return
      endif

c     be pessimistic
      ucno=-2

c     read header byte
      if(ichr.lt.194)return

c     process header byte
      uc=ichr-192
      if(uc.lt.32)then
         bytes=1
         uclo=128
      else
         uc=uc-32
         if(uc.lt.16)then
            bytes=2
            uclo=2048
         else
            uc=uc-16
            if(uc.lt.8)then
               bytes=3
               uclo=65536
            else
               return
            endif
         endif
      endif

c     return if there are not enough bytes
      if(i+1+bytes.gt.linmax)return

c     get the value
      do 100 byt=1,bytes
         ichr=ichar(linchr(i+1+byt))
         if(ichr.lt.128 .or. ichr.ge.192)return
         uc=uc*64+(ichr-128)
  100 continue
      if(uc.lt.uclo .or. uc.gt.uclim)return
      if(uc.ge.ucresb .and. uc.le.ucrese)return

c     all OK
      ucno=uc
      i=i+1+bytes

c     done
      return
      end
