[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
20030429: GARP cross sections
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: 20030429: GARP cross sections
- Date: Tue, 29 Apr 2003 16:05:28 -0600
Larry,
Below is the diff for pxsec to use the DG_CXGP routine
following the mods from gdcross.f (complete file attatched)
so that the dependency on GR_PLIN stays in gemlib.a.
Chiz
*** pxsec.f.old Thu Aug 1 15:01:27 2002
--- pxsec.f Mon Apr 28 16:00:46 2003
***************
*** 175,207 ****
proces = .false.
END IF
END IF
C
! C* Find plotting location.
C
! IF ( proces ) THEN
C
! C* 5/02 gdcross.f was changes using COMMON /GDXS/ for cross
! C* sections across grid boundaries.
C
! CALL GQGPRJ ( cproj, angle1, angle2, angle3, imx,
! + imy, dlatll, dlonll, dlatur, dlonur,
! + iret )
! C* todo...add block for CED, MER and MCD boundary check here
! CALL GSMPRJ ( cproj, angle1, angle2, angle3,
! + dlatll, dlonll, dlatur, dlonur, ier )
! C
! CALL GR_RARG ( imx, imy, qgrd, ier )
! C
! C* End addition
! C
! 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 ( proces ) THEN
--- 175,199 ----
proces = .false.
END IF
END IF
+ C******************** UPC 4/2003 changed to match gdcross mods of 8/02
C
! C* Compute subset grid needed for cross section path
C
! CALL DG_CXGP ( cxstns, 1000, nhxs, rgx, rgy,
! + rlat, rlon, iret )
! IF ( iret .ne. 0 ) proces = .false.
C
! C* Compute length of cross section.
C
! CALL GDXLEN ( nhxs, rlat, rlon, rlngth, iier )
C
+ C* Check that there are some points.
+ C
+ IF ( nhxs .le. 0 ) THEN
+ proces = .false.
+ END IF
+ C********************
+ C
C* Set the origin of the cross section for MSFC calculation.
C
IF ( proces ) THEN
***************
*** 221,232 ****
igymax = INT ( MAX ( rgy ( 1 ), rgy ( nhxs ) ) ) + 1
CALL DG_AREA ( igxmin, igxmax, igymin, igymax, iret )
ENDIF
- C
- C* Determine the length of the cross section.
- C
- IF ( proces ) THEN
- CALL GDXLEN ( nhxs, rlat, rlon, rlngth, iier )
- END IF
C
C* Get the surface data.
C
--- 213,218 ----
On Mon, 28 Apr 2003, Larry D. Oolman wrote:
> I get core dumps attempting to do model cross sections
> with garp under gempak-5.6.j. The cause appears to
> be an extra parameter in gempak/source/gemlib/gr/grplin.f
> that doesn't get added to comet/garp/gempak/pxsec.f. The following
> change fixes the problem.
>
> Larry Oolman
> Department of Atmospheric Science
> University of Wyoming
> address@hidden
> http://www-das.uwyo.edu
>
> *** comet/garp/gempak/pxsec.f.dist Thu Aug 1 15:01:27 2002
> --- comet/garp/gempak/pxsec.f Mon Apr 28 11:18:34 2003
> ***************
> *** 194,200 ****
> C
> C* End addition
> C
> ! 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 )
> --- 194,201 ----
> C
> C* End addition
> C
> ! CALL GR_PLIN ( cxstns, 1000, nhxs, rgx, rgy, rlat, rlon,
> ! + iret )
> IF ( iret .ne. 0 ) THEN
> CALL ER_WMSG ( 'GR', iret, cxstns, ier )
> CALL ER_WMSG ( 'GDCROSS', -4, ' ', ier )
>
>
C***********************************************************************
C*
C* Copyright 1996, University Corporation for Atmospheric Research.
C*
C* pxsec.f
C*
C* Cross section drawing function. Derived from the GEMPAK program
C* GDCROSS.
C*
C* History:
C*
C* 11/96 COMET Original copy
C* 2/97 J. Cowie/COMET Changed title time
C* 3/97 J. Cowie/COMET Changed to deal with unspecified contour
C* or fill interval
C* 5/97 COMET Added gprintf to support logging.
C* 11/97 COMET Added ptitle to display clickable titles.
C* 12/97 COMET Changed varible "len" to "lent".
C* 5/99 COMET Set fflag=F as default to eliminate bug
C*
C************************************************************************
SUBROUTINE pxsec ( gdfile, gdatim, gfunc, gvcord, gvect, cxstns,
+ ctype, ptype, yaxis, scale, wind, cint, line,
+ contur, fint, fline, clrbar, title, skip,
+ refvec, text, frame, ititle, verbose, iperr )
C************************************************************************
C************************************************************************
INCLUDE 'GEMPRM.PRM'
C*
CHARACTER gdfile*(*), gdatim*(*), gfunc*(*), gvcord*(*),
+ gvect*(*) , cxstns*(*), ctype*(*), ptype*(*) ,
+ yaxis*(*) , scale*(*) , wind*(*) , cint*(*) ,
+ line*(*) , contur*(*), fint*(*) , fline*(*) ,
+ clrbar*(*), title*(*) , skip*(*) , refvec*(*),
+ text*(*)
INTEGER verbose, frame
CHARACTER border*72, panel*72, shrttl*72, ttl*72
CHARACTER pfcint*80, pffint*80, carr(3)*36
CHARACTER blank*2
C*
LOGICAL lscal, lvert
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 (1000), rgy (1000), rlat (1000),
+ rlon (1000), vclsfc (1000), frarr(3)
CHARACTER time (2)*20, lastim*20, ttlstr*72, parm*12,
+ timev (2)*20, parmv*12, firstm*20, prmlbl*12
CHARACTER cproj*4
LOGICAL done, proces, havsfc, havscl, havvec
C*
REAL clvl (LLCLEV), flvl (LLCLEV), rmargn (4)
INTEGER icolor (LLCLEV), iline (LLCLEV), ilwid (LLCLEV),
+ labflg (LLCLEV), ifcolr (LLCLEV),ifltyp(LLCLEV),
+ iflabl (LLCLEV), level(2), iflwid (LLCLEV)
SAVE pffint, pfcint
COMMON/GDXS/ cproj, angle1, angle2, angle3, imx, imy,
+ dlatll, dlonll, dlatur, dlonur
C-----------------------------------------------------------------------
iperr = 0
ioldclr = 0
blank = ' ' // char(0)
border='1'
panel='0'
C text= '1/2//hw'
shrttl=' '
ier = 0
iflno = 0
fflag = .false.
if ( verbose .gt. 0 ) call gfprints (
+ 'pxsec' // char(0), blank )
if ( verbose .gt. 1 ) then
call gfprints ( ' gdfile = ' // char(0), gdfile )
call gfprints ( ' gdatim = ' // char(0), gdatim )
call gfprints ( ' gfunc = ' // char(0), gfunc )
call gfprints ( ' gvcord = ' // char(0), gvcord )
call gfprints ( ' gvect = ' // char(0), gvect )
call gfprints ( ' cxstns = ' // char(0), cxstns )
call gfprints ( ' ctype = ' // char(0), ctype )
call gfprints ( ' ptype = ' // char(0), ptype )
call gfprints ( ' yaxis = ' // char(0), yaxis )
call gfprints ( ' scale = ' // char(0), scale )
call gfprints ( ' wind = ' // char(0), wind )
call gfprints ( ' cint = ' // char(0), cint )
call gfprints ( ' line = ' // char(0), line )
call gfprints ( ' contur = ' // char(0), contur )
call gfprints ( ' fint = ' // char(0), fint )
call gfprints ( ' fline = ' // char(0), fline )
call gfprints ( ' clrbar = ' // char(0), clrbar )
call gfprints ( ' title = ' // char(0), title )
call gfprints ( ' skip = ' // char(0), skip )
call gfprints ( ' refvec = ' // char(0), refvec )
call gfprints ( ' text = ' // char(0), text )
call gfprinti ( ' frame = ' // char(0), frame )
call gfprinti ( ' ititle = ' // char(0), ititle )
call gfprinti ( ' verbose = ' // char(0), verbose )
call gfprinti ( ' iperr = ' // char(0), iperr )
end if
C
C* Clear out the contour/fill info from any previous frames
C
if ( frame .eq. 1 ) then
if ( INDEX ( ctype, 'C') .gt. 0 ) pfcint(1:) = ' '
if ( INDEX ( ctype, 'F') .gt. 0 ) pffint(1:) = ' '
endif
C
C* Set flag to indicate processing will be done.
C
proces = .true.
C
C Set text.
C
CALL IN_TEXT ( text, ier )
C
C* Exit if there is an error.
C
IF ( iperr .ne. 0 ) THEN
done = .true.
ELSE
C
C* Open the grid file and set the grid navigation. This will
C* set the proper mode for the grid file. The mode must be
C* set to graph mode later.
C
CALL DG_OFIL ( gdfile, ' ', .true., iflno, idum, iret )
IF ( iret .ne. 0 ) proces = .false.
IF ( ( ier .ne. 0 ) .and. proces ) THEN
proces = .false.
iret = ier
END IF
C
IF ( proces ) THEN
C
C* Get file number, time and vertical coordinate to use.
C
CALL DG_FLNO ( gfunc, iflnos, ier )
CALL GD_NGRD ( iflnos, nn, firstm, lastim, ier )
CALL GDXDTV ( gdatim, 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 ) THEN
CALL DG_FLNO ( gvect, iflnov, ier )
CALL GD_NGRD ( iflnov, nn, firstm, lastim, ier )
CALL GDXDTV ( gdatim, 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 ) 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******************** UPC 4/2003 changed to match gdcross mods of 8/02
C
C* Compute subset grid needed for cross section path
C
CALL DG_CXGP ( cxstns, 1000, nhxs, rgx, rgy,
+ rlat, rlon, iret )
IF ( iret .ne. 0 ) proces = .false.
C
C* Compute length of cross section.
C
CALL GDXLEN ( nhxs, rlat, rlon, rlngth, iier )
C
C* Check that there are some points.
C
IF ( nhxs .le. 0 ) THEN
proces = .false.
END IF
C********************
C
C* Set the origin of the cross section for MSFC calculation.
C
IF ( proces ) THEN
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
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 )
ENDIF
C
C* Get the surface data.
C
IF ( proces ) THEN
CALL GDXGTS ( iflnos, time, ivcord, rgx, rgy, nhxs,
+ vclsfc, havsfc, parm, ier )
END IF
C
C* Get scalar data to plot.
C
IF ( proces ) THEN
CALL GDXDTA ( iflnos, gdatim, 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, gdatim, 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 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 CALL GDXLEV ( cflag, line, cint, fflag, fline, fint,
c + scale, nhxs, nvo, 1, 1, nhxs, nvo, qgrd,
c + nlvl, clvl, icolor, iline, ilwid, labflg,
c + nflvl, flvl, ifcolr, iflabl, iscale, dmin,
c + dmax, iret )
***
*** the following stuff was added in place of the call to GDXLEV above.
*** Much of it duplicates what GDXLEV does, we need to tweak things
*** a little though. -jrc
***
CALL IN_SCAL ( scale, iscale, iscalv, iret)
CALL GR_SSCL ( iscale, nhxs, nvo, 1, 1,
+ nhxs, nvo, qgrd, dmin, dmax, iret )
C
C* Do the regular contours
C
IF ( cflag ) THEN
CALL ST_CLST ( cint, '/', ' ', 3, carr, num, iret )
IF ( (carr(1) .eq. ' ' ) .and.
+ (pfcint .ne. ' ' ) ) cint = pfcint
CALL IN_INTC ( cint, dmin, dmax, clvl, nlvl,
+ rint, cmin, cmax, iret )
IF ( iret .ne. 0 ) THEN
nclvl = 0
rint = 0.
END IF
C
C* If undefined, save the new cint for the next frame
C
IF ( (carr(1) .eq. ' ' ) .and.
+ (pfcint .eq. ' ' )) THEN
write(pfcint,'(F10.2,A,F10.2,A,F10.2)')
+ rint,'/',cmin,'/',cmax
call ST_RMBL (pfcint, pfcint, lent, ier)
cint = pfcint
END IF
CALL IN_LINE ( line, clvl, nlvl, icolor,
+ iline, ilwid, labflg,
+ smooth, filter, iret )
C
C* Check for duplicate contours & sort contours
C
CALL GR_NLEV ( nlvl, clvl, icolor, iline,
+ ilwid, labflg, iret )
END IF
C
C* Get the filled contours.
C
IF ( fflag ) THEN
iflist = INDEX ( fint, ';' )
CALL ST_CLST ( fint, '/', ' ', 3, carr, num, iret )
CALL ST_CRNM ( carr(1), frarr(1), ier )
CALL ST_CRNM ( carr(2), frarr(2), ier )
CALL ST_CRNM ( carr(3), frarr(3), ier )
IF (((frarr(1) .eq. RMISSD ) .or.
+ (frarr(2) .eq. RMISSD ) .or.
+ (frarr(3) .eq. RMISSD )) .and.
+ (pffint .ne. ' ' ) .and.
+ (iflist .eq. 0 )) fint = pffint
C
C* Define color fill contours. If the min or max is
C* already specified, use it.
C
CALL ST_CLST ( fint, '/', ' ', 3, carr, num, iret )
CALL ST_CRNM ( carr(2), frarr(2), ier )
CALL ST_CRNM ( carr(3), frarr(3), ier )
if ( frarr(2) .ne. RMISSD ) dmin = frarr(2)
if ( frarr(3) .ne. RMISSD ) dmax = frarr(3)
CALL IN_INTC ( fint, dmin, dmax, flvl, nflvl,
+ rfint, fmin, fmax, iret )
IF ( iret .ne. 0 ) THEN
nflvl = 0
rfint = 0.
END IF
IF (((frarr(1) .eq. RMISSD ) .or.
+ (frarr(2) .eq. RMISSD ) .or.
+ (frarr(3) .eq. RMISSD )) .and.
+ (pffint .eq. ' ' ) .and.
+ (iflist .eq. 0 )) THEN
write( pffint,'(F10.2,A,F10.2,A,F10.2)')
+ (flvl(2)-flvl(1)), '/',flvl(1),'/',flvl(nflvl)
call ST_RMBL (pffint, pffint, lent, ier)
fint = pffint
END IF
C
C* Get the colors, line types, line widths and labels
C
IF ( nflvl .eq. LLCLEV ) THEN
nflvl = nflvl - 1
END IF
nflvl1 = nflvl + 1
CALL IN_LINE ( fline, flvl, nflvl1, ifcolr,
+ ifltyp, iflwid, iflabl,
+ smooth, filter, iret )
C
C* Check for duplicate fill contours & sort.
C
CALL GR_NLEV ( nflvl, flvl, ifcolr, ifltyp,
+ iflwid, iflabl, iret )
ENDIF
IF ( ( nlvl .eq. 0 .and. nflvl .eq. 0 ) .or. iret .ne. 0 )
+ CALL ER_WMSG ( 'GDCROSS',1,' ',ier)
IF ( nlvl .eq. 0 ) cflag = .false.
IF ( nflvl .eq. 0 ) fflag = .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 and set panel.
C
CALL GG_PANL ( panel, 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
c parmv = ' '
c parmv = gfunc (1:4)
c CALL ST_LCUC ( parmv, parmv, ier )
c IF ( parmv (1:4) .eq. 'THTA' .and. iret .eq. 0 ) THEN
c IF ( cflag ) CALL GDXSDL ( nhxs, nvo, qgrd, nlvl,
c + clvl, labflg, iret )
c IF ( fflag ) CALL GDXSDL ( nhxs, nvo, qgrd, nflvl,
c + flvl, iflabl, iret )
c END IF
IF ( iret .eq. 0 ) THEN
IF ( fflag ) THEN
CALL GCFILL ( nhxs, nvo, qgrd, 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 ( 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
IF ( sflag ) THEN
CALL GCSPLN ( 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
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
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 )
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
C
C Not processing but at least plot a title.
C
ELSE
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
END IF
C
C* Print general error messages if necessary.
C
IF (iperr .ne. 0) CALL ER_WMSG ( 'GDCROSS', iperr, ' ', ier )
C
CALL DG_FCLOS( iret )
C
C CALL GFLUSH ( iret )
C
if ( verbose .gt. 0 ) call gfprinti (
+ 'returning from pxsec - iret = ' // char(0), iret )
RETURN
END
- Prev by Date: 20030429: Gempak 5.6j script colors
- Next by Date: 20030414: gempak 5.6.j question.
- Previous by thread: 20030429: Gempak 5.6j script colors
- Next by thread: 20030414: gempak 5.6.j question.
- Index(es):