[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: 20011105: Gdcross array sizes
This archive contains answers to questions sent to Unidata support through mid-2025. Note that the archive is no longer being updated. We provide the archive for reference; many of the answers presented here remain technically correct, even if somewhat outdated. For the most up-to-date information on the use of NSF Unidata software and data services, please consult the Software Documentation first.
- Subject: Re: 20011105: Gdcross array sizes
- Date: Mon, 5 Nov 2001 14:46:46 -0700
Daryl, I believe that this is the same problem as: http://www.unidata.ucar.edu/projects/coohl/mhonarc/MailArchives/gempak/msg01750.html I have attatched 2 routines for the $GEMPAK/source/programs/gd/gdcross directory with increased array sizes (I upped them to 360 for 1 degree global grids). Recompile with: cd $GEMPAK/source/programs/gd/gdcross make clean make all make install make clean I verified that I can plot the 30;-89>30;89 cross section using the 1.25x1.25 avn grid. Steve Chiswell Unidata User Support On Mon, 5 Nov 2001, Unidata Support wrote: > > >From: Daryl Herzmann <address@hidden> > >Organization: UCAR/Unidata > >Keywords: 200111051818.fA5IIj108835 > > >Hello again, > > Sorry about the confusion. The PC is a dual PIII 500. I am > >running a Linux XFS kernel built by SGI, since I use the XFS filesystem. > >They repackage RedHat kernels with patches to support XFS. Hopefully XFS > >will be in the mainline 2.5 kernel someday, anyway... > > > > Let me simplify the question a bit. Can you produce a plot of > >zonal wind averaged over the entire AVN thinned grid and have the YAXIS > >properly labeled? If you can produce this plot, can you tell me on what > >OS / version of GEMPAK you were able to do that? If gdcross can do it on > >your machine, then I will give you more info. > > > > I will compile 5.6.e.1 up on my Origin 2000 (IRIX 6.5.13) and see > >what it does this afternoon. My first IRIX test was on a little O2 box. > > > >Thanks, > > Daryl > > > >On Mon, 5 Nov 2001, Unidata Support wrote: > > > >> > >>Daryl, > >> > >>As you know, RH on an SGI isn't a configuration we have to test on. > >>Is the SGI a PC type (little endian) or is it a big endian architecture? > >>The Linux flags in the code are based on the word size and byte order of > >>PCs, > >>so if your configuration doesn't match this, then you will have trouble. > >> > >>I can investigate any problems you have under IRIX. > >>Can you describe the sequence leading to the core dump and provide > >>your parameter settings (last.nts and gemglb.nts) files? > >> > >>Steve Chiswell > >> > >> > >>>From: Daryl Herzmann <address@hidden> > >>>Organization: UCAR/Unidata > >>>Keywords: 200111030231.fA32VU112556 > >> > >>>Hello, > >>> I downloaded and compiled GEMPAK 5.6.e.1 tonight and tried my > >>>zonal wind plot of global thinned AVN data and continue to get the same > >>>results as reported > >>>http://www.unidata.ucar.edu/glimpse/gempak/4652 > >>>http://www.unidata.ucar.edu/glimpse/gempak/4647 > >>> > >>> I am running on RH Linux 7.1 (2.4.9-6SGI_XFS_PR4smp) > >>> > >>> I tried to replicate the behavior on a IRIX box, but I get bus > >>>errors with a core dump. The IRIX box is running 5.6.c.1 > >>> > >>>Idears? Thanks, > >>> Daryl > >>> > >>>-- > >>>/** > >>> * Daryl Herzmann (address@hidden) > >>> * Program Assistant -- Iowa Environmental Mesonet > >>> * http://mesonet.agron.iastate.edu > >>> */ > >>> > >>> > >> > >>**************************************************************************** > >>Unidata User Support UCAR Unidata Program > >>(303)497-8644 P.O. Box 3000 > >>address@hidden Boulder, CO 80307 > >>---------------------------------------------------------------------------- > >>Unidata WWW Service http://www.unidata.ucar.edu/ > >>**************************************************************************** > >> > > > >-- > >/** > > * Daryl Herzmann (address@hidden) > > * Program Assistant -- Iowa Environmental Mesonet > > * http://mesonet.agron.iastate.edu > > */ > > > >
PROGRAM GDCROSS
C************************************************************************
C* PROGRAM GDCROSS *
C* *
C* This program creates cross sections through scalar grids. *
C* *
C** *
C* Log: *
C* K. F. Brill/GSC 6/89 Created from GDPROF *
C* K. Brill/GSC 11/89 Added calls to DG_OFIL, DG_FLNO, DG_AREA *
C* K. Brill/GSC 1/90 Added CALL IN_TEXT *
C* K. Brill/GSC 5/90 Changes for IN_AXIS and IN_CINT *
C* S. Schotz/GSC 7/90 Update for IN_LINE *
C* S. Schotz/GSC 7/90 Added changes for IN_PTYP *
C* K. Brill/NMC 8/90 Added call to GDXSDL; remove -9 error *
C* K. Brill/NMC 8/90 DG_OFIL calling sequence change *
C* K. Brill/NMC 11/90 Chngd intrpltn rng for wnds in GDXGRD *
C* K. Brill/NMC 1/91 Remove GVCORD from CALL GDXGTS *
C* K. Brill/NMC 3/91 Use scalar field to make the label *
C* J. Whistler/SSAI 4/91 Changed GDXTTL to GR_TITL *
C* M. desJardins/NMC 10/91 Changed panel to *48 *
C* K. Brill/NMC 01/92 Changes for contour filling *
C* K. Brill/NMC 01/92 Replace GERROR with ER_WMSG *
C* S. Jacobs/EAI 11/92 Added call to GMESG and 'shrttl' *
C* K. Brill/NMC 4/93 Set origin for MSFC calculation *
C* L. Sager/NMC 7/93 Added REFVEC to GDXINP and GDXUPD *
C* S. Jacobs/EAI 9/93 Added CLRBAR, IN_CBAR and GG_CBAR *
C* S. Jacobs/EAI 9/93 Changed IN_CBAR and GG_CBAR to GG_CBAR *
C* S. Jacbos/EAI 9/93 Modified short title *
C* S. Jacobs/EAI 2/94 Added COLADD flag to DG_OFIL *
C* S. Jacobs/NMC 3/94 Removed interpolation of vector to *
C* background grid *
C* L. Williams/EAI 3/94 Clean up declarations of user input *
C* variables *
C* S. Jacobs/NMC 6/94 DEVICE*12 --> *72 *
C* L. Williams/EAI 7/94 Removed call to GDXUPD and added shrttl *
C* to the user input variables *
C* S. Jacobs/NMC 9/94 Moved the title plotting to the end *
C* D. Keiser/GSC 8/96 Added FL_MFIL to search for file type *
C* K. Tyle/GSC 8/96 Added ER_WMSG call after FL_MFIL call, *
C* use filnam in GDXDSP *
C* S. Maxwell/GSC 7/97 Increased input character length *
C* S. Jacobs/NCEP 10/97 Added the border color to GDXSDL for *
C* side labels for THTA *
C* M. Li/GSC 1/00 Added GCNTLN and nflag; removed GCSPLN *
C* R. Curtis 8/00 Added calls to GSTANM and GENANM *
C* S. Jacobs/NCEP 3/01 Replaced DG_OFIL with DG_MFIL *
C* T. Lee/GSC 6/01 Processed multiple files; Added time loop *
C************************************************************************
INCLUDE 'GEMPRM.PRM'
C*
LOGICAL clear
CHARACTER gdfile*(LLMXLN), border*(LLMXLN), ptype*(LLMXLN),
+ gdatim*(LLMXLN), gfunc*(LLMXLN), gvcord*(LLMXLN),
+ title*(LLMXLN), yaxis*(LLMXLN), device*(LLMXLN),
+ scale*(LLMXLN), panel*(LLMXLN), cxstns*(LLMXLN),
+ wind*(LLMXLN), cint*(LLMXLN), line*(LLMXLN),
+ text*(LLMXLN), contur*(LLMXLN), fint*(LLMXLN),
+ fline*(LLMXLN), ctype*(LLMXLN), gvect*(LLMXLN),
+ skip*(LLMXLN), refvec*(LLMXLN), clrbar*(LLMXLN),
+ shrttl*(LLMXLN)
C*
LOGICAL lscal, lvert, first
LOGICAL cflag, lflag, sflag, bflag, fflag, nflag
C*
REAL ugrd (LLMXGD), vgrd (LLMXGD), ponth (LLMXGD)
REAL xgrd (LLMXGD), qgrd (LLMXGD), rlvls (LLMXLV),
+ qlvls (LLMXLV), vlvls (LLMXLV), ylbl (LLAXIS),
+ rgx (360), rgy (360), rlat (360), rlon (360),
+ vclsfc (360)
CHARACTER time (2)*20, lastim*20, ttlstr*72, parm*12,
+ timev (2)*20, parmv*12, firstm*20, prmlbl*12,
+ fname*128, timfnd (LLMXGT)*36, trange*36
LOGICAL respnd, done, proces, havsfc, havscl, havvec
C*
REAL clvl (LLCLEV), flvl (LLCLEV), rmargn (4)
INTEGER icolor (LLCLEV), iline (LLCLEV), ilwid (LLCLEV),
+ labflg (LLCLEV), ifcolr (LLCLEV),
+ iflabl (LLCLEV), level(2)
C-----------------------------------------------------------------------
C* Initialize TAE and GEMPLT.
C
CALL IP_INIT ( respnd, iperr )
IF ( iperr .eq. 0 ) THEN
CALL GG_INIT ( 0, iperr )
END IF
IF ( iperr .eq. 0 ) THEN
done = .false.
ELSE
done = .true.
END IF
CALL IP_IDNT ( 'GDCROSS', ier )
C
C* Main loop to read in TAE parameters and draw profile.
C
DO WHILE ( .not. done )
C
C* Set flag to indicate processing will be done.
C
proces = .true.
C
C* Read in the variables from the TAE.
C
CALL GDXINP ( gdfile, gdatim, gvcord, cxstns, gfunc,
+ cint, scale, line, ptype, yaxis, border, gvect,
+ wind, refvec, skip, title, clear,
+ device, text, panel, contur, fint, fline,
+ ctype, clrbar, iperr )
C
C* Exit if there is an error.
C
IF ( iperr .ne. 0 ) THEN
done = .true.
ELSE
C
C* Set up the graphics device.
C
CALL GG_SDEV ( device, iret )
IF ( iret .ne. 0 ) proces = .false.
C
C* Set the attributes that do not vary within the time loop.
C
IF ( proces ) THEN
C
C* Set the text attributes, especially the size,
C* before setting the margins.
C
CALL IN_TEXT ( text, ier )
C
C* Get contouring type.
C
CALL IN_CONT ( contur, ier )
CALL IN_CTYP ( ctype, nflag, lflag, sflag, bflag,
+ fflag, ier )
IF ( lflag .or. sflag .or. bflag .or. nflag ) THEN
cflag = .true.
ELSE
cflag = .false.
END IF
C
C* Define the view region.
C
CALL GG_PANL ( panel, ier )
END IF
C
C* Get grid times.
C
IF ( proces ) THEN
CALL GR_FTIM ( gdfile, gdatim, timfnd, ntime, trange,
+ iret )
IF ( ( iret .ne. 0 ) .or. ( ntime .lt. 1 ) ) THEN
CALL ER_WMSG ( 'GR', iret, ' ', ier )
proces = .false.
END IF
END IF
C
IF ( ntime .gt. MXLOOP ) THEN
CALL ER_WMSG ( 'GR', 5, ' ', ier )
ntime = MXLOOP
END IF
C
C* Loop over times.
C
itime = 1
DO WHILE ( proces .and. ( itime .le. ntime ) )
first = ( itime .eq. 1 )
C
C* Open the grid file.
C
CALL DG_MFIL ( gdfile, ' ', .true., timfnd (itime),
+ igdfln, idum, fname, maxg, iret )
IF ( iret .ne. 0 ) THEN
proces = .false.
CALL ER_WMSG ( 'DG', iret, gdfile, ier )
END IF
C
C* Scan GFUNC for a file number.
C
IF ( proces .and. first ) THEN
CALL DG_FLNO ( gfunc, iflnos, ier1 )
CALL GD_NGRD ( iflnos, ngrd, firstm, lastim, ier2 )
IF ( ( ier1 .ne. 0 ) .or. ( ier2 .ne. 0 ) ) THEN
proces = .false.
CALL ER_WMSG ( 'DG', ier1, ' ', ier )
END IF
END IF
C
C* Get time and vertical coordinate to use.
C
IF ( proces ) THEN
CALL GDXDTV ( timfnd (itime), gvcord, gfunc,
+ firstm, lastim, time, ivcord, iret )
IF ( iret .ne. 0 ) THEN
CALL ER_WMSG ( 'GDCROSS', iret, ' ', ier )
proces = .false.
END IF
END IF
C*
IF ( proces .and. first ) THEN
CALL DG_FLNO ( gvect, iflnov, ier1 )
CALL GD_NGRD ( iflnov, ngrd, firstm, lastim, ier2 )
IF ( ( ier1 .ne. 0 ) .or. ( ier2 .ne. 0 ) ) THEN
proces = .false.
CALL ER_WMSG ( 'DG', ier1, ' ', ier )
END IF
END IF
C
IF ( proces ) THEN
CALL GDXDTV ( timfnd (itime), gvcord, gvect,
+ firstm, lastim, timev, jvcord, iret )
IF ( iret .ne. 0 ) THEN
CALL ER_WMSG ( 'GDCROSS', iret, ' ', ier )
proces = .false.
END IF
END IF
C
C* Get information about y axis.
C
IF ( proces .and. first ) THEN
CALL GDXYAX ( ptype, yaxis, ivcord, iyaxis, ratio,
+ ystrt, ystop, ylbl, nylbl, rmargn,
+ ilbfrq, iglfrq, itmfrq, iret )
IF ( iret .ne. 0 ) THEN
CALL ER_WMSG ( 'GDCROSS', iret, ' ', ier )
proces = .false.
END IF
END IF
C
C* Find plotting location.
C
IF ( proces .and. first ) THEN
CALL GR_PLIN ( cxstns, nhxs, rgx, rgy, rlat, rlon,
+ iret )
IF ( iret .ne. 0 ) THEN
CALL ER_WMSG ( 'GR', iret, cxstns, ier )
CALL ER_WMSG ( 'GDCROSS', -4, ' ', ier )
proces = .false.
END IF
END IF
C
C* Set the origin of the cross section for MSFC calculation.
C
IF ( first ) CALL DG_ORGN ( rlat (1), rlon (1), ier )
C
C* Check that there are some points.
C
IF ( nhxs .le. 0 ) THEN
proces = .false.
END IF
C
C* Set the subset region.
C
IF ( proces ) THEN
igxmin = INT ( MIN ( rgx ( 1 ), rgx ( nhxs ) ) )
igxmax = INT ( MAX ( rgx ( 1 ), rgx ( nhxs ) ) ) + 1
igymin = INT ( MIN ( rgy ( 1 ), rgy ( nhxs ) ) )
igymax = INT ( MAX ( rgy ( 1 ), rgy ( nhxs ) ) ) + 1
CALL DG_AREA ( igxmin, igxmax, igymin, igymax, iret)
C
C* Determine the length of the cross section.
C
CALL GDXLEN ( nhxs, rlat, rlon, rlngth, iier )
C
C* Get the surface data.
C
CALL GDXGTS ( iflnos, time, ivcord, rgx, rgy, nhxs,
+ vclsfc, havsfc, parm, ier )
C
C* Get scalar data to plot.
C
CALL GDXDTA ( iflnos, timfnd (itime), gvcord, ystrt,
+ ystop, gfunc, time, ivcord,
+ rgx, rgy, nhxs, rlvls, xgrd,
+ nvxs, prmlbl, ybeg, yend, iret )
C
C* If all is well, create a regularly spaced grid.
C
IF ( iret .eq. 0 ) THEN
havscl = .true.
CALL GDXGRD ( xgrd, nhxs, nvxs, ivcord, iyaxis,
+ rlvls, ystrt, ystop, .false.,
+ qgrd, qlvls, nvo, iret )
IF ( iret .ne. 0 ) THEN
iret = - 10
CALL ER_WMSG ( 'GDCROSS', iret, ' ', ier )
ELSE
C
C* Set underground values to missing.
C
IF ( havsfc ) THEN
CALL GDXSFM ( ivcord, qgrd, qlvls,
+ nhxs, nvo, vclsfc, iret )
END IF
END IF
ELSE
havscl = .false.
IF ( iret .lt. 0 ) proces = .false.
END IF
END IF
C
C* Get the vector components defined by GVECT.
C
IF ( proces ) THEN
CALL GDXDVV ( iflnov, timfnd (itime), gvcord, ystrt,
+ ystop, gvect, timev, ivcord, rgx, rgy,
+ nhxs, rlvls, ugrd, vgrd, ponth, nvv,
+ parm, parmv, lvert, lscal, iret )
IF ( iret .eq. 0 ) THEN
havvec = .true.
IF ( .not. havscl ) prmlbl = parm
C
DO ik = 1, nvv
vlvls (ik) = rlvls (ik)
END DO
C
IF ( havsfc ) THEN
CALL GDXSFM ( ivcord, ugrd, vlvls, nhxs,
+ nvv, vclsfc, iret )
CALL GDXSFM ( ivcord, vgrd, vlvls, nhxs,
+ nvv, vclsfc, iret )
END IF
ELSE
havvec = .false.
IF ( iret .lt. 0 ) proces = .false.
END IF
END IF
C
C* Define contour levels and characteristics.
C* Write warning if there are no contour levels.
C
nlvl = 0
IF ( proces .and. havscl ) THEN
CALL GDXLEV ( cflag, line, cint, fflag, fline, fint,
+ scale, nhxs, nvo, 1, 1, nhxs, nvo,
+ qgrd, nlvl, clvl, icolor, iline,
+ ilwid, labflg, nflvl, flvl, ifcolr,
+ iflabl, iscale, dmin, dmax, iret )
IF ( ( nlvl .eq. 0 .and. nflvl .eq. 0 ) .or.
+ ( iret .ne. 0 ) ) THEN
CALL ER_WMSG ( 'GDCROSS',1,' ',ier)
END IF
C
IF ( nlvl .eq. 0 ) cflag = .false.
IF ( nflvl .eq. 0 ) fflag = .false.
END IF
C
C* Set the current pixmap.
C
IF ( first ) THEN
CALL GSTANM ( iret )
ELSE
first = .false.
CALL GSPLOT ( iret )
END IF
C
C* Give user a chance to exit.
C
IF ( proces ) THEN
CALL GDXDSP ( gdfile, gfunc, cxstns, nhxs, iscale,
+ timfnd (itime), gvcord, nlvl, clvl,
+ dmin, dmax, icolor, iline, ilwid,
+ labflg, nflvl, flvl, ifcolr, iflabl,
+ device, panel, gvect, skip, wind,
+ first , iret )
IF ( iret .ne. 0 ) proces = .false.
END IF
C
C* Draw the cross section.
C
IF ( proces ) THEN
C
C* Set plotting mode to graph mode.
C
CALL GQMODE ( mode, ier )
CALL GSMODE ( 2, ier )
C
C* Clear screen if requested.
C
IF ( clear ) CALL GCLEAR ( ier )
C
C* Set up the graph.
C
xstrt = 1.00
xstop = FLOAT ( nhxs )
CALL GDXSUG ( iyaxis, ystrt, ystop, xstrt, xstop,
+ ratio, rmargn, iret )
C
C* Draw the contours.
C
IF ( havscl ) THEN
CALL GSGGRF ( 1, iyaxis, nhxs, nvo, xstrt,
+ ystrt, xstop, ystop, iret )
C
C* Do side labels for THTA.
C
parmv = ' '
parmv = gfunc (1:4)
CALL ST_LCUC ( parmv, parmv, ier )
IF ( parmv (1:4) .eq. 'THTA' .and.
+ ( iret .eq. 0 ) ) THEN
IF ( cflag ) THEN
CALL GDXSDL ( border, nhxs, nvo, qgrd,
+ nlvl, clvl, labflg, iret )
END IF
IF ( fflag ) THEN
CALL GDXSDL ( border, nhxs, nvo, qgrd,
+ nflvl, flvl, iflabl, iret)
END IF
END IF
C
IF ( iret .eq. 0 ) THEN
IF ( fflag ) THEN
CALL GCFILL ( nhxs, nvo, qgrd, 0, 0, 0,
+ nflvl, flvl, ifcolr,
+ iflabl, iret )
IF ( iret .ne. 0 ) THEN
CALL ER_WMSG('GEMPLT', iret, ' ', ier)
END IF
END IF
C
IF ( cflag ) THEN
IF ( lflag ) THEN
CALL GCLGRN ( nhxs, nvo, qgrd, 0, 0,
+ 0, nlvl, clvl, icolor,
+ iline, ilwid, labflg,
+ iret )
IF ( iret .ne. 0 )
+ CALL ER_WMSG ( 'GEMPLT', iret,
+ ' ', ier )
C
IF ( nflag ) THEN
CALL GCNTLN ( nhxs, nvo, qgrd,
+ 0, 0, 0, nlvl,
+ clvl, icolor,
+ iline, ilwid,
+ labflg, iret )
IF ( iret .ne. 0 ) CALL ER_WMSG
+ ( 'GEMPLT', iret, ' ', ier )
END IF
END IF
C
IF ( bflag ) THEN
CALL GCBOXX ( nhxs, nvo, qgrd, 0, 0,
+ 0, nlvl, clvl, icolor,
+ iline, ilwid, labflg,
+ iret )
IF ( iret .ne. 0 ) CALL ER_WMSG
+ ('GEMPLT',iret,' ',ier)
END IF
END IF
ELSE
iret = -11
CALL ER_WMSG ( 'GDCROSS', iret, ' ', ier )
END IF
END IF
C
IF ( havvec ) THEN
IF ( lscal ) THEN
C
C* Scale the vertical component.
C
asprat=0.0
CALL GDXSCV ( vgrd, ponth, vlvls, nhxs, nvv,
+ rlngth, ivcord, iyaxis, ystrt,
+ ystop, asprat, vgrd, iiir )
IF ( iiir .ne. 0 ) THEN
CALL ER_WMSG
+ ( 'GDCROSS', iiir, ' ', ier )
END IF
END IF
C
C* Load the locations of the wind points into
C* arrays xgrd and qgrd.
C
indx = 1
DO k = 1, nvv
DO i = 1, nhxs
xgrd ( indx ) = FLOAT ( i )
qgrd ( indx ) = vlvls ( k )
indx = indx + 1
END DO
END DO
C
C* Plot the vector field.
C
CALL GDXPUW ( gvect, ugrd, vgrd, xgrd, qgrd,
+ nhxs, nvv, wind, skip, refvec,
+ ier )
END IF
C
C* Plot background axes with labels.
C
CALL GDXPLT ( border, ystrt, ystop, vclsfc, havsfc,
+ ylbl, nylbl, xstrt, xstop, cxstns,
+ nhxs, ilbfrq, iglfrq, itmfrq, iret )
C
C* Plot the color bar.
C
IF ( fflag ) CALL GG_CBAR ( clrbar, nflvl, flvl,
+ ifcolr, ier )
C
C* Write title.
C
CALL IN_TITL (title, 0, ititl, linttl, ttlstr, ier)
level(1) = -1
level(2) = -1
CALL GR_TITL ( ttlstr, time, .false., level, ivcord,
+ prmlbl, iscale, ' ', ttlstr, shrttl,
+ iret )
IF ( clear ) CALL GMESG ( shrttl, ier )
IF ( ititl .ne. 0 ) THEN
CALL GSCOLR ( ititl, ier )
CALL GG_WSTR ( ttlstr, linttl, ier )
END IF
C
C* Reset the plotting mode and flush buffers.
C
CALL GSMODE ( mode, ier )
CALL GEPLOT ( ier )
END IF
itime = itime + 1
CALL DG_CLAL ( iret )
END DO
C
CALL GENANM ( iret )
C
C* Prompt for next cross section to be done.
C
CALL IP_DYNM ( done, ier )
END IF
END DO
C
C* Print general error messages if necessary.
C
IF ( iperr .ne. 0 ) CALL ER_WMSG ( 'GDCROSS', iperr, ' ', ier )
C
C* Exit from GEMPLT and the interface.
C
CALL GENDP ( 0, iret )
CALL IP_EXIT ( iret )
C*
END
SUBROUTINE GDXPLT ( border, ystrt, ystop, vclsfc, havsfc,
+ ylbl, ny, xstrt, xstop, xlbl, nx, ilbfrq,
+ iglfrq, itmfrq, iret )
C************************************************************************
C* GDXPLT *
C* *
C* This subroutine draws the background for a cross section. *
C* *
C* GDXPLT ( BORDER, YSTRT, YSTOP, VCLSFC, HAVSFC, YLBL, NY, XSTRT, *
C* XSTOP, XLBL, NX, ILBFRQ, IGLFRQ, ITMFRQ, IRET ) *
C* *
C* Input parameters: *
C* BORDER CHAR* Background *
C* YSTRT REAL Bottom y value *
C* YSTOP REAL Top y value *
C* VCLSFC (NX) REAL Vert coord location of sfc *
C* HAVSFC LOGICAL Flag for existence of sfc *
C* YLBL (NY) REAL Y axis label values *
C* NY INTEGER Number of y labels *
C* XSTRT REAL Left x value *
C* XSTOP REAL Right x value *
C* XLBL CHAR* Xsect endpts from user input *
C* NX INTEGER Number of x grd pts/tick marks *
C* ILBFRQ INTEGER Label frequency *
C* IGLFRQ INTEGER Grid line frequency *
C* ITMFRQ INTEGER Tick mark frequency *
C* *
C* Output parameters: *
C* IRET INTEGER Return code *
C* 0 = normal return *
C* -7 = invalid vert coord type *
C** *
C* Log: *
C* K. F. Brill/GSC 6/98 Created from GDPPLT *
C* K. Brill/GSC 2/90 Activated line width in BORDER *
C* S. Schotz/GSC 7/90 Pass in margin values instead of string *
C* K. Brill/NMC 10/90 Pass zero down for hw flag in GSLINE *
C* S. Schotz/GSC 10/90 Set ndec to -1 for gdaxis *
C* S. Schotz/GSC 10/90 Call IN_LINE for border *
C* K. Brill/NMC 01/92 Remove margin and graph setup *
C* S. Jacobs/NMC 6/94 Offset the end point labels *
C* S. Jacobs/NCEP 1/99 Changed call to IN_LINE *
C* S. Jacobs/NCEP 5/99 Changed call to IN_LINE *
C************************************************************************
CHARACTER*(*) border, xlbl
CHARACTER gpoint(2)*24, cdef(2)*12
REAL vclsfc (*), ylbl (*), xtics ( 125 ),
+ xsub(2), ysub(2)
C*
LOGICAL havsfc
C------------------------------------------------------------------------
iret = 0
cdef(1) = ' '
cdef(2) = ' '
values = 0.
C
C* Draw background.
C
CALL IN_LINE ( border, values, 1, ibcolr, ibtyp, ibwid, iblab,
+ smth, fltr, ier )
C
C* RETURN here if there is to be no border.
C
IF ( ier .ne. 0 .or. ibcolr .eq. 0 ) RETURN
C
C* Generate x axis tic mark locations.
C
xtics(1) = xstrt
ntics = nx
IF ( ntics .gt. 125 ) ntics = 125
dtic = ( xstop - xstrt ) / FLOAT ( ntics - 1 )
DO i = 2, ntics
xtics ( i ) = xtics ( i - 1 ) + dtic
END DO
C
C* Draw the border.
C
CALL GSCOLR ( ibcolr, ier )
CALL GQLINE ( ilntyp, ilntsw, ilnwid, ilnwsw, ier )
CALL GSLINE ( ibtyp, 0, ibwid, 0, ier )
CALL GDAXIS ( 1, ystrt, .true., 000, 101, 000, 0, ntics,
+ xtics, ier )
CALL GDAXIS ( 3, ystop, .true., 000, 000, 000, 0, 0,
+ xtics, ier )
CALL GDAXIS ( 2, xstrt, .true., ilbfrq, itmfrq, iglfrq,
+ -1, ny, ylbl, ier )
CALL GDAXIS ( 4, xstop, .true., 000, 000, 000, 0, 0,
+ ylbl, ier )
C
C* If surface exists and number of points is 360 or less, plot it.
C
IF ( havsfc .and. ( nx .le. 360 ) ) THEN
C
C* Reset surface values to zero if they are below plot.
C
CALL GQBND ( 'M', xl, yb, xr, yt, ier )
diftst = ABS ( yb - yt )
DO i = 1, nx
test = ABS ( vclsfc (i) - yt )
IF ( test .gt. diftst ) vclsfc (i) = yb
END DO
C*
CALL GLINE ( 'M', nx, xtics, vclsfc, ier )
C
C* Draw regularly spaced vertical lines to fill underground
C* region of cross section plane.
C
nvln = 7
xxx = xstrt
frctn = 1. / FLOAT ( nvln )
DO i = 2, nx
difr = vclsfc (i) - vclsfc (i-1)
difr = frctn * difr
yyy = vclsfc (i-1)
DO j = 1, nvln
xxx = xxx + frctn
xsub (1) = xxx
xsub (2) = xxx
yyy = yyy + difr
ysub (1) = ystrt
ysub (2) = yyy
CALL GLINE ( 'M', 2, xsub, ysub, ier )
END DO
END DO
END IF
C
C* Restore original line settings.
C
CALL GSLINE ( ilntyp, 0, ilnwid, 0, ier )
C
C* Label the end points along the x axis.
C
C* Split the input string into the expected substrings seperated by
C* a > .
C
CALL ST_LCUC ( xlbl, xlbl, ier )
CALL ST_CLST ( xlbl, '>', cdef, 2, gpoint, nums, iret )
iret = iret + ier
IF ( iret .ne. 0 .or. nums .ne. 2 ) THEN
iret = -11
RETURN
END IF
C
C* Offset the end points from the edges of the plot, so that
C* the labels are plotted correctly.
C
xoffset = ( xtics(2) - xtics(1) ) / 4.
xtics(1) = xtics(1) + xoffset
xtics(2) = xtics(ntics) - xoffset
C
CALL GAAXIS ( 1, ystrt, .false., 101, 000, 000, 2,
+ xtics, gpoint, ier )
C*
RETURN
END
- References:
- 20011105: 20011102: 20010918: 20010917: YAXIS label on gdcross
- From: Unidata Support
- 20011105: 20011102: 20010918: 20010917: YAXIS label on gdcross
- Prev by Date: 20011105: 20011102: 20010918: 20010917: YAXIS label on gdcross
- Next by Date: Re: 20011105: Gdcross array sizes
- Previous by thread: 20011105: 20011102: 20010918: 20010917: YAXIS label on gdcross
- Next by thread: Re: 20011105: Gdcross array sizes
- Index(es):