[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: 20011105: Gdcross array sizes



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