1      include 'flib.fi'
2C*GRDATE -- get date and time as character string (MS-DOS)
3C+
4      SUBROUTINE GRDATE(CDATE, LDATE)
5      include 'flib.fd'
6      CHARACTER CDATE*(17)
7      INTEGER   LDATE
8C
9C Return the current date and time, in format 'dd-Mmm-yyyy hh:mm'.
10C To receive the whole string, the CDATE should be declared
11C CHARACTER*17.
12C
13C Arguments:
14C  CDATE : receives date and time, truncated or extended with
15C           blanks as necessary.
16C  L      : receives the number of characters in STRING, excluding
17C           trailing blanks. This will always be 17, unless the length
18C           of the string supplied is shorter.
19C--
20C 1989-Mar-17 - [AFT]
21C 12/1993 C. T. Dum MS Power Station F32 Version
22C-----------------------------------------------------------------------
23      CHARACTER CMON(12)*3
24      INTEGER*2 IHR, IMIN, ISEC, I100TH
25      INTEGER*2 IYR, IMON, IDAY
26      DATA CMON/'Jan','Feb','Mar','Apr','May','Jun',
27     :          'Jul','Aug','Sep','Oct','Nov','Dec'/
28C---
29      CALL GETTIM(IHR, IMIN, ISEC, I100TH)
30      CALL GETDAT(IYR, IMON, IDAY)
31      WRITE(CDATE,111) IDAY,CMON(IMON),IYR,IHR,IMIN
32  111 FORMAT(I2,'-',A3,'-',I4,' ',I2,':',I2)
33      LDATE=17
34      RETURN
35      END
36
37C*GRFLUN -- free a Fortran logical unit number (MS-DOS)
38C+
39      SUBROUTINE GRFLUN(LUN)
40      INTEGER LUN
41C
42C Free a Fortran logical unit number allocated by GRGLUN. [This version
43C is pretty stupid; GRGLUN allocates units starting at 81, and GRFLUN
44C does not free units.]
45C
46C Arguments:
47C  LUN    : the logical unit number to free.
48C--
49C 25-Nov-1988
50C-----------------------------------------------------------------------
51      RETURN
52      END
53C*GRGCOM -- read with prompt from user's terminal (MS-DOS)
54C+
55      INTEGER FUNCTION GRGCOM(CREAD, CPROM, LREAD)
56      CHARACTER CREAD*(*), CPROM*(*)
57      INTEGER   LREAD
58C
59C Issue prompt and read a line from the user's terminal; in VMS,
60C this is equivalent to LIB$GET_COMMAND.
61C
62C Arguments:
63C  CREAD : (output) receives the string read from the terminal.
64C  CPROM : (input) prompt string.
65C  LREAD : (output) length of CREAD.
66C
67C Returns:
68C  GRGCOM : 1 if successful, 0 if an error occurs (e.g., end of file).
69C--
70C 1989-Mar-29
71ctd 3/95:len_trim (MS Fortran)
72C-----------------------------------------------------------------------
73      INTEGER IER
74C---
75   11 FORMAT(A)
76C---
77      GRGCOM = 0
78      LREAD = 0
79      WRITE (*, 101, IOSTAT=IER) CPROM
80  101 FORMAT(1X,A,\)
81      IF (IER.EQ.0) READ (*, 11, IOSTAT=IER) CREAD
82      IF (IER.EQ.0) GRGCOM = 1
83      LREAD = LEN_TRIM(CREAD)
84      RETURN
85      END
86C*GRGENV -- get value of PGPLOT environment parameter (MS-DOS)
87C+
88      SUBROUTINE GRGENV(CNAME, CVALUE, LVALUE)
89      include 'flib.fd'
90      CHARACTER CNAME*(*), CVALUE*(*)
91      INTEGER   LVALUE
92C
93C Return the value of a PGPLOT environment parameter.
94C
95C Arguments:
96C CNAME   : (input) the name of the parameter to evaluate.
97C CVALUE  : receives the value of the parameter, truncated or extended
98C           with blanks as necessary. If the parameter is undefined,
99C           a blank string is returned.
100C LVALUE  : receives the number of characters in CVALUE, excluding
101C           trailing blanks. If the parameter is undefined, zero is
102C           returned.
103C--
104C 1990-Mar-19 - [AFT]
105C 12/93;3/95 CTD F32
106C-----------------------------------------------------------------------
107C
108      CHARACTER*80 CTMP,CTEMP
109      INTEGER LTMP
110      CTMP = 'PGPLOT_'//CNAME
111      LTMP = INDEX(CTMP,' ')
112      LVALUE=GETENVQQ(CTMP(:LTMP-1),CTEMP)
113      IF(LVALUE.NE.0)THEN
114       CVALUE = CTEMP(:LVALUE)
115      ELSE
116       CVALUE = ' '
117      ENDIF
118      RETURN
119      END
120C*GRGLUN -- get a Fortran logical unit number (MS-DOS)
121C+
122      SUBROUTINE GRGLUN(LUN)
123      INTEGER LUN
124C
125C Get an unused Fortran logical unit number.
126C Returns a Logical Unit Number that is not currently opened.
127C After GRGLUN is called, the unit should be opened to reserve
128C the unit number for future calls.  Once a unit is closed, it
129C becomes free and another call to GRGLUN could return the same
130C number.  Also, GRGLUN will not return a number in the range 1-9
131C as older software will often use these units without warning.
132C
133C Arguments:
134C  LUN    : receives the logical unit number, or -1 on error.
135C--
136C 12-Feb-1989 [AFT/TJP].
137C-----------------------------------------------------------------------
138      INTEGER I
139      LOGICAL QOPEN
140C---
141      DO 10 I=99,10,-1
142          INQUIRE (UNIT=I,  OPENED=QOPEN)
143          IF (.NOT.QOPEN) THEN
144              LUN = I
145              RETURN
146          END IF
147   10 CONTINUE
148      CALL GRWARN('GRGLUN: out of units.')
149      LUN = -1
150      RETURN
151      END
152C*GRLGTR -- translate logical name (MS-DOS)
153C+
154      SUBROUTINE GRLGTR (CNAME)
155      CHARACTER CNAME*(*)
156C
157C Recursive translation of a logical name.
158C Up to 20 levels of equivalencing can be handled.
159C This is used in the parsing of device specifications in the
160C VMS implementation of PGPLOT. In other implementations, it may
161C be replaced by a null routine.
162C
163C Argument:
164C  CNAME (input/output): initially contains the name to be
165C       inspected.  If an equivalence is found it will be replaced
166C       with the new name. If not, the old name will be left there. The
167C       escape sequence at the beginning of process-permanent file
168C       names is deleted and the '_' character at the beginning of
169C       device names is left in place.
170C--
171C 18-Feb-1988
172C-----------------------------------------------------------------------
173      RETURN
174      END
175
176C*GROPTX -- open output text file [MS-DOS]
177C+
178      INTEGER FUNCTION GROPTX (UNIT, NAME, DEFNAM, MODE)
179      INTEGER UNIT,MODE
180      CHARACTER*(*) NAME,DEFNAM
181C
182C Input:
183C  UNIT : Fortran unit number to use
184C  NAME : name of file to create
185C  DEFNAM : default file name (used to fill in missing fields for VMS)
186C
187C Returns:
188C  0 => success; any other value => error.
189C-----------------------------------------------------------------------
190      INTEGER IER
191      OPEN (UNIT=UNIT, FILE=NAME, STATUS='UNKNOWN', IOSTAT=IER)
192      GROPTX = IER
193      RETURN
194C-----------------------------------------------------------------------
195      END
196C*GRTRML -- get name of user's terminal (MS-DOS)
197C+
198      SUBROUTINE GRTRML(CTERM, LTERM)
199      CHARACTER CTERM*(*)
200      INTEGER   LTERM
201C
202C Return the device name of the user's terminal, if any.
203C
204C Arguments:
205C  CTERM : receives the terminal name, truncated or extended with
206C           blanks as necessary.
207C  LTERM : receives the number of characters in CTERM, excluding
208C           trailing blanks. If there is not attached terminal,
209C           zero is returned.
210C--
211C 1989-Nov-08
212C-----------------------------------------------------------------------
213      CTERM = 'CON'
214      LTERM = 3
215      RETURN
216      END
217C*GRTTER -- test whether device is user's terminal (MS-DOS)
218C+
219      SUBROUTINE GRTTER(CDEV, QSAME)
220      CHARACTER CDEV*(*)
221      LOGICAL   QSAME
222C
223C Return a logical flag indicating whether the supplied device
224C name is a name for the user's controlling terminal or not.
225C (Some PGPLOT programs wish to take special action if they are
226C plotting on the user's terminal.)
227C
228C Arguments:
229C  CDEV : (input) the device name to be tested.
230C  QSAME   : (output) .TRUE. is CDEV contains a valid name for the
231C           user's terminal; .FALSE. otherwise.
232C--
233C 18-Feb-1988
234C-----------------------------------------------------------------------
235      CHARACTER CTERM*64
236      INTEGER   LTERM
237C
238      CALL GRTRML(CTERM, LTERM)
239      QSAME = (CDEV.EQ.CTERM(:LTERM))
240      RETURN
241      END
242
243C*GRUSER -- get user name (MS-DOS)
244C+
245      SUBROUTINE GRUSER(CUSER, LUSER)
246      CHARACTER CUSER*(*)
247      INTEGER   LUSER
248C
249C Return the name of the user running the program.
250C
251C Arguments:
252C  CUSER  : receives user name, truncated or extended with
253C           blanks as necessary.
254C  LUSER  : receives the number of characters in VALUE, excluding
255C           trailing blanks.
256C--
257C 1989-Mar-19 - [AFT]
258C-----------------------------------------------------------------------
259C
260      CALL GRGENV('USER', CUSER, LUSER)
261      RETURN
262      END
263