NADCON5-ng  0.0.1
NADCON5 Next Generation
bilin.f
Go to the documentation of this file.
1 c> \ingroup core
2 c> Subroutine to perform bilinear interpolation
3 c>
4 c> Performs a bilinear interpolation
5 c> at location `xla,xlo` off of grid `data`, whose
6 c> header information is the standard `.b` header
7 c> information
8 c>
9 c> \param[in] data Input Data assumed to be real*4
10 c> \param[in] glamn minimum latitude (real*8 decimal degrees) `*.b`
11 c> \param[in] glomn minimum longitude (real*8 decimal degrees) `*.b`
12 c> \param[in] dla latitude spacing (real*8 decimal degrees) `*.b`
13 c> \param[in] dlo longitude spacing (real*8 decimal degrees) `*.b`
14 c> \param[in] nla number of lat rows (integer*4) `*.b`
15 c> \param[in] nlo number of lon cols (integer*4) `*.b`
16 c> \param[in] maxla actual dimensioned size of "data" in rows `*.b`
17 c> \param[in] maxlo actual dimensioned size of "data" in cols `*.b`
18 c> \param[in] xla lat of pt for interpolation (real*8 dec. def)
19 c> \param[in] xlo lon of pt for interpolation (real*8 dec. def)
20 c> \param[out] val interpolated value (real*8)
21  subroutine bilin(data,glamn,glomn,dla,dlo,
22  *nla,nlo,maxla,maxlo,xla,xlo,val)
23 c - Subroutine to perform a bilinear interpolation
24 c - at location "xla,xlo" off of grid "data", whose
25 c - header information is the standard ".b" header
26 c - information of
27 c - glamn = minimum latitude (real*8 decimal degrees)
28 c - glomn = minimum longitude (real*8 decimal degrees)
29 c - dla = latitude spacing (real*8 decimal degrees)
30 c - dlo = longitude spacing (real*8 decimal degrees)
31 c - nla = number of lat rows (integer*4)
32 c - nlo = number of lon cols (integer*4)
33 c - maxla = actual dimensioned size of "data" in rows
34 c - maxlo = actual dimensioned size of "data" in cols
35 
36 c - data is assumed real*4
37  implicit real*8 (a-h,o-z)
38  real*4 data(maxla,maxlo)
39  logical onedlat,onedlon
40 
41 c - HACK
42 c do 8787 i=1,nla
43 c do 8788 j=1,nlo
44 c write(6,8789)i,j,data(i,j)
45 c8788 continue
46 c8787 continue
47 c8789 format(i5,1x,i5,1x,f20.10)
48 
49 c - Find the row of xla
50  difla = (xla - glamn)
51  ratla = difla / dla
52  ila = int(ratla)+1
53  gla0 = glamn + (ila-1)*dla
54 
55 c - Find the col of xlo
56  diflo = (xlo - glomn)
57  ratlo = diflo / dlo
58  ilo = int(ratlo)+1
59  glo0 = glomn + (ilo-1)*dlo
60 
61 
62 c - Do the interpolation.
63  t=(xlo-glo0)/dlo
64  u=(xla-gla0)/dla
65 
66  val = (1.d0-t)*(1.d0-u)*data(ila ,ilo )
67  * + ( t)*(1.d0-u)*data(ila ,ilo+1)
68  * + ( t)*( u)*data(ila+1,ilo+1)
69  * + (1.d0-t)*( u)*data(ila+1,ilo )
70 
71 c - HACK
72  return
73  write(6,198)xla,xlo
74  write(6,200)ila,ilo,gla0,glo0
75  write(6,199)xla-gla0,xlo-glo0
76  write(6,201)ila,ilo,gla0,glo0,
77  *data(ila,ilo)
78  write(6,201)ila,ilo+1,gla0,glo0+dlo,
79  *data(ila,ilo+1)
80  write(6,201)ila+1,ilo,gla0+dla,glo0,
81  *data(ila+1,ilo)
82  write(6,201)ila+1,ilo+1,gla0+dla,glo0+dlo,
83  *data(ila+1,ilo+1)
84  write(6,202)'SW',(1.d0-t)*(1.d0-u)
85  write(6,202)'SE',( t)*(1.d0-u)
86  write(6,202)'NW',( t)*( u)
87  write(6,202)'NE',(1.d0-t)*( u)
88  202 format(
89  *'Weight to ',a,' corner = ',f20.15)
90 
91  198 format(
92  *6x,'bilin.f: lat/lon = ',f10.6,1x,f10.6)
93  199 format(
94  *6x,'bilin.f: diff from SW corner of cell = ',f10.6,1x,f10.6)
95  200 format(
96  *6x,'bilin.f: SW corner: ',i6,1x,i6,1x,f10.6,1x,f10.6)
97  201 format(
98  *6x,2(i6,1x),2(f10.6,1x),f20.15)
99 
100 
101 c write(6,801)xla,xlo,ila,ilo,gla0,glo0,t,u,val
102  801 format(f15.8,1x,f15.8,1x,i6,1x,i6,1x,
103  *f15.8,1x,f15.8,1x,f8.6,1x,f8.6,1x,f20.10)
104 
105 c write(6,802)data(ila ,ilo ),
106 c *data(ila ,ilo+1),data(ila+1,ilo+1),
107 c *data(ila+1,ilo )
108  802 format(4(f15.8,1x))
109 
110  return
111  end
112 
113 
114 
115 
subroutine bilin(data, glamn, glomn, dla, dlo, nla, nlo, maxla, maxlo, xla, xlo, val)
Subroutine to perform bilinear interpolation.
Definition: bilin.f:23