equivalent of LOC

[abhimodak]

This question is "out of scope" for Intel Fortran. But I am just taking a chance....

Since IVF still doesn't support procedure pointers and type bound procedures, I have been using the Cray style pointers, as suggested by Steve,to fake this. I used intrinsic function LOC to get the address of an external procedure.

However, the other platform that we need to support is IBM and unfortunately LOC intrinsic on that platform is not valid for external procedures. Does anyody know a "common set" that can be used on these two platforms to mimick procedure pointers and type bound procedures?

Abhi

[Steven_L_Intel1]

Does the IBM compiler support passing a variable by value? Which IBM compiler are you using? xlf is ahead of Intel Fortran in F2003 support.

[jimdempseyatthecove]

Abhi,

Considerusing the attribute external. From my QuickThread tool see how the test are run by way of address of function.

Look downnear bottom of code for call to RunTest(...) then look at interface in module (sorry about tabbing as paste code removes that)

This would require some adaptaton to call proceedures (as seperate process in seperate address space) but the sample code should a good basis for how you would do this.

Jim Dempsey

! SimpleArray.f90 
!
! FUNCTIONS:
! SimpleArray - Entry point of console application.
!
!****************************************************************************
!
! PROGRAM: SimpleArray
!
! PURPOSE: Entry point for the console application.
!
!****************************************************************************
module SimpleArray_moduse PerformanceCounteruse QuickThreadInterfaces! Declare application Performance Countertype(T_PERFORMANCECOUNTER) :: ThePerformanceCounterinteger :: ArraySizeinteger :: ArraySizeBegin = 1000integer :: ArraySizeLimit = 1000000! TestRunTimeDesired! Number of seconds of run time desired for single threaded testreal(8) :: TestRunTimeDesired = 10.real(8) :: SingleThreadedRunTime! NumberOfIterations! Calculated at initialization to produce single threaded run time! of TestRunTimeDesired secondsinteger :: NumberOfIterations! isTemporal = .true. if array processing has temporal characteristics! isTemporal = .false. if array processing has no temporal characteristicslogical :: isTemporalreal(8), allocatable :: A(:) ! Allocated to ArraySizereal(8), allocatable :: B(:) ! Allocated to ArraySizereal(8), allocatable
 :: C(:) ! Allocated to ArraySize! Declare the interface to your copy of QuickThreadQueueMainTemplateinterfaceinteger(DWORD) function QueueMain(MainCode)use kernel32implicit nonelogical, external :: MainCodeend function QueueMainend interfaceinterfacesubroutine RunTest(Test, isQuickThread, Name)external :: Testlogical :: isQuickThreadcharacter*(*) :: Nameend subroutine RunTestend interface! Define interface to DoSimpleArraySliceinterfacesubroutine DoSimpleArraySlice(iFrom, iTo)
!DEC$ ATTRIBUTES VALUE :: iFrominteger :: iFrom
!DEC$ ATTRIBUTES VALUE :: iTointeger :: iToend subroutine DoSimpleArraySliceend interface
end module SimpleArray_mod
program SimpleArrayuse SimpleArray_modimplicit none! Variablesinteger :: i, jreal(8) :: SingleThreadRunTimeInSecondsreal(8) :: OpenMPRunTimeInSecondsreal(8) :: QuickThreadRunTimeInSecondsreal(8) :: PerformanceGain! Test subroutinesexter
nal :: SingleThreadTestexternal :: OpenMPTestexternal :: QuickThreadTest! Body of SimpleArraywrite(*,*) 'SimpleArray'write(*,*) 'Specified runtime', TestRunTimeDesiredwrite(*,*) ''
ArraySize = 0do while(ArraySize .lt. ArraySizeLimit)if(ArraySize .eq. 0) then
ArraySize = ArraySizeBeginelse
ArraySize = min(ArraySize*2, ArraySizeLimit)endifwrite(*,*) 'ArraySize = ', ArraySize! allocate the arraysallocate(A(ArraySize))allocate(B(ArraySize))allocate(C(ArraySize))! initialize arrays B and C to random numberscall RANDOM_NUMBER(B)call RANDOM_NUMBER(C)! Calibrate iteration count to produce a single threaded! run time of TestRunTimeDesired seconds! Perform calibration after allocation and initialization of arrayscall CalibrateRuntime
SingleThreadedRunTime = 0.call RunTest(SingleThreadTest, .false., "Single Threaded")call RunTest(OpenMPTest, .false., "OpenMP")
isTemporal = .true.write(*,*) "Temporal", isTemporalcall RunTest(QuickThreadTest, .true., "QuickThread")
isTemporal = .false.write(*,*) "Temporal", isTemporalcall RunTest(QuickThreadTest, .true., "QuickThread")! return memorydeallocate(A)deallocate(B)deallocate(C)end do
!DEC$ IF DEFINED(_DEBUG)! If debugging, pause to permit reading of console window before exitwrite(*,*) ""pause
!DEC$ ENDIF
end program SimpleArray
! Calibrate iteration count to produce a single threaded
! run time of TestRunTimeDesired seconds
subroutine CalibrateRuntimeuse SimpleArray_modimplicit none! Initialize the Performance Counter codecall PerformanceCounterInit
ThePerformanceCounter.RunTimeInSeconds = 0.
NumberOfIterations = 1do while(ThePerformanceCounter.RunTimeInSeconds .lt. 0.5)! First order Estimation accuracy to ~1%! Make a run of NumberOfIterationscall PerformanceCounterStart(ThePerformanceCounter)call SingleThreadTestcall PerformanceCounterEnd(ThePerformanceCounter)! Compute the number of iterations to run for 1 second
NumberOfIterations = int(dble(NumberOfIterations) * 1.0_8 / ThePerformanceCounter.RunTimeInSeconds)end do! Compute the number of iterations to run for TestRunTimeDesired
NumberOfIterations = int(dble(NumberOfIterations) * TestRunTimeDesired / ThePerformanceCounter.RunTimeInSeconds)
end subroutine CalibrateRuntime
subroutine RunTest(Test, isQuickThread, Name)use SimpleArray_modimplicit noneexternal :: Testlogical :: isQuickThreadcharacter
*(*) :: Nameinteger :: iTrashwrite(*,100) Name
100 format(A15,' ',$)call PerformanceCounterStart(ThePerformanceCounter)if(isQuickThread) then! ignore error
iTrash = QueueMain(Test)elsecall Testendifcall PerformanceCounterEnd(ThePerformanceCounter)if(SingleThreadedRunTime .eq. 0.) SingleThreadedRunTime = ThePerformanceCounter.RunTimeInSecondswrite(*,200) ThePerformanceCounter.RunTimeInSeconds, (SingleThreadedRunTime / ThePerformanceCounter.RunTimeInSeconds) * 100.0_8
200 format(F15.12, F15.9,'%')
end subroutine RunTest
subroutine SingleThreadTestuse SimpleArray_modimplicit none! Local Variablesinteger :: i, j! Codedo i=1, NumberOfIterationsdo j=1, size(A)
A(j) = B(j) + C(j)end doend do
end subroutine SingleThreadTest
subroutine OpenMPTestuse SimpleArray_modimplicit none! Local Variablesinteger :: i, j! Codedo i=1, NumberOfIterations
!$OMP PARALLEL DOdo j=1, size(A)
A(j) = B(j) + C(j)end do
!$OMP END PARALLEL DOend do
end subroutine OpenMPTest
subroutine QuickThreadTestuse SimpleArray_moduse QuickThreadInterfacesimplicit none! Local Variables! Stack local control structuretype(T_QuickThreadControlStructure) :: qtControlinteger :: i! codedo i=1, NumberOfIterations! Slice the array processing by number of worker threads! across range of 1 to size of array A (B, and C)call QuickThreadQueueDo(qtControl, DoSimpleArraySlice, 1, size(A))if(isTemporal) call QuickThreadWaitTillDone(qtControl)end doif(.not. isTemporal) call QuickThreadWaitTillDone(qtControl)
end subroutine QuickThreadTest
! DoSimpleArraySlice
! Perform work on slice of arrays A, B, and C
subroutine DoSimpleArraySlice(iFrom, iTo)use SimpleArray_modimplicit none
!DEC$ ATTRIBUTES VALUE :: iFrominteger :: iFrom
!DEC$ ATTRIBUTES VALUE :: iTointeger :: iTo! Local Variablesinteger :: jdo j=iFrom, iTo
A(j) = B(j) + C(j)end do
end subroutine DoSimpleArraySlice

[abhimodak]

Hi Steve and Jim

Thanks for you answer.

Attached code snippet shows exactly what I am trying to do.

I (sadly) know that XLF is way ahead of Intel Fortran but I must usethe same code on both platforms.

Function %VAL and %REF are available on IBM. LOC is also available but unlike Intel, it cannot be used for a procedure. IBM cannot use cray pointers with procedure name either.

I will try to understand Jim's code.

Sincerely

Abhi