Module csvfile_module
  Use Iso_Fortran_Env,Only: Iostat_End,Iostat_Eor
  Implicit None
  Private
  !
  ! A CSV file variable.
  !
  Type,Public :: csvfile_t
    Private
    Integer :: unit = -1
    Character(:),Allocatable :: file
    Integer state
    Character decimal,comma,thousands
  Contains
    Procedure at_eof
    Procedure at_eor
    Procedure close
    Procedure next_record
    Procedure open
    Procedure,Private :: readch
    Procedure,Private :: readi8
    Procedure,Private :: readi16
    Procedure,Private :: readi32
    Procedure,Private :: readi64
    Procedure,Private :: readr1
    Procedure,Private :: readr2
    Generic :: read => readi8,readi16,readi32,readi64,readr1,readr2,readch
  End Type
  !
  ! Private types used to create protected constants.
  !
  Type,Private :: open_action_t
    Private
    Integer value
  End Type
  Type,Private :: open_status_t
    Private
    Integer value
  End Type
  !
  ! Public variables.
  !
  Integer,Public :: csv_unit_range_bottom = 10000
  Integer,Public :: csv_unit_range_top = 10500
  !
  ! Public constants: error codes.
  !
  Integer,Public,Parameter :: ioerr_csvfile_no_unit_available = 666000
  Integer,Public,Parameter :: ioerr_csvfile_not_open = 666001
  Integer,Public,Parameter :: ioerr_csvfile_invalid_value = 666002
  Integer,Public,Parameter :: ioerr_csvfile_value_out_of_range = 666003
  Integer,Public,Parameter :: ioerr_csvfile_invalid_specifier_value = 666004
  !
  ! Public constants (of private type): Various OPEN modes.
  !
  Type(open_action_t),Public,Parameter :: csvopen_read = open_action_t(1)
  Type(open_action_t),Public,Parameter :: csvopen_write = open_action_t(2)
  Type(open_action_t),Public,Parameter :: csvopen_readwrite = open_action_t(3)
  !
  Type(open_status_t),Public,Parameter :: csvopen_old = open_status_t(1)
  Type(open_status_t),Public,Parameter :: csvopen_new = open_status_t(2)
  Type(open_status_t),Public,Parameter :: csvopen_replace = open_status_t(3)
  Type(open_status_t),Public,Parameter :: csvopen_unknown = open_status_t(4)
  !
  ! Internal: CSV file state.
  !
  Integer,Parameter :: state_beginning_of_file = 11
  Integer,Parameter :: state_in_record = 12
  Integer,Parameter :: state_eor = 13
  Integer,Parameter :: state_eof = 14
  !
Contains
  !
  ! AT_EOF: Whether we are currently at the end of file in a CSV file.
  !
  Logical Function at_eof(this,iostat,iomsg)
    Class(csvfile_t),Intent(In) :: this
    Integer,Intent(Out),Optional :: iostat
    Character(*),Intent(InOut),Optional :: iomsg
    If (this%unit==-1) Then
      Call ioerr(this,iostat,iomsg,'at_eof',ioerr_csvfile_not_open,'Not open')
      at_eof = .False.
    Else
      at_eof = this%state==state_eof
    End If
  End Function
  !
  ! AT_EOR: Whether we are currently at the end of record in a CSV file.
  !
  Logical Function at_eor(this,iostat,iomsg)
    Class(csvfile_t),Intent(In) :: this
    Integer,Intent(Out),Optional :: iostat
    Character(*),Intent(InOut),Optional :: iomsg
    If (this%unit==-1) Then
      Call ioerr(this,iostat,iomsg,'at_eor',ioerr_csvfile_not_open,'Not open')
      at_eor = .False.
    Else
      at_eor = this%state==state_eor .Or. this%state==state_eof
    End If
  End Function
  !
  ! CLOSE: Close a CSV file.
  !
  Subroutine close(this,iostat,iomsg)
    Class(csvfile_t),Intent(InOut) :: this
    Integer,Intent(Out),Optional :: iostat
    Character(*),Intent(InOut),Optional :: iomsg
    If (this%unit==-1) Then
      Call ioerr(this,iostat,iomsg,'close',ioerr_csvfile_not_open,'Not open')
      Return
    End If
    If (Present(iostat)) Then
      If (Present(iomsg)) Then
        Close(this%unit,Iostat=iostat,Iomsg=iomsg)
      Else
        Close(this%unit,Iostat=iostat)
      End If
    Else
      Close(this%unit)
    End If
    this%unit = -1
  End Subroutine
  !
  ! OPEN: OPEN a CSV file.
  !
  Subroutine open(this,file,action,status,decimal,iostat,iomsg)
    Class(csvfile_t),Intent(InOut) :: this
    Character(*),Intent(In) :: file
    Type(open_action_t),Intent(In),Optional :: action
    Type(open_status_t),Intent(In),Optional :: status
    Character,Intent(In),Optional :: decimal
    Integer,Intent(Out),Optional :: iostat
    Character(*),Intent(InOut),Optional :: iomsg
    Integer u
    Character(9) :: open_action,open_status,open_decimal
    Logical opened
    If (Present(action)) Then
      Select Case(action%value)
      Case(csvopen_read%value)
        open_action = 'Read'
      Case(csvopen_readwrite%value)
        open_action = 'ReadWrite'
      Case(csvopen_write%value)
        open_action = 'Write'
      Case Default
        Stop '?Impossible value for OPEN ACTION='
      End Select
    Else
      open_action = 'Read' ! Note: default is Action='Read'.
    End If
    If (Present(status)) Then
      Select Case(status%value)
      Case(csvopen_old%value)
        open_status = 'Old'
      Case(csvopen_new%value)
        open_status = 'New'
      Case(csvopen_replace%value)
        open_status = 'Replace'
      Case(csvopen_unknown%value)
        open_status = 'Unknown'
      Case Default
        Stop '?Impossible value for open status'
      End Select
    Else
      open_status = 'Unknown' ! Note: default is same as normal file.
    End If
    If (Present(decimal)) Then
      this%decimal = decimal
      If (decimal=='.') Then
        open_decimal = 'Point'
        this%comma = ','
        this%thousands = ','
      Else If (decimal==',') Then
        Open_decimal = 'Comma'
        this%comma = ';'
        this%thousands = '.'
      Else
        Call ioerr(this,iostat,iomsg,'open', &
                   ioerr_csvfile_invalid_specifier_value, &
                   'Invalid value "'//character(decimal)//'" for DECIMAL=')
        Return
      End If
    Else
      open_decimal = 'Point' ! Note: default is same as normal file.
      this%decimal = '.'
      this%comma = ','
    End If
    If (this%unit/=-1) Then
      Call this%close(iostat=iostat,iomsg=iomsg)
      If (Present(iostat)) Then
        If (iostat/=0) Return
      End If
    End If
    Do u=csv_unit_range_bottom,csv_unit_range_top
      Inquire(u,Opened=opened)
      If (.Not.opened) Exit
    End Do
    If (u==csv_unit_range_top+1) Then
      Call ioerr(this,iostat,iomsg,'open', &
                 ioerr_csvfile_no_unit_available, &
                 'No unit available for opening "'//file//'"')
      Return
    End If
    If (Present(iostat)) Then
      If (Present(iomsg)) Then
        Open(u,File=file,Action=open_action,Status=open_status, &
             Decimal=open_decimal,Access='Stream',Form='Formatted', &
             Iostat=iostat,Iomsg=iomsg)
      Else
        Open(u,File=file,Action=open_action,Status=open_status, &
             Decimal=open_decimal,Access='Stream',Form='Formatted', &
             Iostat=iostat)
      End If
      If (iostat/=0) Return
    Else
      Open(u,File=file,Action=open_action,Status=open_status, &
           Decimal=open_decimal,Access='Stream',Form='Formatted')
    End If
    this%file = file
    this%unit = u
    this%state = state_beginning_of_file
  End Subroutine
  !
  ! READ: Read a value from a CSV file.
  !
  Subroutine readi8(this,value,iostat,iomsg,eor,eof)
    Class(csvfile_t),Intent(InOut) :: this
    Integer(Selected_Int_Kind(4)),Intent(Out) :: value
    Integer,Intent(Out),Optional :: iostat
    Character(*),Intent(InOut),Optional :: iomsg
    Logical,Intent(Out),Optional :: eor,eof
    Integer(Selected_Int_Kind(18)) :: v
    Call readi64(this,v,iostat,iomsg,eor,eof)
    If (Present(iostat)) Then
      If (iostat/=0) Return
    End If
    If (v>Huge(value) .Or. v<-Huge(value)-1) Then
      Call ioerr(this,iostat,iomsg,'readint',ioerr_csvfile_value_out_of_range,&
                 'Value '//itoa(v)//' out of range')
    Else
      value = v
    End If
  End Subroutine
  Subroutine readi16(this,value,iostat,iomsg,eor,eof)
    Class(csvfile_t),Intent(InOut) :: this
    Integer(Selected_Int_Kind(9)),Intent(Out) :: value
    Integer,Intent(Out),Optional :: iostat
    Character(*),Intent(InOut),Optional :: iomsg
    Integer(Selected_Int_Kind(18)) :: v
    Logical,Intent(Out),Optional :: eor,eof
    Call readi64(this,v,iostat,iomsg,eor,eof)
    If (Present(iostat)) Then
      If (iostat/=0) Return
    End If
    If (v>Huge(value) .Or. v<-Huge(value)-1) Then
      Call ioerr(this,iostat,iomsg,'readint',ioerr_csvfile_value_out_of_range,&
                 'Value '//itoa(v)//' out of range')
    Else
      value = v
    End If
  End Subroutine
  Subroutine readi32(this,value,iostat,iomsg,eor,eof)
    Class(csvfile_t),Intent(InOut) :: this
    Integer(Selected_Int_Kind(2)),Intent(Out) :: value
    Integer,Intent(Out),Optional :: iostat
    Character(*),Intent(InOut),Optional :: iomsg
    Logical,Intent(Out),Optional :: eor,eof
    Integer(Selected_Int_Kind(18)) :: v
    Call readi64(this,v,iostat,iomsg,eor,eof)
    If (Present(iostat)) Then
      If (iostat/=0) Return
    End If
    If (v>Huge(value) .Or. v<-Huge(value)-1) Then
      Call ioerr(this,iostat,iomsg,'readint',ioerr_csvfile_value_out_of_range,&
                 'Value '//itoa(v)//' out of range')
    Else
      value = v
    End If
  End Subroutine
  Subroutine readi64(this,value,iostat,iomsg,eor,eof)
    Class(csvfile_t),Intent(InOut) :: this
    Integer(Selected_Int_Kind(18)),Intent(Out) :: value
    Integer,Intent(Out),Optional :: iostat
    Character(*),Intent(InOut),Optional :: iomsg
    Logical,Intent(Out),Optional :: eor,eof
    Character(:),Allocatable :: buf
    Integer mylength
    Logical return_now
    If (this%unit==-1) Then
      Call ioerr(this,iostat,iomsg,'readint',ioerr_csvfile_not_open,'Not open')
      Return
    End If
    Call clear_flags(iostat,eor,eof)
    Allocate(Character(2)::buf)
    Call getstring(this,buf,mylength,iostat,iomsg,eor,eof,return_now)
    If (return_now) Return
    If (mylength<1) Then
      Call ioerr(this,iostat,iomsg,'input',ioerr_csvfile_invalid_value, &
      'Invalid value')
      Return
    End If
    !
    ! Convert to Fortran format, then use internal READ.
    !
    Call convert_number(this,buf,mylength)
    If (Present(iostat)) Then
      If (Present(iomsg)) Then
        Read(buf(:mylength),*,Iostat=iostat,Iomsg=iomsg) value
      Else
        Read(buf(:mylength),*,Iostat=iostat) value
      End If
    Else
      Read(buf(:mylength),*) value
    End If
  End Subroutine
  Subroutine readr1(this,value,iostat,iomsg,eor,eof)
    Class(csvfile_t),Intent(InOut) :: this
    Real(Selected_Real_Kind(6)),Intent(Out) :: value
    Integer,Intent(Out),Optional :: iostat
    Character(*),Intent(InOut),Optional :: iomsg
    Logical,Intent(Out),Optional :: eor,eof
    Character(:),Allocatable :: buf
    Integer mylength
    Logical return_now
    If (this%unit==-1) Then
      Call ioerr(this,iostat,iomsg,'readint',ioerr_csvfile_not_open,'Not open')
      Return
    End If
    Call clear_flags(iostat,eor,eof)
    Allocate(Character(32)::buf)
    Call getstring(this,buf,mylength,iostat,iomsg,eor,eof,return_now)
    If (return_now) Return
    If (mylength<1) Then
      Call ioerr(this,iostat,iomsg,'input',ioerr_csvfile_invalid_value, &
                 'Invalid value')
      Return
    End If
    !
    ! Convert to Fortran format, then use internal READ.
    !
    Call convert_number(this,buf,mylength)
    If (Present(iostat)) Then
      If (Present(iomsg)) Then
        Read(buf(:mylength),*,Iostat=iostat,Iomsg=iomsg) value
      Else
        Read(buf(:mylength),*,Iostat=iostat) value
      End If
    Else
      Read(buf(:mylength),*) value
    End If
  End Subroutine
  Subroutine readr2(this,value,iostat,iomsg,eor,eof)
    Class(csvfile_t),Intent(InOut) :: this
    Real(Selected_Real_Kind(15)),Intent(Out) :: value
    Integer,Intent(Out),Optional :: iostat
    Character(*),Intent(InOut),Optional :: iomsg
    Logical,Intent(Out),Optional :: eor,eof
    Character(:),Allocatable :: buf
    Integer mylength
    Logical return_now
    If (this%unit==-1) Then
      Call ioerr(this,iostat,iomsg,'readint',ioerr_csvfile_not_open,'Not open')
      Return
    End If
    Call clear_flags(iostat,eor,eof)
    Allocate(Character(32)::buf)
    Call getstring(this,buf,mylength,iostat,iomsg,eor,eof,return_now)
    If (return_now) Return
    If (mylength<1) Then
      Call ioerr(this,iostat,iomsg,'input',ioerr_csvfile_invalid_value, &
                 'Invalid value')
      Return
    End If
    !
    ! Convert to Fortran format, then use internal READ.
    !
    Call convert_number(this,buf,mylength)
    If (Present(iostat)) Then
      If (Present(iomsg)) Then
        Read(buf(:mylength),*,Iostat=iostat,Iomsg=iomsg) value
      Else
        Read(buf(:mylength),*,Iostat=iostat) value
      End If
    Else
      Read(buf(:mylength),*) value
    End If
  End Subroutine
  !
  ! NEXT_RECORD: The next READ should read from the next record.
  !
  ! If at the beginning of the file, skip the first record.
  ! In the middle of the file, skip the rest of this record;
  ! multiple consecutive NEXT_RECORD calls will skip one record each.
  !
  Subroutine next_record(this,iostat,iomsg,eof)
    Class(csvfile_t),Intent(InOut) :: this
    Integer,Intent(Out),Optional :: iostat
    Character(*),Intent(InOut),Optional :: iomsg
    Logical,Intent(Out),Optional :: eof
    If (this%unit==-1) Then
      Call ioerr(this,iostat,iomsg,'next_record',ioerr_csvfile_not_open, &
                 'Not open')
      Return
    End If
    Call clear_flags(iostat,eof=eof)
    If (this%state==state_eof) Then
      If (Present(eof)) eof = .True.
      If (Present(iostat) .Or. .Not.Present(eof)) &
        Call ioerr(this,iostat,iomsg,'next_record',Iostat_End,'End of file')
      Return
    End If
    If (this%state/=state_eor) Then
      If (Present(iostat)) Then
        If (Present(iomsg)) Then
          Read (this%unit,1,Iostat=iostat,Iomsg=iomsg,End=2)
        Else
          Read (this%unit,1,Iostat=iostat,End=2)
        End If
      Else If (Present(eof)) Then
        Read (this%unit,1,End=2)
      Else
        Read (this%unit,1)
      End If
    End If
    this%state = state_in_record
    Return
1   Format()
2   Continue ! End of file
    If (Present(eof)) eof = .True.
    this%state = state_eof
  End Subroutine
  !
  ! READ: Read a value into an allocatable character string.
  ! 
  ! If LENGTH is not present, VALUE is allocated to be the exact length of the
  ! input string.  If LENGTH is present, VALUE might be longer than the length
  ! of the string but LENGTH will contain the length of the input string.
  !
  ! If an error occurs, VALUE and LENGTH are undefined.
  !
  Subroutine readch(this,value,length,iostat,iomsg,eor,eof)
    Class(csvfile_t),Intent(InOut) :: this
    Character(:),Allocatable :: value
    Integer,Intent(Out),Optional :: length
    Integer,Intent(Out),Optional :: iostat
    Character(*),Intent(InOut),Optional :: iomsg
    Logical,Intent(Out),Optional :: eor,eof
    Integer mylength
    Character(:),Allocatable :: tmpvalue
    Logical return_now
    If (this%unit==-1) Then
      Call ioerr(this,iostat,iomsg,'next_record',ioerr_csvfile_not_open, &
                 'Not open')
      Return
    End If
    Call clear_flags(iostat,eor,eof)
    value = Repeat(' ',32) ! Initial guess for how much space we will need.
    Call getstring(this,value,mylength,iostat,iomsg,eor,eof,return_now)
    If (return_now) Return
    If (Present(length)) Then
      length = mylength
    Else If (mylength>=0) Then
      If (Len(value)/=mylength) Then
        tmpvalue = value(:mylength)
        Call Move_Alloc(tmpvalue,value)
      End If
    End If
  End Subroutine
  !
  ! Internal routines: these are not user-visible or user-callable.
  !
  ! ioerr: process an i/o error.
  !
  Subroutine ioerr(this,iostat,iomsg,routine,ioerr_val,ioerr_msg)
    Class(csvfile_t),Intent(In) :: this
    Integer,Intent(Out),Optional :: iostat
    Character(*),Intent(InOut),Optional :: iomsg
    Character(*),Intent(In) :: routine
    Integer,Intent(In) :: ioerr_val
    Character(*),Intent(In) :: ioerr_msg
    If (.Not.Present(iostat)) Then
      Print 1,routine,ioerr_msg
1     Format('?I/O error in csvfile.',A,': ',A)
      Print 2,this%unit,this%file
2     Format('CSV file on unit ',I0,', filename ',A)
      Stop '?Program stopped by fatal csvfile i/o error'
    End If
    If (Present(iomsg)) iomsg = ioerr_msg
    iostat = ioerr_val
  End Subroutine
  !
  ! clear_flags: Clear eor, eof and iostat flags.
  !
  Subroutine clear_flags(iostat,eor,eof)
    Integer,Intent(Out),Optional :: iostat
    Logical,Intent(Out),Optional :: eor,eof
    If (Present(iostat)) iostat = 0
    If (Present(eor)) eor = .False.
    If (Present(eof)) eof = .False.
  End Subroutine
  !
  ! character: return a printable string describing a single character
  !
  Function character(ch)
    Character,Intent(In) :: ch
    Character(:),Allocatable :: character
    If (Iand(Iachar(ch),127)<Iachar(' ') .Or. Iand(Iachar(ch),127)==127) Then
      Allocate(Character(4) :: character)
      Write (character,1) Iachar(ch)
1     Format('\',O3.3) ! ') for Emacs
    Else
      character = ch
    End If
  End Function
  !
  ! itoa: convert integer to text
  !
  Function itoa(value)
    Integer(Selected_Int_Kind(18)),Intent(In) :: value
    Character(:),Allocatable :: itoa
    Character(22) buf
    Write (buf,1) value
1   Format(I0)
    itoa = buf(:Len_Trim(buf))
  End Function
  !
  ! getstring: Get a whole value as a string.
  !
  ! VALUE must be an allocatable character string, that is already allocated;
  ! it will be reallocated to be longer if necessary,
  ! but will not be deallocated or reallocated to be shorter.
  !
  ! The length of the value is returned in LENGTH.
  !
  Subroutine getstring(this,value,length,iostat,iomsg,eor,eof,return_now)
    Class(csvfile_t),Intent(InOut) :: this
    Character(:),Allocatable,Intent(InOut) :: value
    Integer,Intent(Out) :: length
    Integer,Intent(Out),Optional :: iostat
    Character(*),Intent(InOut),Optional :: iomsg
    Logical,Intent(Out),Optional :: eor,eof
    Logical,Intent(Out) :: return_now
    Character ch,quote
    Character(:),Allocatable :: tmpbuf
    Integer i
    Logical in_quotes
    Call getchar(ch,this,iostat,iomsg,eor,eof,return_now)
    If (return_now) Return
    If (ch==this%comma) Then ! Zero-length value?
      length = 0
      Return
    Else If (ch==New_Line(ch)) Then ! No value (at end of record)?
      length = -1
      If (Present(eor)) eor = .True.
      Call ioerr(this,iostat,iomsg,'input',Iostat_Eor,'No value found')
      Return
    Else If (ch==Achar(0)) Then ! At end of file?
      If (Present(eof)) eof = .True.
      If (Present(iostat) .Or. .Not.Present(eof)) &
        Call ioerr(this,iostat,iomsg,'input',Iostat_End,'End of file')
      Return
    End If
    If (ch=='"' .Or. ch=="'") Then
      in_quotes = .True.
      quote = ch
      i = 1
    Else
      in_quotes = .False.
      If (Len(value)<1) Allocate(Character(32)::value)
      value(1:1) = ch
      i = 2
    End If
    Do
      Call getchar(ch,this,iostat,iomsg,eor,eof,return_now)
      If (return_now) Return
      If (ch==New_Line(ch)) Then
        If (in_quotes) Then
          Call ioerr(this,iostat,iomsg,'input',ioerr_csvfile_invalid_value, &
                     'Invalid value')
          Return
        End If
        Exit
      Else If (in_quotes) Then
        If (ch==quote) Then
          Call getchar(ch,this,iostat,iomsg,eor,eof,return_now)
          If (return_now) Return
          If (ch==this%comma .Or. ch==New_Line(ch)) Then
            Exit
          Else If (ch/=quote) Then
            Call ioerr(this,iostat,iomsg,'input',ioerr_csvfile_invalid_value, &
                       'Invalid value')
            Return
          End If
        End If
      Else If (ch==this%comma) Then
        Exit
      End If
      !
      ! Only here if we have an actual char to add to the string.
      !
      If (i>Len(value)) Then
        Allocate(Character(Len(value)*2) :: tmpbuf)
        tmpbuf(:Len(value)) = value
        Call Move_Alloc(tmpbuf,value)
      End If
      value(i:i) = ch
      i = i + 1
    End Do
    length = i - 1
  End Subroutine
  !
  ! getchar: get a single character from a csv file
  !
  Subroutine getchar(ch,this,iostat,iomsg,eor,eof,return_now)
    Character,Intent(Out) :: ch
    Class(csvfile_t),Intent(InOut) :: this
    Integer,Intent(Out),Optional :: iostat
    Character(*),Intent(InOut),Optional :: iomsg
    Logical,Intent(InOut),Optional :: eor,eof
    Logical,Intent(Out) :: return_now
    return_now = .False.
    Select Case (this%state)
    Case (state_eor)
      ! Just keep returning line feed until we get a next_record call.
      ch = New_Line(ch)
      If (Present(eor)) eor = .True.
      return_now = .True.
    Case (state_eof)
      ! Here for attempting to read past EOF; that is an error.
      Stop 'oops'
      ch = Achar(0)
      If (Present(eof)) eof = .True.
      If (Present(iostat) .Or..Not.Present(eof)) &
        Call ioerr(this,iostat,iomsg,'input',Iostat_End,'End of file')
      return_now = .True.
    Case Default
      If (Present(iostat)) Then
        If (Present(iomsg)) Then
          Read (this%unit,1,Iostat=iostat,Iomsg=iomsg,Eor=100,End=200,Advance='No') ch
        Else
          Read (this%unit,1,Iostat=iostat,Eor=100,End=200,Advance='No') ch
        End If
        If (iostat/=0) Then
          return_now = .True.
          Return
        End If
      Else
        Read (this%unit,1,Eor=100,End=200,Advance='No') ch
      End If
      this%state = state_in_record
      Return
100   ch = New_Line(ch)
      If (Present(iostat)) Then
        iostat = 0 ! We don't want to return EOR for finding the end.
      End If
      this%state = state_eor
      Return
200   ch = Achar(0)
      If (Present(iostat)) Then
        iostat = 0 ! We don't want to return EOF for finding the end-of-file.
      End If
      this%state = state_eof
    End Select
1   Format(A1)
  End Subroutine
  !
  ! Convert weird Excel formats.
  !
  ! We recognise:
  !   1. leading dollar sign and blanks (skipped);
  !   2. thousands separators (depending on the DECIMAL= mode);
  !   3. parentheses meaning negative.
  !
  Subroutine convert_number(this,string,length)
    Class(csvfile_t),Intent(In) :: this
    Character(:),Allocatable,Intent(InOut) :: string
    Integer,Intent(InOut) :: length
    Integer,Parameter :: tab = 9
    Integer i
    Do i=1,length
      If (string(i:i)/=' ' .And. Iachar(string(i:i))/=tab) Exit
    End Do
    If (i>=length) Return
    !
    ! Parentheses meaning negative are always outside.
    !
    If (string(i:i)=='(' .And. string(length:length)==')') Then
      string(i:i) = '-'
      length = length - 1
      i = i + 1
    Else If (string(i:i)=='+' .Or. string(i:i)=='-') Then
      i = i + 1
      If (i>=length) Return
    End If
    !
    ! Now try to strip off any current indicator.
    !
    If (string(i:i)=='$' .Or. string(i:i)=='?') Then
      string(i:length-1) = string(i+1:length)
      length = length - 1
      If (i>=length) Return
    Else If (string(i:i)>='A' .And. string(i:i)<='Z' .And. i+3<length) Then
      If (string(i:i+2)=='US$' .Or. string(i:i+2)=='HK$' .Or. &
          string(i+1:i+1)>='A' .And. string(i+1:i+1)<='Z' .And. &
          string(i+2:i+2)>='A' .And. string(i+2:i+2)<='Z') Then
        string(i:length-3) = string(i+3:length)
        length = length - 3
      End If
    End If
    !
    ! Skip any blanks again... and sign.
    !
    Do
      If (string(i:i)/=' ' .And. Iachar(string(i:i))/=tab) Exit
      i = i + 1
      If (i==length) Return
    End Do
    If (string(i:i)=='+' .Or. string(i:i)=='-') i = i + 1
    !
    ! Now we ought to be in a position to scan the string for thousands
    ! separators and eliminate them.
    !
    Do While (i<length-3)
      If (string(i:i)==this%thousands) Then
        string(i:length-1) = string(i+1:length)
        length = length - 1
      Else If (string(i:i)<'0' .Or. string(i:i)>'9') Then
        Exit
      Else
        i = i + 1
      End If
    End Do
    !
    ! It is possible to have a trailing current symbol;
    ! I think this happens only with ones that turn into question mark.
    !
    Do While (string(i:i)>='0' .Or. string(i:i)<='9' .Or. &
              string(i:i)==this%decimal)
      i = i + 1
      If (i==length) Return
    End Do
    If (i<length-2) Then
      If (string(i:length)==' ? ') Then
        length = i - 1
      End If
    End If
  End Subroutine
End Module