module gsi_unformatted
!$$$  subprogram documentation block
!                .      .    .                                       .
! subprogram:    module gsi_unformatted
!   prgmmr:      j guo <jguo@nasa.gov>
!      org:      NASA/GSFC, Global Modeling and Assimilation Office, 900.3
!     date:      2013-05-06
!
! abstract: open() for named sequential unformatted files with "convert" specifier.
!
! program history log:
!   2013-05-06  j guo   - initial implementation.
!                       - added this document block
!
!   input argument list: see Fortran 90 style document below
!
!   output argument list: see Fortran 90 style document below
!
! attributes:
!   language: Fortran 90 and/or above
!   machine:
!
!$$$  end subprogram documentation block

! module interface:

  use kinds    , only: i_kind
  use mpeu_util, only: mpeu_luavail => luavail
  use mpeu_util, only: mpeu_getarec => getarec
  use mpeu_util, only: die,perr,warn,tell
  use mpeu_util, only: indexSet, indexSort
  implicit none
  private       ! except

  public :: unformatted_open    ! (unit,file[,class][,action][,position][,status][,iostat])
                                !  -- an interface to open a Fortran sequential unformatted file
  public :: fileinfo_lookup     ! (class,convert)
                                !  -- look up class in a fileinfo table, for a convert definition
  public :: fileinfo_reset      ! ([fileinfo])
                                !  -- deallocate(fileinfo_xx) or set an alternate fileinfo filename.
  public :: FILEINFO_LEN        ! the internal lenth of fields class and convert.

  interface unformatted_open; module procedure   open_; end interface
  interface fileinfo_lookup ; module procedure lookup_; end interface
  interface fileinfo_reset  ; module procedure  reset_; end interface

!!! For implementor: For compilers do not support "convert", this is
!!! the place to #ifdef them out.
#ifdef __X_OR_Y_OR_Z_FORTRAN_COMPILERS__
#define _DO_NOT_SUPPORT_OPEN_WITH_CONVERT_
#endif

!!! Usage:
!!!
!!!   ! lookup convert value for a user defined class '.bufr.'
!!!     use gsi_unformatted, only: fileinfo_lookup, FILEINFO_LEN
!!!     character(len=FILEINFO_LEN):: convert
!!!     convert='native'
!!!     call fileinfo_lookup('.bufr.',convert)
!!! or
!!!   ! lookup convert value for a given filename
!!!     use gsi_unformatted, only: fileinfo_lookup, FILEINFO_LEN
!!!     character(len=FILEINFO_LEN):: convert
!!!     convert=''
!!!     call fileinfo_lookup(filename,convert)
!!! or
!!!   ! open an existed BUFR file for input
!!!     use gsi_unformatted, only: unformatted_open
!!!     call unformatted_open(unit,file,class='.bufr.',status='old',iostat=ier)
!!!
!!# This is an example of file 'unformatted_fileinfo', a user defined database
!!# file supporting module gsi_unformatted, for user specific local GSI system
!!# configuration.
!!#
!!# Note: convert="" and convert="native" may be different, when this code is
!!#     compiled with a compiler "--convert <keyword>" flag.  "native" refers
!!#     to the platform default, while "" refers to <keyword> of flag "--convert".
!!#
!!# Note: Just like a filename, class is case sensitive, at least for this
!!#     implementation.
!!#
!!# Note: Reserved values in this implementation of this module.
!!#     class   == ".default."          -- for all files
!!#     convert == "_NOT_SUPPORTED_"    -- flag compilers not supporting "convert"
!!#     convert == "_NOT_FOUND_"        -- flag a failed lookup() call.
!!#
!!#     class/file      convert
!!#--------------------------------------
!!      .default.       ""              # a class name reserved for all files
!!      .bufr.          little_endian   # for all BUFR files
!!      prepbufr        native          # an exception from .bufr.
!!      .berror.        native          # for files grouped under .berror.
!!      berror_stats    big_endian      # an exception from .berror.
!!      .diag.          big_endian      # for files grouped under .diag.


!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  character(len=*),parameter :: myname='gsi_unformatted'

  integer(i_kind),parameter:: FILEINFO_LEN=64
  integer(i_kind),parameter:: FILEINFO_INC=32

  integer(i_kind),parameter:: FILEINFO_REC=256
  integer(i_kind),parameter:: FILEINFO_FNL=512  ! in case it has a very long pathname

#ifdef _DO_NOT_SUPPORT_OPEN_WITH_CONVERT_
  logical,parameter:: CONVERT_SUPPORTED_ = .false.
#else
  logical,parameter:: CONVERT_SUPPORTED_ = .true.
#endif

! Declare a "_fileinfo_" data structure, defining a class-vs-convert table.

  character(len=*),parameter:: DEFAULT_FILEINFO_NAME ='unformatted_fileinfo'

  logical,save:: fileinfo_initialized_ = .false.

  character(len=FILEINFO_FNL),save:: fileinfo_name_=DEFAULT_FILEINFO_NAME
  integer(i_kind),save:: fileinfo_msize_=FILEINFO_INC   ! allocated size
  integer(i_kind),save:: fileinfo_lsize_=-1             ! actual size
  character(len=FILEINFO_LEN),dimension(:),pointer,save:: fileinfo_class_
  character(len=FILEINFO_LEN),dimension(:),pointer,save:: fileinfo_cnvrt_
  integer(i_kind)            ,dimension(:),pointer,save:: fileinfo_index_

! name/class    convert

contains
subroutine open_(unit,file,class,newunit,action,position,status,iostat,silent)
  implicit none
  integer(i_kind) ,intent(inout):: unit                 ! logical unit
  character(len=*),intent(in   ):: file                 ! filename
  character(len=*),optional,intent(in ):: class         ! file class of convert specifier
  logical         ,optional,intent(in ):: newunit       ! file class of convert specifier
  character(len=*),optional,intent(in ):: action        ! 'read', 'write', or 'readwrite'
  character(len=*),optional,intent(in ):: position      ! 'rewind', 'append', or 'asis'
  character(len=*),optional,intent(in ):: status        ! 'old', 'new', 'unknown', or 'scratch'
  integer(i_kind) ,optional,intent(out):: iostat        ! the return status
  logical         ,optional,intent(in ):: silent        ! not complain on missing fileinfo

  integer(i_kind):: iostat_
  logical        :: newunit_
  character(len=FILEINFO_LEN):: class_
  character(len=FILEINFO_LEN):: action_
  character(len=FILEINFO_LEN):: position_
  character(len=FILEINFO_LEN):: status_
  character(len=FILEINFO_LEN):: convert_
  character(len=*),parameter:: myname_=myname//'::open_'

  class_   ='.default.'; if(present(class   )) class_   =class
  action_  ='readwrite'; if(present(action  )) action_  =action
  position_='rewind'   ; if(present(position)) position_=position
  newunit_ =.false.    ; if(present(newunit )) newunit_ =newunit
  status_  ='unknown'  ; if(present(status  )) status_  =status

  if(present(iostat)) iostat=0

#ifdef _DO_NOT_SUPPORT_OPEN_WITH_CONVERT_
  convert_="_NOT_SUPPORTED_"    ! open(file with the compiler default convert
  if(newunit_) then
     open(newunit=unit,file=file,access='sequential',form='unformatted', &
        action=action_,position=position_,status=status_,iostat=iostat_)
  else
     open(   unit=unit,file=file,access='sequential',form='unformatted', &
        action=action_,position=position_,status=status_,iostat=iostat_)
  endif

#else
  convert_="_NOT_FOUND_"        ! set a difault value
  call lookup_(class_,convert_,silent=silent) ! may override convert value, if an entry of class_ is found.
  call lookup_(file  ,convert_,silent=silent) ! may override convert value, if an entry of file is found.

  select case(convert_)
  case("","_NOT_FOUND_")        ! open(file) with the compiler default convert
     if(newunit_) then
        open(newunit=unit,file=file,access='sequential',form='unformatted', &
           action=action_,position=position_,status=status_,iostat=iostat_)
     else
        open(   unit=unit,file=file,access='sequential',form='unformatted', &
           action=action_,position=position_,status=status_,iostat=iostat_)
     endif

  case default                  ! open(file) with user specified convert
     if(newunit_) then
        open(newunit=unit,file=file,access='sequential',form='unformatted', &
           action=action_,position=position_,status=status_,iostat=iostat_, &
           convert=convert_)
     else
        open(   unit=unit,file=file,access='sequential',form='unformatted', &
           action=action_,position=position_,status=status_,iostat=iostat_, &
           convert=convert_)
     endif
  end select
#endif

  if(iostat_/=0) then
     call perr(myname_,'open() error, iostat =',iostat_)
     call perr(myname_,'                unit =',unit)
     call perr(myname_,'                file =',trim(file))
     call perr(myname_,'              status =',trim(status_))
     call perr(myname_,'              action =',trim(action_))
     call perr(myname_,'            position =',trim(position_))
     call perr(myname_,'       FILEINFO_NAME =',trim(fileinfo_name_))
     call perr(myname_,'      fileinfo.class =',trim(class_))
     call perr(myname_,'    fileinfo.convert =',trim(convert_))

     if(.not.present(iostat)) call die(myname_)
     iostat=iostat_
     return
  endif
end subroutine open_

subroutine lookup_(class,convert,silent)
  implicit none
  character(len=*),intent(in   ):: class        ! class or filename itself
  character(len=*),intent(inout):: convert      ! may be override if an entry of class is found
  logical,optional,intent(in   ):: silent       ! not complain on missing fileinfo file

  character(len=*),parameter:: myname_=myname//'::lookup_'
  integer(i_kind):: l
  logical:: silent_
  silent_=.false.
  if(present(silent)) silent_=silent
  if(.not.fileinfo_initialized_) call init_(.not.silent_)

  if(fileinfo_lsize_<=0) return

  l=fileinfo_lsize_
  call lookitup_(l, fileinfo_index_(1:l), &
                    fileinfo_class_(1:l), &
                    fileinfo_cnvrt_(1:l), &
                    class, convert        )
end subroutine lookup_
!!!!!!!
subroutine reset_(fileinfo)
  implicit none
  character(len=*),optional,intent(in):: fileinfo       ! an alternate fileinfo name

        ! Reset fileinfo_name_, even if the fileinfo part has not been not
        ! initialized_.  So one can lookup() from a different fileinfo.
  fileinfo_name_= DEFAULT_FILEINFO_NAME
  if(present(fileinfo)) fileinfo_name_= fileinfo

        ! Initialization (init_()) is defered to the time an actual lookup().
  if(.not.fileinfo_initialized_) return

        ! Reset to the pre-init_() state, except fileinfo_name_
  fileinfo_initialized_ = .false.
  fileinfo_msize_       = FILEINFO_INC
  fileinfo_lsize_       = -1
  deallocate( fileinfo_class_, &
              fileinfo_cnvrt_, &
              fileinfo_index_  )
end subroutine reset_
subroutine init_(verbose)
  implicit none
  logical,intent(in):: verbose

! local variables
  integer(i_kind):: lu,ier,i,n

  character(len=FILEINFO_LEN):: classi
  character(len=FILEINFO_LEN):: cnvrti
  character(len=FILEINFO_REC):: arec

  character(len=FILEINFO_LEN),pointer,dimension(:):: p_class
  character(len=FILEINFO_LEN),pointer,dimension(:):: p_cnvrt
  character(len=*),parameter:: myname_=myname//'::init_'

  fileinfo_initialized_=.true.

  if(.not.CONVERT_SUPPORTED_.and.verbose) call warn(myname_,'Not supported, open(convert=..)')

        ! read in the fileinfo table anyway
  lu=mpeu_luavail()
  open(lu,file=fileinfo_name_,status='old',form='formatted',iostat=ier)
        if(ier/=0) then
#ifndef _DO_NOT_SUPPORT_OPEN_WITH_CONVERT_
           if(verbose) then
             call warn(myname_,'Can not open, file =',trim(fileinfo_name_))
             call warn(myname_,'Will use default convert values in code')
           endif
#endif

           fileinfo_lsize_=0
           allocate( fileinfo_class_(0), &
                     fileinfo_cnvrt_(0), &
                     fileinfo_index_(0)  )
           return
        endif

  n=fileinfo_msize_
  allocate( fileinfo_class_(n), &
            fileinfo_cnvrt_(n))

  i=0
  call mpeu_getarec(lu,arec,ier,commchar='#!')
  do while(ier==0)
     read(arec,*,iostat=ier) classi,cnvrti
                if(ier/=0) cnvrti=""

     i=i+1
     if(i>fileinfo_msize_) then  ! realloc()
        p_class => fileinfo_class_
        p_cnvrt => fileinfo_cnvrt_
        n=fileinfo_msize_+FILEINFO_INC
        allocate( fileinfo_class_(n), &
                  fileinfo_cnvrt_(n))

        fileinfo_class_(1:fileinfo_msize_)=p_class(:)
        fileinfo_cnvrt_(1:fileinfo_msize_)=p_cnvrt(:)

        fileinfo_msize_=n
        deallocate(p_class,p_cnvrt)
     endif

     fileinfo_class_(i)=classi
     fileinfo_cnvrt_(i)=cnvrti

     call mpeu_getarec(lu,arec,ier,commchar='#!')
  enddo

  fileinfo_lsize_=i
  close(lu)

  allocate(fileinfo_index_(fileinfo_lsize_))
  call indexSet (fileinfo_index_(1:fileinfo_lsize_))
  call indexSort(fileinfo_index_(1:fileinfo_lsize_), &
                 fileinfo_class_(1:fileinfo_lsize_), descend=.false.)

end subroutine init_

subroutine lookitup_(lsize_,index_,class_,cnvrt_,classi,convert)
  implicit none
  integer(i_kind) ,intent(in):: lsize_
  integer(i_kind) ,dimension(:),intent(in):: index_
  character(len=*),dimension(:),intent(in):: class_
  character(len=*),dimension(:),intent(in):: cnvrt_

  character(len=*),intent(in   ):: classi
  character(len=*),intent(inout):: convert

  logical:: done
  integer(i_kind):: lb,ub,i,l
  character(len=*),parameter:: myname_=myname//'::init_'

  done=.false.
  lb=1; ub=lsize_
  do while( .not. (done .or. ub<lb) )
     i=(lb+ub)/2
     l=index_(i)
     if    (classi<class_(l)) then
        ub=i-1
     elseif(classi>class_(l)) then
        lb=i+1
     else
        done=.true.
        convert=cnvrt_(l)
        exit
     endif
  enddo
  return
end subroutine lookitup_

end module gsi_unformatted