File: grgfil.f

package info (click to toggle)
pgplot5 5.2-8
  • links: PTS
  • area: non-free
  • in suites: slink
  • size: 6,268 kB
  • ctags: 5,900
  • sloc: fortran: 37,938; ansic: 18,809; sh: 1,136; objc: 532; perl: 443; makefile: 271; pascal: 233; tcl: 178; awk: 51; csh: 25
file content (95 lines) | stat: -rw-r--r-- 2,768 bytes parent folder | download | duplicates (15)
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