*
*----------------------------------------------------------------
*
c
	subroutine fnc_upk(e_raw,t_raw,ierr)
c
c  unpack raw FNC times and enegies from FNTENE and PTTENE banks
c
c  author: bill schmidke 21.05.96
c
c  update: 18.07.96	expand COEN into TENE banks,
c			allow more channels from PTTENE,
c			generally cleaned up.	- b.s.
c
c	   06.02.97	accomodate for bizarre MC counter numbering. - b.s.
c
c	   26.08.97	check PMNr in range (usually corrupt data)
c			improved error codes
c
c	   06.10.97	no error if no FNTENE for MC
c
c          19.12.97     fix bug, check PMNr range only for data
c
c	   02.02.98	one more time:
c			never an error when FNTENE/FNCOEN empty to
c			  account for 'missing' FNCOEN in 96 MDST
c			only check FNTENE_PMNr for DATA
c
c	   20.08.98	and again:
c			extend for FNT channels, and read out PRT too
c			(still no error flagging if PT banks missing, corrupt)
c			ignore muon counters in MC
c
c  output: e_raw(max_FNC) - energy raw data ('pC')
c          t_raw(max_FNC) - time raw data (nS)
c		     ierr - = 0, FNTENE/FNCOEN o.k.
c		            = 1, error in fncoen_2_fntene (corrupt data)
c		            = 2, PMNr out of range in FNTENE (corrupt data)
c
	implicit none
c
	integer ierr
	integer max_FNTENE,max_PTTENE,max_FNC
	parameter (max_FNTENE = 72)
	parameter (max_PTTENE = 24)
	parameter (max_FNC=max_FNTENE+max_PTTENE)
	real e_raw(max_FNC),t_raw(max_FNC)
c
#include "partap.inc"
#include "fntene.inc"
#include "pttene.inc"
c
	integer i
c
	integer PMNr,i_energy,i_time
c
	character*4 GENKEY_ARG
c
c
	ierr = 0
c
c  set raw values to 0. in case of missing data
c
	do i=1,max_FNC
	   e_raw(i) = 0.
	   t_raw(i) = 0.
	end do
c
c  expand FNCOEN into FNTENE
c  if error abort, probably corrupt data
c
	call FNCOEN_2_FNTENE(ierr)
	if(ierr.ne.0) then
	   ierr = 1
	   return
	endif
c
c  bag it now if no FNTENE (no error to allow for 'missing' FNCOEN 96 MDST)
c
	if(coutab(FNTENE).le.0) then
	   return
	endif
c
c  in following we have some differences for DATA and MC, so need:
c
	call defgen(GENKEY_ARG)
c
c  unpack raw e,t from FNTENE
c  convert from CAL MeV to pC using famous 10.6 pC/GeV factor
c						---> 0.0106 pC/Mev
c
	do i=1,coutab(FNTENE)
	   call fettab(FNTENE,ID,i)
	   PMNr = FNTENE_PMNr
c
c  for data check if PMNr is ok, if not abort with error (probably corrupt)
c
	   if(GENKEY_ARG.eq.'DATA') then
	      if(PMNr.le.0.or.PMNr.gt.max_FNTENE) then
	         ierr = 2
	         return
	      endif
c
c  following is an ode to MC 'backward compatibility' (don't blame me - b.s.)
c
	   else
	      if(PMNr.eq.1025) PMNr = 43
	      if(PMNr.eq.1026) PMNr = 44
	      if(PMNr.eq.3073) PMNr = 45
	      if(PMNr.eq.3074) PMNr = 46
	      if(PMNr.eq.1027) PMNr = 47
	      if(PMNr.eq.1028) PMNr = 48
c
c  take out muon counters in MC
c
C	      if(PMNr.eq.2049) PMNr = 49
C	      if(PMNr.eq.2050) PMNr = 50
C	      if(PMNr.eq.2051) PMNr = 51
C	      if(PMNr.eq.2052) PMNr = 52
	   endif
c
c  ok, unpack e,t and fill (unless muon counter in MC)
c
	   if(PMNr.lt.2049) then
	      call UnpackTEWord(FNTENE_ETWord,i_energy,i_time)
	      e_raw(PMNr) = float(i_energy) * 0.0106
	      t_raw(PMNr) = float(128 - i_time) / 2.
	   endif
	end do
c
c  expand PTCOEN into PTTENE
c
	call PTCOEN_2_PTTENE(ierr)
c
c  if error at this point bag it
c  (w/o error since we got FNC data ok, who cares about the counters...)
c
	if(ierr.ne.0) then
	   ierr = 0
	   return
	endif
c
c  if no PTTENE at this point bag it
c  (w/o error since we got FNC data ok, who cares about the counters...)
c
	if(coutab(PTTENE).le.0) then
	   return
	endif
c
c  unpack raw e,t from PTTENE
c  convert to pC using new DSP code factor .005 pC/unit
c
	do i=1,coutab(PTTENE)
	   call fettab(PTTENE,ID,i)
	   PMNr = PTTENE_PMNr
c
c  check PMNr in range, if not abort
c  (w/o error since we got FNC data ok, who cares about the counters...)
c
	   if(PMNr.le.0.or.PMNr.gt.max_PTTENE) then
	      return
	   endif
c
       	   call UnpackTEWord(PTTENE_ETWord,i_energy,i_time)
	   e_raw(max_FNTENE+PMNr) = float(i_energy) * 0.005
	   t_raw(max_FNTENE+PMNr) = float(128 - i_time) / 2.
	end do
c
c  successful completion
c
	ierr = 0
	return
	end
*
*----------------------------------------------------------------
*
      Subroutine UnpackTEWord( TEWord, Energy, Time )
* ===================================================
*

*                               Author: A.Kruse
*
      Implicit None
      Integer TEWord, Energy, Time

      Integer Bit1To24
      Parameter (Bit1To24='00FFFFFF'x)
      Integer Bit24
      Parameter (Bit24='00800000'x)
      Integer Bit25To32
      Parameter (Bit25To32='FF000000'x)

      Integer IOr, IAnd, IShft

*
      Energy = IAnd(TEWord,Bit1To24)
      if( IAnd(TEWord,Bit24).ne.0 ) then
         Energy = IOr(Energy,Bit25To32)
      endif
      Time = IShft(TEWord,-24)

      return
      end
*
*----------------------------------------------------------------
*
c
	subroutine FNCOEN_2_FNTENE(ierr)
c
c  expand FNCOEN data into FNTENE bank
c
c  author: bill schmidke 18.07.96 (modified from j. tickner code for BPC)
c
c  update: 26.08.97	error if PMNr out of range
c
c  output: ierr - = 0, all OK
c		  = 1, PMNr out of range (usually corrupt data)
c
	implicit none
c
	integer ierr
c
#include "partap.inc"
#include "fntene.inc"
#include "fncoen.inc"
#include "fnpmno.inc"
c
	integer i,j,k,l
	integer max_FNTENE
	parameter (max_FNTENE = 72)
	logical FNTENE_exists(max_FNTENE)
	integer PMNr,ETWord
c
	integer ibits,ibset
	logical btest
c
c
	ierr = 0
c
c  bag it if no FNCOEN or no FNPMNO
c
	if(coutab(FNCOEN).le.0.or.coutab(FNPMNO).le.0) return
c
c  flag pm's which are in FNTENE
c
	do i=1,max_FNTENE
	   FNTENE_exists(i) = .false.
	end do
	if(coutab(FNTENE).gt.0) then
    	   do i=1,coutab(FNTENE)
	      call fettab(FNTENE,ID,i)
	      if(FNTENE_PMNr.gt.0.and.FNTENE_PMNr.le.max_FNTENE)
     +		FNTENE_exists(FNTENE_PMNr) = .true.
	   end do
	endif
c
c  loop over FNCOEN, pack ones missing from FNTENE
c
	do i=1,coutab(FNCOEN)
	   call fettab(FNCOEN,ID,i)
	   do j=1,2
	      call fettab(FNPMNO,ID,2*(i-1)+j)
	      do k=1,2
		 PMNr = ibits(FNPMNO_PMNrs,16*(k-1),16)
		 if(PMNr.le.0.or.PMNr.gt.max_FNTENE) then
		    ierr = 1
		    return
		 else
		    if(.not.FNTENE_exists(PMNr)) then
		       ETWord = ibits(FNCOEN_PMEnLowBytes,8*(2*j+k-3),8)
		       if(btest(ETWord,7)) then
		          do l=8,23
			     ETWord = ibset(ETWord,l)
		          end do
		       endif
		       ETWord = ibset(ETWord,31)
		       FNTENE_PMNr = PMNr
		       FNTENE_ETWord = ETWord
		       FNTENE_ID = NEXT
		       call instab(FNTENE)
		    endif
		 endif
	      end do
	   end do
	end do
c
c  successful completion
c
	ierr = 0
	return
	end
*
*----------------------------------------------------------------
*
c
	subroutine PTCOEN_2_PTTENE(ierr)
c
c  expand PTCOEN data into PTTENE bank
c
c  author: bill schmidke 18.07.96 (modified from j. tickner code for BPC)
c
c  update: 26.08.97	error if PMNr out of range
c
c  output: ierr - = 0, all OK
c		  = 1, PMNr out of range (usually corrupt data)
c
	implicit none
c
	integer ierr
c
#include "partap.inc"
#include "pttene.inc"
#include "ptcoen.inc"
#include "ptpmno.inc"
c
	integer i,j,k,l
	integer max_PTTENE
	parameter (max_PTTENE = 24)
	logical PTTENE_exists(max_PTTENE)
	integer PMNr,ETWord
c
	integer ibits,ibset
	logical btest
c
c
	ierr = 0
c
c  bag it if no PTCOEN or PTPMNO
c
	if(coutab(PTCOEN).le.0.or.coutab(PTPMNO).le.0) return
c
c  flag pm's which are in PTTENE
c
	do i=1,max_PTTENE
	   PTTENE_exists(i) = .false.
	end do
	if(coutab(PTTENE).gt.0) then
	   do i=1,coutab(PTTENE)
	      call fettab(PTTENE,ID,i)
	      if(PTTENE_PMNr.gt.0.and.PTTENE_PMNr.le.max_PTTENE)
     +		PTTENE_exists(PTTENE_PMNr) = .true.
	   end do
	endif
c
c  loop over PTCOEN, pack ones missing from PTTENE
c
	do i=1,coutab(PTCOEN)
	   call fettab(PTCOEN,ID,i)
	   do j=1,2
	      call fettab(PTPMNO,ID,2*(i-1)+j)
	      do k=1,2
		 PMNr = ibits(PTPMNO_PMNrs,16*(k-1),16)
		 if(PMNr.le.0.or.PMNr.gt.max_PTTENE) then
		    ierr = 1
		    return
		 else
		    if(.not.PTTENE_exists(PMNr)) then
		       ETWord = ibits(PTCOEN_PMEnLowBytes,8*(2*j+k-3),8)
		       if(btest(ETWord,7)) then
		          do l=8,23
			     ETWord = ibset(ETWord,l)
		          end do
		       endif
		       ETWord = ibset(ETWord,31)
		       PTTENE_PMNr = PMNr
		       PTTENE_ETWord = ETWord
		       PTTENE_ID = NEXT
		       call instab(PTTENE)
		    endif
		 endif
	      end do
	   end do
	end do
c
c  successful completion
c
	ierr = 0
	return
	end
