You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
139 lines
4.7 KiB
139 lines
4.7 KiB
C Copyright(C) 1999-2020 National Technology & Engineering Solutions
|
|
C of Sandia, LLC (NTESS). Under the terms of Contract DE-NA0003525 with
|
|
C NTESS, the U.S. Government retains certain rights in this software.
|
|
C
|
|
C See packages/seacas/LICENSE for details
|
|
|
|
C=======================================================================
|
|
SUBROUTINE WRTNEU (NPTS, XPTS, YPTS, PLTITL, TXLAB, TYLAB)
|
|
C=======================================================================
|
|
|
|
C --*** WRTNEU *** (XYPLOT) Write curve to neutral file
|
|
C -- Written by Amy Gilkey - revised 04/21/88
|
|
C --
|
|
C --WRTNEU writes the data for a curve to a neutral file which is
|
|
C --readable by the xmgr program. The first
|
|
C --time the routine is called, the neutral file is opened.
|
|
C --
|
|
C --Parameters:
|
|
C -- NPTS - IN - the number of points on the curve
|
|
C -- XPTS, YPTS - IN - the points on the curve
|
|
C -- PLTITL - IN - the plot title describing the curve
|
|
C -- (e.g. "TIME vs SIGXX at ELEMENT 30")
|
|
C -- TXLAB, TYLAB - IN - the X and Y axis labels, either the
|
|
C -- user-input labels or the plot variable descriptions
|
|
C --
|
|
C --Common Variables:
|
|
C -- Uses TITLE, CREATE, MODIFY, DRAW of /DBTITL/
|
|
C -- Uses DOQA, CAPTN of /LEGOPT/
|
|
C -- Uses XMIN, XMAX, YMIN, YMAX of /LIMITS/
|
|
C -- Uses NEU, NUMCRV, INCCRV, CRVNAM of /NEUTR./
|
|
C -- Uses and sets NEUOPN of /NEUTR./
|
|
|
|
include 'dbname.blk'
|
|
include 'dbtitl.blk'
|
|
include 'legopt.blk'
|
|
include 'xylim.blk'
|
|
include 'neutr.blk'
|
|
|
|
CHARACTER*2048 filnam, errmsg
|
|
REAL XPTS(NPTS), YPTS(NPTS)
|
|
CHARACTER*(*) PLTITL
|
|
CHARACTER*(*) TXLAB, TYLAB
|
|
|
|
CHARACTER*15 CURVE
|
|
integer numgrf
|
|
save numgrf
|
|
|
|
IF (.NOT. NEUOPN) THEN
|
|
filnam = basenam(:lenstr(basenam)) // '.xmgr'
|
|
|
|
C --Open the neutral file and write the title line
|
|
write (*,*) "Neutral File: ", filnam
|
|
open (unit=neu, file=filnam(:lenstr(filnam)), form='formatted',
|
|
* status='unknown', iostat=ierr)
|
|
IF (IERR .NE. 0) THEN
|
|
ERRMSG = 'Neutral file "'//FILNAM(:LENSTR(FILNAM))//
|
|
* '" could not be opened.'
|
|
CALL PRTERR ('CMDERR', ERRMSG(:LENSTR(ERRMSG)))
|
|
GOTO 170
|
|
END IF
|
|
NEUOPN = .TRUE.
|
|
|
|
WRITE (NEU, 10000) 'Written by: ',
|
|
* DRAW(1), DRAW(3)(:LENSTR(DRAW(3))), DRAW(4)(:LENSTR(DRAW(4)))
|
|
WRITE (NEU, 10000) 'Created by: ',
|
|
* CREATE(1), CREATE(3)(:LENSTR(CREATE(3))),
|
|
* CREATE(4)(:LENSTR(CREATE(4)))
|
|
WRITE (NEU, 10000) 'Modified by: ',
|
|
& MODIFY(1), MODIFY(3)(:LENSTR(MODIFY(3))),
|
|
* MODIFY(4)(:LENSTR(MODIFY(4)))
|
|
10000 FORMAT ('# ',A, A, A, ' ', A, ' ', A)
|
|
|
|
C--Write header information.
|
|
numgrf = 0
|
|
numcrv = 31
|
|
C... Set world min/max values to appropriate values.
|
|
WXMIN = 1.0E30
|
|
WXMAX = -1.0E30
|
|
WYMIN = 1.0E30
|
|
WYMAX = -1.0E30
|
|
END IF
|
|
C --If numcrv >= 30, increment grf number and print header.
|
|
if (numcrv .ge. 30 .or.
|
|
* (inccrv .lt. 0 .and. numcrv .gt. abs(inccrv))) then
|
|
numcrv = 1
|
|
write (curve, '(A1, I7)') 'g', numgrf
|
|
CALL PCKSTR (1, CURVE)
|
|
WRITE (NEU, 10100) curve
|
|
10100 FORMAT ('@ with ',A,/
|
|
* '@ legend on'/
|
|
* '@ legend loctype view'/
|
|
* '@ legend char size 0.75')
|
|
numgrf = numgrf + 1
|
|
end if
|
|
C --Get the curve name
|
|
WRITE (CURVE, '(A1, I7)') 's', NUMCRV-1
|
|
CALL PCKSTR (1, CURVE)
|
|
|
|
WRITE (*, 10090) PLTITL(:LENSTR(PLTITL)), numgrf-1, numcrv-1
|
|
10090 FORMAT (' Writing "',A,'" to Graph ',i2,', Set ',i2)
|
|
|
|
C --Write the begin curve record with the curve name
|
|
WRITE (NEU, 10020) 'title', TITLE(:lenstr(title))
|
|
WRITE (NEU, 10020) 'subtitle', PLTITL(:lenstr(pltitl))
|
|
|
|
ncol = mod(numcrv-1,15) + 1
|
|
WRITE (NEU, 10010) CURVE, 'color', ncol
|
|
10010 FORMAT ('@ ',A, A, I7)
|
|
|
|
C --Write the title lines
|
|
|
|
10020 FORMAT ('@ ',A,' "', A,'"')
|
|
|
|
C --Write the X and Y labels
|
|
|
|
WRITE (NEU, 10040) '@ xaxis label', TXLAB(:lenstr(txlab))
|
|
WRITE (NEU, 10040) '@ yaxis label', TYLAB(:lenstr(tylab))
|
|
10040 FORMAT (A,' "',A,'"')
|
|
write (neu, 10050) numcrv-1, TYLAB(:lenstr(tylab))
|
|
10050 FORMAT ('@ legend string ',i5,' "',A,'"')
|
|
write (neu, 10060) curve, TYLAB(:lenstr(tylab))
|
|
10060 FORMAT ('@ ',A,' comment "',A,'"')
|
|
C --Write the min/max, the number of points, and the auxiliary data flag
|
|
|
|
C --Write the data points
|
|
|
|
DO 160 I = 1, NPTS
|
|
WXMAX = MAX(WXMAX, XPTS(I))
|
|
WXMIN = MIN(WXMIN, XPTS(I))
|
|
WYMAX = MAX(WYMAX, YPTS(I))
|
|
WYMIN = MIN(WYMIN, YPTS(I))
|
|
WRITE (NEU, 10070) XPTS(I), YPTS(I)
|
|
10070 FORMAT (1PE15.7E3,4x,1pe15.7E3)
|
|
160 CONTINUE
|
|
WRITE (NEU, '(A)') '&'
|
|
170 CONTINUE
|
|
NUMCRV = NUMCRV + 1
|
|
RETURN
|
|
END
|
|
|