	SUBROUTINE AGN_VMS(PARSTR,IDENT,ITYP,TYPSTR,VALSTR,BADP)
C	###############################################################
C	# (C) Copyright 1985 Auto-trol Technology Corporation         #
C	#                                                             #
C	# This program is the sole property of Auto-trol Technology   #
C	# Corporation and is considered a trade secret and/or a       #
C	# proprietary product of Auto-trol Technology Corporation.    #
C	# Use or disclosure of this program by other than Auto-trol   #
C	# Technology Corporation and its assigned licensees and       #
C	# customers is strictly forbidden by law.                     #
C	#                                                             #
C	# Use, duplication or disclosure by the Government is subject #
C	# to restrictions as set forth in subdivision (b)(3)(ii) of   #
C	# the Rights in Technical Data and Computer Software clause   #
C	# at 252.227.7013.                                            #
C	###############################################################
C
C      /BEGIN MODULE HEADER/        		/STANDARD MODULE HEADER/
C
C       NAME -- AGN_VMS
C
C       PURPOSE -- Check the current VMS SYSTEM parameter value
C
C       INTERNAL DESCRIPTION AND DESIGN CONSIDERATIONS --
C
C	  This routine checks precribed VMS parameter for value and type.      
C	  BADP is set .false. if requirements are not matched.
C	  After any error, control is returned to the main program loop
C	  by signalling an AGN error (causing UNWIND)	
C
C       NOTES --
C	  
C	  Routine uses $GETSYI item definitions provided by the
C	  AGN_PRM module. It also contains (some) code for STRING
C	  parameters handling, but this code has not been tested,
C	  since ATTC AGN only allows for numeric parameter values.
C
C       HISTORY --
C         MM/DD/YY,SDRC,functional spec number,initials,comments
C	  07/01/87,,137-148312-000,MARBRU,Initial code
C
C  /END MODULE HEADER/        AUOSI 	    /STANDARD MODULE HEADER/
C  *****************************************************************
C
	IMPLICIT	NONE
C
	Character*(*)	PARSTR			! VMS parameter name
	Integer*2	IDENT			! Param ident for GETSYI
	Integer*4	ITYP			! Param type     
	Character*(*)	TYPSTR			! VMS parameter req. "type"
	Character*(*)	VALSTR			! VMS parameter req. "value"
	Logical		BADP			! Parameter failed
C                                      
	INCLUDE		'AGN_ERR'      		! Error messages definitions
C
C	Local data            
	Integer*4	SYS$GETSYI		! Get VMS system info
	Integer*4	ITL4(4)			! Item list, longwords
	Integer*2	ITL2(8)			! Item list, words
	Equivalence	(ITL4,ITL2)		! Item lists are overlaid
	Integer*4	VV			! verified value
	Integer*4	CV			! returned current value 
	Character*16	CS			! returned current STRING
	Integer*4	RL			! returned LENGTH
	Integer*4	IS			! status value
C	
C	Data used for special parameters (GBLPAGES_FREE,GBLSECTIONS_FREE)
	Integer*4	GPUSED/-1/		! GBLPAGES in use (-1=unknown)
	Integer*4	GSUSED/-1/		! GBLSECTIONS in use
	Integer*4	I,J			! subscripts etc.
	Integer*4 	lib$set_symbol		! Define DCL symbol
	Integer*4 	lib$spawn		! Create subprocess
	Character*80 	STR			! String for temp. file
C
C  START OF EXECUTABLE CODE --
C
C	STRING VMS system parameters (check for  VALue only, no MIN/MAX/ADD)
C	This code has NOT been tested, we do NOT support string parameters
C
	if (ityp.eq.2) then	    		! VMS  STRING parameter
	   ITL2(1) = 16				! Buffer length = 16
	   ITL2(2) = IDENT			! Item identification
	   ITL4(2) = %loc(CS)			! Buffer address
	   ITL4(3) = %loc(RL)			! Returned length address
	   ITL4(4) = 0				! Item list end
	   IS = SYS$GETSYI(,,,ITL4,,,)		! Get info from system
	   if (.not.IS)Call LIB$SIGNAL(AGN$_GETSYI,%val(1),%val(IS)) !Unwind
	   if	(TYPSTR .ne. 'VAL') then
     	        Call LIB$SIGNAL(AGN$_PARTYP,%val(1),PARSTR(:16))     ! Unwind
	   end if   
	   if   (VALSTR(:RL).ne.CS(:RL) ) then
	        BADP=.true.
		Call LIB$SIGNAL(AGN$_PARSTR,%val(3),PARSTR(:16),VALSTR,CS(:RL))
	   end if
	   Return				! For strings finish here
	end if
C       
C	INTEGER VMS system parameters. Use SYS$GETSYI to get curr. value
C
	ITL2(1) = 4				! Buffer length = 4
	ITL2(2) = IDENT				! Item identification
	ITL4(2) = %loc(CV)			! Buffer address
	ITL4(3) = %loc(RL)			! Returned length address
	ITL4(4) = 0		       		! Item list end
	IS = SYS$GETSYI(,,,ITL4,,,)		! Get info from system
	if (.not.IS)Call LIB$SIGNAL(AGN$_GETSYI,%val(1),%val(IS)) !Unwind
C
C	SPECIAL (not available in VMS 4.4) GBLPAGES_FREE, GBLSECTIONS_FREE
C
C	In VMS 4.4, we MUST use complicated way to get current use. Later,
C	we may remove all this ugly stuff between lable 100-200
 100	if (ityp.eq.3) then
    	   if(GPUSED.ne.-1)GoTo 180		! Value in use is known
C	   Create FOREIGN COMMAND symbol for INSTALL utility
	   IS = lib$set_symbol('ATTC_AGN_INSTALL','$INSTALL/Command',2)
C          Create  subprocess to get global sections summary
	   IS = lib$spawn ('ATTC_AGN_INSTALL LIST/GLOBAL/SUM',,
     $		'ATTC_AGN_INSTALL.TMP',,,,I)
	   If (.not.IS .or. .not.I)Call LIB$SIGNAL(AGN$_GPGUSE) ! Unwind
C	   Read temporray file to extract global sections usage
	   Open(unit=1,name='ATTC_AGN_INSTALL.TMP',ERR=180,
     $		type='OLD',dispose='DELETE')
 110	   Read(1,'(a)',END=150)str		! look for line with "Used"
	     if (index(str,'Used,').eq.0) GoTo 110
	     i = index(str,'Global')-1		! Global sections used are
	     read(str(3:i),*,ERR=150)GSUSED	! first, before "Global"
	     i = index(str,',')+1		! Global pages used are
	     j = index(str,'/')-1		! framed by ", count/"
	     read(str(i:j),*,ERR=150)GPUSED	!
C	     write(*,*)'Inquired GBLSEC,PAG usage:',GSUSED,GPUSED
 150	   Close(UNIT=1)                                      
C    	   Any error in the block above result in values remaining unknown:
 160	   if (GSUSED.lt.0 .or. GPUSED.lt.0) Call LIB$SIGNAL(AGN$_GPGUSE) 
 180	   Continue				! 
C	   For special parameters, IDENT contained ident for current value
C	   of system parameter GBLPAGES, GBLSECTIONS (see AGN_PRM).
C	   Thus, to obtain free space we must subtract current usage:
	   if(PARSTR(:16).eq.'GBLPAGES_FREE   ') CV=CV-GPUSED
	   if(PARSTR(:16).eq.'GBLSECTIONS_FREE') CV=CV-GSUSED
 200 	end if
C
C	Numeric SYSTEM parameter checking (both for types 1,3)
C
	read(VALSTR,*,ERR=900)VV  		! Get required parameter value
	if      (TYPSTR .eq. 'MIN') then	! Type MIN
 	  if (CV .lt. VV ) then			! Curr < Verified Value
	   BADP = .true.			! = error
     	   Call LIB$SIGNAL(AGN$_PARMIN,
     $			   %val(3),PARSTR(:16),%val(VV),%val(CV))
	  end if
	else if (TYPSTR .eq. 'MAX') then	! Type MAX
	  if (CV .gt. VV ) then	       		! Curr > Max Verified value
	   BADP=.true.				! = errror
     	   Call LIB$SIGNAL(AGN$_PARMAX,
     $			   %val(3),PARSTR(:16),%val(VV),%val(CV))
	  end if
	else if (TYPSTR .eq. 'VAL' .or. TYPSTR .eq. '   ') then
	  if (VV .ne. CV ) then	     		! Curr value .ne. Verified
	   BADP = .true.			! = error
     	   Call LIB$SIGNAL(AGN$_PARVAL,
     $		  	   %val(3),PARSTR(:16),%val(VV),%val(CV))
	  end if
	else if (TYPSTR .eq. 'ADD' .or. TYPSTR .eq. 'FRE') then
	  if (CV .lt. VV ) then			! Curr (free) < Verified
	   BADP = .true.			! = error
     	   Call LIB$SIGNAL(AGN$_PARADD,
     $			   %val(3),PARSTR(:16),%val(VV),%val(CV))
	  end if
	end if
	RETURN
C	
C	Numeric conversion error handler
 900	Call LIB$SIGNAL(AGN$_INVVAL,%val(2),VALSTR,PARSTR(:16))
	RETURN
	END
