From e503997e2b0a41e0325807f5958356de88e4add0 Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Mon, 22 May 2023 14:36:51 +0200
Subject: [PATCH] Philippe 22/05/2023: FFT: FFT991: pass argument PWORK as a 3D
array (no need to use an intermediary 1D pointer at this level)
---
src/MNH/fft.f90 | 26 +++++++++++++++-----------
src/MNH/fft55.f90 | 10 ++++------
src/MNH/flat_inv.f90 | 13 ++++---------
src/MNH/flat_invz.f90 | 25 ++++++++-----------------
4 files changed, 31 insertions(+), 43 deletions(-)
diff --git a/src/MNH/fft.f90 b/src/MNH/fft.f90
index 298211f32..7bfd0ef4b 100644
--- a/src/MNH/fft.f90
+++ b/src/MNH/fft.f90
@@ -93,7 +93,7 @@ SUBROUTINE FFT991( PA, PWORK, PTRIGS, PFAX, KJUMP, KN, KLOT, KSIGN )
IMPLICIT NONE
REAL, DIMENSION(:), INTENT(INOUT) :: PA
- REAL, DIMENSION(:), INTENT(OUT) :: PWORK
+ REAL, DIMENSION(:,:,:), CONTIGUOUS, TARGET, INTENT(OUT) :: PWORK
REAL, DIMENSION(:), INTENT(IN) :: PTRIGS
INTEGER, DIMENSION(19), INTENT(IN) :: PFAX
INTEGER, INTENT(IN) :: KJUMP, KN, KLOT, KSIGN
@@ -141,6 +141,7 @@ SUBROUTINE FFT991( PA, PWORK, PTRIGS, PFAX, KJUMP, KN, KLOT, KSIGN )
INTEGER :: IIBASE, IJBASE
INTEGER :: II, JJ, IX, IZ
INTEGER :: I0
+ REAL, DIMENSION(:), POINTER :: ZWORK
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
@@ -150,10 +151,13 @@ SUBROUTINE FFT991( PA, PWORK, PTRIGS, PFAX, KJUMP, KN, KLOT, KSIGN )
CALL MPPDB_CHECK( PA, "FFT991 beg:PA" )
END IF
-!$acc data present( PA, PWORK )
+ZWORK(1 : SIZE(PWORK)) => PWORK(:,:,:)
- ! Initialisation of PWORK useful to compare results with MPPDB_CHECK (otherwise all values are not set by FFT991
- PWORK(:) = 0.
+!$acc data present( PA, ZWORK )
+
+ ! Initialisation of ZWORK useful to compare results with MPPDB_CHECK (otherwise all values are not set by FFT991
+ ZWORK(:) = 0.
+!$acc update device( ZWORK )
#if 0
!PW: Original version: but in that case, intent of PTRIGS and KFAX are not correct
@@ -203,10 +207,10 @@ SUBROUTINE FFT991( PA, PWORK, PTRIGS, PFAX, KJUMP, KN, KLOT, KSIGN )
IFAC=PFAX(IK+1)
IERR=-1
IF ( IGO == 1 ) THEN
- CALL RPASSM( PA(IA:), PA(IA+ILA:), PWORK(:), PWORK(IFAC*ILA+1:), PTRIGS(:), &
+ CALL RPASSM( PA(IA:), PA(IA+ILA:), ZWORK(:), ZWORK(IFAC*ILA+1:), PTRIGS(:), &
KJUMP, INX, INVEX, KN, IFAC, ILA, IERR )
ELSE
- CALL RPASSM( PWORK(:), PWORK(ILA+1:), PA(IA:), PA(IA+IFAC*ILA:), PTRIGS(:), &
+ CALL RPASSM( ZWORK(:), ZWORK(ILA+1:), PA(IA:), PA(IA+IFAC*ILA:), PTRIGS(:), &
INX, KJUMP, INVEX, KN, IFAC, ILA, IERR )
END IF
IF (IERR.NE.0) GO TO 500
@@ -225,7 +229,7 @@ SUBROUTINE FFT991( PA, PWORK, PTRIGS, PFAX, KJUMP, KN, KLOT, KSIGN )
DO JJ = 1, INVEX
IIBASE = 1 + (JJ-1) * INX
IJBASE = IA + (JJ-1) * KJUMP
- PA(IJBASE:IJBASE+KN-1) = PWORK(IIBASE:IIBASE+KN-1)
+ PA(IJBASE:IJBASE+KN-1) = ZWORK(IIBASE:IIBASE+KN-1)
END DO
!$acc end kernels
END IF
@@ -256,10 +260,10 @@ SUBROUTINE FFT991( PA, PWORK, PTRIGS, PFAX, KJUMP, KN, KLOT, KSIGN )
ILA=ILA/IFAC
IERR=-1
IF ( IGO == 1 ) THEN
- CALL QPASSM( PA(IA:), PA(IA+IFAC*ILA:), PWORK(:), PWORK(ILA+1:), PTRIGS(:), &
+ CALL QPASSM( PA(IA:), PA(IA+IFAC*ILA:), ZWORK(:), ZWORK(ILA+1:), PTRIGS(:), &
KJUMP, INX, INVEX, KN, IFAC, ILA, IERR )
ELSE
- CALL QPASSM( PWORK(:), PWORK(IFAC*ILA+1:), PA(IA:), PA(IA+ILA:), PTRIGS(:), &
+ CALL QPASSM( ZWORK(:), ZWORK(IFAC*ILA+1:), PA(IA:), PA(IA+ILA:), PTRIGS(:), &
INX, KJUMP, INVEX, KN, IFAC, ILA, IERR )
END IF
IF (IERR.NE.0) GO TO 500
@@ -277,7 +281,7 @@ SUBROUTINE FFT991( PA, PWORK, PTRIGS, PFAX, KJUMP, KN, KLOT, KSIGN )
DO JJ = 1, INVEX
IIBASE = 1 + (JJ-1) * INX
IJBASE = IA + (JJ-1) * KJUMP
- PA(IJBASE:IJBASE+KN-1) = PWORK(IIBASE:IIBASE+KN-1)
+ PA(IJBASE:IJBASE+KN-1) = ZWORK(IIBASE:IIBASE+KN-1)
END DO
!$acc end kernels
END IF
@@ -326,7 +330,7 @@ SUBROUTINE FFT991( PA, PWORK, PTRIGS, PFAX, KJUMP, KN, KLOT, KSIGN )
!Check all INOUT arrays
CALL MPPDB_CHECK( PA, "FFT991 end:PA" )
!Check all OUT arrays
- CALL MPPDB_CHECK( PWORK, "FFT991 end:PWORK" )
+ CALL MPPDB_CHECK( ZWORK, "FFT991 end:PWORK" )
END IF
END SUBROUTINE FFT991
diff --git a/src/MNH/fft55.f90 b/src/MNH/fft55.f90
index b6908c37f..02baa21a1 100644
--- a/src/MNH/fft55.f90
+++ b/src/MNH/fft55.f90
@@ -103,7 +103,7 @@ INTEGER, DIMENSION(19), INTENT(IN) :: KIFAX ! previously prepared list of
INTEGER, INTENT(IN) :: KISIGN ! +1 for transform from spectral to gridpoint
! -1 for transform from gridpoint to spectral
!
-REAL, DIMENSION(:,:,:), CONTIGUOUS, TARGET, INTENT(OUT) :: PWORK ! area of size (2*N)*MIN(LOT,NVECLEN)
+REAL, DIMENSION(:,:,:), CONTIGUOUS, INTENT(OUT) :: PWORK ! area of size (2*N)*MIN(LOT,NVECLEN)
!
REAL, DIMENSION(:,:,:), CONTIGUOUS, TARGET, INTENT(INOUT) :: PA ! input and output data
!
@@ -123,7 +123,6 @@ REAL :: ZSCALE, ZSCALE1, ZSCALE2
!
REAL :: ZT1, ZT2, ZCO, ZRI
REAL, DIMENSION(:), POINTER :: ZA
-REAL, DIMENSION(:), POINTER :: ZWORK
!
!-------------------------------------------------------------------------------
@@ -144,9 +143,8 @@ END IF
IN = SIZE( PA, 1 ) - 2 * JPHEXT
ZA(1:IJUMP*ILOT) => PA(:,:,:)
-ZWORK(1:IJUMP*ILOT) => PWORK(:,:,:)
-!$acc data present( ZA, ZWORK, PTRIGS )
+!$acc data present( ZA, PWORK, PTRIGS )
!
!* 1. COMPUTE LOOP BOUNDS
! -------------------
@@ -221,7 +219,7 @@ IF (KISIGN.EQ.1) THEN
!
IIS=-1
IIA=ISTART
- CALL FFT991( ZA(IIA:), ZWORK(:), PTRIGS, KIFAX, IJUMP, IN, INVEX, IIS )
+ CALL FFT991( ZA(IIA:), PWORK(:,:,:), PTRIGS, KIFAX, IJUMP, IN, INVEX, IIS )
!
! 2.3 postprocessing
! --------------
@@ -300,7 +298,7 @@ ELSE
!
IIA=ISTART
IIS=1
- CALL FFT991( ZA(IIA:), ZWORK(:), PTRIGS, KIFAX, IJUMP, IN, INVEX, IIS )
+ CALL FFT991( ZA(IIA:), PWORK(:,:,:), PTRIGS, KIFAX, IJUMP, IN, INVEX, IIS )
!
! 3.3 postprocessing
! --------------
diff --git a/src/MNH/flat_inv.f90 b/src/MNH/flat_inv.f90
index 89637dd96..e9cb8d81a 100644
--- a/src/MNH/flat_inv.f90
+++ b/src/MNH/flat_inv.f90
@@ -245,7 +245,6 @@ REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZBAND_YT ! array in Y slices dis
REAL, DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ZBAND_YRT ! array in Y slices distribution transpose
#endif
REAL, DIMENSION(:), POINTER, CONTIGUOUS :: ZBAND1D
-REAL, DIMENSION(:), POINTER, CONTIGUOUS :: ZWORK1D
!-------------------------------------------------------------------------------
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
@@ -417,8 +416,7 @@ CALL REMAP_2WAY_X_ll(ZY,ZBAND_X,IINFO_ll)
!
IF (HLBCX(1) == 'CYCL') THEN
ZBAND1D( 1 : SIZE(ZBAND_X,1)*SIZE(ZBAND_X,2)*SIZE(ZBAND_X(:,:,IKB-1:),3) ) => ZBAND_X(:,:,IKB-1:)
- ZWORK1D( 1 : SIZE(ZWORKX) ) => ZWORKX(:,:,:)
- CALL FFT991( ZBAND1D, ZWORK1D, PTRIGSX, KIFAXX, INC2X, IIMAX, ILOTX, -1 )
+ CALL FFT991( ZBAND1D, ZWORKX, PTRIGSX, KIFAXX, INC2X, IIMAX, ILOTX, -1 )
ELSE
CALL FFT55( ZBAND_X(1:,1:,IKB-1:), ZWORKX, PTRIGSX, KIFAXX, -1 )
END IF
@@ -437,8 +435,7 @@ IF (.NOT. L2D) THEN
!
IF (HLBCY(1) == 'CYCL') THEN
ZBAND1D( 1 : SIZE(ZBAND_YT,1)*SIZE(ZBAND_YT,2)*SIZE(ZBAND_YT(:,:,IKB-1:),3) ) => ZBAND_YT(:,:,IKB-1:)
- ZWORK1D( 1 : SIZE(ZWORKY) ) => ZWORKY(:,:,:)
- CALL FFT991( ZBAND1D, ZWORK1D, PTRIGSY, KIFAXY, INC2Y, IJMAX, ILOTY, -1 )
+ CALL FFT991( ZBAND1D, ZWORKY, PTRIGSY, KIFAXY, INC2Y, IJMAX, ILOTY, -1 )
ELSE
CALL FFT55( ZBAND_YT(1:,1:,IKB-1:), ZWORKY, PTRIGSY, KIFAXY, -1 )
END IF
@@ -493,8 +490,7 @@ END IF
IF (.NOT. L2D) THEN
IF (HLBCY(1) == 'CYCL') THEN
ZBAND1D( 1 : SIZE(ZBAND_YRT,1)*SIZE(ZBAND_YRT,2)*SIZE(ZBAND_YRT(:,:,IKB-1:),3) ) => ZBAND_YRT(:,:,IKB-1:)
- ZWORK1D( 1 : SIZE(ZWORKY) ) => ZWORKY(:,:,:)
- CALL FFT991( ZBAND1D, ZWORK1D, PTRIGSY, KIFAXY, INC2Y, IJMAX, ILOTY, +1 )
+ CALL FFT991( ZBAND1D, ZWORKY, PTRIGSY, KIFAXY, INC2Y, IJMAX, ILOTY, +1 )
ELSE
CALL FFT55( ZBAND_YRT(1:,1:,IKB-1:), ZWORKY, PTRIGSY, KIFAXY, +1 )
END IF
@@ -512,8 +508,7 @@ CALL REMAP_Y_X_ll(ZBAND_YR,ZBAND_X,IINFO_ll)
!
IF (HLBCX(1) == 'CYCL') THEN
ZBAND1D( 1 : SIZE(ZBAND_X,1)*SIZE(ZBAND_X,2)*SIZE(ZBAND_X(:,:,IKB-1:),3) ) => ZBAND_X(:,:,IKB-1:)
- ZWORK1D( 1 : SIZE(ZWORKX) ) => ZWORKX(:,:,:)
- CALL FFT991( ZBAND1D, ZWORK1D, PTRIGSX, KIFAXX, INC2X, IIMAX, ILOTX, +1 )
+ CALL FFT991( ZBAND1D, ZWORKX, PTRIGSX, KIFAXX, INC2X, IIMAX, ILOTX, +1 )
ELSE
CALL FFT55( ZBAND_X(1:,1:,IKB-1:), ZWORKX, PTRIGSX, KIFAXX, +1 )
END IF
diff --git a/src/MNH/flat_invz.f90 b/src/MNH/flat_invz.f90
index 334d61894..ea7b6b3cd 100644
--- a/src/MNH/flat_invz.f90
+++ b/src/MNH/flat_invz.f90
@@ -341,7 +341,6 @@ SUBROUTINE FLAT_INVZ(HLBCX,HLBCY,PDXHATM,PDYHATM,PRHOM,PAF,PBF,PCF, &
! INTEGER :: IERROR
!JUAN
REAL, DIMENSION(:), POINTER, CONTIGUOUS :: ZBAND1D
- REAL, DIMENSION(:), POINTER, CONTIGUOUS :: ZWORK1D
!-------------------------------------------------------------------------------
!
!* 1. COMPUTE LOOP BOUNDS
@@ -671,8 +670,7 @@ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'FLAT_INVZ', 'OpenACC: IAND(NZ_SPLITTING,1
IF ( IAND(NZ_SPLITTING,1) > 0 ) THEN
IF (HLBCX(1) == 'CYCL') THEN
ZBAND1D( 1 : SIZE(ZBAND_X,1)*SIZE(ZBAND_X,2)*SIZE(ZBAND_X(:,:,IKB-1:),3) ) => ZBAND_X(:,:,IKB-1:)
- ZWORK1D( 1 : SIZE(ZWORKX) ) => ZWORKX(:,:,:)
- CALL FFT991( ZBAND1D, ZWORK1D, PTRIGSX, KIFAXX, INC2X, IIMAX, ILOTX, -1 )
+ CALL FFT991( ZBAND1D, ZWORKX(:,:,:), PTRIGSX, KIFAXX, INC2X, IIMAX, ILOTX, -1 )
ELSE
CALL FFT55( ZBAND_X(1:,1:,IKB-1:), ZWORKX, PTRIGSX, KIFAXX, -1 )
END IF
@@ -691,8 +689,7 @@ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'FLAT_INVZ', 'OpenACC: IAND(NZ_SPLITTING,1
CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'FLAT_INVZ', 'OpenACC: HLBCX(1)==CYCL not ported' )
#endif
ZBAND1D( 1 : SIZE(ZBAND_SX_YP2_ZP1) ) => ZBAND_SX_YP2_ZP1(:,:,:)
- ZWORK1D( 1 : SIZE(ZWORK_SX_YP2_ZP1) ) => ZWORK_SX_YP2_ZP1(:,:,:)
- CALL FFT991( ZBAND1D, ZWORK1D, PTRIGSX, KIFAXX, INC2_SX_YP2_ZP1, IIMAX, ILOT_SX_YP2_ZP1, -1 )
+ CALL FFT991( ZBAND1D, ZWORK_SX_YP2_ZP1(:,:,:), PTRIGSX, KIFAXX, INC2_SX_YP2_ZP1, IIMAX, ILOT_SX_YP2_ZP1, -1 )
! move (N+1) values in (2) values to avoid to lost them
ZBAND_SX_YP2_ZP1(2,:,:) = ZBAND_SX_YP2_ZP1(INC2_SX_YP2_ZP1-1,:,:)
!ZBAND_SX_YP2_ZP1(INC2_SX_YP2_ZP1-1,:,:) = 0.0
@@ -723,8 +720,7 @@ CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'FLAT_INVZ', 'OpenACC: HLBCX(1)==CYCL not po
!
IF (HLBCY(1) == 'CYCL') THEN
ZBAND1D( 1 : SIZE(ZBAND_YT,1)*SIZE(ZBAND_YT,2)*SIZE(ZBAND_YT(:,:,IKB-1:),3) ) => ZBAND_YT(:,:,IKB-1:)
- ZWORK1D( 1 : SIZE(ZWORKY) ) => ZWORKY(:,:,:)
- CALL FFT991( ZBAND1D, ZWORK1D, PTRIGSY, KIFAXY, INC2Y, IJMAX, ILOTY, -1 )
+ CALL FFT991( ZBAND1D, ZWORKY(:,:,:), PTRIGSY, KIFAXY, INC2Y, IJMAX, ILOTY, -1 )
ELSE
CALL FFT55( ZBAND_YT(1:,1:,IKB-1:), ZWORKY, PTRIGSY, KIFAXY, -1 )
END IF
@@ -744,8 +740,7 @@ CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'FLAT_INVZ', 'OpenACC: HLBCX(1)==CYCL not po
CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'FLAT_INVZ', 'OpenACC: HLBCY(1)==CYCL not ported' )
#endif
ZBAND1D( 1 : SIZE(ZBAND_SXP2_Y_ZP1T) ) => ZBAND_SXP2_Y_ZP1T(:,:,:)
- ZWORK1D( 1 : SIZE(ZWORK_SXP2_Y_ZP1) ) => ZWORK_SXP2_Y_ZP1(:,:,:)
- CALL FFT991( ZBAND1D, ZWORK1D, PTRIGSY, KIFAXY, INC2_SXP2_Y_ZP1, IJMAX, ILOT_SXP2_Y_ZP1, -1 )
+ CALL FFT991( ZBAND1D, ZWORK_SXP2_Y_ZP1(:,:,:), PTRIGSY, KIFAXY, INC2_SXP2_Y_ZP1, IJMAX, ILOT_SXP2_Y_ZP1, -1 )
! move (N+1) values in (2) values to avoid to lost them
ZBAND_SXP2_Y_ZP1T(2,:,:) = ZBAND_SXP2_Y_ZP1T(INC2_SXP2_Y_ZP1-1,:,:)
!ZBAND_SXP2_Y_ZP1T(INC2_SXP2_Y_ZP1-1,:,:) = 0.0
@@ -881,8 +876,7 @@ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'FLAT_INVZ', 'L2D=T not tested' )
IF (.NOT. L2D) THEN
IF (HLBCY(1) == 'CYCL') THEN
ZBAND1D( 1 : SIZE(ZBAND_YRT,1)*SIZE(ZBAND_YRT,2)*SIZE(ZBAND_YRT(:,:,IKB-1:),3) ) => ZBAND_YRT(:,:,IKB-1:)
- ZWORK1D( 1 : SIZE(ZWORKY) ) => ZWORKY(:,:,:)
- CALL FFT991( ZBAND1D, ZWORK1D, PTRIGSY, KIFAXY, INC2Y, IJMAX, ILOTY, +1 )
+ CALL FFT991( ZBAND1D, ZWORKY(:,:,:), PTRIGSY, KIFAXY, INC2Y, IJMAX, ILOTY, +1 )
ELSE
CALL FFT55( ZBAND_YRT(1:,1:,IKB-1:), ZWORKY, PTRIGSY, KIFAXY, +1 )
END IF
@@ -900,8 +894,7 @@ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'FLAT_INVZ', 'L2D=T not tested' )
!
IF (HLBCX(1) == 'CYCL') THEN
ZBAND1D( 1 : SIZE(ZBAND_X,1)*SIZE(ZBAND_X,2)*SIZE(ZBAND_X(:,:,IKB-1:),3) ) => ZBAND_X(:,:,IKB-1:)
- ZWORK1D( 1 : SIZE(ZWORKX) ) => ZWORKX(:,:,:)
- CALL FFT991( ZBAND1D, ZWORK1D, PTRIGSX, KIFAXX, INC2X, IIMAX, ILOTX, +1 )
+ CALL FFT991( ZBAND1D, ZWORKX(:,:,:), PTRIGSX, KIFAXX, INC2X, IIMAX, ILOTX, +1 )
ELSE
CALL FFT55( ZBAND_X(1:,1:,IKB-1:), ZWORKX, PTRIGSX, KIFAXX, +1 )
END IF
@@ -936,8 +929,7 @@ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'FLAT_INVZ', 'L2D=T not tested' )
ZBAND_SXP2_Y_ZP1RT(2,:,:) = 0.0
!$acc end kernels
ZBAND1D( 1 : SIZE(ZBAND_SXP2_Y_ZP1RT) ) => ZBAND_SXP2_Y_ZP1RT(:,:,:)
- ZWORK1D( 1 : SIZE(ZWORK_SXP2_Y_ZP1) ) => ZWORK_SXP2_Y_ZP1(:,:,:)
- CALL FFT991( ZBAND1D, ZWORK1D, PTRIGSY, KIFAXY, INC2_SXP2_Y_ZP1, IJMAX, ILOT_SXP2_Y_ZP1, +1 )
+ CALL FFT991( ZBAND1D, ZWORK_SXP2_Y_ZP1(:,:,:), PTRIGSY, KIFAXY, INC2_SXP2_Y_ZP1, IJMAX, ILOT_SXP2_Y_ZP1, +1 )
ELSE
CALL FFT55( ZBAND_SXP2_Y_ZP1RT, ZWORK_SXP2_Y_ZP1, PTRIGSY, KIFAXY, +1 )
END IF
@@ -963,8 +955,7 @@ CALL PRINT_MSG( NVERB_WARNING, 'GEN', 'FLAT_INVZ', 'L2D=T not tested' )
ZBAND_SX_YP2_ZP1(2,:,:) = 0.0
!$acc end kernels
ZBAND1D( 1 : SIZE(ZBAND_SX_YP2_ZP1) ) => ZBAND_SX_YP2_ZP1(:,:,:)
- ZWORK1D( 1 : SIZE(ZWORK_SX_YP2_ZP1) ) => ZWORK_SX_YP2_ZP1(:,:,:)
- CALL FFT991( ZBAND1D, ZWORK1D, PTRIGSX, KIFAXX, INC2_SX_YP2_ZP1, IIMAX, ILOT_SX_YP2_ZP1, +1 )
+ CALL FFT991( ZBAND1D, ZWORK_SX_YP2_ZP1(:,:,:), PTRIGSX, KIFAXX, INC2_SX_YP2_ZP1, IIMAX, ILOT_SX_YP2_ZP1, +1 )
ELSE
CALL FFT55( ZBAND_SX_YP2_ZP1, ZWORK_SX_YP2_ZP1, PTRIGSX, KIFAXX, +1 )
END IF
--
GitLab