GNU WOCSS (gwocss)  2.2.4-pre
GNU version of Winds On Critical Streamline Surfaces (WOCSS)
Functions/Subroutines
interp.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine sfctrp (NCALL)
 
subroutine vrsmoo (VAL, VALTRP, NUMBER)
 
subroutine vrsdis (VAL, VALTRP, NUMBER)
 
real function sloper (HERE, SFCMIN, HIRISE)
 

Function/Subroutine Documentation

subroutine sfctrp (   NCALL)

Definition at line 3 of file interp.f.

Referenced by geosig().

3 C********************************************************************
4 C
5 C THIS SUBROUTINE GETS FIRST ESTIMATE OF SELECTED MET VARIABLES
6 C AT LOWEST GRID POINTS. USES INVERSE DISTANCE-SQUARED WHEN FALSE.
7 C
8 C THIS VERSION FLUDWIG 3/2002
9 C
10  include 'NGRIDS.PAR'
11 C
12  include 'ANCHOR.CMM'
13  include 'FLOWER.CMM'
14  include 'LIMITS.CMM'
15  include 'STALOC.CMM'
16 C
17  REAL uob(nsites),vob(nsites),xval(nsites),yval(nsites)
18 C
19  SAVE
20 C
21  DATA zero /0.0/
22 C
23 C FIRST, GET A VALUE FOR EACH X,Y GRID POINT.
24 C
25 C INTERPOLATE TO GET VALUES AT 10 M U(IX,IY,1) & V(IX,IY,1)
26 C ABOVE EACH GRID POINT ON 1ST CALL
27 C
28  IF (ncall .LE.1) THEN
29 C
30 C*********BUG FIX WHEN MULTIPLE CASES RUN*****1/2002********
31 C FLOW SURFACE HEIGHTS MUST BE RESET TO TERRAIN-FOLLOWING ON 1ST
32 C CALL TO AVOID NEGATIVE VALUES LEFT OVER FROM PRECEDING CALCULATIONS
33 C
34  zrise=sfchi-sfclow
35  relht=avthk
36 C
37 C GET HEIGHT OF EACH 1ST GUESS SURFACE RELATIVE TO TERRAIN FOR EACH
38 C GRID PT. CHANGE IN HT RELATIVE TO THE LOWEST HT (MSL) IS ASSUMED
39 C PROPORTIONAL TO SIGMA FOR THAT SFC.
40 C
41  DO 67 jy=1,nrow
42  DO 66 ix=1,ncol
43  DO 65 kz=1,nlvl
44  IF (kz.EQ.1) THEN
45  rhs(ix,jy,kz) = z10
46  ELSE
47  rhs(ix,jy,kz) =sigma(kz)*avthk-
48  $ (sfcht(ix,jy)-sfclow)*(1.0-slfac)
49  END IF
50 C
51  IF (rhs(ix,jy,kz) .LE. 0.0) THEN
52  WRITE (*,*) 'BAD TERRAIN-FOLLOWING IN SFCTRP'
53 
54  stop
55  END IF
56 65 CONTINUE
57 66 CONTINUE
58 67 CONTINUE
59 C
60 C*********END BUG FIX WHEN MULTIPLE CASES RUN*************
61 C
62 C INTERPOLATING WIND COMPONENTS BETWEEN SURFACE OBSERVATIONS.
63 C
64  numtru=0
65  DO 80 iob=1,numnws
66  IF (ucomp(iob).GT.-9998.9) THEN
67  numtru=numtru+1
68  uob(numtru)=ucomp(iob)
69  vob(numtru)=vcomp(iob)
70  xval(numtru)=xg(iob)
71  yval(numtru)=yg(iob)
72  END IF
73 80 CONTINUE
74 C
75 C NOW ASSIGN INTERPOLATED VALUES TO LEVEL 1
76 C
77  DO 124 iy=1,nrow
78  y2=float(iy)
79  DO 122 ix=1,ncol
80  x2=float(ix)
81  CALL rinvmod(trpval,x2,y2,xval,yval,numtru,uob)
82  u(ix,iy,1)=trpval
83  CALL rinvmod(trpval,x2,y2,xval,yval,numtru,vob)
84  v(ix,iy,1)=trpval
85  levbot(ix,iy)=2
86 C
87 C ON 1ST CALL EXTRAPOLATE OR INTERPOLATE TO NEXT SURFACE
88 C
89  CALL lgntrp(u(ix,iy,2),z0,z10,
90  $ rhs(ix,iy,2),zero,u(ix,iy,1))
91  CALL lgntrp(v(ix,iy,2),z0,z10,
92  $ rhs(ix,iy,2),zero,v(ix,iy,1))
93 122 CONTINUE
94 C
95 124 CONTINUE
96 C
97  ELSE
98 C
99 C ON SECOND CALL USE VALUES FROM 1ST CALL TO
100 C DETERMINE COMPONENTS AT 1ST ABOVE GROUND LEVEL
101 C
102  DO 150 iy=1,nrow
103  DO 148 ix=1,ncol
104 C
105 C NOW SET SUBSFC VALUES TO ZERO AND INTER(EXTRA)POLATE TO
106 C LOWEST ABOVE-GROUND FLOW SURFACE.
107 C
108  IF (levbot(ix,iy).GT.2) THEN
109  DO 145 l=2,levbot(ix,iy)-1
110 C
111  u(ix,iy,l)=0.0
112  v(ix,iy,l)=0.0
113 145 CONTINUE
114  END IF
115 C
116  uu =u(ix,iy,1)
117  vv =v(ix,iy,1)
118  CALL lgntrp(u(ix,iy,levbot(ix,iy)),z0,z10,
119  $ rhs(ix,iy,levbot(ix,iy)),zero,uu)
120  CALL lgntrp(v(ix,iy,levbot(ix,iy)),z0,z10,
121  $ rhs(ix,iy,levbot(ix,iy)),zero,vv)
122 148 CONTINUE
123 150 CONTINUE
124  END IF
125 C
126  RETURN
127 C
lgntrp
subroutine lgntrp(Y, X0, X1, X, Y0, Y1)
Definition: utils.f:198
rinvmod
subroutine rinvmod(TRPVAL, X0, Y0, XX, YY, NOBS, VARBL)
Definition: invwt.f:3

Here is the call graph for this function:

Here is the caller graph for this function:

real function sloper (   HERE,
  SFCMIN,
  HIRISE 
)

Definition at line 255 of file interp.f.

Referenced by flowht().

255 C**********************************************************************
256 C
257 C DETERMINES RATIO OF HEIGHT ABOVE LOWEST TOPOGRAPHY TO MAXIMUM
258 C HEIGHT ABOVE LOWEST POINT. OTHER RELATIONSHIPS CAN BE SUBSTITUTED
259 C TO GIVE DIFFERENT FLOW SURFACE HEIGHTS. -- LUDWIG 11/87
260 C
261  IF ((hirise-sfcmin) .EQ. 0.0 .OR. hirise .EQ. 0.0) THEN
262 C
263 C FLAT TERRAIN ALWAYS GIVES FLAT SFCS
264 C
265  sloper =0.0
266  ELSE
267 C
268 C SFC RISE AT THIS PT PROPORTIONAL TO TERRAIN INCREMENT AS A FRACTION
269 C OF MAXIMUM TERRAIN ELEVATION DIFFERENCES.
270 C
271  sloper = (here-sfcmin)/hirise
272  END IF
273 C
274  RETURN
sloper
real function sloper(HERE, SFCMIN, HIRISE)
Definition: interp.f:255

Here is the caller graph for this function:

subroutine vrsdis ( real, dimension(nsites)  VAL,
real, dimension(nxgrd,nygrd)  VALTRP,
  NUMBER 
)

Definition at line 197 of file interp.f.

197 C*******************************************************************
198 C
199 C THIS PROGRAM INTERPOLATES TO FIND VALUES (VALTRP) AT GRID POINTS
200 C FROM OBSERVED VALUES (VAL)
201 C
202 C FLUDWIG, OCT 97
203 C
204 C
205 C MODIFIED TO USE INPUT VALUE WHEN WITHIN 0.5*SQRT(2) GRID UNITS
206 C OR INVERSE DISTANCE POLYNOMIAL FIT BASED ON NEAREST OBSERVATIONS
207 C OTHERWISE --- RINVMOD (TRPVAL,X0,Y0,XX,YY,NOBS,VARBL)
208 C
209 C
210 C FLUDWIG, 7/2002
211 C
212 C
213 C XG,YG,VAL COORDINATES (GRID UNITS) & VALUE AT OBSERVING SITES
214 C VALTRP INTERPOLATED VALUES AT GRID POINTS
215 C NUMBER NUMBER OF OBSERVATIONS
216 C
217  include 'NGRIDS.PAR'
218 C
219  include 'LIMITS.CMM'
220  include 'STALOC.CMM'
221 C
222  REAL val(nsites),valtrp(nxgrd,nygrd)
223  REAL varbl(nsites),xval(nsites),yval(nsites)
224 C
225  SAVE
226 C
227 C CHECK THAT DATA ARE GOOD
228 C
229  WRITE (*,*) number,(nint(100.0*val(iob)),iob=1,number)
230 C
231  IF (number.LE.0) THEN
232  WRITE(*,*) 'BAD OBSERVED DATA'
233  pause
234  stop
235  ELSE
236 C
237 C BEGIN LOOP S THROUGH GRID POINTS
238 C
239  DO 370 iy=1,nrow
240  y2=float(iy)
241  DO 365 ix=1,ncol
242  x2=float(ix)
243  CALL rinvmod(trpval,x2,y2,xval,yval,numtru,varbl)
244  valtrp(ix,iy)=trpval
245 365 CONTINUE
246  WRITE (*,*) iy,(nint(100.0*valtrp(jx,iy)),jx=20,40)
247 370 CONTINUE
248  END IF
249 C
250  RETURN
251 C
rinvmod
subroutine rinvmod(TRPVAL, X0, Y0, XX, YY, NOBS, VARBL)
Definition: invwt.f:3

Here is the call graph for this function:

subroutine vrsmoo ( real, dimension(nsites)  VAL,
real, dimension(nxgrd,nygrd)  VALTRP,
  NUMBER 
)

Definition at line 132 of file interp.f.

Referenced by betpar().

132 C*******************************************************************
133 C
134 C THIS PROGRAM INTERPOLATES TO FIND VALUES (VALTRP) AT GRID POINTS
135 C FROM OBSERVED VALUES (VAL)
136 C
137 C FLUDWIG, OCT 97
138 C THIS VERSION USES SIMPLE INVERSE DISTANCE SQUARED WEIGHTING SO THAT
139 C THOSE PARAMETERS LIKE ALTIMETER SETTING AND POTENTIAL TEMPERATURE
140 C WHICH ARE NOT EXPECTED TO HAVE VERY SHARP HORIZONTAL GRADIENTS WILL
141 C BE SMOOTHED. PRESSURE OBSERVATIONS SEEMED SUFFICIENTLY UNRELIABLE
142 C THAT SMOOTHING WAS DEEMED DESIRABLE.
143 C
144 C FLUDWIG, 6/2002
145 C
146 C
147 C XG,YG,VAL COORDINATES (GRID UNITS) & VALUE AT OBSERVING SITES
148 C VAL OBSERVED VARIABLE VALUES
149 C XVAL,YVAL COORDINATES NORMALIZED FOR MQ INTERPOLATION
150 C VALTRP INTERPOLATED VALUES AT GRID POINTS
151 C NUMBER NUMBER OF OBSERVATIONS
152 C
153  include 'NGRIDS.PAR'
154 C
155  include 'LIMITS.CMM'
156  include 'STALOC.CMM'
157 C
158  REAL val(nsites),valtrp(nxgrd,nygrd)
159  SAVE
160 C
161 C BEGIN LOOP S THROUGH GRID POINTS
162 C
163  DO 370 ix=1,ncol
164  x2=float(ix)
165  DO 365 iy=1,nrow
166  y2=float(iy)
167  numtru=0
168  sum=0.0
169  sumwt=0.0
170  DO 355 is=1,number
171 C
172 C CHECK THAT DATA ARE GOOD
173 C
174  IF (val(is).GT.-9998.9) THEN
175  weight=wndwt(x2,y2,xg(is),yg(is))
176  sumwt=sumwt+weight
177  sum=sum+weight*val(is)
178  END IF
179 355 CONTINUE
180  IF (sumwt .GT. 0.0 ) THEN
181  valtrp(ix,iy)=sum/sumwt
182  ELSE
183  WRITE (*,*) ' NO GOOD PRESSURE OR TEMP OBS IN VRSMOO'
184  WRITE (*,*) 'RETURN TO QUIT'
185  pause
186  stop
187  END IF
188 365 CONTINUE
189 370 CONTINUE
190 C
191  RETURN
192 C
wndwt
real function wndwt(X, Y, XOBS, YOBS)
Definition: utils.f:216

Here is the call graph for this function:

Here is the caller graph for this function:

Generated on Tue Sep 22 2015 23:54:04 for GNU WOCSS (gwocss) by   doxygen 1.8.10