minix/pkgsrc-ng
1
0
Fork 0
mirror of https://github.com/Stichting-MINIX-Research-Foundation/pkgsrc-ng.git synced 2025-08-04 02:08:49 -04:00
Code Issues Packages Projects Releases Wiki Activity
pkgsrc-ng/benchmarks/benchfft/patches/patch-af
Lionel Sambuc 785076ae39 Import of pkgsrc-2013Q2
2013-09-26 17:14:40 +02:00

420 lines
13 KiB
Plaintext
Raw Blame History

$NetBSD: patch-af,v 1.5 2008/06/21 20:00:22 joerg Exp $
Reorder functions in usage order to fix compilation with f2c.
--- f_source/sciport/ffts.f.orig 2008-06-21 13:38:06.000000000 +0000
+++ f_source/sciport/ffts.f
@@ -1,3 +1,190 @@
+C----------------------------------------------- ************
+C CABLE2
+C ************
+ SUBROUTINE SPSCABLE2(NN,WORK)
+C
+ REAL WORK(2,NN),TWOPI
+ DATA TWOPI /6.28318530717958647692/
+C
+ N = 2 * NN
+ P2 = TWOPI/N
+ DO 10 I=1, NN
+ WORK(1,I) = COS(P2 * (I-1))
+ WORK(2,I) = SIN(P2 * (I-1))
+ 10 CONTINUE
+ RETURN
+ END
+
+C----------------------------------------------- ************
+C RCONV2
+C ************
+ SUBROUTINE SPSRCONV2(N,CY,C,CH)
+C
+ COMPLEX CY(1)
+ REAL CH(N/2,2),P(2,1),C(2,N/2)
+C
+ N2 = N/2
+ P(1,1) = (C(1,1) + C(2,1)) * 2
+ P(2,1) = (C(1,1) - C(2,1)) * 2
+ CY(1) = CMPLX(P(1,1),0.)
+ CY(N2+1) = CMPLX(P(2,1),0.)
+ K = N2
+ DO 10 I=2, N2
+ X = C(1,I)+C(1,K)
+ Y = C(2,I)+C(2,K)
+ Z = C(1,I)-C(1,K)
+ Z1= C(2,I)-C(2,K)
+ P(1,1) = X + CH(I,1) * Y - CH(I,2) * Z
+ P(2,1) = Z1 - CH(I,2) * Y - CH(I,1) * Z
+ CY(I) = CMPLX(P(1,1),P(2,1))
+ K = K - 1
+ 10 CONTINUE
+ RETURN
+ END
+
+C----------------------------------------------- ************
+C RCONV1
+C ************
+ SUBROUTINE SPSRCONV1(N,CY,C,CH)
+C
+ COMPLEX CY(1)
+ REAL CH(N/2,2),P(2,1),C(2,N/2)
+C
+ N2 = N/2
+ P(1,1) = (C(1,1) + C(2,1)) * 2
+ P(2,1) = (C(1,1) - C(2,1)) * 2
+ CY(1) = CMPLX(P(1,1),0.)
+ CY(N2+1) = CMPLX(P(2,1),0.)
+ K = N2
+ DO 10 I=2, N2
+ X = C(1,I)+C(1,K)
+ Y = C(2,I)+C(2,K)
+ Z = C(1,I)-C(1,K)
+ Z1= C(2,I)-C(2,K)
+ P(1,1) = X + CH(I,1) * Y + CH(I,2) * Z
+ P(2,1) = Z1 + CH(I,2) * Y - CH(I,1) * Z
+ CY(I) = CMPLX(P(1,1),P(2,1))
+ K = K - 1
+ 10 CONTINUE
+ RETURN
+ END
+
+C----------------------------------------------- ************
+C CRFORM
+C ************
+ SUBROUTINE SPSRABLE1(NN,WORK)
+C
+ REAL WORK(NN,2),TWOPI
+ DATA TWOPI /6.28318530717958647692/
+C
+ N = 2 * NN
+ P2 = TWOPI/N
+ DO 10 I=1, NN
+ WORK(I,1) = COS(P2 * (I-1))
+ WORK(I,2) = SIN(P2 * (I-1))
+ 10 CONTINUE
+ RETURN
+ END
+
+C----------------------------------------------- ************
+C RTOCK3
+C ************
+ SUBROUTINE SPSRTOCK3(LS,NS,C,CH,CH2)
+C
+ COMPLEX WYK,C(NS,LS,2),CH(NS,2,LS)
+ REAL CH2(2,NS,LS,2)
+C
+ IF (LS .GT. NS) GOTO 30
+ DO 600 I=1, LS
+ DO 600 J=1, NS
+ WYK =CONJG(CMPLX(CH2(1,1,I,1),CH2(1,1,I,2))) * CH(J,2,I)
+ C(J,I,1) = CH(J,1,I) + WYK
+ C(J,I,2) = CH(J,1,I) - WYK
+ 600 CONTINUE
+ RETURN
+ 30 CONTINUE
+ DO 800 J=1, NS
+ DO 800 I=1, LS
+ WYK =CONJG(CMPLX(CH2(1,1,I,1),CH2(1,1,I,2))) * CH(J,2,I)
+ C(J,I,1) = CH(J,1,I) + WYK
+ C(J,I,2) = CH(J,1,I) - WYK
+ 800 CONTINUE
+ RETURN
+ END
+
+C----------------------------------------------- ************
+C RTOCK2
+C ************
+ SUBROUTINE SPSRTOCK2(LS,NS,C,CH,CH2)
+C
+ COMPLEX WYK,C(NS,LS,2),CH(NS,2,LS)
+ REAL CH2(2,NS,LS,2)
+C
+ IF (LS .GT. NS) GOTO 20
+ DO 200 I=1, LS
+ DO 200 J=1, NS
+ WYK = CMPLX(CH2(1,1,I,1),CH2(1,1,I,2)) * CH(J,2,I)
+ C(J,I,1) = CH(J,1,I) + WYK
+ C(J,I,2) = CH(J,1,I) - WYK
+ 200 CONTINUE
+ RETURN
+ 20 CONTINUE
+ DO 400 J=1, NS
+ DO 400 I=1, LS
+ WYK = CMPLX(CH2(1,1,I,1),CH2(1,1,I,2)) * CH(J,2,I)
+ C(J,I,1) = CH(J,1,I) + WYK
+ C(J,I,2) = CH(J,1,I) - WYK
+ 400 CONTINUE
+ RETURN
+ END
+
+C----------------------------------------------- ************
+C CRBLE1
+C ************
+ SUBROUTINE SPSCRBLE1(NN,WORK)
+C
+ REAL WORK(NN,2),TWOPI
+ DATA TWOPI /6.28318530717958647692/
+C
+ N = 2 * NN
+ P2 = TWOPI/N
+ DO 10 I=1, NN
+ WORK(I,1) = COS(P2 * (I-1))
+ WORK(I,2) = SIN(P2 * (I-1))
+ 10 CONTINUE
+ RETURN
+ END
+
+C----------------------------------------------- ************
+C CRFORM
+C ************
+ SUBROUTINE SPSCRFORM(IX,NS,NDIV2,CX,C,CH2)
+C
+ COMPLEX CX(1),WYK1,C(NS,2),WYK
+ REAL CH2(NDIV2,2)
+C
+ IF (IX .GT. 0) GOTO 50
+ K = NS + 1
+ DO 10 I=1, NS
+ WYK = CONJG(CX(NDIV2-I+2))
+ C(I,1)= CX(I)+WYK + (CX(I) - WYK) * CMPLX(CH2(I,2),CH2(I,1))
+ WYK1 = CONJG(CX(NDIV2-K+2))
+ C(I,2)= CX(K)+WYK1+ (CX(K) -WYK1) * CMPLX(CH2(K,2),CH2(K,1))
+ K = K + 1
+ 10 CONTINUE
+ RETURN
+ 50 CONTINUE
+ K = NS + 1
+ DO 20 I=1, NS
+ WYK = CONJG(CX(NDIV2-I+2))
+ C(I,1)= CX(I)+WYK + (CX(I) - WYK) * CMPLX(-CH2(I,2),CH2(I,1))
+ WYK1 = CONJG(CX(NDIV2-K+2))
+ C(I,2)= CX(K)+WYK1 +(CX(K) -WYK1) * CMPLX(-CH2(K,2),CH2(K,1))
+ K = K + 1
+ 20 CONTINUE
+ RETURN
+ END
+
C------------------------------------------------------------- ************
C CRFFT2
C ************
@@ -62,36 +249,6 @@ C
END
C----------------------------------------------- ************
-C CRFORM
-C ************
- SUBROUTINE SPSCRFORM(IX,NS,NDIV2,CX,C,CH2)
-C
- COMPLEX CX(1),WYK1,C(NS,2),WYK
- REAL CH2(NDIV2,2)
-C
- IF (IX .GT. 0) GOTO 50
- K = NS + 1
- DO 10 I=1, NS
- WYK = CONJG(CX(NDIV2-I+2))
- C(I,1)= CX(I)+WYK + (CX(I) - WYK) * CMPLX(CH2(I,2),CH2(I,1))
- WYK1 = CONJG(CX(NDIV2-K+2))
- C(I,2)= CX(K)+WYK1+ (CX(K) -WYK1) * CMPLX(CH2(K,2),CH2(K,1))
- K = K + 1
- 10 CONTINUE
- RETURN
- 50 CONTINUE
- K = NS + 1
- DO 20 I=1, NS
- WYK = CONJG(CX(NDIV2-I+2))
- C(I,1)= CX(I)+WYK + (CX(I) - WYK) * CMPLX(-CH2(I,2),CH2(I,1))
- WYK1 = CONJG(CX(NDIV2-K+2))
- C(I,2)= CX(K)+WYK1 +(CX(K) -WYK1) * CMPLX(-CH2(K,2),CH2(K,1))
- K = K + 1
- 20 CONTINUE
- RETURN
- END
-
-C----------------------------------------------- ************
C CROCK1
C ************
SUBROUTINE SPSCROCK1(NS,C,CH)
@@ -157,23 +314,6 @@ C
RETURN
END
-C----------------------------------------------- ************
-C CRBLE1
-C ************
- SUBROUTINE SPSCRBLE1(NN,WORK)
-C
- REAL WORK(NN,2),TWOPI
- DATA TWOPI /6.28318530717958647692/
-C
- N = 2 * NN
- P2 = TWOPI/N
- DO 10 I=1, NN
- WORK(I,1) = COS(P2 * (I-1))
- WORK(I,2) = SIN(P2 * (I-1))
- 10 CONTINUE
- RETURN
- END
-
C------------------------------------------------------------- ************
C RCFFT2
C ************
@@ -236,32 +376,6 @@ C
END
C----------------------------------------------- ************
-C RTOCK2
-C ************
- SUBROUTINE SPSRTOCK2(LS,NS,C,CH,CH2)
-C
- COMPLEX WYK,C(NS,LS,2),CH(NS,2,LS)
- REAL CH2(2,NS,LS,2)
-C
- IF (LS .GT. NS) GOTO 20
- DO 200 I=1, LS
- DO 200 J=1, NS
- WYK = CMPLX(CH2(1,1,I,1),CH2(1,1,I,2)) * CH(J,2,I)
- C(J,I,1) = CH(J,1,I) + WYK
- C(J,I,2) = CH(J,1,I) - WYK
- 200 CONTINUE
- RETURN
- 20 CONTINUE
- DO 400 J=1, NS
- DO 400 I=1, LS
- WYK = CMPLX(CH2(1,1,I,1),CH2(1,1,I,2)) * CH(J,2,I)
- C(J,I,1) = CH(J,1,I) + WYK
- C(J,I,2) = CH(J,1,I) - WYK
- 400 CONTINUE
- RETURN
- END
-
-C----------------------------------------------- ************
C RTOCK1
C ************
SUBROUTINE SPSRTOCK1(NS,C,CH)
@@ -275,103 +389,6 @@ C
RETURN
END
-C----------------------------------------------- ************
-C RTOCK3
-C ************
- SUBROUTINE SPSRTOCK3(LS,NS,C,CH,CH2)
-C
- COMPLEX WYK,C(NS,LS,2),CH(NS,2,LS)
- REAL CH2(2,NS,LS,2)
-C
- IF (LS .GT. NS) GOTO 30
- DO 600 I=1, LS
- DO 600 J=1, NS
- WYK =CONJG(CMPLX(CH2(1,1,I,1),CH2(1,1,I,2))) * CH(J,2,I)
- C(J,I,1) = CH(J,1,I) + WYK
- C(J,I,2) = CH(J,1,I) - WYK
- 600 CONTINUE
- RETURN
- 30 CONTINUE
- DO 800 J=1, NS
- DO 800 I=1, LS
- WYK =CONJG(CMPLX(CH2(1,1,I,1),CH2(1,1,I,2))) * CH(J,2,I)
- C(J,I,1) = CH(J,1,I) + WYK
- C(J,I,2) = CH(J,1,I) - WYK
- 800 CONTINUE
- RETURN
- END
-
-C----------------------------------------------- ************
-C CRFORM
-C ************
- SUBROUTINE SPSRABLE1(NN,WORK)
-C
- REAL WORK(NN,2),TWOPI
- DATA TWOPI /6.28318530717958647692/
-C
- N = 2 * NN
- P2 = TWOPI/N
- DO 10 I=1, NN
- WORK(I,1) = COS(P2 * (I-1))
- WORK(I,2) = SIN(P2 * (I-1))
- 10 CONTINUE
- RETURN
- END
-
-C----------------------------------------------- ************
-C RCONV1
-C ************
- SUBROUTINE SPSRCONV1(N,CY,C,CH)
-C
- COMPLEX CY(1)
- REAL CH(N/2,2),P(2,1),C(2,N/2)
-C
- N2 = N/2
- P(1,1) = (C(1,1) + C(2,1)) * 2
- P(2,1) = (C(1,1) - C(2,1)) * 2
- CY(1) = CMPLX(P(1,1),0.)
- CY(N2+1) = CMPLX(P(2,1),0.)
- K = N2
- DO 10 I=2, N2
- X = C(1,I)+C(1,K)
- Y = C(2,I)+C(2,K)
- Z = C(1,I)-C(1,K)
- Z1= C(2,I)-C(2,K)
- P(1,1) = X + CH(I,1) * Y + CH(I,2) * Z
- P(2,1) = Z1 + CH(I,2) * Y - CH(I,1) * Z
- CY(I) = CMPLX(P(1,1),P(2,1))
- K = K - 1
- 10 CONTINUE
- RETURN
- END
-
-C----------------------------------------------- ************
-C RCONV2
-C ************
- SUBROUTINE SPSRCONV2(N,CY,C,CH)
-C
- COMPLEX CY(1)
- REAL CH(N/2,2),P(2,1),C(2,N/2)
-C
- N2 = N/2
- P(1,1) = (C(1,1) + C(2,1)) * 2
- P(2,1) = (C(1,1) - C(2,1)) * 2
- CY(1) = CMPLX(P(1,1),0.)
- CY(N2+1) = CMPLX(P(2,1),0.)
- K = N2
- DO 10 I=2, N2
- X = C(1,I)+C(1,K)
- Y = C(2,I)+C(2,K)
- Z = C(1,I)-C(1,K)
- Z1= C(2,I)-C(2,K)
- P(1,1) = X + CH(I,1) * Y - CH(I,2) * Z
- P(2,1) = Z1 - CH(I,2) * Y - CH(I,1) * Z
- CY(I) = CMPLX(P(1,1),P(2,1))
- K = K - 1
- 10 CONTINUE
- RETURN
- END
-
C------------------------------------------------------------- ************
C CFFT2
C ************
@@ -514,23 +531,6 @@ C
RETURN
END
-C----------------------------------------------- ************
-C CABLE2
-C ************
- SUBROUTINE SPSCABLE2(NN,WORK)
-C
- REAL WORK(2,NN),TWOPI
- DATA TWOPI /6.28318530717958647692/
-C
- N = 2 * NN
- P2 = TWOPI/N
- DO 10 I=1, NN
- WORK(1,I) = COS(P2 * (I-1))
- WORK(2,I) = SIN(P2 * (I-1))
- 10 CONTINUE
- RETURN
- END
-
C------------------------------------------------------------- ************
C ABORT
C ************
Reference in New Issue View Git Blame Copy Permalink