>
> Hi,
> I want to draw wind data as wind barbs rather than vectors.
> I have an old modified version of velvct that would let me do this.
> But this will not work with newer versions of ncar graphics.
> How can I accomplish this with ncar graphics 3.2?
> thanks
> David Knight Tel: (518)-442-4204
> Department of Atmospheric Science Fax: (518)-442-4494
> SUNYA ES-228 Bitnet: dk962 AT unknown
> Albany, NY 12222 Internet: knight AT unknown
>
Wind barbs will be fully supported in version 4.0. For version 3.2,
here is a *very* quick-and-dirty program that will do the most basic
thing. This program was originally written by Dennis Joseph and
modified by Ken Hansen.
program tbrb
ac=3.14159265/180.
spd=-8.
call opngks
call set(0.,1.,0.,1.,0.,12.,0.,12.,1)
do 20 i=1,11
spd=spd+8.
do 15 j=1,12
dir=(30.*j-180.)*ac
u=spd*sin(dir)
v=spd*cos(dir)
x=i
y=j
call wndbarb(x,y,u,v)
15 continue
20 continue
call frame
call clsgks
stop
end
subroutine wndbarb(x,y,u,v)
c x,y - coord of origin of wind barbs
c u,v - wind components
data sc/50./,pf/.3/,pi/.15/
data ba/50./,bb/10./
c sc - length of wind shaft in dd80 units
c pf - full tic length as a fraction of shaft length
c pi - distance between tics as a fraction of shaft length
c ba - value for which triangle is drawn
c bb - value for which tic is drawn
c - half tic for half of bb
call frstpt(x,y)
if(u .eq. 0. .and. v .eq. 0.) return
call mxmy(m,n)
xn=sqrt(u*u+v*v)
mx=-sc*u/xn
ny=-sc*v/xn
ia=pf*ny
ja=-pf*mx
mmx=mx+m
nny=ny+n
call vector(cpux(mmx),cpuy(nny))
pc=1.
xt=xn+.25*bb
5 if(xt .lt. ba) go to 15
i=pc*mx+m+.5
j=pc*ny+n+.5
call frstpt(cpux(i),cpuy(j))
ii=i+ia
jj=j+ja
call vector(cpux(ii),cpuy(jj))
pc=pc-pi
i=pc*mx+m+.5
j=pc*ny+n+.5
call vector(cpux(i),cpuy(j))
pc=pc-pi
xt=xt-ba
go to 5
15 continue
if(xt .lt. bb) go to 25
i=pc*mx+m+.5
j=pc*ny+n+.5
call frstpt(cpux(i),cpuy(j))
ii=i+ia
jj=j+ja
call vector(cpux(ii),cpuy(jj))
pc=pc-pi
xt=xt-bb
go to 15
25 if(xt .lt. .5*bb) go to 30
i=pc*mx+m
j=pc*ny+n
call frstpt(cpux(i),cpuy(j))
ii=i+.5*ia
jj=j+.5*ja
call vector(cpux(ii),cpuy(jj))
30 continue
return
end
This archive was generated by hypermail 2b29 : Wed Jun 28 2000 - 09:40:24 MDT