1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95
|
C*GRGFIL -- find data file -- PC version
C+
SUBROUTINE GRGFIL(TYPE, NAME)
CHARACTER*(*) TYPE, NAME
C
C This routine encsapsulates the algorithm for finding the PGPLOT
C run-time data files.
C
C 1. The binary font file: try the following in order:
C file specified by PGPLOT_FONT
C file "grfont.dat" in directory specified by PGPLOT_DIR
C (with or without '\' appended)
C file "grfont.dat" in directory C:\PGPLOT\
C
C 2. The color-name database: try the following in order:
C file specified by PGPLOT_RGB
C file "rgb.txt" in directory specified by PGPLOT_DIR
C (with or without '\' appended)
C file "rgb.txt" in directory C:\PGPLOT\
C
C Arguments:
C TYPE (input) : either 'FONT' or 'RGB' to request the corresponding
C file.
C NAME (output) : receives the file name.
C--
C 2-Dec-1994 - new routine [TJP].
C 30-Apr-1996 - PC version, default C:\PGPLOT\, '\' [PAS]
C-----------------------------------------------------------------------
CHARACTER*(*) DEFDIR, DEFFNT, DEFRGB
PARAMETER (DEFDIR='C:\PGPLOT\')
PARAMETER (DEFFNT='grfont.dat')
PARAMETER (DEFRGB='rgb.txt')
CHARACTER*255 FF
CHARACTER*16 DEFLT
INTEGER I, L, LD
LOGICAL TEST, DEBUG
C
C Is debug output requested?
C
CALL GRGENV('DEBUG', FF, L)
DEBUG = L.GT.0
C
C Which file?
C
IF (TYPE.EQ.'FONT') THEN
DEFLT = DEFFNT
LD = LEN(DEFFNT)
ELSE IF (TYPE.EQ.'RGB') THEN
DEFLT = DEFRGB
LD = LEN(DEFRGB)
ELSE
CALL GRWARN('Internal error in routine GRGFIL')
END IF
C
C Try each possibility in turn.
C
DO 10 I=1,4
IF (I.EQ.1) THEN
CALL GRGENV(TYPE, FF, L)
ELSE IF (I.EQ.2) THEN
CALL GRGENV('DIR', FF, L)
IF (L.GT.0) THEN
FF(L+1:) = DEFLT
L = L+LD
END IF
ELSE IF (I.EQ.3) THEN
CALL GRGENV('DIR', FF, L)
IF (L.GT.0) THEN
FF(L+1:L+1) = '\'
FF(L+2:) = DEFLT
L = L+1+LD
END IF
ELSE IF (I.EQ.4) THEN
FF = DEFDIR//DEFLT
L = LEN(DEFDIR)+LD
END IF
IF (L.GT.0) THEN
IF (DEBUG) THEN
CALL GRWARN('Looking for '//FF(:L))
END IF
INQUIRE (FILE=FF(:L), EXIST=TEST)
IF (TEST) THEN
NAME = FF(:L)
RETURN
ELSE IF (DEBUG) THEN
CALL GRWARN('WARNING: file not found')
END IF
END IF
10 CONTINUE
C
C Failed to find the file.
C
NAME = DEFLT
C-----------------------------------------------------------------------
END
|