SUBROUTINE INITXY (Z,S,IKTX,IKTY,KTX, 1,2
. KTY,DELT,WN,PXLIM,L,
. ZR,SR,N,N2,LWRK,FF1,FF2,FF3,WORK,TRIGS,IFAX,BJ,ILAP)
C
C
IMPLICIT NONE
INTEGER IKX,IKY,IKTX,IKTY,KTX,KTY,PXLIM,J,IR
INTEGER L(PXLIM,IKTY),IFAX(10)
INTEGER N,N2,LWRK,inky,ILAP,NO(200)
COMPLEX Z(IKTX,IKTY),S(IKTX,IKTY),ZI
REAL BJ
REAL KX,KY,WK,DELT
REAL TWOPI,KE,KE0,KS0,KQ0,RE,IM
REAL WN(PXLIM,IKTY)
REAL ZR(N,N),SR(N,N),AVZ,AVQ
REAL WORK(LWRK),TRIGS(N),FF1(N2,N2),FF2(N2,N2),FF3(N2,N2)
REAL RA(10000),POWERZ,POWERS,POWERQ
REAL SPZ(KTX),E,VZ
external RK,KR
ZI = CMPLX(0.,1.)
TWOPI = 4.*ASIN(1.)
POWERZ = -5/3.
POWERS = -2.
KE0 = 1.0E-04
KS0 = 0.0
c+ POWERZ = -3.
c+ POWERS = -2.
c+ KE0 = 0.0
c+ KS0 = 0.0
C
C
C
if(KTX.gt.200) then
print*,'KTX gt 200 in init.f'
stop
endif
open(1,file='random.io',status='old')
read(1,101) (ra(ikx),ikx=1,10000)
close(1)
101 format(8f10.7)
DO J=1,200
NO(J)=0
ENDDO
DO 10 IKX=1,IKTX
DO 10 IKY=1,IKTY
Z(IKX,IKY) = CMPLX(0.,0.)
S(IKX,IKY) = CMPLX(0.,0.)
10 CONTINUE
DO 20 IKX=1,IKTX
KX = FLOAT(IKX-1)
DO 20 IKY=1,IKTY
KY = FLOAT(IKY-KTY-1)
WK = SQRT(KX*KX+KY*KY)
IF(WK.GT.FLOAT(KTX)-0.5) GO TO 20
IF(KX.EQ.0. .AND. KY.LE.0.) GO TO 20
J = IFIX(WK+0.5)
NO(J) = NO(J) + 1
20 CONTINUE
print*,NO
IR = 0
DO 30 IKX=1,IKTX
KX = FLOAT(IKX-1)
DO 30 IKY=1,IKTY
KY = FLOAT(IKY-KTY-1)
WK = SQRT(KX*KX+KY*KY)
IF(WK.GT.FLOAT(KTX)-0.5) GO TO 30
IF(KX.EQ.0. .AND. KY.LE.0.) GO TO 30
J = IFIX(WK+0.5)
IF(NO(J).NE.0) THEN
IR = IR + 1
IF (IR.GT.9999) IR = 1
KE = KS0*(WK**2)*(FLOAT(J)**(POWERS))/NO(J)
RE = SQRT(KE)*COS(TWOPI*RA(IR))
IM = SQRT(KE)*SIN(TWOPI*RA(IR))
S(IKX,IKY) = CMPLX(RE,IM)
IR = IR + 1
IF (IR.GT.9999) IR = 1
KE = KE0*(WK**2)*(FLOAT(J)**(POWERZ))/NO(J)
RE = SQRT(KE)*COS(TWOPI*RA(IR))
IM = SQRT(KE)*SIN(TWOPI*RA(IR))
Z(IKX,IKY) = CMPLX(RE,IM)
ENDIF
30 CONTINUE
c
CALL KR
(Z,ZR,KTX,KTY,IKTX,IKTY,N,N2,LWRK,
. FF1,FF2,FF3,WORK,TRIGS,IFAX,ZI)
CALL KR
(S,SR,KTX,KTY,IKTX,IKTY,N,N2,LWRK,
. FF1,FF2,FF3,WORK,TRIGS,IFAX,ZI)
c
c+ test test test
DO 40 J=1,KTX
SPZ(J) = 0.0
NO(J) = 0
40 CONTINUE
C
DO 50 IKX=1,IKTX
KX = FLOAT(IKX-1)
DO 50 IKY=1,IKTY
KY = FLOAT(IKY-KTY-1)
WK = SQRT(KX*KX+KY*KY)
IF(WK.GT.FLOAT(KTX)-0.5) GO TO 50
IF(KX.EQ.0. .AND. KY.LE.0.) GO TO 50
J = IFIX(WK+0.5)
IF(J.LE.0 .OR. J.GT.KTX) PRINT *,'SCREW-UP.'
VZ = REAL( Z(IKX,IKY)*CONJG(Z(IKX,IKY)) )
SPZ(J) = SPZ(J) + (VZ/WK**2)
NO(J) = NO(J) + 2
50 CONTINUE
DO 60 J=1,KTX-1
E = 0.5* SPZ(J)
AVZ = AVZ + E
60 CONTINUE
print*, 'AVZ initial', AVZ
c+ end test
RETURN
END