SUBROUTINE GRADDT,4
IMPLICIT NONE
include 'champ.cdk'
include 'chobs.cdk'
REAL KX,KY,KW
DO IKX=1,IKTX
KX = FLOAT(IKX-1)
DO IKY=1,IKTY
KY = FLOAT(IKY - KTY - 1)
KW = MAX(KX*KX+KY*KY ,0.001 )
UK(IKX,IKY)= L(IKX+KTX,IKY)*ZI*KY*ZT(IKX,IKY)/KW
WK(IKX,IKY)=-L(IKX+KTX,IKY)*ZI*KX*ZT(IKX,IKY)/KW
ENDDO
ENDDO
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)
cs CALL KR(ST,SR,KTX,KTY,IKTX,IKTY,N,N2,LWRK,
cs . FF1,FF2,FF3,WORK,TRIGS,IFAX,ZI)
DO IKX=1,N
DO IKY=1,N
UR(IKX,IKY) = (UR(IKX,IKY)-UOBS(IKX,IKY,NT+2))
. * PZ(IKX,IKY,NT+2)
WR(IKX,IKY) = (WR(IKX,IKY)-WOBS(IKX,IKY,NT+2))
. * PZ(IKX,IKY,NT+2)
cs SR(IKX,IKY) = (SR(IKX,IKY)-SOBS(IKX,IKY,NT+2))
cs . * PS(IKX,IKY,NT+2)
ENDDO
ENDDO
CALL RK
(UR,UK,KTX,KTY,IKTX,IKTY,N,N2,LWRK,
. FF1,FF2,FF3,WORK,TRIGS,IFAX,ZI)
CALL RK
(WR,WK,KTX,KTY,IKTX,IKTY,N,N2,LWRK,
. FF1,FF2,FF3,WORK,TRIGS,IFAX,ZI)
cs CALL RK(SR,NSK,KTX,KTY,IKTX,IKTY,N,N2,LWRK,
cs . FF1,FF2,FF3,WORK,TRIGS,IFAX,ZI)
DO IKX=1,IKTX
KX = FLOAT(IKX-1)
DO IKY=1,IKTY
KY = FLOAT(IKY - KTY - 1)
IF ( L(IKX+KTX,IKY).NE.0 ) THEN
KW = MAX(KX*KX+KY*KY ,0.001 )
NZK(IKX,IKY)=-ZI*L(IKX+KTX,IKY)*KY*UK(IKX,IKY)/KW
. +ZI*L(IKX+KTX,IKY)*KX*WK(IKX,IKY)/KW
NZK(IKX,IKY)=2.*N*N*NZK(IKX,IKY)
cs --- pas oublier d'enlever NSK(IKX,IKY) = CMPLX(0.,0.) !!!!!!!!
cs NSK(IKX,IKY)=2.*N*N*NSK(IKX,IKY)
NSK(IKX,IKY) = CMPLX(0.,0.)
ELSE
NZK(IKX,IKY) = CMPLX(0.,0.)
NSK(IKX,IKY) = CMPLX(0.,0.)
ENDIF
ENDDO
ENDDO
RETURN
END