Compiler error shape mismatch

[zekebryant]

I have a shape mismatch error for ITD. Not sure why can someone please help identify the mismatch.

SUBROUTINE NET (TD, ITD, N, T, Q)

!

DIMENSION TD (601), ITD (1552), T (N), Q (N)

!

CALL NETEET (N, ITD, ITD (2), T, TD, TD (101), TD (601), ITD (3), &

ITD (53), ITD (553), ITD (1053), Q)

RETURN

END SUBROUTINE NET

SUBROUTINE NETEET (N, M, NT, T, G, TRM, HTC, KX, INDX, II, JJ, Q)

!

DIMENSION T (M), G (100), TRM (500), HTC (100), KX (50), INDX (500), II (500), JJ (500), Q (M)

COMMON DUM (800), QD (100)

[Anonymous66]

The issue is likely your call to NETEET in NET. You are passing the array ITD in as the value of M which appears to be a scalar based on how you are using it.

SUBROUTINE NET (TD, ITD, N, T, Q)

!

DIMENSION TD (601), ITD (1552), T (N), Q (N)

!

CALL NETEET (N, ITD, ITD (2), T, TD, TD (101), TD (601), ITD (3), &

ITD (53), ITD (553), ITD (1053), Q)

RETURN

END SUBROUTINE NET

SUBROUTINE NETEET (N, M, NT, T, G, TRM, HTC, KX, INDX, II, JJ, Q)

!

DIMENSION T (M), G (100), TRM (500), HTC (100), KX (50), INDX (500), II (500), JJ (500), Q (M)

COMMON DUM (800), QD (100)

[zekebryant]

ITD is defined in a COMMON Block in the main program

COMMON / THERM2 / ITD (1552), IGBP (20, 5), ITP (15, 5)

There are a few calls that other functions that pass ITD

If I DIMENSION ITD(1) in these functions will it become a scalar in those functions

[zekebryant]

ITD is defined in a COMMON Block in the main program

COMMON / THERM2 / ITD (1552), IGBP (20, 5), ITP (15, 5)

There are a few calls that other functions that pass ITD

If I DIMENSION ITD(1) in these functions will it become a scalar in those functions

[mecej4]

What Annalee is pointing out as the error can be fixed by your changing

CALL NETEET (N, ITD, ITD (2), T, TD, TD (101), TD (601), ITD (3), &

to

CALL NETEET (N, ITD(1), ITD (2), T, TD, TD (101), TD (601), ITD (3), &

This will work correctly if the intended value of M has been set into ITD(1). As far as code generation is concerned, the object code is probably going to be the same whether ITD or ITD(1) is used as the second argument, since both have the same address.

Whether ITD is in a common block or not in some other subroutine is not relevant.

The problem with compiling old programs with interface checking turned on is that you will often see complaints such as this, which you obviously do not like to spring up, as well as warnings about other shady practices that will one day give an unpleasant surprise.

[Anonymous66]

No, a 1 element array is not the same as a scalar.

[zekebryant]

Thanks for thefeedback. I am in the process of updating old Fortan 66 and 77 code. I using your complier to identify all of the issues and hopeful resolve them. I was able to work pass this error with your help.

Thanks

[zekebryant]

I looking for some advice for the best practice to help resolve the following code error. This code is being converted from .FOR to f90.

The following is code in question:

CALL TEMPIN (TITLE, NBRG, ITEMP, IPUNCH, IUB, ITD, N, T, ITP, TB, &

TD, IGBP, BCP, TD, ITD, IT1, EP1, IT2, EP2, START, STEPIN, STOP, &

TTIME, BTIME, VDC, TMAX, BD)


/////////////////////////

SUBROUTINE TEMPIN (TITLE, NBRG, ITEMP, IPUNCH, IUB, M, N, T, ITP, &

TB, G, IGBP, BCP, TD, ITD, IT1, EP1, IT2, EP2, START, STEPIN, &

STOP, TTIME, BTIME, VDC, TMAX, BD)

!

!INTEGER(2) SSQMSF

CHARACTER(1) LIST

CHARACTER(48) MESSAGE

!

COMMON / CONGHT / GCONS (100), IGCONS (100)

COMMON / UNITS / IMET

COMMON / LSTDAT / LIST (80), KTEST

COMMON / LSTMES / MESSAGE

!

! IMET=0 ==> ENGLISH UNIT INPUT

! IMET=1 ==> METRIC UNIT INPUT

!

! $LARGE:TEXT

DIMENSION TITLE (47), T (M), ITP (15, 5), TB (15, 5), G (M), &

IGBP (20, 5), BCP (4, 8, 5), TD (690), ITD (1552), VDC (N), &

TEXT (25), IDU (5), DU (5), BD (1830, 5)

//////

M in TEMPIN is problem error #6634 shape matching rule

What is the best procedure to correct the problem is the question.

[Steven_L_Intel1]

How is ITD declared in the caller?

[zekebryant]

Here is the definition

COMMON / THERM2 / ITD (1552), IGBP (20, 5), ITP (15, 5)

[mecej4]

So, ITD is an array containing 1552 integers. One of these, presumably ITD(1), is supposed to be equal to the desired value of M, the sixth formal argument of the subroutine.

Verify that the value of M is placed into ITD(1) before the CALL, and replace the actual argument ITD by ITD(1), as I suggested in #4.

I doubt that more concrete recommendations can be given since we cannot reach back in time and deduce what the author intended to be done with these lines of code.

[zekebryant]

I followed the procedure, but when I try to use T(M) for example:

! ... THE TEMPERATURES WILL BE CALCULATED

100 DO 105 I = 1, M

T (I) = TEMP

run time error is generated. When I dug the code T has no array length even thoughthe value of M is 3D.

This why I ask the additional question. Please adivce on what I do not understand. Below is the entire routine.

SUBROUTINE TEMPIN (TITLE, NBRG, ITEMP, IPUNCH, IUB, M, N, T, ITP, &

TB, G, IGBP, BCP, TD, ITD, IT1, EP1, IT2, EP2, START, STEPIN, &

STOP, TTIME, BTIME, VDC, TMAX, BD)

!

!INTEGER(2) SSQMSF

CHARACTER(1) LIST

CHARACTER(48) MESSAGE

!

COMMON / CONGHT / GCONS (100), IGCONS (100)

COMMON / UNITS / IMET

COMMON / LSTDAT / LIST (80), KTEST

COMMON / LSTMES / MESSAGE

!

! IMET=0 ==> ENGLISH UNIT INPUT

! IMET=1 ==> METRIC UNIT INPUT

!

! $LARGE:TEXT

DIMENSION TITLE (47), T (M), ITP (15, 5), TB (15, 5), G (M), &

IGBP (20, 5), BCP (4, 8, 5), TD (690), ITD (1552), VDC (N), &

TEXT (25), IDU (5), DU (5), BD (1830, 5)

!

DATA TEXT / 'COND', 'UCTI', 'ON ', ' ', ' ', 'FREE', ' CON'&

&, 'VECT', 'ION ', ' ', 'FORC', 'ED C', 'ONVE', 'CTIO', 'N ', &

&'RADI', 'ATIO', 'N ', 2 * ' ', 'FLUI', 'D FL', 'OW ', 2 * ' &

& ' /

IN = 5

KUT = 6

!

! CHECK FOR PRESENCE OF HARDWARE LOCK

!

!KSUM = SSQMSF (LIST)

IF (KSUM.NE.KTEST) THEN

WRITE ( *, * ) MESSAGE

! STOP

ENDIF

!

! SET TEMPERATURE CONVERSION FACTORS

!

C1 = 1.8

C2 = 32.0

!

DO 1 I = 1, 100

GCONS (I) = 0.

IGCONS (I) = 0

1 END DO

DO 5 I = 1, 20

DO 5 J = 1, 5

IGBP (I, J) = 0

IF (I.LE.15) ITP (I, J) = 0

IF (I.LE.15) TB (I, J) = 0.0

5 CONTINUE

! ... READ CONTROLLING CARD AND SET SOME VARIABLES

READ (IN, 10) M, N, TEMP, IPUNCH, IUB, IT1, EP1, IT2, EP2, START, &

STOP, STEPIN, TTIME, BTIME, TMAX

10 FORMAT(2I5, F5.0, 3I5, F5.0, I5, 7F5.0 )

IF (ABS (TMAX) .LT.1.E-30.AND.IMET.EQ.1) TMAX = 600.

IF (ABS (TMAX) .LT.1.E-30.AND.IMET.EQ.0) TMAX = 600. * C1 + C2

IF (EP1.LE.0.0.AND.IMET.EQ.1) EP1 = 2.0

IF (EP1.LE.0.0.AND.IMET.EQ.0) EP1 = 2.0 * C1

ITEMP = 1

IF (M.EQ.0) ITEMP = 0

IF (ABS (STOP - START) .GT.0) ITEMP = 2

IF (M.GT.0) WRITE (KUT, 15) TITLE

15 FORMAT('1'////' ',27A4/'0', 20A4)

!

! ... STEADY STATE

IF (ITEMP.NE.1) GOTO 28

WRITE (KUT, 20) IT1, EP1

20 FORMAT('0STEADY STATE TEMPERATURE CALCULATION. ITERATION LIMIT', &

& I4,', ABSOLUTE ACCURACY', F6.2, ' DEGREES')

IF (IUB.NE.0) WRITE (KUT, 25)

25 FORMAT(' ', 5X, 'INTERMEDIATE OUTPUT WILL BE OBTAINED')

!

! ... TRANSIENT

28 IF (ITEMP.NE.2) GOTO 35

WRITE (KUT, 30) START, STOP, TTIME, BTIME, TMAX

30 FORMAT('0TRANSIENT TEMPERATURE CALCULATION, BEGINNING AT TIME', &

& F7.1, ' SECONDS, ENDING AT TIME', F7.1, ' SECONDS.'/ &

& ' ', 5X, 'TEMPERATURE OUTPUT INTERVAL', F7.1,' BEARING CALCULA',&

& 'TION INTERVAL',F7.1, ' MAXIMUM ALLOWABLE TEMPERATURE', F7.1 )

IF (IUB.NE.0) WRITE (KUT, 32)

32 FORMAT(' ', 5X, 'BEARING OUTPUT WILL BE OBTAINED AFTER EACH', &

& ' BEARING CALCULATION')

!

35 IF (IMET.EQ.1) WRITE (KUT, 40)

IF (IMET.EQ.0) WRITE (KUT, 41)

40 FORMAT('0UNLESS OTHERWISE STATED, INTERNATIONAL UNITS ARE USED'//)

41 FORMAT('0UNLESS OTHERWISE STATED, ENGLISH UNITS ARE USED'//)

!

! FOR IMET=0, CONVERT VALUES OF TEMP, EP1, AND TMAX TO METRIC.

!

IF (IMET.EQ.1) GOTO 45

!

EP1 = EP1 / C1

TMAX = (TMAX - C2) / C1

!

45 CONTINUE

!

IF (NBRG.EQ.0) GOTO 100

IF (ITEMP.NE.0) GOTO 100

!

! ... READ AND WRITE INITIAL BEARING TEMPERATURES

DO 65 I = 1, NBRG

READ (IN, 60) (TB (J, I), J = 1, 15)

60 FORMAT (16F5.0)

65 END DO

WRITE (KUT, 70)

70 FORMAT('0GIVEN TEMPERATURES')

WRITE (KUT, 75)

75 FORMAT('0',5X,'BRG O.RACE I.RACE BULK OIL FLNG.1 FLNG.2 FLN&

&G.3 FLNG.4 CAGE SHAFT I.RING ROLL.EL. O.RING HSG.')

DO 80 I = 1, NBRG

WRITE (KUT, 85) I, (TB (J, I), J = 1, 13)

80 END DO

85 FORMAT (' ', 5X, I2, 2X, 7( F8.2,1X,F8.2 ))

!

IF (IMET.EQ.1) GOTO 95

!

! CONVERT BEARING TEMPERATURES TO DEGREES C IF IMET=0.

!

DO 90 I = 1, NBRG

DO 90 J = 1, 13

TB (J, I) = (TB (J, I) - C2) / C1

90 CONTINUE

!

95 CONTINUE

!

RETURN

!

! ... THE TEMPERATURES WILL BE CALCULATED

100 DO 105 I = 1, M

T (I) = TEMP

105 G (I) = 0.

!

! ... READ INITIAL TEMPERATURES (AND NODES) NOT EQUAL TO TEMP

CALL INDUM (T, J)

IF (NBRG.EQ.0) GOTO 180

!

! ... READ AND WRITE BEARING TEMPERATURE NODE POINTERS

DO 120 I = 1, NBRG

READ (IN, 118) (ITP (J, I), J = 1, 13)

118 FORMAT (16I5)

120 END DO

WRITE (KUT, 125)

125 FORMAT('0NODE POINTERS')

WRITE (KUT, 75)

DO 130 I = 1, NBRG

130 WRITE (KUT, 135) I, (ITP (J, I), J = 1, 13)

135 FORMAT (' ',5X, I2, 7( I8,1X,I8 ))

!

! ... READ AND WRITE BEARING GENERATED HEAT POINTERS

119 FORMAT(10I5)

DO 150 I = 1, NBRG

LIM = 18

IF (BD (1, I) .LT.0.) LIM = 10

READ (IN, 119) (IGBP (J, I), J = 1, LIM)

150 END DO

WRITE (KUT, 155)

155 FORMAT(/'0NODES WHERE BEARING HEAT IS GENERATED'/'0', 5X, &

& 'BRG',2X,'OUTER RACE INNER RACE R.E.DRAG CAGE-R.E. CAGE-&

&LAND FLNG.1-RE FLNG.2-RE FLNG.3-RE FLNG.4-RE' )

DO 160 I = 1, NBRG

160 WRITE (KUT, 165) I, (IGBP (J, I), J = 1, 18)

165 FORMAT (6X, I2, 18I6 )

!

! ... READ AND WRITE CONSTANT GENERATED HEATS

180 CALL INDUM (G, IG)

IF (IG.LE.0) GOTO 191

WRITE (KUT, 185)

185 FORMAT(/'0CONSTANT GENERATED HEATS'//'0', 5X, 5(5X,'NODE GEN. HEA&

&T') / )

NGH = 0

KOUNTR = 0

DO 190 I = 1, N

IF (G (I) .EQ.0.) GOTO 186

KOUNTR = KOUNTR + 1

GCONS (KOUNTR) = G (I)

IGCONS (KOUNTR) = I

NGH = NGH + 1

IDU (NGH) = I

DU (NGH) = G (I)

186 IF (NGH.EQ.5.OR.I.EQ.N) WRITE (KUT, 188) (IDU (J), DU (J), &

J = 1, NGH)

188 FORMAT (' ', 4X, 5(I10, F10.2) )

IF (NGH.EQ.5) NGH = 0

190 END DO

191 CONTINUE

IF (IMET.EQ.1) GOTO 198

!

! FOR IMET=0, CONVERT TEMPERATURE ARRAY (T) AND GENERATED HEAT

! ARRAYS (G & GCONS) TO METRIC UNITS (DEG. C & WATTS).

!

DO 195 I = 1, M

T (I) = (T (I) - C2) / C1

195 END DO

!

DO 196 I = 1, N

G (I) = G (I) * 0.29301

GCONS (I) = GCONS (I) * 0.29301

196 END DO

!

198 CONTINUE

!

! ... READ AND WRITE HEAT TRANSFER COEFFICIENTS

!

200 CALL RWHTC (TITLE, TEXT, ITD (3), TD (601) )

!

! ... READ AND WRITE GEOMETRY CARDS

!

CALL RWG (TITLE, TEXT, ITD (3), TD (601), BCP, TD (101), ITD (53),&

ITD (553), ITD (1053), ITD (2) )

!

IF (ITEMP.NE.2) GOTO 250

!

! ... READ AND WRITE HEAT CAPACITY CARDS

!

CALL RWHC (TITLE, N, VDC)

!

!

! ... PRINT FIRST TEMPERATURE MAP

250 CALL TMAP (TITLE, ITEMP, M, N, 0, START, T)

RETURN

END

[Steven_L_Intel1]

You have not shown us the error message. I do not know what you mean by "the value of M is 3D". Perhaps you could add a:

PRINT *, M

just before the DO loop so you can see what the value is. But you may not have passed array T correctly.

It is hard to help based on pieces of the program, with so much that we cannot see.