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

Go to the source code of this file.

Functions/Subroutines

subroutine fixwnd (IFXPT, LVL)
 
subroutine betwin
 

Function/Subroutine Documentation

subroutine betwin ( )

Definition at line 96 of file windest.f.

Referenced by geosig().

96 C*********************************************************************
97 C
98 C THIS SUBROUTINE ESTIMATES WINDS BETWEEN THE TOP AND BOTTOM LEVELS.
99 C THE DEVIATION OF OBSERVED WINDS FROM A LOG PROFILE IS FIRST
100 C DETERMINED. THEN THE DEVIATIONS AT EACH LEVEL ARE INTERPOLATED BY
101 C AN INVERSE DISTANCE TO A POWER WEIGHTING SCHEME. THE
102 C INTERPOLATED DEVIATIONS ARE USED TO CORRECT THE CALCULATED LOG
103 C PROFILES AT THE GRID POINTS.
104 C --F LUDWIG 12/87
105 C
106  include 'NGRIDS.PAR'
107 C
108  include 'ANCHOR.CMM'
109  include 'FLOWER.CMM'
110  include 'LIMITS.CMM'
111  include 'STALOC.CMM'
112  include 'TSONDS.CMM'
113 C
114  REAL ddopu(nwsite,nzgrd),ddopv(nwsite,nzgrd)
115  REAL dutmp(nsites),dvtmp(nsites),xvar(nsites),yvar(nsites)
116 C
117  INTEGER lbot(nwsite)
118 C
119  LOGICAL oksond(nwsite,nzgrd)
120 C
121  IF (nlvl .LE. 3) THEN
122  WRITE (*,*) ' ONLY ',nlvl-1,' FLOW SURFACES'
123  RETURN
124  END IF
125 C
126 C GET LOG PROFILES AT OBSERVATION POINTS AND DEVIATIONS FROM THEM.
127 C Z0=ROUGHNESS HT.
128 C
129  IF (numdop .GT. 0) THEN
130  DO 50 jdop = 1,numdop
131 C
132 C FIND LOWEST FLOW SURFACE FOR THIS SONDE
133 C
134  DO 22 il=2,nlvl
135  IF (zsigl(jdop,il) .GE. z0) THEN
136  h0=zsigl(jdop,il)
137  lbot(jdop)=il
138  GO TO 24
139  END IF
140 22 CONTINUE
141 C
142 C INTERPOLATE BETWEEN LOWEST AND HIGHEST LEVELS ABOVE THE
143 C SURFACE FOR GETTING DEVIATIONS.
144 C
145 24 uu = usig(jdop,lbot(jdop))
146  vv = vsig(jdop,lbot(jdop))
147  h0 = zsigl(jdop,lbot(jdop))
148  utop = usig(jdop,nlvl)
149  vtop = vsig(jdop,nlvl)
150  ztop = zsigl(jdop,nlvl)
151  ddopu(jdop,nlvl)=0.0
152  ddopv(jdop,nlvl)=0.0
153  oksond(jdop,nlvl)=.true.
154  oksond(jdop,lbot(jdop))=.true.
155  DO 38 ll = 2,nlvl-1
156  IF (ll .GT. lbot(jdop)) THEN
157  zz = zsigl(jdop,ll)
158  CALL lgntrp(uu,h0,ztop,zz,u0,utop)
159  CALL lgntrp(vv,h0,ztop,zz,v0,vtop)
160 C
161 C GET DEVIATIONS FROM LOG INTERPOLATED VALUE FOR THIS LEVEL
162 C
163  ddopu(jdop,ll) = usig(jdop,ll)-uu
164  ddopv(jdop,ll) = vsig(jdop,ll)-vv
165  oksond(jdop,ll)=.true.
166  ELSE
167  ddopu(jdop,ll)=0.0
168  ddopv(jdop,ll)=0.0
169  IF (ll.NE.lbot(jdop)) oksond(jdop,ll)=.false.
170  END IF
171 38 CONTINUE
172 50 CONTINUE
173  END IF
174 C
175 C GET LOG PROFILES AT EACH GRID POINT-- FROM 1ST ABOVE-GROUND LEVEL.
176 C THEN ADD DEVIATION FROM LOG AS DETERMINED FROM HORIZONTAL
177 C INTERPOLATION BETWEEN SOUNDINGS
178 C
179  nevent=0
180  DO 100 ix = 1,ncol
181  xhere=float(ix)
182  DO 90 iy = 1,nrow
183  yhere=float(iy)
184  utop = u(ix,iy,nlvl)
185  vtop = v(ix,iy,nlvl)
186  ztop = rhs(ix,iy,nlvl)
187  h0 = 10.0
188  u0 = u(ix,iy,1)
189  v0 = v(ix,iy,1)
190  DO 80 ll=levbot(ix,iy),nlvl-1
191 C
192 C GET COMPONENTS FROM LOG LINEAR INTERPOLATION BETWEEN TOP AND BOTTOM
193 C
194  zz=rhs(ix,iy,ll)
195  CALL lgntrp(u(ix,iy,ll),h0,ztop,zz,u0,utop)
196  CALL lgntrp(v(ix,iy,ll),h0,ztop,zz,v0,vtop)
197 C
198 C GET CORRECTION FOR THIS GRID POINT AND FLOW LEVEL
199 C
200  n4use=0
201  DO 78 jdop = 1,numdop
202 C
203  IF (oksond(jdop,ll)) THEN
204  n4use=n4use+1
205  dutmp(n4use)=ddopu(jdop,ll)
206  dvtmp(n4use)=ddopv(jdop,ll)
207  xvar(n4use)=xdop(jdop)
208  yvar(n4use)=ydop(jdop)
209  END IF
210 78 CONTINUE
211 C
212 C IF THIS GRID PT. IS BELOW THE BOTTOM FLOW SFC FOR ALL SOUNDINGS, WE
213 C SET THE DEVIATION TO 0 AND USE THE INTERPOLATED VALUE
214 C
215  IF (n4use.LE.0) THEN
216  nevent=nevent+1
217  du=0.0
218  dv=0.0
219  ELSE
220  CALL rinvmod(du,xhere,yhere,xvar,yvar,
221  $ n4use,dutmp)
222  CALL rinvmod(dv,xhere,yhere,xvar,yvar,
223  $ n4use,dvtmp)
224  END IF
225 C
226 C CHECK FOR INTERPOLATED SOND DATA AND USE IT TO CORRECT THE
227 C LOG PROFILE.I IF NO OBS ON THIS FLOW SFC, USE THE VALUES ALREADY
228 C INTERPOLATED.
229 C
230  u(ix,iy,ll)=du+u(ix,iy,ll)
231  v(ix,iy,ll)=dv+v(ix,iy,ll)
232 C
233 80 CONTINUE
234 90 CONTINUE
235 100 CONTINUE
236 C
237 C INTRODUCE INFLUECE OF OBSERVED SURFACE WINDS ON LOWEST LAYER ALOFT
238 C BY INTERPOLATING BETWEEN ANEMOMETER HT. AND 2ND LOWEST SFC.TO
239 C OBTAIN WIND ON THE LOWEST ABOVE GROUND SURFACE. IF ONLY THE TOP
240 C SFC IS ABOVE GROUND, EXTRAPOLATE UP FROM SFC.
241 C
242  DO 200 ix=1,ncol
243  DO 190 iy=1,nrow
244 C
245  IF (levbot(ix,iy).LT.nlvl) THEN
246  u0=u(ix,iy,1)
247  v0=v(ix,iy,1)
248  h0=z10
249  utop=u(ix,iy,levbot(ix,iy)+1)
250  vtop=v(ix,iy,levbot(ix,iy)+1)
251  ztop=rhs(ix,iy,levbot(ix,iy)+1)
252  zz=rhs(ix,iy,levbot(ix,iy))
253  CALL lgntrp(uu,h0,ztop,zz,u0,utop)
254  CALL lgntrp(vv,h0,ztop,zz,v0,vtop)
255  u(ix,iy,levbot(ix,iy))=uu
256  v(ix,iy,levbot(ix,iy))=vv
257  ELSE
258  u0=0.0
259  v0=0.0
260  h0=z0
261  utop=u(ix,iy,1)
262  vtop=v(ix,iy,1)
263  ztop=z10
264  zz=rhs(ix,iy,nlvl)
265  CALL lgntrp(uu,h0,ztop,zz,u0,utop)
266  CALL lgntrp(vv,h0,ztop,zz,v0,vtop)
267  u(ix,iy,levbot(ix,iy))=uu
268  v(ix,iy,levbot(ix,iy))=vv
269  END IF
270 190 CONTINUE
271 200 CONTINUE
272 C
273  RETURN
274 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:

subroutine fixwnd ( logical, dimension(nxgrd,nygrd)  IFXPT,
  LVL 
)

Definition at line 3 of file windest.f.

Referenced by bal5(), and levwnd().

3 C******************************************************************
4 C
5 C THIS ROUTINE IDENTIFIES PTS NEAR OBSERVATION SITES SO THAT
6 C WIND ADJUSTMENTS CAN BE RESTRAINED IN SUBROUTINE BAL5.
7 C
8 C___________________________________________________________________
9 C
10 C MODIFIED SO THAT ALL LEVELS ABOVE AN UPPER WIND SITE ARE IDENTIFIED,
11 C BUT ONLY THE FIRST ABOVE GROUND LEVEL FOR SURFACE WIND SITES.
12 C
13 C F. L. LUDWIG, 3/96
14 C___________________________________________________________________
15 C
16 C FURTHER MODIFIED SO THAT ABOVE GROUND POINTS ON A SURFACE ARE
17 C FLAGGED FOR RESTRAINED ADJUSTMENT IF THEY HAVE 3 OR MORE OF THE 4
18 C SURROUNDING POINTS ARE BELOW GROUND.
19 C
20 C FLUDWIG 3/2000
21 C___________________________________________________________________
22 C
23  include 'NGRIDS.PAR'
24 C
25  include 'FLOWER.CMM'
26  include 'LIMITS.CMM'
27  include 'STALOC.CMM'
28 C
29  LOGICAL ifxpt(nxgrd,nygrd)
30  SAVE
31 C
32 C INTIALIZE IFXPT VALUES TO FALSE
33 C
34  DO 22 ix=1,nxgrd
35  DO 20 iy=1,nygrd
36  ifxpt(ix,iy)=.false.
37 20 CONTINUE
38 22 CONTINUE
39 C
40 C CHECK ALL GRID POINTS TO SEE IF THEY SHOULD BE ADJUSTED
41 C IF THE POINT ITSELF, OR 3 OR 4 OF THE SURROUNDING POINTS
42 C ARE SUBTERRAINIAN, RESTRICT ADJUSTMENTS, I.E. SET IFXPT TO .TRUE.
43 C
44  DO 50 ix=2,ncol-1
45  DO 48 iy=2,nrow-1
46  IF (rhs(ix,iy,lvl).LE. 0.0) THEN
47  ifxpt(ix,iy)=.true.
48  ELSE
49  nsubter=0
50  DO 44 jx=ix-1,ix+1,2
51  DO 40 jy=iy-1,iy+1,2
52  IF (rhs(jx,jy,lvl).LE. 0.0)
53  $ nsubter=nsubter+1
54 40 CONTINUE
55 44 CONTINUE
56  IF (nsubter .GE. 3) THEN
57  ifxpt(ix,iy)=.true.
58  ELSE
59  ifxpt(ix,iy)=.false.
60  END IF
61  END IF
62 48 CONTINUE
63 50 CONTINUE
64 
65 C
66 C SET FLAG FOR LIMITED ADJUSTMENT AT POINTS AROUND OBS SITE
67 C
68  DO 200 i=1,nsites
69  IF (i .LE. numnws ) THEN
70 C
71 C CHECK TO SEE IF THIS SITE HAD AN OBSERVATION
72 C
73  IF (jgood(i)) THEN
74  ix=nint(xg(i))
75  iy=nint(yg(i))
76  IF (ix.GT.0 .AND. ix.LE.ncol
77  $ .AND. iy.GT.0 .AND.
78  $ iy .LE.nrow) THEN
79 C
80 C CHECK TO SEE IF THIS IS FIRST LEVEL ABOVE SURFACE FOR
81 C SURFACE OBSERVATIONS.
82 C
83  IF (rhs(ix,iy,lvl) .GT. 0.0 .OR. lvl.EQ.1)
84  $ ifxpt(ix,iy)=.true.
85  END IF
86  END IF
87  END IF
88 C
89 200 CONTINUE
90 C
91  RETURN

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