Initial commit

1 files changed, 79 insertions, 0 deletions

diff --git a/sys/gio/ncarutil/autograph/agctcs.f b/sys/gio/ncarutil/autograph/agctcs.f
new file mode 100644
index 00000000..d9f67d5f
--- /dev/null
+++ b/sys/gio/ncarutil/autograph/agctcs.f
@@ -0,0 +1,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