PROGRAM LISTEF
!
! **********************************************************************
! *
! *   PROGRAM LISTEF
! *
! *   PROGRAM TO PRODUCE INTERPRETED LISTINGS OF INFORMATION FROM AN
! *   ENDF-V OR -VI FORMAT EVALUATED DATA FILE
! *
! *      VERSION 6.0   JULY 1985  C.L. DUNFORD
! *                    1. LSTFCV CONVERTED TO FORTRAN-77
! *                    2. NEW ENDF-6 FORMATS FILES 1-27 ADDED
! *                    3. FILE 33 LB=6 FORMAT ADDED
! *                    4. ADLER-ADLER PROCESSING ADDED
! *                    5. SUMRIZ PROGRAM MERGED
! *      VERSION 6.1   DECEMBER 1985  C.L. DUNFORD
! *                    1. CORRECTIONS TO VERSION 6.0
! *      VERSION 6.2   DECEMBER 1986 C.L. DUNFORD
! *                    1. CORRECTIONS TO VERSION 6.1
! *                    2. FILE 6, LAW=7 ADDDED
! *                    3. READ MT=457 SPECTRA COVARIANCES
! *      VERSION 6.3   AUGUST 1987 C.L. DUNFORD
! *                    1. CORRECTIONS TO VERSION 6.2
! *                    2. RESTORE REICH-MOORE TO ENDF-5 FORMAT
! *                    3. PROCESS MORE THAN ONE INPUT FILE
! *                    4. IMPROVE TITLING
! *                    5. FORMAT CHANGES OF MAY 1987 EXCEPT
! *                        GENERALIZED R-MATRIX
! *      VERSION 6.4   MAY 1988   C.L. DUNFORD
! *                    1. CORRECTIONS TO VERSION 6.3
! *                    2. HYBRID R-FUNCTION FOR RESONANCE REGION
! *      VERSION 6.5   APRIL 1989  C.L. DUNFORD
! *                    1. NEW FORMATS FOR FILES 32, 34, 35, AND 40
! *      VERSION 6.6   JUNE 1990  C.L. DUNFORD
! *                    1. CORRECTIONS TO VERSION 6.5
! *                    2. PHOTON INTERACTION FORMAT EXTENSIONS
! *                    3. LOG STORAGE OF S(ALPHA,BETA)
! *      VERSION 6.7   JUNE 1991  C.L. DUNFORD
! *                    1. CORRECTIONS TO VERSION 6.6
! *                    2. ADDITION OF PION PRODUCTION MTS
! *      VERSION 6.8   JULY 1992  C.L. DUNFORD
! *                    1. CORRECTIONS TO VERSION 6.7
! *                    2. VMS INPUT ON COMMAND LINE
! *      VERSION 6.9   NOVEMBER 1993 C.L. DUNFORD
! *                    1. CORRECTED BROND NLIB NUMBER TO BE 41
! *      VERSION 6.10  NOVEMBER 1995 C.L.DUNFORD
! *                    1. ADDED RECOGNITION OF MAT NO. FOR S-METHANE
! *                    2. ADDED RECOGNITION OF NEW MT'S, 11, 44, 45
! *                       AND 117
! *                    3. CORRECTED OUTPUT FOR THE KALBACH-MANN
! *                       REPRESENTATION IN FILE 6.
! *                    4. CORRECTED DIROUT BY ADDING SAVE STATEMENT
! *                       TO ASSURE ANSI COMPATIBILITY
! *      VERSION 6.11  APRIL 1998  C.L.DUNFORD
! *                    1. ALLOW 50000 POINTS IN TAB AND LIST RECORDS
! *                    2. ALLOW UP TO 64 LEGENDRE COEFFICIENTS
! *                    3. ADD NEW 451 FIELDS NREL AND EMAX
! *                    4. NEW LTT=3 REPRESENTATION IN FILE 4
! *                    5  UPDATED ELEMENT NAMES AND SYMBOLS
! *      VERSION 6.12  FEBRUARY 2001  C.L.DUNFORD
! *                    1. MOVE NREL TO L1 FIELD FROM L2 FIELD
! *                    2. IMPLEMENT "$" OUTPUT CONTROL ON UNIX
! *                    3. CREATE THREE INTERACTIVE VERSIONS AND ONE
! *                       BATCH VERSION
! *                    4. IMPLEMENT ADDITIONAL AVERAGE ENERGIES IN 457
! *                    5. IMPLEMENT NEW ELECTRO-ATOMIC DATA FORMATS
! *      VERSION 6.13  MAY 2002     C.L.DUNFORD
! *                    1. 6.12 BUGS REPORTED BY MAY 2002
! *                    2. FORMAT MODIFICATIONS FOR RADIOACTIVE PRODUCTS
! *                        IN FILES 8, 9 AMD 10
! *                    3. SIMPLE CONVERSION TO F95 STANDARD
! *
! *      REFER ALL COMMENTS AND INQUIRIES TO
! *
! *         NATIONAL NUCLEAR DATA CENTER
! *         BUILDING 197D
! *         BROOKHAVEN NATIONAL LABORATORY
! *         P.O. BOX 5000
! *         UPTON, NY 11973-5000
! *         USA
! *
! *      TELEPHONE           631-344-2902
! *      E-MAIL              NNDC@BNL.GOV
! *
! **********************************************************************
!
!
!    TO CUSTOMIZE THIS SOURCE RUN SETMDC
!        VMS  -  INTERACTIVE VERSION FOR VMS OPERATING SYSTEM
!        WIN  -  INTERACTIVE VERSION FOR PC USING DIGITAL VISUAL FORTRAN
!        UNX  -  INTERACTIVE VERSION FOR UNIX
!        ANS  -  ANSI STANDARD BATCH MODE VERSION
!
!
!***********************************************************************
!
!     INFIL  = INPUT FILE SPECIFICATIONS
!     SOUFIL = SUMMARY FILE SPECIFICATIONS
!     OUFIL  = OUTPUT LISTING FILE SPECIFICATIONS
!     EDITIT = Y FOR ONE SECTION PER PAGE
!              N COMPRESS OUTPUT TO MIMIMUM NUMBER OF PAGES
!     IOPT   = N PROCESS PARTAL TAPE
!            = Y PROCESS FULL TAPE
!
!***********************************************************************
!
      COMMON DUM(100510)
      COMMON/CLINE/INPAR
      CHARACTER(LEN=100) INPAR
      COMMON/CLINE1/ILENP
      COMMON/INDAT/IOPT,NLABEL,EDITIT,IFULL
      INTEGER EDITIT
      COMMON/REQUST/MATN(50),ZAN(50),MFN(50,25),IFILE(50),NCARD,KCARD
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/HEAD1/ZAH,AWRH,L1H,L2H,N1H,N2H,MATH,MFH,MTH
      COMMON/HEADI/ZAI,AWRI,L1I,L2I,N1I,N2I,MATI,MFI,MTI
      COMMON/XYCONT/NSCR,MAXY,NCONT,NA,NB,NN
!
      PARAMETER (MAXFIL=25,MXFIL=50)
      CHARACTER(LEN=66) STOR
!+++MDC+++
!...VMS, WIN
      INTEGER*2 ILENP2
!---MDC---
      CHARACTER(LEN=4 ) VERSION
      DATA VERSION/'6.13'/
!
!     DEFINE LIMITS FOR THE MINIPAGE VALUES
!
      MAXY = 5000
!
!     INITIALIZE FILE UNITS
!
      INPUT = 5
      OTPUT = 6
      ITAPE = 20
      NSCR = 23
!
!     OUTPUT PROGRAM IDENTIFICATION
!
      WRITE(OTPUT,'(/A)') ' PROGRAM LISTEF VERSION '//VERSION
!
!     CHECK FOR COMMAND LINE OPERATION
!
      INPAR = ' '
      ILENP = 0
!+++MDC+++
!...VMS
!/      CALL LIB$GET_FOREIGN(INPAR,,ILENP2)
!/      ILENP = ILENP2
!...WIN
      CALL GETARG(1,INPAR,ILENP2)
      ILENP = IMAX0(ILENP2,0)
!---MDC---
!
!     INITIALIZE FOR RUN
!
   10 SOUT = 6
      OUTPUT = 0
      CALL BEGIN(IQUIT)
      IF(IQUIT.EQ.-1)   GO TO 10
      IF(IQUIT.EQ.1)   GO TO 805
!
!     IF TAPE REQUEST LABEL IS LESS THAN ZERO DO NOT READ OR WRITE TPID
!
      IF(NLABEL.LT.0) GO TO 100
!
!     READ TAPE I.D. AND CHECK IF REQUESTED
!
      CALL TEXTR(ITAPE,STOR,LLABEL,MFL,MTL)
      IF(MFL.EQ.0.AND.MTL.EQ.0)   GO TO 18
      REWIND (UNIT=ITAPE)
      WRITE(OTPUT,17)
   17 FORMAT(/' TAPE IS UNLABELED ')
      GO TO 100
   18 IF(NLABEL.GT.0) GO TO 20
      NLABEL = LLABEL
      GO TO 50
   20 IF(NLABEL.EQ.LLABEL) GO TO 50
      WRITE(OTPUT,30)
   30 FORMAT(/' TAPE LABEL DOES NOT MATCH REQUEST LABEL--EXECUTION ',   &       
     &   'TERMINATED')
      GO TO 800
!
!     WRITE TAPE I.D.
!
   50 IF(OUTPUT.GT.0) WRITE(OUTPUT,60)  STOR,NLABEL
   60 FORMAT(/' LABEL FROM DATA TAPE IS LISTED BELOW'//' ',A66,I4)
!
!     READ HEAD CARD FOR FILE 1 OF CURRENT MATERIAL
!
  100 CALL CONT(ITAPE,ZAH,AWRH,L1H,L2H,N1H,N2H,MATH,MFH,MTH)
!
!     TEST FOR END OF FILE ON ITAPE
!
      IF(MATH.LT.0) GO TO 600
      IF(MATH.EQ.0) GO TO 680
!
!     DETERMINE IF THIS DATA SET IS ON LIST OF THOSE TO BE LISTED
!
  130 IF(NCARD.EQ.0)   GO TO 250
      DO 150 I=1,KCARD
      IF(MATN(I).EQ.MATH.OR.ZAN(I).EQ.ZAH) GO TO 160
  150 CONTINUE
!
!     THIS DATA SET HAS NOT BEEN REQUESTED. SKIP OVER IT
!
      CALL SKPMAT(ITAPE)
      GO TO 100
!
!     SET INDICATORS TO LIST THOSE FILES LISTED ON THE I-TH CARD
!
  160 DO KEY=1,MXFIL
         IFILE(KEY)=0
      END DO
      DO KEY=1,MAXFIL
         IF(MFN(I,KEY).LE.0) GO TO 200
         LFN=MFN(I,KEY)
         IFILE(LFN)=1
      END DO
!
!     SHORTEN REQUEST LIST
!
  200 DO KEY=1,MAXFIL
         MFN(I,KEY)=MFN(KCARD,KEY)
      END DO
      MATN(I)=MATN(KCARD)
      ZAN(I)=ZAN(KCARD)
      KCARD=KCARD-1
!
!     LIST FILE ONE
!
  250 CALL FILE1(IFILE(1),IFILE(3))
!
!     READ FIRST RECORD OF FILE MFI
!
  300 CALL CONT(ITAPE,ZAI,AWRI,L1I,L2I,N1I,N2I,MATI,MFI,MTI)
      IF(MATI.LT.0) GO TO 680
      IF(MATI.EQ.0) GO TO 575
!
!     TEST LIST OPTION FOR FILE MFI
!
      SELECT CASE (MFI)
         CASE (2)
            CALL FILE2
         CASE (3)
            CALL FILE3
         CASE (4)
            CALL FILE4
         CASE (5)
            CALL FILE5
         CASE (6)
            CALL FILE6
         CASE (7)
            CALL FILE7
         CASE (8)
            CALL FILE8
         CASE (9,10)
            CALL FILE9
         CASE (12,13)
            CALL FILE12
         CASE (14)
            CALL FILE14
         CASE (15)
            CALL FILE15
         CASE (23,27)
            CALL FILE23
         CASE(26)
            CALL FILE26
         CASE (28)
            CALL FILE28
         CASE (31,33)
            CALL FILE33
         CASE (32)
            CALL FILE32
         CASE (34)
            CALL FILE34
         CASE (35)
            CALL FILE35
         CASE (40)
            CALL FILE40
         CASE DEFAULT
            CALL SKPFIL(ITAPE)
      END SELECT
      GO TO 300
!
!     END OF MATERIAL ENCOUNTERED.  DETERMINE IF ALL DATA SETS PROCESSED
!
  575 IF(NCARD.LE.0) GO TO 100
      IF(KCARD.GT.0) GO TO 100
      GO TO 650
!
!     END OF RUN
!
  600 IF(KCARD.LT.1) GO TO 650
!
!     WRITE LIST OF UNFULLFILLED REQUESTS
!
      IF(OUTPUT.GT.0) WRITE(OUTPUT,610) (MATN(I),ZAN(I),I=1,KCARD)
  610 FORMAT('1','All input data has been processed. The following ',   &       
     & 'requests were not filled since no matching MAT or ZA was found'/&       
     & /'   MAT       ZA'/(I6,F10.0))
      GO TO 800
!
!     ALL DATA SETS REQUESTED HAVE BEEN PROCESSED. WRITE COMPLETION
!     MESSAGE
!
  650 IF(OUTPUT.GT.0) WRITE(OUTPUT,660)
  660 FORMAT('1','All data sets requested have been processed.')
      GO TO 800
!
!     ERROR ON TAPE. WRITE ERROR MESSAGE AND STOP
!
  680 WRITE(OTPUT,690)
  690 FORMAT(/' MATERIAL NUMBER IS LESS THAN OR EQUAL TO ZERO---',      &       
     &   'EXECUTION TERMINATED')
!
!     CLOSE FILES
!
  800 CLOSE(UNIT=ITAPE)
      IF(OTPUT.NE.SOUT)  CLOSE(UNIT=SOUT)
      IF(OUTPUT.NE.0)   CLOSE(UNIT=OUTPUT)
      GO TO 10
!
!     TERMINATE JOB
!
  805 WRITE(OTPUT,'(/A)') '   '
      STOP '     JOB COMPLETED SUCCESSFULLY'
      END
!
!***********************************************************************
!
      SUBROUTINE BEGIN(IQUIT)
!
!     ROUTINE TO SET UP JOB
!
      COMMON/CLINE/INPAR
      CHARACTER(LEN=100) INPAR
      COMMON/CLINE1/ILENP
      COMMON/INDAT/IOPT,NLABEL,EDITIT,IFULL
      INTEGER EDITIT
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/XYCONT/NSCR,MAXY,NCONT,NA,NB,NN
!
      LOGICAL IEXIST
      CHARACTER(LEN=50) INFIL,SOUFIL,OUFIL
      CHARACTER(LEN=1) IW
      CHARACTER(LEN=80) DATIN
      CHARACTER(LEN=4) BUF
      DATA IONEPASS/0/
!
!     SEE IF ONE PASS LIMIT SET
!
      IF(IONEPASS.EQ.1) THEN
         IQUIT = 1
         GO TO 100
      END IF
!
!     INITIALIZE
!
      NCONT = 0
      IQUIT = 0
      IFULL = 0
      INFIL = '*'
      SOUFIL = '*'
      OUFIL = '*'
      IW = '*'
!
!     INITIALIZE INPUT PARAMATERS
!
      NLABEL = 0
      IOPT = 1
      EDITIT = 1
!
!+++MDC+++
!...VMS, WIN
      IF(ILENP.NE.0)  THEN
         CALL TOKEN(INPAR,'/',1,INFIL)
         CALL TOKEN(INPAR,'/',2,SOUFIL)
         CALL TOKEN(INPAR,'/',3,OUFIL)
         CALL TOKEN(INPAR,'/',4,IW)
         IF(IW.EQ.' ')  IW = 'Y'
         IONEPASS = 1
      ELSE
         IW = '*'
      END IF
!---MDC---
!
!     GET FILE SPECIFICATIONS
!
      IF(INFIL.EQ.'*') THEN
!+++MDC+++
!...VMS, WIN, UNX
         WRITE(OTPUT,'(/A,$)')                                          &       
     &               ' Input File Specification          - '
!---MDC---
         READ(INPUT,'(A)') INFIL
!+++MDC+++
!...ANS
!/         WRITE(OTPUT,'(/2A)') ' Input file - ',INFIL
!---MDC---
      ELSE
         WRITE(OTPUT,'(/2A)') ' Input file - ',INFIL
      END IF
      CALL UPSTR(INFIL)
      IF(INFIL.EQ.' '.OR.INFIL.EQ.'DONE')   THEN
         IQUIT = 1
         GO TO 100
      END IF
      INQUIRE(FILE=INFIL,EXIST=IEXIST)
      IF(.NOT.IEXIST) THEN
         WRITE(OTPUT,'(/A/)') '       COULD NOT FIND INPUT FILE'
!+++MDC+++
!...VMS, WIN, UNX
         IF(IONEPASS.EQ.1) THEN
            IQUIT = 1
         ELSE
            IQUIT = -1
         END IF
!...ANS
!/         IQUIT = 1
!---MDC---
         GO TO 100
      END IF
      IF(SOUFIL.EQ.'*' ) THEN
!+++MDC+++
!...VMS, WIN, UNX
         WRITE(OTPUT,'(/A,$)')                                          &       
     &          ' Output Summary File Specification - '
!---MDC---
         READ(INPUT,'(A)')  SOUFIL
!+++MDC+++
!...ANS
!/         WRITE(OTPUT,'(/2A)') ' Output Summary File - ',SOUFIL
!---MDC---
      ELSE
         WRITE(OTPUT,'(/2A)') ' Output Summary File - ',SOUFIL
      END IF
      IF(SOUFIL.NE.' ') SOUT = 21
      CALL UPSTR(SOUFIL)
      IF(OUFIL.EQ.'*' ) THEN
!+++MDC+++
!...VMS, WIN, UNX
         WRITE(OTPUT,'(/A,$)') ' Output Full File Specification    - '
!---MDC---
         READ(INPUT,'(A)') OUFIL
!+++MDC+++
!...ANS
!/         WRITE(OTPUT,'(/2A)') ' Output Full File - ',OUFIL
!---MDC---
      ELSE
         WRITE(OTPUT,'(/2A)') ' Output Full File - ',OUFIL
      END IF
      IF(OUFIL.NE.' ')  THEN
         IFULL = 1
         OUTPUT = 22
         CALL UPSTR(OUFIL)
      END IF
!
!     CHECK IF STANDARD OPTIONS ARE WANTED
!
      IF(IW.EQ.'*') THEN
!+++MDC+++
!...VMS, WIN, UNX
   10    WRITE(OTPUT,'(/A,$)')   ' Standard Options (Y(es),N(o),?)  '
         READ(INPUT,'(A)')  IW
         CALL UPSTR(IW)
         IF(IW.EQ.'?') THEN
            IW = '*'
            WRITE(OTPUT,15)
   15       FORMAT(10X,' STANDARD OPTIONS ARE'/                         &       
     &          10X,'    ONE SECTION/PAGE '/                            &       
     &          10X,'    LIST ENTIRE TAPE')
            GO TO 10
         END IF
!...ANS
!/      READ(INPUT,'(A)') DATIN
!/      IF(DATIN.EQ.' ')  THEN
!/         IW = 'Y'
!/      ELSE
!/         IW = 'N'
!/      END IF
!---MDC---
      END IF
!
!     NON STANDARD OPTIONS
!
      IF(IW.EQ.'N') THEN
!
!        EDIT ONE SECTION PER PAGE
!
!+++MDC+++
!...VMS, WIN, UNX
         WRITE(OTPUT,'(/A,$)')                                          &       
     &      '     Edit One Section per Page (Y(es),N(o))   '
         READ(INPUT,'(A)') IW
!...ANS
!/         CALL TOKEN(DATIN,',',1,BUF)
!/         IW = BUF(1:1)
!---MDC---
         CALL UPSTR(IW)
         IF(IW.EQ.'N') EDITIT = 0
!
!           LIST ENTIRE TAPE
!
!+++MDC+++
!...VMS, WIN, UNX
         WRITE(OTPUT,'(/A,$)')                                          &       
     &                   '     List Entire Tape (Y(es),N(o))   '
         READ(INPUT,'(A)') IW
!...ANS
!/         CALL TOKEN(DATIN,',',2,BUF)
!/         IW = BUF(1:1)
!---MDC---
         CALL UPSTR(IW)
         IF(IW.EQ.'N') IOPT = 0
      END IF
      IF(EDITIT.EQ.0)  THEN
         WRITE(OTPUT,'(/6X,A)')                                         &       
     &        'Output will NOT be Edited to One Section per Page.'
      ELSE
         WRITE(OTPUT,'(/6X,A)')                                         &       
     &        'Output will be Edited to One Section per Page.'
      END IF
      IF(IOPT.EQ.1)  THEN
         WRITE(OTPUT,'(6X,A)')  'Process the Entire Tape'
      END IF
!
!     OPEN INPUT AND OUTPUT FILES
!
      OPEN(UNIT=ITAPE,ACCESS='SEQUENTIAL',STATUS='OLD',ACTION='READ',   &       
     &  FILE=INFIL)
      IF(SOUT.NE.6) THEN
!...VMS
         OPEN(UNIT=SOUT,ACCESS='SEQUENTIAL',STATUS='NEW',FILE=SOUFIL)
!...ANS, WIN, UNX
!/         OPEN(UNIT=SOUT,ACCESS='SEQUENTIAL',STATUS='UNKNOWN',
!/   1          FILE=SOUFIL)
!---MDC---
      END IF
      IF(IFULL.NE.0) THEN
!+++MDC+++
!...VMS
!/         OPEN(UNIT=OUTPUT,ACCESS='SEQUENTIAL',STATUS='NEW',FILE=OUFIL)
!...ANS, WIN, UNX
         OPEN(UNIT=OUTPUT,ACCESS='SEQUENTIAL',                          &       
     &        STATUS='UNKNOWN',FILE=OUFIL)
!---MDC---
      END IF
!
!     GET AND OUTPUT DETAILS OF MATERIALS SELECTED
!
      CALL REQUES
!
!     OUTPUT SELECTED OPTIONS
!
      IF(OUTPUT.GT.0)   THEN
         WRITE(OUTPUT,'(A//)')   '1'
         WRITE(OUTPUT,'(2A)')                                           &       
     &      ' Input File Specification------------------------',INFIL
         IF(EDITIT.EQ.0)  THEN
            WRITE(OUTPUT,'(A)')                                         &       
     &        ' Output will NOT be Edited to One Section per Page.'
         ELSE
            WRITE(OUTPUT,'(A)')                                         &       
     &        ' Output will be Edited to One Section per Page.'
         END IF
         IF(IOPT.EQ.1)  THEN
            WRITE(OUTPUT,'(A)')  ' Process the Entire Tape'
         END IF
      END IF
!
  100 RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE REQUES
!
!     ROUTINE TO SET SPECIFICATIONS FOR PARTS OF TAPE TO BE PROCESSED
!
      COMMON/INDAT/IOPT,NLABEL,EDITIT,IFULL
      INTEGER EDITIT
      COMMON/REQUST/MATN(50),ZAN(50),MFN(50,25),IFILE(50),NCARD,KCARD
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
!
      PARAMETER (MAXMAT=50)
      CHARACTER(LEN=80) CARD
      CHARACTER(LEN=4) BUF
      CHARACTER(LEN=6) BUF1
!
      PARAMETER (MAXFIL=25)
      INTEGER MFNT(MAXFIL)
      PARAMETER (KRANGE=6)
      INTEGER MRANGE(2,KRANGE)
      DATA MRANGE/1,7,8,10,12,15,23,23,26,28,31,33/
!
!     INITIALIZE
!
      NCARD = 0
      DO I=1,MAXMAT
         MATN(I) = 0
         ZAN(I) = 0.
         IFILE(I) = 0
         DO J=1,MAXFIL
            MFN(I,J) = 0
         END DO
      END DO
!
!     SET UP FOR ENTIRE TAPE PROCESSING
!
      IF(IOPT.NE.0)   THEN
         JJ = 0
         DO J=1,KRANGE
            K1 = MRANGE(1,J)
            K2 = MRANGE(2,J)
            DO K=K1,K2
               JJ = JJ + 1
               IFILE(K) = 1
               MFN(1,JJ) = K
            END DO
         END DO
         IF(OUTPUT.GT.0) THEN
            WRITE(OUTPUT,'(/2A/)')                                      &       
     &        ' The following files have been requested for all data ', &       
     &        'sets on the tape.'
            WRITE(OUTPUT,'(15I5)')  (MFN(1,K),K=1,JJ)
         END IF
         GO TO 100
      END IF
!
!     PARTIAL TAPE PROCESSING
!
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
!
!     MATN(I)=IDENTIFICATION NUMBER FOR DATA SET
!     ZAN(I) =(Z,A) NUMBER FOR DATA SET
!     MFN(I,J)=LIST OF FILES TO BE LISTED.  PERMISSIBLE NUMBERS ARE...
!              1 TO 7 NEUTRON INTERACTION DATA
!              8 TO 10 RADIOACTIVE DECAY DATA
!              12 TO 15 PHOTON PRODUCTION DATA
!              23 AND 26 TO 28 PHOTON INTERACTION DATA
!              31 TO 33 ERROR FILES
!            IF NO FILES ARE REQUESTED ONLY HOLLERITH DATA IS SUPPLIED
!
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
!
!+++MDC+++
!...VMS, WIN, UNX
      DO I=1,MAXFIL
         MFNT(I) = 0
      END DO
      WRITE(OTPUT,'(/2A/A/)')  ' Enter MAT or ZA and FILE Numbers',     &       
     &    ' for each material to be listed,',                           &       
     &    '   one line per material. Terminate with MAT=0 or ZA=0.0'
!---MDC---
!
!     READ EACH DATA SET IDENTIFICATION
!
      DO I=1,MAXMAT
!+++MDC+++
!...VMS, WIN, UNX
   10    WRITE(OTPUT,'(A,$)')   '     * '
!...ANS
!/   10    CONTINUE
!---MDC---
         MATN(I) = 0
         ZAN(I) = 0.0
         READ(INPUT,'(A)') CARD
         IF(CARD.EQ.' ')   GO TO 50
         CALL TOKEN(CARD,',',1,BUF1)
         IF(INDEX(BUF1,'.').NE.0)    THEN
            READ(BUF1,'(BN,F6.0)',ERR=10)  ZAN(I)
         ELSE
            BUF = BUF1(1:4)
            READ(BUF(1:4),'(BN,I4)',ERR=10) MATN(I)
         END IF
         IF(MATN(I).EQ.0.AND.ZAN(I).EQ.0.0)   GO TO 50
         DO J=1,MAXFIL
            CALL TOKEN(CARD,',',J+1,BUF)
            READ(BUF,'(BN,I2)',ERR=10)  MFNT(J)
         END DO
!
!        ELIMINATE ALL FILE REQUESTS THAT ARE NOT IN A LEGAL RANGE
!
         JJ = 0
         DO J=1,MAXFIL
            MFNTT = MFNT(J)
            DO K=1,KRANGE
               IF(MFNTT.GE.MRANGE(1,K).AND.MFNTT.LE.MRANGE(2,K))  THEN
                  JJ=JJ+1
                  MFN(I,JJ) = MFNTT
                  GO TO 30
               END IF
            END DO
   30    END DO
      END DO
      I = MAXMAT + 1
   50 NCARD = I - 1
      KCARD = NCARD
!
!     OUTPUT SUMMARY OF DATA TO BE LISTED
!
      IF(NCARD.LE.0)   THEN
         IF(OUTPUT.GT.0) THEN
            WRITE(OUTPUT,'(/2A)')                                       &       
     &         ' Only hollerith information for all data sets on the ', &       
     &         'tape has been requested'
         END IF
         GO TO 100
      END IF
!
!     SPECIFIC MATERIALS AND FILES REQUESTED
!
      IF(OUTPUT.GT.0) THEN
         WRITE(OUTPUT,'(/A//A)')                                        &       
     &          ' The following data has been requested',               &       
     &          '  MAT        ZA           FILES'
      END IF
      DO I=1,NCARD
         DO J=1,MAXFIL
            IF(MFN(I,J).EQ.0) GO TO 60
         END DO
         J = MAXFIL + 1
   60    J = J - 1
         IF(OUTPUT.GT.0) THEN
            IF(J.GT.0) THEN
               WRITE(OUTPUT,'(I5,F10.0,5X,20I5)')                       &       
     &                 MATN(I),ZAN(I),(MFN(I,K),K=1,J)
            ELSE
               WRITE(OUTPUT,'(I5,F10.0,5X,A)')                          &       
     &                 MATN(I),ZAN(I),' Only hollerith'
            END IF
         END IF
      END DO
!
  100 RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE UPSTR(STRING)
!
!     ROUTINE TO CONVERT A STRING TO ALL UPPER CASE
!
      CHARACTER(LEN=*) STRING
!
      L = LEN(STRING)
      DO I=1,L
         IC = ICHAR(STRING(I:I))
         IF(IC.GT.96.AND.IC.LT.123)   STRING(I:I) = CHAR(IC-32)
      END DO
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE TOKEN(INSTR,DELIM,ITOK,OUTSTR)
!
!     SUBROUTINE TO EXTRACT A STRING FROM A STRING WITH DELIMITERS
!
      CHARACTER(LEN=*) INSTR,OUTSTR,DELIM
!
!     INITIALIZE
!
      OUTSTR = ' '
      ILEN = LEN_TRIM(INSTR)
      JLEN = LEN_TRIM(DELIM)
      IF(ITOK.EQ.0.OR.ILEN.EQ.0)   GO TO 100
      IF(JLEN.EQ.0)  THEN
         IF(ITOK.EQ.1)    OUTSTR = INSTR
         GO TO 100
      END IF
!
!     FIND ITOK-TH DELIMITER
!
      ITOKP = 1 - JLEN
      DO I=1,ITOK
         IBEG = ITOKP + JLEN
         IF(IBEG.LE.ILEN)  THEN
            ITOKP = INDEX(INSTR(IBEG:),DELIM) + IBEG - 1
            IF(ITOKP.LT.IBEG) ITOKP = ILEN + 1
         ELSE
            GO TO 100
         END IF
         IF(I.EQ.ITOK)  THEN
            IF(ITOKP.GT.IBEG) OUTSTR = INSTR(IBEG:ITOKP-1)
            GO TO 100
         END IF
      END DO
!
  100 RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE FILE1(ICOMP,IFILE3)
!
!     ROUTINE TO CONTROL PROCESSING OF FILE 1 DATA
!
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/TOPPER/LIBBCD,MFBCD,MTBCD,ZABCD
      CHARACTER(LEN=14) LIBBCD
      CHARACTER(LEN=48) MFBCD
      CHARACTER(LEN=30) MTBCD
      CHARACTER(LEN=24) ZABCD
      COMMON/TOPI/NLIB,NVER,NREL,NSUB,MATIN,AWI,NMOD,NFOR
      COMMON/TOPR/EMAX,ELIS,STA,LIS,LISO
      COMMON/HEAD1/ZAH,AWRH,LRP,LFI,N1H,N2H,MATH,MFH,MTH
      COMMON/HEADI/ZAI,AWRI,L1I,L2I,N1I,N2I,MATI,MFI,MTI
!
!     PROCESS REMAINING IDENTIFICATION CARDS IN FILE 1 SECTION 451
!
      NLIB=N1H
      NMOD=N2H
      MATIN = MATH
      CALL CONT(ITAPE,ELIS,STA,LIS,LISO,N1,NFOR,MAT,MF,MT)
      IF(NFOR.NE.0)   GO TO 20
!
!     ENDF-V FORMAT FILE
!
      NFOR = 5
      NVER = 5
      NREL = 0
      IF((NLIB.GE.2.AND.NLIB.LE.4).OR.NLIB.EQ.35)  NVER = 1
      IF(NLIB.EQ.5)  NVER = 2
      IF(NLIB.EQ.6)  NVER = 3
      NSUB = 10
      AWI = 1.
      GO TO 30
!
!     ENDF-VI OR LATER FORMAT
!
   20 CALL CONT(ITAPE,AWI,EMAX,NREL,L2,NSUB,NVER,MAT,MF,MT)
      IF(EMAX.EQ.0.0) EMAX = 2.E+7
!
!     PROCESS COMMENTS AND DIRECTORY
!
   30 CALL HEADIN(MATH,MFH,0,ZAH)
      MFBCD = '              General Information'
      CALL IDDATA
      IF(LRP.EQ.1.AND.IFILE3.EQ.1)   CALL BANNER(LFI)
      CALL FILE1A
!
!     SKIP REST OF FILE ONE UNLESS PROCESSING REQUESTED
!
      IF(ICOMP.EQ.1)   GO TO 40
      CALL SKPFIL(ITAPE)
      GO TO 100
   40 IREST1 = 0
!
!     PROCESS REMAINING SECTIONS OF FILE 1
!
   50 CALL CONT(ITAPE,ZA,AWR,L1I,L2I,N1I,N2I,MATI,MFI,MTI)
      IF(MFI.EQ.0) GO TO 100
!
!     PROCESS NEXT SECTION
!
      IF(IREST1.EQ.0) THEN
         CALL FILEHD(1)
         IREST1 = 1
      END IF
      CALL HEADIN(0,0,MTI,-1.)
      SELECT CASE (MTI)
!
!        NUBAR
!
         CASE (452,455,456)
            NWI = 0
            IF(MTI.EQ.455)  NWI = 1
            CALL FILE1B(NWI)
!
!        ENERGY RELEASE IN FISSION
!
         CASE (458)
            CALL FILE1C
!
!        SKIP SECTION WHICH CANNOT BE RECOGNIZED
!
         CASE DEFAULT
            CALL SKPSEC(ITAPE)
         GO TO 50
      END SELECT
      CALL SKPREC(ITAPE,1)
      GO TO 50
!
  100 RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE BANNER(LFI)
!
!     ROUTINE TO PUT OUT WARNING BANNER IF FILE 3 IS LISTED AND THERE
!     ARE RESONANCE PARAMETERS TO BE ADDED
!
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
!
      PARAMETER (NLINES=7)
      CHARACTER(LEN=46)  LINE(NLINES)
      CHARACTER(LEN=46)  LINE3(2)
!
      DATA LINE/'This material  contains  resonance parameters.',       &       
     &           'The   cross  sections   given  in  file 3  for',      &       
     &           '                                              ',      &       
     &           'in the  resonance  region are background files',      &       
     &           'which  must  be  added  to the  cross  section',      &       
     &           'calculated   from  the   resonance  parameters',      &       
     &           'to give the real cross section.               '/
      DATA LINE3/'     Total, Elastic, and Gamma production     ',      &       
     &           'Total, Elastic, Fission, and  Gamma production'/
!
!     SET PROPER LINE 3 IF FISSIONABLE
!
      LINE(3) = LINE3(1)
      IF(LFI.EQ.1)   LINE(3) = LINE3(2)
!
!     OUTPUT TEXT
!
      IF(OUTPUT.GT.0) WRITE(OUTPUT,10)
   10 FORMAT(/////////27X,80('*')/27X,'*',78X,'*'/27X,'*',78X,'*')
      DO 50 I=1,NLINES
      IF(OUTPUT.GT.0) WRITE(OUTPUT,25) LINE(I)
   25 FORMAT(27X,'*',16X,A46,16X,'*')
   50 CONTINUE
      IF(OUTPUT.GT.0) WRITE(OUTPUT,60)
   60 FORMAT(27X,'*',78X,'*'/27X,'*',78X,'*'/27X,80('*'))
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE IDDATA
!
!     ROUTINE TO OUTPUT MATERIAL IDENTIFICATION
!
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/HEAD1/ZAH,AWRH,LRP,LFI,N1H,N2H,MATH,MFH,MTH
      COMMON/TOPPER/LIBBCD,MFBCD,MTBCD,ZABCD
      CHARACTER(LEN=14) LIBBCD
      CHARACTER(LEN=48) MFBCD
      CHARACTER(LEN=30) MTBCD
      CHARACTER(LEN=24) ZABCD
      COMMON/TOPI/NLIB,NVER,NREL,NSUB,MATIN,AWI,NMOD,NFOR
      COMMON/TOPR/EMAX,ELIS,STA,LIS,LISO
!
      CHARACTER(LEN=11) ADATE
      CHARACTER(LEN=20) ZAPART
!
      PARAMETER (NPARTS=7)
      CHARACTER(LEN=8) PNAMES(NPARTS)
      INTEGER IPZA(NPARTS)
      CHARACTER(LEN=16) GTEXT(2)
!
      DATA PNAMES/'PHOTON  ','NEUTRON ','ELECTRON','PROTON  ',          &       
     &            'DEUTERON','TRITON  ','ALPHA   '/
      DATA IPZA/0,1,11,1001,1002,1003,2004/
      DATA GTEXT/'GROUND State','METASTABLE State'/
!
!     SET LIBRARY ID
!
      CALL LIBID(NLIB,NVER,LIBBCD)
!
!     GET TODAY'S DATE
!
      CALL DATE_20(ADATE)
!
!     OUTPUT IDENTIFICATION FOR MATERIAL
!
      IF(OUTPUT.GT.0) WRITE(OUTPUT,20) ADATE,ZABCD,MATIN,NSUB,NMOD,     &       
     &    LIBBCD,NREL,NFOR
      WRITE(SOUT,20) ADATE,ZABCD,MATIN,NSUB,NMOD,LIBBCD,NREL,NFOR
   20 FORMAT('1',100X,A11///2X,A24,' Material No. ',I4,',  ',           &       
     &  'Sub-library No. ',I6,',  ','Mod No. ',I2,',  ',A14,            &       
     &  '  Release No. ',I2,',  ',' Format ENDF-',I1)
!
!     DETERMINE INCIDENT PARTICLE NAME
!
      IPART = NSUB/10
      DO 40 I=1,NPARTS
      IF(IPART.EQ.IPZA(I))  GO TO 45
   40 CONTINUE
      CALL ZAID(FLOAT(IPART),ZAPART,IERR)
      GO TO 50
   45 ZAPART = PNAMES(I)
      GO TO 55
   50 IF(IPART.NE.0)   GO TO 55
      IF(NSUB.EQ.4.OR.NSUB.EQ.5)  ZAPART = 'NONE'
!
!     OUTPUT PROJECTILE ID AND TARGET STATE
!
   55 IF(OUTPUT.GT.0) WRITE(OUTPUT,60) ZAPART
      WRITE(SOUT,60) ZAPART
   60 FORMAT(/30X,'Projectile is ',A20)
      IGM = MIN0(LISO,1) + 1
      ELISM = ELIS/1.E+6
      IF(OUTPUT.GT.0) WRITE(OUTPUT,65) GTEXT(IGM),ELISM
      WRITE(SOUT,65) GTEXT(IGM),ELISM
   65 FORMAT(30X,'Target in ',A16,'     E(level) =   ',F8.4,' MeV')
      IF(NFOR.GT.5) THEN
         EMAXM = EMAX/1.E+6
         IF(OUTPUT.GT.0) WRITE(OUTPUT,70) EMAXM
         WRITE(SOUT,70) EMAXM
   70    FORMAT(30X,'Maximum Incident Energy ',16X,'= ',1PG10.4,' MeV')
      END IF
      IF(LFI.GT.0)  THEN
         IF(OUTPUT.GT.0) WRITE(OUTPUT,75)
         WRITE(SOUT,75)
   75    FORMAT(30X,'Target is FISSIONABLE')
      END IF
      IF(LRP.GT.0) THEN
         IF(OUTPUT.GT.0) WRITE(OUTPUT,85)
         WRITE(SOUT,85)
   85    FORMAT(30X,'RESONANCE PARAMETERS are given')
      END IF
      IF(OUTPUT.GT.0) WRITE(OUTPUT,100)
      WRITE(SOUT,100)
  100 FORMAT(/)
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE FILE1A
!
!     ROUTINE TO PROCESS  MT = 451
!
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/TOPPER/LIBBCD,MFBCD,MTBCD,ZABCD
      CHARACTER(LEN=14) LIBBCD
      CHARACTER(LEN=48) MFBCD
      CHARACTER(LEN=30) MTBCD
      CHARACTER(LEN=24) ZABCD
      COMMON/TOPI/NLIB,NVER,NREL,NSUB,MATIN,AWI,NMOD,NFOR
!
      PARAMETER (LPPAGE=59)
      CHARACTER(LEN=66) HOL
      CHARACTER(LEN=132) FHOL
      CHARACTER(LEN=33) STEXT
!
      CHARACTER(LEN=30) DICTON
      PARAMETER (NHEADS=6)
      INTEGER HLENL(NHEADS)
      INTEGER HLENU(NHEADS)
      CHARACTER(LEN=23) HEADS(NHEADS)
!
      DATA DICTON/'      Table of Contents       '/
!
      DATA HEADS/'Laboratory-------------',                             &       
     &           'Evaluation date--------',                             &       
     &           'Author(s)--------------',                             &       
     &           'Reference(s)-----------',                             &       
     &           'Distribution date------',                             &       
     &           'Revision date(s)-------'/
      DATA HLENL/12,28,34,68,94,105/
      DATA HLENU/22,32,66,88,98,109/
!
!     READ CONTROL CARD
!
      CALL CONT(ITAPE,C1,C2,L1,L2,NCD,NXC,MAT,MF,MT)
!
!     PROCESS EACH TEXT CARD
!
      IF(NCD.LE.0)   GO TO 37
      DO 25 N=1,NCD
!*****OUTPUT NEW PAGE
      IF(OUTPUT.GT.0.AND.MOD(N,LPPAGE).EQ.1)   WRITE(OUTPUT,10)
   10 FORMAT('1')
      CALL TEXTR(ITAPE,HOL,MAT,MF,MT)
      IF(N.GT.2)   GO TO 15
      NB = 66*(N-1) + 1
      NE = NB + 65
      FHOL(NB:NE) = HOL
   15 IF(OUTPUT.GT.0) WRITE(OUTPUT,20) HOL
   20 FORMAT(30X,A66)
   25 CONTINUE
!
!     OUTPUT TO SUMMARY STRUCTURED FREE TEXT INFORMATION
!
      DO 32 K=1,NHEADS
      IB = HLENL(K)
      IU = HLENU(K)
      STEXT = FHOL(IB:IU)
      WRITE(SOUT,30) HEADS(K),STEXT
   30 FORMAT(43X,A23,1X,A33)
   32 CONTINUE
!
!     OUTPUT SUMMARY FOR 451
!
      WRITE(SOUT,35)  NCD,NXC
   35 FORMAT(//30X,'Total number of COMMENT RECORDS: ',I3/              &       
     &         30X,'Total number of DATA SECTIONS:   ',I3)
!
!     PROCESS THE DIRECTORY IF PRESENT
!
   37 IF(NXC.LE.0)  GO TO 100
      MTBCD = DICTON
!
!     WRITE DIRECTORY HEADING FOR SUMMARY
!
      WRITE(SOUT,38)
   38 FORMAT(//58X,'TABLE OF CONTENTS'//57X,'Section Numbers(MOD)'/     &       
     &  32X,10(' ------'))
!
!     WRITE PAGE LABEL
!
      CALL TOPAGE
!
!     WRITE TABLE COLUMN HEADINGS
!
      IF(OUTPUT.GT.0) WRITE(OUTPUT,40)
   40 FORMAT(29X,'Data Type',36X,'Reaction',17X,'Records',5X,           &       
     &   'MOD Number'/)
!
!     WRITE TWO TABLE ENTRIES FOR FREE TEXT AND TABLE OF CONTENTS
!
      CALL CONT(ITAPE,C1,C2,MFZ,MTZ,NCZ,NMODZ,MAT,MF,MT)
      NCZ=NCZ-NXC
      CALL MTID(NFOR,NSUB,MTZ,MTBCD,IERR)
      IF(OUTPUT.GT.0) WRITE(OUTPUT,45)  MFBCD,MTBCD,NCZ,NMODZ
   45 FORMAT(10X,A48,5X,A30,2I11)
      MTBCD = DICTON
      MFBCD = ' '
      IF(OUTPUT.GT.0) WRITE(OUTPUT,45) MFBCD,MTBCD,NXC,NMODZ
!
!     INITIALIZE FILE
!
      MFX=1
      CALL DIROUT(SOUT,MFZ,MTZ,NMODZ)
      IF(NXC.LT.2) GO TO 90
!
!     SET UP LOOP OVER REMAINING DIRECTORY CARDS
!
      DO 80 I=2,NXC
      CALL CONT(ITAPE,C1,C2,MFZ,MTZ,NCZ,NMODZ,MAT,MF,MT)
!
!     IF FILE NUMBER HAS CHANGED COMPUTE NEW HOLLERITH
!
      IF(MFZ.NE.MFX) GO TO 50
      MFBCD = ' '
      CALL DIROUT(SOUT,0,MTZ,NMODZ)
      GO TO 60
   50 CALL MFID(NSUB,MFZ,MTZ,MFBCD,IERR)
      MFX = MFZ
      CALL DIROUT(SOUT,MFZ,MTZ,NMODZ)
!
!     COMPUTE NEW HOLLERITH FOR REACTION
!
   60 CALL MTID(NFOR,NSUB,MTZ,MTBCD,IERR)
!
!     WRITE HOLLERITH EQIVALENTS OF FILE AND REACTION PLUS CARD COUNT
!
      IF(OUTPUT.GT.0) WRITE(OUTPUT,45) MFBCD,MTBCD,NCZ,NMODZ
   80 CONTINUE
!
!     DUMP REMAINING DIRECTORY SUMMARY
!
   90 CALL DIROUT(SOUT,99,0,0)
!
!     RESTORE FILE IDENTIFICATION
!
      CALL HEADIN(0,1,451,-1.)
!
!     SKIP SEND CARD
!
  100 CALL SKPREC(ITAPE,1)
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE DIROUT(OUT,IFILE,MT,SMOD)
!
!     ROUTINE TO BUILD AND BUFFER OUT DIRECTORY SUMMARY
!
      INTEGER OUT,SMOD
      CHARACTER(LEN=8) FSTRNG
      CHARACTER(LEN=70) DSTRNG
      CHARACTER(LEN=7) TSTRNG
!
!+++MDC+++
!...ANS
!/      SAVE NEXT,FSTRNG,DSTRNG
!---MDC---
!
      DATA NEXT/0/
!
!     START OF NEW LINE REQUIRED
!
      IF(IFILE.EQ.1)   GO TO 30
      IF(IFILE.EQ.0.AND.NEXT.LT.70)   GO TO 50
      IF(FSTRNG.EQ.' ')  THEN
         WRITE(OUT,10) DSTRNG
   10    FORMAT(33X,A70)
      ELSE
         WRITE(OUT,20) FSTRNG,DSTRNG
   20    FORMAT(/23X,A8,2X,A70)
      END IF
      IF(IFILE.EQ.100)   GO TO 100
!
!     INITIALIZE A NEW LINE
!
   30 NEXT = 1
      DSTRNG = ' '
      FSTRNG = ' '
!
!     SET UP NEXT FILE ID
!
      IF(IFILE.EQ.0)   GO TO 50
      WRITE(FSTRNG,40)  IFILE
   40 FORMAT('FILE#',I3)
!
!     ADD NEW SECTION
!
   50 WRITE(TSTRNG,60)  MT,SMOD
   60 FORMAT(I3,'(',I1,') ')
      DSTRNG(NEXT:NEXT+6) = TSTRNG
      NEXT = NEXT + 7
!
  100 RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE FILE1B(NDEL)
!
!     PROCESS NUBAR
!
      COMMON A(100),C(10),NBT(200),INT(200),X(50000),Y(50000)
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/TOPPER/LIBBCD,MFBCD,MTBCD,ZABCD
      CHARACTER(LEN=14) LIBBCD
      CHARACTER(LEN=48) MFBCD
      CHARACTER(LEN=30) MTBCD
      CHARACTER(LEN=24) ZABCD
      COMMON/HEADI/ZAI,AWRI,L1I,LNU,N1I,N2I,MATI,MFI,MTI
!
      PARAMETER (IBASE=0,ERANGE=2.0E+10)
!
      CHARACTER(LEN=24) HEAD
      CHARACTER(LEN=24) UNIT
      CHARACTER(LEN=4) DEGREE(6)
!
      DATA HEAD/'   Energy       NU      '/
      DATA UNIT/'     eV                 '/
      DATA DEGREE/'ZERO','1-ST','2-ND','3-RD','4-TH','5-TH'/
!
!     WRITE PAGE HEADING
!
      CALL TOPAGE
!
!     READ AND OUTPUT DECAY CONSTANTS
!
      IF(MTI.NE.455)   GO TO 20
      CALL CANT(ITAPE,C1,C2,L1,L2,NNF,N2,MAT,MF,MT,A)
      IF(OUTPUT.GT.0) WRITE(OUTPUT,10)
   10 FORMAT(/6X,'Decay Constants'/11X,'(1/sec)'/)
      IF(OUTPUT.GT.0) WRITE(OUTPUT,15) (A(I),I=1,NNF)
   15 FORMAT(9X,1PE11.4)
!
!     BRANCH ON DATA FORMAT
!
   20 IF(LNU.NE.1)  GO TO 150
!
!     DATA IS POLYNOMIAL COEFFICIENTS
!
      CALL CANT(ITAPE,C1,C2,L1,L2,NR,NP,MAT,MF,MT,C)
      NC = NR
!
!     RECONSTRUCT POLYNOMIAL AT 200 EQUALLY SPACED POINTS
!
      DX=10.**(ALOG10(ERANGE)/200.)
      X(1)=10.E-3
      DO I=1,201
         ET = X(I)
         Y(I) = C(1)
         IF(NC.GE.2)  THEN
            DO J=2,NC
               Y(I) = Y(I)+C(J)*ET
               ET = ET*X(I)
            END DO
            X(I+1)=X(I)*DX
         END IF
   50 END DO
      NP = 201
!
!     OUTPUT POLYNOMIAL DATA
!
      IF(NC.GT.1) GO TO 120
      IF(OUTPUT.GT.0.AND.NDEL.EQ.0)  WRITE(OUTPUT,110) C(1)
  110 FORMAT(/' The average number of neutrons per fission is CONSTANT',&       
     &   1PE11.4)
      IF(OUTPUT.GT.0.AND.NDEL.EQ.1)  WRITE(OUTPUT,115)  C(1)
  115 FORMAT(/' The average number of delayed neutrons per fission is ',&       
     &   'CONSTANT',1PE11.4)
      GO TO 1000
  120 NCM1=NC-1
      IF(OUTPUT.GT.0) WRITE(OUTPUT,130)
  130 FORMAT(/' Polynomial Coefficients for NU-BAR')
      IF(OUTPUT.GT.0) WRITE(OUTPUT,135) IBASE,C(1),(I,C(I+1),I=1,NCM1)
  135 FORMAT(8(I3,1PE11.4))
      IF(OUTPUT.GT.0) WRITE(OUTPUT,140)
  140 FORMAT(/' Reconstructed Values of NU-BAR')
      GO TO 250
!
!     DATA IS TABULAR
!
  150 CALL CANT1(ITAPE,C1,C2,L1,L2,NR,NP,MAT,MF,MT,NBT,INT,X,Y)
      CALL INTAB(NBT,INT,NR,1,OUTPUT)
      IF(OUTPUT.GT.0) WRITE(OUTPUT,210)
  210 FORMAT(/' Tabulated Values of NU-BAR')
!
!     OUTPUT TABLE
!
  250 CALL WRTAB1(OUTPUT,HEAD,UNIT,X,Y,NP)
!
!      OUTPUT TO SUMMARY TABLE
!
      IF(MTI.NE.455)   GO TO 300
      IF(LNU.EQ.1)  WRITE(SOUT,260)  MTI,MTBCD,DEGREE(NC),NNF
  260 FORMAT(/I6,3X,A30,4X,'Specified by a ',A4,' DEGREE POLYNOMIAL',   &       
     &   ' for ',I2,' groups')
      IF(LNU.EQ.2)  WRITE(SOUT,270) MTI,MTBCD,NP,NR,NNF
  270 FORMAT(/I6,3X,A30,4X,'Specified at ',I4,' ENERGY POINTS with ',I3,&       
     &   ' INTERPOLATION REGIONS for ',I2,' GROUPS')
      GO TO 1000
  300 IF(LNU.EQ.1)  WRITE(SOUT,310)  MTI,MTBCD,DEGREE(NC)
  310 FORMAT(/I6,3X,A30,4X,'Specified by a ',A4,' DEGREE POLYNOMIAL')
      IF(LNU.EQ.2)  WRITE(SOUT,320) MTI,MTBCD,NP,NR
  320 FORMAT(/I6,3X,A30,4X,'Specified at ',I4,' ENERGY POINTS with ',   &       
     &   I3,' INTERPOLATION REGIONS')
!
 1000 RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE FILE1C
!
!     ROUTINE TO PROCESS ENERGY RELEASE IN FISSION
!
      COMMON A(100),C(10),NBT(200),INT(200),X(50000),Y(50000)
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/TOPPER/LIBBCD,MFBCD,MTBCD,ZABCD
      CHARACTER(LEN=14) LIBBCD
      CHARACTER(LEN=48) MFBCD
      CHARACTER(LEN=30) MTBCD
      CHARACTER(LEN=24) ZABCD
      COMMON/HEADI/ZAI,AWRI,L1I,LNU,N1I,N2I,MATI,MFI,MTI
!
      CHARACTER(LEN=38) LINE(9)
      DATA LINE/'Fragment Kinetic Energy               ',               &       
     &          'Prompt Fission Neutron Kinetic Energy ',               &       
     &          'Delayed Fission Neutron Kinetic Energy',               &       
     &          'Prompt Gamma-ray Emission             ',               &       
     &          'Delayed Gamma-ray Emission            ',               &       
     &          'Delayed Beta                          ',               &       
     &          'Neutrino                              ',               &       
     &          'Total Energy Less Neutrino Energy     ',               &       
     &          'Total Energy Release per Fission      '/
!
!     WRITE PAGE HEADING
!
      CALL TOPAGE
!
!     READ IN DATA
!
      CALL CANT(ITAPE,C1,C2,L1,L2,NR,NP,MAT,MF,MT,A)
!
!     OUTPUT HEADING
!
      IF(OUTPUT.GT.0) WRITE(OUTPUT,10)
   10 FORMAT(//'     Components of Energy Release Due to Fission',      &       
     &         13X,'Energy(eV/fission)'/5X,43('-'),13X,18('-'))
      NL = 1
      DO I=1,NP
         IF(OUTPUT.GT.0) WRITE(OUTPUT,25) LINE(I),A(NL),A(NL+1)
   25    FORMAT(10X,A38,10X,1PE12.5,' +/- ',1PE12.5,' eV/fission')
         NL = NL + 2
      END DO
!
!     OUTPUT TO SUMMARY
!
      WRITE(SOUT,75) MTI,MTBCD,A(NR-1)
   75 FORMAT(/I6,3X,A30,4X,'Total Energy Release per Fission is',       &       
     &   1PE11.4,' EV')
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE FILE2
!
!     ROUTINE TO PROCESS RESONANCE REGION DATA
!
      COMMON ZARI,ABN,LFW,NER,EL,EH,LRU,LRF,SPI,AP,NLS,NJS,QX(5),LRX(5),&       
     &  L(5),NJSA(5),AJ(20),NRS(20),JNT(20),AJL(6),MUF(6),NE(6),ES(250),&       
     &  RES(47728),NRO,NBT(200),INT(200),NR,X(1000),Y(1000),NP,C(18),NX,&       
     &  DUM(50000)
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/TOPPER/LIBBCD,MFBCD,MTBCD,ZABCD
      CHARACTER(LEN=14) LIBBCD
      CHARACTER(LEN=48) MFBCD
      CHARACTER(LEN=30) MTBCD
      CHARACTER(LEN=24) ZABCD
      COMMON/HEADI/ZAI,AWRI,L1I,L2I,NIS,N2I,MATI,MFI,MTI
!
      CHARACTER(LEN=24) ZAIBCD
!
!     SET IDENTIFICATION FOR THE FILE
!
      CALL HEADIN(MATI,MFI,MTI,-1.0)
!
!     OUTPUT FILE HEADING FOR SUMMARY
!
      CALL FILEHD(MFI)
      WRITE(SOUT,5)   MTBCD
    5 FORMAT(/'   151',3X,A30)
!
!     SET UP LOOP OVER ISOTOPES
!
      DO 200 I=1,NIS
      CALL CONT(ITAPE,ZARI,ABN,L1,LFW,NER,N2,MAT,MF,MT)
!
!     OUTPUT ISOTOPE HEADING TO SUMMARY
!
      CALL ZAID(ZARI,ZAIBCD,IERR)
      WRITE(SOUT,10)  ZAIBCD
   10 FORMAT(//40X,'Isotope  ',A24/40X,'-------')
!
!     SET UP LOOP OVER ENERGY RANGES
!
      DO 180 JJ=1,NER
      J = JJ
      CALL CONT(ITAPE,EL,EH,LRU,LRF,NRO,N2,MAT,MF,MT)
!
!     READ ENERGY DEPENDENT SCATTERING LENGTH
!
      IF(NRO.EQ.0)   GO TO 20
      CALL CANT1(ITAPE,C1,C2,L1,L2,NR,NP,MAT,MF,MT,NBT,INT,X,Y)
!
!     NO RESONANCE PARAMETERS GIVEN
!
   20 IF(LRU.EQ.0) THEN
         CALL CONT(ITAPE,SPI,AP,L1,L2,NLS,N2,MAT,MF,MT)
         CALL LIST2H(J)
         GO TO 180
      END IF
!
!     RESONANCES ARE RESOLVED
!
      IF(LRU.EQ.2) GO TO 100
      CALL CONT(ITAPE,SPI,AP,L1,L2,NLS,N2,MAT,MF,MT)
      CALL LIST2H(J)
!
!     SINGLE - AND MULTI-LEVEL BREIT-WIGNER AND R-MATRIX PARAMETERS
!
      IF(LRF.EQ.4) GO TO 70
      IF(LRF.EQ.6) GO TO 85
      K4 = 1
      DO III=1,NLS
         CALL CANT(ITAPE,C1,QX(III),L(III),LRX(III),NT,NRS(III),        &       
     &       MAT,MF,MT,RES(K4))
         K4 = K4 + NT
      END DO
      CALL LIST2A
      GO TO 180
!
!     RESOLVED ADLER-ADLER PARAMETERS
!
   70 CALL CANT(ITAPE,C1,C2,LI,L2,NT,NX,MAT,MF,MT,C)
      K4 = 1
      K5 = 1
      DO 80 III=1,NLS
      CALL CONT(ITAPE,C1,C2,L(III),L2,NJS,N2,MAT,MF,MT)
      NJSA(III) = NJS
      DO JJJ=1,NJS
         CALL CANT(ITAPE,AJ(K5),C2,L1,L2,NT,NRS(K5),MAT,MF,MT,RES(K4))
         K5 = K5 + 1
         K4 = K4 + NT
      END DO
   80 CONTINUE
      CALL LIST2A
      GO TO 180
!
!     HYBRID R-FUNCTION
!
   85 CALL CONT(ITAPE,C1,C2,NGRE,NFRE,NIRE,NCRE,MAT,MF,MT)
      NCOMCH = NIRE + NCRE
      CALL CONT(ITAPE,C1,C2,LRX(1),LRX(2),LRX(3),LRX(4),MAT,MF,MT)
      CALL CANT(ITAPE,C1,C2,L1,L2,N1,N2,MAT,MF,MT,QX)
      IF(NCOMCH.GT.0)  THEN
         WRITE(SOUT,87) NCOMCH
   87    FORMAT(49X,I1,' Competing Reaction Channels')
         IF(OUTPUT.NE.0) WRITE(OUTPUT,87) NCOMCH
         DO 90 III=1,NCOMCH
         WRITE(SOUT,88)  LRX(III),QX(III)
   88    FORMAT(52X,'Reaction = ',I3,' Q = ',1PE11.4)
         IF(OUTPUT.NE.0) WRITE(OUTPUT,88) LRX(III),QX(III)
   90    CONTINUE
      END IF
      WRITE(SOUT,95)
   95 FORMAT(                                                           &       
     &  /53X,'Angular     Channel     Spin     Resonances'/             &       
     &   53X,'Momentum     Spin     '/                                  &       
     &   53X,'  (L)        (AS)       (AJ)        (NRS)'/               &       
     &   53X,'--------    -------     ----     ----------')
      CALL LIST2B(NCOMCH,NCRE)
      GO TO 180
!
!     RESONANCES ARE UNRESOLVED.
!
  100 IF(LRF.EQ.2) GO TO 160
      IF(LFW.EQ.0) GO TO 130
!
!     ISOTOPE IS FISSILE
!
      CALL CANT(ITAPE,SPI,AP,L1,L2,NEL,NLS,MAT,MF,MT,ES)
      CALL LIST2H(J)
      NE(1)=NEL
      DO 120 I3=1,NLS
      III = I3
      CALL CONT(ITAPE,C1,C2,L(III),L2,NJS,N2,MAT,MF,MT)
      K6=1
      DO JJJ=1,NJS
         CALL CANT(ITAPE,C1,C2,L1,MUF(JJJ),NEPL6,N2,MAT,MF,MT,RES(K6))
         K6=K6+NEPL6
      END DO
      CALL LIST2C(III)
  120 CONTINUE
      GO TO 180
!
!     ISOTOPE IS NON-FISSILE
!
  130 CALL CONT(ITAPE,SPI,AP,L1,L2,NLS,N2,MAT,MF,MT)
      CALL LIST2H(J)
      DO 150 I3=1,NLS
      III = I3
      CALL CANT(ITAPE,C1,C2,L(III),L2,NJS6X,NJS,MAT,MF,MT,RES)
      CALL LIST2C(III)
  150 CONTINUE
      GO TO 180
!
!     ALL ENERGY DEPENDENT PARAMETERS
!
  160 CALL CONT(ITAPE,SPI,AP,L1,L2,NLS,N2,MAT,MF,MT)
      CALL LIST2H(J)
      DO 170 I3=1,NLS
      III = I3
      CALL CONT(ITAPE,C1,C2,L(III),L2,NJS,N2,MAT,MF,MT)
      K6=1
      DO JJJ=1,NJS
         CALL CANT(ITAPE,AJL(JJJ),C2,JNT(JJJ),L2,NEL6X,NE(JJJ),MAT,MF,  &       
     &      MT,RES(K6))
         K6=K6+NEL6X
      END DO
      CALL LIST2C(III)
  170 CONTINUE
!
!     END OF LOOP ON ENERGY REGIONS
!
  180 CONTINUE
!
!     END OF LOOP ON ISOTOPES
!
  200 CONTINUE
!
!     SKIP TO THE END OF THE FILE
!
      CALL SKPFIL(ITAPE)
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE LIST2H(J)
!
!     ROUTINE TO LIST RESONANCE PARAMETER HEADINGS
!
      COMMON/TOPI/NLIB,NVER,NREL,NSUB,MATIN,AWI,NMOD,NFOR
      COMMON ZARI,ABN,LFW,NER,EL,EH,LRU,LRF,SPI,AP,NLS,NJS,QX(5),LRX(5),&       
     &  L(5),NJSA(5),AJ(20),NRS(20),JNT(20),AJL(6),MUF(6),NE(6),ES(250),&       
     &  RES(47728),NRO,NBT(200),INT(200),NR,X(1000),Y(1000),NP,C(18),NX,&       
     &  DUM(50000)
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
!
      CHARACTER(LEN=24) ZABCD
      CHARACTER(LEN=48) RESOP(8)
      CHARACTER(LEN=24) HEAD
      CHARACTER(LEN=24) UNIT
!
      DATA RESOP/'Resolved Resonance Parameters NOT GIVEN      ',       &       
     &       'Resolved Single-Level BREIT-WIGNER Parameters',           &       
     &       'Resolved Multi-Level BREIT-WIGNER Parameters',            &       
     &       'Resolved Multi-Level R-MATRIX Parameters',                &       
     &       'Resolved Multi-Level ADLER-ADLER Parameters',             &       
     &       'Resolved Multi-Level REICH-MOORE Parameters',             &       
     &       'Resolved HYBRID R-FUNCTION Parameters',                   &       
     &       'Unresolved Single-Level BREIT-WIGNER Parameters'/
!
      DATA HEAD/'   Energy     Length    '/
      DATA UNIT/'     eV     10**-12 cm  '/
!
!     OUTPUT PAGE HEADER
!
      CALL TOPAGE
!
!     OUTPUT ISOTOPE ID TEXT
!
      CALL ZAID(ZARI,ZABCD,IERR)
      IF(OUTPUT.GT.0) WRITE(OUTPUT,5) ZABCD,ABN
    5 FORMAT(' Isotope----------------------',1X,A24/                   &       
     &       ' Fractional abundance---------',1PE11.4)
!
!     OUTPUT REGION TYPE AND RANGE TO SUMMARY
!
      IF(LRU.LT.2)  THEN
         WRITE(SOUT,8)  EL,EH
    8    FORMAT(/46X,'RESOLVED RESONANCE REGION from',1PE11.4,' to',    &       
     &      1PE11.4,' eV')
      ELSE
         WRITE(SOUT,10)  EL,EH
   10    FORMAT(/46X,'UNRESOLVED RESONANCE REGION from',1PE11.4,' to',  &       
     &      1PE11.4,' eV')
      END IF
      WRITE(SOUT,15)  SPI
   15 FORMAT(49X,'Nuclear Spin is',1PE11.4)
!
!     OUTPUT PARAMETER TYPE TO SUMMARY
!
      IF(LRU.LT.2)  THEN
         LRF1 = LRF + 1
         IF(LRF.EQ.3.AND.NFOR.EQ.5)   LRF1 = 6
         ISTAR = 10
      ELSE
         LRF1 = 8
         ISTAR = 12
      END IF
      WRITE(SOUT,16)  RESOP(LRF1)(ISTAR:)
   16 FORMAT(/49X,A)
!
!     OUTPUT PARAMETER OPTION
!
      IF(OUTPUT.LE.0) GO TO 25
      WRITE(OUTPUT,20) NER,J,RESOP(LRF1),EL,EH,SPI
   20 FORMAT(' Number of energy ranges------',I11//                     &       
     &       ' Energy range number----------',I11,3X,A/                 &       
     &       ' Lower energy limit (eV)------',1PE11.4/                  &       
     &       ' Upper energy limit (eV)------',1PE11.4/                  &       
     &       ' Nuclear spin-----------------',1PE11.4)
      IF(LRU.NE.0)  WRITE(OUTPUT,22) NLS
   22 FORMAT(' Number of L states-----------',I11)
!
!      OUTPUT IF CONSTANT SCATTERING LENGTH
!
   25 IF(LRF.GT.4)   GO TO 50
      IF(NRO.GT.0)   GO TO 30
      IF(LRF.EQ.3)   GO TO 50
      IF(OUTPUT.GT.0) WRITE(OUTPUT,26) AP
   26 FORMAT(' Scattering length (A)--------',1PE11.4)
      WRITE(SOUT,27)
   27 FORMAT(49X,'Energy Independent Scattering Length')
      GO TO 50
!
!     OUTPUT ENERGY DEPENDENT SCATTERING LENGTH
!
   30 CALL INTAB(NBT,INT,NR,1,OUTPUT)
      IF(OUTPUT.GT.0) WRITE(OUTPUT,35)
   35 FORMAT(/' Energy Dependent Scattering Length')
      CALL WRTAB1(OUTPUT,HEAD,UNIT,X,Y,NP)
      WRITE(SOUT,40) NP,NR
   40 FORMAT(49X,'Energy Dependent Scattering Length specified at'/     &       
     &  52X,I3,' ENERGY POINTS with ',I4,' INTERPOLATION REGIONS')
!
!     OUTPUT OF HEADING FOR RESONANCE SUMMARY TABLE
!
   50 IF(LRU.EQ.1) THEN
         IF(LRF.EQ.6)   GO TO 100
         WRITE(SOUT,75)
   75    FORMAT(                                                        &       
     &     /53X,'Angular      Spin     Resonances'/                     &       
     &      53X,'Momentum'/                                             &       
     &      53X,'  (L)        (AJ)        (NRS)'/                       &       
     &      53X,'--------     ----     ----------')
      ELSE IF(LRU.EQ.2) THEN
         WRITE(SOUT,85)
   85    FORMAT(                                                        &       
     & /53X,'Angular      Spin       Energy      Number       Interp.'/ &       
     &  53X,'Momentum              Dependence   Energies      Scheme '/ &       
     &  53X,'   (L)       (AJ)                    (NE)         (INT) '/ &       
     &  53X,'--------     ----      --------     ------       -------')
      END IF
!
  100 RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE LIST2A
!
!     ROUTINE TO LIST RESOLVED RESONANCE PARAMETERS EXCEPT HYBRID
!        R-FUNCTION
!
      COMMON ZARI,ABN,LFW,NER,EL,EH,LRU,LRF,SPI,AP,NLS,NJS,QX(5),LRX(5),&       
     &  L(5),NJSA(5),AJ(20),NRS(20),JNT(20),AJL(6),MUF(6),NE(6),ES(250),&       
     &  RES(47728),NRO,NBT(200),INT(200),NR,X(1000),Y(1000),NP,C(18),NX,&       
     &  DUM(50000)
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
!
      INTEGER NOFJ(20)
!
      CHARACTER(LEN=10) CTYPE(3)
      DATA CTYPE/'TOTAL','FISSION','CAPTURE'/
!
!     OUTPUT RESONANCE PARAMETERS EXCEPT FOR ADLER-ADLER
!
      IF(LRF.EQ.4) GO TO 110
      K6 = 0
      DO 100 III=1,NLS
      FL = FLOAT(L(III))
      SPMIN = ABS(ABS(SPI-FL) - 0.5)
      DO JJJ=1,20
         NOFJ(JJJ) = 0
      END DO
      IF(OUTPUT.GT.0.AND.NLS.GT.1) WRITE(OUTPUT,50)
   50 FORMAT('1')
      IF(OUTPUT.GT.0) WRITE(OUTPUT,60) L(III),NRS(III)
   60 FORMAT(///' L value----------------------',I11/                   &       
     &          ' Number of resonances---------',I11)
      IF(OUTPUT.GT.0.AND.LRX(III).EQ.1)   WRITE(OUTPUT,65) QX(III)
   65 FORMAT(   ' Competitive width Q-value----',1PE11.4)
      KADD = 6
      IF(OUTPUT.EQ.0) GO TO 75
      IF(LRF.NE.3)  THEN
         WRITE(OUTPUT,70)
   70    FORMAT(/44X,' Resonance Widths (eV)'/' Index  Energy (eV)    ',&       
     &    'J value      Total        Neutron    Radiation      ',       &       
     &    'Fission'/)
      ELSE
         WRITE(OUTPUT,74)
   74    FORMAT(/44X,' Resonance Widths (eV)'/' Index  Energy (eV)    ',&       
     &    'J value      Neutron    Radiation     Fission-1    ',        &       
     &    'Fission-2'/)
      END IF
   75 K5=NRS(III)
      DO 90 KN=1,K5
      K6L = K6 + 1
      K6 = K6 + KADD
      IF(OUTPUT.GT.0) WRITE(OUTPUT,80)  KN,(RES(K4),K4=K6L,K6)
   80 FORMAT(I5,2X,7(1PE11.4,2X))
      JJJ = RES(K6L+1) - SPMIN + 1.001
      NOFJ(JJJ) = NOFJ(JJJ) + 1
   90 CONTINUE
      SPMAX = SPI + FL + 0.5
      AJJ = SPMIN
      DO 97 JJJ=1,20
      IF(JJJ.EQ.1)  WRITE(SOUT,93)  FL,AJJ,NOFJ(JJJ)
   93 FORMAT(53X,F5.1,F12.1,I13)
      IF(JJJ.GT.1)  WRITE(SOUT,95)  AJJ,NOFJ(JJJ)
   95 FORMAT(58X,F12.1,I13)
      AJJ = AJJ + 1.
      IF(AJJ.GT.SPMAX)  GO TO 100
   97 CONTINUE
  100 CONTINUE
      GO TO 1000
!
!     PARAMETER OUTPUT FOR ADLER-ADLER
!
  110 IF(OUTPUT.GT.0) WRITE(OUTPUT,120)
  120 FORMAT(//10X,'ADLER-ADLER Background Cross Section'/)
      DO 130 K=1,NX
      JL = 6*(K-1) + 1
      IF(OUTPUT.GT.0) WRITE(OUTPUT,125) CTYPE(K),(C(JJJ),JJJ=JL,JL+5)
  125 FORMAT(1X,A10,'(C/SQRT(E))*(',1PE11.4,' + ',1PE11.4,'/E + ',      &       
     &  1PE11.4,'/E**2 + ',1PE11.4,'/E**3 + ',1PE11.4,'*E + ',          &       
     &  1PE11.4,'*E**2)')
  130 CONTINUE
      K6 = 0
      K5 = 1
      DO 180 III=1,NLS
      NJS = NJSA(III)
      FL = FLOAT(L(III))
      DO JJJ=1,NLS
      IF(OUTPUT.GT.0.AND.(NLS.GT.1.OR.NJSA(1).GT.1)) WRITE(OUTPUT,50)
      IF(OUTPUT.GT.0) WRITE(OUTPUT,135) L(III),AJ(K5),NRS(K5)
  135 FORMAT(///' L value----------------------',I11/                   &       
     &          ' J value----------------------',1PE11.4/               &       
     &          ' Number of resonances---------',I11)
      IF(OUTPUT.GT.0) WRITE(OUTPUT,150)
  150 FORMAT(/44X,' RESONANCE PARAMETERS'/' Index    MU(eV)    ',       &       
     & '   NU(eV)        G(T)         H(T)         G(F)     ',          &       
     & '    H(F)         G(C)         H(C)'/)
      K4=NRS(K5)
      DO KN=1,K4
         IF(OUTPUT.GT.0) WRITE(OUTPUT,175)  KN,(RES(K3),K3=K6+1,K6+4),  &       
     &        RES(K6+7),RES(K6+8),RES(K6+11),RES(K6+12)
  175    FORMAT(I5,2X,8(1PE11.4,2X))
         K6=K6+12
      END DO
      IF(JJJ.EQ.1)   WRITE(SOUT,93)  FL,AJ(K5),NRS(K5)
      IF(JJJ.GT.1)   WRITE(SOUT,95)  AJ(K5),NRS(K5)
      K5 = K5 + 1
      END DO
  180 CONTINUE
!
 1000 RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE LIST2B(NCOMCH,NCRE)
!
!     ROUTINE TO LIST HYBRID R-FUNCTION DATA
!
      COMMON ZARI,ABN,LFW,NER,EL,EH,LRU,LRF,SPI,AP,NLS,NJS,QX(5),LRX(5),&       
     &  L(5),NJSA(5),DU(20),NRS(20),JNT(20),AJL(6),MUF(6),NE(6),ES(250),&       
     &  RES(47728),NRO,NBT(200),INT(200),NR,X(1000),Y(1000),NP,C(18),NX,&       
     &  DUM(50000)
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
!
      CHARACTER(LEN=24) HEAD
      CHARACTER(LEN=24) UNIT
      CHARACTER(LEN=6) ORDS(4)
!
      DATA HEAD/'   Energy       Data    '/
      DATA UNIT/'     eV                 '/
      DATA ORDS/'First ','Second','Third ','Fourth'/
!
!     PROCESS CHARGED PARTICLE PENETRABILITIES
!
      IF(NCRE.GT.0)  THEN
         DO 25 NCR=1,NCRE
         DO 15 LIL=1,4
         CALL CANT1(ITAPE,C1,C2,L1,L2,NR,NP,MAT,MF,MT,NBT,INT,X,Y)
         IF(OUTPUT.EQ.0)   GO TO 25
         WRITE(OUTPUT,10) ORDS(NCR),LIL-1
   10    FORMAT(/38X,'Charged Particle Penetrability for ',A6,' CP ',   &       
     &      'Channel, L=',I1/38X,52('-')/)
         CALL INTAB(NBT,INT,NR,1,OUTPUT)
         CALL WRTAB1(OUTPUT,HEAD,UNIT,X,Y,NP)
   15    CONTINUE
   25    CONTINUE
      END IF
!
!     PROCESS ALL L-VALUES
!
      DO 95 NL=1,NLS
      CALL CONT(ITAPE,C1,C2,LL,L2,NSS,N2,MAT,MF,MT)
      FLL = LL
!
!     OUTPUT CURRENT L AND NUMBER OF S VALUES
!
      IF(OUTPUT.GT.0) WRITE(OUTPUT,5) LL,NSS
    5 FORMAT(///' L value----------------------',I11/                   &       
     &          ' Number of S States-----------',I11)
!
!     PROCESS ALL CHANNEL SPIN STATES
!
      DO NS=1,NSS
      CALL CONT(ITAPE,AS,C2,L1,L2,NJS,N2,MAT,MF,MT)
!
!     OUTPUT CURRENT L AND S AND NUMBER OF J VALUES
!
      IF(OUTPUT.GT.0) WRITE(OUTPUT,30) LL,AS,NJS
   30 FORMAT(///21X,'L value----------------------',I11/                &       
     &          21X,'S value----------------------',F11.1/              &       
     &          21X,'Number of J States-----------',I11)
!
!     PROCESS ALL TOTAL SPIN STATES
!
      DO 90 NJ=1,NJS
      CALL CANT(ITAPE,AJ,C2,LBK,LPS,N1,NLSJ,MAT,MF,MT,RES)
      IF(OUTPUT.EQ.0)  GO TO 55
      IF(NCOMCH.NE.0)  THEN
         WRITE(OUTPUT,35) AJ,(LRX(III),III=1,NCOMCH)
   35    FORMAT(/43X,'Resonance Parameters for J = ',F4.1,' in (eV)'/   &       
     &           43X,41('-')/' Index  Energy (eV)   ',                  &       
     &       'Neutron      ','Capture      ','Fission     ',            &       
     &       4('MT = ',I3,' (L-out)  '))
      ELSE
         WRITE(OUTPUT,36) AJ
   36    FORMAT(/43X,'Resonance Parameters for J = ',F4.1,' in (eV)'/   &       
     &           43X,41('-')/' Index  Energy (eV)   ',                  &       
     &       'Neutron      ','Capture      ','Fission     ')
      END IF
      WRITE(OUTPUT,37)
   37 FORMAT(' ')
      II = 2
!*****OUTPUT EACH RESONANCE
      DO 50 NN=1,NLSJ
      IF(NCOMCH.NE.0)  THEN
         IL = II + 3
         IU = II + NCOMCH + 2
         WRITE(OUTPUT,40) NN,RES(II-1),RES(II),RES(II+1),RES(II+2),     &       
     &       (RES(III),RES(III+4),III=IL,IU)
   40    FORMAT(I5,2X,4(1PE11.4,2X),4(1PE11.4,' (',0PF2.0,')',2X))
      ELSE
         WRITE(OUTPUT,42) NN,RES(II-1),RES(II),RES(II+1),RES(II+2)
   42    FORMAT(I5,2X,4(1PE11.4,2X))
      END IF
      II = II + 12
   50 CONTINUE
   55 IF(NJ.NE.1)    THEN
         WRITE(SOUT,60) AJ,NLSJ
   60    FORMAT(70X,F11.1,I13)
      ELSE
         IF(NS.NE.1) THEN
            WRITE(SOUT,62) AS,AJ,NLSJ
   62       FORMAT(58X,F12.1,F11.1,I13)
         ELSE
            WRITE(SOUT,65) FLL,AS,AJ,NLSJ
   65       FORMAT(53X,F5.1,F12.1,F11.1,I13)
         END IF
      END IF
!*****BACKGROUND COMPONENT
      IF(LBK.NE.0)  THEN
         CALL CANT1(ITAPE,C1,C2,L1,L2,NR,NP,MAT,MF,MT,NBT,INT,X,Y)
         IF(OUTPUT.EQ.0)   GO TO 72
         WRITE(OUTPUT,70)
   70    FORMAT(/38X,'Real Part of R-Function Background for this ',    &       
     &      'Channel'/38X,52('-')/)
         CALL INTAB(NBT,INT,NR,1,OUTPUT)
         CALL WRTAB1(OUTPUT,HEAD,UNIT,X,Y,NP)
   72    CALL CANT1(ITAPE,C1,C2,L1,L2,NR,NP,MAT,MF,MT,NBT,INT,X,Y)
         IF(OUTPUT.EQ.0)  GO TO 78
         WRITE(OUTPUT,75)
   75    FORMAT(/35X,'Imaginary Part of R-Function Background for ',    &       
     &      'this Channel'/35X,52('-')/)
         CALL INTAB(NBT,INT,NR,1,OUTPUT)
         CALL WRTAB1(OUTPUT,HEAD,UNIT,X,Y,NP)
   78    CONTINUE
      END IF
!*****OPTICAL MODEL PHASE SHIFT
      IF(LPS.NE.0)  THEN
         CALL CANT1(ITAPE,C1,C2,L1,L2,NR,NP,MAT,MF,MT,NBT,INT,X,Y)
         IF(OUTPUT.EQ.0)  GO TO 82
         WRITE(OUTPUT,80)
   80    FORMAT(/34X,'Real Part of the Optical Model Phase Shift ',     &       
     &      'for this Channel'/34X,60('-')/)
         CALL INTAB(NBT,INT,NR,1,OUTPUT)
         CALL WRTAB1(OUTPUT,HEAD,UNIT,X,Y,NP)
   82    CALL CANT1(ITAPE,C1,C2,L1,L2,NR,NP,MAT,MF,MT,NBT,INT,X,Y)
         IF(OUTPUT.EQ.0)  GO TO 88
         WRITE(OUTPUT,85)
   85    FORMAT(/31X,'Imaginary Part of the Optical Model Phase Shift ',&       
     &      'for this Channel'/31X,66('-')/)
         CALL INTAB(NBT,INT,NR,1,OUTPUT)
         CALL WRTAB1(OUTPUT,HEAD,UNIT,X,Y,NP)
   88    CONTINUE
      END IF
   90 CONTINUE
      END DO
   95 CONTINUE
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE LIST2C(III)
!
!     ROUTINE TO LIST UNRESOLVED RESONANCE PARAMETERS
!
      COMMON ZARI,ABN,LFW,NER,EL,EH,LRU,LRF,SPI,AP,NLS,NJS,QX(5),LRX(5),&       
     &  L(5),NJSA(5),AJ(20),NRS(20),JNT(20),AJL(6),MUF(6),NE(6),ES(250),&       
     &  RES(47728),NRO,NBT(200),INT(200),NR,X(1000),Y(1000),NP,C(18),NX,&       
     &  DUM(50000)
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
!
      CHARACTER(LEN=7) EDEP
!
      CHARACTER(LEN=8) ILAW(5)
      DATA ILAW/'CONSTANT','LIN LIN ','LIN LOG ','LOG LIN ','LOG LOG '/
!
!     OUTPUT CURRENT L AND NUMBER OF J VALUES
!
      IF(OUTPUT.GT.0) WRITE(OUTPUT,45) L(III),NJS
   45 FORMAT(///' L value----------------------',I11/                   &       
     &          ' Number of J States-----------',I11)
      FL = FLOAT(L(III))
!
!     BRANCH ON REPRESENTATION OPTION
!
      IF(LRF.EQ.2)   GO TO 200
!
!     ONLY FISSION WIDTHS ENERGY DEPENDENT
!
      IF(OUTPUT.GT.0) WRITE(OUTPUT,50)
   50 FORMAT(/41X,'Average Resonance Widths (eV)'/41X,29('-'))
      K6=1
      NEL = 0
      EDEP = '  NONE'
      IF(LFW.EQ.0)    GO TO 60
      EDEP = 'FISSION'
      NEL = NE(1)
   60 NEPL6 = NEL + 6
      NEL=NE(1)
      DO 150 K=1,NJS
      IF(OUTPUT.GT.0.AND.(K.EQ.1.OR.LFW.EQ.1)) WRITE(OUTPUT,70)
   70 FORMAT (' Level Spacing    J-value    Deg of Freedom   ',         &       
     &   'Neutron       Radiation'/)
      KH=K6+4
      IF(OUTPUT.GT.0) WRITE(OUTPUT,80) (RES(M),M=K6,KH)
   80 FORMAT(5(3X,1PE11.4))
!
!     OUTPUT ENERGY DEPENDENT FISSION WIDTH
!
      IF(LFW.EQ.0) GO TO 125
      IF(OUTPUT.GT.0) WRITE(OUTPUT,90) MUF(K)
   90 FORMAT(/'    Energy        Fission Width    ',                    &       
     &   'Degrees of Freedom used =',I5)
      KL=K6+6
      DO N=1,NEL
         IF(OUTPUT.GT.0) WRITE(OUTPUT,80) ES(N),RES(KL)
         KL=KL+1
      END DO
  125 IF(K.EQ.1)   WRITE(SOUT,130)  FL,RES(K6+1),EDEP,NEL,ILAW(2)
  130 FORMAT(53X,F6.1,F11.1,6X,A7,I11,8X,A8)
      IF(K.GT.1)   WRITE(SOUT,140)  RES(K6+1),EDEP,NEL,ILAW(2)
  140 FORMAT(59X,F11.1,6X,A7,I11,8X,A8)
      K6=K6+NEPL6
  150 END DO
      GO TO 1000
!
!     ALL PARAMETERS ENERGY DEPENDENT
!
  200 K6=1
      EDEP = '  ALL'
      DO 250 K=1,NJS
      NEL6X=6*NE(K)+6
      KL=K6+2
      KH=K6+5
      IF(OUTPUT.GT.0) WRITE(OUTPUT,210)
  210 FORMAT(///37X,'Degrees of Freedom used in the Width Distribution'/&       
     &   37X,49('-')/13X,'J-value     Interp.    Competitive    ',      &       
     &   'Neutron     Radiation     Fission')
      INTT = JNT(K)
      IF(OUTPUT.GT.0) WRITE(OUTPUT,220) AJL(K),ILAW(INTT),              &       
     &    (RES(M),M=KL,KH)
  220 FORMAT(10X,1PE11.4,4X,A8,2X,4(1PE11.4,2X))
      IF(OUTPUT.GT.0) WRITE(OUTPUT,230)
  230 FORMAT(/44X,'Average RESONANCE WIDTHS (eV)'/44X,29('-')/          &       
     &       ' Index    Energy(eV) Level Spacing  Competitive    ',     &       
     &       'Neutron    Radiation     Fission')
      NEL=NE(K)
      DO 240 N=1,NEL
      KL=KH+1
      KH=KL+5
      IF(OUTPUT.GT.0) WRITE(OUTPUT,235) N,(RES(M),M=KL,KH)
  235 FORMAT(I5,4X,6(1PE11.4,2X))
  240 CONTINUE
      INTT = JNT(K)
      IF(K.EQ.1)  WRITE(SOUT,130)  FL,AJL(K),EDEP,NE(K),ILAW(INTT)
      IF(K.GT.1)  WRITE(SOUT,140)  AJL(K),EDEP,NE(K),ILAW(INTT)
      K6=K6+NEL6X
  250 END DO
!
 1000 RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE FILE3
!
!     ROUTINE TO CONTROL PROCESSING OF FILE 3
!
      COMMON DUM(110),NBT(200),INT(200),X(50000),Y(50000)
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/TOPPER/LIBBCD,MFBCD,MTBCD,ZABCD
      CHARACTER(LEN=14) LIBBCD
      CHARACTER(LEN=48) MFBCD
      CHARACTER(LEN=30) MTBCD
      CHARACTER(LEN=24) ZABCD
      COMMON/TOPI/NLIB,NVER,NREL,NSUB,MATIN,AWI,NMOD,NFOR
      COMMON/XYCONT/NSCR,MAXY,NCONT,NA,NB,NN
      COMMON/HEADI/ZAI,AWRI,L1I,L2I,N1I,N2I,MATI,MFI,MTI
!
      CHARACTER(LEN=24) UNIT(2)
      CHARACTER(LEN=24) HEAD(2)
      CHARACTER(LEN=21) TITLE(3)
!
      DATA UNIT/'   Energy     Sigma     ',                             &       
     &          '   Energy      Data     '/
      DATA HEAD/'     eV       Barns     ',                             &       
     &          '     eV                 '/
      DATA TITLE/'CROSS SECTIONS       ',                               &       
     &           'SCATTERING PARAMETERS',                               &       
     &           'ENERGY DEPOSIT       '/
!
!     SET IDENTIFICATION FOR THE FILE
!
      CALL HEADIN(MATI,MFI,0,ZAI)
!
!     OUTPUT FILE HEADING TO SUMMARY
!
      CALL FILEHD(MFI)
!
!     SET SECTION ID INFORMATION
!
   10 CALL HEADIN(0,0,MTI,-1.0)
!
!     WRITE PAGE LABEL
!
      CALL TOPAGE
!
!     READ IN DATA FOR THE SECTION
!
      CALL CANT1(ITAPE,QM,QI,L1,LR,NR,NP,MAT,MF,MT,NBT,INT,X,Y)
!
!     OUTPUT Q VALUE(S)
!
      IF(NFOR.GT.5.OR.LR.NE.0)  GO TO 20
      IF(OUTPUT.GT.0.AND.QI.NE.0.0) WRITE(OUTPUT,15) QI
   15 FORMAT(/' Reaction Q-value             ',1PE11.4,' eV')
      GO TO 30
   20 IF(OUTPUT.GT.0.AND.QM.NE.0.0)   WRITE(OUTPUT,15) QM
      IF(OUTPUT.GT.0.AND.QI.NE.0.0)   WRITE(OUTPUT,25) QI
   25 FORMAT(/' Intermediate State Q-value   ',1PE11.4,' eV')
!
!     OUTPUT SECTION INFO TO SUMMARY
!
   30 CALL GETLIM(XMIN,XMAX,X,Y,NP)
      IF(NFOR.LT.6) THEN
         WRITE(SOUT,35) MTI,MTBCD,QI,NP,XMIN,XMAX,NR
   35    FORMAT(/I6,3X,A30,14X,1PE11.4,3X,I4,2X,1PE11.4,1X,1PE11.4,     &       
     &     4X,I3)
      ELSE
         WRITE(SOUT,37) MTI,MTBCD,QM,QI,NP,XMIN,XMAX,NR
   37    FORMAT(/I6,3X,A30,14X,2(1PE11.4,3X),I4,2X,1PE11.4,1X,          &       
     &     1PE11.4,4X,I3)
      END IF
!
!     OUTPUT INTERPOLATION TABLE
!
      CALL INTAB(NBT,INT,NR,1,OUTPUT)
!
!     OUTPUT DATA
!
      IHEAD = 1
      IF(MTI.GT.250.AND.MTI.LE.300) IHEAD = 2
      IF(MTI.GT.300.AND.MTI.LE.450) IHEAD = 3
      IF(OUTPUT.GT.0) WRITE(OUTPUT,50)  TITLE(IHEAD)
   50 FORMAT(/1X,A21)
      IHEAD = MIN0(IHEAD,2)
      CALL WRTAB1(OUTPUT,HEAD(IHEAD),UNIT(IHEAD),X,Y,NP)
!
!     SKIP SEND RECORD
!
      CALL SKPREC(ITAPE,1)
!
!     SEE IF ANOTHER SECTION IN FILE THREE
!
      CALL CONT(ITAPE,ZAI,AWRI,L1I,L2I,N1I,N2I,MATI,MFI,MTI)
      IF(MFI.GT.0) GO TO 10
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE FILE4
!
!     ROUTINE TO CONTROL PROCESSING OF FILE 4
!
      COMMON DUM(104),E,NP,NL,LCT,EG,ES,NBT(200),INT(200),P(101),       &       
     &   FMU(101),PL(81,64),FL(64),TMATRX(4225),DUM1(40264),DUM2(50000)
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/TOPPER/LIBBCD,MFBCD,MTBCD,ZABCD
      CHARACTER(LEN=14) LIBBCD
      CHARACTER(LEN=48) MFBCD
      CHARACTER(LEN=30) MTBCD
      CHARACTER(LEN=24) ZABCD
      COMMON/HEADI/ZAI,AWRI,LVT,LTT,N1I,N2I,MATI,MFI,MTI
!
      PARAMETER (NANG=81,NCOF=64)
      INTEGER JJJ(10)
!
      CHARACTER(LEN=4) LOCM(2)
      CHARACTER(LEN=21) LCMT(2)
      CHARACTER(LEN=14) LABCMS(2)
      CHARACTER(LEN=9) DREP(3)
!
      DATA LOCM/'LAB ','C.M.'/
      DATA LCMT/'LAB TO CENTER OF MASS',                                &       
     &          'CENTER OF MASS TO LAB'/
      DATA LABCMS/'  LABORATORY  ',                                     &       
     &            'CENTER OF MASS'/
      DATA DREP/'LEGENDRE ','TABULATED','MIXED'/
!
!     SET IDENTIFICATION FOR THE FILE
!
      CALL HEADIN(MATI,MFI,0,ZAI)
!
!     OUTPUT FILE HEADING TO SUMMARY
!
      CALL FILEHD(MFI)
!
!     SET SECTION ID INFORMATION
!
   10 CALL HEADIN(0,0,MTI,-1.0)
!
!     WRITE PAGE LABEL
!
      CALL TOPAGE
!
!     PROCESS TRANSFORMATION MATRIX IF IT EXISTS
!
      IF(LVT.EQ.0)GO TO 75
      CALL CANT(ITAPE,C1,C2,LI,LCT,NK,NM,MAT,MF,MT,TMATRX)
      LCT2 = MOD(LCT,2) + 1
      IF(OUTPUT.GT.0) WRITE(OUTPUT,20)   LCMT(LCT),LOCM(LCT2),LOCM(LCT)
   20 FORMAT(/' Transformation Matrix from ',A21,' System'/             &       
     &   ' F(E,L,',A4,')=(sum over M) U(L,M)*F(E,M,',A4,')')
      NMM=NM+1
      NLL=NK/NMM
      KK=0
      DO 50 I=1,NMM,10
      II = MIN0(I+9,NMM)
      JJ=0
      DO J=I,II
         JJ=JJ+1
         JJJ(JJ)=J-1
      END DO
      IF(OUTPUT.GT.0) WRITE(OUTPUT,40) (JJJ(K),K=1,JJ)
   40 FORMAT('   L/M ',I6,9I12)
      DO L=1,NLL
         K=L-1
         KK=L+(I-1)*NLL
         KKK = MIN0(KK+9*NLL,NK)
         IF(KKK.GT.NK) KKK=NK
         IF(OUTPUT.GT.0) WRITE(OUTPUT,45) K,(TMATRX(JL),JL=KK,KKK,NLL)
   45    FORMAT(I4,2X,10(1PE12.4))
      END DO
   50 CONTINUE
      GO TO 100
!
!     NO TRANSFORMATION MATRIX
!
   75 CALL CONT(ITAPE,C1,C2,LI,LCT,N1,N2,MAT,MF,MT)
!
!     PROCESS THE DISTRIBUTIONS
!
  100 IF(LI.EQ.1) GO TO 200
!
!     LIST INTERPOLATION LAW BETWEEN ENERGIES
!
      CALL CANT2(ITAPE,C1,C2,L1,L2,NR,NE,MAT,MF,MT,NBT,INT)
      CALL INTAB(NBT,INT,NR,1,OUTPUT)
      NMIN = 100000
      NMAX = 0
      NRR = NR
!
!     DATA IS IN THE FORM OF LEGENDRE COEFFICIENTS
!
      IF(LTT.EQ.2)  GO TO 150
!
!     GENERATE TABLES OF LEGENDRE POLYNOMIALS
!
      CALL LEGEND(PL,NCOF,NANG,1.0,-1.0)
      DO J=1,NANG
         P(J) = PL(J,1)
      END DO
!
!     SET UP LOOP OVER ENERGIES
!
      NP = NANG
      DO 110 I=1,NE
!
!     READ TABLE OF LEGENDRE COEFFICIENTS
!
      CALL CANT(ITAPE,C1,E,L1,L2,NL,N2,MAT,MF,MT,FL)
      IF(I.EQ.1)   ELO = E
      IF(I.EQ.NE)  EHI = E
      NMIN = MIN0(NMIN,NL)
      NMAX = MAX0(NMAX,NL)
!
!     RECONSTRUCT AND LIST ANGULAR DISTRIBUTION
!
      CALL ANGLAR(FMU,FL,PL,NL,NCOF,NANG)
      CALL TOPAGE
      CALL LIST4
  110 CONTINUE
!
!     CHECK FOR BOTH LEGENDRE AND TABULAR
!
      IF(LTT.EQ.1) GO TO 180
      CALL CANT2(ITAPE,C1,C2,L1,L2,NR,NE,MAT,MF,MT,NBT,INT)
      CALL INTAB(NBT,INT,NR,1,OUTPUT)
      NMIN = 100000
      NMAX = 0
      NRR = NR
!
!     DATA IS IN TABULAR FORM
!
  150 CONTINUE
!
!     SET UP LOOP OVER ENERGIES
!
      DO 160 I=1,NE
!
!     READ TABULATED ANGULAR DISTRIBUTION
!
      CALL CANT1(ITAPE,C1,E,L2,L2,NR,NP,MAT,MF,MT,NBT,INT,P,FMU)
      IF(I.EQ.1)   ELO = E
      IF(I.EQ.NE)  EHI = E
      NMIN = MIN0(NMIN,NP)
      NMAX = MAX0(NMAX,NP)
!
!     LIST INTERPOLATION LAW AT TOP OF NEW PAGE
!
      CALL TOPAGE
      CALL INTAB(NBT,INT,NR,2,OUTPUT)
!
!     LIST TABULAR ANGULAR DISTRIBUTION
!
      CALL LIST4
  160 CONTINUE
!
!     OUTPUT TO SUMMARY FILE
!
  180 WRITE(SOUT,190) MTI,MTBCD,LOCM(LCT),NE,ELO,EHI,NRR,               &       
     &   DREP(LTT),NMIN,NMAX
  190 FORMAT(/I6,3X,A30,3X,2X,A4,4X,I4,3X,1PE11.4,1X,1PE11.4,3X,        &       
     &  I3,4X,A9,3X,I3,5X,I3)
      GO TO 250
!
!     ALL DISTRIBUTIONS ARE ISOTROPIC
!
  200 IF(OUTPUT.GT.0) WRITE(OUTPUT,210) LABCMS(LCT)
  210 FORMAT(/' All Angular Distributions are ISOTROPIC in the ',       &       
     &  A14,' System')
      WRITE(SOUT,260) MTI,MTBCD,LOCM(LCT)
  260 FORMAT(/I6,3X,A30,5X,A4,44X,'ISOTROPIC')
!
!     SKIP SEND RECORD
!
  250 CALL SKPREC(ITAPE,1)
!
!     CHECK FOR NEW SECTION OR END OF FILE
!
      CALL CONT(ITAPE,ZAI,AWRI,LVT,LTT,N1I,N2I,MATI,MFI,MTI)
      IF(MFI.GT.0) GO TO 10
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE LIST4
!
!     ROUTINE TO LIST ANGULAR DATA
!
      COMMON DUM(104),E,NP,NL,LCT,EG,ES,NBT(200),INT(200),P(101),       &       
     &   FMU(101),PL(81,64),FL(64),TMATRX(4225),DUM1(40264),DUM2(50000)
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/HEADI/ZAI,AWRI,LVT,LTT,N1I,N2I,MATI,MFI,MTI
!
      CHARACTER(LEN=14) LABCMS(2)
      CHARACTER(LEN=24) HEAD
      CHARACTER(LEN=24) UNIT
!
      DATA LABCMS/'  LABORATORY  ',                                     &       
     &            'CENTER OF MASS'/
      DATA HEAD/'     MU       F(MU)     '/
      DATA UNIT/'                        '/
!
!     SCALE ENERGY
!
      E = E*1.0E-06
!
!     BRANCH ON REPRESENTATION TYPE
!
      IF(LTT.EQ.1)   GO TO 100
!
!     TABULAR DISTRIBUTION
!
      DO 20 I=1,NP
      IF(FMU(I).NE.FMU(1)) GO TO 50
   20 CONTINUE
!*****DISTRIBUTION IS ISOTROPIC
      IF(OUTPUT.GT.0) WRITE(OUTPUT,30)  LABCMS(LCT),E
   30 FORMAT(' Tabulated Distribution in the ',A14,' System at',        &       
     & 1PE11.4,' MeV is ISOTROPIC')
      GO TO 1000
!
!     NOT ISOTROPIC SO WRITE OUT APPROPRIATE HEADING
!
   50 IF(MFI.EQ.14)   GO TO 65
      IF(OUTPUT.GT.0) WRITE(OUTPUT,60)   LABCMS(LCT),E
   60 FORMAT(/' Tabulated Angular Distribution in the ',A14,            &       
     & ' System at',1PE11.4,' MeV')
      GO TO 200
   65 IF(OUTPUT.GT.0.AND.EG.EQ.0.0)   WRITE(OUTPUT,70)
   70 FORMAT(/' Tabulated Angular Distribution at NEUTRON ENERGY',      &       
     &  1PE11.4,' MeV, CONTINUOUS SPECTRUM')
      IF(OUTPUT.GT.0.AND.EG.NE.0.0)   WRITE(OUTPUT,75)  EG,ES
   75 FORMAT(/' Tabulated Angular Distribution at NEUTRON ENERGY',      &       
     &   1PE11.4,' MeV, ENERGY',1PE11.4,' MeV, ENERGY STATE',           &       
     &   1PE11.4,' MeV')
      GO TO 200
!
!     LEGENDRE COEFFICIENT EXPANSION
!
  100 ISO = 0
      IF(NL.LE.0) GO TO 130
      DO 120 I=1,NL
      IF(ABS(FL(I)).NE.0.0)GO TO 150
  120 CONTINUE
!*****DISTRIBUTION IS ISOTROPIC
  130 ISO = 1
      IF(OUTPUT.GT.0) WRITE(OUTPUT,140)  LABCMS(LCT),E
  140 FORMAT(/' Reconstructed Angular Distribution in the ',A14,        &       
     & ' System at',1PE11.4,' MeV is ISOTROPIC')
      GO TO 168
!
!     NOT ISOTROPIC SO WRITE APPROPRIATE HEADING
!
  150 IF(MFI.EQ.14)   GO TO 160
      IF(OUTPUT.GT.0) WRITE(OUTPUT,155)   LABCMS(LCT),E
  155 FORMAT(/' Reconstructed Angular Distribution in the ',A14,        &       
     & ' System at',1PE11.4,' MeV')
      GO TO 168
  160 IF(OUTPUT.GT.0.AND.EG.EQ.0.0)   WRITE(OUTPUT,162)
  162 FORMAT(/' Reconstructed Angular Distribution at NEUTRON ENERGY',  &       
     &  1PE11.4,' MeV, CONTINUOUS SPECTRUM')
      IF(OUTPUT.GT.0.AND.EG.NE.0.0)   WRITE(OUTPUT,165)  EG,ES
  165 FORMAT(/' Reconstructed Angular Distribution at NEUTRON ENERGY',  &       
     &   1PE11.4,' MeV, ENERGY',1PE11.4,' MeV, ENERGY STATE',           &       
     &   1PE11.4,' MeV')
!
!     WRITE LEGENDRE COEFFICIENTS
!
  168 NNL=NL+1
      IF(OUTPUT.GT.0) WRITE(OUTPUT,170) NNL
  170 FORMAT(I5,' LEGENDRE COEFFICIENTS were used in the ',             &       
     &   'reconstruction')
      IF(OUTPUT.GT.0) WRITE(OUTPUT,175)(I,FL(I),I=1,NL)
  175 FORMAT((8(I3,1PE11.4)))
      IF(ISO.EQ.1)   GO TO 1000
      IF(OUTPUT.GT.0) WRITE(OUTPUT,180)
  180 FORMAT(/' F(MU)=(sum over L) (0.5*(2L+1)*F(L,E)*P(L,MU))')
!
!     WRITE ANGULAR DISTRIBUTION
!
  200 CALL WRTAB1(OUTPUT,HEAD,UNIT,P,FMU,NP)
!
 1000 RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE FILE5
!
!     ROUTINE TO CONTROL PROCESSING OF FILE 5 DATA
!
      COMMON DUM(107),NR,NP,U,NBT(200),INT(200),X(50000),Y(50000)
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/TOPPER/LIBBCD,MFBCD,MTBCD,ZABCD
      CHARACTER(LEN=14) LIBBCD
      CHARACTER(LEN=48) MFBCD
      CHARACTER(LEN=30) MTBCD
      CHARACTER(LEN=24) ZABCD
      COMMON/HEADI/ZAI,AWRI,L1I,L2I,NK,N2I,MATI,MFI,MTI
      COMMON/SFIVE/ELO,EHI,NE,NF
!
      PARAMETER (NLAWS=6)
      CHARACTER(LEN=15) LAWS(NLAWS)
      INTEGER ILAW(NLAWS)
!
      DATA LAWS/'TABULATED(1)   ','GEN.EVAP.(5)   ',                    &       
     &          'MAXWELLIAN(7)  ','EVAPORATION(9) ',                    &       
     &          'WATT(11)       ','MADLAND-NIX(12)'/
      DATA ILAW/1,5,7,9,11,12/
!
!     SET IDENTIFICATION FOR THE FILE
!
      CALL HEADIN(MATI,MFI,0,ZAI)
!
!     OUTPUT FILE HEADING TO SUMMARY
!
      CALL FILEHD(MFI)
!
!     SET SECTION IDENTIFICATION INFORMATION
!
   10 CALL HEADIN(0,0,MTI,-1.0)
!
!     PROCESS EACH PARTIAL ENERGY DISTRIBUTION
!
      DO 150 I=1,NK
      CALL CANT1(ITAPE,U,C2,L1,LF,NR,NP,MAT,MF,MT,NBT,INT,X,Y)
      NPE = NP
!
!     CHECK FOR VALID LAW
!
      DO 20 J=1,NLAWS
      IF(LF.EQ.ILAW(J))  GO TO 30
   20 CONTINUE
      GO TO 200
!
!     TABULAR FUNCTION
!
   30 IF(LF.NE.1)   GO TO 50
      CALL LIST5A
      GO TO 100
!
!     GENERAL AND SIMPLE EVAPORATION, MAXWELLIAN, WATT AND MADLAND-NIX
!       REPRESENTATION
!
   50 CALL LIST5B(LF)
!
!     OUTPUT TO SUMMARY FILE
!
  100 IF(I.EQ.1) THEN
         WRITE(SOUT,110) MTI,MTBCD,LAWS(J),NPE,ELO,EHI,NR,NE,NF,U
  110    FORMAT(/I6,3X,A30,3X,A15,I6,3X,1PE11.4,1X,1PE11.4,3X,I3,1X,    &       
     &     2I6,3X,1PE11.4)
      ELSE
         WRITE(SOUT,120)  LAWS(J),NPE,ELO,EHI,NR,NE,NF,U
  120    FORMAT(42X,A15,I6,3X,1PE11.4,1X,1PE11.4,3X,I3,1X,2I6,3X,       &       
     &     1PE11.4)
      END IF
!
  150 CONTINUE
!
!     SKIP SEND RECORD
!
      CALL SKPREC(ITAPE,1)
      GO TO 250
!
!     INVALID LAW, SKIP REST OF SECTION
!
  200 IF(OUTPUT.GT.0) WRITE(OUTPUT,210) LF
  210 FORMAT(//5X,'LF = ',I2,' IS ILLEGAL. REST OF SECTION IS SKIPPED')
      CALL SKPSEC(ITAPE)
!
!     CHECK FOR NEW SECTION OR END OF FILE
!
  250 CALL CONT(ITAPE,ZAI,AWRI,L1I,L2I,NK,N2I,MATI,MFI,MTI)
      IF(MFI.GT.0) GO TO 10
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE LIST5A
!
!     PROCESS AND LIST A FILE FIVE TABULAR REPRESENTATION
!
      COMMON DUM(107),NR,NP,U,NBT(200),INT(200),X(50000),Y(50000)
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/SFIVE/ELO,EHI,NE,NF
!
      CHARACTER(LEN=24) HEAD(2)
      CHARACTER(LEN=24) UNIT
!
      DATA HEAD/'   Energy      P(E)     ',                             &       
     &          '     E''       G(E'')     '/
      DATA UNIT/'     eV                 '/
!
!     OUTPUT PAGE HEADER
!
      CALL TOPAGE
      IF(OUTPUT.GT.0) WRITE(OUTPUT,10)
   10 FORMAT(//' TABULATED SPECTRUM')
!
!     OUTPUT DISTRIBUTION PROBABILITY WITH INTERPOLATION SCHEME
!
      CALL INTAB(NBT,INT,NR,1,OUTPUT)
      CALL WRTAB1(OUTPUT,HEAD(1),UNIT,X,Y,NP)
!
!     OUTPUT ENERGY INTERPOLATION SCHEME ON A NEW PAGE
!
      CALL TOPAGE
      CALL CANT2(ITAPE,C1,C2,L1,L2,NR,NE,MAT,MF,MT,NBT,INT)
      CALL INTAB(NBT,INT,NR,1,OUTPUT)
!
!     PROCESS EACH INCIDENT ENERGY
!
      NF = 0
      DO 50 J1=1,NE
      CALL CANT1(ITAPE,C1,E,L1,L2,NR,NP,MAT,MF,MT,NBT,INT,X,Y)
      IF(J1.EQ.1)   ELO = E
      IF(J1.EQ.NE)  EHI = E
      NF = MAX0(NF,NP)
      CALL TOPAGE
      IF(OUTPUT.GT.0) WRITE(OUTPUT,20) E
   20 FORMAT(/' Incident NEUTRON ENERGY',1PE11.4,' eV'/' ',38('-'))
      CALL INTAB(NBT,INT,NR,1,OUTPUT)
      CALL WRTAB1(OUTPUT,HEAD(2),UNIT,X,Y,NP)
   50 CONTINUE
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE LIST5B(LF)
!
!     PROCESS AND LIST A FILE FIVE MAXWELLIAN, EXAPORATION, WATT OR
!      MADLAND-NIX SPECTRUM
!
      COMMON DUM(107),NR,NP,U,NBT(200),INT(200),X(50000),Y(50000)
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/HEADI/ZAI,AWRI,L1I,LFS,NK,N2I,MATI,MFI,MTI
      COMMON/SFIVE/ELO,EHI,NE,NF
!
      CHARACTER(LEN=24) HEAD(6)
      CHARACTER(LEN=24) UNIT(4)
!
      DATA HEAD           /'   Energy      P(E)     ',                  &       
     &                     '   Energy    Theta(E)   ',                  &       
     &                     '     X         G(X)     ',                  &       
     &                     '     eV        A(E)     ',                  &       
     &                     '     eV        B(E)     ',                  &       
     &                     '     eV       TM(E)     '/
      DATA UNIT           /'     eV                 ',                  &       
     &                     '     eV         eV      ',                  &       
     &                     '                        ',                  &       
     &                     '     eV       eV**-1    '/
!
!     OUTPUT PAGE HEADER
!
      CALL TOPAGE
      IF(OUTPUT.GT.0.AND.LF.EQ.7) WRITE(OUTPUT,10)
   10 FORMAT(/' MAXWELLIAN spectrum, THETA = THETA(E)')
      IF(OUTPUT.GT.0.AND.LF.EQ.9) WRITE(OUTPUT,20)
   20 FORMAT(/' SIMPLE EVAPORATION spectrum, THETA = THETA(E)')
      IF(OUTPUT.GT.0.AND.LF.EQ.5) WRITE(OUTPUT,30)
   30 FORMAT(/' GENERAL EVAPORATION spectrum, THETA = THETA(E), ',      &       
     &    'X = E-PRIME/THETA(E)')
      IF(OUTPUT.GT.0.AND.LF.EQ.11)   WRITE(OUTPUT,35)
   35 FORMAT(/' WATT FISSION spectrum, A(E) AND B(E)')
      IF(OUTPUT.GT.0.AND.LF.EQ.12)   WRITE(OUTPUT,40)
   40 FORMAT(/' MADLAND-NIX FISSION spectrum, TM(E)')
      IF(OUTPUT.GT.0) WRITE(OUTPUT,45) U
   45 FORMAT('     Maximum Energy of the Secondary Particle is ',       &       
     &   1PE11.4,' eV')
!
!     OUTPUT DISTRIBUTION PROBABILITY WITH INTERPOLATION SCHEME
!
      CALL INTAB(NBT,INT,NR,1,OUTPUT)
      CALL WRTAB1(OUTPUT,HEAD(1),UNIT(1),X,Y,NP)
!
!     READ AND OUTPUT ENERGY DEPENDENT NUCLEAR TEMPERATURES
!
      IF(OUTPUT.GT.0) WRITE(OUTPUT,50)
   50 FORMAT(/)
      CALL CANT1(ITAPE,EFL,EFH,L1,L2,NR,NP,MAT,MF,MT,NBT,INT,X,Y)
      NF = 0
      NE = NP
      ELO = X(1)
      EHI = X(NP)
      CALL INTAB(NBT,INT,NR,1,OUTPUT)
      IHEAD = 2
      IF(LF.EQ.11) IHEAD = 4
      IF(LF.NE.12) GO TO 75
      IHEAD = 6
      IF(OUTPUT.GT.0) WRITE(OUTPUT,60) EFL,EFH
   60 FORMAT(' Average Light Fragment KINETIC ENERGY---',1PE11.4,' eV'/ &       
     &       ' Average Heavy Fragment KINETIC ENERGY---',1PE11.4,' eV')
   75 CALL WRTAB1(OUTPUT,HEAD(IHEAD),UNIT(2),X,Y,NP)
!
!     ADDITIONAL TAB1 RECORD FOR GENERAL EVAPORATION AND WATT SPECTRUM
!
      IF(LF.NE.5.AND.LF.NE.11)   GO TO 100
      CALL CANT1(ITAPE,C1,C2,L1,L2,NR,NP,MAT,MF,MT,NBT,INT,X,Y)
      IF(LF.EQ.5)  NF = NP
      IINT = 1
      IF(LF.EQ.11)   IINT = 6
      CALL INTAB(NBT,INT,NR,IINT,OUTPUT)
      IF(LF.EQ.5)  CALL WRTAB1(OUTPUT,HEAD(3),UNIT(3),X,Y,NP)
      IF(LF.EQ.11)  CALL WRTAB1(OUTPUT,HEAD(5),UNIT(4),X,Y,NP)
!
  100 RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE FILE6
!
!     ROUTINE TO CONTROL PROCESSING OF FILE 6 DATA
!
      COMMON DUM(86),FL(21),ZAP,NR,NP,NBT(200),INT(200),X(50000),       &       
     &       Y(50000)
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/TOPPER/LIBBCD,MFBCD,MTBCD,ZABCD
      CHARACTER(LEN=14) LIBBCD
      CHARACTER(LEN=48) MFBCD
      CHARACTER(LEN=30) MTBCD
      CHARACTER(LEN=24) ZABCD
      COMMON/HEADI/ZAI,AWRI,L1I,LCT,NK,N2I,MATI,MFI,MTI
      COMMON/SSIX/LANG,NE
!
      CHARACTER(LEN=24) ZAPBCD
      CHARACTER(LEN=6) SBCD
      CHARACTER(LEN=8) ZAPSB
!
      PARAMETER (NPARTS=8)
      CHARACTER(LEN=10) OPARTS(NPARTS)
      INTEGER IPARTS(NPARTS)
      PARAMETER (NLAWS=8)
      CHARACTER(LEN=30) LTEXT(NLAWS)
      CHARACTER(LEN=12) LSTEXT(NLAWS)
      CHARACTER(LEN=24) HEAD
      CHARACTER(LEN=24) UNIT
      CHARACTER(LEN=15) LCM(3)
!
      DATA OPARTS/'PHOTON    ','NEUTRON   ','PROTON    ',               &       
     &            'DEUTERON  ','TRITON    ','ALPHA     ',               &       
     &            'ELECTRON  ','POSITRON  '/
      DATA IPARTS/0,1,1001,1002,1003,2004,-1000,1000/
!
      DATA LTEXT/'UNKNOWN                       ',                      &       
     &           'CONTINUUM ENERGY-ANGLE        ',                      &       
     &           'DISCRETE TWO-BODY             ',                      &       
     &           'ISOTROPIC DISCRETE TWO-BODY   ',                      &       
     &           'RECOIL TWO-BODY               ',                      &       
     &           'CHARGED PARTICLE ELASTIC      ',                      &       
     &           'N-BODY PHASE SPACE            ',                      &       
     &           'ANGLE-ENERGY TABULAR          '/
      DATA LSTEXT/'UNKNOWN(0)  ','CONTINUUM(1)','DISCRETE(2) ',         &       
     &            'ISOTROPIC(3)','RECOIL(4)   ','CP ELAST.(5)',         &       
     &            'N-BODY(6)   ','ANG-EN(7)   '/
!
      DATA HEAD/'   Energy     Number    '/
      DATA UNIT/'     eV                 '/
      DATA LCM/'LABORATORY     ','CENTER OF MASS ','   '/
!
!     SET IDENTIFICATION FOR THE FILE
!
      CALL HEADIN(MATI,MFI,0,ZAI)
!
!     SET SECTION IDENTIFICATION INFORMATION
!
    5 CALL HEADIN(0,0,MTI,-1.0)
!
!     OUTPUT FILE HEADING TO SUMMARY
!
      CALL FILEHD(MFI)
!
!     PROCESS EACH PARTIAL DISTRIBUTION
!
      DO 190 I=1,NK
      CALL CANT1(ITAPE,ZAP,C2,LIP,LAW,NR,NP,MAT,MF,MT,NBT,INT,X,Y)
      NRR = NR
      NPP = NP
      ELO = X(1)
      EHI = X(NP)
!
!     OUTPUT PAGE HEADER
!
      CALL TOPAGE
!
!     SET PRODUCT TEXT STRING
!
      IZAP = ABS(ZAP) + .001
      IF(ZAP.LT.0.)  IZAP = -IZAP
      IAP = MOD(IZAP,1000)
      DO 10 J=1,NPARTS
      IF(IPARTS(J).EQ.IZAP)    GO TO 15
   10 CONTINUE
      CALL ZAID(ZAP,ZAPBCD,IERR)
      CALL NUSYM(ZAP,SBCD,NSBCD,IERR)
      ZAPSB = SBCD
      GO TO 20
   15 ZAPBCD = OPARTS(J)
      ZAPSB = OPARTS(J)(1:8)
!
!     IDENTIFY DISTRIBUTION
!
   20 IF(OUTPUT.GT.0) THEN
         IF(LCT.NE.3) THEN
            WRITE(OUTPUT,25) ZAPBCD,LCM(LCT),LIP
   25       FORMAT(/' Distribution for ',A24,' Product in the ',A15,    &       
     &          'System;    PARTIAL ',I3)
         ELSE
            IF(IAP.LE.4) THEN
               WRITE(OUTPUT,27) ZAPBCD(1:20),LIP
   27          FORMAT(/' Distribution for ',A20,' Product Energy/Angle',&       
     &            ' in the C.M. System;    PARTIAL ',I3)
            ELSE
!
               WRITE(OUTPUT,28) ZAPBCD,LIP
   28          FORMAT(/' Distribution for ',A20,' Product Energy/Angle',&       
     &            ' in the Lab. System;    PARTIAL ',I3)
            END IF
         END IF
      END IF
!
!     OUTPUT YIELDS
!
      CALL INTAB(NBT,INT,NR,1,OUTPUT)
      CALL WRTAB1(OUTPUT,HEAD,UNIT,X,Y,NP)
!
!     IDENTIFY THE LAW
!
      IF(OUTPUT.GT.0) WRITE(OUTPUT,30) LTEXT(LAW+1)
   30 FORMAT(/' Product Distribution Law is ',A30)
!
!     BRANCH ON LAW
!
      LF = LAW + 1
      LANG = 0
      NE = 0
      IF(LAW.GT.8)   GO TO 200
!
      SELECT CASE (LF)
!
!     TABULAR FUNCTION
!
         CASE (2)
            CALL LIST6A
!
!     DISCRETE TWO BODY SCATTERING
!
         CASE (3)
            CALL LIST6B
!
!     CHARGED PARTICLE ELASTIC
!
         CASE (6)
            CALL LIST6C
!
!     N-BODY PHASE SPACE
!
         CASE (7)
            CALL CONT(ITAPE,APSX,C2,L1,L2,N1,NPSX,MAT,MF,MT)
            IF(OUTPUT.GT.0) WRITE(OUTPUT,130)NPSX,APSX
  130       FORMAT(/I5,' Particles with Mass',1PE11.4,                  &       
     &         ' are described by this law')
!
!     ANGLE-ENERGY TABULAR LAW
!
         CASE (8)
            CALL LIST6D
!
      END SELECT
!
!     OUTPUT SUMMARY LINE
!
  175 IF(I.EQ.1)  THEN
         WRITE(SOUT,180) MTI,MTBCD,ZAPSB,LSTEXT(LAW+1),NPP,             &       
     &      ELO,EHI,NRR,LANG,NE
  180    FORMAT(/I6,3X,A30,1X,A8,2X,A12,I8,3X,1PE11.4,1X,1PE11.4,I5,    &       
     &     7X,I3,I7)
      ELSE
         WRITE(SOUT,185) ZAPSB,LSTEXT(LAW+1),NPP,ELO,EHI,NRR,           &       
     &      LANG,NE
  185    FORMAT(40X,A8,2X,A12,I8,3X,1PE11.4,1X,1PE11.4,I5,7X,I3,I7)
      END IF
!
  190 CONTINUE
!
!     SKIP SEND RECORD
!
      CALL SKPREC(ITAPE,1)
      GO TO 250
!
!     INVALID LAW, SKIP REST OF SECTION
!
  200 IF(OUTPUT.GT.0) WRITE(OUTPUT,210) LAW
  210 FORMAT(//5X,'LAW = ',I2,' IS ILLEGAL. REST OF SECTION IS SKIPPED')
      CALL SKPSEC(ITAPE)
!
!     CHECK FOR NEW SECTION OR END OF FILE
!
  250 CALL CONT(ITAPE,ZAI,AWRI,L1I,LCT,NK,N2I,MATI,MFI,MTI)
      IF(MFI.GT.0) GO TO 5
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE LIST6A
!
!     ROUTINE TO PROCESS CONTINUUM EMISSION REPRESENTATIONS
!
      COMMON DUM(108),NR,NP,NBT(200),INT(200),B(50000),X(7500),Y(7500), &       
     &    DUM1(35000)
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/SSIX/LANG,NE
!
      CHARACTER(LEN=24) HEAD
      CHARACTER(LEN=24) UNIT
      CHARACTER(LEN=12) EXPAN(2)
      CHARACTER(LEN=24) ILAW(5)
      CHARACTER(LEN=24) JLAW(5)
!
      DATA HEAD/'     MU       F(MU)     '/
      DATA UNIT/'                        '/
      DATA EXPAN/'LEGENDRE    ','KALBACH-MANN'/
!
      DATA ILAW           /'F(E'') HISTOGRAM IN E''   ',                &       
     &                     'F(E'') LINEAR IN E''      ',                &       
     &                     'F(E'') LINEAR IN LN E''   ',                &       
     &                     'LN F(E'') LINEAR IN E''   ',                &       
     &                     'LN F(E'') LINEAR IN LN E'''/
      DATA JLAW           /'F(MU) HISTOGRAM IN MU   ',                  &       
     &                     'F(MU) LINEAR IN MU      ',                  &       
     &                     'F(MU) LINEAR IN LN MU   ',                  &       
     &                     'LN F(MU) LINEAR IN MU   ',                  &       
     &                     'LN F(MU) LINEAR IN LN MU'/
!
!     READ TAB2 RECORD AND OUTPUT CONTENTS
!
      CALL CANT2(ITAPE,C1,C2,LANG,LEP,NR,NE,MAT,MF,MT,NBT,INT)
      CALL INTAB(NBT,INT,NR,1,OUTPUT)
      IF(OUTPUT.GT.0) WRITE(OUTPUT,10) ILAW(LEP)
   10 FORMAT(/' Interpolation Law between Emitted Particle Energies ',  &       
     &   'is ',A24)
!
!     PROCESS EACH ENERGY
!
      DO 200 N=1,NE
      CALL CANT(ITAPE,C1,E,ND,NA,NW,NEP,MAT,MF,MT,B)
      IF(N.NE.1)  CALL TOPAGE
!
!     LEGENDRE OR KALBACH-MANN EXPANSION
!
      IF(LANG.LE.2)   THEN
         IF(OUTPUT.GT.0) WRITE(OUTPUT,20) EXPAN(LANG),E
   20    FORMAT(//' ',A12,' Expansion of the Emitted Particle ',        &       
     &      'Distribution at',1PE11.4,' eV')
         GO TO 50
      END IF
!
!     TABULATED DISTRIBUTION
!
   30 INTER = LANG - 10
      IF(OUTPUT.GT.0) WRITE(OUTPUT,35) E,JLAW(INTER)
   35 FORMAT(//' Tabulated Emitted Particle Distribution at',1PE11.4,   &       
     &   ' eV with ',A24,' interpolation')
!
!     PROCESS EACH EMITTED PARTICLE ENERGY
!
   50 KN = 1
      DO 185 NN=1,NEP
      EP = B(KN)
!
!     A DISCRETE EMITTED ENERGY
!
      IF(NN.GT.ND)    GO TO 80
      IPRI = 0
      IF(EP.LT.0.)  IPRI = 1
      IF(OUTPUT.GT.0.AND.IPRI.EQ.0)   WRITE(OUTPUT,60)  EP
   60 FORMAT(/' Discrete Emitted Particle ENERGY is',1PE11.4)
      IF(OUTPUT.GT.0.AND.IPRI.EQ.1)   WRITE(OUTPUT,70) -EP
   70 FORMAT(/' Primary Photon ENERGY is',1PE11.4)
      GO TO 100
!
!     A CONTINUUM EMITTED ENERGY
!
   80 IF(OUTPUT.GT.0) WRITE(OUTPUT,90) EP
   90 FORMAT(/' Emitted Particle ENERGY is',1PE11.4)
!
!     OUTPUT DATA FOR THIS EMITTED ENERGY
!
  100 KN = KN + 1
!
!     OUTPUT LEGENDRE PARAMETERS
!
      IF(LANG.EQ.1)   THEN
         KU = KN + NA
         IF(OUTPUT.GT.0) WRITE(OUTPUT,110)  ((J-KN),B(J),J=KN,KU)
  110    FORMAT((8(I3,1PE11.4)))
         GO TO 180
      END IF
!
!     OUTPUT KALBACH-MANN PARAMETERS
!
  120 IF(LANG.EQ.2)   THEN
         KU = KN + NA
         IF(OUTPUT.GT.0) WRITE(OUTPUT,130) B(KN),B(KN+1)
  130    FORMAT(7X,'F(0)=',1PE11.4,5X,'R=',1PE11.4)
         GO TO 180
      END IF
!
!     TABULAR FUNCTION
!
      NP = 0
      DO KK=KN,KU,2
         NP = NP + 1
         X(NP) = B(KK)
         Y(NP) = B(KK+1)
      END DO
      CALL WRTAB1(OUTPUT,HEAD,UNIT,X,Y,NP)
  180 KN = KU + 1
  185 CONTINUE
  200 CONTINUE
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE LIST6B
!
!     ROUTINE TO PROCESS DISCRETE TWO-BODY REPRESENTATIONS
!
      COMMON DUM(108),NR,NP,NBT(200),INT(200),B(50000),X(7500),Y(7500), &       
     &    DUM1(35000)
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/SSIX/LANG,NE
!
      CHARACTER(LEN=24) HEAD
      CHARACTER(LEN=24) UNIT
      CHARACTER(LEN=24) JLAW(5)
!
      DATA HEAD/'     MU       F(MU)     '/
      DATA UNIT/'                        '/
!
      DATA JLAW           /'F(MU) HISTOGRAM IN MU   ',                  &       
     &                     'F(MU) LINEAR IN MU      ',                  &       
     &                     'F(MU) LINEAR IN LN MU   ',                  &       
     &                     'LN F(MU) LINEAR IN MU   ',                  &       
     &                     'LN F(MU) LINEAR IN LN MU'/
!
!     READ TAB2 RECORD AND OUTPUT CONTENTS
!
      CALL CANT2(ITAPE,C1,C2,L1,L2,NR,NE,MAT,MF,MT,NBT,INT)
      CALL INTAB(NBT,INT,NR,1,OUTPUT)
!
!     PROCESS EACH ENERGY
!
      DO 100 N=1,NE
      CALL CANT(ITAPE,C1,E,LTP,L2,NW,NL,MAT,MF,MT,B)
      LANG = LTP
      IF(N.NE.1)  CALL TOPAGE
!
!     LEGENDRE EXPANSION
!
      IF(LANG.NE.0)   GO TO 30
      IF(OUTPUT.GT.0) WRITE(OUTPUT,20) E,NL
   20 FORMAT(/' Emitted Particle Angular Distribution at',1PE11.4,      &       
     &   ' eV is represented by ',I2,' LEGENDRE COEFFICIENTS')
      IF(OUTPUT.GT.0) WRITE(OUTPUT,25)  (J,B(J),J=1,NL)
   25 FORMAT((8(I3,1PE11.4)))
      GO TO 100
!
!     TABULATED DISTRIBUTION
!
   30 INTER = LANG - 10
      IF(OUTPUT.GT.0) WRITE(OUTPUT,35) E,JLAW(INTER)
   35 FORMAT(//' Tabulated Emitted Particle Distribution at',1PE11.4,   &       
     &   ' eV with ',A24,' INTERPOLATION')
      NP = 0
      DO KK=1,NW,2
         NP = NP + 1
         X(NP) = B(KK)
         Y(NP) = B(KK+1)
      END DO
      CALL WRTAB1(OUTPUT,HEAD,UNIT,X,Y,NP)
  100 CONTINUE
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE LIST6C
!
!     ROUTINE TO PROCESS CHARGED PARTICLE ELASTIC REPRESENTATIONS
!
      COMMON DUM(108),NR,NP,NBT(200),INT(200),X(50000),Y(50000)
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/SSIX/LTP,NE
!
      CHARACTER(LEN=24) HEAD
      CHARACTER(LEN=24) UNIT
      CHARACTER(LEN=29) ILAW(4)
!
      DATA HEAD/'   Cosine     Dsigma    '/
      DATA UNIT/'             Barns/Sr   '/
!
      DATA ILAW           /'DSIGMA LINEAR IN COSINE      ',             &       
     &                     'DSIGMA LINEAR IN LN COSINE   ',             &       
     &                     'LN DSIGMA LINEAR IN COSINE   ',             &       
     &                     'LN DSIGMA LINEAR IN LN COSINE'/
!
!     READ TAB2 RECORD AND OUTPUT CONTENTS
!
      CALL CANT2(ITAPE,SPI,C2,LIDP,L2,NR,NE,MAT,MF,MT,NBT,INT)
      IF(OUTPUT.GT.0.AND.LIDP.NE.0)   WRITE(OUTPUT,10) SPI
   10 FORMAT(' Scattering of Identical Particles with SPIN ',F3.1)
      CALL INTAB(NBT,INT,NR,1,OUTPUT)
!
!     PROCESS EACH ENERGY
!
      DO 100 N=1,NE
      CALL CANT(ITAPE,C1,E,LTP,L2,NW,NL,MAT,MF,MT,X)
      IF(N.NE.1)  CALL TOPAGE
!
!     RESIDUAL CROSS SECTION TABULATED
!
      IF(LTP.LE.10)    GO TO 30
      INTER = LTP - 10
      NIP = 1
      DO I=1,NL
         X(I) = X(NIP)
         Y(I) = X(NIP+1)
         NIP = NIP + 2
      END DO
      NP = NL
      IF(OUTPUT.GT.0) WRITE(OUTPUT,25) E,ILAW(INTER)
   25 FORMAT(//' Residual Cross Section Tabulated at',1PE11.4,' eV',    &       
     &   ' with ',A29,' INTERPOLATION')
      CALL WRTAB1(OUTPUT,HEAD,UNIT,X,Y,NP)
      GO TO 100
!
!     RESIDUAL CROSS SECTION AS LEGENDRE EXPANSION
!
   30 IF(LTP.NE.2)  GO TO 50
      WRITE(OUTPUT,35) E
   35 FORMAT(//' Legendre Expansion of the Residual Reaction at',       &       
     &   1PE11.4,' eV')
      IF(OUTPUT.GT.0.AND.LIDP.EQ.1)                                     &       
     &         WRITE(OUTPUT,40)  (2*(J-1),X(J),J=1,NW)
      IF(OUTPUT.GT.0.AND.LIDP.EQ.0) WRITE(OUTPUT,40) ((J-1),X(J),J=1,NW)
   40 FORMAT((8(I3,1PE11.4)))
      GO TO 100
!
!     NUCLEAR AMPLITUDE LEGENDRE EXPANSION
!
   50 IF(LTP.NE.1)  GO TO 100
      IF(OUTPUT.GT.0) WRITE(OUTPUT,55) E
   55 FORMAT(//' Legendre Expansion of the Reaction Amplitude at',      &       
     &   1PE11.4,' eV'//'      NUCLEAR TERM')
      IF(OUTPUT.GT.0.AND.LIDP.EQ.1)                                     &       
     &      WRITE(OUTPUT,40) (2*(J-1),X(J),J=1,NL+1)
      IF(OUTPUT.GT.0.AND.LIDP.EQ.0)                                     &       
     &      WRITE(OUTPUT,40) ((J-1),X(J),J=1,2*NL+1)
      IF(OUTPUT.GT.0) WRITE(OUTPUT,60)
   60 FORMAT(/'      COMPLEX INTERFERENCE TERM')
      JB = NL + 2
      IF(LIDP.EQ.1)  JB = JB + NL
      JJB = (J-JB)/2
      IF(OUTPUT.GT.0)                                                   &       
     &       WRITE(OUTPUT,80) (JJB,X(J),JJB,X(J+1),J=JB,NW,2)
   80 FORMAT((4(I3,'R',1PE11.4,I3,'I',1PE11.4)))
!
  100 CONTINUE
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE LIST6D
!
!     ROUTINE TO PROCESS CONTINUUM EMISSION REPRESENTATIONS
!
      COMMON DUM(108),NR,NP,NBT(200),INT(200),B(50000),X(7500),Y(7500), &       
     &    DUM1(35000)
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/SSIX/LANG,NE
!
      CHARACTER(LEN=24) HEAD
      CHARACTER(LEN=24) UNIT
!
      DATA HEAD/'     E''       F(E'')     '/
      DATA UNIT/'     eV                 '/
!
!     READ TAB2 RECORD AND OUTPUT CONTENTS
!
      CALL CANT2(ITAPE,C1,C2,L1,L2,NR,NE,MAT,MF,MT,NBT,INT)
      LANG = 0
      CALL INTAB(NBT,INT,NR,1,OUTPUT)
!
!     PROCESS EACH ENERGY
!
      DO 200 N=1,NE
      CALL CANT2(ITAPE,C1,E,L1,L2,NRM,NMU,MAT,MF,MT,NBT,INT)
      IF(N.NE.1)   CALL TOPAGE
      IF(OUTPUT.GT.0)  WRITE(OUTPUT,20) E
   20 FORMAT(/' Incident Particle Energy',1PE11.4,' eV'/' ',38('-'))
      CALL INTAB(NBT,INT,NRM,2,OUTPUT)
!
!     PROCESS EACH ANGLE
!
      DO NM=1,NMU
         CALL CANT1(ITAPE,C1,FMU,L1,L2,NREP,NEP,MAT,MF,MT,NBT,INT,X,Y)
         IF(OUTPUT.GT.0)  WRITE(OUTPUT,25) FMU
   25    FORMAT(/' Outgoing Particle ANGLE COSINE',1PE11.4,' eV'/       &       
     &     ' ',44('-'))
         CALL INTAB(NBT,INT,NREP,1,OUTPUT)
         CALL WRTAB1(OUTPUT,HEAD,UNIT,X,Y,NEP)
      END DO
  200 CONTINUE
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE LIST6E
!
!     ROUTINE TO PROCESS ENERGY TRANSFER REPRESENTATION
!
      COMMON DUM(108),NR,NP,NBT(200),INT(200),B(50000),X(7500),Y(7500), &       
     &    DUM1(35000)
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/SSIX/LANG,NE
!
      CHARACTER(LEN=24) HEAD
      CHARACTER(LEN=24) UNIT
!
      DATA HEAD/'     E         ET(E)   '/
      DATA UNIT/'     eV         eV     '/
!
      CALL CANT1(ITAPE,C1,C2,L1,LR,NR,NP,MAT,MF,MT,NBT,INT,X,Y)
      CALL TOPAGE
      IF(OUTPUT.GT.0)  WRITE(OUTPUT,20)
   20 FORMAT(/' ',38('-'))
      CALL INTAB(NBT,INT,NR,1,OUTPUT)
      CALL WRTAB1(OUTPUT,HEAD,UNIT,X,Y,NP)
  200 CONTINUE
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE FILE7
!
!     ROUTINE TO CONTROL PROCESSING OF THERMAL LAW DATA
!
      COMMON DUM(110),NBT(200),INT(200),ALPHA(50000),S(50000)
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/TOPI/NLIB,NVER,NREL,NSUB,MATIN,AWI,NMOD,NFOR
      COMMON/HEADI/ZAI,AWRI,LTHR,LAT,N1I,N2I,MATI,MFI,MTI
!
      REAL B(30),CFLAG(4)
!
      CHARACTER(LEN=24) HEAD(5)
      CHARACTER(LEN=24) UNIT(5)
      CHARACTER(LEN=16) MODEL(3)
      CHARACTER(LEN=20) INLAWS(6)
!
      DATA HEAD           /'   Alpha     S(Alpha)   ',                  &       
     &                     '   T-Mod      T-Eff     ',                  &       
     &                     '   Energy     Factor    ',                  &       
     &                     '    Temp       Data     ',                  &       
     &                     '   Alpha    ln(S(Alpha))'/
      DATA UNIT           /'                        ',                  &       
     &                     '   Kelvin     Kelvin    ',                  &       
     &                     '     eV      eV-Barns   ',                  &       
     &                     '   Kelvin     eV**-1    ',                  &       
     &                     '                        '/
!
      DATA MODEL/'   TABULATED    ','  FREE GAS LAW  ',                 &       
     &           'DIFFUSIVE MOTION'/
      DATA INLAWS           /'CONSTANT            ',                    &       
     &                       'Y LINEAR IN X       ',                    &       
     &                       'Y LINEAR IN LN X    ',                    &       
     &                       'LN Y LINEAR IN X    ',                    &       
     &                       'LN Y LINEAR IN LN X ',                    &       
     &                       '******(ERROR)*******'/
!
!     SET IDENTIFICATION FOR THE FILE
!
      CALL HEADIN(MATI,MFI,0,ZAI)
!
!     SET SECTION IDENTIFICATION INFORMATION
!
   10 CALL HEADIN(0,0,MTI,-1.)
!
!     PRINT PAGE HEADER
!
      CALL TOPAGE
!
!     INCOHERENT INELASTIC SCATTERING
!
      IF(LTHR.GT.0)   GO TO 300
!
!     READ IN AND PRINT CONSTANTS
!
      CALL CANT(ITAPE,C1,C2,LLN,L2,NL,NS,MAT,MF,MT,B)
      DO NNN=1,NS+1
         CFLAG(NNN) = B(6*(NNN-1)+1)
      END DO
!
!     WRITE OUT PHYSICAL CONSTANTS FOR TABULAR LAW
!
      IF(CFLAG(1).LE.0.0) GO TO 40
      IF(OUTPUT.GT.0) WRITE(OUTPUT,20)
   20 FORMAT(/' Index',6X,'Type',14X,'Total',10X,'Effective',11X,       &       
     &        'Constant',6X,'Static Elastic'/                           &       
     &        13X,'of',13X,'Free Atom',10X,'Mass',13X,'Free Atom',8X,   &       
     &        'Scattering'/                                             &       
     &        11X,'Model',10X,'Cross Section',23X,'Cross Section',5X,   &       
     &        'Energy Limit'/                                           &       
     &        63X,'Energy Limit',8X,'(E.KT)'/)
      IF(OUTPUT.GT.0) WRITE(OUTPUT,30) MODEL(1),B(1),B(3),B(4),B(2)
   30 FORMAT('   0  ',A16,1X,4(3X,1PE11.4,4X))
      GO TO 75
!
!     WRITE HEADING FOR CONSTANTS FOR ANALYTIC FUNCTION ONLY
!
   40 IF(OUTPUT.GT.0) WRITE(OUTPUT,50)
   50 FORMAT(/' Index',6X,'Type',14X,'Total',10X,'Effective'/           &       
     &        13X,'of',13X,'Free Atom',10X,'Mass'/                      &       
     &        11X,'Model',10X,'Cross Section')
!
!     PROCESS ALL CONSTANTS FOR ANALYTIC FUNCTIONS
!
   75 IF(NS.LE.0)   GO TO 100
      IAOFF = 6
      DO JNDEX=1,NS
         INDEX = B(IAOFF+1) + 1
         IF(OUTPUT.GT.0) WRITE(OUTPUT,80) JNDEX,MODEL(INDEX),           &       
     &       B(IAOFF+2),B(IAOFF+3)
   80    FORMAT(I4,2X,A16,1X,2(3X,1PE11.4,4X))
         IAOFF = IAOFF + 6
      END DO
!
!     PROCESS INTERPOLATION SCHEME FOR BETA
!
  100 IF(B(1).LE.0.0) GO TO 250
      CALL CANT2(ITAPE,C1,C2,L1,L2,NR,NB,MAT,MF,MT,NBT,INT)
      CALL TOPAGE
      IF(OUTPUT.GT.0.AND.LAT.EQ.0) WRITE(OUTPUT,110)
  110 FORMAT(/' The ACTUAL Temperarure was used to compute ',           &       
     &     'ALPHA and BETA')
      IF(OUTPUT.GT.0.AND.LAT.EQ.1) WRITE(OUTPUT,120)
  120 FORMAT(/' ALPHA and BETA were computed using a Temperature of ',  &       
     &     '293.62 DEGREES KELVIN (0.0253 EV) instead of the Actual ',  &       
     &     'Temperature')
      CALL INTAB(NBT,INT,NR,4,OUTPUT)
!
!     PROCESS FOR ALL VALUES OF BETA TABULATED
!
      IHEAD = 1
      IF(LLN.EQ.1)   IHEAD = 5
      DO 200 J=1,NB
      CALL CANT1(ITAPE,T,BETA,LT,L2,NR,NP,MAT,MF,MT,NBT,INT,ALPHA,S)
      CALL TOPAGE
      IF(OUTPUT.GT.0) WRITE(OUTPUT,130) T,BETA
  130 FORMAT(/' Temperature=',1PE11.4,' DEGREES KELVIN',53X,'BETA=',    &       
     &     1PE11.4)
      CALL INTAB(NBT,INT,NR,5,OUTPUT)
      IF(OUTPUT.GT.0) WRITE(OUTPUT,140)
  140 FORMAT(/' TABULATED THERMAL SCATTERING LAW')
      CALL WRTAB1(OUTPUT,HEAD(IHEAD),UNIT(IHEAD),ALPHA,S,NP)
      IF(LT.LE.0)GO TO 200
      DO 190 K=1,LT
      TLAST=T
      CALL CANT(ITAPE,T,C2,INTER,L2,NP,N2,MAT,MF,MT,S)
      CALL TOPAGE
      IF(OUTPUT.GT.0) WRITE(OUTPUT,130) T,BETA
      IF(INTER.LT.1.OR.INTER.GT.5) INTER=6
      IF(OUTPUT.GT.0) WRITE(OUTPUT,160) TLAST,T,INLAWS(INTER)
  160 FORMAT(' Interpolation Law between Temperature=',1PE11.4,         &       
     &       ' and Temperature=',1PE11.4,' is ',A20)
      CALL INTAB(NBT,INT,NR,5,OUTPUT)
      CALL WRTAB1(OUTPUT,HEAD(1),UNIT(1),ALPHA,S,NP)
  190 CONTINUE
  200 CONTINUE
!
!     PROCESS EFFECTIVE TEMPERATURE RECORD
!
  250 IF(NFOR.LT.6)   GO TO 500
      CALL TOPAGE
      CALL CANT1(ITAPE,C1,C2,L1,L2,NR,NT,MAT,MF,MT,NBT,INT,ALPHA,S)
      CALL INTAB(NBT,INT,NR,3,OUTPUT)
      IF(OUTPUT.GT.0) WRITE(OUTPUT,260)
  260 FORMAT(//' TABLE OF EFFECTIVE TEMPERATURES FOR PRINCIPLE ATOM')
      CALL WRTAB1(OUTPUT,HEAD(2),UNIT(2),ALPHA,S,NT)
      IF(NS.LE.0)   GO TO 500
      DO 280 NN=1,NS
      IF(CFLAG(NN+1).GT.0.)    GO TO 280
      CALL TOPAGE
      CALL CANT1(ITAPE,C1,C2,L1,L2,NR,NT,MAT,MF,MT,NBT,INT,ALPHA,S)
      CALL INTAB(NBT,INT,NR,3,OUTPUT)
      IF(OUTPUT.GT.0) WRITE(OUTPUT,270)   B(6*NN+3)
  270 FORMAT(//' TABLE OF EFFECTIVE TEMPERATURES FOR ATOM WITH',        &       
     &     ' EFFECTIVE MASS EQUAL TO ',1PE11.4)
      CALL WRTAB1(OUTPUT,HEAD(2),UNIT(2),ALPHA,S,NT)
  280 CONTINUE
      GO TO 500
!
!     COHERENT ELASTIC SCATTERING
!
  300 IF(LTHR.NE.1) GO TO 400
      CALL CANT1(ITAPE,T,C2,LT,L2,NR,NP,MAT,MF,MT,NBT,INT,ALPHA,S)
      IF(OUTPUT.GT.0) WRITE(OUTPUT,310)
  310 FORMAT(/' COHERENT ELASTIC SCATTERING')
      CALL INTAB(NBT,INT,NR,1,OUTPUT)
      IF(LT.GT.0)  CALL TOPAGE
      IF(OUTPUT.GT.0) WRITE(OUTPUT,320)  T
  320 FORMAT(//' TABULATED STRUCTURE FACTORS AT',1PE11.4,' DEGREES ',   &       
     &  'KELVIN')
      CALL WRTAB1(OUTPUT,HEAD(3),UNIT(3),ALPHA,S,NP)
      IF(LT.LE.0)GO TO 500
      DO 390 K=1,LT
      TLAST=T
      CALL CANT(ITAPE,T,C2,INTER,L2,NP,N2,MAT,MF,MT,S)
      CALL TOPAGE
      IF(OUTPUT.GT.0) WRITE(OUTPUT,320) T
      IF(INTER.LT.1.OR.INTER.GT.5) INTER=6
      IF(OUTPUT.GT.0) WRITE(OUTPUT,330) TLAST,T,INLAWS(INTER)
  330 FORMAT(' Interpolation Law between Temperature=',1PE11.4,         &       
     &       ' and Temperature=',1PE11.4,' is ',A20)
      CALL INTAB(NBT,INT,NR,5,OUTPUT)
      CALL WRTAB1(OUTPUT,HEAD(3),UNIT(3),ALPHA,S,NP)
  390 CONTINUE
      GO TO 500
!
!     INCOHERENT ELASTIC SCATTERING
!
  400 IF(LTHR.NE.2) GO TO 500
      CALL CANT1(ITAPE,SB,C2,L1,L2,NR,NP,MAT,MF,MT,NBT,INT,ALPHA,S)
      IF(OUTPUT.GT.0) WRITE(OUTPUT,410) SB
  410 FORMAT(//' ELASTIC INCOHERENT SCATTERING'/                        &       
     &    '   CHARACTERISTIC BOUND CROSS SECTION IS',1PE11.4,' BARNS')
      CALL INTAB(NBT,INT,NR,3,OUTPUT)
      IF(OUTPUT.GT.0) WRITE(OUTPUT,420)
  420 FORMAT(/' DEBYE-WALLER INTEGRAL/A')
      CALL WRTAB1(OUTPUT,HEAD(4),UNIT(4),ALPHA,S,NP)
!
!     SKIP SEND RECORD
!
  500 CALL SKPREC(ITAPE,1)
!
!     CHECK FOR NEW SECTION OR END OF FILE
!
      CALL CONT(ITAPE,ZAI,AWRI,LTHR,LAT,N1I,N2I,MATI,MFI,MTI)
      IF(MFI.GT.0) GO TO 10
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE FILE8
!
!     ROUTINE TO CONTROL PROCESSING OF FILE 8 DATA
!
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/HEADI/ZAI,AWRI,L1I,L2I,N1I,N2I,MATI,MFI,MTI
!
!     SET IDENTIFICATION FOR THE FILE
!
      CALL HEADIN(MATI,MFI,0,ZAI)
!
!     OUTPUT FILE HEADING TO SUMMARY
!
      CALL FILEHD(MFI)
!
!     SET SECTION ID AND BRANCH ON SECTION
!
   10 CALL HEADIN(0,0,MTI,-1.0)
      IF(MTI.EQ.454.OR.MTI.EQ.459)   GO TO 20
      IF(MTI.EQ.457)  GO TO 30
!
!     RADIOACTIVE NUCLIDE PRODUCTION
!
      CALL FILE8A
      GO TO 100
!
!     FISSION PRODUCT YIELDS
!
   20 CALL FILE8B
      GO TO 100
!
!     DECAY DATA
!
   30 CALL FILE8C
!
!     LOOK FOR FILE END CARD
!
  100 CALL CONT(ITAPE,ZAI,AWRI,L1I,L2I,N1I,N2I,MATI,MFI,MTI)
      IF(MFI.NE.0)GO TO 10
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE FILE8A
!
!     RADIOACTIVE NUCLIDE PRODUCTION
!
      COMMON DUM(510),E(1000),DUM1(50000),DUM2(50000)
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/TOPPER/LIBBCD,MFBCD,MTBCD,DZABCD
      CHARACTER(LEN=14) LIBBCD
      CHARACTER(LEN=48) MFBCD
      CHARACTER(LEN=30) MTBCD
      CHARACTER(LEN=24) DZABCD
      COMMON/HEADI/ZA,AWR,LIS,LISO,NS,N0,MATI,MFI,MTI
!
      CHARACTER(LEN=24) ZABCD
      CHARACTER(LEN=24) ZAPBCD
      CHARACTER(LEN=6) SZBCD
!
      CHARACTER(LEN=18) RDATA(3)
      DATA RDATA/'CROSS SECTIONS(3) ',                                  &       
     &           'MULTIPLICITIES(9) ','CROSS SECTIONS(10)'/
!
!     GET TARGET NUCLIDE EXPANSION
!
      CALL ZAID(ZA,ZABCD,IERR)
!
!     OUTPUT PAGE HEADER
!
      CALL TOPAGE
!
!     PROCESS EACH STATE
!
      DO 200 N=1,NS
      IF(N0.EQ.1)  THEN
         CALL CONT(ITAPE,ZAP,ELFS,LMF,LFSO,NZ,MATP,MAT,MF,MT)
         IREP = 1
      ELSE
         CALL CANT(ITAPE,ZAP,ELFS,LMF,LFSO,NZ,MATP,MAT,MF,MT,E)
         IREP = LMF - 7
      END IF
!
!     DECODE PRODUCT NUCLIDE
!
      CALL ZAID(ZAP,ZAPBCD,IERR)
      CALL NUSYM(ZAP,SZBCD,NSZBCD,IERR)
!
!     WRITE OUT INITIAL STATE
!
      IF(LISO.EQ.0) THEN
         IF(OUTPUT.GT.0) WRITE(OUTPUT,20) N,ZABCD
   20    FORMAT(///'       Reaction ',I3/'       ------------'/         &       
     &      '       Original Nuclide= ',A24,'  (GROUND state)')
      ELSE
         IF(OUTPUT.GT.0) WRITE(OUTPUT,50)  ZABCD,MAX0(LISO,LIS)
   50    FORMAT('       Original Nuclide= ',A24,                        &       
     &      '  (',I3,'-EXCITED state)')
      END IF
!
!     WRITE OUT FINAL STATE
!
   60 IF(LFSO.EQ.0) THEN
         IF(OUTPUT.GT.0) WRITE(OUTPUT,70)  ZAPBCD
   70    FORMAT('       Product  Nuclide= ',A24,'  (GROUND state)')
      ELSE
         IF(OUTPUT.GT.0) WRITE(OUTPUT,90)   ZAPBCD,LFSO
   90    FORMAT('       Product  Nuclide= ',A24,                        &       
     &     '  (',I3,'-EXCITED state)')
      END IF
!
!     OUTPUT ADDITIONAL PRODUCT PARAMETERS
!
  100 IF(OUTPUT.GT.0) THEN
         IF(MATP.NE.0) WRITE(OUTPUT,105)  MATP
  105    FORMAT(7X,'Reaction Product Material Number           = ',     &       
     &       I4)
         IF(ELFS.NE.0.0) WRITE(OUTPUT,110)  ELFS
  110    FORMAT(7X,'Excitation Energy of Product               =',      &       
     &       1PE11.4,' eV')
         WRITE(OUTPUT,115)  LMF
  115    FORMAT(7X,'Multiplicity/Cross Section File Number     = ',     &       
     &       I2/)
      END IF
!
!     PROCESS EACH DECAY MODE
!
      ND = NZ/6
      IF(NZ.EQ.0)   GO TO 150
      IF(OUTPUT.GT.0) WRITE(OUTPUT,120)
  120 FORMAT('   Branch Number      ZAP Half-life      Mode of Decay',  &       
     &       '    Next Nuclide(ZAN) ZAN Branching Ratio  ',             &       
     &       'End-point Energy   Chain Terminator'/)
      DO 140 K=1,NZ,6
      KK=K+5
      K3 = KK
      IF(K3.GT.NZ)K3=NZ
      KK=KK/6
      IF(OUTPUT.GT.0) WRITE(OUTPUT,130)KK,(E(K2),K2=K,K3)
  130 FORMAT(8X,I3,4X,6(8X,1PE11.4))
  140 CONTINUE
!
!     OUTPUT LINE TO SUMMARY
!
  150 IF(N.EQ.1)  THEN
         WRITE(SOUT,160) MTI,MTBCD,SZBCD,MATP,LFSO,ELFS,RDATA(IREP),ND
  160    FORMAT(/I6,3X,A30,4X,A6,6X,I4,6X,I3,5X,1PE11.4,3X,A18,4X,I3)
      ELSE
         WRITE(SOUT,170) SZBCD,MATP,LFSO,ELFS,RDATA(IREP),ND
  170    FORMAT(43X,A6,6X,I4,6X,I3,5X,1PE11.4,3X,A18,4X,I3)
      END IF
  200 CONTINUE
!
!     SKIP SEND CARD
!
      CALL SKPREC(ITAPE,1)
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE FILE8B
!
!     FISSION PRODUCT YIELDS
!
      COMMON DUM(509),INTE,C(50000),DUM1(50000)
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/TOPPER/LIBBCD,MFBCD,MTBCD,ZABCD
      CHARACTER(LEN=14) LIBBCD
      CHARACTER(LEN=48) MFBCD
      CHARACTER(LEN=30) MTBCD
      CHARACTER(LEN=24) ZABCD
      COMMON/HEADI/ZAI,AWRI,L1I,L2I,N1I,N2I,MATI,MFI,MTI
!
!     READ FIRST SECTION
!
      I=0
      CALL CANT(ITAPE,E,C2,LE,L2,N2NFP,NFP,MATI,MFI,MTI,C)
      ELO = E
      NE = LE + 1
      INTE=LE
      CALL LIST8B(NFP,I,E)
!
!     SET UP LOOP TO READ ALL OTHER SECTIONS
!
      IF(LE.LE.0)   GO TO 100
      DO 50 I=1,LE
      II = I
      CALL CANT(ITAPE,E,C2,INTE,L2,N2NFP,NFP,MAT,MF,MT,C)
      CALL HEADIN(0,0,MT,-1.0)
      CALL LIST8B(NFP,II,E)
   50 CONTINUE
!
!     OUTPUT TO SUMMARY
!
  100 EHI = E
      WRITE(SOUT,110) MTI,MTBCD,NFP,NE,ELO,EHI
  110 FORMAT(/I6,3X,A30,4X,I4,' FISSION PRODUCTS specified at',I3,      &       
     &   ' ENERGIES between',1PE11.4,' and',1PE11.4,' eV')
!
!     SKIP SEND RECORD
!
      CALL SKPREC(ITAPE,1)
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE LIST8B(NFP,IF1D,E)
!
!     PRINT FISSION PRODUCT YIELDS
!
      COMMON DUM(509),INTE,C(50000),DUM1(50000)
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
!
      CHARACTER(LEN=6) ZABCDS(3)
      CHARACTER(LEN=1) IFLAG(3)
      REAL YLD(3),DYLD(3)
!
!     WRITE HEADING FOR PAGE
!
      CALL TOPAGE
!
!     WRITE OUT ENERGY AND INTERPOLATION
!
      IF(OUTPUT.GT.0.AND.E.GT.0.0)  WRITE(OUTPUT,10)  E
   10 FORMAT(/29X,' Incident Neutron Energy   ',1PE11.4,' eV'/)
      IF(OUTPUT.GT.0.AND.IF1D.GT.0)   WRITE(OUTPUT,20) INTE
   20 FORMAT(29X,' Interpolation Law for Last Interval=',I2/)
!
!     WRITE OUT COLUMN HEADINGS
!
      IF(OUTPUT.GT.0) WRITE(OUTPUT,30)
   30 FORMAT(' Index  ',3('     Fission       Fractional    Yield   ')/ &       
     &       '        ',3('     Product          Yield   Uncertainty'))
!
!     PRINT YIELDS IN GROUPS OF THREE
!
      JJ=1
      IFC=0
      DO 100 I=1,NFP,3
      JMAX = MIN0(3,NFP-(JJ-1)/4)
      DO 80 J=1,JMAX
!
!     SET PRODUCT TEXT ID
!
      CALL NUSYM(C(JJ),ZABCDS(J),NZAB,IERR)
!
!     GET YIELD AND UNCERTAINTY FOR PRODUCT
!
      YLD(J)=C(JJ+2)
      DYLD(J) = C(JJ+3)
!
!     SET ISOMER FLAG
!
      IFLAG(J) = ' '
      IF(C(JJ+1).GE.1.0) THEN
         IFC=1
         IFLAG(J) = '*'
      END IF
      JJ = JJ + 4
   80 CONTINUE
      IF(OUTPUT.GT.0) WRITE(OUTPUT,90)   I,(IFLAG(J),ZABCDS(J),         &       
     &     YLD(J),DYLD(J),J=1,JMAX)
   90 FORMAT(I7,1X,3(A1,1X,A6,10X,1PE12.5,1PE11.4))
  100 CONTINUE
!
!     DEFINE ISOMER FLAG IF USED
!
      IF(OUTPUT.GT.0.AND.IFC.GT.0) WRITE(OUTPUT,110)
  110 FORMAT(// 9X,'* Excited State')
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE FILE8C
!
!     DECAY DATA
!
      COMMON DUM(276),E(34),INT(100),NBT(100),B(5000),DUM1(45000),      &       
     &           X(5000),Y(5000),DUM2(40000)
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/TOPPER/LIBBCD,MFBCD,MTBCD,DZABCD
      CHARACTER(LEN=14) LIBBCD
      CHARACTER(LEN=48) MFBCD
      CHARACTER(LEN=30) MTBCD
      CHARACTER(LEN=24) DZABCD
      COMMON/HEADI/ZAI,AWRI,LIS,LISO,N1I,NSP,MATI,MFI,MTI
!
      CHARACTER(LEN=1) NSTTE
      CHARACTER(LEN=1) ITIME
      CHARACTER(LEN=1) PRTY
      CHARACTER(LEN=18) IC
      CHARACTER(LEN=24) ZABCD
!
      CHARACTER(LEN=2) FLIS(4)
      CHARACTER(LEN=16) COV(2)
      PARAMETER (NTIMES=4)
      CHARACTER(LEN=1) NTIME(NTIMES)
      REAL TIMAX(NTIMES)
      CHARACTER(LEN=12) NRTYP(11)
      CHARACTER(LEN=16) NSTYP(10)
      CHARACTER(LEN=12) NTYP(4)
!
      DATA FLIS/'ST','ND','RD','TH'/
      DATA COV/'                ','WITH COVARIANCES'/
!
!     TABLES FOR TIME CONVERSIONS
!
      DATA NTIME/'M','H','D','Y'/
      DATA TIMAX/60.,60.,24.,365.25/
!
!     TABLE OF DECAY TYPES
!
      DATA NRTYP            /'GAMMA RAY   ','BETA DECAY  ',             &       
     &                       'E.C./POS EMI','ISOM TRANS  ',             &       
     &                       'ALPHA DECAY ','NEUTRON EMIS',             &       
     &                       'SPONT FISSN ','PROTON EMIS ',             &       
     &                       'NOT DEFINED ','NOT DEFINED ',             &       
     &                       'UNKNOWN ORIG'/
!
!     TABLE OF RADIATION TYPES
!
      DATA NSTYP            /'GAMMA RAYS      ','BETA RAYS       ',     &       
     &                       'E.C. OR POS EMIS','NOT DEFINED     ',     &       
     &                       'ALPHA PARTICLE ','NEUTRONS        ',      &       
     &                       'SPONT FIS FRAGS ','PROTONS         ',     &       
     &                       'DISCRETE ELECTS ','XRAYS/ANNIL RAD '/
!
!     TABLE OF BETA TRANSITION TYPES
!
      DATA NTYP            /'NOT REQUIRED','ALLOWED     ',              &       
     &                     '1ST-FORBIDDN','2ND-FORBIDDN'/
!
!     WRITE HEADING ON PAGE
!
      CALL TOPAGE
!
!     OUTPUT NUCLIDE AND LEVEL IDENTIFIER
!
      NIS = MIN0(LIS,4)
      NIS0 = MIN0(LISO,4)
      CALL ZAID(ZAI,ZABCD,IERR)
      IF(LIS.GT.0) GO TO 20
      IF(OUTPUT.GT.0) WRITE(OUTPUT,10) ZABCD
   10 FORMAT(//44X,'Radioactive Nuclide  GROUND State of ',A20)
      GO TO 40
   20 IF(LISO.GT.0) GO TO 30
      IF(OUTPUT.GT.0) WRITE(OUTPUT,25) LIS,FLIS(NIS),ZABCD
   25 FORMAT(//40X,'Radioactive Nuclide  ',I2,A2,' EXCITED State of ',  &       
     & A24)
      GO TO 40
   30 IF(OUTPUT.GT.0) WRITE(OUTPUT,35) LIS,FLIS(NIS),LISO,              &       
     &    FLIS(NIS0),ZABCD
   35 FORMAT(//40X,'Radioactive Nuclide  ',I2,A2,' EXCITED State (',I2, &       
     &   A2,' ISOMERIC State) of ',A24)
!
!     READ FIRST RECORD
!
   40 CALL CANT(ITAPE,C1,C2,L1,L2,N1,N2,MAT,MF,MT,E)
!
!     CONVERT HALF-LIFE
!
      HL = C1
      DHL = C2
      ITIME = 'S'
      DO I=1,NTIMES
         TIM = TIMAX(I)
         IF(HL.LT.TIM)   GO TO 60
         ITIME = NTIME(I)
         HL = HL/TIM
         DHL = DHL/TIM
      END DO
!
!     PROCESS LIST OF DECAY MODES
!
   60 CALL CANT(ITAPE,C1,C2,L1,L2,N1,NDK,MAT,MF,MT,B)
!
!     OUTPUT SPIN PARITY AND HALF-LIFE
!
      PRTY = '+'
      IF(C2.LT.0.0) PRTY = '-'
      IF(OUTPUT.EQ.0) GO TO 68
      ASPIN = ABS(C1)
      IF(ASPIN.NE.77.777)  WRITE(OUTPUT,62) C1,PRTY
   62 FORMAT(40X,'Spin and Parity      ',F4.1,1X,A1)
      IF(ASPIN.EQ.77.777)  WRITE(OUTPUT,63)
   63 FORMAT(40X,'Spin and Parity       UNKNOWN')
      WRITE(OUTPUT,65) HL,DHL,ITIME
   65 FORMAT(40X,'Half-life ',11X,1PE12.5,' +/- ',1PE12.5,2X,A1)
!
!     WRITE AVERAGE RADIATION ENERGIES
!
   68 IF(OUTPUT.GT.0) THEN
         WRITE(OUTPUT,'(/31X,A,1PE12.5,A,1PE12.5,A)')                   &       
     &      'Average LIGHT PARTICLE Energy  ',E(1),' +/- ',E(2),' eV'
         IF(N1.EQ.34) THEN
            WRITE(OUTPUT,'(34X,A,1PE12.5,A,1PE12.5,A)')                 &       
     &         '              BETA- Energy  ',E(7),' +/- ',E(8),' eV'
            WRITE(OUTPUT,'(34X,A,1PE12.5,A,1PE12.5,A)')                 &       
     &         '              BETA+ Energy  ',E(9),' +/- ',E(10),' eV'
            WRITE(OUTPUT,'(34X,A,1PE12.5,A,1PE12.5,A)')                 &       
     &         '     AUGER ELECTRON Energy  ',E(11),' +/- ',E(12),' eV'
            WRITE(OUTPUT,'(34X,A,1PE12.5,A,1PE12.5,A)')                 &       
     &         'CONVERSION ELECTRON Energy  ',E(13),' +/- ',E(14),' eV'
         END IF
         WRITE(OUTPUT,'(/31X,A,1PE12.5,A,1PE12.5,A)')                   &       
     &      'Average ELECTROMAGNETIC Energy ',E(3),' +/- ',E(4),' eV'
         IF(N1.EQ.34) THEN
            WRITE(OUTPUT,'(34X,A,1PE12.5,A,1PE12.5,A)')                 &       
     &         '          GAMMA-RAY Energy  ',E(15),' +/- ',E(16),' eV'
            WRITE(OUTPUT,'(34X,A,1PE12.5,A,1PE12.5,A)')                 &       
     &         '              X-RAY Energy  ',E(17),' +/- ',E(18),' eV'
            WRITE(OUTPUT,'(34X,A,1PE12.5,A,1PE12.5,A)')                 &       
     &         '     BREMSSTRAHLUNG Energy  ',E(19),' +/- ',E(20),' eV'
            WRITE(OUTPUT,'(34X,A,1PE12.5,A,1PE12.5,A)')                 &       
     &         '       ANNILILATION Energy  ',E(21),' +/- ',E(22),' eV'
         END IF
         WRITE(OUTPUT,'(/31X,A,1PE12.5,A,1PE12.5,A)')                   &       
     &      'Average HEAVY PARTICLE Energy  ',E(5),' +/- ',E(6),' eV'
         IF(N1.EQ.34) THEN
            WRITE(OUTPUT,'(34X,A,1PE12.5,A,1PE12.5,A)')                 &       
     &         '     ALPHA PARTICLE Energy  ',E(23),' +/- ',E(24),' eV'
            WRITE(OUTPUT,'(34X,A,1PE12.5,A,1PE12.5,A)')                 &       
     &         '             RECOIL Energy  ',E(25),' +/- ',E(26),' eV'
            WRITE(OUTPUT,'(34X,A,1PE12.5,A,1PE12.5,A)')                 &       
     &         'SPONTANEOUS FISSION Energy  ',E(27),' +/- ',E(28),' eV'
            WRITE(OUTPUT,'(34X,A,1PE12.5,A,1PE12.5,A)')                 &       
     &         '            NEUTRON Energy  ',E(29),' +/- ',E(30),' eV'
            WRITE(OUTPUT,'(34X,A,1PE12.5,A,1PE12.5,A)')                 &       
     &         '             PROTON Energy  ',E(31),' +/- ',E(32),' eV'
            WRITE(OUTPUT,'(/31X,A,1PE12.5,A,1PE12.5,A)')                &       
     &        'Average NEUTRINO Energy        ',E(5),' +/- ',E(6),' eV'
         END IF
      END IF
!
!     WRITE COLUMN HEADINGS
!
      IF(OUTPUT.GT.0) WRITE(OUTPUT,75)
   75 FORMAT(/'      Decay Mode     Product State',15X,'Q-value (eV)',  &       
     &   16X,'Branching Ratio'/)
!
!     READ DECAY TYPES AND PRINT
!
      NPOS = 0
      DO 120 I4=1,NDK
      LFF = B(NPOS+2)
      NSTTE = 'G'
      IF(LFF.NE.0) NSTTE = 'M'
      I3 = B(NPOS+1)
!
!     SIMPLE DECAY
!
      IF((B(NPOS+1)-FLOAT(I3)).NE.0.0) GO TO 100
      IC = '   '//NRTYP(I3+1)
      GO TO 105
!
!     COMPLEX DECAY
!
  100 CALL CDECAY(B(NPOS+1),IC)
!
!     OUTPUT DECAY MODE PARAMETERS
!
  105 IF(OUTPUT.GT.0) WRITE(OUTPUT,110) IC,NSTTE,B(NPOS+3),             &       
     &     B(NPOS+4),B(NPOS+5),B(NPOS+6)
  110 FORMAT(3X,A18,3X,A1,11X,1PE12.5,' +/- ',1PE12.5,5X,1PE12.5,       &       
     &    ' +/- ',1PE12.5)
      NPOS = NPOS + 6
  120 CONTINUE
!
!     OUTPUT SECTION SUMMARY
!
      WRITE(SOUT,122) MTI,MTBCD,HL,ITIME,NDK,NSP
  122 FORMAT(/I6,3X,A30,4X,'Half-life',1PE11.4,1X,A1,5X,I2,' Decay ',   &       
     &  'Modes and ',I2,' Radiation Types')
!
!     READ ENERGY/INTENSITY AND PRINT
!
      IF(NSP.EQ.0) GO TO 500
      DO 300 I4=1,NSP
!
!     READ FIRST LIST RECORD
!
      CALL CANT(ITAPE,C1,STYP,LCON,L2,N1,NER,MAT,MF,MT,B)
      I3=STYP+1
      IF(OUTPUT.GT.0) WRITE(OUTPUT,125)  NSTYP(I3),(B(IJ),IJ=1,6)
  125 FORMAT(//6X,'for Decay Radiation Type: ',A16/                     &       
     & 10X,'Discrete Spectrum Normalization Factor  ',1PE12.5,' +/- ',  &       
     &              1PE12.5/                                            &       
     & 10X,'Average Decay Energy',20X,1PE12.5,' +/- ',1PE12.5,' eV'/    &       
     & 10X,'Continuum Spectrum Normalization Factor ',1PE12.5,' +/- ',  &       
     &              1PE12.5)
!
!     OUTPUT DISCRETE SPECTRA
!
      IF(LCON.EQ.1)GO TO 250
      IF(STYP.NE.0.0) GO TO 133
      IF(OUTPUT.GT.0) WRITE(OUTPUT,130)
  130 FORMAT(/'   Radiation          Relative            Mode of      ',&       
     &       ' Internal Pair     Total Internal    K-shell InternaL  ', &       
     &       'L-shell Internal '/                                       &       
     &       '     Energy           Intensity            Decay       ', &       
     &       ' Formation Coeff   Conversion Coeff  Conversion Coeff  ', &       
     &       'Conversion Coeff ')
      GO TO 150
  133 IF(OUTPUT.GT.0.AND.STYP.EQ.1.0) WRITE(OUTPUT,135)
  135 FORMAT(/6X,'Radiation Energy',12X,'Relative Intensity',9X,        &       
     &  'Mode of Decay   Spectrum Definition ')
      IF(OUTPUT.GT.0.AND.STYP.EQ.2.0) WRITE(OUTPUT,140)
  140 FORMAT(/6X,'Radiation Energy',12X,'Relative Intensity',9X,        &       
     &  'Mode of Decay   Spectrum Definition      ',                    &       
     &  'Positron Intensity')
      IF(OUTPUT.GT.0.AND.STYP.GE.3.0) WRITE(OUTPUT,145)
  145 FORMAT(/6X,'Radiation Energy',12X,'Relative Intensity',9X,        &       
     &  'Mode of Decay')
!
!     LOOP THROUGH DISCRETE ENERGIES
!
  150 DO 200 JJ=1,NER
      CALL CANT(ITAPE,ER,DER,L1,L2,NT,N2,MAT,MF,MT,B)
      J3=B(2)+1.
!
!     DETERMINE DECAY MODE TEXT
!
      CALL CDECAY(B(1),IC)
!
!     OUTPUT DATA FOR EACH DISCRETE ENERGY
!
      IF(OUTPUT.EQ.0)   GO TO 190
      IF(STYP.NE.0.0) GO TO 170
      WRITE(OUTPUT,160) ER,B(3),IC,(B(J),J=5,NT,2)
  160 FORMAT(2(1X,1PE12.5,5X),1X,A18,4(1X,1PE12.5,5X))
      DDER = DER+B(4)+B(6)+B(8)+B(10)+B(12)
      IF(DDER.NE.0.0)  WRITE(OUTPUT,165) DER,(B(J),J=4,NT,2)
  165 FORMAT(2(' +/-',1PE12.5,2X),17X,4(:,'   +/-',1PE12.5))
      GO TO 190
  170 IF(STYP.GE.3.)  GO TO 185
      IF(STYP.EQ.1.0) WRITE(OUTPUT,175) ER,DER,B(3),B(4),IC,NTYP(J3)
  175 FORMAT(2(1X,1PE12.5,' +/-',1PE12.5),1X,A18,:,4X,A12,5X,1PE12.5,   &       
     &   :,' +/-',1PE12.5)
      IF(STYP.EQ.2.0) WRITE(OUTPUT,175) ER,DER,B(3),B(4),IC,NTYP(J3),   &       
     &       B(5),B(6)
      GO TO 190
  185 IF(STYP.GE.3.0) WRITE(OUTPUT,175) ER,DER,B(3),B(4),IC
  190 DO I=1,12
         B(I) = 0.
      END DO
  200 CONTINUE
!
!     OUTPUT CONTINUUM SPECTRUM
!
  250 IF(LCON.EQ.0)  GO TO 300
!     READ THE TAB1
      CALL CANT1(ITAPE,RTYP,C2,L1,LCOV,NR,NP,MAT,MF,MT,NBT,INT,X,Y)
      I3=RTYP+1.
      IF(OUTPUT.GT.0) WRITE(OUTPUT,260)  NRTYP(I3),COV(LCOV+1)
  260 FORMAT(//'     for Decay Mode: ',A12,1X,A16/                      &       
     &       3('     Energy (eV)      Continuum Comp. Spectr')/)
      DO 275 J2=1,NP,3
      J3=J2+2
      IF(J3.GT.NP)  J3 = NP
      IF(OUTPUT.GT.0) WRITE(OUTPUT,270)(X(J1),Y(J1),J1=J2,J3)
  270 FORMAT(6(5X,1PE12.5,5X))
  275 CONTINUE
      IF(LCOV.EQ.0)   GO TO 300
      CALL CANT(ITAPE,C1,C2,L1,L2,N1,N2,MAT,MF,MT,Y)
  300 CONTINUE
!
!     SKIP TO END OF SECTION
!
  500 CALL SKPSEC(ITAPE)
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE CDECAY(FNUM,IC)
!
!     ROUTINE TO TRANSLATE A NUMERICAL REPRESENTATION OF A COMPLEX DECAY
!       INTO A TEXT STRING
!
      CHARACTER(LEN=18) IC
      CHARACTER(LEN=2) ID(6)
!
!     STRING FOR EACH DECAY TYPE
!
      PARAMETER (NDTYPE=11)
      CHARACTER(LEN=2) ITYPE(NDTYPE)
      DATA ITYPE/'G','B-','EC','IT','A','N','SF','P',3*'?'/
!
      IRTYP = FNUM*100000.
      N = 0
      IC = ' '
      DO 25 I=1,6
      IR = IRTYP/10
      NUM = IRTYP - IR*10
      IRTYP = IR
      IF(NUM.EQ.0) GO TO 25
      N = N + 1
      ID(N) = ITYPE(NUM+1)
   25 CONTINUE
      IF(N.EQ.0)   GO TO 100
!
!     INVERT ORDER AND CENTER IN FIELD
!
      IBEG = (18-(3*N-1))/2 + 1
      DO NN=1,N
         IC(IBEG:IBEG+1) = ID(N-NN+1)
         IF(N.EQ.NN)   GO TO 100
         IC(IBEG+2:IBEG+2) = ','
         IBEG = IBEG + 3
      END DO
!
  100 RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE FILE9
!
!     ROUTINE TO CONTROL PROCESSING OF BOTH FILES 9 AND 10
!
      COMMON DUM(110),NBT(200),INT(200),X(50000),Y(50000)
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/TOPPER/LIBBCD,MFBCD,MTBCD,DZABCD
      CHARACTER(LEN=14) LIBBCD
      CHARACTER(LEN=48) MFBCD
      CHARACTER(LEN=30) MTBCD
      CHARACTER(LEN=24) DZABCD
      COMMON/HEADI/ZAI,AWRI,L1I,L2I,NS,N2I,MATI,MFI,MTI
!
      CHARACTER(LEN=24) HEAD(2)
      CHARACTER(LEN=24) UNIT(2)
!
      DATA HEAD/'   Energy     Sigma     ',                             &       
     &          '   Energy  Multiplicity '/
      DATA UNIT/'     eV       Barns     ',                             &       
     &          '     eV                 '/
!
!     SET IDENTIFICATION FOR THE FILE
!
      CALL HEADIN(MATI,MFI,0,ZAI)
!
!     OUTPUT FILE HEADING TO SUMMARY
!
      CALL FILEHD(MFI)
!
!     SET SECTION ID INFORMATION
!
   10 CALL HEADIN(0,0,MTI,-1.0)
!
!     LOOP THRU ALL OF STATES
!
      DO 100 I=1,NS
      CALL TOPAGE
      CALL CANT1(ITAPE,C1,Q,L1,LFSO,NR,NP,MAT,MF,MT,NBT,INT,X,Y)
      IF(OUTPUT.GT.0) WRITE(OUTPUT,50) LFSO,Q
   50 FORMAT(/' State Number of Final Product ',I2/                     &       
     &        ' Reaction Q-Value              ',1PE11.4,' eV')
      CALL INTAB(NBT,INT,NR,1,OUTPUT)
      CALL WRTAB1(OUTPUT,HEAD(11-MF),UNIT(11-MF),X,Y,NP)
!
!     OUTPUT SUMMARY LINE
!
      IF(I.EQ.1)   THEN
         WRITE(SOUT,60) MTI,MTBCD,LFSO,Q,NP,X(1),X(NP),NR
   60    FORMAT(/I6,3X,A30,9X,I2,4X,1PE11.4,I6,2X,1PE11.4,1X,1PE11.4,I7)
      ELSE
         WRITE(SOUT,70)  LFSO,Q,NP,X(1),X(NP),NR
   70    FORMAT(48X,I2,4X,1PE11.4,I6,2X,1PE11.4,1X,1PE11.4,I7)
      END IF
!
  100 CONTINUE
!
!     SKIP SEND RECORD
!
      CALL SKPREC(ITAPE,1)
!
!     SEE IF ANOTHER SECTION IN THE FILE
!
      CALL CONT(ITAPE,ZAI,AWRI,L1I,L2I,NS,N2I,MATI,MFI,MTI)
      IF(MFI.GT.0)GO TO 10
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE FILE12
!
!     ROUTINE TO CONTROL PROCESSING OF FILE 12 AND FILE 13
!
      COMMON DUM(105),EG,ES,LF,NR,NP,NBT(200),INT(200),X(50000),Y(50000)
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/TOPPER/LIBBCD,MFBCD,MTBCD,ZABCD
      CHARACTER(LEN=14) LIBBCD
      CHARACTER(LEN=48) MFBCD
      CHARACTER(LEN=30) MTBCD
      CHARACTER(LEN=24) ZABCD
      COMMON/HEADI/ZAI,AWRI,LO,LG,NSNK,N2I,MATI,MFI,MTI
!
      CHARACTER(LEN=11) SLEVEL,GENERG
!
      CHARACTER(LEN=10) SOURCE(3)
      CHARACTER(LEN=12) MODE(2)
      CHARACTER(LEN=24) PROB
!
      DATA SOURCE/'NOT STATED',' SECONDARY','  PRIMARY '/
      DATA MODE/'  ALL GAMMA ','    COMPLEX '/
      DATA PROB/'TRANSITION PROBABILITY  '/
!
!     SET IDENTIFICATION FOR THE FILE
!
      CALL HEADIN(MATI,MFI,0,ZAI)
      MBR = MFI - 11
!
!     OUTPUT FILE HEADING TO SUMMARY
!
      CALL FILEHD(MFI)
!
!     SET SECTION IDENTIFICATION INFORMATION
!
   10 CALL HEADIN(0,0,MTI,-1.0)
!
!     OUTPUT PAGE HEADER
!
      CALL TOPAGE
!
!     BRANCH ON REPRESENTATION
!
      IF(LO.EQ.2) GO TO 100
!
!     DATA ARE MULTIPLICITIES
!
      NK=NSNK
      IF(NK.LE.1) GO TO 25
!
!     READ AND OUTPUT TOTAL PHOTON PRODUCTION
!
      CALL CANT1(ITAPE,C1,C2,LP,LF,NR,NP,MAT,MF,MT,NBT,INT,X,Y)
      CALL LIST12(MBR,1)
      CALL TOPAGE
!
!     PROCESS ALL PARTIAL PHOTON PRODUCTION
!
   25 DO 50 N=1,NK
      CALL CANT1(ITAPE,EG,ES,LP,LF,NR,NP,MAT,MF,MT,NBT,INT,X,Y)
      CALL LIST12(MBR,2)
!
!     OUTPUT SUMMARY LINE
!
      SLEVEL = ' CONTINUUM'
      GENERG = ' '
      IF(EG.EQ.0.0)    GO TO 30
      WRITE(GENERG,27) EG
      SLEVEL = '  UNKNOWN'
      IF(ES.NE.0.)  WRITE(SLEVEL,27) ES
   27 FORMAT(1PE11.4)
   30 IF(N.EQ.1)  THEN
         WRITE(SOUT,35)  MTI,MTBCD,GENERG,SOURCE(LP+1),SLEVEL,NP,       &       
     &      X(1),X(NP),NR
   35    FORMAT(/I6,3X,A30,1X,A11,3X,A10,2X,A11,I6,3X,1PE11.4,1X,       &       
     &     1PE11.4,I7)
      ELSE
         WRITE(SOUT,40) GENERG,SOURCE(LP+1),SLEVEL,NP,X(1),X(NP),NR
   40    FORMAT(40X,A11,3X,A10,2X,A11,I6,3X,1PE11.4,1X,1PE11.4,I7)
      END IF
!
   50 CONTINUE
      GO TO 200
!
!     DATA ARE TRANSITION PROBABILITY ARRAYS
!
  100 NS=NSNK
      CALL CANT(ITAPE,ES,C2I,L1I,L2I,NL,NT,MAT,MF,MT,X)
!
!     OUTPUT SUMMARY LINE
!
      WRITE(SOUT,105)  MTI,MTBCD,SOURCE(LP+1),ES,NT,MODE(LG),NS
  105 FORMAT(/I6,3X,A30,15X,A10,1X,1PE11.4,2X,I4,A12,'Transitions ',    &       
     &   'to',I4,' lower levels')
!
!     OUT FULL LISTING
!
      ES=ES*1.0E-6
      IF(OUTPUT.GT.0) WRITE(OUTPUT,110)  ES,NS
  110 FORMAT(/' Transition Probability Array from Level Energy',        &       
     &   1PE11.4,' MeV'/                                                &       
     &        ' Number of Levels below the present one, including the ',&       
     &   'ground state = ',I3)
      IF(OUTPUT.GT.0) WRITE(OUTPUT,120) (PROB,I=1,LG)
  120 FORMAT(/' Index    Energy ',2(A24))
      IF(OUTPUT.GT.0) WRITE(OUTPUT,130)
  130 FORMAT('            eV')
      M=1
      DO I=1,NT
         N=LG+M
         IF(OUTPUT.GT.0) WRITE(OUTPUT,140) I,(X(II),II=M,N)
  140    FORMAT(I5,2X,1PE11.4,2(6X,1PE11.4,5X))
         M=N+1
      END DO
!
!     SKIP SEND RECORD
!
  200 CALL SKPREC(ITAPE,1)
!
!     DETERMINE IF THERE ARE MORE SECTIONS IN THE FILE
!
      CALL CONT(ITAPE,ZAI,AWRI,LO,LG,NSNK,N2I,MATI,MFI,MTI)
      IF(MFI.GT.0) GO TO 10
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE LIST12(J,K)
!
!     ROUTINE TO LIST FILE 12 AND 13 DATA
!
      COMMON DUM(105),EG,ES,LF,NR,NP,NBT(200),INT(200),X(50000),Y(50000)
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/HEADI/ZAI,AWRI,LO,LG,NSNK,N2I,MATI,MFI,MTI
!
      CHARACTER(LEN=24) HEAD(2)
      CHARACTER(LEN=24) UNIT(2)
!
      DATA HEAD/'   Energy    Photons    ',                             &       
     &          '   Energy     Sigma     '/
      DATA UNIT/'     eV                 ',                             &       
     &          '     eV       Barns     '/
!
!     WRITE TOTAL PHOTON YIELD
!
      IF(K.EQ.2)   GO TO 20
      CALL INTAB(NBT,INT,NR,1,OUTPUT)
      IF(OUTPUT.GT.0.AND.J.EQ.1)  WRITE(OUTPUT,10)
   10 FORMAT(/' Total Photon Yield')
      IF(OUTPUT.GT.0.AND.J.EQ.2)  WRITE(OUTPUT,15)
   15 FORMAT(/' Total Photon Production Cross Section')
      GO TO 100
!
!     BRANCH ON LF
!
   20 IF(LF.NE.1)   GO TO 40
!
!     NORMALIZED TABULATED FUNCTION
!
      IF(OUTPUT.GT.0) WRITE(OUTPUT,30)
   30 FORMAT(///' Photon Energy Distribution Law = TABULATED')
      GO TO 50
!
!     WRITE DISCRETE PHOTON ENERGY TABLE
!
   40 IF(OUTPUT.GT.0) WRITE(OUTPUT,45)
   45 FORMAT(///' Photon Energy Distribution Law = DISCRETE')
!
!     OUTPUT INTERPOLATION SCHEME AND HEADING
!
   50 CALL INTAB(NBT,INT,NR,1,OUTPUT)
      IF(EG.EQ.0.0) GO TO 60
      EG=EG*1.0E-6
      ES=ES*1.0E-6
      IF(OUTPUT.EQ.0) GO TO 100
      IF(ES.GT.0.0)  WRITE(OUTPUT,55)  EG,ES
   55 FORMAT(/' Photon Energy',1PE11.4,' MeV,   Level Energy',          &       
     &   1PE11.4,' MeV')
      IF(ES.EQ.0.0)  WRITE(OUTPUT,57)  EG
   57 FORMAT(/' Photon Energy',1PE11.4,' MeV,   Level Energy UNKNOWN')
      GO TO 100
   60 IF(OUTPUT.GT.0) WRITE(OUTPUT,70)
   70 FORMAT(/' Continuous Photon Energy Distribution')
!
!     OUTPUT DATA
!
  100 CALL WRTAB1(OUTPUT,HEAD(J),UNIT(J),X,Y,NP)
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE FILE14
!
!     ROUTINE TO PROCESS FILE 14 DATA
!
      COMMON DUM(104),E,NP,NL,LCT,EG,ES,NBT(200),INT(200),P(101),       &       
     &   FMU(101),PL(81,64),FL(64),TMATRX(4225),DUM1(40264),DUM2(50000)
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/TOPPER/LIBBCD,MFBCD,MTBCD,ZABCD
      CHARACTER(LEN=14) LIBBCD
      CHARACTER(LEN=48) MFBCD
      CHARACTER(LEN=30) MTBCD
      CHARACTER(LEN=24) ZABCD
      COMMON/HEADI/ZAI,AWRI,LI,LTT,NK,NI,MATI,MFI,MTI
!
      PARAMETER (NANG=81,NCOF=64)
      CHARACTER(LEN=11) SLEVEL,GENERG
!
      CHARACTER(LEN=9) REP(2)
      DATA REP/'LEGENDRE ','TABULATED'/
!
!     SET IDENTIFICATION FOR THE FILE
!
      CALL HEADIN(MATI,MFI,0,ZAI)
!
!     OUTPUT FILE HEADING TO SUMMARY
!
      CALL FILEHD(MFI)
!
!     SET SECTION IDENTIFICATION INFORMATION
!
   10 CALL HEADIN(0,0,MTI,-1.0)
!
      IF(LI.EQ.1)   GO TO 500
!
!     PROCESS ALL SUBSECTIONS WHEN ALL NOT ISOTROPIC
!
      DO 200 N=1,NK
      SLEVEL = ' CONTINUUM'
      GENERG = ' '
!
!     AN ISOTROPIC PHOTON DISTRIBUTION
!
      IF(N.GT.NI) GO TO 50
      CALL CONT(ITAPE,EG,ES,L1,L2,N1,N2,MAT,MF,MT)
      ES=ES*1.0E-6
      EG=EG*1.0E-6
      IF(EG.EQ.0.0)    GO TO 15
      WRITE(GENERG,12) EG
      SLEVEL = '  UNKNOWN'
      IF(ES.NE.0.)  WRITE(SLEVEL,12) ES
   12 FORMAT(1PE11.4)
   15 IF(N.EQ.1)  CALL TOPAGE
      IF(OUTPUT.GT.0.AND.EG.NE.0.0) WRITE(OUTPUT,20) EG,ES
   20 FORMAT(/6X,1PE12.5,' MeV Photons from the',1PE12.5,               &       
     &  ' MeV Level are ISOTROPIC')
      IF(OUTPUT.GT.0.AND.EG.EQ.0.0) WRITE(OUTPUT,30)
   30 FORMAT(/6X,'All Photons from the Continuum are ISOTROPIC')
!
!     OUTPUT SUMMARY LINE
!
      IF(N.EQ.1)  THEN
         WRITE(SOUT,25)  MTI,MTBCD,GENERG,SLEVEL
   25    FORMAT(/I6,3X,A30,1X,A11,1X,A11,42X,'ISOTROPIC')
      ELSE
         WRITE(SOUT,27)  GENERG,SLEVEL
   27    FORMAT(40X,A11,1X,A11,42X,'ISOTROPIC')
      END IF
!
      GO TO 200
!
!     NON-ISOTROPIC PHOTON
!
   50 CALL CANT2(ITAPE,EG,ES,L1,L2,NR,NE,MAT,MF,MT,NBT,INT)
      ES=ES*1.0E-6
      EG=EG*1.0E-6
      IF(EG.EQ.0.0)    GO TO 60
      WRITE(GENERG,12) EG
      SLEVEL = '  UNKNOWN'
      IF(ES.NE.0.0)  WRITE(SLEVEL,12) ES
   60 NRR = NR
      NMIN = 100000
      NMAX = 0
      CALL INTAB(NBT,INT,NR,1,OUTPUT)
!
!     DATA IS IN THE FORM OF LEGENDRE COEFFICIENTS
!
      IF(LTT.GT.1)  GO TO 150
!
!     GENERATE TABLES OF LEGENDRE POLYNOMIALS
!
      CALL LEGEND(PL,NCOF,NANG,1.0,-1.0)
      DO J=1,NANG
         P(J) = PL(J,1)
      END DO
!
!     SET UP LOOP OVER ENERGIES
!
      NP = NANG
      DO 110 I=1,NE
!
!     READ TABLE OF LEGENDRE COEFFICIENTS
!
      CALL CANT(ITAPE,C1,E,L1,L2,NL,N2,MAT,MF,MT,FL)
      IF(I.EQ.1)   ELO = E
      IF(I.EQ.NE)  EHI = E
      NMIN = MIN0(NMIN,NL)
      NMAX = MAX0(NMAX,NL)
!
!     RECONSTRUCT AND LIST ANGULAR DISTRIBUTION
!
      CALL ANGLAR(FMU,FL,PL,NL,NCOF,NANG)
      CALL TOPAGE
      CALL LIST4
  110 CONTINUE
      GO TO 170
!
!     DATA IS IN TABULAR FORM
!
  150 CONTINUE
!
!     SET UP LOOP OVER ENERGIES
!
      DO 160 I=1,NE
!
!     READ TABULATED ANGULAR DISTRIBUTION
!
      CALL CANT1(ITAPE,C1,E,L1,L2,NR,NP,MAT,MF,MT,NBT,INT,P,FMU)
      IF(I.EQ.1)   ELO = E
      IF(I.EQ.NE)  EHI = E
      NMIN = MIN0(NMIN,NP)
      NMAX = MAX0(NMAX,NP)
!
!     LIST INTERPOLATION LAW AT TOP OF NEW PAGE
!
      CALL TOPAGE
      CALL INTAB(NBT,INT,NR,2,OUTPUT)
!
!     LIST TABULAR ANGULAR DISTRIBUTION
!
      CALL LIST4
  160 CONTINUE
!
!     OUTPUT SUMMARY LINE
!
  170 IF(N.EQ.1)   THEN
         WRITE(SOUT,175) MTI,MTBCD,GENERG,SLEVEL,NE,ELO,EHI,NRR,        &       
     &      REP(LTT),NMIN,NMAX
  175    FORMAT(/I6,3X,A30,1X,A11,1X,A11,I5,3X,1PE11.4,1X,1PE11.4,      &       
     &      I7,5X,A9,2I5)
      ELSE
         WRITE(SOUT,180) GENERG,SLEVEL,NE,ELO,EHI,NRR,REP(LTT),NMIN,NMAX
  180    FORMAT(40X,A11,1X,A11,I5,3X,1PE11.4,1X,1PE11.4,I7,5X,A9,2I5)
      END IF
!
  200 CONTINUE
      GO TO 1000
!
!     DATA IS ISOTROPIC
!
  500 CALL TOPAGE
      IF(OUTPUT.GT.0) WRITE(OUTPUT,510)
  510 FORMAT(//6X,'All Photons are ISOTROPIC')
      WRITE(SOUT,520)  MTI,MTBCD
  520 FORMAT(/I6,3X,A30,1X,'All Photons are ISOTROPIC')
!
!     SKIP SEND RECORD
!
 1000 CALL SKPREC(ITAPE,1)
!
!     DETERMINE IF THERE ARE MORE SECTIONS IN THE FILE
!
      CALL CONT(ITAPE,ZAI,AWRI,LI,LTT,NK,NI,MATI,MFI,MTI)
      IF(MFI.NE.0)   GO TO 10
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE FILE15
!
!     ROUTINE TO CONTROL PROCESSING OF FILE 15
!
      COMMON DUM(110),NBT(200),INT(200),X(50000),Y(50000)
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/TOPPER/LIBBCD,MFBCD,MTBCD,ZABCD
      CHARACTER(LEN=14) LIBBCD
      CHARACTER(LEN=48) MFBCD
      CHARACTER(LEN=30) MTBCD
      CHARACTER(LEN=24) ZABCD
      COMMON/HEADI/ZAI,AWRI,L1I,L2I,NC,N2I,MATI,MFI,MTI
!
      CHARACTER(LEN=24) HEAD(2)
      CHARACTER(LEN=24) UNIT(2)
      CHARACTER(LEN=15) LAW
!
      DATA HEAD/'   Energy     P(E)      ',                             &       
     &                     '   Energy    Dsigma     '/
      DATA UNIT/'     eV                 ',                             &       
     &          '     eV       1/eV      '/
      DATA LAW/'TABULATED(1)   '/
!
!     SET IDENTIFICATION FOR THE FILE
!
      CALL HEADIN(MATI,MFI,0,ZAI)
!
!     OUTPUT FILE HEADING TO SUMMARY
!
      CALL FILEHD(MFI)
!
!     SET SECTION IDENTIFICATION INFORMATION
!
   10 CALL HEADIN(0,0,MTI,-1.0)
!
!     PROCESS ALL SUBSECTIONS
!
      DO 200 I=1,NC
      CALL CANT1(ITAPE,C1,C2,L1,LF,NR,NP,MAT,MF,MT,NBT,INT,X,Y)
      ELO = X(1)
      EHI = X(NP)
      NRR = NR
      NPP = NP
      NF = 0
!
!     OUTPUT PAGE HEADER
!
      CALL TOPAGE
!
!     OUTPUT INTERPOLATION SCHEME FOR PROBABILITY
!
      CALL INTAB(NBT,INT,NR,1,OUTPUT)
!
!     PRINT TABLE OF PROBABILITIES
!
      IF(OUTPUT.GT.0) WRITE(OUTPUT,20)
   20 FORMAT(10X)
      CALL WRTAB1(OUTPUT,HEAD(1),UNIT(1),X,Y,NP)
!
!     READ AND OUTPUT ENERGY INTERPOLATION
!
      CALL CANT2(ITAPE,C1,C2,L1,L2,NR,NE,MAT,MF,MT,NBT,INT)
      CALL TOPAGE
      CALL INTAB(NBT,INT,NR,1,OUTPUT)
!
!     PROCESS TABULAR DISTRIBUTION FOR EACH INCIDENT ENERGY
!
      DO 150 J1=1,NE
      CALL CANT1(ITAPE,C1,E,L1,L2,NR,NP,MAT,MF,MT,NBT,INT,X,Y)
      NF = MAX0(NF,NP)
      CALL TOPAGE
      CALL INTAB(NBT,INT,NR,1,OUTPUT)
      E=E*1.0E-6
      IF(OUTPUT.GT.0) WRITE(OUTPUT,100) E
  100 FORMAT(/' Continuous Photon Energy Distribution Neutron Energy',  &       
     &   1PE11.4,' MeV')
      CALL WRTAB1(OUTPUT,HEAD(2),UNIT(2),X,Y,NP)
  150 CONTINUE
!
!     OUTPUT SUMMARY LINE
!
      IF(I.EQ.1)   THEN
         WRITE(SOUT,170)  MTI,MTBCD,LAW,NPP,ELO,EHI,NRR,NE,NF
  170    FORMAT(/I6,3X,A30,2X,A15,I8,4X,1PE11.4,1X,1PE11.4,I7,          &       
     &      7X,I3,3X,I3)
      ELSE
         WRITE(SOUT,175)  LAW,NPP,ELO,EHI,NRR,NE,NF
  175    FORMAT(42X,A15,I8,4X,1PE11.4,1X,1PE11.4,I7,7X,I3,3X,I3)
      END IF
!
  200 CONTINUE
!
!     SKIP SEND RECORD
!
      CALL SKPREC(ITAPE,1)
!
!     DETERMINE IF THERE ARE MORE SECTIONS IN THE FILE
!
      CALL CONT(ITAPE,ZAI,AWRI,L1I,L2I,NC,N2I,MATI,MFI,MTI)
      IF(MFI.GT.0) GO TO 10
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE FILE23
!
!     ROUTINE TO CONTROL PROCESSING OF FILE 23 AND FILE 27 DATA
!
      COMMON DUM(110),NBT(200),INT(200),X(50000),Y(50000)
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/TOPPER/LIBBCD,MFBCD,MTBCD,ZABCD
      CHARACTER(LEN=14) LIBBCD
      CHARACTER(LEN=48) MFBCD
      CHARACTER(LEN=30) MTBCD
      CHARACTER(LEN=24) ZABCD
      COMMON/HEADI/ZAI,AWRI,L1I,L2I,N1I,N2I,MATI,MFI,MTI
!
      CHARACTER(LEN=24) HEAD(3)
      CHARACTER(LEN=24) UNIT(3)
!
      DATA HEAD/'   Energy     Sigma     ',                             &       
     &          '  Momentum    Factor    ',                             &       
     &          '   Energy     Factor    '/
      DATA UNIT/'     eV       Barns     ',                             &       
     &          '   1/Ang                ',                             &       
     &          '     eV                 '/
!
!     SET IDENTIFICATION FOR THE FILE
!
      CALL HEADIN(MATI,MFI,0,ZAI)
!
!     OUTPUT FILE HEADING TO SUMMARY
!
      CALL FILEHD(MFI)
!
!     SET SECTION IDENTIFICATION INFORMATION
!
   10 CALL HEADIN(0,0,MTI,-1.0)
      CALL CANT1(ITAPE,C1,C2,L1,L2,NR,NP,MAT,MF,MT,NBT,INT,X,Y)
      CALL TOPAGE
      CALL INTAB(NBT,INT,NR,1,OUTPUT)
      IHEAD = 1
      IF(MFI.EQ.27) THEN
         IF(MTI.EQ.505.OR.MTI.EQ.506)  THEN
            IHEAD = 3
         ELSE
            IHEAD = 2
         END IF
      END IF
      CALL WRTAB1(OUTPUT,HEAD(IHEAD),UNIT(IHEAD),X,Y,NP)
!
!     OUTPUT SUMMARY LINE
!
      WRITE(SOUT,50) MTI,MTBCD,NP,X(1),X(NP),NR
   50 FORMAT(/I6,3X,A30,7X,I4,2X,1PE11.4,1X,1PE11.4,5X,I3)
!
!     SKIP SEND RECORD
!
      CALL SKPREC(ITAPE,1)
!
!     DETERMINE IF THERE ARE MORE SECTIONS IN THE FILE
!
      CALL CONT(ITAPE,ZAI,AWRI,L1I,L2I,N1I,N2I,MATI,MFI,MTI)
      IF(MFI.GT.0) GO TO 10
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE FILE26
!
!     ROUTINE TO CONTROL PROCESSING OF FILE 26 DATA
!
      COMMON DUM(86),FL(21),ZAP,NR,NP,NBT(200),INT(200),X(50000),       &       
     &       Y(50000)
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/TOPPER/LIBBCD,MFBCD,MTBCD,ZABCD
      CHARACTER(LEN=14) LIBBCD
      CHARACTER(LEN=48) MFBCD
      CHARACTER(LEN=30) MTBCD
      CHARACTER(LEN=24) ZABCD
      COMMON/HEADI/ZAI,AWRI,L1I,LCT,NK,N2I,MATI,MFI,MTI
      COMMON/SSIX/LANG,NE
!
      CHARACTER(LEN=24) ZAPBCD
      CHARACTER(LEN=6) SBCD
      CHARACTER(LEN=8) ZAPSB
!
      PARAMETER (NPARTS=2)
      CHARACTER(LEN=10) OPARTS(NPARTS)
      INTEGER IPARTS(NPARTS)
      PARAMETER (NLAWS=9)
      CHARACTER(LEN=30) LTEXT(NLAWS)
      CHARACTER(LEN=12) LSTEXT(NLAWS)
      CHARACTER(LEN=24) HEAD
      CHARACTER(LEN=24) UNIT
!
      DATA OPARTS/'PHOTON    ','ELECTRON  '/
      DATA IPARTS/0,11/
!
      DATA LTEXT/'UNKNOWN                       ',                      &       
     &           'CONTINUUM ENERGY-ANGLE        ',                      &       
     &           'DISCRETE TWO-BODY             ',                      &       
     &           'ISOTROPIC DISCRETE TWO-BODY   ',                      &       
     &           'RECOIL TWO-BODY               ',                      &       
     &           'CHARGED PARTICLE ELASTIC      ',                      &       
     &           'N-BODY PHASE SPACE            ',                      &       
     &           'ANGLE-ENERGY TABULAR          ',                      &       
     &           'ENERGY TRANSFER FOR EXCITATION'/
      DATA LSTEXT/'UNKNOWN(0)  ','CONTINUUM(1)','DISCRETE(2) ',         &       
     &            'ISOTROPIC(3)','RECOIL(4)   ','CP ELAST.(5)',         &       
     &            'N-BODY(6)   ','ANG-EN(7)   ','EN-TRANS(8) '/
!
      DATA HEAD/'   Energy     Number    '/
      DATA UNIT/'     eV                 '/
!
!     SET IDENTIFICATION FOR THE FILE
!
    5 CALL HEADIN(MATI,MFI,MTI,ZAI)
!
!     SET SECTION IDENTIFICATION INFORMATION
!
      CALL HEADIN(0,0,MTI,-1.0)
!
!     OUTPUT FILE HEADING TO SUMMARY
!
      CALL FILEHD(MFI)
!
!     PROCESS EACH PARTIAL DISTRIBUTION
!
      DO 190 I=1,NK
      CALL CANT1(ITAPE,ZAP,C2,LIP,LAW,NR,NP,MAT,MF,MT,NBT,INT,X,Y)
      NRR = NR
      NPP = NP
      ELO = X(1)
      EHI = X(NP)
!
!     OUTPUT PAGE HEADER
!
      CALL TOPAGE
!
!     SET PRODUCT TEXT STRING
!
      IZAP = ABS(ZAP) + .001
      IF(ZAP.LT.0.)  IZAP = -IZAP
      DO 10 J=1,NPARTS
      IF(IPARTS(J).EQ.IZAP)    GO TO 15
   10 CONTINUE
      CALL ZAID(ZAP,ZAPBCD,IERR)
      CALL NUSYM(ZAP,SBCD,NSBCD,IERR)
      ZAPSB = SBCD
      GO TO 20
   15 ZAPBCD = OPARTS(J)
      ZAPSB = OPARTS(J)(1:8)
!
!     IDENTIFY DISTRIBUTION
!
   20 IF(OUTPUT.GT.0) WRITE(OUTPUT,25) ZAPBCD
   25 FORMAT(/' Distribution for ',A24,' Product')
!
!     OUTPUT YIELDS
!
      CALL INTAB(NBT,INT,NR,1,OUTPUT)
      CALL WRTAB1(OUTPUT,HEAD,UNIT,X,Y,NP)
!
!     IDENTIFY THE LAW
!
      IF(OUTPUT.GT.0) WRITE(OUTPUT,30) LTEXT(LAW+1)
   30 FORMAT(/' Product Distribution Law is ',A30)
!
!     BRANCH ON LAW
!
      LF = LAW + 1
      LANG = 0
      NE = 0
      IF(LAW.GT.8)   GO TO 200
!
      SELECT CASE (LF)
!
!     TABULAR FUNCTION
!
         CASE (2)
            CALL LIST6A
!
!     DISCRETE TWO BODY SCATTERING
!
         CASE (3)
            CALL LIST6B
!
!     ENERGY TRANSFER FOR EXCITATION
!
         CASE (9)
            CALL LIST6E
!
      END SELECT
!
!     OUTPUT SUMMARY LINE
!
  175 IF(I.EQ.1)  THEN
         WRITE(SOUT,180) MTI,MTBCD,ZAPSB,LSTEXT(LAW+1),NPP,             &       
     &      ELO,EHI,NRR,LANG,NE
  180    FORMAT(/I6,3X,A30,1X,A8,2X,A12,I8,3X,1PE11.4,1X,1PE11.4,I5,    &       
     &     7X,I3,I7)
      ELSE
         WRITE(SOUT,185) ZAPSB,LSTEXT(LAW+1),NPP,ELO,EHI,NRR,           &       
     &      LANG,NE
  185    FORMAT(40X,A8,2X,A12,I8,3X,1PE11.4,1X,1PE11.4,I5,7X,I3,I7)
      END IF
!
  190 CONTINUE
!
!     SKIP SEND RECORD
!
      CALL SKPREC(ITAPE,1)
      GO TO 250
!
!     INVALID LAW, SKIP REST OF SECTION
!
  200 IF(OUTPUT.GT.0) WRITE(OUTPUT,210) LAW
  210 FORMAT(//5X,'LAW = ',I2,' IS ILLEGAL. REST OF SECTION IS SKIPPED')
      CALL SKPSEC(ITAPE)
!
!     CHECK FOR NEW SECTION OR END OF FILE
!
  250 CALL CONT(ITAPE,ZAI,AWRI,L1I,LCT,NK,N2I,MATI,MFI,MTI)
      IF(MFI.GT.0) GO TO 5
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE FILE28
!
!     ROUTINE TO CONTROL PROCESSING OF FILE 28
!
      COMMON DUM(110),NBT(200),JINT(200),B(50000),DUM1(50000)
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/TOPPER/LIBBCD,MFBCD,MTBCD,ZABCD
      CHARACTER(LEN=14) LIBBCD
      CHARACTER(LEN=48) MFBCD
      CHARACTER(LEN=30) MTBCD
      CHARACTER(LEN=24) ZABCD
      COMMON/TOPI/NLIB,NVER,NREL,NSUB,MATIN,AWI,NMOD,NFOR
      COMMON/XYCONT/NSCR,MAXY,NCONT,NA,NB,NN
      COMMON/HEADI/ZAI,AWRI,L1I,L2I,NSS,N2I,MATI,MFI,MTI
!
!     DEFINE SUBSHELLS
!
      PARAMETER (NSHELS=39)
      CHARACTER(LEN=3) SHELL(NSHELS)
      DATA SHELL/'K  ','L1 ','L2 ','L3 ','M1 ','M2 ','M3 ','M4 ','M5 ', &       
     &           'N1 ','N2 ','N3 ','N4 ','N5 ','N6 ','N7 ','O1 ','O2 ', &       
     &           'O3 ','O4 ','O5 ','O6 ','O7 ','O8 ','O9 ','P1 ','P2 ', &       
     &           'P3 ','P4 ','P5 ','P6 ','P7 ','P8 ','P9 ','P10','P11', &       
     &           'Q1 ','Q2 ','Q3 '/
!
      CHARACTER(LEN=3) SC,S1,S2
!
!     SET IDENTIFICATION FOR THE FILE
!
      CALL HEADIN(MATI,MFI,0,ZAI)
!
!     OUTPUT FILE HEADING TO SUMMARY
!
      CALL FILEHD(MFI)
!
!     SET SECTION ID INFORMATION
!
   10 CALL HEADIN(0,0,MTI,-1.0)
!
!     WRITE PAGE LABEL
!
      CALL TOPAGE
!
!     PROCESS EACH SUBSHELL
!
      DO 50 N=1,NSS
!
      CALL CANT(ITAPE,SUBI,C2,L1,L2,NW,NTR,MAT,MF,MT,B)
      IF(N.NE.1)  CALL TOPAGE
      SC =  SHELL(INT(SUBI))
      IF(N.EQ.1) S1 = SC
      S2 = SC
      IF(OUTPUT.GT.0) THEN
         WRITE(OUTPUT,20) SC,INT(B(2)),B(1)
   20    FORMAT(/' Subshell is ',A,' with ',I2,' electrons when ',      &       
     &       'neutral.',8X,'Shell binding energy is ',F13.5,' eV')
      END IF
      IF(NTR.GT.0) THEN
         M = 7
         NRAD = 0
         NONRAD = 0
         DO L=1,NTR
            IF(B(M+1).EQ.0.) THEN
               NRAD = NRAD + 1
               IF(NRAD.EQ.1.AND.OUTPUT.GT.0) THEN
                  WRITE(OUTPUT,'(/3X,A/12X,A,21X,A/6X,2A)')             &       
     &              'Radiative transitions','Subshell','Transition',    &       
     &              'Secondary                    Energy           ',   &       
     &              'Fraction'
               END IF
               IF(OUTPUT.GT.0) THEN
                  WRITE(OUTPUT,25) SHELL(INT(B(M))),B(M+2),B(M+3)
   25             FORMAT(10X,A,16X,F13.5,8X,F11.8)
               END IF
            ELSE
               NONRAD = NONRAD + 1
               IF(NONRAD.EQ.1.AND.OUTPUT.GT.0) THEN
                  WRITE(OUTPUT,'(/3X,A/12X,A,21X,A/6X,2A)')             &       
     &              'Non-radiative transitions','Subshell','Transition',&       
     &              'Secondary   Tertiary         Energy           ',   &       
     &              'Fraction'
               END IF
               IF(OUTPUT.GT.0) THEN
                  WRITE(OUTPUT,30) SHELL(INT(B(M))),SHELL(INT(B(M+1))), &       
     &                       B(M+2),B(M+3)
   30             FORMAT(10X,A,8X,A,5X,F13.5,8X,F11.8)
               END IF
            END IF
            M = M + 6
         END DO
         NONRAD = NTR - NRAD
      END IF
   50 CONTINUE
!
!     OUTPUT SECTION INFO TO SUMMARY
!
      WRITE(SOUT,60) MTI,MTBCD,NSS,S1,S2,NRAD,NONRAD
   60 FORMAT(/I6,3X,A30,7X,I4,12X,A,9X,A,12X,I2,16X,I2)
!
!     SKIP SEND RECORD
!
      CALL SKPREC(ITAPE,1)
!
!     SEE IF ANOTHER SECTION IN FILE 28
!
      CALL CONT(ITAPE,ZAI,AWRI,L1I,L2I,N1I,N2I,MATI,MFI,MTI)
      IF(MFI.GT.0) GO TO 10
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE FILE32
!
!     ROUTINE TO CONTROL PROCESSING OF FILE 32 DATA
!
      COMMON DUM(510),B(50000),DUM1(50000)
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/TOPPER/LIBBCD,MFBCD,MTBCD,ZABCD
      CHARACTER(LEN=14) LIBBCD
      CHARACTER(LEN=48) MFBCD
      CHARACTER(LEN=30) MTBCD
      CHARACTER(LEN=24) ZABCD
      COMMON/TOPI/NLIB,NVER,NREL,NSUB,MATIN,AWI,NMOD,NFOR
      COMMON/TOPR/EMAX,ELIS,STA,LIS,LISO
      COMMON/HEADI/ZAI,AWRI,L1I,L2I,N1I,N2I,MATI,MFI,MTI
!
      CHARACTER(LEN=120) LINE
!
!     SET IDENTIFICATION FOR THE FILE
!
      CALL HEADIN(MATI,MFI,0,ZAI)
!
!     OUTPUT FILE HEADING TO SUMMARY
!
      CALL FILEHD(MFI)
!
!     SET SECTION IDENTIFICATION INFORMATION
!
   10 CALL HEADIN(0,0,MTI,-1.0)
      CALL TOPAGE
      IF(OUTPUT.GT.0) WRITE(OUTPUT,15)
   15 FORMAT(//' ****COVARIANCE DATA EXISTS BUT IS NOT LISTED****')
!
!     ENDF-5 FORMAT
!
      IF(NFOR.GT.5)   GO TO 50
!
!     OUTPUT SUMMARY LINE
!
      WRITE(SOUT,20)  MTI,MTBCD
   20 FORMAT(/I6,3X,A30,4X,'Covariances for Resolved Resonance Region', &       
     &   ' BREIT-WIGNER Parameters are given.'/                         &       
     &   58X,'(SEE SUMMARY FOR FILE 2)')
!
!     SKIP REST OF SECTION
!
      CALL SKPSEC(ITAPE)
      GO TO 500
!
!     ENDF-6 FORMAT
!
   50 NIS = N1I
      WRITE(SOUT,51)
   51 FORMAT(' ')
      WRITE(LINE,52)  MTI,MTBCD
   52 FORMAT(I6,3X,A30)
      LINELN = 39
!
!     LOOP OVER ISOTOPES
!
      DO 200 I=1,NIS
      CALL CONT(ITAPE,ZAI,ABN,L1,LFW,NER,N2,MATI,MFI,MTI)
      IZAI = IFIX(ZAI+.00001)
      IZ = IZAI/1000
      IA = MOD(IZAI,1000)
      WRITE(LINE(42:48),55) IZ,IA
   55 FORMAT(I2,2X,I3)
!
!     LOOP OVER ENERGY RANGES
!
      DO 190 II=1,NER
      CALL CONT(ITAPE,EL,EH,LRU,LRF,NRO,NAPS,MATI,MFI,MTI)
      WRITE(LINE(53:79),57) EL,EH,LRF
   57 FORMAT(1PE11.4,1X,1PE11.4,2X,I2)
!
!     RESOLVED RESONANCE RANGE
!
      IF(LRU.EQ.2)  GO TO 125
      LINE(84:93) = ' Resolved '
      LINELN = 93
!*****ENERGY DEPENDENT SCATTERING LENGTH
      IF(NRO.GT.0) THEN
         CALL CONT(ITAPE,C1,C2,L1,L2,N1,NIT,MATI,MFI,MTI)
         DO 60 I2=1,NIT
         CALL CANT(ITAPE,C1,C2,L1,L2,N1,NIT,MATI,MFI,MTI,B)
   60    CONTINUE
      END IF
!*****L-STATE CONTROL RECORD
      CALL CONT(ITAPE,C1,C2,L1,LCOMP,NLS,N2,MATI,MFI,MTI)
!
!     SINGLE AND MULTILEVEL BREIT-WIGNER ENDF-5 STYLE
!
      IF(LCOMP.EQ.1)   GO TO 80
      WRITE(LINE(99:100),65) NLS
   65 FORMAT(I2)
      LINELN = 100
      DO 75 N=1,NLS
      CALL CANT(ITAPE,C1,C2,L1,L2,N1,N2,MATI,MFI,MTI,B)
   75 CONTINUE
      GO TO 180
!
!     NEW STYLE FORMATS
!
   80 CALL CONT(ITAPE,C1,C2,L1,L2,NSRS,NLRS,MATI,MFI,MTI)
      WRITE(LINE(109:117),85) NSRS,NLRS
   85 FORMAT(I3,3X,I3)
      LINELN = 117
      IF(NSRS.EQ.0)   GO TO 100
      DO 90 I2=1,NSRS
      CALL CANT(ITAPE,C1,C2,L1,L2,N1,N2,MATI,MFI,MTI,B)
   90 CONTINUE
  100 IF(NLRS.EQ.0)   GO TO 180
      DO 110 I2=1,NLRS
      CALL CANT(ITAPE,C1,C2,L1,L2,N1,N2,MATI,MFI,MTI,B)
  110 CONTINUE
      GO TO 180
!
!     UNRESOLVED RESONANCE PARAMETERS
!
  125 LINE(84:93) = 'Unresolved'
      CALL CONT(ITAPE,C1,C2,L1,L2,NLS,N2,MATI,MFI,MTI)
      WRITE(LINE(99:100),65) NLS
      LINELN = 100
      DO 150 N=1,NLS
      CALL CONT(ITAPE,C1,C2,L1,L2,NJS,N2,MATI,MFI,MTI)
         DO NN=1,NJS
            CALL CANT(ITAPE,C1,C2,L1,L2,N1,N2,MATI,MFI,MTI,B)
         END DO
  150 CONTINUE
      CALL CANT(ITAPE,C1,C2,L1,L2,N1,N2,MATI,MFI,MTI,B)
!
!     OUTPUT SUMMARY LINE
!
  180 WRITE(SOUT,185) LINE(1:LINELN)
  185 FORMAT(A)
      LINE = ' '
      LINELN = 1
!
  190 CONTINUE
  200 CONTINUE
!
!     SKIP SEND RECORD
!
      CALL SKPREC(ITAPE,1)
!
!     DETERMINE IF THERE ARE MORE SECTIONS IN THE FILE
!
  500 CALL CONT(ITAPE,ZAI,AWRI,L1I,L2I,N1I,N2I,MATI,MFI,MTI)
      IF(MFI.GT.0) GO TO 10
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE FILE33
!
!     ROUTINE TO CONTROL PROCESSING OF FILE 31 AND 33 DATA
!
      COMMON DUM(110),NBT(200),INT(200),B(50000),DUM1(50000)
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/TOPPER/LIBBCD,MFBCD,MTBCD,ZABCD
      CHARACTER(LEN=14) LIBBCD
      CHARACTER(LEN=48) MFBCD
      CHARACTER(LEN=30) MTBCD
      CHARACTER(LEN=24) ZABCD
      COMMON/HEADI/ZAI,AWRI,L1I,MTL,N1I,NL,MATI,MFI,MTI
!
      CHARACTER(LEN=125) LINE
!
!     SET IDENTIFICATION FOR THE FILE
!
      CALL HEADIN(MATI,MFI,0,ZAI)
!
!     OUTPUT FILE HEADING TO SUMMARY
!
      CALL FILEHD(MFI)
!
!     SET SECTION IDENTIFICATION INFORMATION
!
   10 CALL HEADIN(0,0,MTI,-1.0)
      CALL TOPAGE
      IF(OUTPUT.GT.0) WRITE(OUTPUT,12)
   12 FORMAT(//' ****COVARIANCE DATA EXISTS BUT IS NOT LISTED****')
      WRITE(SOUT,13)
   13 FORMAT(' ')
      WRITE(LINE,14) MTI,MTBCD
   14 FORMAT(I6,3X,A30)
      LINELN = 39
!
!     PROCESS ALL SUBSECTIONS
!
      IF(MTL.NE.0)   GO TO 300
      DO 100 N=1,NL
      CALL CONT(ITAPE,C1,C2,MAT1,MT1,NC,NI,MAT,MF,MT)
      WRITE(LINE(42:52),15) MAT1,MT1
   15 FORMAT(I4,4X,I3)
      IF(MAT1.EQ.0) LINE(42:45) = 'SELF'
      LINELN = 45
!
!     PROCESS ALL SUB-SUBSECTIONS
!
      NS = NC + NI
      DO 90 NN=1,NS
      IF(NN.LE.NC)   CALL CONT(ITAPE,C1,C2,L1,LTY,N1,N2,MAT,MF,MT)
      CALL CANT(ITAPE,E1,E2,MATS,MTS,N2E,NE,MAT,MF,MT,B)
!
!     NC TYPE SUB-SUBSECTIONS
!
      IF(NN.LE.NC)  THEN
         WRITE(LINE(57:107),20) E1,E2,LTY,NE
   20    FORMAT(1PE11.4,1X,1PE11.4,6X,'NC',8X,I2,7X,I3)
         LINELN = 107
         IF(MATS.NE.0.OR.MTS.NE.0) THEN
            WRITE(LINE(113:122),25)  MATS,MTS
   25       FORMAT(I4,3X,I3)
            LINELN = 122
         END IF
!
!     NI TYPE SUB-SUBSECTIONS
!
      ELSE
         E1 = B(1)
         E2 = B(N2E-1)
         IF(LTY.EQ.5.OR.LTY.EQ.6)   E2 = B(NE)
         LTY = MTS
         WRITE(LINE(57:107),30) E1,E2,LTY,NE
   30    FORMAT(1PE11.4,1X,1PE11.4,6X,'NI',8X,I2,7X,I3)
         LINELN = 107
      END IF
!
!     OUTPUT SUMMARY LINE
!
      WRITE(SOUT,50) LINE(1:LINELN)
   50 FORMAT(A)
      LINE = ' '
      LINELN = 1
!
   90 CONTINUE
  100 CONTINUE
      GO TO 400
!
!     LUMPED COVARIANCES
!
  300 WRITE(LINE(49:86),310)  MTL
  310 FORMAT('Component of Lumped Reaction MTL =',I4)
      WRITE(SOUT,50) LINE(1:86)
!
!     SKIP SEND RECORD
!
  400 CALL SKPREC(ITAPE,1)
!
!     DETERMINE IF THERE ARE MORE SECTIONS IN THE FILE
!
      CALL CONT(ITAPE,ZAI,AWRI,L1I,MTL,N1I,NL,MATI,MFI,MTI)
      IF(MFI.GT.0) GO TO 10
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE FILE34
!
!     ROUTINE TO CONTROL PROCESSING OF FILE 34 DATA
!
      COMMON DUM(510),B(50000),DUM1(50000)
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/TOPPER/LIBBCD,MFBCD,MTBCD,ZABCD
      CHARACTER(LEN=14) LIBBCD
      CHARACTER(LEN=48) MFBCD
      CHARACTER(LEN=30) MTBCD
      CHARACTER(LEN=24) ZABCD
      COMMON/HEADI/ZAI,AWRI,L1I,L2I,N1I,N2I,MATI,MFI,MTI
!
!     SET IDENTIFICATION FOR THE FILE
!
      CALL HEADIN(MATI,MFI,0,ZAI)
!
!     OUTPUT FILE HEADING TO SUMMARY
!
      CALL FILEHD(MFI)
!
!     SET SECTION IDENTIFICATION INFORMATION
!
   10 CALL HEADIN(0,0,MTI,-1.0)
      CALL TOPAGE
      IF(OUTPUT.GT.0) WRITE(OUTPUT,20)
   20 FORMAT(//' ****COVARIANCE DATA EXISTS BUT IS NOT LISTED****')
!
!     LOOP OVER SUBSECTIONS
!
      NMT1 = N2I
      DO 100 N=1,NMT1
      CALL CONT(ITAPE,C1,C2,MAT1,MT1,NL,NL1,MAT,MF,MT)
      NSS = NL*NL1
!
!     LOOP OVER ALL SUB-SUBSECTIONS
!
      DO 90 NN=1,NSS
      CALL CONT(ITAPE,C1,C2,L,L1,N1,NI,MAT,MF,MT)
!
!     LOOP OVER ALL SUB-SUB-SUBSECTIONS
!
      DO 80 NNN=1,NI
      CALL CANT(ITAPE,C1,C2,LS,LB,NT,NE,MAT,MF,MT,B)
!
!     OUTPUT SUMMARY LINE
!
      IF(NNN.GT.1)   GO TO 70
      IF(N.EQ.1)  THEN
         WRITE(SOUT,50) MTI,MTBCD,MT1,L,L1,LB,NE
   50    FORMAT(/I6,3X,A30,5X,'SELF',I7,6X,I2,I5,9X,'NI',8X,I2,7X,I3)
      ELSE
         IF(NN.EQ.1) THEN
            WRITE(SOUT,55)  MT1,L,L1,LB,NE
   55       FORMAT(44X,'SELF',4X,I7,6X,I2,I5,9X,'NI',8X,I2,7X,I3)
         ELSE
            WRITE(SOUT,60)  L,L1,LB,NE
   60       FORMAT(61X,I2,I5,9X,'NI',8X,I2,7X,I3)
         END IF
      END IF
      GO TO 90
   70 WRITE(SOUT,75) L,L1,LB,NE
   75 FORMAT(61X,I2,I3,6X,'NI',8X,I2,7X,I3)
   80 CONTINUE
   90 CONTINUE
  100 CONTINUE
!
!     SKIP SEND RECORD
!
      CALL SKPREC(ITAPE,1)
!
!     DETERMINE IF THERE ARE MORE SECTIONS IN THE FILE
!
      CALL CONT(ITAPE,ZAI,AWRI,L1I,L2I,N1I,N2I,MATI,MFI,MTI)
      IF(MFI.GT.0) GO TO 10
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE FILE35
!
!     ROUTINE TO CONTROL PROCESSING OF FILE 35 DATA
!
      COMMON DUM(510),B(50000),DUM1(50000)
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/TOPPER/LIBBCD,MFBCD,MTBCD,ZABCD
      CHARACTER(LEN=14) LIBBCD
      CHARACTER(LEN=48) MFBCD
      CHARACTER(LEN=30) MTBCD
      CHARACTER(LEN=24) ZABCD
      COMMON/HEADI/ZAI,AWRI,L1I,L2I,N1I,N2I,MATI,MFI,MTI
!
!     SET IDENTIFICATION FOR THE FILE
!
      CALL HEADIN(MATI,MFI,0,ZAI)
!
!     OUTPUT FILE HEADING TO SUMMARY
!
      CALL FILEHD(MFI)
!
!     SET SECTION IDENTIFICATION INFORMATION
!
   10 CALL HEADIN(0,0,MTI,-1.0)
      CALL TOPAGE
      IF(OUTPUT.GT.0) WRITE(OUTPUT,20)
   20 FORMAT(//' ****COVARIANCE DATA EXISTS BUT IS NOT LISTED****')
!
!     LOOP OVER SUBSECTIONS
!
      NK = N1I
      DO 100 N=1,NK
      CALL CANT(ITAPE,E1,E2,L1,L2,NT,NE,MAT,MF,MT,B)
      IF(N.EQ.1)  THEN
         WRITE(SOUT,50) MTI,MTBCD,E1,E2,NE
   50    FORMAT(/I6,3X,A30,4X,1PE11.4,1X,1PE11.4,7X,I3)
      ELSE
         WRITE(SOUT,80) E1,E2,NE
   80    FORMAT(43X,1PE11.4,1X,1PE11.4,7X,I3)
      END IF
  100 CONTINUE
!
!     SKIP SEND RECORD
!
      CALL SKPREC(ITAPE,1)
!
!     DETERMINE IF THERE ARE MORE SECTIONS IN THE FILE
!
      CALL CONT(ITAPE,ZAI,AWRI,L1I,L2I,N1I,N2I,MATI,MFI,MTI)
      IF(MFI.GT.0) GO TO 10
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE FILE40
!
!     ROUTINE TO CONTROL PROCESSING OF FILE 40 DATA
!
      COMMON DUM(110),NBT(200),INT(200),B(50000),DUM1(50000)
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/TOPPER/LIBBCD,MFBCD,MTBCD,ZABCD
      CHARACTER(LEN=14) LIBBCD
      CHARACTER(LEN=48) MFBCD
      CHARACTER(LEN=30) MTBCD
      CHARACTER(LEN=24) ZABCD
      COMMON/HEADI/ZAI,AWRI,L1I,L2I,N1I,NS,MATI,MFI,MTI
!
      CHARACTER(LEN=4) CMAT1
      CHARACTER(LEN=10) STAN
      CHARACTER(LEN=2) SSTYPE
!
!     SET IDENTIFICATION FOR THE FILE
!
      CALL HEADIN(MATI,MFI,0,ZAI)
!
!     OUTPUT FILE HEADING TO SUMMARY
!
      CALL FILEHD(MFI)
!
!     SET SECTION IDENTIFICATION INFORMATION
!
   10 CALL HEADIN(0,0,MTI,-1.0)
      CALL TOPAGE
      IF(OUTPUT.GT.0) WRITE(OUTPUT,12)
   12 FORMAT(//' ****COVARIANCE DATA EXISTS BUT IS NOT LISTED****')
!
!     PROCESS ALL SUBSECTIONS
!
      DO 100 N=1,NS
      CALL CONT(ITAPE,C1,C2,L1,LFS,N1,NL,MAT,MF,MT)
!
!     PROCESS ALL SUB-SUBSECTIONS
!
      DO 95 NN=1,NL
      CALL CONT(ITAPE,XMF1,XLFS1,MAT1,MT1,NC,NI,MAT,MF,MT)
      MF1 = IFIX(XMF1+.00001)
      LFS1 = IFIX(XLFS1+.00001)
!
!     PROCESS ALL SUB-SUB-SUBSECTIONS
!
      NS = NC + NI
      DO 90 NNN=1,NS
      IF(NNN.LE.NC)   CALL CONT(ITAPE,C1,C2,L1,LTY,N1,N2,MAT,MF,MT)
      CALL CANT(ITAPE,E1,E2,MATS,MTS,N2E,NE,MAT,MF,MT,B)
      SSTYPE = 'NC'
      CMAT1 = 'SELF'
      IF(MAT1.NE.0)    WRITE(CMAT1,15)  MAT1
   15 FORMAT(I4)
      STAN = ' '
      IF(MATS.EQ.0.AND.MTS.EQ.0)   GO TO 30
      WRITE(STAN,20)  MATS,MTS
   20 FORMAT(I4,3X,I3)
!
!     SET UP FOR NI TYPE SUB-SUBSECTION
!
   30 IF(NNN.LE.NC)    GO TO 40
      SSTYPE = 'NI'
      E1 = B(1)
      E2 = B(N2E-1)
      LTY = MTS
      MATS = 0
      MTS = 0
      STAN = ' '
      IF(LTY.EQ.5.OR.LTY.EQ.6)   E2 = B(NE)
!
!     OUTPUT SUMMARY LINE
!
   40 IF(NNN.GT.1)   GO TO 70
      IF(N.EQ.1)  THEN
         WRITE(SOUT,50) MTI,MTBCD(1:26),LFS,CMAT1,MF1,MT1,              &       
     &     LFS1,E1,E2,SSTYPE,LTY,NE,STAN
   50    FORMAT(/I6,3X,A26,I4,4X,A4,2I4,I5,5X,1PE11.4,1X,1PE11.4,       &       
     &     6X,A2,8X,I2,7X,I3,5X,A10)
      ELSE
         IF(NN.EQ.1) WRITE(SOUT,55)  LFS,CMAT1,MF1,MT1,LFS1,E1,E2,      &       
     &     SSTYPE,LTY,NE,STAN
   55    FORMAT(36X,I3,4X,A4,4X,2I4,I5,5X,1PE11.4,1X,1PE11.4,6X,A2,     &       
     &     8X,I2,7X,I3,5X,A10)
         IF(NN.GT.1) WRITE(SOUT,60)  CMAT1,MF1,MT1,LFS1,E1,E2,SSTYPE,   &       
     &     LTY,NE,STAN
   60    FORMAT(43X,A4,4X,2I4,I5,5X,1PE11.4,1X,1PE11.4,6X,A2,8X,I2,     &       
     &     7X,I3,5X,A10)
      END IF
      GO TO 90
   70 WRITE(SOUT,80) E1,E2,SSTYPE,LTY,NE,STAN
   80 FORMAT(65X,1PE11.4,1X,1PE11.4,6X,A2,8X,I2,7X,I3,5X,A10)
   90 CONTINUE
   95 CONTINUE
  100 CONTINUE
!
!     SKIP SEND RECORD
!
      CALL SKPREC(ITAPE,1)
!
!     DETERMINE IF THERE ARE MORE SECTIONS IN THE FILE
!
      CALL CONT(ITAPE,ZAI,AWRI,L1I,L2I,N1I,N2I,MATI,MFI,MTI)
      IF(MFI.GT.0) GO TO 10
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE TOPAGE
!
!     ROUTINE TO OUTPUT TOP OF PAGE HEADING
!
      COMMON/INDAT/IOPT,NLABEL,EDITIT,IFULL
      INTEGER EDITIT
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/TOPPER/LIBBCD,MFBCD,MTBCD,ZABCD
      CHARACTER(LEN=14) LIBBCD
      CHARACTER(LEN=48) MFBCD
      CHARACTER(LEN=30) MTBCD
      CHARACTER(LEN=24) ZABCD
      COMMON/TOPI/NLIB,NVER,NREL,NSUB,MATIN,AWI,NMOD,NFOR
!
!     SKIP IF FULL LISTING NOT REQUIRED
!
      IF(OUTPUT.EQ.0)   GO TO 100
!
!     EITHER SKIP 4 LINES OR TO TOP OF NEXT PAGE
!
      IF(EDITIT.NE.1) WRITE(OUTPUT,10)
   10 FORMAT(////)
      IF(EDITIT.EQ.1) WRITE(OUTPUT,20)
   20 FORMAT('1')
!
!     WRITE IDENTIFICATION
!
      WRITE(OUTPUT,50) ZABCD,MATIN,NSUB,LIBBCD,NREL,MTBCD,MFBCD
   50 FORMAT(6X,A24,8X,' Material No.',I5,3X,' Sub-library No. ',I6,    &       
     &  12X,A14,'  Release No. ',I2//45X,A30/36X,A48/)
!
  100 RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE FILEHD(MFH)
!
!     ROUTINE TO OUTPUT TOP OF PAGE HEADING
!
      COMMON/INDAT/IOPT,NLABEL,EDITIT,IFULL
      INTEGER EDITIT
      COMMON/IODATA/INPUT,OTPUT,ITAPE,SOUT,OUTPUT
      INTEGER OTPUT,SOUT,OUTPUT
      COMMON/TOPPER/LIBBCD,MFBCD,MTBCD,ZABCD
      CHARACTER(LEN=14) LIBBCD
      CHARACTER(LEN=48) MFBCD
      CHARACTER(LEN=30) MTBCD
      CHARACTER(LEN=24) ZABCD
      COMMON/TOPI/NLIB,NVER,NREL,NSUB,MATIN,AWI,NMOD,NFOR
!
      CHARACTER(LEN=7) SEC
      CHARACTER(LEN=13) RTYP
!
      DATA SEC/'Section'/
      DATA RTYP/'Reaction Type'/
!
!     EITHER SKIP 4 LINES OR TO TOP OF NEXT PAGE
!
      IF(EDITIT.EQ.1) THEN
         WRITE(SOUT,10)
   10    FORMAT('1')
      ELSE
         WRITE(SOUT,15)
   15    FORMAT(////)
      END IF
!
!     WRITE IDENTIFICATION
!
      WRITE(SOUT,20) ZABCD,MATIN,NSUB,LIBBCD,NREL,MFH,MFBCD
   20 FORMAT(6X,A24,8X,' Material No.',I5,3X,' Sub-library No. ',I6,    &       
     &  12X,A14,'  Release No. ',I2//55X,'File#  ',I3/36X,A48/)
!
!     OUTPUT SUMMARY TABLE HEADINGS
!
      SELECT CASE (MFH)
!
!*****FILES 1 AND 2
!
         CASE (1,2)
      WRITE(SOUT,35)  SEC,RTYP
   35 FORMAT(1X,A7,9X,A13/3X,'(MT)'/1X,7('-'),8X,15('-'))
!
!****FILE 3
!
         CASE (3)
      IF(NFOR.GE.6)   THEN
         WRITE(SOUT,65)   SEC,RTYP
   65    FORMAT(1X,A7,9X,A13,24X,' Reaction   Intermediate  Energy',    &       
     &      '     Energy range(eV)','      Interp.'/                    &       
     &      54X,' Q-value       Q-value    Points',27X,'Regions'/       &       
     &      2X,'(MT)',75X,'(NP)     from           to       (NR)'/,     &       
     &      1X,7('-'),8X,15('-'),24X,8('-'),6X,8('-'),4X,4('-'),        &       
     &      5X,4('-'),10X,4('-'),6X,4('-'))
      ELSE
         WRITE(SOUT,70)   SEC,RTYP
   70    FORMAT(1X,A7,9X,A13,24X,'Reaction    Energy     ',             &       
     &      'Energy range(eV)      Interp.'/                            &       
     &      54X,'Q-value     Points',27X,'Regions'/                     &       
     &      2X,'(MT)',61X,'(NP)     from           to       (NR)'/,     &       
     &      1X,7('-'),8X,15('-'),23X,8('-'),5X,4('-'),5X,4('-'),        &       
     &      10X,4('-'),6X,4('-'))
      END IF
!
!*****FILE 4
!
         CASE (4)
      WRITE(SOUT,85)   SEC,RTYP
   85 FORMAT(1X,A7,9X,A13,10X,' Reference Energy      Energy ',         &       
     &   'range(eV)     Interp.   Data   Angular points-NP'/            &       
     &   43X,'Frame   Points',27X,'Regions   Form      ',               &       
     &   'or Order-NL'/                                                 &       
     &   2X,'(MT)',34X,'   (LCT)    (NE)      from           ',         &       
     &   'to      (NR)     (LTT)     MIN     MAX'/                      &       
     &   1X,7('-'),8X,15('-'),12X,5('-'),4X,4('-'),6X,4('-'),           &       
     &   10X,4('-'),5X,4('-'),3X,9('-'),3X,3('-'),5X,3('-'))
!
!*****FILE 5
!
         CASE (5)
      WRITE(SOUT,95)   SEC,RTYP
   95 FORMAT(1X,A7,9X,A13,13X,'Distribution   Incident    ',            &       
     &   'Energy range(eV)    Interp.  Points for     Cutoff'/          &       
     &   47X,'Law',8X,'Energies',24X,'Regions    Emitted      Energy'/, &       
     &   100X,'Function       (eV)'/                                    &       
     &   2X,'(MT)',41X,'(LF)',9X,'(NP)     from           to     ',     &       
     &   ' (NR)   (NE)  (NF)      (U)'/                                 &       
     &   1X,7('-'),8X,15('-'),16X,4('-'),9X,4('-'),5X,4('-'),10X,4('-'),&       
     &   5X,4('-'),3X,4('-'),2X,4('-'),4X,8('-'))
!
!*****FILE 6
!
         CASE (6)
      WRITE(SOUT,105) SEC,RTYP
  105 FORMAT(1X,A7,9X,A13,10X,'Outgoing  Energy-Angle   Energy      ',  &       
     &  'Energy range(eV)    Interp.',4X,'Emitted '/                    &       
     &  40X,'Particle     Model       Points',26X,'Regions',3X,         &       
     &  'Function'/                                                     &       
     &  53X,'(LAW)        (NP)      from           to     (NR)    ',    &       
     &  '(LANG)  (NE)'/                                                 &       
     &  1X,7('-'),8X,15('-'),9X,8('-'),2X,12('-'),4X,4('-'),6X,4('-'),  &       
     &  10X,4('-'),4X,4('-'),4X,6('-'),2X,4('-'))
!
!*****FILE 8
!
         CASE (8)
      WRITE(SOUT,125) SEC,RTYP
  125 FORMAT(1X,A7,9X,A13,18X,'Product',9X,'Final     Excitation',10X,  &       
     &   'Data',11X,'Decay'/48X,'Nuclide         State       ',         &       
     &   'Energy       Representation      Modes'/                      &       
     &   64X,'Flags'/2X,'(MT)',37X,'(ZAP)      (MATP)    (LFS)',        &       
     &   7X,'(ELFS)           (LMF)           (ND)'/                    &       
     &   1X,7('-'),8X,15('-'),12X,5('-'),6X,6('-'),4X,5('-'),7X,6('-'), &       
     &   11X,5('-'),11X,4('-'))
!
!*****FILES 9 AND 10
!
         CASE (9,10)
      WRITE(SOUT,135)   SEC,RTYP
  135 FORMAT(1X,A7,9X,A13,16X,'Final     Reaction  Energy     ',        &       
     &   'Energy range(eV)      Interp.'/                               &       
     &   43X,' State Flag  Q-value   Points',27X,'Regions'/             &       
     &   2X,'(MT)',40X,'(LFS)',16X,'(NP)     from           to',        &       
     &   7X,'(NR)'/                                                     &       
     &   1X,7('-'),8X,15('-'),15X,5('-'),5X,8('-'),3X,4('-'),           &       
     &   5X,4('-'),10X,4('-'),6X,4('-'))
!
!*****FILES 12 AND 13
!
         CASE (12,13)
      WRITE(SOUT,175)  SEC,RTYP
  175 FORMAT(1X,A7,9X,A13,13X,'Photon       Photon       Source    ',   &       
     &   'Energy     Energy range(eV)      Interp.'/                    &       
     &   43X,'Energy       Origin       Level     Points',27X,'Regions'/&       
     &   43X,'(MeV)                     (MeV)'/                         &       
     &   2X,'(MT)',38X,'(EG)         (LP)         (ES)      (NP)',      &       
     &   5X,'from           to       (NR)'/                             &       
     &   1X,7('-'),8X,15('-'),13X,4('-'),9X,4('-'),9X,4('-'),6X,4('-'), &       
     &   5X,4('-'),10X,4('-'),6X,4('-'))
!
!*****FILE 14
!
         CASE (14)
      WRITE(SOUT,185)  SEC,RTYP
  185 FORMAT(1X,A7,9X,A13,13X,'Photon     Source    Energy     ',       &       
     &   'Energy range(eV)      Interp.    Data     Angular'/           &       
     &   43X,'Energy      Level    Points',27X,'Regions    Form   ',    &       
     &   'Momentum-NL'/43X,'(MeV)',7X,'(MeV)',55X,'or Points-NP'/       &       
     &   2X,'(MT)',38X,'(EG)        (ES)     (NE)     from',11X,        &       
     &   'to',7X,'(NR)      (LTT)    MIN  MAX'/                         &       
     &   1X,7('-'),8X,15('-'),13X,4('-'),8X,4('-'),5X,4('-'),5X,4('-'), &       
     &   10X,4('-'),6X,4('-'),6X,5('-'),4X,3('-'),2X,3('-'))
!
!*****FILE 15
!
         CASE (15)
      WRITE(SOUT,195)   SEC,RTYP
  195 FORMAT(1X,A7,9X,A13,13X,'Distribution    Incident     ',          &       
     &   'Energy range(eV)      Interp.    Points for'/                 &       
     &   47X,'Law         Energies',27X,'Regions      Emitted'/         &       
     &   106X,'Function'/                                               &       
     &   2X,'(MT)',41X,'(LF)',10X,'(NP)      from           to',7X,     &       
     &   '(NR)      (NE)  (NF)'/                                        &       
     &   1X,7('-'),8X,15('-'),16X,4('-'),10X,4('-'),6X,4('-'),          &       
     &   10X,4('-'),6X,4('-'),6X,4('-'),2X,4('-'))
!
!*****FILES 23 AND 27
!
         CASE (23,27)
      WRITE(SOUT,255)  SEC,RTYP
  255 FORMAT(1X,A7,9X,A13,15X,'Energy     Energy range(eV)      ',      &       
     &    'Interp.'/45X,'Points',27X,'Regions'/                         &       
     &    2X,'(MT)',40X,'(NP)     from           to       (NR)'/        &       
     &   1X,7('-'),8X,15('-'),15X,4('-'),5X,4('-'),10X,4('-'),6X,4('-'))
!
!*****FILE 26
!
         CASE (26)
      WRITE(SOUT,265) SEC,RTYP
  265 FORMAT(1X,A7,9X,A13,10X,'Outgoing  Energy-Angle   Energy      ',  &       
     &  'Energy range(eV)    Interp.',4X,'Emitted '/                    &       
     &  40X,'Particle     Model       Points',26X,'Regions',3X,         &       
     &  'Function'/                                                     &       
     &  53X,'(LAW)        (NP)      from           to     (NR)    ',    &       
     &  '(LANG)  (NE)'/                                                 &       
     &  1X,7('-'),8X,15('-'),9X,8('-'),2X,12('-'),4X,4('-'),6X,4('-'),  &       
     &  10X,4('-'),4X,4('-'),4X,6('-'),2X,4('-'))
!
!*****FILE 28
!
         CASE (28)
      WRITE(SOUT,275) SEC,RTYP
  275 FORMAT(1X,A7,9X,A13,15X,'Number of        Subshell range      ',  &       
     &   '      Number of transitions'/45X,'Subshells'/                 &       
     &   2X,'(MT)',41X,'(NSS)',9X,'from         to         ',           &       
     &   'Radiative       Non-radiative'/                               &       
     &   1X,7('-'),8X,15('-'),16X,5('-'),9X,4('-'),8X,4('-'),6X,        &       
     &   13('-'),5X,13('-'))
!
!*****FILES 31 AND 33
!
         CASE (31,33)
      WRITE(SOUT,315)  SEC,RTYP
  315 FORMAT(1X,A7,9X,A13,9X,'Covariance with',6X,'Energy range(eV)',   &       
     &  8X,'Sub-       LTY    Energy     Standard'/                     &       
     &  81X,'Subsection    or     Points'/                              &       
     &  2X,'(MT)',35X,'MAT1    MT1',7X,'from           to',8X,'Type',   &       
     &  7X,'LB',15X,'MATS   MTS'/                                       &       
     &  1X,7('-'),8X,15('-'),10X,4('-'),4X,3('-'),7X,4('-'),10X,4('-'), &       
     &  7X,4('-'),7X,3('-'),5X,4('-'),5X,4('-'),3X,3('-'))
!
!*****FILE 32
!
         CASE (32)
      IF(NFOR.LT.6) THEN
         WRITE(SOUT,35)   SEC,RTYP
      ELSE
         WRITE(SOUT,325)   SEC,RTYP
  325    FORMAT(1X,A7,9X,A13,11X,'Isotope',8X,'Energy range(eV)',5X,    &       
     &     'LRF',5X,'Region',8X,'L',8X,'NSRS  NLRS'/                    &       
     &     42X,'Z   A',8X,'from           to',14X,'type',6X,'values'/   &       
     &     1X,7('-'),8X,15('-'),10X,'--  ---',7X,4('-'),10X,4('-'),     &       
     &     4X,3('-'),3X,10('-'),5X,'--',8X,'----  ----')
      END IF
!
!*****FILE 34
!
         CASE (34)
      WRITE(SOUT,355)  SEC,RTYP
  355 FORMAT(1X,A7,9X,A13,12X,'Covariance with',4X,'L    L1',           &       
     &  6X,'Sub-Sub-     LB     Energy'/                                &       
     &  73X,'Subsection           Points'/                              &       
     &  2X,'(MT)',38X,'MAT1    MT1',21X,'Type'/                         &       
     &  1X,7('-'),8X,15('-'),13X,4('-'),4X,3('-'),6X,'--   --',         &       
     &  8X,4('-'),7X,2('-'),6X,4('-'))
!
!*****FILE 35
!
         CASE (35)
      WRITE(SOUT,365)  SEC,RTYP
  365 FORMAT(1X,A7,9X,A13,16X,'Energy range(eV)',8X,'Energy'/           &       
     &  70X,'Points'/2X,'(MT)',39X,'from           to'/                 &       
     &  1X,7('-'),8X,15('-'),14X,4('-'),10X,4('-'),6X,4('-'))
!
!*****FILE 40
!
         CASE (40)
      WRITE(SOUT,405)  SEC,RTYP
  405 FORMAT(1X,A7,9X,A13,14X,'Covariance with',10X,'Energy range(eV)', &       
     &  6X,'Sub-Sub-     LTY    Energy     Standard'/                   &       
     &  90X,'Subsection    or     Points'/                              &       
     &  2X,'(MT)',30X,'LFS',4X,'MAT1 MF1 MT1 LFS1',8X,                  &       
     &  'from           to',8X,'Type',7X,'LB',15X,'MATS   MTS'/         &       
     &  1X,7('-'),8X,15('-'),5X,3('-'),4X,4('-'),2(1X,3('-')),1X,4('-'),&       
     &  8X,4('-'),10X,4('-'),7X,4('-'),7X,3('-'),5X,4('-'),5X,4('-'),   &       
     &  3X,3('-'))
!
      END SELECT
!
 1000 RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE INTAB(NBT,INT,NR,NTYPE,OUTPUT)
!
!     LIST AN INTERPOLATION LAW, INTERPRETING THE RANGE AND TYPE OF LAW.
!
!     NBT   =TABLE OF INTERPOLATION LAW BOUNDARIES
!     INT   =TABLE OF INTERPOLATION LAW CODES DEFINED AS FOLLOWS..
!           =1  CONSTANT FROM THE LOWER LIMIT
!            2  Y LINEAR IN X
!            3  Y LINEAR IN LN X
!            4  LN Y LINEAR IN X
!            5  LN Y LINEAR IN LN X
!            6  COULOMB THRESHOLD
!     NR    =NUMBER OF RANGES OR POINTS IN NBT AND INT TABLES
!     NTYPE =INTERPOLATION DESCRIPTION INDICATOR DEFINED AS FOLLOWS...
!            1  INTERPOLATION LAW BETWEEN ENERGIES
!            2  INTERPOLATION LAW BETWEEN COSINES
!            3  INTERPOLATION LAW BETWEEN TEMPERATURES
!            4  INTERPOLATION LAW BETWEEN BETAS (THERMAL SCATTERING LAW)
!            5  INTERPOLATION LAW BETWEEN ALPHAS(THERMAL SCATTERING LAW)
!            6  INTERPLOATION LAW BETWEEN VALUES OF X
!     OUTPUT=INTEGER LOGICAL NUMBER OF OUTPUT FILE
!
      INTEGER NBT(NR),INT(NR),OUTPUT
!
      INTEGER NBTF(201)
      CHARACTER(LEN=12) ARRAY(6)
      CHARACTER(LEN=21) HEAD
      CHARACTER(LEN=19) BCD(7)
!
!     DEFINE INTERPRETATIONS
!
      DATA ARRAY/'Energies    ','Cosines     ',                         &       
     &           'Temperatures','Betas       ',                         &       
     &           'Alphas      ','Values of X '/
!
!     DEFINE TABLE HEADINGS
!
      DATA HEAD/'Range     Description'/
!
!     DEFINE ALPHANUMERIC EQUIVALENT OF INTERPOLATION CODES
!
      DATA BCD           /'CONSTANT           ',                        &       
     &                    'Y LINEAR IN X      ',                        &       
     &                    'Y LINEAR IN LN X   ',                        &       
     &                    'LN Y LINEAR IN X   ',                        &       
     &                    'LN Y LINEAR IN LN X',                        &       
     &                    'COULOMB THRESHOLD  ',                        &       
     &                    '******(ERROR)******'/
!
!     SKIP IF FULL FILE NOT REQUESTED
!
      IF(OUTPUT.EQ.0)  GO TO 200
!
!     WRITE TABLE HEADING
!
      WRITE(OUTPUT,10) ARRAY(NTYPE)
   10 FORMAT(/' Interpolation Law between ',A12)
      NNR = MIN0(NR,3)
      WRITE(OUTPUT,20)    (HEAD,I=1,NNR)
   20 FORMAT(3(5X,A21,13X))
!
!     IF IN ERROR, SET INTERPOLATION CODE TO 7
!
      NBTF(1) = 1
      DO 50 I=1,NR
      NBTF(I+1) = NBT(I)
      INT(I) = MOD(INT(I),10)
      IF(INT(I).GT.6.OR.INT(I).LT.1)  INT(I) = 7
   50 CONTINUE
      DO 100 I=1,NR,3
      IU = MIN0(I+2,NR)
      WRITE(OUTPUT,75) (NBTF(J),NBTF(J+1),BCD(INT(J)),J=I,IU)
   75 FORMAT(3(I5,' TO',I5,2X,A19,5X))
  100 CONTINUE
!
  200 RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE GETLIM(XMIN,XMAX,X,Y,NP)
!
!     ROUTINE TO GET X LIMITS FROM A TAB1 RECORD
!
      COMMON/XYCONT/NSCR,MAXY,NCONT,NA,NB,NN
!
      REAL X(NP),Y(NP)
!
!     INITIALIZE MINIMUM X VALUE
!
      XMIN = X(1)
!
!     SET MAXIMUM X VALUE WHEN NO PAGING
!
      IF(NCONT.GT.0)   GO TO 20
      XMAX = X(NP)
      GO TO 100
!
!     READ ALL PAGES
!
   20 IF(NB.EQ.NN) GO TO 50
      CALL RDTAB(X,Y)
      GO TO 20
!
!     SET MAXIMUM X VALUE WHEN LAST PAGE HAS BEEN READ
!
   50 NU = NB - NA + 1
      XMAX = X(NU)
!
!     RESTORE INITIAL PAGE IN CORE
!
      CALL RDTAB(X,Y)
!
  100 RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE WRTAB1(OUTPUT,HEAD,UNIT,X,Y,NP)
!
!     ROUTINE TO LIST A TAB1 RECORD
!
      COMMON/XYCONT/NSCR,MAXY,NCONT,NA,NB,NN
!
      CHARACTER(LEN=24) HEAD,UNIT
      INTEGER OUTPUT
      REAL X(NP),Y(NP)
!
!     SKIP IF FULL FILE NOT REQUESTED
!
      IF(OUTPUT.EQ.0)  GO TO 300
!
!     OUTPUT HEADING
!
      NRR = MIN0(NP,5)
      WRITE(OUTPUT,10) (HEAD,JJ=1,NRR)
   10 FORMAT(' Index ',5A24)
      IF(UNIT.NE.' ')  WRITE(OUTPUT,20) (UNIT,JJ=1,NRR)
   20 FORMAT(7X,5A24)
!
!     OUTPUT DATA
!
      IF(NCONT.GT.0)   GO TO 100
      NA = 1
      NB = NP
      NN = NP
  100 NU = NB - NA + 1
      DO 200 I=1,NU,5
      II = MIN0(I+4,NU)
      NI = NA + I - 1
      WRITE(OUTPUT,150) NI,(X(JJ),Y(JJ),JJ=I,II)
  150 FORMAT(I5,2X,5(2(1PE11.4),2X))
  200 CONTINUE
!
!     READ ANOTHER PAGE IF THERE ARE MORE
!
      IF(NB.EQ.NN)   GO TO 300
      CALL RDTAB(X,Y)
      GO TO 100
!
  300 RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE LIBID(NLIB,NVER,LIBBCD)
!
!     ROUTINE TO GENERATE LIBRARY ID FROM NLIB AND NVER
!
      CHARACTER(LEN=14) LIBBCD
      CHARACTER(LEN=1) TCHAR
      CHARACTER(LEN=14) LIBTMP
!
      PARAMETER (NLIBS=13)
      CHARACTER(LEN=8) TLIBS(NLIBS)
      INTEGER LIBS(NLIBS)
      CHARACTER(LEN=5) NUMS(20)
!
      DATA TLIBS/'ENDF/B  ','ENDF/A  ','JEF     ','EFF     ',           &       
     &           'ENDF/HE ','CENDL   ','JENDL   ','INDL/V  ',           &       
     &           'INDL/A  ','INDL/F  ','IRDF    ','BROND   ',           &       
     &           'UNKNOWN '/
      DATA LIBS/0,1,2,3,4,5,6,31,32,33,34,41,99/
!
      DATA NUMS   /'I','II','III','IV','V','VI','VII','VIII',           &       
     &             'IX','X','XI','XII','XIII','XIV','XV','XVI','XVII',  &       
     &             'XVIII','XIX','?????'/
!
!     FIND LIBRARY ID
!
      DO 10 I=1,NLIBS-1
      IF(NLIB.EQ.LIBS(I))    GO TO 15
   10 CONTINUE
      I = NLIBS
!
!     BUILD LIBRARY ID
!
   15 IF(NLIB.GT.0.AND.NLIB.NE.4)  GO TO 30
      INVER = NVER
      IF(NVER.LT.1.OR.NVER.GT.19) INVER = 20
      WRITE(LIBBCD,20)   TLIBS(1)(1:6),NUMS(INVER)
   20 FORMAT(A6,'-',A5)
      GO TO 100
   30 WRITE(LIBTMP,40) TLIBS(I),NVER
   40 FORMAT(A8,'-',I5)
!
!     PACK ID LEFT JUSTIFIED
!
      LIBBCD = ' '
      NCF = 0
      DO 50 N=1,14
      TCHAR = LIBTMP(N:N)
      IF(TCHAR.EQ.' ')   GO TO 50
      NCF = NCF + 1
      LIBBCD(NCF:NCF) = TCHAR
   50 CONTINUE
!
  100 RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE HEADIN(MAT,MF,MT,ZA)
!
!     ROUTINE TO CREATE AND STORE EXPANDED TEXT FOR ZA, MF AND MT
!
      COMMON/TOPPER/LIBBCD,MFBCD,MTBCD,ZABCD
      CHARACTER(LEN=14) LIBBCD
      CHARACTER(LEN=48) MFBCD
      CHARACTER(LEN=30) MTBCD
      CHARACTER(LEN=24) ZABCD
      COMMON/TOPI/NLIB,NVER,NREL,NSUB,MATIN,AWI,NMOD,NFOR
!
!     SAVE MAT NUMBER IF GREATER THAN ZERO
!
      IF(MAT.GT.0)   MATIN = MAT
!
!     IF MF IS POSITIVE CHANGE FILE IDENTIFICATION
!
      IF(MF.GT.0) CALL MFID(NSUB,MF,MT,MFBCD,IERR)
!
!     IF MT IS POSITIVE CHANGE REACTION IDENTIFICATION
!
      IF(MT.GT.0) CALL MTID(NFOR,NSUB,MT,MTBCD,IERR)
!
!     IF IZ IS POSITIVE CHANGE ISOTOPE IDENTIFICATION
!
      IF(ZA.GT.0.0)  CALL ZAID(ZA,ZABCD,IERR)
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE ZAID(ZA,BCD,IERR)
!
!     CONSTRUCTION OF THE ALPHANUMERIC REPRESENTATION OF AN ISOTOPE
!     HAVING A GIVEN ATOMIC NUMBER AND WEIGHT. IF THE ATOMIC NUMBER IS
!     LESS THAN OR EQUAL TO ZERO THE ISOTOPE IS ASSUMED TO BE A NATURAL
!     ELEMENT
!
!     SUBROUTINE ARGUMENTS ARE DEFINED AS FOLLOWS.....
!     ZA    = 1000.*Z + A
!     BCD   =RESULTING ALPHANUMERIC EQUIVALENT.
!     IERR  =ERROR INDICATOR. SET EQUAL TO ONE IF IZ IS NOT IN THE RANGE
!            1 TO 104, OR IA IS NOT IN THE RANGE 1 TO 999. IT IS
!            SET EQUAL TO ZERO IF BOTH ARE IN ACCEPTABLE RANGE.
!
!     THE NAME OF THE ELEMENT FOLLOWED BY ITS ATOMIC NUMBER IS LEFT
!     ADJUSTED INTO ID. FOR NATURAL MATERIALS THE WORD 'NATURAL'
!     FOLLOWED BY THE ELEMENT NAME IS USED INSTEAD.
!
      COMMON/TOPI/NLIB,NVER,NREL,NSUB,MATIN,AWI,NMOD,NFOR
!
      CHARACTER(LEN=*) BCD
      CHARACTER(LEN=24) BCDX
      CHARACTER(LEN=1) CCHAR
      PARAMETER (ISPEC5=20)
      CHARACTER(LEN=20) SPMAT5(ISPEC5)
      INTEGER SANUM5(ISPEC5)
      PARAMETER (ISPEC6=18)
      CHARACTER(LEN=20) SPMAT6(ISPEC6)
      INTEGER SANUM6(ISPEC6)
      CHARACTER(LEN=3) NUMBER(7)
      CHARACTER(LEN=5) LETTER(3)
      CHARACTER(LEN=12) SPEED(2)
      PARAMETER (IELM=109)
      CHARACTER(LEN=13) ELEMNT(IELM)
!
      CHARACTER(LEN=24) GOOF
      DATA GOOF/'********(ERROR)*********'/
!
!     DEFINE SPECIAL MATERIAL LIBRARY FOR ENDF-5 FORMAT
!
      DATA SPMAT5/ 'Pure 1/V absorber   ',                              &       
     &      'Pure scatterer      ','Water               ',              &       
     &      'Heavy Water         ','Biphenyl            ',              &       
     &      'Sodium Hydroxide    ','Santowax R          ',              &       
     &      'Dowtherm A          ','Benzene             ',              &       
     &      'Beryllea            ','Beryllium Carbide   ',              &       
     &      'Beryllium Fluoride  ','Zirconium Hydride   ',              &       
     &      'Polystyrene         ','Polyethylene        ',              &       
     &      'Zircalloy 1         ','Zircalloy 2         ',              &       
     &      '304 Stainless Steel ','Uranium Dioxide     ',              &       
     &      'Uranium Carbide     '/
      DATA SANUM5/1,2,100,101,102,103,104,105,106,200,                  &       
     &            201,202,203,204,205,301,302,304,310,315/
!
!     DEFINE SPECIAL MATERIAL LIBRARY FOR ENDF-6 FORMAT
!
      DATA SPMAT6/  'Water               ',                             &       
     &       'Para Hydrogen       ','Ortho Hydrogen      ',             &       
     &       'Hydrogen in ZrH     ','Heavy Water         ',             &       
     &       'Para Deuterium      ','Ortho Deuterium     ',             &       
     &       'Beryllea            ','Beryllium Oxide     ',             &       
     &       'Beryllium Carbide   ','Graphite            ',             &       
     &       'Methane             ','S-methane           ',             &       
     &       'Polyethylene        ','Benzene             ',             &       
     &       'Zirconium in ZrH    ','Uranium Dioxide     ',             &       
     &       'Uranium Carbide     '/
      DATA SANUM6/1,2,3,7,11,12,13,26,27,28,                            &       
     &            31,33,34,37,40,58,75,76/
!
!     DEFINE FISSION PRODUCT PARAMETERS
!
      DATA NUMBER/'23 ','25 ','49 ','41 ','02 ','28 ','40 '/
      DATA LETTER/'RSFP ','SSFP ','NSFP '/
      DATA SPEED/'SLOW REACTOR','FAST REACTOR'/
!
!     DEFINE ELEMENT NAMES
!
      DATA (ELEMNT(IJK),IJK=1,10)/   'Hydrogen    ',                    &       
     &                               'Helium      ',                    &       
     &                               'Lithium     ',                    &       
     &                               'Beryllium   ',                    &       
     &                               'Boron       ',                    &       
     &                               'Carbon      ',                    &       
     &                               'Nitrogen    ',                    &       
     &                               'Oxygen      ',                    &       
     &                               'Fluorine    ',                    &       
     &                               'Neon        '/
      DATA (ELEMNT(IJK),IJK=11,20)/  'Sodium      ',                    &       
     &                               'Magnesium   ',                    &       
     &                               'Aluminum    ',                    &       
     &                               'Silicon     ',                    &       
     &                               'Phosphorus  ',                    &       
     &                               'Sulfur      ',                    &       
     &                               'Chlorine    ',                    &       
     &                               'Argon       ',                    &       
     &                               'Potassium   ',                    &       
     &                               'Calcium     '/
      DATA (ELEMNT(IJK),IJK=21,30)/  'Scandium    ',                    &       
     &                               'Titanium    ',                    &       
     &                               'Vanadium    ',                    &       
     &                               'Chromium    ',                    &       
     &                               'Manganese   ',                    &       
     &                               'Iron        ',                    &       
     &                               'Cobalt      ',                    &       
     &                               'Nickel      ',                    &       
     &                               'Copper      ',                    &       
     &                               'Zinc        '/
      DATA (ELEMNT(IJK),IJK=31,40)/  'Gallium     ',                    &       
     &                               'Germanium   ',                    &       
     &                               'Arsenic     ',                    &       
     &                               'Selenium    ',                    &       
     &                               'Bromine     ',                    &       
     &                               'Krypton     ',                    &       
     &                               'Rubidium    ',                    &       
     &                               'Strontium   ',                    &       
     &                               'Yttrium     ',                    &       
     &                               'Zirconium   '/
      DATA (ELEMNT(IJK),IJK=41,50)/  'Niobium     ',                    &       
     &                               'Molybdenum  ',                    &       
     &                               'Technetium  ',                    &       
     &                               'Ruthenium   ',                    &       
     &                               'Rhodium     ',                    &       
     &                               'Palladium   ',                    &       
     &                               'Silver      ',                    &       
     &                               'Cadmium     ',                    &       
     &                               'Indium      ',                    &       
     &                               'Tin         '/
      DATA (ELEMNT(IJK),IJK=51,60)/  'Antimony    ',                    &       
     &                               'Tellurium   ',                    &       
     &                               'Iodine      ',                    &       
     &                               'Xenon       ',                    &       
     &                               'Cesium      ',                    &       
     &                               'Barium      ',                    &       
     &                               'Lanthanum   ',                    &       
     &                               'Cerium      ',                    &       
     &                               'Praseodymium',                    &       
     &                               'Neodymium   '/
      DATA (ELEMNT(IJK),IJK=61,70)/  'Promethium  ',                    &       
     &                               'Samarium    ',                    &       
     &                               'Europium    ',                    &       
     &                               'Gadolinium  ',                    &       
     &                               'Terbium     ',                    &       
     &                               'Dysprosium  ',                    &       
     &                               'Holmium     ',                    &       
     &                               'Erbium      ',                    &       
     &                               'Thulium     ',                    &       
     &                               'Ytterbium   '/
      DATA (ELEMNT(IJK),IJK=71,80)/  'Lutetium    ',                    &       
     &                               'Hafnium     ',                    &       
     &                               'Tantalum    ',                    &       
     &                               'Tungsten    ',                    &       
     &                               'Rhenium     ',                    &       
     &                               'Osmium      ',                    &       
     &                               'Iridium     ',                    &       
     &                               'Platinum    ',                    &       
     &                               'Gold        ',                    &       
     &                               'Mercury     '/
      DATA (ELEMNT(IJK),IJK=81,90)/  'Thallium    ',                    &       
     &                               'Lead        ',                    &       
     &                               'Bismuth     ',                    &       
     &                               'Polonium    ',                    &       
     &                               'Astatine    ',                    &       
     &                               'Radon       ',                    &       
     &                               'Francium    ',                    &       
     &                               'Radium      ',                    &       
     &                               'Actinium    ',                    &       
     &                               'Thorium     '/
      DATA (ELEMNT(IJK),IJK=91,100)/ 'Protactinium',                    &       
     &                               'Uranium     ',                    &       
     &                               'Neptunium   ',                    &       
     &                               'Plutonium   ',                    &       
     &                               'Americium   ',                    &       
     &                               'Curium      ',                    &       
     &                               'Berkelium   ',                    &       
     &                               'Californium ',                    &       
     &                               'Einsteinium ',                    &       
     &                               'Fermium     '/
      DATA (ELEMNT(IJK),IJK=101,IELM)/'Mendelevium ',                   &       
     &                                'Nobelium    ',                   &       
     &                                'Lawrencium  ',                   &       
     &                                'Rutherfordium',                  &       
     &                                'Dubnium',                        &       
     &                                'Seborgium',                      &       
     &                                'Bohrium',                        &       
     &                                'Hassium',                        &       
     &                                'Meitnerium'/
!
!     INITIALIZE
!
      IERR=0
      BCD = ' '
!
!     DETERMINE IZ AND IA
!
      IZ = ZA/1000.
      IA = ZA - 1000.*FLOAT(IZ)
!
!     DETERMINE IF IZ AND IA ARE IN THE ALLOWABLE RANGE.
!
      IF(IZ.LT.0.OR.IZ.GT.IELM.OR.IA.GE.1000) GO TO 90
!
!     ZERO Z CORRESPONDS TO SPECIAL MATERIALS.
!
      IF(IZ.EQ.0) GO TO 50
!
!     ZERO A CORRESPONDS TO NATURAL ELEMENTS
!
      IF(IA.GT.0) GO TO 20
!
!     CONSTRUCT IDENTIFICATION FOR NATURAL MATERIAL
!
      BCD = 'Natural '//ELEMNT(IZ)
      GO TO 100
!
!     BUILD ISOTOPE NAME
!
   20 WRITE(BCDX,25)   IZ,ELEMNT(IZ),IA
   25 FORMAT(I3,'-',A12,'-',I3)
!
!     ELIMINATE IMBEDDED BLANKS
!
      NC = 0
      DO 30 I=1,24
      CCHAR = BCDX(I:I)
      IF(CCHAR.EQ.' ')   GO TO 30
      NC = NC + 1
      BCD(NC:NC) = CCHAR
   30 CONTINUE
      GO TO 100
!
!     CHECK AGAINST LIST OF SPECIAL ATOMIC WEIGHTS
!
   50 IF(NFOR.GT.5)  GO TO 75
      IF(IA.GE.400.AND.IA.LE.499)   GO TO 70
      DO I=1,ISPEC5
         IF(IA.LT.SANUM5(I))   THEN
            BCD = GOOF
            IERR=1
            GO TO 100
         ELSE IF(IA.EQ.SANUM5(I))   THEN
            BCD = SPMAT5(I)
            GO TO 100
         END IF
      END DO
      GO TO 90
!
!     LUMPED FISSION PRODUCTS
!
!*****COMPUTE MAJOR FISSION PRODUCT GROUP INDEX.
   70 I1=MOD(IA,10)+1
      IF(I1.GT.7) GO TO 90
!*****COMPUTE MINOR FISSION PRODUCT GROUP INDEX.
      I2=MOD(IA,100)/10
      IF(I2.GT.5) GO TO 90
!*****DETERMINE CLASS OF REACTOR
      I3=I2/3+1
      I2=MOD(I2,3)+1
!*****LOAD FISSION PRODUCT NUMBER, GROUP AND REACTOR CLASS
      BCD = NUMBER(I1)//LETTER(I2)//SPEED(I3)
      GO TO 100
!
!     ENDF-6
!
   75 IAM1 = IA - 100
      IF(IAM1.LT.1.OR.IAM1.GT.99)   GO TO 90
      DO I=1,ISPEC6
         IF(IAM1.LT.SANUM6(I))   THEN
            BCD = GOOF
            IERR=1
            GO TO 100
         ELSE IF(IAM1.EQ.SANUM6(I)) THEN
            BCD = SPMAT6(I)
            GO TO 100
         END IF
      END DO
      GO TO 90
!
!     IZ AND/OR IA NOT VALID
!
   90 BCD = GOOF
      IERR=1
!
  100 RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE MFID(NSUB,MF,MT,BCD,IERR)
!
!     DETERMINE THE ALPHANUMERIC EQUIVALENT FOR EACH FILE NUMBER.
!     THE SUBROUTINE ARGUMENTS ARE DEFINED AS FOLLOWS....
!     MF   =FILE NUMBER
!     BCD   =ALPHANUMERIC IDENTIFICATION FOR FILE MF. RETURNED AS
!            CHARACTER*48
!     IERR  =ERROR INDICATOR. IS SET TO ZERO IF MF IS AN ALLOWED.
!            SET EQUAL TO ONE IF MF IS NOT ALLOWED.
!
      CHARACTER(LEN=48) BCD
      CHARACTER(LEN=48) GOOF
      PARAMETER (NMFS=24)
      CHARACTER(LEN=48) MMF(NMFS)
      INTEGER IMFS(NMFS)
!
      DATA GOOF/'********************(ERROR)*********************'/
!
!     DEFINE FILE IDENTIFICATION FOR NEUTRON INTERACTION DATA FILES
!
      DATA (MMF(IJK),IJK=1,7)/                                          &       
     &     '               Fission Parameters              ',           &       
     &     '              Resonance Parameters              ',          &       
     &     '             Reaction Cross Section             ',          &       
     &     '     Emitted Neutron Angular Distributions      ',          &       
     &     '      Emitted Neutron Energy Distributions      ',          &       
     &     '  Emitted Particle Energy-Angle Distributions   ',          &       
     &     '        Thermal Neutron Scattering Laws         '/
      DATA (IMFS(IJK),IJK=1,7)/1,2,3,4,5,6,7/
!
!     DEFINE FILE IDENTIFICATION FOR RADIOACTIVE DECAY FILES
!
      DATA (MMF(IJK),IJK=8,10)/                                         &       
     &     '    Radioactive Reaction Product Information    ',          &       
     &     ' Radioactive Nuclide Production Multiplicities  ',          &       
     &     ' Radioactive Nuclide Production Cross Sections  '/
      DATA (IMFS(IJK),IJK=8,10)/8,9,10/
!
!     DEFINE FILE IDENTIFICATION FOR PHOTON PRODUCTION FILES
!
      DATA (MMF(IJK),IJK=11,14)/                                        &       
     &     '    Photon Multiplicities (Neutron Induced)     ',          &       
     &     '    Photon Cross Sections (Neutron Induced)     ',          &       
     &     ' Photon Angular Distributions (Neutron Induced) ',          &       
     &     ' Photon Energy Distributions (Neutron Induced)  '/
      DATA (IMFS(IJK),IJK=11,14)/12,13,14,15/
!
!     DEFINE FILE IDENTIFICATION FOR PHOTON INTERACTION FILES
!
      DATA (MMF(IJK),IJK=15,18)/                                        &       
     &     '        Photon Interaction Cross Section        ',          &       
     &     '  Emitted Particle Energy-Angle Distributions   ',          &       
     &     'Incoherent and Coherent Photon Form Factor Data ',          &       
     &     '             Atomic Relaxation Data             '/
      DATA (IMFS(IJK),IJK=15,18)/23,26,27,28/
!
!     DEFINE FILE IDENTIFICATION FOR COVARIANCE FILES
!
      DATA (MMF(IJK),IJK=19,NMFS)/                                      &       
     &     '             Nu Bar Covariance Data             ',          &       
     &     '      Resonance Parameter Covariance Data       ',          &       
     &     '     Reaction Cross Section Covariance Data     ',          &       
     &     '    Emitted Neutron Angular Covariance Data     ',          &       
     &     '     Emitted Neutron Energy Covariance Data     ',          &       
     &     ' Radioactive Nuclide Production Covariance Data '/
      DATA (IMFS(IJK),IJK=19,NMFS)/31,32,33,34,35,40/
!
!     SEARCH FOR MATCHING FILE NUMBER (MF)
!
      DO I=1,NMFS
         IF(MF.LT.IMFS(I)) THEN
            BCD = GOOF
            IERR=1
            GO TO 1000
         ELSE IF(MF.EQ.IMFS(I)) THEN
            GO TO 100
         END IF
      END DO
      BCD = GOOF
      IERR=1
      GO TO 1000
!
!     FILE NUMBER IS NOT RECOGNIZED. SET IDENTIFICATION TO ERROR AND
!     ERROR INDICATOR TO ONE.
!
!
!     FILE NUMBER IS RECOGNIZED.  SET IDENTIFICATION TO CORRESPONDING
!     TEXT AND SET ERROR INDICATOR TO ZERO
!
  100 IF(MF.EQ.8)  THEN
         IF(MT.EQ.457)   THEN
            BCD = '             Radioactive Decay Data'
         ELSE IF(MT.EQ.454.OR.MT.EQ.459)  THEN
            BCD = '             Fission Product Yields'
         ELSE
            BCD = MMF(I)
         END IF
      ELSE IF(MF.EQ.23) THEN
         IF(NSUB.EQ.113) THEN
            BCD = '       Electron'//MMF(I)(15:)
         ELSE
            BCD = MMF(I)
         END IF
      ELSE
         BCD = MMF(I)
      END IF
  250 IERR=0
!
 1000 RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE MTID(NFOR,NSUB,MTIN,BCD,IERR)
!
!     DETERMINE THE ALPHANUMERIC EQUIVALENT OF A REACTION TYPE NUMBER.
!     THE SUBROUTINE ARGUMENTS ARE DEFINED AS FOLLOWS....
!     NSUB   =SUBLIBRARY NUMBER (CONTAINS INCIDENT PARTICLE ID)
!     MT    =REACTION NUMBER
!     BCD   =ALPHANUMERIC EQUIVALENT OF A REACTION TYPE. RETURNED AS 5A4
!     IERR  =ERROR INDICATOR. IF MT IS NOT IN THE LIBRARY IERR IS SET
!     EQUAL TO ONE. IF MT O.K. IERR IS SET EQUAL TO ZERO
!
      CHARACTER(LEN=30) GOOF
      PARAMETER (NCRS=30)
      CHARACTER(LEN=*) BCD
      CHARACTER(LEN=1) CCHAR
      CHARACTER(LEN=30) BCDT
      CHARACTER(LEN=20) ILEV,JLEV
      PARAMETER (NPARTS=8)
      CHARACTER(LEN=6) PCODES(NPARTS+1)
      INTEGER ICLEN(NPARTS)
      INTEGER INMT(NPARTS)
      INTEGER IPZA(NPARTS)
      PARAMETER (NSHELS=39)
      CHARACTER(LEN=4) SHELL(NSHELS)
      CHARACTER(LEN=3) SUFO(4)
      PARAMETER (NMTS=93)
      CHARACTER(LEN=30) MMT(NMTS)
      INTEGER IMTS(NMTS)
!
      DATA GOOF/'***********(ERROR)************'/
!
!     DEFINE INCIDENT PARTICLE CODES
!
      DATA PCODES/'g','n','e','p','d','t','He-3','a',' '/
      DATA ICLEN/6*1,4,1/
      DATA INMT/102,4,0,103,104,105,106,107/
      DATA IPZA/0,1,11,1001,1002,1003,2003,2004/
!
!     DEFINE SUBSHELLS
!
      DATA SHELL/'K  ','L1 ','L2 ','L3 ','M1 ','M2 ','M3 ','M4 ','M5 ', &       
     &           'N1 ','N2 ','N3 ','N4 ','N5 ','N6 ','N7 ','O1 ','O2 ', &       
     &           'O3 ','O4 ','O5 ','O6 ','O7 ','O8 ','O9 ','P1 ','P2 ', &       
     &           'P3 ','P4 ','P5 ','P6 ','P7 ','P8 ','P9 ','P10','P11', &       
     &           'Q1 ','Q2 ','Q3 '/
!
!     DEFINE NUMERICAL SUFFIXES
!
      DATA SUFO/'-st','-nd','-rd','-th'/
!
!     DEFINE MT NUMBER CODES
!
      DATA (MMT(IJK),IJK=1,15)/                                         &       
     &           ',Total)',                                             &       
     &           ',Elastic)',                                           &       
     &           ',Non-Elastic)',                                       &       
     &           ',n)',                                                 &       
     &           ',complex)',                                           &       
     &           ',continuum emission)',                                &       
     &           ',2nd)',                                               &       
     &           ',2n)',                                                &       
     &           ',3n)',                                                &       
     &           ',fission)',                                           &       
     &           ',f)',                                                 &       
     &           ',nf)',                                                &       
     &           ',2nf)',                                               &       
     &           ',na)',                                                &       
     &           ',n3a)'/
      DATA (IMTS(IJK),IJK=1,15)/1,2,3,4,5,10,11,16,17,18,19,20,21,22,23/
      DATA (MMT(IJK),IJK=16,32)/                                        &       
     &           ',2na)',                                               &       
     &           ',3na)',                                               &       
     &           ',absorption)',                                        &       
     &           ',np)',                                                &       
     &           ',n2a)',                                               &       
     &           ',2n2a)',                                              &       
     &           ',nd)',                                                &       
     &           ',nt)',                                                &       
     &           ',nHe-3)',                                             &       
     &           ',nd2a)',                                              &       
     &           ',nt2a)',                                              &       
     &           ',4n)',                                                &       
     &           ',3nf)',                                               &       
     &           ',2np)',                                               &       
     &           ',3np)',                                               &       
     &           ',n2p)',                                               &       
     &           ',npa)'/
      DATA (IMTS(IJK),IJK=16,32)/24,25,27,28,29,30,32,33,34,35,         &       
     &   36,37,38,41,42,44,45/
      DATA (MMT(IJK),IJK=33,48)/                                        &       
     &           ',disappearance)',                                     &       
     &           ',g)',                                                 &       
     &           ',p)',                                                 &       
     &           ',d)',                                                 &       
     &           ',t)',                                                 &       
     &           ',He-3)',                                              &       
     &           ',a)',                                                 &       
     &           ',2a)',                                                &       
     &           ',3a)',                                                &       
     &           ',2p)',                                                &       
     &           ',pa)',                                                &       
     &           ',t2a)',                                               &       
     &           ',d2a)',                                               &       
     &           ',pd)',                                                &       
     &           ',pt)',                                                &       
     &           ',da)'/
      DATA (IMTS(IJK),IJK=33,48)/101,102,103,104,105,106,107,108,109,   &       
     &   111,112,113,114,115,116,117/
      DATA (MMT(IJK),IJK=49,59)/                                        &       
     &           ',resonance data)',                                    &       
     &           ',n production)',                                      &       
     &           ',g production)',                                      &       
     &           ',p production)',                                      &       
     &           ',d production)',                                      &       
     &           ',t production)',                                      &       
     &           ',He-3 production)',                                   &       
     &           ',He-4 production)',                                   &       
     &           ',pi+ production)',                                    &       
     &           ',pi0 production)',                                    &       
     &           ',pi- production)'/
      DATA (IMTS(IJK),IJK=49,59)/151,201,202,203,204,205,206,207,208,   &       
     &   209,210/
      DATA (MMT(IJK),IJK=60,70)/                                        &       
     &           ',mu+ production)',                                    &       
     &           ',mu- production)',                                    &       
     &           ',K+ production)',                                     &       
     &           ',K0(long) production)',                               &       
     &           ',K0(short) production)',                              &       
     &           ',K- production)',                                     &       
     &           ',anti-p production)',                                 &       
     &           ',anti-n production)',                                 &       
     &           'Mu Bar',                                              &       
     &           'Xi',                                                  &       
     &           'Gamma'/
      DATA (IMTS(IJK),IJK=60,70)/211,212,213,214,214,216,217,128,251,   &       
     &   252,253/
      DATA (MMT(IJK),IJK=71,78)/                                        &       
     &           'DOCUMENTATION',                                       &       
     &           'Fission Neutron Yields',                              &       
     &           'Independent Yields',                                  &       
     &           'Delayed Fission Neutron Yields',                      &       
     &           'Prompt Fission Neutron Yields',                       &       
     &           'Decay Data',                                          &       
     &           'Energy Release per Fission',                          &       
     &           'Cumulative Yields'/
      DATA (IMTS(IJK),IJK=71,78)/451,452,454,455,456,457,458,459/
!
!     DEFINE PHOTON REACTIONS
!
      DATA (MMT(IJK),IJK=79,NMTS)/                                      &       
     &           'Charged Part. Stopping Power',                        &       
     &           'Photon Interaction Sigma',                            &       
     &           'Photon Coherent Scattering ',                         &       
     &           'Photon Incoherent Scattering',                        &       
     &           'Imaginary Scattering Factor',                         &       
     &           'Real Scattering Factor',                              &       
     &           'Pair Prod.(Electron Field) ',                         &       
     &           'Total Pair Production',                               &       
     &           'Pair Prod.(Nuclear Field)',                           &       
     &           'Photoelectric',                                       &       
     &           'Photo-Excitation',                                    &       
     &           'Electro-Atomic Elastic',                              &       
     &           'Electro-Atomic Bremsstrahlung',                       &       
     &           'Electro-Atomic Excitation',                           &       
     &           'Atomic Relaxation'/
!
      DATA (IMTS(IJK),IJK=79,NMTS)/500,501,502,504,505,506,515,         &       
     &         516,517,522,523,526,527,528,533/
!
!     INITIALIZE
!
      IERR = 0
      BCD = ' '
      MT = MTIN
!
!     CONVERT IF INPUT FILE IS IN ENDF-V FORMAT
!
      IF(NFOR.GT.5)   GO TO 30
      IF(MT.GT.799)   GO TO 30
      IF(MT.GE.700)   GO TO 10
      IF(MT.EQ.602)   MT = 522
      GO TO 30
   10 INDX = MT - 700
      IPAR = INDX/20
      INDX = INDX - 20*IPAR
      IF(INDX.EQ.19)   INDX = 48
      IF(INDX.EQ.18)   INDX = 49
      MT = 600 + 50*IPAR + INDX
!
!     DETERMINE INCIDENT PARTICLE CODE
!
   30 IPART = NSUB/10
      DO I=1,NPARTS
         IF(IPART.LT.IPZA(I))  THEN
            GO TO 900
         ELSE IF(IPART.EQ.IPZA(I)) THEN
            GO TO 45
         END IF
      END DO
      CALL NUSYM(FLOAT(IPART),PCODES(NPARTS+1),JPLEN,IERR)
      IF(IERR.GT.0)  GO TO 900
      JPAR = NPARTS + 1
      GO TO 48
   45 JPAR = I
      JPLEN = ICLEN(JPAR)
!
!     CHECK FOR NEUTRON EXCITED STATES
!
   48 IF(MT.LT.50)   GO TO 200
      IF(MT.GT.91)   GO TO 50
      IPAR = 2
      INDX = MT - 50
      GO TO 60
!
!     CHECK FOR PROTON, TRITON, HELIUM-3 AND ALPHA EXCITED STATES
!
   50 IF(MT.LT.600)   GO TO 150
      IF(MT.GT.849) GO TO 250
      INDX = MT - 600
      IPAR = INDX/50 + 3
      INDX = INDX - 50*(IPAR-3)
!
!     CREATE STRING TO DESCRIBE EXCITED FINAL STATE
!
   60 IPLEN = ICLEN(IPAR)
      IF(INDX.GT.0)  GO TO 75
!*****GROUND STATE
      ILEV = ') ground state'
      GO TO 100
!*****EXCITED STATE
   75 IF(IPAR.EQ.2.AND.INDX.EQ.41)   GO TO 90
      IF(IPAR.GT.2.AND.INDX.EQ.49)   GO TO 90
      IF(NFOR.GT.5.OR.(IPAR.LE.2.OR.INDX.NE.48)) GO TO 78
      ILEV = ') redundant'
      GO TO 100
   78 ISUF = MIN0(INDX,4)
      WRITE(ILEV,80) INDX,SUFO(ISUF)
   80 FORMAT(''')',I2,A3,' level')
      GO TO 95
!*****CONTINUUM
   90 ILEV = ''') continuum'
   95 IF(IPAR.NE.JPAR) THEN
         JLEV = ILEV(2:)
         ILEV = JLEV
      END IF
  100 BCDT = '('//PCODES(JPAR)(1:JPLEN)//','//PCODES(IPAR)(1:IPLEN)//   &       
     &    ILEV
      GO TO 800
!
!     ENERGY RELEASE RATE PARAMETERS
!
  150 IF(MT.LT.301.OR.MT.GT.450) GO TO 180
      MTER = MT - 300
      WRITE(BCDT,175)  MTER
  175 FORMAT('E*SIGMA (MT=',I3,')')
      GO TO 800
!
!     PHOTO ELECTRIC SUBSHELLS
!
  180 IF(MT.LT.534.OR.MT.GT.572)  GO TO 200
      ISHELL = MT - 533
      IIND = INDEX(SHELL(ISHELL),' ') - 1
      BCDT = SHELL(ISHELL)(1:IIND)//' Photoelectric Subshell'
      GO TO 800
!
!     SEARCH FOR MATCHING REACTION NUMBER
!
  200 DO I=1,NMTS
         IF(MT.LT.IMTS(I)) THEN
            GO TO 900
         ELSE IF(MT.EQ.IMTS(I)) THEN
            GO TO 220
         END IF
      END DO
      GO TO 900
!
!     TRANSFER REPRESENTATION TO THE ARRAY BCDT
!
  220 IF(MT.EQ.INMT(JPAR)) GO TO 230
      CCHAR = MMT(I)(1:1)
      IF(CCHAR.EQ.',')   GO TO 225
      BCDT = MMT(I)
      GO TO 800
  225 BCDT = '('//PCODES(JPAR)(1:JPLEN)//MMT(I)
      GO TO 800
!*****SPECIAL CASE OF INELASTIC
  230 BCDT = '('//PCODES(JPAR)(1:JPLEN)//',Inelastic)'
      GO TO 800
!
!     LUMPED REACTION USED IN COVARIANCE FILES
!
  250 IF(MT.GT.870)   GO TO 900
      BCDT = 'Lumped Reaction'
      GO TO 800
!
!     SECTION NUMBER IS RECOGNIZED.  CENTER TEXT
!
  800 DO 810 I=NCRS,1,-1
      CCHAR = BCDT(I:I)
      IF(CCHAR.NE.' ')   GO TO 820
  810 CONTINUE
      GO TO 1000
  820 INIT = (NCRS-I)/2 + 1
      DO J=1,I
         BCD(INIT:INIT) = BCDT(J:J)
         INIT = INIT + 1
      END DO
      GO TO 1000
!
!     SECTION NUMBER IS NOT RECOGNIZED, SET IDENTIFICATION TO ERROR
!       AND ERROR FLAG TO ONE
!
  900 BCD = GOOF
      IERR = 1
!
 1000 RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE NUSYM(ZA,BCD,NCBCD,IERR)
!
!     ROUTINE TO CONSTRUCT A NUCLIDE SYMBOL FROM ITS Z AND A
!
      CHARACTER(LEN=*) BCD
      CHARACTER(LEN=6) BCDX
      CHARACTER(LEN=1) CCHAR
!
      CHARACTER(LEN=6) GOOF
      PARAMETER(IELM=109)
      CHARACTER(LEN=2) ELEMNT(IELM)
!
      DATA GOOF/'******'/
!
!     DEFINE ELEMENT SYMBOLS
!
      DATA (ELEMNT(IJK),IJK=1,60)/                                      &       
     &       'H ','He','Li','Be','B ','C ','N ','O ','F ','Ne',         &       
     &       'Na','Mg','Al','Si','P ','S ','Cl','Ar','K ','Ca',         &       
     &       'Sc','Ti','V ','Cr','Mn','Fe','Co','Ni','Cu','Zn',         &       
     &       'Ga','Ge','As','Se','Br','Kr','Rb','Sr','Y ','Zr',         &       
     &       'Nb','Mo','Tc','Ru','Rh','Pd','Ag','Cd','In','Sn',         &       
     &       'Sb','Te','I ','Xe','Cs','Ba','La','Ce','Pr','Nd'/
      DATA (ELEMNT(IJK),IJK=61,IELM)/                                   &       
     &       'Pm','Sm','Eu','Gd','Tb','Dy','Ho','Er','Tm','Yb',         &       
     &       'Lu','Hf','Ta','W ','Re','Os','Ir','Pt','Au','Hg',         &       
     &       'Tl','Pb','Bi','Po','At','Rn','Fr','Ra','Ac','Th',         &       
     &       'Pa','U ','Np','Pu','Am','Cm','Bk','Cf','Es','Fm',         &       
     &       'Md','No','Lr','Rf','Db','Sg','Bh','Hs','Mt'/
!
!     INITIALIZE
!
      IERR=0
      BCD = ' '
!
!     DETERMINE IZ AND IA
!
      IZ = ZA/1000.
      IA = ZA - 1000.*FLOAT(IZ)
!
!     DETERMINE IF IZ AND IA ARE IN THE ALLOWABLE RANGE.
!
      IF(IZ.LT.0.OR.IZ.GT.IELM) GO TO 90
      IF(IA.LT.0.OR.IA.GT.999)   GO TO 90
!
!     NATURAL ELEMENT
!
      IF(IA.GT.0)   GO TO 20
      BCDX = 'nat-'//ELEMNT(IZ)
      GO TO 28
!
!     BUILD ISOTOPE NAME
!
   20 WRITE(BCDX,25)   IA,ELEMNT(IZ)
   25 FORMAT(I3,'-',A2)
!
!     ELIMINATE IMBEDDED BLANKS
!
   28 NC = 0
      DO 30 I=1,6
      CCHAR = BCDX(I:I)
      IF(CCHAR.EQ.' ')   GO TO 30
      NC = NC + 1
      BCD(NC:NC) = CCHAR
   30 CONTINUE
      NCBCD = NC
      GO TO 100
!
!     IZ AND/OR IA NOT VALID
!
   90 BCD = GOOF
      NCBCD = 6
      IERR = 1
!
  100 RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE TEXTR(ITAPE,TEXT,MAT,MF,MT)
!
!     SUBROUTINE TO READ A TEXT RECORD
!
      COMMON/XYCONT/NSCR,MAXY,NCONT,NA,NB,NN
!
      CHARACTER(LEN=66) TEXT
!
      NCONT = 0
      READ(ITAPE,10) TEXT,MAT,MF,MT
   10 FORMAT(A66,I4,I2,I3)
      RETURN
!
      END
!
!***********************************************************************
!
      SUBROUTINE CONT(ITAPE,C1,C2,L1,L2,N1,N2,MAT,MF,MT)
!
!     READ A CONT RECORD
!
      COMMON/XYCONT/NSCR,MAXY,NCONT,NA,NB,NN
!
      NCONT = 0
      READ(ITAPE,10) C1,C2,L1,L2,N1,N2,MAT,MF,MT
   10 FORMAT(2E11.4,4I11,I4,I2,I3)
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE CANT(ITAPE,C1,C2,L1,L2,N1,N2,MAT,MF,MT,B)
!
!     READ A LIST RECORD
!
      REAL B(*)
!
!     READ CONT RECORD
!
      READ(ITAPE,10)C1,C2,L1,L2,N1,N2,MAT,MF,MT
   10 FORMAT(2E11.4,4I11,I4,I2,I3)
!
!     READ IN ARRAY
!
      READ(ITAPE,20)  (B(I),I=1,N1)
   20 FORMAT(6E11.4)
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE CANT1(ITAPE,C1,C2,L1,L2,N1,N2,MAT,MF,MT,NBT,INT,X,Y)
!
!     READ A TAB1 RECORD
!
      COMMON/XYCONT/NSCR,MAXY,NCONT,NA,NB,NN
!
      INTEGER NBT(20),INT(20)
      REAL X(*),Y(*)
!
!     READ CONT RECORD
!
      NCONT = 0
      READ(ITAPE,10)C1,C2,L1,L2,N1,N2,MAT,MF,MT
   10 FORMAT(2E11.4,4I11,I4,I2,I3)
!
!     READ INTERPOLATION TABLE
!
      READ(ITAPE,20)  (NBT(I),INT(I),I=1,N1)
   20 FORMAT(6I11)
!
!     READ IN ARRAY
!
      IF(N2.GT.MAXY)GO TO 50
      READ(ITAPE,30)  (X(I),Y(I),I=1,N2)
   30 FORMAT(6E11.4)
      GO TO 100
!
!     POINT LIMIT IS EXCEDED SO CREATE PAGING FILE
!
   50 CALL OPSCR(1)
      NCONT = 3*(MAXY/3)
!
!     FILL PAGING FILE
!
   70 NU = MIN0(NCONT,N2-NN)
      READ(ITAPE,30)  (X(I),Y(I),I=1,NU)
      WRITE(NSCR) (X(I),Y(I),I=1,NU)
      NN = NN + NU
      IF(NN.LT.N2)   GO TO 70
!
!     LOAD FIRST PAGE INTO CORE
!
      CALL OPSCR(2)
      CALL RDTAB(X,Y)
!
  100 RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE CANT2(ITAPE,C1,C2,L1,L2,N1,N2,MAT,MF,MT,NBT,INT)
!
!     READ A TAB2 RECORD
!
      COMMON/XYCONT/NSCR,MAXY,NCONT,NA,NB,NN
!
      INTEGER NBT(20),INT(20)
!
!     READ CONT RECORD
!
      NCONT = 0
      READ(ITAPE,10)  C1,C2,L1,L2,N1,N2,MAT,MF,MT
   10 FORMAT(2E11.4,4I11,I4,I2,I3)
!
!     READ INTERPOLATION TABLE
!
      READ(ITAPE,20)  (NBT(I),INT(I),I=1,N1)
   20 FORMAT(6I11)
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE OPSCR(INEW)
!
!     ROUTINE TO INITIALIZE A PAGING FILE
!
      COMMON/XYCONT/NSCR,MAXY,NCONT,NA,NB,NN
!
      LOGICAL SCROPN
!
!     BRANCH ON OPTION
!
      IF(INEW.EQ.2)   GO TO 50
!
!     DELETE ANY EXISTING FILE
!
      NCONT = 0
      INQUIRE(UNIT=NSCR,OPENED=SCROPN)
      IF(SCROPN)  CLOSE(UNIT=NSCR,STATUS='DELETE')
!
!     OPEN NEW PAGE FILE
!
      OPEN(UNIT=NSCR,STATUS='NEW',ACCESS='SEQUENTIAL',                  &       
     &  FORM='UNFORMATTED')
      NN = 0
      GO TO 100
!
!     PREPARE PAGE FILE FOR READING
!
   50 ENDFILE (UNIT=NSCR)
      REWIND (UNIT=NSCR)
      NA = 0
      NB = 0
!
  100 RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE RDTAB(X,Y)
!
!     ROUTINE TO READ A PAGE OF A TAB1 RECORD FROM SCRATCH
!
      COMMON/XYCONT/NSCR,MAXY,NCONT,NA,NB,NN
!
      REAL X(5000),Y(5000)
!
   10 NA = NB + 1
      NB = MIN0(NB+NCONT,NN)
      NU = NB - NA + 1
      IF(NU.GT.0)  GO TO 20
      REWIND (UNIT=NSCR)
      NB = 0
      GO TO 10
   20 READ(NSCR)  (X(I),Y(I),I=1,NU)
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE SKPMAT(ITAPE)
!
!     SKIP REMAINDER OF A DATA SET (MATERIAL)
!
   10 READ(ITAPE,20) MAT
   20 FORMAT(66X,I4)
      IF(MAT.GT.0) GO TO 10
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE SKPFIL(ITAPE)
!
!     SKIP THE REMAINDER OF A FILE
!
   10 READ(ITAPE,20) MF
   20 FORMAT(70X,I2)
      IF(MF.NE.0)   GO TO 10
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE SKPSEC(ITAPE)
!
!     SKIP THE REMAINDER OF A SECTION
!
   10 READ(ITAPE,20) MT
   20 FORMAT(72X,I3)
      IF(MT.NE.0)  GO TO 10
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE SKPREC(ITAPE,I)
!
!     SKIP I RECORDS
!
      DO 20 J=1,I
      READ(ITAPE,10) MT
   10 FORMAT(72X,I3)
   20 CONTINUE
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE LEGEND(P,N,M,X0,X1)
!
!     GENERATE A TABLE OF LEGENDRE POLYNOMIAL FROM P1 TO PN AT M
!     EQUALLY SPACED POINTS SUCH THAT THE FIRST IS X0 AND THE LAST IS
!     X1. THE ORDER N MUST BE AT LEAST 3 AND THE NUMBER OF POINTS
!     MUST BE AT LEAST 2. NO CHECK IS MADE TO SEE IF THESE CRITERIA ARE
!     MET. THEREFORE FAILURE TO SATISFY THEM MAY RESULT IN ERRORS.
!
      REAL P(M,N)
!
!     COMPUTE SPACING
!
      DX=(X0-X1)/FLOAT(M-1)
!
!     INITIALIZE POSITION
!
      X=X0
!
!     BEGIN LOOP OVER POINTS
!
      DO 100 I=1,M
!
!     COMPUTE P1 AND P2
!
      P(I,1)=X
      P(I,2)=1.5*X*X-0.5
      AJ=2.
!
!     BEGIN LOOP OVER ORDERS
!
      DO J=3,N
         AJ=AJ+1.
!
!     USE RECURSION RELATIONSHIP TO GENERATE HIGHER ORDER TERMS
!
         P(I,J)=((2.*AJ-1.)*X*P(I,J-1)-(AJ-1.)*P(I,J-2))/AJ
      END DO
!
!     INCREMENT POSITION
!
      X=X-DX
  100 CONTINUE
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE ANGLAR(DSDO,FL,P,NL,N,M)
!
!     RECONSTRUCT ANGULAR DISTRIBUTION FROM LEGENDRE COEFFICIENTS
!
      REAL DSDO(M),FL(NL),P(M,N)
!
!     INITIALIZE DISTRIBUTION TO P0 CONTRIBUTION AND (2*J+1)/2 TO 0.5
!
      DO J=1,M
         DSDO(J)=0.5
      END DO
      IF(NL.LT.1) RETURN
      AJ=0.5
      DO K=1,NL
         AJ=AJ+1.
         AJFLK=AJ*FL(K)
         DO J=1,M
            DSDO(J)=DSDO(J)+AJFLK*P(J,K)
         END DO
      END DO
!
      RETURN
      END
!
!***********************************************************************
!
      SUBROUTINE DATE_20(DATE)
!
!     RETURNS DATE AS A CHARACTER STRING OF 11 CHARACTERS IN THE
!          FORM  DD-MMM-YYYY
!
      CHARACTER(LEN=*) DATE
      CHARACTER(LEN=26) CDATE
      CHARACTER(LEN=8) PDATE
      CHARACTER(LEN=4) YR
      CHARACTER(LEN=2) DD
      INTEGER     MON
!
      CHARACTER(LEN=3) MONTHS(12)
      DATA MONTHS/'Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep',&       
     &            'Oct','Nov','Dec'/
!
!     GET THE DATE AND TIME AS A CHARACTER STRING
!
!+++MDC+++
!...VMS, WIN
      CALL DATE_AND_TIME(PDATE)
      READ(PDATE,'(A4,I2,A2)') YR,MON,DD
      DATE = DD//'-'//MONTHS(MON)//'-'//YR
!...UNX
!/      CALL FDATE(CDATE)
!/      DATE = CDATE(10:12)//CDATE(6:9)//CDATE(22:25)
!...ANS
!/      DATE = ' '
!---MDC---
      RETURN
      END