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.
255 lines
8.2 KiB
255 lines
8.2 KiB
2 years ago
|
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 GRINIT (DBORD0, CHLSIZ)
|
||
|
|
C=======================================================================
|
||
|
|
|
||
|
|
C --*** GRINIT *** (GRPLIB) Initialize graphics (PLT)
|
||
|
|
C -- Written by Amy Gilkey - revised 04/27/88
|
||
|
|
C --
|
||
|
|
C --GRINIT initializes the graphics and sets graphics options and
|
||
|
|
C --parameters common to the entire run.
|
||
|
|
C --
|
||
|
|
C --Alphanumeric mode is set upon exit from this routine.
|
||
|
|
C --
|
||
|
|
C --Parameters:
|
||
|
|
C -- DBORD0 - OUT - the display / label area boundary (device units)
|
||
|
|
C -- (1=left, 2=right, 3=bottom, 4=top)
|
||
|
|
C -- CHLSIZ - OUT - the character line size (device units)
|
||
|
|
C --
|
||
|
|
C --Common Variables:
|
||
|
|
C -- Sets ICURDV, DEVOK, DEVNAM, DEVCOD, TALKOK, NSNAP, IFONT, SOFTCH,
|
||
|
|
C -- AUTOPL, MAXCOL, NUMCOL, MAPALT of /GRPCOM/
|
||
|
|
|
||
|
|
C --Routines Called:
|
||
|
|
C -- EXPARM - (SUPES) Get system-dependent parameters
|
||
|
|
C -- PLTINT - (PLTLIB) Initialize Graphics Status Area (GSA)
|
||
|
|
C -- PLTIQD - (PLTLIB) Obtain device information
|
||
|
|
C -- PLTSTT - (PLTLIB) Set text parameter
|
||
|
|
C -- 1 = (KHCHSZ) hardware character size
|
||
|
|
C -- 2 = (KSCHSZ) software character size
|
||
|
|
C -- 6 = (KCHLSZ) vertical line size
|
||
|
|
C -- GRSDEV - (GRPLIB) Select device
|
||
|
|
|
||
|
|
PARAMETER (KLFT=1, KRGT=2, KBOT=3, KTOP=4)
|
||
|
|
|
||
|
|
PARAMETER (KDVDI=10000)
|
||
|
|
PARAMETER (KHCHSZ=1, KSCHSZ=2, KCHLSZ=6)
|
||
|
|
|
||
|
|
COMMON /GRPCOC/ DEVNAM(2), DEVCOD(2)
|
||
|
|
CHARACTER*3 DEVNAM
|
||
|
|
CHARACTER*8 DEVCOD
|
||
|
|
COMMON /GRPCOM/ ICURDV, ISHARD, DEVOK(2), TALKOK(2),
|
||
|
|
& NSNAP(2), IFONT(2), SOFTCH(2), AUTOPL(2),
|
||
|
|
& MAXCOL(2), NUMCOL(0:1,2), MAPALT(2), MAPUSE(2)
|
||
|
|
LOGICAL ISHARD, DEVOK, TALKOK, SOFTCH, AUTOPL
|
||
|
|
C --For all device-dependent parameters:
|
||
|
|
C -- (1) terminal, (2) hardcopy (file)
|
||
|
|
C --ICURDV - the selected device number (1 or 2)
|
||
|
|
C --ISHARD - true iff a single hardcopy plot is being done
|
||
|
|
C --DEVNAM - the device name
|
||
|
|
C --DEVOK - true iff the device is defined
|
||
|
|
C --DEVCOD - a code associated with a class of devices:
|
||
|
|
C -- DICOMED = Dicomed
|
||
|
|
C -- CAMERA = Raster Tech with video
|
||
|
|
C -- WAIT = TK4 or any device that requires a wait after graph drawn
|
||
|
|
C -- = other
|
||
|
|
C --TALKOK - true iff interactive graphics device
|
||
|
|
C --NSNAP - the number of frames to snap for the device
|
||
|
|
C --IFONT - font (1=stick, 2=sanserif, 3=Roman)
|
||
|
|
C --SOFTCH - true iff software characters are to be used
|
||
|
|
C --AUTOPL - true iff automatic plotting (no response requested at end)
|
||
|
|
C --MAXCOL - the maximum number of colors available on the graphics device
|
||
|
|
C -- (excluding black and white)
|
||
|
|
C --NUMCOL - the number of colors to be used (excluding black and white)
|
||
|
|
C -- (0,x) - on standard rainbow
|
||
|
|
C -- (1,x) - on alternate color map
|
||
|
|
C --MAPALT - the alternate color map type:
|
||
|
|
C -- 0 = standard rainbow (no alternate)
|
||
|
|
C -- 1 = spectrum
|
||
|
|
C --MAPUSE - the color map type to use (as in MAPALT)
|
||
|
|
|
||
|
|
REAL DBORD0(KTOP)
|
||
|
|
REAL CHLSIZ
|
||
|
|
|
||
|
|
LOGICAL LDUM, PLTSTT
|
||
|
|
LOGICAL BATCH
|
||
|
|
LOGICAL HRDCPY
|
||
|
|
REAL VDINFO(23)
|
||
|
|
|
||
|
|
character*2048 scratch
|
||
|
|
character*32 device
|
||
|
|
|
||
|
|
PARAMETER (MXDCOD = 12)
|
||
|
|
|
||
|
|
CHARACTER*3 NDCOD(MXDCOD)
|
||
|
|
CHARACTER*8 DCOD(MXDCOD)
|
||
|
|
SAVE NDCOD, DCOD
|
||
|
|
C --NDCOD - the device name for special devices
|
||
|
|
C --DCOD - the device code for special devices
|
||
|
|
|
||
|
|
DATA NDCOD / '16B', '16C',
|
||
|
|
& '35A', '35B', '35C', '3MB', '3MC',
|
||
|
|
& '24L', '48L', 'BSQ', 'CSQ',
|
||
|
|
& 'TK4' /
|
||
|
|
DATA DCOD / 'DICOMED ', 'DICOMED ',
|
||
|
|
& 'DICOMED ', 'DICOMED ', 'DICOMED ', 'DICOMED ', 'DICOMED ',
|
||
|
|
& 'DICOMED ', 'DICOMED ', 'DICOMED ', 'DICOMED ',
|
||
|
|
& 'WAIT ' /
|
||
|
|
|
||
|
|
C --Set up graph borders, etc
|
||
|
|
|
||
|
|
CHLSIZ = .014
|
||
|
|
DBORD0(KLFT) = 0.00 + 0.0001
|
||
|
|
DBORD0(KRGT) = 1.00 - 0.0001
|
||
|
|
DBORD0(KBOT) = 0.00 + 0.0001
|
||
|
|
DBORD0(KTOP) = 0.75 - 0.0001
|
||
|
|
C --Open unit 6 to tty (for PLT)
|
||
|
|
|
||
|
|
c OPEN (UNIT=6, FILE='tty', ERR=100)
|
||
|
|
c 100 CONTINUE
|
||
|
|
|
||
|
|
C --Get graphic output devices ready
|
||
|
|
|
||
|
|
C ... Get graphics device name from executable (follows . in executable name)
|
||
|
|
CALL GET_ARGUMENT(0,scratch, lfil)
|
||
|
|
last = indexr(scratch, '_')
|
||
|
|
if (last .gt. 2) then
|
||
|
|
device = scratch(last+1:lfil)
|
||
|
|
if (device(:lenstr(device)) .eq. 'dual') then
|
||
|
|
devnam(1) = 'x11'
|
||
|
|
devnam(2) = 'met'
|
||
|
|
else if (device(:lenstr(device)) .eq. 'xcps') then
|
||
|
|
devnam(1) = 'x11'
|
||
|
|
devnam(2) = 'cps'
|
||
|
|
else
|
||
|
|
devnam(1) = device(:lenstr(device))
|
||
|
|
devnam(2) = ' '
|
||
|
|
end if
|
||
|
|
else
|
||
|
|
last = indexr(scratch, '.')
|
||
|
|
if (last .gt. 2) then
|
||
|
|
device = scratch(last+1:lfil)
|
||
|
|
if (device(:lenstr(device)) .eq. 'dual') then
|
||
|
|
devnam(1) = 'x11'
|
||
|
|
devnam(2) = 'met'
|
||
|
|
else if (device(:lenstr(device)) .eq. 'xcps') then
|
||
|
|
devnam(1) = 'x11'
|
||
|
|
devnam(2) = 'cps'
|
||
|
|
else
|
||
|
|
devnam(1) = device(:lenstr(device))
|
||
|
|
devnam(2) = ' '
|
||
|
|
end if
|
||
|
|
else
|
||
|
|
call PRTERR('ERROR',
|
||
|
|
* 'Could not determine graphics device type.')
|
||
|
|
call PRTERR('CMDSPEC',scratch(:lfil))
|
||
|
|
C ... Assume single device, x11
|
||
|
|
devnam(1) = 'x11'
|
||
|
|
devnam(2) = ' '
|
||
|
|
end if
|
||
|
|
end if
|
||
|
|
|
||
|
|
CALL VDIQES (KDVDI, ION)
|
||
|
|
IF (ION .EQ. 1) THEN
|
||
|
|
DO 110 IDEV = 1, 2
|
||
|
|
CALL VDIQES (KDVDI + IDEV, ION)
|
||
|
|
DEVOK(IDEV) = (ION .EQ. 1)
|
||
|
|
IF (.NOT. DEVOK(IDEV)) THEN
|
||
|
|
DEVNAM(IDEV) = ' '
|
||
|
|
END IF
|
||
|
|
110 CONTINUE
|
||
|
|
ELSE
|
||
|
|
DO 120 IDEV = 1, 2
|
||
|
|
DEVOK(IDEV) = (DEVNAM(IDEV) .NE. ' ')
|
||
|
|
120 CONTINUE
|
||
|
|
IF (.NOT. (DEVOK(1) .OR. DEVOK(2))) THEN
|
||
|
|
DEVOK(1) = .TRUE.
|
||
|
|
DEVNAM(1) = '***'
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C ... Temporary kludge until dual device available GDS
|
||
|
|
IF (DEVNAM(2) .eq. '***' ) then
|
||
|
|
DEVOK(2) = .FALSE.
|
||
|
|
DEVNAM(2) = ' '
|
||
|
|
end if
|
||
|
|
|
||
|
|
IF (.NOT. (DEVOK(1) .OR. DEVOK(2))) THEN
|
||
|
|
CALL PRTERR ('FATAL', 'No device is active')
|
||
|
|
STOP
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C --Initialize the attached camera device (before the graphics device)
|
||
|
|
|
||
|
|
NSNAP(1) = -999
|
||
|
|
NSNAP(2) = -999
|
||
|
|
|
||
|
|
C --Initialize graphics devices
|
||
|
|
|
||
|
|
IDEV = 0
|
||
|
|
IF (DEVOK(1)) IDEV = IDEV + 1
|
||
|
|
IF (DEVOK(2)) IDEV = IDEV + 2
|
||
|
|
CALL VDESCP (KDVDI + IDEV, 0, 0)
|
||
|
|
CALL PLTINT
|
||
|
|
|
||
|
|
C --Set device dependent parameters, for both devices
|
||
|
|
|
||
|
|
DO 140 IDEV = 1, 2
|
||
|
|
IF (DEVOK(IDEV)) THEN
|
||
|
|
CALL VDESCP (KDVDI + IDEV, 0, 0)
|
||
|
|
|
||
|
|
CALL PLTIQD (VDINFO)
|
||
|
|
|
||
|
|
DEVCOD(IDEV) = ' '
|
||
|
|
DO 130 I = 1, MXDCOD
|
||
|
|
IF (NDCOD(I) .EQ. DEVNAM(IDEV)) DEVCOD(IDEV) = DCOD(I)
|
||
|
|
130 CONTINUE
|
||
|
|
HRDCPY = (NINT(VDINFO(1)) .EQ. 0)
|
||
|
|
TALKOK(IDEV) = (.NOT. HRDCPY) .AND. (.NOT. BATCH ())
|
||
|
|
C --Old: high resolution font if (1.75*VDINFO(15)) .GT. 1600
|
||
|
|
CALL GRSNAP ('QUERY', IDEV)
|
||
|
|
IFONT(IDEV) = 1
|
||
|
|
SOFTCH(IDEV) = HRDCPY .OR. (NINT(VDINFO(7)) .EQ. 0)
|
||
|
|
MAXCOL(IDEV) = MAX (0, NINT(VDINFO(4))-2)
|
||
|
|
NUMCOL(0,IDEV) = MIN (MAXCOL(IDEV), 6)
|
||
|
|
NUMCOL(1,IDEV) = 0
|
||
|
|
MAPALT(IDEV) = 0
|
||
|
|
MAPUSE(IDEV) = 0
|
||
|
|
AUTOPL(IDEV) = .NOT. TALKOK(IDEV)
|
||
|
|
|
||
|
|
ELSE
|
||
|
|
HRDCPY = .FALSE.
|
||
|
|
TALKOK(IDEV) = .FALSE.
|
||
|
|
NSNAP(IDEV) = -999
|
||
|
|
IFONT(IDEV) = 1
|
||
|
|
SOFTCH(IDEV) = .FALSE.
|
||
|
|
MAXCOL(IDEV) = 0
|
||
|
|
NUMCOL(0,IDEV) = 0
|
||
|
|
NUMCOL(1,IDEV) = 0
|
||
|
|
MAPALT(IDEV) = 0
|
||
|
|
MAPUSE(IDEV) = 0
|
||
|
|
AUTOPL(IDEV) = .NOT. TALKOK(IDEV)
|
||
|
|
END IF
|
||
|
|
140 CONTINUE
|
||
|
|
|
||
|
|
C --Set current device parameters
|
||
|
|
|
||
|
|
ICURDV = 0
|
||
|
|
CALL GRSDEV (0)
|
||
|
|
|
||
|
|
C --Set character sizes
|
||
|
|
|
||
|
|
RAT = 4.0 / 3.0
|
||
|
|
VCS = CHLSIZ / RAT
|
||
|
|
LDUM = PLTSTT (KSCHSZ, VCS)
|
||
|
|
LDUM = PLTSTT (KHCHSZ, VCS)
|
||
|
|
LDUM = PLTSTT (KCHLSZ, RAT)
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
END
|