SUBROUTINE CONVOL(ZK,SK,NZK,NSK,IKTX,IKTY,KTX,KTY, 3,6
. N,N2,L,PXLIM,LWRK,WORK,TRIGS,IFAX,
. FF1,FF2,FF3,UK,WK,UR,WR,ZR,SR,NZR,NSR,ZI,U0)
C
C CALCULATES CONVOLUTION SUMS, CALLS FFT'S, ETC.
C
IMPLICIT NONE
INTEGER IKTX,IKTY,KTX,KTY,PXLIM
INTEGER IKX,IKY,L(PXLIM,IKTY),I,J
INTEGER KX,KY,IFAX(10),N,N2,LWRK
C
REAL KW,WORK(LWRK),TRIGS(N)
REAL FF1(N2,N2),FF2(N2,N2),FF3(N2,N2)
REAL UR(N,N),WR(N,N),NZR(N,N),SR(N,N),NSR(N,N)
REAL ZR(N,N),WEIGHT,U0
C
COMPLEX NZK(IKTX,IKTY),NSK(IKTX,IKTY)
COMPLEX ZK(IKTX,IKTY), SK(IKTX,IKTY)
COMPLEX UK(IKTX,IKTY), WK(IKTX,IKTY)
COMPLEX ZI, C1
EXTERNAL KR,RK
C
DO 10 IKX = 1, IKTX
KX = IKX-1
DO 10 IKY = 1, IKTY
KY = IKY - KTY - 1
KW = MAX( FLOAT(KX*KX+KY*KY) ,0.001 )
NZK(IKX,IKY) = CMPLX(0.,0.)
NSK(IKX,IKY) = CMPLX(0.,0.)
UK(IKX,IKY) = + L(IKX+KTX,IKY)*ZI*KY*ZK(IKX,IKY)/KW
WK(IKX,IKY) = - L(IKX+KTX,IKY)*ZI*KX*ZK(IKX,IKY)/KW
10 CONTINUE
CALL KR
(ZK,ZR,KTX,KTY,IKTX,IKTY,N,N2,LWRK,
. FF1,FF2,FF3,WORK,TRIGS,IFAX,ZI)
CALL KR
(SK,SR,KTX,KTY,IKTX,IKTY,N,N2,LWRK,
. FF1,FF2,FF3,WORK,TRIGS,IFAX,ZI)
CALL KR
(UK,UR,KTX,KTY,IKTX,IKTY,N,N2,LWRK,
. FF1,FF2,FF3,WORK,TRIGS,IFAX,ZI)
CALL KR
(WK,WR,KTX,KTY,IKTX,IKTY,N,N2,LWRK,
. FF1,FF2,FF3,WORK,TRIGS,IFAX,ZI)
C
c
c
c
c
DO 20 I=1,N
DO 20 J=1,N
NZR(I,J) = (UR(I,J)+U0) * ZR(I,J)
cs NSR(I,J) = (UR(I,J)+U0) * SR(I,J)
20 CONTINUE
C
CALL RK
(NZR,NZK,KTX,KTY,IKTX,IKTY,N,N2,LWRK,
. FF1,FF2,FF3,WORK,TRIGS,IFAX,ZI)
cs CALL RK(NSR,NSK,KTX,KTY,IKTX,IKTY,N,N2,LWRK,
cs . FF1,FF2,FF3,WORK,TRIGS,IFAX,ZI)
C
DO 30 IKX = 1, IKTX
KX = IKX-1
DO 30 IKY = 1, IKTY
NZK(IKX,IKY) = + ZI*KX * NZK(IKX,IKY)
cs NSK(IKX,IKY) = + ZI*KX * NSK(IKX,IKY)
30 CONTINUE
C
C
DO 40 I=1,N
DO 40 J=1,N
UR(I,J) = WR(I,J) * ZR(I,J)
40 CONTINUE
C
CALL RK
(UR,UK,KTX,KTY,IKTX,IKTY,N,N2,LWRK,
. FF1,FF2,FF3,WORK,TRIGS,IFAX,ZI)
C
DO 50 IKX = 1, IKTX
DO 50 IKY = 1, IKTY
KY = IKY - KTY - 1
WEIGHT = L(IKX+KTX,IKY)*L(IKX+KTX,IKY)
C1 = + ZI*KY * UK(IKX,IKY)
NZK(IKX,IKY) = (- NZK(IKX,IKY) - C1)*WEIGHT
50 CONTINUE
C
C
cs DO 80 I=1,N
cs DO 80 J=1,N
cs UR(I,J) = WR(I,J) * SR(I,J)
cs80 CONTINUE
C
cs CALL RK(UR,UK,KTX,KTY,IKTX,IKTY,N,N2,LWRK,
cs . FF1,FF2,FF3,WORK,TRIGS,IFAX,ZI)
C
cs DO 90 IKX = 1, IKTX
cs DO 90 IKY = 1, IKTY
cs KY = IKY - KTY - 1
cs WEIGHT = L(IKX+KTX,IKY)*L(IKX+KTX,IKY)
cs C1 = + ZI*KY * UK(IKX,IKY)
cs NSK(IKX,IKY) = (- NSK(IKX,IKY) - C1)*WEIGHT
cs90 CONTINUE
C
c
RETURN
END