C This file is part of PREPRO.
C
C    Author: Dermott (Red) Cullen
C Copyright: (C) International Atomic Energy Agency
C
C PREPRO is free software; you can redistribute it and/or modify it
C under the terms of the MIT License; see LICENSE file for more details.

C=======================================================================
C
C     PROGRAM LEGEND
C     ==============
C     VERSION 80-1 (SEPTEMBER 1980)
C     VERSION 84-1 (NOVEMBER 1984)
C     VERSION 86-1 (JANUARY 1986) *CORRECTED BASED ON USER COMMENTS
C                                 *FORTRAN-77/H VERSION
C     VERSION 87-1 (JANUARY 1987) *CORRECTED BASED ON USER COMMENTS
C     VERSION 88-1 (JULY 1988)    *OPTION...INTERNALLY DEFINE ALL I/O
C                                  FILE NAMES (SEE, SUBROUTINE FILEIO
C                                  FOR DETAILS).
C                                 *IMPROVED BASED ON USER COMMENTS.
C     VERSION 89-1 (JANUARY 1989) *PSYCHOANALYZED BY PROGRAM FREUD TO
C                                  INSURE PROGRAM WILL NOT DO ANYTHING
C                                  CRAZY.
C                                 *UPDATED TO USE NEW PROGRAM CONVERT
C                                  KEYWORDS.
C                                 *ADDED LIVERMORE CIVIC COMPILER
C                                  CONVENTIONS.
C     VERSION 92-1 (JANUARY 1992) *FOR ANGULAR DISTRIBUTIONS CALCULATED
C                                  FROM LEGENDRE COEFFICIENTS, INTERVAL
C                                  HALF TO CONVERGENCE.
C                                 *UPDATED BASED ON USER COMMENTS
C                                 *ADDED FORTRAN SAVE OPTION
C                                 *ADDED SELECTED OF DATA TO PROCESS
C                                  BY MAT/MF/MT/ENERGY RANGES.
C                                 *WARNING...THE INPUT PARAMETER FORMAT
C                                  HAS BEEN CHANGED - FOR DETAILS SEE
C                                  BELOW.
C     VERSION 92-2 (SEPT. 1992)   *CORRECTED PROCESSING OF ISOTROPIC
C                                  ANGULAR DISTRIBUTIONS
C     VERSION 94-1 (JANUARY 1994) *VARIABLE ENDF/B DATA FILENAMES
C                                  TO ALLOW ACCESS TO FILE STRUCTURES
C                                  (WARNING - INPUT PARAMETER FORMAT
C                                  HAS BEEN CHANGED)
C                                 *CLOSE ALL FILES BEFORE TERMINATING
C                                  (SEE, SUBROUTINE ENDIT)
C     VERSION 96-1 (JANUARY 1996) *COMPLETE RE-WRITE
C                                 *IMPROVED COMPUTER INDEPENDENCE
C                                 *ALL DOUBLE PRECISION
C                                 *ON SCREEN OUTPUT
C                                 *UNIFORM TREATMENT OF ENDF/B I/O
C                                 *IMPROVED OUTPUT PRECISION
C                                 *INCREASED MAX. POINTS FROM 5,000
C                                  TO 20,000.
C     VERSION 99-1 (MARCH 1999)   *CORRECTED CHARACTER TO FLOATING
C                                  POINT READ FOR MORE DIGITS
C                                 *UPDATED TEST FOR ENDF/B FORMAT
C                                  VERSION BASED ON RECENT FORMAT CHANGE
C                                 *GENERAL IMPROVEMENTS BASED ON
C                                  USER FEEDBACK
C     VERS. 2000-1 (FEBRUARY 2000)*GENERAL IMPROVEMENTS BASED ON
C                                  USER FEEDBACK
C     VERS. 2001-1 (MARCH 2001)   *UPDATED TO HANDLE COMBINATIONS OF
C                                  LEGENDRE COEFFICIENTS AT LOW ENERGY
C                                  AND TABULATED DATA AT HIGH ENERGY.
C     VERS. 2002-1 (MAY 2002)     *OPTIONAL INPUT PARAMETERS
C     VERS. 2004-1 (MARCH 2004)   *ADDED INCLUDE FOR COMMON
C                                 *ZERO ANGULAR DISTRIBUTIONS ARE O.K.
C                                  (PREVIOUSLY ZERO OR NEGATIVE WAS
C                                   TREATED AS AN ERROR - ZERO IS O.K.
C                                   FOR SOME REACTIONS OVER SOME COSINE
C                                   RANGES)
C     VERS. 2006-1 (MARCH 2006)   *INCREASED MAXIMUM NUMBER OF LEGENDRE
C                                  COEFFICIENTS FROM 50 TO 500.
C                                  WARNING - THE RECURSION RELATIONSHIP
C                                  FOR LEGENDRE POLYNOMIALS BECOMES
C                                  UNSTABLE IN HIGHER ORDER POLYTNOMIALS
C                                  EVEN USING DOUBLE PRECISION.
C     VERS. 2007-1 (JAN.  2007)   *CHECKED AGAINST ALL ENDF/B=VII.
C                                 *INCREASED MAX. POINTS FROM 60,000
C                                  TO 240,000.
C     VERS. 2007-2 (MAY   2007)   *CORRECTED SIZE OF XMUBASE IN ANGLEN
C                                  FOR INCREASED NUMBER OF COEFFICIENTS.
C     VERS. 2010-1 (Apr.  2010)   *General update based on user feedback
C     VERS. 2012-1 (Aug.  2012)   *added CODENAME
C                                 *32 and 64 bit Compatible
C                                 *Added ERROR stop
C     VERS. 2015-1 (Jan.  2015)   *Extended OUT9
C                                 *Replaced ALL 3 way IF Statements.
C     VERS. 2015-2 (Oct.  2015)   *OPEN optional LEGEND.INP after
C                                  OPENING LEGEND.LST.
C                                 *Coefficient checks are turned OFF
C                                  if LEGEND.INP is missing = this
C                                  agrees with BEST INPUT.
C                                 *Switched from LISTO to LISTO9
C                                  (no 10 digit output)
C     VERS. 2016-1 (May   2016)   *Changed multiple IF statement to
C                                  accommodate compiler optimizer
C                                 *Increased Maximum allowed points per
C                                  angular distribution from 900 to
C                                  MAXPOINT (currently 240,000)
C     VERS. 2017-1 (May   2017)   *More tests. Expanded to handle new
C                                  R-M (LRF=7) detailed angular
C                                  distributions.
C                                 *Max. points increased to 3,000,000.
C                                 *All floating input parameters changed
C                                  to characte input + IN9 conversion.
C                                 *If near COS=0 - set = 0
C                                 *Default changed to negative fixes.
C                                 *At end print tallies for,
C                                  1-Number of negative distributions.
C                                  2-Number of duplicate or out-of-order
C                                    Ehnergies
C     VERS. 2018-1 (Jan.  2018)   *Added on-line output for ALL ENDERROR
C     VERS. 2019-1 (June  2019)   *Additional Interpolation Law Tests
C                                 *Checked Maximum Tabulated Energy to
C                                  insure it is the same for all MTs -
C                                  if not, print WARNING messages.
C                                 *Corrected END Histogram linearized -
C                                  Previously assumed Y = 0 and deleted
C                                  Now output whatever the Y value.
C     VERS. 2020-1 (Feb.  2020)   *Identical to 2019-1.
C     VERS. 2021-1 (Jan.  2021)   *Updated for FORTRAN 2018
C
C     OWNED, MAINTAINED AND DISTRIBUTED BY
C     ------------------------------------
C     THE NUCLEAR DATA SECTION
C     INTERNATIONAL ATOMIC ENERGY AGENCY
C     P.O. BOX 100
C     A-1400, VIENNA, AUSTRIA
C     EUROPE
C
C     ORIGINALLY WRITTEN BY
C     ------------------------------------
C     Dermott E. Cullen
C
C     PRESENT CONTACT INFORMATION
C     ---------------------------
C     Dermott E. Cullen
C     1466 Hudson Way
C     Livermore, CA 94550
C     U.S.A.
C     Telephone  925-443-1911
C     E. Mail    RedCullen1@Comcast.net
C     Website    RedCullen1.net/HOMEPAGE.NEW
C
C     PURPOSE
C     -------
C     CALCULATE LINEARLY INTERPOLABLE TABULATED ANGULAR DISTRIBUTIONS
C     STARTING FROM DATA IN THE ENDF/B FORMAT. ANGULAR DISTRIBUTIONS
C     MAY BE DESCRIBED IN THE ENDF/B FORMAT IN ONE OF THREE WAYS.
C     FOR EACH OF THESE THREE FORMS THE USER MAY CHOOSE (SEE, INPUT
C     OPTIONS) TO EITHER COPY EACH TYPE OF DATA OR TO PROCESS IT AT
C     AS FOLLOWS,
C
C     (1) ANGULAR DISTRIBUTION IS ISOTROPIC AT ALL ENERGIES (LTT=0)
C     -------------------------------------------------------------
C     IN THIS CASE THE INPUT DATA DOES NOT INCLUDE ANY ANGULAR
C     DISTRIBUTIONS. A SECTION MERELY CONTAINS A FLAG TO INDICATE
C     THE ANGULAR DISTRIBUTION IS ISOTROPIC AT ALL ENERGIES. IN THIS
C     CASE THE SECTION IS OUTPUT IN EXACTLY THE SAME FORM IN WHICH IT
C     WAS READ FROM THE INPUT.
C
C     (2) ANGULAR DISTRIBUTIONS GIVEN BY LEGENDRE COEFFICIENTS (LTT=1)
C     ----------------------------------------------------------------
C     LEGENDRE COEFFICIENTS ARE GIVEN AT A SERIES OF ENERGIES. AN
C     INTERPOLATION LAW IS GIVEN BETWEEN ENERGIES. THE INTERPOLATION
C     LAW BETWEEN ENERGIES IS COPIED AS INPUT (I.E., NO ATTEMPT IS
C     MADE TO LINEARIZE THE VARIATION WITH ENERGY). FOR EACH ENERGY AT
C     WHICH LEGENDRE COEFFICIENTS ARE GIVEN A LINEARLY INTERPOLABLE
C     ANGULAR DISITRIBUTION IS RECONSTRUCTED IN THE SYSTEM IN WHICH THE
C     THE COEFFICIENTS ARE GIVEN (I.E., CM OR LAB - NO ATTEMPT IS MADE
C     TO CONVERT FROM ONE SYSTEM TO THE OTHER). A MAXIMUM OF 50 LEGENDRE
C     COEFFICIENTS IS ALLOWED. REGARDLESS OF THE NUMBER OF COEFFICIENTS
C     INPUT THE PROGRAM WILL ONLY USE COEFFICIENTS UP TO THE LAST ORDER
C     AT WHICH THE COEFFICIENTS ARE NON-ZERO (E.G. IF COEFFICIENTS P1
C     THROUGH P12 ARE READ, BUT P9=P10=P11=P12=0.0, THE PROGRAM WILL
C     ONLY USE COEFFICIENTS UP TO P8). IF OVER 50 NON-ZERO COEFFICIENTS
C     ARE READ ONLY THE FIRST 50 WILL BE USED.
C
C     (2) ANGULAR DISTRIBUTIONS IS TABULATED (LTT=2)
C     ----------------------------------------------------------------
C     ANGULAR DISTRIBUTIONS ARE GIVEN AT A SERIES OF ENERGIES. AN
C     INTERPOLATION LAW IS GIVEN BETWEEN ENERGIES AND A SECOND
C     INTERPOLATION LAW IS GIVEN AT EACH ENERGY TO INTERPOLATE BETWEEN
C     THE POINTS IN EACH TABULATED DISTRIBUTION. AT EACH ENERGY THE
C     ANGULAR DISTRIBUTION WILL BE CONVERTED TO LINEARLY INTERPOLABLE
C     FORM. THE INTERPOLATION BETWEEN ENERGIES IS OUTPUT EXACTLY AS
C     INPUT. THE INTERPOLATION LAW AT EACH ENERGY IS OUTPUT TO INDICATE
C     THE NOW LINEARLY INTERPOLABLE ANGULAR DISTRIBUTION.
C
C     (3) LEGENDRE COEFFICIENTS AND TABULATED (LTT=3)
C     ----------------------------------------------------------------
C     ENDF-102 SAYS THIS SHOULD BE LTT=4, BUT ALL OF THE EVALUATIONS
C     IN ENDF/B-VI, RELEASE 7, USE LTT=3? THIS CODE WILL TREAT THESE
C     AS LTT=4 - SEE BELOW.
C
C     (4) LEGENDRE COEFFICIENTS AND TABULATED (LTT=4)
C     ----------------------------------------------------------------
C     THIS IS A COMBINATION OF (1) AND (2) DESCRIBED ABOVE. THE
C     LEGENDRE DATA IS ALWAYS GIVEN FIRST, FOR LOWER ENERGIES,
C     FOLLOWED BY TABULATED ANGULAR DISTRIBUTIONS, FOR HIGHER ENERGIES.
C
C     THIS TYPE OF DATA CAN ONLY BE COPIED OR ALL CONVERTED TO
C     TABULATED (LTT=2).
C
C     POINT VALUES - NORMALIZED VS. UNNORMALIZED
C     ------------------------------------------------------------------
C     THE VALUE OF AN ANGULAR DISTRIBUTION AT ANY COSINE WILL BE
C     CORRECTLY CALCULATED BY THIS CODE, BASED EITHER DIRECTLY ON THE
C     ANGULAR DISTRIBUTION, OR ON THE SUM OF THE CONTRIBUTING LEGENDRE
C     MOMENTS.
C
C     ENDF/B ANGULAR DISTRIBUTIONS ARE BY DEFINITION NORMALIZED WHEN
C     INTEGRATED OVER COSINE. THEREFORE THIS CODE WILL NORMALIZE EACH
C     ANGULAR DISTRIBUTION BEFORE IT IS OUTPUT. THE OUTPUT REPORT FROM
C     THIS CODE WILL INDICATE THE NORMALIZATION FACTOR USED.
C
C     THE REASON THAT AN ANGULAR DISTRIBUTION MAY NOT BE NORMALIZED IS
C     DUE TO THE APPROXIMATION OF CREATING LINEARLY INTERPOLABLE
C     TABULATED ANGULAR DISTRIBUTIONS - THE MORE ACCURATELY THIS IS
C     DONE THE CLOSER THE NORMALIZATION FACTOR WILL BE TO UNITY. AS YOU
C     DECREASE THE ALLOWABLE ERROR THE NORMALIZED VALUES WILL APPROACH
C     THE CORRECT POINT VALUES CALCULATED BY THE CODE.
C
C     SINCE THE DATA IS NORMALIZED PRIOR TO OUTPUT THE RESULTS IN THE
C     ENDF/B FORMAT MAY DIFFER SLIGHTLY FROM VALUES REFERRED TO BE ERROR
C     MESSAGES, ETC. PRINTED BY THE CODE DURING EXECUTION. IN ALL CASES
C     THE VALUES PRINTED BY THE CODE IN ERROR MESSAGES, ETC. SHOULD BE
C     CONSIDERED TO BE THE CORRECT VALUES AND THE OUTPUT TABULATED
C     ANGULAR DISTRIBUTIONS APPROXIMATE DUE TO THE RE-NORMALIZATION -
C     TO RE-ITERATE, THE OUTPUT TABULATED VALUES ARE APPROXIMATE DUE
C     TO THE APPROXIMATIONS USED IN CONSTRUCTING LINEAR INTERPOLABLE
C     ANGULAR DISTRIBUTIONS TO WITHIN SOME ALLOWABLE TOLERANCE.
C
C     ELIMINATION OF NEGATIVE VALUES
C     ------------------------------
C     THE RECONSTRUCTED ANGULAR DISTRIBUTION WILL BE TESTED AND IF IT
C     IS NEGATIVE AT ONE OR MORE COSINES AN ERROR MESSAGE WILL BE OUTPUT
C     AND BASED ON THE INPUT OPTION SELECTED ONE OF THE FOLLOWING
C     CORRECTIVE ACTIONS WILL BE TAKEN (SEE, INPUT OPTIONS),
C     (1) NO CORRECTION
C     (2) CHANGE INDIVIDUAL LEGENDRE COEFFICIENTS (EACH BY LESS THAN
C         1.0 PER-CENT) UNTIL THE RECONSTRUCTED ANGULAR DISTRIBUTION
C         IS POSITIVE (MINIMUM MORE THAN 1 MILLI-BARN). THE ALLOWABLE
C         PER-CENT CHANGE IN COEFFICIENTS AND MINIMUM CROSS SECTION CAN
C         BE CHANGED BY INPUT.
C     (3) CHANGE ALL LEGENDRE COEFFICIENTS TO FORCE DISTRIBUTION TO BE
C         POSITIVE (MINIMUM MORE THAN 1 MILLI-BARN). WITH THIS OPTION
C         THERE IS NO RESTRICTION ON THE AMOUNT THAT EACH COEFFICIENT
C         IS CHANGED AND AS SUCH THIS OPTION SHOULD BE USED WITH
C         CAUTION AND ONLY AS A LAST RESORT IF NO OTHER APPROACH CAN
C         BE USED TO MAKE THE DISTRIBUTION POSITIVE.
C
C     OUTPUT
C     ------
C     THE USER MAY REQUEST OUTPUT OF EITHER,
C     (1) TABULATED VALUES - POSSIBLY CORRECTED TO ELIMINATE NEGATIVE
C         VALUES. THE TABULATED DISTRIBUTION WILL BE NORMALIZED BEFORE
C         OUTPUT.
C     (2) LEGENDRE COEFFICIENTS - POSSIBLY CORRECTED TO ELIMINATE
C         NEGATIVE VALUES AND WITHOUT HIGHER ORDER ZERO COEFFICIENTS.
C         BY DEFINITION DISTRIBUTIONS DEFINED BY LEGENDRE COEFFICIENTS
C         ARE NORMALIZED TO UNITY.
C
C     (3) ANGULAR DISTRIBUTIONS GIVEN BY A TABULATION (LTT=2)
C     -------------------------------------------------------
C     TABULATED ANGULAR DISTRIBUTIONS ARE GIVEN AT A SERIES OF ENERGIES.
C     AN INTERPOLATION LAW IS GIVEN BETWEEN ENERGIES. THE INTERPOLATION
C     LAW BETWEEN ENERGIES IS COPIED AS INPUT (I.E., NO ATTEMPT IS
C     MADE TO LINEARIZE THE VARIATION WITH ENERGY). FOR EACH ENERGY AT
C     AT WHICH TABULATED DATA ARE GIVEN A LINEARLY INTERPOLABLE ANGULAR
C     DISTRIBUTION IS CONSTRUCTED IN THE SYSTEM IN WHICH THE TABULATED
C     DATA ARE GIVEN (I.E., CM OR LAB - NO ATTEMPT IS MADE TO CONVERT
C     FROM ONE SYSTEM TO THE OTHER). A MAXIMUM OF 60000 POINTS IS ALLOWE
C     TO REPRESENT THE ANGULAR DISTRIBUTION AT EACH ENERGY.
C
C     ELIMINATION OF NEGATIVE VALUES
C     ------------------------------
C     THE RECONSTRUCTED ANGULAR DISTRIBUTION WILL BE TESTED AND IF IT
C     IS NEGATIVE AT ONE OR MORE COSINES AN ERROR MESSAGE WILL BE OUTPUT
C     AND BASED ON THE INPUT OPTION SELECTED ONE OF THE FOLLOWING
C     CORRECTIVE ACTIONS WILL BE TAKEN (SEE, INPUT OPTIONS),
C     (1) NO CORRECTION
C     (2) CHANGE ALL TABULATED VALUES TO FORCE DISTRIBUTION TO BE
C         POSITIVE (MINIMUM MORE THAN 1 MILLI-BARN). THE MINIMUM VALUE
C         MAY BE CHANGED BY INPUT. WITH THIS OPTION THERE IS NO
C         RESTRICTION ON THE AMOUNT THAT EACH VALUE IS CHANGED AND AS
C         SUCH THIS OPTION SHOULD BE USED WITH CAUTION AND ONLY AS A
C         LAST RESORT IF NO OTHER APPROACH CAN BE USED TO MAKE THE
C         DISTRIBUTION POSITIVE.
C
C     OUTPUT
C     ------
C     THE OUTPUT WILL BE THE LINEARIZED ANGULAR DISTRIBUTION. THE
C     TABULATED DISTRIBUTION WILL BE NORMALIZED TO UNITY BEFORE OUTPUT.
C
C     CORRECTING NEGATIVE ANGULAR DISTRIBUTION
C     ----------------------------------------
C     IF AN ANGULAR DISTRIBUTION IS NEGATIVE AN ERROR MESSAGE WILL BE
C     PRINTED AND THE USER MAY DECIDE (BASED ON INPUT OPTION) TO,
C     (1) NOT PERFORM ANY CORRECTIVE ACTION.
C     (2) FOR TABULATED DISTRIBUTIONS - ADD THE SAME VALUE TO EACH POINT
C         VALUE SUCH THAT WHEN THE DISTRIBUTION IS RE-NORMALIZED THE
C         MINIMUM VALUE IS 0.001 (1 MILLI-BARN). THE MINIMUM VALUE CAN
C         BE CHANGED BY INPUT. WARNING...EXCEPT FOR SELECTION OF THE
C         MINIMUM VALUE (BY INPUT) THE USER HAS NO CONTROL OVER HOW
C         MUCH THE DISTRIBUTION IS CHANGED. THEREFORE THIS OPTION SHOULD
C         BE USED WITH CAUTION.
C     (3) FOR LEGENDRE COEFFICIENTS ONE OF TWO OPTIONS MAY BE SELECTED,
C     (A) CHANGE INDIVIDUAL COEFFICIENTS (NO ONE COEFFICIENT BY MORE
C         THAN 1 PER-CENT) TO MAKE THE DISTRIBUTION POSITIVE WITH A
C         MINIMUM VALUE OF 0.001 (1 MILLI-BARN). THE MAXIMUM PER-CENT
C         CHANGE IN EACH COEFFICIENT AND MINIMUM VALUE MAY BE CHANGED
C         BY INPUT. INPUT THE PROGRAM CANNOT MAKE THE DISTRIBUTION
C         POSITIVE BY CHANGING EACH COEFFICIENT BY UP TO THE MAXIMUM
C         ALLOWABLE AMOUNT, THE ORIGINAL ANGULAR DISTRIBUTION OR
C         COEFFICIENTS WILL BE OUTPUT. ONLY IN THE LATTER CASE SHOULD
C         ONE CONSIDER USING OPTION (B) DESCRIBED BELOW.
C     (B) LOGICALLY ADD THE SAME VALUE TO EACH POINT VALUE SUCH THAT
C         WHEN THE DISTRIBUTION IS RE-NORMALIZED THE MINIMUM VALUE IS
C         0.001 (1 MILLI-BARN). THIS IS EQUIVALENT AT INCREASING P0
C         BY A CERTAIN AMOUNT AND RE-NORMALIZATION IS EQUIVALENT TO THEN
C         DIVIDING EACH COEFFICIENT BY A CERTAIN AMOUNT. THEREFORE,
C         WHAT IS PHYSICALLY DONE BY THE PROGRAM IS TO DIVIDE EACH
C         COEFFICIENT BY THE SAME AMOUNT. WARNING..EXCEPT FOR SELECTION
C         OF THE MINIMUM VALUE (BY INPUT) THE USER HAS NO CONTROL OVER
C         HOW MUCH THE DISTRIBUTION IS CHANGED. THEREFORE THIS OPTION
C         SHOULD BE USED WITH CAUTION.
C
C     WARNING MESSAGES FROM PROGRAM
C     -----------------------------
C     THE WARNING MESSAGES PRINTED BY THIS PROGRAM SHOULD ONLY BE
C     CONSIDERED TO BE EXACTLY THAT..WARNINGS..NOT AN ABSOLUTE JUDGEMENT
C     BY THIS PROGRAM THAT THERE IS SOMETHING WRONG WITH THE DATA. WHEN
C     WARNING MESSAGES ARE PRINTED EXAMINE THE DATA AND EITHER TAKE NO
C     ACTION (IF YOU FEEL THAT THE DATA IS O.K.) OR CORRECT THE DATA
C     (IF YOU FEEL THAT THE DATA IS INCORRECT AND YOU CAN CORRECT IT).
C
C     VALIDITY OF MODIFIED DATA
C     -------------------------
C     BEFORE BELIEVING AND USING DATA WHICH HAS BEEN MODIFIED (EITHER
C     TABULATED ANGULAR DISTRIBUTIONS OR LEGENDRE COEFFICIENTS) THE USER
C     SHOULD INSURE THAT THE MODIFIED DATA IS PHYSICALLY MORE ACCEPTABLE
C     THAN THE ORIGINAL DATA. IN ORDER TO DO THIS ONE OR MORE OF THE
C     FOLLOWING METHODS SHOULD BE USED,
C
C     (1) USE THE ENERGY VARIATION TESTS BUILT-IN TO THIS PROGRAM AND
C         EVALPLOT TO PLOT THE ENERGY DEPENDENCE OF THE LEGENDRE
C         COEFFICIENTS IN ORDER TO IDENTIFY AND CORRECT (BY HAND...NOT
C         BY THIS PROGRAM) ANY COEFFICIENTS WHICH HAVE UNREALISTIC
C         ENERGY AND L ORDER VARIATIONS. THIS SHOULD ALWAYS BE DONE
C         FIRST TO ELIMINATE MAJOR PROBLEMS BEFORE USING THIS PROGRAM
C         TO AUTOMATICALLY MAKE MINOR CORRECTIONS.
C     (1) OUTPUT AND PLOT THE UNCORRECTED AND CORRECTED ANGULAR
C         DISTRIBUTIONS. COMPARE THE PLOTS TO INSURE THAT THE CORRECTED
C         DATA DOES NOT SERIOUSLY CHANGE THE ENERGY DEPENDENCE OF THE
C         ANGULAR DISTRIBUTION.
C     (2) IF PLOTTING CAPABILITY IS NOT AVAIALABLE, USE THE PRINTED OUT
C         OF THIS PROGRAM TO DETERMINE HOW MUCH THE TABULATED ANGULAR
C         DISTRIBUTION OR LEGENDRE COEFFICIENTS HAVE BEEN MODIFIED.
C         GENERALLY IF ONE COEFFICIENT HAS BEEN ONLY SLIGHTLY MODIFIED
C         THE DISTRIBUTION WILL BE ACCEPTABLE. HOWEVER IF MANY
C         COEFFICIENTS HAVE BEEN MODIFIED THE RESULT WILL NOT BE
C         RELIABLE.
C
C     SEEING ANGULAR DISTRIBUTIONS AND LEGENDRE COEFFICIENTS
C     ------------------------------------------------------
C     PROGRAM EVALPLOT CAN BE USED TO PLOT ANGULAR DISTRIBUTION AND
C     LEGENDRE COEFFICIENTS - WHEN IT COMES TO CHECKING THIS TYPE OF
C     DATA THERE IS NO SUBSTITUTE FOR PLOTS OF THE DATA TO MAKE THE
C     JOB EASY AND STRAIGHTFORWARD.
C
C     FOR LEGENDRE COEFFICIENTS EVALPLOT CAN BE USED TO SEE THE ENERGY
C     DEPENDENCE OF EACH COEFFICIENT - THIS IS AN EXTREMELY EASY AND
C     USEFUL WAY TO CHECK FOR ERRORS IN THE BASIC DATA.
C
C     FOR ANGULAR DISTRIBUTION EVALPLOT CAN BE USED TO PLOT THEM AT
C     EACH ENERGY THAT THEY ARE TABULATED - THIS IS ALSO AN EASY AND
C     USEFUL WAY TO CHECK FOR ERRORS.
C
C     I/O UNIT DEFINITIONS
C     --------------------
C     UNIT  DESCRIPTION
C     ----  -----------
C       2   INPUT CARDS
C       3   OUTPUT REPORT
C      10   ORIGINAL DATA IN ENDF/B FORMAT
C      11   FINAL DATA IN ENDF/B FORMAT
C
C     OPTIONAL STANDARD FILE NAMES (SEE SUBROUTINE FILIO1 AND FILIO2)
C     ---------------------------------------------------------------
C     UNIT  FILE NAME
C     ----  ----------
C       2   LEGEND.INP
C       3   LEGEND.LST
C      10   ENDFB.IN
C      11   ENDFB.OUT
C
C     INPUT CARD
C     ----------
C CARD COLS.  FORMAT  DESCRIPTION
C ---- -----  ------ -----------
C  1    1-11   E11.4 FRACTIONAL THINNING CRITERIA
C      12-22   I11   MAXIMUM NUMBER OF POINTS IN ANGULAR DISTRIBUTION
C                    RECONSTRUCTED FROM LEGENDRE COEFFICIENTS (PRESENT
C                    LIMITS ARE 11 TO 60000 POINTS)
C                   *THIS OPTION CAN BE USED TO RUN QUICK, BUT NOT
C                    NECESSARILY SO ACCURATE CALCULATIONS - TO ROUGHLY
C                    SEE WHAT THE ANGULAR DISTRIBUTIONS LOOK LIKE.
C                   *IT IS RECOMMENDED THAT YOU USE 0 AS INPUT - IN
C                    WHICH CASE THE PROGRAM WILL USE THE MAXIMUM
C                    ALLOWABLE NUMBER OF POINTS = 60000.
C      23-33   I11   TABULATED ANGULAR DISTRIBUTION TREATMENT
C                    = 0 - COPY TABLES
C                    = 1 - LINEARIZE TABLES (OUTPUT TABLES)
C                    = 2 - LINEARIZE AND THIN TABLES (OUTPUT TABLES)
C      34-44   I11   LEGENDRE COEFFICIENT TREATMENT
C                    = 0 - COPY LEGENDRE COEFFICIENTS
C                    = 1 - RECONSTRUCT TABULATED ANGULAR DISTRIBUTION.
C                          (OUTPUT TABLES).
C                    = 2 - RECONSTRUCT TABULATED ANGULAR DISTRIBUTION.
C                          (OUTPUT LEGENDRE COEFFICIENTS).
C      45-55   I11   NEGATIVE ANGULAR DISTRIBUTION TREATMENT.
C                    = 0 - NO CORRECTION
C                    = 1 - TABULATE DATA - NO CORRECTION.
C                        - LEGENDRE DATA - CHANGE COEFFICIENTS
C                          (NONE BY MORE THAN 1.0 PER-CENT - CAN BE
C                          CHANGED BY INPUT).
C                    = 2 - FORCE DISTRIBUTIONS TO BE POSITIVE
C                          (TABULATED OR LEGENDRE DATA).
C      56-66   I11   LEGENDRE COEFFICIENT VARIATION TEST FLAG.
C                    = 0 - TEST TESTS.
C                    = 1 - PERFORM TESTS,
C                          (A) LEGENDRE ORDER INCREASES WITH ENERGY.
C                          (C) MONOTONIC VARIATION OF COEFFICIENTS
C                              AS A FUNCTION OF ENERGY.
C                          (C) COEFFICIENTS DECREASE AS A FUNCTION OF
C                              LEGENDRE ORDER.
C   2   1-60   60A1  ENDF/B INPUT DATA FILENAME
C                    (STANDARD OPTION = ENDFB.IN)
C   3   1-60   60A1  ENDF/B OUTPUT DATA FILENAME
C                    (STANDARD OPTION = ENDFB.OUT)
C 4-N   1- 6    I6   LOWER MAT LIMIT
C       7- 8    I2   LOWER MF LIMIT
C       9-11    I3   LOWER MT LIMIT
C      12-17    I6   UPPER MAT LIMIT
C      18-19    I2   UPPER MF LIMIT
C      20-22    I3   UPPER MT LIMIT
C      23-33  E11.4  LOWER ENERGY LIMIT
C      34-44  E11.4  UPPER ENERGY LIMIT
C      45-55  E11.4  MINIMUM ALLOWABLE VALUE OF ANGULAR DISTRIBUTION
C      56-66  E11.4  ALLOWABLE FRACTION (NOT PER-CENT) CHANGE IN ANY
C                    ONE LEGENDRE COEFFICIENT TO MAKE THE ANGULAR
C                    DISTRIBUTION POSITIVE (AND AT LEAST EQUAL TO THE
C                    INPUT MINIMUM ALLOWABLE VALUE).
C
C     *UP TO 100 MAT/MT/E RANGES MAY BE INPUT, EACH SPECIFYING AN
C      ALLOWABLE MINIMUM SIGMA AND MAXIMUM CHANGE IN COEFFICIENTS.
C     *INPUT IS TERMINATED BY A BLANK CARD.
C     *ALL MAY/MT/E RANGES NOT SPECIFIED BY INPUT WILL BE TREATED BY
C      ALLOWING A MINIMUM SIGMA OF 0.001 (1 MILLI-BARN) AND A CHANGE
C      IN EACH COEFFICIENT BY UP TO 0.01 (1 PER-CENT).
C     *THESE MAT/MT/E RANGES ARE NOT USED TO CORRECT ALL ANGULAR
C      DISTRIBUTIONS WHERE SIGMA IS LESS THAN THE MINIMUM. THEY ARE
C      ONLY USED TO CORRECT DISTRIBUTION THAT ARE NEGATIVE AND TO
C      INSURE THAT THE CROSS SECTION AT THE COSINES WHERE THE ANGULAR
C      DISTRIBUTION ARE INITIALLY NEGATIVE ARE CORRECTED TO BE POSITIVE
C      AND AT LEAST AS LARGE AS THE MINIMUM ALLOWABLE SIGMA (SPECIFIED
C      BY INPUT).
C
C     EXAMPLE INPUT NO. 1
C     -------------------
C     PROCESS BOTH LEGENDRE COEFFICIENTS AND TABULATED DATA TO OBTAIN
C     ANGULAR DISTRIBUTION WHICH ARE ACCURATE TO WITHIN 0.1 PER-CENT
C     AND OUTPUT UNCORRECTED TABULATED ANGULAR DISTRIBUTION USING
C     A MAXIMUM OF 501 POINTS IN EACH TABULATED ANGULAR DISTRIBUTION.
C     SINCE LEGENDRE COEFFICIENTS WILL NOT BE CORRECTED THE INPUT NEED
C     NOT SPECIFY MAT/MT/E RANGES.
C
C     READ /ENDFB6/K300/LEAD.IN AND WRITE /ENDFB6/K300/LEAD.OUT
C
C     THE FOLLOWING 4 INPUT LINES ARE REQUIRED,
C
C 1.00000- 3        501          2          1          0
C /ENDFB6/K300/LEAD.IN
C /ENDFB6/K300/LEAD.OUT
C     (BLANK CARD TERMINATED INPUT)
C
C     EXAMPLE INPUT NO. 2
C     -------------------
C     PROCESS BOTH LEGENDRE COEFFICIENTS AND TABULATED DATA TO OBTAIN
C     ANGULAR DISTRIBUTION WHICH ARE ACCURATE TO WITHIN 0.1 PER-CENT
C     AND OUTPUT CORRECTED TABULATED ANGULAR DISTRIBUTION (ONLY THOSE
C     RE-CONSTRUCTED FROM LEGENDRE COEFFICIENTS WILL BE CORRECTED).
C     FOR ALL MAT/MT/E CORRECT NEGATIVE ANGULAR DISTRIBUTION TO A VALUE
C     OF 0.01 (10 MILLI-BARNS) AND ALLOW LEGENDRE COEFFICIENTS TO BE
C     CHANGED BY UP TO 0.02 (2 PER-CENT).
C
C     USE THE DEFAULT FILENAMES ENDFB.IN AND ENDFB.OUT (THIS CAN BE
C     DONE BY LEAVING THE SECOND AND THIRD INPUT LINES BLANK).
C
C     THE FOLLOWING 5 INPUT LINES ARE REQUIRED,
C
C 1.00000- 3        501          2          1          1
C
C
C     1 1  1  999999999 0.00000+ 0 3.00000+ 7 1.00000- 2 2.00000- 2
C     (BLANK CARD TERMINATED INPUT)
C
C     EXAMPLE INPUT NO. 3
C     -------------------
C     PROCESS BOTH LEGENDRE COEFFICIENTS AND TABULATED DATA TO OBTAIN
C     ANGULAR DISTRIBUTION WHICH ARE ACCURATE TO WITHIN 0.1 PER-CENT
C     AND OUTPUT CORRECTED LEGENDRE COEFFICIENTS AND UNCORRECTED
C     TABULATED ANGULAR DISTRIBUTIONS. FOR MAT=1800, MT=2 CORRECT
C     NEGATIVE ANGULAR DISTRIBUTIONS TO INSURE THE MINIMUM IS 0.01
C     (10 MILLI-BARNS) ALLOWING EACH LEGENDRE COEFFICIENT TO CHANGE BY
C     UP TO 0.02 (2 PER-CENT). ALL OTHER MAT/MT/E WILL BE CORRECTED
C     TO A MINIMUM OF 0.001 (1 MILLI-BARN) ALLOWING A 0.01 (1 PER-CENT)
C     CHANGE (BUILT-IN OPTION).
C
C     READ /ENDFB6/K300/LEAD.IN AND WRITE /ENDFB6/K300/LEAD.OUT
C
C     THE FOLLOWING 5 INPUT LINES ARE REQUIRED,
C
C 1.00000- 3        501          2          2          1
C /ENDFB6/K300/LEAD.IN
C /ENDFB6/K300/LEAD.OUT
C  1800 4  2  1800 4  2 0.00000+ 0 3.00000+ 7 1.00000- 2 2.00000- 2
C     (BLANK CARD TERMINATED INPUT)
C
C     EXAMPLE INPUT NO. 4
C     -------------------
C     TO COPY TABULATED ANGULAR DISTRIBUTION AND CONVERT LEGENDRE
C     COEFFICIENTS TO UNCORRECTED TABULAR DISTRIBUTIONS.
C
C     USE THE DEFAULT FILENAMES ENDFB.IN AND ENDFB.OUT (THIS CAN BE
C     DONE BY LEAVING THE SECOND AND THIRD INPUT LINES BLANK).
C
C     THE FOLLOWING 4 INPUT LINES ARE REQUIRED,
C
C 1.00000- 3        501          0          1          0
C
C
C     (BLANK CARD TERMINATED INPUT)
C
C=======================================================================
      INCLUDE 'implicit.h'
C-----08/08/2012 DEFINE CODE NAME
      CHARACTER*8 CODENAME
      COMMON/NAMECODE/CODENAME
      INTEGER*4 OUTP,OTAPE,TYPED
      CHARACTER*1 FIELD6
      CHARACTER*4 CARD
      CHARACTER*60 NAMEIN,NAMEOUT
      COMMON/HEADER/C1H,C2H,L1H,L2H,N1H,N2H,MATH,MFH,MTH,NOSEQ
      COMMON/ENDFIO/INP,OUTP,ITAPE,OTAPE
      COMMON/IOSTATUS/ISTAT1,ISTAT2
      COMMON/MAXIE/ERRMAX,ERROK,ERRUSE,LOOPE
      COMMON/MAXIM/NPTMAX,LEGMAX
      COMMON/COPC/CARD(17)
      COMMON/WHERE/E,IZALST,MATLST,MTLST,NE,JE
      COMMON/TYPES/TYPED(6)
      COMMON/FLAGS4/IMTABS,IMLEGS,IMFIX,IMVAR
      COMMON/NAMEX/NAMEIN,NAMEOUT
      COMMON/FIELDC/FIELD6(11,6)
      INCLUDE 'legend.h'
      DATA ERRMIN/1.0D-03/
      DATA ONE   /1.0D+00/
      DATA ONEP5 /1.5D+00/
      DATA TWO   /2.0D+00/
      DATA THREE /3.0D+00/
C-----08/08/2012 DEFINE CODE NAME
      CODENAME = 'LEGEND  '
C-----INITIALIZE TIMER
      CALL TIMER
c-----------------------------------------------------------------------
C
C     DEFINE ALL I/O UNITS AND OPTIONALLY DEFINE FILENAMES.
C
c-----------------------------------------------------------------------
      CALL FILIO1
C-----IDENTIFY PROGRAM
      WRITE(OUTP,230)
      WRITE(*   ,230)
C-----INITIALIZE LAST ZA, MAT AND MT.
      IZALST=-999999
      MATLST=-9999
      MTLST=-9999
C-----DEFINE MAXIMUM ALLOWABLE NUMBER OF COSINES AND LEGENDRE ORDER.
      NPTMAX=MAXPOINT
      LEGMAX=MAXLEGS
c-----------------------------------------------------------------------
C
C     DEFINE MULTIPLIERS FOR LEGENDRE POLYNOMIALS (2*L+1)/2
C     AND CONSTANTS FOR LEGENDRE RECURSION RELATIONSHIP
C     P(L+1)=PCON1(L+1)*MU*P(L)+PCON2(L+1)*P(L-1)
C     PCON1(L+1)=(2*L+1)/(L+1)
C     PCON2(L+1)=-L/(L+1)
C
c-----------------------------------------------------------------------
      FLMULT(1)=ONEP5
      CON1=THREE
      CON2=ONE
      DO 10 L=2,LEGMAX
      FLMULT(L)=FLMULT(L-1)+ONE
      PCON1(L)=CON1/(CON2+ONE)
      PCON2(L)=-CON2/(CON2+ONE)
      CON1=CON1+TWO
      CON2=CON2+ONE
   10 CONTINUE
c-----------------------------------------------------------------------
C
C     READ ALL RUN PARAMETERS.
C
c-----------------------------------------------------------------------
      IF(ISTAT1.EQ.1) GO TO 30
C-----2017/5/6 - Changed all floating point to character.
      READ(INP,20,END=30,ERR=30) (FIELD6(j,1),j=1,11),
     1 NPTMU,IMTABS,IMLEGS,IMFIX,IMVAR
   20 FORMAT(11A1,5I11)
      CALL IN9(ERROK,FIELD6(1,1))
C-----2017/5/6 - Changed all floating point to character.
      GO TO 40
C-----DEFINE DEFAULT VALUES
   30 ISTAT1 = 1
      ERROK  = ERRMIN
c-----2016/5/21 - Increased from 101 to NPTMAX
      NPTMU  = NPTMAX
      IMTABS = 1
      IMLEGS = 1
C-----2017/3/7 - changed from 2 to 0 = default: NO negatives fixes.
      IMFIX  = 0
C-----2015/10/28 - switched from 1 to 0, to agree with BEST INPUT.
      IMVAR  = 0
C-----INSURE PARAMETERS ARE IN LEGAL RANGE. IF NOT USE DEFAULT VALUES.
   40 IF(ERROK.LE.0.0d0) ERROK=ERRMIN
      IF(NPTMU.LE.0) NPTMU=NPTMAX
      IF(NPTMU.LT.11) NPTMU=11
      IF(NPTMU.GT.NPTMAX) NPTMU=NPTMAX
      NPTMAX=NPTMU
      IF(IMTABS.LT.0.OR.IMTABS.GT.2) IMTABS=0
      IF(IMLEGS.LT.0.OR.IMLEGS.GT.2) IMLEGS=0
      IF(IMFIX.LT.0.OR.IMFIX.GT.2) IMFIX=0
      IF(IMVAR.NE.1) IMVAR=0
C-----WRITE TITLE FOR OUTPUT LISTING.
      ERRMAX=100.0d0*ERROK
      CALL OUT9(ERROK,FIELD6(1,1))
      WRITE(OUTP,240) (FIELD6(M,1),M=1,11),ERRMAX,NPTMAX
      IF(IMTABS.EQ.0) WRITE(OUTP,250)
      IF(IMTABS.EQ.1) WRITE(OUTP,260)
      IF(IMTABS.EQ.2) WRITE(OUTP,270)
      IF(IMLEGS.EQ.0) WRITE(OUTP,280)
      IF(IMLEGS.EQ.1) WRITE(OUTP,290)
      IF(IMLEGS.EQ.2) WRITE(OUTP,300)
      IF(IMFIX.EQ.0) WRITE(OUTP,310)
      IF(IMFIX.EQ.1) WRITE(OUTP,320)
      IF(IMFIX.EQ.2) WRITE(OUTP,330)
      IF(IMVAR.EQ.0) WRITE(OUTP,390)
      IF(IMVAR.EQ.1) WRITE(OUTP,400)
c-----------------------------------------------------------------------
C
C     READ FILENAMES - IF BLANK USE STANDARD FILENAMES
C
c-----------------------------------------------------------------------
C-----INPUT DATA.
      IF(ISTAT1.EQ.1) GO TO 60
      READ(INP,50,END=60,ERR=60) NAMEIN
   50 FORMAT(A60)
      IF(NAMEIN.EQ.' ') NAMEIN = 'ENDFB.IN'
C-----OUTPUT DATA.
      READ(INP,50,END=70,ERR=70) NAMEOUT
      IF(NAMEOUT.EQ.' ') NAMEOUT = 'ENDFB.OUT'
      GO TO 80
C-----USE DEFAULT FILENAMES
   60 NAMEIN  = 'ENDFB.IN'
   70 NAMEOUT = 'ENDFB.OUT'
      ISTAT1  = 1
C-----PRINT FINAL FILENAMES
   80 WRITE(OUTP,90) NAMEIN,NAMEOUT
      WRITE(*   ,90) NAMEIN,NAMEOUT
   90 FORMAT(1X,78('-')/
     1 ' ENDF/B Input and Output Data Filenames'/1X,A60/1X,A60)
c-----------------------------------------------------------------------
C
C     OPEN ENDF/B DATA FILES
C
c-----------------------------------------------------------------------
      CALL FILIO2
c-----------------------------------------------------------------------
C
C     TERMINATE IF ERROR OPENING ENDF/B DATA FILE
C
c-----------------------------------------------------------------------
      IF(ISTAT2.EQ.1) THEN
      WRITE(OUTP,100) NAMEIN
      WRITE(   *,100) NAMEIN
  100 FORMAT(//' ERROR - Opening ENDF/B formatted file'/1X,A60//)
      CALL ENDERROR
      ENDIF
C-----MINIMUM REQUESTED CROSS SECTION AND CHANGE IN COEFFICIENTS.
      WRITE(OUTP,340)
      IEND=0
      DO 150 ITAB=1,MAXMAT
C-----READ NEXT REQUEST.
      IF(ISTAT1.EQ.1) GO TO 120
C-----2017/5/6 - Changed all floating point to character.
      READ(INP,110,END=120,ERR=120)
     1 MATAB1(ITAB),MFTAB1(ITAB),MTAB1(ITAB),MATAB2(ITAB),
     2 MFTAB2(ITAB),MTAB2(ITAB),((FIELD6(j,k),j=1,11),k=1,4)
  110 FORMAT(I6,I2,I3,I6,I2,I3,44A1)
      CALL IN9(ETAB1 (ITAB),FIELD6(1,1))
      CALL IN9(ETAB2 (ITAB),FIELD6(1,2))
      CALL IN9(SIGTAB(ITAB),FIELD6(1,3))
      CALL IN9(DFLTAB(ITAB),FIELD6(1,4))
C-----2017/5/6 - Changed all floating point to character.
      IF(MATAB1(ITAB).NE.0.OR.MFTAB1(ITAB).NE.0.OR.MTAB1(ITAB).NE.0.OR.
     1   MATAB2(ITAB).NE.0.OR.MFTAB2(ITAB).NE.0.OR.MTAB2(ITAB).NE.0.OR.
     1 ETAB1(ITAB) .NE.0.0d0.OR.ETAB2(ITAB) .NE.0.0d0.OR.
     2 SIGTAB(ITAB).NE.0.0d0.OR.DFLTAB(ITAB).NE.0.0d0) GO TO 130
C-----SET PARAMETERS TO PROCESS ALL DATA IF FIRST REQUEST IS BLANK.
C-----OTHERWISE ASSUME END OF INPUT PARAMETERS.
      IF(ITAB.GT.1) GO TO 160
C-----SET END OF INPUT FLAG AND DEFINE STANDARD OPTIONS FOR ALL
C-----REMAINING SECTIONS.
  120 ISTAT1 = 1
      IEND=1
      IF(ITAB.GT.1) GO TO 160
      MATAB1(ITAB)=1
      MATAB2(ITAB)=9999
      MFTAB1(ITAB)=1
      MFTAB2(ITAB)=99
      MTAB1(ITAB)=1
      MTAB2(ITAB)=999
      ETAB1(ITAB)=0.0d0
      ETAB2(ITAB)=1.0E+09
      SIGTAB(ITAB)=0.001d0
      DFLTAB(ITAB)=0.01d0
      GO TO 140
C-----ASSIGN STANDARD VALUES.
  130 IF(MATAB2(ITAB).LT.MATAB1(ITAB)) MATAB2(ITAB)=MATAB1(ITAB)
      IF(MFTAB2(ITAB).LT.MFTAB1(ITAB)) MFTAB2(ITAB)=MFTAB1(ITAB)
      IF(MTAB2(ITAB).LT.MTAB1(ITAB)) MTAB2(ITAB)=MTAB1(ITAB)
      IF(ETAB1(ITAB).LE.0.0d0) ETAB1(ITAB)=0.0d0
      IF(ETAB2(ITAB).LE.0.0d0) ETAB2(ITAB)=1.0E+09
      IF(SIGTAB(ITAB).LE.0.0d0) SIGTAB(ITAB)=0.001d0
      IF(DFLTAB(ITAB).LE.0.01d0) DFLTAB(ITAB)=0.01d0
C-----OUTPUT INTERPRETATION OF CARD.
  140 CALL OUT9(ETAB1( ITAB),FIELD6(1,1))
      CALL OUT9(ETAB2( ITAB),FIELD6(1,2))
      CALL OUT9(SIGTAB(ITAB),FIELD6(1,3))
      WRITE(OUTP,350) MATAB1(ITAB),MFTAB1(ITAB),MTAB1(ITAB),
     1 MATAB2(ITAB),MFTAB2(ITAB),MTAB2(ITAB),
     2 ((FIELD6(M,J),M=1,11),J=1,3),DFLTAB(ITAB)
      IF(IEND.GT.0) GO TO 170
  150 CONTINUE
      ITAB=MAXMAT
      GO TO 170
  160 ITAB=ITAB-1
c-----------------------------------------------------------------------
C
C     START OF RUN.
C
c-----------------------------------------------------------------------
C-----INITIALIZE ISOTROPIC, LEGENDRE AND TABULATED COUNTS.
  170 do i=1,6
      TYPED(i)=0
      enddo
C-----COPY TAPE LABEL.
      CALL COPYL
      WRITE(OUTP,360) CARD,MATH
      WRITE(*   ,360) CARD,MATH
      LASTMAT=-10000
C-----COPY UP TO HOLLERITH (MF/MT=1/451) OR ANGULAR DISTRIBUTIONS (MF=4)
  180 CALL CONTIL
      IF(MATH.LT.0) then
c-----------------------------------------------------------------------
c
c     End of run
c
c-----------------------------------------------------------------------
      IF(LASTMAT.GT.0) then
c-----Check MT table for MAT
      CALL MAXIE3(1)
      CALL TIMEMAT
      endif
      GO TO 220
      endif
c-----------------------------------------------------------------------
c
c     New MAT?
c
c-----------------------------------------------------------------------
      IF(MATH.EQ.LASTMAT) GO TO 190
C-----TIME FOR PREVIOUS MAT, IF ANY
      IF(LASTMAT.GT.0) then
c-----Check MT table for MAT
      CALL MAXIE3(1)
      CALL TIMEMAT
      endif
c-----Initialize MT table for MAT
      CALL MAXIE0
C-----HEADING FOR EACH MAT
      WRITE(OUTP,370)
      WRITE(*   ,370)
      LASTMAT=MATH
C-----CHECK FOR HOLLERITH SECTION.
  190 IF(MFH.NE.1.OR.MTH.NE.451) GO TO 200
      CALL CONTOL
      CALL FILE1
      CALL COPYS
      GO TO 180
C-----CHECK FOR ANGULAR DISTRIBUTIONS.
  200 IF(MFH.eq.4) go to 210
C-----NOT FILE 4. COPY SECTION.
      CALL CONTOL
      CALL COPYS
      GO TO 180
C-----FILE 4 FOUND. PROCESS ONE SECTION.
  210 CALL FILE4
      GO TO 180
c-----------------------------------------------------------------------
C
C     END OF RUN.
C
c-----------------------------------------------------------------------
C-----OUTPUT FEND/MEND/TEND AS NEEDED.
  220 CALL CONTOL
C-----PRINT TOTALS AND TERMINATE.
      WRITE(OUTP,380) TYPED
      WRITE(*   ,380) TYPED
c-----Print final WARNING if data not tabulated to same Maximum Energy
      CALL MAXIE4(1)
c-----End of run - Normal
      CALL ENDIT
      GO TO 220      ! CANNOT GET TO HERE.
  230 FORMAT(' Linearized ENDF/B Angular Distributions (LEGEND 2021-1)'/
     1 1X,78('-'))
  240 FORMAT(' Allowable Accuracy----------',11A1,
     2 ' (',F9.4,' per-cent)'/
     3 ' Maximum Number of Cosines---',I11)
  250 FORMAT(' Tabulated Data--------------Copy')
  260 FORMAT(' Tabulated Data--------------Linearize     ',
     1 ' - Output Tables')
  270 FORMAT(' Tabulated Data--------------Linearize/Thin',
     1 ' - Output Tables')
  280 FORMAT(' Legendre Data---------------Copy')
  290 FORMAT(' Legendre Data---------------Tabulate      ',
     1 ' - Output Tables')
  300 FORMAT(' Legendre Data---------------Tabulate      ',
     1 ' - Output Coefficients')
  310 FORMAT(' Negative Data Correction----None')
  320 FORMAT(' Negative Table Correction---None'/
     1       ' Legendre Coef. Correction---Modify up to 1 per-cent')
  330 FORMAT(' Negative Data Correction----Force to be Positive')
  340 FORMAT(1X,78('-')/' Minimum Allowable Cross Section and',
     1 ' Maximum Allowable Coefficient Change'/1X,78('-')/
     2 '  MAT1 MF1  MT1  MAT2 MF2  MT2         E1         E2',
     3 '  Sigma-Low   Delta-Fl'/
     4 38X,'(eV)',7X,'(eV)',5X,'(b/mu)'/1X,78('-'))
  350 FORMAT(I6,I4,I5,I6,I4,I5,33A1,F11.5)
  360 FORMAT(1X,78('-')/
     1 ' Tape Label'/1X,78('-')/1X,16A4,A2,I4)
  370 FORMAT(1X,78('-')/
     2 '     ZA  MAT  MT  Energy-eV   Legendre     Points     Points'/
     3 31X,'Order',11X,'In',8X,'Out   Integral Messages'/
     4 28X,'Read (Used)'/1X,78('-'))
  380 FORMAT(1X,78('-')/' Summary of Data as Read'/1X,78('-')/
     1 ' Isotropic Sections----------------------',I8/
     2 ' Energies with Legendre Coefficients-----',I8/
     3 ' Energies with Tabulations---------------',I8/
     4 ' Energies with Combined------------------',I8/
     5 ' Energies with NEGATIVE distributions----',I8/
     6 ' Repeated Energies-----------------------',I8)
  390 FORMAT(' Coefficient Tests-----------Off')
  400 FORMAT(' Coefficient Tests-----------On')
      END
      INTEGER*4 FUNCTION MYWANT(MAT,MF,MT)
C=======================================================================
C
C     DEFINE WHETHER OR NOT A SECTION HAS BEEN REQUESTED.
C     MYWANT = 1 - REQUESTED
C            = 0 - NOT REQUESTED
C            =-1 - END OF DATA (PASSED ALL REQUESTED DATA)
C
C=======================================================================
      INCLUDE 'implicit.h'
      INCLUDE 'legend.h'
      NEEDED=0
      DO 10 I=1,ITAB
      IF(MAT.GT.MATAB2(I)) GO TO 10
      NEEDED=1
      IF(MAT.LT.MATAB1(I)) GO TO 10
      IF(MF.LT.MFTAB1(I).OR.MF.GT.MFTAB2(I)) GO TO 10
      IF(MT.LT.MTAB1(I).OR.MT.GT.MTAB2(I)) GO TO 10
C-----SECTION REQUESTED.
      GO TO 20
   10 CONTINUE
C-----SECTION NOT REQUESTED. IS THIS END OF DATA.
      IF(NEEDED.LE.0) GO TO 30
      MYWANT=0
      RETURN
C-----REQUESTED.
   20 MYWANT=1
      RETURN
C-----END OF DATA.
   30 MYWANT=-1
      RETURN
      END
      SUBROUTINE FILE1
C=======================================================================
C
C     ADD COMMENTS AT THE END OF FILE 1, SECTION 451 TO INDICATE
C     THAT THIS MATERIAL HAS BEEN PROCESSED BY PROGRAM LEGEND AND
C     TO SPECIFY THE INPUT PARAMETERS.
C
C     DEFINE FORMAT TO BE ENDF/B-IV, V OR VI.
C
C     THE ENDF/B FORMAT CAN BE DETERMINED FROM THE SECOND CARD.
C     ENDF/B-IV = N1 > 0, N2 = 0,CARD COUNT (POSITIVE)
C     ENDF/B-V  = N1 = N2 = 0
C     ENDF/B-VI =      N2 = VERSION NUMBER (6 OR MORE)
C
C=======================================================================
      INCLUDE 'implicit.h'
      CHARACTER*1 PROGDOC1
      CHARACTER*66 PROGDOC
      COMMON/LEADER/C1,C2,L1,L2,N1,N2,MAT,MF,MT
      COMMON/MAXIE/ERRMAX,ERROK,ERRUSE,LOOPE
      COMMON/FLAGS4/IMTABS,IMLEGS,IMFIX,IMVAR
      COMMON/MAXIM/NPTMAX,LEGMAX
      DIMENSION PROGDOC(12),PROGDOC1(66,12)
      EQUIVALENCE (PROGDOC(1),PROGDOC1(1,1))
c-----------------------------------------------------------------------
c
C     DOCUMENTATION TO ADD TO ENDF/B OUTPUT - EACH LINE IS 66
C     CHARACTERS LONG - FIELDS 12345678901 ARE FILLED IN WITH
C     11 CHARACTERS DURING EXECUTION.
c
c-----------------------------------------------------------------------
C                1         2         3         4         5         6
C       12345678901234567890123456789012345678901234567890123456789012
C       3456
      DATA PROGDOC/
     1 ' ***************** Program LEGEND (VERSION 2021-1) ***********',
     2 ' Linearized Angular Distributions from Tables or Coefficients ',
     3 ' Allowable Error of12345678901 per-cent and123456 Max. Points ',
     4 ' Tabulated Data...Copied                                      ',
     5 ' Tabulated Data...Linearized                                  ',
     6 ' Tabulated Data...Linearized/Thinned                          ',
     7 ' Legendre Data....Copied                                      ',
     8 ' Legendre Data....Reconstructed Table/Output Table            ',
     9 ' Legendre Data....Reconstructed Table/Output Coefficients     ',
     A ' Correction.......None                                        ',
     1 ' Correction.......Modify Coefficients                         ',
     2 ' Correction.......Force Distributions to be Positive          '/
C-----FILL IN REMAINDER OF FIRST LINE
      PROGDOC1(63,1) = '*'
      PROGDOC1(64,1) = '*'
      PROGDOC1(65,1) = '*'
      PROGDOC1(66,1) = '*'
C-----HEAD CARD OF SECTION HAS BEEN READ AND WRITTEN. READ NEXT CARD
C-----AND DETERMINE IF THIS IS THE ENDF/B-IV, V OR VI FORMAT.
      CALL CARDI(C1,C2,L1,L2,N1,N2)
C-----CHECK FOR ENDF/B-IV.
C-----IV N1 > 0, N2 = 0
      IF(N1.GT.0.AND.N2.EQ.0) GO TO 10
C-----NOT ENDF/B-IV. READ THIRD CARD.
      N2X=N2
      CALL CARDO(C1,C2,L1,L2,N1,N2)
      CALL CARDI(C1,C2,L1,L2,N1,N2)
C-----CHECK FOR ENDF/B-V FORMAT.
      IF(N2X.LE.0) GO TO 10
C-----ENDF/B-VI FORMAT. READ FOURTH CARD.
      CALL CARDO(C1,C2,L1,L2,N1,N2)
      CALL CARDI(C1,C2,L1,L2,N1,N2)
C-----INCREASE COMMENT CARD COUNT AND COPY TO END OF HOLLERITH.
   10 N1IN=N1
      N1=N1+6
      CALL CARDO(C1,C2,L1,L2,N1,N2)
      DO 20 N=1,N1IN
      CALL COPY1
   20 CONTINUE
c-----------------------------------------------------------------------
C
C     ADD SIX COMMENT LINES.
C
c-----------------------------------------------------------------------
C-----IDENTIFY PROGRAM AND VERSION
      CALL HOLLYO(PROGDOC1(1,1))
      CALL HOLLYO(PROGDOC1(1,2))
C-----ALLOWABLE ERROR AND MAXIMUM POINTS
      CALL OUT9(ERRMAX,PROGDOC1(20,3))
      CALL INTOUT(NPTMAX,PROGDOC1(44,3),6)
      CALL HOLLYO(PROGDOC1(1,3))
C-----TREATMENT OF TABLES
      IF(IMTABS.EQ.0) CALL HOLLYO(PROGDOC1(1, 4))
      IF(IMTABS.EQ.1) CALL HOLLYO(PROGDOC1(1, 5))
      IF(IMTABS.EQ.2) CALL HOLLYO(PROGDOC1(1, 6))
C-----TREATMENT OF LEGENDRE COEFFICIENTS
      IF(IMLEGS.EQ.0) CALL HOLLYO(PROGDOC1(1, 7))
      IF(IMLEGS.EQ.1) CALL HOLLYO(PROGDOC1(1, 8))
      IF(IMLEGS.EQ.2) CALL HOLLYO(PROGDOC1(1, 9))
C-----CORRECTIONS
      IF(IMFIX .EQ.0) CALL HOLLYO(PROGDOC1(1,10))
      IF(IMFIX .EQ.1) CALL HOLLYO(PROGDOC1(1,11))
      IF(IMFIX .EQ.2) CALL HOLLYO(PROGDOC1(1,12))
      RETURN
      END
      SUBROUTINE FILE4
C=======================================================================
C
C     PROCESS ONE SECTION OF FILE4 DATA.
C
C=======================================================================
      INCLUDE 'implicit.h'
      INTEGER*4 OUTP,OTAPE,TYPED
      CHARACTER*1 FIELD6
      COMMON/HEADER/C1H,C2H,L1H,L2H,N1H,N2H,MATH,MFH,MTH,NOSEQ
      COMMON/LEADER/C1,C2,L1,L2,N1,N2,MAT,MF,MT
      COMMON/ENDFIO/INP,OUTP,ITAPE,OTAPE
      COMMON/UNITS/ISCR
      COMMON/OUTTAB/N2OUT
      COMMON/MAXIE/ERRMAX,ERROK,ERRUSE,LOOPE
      COMMON/WHERE/E,IZALST,MATLST,MTLST,NE,JE
      COMMON/TYPES/TYPED(6)
      COMMON/FLAGS4/IMTABS,IMLEGS,IMFIX,IMVAR
      COMMON/FIELDC/FIELD6(11,6)
      COMMON/LASTE/ELAST
      INCLUDE 'legend.h'
c-----------------------------------------------------------------------
C
C     SAVE I/O UNITS, IN CASE SCRATCH IS USED.
C
c-----------------------------------------------------------------------
      NTAPE1 = ITAPE
      NTAPE2 = OTAPE
c-----------------------------------------------------------------------
C
C     INITIALIZE PARAMETERS.
C
c-----------------------------------------------------------------------
C-----MF=4 FOUND. DEFINE ZA.
      IZA=C1H
C-----PRINT SEPERATOR IF NEW MAT OR MT.
      IF(MATH.EQ.MATLST) GO TO 10
      IF(MATLST.GT.0) WRITE(OUTP,340)
      GO TO 20
   10 IF(MTH.EQ.MTLST) GO TO 20
      WRITE(OUTP,350)
   20 IZALST=IZA
      MATLST=MATH
      MTLST=MTH
C-----FIX FOR ERRORS IN ENDF/B-VI, RELEASE 7 DATA, WHICH ERRNOEOUSLY
C-----USES LTT=3, INSTEAD OF LTT=4.
      IF(L2H.EQ.3) L2H = 4
C-----SAVE LTT WHICH DEFINES ISOTROPIC, LEGENDRE OR TABULATED AND
C-----TRANSFORMATION MATRIX FLAG.
      LTT=L2H
      LVT=L1H
c-----------------------------------------------------------------------
C
C     DECIDE WHEATHER OR NOT SECTION SHOULD AND CAN BE PROCESSED.
C
c-----------------------------------------------------------------------
C-----IF LTT IS NOT 0 TO 4 PRINT ERROR MESSAGE AND COPY SECTION.
      IF(LTT.GE.0.AND.LTT.LE.4) GO TO 30
      WRITE(OUTP,290) IZA,MATH,MTH,LTT
      GO TO 110
C-----DETERMINE REPRESENTATION (0=ISOTROPIC, 1=LEGENDRE, 2=TABULATED,
C-----3 OR 4=LEGENDRE+TABULATED)
   30 GO TO (40,50,60,70,70),LTT+1
c-----------------------------------------------------------------------
C
C     ANGULAR DISTRIBUTIONS ARE ISOTROPIC. COPY SECTION.
C
c-----------------------------------------------------------------------
   40 TYPED(1)=TYPED(1)+1
      WRITE(OUTP,300) IZALST,MATLST,MTLST
      GO TO 110
c-----------------------------------------------------------------------
C
C     LEGENDRE COEFFICIENTS. IF REQUESTED COPY LEGENDRE DATA.
C
c-----------------------------------------------------------------------
   50 IF(IMLEGS.gt.0) go to 120
      WRITE(OUTP,310) IZALST,MATLST,MTLST
      TYPED(2)=TYPED(2)+1
      GO TO 110
c-----------------------------------------------------------------------
C
C     TABULATED DATA. IF REQUESTED COPY TABULATED DATA.
C
c-----------------------------------------------------------------------
   60 IF(IMTABS.gt.0) go to 130
      WRITE(OUTP,310) IZALST,MATLST,MTLST
      TYPED(3)=TYPED(3)+1
      GO TO 110
c-----------------------------------------------------------------------
C
C     LEGENDRE+TABULATED. IF REQUESTED COPY DATA.
C
c-----------------------------------------------------------------------
   70 IF(IMLEGS.EQ.1.AND.IMTABS.GT.0) GO TO 80
      WRITE(OUTP,320) IZALST,MATLST,MTLST
      TYPED(4)=TYPED(4)+1
      GO TO 110
c-----------------------------------------------------------------------
C
C     COPY SECTION TO SCRATCH AND SWITCH INPUT TO SCRATCH.
C
c-----------------------------------------------------------------------
   80 REWIND ISCR
C-----SWITCH OUTPUT TO SCRATCH AND SAVE LINE SEQUENCE NUMBER
      OTAPE = ISCR
      NOSEQNOW = NOSEQ
      CALL CARDI(C1,C2,L1,L2,N1,N2)
      CALL CARDO(C1,C2,L1,L2,N1,N2)
C-----LOW ENERGY LEGENDRE COEFFICIENTS
      CALL CARDI(C1,C2,L1,L2,N1L,N2L)
      CALL CARDO(C1,C2,L1,L2,N1L,N2L)
      CALL TERPI(NBTC(1),INTC(1),N1L)
c-----2019/1/3 - Additional Interpolation Law Tests
      CALL TERPTEST(NBTC(1),INTC(1),N1L,N2L,1)
      CALL TERPO(NBTC(1),INTC(1),N1L)
      DO 90 K1=1,N2L
      CALL CARDI(C1,C2,L1,L2,N1,N2)
      CALL CARDO(C1,C2,L1,L2,N1,N2)
      CALL LISTI(FL,N1)
      CALL LISTO(FL,N1)
   90 CONTINUE
C-----HIGH ENERGY TABULATED
      CALL CARDI(C1,C2,L1,L2,N1T,N2T)
      CALL CARDO(C1,C2,L1,L2,N1T,N2T)
      CALL TERPI(NBTC(N1L+1),INTC(N1L+1),N1T)
c-----2019/1/3 - Additional Interpolation Law Tests
      CALL TERPTEST(NBTC(N1L+1),INTC(N1L+1),N1T,N2T,1)
      CALL TERPO(NBTC(N1L+1),INTC(N1L+1),N1T)
      DO 100 K1=1,N2T
      CALL CARDI(C1,C2,L1,L2,N1,N2)
      CALL CARDO(C1,C2,L1,L2,N1,N2)
      CALL TERPI(NBT,INT,N1)
c-----2019/1/3 - Additional Interpolation Law Tests
      CALL TERPTEST(NBT,INT,N1,N2,1)
      CALL TERPO(NBT,INT,N1)
      ELAST = -1.0d0
      CALL POINTI(XMUIN,PTIN,N2)
      CALL POINTO(XMUIN,PTIN,N2)
  100 CONTINUE
C-----DEFINE NUMBER OF COMBINED INTERPOLATION RANGES AND ENERGIES
      N1COMBO = N1L + N1T
      N2COMBO = N2L + N2T
C-----DEFINE COMBINED INTERPOLATION LAW
      DO I = N1L+1,N1COMBO
      NBTC(I) = NBTC(I) + NBTC(N1L)
      ENDDO
C-----SETUP TO READ SCRATCH.
      ENDFILE ISCR
      REWIND  ISCR
C-----SWITCH INPUT FROM SCRATCH, OUTPUT TO FINAL FILE, AND RESTORE
C-----LINE SEQUENCE NUMBER.
      ITAPE = ISCR
      OTAPE = NTAPE2
      NOSEQ = NOSEQNOW
      GO TO 120
c-----------------------------------------------------------------------
C
C     COPY SECTION.
C
c-----------------------------------------------------------------------
  110 CALL CONTOL
      CALL COPYS
      GO TO 250
c-----------------------------------------------------------------------
C
C     PROCESS SECTION (LEGENDRE AND/OR TABULATED DATA).
C
c-----------------------------------------------------------------------
C-----IF TABLES WILL BE OUTPUT, CHANGE TO INDICATE TABULATED DATA.
  120 IF(IMLEGS.EQ.1) L2H=2
C-----OUTPUT SECTION HEAD CARD.
  130 CALL CONTOL
C-----COPY TRANSFORMATION MATRIX, IF PRESENT.
      CALL CARDI(C1,C2,L1,L2,N1,N2)
      CALL CARDO(C1,C2,L1,L2,N1,N2)
      IF(LVT.NE.1) GO TO 150
      DO 140 L=1,N1,6
      CALL COPY1
  140 CONTINUE
c-----------------------------------------------------------------------
C
C     POSSIBLE LOOP, IF BOTH LEGENDRE AND TABULATED
C
c-----------------------------------------------------------------------
  150 LOOPLTT = 1
      IF(LTT.EQ.4) LOOPLTT = 2
      DO 240 KOOPLTT = 1,LOOPLTT
      IF(LOOPLTT.EQ.2.AND.KOOPLTT.EQ.1) LTT = 1
      IF(LOOPLTT.EQ.2.AND.KOOPLTT.EQ.2) LTT = 2
C-----COPY INTERPOLATION LAW BETWEEN ENERGIES.
      CALL CARDI(C1,C2,L1,L2,N1,N2)
      CALL TERPI(NBT,INT,N1)
c-----2019/1/3 - Additional Interpolation Law Tests
      CALL TERPTEST(NBT,INT,N1,N2,1)
C-----ONLY 1 INTERPOLATION LAW OUTPUT
      IF(KOOPLTT.EQ.2) GO TO 180
C-----OUTPUT SINGLE OR COMBINED INTERPOLATION LAW
      IF(LOOPLTT.EQ.1) THEN
      CALL CARDO(C1,C2,L1,L2,N1,N2)
      CALL TERPO(NBT,INT,N1)
      ELSE
      CALL CARDO(C1,C2,L1,L2,N1COMBO,N2COMBO)
      CALL TERPO(NBTC,INTC,N1COMBO)
      ENDIF
C-----FOR LEGENDRE POLYNOMIALS TEST FOR LOG INTERPOLATION OF THE
C-----COEFFICIENTS = ILLEGAL. SINCE ALL PARAMETERS SHOULD START AT
C-----ZERO AT LOW ENERGY.
      IF(LTT.NE.1) GO TO 180
      DO 160 L=1,N1
      IF(INT(L).GE.4) GO TO 170
  160 CONTINUE
      GO TO 180
  170 WRITE(OUTP,330)
C-----DEFINE NUMBER OF ENERGIES AT WHICH LEGENDRE COEFFICIENTS ARE GIVEN
C-----AND SET UP LOOP OVER ENERGIES.
  180 NE=N2
      IF(LOOPLTT.EQ.1) TYPED(LTT+1)=TYPED(LTT+1)+NE
      IF(LOOPLTT.EQ.2) TYPED(4    )=TYPED(4    )+NE
      ELAST4=0.0d0
C-----SET COUNTER TO INDICATE EITHER NO TABULATED DATA OR NO COEFFICIENT
      IF(LTT.EQ.1) N2OUT=-1
      IF(LTT.EQ.2) LEGUSE=-1
c-----------------------------------------------------------------------
C
C     LOOP OVER INCIDENT ENERGIES.
C
c-----------------------------------------------------------------------
      DO 230 JE=1,NE
C-----READ NEXT FIRST CARD OF TAB1 OR LIST RECORD AND DEFINE ENERGY.
      CALL CARDI(C1,C2,L1,L2,N1,N2)
      E=C2
C-----CHOOSE LEGENDRE COEFFICIENTS OR TABULATED DATA.
      GO TO (190,200), LTT
c-----------------------------------------------------------------------
C
C     INPUT DATA IS LEGENDRE COEFFICIENTS. READ, RECONSTRUCT AND THIN.
C
c-----------------------------------------------------------------------
  190 CALL ANGLEG
      GO TO 210
c-----------------------------------------------------------------------
C
C     INPUT DATA IS TABULATED. READ, LINEARIZE AND THIN.
C
c-----------------------------------------------------------------------
  200 CALL ANGTAB
c-----------------------------------------------------------------------
C
C     WRITE OUTPUT REPORT...
C     IF LESS THAN REQUESTED ALLOWABLE ERROR WAS USED, IF COSINES
C     ARE NOT IN ASCENDING ORDER OR IF THE ANGULAR DISTRIBUTION DOES
C     NOT SPAN THE COSINE RANGE -1.0 TO 1.0.
C
c-----------------------------------------------------------------------
C-----OUTPUT MESSAGE IF REQUESTED ACCURACY WAS NOT ACHIEVED.
      IF(LOOPE.LE.0) GO TO 210
      CALL OUT9(ERROK,FIELD6(1,1))
      WRITE(OUTP,260) (FIELD6(M,1),M=1,11)
C-----CHECK FOR COSINES NOT IN ASCENDING ORDER.
  210 COSLST=-1.0d0
      DO 220 J=1,N2OUT
      IF(XMUOUT(J).LT.COSLST) THEN
      WRITE(OUTP,270) J,XMUOUT(J),COSLST
      ELSE
      COSLST=XMUOUT(J)
      ENDIF
  220 CONTINUE
C-----CHECK FOR COSINES SPANNING -1.0 TO 1.0
      IF(DABS(XMUOUT(1)    +1.0d0).LE.0.001d0) XMUOUT(1)    =-1.0d0
      IF(DABS(XMUOUT(N2OUT)-1.0d0).LE.0.001d0) XMUOUT(N2OUT)= 1.0d0
      IF(DABS(XMUOUT(1)+1.0d0).GT.0.001d0.OR.DABS(XMUOUT(N2OUT)-1.0d0)
     1 .GT.0.001d0) WRITE(OUTP,280) XMUOUT(1),XMUOUT(N2OUT)
C-----END OF ENERGY LOOP.
  230 CONTINUE
C-----END OF LOOP, IF BOTH LEGENDRE AND TABULATED
  240 CONTINUE
c-----Save Last Energy
      CALL MAXIE1(MATH,MFH,MTH)
      CALL MAXIE2(E,1.0d0)
C-----END OF FILE 4 SECTION - RESET I/O UNITS.
      ITAPE = NTAPE1
      OTAPE = NTAPE2
C-----COPY SECTION END LINE.
      CALL COPYS
  250 RETURN
  260 FORMAT(1X,78('-')/' WARNING...Allowable Error=',11A1/
     1 1X,78('-'))
  270 FORMAT(1X,78('-')/' WARNING...Cosines NOT in Ascending Order',
     1 I6,0P2F16.8/1X,78('-'))
  280 FORMAT(1X,78('-')/' WARNING...Cosines Do NOT Span -1 to +1',
     1 'Range=',0P2F16.8/1X,78('-'))
  290 FORMAT(I7,I5,I4,' LTT=',I6,' Expect 0 to 4...Section Copied.')
  300 FORMAT(I7,I5,I4,' Isotropic...Copied')
  310 FORMAT(I7,I5,I4,' Legendre Coefficients...Copied')
  320 FORMAT(I7,I5,I4,' Legendre Coefficients + Tabulated...Copied')
  330 FORMAT(I7,I5,I4,' WARNING - Log Interpolation for Legendre'/
     1 16X,' Coefficients Between Energies. Since All'/
     2 16X,' Coefficients Should be Zero at Low Energy,'/
     3 16X,' This is NOT Physically Possible.')
  340 FORMAT(1X,78('='))
  350 FORMAT(1X,78('-'))
      END
      SUBROUTINE ANGTAB
C=======================================================================
C
C     CONVERT TABULATED ANGULAR DISTRIBUTION TO LINEARLY INTERPOLABLE
C     FORM. THE ENTIRE LINEARLY INTERPOLABLE ANGULAR DISTRIBUTION MUST
C     BE 60000 OR FEWER POINTS. ALMOST ALL ANGULAR DISTRIBUTIONS CAN BE
C     REPRESENTED BY 60000 OR FEWER POINTS. IF THE ALLOWABLE ERROR CAUSE
C     MORE THAN 60000 POINTS TO BE GENERATED THE ALLOWABLE ERROR WILL BE
C     INCREASED BY A FACTOR OF TWO AND THE ANGULAR DISTRIBUTION WILL BE
C     RECONSTRUCTED AGAIN. THIS ALLOWABLE ERROR DOUBLING PROCESS WILL BE
C     REPEATED UNTIL THE RECONSTRUCTED ANGULAR DISTRIBUTION CAN BE
C     REPRESENTED BY 60000 OR FEWER POINTS. WHENEVER THE ALLOWABLE ERROR
C     IS INCREASED, THE ACTUAL ERROR USED WILL BE INDICATED IN THE
C     OUTPUT LISTING.
C
C=======================================================================
      INCLUDE 'implicit.h'
      INTEGER*4 OUTP,OTAPE,TYPED
      CHARACTER*1 FIELD6
      COMMON/ENDFIO/INP,OUTP,ITAPE,OTAPE
      COMMON/LEADER/C1,C2,L1,L2,N1,N2,MAT,MF,MT
      COMMON/WHERE/E,IZALST,MATLST,MTLST,NE,JE
      COMMON/INTAB/N2IN
      COMMON/OUTTAB/N2OUT
      COMMON/MAXIE/ERRMAX,ERROK,ERRUSE,LOOPE
      COMMON/MAXIM/NPTMAX,LEGMAX
      COMMON/FLAGS4/IMTABS,IMLEGS,IMFIX,IMVAR
      COMMON/MINY/SIGMIN
      COMMON/TYPES/TYPED(6)
      COMMON/LASTE/ELAST
      COMMON/FIELDC/FIELD6(11,6)
      INCLUDE 'legend.h'
C-----DEFINE ARITHMETIC STATEMENT FUNCTION FOR LINEAR-LINEAR
C-----INTERPOLATION.
      TERP(X,X1,X2,Y1,Y2)=((X-X1)*Y2+(X2-X)*Y1)/(X2-X1)
C-----DEFINE THE NUMBER OF POINTS IN THE ANGULAR DISTRIBUTION.
      N2IN=N2
c-----------------------------------------------------------------------
C
C     READ AND CHECK INTERPOLATION LAW AND ANGULAR DISTRIBUTION.
C
c-----------------------------------------------------------------------
C-----READ TAB1 INTERPOLATION LAW.
      CALL TERPI(NBT,INT,N1)
c-----2019/1/3 - Additional Interpolation Law Tests
      CALL TERPTEST(NBT,INT,N1,N2,1)
C-----INSURE THAT ANGULAR DISTRIBUTION WILL FIT IN CORE.
      IF(N2IN.LE.MAXPOINT) GO TO 10
      WRITE(OUTP,230) IZALST,MATLST,MTLST,MAXPOINT,N2IN
c-----2018/1/23 - Added on-line output
      WRITE(*   ,230) IZALST,MATLST,MTLST,MAXPOINT,N2IN
      CALL ENDERROR
C-----READ ANGULAR DISTRIBUTION INTO CORE.
   10 ELAST=-1.0D+00
      CALL POINTI(XMUIN,PTIN,N2IN)
c-----------------------------------------------------------------------
C
C     LINEARIZE EACH INTERPOLATION REGION SEPARATELY. START WITH THE
C     REQUESTED ALLOWABLE ERROR, BUT DOUBLE AS REQUIRED.
C
c-----------------------------------------------------------------------
C-----INITIALIZE ERROR AND ITERATION COUNT.
      ERRUSE=ERROK
      LOOPE=0
      GO TO 30
c-----------------------------------------------------------------------
C
C     MAXIMUM ALLOWABLE NUMBER OF POINTS EXCEEDED. DOUBLE THE ALLOWABLE
C     UNCERTAINTY AND TRY TO RECONSTRUCT DISTRIBUTION AGAIN.
C
c-----------------------------------------------------------------------
   20 ERRUSE=2.0d0*ERRUSE
      LOOPE=LOOPE+1
C-----INITIALIZE TOTAL LINEARIZED POINT COUNT.
   30 N2OUT=1
C-----DEFINE FIRST POINT IN TABLE.
      XMUOUT(1)=XMUIN(1)
      PTOUT(1)=PTIN(1)
C-----SET UP LOOP OVER INTERPOLATION RANGES.
      NR2=1
      DO 180 IR=1,N1
C-----DEFINE POINTS IN INTERPOLATION RANGE AND TYPE OF INTERPOLATION.
      NR1=NR2+1
      NR2=NBT(IR)
      INTYPE=INT(IR)
C-----HISTOGRAM OR LINEAR-LINEAR DOES NOT REQUIRE FURTHER SUBDIVISION.
      IF(INTYPE.eq.2) go to 50
      IF(INTYPE.gt.2) go to 70
C-----FOR HISTOGRAM REPLACE EACH COSINE POINT THAT IS INTERNAL TO THE
C-----INTERPOLATION COSINE RANGE BY TWO COSINE POINTS AND REPLACE EACH
C-----END POINT OF THE INTERPOLATION COSINE RANGE BY A SINGLE COSINE
C-----POINT (START OF INTERVAL HAS ALREADY BEEN STORED).
      DO 40 NPT=NR1,NR2
      KM2=N2OUT
      KM1=N2OUT+1
      N2OUT=N2OUT+2
      IF(N2OUT.GT.NPTMAX) GO TO 20
      XMUOUT(N2OUT)=XMUIN(NPT)
      PTOUT(N2OUT)=PTIN(NPT)
      XMUOUT(KM1)=XMUOUT(N2OUT)
      PTOUT(KM1)=PTOUT(KM2)
   40 CONTINUE
c-----2019/6/30 - Keep last point of histogram.
      GO TO 180
C-----FOR LINEAR-LINEAR INTERPOLATION JUST COPY POINTS TO OUTPUT ARRAY.
   50 DO 60 NPT=NR1,NR2
      N2OUT=N2OUT+1
      IF(N2OUT.GT.NPTMAX) GO TO 20
      XMUOUT(N2OUT)=XMUIN(NPT)
      PTOUT(N2OUT)=PTIN(NPT)
   60 CONTINUE
      GO TO 180
C-----SET UP LOOP OVER POINTS.
   70 DO 170 NPT=NR1,NR2
C-----DEFINE END OF INTERVAL.
      XEND=XMUIN(NPT)
      YEND=PTIN(NPT)
C-----DEFINE INDICES FOR NEXT INTERVAL.
   80 KM2=N2OUT
      KM1=N2OUT+1
      N2OUT=N2OUT+2
C-----IF CORE IS FULL REDUCE ALLOWABLE ERROR.
      IF(N2OUT.GT.NPTMAX) GO TO 20
      XMUOUT(N2OUT)=XEND
      PTOUT(N2OUT)=YEND
C-----IF CROSS SECTION IS DISCONTINUOUS (TWO OR MORE SUCCESSIVE
C-----IDENTICAL ENERGIES) TREAT AS HISTOGRAM.
      IF(XMUOUT(N2OUT).LE.XMUOUT(KM2)) GO TO 100
C-----DEFINE COSINE AND CROSS SECTION AT MIDDLE OF INTERVAL.
   90 GO TO (160,160,110,120,130),INTYPE
C-----DISCONTINUITY IN CROSS SECTION. CANNOT SUBDIVIDE COSINE RANGE.
C-----KEEP COSINE AND CROSS SECTION FROM BOTH SIDES OF THE DISCONTINUITY
  100 XMUOUT(KM1)=XMUOUT(N2OUT)
      PTOUT(KM1)=PTOUT(N2OUT)
      N2OUT=KM1
      GO TO 160
C-----LOG COSINE, LINEAR CROSS SECTION
  110 XNKM1=DSQRT(XMUOUT(KM2)*XMUOUT(N2OUT))
      YNKM1=0.5d0*(PTOUT(KM2)+PTOUT(N2OUT))
      GO TO 140
C-----LINEAR COSINE, LOG CROSS SECTION
  120 XNKM1=0.5d0*(XMUOUT(KM2)+XMUOUT(N2OUT))
      YNKM1=DSQRT(PTOUT(KM2)*PTOUT(N2OUT))
      GO TO 140
C-----LOG COSINE, LOG CROSS SECTION
  130 XNKM1=DSQRT(XMUOUT(KM2)*XMUOUT(N2OUT))
      YNKM1=DSQRT(PTOUT(KM2)*PTOUT(N2OUT))
C-----DETERMINE IF THE EXACT VALUE CAN BE APPROXIMATED TO WITHIN THE
C-----ALLOWABLE ERROR BY LINEAR-LINEAR INTERPOLATION.
  140 YAPROX=TERP(XNKM1,XMUOUT(KM2),XMUOUT(N2OUT),
     1 PTOUT(KM2),PTOUT(N2OUT))
C-----TEST FOR CONVERGENCE.
      IF(DABS(YNKM1-YAPROX).LE.DABS(ERRUSE*YNKM1)) GO TO 150
C-----NO CONVERGENCE. SHORTEN INTERVAL.
      XMUOUT(N2OUT)=XNKM1
      PTOUT(N2OUT)=YNKM1
      GO TO 90
C-----CONVERGENCE.
  150 XMUOUT(KM1)=XNKM1
      PTOUT(KM1)=YNKM1
C-----IF NOT END OF CURRENT INTERVAL CONTINUE. OTHERWISE
C-----MOVE TO NEXT INTERVAL.
  160 IF(XMUOUT(N2OUT).LT.XEND) GO TO 80
  170 CONTINUE
  180 CONTINUE
C-----IF REQUESTED THIN ANGULAR DISTRIBUTIONS.
      IF(IMTABS.EQ.2) CALL THIN
C-----DEFINE INTEGRAL OF DISTRIBUTION.
      SUMX=XINT(XMUOUT,PTOUT,N2OUT)
C-----PRINT DESCRIPTION OF SECTION.
      CALL OUT9(E,FIELD6(1,2))
      WRITE(OUTP,240) IZALST,MATLST,MTLST,(FIELD6(M,2),M=1,11),
     1 N2IN,N2OUT,SUMX
      WRITE(*   ,240) IZALST,MATLST,MTLST,(FIELD6(M,2),M=1,11),
     1 N2IN,N2OUT,SUMX
C-----CHECK FOR NEGATIVE CROSS SECTIONS.
      CALL POSTIV(XMUMIN,PTMIN,IMNEG)
C-----PRINT WARNING IF DISTRIBUTION IS NEGATIVE.
      IF(IMNEG.LE.0) GO TO 210
      WRITE(OUTP,270) IMNEG,XMUMIN,PTMIN
      TYPED(5) = TYPED(5) + 1
C-----IF REQUESTED FORCE ANGULAR DISTRIBUTION TO BE POSITIVE.
      IF(IMFIX.NE.2) GO TO 210
c-----------------------------------------------------------------------
C
C     DEFINE MINIMUM ALLOWABLE SIGMA AND MAXIMUM ALLOWABLE CHANGE IN
C     EACH COEFFICIENT.
C
c-----------------------------------------------------------------------
      DO 190 JTAB=1,ITAB
      IF(MATLST.LT.MATAB1(JTAB).OR.MATLST.GT.MATAB2(JTAB)) GO TO 190
      IF(MTLST.LT.MTAB1(JTAB).OR.MTLST.GT.MTAB2(JTAB)) GO TO 190
      IF(E.LT.ETAB1(JTAB).OR.E.GT.ETAB2(JTAB)) GO TO 190
      GO TO 200
  190 CONTINUE
      JTAB=ITAB
  200 SIGMIN=SIGTAB(JTAB)
C-----FORCE ANGULAR DISTRIBUTION TO BE POSITIVE.
      CALL LOWTAB(PTMIN,2)
C-----OUTPUT WARNING IF ANGULAR DISTRIBUTION WAS NOT NORMALIZED.
  210 IF(DABS(SUMX-1.0D+00).GT.0.05D+00) WRITE(OUTP,260)
C-----CHECK FOR ASCENDING ENERGIES.
      IF(E.GT.ELAST4) GO TO 220
      CALL OUT9(ELAST4,FIELD6(1,1))
      WRITE(OUTP,250) ((FIELD6(M,J),M=1,11),J=1,2)
      TYPED(6) = TYPED(6) + 1
  220 ELAST4=E
C-----OUTPUT ANGULAR DISTRIBUTION.
      CALL TAB4
      RETURN
  230 FORMAT(I7,I5,I4,
     1 ' Angular Distribution Contains Over ',I6,' Points'/
     2 16X,' N2 =',I6,' (Execution Terminated)')
  240 FORMAT(I7,I5,I4,11A1,11X,2I11,F11.6)
  250 FORMAT(1X,78('-')/' WARNING - Energy is NOT in Ascending Order'/
     1 ' Last E =',11A1,' eV, Current E =',11A1,' eV'/
     2 1X,78('-'))
  260 FORMAT(1X,78('-')/' WARNING - Angular Distribution NOT',
     1 ' Normalized to within 5%'/1X,78('-'))
  270 FORMAT(1X,78('-')/' Negative Angular Distribution at',I5,
     1 ' Points.'/' Mimimum at Cosine=',F11.6,' Value=',F11.7/
     2 1X,78('-'))
      END
      SUBROUTINE ANGLEG
C=======================================================================
C
C     RECONSTRUCT ANGULAR DISTRIBUTION (PTOUT) AT AN ARBITRARY SET OF
C     COSINES (XMUOUT) FOR ANY NUMBER OF COSINES (N2OUT). THIS ROUTINE
C     ASSUMES THAT THE ZERO ORDER COEFFICIENT F-0=0.5 (AS A NORMAL-
C     IZATION) AND THAT ANY NUMBER OF COEFFICIENTS (NL) ARE GIVEN IN
C     THE TABLE (FL) STARTING WITH F-1 AND EXTENDING THROUGH F-NL.
C     THE LEGENDRE COEFFICIENTS ARE IN SINGLE PRECISION FORM, BUT THE
C     LEGENDRE POLYNOMIALS AND ALL RECONSTRUCTION CALCULATIONS WILL
C     BE PERFORMED IN DOUBLE PRECISION (TO AVOID ROUND-OFF PROBLEMS).
C
C=======================================================================
      INCLUDE 'implicit.h'
      INTEGER*4 OUTP,OTAPE,TYPED
      CHARACTER*1 FIELD6
      COMMON/ENDFIO/INP,OUTP,ITAPE,OTAPE
      COMMON/LEADER/C1,C2,L1,L2,N1,N2,MAT,MF,MT
      COMMON/WHERE/E,IZALST,MATLST,MTLST,NE,JE
      COMMON/OUTTAB/N2OUT
      COMMON/TYPES/TYPED(6)
      COMMON/MAXIM/NPTMAX,LEGMAX
      COMMON/FLAGS4/IMTABS,IMLEGS,IMFIX,IMVAR
      COMMON/MINY/SIGMIN
      COMMON/FIELDC/FIELD6(11,6)
      INCLUDE 'legend.h'
      DIMENSION DFLTIM(3)
C-----DEFINE ALLOWABLE CHANGES IN COEFFICIENTS (0.25,0.5 AND 1 PER-CENT)
      DATA DFLTIM/0.25D+00,0.5D+00,1.0D+00/
      DATA LEGLST/0/
c-----------------------------------------------------------------------
C
C     READ COEFFICIENTS. DURING RECONSTRUCTION IGNOR HIGHER ORDER
C     COEFFICIENTS WHICH ARE 0 (ALL COEFFICIENTS READ WILL BE OUTPUT
C     SINCE THIS IS IMPORTANT FOR INTERPOLATION IN ENERGY).
C
c-----------------------------------------------------------------------
C-----READ LEGENDRE COEFFICIENTS (IF ANY).
      LEGIN=N1
      LEGUSE=LEGIN
      IF(LEGIN.LT.1) GO TO 40
      CALL LISTI(PTOUT,LEGIN)
C-----IGNOR HIGHER ZERO COEFFICIENTS IN CALCULATIONS.
      IF(LEGUSE.GT.LEGMAX) LEGUSE=LEGMAX
      LEGTOP=LEGUSE
      DO 10 L=1,LEGTOP
      IF(PTOUT(LEGUSE).ne.0.0D+0) go to 20
      LEGUSE=LEGUSE-1
   10 CONTINUE
   20 IF(LEGUSE.LE.0) LEGUSE=1
C-----TRANSFER ALL COEFFICIENTS TO ARRAY WHICH WILL BE USED.
      DO 30 L=1,LEGUSE
      FL(L)=PTOUT(L)
      FLOLD(L)=FL(L)
      NEWFL(L)=0
   30 CONTINUE
c-----------------------------------------------------------------------
C
C     KEEP COEFFICIENTS AT LAST 3 ENERGIES FOR ENERGY VARIATION TEST.
C
c-----------------------------------------------------------------------
   40 IF(JE.le.1) go to 70
C-----MOVE FORWARD COEFFICIENTS FROM PRECEDING ENERGIES.
      DO 60 L=2,3
      LM1=L-1
      LEGO=LKEEP(L)
      LKEEP(LM1)=LKEEP(L)
      EKEEP(LM1)=EKEEP(L)
      IF(LEGO.LE.0) GO TO 60
      DO 50 J=1,LEGO
      FLKEEP(J,LM1)=FLKEEP(J,L)
   50 CONTINUE
   60 CONTINUE
C-----SAVE CURRENT SET OF COEFFICIENTS AT END OF TABLE.
   70 LKEEP(3)=LEGUSE
      EKEEP(3)=E
      IF(LEGUSE.LE.0) GO TO 90
      DO 80 J=1,LEGUSE
      FLKEEP(J,3)=FLOLD(J)
   80 CONTINUE
      GO TO 100
   90 LEGUSE=0
      FL(1)=0.0d0
C-----RECONSTRUCT ANGULAR DISTRIBUTION.
  100 CALL ANGLEN
C-----SEARCH FOR AND INSERT MINIMA.
      CALL MINNIE
C-----DEFINE INTEGRAL.
      SUMX=XINT(XMUOUT,PTOUT,N2OUT)
C-----PRINT DESCRIPTION OF SECTION.
      CALL OUT9(E,FIELD6(1,1))
      IF(LEGIN.NE.LEGUSE) GO TO 110
      WRITE(OUTP,340) IZALST,MATLST,MTLST,(FIELD6(M,1),M=1,11),
     1 LEGIN,N2OUT,SUMX
      WRITE(*   ,340) IZALST,MATLST,MTLST,(FIELD6(M,1),M=1,11),
     1 LEGIN,N2OUT,SUMX
      GO TO 120
  110 WRITE(OUTP,350) IZALST,MATLST,MTLST,(FIELD6(M,1),M=1,11),
     1 LEGIN,LEGUSE,N2OUT,SUMX
      WRITE(*   ,350) IZALST,MATLST,MTLST,(FIELD6(M,1),M=1,11),
     1 LEGIN,LEGUSE,N2OUT,SUMX
c-----------------------------------------------------------------------
C
C     CHECK FOR LEGENDRE COEFFICIENTS THAT START AT NON-ZERO VALUES
C     AFTER FIRST ENERGY (THIS CAN LEAD TO ERRORS WHEN INTERPOLATING
C     TO LOWER ENERGIES).
C
c-----------------------------------------------------------------------
C-----NO TEST IF COEFFICIENT TESTS ARE OFF.
  120 IF(IMVAR.LE.0) GO TO 150
      IF(JE.le.1) go to 140
C-----ONLY TEST WHEN NUMBER OF COEFFICIENTS INCREASES.
      IF(LEGUSE.LE.LEGLST) GO TO 140
      LL=LEGLST+1
      LOUT=0
C-----PRINT WARNING IF COEFFICIENT STARTS AT A NON-ZERO VALUE.
      DO 130 L=LL,LEGUSE
      IF(DABS(FLKEEP(L,3)).EQ.0.0d0) GO TO 130
      IF(LOUT.EQ.0) WRITE(OUTP,430)
      LOUT=1
      CALL OUT9(FLKEEP(L,3),FIELD6(1,1))
      WRITE(OUTP,440) L,(FIELD6(M,1),M=1,11)
  130 CONTINUE
      IF(LOUT.NE.0) WRITE(OUTP,450)
C-----SAVE NUMBER OF COEFFICIENTS.
  140 LEGLST=LEGUSE
C-----PERFORM ENERGY VARIATION TESTS.
      CALL EVAR1
C-----OUTPUT WARNING IF ANGULAR DISTRIBUTION WAS NOT NORMALIZED.
  150 IF(DABS(SUMX-1.0D+00).GT.0.05D+00) WRITE(OUTP,380)
C-----CHECK FOR ASCENDING ENERGIES.
      IF(E.GT.ELAST4) GO TO 160
      CALL OUT9(ELAST4,FIELD6(1,1))
      CALL OUT9(E     ,FIELD6(1,2))
      WRITE(OUTP,370) ((FIELD6(M,J),M=1,11),J=1,2)
      TYPED(6) = TYPED(6) + 1
  160 ELAST4=E
C-----CHECK FOR TOO MANY COEFFICIENTS.
      IF(LEGIN.GT.LEGMAX) WRITE(OUTP,390) LEGIN,LEGMAX
C-----CHECK FOR NEGATIVE CROSS SECTIONS.
      CALL POSTIV(XMUMIN,PTMIN,IMNEG)
C-----IF DISTRIBUTION IS NEGATIVE PRINT WARNING.
      IF(IMNEG.LE.0) GO TO 270
      WRITE(OUTP,420) IMNEG,XMUMIN,PTMIN
      TYPED(5) = TYPED(5) + 1
C-----IF CORRECTION IS NOT REQUESTED THERE IS NOTHING ELSE TO DO.
      IF(IMFIX.LE.0) GO TO 270
c-----------------------------------------------------------------------
C
C     DEFINE MINIMUM ALLOWABLE SIGMA AND MAXIMUM ALLOWABLE CHANGE IN
C     EACH COEFFICIENT.
C
c-----------------------------------------------------------------------
      DO 170 JTAB=1,ITAB
      IF(MATLST.LT.MATAB1(JTAB).OR.MATLST.GT.MATAB2(JTAB)) GO TO 170
      IF(MTLST.LT.MTAB1(JTAB).OR.MTLST.GT.MTAB2(JTAB)) GO TO 170
      IF(E.LT.ETAB1(JTAB).OR.E.GT.ETAB2(JTAB)) GO TO 170
      GO TO 180
  170 CONTINUE
      JTAB=ITAB
  180 SIGMIN=SIGTAB(JTAB)
      DFLCHN=DFLTAB(JTAB)
C-----IF REQUESTED FORCE ANGULAR DISTRIBUTION TO BE POSITIVE.
      IF(IMFIX.NE.2) GO TO 190
      CALL LOWTAB(PTMIN,1)
      GO TO 270
c-----------------------------------------------------------------------
C
C     USE ORIGINAL ANGULAR DISTRBUTION WITHOUT THINNING TO TRY TO
C     ELIMINATE NEGATIVE VALUES.
C
c-----------------------------------------------------------------------
C-----RECONSTRUCT ANGULAR DISTRIBUTION.
  190 CALL ANGLEN
C-----SEARCH FOR AND INSERT MINIMA.
      CALL MINNIE
c-----------------------------------------------------------------------
C
C     SET UP ITERATION LOOP TO ELIMINATE NEGATIVE VALUES.
C     ITERATION LOOP CORRESPONDS TO ALLOWING A MAXIMUM CHANGE IN EACH
C     COEFFICIENT OF UP TO 0.25, 0.5 OR 1 PER-CENT (OR 0.25, 0.5 AND
C     1 TIMES THE INPUT ALLOWABLE CHANGE).
C
c-----------------------------------------------------------------------
      PTMINX=PTMIN
      KPASS=0
      DO 220 LOOPPC=1,3
C-----DEFINE ALLOWABLE CHANGE.
      DFLMAX=DFLCHN*DFLTIM(LOOPPC)
      PTMIN=PTMINX
C-----INITIALIZE COEFFICIENTS TO ORIGINAL VALUES AND INITIALIZE
C-----COFFICIENT CHANGED FLAGS OFF.
      DO 200 L=1,LEGUSE
      FL(L)=FLOLD(L)
      NEWFL(L)=0
  200 CONTINUE
C-----LOOP OVER COEFFICIENTS TO CHANGE.
      DO 210 LOOPL=1,LEGUSE
      KPASS=KPASS+1
C-----CHANGE COEFFICIENTS TO TRY TO MAKE DISTRIBUTION POSITIVE AT
C-----COSINE=XMUMIN.
      CALL LOWLEG(XMUMIN,PTMIN,NEWLEG)
C-----RE-CALCULATE ANGULAR DISTRIBUTION WITH MODIFIED COEFFICIENTS
      CALL ANGLEN
C-----IS NO COEFFICIENTS COULD BE CHANGED INCREASE ALLOWABLE ERROR AND
C-----TRY AGAIN.
      IF(NEWLEG.ge.0) go to 220
C-----COEFFICIENTS CHANGED TO ELIMINATE NEGATIVE AT COSINE=XMUMIN.
C-----CHECK FOR NEGATIVE VALUES AT ALL OTHER COSINES.
      CALL POSTIV(XMUMIN,PTMIN,IMNEG)
C-----IF DISTRIBUTION IS NOW POSITIVE AND AT LEAST EQUAL TO MINIMUM
C-----ALLOWABLE VALUE STOP ITERATION.
      IF(IMNEG.LE.0.AND.PTMIN.GE.SIGMIN) GO TO 250
C-----END OF COEFFICIENT CHANGE LOOP. TRY TO CHANGE MORE COEFFICIENTS.
  210 CONTINUE
C-----END OF ALLOWABLE PER-CENT CHANGE IN COEFFICIENT LOOP.
C-----INCREASE ALLOWABLE ERROR AND TRY AGAIN.
  220 CONTINUE
C-----DISTRIBUTION CANNOT BE MADE POSITIVE WITH ACCEPTABLE MINIMUM.
C-----IF MODIFIED DISTRIBUTION IS POSITIVE USE IT. OTHERWISE USE
C-----ORIGINAL DISTRIBUTION.
      IF(PTMIN.LT.0.0d0) GO TO 230
      WRITE(OUTP,400) SIGMIN,PTMIN
      GO TO 250
  230 WRITE(OUTP,410)
      DO 240 I=1,LEGUSE
      FL(I)=FLOLD(I)
      NEWFL(I)=0
  240 CONTINUE
      CALL ANGLEN
c-----------------------------------------------------------------------
C
C     LIST MODIFIED COEFFICIENTS.
C
c-----------------------------------------------------------------------
  250 II=0
      DO 260 L=1,LEGUSE
      IF(NEWFL(L).LE.0) GO TO 260
      IF(II.EQ.0) WRITE(OUTP,320)
      II=1
      PC=100.0d0*(FL(L)-FLOLD(L))/FLOLD(L)
      WRITE(OUTP,330) L,FLOLD(L),FL(L),PC
  260 CONTINUE
      IF(II.NE.0) WRITE(OUTP,450)
c-----------------------------------------------------------------------
C
C     OUTPUT ANGULAR DISTRIBUTION OR LEGENDRE COEFFICIENTS.
C
c-----------------------------------------------------------------------
  270 IF(IMLEGS.gt.1) go to 280
C-----OUTPUT ANGULAR DISTRIBUTION.
      CALL TAB4
      GO TO 290
C-----OUTPUT LEGENDRE COEFFICIENTS.
  280 CALL LIST4
C-----CHECK LEGENDRE COEFFICIENTS BETWEEN -1 TO 1.
  290 IF(LEGUSE.LE.0) GO TO 310
      DO 300 I=1,LEGUSE
      IF(DABS(FL(I)).GT.1.0d0) WRITE(OUTP,360) I,FL(I)
  300 CONTINUE
  310 RETURN
  320 FORMAT(' Coefficients Modified to Eliminate Negative Value',
     1 1HS/' Index   Old Value   New Value    per-cent Change')
  330 FORMAT(I6,3F12.6)
  340 FORMAT(I7,I5,I4,11A1,I5,17X,I11,F11.6)
  350 FORMAT(I7,I5,I4,11A1,I5,' (',I4,')',10X,I11,F11.6)
  360 FORMAT(1X,78('-')/' WARNING - Legendre Coefficient=',I4,F11.6,
     1 ' (Expect -1 TO 1)')
  370 FORMAT(1X,78('-')/' WARNING - Energy is NOT in Ascending Order'/
     1 ' Last E =',11A1,' eV, Current E =',11A1,' eV')
  380 FORMAT(1X,78('-')/' WARNING - Angular Distribution NOT',
     1 ' Normalized to within 5%'/1X,78('-'))
  390 FORMAT(1X,78('-')/' WARNING - Too Many Legendre Coefficients'/
     1 ' Read',I4,' Only Used First',I4,' All Others Ignored'/
     2 1X,78('-'))
  400 FORMAT(1X,78('-')/' WARNING - Cannot Modify Coefficients to Make'/
     1 ' Distribution More Than Minimum=',F11.6/
     2 ' However, Modified Distribution is Positive with',
     3 ' Minimum=',F11.6/' Will Output Modified Coefficients or',
     4 ' Angular Distribution'/1X,78('-'))
  410 FORMAT(1X,78('-')/' WARNING - Cannot Modify Coefficients to Make'/
     1 ' Distribution Positive'/' Will Output Unmodified',
     2 ' Coefficients or Angular Distribution'/1X,78('-'))
  420 FORMAT(1X,78('-')/' WARNING - Negative Angular Distribution at',
     1 I5,' Points.'/
     1 ' Minimum at Cosine=',F11.6,' Value=',F11.7/1X,78('-'))
  430 FORMAT(1X,78('-')/' WARNING - Coefficients do NOT Start Equal to',
     1 ' Zero.'/' Interpolation to Lower Energies May Cause Errors.'/
     2 '   L  Coefficient')
  440 FORMAT(I4,2X,11A1)
  450 FORMAT(1X,78('-'))
      END
      SUBROUTINE EVAR1
C=======================================================================
C
C     PERFORM ENERGY VARIATION TESTS.
C
C=======================================================================
      INCLUDE 'implicit.h'
      INTEGER*4 OUTP,OTAPE
      CHARACTER*1 FIELD6
      COMMON/ENDFIO/INP,OUTP,ITAPE,OTAPE
      COMMON/WHERE/E,IZALST,MATLST,MTLST,NE,JE
      COMMON/FIELDC/FIELD6(11,6)
      INCLUDE 'legend.h'
C-----NO TEST FOR FIRST ENERGY.
      IF(JE.LE.1) GO TO 70
C-----CONVERT ENERGIES TO OUTPUT FORM.
      CALL OUT9(EKEEP(2),FIELD6(1,1))
      CALL OUT9(EKEEP(3),FIELD6(1,2))
C-----COMPARE NUMBER OF LEGENDRE COEFFICIENTS AT LAST ENERGY AND
C-----CURRENT ENERGY.
      IF(LKEEP(2).LE.LKEEP(3)) GO TO 10
      WRITE(OUTP,80) LKEEP(2),(FIELD6(M,1),M=1,11),
     1               LKEEP(3),(FIELD6(M,2),M=1,11)
C-----COMPARE COEFFICIENTS TO INSURE THAT THEY ARE MONOTONICALLY
C-----CHANGING AS A FUNCTION OF ENERGY (IN ABSOLUTE VALUE AND SIGN).
   10 LTOP=LKEEP(2)
      IF(LKEEP(3).GT.LTOP) LTOP=LKEEP(3)
      IF(LTOP.LE.0) GO TO 40
      IERR=0
      DO 30 L=1,LTOP
      IF(LKEEP(2).LT.L.OR.LKEEP(3).LT.L) GO TO 30
      IF(DABS(FLKEEP(L,2)).GT.DABS(FLKEEP(L,3))) GO TO 20
      IF(FLKEEP(L,2).GT.0.0d0.AND.FLKEEP(L,3).LT.0.0d0) GO TO 20
      IF(FLKEEP(L,2).LT.0.0d0.AND.FLKEEP(L,3).GT.0.0d0) GO TO 20
      GO TO 30
   20 IF(IERR.EQ.0) WRITE(OUTP,90)
      IERR=1
C-----CONVERT COEFFICIENTS TO OUTPUT FORM.
      CALL OUT9(FLKEEP(L,2),FIELD6(1,3))
      CALL OUT9(FLKEEP(L,3),FIELD6(1,4))
      WRITE(OUTP,100) L,(FIELD6(M,3),M=1,11),(FIELD6(M,1),M=1,11),
     1                 (FIELD6(M,4),M=1,11),(FIELD6(M,2),M=1,11)
   30 CONTINUE
      IF(IERR.NE.0) WRITE(OUTP,130)
C-----COMPARE COEFFICIENTS TO INSURE THAT THEY ARE MONOTONICALLY
C-----DECREASING AS A FUNCTION OF L.
   40 LTOP=LKEEP(3)
      IF(LTOP.LE.0) GO TO 70
      FLAST=1.0d0
      IERR=0
      DO 60 L=1,LTOP
      IF(DABS(FLKEEP(L,3)).LE.DABS(FLAST)) GO TO 50
      IF(IERR.EQ.0) WRITE(OUTP,110)
      LM1=L-1
C-----CONVERT COEFFICIENTS TO OUTPUT FORM.
      CALL OUT9(FLAST      ,FIELD6(1,3))
      CALL OUT9(FLKEEP(L,3),FIELD6(1,4))
      WRITE(OUTP,120) LM1,(FIELD6(M,3),M=1,11),
     1                  L,(FIELD6(M,4),M=1,11)
      IERR=1
   50 FLAST=FLKEEP(L,3)
   60 CONTINUE
      IF(IERR.NE.0) WRITE(OUTP,130)
   70 RETURN
   80 FORMAT(1X,78('-')/' WARNING - ',I3,' Coefficients at E=',
     1 11A1,' eV'/
     2 '       Only',I3,' Coefficients at E=',
     3 11A1,' eV'/1X,78('-'))
   90 FORMAT(1X,78('-')/' WARNING - Coefficient Has Decreased or',
     1 ' Changed Sign')
  100 FORMAT(' L=',I3,1X,11A1,' at E=',11A1,' eV'/
     1                7X,11A1,' at E=',11A1,' eV')
  110 FORMAT(1X,78('-')/' WARNING - Coefficients do NOT Decrease',
     1 ' with L')
  120 FORMAT(' L=',I3,1X,11A1,' L=',I3,1X,11A1)
  130 FORMAT(1X,78('-'))
      END
      SUBROUTINE ANGLEN
C=======================================================================
C
C     CALCULATE ANGULAR DISTRIBUTION.
C
C=======================================================================
      INCLUDE 'implicit.h'
      COMMON/OUTTAB/N2OUT
      COMMON/MAXIE/ERRMAX,ERROK,ERRUSE,LOOPE
      INCLUDE 'legend.h'
c-----------------------------------------------------------------------
C
C     USE ONLY 2 POINTS FOR ISOTROPIC OR LINEARLY ANISOTROPIC.
C
c-----------------------------------------------------------------------
      IF(LEGUSE.GT.1) GO TO 10
      N2OUT=2
      XMUOUT(1)=-1.0d0
      XMUOUT(2)=1.0
      CALL ANGLE1(XMUOUT(1))
      PTOUT(1)=SUM
      CALL ANGLE1(XMUOUT(2))
      PTOUT(2)=SUM
      RETURN
c-----------------------------------------------------------------------
C
C     DEFINE STARTING COSINE GRID.
C
c-----------------------------------------------------------------------
   10 NMID=2*LEGUSE+1
      NSTART=NMID+2*LEGUSE
C-----05/01/07 - CORRECTED FOR UNIFORM GRID
      DMU=1.0d0/FLOAT(NMID-1)
      XMUBASE(1)=-1.0d0
      DO 20 I=2,NSTART
      XMUBASE(I)=XMUBASE(I-1)+DMU
      IF(I.EQ.NMID) XMUBASE(I)=0.0d0
   20 CONTINUE
      XMUBASE(NSTART)=1.0d0
c-----------------------------------------------------------------------
C
C     INITIALIZE ALLOWABLE UNCERTAINTY.
C
c-----------------------------------------------------------------------
      ERRUSE=ERROK
c-----------------------------------------------------------------------
C
C     ITERATE TO CONVERGENCE.
C
c-----------------------------------------------------------------------
      XMUOUT(1)=-1.0d0
      CALL ANGLE1(XMUOUT(1))
      PTOUT(1)=SUM
   30 NBASE=1
      N2OUT=1
C-----NEXT INTERVAL.
   40 NBASE=NBASE+1
      CALL ANGLE1(XMUBASE(NBASE))
      PTBASE=SUM
C-----DEFINE VALUES AT END OF INTERVAL.
   50 N2OUT=N2OUT+1
      IF(N2OUT.GT.MAXPOINT) GO TO 100
C-----05/01/07 - CORRECTED TO PREVENT COSINES NOT IN ASCENDING ORDER.
   60 IF(NBASE.GE.NSTART) GO TO 70
      IF(XMUBASE(NBASE).LT.XMUOUT(N2OUT-1)) THEN
      NBASE = NBASE + 1
      GO TO 60
      ENDIF
   70 XMUOUT(N2OUT)=XMUBASE(NBASE)
      PTOUT(N2OUT)=PTBASE
C-----CHECK FOR CONVERGENCE.
   80 XMUMID=0.5d0*(XMUOUT(N2OUT)+XMUOUT(N2OUT-1))
      CALL ANGLE1(XMUMID)
      PTMID=SUM
      PTAV=0.5d0*(PTOUT(N2OUT)+PTOUT(N2OUT-1))
      IF(DABS(PTMID-PTAV).LE.ERRUSE*DABS(PTMID)) GO TO 90
C-----NO CONVERGENCE. INTERVAL HALF, UNLESS THE VALUE IS NEGATIVE.
      IF(PTMID.LT.0.0d0) GO TO 90
      XMUOUT(N2OUT)=XMUMID
      PTOUT(N2OUT)=PTMID
      GO TO 80
C-----CONVERGENCE. IF NOT THE END OF AN INTERVAL CONTINUE IN CURRENT
C-----INTERVAL.
   90 IF(XMUOUT(N2OUT).LT.XMUBASE(NBASE)) GO TO 50
C-----END OF INTERVAL. CONTINUE UP TO COSINE = 1.0
      IF(NBASE.lt.NSTART) go to 40
      go to 110
C-----TOO MANY POINTS. DOUBLE ALLOWABLE UNCERTAINTY AND TRY AGAIN.
  100 ERRUSE=2.0d0*ERRUSE
      GO TO 30
  110 RETURN
      END
      SUBROUTINE ANGLE1(XMUDUM)
C=======================================================================
C
C     RECONSTRUCT ANGULAR DISTRIBUTION FROM LEGENDRE COEFFICIENTS AT
C     COSINE=XMU.
C
C     RESULTS ARE RETURNED IN COMMON
C
C     SUM  = SUM OF ALL TERMS
C     SUMN = CONTRIBUTION OF EACH LEGENDRE COEFFICIENT
C     PN   = VALUE OF EACH LEGENDRE POLYNOMIAL
C
C     2017/2/28 = UPDATED
C     2017/2/28   XMUDUM = Dummy input - internaaly if near 0, set = 0
C
C=======================================================================
      INCLUDE 'implicit.h'
      INCLUDE 'legend.h'
C-----DEFINE CONSTANTS.
      DATA HALF/5.0D-01/
c-----Correct for roundoff = set small cos = 0
      XMU = XMUDUM
      if(DABS(XMU).lt.1.0d-10) XMU = 0.0d0
C-----------------------------------------------------------------------
C
C     Isotropic
C
C-----------------------------------------------------------------------
      SUM=HALF
      IF(LEGUSE.lt.1) return   ! Isotropic
C-----------------------------------------------------------------------
c
C     Linearly Anisotropic = add f1 term to sum
c
C-----------------------------------------------------------------------
      PN(1)=XMU
      SUMN(1)=FLMULT(1)*FL(1)*PN(1)
      SUM  = SUM + SUMN(1)     ! SUM already f0
      IF(LEGUSE.eq.1) return   ! Linear Isotopic
C-----------------------------------------------------------------------
c
C     Quadratically Anisotropic = and f2 term to sum
c
C-----------------------------------------------------------------------
      PN(2)=PCON1(2)*XMU*PN(1)+PCON2(2)       ! PN(0) = 1
      SUMN(2)=FLMULT(2)*FL(2)*PN(2)
      SUM = SUM + SUMN(2)        ! SUM already f0 and f1
      IF(LEGUSE.eq.2) return     ! quadratic f0, f1 and f2
C-----------------------------------------------------------------------
C
C     Higher Order - Use Legendre Recursion. SUM already f0 + f1 + f2
C
C-----------------------------------------------------------------------
      DO L=3,LEGUSE
      PN(L)=PCON1(L)*XMU*PN(L-1)+PCON2(L)*PN(L-2)
      SUMN(L)=FLMULT(L)*FL(L)*PN(L)
      SUM = SUM + SUMN(L)
      ENDDO
      RETURN
      END
      REAL*8 FUNCTION XINT(X,Y,I)
C=======================================================================
C
C     DEFINE THE INTEGRAL USING TABULATED VALUES (X,Y) AND ASSUMING
C     LINEAR INTERPOLATION BETWEEN TABULATED VALUES.
C
C=======================================================================
      INCLUDE 'implicit.h'
      DIMENSION X(*),Y(*)
      DATA TWO/2.0D+00/
      SUMX=0.0D+00
      IF(I.LT.2) GO TO 20
      DO 10 J=2,I
      SUMX=SUMX+(X(J)-X(J-1))*(Y(J)+Y(J-1))
   10 CONTINUE
   20 XINT=SUMX/TWO
      RETURN
      END
      SUBROUTINE MINNIE
C=======================================================================
C
C     SEARCH FOR AND INSERT MINIMA INTO ANGULAR DISTRIBUTION.
C
C=======================================================================
      INCLUDE 'implicit.h'
      COMMON/INTAB/N2IN
      COMMON/OUTTAB/N2OUT
      INCLUDE 'legend.h'
      DIMENSION XMUEND(3),PTEND(3)
C-----NO INTERNAL MINIMA POSSIBLE IF LESS THAN 3 POINTS.
      IF(N2OUT.LT.3) GO TO 100
C-----SAVE FIRST TWO POINTS.
      N2IN=2
      XMUIN(1)=XMUOUT(1)
      PTIN(1)=PTOUT(1)
      XMUIN(2)=XMUOUT(2)
      PTIN(2)=PTOUT(2)
C-----FIND INTERNAL MININA. INITIALIZE SIGN OF SLOPE.
      DSIGN=1.0d0
      IF(PTOUT(2).LT.PTOUT(1)) DSIGN=-1.0d0
      DO 80 I2OUT=3,N2OUT
      IM1=I2OUT-1
      DP=PTOUT(I2OUT)-PTOUT(IM1)
      IF(DP*DSIGN.ge.0.0d0) go to 70
C-----SLOPE HAS CHANGED SIGN. LAST POINT IS MAXIMA OR MINIMA. IT IS A
C-----MINIMUM IF CURRENT SLOPE IS POSITIVE. IF MINIMA ITERATE TO FIND
C-----LOWEST VALUE.
      DSIGN=-DSIGN
      IF(DP.le.0.0d0) go to 70
C-----MINIMUM IS BETWEEN PTOUT(I2OUT-2) AND PTOUT(I2OUT). DEFINE TWO
C-----INTERVALS BETWEEN XMUOUT(I2OUT-2) AND XMUOUT(I2OUT).
      XMUEND(1)=XMUOUT(I2OUT-2)
      PTEND(1)=PTOUT(I2OUT-2)
      XMUEND(2)=XMUOUT(IM1)
      PTEND(2)=PTOUT(IM1)
      XMUEND(3)=XMUOUT(I2OUT)
      PTEND(3)=PTOUT(I2OUT)
C-----INITIALIZE MINIMUM COORDINATES.
      XMUMIN=XMUEND(2)
      PTMIN=PTEND(2)
C-----PERFORM BINARY SEARCH FOR LOWEST VALUE.
      DO 30 LOOP=1,10
C-----TRY EACH OF THE TWO SUB-INTERVALS.
      DO 10 J=1,2
      XMUMID=(XMUEND(J)+XMUEND(J+1))/2.0d0
      CALL ANGLE1(XMUMID)
      PTMID=SUM
      IF(PTMID.LT.PTMIN) GO TO 20
   10 CONTINUE
C-----NO SMALLER VALUE FOUND. USE CURRENT LOWSET VALUE.
      GO TO 40
C-----SMALLER VALUE FOUND BETWEEN XMUEND(J) AND XMUEND(J+1). SHORTEN
C-----INTERVAL AND CONTINUE BINARY SEARCH.
   20 XMUEND(1)=XMUEND(J)
      XMUEND(3)=XMUEND(J+1)
      PTEND(1)=PTEND(J)
      PTEND(3)=PTEND(J+1)
      XMUEND(2)=XMUMID
      PTEND(2)=PTMID
C-----SAVE NEW MINIMUM COORDINATES.
      XMUMIN=XMUMID
      PTMIN=PTMID
   30 CONTINUE
C-----2016/5/21 - Increased from 900 to MAXPOINT
C-----IF MANY POINTS DO NOT ADD ANY MORE.
   40 IF(N2OUT.GE.MAXPOINT) GO TO 50
C-----IF MINIMUM IS VERY CLOSE TO ORIGINAL POINT DO NOT INSERT A POINT,
C-----USE THE ORIGINAL ONE.
      DMU=XMUMIN-XMUIN(N2IN)
      IF(DABS(DMU).LT.0.001d0) GO TO 50
C-----INSERT MINIMUM BETWEEN XMUOUT(I2OUT-2) AND XMUOUT(I2OUT-1) OR
C-----XMUOUT(I2OUT-1) AND XMUOUT(I2OUT).
      IF(DMU.lt.0.0d0) go to 60
      IF(DMU.eq.0.0d0) go to 70
      N2IN=N2IN+1
   50 XMUIN(N2IN)=XMUMIN
      PTIN(N2IN)=PTMIN
      GO TO 70
   60 N2INM1=N2IN
      N2IN=N2IN+1
      XMUIN(N2IN)=XMUIN(N2INM1)
      PTIN(N2IN)=PTIN(N2INM1)
      XMUIN(N2INM1)=XMUMIN
      PTIN(N2INM1)=PTMIN
C-----SAVE CURRENT POINT.
   70 N2IN=N2IN+1
      XMUIN(N2IN)=XMUOUT(I2OUT)
      PTIN(N2IN)=PTOUT(I2OUT)
   80 CONTINUE
C-----COPY DISTRIBUTION TO OUTPUT ARRAYS.
      N2OUT=N2IN
      DO 90 I=1,N2OUT
      XMUOUT(I)=XMUIN(I)
      PTOUT(I)=PTIN(I)
   90 CONTINUE
  100 RETURN
      END
      SUBROUTINE THIN
C=======================================================================
C
C     THIN (XMUOUT,PTOUT) DATA ASSUMING LINAR INTERPOLATION BETWEEN
C     POINTS.
C
C     XMUOUT = ARRAY OF X VALUES.
C     PTOUT  = ARRAY OF Y VALUES.
C     N2OUT  = ON INPUT - ORIGINAL NUMBER OF POINTS.
C              ON OUTPUT - FINAL NUMBER OF POINTS.
C     ERROK  = FRACTIONAL (NOT PER-CENT) ACCEPTABLE ERROR.
C
C=======================================================================
      INCLUDE 'implicit.h'
      COMMON/OUTTAB/N2OUT
      COMMON/MAXIE/ERRMAX,ERROK,ERRUSE,LOOP
      INCLUDE 'legend.h'
c-----------------------------------------------------------------------
C
C     POINTS CAN ONLY TO THINNED IF THERE ARE 3 OR MORE POINTS AND
C     THINNING CRITERIA IS POSITIVE.
C
c-----------------------------------------------------------------------
      IF(N2OUT.LT.3.OR.ERROK.LE.0.0d0) GO TO 120
c-----------------------------------------------------------------------
C
C     POINTS WILL BE THINNED. SAVE INITIAL NUMBER OF POINTS AND DEFINE
C     INITIAL SLOPE.
C
c-----------------------------------------------------------------------
      NSTART=N2OUT
      DSIGN=1.0d0
      IF(PTOUT(1).GT.PTOUT(2)) DSIGN=-1.0d0
c-----------------------------------------------------------------------
C
C     SET UP LOOP TO THIN DATA.
C
c-----------------------------------------------------------------------
C-----SET UP LOOP OVER POINTS TO THIN (KEEP FIRST POINT AND INDICATE
C-----THAT THE NEXT POINT WHICH MIGHT BE THINNED IS THE SECOND POINT).
      N2OUT=1
      ITHIN=2
      DO 110 M=2,NSTART
      MM1=M-1
c-----------------------------------------------------------------------
C
C     KEEP ALL MAXIMA AND MINIMA.
C
c-----------------------------------------------------------------------
C-----PRECEDING POINT WAS MAXIMUM OR MINIMUM IF SIGN OF CHANGE IN Y
C-----HAS REVERSED.
      DY=PTOUT(M)-PTOUT(MM1)
      IF(DY*DSIGN.ge.0.0d0) go to 10
      DSIGN=-DSIGN
C-----IF X OF TWO POINTS ARE THE SAME TREAT AS DISCONTINUITY.
      IF(XMUOUT(M).LE.XMUOUT(MM1)) GO TO 30
C-----X NOT THE SAME. SAVE MAXIMUM OR MINIMUM IF IT HAS NOT
C-----ALREADY BEEN SAVED.
      IF(M.gt.ITHIN) go to 70
C-----MAXIMUM OR MAXIMUM ALREADY SAVED.
c-----------------------------------------------------------------------
C
C     KEEP LAST TWO POINTS IF SIGN OF Y HAS REVERSED.
C
c-----------------------------------------------------------------------
   10 IF(PTOUT(M)*PTOUT(MM1).GE.0.0d0) GO TO 20
C-----CHANGE IN SIGN OF Y. INSURE CURRENT AND PRECEDING POINTS ARE
C-----KEPT (IF PRECEDING POINT IS ALREADY KEPT ONLY NEED TO NOW KEEP
C-----CURRENT POINT, OTHERWISE KEEP BOTH NOW).
      IF(M.le.ITHIN) go to 90
      go to 80
c-----------------------------------------------------------------------
C
C     KEEP DISCONTINUITY.
C
c-----------------------------------------------------------------------
C-----IS X OF TWO POINTS THE SAME.
   20 IF(XMUOUT(M).GT.XMUOUT(MM1)) GO TO 50
C-----YES. CHECK FOR SAME Y.
   30 DY=DABS(DY)
C-----CHECK FOR BEGINNING OF THINNING INTERVAL.
      IF(M.NE.ITHIN) GO TO 40
C-----BEGINNING OF INTERVAL (M-1 ALREADY SAVED). IF Y,
C-----(1) SAME -SKIP M AND UPDATE INDEX DEFINING M+1 BEGINNING INTERVAL.
C-----(2) DIFFERENT - KEEP POINT M.
      IF(DY.le.0.0d0) go to 100
      go to 90
C-----NOT BEGINNING OF INTERVAL (M-1 NOT SAVED). IF Y,
C-----(1) SAME - KEEP M, SKIP M-1.
C-----(2) DIFFERENT - KEEP POINTS M-1 AND M.
   40 IF(DY.le.0.0d0) go to 90
      go to 80
c-----------------------------------------------------------------------
C
C     KEEP POINTS THAT CANNOT BE ACCURATELY INTERPOLATED.
C
c-----------------------------------------------------------------------
C-----KEEP COSINE=0.0 POINT.
   50 IF(XMUOUT(M).EQ.0.0d0) GO TO 90
C-----DEFINE X INTERVAL BETWEEN CURRENT POINT AND LAST CONVERGED
C-----POINT.
      DX=XMUOUT(M)-XMUOUT(N2OUT)
c-----------------------------------------------------------------------
C
C     DEFINE SLOPE OF STRAIGHT LINE THAT WILL PASS WITHIN THE ALLOWABLE
C     ERROR OF EACH POINT. KEEP ELIMINATING POINTS UNTIL ONE OR MORE
C     POINTS CANNOT BE APPROXIMATED TO WITHIN THE ALLOWABLE ERROR. AT
C     THAT POINT KEEP THE LAST PRECEDING POINT (I.E., KEEP THE LAST
C     POINT THAT PASSED THE TEST).
C
c-----------------------------------------------------------------------
      SLOPE=(PTOUT(M)-PTOUT(N2OUT))/DX
C-----INITIALIZE MAXIMUM AND MINIMUM ALLOWABLE SLOPE AT FIRST POINT OF
C-----INTERVAL.
      IF(M.NE.ITHIN) GO TO 60
      DSLOPE=ERROK*PTOUT(M)/DX
      SLPMAX=SLOPE+DSLOPE
      SLPMIN=SLOPE-DSLOPE
      GO TO 110
C-----AFTER FIRST POINT OF INTERVAL SEE IF SLOPE TO CURRENT POINT PASSES
C-----WITHIN THE ALLOWABLE ERROR OF ALL PRECEDING POINTS IN CURRENT
C-----INTERVAL.
   60 IF(SLOPE.GT.SLPMAX.OR.SLOPE.LT.SLPMIN) GO TO 70
C-----CAN ELIMINATE CURRENT POINT. UPDATE SLOPE LIMITS.
      DSLOPE=ERROK*PTOUT(M)/DX
      SLP1=SLOPE+DSLOPE
      IF(SLP1.LT.SLPMAX) SLPMAX=SLP1
      SLP2=SLOPE-DSLOPE
      IF(SLP2.GT.SLPMIN) SLPMIN=SLP2
      GO TO 110
C-----NEED TO KEEP LAST PRECEDING POINT (LAST ONE TO PASS TEST).
   70 N2OUT=N2OUT+1
      XMUOUT(N2OUT)=XMUOUT(MM1)
      PTOUT(N2OUT) =PTOUT(MM1)
C-----RE-DEFINE INDEX TO BEGINNING OF NEXT INTERVAL.
      ITHIN=M
      GO TO 50
C-----NEED TO KEEP LAST PRECEDING AND CURRENT POINTS.
   80 N2OUT=N2OUT+1
      XMUOUT(N2OUT)=XMUOUT(MM1)
      PTOUT(N2OUT) =PTOUT(MM1)
C-----NEED TO KEEP CURRENT POINT.
   90 N2OUT=N2OUT+1
      XMUOUT(N2OUT)=XMUOUT(M)
      PTOUT(N2OUT) =PTOUT(M)
C-----RE-DEFINE INDEX TO BEGINNING OF NEXT INTERVAL.
  100 ITHIN=M+1
C-----END OF THINNING LOOP.
  110 CONTINUE
C-----SAVE LAST POINT (IF NOT ALREADY SAVED).
      IF(ITHIN.GT.NSTART) GO TO 120
      N2OUT=N2OUT+1
      XMUOUT(N2OUT)=XMUOUT(NSTART)
      PTOUT(N2OUT) =PTOUT(NSTART)
  120 RETURN
      END
      SUBROUTINE POSTIV(XMUMIN,PTMIN,IMNEG)
C=======================================================================
C
C     DETERMINE IF ANGULAR DISTRIBUTION RECONSTRUCTED IS POSITIVE.
C
C=======================================================================
      INCLUDE 'implicit.h'
      COMMON/OUTTAB/N2OUT
      INCLUDE 'legend.h'
C-----INITIALIZE NON-NEGATIVE POINT COUNT. SEARCH FOR NEGATIVE POINTS.
      XMUMIN=XMUOUT(1)
      PTMIN=PTOUT(1)
      IMNEG=0
      DO 10 I=1,N2OUT
C-----12/14/04 - CHANGED FROM .LE. TO .LT. - ZERO IS NOW O.K.
      IF(PTOUT(I).LT.0.0d0) then
      IMNEG=IMNEG+1
      endif
      IF(PTOUT(I).GE.PTMIN) GO TO 10
      XMUMIN=XMUOUT(I)
      PTMIN=PTOUT(I)
   10 CONTINUE
      RETURN
      END
      SUBROUTINE LOWLEG(XMU,PTMIN,NEWLEG)
C=======================================================================
C
C     DETERMINE WHICH COEFFICIENT MAKES THE LARGEST NEGATIVE
C     CONTRIBUTION AT COSINE=XMU AND TRY TO ELIMINATE NEGATIVE ANGULAR
C     DISTRIBUTIONS BY CHANGES THOSE COEFFICIENTS WHICH MAKE THE
C     LARGEST NEGATIVE CONTRIBUTION. IN NO CASE WILL EACH COEFFICIENT
C     BE CHANGED BY MORE THAN 1 PER-CENT.
C
C=======================================================================
      INCLUDE 'implicit.h'
      INTEGER*4 OUTP,OTAPE
      COMMON/ENDFIO/INP,OUTP,ITAPE,OTAPE
      COMMON/MINY/SIGMIN
      INCLUDE 'legend.h'
c-----------------------------------------------------------------------
C
C     DEFINE CONTRIBUTION OF EACH LEGENDRE ORDER AT COSINE=MU. SORT
C     CONTRIBUTIONS INTO ASCENDING ORDER.
C
c-----------------------------------------------------------------------
C-----INITIALIZE COUNT OF COEFFICIENTS CHANGED.
      NEWLEG=0
C-----DEFINE THE CONTRIBUTION OF EACH LEGENDRE COEFFICIENT AND PN AT
C-----COSINE=XMU
      CALL ANGLE1(XMU)
C-----MOVE INDEX AND CONTRIBUTIONS OF EACH L ORDER FOR INTERNAL USE.
      DO 10 L=1,LEGUSE
      LVALUE(L)=L
      VALUES(L)=SUMN(L)
   10 CONTINUE
C-----SORT CONTRIBUTIONS INTO ASCENDING ORDER.
      CALL SORT(VALUES,LVALUE,LEGUSE)
C-----LIST PARAMETERS AND THERE CONTRIBUTIONS TO INITIAL DISTRIBUTION.
      IF(KPASS.EQ.1) WRITE(OUTP,70) SIGMIN
c-----------------------------------------------------------------------
C
C     DEFINE REQUIRED CHANGE IN EACH COEFFICIENT TO MAKE DISTRIBUTION
C     POSITIVE AND IDENTIFY COEFFICIENT WHICH REQUIRES SMALLEST CHANGE.
C
c-----------------------------------------------------------------------
   20 ILOW=0
      RATLOW=100.0d0
      DO 40 I=1,LEGUSE
      II=LVALUE(I)
C-----ONLY CONSIDER COEFFICIENTS THAT HAVE NOT YET BEEN CHANGED.
      IF(NEWFL(II).GT.0) GO TO 40
C-----ONLY CONSIDER COEFFICIENTS THAT MAKE A NEGATIVE CONTRIBUTION.
      IF(VALUES(I).ge.0.0d0) go to 50
      DFL(I)=(SIGMIN-PTMIN)/(FLMULT(II)*PN(II))
C-----ONLY CONSIDER COEFFICIENTS THAT WOULD REQUIRE A CHANGE OF LESS
C-----THAN A FACTOR OF 10.
      RATIO=DFL(I)/FL(II)
      ABSRAT=DABS(RATIO)
      IF(ABSRAT.GT.10.0d0) GO TO 50
C-----DEFINE INDEX TO COEFFICIENT WHICH REQUIRES THE SMALLEST PER-CENT
C-----CHANGE.
      IF(ABSRAT.GE.RATLOW) GO TO 30
      ILOW=I
      RATLOW=ABSRAT
C-----LIST REQUIRED CHANGES FOR INITIAL DISTRIBUTION.
   30 IF(KPASS.NE.1) GO TO 40
      XX=PN(II)
      XXX=VALUES(I)
      PC1=100.0d0*RATIO
      PC2=100.0d0*DFLMAX
      WRITE(OUTP,80) II,FL(II),XX,XXX,PC1,PC2
   40 CONTINUE
      I=LEGUSE+1
c-----------------------------------------------------------------------
C
C     CHANGE COEFFICIENT.
C
c-----------------------------------------------------------------------
C-----IF NO COEFFICIENT CAN BE CHANGED STOP TRYING.
   50 IF(ILOW.LE.0) GO TO 60
C-----PREVENT FURTHER LISTINGS.
      KPASS=2
C-----USE NEXT COEFFICIENT WHICH MAKES THE LARGEST NEGATIVE CONTRIBUTION
      II=LVALUE(ILOW)
      DFLUSE=DFL(ILOW)
C-----DO NOT ALLOW COEFFICIENT TO BE CHANGED BY MORE THAN 1.0 PER-CENT.
      FLTRY=FL(II)+DFLUSE
      IF(DABS(FLTRY-FLOLD(II)).GT.DFLMAX*DABS(FLOLD(II)))
     1 DFLUSE=-DFLMAX*FLOLD(II)
C-----CALCULATE NEW POINT VALUE AND STOP IF VALUE IS POSITIVE.
      FL(II)=FL(II)+DFLUSE
      NEWFL(II)=1
      PTMIN=PTMIN+FLMULT(II)*DFLUSE*PN(II)
      NEWLEG=NEWLEG+1
      IF(PTMIN.LT.0.99d0*SIGMIN) GO TO 20
C-----SET COUNTER TO INDICATE DISTRIBUTION IS NOW POSITIVE.
      NEWLEG=-1
C-----END OF ITERATION.
   60 RETURN
   70 FORMAT(' Requested Minimum Value=',F11.6/
     1 ' Negative Contribution of Each Legendre Order and per-cent'/
     3 ' Changed to Make Positive by Changing One Coefficient'/
     4 ' Index   Coefficient  P-n(Cosine)  Contribution',
     5 '   Change  Allowed')
   80 FORMAT(I6,3F14.6,2F9.4)
      END
      SUBROUTINE LOWTAB(PTMIN,LTT)
C=======================================================================
C
C     FORCE ANGULAR DISTRIBUTION TO BE POSITIVE WITH MINIMUM EQUAL TO
C     (SIGMIN). THIS IS DONE AS FOLLOWS,
C     (1) FOR TABLES - ADD THE SAME AMOUNT (ADDIT) TO EACH POINT VALUE
C         AND RE-NORMALIZE.
C     (2) FOR LEGENDRE COEFFICIENTS - LOGICALLY ADD THE SAME AMOUNT
C         (ADDIT) TO EACH POINT VALUE BY INCREASING P0 BY 2 X (ADDIT).
C         BY DEFINITION P0=1 FOR A NORMALIZED DISTRIBUTION. NORMALIZING
C         THE RESULTING DISTRIBUTION IS EQUIVALENT TO DIVIDING EACH
C         COEFFICIENT BY 1 + 2 X (ADDIT). THEREFORE WHAT IS ACTUALLY
C         DONE IS TO DIVIDE EACH LEGENDRE COEFFICIENT BY 1 + 2 X (ADDIT)
C
C     NOTE, ADDING (ADDIT) TO EACH POINT VALUE WILL INCREASE THE
C     INTEGRAL FROM 1 TO (1+2*ADDIT). RE-NORMALIZING WILL DECREASE
C     EACH POINT VALUE BY (1+2*ADDIT). TO INSURE THAT THE MINIMUM
C     RE-NORMALIZED VALUE IS EQUAL TO (SIGMIN) WE REQUIRE THAT
C     PTOUT(NEW)=(PTOUT(OLD)+ADDIT)/(1+2*ADDIT)=AT LEAST SIGMIN.
C     IN PARTICULAR WHEN PTOUT(OLD)=PTMIN WE CAN SOLVE.
C
C     (PTMIN+ADDIT)/(1+2*ADDIT)=SIGMIN
C
C     TO FIND,
C
C     ADDIT=(SIGMIN-PTMIN)/(1-2*SIGMIN)
C
C=======================================================================
      INCLUDE 'implicit.h'
      INTEGER*4 OUTP,OTAPE
      COMMON/ENDFIO/INP,OUTP,ITAPE,OTAPE
      COMMON/OUTTAB/N2OUT
      COMMON/MINY/SIGMIN
      INCLUDE 'legend.h'
c-----------------------------------------------------------------------
C
C     DEFINE REQUIRED CHANGE TO MAKE FINAL RE-NORMALIZED DISTRIBUTION
C     HAVE A MINIMIM OF (SIGMIN), ADD TO EACH POINT VALUE AND THEN
C     RE-NORMALIZE.
C
c-----------------------------------------------------------------------
      ADDIT=(SIGMIN-PTMIN)/(1.0d0-2.0d0*SIGMIN)
      IF(N2OUT.LE.0) GO TO 20
      DO 10 I=1,N2OUT
      PTOUT(I)=PTOUT(I)+ADDIT
   10 CONTINUE
      IF(LTT.EQ.2) WRITE(OUTP,50) ADDIT
c-----------------------------------------------------------------------
C
C     RE-NORMALIZE LEGENDRE COEFFICIENTS.
C
c-----------------------------------------------------------------------
   20 IF(LEGUSE.LE.0) GO TO 40
      SUMX=1.0d0+2.0d0*ADDIT
      DO 30 L=1,LEGUSE
      FLOLD(L)=FL(L)
      FL(L)=FL(L)/SUMX
      NEWFL(L)=1
   30 CONTINUE
      WRITE(OUTP,60) SUMX
   40 RETURN
   50 FORMAT(F10.5,' Added to Each Point to Make Distribution Positive')
   60 FORMAT(' Each Legendre Coefficient Divided by',F10.5,
     1 ' to Make Distribution Positive')
      END
      SUBROUTINE SORT(SUMN,LVALUE,L)
C=======================================================================
C
C     SORT INTO ASCENDING ORDER
C
C=======================================================================
      INCLUDE 'implicit.h'
      DIMENSION SUMN(*),LVALUE(*)
      IF(L.LE.1) GO TO 40
      LTOP=L
      DO 30 I=2,L
      ISWTCH=0
      JM1=1
      DO 20 J=2,LTOP
      IF(SUMN(J).ge.SUMN(JM1)) go to 10
      DD=SUMN(J)
      SUMN(J)=SUMN(JM1)
      SUMN(JM1)=DD
      LL=LVALUE(J)
      LVALUE(J)=LVALUE(JM1)
      LVALUE(JM1)=LL
      ISWTCH=1
   10 JM1=J
   20 CONTINUE
      IF(ISWTCH.le.0) go to 40
      LTOP=LTOP-1
   30 CONTINUE
   40 RETURN
      END
      SUBROUTINE TAB4
C=======================================================================
C
C     OUTPUT TAB1 RECORD FOR FILE 4 TABULATED ANGULAR DISTRIBUTION.
C     COSINES ARE OUTPUT IN F11.6 FORMAT AND PROBABILITY IN E11.5
C     FORMAT.
C
C     NORMALIZE DISTRIBUTION PRIOR TO OUTPUT.
C
C=======================================================================
      INCLUDE 'implicit.h'
      COMMON/LEADER/C1,C2,L1,L2,N1,N2,MAT,MF,MT
      COMMON/OUTTAB/N2OUT
      COMMON/FLAGS/MINUS3,IMPLUS
      INCLUDE 'legend.h'
      DIMENSION NBTO(1),INTO(1)
      DATA INTO/2/
C-----DEFINE INTEGRAL OF DISTRIBUTION.
      SUMX=XINT(XMUOUT,PTOUT,N2OUT)
C-----NORMALIZE DISTRIBUTION.
      DO 10 I=1,N2OUT
      PTOUT(I)=PTOUT(I)/SUMX
   10 CONTINUE
C-----DEFINE ONE INTERPOLATION REGION AND THE NUMBER OF POINTS IN THE
C-----SECTION AND OUTPUT FIRST CARD OF TAB1 RECORD.
      N1=1
      N2=N2OUT
      CALL CARDO(C1,C2,L1,L2,N1,N2)
C-----DEFINE INTERPOLATION LAW AND OUTPUT IT.
      NBTO(1)=N2OUT
      CALL TERPO(NBTO,INTO,1)
C-----OUTPUT TABULATED ANGULAR DISTRIBUTION.
      MINUS3=0
      IMPLUS=0
      CALL POINTO(XMUOUT,PTOUT,N2OUT)
      RETURN
      END
      SUBROUTINE LIST4
C=======================================================================
C
C     OUTPUT LIST RECORD FOR FILE 4 LEGENDRE COEFFICIENTS. OUTPUT THE
C     NUMBER OF COEFFICIENTS READ EVEN IF HIGHER ORDER COEFFICIENTS
C     ARE ZERO (IMPORTANT FOR INTERPOLATION IN ENERGY).
C
C=======================================================================
      INCLUDE 'implicit.h'
      COMMON/LEADER/C1,C2,L1,L2,N1,N2,MAT,MF,MT
      INCLUDE 'legend.h'
C-----DEFINE NUMBER OF LEGENDRE COEFFICIENTS TO OUTPUT (IF NONE, OUTPUT
C-----ONE) AND OUTPUT FIRST CARD OF LIST RECORD.
      N1=LEGIN
      IF(N1.GT.0) GO TO 10
      N1=1
      FL(1)=0.0d0
      GO TO 30
C-----IF NECESSARY FILL IN TRAILING ZERO VALUES.
   10 IF(LEGUSE.GE.N1) GO TO 30
      L=LEGUSE+1
      DO 20 I=L,N1
      FL(I)=0.0d0
   20 CONTINUE
C-----OUTPUT START OF LIST RECORD.
   30 CALL CARDO(C1,C2,L1,L2,N1,N2)
C-----OUTPUT LEGENDRE COEFFICIENTS.
C-----2015/10/28 - switched from LISTO and LISTO9 (no 10 digit output).
      CALL LISTO9(FL,N1)
      RETURN
      END
      SUBROUTINE CONTIL
C=======================================================================
C
C     READ ENDF/B HEADER RECORD.
C
C     SKIP TO START OF NEXT SELECTED SECTION.
C
C=======================================================================
      INCLUDE 'implicit.h'
      COMMON/HEADER/C1H,C2H,L1H,L2H,N1H,N2H,MATH,MFH,MTH,NOSEQ
C-----READ NEXT LINE.
   10 CALL CONTI
C-----SKIP SEND/FEND/MEND - END ON TEND.
      IF(MTH.gt.0) go to 20
      IF(MATH.lt.0) go to 30
      go to 10
C-----HAS SECTION BEEN REQUESTED.
   20 MMM = MYWANT(MATH,MFH,MTH)
      IF(MMM.lt.0) go to 30
      IF(MMM.gt.0) go to 40
C-----NOT REQUESTED. SKIP SECTION.
      CALL SKIPS
      GO TO 10
C-----END OF DATA.
   30 MATH=-1
      MFH=0
      MTH=0
C-----REQUESTED OR END OF DATA.
   40 RETURN
      END
      SUBROUTINE CONTOL
C=======================================================================
C
C     WRITE ENDF/B HEADER RECORD.
C
C=======================================================================
      INCLUDE 'implicit.h'
      COMMON/HEADER/C1H,C2H,L1H,L2H,N1H,N2H,MATH,MFH,MTH,NOSEQ
      DATA LSTMAT/-9999/
      DATA LSTMF/-999/
C-----ADD FEND AND MEND LINES AS NECESSARY.
      IF(LSTMAT.LE.0) GO TO 10
      IF(LSTMF.EQ.MFH.AND.LSTMAT.EQ.MATH) GO TO 20
C-----OUTPUT FEND.
      CALL OUTF(LSTMAT)
      IF(LSTMAT.EQ.MATH) GO TO 20
C-----OUTPUT MEND.
      CALL OUTM
C-----INITIALIZE SEQUENCE NUMBER.
   10 NOSEQ=1
C-----SAVE CURRENT MAT/MF.
   20 LSTMAT=MATH
      LSTMF=MFH
      CALL CONTO
      RETURN
      END
      SUBROUTINE INTOUT(INT,FIELD,LENGTH)
C=======================================================================
C
C     CONVERT INTEGER TO CHARACTERS FOR OUTPUT
C
C     WARNING - ONLY CONSIDERS POSITIVE INTEGERS
C
C=======================================================================
      INCLUDE 'implicit.h'
      CHARACTER*1 DIGITS,FIELD
      DIMENSION DIGITS(0:9),FIELD(LENGTH)
      DATA DIGITS/'0','1','2','3','4','5','6','7','8','9'/
C-----INITIALIZE TO BLANK
      DO 10 I=1,LENGTH
      FIELD(I)=' '
   10 CONTINUE
C-----FILL IN LAST DIGIT TO FIRST
      II=INT
      DO 20 I=LENGTH,1,-1
      IF(II.LE.0) GO TO 30
      KK=II/10
      LL=II-10*KK
      FIELD(I)=DIGITS(LL)
      II=KK
   20 CONTINUE
   30 RETURN
      END
      SUBROUTINE FILIO1
C=======================================================================
C
C     DEFINE ALL I/O UNITS AND OPTIONALLY DEFINE FILENAMES.
C
C=======================================================================
      INCLUDE 'implicit.h'
      INTEGER*4 OUTP,OTAPE
      CHARACTER*60 NAMEIN,NAMEOUT
      COMMON/ENDFIO/INP,OUTP,ITAPE,OTAPE
      COMMON/UNITS/ISCR
      COMMON/IOSTATUS/ISTAT1,ISTAT2
      COMMON/NAMEX/NAMEIN,NAMEOUT
C-----DEFINE ALL I/O UNITS.
      INP=2
      OUTP=3
      ITAPE=10
      OTAPE=11
      ISCR =12
C-----DEFINE ALL FILE NAMES.
      OPEN(OUTP,FILE='LEGEND.LST',STATUS='UNKNOWN')
      OPEN(ISCR,FILE='LEGEND.TMP',STATUS='UNKNOWN')
c-----------------------------------------------------------------------
C
C     2015/10/28 - moved this after opening above 2 files.
C                  Earlier on ERR=10 these were skipped.
C
c-----------------------------------------------------------------------
      OPEN(INP,FILE='LEGEND.INP',STATUS='OLD',ERR=10)
      ISTAT1 = 0
      RETURN
C-----NO INPUT PARAMETERS.
   10 ISTAT1 = 1
      RETURN
      ENTRY FILIO2
c-----------------------------------------------------------------------
C
C     DEFINE ENDF/B DATA FILE NAMES.
C
c-----------------------------------------------------------------------
C-----DEFINE ENDF/B DATA FILENAMES.
      OPEN(OTAPE,FILE=NAMEOUT,STATUS='UNKNOWN')
      OPEN(ITAPE,FILE=NAMEIN ,STATUS='OLD',ERR=20)
      ISTAT2 = 0
      RETURN
   20 ISTAT2 = 1
      RETURN
      END