
                               					 7-Jan-1983 13:28:33	VAX-11 FORTRAN V3.1-23              Page   1
								 4-Jan-1983 14:33:17	SYS$SYSROOT:[CAMAC.CTS]CTS.FOR;54           

0001    C+++
0002    C	CTS - the CAMAC Topology Supervisor
0003    C
0004    C This program maintains a data base of logical names and their physical CAMAC
0005    C device equivalents.  The data base is a single index file with two keys.  The
0006    C primary key is in logical name order.  The secondary key is in CAMAC device
0007    C specifier order, with duplicates and changes permitted.
0008    C
0009    C The following commands are understood:
0010    C
0011    C	ASSIGN		creates a logical name - physical device equivalence
0012    C
0013    C	AUTOCONFIGURE	recreates equivalences
0014    C
0015    C	DEASSIGN	deletes an equivalence
0016    C
0017    C	EXIT		terminates the program
0018    C
0019    C	HELP		provides on-line help on the use of this program
0020    C
0021    C	MODIFY		modifies equivalences
0022    C
0023    C	SET		sets a CAMAC support unit (crate) on- or off-line,
0024    C			enables/disables LAM support
0025    C
0026    C	SHOW		lists equivalences
0027    C
0028    C
0029    C Source modules:
0030    C
0031    C	CTS.FOR		main routine, plus autoconfigure, exit and help
0032    C			commands;  report & get_keyword_val utility routines
0033    C
0034    C	CTSASSIGN.FOR	assign command
0035    C
0036    C	CTSDEASGN.FOR	deassign command
0037    C
0038    C	CTSMODIFY.FOR	modify command
0039    C
0040    C	CTSSET.FOR	set command
0041    C
0042    C	CTSSHOW.FOR	show command
0043    C
0044    C	CTSUSROPN.MAR	user open routine to set database file protection
0045    C
0046    C	CTSCLD.CLD	command language definition source file
0047    C
0048    C	CTSHELP.HLP	help text source file
0049    C
0050    C
0051    C Compilation and Link Requirements:
0052    C
0053    C	FOR CTS, CTSASSIGN, CTSDEASGN, CTSMODIFY, CTSSET, CTSSHOW
0054    C
0055    C	MAC CTSUSROPN
0056    C
0057    C	SET COMMAND/OBJ CTSCLD

                               					 7-Jan-1983 13:28:33	VAX-11 FORTRAN V3.1-23              Page   2
								 4-Jan-1983 14:33:17	SYS$SYSROOT:[CAMAC.CTS]CTS.FOR;54           

0058    C
0059    C	LINK/NOTRACEBACK CTS, CTSASSIGN, CTSDEASGN, CTSMODIFY, CTSSET, -
0060    C	CTSSHOW, CTSUSROPN, CTSCLD, WCCOPY, WCMATCH, SYS$LIBRARY:CAMLIB/LIB
0061    C
0062    C	LIBRARY/HELP SYS$LIBRARY:CTS CTSHELP
0063    C
0064    C CTS must be installed with SYSPRV, SYSNAM and PHY_IO privleges
0065    C
0066    C
0067    C Revision History
0068    C   Date	By		Comments
0069    C  9/01/82	D.E. Greenwood	Original
0070    C 10/07/82	D.E.Greenwood	^Z treated like EXIT cmd; LAM enable/disable
0071    C				moved to SET cmd; SET cmd source moved to
0072    C				separate module (CTSSET); subroutine
0073    C				GET_KEYWORD_VAL added
0074    C 10/08/82	D.E.Greenwood	Correction to GET_KEYWORD_VAL to return the
0075    C				last value of the legal value string correctly
0076    C  1/04/83	D.E.Greenwood	AUTOCONFIGURE allows list of match specs, full
0077    C				wildcards, logical or physical specifications;
0078    C				REPORT takes second argument
0079    C
0080    C---

                               					 7-Jan-1983 13:28:33	VAX-11 FORTRAN V3.1-23              Page   3
								 4-Jan-1983 14:33:17	SYS$SYSROOT:[CAMAC.CTS]CTS.FOR;54           

0081    C Main routine
0082    C
0083    	PARAMETER FILENAME='SYS$SYSTEM:SYSCAMAC.DAT'
0084    	CHARACTER*80 A
0085    	EXTERNAL CTSUSROPN, CAMAC_EQUIVALENCES
0086    	INTEGER*4 CMD_LEN,FRGN_CMD_LEN
0087    	INTEGER*4 CLI$DCL_PARSE, LIB$GET_INPUT
0088    C
0089    C Create (if necessary) and open the file containing the equivalences.
0090    C
0091    	OPEN (1, FILE=FILENAME, ACCESS='KEYED', ERR=1000, FORM='UNFORMATTED',
0092    	1	ORGANIZATION='INDEXED', RECL=30,  SHARED, STATUS='OLD')
0093    	GOTO 10000
0094    C
0095    1000	TYPE *, '%CTS-I-CREAT, creating new ',FILENAME,' file'
0096    	OPEN (1, FILE=FILENAME, ACCESS='KEYED', FORM='UNFORMATTED',
0097    	1	ORGANIZATION='INDEXED', RECL=30, SHARED, STATUS='NEW',
0098    	2	KEY=(1:32:CHARACTER,37:47:CHARACTER), USEROPEN=CTSUSROPN)
0099    C
0100    C Get and parse the command string.  Then dispatch to the appropriate subroutine.
0101    C If a foreign command string was entered, we'll execute that command only and
0102    C then exit.  Else, we'll continue to prompt for commands until the EXIT
0103    C command (or ^Z) is entered.
0104    C
0105    10000	CALL LIB$GET_FOREIGN(A,,FRGN_CMD_LEN)
0106    	IF (FRGN_CMD_LEN .GT. 0) GOTO 10200
0107    C
0108    10100	IF (.NOT. LIB$GET_INPUT(A,'CTS> ',CMD_LEN)) CALL DONE
0109    	IF (CMD_LEN .EQ. 0) GOTO 10100
0110    C
0111    10200	IF (.NOT. CLI$DCL_PARSE(A,CAMAC_EQUIVALENCES) .AND. 1) GOTO 10100
0112    	CALL CLI$DISPATCH
0113    	IF (FRGN_CMD_LEN .EQ. 0) GOTO 10100
0114    	CALL DONE
0115    C
0116    	END

CTS$MAIN                       					 7-Jan-1983 13:28:33	VAX-11 FORTRAN V3.1-23              Page   4
								 4-Jan-1983 14:33:17	SYS$SYSROOT:[CAMAC.CTS]CTS.FOR;54           

PROGRAM SECTIONS

    Name				 Bytes   Attributes

  0 $CODE                                  152   PIC CON REL LCL   SHR   EXE   RD NOWRT LONG
  1 $PDATA                                  62   PIC CON REL LCL   SHR NOEXE   RD NOWRT LONG
  2 $LOCAL                                 300   PIC CON REL LCL NOSHR NOEXE   RD   WRT LONG

    Total Space Allocated                  514


ENTRY POINTS

    Address  Type  Name          

  0-00000000       CTS$MAIN      


VARIABLES

    Address  Type  Name              Address  Type  Name              Address  Type  Name          

  2-00000000  CHAR A               2-00000050  I*4  CMD_LEN         2-00000054  I*4  FRGN_CMD_LEN  


LABELS

    Address   Label       Address   Label       Address   Label       Address   Label   

  0-00000016  1000      0-0000004D  10000     0-0000005B  10100     0-00000072  10200   


FUNCTIONS AND SUBROUTINES REFERENCED

  Type  Name                              Type  Name                              Type  Name                            

        CAMAC_EQUIVALENCES                 I*4  CLI$DCL_PARSE                           CLI$DISPATCH                    
        CTSUSROPN                               DONE                                    FOR$OPEN                        
        LIB$GET_FOREIGN                    I*4  LIB$GET_INPUT                   

                               					 7-Jan-1983 13:28:33	VAX-11 FORTRAN V3.1-23              Page   5
								 4-Jan-1983 14:33:17	SYS$SYSROOT:[CAMAC.CTS]CTS.FOR;54           

0001    C AUTOCONFIGURE command
0002    C
0003    C This subroutine reassigns the CAMAC logical names, based on the data base.
0004    C The normal use for this subroutine is to recreate all CAMAC logical name
0005    C equivalences each time VMS is reloaded.
0006    C
0007    	SUBROUTINE AUTO
0008    C
0009    	CHARACTER MATCH*32, MIN_MATCH*32, PHY_SPEC*32, TEMP_STR*2
0010    	INTEGER*2 LOG_LEN, MATCH_LEN, MIN_MATCH_LEN,
0011         &		PHY_SPEC_LEN, PRCNT_LOC, STAR_LOC
0012    	INTEGER*4 ISTAT
0013    	INTEGER*4 CLI$GET_VALUE, CLI$PRESENT, SYS$CRELOG, WCMATCH
0014    C
0015    	INCLUDE 'CTSDEF'
0058    	INCLUDE '($SSDEF)'
0449    C
0450    C
0451    C Get the (next) match specification and the minimum number of characters
0452    C required to match.
0453    C
0454    100	IF (.NOT. CLI$GET_VALUE('NAME',MATCH)) RETURN
0455    	CALL STR$UPCASE(MATCH,MATCH)
0456    	CALL STR$TRIM(MATCH,MATCH,MATCH_LEN)
0457    	STAR_LOC = INDEX(MATCH,'*')
0458    	PRCNT_LOC = INDEX(MATCH,'%')
0459    	MIN_MATCH_LEN = MATCH_LEN
0460    	IF (STAR_LOC .GT. 0) MIN_MATCH_LEN = STAR_LOC - 1
0461    	IF (PRCNT_LOC .GT. 0 .AND. PRCNT_LOC-1 .LT. MIN_MATCH_LEN)
0462         &		MIN_MATCH_LEN = PRCNT_LOC - 1
0463    	MIN_MATCH = MATCH(1:MIN_MATCH_LEN)
0464    	IF (MIN_MATCH_LEN .EQ. 0) MIN_MATCH = ' '
0465    C
0466    C Determine the sorting order (logical name order, unless "/physical" was
0467    C specified.
0468    C
0469    	IF (CLI$PRESENT('PHYSICAL')) GOTO 2000
0470    C
0471    C Select assignments in logical name order.
0472    C
0473    1000	READ (1,KEYGE=MIN_MATCH,KEYID=0,ERR=89000) CAMDEF_RECORD
0474    	UNLOCK 1
0475    C
0476    	DO WHILE (MIN_MATCH_LEN .EQ. 0 .OR.
0477         &		LOGICAL_NAME(1:MIN_MATCH_LEN) .EQ. MIN_MATCH)
0478    	  CALL STR$TRIM(LOGICAL_NAME,LOGICAL_NAME,LOG_LEN)
0479    	  IF (MATCH_LEN .EQ. 0 .OR.
0480         &		WCMATCH( MATCH(1:MATCH_LEN), LOGICAL_NAME(1:LOG_LEN))) THEN
0481    	    CALL MAKE_FULL_SPEC(CAMDEF_RECORD, PHY_SPEC, PHY_SPEC_LEN)
0482    	    ISTAT = SYS$CRELOG(%VAL(0), LOGICAL_NAME(1:LOG_LEN),
0483         &		PHY_SPEC(1:PHY_SPEC_LEN),)
0484    	    IF (ISTAT .NE. SS$_NORMAL)
0485         &		CALL REPORT('Error assigning '//LOGICAL_NAME(1:LOG_LEN)//': ',
0486         &		ISTAT)
0487    	  ENDIF
0488    	  READ (1,END=89000) CAMDEF_RECORD
0489    	  UNLOCK 1

AUTO                           					 7-Jan-1983 13:28:33	VAX-11 FORTRAN V3.1-23              Page   6
								 4-Jan-1983 14:33:17	SYS$SYSROOT:[CAMAC.CTS]CTS.FOR;54           

0490    	END DO
0491    C
0492    	GOTO 89000
0493    C
0494    C Choose assignments in physical specifier order.
0495    C
0496    2000	IF (MIN_MATCH_LEN .GT. 3) THEN			! This kludge req'd
0497    	    MIN_MATCH_LEN = 3				!  because crate may be
0498    	    MIN_MATCH(4:) = ' '				!  either 1 or 2 chars
0499    	ENDIF						!  long
0500    	READ (1,KEYGE=MIN_MATCH(1:11),KEYID=1,ERR=89000) CAMDEF_RECORD
0501    	UNLOCK 1
0502    C
0503    	DO WHILE (.TRUE.)
0504    	  CALL MAKE_SPECIFIER(CAMDEF_RECORD,PHY_SPEC)
0505    	  IF (MIN_MATCH_LEN .GT. 0 .AND.
0506         &		PHY_SPEC(1:MIN_MATCH_LEN) .GT. MIN_MATCH) GOTO 89000
0507    	  CALL STR$TRIM(PHY_SPEC,PHY_SPEC,PHY_SPEC_LEN)
0508    	  IF (MATCH_LEN .EQ. 0 .OR.
0509         &		WCMATCH(MATCH(1:MATCH_LEN),PHY_SPEC(1:PHY_SPEC_LEN))) THEN
0510    	    CALL MAKE_FULL_SPEC(CAMDEF_RECORD, PHY_SPEC, PHY_SPEC_LEN)
0511    	    ISTAT = SYS$CRELOG(%VAL(0),LOGICAL_NAME(1:LOG_NAM_LEN),
0512    	1	PHY_SPEC(1:PHY_SPEC_LEN),)
0513    	    IF (ISTAT .NE. SS$_NORMAL)
0514         &		CALL REPORT('Error assigning '//PHY_SPEC(1:PHY_SPEC_LEN)//': ',
0515         &		ISTAT)
0516    	  ENDIF
0517    	  READ (1,END=89000) CAMDEF_RECORD
0518    	  UNLOCK 1
0519    	END DO
0520    C
0521    89000	GOTO 100
0522    C
0523    	END

AUTO                           					 7-Jan-1983 13:28:33	VAX-11 FORTRAN V3.1-23              Page   7
								 4-Jan-1983 14:33:17	SYS$SYSROOT:[CAMAC.CTS]CTS.FOR;54           

PROGRAM SECTIONS

    Name				 Bytes   Attributes

  0 $CODE                                  736   PIC CON REL LCL   SHR   EXE   RD NOWRT LONG
  1 $PDATA                                  34   PIC CON REL LCL   SHR NOEXE   RD NOWRT LONG
  2 $LOCAL                                 544   PIC CON REL LCL NOSHR NOEXE   RD   WRT LONG

    Total Space Allocated                 1314


ENTRY POINTS

    Address  Type  Name          

  0-00000000       AUTO          


VARIABLES

    Address  Type  Name                                Address  Type  Name                            

  2-00000010  CHAR CAMDEF_RECORD                     2-00000045  CHAR COMMENT                         
  2-00000039  CHAR CR_COLON                          2-00000034  CHAR CSU                             
  2-00000036  CHAR CSU_CONTROLLER                    2-00000034  CHAR CSU_DEVICE                      
  2-000000EA  CHAR CSU_NAME                          2-00000037  CHAR CSU_UNIT                        
  2-000000FC  I*4  ISTAT                             2-00000010  CHAR LOGICAL_NAME                    
  2-000000F0  I*2  LOG_LEN                           2-00000100  I*4  LOG_NAM_LEN                     
  2-00000088  CHAR MATCH                             2-000000F2  I*2  MATCH_LEN                       
  2-000000A8  CHAR MIN_MATCH                         2-000000F4  I*2  MIN_MATCH_LEN                   
  2-000000C8  CHAR PHY_SPEC                          2-000000F6  I*2  PHY_SPEC_LEN                    
  2-00000000  I*4  PM_RUG                            2-00000004  I*4  PM_RUM                          
  2-0000000C  I*4  PM_STATION                        2-00000008  I*4  PM_UNIT                         
  2-000000F8  I*2  PRCNT_LOC                         2-0000003D  I*4  REF_UIC_GROUP                   
  2-00000041  I*4  REF_UIC_MEMBER                    2-00000034  CHAR SPECIFIER                       
  2-000000FA  I*2  STAR_LOC                          2-0000003A  CHAR STATION                         
  2-000000E8  CHAR TEMP_STR                        


ARRAYS

    Address  Type  Name                Bytes  Dimensions

  2-00000000  I*4  PHY_MOD                16  (4)


LABELS

    Address   Label       Address   Label       Address   Label       Address   Label   

  0-00000009  100           **      1000      0-000001A6  2000      0-000002DD  89000   

AUTO                           					 7-Jan-1983 13:28:33	VAX-11 FORTRAN V3.1-23              Page   8
								 4-Jan-1983 14:33:17	SYS$SYSROOT:[CAMAC.CTS]CTS.FOR;54           

FUNCTIONS AND SUBROUTINES REFERENCED

  Type  Name                              Type  Name                              Type  Name                            

   I*4  CLI$GET_VALUE                      I*4  CLI$PRESENT                        I*4  LIB$INDEX                       
        MAKE_FULL_SPEC                          MAKE_SPECIFIER                          REPORT                          
        STR$TRIM                                STR$UPCASE                         I*4  SYS$CRELOG                      
   I*4  WCMATCH                         

                               					 7-Jan-1983 13:28:33	VAX-11 FORTRAN V3.1-23              Page   9
								 4-Jan-1983 14:33:17	SYS$SYSROOT:[CAMAC.CTS]CTS.FOR;54           

0001    C EXIT command
0002    C
0003    C This subroutine closes the data base file and terminates the supervisor.
0004    C
0005    	SUBROUTINE DONE
0006    	CLOSE (1)
0007    	CALL EXIT
0008    	END

DONE                           					 7-Jan-1983 13:28:33	VAX-11 FORTRAN V3.1-23              Page  10
								 4-Jan-1983 14:33:17	SYS$SYSROOT:[CAMAC.CTS]CTS.FOR;54           

PROGRAM SECTIONS

    Name				 Bytes   Attributes

  0 $CODE                                   24   PIC CON REL LCL   SHR   EXE   RD NOWRT LONG
  2 $LOCAL                                   8   PIC CON REL LCL NOSHR NOEXE   RD   WRT LONG

    Total Space Allocated                   32


ENTRY POINTS

    Address  Type  Name          

  0-00000000       DONE          


FUNCTIONS AND SUBROUTINES REFERENCED

  Type  Name            Type  Name          

        FOR$CLOSE             FOR$EXIT      

                               					 7-Jan-1983 13:28:33	VAX-11 FORTRAN V3.1-23              Page  11
								 4-Jan-1983 14:33:17	SYS$SYSROOT:[CAMAC.CTS]CTS.FOR;54           

0001    C HELP command
0002    C
0003    C This subroutine calls the VMS help routines to provide the user with
0004    C information on how to use the supervisor
0005    C
0006    	SUBROUTINE HELP
0007    	CHARACTER*80 LINE
0008    	EXTERNAL LIB$PUT_OUTPUT,LIB$GET_INPUT
0009    	INTEGER*4 CLI$PRESENT,CLI$GET_VALUE,LBR$OUTPUT_HELP
0010    C
0011    	LINE = ' '
0012    	IF (CLI$PRESENT('TEXT')) CALL CLI$GET_VALUE('TEXT',LINE)
0013    	ISTAT=LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,LINE,
0014         &		'SYS$HELP:CTS',,LIB$GET_INPUT)
0015    	IF (.NOT. ISTAT) CALL LIB$SIGNAL(%VAL(ISTAT))
0016    	RETURN
0017    	END

HELP                           					 7-Jan-1983 13:28:33	VAX-11 FORTRAN V3.1-23              Page  12
								 4-Jan-1983 14:33:17	SYS$SYSROOT:[CAMAC.CTS]CTS.FOR;54           

PROGRAM SECTIONS

    Name				 Bytes   Attributes

  0 $CODE                                   64   PIC CON REL LCL   SHR   EXE   RD NOWRT LONG
  1 $PDATA                                  18   PIC CON REL LCL   SHR NOEXE   RD NOWRT LONG
  2 $LOCAL                                 164   PIC CON REL LCL NOSHR NOEXE   RD   WRT LONG

    Total Space Allocated                  246


ENTRY POINTS

    Address  Type  Name          

  0-00000000       HELP          


VARIABLES

    Address  Type  Name              Address  Type  Name          

  2-00000050  I*4  ISTAT           2-00000000  CHAR LINE          


FUNCTIONS AND SUBROUTINES REFERENCED

  Type  Name                              Type  Name                              Type  Name                            

        CLI$GET_VALUE                      I*4  CLI$PRESENT                        I*4  LBR$OUTPUT_HELP                 
        LIB$GET_INPUT                           LIB$PUT_OUTPUT                          LIB$SIGNAL                      

                               					 7-Jan-1983 13:28:33	VAX-11 FORTRAN V3.1-23              Page  13
								 4-Jan-1983 14:33:17	SYS$SYSROOT:[CAMAC.CTS]CTS.FOR;54           

0001    C REPORT - a utility subroutine for the supervisor
0002    C
0003    C This subroutine types an error message on SYS$OUTPUT.
0004    C
0005    C Calling Sequence:
0006    C
0007    C	CALL REPORT(MSG_ID, MSG_NUM)
0008    C
0009    C   where
0010    C
0011    C	MSG_ID		is a character expression to be typed before the system
0012    C			error message (an all-blank string will not be typed)
0013    C	MSG_NUM		is the address of an integer containing the message
0014    C			number
0015    C
0016    C
0017    C
0018    	SUBROUTINE REPORT(MSG_ID, MSG_NUM)
0019    C
0020    	CHARACTER*132 MESSAGE, MSG_ID*(*)
0021    	INTEGER*2 MSG_LEN
0022    	INTEGER*4 SYS$GETMSG
0023    C
0024    	ISTAT = SYS$GETMSG(%VAL(MSG_NUM), MSG_LEN, MESSAGE, %VAL(15),)
0025    	IF (ISTAT) THEN
0026    	    IF (MSG_ID .NE. ' ') THEN
0027    		TYPE *, MSG_ID, MESSAGE(1:MSG_LEN)
0028    	    ELSE
0029    		TYPE *, MESSAGE(1:MSG_LEN)
0030    	    ENDIF
0031    	ELSE
0032    	    IF (MSG_ID .NE. ' ') THEN
0033    		TYPE *, MSG_ID, '%CTS-W-ERROR: ', MSG_NUM
0034    	    ELSE
0035    		TYPE *, 'CTS-W-ERROR: ',MSG_NUM
0036    	    ENDIF
0037    	END IF
0038    	RETURN
0039    	END

REPORT                         					 7-Jan-1983 13:28:33	VAX-11 FORTRAN V3.1-23              Page  14
								 4-Jan-1983 14:33:17	SYS$SYSROOT:[CAMAC.CTS]CTS.FOR;54           

PROGRAM SECTIONS

    Name				 Bytes   Attributes

  0 $CODE                                  243   PIC CON REL LCL   SHR   EXE   RD NOWRT LONG
  1 $PDATA                                  27   PIC CON REL LCL   SHR NOEXE   RD NOWRT LONG
  2 $LOCAL                                 204   PIC CON REL LCL NOSHR NOEXE   RD   WRT LONG

    Total Space Allocated                  474


ENTRY POINTS

    Address  Type  Name          

  0-00000000       REPORT        


VARIABLES

    Address  Type  Name              Address  Type  Name              Address  Type  Name              Address  Type  Name          

  2-00000088  I*4  ISTAT           2-00000000  CHAR MESSAGE        AP-00000004@ CHAR MSG_ID          2-00000084  I*2  MSG_LEN       
 AP-00000008@ I*4  MSG_NUM       


FUNCTIONS AND SUBROUTINES REFERENCED

  Type  Name          

   I*4  SYS$GETMSG    

                               					 7-Jan-1983 13:28:33	VAX-11 FORTRAN V3.1-23              Page  15
								 4-Jan-1983 14:33:17	SYS$SYSROOT:[CAMAC.CTS]CTS.FOR;54           

0001    C	GET_KEYWORD_VAL
0002    C
0003    C Function to check that the value of a parameter or qualifier returned by the
0004    C CLI is contained uniquely in a list of legal values.
0005    C
0006    C Calling sequence:
0007    C
0008    C	ISTATUS = GET_KEYWORD_VAL(NAME,LEGAL_LIST,VALUE)
0009    C   where:
0010    C	NAME		is the address of a string descriptor containing the
0011    C			name of the qualifier or parameter (the name must
0012    C			be recognizable by CLI$GET_VALUE)
0013    C	LEGAL_LIST	is the address of a string descriptor containing the
0014    C			list of legal keyword values, separated by a "/"
0015    C	VALUE		is the address of a string descriptor defining where
0016    C			the full spelling of the value will be placed
0017    C
0018    C
0019    	INTEGER*4 FUNCTION GET_KEYWORD_VAL(NAME, LEGAL_LIST, VALUE)
0020    C
0021    C
0022    	CHARACTER ENTRY*64, LEGAL_LIST*(*), NAME*(*), VALUE*(*)
0023    	INTEGER*2 ENTRY_LEN, LEGAL_LIST_LEN, MATCH_LOC, SLASH_LOC
0024    	INTEGER*4 STATUS
0025    	INTEGER*4 CLI$GET_VALUE
0026    C
0027    	LEGAL_LIST_LEN = LEN(LEGAL_LIST)
0028    	STATUS = CLI$GET_VALUE(NAME, ENTRY)
0029    	IF (.NOT. STATUS) GOTO 89900
0030    	CALL STR$TRIM(ENTRY, ENTRY, ENTRY_LEN)
0031    C
0032    C Search the list of legal values for a unique match with the entered value.
0033    C
0034    	MATCH_LOC = 0
0035    	START_LOC = 1
0036    	DO 10050 WHILE (.TRUE.)
0037    	   IF (INDEX(LEGAL_LIST(START_LOC:),ENTRY(1:ENTRY_LEN)) .EQ. 1) THEN
0038    		IF (MATCH_LOC .NE. 0) THEN
0039    		   STATUS = .FALSE.			! not unique
0040    		   TYPE *, '%CTS-W-ABKEYVAL, ambiguous keyword value'
0041    		   GOTO 89900
0042    		ENDIF
0043    		MATCH_LOC = START_LOC			! found match
0044    	   ENDIF
0045    	   SLASH_LOC = INDEX(LEGAL_LIST(START_LOC:),'/')
0046    	   IF (SLASH_LOC .EQ. 0) GOTO 20000		! no '/' means done
0047    	   START_LOC = START_LOC + SLASH_LOC
0048    10050	CONTINUE
0049    C
0050    C Done searching.  Return full spelling of value if we found a match.
0051    C
0052    20000	IF (MATCH_LOC .EQ. 0) THEN
0053    	   STATUS = .FALSE.				! illegal value
0054    	   TYPE *, '%CTS-W-ILLVAL, illegal keyword value'
0055    	   GOTO 89900
0056    	ENDIF
0057    	SLASH_LOC = INDEX(LEGAL_LIST(MATCH_LOC:),'/')

GET_KEYWORD_VAL                					 7-Jan-1983 13:28:33	VAX-11 FORTRAN V3.1-23              Page  16
								 4-Jan-1983 14:33:17	SYS$SYSROOT:[CAMAC.CTS]CTS.FOR;54           

0058    	IF (SLASH_LOC .EQ. 0) SLASH_LOC = LEN(LEGAL_LIST)-MATCH_LOC+2
0059    	VALUE = LEGAL_LIST(MATCH_LOC:SLASH_LOC+MATCH_LOC-2)
0060    	STATUS = .TRUE.
0061    C
0062    C Return
0063    C
0064    89900	GET_KEYWORD_VAL = STATUS
0065    	RETURN
0066    	END




PROGRAM SECTIONS

    Name				 Bytes   Attributes

  0 $CODE                                  334   PIC CON REL LCL   SHR   EXE   RD NOWRT LONG
  1 $PDATA                                  78   PIC CON REL LCL   SHR NOEXE   RD NOWRT LONG
  2 $LOCAL                                 208   PIC CON REL LCL NOSHR NOEXE   RD   WRT LONG

    Total Space Allocated                  620


ENTRY POINTS

    Address  Type  Name                            

  0-00000000  I*4  GET_KEYWORD_VAL                 


VARIABLES

    Address  Type  Name                                Address  Type  Name                            

  2-00000000  CHAR ENTRY                             2-00000040  I*2  ENTRY_LEN                       
 AP-00000008@ CHAR LEGAL_LIST                        2-00000042  I*2  LEGAL_LIST_LEN                  
  2-00000044  I*2  MATCH_LOC                        AP-00000004@ CHAR NAME                            
  2-00000046  I*2  SLASH_LOC                         2-00000050  R*4  START_LOC                       
  2-0000004C  I*4  STATUS                           AP-0000000C@ CHAR VALUE                           


LABELS

    Address   Label       Address   Label       Address   Label   

      **      10050     0-000000D5  20000     0-0000014A  89900   


FUNCTIONS AND SUBROUTINES REFERENCED

  Type  Name            Type  Name            Type  Name          

   I*4  CLI$GET_VALUE    I*4  LIB$INDEX             STR$TRIM      

GET_KEYWORD_VAL                					 7-Jan-1983 13:28:33	VAX-11 FORTRAN V3.1-23              Page  17
								 4-Jan-1983 14:33:17	SYS$SYSROOT:[CAMAC.CTS]CTS.FOR;54           

COMMAND QUALIFIERS

  FORTRAN /LIS CTS,CTSASSIGN,CTSDEASGN,CTSMODIFY,CTSSET,CTSSHOW,WCCOPY,WCMATCH

  /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)
  /DEBUG=(NOSYMBOLS,TRACEBACK)
  /STANDARD=(NOSYNTAX,NOSOURCE_FORM)
  /SHOW=(NOPREPROCESSOR,NOINCLUDE,MAP)
  /F77  /NOG_FLOATING  /I4  /OPTIMIZE  /WARNINGS  /NOD_LINES  /NOCROSS_REFERENCE  /NOMACHINE_CODE  /CONTINUATIONS=19


COMPILATION STATISTICS

  Run Time:           6.66 seconds
  Elapsed Time:       7.38 seconds
  Page Faults:        664
  Dynamic Memory:     324 pages
