	Subroutine IRS_CORE(PID,INT,REQI,FILE)
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 -- IRS_CORE
C
C       PURPOSE -- Core module for ATTC Image Runtime Statistics
C
C       INTERNAL DESCRIPTION AND DESIGN CONSIDERATIONS --
C
C	  The core module monitors selected process, collects statistics
C	  on a particular image and generates a summary report.
C	  This version only works on parameters available via $GETSYI
C	  $GETJPI calls. In the future I would like to add some code
C	  looking directly on process header for parameters like process
C	  sections usage etc.
C
C       NOTES --
C
C       NOTES --
C
C       HISTORY --
C         MM/DD/YY,SDRC,functional spec number,initials,comments
C         09/26/88,,,MARBRU,Initial code
C
C  /END MODULE HEADER/        AUOSI         /STANDARD MODULE HEADER/
C  *****************************************************************
C
	IMPLICIT    NONE
	INCLUDE	    '($JPIDEF)'
	INCLUDE	    '($SYIDEF)'
C
C	ARGUMENTS
C
	Integer*4	PID		    ! Watched process PID
	Integer*4	INT		    ! Sampling intreval
	Character*(*)	REQI		    ! Requested image
	Character*(*)	FILE   
C
C
	Real		SECNDS 		    ! Requested sampling delay
	Character*4	RRBB /'0101'/	    ! Release/build ID
	Integer		MSYI		    ! System parameters count
CC	Parameter	(MSYI=21)	    !
	Parameter	(MSYI=19)	    !
	Integer*4	SYI(MSYI)	    ! SYSGEN item codes buffer
	Integer*4	SYV(MSYI)	    ! SYSGEN values buffer
	Character*12	SYN(MSYI)	    ! SYSGEN names

	Integer*4	MJPI		    ! Item list memebers
	Parameter	(MJPI=38)	    ! (see JPI table)
	Integer*4	JPI(MJPI)	    ! $GETJPI code value
	Integer*4	JPV(MJPI)	    ! Value buffer
	Integer*4	JTL(MJPI)	    ! Length buffer
	Character*12	JTN(MJPI)	    ! Item descriptor table
	Integer*4	PRV(MJPI)	    ! Previous sample value
	Integer*4	MIN(MJPI)	    ! Value minimum
	Integer*4	MAX(MJPI)	    ! Value maximum
	Real*8		AVE(MJPI)	    ! Value average total
	Integer*4	NAVE		    ! Value sample count


	Character*255	IMAG		    ! Running image
	Integer*4	IMAL
	Character*255	SIMG		    ! Saved image name for report
	Integer*4	SIML
	Character*12	USER		    ! Username
	Integer*4	USEL
	Character*08	ACNT		    ! Account
	Integer*4	ACNL
	Character*6	NODE		    ! Nodename
	Integer*4	NODL
	Character*32	HWNM		    ! HW name
	Integer*4	HWNL
	Character*18	DAYB		    ! DAY/TIME
	Logical		ACTIVE		    ! Image monitoring active

	Integer*4	OUT  /1/	    ! Output LUN
	Integer*4	IS		    ! VMS status
	Integer*4	I,J,K
	Integer*4	ITML(3*(MJPI+2))
        INTEGER*4       DELT(2)		    ! Delay quad word
	

	External    SS$_NORMAL, SS$_SUSPENDED
	Integer	    LIB$GETJPI, SYS$GETJPIW
	Integer	    LIB$GETSYI, SYS$GETSYIW
C
C	$GETJPI request table:
C
C	The following indexes/counters describe our $GETJPI item table
C	in terms of differently handled groups. ANY change in the JPI
C	list (add, re-order) means index change.
C
	Integer	    MDEL /4/		    ! Number of "delta" parameters
	Integer     MDED /8/		    ! Count of "deductible" quotas
	Integer	    IDED /5/		    ! First "deductible" quota value
	Integer	    MAVE /20/		    ! Max item for averaging
	Integer	    IPRV /21/		    ! Process privileges index
	Integer	    IIMG /22/		    ! Image name index
	Integer	    JDED /23/		    ! First "deductible" quota base
	Integer	    IQUO /23/		    ! Fist quota, never changing

	Data JPI  /
C	Counter values, subtract previous to get current value / interval
     $		   JPI$_CPUTIM,		    !*CPU time 10 milisec ticks	      1
     $		   JPI$_BUFIO,		    !*Buffered I,O counter	      2
     $		   JPI$_DIRIO,		    !*Direct I,O counter	      3
     $		   JPI$_PAGEFLTS,	    !*Page faults counter	      4 
C	Quota values to be deducted from base to obtain "usage", start IDED=5
     $		   JPI$_ASTCNT,		    ! 1 Remaining AST quota	      5
     $		   JPI$_BIOCNT,		    ! 2 Remaining BIO quota	      6
     $		   JPI$_BYTCNT,		    ! 3 Remaining I/O BYTE Count quota
     $		   JPI$_DIOCNT,		    ! 4 Remaining Direct I/O quota    8
     $		   JPI$_ENQCNT,		    ! 5 Remaining LOCK request quota  9
     $		   JPI$_FILCNT,		    ! 6 Remaining open files quota    10
     $		   JPI$_PAGFILCNT,	    ! 7 Remaining paging file quota   11
     $		   JPI$_TQCNT,		    ! 8 Remaining timer entry quota   12
C	Other "normal" values						    
     $		   JPI$_GPGCNT,		    ! Global pages in WS	      13
     $		   JPI$_PPGCNT,		    ! Physical Pages in WS	      14
     $		   JPI$_WSSIZE,		    ! WS current size		      15
     $		   JPI$_WSPEAK,		    ! Peak WS size		      16
     $		   JPI$_FREPTECNT,	    ! Remaining virtual pages	      17
     $		   JPI$_VIRTPEAK,	    ! Peak viurtual size	      18
     $		   JPI$_JOBPRCCNT,	    ! Total of subprocesses owned     19
     $		   JPI$_DFPFC,		    ! Default page fault cluster      20
C	Privately used values   IPRV,IIMG
     $		   JPI$_CURPRIV,	    ! Current process PRIVILEGES      21
     $		   JPI$_IMAGNAME,	    ! Image name		      22
C	Quota bases for deductible process quotas, starting at JDED
     $		   JPI$_ASTLM,		    !=1 Process AST quota	      23
     $		   JPI$_BIOLM,		    !=2 BIO quota		      24
     $		   JPI$_BYTLM,		    !=3 I/O byte count quota	      25
     $		   JPI$_DIOLM,		    !=4 Direct I/O quota	      26
     $		   JPI$_ENQLM,		    !=5 LOCK request quota	      27
     $		   JPI$_FILLM,		    !=6 Open files quota	      28
     $		   JPI$_PGFLQUOTA,	    !=7 Page file quota		      29
     $		   JPI$_TQLM,		    !=8 Timer entry quota	      30
C	Other quotas 
     $		   JPI$_SHRFILLM,	    !=Shared files quota	      31
     $		   JPI$_MAXDETACH,	    !=Max number of detached jobs     32
     $		   JPI$_MAXJOBS,	    !=Max number of active processes  33
     $		   JPI$_PRCLM,		    !=Subprocess quota		      34
     $		   JPI$_DFWSCNT,	    !=Default WS		      35
     $		   JPI$_WSQUOTA,	    !=WS quota			      36
     $		   JPI$_WSAUTH,		    !=Max authorized WS size	      37
     $		   JPI$_WSAUTHEXT/	    !=Max authorized WS extent	      38
C
	Data JTN  /
C	Counter values, subtract previous to get current value / interval
     $		   'CPUTIM 1/100',	    !*CPU time 10 milisec ticks	      1
     $		   'BUFIO       ',	    !*Buffered I/O counter	      2
     $		   'DIRIO       ',	    !*Direct I/O counter	      3
     $		   'PAGEFLTS    ',	    !*Page faults counter	      4 
C	Quota values to be deducted from base to obtain 'usage', start IDED=5
     $		   'ASTCNT      ',	    ! 1 Remaining AST quota	      5
     $		   'BIOCNT      ',	    ! 2 Remaining BIO quota	      6
     $		   'BYTCNT      ',	    ! 3 Remaining I/O BYTE Count quota
     $		   'DIOCNT      ',	    ! 4 Remaining Direct I/O quota    8
     $		   'ENQCNT      ',	    ! 5 Remaining LOCK request quota  9
     $		   'FILCNT      ',	    ! 6 Remaining open files quota    10
     $		   'PAGFILCNT   ',	    ! 7 Remaining paging file quota   11
     $		   'TQCNT       ',	    ! 8 Remaining timer entry quota   12
C	Other 'normal' values						    
     $		   'GPGCNT      ',	    ! Global pages in WS	      13
     $		   'PPGCNT      ',	    ! Physical Pages in WS	      14
     $		   'WSSIZE      ',	    ! WS current size		      15
     $		   'WSPEAK      ',	    ! Peak WS size		      16
     $		   'FREPTECNT   ',	    ! Remaining virtual pages	      17
     $		   'VIRTPEAK    ',	    ! Peak viurtual size	      18
     $		   'JOBPRCCNT   ',	    ! Total of subprocesses owned     19
     $		   'DFPFC       ',	    ! Default page fault cluster      20
C	Privately used values   IPRV,IIMG
     $		   'CURPRIV     ',	    ! Current process PRIVILEGES      21
     $		   'IMAGNAME    ',	    ! Image name		      22
C	Quota bases for deductible process quotas, starting at JDED
     $		   'ASTLM       ',	    !=1 Process AST quota	      23
     $		   'BIOLM       ',	    !=2 BIO quota		      24
     $		   'BYTLM       ',	    !=3 I/O byte count quota	      25
     $		   'DIOLM       ',	    !=4 Direct I/O quota	      26
     $		   'ENQLM       ',	    !=5 LOCK request quota	      27
     $		   'FILLM       ',	    !=6 Open files quota	      28
     $		   'PGFLQUOTA   ',	    !=7 Page file quota		      29
     $		   'TQLM        ',	    !=8 Timer entry quota	      30
C	Other quotas 
     $		   'SHRFILLM    ',	    !=Shared files quota	      31
     $		   'MAXDETACH   ',          !=Max number of detached jobs     32
     $		   'MAXJOBS     ',          !=Max number of active processes  33
     $		   'PRCLM       ',	    !=Subprocess quota		      34
     $		   'DFWSCNT     ',          !=Default WS		      35
     $		   'WSQUOTA     ',          !=WS quota			      36
     $		   'WSAUTH      ',	    !=Max authorized WS size	      37
     $		   'WSAUTHEXT   '/	    !=Max authorized WS extent	      38
C
C	$GETSYI requets item table. Note corresponding names list SYN following.
C
	DATA SYI   /
     $		    SYI$_CLUSTER_MEMBER,    !01
     $		    SYI$_MAXPROCESSCNT,	    !02
     $		    SYI$_BALSETCNT,	    !03
     $		    SYI$_GBLSECTIONS,	    !04
     $		    SYI$_GBLPAGES,	    !05
     $		    SYI$_GBLPAGFIL,	    !06
     $		    SYI$_VIRTUALPAGECNT,    !07
     $		    SYI$_WSMAX,		    !08
     $		    SYI$_CTLPAGES,	    !09
     $		    SYI$_SRPCOUNT,	    !10
     $		    SYI$_IRPCOUNT,	    !11
     $		    SYI$_LRPCOUNT,	    !12
     $		    SYI$_SPTREQ,	    !13
     $		    SYI$_PFRATL,	    !14
     $		    SYI$_PFRATH,	    !15
     $		    SYI$_AWSMIN,	    !16
     $		    SYI$_WSINC,		    !17
     $		    SYI$_WSDEC ,	    !18
     $		    SYI$_PROCSECTCNT/	    !19
CC   $		    SYI$_FREE_GBLPAGES,	    !20
CC   $		    SYI$_FREE_GBLSECTS/	    !21
C
	DATA SYN   /
     $		    'CLUSTER_MEMB',	    !01
     $		    'MAXPROCESS. ',	    !02
     $		    'BALSETCNT   ',	    !03
     $		    'GBLSECTIONS ',	    !04
     $		    'GBLPAGES    ',	    !05
     $		    'GBLPAGFIL   ',	    !06
     $		    'VIRTUALPAGE.',	    !07
     $		    'WSMAX       ',	    !08
     $		    'CTLPAGES    ',	    !09
     $		    'SRPCOUNT    ',	    !10
     $		    'IRPCOUNT    ',	    !11
     $		    'LRPCOUNT    ',	    !12
     $		    'SPTREQ      ',	    !13
     $		    'PFRATL      ',	    !14
     $		    'PFRATH      ',	    !15
     $		    'AWSMIN      ',	    !16
     $		    'WSINC       ',	    !17
     $		    'WSDEC       ',	    !18
     $		    'PROCSECTCNT '/	    !19
CC     $		    'FREE_GBLPAG ',	    !20
CC     $		    'FREE_GBLSEC '/	    !21

C	=====================================================================
C
C	START of executable code
C
C	Initalize sampling values
C
	Do i=1,MJPI
	   MIN(I)='7FFFFFFF'X
	   MAX(I)='80000000'X
	   AVE(I)=0.0
	   NAVE=0
	end do

	SECNDS = FLOAT(INT)/10
        IF (SECNDS .LE. 0.0 .or. SECNDS .GT. 100.0) SECNDS=1.0
        DELT(1) = - ( 10E6 * SECNDS )	      ! Setup the delay interval
        DELT(2) = -1
C
C	Common process, system and HW informations for data header
C
	IS = LIB$GETJPI(JPI$_USERNAME,PID,,,USER,USEL) ! Get username
	IS = LIB$GETJPI(JPI$_ACCOUNT ,PID,,,ACNT,ACNL) ! Get username
C
C	Load our item list (Could have been done with data statement, but..)
C	
	J = 1
	Do I=1,MJPI
	   ITML(J+0)=4+65536*JPI(I)	    ! Buffer length, item code
	   ITML(J+1)=%loc(JPV(I))	    ! Item buffer
	   ITML(J+2)=%loc(JTL(I))	    ! Item length
	   J=J+3
	End Do
	ITML(J)=0			    ! Item list end
C					    ! We need also the image name
	J=3*(IIMG-1)			    ! with larger buffer
	ITML(J+1)=len(IMAG)+65536*JPI$_IMAGNAME	! Buffer length, item code
	ITML(J+2)=%loc(IMAG)		    ! Item buffer - image name
	ITML(J+3)=%loc(IMAL)		    ! Item length
C
C	Main processing loop. Collects $GETJPI data and based on image
C	presence starts/stops monitoring. During monitoring, several
C	values are updated.
C
 100	IS = SYS$GETJPIW(,PID,,ITML,,,,)    ! Pick up all the information
	If (IS .eq. %loc(SS$_SUSPENDED)) GoTo 200
	If (.not. IS )Call sys$exit(%val(IS))
	ITML(3*IQUO-2)=0		    ! Don't look at quotas any more
C
	if (.not.ACTIVE) then		    ! No image monitored yet...
	    if (IMAL.ne.0) then		    ! But we have an image
	       if ( REQI .eq. '*' .or.
     $		    INDEX(IMAG,REQI).ne.0) then
D		    write(*,*)'Monitoring started '//IMAG(:IMAL)
		    ACTIVE = .true.	    ! Start monitoring
		    SIMG = IMAG		    ! save image name for report
		    SIML = IMAL
	       end if
	    end if
	    Do I=1,MDEL			    ! Save base for "DELTA" values
	       PRV(I)=JPV(I)		    ! saving "previous" values
	    end do		    
	else				    ! ACTIVE image monitored
	   if (IMAL.eq.0 .and. NAVE.gt.0) then ! ACTIVE image terminated
	      ACTIVE=.false.		    !
D	      write(*,*)'Monitoring finished, IMAL,NAVE',IMAL,NAVE
	      GoTo 500			    ! Process image data
	   else
	      Do I=1,MDEL		    ! Compute DELTA for incremental
	        J=JPV(I)		    ! parameters
	        JPV(I)=J-PRV(I)
	        PRV(I)=J
	      end do	      
	      Do I=0,MDED-1		    ! Compute deductible values
	         JPV(IDED+I)=JPV(JDED+I)-JPV(IDED+I) ! to get "usage"
	      end do
	      Do I=1,MAVE
	         if (JPV(I).gt.MAX(I))MAX(I)=JPV(I) ! record MIN/MAX/AVE
	         if (JPV(I).lt.MIN(I))MIN(I)=JPV(I) ! for each parameter
	         AVE(I) = AVE(I) + JPV(I)
	      end do
	      NAVE = NAVE+1
	   end if
	end if
C
 200	CALL SYS$SCHDWK ( ,, DELT ,)
        CALL SYS$HIBER
	GoTo 100
C
C	POSTPROCESSING: Process and output collected data
C
 500	Continue
 510	Format(3(3X,a,I8,4X))		! Format for proc quota list
 520	Format(2('   parameter        MIN     MAX     AVE'))
 530	Format(2(3X,a,I8,I8,F8.1))	! Format for MIN/MAX/AVE
C
C	Build an item list for $GETSYI using our system parameter list array
C
	IF (NAVE.eq.0)RETURN
	J = 1
	Do I=1,MSYI
	   ITML(J+0)=4+65536*SYI(I)	    ! Buffer length, item code
	   ITML(J+1)=%loc(SYV(I))	    ! Item buffer
	   ITML(J+2)=%loc(JTL(I))	    ! Item length
	   J=J+3
	End Do
	ITML(J)=0			    ! terminator
	IS = SYS$GETSYIW(,,,ITML,,,)	    ! Pick up all the information
	if (.not.IS) Call sys$exit(%val(IS))! Report any error
	IS = LIB$GETSYI(SYI$_NODENAME,,NODE,NODL,,)
	IS = LIB$GETSYI(SYI$_NODE_HWTYPE ,,HWNM,HWNl,,)
CC	IS = LIB$GETSYI(SYI$_HW_NAME,,HWNM,HWNl,,)
	DAYB=' '
	Call DATE(DAYB)			    ! Get date/time for report
	Call TIME(DAYB(11:))
C
	Open (unit=OUT,type='NEW',name=FILE)
	Write(OUT,*)
	Write(OUT,*)
	Write(OUT,*)'  IMAGE RUNTIME STATISTICS'
	Write(OUT,*)'  ========================'
	Write(OUT,*)
	write(OUT,*)'  Image:    '//SIMG(:SIML)
	write(OUT,*)'  Date:     '//DAYB
	write(OUT,'(a,Z8.8)')'   User:     '//USER(:USEL)//' account: '//
     $			      ACNT(:ACNL)//'  privileges: ',JPV(IPRV)
	write(OUT,*)'  Node:     '//NODE(:NODL)//'  '//HWNM(:HWNL)
	write(OUT,*)'  IRS ver:  '//RRBB
	write(OUT,'(a,F5.2,a,I8,a,F7.1,a)')'   Interval:',SECNDS,
     $     ' sec  samples:',NAVE,'  run total:',NAVE*SECNDS,' sec.'
C
	do I=1,MDEL
	  MIN(I)= NINT(1.0/SECNDS* FLOAT(MIN(I)))
	  MAX(I)= NINT(1.0/SECNDS* FLOAT(MAX(I)))
	  AVE(I)=      1.0/SECNDS* AVE(I)
	end do

	write(OUT,*) 
	write(OUT,*)'  Important system parameters after image exit '//
     $		       '(names abbreviated)'
	Write(OUT,510) ((SYN(i),SYV(i)),i=1,MSYI)
	write(OUT,*) 
	write(OUT,*)'  Process quotas from SYSUAF.DAT or process creation'
	Write(OUT,510) ((JTN(i),JPV(i)),i=IQUO,MJPI)
	write(OUT,*) 
	write(OUT,*)'  Process counters (resource usage per second)'
	write(OUT,520)
	write(OUT,530)((JTN(I),MIN(I),MAX(I),AVE(I)/NAVE),I=1,MDEL)	
	write(OUT,*) 
	write(OUT,*)'  Process deductible quota usage (quota - remaining)'
	write(OUT,520)
	write(OUT,530)((JTN(I),MIN(I),MAX(I),AVE(I)/NAVE),I=IDED,IDED+MDED-1)
	write(OUT,*) 
	write(OUT,*)'  Other dynamic process parameters'
	write(OUT,520)
	write(OUT,530)((JTN(I),MIN(I),MAX(I),AVE(I)/NAVE),I=IDED+MDED,IPRV-1)
	write(OUT,*)
	close(OUT)
C
	Return
	End
