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 VIRGIN
C     VERSION 76-1 (NOVEMBER 1976)
C     VERSION 84-1 (JUNE 1984)   *DOUBLE PRECISION ENERGY
C     VERSION 86-1 (JANUARY 1986)*FORTRAN-77/H VERSION
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)*COMPLETE RE-WRITE
C                                *OUTPUT IN PLOTTAB FORMAT
C                                *UP TO 2000 THICKNESSES
C                                *INCREASED INCORE PAGE SIZE TO 6000
C                                 CROSS SECTION POINTS
C                                *ADDED PHOTON CALCULATIONS
C                                *ADDED BLACKBODY SPECTRUM
C                                *ADDED MULTIPLE LAYERS
C                                *ADDED SPATIALLY DEPENDENT DENSITY
C                                *ADDED FORTRAN SAVE OPTION
C                                *COMPLETELY CONSISTENT I/O ROUTINES -
C                                 TO MINIMIZE COMPUTER DEPENDENCE.
C     VERSION 92-2 (MAY 1992)    *CORRECTED TO HANDLE MULTIGROUP CROSS
C                                 SECTIONS AS INPUT IN ENDF/B FORMAT.
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                                 *DEFINED SCRATCH FILE NAMES
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. 2002-1 (MAY 2002)     *OPTIONAL INPUT PARAMETERS
C     VERS. 2004-1 (MARCH 2004)   *ADDED INCLUDE FOR COMMON
C                                 *UP TO 2000 THICKNESSES
C                                 *INCREASED INCORE PAGE SIZE TO 60,000
C     VERS. 2007-1 (JAN.  2007)   *CHECKED AGAINST ALL ENDF/B-VII.
C                                 *INCREASED INCORE PAGE SIZE TO
C                                  240,000 FROM 60,000.
C     VERS. 2007-2 (DEC.  2007)   *72 CHARACTER FILE NAME.
C     VERS. 2010-1 (Apr.  2010)   *General update based on user feedback
C                                 *INCREASED INCORE PAGE SIZE TO
C                                  600,000 FROM 240,000.
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                                 *Generalized TART Group Structures.
C                                 *Generalized SAND-II Group Structures.
C                                 *Extended SAND-II to 60, 150, 200 MeV.
C     VERS. 2015-2 (Apr.  2015)   *Changed ALL data to "D" instead of
C                                  "E" to insure it is REAL*8 and avoid
C                                  Truncation ERRORS.
C     VERS. 2017-1 (May   2017)   *Added UKAEA 1102 Group Structure.
C                                 *Increased points to 3,000,000
C                                 *Increased groupd to 30,000
C                                 *Updated based on user feedback
C                                 *Defintion of built-in group structure
C                                  using SUBROUTINE GROPE is identical
C                                  for GROUPIE and VIRGIN.
C                                 *All floating point parameters changed
C                                  to character inout + IN9 conversion.
C     VERS. 2018-1 (Jan.  2018)   *Decreased PAGE size from 3,000,000
C                                  to 1,500,000
C                                 *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     VERS. 2020-1 (Feb.  2020)   *Identical to 2019-1.
C
C     2015-2 Acknowledgment
C     =====================
C     I thank Andrej Trkov (NDS, IAEA) for finding the problem with
C     the "E" formatted DATA (this effected both VIRGIN and GROUPIE).
C     I also thank Andrej for overseeing the entire PREPRO project
C     at IAEA, Vienna; he is part of a truly International team who
C     worked together to produce PREPRO-2015-2, and to make it
C     available Internationally on-line for FREE to ALL users.
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     THIS PROGRAM IS DESIGNED TO CALCULATE UNCOLLIDED (I.E. VIRGIN)
C     FLUX AND REACTIONS DUE TO TRANSMISSION OF A MONODIRECTIONAL
C     BEAM OF NEUTRONS THROUGH ANY THICKNESS OF MATERIAL. IN ORDER
C     TO SIMULATE AN EXPERIMENTAL MEASUREMENT THE RESULTS ARE GIVEN
C     AS INTEGRALS OVER ENERGY TALLY GROUPS (AS OPPOSED TO POINTWISE
C     IN ENERGY). BY TAKING THE RATIO OF REACTIONS TO FLUX IN EACH
C     GROUP AN EQUIVALENT SPATIALLY DEPENDENT GROUP AVERAGED CROSS
C     SECTION IS CALCULATED BY THE PROGRAM.
C
C     EVALUATED DATA
C     --------------
C     THE EVALUATED DATA MUST BE IN THE ENDF/B FORMAT. HOWEVER IT
C     MUST BE LINEAR-LINEAR INTERPOLABLE IN ENERGY-CROSS SECTION
C     BETWEEN TABULATED POINTS. SINCE ONLY CROSS SECTIONS (FILE 3 OR 23)
C     ARE USED, THIS PROGRAM WILL WORK ON ANY VERSION OF ENDF/B
C     (I.E. ENDF/B-I, II, III, IV, V OR VI).
C
C     RELATED COMPUTER CODES
C     ----------------------
C     IN ORDER TO CONVERT ENDF/B DATA TO THE FORM REQUIRED BY THIS CODE
C     THE FOLLOWING COMPUTER CODES MAY BE USED,
C
C     LINEAR  - CONVERT FROM GENERAL ENDF/B INTERPOLATION TO LINEAR-
C               LINEAR INTERPOLATION.
C     RECENT  - ADD THE RESONANCE CONTRIBUTION TO TABULATED BACKGROUND
C               CROSS SECTIONS TO OBTAIN LINEAR-LINEAR INTERPOLABLE
C               RESULTS.
C     SIGMA1  - DOPPLER BROADEN CROSS SECTION TO OBTAIN LINEAR-LINEAR
C               INTERPOLABLE RESULTS.
C     MIXER   - MIX INDIVIDUAL MATERIALS TOGETHER TO DEFINE COMPOSITE
C               MIXTURES, E.G., COMBINE MATERIALS TO DEFINE STAINLESS
C               STELL.
C
C     IN ORDER TO PLOT THE OUTPUT RESULTS OF THIS CODE USE PROGRAM
C     PLOTTAB.
C
C     COPIES OF ANY OR ALL OF THESE CODES MAY BE OBTAINED FROM D.E.
C     CULLEN AT THE ABOVE ADDRESS.
C
C     OUTPUT FORMAT
C     -------------
C     FOR ALL VERSIONS OF THIS PROGRAM PRIOR TO VERSION 92-1 OUTPUT WAS
C     IN TABULAR FORM.
C
C     FOR VERSION 92-1 AND LATER VERSIONS OF THIS CODE ALL OUTPUT IS IN
C     THE PROGRAM PLOTTAB FORMAT TO ALLOW RESULTS TO BE EASILY PLOTTED.
C     FOR A COPY OF PROGRAM PLOTTAB CONTACT D.E. CULLEN AT THE ABOVE
C     ADDRESS.
C
C     TALLY GROUPS
C     ------------
C     THE TALLY GROUP STRUCTURE MAY BE ANY SET OF MONONTONICALLY
C     INCREASING ENERGY BOUNDARIES. THERE MAY BE UP TO 2000 TALLY
C     GROUPS. BY USING THE INPUT PARAMETERS THE USER MAY SPECIFY ANY
C     ARBITRARY TALLY GROUP STRUCTURE OR SELECT ONE OF THE FOLLOWING
C     BUILT-IN GROUP STRUCTURES.
C
C     (0) TART 175 GROUPS
C     (1) ORNL  50 GROUPS
C     (2) ORNL 126 GROUPS
C     (3) ORNL 171 GROUPS
C     (4) SAND-II 620 GROUPS - 1.0D-4 eV UP TO 18 MEV
C     (5) SAND-II 640 GROUPS - 1.0D-4 eV UP TO 20 MEV
C     (6) WIMS 69 GROUPS
C     (7) GAM-I 68 GROUPS
C     (8) GAM-II 99 GROUPS
C     (9) MUFT 54 GROUPS
C    (10) ABBN 28 GROUPS
C    (11) TART 616 GROUPS TO  20 MeV
C    (12) TART 700 GROUPS To   1 GeV
C    (13) SAND-II 665 GROUPS - 1.0D-5 eV UP TO 18 MEV
C    (14) SAND-II 685 GROUPS - 1.0D-5 eV UP TO 20 MEV
C    (15) TART 666 GROUPS TO 200 MeV
C    (16) SAND-II 725 GROUPS - 1.0D-5 eV UP TO  60 MEV
C    (17) SAND-II 755 GROUPS - 1.0D-5 eV UP TO 150 MEV
C    (18) SAND-II 765 GROUPS - 1.0D-5 eV UP TO 200 MEV
C    (19) UKAEA  1102 GROUPS - 1.0D-5 eV UP TO 1 GeV
C
C     INCIDENT SPECTRUM
C     -----------------
C     THE INCIDENT SPECTRUM MAY BE ANY TABULATED FUNCTION THAT IS
C     GIVEN BY A SET OF POINTS THAT IS MONOTONICALLY INCREASING IN
C     ENERGY AND LINEAR-LINEAR INTERPOLABLE IN ENERGY-SPECTRUM
C     BETWEEN TABULATED POINTS. THERE IS NO LIMIT TO THE NUMBER OF
C     POINTS USED TO DESCRIBE THE SPECTRUM. THERE ARE FIVE BUILT-IN
C     OPTIONS FOR THE SPECTRUM.
C
C     (1) CONSTANT...ENERGY INDEPENDENT (INPUT 0)
C     (2) 1/E (INPUT 1)
C     (3) BLACKBODY - PHOTON SPECTRUM
C     (4) BLACKBODY - ENERGY SPECTRUM (E TIMES THE PHOTON SPECTRUM)
C     (5) TRANSMITTED SPECTRUM FROM PREVIOUS CASE
C
C     NORMALIZATION OF SPECTRUM
C     -------------------------
C     ANY INCIDENT SPECTRUM, EITHER READ AS INPUT OR ONE OF THE
C     BUILT-IN SPECTRA, WILL BE NORMALIZED TO UNITY WHEN INTEGRATED
C     OVER THEIR ENTIRE ENERGY RANGE.
C
C     TRANSMITTED SPECTRA WILL NOT BE RE-NORMALIZED, SINCE IT ALREADY
C     INCLUDES THE NORMALIZATION OF THE INCIDENT SPECTRUM.
C
C     NOTE, INCIDENT SPECTRA IS NORMALIZED TO UNITY OVER THEIR ENTIRE
C     ENERGY RANGE - NOT OVER THE ENERGY RANGE OF THE GROUPS. IF THE
C     ENERGY RANGE OF THE GROUPS IS LESS THAN THAT OF THE SPECTRUM
C     ONLY THAT PORTION OF THE SPECTRUM WILL BE USED AND THIS WILL
C     NOT BE RE-NORMALIZED TO UNITY.
C
C     COMPOSITION OF A LAYER
C     ----------------------
C     YOU MAY RUN PROBLEMS INVOLVING
C     1) A LAYER OF UNIFORM DENSITY - DENSITY FOR ATTENUATION IS THAT
C        OF THE TOTAL. DENSITY FOR REACTIONS IS THAT OF THE REACTION.
C     2) A LAYER OF UNIFORM DENSITY - DENSITY IS THE SUM OF THE TOTAL
C        AND REACTION DENSITIES - THE SUM OF THE CROSS SECTIONS IS
C        USED FOR ATTENUATION AND REACTIONS.
C     3) A LAYER OF VARYING DENSITY BASED ON A UNIFORM TOTAL DENSITY
C        PLUS A VARIATION BETWEEN 0 AND A MAXIMUM BASED ON THE
C        REACTION DENSITY - 0 AT 0 THICKNESS AND MAXIMUM AT MAXIMUM
C        THICKNESS. IN THIS CASE THE AVERAGE REACTION DENSITY IS EQUAL
C        TO THE INPUT REACTION DENSITY. THE VARIATION IN REACTION
C        DENSITY CAN BE LINEAR, SQUARE OR CUBIC.
C     4) A LAYER OF VARYING DENSITY BASED ON A TOTAL DENSITY WHICH
C        VARYING FROM MAXIMUM AT 0 THICKNESS TO 0 AT MAXIMUM THICKNESS
C        PLUS A REACTION DENSITY WHICH VARIES FROM 0 AT 0 THICKNESS
C        TO MAXIMUM AT MAXIMUM THICKNESS. IN THIS CASE THE AVERAGE
C        DENSITY OF THE TOTAL AND REACTION WILL BOTH BE EQUAL TO THE
C        INPUT TOTAL AND REACTION DENSITIES. THE VARIATION IN TOTAL
C        AND REACTION DENSITY CAN BE LINEAR, SQUARE OR CUBIC.
C
C     IN THE FIRST CASE THE TWO REQUESTED CROSS SECTIONS ARE CONSIDERED
C     TO BE INDEPENDENT - THE TOTAL CROSS SECTION IS USED TO CALCULATE
C     ATTENUATION AND THE REACTION CROSS SECTION IS USED TO CALCULATE
C     REACTIONS, E.G., TRANSMISSION THROUGH NATURAL URANIUM (THE TOTAL
C     CROSS SECTION SHOULD BE THAT OF NATURAL URANIUM) AND REACTIONS
C     IN A U-235 DETECTOR (THE REACTION CROSS SECTION SHOULD BE THAT OF
C     U-235).
C
C     IN THE OTHER THREE CASES THE TWO REQUESTED CROSS SECTIONS ARE
C     TREATED AS TWO CONSTITUENTS OF A MIXTURE OF TWO MATERIALS AND
C     THE TWO CROSS SECTIONS ARE USED BOTH TO DEFINE A TOTAL CROSS
C     SECTION FOR ATTENUATION AND A REACTION CROSS SECTION TO DEFINE
C     REACTIONS. IN THESE CASES THE MIXTURE WILL VARY CONTINUOUSLY,
C     E.G., IN CASE 4) HALF WAY THROUGH THE LAYER THE COMPOSITION WILL
C     BE 1/2 THE MATERIAL DEFINED BY THE TOTAL AND 1/2 THE MATERIAL
C     BASED ON THE REACTION. IN THESE CASES RATHER THAN THINKING OF
C     THE TWO CROSS SECTIONS AS A TOTAL AND REACTION CROSS SECTION,
C     IT IS BETTER TO THINK OF THEM AS THE TOTAL CROSS SECTIONS FOR
C     MATERIALS A AND B AND THE CALCULATED REACTIONS WILL BE BASED
C     ON THESE TWO TOTAL CROSS SECTIONS.
C
C     MULTIPLE LAYERS
C     ---------------
C     THIS CODE MAY BE USED TO RUN EITHER A NUMBER OF INDEPENDENT
C     PROBLEMS, EACH INVOLVING TRANSMISSION THROUGH A SINGLE LAYER OF
C     MATERIAL, OR TRANSMISSION THROUGH A NUMBER OF LAYERS ONE AFTER
C     THE OTHER.
C
C     IN THE CASE OF MULTIPLE LAYERS, ONE LAYER AFTER ANOTHER, THE
C     TRANSMITTED ENERGY DEPENDENT SPECTRUM IS USED AS THE INCIDENT
C     SPECTRUM FOR THE NEXT LAYER. THERE IS NO LIMIT TO THE NUMBER
C     OF LAYERS WHICH MAY BE USED - EACH LAYER IS TREATED AS A
C     COMPLETELY INDEPENDENT PROBLEM WITH A DEFINED INCIDENT SOURCE,
C     AND AS SUCH THE CYCLE OF TRANSMISSION THROUGH EACH LAYER AND
C     USING THE TRANSMITTED SPECTRUM AS THE INCIDENT SPECTRUM FOR THE
C     NEXT LAYER MAY BE REPEATED ANY NUMBER OF TIMES.
C
C     REMEMBER - THE INCIDENT SPECTRUM IS ASSUMED TO BE LINEARLY
C     INTERPOLABLE IN ENERGY AND SPECTRUM BETWEEN THE ENERGIES AT
C     WHICH IT IS TABULATED. THE TRANSMITTED SPECTRUM WILL BE TABULATED
C     AT THE UNION OF ALL ENERGIES OF THE INCIDENT SPECTRUM AND CROSS
C     SECTIONS (TOTAL AND REACTION). IN ORDER TO INSURE THE ACCURACY
C     OF THE RESULT WHEN PERFORMING MULTIPLE LAYER CALCULATION BE SURE
C     TO SPECIFY THE INCIDENT SPECTRUM ON THE FIRST LAYER TO SUFFICIENT
C     DETAIL (ENOUGH ENERGY POINTS CLOSELY SPACED TOGETHER) IN ORDER TO
C     ALLOW THE TRANSMITTED SPECTRUM TO BE ACCURATELY REPRESENTED BY
C     LINEAR INTERPOLATION BETWEEN SUCCESSIVE ENERGY POINTS - THERE IS
C     NO LIMIT TO THE NUMBER OF POINTS ALLOWED IN THE INCIDENT SPECTRUM,
C     SO IF YOU ARE IN DOUBT, SIMPLY USE MORE ENERGY POINTS TO SPECIFY
C     THE INCIDENT SPECTRUM.
C
C     RESULT OUTPUT UNITS
C     -------------------
C     FLUX      = EXACTLY AS CALCULATED
C     REACTIONS = 1/CM OR 1/GRAM
C     AVERAGE   = 1/CM - MACROSCOPIC UNITS
C     CROSS
C     SECTION
C
C     THICKNESS AND DENSITY
C     ---------------------
C     THE UNCOLLIDED CALCULATION ONLY DEPENDS ON THE PRODUCT OF
C     THICKNESS AND DENSITY (I.E. GRAMS PER CM SQUARED). THIS FACT
C     MAY BE USED TO SIMPLIFY INPUT BY ALLOWING THE THICKNESS AND
C     DENSITY TO BE GIVEN EITHER AS CM AND GRAMS/CC RESPECTIVELY
C     OR ELSE TO GIVE THICKNESS IN GRAMS/(CM*CM) AND INPUT A
C     DENSITY OF 1.0 - OR IN ANY OTHER CONVENIENT UNITS AS LONG AS
C     THE PRODUCT OF THICKNESS AND DENSITY IS IN THE CORRECT GRAMS
C     PER CENTIMETER SQUARED.
C
C     GRAMS/(CM*CM) ARE RELATED TO ATOMS/BARN THROUGH THE RELATIONSHIP
C
C     GRAMS/(CM*CM)=(ATOMS/BARN)*(GRAMS/MOLE)*(MOLE/ATOM)
C
C     OR...
C
C     GRAMS/(CM*CM)=(ATOMS/BARN)*(ATOMIC WEIGHT)/0.602
C
C     CROSS SECTIONS AT A SPACE POINT AND OPTICAL THICKNESS
C     -----------------------------------------------------
C     THIS PROGRAM ALLOWS LAYERS OF EITHER UNIFORM DENSITY OR
C     CONTINUOUSLY VARYING DENSITY. THE DENSITY CAN BE ONE OF THE
C     FOLLOWING FORMS,
C     1) C                   = UNIFORM DENSITY
C     2) C*2*(X/T)           = LINEAR VARIATION FROM 0 TO C
C     3) C*(2-2*(X/T))       = LINEAR VARIATION FROM C TO 0
C     4) C*3*(X/T)**2        = SQUARE VARIATION FROM 0 TO C
C     5) C*(3-3*(X/T)**2)/2  = SQUARE VARIATION FROM C TO 0
C     6) C*4*(X/T)**3        = CUBIC VARIATION FROM 0 TO C
C     7) C*(4-4*(X/T)**3)/3  = CUBIC VARIATION FROM C TO 0
C
C     IN ORDER TO CALCULATE REACTIONS AT A POINT THE MICROSCOPIC
C     REACTION CROSS SECTION NEED MERELY BE SCALED BY THESE DENSITIES.
C
C     IN ORDER TO CALCULATE TRANSMISSION WE MUST DEFINE THE OPTICAL
C     PATH LENGTH WHICH MAY BE DEFINED BY INTEGRATING EACH OF THE
C     ABOVE DENSITY FORMS TO FIND,
C     1) C*X
C     2) C*X*(X/T)
C     3) C*X*(2-(X/T))
C     4) C*X*(X/T)**2
C     5) C*X*(3-(X/T)**2)/2
C     6) C*X*(X/T)**3
C     7) C*X*(4-(X/T)**3))/3
C
C     IN ORDER TO CALCULATE TRANSMISSION TO A POINT THE MICROSCOPIC
C     TOTAL CROSS SECTION NEED MERELY BE SCALED BY THESE DENSITIES
C     TO DEFINE THE OPTICAL PATH LENGTH.
C
C     THE VARIATION OF THE DENSITY THROUGH THE LAYER MAY BE DEFINED
C     BY SETTING X = 0 OR X = T TO FIND,
C        X = 0      X = T
C        -----      -----
C     1) C          C
C     2) 0          2*C
C     3) 2*C        0
C     4) 0          3*C
C     5) 3*C/2      0
C     6) 0          4*C
C     7) 4*C/3      0
C
C     THE OPTICAL PATH THROUGH A LAYER OF THICKNESS T MAY BE DEFINED
C     FROM THE ABOVE EXPRESSIONS BY SETTING X=T TO FIND THAT IN ALL
C     CASES THE ANSWER WILL BY C*T. THE CONSTANTS IN THE ABOVE
C     EXPRESSIONS HAVE BEEN INTRODUCED IN ORDER TO FORCE THIS RESULT.
C     WITH THESE FACTORS THE OPTICAL PATH LENGTH THROUGH THE LAYER
C     WILL EXACTLY CORRESPOND TO AN AVERAGE DENSITY CORRESPONDING TO
C     THAT INPUT FOR THE TOTAL AND/OR REACTION, I.E., C CORRESPONDS
C     TO THE INPUT DENSITY.
C
C     NOTE - FOR THE SAME OPTICAL PATH LENGTHS THROUGH THE LAYER THE
C     TRANSMISSION WILL BE EXACTLY THE SAME. HOWEVER, VARYING THE
C     DENSITY WILL ALLOW YOU TO MODIFY THE REACTION RATES AT SPECIFIC
C     DEPTHS INTO THE LAYER.
C
C     COMPUTATION OF INTEGRALS
C     ------------------------
C     STARTING FROM TOTAL CROSS SECTIONS, REACTION CROSS SECTIONS AND
C     A SOURCE SPECTRUM ALL OF WHICH ARE GIVEN IN TABULAR FORM WITH
C     LINEAR INTERPOLATION BETWEEN TABULATED POINTS ALL REQUIRED
C     INTEGRALS CAN BE DEFINED BY ANALYTICAL EXPRESSIONS INVOLVING
C     NOTHING MORE COMPLICATED THAN EXPONENTIALS. THE INTEGRALS THAT
C     MUST BE EVALUATED ARE OF THE FORM...
C
C     FLUX
C     ----
C     (INTEGRAL EK TO EK+1) (S(E)* EXP(-XCT(E)*Z)*DE)
C
C     REACTIONS
C     ---------
C     (INTEGRAL EK TO EK+1) (S(E)*XCR(E)*EXP(-XCT(E)*Z)*DE)
C
C     WHERE..
C     EK TO EK+1 = LONGEST ENERGY INTERVAL OVER WHICH S(E), XCT(E) AND
C                  XCR(E) ARE ALL LINEARLY INTERPOLABLE.
C     S(E)       = ENERGY DEPENDENT WEIGHTING SPECTRUM
C     XCR(E)     = REACTION CROSS SECTION
C     XCT(E)     = OPTICAL PATH LENGTH (BASED ON TOTAL CROSS SECTION)
C     Z          = MATERIAL THICKNESS
C
C     S(E), XCR(E) AND XCT(E) ARE ALL ASSUMED TO BE GIVEN IN TABULAR
C     FORM WITH LINEAR INTERPOLATION USED BETWEEN TABULATED POINTS.
C     IN OTHER WORDS BETWEEN TABULATED POINTS EACH OF THESE THREE IS
C     DEFINED BY A FUNCTION OF THE FORM...
C
C     F(E)=((E - EK)*FK+1 + (EK+1 - E)*FK)/(EK+1 - EK)
C
C     EACH OF THESE THREE CAN BE CONVERTED TO NORMAL FORM BY THE
C     CHANGE OF VARIABLES....
C
C     X=(E - 0.5*(EK+1 + EK))/(EK+1 - EK)
C
C     IN WHICH CASE X WILL VARY FROM -1 (AT EK) TO +1 (AT EK+1) AND
C     EACH FUNCTION REDUCES TO THE NORMAL FORM...
C
C     F(X)=0.5*(FK*(1 - X) + FK+1*(1 + X))
C         =0.5*(FK+1 + FK) + 0.5*(FK+1 - FK)*X
C
C     BY DEFINING THE AVERAGE VALUE AND 1/2 THE CHANGE ACROSS THE
C     INTERVAL.
C
C     AVF=0.5*(FK+1 + FK)
C     DF= 0.5*(FK+1 - FK)
C     DE= 0.5*(EK+1 - EK)
C
C     EACH OF THE THREE FUNCTIONS REDUCES TO THE SIMPLE FORM...
C
C     F(X)=AVF+DF*X
C
C     AND THE TWO REQUIRED INTEGRALS REDUCE TO...
C
C     FLUX
C     ----
C     DE*EXP(-AVXCT*Z) * (INTEGRAL -1 TO +1)
C     ((AVS+DS*X)*EXP(-DXCT*Z*X)*DX)
C
C     REACTION
C     --------
C     DE*EXP(-AVXCT*Z) * (INTEGRAL -1 TO +1)
C     ((AVS*AVXCR+(AVS*DXCR+AVXCR*DS)*X+DS*DXCR*X*X)*EXP(-DXCT*Z*X)*DX)
C
C     WHERE
C
C     AVXCT   = AVERAGE VALUE OF THE TOTAL CROSS SECTION
C     AVXCR   = AVERAGE VALUE OF THE REACTION CROSS SECTION
C     AVS     = AVERAGE VALUE OF THE SOURCE
C     DXCT    = 1/2 THE CHANGE IN THE TOTAL CROSS SECTION
C     DXCR    = 1/2 THE CHANGE IN THE REACTION CROSS SECTION
C     DS      = 1/2 THE CHANGE IN THE SOURCE
C     DE      = 1/2 THE CHANGE IN THE ENERGY
C
C     NOTE THAT IN THIS FORM THE ENERGY ONLY APPEARS IN FRONT OF THE
C     INTEGRALS AND THE INTEGRALS ARE EXPRESSED ONLY IN TERMS OF THE
C     TABULATED VALUES OF S(E), XCT(E) AND XCR(E). IN PARTICULAR NO
C     DERIVATIVES ARE USED, SO THAT THERE ARE NO NUMERICAL INSTABILITY
C     PROBLEMS IN THE VACINITY OF DISCONTINUITIES IN S(E), XCT(E) OR
C     XCR(E). INDEED, SINCE (EK+1 - EK) APPEARS IN FRONT OF THE INTEGRAL
C     POINTS OF DISCONTINUITY AUTOMATICALLY MAKE ZERO CONTRIBUTION TO
C     THE INTEGRALS.
C
C     THE REQUIRED INTEGRALS CAN BE EXPRESSED IN TERMS OF THE THREE
C     INTEGRALS IN NORMAL FORM....
C
C     F(A,N) = (INTEGRAL -1 TO 1) (X**N*EXP(-A*X)*DX), N=0,1 AND 2.
C
C     THESE THREE INTEGRALS CAN BE EVALUATED TO FIND...
C
C     N=0
C     ---
C     F(A,0) = (EXP(A)-EXP(-A))/A
C
C     N=1
C     ---
C     F(A,1) = ((1-A)*EXP(A)-(1+A)*EXP(-A))/(A*A)
C
C     N=2
C     ---
C     F(A,2) = ((2-2*A+A*A)*EXP(A)-(2+2*A+A*A)*EXP(-A))/(A*A*A)
C
C     HOWEVER THESE EXPRESSIONS ARE NUMERICALLY UNSTABLE FOR SMALL
C     VALUES OF A. THEREFORE FOR SMALL A THE EXPONENTIAL IN THE
C     INTEGRALS ARE EXPANDED IN A POWER SERIES...
C
C     EXP(-AX)=1.0-(AX)+(AX)**2/2-(AX)**3/6+(AX)**4/24-........
C             =(SUM K=0 TO INFINITY) (-AX)**K/(K FACTORIAL)
C
C     AND THE INTEGRAL REDUCES TO THE FORM....
C
C     (SUM K=0 TO INFINITY) ((-A)**K/(K FACTORIAL)) *
C     (INTEGRAL -1 TO 1) (X**(N+K))*DX
C
C     WHICH CAN BE ANALYTICALLY EVAULATED TO FIND....
C     (K(N) = K FACTORIAL)
C
C     N=0
C     ---
C     F(A,0) = 2*(1+(A**2)/K(3)+(A**4)/K(5)+(A**6)/K(7)+....
C
C     N=1
C     ---
C     F(A,1) = -2*A*(2/K(3)+4*(A**2)/K(5)+6*(A**4)/K(7)+8*(A**6)/K(9)+..
C
C     N=2
C     ---
C     F(A,2) = 2*(2/K(3)+3*4*(A**2)/K(5)+5*6*(A**4)/K(7)+
C              7*8*(A**6)/K(9)+....
C
C     THESE EXPANSIONS ARE USED WHEN THE ABSOLUTE VALUE OF A IS LESS
C     THAN 0.1. BY TRUNCATING THE ABOVE SERIES BEFORE A**8 THE ERROR
C     RELATIVE TO THE LEADING TERM OF THE SERIES WILL BE 10**(-10),
C     YIELDING 10 DIGIT ACCURACY.
C
C     AFTER EVALUATING THE ABOVE FUNCTIONS, EITHER DIRECTLY OR BY USING
C     THE EXPANSION THE TWO REQUIRED INTEGRALS CAN BE WRITTEN AS...
C
C     FLUX
C     ----
C     DE*EXP(-AVXCT*Z)*(AVS*F(A,0) + DS*F(A,1))
C
C     REACTIONS
C     ---------
C     DE*EXP(-AVXCT*Z)*
C     (AVS*AVXCR*F(A,0) + (AVS*DXCR+AVXCR*DS)*F(A,1) + DS*DXCR*F(A,2))
C
C     INPUT FILES
C     -----------
C     FILENAME  UNIT  DESCRIPTION
C     --------  ----  -----------
C     INPUT       2   INPUT LINES
C     ENDFIN     10   EVALUATED DATA IN ENDF/B FORMAT
C
C     OUTPUT FILES
C     ------------
C     FILENAME  UNIT  DESCRIPTION
C     --------  ----  -----------
C     OUTPUT      3   OUTPUT LISTING
C
C     SCRATCH FILES
C     -------------
C     FILENAME  UNIT  DESCRIPTION
C     --------  ----  -----------
C     SCR1       12   REACTION, FLUX AND CROSS SECTION RESULTS (BCD)
C                     (SORTED AT END OF RUN AND OUTPUT SEPARATELY)
C     SCR2       13   TALLY GROUP ENERGY BOUNDARIES (BINARY)
C     SCR3       14   SOURCE SPECTRUM (BINARY)
C     SCR4       15   TOTAL CROSS SECTION (BINARY)
C     SCR5       16   REACTION CROSS SECTION (BINARY)
C
C     OPTIONAL STANDARD FILE NAMES (SEE SUBROUTINE FILIO1 AND FILEIO2)
C     ----------------------------------------------------------------
C     UNIT  FILE NAME   FORMAT
C     ----  ----------  ------
C       2   VIRGIN.INP   BCD
C       3   VIRGIN.LST   BCD
C      10   ENDFB.IN     BCD
C    11-15  (SCRATCH)   BINARY
C      16   PLOTTAB.CUR PLOTTAB OUTPUT FORMAT DATA
C
C     INPUT LINES
C     -----------
C     ANY NUMBER OF CASES MAY BE RUN ONE AFTER THE OTHER. AFTER THE
C     FIRST CASE HAS BEEN RUN THE FOLLOWING CASES MAY USE THE SAME
C     THICKNESSES, GROUP STRUCTURE AND SPECTRUM AS THE PRECEDING CASE.
C     IN ADDITION THE TRANSMITTED SPECTRUM FROM ONE CASE MAY BE USED
C     AS THE INCIDENT SPECTRUM IN THE NEXT CASE, TO ALLOW MULTIPLE
C     LAYERS OF DIFFERENT MATERIALS.
C
C     LINE  COLS.  FORMAT  DESCRIPTION
C     ----  -----  ------  ----------
C        1   1-60   ENDF/B INPUT DATA FILENAME
C                     (STANDARD OPTION = ENDFB.IN)
C
C     LEAVE THE DEFINITION OF THE FILENAMES BLANK - THE PROGRAM WILL
C     THEN USE STANDARD FILENAMES.
C
C      2-3   1-72   18A4   TWO LINE TITLE DESCRIBING PROBLEM
C        4   1- 6    I6    ZA (1000*Z+A) OF TARGET FOR TOTAL
C            7-11    I5    MT OF TOTAL
C           12-22   E11.4  DENSITY FOR TOTAL
C           23-28    I6    ZA (1000*Z+A) OF TARGET FOR REACTION
C           29-33    I5    MT OF REACTION
C                          = 0 - NO REACTION CALCULATION (ONLY FLUX).
C                          = GREATER THAN 0 - CALCULATE REACTIONS.
C           34-44   E11.4  DENSITY FOR REACTION
C           45-50    I6    NUMBER OF TARGET THICKNESSES
C                          = GREATER THAN 0 = READ FROM INPUT
C                            (1 TO 2000 ALLOWED)
C                          =  0 = SAME AS LAST CASE
C           51-55    I5    NUMBER OF TALLY GROUPS
C                          (REMEMBER NUMBER OF GROUP BOUNDARIES
C                          IS ONE MORE THAN THE NUMBER OF GROUPS)
C                          UP TO 2000 GROUPS ARE ALLOWED
C                          BUILT-IN GROUP STRUCTURES.
C                          = GREATER THAN 0 = READ FROM INPUT
C                          =  0 TART 175 GROUPS
C                          = -1 ORNL  50 GROUPS
C                          = -2 ORNL 126 GROUPS
C                          = -3 ORNL 171 GROUPS
C                          = -4 SAND-II 620 GROUPS..1.0D-4 eV TO 18 MEV
C                          = -5 SAND-II 640 GROUPS..1.0D-4 eV TO 20 MEV
C                          = -6 WIMS 69 GROUPS
C                          = -7 GAM-I 68 GROUPS
C                          = -8 GAM-II 99 GROUPS
C                          = -9 MUFT 54 GROUPS
C                          =-10 ABBN 28 GROUPS
C                          =-11 TART 616 GROUPS TO  20 MeV
C                          =-12 TART 700 GROUPS TO   1 GeV
C                          =-13 SAND-II 665 GROUPS..1.0D-5 eV TO 18 MEV
C                          =-14 SAND-II 685 GROUPS..1.0D-5 eV TO 20 MEV
C                          =-15 TART 666 GROUPS TO 200 MeV
C                          =-16 SAND-II 725 GROUPS..1.0D-5 eV TO  60 MEV
C                          =-17 SAND-II 755 GROUPS..1.0D-5 eV TO 150 MEV
C                          =-18 SAND-II 765 GROUPS..1.0D-5 eV TO 200 MEV
C                          =-19 UKAEA  1102 GROUPS..1.0D-5 eV to   1 GeV
C           56-60    I5    NUMBER OF POINTS IN SOURCE SPECTRUM
C                          (MUST BE AT LEAST TWO POINTS)
C                          = GREATER THAN 1 = READ FROM INPUT
C                          =  0 = SAME AS LAST CASE
C                          = -1 = CONSTANT (ENERGY INDEPENDENT)
C                          = -2 = 1/E
C                          = -3 = BLACKBODY - PHOTON SPECTRUM
C                          = -4 = BLACKBODY - ENERGY SPECTRUM
C                          = -5 = TRANSMITTED SPECTRUM FROM LAST CASE
C                          NOTE, ALL SPECTRA, EXCEPT THE TRANSMITTED
C                          SPECTRUM FROM THE LAST CASE, WILL BE
C                          NORMALIZED SUCH THAT ITS INTEGRAL OVER
C                          ENERGY WILL BE UNITY.
C           61-64  1X,3I1  SPATIALLY DEPENDENT OUTOUT
C                          = 0 = NO
C                          = 1 = YES
C                          FOR THE 3 QUANTITIES
C                          COLUMN 67 FLUX
C                                 68 REACTIONS
C                                 69 AVERAGE CROSS SECTION
C           65-65    I1    ENERGY DEPENDENT OUTOUT
C                          = 0 = NONE
C                          = 1 = INCIDENT SPECTRUM
C                          = 2 = TRANSMITTED SPECTRUM
C                          = 3 = INCIDENT REACTIONS
C                          = 4 = TRANSMIITED REACTIONS
C                          = 5 = TOTAL CROSS SECTION
C                          = 6 = REACTION CROSS SECTION
C        5   1-11   E11.4  BLACKBODY TEMPERATURE IN eV
C           12-22   E11.4  FLUX NORMALIZATION
C           23-33   E11.4  REACTION NORMALIZATION
C                          CALCULATIONS WILL BE BASED ON THE SPECTRUM
C                          AND CROSS SECTIONS AS READ. AT OUTPUT THE
C                          RESULTS WILL BE MULTIPLIED BY THESE
C                          NORMALIZATION FACTORS.
C           34-44    I11   DENSITY PROFILE
C                          = 0 - UNIFORM - BASED ON TOTAL DENSITY
C                          = 1 - UNIFORM - TOTAL + REACTION DENSITY
C                          = 2 - TOTAL + LINEAR REACTION
C                          = 3 - LINEAR (TOTAL + REACTION)
C                          = 4 - TOTAL + SQUARE REACTION
C                          = 5 - SQUARE (TOTAL + REACTION)
C                          = 6 - TOTAL + CUBIC REACTION
C                          = 7 - CUBIC (TOTAL + REACTION)
C      6-N   1-66  6E11.4  TARGET THICKNESSES IN CM
C                          IF SAME AS LAST CASE THIS SECTION IS NOT
C                          INCLUDED IN THE INPUT.
C     VARY   1-66  6E11.4  TALLY GROUP ENERGY BOUNDARIES
C                          (NUMBER OF BOUNDARIES IS ONE MORE THAN
C                          THE NUMBER OF TALLY GROUPS)
C                          IF THE STANDARD OPTION (-14 TO 0) IS
C                          SELECTED THIS SECTION IS NOT INCLUDED
C                          IN THE INPUT
C     VARY   1-66  6E11.4  SOURCE SPECTRUM IN ENERGY (eV)-SOURCE PAIRS
C                          (MUST BE AT LEAST TWO POINTS)
C                          IF STANDARD OPTION (-5 TO 0) IS SELECTED THIS
C                          SECTION IS NOT INCLUDED IN THE INPUT
C
C     ANY NUMBER OF CASES MAY BE RUN ONE AFTER ANOTHER.
C
C     EXAMPLE INPUT NO. 1
C     -------------------
C     CALCULATE THE UNCOLLIDED FLUX AND CAPTURE (MT=102) THROUGH
C     30 CM OF IRON (DENSITY 7.87 G/CC). TALLY THE RESULTS USING
C     THE TART 175 GROUP STRUCTURE. THE SOURCE WILL BE CONSTANT
C     FROM 1 KEV TO 20 MEV. USE THE STANDARD ENDF/B INPUT DATA
C     FILENAME.
C
C     ENDFB.IN
C     IRON 0 TO 30 CM THICK.
C     CONSTANT SOURCE FROM 1 KEV TO 20 MEV.
C      26000    1 7.8700D+ 0 26000  102 7.8700D+ 0     2    0    2 1100
C      0.0000D+ 0 1.0000D+ 0 1.0000D+ 0          0 0.0000D+00
C      0.0000D+00 3.0000D+01
C      1.0000D+03 1.0000D+00 2.0000D+07 1.0000D+00
C
C     EXAMPLE INPUT NO. 2
C     -------------------
C     CALCULATE THE UNCOLLIDED PHOTON FLUX THROUGH A MIXTURE OF SILICON
C     AND IRON FOR 100 MEV PHOTONS INCIDENT. THE TRANSMISSION WILL BE
C     CALCULATED FOR 21 THICKNESSES VARYING BETWEEN 0 AND 1 CM. THERE
C     WILL BE ONLY 1 TALLY GROUP SPANNING A VERY NARROW ENERGY RANGE
C     NEAR 100 MEV, AND THE SOURCE SPECTRUM WILL BE CONSTANT OVER THE
C     SAME ENERGY RANGE. USE THE STANDARD ENDF/B INPUT DATA FILENAME
C     BY LEAVING THE FIRST INPUT LINE BLANK.
C
C     (THIS IS A BLANK LINE TO USE THE STANDARD INPUT FILENAME)
C     100 MEV PHOTONS
C     SILICON + 5 % IRON
C      14000  521 2.30000+ 0 26000  521 1.15000- 1    21    1    2 1000
C      0.00000+ 0 1.00000+ 0 1.00000+ 0          1 0.00000+00
C      0.00000+00 5.00000-01 1.00000+00 1.50000+00 2.00000+00 2.50000+00
C      3.00000+00 3.50000+00 4.00000+00 4.50000+00 5.00000+00 5.50000+00
C      6.00000+00 6.50000+00 7.00000+00 7.50000+00 8.00000+00 8.50000+00
C      9.00000+00 9.50000+00 1.00000+01
C      9.99000+ 7 1.00100+ 8
C      9.99000+ 7 1.00000+ 4 1.00100+ 8 1.00000+ 4
C
C=======================================================================
      INCLUDE 'implicit.h'
C-----08/08/2012 DEFINE CODE NAME
      CHARACTER*8 CODENAME
      COMMON/NAMECODE/CODENAME
      CHARACTER*1 FIELDX
      CHARACTER*4 TITLE,KOUT,ANSWER
      CHARACTER*10 GOOF1,GOOF6
      CHARACTER*16 HOLWAY
      CHARACTER*24 OPOUT,HOLSP
      CHARACTER*28 HOLCOM
      CHARACTER*20 HOLGRP,HOLTHICK
      INTEGER*4 OUTP,OTAPE,HOLGRI,HOLSPA
      CHARACTER*72 NAMEIN,LASTIN
      COMMON/ENDFIO/INP,OUTP,ITAPE,OTAPE
      COMMON/IOSTATUS/ISTAT1,ISTAT2
      COMMON/PAGER/IXYLOW(3),IXYHI(3)
      COMMON/ENDFB/IZATOT,MTTOT,DENSET,IZARAC,MTRACT,DENSER
      COMMON/TALLY/THICKL,NTHICK
      COMMON/REALLY/XSTART(3),XFIN(3),YSTART(3),YFIN(3),IPTAB(3),
     1 NPTAB(3)
      COMMON/GPPAGE/NGROUP,NGPP1,NGRLOW,NGRHI
      COMMON/LIMITS/EMIN(3),EMAX(3),SPLOW
      COMMON/CONJOB/CTAB(5,3)
      COMMON/SIZES/NPAGE,NPAGEM
      COMMON/TITLES/TITLE(36)
      COMMON/OUTIT/IMOUT(4),IMOPEN
      COMMON/NORMS/YNORM(3),FLUXNR,SPNORM,IMFLAT
      COMMON/TRANST/ESPMAX,NTRAN
      COMMON/NAMEX/NAMEIN
      COMMON/LAST1/LZATOT,LZARAC,LTTOT,LTRACT
      COMMON/FIELDC/FIELDX(11,12)
      INCLUDE 'virgin.h'
      DIMENSION FACTN(11),KOUT(3),HOLGRI(22),HOLSPA(8),ANSWER(2),
     1 HOLSP(8),HOLGRP(22),HOLTHICK(2),HOLCOM(8),GOOF6(6),HOLWAY(3),
     2 OPOUT(7)
      DATA IPASS/0/
C-----DEFINE UNNORMALIZED MINIMUM SPECTRUM VALUE OF INTEREST
      DATA YLOW/1.0D-20/
      DATA ANSWER/' No ',' Yes'/
      DATA HOLCOM/
     1 'Uniform - Total             ',
     2 'Uniform - Total + Reaction  ',
     3 'Total + Linear Reaction     ',
     4 'Linear (Total + Reaction)   ',
     5 'Total + Square Reaction     ',
     6 'Square (Total + Reaction)   ',
     7 'Total + Cubic Reaction      ',
     8 'Cubic (Total + Reaction)    '/
      DATA HOLWAY/
     1 '(0 to Thickness)',
     2 '(Thickness to 0)',
     3 '                '/
      DATA OPOUT/
     1 'None                    ',
     2 'Incident Spectrum       ',
     3 'Transmitted Spectrum    ',
     4 'Incident Reactions      ',
     5 'Transmitted Reactions   ',
     6 'Total Cross Sections    ',
     7 'Reaction Cross Sections '/
C-----DEFINE BUILT IN GROUP STRUCTURES.
      DATA HOLGRI/175,50,126,171,620,640,69,68,99,54,28,616,700,
     1 665,685,666,725,755,765,1102,0,0/
      DATA HOLGRP/
     1 ' (TART)             ',
     2 ' (ORNL)             ',
     3 ' (ORNL)             ',
     4 ' (ORNL)             ',
     5 ' (SAND-II)          ',
     6 ' (SAND-II)          ',
     7 ' (WIMS)             ',
     8 ' (GAM-I)            ',
     9 ' (GAM-II)           ',
     A ' (MUFT)             ',
     1 ' (ABBN)             ',
     2 ' (TART)             ',
     3 ' (TART)             ',
     4 ' (SAND-II)          ',
     5 ' (SAND-II)          ',
     6 ' (TART)             ',
     7 ' (SAND-II)          ',
     8 ' (SAND-II)          ',
     9 ' (SAND-II)          ',
     A ' (UKAEA)            ',
     1 ' (Read from Input)  ',
     2 ' (ERROR)            '/
c-----thickness summary.
      DATA HOLTHICK/
     1 '                    ',
     2 ' (ERROR)            '/
C-----DEFINE BUILT IN WEIGHTING SPECTRUM.
      DATA HOLSPA/0,2,2000,2000,2000,0,0,0/
      DATA HOLSP/
     1 ' (Last Case Incident)   ',
     2 ' (Constant)             ',
     3 ' (1/E)                  ',
     4 ' (Blackbody-Photons)    ',
     5 ' (Blackbody-Energy)     ',
     6 ' (Last Case Transmitted)',
     7 ' (Read From Input)      ',
     8 ' (ERROR)                '/
c       123456789012345678901234
      DATA GOOF1/'**ERROR***'/
C-----INITIALIZE LAST ENDF/B DATA FILENAME
      DATA LASTIN/'    '/
C-----08/08/2012 DEFINE CODE NAME
      CODENAME = 'VIRGIN  '
C-----INITIALIZE TIMER
      CALL TIMER
c-----------------------------------------------------------------------
C
C     DEFINE ALL I/O UNITS AND OPTIONALLY DEFINE FILENAMES.
C
c-----------------------------------------------------------------------
      CALL FILIO1
C-----IDENTIFY CODE (FOR FIRST CASE)
      WRITE(OUTP,320)
      WRITE(*   ,320)
c-----------------------------------------------------------------------
C
C     TERMINATE IF ERROR OPENING INPUT FILE
C
c-----------------------------------------------------------------------
      IF(ISTAT1.EQ.1) THEN
      WRITE(OUTP,10)
      WRITE(   *,10)
   10 FORMAT(//' ERROR - Opening VIRGIN.INP input parameter file'//)
      CALL ENDERROR
      ENDIF
c-----------------------------------------------------------------------
C
C     Start Run
C
c-----------------------------------------------------------------------
C-----DEFINE PAGE SIZES.
      NPAGE=MAXPOINT
      NPAGEM=NPAGE-1
C-----INITIALIZE LAST TOTAL AND REACTION (I.D. AND POINT COUNT).
      LZATOT=0
      LZARAC=0
      LTTOT=0
      LTRACT=0
C-----DEFINE FACTORIALS FOR EXPONENTIAL EXPANSIONS.
      FACTN(1)=1.0d0
      FMULT=FACTN(1)
      DO 20 N=2,11
      FMULT=FMULT+FACTN(1)
      FACTN(N)=FMULT*FACTN(N-1)
   20 CONTINUE
C-----DEFINE CONSTANTS TO USE IN EXPANSION OF INTEGRALS USED TO DEFINE
C-----UNCOLLIDED FLUX AND REACTION RATE.
      CTAB(1,1)= 2.0d0
      CTAB(2,1)= 2.0d0/FACTN(3)
      CTAB(3,1)= 2.0d0/FACTN(5)
      CTAB(4,1)= 2.0d0/FACTN(7)
      CTAB(5,1)= 2.0d0/FACTN(9)
      CTAB(1,2)= 4.0d0/FACTN(3)
      CTAB(2,2)= 8.0d0/FACTN(5)
      CTAB(3,2)=12.0d0/FACTN(7)
      CTAB(4,2)=16.0d0/FACTN(9)
      CTAB(5,2)=20.0d0/FACTN(11)
      CTAB(1,3)= 4.0d0/FACTN(3)
      CTAB(2,3)=24.0d0/FACTN(5)
      CTAB(3,3)=60.0d0/FACTN(7)
      CTAB(4,3)=112.0d0/FACTN(9)
      CTAB(5,3)=180.0d0/FACTN(11)
C-----INITIALIZE ALL COUNTS.
      IMOPEN=0
      NGROUP=0
      NTHICK=0
      THICKL=0.0d0
      DO 30 I=1,3
      NPTAB(I)=0
   30 CONTINUE
C=======================================================================
C
C     NEXT CASE
C
C=======================================================================
C-----IDENTIFY CODE (FOR ALL CASES AFTER FIRST CASE)
      IPASS = IPASS + 1
      IF(IPASS.GT.1) WRITE(OUTP,320)
      IF(IPASS.GT.1) WRITE(   *,320)
c-----------------------------------------------------------------------
C
C     READ FILENAMES - IF BLANK USE STANDARD FILENAMES
C
c-----------------------------------------------------------------------
C-----INPUT DATA.
      READ(INP,40,END=130,ERR=130) NAMEIN
   40 FORMAT(A72)
      IF(NAMEIN.EQ.' ') NAMEIN = 'ENDFB.IN'
      WRITE(OUTP,50) NAMEIN
      WRITE(*   ,50) NAMEIN
   50 FORMAT(
     1 ' ENDF/B INPUT DATA FILENAMES'/1X,A72/
     2 1X,72('-'))
c-----------------------------------------------------------------------
C
C     OPEN ENDF/B DATA FILES
C
c-----------------------------------------------------------------------
      CALL FILIO2
c-----------------------------------------------------------------------
C
C     TERMINATE IF EREROR OPENING ENDF/B DATA FILE
C
c-----------------------------------------------------------------------
      IF(ISTAT2.EQ.1) THEN
      WRITE(OUTP,60) NAMEIN
      WRITE(   *,60) NAMEIN
   60 FORMAT(//' ERROR - Opening ENDF/B data file'/1X,A72//)
      CALL ENDERROR
      ENDIF
c-----------------------------------------------------------------------
C
C     IF NOT THE SAME FILE NAME AS LAST CASE INITIALIZE ZA, REACTION
C
c-----------------------------------------------------------------------
      IF(NAMEIN.EQ.LASTIN) GO TO 70
      LASTIN = NAMEIN
      LZATOT=0
      LZARAC=0
      LTTOT=0
      LTRACT=0
c-----------------------------------------------------------------------
C
C     READ REMAINING INPUT PARAMETERS.
C
c-----------------------------------------------------------------------
C-----INITIALIZE NORMALIZATIONS.
   70 YNORM(1)=1.0d0
      YNORM(2)=1.0d0
      YNORM(3)=1.0d0
C-----READ INPUT PARAMETERS.
      READ(INP,80,END=130,ERR=130) TITLE
   80 FORMAT(18A4)
C     TITLE   = 2 LINE TITLE FOR RUN
C-----PRINT TITLE FOR OUTPUT REPORT.
      WRITE(OUTP,330) TITLE
      WRITE(*   ,330) TITLE
C----- 2017/5/6 - Changed all floating point to character
C-----READ AND LIST INPUT PARAMETERS.
      READ(INP,90) IZATOT,MTTOT,(FIELDX(j,1),j=1,11),IZARAC,
     1 MTRACT,(FIELDX(j,2),j=1,11),NTHIN,NGRIN,NPTSP,IMOUT
   90 FORMAT(I6,I5,11A1,I6,I5,11A1,I6,2I5,1X,4I1)
      CALL IN9(DENSET,FIELDX(1,1))
      CALL IN9(DENSER,FIELDX(1,2))
      READ(INP,100) ((FIELDX(j,k),j=1,11),k=1,3),IMFLAT
  100 FORMAT(33A1,I11)
      CALL IN9(TEMPK ,FIELDX(1,1))
      CALL IN9(FLUXNR,FIELDX(1,2))
      CALL IN9(SPNORM,FIELDX(1,3))
C----- 2017/5/6 - Changed all floating point to character
      IF(MTRACT.LT.0) MTRACT=0
C-----DEFINE TYPE OF GROUP STRUCTURE.
      INGRP=22
      IF(NGRIN.GT.0) INGRP=21
C----- 2017/4/11 - Added UKAEA = -19
      IF(NGRIN.LE.0.AND.NGRIN.GE.-19) INGRP=1-NGRIN
      HOLGRI(21)=NGRIN
      HOLGRI(22)=NGRIN
C-----DEFINE TYPE OF WEIGHTING SPECTRUM.
      INSP=8
      IF(NPTSP.LE.0.AND.NPTSP.GE.-5) INSP=1-NPTSP
      IF(NPTSP.GE.2) INSP=7
      HOLSPA(1)=NPTAB(3)
      HOLSPA(6)=NTRAN
      HOLSPA(7)=NPTSP
      HOLSPA(8)=NPTSP
      IF(FLUXNR.LE.0.0d0) FLUXNR=1.0d0
      IF(SPNORM.LE.0.0d0) SPNORM=1.0d0
C-----DEFINE NORMALIZED MINIMUM SPECTRUM OF INTEREST.
      SPLOW=YLOW/SPNORM
      IF(IABS(IMFLAT).LT.0.OR.IABS(IMFLAT).GT.7) IMFLAT=0
C-----DEFINE OUTPUT OPTIONS.
      DO 110 I=1,3
      IF(IMOUT(I).NE.0) IMOUT(I)=1
      II=IMOUT(I)+1
      KOUT(I)=ANSWER(II)
  110 CONTINUE
      IF(IMOUT(4).LT.0.OR.IMOUT(4).GT.6) IMOUT(4)=0
c-----------------------------------------------------------------------
C
C     LIST INTERPRETATION OF INPUT PARAMETERS.
C
c-----------------------------------------------------------------------
      KTHICK=NTHIN
      IF(NTHIN.LE.0) KTHICK=NTHICK
      MTHICK=1
      IF(NTHIN.LE.0) MTHICK=2
      CALL OUT9(DENSET,FIELDX(1,1))
      CALL OUT9(DENSER,FIELDX(1,2))
      WRITE(OUTP,340) IZATOT,MTTOT,(FIELDX(M,1),M=1,11),
     1 IZARAC,MTRACT,(FIELDX(M,2),M=1,11),
     2 KTHICK,HOLTHICK(MTHICK),
     3 HOLGRI(INGRP),HOLGRP(INGRP),
     4 HOLSPA(INSP),HOLSP(INSP)
      WRITE(*   ,340) IZATOT,MTTOT,(FIELDX(M,1),M=1,11),
     1 IZARAC,MTRACT,(FIELDX(M,2),M=1,11),
     2 KTHICK,HOLTHICK(MTHICK),
     3 HOLGRI(INGRP),HOLGRP(INGRP),
     4 HOLSPA(INSP),HOLSP(INSP)
C-----LIST OUTPUT OPTIONS.
      WRITE(OUTP,390) KOUT
      WRITE(*   ,390) KOUT
      II=IMOUT(4)+1
      WRITE(OUTP,400) OPOUT(II)
      WRITE(*   ,400) OPOUT(II)
C-----IF BLACKBODY SPECTRUM LIST TEMPERATURE.
      IF(NPTSP.NE.-3.AND.NPTSP.NE.-4) GO TO 120
      CALL OUT9(TEMPK ,FIELDX(1,1))
      WRITE(OUTP,350) (FIELDX(M,1),M=1,11)
      WRITE(*   ,350) (FIELDX(M,1),M=1,11)
      IF(TEMPK.LE.0.0d0) INSP=8
  120 CALL OUT9(FLUXNR,FIELDX(1,1))
      CALL OUT9(SPNORM,FIELDX(1,2))
      WRITE(OUTP,360) ((FIELDX(M,I),M=1,11),I=1,2)
      WRITE(*   ,360) ((FIELDX(M,I),M=1,11),I=1,2)
      II=IABS(IMFLAT)+1
      III=3
      IF(IMFLAT.GT.0) III=1
      IF(IMFLAT.LT.0) III=2
      WRITE(OUTP,370) HOLCOM(II),HOLWAY(III)
      WRITE(*   ,370) HOLCOM(II),HOLWAY(III)
c-----------------------------------------------------------------------
C
C     TERMINATE IF ALL INPUT PARAMETERS ARE NOT ACCEPTABLE.
C
c-----------------------------------------------------------------------
      IF(IZATOT.GT.0.AND.MTTOT.GE.0.AND.
     1 NGRIN.GE.-19.AND.NGRIN.LE.MAXGROUP.AND.
     2 INSP.NE.8.AND.
     3 NTHIN.GE.0.AND.NTHIN.LE.MAXGROUP.AND.
     5 DENSET.GT.0.0d0) GO TO 140
      WRITE(OUTP,380) MAXGROUP,MAXGROUP
      WRITE(*   ,380) MAXGROUP,MAXGROUP
  130 CALL ENDERROR
c-----------------------------------------------------------------------
C
C     READ AND LIST THICKESSES
C
c-----------------------------------------------------------------------
C-----ALLOW SAME AS LAST CASE.
  140 IF(NTHIN.GT.0) GO TO 150
      IF(NTHICK.GT.0) GO TO 190
      WRITE(OUTP,440)
      WRITE(*   ,440)
      CALL ENDERROR
C-----READ THICKNESSES.
  150 NTHICK=NTHIN
C----- 2017/5/6 - Changed all floating point to character
      CALL LISTIV(INP,THICKI,NTHICK)
C----- 2017/5/6 - Changed all floating point to character
C-----PRINT THICKNESSES AND CHECK FOR ASCENDING ORDER.
      WRITE(OUTP,420)
      WRITE(*   ,420)
      IERR=0
      DO 180 I1=1,NTHICK,6
      I2=I1+5
      IF(I2.GT.NTHICK) I2=NTHICK
      II=0
      KERR=0
      DO 170 K=I1,I2
      II=II+1
C-----FORMAT FOR OUTPUT.
      CALL OUT9(THICKI(K),FIELDX(1,II))
C-----CHECK FOR ASCENDING ORDER.
      IF(K.EQ.1) GO TO 160
      IF(THICKI(K).GT.THICKI(K-1)) GO TO 160
      KERR=1
      GOOF6(II)=GOOF1
      GO TO 170
  160 GOOF6(II)='    '
  170 CONTINUE
C-----PRINT LINE AND IF NECESSARY ERROR MESSAGE.
      WRITE(OUTP,430) ((FIELDX(M,K),M=1,11),K=1,II)
      WRITE(*   ,430) ((FIELDX(M,K),M=1,11),K=1,II)
      IF(KERR.LE.0) GO TO 180
      IERR=1
      WRITE(OUTP,460) (GOOF6(K),K=1,II)
      WRITE(*   ,460) (GOOF6(K),K=1,II)
  180 CONTINUE
C-----TERMINATE IF THICKNESSES ARE NOT IN ASCENDING ORDER.
      IF(IERR.LE.0) GO TO 190
      WRITE(OUTP,470)
      WRITE(*   ,470)
      CALL ENDERROR
c-----------------------------------------------------------------------
C
C     DEFINE GROUP STRUCTURE.
C
c-----------------------------------------------------------------------
  190 IF(NGRIN.gt.0) go to 200
C-----DEFINE ONE OF THE STANDARD BUILT-IN GROUP STRUCTURES.
      IWANT=-NGRIN
      CALL GROPE(IWANT,EGROUP,NGROUP)
      GO TO 210
C-----READ ARBITRARY GROUP STRUCTURE.
  200 NGROUP=NGRIN
      CALL GROPIN
C-----DEFINE ENERGY LIMITS OF TALLY GROUPS.
  210 NGPP1=NGROUP+1
c-----------------------------------------------------------------------
C
C     DEFINE WEIGHTING SPECTRUM
C
c-----------------------------------------------------------------------
C-----DEFINE ENERGY LIMITS FOR BUILT-IN SPECTRA.
      XLOW =0.999d0*EGROUP(1)
      XHIGH=1.001d0*EGROUP(NGPP1)
C-----INITIALIZE ACCUMULATED THICKNESS UNLESS TRANSMITTED SPECTRUM FROM
C-----LAST CASE WILL BE USED.
      IF(NPTSP.EQ.-5) GO TO 220
      THICKL=0.0d0
      IMOPEN=0
C-----READ SPECTRUM FROM INPUT OR USE BUILT-IN SPECTRUM.
  220 IF(NPTSP.GT.0) GO TO 290
      II=1-NPTSP
      GO TO (300,230,240,250,260,280),II
C-----DEFINE NORMALIZED CONSTANT WEIGHTING SPECTRUM.
  230 NPTAB(3)=2
      XTAB(1,3)=XLOW
      XTAB(2,3)=XHIGH
      YTAB(1,3)=1.0d0/(XHIGH-XLOW)
      YTAB(2,3)=YTAB(1,3)
      GO TO 270
C-----DEFINE 1/E WEIGHTING SPECTRUM.
  240 NPTAB(3)=MAXGROUP
      CALL OVERE(XTAB(1,3),YTAB(1,3),NPTAB(3),XLOW,XHIGH)
      GO TO 270
C-----DEFINE BLACKBODY SPECTRUM (PHOTON SPECTRUM).
  250 NPTAB(3)=MAXGROUP
      CALL BBODY(TEMPK,XTAB(1,3),YTAB(1,3),NPTAB(3),XLOW,XHIGH,1)
      GO TO 270
C-----DEFINE BLACKBODY SPECTRUM (ENERGY SPECTRUM).
  260 NPTAB(3)=MAXGROUP
      CALL BBODY(TEMPK,XTAB(1,3),YTAB(1,3),NPTAB(3),XLOW,XHIGH,2)
c-----------------------------------------------------------------------
C
C     INITIALIZE SPECTRUM PARAMETERS - ENTIRE SPECTRUM IS IN CORE.
C
c-----------------------------------------------------------------------
  270 IXYLOW(3)=0
      II=NPTAB(3)
      IXYHI(3)=II
      EMIN(3)=XTAB(1,3)
      EMAX(3)=XTAB(II,3)
      GO TO 300
c-----------------------------------------------------------------------
C
C     DEFINE TRANSMITTED SPECTRUM FROM LAST CASE TO BE INCIDENT SPECTRUM
C     FOR CURRENT CASE.
C
c-----------------------------------------------------------------------
  280 CALL TRANSI
      GO TO 300
c-----------------------------------------------------------------------
C
C     READ TABULATED SPECTRUM FROM INPUT.
C
c-----------------------------------------------------------------------
  290 NPTAB(3)=NPTSP
      ONED=1.0d0
      CALL PAGIN3(INP,3,ONED)
c-----------------------------------------------------------------------
C
C     DETERMINE IF ENERGY RANGE OF SPECTRUM SPANS THE ENERGY RANGE OF
C     THE GROUPS.
C
c-----------------------------------------------------------------------
  300 IF(EMIN(3).LE.EGROUP(1).AND.EMAX(3).GE.EGROUP(NGPP1)) GO TO 310
C-----CONVERT DATA TO SINGLE PRECISION FOR FORMAT.
      CALL OUT9(EMIN(3)      ,FIELDX(1,1))
      CALL OUT9(EMAX(3)      ,FIELDX(1,2))
      CALL OUT9(EGROUP(1)    ,FIELDX(1,3))
      CALL OUT9(EGROUP(NGPP1),FIELDX(1,4))
      WRITE(OUTP,410) ((FIELDX(M,I),M=1,11),I=1,4)
      WRITE(*   ,410) ((FIELDX(M,I),M=1,11),I=1,4)
c-----------------------------------------------------------------------
C
C     ALL INPUT DATA DEFINED. RETRIEVE EVALUATED DATA AND PERFORM
C     UNCOLLIDED TRANSMISSION CALCULATION.
C
c-----------------------------------------------------------------------
C-----PRINT SUMMARY OF DATA
  310 CALL OUT9(EGROUP(1)    ,FIELDX(1,1))
      CALL OUT9(EGROUP(NGPP1),FIELDX(1,2))
      CALL OUT9(EMIN(3)      ,FIELDX(1,3))
      CALL OUT9(EMAX(3)      ,FIELDX(1,4))
      WRITE(OUTP,450) NGROUP,((FIELDX(M,K),M=1,11),K=1,2),
     1 NPTAB(3),((FIELDX(M,K),M=1,11),K=3,4)
      WRITE(*   ,450) NGROUP,((FIELDX(M,K),M=1,11),K=1,2),
     1 NPTAB(3),((FIELDX(M,K),M=1,11),K=3,4)
c-----Initialize MT table for entire Data used
      CALL MAXIE0
C-----FIND EVALUATED DATA IN ENDF/B FORMAT.
      CALL GETZA
C-----PERFORM TRANSMISSION CALCULATION.
      CALL NOHITS
c-----Check MT table for same Maximum Energy
      CALL MAXIE3(1)
c-----Print final WARNINH if data not tabulated to same Maximum Energy
      CALL MAXIE4(1)
C-----END OF RUN - PRINT CURRENT EXECUTION TIME
      CALL ENDIT
      GO TO 310  ! CANNOT GET TO HERE
  320 FORMAT(///1X,72('=')/
     1 ' UNCOLLIDED (I.E. VIRGIN) FLUX AND REACTION CALCULATION',
     2 ' (VIRGIN 2020-1)'/1X,72('='))
  330 FORMAT(' PROBLEM TITLE'/1X,72('-')/1X,18A4/1X,18A4/1X,72('-'))
  340 FORMAT(' INTERPRETATION OF INPUT PARAMETERS'/1X,72('-')/
     1 ' TOTAL ZA/MT/DENSITY-----',I6,'/',I4,'/',11A1/
     2 ' REACTION ZA/MT/DENSITY--',I6,'/',I4,'/',11A1/
     3 ' THICKNESSES-------------',I11,A20/
     4 ' TALLY GROUPS------------',I11,A20/
     5 ' SPECTRUM POINTS---------',I11,A24)
  350 FORMAT(
     1 ' BLACKBODY TEMPERATURE---',11A1,' eV')
  360 FORMAT(
     1 ' FLUX NORMALIZATION------',11A1/
     1 ' REACTION NORMALIZATION--',11A1)
  370 FORMAT(
     1 ' COMPOSITION-------------',1X,A28,1X,A16)
  380 FORMAT(1X,72('-')/
     1 ' ERROR IN INPUT PARAMETERS...CHECK THE FOLLOWING'/1X,72('-')/
     2 ' TOTAL ZA AND MT--------- MUST BE GREATER THAN ZERO'/
     3 ' TOTAL DENSITY----------- MUST BE POSITIVE         '/
     4 ' THICKNESSES------------- MUST BE 1 TO ',I6/
     5 ' TALLY GROUPS------------ MUST BE -19 TO ',I6/
     6 ' SPECTRUM POINTS--------- MUST BE GREATER THAN -6  '/
     7 ' BLACKBODY TEMPERATURE--- MUST BE POSITIVE         '/
     8 1X,72('-')/' EXECUTION TERMINATED')
  390 FORMAT(' OUTPUT FLUX-------------',A4/
     1       ' OUTPUT REACTIONS--------',A4/
     2       ' OUTPUT CROSS SECTIONS---',A4)
  400 FORMAT(' ENERGY DEPENDENT OUTPUT- ',A24)
  410 FORMAT(1X,72('-')/' WARNING...SPECTRUM ENERGY RANGE  ',
     1 11A1,' TO ',11A1,' eV'/
     2 ' DOES NOT SPAN ENERGY GROUP RANGE ',11A1,' TO ',
     3 11A1,' eV'/' WILL TRUNCATE RANGE OF CALCULATION TO',
     4 ' OVERLAPPING ENERGY RANGE')
  420 FORMAT(1X,72('-')/' THICKNESSES (CM)'/1X,72('-'))
  430 FORMAT(66A1)
  440 FORMAT(' NO PRECEDING CASE DEFINING NUMBER OF THICKNESSES'/
     1 ' EXECUTION TERMINATED')
  450 FORMAT(1X,72('-')/' SUMMARY OF DATA USED'/1X,72('-')/
     1 ' TYPE                        POINTS ENERGY RANGE'/1X,72('-')/
     1 ' GROUPS------------------',I10,
     1 11A1,' TO ',11A1,' eV'/
     2 ' SPECTRUM----------------',I10,
     1 11A1,' TO ',11A1,' eV')
  460 FORMAT(6(1X,A10))
  470 FORMAT(1X,72('-')/' ERROR = THICKNESSES ARE NOT IN ASCENDING ',
     1 'ORDER. EXECUTION TERMINATED'/1X,72('-'))
      END
      SUBROUTINE GETZA
C=======================================================================
C
C     GET REQUEST EVALUATION (BY ZA)
C
C=======================================================================
      INCLUDE 'implicit.h'
      INTEGER*4 OUTP,OTAPE
      CHARACTER*1 FIELDX
      COMMON/ENDFIO/INP,OUTP,ITAPE,OTAPE
      COMMON/ENDFB/IZATOT,MTTOT,DENSET,IZARAC,MTRACT,DENSER
      COMMON/REALLY/XSTART(3),XFIN(3),YSTART(3),YFIN(3),IPTAB(3),
     1 NPTAB(3)
      COMMON/HEADER/C1H,C2H,L1H,L2H,N1H,N2H,MATH,MFH,MTH,NOSEQ
      COMMON/LEADER/C1,C2,L1,L2,N1,N2,MAT,MF,MT
      COMMON/WHATZA/IZA
      COMMON/LIMITS/EMIN(3),EMAX(3),SPLOW
      COMMON/LAST1/LZATOT,LZARAC,LTTOT,LTRACT
      COMMON/FIELDC/FIELDX(11,12)
      INCLUDE 'virgin.h'
c-----------------------------------------------------------------------
C
C     IF SAME DATA AS LAST CASE SIMPLY RETURN (DATA IS ALREADY IN CORE).
C
c-----------------------------------------------------------------------
      IF(IZATOT.NE.LZATOT.OR.
     1   IZARAC.NE.LZARAC.OR.
     2   MTTOT.NE.LTTOT.OR.
     3   MTRACT.NE.LTRACT) GO TO 20
C-----IDENTIFY DATA CURRENTLY IN CORE.
      CALL OUT9(EMIN(1)      ,FIELDX(1,1))
      CALL OUT9(EMAX(1)      ,FIELDX(1,2))
      WRITE(OUTP,220) NPTAB(1),((FIELDX(M,K),M=1,11),K=1,2)
      WRITE(*   ,220) NPTAB(1),((FIELDX(M,K),M=1,11),K=1,2)
      IF(MTRACT.LE.0) GO TO 10
      CALL OUT9(EMIN(2)      ,FIELDX(1,1))
      CALL OUT9(EMAX(2)      ,FIELDX(1,2))
      WRITE(OUTP,240) NPTAB(2),((FIELDX(M,K),M=1,11),K=1,2)
      WRITE(*   ,240) NPTAB(2),((FIELDX(M,K),M=1,11),K=1,2)
      RETURN
   10 WRITE(OUTP,230)
      WRITE(*   ,230)
      RETURN
c-----------------------------------------------------------------------
C
C     SAVE REQUESTED ZA AND MT.
C
c-----------------------------------------------------------------------
   20 LZATOT=IZATOT
      LZARAC=IZARAC
      LTTOT=MTTOT
      LTRACT=MTRACT
c-----------------------------------------------------------------------
C
C     FIND REQUESTED CROSS SECTIONS.
C
c-----------------------------------------------------------------------
C-----INITIALIZE POINT COUNTS FOR TOTAL AND REACTION.
      NPTAB(1)=0
      NPTAB(2)=0
C-----REWIND ENDF/B DATA FILE.
      REWIND ITAPE
C-----SKIP ENDF/B TAPE LABEL.
      CALL SKIP1
c-----------------------------------------------------------------------
C
C     FIND REQUESTED ZA.
C
c-----------------------------------------------------------------------
C-----READ SECTION HEAD LINE OR END LINE (SEND,FEND,MEND,TEND)
   30 CALL CONTI
      IF(MTH.GT.0) GO TO 40
      IF(MATH.lt.0) go to 160
      go to 30
C-----SECTION HEAD LINE. TEST FOR TOTAL OR REACTION ZA.
   40 ZA    = C1H
      AWRIN = C2H
      IZA   = ZA
      IF(IZA.EQ.IZATOT) GO TO 50
      IF(IZA.EQ.IZARAC) GO TO 50
C-----SKIP MATERIAL.
      CALL SKIPM
      GO TO 30
c-----------------------------------------------------------------------
C
C     REQUESTED ZA FOUND. LOCATE FILE 3 OR 23 DATA.
C
c-----------------------------------------------------------------------
C-----SEARCH FOR NEUTRON (MF=3) OR PHOTON (MF=23) CROSS SECTIONS.
   50 IF(MFH.lt.3) go to 60
      IF(MFH.eq.3) go to 80
      IF(MFH.eq.23) go to 80
      IF(MFH.gt.23) go to 170
C-----SKIP FILE.
   60 CALL SKIPF
C-----POSITION TO NEXT SECTION IN EVALUATION.
   70 CALL CONTI
      IF(MTH.gt.0) go to 50
      IF(MATH.le.0) go to 170
      go to 70
c-----------------------------------------------------------------------
C
C     FILE 3 OR 23 FOUND. LOCATE TOTAL OR REACTION DATA.
C
c-----------------------------------------------------------------------
   80 IF(IZA.EQ.IZATOT.AND.MTH.EQ.MTTOT) GO TO 100
      IF(IZA.EQ.IZARAC.AND.MTH.EQ.MTRACT) GO TO 110
C-----SKIP SECTION AND READ HEAD LINE OF NEXT SECTION OR FEND LINE.
      CALL SKIPS
   90 CALL CONTI
C-----CHECK FOR END OF FILE
      IF(MTH.gt.0) go to 80
      IF(MFH.le.0) go to 170
      go to 90
c-----------------------------------------------------------------------
C
C     READ SECTION.
C
c-----------------------------------------------------------------------
C-----SET INDEX FOR TOTAL OR REACTION AND DEFINE CONVERSION FACTOR
C-----FROM MICROSCOPIC (BARNS) TO MACROSCOPIC (1/CM) CROSS SECTIONS
C-----(NOTE - THESE FACTORS DO NOT INCLUDE DENSITY - SINCE THE SAME
C-----DATA MAY BE USED IN MORE THEN ONE CASE AND EACH CASE MAY HAVE
C-----A DIFFERENT DENSITY, CROSS SECTIONS WILL BE LEFT IN MICROSCOPIC
C-----FORM AND CONVERTED TO MACROSCOPIC FORM AS THEY ARE USED).
  100 INDEX=1
      AWR=1.008665d0*AWRIN
      FACTM=0.6022d0/AWR
      GO TO 120
  110 INDEX=2
      AWR=1.008665d0*AWRIN
      FACTM=0.6022d0/AWR
  120 CALL CARDI(C1,C2,L1,L2,N1,N2)
      CALL TERPI(NBT(1),INT(1),N1)
c-----2019/1/3 - Additional Interpolation Law Tests
      CALL TERPTEST(NBT(1),INT(1),N1,N2,3)  ! INT MUST = 2
C-----READ DATA AND CONVERT FROM MICROSCOPIC (BARNS) TO MACROSCOPIC
C-----(1/CM/GRAM) FORM (AFTER BEING READ DATA MAY BE USED BY MORE THAN
C-----ONE CASE - THEREFORE DATA IS NOT MULTIPLIED BY DENSITY AT THIS
C-----POINT - IT WILL BE MULTIPLIED BY DENSITY DURING THE ACTUAL
C-----TRANSMISSION CALCULATION).
      NPTAB(INDEX)=N2
      CALL PAGIN3(ITAPE,INDEX,FACTM)
c-----Save MAT/MT/MT
      CALL MAXIE1(MATH,MFH,MTH)
c-----Save Maximum Energy - assume positive
      CALL MAXIE2(EMAX(INDEX),1.0d0)
C-----IDENTIFY READ DATA.
      CALL OUT9(EMIN(INDEX),FIELDX(1,1))
      CALL OUT9(EMAX(INDEX),FIELDX(1,2))
      IF(INDEX.EQ.1) WRITE(OUTP,220) N2,((FIELDX(M,K),M=1,11),K=1,2)
      IF(INDEX.EQ.2) WRITE(OUTP,240) N2,((FIELDX(M,K),M=1,11),K=1,2)
      IF(INDEX.EQ.1) WRITE(*   ,220) N2,((FIELDX(M,K),M=1,11),K=1,2)
      IF(INDEX.EQ.2) WRITE(*   ,240) N2,((FIELDX(M,K),M=1,11),K=1,2)
C-----CONTINUE SEARCH IF TOTAL IS NOT DEFINED.
      IF(NPTAB(1).LE.0) GO TO 30
C-----CHECK FOR BOTH REACTIONS NOW DEFINED.
      IF(NPTAB(2).GT.0) GO TO 150
C-----CHECK FOR TOTAL DEFINED AND NO REACTION REQUESTED.
      IF(MTRACT.LE.0) GO TO 140
C-----CHECK FOR TOTAL DEFINED AND REACTION THE SAME.
      IF(IZATOT.EQ.IZARAC.AND.MTTOT.EQ.MTRACT) GO TO 130
C-----STILL NEED ONE REACTION.
      GO TO 30
c-----------------------------------------------------------------------
C
C     ALL DATA LOADED.
C
c-----------------------------------------------------------------------
C-----REACTION IS THE SAME AS TOTAL.
  130 NPTAB(2)=NPTAB(1)
      EMIN(2)=EMIN(1)
      EMAX(2)=EMAX(1)
      CALL OUT9(EMIN(2),FIELDX(1,1))
      CALL OUT9(EMAX(2),FIELDX(1,2))
      WRITE(OUTP,240) NPTAB(2),((FIELDX(M,K),M=1,11),K=1,2)
      WRITE(*   ,240) NPTAB(2),((FIELDX(M,K),M=1,11),K=1,2)
      GO TO 150
C-----NO REACTION REQUESTED.
  140 WRITE(OUTP,230)
      WRITE(*   ,230)
  150 RETURN
c-----------------------------------------------------------------------
C
C     ERROR MESSAGE SECTION.
C
c-----------------------------------------------------------------------
C-----CANNOT LOCATE EVALUATION.
  160 WRITE(OUTP,190) IZATOT
      WRITE(*   ,190) IZATOT
      CALL ENDERROR
C-----CANNOT LOCATE FILE 3.
  170 WRITE(OUTP,200) IZATOT
      WRITE(*   ,200) IZATOT
      CALL ENDERROR
C-----CANNOT LOCATE TOTAL DATA.
      WRITE(OUTP,210) IZATOT,MTTOT
      WRITE(*   ,210) IZATOT,MTTOT
  180 CALL ENDERROR
C-----CANNOT LOCATE REACTION DATA.
      WRITE(OUTP,210) IZARAC,MTRACT
      WRITE(*   ,210) IZARAC,MTRACT
      GO TO 180
  190 FORMAT(' CANNOT LOCATE ZA=',I6)
  200 FORMAT(' CANNOT LOCATE CROSS SECTIONS OF ZA=',I6)
  210 FORMAT(' CANNOT LOCATE ZA/MT=',I6,'/',I4)
  220 FORMAT(' TOTAL-------------------',I10,
     1 11A1,' TO ',11A1,' eV')
  230 FORMAT(1X,72('-'))
  240 FORMAT(' REACTION----------------',I10,
     1 11A1,' TO ',11A1,' eV'/1X,72('-'))
      END
      SUBROUTINE MYDENS
C=======================================================================
C
C     DEFINE SPATIALLY DEPENDENT WEIGHTS BASED ON COMPOSITION.
C
C     TERMS ARE,
C     WTTP  = CONTRIBUTION OF TOTAL TO TOTAL CROSS SECTION AT POINT
C     WTTI  = INTEGRAL OF TOTAL FROM 0.0 TO POINT
C     WTRP  = CONTRIBUTION OF TOTAL TO REACTIONS AT POINT
C     WRTP  = CONTRIBUTION OF REACTION TO TOTAL CROSS SECTION AT POINT
C     WRTI  = INTEGRAL OF REACTION FROM 0.0 TO POINT
C     WRRP  = CONTRIBUTION OF REACTION TO REACTIONS AT POINT
C     DENTAB= DENSITY GRAMS/CC
C
C=======================================================================
      INCLUDE 'implicit.h'
      COMMON/ENDFB/IZATOT,MTTOT,DENSET,IZARAC,MTRACT,DENSER
      COMMON/TALLY/THICKL,NTHICK
      COMMON/NORMS/YNORM(3),FLUXNR,SPNORM,IMFLAT
      INCLUDE 'virgin.h'
c-----------------------------------------------------------------------
C
C     SELECT TYPE OF DENSITY PROFILE.
C
c-----------------------------------------------------------------------
      MYWAY=IABS(IMFLAT)+1
      GO TO (10,30,50,80,110,140,170,200),MYWAY
C-----UNIFORM LAYER. TOTAL CONTRIBUTES TO TOTAL CROSS SECTIONS AND
C-----REACTION CONTRIBUTES TO REACTIONS UNIFORMLY IN LAYER.
   10 DO 20 I=1,NTHICK
      X=THICKI(I)
      WTTP(I)=DENSET
      WTTI(I)=X*DENSET
      WTRP(I)=0.0d0
      WRTP(I)=0.0d0
      WRTI(I)=0.0d0
      WRRP(I)=DENSER
      DENTAB(I)=DENSET
   20 CONTINUE
      RETURN
C-----UNIFORM LAYER. TOTAL AND REACTION BOTH UNIFORMLY CONTRIBUTE.
   30 DO 40 I=1,NTHICK
      X=THICKI(I)
      WTTP(I)=DENSET
      WTTI(I)=X*DENSET
      WRTP(I)=DENSER
      WRTI(I)=X*DENSER
   40 CONTINUE
      GO TO 230
C-----TOTAL + LINEAR REACTION. TOTAL CONTIBUTES TO TOTAL CROSS SECTION
C-----AND REACTIONS UNIFORMLY IN LAYER. CONTRIBUTION OF REACTION VARIES
C-----FROM ZERO AT ZERO THICKNESS IN A LINEAR FASHION TO MAXIMUM AT
C-----MAXIMUM THICKNESS.
   50 DO 70 I=1,NTHICK
      X=THICKI(I)
      XP=X/THICKI(NTHICK)
      WTTP(I)=DENSET
      WTTI(I)=X*DENSET
      IF(IMFLAT.LT.0) GO TO 60
C-----0 TO MAXIMUM
      WRTP(I)=2.0d0*XP*DENSER
      WRTI(I)=XP*X*DENSER
      GO TO 70
C-----MAXIMUM TO 0
   60 WRTP(I)=(2.0d0-2.0d0*XP)*DENSER
      WRTI(I)=(2.0d0-XP)*X*DENSER
   70 CONTINUE
      GO TO 230
C-----LINEAR TOTAL AND REACTION. TOTAL CONTRIBUTION TO TOTAL CROSS
C-----SECTION AND REACTIONS VARIES FROM MAXIMUM AT ZERO THICKNESS IN
C-----A LINEAR FASHION TO ZERO AT THE MAXIMUM THICKNESS. REACTION
C-----CONTRIBUTION VARIES FROM ZERO AT ZERO THICKNESS TO MAXIMUM AT
C-----MAXIMUM THICKNESS.
   80 DO 100 I=1,NTHICK
      X=THICKI(I)
      XP=X/THICKI(NTHICK)
      IF(IMFLAT.LT.0) GO TO 90
C-----0 TO MAXIMUM
      WTTP(I)=(2.0d0-2.0d0*XP)*DENSET
      WTTI(I)=(2.0d0-XP)*X*DENSET
      WRTP(I)=2.0d0*XP*DENSER
      WRTI(I)=XP*X*DENSER
      GO TO 100
C-----MAXIMUM TO 0
   90 WRTP(I)=(2.0d0-2.0d0*XP)*DENSER
      WRTI(I)=(2.0d0-XP)*X*DENSER
      WTTP(I)=2.0d0*XP*DENSET
      WTTI(I)=XP*X*DENSET
  100 CONTINUE
      GO TO 230
C-----TOTAL + SQUARE REACTION. TOTAL CONTIBUTES TO TOTAL CROSS SECTION
C-----AND REACTIONS UNIFORMLY IN LAYER. CONTRIBUTION OF REACTION VARIES
C-----FROM ZERO AT ZERO THICKNESS IN A SQUARE FASHION TO MAXIMUM AT
C-----MAXIMUM THICKNESS.
  110 DO 130 I=1,NTHICK
      X=THICKI(I)
      XP=X/THICKI(NTHICK)
      XP2=XP*XP
      WTTP(I)=DENSET
      WTTI(I)=X*DENSET
      IF(IMFLAT.LT.0) GO TO 120
C-----0 TO MAXIMUM
      WRTP(I)=3.0d0*XP2*DENSER
      WRTI(I)=XP2*X*DENSER
      GO TO 130
C-----MAXIMUM TO 0
  120 WRTP(I)=(3.0d0-3.0d0*XP2)*DENSER/2.0d0
      WRTI(I)=(3.0d0-XP2)*X*DENSER/2.0d0
  130 CONTINUE
      GO TO 230
C-----SQUARE TOTAL AND REACTION. TOTAL CONTRIBUTION TO TOTAL CROSS
C-----SECTION AND REACTIONS VARIES FROM MAXIMUM AT ZERO THICKNESS IN
C-----A SQUARE FASHION TO ZERO AT THE MAXIMUM THICKNESS. REACTION
C-----CONTRIBUTION VARIES FROM ZERO AT ZERO THICKNESS TO MAXIMUM AT
C-----MAXIMUM THICKNESS.
  140 DO 160 I=1,NTHICK
      X=THICKI(I)
      XP=X/THICKI(NTHICK)
      XP2=XP*XP
      IF(IMFLAT.LT.0) GO TO 150
C-----0 TO MAXIMUM
      WTTP(I)=(3.0d0-3.0d0*XP2)*DENSET/2.0d0
      WTTI(I)=(3.0d0-XP2)*X*DENSET/2.0d0
      WRTP(I)=3.0d0*XP2*DENSER
      WRTI(I)=XP2*X*DENSER
      GO TO 160
C-----MAXIMUM TO 0
  150 WRTP(I)=(3.0d0-3.0d0*XP2)*DENSER/2.0d0
      WRTI(I)=(3.0d0-XP2)*X*DENSER/2.0d0
      WTTP(I)=3.0d0*XP2*DENSET
      WTTI(I)=XP2*X*DENSET
  160 CONTINUE
      GO TO 230
C-----TOTAL + CUBIC REACTION. TOTAL CONTIBUTES TO TOTAL CROSS SECTION
C-----AND REACTIONS UNIFORMLY IN LAYER. CONTRIBUTION OF REACTION VARIES
C-----FROM ZERO AT ZERO THICKNESS IN A SQUARE FASHION TO MAXIMUM AT
C-----MAXIMUM THICKNESS.
  170 DO 190 I=1,NTHICK
      X=THICKI(I)
      XP=X/THICKI(NTHICK)
      XP3=XP*XP*XP
      WTTP(I)=DENSET
      WTTI(I)=X*DENSET
      IF(IMFLAT.LT.0) GO TO 180
C-----0 TO MAXIMUM
      WRTP(I)=4.0d0*XP3*DENSER
      WRTI(I)=XP3*X*DENSER
      GO TO 190
C-----MAXIMUM TO 0
  180 WRTP(I)=(4.0d0-4.0d0*XP3)*DENSER/3.0d0
      WRTI(I)=(4.0d0-XP3)*X*DENSER/3.0d0
  190 CONTINUE
      GO TO 230
C-----CUBIC TOTAL AND REACTION. TOTAL CONTRIBUTION TO TOTAL CROSS
C-----SECTION AND REACTIONS VARIES FROM MAXIMUM AT ZERO THICKNESS IN
C-----A CUBIC FASHION TO ZERO AT THE MAXIMUM THICKNESS. REACTION
C-----CONTRIBUTION VARIES FROM ZERO AT ZERO THICKNESS TO MAXIMUM AT
C-----MAXIMUM THICKNESS.
  200 DO 220 I=1,NTHICK
      X=THICKI(I)
      XP=X/THICKI(NTHICK)
      XP3=XP*XP*XP
      IF(IMFLAT.LT.0) GO TO 210
C-----0 TO MAXIMUM
      WTTP(I)=(4.0d0-4.0d0*XP3)*DENSET/3.0d0
      WTTI(I)=(4.0d0-XP3)*X*DENSET/3.0d0
      WRTP(I)=4.0d0*XP3*DENSER
      WRTI(I)=XP3*X*DENSER
      GO TO 220
C-----MAXIMUM TO 0
  210 WRTP(I)=(4.0d0-4.0d0*XP3)*DENSER/3.0d0
      WRTI(I)=(4.0d0-XP3)*X*DENSER/3.0d0
      WTTP(I)=4.0d0*XP3*DENSET
      WTTI(I)=XP3*X*DENSET
  220 CONTINUE
c-----------------------------------------------------------------------
C
C     ACTUAL DENSITIES ARE ALWAYS BASED ON CONTRIBUTION OF TOTAL AND
C     REACTION TO ATTENUATION.
C
c-----------------------------------------------------------------------
  230 DO 240 I=1,NTHICK
      WTRP(I)=WTTP(I)
      WRRP(I)=WRTP(I)
      DENTAB(I)=WTTP(I)+WRTP(I)
  240 CONTINUE
      RETURN
      END
      SUBROUTINE NOHITS
C=======================================================================
C
C     UNCOLLIDED TRANSMISSION CALCULATION.
C
C=======================================================================
      INCLUDE 'implicit.h'
      CHARACTER*1 FIELDX
      CHARACTER*4 TITLE
      COMMON/UNITS/IPLOT,ISCR(5)
      COMMON/ENDFB/IZATOT,MTTOT,DENSET,IZARAC,MTRACT,DENSER
      COMMON/SPACE/XLAST,XNOW,YLAST(3),YNOW(3)
      COMMON/TALLY/THICKL,NTHICK
      COMMON/GPPAGE/NGROUP,NGPP1,NGRLOW,NGRHI
      COMMON/GROUPY/EGLOW,EGHIGH,EGP2
      COMMON/LIMITS/EMIN(3),EMAX(3),SPLOW
      COMMON/SIZES/NPAGE,NPAGEM
      COMMON/CONJOB/CTAB(5,3)
      COMMON/TITLES/TITLE(36)
      COMMON/OUTIT/IMOUT(4),IMOPEN
      COMMON/NORMS/YNORM(3),FLUXNR,SPNORM,IMFLAT
      COMMON/TRANST/ESPMAX,NTRAN
      COMMON/FIELDC/FIELDX(11,12)
      INCLUDE 'virgin.h'
      EQUIVALENCE (E1,XLAST),(E2,XNOW),(XCT1,YLAST(1)),
     2 (XCR1,YLAST(2)),(S1,YLAST(3)),(XCT2,YNOW(1)),(XCR2,YNOW(2)),
     3 (S2,YNOW(3))
      DATA ZERO /0.0d0/
      DATA ONE  /1.0d0/
      DATA TWO  /2.0d0/
      DATA TENTH/1.0d-01/
      DATA FIFTY/5.0d+01/
c-----------------------------------------------------------------------
C
C     DEFINE SPATIALLY DEPENDENT WEIGHTS BASED ON COMPOSITION.
C
c-----------------------------------------------------------------------
      CALL MYDENS
C-----INITIALIZE COUNT OF TRANSMITTED SPECTRUM POINTS. VARIABLES ARE,
C-----NTRAN  = TOTAL NUMBER OF ENERGY POINTS
C-----KTRAN  = NUMBER OF POINTS IN CORE
C-----LTRAN  = INDEX TO HIGHEST ENERGY POINT OF INTEREST (SPECTRUM
C-----         IS NOT LESS THEN THE MINIMUM OF INTEREST)
C-----ESPMAX = ENERGY OF HIGHEST ENERGY POINT OF INTEREST
      NTRAN=0
      KTRAN=0
      LTRAN=0
      ESPMAX=0.0d0
C-----DEFINE TYPE OF ENERGY DEPENDOUT OUTPUT.
      KMOUT=IMOUT(4)
      IF(KMOUT.GT.0) WRITE(IPLOT,310) (TITLE(KK),KK=1,18)
C-----INITIALIZE SPECTRUM INTEGRALS.
      DO 10 ITHICK=1,NTHICK
      FLUXINT(ITHICK)=ZERO
      REACTINT(ITHICK)=ZERO
   10 CONTINUE
C-----DEFINE VALUES AT LOWER LIMIT OF FIRST TALLY GROUP.
      CALL POINT1
C-----INITIALIZE OUTPUT POINT COUNT FOR ENERGY DEPENDENT OUTPUT.
      IPOINT=0
c-----------------------------------------------------------------------
C
C     LOOP OVER TALLY GROUPS.
C
c-----------------------------------------------------------------------
      DO 230 IGROUP=NGRLOW,NGRHI
C-----DEFINE TALLY GROUP ENERGY LIMITS.
      EGP2=EGROUP(IGROUP+1)
      IF(EGP2.GT.EGHIGH) EGP2=EGHIGH
C-----INITIALIZE TALLIES.
      DO 20 ITHICK=1,NTHICK
      FLUX(ITHICK)=ZERO
      REACT(ITHICK)=ZERO
   20 CONTINUE
C-----SELECT NEXT INTERVAL AND DEFINE VALUES AT ENDS.
   30 CALL POINTN
c-----------------------------------------------------------------------
C
C     SAVE TRANSMITTED SPECTRUM - IN CASE NEXT CASE WILL USE IT.
C
c-----------------------------------------------------------------------
      IF(LTRAN.GT.0) GO TO 40
C-----FIRST POINT.
      ARG1=XCT1*WTTI(NTHICK)+XCR1*WRTI(NTHICK)
      ZEXP1=DEXP(-ARG1)
      SOUT1=S1*ZEXP1
      ETRAN(1)=E1
      STRAN(1)=SOUT1
C-----IGNORE LEADING POINTS LESS THEN MINIMUM OF INTEREST.
      IF(SOUT1.LT.SPLOW) GO TO 40
C-----KEEP TRACK OF HIGHEST ENERGY WHERE SPECTRUM IS NOT LESS THEN
C-----MINIMUM OF INTEREST.
      KTRAN=1
      LTRAN=1
      ESPMAX=E1
C-----AFTER FIRST POINT.
   40 KTRAN=KTRAN+1
      ARG2=XCT2*WTTI(NTHICK)+XCR2*WRTI(NTHICK)
      ZEXP2=DEXP(-ARG2)
      SOUT2=S2*ZEXP2
      ETRAN(KTRAN)=E2
      STRAN(KTRAN)=SOUT2
C-----IGNORE LEADING POINTS LESS THEN MINIMUM OF INTEREST.
      IF(LTRAN.GT.0) GO TO 60
      IF(SOUT2.LT.SPLOW) GO TO 50
      KTRAN=1
      LTRAN=1
      ESPMAX=E2
      GO TO 70
   50 KTRAN=0
      GO TO 70
C-----KEEP TRACK OF HIGHEST ENERGY WHERE SPECTRUM IS NOT LESS THEN
C-----MINIMUM OF INTEREST.
   60 IF(SOUT2.LT.SPLOW) GO TO 70
      LTRAN=NTRAN+KTRAN
      ESPMAX=E2
c-----------------------------------------------------------------------
C
C     SAVE TRANSMITTED SPECTRUM ON SCRATCH IF CORE IS FULL.
C
c-----------------------------------------------------------------------
   70 IF(KTRAN.LT.NPAGE) GO TO 80
      ISCR4=ISCR(4)
      IF(NTRAN.LE.0) REWIND ISCR4
      WRITE(ISCR4) ETRAN,STRAN
      NTRAN=NTRAN+NPAGE
      KTRAN=0
c-----------------------------------------------------------------------
C
C     ENERGY DEPENDENT OUTPUT.
C
c-----------------------------------------------------------------------
   80 IF(KMOUT.LE.0) GO TO 170
      GO TO (90,100,110,120,130,140),KMOUT
C-----SPECTRUM AT 0.0
   90 SOUT1=SPNORM*S1
      SOUT2=SPNORM*S2
      GO TO 150
C-----SPECTRUM AT THICK (EVERYTHING IS ALREADY DEFINED ABOVE).
  100 SOUT1=SPNORM*SOUT1
      SOUT2=SPNORM*SOUT2
      GO TO 150
C-----REACTIONS TO 0.0
  110 ROUT=XCT1*WTRP(1)+XCR1*WRRP(1)
      SOUT1=SPNORM*S1*ROUT/DENTAB(1)
      ROUT=XCT2*WTRP(1)+XCR2*WRRP(1)
      SOUT2=SPNORM*S2*ROUT/DENTAB(1)
      GO TO 150
C-----REACTIONS AT THICK (ZEXP1 AND ZEXP2 DEFINED ABOVE).
  120 ROUT=XCT1*WTRP(NTHICK)+XCR1*WRRP(NTHICK)
      SOUT1=SPNORM*S1*ROUT*ZEXP1/DENTAB(NTHICK)
      ROUT=XCT2*WTRP(NTHICK)+XCR2*WRRP(NTHICK)
      SOUT2=SPNORM*S2*ROUT*ZEXP2/DENTAB(NTHICK)
      GO TO 150
C-----TOTAL CROSS SECTIONS (CM*CM/GRAM)
  130 SOUT1=XCT1
      SOUT2=XCT2
      GO TO 150
C-----REACTION CROSS SECTIONS (CM*CM/GRAM)
  140 SOUT1=XCR1
      SOUT2=XCR2
C-----ENERGY DEPENDENT OUTPUT.
  150 IF(IPOINT.GT.0) GO TO 160
      IF(SOUT1.LE.0.0d0) GO TO 160
      CALL OUT9(E1   ,FIELDX(1,1))
c-----2019/4/22 - Truncate Minimum
      if(SOUT1.lt.1.0d-10) SOUT1 = 0.0d0
      CALL OUT9(SOUT1,FIELDX(1,2))
      WRITE(IPLOT,290) ((FIELDX(M,K3),M=1,11),K3=1,2)
  160 IF(SOUT2.LE.0.0d0) GO TO 170
      CALL OUT9(E2   ,FIELDX(1,1))
c-----2019/4/22 - Truncate Minimum
      if(SOUT2.lt.1.0d10) SOUT2 = 0.0d0
      CALL OUT9(SOUT2,FIELDX(1,2))
      WRITE(IPLOT,290) ((FIELDX(M,K3),M=1,11),K3=1,2)
c-----------------------------------------------------------------------
C
C     ADD CONTRIBUTION OF INTERVAL TO INTEGRALS.
C
c-----------------------------------------------------------------------
  170 IPOINT=1
C-----DEFINE LENGTH OF ENERGY INTERVAL AND SKIP ZERO LENGTH
C-----INTERVALS.
      DE=E2-E1
      IF(DE.le.0.0d0) go to 210
C-----DEFINE THE AVERAGE TOTAL, REACTION AND SOURCE.
      AVXCT=(XCT2+XCT1)/TWO
      AVXCR=(XCR2+XCR1)/TWO
      AVS=(S2+S1)/TWO
C-----DEFINE CHANGE IN TOTAL, REACTION AND SOURCE.
      DXCT=(XCT2-XCT1)/TWO
      DXCR=(XCR2-XCR1)/TWO
      DS=(S2-S1)/TWO
c-----------------------------------------------------------------------
C
C     SET UP LOOP OVER THICKNESSES.
C
c-----------------------------------------------------------------------
      DO 200 ITHICK=1,NTHICK
C-----DEFINE OPTICAL THICKNESS (INTEGRAL OF CONTRIBUTING FACTORS).
      XAVXCT=AVXCT*WTTI(ITHICK)+AVXCR*WRTI(ITHICK)
C-----IF ANY ENERGY INTERVAL HAS AN AVERAGE OPTICAL THICKNESS OF OVER
C-----50 MEAN FREE PATHS CONSIDER IT TO BE INFINITELY THICK.
      IF(XAVXCT.GT.FIFTY) GO TO 200
C-----DEFINE CONTRIBUTION OF AVERAGE TOTAL TO INTEGRAL.
      FRONT=DE*DEXP(-XAVXCT)/TWO
C-----DEFINE REACTION CROSS SECTION AT POINT.
      AVXCRP=AVXCT*WTRP(ITHICK)+AVXCR*WRRP(ITHICK)
      DXCRP=DXCT*WTRP(ITHICK)+DXCR*WRRP(ITHICK)
C-----DEFINE THREE CONTRIBUTING TERMS TO INTEGRAL.
      P1=AVXCRP*AVS
      P2=AVXCRP*DS+AVS*DXCRP
      P3=DXCRP*DS
C-----DEFINE CHANGE IN OPTICAL THICKNESS ACROSS ENERGY INTERVAL.
      A=DXCT*WTTI(ITHICK)+DXCR*WRTI(ITHICK)
      AA=A*A
C-----SPECIAL HANDLING FOR SMALL CHANGE IN OPTICAL THICKNESS ACROSS
C-----THE ENERGY INTERVAL (DUE EITHER TO SMALL MATERIAL THICKNESS OR
C-----SMALL CHANGE IN TOTAL CROSS SECTION).
      IF(DABS(A).LT.TENTH) GO TO 180
C-----USE NORMAL ANALYTICAL EVALUATION OF INTEGRALS.
      AAA=AA*A
      BACK1=DEXP(A)
      BACK2=ONE/BACK1
      F1=(BACK1-BACK2)/A
      F2=((ONE-A)*BACK1-(ONE+A)*BACK2)/AA
      F3=((TWO-TWO*A+AA)*BACK1-(TWO+TWO*A+AA)*BACK2)/AAA
      GO TO 190
C-----FOR SMALL OPTICAL THICKNESS USE EXPANSIONS WHICH ARE TRUNCATED
C-----AT ORDER A**10, WHICH FOR A LESS THAN 0.1 WILL BE ACCURATE TO AT
C-----LEAST 10 DIGITS.
  180 F1=(((AA*CTAB(5,1)+CTAB(4,1))*AA+CTAB(3,1))*AA+CTAB(2,1))*AA+
     1 CTAB(1,1)
      F2=-A*((((AA*CTAB(5,2)+CTAB(4,2))*AA+CTAB(3,2))*AA+CTAB(2,2))*AA+
     1 CTAB(1,2))
      F3=(((AA*CTAB(5,3)+CTAB(4,3))*AA+CTAB(3,3))*AA+CTAB(2,3))*AA+
     1 CTAB(1,3)
C-----ADD CONTRIBUTION TO FLUX.
  190 FLUX(ITHICK)=FLUX(ITHICK)+FRONT*(AVS*F1+DS*F2)
C-----ADD CONTRIBUTION TO REACTIONS.
      REACT(ITHICK)=REACT(ITHICK)+FRONT*(P1*F1+P2*F2+P3*F3)
  200 CONTINUE
C-----TEST FOR END OF TALLY GROUP.
  210 IF(E2.LT.EGP2) GO TO 30
C-----END OF TALLY GROUP. ADD CONTRIBUTIONS TO SPECTRUM INTEGRALS.
C-----DEFINE AVERAGE CROSS SECTIONS (IF ANY).
      DO 220 ITHICK=1,NTHICK
      FLUXINT(ITHICK)=FLUXINT(ITHICK)+FLUX(ITHICK)
      REACTINT(ITHICK)=REACTINT(ITHICK)+REACT(ITHICK)
      IF(FLUX(ITHICK).LE.ZERO) GO TO 220
      IF(MTRACT.LE.0) GO TO 220
  220 CONTINUE
c-----------------------------------------------------------------------
C
C     END OF GROUP LOOP
C
c-----------------------------------------------------------------------
  230 CONTINUE
C-----IF ANY ENERGY DEPENDENT OUTPUT END PLOTTAB TABLE.
      IF(KMOUT.NE.0) WRITE(IPLOT,300)
C
C     END OF CALCULATION.
C
C-----INITIALIZE TO ONLY OUTPUT FLUX.
      LOOP=1
      IF(MTRACT.LE.0) GO TO 250
C-----RESET TO OUTPUT FLUX, REACTIONS AND AVERAGE CROSS SECTION.
      LOOP=3
C-----DEFINE AVERAGE CROSS SECTION.
      DO 240 I=1,NTHICK
      AVXCINT(ITHICK)=ZERO
      IF(FLUXINT(I).GT.0.0d0) AVXCINT(I)=REACTINT(I)/FLUXINT(I)
  240 CONTINUE
c-----------------------------------------------------------------------
C
C     PLOTTAB OUTPUT OF FLUX, REACTIONS AND CROSS SECTION
C
c-----------------------------------------------------------------------
  250 DO 280 L=1,LOOP
      IF(IMOUT(L).LE.0) GO TO 280
C-----CONTINUE PLOTTAB CURVE OR WRITE TITLE FOR NEW CURVE.
      IF(IMOPEN.NE.0) GO TO 260
      IMOPEN=1
  260 IF(L.EQ.1) WRITE(IPLOT,320) (TITLE(KK),KK=1,18)
      IF(L.EQ.2) WRITE(IPLOT,330) (TITLE(KK),KK=1,18)
      IF(L.EQ.3) WRITE(IPLOT,340) (TITLE(KK),KK=1,18)
      DO 270 KK=1,NTHICK
      THICKO=THICKI(KK)+THICKL
      IF(L.EQ.1) THREEO = FLUXINT(KK) *FLUXNR  ! normalized spectrum
      IF(L.EQ.2) THREEO = REACTINT(KK)*SPNORM  ! normalize reactions
      IF(L.EQ.3) THREEO = AVXCINT(KK)          ! average cross section
      CALL OUT9(THICKO,FIELDX(1,1))
      CALL OUT9(THREEO,FIELDX(1,2))
      WRITE(IPLOT,290) ((FIELDX(M,K3),M=1,11),K3=1,2)
  270 CONTINUE
C-----END OLF PLOTTAB CURVE.
      WRITE(IPLOT,300)
  280 CONTINUE
c-----------------------------------------------------------------------
C
C     ADD CURRENT THICKNESS IN CASE NEXT CASE USES TRANSMITTED
C     SPECTRUM.
C
c-----------------------------------------------------------------------
      THICKL=THICKL+THICKI(NTHICK)
c-----------------------------------------------------------------------
C
C     DEFINE NUMBER OF POINTS IN TRANSMITTED SPECTRUM AND IF SCRATCH
C     HAS BEEN USED, END IT.
C
c-----------------------------------------------------------------------
      IF(NTRAN.GT.0) ENDFILE ISCR4
      NTRAN=LTRAN
      RETURN
  290 FORMAT(22A1)
  300 FORMAT(30X,'(BLANK LINE)')
  310 FORMAT('Transmission: ',18A4)
  320 FORMAT('Flux: ',18A4)
  330 FORMAT('Reactions: ',18A4)
  340 FORMAT('Cross Section: ',18A4)
      END
      SUBROUTINE POINT1
C=======================================================================
C
C     DEFINE FIRST INTERVAL FOR TOTAL, REACTION AND SOURCE.
C     IF ANY ARE NOT DEFINED DOWN TO THE START OF THE FIRST
C     TALLY GROUP EXTEND DOWNWARD AS ZERO.
C
C=======================================================================
      INCLUDE 'implicit.h'
      INTEGER*4 OUTP,OTAPE
      COMMON/ENDFIO/INP,OUTP,ITAPE,OTAPE
      COMMON/REALLY/XSTART(3),XFIN(3),YSTART(3),YFIN(3),IPTAB(3),
     1 NPTAB(3)
      COMMON/SPACE/XLAST,XNOW,YLAST(3),YNOW(3)
      COMMON/GPPAGE/NGROUP,NGPP1,NGRLOW,NGRHI
      COMMON/GROUPY/EGLOW,EGHIGH,EGP2
      COMMON/ENDFB/IZATOT,MTTOT,DENSET,IZARAC,MTRACT,DENSER
      COMMON/LIMITS/EMIN(3),EMAX(3),SPLOW
      INCLUDE 'virgin.h'
c-----------------------------------------------------------------------
C
C     DEFINE OVERLAPPING ENERGY RANGE OF TALLY GROUPS AND NON-ZERO
C     SPECTRUM.
C
c-----------------------------------------------------------------------
      DO 10 NGRLOW=2,NGPP1
      IF(EGROUP(NGRLOW).eq.EMIN(3)) go to 30
      IF(EGROUP(NGRLOW).gt.EMIN(3)) go to 20
   10 CONTINUE
C-----SOURCE AND TALLY GROUPS DO NOT OVERLAP.
      WRITE(OUTP,150)
      WRITE(*   ,150)
      CALL ENDERROR
   20 NGRLOW=NGRLOW-1
   30 EGLOW=EMIN(3)
      IF(EGLOW.LT.EGROUP(1)) EGLOW=EGROUP(1)
      NGRHI=NGROUP
      DO 40 I=1,NGROUP
      IF(EGROUP(NGRHI).lt.EMAX(3)) go to 60
      IF(EGROUP(NGRHI).eq.EMAX(3)) go to 50
      NGRHI=NGRHI-1
   40 CONTINUE
C-----SOURCE AND TALLY GROUPS DO NOT OVERLAP.
      WRITE(OUTP,150)
      WRITE(*   ,150)
      CALL ENDERROR
   50 IF(NGRHI.LT.NGROUP) NGRHI=NGRHI+1
   60 EGHIGH=EMAX(3)
      IF(EGHIGH.GT.EGROUP(NGPP1)) EGHIGH=EGROUP(NGPP1)
C-----DEFINE LOWER LIMIT OF FIRST ACTIVE TALLY GROUP.
      XNOW=EGLOW
c-----------------------------------------------------------------------
C
C     DEFINE STARTING TOTAL, REACTION AND SOURCE.
C
c-----------------------------------------------------------------------
C-----SET UP LOOP OVER TOTAL, REACTION AND SOURCE.
      DO 140 ITYPE=1,3
      IF(NPTAB(ITYPE).LE.0) GO TO 70
      IF(ITYPE.NE.2) GO TO 80
      IF(IZATOT.NE.IZARAC.OR.MTTOT.NE.MTRACT) GO TO 80
C-----REACTION=TOTAL OR NO REACTION. USE TOTAL DATA.
   70 XSTART(2)=XSTART(1)
      YSTART(2)=YSTART(1)
      XFIN(2)=XFIN(1)
      YFIN(2)=YFIN(1)
      YNOW(2)=YNOW(1)
      IPTAB(2)=IPTAB(1)
      GO TO 140
C-----FIND FIRST INTERVAL THAT STRADDLES LOWER ENERGY LIMIT OF
C-----FIRST TALLY GROUP.
   80 NPT=NPTAB(ITYPE)
      DO 90 IPT=1,NPT
      CALL PAGOUT(IPT,ITYPE,E2B,XC2)
      IF(E2B.gt.XNOW) go to 100
      E1B=E2B
      XC1=XC2
   90 CONTINUE
C-----ALL DATA POINTS BELOW FIRST TALLY GROUP. EXTEND AS ZERO.
      XSTART(ITYPE)=XNOW
      YSTART(ITYPE)=0.0d0
      XFIN(ITYPE)=XNOW
      YFIN(ITYPE)=0.0d0
      YNOW(ITYPE)=0.0d0
      IPTAB(ITYPE)=NPT
      GO TO 140
C-----DOES INTERVAL STRADDLE LOWER ENERGY LIMIT....
  100 IF(IPT.GT.1) GO TO 110
C-----NO, IT IS ABOVE IT. EXTEND DOWN TO LOWER LIMIT AS ZERO.
      XSTART(ITYPE)=XNOW
      YSTART(ITYPE)=0.0d0
      XFIN(ITYPE)=E2B
      YFIN(ITYPE)=0.0d0
      YNOW(ITYPE)=0.0d0
      IPTAB(ITYPE)=0
      GO TO 140
C-----YES. INTERPOLATE TO DEFINE VALUE AT BOUNDARY.
  110 XSTART(ITYPE)=XNOW
C-----AT DISCONTINUITY USE SECOND (FINAL) CROSS SECTION
      DE21=E2B-E1B
      IF(DE21.gt.0.0d0) go to 120
      YSTART(ITYPE)=XC2
      GO TO 130
  120 YSTART(ITYPE)=((XNOW-E1B)*XC2+(E2B-XNOW)*XC1)/DE21
  130 XFIN(ITYPE)=E2B
      YFIN(ITYPE)=XC2
      YNOW(ITYPE)=YSTART(ITYPE)
      IPTAB(ITYPE)=IPT
  140 CONTINUE
      RETURN
  150 FORMAT(' SOURCE AND TALLY GROUPS DO NOT OVERLAP'/
     1 ' EXECUTION TERMINATED.')
      END
      SUBROUTINE POINTN
C=======================================================================
C
C     DEFINE NEXT INTERVAL FOR TOTAL, REACTION AND SOURCE.
C     IF ANY ARE NOT DEFINED UP TO END OF LAST TALLY GROUP EXTEND
C     UPWARD AS ZERO.
C
C=======================================================================
      INCLUDE 'implicit.h'
      COMMON/REALLY/XSTART(3),XFIN(3),YSTART(3),YFIN(3),IPTAB(3),
     1 NPTAB(3)
      COMMON/SPACE/XLAST,XNOW,YLAST(3),YNOW(3)
      COMMON/GROUPY/EGLOW,EGHIGH,EGP2
      COMMON/ENDFB/IZATOT,MTTOT,DENSET,IZARAC,MTRACT,DENSER
C-----INITIALIZE MAXIMUM NEXT INTERVAL.
      XLAST=XNOW
      XNOW=EGP2
C-----POSITION TOTAL, REACTION AND SOURCE TO NEXT NON-NULL
C-----INTERVAL.
      DO 50 ITYPE=1,3
      IF(NPTAB(ITYPE).LE.0) GO TO 10
C-----SAVE VALUE AT BEGINNING OF NEXT INTEGRATION INTERVAL.
      YLAST(ITYPE)=YNOW(ITYPE)
      IF(ITYPE.NE.2) GO TO 20
      IF(IZATOT.NE.IZARAC.OR.MTRACT.NE.MTTOT) GO TO 20
C-----REACTION=TOTAL OR NO REACTION. USE TOTAL VALUES.
   10 YLAST(2)=YLAST(1)
      YNOW(2)=YNOW(1)
      XSTART(2)=XSTART(1)
      YSTART(2)=YSTART(1)
      XFIN(2)=XFIN(1)
      YFIN(2)=YFIN(1)
      GO TO 50
C-----END OF INTERVAL REACHED YET.....
   20 IF(XFIN(ITYPE).GT.XLAST) GO TO 40
C-----YES. MOVE TO NEXT INTERVAL.
      XSTART(ITYPE)=XFIN(ITYPE)
C-----ANY MORE DATA LEFT....
      IF(IPTAB(ITYPE).LT.NPTAB(ITYPE)) GO TO 30
C-----NO. EXTEND DATA AS ZERO
      YSTART(ITYPE)=0.0d0
      XFIN(ITYPE)=EGHIGH
      YFIN(ITYPE)=0.0d0
      GO TO 40
C-----YES. DEFINE NEXT INTERVAL.
   30 IPT=IPTAB(ITYPE)+1
      IPTAB(ITYPE)=IPT
      YSTART(ITYPE)=YFIN(ITYPE)
      CALL PAGOUT(IPT,ITYPE,XFIN(ITYPE),YFIN(ITYPE))
C-----FIND MINIMUM NEXT INTERVAL.
   40 IF(XFIN(ITYPE).LT.XNOW) XNOW=XFIN(ITYPE)
   50 CONTINUE
C-----INTERPOLATE TO DEFINE VALUES AT END OF INTEGRATION INTERVAL.
      DO 70 ITYPE=1,3
      DX=XFIN(ITYPE)-XSTART(ITYPE)
C-----AT DISCONTINUITY USE SECOND (FINAL) CROSS SECTION.
      IF(DX.gt.0.0d0) go to 60
      YNOW(ITYPE)=YFIN(ITYPE)
      GO TO 70
   60 YNOW(ITYPE)=((XNOW-XSTART(ITYPE))*YFIN(ITYPE)+(XFIN(ITYPE)-XNOW)*
     1 YSTART(ITYPE))/DX
   70 CONTINUE
      RETURN
      END
      SUBROUTINE TRANSI
C=======================================================================
C
C     DEFINE TRANSMITTED SPECTRUM FROM LAST CASE TO BE INCIDENT SPECTRUM
C     FOR CURRENT CASE.
C
C=======================================================================
      INCLUDE 'implicit.h'
      COMMON/UNITS/IPLOT,ISCR(5)
      COMMON/SIZES/NPAGE,NPAGEM
      COMMON/LIMITS/EMIN(3),EMAX(3),SPLOW
      COMMON/PAGER/IXYLOW(3),IXYHI(3)
      COMMON/REALLY/XSTART(3),XFIN(3),YSTART(3),YFIN(3),IPTAB(3),
     1 NPTAB(3)
      COMMON/TRANST/ESPMAX,NTRAN
      INCLUDE 'virgin.h'
c-----------------------------------------------------------------------
C
C     IS DATA IN CORE OR ON SCRATCH.
C
c-----------------------------------------------------------------------
      IF(NTRAN.GT.NPAGE) GO TO 20
C-----IN CORE. COPY TRANSMITTED SPECTRUM TO INCIDENT SPECTRUM.
      DO 10 I=1,NTRAN
      XTAB(I,3)=ETRAN(I)
      YTAB(I,3)=STRAN(I)
   10 CONTINUE
C-----DEFINE ALL SPECTRUM PARAMETERS.
      NPTAB(3)=NTRAN
      IXYLOW(3)=0
      IXYHI(3)=NTRAN
      EMIN(3)=ETRAN(1)
      EMAX(3)=ESPMAX
      RETURN
C-----NO SCRATCH. SWITCH SCRATCH UNITS AND LOAD FIRST PAGE.
   20 ISCR3=ISCR(4)
      ISCR(4)=ISCR(3)
      ISCR(3)=ISCR3
      REWIND ISCR3
      READ(ISCR3) XTAB3,YTAB3
C-----DEFINE ALL SPECTRUM PARAMETERS.
      NPTAB(3)=NTRAN
      IXYLOW(3)=0
      IXYHI(3)=NPAGE
      EMIN(3)=XTAB3(1)
      EMAX(3)=ESPMAX
      RETURN
      END
      SUBROUTINE GROPIN
C=======================================================================
C
C     READ TALLY GROUP ENERGY BOUNDARIES. LIST AND CHECK ASCENDING
C     ENERGY ORDER. TERMINATE IF NOT IN ASCENDING ENERGY ORDER.
C
C=======================================================================
      INCLUDE 'implicit.h'
      CHARACTER*1 FIELDX
      INTEGER*4 OUTP,OTAPE
      COMMON/ENDFIO/INP,OUTP,ITAPE,OTAPE
      COMMON/GPPAGE/NGROUP,NGPP1,NGRLOW,NGRHI
      COMMON/FIELDC/FIELDX(11,12)
      INCLUDE 'virgin.h'
C-----PRINT HEADING FOR OUTPUT REPORT.
      WRITE(OUTP,50)
      WRITE(*   ,50)
      NGPP1=NGROUP+1
C----- 2017/5/6 - Changed all floating point to character
      CALL LISTIV(INP,EGROUP,NGPP1)
C----- 2017/5/6 - Changed all floating point to character
C-----LIST ENERGY BOUNDARIES.
      NGPP1=NGROUP+1
      DO 20 I=1,NGPP1,6
      II=I+5
      IF(II.GT.NGPP1) II=NGPP1
      J=0
      DO 10 III=I,II
      J=J+1
      CALL OUT9(EGROUP(III),FIELDX(1,J))
   10 CONTINUE
      WRITE(OUTP,60) ((FIELDX(M,JJ),M=1,11),JJ=1,J)
      WRITE(*   ,60) ((FIELDX(M,JJ),M=1,11),JJ=1,J)
   20 CONTINUE
C-----CHECK ENERGY GROUP ORDER.
      IERR=0
      DO 30 I=2,NGPP1
      IM1=I-1
      IF(EGROUP(I).GT.EGROUP(IM1)) GO TO 30
      CALL OUT9(EGROUP(IM1),FIELDX(1,1))
      CALL OUT9(EGROUP(I  ),FIELDX(1,2))
      IF(IERR.EQ.0) WRITE(OUTP,70)
      WRITE(OUTP,80) I,((FIELDX(M,K),M=1,11),K=1,2)
      IF(IERR.EQ.0) WRITE(*   ,70)
      WRITE(*   ,80) I,((FIELDX(M,K),M=1,11),K=1,2)
      IERR=1
   30 CONTINUE
C-----TERMINATE IF GROUPS NOT IN ASCENDING ENERGY ORDER.
      IF(IERR.LE.0) GO TO 40
      WRITE(OUTP,90)
      WRITE(*   ,90)
      CALL ENDERROR
   40 RETURN
   50 FORMAT(1X,72('-')/' GROUP ENERGY BOUNDARIES'/1X,72('-')/
     1 6(3X,'ENERGY-eV')/1X,72('-'))
   60 FORMAT(6(1X,11A1))
   70 FORMAT(1X,72('-')/' GROUP BOUNDARIES ARE NOT IN ASCENDING ENERGY',
     1 ' ORDER')
   80 FORMAT(' GROUP',I5,1X,11A1,' TO ',11A1,' eV')
   90 FORMAT(' EXECUTION TERMINATED'/1X,72('-'))
      END
      SUBROUTINE PAGIN3(NTAPE,ITYPE,FACTOR)
C=======================================================================
C
C     LOAD TOTAL, REACTION OR SPECTRUM DATA INTO PAGING SYSTEM.
C
C=======================================================================
      INCLUDE 'implicit.h'
      CHARACTER*1 FIELDX
      INTEGER*4 OUTP,OTAPE
      COMMON/ENDFIO/INP,OUTP,ITAPE,OTAPE
      COMMON/UNITS/IPLOT,ISCR(5)
      COMMON/PAGER/IXYLOW(3),IXYHI(3)
      COMMON/NORMS/YNORM(3),FLUXNR,SPNORM,IMFLAT
      COMMON/REALLY/XSTART(3),XFIN(3),YSTART(3),YFIN(3),IPTAB(3),
     1 NPTAB(3)
      COMMON/LIMITS/EMIN(3),EMAX(3),SPLOW
      COMMON/SIZES/NPAGE,NPAGEM
      COMMON/LASTE/ELAST
      COMMON/FIELDC/FIELDX(11,12)
      INCLUDE 'virgin.h'
      DATA ZERO  /0.0d0/
      DATA XNOWS /0.0d0/
      DATA XLASTS/0.0d0/
C-----PRINT TITLE FOR SPECTRUM OUTPUT LISTING.
      IF(ITYPE.EQ.3) WRITE(OUTP,150)
      IF(ITYPE.EQ.3) WRITE(*   ,150)
C-----SAVE ITAPE AND DEFINE INPUT UNIT AS NTAPE.
      ISAVE=ITAPE
      ITAPE=NTAPE
C-----DEFINE SCRATCH UNIT NUMBER.
      NSCR=ISCR(ITYPE)
C-----INITIALIZE LAST ENERGY FOR ENERGY ORDER CHECK.
      ELAST=ZERO
C-----INITIALIZE SPECTRUM NORMALIZATION FACTOR.
      SUM=ZERO
C-----SET UP LOOP OVER PAGES.
      N2NOW=NPTAB(ITYPE)
      DO 90 NPT=1,N2NOW,NPAGE
C-----READ NEXT PAGE.
      NNPT=NPT+NPAGEM
      IF(NNPT.GT.N2NOW) NNPT=N2NOW
      IHIGH=NNPT-NPT+1
      CALL POINTI(XTAB(1,ITYPE),YTAB(1,ITYPE),IHIGH)
C-----NORMALIZE.
      DO 10 I=1,IHIGH
      YTAB(I,ITYPE)=FACTOR*YTAB(I,ITYPE)
   10 CONTINUE
C-----LIST SPECTRUM.
      IF(ITYPE.NE.3) GO TO 60
      DO 30 I=1,IHIGH,3
      II=I+5
      IF(II.GT.IHIGH) II=IHIGH
      J=0
      DO 20 III=I,II
      J=J+1
      CALL OUT9(XTAB(III,3),FIELDX(1,J))
      J=J+1
      CALL OUT9(YTAB(III,3),FIELDX(1,J))
   20 CONTINUE
      WRITE(OUTP,160) ((FIELDX(M,JJ),M=1,11),JJ=1,J)
      WRITE(*   ,160) ((FIELDX(M,JJ),M=1,11),JJ=1,J)
   30 CONTINUE
C-----CALCULATE NORMALIZATION FACTOR.
      DO 50 I=1,IHIGH
      XNOWS=XTAB(I,3)
      YNOWS=YTAB(I,3)
      IF(NPT.EQ.1.AND.I.EQ.1) GO TO 40
      SUM=SUM+(XNOWS-XLASTS)*(YNOWS+YLASTS)
   40 XLASTS=XNOWS
      YLASTS=YNOWS
   50 CONTINUE
C-----SAVE ENERGY OF FIRST POINT.
   60 IF(NPT.EQ.1) EMIN(ITYPE)=XTAB(1,ITYPE)
C-----IF OVER ONE PAGE OF DATA MOVE DATA TO SCRATCH FILE.
      IF(N2NOW.LE.NPAGE) GO TO 90
      IF(NPT.EQ.1) REWIND NSCR
      IF(ITYPE.eq.2) go to 70
      IF(ITYPE.gt.2) go to 80
      WRITE(NSCR) XTAB1,YTAB1
      GO TO 90
   70 WRITE(NSCR) XTAB2,YTAB2
      GO TO 90
   80 WRITE(NSCR) XTAB3,YTAB3
   90 CONTINUE
C-----SAVE ENERGY OF LAST POINT.
      EMAX(ITYPE)=XTAB(IHIGH,ITYPE)
C-----IS CROSS SECTION IN CORE OR ON SCRATCH.
      IF(N2NOW.GT.NPAGE) GO TO 100
C-----IN CORE.
      IXYLOW(ITYPE)=0
      IXYHI(ITYPE)=N2NOW
      GO TO 140
C-----ON SCRATCH. POSITION SCRATCH AND LOAD FIRST PAGE.
  100 END FILE NSCR
      REWIND NSCR
      IF(ITYPE.eq.2) go to 110
      IF(ITYPE.gt.2) go to 120
      READ(NSCR) XTAB1,YTAB1
      GO TO 130
  110 READ(NSCR) XTAB2,YTAB2
      GO TO 130
  120 READ(NSCR) XTAB3,YTAB3
  130 IXYLOW(ITYPE)=0
      IXYHI(ITYPE)=NPAGE
C-----RE-DEFINE ITAPE TO ENDF/B FORMATTED FILE.
  140 ITAPE=ISAVE
C-----DEFINE SPECTRUM NORMALIZATION FACTOR.
      IF(ITYPE.EQ.3) YNORM(3)=2.0d0/SUM
      RETURN
  150 FORMAT(1X,72('-')/' WEIGHTING SPECTRUM (LINEARLY INTERPOLABLE)'/
     1 1X,72('-')/'   ENERGY-eV   SPECTRUM',2X,
     2 '  ENERGY-eV   SPECTRUM',2X,'  ENERGY-eV   SPECTRUM'/
     3 1X,72('-'))
  160 FORMAT((1X,3(22A1,2X)))
      END
      SUBROUTINE PAGOUT(I,ITYPE,X,Y)
C=======================================================================
C
C     RETRIEVE TOTAL, REACTION OR SPECTRUM X (ENERGY) AND Y (CROSS
C     SECTION OR SPECTRUM) FROM PAGING SYSTEM.
C
C=======================================================================
      INCLUDE 'implicit.h'
      INTEGER*4 OUTP,OTAPE
      COMMON/ENDFIO/INP,OUTP,ITAPE,OTAPE
      COMMON/UNITS/IPLOT,ISCR(5)
      COMMON/PAGER/IXYLOW(3),IXYHI(3)
      COMMON/NORMS/YNORM(3),FLUXNR,SPNORM,IMFLAT
      COMMON/REALLY/XSTART(3),XFIN(3),YSTART(3),YFIN(3),IPTAB(3),
     1 NPTAB(3)
      COMMON/SIZES/NPAGE,NPAGEM
      INCLUDE 'virgin.h'
C-----INSURE POINT INDEX IS IN LEGAL RANGE.
      IF(I.GT.0.AND.I.LE.NPTAB(ITYPE)) GO TO 10
C-----ILLEGAL POINT INDEX.
      WRITE(OUTP,70) I,NPTAB(ITYPE)
      WRITE(*   ,70) I,NPTAB(ITYPE)
      X=0.0d0
      Y=0.0d0
      RETURN
C-----IF DATA IS NOT IN CORE LOAD CORRECT PAGE.
   10 IF(I.GT.IXYLOW(ITYPE)) GO TO 20
      IXYLOW(ITYPE)=0
      IXYHI(ITYPE)=NPAGE
      NSCR=ISCR(ITYPE)
      REWIND NSCR
      GO TO 30
   20 IF(I.LE.IXYHI(ITYPE)) GO TO 60
      IXYLOW(ITYPE)=IXYHI(ITYPE)
      IXYHI(ITYPE)=IXYHI(ITYPE)+NPAGE
      NSCR=ISCR(ITYPE)
   30 IF(ITYPE.eq.2) go to 40
      IF(ITYPE.gt.2) go to 50
      READ(NSCR) XTAB1,YTAB1
      GO TO 20
   40 READ(NSCR) XTAB2,YTAB2
      GO TO 20
   50 READ(NSCR) XTAB3,YTAB3
      GO TO 20
C-----DEFINE REQUIRED POINT.
   60 INCORE=I-IXYLOW(ITYPE)
      X=XTAB(INCORE,ITYPE)
      Y=YNORM(ITYPE)*YTAB(INCORE,ITYPE)
      RETURN
   70 FORMAT(' PAGOUT..INDEX=',I6,' (MUST BE 1 TO',I6,')')
      END
      SUBROUTINE OVERE(E,S,N,ELOW,EHIGH)
C=======================================================================
C
C     CONSTRUCT TABLE OF 1/E AS DEFINED BY A TABLE OF N POINTS
C     LOGARITHMICALLY SPACED BETWEEN THE ENERGIES ELOW AND EHIGH.
C     VALUES ARE RETURNED IN ASCENDING ENERGY ORDER.
C
C     THE MAXIMUM PER-CENT DIFFERENCE BETWEEN THE EXACT 1/E SHAPE
C     (MAGNITUDE DOES NOT MATTER) AND THE TABULATED APPROXIMATION
C     (ASSUMING LINEAR VARIATION BETWEEN TABULATED POINTS) DEPENDS
C     ONLY ON THE NUMBER OF POINTS PER ENERGY DECADE. THE MAXIMUM
C     ERROR VERSUS POINTS PER DECADE WILL BE...
C
C     POINTS PER DECADE    MAXIMUM PER-CENT ERROR
C     -----------------    ----------------------
C                 10           0.67
C                 20           0.17
C                 30           0.074
C                 40           0.042
C                 50           0.027
C                 60           0.019
C                 70           0.014
C                 80           0.011
C                 90           0.009
C                100           0.007
C
C     FOR EXAMPLE IN ORDER TO CONSTRUCT A TABULATED LINEARLY
C     INTERPOLABLE APPROXIMATION TO 1/E FROM 1.0D-5 eV UP TO 10 MEV
C     (12 DECADES OF ENERGY) TO WITHIN AN ACCURACY OF 0.1 PER-CENT
C     CAN BE ACCOMPLISHED BY USING 30 POINTS PER DECADE, OR A TOTAL
C     OF 361 POINTS (12 X 30 + 1 AT END OF ENERGY INTERVAL). THIS
C     WOULD YIELD A MAXIMUM ERROR OF 0.074 PER-CENT.
C
C=======================================================================
      INCLUDE 'implicit.h'
      DIMENSION E(*),S(*)
      DATA ZERO/0.0d0/
      DATA ONE /1.0d0/
      DATA TWO /2.0d0/
C-----DEFINE MULTIPLIER TO SPACE N POINTS BETWEEN ELOW AND EHIGH.
      FN=N-1
      DE=DEXP(DLOG(EHIGH/ELOW)/FN)
C-----DEFINE FIRST POINT AT LOWER ENERGY LIMIT.
      E(1)=ELOW
      S(1)=ONE/ELOW
C-----DEFINE REMAINING POINTS AS LOGARITHMICALLY SPACED, I.E. EACH
C-----ENERGY POINT IS A MULTILPE OF THE PRECEEDING ENERGY POINT.
      DO 10 J=2,N
      E(J)=DE*E(J-1)
      S(J)=ONE/E(J)
   10 CONTINUE
C-----ELIMINATE ROUNDOFF PROBLEMS BY DEFINING LAST POINT AS EXACTLY
C-----AT UPPER ENERGY LIMIT.
      E(N)=EHIGH
      S(N)=ONE/EHIGH
C-----NORMALIZE SPECTRUM
      SUM=ZERO
      DO 20 I=2,N
      SUM=SUM+(E(I)-E(I-1))*(S(I)+S(I-1))
   20 CONTINUE
      SUM=SUM/TWO
      DO 30 I=1,N
      S(I)=S(I)/SUM
   30 CONTINUE
      RETURN
      END
      SUBROUTINE BBODY(TEMPK,XTAB,YTAB,IPT,XLOW,XHIGH,ITYPE)
C=======================================================================
C
C
C     DEFINE BLACKBODY SPECTRUM
C     =========================
C     TEMPK  = BLACKBODY TEMPERATURE (eV)
C     XTAB   = TABULATED ENERGIES (eV)
C     YTAB   = TABULATED VALUES
C     IPT    = NUMBER OF TABULATED POINTS
C     XLOW   = LOWER ENERGY LIMIT (eV)
C     XHIGH  = HIGHER ENERGY LIMIT (eV)
C     ITYPE  = 1 = PHOTON SPECTRUM
C            = 2 = ENERGY SPECTRUM (ENERGY*PHOTON SPECTRUM)
C
C     METHOD
C     ======
C     THE BLACKBODY SPECTRUM IS DEFINED BY,
C
C     S(E) = A*((E/T)**K)/(EXP(E/T) - 1)
C
C     WHERE,
C     E    = ENERGY
C     T    = TEMPERATURE (SAME UNITS AS ENERGY)
C     K    = 2 - PHOTON SPECTRUM
C          = 3 - ENERGY SPECTRUM
C     A    = NORMALIZING CONSTANT
C
C     THE SPECTRUM WILL BE NORMALIZED TO UNITY WHEN INTEGRATED
C     FROM XLOW TO XHIGH
C
C=======================================================================
      INCLUDE 'implicit.h'
      DIMENSION XTAB(*),YTAB(*)
      DATA ZERO/0.0d0/
      DATA ONE /1.0d0/
      DATA TWO /2.0d0/
      DATA YLOW/1.0d-25/
      DATA BNORM/6.4940d0/
      DATA XPEAK/2.822d0/
C-----DEFINE MULTIPLIER TO SPACE IPT POINTS BETWEEN XLOW AND XHIGH.
      FN=IPT-1
      DX=DEXP(DLOG(XHIGH/XLOW)/FN)
C-----DEFINE POWER FOR PHOTON OR ENERGY SPECTRUM.
      KPOWER=1+ITYPE
c-----------------------------------------------------------------------
C
C     DEFINE APPROXIMATION NORMALIZATION FOR ENERGY SPECTRUM.
C
c-----------------------------------------------------------------------
      TEMPN=ONE/(BNORM*TEMPK)
c-----------------------------------------------------------------------
C
C     CALCULATE TABULATED SPECTRUM FROM XLOW TO XHIGH
C
c-----------------------------------------------------------------------
      X=XLOW
      DO 10 KPT=1,IPT
      XK=X/TEMPK
      Y=TEMPN*(XK**KPOWER)/(DEXP(XK)-ONE)
      IF(XK.GT.XPEAK.AND.Y.LT.YLOW) GO TO 20
      XTAB(KPT)=X
      YTAB(KPT)=Y
      X=DX*X
   10 CONTINUE
      XTAB(IPT)=XHIGH
      GO TO 30
C-----HIGH ENERGY CUTOFF WHEN SPECTRUM IS VERY SMALL
   20 XTAB(KPT)=X
      YTAB(KPT)=ZERO
      IPT=KPT
c-----------------------------------------------------------------------
C
C     NORMALIZE SPECTRUM
C
c-----------------------------------------------------------------------
   30 SUM=ZERO
      DO 40 I=2,IPT
      SUM=SUM+(XTAB(I)-XTAB(I-1))*(YTAB(I)+YTAB(I-1))
   40 CONTINUE
      SUM=SUM/TWO
      DO 50 I=1,IPT
      YTAB(I)=YTAB(I)/SUM
   50 CONTINUE
      RETURN
      END
      SUBROUTINE GROPE(IWANT,EGROUP,NGROUP)
C=======================================================================
C
C     THIS ROUTINE IS DESIGNED TO DEFINE ONE OF THE BUILT IN GROUP
C     STRUCTURES.
C
C     ENERGIES ARE RETURNED IN ASCENDING ORDER IN EV.
C
C     ARGUMENTS
C     ---------
C     IWANT   = ENERGY GROUP STRUCTURE SELECTOR.
C             = 0  175 GROUPS (TART)
C             = 1   50 GROUPS (ORNL)
C             = 2  126 GROUPS (ORNL)
C             = 3  171 GROUPS (ORNL)
C             = 4  620 GROUPS (SAND-II, 1.0D-4, UP TO 18 MEV)
C             = 5  640 GROUPS (SAND-II, 1.0D-4, UP TO 20 MEV)
C             = 6   69 GROUPS (WIMS)
C             = 7   68 GROUPS (GAM-I)
C             = 8   99 GROUPS (GAM-II)
C             = 9   54 GROUPS (MUFT)
C             =10   28 GROUPS (ABBN)
C             =11  616 GROUPS (TART TO 20 MEV)
C             =12  700 GROUPS (TART TO 1 GEV)
C             =13  665 GROUPS (SAND-II, 1.0D-5 eV, UP TO 18 MEV)
C             =14  685 GROUPS (SAND-II, 1.0D-5 eV, UP TO 20 MEV)
C             =15  666 GROUPS (TART TO 200 MEV)
C             =16  725 GROUPS (SAND-II, 1.0D-5 eV, UP TO  60 MEV)
C             =17  755 GROUPS (SAND-II, 1.0D-5 eV, UP TO 150 MEV)
C             =18  765 GROUPS (SAND-II, 1.0D-5 eV, UP TO 200 MEV)
C             =19 1102 GROUPS (UKAEA  , 1.0D-5 eV, UP TO   1 GeV)
C             = OTHERWISE ZERO GROUP BOUNDARIES ARE RETURNED
C
C=======================================================================
      INCLUDE 'implicit.h'
      DIMENSION EGROUP(*),
     1 TART(176),ORNLA(51),ORNLB(127),ORNLC(172),
     1 WIMS(70),GAMI(69),GAMII(100),XMUFT(55),ABBN(29),
     2 TART1(40),TART2(40),TART3(40),
     3 TART4(40),TART5(16),GR50A(45),GR50B(6),GR126A(45),GR126B(45),
     4 GR126C(37),GR171A(45),GR171B(45),GR171C(45),GR171D(37),
     7 WIMSA(45),WIMSB(25),
     8 GAMIA(45),GAMIB(24),GAMIIA(45),GAMIIB(45),GAMIIC(10)
      EQUIVALENCE (TART(1),TART1(1)),(TART(41),TART2(1)),
     1 (TART(81),TART3(1)),(TART(121),TART4(1)),(TART(161),TART5(1)),
     2 (ORNLA(1),GR50A(1)),(ORNLA(46),GR50B(1)),(ORNLB(1),GR126A(1)),
     3 (ORNLB(46),GR126B(1)),(ORNLB(91),GR126C(1)),(ORNLC(1),GR171A(1)),
     4 (ORNLC(46),GR171B(1)),(ORNLC(91),GR171C(1)),
     5 (ORNLC(136),GR171D(1))
      EQUIVALENCE (WIMS(1),WIMSA(1)),
     1 (WIMS(46),WIMSB(1)),(GAMI(1),GAMIA(1)),(GAMI(46),GAMIB(1)),
     2 (GAMII(1),GAMIIA(1)),(GAMII(46),GAMIIB(1)),(GAMII(91),GAMIIC(1))
c-----------------------------------------------------------------------
C
C     DEFINE TART 175 GROUP STRUCTURE
C
c-----------------------------------------------------------------------
      DATA TART1/ 1.3068D-03, 5.2271D-03, 2.0908D-02, 3.2669D-02,
     1 4.7044D-02, 8.3215D-02, 1.3068D-01, 1.8817D-01,
     2 2.5613D-01, 3.3453D-01, 4.2339D-01, 5.1230D-01,
     3 7.5270D-01, 1.1761D+00, 1.5106D+00, 2.0908D+00,
     4 2.7411D+00, 3.5335D+00, 4.7044D+00, 5.6578D+00,
     5 6.7367D+00, 8.3215D+00, 9.6199D+00, 1.1012D+01,
     6 1.3068D+01, 1.4683D+01, 1.5812D+01, 1.7584D+01,
     7 1.8817D+01, 2.0746D+01, 2.2769D+01, 2.4170D+01,
     8 2.5613D+01, 2.7097D+01, 2.8623D+01, 2.9402D+01,
     9 3.0991D+01, 3.3453D+01, 3.6009D+01, 3.8659D+01/
      DATA TART2/ 4.0478D+01, 4.2339D+01, 4.3285D+01, 4.6186D+01,
     1 4.7174D+01, 4.9181D+01, 5.1230D+01, 5.3321D+01,
     2 5.6536D+01, 5.7628D+01, 6.0968D+01, 6.3247D+01,
     3 6.5568D+01, 6.6744D+01, 7.0335D+01, 7.1553D+01,
     4 7.5270D+01, 7.7800D+01, 7.9080D+01, 8.1673D+01,
     5 8.4307D+01, 8.8337D+01, 9.1076D+01, 9.3857D+01,
     6 9.6680D+01, 9.8107D+01, 1.0245D+02, 1.0990D+02,
     7 1.1761D+02, 1.2558D+02, 1.3381D+02, 1.4059D+02,
     8 1.5106D+02, 1.6008D+02, 1.6936D+02, 1.7890D+02,
     9 1.8870D+02, 1.9876D+02, 2.0908D+02, 2.7411D+02/
      DATA TART3/ 3.2669D+02, 3.8105D+02, 4.7044D+02, 4.9908D+02,
     1 5.6578D+02, 6.0425D+02, 6.3666D+02, 7.1558D+02,
     2 8.3215D+02, 9.1767D+02, 1.0585D+03, 1.3068D+03,
     3 1.5812D+03, 1.8817D+03, 2.2084D+03, 2.5613D+03,
     4 2.9402D+03, 3.3453D+03, 3.7765D+03, 4.2339D+03,
     5 5.7628D+03, 7.5270D+03, 1.0245D+04, 1.5106D+04,
     6 2.0908D+04, 2.6462D+04, 3.2669D+04, 3.9530D+04,
     7 4.7044D+04, 5.7615D+04, 7.0020D+04, 8.3215D+04,
     8 9.8909D+04, 1.3068D+05, 1.8195D+05, 2.0746D+05,
     9 2.4170D+05, 2.7097D+05, 2.9402D+05, 3.3453D+05/
      DATA TART4/ 3.7765D+05, 4.2339D+05, 5.1230D+05, 6.3247D+05,
     1 7.5270D+05, 8.8337D+05, 1.0245D+06, 1.1761D+06,
     2 1.3381D+06, 1.5106D+06, 1.6936D+06, 1.8870D+06,
     3 2.0908D+06, 2.3051D+06, 2.5299D+06, 2.7411D+06,
     4 3.0108D+06, 3.2669D+06, 3.5335D+06, 3.8105D+06,
     5 4.0688D+06, 4.3960D+06, 4.7044D+06, 4.9908D+06,
     6 5.3525D+06, 5.6578D+06, 6.0425D+06, 6.3666D+06,
     7 6.7367D+06, 7.1558D+06, 7.5479D+06, 7.9096D+06,
     8 8.3215D+06, 8.7867D+06, 9.1767D+06, 9.6648D+06,
     9 1.0120D+07, 1.0585D+07, 1.1012D+07, 1.1547D+07/
      DATA TART5/ 1.1993D+07, 1.2499D+07, 1.3068D+07, 1.3542D+07,
     1 1.3863D+07, 1.4134D+07, 1.4407D+07, 1.4683D+07,
     2 1.5186D+07, 1.5754D+07, 1.6334D+07, 1.6923D+07,
     3 1.7523D+07, 1.8134D+07, 1.8755D+07, 2.0000D+07/
c-----------------------------------------------------------------------
C
C     DEFINE ORNL 50, 126 AND 171 GROUP STRUCTURES.
C
c-----------------------------------------------------------------------
C-----DEFINE 50 GROUP ENERGY BOUNDARIES.
      DATA GR50A/
     1 1.0000D-05, 6.8256D-01, 1.1250D+00, 1.8550D+00, 3.0590D+00,
     2 5.0430D+00, 8.3150D+00, 1.3710D+01, 2.2600D+01, 3.7270D+01,
     3 6.1440D+01, 1.0130D+02, 1.6700D+02, 2.7540D+02, 3.5360D+02,
     4 4.5400D+02, 5.8290D+02, 7.4850D+02, 9.6110D+02, 1.2340D+03,
     5 1.5850D+03, 2.0350D+03, 2.7470D+03, 3.3550D+03, 4.3070D+03,
     6 5.5310D+03, 7.1020D+03, 9.1190D+03, 1.1710D+04, 1.5030D+04,
     7 1.9300D+04, 2.4790D+04, 3.1830D+04, 4.0870D+04, 5.2480D+04,
     8 6.7380D+04, 8.6520D+04, 1.1110D+05, 1.4260D+05, 1.8320D+05,
     9 2.3520D+05, 3.0200D+05, 3.8770D+05, 4.9790D+05, 8.2080D+05/
      DATA GR50B/
     1 1.3530D+06, 2.2310D+06, 3.6790D+06, 6.0650D+06, 1.0000D+07,
     2 1.9970D+07/
C-----DEFINE 126 GROUP ENERGY BOUNDARIES.
      DATA GR126A/
     1 1.0000D-05, 1.0000D-01, 4.1399D-01, 1.1254D+00, 2.3724D+00,
     2 5.0435D+00, 1.0677D+01, 2.2603D+01, 3.7267D+01, 4.7851D+01,
     3 6.1442D+01, 1.0130D+02, 1.6702D+02, 2.1445D+02, 2.7536D+02,
     4 4.5400D+02, 7.4852D+02, 9.6112D+02, 1.2341D+03, 1.5846D+03,
     5 2.0347D+03, 2.2487D+03, 2.4852D+03, 2.6126D+03, 2.7465D+03,
     6 3.0354D+03, 3.3546D+03, 3.7074D+03, 4.3074D+03, 5.5308D+03,
     7 7.1017D+03, 9.1188D+03, 1.1709D+04, 1.5034D+04, 1.9305D+04,
     8 2.1875D+04, 2.3579D+04, 2.4788D+04, 2.6058D+04, 2.7000D+04,
     9 2.8500D+04, 3.1828D+04, 3.4307D+04, 4.0868D+04, 4.6309D+04/
      DATA GR126B/
     1 5.2475D+04, 5.6562D+04, 6.7379D+04, 7.2000D+04, 7.9500D+04,
     2 8.2500D+04, 8.6517D+04, 9.8037D+04, 1.1109D+05, 1.1679D+05,
     3 1.2277D+05, 1.2907D+05, 1.3569D+05, 1.4264D+05, 1.4996D+05,
     4 1.5764D+05, 1.6573D+05, 1.7422D+05, 1.8316D+05, 1.9255D+05,
     5 2.0242D+05, 2.1280D+05, 2.2371D+05, 2.4724D+05, 2.7324D+05,
     6 2.8725D+05, 2.9452D+05, 2.9720D+05, 2.9850D+05, 3.0197D+05,
     7 3.3373D+05, 3.6883D+05, 4.0762D+05, 4.5049D+05, 4.9787D+05,
     8 5.2340D+05, 5.5023D+05, 5.7844D+05, 6.0810D+05, 6.3928D+05,
     9 6.7206D+05, 7.0651D+05, 7.4274D+05, 7.8082D+05, 8.2085D+05/
      DATA GR126C/
     1 8.6294D+05, 9.0718D+05, 9.6164D+05, 1.0026D+06, 1.1080D+06,
     2 1.1648D+06, 1.2246D+06, 1.2873D+06, 1.3534D+06, 1.4227D+06,
     3 1.4957D+06, 1.5724D+06, 1.6530D+06, 1.7377D+06, 1.8268D+06,
     4 1.9205D+06, 2.0190D+06, 2.1225D+06, 2.2313D+06, 2.3069D+06,
     5 2.3653D+06, 2.3852D+06, 2.4660D+06, 2.5924D+06, 2.7253D+06,
     6 2.8650D+06, 3.0119D+06, 3.1664D+06, 3.6788D+06, 4.4933D+06,
     7 5.4881D+06, 6.0653D+06, 6.7032D+06, 8.1873D+06, 1.0000D+07,
     8 1.2214D+07, 1.7333D+07/
C-----DEFINE 171 GROUP ENERGY BOUNDARIES.
      DATA GR171A/
     1 1.0000D-05, 1.0000D-01, 4.1399D-01, 5.3158D-01, 6.8256D-01,
     2 8.7642D-01, 1.1254D+00, 1.4450D+00, 1.8554D+00, 2.3724D+00,
     3 3.0590D+00, 3.9279D+00, 5.0435D+00, 6.4760D+00, 8.3153D+00,
     4 1.0677D+01, 1.3710D+01, 1.7603D+01, 2.2603D+01, 2.9203D+01,
     5 3.7267D+01, 4.7851D+01, 6.1442D+01, 7.8893D+01, 1.0130D+02,
     6 1.3007D+02, 1.6702D+02, 2.1445D+02, 2.7536D+02, 3.5358D+02,
     7 4.5400D+02, 5.8295D+02, 7.4852D+02, 9.6112D+02, 1.2341D+03,
     8 1.5846D+03, 2.0347D+03, 2.2487D+03, 2.4852D+03, 2.6126D+03,
     9 2.7465D+03, 3.0354D+03, 3.3546D+03, 3.7074D+03, 4.3074D+03/
      DATA GR171B/
     1 5.5308D+03, 7.1017D+03, 9.1188D+03, 1.1709D+04, 1.5034D+04,
     2 1.9305D+04, 2.1875D+04, 2.3579D+04, 2.4176D+04, 2.4788D+04,
     3 2.6058D+04, 2.7000D+04, 2.8500D+04, 3.1828D+04, 3.4307D+04,
     4 4.0868D+04, 4.6309D+04, 5.2475D+04, 5.6562D+04, 6.7379D+04,
     5 7.2000D+04, 7.9500D+04, 8.2500D+04, 8.6517D+04, 9.8037D+04,
     6 1.1109D+05, 1.1679D+05, 1.2277D+05, 1.2907D+05, 1.3569D+05,
     7 1.4264D+05, 1.4996D+05, 1.5764D+05, 1.6573D+05, 1.7422D+05,
     8 1.8316D+05, 1.9255D+05, 2.0242D+05, 2.1280D+05, 2.2371D+05,
     9 2.3518D+05, 2.4724D+05, 2.7324D+05, 2.8725D+05, 2.9452D+05/
      DATA GR171C/
     1 2.9720D+05, 2.9850D+05, 3.0197D+05, 3.3373D+05, 3.6883D+05,
     2 3.8774D+05, 4.0762D+05, 4.5049D+05, 4.9787D+05, 5.2340D+05,
     3 5.5023D+05, 5.7844D+05, 6.0810D+05, 6.3928D+05, 6.7206D+05,
     4 7.0651D+05, 7.4274D+05, 7.8082D+05, 8.2085D+05, 8.6294D+05,
     5 9.0718D+05, 9.6164D+05, 1.0026D+06, 1.1080D+06, 1.1648D+06,
     6 1.2246D+06, 1.2873D+06, 1.3534D+06, 1.4227D+06, 1.4957D+06,
     7 1.5724D+06, 1.6530D+06, 1.7377D+06, 1.8268D+06, 1.9205D+06,
     8 2.0190D+06, 2.1225D+06, 2.2313D+06, 2.3069D+06, 2.3457D+06,
     9 2.3653D+06, 2.3852D+06, 2.4660D+06, 2.5924D+06, 2.7253D+06/
      DATA GR171D/
     1 2.8650D+06, 3.0119D+06, 3.1664D+06, 3.3287D+06, 3.6788D+06,
     2 4.0657D+06, 4.4933D+06, 4.7237D+06, 4.9659D+06, 5.2205D+06,
     3 5.4881D+06, 5.7695D+06, 6.0653D+06, 6.3763D+06, 6.5924D+06,
     4 6.7032D+06, 7.0469D+06, 7.4082D+06, 7.7880D+06, 8.1873D+06,
     5 8.6071D+06, 9.0484D+06, 9.5123D+06, 1.0000D+07, 1.0513D+07,
     6 1.1052D+07, 1.1618D+07, 1.2214D+07, 1.2840D+07, 1.3499D+07,
     7 1.3840D+07, 1.4191D+07, 1.4550D+07, 1.4918D+07, 1.5683D+07,
     8 1.6487D+07, 1.7333D+07/
c-----------------------------------------------------------------------
C
C     DEFINE WIMS 69 GROUP STRUCTURE.
C
c-----------------------------------------------------------------------
      DATA WIMSA/
     1 0.0001D0  , 0.0050D0  , 0.0100D0  , 0.0150D0  , 0.0200D0  ,
     2 0.0250D0  , 0.0300D0  , 0.0350D0  , 0.0420D0  , 0.0500D0  ,
     3 0.0580D0  , 0.0670D0  , 0.0800D0  , 0.1000D0  , 0.1400D0  ,
     4 0.1800D0  , 0.2200D0  , 0.2500D0  , 0.2800D0  , 0.3000D0  ,
     5 0.3200D0  , 0.3500D0  , 0.4000D0  , 0.5000D0  , 0.6250D0  ,
     6 0.7800D0  , 0.8500D0  , 0.9100D0  , 0.9500D0  , 0.9720D0  ,
     7 0.9960D0  , 1.0200D0  , 1.0450D0  , 1.0710D0  , 1.0970D0  ,
     8 1.1230D0  , 1.1500D0  , 1.3000D0  , 1.5000D0  , 2.1000D0  ,
     9 2.6000D0  , 3.3000D0  , 4.0000D0  , 9.8770D0  , 15.968D0  /
      DATA WIMSB/
     1 27.7000D0  , 48.0520D0   , 75.5014D0  , 148.728D0 , 367.262D0 ,
     2 906.898D0  , 1425.10D0   , 2239.45D0  , 3519.10D0 , 5530.00D0 ,
     3 9118.00D0  , 15030.0D0   , 24780.0D0  , 40850.0D0 , 67340.0D0 ,
     4 111000.0D0 , 183000.0D0  , 302000.0D0 , 500000.0D0, 821000.0D0,
     5 1353000.0D0, 2231000.0D0 , 3679000.0D0,
     6 6065000.0D0, 10000000.0D0/
c-----------------------------------------------------------------------
C
C     DEFINE GAM-I 68 GROUP STRUCTURE.
C
c-----------------------------------------------------------------------
      DATA GAMIA/
     1 0.414D0,    0.532D0,    0.683D0,    0.876D0,    1.125D0,
     2 1.44D0,     1.86D0,     2.38D0,     3.06D0,     3.93D0,
     3 5.04D0,     6.48D0,     8.32D0,    10.68D0,    13.7D0,
     4 17.6D0,     22.6D0,     29.0D0,     37.3D0,     47.9D0,
     5 61.4D0,     78.9D0,    101.0D0,    130.0D0,    167.0D0,
     6 215.0D0,    275.0D0,    354.0D0,    454.0D0,    583.0D0,
     7 748.0D0,    961.0D0,   1230.0D0,   1590.0D0,   2040.0D0,
     8 2610.0D0,   3360.0D0,   4310.0D0,   5530.0D0,   7100.0D0,
     9 9120.0D0,  11700.0D0,  15000.0 D0, 19300.0D0,  24800.0D0/
      DATA GAMIB/
     1 31800.0D0 , 40900.0D0 , 52500.0D0 , 67400.0D0 , 86500.0D0 ,
     2 111000.0D0, 143000.0D0, 183000.0D0, 235000.0D0, 302000.0D0,
     3 388000.0D0, 498000.0D0, 639000.0D0, 821000.0D0, 1.0500D+06,
     4 1.3600D+06, 1.7400D+06, 2.2300D+06, 2.8700D+06, 3.6800D+06,
     5 4.7200D+06, 6.0700D+06, 7.7900D+06, 1.0000D+07/
c-----------------------------------------------------------------------
C
C     DEFINE GAM-II 99 GROUP STRUCTURE.
C
c-----------------------------------------------------------------------
      DATA GAMIIA/
     1 0.414D0,    0.532D0,    0.683D0,    0.876D0,    1.125D0,
     2 1.44D0,     1.86D0,     2.38D0,     3.06D0,     3.93D0,
     3 5.04D0,     6.48D0,     8.32D0,    10.68D0,    13.7D0,
     4 17.6D0,     22.6D0,     29.0D0,     37.3D0,     47.9D0,
     5 61.4D0,     78.9D0,    101.0D0,    130.0D0,    167.0D0,
     6 215.0D0,    275.0D0,    354.0D0,    454.0D0,    583.0D0,
     7 748.0D0,    961.0D0,   1230.0D0,   1590.0D0,   2040.0D0,
     8 2610.0D0,   3360.0D0,   4310.0D0,   5530.0D0,   7100.0D0,
     9 9120.0D0,  11700.0D0,  15000.0D0,  19300.0D0,  24800.0D0/
      DATA GAMIIB/
     1 31800.00D0,  40900.0D0,  52500.0D0,  67400.0D0,  86500.0D0,
     2 111000.0D0, 128000.0D0, 136000.0D0, 150000.0D0, 166000.0D0,
     3 183000.0D0, 202000.0D0, 224000.0D0, 247000.0D0, 273000.0D0,
     4 302000.0D0, 334000.0D0, 369000.0D0, 408000.0D0, 450000.0D0,
     5 498000.0D0, 550000.0D0, 608000.0D0, 672000.0D0, 743000.0D0,
     6 821000.0D0, 907000.0D0, 1.0000D+06, 1.1100D+06, 1.2200D+06,
     7 1.3500D+06, 1.5000D+06, 1.6500D+06, 1.8300D+06, 2.0200D+06,
     8 2.2300D+06, 2.4700D+06, 2.7300D+06, 3.0100D+06, 3.3300D+06,
     9 3.6800D+06, 4.0700D+06, 4.4900D+06, 4.9600D+06, 5.4900D+06/
      DATA GAMIIC/
     1 6.0700D+06, 6.7000D+06, 7.4100D+06, 8.1900D+06, 9.0500D+06,
     2 1.0000D+07, 1.1100D+07, 1.2200D+07, 1.3500D+07, 1.4900D+07/
c-----------------------------------------------------------------------
C
C     DEFINE MUFT 54 GROUP STRUCTURE.
C
c-----------------------------------------------------------------------
      DATA XMUFT/
     1   0.625D+0,   0.835D+0,   1.125D+0,   1.440D+0,   1.855D+0,
     2    2.38D+0,    3.06D+0,    3.97D+0,    5.10D+0,    6.50D+0,
     3    8.32D+0,    10.7D+0,    13.7D+0,    17.6D+0,    22.6D+0,
     4    29.0D+0,    37.2D+0,    47.8D+0,    61.3D+0,    78.7D+0,
     5   101.0D+0,   130.0D+0,   167.0D+0,   275.0D+0,   454.0D+0,
     6   750.0D+0,  1230.0D+0,  2030.0D+0,  3350.0D+0,  5530.0D+0,
     7  9120.0D+0, 15000.0D+0, 24800.0D+0, 40900.0D+0, 67400.0D+0,
     8 86500.0D+0, 1.11000D+5, 1.43000D+5, 1.83000D+5, 2.35000D+5,
     9 3.02000D+5, 3.87000D+5, 4.98000D+5, 6.39000D+5, 8.21000D+5,
     A 1.0500D+06, 1.3500D+06, 1.7400D+06, 2.2300D+06, 2.8600D+06,
     1 3.6800D+06, 4.7200D+06, 6.0700D+06, 7.7900D+06, 1.0000D+07/
c-----------------------------------------------------------------------
C
C    ABBN GROUP STRUCTURE (28 GROUPS - NARROW GROUP NEAR THERMAL,
C    DUMMY GROUP FROM 0.0256 TO 0.215 EV, 26 GROUPS UP TO 15 MEV).
C
c-----------------------------------------------------------------------
      DATA ABBN/  2.500D-02, 2.560D-02,
     1 2.150D-01, 4.650D-01, 1.000D+00, 2.150D+00, 4.650D+00, 1.000D+01,
     1 2.150D+01, 4.650D+01, 1.000D+02, 2.150D+02, 4.650D+02, 1.000D+03,
     1 2.150D+03, 4.650D+03, 1.000D+04, 2.150D+04, 4.650D+04, 1.000D+05,
     1 2.000D+05, 4.000D+05, 8.000D+05, 1.400D+06, 2.500D+06, 4.000D+06,
     1 6.500D+06, 1.050D+07, 1.500D+07/
c-----------------------------------------------------------------------
C
C     CHECK FOR ALLOWABLE VALUES - IF NOT, RETURN NO GROUPS.
C
c-----------------------------------------------------------------------
      IF(IWANT.GE.0.AND.IWANT.LE.19) GO TO 10
      NGROUP=0
      RETURN
c-----------------------------------------------------------------------
C
C     SELECT GROUP STRUCTURE
C
c-----------------------------------------------------------------------
   10 II=IWANT+1
c              1   2   3   4   5   6   7   8   9  10
      GO TO ( 20, 40, 60, 80,100,110,120,140,160,180,
     1       200,220,230,250,260,240,270,280,290,300),II
c             11  12  13  14  15  16  17  18  19  20
C-----TART 176 GROUPS
   20 DO 30 I=1,176
      EGROUP(I)=TART(I)
   30 CONTINUE
      NGROUP=175
      RETURN
C-----ORNL 50 GROUPS
   40 DO 50 I=1,51
      EGROUP(I)=ORNLA(I)
   50 CONTINUE
      NGROUP=50
      RETURN
C-----ORNL 126 GROUPS
   60 DO 70 I=1,127
      EGROUP(I)=ORNLB(I)
   70 CONTINUE
      NGROUP=126
      RETURN
C-----ORNL 171 GROUPS
   80 DO 90 I=1,172
      EGROUP(I)=ORNLC(I)
   90 CONTINUE
      NGROUP=171
      RETURN
c-----------------------------------------------------------------------
C
C     SAND-II - Original - 1.0D-4 eV to 18 or 20 MeV.
C
c-----------------------------------------------------------------------
C-----SAND 620 GROUPS (1.0D-4 eV to 18 MeV)
  100 EGRPMIN = 1.0D-4
      EGRPMAX = 1.8D+7
      CALL SAND2GEN(EGROUP,NGROUP,EGRPMIN,EGRPMAX)
      RETURN
C-----SAND 640 GROUPS (1.0D-4 eV to 20 MeV)
  110 EGRPMIN = 1.0D-4
      EGRPMAX = 2.0D+7
      CALL SAND2GEN(EGROUP,NGROUP,EGRPMIN,EGRPMAX)
      RETURN
C-----WIMS 69 GROUPS
  120 DO 130 I=1,70
      EGROUP(I)=WIMS(I)
  130 CONTINUE
      NGROUP=69
      RETURN
C-----GAM-I 68 GROUPS
  140 DO 150 I=1,69
      EGROUP(I)=GAMI(I)
  150 CONTINUE
      NGROUP=68
      RETURN
C-----GAM-II 99 GROUPS
  160 DO 170 I=1,100
      EGROUP(I)=GAMII(I)
  170 CONTINUE
      NGROUP=99
      RETURN
C-----MUFT 54 GROUPS
  180 DO 190 I=1,55
      EGROUP(I)=XMUFT(I)
  190 CONTINUE
      NGROUP=54
      RETURN
C-----ABBN 28 GROUPS
  200 DO 210 I=1,29
      EGROUP(I)=ABBN(I)
  210 CONTINUE
      NGROUP=28
      RETURN
C-----TART 616 GROUPS UP TO 20 MeV
  220 EGRPMAX = 2.0D+7
      CALL TARTGEN(EGROUP,NGROUP,EGRPMAX)
      RETURN
C-----TART 700 GROUPS UP TO 1 GeV
  230 EGRPMAX = 1.0D+9
      CALL TARTGEN(EGROUP,NGROUP,EGRPMAX)
      RETURN
C-----TART 666 GROUPS UP TO 200 MeV
  240 EGRPMAX = 2.0D+8
      CALL TARTGEN(EGROUP,NGROUP,EGRPMAX)
      RETURN
c-----------------------------------------------------------------------
C
C     SAND-II - Extended down to 1.0D-5 up to 18 or 20 MeV.
C
c-----------------------------------------------------------------------
C-----SAND 665 GROUPS (1.0D-5 eV to 18 MeV)
  250 EGRPMIN = 1.0D-5
      EGRPMAX = 1.8D+7
      CALL SAND2GEN(EGROUP,NGROUP,EGRPMIN,EGRPMAX)
      RETURN
C-----SAND 685 GROUPS (1.0D-5 eV to 20 MeV)
  260 EGRPMIN = 1.0D-5
      EGRPMAX = 2.0D+7
      CALL SAND2GEN(EGROUP,NGROUP,EGRPMIN,EGRPMAX)
      RETURN
c-----------------------------------------------------------------------
C
C     SAND-II - Extended up to 60, 150 or 200 MeV.
C
c-----------------------------------------------------------------------
C-----SAND 725 GROUPS (1.0D-5 eV to 60 MeV)
  270 EGRPMIN = 1.0D-5
      EGRPMAX = 6.0D+7
      CALL SAND2GEN(EGROUP,NGROUP,EGRPMIN,EGRPMAX)
      RETURN
C-----SAND 755 GROUPS (1.0D-5 eV to 150 MeV)
  280 EGRPMIN = 1.0D-5
      EGRPMAX = 1.5D+8
      CALL SAND2GEN(EGROUP,NGROUP,EGRPMIN,EGRPMAX)
      RETURN
C-----SAND 765 GROUPS (1.0D-5 eV to 200 MeV)
  290 EGRPMIN = 1.0D-5
      EGRPMAX = 2.0D+8
      CALL SAND2GEN(EGROUP,NGROUP,EGRPMIN,EGRPMAX)
      RETURN
c-----------------------------------------------------------------------
C
C     UKAEA 1102 GROUPS (1.0D-5 eV to 1 GeV)
C
c-----------------------------------------------------------------------
  300 EGRPMAX = 1.0D+9
      CALL UKAEAGEN(EGROUP,NGROUP,EGRPMAX)
      RETURN
      END
      SUBROUTINE TARTGEN(EGROUP,NGROUP,EGRPMAX)
C===============================================================
C
C     DEFINE TART GROUP STRUCTURE FROM 1.0D-5 eV TO UP
C     ANY UPPER LIMIT DEFINED BY EGRPMAX INPUT.
C
C===============================================================
      INCLUDE 'implicit.h'
      DIMENSION EGROUP(*)
c-----2011/11 - Corrected lower energy to 1.0D-5 from 1.0D-04.
      DATA EGRPMIN/1.0d-05/
      DATA TEN    /10.0d0/
      DATA FIFTY  /50.0d0/
C-----DEFAULT IS 700 GROUPS
      NGROUP=700
C-----50 PER ENERGY DECADE
      DE=DEXP(DLOG(TEN)/FIFTY)
      ENOW=EGRPMIN
C-----DEFINE GROUPS UP TO MAXIMUM ENDL ENERGY
      DO 10 I=1,NGROUP+1
      EGROUP(I)=ENOW
      IF(EGROUP(I).eq.EGRPMAX) go to 30
      IF(EGROUP(I).gt.EGRPMAX) go to 20
      ENOW=ENOW*DE
   10 CONTINUE
      RETURN
C-----DEFINE END OF GROUPS AT MAXIMUM ENDL ENERGY
   20 EGROUP(I)=EGRPMAX
   30 NGROUP=I-1
      RETURN
      END
      SUBROUTINE SAND2GEN(EGROUP,NGROUP,EGRPMIN,EGRPMAX)
C=======================================================================
C
C     GENERAL SAND-II GROUP STRUCTURE TO SELECT ALL GROUPS
C     BETWEEN EGRPMIN AND EGRPMAX (INPUT PARAMETERS).
C
C=======================================================================
      INCLUDE 'implicit.h'
      DIMENSION EGROUP(*),SAND(766),
     1 SANDA(45),SANDB(45),SANDC(45),SANDD(45),SANDE(45),SANDF(45),
     2 SANDG(45),SANDH(45),SANDI(45),SANDJ(45),SANDK(45),SANDL(45),
     3 SANDM(45),SANDN(45),SANDO(36),SANDP(20),SANDQ(40),SANDR(30),
     4 SANDS(10)
c
      EQUIVALENCE (SAND(  1),SANDA(1)),    ! 45
     1            (SAND( 46),SANDB(1)),    ! 45
     1            (SAND( 91),SANDC(1)),    ! 45
     1            (SAND(136),SANDD(1)),    ! 45
     1            (SAND(181),SANDE(1)),    ! 45
     1            (SAND(226),SANDF(1)),    ! 45
     1            (SAND(271),SANDG(1)),    ! 45
     1            (SAND(316),SANDH(1)),    ! 45
     1            (SAND(361),SANDI(1)),    ! 45
     1            (SAND(406),SANDJ(1)),    ! 45
     1            (SAND(451),SANDK(1)),    ! 45
     1            (SAND(496),SANDL(1)),    ! 45
     1            (SAND(541),SANDM(1)),    ! 45
     1            (SAND(586),SANDN(1)),    ! 45
     1            (SAND(631),SANDO(1)),    ! 36
     1            (SAND(667),SANDP(1)),    ! 20
     1            (SAND(687),SANDQ(1)),    ! 40
     1            (SAND(727),SANDR(1)),    ! 30
     1            (SAND(757),SANDS(1))     ! 10
c                       766
c-----------------------------------------------------------------------
C
C     DEFINE SAND-II 45 GROUP EXTENSION DOWN TO 10D-5 EV
C
c-----------------------------------------------------------------------
      DATA SANDA/
     1 1.0000D-05, 1.0500D-05, 1.1000D-05, 1.1500D-05, 1.2000D-05,
     2 1.2750D-05, 1.3500D-05, 1.4250D-05, 1.5000D-05, 1.6000D-05,
     3 1.7000D-05, 1.8000D-05, 1.9000D-05, 2.0000D-05, 2.1000D-05,
     4 2.2000D-05, 2.3000D-05, 2.4000D-05, 2.5500D-05, 2.7000D-05,
     5 2.8000D-05, 3.0000D-05, 3.2000D-05, 3.4000D-05, 3.6000D-05,
     6 3.8000D-05, 4.0000D-05, 4.2500D-05, 4.5000D-05, 4.7500D-05,
     7 5.0000D-05, 5.2500D-05, 5.5000D-05, 5.7500D-05, 6.0000D-05,
     8 6.3000D-05, 6.6000D-05, 6.9000D-05, 7.2000D-05, 7.6000D-05,
     9 8.0000D-05, 8.4000D-05, 8.8000D-05, 9.2000D-05, 9.6000D-05/
c-----------------------------------------------------------------------
C
C     DEFINE SAND-II 620 (665) AND 620 (685) GROUP STRUCTURES.
C
c-----------------------------------------------------------------------
      DATA SANDB/
     1 1.0000D-04, 1.0500D-04, 1.1000D-04, 1.1500D-04, 1.2000D-04,
     2 1.2750D-04, 1.3500D-04, 1.4250D-04, 1.5000D-04, 1.6000D-04,
     3 1.7000D-04, 1.8000D-04, 1.9000D-04, 2.0000D-04, 2.1000D-04,
     4 2.2000D-04, 2.3000D-04, 2.4000D-04, 2.5500D-04, 2.7000D-04,
     5 2.8000D-04, 3.0000D-04, 3.2000D-04, 3.4000D-04, 3.6000D-04,
     6 3.8000D-04, 4.0000D-04, 4.2500D-04, 4.5000D-04, 4.7500D-04,
     7 5.0000D-04, 5.2500D-04, 5.5000D-04, 5.7500D-04, 6.0000D-04,
     8 6.3000D-04, 6.6000D-04, 6.9000D-04, 7.2000D-04, 7.6000D-04,
     9 8.0000D-04, 8.4000D-04, 8.8000D-04, 9.2000D-04, 9.6000D-04/
      DATA SANDC/
     1 1.0000D-03, 1.0500D-03, 1.1000D-03, 1.1500D-03, 1.2000D-03,
     2 1.2750D-03, 1.3500D-03, 1.4250D-03, 1.5000D-03, 1.6000D-03,
     3 1.7000D-03, 1.8000D-03, 1.9000D-03, 2.0000D-03, 2.1000D-03,
     4 2.2000D-03, 2.3000D-03, 2.4000D-03, 2.5500D-03, 2.7000D-03,
     5 2.8000D-03, 3.0000D-03, 3.2000D-03, 3.4000D-03, 3.6000D-03,
     6 3.8000D-03, 4.0000D-03, 4.2500D-03, 4.5000D-03, 4.7500D-03,
     7 5.0000D-03, 5.2500D-03, 5.5000D-03, 5.7500D-03, 6.0000D-03,
     8 6.3000D-03, 6.6000D-03, 6.9000D-03, 7.2000D-03, 7.6000D-03,
     9 8.0000D-03, 8.4000D-03, 8.8000D-03, 9.2000D-03, 9.6000D-03/
      DATA SANDD/
     1 1.0000D-02, 1.0500D-02, 1.1000D-02, 1.1500D-02, 1.2000D-02,
     2 1.2750D-02, 1.3500D-02, 1.4250D-02, 1.5000D-02, 1.6000D-02,
     3 1.7000D-02, 1.8000D-02, 1.9000D-02, 2.0000D-02, 2.1000D-02,
     4 2.2000D-02, 2.3000D-02, 2.4000D-02, 2.5500D-02, 2.7000D-02,
     5 2.8000D-02, 3.0000D-02, 3.2000D-02, 3.4000D-02, 3.6000D-02,
     6 3.8000D-02, 4.0000D-02, 4.2500D-02, 4.5000D-02, 4.7500D-02,
     7 5.0000D-02, 5.2500D-02, 5.5000D-02, 5.7500D-02, 6.0000D-02,
     8 6.3000D-02, 6.6000D-02, 6.9000D-02, 7.2000D-02, 7.6000D-02,
     9 8.0000D-02, 8.4000D-02, 8.8000D-02, 9.2000D-02, 9.6000D-02/
      DATA SANDE/
     1 1.0000D-01, 1.0500D-01, 1.1000D-01, 1.1500D-01, 1.2000D-01,
     2 1.2750D-01, 1.3500D-01, 1.4250D-01, 1.5000D-01, 1.6000D-01,
     3 1.7000D-01, 1.8000D-01, 1.9000D-01, 2.0000D-01, 2.1000D-01,
     4 2.2000D-01, 2.3000D-01, 2.4000D-01, 2.5500D-01, 2.7000D-01,
     5 2.8000D-01, 3.0000D-01, 3.2000D-01, 3.4000D-01, 3.6000D-01,
     6 3.8000D-01, 4.0000D-01, 4.2500D-01, 4.5000D-01, 4.7500D-01,
     7 5.0000D-01, 5.2500D-01, 5.5000D-01, 5.7500D-01, 6.0000D-01,
     8 6.3000D-01, 6.6000D-01, 6.9000D-01, 7.2000D-01, 7.6000D-01,
     9 8.0000D-01, 8.4000D-01, 8.8000D-01, 9.2000D-01, 9.6000D-01/
      DATA SANDF/
     1 1.0000D+00, 1.0500D+00, 1.1000D+00, 1.1500D+00, 1.2000D+00,
     2 1.2750D+00, 1.3500D+00, 1.4250D+00, 1.5000D+00, 1.6000D+00,
     3 1.7000D+00, 1.8000D+00, 1.9000D+00, 2.0000D+00, 2.1000D+00,
     4 2.2000D+00, 2.3000D+00, 2.4000D+00, 2.5500D+00, 2.7000D+00,
     5 2.8000D+00, 3.0000D+00, 3.2000D+00, 3.4000D+00, 3.6000D+00,
     6 3.8000D+00, 4.0000D+00, 4.2500D+00, 4.5000D+00, 4.7500D+00,
     7 5.0000D+00, 5.2500D+00, 5.5000D+00, 5.7500D+00, 6.0000D+00,
     8 6.3000D+00, 6.6000D+00, 6.9000D+00, 7.2000D+00, 7.6000D+00,
     9 8.0000D+00, 8.4000D+00, 8.8000D+00, 9.2000D+00, 9.6000D+00/
      DATA SANDG/
     1 1.0000D+01, 1.0500D+01, 1.1000D+01, 1.1500D+01, 1.2000D+01,
     2 1.2750D+01, 1.3500D+01, 1.4250D+01, 1.5000D+01, 1.6000D+01,
     3 1.7000D+01, 1.8000D+01, 1.9000D+01, 2.0000D+01, 2.1000D+01,
     4 2.2000D+01, 2.3000D+01, 2.4000D+01, 2.5500D+01, 2.7000D+01,
     5 2.8000D+01, 3.0000D+01, 3.2000D+01, 3.4000D+01, 3.6000D+01,
     6 3.8000D+01, 4.0000D+01, 4.2500D+01, 4.5000D+01, 4.7500D+01,
     7 5.0000D+01, 5.2500D+01, 5.5000D+01, 5.7500D+01, 6.0000D+01,
     8 6.3000D+01, 6.6000D+01, 6.9000D+01, 7.2000D+01, 7.6000D+01,
     9 8.0000D+01, 8.4000D+01, 8.8000D+01, 9.2000D+01, 9.6000D+01/
      DATA SANDH/
     1 1.0000D+02, 1.0500D+02, 1.1000D+02, 1.1500D+02, 1.2000D+02,
     2 1.2750D+02, 1.3500D+02, 1.4250D+02, 1.5000D+02, 1.6000D+02,
     3 1.7000D+02, 1.8000D+02, 1.9000D+02, 2.0000D+02, 2.1000D+02,
     4 2.2000D+02, 2.3000D+02, 2.4000D+02, 2.5500D+02, 2.7000D+02,
     5 2.8000D+02, 3.0000D+02, 3.2000D+02, 3.4000D+02, 3.6000D+02,
     6 3.8000D+02, 4.0000D+02, 4.2500D+02, 4.5000D+02, 4.7500D+02,
     7 5.0000D+02, 5.2500D+02, 5.5000D+02, 5.7500D+02, 6.0000D+02,
     8 6.3000D+02, 6.6000D+02, 6.9000D+02, 7.2000D+02, 7.6000D+02,
     9 8.0000D+02, 8.4000D+02, 8.8000D+02, 9.2000D+02, 9.6000D+02/
      DATA SANDI/
     1 1.0000D+03, 1.0500D+03, 1.1000D+03, 1.1500D+03, 1.2000D+03,
     2 1.2750D+03, 1.3500D+03, 1.4250D+03, 1.5000D+03, 1.6000D+03,
     3 1.7000D+03, 1.8000D+03, 1.9000D+03, 2.0000D+03, 2.1000D+03,
     4 2.2000D+03, 2.3000D+03, 2.4000D+03, 2.5500D+03, 2.7000D+03,
     5 2.8000D+03, 3.0000D+03, 3.2000D+03, 3.4000D+03, 3.6000D+03,
     6 3.8000D+03, 4.0000D+03, 4.2500D+03, 4.5000D+03, 4.7500D+03,
     7 5.0000D+03, 5.2500D+03, 5.5000D+03, 5.7500D+03, 6.0000D+03,
     8 6.3000D+03, 6.6000D+03, 6.9000D+03, 7.2000D+03, 7.6000D+03,
     9 8.0000D+03, 8.4000D+03, 8.8000D+03, 9.2000D+03, 9.6000D+03/
      DATA SANDJ/
     1 1.0000D+04, 1.0500D+04, 1.1000D+04, 1.1500D+04, 1.2000D+04,
     2 1.2750D+04, 1.3500D+04, 1.4250D+04, 1.5000D+04, 1.6000D+04,
     3 1.7000D+04, 1.8000D+04, 1.9000D+04, 2.0000D+04, 2.1000D+04,
     4 2.2000D+04, 2.3000D+04, 2.4000D+04, 2.5500D+04, 2.7000D+04,
     5 2.8000D+04, 3.0000D+04, 3.2000D+04, 3.4000D+04, 3.6000D+04,
     6 3.8000D+04, 4.0000D+04, 4.2500D+04, 4.5000D+04, 4.7500D+04,
     7 5.0000D+04, 5.2500D+04, 5.5000D+04, 5.7500D+04, 6.0000D+04,
     8 6.3000D+04, 6.6000D+04, 6.9000D+04, 7.2000D+04, 7.6000D+04,
     9 8.0000D+04, 8.4000D+04, 8.8000D+04, 9.2000D+04, 9.6000D+04/
      DATA SANDK/
     1 1.0000D+05, 1.0500D+05, 1.1000D+05, 1.1500D+05, 1.2000D+05,
     2 1.2750D+05, 1.3500D+05, 1.4250D+05, 1.5000D+05, 1.6000D+05,
     3 1.7000D+05, 1.8000D+05, 1.9000D+05, 2.0000D+05, 2.1000D+05,
     4 2.2000D+05, 2.3000D+05, 2.4000D+05, 2.5500D+05, 2.7000D+05,
     5 2.8000D+05, 3.0000D+05, 3.2000D+05, 3.4000D+05, 3.6000D+05,
     6 3.8000D+05, 4.0000D+05, 4.2500D+05, 4.5000D+05, 4.7500D+05,
     7 5.0000D+05, 5.2500D+05, 5.5000D+05, 5.7500D+05, 6.0000D+05,
     8 6.3000D+05, 6.6000D+05, 6.9000D+05, 7.2000D+05, 7.6000D+05,
     9 8.0000D+05, 8.4000D+05, 8.8000D+05, 9.2000D+05, 9.6000D+05/
      DATA SANDL/
     1 1.0000D+06, 1.1000D+06, 1.2000D+06, 1.3000D+06, 1.4000D+06,
     2 1.5000D+06, 1.6000D+06, 1.7000D+06, 1.8000D+06, 1.9000D+06,
     3 2.0000D+06, 2.1000D+06, 2.2000D+06, 2.3000D+06, 2.4000D+06,
     4 2.5000D+06, 2.6000D+06, 2.7000D+06, 2.8000D+06, 2.9000D+06,
     5 3.0000D+06, 3.1000D+06, 3.2000D+06, 3.3000D+06, 3.4000D+06,
     6 3.5000D+06, 3.6000D+06, 3.7000D+06, 3.8000D+06, 3.9000D+06,
     7 4.0000D+06, 4.1000D+06, 4.2000D+06, 4.3000D+06, 4.4000D+06,
     8 4.5000D+06, 4.6000D+06, 4.7000D+06, 4.8000D+06, 4.9000D+06,
     9 5.0000D+06, 5.1000D+06, 5.2000D+06, 5.3000D+06, 5.4000D+06/
      DATA SANDM/
     1 5.5000D+06, 5.6000D+06, 5.7000D+06, 5.8000D+06, 5.9000D+06,
     2 6.0000D+06, 6.1000D+06, 6.2000D+06, 6.3000D+06, 6.4000D+06,
     3 6.5000D+06, 6.6000D+06, 6.7000D+06, 6.8000D+06, 6.9000D+06,
     4 7.0000D+06, 7.1000D+06, 7.2000D+06, 7.3000D+06, 7.4000D+06,
     5 7.5000D+06, 7.6000D+06, 7.7000D+06, 7.8000D+06, 7.9000D+06,
     6 8.0000D+06, 8.1000D+06, 8.2000D+06, 8.3000D+06, 8.4000D+06,
     7 8.5000D+06, 8.6000D+06, 8.7000D+06, 8.8000D+06, 8.9000D+06,
     8 9.0000D+06, 9.1000D+06, 9.2000D+06, 9.3000D+06, 9.4000D+06,
     9 9.5000D+06, 9.6000D+06, 9.7000D+06, 9.8000D+06, 9.9000D+06/
      DATA SANDN/
     1 1.0000D+07, 1.0100D+07, 1.0200D+07, 1.0300D+07, 1.0400D+07,
     2 1.0500D+07, 1.0600D+07, 1.0700D+07, 1.0800D+07, 1.0900D+07,
     3 1.1000D+07, 1.1100D+07, 1.1200D+07, 1.1300D+07, 1.1400D+07,
     4 1.1500D+07, 1.1600D+07, 1.1700D+07, 1.1800D+07, 1.1900D+07,
     5 1.2000D+07, 1.2100D+07, 1.2200D+07, 1.2300D+07, 1.2400D+07,
     6 1.2500D+07, 1.2600D+07, 1.2700D+07, 1.2800D+07, 1.2900D+07,
     7 1.3000D+07, 1.3100D+07, 1.3200D+07, 1.3300D+07, 1.3400D+07,
     8 1.3500D+07, 1.3600D+07, 1.3700D+07, 1.3800D+07, 1.3900D+07,
     9 1.4000D+07, 1.4100D+07, 1.4200D+07, 1.4300D+07, 1.4400D+07/
      DATA SANDO/
     1 1.4500D+07, 1.4600D+07, 1.4700D+07, 1.4800D+07, 1.4900D+07,
     2 1.5000D+07, 1.5100D+07, 1.5200D+07, 1.5300D+07, 1.5400D+07,
     3 1.5500D+07, 1.5600D+07, 1.5700D+07, 1.5800D+07, 1.5900D+07,
     4 1.6000D+07, 1.6100D+07, 1.6200D+07, 1.6300D+07, 1.6400D+07,
     5 1.6500D+07, 1.6600D+07, 1.6700D+07, 1.6800D+07, 1.6900D+07,
     6 1.7000D+07, 1.7100D+07, 1.7200D+07, 1.7300D+07, 1.7400D+07,
     7 1.7500D+07, 1.7600D+07, 1.7700D+07, 1.7800D+07, 1.7900D+07,
     8 1.8000D+07/
C------DEFINE EXTENSION OF SAND-II STRUCTURE FROM 18 TO 20 MEV USING
C------20 ADDITIONAL GROUPS EACH 0.1 MEV WIDTH.
      DATA SANDP/
     1 1.8100D+07, 1.8200D+07, 1.8300D+07, 1.8400D+07, 1.8500D+07,
     1 1.8600D+07, 1.8700D+07, 1.8800D+07, 1.8900D+07, 1.9000D+07,
     1 1.9100D+07, 1.9200D+07, 1.9300D+07, 1.9400D+07, 1.9500D+07,
     1 1.9600D+07, 1.9700D+07, 1.9800D+07, 1.9900D+07, 2.0000D+07/
C------DEFINE EXTENSION OF SAND-II STRUCTURE FROM 20 TO 60 MEV USING
C------20 ADDITIONAL GROUPS EACH 0.5 MEV WIDTH.
C------10 ADDITIONAL GROUPS EACH 1.0 MEV WIDTH.
C------10 ADDITIONAL GROUPS EACH 2.0 MEV WIDTH.
      DATA SANDQ/
     1 20.500D+06, 21.000D+06, 21.500D+06, 22.000D+06, 22.500D+06,
     1 23.000D+06, 23.500D+06, 24.000D+06, 24.500D+06, 25.000D+06,
     1 25.500D+06, 26.000D+06, 26.500D+06, 27.000D+06, 27.500D+06,
     1 28.000D+06, 28.500D+06, 29.000D+06, 29.500D+06, 30.000D+06,
     1 31.000D+06, 32.000D+06, 33.000D+06, 34.000D+06, 35.000D+06,
     1 36.000D+06, 37.000D+06, 38.000D+06, 39.000D+06, 40.000D+06,
     1 42.000D+06, 44.000D+06, 46.000D+06, 48.000D+06, 50.000D+06,
     1 52.000D+06, 54.000D+06, 56.000D+06, 58.000D+06, 60.000D+06/
C------DEFINE EXTENSION OF SAND-II STRUCTURE FROM 60 TO 150 MEV USING
C------20 ADDITIONAL GROUPS EACH 2.0 MEV WIDTH.
C------10 ADDITIONAL GROUPS EACH 5.0 MEV WIDTH.
      DATA SANDR/
     1 62.000D+06, 64.000D+06, 66.000D+06, 68.000D+06, 70.000D+06,
     1 72.000D+06, 74.000D+06, 76.000D+06, 78.000D+06, 80.000D+06,
     1 82.000D+06, 84.000D+06, 86.000D+06, 88.000D+06, 90.000D+06,
     1 92.000D+06, 94.000D+06, 96.000D+06, 98.000D+06,100.000D+06,
     1105.000D+06,110.000D+06,115.000D+06,120.000D+06,125.000D+06,
     1130.000D+06,135.000D+06,140.000D+06,145.000D+06,150.000D+06/
C------DEFINE EXTENSION OF SAND-II STRUCTURE FROM 150 TO 200 MEV USING
C------10 ADDITIONAL GROUPS EACH 5.0 MEV WIDTH.
      DATA SANDS/
     1 155.000D+06,160.000D+06,165.000D+06,170.000D+06,175.000D+06,
     1 180.000D+06,185.000D+06,190.000D+06,195.000D+06,200.000D+06/
c-----------------------------------------------------------------------
C
C     USE ALL GROUPS BETWEEN EGRPMIN AND EGRPMAX.
C
c-----------------------------------------------------------------------
      ig = 0
      do i=1,766
      if(SAND(i).ge.EGRPMIN.and.SAND(i).le.EGRPMAX) then
      ig = ig + 1
      EGROUP(ig) = SAND(i)
      endif
      enddo
      NGROUP = ig - 1 ! # of groups is one less than # group boundaries
      return
      END
      SUBROUTINE UKAEAGEN(EGROUP,NGROUP,EGRPMAX)
C===============================================================
C
C     DEFINE UKAEA GROUP STRUCTURE FROM 1.0D-5 EV TO
C     ANY UPPER LIMIT ABOVE 30 MEV DEFINED BY EGRPMAX INPUT.
C
C     WARNING - As used by GROUPIE   EGRPMAX = 1 GeV.
C               There is no test for EGRPMAX > 30 MeV (Caveat Emptor).
C
C===============================================================
      INCLUDE 'implicit.h'
      DIMENSION EGROUP(*)
      DATA TEN/  10.0d0/
      DATA FIFTY/50.0d0/
      DATA EGRPMIN1/1.0d-05/
      DATA EGRPMIN2/5.5d-01/
      DATA EGRPMIN3/1.0d+01/
      DATA EGRPMIN4/5.0d+06/
      DATA E10MEV  /1.0d+07/
      DATA E30MEV  /3.0d+07/
c-----------------------------------------------------------------------
C
C     GROUPS SPLIT INTO EQUAL E (energy) AND U (lethargy) SECTIONS
C      237 EQUAL U FROM 1.0E-05 TO 5.5D-01
C      378 EQUAL E FROM 5.5D-01 TO 1.0D+01
C      285 EQUAL U FROM 1.0D+01 TO 5.0D+06
C      126 EQUAL E FROM 5.0D+06 TO ~3.02D+07
C       76 EQUAL U FROM ~3.02D+07 TO 1.0D+09
C     1102 TOTAL GROUPS
C
c-----------------------------------------------------------------------
C-----CUMULATIVE GROUPS USED IN BUILD BELOW
      NGROUP1= 237
      NGROUP2= 615
      NGROUP3= 900
      NGROUP4=1026
      NGROUP5=1102
      NGROUP= 1102
C-----50 GROUPS PER ENERGY DECADE (Same as TART Group Structure).
      DEU=DEXP(DLOG(TEN)/FIFTY)
C-----------------------------------------------------------------------
C
C     DEFINE GROUPS SEQUENTIALLY OVER 5 LOOPS
C     OPTION TO EXIT AT OTHER MAXIMUM ENERGY ABOVE 30 MEV
C
C-----------------------------------------------------------------------
c
c     10E-5 eV to 0.55 eV: 50 Groups per energy decade (same as TART)
c
c-----------------------------------------------------------------------
      ENOW=EGRPMIN1
      DO I=1,NGROUP1
      EGROUP(I)=ENOW
      ENOW=ENOW*DEU
      ENDDO
c-----------------------------------------------------------------------
c
c     0.55 eV to 10 eV: 0.025 eV spacing.
c
c-----------------------------------------------------------------------
      ENOW=EGRPMIN2
      DO I=NGROUP1+1,NGROUP2
      EGROUP(I)=ENOW
      ENOW=ENOW+2.5d-02
      ENDDO
c-----------------------------------------------------------------------
c
c     10 eV to 5 MeV: 50 Groups per energy decade (same as TART)
c
c-----------------------------------------------------------------------
      ENOW=EGRPMIN3
      DO I=NGROUP2+1,NGROUP3
      EGROUP(I)=ENOW
      ENOW=ENOW*DEU
      ENDDO
c-----------------------------------------------------------------------
c
c     5 MeV to 30 MeV: 200 keV spacing.
c
c-----------------------------------------------------------------------
      ENOW=EGRPMIN4
      DO I=NGROUP3+1,NGROUP4
      EGROUP(I)=ENOW
      ENOW=ENOW+2.0d+05
      ENDDO
c-----------------------------------------------------------------------
c
c     30 MeV to 1 GeV: 50 Groups per energy decade (same as TART)
c
c-----------------------------------------------------------------------
c-----First TART group boundary over 30 MeV
      EGRPMIN5 = E10MEV
   10 EGRPMIN5 = EGRPMIN5*DEU
      if(EGRPMIN5.le.E30MEV) go to 10
      ENOW=EGRPMIN5
      DO I=NGROUP4+1,NGROUP5+1
      EGROUP(I)=ENOW
      IF(EGROUP(I).gt.EGRPMAX) go to 20
      IF(EGROUP(I).eq.EGRPMAX) go to 30
      ENOW=ENOW*DEU
      ENDDO
      I = NGROUP5+1
C-----DEFINE END OF GROUPS AT MAXIMUM ENDL ENERGY
   20 EGROUP(I)=EGRPMAX
   30 NGROUP=I-1
      RETURN
      END
      SUBROUTINE FILIO1
C=======================================================================
C
C     DEFINE I/O UNITS AND OPTIONALLY DEFINE FILENAMES.
C
C=======================================================================
      INCLUDE 'implicit.h'
      INTEGER*4 OUTP,OTAPE
      CHARACTER*72 NAMEIN
      COMMON/ENDFIO/INP,OUTP,ITAPE,OTAPE
      COMMON/IOSTATUS/ISTAT1,ISTAT2
      COMMON/UNITS/IPLOT,ISCR(5)
      COMMON/NAMEX/NAMEIN
      DATA IPASS/0/
C-----DEFINE ALL I/O UNITS.
      INP=2
      OUTP=3
      ITAPE=10
      OTAPE=20
      ISCR(1)=11
      ISCR(2)=12
      ISCR(3)=13
      ISCR(4)=14
      ISCR(5)=15
      IPLOT=16
C-----DEFINE ALL FILE NAMES.
      OPEN(OUTP,FILE='VIRGIN.LST',STATUS='UNKNOWN')
      OPEN(IPLOT,FILE='PLOTTAB.CUR',STATUS='UNKNOWN')
      CALL SCRATCH1(ISCR(1),'VIRGIN.001  ')
      CALL SCRATCH1(ISCR(2),'VIRGIN.002  ')
      CALL SCRATCH1(ISCR(3),'VIRGIN.003  ')
      CALL SCRATCH1(ISCR(4),'VIRGIN.004  ')
      CALL SCRATCH1(ISCR(5),'VIRGIN.005  ')
      OPEN(INP,FILE='VIRGIN.INP',STATUS='OLD',ERR=10)
      ISTAT1 = 0
      RETURN
   10 ISTAT1 = 1
      RETURN
      ENTRY FILIO2
c-----------------------------------------------------------------------
C
C     AFTER FIRST PASS CLOSE INPUT DATA FILE
C
c-----------------------------------------------------------------------
      IPASS=IPASS+1
      IF(IPASS.GT.1) CLOSE(ITAPE)
c-----------------------------------------------------------------------
C
C     DEFINE ENDF/B INPUT DATA FILE NAME.
C
c-----------------------------------------------------------------------
C-----DEFINE ENDF/B INPUT DATA FILENAME.
      OPEN(ITAPE,FILE=NAMEIN,STATUS='OLD',ERR=20)
      ISTAT2 = 0
      RETURN
   20 ISTAT2 = 1
      RETURN
      END