SUBROUTINE KR(ZK,ZR,KTX,KTY,IKTX,IKTY,N,N2,LWRK, 63,3
. FF1,FF2,FF3,WORK,TRIGS,IFAX,ZI)
C
C CALLS SPECTRAL - GRID POINT TRANSFORMS.
C
IMPLICIT NONE
INTEGER N,N2,J,K,LWRK,IFAX(10),KY
INTEGER KTX,KTY,IKTX,IKTY,NC,I,IKX,IKY,IR,II,INKY
C
REAL TRIGS(3*N/2), ZR(N,N), WORK(LWRK)
REAL FF1(N2,N2),FF2(N2,N2),FF3(N2,N2)
COMPLEX ZK(IKTX,IKTY),ZI,C1,C2
EXTERNAL FFT991
C
NC = N2/2
C
DO 35 IKX=1,N2
DO 35 IKY=1,N2
FF1(IKX,IKY) = 0.0
FF2(IKX,IKY) = 0.0
FF3(IKX,IKY) = 0.0
35 CONTINUE
C
DO 37 IKY=1,KTY
KY = IKY - KTY - 1
INKY = -KY + KTY + 1
ZK(1,IKY) = CONJG(ZK(1,INKY))
37 CONTINUE
DO 40 IKX=1,IKTX
DO 40 K=1,KTY+1
IR = K + K - 1
KY = K - 1
IKY = + KY + 1 + KTY
INKY = - KY + 1 + KTY
C1 = ( ZK(IKX,IKY) + CONJG( ZK(IKX,INKY) ) ) / 2.
C2 = ( ZK(IKX,IKY) - CONJG( ZK(IKX,INKY) ) ) / CMPLX(0.,2.)
FF1(IR,IKX) = REAL( C1 )
FF2(IR,IKX) = REAL( C2 )
40 CONTINUE
C
DO 45 IKX=1,IKTX
DO 45 K=1,KTY+1
II = K + K
KY = K - 1
IKY = + KY + 1 + KTY
INKY = - KY + 1 + KTY
C1 = ( ZK(IKX,IKY) + CONJG( ZK(IKX,INKY) ) ) / 2.
C2 = ( ZK(IKX,IKY) - CONJG( ZK(IKX,INKY) ) ) / (2.*ZI)
FF1(II,IKX) = AIMAG( C1 )
FF2(II,IKX) = AIMAG( C2 )
45 CONTINUE
C
CALL FFT991
(FF1,WORK,TRIGS,IFAX,1,N2,N,IKTX,+1)
CALL FFT991
(FF2,WORK,TRIGS,IFAX,1,N2,N,IKTX,+1)
C
DO 70 I=1,IKTX
DO 70 K=1,N2
IR = I + I - 1
FF3(IR,K) = FF1(K,I)
70 CONTINUE
C
DO 75 I=1,IKTX
DO 75 K=1,N2
II = I + I
FF3(II,K) = FF2(K,I)
75 CONTINUE
C
CALL FFT991
(FF3,WORK,TRIGS,IFAX,1,N2,N,N,+1)
C
DO 80 I=1,N
DO 80 J=1,N
ZR(I,J) = FF3(I,J)
80 CONTINUE
C
RETURN
END