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.
263 lines
8.0 KiB
263 lines
8.0 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 GRPEND (MAYQUI, MAYTXT, NDONE, NTOTAL, GOBCK, *, *)
|
||
|
|
C=======================================================================
|
||
|
|
|
||
|
|
C --*** GRPEND *** (GRPLIB) End a plot by requesting quit, hardcopy (PLT)
|
||
|
|
C -- Written by Amy Gilkey - revised 01/22/88
|
||
|
|
C --
|
||
|
|
C --GRPEND is called at the end of a plot. It may prompt the user for
|
||
|
|
C --a response and take the appropriate alternate returns for special
|
||
|
|
C --responses.
|
||
|
|
C --
|
||
|
|
C --If a single hardcopy plot is requested, the hardcopy device is
|
||
|
|
C --selected and an internal flag is set and an alternate return is taken.
|
||
|
|
C --If the internal flag is set upon entry to the routine, the terminal
|
||
|
|
C --device is selected and the flag is reset. Be sure to call this
|
||
|
|
C --routine at the normal end of the each plot (even a single hardcopy plot).
|
||
|
|
C --The internal flag is reset whenever the terminal device is selected.
|
||
|
|
C --
|
||
|
|
C --If the plot may be annotated with text, be sure that the color of the
|
||
|
|
C --text to be displayed is set before this routine is called.
|
||
|
|
C --
|
||
|
|
C --If no response is possible and AUTO is set, the number of plots
|
||
|
|
C --completed is displayed.
|
||
|
|
C --
|
||
|
|
C --Parameters:
|
||
|
|
C -- MAYQUI - IN - true if QUIT is a possible alternative
|
||
|
|
C -- MAYTXT - IN - true if TEXT is a possible alternative
|
||
|
|
C -- NDONE - IN - the number of plots completed
|
||
|
|
C -- NTOTAL - IN - the total number of plots
|
||
|
|
C -- GOBCK - in/out - on entry, true if go back supported,
|
||
|
|
C -- - on output, true if go back selected
|
||
|
|
C -- * - the alternate return if hardcopy requested
|
||
|
|
C -- * - the alternate return if quit requested
|
||
|
|
C --
|
||
|
|
C --Common Variables:
|
||
|
|
C -- Sets and uses IHARD of /GRPCOM/
|
||
|
|
C -- Uses ICURDV, DEVOK, DEVCOD, AUTOPL of /GRPCOM/
|
||
|
|
|
||
|
|
C --Routines Called:
|
||
|
|
C -- FREFLD - (SUPES) Free-field reader
|
||
|
|
C -- SQZSTR - (STRLIB) Compress extra blanks
|
||
|
|
C -- PLTBEL - (PLT) Ring bell
|
||
|
|
C -- PLTFLU - (PLT) Flush buffer
|
||
|
|
C -- PLTMOV - (PLT) Move cursor
|
||
|
|
C -- PLTWAI - (PLT) Wait until key is pressed
|
||
|
|
C -- GRABRT - (GRPLIB) Check for plot set abort
|
||
|
|
C -- GRIKEY - (GRPLIB) Select cursor position
|
||
|
|
C -- GRSDEV - (GRPLIB) Select device
|
||
|
|
C -- GRSNAP - (GRPLIB) Handle device frame snapping
|
||
|
|
|
||
|
|
PARAMETER (MXTEXT = 80)
|
||
|
|
|
||
|
|
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
|
||
|
|
|
||
|
|
LOGICAL MAYQUI, MAYTXT, GOBCK
|
||
|
|
|
||
|
|
LOGICAL GRABRT
|
||
|
|
LOGICAL REQWAI, ASKQUI, ASKHRD, ASKTXT, REPEAT
|
||
|
|
CHARACTER*80 PROMPT
|
||
|
|
CHARACTER REPLY
|
||
|
|
|
||
|
|
LOGICAL LSTERR
|
||
|
|
|
||
|
|
INTEGER NTEXT
|
||
|
|
LOGICAL CTEXT(MXTEXT)
|
||
|
|
REAL XTEXT(MXTEXT), YTEXT(MXTEXT)
|
||
|
|
CHARACTER*80 TEXT(MXTEXT)
|
||
|
|
SAVE NTEXT, CTEXT, XTEXT, YTEXT, TEXT
|
||
|
|
|
||
|
|
C --If end of hardcopy plot, add any text
|
||
|
|
|
||
|
|
IF (ISHARD) THEN
|
||
|
|
DO 100 I = 1, NTEXT
|
||
|
|
IF (CTEXT(I)) THEN
|
||
|
|
CALL GRTEXC (XTEXT(I), YTEXT(I), TEXT(I))
|
||
|
|
ELSE
|
||
|
|
CALL GRTEXT (XTEXT(I), YTEXT(I), TEXT(I))
|
||
|
|
END IF
|
||
|
|
100 CONTINUE
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C --End plot and snap frames
|
||
|
|
|
||
|
|
CALL GRSNAP ('STOP', 0)
|
||
|
|
|
||
|
|
C --Flush the buffer and ring bell and (on some devices) wait for key
|
||
|
|
|
||
|
|
IF (GRABRT ()) RETURN 2
|
||
|
|
CALL PLTMOV (0.0, 0.0)
|
||
|
|
CALL PLTFLU
|
||
|
|
CALL PLTBEL
|
||
|
|
CALL PLTFLU
|
||
|
|
REQWAI = (.NOT. AUTOPL(ICURDV)) .AND. (DEVCOD(ICURDV) .EQ. 'WAIT')
|
||
|
|
IF (REQWAI) THEN
|
||
|
|
CALL PLTWAI
|
||
|
|
CALL PLTFLU
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C --If end of hardcopy plot, reselect terminal device and return
|
||
|
|
|
||
|
|
IF (ISHARD) THEN
|
||
|
|
CALL GRSDEV (0)
|
||
|
|
ISHARD = .FALSE.
|
||
|
|
RETURN
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C --Reset the text lines
|
||
|
|
NTEXT = 0
|
||
|
|
DX = 1.0 / 2
|
||
|
|
DY = 0.75 / 2
|
||
|
|
|
||
|
|
C.. If a single plot, or the last plot in the set, don't prompt,
|
||
|
|
C return immediately to prompt.
|
||
|
|
ASKQUI = NDONE .LT. NTOTAL .AND. MAYQUI
|
||
|
|
|
||
|
|
ASKHRD = DEVOK(2) .AND. (ICURDV .NE. 2)
|
||
|
|
C.. Only ask for text if the hardcopy or multiple plot prompting enabled
|
||
|
|
ASKTXT = (ASKHRD .OR. ASKQUI) .AND. MAYTXT
|
||
|
|
|
||
|
|
IF ((.NOT. AUTOPL(ICURDV))
|
||
|
|
& .AND. (ASKQUI .OR. ASKHRD .OR. ASKTXT)) THEN
|
||
|
|
|
||
|
|
C --Check if user wants to quit or get hardcopy
|
||
|
|
|
||
|
|
LSTERR = .FALSE.
|
||
|
|
|
||
|
|
PROMPT = 'Enter'
|
||
|
|
LPR = LENSTR (PROMPT) + 1
|
||
|
|
IF (ASKQUI) THEN
|
||
|
|
PROMPT(LPR+1:) = '"Q" to quit,'
|
||
|
|
LPR = LENSTR (PROMPT) + 1
|
||
|
|
END IF
|
||
|
|
IF (gobck) THEN
|
||
|
|
gobck = .false.
|
||
|
|
if (ndone .gt. 1) then
|
||
|
|
PROMPT(LPR+1:) = '"P" for previous,'
|
||
|
|
LPR = LENSTR (PROMPT) + 1
|
||
|
|
end if
|
||
|
|
END IF
|
||
|
|
IF (ASKHRD) THEN
|
||
|
|
PROMPT(LPR+1:) = '"H" for hardcopy,'
|
||
|
|
LPR = LENSTR (PROMPT) + 1
|
||
|
|
END IF
|
||
|
|
IF (ASKTXT) THEN
|
||
|
|
PROMPT(LPR+1:) = '"T" for text,'
|
||
|
|
LPR = LENSTR (PROMPT) + 1
|
||
|
|
END IF
|
||
|
|
PROMPT(LPR+1:) = '" " to continue'
|
||
|
|
LPR = LENSTR (PROMPT) + 1
|
||
|
|
|
||
|
|
110 CONTINUE
|
||
|
|
|
||
|
|
C --Prompt for response, print trailing bell only if last response
|
||
|
|
C --was in error
|
||
|
|
|
||
|
|
IF (LSTERR) THEN
|
||
|
|
PROMPT(LPR+1:LPR+1) = CHAR(7)
|
||
|
|
LPR = LPR + 1
|
||
|
|
END IF
|
||
|
|
CALL FREFLD (0, 0, PROMPT(:LPR), 1,
|
||
|
|
& IOSTAT, NUMFLD, INTYP, REPLY, IDUM, RDUM)
|
||
|
|
IF (LSTERR) LPR = LPR - 1
|
||
|
|
|
||
|
|
LSTERR = .FALSE.
|
||
|
|
REPEAT = .FALSE.
|
||
|
|
|
||
|
|
IF (REPLY .EQ. 'Q') THEN
|
||
|
|
IF (ASKQUI) THEN
|
||
|
|
C --Quit
|
||
|
|
RETURN 2
|
||
|
|
END IF
|
||
|
|
|
||
|
|
ELSE IF (REPLY .EQ. 'H') THEN
|
||
|
|
IF (ASKHRD) THEN
|
||
|
|
C --Request hardcopy, select hardcopy, set flag, and return
|
||
|
|
CALL GRSDEV (2)
|
||
|
|
ISHARD = .TRUE.
|
||
|
|
RETURN 1
|
||
|
|
ELSE
|
||
|
|
REPEAT = .TRUE.
|
||
|
|
END IF
|
||
|
|
|
||
|
|
ELSE IF (REPLY .EQ. 'P') THEN
|
||
|
|
GOBCK = .TRUE.
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
ELSE IF (REPLY .EQ. 'T') THEN
|
||
|
|
IF (ASKTXT .AND. (NTEXT .LT. MXTEXT)) THEN
|
||
|
|
|
||
|
|
C --Input position and text string
|
||
|
|
|
||
|
|
CALL GRIKEY (
|
||
|
|
& ' Select text position ("C" to center) ...',
|
||
|
|
& DX, DY, REPLY, *120)
|
||
|
|
|
||
|
|
C --Write line to correct problem with cursor input followed
|
||
|
|
C --by GETINP or FREFLD
|
||
|
|
WRITE (*, *)
|
||
|
|
|
||
|
|
IF (REPLY .EQ. 'C') THEN
|
||
|
|
CALL GETINP (0, 0, ' Text to center> ',
|
||
|
|
& TEXT(NTEXT+1), IOSTAT)
|
||
|
|
ELSE
|
||
|
|
CALL GETINP (0, 0, ' Text> ',
|
||
|
|
& TEXT(NTEXT+1), IOSTAT)
|
||
|
|
END IF
|
||
|
|
WRITE (*, *)
|
||
|
|
|
||
|
|
IF (TEXT(NTEXT+1) .NE. ' ') THEN
|
||
|
|
NTEXT = NTEXT + 1
|
||
|
|
CTEXT(NTEXT) = (REPLY .EQ. 'C')
|
||
|
|
XTEXT(NTEXT) = DX
|
||
|
|
YTEXT(NTEXT) = DY
|
||
|
|
|
||
|
|
C --Display text string on device
|
||
|
|
|
||
|
|
IF (CTEXT(NTEXT)) THEN
|
||
|
|
CALL GRTEXC (XTEXT(NTEXT), YTEXT(NTEXT),
|
||
|
|
& TEXT(NTEXT))
|
||
|
|
ELSE
|
||
|
|
CALL GRTEXT (XTEXT(NTEXT), YTEXT(NTEXT),
|
||
|
|
& TEXT(NTEXT))
|
||
|
|
END IF
|
||
|
|
CALL PLTFLU
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
|
||
|
|
REPEAT = .TRUE.
|
||
|
|
|
||
|
|
ELSE IF (REPLY .NE. ' ') THEN
|
||
|
|
LSTERR = .TRUE.
|
||
|
|
REPEAT = .TRUE.
|
||
|
|
END IF
|
||
|
|
|
||
|
|
IF (REPEAT) GOTO 110
|
||
|
|
ELSE
|
||
|
|
if (gobck) gobck = .false.
|
||
|
|
END IF
|
||
|
|
|
||
|
|
IF (AUTOPL(ICURDV) .AND. (NTOTAL .GT. 0)) THEN
|
||
|
|
WRITE (PROMPT, 10000, IOSTAT=IDUM) NDONE, NTOTAL
|
||
|
|
10000 FORMAT (4X, 'Plot ', I5, ' of ', I5)
|
||
|
|
CALL SQZSTR (PROMPT, LSTR)
|
||
|
|
WRITE (*, '(1X, A)') PROMPT(:LSTR)
|
||
|
|
END IF
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
120 CONTINUE
|
||
|
|
return 2
|
||
|
|
END
|