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
*
*----------------------------------------------------------------
*