module UtilMod
   use m_string
   use sigio_BAMMod, only: BAMfile, bam_fld
   use MiscMod, only: getLongitudes, getGaussianLatitudes, getiMaxjMax
   use typeKinds, only: r8 => Double
   use vTable

   implicit none
   integer, parameter :: stderr = 0
   integer, parameter :: stdin  = 5
   integer, parameter :: stdout = 6
   integer, parameter :: MaxLU  = 255
   integer, parameter :: StrLen = 512
   real,    parameter :: ps     = 1000.0

   type :: fldInfo
      character(len = 60) :: fname
      integer             :: nlevs
      type(fldInfo), pointer :: next => null()
   end type


   contains

   subroutine writectl(bam, mEnd, pathOut, varName, istatus)
      type(BAMFile),              intent(in   ) :: bam
      integer,                    intent(in   ) :: mEnd
      character(len=*),           intent(in   ) :: pathOut
!      character(len=*), optional, intent(in   ) :: varName(:)
      type(fldInfo),  pointer,  optional, intent(in   ) :: varName
      integer,          optional, intent(  out) :: istatus

      type(BAM_fld), pointer  :: Fld => null()
      integer :: lu
      integer :: f
      integer :: i
      integer :: nFields
      integer :: nLevs
      integer :: nymd, nhms
      integer :: itmp
      integer :: iret
      character(len=StrLen) :: info(4)
      character(len=StrLen) :: VName
      character(len=StrLen) :: timefmt
      character(len=StrLen) :: filectl


      integer :: iMax, jMax, kMax
      real(r8), allocatable :: coord(:)
      real(r8), allocatable :: vcoord(:)
      real(r8), allocatable :: ak(:), bk(:)
      type(fldInfo), pointer :: fields => null()

      include 'varTable.f90'

      !
      !
      !
      i=index(bam%fBin,'/',.true.) + 1
      filectl=trim(bam%fBin(i:len_trim(BAM%fBin)))
      
      lu = luavail()
      open(unit   = lu,                   &
           File   = trim(pathOut)//'/'//trim(fileCtl)//'.ctl',&
           form   = 'Formatted',          &
           status = 'unknown')


      write(lu,'(A4,1x,A1,A)')'dset','^',trim(adjustl(filectl))//'.gs4r'
      write(lu,'(A)')'undef 9.999E+20'
      write(lu,'(A)')'options yrev sequential big_endian'
      call getiMaxjMax(mEnd, iMax, jMax)

      !XDEF
      allocate(coord(iMax))
      call getLongitudes(iMax, 0.0_r8, coord)

      write(lu,'(A4,1x,I6,1x,A,2F15.6)')'xdef',iMax,'linear',minval(coord(:)),&
      abs(coord(2)-coord(1))

      deallocate(coord)

      !YDEF
      allocate(coord(jMax))
      call getGaussianLatitudes(jMax, coord)
      coord(jMax:1:-1) = coord(1:jMax)
      write(lu,'(A4,1x,I6,1x,A,8(F15.6))')'ydef',jMax,'levels', coord
!      write(lu,'(A4,1x,I6,1x,A)')'ydef',JMax,'levels'
      deallocate(coord)

      !ZDEF
      kMax = bam%getOneDim('kmax')
      allocate(vcoord(kMax))
      if (bam%isHybrid)then

         allocate(ak(kmax+1))
         allocate(bk(kmax+1))

         call bam%getVerticalCoord('ak',ak)
         call bam%getVerticalCoord('bk',bk)
 
         do i=1,kmax
            vcoord(i) = (ak(i)/100.0) + bk(i)*ps
         enddo
         write(lu,'(A4,1x,I6,1x,A,8(F15.6))')'zdef',KMax,'levels', vcoord

         deallocate(ak)
         deallocate(bk)

      else
         call bam%GetVerticalCoord('SL', vcoord)
         write(lu,'(A4,1x,I6,1x,A,8(F15.6))')'zdef',KMax,'levels', vcoord
      endif
      deallocate(vcoord)

      !TDEF
      timefmt='%h2Z%d2%MC%y4'

      nymd = bam%GetTimeInfo('fyr') * 10000
      nymd = nymd + bam%GetTimeInfo('fmo') * 100
      nymd = nymd + bam%GetTimeInfo('fdy')
      nhms = bam%GetTimeInfo('fhr') * 10000

      call Str_Template(timefmt,nymd,nhms)


      write(lu,'(A,1x,A,1x,A3)')'tdef     1 linear',trim(timefmt),'6hr'

      !
      ! vars section
      !
      if(present(varName))then
         Fields => varName
         nFields = 0
         do while(associated(Fields))
            nFields = nFields + 1
            Fields => Fields%next
         enddo
         write(lu,'(A4,1x,I3)')'vars',nFields

         Fields => varName
         do while(associated(Fields))
            vName = trim(adjustl(fields%fName))
            NLevs = fields%nLevs
            if(NLevs .eq. 1 ) NLevs = 0
            iret  = varInfo%findByDesc(vName, info)
            write(lu,'(A4,1x,I2,1x,A2,1x,A40)')adjustl(info(1)),NLevs,'99',adjustl(info(2))
            fields => fields%next
         enddo
      else
         write(lu,'(A4,1x,I3)')'vars',BAM%fcount
         fld => bam%root
         DO f=1,bam%fcount
            vName = trim(adjustl(fld%name))
            NLevs = bam%GetNlevels(trim(vName),istatus)
            if(NLevs .eq. 1 ) NLevs = 0
            iret  = varInfo%findByDesc(vName, info)
            write(lu,'(A4,1x,I2,1x,A2,1x,A40)')adjustl(info(1)),NLevs,'99',adjustl(info(2))
            fld => fld%next
         ENDDO
      endif
      write(lu,'(A7)')'endvars'
      write(lu,'(A1)')

   end subroutine

   function luavail() result(lu)
      integer :: lu
      integer :: i
      logical :: inuse

      lu    = -1
      inuse = .true.

      do i = 0,  MaxLU

         ! Test #1, reserved

	      inuse = i.eq.stdout .or. i.eq.stdin .or. i.eq.stderr

         ! Test #2, in-use

         if(.not.inuse) inquire(unit=i,opened=inuse)

         ! Apply i to lu
         if(.not.inuse) then
            lu = i
            exit
         endif

         ! if lu is MaxLU and not available too         
         if(inuse.and.(lu.eq.MaxLU)) lu = -1

      enddo

   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