!
      module flist
      implicit none
      contains
!-------------------------------------------------------------------
      integer function shiftblanks(names,lenstr,nnames)
        implicit none
!
! Collapse non-blank elements of names to front of names,
! (blank elements to rear) return number of non-blank elements.
!
! 4/14/04 btf: added args lenstr and nnames for Linux pgf90 compiler
!              (see also getflds.F)
!
      integer,intent(in) :: nnames,lenstr
      character(len=lenstr),intent(inout) :: names(nnames)
      character(len=lenstr) :: newnames(nnames)
      integer :: i,ii
!
      shiftblanks = count(names/=' ')

!     write(6,"('shiftblanks: lenstr=',i3,' shiftblanks=',i3,
!    |  ' nnames=',i3,' names=',/,(8a8))") lenstr,shiftblanks,
!    |  nnames,names

!
! 3/22/06 btf: Code compiled with xlf90 -g -C core dumps on the
! intrinsic pack() here (pgf90 -g -Mbound is ok):
!
!     newnames = pack(names,names/='        ')
      
      newnames = ' ' ! whole-array init
      ii = 0
      do i=1,nnames
        if (len_trim(names(i)) > 0) then
          ii=ii+1
          newnames(ii) = names(i)
        endif
      enddo ! i=1,nnames

!     write(6,"('shiftblanks after pack: newnames=',/,(8a8))")
!    |  newnames

      names = newnames
      if (shiftblanks < size(names))
     +  names(shiftblanks+1:size(names)) = '        '
      end function shiftblanks
!-------------------------------------------------------------------
      integer function deredund(names)
        implicit none
!
! Remove redundancy among elements of names, replacing
! redundant elements w/ blanks, and moving all blanks
! to rear. Return number of non-blank elements.
!
        character(len=*),intent(inout) :: names(:)
        integer :: ii,i,n
        if (.not.any(names/=' ')) then
          deredund = 0
          return
        endif
        n = shiftblanks(names,len(names(1)),size(names))
        do i=1,n-1
          do ii=i+1,n
            if (names(ii)==names(i)) names(ii)=' '
          enddo
        enddo
        n = shiftblanks(names,len(names(1)),size(names))
        deredund = count(names/=' ')
      end function deredund
!-------------------------------------------------------------------
      recursive subroutine getdep(f,fdep,reset,include_derived)
!
! Return list of dependencies required to calculate field f.
! Dependency list is returned in fdep.
!
!     use fields,only: field,flds_known
      use fields
      implicit none
!
! Args:
      type(field),intent(in) :: f
      character(len=*),intent(inout) :: fdep(:)
      integer,intent(in) :: reset,include_derived
!
! Locals:
      integer :: i,ix
      integer,save :: nfdep
      integer,external :: ixfindc
!
      if (reset>0) then
        nfdep = 0
        fdep = '        '
      endif
      if (.not.associated(f%fneed)) then
        write(6,"('>>> WARNING getdep: f%fneed not associated ',
     +    'for field ',a)") f%fname8
      endif
      floop: do i=1,size(f%fneed)
        ix = ixfindc(flds_known%fname8,size(flds_known),f%fneed(i))
        if (ix<=0) then
          write(6,"('>>> WARNING getdep: unknown dependency ',
     +      a,' for field ',a)") f%fneed(i),f%fname8
          cycle floop
        endif
!
! This routine is called recursively if a dependency for a derived
! field is itself a derived field. This appears to be working, but
! only tested for one nesting depth (e.g., N2 needed for E5577)
!
        if (flds_known(ix)%derived) then
          if (include_derived>0) then
            nfdep = nfdep+1 
            fdep(nfdep) = flds_known(ix)%fname8
          endif
          call getdep(flds_known(ix),fdep,0,include_derived)
        else
          nfdep = nfdep+1 
          fdep(nfdep) = f%fneed(i)
        endif
      enddo floop
      nfdep = deredund(fdep)
      end subroutine getdep
!-------------------------------------------------------------------
      recursive subroutine getder(f,fder,reset)
!
! Return list of derived fields, if any, required to calculate
! field f.
!
      use fields
      implicit none
!
! Args:
      type(field),intent(in) :: f
      character(len=*),intent(inout) :: fder(:)
      integer,intent(in) :: reset
!
! Locals:
      integer,save :: nfder
      integer :: nfdep,ix,ixknown
      integer,external :: ixfindc
!
      if (reset > 0.or..not.f%derived) then
        nfder = 0
        fder = ' '
        if (.not.f%derived) return
      endif
      if (.not.associated(f%fneed)) then
        nfder = 0
        fder = ' '
      endif
!
! Loop through f's dependencies, picking out derived dependencies:
      nfdep = size(f%fneed)
      deploop: do ix=1,nfdep
        ixknown = ixfindc(flds_known%fname8,size(flds_known),
     +    f%fneed(ix))
        if (ixknown <= 0) cycle deploop
        if (flds_known(ixknown)%derived) then
          nfder = nfder+1
          fder(nfder) = flds_known(ixknown)%fname8
          call getder(flds_known(ixknown),fder,0)
        endif
      enddo deploop
      nfder = deredund(fder) 
!     write(6,"('exit getder: f=',a,' nfder=',i2,' fder=',/(8a8))")
!    +  f%fname8,nfder,fder(1:nfder)
      end subroutine getder
      end module flist