      SUBROUTINE HCOMPT
C
      IMPLICIT REAL*8(A-H,O-Z)
C
      COMMON/ADDMOM/HAWH(3),HAXWH(3),HELGM(3),HTIP(3)
C
      COMMON/CONSTS/PI,TWOPI,RAD
C
      COMMON/CSTVAL/TST,DUM9(40)
C
      COMMON/EXPAND/THRMPR(100),ITHRM(20)
C
      COMMON/HGIMBL/HGMB(3)
C
      COMMON/HOUTPT/IHCALC,IHREF,IHFLAG
C
      COMMON/HVCOMP/YB(3),YBD(3),CIN(3,3),CID,CIND(3)
C
      COMMON/HVCOUT/HBODY(3),HINERT(3),HMAG
C
      COMMON/IPOOL1/IDUM5,IDAMP,IDUM6(37)
C
      COMMON/MOMENT/IDUM1,IV,IDUM2(2),IW,IDUM3
C
      COMMON/OUTONE/OML,DUM5(9)
C
      COMMON/HWHEEL/HWM(3)
C
      COMMON/ISECBD/I2BDY
C
      COMMON/RPOOL1/DUM1(10),T,A(3,3),F(3,3),DUM2(10),OM(3),DUM3(81),
     1              PHID,PHI
C
      COMMON/RPOOL3/ZMS,YIZM(3,2)
C
      COMMON/RPOOL6/FDUM(3,3),CIY(3,3),CIZ(3,3),SAT(3,3),SZ1,SZ2,SZ3
C
      COMMON/RVISCS/VIV(3),DUM6(12),CIL
C
      COMMON/SBDOUT/B2DUM(34),H2B(3),Y2D(3)
C
      COMMON/XIN1/DUM7(3),ETTA,ZETTA,IDUM4
C
      DIMENSION HDUM(3),V1(3),V2(3),V3(3)
C
      OM1=OM(1)
      OM2=OM(2)
      OM3=OM(3)
      Y1=YB(1)
      Y2=YB(2)
      Y3=YB(3)
      HBODY(1)=(CIN(1,1)-(Y2*Y2+Y3*Y3)/ZMS)*OM1+(CIN(1,2)+Y1*Y2/ZMS)*OM2
     1        +(CIN(1,3)+Y1*Y3/ZMS)*OM3
      HBODY(2)=(CIN(2,1)+Y2*Y1/ZMS)*OM1+(CIN(2,2)-(Y3*Y3+Y1*Y1)/ZMS)*OM2
     1        +(CIN(2,3)+Y2*Y3/ZMS)*OM3
      HBODY(3)=(CIN(3,1)+Y3*Y1/ZMS)*OM1+(CIN(3,2)+Y3*Y2/ZMS)*OM2
     1        +(CIN(3,3)-(Y1*Y1+Y2*Y2)/ZMS)*OM3
C
      HBODY(1)=HBODY(1)+CIND(1)-(Y2*YBD(3)-Y3*YBD(2))/ZMS
      HBODY(2)=HBODY(2)+CIND(2)-(Y3*YBD(1)-Y1*YBD(3))/ZMS
      HBODY(3)=HBODY(3)+CIND(3)-(Y1*YBD(2)-Y2*YBD(1))/ZMS
C
      IF(IDAMP.EQ.0) GO TO 10
      CALL MATV(2,F,YB,V1)
      CALL MATV(2,F,YIZM(1,1),V2)
      HDUM(1)=PHID*(-CIZ(2,1)-(V2(2)-V1(2)/ZMS)*SZ1)
      HDUM(2)=PHID*(CIZ(3,3)+CIZ(1,1)+(V2(3)-V1(3)/ZMS)*SZ3+
     1(V2(1)-V1(1)/ZMS)*SZ1)
      HDUM(3)=PHID*(-CIZ(2,3)-(V2(2)-V1(2)/ZMS)*SZ3)
      CALL MATV(1,F,HDUM,V3)
      DO 5 I=1,3
      HBODY(I)=HBODY(I)+V3(I)
    5 CONTINUE
   10 CONTINUE
C
      IF(IV.EQ.0) GO TO 20
      WS1=OML*CIL
      DO 15 I=1,3
      HBODY(I)=HBODY(I)+VIV(I)*WS1
   15 CONTINUE
   20 CONTINUE
C
      IF(IW.EQ.0) GO TO 30
      DO 25 I=1,3
      HBODY(I)=HBODY(I)+HWM(I)
   25 CONTINUE
   30 CONTINUE
C
      IF(I2BDY.EQ.0) GO TO 32
C
      HBODY(1)=HBODY(1)+H2B(1)-(Y2*Y2D(3)-Y3*Y2D(2))/ZMS
      HBODY(2)=HBODY(2)+H2B(2)-(Y3*Y2D(1)-Y1*Y2D(3))/ZMS
      HBODY(3)=HBODY(3)+H2B(3)-(Y1*Y2D(2)-Y2*Y2D(1))/ZMS
C
   32 CONTINUE
C
      HBODY(1)=HBODY(1)+HGMB(1)+HAWH(1)+HAXWH(1)+HELGM(1)+HTIP(1)
      HBODY(2)=HBODY(2)+HGMB(2)+HAWH(2)+HAXWH(2)+HELGM(2)+HTIP(2)
      HBODY(3)=HBODY(3)+HGMB(3)+HAWH(3)+HAXWH(3)+HELGM(3)+HTIP(3)
C
      HMAG=0.0D0
      DO 35 I=1,3
      HINERT(I)=A(I,1)*HBODY(1)+A(I,2)*HBODY(2)+A(I,3)*HBODY(3)
      HMAG=HMAG+HINERT(I)*HINERT(I)
   35 CONTINUE
      HMAG=DSQRT(HMAG)
      IF(T.NE.TST) GO TO 50
      IF(IHREF.EQ.0) GO TO 50
      WS1=HINERT(1)/HMAG
      WS2=HINERT(2)/HMAG
      ZETTA=0.0D0
      IF(WS1.EQ.0.0D0.AND.WS2.EQ.0.0D0) GO TO 40
      ZETTA=DATAN2(WS2,WS1)/RAD
   40 CONTINUE
      WS1=HINERT(3)/HMAG
      ETTA=DARCOS(WS1)/RAD
   50 CONTINUE
      IF(IHCALC.EQ.0) IHFLAG=0
      IF(ITHRM(10).EQ.0) RETURN
      WRITE(9,9000) CIN
      WRITE(9,9000) CIND,YB,YBD
      WRITE(9,9000) OM,HBODY,HINERT
 9000 FORMAT(' HCOMPT',5X,1P9E13.5)
      RETURN
      END
