Function to upper case a string being truncated to one char

Function to upper case a string being truncated to one char

I have added a function fyuppr to uppercase a string based on a call to an existing subroutine syuppr.  For some reason fyuppr is only returning 1 char.  eg. if carg(1) = '-cwd', then the line carg(i) = fyuppr(carg(i)) puts '-' into carg(1).  Here is the code:

...
      character(256) :: fyuppr
      character(256), allocatable :: carg(:)
      numargs = nargs()-1
      allocate(carg(numargs))
      do i = 1, numargs
        call getarg(i,carg(i))      ! carg(i) contains '-cwd' here
        carg(i) = fyuppr(carg(i))    ! carg(i) only gets the 1st char here for some reason, ie '-'
      enddo
...

      FUNCTION FYUPPR (STRING)
      IMPLICIT NONE
      CHARACTER(LEN=*) STRING

      CHARACTER(LEN=LEN(STRING)) FYUPPR

      CALL SYUPPR(STRING)
      FYUPPR = STRING     ! STRING contains all chars here, ie '-CWD'
      RETURN
      END

      SUBROUTINE SYUPPR (STRING)
      IMPLICIT NONE
      INTEGER I, J
      CHARACTER(LEN=*) STRING
      CHARACTER(LEN=26) UPVALS, LOVALS
      DATA UPVALS / 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' /
      DATA LOVALS / 'abcdefghijklmnopqrstuvwxyz' /
      DO I = 1, LEN_TRIM(STRING)
        J = INDEX(LOVALS,STRING(I:I))
        IF (J > 0) STRING(I:I) = UPVALS(J:J)
      ENDDO
      RETURN
      END

Any idea?

8 posts / 0 new
Last post
For more complete information about compiler optimizations, see our Optimization Notice.

You could provide an explicit interface for function FYUPPR. The following modified version of your code works correctly:


module upr

contains

      FUNCTION FYUPPR (STRING)

      IMPLICIT NONE

      CHARACTER(LEN=*) STRING

      CHARACTER(LEN=LEN(STRING)) FYUPPR

      CALL SYUPPR(STRING)

      FYUPPR = STRING     ! STRING contains all chars here, ie '-CWD'

      RETURN

      END FUNCTION FYUPPR
      SUBROUTINE SYUPPR (STRING)

      IMPLICIT NONE

      INTEGER I, J

      CHARACTER(LEN=*) STRING

      CHARACTER(LEN=26) UPVALS, LOVALS

      DATA UPVALS / 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' /

      DATA LOVALS / 'abcdefghijklmnopqrstuvwxyz' /

      DO I = 1, LEN_TRIM(STRING)

        J = INDEX(LOVALS,STRING(I:I))

        IF (J > 0) STRING(I:I) = UPVALS(J:J)

      ENDDO

      RETURN

      END SUBROUTINE SYUPPR

end module upr

program xupr

  use upr

  character(len=256), allocatable :: carg(:)

  numargs = nargs()-1

  allocate(carg(numargs))

  do i = 1, numargs

     call getarg(i,carg(i))      ! carg(i) contains '-cwd' here

     carg(i) = fyuppr(carg(i))    ! carg(i) only gets the 1st char here for some reason, ie '-'

     write(*,'(1x,I2,2x,A)')i,carg(i)

  enddo

end program xupr

Thanks- I tried without a module, but get a compilation error:

program AAMAIN
IMPLICIT NONE
interface
FUNCTION FYuppr1 (STRING)
IMPLICIT NONE
CHARACTER(LEN=*) STRING
CHARACTER(LEN=LEN(STRING)) FYuppr1
end FUNCTION FYuppr1
end interface
integer :: numargs, i
CHARACTER(256), allocatable :: carg(:)

numargs = nargs()-1
if(numargs > 0) allocate(carg(numargs))
do i = 1, numargs
call getarg(i,carg(i))
write(101,'(a)') carg(i)
carg(i) = fyuppr1(carg(i))
write(101,'(a)') carg(i)
enddo
END

aupper.for(18): error #8000: There is a conflict between local interface block and external interface block. [FYUPPR1]

Is your FYuppr1 the same (except for the name change) as your earlier FYuppr?

Which compiler version/OS combination is being used? The code in the post of "Mon, 11/12/2012 - 05:55" runs fine with the 12.1.7.371 compiler (32-bit) on Windows 7.

There appears to be a problem with the declaration of FYUPPR, although it looks standard conforming to me.
Can anyone explain what is the problem with the original example ?

In the original example (original post), the function FYUPPR requires an explicit interface in any calling scope as it has a result variable with non-constant type parameters (the length of the result depends on the length of the argument). Such an interface is not provided in the code calling the function - mecej4's code fixes that. A declaration of the type of the function is provided in the calling code in the original example, but it does not match the actual type of the function (the declaration says that the result has fixed length, the function definition does not).

The error in the follow up code is probably a compiler bug associated with /warn:interface, which appears to have been fixed in more current releases than what the OP is using.

Thanks Ian,
the following appears to be more robust.
.
interface
FUNCTION FYUPPR (STRING)
CHARACTER(LEN=*) STRING
CHARACTER(LEN=LEN(STRING)) FYUPPR
end FUNCTION FYUPPR
end interface
!
character(256), allocatable :: carg(:)
integer*4 numargs, i
!
numargs = COMMAND_ARGUMENT_COUNT ()
allocate (carg(numargs))
do i = 1, numargs
call GET_COMMAND_ARGUMENT (i,carg(i))
carg(i) = fyuppr(carg(i)) ! carg(i) only gets the 1st char here for some reason, ie '-'
write (*,*) i, ' ', trim(carg(i))
end do
end

I am using 11.1- I guess there is a bug in /warn:interface

Leave a Comment

Please sign in to add a comment. Not a member? Join today