* * $Id: hqwave.F,v 1.1.1.1 1996/01/16 17:08:07 mclareni Exp $ * * $Log: hqwave.F,v $ * Revision 1.1.1.1 1996/01/16 17:08:07 mclareni * First import * * #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