Intel® Fortran Compiler
Build applications that can scale for the future with optimized code designed for Intel® Xeon® and compatible processors.

Q re output arrays from functions ?

WSinc
New Contributor I
3,714 Views

This could easily be done with a subroutine, with no problems - -

I have three variable length arrays here,

I want to add the contents of arrays A and B to get array C.

The zeroth element tells the number of items in the array.

The problem is - I cant get the compiler to work re the calling routine.

I tried to keep this as simple as possible - there must be a special trick to make it compile properly ?

Maybe the compiler is not meant to do this? However, in the CALLED routine it compiles with no problem.

any clues ? See attached source file.

0 Kudos
1 Solution
JVanB
Valued Contributor II
3,691 Views

Your program is a long way from working. First off, you need IMPLICIT NONE in all program units to handle carelessly mismatched variable names. Then, since your function returns something that F77 could not (i.e. an array result) it needs its interface to be explicit in the caller. Also standard Fortran doesn't zero out arrays for you so you have to give them initial values yourself somehow. And the array assignment that captures the result of invocation of xadd is particularly problematic because function xadd doesn't know the true extents of its inputs because they are assumed size arrays (assumed shape arrays would have been a better fit for your usage) so either c has to be allocatable (but then your result ends up starting at index 1 instead of index 0) or you have to invoke xadd twice to get its specifications and value or you have to compute the size of the result separately, which is what I did.

module M
  implicit none
  contains
    function xadd(p,q)
    integer p(0:*),q(0:*),ip,np,nq,nx,ix
    integer xadd(0:max(p(0),q(0)))
    np=p(0)
    nq=q(0)
    nx=ubound(xadd,1)
    do ix=1,nx
      xadd(ix)=p(ix)+q(ix)
    enddo
    xadd(0)=nx
    end function
end module M

  use M
  implicit none
  integer a(0:1000),b(0:1000),c(0:1000)
  integer i
  a(0) = 13
  a(1:a(0)) = [(i,i=1,a(0))]
  a(a(0)+1:) = 0
  b(0) = 17
  b(1:b(0)) = [(i**2,i=1,b(0))]
  b(b(0)+1:) = 0
  c(0:max(a(0),b(0)))=xadd(a,b)
  write(*,*) c(1:c(0))
  end

 

View solution in original post

0 Kudos
35 Replies
WSinc
New Contributor I
2,207 Views

Something got screwed up.

Try this download.

0 Kudos
WSinc
New Contributor I
2,207 Views

Anyway, I get an error #6413 when I compile this.

And I tried typing XADD in the calling routine as XADD(0:1000), but that doesn't work either.

 

By the way, is there a way to examine the contents of attached files without trying to compile them?

If they have an extension of F90 I get a message, "cannot execute this command." when i open them.

 

I have to download them first, then use a text editor, otherwise.

 

0 Kudos
mecej4
Honored Contributor III
2,207 Views

No trick will enable you to compile incorrectly written code. To write correct code and to understand the compiler's error messages you will have to read books and manuals and learn at least those parts of the programming language that you wish to use in your programs.

Your main program declares the function to have the type scalar integer. Your function subprogram, likewise, declares "xadd" to be a scalar integer. Later, you use xadd with subscripts, which you cannot use on a scalar variable.

To reference an external function whose result type is not scalar, you are required to make available an explicit interface in the subprogram/main program containing the reference.

0 Kudos
WSinc
New Contributor I
2,207 Views

The whole purpose of the is post was to figure out the "correct" way to do this -

I have several text books on this topic, but they are woefully inadequate about explaining this - 

anyway, you can see where I did type XADD as an ARRAY in the called routine, and I do use subscripts there

as well. No complaints from the compiler. see quote #3 above.

and when I type it in the calling routine as an array, it wont compile that either, as I mentioned above.

Maybe someone has a less condescending, accusatory, and more intelligent reply?

 

Maybe there is an article about this somewhere?

0 Kudos
JVanB
Valued Contributor II
3,692 Views

Your program is a long way from working. First off, you need IMPLICIT NONE in all program units to handle carelessly mismatched variable names. Then, since your function returns something that F77 could not (i.e. an array result) it needs its interface to be explicit in the caller. Also standard Fortran doesn't zero out arrays for you so you have to give them initial values yourself somehow. And the array assignment that captures the result of invocation of xadd is particularly problematic because function xadd doesn't know the true extents of its inputs because they are assumed size arrays (assumed shape arrays would have been a better fit for your usage) so either c has to be allocatable (but then your result ends up starting at index 1 instead of index 0) or you have to invoke xadd twice to get its specifications and value or you have to compute the size of the result separately, which is what I did.

module M
  implicit none
  contains
    function xadd(p,q)
    integer p(0:*),q(0:*),ip,np,nq,nx,ix
    integer xadd(0:max(p(0),q(0)))
    np=p(0)
    nq=q(0)
    nx=ubound(xadd,1)
    do ix=1,nx
      xadd(ix)=p(ix)+q(ix)
    enddo
    xadd(0)=nx
    end function
end module M

  use M
  implicit none
  integer a(0:1000),b(0:1000),c(0:1000)
  integer i
  a(0) = 13
  a(1:a(0)) = [(i,i=1,a(0))]
  a(a(0)+1:) = 0
  b(0) = 17
  b(1:b(0)) = [(i**2,i=1,b(0))]
  b(b(0)+1:) = 0
  c(0:max(a(0),b(0)))=xadd(a,b)
  write(*,*) c(1:c(0))
  end

 

0 Kudos
WSinc
New Contributor I
2,207 Views

Well, what I gave originally was NOT supposed to be a running program, I simplified it  to illustrate

the problems in compiling it.

apparently I cannot just put the routines together and have VS

figure out the interface?

 

When I typed the arrays, routines, etc. correctly, I get MORE compiler errors.

And it still is a mystery why I did not get a compiler error in the called routine.

 

This came about from a situation where all the routines were subroutines.

 

so I was pretty well committed in use the zeroth element of ALL the arrays.

Well, let me play around with what you sent.

0 Kudos
WSinc
New Contributor I
2,207 Views

OK, I played around with it -

Works fine, but I was wondering why your  line 27 has to be so involved.

after all, the  XADD routine is supposed to figure out the length of the output array,

so why is it necessary to do that separately?

There are situations in the original code where the length of the output array is really complicated, that's

why I mention this.

 

Apparently I cannot just say 

c=xadd(a,b)

 

without getting a breakpoint error. No way around that?

Maybe just using the subroutines is less involved in the long run?

 

To illustrate: If i have signed integers in the arrays A and B, I can a result that is much shorter than

either of them. If A has (3,17) in it, and B has (4,-17) in it, then the result is (7,0). So the output

has only one number in it we need to carry further, so the length is ONE then, not two.

0 Kudos
jimdempseyatthecove
Honored Contributor III
2,207 Views

Your original problem statement did not indicate that the result number of elements should truncate trailing zeros.

Also not stated is if your outermost scope array declarations, as used by a, b, c in the c=xadd(a,b) have a known fixed (parameter) size.

integer, parameter :: MAX_ACCUMULATOR = 4096

Then the parameter can be used by the common/module/program and the caller and callee with the used portion of the array stored in the 0'th index.

Jim Dempsey

0 Kudos
WSinc
New Contributor I
2,207 Views

Well, the original code did have logic to truncate the output array length at the last non-zero position in the array.

I was trying to simplify the examples I gave. Normally I did have a PARAMETER statement like you mention.

I was wondering if the use of the RESULT keyword in the function header might simplify the interface?

For example (and I have yet to experiment further):

FUNCTION XADD(A,B) RESULT C

integer A(0:*), B(0:*) , C(0:*)

Instead of * I could just say 10000, or the PARAMETER like you suggested, to give an open-ended result.

The original code was pretty involved because I was using it to simulate numerical operations on very large integers.

Hundreds of digits long, so we want to avoid operations on a lot of trailing zeros, In the older FORTRAN,

I would carry the array lengths as separate integer variables, and all the array positions would begin with 1 not zero.

Of course we would also have CARRY operations as well. Example:

A= (9,9,9) so A(0)=3

B=(9,9,8) so B(0)=3

C=XADD(A,B) would give C=(1,9,9,7) and C(0)=4

If I add two sets of integers and there is  a CARRY, then I have to allow for one extra place in the result.

This was extended for multiply and divide, and of course BORROW for subtract.

Of course the numeric content of each cell could be a lot higher than just + or - 9. i.e. 0 to + or - 999999999

Or even 2**N-1, so that the operations could be binary in places, i.e. shifts, AND, OR, etc.

But that complicates the problem of DISPLAYING the results.

0 Kudos
WSinc
New Contributor I
2,207 Views

Example for multiply:

A=(9,9)              a(0)=2

b=(9,9)              b(0)=2        This is the most extreme case.

8 1

   8 1

    8 1

        8  1

--------------------

9   8   0  1

The largest possible length for C would be A(0)+b(0), in this case = 4.

0 Kudos
WSinc
New Contributor I
2,207 Views

OK, I took the source code from REPEAT OFFENDER and modified it using the RESULT keyword.

I get a much cleaner interface from that. None of the references I looked at really go into this in much detail.

see attached code. This looks like a good way to go.

0 Kudos
WSinc
New Contributor I
2,207 Views

Whoops - here is the source code:

I do not test to see if the result is going to be shorter in this example.

0 Kudos
JVanB
Valued Contributor II
2,207 Views

Now that you've got everything working more or less to your satisfaction, the obvious thing to do is do tear everything up and start over from scratch! In your final version when you do the last assignment to c, 10001 elements will be copied no matter how many are actually nonzero. If instead you switched to a subroutine interface, the results could be placed in their ultimate destination as they are generated, so there would be no need to do all that copying provided that you knew a reasonably good upper bound on the size of the output when you started the operation. Probably I would change over to a user defined type so different types of things weren't mixed up in the same array.

type MyBigInt

   integer NUsed

   integer Sign

   integer, allocatable :: Data(:)

end type MyBigInt

Now when you are going to compute c = a+b, you know to allocate(c%Data(max(a%NUsed,b%NUsed)+1)) and then you can put the result in c%Data as you figure it out and then set c%NUsed and c%Sign appropriately. All this could be taken care of inside subroutine xadd, so all your main code would see is call xadd(c,a,b) ! c = a+b

 

 

0 Kudos
jimdempseyatthecove
Honored Contributor III
2,207 Views

Also note, if you use user defined types, you can also create operators for these types such that you can use

c = a + b

as well as

c = a + 12345

Jim Dempsey

0 Kudos
JVanB
Valued Contributor II
2,207 Views

To expand on what jimdempseyatthecove said (BTW, what kind of monitor do you have? 4k rules, as you noted previously) I tried:

module M
   use ISO_FORTRAN_ENV
   implicit none
   private
   type, public :: MyBigInt
      integer NUsed
      integer Sign
      integer(INT8), allocatable :: Data(:)
   end type MyBigInt
   public operator(+)
   interface operator(+)
      module procedure plus
   end interface operator(+)
   contains
      function plus(a,b)
         type(MyBigInt), intent(in) :: a, b
         type(MyBigInt) plus
         integer(kind(plus%Data)) carry
         integer i

         if(a%Sign /= b%Sign) then
! Insert logic to handle subtraction
         else
            plus%Sign = a%Sign
            allocate(plus%Data(max(a%NUsed,b%NUsed)+1))
            carry = 0
            do i = 1, min(a%Nused,b%NUsed)
               carry = carry+a%Data(i)+b%Data(i)
               plus%Data(i) = modulo(carry,10)
               carry = carry/10
            end do
            if(a%NUsed > b%NUsed) then
               do i = i, a%NUsed
                  carry = carry+a%Data(i)
                  plus%Data(i) = modulo(carry,10)
                  carry = carry/10
               end do
            else if(b%NUsed > a%NUsed) then
               do i = i, b%NUsed
                  carry = carry+b%Data(i)
                  plus%Data(i) = modulo(carry,10)
                  carry = carry/10
               end do
            end if
            if(carry == 0) then
               plus%NUsed = i-1
            else
               plus%NUsed = i
               plus%Data(i) = carry
            end if
         end if
      end function plus
end module M

program P
   use M
   use ISO_FORTRAN_ENV
   implicit none
   type(MyBigInt) a, b, c
   integer i
   integer(INT8) temp
   a%Sign = 1 ! Positive
   a%NUsed = 13
   allocate(a%Data(a%NUsed))
   temp = 3
   do i = 1, a%NUsed
      a%Data(i) = temp
      temp = modulo(3*temp,10)
   end do
   write(*,*) 'a = ',merge('-','+',a%Sign == -1),a%Data(1:a%NUsed)
   b%Sign = 1 ! Positive
   b%NUsed = 17
   allocate(b%Data(b%NUsed))
   temp = 7
   do i = 1, b%NUsed
      b%Data(i) = temp
      temp = modulo(7*temp,10)
   end do
   write(*,*) 'b = ',merge('-','+',b%Sign == -1),b%Data(1:b%NUsed)
   c = a+b
   write(*,*) 'c = ',merge('-','+',c%Sign == -1),c%Data(1:c%NUsed)
end program P

And gfortran said:

 a = +    3    9    7    1    3    9    7    1    3    9    7    1    3
 b = +    7    9    3    1    7    9    3    1    7    9    3    1    7    9
3    1    7
 c = +    0    9    1    3    0    9    1    3    0    9    1    3    0    0
4    1    7

But ifort died on this code. I suppose functions that return results with allocatable components are not yet implemented or something?

 

0 Kudos
mecej4
Honored Contributor III
2,207 Views

If you change Line-18 to integer(INT8) carry, IFort 15.0.1 will succeed. Probably a compiler bug. 

Another minor point: the intrinsic function MODULO requires both arguments to be of the same kind, according to the compiler documentation.

0 Kudos
jimdempseyatthecove
Honored Contributor III
2,207 Views

RO,

I have a Seiki 39" 4K TV. Image quality is excellent. The viewing area and pixel count is equivalent to four "HD" tiled together (without bezels). The only downside is the firmware is very sensitive to timing. Occasionally the screen will blank out then come back in 2-3 seconds. I think the firmware thought it lost connection. The upside is it was affordable. All together I won't go back to multiple monitors, unless they are all 4K.

Great job on the operator(+). It would be relatively easy to use a parameter for the type used for the internal accumulator element. If, for example, you were most interested in high performance computation as opposed to conversion speed to/from the variable integer type, then I would suggestion using INT64. You an compute the carry relatively easy. Something like this untested code

c%data(i) = a%data(i) + b%data(i) + carry
if(iand(a%data(i), b%data(i)) < 0) then
  carry = 1
else if(iand(ior(a%data(i), b%data(i)), not(c%data(i)) < 0) then
  carry = 1
else
  carry = 0
endif

Jim Dempsey

 

0 Kudos
mecej4
Honored Contributor III
2,207 Views

For decimal floating point arithmetic with limited precision (7, 16 and 34 digits for DECIMAL32, DECIMAL64 and DECIMAL128), which is covered by the IEEE Standard 754-2008, Intel provides a build  package at  https://software.intel.com/en-us/articles/intel-decimal-floating-point-math-library . The library is provided in source form with makefiles and test problems, and is in C.

If the user is certain that 34 digits will suffice for the entire calculation, using the library would have the advantages of higher speed and smaller memory use for variables. The disadvantage would be that  is there no Fortran API provided.

0 Kudos
WSinc
New Contributor I
2,207 Views

Also, if I use mixed signs, I can USE PLUS for the MINUS function. I just have to reverse the sign first.

0 Kudos
WSinc
New Contributor I
2,105 Views

I dont understand quote #14.

 

I ran some simple tests, and see no evidence that any other elements get copied, besides the ones I am working with.

0 Kudos
Reply