cdeck homer4
      subroutine homer4 (qq,xc,yc,ii,jj,iend,jend,nintmax)
      real qq(nintmax,nintmax), xc(nintmax), yc(nintmax)
      include 'maincomo.for'
      include 'homerc.for'
      character *3 iq(41), iqtemp
      logical   pfill
c   pfil is indicator to print fixes from fill
c   options, and may be change to .false. on second pass to
c   get map without filled fixes
      pfill=.false.
      if (nsum.gt.1) pfill=.true.
   10 call dphead
c     search rows of qa to look for something other than zeros
      jkend=jend
      kii=ii
      iyak=kii
   20 kjj=jkend-27
      if (kjj.lt.jj) kjj=jj
      ikend=kii+40
      if (ikend.gt.iend) ikend=iend
      write (iolp,60) (xc(j),j=kii,ikend,5)
      write (unit=iolp,fmt=90) ('  |',j=1,ikend-kii+1)
      ll=jkend+1
      do 40 l=kjj,jkend
         kr=0
         ll=ll-1
         do 30 lz=kii,ikend
            kr=kr+1
            if (qq(lz,ll).ge.1.0) then
               write (iqtemp,'(i3)') int(qq(lz,ll)+0.5)
               iq(kr)=iqtemp
            elseif (qq(lz,ll).gt.0.0.and.pfill) then
               iq(kr)='  r'
            else
               iq(kr)='   '
            endif
   30       continue
         write (iolp,70) yc(ll),yc(ll)
         write (iolp,80) (iq(j),j=1,kr)
   40    continue
      write (unit=iolp,fmt=90) ('  |',j=1,ikend-kii+1)
      write (iolp,60) (xc(j),j=kii,ikend,5)
      if (ikend.eq.iend.and.kjj.eq.jj) go to 50
      if (kjj.eq.jj) then
         jkend=jend
         kii=ikend
         iyak=kii
      elseif (ikend.eq.iend) then
         kii=iyak
         jkend=kjj
      else
         kii=iyak
         jkend=kjj
      endif
      go to 20
   50 if (nsum.eq.3.and.pfill) then
c      print map again without filled locations
         pfill=.false.
         go to 10
      endif
      return
c
   60 format (1x,8(f9.1,6x),f9.1)
   70 format (1x,f9.1,111x,f9.1)
   80 format (5x,41a3)
   90 format (6x,41a3)
      end