PROGRAM ItDependsOnTheDummyArgument
!
!  IanH  Feb 12, 2014
!
      IMPLICIT NONE
 
      INTEGER*4 :: array(10,5)
      integer*8 :: loc_array
      character :: comment*20
 
      array = 0
      loc_array = LOC (array(3,:))
 
!  If a temporary is created for a call, then the LOC of the dummy argument
!  will be different from the LOC of the actual argument.
!  NOTE address of array indicates it is not on the stack used for temporary copies
 
      PRINT "('In main program, LOC(array(3,:)) is ',T45,I0)", LOC (array(3,:))
 
      CALL AssumedShape  (array(3,:))
 
      CALL ExplicitShape (array(3,:), SIZE(array, 2))
 
      CALL AssumedSize   (array(3,:), SIZE(array, 2))
 
      CONTAINS
 
        SUBROUTINE AssumedShape (arg)
 
          INTEGER, INTENT(IN) :: arg(:)
          integer i
 
          comment = ' Same array' ; if (LOC(arg) /= loc_array) comment = ' copy of array'
          PRINT "(/'In DeferredShape, LOC(arg) is ',T45,i0,2x,i0,a)", LOC(arg), LOC(arg)-loc_array, comment
          write (*,'(a,4i8,a)') '  Test Spacing=', (loc(arg(i))-loc(arg(i-1)), i=2,size(arg)),' NOT contiguous !!'

! both these calls transfer the array arg as seen locally, if declared as arg(:)
          call check_contiguous ( arg, size(arg), ' arg, size(arg)' )
          call check_contiguous ( arg(:), size(arg), ' arg(:), size(arg)' )
          call check_contiguous_n ( arg(:), size(arg) )

        END SUBROUTINE AssumedShape
 
        SUBROUTINE ExplicitShape (arg, n)
 
          INTEGER, INTENT(IN) :: n
          INTEGER, INTENT(IN) :: arg(n)
          integer i
 
          comment = ' Same array' ; if (LOC(arg) /= loc_array) comment = ' copy of array'
          PRINT "(/'In ExplicitShape, LOC(arg) is ',T45,i0,2x,i0,a)", LOC(arg), LOC(arg)-loc_array, comment
          write (*,'(a,4i8)') '  Test Spacing=', (loc(arg(i))-loc(arg(i-1)), i=2,size(arg))
          call check_contiguous ( arg, size(arg), ' arg, size(arg)' )
 
        END SUBROUTINE ExplicitShape
 
        SUBROUTINE AssumedSize (arg, n)
 
          INTEGER, INTENT(IN) :: n
          INTEGER, INTENT(IN) :: arg(*)
          integer i
 
          comment = ' Same array' ; if (LOC(arg) /= loc_array) comment = ' copy of array'
          PRINT "(/'In AssumedSize, LOC(arg) is ',T45,i0,2x,i0,a)", LOC(arg), LOC(arg)-loc_array, comment
          write (*,'(a,4i8)') '  Test Spacing=', (loc(arg(i))-loc(arg(i-1)), i=2,n)
          call check_contiguous ( arg(1:n), n, ' arg(1:n), size(arg)' )
 
        END SUBROUTINE AssumedSize
 
        SUBROUTINE check_contiguous (arg, n, desc)
 
          INTEGER, INTENT(IN) :: n
          INTEGER, INTENT(IN) :: arg(:)
          character*(*) :: desc
          integer i
 
          write (*,'(a,4i8,a)') '   chk Spacing=', (loc(arg(i))-loc(arg(i-1)), i=2,n), desc
        END SUBROUTINE check_contiguous
 
        SUBROUTINE check_contiguous_n (arg, n)
 
          INTEGER, INTENT(IN) :: n
          INTEGER, INTENT(IN) :: arg(n)
          integer i
 
          write (*,'(a,4i8)') '  nchk Spacing=', (loc(arg(i))-loc(arg(i-1)), i=2,n)
        END SUBROUTINE check_contiguous_n
 
      END PROGRAM ItDependsOnTheDummyArgument
 
