Skip to content

Commit

Permalink
GPU offload support added for FIELD_XX_BUFFER utils
Browse files Browse the repository at this point in the history
  • Loading branch information
@awnawab
awnawab committed Sep 12, 2023
1 parent a0363ae commit 6d4a19e
Show file tree
Hide file tree
Showing 4 changed files with 189 additions and 92 deletions.
146 changes: 98 additions & 48 deletions field_buffer_module.fypp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -40,8 +40,8 @@ CONTAINS
PROCEDURE :: GET_HOST_DATA_RDWR => ${ftn}$_GET_HOST_DATA_RDWR
PROCEDURE :: SYNC_HOST_RDWR => ${ftn}$_SYNC_HOST_RDWR
PROCEDURE :: SYNC_HOST_RDONLY => ${ftn}$_SYNC_HOST_RDONLY
#! PROCEDURE :: SYNC_DEVICE_RDWR => ${ftn}$_SYNC_DEVICE_RDWR
#! PROCEDURE :: SYNC_DEVICE_RDONLY => ${ftn}$_SYNC_DEVICE_RDONLY
PROCEDURE :: SYNC_DEVICE_RDWR => ${ftn}$_SYNC_DEVICE_RDWR
PROCEDURE :: SYNC_DEVICE_RDONLY => ${ftn}$_SYNC_DEVICE_RDONLY
END TYPE ${ftn}$

#:endfor
Expand All @@ -50,14 +50,15 @@ CONTAINS

#:for ft in fieldTypeList
#:set ftn = ft.name + '_BUFFER'
SUBROUTINE ${ftn}$_INIT_WRAPPER(SELF, NUM_FIELDS, FIELDS, DATA, CONTIG_FIELDS, PERSISTENT)
SUBROUTINE ${ftn}$_INIT_WRAPPER(SELF, NUM_FIELDS, FIELDS, DATA, LBOUNDS, CONTIG_FIELDS, PERSISTENT)
CLASS(${ftn}$) :: SELF
INTEGER(KIND=JPIM), INTENT(IN) :: NUM_FIELDS
TYPE(${f'FIELD_{ft.rank-1}{ft.suffix}'}$_PTR), TARGET, INTENT(INOUT) :: FIELDS(NUM_FIELDS)

${ft.type}$, TARGET, INTENT(IN) :: DATA(${ft.shape}$)
LOGICAL, INTENT(IN), OPTIONAL :: CONTIG_FIELDS, PERSISTENT
INTEGER(KIND=JPIM) :: LBOUNDS(${ft.rank}$)
INTEGER(KIND=JPIM), INTENT(IN), OPTIONAL :: LBOUNDS(${ft.rank}$)
INTEGER(KIND=JPIM) :: LLBOUNDS(${ft.rank}$)
LOGICAL :: LLPERSISTENT

SELF%NUM_FIELDS = NUM_FIELDS
Expand All @@ -83,14 +84,15 @@ SUBROUTINE ${ftn}$_INIT_WRAPPER(SELF, NUM_FIELDS, FIELDS, DATA, CONTIG_FIELDS, P
ENDIF

!...Set lower bounds
LBOUNDS = LBOUND(DATA)
LLBOUNDS(:) = 1
IF(PRESENT(LBOUNDS)) LLBOUNDS = LBOUNDS
IF(SELF%CONTIG_FIELDS)THEN
LBOUNDS(${ft.rank}$) = 1
LLBOUNDS(${ft.rank}$) = 1
ELSE
LBOUNDS(${ft.rank-1}$) = 1
LLBOUNDS(${ft.rank-1}$) = 1
ENDIF

CALL FIELD_NEW(SELF%BUFFER, DATA=DATA, LBOUNDS=LBOUNDS, PERSISTENT=LLPERSISTENT)
CALL FIELD_NEW(SELF%BUFFER, DATA=DATA, LBOUNDS=LLBOUNDS, PERSISTENT=LLPERSISTENT)
CALL SELF%ASSIGN_FIELDS(FIELDS, LLPERSISTENT)
SELF%FIELDS => FIELDS

Expand Down Expand Up @@ -176,100 +178,84 @@ SUBROUTINE ${ftn}$_ASSIGN_FIELDS(SELF, FIELDS, PERSISTENT)

END SUBROUTINE ${ftn}$_ASSIGN_FIELDS

SUBROUTINE ${ftn}$_GET_HOST_DATA_RDWR(SELF, PPTR, QUEUE, FIELDS)
SUBROUTINE ${ftn}$_GET_HOST_DATA_RDWR(SELF, PPTR, QUEUE)
CLASS(${ftn}$), INTENT(INOUT) :: SELF
${ft.type}$, POINTER, INTENT(INOUT) :: PPTR(${ft.shape}$)
INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: QUEUE
TYPE(${f'FIELD_{ft.rank}{ft.suffix}'}$_VIEW), INTENT(OUT), OPTIONAL :: FIELDS(:)
INTEGER(KIND=JPIM) :: IFIELD

CALL SELF%BUFFER%GET_HOST_DATA_RDWR(PPTR, QUEUE=QUEUE)

IF(PRESENT(FIELDS))THEN
IF(SELF%CONTIG_FIELDS)THEN
#:set ar = (',').join([':' for _ in range(0, ft.rank-1)])
DO IFIELD=1,SELF%NUM_FIELDS
FIELDS(IFIELD)%P => PPTR(${ar}$,IFIELD)
ENDDO
ELSE
#:set ar = (',').join([':' for _ in range(0, ft.rank-2)])
DO IFIELD=1,SELF%NUM_FIELDS
FIELDS(IFIELD)%P => PPTR(${ar}$,IFIELD,:)
ENDDO
ENDIF
ENDIF
DO IFIELD=1,SELF%NUM_FIELDS
SELF%FIELDS(IFIELD)%PTR%ISTATUS = SELF%BUFFER%ISTATUS
ENDDO

END SUBROUTINE ${ftn}$_GET_HOST_DATA_RDWR

SUBROUTINE ${ftn}$_GET_DEVICE_DATA_RDWR(SELF, PPTR, QUEUE, FIELDS)
SUBROUTINE ${ftn}$_GET_DEVICE_DATA_RDWR(SELF, PPTR, QUEUE)
CLASS(${ftn}$), INTENT(INOUT) :: SELF
${ft.type}$, POINTER, INTENT(INOUT) :: PPTR(${ft.shape}$)
INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: QUEUE
TYPE(${f'FIELD_{ft.rank}{ft.suffix}'}$_VIEW), INTENT(OUT), OPTIONAL :: FIELDS(:)
INTEGER(KIND=JPIM) :: IFIELD

CALL SELF%BUFFER%GET_DEVICE_DATA_RDWR(PPTR, QUEUE=QUEUE)

IF(PRESENT(FIELDS))THEN
DO IFIELD=1,SELF%NUM_FIELDS
SELF%FIELDS(IFIELD)%PTR%ISTATUS = SELF%BUFFER%ISTATUS
ENDDO

IF(.NOT. ASSOCIATED(SELF%FIELDS(1)%PTR%DEVPTR))THEN
IF(SELF%CONTIG_FIELDS)THEN
#:set ar = (',').join([':' for _ in range(0, ft.rank-1)])
DO IFIELD=1,SELF%NUM_FIELDS
FIELDS(IFIELD)%P => PPTR(${ar}$,IFIELD)
SELF%FIELDS(IFIELD)%PTR%DEVPTR => SELF%BUFFER%DEVPTR(${ar}$,IFIELD)
ENDDO
ELSE
#:set ar = (',').join([':' for _ in range(0, ft.rank-2)])
DO IFIELD=1,SELF%NUM_FIELDS
FIELDS(IFIELD)%P => PPTR(${ar}$,IFIELD,:)
SELF%FIELDS(IFIELD)%PTR%DEVPTR => SELF%BUFFER%DEVPTR(${ar}$,IFIELD,:)
ENDDO
ENDIF
ENDIF

END SUBROUTINE ${ftn}$_GET_DEVICE_DATA_RDWR

SUBROUTINE ${ftn}$_GET_HOST_DATA_RDONLY(SELF, PPTR, QUEUE, FIELDS)
SUBROUTINE ${ftn}$_GET_HOST_DATA_RDONLY(SELF, PPTR, QUEUE)
CLASS(${ftn}$), INTENT(INOUT) :: SELF
${ft.type}$, POINTER, INTENT(INOUT) :: PPTR(${ft.shape}$)
INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: QUEUE
TYPE(${f'FIELD_{ft.rank}{ft.suffix}'}$_VIEW), INTENT(OUT), OPTIONAL :: FIELDS(:)
INTEGER(KIND=JPIM) :: IFIELD

CALL SELF%BUFFER%GET_HOST_DATA_RDONLY(PPTR, QUEUE=QUEUE)

IF(PRESENT(FIELDS))THEN
IF(SELF%CONTIG_FIELDS)THEN
#:set ar = (',').join([':' for _ in range(0, ft.rank-1)])
DO IFIELD=1,SELF%NUM_FIELDS
FIELDS(IFIELD)%P => PPTR(${ar}$,IFIELD)
ENDDO
ELSE
#:set ar = (',').join([':' for _ in range(0, ft.rank-2)])
DO IFIELD=1,SELF%NUM_FIELDS
FIELDS(IFIELD)%P => PPTR(${ar}$,IFIELD,:)
ENDDO
ENDIF
ENDIF
DO IFIELD=1,SELF%NUM_FIELDS
SELF%FIELDS(IFIELD)%PTR%ISTATUS = SELF%BUFFER%ISTATUS
ENDDO

END SUBROUTINE ${ftn}$_GET_HOST_DATA_RDONLY

SUBROUTINE ${ftn}$_GET_DEVICE_DATA_RDONLY(SELF, PPTR, QUEUE, FIELDS)
SUBROUTINE ${ftn}$_GET_DEVICE_DATA_RDONLY(SELF, PPTR, QUEUE)
CLASS(${ftn}$), INTENT(INOUT) :: SELF
${ft.type}$, POINTER, INTENT(INOUT) :: PPTR(${ft.shape}$)
INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: QUEUE
TYPE(${f'FIELD_{ft.rank}{ft.suffix}'}$_VIEW), INTENT(OUT), OPTIONAL :: FIELDS(:)
INTEGER(KIND=JPIM) :: IFIELD

CALL SELF%BUFFER%GET_DEVICE_DATA_RDONLY(PPTR, QUEUE=QUEUE)

IF(PRESENT(FIELDS))THEN
DO IFIELD=1,SELF%NUM_FIELDS
SELF%FIELDS(IFIELD)%PTR%ISTATUS = SELF%BUFFER%ISTATUS
ENDDO

IF(.NOT. ASSOCIATED(SELF%FIELDS(1)%PTR%DEVPTR))THEN
IF(SELF%CONTIG_FIELDS)THEN
#:set ar = (',').join([':' for _ in range(0, ft.rank-1)])
DO IFIELD=1,SELF%NUM_FIELDS
FIELDS(IFIELD)%P => PPTR(${ar}$,IFIELD)
SELF%FIELDS(IFIELD)%PTR%DEVPTR => SELF%BUFFER%DEVPTR(${ar}$,IFIELD)
ENDDO
ELSE
#:set ar = (',').join([':' for _ in range(0, ft.rank-2)])
DO IFIELD=1,SELF%NUM_FIELDS
FIELDS(IFIELD)%P => PPTR(${ar}$,IFIELD,:)
SELF%FIELDS(IFIELD)%PTR%DEVPTR => SELF%BUFFER%DEVPTR(${ar}$,IFIELD,:)
ENDDO
ENDIF
ENDIF
Expand All @@ -285,6 +271,10 @@ SUBROUTINE ${ftn}$_SYNC_HOST_RDWR(SELF, QUEUE)

CALL SELF%BUFFER%GET_HOST_DATA_RDWR(PPTR, QUEUE=QUEUE)

DO IFIELD=1,SELF%NUM_FIELDS
SELF%FIELDS(IFIELD)%PTR%ISTATUS = SELF%BUFFER%ISTATUS
ENDDO

END SUBROUTINE ${ftn}$_SYNC_HOST_RDWR

SUBROUTINE ${ftn}$_SYNC_HOST_RDONLY(SELF, QUEUE)
Expand All @@ -296,8 +286,68 @@ SUBROUTINE ${ftn}$_SYNC_HOST_RDONLY(SELF, QUEUE)

CALL SELF%BUFFER%GET_HOST_DATA_RDONLY(PPTR, QUEUE=QUEUE)

DO IFIELD=1,SELF%NUM_FIELDS
SELF%FIELDS(IFIELD)%PTR%ISTATUS = SELF%BUFFER%ISTATUS
ENDDO

END SUBROUTINE ${ftn}$_SYNC_HOST_RDONLY

SUBROUTINE ${ftn}$_SYNC_DEVICE_RDWR(SELF, QUEUE)
CLASS(${ftn}$), INTENT(INOUT) :: SELF
INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: QUEUE
${ft.type}$, POINTER :: PPTR(${ft.shape}$)
INTEGER(KIND=JPIM) :: IFIELD

CALL SELF%BUFFER%GET_DEVICE_DATA_RDWR(PPTR, QUEUE=QUEUE)

DO IFIELD=1,SELF%NUM_FIELDS
SELF%FIELDS(IFIELD)%PTR%ISTATUS = SELF%BUFFER%ISTATUS
ENDDO

IF(.NOT. ASSOCIATED(SELF%FIELDS(1)%PTR%DEVPTR))THEN
IF(SELF%CONTIG_FIELDS)THEN
#:set ar = (',').join([':' for _ in range(0, ft.rank-1)])
DO IFIELD=1,SELF%NUM_FIELDS
SELF%FIELDS(IFIELD)%PTR%DEVPTR => SELF%BUFFER%DEVPTR(${ar}$,IFIELD)
ENDDO
ELSE
#:set ar = (',').join([':' for _ in range(0, ft.rank-2)])
DO IFIELD=1,SELF%NUM_FIELDS
SELF%FIELDS(IFIELD)%PTR%DEVPTR => SELF%BUFFER%DEVPTR(${ar}$,IFIELD,:)
ENDDO
ENDIF
ENDIF

END SUBROUTINE ${ftn}$_SYNC_DEVICE_RDWR

SUBROUTINE ${ftn}$_SYNC_DEVICE_RDONLY(SELF, QUEUE)
CLASS(${ftn}$), INTENT(INOUT) :: SELF
INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: QUEUE
${ft.type}$, POINTER :: PPTR(${ft.shape}$)
INTEGER(KIND=JPIM) :: IFIELD

CALL SELF%BUFFER%GET_DEVICE_DATA_RDONLY(PPTR, QUEUE=QUEUE)

DO IFIELD=1,SELF%NUM_FIELDS
SELF%FIELDS(IFIELD)%PTR%ISTATUS = SELF%BUFFER%ISTATUS
ENDDO

IF(.NOT. ASSOCIATED(SELF%FIELDS(1)%PTR%DEVPTR))THEN
IF(SELF%CONTIG_FIELDS)THEN
#:set ar = (',').join([':' for _ in range(0, ft.rank-1)])
DO IFIELD=1,SELF%NUM_FIELDS
SELF%FIELDS(IFIELD)%PTR%DEVPTR => SELF%BUFFER%DEVPTR(${ar}$,IFIELD)
ENDDO
ELSE
#:set ar = (',').join([':' for _ in range(0, ft.rank-2)])
DO IFIELD=1,SELF%NUM_FIELDS
SELF%FIELDS(IFIELD)%PTR%DEVPTR => SELF%BUFFER%DEVPTR(${ar}$,IFIELD,:)
ENDDO
ENDIF
ENDIF

END SUBROUTINE ${ftn}$_SYNC_DEVICE_RDONLY

FUNCTION ${ftn}$_GET_VIEW(SELF, BLOCK_INDEX, ZERO) RESULT(VIEW_PTR)
CLASS(${ftn}$) :: SELF
${ft.type}$, POINTER :: VIEW_PTR(${ft.viewShape}$)
Expand Down
25 changes: 13 additions & 12 deletions tests/init_final_owner_field_buffer.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -22,33 +22,35 @@ PROGRAM INIT_FINAL_OWNER_FIELD_BUFFER
TYPE(FIELD_3RB_BUFFER) :: BUFFER
TYPE(FIELD_2RB_PTR), ALLOCATABLE :: FIELDS(:)
INTEGER(KIND=JPIM) :: NFIELDS, IFIELD
REAL(KIND=JPRB), POINTER :: PTR(:,:,:)
TYPE(FIELD_3RB_VIEW), ALLOCATABLE :: FIELD_PTRS(:)
REAL(KIND=JPRB), POINTER :: BUFFER_PTR(:,:,:)
REAL(KIND=JPRB), POINTER :: FIELD_PTR(:,:)

NFIELDS = 3
ALLOCATE(FIELDS(NFIELDS))
ALLOCATE(FIELD_PTRS(NFIELDS))

CALL BUFFER%INIT(NFIELDS, FIELDS, LBOUNDS=[10,1,1], UBOUNDS=[21,NFIELDS,10])

BUFFER%BUFFER%PTR = 0._JPRB
CALL BUFFER%GET_HOST_DATA_RDWR(PTR, FIELDS=FIELD_PTRS)
CALL BUFFER%GET_HOST_DATA_RDWR(BUFFER_PTR)

IF(.NOT. ALL(PTR == 0.))THEN
IF(.NOT. ALL(BUFFER_PTR == 0.))THEN
ERROR STOP
ENDIF

PTR(:,1,:) = 1._JPRB
PTR(:,2,:) = 2._JPRB
PTR(:,3,:) = 3._JPRB
BUFFER_PTR(:,1,:) = 1._JPRB
BUFFER_PTR(:,2,:) = 2._JPRB
BUFFER_PTR(:,3,:) = 3._JPRB

IF(.NOT. ALL(FIELD_PTRS(1)%P == 1.))THEN
CALL FIELDS(1)%PTR%GET_HOST_DATA_RDWR(FIELD_PTR)
IF(.NOT. ALL(FIELD_PTR == 1.))THEN
ERROR STOP
ENDIF
IF(.NOT. ALL(FIELD_PTRS(2)%P == 2.))THEN
CALL FIELDS(2)%PTR%GET_HOST_DATA_RDWR(FIELD_PTR)
IF(.NOT. ALL(FIELD_PTR == 2.))THEN
ERROR STOP
ENDIF
IF(.NOT. ALL(FIELD_PTRS(3)%P == 3.))THEN
CALL FIELDS(3)%PTR%GET_HOST_DATA_RDWR(FIELD_PTR)
IF(.NOT. ALL(FIELD_PTR == 3.))THEN
ERROR STOP
ENDIF

Expand Down Expand Up @@ -96,5 +98,4 @@ PROGRAM INIT_FINAL_OWNER_FIELD_BUFFER
ENDDO

DEALLOCATE(FIELDS)
DEALLOCATE(FIELD_PTRS)
END PROGRAM INIT_FINAL_OWNER_FIELD_BUFFER
25 changes: 13 additions & 12 deletions tests/init_final_wrapper_field_buffer.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,35 +20,37 @@ PROGRAM INIT_FINAL_WRAPPER_FIELD_BUFFER
TYPE(FIELD_3RB_BUFFER) :: BUFFER
TYPE(FIELD_2RB_PTR), ALLOCATABLE :: FIELDS(:)
INTEGER(KIND=JPIM) :: NFIELDS, IFIELD
REAL(KIND=JPRB), POINTER :: PTR(:,:,:)
REAL(KIND=JPRB), POINTER :: BUFFER_PTR(:,:,:)
REAL(KIND=JPRB), POINTER :: FIELD_PTR(:,:)
REAL(KIND=JPRB), ALLOCATABLE :: D(:,:,:)
TYPE(FIELD_3RB_VIEW), ALLOCATABLE :: FIELD_PTRS(:)

NFIELDS = 3
ALLOCATE(FIELDS(NFIELDS))
ALLOCATE(FIELD_PTRS(NFIELDS))
ALLOCATE(D(10:21,NFIELDS,2:6))

CALL BUFFER%INIT(NFIELDS, FIELDS, DATA=D)

D = 0._JPRB
CALL BUFFER%GET_HOST_DATA_RDWR(PTR, FIELDS=FIELD_PTRS)
CALL BUFFER%GET_HOST_DATA_RDWR(BUFFER_PTR)

IF(.NOT. ALL(PTR == 0.))THEN
IF(.NOT. ALL(BUFFER_PTR == 0.))THEN
ERROR STOP
ENDIF

PTR(:,1,:) = 1._JPRB
PTR(:,2,:) = 2._JPRB
PTR(:,3,:) = 3._JPRB
BUFFER_PTR(:,1,:) = 1._JPRB
BUFFER_PTR(:,2,:) = 2._JPRB
BUFFER_PTR(:,3,:) = 3._JPRB

IF(.NOT. ALL(FIELD_PTRS(1)%P == 1.))THEN
CALL FIELDS(1)%PTR%GET_HOST_DATA_RDWR(FIELD_PTR)
IF(.NOT. ALL(FIELD_PTR == 1.))THEN
ERROR STOP
ENDIF
IF(.NOT. ALL(FIELD_PTRS(2)%P == 2.))THEN
CALL FIELDS(2)%PTR%GET_HOST_DATA_RDWR(FIELD_PTR)
IF(.NOT. ALL(FIELD_PTR == 2.))THEN
ERROR STOP
ENDIF
IF(.NOT. ALL(FIELD_PTRS(3)%P == 3.))THEN
CALL FIELDS(3)%PTR%GET_HOST_DATA_RDWR(FIELD_PTR)
IF(.NOT. ALL(FIELD_PTR == 3.))THEN
ERROR STOP
ENDIF

Expand Down Expand Up @@ -97,5 +99,4 @@ PROGRAM INIT_FINAL_WRAPPER_FIELD_BUFFER

DEALLOCATE(D)
DEALLOCATE(FIELDS)
DEALLOCATE(FIELD_PTRS)
END PROGRAM INIT_FINAL_WRAPPER_FIELD_BUFFER
Loading

0 comments on commit 6d4a19e

Please sign in to comment.