|Using LAPI_Rmw64 is like using LAPI_Rmw, with the |following exceptions: |
This Fortran program is an example of LAPI_RMW (read/write/modify function):
/* Rmwf.f */
INCLUDE 'lapif.h'
INTEGER T_HNDL, T_INFO(10)
INTEGER TASKID, NUMTASKS
INTEGER T_BUF, T2_BUF, PREV_TGT_VAL
INTEGER L_CNTR, T_CNTR
INTEGER GLOBAL_ADDR(2)
INTEGER TGT_ADDR(2)
INTEGER LOOP, IERROR, TGT, TGT2, VAL, CUR_VAL, LENGTH
INTEGER T_ADDR, TIME_OUT, INTR_SET
INTEGER ERR_MSG_BUF(40)
c Not registering error handler function
DO I = 1, 10
T_INFO(I) = 0
ENDDO
CALL LAPI_ADDRESS(MY_ERR_HNDLR, 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)
CALL LAPI_QENV(T_HNDL, TIMEOUT, TIME_OUT, IERROR)
CALL LAPI_QENV(T_HNDL, INTERRUPT_SET, INTR_SET, IERROR)
IF (TIME_OUT .gt. 30) THEN
VAL = 15
CALL LAPI_SENV(T_HNDL, TIMEOUT, VAL, IERROR)
ENDIF
IF (INTR_SET .eq. 1) THEN
c Turn off interrupts
VAL = 0
CALL LAPI_SENV(T_HNDL, INTERRUPT_SET, VAL, IERROR)
ENDIF
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
c Get INTEGER size buffer
LENGTH = 4
c Initial value to add at target
T_BUF = 1
c Global FENCE to sync before starting
CALL LAPI_GFENCE(T_HNDL, IERROR)
c Issue RMW from origin to target
CALL LAPI_RMW(T_HNDL, FETCH_AND_ADD, TGT,
1 GLOBAL_ADDR(TGT2), T_BUF,
2 PREV_TGT_VAL, L_CNTR, IERROR)
VAL = 1
CALL LAPI_WAITCNTR(T_HNDL, L_CNTR, VAL,
1 CUR_VAL, IERROR)
WRITE(6,*) "Node ",TASKID,
1 "done issuing RMW from node ", TGT
c Issue GET from origin to target
CALL LAPI_GET(T_HNDL,TGT,LENGTH,GLOBAL_ADDR(TGT2),
1 T2_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
VAL = T_BUF + PREV_TGT_VAL
WRITE(6,*) "Correct value should be ",VAL,
1 " = ", T2_BUF
c Task id is 1 , Target
ELSEIF (TASKID .eq. 1) THEN
TGT = TASKID - 1
c Set initial buffer value
T_BUF = 5
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
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
SUBROUTINE MY_ERR_HNDLR (HNDL, ERROR_CODE, ERR_TYPE,
1 TASKID, SRC)
INCLUDE "lapif.h"
INTEGER BUF(40)
WRITE(6,*) "In my error handler, HNDL=",HNDL,
1 " ERROR_CODE=",ERROR_CODE," ERR_TYPE=",ERR_TYPE,
2 " TASKID=",TASKID," SRC=",SRC
CALL LAPI_MSG_STRING(ERROR_CODE, BUF, IERROR)
WRITE(6,*) "In my error handler, error code = ", ERROR_CODE
IF (ERROR_CODE .ne. LAPI_ERR_TIMEOUT) THEN
c Cause program to exit
STOP 2
ENDIF
RETURN
END