module vTable
   implicit none
   private

   public :: varTable

   integer, parameter :: stderr = 0
   integer, parameter :: stdin  = 5
   integer, parameter :: stdout = 6
   integer, parameter :: StrLen = 512
   type baseTable
      integer(kind = 4)   :: kpds_
      character(len =  4) :: name_
      character(len = 45) :: desc_
      character(len = 20) :: unit_
      character(len = 10) :: type_
      type(baseTable), pointer :: next => null()
   end type baseTable

   type varTable
      private
      integer(kind = 4) :: nVars
      type(baseTable), pointer :: headTable => null()
      type(baseTable), pointer :: tailTable => null()
      contains
         private
         procedure, public :: insert
         procedure, public :: findByPDS
         procedure, public :: findByName
         procedure, public :: findByDesc
         procedure, public :: print
   end type varTable

   contains

   subroutine insert(this, kpds, name, desc, unit, type)
      class(varTable)    :: this
      integer(kind = 4)  :: kpds
      character(len = *) :: name
      character(len = *) :: desc
      character(len = *) :: unit
      character(len = *) :: type

      type(baseTable), pointer :: tmpTable => null()

      allocate(tmpTable)
      tmpTable%kpds_ = kpds
      tmpTable%name_ = adjustl(trim(name))
      tmpTable%desc_ = adjustl(trim(desc))
      tmpTable%unit_ = adjustl(trim(unit))
      tmpTable%type_ = adjustl(trim(type))

      if (.not.associated(this%headTable))then
         this%nVars = 1
         this%headTable => tmpTable
         this%tailTable => tmpTable
      else
         this%nVars = this%nVars + 1
         this%tailTable%next => tmpTable
         this%tailTable => this%tailTable%next
      endif

   end subroutine

   function tableConstructor(kpds, name, desc, unit, type)
      type(varTable) :: tableConstructor
      integer(kind = 4)  :: kpds
      character(len = *) :: name
      character(len = *) :: desc
      character(len = *) :: unit
      character(len = *) :: type

      call tableConstructor%insert(kpds, name, desc, unit, type)

   end function

   subroutine print(this)
      class(varTable) :: this

      type(baseTable), pointer :: tmpTable => null()

      if (associated(this%headTable))then
         write(stdout,'(1x,A,1x,I6,1x,A)')'There is :', this%nVars, 'variables in this table!'

         tmpTable => this%headTable
         do while(associated(tmpTable))
            write(stdout,'(1x,I4,1x,A4,1x,A45,1x,A20,1x,A10)')&
            tmpTable%kpds_, &
            trim(tmpTable%name_),&
            trim(tmpTable%desc_),&
            trim(tmpTable%unit_),&
            trim(tmpTable%type_)

            tmpTable => tmpTable%next                          
         end do
      else
         write(stdout,'(1x,A)')'Empty table!'
      endif

   end subroutine

   function findByPDS(this, kpds, table)result(istatus)
      class(varTable),    intent(in   ) :: this
      integer,            intent(in   ) :: kpds
      character(len = *), intent(  out) :: table(4)
      integer                           :: istatus

      type(baseTable), pointer :: tmpTable => null()

      istatus = 0
      if (associated(this%headTable))then
         tmpTable => this%headTable
         do while(associated(tmpTable))
            if (kpds .eq. tmpTable%kpds_)then
               table(1) = trim(adjustl(tmpTable%name_))
               table(2) = trim(adjustl(tmpTable%desc_))
               table(3) = trim(adjustl(tmpTable%unit_))
               table(4) = trim(adjustl(tmpTable%type_))
               return
            endif
            tmpTable => tmpTable%next
         enddo
         write(stderr,'(A,1x,I4)')'Variable not found:',kpds
         table(1:4) = 'UNKNOWN'
         istatus = -1
      else
         write(stdout,'(1x,A)')'Empty table!'
         table(1:4) = 'UNKNOWN'
         istatus    = -2
      endif
      return
   end function

   function findByName(this, name, table)result(istatus)
      class(varTable),    intent(in   ) :: this
      character(len = *), intent(in   ) :: name
      character(len = *), intent(  out) :: table(4)
      integer                           :: istatus

      character(len=strlen)  :: InqName
      character(len=strlen)  :: FldName
      type(baseTable), pointer :: tmpTable => null()

      istatus = 0

      InqName = trim(adjustl(lcase(Name)))

      if (associated(this%headTable))then
         tmpTable => this%headTable
         do while(associated(tmpTable))
            fldName = trim(adjustl(lcase(tmpTable%name_)))
            if (trim(inqName) .eq. trim(fldName))then
               table(1) = trim(adjustl(tmpTable%name_))
               table(2) = trim(adjustl(tmpTable%desc_))
               table(3) = trim(adjustl(tmpTable%unit_))
               table(4) = trim(adjustl(tmpTable%type_))
               return
            endif
            tmpTable => tmpTable%next
         enddo
         write(stderr,'(A,1x,A)')'Variable not found:',trim(adjustl(Name))
         table(1:4) = 'UNKNOWN'
         istatus = -1
      else
         write(stdout,'(1x,A)')'Empty table!'
         table(1:4) = 'UNKNOWN'
         istatus    = -2
      endif
      return
   end function

   function findByDesc(this, Desc, table)result(istatus)
      class(varTable),    intent(in   ) :: this
      character(len = *), intent(in   ) :: Desc
      character(len = *), intent(  out) :: table(4)
      integer                           :: istatus

      character(len=strlen)  :: InqName
      character(len=strlen)  :: FldName
      type(baseTable), pointer :: tmpTable => null()

      istatus = 0

      InqName = trim(adjustl(lcase(Desc)))

      if (associated(this%headTable))then
         tmpTable => this%headTable
         do while(associated(tmpTable))
            fldName = trim(adjustl(lcase(tmpTable%desc_)))
            if (trim(inqName) .eq. trim(fldName))then
               table(1) = trim(adjustl(tmpTable%name_))
               table(2) = trim(adjustl(tmpTable%desc_))
               table(3) = trim(adjustl(tmpTable%unit_))
               table(4) = trim(adjustl(tmpTable%type_))
               return
            endif
            tmpTable => tmpTable%next
         enddo
         write(stderr,'(A,1x,A)')'Variable not found:',trim(adjustl(Desc))
         table(1:4) = 'UNKNOWN'
         istatus = -1
      else
         write(stdout,'(1x,A)')'Empty table!'
         table(1:4) = 'UNKNOWN'
         istatus    = -2
      endif
      return
   end function
!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: lower_case - convert uppercase letters to lowercase.
!
! !DESCRIPTION:
!
! !INTERFACE:

  function lcase(str) result(lstr)
    implicit none
    character(len=*), intent(in) :: str
    character(len=len(str))      :: lstr

! !REVISION HISTORY:
! 	13Aug96 - J. Guo	- (to do)
!EOP
!-----------------------------------------------------------------------
    integer i
    integer,parameter :: iu2l=ichar('a')-ichar('A')

    lstr=str
    do i=1,len_trim(str)
      if(str(i:i).ge.'A'.and.str(i:i).le.'Z')	&
      	lstr(i:i)=char(ichar(str(i:i))+iu2l)
    end do
  end function lcase
end module vTable