SUBROUTINE GD2MVOAD (cdvarname, klev) 8
*
#if defined (DOC)
*
***s/r GD2MVOAD - Adjoint of the horizontal interpolation of the model variables
* . in grid-point space to observation locations.
* . Simple multiplication by the weights of
* . the horizontal bilinear interpolation.
* . (adapted from BILINAD)
*
*
*Author : P. GAUTHIER *ARMA/MSC JULY 2002
*
*Revision:
*
* Y. Yang July 2003
* -- add 'CASE DEFAULT' for species
* -- change 'CASE('O3')' to 'CASE('OZ')'
* Y. Yang Feb. 2005
* -- Removed 'OZ' part
*
** Purpose: Update the estimate of GD from the gradient components
* at the observation points which have been stored in
* GOMOBS
*
* Arguments
* CDVARNAME: identificator of the variable to be treated
* KLEV : number of levels (typically 1 for 2D-fields and NFLEV for 3D-fields)
*
*
*
#endif
IMPLICIT NONE
*implicits
#include "pardim.cdk"
#include "comdim.cdk"
#include "comdimo.cdk"
#include "comleg.cdk"
#include "comgem.cdk"
#include "comchem.cdk"
#include "comgd0.cdk"
#include "comcst.cdk"
#include "comoahdr.cdk"
#include "comoabdy.cdk"
#include "comoba.cdk"
#include "commvo.cdk"
#include "comlun.cdk"
*
* Arguments
*
character*(*) cdvarname
integer klev
*
* Local Variables
*
INTEGER JLEV, JGL, JLON, JOBS, IOBTYP
INTEGER ILON, ILOS, ILA, IMIDDLE, ISYM, IMAX
REAL*8 DLMEAN, DLMEAS, DLLAO, DLLOO, DLDLON, DLDLOS
REAL*8 DLDXN, DLDXS, DLDY, DLW1, DLW2, DLW3, DLW4
INTEGER JJ, KK, II
*
real*8 zfield(nibeg:niend,1:klev,njbeg:njend)
S , zprofil(1:klev,nobtot)
*
* Transfer Grid point field into local array (for generecity)
*
zfield(:,:,:) = 0.
zprofil(:,:) = 0.
*
*
SELECT CASE (CDVARNAME)
*
* 2D fields
*
CASE('TG')
ZPROFIL(1:KLEV,1:NOBTOT)= GOMTGR(1:KLEV,1:NOBTOT)
CASE('PS')
ZPROFIL(1:KLEV,1:NOBTOT)= GOMPS(1:KLEV,1:NOBTOT)
*
* 3D fields
*
CASE('TT')
ZPROFIL(1:KLEV,1:NOBTOT) = GOMT (1:KLEV,1:NOBTOT)
CASE('Q0')
ZPROFIL(1:KLEV,1:NOBTOT) = GOMQ (1:KLEV,1:NOBTOT)
CASE('UU')
ZPROFIL(1:KLEV,1:NOBTOT) = GOMU(1:KLEV,1:NOBTOT)
CASE('VV')
ZPROFIL(1:KLEV,1:NOBTOT) = GOMV(1:KLEV,1:NOBTOT)
CASE('GZ')
ZPROFIL(1:KLEV,1:NOBTOT) = GOMGZ(1:KLEV,1:NOBTOT)
CASE DEFAULT
*
* species
*
DO JJ = 1, NOCMT
IF(cdvarname .eq. CMVOCMT(JJ)) THEN
ZPROFIL(1:KLEV,1:NOBTOT) = GOMTR((JJ-1)*KLEV+1:JJ*KLEV,1:NOBTOT)
go to 500
ENDIF
ENDDO
500 continue
END SELECT
C
C* 2. LOOP OVER ALL THE OBSERVATIONS
C ---------------------------------
C
200 CONTINUE
C
Observations: DO JOBS = 1, NOBTOT
DLLAO = ROBHDR(NCMLAT,JOBS)
DLLOO = ROBHDR(NCMLON,JOBS)
IOBTYP = MOBHDR(NCMOTP,JOBS)
C
C * 2.1. LOCATE FIRST LATITUDE ROW NUMBER (ILA) TO THE NORTH
C * OF ZLAO, AND THE TWO LONGITUDE POINT NUMBERS IMMEDIATELY
C TO THE WEST (ILON AND ILOS)
C
ILA=MOBHDR(NCMTLA,JOBS)
C
IF(DLLOO.LT.0.) DLLOO = DLLOO + 2.*RPI
IF(DLLOO.GE.2.*RPI) DLLOO = DLLOO - 2.*RPI
DLDLON = 2.*RPI/NILON(ILA)
DLDLOS = 2.*RPI/NILON(ILA+1)
ILON = INT(DLLOO/DLDLON) + 1
ILOS = INT(DLLOO/DLDLOS) + 1
C
C * 2.2 COMPUTE THE 4 WEIGHTS OF THE BILINEAR INTERPOLATION
C
DLDXN = DLLOO/DLDLON + 1. - ILON
DLDXS = DLLOO/DLDLOS + 1. - ILOS
DLDY = (RLATI(ILA)-DLLAO)/(RLATI(ILA)-RLATI(ILA+1))
DLW1 = (1.-DLDXN)*(1.-DLDY)
DLW2 = DLDXN*(1.-DLDY)
DLW3 = (1.-DLDXS)*DLDY
DLW4 = DLDXS*DLDY
C
do jlev = 1, klev
ZFIELD(ILON,jlev,ILA) = ZFIELD(ILON,jlev,ILA)
+ + DLW1 * ZPROFIL(jlev,JOBS)
ZFIELD(ILON+1,jlev,ILA) = ZFIELD(ILON+1,jlev,ILA)
+ + DLW2 * ZPROFIL(jlev,JOBS)
ZFIELD(ILOS,jlev,ILA+1) = ZFIELD(ILOS,jlev,ILA+1)
+ + DLW3 * ZPROFIL(jlev,JOBS)
ZFIELD(ILOS+1,jlev,ILA+1) = ZFIELD(ILOS+1,jlev,ILA+1)
+ + DLW4 * ZPROFIL(jlev,JOBS)
C
end do
*
end do OBSERVATIONS
C
C
C 1. REARRANGE GRID-POINTS ARRAYS GD0, BY CARRYING GRADIENTS
C . CONTRIBUTIONS OF MERIDIAN 0, NILON(JGL)+1 AND NILON(JGL+2)
C . INTO MERIDIANS NILON(JGL), 1, AND 2. SIMILAR TREATMENT NEAR POLES
C
C
C 1.2 EXTRA PARALLELS
C
C TREATMENT OF GRADIENTS FOR PARALLELS -1 AND NJ + 2 (WITH SYMETRIZATION)
C
LEVELS: DO JLEV = 1, KLEV
IMIDDLE = NILON(1) / 2
DO JLON = 0, IMIDDLE
ISYM = JLON + IMIDDLE
ZFIELD(ISYM,jlev,1) = ZFIELD(JLON,jlev,-1)
+ + ZFIELD(ISYM,jlev,1)
ZFIELD(ISYM,jlev,NJ) = ZFIELD(JLON,jlev,NJ+2)
+ + ZFIELD(ISYM,jlev,NJ)
END DO
*
IMAX = NILON(1)
DO JLON = IMIDDLE + 1, IMAX + 2
ISYM = JLON - IMIDDLE
ZFIELD(ISYM,JLEV,1) = ZFIELD(JLON,JLEV,-1)
+ + ZFIELD(ISYM,JLEV,1)
ZFIELD(ISYM,JLEV,NJ) = ZFIELD(JLON,JLEV,NJ+2)
+ + ZFIELD(ISYM,JLEV,NJ)
END DO
C
C TREATMENT OF THE GRADIENTS AT NORTH AND SOUTH POLES.
C
DLMEAN = 0.
DLMEAS = 0.
IMAX = NILON(0)
DO JLON = 0, IMAX + 2
DLMEAN = DLMEAN + ZFIELD(JLON,jlev,0)
DLMEAS = DLMEAS + ZFIELD(JLON,jlev,NJ+1)
end do
*
DLMEAN = DLMEAN/NILON(1)
DLMEAS = DLMEAS/NILON(NJ)
IMAX = NILON(1)
DO JLON = 1, IMAX
ZFIELD(JLON,jlev,1) = DLMEAN + ZFIELD(JLON,jlev,1)
ZFIELD(JLON,jlev,NJ) = DLMEAS + ZFIELD(JLON,jlev,NJ)
end do
*
END DO LEVELS
C
C
C 1.1 EXTRA MERIDIANS
C
DO JGL = 1, NJ
IMAX = NILON(JGL)
DO JLEV = 1, KLEV
ZFIELD(IMAX,JLEV,JGL) = ZFIELD(0,JLEV,JGL)
+ + ZFIELD(IMAX,JLEV,JGL)
ZFIELD(1,JLEV,JGL) = ZFIELD(IMAX+1,JLEV,JGL)
+ + ZFIELD(1,JLEV,JGL)
ZFIELD(2,JLEV,JGL) = ZFIELD(IMAX+2,JLEV,JGL)
+ + ZFIELD(2,JLEV,JGL)
END DO
END DO
*
* Adjoint of the identity (change of norm)
*
DO JGL = 1, NJ
IMAX = NILON(JGL)
DO JLEV = 1, KLEV
DO JLON = 1, IMAX
ZFIELD(JLON,JLEV,JGL) = ZFIELD(JLON,JLEV,JGL) *
+ NILON(JGL) / RWT(JGL)
END DO
END DO
END DO
C
C Transfer local results to global array
C
select case (cdvarname)
*
* 2D fields
*
case('TG')
gtg0(:,1:klev,:) = zfield(:,1:klev,:)
case('PS')
gps0(:,1:klev,:) = zfield(:,1:klev,:)
*
* 3D fields
*
case('TT')
tt0(:,1:klev,:) = zfield(:,1:klev,:)
case('Q0')
q0 (:,1:klev,:) = zfield(:,1:klev,:)
case('UU')
UT0(:,1:klev,:) = zfield(:,1:klev,:)
case('VV')
VT0(:,1:klev,:) = zfield(:,1:klev,:)
case ('GZ')
GZ0(:,1:klev,:) = zfield(:,1:klev,:)
case default
*
DO JJ = 1, NGCMT
IF(cdvarname .eq. CGCMT(JJ)) THEN
GTR0(:,((jj-1)*klev+1):jj*klev,:) = GTR0(:,((jj-1)*klev+1):
$ jj*klev,:) +zfield(:,1:klev,:)
go to 400
ENDIF
ENDDO
400 continue
end select
RETURN
END