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