Handling character*(*) in Visual FORTRAN Composer XE 2011 (evalulation edition)

[rre9518]

The code below fails with

Error5 error #7836: If the actual argument is scalar, the corresponding dummy argument shall be scalar unless the actual argument is an element of an array that is not an assumed-shape or pointer array, or a substring of such an element. [INDE]C:\\ActiveSWS\\libutil\\dvlp\\lib\\prsval.f158


fcn1( string)
character*(*)
call fcn2(string)
endfcn1

fcn2(string)
character*(*) string
...
endfcn2

[Steven_L_Intel1]

You have not shown the actual code, nor even all of the lines of the code you provided a paraphrase of. Please show the actual code including the complete declarations of all relevant variables. What you did show of the paraphrase does not show a problem.

[rre9518]

Here is the code, for the caller and callee, I've marked the line where the error occurs (call to iprsstr) (the code has worked for 20 years)

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

subroutine prsval(string, istart, ilast, sep, lsep, nsep, mxfld,

+ idfld, ifld, rfld, cfld, lcfld, nfld, lcol,

+ ierr)

c

c---------------------------------------------------------------------

cs

c Routine : subroutine prsval

c

c

c Purpose : This routine parses a string into fields (tokens). Each

c field can be delimited by one or more seperators. The

c seperators are scanned in the order in which they appear

c in the character array,sep. Each field is tested to

c determine if it is real, integer, or character type data.

c If real or integer, the field is converted to its

c original numeric type and to its compelentary numeric

c type (i.e., real numbers are converted to integer and

c integers are converted to floating point). Both numeric

c types are returned. If the data field contains a double

c precision number, it is coverted to a single precision

c real number and then to an integer number. The real

c and the integer numbers are returned. Fields which

c exceed the allowable character token length are

c truncated when placed into the array, cfld.

c

c

c Usage :

c integer lsep(nsep)

c

c character*nc1 string

c character*nc2 sep(nsep)

c

c dimension rfld(mxfld)

c integer ifld(maxfld), nfld, lcol

c character*1 idfld(mxfld)

c character*nc cfld(mxfld)

c

c call prsval(line, ifrst, ilast, mxfld, sep, lsep,

c + nsep, idfld, ifld, rfld, cfld, nfld

c + lcol, ierr)

c

c

c Parameters: I N P U T

c =========

c

c string - Line of characters to be parsed

c ifrst - Position of first character of line to be

c considered

c ilast - Position of last character of line to be

c considered

c mxfld - Maximum number of fields to be considered

c for parsing

c sep - Character array of valid separator characters

c lsep - Integer array of seperator charcater lengths

c nsep - Number of separators

c

c

c O U T P U T

c ===========

c

c idfld - Charcater array identifying type of each

c field(token).

c = 'c' - character

c = 'i' - integer

c = 'r' - real

c = 'e' - error, character field exceeds

c allowable token character size

c ifld - Array containing integer values for those

c fields that are numeric.

c rfld - Array containing real values for those fields

c that are numeric.

c cfld - Character array. If the size of a data field

c exceeds the declared size of the character

c array, then the field is truncated.

c lcfld - Integer array containing the number of

c characters extracted from each field

c nfld - Number of fields in string

c lcol - Column number of last character read

c ierr - Error indicator.

c = 0 No data errors

c = 1 One or more character data fields

c exceeds the allowable number of

c characters in the token string array

c = 2 Data left in string

c

c

c Routines : Name Description Source

c --------------- ------------------------------- ------

c iprsstr Determines the starting and Libutil

c ending location of a field in

c a character string

c rmesc Removes escape characters which Libutil

c are defined by "setesc" and

c recognized by "iprsstr".

c strval Returns the data type Libutil

c and value of a string

c

c

c Functions : Name Description Source

c --------------- ------------------------------- ------

c

c nindset returns the location in string Libutil

c of a character that is NOT in a

c symbol in "sep"

c call to iprsstr is now set to

c 0. This prevents iprsstr from

c checking for remaining data on

c card. The information was

c never used and by eliminating

c the check, cpu time is saved.

c

c---------------------------------------------------------------------

c

parameter(INS=0)

c

dimension rfld(*), ifld(*)

c

integer lsep(*)

integer lcfld(*)

c

character*(*) string

character*(*) sep(*)

character*(*) cfld(*)

character*1 idfld(*)

c

c

c---------------------------------------------------------------------

c

c

nfld = 0

ierr = 0

lcol = 0

lcf = len(cfld(1))

ibeg = istart

c

c

if ( ilast .eq. 0 ) return

c

c loop over fields

c ================

c

do 10 i = 1, mxfld

c

c Parse string by calling iprsstr with max field

c set to 0. This returns only one value without

c checking for data remaining on card.

c

call iprsstr( string, ibeg, ilast, sep, lsep, nsep, 0,

+ iflds, iflde, nf, kerr)<=======================THIS IS WHERE THE ERROR OCCURS CODE FOR IPRSSTR is BELOW

if ( nf .eq. 0 ) return

c

c Fill data fields

c

nfld = nfld + 1

call rmesc(string,iflds,iflde,idmin,cfld(nfld),lfldnew,idmout)

lcfld(nfld) = lfldnew

c

c Determine data type and convert

c

call strval( cfld(nfld)(1:lcfld(nfld)), idfld(nfld),

$ ifld(nfld), rfld(nfld) )

ibeg = iflde + 1

lcol = iflde

c

c Check for character truncation

c

if ( (idfld(nfld) .eq. 'c' ) .and.

+ (lcfld(nfld) .gt. lcf ) ) then

ierr = 1

idfld(nfld) = 'e'

endif

c

c

c Return if past the last column of line

c

if (ibeg .gt. ilast) return

c

10 continue

c

c end loop on fields

c ==================

c

c

c Test for data left in string

c ----------------------------

c

if ( ibeg .le. ilast ) then

iendval = nindset(string, ibeg, ilast, sep, lsep, nsep,

+ INS)

if ( iendval .gt. 0 ) ierr = 2

endif

return

end

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

subroutine iprsstr(string, istart, inlast, sep, lsep, nsep,

+ mxfld, inds, inde, nfld, ierr)

c

c---------------------------------------------------------------------

cs

c Routine: subroutine iprsstr

c

c Purpose: This subroutine determines the starting and ending

c columns of the fields to be parsed from an input

c string using an array of data field seperators

c defined by the user.

c

c Usage:

c character*nc1 string

c character*nc2 sep(nsep)

c

c integer lsep(nsep), nsep, ierr

c integer mxfld, inds(mxfld), inde(mxfld)

c

c call iprsstr( string, istart, inlast, sep, lsep, nsep,

c + mxfld, inds, inde, nfld, ierr)

c

c Parameters: I N P U T

c =========

c string - String from which data fields

c are to be found

c istart - Starting position of search

c inlast - Ending position of search

c sep - Character array of data field

c seperators

c lsep - Array of seperator lengths

c nsep - Number of data field seperators

c

c O U T P U T

c ===========

c

c mxfld - Maximum number of fields to be parsed

c if = 0, the routine will parse one

c data field without checking for

c data remaining in the string.

c inds - Array of starting columns of each

c data field

c inde - Array of ending columns of each

c nfld - Number of fields found

c ierr - Error flag

c = 0 - no error

c 2 - data left in string

c

c Routines : None

c

c Functions: Name Description Source

c -------------- ------------------------------- -------

c index determine location in string Intrin.

c of a character

c indset returns the location in string LIBUTIL

c of a symbol in "sep"

c nindset returns the location in string LIBUTIL

c of a character that is NOT in a

c symbol in "sep"

c

c Limitations/Restrictions:

c

c Modifications:

c maxfld = 0. This extracts one

c data item while not checking

c for remaining items in string.

c This allows for faster

c execution when a user only

c wants one data item.

c

c---------------------------------------------------------------------

c

c

c Include the LIBUTIL include file.

c

include 'libutil.h'

c

parameter(INS=0)

c

character*(*) string

character*(*) sep(nsep)

c

integer lsep(nsep)

integer inds(*), inde(*)

c

integer ihit

c

c---------------------------------------------------------------------

c

c

c Initialize the number of values to find

c ---------------------------------------

igetfl = max0(1,mxfld)

c

c Initialize the number of values found.

c -------------------------------------

nfld = 0

c

c

c Initialize the current "pointer" value.

c --------------------------------------

ibeg = istart

c

c

c Initialize the error flag value.

c --------------------------------

ierr = 0

c

c

c Determine the end of the input string.

c --------------------------------------

if (inlast .gt. 0) then

ilast = inlast

else if (inlast .eq. KTRIMMED) then

ilast = lenstr(string)

if (ilast .eq. 0) return

else if (inlast .eq. KDEFLEN) then

ilast = len(string)

else

ierr = 10

return

endif

c

c

c Initialize the index to the beginning

c of the current value.

c ---------------------------------------

iendval = 0

c

c

c LOOP: Check the terminating conditions of

c enough values or the end of the string.

c ----------------------------------------

5 if ((nfld .lt. igetfl) .and. (ibeg .le. ilast)) then

c

c

c Get the next non-symbol character.

c ---------------------------------

ibegval = nindset(string,ibeg,ilast,sep,lsep,nsep,INS)

if (ibegval .gt. 0) then

c

c

c Search for the next symbol character.

c ------------------------------------

if (ibegval .lt. ilast) then

iendval = indset(string,ibegval,ilast,sep,lsep

+ ,nsep,INS,ihit)

if (iendval .gt. 0) then

nfld = nfld + 1

inds(nfld) = ibegval

inde(nfld) = iendval-1

ibeg = iendval + lsep(ihit)

c

c END LOOP: keep looping until either enough values have been found, or

c end of the string

c

goto 5

else

nfld = nfld + 1

inds(nfld) = ibegval

inde(nfld) = ilast

endif

c

c

c At end of string. Since this last character

c was NOT part of a pattern string, the last

c character is a token.

c

else

nfld = nfld + 1

inds(nfld) = ibegval

inde(nfld) = ilast

endif

endif

endif

c

if ( mxfld .gt. 0 ) then

if ( nfld .eq. mxfld .and. inde(nfld) .lt. ilast ) then

c

c Test for data left in string

c ----------------------------

c

ibeg = inde(nfld) + 1

iendval = nindset(string, ibeg, ilast, sep, lsep, nsep,

+ INS)

if ( iendval .gt. 0 ) ierr = 2

endif

endif

return

end

[Steven_L_Intel1]

I'd need to see the contents of libutil.h to be sure, because dummy argument inde is not declared, but the comments say that argument inde is an array, and you are passing a scalar iflde (also not declared) to it. This is not legal Fortran but most compilers do not detect the error. Given that this is an output parameter, one workaround of passing [iflde] (an array constructor) won't work. Instead, you should declare iflde as an integer array and subscript it properly when used later in the caller.

That the code has been "working" for 20 years means nothing if the code is incorrect. You may have been lucky that nothing was overwritten or that if it was, you didn't notice.