Function to upper case a string being truncated to one char

[Adrian_F_1]

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?

[mecej4]

You could provide an explicit interface for function FYUPPR. The following modified version of your code works correctly:
[fortran] 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 [/fortran]

[Adrian_F_1]

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]

[mecej4]

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.

[John_Campbell]

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 ?

[IanH]

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.

[John_Campbell]

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

[Adrian_F_1]

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