Program Test
c
c	Test of virt package
c
c
	parameter	(NCOMP	= 4)		! Number of vectors
	parameter	(NSIZE	= 4096)		! Length of vectors
	parameter	(NLEN	= 4)		! 4 bytes per element
	parameter	(NBLKS	= NSIZE / 512 * NCOMP * NLEN)
c					! Size to allocate
c
	parameter	(NWIND	= 512)		! Size of window array
	parameter	(NINDX	= NSIZE / NWIND) ! Number of segments
c
        integer irdb(8), iwdb(8)
	integer*4 iarray, iseed
	common	/virt/ iarray(NWIND,NCOMP)
c
c...    Create region with 512 * 512 bytes
c...			   512 * 128 longwords
c...
	call CRVIRT (NBLKS,irdb,ierr)
c
        call CRWIND(iarray, irdb, iwdb, ierr, NLEN, NWIND, NCOMP)
	call PRTMCX(iwdb)
c
	iseed = 0
	Do 2000 i = 0, NINDX-1
	   If (MPVIRT(iwdb, ierr, i) .le. 0) Pause 'MPVIRT Error'
	   if (i .eq. 0) call PRTMCX(iwdb)
	   do 2000 j = 1, NCOMP
	      do 2000 jj = 1, NWIND
		 iarray(jj,j) = iseed + j + jj
	         iseed = iseed + 1
 2000	Continue
c
	iseed = 0
	Do 3000 i = 0, NINDX-1
	   If (MPVIRT(iwdb, ierr, i) .le. 0) Pause 'MPVIRT Error'
d	   write (5,122) ierr
d	   call PRIPLA(irdb, iwdb)
	   do 3000 j = 1, NCOMP
	      do 3000 jj = 1, NWIND
	      if (iarray(jj,j) .ne. (iseed+j+jj)) Pause 'Not equal'
	      iseed = iseed + 1
 3000	Continue
c
c	Pause
 9999	call exit
	end
      Subroutine PRTMCX (imcx)
C
      Implicit Integer*2 (A-Z)
C
      Parameter  (WSMAP = '200'O)
      Parameter  (WSWRT = '  2'O)
      Parameter  (WSSIS = ' 40'O)
      Parameter  (WSEDS = ' 60'O)
      Parameter  (WSUDS = ' 20'O)
C
      Dimension  imcx(8)
C
      Write (5,601) IAND(imcx(1),255), IAND(imcx(1)/256,255),
     1              (imcx(i), i = 2,7)
  601 Format (6X, 'W.NID  -- ', I2, '.', 3X, ' Window ID'/
     1        6X, 'W.NAPR -- ', I2, '.', 3X, ' Base APR'/
     2        6X, 'W.NBAS -- ', O6, ' Virtual Base Address (bytes)'/
     3        6X, 'W.NSIZ -- ', O6, ' Window Size (32W blocks)'/
     4        6X, 'W.NRID -- ', O6, ' Region ID'/
     5        6X, 'W.NOFF -- ', O6, ' Offset in Region (32W blocks)'/
     6        6X, 'W.NLEN -- ', O6, ' Length to Map (32W blocks)'/
     7        6X, 'W.NSTS -- ', O6, ' Window Status Word')
      WNSTS = imcx(7)
      If (IAND(WNSTS,WSMAP) .ne. 0) Then
         Write (5,603)
  603    Format (25X, 'Window is mapped')
      Else
         Write (5,604)
  604    Format (25X, 'Window is unmapped')
      End If
      If (IAND(WNSTS,WSWRT) .ne. 0) Then
         Write (5,605)
  605    Format (25X, 'Window is mapped with write access')
      Else
         Write (5,606)
  606    Format (25X, 'Window is mapped with read-only access')
      End If
      If (IAND(WNSTS,WSEDS) .eq. WSEDS) Then
         Write (5,677)
  677    Format (25X, 'Window is "Effective Data Space Mapped"')
      Else If (IAND(WNSTS,WSSIS) .ne. 0) Then
         Write (5,607)
  607    Format (25X, 'Window is mapped in Supervisor-mode I-space')
      Else If (IAND(WNSTS,WSUDS) .ne. 0) Then
         Write (5,608)
  608    Format (25X, 'Window is mapped in User-mode D-space')
      Else
         Write (5,609)
  609    Format (25X, 'Window is mapped in User-mode I-space')
      End If
      Write (5,602) imcx(8)
  602 Format (6X, 'W.NSRB -- ', O6, ' Send/Receive Buffer Address (bytes)')
C
      Return
      End
	subroutine pripla (irdb, iwdb)
	integer irdb(8), iwdb(8)
c
	write (5,100) irdb
  100	format ('0PLAS dump:'/
	1	'  R.GID:     ',o6,/
	2	'  R.GSIZ:    ',i6,'.',/
	3	'  R.GNAM:    ',o6,2x,o6,/
	4	'  R.GPAR:    ',o6,2x,o6,/
	5	'  R.GSTS:    ',o6,/
	6	'  R.GPRO:    ',o6,/)
c
	write (5,101) iand(iwdb(1),'377'O), 
	1	      iand(iwdb(1)/256,'377'O), (iwdb(i),i=2,8)
  101	format ('  W.NID:     ',o6,/
	1	'  W.NAPR:    ',o6,/
	2	'  W.NBAS:    ',o6,/
	3	'  W.NSIZ:    ',o6,/
	4	'  W.NRID:    ',o6,/
	5	'  W.NOFF:    ',o6,/
	6	'  W.NLEN:    ',o6,/
	7	'  W.NSTS:    ',o6,/
	8	'  W.NSRB:    ',o6)
	return
	end