program vms_imgfix
      implicit none
c
      character*80 filnam
      integer i, strlen
      integer*2 rec_size
c
      write (6,10)
 10   format (' Enter file name : ',$)
      read (5,'(a)') filnam

 25   write (6,30)
 30   format (' Enter required record length (e.g. 2400) : ',$)
      read (5,*) rec_size

      call change_attr (filnam, rec_size)
c

      end
c
      integer function strlen (string)
      implicit none
      character*(*) string
c
      integer i
      do 10 i = len(string), 1 , -1
         if (string(i:i).ne.' ') go to 20
 10   continue
 20   strlen = i
c
      return
c
      end
c
      subroutine change_attr (filnam, rec_size)
      implicit none
c
      character*(*) filnam
      integer*2 rec_size
c
      include '($atrdef)'
      include '($fabdef)'
      include '($iodef)'
c
      structure /fatdef/
         byte      fat$b_rtype
         byte      fat$b_rattrib
         integer*2 fat$w_rsize
         byte      %fill(12)
         integer*2 fat$w_maxrec
         byte      %fill(14)
      endstructure
c
      record /atrdef/ atr(2)
      record /fabdef/ fab
      record /fatdef/ fat
c
      integer iosb(2)
      integer is, sys$open, sys$qiow
c
c======open the file
c
      fab.fab$b_bid = fab$c_bid
      fab.fab$b_bln = fab$c_bln
      fab.fab$b_fac = fab$m_get .or. fab$m_put
      fab.fab$l_fna = %loc(filnam)
      fab.fab$b_fns = len(filnam)
      fab.fab$l_fop = fab$m_sqo .or. fab$m_ufo
      fab.fab$w_ifi = 0
      fab.fab$b_rtv = 1
      is = sys$open(fab)
      if (.not.is) call lib$signal(%val(is))
c
      atr(1).atr$w_size = atr$s_recattr
      atr(1).atr$w_type = atr$c_recattr
      atr(1).atr$l_addr = %loc(fat)
      atr(2).atr$w_size = 0
c
c======get the required attributes
c
      is = sys$qiow(,%val(fab.fab$l_stv),%val(io$_access),iosb,,,
     &     ,,,,atr,)
      if (is) is = iosb(1)
      if (.not.is) call lib$signal(%val(is))
c
c======change to fixed length records, no carriage control information
c
      fat.fat$b_rtype = fab$c_fix
      fat.fat$b_rattrib = 0
      fat.fat$w_rsize = rec_size
      fat.fat$w_maxrec = rec_size
c
c======and reset them
c
      is = sys$qiow(,%val(fab.fab$l_stv),%val(io$_deaccess),iosb,,,
     &     ,,,,atr,)
      if (is) is = iosb(1)
      if (.not.is) call lib$signal(%val(is))
c
      end