SUBROUTINE OBSERVATIONS 5,4
IMPLICIT NONE
include 'champ.cdk'
include 'chobs.cdk'
INTEGER CMP,IR
INTEGER KCOUPE,KTRES
REAL AMRA,RA(10000)
REAL*8 KX,KY,KWW
AMRA = 0.
KCOUPE = 0
KTRES = 5
open(1,file='./files/rannor.io',status='old')
read(1,101) (ra(ikx),ikx=1,10000)
close(1)
101 format(8f10.7)
open (16,file='./files/obs.io',form='unformatted')
DO NT=1,NTRAJC
read(16) ((UOBS(IW,JW,NT),IW=1,N),JW=1,N)
read(16) ((WOBS(IW,JW,NT),IW=1,N),JW=1,N)
ENDDO
close(16)
IR=0
DO NT=1,NTRAJC
DO IW=1,N
DO JW=1,N
IR=IR+1
UOBS(IW,JW,NT) = UOBS(IW,JW,NT) + AMRA*RA(IR)
IR=IR+1
WOBS(IW,JW,NT) = WOBS(IW,JW,NT) + AMRA*RA(IR)
IR=IR+1
IF(IR.GT.9995) IR=0
END DO
END DO
END DO
C Observation covariance error
C ----------------------------
IR = 0
DO IR =1,2*N*N*NTRAJC
c sigmao(IR) = 0.064
sigmao(IR) = 0.064
END DO
C ----------------------------------------------------------------
C POUR OBSERVATIONS TRONQUEES A KTRES DANS L'ESPACE SPECTRAL
IF(KCOUPE.EQ.1) THEN
NT = NSTOP
DO IW=1,N
DO JW=1,N
UR(IW,JW) = UOBS(IW,JW,NT)
WR(IW,JW) = WOBS(IW,JW,NT)
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)
DO IKX=1,IKTX
KX=FLOAT(IKX-1)
DO IKY=1,IKTY
KY=FLOAT(IKY-KTY-1)
KWW=SQRT(KX*KX+KY*KY)
IF(KWW.GT.FLOAT(KTRES)-0.5) THEN
UK(IKX,IKY)=CMPLX(0.,0.)
WK(IKX,IKY)=CMPLX(0.,0.)
ENDIF
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)
DO IW=1,N
DO JW=1,N
UOBS(IW,JW,NT) = UR(IW,JW)
WOBS(IW,JW,NT) = WR(IW,JW)
ENDDO
ENDDO
END IF
C Choose which observation network
C --------------------------------
CMP=0
OPEN(1,file='station.dat',status='unknown')
DO NT =1,NTRAJ
IR=0
DO IKX=1,N
DO IKY=1,N
PZ(IKX,IKY,NT) = 1.0
IR=IR+1
IF(MOD(IKX,8).EQ.0.AND.MOD(IKY,8).EQ.0) THEN
PZ(IKX,IKY,NT) = 1.0
CMP=CMP+1
ENDIF
IF(NT.EQ.1) THEN
IF(PZ(IKX,IKY,1).NE.0.0) WRITE(1,987) IKX,IKY
987 FORMAT(2I10)
ENDIF
IF(IR.GT.9998) IR=0
ENDDO
ENDDO
ENDDO
CLOSE(1)
C Observation vector y
C --------------------
IR = 0
DO NT = 1,NTRAJC
DO IW= 1,N
DO JW = 1,N
dl_y(IR+1) = UOBS(IW,JW,NT)*PZ(IW,JW,NT)
dl_y(IR+2) = WOBS(IW,JW,NT)*PZ(IW,JW,NT)
IR = IR+2
END DO
END DO
ENDDO
RETURN
END SUBROUTINE