       subroutine slic2d4
     1   ( q3d, i1, j1, k1, i2, j2, k2, nlog, q2d )
c
c    dac:zeus3d.slic2d4 <------ extracts a 2-d slice from a 3-d datacube
c                                                            march, 1990
c
c    written by: David Clarke
c    modified 1: Robert Fiedler to make q2d real*4 when REAL is real*8.
c
c  PURPOSE:  This subroutine extracts a 2-D slice specified by the input
c  coordinates from a 3-D datacube and copies it to a 2-D array.  The
c  slice is restricted by virtue of the fact that its normal must be
c  parallel to one of the coordinate directions.  Accordingly, i1=i2, or
c  j1=j2, or k1=k2.
c
c  INPUT VARIABLES:
c    q3d        the 3-D array from which the 2-D slice is to be
c               extracted.
c    i1,j1,k1   coordinates of the "bottom left" corner of the slice.
c    i2,j2,k2   coordinates of the "top right" corner of the slice.
c    nlog       =0 => return data slice
c               =1 => return log10 of data slice
c
c  OUTPUT VARIABLES:
c    q2d        the 2-D slice.
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 )
       integer       i       , j       , k       , i1      , i2
     1             , j1      , j2      , k1      , k2      , imax
     2             , jmax    , nlog
c
       real*8        large
       real*4        small
       parameter ( small = 1.0e-22 , large = 1.0e+32 )
c
       real*4        q2d     (idim,jdim)
c
       real*8        q3d     (  in,  jn,  kn)
c
c-----------------------------------------------------------------------
c
c      Slice is in the x2-x3 plane.
c
       if (i1 .eq. i2) then
         if (nlog .eq. 1) then
           do 20 k=k1,k2
             do 10 j=j1,j2
               q2d(j,k) =  log10 (   max ( tiny, q3d(i1,j,k) ) )
10           continue
20         continue
         else
           do 40 k=k1,k2
             do 30 j=j1,j2
               q2d(j,k) = sign( one, q3d(i1,j,k) )
     1                  * min( large, abs( q3d(i1,j,k) ) )
               if( abs(q2d(j,k)) .lt. small ) q2d(j,k) = 0.0
30           continue
40         continue
         endif
         return
       endif
c
c      Slice is in the x3-x1 plane.
c
       if (j1 .eq. j2) then
         if (nlog .eq. 1) then
           do 60 i=i1,i2
             do 50 k=k1,k2
               q2d(k,i) =  log10 (   max ( tiny, q3d(i,j1,k) ) )
50           continue
60         continue
         else
           do 80 i=i1,i2
             do 70 k=k1,k2
               q2d(k,i) = sign( one, q3d(i,j1,k) )
     1                  * min( large, abs( q3d(i,j1,k) ) )
               if( abs(q2d(k,i)) .lt. small ) q2d(k,i) = 0.0
70           continue
80         continue
         endif
         return
       endif
c
c      Slice is in the x1-x2 plane.
c
       if (k1 .eq. k2) then
         if (nlog .eq. 1) then
           do 100 j=j1,j2
             do 90 i=i1,i2
               q2d(i,j) =  log10 (   max ( tiny, q3d(i,j,k1) ) )
90           continue
100        continue
         else
           do 120 j=j1,j2
             do 110 i=i1,i2
               q2d(i,j) = sign( one, q3d(i,j,k1) )
     1                  * min( large, abs( q3d(i,j,k1) ) )
               if( abs(q2d(i,j)) .lt. small ) q2d(i,j) = 0.0
110          continue
120        continue
         endif
         return
       endif
c
c      If no plane is specified (i1.ne.i2 .and. j1.ne.j2 .and. k1.ne.k2)
c  then no slice can be extracted.  Return a zeroed "q2d" to calling
c  routine.
c
       imax = kn
       jmax = in
       do 140 j=1,jmax
         do 130 i=1,imax
           q2d(i,j) = 0.0
130      continue
140    continue
c
       return
       end
