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
|
C
C
C +-----------------------------------------------------------------+
C | |
C | Copyright (C) 1986 by UCAR |
C | University Corporation for Atmospheric Research |
C | All Rights Reserved |
C | |
C | NCARGRAPHICS Version 1.00 |
C | |
C +-----------------------------------------------------------------+
C
C
C ---------------------------------------------------------------------
C
SUBROUTINE AGCTCS (TPID,ITCS)
C
CHARACTER*(*) TPID
C
C The routine AGCTCS is called by the routines AGGETC and AGSETC to
C check what type of character-string parameter is implied by the
C parameter identifier TPID and return an appropriate value of ITCS, as
C follows:
C
C -- ITCS = 0 implies that the parameter is not intrinsically of type
C character and that AGGETC/AGSETC should not have been called in
C the way that it was.
C
C -- ITCS = 1 implies a dash-pattern parameter.
C
C -- ITCS = 2 implies a label name.
C
C -- ITCS = 3 implies the line-end character.
C
C -- ITCS = 4 implies the text of some line of some label.
C
C Find out where in the parameter list the requested parameter lies.
C
CALL AGSCAN (TPID,LOPA,NIPA,IIPA)
C
C See if it's a dash pattern.
C
CALL AGSCAN ('DASH/PATT.',LODP,NIDP,IIDP)
IF (LOPA.GE.LODP.AND.LOPA.LE.LODP+NIDP-1) THEN
ITCS=1
RETURN
END IF
C
C See if it's a label name.
C
CALL AGSCAN ('LABE/NAME.',LOLN,NILN,IILN)
IF (LOPA.EQ.LOLN) THEN
ITCS=2
RETURN
END IF
C
C See if it's the line-end character.
C
CALL AGSCAN ('LINE/END .',LOLE,NILE,IILE)
IF (LOPA.EQ.LOLE) THEN
ITCS=3
RETURN
END IF
C
C See if it's the text of some label line.
C
CALL AGSCAN ('LINE/BUFF/CONT.',LOLB,NILB,IILB)
IF (LOPA.GE.LOLB.AND.LOPA.LE.LOLB+NILB-1.AND.
+ MOD(LOPA-LOLB,6).EQ.3) THEN
ITCS=4
RETURN
END IF
C
C Error - type not recognizable.
C
ITCS=0
RETURN
C
END
|
