From bd4a696d6c6b2773549907e95c5230757e2bc74e Mon Sep 17 00:00:00 2001 From: Philippe Marguinaud Date: Thu, 30 May 2024 15:25:55 +0000 Subject: [PATCH 1/3] Add utility functions transfering between Field API objects and old PGFL/PGMV arrays --- field_RANKSUFF_util_module.fypp | 56 ++++++++++++++- field_constants_module.F90 | 1 + field_util_module.fypp | 4 +- tests/CMakeLists.txt | 1 + tests/test_legacy.F90 | 124 ++++++++++++++++++++++++++++++++ 5 files changed, 182 insertions(+), 4 deletions(-) create mode 100644 tests/test_legacy.F90 diff --git a/field_RANKSUFF_util_module.fypp b/field_RANKSUFF_util_module.fypp index e4a9bfe..f0b2383 100644 --- a/field_RANKSUFF_util_module.fypp +++ b/field_RANKSUFF_util_module.fypp @@ -18,11 +18,11 @@ ${fieldType.useParkind1 ()}$ IMPLICIT NONE -#:for method in ['LOAD', 'SAVE', 'DIFF', 'COPY', 'WIPE', 'HOST', 'CRC64'] +#:for method in ['LOAD', 'SAVE', 'DIFF', 'COPY', 'WIPE', 'HOST', 'LEGACY', 'CRC64'] INTERFACE ${method}$ #:for ft in fieldTypeList MODULE PROCEDURE ${method}$_${ft.name}$ -#:if method not in ['DIFF', 'CRC64'] +#:if method not in ['DIFF', 'CRC64', 'LEGACY'] MODULE PROCEDURE ${method}$_${ft.name}$_PTR #:if ft.hasView MODULE PROCEDURE ${method}$_${ft.name}$_VIEW @@ -109,6 +109,58 @@ CALL SELF%SYNC_HOST_RDWR () END SUBROUTINE +SUBROUTINE LEGACY_${ft.name}$ (SELF, KADDRL, KADDRU, KDIR) + +USE ${ft.name}$_ACCESS_MODULE +USE FIELD_CONSTANTS_MODULE + +CLASS (${ft.name}$), POINTER :: SELF +INTEGER*8, INTENT (IN) :: KADDRL +INTEGER*8, INTENT (IN) :: KADDRU +INTEGER, INTENT (IN) :: KDIR + +${ft.type}$, POINTER :: PTR (${ft.shape}$), DEVPTR (${ft.shape}$) +INTEGER*8 :: IADDRL +INTEGER*8 :: IADDRU +INTEGER (KIND=JPIM) :: ILBOUNDS (${ft.rank}$) +INTEGER (KIND=JPIM) :: IUBOUNDS (${ft.rank}$) + +IF (ASSOCIATED (SELF)) THEN + + CALL SELF%GET_DIMS (LBOUNDS=ILBOUNDS, UBOUNDS=IUBOUNDS) + + PTR => SELF%PTR + + IADDRL = LOC (PTR (${",".join (map (lambda i: "ILBOUNDS(" + str (i) + "):", range (1, ft.rank+1)))}$)) + IADDRU = LOC (PTR (${",".join (map (lambda i: "IUBOUNDS(" + str (i) + "):", range (1, ft.rank+1)))}$)) + + IF ((KADDRL <= IADDRL) .AND. (IADDRU <= KADDRU)) THEN + DEVPTR => GET_DEVICE_DATA_RDONLY (SELF) + + IF (KDIR == NF2L) THEN + CALL LEGACY_${ft.name}$_ASSIGN (PTR, DEVPTR) + ELSEIF (KDIR == NL2F) THEN + CALL LEGACY_${ft.name}$_ASSIGN (DEVPTR, PTR) + ENDIF + + ENDIF + +ENDIF + +CONTAINS + +SUBROUTINE LEGACY_${ft.name}$_ASSIGN (PTR_RHS, PTR_LHS) + +${ft.type}$ :: PTR_RHS (${ft.shape}$), PTR_LHS (${ft.shape}$) + +!$acc kernels present (PTR_RHS, PTR_LHS) +PTR_RHS = PTR_LHS +!$acc end kernels + +END SUBROUTINE + +END SUBROUTINE + #:if ft.hasView SUBROUTINE LOAD_${ft.name}$_VIEW (KLUN, YD) diff --git a/field_constants_module.F90 b/field_constants_module.F90 index fabce87..746d734 100644 --- a/field_constants_module.F90 +++ b/field_constants_module.F90 @@ -20,5 +20,6 @@ MODULE FIELD_CONSTANTS_MODULE INTEGER (KIND=JPIM), PARAMETER :: NH2D = 1, ND2H = 2 INTEGER (KIND=JPIM), PARAMETER :: NRD = INT(B'00000001', KIND=JPIM) INTEGER (KIND=JPIM), PARAMETER :: NWR = INT(B'00000010', KIND=JPIM) +INTEGER (KIND=JPIM), PARAMETER :: NF2L = 1, NL2F = 2 END MODULE diff --git a/field_util_module.fypp b/field_util_module.fypp index 64500de..f1e007b 100644 --- a/field_util_module.fypp +++ b/field_util_module.fypp @@ -18,9 +18,9 @@ MODULE FIELD_UTIL_MODULE #:for fta, ftb in zip (ftlTA, ftlRB) USE ${fta.name}$_UTIL_MODULE, ONLY : & -#:for method in ['LOAD', 'SAVE', 'DIFF', 'COPY', 'WIPE', 'HOST', 'CRC64'] +#:for method in ['LOAD', 'SAVE', 'DIFF', 'COPY', 'WIPE', 'HOST', 'LEGACY', 'CRC64'] & ${method}$_${ftb.name}$ => ${method}$_${fta.name}$, ${method}$_${fta.name}$, ${method}$, & -#:if method not in ['DIFF', 'CRC64'] +#:if method not in ['DIFF', 'CRC64', 'LEGACY'] & ${method}$_${ftb.name}$_PTR => ${method}$_${fta.name}$_PTR, ${method}$_${fta.name}$_PTR, & #:if fta.hasView & ${method}$_${ftb.name}$_VIEW => ${method}$_${fta.name}$_VIEW, ${method}$_${fta.name}$_VIEW, & diff --git a/tests/CMakeLists.txt b/tests/CMakeLists.txt index 0d9ca6f..88ac93f 100644 --- a/tests/CMakeLists.txt +++ b/tests/CMakeLists.txt @@ -25,6 +25,7 @@ target_compile_definitions( main.x PRIVATE $<${HAVE_CUDA}:_CUDA> ) ## Unit tests list(APPEND TEST_FILES + test_legacy.F90 test_field_array.F90 gather_scatter_lastdim.F90 reshuffle_lastdim.F90 diff --git a/tests/test_legacy.F90 b/tests/test_legacy.F90 new file mode 100644 index 0000000..ab3847e --- /dev/null +++ b/tests/test_legacy.F90 @@ -0,0 +1,124 @@ +! (C) Copyright 2022- ECMWF. +! (C) Copyright 2022- Meteo-France. +! +! This software is licensed under the terms of the Apache Licence Version 2.0 +! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +! In applying this licence, ECMWF does not waive the privileges and immunities +! granted to it by virtue of its status as an intergovernmental organisation +! nor does it submit to any jurisdiction. + +PROGRAM TEST_LEGACY + +USE FIELD_MODULE +USE FIELD_FACTORY_MODULE +USE FIELD_ACCESS_MODULE +USE FIELD_ABORT_MODULE +USE FIELD_CONSTANTS_MODULE +USE FIELD_UTIL_MODULE, ONLY : LEGACY, LEGACY_FIELD_3RD + +USE PARKIND1 + +IMPLICIT NONE + +CLASS(FIELD_3RB), POINTER :: FU, FV, FT + +REAL(KIND=JPRB), ALLOCATABLE :: GMV (:,:,:,:) + +REAL(KIND=JPRB), POINTER :: U (:,:,:), V (:,:,:), T (:,:,:) + +INTEGER, PARAMETER :: NFLEVG = 5, NPROMA = 32, NGPBLKS = 4, NDIM = 3 +INTEGER, PARAMETER :: IU = 1, IV = 2, IT = 3 + +INTEGER*8 :: IADDRL, IADDRU + +INTEGER :: JLON, JLEV, JBLK +INTEGER :: IERR + +ALLOCATE (GMV (NPROMA, NFLEVG, NDIM, NGPBLKS)) + +GMV = 0._JPRB + +CALL FIELD_NEW (FU, DATA=GMV (:,:,IU,:)) +CALL FIELD_NEW (FV, DATA=GMV (:,:,IV,:)) +CALL FIELD_NEW (FT, DATA=GMV (:,:,IT,:)) + +! All fields on the device + +U => GET_DEVICE_DATA_RDWR (FU) +V => GET_DEVICE_DATA_RDONLY (FV) +T => GET_DEVICE_DATA_RDONLY (FT) + +!$acc kernels present (U) +U = 1._JPRB +!$acc end kernels + +!$acc enter data create (GMV) +!$acc update device (GMV) + +IADDRL = LOC (GMV (1,1,1,1)) +IADDRU = LOC (GMV(NPROMA,NFLEVG,NDIM,NGPBLKS)) + +CALL LEGACY_FIELD_3RD (FU, KADDRL=IADDRL, KADDRU=IADDRU, KDIR=NF2L) + +IERR = 0 + +!$acc serial present (GMV) copy (IERR) + +DO JBLK = 1, NGPBLKS + DO JLEV = 1, NFLEVG + DO JLON = 1, NPROMA + IF (GMV (JLON,JLEV,IU,JBLK) /= 1._JPRB) THEN + IERR = IERR + 1 + ENDIF + GMV (JLON,JLEV,IV,JBLK) = 2._JPRB + ENDDO + ENDDO +ENDDO + +!$acc end serial + +IF (IERR /= 0) CALL FIELD_ABORT ('VALUE MISMATCH: KDIR=NF2L') + +CALL LEGACY_FIELD_3RD (FV, KADDRL=IADDRL, KADDRU=IADDRU, KDIR=NL2F) + +U => GET_DEVICE_DATA_RDONLY (FU) +V => GET_DEVICE_DATA_RDONLY (FV) +T => GET_DEVICE_DATA_RDONLY (FT) + +IERR = 0 + +!$acc serial present (U, V, T) copy (IERR) + +DO JBLK = 1, NGPBLKS + DO JLEV = 1, NFLEVG + DO JLON = 1, NPROMA + + IF (U (JLON, JLEV, JBLK) /= 1._JPRB) THEN + IERR = IERR + 1 + ENDIF + + IF (V (JLON, JLEV, JBLK) /= 2._JPRB) THEN + IERR = IERR + 1 + ENDIF + + IF (T (JLON, JLEV, JBLK) /= 0._JPRB) THEN + IERR = IERR + 1 + ENDIF + + ENDDO + ENDDO +ENDDO + +!$acc end serial + +IF (IERR /= 0) CALL FIELD_ABORT ('VALUE MISMATCH: KDIR=NL2F') + +!$acc exit data delete (GMV) + +CALL FIELD_DELETE (FT) +CALL FIELD_DELETE (FV) +CALL FIELD_DELETE (FU) + +DEALLOCATE (GMV) + +END PROGRAM From f62599c2a5726025fc2e8e1cba6758aa1a92be08 Mon Sep 17 00:00:00 2001 From: Philippe Marguinaud Date: Fri, 31 May 2024 12:45:18 +0000 Subject: [PATCH 2/3] Fix memory location --- field_RANKSUFF_util_module.fypp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/field_RANKSUFF_util_module.fypp b/field_RANKSUFF_util_module.fypp index f0b2383..9454a5b 100644 --- a/field_RANKSUFF_util_module.fypp +++ b/field_RANKSUFF_util_module.fypp @@ -131,8 +131,8 @@ IF (ASSOCIATED (SELF)) THEN PTR => SELF%PTR - IADDRL = LOC (PTR (${",".join (map (lambda i: "ILBOUNDS(" + str (i) + "):", range (1, ft.rank+1)))}$)) - IADDRU = LOC (PTR (${",".join (map (lambda i: "IUBOUNDS(" + str (i) + "):", range (1, ft.rank+1)))}$)) + IADDRL = LOC (PTR (${",".join (map (lambda i: "ILBOUNDS(" + str (i) + ")", range (1, ft.rank+1)))}$)) + IADDRU = LOC (PTR (${",".join (map (lambda i: "IUBOUNDS(" + str (i) + ")", range (1, ft.rank+1)))}$)) IF ((KADDRL <= IADDRL) .AND. (IADDRU <= KADDRU)) THEN DEVPTR => GET_DEVICE_DATA_RDONLY (SELF) From 8134866519bbd81c9423c1f9509543bac9e6e757 Mon Sep 17 00:00:00 2001 From: Philippe Marguinaud Date: Sun, 2 Jun 2024 07:07:25 +0000 Subject: [PATCH 3/3] Fix access mode in LEGACY util --- field_RANKSUFF_util_module.fypp | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/field_RANKSUFF_util_module.fypp b/field_RANKSUFF_util_module.fypp index 9454a5b..87c181a 100644 --- a/field_RANKSUFF_util_module.fypp +++ b/field_RANKSUFF_util_module.fypp @@ -135,11 +135,12 @@ IF (ASSOCIATED (SELF)) THEN IADDRU = LOC (PTR (${",".join (map (lambda i: "IUBOUNDS(" + str (i) + ")", range (1, ft.rank+1)))}$)) IF ((KADDRL <= IADDRL) .AND. (IADDRU <= KADDRU)) THEN - DEVPTR => GET_DEVICE_DATA_RDONLY (SELF) IF (KDIR == NF2L) THEN + DEVPTR => GET_DEVICE_DATA_RDONLY (SELF) CALL LEGACY_${ft.name}$_ASSIGN (PTR, DEVPTR) ELSEIF (KDIR == NL2F) THEN + DEVPTR => GET_DEVICE_DATA_RDWR (SELF) CALL LEGACY_${ft.name}$_ASSIGN (DEVPTR, PTR) ENDIF