SUBROUTINE psasvar(NDIM,dl_a,dl_j) 1,14
C ===============================================================
C ==== Calculates the primal functional for the equivalent ====
C ==== of the dual iterates in the model space. ====
C ==== Also calculates the equivalent norms in model space ====
C Author: Amal El Akkraoui, 2010
C ===============================================================
implicit none
include 'champ.cdk'
include 'chobs.cdk'
INTEGER NDIM, NOBS, i, kdim
REAL*8 dl_a(NDIM),dl_j
REAL dl_s(NDIM),dl_v(NDIM)
REAL dl_t(4096),dl_zeta(4096)
REAL norm
C ------------------------------------------------------
KDIM = 4096
dl_j = 0
DO i= 1, NDIM
dl_s(i) = dl_a(i)
END DO
C Control vector in model space
C -----------------------------
DO i=1,NDIM
dl_s(i)=dl_s(i)/sigmao(i)
END DO
CALL HT
(dl_s,ZF,SO)
CALL SQRTBT
(ZF,ZR)
NCO = 0
DO IW=1,N
DO JW=1,N
NCO=NCO+1
dl_zeta(NCO) = ZR(IW,JW)
END DO
ENDDO
C BT/2 HT R-1 H B1/2 dl_zeta
C --------------------------
CALL SQRTB
(ZR,ZF)
CALL H
(ZF,SO,HX)
DO i=1,2*N**2
HX(i) = HX(i)/sigmao(i)**2
END DO
CALL HT
(HX,ZF,SO)
CALL SQRTBT
(ZF,ZR)
NCO = 0
DO IW =1,N
DO JW =1,N
NCO=NCO+1
dl_t(NCO) = ZR(IW,JW)
END DO
END DO
C (I+BT/2 HT R-1 H B1/2) dl_zeta
C J = 0.5 dl_zeta^T (I+BT/2 HT R-1 H B1/2) dl_zeta
C -------------------------------------------------
DO i = 1, KDIM
dl_t(i) = dl_t(i) + dl_zeta(i)
dl_j= dl_j + 0.5*DBLE(dl_zeta(i)*dl_t(i))
ENDDO
C BT/2 HT R-1 Yprime
C ------------------
DO i =1,NDIM
HX(i) = by(i)/sigmao(i)
END DO
CALL HT
(HX,ZF,SO)
CALL SQRTBT
(ZF,ZR)
NCO = 0
DO IW=1,N
DO JW = 1,N
NCO = NCO+1
dl_t(NCO) = ZR(IW,JW)
END DO
END DO
C -------------------
DO i = 1,KDIM
dl_j = dl_j - DBLE(dl_zeta(i)*dl_t(i))
END DO
C Add the constant term to the functional
C ---------------------------------------
DO i=1,NDIM
dl_j = dl_j + 0.5*DBLE(by(i))**2
END DO
print*,'== PSASVAR == : Equivalence J = ',dl_j
C The equivalent norm
C -------------------
DO i = 1,NDIM
dl_s(i) = dl_a(i)/sigmao(i)
END DO
call HT
(dl_s,ZF,SO)
call SQRTBT
(ZF,ZR)
call SQRTB
(ZR,ZF)
call H
(ZF,SO,dl_v)
DO i = 1,NDIM
dl_v(i) = dl_v(i)/sigmao(i)
dl_s(i) = dl_v(i) + dl_a(i)
END DO
DO i =1,NDIM
dl_v(i) = (dl_s(i) - by(i))/sigmao(i)
END DO
call HT
(dl_v,ZF,SO)
call SQRTBT
(ZF,ZR)
norm = 0.
DO IW = 1,N
DO JW =1,N
norm = norm + ZR(IW,JW)**2
END DO
ENDDO
norm = sqrt(norm)
print*,'== PSASVAR == : Norm of LT rk', norm
end subroutine