SUBROUTINE CH_AVGKERN(KFLAG1,KFLAG2,KINDEX,PROF,KNUM,KMOD) C IMPLICIT NONE INTEGER KNUM,KFLAG1(KNUM),KFLAG2(KNUM),KINDEX,KMOD REAL*8 PROF(KNUM) C #if defined (DOC) * * **s/r CH_AVGKERN - Apply averaging kernel matrix or its adjoint. * * AUTHOR: Y. Rochon *ARQX/MSC Aug 2010 * * REVISIONS: * * ARGUMENTS * * INPUT: * * KFLAG1.......Flags (1 for valid obs data) * KFLAG2.......Flags (0 for data in vertical range) * KNUM.........Number of obs levels * PROF.........Input * kmod........ Flag indicating purpose of call * -1: Use as forward model * 0: Use as TLM model * 1: Use as adjoint of TLM model. * * OUTPUT: * * PROF.........Output * *COMMENT * * ************************************************************************ #endif C C* Global variables C #include "pardim.cdk"
#include "commatrix.cdk"
#include "comlun.cdk"
C INTEGER J,IW(KNUM) REAL*8 ZPROF(KNUM) ZPROF(:)=0.0 IW(:)=1 where (KFLAG1.NE.1.OR.KFLAG2.NE.0) IW=0 C IF (KMOD.EQ.-1) THEN DO J=1,KNUM IF (IW(J).eq.1) THEN ZPROF(J)=dot_product(RAVGKERN(J,1:KNUM,KINDEX),PROF) END IF END DO ELSE IF (KMOD.EQ.0) THEN DO J=1,KNUM IF (IW(J).eq.1) THEN ZPROF(J)=dot_product(RAVGKERN(J,1:KNUM,KINDEX),PROF) c ZPROF(J)=PROF(J)*sum(RAVGKERN(J,1:KNUM,KINDEX)) END IF END DO ELSE ! Adjoint DO J=1,KNUM IF (IW(J).eq.1) THEN ZPROF(1:KNUM)=ZPROF(1:KNUM)+ & RAVGKERN(J,1:KNUM,KINDEX)*PROF(J) c ZPROF(J)=ZPROF(J)+ c & sum(RAVGKERN(J,1:KNUM,KINDEX))*PROF(J) END IF END DO END IF PROF(:)=ZPROF(:) C RETURN END