*
* $Id$
*
* $Log$
* Revision 1.1  1996/01/16 17:08:06  mclareni
* Initial revision
*
*
#include "hbook/pilot.h"
*CMZ :  4.18/00 02/02/93  09.32.29  by  John Allison
*-- Author :
      SUBROUTINE HQWAVE (CHID, TAGS, CHISQ, ALOGLI, NNX, NNY, NNZ,
     +LUWAVE, LUAVSH, LUAVSF)
      CHARACTER*(*) CHID, TAGS (*)
      INTEGER NNX, NNY, NNZ, LUWAVE, LUAVSH, LUAVSF
      REAL CHISQ, ALOGLI
* Output 3-D histogram and fitted function in Wavefront's Data Visualiser
*   format.  Also write an AVS .fld files (one for the histogram, one for the
*   function) to read it.
* If you have just completed multiquadric smoothing and it will write out the
*   histogram contents.  If you pick up a previously smoothed ntuple from a
*   .hbook file, the histogram will not be present.  If you smooth one ntuple,
*   then pick another up from a .hbook file, you may get the wrong histogram
*   contents.
* CHID is a character identification, which (it is suggested) should be the
*   filename "basename".
* LUWAVE, LUAVSH and LUAVSF are the logical nos.  It is suggested that files are
*   named (with the OPEN statement in the calling routine) to:
*   LUWAVE: filename = basename.wave
*   LUAVSH: filename = basename_hist.fld
*   LUAVSF: filename = basename_func.fld
* If NNX, etc. is different to NX, etc., the function is written on a
*   grid defined by NNX, etc., and the histogram is not written.
 
#include "hbook/hcqcom.inc"
#include "hbook/hcbook.inc"
 
      CHARACTER*80 CHQMES, CHID1
      LOGICAL HTHERE, FTHERE
      CHARACTER*40 CHTITL
      INTEGER L, IX, IY, IZ, NCHX, NCHY, NCHZ
      INTEGER LENOCC, LCHID, LCHTIT, NLINES
      REAL V (3), X, Y, Z, DDX, DDY, DDZ
      EQUIVALENCE (X, V (1)), (Y, V(2)), (Z, V(3))
      REAL HQF
 
      IF (NDIM .NE. 3) GO TO 70
 
      IF (NSIG .GT. 0) THEN
         FTHERE = .TRUE.
      ELSE
         FTHERE = .FALSE.
      END IF
 
      IF (NNX .EQ. NX .AND. NNY .EQ. NY .AND. NNZ .EQ. NZ) THEN
         HTHERE = .TRUE.
      ELSE
         HTHERE = .FALSE.
      END IF
 
      IF (.NOT. HTHERE .AND. .NOT. FTHERE) GO TO 80
 
      DDX = DXT / NNX
      DDY = DYT / NNY
      DDZ = DZT / NNZ
 
      LCHID = LENOCC (CHID)
      CHID1 = CHID
 
      NCHZ = LENOCC (TAGS (1))
      NCHY = LENOCC (TAGS (2))
      NCHX = LENOCC (TAGS (3))
      CHTITL = TAGS (3) (1: NCHZ) // '%' // TAGS (2) (1: NCHY)
     +// '%' // TAGS (1) (1: NCHX)
      LCHTIT = LENOCC (CHTITL)
 
#if defined(CERNLIB_UNIX)
      CALL CUTOL (CHID1)
      CALL CUTOL (CHTITL)
#endif
 
* Write .wave file for Wavefront's Data Visualiser.
      WRITE (LUWAVE,
     +'(''# Multiquadric data for Wavefront''''s Data Visualiser.'')')
      WRITE (LUWAVE, '(''# Identifier '', A)') CHID1 (1: LCHID)
      WRITE (LUWAVE, '(''# Tags '', A)') CHTITL (1: LCHTIT)
      WRITE (LUWAVE, '(''# No. of multiquadric parameters'', I6)') NSIG
      WRITE (LUWAVE, '(''# Chi-squared'', G12.5, '' for'', I6,
     +'' degrees of freedom.'')') CHISQ, NBTOT - NSIG
      WRITE (LUWAVE, '(''# Log likelihood'', G12.5)') ALOGLI
 
      WRITE (LUWAVE, '(/)')
      WRITE (LUWAVE, '(''define mesh mquad_'', A)') CHTITL (1: LCHTIT)
      WRITE (LUWAVE, '('' mesh_topology mquad_topology'')')
      WRITE (LUWAVE, '('' mesh_grid mquad_grid'')')
 
      WRITE (LUWAVE, '(/)')
      WRITE (LUWAVE, '(''define reg_grid mquad_grid'')')
      WRITE (LUWAVE, '('' grid_samp'', 3I5)') NNX, NNY, NNZ
      WRITE (LUWAVE, '('' origin'', 3G12.5)') XMI + DX / 2.,
     + YMI + DY / 2., ZMI + DZ / 2.
      WRITE (LUWAVE, '('' step'', 3G12.5)') DDX, DDY, DDZ
 
      WRITE (LUWAVE, '(/)')
      WRITE (LUWAVE, '(''define reg_topology mquad_topology'')')
      WRITE (LUWAVE, '('' elem_samp'', 3I5)') NNX - 1, NNY - 1, NNZ - 1
 
      NLINES = 21
 
      IF (HTHERE) THEN
         WRITE (LUWAVE, '(/)')
         WRITE (LUWAVE, '(''define volume mquad_histogram'')')
         WRITE (LUWAVE, '('' volume_mesh mquad_'', A)')
     +   CHTITL (1: LCHTIT)
         WRITE (LUWAVE, '('' volume_vdata mquad_histogram_contents'')')
         NLINES = NLINES + 5
      END IF
 
      IF (FTHERE) THEN
         WRITE (LUWAVE, '(/)')
         WRITE (LUWAVE, '(''define volume mquad_function'')')
         WRITE (LUWAVE, '('' volume_mesh mquad_'', A)')
     +   CHTITL (1: LCHTIT)
         WRITE (LUWAVE, '('' volume_vdata mquad_function_value'')')
         NLINES = NLINES + 5
      END IF
 
      IF (HTHERE .AND. .NOT. FTHERE) THEN
         WRITE (LUWAVE, '(/)')
         WRITE (LUWAVE, '(''define vdata 1 mquad_histogram_contents'')')
         WRITE (LUWAVE, '('' data list'')')
         WRITE (LUWAVE, '(G15.8)') (Q (L3H + L), L = 1, NBTOT)
      ELSE IF (HTHERE .AND. FTHERE) THEN
         WRITE (LUWAVE, '(/)')
         WRITE (LUWAVE, '(''define vdata 2 mquad_histogram_contents'',
     +   '' mquad_function_value'')')
         WRITE (LUWAVE, '('' data list'')')
         DO 30    IZ = 1, NNZ
            Z = ZMI + (IZ - 0.5) * DDZ
            DO 20    IY = 1, NNY
               Y = YMI + (IY - 0.5) * DDY
               DO 10    IX = 1, NNX
                  X = XMI + (IX - 0.5) * DDX
                  L = (IZ - 1) * NNX * NNY + (IY - 1) * NNX + IX
                  WRITE (LUWAVE, '(2G15.8)') Q (L3H + L), HQF (V)
   10          CONTINUE
   20       CONTINUE
   30    CONTINUE
      ELSE IF (.NOT. HTHERE .AND. FTHERE) THEN
         WRITE (LUWAVE, '(/)')
         WRITE (LUWAVE, '(''define vdata 1 mquad_function_value'')')
         WRITE (LUWAVE, '('' data list'')')
         DO 60    IZ = 1, NNZ
            Z = ZMI + (IZ - 0.5) * DDZ
            DO 50    IY = 1, NNY
               Y = YMI + (IY - 0.5) * DDY
               DO 40    IX = 1, NNX
                  X = XMI + (IX - 0.5) * DDX
                  L = (IZ - 1) * NNX * NNY + (IY - 1) * NNX + IX
                  WRITE (LUWAVE, '(G15.8)') HQF (V)
   40          CONTINUE
   50       CONTINUE
   60    CONTINUE
      END IF
      NLINES = NLINES + 4
 
* Write AVS _hist.fld file.
      IF (HTHERE) THEN
         WRITE (LUAVSH, '(''# AVS field file.'')')
         WRITE (LUAVSH, '(''# Identifier '', A)') CHID1 (1: LCHID) //
     +   ' (histogram)'
         WRITE (LUAVSH, '(/''######################################'')')
         WRITE (LUAVSH, '(''#   (Note: you may have to edit the .wave '
     +   //'filename below.)'')')
         WRITE (LUAVSH, '(''######################################''/)')
         WRITE (LUAVSH, '(''# Tags '', A)') CHTITL (1: LCHTIT)
         WRITE (LUAVSH, '(''# No. of multiquadric parameters'', I6)')
     +   NSIG
         WRITE (LUAVSH, '(''# Chi-squared'', G12.5, '' for'', I6,'
     +   //''' degrees of freedom.'')') CHISQ, NBTOT - NSIG
         WRITE (LUAVSH, '(''# Log likelihood'', G12.5)') ALOGLI
 
         WRITE (LUAVSH, '(/)')
         WRITE (LUAVSH, '(''ndim = 3'')')
         WRITE (LUAVSH, '(''dim1 = '', I3)') NNX
         WRITE (LUAVSH, '(''dim2 = '', I3)') NNX
         WRITE (LUAVSH, '(''dim3 = '', I3)') NNX
         WRITE (LUAVSH, '(''nspace = 3'')')
         WRITE (LUAVSH, '(''veclen = 1'')')
         WRITE (LUAVSH, '(''data = float'')')
         WRITE (LUAVSH, '(''field = uniform'')')
         WRITE (LUAVSH, '(''min_ext = '', 3F15.7)') XMI + DX / 2.,
     +   YMI + DY / 2., ZMI + DZ / 2.
         WRITE (LUAVSH, '(''max_ext = '', 3F15.7)') XMA - DX / 2.,
     +   YMA - DY / 2., ZMA - DZ / 2.
         WRITE (LUAVSH, '(''label = histogram'')')
         IF (FTHERE) THEN
            WRITE (LUAVSH, '(''variable 1 file='', A, ''.wave '
     +      //'filetype=ascii skip='', I5, '' stride=2'')')
     +      CHID1 (1: LCHID), NLINES
         ELSE
            WRITE (LUAVSH, '(''variable 1 file='', A, ''.wave '
     +      //'filetype=ascii skip='', I5)') CHID1 (1: LCHID), NLINES
         END IF
      END IF
 
* Write AVS _func.fld file.
      IF (FTHERE) THEN
         WRITE (LUAVSF, '(''# AVS field file.'')')
         WRITE (LUAVSF, '(''# Identifier '', A)') CHID1 (1: LCHID) //
     +   ' (function)'
         WRITE (LUAVSF, '(/''######################################'')')
         WRITE (LUAVSF, '(''#   (Note: you may have to edit the .wave '
     +   //'filename below.)'')')
         WRITE (LUAVSF, '(''######################################''/)')
         WRITE (LUAVSF, '(''# Tags '', A)') CHTITL (1: LCHTIT)
         WRITE (LUAVSF, '(''# No. of multiquadric parameters'', I6)')
     +   NSIG
         WRITE (LUAVSF, '(''# Chi-squared'', G12.5, '' for'', I6,'
     +   //''' degrees of freedom.'')') CHISQ, NBTOT - NSIG
         WRITE (LUAVSF, '(''# Log likelihood'', G12.5)') ALOGLI
 
         WRITE (LUAVSF, '(/)')
         WRITE (LUAVSF, '(''ndim = 3'')')
         WRITE (LUAVSF, '(''dim1 = '', I3)') NNX
         WRITE (LUAVSF, '(''dim2 = '', I3)') NNX
         WRITE (LUAVSF, '(''dim3 = '', I3)') NNX
         WRITE (LUAVSF, '(''nspace = 3'')')
         WRITE (LUAVSF, '(''veclen = 1'')')
         WRITE (LUAVSF, '(''data = float'')')
         WRITE (LUAVSF, '(''field = uniform'')')
         WRITE (LUAVSF, '(''min_ext = '', 3F15.7)') XMI + DX / 2.,
     +   YMI + DY / 2., ZMI + DZ / 2.
         WRITE (LUAVSF, '(''max_ext = '', 3F15.7)') XMA - DX / 2.,
     +   YMA - DY / 2., ZMA - DZ / 2.
         IF (HTHERE) THEN
            WRITE (LUAVSF, '(''variable 1 file='', A, ''.wave '
     +      //'filetype=ascii skip='', I5, '' offset=1 stride=2'')')
     +      CHID1 (1: LCHID), NLINES
         ELSE
            WRITE (LUAVSF, '(''variable 1 file='', A, ''.wave '
     +      //'filetype=ascii skip='', I5)') CHID1 (1: LCHID), NLINES
         END IF
      END IF
 
 
      GO TO 100
 
   70 CONTINUE
      WRITE (CHQMES, '(''Wrong dimensions ('', I2,
     +'') - only 3-D programmed.'')') NDIM
      GO TO 90
 
   80 CONTINUE
      CHQMES = 'Neither histogram nor function exist.'
      GO TO 90
 
   90 CONTINUE
      CALL HBUG (CHQMES, 'HQWAVE', IDMQ)
 
  100 CONTINUE
 
      END
