[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: /home/support/Mail/inbox/19
- Subject: Re: /home/support/Mail/inbox/19
- Date: Thu, 21 Aug 2003 16:12:40 -0600 (MDT)
Robert,
Attatched is the updated pvgrid.f routine for $GARPHOME/gempak/ directory.
I haven't put into the source tarfile yet.
Steve Chiswell
****************************************************************************
Unidata User Support UCAR Unidata Program
303 497 8643 P.O. Box 3000
address@hidden Boulder, CO 80307
----------------------------------------------------------------------------
Unidata WWW Service http://my.unidata.ucar.edu/content/support
****************************************************************************
On Thu, 21 Aug 2003 address@hidden wrote:
> Replied: Thu, 21 Aug 2003 15:59:44 -0600
> Replied: Robert Mullenax <address@hidden>
> Replied: "'address@hidden'" <address@hidden>
> From address@hidden Mon Aug 11 13:23:32 2003
> Received: from uwxcom02.univ-wea.com (uwxcom02.univ-wea.com [12.31.213.85])
> by unidata.ucar.edu (UCAR/Unidata) with ESMTP id h7BJNVLd004847
> for <address@hidden>; Mon, 11 Aug 2003 13:23:32 -0600 (MDT)
> Organization: UCAR/Unidata
> Keywords: 200308111923.h7BJNVLd004847
> Received: from LIGHTNING.univ-wea.com (latrobe.univ-wea.com [12.31.213.81])
> by uwxcom02.univ-wea.com (8.12.8/8.12.8) with ESMTP id h7BJNQli008059
> for <address@hidden>; Mon, 11 Aug 2003 19:23:26 GMT
> Received: by lightning.univ-wea.com with Internet Mail Service (5.5.2653.19)
> id <QTTYKMXR>; Mon, 11 Aug 2003 14:23:09 -0500
> Message-ID: <address@hidden>
> From: Robert Mullenax <address@hidden>
> To: "'address@hidden'" <address@hidden>
> Subject: GARP won't display model wind vectors in 5.6k
> Date: Mon, 11 Aug 2003 14:23:07 -0500
> MIME-Version: 1.0
> X-Mailer: Internet Mail Service (5.5.2653.19)
> Content-Type: text/plain;
> charset="iso-8859-1"
> X-Spam-Status: No, hits=0.1 required=5.0
> tests=AWL,EXCHANGE_SERVER,NOSPAM_INC,SPAM_PHRASE_00_01
> version=2.43
> X-Spam-Level:
>
> I got into the ftp site today to see if 5.6k was there..and went ahead and
> got it and built it
> on RH Linux 8.0. It built fine, but whne I went to display 500mb winds in
> GARP
> from the eta211 model (a test I always use) it displayed calm winds at each
> point. I noticed
> it was the same at any level or with any model. I didn't see any errors in
> the compile and no
> errors are written to the terminal when GARP is started by itself from the
> command line.
> NMAP2, gdwinds, and gdwind2 all work fine as far as displaying the same
> thing.
>
> As another test I got the Unidata 5.6k Linux binary and had the same result.
>
> I thought I would let you know, even though 5.6k hasn't been officialy
> released yet.
>
> Robert
>
> Robert Mullenax
> Weather Systems Administrator
> Universal Weather and Aviation
>
>
C***********************************************************************
C*
C* Copyright 1996, University Corporation for Atmospheric Research.
C*
C* pvgrid.f
C*
C* Vector data plotter. Derived from the GEMPAK program GDWIND.
C*
C* History:
C*
C* 11/96 COMET Original copy
C* 4/97 COMET Added "scale" as an input parameter.
C* 5/97 COMET Added gprintf to support logging.
C* 11/97 COMET Added ptitle to display clickable titles.
C* 11/97 COMET Added call to dscolor, cleaned up.
C*
C************************************************************************
SUBROUTINE pvgrid ( gdfile, gdatim, glevel, gvcord, ggvect,
+ gridtype, wind, refvec, scale, skip, title,
+ text, nfunc, ititle, verbose, iperr )
C************************************************************************
C* S. Chiswell: Updated to remove use of subflg fpr GEMPAK calls (8/03)
C************************************************************************
INCLUDE 'GEMPRM.PRM'
C*
CHARACTER gdfile*(*), gdatim*(*), glevel*(*),
+ gvcord*(*), ggvect*(*), gridtype*(*), wind*(*),
+ refvec*(*), scale*(*) , skip*(*), title*(*)
CHARACTER text*(*)
INTEGER verbose
CHARACTER shrttl*72
C*
REAL grid (LLMXGD), grid1 (LLMXGD), grid2 (LLMXGD)
REAL sped (LLMXGD), drct (LLMXGD)
REAL fi (100), fj (100), s (100), d (100)
INTEGER level (2)
CHARACTER parm*12, parmu*12, parmv*12,
+ pfunc*72, gvect*72, gtype*12
CHARACTER gv*72, time(2)*20, winuni*1, wintyp*1
CHARACTER ttlstr*72, defstr*12, ttl*72, blank*2
LOGICAL done, proces
LOGICAL first, novect
INTEGER iskplt (2)
character panel*72
C-----------------------------------------------------------------------
C
panel = '0'
iperr = 0
ioldclr = 0
blank = ' ' // char(0)
first = .TRUE.
if ( verbose .gt. 0 ) call gfprints (
+ 'pvgrid'//char(0), blank )
if ( verbose .gt. 1 ) then
call gfprints ( ' gdfile = ' // char(0), gdfile )
call gfprints ( ' gdatim = ' // char(0), gdatim )
call gfprints ( ' glevel = ' // char(0), glevel )
call gfprints ( ' gvcord = ' // char(0), gvcord )
call gfprints ( ' gvect = ' // char(0), ggvect )
call gfprints ( ' wind = ' // char(0), wind )
call gfprints ( ' refvec = ' // char(0), refvec )
call gfprints ( ' scale = ' // char(0), scale )
call gfprints ( ' skip = ' // char(0), skip )
call gfprints ( ' title = ' // char(0), title )
call gfprints ( ' text = ' // char(0), text )
call gfprinti ( ' nfunc = ' // char(0), nfunc )
call gfprinti ( ' ititle = ' // char(0), ititle )
call gfprinti ( ' verbose = ' // char(0), verbose )
call gfprinti ( ' iperr = ' // char(0), iperr )
end if
C
C Indicate that file is closed.
C
igdfln = 0
C
C* Set text.
C
CALL IN_TEXT ( text, ier )
C
C* Set flag to indicate processing will be done.
C
proces = .true.
C
IF ( iperr .ne. 0 ) THEN
done = .true.
ELSE
C
C* Open the grid file and set the grid navigation.
C
CALL DG_OFIL ( gdfile, ' ', .false., igdfln, idum, iret )
IF ( iret .ne. 0 ) proces = .false.
C
C* Check which points are in the graphics area.
C
CALL GR_GALM ( kx, ky, ix1, iy1, ix2, iy2, iret )
IF ( iret .ne. 0 ) THEN
CALL ER_WMSG ( 'GR', iret, ' ', ier )
proces = .false.
ELSE
CALL DG_AREA ( ix1, ix2, iy1, iy2, ier )
END IF
C
IF ( proces ) THEN
C
C* Process the parameters that do not change within the
C* time loop.
C
CALL IN_WIND ( wind, wintyp, winuni, icolor, ier )
C
C* Check for points to skip.
C
CALL IN_SKIP ( skip, iskpcn, iskplt, ier )
ixinc = iskplt (1)
iyinc = iskplt (2)
C
C* Check for stagger.
C
IF ( ixinc .ge. 0 ) THEN
ixstep = ixinc + 1
istag = 0
ELSE
ixstep = - ixinc + 1
istag = ixstep / 2
END IF
iystep = iyinc + 1
END IF
C
C* Compute the requested vector.
C
IF ( proces ) THEN
C
do i=1, nfunc
llen = 72
ibeg = llen * ( i - 1 ) + 1
iend = ibeg + llen - 1
igl = 2
igb = igl * ( i - 1 ) + 1
ige = igb + 1
gvect = ggvect(ibeg:iend)
pfunc = gvect
gtype = gridtype(ige:ige)
if ( gtype .eq. 's' ) then
CALL DG_GRID ( gdatim, glevel, gvcord,
+ gvect, pfunc, grid, kx, ky,
+ time, level, ivcord, parm, iret )
else if ( gtype .eq. 'v' ) then
CALL DG_VECT ( gdatim, glevel, gvcord,
+ gvect, pfunc, grid1, grid2, kx, ky,
+ time, level, ivcord, parmu, parmv,
+ iret )
endif
enddo
C
C* Check for error message.
C
IF ( iret .ne. 0 ) THEN
CALL ER_WMSG ( 'DG', iret, pfunc, ier )
novect = .true.
proces = .false.
ELSE
novect = .false.
C
C* Set the use flag to calculate the magnitude,
C* now that we know kx, ky.
C
npt = kx * ky
C
C
C* Calculate the wind speed and direction.
C
CALL PD_SPED ( grid1, grid2, npt,
+ sped, iret )
CALL PD_DRCT ( grid1, grid2, npt,
+ drct, iret )
CALL ST_LCUC ( gvect, gv, ier )
C
C* Convert sped to knots, if necessary.
C
iposk = INDEX ( gv, 'KNTV' )
IF ( winuni .eq. 'K' .and. iposk .eq. 0 )
+ CALL PD_MSKN ( sped, npt,
+ sped, iret )
END IF
END IF
C*
IF ( proces ) THEN
C
C* Scale the data.
C
IF ( first ) THEN
CALL IN_SCAL ( scale, iscale, iscalv, iret )
IF ( wintyp .ne. 'B' ) THEN
CALL GR_SSCL ( iscalv, kx, ky, ix1, iy1,
+ ix2, iy2, sped, dmin, dmax,
+ ier )
ELSE
C
C* Don't scale wind barbs
C
iscalv = 0
CALL GR_STAT ( sped, kx, ky, ix1, iy1,
+ ix2, iy2, dmin, dmax,
+ davg, ddev, ier )
END IF
ELSE IF ( iscalv .ne. 0 ) THEN
CALL GR_SSCL ( iscalv, kx, ky, ix1, iy1,
+ ix2, iy2, sped, dmin, dmax,
+ ier )
END IF
END IF
C
C* Draw wind symbols.
C
IF ( proces ) THEN
C
C* Draw winds.
C
IF ( ( icolor .ne. 0 ) .and.
+ ( .not. novect ) ) THEN
CALL GSCOLR ( icolor, ier )
npts = 0
ixstrt = ix1
DO j = iy1, iy2, iystep
iy = ( j - 1 ) * kx
C*
DO i = ixstrt, ix2, ixstep
ixy = iy + i
csd need ermiss include file
csd IF ( ( .not. ERMISS ( sped (ixy) ) ) .and.
csd + ( .not. ERMISS ( drct (ixy) ) ) )
THEN
npts = npts + 1
fi ( npts ) = FLOAT (i)
fj ( npts ) = FLOAT (j)
s ( npts ) = sped ( ixy )
d ( npts ) = drct ( ixy )
csd END IF
IF ( ( npts .ge. 100 ) .or.
+ ( ( i + ixstep .gt. ix2 ) .and.
+ ( j + iystep .gt. iy2 ) ) ) THEN
IF ( wintyp .eq. 'B' ) THEN
CALL GBARB ( 'G', npts, fi, fj,
+ s, d, ier )
ELSE
CALL GARRW ( 'G', npts, fi, fj,
+ s, d, ier )
END IF
npts = 0
END IF
END DO
IF ( ixstrt .eq. ix1 ) THEN
ixstrt = ixstrt + istag
ELSE
ixstrt = ix1
END IF
END DO
C
C* Plot reference arrow if arrows were requested.
C* Parse the parameter REFVEC and draw the arrow.
C
IF ( ( wintyp .eq. 'A' ) .and.
+ ( winuni .ne. 'N' ) ) THEN
IF ( winuni .eq. 'K' ) defstr = 'kts'
IF ( winuni .eq. 'M' ) defstr = 'm/s'
CALL GG_RVEC ( refvec, defstr, ier )
END IF
C
C* Write title.
C
CALL IN_TITL ( title, 0, ititl, linttl,
+ ttlstr, ier )
IF ( ititl .ne. 0 ) THEN
CALL GSCOLR ( ititl, ier )
CALL DSCOLR ( ititl, ioldclr, iret)
lens = LEN ( ttlstr )
ttlstr(lens:lens) = char(0)
call ptitle ( ttlstr, ititle )
END IF
END IF
C
C Not processing but at least plot a title.
C
ELSE
CALL IN_TITL ( title, 0, ititl, linttl,
+ ttlstr, ier )
IF ( ititl .gt. 0 ) THEN
CALL GSCOLR ( ititl, ier )
CALL DSCOLR ( ititl, ioldclr, iret)
call ptitle ( ttlstr, ititle )
END IF
END IF
END IF
C
C End the plot to flush everything out
C
CALL DG_FCLOS( iret )
C CALL GFLUSH ( iret )
C*
if ( verbose .gt. 0 ) call gfprinti (
+ 'returning from pvgrid - iret = ' // char(0), iret )
RETURN
END