SUBROUTINE  POLY_CARBO (E,AMUT,STATUS)
C
C------------------------------------------------------------------------
C
C.IDENTIFICATION:
C	Subroutine  poly_carbo
C
C.SOURCE FILE:
C	poly_carbo.f
C
C.LIBRARY:
C       libmecs.a
C
C.AUTHOR:
C       B.Sacco    IFCAI/CNR,  Palermo
C
C.VERSIONS:
C	Vers. 1.0     6-7-95		creation date
C	Vers. 1.1    25-7-95            revised by T.Mineo
C
C.PURPOSE:
C       computes the poly-carbonate absorption coefficient. The 
C       results is obtained computing the contribution from each 
C       element contained in the material (14H-32C-6O).  
C
C.SYNTAX:
C	CALL POLY_CARBO (E,AMUT,STATUS)
C
C.PARAMETERS:
C       inp.  E      Real*4    Energy (keV)
C       out.  AMUT   Real*4    Absorption coefficient (1/mm)
C       out.  STATUS Integer*4 STATUS=0 ==> no errors 
C
C.REFERENCES:
C        F.Biggs, R.Lighthill "Analitical approximations for X-ray
C        cross sections III" SANDIA REPORT SAND87-0070 UC-34
C
C------------------------------------------------------------------------
C
C...variables definition
C
        REAL*4     E1_H(5),E1_C(5),E1_O(4),
     *             E2_H(5),E2_C(5),E2_O(4), 
     *             C_H(4,5),C_C(4,5),C_O(4,4),
     *             F(3),AMU(3)
C
        INTEGER*4  LINES(3),STATUS
C
C...variables initialization:
C...RO=polycarbonate density (g/cm**3)
C...E1_H{C O} E2_H{C O}=energy boundary (keV)
C...C_H{C O}=Coefficient for the calculation of the cross section (1/cm)
C...F=Z*n atoms in the molecule 
C...LINES= number of non zero lines
C
	DATA RO /1.2/
	DATA F /14.,192.,48/
	DATA E1_H /0.01,0.014,0.1,0.8,4.0/
	DATA E2_H /0.014,0.1,0.8,4.0,20.0/
	DATA C_H / 1.000E-8,  0.,       0.,        0.,       
     *            -6.383E+1, -6.446E+0, 1.317E+1, -5.045E-2,
     *             3.051E+0, -7.818E+0, 1.144E+1,  6.959E-2,
     *             7.636E-2, -9.406E-1, 6.144E+0,  1.425E+0,
     *             1.180E-3, -8.236E-2, 2.886E+0,  5.534E+0 / 
	DATA E1_C /0.01,0.0457,0.284,0.8,4.0/
	DATA E2_C /0.0457,0.284,0.8,4.0,20.0/
	DATA C_C / 6.704E+3,  0.,        0.,        0.,       
     *            -3.935E+2,  3.219E+2, -6.549E+0,  2.086E-1,
     *            -9.022E+2,  1.760E+3,  1.549E+3, -2.280E+2,
     *            -7.363E+0, -1.537E+1,  2.672E+3, -4.482E+2,
     *             1.640E+0, -9.428E+1,  2.872E+3, -5.583E+2/
	DATA E1_O /0.01,0.0483,0.532,4.0/
	DATA E2_O /0.0483,0.532,4.0,20.0/
	DATA C_O  / 1.144E+4,  0.,        0.,        0.,     
     *             -2.863E+2,  4.085E+2,  4.436E+1, -1.782E+0,
     *             -7.181E+1,  4.748E+2,  5.542E+3, -1.363E+3,
     *              2.745E+0, -1.747E+2,  7.159E+3, -2.213E+3/

        DATA LINES /5,5,4/
C
C...checks if the energy is out of range
C
        IF(E.LT.0.01.OR.E.GE.20.) THEN
          WRITE(*,*) ' POLY_CARBO: energy out of range for computing'
          WRITE(*,*) '     the poly-carbonate transmission efficiency'
          STATUS=1
	  RETURN
        ENDIF
C
C...computes the absorption coefficient for each element
C...H
C
	J=1
	DO 20 I=1,LINES(J)
          IF (E.GE.E1_H(I).AND.E.LT.E2_H(I)) THEN
            KK=I
	    GO TO 30
	  END IF
 20	CONTINUE
 30	CONTINUE
        AMU(J)=0
        DO 40 I=1,4
          AMU(J)=AMU(J)+C_H(I,KK)/E**I
 40      CONTINUE
C
C...C
C
	J=2
	DO 50 I=1,LINES(J)
          IF (E.GE.E1_C(I).AND.E.LT.E2_C(I)) THEN
            KK=I
	    GO TO 60
	  END IF
 50	CONTINUE
 60	CONTINUE
        AMU(J)=0
        DO 70 I=1,4
          AMU(J)=AMU(J)+C_C(I,KK)/E**I
 70     CONTINUE
C
C...O
C
	J=3
	DO 80 I=1,LINES(J)
          IF (E.GE.E1_O(I).AND.E.LT.E2_O(I)) THEN
            KK=I
	    GO TO 90
	  END IF
 80	CONTINUE
 90	CONTINUE
        AMU(J)=0
        DO 100 I=1,4
          AMU(J)=AMU(J)+C_O(I,KK)/E**I
 100    CONTINUE
C
C...computes the total absorption coefficient
C
        FT=0.
        AMUT=0
	DO 110 J=1,3
          AMU(J)=AMU(J)*F(J)
          AMUT  =AMUT+AMU(J)
          FT    =F(J)+FT
110	CONTINUE
C
        AMUT=AMUT*RO/FT/10   
C
        RETURN
        END