	SUBROUTINE  POLY (E,AMUT,STATUS)
C
C------------------------------------------------------------------------
C
C.IDENTIFICATION:
C	Subroutine  poly
C
C.SOURCE FILE:
C	poly.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 polyimide absorption coefficient. The results 
C       is obtained computing the contribution from each element
C       contained in the filter (H-C-N-O).  
C
C.SYNTAX:
C	CALL POLY (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),E2_H(5), E1_C(5),E2_C(5),
     *             E1_N(5),E2_N(5), E1_O(4),E2_O(4), 
     *             C_H(4,5),C_C(4,5),C_N(4,5),C_O(4,4)
	REAL*4     AMU(4),F(4)
	REAL*4     E,AMUT
C
        INTEGER*4  LINES(4),STATUS
C
C...variables initialization:
C...RO=polyammide density (g/cm**3)
C...E1_H{C N O} E2_H{C N O}=energy boundary (keV)
C...C_H{C N 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.4/
        DATA F /10.,264.,28.,64./
C
        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 /
C
        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/
C
	DATA E1_N /0.01,0.0404,0.4016,0.8,4.0/
	DATA E2_N /0.0404,0.4016,0.8,4.0,20.0/
	DATA C_N  / 1.010E+4,  0.,        0.,        0.,      
     *	           -3.622E+2,  3.873E+2,  1.244E+1, -4.462E-1,
     *             -2.338E+3,  5.732E+3, -2.082E+2,  1.482E+2,
     *             -4.940E+0, -8.442E+1,  4.620E+3, -1.186E+3,
     *              2.019E+0, -1.249E+2,  4.609E+3, -9.421E+2/  
 
C
        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/
C
        DATA LINES /5,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: energy out of range for computing'
	  WRITE(*,*) '       the polyimide transmission efficiency'
          STATUS=1
	  RETURN
        ENDIF
C
C...computes the absorption coefficient for each element
C...H
C
	J=1
	DO 10 I=1,LINES(J)
          IF (E.GE.E1_H(I).AND.E.LT.E2_H(I)) THEN
            KK=I
	    GO TO 20
	  END IF
 10	CONTINUE
 20	CONTINUE
        AMU(J)=0
        DO 30 I=1,4
          AMU(J)=AMU(J)+C_H(I,KK)/E**I
 30     CONTINUE
C
C...C
C
	J=2
	DO 40 I=1,LINES(J)
          IF (E.GE.E1_C(I).AND.E.LT.E2_C(I)) THEN
            KK=I
	    GO TO 50
	  END IF
 40	CONTINUE
 50	CONTINUE
        AMU(J)=0
        DO 60 I=1,4
          AMU(J)=AMU(J)+C_C(I,KK)/E**I
 60      CONTINUE
C
C...N
C
	J=3
	DO 70 I=1,LINES(J)
          IF (E.GE.E1_N(I).AND.E.LT.E2_N(I)) THEN
            KK=I
	    GO TO 80
	  END IF
 70	CONTINUE
 80	CONTINUE
        AMU(J)=0
        DO  90 I=1,4
          AMU(J)=AMU(J)+C_N(I,KK)/E**I
 90      CONTINUE
C
C...O
C
	J=4
	DO 100 I=1,LINES(J)
          IF (E.GE.E1_O(I).AND.E.LT.E2_O(I)) THEN
            KK=I
	    GO TO 110
	  END IF
 100	CONTINUE
 110	CONTINUE
        AMU(J)=0
        DO 120 I=1,4
          AMU(J)=AMU(J)+C_O(I,KK)/E**I
 120    CONTINUE
C
        FT=0.
        AMUT=0
 	DO 130 J=1,4
          AMU(J)=AMU(J)*F(J)
          AMUT  =AMUT+AMU(J)
          FT    =F(J)+FT
 130	CONTINUE
C
        AMUT=AMUT*RO/FT/10   
C
        RETURN
        END
