diff --git a/field_RANKSUFF_buffer_module.fypp b/field_RANKSUFF_buffer_module.fypp index f332442..7a63235 100644 --- a/field_RANKSUFF_buffer_module.fypp +++ b/field_RANKSUFF_buffer_module.fypp @@ -12,7 +12,8 @@ MODULE FIELD_${RANK}$${SUFF}$_BUFFER_MODULE #:set fieldTypeList = fieldType.getFieldTypeList (ranks=[RANK], kinds=['JP' + str (SUFF)]) #:for ft in fieldTypeList -USE ${ft.name}$_MODULE, ONLY : ${ft.name}$, ${ft.name}$_OWNER, ${ft.name}$_WRAPPER, NDEVFRESH, NHSTFRESH +USE ${ft.name}$_MODULE, ONLY : ${ft.name}$, ${ft.name}$_OWNER, ${ft.name}$_WRAPPER, & +& NDEVFRESH, NHSTFRESH, NRD, NWR USE ${f'FIELD_{ft.rank-1}{ft.suffix}'}$_MODULE, ONLY : ${f'FIELD_{ft.rank-1}{ft.suffix}'}$, & & ${f'FIELD_{ft.rank-1}{ft.suffix}'}$_WRAPPER, ${f'FIELD_{ft.rank-1}{ft.suffix}'}$_PTR #:endfor @@ -39,7 +40,13 @@ CONTAINS PROCEDURE :: GET_VIEW => ${ftn}$_BUFFER_WRAPPER_GET_VIEW PROCEDURE :: GET_DEVICE_DATA_RDONLY => ${ftn}$_BUFFER_WRAPPER_GET_DEVICE_DATA_RDONLY PROCEDURE :: GET_DEVICE_DATA_RDWR => ${ftn}$_BUFFER_WRAPPER_GET_DEVICE_DATA_RDWR -#! PROCEDURE :: GET_HOST_DATA => ${ftn}$_BUFFER_WRAPPER_GET_HOST_DATA + PROCEDURE :: SYNC_DEVICE_RDONLY => ${ftn}$_BUFFER_WRAPPER_SYNC_DEVICE_RDONLY + PROCEDURE :: SYNC_DEVICE_RDWR => ${ftn}$_BUFFER_WRAPPER_SYNC_DEVICE_RDWR + PROCEDURE :: GET_HOST_DATA_RDONLY => ${ftn}$_BUFFER_WRAPPER_GET_HOST_DATA_RDONLY + PROCEDURE :: GET_HOST_DATA_RDWR => ${ftn}$_BUFFER_WRAPPER_GET_HOST_DATA_RDWR + PROCEDURE :: SYNC_HOST_RDONLY => ${ftn}$_BUFFER_WRAPPER_SYNC_HOST_RDONLY + PROCEDURE :: SYNC_HOST_RDWR => ${ftn}$_BUFFER_WRAPPER_SYNC_HOST_RDWR + PROCEDURE :: CREATE_BUFFER_DEVICE_DATA => ${ftn}$_BUFFER_WRAPPER_CREATE_DEVICE_DATA END TYPE ${ftn}$_BUFFER_WRAPPER PUBLIC :: ${ftn}$_BUFFER_WRAPPER @@ -55,7 +62,13 @@ CONTAINS PROCEDURE :: GET_VIEW => ${ftn}$_BUFFER_OWNER_GET_VIEW PROCEDURE :: GET_DEVICE_DATA_RDONLY => ${ftn}$_BUFFER_OWNER_GET_DEVICE_DATA_RDONLY PROCEDURE :: GET_DEVICE_DATA_RDWR => ${ftn}$_BUFFER_OWNER_GET_DEVICE_DATA_RDWR -#! PROCEDURE :: GET_HOST_DATA => ${ftn}$_BUFFER_OWNER_GET_HOST_DATA + PROCEDURE :: SYNC_DEVICE_RDONLY => ${ftn}$_BUFFER_OWNER_SYNC_DEVICE_RDONLY + PROCEDURE :: SYNC_DEVICE_RDWR => ${ftn}$_BUFFER_OWNER_SYNC_DEVICE_RDWR + PROCEDURE :: GET_HOST_DATA_RDONLY => ${ftn}$_BUFFER_OWNER_GET_HOST_DATA_RDONLY + PROCEDURE :: GET_HOST_DATA_RDWR => ${ftn}$_BUFFER_OWNER_GET_HOST_DATA_RDWR + PROCEDURE :: SYNC_HOST_RDONLY => ${ftn}$_BUFFER_OWNER_SYNC_HOST_RDONLY + PROCEDURE :: SYNC_HOST_RDWR => ${ftn}$_BUFFER_OWNER_SYNC_HOST_RDWR + PROCEDURE :: CREATE_BUFFER_DEVICE_DATA => ${ftn}$_BUFFER_OWNER_CREATE_DEVICE_DATA END TYPE ${ftn}$_BUFFER_OWNER PUBLIC :: ${ftn}$_BUFFER_OWNER @@ -78,7 +91,7 @@ SUBROUTINE ${ftn}$_WRAPPER_INIT(SELF, NUM_CHILDREN, CHILDREN, LBOUNDS, DATA, PER LOGICAL, OPTIONAL, INTENT(IN) :: CONTIG_FIELDS LOGICAL :: LLPERSISTENT - INTEGER(KIND=JPIM) :: LLBOUNDS(${ft.rank}$), IFIELD + INTEGER(KIND=JPIM) :: LLBOUNDS(${ft.rank}$), CHILD_LBOUNDS(${ft.rank-1}$) ${ft.type}$ :: LINIT_VALUE SELF%NUM_CHILDREN = NUM_CHILDREN @@ -114,7 +127,22 @@ SUBROUTINE ${ftn}$_WRAPPER_INIT(SELF, NUM_CHILDREN, CHILDREN, LBOUNDS, DATA, PER CALL SELF%${ft.name}$_WRAP(DATA=DATA, LBOUNDS=LLBOUNDS, PERSISTENT=LLPERSISTENT) - CALL ${ftn}$_ASSIGN_CHILDREN(NUM_CHILDREN, SELF%CHILDREN, CHILDREN, SELF%PTR, LLPERSISTENT, SELF%CONTIG_FIELDS) + IF(SELF%CONTIG_FIELDS)THEN + #:for r in range(1, ft.rank) + CHILD_LBOUNDS(${r}$) = LBOUND(SELF%PTR, ${r}$) + #:endfor + ELSE + #:for r in range(1, ft.rank-1) + CHILD_LBOUNDS(${r}$) = LBOUND(SELF%PTR, ${r}$) + #:endfor + CHILD_LBOUNDS(${ft.rank-1}$) = LBOUND(SELF%PTR, ${ft.rank}$) + ENDIF + + CALL ${ftn}$_ASSIGN_CHILDREN(NUM_CHILDREN, SELF%CHILDREN, CHILDREN, SELF%PTR, LLPERSISTENT, SELF%CONTIG_FIELDS, CHILD_LBOUNDS) + + ! We allocate device memory here so that we can point CHILD%DEVPTR to a discontiguous + ! slice of BUFFER%DEVPTR + CALL SELF%CREATE_BUFFER_DEVICE_DATA END SUBROUTINE ${ftn}$_WRAPPER_INIT SUBROUTINE ${ftn}$_OWNER_INIT(SELF, NUM_CHILDREN, CHILDREN, LBOUNDS, UBOUNDS, & @@ -131,7 +159,7 @@ SUBROUTINE ${ftn}$_OWNER_INIT(SELF, NUM_CHILDREN, CHILDREN, LBOUNDS, UBOUNDS, & ${ft.type}$, OPTIONAL, INTENT(IN) :: INIT_VALUE LOGICAL :: LLPERSISTENT - INTEGER(KIND=JPIM) :: LLBOUNDS(${ft.rank}$), IFIELD + INTEGER(KIND=JPIM) :: LLBOUNDS(${ft.rank}$), CHILD_LBOUNDS(${ft.rank-1}$) ${ft.type}$ :: LINIT_VALUE SELF%NUM_CHILDREN = NUM_CHILDREN @@ -173,47 +201,32 @@ SUBROUTINE ${ftn}$_OWNER_INIT(SELF, NUM_CHILDREN, CHILDREN, LBOUNDS, UBOUNDS, & CALL SELF%${ft.name}$_OWNER_INIT(LBOUNDS=LBOUNDS, UBOUNDS=UBOUNDS, PERSISTENT=LLPERSISTENT, INIT_VALUE=LINIT_VALUE) - CALL ${ftn}$_ASSIGN_CHILDREN(NUM_CHILDREN, SELF%CHILDREN, CHILDREN, SELF%PTR, LLPERSISTENT, SELF%CONTIG_FIELDS) -END SUBROUTINE ${ftn}$_OWNER_INIT - -SUBROUTINE ${ftn}$_WRAPPER_FINAL(SELF) - CLASS(${ftn}$_WRAPPER) :: SELF - INTEGER(KIND=JPIM) :: IFIELD - - DO IFIELD=1,SELF%NUM_CHILDREN - CALL SELF%CHILDREN(IFIELD)%PTR%FINAL() - IF(ASSOCIATED(SELF%CHILDREN(IFIELD)%PTR))THEN - DEALLOCATE(SELF%CHILDREN(IFIELD)%PTR) - NULLIFY(SELF%CHILDREN(IFIELD)%PTR) - ENDIF - ENDDO - - CALL SELF%${ft.name}$_WRAPPER_FINAL -END SUBROUTINE ${ftn}$_WRAPPER_FINAL - -SUBROUTINE ${ftn}$_OWNER_FINAL(SELF) - CLASS(${ftn}$_OWNER) :: SELF - INTEGER(KIND=JPIM) :: IFIELD + IF(SELF%CONTIG_FIELDS)THEN + #:for r in range(1, ft.rank) + CHILD_LBOUNDS(${r}$) = LBOUND(SELF%PTR, ${r}$) + #:endfor + ELSE + #:for r in range(1, ft.rank-1) + CHILD_LBOUNDS(${r}$) = LBOUND(SELF%PTR, ${r}$) + #:endfor + CHILD_LBOUNDS(${ft.rank-1}$) = LBOUND(SELF%PTR, ${ft.rank}$) + ENDIF - DO IFIELD=1,SELF%NUM_CHILDREN - CALL SELF%CHILDREN(IFIELD)%PTR%FINAL() - IF(ASSOCIATED(SELF%CHILDREN(IFIELD)%PTR))THEN - DEALLOCATE(SELF%CHILDREN(IFIELD)%PTR) - NULLIFY(SELF%CHILDREN(IFIELD)%PTR) - ENDIF - ENDDO + CALL ${ftn}$_ASSIGN_CHILDREN(NUM_CHILDREN, SELF%CHILDREN, CHILDREN, SELF%PTR, LLPERSISTENT, SELF%CONTIG_FIELDS, CHILD_LBOUNDS) - CALL SELF%${ft.name}$_OWNER_FINAL -END SUBROUTINE ${ftn}$_OWNER_FINAL + ! We allocate device memory here so that we can point CHILD%DEVPTR to a discontiguous + ! slice of BUFFER%DEVPTR + CALL SELF%CREATE_BUFFER_DEVICE_DATA +END SUBROUTINE ${ftn}$_OWNER_INIT -SUBROUTINE ${ftn}$_ASSIGN_CHILDREN(NUM_CHILDREN, CHILDREN_, CHILDREN, DATA, PERSISTENT, CONTIG_FIELDS) +SUBROUTINE ${ftn}$_ASSIGN_CHILDREN(NUM_CHILDREN, CHILDREN_, CHILDREN, DATA, PERSISTENT, CONTIG_FIELDS, LBOUNDS) INTEGER(KIND=JPIM), INTENT(IN) :: NUM_CHILDREN + INTEGER(KIND=JPIM), INTENT(IN) :: LBOUNDS(${ft.rank-1}$) TYPE(${f'FIELD_{ft.rank-1}{ft.suffix}'}$_PTR), POINTER, INTENT(OUT) :: CHILDREN_(:) TYPE(${f'FIELD_{ft.rank-1}{ft.suffix}'}$_PTR), TARGET, INTENT(INOUT) :: CHILDREN(:) LOGICAL, INTENT(IN) :: PERSISTENT, CONTIG_FIELDS ${ft.type}$, INTENT(IN) :: DATA(${ft.shape}$) - INTEGER(KIND=JPIM), DIMENSION(${ft.rank-1}$) :: LBOUNDS INTEGER(KIND=JPIM) :: IFIELD DO IFIELD=1,NUM_CHILDREN @@ -221,20 +234,11 @@ SUBROUTINE ${ftn}$_ASSIGN_CHILDREN(NUM_CHILDREN, CHILDREN_, CHILDREN, DATA, PERS ENDDO IF(CONTIG_FIELDS)THEN - #:for r in range(1, ft.rank) - LBOUNDS(${r}$) = LBOUND(DATA, ${r}$) - #:endfor - #:set ar = (',').join([':' for _ in range(0, ft.rank-1)]) DO IFIELD=1,NUM_CHILDREN CALL ${f'FIELD_{ft.rank-1}{ft.suffix}'}$_INIT_CHILD(CHILDREN(IFIELD)%PTR, DATA(${ar}$,IFIELD), LBOUNDS, PERSISTENT) ENDDO ELSE - #:for r in range(1, ft.rank-1) - LBOUNDS(${r}$) = LBOUND(DATA, ${r}$) - #:endfor - LBOUNDS(${ft.rank-1}$) = LBOUND(DATA, ${ft.rank}$) - #:set ar = (',').join([':' for _ in range(0, ft.rank-2)]) DO IFIELD=1,NUM_CHILDREN CALL ${f'FIELD_{ft.rank-1}{ft.suffix}'}$_INIT_CHILD(CHILDREN(IFIELD)%PTR, DATA(${ar}$,IFIELD,:), LBOUNDS, PERSISTENT) @@ -257,176 +261,6 @@ SUBROUTINE ${f'FIELD_{ft.rank-1}{ft.suffix}'}$_INIT_CHILD(CHILD, DATA, LBOUNDS, END SELECT END SUBROUTINE ${f'FIELD_{ft.rank-1}{ft.suffix}'}$_INIT_CHILD -#!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 -#! INTEGER(KIND=JPIM) :: IFIELD -#! -#! 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}$_GET_HOST_DATA_RDWR -#! -#!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 -#! 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}$_GET_DEVICE_DATA_RDWR -#! -#!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 -#! INTEGER(KIND=JPIM) :: IFIELD -#! -#! 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}$_GET_HOST_DATA_RDONLY -#! -#!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 -#! 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}$_GET_DEVICE_DATA_RDONLY -#! -#!SUBROUTINE ${ftn}$_SYNC_HOST_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_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) -#! 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_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 - SUBROUTINE ${ftn}$_GET_VIEW(VIEW_PTR, IDX, DATA, CONTIG_FIELDS) ${ft.type}$, POINTER, INTENT(OUT) :: VIEW_PTR(${ft.viewShape}$) ${ft.type}$, INTENT(IN), POINTER :: DATA(${ft.shape}$) @@ -469,6 +303,49 @@ SUBROUTINE ${ftn}$_CHECK_CHILDREN_STATUS(CHILDREN, ISTATUS, STAT) END SUBROUTINE ${ftn}$_CHECK_CHILDREN_STATUS #:for buffer_type in ['OWNER', 'WRAPPER'] +SUBROUTINE ${ftn}$_${buffer_type}$_CREATE_DEVICE_DATA(SELF) + CLASS(${ftn}$_${buffer_type}$) :: SELF + INTEGER(KIND=JPIM) :: IFIELD + + IF (.NOT. ASSOCIATED (SELF%DEVPTR)) THEN + CALL SELF%CREATE_DEVICE_DATA + IF(SELF%CONTIG_FIELDS)THEN + #:set ar = (',').join([':' for _ in range(0, ft.rank-1)]) + DO IFIELD=1,SELF%NUM_CHILDREN + SELF%CHILDREN(IFIELD)%PTR%DEVPTR => SELF%DEVPTR(${ar}$,IFIELD) + ENDDO + ELSE + #:set ar = (',').join([':' for _ in range(0, ft.rank-2)]) + DO IFIELD=1,SELF%NUM_CHILDREN + SELF%CHILDREN(IFIELD)%PTR%DEVPTR => SELF%DEVPTR(${ar}$,IFIELD,:) + ENDDO + ENDIF + ENDIF +END SUBROUTINE ${ftn}$_${buffer_type}$_CREATE_DEVICE_DATA + +SUBROUTINE ${ftn}$_${buffer_type}$_FINAL(SELF) + CLASS(${ftn}$_${buffer_type}$) :: SELF + INTEGER(KIND=JPIM) :: IFIELD + + ! CHILD%DEVPTR was never allocated and is a discontiguous slice of BUFFER%DEVPTR + ! To avoid calling CHILD%DELETE_DEVICE, we copy back all the data here and + ! nullify CHILD%DEVPTR + DO IFIELD=1,SELF%NUM_CHILDREN + CALL SELF%CHILDREN(IFIELD)%PTR%SYNC_HOST_RDWR() + NULLIFY(SELF%CHILDREN(IFIELD)%PTR%DEVPTR) + ENDDO + + DO IFIELD=1,SELF%NUM_CHILDREN + CALL SELF%CHILDREN(IFIELD)%PTR%FINAL() + IF(ASSOCIATED(SELF%CHILDREN(IFIELD)%PTR))THEN + DEALLOCATE(SELF%CHILDREN(IFIELD)%PTR) + NULLIFY(SELF%CHILDREN(IFIELD)%PTR) + ENDIF + ENDDO + + CALL SELF%${ft.name}$_${buffer_type}$_FINAL +END SUBROUTINE ${ftn}$_${buffer_type}$_FINAL + FUNCTION ${ftn}$_${buffer_type}$_GET_VIEW(SELF, BLOCK_INDEX, ZERO) RESULT(VIEW_PTR) CLASS(${ftn}$_${buffer_type}$) :: SELF ${ft.type}$, POINTER :: VIEW_PTR(${ft.viewShape}$) @@ -501,52 +378,131 @@ SUBROUTINE ${ftn}$_${buffer_type}$_GET_DEVICE_DATA_${mode}$(SELF, PPTR, QUEUE) INTEGER (KIND=JPIM), OPTIONAL, INTENT(IN) :: QUEUE LOGICAL :: STAT - INTEGER(KIND=JPIM) :: IFIELD + INTEGER(KIND=JPIM) :: IFIELD, MODE INTEGER(KIND=JPIM) :: LBOUNDS(${ft.rank}$) CALL ${ftn}$_CHECK_CHILDREN_STATUS(SELF%CHILDREN, SELF%ISTATUS, STAT) + ! If the CHILDREN all have the same ISTATUS as the BUFFER, then we can safely + ! exchange data on a per BUFFER basis. Otherwise, data exchange must be done + ! on a per field basis IF(STAT)THEN CALL SELF%${ft.name}$_GET_DEVICE_DATA_${mode}$(PPTR, QUEUE=QUEUE) - + CALL ${ftn}$_SET_CHILDREN_STATUS(SELF%CHILDREN, SELF%ISTATUS) + ELSE DO IFIELD=1,SELF%NUM_CHILDREN - SELF%CHILDREN(IFIELD)%PTR%ISTATUS = SELF%ISTATUS + CALL SELF%CHILDREN(IFIELD)%PTR%SYNC_DEVICE_${mode}$(QUEUE=QUEUE) ENDDO - IF(SELF%CONTIG_FIELDS)THEN - #:set ar = (',').join([':' for _ in range(0, ft.rank-1)]) - DO IFIELD=1,SELF%NUM_CHILDREN - SELF%CHILDREN(IFIELD)%PTR%DEVPTR => SELF%DEVPTR(${ar}$,IFIELD) - ENDDO - ELSE - #:set ar = (',').join([':' for _ in range(0, ft.rank-2)]) - DO IFIELD=1,SELF%NUM_CHILDREN - SELF%CHILDREN(IFIELD)%PTR%DEVPTR => SELF%DEVPTR(${ar}$,IFIELD,:) - ENDDO +#:if mode == 'RDWR' + MODE = IOR (NRD, NWR) +#:else + MODE = NRD +#:endif + IF (IAND (MODE, NWR) /= 0) THEN + SELF%ISTATUS = IAND (SELF%ISTATUS, NOT (NHSTFRESH)) ENDIF + LBOUNDS = LBOUND(SELF%PTR) + PPTR(${ft.lbptr}$) => SELF%DEVPTR (${','.join(':' for _ in range(ft.rank))}$) + ENDIF +END SUBROUTINE ${ftn}$_${buffer_type}$_GET_DEVICE_DATA_${mode}$ + +SUBROUTINE ${ftn}$_${buffer_type}$_SYNC_DEVICE_${mode}$(SELF, QUEUE) + CLASS(${ftn}$_${buffer_type}$), INTENT(INOUT) :: SELF + INTEGER (KIND=JPIM), OPTIONAL, INTENT(IN) :: QUEUE + + LOGICAL :: STAT + INTEGER(KIND=JPIM) :: IFIELD, MODE + + CALL ${ftn}$_CHECK_CHILDREN_STATUS(SELF%CHILDREN, SELF%ISTATUS, STAT) + + ! If the CHILDREN all have the same ISTATUS as the BUFFER, then we can safely + ! exchange data on a per BUFFER basis. Otherwise, data exchange must be done + ! on a per field basis + IF(STAT)THEN + CALL SELF%${ft.name}$_SYNC_DEVICE_${mode}$(QUEUE=QUEUE) + CALL ${ftn}$_SET_CHILDREN_STATUS(SELF%CHILDREN, SELF%ISTATUS) ELSE DO IFIELD=1,SELF%NUM_CHILDREN - CALL SELF%CHILDREN(IFIELD)%PTR%${f'FIELD_{ft.rank-1}{ft.suffix}'}$_SYNC_DEVICE_${mode}$(QUEUE=QUEUE) + CALL SELF%CHILDREN(IFIELD)%PTR%SYNC_DEVICE_${mode}$(QUEUE=QUEUE) ENDDO - SELF%ISTATUS = SELF%CHILDREN(1)%PTR%ISTATUS - - IF(SELF%CONTIG_FIELDS)THEN - #:set ar = (',').join([':' for _ in range(0, ft.rank-1)]) - DO IFIELD=1,SELF%NUM_CHILDREN - SELF%DEVPTR(${ar}$,IFIELD) = SELF%CHILDREN(IFIELD)%PTR%DEVPTR - ENDDO - ELSE - #:set ar = (',').join([':' for _ in range(0, ft.rank-2)]) - DO IFIELD=1,SELF%NUM_CHILDREN - SELF%DEVPTR(${ar}$,IFIELD,:) = SELF%CHILDREN(IFIELD)%PTR%DEVPTR - ENDDO +#:if mode == 'RDWR' + MODE = IOR (NRD, NWR) +#:else + MODE = NRD +#:endif + IF (IAND (MODE, NWR) /= 0) THEN + SELF%ISTATUS = IAND (SELF%ISTATUS, NOT (NHSTFRESH)) ENDIF + ENDIF +END SUBROUTINE ${ftn}$_${buffer_type}$_SYNC_DEVICE_${mode}$ + +SUBROUTINE ${ftn}$_${buffer_type}$_GET_HOST_DATA_${mode}$(SELF, PPTR, QUEUE) + CLASS(${ftn}$_${buffer_type}$), INTENT(INOUT) :: SELF + ${ft.type}$, POINTER, INTENT(INOUT) :: PPTR(${ft.shape}$) + INTEGER (KIND=JPIM), OPTIONAL, INTENT(IN) :: QUEUE + + LOGICAL :: STAT + INTEGER(KIND=JPIM) :: IFIELD, MODE + INTEGER(KIND=JPIM) :: LBOUNDS(${ft.rank}$) + + CALL ${ftn}$_CHECK_CHILDREN_STATUS(SELF%CHILDREN, SELF%ISTATUS, STAT) + + ! If the CHILDREN all have the same ISTATUS as the BUFFER, then we can safely + ! exchange data on a per BUFFER basis. Otherwise, data exchange must be done + ! on a per field basis + IF(STAT)THEN + CALL SELF%${ft.name}$_GET_HOST_DATA_${mode}$(PPTR, QUEUE=QUEUE) + CALL ${ftn}$_SET_CHILDREN_STATUS(SELF%CHILDREN, SELF%ISTATUS) + ELSE + DO IFIELD=1,SELF%NUM_CHILDREN + CALL SELF%CHILDREN(IFIELD)%PTR%${f'FIELD_{ft.rank-1}{ft.suffix}'}$_SYNC_HOST_${mode}$(QUEUE=QUEUE) + ENDDO +#:if mode == 'RDWR' + MODE = IOR (NRD, NWR) +#:else + MODE = NRD +#:endif + IF (IAND (MODE, NWR) /= 0) THEN + SELF%ISTATUS = IAND (SELF%ISTATUS, NOT (NDEVFRESH)) + ENDIF LBOUNDS=LBOUND(SELF%PTR) - PPTR (${ft.lbptr}$) => SELF%DEVPTR (${','.join(':' for _ in range(ft.rank))}$) + PPTR (${ft.lbptr}$) => SELF%PTR (${','.join(':' for _ in range(ft.rank))}$) ENDIF -END SUBROUTINE ${ftn}$_${buffer_type}$_GET_DEVICE_DATA_${mode}$ +END SUBROUTINE ${ftn}$_${buffer_type}$_GET_HOST_DATA_${mode}$ + +SUBROUTINE ${ftn}$_${buffer_type}$_SYNC_HOST_${mode}$(SELF, QUEUE) + CLASS(${ftn}$_${buffer_type}$), INTENT(INOUT) :: SELF + INTEGER (KIND=JPIM), OPTIONAL, INTENT(IN) :: QUEUE + + LOGICAL :: STAT + INTEGER(KIND=JPIM) :: IFIELD, MODE + + CALL ${ftn}$_CHECK_CHILDREN_STATUS(SELF%CHILDREN, SELF%ISTATUS, STAT) + + ! If the CHILDREN all have the same ISTATUS as the BUFFER, then we can safely + ! exchange data on a per BUFFER basis. Otherwise, data exchange must be done + ! on a per field basis + IF(STAT)THEN + CALL SELF%${ft.name}$_SYNC_HOST_${mode}$(QUEUE=QUEUE) + CALL ${ftn}$_SET_CHILDREN_STATUS(SELF%CHILDREN, SELF%ISTATUS) + ELSE + DO IFIELD=1,SELF%NUM_CHILDREN + CALL SELF%CHILDREN(IFIELD)%PTR%${f'FIELD_{ft.rank-1}{ft.suffix}'}$_SYNC_HOST_${mode}$(QUEUE=QUEUE) + ENDDO + +#:if mode == 'RDWR' + MODE = IOR (NRD, NWR) +#:else + MODE = NRD +#:endif + IF (IAND (MODE, NWR) /= 0) THEN + SELF%ISTATUS = IAND (SELF%ISTATUS, NOT (NDEVFRESH)) + ENDIF + ENDIF +END SUBROUTINE ${ftn}$_${buffer_type}$_SYNC_HOST_${mode}$ #:endfor #:endfor diff --git a/field_RANKSUFF_module.fypp b/field_RANKSUFF_module.fypp index 6a8beb5..c6f6d11 100644 --- a/field_RANKSUFF_module.fypp +++ b/field_RANKSUFF_module.fypp @@ -33,6 +33,8 @@ INTEGER (KIND=JPIM), PARAMETER :: NWR = INT(B'00000010', KIND=JPIM) PUBLIC :: NHSTFRESH PUBLIC :: NDEVFRESH +PUBLIC :: NRD +PUBLIC :: NWR #:for ft in fieldTypeList #:set ftn = ft.name @@ -51,8 +53,12 @@ CONTAINS PROCEDURE :: ${ftn}$_GET_DEVICE_DATA_RDWR PROCEDURE :: GET_HOST_DATA_RDONLY => ${ftn}$_GET_HOST_DATA_RDONLY PROCEDURE :: GET_HOST_DATA_RDWR => ${ftn}$_GET_HOST_DATA_RDWR + PROCEDURE :: ${ftn}$_GET_HOST_DATA_RDONLY + PROCEDURE :: ${ftn}$_GET_HOST_DATA_RDWR PROCEDURE :: SYNC_HOST_RDWR => ${ftn}$_SYNC_HOST_RDWR PROCEDURE :: SYNC_HOST_RDONLY => ${ftn}$_SYNC_HOST_RDONLY + PROCEDURE :: ${ftn}$_SYNC_HOST_RDWR + PROCEDURE :: ${ftn}$_SYNC_HOST_RDONLY PROCEDURE :: SYNC_DEVICE_RDWR => ${ftn}$_SYNC_DEVICE_RDWR PROCEDURE :: SYNC_DEVICE_RDONLY => ${ftn}$_SYNC_DEVICE_RDONLY PROCEDURE :: ${ftn}$_SYNC_DEVICE_RDWR @@ -274,7 +280,7 @@ CONTAINS ! Finalizes field and deallocates owned data CLASS(${ftn}$_WRAPPER) :: SELF ${ft.type}$, POINTER :: PTR(${ft.shape}$) - CALL SELF%GET_HOST_DATA_RDONLY(PTR) + CALL SELF%${ftn}$_GET_HOST_DATA_RDONLY(PTR) CALL SELF%${ftn}$_FINAL END SUBROUTINE ${ftn}$_WRAPPER_FINAL diff --git a/tests/CMakeLists.txt b/tests/CMakeLists.txt index 2b52759..e6a3c66 100644 --- a/tests/CMakeLists.txt +++ b/tests/CMakeLists.txt @@ -45,7 +45,7 @@ list(APPEND TEST_FILES init_owner_delayed_gpu.F90 init_owner_delayed_init_debug_value.F90 init_owner_delayed_init_value.F90 -# init_owner_field_buffer_gpu.F90 + test_field_buffer_coherency_gpu_dirty.F90 # init_final_owner_field_buffer.F90 # init_final_wrapper_field_buffer.F90 init_owner_gpu.F90 diff --git a/tests/test_field_buffer_gpu_coherency.F90 b/tests/test_field_buffer_coherency_gpu_dirty.F90 similarity index 57% rename from tests/test_field_buffer_gpu_coherency.F90 rename to tests/test_field_buffer_coherency_gpu_dirty.F90 index 5a9d474..a2026b0 100644 --- a/tests/test_field_buffer_gpu_coherency.F90 +++ b/tests/test_field_buffer_coherency_gpu_dirty.F90 @@ -7,18 +7,18 @@ ! granted to it by virtue of its status as an intergovernmental organisation ! nor does it submit to any jurisdiction. -PROGRAM INIT_OWNER_FIELD_BUFFER_GPU +PROGRAM TEST_FIELD_BUFFER_COHERENCY_GPU_DIRTY ! TEST IF OWNER IS REALLY ALLOCATING THE DATA ! WHEN PERSITENT IS SET TO TRUE OR IS NOT GIVEN IN ARGUMENT, ! THEN THE LAST DIM OF THE FIELD IS THE NUMBER OF OPENMP THREADS USE FIELD_MODULE - USE FIELD_BUFFER_MODULE + USE FIELD_FACTORY_MODULE USE PARKIND1 IMPLICIT NONE - TYPE(FIELD_3RB_BUFFER) :: BUFFER + CLASS(FIELD_3RB), POINTER :: BUFFER => NULL() TYPE(FIELD_2RB_PTR), ALLOCATABLE :: FIELDS(:) REAL(KIND=JPRB), POINTER :: BUFFER_CPU(:,:,:) @@ -29,54 +29,35 @@ PROGRAM INIT_OWNER_FIELD_BUFFER_GPU INTEGER(KIND=JPIM) :: NFIELDS, IFIELD, I, J NFIELDS = 3 - ALLOCATE(FIELDS(NFIELDS)) - - CALL BUFFER%INIT(NFIELDS, FIELDS, LBOUNDS=[10,1,1], UBOUNDS=[21,NFIELDS,10], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) - - CALL BUFFER%GET_HOST_DATA_RDWR(BUFFER_CPU) - BUFFER_CPU = 42 - - CALL FIELDS(1)%PTR%GET_HOST_DATA_RDWR(FIELD_PTR) - IF(.NOT. ALL(FIELD_PTR == 42)) ERROR STOP - CALL FIELDS(2)%PTR%GET_HOST_DATA_RDWR(FIELD_PTR) - IF(.NOT. ALL(FIELD_PTR == 42)) ERROR STOP - CALL FIELDS(3)%PTR%GET_HOST_DATA_RDWR(FIELD_PTR) - IF(.NOT. ALL(FIELD_PTR == 42)) ERROR STOP + CALL FIELD_NEW(BUFFER, NFIELDS, FIELDS, LBOUNDS=[10,1,1], UBOUNDS=[21,NFIELDS,10], PERSISTENT=.TRUE., INIT_VALUE=0._JPRB) CALL BUFFER%GET_DEVICE_DATA_RDWR(BUFFER_GPU) - RES=.TRUE. #ifdef _CUDA - !$ACC SERIAL DEVICEPTR (BUFFER_GPU) COPY(RES) + !$ACC SERIAL DEVICEPTR (BUFFER_GPU) #else - !$ACC SERIAL PRESENT (BUFFER_GPU) COPY(RES) + !$ACC SERIAL PRESENT (BUFFER_GPU) #endif DO J=1,10 DO IFIELD=1,NFIELDS DO I=10,21 - IF(BUFFER_GPU(I,IFIELD,J) /= 42) THEN - RES = .FALSE. - END IF + BUFFER_GPU(I,IFIELD,J) = 42._JPRB END DO END DO END DO - !$ACC END SERIAL - IF(.NOT. RES) ERROR STOP - CALL FIELDS(1)%PTR%GET_DEVICE_DATA_RDWR(FIELD_PTR) -#ifdef _CUDA - !$ACC SERIAL DEVICEPTR (FIELD_PTR) -#else - !$ACC SERIAL PRESENT (FIELD_PTR) -#endif - DO J=1,10 - DO I=10,21 - FIELD_PTR(I,J) = 1 - END DO - END DO - !$ACC END SERIAL + CALL BUFFER%GET_HOST_DATA_RDWR(BUFFER_CPU) + IF(.NOT. ALL(BUFFER_CPU == 42)) ERROR STOP + + CALL FIELDS(1)%PTR%GET_HOST_DATA_RDWR(FIELD_PTR) + IF(.NOT. ALL(FIELD_PTR == 42)) ERROR STOP + CALL FIELDS(2)%PTR%GET_HOST_DATA_RDWR(FIELD_PTR) + IF(.NOT. ALL(FIELD_PTR == 42)) ERROR STOP + CALL FIELDS(3)%PTR%GET_HOST_DATA_RDWR(FIELD_PTR) + IF(.NOT. ALL(FIELD_PTR == 42)) ERROR STOP CALL FIELDS(2)%PTR%GET_DEVICE_DATA_RDWR(FIELD_PTR) + #ifdef _CUDA !$ACC SERIAL DEVICEPTR (FIELD_PTR) #else @@ -84,43 +65,33 @@ PROGRAM INIT_OWNER_FIELD_BUFFER_GPU #endif DO J=1,10 DO I=10,21 - FIELD_PTR(I,J) = 2 + FIELD_PTR(I,J) = 1 END DO END DO !$ACC END SERIAL - CALL FIELDS(3)%PTR%GET_DEVICE_DATA_RDWR(FIELD_PTR) + CALL BUFFER%GET_DEVICE_DATA_RDWR(BUFFER_GPU) + RES=.TRUE. #ifdef _CUDA - !$ACC SERIAL DEVICEPTR (FIELD_PTR) + !$ACC SERIAL DEVICEPTR (BUFFER_GPU) COPY(RES) #else - !$ACC SERIAL PRESENT (FIELD_PTR) + !$ACC SERIAL PRESENT (BUFFER_GPU) COPY(RES) #endif DO J=1,10 DO I=10,21 - FIELD_PTR(I,J) = 3 + IF(BUFFER_GPU(I,1,J) /= 42) THEN + RES = .FALSE. + END IF + IF(BUFFER_GPU(I,2,J) /= 1) THEN + RES = .FALSE. + END IF + IF(BUFFER_GPU(I,3,J) /= 42) THEN + RES = .FALSE. + END IF END DO END DO !$ACC END SERIAL + IF(.NOT. RES) ERROR STOP - CALL BUFFER%SYNC_HOST_RDWR() - IF(.NOT. ALL(BUFFER_CPU(:,1,:) == 1))THEN - ERROR STOP - ENDIF - IF(.NOT. ALL(BUFFER_CPU(:,2,:) == 2))THEN - ERROR STOP - ENDIF - IF(.NOT. ALL(BUFFER_CPU(:,3,:) == 3))THEN - ERROR STOP - ENDIF - - CALL FIELDS(1)%PTR%GET_HOST_DATA_RDWR(FIELD_PTR) - IF(.NOT. ALL(FIELD_PTR == 1)) ERROR STOP - CALL FIELDS(2)%PTR%GET_HOST_DATA_RDWR(FIELD_PTR) - IF(.NOT. ALL(FIELD_PTR == 2)) ERROR STOP - CALL FIELDS(3)%PTR%GET_HOST_DATA_RDWR(FIELD_PTR) - IF(.NOT. ALL(FIELD_PTR == 3)) ERROR STOP - - CALL BUFFER%FINAL() - - DEALLOCATE(FIELDS) -END PROGRAM INIT_OWNER_FIELD_BUFFER_GPU + CALL FIELD_DELETE(BUFFER, FIELDS) +END PROGRAM TEST_FIELD_BUFFER_COHERENCY_GPU_DIRTY