	SUBROUTINE RHOLSJ(K,MQ,F)
	IMPLICIT REAL*8(A-H,O-Z)

C  CALCULATES STATISTICAL TENSORS FOR VARIOUS L,S,J TRANSFERS
c Nov-2000 M.Yosoi   Rev. for IBM-xlf

	INCLUDE 'ANGCOR.INC'
	COMPLEX*16 F1,F2,F(2*MAX_LG,2*MAX_LG)

	XK=K
	XMQ=MQ
	IND1=0
	DO 1 I=1,NLTR
	XI=FLOAT(JTR(I))/2.
	IND2=0
	JTR1=JTR(I)+1
	IMI=-JTR(I)
	DO 2 J=1,NLTR
	XJ=FLOAT(JTR(J))/2.
	F(I,J)=(0.,0.)
	DO 3 MI=1,JTR1
	MIMI=(IMI+JTR(I))/2+1
	XMI=FLOAT(IMI)/2.
	IMSB=-ISB
	DO 4 MSB=1,JS
	IMSA=-ISA
	DO 5 MSA=1,JR
	F1=SUM(MSB,MSA,MIMI+IND1)
	MJ=IMI-2*MQ
	MJMJ=(MJ+JTR(J))/2+1
	F2=DCMPLX(DREAL(SUM(MSB,MSA,MJMJ+IND2)),
     1  -DIMAG(SUM(MSB,MSA,MJMJ+IND2)))
	F(I,J)=F(I,J)+PAR((JTR(J)-IMI+2*MQ)/2)*F1*F2*CG(XI,XMI,XJ,
     1  XMQ-XMI,XK,XMQ)
	IMSA=IMSA+2
5	CONTINUE
	IMSB=IMSB+2
4	CONTINUE
	IMI=IMI+2
3	CONTINUE
	IND2=IND2+JTR(J)+1

	IF(ICO(2).EQ.1) WRITE(LUNOUT,100)I,J,F(I,J)

2	CONTINUE
	IND1=IND1+JTR(I)+1
1	CONTINUE
	RETURN
100	FORMAT(2I4,2F15.6)
	END
