      PROGRAM DISKS      !Verson DISKSCLUMGR
C     Eric Andresen GRC/SB
C     David Deley   GRC/SB  February, 1986
C     David Deley   GRC/SB  May, 1986
C     Bob VB        GRC/SB  June, 1986
C     David Deley   GRC/SB  June, 1986 Version disksclumgr for system.
C     David Deley   GRC/SB  August, 1986

C     SYMBOL DEFINITIONS
      include '($ssdef)'
      include '($lnmdef)'
      include '($dvidef)'
      parameter ucb$m_timout=64  !sys$library:lib.mlb $ucbdef
      parameter ucb$m_valid=2048 !sys$library:lib.mlb $ucbdef

C     VARIABLE DECLARATIONS
      integer free_blocks, max_blocks, percent_full, msglen, status,
     .        log_equiv_len, sys$trnlnm, sys$getdviw, avl, mnt, dmt,
     .        host_avail, dvi_sts, tot_usr_freeblks, tot_usr_blks,
     .        tot_sys_freeblks, tot_sys_blks, tot_freeblks, tot_blks
      character log_equiv_str*255, user_disk*255, log_table*13,
     .          errmsg*43
      parameter errflags=1      !include only text of error message
      parameter bell=7

C     DATA SECTION				![NODE SPECIFIC]
      parameter num_disks=9			![NODE SPECIFIC]
      character disk_name(num_disks)*10, logical_name(num_disks)*7
      character disk_type(num_disks)*9, shared(num_disks)*3

      data disk_name    /'SB1$DRA0: ',		![NODE SPECIFIC]
     .                   'SB1$DRB0: ',		![NODE SPECIFIC]
     .                   'SB1$DRB1: ',		![NODE SPECIFIC]
     .                   'SBH1$DUA3:',		![NODE SPECIFIC]
     .                   'SB1$DRB3: ',		![NODE SPECIFIC]
     .                   'SB1$DRB4: ',		![NODE SPECIFIC]
     .                   'SBH1$DUA2:',		![NODE SPECIFIC]
     .                   'SBH1$DUA0:',		![NODE SPECIFIC]
     .                   'SB3$DRA0: '/		![NODE SPECIFIC]

      data logical_name /'DISK1: ',		![NODE SPECIFIC]
     .                   'DISK2: ',		![NODE SPECIFIC]
     .                   'DISK3: ',		![NODE SPECIFIC]
     .                   'DISK4: ',		![NODE SPECIFIC]
     .                   'DISK5: ',		![NODE SPECIFIC]
     .                   'DISK6: ',		![NODE SPECIFIC]
     .                   'DISK9: ',		![NODE SPECIFIC]
     .                   'DISK10:',		![NODE SPECIFIC]
     .                   'DISK11:'/		![NODE SPECIFIC]

      data disk_type    /'RM03     ',		![NODE SPECIFIC]
     .                   'RM05     ',		![NODE SPECIFIC]
     .                   'RM05     ',		![NODE SPECIFIC]
     .                   'RA81/HSC ',		![NODE SPECIFIC]
     .                   'RM03     ',		![NODE SPECIFIC]
     .                   'RM03     ',		![NODE SPECIFIC]
     .                   'RA81/HSC ',		![NODE SPECIFIC]
     .                   'RA80/HSC ',		![NODE SPECIFIC]
     .                   'FUJITSU  '/		![NODE SPECIFIC]

      data shared       /'YES',			![NODE SPECIFIC]
     .                   'YES',			![NODE SPECIFIC]
     .                   'YES',			![NODE SPECIFIC]
     .                   'YES',			![NODE SPECIFIC]
     .                   'YES',			![NODE SPECIFIC]
     .                   'YES',			![NODE SPECIFIC]
     .                   'YES',			![NODE SPECIFIC]
     .                   'YES',			![NODE SPECIFIC]
     .                   'YES'/			![NODE SPECIFIC]

      data log_table, len_table / 'LNM$FILE_DEV', 12 /
      data user_disk, len_disk   / 'SYS$DISK', 8/


C     ITEM_LIST SECTION
      ! Define item list structure

      STRUCTURE /ITMLST/
        union
          map
            integer*2 buflen, itmcod
            integer*4 bufadr, retadr
          end map
          map
            integer*4 end_list
          end map
        end union
      END STRUCTURE

C     DECLARE STRUCTURED VARIABLES
      record /itmlst/ trnlnm_list(2)
      record /itmlst/ getdvi_list(8)

C     .BEGIN
      ! Initialize item lists
      trnlnm_list(1).buflen = 255
      trnlnm_list(1).itmcod = lnm$_string
      trnlnm_list(1).bufadr = %loc(log_equiv_str)
      trnlnm_list(1).retadr = %loc(log_equiv_len)
      trnlnm_list(2).end_list = 0
 
      getdvi_list(1).buflen = 4
      getdvi_list(1).itmcod = dvi$_freeblocks
      getdvi_list(1).bufadr = %loc(free_blocks)
      getdvi_list(1).retadr = 0
      getdvi_list(2).buflen = 4
      getdvi_list(2).itmcod = dvi$_maxblock
      getdvi_list(2).bufadr = %loc(max_blocks)
      getdvi_list(2).retadr = 0
      getdvi_list(3).buflen = 4
      getdvi_list(3).itmcod = dvi$_avl
      getdvi_list(3).bufadr = %loc(avl)
      getdvi_list(3).retadr = 0
      getdvi_list(4).buflen = 4
      getdvi_list(4).itmcod = dvi$_mnt
      getdvi_list(4).bufadr = %loc(mnt)
      getdvi_list(4).retadr = 0
      getdvi_list(5).buflen = 4
      getdvi_list(5).itmcod = dvi$_dmt
      getdvi_list(5).bufadr = %loc(dmt)
      getdvi_list(5).retadr = 0
      getdvi_list(6).buflen = 4
      getdvi_list(6).itmcod = dvi$_host_avail
      getdvi_list(6).bufadr = %loc(host_avail)
      getdvi_list(6).retadr = 0
      getdvi_list(7).buflen = 4
      getdvi_list(7).itmcod = dvi$_sts
      getdvi_list(7).bufadr = %loc(dvi_sts)
      getdvi_list(7).retadr = 0
      getdvi_list(8).end_list = 0

      tot_usr_freeblks = 0
      tot_usr_blks     = 0
      tot_sys_freeblks = 0
      tot_sys_blks     = 0
      tot_freeblks     = 0
      tot_blks         = 0

C     GET USER'S DEFAULT DISK
      status = (ss$_normal)
      do while ( status .eq. ss$_normal )
        status = sys$trnlnm( , log_table(1:len_table),
     *                      user_disk(1:len_disk),, trnlnm_list )
        user_disk = log_equiv_str
        len_disk = index( user_disk, ':' ) - 1
      enddo

C     PRINT HEADING
80    print 90, char(27), '[4m', char(27), '[m'
90    format( 1x, a1, a3, 'Device     Logical Name   Free Blks  %Full 
     .  Total Blks   Type    Shared', a1, a2 )
      print *, ' '


C     SHOW DISKS
      DO I = 1, NUM_DISKS

      status = sys$getdviw ( ,, disk_name(i), getdvi_list,,,, )

      if ( max_blocks .ne. 0 ) then
         percent_full=100*(max_blocks-free_blocks)/float(max_blocks)
      else
         percent_full = 0
      endif

      if ( logical_name(i) .eq. 'DISK10:' ) then	![NODE SPECIFIC] [DISK10: IS THE SYSTEM DISK]
         tot_sys_freeblks = tot_sys_freeblks + free_blocks
         tot_sys_blks     = tot_sys_blks     + max_blocks
      else
         tot_usr_freeblks = tot_usr_freeblks + free_blocks
         tot_usr_blks     = tot_usr_blks     + max_blocks
      endif

      ! PRINT DISK
      IF ( status .ne. ss$_normal ) then
         call sys$getmsg(%val(status),msglen,errmsg,%val(errflags),)
         print 106, disk_name(i), logical_name(i), errmsg(1:msglen),bell

      ELSE IF ( .not. host_avail ) then
          errmsg = 'Host unavailable'
          msglen = 16
          print 105, disk_name(i), logical_name(i), errmsg(1:msglen)

      ELSE IF ( .not. avl ) then
         errmsg = 'Device is unavailable'
         msglen = 21
         print 105, disk_name(i), logical_name(i), errmsg(1:msglen)

      ELSE IF ( mnt .and. ( (dvi_sts .and. ucb$m_valid).EQ.0 ) ) then
          errmsg = 'Mount Verify Timeout'
          msglen = 20
          print 105, disk_name(i), logical_name(i), errmsg(1:msglen)

      ELSE IF ( dmt ) then
          errmsg = 'Device marked for dismount'
          msglen = 26
          print 105, disk_name(i), logical_name(i), errmsg(1:msglen)

      ELSE IF ( (dvi_sts .and. ucb$m_timout).NE.0 ) then
          errmsg = 'Device timed out'
          msglen = 16
          print 105, disk_name(i), logical_name(i), errmsg(1:msglen)

      ELSE IF ( .not. mnt ) then
          errmsg = 'Device not mounted'
          msglen = 18
          print 105, disk_name(i), logical_name(i), errmsg(1:msglen)

      ELSE IF (disk_name(i)(1:len_disk) .eq. user_disk(1:len_disk)) then
         print 110, char(27), '[1m', disk_name(i), logical_name(i),
     .             free_blocks, percent_full, max_blocks, disk_type(i), 
     .             shared(i), char(27), '[m'

      ELSE
         print 120, disk_name(i), logical_name(i), free_blocks, 
     .              percent_full, max_blocks, disk_type(i), shared(i)
      END IF
      END DO

      tot_freeblks = tot_usr_freeblks + tot_sys_freeblks
      tot_blks     = tot_usr_blks     + tot_sys_blks
      print 200
      print 210, tot_usr_freeblks, tot_usr_blks
      print 220, tot_sys_freeblks, tot_sys_blks
      print 200
      print 230, tot_freeblks,     tot_blks
      STOP ' '

C     FORMAT STATEMENTS
105      format(1x,a10,4x,a7,8x,a)
106      format(1x,a10,4x,a7,8x,a,a)
110      format(1x,a1,a3,a10,4x,a7,6x,i7,4x,i3,'%',5x,i7,5x,a9,a3,a1,a2)
120      format(1x,a10,4x,a7,6x,i7,4x,i3,'%',5x,i7,5x,a9,a3)
200      format(1x,72('-'))
210      format(1x,'USER DISKS',17x,I7,13x,I7)
220      format(1x,'SYSTEM DISK',16x,I7,13x,I7)
230      format(1x,'TOTAL',22x,I7,13x,I7)

      END
