      IMPLICIT INTEGER (A-Z)
       PARAMETER MO=9999,MR=9999,MF=9999
       INTEGER OPR6(0:MO),OPR9(0:MR),OPR8(0:MR),TREE(0:MO)
       INTEGER OPR1(0:MR),OPR2(0:MO),OPR3(0:MF),OPR4(0:MF),OPR5(0:MR),OPR7(0:MF)
       INTEGER*8 OPRA(0:MR),OPRB(0:MR),OPRT(0:MO)
       VOLATILE OPR6

       PA1=-1
       PA2=-1
       KID=0

           DO OBJ=1,5
               IF(PA1.EQ.MR) GOTO 101
               PA1=PA1+1
               OPR1(PA1)=OBJ
               OPR2(OBJ)=MAX(OBJ-1,0)
               OPR8(PA1)=PA2+1
               OPRA(OBJ)=PA1
               DO I=1,5
                   IF(PA2.EQ.MF) GOTO 101
                   PA2=PA2+1
                   OPR3(PA2)=OBJ+100
                   OPR4(PA2)=OBJ
                   OPR7(PA2)=PA1
               END DO
               KID=MAX(KID,PA2-OPR8(PA1)+1)
           END DO
           WHO=OBJ


           K=0
           DO I=0,PA1
               H=0
               OBJ=OPR1(I)
               DO WHILE (OPR2(OBJ).NE.0)
                   OBJ=OPR2(OBJ)
                   H=H+1
               END DO
               OPR5(I)=H
               K=MAX(K,H)
           END DO
           IF(K.GT.MR) GOTO 102
           DO I=1,K
               CALL HEAPXA_INIT(WHO,TREE)
               DO J=0,PA1
                   IF(OPR5(J).EQ.I) CALL HEAPXA_PUT2(OPR1(J),TREE)
               END DO
               H=0
               DO WHILE (HEAPXA_GET2(OBJ,TREE).EQ.0)
                   H=H+1
                   OPR6(OBJ)=H
               END DO
               OPR9(I)=H+1
           END DO
           IF(K.EQ.MR) GOTO 102
           OPRB(K)=KID
           DO I=K-1,1,-1
               IF(BITSX(OPRB(I+1))+BITSX(OPR9(I+1)).GT.63) GOTO 103
               OPRB(I)=OPRB(I+1)*OPR9(I+1)
           END DO
           OBJ1=0
           DO I=0,PA2
               OBJ=OPR4(I)
               P=OPR7(I)
               J=I-OPR8(P)
               IF(OBJ.EQ.OBJ1) THEN
                   LONG=LONG/KID*KID+J
               ELSE
                   OBJ1=OBJ
                   LONG=J
                   DO WHILE (OPR2(OBJ).NE.0)
                       LONG=LONG+OPR6(OBJ)*OPRB(OPR5(OPRA(OBJ)))
                       OBJ=OPR2(OBJ)
                   END DO
               ENDIF
               OBJ=OPR3(I)
               OPRT(OBJ)=LONG
               WRITE(6,*) OBJ,LONG
           END DO

100    CALL EXIT
101    WRITE(6,*) '%PDTXT - increase MF'
       CALL EXIT
102    WRITE(6,*) '%PDTXT - increase MR'
       CALL EXIT
103    WRITE(6,*) '%PDTXT - tree failure'
       CALL EXIT

       END

 SUBROUTINE HEAPXA
 IMPLICIT INTEGER (A-Z)
 INTEGER TREE(0:1)
       DATA EOH/'80000000'X/

 ENTRY HEAPXA_INIT(SIZ,TREE)
 SIZE=SIZ
 LAST=0
 TREE(1)=EOS
 RETURN

 ENTRY HEAPXA_PUT2(WHO,TREE)

 LAST=LAST+1
 IF(LAST.GT.SIZE) GOTO 10
       IF(WHO.EQ.EOH) GOTO 11
 TREE(LAST)=WHO
 I=LAST
1 J=ISHFT(I,-1)
 IF(J.EQ.0) RETURN
 K=TREE(J)
 IF(K.LE.WHO) RETURN
 TREE(J)=WHO
 TREE(I)=K
 I=J
 GOTO 1

 ENTRY HEAPXA_GET2(WHO,TREE,*)
 WHO=TREE(1)
 IF(WHO.EQ.EOH) RETURN 1
 I=1
2 J=ISHFT(I,1)
 IF(J-LAST) 5,3,4
3 K=TREE(J)
 IF(K.EQ.EOH) THEN
4  TREE(I)=EOH
  RETURN
 ENDIF
 TREE(I)=K
 TREE(J)=EOH
 RETURN
5 K=TREE(J)
 N=J+1
 L=TREE(N)
 IF(K.EQ.EOH) THEN
  IF(L.EQ.EOH) GOTO 4
  TREE(I)=L
  I=N
  GOTO 2
 ELSE IF(L.EQ.EOH) THEN
  TREE(I)=K
  I=J
  GOTO 2
 ENDIF
 IF(K-L) 6,7,8

6  TREE(I)=K
  I=J
  GOTO 2

7  IF(K.LT.L) THEN
   TREE(I)=K
   I=J
  ELSE
   TREE(I)=L
   I=N
  ENDIF
  GOTO 2

8  TREE(I)=L
  I=N
  GOTO 2

10     WRITE(6,*) '%HEAPXA - memory exceeded'
       CALL EXIT
11     WRITE(6,*) '%HEAPXA - use HEAPXA when some values equal 80000000x'
       CALL EXIT

 END

 INTEGER FUNCTION BITSX(VALUE1)
 IMPLICIT INTEGER (A-Z)
       INTEGER*8 POW(0:64),VALUE,VALUE1
       DATA POW/ &
     & 1,&
     & 2,&
     & 4,&
     & 8,&
     & 16,&
     & 32,&
     & 64,&
     & 128,&
     & 256,&
     & 512,&
     & 1024,&
     & 2048,&
     & 4096,&
     & 8192,&
     & 16384,&
     & 32768,&
     & 65536,&
     & 131072,&
     & 262144,&
     & 524288,&
     & 1048576,&
     & 2097152,&
     & 4194304,&
     & 8388608,&
     & 16777216,&
     & 33554432,&
     & 67108864,&
     & 134217728,&
     & 268435456,&
     & 536870912,&
     & 1073741824,&
     & 2147483648,&
     & 4294967296,&
     & 8589934592,&
     & 17179869184,&
     & 34359738368,&
     & 68719476736,&
     & 137438953472,&
     & 274877906944,&
     & 549755813888,&
     & 1099511627776,&
     & 2199023255552,&
     & 4398046511104,&
     & 8796093022208,&
     & 17592186044416,&
     & 35184372088832,&
     & 70368744177664,&
     & 140737488355328,&
     & 281474976710656,&
     & 562949953421312,&
     & 1125899906842624,&
     & 2251799813685248,&
     & 4503599627370496,&
     & 9007199254740992,&
     & 18014398509481984,&
     & 36028797018963968,&
     & 72057594037927936,&
     & 144115188075855872,&
     & 288230376151711744,&
     & 576460752303423488,&
     & 1152921504606846976,&
     & 2305843009213693952,&
     & 4611686018427387904, &
     & 9223372036854775807/
       IF(VALUE1.EQ.0) THEN
           BITSX=0
           RETURN
       ELSE IF(VALUE1.GT.0) THEN
           VALUE=VALUE1
       ELSE
           VALUE=-VALUE1
       ENDIF
       J1=0
       J2=64
       I=32
1      IF(VALUE.LE.POW(I)) THEN
           J2=I
       ELSE
           J1=I+1
       ENDIF
       IF(J1.NE.J2) THEN
           I=(J1+J2)/2
           GOTO 1
       ENDIF
       IF(VALUE.LT.POW(J1)) THEN
           BITSX=J1
       ELSE
           BITSX=J1+1
       ENDIF
 END