!-------------------------------------- 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 GD2MVO(CDVARNAME,klev) 26
*
#if defined (DOC)
*
***s/r GD2MVO - Horizontal interpolation of the model variables
* in grid-point space to observation locations.
* Bilinear interpolation from the 4 nearest grid points.
* . (adapted from BILIN)
*
*Author : P. GAUTHIER *ARMA/MSC JULY 2002
* .
*Revision:
*
** Purpose: Build GOMOBS (in COMMVO) from GD (in COMGD0) using
* . bilinear interpolation.
*
* 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 "comgd0.cdk"
#include "comcst.cdk"
#include "comoahdr.cdk"
#include "comoabdy.cdk"
#include "comoba.cdk"
#include "commvo.cdk"
*
* Arguments
*
character*2 cdvarname
integer klev
*
* Local Variables
*
INTEGER JLEV, JGL, JLON, JOBS, IOBTYP
INTEGER ILON, ILOS, IMIDDLE, ISYM, ILA, IMAX
REAL*8 DLMEAN, DLMEAS, DLLAO, DLLOO, DLDLON, DLDLOS
REAL*8 DLDXN, DLDXS, DLDY, DLW1, DLW2, DLW3, DLW4
*
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')
zfield(:,1,:)= gtg0(:,1,:)
case('PS')
zfield(:,1,:)= gps0(:,1,:)
*
* 3D fields
*
case('TT')
zfield(:,1:klev,:)= TT0(:,1:KLEV,:)
case('Q0')
zfield(:,1:klev,:)= Q0(:,1:KLEV,:)
case('O3')
zfield(:,1:klev,:)= GOZ0(:,1:klev,:)
case('TR')
zfield(:,1:klev,:)= GTR0(:,1:klev,:)
case('UU')
zfield(:,1:klev,:)= UT0(:,1:KLEV,:)
case('VV')
zfield(:,1:klev,:)= VT0(:,1:KLEV,:)
case ('GZ')
zfield(:,1:klev,:)= GZ0(:,1:klev,:)
end select
*
C
C* 1. EXPAND GRID-POINTS ARRAYS OF GD BY REPEATING MERIDIANS
C NILON(JGL), 1, AND 2 INTO MERIDIANS 0, NILON(JGL)+1,
C AND NILON(JGL+2) AND ALSO TWO PARALLELS NEAR THE POLES.
C ----------------------------------------------------------
C
C* 1.1 EXTRA MERIDIANS
C
C MERIDIAN NILON(JGL) DUPLICATED INTO MERIDIAN 0
C MERIDIAN 1 DUPLICATED INTO MERIDIAN NILON(JGL) + 1
C MERIDIAN 2 DUPLICATED INTO MERIDIAN NILON(JGL) + 2
C
DO JLEV = 1, KLEV
DO JGL = 1, NJ
IMAX = NILON(JGL)
ZFIELD(0 ,jlev,JGL) = ZFIELD(NI,jlev,JGL)
ZFIELD(IMAX+1,jlev,JGL) = ZFIELD( 1,jlev,JGL)
ZFIELD(IMAX+2,jlev,JGL) = ZFIELD( 2,jlev,JGL)
END DO
END DO
C
C * 1.2 EXTRA PARALLELS
C
C COMPUTATION OF VALUES AT NORTH AND SOUTH POLES.
C
LEVELS: DO JLEV = 1, KLEV
DLMEAN = 0.
DLMEAS = 0.
IMAX = NILON(1)
DO JLON = 1, IMAX
DLMEAN = DLMEAN + ZFIELD(JLON,jlev,1)
DLMEAS = DLMEAS + ZFIELD(JLON,jlev,NJ)
END DO
DLMEAN = DLMEAN / NILON(1)
DLMEAS = DLMEAS / NILON(NJ)
IMAX = NILON(0)
DO JLON = 0, IMAX + 2
ZFIELD(JLON,jlev,0) = DLMEAN
ZFIELD(JLON,jlev,NJ+1) = DLMEAS
END DO
C
C COMPUTATION OF VALUES FOR PARALLELS -1 AND NJ + 2 (WITH SYMETRIZATION)
C
IMIDDLE = NILON(1) / 2
DO JLON = 0, IMIDDLE
ISYM = JLON + IMIDDLE
ZFIELD(JLON,jlev,-1) = ZFIELD(ISYM,jlev,1)
ZFIELD(JLON,jlev,NJ+2) = ZFIELD(ISYM,jlev,NJ)
END DO
IMAX = NILON(1)
DO JLON = IMIDDLE + 1, IMAX + 2
ISYM = JLON - IMIDDLE
ZFIELD(JLON,jlev,-1) = ZFIELD(ISYM,jlev,1)
ZFIELD(JLON,jlev,NJ+2) = ZFIELD(ISYM,jlev,NJ)
END DO
*
END DO LEVELS
C ---------------------------------
C* 2. LOOP OVER ALL THE OBSERVATIONS
C ---------------------------------
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
C
C * 2.3 Interpolate the model state to the obs point
C
DO JLEV = 1, KLEV
ZPROFIL(JLEV,JOBS) = DLW1*ZFIELD(ILON,JLEV,ILA)
+ + DLW2*ZFIELD(ILON+1,JLEV,ILA)
+ + DLW3*ZFIELD(ILOS,JLEV,ILA+1)
+ + DLW4*ZFIELD(ILOS+1,JLEV,ILA+1)
END DO
END DO OBSERVATIONS
*
* Transfer to Global Array GOMOBS
*
SELECT CASE (CDVARNAME)
*
* 2D fields
*
CASE('TG')
GOMTGR(1:KLEV,1:NOBTOT) = ZPROFIL(1:KLEV,1:NOBTOT)
CASE('PS')
GOMPS(1:KLEV,1:NOBTOT) = ZPROFIL(1:KLEV,1:NOBTOT)
*
* 3D fields
*
CASE('TT')
GOMT (1:KLEV,1:NOBTOT) = ZPROFIL(1:KLEV,1:NOBTOT)
CASE('Q0')
GOMQ (1:KLEV,1:NOBTOT) = ZPROFIL(1:KLEV,1:NOBTOT)
CASE('O3')
GOMOZ(1:KLEV,1:NOBTOT) = ZPROFIL(1:KLEV,1:NOBTOT)
CASE('TR')
GOMTR(1:KLEV,1:NOBTOT) = ZPROFIL(1:KLEV,1:NOBTOT)
CASE('UU')
GOMU(1:KLEV,1:NOBTOT) = ZPROFIL(1:KLEV,1:NOBTOT)
CASE('VV')
GOMV(1:KLEV,1:NOBTOT) = ZPROFIL(1:KLEV,1:NOBTOT)
CASE('GZ')
GOMGZ(1:KLEV,1:NOBTOT) = ZPROFIL(1:KLEV,1:NOBTOT)
END SELECT
*
RETURN
END