This Fortran program is an example of the use of LAPI_PUT and LAPI_GET:
/* Putf.f */
INCLUDE 'lapif.h'
INTEGER T_HNDL, T_INFO(10)
INTEGER TASKID, NUMTASKS
INTEGER T_BUF(10)
INTEGER L_CNTR, T_CNTR, C_CNTR
INTEGER GLOBAL_ADDR(2)
INTEGER TGT_ADDR(2)
INTEGER LOOP, IERROR, TGT, TGT2, VAL, CUR_VAL, LENGTH
INTEGER T_ADDR
INTEGER ERR_MSG_BUF(40)
c Not registering error handler function
CALL LAPI_ADDRESS(LAPI_ADDR_NULL, T_ADDR, IERROR)
T_INFO(7) = T_ADDR
CALL LAPI_INIT(T_HNDL, T_INFO, IERROR)
IF (IERROR .NE. LAPI_SUCCESS) THEN
VAL = IERROR
CALL LAPI_MSG_STRING(VAL, ERR_MSG_BUF, IERROR)
WRITE(6,*)'Error Message ',IERROR
STOP 1
ENDIF
c GET task number and number of tasks in job
CALL LAPI_QENV(T_HNDL, TASK_ID, TASKID, IERROR)
CALL LAPI_QENV(T_HNDL, NUM_TASKS, NUMTASKS, IERROR)
c Turn off parameter checking - default is on
VAL=0
CALL LAPI_SENV(T_HNDL, ERROR_CHK, VAL, IERROR)
c Initialize counters to be zero at the start
CALL LAPI_SETCNTR(T_HNDL, L_CNTR, VAL, IERROR)
CALL LAPI_SETCNTR(T_HNDL, T_CNTR, VAL, IERROR)
CALL LAPI_SETCNTR(T_HNDL, C_CNTR, VAL, IERROR)
IF (NUMTASKS .eq. 2) THEN
c Run only if number of tasks equal 2
c Exchange buffer address to every task - Collective call
CALL LAPI_ADDRESS(T_BUF, T_ADDR, IERROR)
CALL LAPI_ADDRESS_INIT(T_HNDL,T_ADDR,GLOBAL_ADDR,IERROR)
CALL LAPI_ADDRESS(T_CNTR, T_ADDR, IERROR)
CALL LAPI_ADDRESS_INIT(T_HNDL,T_ADDR,TGT_ADDR,IERROR)
c Task id is 0 , Origin
IF (TASKID .eq. 0) THEN
TGT = TASKID + 1
c Buffer in Fortran start at 1 and not 0
TGT2 = TGT + 1
LENGTH = 10*4
DO LOOP = 1, 10
c Update buffer
T_BUF(LOOP) = TASKID - LOOP;
ENDDO
c Global FENCE to sync before starting
CALL LAPI_GFENCE(T_HNDL, IERROR)
c Issue PUT from origin to target
CALL LAPI_PUT(T_HNDL,TGT,LENGTH,GLOBAL_ADDR(TGT2),
1 T_BUF, TGT_ADDR(TGT2),
2 L_CNTR, C_CNTR, IERROR)
VAL = 1
CALL LAPI_WAITCNTR(T_HNDL, L_CNTR, VAL,
1 LAPI_ADDR_NULL, IERROR)
c Local buffer can be reused now
DO LOOP = 1, 10
T_BUF(LOOP) = TGT2;
ENDDO
VAL = 1
CALL LAPI_WAITCNTR(T_HNDL, C_CNTR, VAL,
1 LAPI_ADDR_NULL, IERROR)
c Issue GET from origin to target
CALL LAPI_GET(T_HNDL,TGT,LENGTH,GLOBAL_ADDR(TGT2),
1 T_BUF, TGT_ADDR(TGT2),
2 L_CNTR, IERROR)
VAL = 1
CALL LAPI_WAITCNTR(T_HNDL, L_CNTR, VAL,
1 LAPI_ADDR_NULL, IERROR)
WRITE(6,*) "Node ",TASKID,
1 "done issuing GET from node ", TGT
WRITE(6,*) "Result of GET from node ", TGT
DO LOOP = 1, 10
WRITE(6,*) "T_BUF(",LOOP,") = ", T_BUF(LOOP)
ENDDO
c Task id is 1 , Target
ELSEIF (TASKID .eq. 1) THEN
TGT = TASKID - 1
DO LOOP = 1, 10
c Zero out buffer
T_BUF(LOOP) = 0
ENDDO
VAL = 0
c Global FENCE to sync before starting
CALL LAPI_GFENCE(T_HNDL, IERROR)
CALL LAPI_GETCNTR(T_HNDL, T_CNTR, VAL, IERROR)
DO WHILE (VAL .LT. 1)
c Can Do some work
CALL LAPI_PROBE(T_HNDL, IERROR)
CALL LAPI_GETCNTR(T_HNDL, T_CNTR, VAL, IERROR)
ENDDO
WRITE(6,*) "Result of Put from ",TGT, ":"
DO LOOP = 1, 10
WRITE(6,*) "T_BUF(",LOOP,") = ", T_BUF(LOOP)
ENDDO
c To clear the T_CNTR VALue
VAL = 1
CALL LAPI_WAITCNTR(T_HNDL, T_CNTR, VAL, CUR_VAL, IERROR)
WRITE(6,*) "Node ", TASKID,
1 "done doing work and processing PUT"
VAL = 0
CALL LAPI_GETCNTR(T_HNDL, T_CNTR, VAL, IERROR)
DO WHILE (VAL .LT. 1)
c Can Do some work
CALL LAPI_PROBE(T_HNDL, IERROR)
CALL LAPI_GETCNTR(T_HNDL, T_CNTR, VAL, IERROR)
ENDDO
c To clear the T_CNTR VALue
VAL = 1
CALL LAPI_WAITCNTR(T_HNDL, T_CNTR, VAL, CUR_VAL, IERROR)
WRITE(6,*) "Node ", TASKID,
1 "done doing work and processing GET"
ENDIF
ENDIF
c Global FENCE to sync before terminating job
CALL LAPI_GFENCE(T_HNDL, IERROR)
CALL LAPI_TERM(T_HNDL, IERROR)
END