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