       subroutine displayi ( lunit, iarray, iar, jar
     1                     , ibeg, iend, jbeg, jend, clab, ctitle )
c
c    dac:zeus3d.displayi <-------- displays portion of 2-D integer array
c                                                          october, 1990
c
c    written by: David Clarke
c    modified 1:
c
c  PURPOSE:  This subroutine writes to "lunit" the specified portion of
c  the specified integer array "iarray".  The difference between "iend"
c  and "ibeg" should not be greater than 38.
c
c  INPUT VARIABLES:
c    lunit       logical unit to which display is sent
c    iarray      2-D integer array to display
c    iar,jar     dimensions of "iarray"
c    ibeg,iend   range in "i" to be displayed
c    jbeg,jend   range in "j" to be displayed
c    clab        character string to label axes
c    ctitle      character string to head data
c
c  OUTPUT VARIABLES: NONE
c
c  LOCAL VARIABLES:
c
c  EXTERNALS: [NONE]
c
c-----------------------------------------------------------------------
c
c
c-----------------------------------------------------------------------
c------------------------ IMPLICIT STATEMENTS --------------------------
c-----------------------------------------------------------------------
c
       implicit      none
c
c-----------------------------------------------------------------------
c----------------------------- PARAMETERS ------------------------------
c-----------------------------------------------------------------------
c
c      Primary parameters:
c
       integer       in      , jn      , kn      , ijkn    , nxpx
     1             , nypx    , nxrd    , nyrd    , niov    , nios
     2             , ntsl    , mn      , nmd     , isig
       real*8        pi  , tiny  , huge  , one  , mone  , haf  , zro
c
       parameter     ( in = 5005, jn = 1, kn = 10, ijkn = 5005)
       parameter     ( nxpx = 1, nypx = 1, nxrd =   1, nyrd =   1 )
       parameter     ( niov =  20, nios =  20, ntsl =1000 )
       parameter     ( mn   =   1, nmd  =   1 )
       parameter     ( pi   = 3.1415926535898 )
       parameter     ( isig = 9, tiny = 1.0d-99, huge = 1.0d+99 )
       parameter     ( one  = 1.0d+00, mone = -1.0d+00
     1                               , haf  =  0.5d+00, zro = 0.0d+00)
c
c      Secondary parameters:
c
       integer        idim    , jdim
     1              , nt01    , nt02    , nt03    , nt04    , nt05
     2              , nt06    , nt07    , nt08    , nt09    , nt10
     3              , nt11    , nt12    , nt13    , nt14    , nt15
     4              , nt16    , nt17    , nt18    , nt19    , nt20
       parameter     ( idim =   kn, jdim =   in )
       parameter     ( nt01 = 600, nt02 = 600, nt03 =   7, nt04 =   5 )
       parameter     ( nt05 =  18, nt06 =   1, nt07 =  10, nt08 =  12 )
       parameter     ( nt09 =   5, nt10 =  54, nt11 =   8 )
       parameter     ( nt12 =        16, nt17 =         4 )
       parameter     ( nt13 = nt12 +  4, nt18 = nt17 +  1 )
       parameter     ( nt14 = nt13     , nt19 = nt18      )
       parameter     ( nt15 = nt14 + 30, nt20 = nt19 +  3 )
       parameter     ( nt16 = nt14 + 42 )
c
c-----------------------------------------------------------------------
c-------------------- SCRATCH SPACE (WORKER ARRAYS) --------------------
c-----------------------------------------------------------------------
c
c      1-D worker arrays
c
       real*8        wa1d    (ijkn), wb1d    (ijkn), wc1d    (ijkn)
     1             , wd1d    (ijkn), we1d    (ijkn), wf1d    (ijkn)
     2             , wg1d    (ijkn), wh1d    (ijkn), wi1d    (ijkn)
     3             , wj1d    (ijkn), wk1d    (ijkn), wl1d    (ijkn)
     4             , wm1d    (ijkn), wn1d    (ijkn), wo1d    (ijkn)
     5             , wp1d    (ijkn), wq1d    (ijkn), wr1d    (ijkn)
     6             , ws1d    (ijkn), wt1d    (ijkn), wu1d    (ijkn)
     7             , wv1d    (ijkn), ww1d    (ijkn), wx1d    (ijkn)
     8             , wy1d    (ijkn), wz1d    (ijkn)
c
c      2-D worker arrays
c
       real*8        wa2d    (idim,jdim), wa2dt   (jdim,idim)
     1             , wb2d    (idim,jdim), wb2dt   (jdim,idim)
     1             , wc2d    (idim,jdim), wc2dt   (jdim,idim)
     2             , wd2d    (idim,jdim), wd2dt   (jdim,idim)
     1             , we2d    (idim,jdim), we2dt   (jdim,idim)
     2             , wf2d    (idim,jdim), wf2dt   (jdim,idim)
c
c      3-D worker arrays
c
       real*8        wa3d    (  in,  jn,  kn), wb3d    (  in,  jn,  kn)
     1             , wc3d    (  in,  jn,  kn), wd3d    (  in,  jn,  kn)
     2             , we3d    (  in,  jn,  kn), wf3d    (  in,  jn,  kn)
     3             , wg3d    (  in,  jn,  kn)
c
       equivalence   ( wa2d    , wa2dt    ), ( wb2d    , wb2dt    )
     1             , ( wc2d    , wc2dt    ), ( wd2d    , wd2dt    )
     2             , ( we2d    , we2dt    ), ( wf2d    , wf2dt    )
       equivalence   ( wa3d    , wa2d     ), ( wb3d    , wb2d     )
     1             , ( wc3d    , wc2d     ), ( wd3d    , wd2d     )
     2             , ( we3d    , we2d     ), ( wf3d    , wf2d     )
c
c---------------------------- Common Blocks ----------------------------
c
       common / scratchr /
     1               wa1d    , wb1d    , wc1d    , wd1d    , we1d
     2             , wf1d    , wg1d    , wh1d    , wi1d    , wj1d
     3             , wk1d    , wl1d    , wm1d    , wn1d    , wo1d
     4             , wp1d    , wq1d    , wr1d    , ws1d    , wt1d
     5             , wu1d    , wv1d    , ww1d    , wx1d    , wy1d
     6             , wz1d
       common / scratchr /
     1               wa3d    , wb3d    , wc3d    , wd3d    , we3d
     2             , wf3d
     3             , wg3d
c
       character*(*) clab    , ctitle
       integer       lunit   , iar     , jar     , ibeg    , iend
     1             , jbeg    , jend    , i       , j       , iran
     1             , i1      , i2      , imax    , iarmax  , iarmaxt
     2             , iarmin
       real*8        q1      , q2      , q3
c
       integer       ilab    (ijkn), jlab    (ijkn), idummy  (ijkn)
c
       integer       iarray  ( iar, jar)
c
cRAF       equivalence   ( ilab    , wx1d     ), ( jlab    , wy1d     )
cRAF     1             , ( idummy  , wz1d     )
c
c-----------------------------------------------------------------------
c
c      Write "ctitle" to "lunit"
c
       write (lunit, 2010) ctitle
c
c      Set limits for i-sweep
c
       iran =  min ( 38, iend - ibeg + 1 )
       i1   = ibeg
       i2   = ibeg + iran - 1
c
c      Set axis labels
c
       do 10 i=i1,i2
         ilab(i) = i
10     continue
       do 20 j=jbeg,jend
         jlab(j) = j
20     continue
c
c      Find extrema of array "iarray"
c
       iarmax =-999999
       iarmin = 999999
       do 40 j=jbeg,jend
         do 30 i=i1,i2
           iarmax =  max ( iarmax, iarray(i,j) )
           iarmin =  min ( iarmin, iarray(i,j) )
30       continue
40     continue
       if (iarmax .lt.  abs(iarmin)) iarmax = iarmin
       iarmaxt = iarmax
       if (iarmax .eq. 0.0) iarmax = 1.0
c
c      Display array "iarray" depending on "iran".
c
       if (iran .ge. 20) then
         imax = 99
         q1   = 0.499
       endif
       if ( (iran .ge. 16) .and. (iran .le. 19) ) then
         imax = 999
         q1   = 0.4999
       endif
       if ( (iran .ge. 13) .and. (iran .le. 15) ) then
         imax = 9999
         q1   = 0.49999
       endif
       if ( (iran .ge. 11) .and. (iran .le. 12) ) then
         imax = 99999
         q1   = 0.499999
       endif
       if (iran .le. 10) then
         imax = 999999
         q1   = 0.4999999
       endif
       q2 =   min ( one,  dble(imax) / abs ( dble(iarmax)) )
       do 60 j=jend,jbeg,-1
         do 50 i=i1,i2
           q3        = q2 *  real(iarray(i,j))
           idummy(i) =  int ( q3 + sign ( q1, q3 ) )
50       continue
         if (iran .ge. 26)
     1     write (lunit, 2020) jlab(j), (idummy(i),i=i1,i2)
         if ( (iran .ge. 20) .and. (iran .le. 25) )
     1     write (lunit, 2030) jlab(j), (idummy(i),i=i1,i2)
         if ( (iran .ge. 16) .and. (iran .le. 19) )
     1     write (lunit, 2040) jlab(j), (idummy(i),i=i1,i2)
         if ( (iran .ge. 13) .and. (iran .le. 15) )
     1     write (lunit, 2050) jlab(j), (idummy(i),i=i1,i2)
         if ( (iran .ge. 11) .and. (iran .le. 12) )
     1     write (lunit, 2060) jlab(j), (idummy(i),i=i1,i2)
         if (iran .le. 10)
     1     write (lunit, 2070) jlab(j), (idummy(i),i=i1,i2)
60     continue
c
c      Label horizontal axis.
c
       if (iran .ge. 26)
     1   write (lunit, 2080) clab, (ilab(i),i=i1,i2)
       if ( (iran .ge. 20) .and. (iran .le. 25) )
     1   write (lunit, 2090) clab, (ilab(i),i=i1,i2)
       if ( (iran .ge. 16) .and. (iran .le. 19) )
     1   write (lunit, 2100) clab, (ilab(i),i=i1,i2)
       if ( (iran .ge. 13) .and. (iran .le. 15) )
     1   write (lunit, 2110) clab, (ilab(i),i=i1,i2)
       if ( (iran .ge. 11) .and. (iran .le. 12) )
     1   write (lunit, 2120) clab, (ilab(i),i=i1,i2)
       if (iran .le. 10)
     1   write (lunit, 2130) clab, (ilab(i),i=i1,i2)
c
c      Indicate scale of displayed data.
c
       if (q2 .lt. 1.0) write (lunit, 2140) imax, iarmaxt
       if (q2 .eq. 1.0) write (lunit, 2150)
c
c-----------------------------------------------------------------------
c----------------------- Write format statements -----------------------
c-----------------------------------------------------------------------
c
2010   format('DISPLAYI:',/,'DISPLAYI: ',a)
2020   format(i3,1x,38i2)
2030   format(i3,1x,25i3)
2040   format(i3,1x,19i4)
2050   format(i3,1x,15i5)
2060   format(i3,1x,12i6)
2070   format(i3,1x,10i7)
2080   format(a3,1x,38i2)
2090   format(a3,1x,25i3)
2100   format(a3,1x,19i4)
2110   format(a3,1x,15i5)
2120   format(a3,1x,12i6)
2130   format(a3,1x,10i7)
2140   format('DISPLAYI: Data scaled so that a display of ',i6
     1       ,' corresponds to ',i12)
2150   format('DISPLAYI: Data are not scaled.')
c
       return
       end
