From bf07985d7004ca7bebf0ccf8994b077cdbb0c23b Mon Sep 17 00:00:00 2001
From: Philippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Date: Mon, 16 Jan 2023 15:22:16 +0100
Subject: [PATCH] Philippe 16/01/2023: QPASSM and RPASSM: remove 2 always 1
arguments
---
src/MNH/fft.f90 | 264 ++++++++++++++++++++++++------------------------
1 file changed, 130 insertions(+), 134 deletions(-)
diff --git a/src/MNH/fft.f90 b/src/MNH/fft.f90
index 59ac09b1d..60ee2eaab 100644
--- a/src/MNH/fft.f90
+++ b/src/MNH/fft.f90
@@ -202,15 +202,15 @@ SUBROUTINE FFT991( A, WORK, TRIGS, IFAX, JUMP, N, ILOT, ISIGN, KSZA, KSZW, KSZT
IERR=-1
IF ( IGO == 1 ) THEN
CALL RPASSM(A(IA:),A(IA+ILA:),WORK(1:),WORK(IFAC*ILA+1:), &
- TRIGS(:), &
- 1,1,JUMP,NX,NVEX,N,IFAC,ILA,IERR, &
- SIZE(A(IA:)),SIZE(A(IA+ILA:)),SIZE(WORK(1:)), &
+ TRIGS(:), &
+ JUMP,NX,NVEX,N,IFAC,ILA,IERR, &
+ SIZE(A(IA:)),SIZE(A(IA+ILA:)),SIZE(WORK(1:)), &
SIZE(WORK(IFAC*ILA+1:)),SIZE(TRIGS(:)))
ELSE
CALL RPASSM(WORK(1:),WORK(ILA+1:),A(IA:),A(IA+IFAC*ILA:), &
- TRIGS(:), &
- 1,1,NX,JUMP,NVEX,N,IFAC,ILA,IERR, &
- SIZE(WORK(1:)),SIZE(WORK(ILA+1:)),SIZE(A(IA:)), &
+ TRIGS(:), &
+ NX,JUMP,NVEX,N,IFAC,ILA,IERR, &
+ SIZE(WORK(1:)),SIZE(WORK(ILA+1:)),SIZE(A(IA:)), &
SIZE(A(IA+IFAC*ILA:)),SIZE(TRIGS(:)))
END IF
IF (IERR.NE.0) GO TO 500
@@ -267,13 +267,13 @@ SUBROUTINE FFT991( A, WORK, TRIGS, IFAX, JUMP, N, ILOT, ISIGN, KSZA, KSZW, KSZT
IF ( IGO == 1 ) THEN
CALL QPASSM(A(IA:),A(IA+IFAC*ILA:),WORK(1:),WORK(ILA+1:), &
TRIGS(:), &
- 1,1,JUMP,NX,NVEX,N,IFAC,ILA,IERR, &
+ JUMP,NX,NVEX,N,IFAC,ILA,IERR, &
SIZE(A(IA:)),SIZE(A(IA+IFAC*ILA:)),SIZE(WORK(1:)), &
SIZE(WORK(ILA+1:)),SIZE(TRIGS(:)))
ELSE
CALL QPASSM(WORK(1:),WORK(IFAC*ILA+1:),A(IA:),A(IA+ILA:), &
TRIGS(:), &
- 1,1,NX,JUMP,NVEX,N,IFAC,ILA,IERR, &
+ NX,JUMP,NVEX,N,IFAC,ILA,IERR, &
SIZE(WORK(1:)),SIZE(WORK(IFAC*ILA+1:)),SIZE(A(IA:)), &
SIZE(A(IA+ILA:)),SIZE(TRIGS(:)))
END IF
@@ -352,7 +352,7 @@ END SUBROUTINE FFT991
-SUBROUTINE RPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KSZ2,KSZ3,KSZ4,KSZ5)
+SUBROUTINE RPASSM(A,B,C,D,TRIGS,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KSZ2,KSZ3,KSZ4,KSZ5)
#ifdef MNH_OPENACC
USE MODE_MNH_ZWORK, ONLY: MNH_MEM_GET, MNH_MEM_POSITION_PIN, MNH_MEM_RELEASE
#endif
@@ -364,7 +364,7 @@ SUBROUTINE RPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
REAL, DIMENSION(KSZ3), INTENT(INOUT) :: C
REAL, DIMENSION(KSZ4), INTENT(INOUT) :: D
REAL, DIMENSION(KSZ5), INTENT(IN) :: TRIGS
- INTEGER, INTENT(IN) :: INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA
+ INTEGER, INTENT(IN) :: INC3, INC4, ILOT, N, IFAC, ILA
INTEGER, INTENT(OUT) :: IERR
INTEGER, INTENT(IN) :: KSZ1,KSZ2,KSZ3,KSZ4,KSZ5
!
@@ -372,12 +372,10 @@ SUBROUTINE RPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
! OF MULTIPLE REAL FFT (FOURIER SYNTHESIS) ROUTINE
!
! A IS FIRST REAL INPUT VECTOR
-! EQUIVALENCE B(1) WITH A (ILA*INC1+1)
+! EQUIVALENCE B(1) WITH A (ILA+1)
! C IS FIRST REAL OUTPUT VECTOR
-! EQUIVALENCE D(1) WITH C(IFAC*ILA*INC2+1)
+! EQUIVALENCE D(1) WITH C(IFAC*ILA+1)
! TRIGS IS A PRECALCULATED LIST OF SINES & COSINES
-! INC1 IS THE ADDRESSING INCREMENT FOR A
-! INC2 IS THE ADDRESSING INCREMENT FOR C
! INC3 IS THE INCREMENT BETWEEN INPUT VECTORS A
! INC4 IS THE INCREMENT BETWEEN OUTPUT VECTORS C
! ILOT IS THE NUMBER OF VECTORS
@@ -424,8 +422,8 @@ SUBROUTINE RPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
!acc kernels
M=N/IFAC
- IINK=ILA*INC1
- JINK=ILA*INC2
+ IINK=ILA
+ JINK=ILA
JUMP=(IFAC-1)*JINK
KSTOP=(N-IFAC)/(2*IFAC)
@@ -446,7 +444,7 @@ SUBROUTINE RPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
! CODING FOR FACTOR 2
! -------------------
IA=1
- IB=IA+(2*M-ILA)*INC1
+ IB=IA+2*M-ILA
JA=1
JB=JA+JINK
@@ -467,8 +465,8 @@ SUBROUTINE RPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
C(JB+J)=A(IA+I)-A(IB+I)
END DO
!acc end kernels
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
!$acc end kernels
IA=IA+IINK
@@ -499,8 +497,8 @@ SUBROUTINE RPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
C(JB+J)=C1*(A(IA+I)-A(IB+I))-S1*(B(IA+I)+B(IB+I))
D(JB+J)=S1*(A(IA+I)-A(IB+I))+C1*(B(IA+I)+B(IB+I))
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
IA=IA+IINK
IB=IB-IINK
@@ -524,8 +522,8 @@ SUBROUTINE RPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
C(JA+J)=A(IA+I)
C(JB+J)=-B(IA+I)
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
!$acc end kernels
END IF
@@ -546,8 +544,8 @@ SUBROUTINE RPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
C(JA+J)=2.0*(A(IA+I)+A(IB+I))
C(JB+J)=2.0*(A(IA+I)-A(IB+I))
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
!$acc end kernels
END IF
@@ -559,7 +557,7 @@ SUBROUTINE RPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
! CODING FOR FACTOR 3
! -------------------
IA=1
- IB=IA+(2*M-ILA)*INC1
+ IB=IA+2*M-ILA
IC=IB
JA=1
JB=JA+JINK
@@ -582,8 +580,8 @@ SUBROUTINE RPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
C(JB+J)=(A(IA+I)-0.5*A(IB+I))-(XSIN60*(B(IB+I)))
C(JC+J)=(A(IA+I)-0.5*A(IB+I))+(XSIN60*(B(IB+I)))
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
!$acc end kernels
IA=IA+IINK
@@ -635,8 +633,8 @@ SUBROUTINE RPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
+C2*((B(IA+I)-0.5*(B(IB+I)-B(IC+I)))-(XSIN60*(A(IB+I)-A(IC+ &
I))))
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
IA=IA+IINK
IB=IB+IINK
@@ -663,8 +661,8 @@ SUBROUTINE RPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
C(JB+J)=(0.5*A(IA+I)-A(IB+I))-(XSIN60*B(IA+I))
C(JC+J)=-(0.5*A(IA+I)-A(IB+I))-(XSIN60*B(IA+I))
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
!$acc end kernels
END IF
@@ -687,8 +685,8 @@ SUBROUTINE RPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
C(JB+J)=(2.0*A(IA+I)-A(IB+I))-(SSIN60*B(IB+I))
C(JC+J)=(2.0*A(IA+I)-A(IB+I))+(SSIN60*B(IB+I))
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
!$acc end kernels
END IF
@@ -701,8 +699,8 @@ SUBROUTINE RPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
! CODING FOR FACTOR 4
! -------------------
IA=1
- IB=IA+(2*M-ILA)*INC1
- IC=IB+2*M*INC1
+ IB=IA+2*M-ILA
+ IC=IB+2*M
ID=IB
JA=1
JB=JA+JINK
@@ -727,8 +725,8 @@ SUBROUTINE RPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
C(JC+J)=(A(IA+I)+A(IC+I))-A(IB+I)
C(JD+J)=(A(IA+I)-A(IC+I))+B(IB+I)
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
!$acc end kernels
IA=IA+IINK
@@ -782,8 +780,8 @@ SUBROUTINE RPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
S3*((A(IA+I)-A(IC+I))+(B(IB+I)+B(ID+I))) &
+C3*((B(IA+I)+B(IC+I))-(A(IB+I)-A(ID+I)))
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
IA=IA+IINK
IB=IB+IINK
@@ -813,8 +811,8 @@ SUBROUTINE RPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
C(JC+J)=B(IB+I)-B(IA+I)
C(JD+J)=-SIN45*((A(IA+I)-A(IB+I))+(B(IA+I)+B(IB+I)))
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
!$acc end kernels
END IF
@@ -837,8 +835,8 @@ SUBROUTINE RPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
C(JC+J)=2.0*((A(IA+I)+A(IC+I))-A(IB+I))
C(JD+J)=2.0*((A(IA+I)-A(IC+I))+B(IB+I))
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
!$acc end kernels
END IF
@@ -851,8 +849,8 @@ SUBROUTINE RPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
! CODING FOR FACTOR 5
! -------------------
IA=1
- IB=IA+(2*M-ILA)*INC1
- IC=IB+2*M*INC1
+ IB=IA+2*M-ILA
+ IC=IB+2*M
ID=IC
IE=IB
JA=1
@@ -888,8 +886,8 @@ SUBROUTINE RPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
I))) &
+(XSIN72*B(IB+I)+XSIN36*B(IC+I))
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
!$acc end kernels
IA=IA+IINK
@@ -951,8 +949,8 @@ SUBROUTINE RPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
C(JD+J)=C3*(A20(IJK)+A21(IJK))-S3*(B20(IJK)-B21(IJK))
D(JD+J)=S3*(A20(IJK)+A21(IJK))+C3*(B20(IJK)-B21(IJK))
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
IA=IA+IINK
IB=IB+IINK
@@ -991,8 +989,8 @@ SUBROUTINE RPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
I))) &
-(XSIN72*B(IA+I)-XSIN36*B(IB+I))
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
!$acc end kernels
END IF
@@ -1023,8 +1021,8 @@ SUBROUTINE RPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
C(JE+J)=(2.0*(A(IA+I)-0.25*(A(IB+I)+A(IC+I))) &
+QQRT5*(A(IB+I)-A(IC+I)))+(SSIN72*B(IB+I)+SSIN36*B(IC+I))
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
!$acc end kernels
END IF
@@ -1037,9 +1035,9 @@ SUBROUTINE RPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
! CODING FOR FACTOR 6
! -------------------
IA=1
- IB=IA+(2*M-ILA)*INC1
- IC=IB+2*M*INC1
- ID=IC+2*M*INC1
+ IB=IA+2*M-ILA
+ IC=IB+2*M
+ ID=IC+2*M
IE=IC
IF=IB
JA=1
@@ -1073,8 +1071,8 @@ SUBROUTINE RPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
C(JE+J)=((A(IA+I)+A(ID+I))-0.5*(A(IB+I)+A(IC+I))) &
+(XSIN60*(B(IB+I)-B(IC+I)))
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
!$acc end kernels
IA=IA+IINK
@@ -1146,8 +1144,8 @@ SUBROUTINE RPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
C(JF+J)=C5*(A20(IJK)+B21(IJK))-S5*(B20(IJK)+A21(IJK))
D(JF+J)=S5*(A20(IJK)+B21(IJK))+C5*(B20(IJK)+A21(IJK))
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
IA=IA+IINK
IB=IB+IINK
@@ -1182,8 +1180,8 @@ SUBROUTINE RPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
C(JC+J)=XSIN60*(B(IC+I)-B(IA+I))+(0.5*(A(IA+I)+A(IC+I))-A(IB+I))
C(JE+J)=XSIN60*(B(IC+I)-B(IA+I))-(0.5*(A(IA+I)+A(IC+I))-A(IB+I))
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
!$acc end kernels
END IF
@@ -1213,8 +1211,8 @@ SUBROUTINE RPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
C(JE+J)=(2.0*(A(IA+I)+A(ID+I))-(A(IB+I)+A(IC+I))) &
+(SSIN60*(B(IB+I)-B(IC+I)))
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
!$acc end kernels
END IF
@@ -1231,10 +1229,10 @@ SUBROUTINE RPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
ELSE
!$acc kernels
IA=1
- IB=IA+ILA*INC1
- IC=IB+2*ILA*INC1
- ID=IC+2*ILA*INC1
- IE=ID+2*ILA*INC1
+ IB=IA+ILA
+ IC=IB+2*ILA
+ ID=IC+2*ILA
+ IE=ID+2*ILA
JA=1
JB=JA+JINK
JC=JB+JINK
@@ -1268,8 +1266,8 @@ SUBROUTINE RPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
C(JH+J)=2.0*((A(IA+I)-A(IE+I))+B(IC+I)) &
+SSIN45*((A(IB+I)-A(ID+I))+(B(IB+I)+B(ID+I)))
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
!$acc end kernels
IBAD=0
@@ -1297,7 +1295,7 @@ END SUBROUTINE RPASSM
-SUBROUTINE QPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KSZ2,KSZ3,KSZ4,KSZ5)
+SUBROUTINE QPASSM(A,B,C,D,TRIGS,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KSZ2,KSZ3,KSZ4,KSZ5)
IMPLICIT NONE
REAL, DIMENSION(KSZ1), INTENT(IN) :: A
@@ -1305,7 +1303,7 @@ SUBROUTINE QPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
REAL, DIMENSION(KSZ3), INTENT(INOUT) :: C
REAL, DIMENSION(KSZ4), INTENT(INOUT) :: D
REAL, DIMENSION(KSZ5), INTENT(IN) :: TRIGS
- INTEGER, INTENT(IN) :: INC1, INC2, INC3, INC4, ILOT, N, IFAC, ILA
+ INTEGER, INTENT(IN) :: INC3, INC4, ILOT, N, IFAC, ILA
INTEGER, INTENT(OUT) :: IERR
INTEGER, INTENT(IN) :: KSZ1, KSZ2, KSZ3, KSZ4, KSZ5
!
@@ -1313,12 +1311,10 @@ SUBROUTINE QPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
! OF MULTIPLE REAL FFT (FOURIER ANALYSIS) ROUTINE
!
! A IS FIRST REAL INPUT VECTOR
-! EQUIVALENCE B(1) WITH A(IFAC*ILA*INC1+1)
+! EQUIVALENCE B(1) WITH A(IFAC*ILA+1)
! C IS FIRST REAL OUTPUT VECTOR
-! EQUIVALENCE D(1) WITH C(ILA*INC2+1)
+! EQUIVALENCE D(1) WITH C(ILA+1)
! TRIGS IS A PRECALCULATED LIST OF SINES & COSINES
-! INC1 IS THE ADDRESSING INCREMENT FOR A
-! INC2 IS THE ADDRESSING INCREMENT FOR C
! INC3 IS THE INCREMENT BETWEEN INPUT VECTORS A
! INC4 IS THE INCREMENT BETWEEN OUTPUT VECTORS C
! ILOT IS THE NUMBER OF VECTORS
@@ -1350,8 +1346,8 @@ SUBROUTINE QPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
M=N/IFAC
- IINK=ILA*INC1
- JINK=ILA*INC2
+ IINK=ILA
+ JINK=ILA
IJUMP=(IFAC-1)*IINK
KSTOP=(N-IFAC)/(2*IFAC)
@@ -1372,7 +1368,7 @@ SUBROUTINE QPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
IA=1
IB=IA+IINK
JA=1
- JB=JA+(2*M-ILA)*INC2
+ JB=JA+2*M-ILA
IF ( ILA /= M ) THEN
@@ -1390,8 +1386,8 @@ SUBROUTINE QPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
C(JA+J)=A(IA+I)+A(IB+I)
C(JB+J)=A(IA+I)-A(IB+I)
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
!$acc end kernels
JA=JA+JINK
@@ -1421,8 +1417,8 @@ SUBROUTINE QPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
D(JA+J)=(C1*B(IB+I)-S1*A(IB+I))+B(IA+I)
D(JB+J)=(C1*B(IB+I)-S1*A(IB+I))-B(IA+I)
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
IBASE=IBASE+IJUMP
JA=JA+JINK
@@ -1447,8 +1443,8 @@ SUBROUTINE QPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
C(JA+J)=A(IA+I)
D(JA+J)=-A(IB+I)
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
!$acc end kernels
END IF
@@ -1470,8 +1466,8 @@ SUBROUTINE QPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
C(JA+J)=Z*(A(IA+I)+A(IB+I))
C(JB+J)=Z*(A(IA+I)-A(IB+I))
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
!$acc end kernels
@@ -1489,7 +1485,7 @@ SUBROUTINE QPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
IB=IA+IINK
IC=IB+IINK
JA=1
- JB=JA+(2*M-ILA)*INC2
+ JB=JA+2*M-ILA
JC=JB
IF ( ILA /= M ) THEN
@@ -1509,8 +1505,8 @@ SUBROUTINE QPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
C(JB+J)=A(IA+I)-0.5*(A(IB+I)+A(IC+I))
D(JB+J)=XSIN60*(A(IC+I)-A(IB+I))
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
!$acc end kernels
JA=JA+JINK
@@ -1552,8 +1548,8 @@ SUBROUTINE QPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
C(JC+J)=A2-B3
D(JC+J)=-(B2+A3)
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
IBASE=IBASE+IJUMP
JA=JA+JINK
@@ -1580,8 +1576,8 @@ SUBROUTINE QPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
D(JA+J)=-XSIN60*(A(IB+I)+A(IC+I))
C(JB+J)=A(IA+I)-(A(IB+I)-A(IC+I))
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
!$acc end kernels
END IF
@@ -1605,8 +1601,8 @@ SUBROUTINE QPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
C(JB+J)=Z*(A(IA+I)-0.5*(A(IB+I)+A(IC+I)))
D(JB+J)=ZSIN60*(A(IC+I)-A(IB+I))
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
!$acc end kernels
END IF
@@ -1624,8 +1620,8 @@ SUBROUTINE QPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
IC=IB+IINK
ID=IC+IINK
JA=1
- JB=JA+(2*M-ILA)*INC2
- JC=JB+2*M*INC2
+ JB=JA+2*M-ILA
+ JC=JB+2*M
JD=JB
IF ( ILA /= M ) THEN
@@ -1645,8 +1641,8 @@ SUBROUTINE QPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
C(JB+J)=A(IA+I)-A(IC+I)
D(JB+J)=A(ID+I)-A(IB+I)
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
!$acc end kernels
JA=JA+JINK
@@ -1696,8 +1692,8 @@ SUBROUTINE QPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
D(JB+J)=B2-A3
D(JD+J)=-(B2+A3)
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
IBASE=IBASE+IJUMP
JA=JA+JINK
@@ -1727,8 +1723,8 @@ SUBROUTINE QPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
D(JA+J)=-A(IC+I)-SIN45*(A(IB+I)+A(ID+I))
D(JB+J)=A(IC+I)-SIN45*(A(IB+I)+A(ID+I))
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
!$acc end kernels
END IF
@@ -1751,8 +1747,8 @@ SUBROUTINE QPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
C(JB+J)=Z*(A(IA+I)-A(IC+I))
D(JB+J)=Z*(A(ID+I)-A(IB+I))
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
!$acc end kernels
END IF
@@ -1770,8 +1766,8 @@ SUBROUTINE QPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
ID=IC+IINK
IE=ID+IINK
JA=1
- JB=JA+(2*M-ILA)*INC2
- JC=JB+2*M*INC2
+ JB=JA+2*M-ILA
+ JC=JB+2*M
JD=JC
JE=JB
@@ -1799,8 +1795,8 @@ SUBROUTINE QPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
D(JB+J)=-XSIN72*A3-XSIN36*A4
D(JC+J)=-XSIN36*A3+XSIN72*A4
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
!$acc end kernels
JA=JA+JINK
@@ -1868,8 +1864,8 @@ SUBROUTINE QPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
D(JC+J)=B20-B21
D(JD+J)=-(B20+B21)
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
IBASE=IBASE+IJUMP
JA=JA+JINK
@@ -1906,8 +1902,8 @@ SUBROUTINE QPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
D(JA+J)=-XSIN36*A1-XSIN72*A2
D(JB+J)=-XSIN72*A1+XSIN36*A2
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
!$acc end kernels
END IF
@@ -1940,8 +1936,8 @@ SUBROUTINE QPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
D(JB+J)=-ZSIN72*A3-ZSIN36*A4
D(JC+J)=-ZSIN36*A3+ZSIN72*A4
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
!$acc end kernels
END IF
@@ -1960,9 +1956,9 @@ SUBROUTINE QPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
IE=ID+IINK
IF=IE+IINK
JA=1
- JB=JA+(2*M-ILA)*INC2
- JC=JB+2*M*INC2
- JD=JC+2*M*INC2
+ JB=JA+2*M-ILA
+ JC=JB+2*M
+ JD=JC+2*M
JE=JC
JF=JB
@@ -1988,8 +1984,8 @@ SUBROUTINE QPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
D(JB+J)=XSIN60*((A(IE+I)-A(IB+I))-(A(IC+I)-A(IF+I)))
C(JD+J)=(A(IA+I)-A(ID+I))+A11
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
!$acc end kernels
JA=JA+JINK
@@ -2065,8 +2061,8 @@ SUBROUTINE QPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
C(JF+J)=A20+B21
D(JF+J)=A21+B20
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
IBASE=IBASE+IJUMP
JA=JA+JINK
@@ -2099,8 +2095,8 @@ SUBROUTINE QPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
C(JC+J)=(A(IA+I)+0.5*(A(IC+I)-A(IE+I)))-XSIN60*(A(IB+I)-A(IF+I))
D(JC+J)=-(A(ID+I)+0.5*(A(IB+I)+A(IF+I)))+XSIN60*(A(IC+I)+A(IE+I))
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
!$acc end kernels
END IF
@@ -2129,8 +2125,8 @@ SUBROUTINE QPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
D(JB+J)=ZSIN60*((A(IE+I)-A(IB+I))-(A(IC+I)-A(IF+I)))
C(JD+J)=Z*((A(IA+I)-A(ID+I))+A11)
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
!$acc end kernels
END IF
@@ -2156,10 +2152,10 @@ SUBROUTINE QPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
IG=IF+IINK
IH=IG+IINK
JA=1
- JB=JA+ILA*INC2
- JC=JB+2*M*INC2
- JD=JC+2*M*INC2
- JE=JD+2*M*INC2
+ JB=JA+ILA
+ JC=JB+2*M
+ JD=JC+2*M
+ JE=JD+2*M
Z=1.0/REAL(N)
ZSIN45=Z*SQRT(0.5)
@@ -2190,8 +2186,8 @@ SUBROUTINE QPASSM(A,B,C,D,TRIGS,INC1,INC2,INC3,INC4,ILOT,N,IFAC,ILA,IERR,KSZ1,KS
! I=I+INC3
! J=J+INC4
END DO
- IBASE=IBASE+INC1
- JBASE=JBASE+INC2
+ IBASE=IBASE+1
+ JBASE=JBASE+1
END DO
!$acc end kernels
IBAD=0
--
GitLab