!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer,
! version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer
!version 3 or (at your option) any later version that should be found at:
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software;
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec),
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
!
subroutine matvec(alpha,x,beta,y,kelem,cdfam) 3,8
#if defined (DOC)
*
***s/r MATVEC - Matrix-vector product
*
*
*Author : P. Koclas *CMC/AES April 1996
*Revision:
* S. Pellerin *ARMA/AES Sept 97.
* .Change from TT to GZ state variable.
* S. Pellerin *ARMA/AES Aug. 98.
* - Built-up of O matrix based on assimilated elements
* and family of observation instead of NPOS variable.
*
*
* -1
** Purpose: - Perform the matrix-vector product
* y = alpha*A*x + beta*y,
*
*
*Arguments
*
* INPUT :
* -alpha ,beta: Scalar values
* -x y : Vectors
* kelem : variable (observation) code (BUFR)
* cdfam : family of the observation
* OUTPUT:
* y : Updated value of y
*
* NOTE:
* -ARGUMENTS OF THIS ROUTINE ARE FIXED BY BY SUBROUTINE "CONJGRAD"
* -Matrix A is passed via common COMSTATO
* -Matrix multiplication is done by mxma
* -Agrguments to mxma are passed via common COMVCOR
*
#endif
IMPLICIT NONE
#include "comdimo.cdk"
#include "comoabdy.cdk"
#include "comoahdr.cdk"
#include "comoba.cdk"
#include "comstato.cdk"
#include "comvcor.cdk"
C
REAL*8 ALPHA,BETA
REAL*8 X(*),Y(*)
REAL*8 Z
integer kelem
character*2 cdfam
C
INTEGER IBEGIN,ILAST,IBEGINOBS,ILASTOBS,IB,INREPT,IDATA
INTEGER JDATA
INTEGER IOBS,IPOS,ILEN,INOBS,ILYR
REAL*8 XTEMP(JPMAXILEV,JPNMAXPRO) , RESULT(JPMAXILEV,JPNMAXPRO)
INTEGER IUU , IVV , IGZ , IDZ ,ITT , IES
DATA IUU,IVV,IGZ,IDZ,ITT,IES/11003,11004,10194,10192,12001,12192/
C
C *******************************************
C OBTAIN PARAMETERS FROM CONTENTS OF COMVCOR
C *******************************************
C
C==========================================
IB=MBAND
INREPT=ND
IBEGIN=NBEG
ILAST= NEND
C
C CALCULATE NUMBER OF OBSERVATIONS
C
IBEGINOBS=MOBDATA(NCMOBS,IBEGIN)
ILASTOBS =MOBDATA(NCMOBS,ILAST)
ILEN =ILASTOBS-IBEGINOBS +1
C==========================================
C
C
C *********************************
C X IS MAPPED INTO FULL SOUNDINGS
C *********************************
C
CALL ZERO(JPMAXILEV*JPNMAXPRO,XTEMP)
DO JDATA = 1,INREPT
IDATA = NINDX(JDATA)
IOBS = MOBDATA(NCMOBS,IDATA)
ILYR = MOBDATA(NCMLOBS,IDATA)
INOBS = IOBS-IBEGINOBS + 1
C =============================
XTEMP(ILYR,INOBS) = X(JDATA)
C =============================
END DO
C
C *********************************
C PERFORM MATRIX MULTIPLICATIONS
C *********************************
C
C -----------
IF (kelem .EQ. iuu .and. cdfam .eq. 'UA') THEN
C -----------
C U-COMPONENT
C -----------
CALL MXMAOP(UUOBSCOR(1,1,IB),1,JPMAXILEV, XTEMP,1,JPMAXILEV,
& RESULT,1,JPMAXILEV,JPRALEV,JPRALEV,ILEN)
C
ELSE IF (kelem .EQ. ivv .and. cdfam .eq. 'UA') THEN
C -----------
C V-COMPONENT
C -----------
CALL MXMAOP(UUOBSCOR(1,1,IB),1,JPMAXILEV, XTEMP,1,JPMAXILEV,
& RESULT,1,JPMAXILEV,JPRALEV,JPRALEV,ILEN)
C
ELSE IF ( kelem .EQ. itt .and. cdfam .eq. 'UA' ) THEN
C ----------------------------
C TEMPERATURE
C ----------------------------
CALL MXMAOP(GZOBSCOR(1,1,IB),1,JPMAXILEV, XTEMP,1,JPMAXILEV,
& RESULT,1,JPMAXILEV,JPRALEV,JPRALEV,ILEN)
C
C ----------------
ELSE IF (kelem .EQ. ies .and. cdfam .eq. 'UA' ) THEN
C ----------------
C MOISTURE ( T-Td)
C ----------------
CALL MXMAOP(ESOBSCOR(1,1,IB),1,JPMAXILEV, XTEMP,1,JPMAXILEV,
& RESULT,1,JPMAXILEV,JPRALEV,JPRALEV,ILEN)
C
ELSE IF (kelem .EQ. igz .and. cdfam .eq. 'UA') THEN
C ----------------------------
C GEOPOTENTIAL
C ----------------------------
CALL MXMAOP(GZOBSCOR(1,1,IB),1,JPMAXILEV, XTEMP,1,JPMAXILEV,
& RESULT,1,JPMAXILEV,JPRALEV,JPRALEV,ILEN)
C
C ----------------
ELSE IF (kelem .EQ. ies .and. cdfam .eq. 'HU') THEN
C ----------------------------
C --- HUMSAT ---
C ----------------------------
CALL MXMAOP(HUOBSCOR,1,JPMAXILEV, XTEMP,1,JPMAXILEV,
& RESULT,1,JPMAXILEV,JPHLEV,JPHLEV,ILEN)
C
C
ELSE IF (kelem .EQ. idz .and. cdfam .eq. 'ST' ) THEN
C ----------------------------
C --- SATEMS ---
C ----------------------------
CALL MXMAOP(DZOBSCOR(1,1,IB),1,JPMAXILEV, XTEMP,1,JPMAXILEV,
& RESULT,1,JPMAXILEV,JPSALEV,JPSALEV,ILEN)
ENDIF
C
C *******************************************************
C REMAP INTO ORIGINAL POSITIONS (Z) AND UPDATE VECTOR Y
C *******************************************************
C
DO JDATA = 1, INREPT
IDATA = NINDX(JDATA)
IOBS = MOBDATA(NCMOBS,IDATA)
ILYR = MOBDATA(NCMLOBS,IDATA)
INOBS = IOBS-IBEGINOBS + 1
Z = RESULT(ILYR,INOBS)
C ================================
Y(JDATA)=ALPHA*Z + BETA*Y(JDATA)
C ================================
END DO
C
RETURN
END