Solved:

jajdavid · ‎11-04-2016

SPR

11/04/2016

O/S:

Windows 7 Professional

ifort switches:

/compile_only
/static
/noautomatic
/list
/warn:nogeneral
/traceback
/map
/align:rec4byte
/optimize:4
/assume:byterecl
/extend_source
/fltconsistency
/vms

ifort version:

Intel(R) Visual Fortran Compiler Professional for applications running on IA-32, Version 11.1
Build 20090930 Package ID: w_cprof_p_11.1.048
Copyright (C) 1985-2009 Intel Corporation. All rights reserved.

Issue: Array OPR6 is not being computed unless VOLATILE statement is
implemented.

Directions: compile and link with VOLATILE statement commented out and
            not commented out. Observe the output is different. OPR6 is
            an array that is entirely contained within main() and should
            not fail under optimization.

       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

mecej4 · ‎11-05-2016

Your program seems to depend on some non-standard extensions, and I don't know what it is supposed to do. It uses the old VMS style PARAMETER statement, but also the attribute VOLATILE, which did not exist in Fortran 95.

One thing stands out: the undefined variable EOS is used in HEAPXA. What do you expect its value to be? Zero?

The program in #3 gives the same results with and without the VOLATILE statement with IFort 11.1.070. Same with 2017 Update 1.

View solution in original post

Steven_L_Intel1 · ‎11-04-2016

You're using a compiler that is seven years old. Can you reproduce the problem with the current version 17.0.1?

Some issues I see with the code. In BITSX, you declare POW to be (0:64), which is 65 elements, but you supply only 64 values. On lines 123 and 136 you have branches to label 4 which are inside an IF-THEN block. This is not legal in Fortran and can result in incorrect execution.

When I run the program I get:

%HEAPXA - memory exceeded

I don't understand the logic flow that leads to this.

Lastly, I'll comment that we don't have an optimization level higher than 3. For compatibility with DEC/Compaq compilers that had up to a level 5, we accept 4 and 5 but map them to 3.

If you can tell me how to correct the "memory exceeded" problem I'll try again, but the illegal branches into blocks could be problematic with optimization.

I've attached a version that is free-form formatted - the inline insertion button doesn't do well with tab formatting.

jajdavid · ‎11-04-2016

Hi Steve,

I fixed the branches into IF blocks. It has been my experience that branches into IF blocks don't cause any harm if done properly. In any case, I changed the code so that doesn't happen in this example. Yes, 0:63 is better. Thanks for your insightful comment here. There was an issue when the value was 2**63-1 (because I can't store 2**63 in a 64-bit signed integer, so I stored 2**63-1 in the 63rd position) - it gave the wrong answer - however that was unrelated to the bug at hand here.

You should never get a HEAPAX memory exceeded error (I don't get that). Basically, the maximum number of calls to HEAPAX_PUT2 should not exceed the first argument to HEAPAX_INIT - which is WHO - which equals 6. So I don't understand why you would be getting this error. Maybe you dropped the statement that defined WHO = OBJ?? Try setting WHO = 6 directly.

As an aside, FORTRAN is 10X (yes 10 times!) faster than the most expensive and best code being sold today to do the job that this program does...And it is 50X ( 50 times!) faster than the cheapest code commercially available.

Here is the code with all tabs replaced with 8 spaces.

       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) GOTO 4
        TREE(I)=K
        TREE(J)=EOH
        RETURN
4      TREE(I)=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:63),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=63
       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 IF(J1.EQ.63) THEN
           BITSX=J1
       ELSE
           BITSX=J1+1
       ENDIF
        END

mecej4 · ‎11-05-2016

Your program seems to depend on some non-standard extensions, and I don't know what it is supposed to do. It uses the old VMS style PARAMETER statement, but also the attribute VOLATILE, which did not exist in Fortran 95.

One thing stands out: the undefined variable EOS is used in HEAPXA. What do you expect its value to be? Zero?

The program in #3 gives the same results with and without the VOLATILE statement with IFort 11.1.070. Same with 2017 Update 1.

jimdempseyatthecove · ‎11-05-2016

Be careful of line 28 (WHO=OBJ).

Depending on version of compiler (early F66/F77), the termination value of the loop may be the last one used in the loop or one step increment after (assuming no loop bail-out). As written now, the value used is 6.

Jim Dempsey

TimP · ‎11-05-2016

As you have a mixture of features from F66 and later standards, which you like to use in incompatible combinations, Jim's caution may be well taken. F77 did specify the "next" value of loop counter as the one set after loop termination, but that was one of the last features of F77 to be widely implemented, around 1983 in some compilers. F66 had no rule. One of the F66 compilers I used (Honeywell) had 3 different treatments in the same compiler, depending on the optimization level, and an F77 compiler (HP/KAP) required a specific directive to get the standard treatment.

Steven_L_Intel1 · ‎11-05-2016

I wonder if that EOS was supposed to be EOH.

jajdavid · ‎11-05-2016

Yes EOS was supposed to be EOH - unfortunately that made no difference in the outcome...

jajdavid · ‎11-05-2016

I am using 11.1.048 and you are telling me that version 11.1.070 has since fixed this bug.

This is good news and justification enough to upgrade to the latest version.

Thanks for all your effort and great suggestions, everyone !

John

jajdavid · ‎11-05-2016

Just to make sure, is this what 11.1.070 and 2017 update 1 produced as output:?

       101           0
       101           1
       101           2
       101           3
       101           4
       102          40
       102          41
       102          42
       102          43
       102          44
       103          60
       103          61
       103          62
       103          63
       103          64
       104          70
       104          71
       104          72
       104          73
       104          74
       105          75
       105          76
       105          77
       105          78
       105          79

mecej4 · ‎11-06-2016

Yes, that is the output I see, but I am afraid that your program is firmly lodged in my basket of deplorables. The following are some of the reasons, in addition to those that I mentioned earlier.

HEPXA_GET2 is a subroutine secondary ENTRY with one alternate return argument. It is invoked as an integer function.
Function BITSX is invoked with an INTEGER*4 argument whereas an INTEGER*8 is expected.

andrew_4619 · ‎11-06-2016

IMPLICIT NONE is the king of all Fortran commands. It eliminates so many coding errors!

mecej4 · ‎11-06-2016

Here is a cleaned up version of OP's program that does not depend on extensions to the language or require a perfect alignment of the planets to give correct results. It will probably work even with the 11.1.048 version of IFort.

    MODULE heapxa
       IMPLICIT NONE
       INTEGER, PARAMETER :: eoh = huge(0)
	   INTEGER, PARAMETER :: i8 = SELECTED_INT_KIND(15)
       INTEGER, SAVE :: last, tsize
    CONTAINS
       SUBROUTINE heapxa_init(siz, tree)
	      IMPLICIT NONE
          INTEGER, DIMENSION (0:1) :: tree
		  INTEGER, INTENT(IN) :: siz

          tsize = siz
          last = 0
          tree(1) = eoh
          RETURN
       END SUBROUTINE heapxa_init

       SUBROUTINE heapxa_put2(who, tree)
	      IMPLICIT NONE
          INTEGER, DIMENSION (0:1) :: tree
		  INTEGER :: i, j, k, who 

          last = last + 1
          IF (last>tsize) GO TO 100
          IF (who==eoh) GO TO 110
          tree(last) = who
          i = last
          DO
             j = ishft(i, -1)
             IF (j==0) RETURN
             k = tree(j)
             IF (k<=who) RETURN
             tree(j) = who
             tree(i) = k
             i = j
          END DO

100       WRITE (6, *) '%HEAPXA - memory exceeded'
          CALL exit
110       WRITE (6, *) '%HEAPXA - use HEAPXA when some values equal HUGE(0)'
          CALL exit
       END SUBROUTINE heapxa_put2

       FUNCTION heapxa_get2(who, tree) RESULT (rv)
	      IMPLICIT NONE
          INTEGER, DIMENSION (0:1) :: tree
          INTEGER rv
		  INTEGER :: i, j, k, l, n, who

          who = tree(1)
          rv = 0
          IF (who==eoh) THEN
             rv = 1
             RETURN
          END IF
          i = 1
		  DO
          j = ishft(i, 1)
		  IF (j > last) THEN
		     tree(i) = eoh
			 RETURN
		  ELSE IF(j == last) THEN
             k = tree(j)
             IF (k==eoh) THEN
			    tree(i) = eoh
				RETURN
			 END IF
             tree(i) = k
             tree(j) = eoh
             RETURN
		  END IF
          k = tree(j)
          n = j + 1
          l = tree(n)
          IF (k==eoh) THEN
             IF (l==eoh) THEN
			    tree(i) = eoh
				RETURN
			 END IF
             tree(i) = l
             i = n
             CYCLE
          ELSE IF (l==eoh) THEN
             tree(i) = k
             i = j
             CYCLE
          END IF
		  IF (k > l) THEN
		     tree(i) = l
			 i = n
			 CYCLE
		  END IF
		  IF (k < l) THEN
		     tree(i) = k
			 i = j
		  ELSE 
             tree(i) = l
             i = n
		  END IF
       END DO

       END FUNCTION heapxa_get2

       INTEGER FUNCTION bitsx(value1)
	      IMPLICIT NONE
          INTEGER(i8) :: value, value1
		  INTEGER :: j

          j = 64
          value = abs(value1)
          DO WHILE (j>0)
             j = j - 1
             IF (btest(value,j)) EXIT
          END DO
          IF (btest(value,j)) j = j + 1
          bitsx = j
          RETURN
       END FUNCTION bitsx

    END MODULE heapxa
    PROGRAM jajdavid
       USE heapxa
	   IMPLICIT NONE
       INTEGER, PARAMETER :: mo=9999, mr=9999, mf=9999
	   INTEGER, DIMENSION(0:mo) :: opr2, opr6, tree
	   INTEGER, DIMENSION(0:mr) :: opr1, opr5, opr8, opr9
	   INTEGER, DIMENSION(0:mf) :: opr3, opr4, opr7
       INTEGER(i8) :: opra(0:mr), oprb(0:mr), oprt(0:mo)
	   INTEGER :: pa1, pa2, kid, obj, obj1, who, i, j, k, h, p, long

       pa1 = -1
       pa2 = -1
       kid = 0

       DO obj = 1, 5
          IF (pa1==mr) GO TO 100
          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==mf) GO TO 100
             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)/=0)
             obj = opr2(obj)
             h = h + 1
          END DO
          opr5(i) = h
          k = max(k, h)
       END DO
       IF (k>mr) GO TO 110
       DO i = 1, k
          CALL heapxa_init(who, tree)
          DO j = 0, pa1
             IF (opr5(j)==i) CALL heapxa_put2(opr1(j), tree)
          END DO
          h = 0
          DO WHILE (heapxa_get2(obj,tree)==0)
             h = h + 1
             opr6(obj) = h
          END DO
          opr9(i) = h + 1
       END DO
       IF (k==mr) GO TO 110
       oprb(k) = kid
       DO i = k - 1, 1, -1
          IF (bitsx(oprb(i+1))+bitsx(int(opr9(i+1),8))>63) GO TO 120
          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==obj1) THEN
             long = long/kid*kid + j
          ELSE
             obj1 = obj
             long = j
             DO WHILE (opr2(obj)/=0)
                long = long + opr6(obj)*oprb(opr5(opra(obj)))
                obj = opr2(obj)
             END DO
          END IF
          obj = opr3(i)
          oprt(obj) = long
          WRITE (6, *) obj, long
       END DO

       CALL exit
100    WRITE (6, *) '%PDTXT - increase MF'
       CALL exit
110    WRITE (6, *) '%PDTXT - increase MR'
       CALL exit
120    WRITE (6, *) '%PDTXT - tree failure'
       CALL exit

    END PROGRAM jajdavid

    SUBROUTINE exit()
       STOP 'Exit called'
    END SUBROUTINE exit

andrew_4619 · ‎11-06-2016

Looks good mecej4, all that old old style Fortran upsets my eyes! Much more readable and will compile with all that bug stopping checking and standards checking options....

I am intrigued, what does this program that takes no external input do?

jajdavid · ‎11-06-2016

The answer to mecej4 is

No, your spruced up code does not run correctly under 11.1.048. Your changes are purely cosmetic as far as the compiler is concerned.

However, it is true OPR9 is misclassified as INTEGER*4 when it should be INTEGER*8. Thanks for that!

I apologize for hurting anybody's eyes. I am very happy with F77 and have no plans to "improve" my code, of which I have an extensive library, all written in F77/VMS.

Finally to answer the question as to what this code is about.

First, this code is a very small extract of a much bigger and complex program. The code was created to give Intel something relatively manageable that demonstrated the 11.1.048 complier bug. I was most curious to see if this bug had been fixed in subsequent versions of Intel FORTRAN so I could make a case for myself to upgrade to the latest version.

Finally, what does this program do? It reads raw PDF's, formats them as text using a configuration file that allows for manipulation of the PDF (such as removing columns and translating different languages into "phonetic ASCII" ) then runs a specialized script (unique to each PDF) that extracts the text data so it may be loaded into a given database. As an example, it will process a 30,000 page AT&T Mobility invoice in under 2 minutes, extracting all the billing information (charges, call detail) so it may be loaded into a target database. Just for comparison purposes, using commercially available software, thus can not be done in under 20 minutes. When you have 10,000 PDF's to process a day, being 10X faster makes a big difference.

You may be asking yourself the question "why process PDF's?" Isn't everything available in more manageable formats (like XML, CSV etc)? The answer to that is in two parts. One, PDF's sometimes contain specialized information not available in any other format. Two, in some cases, no other format is available.

I call this program CAPTURE. As far as I know, CAPTURE is unique.

CAPTURE is entirely written in F77, my favorite language..

mecej4 · ‎11-06-2016

Thanks for the explanation of the purpose of your program. The application is interesting, and I had done similar data extraction work using a commercial PDF library a few years ago.

I tried the program of #13 with (i) IFort 7.0 of 2002/10/28 and (ii) IFort 9.1.0 of 2007/10/16. In both cases, no errors, same results. The question then is: What is special about 11.1.048, given that none of the earlier and later versions that I tried do not show a bug?

With regard to your CAPTURE application: does it spend a good portion of its run time in function BITSX? Or one of the other subroutines that you showed in your test program? Note that BITSX can be efficiently implemented using the X86/X64 BSR instruction. Here is the 64-bit version:

_TEXT SEGMENT
public BITSX
BITSX proc
   mov         rax,qword ptr [rcx]
   test        rax,rax
   jne         l1
   ret
l1:
   jns         l2
   neg         rax
l2:
   bsr         rax,rax
   inc         eax
   ret
BITSX endp
   end

andrew_4619 · ‎11-06-2016

I don't know what the comparative capabilities of V11 of the compiler were it is a long time ago but I will say that during the course of this thread a number of bugs in the short original code have been identified all of which would have been thrown up by the latest compiler with appropriate checking options set and if speed it one of your primary concerns then that also should improve with an upgrade.

For what it is worth my personal option is the that restructure is far more than cosmetic is allows for easier readability maintenance and the elimination of coding errors and/or code that relies on non-standard and hence unpredictable compiler behaviour.

jajdavid · ‎11-06-2016

To answer your question, my program spends and insignificant amount of time in BITS so changing it wouldn't have any impact on the performance of the program. But it is nice to know about and It certainly would be nice if BSR (and BSF) were implemented in FORTRAN...

Bug Report - here's the details