531 lines
17 KiB
Fortran
531 lines
17 KiB
Fortran
SUBROUTINE SNCROSS (snfile, dattim, yaxis, cxstns )
|
|
C************************************************************************
|
|
C* PROGRAM SNCROSS *
|
|
C* *
|
|
C* This program draws cross sections using upper air data. *
|
|
C** *
|
|
C* Log: *
|
|
C* M. desJardins/GSFC 12/85 *
|
|
C* I. Graffman/RDS 5/86 Added observed wind drawing *
|
|
C* I. Graffman/RDS 5/88 GG call, DEVICE, GFLUSH to GEPLOT *
|
|
C* G. Huffman/GSC 11/88 GEMPAK4.1; modify parameter names *
|
|
C* M. desJardins/GSFC 8/89 Add IP_IDNT *
|
|
C* M. desJardins/GSFC 1/90 Change thtinc to thtint in SNSGTH *
|
|
C* S. Schotz/GSC 6/90 Updates and cleanup for GEMPAK5 *
|
|
C* S. Schotz/GSC 7/90 Added changes for IN_PTYP, IN_AXIS *
|
|
C* S. Schotz/GSC 8/90 Plot winds only at wind data levels *
|
|
C* M. desJardins/GSFC 8/90 Changed array size; plot any parameter *
|
|
C* J. Nielsen/SUNYA 2/91 Read data for new set of stations *
|
|
C* J. Whistler/SSAI 2/91 Added subroutine SNSWWE *
|
|
C* M. desJardins/GSFC 3/91 Reorganized x axis for time section *
|
|
C* M. desJardins/NMC 4/91 Change time section title *
|
|
C* J. Nielsen/TAMU 11/91 Added filter factor *
|
|
C* K. Brill/NMC 11/91 Changed PANEL*24 to *48 *
|
|
C* K. Brill/NMC 12/91 Call SNSWWE only if PROCES is true *
|
|
C* K. Brill/NMC 01/92 Changes for contour fill *
|
|
C* K. Brill/NMC 01/92 Replace GERROR with ER_WMSG *
|
|
C* K. Brill/NMC 02/92 Check for new vertical coord; add parm *
|
|
C* conditions *
|
|
C* S. Jacobs/EAI 11/92 Added call to GMESG and 'shrttl' *
|
|
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. Jacobs/NMC 4/94 Removed unused variables *
|
|
C* S. Jacobs/NMC 6/94 DEVICE*12 --> *72 *
|
|
C* L. Williams/EAI 7/94 Removed call to SNSUPD 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* M. Linda/GSC 2/97 Removed GFLUSH *
|
|
C* S. Maxwell/GSC 7/97 Increased input character length *
|
|
C* K. Brill/EMC 4/99 Set MAXD grid dimension in PARAMETER *
|
|
C* M. Li/GSC 1/00 Added GCNTLN and nflag; removed GCSPLN *
|
|
C* T. Lee/GSC 7/00 Moved MAXD to GEMPRM.PRM & named LLMAXD *
|
|
C* T. Lee/GSC 8/00 Added calls to GSTANM and GENANM *
|
|
C* T. Lee/SAIC 10/01 Added contour fill types *
|
|
C* T. Piper/SAIC 4/02 Fixed UMR; initialized icvtyp & isnfln *
|
|
C* L. Hinson/AWC 3/03 Defined/init iend and ierr *
|
|
C* L. Hinson/AWC 4/03 Numerous Declarations/Initializations *
|
|
C* Added. Logic/Miscoding Fix in call to *
|
|
C* SNSWND, with undefined nlvl. Passed *
|
|
C* defined nvlvl set up by SNSVNT instead *
|
|
C************************************************************************
|
|
INCLUDE 'GEMPRM.PRM'
|
|
C*
|
|
CHARACTER snfile*(*), dattim*(*), yaxis*(*), cxstns*(*)
|
|
CHARACTER device*(LLMXLN),
|
|
+ border*(LLMXLN), cint*(LLMXLN), line*(LLMXLN),
|
|
+ ptype*(LLMXLN), title*(LLMXLN), wind*(LLMXLN),
|
|
+ taxis*(LLMXLN), filter*(LLMXLN), shrttl*(LLMXLN),
|
|
+ panel*(LLMXLN), text*(LLMXLN), snparm*(LLMXLN),
|
|
+ vcoord*(LLMXLN),
|
|
+ curve*(LLMXLN), contur*(LLMXLN),
|
|
+ fint*(LLMXLN), fline*(LLMXLN), ctype*(LLMXLN),
|
|
+ clrbar*(LLMXLN), filnam*(LLMXLN),
|
|
+ vline*(LLMXLN), vint*(LLMXLN)
|
|
C*
|
|
LOGICAL clear
|
|
C
|
|
C* The "old" values keep track of the current values. NEWSTN
|
|
C* is set when station data must be read in. NEWPRM is set when
|
|
C* a new parameter is selected. NEWTHA is read when new theta
|
|
C* data for an isentropic display must be read.
|
|
C
|
|
CHARACTER cxsold*72, snfold*72, datold*48, prmold*4,
|
|
+ taxold*48, prmhld*16
|
|
LOGICAL newstn, newprm, newtha, newvco
|
|
C*
|
|
CHARACTER times (LLMXTM)*20, stns (LLTMCX)*20, parm*4
|
|
CHARACTER wintyp*1, winuni*1, vcord*4
|
|
CHARACTER ctlbl (LLMXTM)*12, ttlstr*72
|
|
PARAMETER ( MSDSIZ = 100000 )
|
|
REAL stndat ( MSDSIZ ), xtlbl (LLMXTM)
|
|
REAL sloc (LLTMCX), xx (LLMAXD), yy (LLMAXD),
|
|
+ pontha (LLMAXD,200), clvl (LLCLEV),
|
|
+ flvl (LLCLEV), pdat (LLTMCX,200),
|
|
+ rmargn (4), grid (LLMAXD,LLMAXD),
|
|
+ toptmp (LLTMCX), topwnd (LLTMCX),
|
|
+ yaxval (LLAXIS),vlvl(LLCLEV)
|
|
INTEGER iltype (LLCLEV), linwid (LLCLEV),
|
|
+ ilabel (LLCLEV), icolor (LLCLEV),
|
|
+ ifcolr (LLCLEV), iflabl (LLCLEV),
|
|
+ ifltyp (LLCLEV), ipsdat (LLTMCX),
|
|
+ nlvls (LLTMCX), idtype (LLMXLV,LLTMCX),
|
|
+ ivcolr(LLCLEV)
|
|
LOGICAL proces, respnd, done, isnflg, timflg,prmexs,
|
|
+ wndexs, cflag, lflag, sflag, bflag, fflag, nflag,
|
|
+ vflag
|
|
INTEGER iend, ier, iret, ivcord
|
|
INTEGER nstn, nyval, iylbfr, iyglfr, iytmfr, nxlbl,
|
|
+ ixlbfr, ixglfr, ixtmfr, nvlvl, iwnclr, kgxy,
|
|
+ iytype, nclvl,nflvl, ithinc, icttl, linttl
|
|
REAL ybot, ytop, xmin, xmax
|
|
C*
|
|
DATA snfold, cxsold, prmold, datold, taxold
|
|
+ / 5 * ' ' /
|
|
DATA newstn, newprm, newvco / 3 * .true. /
|
|
DATA icvtyp / 0 /, isnfln / 0 /, ivcold / -9999 /
|
|
C------------------------------------------------------------------------
|
|
C* Initialize TAE and GEMPLT
|
|
C
|
|
vflag=.false.
|
|
nflag=.false.
|
|
lflag=.false.
|
|
sflag=.false.
|
|
bflag=.false.
|
|
cflag=.false.
|
|
kgxy = 0
|
|
nvlvl = 0
|
|
nclvl = 0
|
|
nflvl = 0
|
|
nstn = 0
|
|
iend = 0
|
|
ier = 0
|
|
iret = 0
|
|
icttl = 0
|
|
linttl = 0
|
|
fflag = .false.
|
|
isnflg = .false.
|
|
newtha = .false.
|
|
timflg = .false.
|
|
ybot = 0.0
|
|
ytop = 0.0
|
|
xmin = 0.0
|
|
xmax = 0.0
|
|
nyval = 0
|
|
iylbfr = 0
|
|
iyglfr = 0
|
|
iytmfr = 0
|
|
nxlbl = 0
|
|
ixlbfr = 0
|
|
ixglfr = 0
|
|
ixtmfr = 0
|
|
iwnclr = 0
|
|
|
|
snfold = ' '
|
|
cxsold = ' '
|
|
prmold = ' '
|
|
datold = ' '
|
|
taxold = ' '
|
|
newstn = .true.
|
|
newprm = .true.
|
|
newvco = .true.
|
|
ivcold = -9999
|
|
CALL IN_BDTA ( ier )
|
|
CALL GSMODE ( 2, ier )
|
|
snparm = ' '
|
|
vcoord = 'hght'
|
|
ptype = 'lin//12;5;6;3'
|
|
taxis = 'r--1;2;1;1'
|
|
line = '0'
|
|
border = '1;1;8'
|
|
cint = '2'
|
|
wind = 'bk1/1/2/112'
|
|
title = '1/-3'
|
|
panel = '0'
|
|
clear = .true.
|
|
filter = 'yes'
|
|
text = '1/22//hw'
|
|
curve = '2'
|
|
clrbar = '0!1/v/lr/.99;.1//-1'
|
|
fint = '0;2;4;6;8;10'
|
|
contur = '0'
|
|
fline = '0'
|
|
vint = '20/0/180'
|
|
vline = '0;31;11;2;17;20;23;21;24;27;29'
|
|
ctype = 'l'
|
|
proces = .true.
|
|
prmexs = .true.
|
|
wndexs = .true.
|
|
|
|
|
|
C
|
|
C* Set up the graphics device.
|
|
C
|
|
C CALL GG_SDEV ( device, iret )
|
|
C IF ( iret .ne. 0 ) proces = .false.
|
|
C
|
|
C* Set text attributes
|
|
C
|
|
CALL IN_TEXT ( text, iret )
|
|
C
|
|
C* Open the sounding file.
|
|
C
|
|
CALL FL_MFIL ( snfile, ' ', filnam, ier )
|
|
IF ( iret .ne. 0 ) CALL ER_WMSG ( 'FL', iret, ' ', ier )
|
|
CALL SNSFIL ( filnam, snfold, isnfln, newstn, nparms,
|
|
+ iret )
|
|
IF ( iret .ne. 0 ) THEN
|
|
proces = .false.
|
|
ELSE
|
|
CALL SNSDAT ( isnfln, dattim, datold, newstn,
|
|
+ times, ntime, iret )
|
|
IF ( iret .ne. 0 ) THEN
|
|
proces = .false.
|
|
ELSE IF ( ntime .eq. 1 ) THEN
|
|
timflg = .false.
|
|
ELSE IF ( ntime .ge. 4 ) THEN
|
|
timflg = .true.
|
|
IF ( ntime .gt. LLTMCX ) THEN
|
|
ntime = LLTMCX
|
|
END IF
|
|
ELSE
|
|
iret = -6
|
|
CALL ER_WMSG ( 'SNCROSS', iret, dattim, ier )
|
|
proces = .false.
|
|
datold = ' '
|
|
END IF
|
|
END IF
|
|
C
|
|
C* Check to see if the station(s) have changed.
|
|
C
|
|
IF (proces) THEN
|
|
CALL ST_LCUC ( cxstns, cxstns, ier )
|
|
IF ( cxsold .ne. cxstns ) THEN
|
|
newstn = .true.
|
|
cxsold = ' '
|
|
END IF
|
|
C
|
|
C* Get wind information.
|
|
C
|
|
CALL IN_WIND ( wind, wintyp, winuni, iwnclr, ier )
|
|
C
|
|
C* Get the parameter to evaluate.
|
|
C
|
|
CALL ST_CLST ( snparm, ';', ' ', 1, prmhld, n, ier )
|
|
parm = prmhld (1:4)
|
|
isnflg=.false.
|
|
CALL ST_LCUC ( parm, parm, ier )
|
|
IF ( ( parm .eq. ' ' ) .and. ( iwnclr .eq. 0 ) ) THEN
|
|
iret = -13
|
|
CALL ER_WMSG ( 'SNCROSS', iret, snparm, ier )
|
|
proces = .false.
|
|
newprm = .true.
|
|
ELSE IF ( parm .ne. prmold ) THEN
|
|
newprm = .true.
|
|
IF ( parm .eq. 'ISEN' ) THEN
|
|
isnflg = .true.
|
|
ELSE
|
|
isnflg = .false.
|
|
END IF
|
|
END IF
|
|
C
|
|
C* Check to see if the time axis has changed for a time
|
|
C* series.
|
|
C
|
|
IF ( taxis .ne. taxold ) newstn = .true.
|
|
taxold = taxis
|
|
C
|
|
C* Get the data for the selected stations or times.
|
|
C
|
|
iret = 0
|
|
END IF
|
|
IF ( proces .and. ( .not. timflg ) .and. newstn )
|
|
+ THEN
|
|
CALL SNSSST ( cxstns, isnfln, nparms, MSDSIZ,
|
|
+ nstn, stns, ipsdat, nlvls, stndat,
|
|
+ idtype, sloc, xmin, xmax, iret )
|
|
IF ( iret .ne. 0 ) proces = .false.
|
|
ELSE IF ( proces .and. timflg .and. newstn ) THEN
|
|
CALL SNSSTM ( cxstns, isnfln, nparms, MSDSIZ, times,
|
|
+ ntime, taxis, nstn, ipsdat, nlvls,
|
|
+ stndat, idtype, sloc, xmin, xmax,
|
|
+ xtlbl, ctlbl, nxlbl, ixlbfr, ixglfr,
|
|
+ ixtmfr, iret )
|
|
IF ( iret .ne. 0 ) proces = .false.
|
|
END IF
|
|
CALL SN_CLOS( isnfln, ier)
|
|
C
|
|
C* Check for at least four stations.
|
|
C
|
|
IF ( proces .and. ( nstn .ge. 4 ) ) THEN
|
|
cxsold = cxstns
|
|
prmold = parm
|
|
ELSE
|
|
cxsold = ' '
|
|
prmold = ' '
|
|
proces = .false.
|
|
END IF
|
|
C
|
|
C* Get information about the y axes. Find the y points
|
|
C* on a LLMAXD by LLMAXD grid.
|
|
C
|
|
IF ( proces ) THEN
|
|
CALL SNSYAX ( ptype, vcoord, yaxis, iytype, ratio,
|
|
+ rmargn, ybot, ytop, ivcord, vcord,
|
|
+ yaxval, nyval, iylbfr, iyglfr,
|
|
+ iytmfr, iret )
|
|
IF ( iret .ne. 0 ) THEN
|
|
proces = .false.
|
|
ELSE IF ( isnflg .and. ( ivcord .ne. 1 ) ) THEN
|
|
iret = -4
|
|
CALL ER_WMSG ( 'SNCROSS', iret, ' ', ier )
|
|
proces = .false.
|
|
ELSE
|
|
IF ( ivcold .eq. ivcord ) newvco = .false.
|
|
ivcold = ivcord
|
|
CALL SNSGRD ( iytype, xmin, xmax, ybot, ytop,
|
|
+ ratio, rmargn, yy, xx, iret )
|
|
IF ( iret .ne. 0 ) proces = .false.
|
|
END IF
|
|
END IF
|
|
C
|
|
C* Get the minimum pressure for temperature and winds.
|
|
C
|
|
IF ( proces ) THEN
|
|
CALL SNSRGE ( vcord, nstn, stndat, nlvls, ipsdat,
|
|
+ toptmp, topwnd, iret )
|
|
C
|
|
C* Get interval and curve type.
|
|
C
|
|
CALL SNSGTH ( cint, curve, ithinc, icvtyp, newtha,
|
|
+ iret )
|
|
END IF
|
|
C
|
|
C* Get either grid or isentropic data.
|
|
C
|
|
IF ( proces ) THEN
|
|
IF ( isnflg .and.
|
|
+ ( newprm .or. newtha .or. newstn ) ) THEN
|
|
CALL SNSTHA ( ithinc, icvtyp, nstn, stns,
|
|
+ ipsdat, nlvls, stndat, sloc,
|
|
+ xx, thmin, thmax, pontha,
|
|
+ pdat, iret )
|
|
IF ( iret .eq. 0 ) THEN
|
|
newprm = .false.
|
|
ELSE
|
|
prmexs = .false.
|
|
END IF
|
|
ELSE IF ( ( .not. isnflg ) .and.
|
|
+ ( newprm .or. newstn .or. newvco ) ) THEN
|
|
CALL SNSPRM ( snparm, nstn, stns, ipsdat, nlvls,
|
|
+ stndat, sloc, xx, yy, vcord,
|
|
+ ivcord, icvtyp, grid, pontha,
|
|
+ iret )
|
|
IF ( iret .eq. 0 .and. parm .ne. ' ' ) THEN
|
|
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
|
|
kgxy = LLMAXD * LLMAXD
|
|
CALL SNSLEV ( cflag, line, cint, fflag,
|
|
+ fline, fint, kgxy, grid,
|
|
+ nclvl, clvl, icolor, iltype,
|
|
+ linwid, ilabel, nflvl, flvl,
|
|
+ ifcolr, iflabl, ifltyp, ier )
|
|
IF ( nclvl .eq. 0) cflag = .false.
|
|
IF ( nflvl .eq. 0) fflag = .false.
|
|
END IF
|
|
IF ( iret .ne. 0 ) THEN
|
|
prmexs = .false.
|
|
ELSE
|
|
CALL GSGGRF ( 1, iytype, LLMAXD, LLMAXD,
|
|
+ xmin, ybot, xmax, ytop, ier )
|
|
IF ( ier .ne. 0 ) THEN
|
|
iret = -15
|
|
CALL ER_WMSG ('SNCROSS', iret, ' ', ier)
|
|
proces = .false.
|
|
END IF
|
|
END IF
|
|
END IF
|
|
END IF
|
|
C
|
|
C* Check to see if wind data exist.
|
|
C
|
|
IF ( proces ) THEN
|
|
CALL SNSWWE ( winuni, vcord, ier )
|
|
IF ( ier .ne. 0 ) THEN
|
|
wndexs = .false.
|
|
END IF
|
|
END IF
|
|
C
|
|
C
|
|
C* Draw the cross section.
|
|
C
|
|
IF ( proces .and. ( prmexs .or. wndexs ) ) THEN
|
|
C
|
|
C* Clear the device if requested and set panel.
|
|
C
|
|
IF ( clear ) CALL GCLEAR ( iret )
|
|
CALL GG_PANL ( panel, iret )
|
|
C
|
|
C* Draw the isentropes or contours.
|
|
C
|
|
IF ( prmexs ) THEN
|
|
IF ( isnflg ) THEN
|
|
CALL SNSISN ( line, xx, pontha, ybot, ytop,
|
|
+ ithinc, thmin, thmax, nstn,
|
|
+ sloc, pdat, iret )
|
|
ELSE IF ( parm .ne. ' ' .and.
|
|
+ ( cflag .or. fflag ) ) THEN
|
|
IF ( fflag ) THEN
|
|
CALL GCFILL ( LLMAXD, LLMAXD, grid,
|
|
+ 0, 0, 0, nflvl, flvl,
|
|
+ ifcolr, iflabl, ifltyp,
|
|
+ iret )
|
|
IF ( iret .ne. 0 ) CALL ER_WMSG
|
|
+ ( 'GEMPLT', iret, ' ', ier )
|
|
END IF
|
|
IF ( cflag ) THEN
|
|
IF ( lflag ) THEN
|
|
CALL GCLGRN ( LLMAXD, LLMAXD, grid,
|
|
+ 0, 0, 0, nclvl, clvl,
|
|
+ icolor, iltype, linwid,
|
|
+ ilabel, iret )
|
|
IF ( iret .ne. 0 ) CALL ER_WMSG
|
|
+ ( 'GEMPLT', iret, ' ', ier )
|
|
END IF
|
|
IF ( nflag ) THEN
|
|
CALL GCNTLN ( LLMAXD, LLMAXD, grid,
|
|
+ 0, 0, 0, nclvl, clvl,
|
|
+ icolor, iltype, linwid,
|
|
+ ilabel, iret )
|
|
IF ( iret .ne. 0 ) CALL ER_WMSG
|
|
+ ( 'GEMPLT', iret, ' ', ier )
|
|
END IF
|
|
IF ( sflag ) THEN
|
|
CALL GCSPLN ( LLMAXD, LLMAXD, grid, 0, 0, 0,
|
|
+ nclvl, clvl, icolor,
|
|
+ iltype, linwid, ilabel,
|
|
+ iret )
|
|
IF ( iret .ne. 0 ) CALL ER_WMSG
|
|
+ ( 'GEMPLT', iret, ' ', ier )
|
|
END IF
|
|
IF ( bflag ) THEN
|
|
CALL GCBOXX ( LLMAXD, LLMAXD, grid,
|
|
+ 0, 0, 0, nclvl, clvl,
|
|
+ icolor, iltype, linwid,
|
|
+ ilabel, iret )
|
|
IF ( iret .ne. 0 ) CALL ER_WMSG
|
|
+ ( 'GEMPLT', iret, ' ', ier )
|
|
END IF
|
|
END IF
|
|
END IF
|
|
END IF
|
|
C
|
|
C* Plot the background and surface.
|
|
C
|
|
CALL SNSBOR ( border, ybot, ytop, yaxval, nyval,
|
|
+ iylbfr, iyglfr, iytmfr, xmin, xmax,
|
|
+ nstn, stns, sloc, xx, pontha,
|
|
+ toptmp, topwnd, xtlbl, ctlbl,
|
|
+ nxlbl, ixlbfr, ixglfr, ixtmfr,
|
|
+ timflg, iret )
|
|
C
|
|
C* Draw the winds.
|
|
C
|
|
IF ( wndexs ) THEN
|
|
|
|
IF ( vint .ne. ' ' ) THEN
|
|
CALL SNSVNT ( vint, vline, vflag, vlvl,
|
|
+ nvlvl, ivcolr, ier )
|
|
ELSE
|
|
vflag = .false.
|
|
END IF
|
|
C*
|
|
IF ( iwnclr .gt. 0 .or. vflag) THEN
|
|
CALL GSCOLR ( iwnclr, ier )
|
|
CALL IN_FILT ( filter, filtfc, ier )
|
|
CALL SNSWND ( wintyp, nstn, ipsdat,
|
|
+ nlvls, stndat, idtype, sloc,
|
|
+ ybot, ytop, filtfc, vcord,
|
|
+ nvlvl, vlvl, ivcolr, vflag,
|
|
+ iret )
|
|
END IF
|
|
END IF
|
|
C
|
|
C* Plot the color bar.
|
|
|
|
ipoint = INDEX ( clrbar, '!' )
|
|
IF ( fflag ) THEN
|
|
IF ( ipoint .gt. 0 ) THEN
|
|
iend = ipoint - 1
|
|
ELSE
|
|
CALL ST_LSTR ( clrbar, iend, ier )
|
|
END IF
|
|
CALL GG_CBAR ( clrbar(:iend), nflvl, flvl,
|
|
+ ifcolr, ier )
|
|
IF ( vflag .and. ipoint .gt. 0 ) THEN
|
|
CALL GG_CBAR ( clrbar(ipoint+1:), nvlvl,
|
|
+ vlvl, ivcolr, ier )
|
|
|
|
END IF
|
|
ELSE IF ( vflag ) THEN
|
|
CALL GG_CBAR ( clrbar, nvlvl, vlvl,
|
|
+ ivcolr, ier )
|
|
END IF
|
|
C
|
|
C
|
|
C* Write the title.
|
|
C
|
|
CALL SNSTTL (title, timflg, cxstns, times, ntime,
|
|
+ icttl, linttl, ttlstr, shrttl, iret)
|
|
IF ( clear ) CALL GMESG ( shrttl, ier )
|
|
IF ( icttl .gt. 0 ) THEN
|
|
CALL GSCOLR ( icttl, ier )
|
|
CALL GG_WSTR ( ttlstr, linttl, ier )
|
|
END IF
|
|
title = '1/-1/Height in Feet'
|
|
CALL SNSTTL (title, timflg, cxstns, times, ntime,
|
|
+ icttl, linttl, ttlstr, shrttl, iret)
|
|
IF ( icttl .gt. 0 ) THEN
|
|
CALL GSCOLR ( icttl, ier )
|
|
CALL GG_WSTR ( ttlstr, linttl, ier )
|
|
END IF
|
|
C
|
|
C
|
|
C* Flush the plotting buffers and update globals.
|
|
C
|
|
CALL GEPLOT ( iret )
|
|
END IF
|
|
C
|
|
C* Prompt for next cross section to be drawn.
|
|
C
|
|
C*
|
|
RETURN
|
|
END
|