SUBROUTINE FUNC10 (KR, KCM)
C ************************* COMMON COMMON ************************** 0020
COMMON MAP(2000),PARS(1000),MISC(27),KLIST(500),MTABLE(2)
COMMON /LIMIT/LIMMNO,LIMLNO,LIMKNO,LIMEX
DIMENSION ZMAP(2000)
DIMENSION REMARK(500)
DIMENSION OTABLE(7,50), JTABLE(7,50), RTABLE(9,20,2),
1 LTABLE(9,20,2), ITABLE(6,20), VAL(100), IVAL(100),
2 WGT(100)
DIMENSION HLIST(500)
DIMENSION PARA(1000),NPARA(1000),SNAME(1000),NAME(1000)
DIMENSION HEAD(11), NBRNCH(10)
DIMENSION HTABLE(7,100)
DIMENSION TABLE(100)
EQUIVALENCE (MAP,ZMAP)
EQUIVALENCE (REMARK,MAP(1001))
EQUIVALENCE (OTABLE,JTABLE,MAP(701)), (RTABLE,LTABLE,MAP(1051)),
1 (ITABLE,MAP(1411)), (VAL,IVAL,MAP(1531)),
2 (WGT,MAP(1631))
EQUIVALENCE (NCFLAG,MAP(1869)), (WEIGHT,MAP(1978)),
1 (NTAPE,MAP(1988)), (EINC,MAP(1998)),
2 (PINC,MAP(1999)), (BINC,MAP(2000))
EQUIVALENCE (PARA,NPARA,PARS),(SNAME,NAME,MAP(1))
EQUIVALENCE (PI, MISC), (RADIAN, MISC(2)), (NIT, MISC(3)),
1 (NOT, MISC(4)), (HEAD, MISC(5)), (NBRNCH, MISC(16)),
2 (NPAGE, MISC(26)), (NORD, MISC(27))
EQUIVALENCE (LTAPE,NBRNCH(9)), (LINK,NBRNCH(10)), (HTABLE,MAP)
EQUIVALENCE (HLIST,KLIST)
EQUIVALENCE (TABLE,PARS(101))
C *************** END COMMON COMMON *************************
DIMENSION LIST(10), HNAME(3)
DATA HNAME /' RESONANCES '/
C 0170
IF (KCM) 5, 10, 10 0180
5 DO 6 I=1,3
6 VAL(I) = HNAME(I)
RETURN 0230
C 0240
10 NT = KLIST(KR) 0250
NRP = HLIST(KR + 1) 0260
NR = 0 0270
DO 15 N = 1,6 0280
LIST(N) = MOD(NRP,10) 0290
NR = NR + 1 0300
NRP = NRP / 10 0310
IF (NRP) 20, 20, 15 0320
15 CONTINUE 0330
20 KEND = KR + 3 0340
Y = 0.0 0350
Z = 0.0 0360
C 0370
DO 50 N = 1,NR 0380
CVSQ = TABLE(NT)**2 0390
CVGAM = TABLE(NT) * TABLE(NT + 1) 0400
AMP = TABLE(NT + 2) 0410
PHASE = TABLE(NT + 3)/RADIAN 0420
COSP = COS(PHASE) 0430
SINP = SIN(PHASE) 0440
NT = NT + 4 0450
NN = NR - N + 1 0460
KBEG = KEND + 1 0470
KEND = KEND + LIST(NN) 0480
EFMSQ = SQMASS (KBEG,KEND) 0490
X = (EFMSQ - CVSQ) / CVGAM 0500
B = 1.0 / (1.0 + X*X) 0510
A = -X*B 0520
Y = Y + AMP*(A*COSP - B*SINP) 0530
Z = Z + AMP*(B*COSP + A*SINP) 0540
50 CONTINUE 0550
C 0560
WEIGHT = Y*Y + Z*Z 0570
RETURN 0580
END 0590