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