DO 13000 J=1,NCAT
DO 13001 I=NC1,NN
IF (Z(J)*ABS(Z(I)).EQ.4) THEN
BPHI(J,I)=BET0(J,I)+BET1(J,I)*EXP(-ALPHA1)+
$
BET2(J,I)*EXP(-ALPHA2)
B(J,I)=BET0(J,I)+BET1(J,I)*G1+BET2(J,I)*G2
BPRIME(J,I)=BET1(J,I)*GPRI1/UM+BET2(J,I)*GPRI2/UM
ELSE
BPHI(J,I)=BET0(J,I)+BET1(J,I)*EXP(-ALPHA)
B(J,I)=BET0(J,I)+BET1(J,I)*G
BPRIME(J,I)=BET1(J,I)*GPRIME/UM
END IF
C(J,I)=C0(J,I)/2./SQRT(Z(J)*DABS(Z(I)))
13001
CONTINUE
13000 CONTINUE
DO 14000 J=1,NCAT-1
DO 14001 I=J+1,NCAT
CALL INTACT(Z(J),Z(I),UM,A0,PHIPHI(J,I),
$
PHIPRI(J,I),PHIIJ(J,I),TET(J,I))
14001
CONTINUE
14000 CONTINUE
DO 15000 J=NC1,NN-1
DO 15001 I=J+1,NN
CALL INTACT(Z(J),Z(I),UM,A0,PHIPHI(J,I),
$
PHIPRI(J,I),PHIIJ(J,I),TET(J,I))
15001
CONTINUE
15000 CONTINUE
C..
CALCULATION OF SUMMATION TERMS FOR F AND PHI.
SCATON=0.
SUBSUM=0.
SANON=0.
SUMCAF=0.
SUMANF=0.
DO 16000 J=1,NCAT-1
DO 16001 J1=J+1,NCAT
DO 16002 I=NC1,NN
SUBSUM=SUBSUM+PSI(J,J1,I)*XM(I)
16002
CONTINUE
SCATON=SCATON+(SUBSUM+PHIPHI(J,J1))*XM(J)*XM(J1)
SUMCAF=SUMCAF+PHIPRI(J,J1)*XM(J)*XM(J1)
SUBSUM=0.
16001
CONTINUE
23