29
IMPLICIT REAL*8(A-H,O-Z)
REAL*8 KI,KIJ,KD
COMMON/RM/RM/Y1/Y(19)/NC1/NC/NI1/NI(19)/EFI/EI(19),KI(19),
*GI(19),QI(19),FI(19)
*/INTER1/EIJ(19,19),UIJ(19,19),KIJ(19,19),GIJ(19,19)
*/EFD/ED(19),KD(19),GD(19),QD(19),FD(19)/Z/Z
RM=8.31448D0
IF(ICALC.NE.l) GO TO 3
CALL COMPO1
IF(Z.EQ.0D0) GO TO 133
CALL PARIN1
DO 75 I=1,NC
EI(I)=ED(NI(I))
KI(I)=KD(NI(I))
GI(I)=GD(NI(I))
QI(I)=QD(NI(I))
FI(I)=FD(NI(I))
DO 123 J=1,NC
IF(I.GE.J) GO TO 123
EIJ(I,J)=EIJ(NI(I),NI(J))
UIJ(I,J)=UIJ(NI(I),NI(J))
KIJ(I,J)=KIJ(NI(I),NI(J))
GIJ(I,J)=GIJ(NI(I),NI(J))
123 CONTINUE
75 CONTINUE
CALL PARMI1
3 CALL PHASE1
133 RETURN
END
SUBROUTINE COMPO1
IMPLICIT REAL*8(A-h,O-Z)
DIMENSION ZNI(25),YI(25)
COMMON/YI/Y(19)/YI/YC(25)/NC1/NC/NT1/NI(19)/NPR/NPR
DATA ZNI/.9981D0,.992D0,.9834D0,.9682D0,.971D0,.9997D0,.9947D0,
*.99D0,.993D0,.994D0,985D0,.945D0,.953D0,1D0,.919D0,
*.936D0,.876D0,.892D0,3*1D0,1.0005D0,1.0006D0,.9996D0,.9993D0/
DO 100 I=1,25
100 YI(I)=YC(I)
YI(13)=YI(13)+YI(14)
YI(14)=0D0
IF(NPR.EQ.0D0) GO TO 5
YI(17)=YI(17)+YI(19)+YI(20)+YI(21)
YI(19)=0D0
YI(20)=0D0
YI(21)=0D0
SUM=0D0
DO 7 I=1,25
7 SUM=SUM+YI(I)/ZNI(I)
DO 9 I=1,25
9 YI(I)=YI(I)/ZNI(I)/SUM
5 YI(2)=YI(2)+YI(9)+YI(10)
YI(9)=0D0