       SUBROUTINE ATTEN(EP,INAMP,OUTAMP)
C
C      THIS SUBROUTINE TAKES THE INPUT AMPLITUDE (INAMP) AND REDUCES
C      IT BY THE KNOWN ATTENUATION OF THE MATERIAL IN FRONT OF
C      THE DETECTOR.  THE INPUT VALUE OF AMPL IS REPLACED BY THE
C      ATTENUATED VALUE.
C
C
       REAL EP,AMP,INAMP,OUTAMP
C
C
C
C
       IF (EP.LT.2.522) GO TO 5
       OUTAMP=0.92*INAMP
       RETURN
C
C
5      IF (EP.LT.0.22) GO TO 10
       OUTAMP=INAMP*(EXP(-0.14/EP)-0.026)
       RETURN
C
C
10     OUTAMP=INAMP*(197.13*EP*EP*EP*EP)
       RETURN
C
C
C
       END
       PROGRAM AVEMOD
C
C      13 APRIL 1982         S.M.MATZ
C
C      THIS PROGRAM PRODUCES A SMOOTHED SPECTRUM FROM A GRABAG READABLE
C      SPECTRUM FILE
C      BY MEANS OF AN UNWEIGHTED RUNNING AVERAGE
C
       REAL C,WIDTH,INPT(476),SMTH(476)
       INTEGER CHMIN,CHMAX,M,CK,NUMCH
       CHARACTER*80 INFL,OUTFL,INLA,OUTLA
C
       DO 100 I=1,476
         SMTH(I)=0.0
100    CONTINUE
C
       WRITE(6,200)
200    FORMAT(1X,'NAME OF INPUT FILE?')
       READ(5,300)INFL
300    FORMAT(A80)
C
       NUMCH = 476
C
       OPEN(UNIT=15,FILE=INFL,FORM='FORMATTED')
       READ(15,300)INLA
       WRITE(6,350)INLA
350    FORMAT(1X,A80)
       READ(15,400) (INPT(I),I=1,NUMCH)
400    FORMAT(E13.6)
       CLOSE(UNIT=15)
C
C
       CHMIN = 2
       CHMAX = 475
       M = 1
C
C
       C=0.0
       WIDTH=2.0*FLOAT(M)+1.0
C
C
C
       DO 2000 I=CHMIN,CHMAX
         C=0.0
         DO 1500 J=I-M,I+M
           C=C+INPT(J)
1500     CONTINUE
         SMTH(I)=C/WIDTH
2000   CONTINUE
C
C
       SMTH(1) = INPT(1)
       SMTH(476) = INPT(476)
C
C
       OUTFL = INFL
       OUTLA = INLA
C
       OPEN(UNIT=15,FILE=OUTFL,FORM='FORMATTED')
       WRITE(15,300)OUTLA
       WRITE(15,2500) (SMTH(I),I=1,NUMCH)
2500   FORMAT(E13.6)
       CLOSE(UNIT=15)
C
C
       STOP
C
       END
      REAL FUNCTION CEDGE(EP)
C
C     THIS ROUTINE CALCULATES THE ENERGY OF THE COMPTON EDGE
C      IN MEV...
C
      REAL EP
C
C     EP IS THE INPUT PHOTON ENERGY
C
      CEDGE = EP/(1.0 +0.256/EP)
C
      RETURN
C
      END
10	write(*,*)'input channnel'
        read(*,*)ch
        energy = pha(ch)
        write(*,*)energy
        goto 10
        end

      REAL FUNCTION CONT(EP,E,EDGE)
C
C      THIS ROUTINE IS THE UNSCALED COMPTON CONTINUUM ENERGY SPECTRUM
C
C
C   THIS ROUTINE IS FOR THE TOTALS SPECTRA......
C
      REAL EP,E,EDGE
C
C      EP IS THE INPUT PHOTON ENERGY IN MEV
C
       IF (E.LT.EDGE) CONT=1.0
       IF (E.GE.EDGE) CONT=0.7
C
      RETURN
C
      END
       SUBROUTINE COUNTS(N,CONST,CNTS)
C
C      THIS PROGRAM PERFORMS THE FUNCTION OF THE QPHA IN THE INSTRUMENT
C      BY INTERPOLATING THE COUNTS BETWEEN THE CHANNEL BOUNDARIES AND
C      ASSIGNING THAT NUMBER TO THE SPECTRUM.  ANY QPHA FUNCTION CAN BE
C      USED IN THIS ROUTINE BY MERELY SUBSTITUTING THE FUNCTION PHA.
C
       INTEGER J,JMIN,JMAX,M
C
       REAL CONST,EMIN,EMAX,C
       REAL N(1000),CNTS(476)
C
C
C      STEP THRU ALL PHA CHANNELS...
C
       DO 200 M=1,476
C
         EMIN = PHA(FLOAT(M)-0.5)*CONST
         EMAX = PHA(FLOAT(M)+0.5)*CONST
C
         JMIN = NINT(EMIN)
         JMAX = NINT(EMAX)
C
C
C        ADD IN FRACTIONS OF FIRST + LAST ENERGY BINS OVERLAPPING
C        CHANNEL M:
         CNTS(M) = (JMIN-EMIN+0.5)*N(JMIN) + (EMAX-JMAX+0.5)*N(JMAX)
C
C        CORRECT FOR POSSIBLE OVERCOUNTING IN ABOVE EXPRESSION:
         IF (JMIN.EQ.JMAX) CNTS(M)=CNTS(M)-N(JMIN)
C
C
C        ADD IN CNTS FROM ENERGY BINS ENTIRELY WITHIN CHANNEL M BOUNDS:
         DO 100 I=JMIN+1,JMAX-1
           CNTS(M)=CNTS(M)+N(I)
100      CONTINUE
C
C
200    CONTINUE
C
C
       RETURN
C
       END
       REAL FUNCTION CPEAK(I,SIGM)
C
C
C       GENERATES A TRIANGULAR PEAK OF AREA 1 AND BASE 4*SIGM
C
       INTEGER I,SIGM
C
       FSIGM=FLOAT(SIGM)
C
       CPEAK=1/(2*FSIGM)-ABS(I)/(4*FSIGM*FSIGM)
C
       RETURN
C
       END
       REAL FUNCTION CPSIGM(ECP)
C
C      RETURNS THE INTRINSIC WIDTH OF THE COMPTON EDGE
C      FEATURE IN MEV, BASED ON A FUNCTIONAL APPROX. OF THE MEASURED
C      DATA.
C
       REAL ECP
C
C
       CPSIGM = 0.05853
C
       IF (ECP.GE.1.6) RETURN
C
C
       CPSIGM = 0.02327 + 0.02204*ECP
C
       RETURN
C
C
C
       END
       REAL FUNCTION EDFEAT(EP)
C
C  CALCULATES THE POSITION OF THE COMPTON EDGE FEATURE IN MEV...
C
       REAL EP
C
       EDFEAT = CEDGE(EP) - 2.0*RESO(EP)
C
       RETURN
C
       END
       REAL FUNCTION EFAREA(EP)
C
C      THIS FUNCTION RETURNS THE VALUE OF THE EFFICIENCY TIMES
C      THE AREA (319.22 CM^2) AT PHOTON ENERGY EP (MEV).
C
C
       REAL EP,AREA,EFF
C
C
       DATA AREA/319.22/
C
C
       EFF= 0.6405*EXP(-0.655*EP) + 0.488*(EP**0.1204)
C
C
       EFAREA=EFF*AREA
C
       RETURN
C
C
       END
       REAL FUNCTION F1(EP)
C
C      THIS ROUTINE CALCULATES THE HEIGHT OF THE FIRST ESCAPE PEAK
C        RELATIVE TO THE PHOTOPEAK.
C
C
C      THIS ROUTINE IS FOR THE TOTALS SPECTRA...........
C
       REAL EP,M,B,COEFF,EXPT
C
C
C      EP IS THE PHOTON ENERGY IN MEV.
C
       F1 = 0.0
C
       IF (EP.LE.2.12) RETURN
C
       F1 = -0.27 + 0.36*LOG(EP)
       RETURN
C
C
C
C
       END
       REAL FUNCTION FC(EP)
C
C      THIS ROUTINE CALCULATES THE CONTRIBUTION OF THE COMPTON
C        CONTINUUM RELATIVE TO THE PHOTOPEAK.
C
C
C      THIS ROUTINE IS FOR THE TOTALS SPECTRA...........
C
       REAL EP
C
C      EP IS THE INPUT PHOTON ENERGY IN MEV.
C
C
       FC = -0.0878 + 0.5524*EP - 0.0515*EP*EP + 0.00157*EP*EP*EP
C
C
       RETURN
C
       END
       REAL FUNCTION FEDFET(EP)
C
C CALCULATES THE CONTRIBUTION OF THE EDGE FEATURE
C   WITH RESPECT TO THE PHOTOPEAK INTEGRAL.
C
C
C   THIS ROUTINE IS FOR THE TOTALS SPECTRA......
C
       REAL EP
C
       FEDFET = 0.12884
C
       IF (EP.GE.2.2) RETURN
C
       FEDFET = 0.047641 + 0.03691*EP
C
C
       RETURN

C
       END
       REAL FUNCTION FLUX(E,FUNC,INTEN,PARAM1,PARAM2,CONST)
C
       REAL E,TEMP,CONST
       REAL INTEN,PARAM1,PARAM2
       INTEGER FUNC
C
C
C
C
       GO TO (10,20,30,40)FUNC
C
       WRITE(6,5)
5      FORMAT(1X,'***  ERROR IN VALUE OF FUNC')
       RETURN
C
C
C         CALCULATE FLUX FOR BROADENED LINE:
10       TEMP = (E - PARAM1)/PARAM2
         FLUX = EXP(-TEMP*TEMP/2.0)/PARAM2/0.25066/FLOAT(MESH)
         RETURN
C
C         CALCULATE FLUX FOR POWER LAW SPECTRUM:
20       FLUX =  INTEN*E**PARAM1/CONST
       RETURN
C
C         CALCULATE FLUX FOR THERMAL SPECTRUM:
30     TEMP = -E/PARAM1
       FLUX=0.0
       IF (TEMP.LT.-145.0) RETURN
       FLUX = INTEN*EXP(TEMP)/E/CONST
       RETURN
C
C          CALCULATE FLUX FOR THERMAL SYNCH. SPECTRUM
40     TEMP = -(4.5*E/PARAM1)**0.333333
       FLUX = 0.0
       IF (TEMP.LT.-145.0) RETURN
       FLUX = INTEN*EXP(TEMP)/CONST
       RETURN
C
C
C
C
       END
       REAL FUNCTION FRAC(X)
C
       REAL X
C
       FRAC = X - AINT(X)
C
       RETURN
C
       END
       REAL FUNCTION GAUSS(J,P)
C
C
C      RETURNS THE INTEGRAL OF THE GAUSSIAN DEFINED BY P FROM J-0.5
C      TO J+0.5.
C            P(1)=AREA
C            P(2)=PEAK CHANNEL NUMBER
C            P(3)=SIGMA IN CHANNEL NUMBERS
C            P(4),P(5)=BACKGROUND PARAMETERS, NOT USED
C
C
       INTEGER J,PEAK
       REAL JF,TMP1,TMP2,FMID
       REAL AVEXP,EXP1,EXP2,EXP3,CONST
       REAL P(5)
C
       DATA CONST /2.5066283/
C
C
       JF=FLOAT(J)
       PEAK=NINT(P(2))
C
       EXP1=0.0
       EXP2=0.0
       EXP3=0.0
C
         TMP1=-(JF-0.5-P(2))*(JF-0.5-P(2))/(2*P(3)*P(3))
         TMP2=-(JF+0.5-P(2))*(JF+0.5-P(2))/(2*P(3)*P(3))
         TMP3=-(JF-P(2))*(JF-P(2))/(2.0*P(3)*P(3))
C
       IF (TMP1.GT.-145.06) EXP1=EXP(TMP1)
       IF (TMP2.GT.-145.06) EXP2=EXP(TMP2)
       IF (TMP3.GT.-145.06) EXP3=EXP(TMP3)
C
       AVEXP=(EXP1 + EXP2 + EXP3 + EXP3)/4.0
C
       GAUSS=P(1)*AVEXP/(P(3)*CONST)
C
C
       RETURN
C
       END
       REAL FUNCTION P0(EP)
C
C      THIS FUNCTION RETURNS THE VALUE OF THE PHOTOFRACTION AT
C      PHOTON ENERGY EP (MEV).
C      THIS ROUTINE IS FOR TOTALS SPECTRA.
C
C
       REAL EP
C
C
       P0= 0.19 + 0.21*EXP(-0.415*EP) + 0.62*EXP(-1.04*EP)
C
       RETURN
C
C
       END
       REAL FUNCTION PHA(CH)
C      FOR THE TOTALS SPECTRA
C
       REAL CH
C
C
       PHA = 0.231985 + 6.40281E-3*CH + 2.37647E-5*CH*CH
       PHA = PHA + 3.27707E-9*CH*CH*CH
C
       RETURN
C
       END
      SUBROUTINE PPSPEC(EP,N,CONST,AMPL)
C
C      THIS ROUTINE PRODUCES AN UNSMOOTHED ELECTRON ENERGY DEPOSIT
C      SPECTRUM IN THE DETECTOR.  THE NOMINAL ARRAY SIZE IS 1000.
C
       REAL N(1000)
C
C      ARRAY N IS THE COUNTS DISTRIBUTION
C
       REAL EP,TAIL(1000),PPA,INT,CONST,PPH,AMPL,THRESH,EEDGE,EMIN,E0
       REAL AREA,PHOTFR
C
C      EP IS THE INPUT PHOTON ENERGY TO BE INTEGERIZED
C      TAIL IS THE UNSCALED COMTPTON TAIL
C      AREA - EFFECTIVE AREA AT ENERGY EP = EFFICIENCY * TOTAL AREA
C      PHOTFR - PHOTOFRACTION = COUNTS(PHOTOPEAK)/COUNTS(TOTAL)
C      PPA - THE PHOTOPEAK AREA
C      INT - THE INTEGRAL TAIL FROM CHANNEL 0 TO THE EDGE
C      PPH - THE PHOTOPEAK HEIGHT, FLUX*AREA
C      AMPL - THE INTENSITY OF THE PHOTON FLUX
C      ATTAMP - THE ATTENUATED INTENSITY OF PHOTON FLUX
C      THRESH - THE THRESHOLD OF THE SMM PHA = CHANNEL 0
C      EEDGE - THE ENERGY OF THE COMPTON EDGE
C
       INTEGER E,EDGE,EPP,E1,MESH,ECF,EC
C      E IS THE INTEGERIZED ENERGY
C      EDGE - THE INTEGERIZED EDGE
C      EPP - THE INTEGERIZED PHOTOPEAK ENERGY = PHOTON ENERGY
C      E1 - THE INTEGERIZED ENERGY OF THE ESCAPE PEAK
C      MESH - THE SIZE OF N OR THE FINENESS OF THE DIGITIZATION
C      ECF - INTEGERIZED ENERGY OF THE COMPTON FEATURE
C      EMIN - ENERGY BELOW WHICH COMPTON TAIL FRACTION REMAINS CONST
C             AT VALUE AT E=0.5
C
       REAL WIDTH,CPAREA,ECP
       INTEGER SIGM
C      WIDTH - THE INTRINSIC WIDTH (SIGMA) OF THE COMPTON EDGE FEATURE
C      CPAREA - THE AREA OF THE COMPTON EDGE FEATURE
C      ECP - THE REAL ENERGY OF THE COMPTON EDGE FEATURE
C      SIGM - THE INTEGERIZED SIGMA OF THE COMPTON EDGE FEATURE
C
       DATA EMIN/0.500/
C
       THRESH = PHA(0.0)
C
C
C      WE FIRST COMPUTE THE AMPLITUDE OF THE INCIDENT PHOTONS
C      AFTER ATTENUATION BY THE MATERIAL IN FRONT OF THE DETECTOR.
C
       CALL ATTEN(EP,AMPL,ATTAMP)
C
C
       EPP = NINT(EP*CONST)
C
C      NEXT WE COMPUTE THE SCALING AND HEIGHT OF PHOTOPEAK
C
       AREA=EFAREA(EP)
       PHOTFR=P0(EP)
       PPA=PHOTFR*AREA
       PPH = PPA*ATTAMP
C
       EC = EPP
       E0 = EP
C
C
C      ADD PHOTOPEAK
C
       N(EPP) = N(EPP) + PPH
C
C
       RETURN
C
       END
       SUBROUTINE REBIN(ELO,EUP,J,JMAX,AMPL)
C
C
C      REBINS GSFC NUCLEAR SPECTRAL DATA INTO BINS DEFINED
C      BY ELO,EUP.
C
       REAL ELO,EUP,EMIN,EMAX,PHOTS,AMPL
       INTEGER J,JMAX
C
       AMPL=0.0
C
       IF ((J+1).GE.JMAX) RETURN
C
100    READ(9,200)EMIN,EMAX,PHOTS
C
200    FORMAT(3E13.6)
C
       J=J+1
C
       IF (EMAX.LE.ELO) GOTO 100
C
C
       AMPL=(EMAX-ELO)*1000.0*PHOTS
C
C
300    IF ((J+1).GE.JMAX) RETURN
C
       READ(9,200)EMIN,EMAX,PHOTS
       J=J+1
C
       IF (EMAX.GE.EUP) GOTO 400
C
       AMPL=AMPL+(EMAX-EMIN)*1000.0*PHOTS
C
       GOTO 300
C
C
C      ADD THE CONTRIBUTION OF THE LAST RECORD:
C
400    AMPL=AMPL+(EUP-EMIN)*1000.0*PHOTS
C
C      SINCE LAST GSFC RECORD MAY OVERLAP NEXT RESPONSE BIN, WE MOVE
C      THE POINTERS BACK ONE SO THAT THE LAST RECORD WILL BE REREAD:
C
500    BACKSPACE(UNIT=9)
       J=J-1
C
C
       RETURN
C
C
       END
       REAL FUNCTION RESO(E)
C
C CALCULATES SIGMA IN MEV FOR AN ENERGY DEPOSIT OF E IN MEV.
C
       REAL E,COEFF,EXPT
C
       DATA COEFF/0.0271/,EXPT/0.66/
C
       RESO = COEFF * E**EXPT
C
       RETURN
C
       END
      SUBROUTINE SMOOTH(NI,NF,MESH,CONST)
C
C      THIS SUBROUTINE SMOOTHS AN ELECTRON ENERGY DEPOSIT SPECTRUM
C      BY AN ASSIGNED DETECTOR RESOLUTION
C
      INTEGER MESH,E,EMIN,EMAX
C
C      E - THE INTGERIZED ENERGY
C      EMIN - THE ENERGY INDEX FOR THE -3*SIGMA POINT
C      EMAX - THE ENERGY INDEX FOR THE +3*SIGMA POINT
C
      REAL SIGMA,SIG,CONST,ENERGY,DEL,RT2PI,NORM
      REAL NI(1000),NF(1000),P(5)
C
C      NI IS THE INITIAL ARRAY, NF IS THE FINAL ARRAY, MESH IS THE
C      SPECTRUM SIZE
C
       DATA RT2PI/2.5066/
C
C
C      THIS LOOP CALCULATES THE GAUSSIAN FROM THE COUNTS IN A PARTICULAR
C      ENERGY INTERVAL.  IT DOES NOT EXTEND ABOVE OR BELOW THE
C      ENERGY RANGE.  THE NORMALIZATION IS ALSO DONE TO CONSERVE COUNTS
C     THE GAUSSIAN IS ONLY PERFORMED FROM -3*SIGMA TO +3*SIGMA.
C
      DO 10 E=1,MESH
C       PASS IF NO COUNTS...
        IF (NI(E).EQ.0.0) GO TO 10
        ENERGY = E/CONST
        SIGMA = RESO(ENERGY)
        SIG = SIGMA*SIGMA
        EMIN = NINT((ENERGY - 3.0*SIGMA)*CONST)
        EMAX = NINT((ENERGY + 3.0*SIGMA)*CONST)
        P(1)=NI(E)
        P(2)=FLOAT(E)
        P(3)=SIGMA*CONST
        DO 20 I=EMIN,EMAX
C         PASS IF BELOW 10 KEV...
          IF (I.LT.1) GO TO 20
C         PASS IF ABOVE 10 MEV...
          IF (I.GT.MESH) GO TO 10
          NF(I) = NF(I) + GAUSS(I,P)
20        CONTINUE
10       CONTINUE
C
      RETURN
      END
      SUBROUTINE SPEC(EP,N,CONST,AMPL)
C
C      THIS ROUTINE PRODUCES AN UNSMOOTHED ELECTRON ENERGY DEPOSIT
C      SPECTRUM IN THE DETECTOR.  THE NOMINAL ARRAY SIZE IS 1000.
C
       REAL N(1000)
C
C      ARRAY N IS THE COUNTS DISTRIBUTION
C
       REAL EP,TAIL(1000),PPA,INT,CONST,PPH,AMPL,THRESH,EEDGE,EMIN,E0
       REAL AREA,PHOTFR
C
C      EP IS THE INPUT PHOTON ENERGY TO BE INTEGERIZED
C      TAIL IS THE UNSCALED COMTPTON TAIL
C      AREA - EFFECTIVE AREA AT ENERGY EP = EFFICIENCY * TOTAL AREA
C      PHOTFR - PHOTOFRACTION = COUNTS(PHOTOPEAK)/COUNTS(TOTAL)
C      PPA - THE PHOTOPEAK AREA
C      INT - THE INTEGRAL TAIL FROM CHANNEL 0 TO THE EDGE
C      PPH - THE PHOTOPEAK HEIGHT, FLUX*AREA
C      AMPL - THE INTENSITY OF THE PHOTON FLUX
C      ATTAMP - THE ATTENUATED INTENSITY OF PHOTON FLUX
C      THRESH - THE THRESHOLD OF THE SMM PHA = CHANNEL 0
C      EEDGE - THE ENERGY OF THE COMPTON EDGE
C
       INTEGER E,EDGE,EPP,E1,MESH,ECF,EC
C      E IS THE INTEGERIZED ENERGY
C      EDGE - THE INTEGERIZED EDGE
C      EPP - THE INTEGERIZED PHOTOPEAK ENERGY = PHOTON ENERGY
C      E1 - THE INTEGERIZED ENERGY OF THE ESCAPE PEAK
C      MESH - THE SIZE OF N OR THE FINENESS OF THE DIGITIZATION
C      ECF - INTEGERIZED ENERGY OF THE COMPTON FEATURE
C      EMIN - ENERGY BELOW WHICH COMPTON TAIL FRACTION REMAINS CONST
C             AT VALUE AT E=0.5
C
       REAL WIDTH,CPAREA,ECP
       INTEGER SIGM
C      WIDTH - THE INTRINSIC WIDTH (SIGMA) OF THE COMPTON EDGE FEATURE
C      CPAREA - THE AREA OF THE COMPTON EDGE FEATURE
C      ECP - THE REAL ENERGY OF THE COMPTON EDGE FEATURE
C      SIGM - THE INTEGERIZED SIGMA OF THE COMPTON EDGE FEATURE
C
       DATA EMIN/0.500/
C
       THRESH = PHA(0.0)
C
C
C      WE FIRST COMPUTE THE AMPLITUDE OF THE INCIDENT PHOTONS
C      AFTER ATTENUATION BY THE MATERIAL IN FRONT OF THE DETECTOR.
C
       CALL ATTEN(EP,AMPL,ATTAMP)
C
C      WE  COMPUTE THE ENERGY OF THE COMPTON EDGE
C      CONST IS THE # OF CHANNELS PER MEV...
C
       EDGE = NINT(CEDGE(EP)*CONST)
C
C      CALCULATE THE INDEX OF THE PHOTOPEAK ENERGY
C
       EPP = NINT(EP*CONST)
C
C      NEXT WE COMPUTE THE SCALING AND HEIGHT OF PHOTOPEAK
C
       AREA=EFAREA(EP)
       PHOTFR=P0(EP)
       PPA=PHOTFR*AREA
       PPH = PPA*ATTAMP
C
C      WE NEXT CONSTRUCT THE COMPTON TAIL
C      WE DO THIS BY CONSTRUCTING THE UNSCALED TAIL THEN NORMALIZING
C      WE CONSTRUCT THE TAIL ONLY UP TO THE PHOTOPEAK
C      WE DO NOT CONSIDER  THE COMPTON TAIL IF BELOW THRESH
C
C      INT IS THE COMPTON TAIL INTEGRAL FROM THRESHOLD TO THE
C        COMPTON EDGE.  THIS INTEGRAL IS UNNORMALIZED...
C      EEDGE IS THE COMPTON EGDE ENERGY...
C
       INT = 0
       EEDGE = CEDGE(EP)
C
       EC = EPP
       E0 = EP
C
C      IF PHOTON ENERGY IS ABOVE EMIN, PROCEED NORMALLY...
C
       IF (EP.GT.EMIN) GO TO 70
C
C      OTHERWISE SCALE COMPTON TAIL TO FRACTION AT EMIN.  FEED
C      PARMATERS TO SCALING LOOP AT E = EMIN...
C      THE TAIL IS CONSTRUCTED IN THE NORMAL WAY, BUT THE SCALE FACOR
C      WILL BE THE SAME AS THE SPECTRUM FOR E = EMIN.  THE PROBLEM ARISES
C      BECAUSE THE COMPTON EDGE FALLS BELOW THE DETECTOR THRESHOLD AND
C      THE INTEGRAL IS EVALUATED FROM THRESHOLD TO THE COMPTON EDGE...
C
C      EC = NINT(EMIN*CONST)
C      E0 = EMIN
C      EDGE = NINT(CEDGE(EMIN)*CONST)
C
70     CONTINUE
C
       DO 10 E=1,EC
         EN = FLOAT(E)/CONST
         TAIL(E) = CONT(EP,EN,EEDGE)
C        IF (EN.GT.THRESH.AND.E.LT.EDGE) INT = INT + TAIL(E)
        INT = INT + TAIL(E)
10       CONTINUE
C
       IF (INT.EQ.0.0) GO TO 40
C
C      SCALE COMPTON TAIL
       SCALE = FC(E0)*PPH/INT
C
90     CONTINUE
C
       DO 20 E=1,EPP
         N(E) = N(E) +  TAIL(E)*SCALE
20       CONTINUE
C
C      ADD CONTINUUM FEATURE NEAR EDGE
C      UNLESS IT FALLS BELOW THRESHOLD
C
       ECP=EDFEAT(EP)
      ECF = NINT(ECP*CONST)
C
       IF (ECP.LT.THRESH) GO TO 40
C
C      GET AREA OF COMPTON EDGE FEATURE
       CPAREA=FEDFET(EP)*PPH
C
C      GET MEASURED INTRINSIC WIDTH OF COMPTON EDGE FEATURE:
       WIDTH=CPSIGM(ECP)
C
       SIGM=NINT(CONST*WIDTH)
C
C      PRODUCE BROADENED COMPTON EDGE FEATURE
C
       DO 35 I=-2*SIGM,2*SIGM
         N(ECF+I)=N(ECF+I)+CPAREA*CPEAK(I,SIGM)
35     CONTINUE
C
C
40     CONTINUE
C
C      ADD PHOTOPEAK
C
       N(EPP) = N(EPP) + PPH
C
C
50     CONTINUE
C
C      ADD FIRST ESCAPE PEAK
C
       IF (EP.LE.1.022) GO TO 30
C
       E1 = NINT((EP-0.511)*CONST)
C
       N(E1) = N(E1) + F1(EP)*PPH
C
30     CONTINUE
C
       RETURN
C
       END
