#undef DEBUG
c     
c     keyvalue version 4
c     update: 
c     version 4.6, Feb 24, 2006
c     version 3,  Feb 23, 2006 
c     
c     Copyright,  2004. 
c     Hiori Kino
c     
c     The distribution of this program package follows the practice of
c     the GNU General Public Licence (GPL).
c     
c     
c     
c     
      module keyvalue
      implicit none
      integer,private :: stdout=6

      integer,private,parameter:: maxstring=120
      character(6),private,parameter:: strform='(a120)'
      character(maxstring),private :: buf
      character(maxstring),private :: token(2)
      character(maxstring),allocatable,private :: vtoken(:)

      integer,private,parameter:: nlogical=14
      character(7),private:: logicalstr(nlogical)=
     i     (/'TRUE   ', 'OK     ', '.TRUE. ', 'YES    ','ON     ',
     i     '1      ', 'T      ',
     i     'FALSAE ', 'NG     ', '.FALSE.', 'NO     ','OFF    ',
     i     '0      ', 'F      '/)
      logical,private :: logicalvalue(nlogical) =
     i     (/.true.,.true.,.true.,.true.,.true.,.true.,.true.,
     i     .false.,.false.,.false.,.false.,.false.,.false.,.false./)
c     debug
      integer,private:: printlevel=0

c     
      interface getkeyvalue
      module procedure 
     i     getkeyvalue_i , getkeyvalue_r8 , getkeyvalue_l 
     i     , getkeyvalue_c
     i     , getkeyvalue_iv , getkeyvalue_rv
     i     , getkeyvalue_direct_i , getkeyvalue_direct_r8 , getkeyvalue_direct_l
     i     , getkeyvalue_direct_c
     i     , getkeyvalue_direct_iv , getkeyvalue_direct_rv
      end interface

      interface getkeyblock
      module procedure
     i     getkeyblock, getkeyblock_direct
      end interface

      interface  getkeyvalue_printunknown
      module procedure getkeyvalue_printunknown_filename,  getkeyvalue_printunknown_fileid
      end interface

      private:: unusedfid,input_delfirstspc,input_toupper,input_septoken,input_endkey
      private:: input_is_blockkey

      contains


c----------------------------------------------------------
c     unusedfid>0 if success
c     <0 if NG
c     
      integer function unusedfid()
      integer:: i
      logical ::L
c     find new unused file id

      do i=10,99
         inquire(i,opened=L)
         if (.not.L) then
            unusedfid=i
            return
         endif
      enddo
      
      unusedfid=-1

      end function unusedfid

c----------------------------------------------------------
      subroutine input_delfirstspc(buf)
      implicit none
      character(*):: buf


      buf=adjustl(buf)
c     cut comment
      if (buf(1:1).eq.'#' .or. buf(1:1).eq.'!') then
         buf=''
         return
      endif
      
c     do i=1,len_trim(buf)
c     if (buf(i:i).eq.'#' .or. buf(i:i).eq.'!') buf(i:)=''
c     enddo
      
      end subroutine input_delfirstspc

c-----------------------------------------------------------

      subroutine input_toupper(buf)
      implicit none
      character(*) :: buf
      integer:: i,n

      n=len_trim(buf)
      do i=1,n
         if (  ichar(buf(i:i)).ge.ichar('a') .and. 
     i        ichar(buf(i:i)).le.ichar('z')) then
            buf(i:i) = char(ichar(buf(i:i))+ichar('Z')-ichar('z'))
         endif
      enddo
      end subroutine input_toupper
      

c----------------------------------------------------------
      subroutine input_septoken(line,n,bufs)
      implicit none
      integer,intent(in):: n
      character(*),intent(in):: line
      character(*),intent(out):: bufs(n)

      integer::i,j,max,ibuf

      do i=1,n
         bufs(i)=' '
      enddo

      max=len_trim(line)
      if (printlevel>0)then
         write(*,*) max,line(:max)
      endif

      ibuf=0
      i=1
      do 
         do while (line(i:i).eq.' ') 
            i=i+1
            if (i>max) goto 1000
         enddo
         j=i+1
         do  while (line(j:j).ne.' ') 
            j=j+1
            if (j>max) exit
         enddo 
         j=j-1
         if (printlevel>0) then
            write(*,*) i,j,line(i:j)
         endif
         
         ibuf=ibuf+1
         bufs(ibuf)=line(i:j)
         if (ibuf>=n) goto 1000

         i=j+1
         if (i>max) goto 1000

      enddo

 1000 continue
      end  subroutine input_septoken
c-------------------------------------------------------------
      subroutine input_endkey(key)
      character(*) :: key
      integer::i,n

      n= len_trim(key)

      do i=n,1,-1
         key(i+1:i+1)= key(i:i)
      enddo

      key(1:1)=key(2:2)
      key(2:2)='/'

      end  subroutine input_endkey
c-------------------------------------------------------------
      logical function input_is_blockkey(key)
      character(*),intent(in):: key

      integer::i
      i=len_trim(key)
      if (i==0) then
         input_is_blockkey=.false.
         return
      endif
      if (key(1:1)=='<' .and. key(i:i)=='>') then
         input_is_blockkey=.true.
         return
      endif
      input_is_blockkey=.false.
      return 

      end function input_is_blockkey

c----------------------------------------------------------
      subroutine getkeyvalue_printunknown_fileid(fid, filename)
      use keyvalue_container, only:  keyvalue_container_findvar
      integer,intent(in) :: fid
      character(*),optional:: filename
      
      character(maxstring):: key 
      character(32):: this='getkeyvalue_printunused_fileid: '
      logical::flag

      rewind(fid)

      do while (.true.)

         read(fid,strform,end=9100,err=9100)  buf
#ifdef DEBUG
         write(*,*) buf
#endif
         call input_delfirstspc(buf)        
         if (buf(1:1)=='#') cycle

         call input_septoken(buf,2,token)
c         call input_toupper(token(1))
         if (len_trim(token(1))==0) cycle
         if (present(filename)) then
            flag = keyvalue_container_findvar(token(1),filename=filename)
         else
            flag = keyvalue_container_findvar(token(1),fileid=fid) 
         endif
         if ( .not.flag ) then
            key=token(1)
            if (present(filename)) then
               write(*,*) 'file=',filename(:len_trim(filename)),', unknown keyword=(',key(:len_trim(key)),')'
            else
               write(*,'(a,i4,2x,a,a,a)') 'fileID=',fid,'unknown keyword=(',key(:len_trim(key)),')'
            endif
         endif

         if (input_is_blockkey(token(1))) then
            key = token(1)
            call input_endkey(key)
            call input_toupper(key)
            do while (.true.)
               read(fid,strform,end=9100,err=9100) buf
               call input_delfirstspc(buf)
               call input_septoken(buf,2,token)
               call input_toupper(token(1))
               if (len_trim(token(1))==0) cycle
               if (token(1).eq.key) exit
            enddo
         endif

      enddo

 9100 continue
      return
 9000 continue
      return

      end subroutine getkeyvalue_printunknown_fileid

c----------------------------------------------------------
      subroutine getkeyvalue_printunknown_filename(filename)
      use keyvalue_container, only: keyvalue_container_findvar

      character(*),intent(in) ::filename
      character(33):: this='getkeyvalue_printunknown_fileid: '
      character(maxstring)::key
      integer::fid

      fid = unusedfid()

      if (fid<0) then
         write(*,*) this,'can not find fileID ',filename
         return
      endif

      open(file=filename,unit=fid,status='old',err=9000)

      call getkeyvalue_printunknown_fileid(fid,filename=filename)

      close(fid)
      return
 9000 continue
      write(*,*) this,'can not open a file',filename

      end subroutine getkeyvalue_printunknown_filename
c----------------------------------------------------------
      subroutine getkeyvalue_filename(filename, key0,n,token,status,this1,fileid)
      use keyvalue_container, only: keyvalue_container_addvar
      character(*),intent(in) :: filename
      character(*),intent(in) :: key0
      integer,intent(in)::n
      character(*),intent(out):: token(n)
      integer,intent(out) :: status
      character(*),intent(in)::this1
      integer,optional::fileid
      
      character(maxstring):: key 
      integer:: fid
      character(22):: this2='getkeyvalue_filename: '


      fid = unusedfid()

      if (fid<0) then
         write(*,*) this1,this2,'can not find fileID ',filename
         status=-1
         return
      endif

      open(file=filename,unit=fid,status='old',err=9000)

      call getkeyvalue_fileid(fid,key0,n,token,status,this2,filename)

      if (present(fileid)) then
              fileid = fid
      else
      select case(status)
      case(-1)
      case(1)
              close(fid)
      case(2)
              close(fid)
      end select
      endif
      return

 9000 continue
      write(*,*) this2,'ca not open a file', filename
      if (present(fileid)) fileid=-1

      end subroutine getkeyvalue_filename

c----------------------------------------------------------
      subroutine getkeyvalue_fileid(fid, key0,n,token,status,this1,filename)
      use keyvalue_container, only: keyvalue_container_addvar

      integer,intent(in) :: fid
      character(*),intent(in) :: key0
      integer,intent(in)::n
      character(*),intent(out):: token(:)
      integer,intent(out) :: status
      character(*),intent(in)::this1
      character(*),optional::filename
      
      character(maxstring):: key 
      character(22):: this2='getkeyvalue_filename: '

      if (present(filename))then
              call keyvalue_container_addvar(key0,filename=filename)
      else
              call keyvalue_container_addvar(key0,fileid=fid)
      endif

      rewind(fid)

      key=adjustl(key0)
      call input_toupper(key)
      
      do while (.true.)

         read(fid,strform,end=9100,err=9100)  buf
         call input_delfirstspc(buf)        
         if (buf(1:1)=='#') cycle

         call input_septoken(buf,n,token)
         call input_toupper(token(1))
c     write(*,*) token(1) 
         if ( token(1).eq.key ) then
c     read(token(2),*) var
            goto 9200
         endif

      enddo

 9100 continue
      status=2                  ! not found
      return

 9200 continue
      status=1                  ! found

      return

 9000 continue
      status=-1                 ! can not open the file

      end subroutine getkeyvalue_fileid


c----------------------------------------------------------
      subroutine getkeyvalue_i(filename, key0,var, default, status)
      character(*),intent(in) :: filename
      character(*),intent(in) :: key0
      integer,intent(out):: var
      integer,optional :: default
      integer,optional :: status
      
      character(15):: this='getkeyvalue_i: '
      integer::status0

      if (present(default)) then
         var = default
      endif

      call getkeyvalue_filename(filename,key0,2,token,status0,this)
                                ! implicit output: buf, token(:)
      select case(status0)
      case(-1)  
         continue
      case (1)  
         read(token(2),*,err=900) var
      case (2)                  ! not found , set default?
         if (present(default)) then 
            status0=0
         else
            status0=-1
         endif
      end select

      if (present(status)) status=status0
      return
 900  continue
      if (present(status)) status=-100

      end subroutine getkeyvalue_i

c----------------------------------------------------------
      subroutine getkeyvalue_r8(filename, key0,var, default, status)
      character(*),intent(in) :: filename
      character(*),intent(in) :: key0
      real(8),intent(out):: var
      real(8),optional :: default
      integer,optional :: status
      
      character(16)::  this='getkeyvalue_r8: '
      integer::status0

      if (present(default)) then
         var = default
      endif

      call getkeyvalue_filename(filename,key0,2,token,status0,this)
                                ! implicit output: buf, token(:)
      select case(status0)
      case(-1)
         continue
      case (1)
         read(token(2),*,err=900) var
      case (2)                  ! not found , set default?
         if (present(default)) then
            status0=0
         else
            status0=-1
         endif
      end select

      if (present(status)) status=status0
      return
 900  continue
      if (present(status)) status=-100

      end subroutine getkeyvalue_r8

c----------------------------------------------------------
      subroutine getkeyvalue_l(filename, key0,var, default, status)
      character(*),intent(in) :: filename
      character(*),intent(in) :: key0
      logical,intent(out):: var
      logical,optional :: default
      integer,optional :: status

      character(15):: this='getkeyvalue_l: '
      integer::status0,iname

      if (present(default)) var=default

      call getkeyvalue_filename(filename,key0,2,token,status0,this)
                                ! implicit output: buf, token(:)
      select case(status0)
      case(-1)
         continue
      case (1)
         status=-100
         call input_toupper(token(2))
         do iname=1,nlogical
            if ( token(2) .eq. logicalstr(iname) ) then
               var=  logicalvalue(iname)
               status0=1
               exit
            endif
         enddo

      case (2)                  ! not found , set default?
         if (present(default)) then
            status0=0
         else
            status0=-1
         endif
      end select

      if (present(status)) status=status0

      end subroutine getkeyvalue_l

c----------------------------------------------------------

      subroutine getkeyvalue_c(filename,key0,var, default,mode,status)
      character(*),intent(in) :: filename
      character(*),intent(in) :: key0
      character(*),optional:: var
      character(*),optional :: default
      character(*),optional :: mode
      integer,optional :: status

      character(15):: this='getkeyvalue_c: '
      integer::status0
      integer:: mode_flag
      character(maxstring)::key

      if (present(default)) then
         var = default
      endif

      key=adjustl(key0)

      mode_flag=0
      if (present(mode)) then
         if (mode=='all') then
            mode_flag=1
         endif
      endif
      call getkeyvalue_filename(filename,key0,2,token,status0,this)
                                ! implicit output: buf, token(:)
      select case(status0)
      case(-1)
         continue
      case (1)
         if (mode_flag==1) then
            var = adjustl(buf(len_trim(key)+1:) )
         else
            var=token(2)
         endif

      case (2)                  ! not found , set default?
         if (present(default)) then
            status0=0
         else
            status0=-1
         endif
      end select

      if (present(status)) status=status0

      end subroutine getkeyvalue_c
c-------------------------------------------------------------
      subroutine getkeyblock(filename,key0,unit,n,status)
      character(*),intent(in) :: filename
      character(*),intent(in) :: key0
      integer,intent(out):: unit
      integer,intent(out)::  n
      integer,optional:: status

      character(maxstring):: key
      integer:: fid,status0,tmpfid

      character(19)::this='getkeyvalue_block: '


      call getkeyvalue_filename(filename, key0,2,token,status0,this,fid)

      if (status0.ne.1) then

         close(fid)
         write(*,*) this,'can not find key ', key0
         n=0
         if (present(status)) status=-1
         return

      endif

 9200 key=key0
      call input_toupper(key)
      call input_endkey(key)
      tmpfid=unusedfid()
      open(tmpfid,status='scratch')
      n=0
      do while (.true.)
         read(fid,strform,end=9100,err=9100)  buf
         write(tmpfid,strform) buf
         call input_delfirstspc(buf)
         call input_septoken(buf,2,token)
         call input_toupper(token(1))
         if ( token(1).eq.key ) exit
         n=n+1
      enddo

c     call getkeyvalue_filename(filename, key0,2,token,status0,this,fid)


      if (status0.ne.1) then

         close(fid)
         write(*,*) this,'can not find key ', key0
         n=0
         if (present(status)) status=-1
         return

      endif

      if (present(status)) status=1
      unit = tmpfid
      rewind(tmpfid)
      return

 9100 write(*,*) this,'file ends abnormally ',filename
      n=0
      if (present(status)) status=-1

      end subroutine getkeyblock


c------------------------------------------------------------
      subroutine getkeyvalue_iv(filename, key0,var,n, default, status)
      character(*),intent(in) :: filename
      character(*),intent(in) :: key0
      integer,intent(in):: n
      integer,intent(out):: var(n)
      integer,optional :: default(n)
      integer,optional :: status
      
      character(16):: this='getkeyvalue_iv: '
      integer::status0,i

      allocate(vtoken(n+1) )

      if (present(default)) then
         var = default
      endif

      call getkeyvalue_filename(filename,key0,n+1,vtoken,status0,this)
                                ! implicit output: buf, token(:)
      select case(status0)
      case(-1)
         continue
      case (1)
         do i=1,n
            read(vtoken(i+1),*,end=9500,err=9500) var(i)
         enddo
         status0=n
      case (2)                  ! not found , set default?
         if (present(default)) then
            status0=0
         else
            status0=-1
         endif
      end select

      if (present(status)) status=status0
      if (allocated(vtoken)) deallocate(vtoken)
      return

 9500 write(stdout,*) this, 'can not read all the items for key ', key0
      if (present(status)) status= i
      if (allocated(vtoken)) deallocate(vtoken)

      end subroutine getkeyvalue_iv

c-------------------------------------------------------------
      subroutine getkeyvalue_rv(filename, key0,var,n, default, status)
      character(*),intent(in) :: filename
      character(*),intent(in) :: key0
      integer,intent(in):: n
      real(8),intent(out):: var(n)
      real(8),optional :: default(n)
      integer,optional :: status
      
      integer:: status0,i
      character(16):: this='getkeyvalue_rv: '

      allocate(vtoken(n+1) )
      if (present(default)) then
         var = default
      endif

      call getkeyvalue_filename(filename,key0,n+1,vtoken,status0,this)
                                ! implicit output: buf, token(:)
      select case(status0)
      case(-1)
         continue
      case (1)
         do i=1,n
            read(vtoken(i+1),*,end=9500,err=9500) var(i)
         enddo
         status0=n
      case (2)                  ! not found , set default?
         if (present(default)) then
            status0=0
         else
            status0=-1
         endif
      end select

      if (present(status)) status=status0
      if (allocated(vtoken)) deallocate(vtoken)
      return

 9500 write(stdout,*) this, 'can not read all the items for key ', key0
      if (present(status)) status= i
      if (allocated(vtoken)) deallocate(vtoken)

      end subroutine getkeyvalue_rv



c------------------------------------------------------------



c----------------------------------------------------------
      subroutine getkeyvalue_direct_i(fid, key0,var, default, status)
      integer,intent(in) :: fid
      character(*),intent(in) :: key0
      integer,intent(out):: var
      integer,optional :: default
      integer,optional :: status
      
      character(15):: this='getkeyvalue_i: '
      integer::status0

      if (present(default)) then
         var = default
      endif

      call getkeyvalue_fileid(fid,key0,2,token,status0,this)
                                ! implicit output: buf, token(:)
      select case(status0)
      case(-1)  
         continue
      case (1)  
         read(token(2),*,err=900) var
      case (2)                  ! not found , set default?
         if (present(default)) then 
            status0=0
         else
            status0=-1
         endif
      end select

      if (present(status)) status=status0
      return
 900  continue
      if (present(status)) status=-100
      end subroutine getkeyvalue_direct_i

c----------------------------------------------------------
      subroutine getkeyvalue_direct_r8(fid, key0,var, default, status)
      integer,intent(in) :: fid
      character(*),intent(in) :: key0
      real(8),intent(out):: var
      real(8),optional :: default
      integer,optional :: status
      
      character(16)::  this='getkeyvalue_r8: '
      integer::status0

      if (present(default)) then
         var = default
      endif
      call getkeyvalue_fileid(fid,key0,2,token,status0,this)
                                ! implicit output: buf, token(:)
      select case(status0)
      case(-1)
         continue
      case (1)
         read(token(2),*) var
      case (2)                  ! not found , set default?
         if (present(default)) then
            status0=0
         else
            status0=-1
         endif
      end select

      if (present(status)) status=status0
      return
 900  continue
      if (present(status)) status=-100

      end subroutine getkeyvalue_direct_r8

c----------------------------------------------------------
      subroutine getkeyvalue_direct_l(fid, key0,var, default, status)
      integer,intent(in) :: fid
      character(*),intent(in) :: key0
      logical,intent(out):: var
      logical,optional :: default
      integer,optional :: status

      character(15):: this='getkeyvalue_l: '
      integer::status0,iname

      if (present(default)) then
         var = default
      endif

      call getkeyvalue_fileid(fid,key0,2,token,status0,this)
                                ! implicit output: buf, token(:)
      select case(status0)
      case(-1)
         continue
      case (1)
         status0=-1
         do iname=1,nlogical
            if ( token(2) .eq. logicalstr(iname) ) then
               var=  logicalvalue(iname)
               status0=1
               exit
            endif
         enddo

      case (2)                  ! not found , set default?
         if (present(default)) then
            status0=0
         else
            status0=-1
         endif
      end select

      if (present(status)) status=status0
      return
 900  continue
      if (present(status)) status=-1

      end subroutine getkeyvalue_direct_l

c----------------------------------------------------------

      subroutine getkeyvalue_direct_c(fid,key0,var, default,mode,status)
      integer,intent(in) :: fid
      character(*),intent(in) :: key0
      character(*),optional:: var
      character(*),optional :: default
      character(*),optional :: mode
      integer,optional :: status

      character(15):: this='getkeyvalue_c: '
      integer::status0
      integer:: mode_flag

      if (present(default))then
         var = default
      endif

      mode_flag=0
      if (present(mode)) then
         if (mode=='all') then
            mode_flag=1
         endif
      endif

      call getkeyvalue_fileid(fid,key0,2,token,status0,this)
                                ! implicit output: buf, token(:)
      select case(status0)
      case(-1)
         continue
      case (1)
         var = token(2)

      case (2)                  ! not found , set default?
         if (present(default)) then
            status0=0
         else
            status0=-1
         endif
      end select

      if (present(status)) status=status0
      
      end subroutine getkeyvalue_direct_c
c-------------------------------------------------------------
      subroutine getkeyblock_direct(fid,key0,unit,n,status)
      integer,intent(in) :: fid
      character(*),intent(in) :: key0
      integer,intent(out):: unit
      integer,intent(out)::  n
      integer,optional:: status

      character(maxstring):: key

      character(26)::this='getkeyvalue_block_direct: '
      integer::status0,tmpfid

      unit=-1

      call getkeyvalue_fileid(fid, key0,2,token,status0,this)

      if (status0.ne.1) then
         write(*,*) this,'can not find key ', key0
         n=0
         if (present(status)) status=-1
         return
      endif

 9200 key=key0
      call input_toupper(key)
      call input_endkey(key)
      tmpfid=unusedfid()
#ifdef DEBUG
      write(*,*) 'tmpfid=',tmpfid
#endif
      open(tmpfid,status='scratch')
      n=0
      do while (.true.)
         read(fid,strform,end=9100,err=9100)  buf
         write(tmpfid,strform) buf
         call input_delfirstspc(buf)
         call input_septoken(buf,2,token)
         call input_toupper(token(1))
         if ( token(1).eq.key ) exit
         n=n+1
      enddo

c     call getkeyvalue_fileid(fid, key0,2,token,status0,this)

      if (status0.ne.1) then
         write(*,*) this,'can not find key ', key0
         n=0
         if (present(status)) status=-1
         return
      endif


      if (present(status)) status=1
      unit = tmpfid
      rewind(tmpfid)
      return

 9100 continue
      write(*,*) this,'file abnormally ends',fid
      if (present(status)) status=-1 
      n=0

      return

      end subroutine getkeyblock_direct


c------------------------------------------------------------
      subroutine getkeyvalue_direct_iv(fid, key0,var,n, default, status)
      integer,intent(in) :: fid
      character(*),intent(in) :: key0
      integer,intent(in):: n
      integer,intent(out):: var(n)
      integer,optional :: default(n)
      integer,optional :: status
      
      character(maxstring):: key 
      integer:: i,status0
      character(16):: this='getkeyvalue_iv: '


      allocate(vtoken(n+1) )

      if (present(default)) then
         var = default
      endif

      call getkeyvalue_fileid(fid,key0,n+1,vtoken,status0,this)
                                ! implicit output: buf, token(:)
      select case(status0)
      case(-1)
         continue
      case (1)
         do i=1,n
            read(vtoken(i+1),*,end=9500,err=9500) var(i)
         enddo
         status0=n
      case (2)                  ! not found , set default?
         if (present(default)) then
            status0=0
         else
            status0=-1
         endif
      end select

      if (present(status)) status=status0
      if (allocated(vtoken)) deallocate(vtoken)
      return

 9500 write(stdout,*) this, 'can not read all the items for key ', key0
      if (present(status)) status= i
      if (allocated(vtoken)) deallocate(vtoken)


      end subroutine getkeyvalue_direct_iv

c-------------------------------------------------------------
      subroutine getkeyvalue_direct_rv(fid, key0,var,n, default, status)
      integer,intent(in) :: fid
      character(*),intent(in) :: key0
      integer,intent(in):: n
      real(8),intent(out):: var(n)
      real(8),optional :: default(n)
      integer,optional :: status
      
      character(maxstring):: key 
      integer:: i,status0
      character(16):: this='getkeyvalue_rv: '


      allocate(vtoken(n+1) )

      if (present(default)) then
         var = default
      endif

      call getkeyvalue_fileid(fid,key0,n+1,vtoken,status0,this)
                                ! implicit output: buf, token(:)
      select case(status0)
      case(-1)
         continue
      case (1)
         do i=1,n
            read(vtoken(i+1),*,end=9500,err=9500) var(i)
         enddo
         status0=n
      case (2)                  ! not found , set default?
         if (present(default)) then
            status0=0
         else
            status0=-1
         endif
      end select

      if (present(status)) status=status0
      if (allocated(vtoken)) deallocate(vtoken)
      return

 9500 write(stdout,*) this, 'can not read all the items for key ', key0
      if (present(status)) status= i
      if (allocated(vtoken)) deallocate(vtoken)


      end subroutine getkeyvalue_direct_rv



c------------------------------------------------------------

      end module keyvalue

c-----------------------------------------------------------

#if  1
      program main
      use keyvalue
      use keyvalue_container
      implicit none
      integer :: ikey, ret, ivkey(10),unit,i
      real(8):: rkey, rvkey(10),rvkeydefault(10)
      logical :: lkey
      character(200):: ckey

      character(20)::filename
      integer:: fid=10

c     when you want to read from stdin 
#if 1
c     open a scratch file
      open(fid,status='scratch')
      write(*,*) 'open fid=',fid
c     read from stdin and write to the scratch file
      do while(.true.)
         read(5,'(a200)',end=501) ckey
         write(fid,'(a200)') ckey
      enddo
 501  continue

c     getkeyvalue|getkeyblock rewinds the file automatically

      call getkeyvalue(fid,"nsite",ikey,status=ret)
      write(*,*) 'nsite=',ret,'val=',ikey

      call getkeyvalue(fid,"title",ckey,mode='all')
      write(*,*) 'val=',ckey(:len_trim(ckey))

      call getkeyblock(fid,"<block_foo>", unit=unit, n=ikey, status=ret)
      write(*,*) "<block_foo>",ret, ikey, unit
      do i=1,ikey
         read(unit,'(a80)') ckey
         write(*,*)ckey(:len_trim(ckey))
      enddo
      write(*,*)'closing fid=',unit
      close(unit)               ! <= do not forget closing it.

c      call keyvalue_container_printall()
      write(*,*) 'fid=',fid
      call  getkeyvalue_printunknown(fid)

      close(fid)                ! <= close the scratch file
#endif

c===============
c     read from file 'IN'

      filename='IN' 
      call getkeyvalue(filename,"int",ikey,status=ret) !<= integer
      write(*,*) "int",ret,'val=',ikey

      call getkeyvalue(filename,"real",rkey,default=-100.0d0,status=ret) !<= real
      write(*,*) "real",ret,'val=',rkey

      call getkeyvalue(filename,"logical",lkey,status=ret ) !<= logical
      write(*,*) "logical",ret,'val=',lkey

      call getkeyvalue(filename,"str",ckey,status=ret) !<= a word
      write(*,*) "str",ret,'val=',ckey(:len_trim(ckey))

      call getkeyvalue(filename,"title",ckey,status=ret,mode='all') !<= all the words
      write(*,*) "title",ret,'val=',ckey(:len_trim(ckey))

      call getkeyvalue(filename,"intv",ivkey,n=5,status=ret ) !<= vector of integer
      write(*,*) "intv",ret,'val=',ivkey(1:5)

      call getkeyvalue(filename,"realv",rvkey,n=3,status=ret ) !<= vector of real 
      write(*,*) "realv",ret,'val=',rvkey(1:3)

c     You can use default values
      rvkeydefault(1:3)=(/-1.0d0, -2.0d0, -3.0d0/)
      call getkeyvalue(filename,"target_temperature_set",rvkey,n=3,default=rvkeydefault,status=ret )
      write(*,*) "target_temperature_set",ret,'val=',rvkey(1:3)

      call getkeyvalue(filename,"real3", rkey,default=100.01d0,status=ret)
      write(*,*) "real3",ret,'val=',rkey


c     an example to read block structure     
      call getkeyblock(filename,"<block>", unit=unit, n=ikey, status=ret)
      write(*,*) "<block>",ret, ' n=',ikey,' unit=', unit
      do i=1,ikey
         read(unit,'(a80)') ckey
         write(*,*)ckey(:len_trim(ckey))
      enddo
      close(unit)               !<= do not forget closing it
      write(*,*) 'close unit=',unit

      call getkeyvalue(filename,"Final_Temperature",rkey,default=500.0d0,status=ret)
      write(*,*) "final temperature",ret,'val=',rkey
      call getkeyvalue(filename,"Velocity",rkey,default=-500.0d0,status=ret)
      write(*,*) "velocity",ret,'val=',rkey

c      call  keyvalue_container_printall()
      call  getkeyvalue_printunknown(filename)

      end program main

#endif

c     The data in the <blockname> is a bit special because getkeyvalue just returns
c     file hundle (and line numbers.) to read the contents. 
c     In order to use getkeyvalue, you first have to declear "use keyvalue".
c     See main/kino_input_test.f with filename file to see how it works.
c     
c     1.      call getkeyvalue(filename,"int_1",ikey,default=999,status=ret )
c     2.      call getkeyvalue(filename,"delta",rkey,default=1430d0,status=ret)
c     
c     3.     logical:: lkey
c     call getkeyvalue(filename,"L_test",lkey,status=ret )
c     
c     4.     integer(4):: ivkey(5),nsize=5
c     call getkeyvalue(filename,"n1n2n3",ivkey,nsize,status=ret )
c     
c     5.     real(8):: rvkey(3) 
c     integer(4)::nsize=3
c     call getkeyvalue(filename,"vv", rvkey,nsize,status=ret,
c     &                 default=(/10.0d0,10.0d0,10.0d0/))
c     : Note nsize is required. If default is not assigned, this cause stop 
c     within getkeyvalue.
c     
c     6.    call getkeyvalue(filename,"char", ckey, status=ret)
c     7.    call getkeyblock(filename,"<blockname>",unit=file,n=nlines,status=ret)
c     : unit is the file handle to read contants sandwitched by
c     <blockname> and </blockname>. nlines= number of the lines.
c     
c     
c     ret>0: ret is the number of variables succesfully read
c     ret=0: no key found in filename, but variables are set from "default" 
c     
c     ret<0: no key found in "IN, and no default variables are set. (This case is an error.)
c     
c     


c     a sample IN file
#if 0
      int 1
      real 2.0
      logical true
      intv    1 2 3  4 5 6 7
      realv  1.0 2.0 3.0 4.0
      <block>
      test
      test22
      </block> 

## method.scf    simple   #<- comment
c     har test1.dat

      filename Kondo.dat
      temperature 300

#endif



