SUBROUTINE COUTDT(Z,S,JX) 3,2
IMPLICIT NONE
include 'champ.cdk'
include 'chobs.cdk'
COMPLEX Z(IKTX,IKTY),S(IKTX,IKTY)
REAL KX,KY,KW,JX
EXTERNAL RK,KR
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*Z(IKX,IKY)/KW
WK(IKX,IKY)=-L(IKX+KTX,IKY)*ZI*KX*Z(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(S,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)
JX = JX + 0.5*UR(IKX,IKY)*UR(IKX,IKY)
JX = JX + 0.5*WR(IKX,IKY)*WR(IKX,IKY)
cs JX = JX + 0.5*SR(IKX,IKY)*SR(IKX,IKY)
ENDDO
ENDDO
RETURN
END