blocks.F90

Go to the documentation of this file.

 
 
subroutine blocks(mbay,mwrd)
 
  use modv_vars, only: iblock, nbytw, iordle
 
  implicit none
 
  integer, intent(inout) :: mbay(*), mwrd
 
  integer iint, jint, i
 
  character*1 cint(4),dint(4)
 
  equivalence(cint,iint)
  equivalence(dint,jint)
 
  if(iblock==0) return
 
  ! make room in mbay for control words - one at each end of the record
 
  do i=mwrd,1,-1
    mbay(i+1) = mbay(i)
  enddo
 
  ! store the endianized control word in bytes in dint/jint
 
  iint=mwrd*4
 
  do i=1,nbytw
    if(iblock==-1) then
#ifdef BIG_ENDIAN
      dint(i)=cint(iordle(i))
#else
      dint(i)=cint(i)
#endif
    elseif(iblock==1) then
#ifdef LITTLE_ENDIAN
      dint(i)=cint(iordle(i))
#else
      dint(i)=cint(i)
#endif
    endif
  enddo
 
  ! increment mrwd and install the control words in their proper places
 
  mwrd = mwrd+2
  mbay(1) = jint
  mbay(mwrd) = jint
 
  return
end subroutine blocks
 
recursive subroutine setblock(iblk)
 
  use modv_vars, only: im8b, iblock
 
  implicit none
 
  integer, intent(in) :: iblk
 
  integer my_iblk
 
  ! Check for I8 integers.
 
  if(im8b) then
    im8b=.false.
 
    call x84(iblk,my_iblk,1)
    call setblock(my_iblk)
 
    im8b=.true.
    return
  endif
 
  iblock=iblk
 
  return
end subroutine setblock