!-------------------------------------- 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 BILIN 9
*
#if defined (DOC)
*
***s/r BILIN - Horizontal interpolation of the model variables
* in grid-point space to observation points.
* Bilinear interpolation from the 4 nearest grid points.
* . (based on HOR4 from the ARPEGE/IFS model)
*
*Author : J. Pailleux ECMWF 90-01-11
* . Luc Fillion RPN/AES Jan 1993
*Revision:
* . P. Gauthier *ARMA/AES October 6,1993: operations performed on the
* . global state
* . P. Gauthier *ARMA/AES May 20,1993: modifications to the CMA files
* . P. Gauthier *ARMA/AES May 25,1993: -Treatment of specific humidity
* . and surface pressure
* . P. Koclas *CMC/AES Sept 08,1994: removal of call to isrchila by
* access to "transormed latitudes" contained in observation
* headers.
* . S. Pellerin *ARMA/AES Aug. 11, 1998:
* . Interpolation performed on
* individual variable and conditional
* to the existance of a variable in GOMOBS
* and GD.
* . Interpolation of GZ model state to GOMGZ
* when TT is the control variable.
* . J. Halle *CMDA/AES Oct 99.
* - Added ground temperature (TG) to the model state.
*
** Purpose: Build GOMU, GOMV, GOMT, GOMGZ, GOMQ and GOMPS with the model variables at the
* observation points from the model variables in grid-points
* space using bilinear interpolation.
*
*
#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"
#include "comstate.cdk"
*
INTEGER JLEV, JK, 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
C
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.0 TRANSFORM WIND IMAGES INTO PHYSICAL WINDS
C
100 CONTINUE
C
DO 103 JLEV = 1, NFLEV
DO 102 JGL = 1, NJ
IMAX = NILON(JGL)
DO 101 JLON = 1, IMAX
UT0(JLON,JLEV,JGL) = CONPHY(JGL) * UT0(JLON,JLEV,JGL)
VT0(JLON,JLEV,JGL) = CONPHY(JGL) * VT0(JLON,JLEV,JGL)
101 CONTINUE
102 CONTINUE
103 CONTINUE
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 110 JK = 1, NKGDIM
DO 111 JGL = 1, NJ
IMAX = NILON(JGL)
GD(0 ,JK,JGL) = GD(NI,JK,JGL)
GD(IMAX+1,JK,JGL) = GD( 1,JK,JGL)
GD(IMAX+2,JK,JGL) = GD( 2,JK,JGL)
111 CONTINUE
110 CONTINUE
C
C* 1.2 EXTRA PARALLELS
C
DO 120 JK = 1, NKGDIM
C
C COMPUTATION OF VALUES AT NORTH AND SOUTH POLES.
C
DLMEAN = 0.
DLMEAS = 0.
IMAX = NILON(1)
DO 121 JLON = 1, IMAX
DLMEAN = DLMEAN + GD(JLON,JK,1)
DLMEAS = DLMEAS + GD(JLON,JK,NJ)
121 CONTINUE
DLMEAN = DLMEAN / NILON(1)
DLMEAS = DLMEAS / NILON(NJ)
IMAX = NILON(0)
DO 122 JLON = 0, IMAX + 2
GD(JLON,JK,0) = DLMEAN
GD(JLON,JK,NJ+1) = DLMEAS
122 CONTINUE
C
C COMPUTATION OF VALUES FOR PARALLELS -1 AND NJ + 2 (WITH SYMETRIZATION)
C
IMIDDLE = NILON(1) / 2
DO 123 JLON = 0, IMIDDLE
ISYM = JLON + IMIDDLE
GD(JLON,JK,-1) = GD(ISYM,JK,1)
GD(JLON,JK,NJ+2) = GD(ISYM,JK,NJ)
123 CONTINUE
IMAX = NILON(1)
DO 124 JLON = IMIDDLE + 1, IMAX + 2
ISYM = JLON - IMIDDLE
GD(JLON,JK,-1) = GD(ISYM,JK,1)
GD(JLON,JK,NJ+2) = GD(ISYM,JK,NJ)
124 CONTINUE
C
120 CONTINUE
c
C
C* 2. LOOP OVER ALL THE OBSERVATIONS
C ---------------------------------
C
200 CONTINUE
C
DO 201 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 JK = 1, nflev
if(NGEXIST(nguu).eq.1) then
gomu(JK,JOBS) = DLW1*ut0(ILON,JK,ILA)
+ + DLW2*ut0(ILON+1,JK,ILA)
+ + DLW3*ut0(ILOS,JK,ILA+1)
+ + DLW4*ut0(ILOS+1,JK,ILA+1)
endif
if(NGEXIST(ngvv).eq.1) then
gomv(JK,JOBS) = DLW1*vt0(ILON,JK,ILA)
+ + DLW2*vt0(ILON+1,JK,ILA)
+ + DLW3*vt0(ILOS,JK,ILA+1)
+ + DLW4*vt0(ILOS+1,JK,ILA+1)
endif
if(NGEXIST(ngq).eq.1) then
gomq(JK,JOBS) = DLW1*q0(ILON,JK,ILA)
+ + DLW2*q0(ILON+1,JK,ILA)
+ + DLW3*q0(ILOS,JK,ILA+1)
+ + DLW4*q0(ILOS+1,JK,ILA+1)
endif
if(NGEXIST(nggz).eq.1) then
gomgz(JK,JOBS) = DLW1*gz0(ILON,JK,ILA)
+ + DLW2*gz0(ILON+1,JK,ILA)
+ + DLW3*gz0(ILOS,JK,ILA+1)
+ + DLW4*gz0(ILOS+1,JK,ILA+1)
endif
if(NGEXIST(ngtt).eq.1) then
gomt(JK,JOBS) = DLW1*tt0(ILON,JK,ILA)
+ + DLW2*tt0(ILON+1,JK,ILA)
+ + DLW3*tt0(ILOS,JK,ILA+1)
+ + DLW4*tt0(ILOS+1,JK,ILA+1)
endif
if(NGEXIST(ngoz).eq.1) then
gomoz(JK,JOBS) = DLW1*goz0(ILON,JK,ILA)
+ + DLW2*goz0(ILON+1,JK,ILA)
+ + DLW3*goz0(ILOS,JK,ILA+1)
+ + DLW4*goz0(ILOS+1,JK,ILA+1)
endif
if(NGEXIST(ngtr).eq.1) then
gomtr(JK,JOBS) = DLW1*gtr0(ILON,JK,ILA)
+ + DLW2*gtr0(ILON+1,JK,ILA)
+ + DLW3*gtr0(ILOS,JK,ILA+1)
+ + DLW4*gtr0(ILOS+1,JK,ILA+1)
endif
enddo
if(NGEXIST(ngps).eq.1) then
gomps(1,JOBS) = DLW1*gps0(ILON,1,ILA)
+ + DLW2*gps0(ILON+1,1,ILA)
+ + DLW3*gps0(ILOS,1,ILA+1)
+ + DLW4*gps0(ILOS+1,1,ILA+1)
endif
if(NGEXIST(ngtg).eq.1) then
gomtgr(1,JOBS) = DLW1*gtg0(ILON,1,ILA)
+ + DLW2*gtg0(ILON+1,1,ILA)
+ + DLW3*gtg0(ILOS,1,ILA+1)
+ + DLW4*gtg0(ILOS+1,1,ILA+1)
endif
201 CONTINUE
C
RETURN
END