module ccc_io

  private

  public :: cc_open, cc_close, cc_access, cc_save, cc_delete
  public :: guess_ib2_fmt
  public :: locate_file
  public :: cc_newunit

  public dump_farray
  interface dump_farray
    module procedure dump_farray1d
    module procedure dump_farray2d
  end interface

  !--- A buffer used with CCCma binary read/write operations
  integer, parameter :: maxx=8392704  !---2049x4096
  real(kind=8)    :: wrk(maxx)
  integer(kind=8) :: ibuf(8), idat(2*maxx)
  common /iocom/ ibuf,idat

contains

  character(len=10) function guess_ib2_fmt(ibuf2) result(fmt)
    !--- Guess what the ibuf2 format might be
    implicit none

    !--- Input
    integer(kind=8) :: ibuf2

    !--- Local
    character(16) :: strng
    integer :: digits
    integer(kind=8) :: yy,mm,dd,hh

    !--- Determine the number of digits in the input ibuf2 value
    write(strng,'(i16)')ibuf2
    digits = len_trim(adjustl(strng))

    !--- If the format is not one containing year, month, day, hour
    !--- or a subset thereof, then assume a "RAW" format
    fmt = " "
    if ( digits.ge.11 ) then
      !--- Assume RAW
      fmt = "RAW"
    else if ( digits.ge.7 .and. digits.le.10 ) then
      !--- This will be either YYYYMMDDHH, YYYYMMDD or MODEL
      yy = ibuf2/1000000_8
      mm = (ibuf2-yy*1000000_8)/10000_8
      dd = (ibuf2-yy*1000000_8-mm*10000_8)/100_8
      hh = ibuf2-yy*1000000_8-mm*10000_8-dd*100_8
      if ( (mm.lt.1 .or. mm.gt.12) .and. &
           (dd.lt.1 .or. dd.gt.31) .and. &
           (hh.lt.0 .or. hh.gt.24) ) then
        !--- This cannot be YYYYMMDDHH
        if (digits.eq.8) then
          !--- See if this could be YYYYMMDD
          yy = ibuf2/10000_8
          mm = (ibuf2-yy*10000_8)/100_8
          dd = ibuf2-yy*10000_8-mm*100_8
          if ( (mm.ge.1 .and. mm.le.12) .and. &
               (dd.ge.1 .and. dd.le.31) ) then
            !--- Assume YYYYMMDD
            fmt = "YYYYMMDD"
          else
            fmt = "RAW"
          endif
        else
          fmt = "RAW"
        endif
      else
        !--- This could be either YYYYMMDDHH or YYYYMMDD
        if (digits.eq.8) then
          !--- See if this could be YYYYMMDD
          yy = ibuf2/10000_8
          mm = (ibuf2-yy*10000_8)/100_8
          dd = ibuf2-yy*10000_8-mm*100_8
          if ( (mm.ge.1 .and. mm.le.12) .and. &
               (dd.ge.1 .and. dd.le.31) ) then
            !--- Assume YYYYMMDD
            fmt = "YYYYMMDD"
          else
            !--- Assume YYYYMMDDHH
            fmt = "YYYYMMDDHH"
          endif
        else
          !--- Assume YYYYMMDDHH
          fmt = "YYYYMMDDHH"
        endif
      endif
    else if ( digits.ge.5 .and. digits.le.6 ) then
      !--- This will be either YYYYMM, YYYYMMDD  or MODEL
      !--- See if this could be YYYYMMDD
      yy = ibuf2/10000_8
      mm = (ibuf2-yy*10000_8)/100_8
      dd = ibuf2-yy*10000_8-mm*100_8
      if ( (mm.ge.1 .and. mm.le.12) .and. &
           (dd.ge.1 .and. dd.le.31) ) then
        !--- This could be either YYYYMMDDHH or YYYYMMDD
        if (digits.eq.6) then
          !--- See if this could be YYYYMM
          yy = ibuf2/100_8
          mm = ibuf2-yy*100_8
          if ( mm.ge.1 .and. mm.le.12 ) then
           !--- Assume YYYYMM
            fmt = "YYYYMM"
          else
            !--- Assume YYYYMMDD
            fmt = "YYYYMMDD"
          endif
        else
          !--- Assume YYYYMMDD
          fmt = "YYYYMMDD"
        endif
      else
        !--- See if this could be YYYYMM
        yy = ibuf2/100_8
        mm = ibuf2-yy*100_8
        if ( mm.ge.1 .and. mm.le.12 ) then
          !--- Assume YYYYMM
          fmt = "YYYYMM"
        else
          !--- Assume RAW
          fmt = "RAW"
        endif
      endif
          
    else if ( digits.ge.3 .and. digits.le.4 ) then
      !--- This will be either YYYY, YYYYMM  or MODEL
      yy = ibuf2/100_8
      mm = ibuf2-yy*100_8
      if ( mm.ge.1 .and. mm.le.12 ) then
        !--- Assume YYYYMM
        fmt = "YYYYMM"
      else
        !--- Assume RAW
        fmt = "RAW"
      endif
    else if ( digits.ge.1 .and. digits.le.2 ) then
      !--- This will be either YYYY or MODEL
      !--- Assume RAW
      fmt = "RAW"
    else
      !--- This should never happen
      write(6,'(a,i16,a)')'guess_ib2_fmt: Invalid ibuf2 value --> ',ibuf2,' <--'
      call abort
    endif
  end function guess_ib2_fmt

  function locate_file(fname,remote) result(found)
    !===========================================================================
    !--- Determine if a given file is accessable
    !--- If the file is not a local file then attempt to access the file
    !--- The optional logical parameter remote may be used to indicate whether
    !--- or not the file was accessed so the calling program may release it
    !--- after it has been processed.
    !===========================================================================

    logical :: found

    character(len=*), intent(in) :: fname
    logical, intent(out), optional :: remote

    !--- Local
    integer :: verbose = 1
    logical :: exists
    character(512) :: strng

    found = .false.
    if ( present(remote) ) remote = .false.

    !--- If the input file name is blank simply return a false value
    if ( len_trim(fname) <= 0 ) return

    !--- Attempt to locate the given file
    inquire(file=trim(fname),exist=exists)
    if (exists) then
      !--- This file exists and is accessable via "open" from the cwd
      found=.true.
    else
      !--- If this file does not exist, try an access
      strng=' '
      strng="access "//trim(fname)//" "//trim(fname)//" 2>/dev/null"
      if (verbose.gt.1) write(6,*)trim(strng)
      call system(trim(strng))
      !--- Clean up the trash left behind by access
      strng="rm -f .ccc_cards"
      call system(trim(strng))
      inquire(file=trim(fname),exist=exists)
      if (exists) then
        !--- The access was successful
        if (verbose.gt.0) then
          write(6,'(2a)')'Created link to remote file: ',trim(fname)
        endif
        if ( present(remote) ) remote = .true.
        found=.true.
      endif
    endif

  end function locate_file

  subroutine cc_open(iu,cccfile,remote,verbose)
    !=====================================================================
    ! Attach a file, named in the string cccfile, to unit iu
    ! If the file is not local attempt an access via system command access
    !
    ! remote is returned as .true. if the "access" was invoked
    ! remote is returned as .false. otherwise
    !
    ! When verbose > 0 some diagnostic info is written to stdout
    !
    ! Larry Solheim   May,2010
    !=====================================================================

    implicit none
    integer :: iu, verbose
    character*(*) :: cccfile
    logical :: remote

    !--- local
    character(512) :: strng
    logical :: exists,found

    remote=.false.
    found=.false.

    !--- Attach the CCCma binary file
    inquire(file=trim(cccfile),exist=exists)
    if (exists) then
      !--- Attach this file to unit iu
      open(iu,file=trim(cccfile),form="unformatted")
      found=.true.
    else
      !--- If this file does not exist, try an access
      strng=' '
      strng="access "//trim(cccfile)//" "//trim(cccfile)
      if (verbose.gt.1) write(6,*)trim(strng)
      call system(trim(strng))
      inquire(file=trim(cccfile),exist=exists)
      if (exists) then
        !--- Attach this file to unit iu
        if (verbose.gt.0) then
          write(6,'(2a)')'Attached remote file: ',trim(cccfile)
        endif
        open(iu,file=trim(cccfile),form='unformatted')
        remote=.true.
        found=.true.
      endif
    endif
    if (.not.found) then
      write(6,*)'Unable to find CCCma binary file ',trim(cccfile)
      call abort
    endif
  end subroutine cc_open

  subroutine cc_close(iu,cccfile,remote,verbose)
    !=====================================================================
    ! Close a file that was opened by cc_open
    ! If this file was accessed by cc_open then release it here
    !
    ! Larry Solheim   Jul,2012
    !=====================================================================

    implicit none
    integer :: iu, verbose
    character*(*) :: cccfile
    logical :: remote

    !--- local
    character(512) :: strng

    !--- Close the file
    close(iu)

    if (remote) then
      !--- Release this file, it was aquired by access
      if (verbose.gt.0) then
        write(6,'(2a)')" Release remote file: ",trim(cccfile)
      endif
      strng=' '
      strng="release "//trim(cccfile)
      call system(trim(strng))
    endif
  end subroutine cc_close

  subroutine cc_access(local_file,rem_file,clobber,missing_ok,verbose)
    !=====================================================================
    ! Access the file named in the string rem_file and save it to the
    ! current working directory named as local_file
    !
    ! If clobber is true then overwrite any existing local file of the same name
    !
    ! If missing_ok is true then do not abort when the access fails.
    ! The access normally fails because the remote file does not exist so
    ! setting missing_ok=.true. usually means ignore any missing remote files.
    !
    ! When verbose > 0 some diagnostic info is written to stdout
    !
    ! Larry Solheim   Nov,2011
    !=====================================================================

    implicit none

    character*(*) :: local_file, rem_file
    logical, intent(in) :: clobber, missing_ok
    integer, intent(in) :: verbose

    !--- local
    character(512) :: strng
    logical :: exists
    !.......................................................................

    if (verbose.gt.1) then
      write(6,*)'cc_access: local_file=',trim(local_file), &
        '  rem_file=',trim(rem_file),'  clobber=',clobber, &
        '  missing_ok=',missing_ok,'  verbose=',verbose
    endif

    !--- Determine if the local file already exists and
    !--- take the appropriate action is if does
    inquire(file=trim(local_file),exist=exists)
    if (exists) then
      !--- Abort unless clobber is true
      if (.not.clobber) then
        write(6,'(3a)')'  cc_access: Local file ', &
          trim(local_file),' exists.'
        call xit("CC_ACCESS",-1)
      endif

      !--- Delete the local file
      strng=' '
      strng='rm -f '//trim(local_file)
      call system(trim(strng))
      if (verbose.gt.0) write(6,'(2a)')" cc_access: ",trim(strng)
      inquire(file=trim(local_file),exist=exists)
      if (exists) then
        !--- If the file still exists then there was a problem
        !--- with the "rm -f ..." that was attempted above
        write(6,'(2a)')'  cc_access: Cannot remove local file ', &
          trim(local_file)
        call xit("CC_ACCESS",-2)
      endif
    endif

    !--- Access the remote file
    strng=' '
    strng="access "//trim(local_file)//" "//trim(rem_file)
    if (verbose.gt.0) write(6,'(2a)')" cc_access: ",trim(strng)
    call system(trim(strng))
    inquire(file=trim(local_file),exist=exists)
    if (.not.exists .and. .not.missing_ok) then
      write(6,'(2a)') &
        '  cc_access: Unable to access remote file ',trim(rem_file)
      call xit("CC_ACCESS",-3)
    endif

  end subroutine cc_access

  subroutine cc_save(local_name,saved_name,clobber,append, &
                       del_local,verbose)
    !=====================================================================
    ! Save the file local_name as saved_name on DATAPATH/RUNPATH
    !
    ! If clobber is true then the most recent edition, if any, of the
    ! saved file will be deleted prior to the save
    !
    ! If append is true then the input file "local_name" will be appended
    ! to the latest edition of a file named "saved_name" found on
    ! DATAPATH/RUNPATH, if it exists. If it does not exist then the file
    ! "saved_name" will be created on DATAPATH/RUNPATH.
    !
    ! clobber and append are mutually exclusive and an error will occur
    ! if they are both true.
    !
    ! If del_local is true then the input file "local_name" will
    ! be deleted after being saved to DATAPATH/RUNPATH
    !
    ! When verbose > 0 some diagnostic info is written to stdout
    !
    ! Larry Solheim   Nov,2011
    !=====================================================================

    implicit none

    character*(*) :: local_name, saved_name
    logical, intent(in) :: clobber, append, del_local
    integer, intent(in) :: verbose

    !--- local
    character(1024) :: strng, tmpf1, tmpf2
    logical :: exists, found, ok, delete_missing_ok=.true.
    logical :: access_clobber=.false., access_missing_ok=.true.
    integer :: iurem, iuin

    integer, parameter :: maxx=2098176  !--- 1024x2049
    integer :: ibuf(maxx+8)
    common /icom/ ibuf
    !.......................................................................

    if (verbose.gt.1) then
      write(6,'(4a,2(a,l1),a,i3)') &
        ' cc_save: local_name=',trim(local_name), &
        '  saved_name=',trim(saved_name), &
        '  clobber=',clobber,'  append=',append, &
        '  verbose=',verbose
    endif

    if (clobber .and. append) then
      !--- clobber and append are mutually exclusive
      write(6,*)'cc_save: Both clobber and append cannot be true.'
      call xit("CC_SAVE",-1)
    endif

    !--- Ensure the local file exists
    inquire(file=trim(local_name),exist=exists)
    if (exists) then

      if (clobber) then
        !--- Before saving the current file, attempt to delete the remote file
        !--- If the remote files does not exists this call to cc_delete will
        !--- simply return without incident (similar to rm -f)
        call cc_delete(trim(saved_name),delete_missing_ok,verbose)
      endif

      if (append) then
        !--- Append to an existing file, if any

        !--- Determine the name of a temporary file
        call get_unique_fname("tmp_cc_save_", tmpf1, &
                              .false., verbose)

        !--- Access the remote file as tmpf1 locally
        call cc_access(trim(tmpf1),trim(saved_name), &
                       access_clobber,access_missing_ok,verbose)

        !--- If the temporay file does not exists then assume that
        !--- the remote file does not yet exist on DATAPATH/RUNPATH
        !--- Otherwise append to the remote file.
        inquire(file=trim(tmpf1),exist=exists)
        if (exists) then
          !--- Append the input file (local_name) to the existing remote file

          !--- The access done above will normally create a link to the
          !--- remote file, which may be owned by another user and will
          !--- certainly have write permission disabled.
          !--- Create a local copy of the remote file so that we can ensure
          !--- that it is owned by the current user and the permissions will
          !--- allow writing to the file.

          !--- We will need another unique file name to do this.
          call get_unique_fname("tmp_cc_save_", tmpf2, &
                                .true., verbose)

          !--- Copy the file to the cwd
          strng=' '
          strng='cp '//trim(tmpf1)//' '//trim(tmpf2)
          if (verbose.gt.1) write(6,*)trim(strng)
          call system(trim(strng))

          !--- Ensure the file is writable
          strng=' '
          strng='chmod u+w '//trim(tmpf2)
          if (verbose.gt.1) write(6,*)trim(strng)
          call system(trim(strng))

          !--- Release the remote file (remove the link)
          strng=' '
          strng='release '//trim(tmpf1)
          if (verbose.gt.1) write(6,*)trim(strng)
          call system(trim(strng))

! We can cat the files instead of reading them directly
! This will work for both binary and text files

          strng=' '
          strng='cat '//trim(tmpf2)//' '//trim(local_name)//' >'//trim(tmpf1)
          if (verbose.gt.1) write(6,*)trim(strng)
          call system(trim(strng))

!xxx          !--- Open the input file (local_name)
!xxx          iuin = cc_newunit(20)
!xxx          if (verbose.gt.1) then
!xxx            write(6,'(3a,i6)') &
!xxx              " cc_save: open ",trim(local_name)," on unit ",iuin
!xxx          endif
!xxx          open(iuin,file=trim(local_name),form='unformatted')
!xxx
!xxx          !--- Open the remote file (tmpf2), positioned at the EOF
!xxx          iurem = cc_newunit(20)
!xxx          if (verbose.gt.1) then
!xxx            write(6,'(3a,i6)') &
!xxx              " cc_save: open ",trim(tmpf2)," on unit ",iurem
!xxx          endif
!xxx          open(iurem,file=trim(tmpf2),form='unformatted', &
!xxx               position='append')
!xxx
!xxx          !--- Append records from the input file (local_name) to the
!xxx          !--- a local copy of the remote file (tmpf2)
!xxx          ok=.true.
!xxx          do while (ok)
!xxx            call recget(iuin,-1,-1,-1,-1,ibuf,maxx,ok)
!xxx            if (.not.ok) exit
!xxx            call recput(iurem,ibuf)
!xxx            if (verbose.gt.1) then
!xxx              write(6,'(a,a4,1x,i10,1x,a4,1x,5i8)') &
!xxx                " cc_save: append ",ibuf(1:8)
!xxx            endif
!xxx          enddo
!xxx
!xxx          close(iuin)
!xxx          close(iurem)
!xxx
!xxx          !--- Delete the remote file before saving the new version
!xxx          !--- which has the input file appended to it
!xxx          call cc_delete(trim(saved_name),.false.,verbose)
!xxx
!xxx          strng=' '
!xxx          strng="save "//trim(tmpf2)//" "//trim(saved_name)
!xxx          if (verbose.gt.1) write(6,*)trim(strng)
!xxx          call system(trim(strng))
!xxx
!xxx          !--- tmpf2 will remain on disk as a link after the save
!xxx          !--- Release tmpf2 to clean up this link
!xxx          strng=' '
!xxx          strng="release "//trim(tmpf2)
!xxx          if (verbose.gt.1) write(6,*)trim(strng)
!xxx          call system(trim(strng))

          !--- Delete the remote file before saving the new version
          !--- which has the input file appended to it
          call cc_delete(trim(saved_name),.false.,verbose)

          strng=' '
          strng="save "//trim(tmpf1)//" "//trim(saved_name)
          if (verbose.gt.1) write(6,*)trim(strng)
          call system(trim(strng))

          !--- tmpf1 will remain on disk as a link after the save
          !--- Release tmpf2 to clean up this link
          strng=' '
          strng="release "//trim(tmpf1)
          if (verbose.gt.1) write(6,*)trim(strng)
          call system(trim(strng))

        else
          !--- The remote file does not yet exist
          !--- Simply save local file as saved_name
          strng=' '
          strng="save "//trim(local_name)//" "//trim(saved_name)
          if (verbose.gt.1) write(6,*)trim(strng)
          call system(trim(strng))
        endif

      else
        !--- If not appending to the remote file then simply
        !--- save local file as saved_name
        strng=' '
        strng="save "//trim(local_name)//" "//trim(saved_name)
        if (verbose.gt.1) write(6,*)trim(strng)
        call system(trim(strng))
      endif

      if (del_local) then
        !--- Use release to delete this file so that any links
        !--- created by system calls above are removed
        strng=' '
        strng="release "//trim(local_name)
        if (verbose.gt.1) write(6,*)trim(strng)
        call system(trim(strng))
      endif

      if (verbose.gt.0) then
        write(6,'(2a)')'cc_save: saved file ',trim(saved_name)
      endif

    else
      !--- The file to be saved does not exist
      write(6,'(2a)') &
        'cc_save: Unable to find local file ',trim(local_name)
      call xit("CC_SAVE",-3)
    endif

  end subroutine cc_save

  subroutine cc_delete(rem_file,missing_file_ok,verbose)
    !=====================================================================
    ! Delete the file named in the string rem_file from DATAPATH/RUNPATH
    !
    ! When verbose > 0 some diagnostic info is written to stdout
    !
    ! Larry Solheim   Nov,2011
    !=====================================================================

    implicit none

    character*(*) :: rem_file
    logical, intent(in) :: missing_file_ok
    integer, intent(in) :: verbose

    !--- local
    character(1024) :: strng, local_file
    logical :: exists

    !--- Get the name of a temporary local file
    call get_unique_fname("tmp_cc_delete_", local_file, &
                              .false., verbose)

    !--- Access the remote file
    strng=' '
    strng="access "//trim(local_file)//" "//trim(rem_file)
    if (verbose.gt.0) write(6,'(2a)')" cc_delete:  ",trim(strng)
    call system(trim(strng))
    inquire(file=trim(local_file),exist=exists)
    if (.not.exists) then
      !--- The access failed for some reason
      !--- Abort unless the user indicates otherwise via missing_file_ok
      if ( missing_file_ok ) then
        !--- Simply return without incident
        return
      else
        !--- Abort when this access fails
        write(6,'(2a)') &
          ' cc_delete: Unable to access remote file ',trim(rem_file)
        call xit("CC_DELETE",-2)
      endif
    endif

    !--- Delete the remote file
    strng=' '
    strng="delete "//trim(local_file)
    if (verbose.gt.0) write(6,'(2a)')" cc_delete:  ",trim(strng)
    call system(trim(strng))
    inquire(file=trim(local_file),exist=exists)
    if (exists) then
      !--- The delete failed to remove the local file
      write(6,'(2a)') &
        ' cc_delete: Unable to delete file ',trim(rem_file)
      call xit("CC_DELETE",-3)
    endif

    !--- Release the local file (remove any remaining links)
    strng=' '
    strng="release "//trim(local_file)
    if (verbose.gt.0) write(6,'(2a)')" cc_delete: ",trim(strng)
    call system(trim(strng))

  end subroutine cc_delete

  subroutine get_unique_fname(pfx, fname, wait1, verbose)
    !=======================================================================
    ! Create a file name that begins with the string pfx and is unique in
    ! the current working directory.
    ! The file name is returned in the string fname.
    !
    ! If wait1 is true then this subroutine will wait 1 second before
    ! seeding the random number generator. This will (usually) guarantee
    ! that a file name that is different than any returned by previous calls
    ! to get_unique_fname will be returned by the current call.
    ! Obviously, this will slow things down significantly, but the user may
    ! want to invoke this if several unique file names are to be generated
    ! by a single loop, calling get_unique_fname on each iteration.
    !
    ! If verbose is greater than 0 then diagnostic messages will be
    ! written to stdout.
    !
    ! Larry Solheim ...Dec,2011
    !=======================================================================
    character*(*), intent(in)  :: pfx
    character*(*), intent(out) :: fname
    logical, intent(in) :: wait1
    integer, intent(in) :: verbose

    !--- local
    logical :: found, exists
    real :: rnd
    integer :: irnd, idx, sz
    integer, allocatable :: seed(:)

    if (len_trim(pfx).le.0) then
      write(6,*)"get_unique_fname: pfx is empty"
      call xit("GET_UNIQUE_FNAME",-1)
    endif

    found=.false.

    !--- Seed the random number generator
    if (wait1) call system('sleep 1')
    call system_clock( count=idx )
    call random_seed( size=sz )
    allocate( seed(sz) )
    seed = idx
    call random_seed( put=seed )
    deallocate( seed )

    !--- Attempt to find the unique file name
    !--- The file name will usually be found on the first iteration
    !--- Allowing 500 iterations is likely overkill but this number is
    !--- used on the off chance that some edge case will require it
    do idx=1,500
      call random_number(rnd)
      irnd=100000*rnd
      fname=' '
      write(fname,'(a,i6.6)')trim(pfx),irnd
      if (verbose.gt.1) then
        write(6,'(2a)')" get_unique_fname: fname=",trim(fname)
      endif

      !--- If the temporay file already exists then try another name
      inquire(file=trim(fname),exist=exists)
      if (exists) then
        cycle
      else
        found=.true.
        exit
      endif
    enddo

    if (.not.found) then
      !--- Cannot find a file name that does not already exist
      write(6,'(2a)') &
        ' get_unique_fname: Unable to find a unique file name.'
      call xit("GET_UNIQUE_FNAME",-2)
    endif

  end subroutine get_unique_fname

  integer function cc_newunit(iuin)
    !-----------------------------------------------------------------------
    !--- May 12/2004 - L.Solheim
    !---
    !--- Return the first unit number .ge. iuin that is not attached
    !--- to a file. Unit numbers in the exclusion list (iuxcld) will
    !--- never be returned. This exclusion list may be appended to by
    !--- passing in a negative iuin, in which case the value returned is
    !--- appended to the exclusion list.
    !-----------------------------------------------------------------------

    implicit real (a-h,o-z), integer (i-n)

    !--- iumax is the largest unit number that will be returned
    !--- f90 allows unit number in the range 0 to 2147483647
    !--- this range (excluding end points) is allowed here

    integer, parameter :: iumax=2147483647

    integer iuin

    !--- local
    logical uexist,uopen,found
    integer iu

    !--- the unit numbers in the iuxcld list will never be used
    integer, parameter :: lxcld_max=100
    integer, save :: iuxcld(lxcld_max)

    data iuxcld /0,5,6,7,8,95*-1/
    !-----------------------------------------------------------------------

    !--- find the first available unit number not attached to a file

    if (iuin.lt.1) then
      if (iuin.eq.0) then
        iu=0
      else
        !--- when iuin is negative we reserve the first available
        !--- unit .ge. iabs(iuin) by saving it in iuxcld
        iu=iabs(iuin)-1
      endif
    else if (iuin.lt.iumax) then
      iu=iuin-1
    else
      write(6,*)'CC_NEWUNIT: iuin=',iuin,' is out of range.'
      write(6,*)'         starting from unit 1'
      iu=0
    endif
    uexist=.true.
    uopen=.true.
    do while (uexist .and. uopen .and. iu.lt.iumax)
      iu=iu+1
      if (.not.any(iu.eq.iuxcld(:))) then
        inquire(iu,exist=uexist,opened=uopen)
      endif
    enddo
    if (iu.ge.iumax) then
      write(6,*)'CC_NEWUNIT: unable to find an available unit number'
      write(6,*)'       uexist,uopen,iu: ',uexist,uopen,iu
      call                                         xit("cc_newunit",-1)
    endif
    cc_newunit=iu

    if (iuin.lt.0) then
      !--- reserve this unit number by saving it in iuxcld
      i=0
      found=.false.
      do while(.not.found .and. i.lt.lxcld_max)
        i=i+1
        if (iuxcld(i).lt.0) then
          iuxcld(i)=iu
          lxcld=i
          found=.true.
        endif
      enddo
      if (found) then
        write(6,'(a)')'CC_NEWUNIT: adding to exclude list'
        write(6,'(a)')'         new exclude list: '
        write(6,'(10i6)')(iuxcld(i),i=1,lxcld)
      else
        write(6,'(a)')'CC_NEWUNIT: ***warning*** exclude list overflow.'
      endif
    endif

  end function cc_newunit

  !***************************************************************************
  !--- Dump a 1d array to a fortran binary file
  !***************************************************************************
  subroutine dump_farray1d(name,var,pfx,idx,pos,nx,ny,fname)
    character(*) :: name
    real(kind=8) :: var(:)
    character(*), optional :: pfx
    integer, optional :: idx
    integer, optional :: pos
    integer, optional :: nx, ny
    character(*), optional :: fname
    integer :: lpos, iu
    logical :: exists, cccma_bin
    character(256) :: lpfx, strng

    cccma_bin = .true.
    if ( cccma_bin ) then
      ibuf(1) = transfer("GRID", 1_8)
      ibuf(2) = 1
      ibuf(3) = transfer(name(1:4), 1_8)
      ibuf(4) = 1
      if ( present(nx) ) then
        ibuf(5) = nx
      else
        ibuf(5) = size(var)
      endif
      if ( present(ny) ) then
        ibuf(6) = ny
      else
        ibuf(6) = 1
      endif
      ibuf(7) = 0
      ibuf(8) = 1
      wrk(1:size(var)) = var
    endif

    if ( present(pos) ) then
      lpos = pos
    else
      !--- Append to existing files by default
      lpos = 2
    endif
    lpfx = " "
    if ( present(pfx) ) then
      lpfx = trim(pfx)
    else
      lpfx = "dump"
    endif
    strng=" "
    if ( present(fname) ) then
      strng = trim(fname)
    else
      if ( present(idx) ) then
        write(strng,'(a,"_",a,"_",i8.8)')trim(lpfx),trim(name),idx
      else
        write(strng,'(a,"_",a)')trim(lpfx),trim(name)
      endif
    endif
    !--- Ensure a valid file name
    strng = valid_nc_name(trim(strng))
    iu = cc_newunit(427)
    if ( lpos == 0 ) then
      !--- Only write the first time this name is used
      inquire(file=trim(strng), exist=exists)
      if ( exists ) then
        write(6,*)"dump_farray1d: file exists ",trim(strng)
        call flush(6)
      else
        open(iu,file=trim(strng),form="unformatted")
        if ( cccma_bin ) then
          call putfld2(iu,wrk,ibuf,maxx)
        else
          write(iu) var
        endif
        close(iu)
      endif
    else if ( lpos == 1 ) then
      !--- Overwrite the file each time a write is requested
      open(iu,file=trim(strng),form="unformatted")
      rewind(iu)
      if ( cccma_bin ) then
        call putfld2(iu,wrk,ibuf,maxx)
      else
        write(iu) var
      endif
      close(iu)
    else if ( lpos == 2 ) then
      !--- Append to the file each time a write is requested
      open(iu,file=trim(strng),form="unformatted",position="append")
      if ( cccma_bin ) then
        call putfld2(iu,wrk,ibuf,maxx)
      else
        write(iu) var
      endif
      close(iu)
    endif
  end subroutine dump_farray1d

  !***************************************************************************
  !--- Dump a 1d array to a fortran binary file
  !***************************************************************************
  subroutine dump_farray2d(name,var,pfx,idx,pos,nx,ny,fname)
    character(*) :: name
    real(kind=8) :: var(:,:)
    character(*), optional :: pfx
    integer, optional :: idx
    integer, optional :: pos
    integer, optional :: nx, ny
    character(*), optional :: fname
    integer :: lpos, iu
    logical :: exists, cccma_bin
    character(256) :: lpfx, strng

    cccma_bin = .true.
    if ( cccma_bin ) then
      ibuf(1) = transfer("GRID", 1_8)
      ibuf(2) = 1
      ibuf(3) = transfer(name(1:4), 1_8)
      ibuf(4) = 1
      if ( present(nx) ) then
        ibuf(5) = nx
      else
        ibuf(5) = size(var,dim=1)
      endif
      if ( present(ny) ) then
        ibuf(6) = ny
      else
        ibuf(6) = size(var,dim=2)
      endif
      ibuf(7) = 0
      ibuf(8) = 1
      wrk(1:nx*ny) = reshape(var(1:nx,1:ny), (/nx*ny/) )
    endif

    if ( present(pos) ) then
      lpos = pos
    else
      !--- Append to existing files by default
      lpos = 2
    endif
    lpfx = " "
    if ( present(pfx) ) then
      lpfx = trim(pfx)
    else
      lpfx = "dump"
    endif
    strng=" "
    if ( present(fname) ) then
      strng = trim(fname)
    else
      if ( present(idx) ) then
        write(strng,'(a,"_",a,"_",i8.8)')trim(lpfx),trim(name),idx
      else
        write(strng,'(a,"_",a)')trim(lpfx),trim(name)
      endif
    endif
    !--- Ensure a valid file name
    strng = valid_nc_name(trim(strng))
    iu = cc_newunit(437)
    if ( lpos == 0 ) then
      !--- Only write the first time this name is used
      inquire(file=trim(strng),exist=exists)
      if ( exists ) then
        write(6,*)"dump_farray2d: file exists ",trim(strng)
        call flush(6)
      else
        open(iu,file=trim(strng),form="unformatted")
        if ( cccma_bin ) then
          call putfld2(iu,wrk,ibuf,maxx)
        else
          write(iu) var
        endif
        close(iu)
      endif
    else if ( lpos == 1 ) then
      !--- Overwrite the file each time a write is requested
      open(iu,file=trim(strng),form="unformatted")
      rewind(iu)
      if ( cccma_bin ) then
        call putfld2(iu,wrk,ibuf,maxx)
      else
        write(iu) var
      endif
      close(iu)
    else if ( lpos == 2 ) then
      !--- Append to the file each time a write is requested
      open(iu,file=trim(strng),form="unformatted",position="append")
      if ( cccma_bin ) then
        call putfld2(iu,wrk,ibuf,maxx)
      else
        write(iu) var
      endif
      close(iu)
    endif
  end subroutine dump_farray2d

  function valid_nc_name(name_in)
    implicit none
    character(*) :: name_in
    character(len=1024) :: strng, name_out, valid_nc_name
    integer :: i, ich, idx
    logical :: add_pfx

    name_out=' '
    add_pfx = .false.
    !--- Strip leading and trailing space from name_in
    name_out=trim(adjustl(name_in))
    do i=1,len_trim(name_out)
      !--- netcdf variable names can be any alphanumeric character
      !--- as well as underscore (_) or dash (-) but must start
      !--- with an [a-z][A-Z] character
      !--- ascii 48 to ascii  57 are the numbers 0-9
      !--- ascii 65 to ascii  90 are the letters A-Z
      !--- ascii 97 to ascii 122 are the letters a-z
      !--- ascii 45 is dash (-)
      !--- ascii 95 is underscore (_)
      ich = ichar(name_out(i:i))
      if (ich.eq.32) then
        !--- replace spaces with underscore
        name_out(i:i)='_'
      else if (ich.eq.34) then
        !--- replace double quote with dash
        name_out(i:i)='-'
      else if (ich.eq.39) then
        !--- replace single quote with dash
        name_out(i:i)='-'
      else if (ich.eq.46) then
        !--- replace period with dash
        name_out(i:i)='_'
      else if (ich.eq.42) then
        !--- replace star with dash
        name_out(i:i)='_'
      else if (ich.eq.45) then
        !--- replace dash with dash
        name_out(i:i)='-'
      else if (ich.lt.48 .or. ich.gt.122) then
        !--- replace all other illegal characters with underscore
        name_out(i:i)='_'
      else if (ich.gt.57 .and. ich.lt.65) then
        !--- replace all other illegal characters with underscore
        name_out(i:i)='_'
      else if (ich.gt.90 .and. ich.lt.97) then
        !--- replace all other illegal characters with underscore
        name_out(i:i)='_'
      endif
      !--- Allow any first char for nor now
      if (i.eq.1 .and. .false.) then
        !--- If the first character is not one of [a-z][A-Z] then
        !--- prepend a valid first character to the output name
        if ( (ich.ge.65 .and. ich.le.90) .or. (ich.ge.97 .and. ich.le.122) ) then
          !--- This is a valid first character
          add_pfx = .false.
        else
          !--- This is not a valid first character
          add_pfx = .true.
        endif
      endif
    enddo

    if ( add_pfx ) then
      !--- The first character is not valid as the first char in a netcdf variable name
      !--- Prepend a valid letter to this name
      idx = len_trim(name_out)
      strng = " "
      strng(1:1) = "n"
      strng(2:1+idx) = trim(adjustl(name_out))
      name_out = " "
      name_out = trim(strng)
    endif

    !--- Return the (possibly) modified value of name_in
    valid_nc_name=' '
    valid_nc_name=name_out

  end function valid_nc_name

end module ccc_io
