C RICOQ     SOURCE    CHAT      05/01/13    02:56:17     5004
      SUBROUTINE RICOQ(RE,XA,HM,E,RIGL,REP,REM,P,XE,YE,ZE,XX,YY,RAI)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION            E(3,3),RIGL(18,18),REP(9,9),REM(6,6),
     1P(3,3),XE(3),YE(3),ZE(3),XX(3,3),YY(3,3)
      DIMENSION RE(18,18),XA(3,3)
      DATA EPSI/1.E-9/
*
      DO9I=1,18
      DO9J=1,18
      RE(I,J)=0.D0
    9 RIGL(I,J)=0.D0
      DO 1 I=1,3
      XE(I)=XA(1,I)
      YE(I)=XA(2,I)
    1 ZE(I)=XA(3,I)
      CALL       PASSA(XE,YE,ZE,    P,X13,X23,Y13,Y23)
      S=0.5*Y13*(X13-X23)
*     SPECIAL    RIGI      PSI Z
      RKZ= RAI*HM*S*EPSI
      CALL RICOQ0(RIGL,X13,X23,Y13,Y23,RKZ)
*
      CALL RIMT6(REM,E,RAI,X13,X23,Y13,HM,S)
      DO100I=1,6
      DO100J=I,6
  100 REM(J,I)=REM(I,J)
      CALL RIPP9(REP,E,RAI,X13,X23,Y13,HM,S)
      DO101I=1,9
      DO101J=I,9
  101 REP(J,I)=REP(I,J)
      DO2K=1,3
      K1=K-1
      DO2L=K,3
      L1=L-1
      DO 3 I=1,2
      M=6*K1+I
      ML=2*K1+I
      DO 3 J=1,2
      N=6*L1+J
      NL=2*L1+J
    3 RIGL(M,N)=RIGL(M,N)+REM(ML,NL)
      DO 4 I=1,3
      M=6*K1+2+I
      ML=3*K1+I
      DO 4 J=1,3
      N=6*L1+J+2
      NL=3*L1+J
    4 RIGL(M,N)=RIGL(M,N)+REP(ML,NL)
    2 CONTINUE
      DO 6 K=1,6
      K1=3*(K-1)
      DO6L=K,6
      L1=3*(L-1)
      DO 7 I=1,3
      IM=I+K1
      DO 7 J=1,3
      JM=J+L1
    7 XX(I,J)=RIGL(IM,JM)
      CALL PRODT(YY,XX,P,3,3)
      DO 8 I=1,3
      IM=I+K1
      DO 8 J=1,3
      JM=J+L1
    8 RE(IM,JM)=YY(I,J)
    6 CONTINUE
      DO 10 I=1,18
      DO 10 J=1,I
   10 RE(I,J)=RE(J,I)
*     DO 555 I=1,18
*     WRITE(6,77882) I
*77882 FORMAT('0  LIGNE ',I4//)
*     WRITE(6,77881) ( RE(I,J),J=1,18)
*77881 FORMAT(1X,6(1X,1PE12.5)/)
*555   CONTINUE
      RETURN
      END