	SUBROUTINE RHOKQ(KL)
	IMPLICIT REAL*8(A-H,O-Z)

C  CALCULATES STATISTICAL TENSORS
c Nov-2000 M.Yosoi   Rev. for IBM-xlf

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

	IF(ICO(2).EQ.1)WRITE(LUNOUT,100)
	KK=-1
	XK=-1.
	DO 1 K=1,KL
	KK=KK+1
	XK=XK+1.
	IQ=2*K-1
	DO 1 KQ=1,IQ
	MQ=KQ-K
	KMQ=KK*KK+KK+MQ+1
	XQ=MQ
	RHO(KMQ)=(0.,0.)
	IF(ICO(3).EQ.0) THEN
	  MB=-JB(1)
	  DO 2 M=1,LF2(1)
	  XMB=FLOAT(MB)/2.
	  MB1=-JB(1)
	  DO 3 MM=1,LF2(1)
	  XMB1=FLOAT(MB1)/2.
	  IF(MB-MB1.EQ.2*MQ)
     1  RHO(KMQ)=RHO(KMQ)+FPP(M,MM)*CG(XJB(1),XMB,XJB(1),-XMB1,XK,XQ)
     2  *PAR((JB(1)-MB1)/2)
	  MB1=MB1+2
3	  CONTINUE
	  MB=MB+2
2	  CONTINUE
	ELSEIF(ICO(3).EQ.1) THEN
	  CALL RHOLSJ(KK,MQ,F)
	  DO 4 J=1,NLTR
	  XJ=FLOAT(JTR(J))/2.
	  DO 5 J1=1,NLTR
	  XJ1=FLOAT(JTR(J1))/2.
	  RHO(KMQ)=RHO(KMQ)+SQRT((2.*XJ+1.)*(2.*XJ1+1.))*
     1  W(XJ,XJ1,XJB(1),XJB(1),XK,XJA)*PAR((JB(1)-JA+JTR(J)-2*KK)/2)*
     1  F(J,J1)
5	  CONTINUE
4	  CONTINUE
	  XJBB=JB(1)+1
	  RHO(KMQ)=RHO(KMQ)*XJBB
	ENDIF

	IF(ICO(2).EQ.1)WRITE(LUNOUT,101)KK,MQ,RHO(KMQ)

1	CONTINUE
	RETURN
100	FORMAT(1H0,'  K   Q    REAL RHOKQ     IMAG RHOKQ')
101	FORMAT(2I4,2E15.6)
	END
