|
PAW > SET TFON ffp | Title FONT (ff) and PREC (p)
PAW > SET GFON ffp | Global title FONT (ff) and PREC (p)
PAW > SET VFON ffp | axis Values FONT (ff) and PREC (p)
PAW > SET LFON ffp | axis Labels FONT (ff) and PREC (p)
PAW > SET CFON ffp | Comment FONT (ff) and PREC (p)
PAW > SET *FON ffp | Set the same values for all
PAW > SET TXFP ffp | ITX FONT (ff) and PREC (p)
Example:
PAW > SET *FON -60 | the all the font to -6 (Helvetica-Bold) and all
| the precision to 0.
The possible PostScript fonts are:
Font 0 with the precision 2 is the Software HIGZ font:
The following table gives all the Postscript characters available in PAW. Note the Euro symbol is there (\360 in greek or special):
The possible precisions are:
|
Precision number |
Effect |
|
0 |
The font used on screen and on Postscript file are the same. On the screen the text is rotated and aligned but, for speed purpose, the size used is the available on the machine. The control characters special characters are not interpreted on the screen but are interpreted on the PostScript output. |
|
1 |
The font used on the screen is the HIGZ-Software and on PostScript the one selected. So, on the screen the text is rotated, aligned and scaled correctly, the control are interpreted but the font used doesn't look like the one used on the PostScript output. |
|
2 |
The font used on screen and on Postscript output are the same. On the screen the text is rotated, aligned and correctly scaled, the control characters are NOT interpreted but the font used looks like the one used on the PostScript output. |
In addition to the character font and precision, the text aspect can be modified via a set of control characters. These characters are embedded into the characters strings and are interpreted according to the rules defined in the HIGZ-software font table.
| List of escape characters and their meaning | |||
|---|---|---|---|
| < | go to lower case (optional) | > | go to upper case (optional) |
| [ | go to greek (Roman = default) | ] | end of greek |
| " | go to special symbols | # | end of special symbols |
| ~ | go to ZapfDingbats | # | end of ZapfDingbats |
| ^ | go to superscript | ? | go to subscript |
| ! | go to normal level of script | & | backspace one character |
| $ | termination character (optional) | @ | escape |
Example:
For/File 44 paw.ps
Meta 44 -111
Size 40 20
Next
Sel 1
Set CHHE 1
Set TXFP -11
Itx 0.2 1. 'L?em! = e J^[m]?&em! A?[m]! , J^[m]?&em!=l&^\261![ g?m]!l , M^j?&i! = [\345&?a]! A?[a! t^a]j?&i! '
Set TXFP -10
Itx 0.2 3.5 'L?em! = e J^[m]?&em! A?[m]! , J^[m]?&em!=l&^\261![ g?m]!l , M^j?&i! = [\345&?a]! A?[a! t^a]j?&i! '
Close 44
The output on the screen is the following. Note that the 'octal characters' like \261 or \345 are never translated whatever the precision is.
The output on the PostScript file is the same with precision 0 or 1.
Note: If the text output is produced with the command TEXT instead of ITX the font and precision used is always 0, 2.
Vector/Del *
Vector/Cre x(10) r 1 2 3 4 5 6 7 8 9 10
Vector/Cre y(10) r 0.9 2.1 2.9 4.1 4.9 6.1 6.9 8.1 8.9 10.1
Vector/Cre ey(10) r 10*0.3
Vector/Cre chi2(1) r
*
Vector/Fit x y ey p1 e
*
Application COMIS Quit
SUBROUTINE chiq
* NPFITS Number of points used in the fit
* NFPAR Number of free parameters
* FITCHI Chisquare
* FITPAR Values of parameters
* FITSIG Errors on parameters
COMMON/HCFITS/NCFITS,NPFITS,NFPAR,FITCHI,FITPAR(35),FITSIG(35)
+ ,FITDER(35)
vector chi2
chi2(1)=fitchi
END
Quit
*
Call chiq
Vector/Pri chi2
*
return
|
PAW > exe chi2
**********************************************
* *
* Function minimization by SUBROUTINE HFITV *
* Variable-metric method *
* ID = 0 CHOPT = E *
* *
**********************************************
Convergence when estimated distance to minimum (EDM) .LT. 0.10E+01
FCN= 1.077442 FROM MINOS STATUS=SUCCESSFUL 18 CALLS 58 TOTAL
EDM= 0.38E-11 STRATEGY= 1 ERROR MATRIX ACCURATE
EXT PARAMETER PARABOLIC MINOS ERRORS
NO. NAME VALUE ERROR NEGATIVE POSITIVE
1 P1 -0.33333E-01 0.20507 -0.20494 0.20494
2 P2 1.0061 0.33054E-01 -0.33029E-01 0.33029E-01
CHISQUARE = 0.1347E+00 NPFIT = 10
CHI2(1) = 0.13468
PAW >
|
$HINFO(id,'ENTRIES') ........ Number of entries
$HINFO(id,'MEAN') ........... Mean value
$HINFO(id,'RMS') ............ Standard deviation
$HINFO(id,'EVENTS') ......... Number of equivalent events
$HINFO(id,'OVERFLOW') ....... Content of overflow channel
$HINFO(id,'UNDERFLOW') ...... Content of underflow channel
$HINFO(id,'MIN') ............ Minimum bin content
$HINFO(id,'MAX') ............ Maximum bin content
$HINFO(id,'SUM') ............ Total histogram content
$HINFO(id,'NSLIX') .......... Number of X slices
$HINFO(id,'NSLIY') .......... Number of Y slices
$HINFO(id,'NBANX') .......... Number of X bands
$HINFO(id,'NBANY') .......... Number of Y bands
$HINFO(id,'NPROX') .......... Projection X (0 or 1)
$HINFO(id,'NPROY') .......... Projection Y (0 or 1)
$HINFO(id,'XBINS') .......... Number of bins in X direction
$HINFO(id,'XMIN') ........... Lower histogram limit in X direction
$HINFO(id,'XMAX') ........... Upper histogram limit in X direction
$HINFO(id,'YBINS') .......... Number of bins in Y direction
$HINFO(id,'YMIN') ........... Lower histogram limit in Y direction
$HINFO(id,'YMAX') ........... Upper histogram limit in Y direction
Example:
PAW > MESSAGE $HINFO(10,'ENTRIES')Note that some other functions are available.
For low level drawing commands such as
PLINE,
PMARKER,
ITX,
FAREA,
the colours are set via commands like
PAW > SET PLCI 2,
PAW > SET FACI 4.
When a command like
HISTO/PLOT
is performed, the hatching and colour attributes
can be preset with the
SET command. It allows to change the colour (COL) and
the hatches type (TYP) of 4 main graphics object in the PAW plots:
Bxxx : Box around each histogram/function plot (zone).
Pxxx : Page. It may contain several zones.
Hxxx : Histogram
Fxxx : Function
xxx can be
TYP or
COL
Example:
PAW > SET HCOL 2
Changes the histogram colour to 2 (red).
The values given to the parameters PTYP, BTYP and HTYP are fill area interior style. The two following figures show the available fill area interior styles:


The parameters PCOL, BCOL, HCOL are equivalent to PTYP, BTYP, HTYP, respectively , but instead of changing the hatch style, they change the colour of the same areas.
If PCOL, BCOL, HCOL are between 1 and 99, then only the contour of the corresponding area is changed. If they are between 1001 and 1099, then the surface is filled with the corresponding fill area colour index.
It is possible to specify with one
SET command both the border and
the inside color for the Histogram, Box Page, and Function (
HCOL,
BCOL,
PCOL,
FCOL).
Example:
+---- 1 The Histogram is filled
| 0 Only the border is drawn
|+--- Border color (here 2) if the histogram is filled
||++- Inside color (here 3) if the histogram is filled
|||| Border color if the histogram is not filled
||||
VVVV
SET HCOL 1203.
The same mechanism is also available for
FCOL,
BCOL and
PCOL.
In addition, BCOL has two digits after the dot. The first one specifies the colour of the zone box shadowing and the second the colour of the statistic box shadowing.
See also the FAQ: How to define the colour map for the option COLZ of HISTO/PLOT ?
You can use the Histo/fit command with the predefined fitting functions on a profile histogram. See the macro below.
macro fit2l
h/del 0
application comis quit
subroutine make2d
call hbook2(2,'test',40,0.,10.,40,0.,10.,0.)
call hbprof(1,'test',40,0.,10.,0.,10.,'S')
do 10 i=1,10000
dev=0.5-rndm(i)
x=10.*rndm(i)
call hfill(1,x,x+dev,1.)
call hfill(2,x,x+dev,1.)
10 continue
end
quit
call make2d
zone 1 2
h/pl 2
hi/fit 1 p1
return
|
PAW > exe fit2l
**********************************************
* *
* Function minimization by SUBROUTINE HFITPO *
* Variable-metric method *
* ID = 1 CHOPT = TU *
* *
**********************************************
Convergence when estimated distance to minimum (EDM) .LT. 0.10E+01
FCN= 1.792382 FROM MIGRAD STATUS=CONVERGED 31 CALLS 32 TOTAL
EDM= 0.21E-24 STRATEGY= 1 ERROR MATRIX ACCURATE
EXT PARAMETER STEP FIRST
NO. NAME VALUE ERROR SIZE DERIVATIVE
1 A0 0.55398E-01 0.85177E-01 0.26538E-02 -0.96222E-11
2 A1 0.98826 0.14371E-01 0.25001E-02 -0.82064E-10
CHISQUARE = 0.4717E-01 NPFIT = 40
PAW >
|
RZOUT: current RZ file cannot support > 64K records
or individual directories > 64K
RZOUT: previous cycle(s) for this key ( 30) deleted
RZOUT: please consult ZEBRA manual for further details
or:
RZOUT: "Request exceeds quota"this indicates that some parameters must be tuned in order to bypass these limits:
Example:
COMMON/QUEST/IQUEST(100)
IQUEST(10)=64000
CALL HROPEN(lun,......,'NQ',4096,istat)
will create a file with a maximum of 64000 records of 4096 words. With this
technique the largest number of records you can have in an HBOOK file
will be 64000 (2**16).
Important note: It is very important to initialise IQUEST(10) just before the call to HROPEN. The QUEST common block is used a lot in the whole CERNLIB, and in particular in HBOOK, so if the value of IQUEST(10) is defined too far from the call to HROPEN, very likely it will not have the expected value when needed.
Program Quota
Parameter (Nwpawc=150000, Nvars=17)
Character*8 Chtags(Nvars)
Dimension Event(Nvars)
Common/Pawc/Paw(Nwpawc)
*
Equivalence (Event(1) ,X1) , (Event(2),Y1) , (Event(3) ,Z1)
Equivalence (Event(4) ,Enrgy1), (Event(5),Eloss1)
Equivalence (Event(6) ,X2) , (Event(7),Y2) , (Event(8) ,Z2)
Equivalence (Event(9) ,Enrgy2), (Event(10),Eloss2)
Equivalence (Event(11),X3) , (Event(12),Y3) , (Event(13),Z3)
Equivalence (Event(14),Enrgy3), (Event(15),Eloss3)
Equivalence (Event(16),X4) , (Event(17),Y4)
*
Common /QUEST/ Iquest(100)
Data Chtags/'X1','Y1','Z1','Energy1','Eloss1',
+ 'X2','Y2','Z2','Energy2','Eloss2',
+ 'X3','Y3','Z3','Energy3','Eloss3',
+ 'X4','Y4'/
*
Call Hlimit(Nwpawc)
*
Iquest(10) = 256000
Call Hropen (1,'QUOTA','quota.hbook','NQE',1024,ISTAT)
If (Istat.Ne.0) Stop
*
Call Hbookn (10,'A simple Ntuple',Nvars,'//QUOTA',10000,Chtags)
*
Do I=1, 5000000
Call Rannor(X1,Y1)
X1 = Float(I)
Z3 = Sqrt(X1*X1+Y1*Y1)
Enrgy1 = 50. + 10.*X1
Eloss1 = 10. * Abs(Y1)
Call Rannor (X2,Y2)
Z3 = Sqrt(X2*X2+Y2*Y2)
Enrgy2 = 50. + 10.*X2
Eloss2 = 10. * Abs(Y2)
Call Rannor(X3,Y3)
Z3 = SQRT(X3*X3+Y3*Y3)
Enrgy3 = 50. + 10.*X3
Eloss3 = 10. * Abs(Y3)
Call Rannor(X4,Y4)
Call Hfn(10,Event)
Enddo
Call Hrout(0,Icycle,' ')
Call Hrend('QUOTA')
End
When you run this example you get:
$ ./quota
RZMAKE. new RZ format selected.
This file will not be readable with versions of RZ prior to release 94B
$ ls -l quota.hbook
-rw-r--r-- 1 couet olivier 340918272 Dec 13 12:06 quota.hbook
$
the program xwpick, available on asis, should be used. It has all kind of options to produce GIF, PICT etc .. . In PAW just do:
shell xwpick ....
This will invoke xwpick in interactive mode.
To convert the current PAW window into a gif file, the following script (UNIX only) can be used (file xw1):
xwininfo -name 'HIGZ_01 @ hphigz' | grep xwininfo | sed -e 's/^..................../xwpick junk.gif -window/' -e 's/................. mv junk.gif $1
in PAW just do:
PAW > shell xw1 test.gif
and the current window will be converted in test.gif.
The command PICTURE/PRINT produces a gif file if the file name is file_name.gif.
Example:
PAW > pict/print test.gif
produce the file test.gif from the current graphics window.
This mechanism works only on X11 machines. On NT or Windows one should use the general procedure to capture any active windows:
CALL IGGIF(1,W,H,'name.gif','M')
Where W and
H are the width and heigh of the GIF
picture.
Note: The GIF file is created by converting the content of the X11 window. So, as we said before, the HIGZ graphics window is necessary. If the popping up of the HIGZ window on the computer screen is annoying, one can install the VNC server and redirect the HIGZ window to that screen like setenv DISPLAY :1.
Macro Legend
TYPE = [1] | Type of hatches
X1 = [2] | X bottom left corner of the box.
X2 = [3] | X top right corner of the box.
Y1 = [4] | Y bottom left corner of the box.
Y2 = [5] | Y top right corner of the box.
TEXT = [6] | Text to be printed
Set FAIS 3
Set FASI [TYPE]
Set BORD 1
Box [X1] [X2] [Y1] [Y2]
Set TXAL 03
XT = [X2]+$GRAFINFO('?CHHE')
YT = ([Y2]+[Y1])/2
Itx [XT] [YT] [TEXT]
Return
Note that this kind of macro is anyway useful to personalise an output.
And also ....
:0 local /usr/X11R6/bin/X +bsIf it is gdm the line starting the X server in the file /etc/X11/gdm/gdm.conf should contain the option +bs it could be something like:
0=/usr/bin/X11/X +bsWith some LINUX systems (for instance Suse Linux 7.2) the file .fvwm2rc should contains the line:
Style "*" BackingStore
Section "Screen"
.
.
.
Option "backingstore"
.
.
.
EndSection
#!/bin/sh
HOST=`hostname`
exec X +bs -bpp 32 -auth ${HOME}/.Xauthority
Note that once the necessary modifications have been done, the X server should be restart. Rebooting the machine may be necessary ...
Two possibilities:
Start --->
More Applications
---> Exceed X-terminal
---> Exceed Applications
---> Xconfig
---> Performance
In this window, titled "Performance":
"Save Unders" option (this eliminates the need
for the client to refresh the window when the menu is rolled back up).
Maximum Backing Store: Always (attempt to preserve the contents
of any window, whether it is mapped or not,
as long as it is displayed on the X server)
Default Backing Store: When Mapped
Minimum Backing Store: When Mapped
Tune... ---> Run All (this runs automatically some tests)
Then start again your X11-session
PAW > OUTPUT 60 FIT.DAT PAW > HI/FIT 10 GThe HI/FIT output is written in the file FIT.DAT.


SET NDVX i e.g. SET NDVX 512
or
SET NDVX i.jk e.g. SET NDVX 10.25
In the first case the number ``i'' contains 100 times the number of
secondary divisions plus the number of primary divisions. (e.g. 512 means
12 primary and 5 secondary division. By adding 10000 times N3 to ``i'' a
third level of divisions is available.
In the second case the number in front of the dot (i) indicates the total number of divisions, the first digit following the dot (j) the label identifier (LABNUM) (if this number is equal to 0 numeric labels are drawn). The second digit after the dot (k) indicates the position where the labels have to be drawn (i.e. the parameter, in this case 5, indicating horizontally written text centred on the interval). Study the next figures for details. These two figures show that the labels can be centred on the tick marks (1 to 4) or on the divisions (5 to 8). If the labels are centred on the tick marks, note that the number of items in the command LABELS must be equal to the number of tick marks (which is equal to the number of divisions plus one ), otherwise the last alphanumeric label on the axis will be undefined.
By default, the number of primary divisions given by SET NDVX n,
SET NDVY n or SET NDVZ n is optimised to have a reasonable labelling:
The number of divisions ( NDIV ) is calculated according to
the following convention:
(NDIV = N1 + 100*N2 + 10000*N3)
Where N1 is the number of primary divisions, N2 is the number of second order
divisions and N3 is the number of third order divisions. The sign of NDIV is
also used to control the labelling:
The number of primary divisions is also optimised according the number of zones (see command ZONE) i.e : along the X direction the number of primary divisions is divided by the_number_of_X_zones along the Y direction the number of primary divisions in divided by (the_number_of_Y_zones)/2.
If the number of divisions has to be exactly equal to the
number given by SET NDVX n, SET NDVY n or
SET NDVZ n, a negative value must be used i.e.:
SET NDVX -i e.g. SET NDVX -512
or
SET NDVX -i.jk e.g. SET NDVX -10.25
For example to label each subsequent X-axis with the names of the
months of the year centred in the middle of each bin you can use:
PAW > LABEL 1 12 JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC
PAW > SET NDVX -12.15
Limitation: Alpha numeric labels (defined with the command
LABEL) do not work on 3D plots
like Lego Plots and Surface Plots.
It is also possible to run PAW on a remote host and display the PAW graphics window on a MacIntosh. This can be achieve in two ways:
MACRO FIT2D
*
* Macro to test 2-D fits of functions F(x1,x2) = Y to data.
*
ZONE 2 2
OPT NSTA
H/DEL *
VECT/DEL *
NP= 3
VECT/CREA PAR([NP]) R 100.0 1.0 1.0
VECT/CREA STEP([NP]) R 1.0 1.0 1.0
VECT/CREA PMIN([NP]) R 1.0 0.0 1.0
VECT/CREA PMAX([NP]) R 1.0 1.0 1.0
*
* Define number of bins in X and Y, then book vectors:
*
NX= 6
NY= 8
MINX= 0.0
MAXX= 3.0
MINY= 0.0
MAXY= 4.0
N= [NX]*[NY]
VECT/CREA Y([N])
VECT/CREA EY([N])
VECT/CREA X([N],2)
*
* Make dummy data using random function HRNDM2. Observe that here the values to
* be expected from the fits are defined:
* | |
FUN2 20 EXP(-0.5*(((1.5-X)**2+(2.0-Y)**2)/(3.**2))) 20 [MINX] [MAXX] _
20 [MINY] [MAXY]
2D 30 'DATA' [NX] [MINX] [MAXX] [NY] [MINY] [MAXY]
APPLICATION COMIS QUIT
SUBROUTINE RNDM
DO 10 I=1,10000
CALL HRNDM2(20,RX,RY)
CALL HFILL(30,RX,RY,1.0)
10 CONTINUE
END
CALL RNDM
END
QUIT
H/PL 30 LEGO
GET/CON 30 Y
GET/ERR 30 EY
*
* Put coordinates x1 and x2 into vector X:
*
BINWX= ([MAXX]-[MINX])/[NX]
BINWY= ([MAXY]-[MINY])/[NY]
DO I=1,[NY]
DO J=1,[NX]
ZX= $SIGMA( [MINX]+[BINWX]*([J]-0.5) )
ZY= $SIGMA( [MINY]+[BINWY]*([I]-0.5) )
N= $SIGMA( ([I]-1)*[NX]+[J] )
VECT/INP X([N],1) [ZX]
VECT/INP X([N],2) [ZY]
ENDDO
ENDDO
*
* Do the fit:
*
V/IN PAR 100.0 1.0 1.0
V/FIT X Y EY FUNXY.FOR 0 [NP] PAR STEP PMIN PMAX
| Plot result:
P1= PAR(1)
P2= PAR(2)
P3= PAR(3)
ZONE 1 2 2 S
FUN2 50 [P1]*EXP(-0.5*((([P2]-X)**2+([P3]-Y)**2)/(3.**2))) [NX] [MINX] [MAXX] _
[NY] [MINY] [MAXY] ' '
H/PL 50 LEGO
RETURN
Where the COMIS function FUNXY.FOR is:
FUNCTION FUNXY(X)
DIMENSION X(2)
COMMON/PAWPAR/PAR(3)
FUNXY= PAR(1)
& *EXP( -0.5*(((PAR(2)-X(1))**2+(PAR(3)-X(2))**2)/(3.**2)) )
END
|
PAW > exe fit2d
**********************************************
* *
* Function minimization by SUBROUTINE HFITV *
* Variable-metric method *
* ID = 0 CHOPT = 0 *
* *
**********************************************
Convergence when estimated distance to minimum (EDM) .LT. 0.10E+01
FCN= 44.38704 FROM MIGRAD STATUS=CONVERGED 70 CALLS 71 TOTAL
EDM= 0.92E-04 STRATEGY= 1 ERROR MATRIX ACCURATE
EXT PARAMETER STEP FIRST
NO. NAME VALUE ERROR SIZE DERIVATIVE
1 P1 232.45 2.4176 0.58806 0.23439E-04
2 P2 1.7379 0.10665 0.24700E-01 0.10854
3 P3 2.0745 0.81073E-01 0.19395E-01 -0.86093E-01
CHISQUARE = 0.9864E+00 NPFIT = 48
PAW >
|
Subroutine Rescale(Id1,Id2,X1,X2)
Character*32 Chtitl
Logical Hexist
Call Hgive(Id1,Chtitl,Ncx,Xmin,Xmax,Ncy,Ymin,Ymax,Nwt,Loc)
Bw = (Xmax-Xmin)/Ncx
Nbin = (X2-X1)/Bw
Bw2 = Bw/2.
If (Hexist(Id2)) Call Hdelet(Id2)
Call Hbook1(Id2,Chtitl,NBin,X1,X2,0.)
Do I=1,Ncx
Call Hix(Id1,I,X)
XI = X+Bw2
W = Hx(Id1,XI)
Call Hfill(Id2,XI,0.,W)
Enddo
End
Example:
PAW > Call rescale.f(10,11,-3.,10.) PAW > h/pl 11
| on Unix |
paw -b macro_name |
| on VMS |
PAW/batch=macro_name |
Macro macro_name
For/File 1 filename.ps
Metafile -1 -111
.
.
here put your graphic commands
.
.
close 1
To know if a PAW session is running in batch
or interactive mode mode, it is enough to put the following
lines in the pawlogon.kumac
file:
if $INDEX($ARGS,'-b') = 0 then
a/cr batch 0
else
a/cr batch 1
endif
Then every where you need to know the running mode it is
enough to test the value of the alias
batch.
Arguments passing
It is NOT possible to pass directly arguments to a macro executed in batch. Nevertheless this problem can be bypass using environment variables.
| On Unix (csh) |
setenv arg1 hello paw -b macro_name |
| On Unix (ksh) |
export arg1=hello paw -b macro_name |
| On VMS |
arg1 :== hello PAW/batch=macro_name |
In all cases (UNIX, VMS ...) in the macro "macro_name" it
is enough to use $ENV(arg1)
to get the value of the global variable.
arg1
Example:
mess $ENV(arg1)
![]() |
Macro Colz
Set * ; Opt * ; H/Del *
*
Fun2 100 1000*(x**2+y**2) 100 -1 1 100 -1 1 ' '
*
Mess ' '
Mess 'The first 8 (0-7) basic colours are used'
Mess ' '
Hist/Plot 100 COLZ
Wait
*
Mess ' '
Mess 'SET NCOL allows to enlarge the colour map and defines'
Mess 'a grey scale ramp from color index 8 to NCOL'
Mess ' '
Set NCOL 20
Hist/Plot 100 COLZ
Wait
*
Mess ' '
Mess 'The command PALETTE defines (by default) a geographical'
Mess 'palette form 8 to NCOL'
Mess ' '
Palette 1
Hist/Plot 100 COLZ
Wait
*
Mess ' '
Mess 'The command COLOR allows to define individually the colours.'
Mess ' '
Color 20 1 0 0
Color 8 1 0 0
Color 15 1 0 0
Hist/Plot 100 COLZ
*
Return
|
![]() |
|
![]() |
|
![]() |
The following example is in fact a tool allowing to define a smooth colour map in a very simple way. This tool consist of 2 COMIS routines which should be saved in the files shade.f and setshd.f. The routine setshd allows to define a set (up to 20) of fixed colours which will be used to define the colour map. Once this set of colours is define, a single call to shade allows to define the colour map. An example is given below, with the macro shade.kumac.
File "shade.f":
subroutine shade()
parameter (nmx = 20)
common /shpt/ npt,idx(nmx),r(nmx),g(nmx),b(nmx)
if (npt.lt.2) then
print*, 'Error: at least two colours are needed'
return
endif
do i=2,npt
j = i-1
i1 = idx(j)
i2 = idx(i)
r1 = r(j)
g1 = g(j)
b1 = b(j)
r2 = r(i)
g2 = g(i)
b2 = b(i)
n = i2-i1+1
do ii=i1,i2
scale = float(ii-i1)/(n-1)
rs = (r2 - r1)*scale + r1
gs = (g2 - g1)*scale + g1
bs = (b2 - b1)*scale + b1
call iscr(1,ii,rs,gs,bs)
enddo
enddo
end
File "setshd.f":
subroutine setshd(idxi, ri, gi, bi)
parameter (nmx = 20)
common /shpt/ npt,idx(nmx),r(nmx),g(nmx),b(nmx)
if (idxi.lt.0) then
npt = 0
return
endif
npt = npt+1
if (npt.gt.nmx) then
print*, 'Error: too many colours'
return
endif
idx(npt) = idxi
r(npt) = ri
g(npt) = gi
b(npt) = bi
end
File "shade.kumac":
Macro shade
set ncol 255
fun2 100 exp(-.5*((x-75)/10)**2)*exp(-.5*((y-60)/10)**2) 100 45 105 100 30 90 ' '
call setshd.f( -1,0.0,0.0,0.0)
call setshd.f( 8,0.0,0.0,1.0)
call setshd.f(100,1.0,0.0,0.0)
call setshd.f(130,1.0,1.0,0.0)
call setshd.f(180,0.0,1.0,0.5)
call setshd.f(255,1.0,0.6,0.5)
call shade.f
h/pl 100 colz
h/del 100
return
Just do:
PAW > Exec shade
and you will get the following picture:
File "colz.kumac":
Macro Colz
Opt * ; h/del * ; v/del *
fun2 2 sin(x)/x*cos(y)*y 100 -6 6 100 -6 6 ' '
N = 6
V/create Z([N]) R -12 -4 -1 0 1 12
V/create R([N]) R 1.0 1.0 0.0 1.0 0.0 0.0
V/create G([N]) R 0.0 1.0 1.0 1.0 1.0 0.0
V/create B([N]) R 0.0 0.0 1.0 1.0 0.0 1.0
call colz.f(2,255,[N],Z,R,G,B)
Return
File "colz.f":
Subroutine Colz(Id,Ncol,N,Z,R,G,B)
*
* This procedure defines a mapping of a 2D histogram content to a palette
* of colours defines by R G B values. Ncol is the number of colours in the
* colour map.
* Z(i) is mapped to R(i), G(i), B(i).
* If Z(1) < Zmin, Zmin is used, is Z(N) > Zmax Z max is used
*
Dimension Z(N),R(N),G(N),B(N)
Character*32 Chtitl
*
Call Hgive(Id,Chtitl,Ncx,Xmin,Xmax,Ncy,Ymin,Ymax,Nwt,Loc)
*
Call Igset('NCOL',Float(Ncol))
*
Zmin = Hij(Id,1,1)
Zmax = Zmin
Do j=1,Ncy
Do I=1,Ncx
Zi = Hij(Id,i,j)
If (Zi.Gt.Zmax) Zmax = Zi
If (Zi.Lt.Zmin) Zmin = Zi
Enddo
Enddo
Dz = Zmax-Zmin
*
Call Setshd( -1,0.0,0.0,0.0)
Do I=1,N
Zi = Z(I)
If (Zi.Lt.Zmin) Zi = Zmin
If (Zi.Gt.Zmax) Zi = Zmax
Idz = Int(((Zi-Zmin)/Dz)*(Ncol-8)+8)
Call Setshd(Idz,R(I),G(I),B(I))
Enddo
Call Shade
Call Hplot(Id,'COLZ',' ',0)
End
*.__________________________________
*
Subroutine Shade()
Parameter (Nmx = 20)
Common /SHPT/ Npt,Idx(Nmx),R(Nmx),G(Nmx),B(Nmx)
If (Npt.Lt.2) Then
Print*, 'Error: at least two colours are needed'
Return
Endif
Do I=2,Npt
J = I-1
I1 = Idx(j)
I2 = Idx(i)
R1 = R(j)
G1 = G(j)
B1 = B(j)
R2 = R(i)
G2 = G(i)
B2 = B(i)
n = i2-i1+1
Do Ii=I1,i2
Scale = Float(Ii-I1)/(N-1)
Rs = (R2 - R1)*Scale + R1
Gs = (G2 - G1)*Scale + G1
Bs = (B2 - B1)*Scale + B1
Call Iscr(1,Ii,Rs,Gs,Bs)
Enddo
Enddo
End
*.__________________________________
*
Subroutine Setshd(Idxi, Ri, Gi, Bi)
Parameter (Nmx = 20)
Common /SHPT/ Npt,Idx(Nmx),R(Nmx),G(Nmx),B(Nmx)
If (Idxi.Lt.0) Then
Npt = 0
Return
Endif
Npt = Npt+1
If (Npt.Gt.Nmx) Then
Print*, 'Error: too many colours'
Return
Endif
Idx(Npt) = Idxi
R(Npt) = Ri
G(Npt) = Gi
B(Npt) = Bi
End
Just do:
PAW > Exec colz
and you will get the following picture:
Appl Comis Quit
Function Square(x)
Square = x*x
End
Quit
Do i=1,9
x = Square( $RSIGMA([i]) )
Mess Square of [i] is $CALL([x])
Enddo
The output of this macro is:
PAW > exe test Square of 1 is 1 Square of 2 is 4 Square of 3 is 9 Square of 4 is 16 Square of 5 is 25 Square of 6 is 36 Square of 7 is 49 Square of 8 is 64 Square of 9 is 81An other way to use $CALL with macro variable is:
Appl Comis Quit
Function Square(x)
Square = x*x
End
Quit
x = $Rsigma(16)
Mess Square of [x] is $CALL('square('//[x]//')')
Note also:
$CALL('fun(args)') ...... Call a Fortran REAL FUNCTION
$ICALL('ifun(args)') .... Call an INTEGER FUNCTION
$LCALL('lfun(args)') .... Call a LOGICAL FUNCTION and return 0 or 1
$DCALL('dfun(args)') .... Call a DOUBLE PRECISION FUNCTION
PROGRAM PAMAIN
*
* MAIN Program for basic PAW
*
PARAMETER (NWPAW=2000000)
*
COMMON/PAWC/PAWCOM(NWPAW)
*
ON REAL UNDERFLOW IGNORE <--- For HP only
*
CALL PAW(NWPAW,IWTYP)
*
CALL KUWHAG
*
CALL PAEXIT
*
STOP
END
SUBROUTINE QNEXT
END
SUBROUTINE CTL$GL_PCB \
ENTRY CTL$T_ACCOUNT | For VAX
ENTRY CTL$T_USERNAME | only
END /
To increase the size of the PAW memory the parameter
NWPAW should
be changed.
To rebuild paw++ instead of pawX11 be sure that:
PROGRAM PAMAIN
*
PARAMETER (NWPAW=2000000)
*
COMMON /PAWC/ PAWCOM(NWPAW)
*
CALL PAWPP(NWPAW,IWTYP)
*
IF (IWTYP .EQ. 999) THEN
CALL KUWHAM('Paw++')
ELSE
CALL KUWHAG
ENDIF
*
CALL PAEXIT
*
STOP
END
OPTION=-O <--- Machine dependent CERNLIB=/cern/pro/lib LIB=-lX11 -lm -lc <--- Machine dependent LIBMOTIF=-lXm -lXt <--- Machine dependent f77 -o pawX11 pamain.f $OPTION \ <--- replace pawX11 by paw++ to rebuild paw++ $CERNLIB/libpawlib.a \ $CERNLIB/libpacklib.a \ $CERNLIB/libgraflib.a \ $CERNLIB/libgrafX11.a \ $CERNLIB/libpacklib.a \ $CERNLIB/libmathlib.a \ $CERNLIB/libkernlib.a \ $CERNLIB/liblapack3.a \ $CERNLIB/libblas.a \ -L/usr/local/lib -lshift \ $LIBMOTIF \ <--- for paw++ only $LIBCopy/paste the previous script in an file named buildpaw and do:
$ chmod +x buildpaw $ ./buildpawThe machine dependent variables should be defined as follow:
OPTION=+ppu -Wl,-E LIB=-L/usr/lib/X11R5 -lX11 -lm -lc -lPW -ldld
OPTION=-O -Wl,-E LIB=-L/usr/X11R6/lib -lX11 -lcrypt -ldl -lnsl LIBMOTIF=-lXm -lXt -lXext -lXp
OPTION=-D 40000000 -T 20000000 -taso -v LIB=-lX11 -ldnet_stub LIBMOTIF=-lXm -lXt
OPTION=-Bdynamic LIB=-L/usr/openwin/lib -lX11 -lw -lgen -lsocket -lnsl -lintl -ldl LIBMOTIF=-lXm -lXt
df -Fepawbig.exe pamain.for pawlib.lib lapack3.lib blas.lib graflib.lib grafX11.lib ix_higz.lib packlib.lib mathlib.lib kernlib.lib user32.lib advapi32.lib wsock32.libTo run properly this script, the following steps must be done:
C:\cern buildpaw
program main
common/pawc/paw(100000)
call hlimit(100000)
call csinit(2000)
1 call cspaus('Test')
go to 1
end
This is the corresponding link procedure for a HP-UX system:
f77 -o ctest +ppu ctest.f \ /cern/pro/lib/libpawlib.a \ /cern/pro/lib/libpacklib.a \ /cern/pro/lib/libkernlib.a -ldld -Wl,-EYou run the program ctest. At the COMIS prompt, you can compile one or more COMIS files with the command
Cs > !file mytest.f Cs > call mytest#
MACRO ALABEL XLBL=' ' YLBL=' ' XDEL=0.05 YDEL=0.05
NT = $GRAFINFO('NT')
TSIZ = $GRAFINFO('?TSIZ')
TFON = $GRAFINFO('?TFON')
X1 = $GRAFINFO('VPXMIN') | Lower X limit of viewport in current NT
X2 = $GRAFINFO('VPXMAX') | Upper X limit of viewport in current NT
Y1 = $GRAFINFO('VPYMIN') | Lower Y limit of viewport in current NT
Y2 = $GRAFINFO('VPYMAX') | Upper Y limit of viewport in current NT
SEL 0
Xlx = ([X2]+[X1])/2
Xly = [Y1] - [YDEL]
Ylx = [X1] - [XDEL]
Yly = ([Y2]+[Y1])/2
SET TXFP [TFON] ; SET CHHE [TSIZ] ; SET TXAL 20
SET TANG 0 ; ITX [Xlx] [Xly] [XLBL]
SET TANG 90 ; ITX [Ylx] [Yly] [YLBL]
SEL [NT]
RETURN
Example:
|
PAW > zone 2 2
PAW > Nul
PAW > exe alabel XLBL=X-Title YLBL=Y-Title
|
The offset of the labels can be changed (in normalized coordinates) with the parameter XDEL and YDEL.
| Fortran version | C version |
|---|---|
Program hserver
*
Call Hlimap(10000,'TEST')
*
Call Hbook1(1,'test1',100,-3.,3.,0.)
*
Call Hcopy(1,2,'test2')
Call Hcopy(1,3,'test3')
*
Do i=1,100000000
call rannor(a,b)
call hf1(1,a,1.)
call hf1(2,b,1.)
call hf1(3,a**2+b**2,1.)
if(mod(i,100000).eq.0)print *,' hserver in loop index ',i
Enddo
*
End
|
#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#include <cfortran.h>
#include <hbook.h>
#define PAWC_SIZE 10000
typedef struct { float PAW[PAWC_SIZE]; } PAWC_DEF;
#define PAWC COMMON_BLOCK(PAWC,pawc)
COMMON_BLOCK_DEF(PAWC_DEF,PAWC);
PAWC_DEF PAWC;
#define X11 1
int main(int argc, char **argv)
{
int i;
float a, b;
HLIMAP(PAWC_SIZE, "TEST");
HBOOK1(1,"test1",100,-3.,3.,0.);
HCOPY(1,2,"test2");
HCOPY(1,3,"test3");
for (i=0;;i++) {
a=6.*((float)random())/(float)RAND_MAX-3.;
a=log(a*a);
b=6.*((float)random())/(float)RAND_MAX-3.;
b=log(b*b);
HF1(1,a,1.);
HF1(2,b,1.);
HF1(3,a*a+b*b,1.0);
if (!(i % 100000)) printf("\nloop index i=%d", i);
}
return 0;
}
|
$ hserver
GLOBAL MEMORY CREATED, offset from LQ = 235337934
hserver in loop index 100000
hserver in loop index 200000
hserver in loop index 300000
hserver in loop index 400000
hserver in loop index 500000
hserver in loop index 600000
hserver in loop index 700000
.
.
.
While the histograms producer program is running, it is possible to access
the histograms in tow ways:
PAW > GLOBAL_SECT TEST PAW > H/PL 1 PAW > H/PL 1 U
| Fortran version | C version |
|---|---|
Program hreader
*
Character*80 name
Common /PAWC/ A(10000)
*
Call Hlimit(10000)
Call Hlimap(0,'TEST')
*
Call Hrin(1,9999,0)
Call Hgive(1,name,nx,xmi,xma,ny,ymi,yma,nwt,loc)
Print*, name,nx,xmi,xma
*
End
|
#include <stdio.h>
#include <stdlib.h>
#include <cfortran.h>
#include <hbook.h>
#define PAWC_SIZE 10000
typedef struct { float PAW[PAWC_SIZE]; } PAWC_DEF;
#define PAWC COMMON_BLOCK(PAWC,pawc)
COMMON_BLOCK_DEF(PAWC_DEF,PAWC);
PAWC_DEF PAWC;
#define X11 1
int main(int argc, char **argv) {
char fln[256];
int record_size=1024, success=0;
char name[80];
int nx,ny,nwt,loc;
float xmi, xma, ymi, yma, res;
HLIMIT(PAWC_SIZE);
HLIMAP(0,"TEST");
HRIN(1,9999,0);
HGIVE(histo,name,nx,xmi,xma,ny,ymi,yma,nwt,loc);
printf("\n>>%d: %s, %d", histo, name, nx);
return 0;
}
|
$ hreader test1 100 -3. 3. $With HBOOK version older than 4.27/01 be careful to put the shared memory name in a character variable.
PAW > call file.f | code is interpreted (default) PAW > call file.f77 | compilation of file.f with f77 and dynamic linking PAW > call file.c | same with the C compilerfile.c should have the following form:
#includeNote the _ added at the end of the procedure name. Then to call it from PAW it is enough to do:file_(int *i) { int j=*i*100; printf("this is a test %d\n",j); }
PAW > call file.c(123) this is a test 12300 PAW >
It is possible to load shared objects without executing the code. The following macro gives an example:
Macro comp
appl comis quit
!file filename.f77
quit
in this case the local compiler is invoked to process filename.f (note that the file extension remains .f even if the file is called with the extension .f77). Before invoking the compiler, COMIS perform preliminary operations:
then COMIS creates and executes a script file to invoke the native fortran compiler and linker to create a shared object and load the shared object.
C code can also be loaded as shared objects. The following macro gives an example:
Macro comp
appl comis quit
!file filename.c
quit
in this case COMIS creates and executes a script file to invoke the native C compiler and linker to create a shared object and load the shared object.
It is also possible to load an existing shared library. In that case the local compiler is not invoked. There is two types of shared libraries:
The following macro shows how to load a shared library produced from fortran code:
Macro load
appl comis quit
!file filename.sl
quit
in this case COMIS analyse the file filename.f to fill a list of used variables for ntuple watched common blocks, and then load the shared object filename.sl.
The following macro shows how to load a shared library produced from C code:
Macro load
appl comis quit
!file filename.csl
quit
in this case COMIS doesn't analyse the source file, it only load the shared object filename.sl . This can be a way to use fortran features not supported by COMIS such as DOUBLE COMPLEX.
Note that when a procedure has been is loaded with one of the methods described above, it can then be accessed by its name only i.e. the file extension is not needed anymore providing the procedure's code has not changed.
To produce and load the shared library, COMIS produced a temporary script file which looks like this:
#! /bin/sh
olddir=`pwd`
cd CHPATH
/bin/rm -f name.sl
# for C compiler
# cc -c .... name.c
CHCC name.c
#for f77 compiler
# f77 -c .... name.f
CHF77 name.f
errno=$?'
if [ $errno != 0 ]
then
exit $errno
fi
#for HPUX.
ld -b -o name.sl name.o
#for SUN.
# ld -G -o name.sl name.o for Solaris
ld -o name.sl name.o
#for SGI.
ld -shared -o name.sl name.o
#for LINUX.
ld -shared -o name.sl name.o
#
errno=$?
if [ $errno != 0 ]
then
exit $errno
fi
/bin/chmod 555 name.sl
/bin/rm -f name.o
cd $olddir
exit 0
This default script can be customised using COMIS directives.
The user can redefine CHPATH - The new directory where shared object and temporary files will be located (default is /tmp/),
Macro SetPath
appl comis quit
!setopt 'string' path
quit
The user can redefine CHF77 - fortran compiler directive:
Macro Setf77Options
appl comis quit
!setopt 'string' f77
quit
The user can redefine CHCC - C compiler directive:
Macro SetCOptions
appl comis quit
!setopt 'string' cc
quit
To have the current values of the !setopt parameters use:
Macro ShowOptions
appl comis quit
!setopt
quit
|
Default CHF77 value (fortran options) |
Default CHCC value (C options) |
|
| HPUX | f77 -c +z +ppu -K -O (before PAW
2.10) f77 -c +z +ppu |
cc -c +z -O (before PAW
2.10) cc -c +z |
| SGI | f77 -c -pic | cc -c -pic |
| SUN | f77 -c | cc -cckr -c |
| IBM/RT | xlf -qextname -qrndsngl -qcharlen=32767 -c | cc -c |
| LINUX | g77 -c | cc -c |
| ALPHA/OSF | f77 -c | cc -c |
ERROR: Undefined symbol: .f1_
To solve this problem you could add f1 routine into file with
f2 routine.
APPL COMIS QUIT
!FILE 0.csl
QUIT
$ nm /cern/pro/bin/pawX11 | grep -i routine_name
If nothing is returned it means that routine_name cannot
be accessed.
REAL FUNCTION select()
File main.f:
program main
common/pawc/paw(100000)
character*80 chfile
integer csaddr
call hlimit(100000)
call csinit(2000)
*-* file names are given like /xx/yy/file.f
*-* the subroutine name is assumed to be file
1 print *,' Give the name of the COMIS file to be executed'
read (5,'(A)')chfile
nch=lenocc(chfile)
islash=index(chfile,'/')
*-* search for / and .
if(nch.gt.0)then
idot=index(chfile,'.')
if(idot.eq.0)go to 1
ifirst=1
do 10 i=idot-1,1,-1
if(chfile(i:i).eq.'/')then
ifirst=i+1
go to 20
endif
10 continue
20 continue
call cltou(chfile)
*-* compile file
call csexec('!FILE '//chfile(1:nch),iret)
if(iret.ne.0)go to 1
*-* get subroutine address
iad=csaddr(chfile(ifirst:idot-1))
*-* execute routine
call csjcal(iad,0,p,p,p,p,p,p,p,p,p,p)
go to 1
endif
end
File test.f:
subroutine test
*-* stupid sum
sum=0
do i=1,1000
sum=sum+i
enddo
print *,' SUM=',sum
end
Macro Draw_Stat
*
Id = [1]
X1 = [2]
X2 = [3]
Y1 = [4]
Y2 = [5]
N = 6
Dy = $EVAL(([Y2]-[Y1])/([N]+1))
Xt = $EVAL([X1]+0.1)
Yt = $EVAL([Y2]-[Dy])
Selnt 1
Box [X1] [X2] [Y1] [Y2]
Set CHHE $EVAL(0.7*[Dy])
Set TXAL 03
Itx [Xt] [Yt] ID ; Yt = $EVAL([Yt]-[Dy])
Itx [Xt] [Yt] Entries ; Yt = $EVAL([Yt]-[Dy])
Itx [Xt] [Yt] Mean ; Yt = $EVAL([Yt]-[Dy])
Itx [Xt] [Yt] Rms ; Yt = $EVAL([Yt]-[Dy])
Itx [Xt] [Yt] Overflow ; Yt = $EVAL([Yt]-[Dy])
Itx [Xt] [Yt] Underflow
*
Yt = $EVAL([Y2]-[Dy])
Xt = $EVAL([X2]-0.1)
Set TXAL 33
Itx [Xt] [Yt] [Id] ; Yt = $EVAL([Yt]-[Dy])
Itx [Xt] [Yt] $HINFO([Id],'ENTRIES') ; Yt = $EVAL([Yt]-[Dy])
Itx [Xt] [Yt] $HINFO([Id],'MEAN') ; Yt = $EVAL([Yt]-[Dy])
Itx [Xt] [Yt] $HINFO([Id],'RMS') ; Yt = $EVAL([Yt]-[Dy])
Itx [Xt] [Yt] $HINFO([Id],'OVERFLOW') ; Yt = $EVAL([Yt]-[Dy])
Itx [Xt] [Yt] $HINFO([Id],'UNDERFLOW')
*
Return
This macro has five parameters:
|
PAW > H/Plot 10
PAW > Exec draw_stat 10 2 10 2 6 | the position is in cm
|
Example:
|
SET * ; OPT * | Reset the defaults
Nul 0 1 0 1 | draw an empty frame with axis
Set ndvy 5 | Change number of Y divisions
Nul 0 10 0 10 ABS | Redefine the scales
Ticks XR 5 ! | Axis in the new coordinates
|
PAW > VECTOR/DELETE *
PAW > VECTOR/READ X,Y snoopy.dat
PAW > GRAPH $VDIM(X,1) X Y
The output produced is:

10.45700 19.02800 9.867000 18.91000 9.308000 18.61600 8.630000 18.46800 8.012000 18.38000 7.393000 18.49800 6.834000 18.61600 5.862000 18.61600 4.860000 18.38000 3.829000 17.76100 3.240000 16.96600 2.710000 16.23000 2.769000 14.90400 2.209000 14.96300 1.826000 15.28700 1.708000 15.75800 1.767000 16.20000 2.150000 16.40600 2.504000 16.46500 2.828000 16.31800 2.739000 14.78600 3.063000 13.96200 3.535000 13.34300 3.976000 12.96000 4.801000 12.48900 5.596000 12.28300 6.274000 12.16500 6.863000 11.95900 7.305000 11.51700 7.806000 10.86900 8.012000 10.51500 7.894000 10.19100 7.688000 9.838000 7.246000 9.543000 7.010000 9.779000 7.452000 10.30900 6.745000 11.34000 5.803000 11.90000 5.037000 11.72300 5.214000 11.60500 5.420000 11.16300 5.125000 10.92800 4.772000 10.72200 4.242000 10.75100 3.711000 10.54500 3.358000 10.13300 3.152000 9.602000 3.417000 9.161000 4.300000 9.013000 4.624000 8.866000 4.948000 8.277000 4.890000 8.189000 4.683000 8.159000 4.536000 7.629000 5.007000 7.010000 4.566000 6.745000 5.155000 6.068000 4.477000 6.038000 4.271000 5.744000 4.477000 5.508000 4.801000 5.331000 5.214000 5.302000 5.685000 5.538000 5.655000 4.890000 6.097000 3.976000 6.627000 3.505000 6.480000 2.592000 5.891000 2.445000 4.860000 2.474000 4.389000 2.415000 3.800000 2.003000 3.594000 1.532000 3.711000 1.149000 4.035000 1.031000 4.536000 1.060000 4.683000 1.178000 5.331000 1.031000 6.598000 1.001000 9.219000 .9430000 10.45700 1.031000 10.75100 1.237000 10.75100 1.473000 10.39800 1.856000 9.985000 2.003000 9.367000 2.180000 8.984000 2.445000 8.807000 2.946000 8.748000 3.623000 8.984000 3.918000 9.602000 4.124000 10.36800 3.594000 11.34000 3.152000 11.95900 3.152000 11.48700 3.623000 10.45700 4.035000 9.750000 4.507000 9.750000 5.361000 9.396000 5.714000 9.190000 6.598000 9.161000 7.452000 8.954000 8.041000 8.895000 8.748000 8.954000 9.426000 8.984000 9.838000 9.485000 10.39800 9.956000 10.57400 10.66300 10.66300 11.10500 10.66300 11.57600 9.897000 12.10600 9.720000 12.54800 9.750000 13.13700 9.867000 13.90300 10.54500 14.34500 11.07500 14.69800 12.10600 14.72800 13.72600 14.22700 15.46400 14.02100 16.34800 13.25500 17.73200 12.01800 18.58600 10.48600 19.05700
Assuming that fitting is done to a straightforward one- dimensional histogram using essentially a minimization of chi2. Then the only complication is that the "error" in each bin, i.e. the error in the difference between the function curve and the bin contents, has an added component due to the fact that x is also not perfectly known. The usual technique is to calculate chi2 as the sum over bins of:
(n - f)2
-------------
dy2 + (f' dx)2
where n is the experimental bin content, f and f'
are respectively the
value of the function being fitted and its derivative, both taken at the
nominal value of x, and dx and dy are the errors
in x and y. (dy is
usually taken as the square root of n.) This clearly assumes that the
function being fitted is nearly a straight line inside a bin (or inside a
dx). If that is not true, the problem becomes highly non-linear and I
wouldn't believe the results of any fit.
The expression above is easy to calculate, since as you are looping over bins, you can remember the value of f from the previous bin and use that to estimate f'. Just watch out at both ends!
If the chi2 is calculated as indicated above and the approximations are valid, then all the other features of MINUIT (calculation of parameter errors, error matrix, contours, etc.) will automatically take account correctly of the errors in x and y.
Fred James
All the IGSET options are also available in SET. It is strongly recommended to use only SET to avoid mistakes.
Program CWN
*
Common /Pawc/ H(100000)
Parameter (Nmax = 100)
Common /CWN/ N,X(Nmax),Y(Nmax),Z(Nmax)
*.___________________________________________
*
Call Hlimit(100000)
*
Call Hropen(1,'CWN','cwn.hbook','N',1024,Istat)
If (Istat.Ne.0) Then
Print*, 'Error in opening file ...'
Stop
Endif
*
Call Hbnt(1,'CWN',' ')
Call Hbname(1,'Block1',N,'N[0,100], X(N), Y(N), Z(N)')
*
Do N=1,Nmax
Do I=1,N
X(N) = N*N
Y(N) = N*N*N
Z(N) = SIN(X(N))
EndDo
Call HFNT(1)
EndDo
*
Call Hrout(0,Icycle,' ')
Call Hrend('CWN')
*
end
sigma x=array(10,1#10)
v/li
application comis quit
Subroutine Square
VECTOR x,sqrx(10)
Do i = 1, 10
sqrx(i)=x(i)**2
Write (6,*) 'square of',x(i),sqrx(i)
Enddo
End
quit
call square
v/pri x
v/pri sqrx
In this example, the vector x is created via a PAW command
and is visible in the routine SQUARE. The vector SQRX doesn't
exists before SQUARE is called, so it is created with 10
entries.
(BSIZE+250)*N+20000 words
Where
BSIZE
is the Ntuple buffer size as can be set via the routine
HBSET
(default 1024 words).
The second part is taken by the RZ directory structure which contains the
keys that describe where the Ntuple extensions are stored (Ntuple extensions
are the column memory buffers which are flushed to disk, each extension has
a size of
BSIZE words).
For each key 6 words are needed. The number of keys
needed to store
M
events is dependent on the column packing factor (the
higher the packing factor is, the more events fit in a column buffer) and
on the
BSIZE
(the larger is
BSIZE
the fewer extensions need to be stored).
An upper limit is given by the key quota as specified in
HROPEN,
via
IQUEST(10)
(don't forget to include the
COMMON/QUEST/IQUEST(100)
in the routine where you call
HROPEN
). Assume you set
IQUEST(10)=65000
(the maximum) you will need at maximum:
65000*6 = 390000 words
Following from the above the maximum obtainable file size can easily be
determined:
IQUEST(10)*BSIZE*4 bytes
The number of events that can be stored in a file is approximately given by:
M = IQUEST(10)*BSIZE*packing/N
where packing is the average packing factor of all columns (all elements
of an array column are stored in the same buffer so they have a very small
packing factor).
PAW > call file.cwhere file.c is:
#include <stdio.h>
file_()
{
printf("this is a test\n");
}
Note that on some machine (HPUX, Linux ...) a "_" should
be added at the end of the procedure name. This is not necessary on all
machines just try both on your machine if you are unsure.
If you want to pass parameters, you should be careful to declare them as
pointers as FORTRAN passes parameters by address and C by value. Example:
#include <stdio.h>
file_(int *i)
{
int j=*i*100;
printf("this is a test %d\n",j);
}
this gives:
PAW > call file.c(123)
this is a test 12300
Note that if you want to call some CERNLIB Fortran subroutines
from a C program, your should use the
cfortran.h package.
Example:
Hi/fit 10 userf.f 0 6 parvalues
Application COMIS quit
Subroutine Set_names
Parameter (Npar=6)
Character*8 Names(Npar)
Names(1)='p1_name'
Names(2)=...
Call Hfinam(10,names,npar)
End
Quit
Call Set_names
Opt fit
Histo/Plot 10
Note the 0 option for CHOPT in Histo/Fit: the plot is not done by the fit
command.
If one of the names begins with "-", the parameters is not drawn when the option "FIT" is on.
The routine HGFIT (see HBOOK manual) return all the fit parameters including the parameter names. This routine takes the info from the HBOOK data structure.
SIGMA X=array(1000,1#10) SIGMA Y=sin(X)*X SIGMA Z=sin(X*X)*X call dvect.f(x,y,z)Where dvect.f is:
Subroutine Dvect(X,Y,Z)
Real X(1000)
Real Y(1000)
Real Z(1000)
Xmin = X(1)
Xmax = X(1)
Ymin = Y(1)
Ymax = Y(1)
Zmin = Z(1)
Zmax = Z(1)
Do i=2,1000
If (X(i).Lt.Xmin) Xmin=X(i)
If (X(i).Gt.Xmax) Xmax=X(i)
If (Y(i).Lt.Ymin) Ymin=Y(i)
If (Y(i).Gt.Ymax) Ymax=Y(i)
If (Z(i).Lt.Zmin) Zmin=Z(i)
If (Z(i).Gt.Zmax) Zmax=Z(i)
Enddo
Call Hplfr3(Xmin,Xmax,Ymin,Ymax,Zmin,Zmax,30.,30.,'FWB')
Call Ipm3(1000,X,Y,Z)
End
application comis quit
function func(x)
func=1.
end
subroutine funtest
external func
call hbfun1(10,'TEST hrndm1 ',100,0.,3.14,func)
End
quit
call funtest
To solve this problem, dynamic loading should be used i.e. put
funtest and func in the file funtest.f and do:
call funtest.f77
as describe
here
and in the PAW FAQ called "Dynamic linking".
Note that all the CERNLIB functions (for example HFITH, HFITV etc ...) using EXTERNAL will have the same problem when they are used via COMIS.
Macro Integral 1=0 2=0 3=0
*
* This Macro computes the Sum, Integral and the Mean Value of a given
* histogram between two channels. The input format should be:
* `inte ID CH_low CH_high', where `inte' is the alias to execute
* this kumac file, ID is the histogram id number, CH_low and
* CH_high are low and high channel numbers. All three numbers
* MUST be positive integers. - Yingchao Zhang
*
* Modified by : Olivier Couet (15th September 1994)
*
Trace off
If $VEXIST(Out)<>0 Then
V/Del Out
Endif
V/Create Out(3)
*
Application Comis Quit
Subroutine Integral(Id,Nl,Nh)
Character*80 Chtitl
Vector Out
Call Hgive(Id,Chtitl,Nx,Xmi,Xma,0,Ymi,Yma,Nwt,Loc)
If(Nl.Le.0) Nl=1
If(Nh.Ge.Nx) Nh=Nx
S = (Xma-Xmi)/Float(Nx)
W = 0.0
Y = 0.0
Z = 0.0
Do I = Nl,Nh
X = Xmi + (Float(I)-0.5)*S
Y = Y + Hx(Id,X)
W = W + Hx(Id,X)*X
EndDo
Z = Y*S
W = W/Y
Out(1) = Y
Out(2) = Z
Out(3) = W
End
Quit
*
* Check the input parameter
*
Id = [1]
Nl = [2]
Nh = [3]
If [Id] = 0 Then
Read Id 'Histogram identifier'
Endif
If [Nl] = 0 Then
Read Nl 'First channel'
Endif
If [Nh] = 0 Then
Read Nh 'Last channel'
Endif
*
* PLot the histogram and compute the integral
*
If $HEXIST([Id])=0 Then
Hrin [Id]
Endif
Histo/Plot [Id]([Nl]:[Nh])
Call Integral([Id],[Nl],[Nh])
Y = Out(1)
Z = Out(2)
W = Out(3)
Exec Rt 0.025 0.95 'Sum = '//[Y]
Exec Rt 0.025 0.90 'Integral = '//[Z]
Exec Rt 0.025 0.85 'Mean = '//[W]
V/Del Out
*
Return
Macro rt 1=0. 2=0. 3=' ' 4=.3
*
X1 = $GRAFINFO('WNXMIN')
X2 = $GRAFINFO('WNXMAX')
Y1 = $GRAFINFO('WNYMIN')
Y2 = $GRAFINFO('WNYMAX')
X = ([X2]-[X1])*[1]+[X1]
Y = ([Y2]-[Y1])*[2]+[Y1]
Set CHHE [4]
Set TXAL 3
Itx [X] [Y] [3]
*
Return
Macro DUPRWN
Close 0
Hi/File 1 hrztest.hbook
Hi/File 2 hrztest_new.hbook ! N
Nt/Dup //lun1/30 2
*
Application Comis Quit
Real Function Dup
Include ?
If (x.gt.0..and.y.gt.0.) call hfn(2,x)
dup=1.
end
Quit
*
nt/loop //lun1/30 dup
*
cd //lun2 |<------------------- For PAW version 2.07 only (see here)
*
hrout 2
*
* Verification: the 2 plots should be the same.
*
Option STAT
Zone 1 2
Nt/plot //lun1/30.x x.gt.0..and.y.gt.0.
Nt/plot //lun2/2.x
Macro DUPCWN1
*
Close 0 | Close all the currently opened file
H/file 1 hcwn.hbook | hcwn.hbook contains the ntuple to be duplicated
Hrin 1
Uwfunc //lun1/1 hcwn.inc | Copy the Ntuple structure into hcwn.inc
H/file 2 hcwn_new.hbook ! N | Create a new hbook file
Nt/Dup //lun1/1 11 | Duplicate the ntuple 1 in the ntuple 11
*
* Comis routine which Loop on all events of Id1 and select some events to be
* written in the new ntuple Id2.
*
Application COMIS quit
Subroutine ntdup(Id1,Id2)
Include 'hcwn.inc'
Call Hnoent(Id1,Noent)
Do Ievent=1,Noent
Call Hgnt(Id1,Ievent,Ierr)
If (Ierr.ne.0) Goto 20
If (Vx.Gt.0..Or.Vy.Gt.0.) Then
Call Hfnt(Id2)
Endif
Enddo
20 Continue
*
End
Quit
*
Call Ntdup(1,11) | Execute the routine Ntdup
Hrout 11 | Write Id2 on disk
*
* Verification: the 2 plots should be the same.
*
Option STAT
Zone 1 2
Nt/plot //lun1/1.vx vx.gt.0..or.vy.gt.0
Nt/plot //lun2/11.vx
*
Return
It is possible to do more in the fortran program:
Macro DUPCWN2
*
Close 0 | Close all the currently opened file
H/file 1 hcwn.hbook | hcwn.hbook contains the ntuple to be duplicated
Hrin 1 | Load the ntuple 1 in memory
Uwfunc //lun1/1 hcwn.inc | Copy the Ntuple structure into hcwn.inc
H/file 2 hcwn_new.hbook ! N | Create a new hbook file
*
Application COMIS quit
Subroutine ntdup(Id1,Id2)
include 'hcwn.inc'
*
* Duplicate structure of ntuple Id1 into Id2
*
Call Hntdup(Id1,Id2,-1,' ','A')
*
* Loop on all events of Id1. Select some events to be written
* in the new ntuple Id2.
*
Call Hnoent(Id1,Noent)
Do Ievent=1,Noent
Call Hgnt(Id1,Ievent,Ierr)
If (Ierr.Ne.0) Goto 20
If (Vx.Gt.0..Or.Vy.Gt.0.) Then
Call Hfnt(id2)
Endif
Enddo
20 Call Hrout(Id2,icycle,' ')
*
End
quit
*
Call Ntdup(1,11) | Execute the routine Ntdup
*
* Verification: the 2 plots should be the same.
*
Option STAT
Zone 1 2
Nt/plot //lun1/1.vx vx.gt.0..or.vy.gt.0
Nt/plot //lun2/11.vx
Note: Take care that the local variables used in the COMIS
routine are different from the field names in the Ntuple.
NT/LOOP 1 $1.AND.a.fwhere 1 is the ntuple identifier, $1 the graphical cut and a.f the LOGICAL fortran function (generated with the command UWFUNC) filling the new ntuple. The problem is that only the used ntuple variables in a.f will be loaded in the PAWCR4 common block. So you want all the variables in the new ntuple, you will have to use them all in a "dummy" way in a.f. For example you can do something like:
LOGICAL FUNCTION A
.
.
IF (IDNEVT.EQ.0) THEN
DUMMY = X1
DUMMY = X2
.
.
DUMMY = XI
..
ENDIF
.
.
END
where the XI are the all ntuple variables.
subroutine ac
character*16 filename
character*80 line
filename='data.hbook'
line = 'global/create filename '''//filename//''''
call kuexel(line)
end
Usage:
PAW > call ac.f
PAW > mess [filename]
data.hbook
macro quote
a = $quote('String test')
appl comis quit
subroutine test(c)
character*(*) c
print*, c
end
quit
call test([a])
Usage:
PAW > exe quote String test
HI/FIT 1 fff.f ! 1 par
the first thing this command do, is to set the pointer to the current
histogram to the histogram identified by
1 and it assumes this pointer
will not change during the command execution. This is usually the case with
"normal" fit functions.
The problem in different when HBOOK functions like
HCX,
HXI... are called
inside the fitting function because these functions (HCX, HXI...)
change the pointer to the current histogram and the fit command (which
assume this pointer doesn't change) point to the wrong histogram.
There is a way to fake the HI/FIT command. The following example shows
how to proceed:
macro f v/del *; h/del * zone 1 3 vector/create xx(10) r 1 2 3 4 5 5 4 3 2 1 vector/draw xx 1 sigma yy=3*xx vector/draw yy 2 vector/create par(1) r 1. histogram/fit 1 fff.f ! 1 parIn the following fitting function HFIND reset the current histogram before exiting the function.
function fff(x)
common /pawpar/ par(1)
y=hx(2,x)
call hfind(1,' ')
fff=y*par(1)
end
|
PAW > exe f
**********************************************
* *
* Function minimization by SUBROUTINE HFITH *
* Variable-metric method *
* ID = 1 CHOPT = *
* *
**********************************************
Convergence when estimated distance to minimum (EDM) .LT. 0.10E+01
FCN= 0.1500666E-11 FROM MIGRAD STATUS=CONVERGED 12 CALLS 13 TOTAL
EDM= 0.30E-11 STRATEGY= 1 ERROR MATRIX ACCURATE
EXT PARAMETER STEP FIRST
NO. NAME VALUE ERROR SIZE DERIVATIVE
1 P1 0.33333 0.60858E-01 0.23809E-02 -0.40413E-04
CHISQUARE = 0.1667E-12 NPFIT = 10
|
You must recreate your ntuple as a disk resident one (see the FAQ "How to create a disk resident Row Wise Ntuple").
appl data nt.dat
0 1 0.1
1 2 0.2
2 3 0.3
3 4 0.15
4 5 0.4
5 5 0.2
6 4 0.1
7 3 0.2
8 2 0.1
9 1 0.3
nt.dat
ntuple/create 1 'Test' 3 ! ! X Y EY
nt/read 1 nt.dat
appl comis quit
REAL FUNCTION A
REAL
+X ,Y ,EY
*
LOGICAL CHAIN
CHARACTER*128 CFILE
*
COMMON /PAWCHN/ CHAIN, NCHEVT, ICHEVT
COMMON /PAWCHC/ CFILE
*
COMMON/PAWIDN/IDNEVT,OBS(13),
+X ,Y ,EY
*
dimension xx(2),yy(2)
*
XX(1) = X
XX(2) = X
YY(1) = Y-EY
YY(2) = Y+EY
CALL IPL(2,XX,YY)
END
quit
set MTYP 20
nt/plot 1.y%x
nt/loop 1 A

Macro test
null 0 10 0 10 'ab'
igset txal 23
igset chhe 0.5
igset txfp -130
igset fais 1
igset fasi 0
igset faci 2
box 2 8 5 7
itx 5 6 'Example of text'
return
PAW > Exec test | with opt zfl1 in pawlogon.kumac
PAW > pi/print paw.ps
This problem can be avoid in 2 ways:
1)
PAW > for/file 66 paw.ps ; meta 66 -111
PAW > exec test
PAW > close 66
2)
PAW > exec test | with opt zfl1 in pawlogon.kumac
PAW > exe print
Where print is
macro print
for/file 66 paw.ps ; meta 66 -111
sel 1 ; izpict ' ' d
close 66
Note: IZPICT with option D draws the a picture without reordering the
normalisation transformations.
Example:
Fun2 2 x*y 40 0 1 40 0 1 ' '
V/Cr PAR(5) R .1 .11 .3 .31 .5
Set DMOD 1
set HCOL 1
Contour 2 1 2 PAR(1)
Do i=2,5
Set HCOl [i]
Contour 2 1 2S PAR([i])
Enddo
subroutine mess(lun,chmess)
character*(*) chmess
write (lun,'(a)') chmess
end
as follow:
PAW > output 22 a.dat
PAW > call mess.f(22,'hello')
If the character string is in a variable, the system function $QUOTE
should be used before calling the routine mess.f in order to enclose
the string with ' ':
a=$quote(hello)
output 22 a.dat
call mess.f(22,[a])
Macro Emat
Histo/fit 110(50:) G
Application COMIS Quit
Subroutine Get_Emat
Parameter (ndim=3)
Double Precision demat(ndim,ndim)
Vector Emat(ndim,ndim)
Call Mnemat(demat,ndim)
Do i=1,ndim
Do j=1,ndim
emat(j,i)=demat(j,i)
Enddo
Enddo
End
Quit
Call Get_Emat
Vector/Print Emat
Return
Note that the matrix is returned in a
DOUBLE Precision array.
It is copied into a single precision vector.
PROGRAM HTONEW
*
* Program to convert old format HBOOK files into new format
* New files are by default in RZ Exchange mode
* RWN are converted into CWN.
*
PARAMETER (MXBOOK=1000000)
COMMON/PAWC/ PAW(MXBOOK)
COMMON/QUEST/ IQUEST(100)
COMMON/HINFO/LRECL
*
CHARACTER*80 FILOUT,FILIN
*
EXTERNAL CONVERT
*
*===========================================================
*
print*, 'Input file ?'
read*, filin
print*, 'Output file ?'
read*, filout
lo = lenocc(filout)
li = lenocc(filin)
nsize = 0
*
CALL HLIMIT(MXBOOK)
CALL HBSET('BSIZE',100,IERR)
*
*
10 CONTINUE
*
*-* Create directory //PAWC/OLDF to store old ntuples
CALL HMDIR('OLDF',' ')
*-* Open old file and get record length
* LRECL=0 If LRECL=0 does not work,specify LRECL for your file
LRECL=NSIZE
CALL HROPEN(1,'OLDF',FILIN,' ',LRECL,ISTAT)
LRECL=IQUEST(10)
IF(ISTAT.NE.0) THEN
WRITE (6,'('' FILE : '',A80,'' CANNOT BE OPENED'')') FILIN(1:
+ LI)
GO TO 20
END IF
*
*-* Create new file
IQUEST(10) = 64000
if(lrecl.gt.4096)lrecl=4096
* lrecl=4096
print *,' Creating new file with LRECL=',lrecl,' words'
CALL HROPEN(2,'NEWF',FILOUT(1:LENOCC(FILOUT)),'QN',LRECL,ISTAT)
IF(ISTAT.NE.0) THEN
WRITE (6, '('' FILE : '',A80, '' CANNOT BE CREATED'')')
+ FILOUT(1:LO)
GOTO 20
END IF
*
*
*-* Convert
CALL HCDIR('//OLDF',' ')
CALL RZSCAN (' ', CONVERT)
CALL HREND ('NEWF')
CLOSE (2)
CALL HREND ('OLDF')
CLOSE (1)
*
WRITE (6,'('' Conversion completed'')')
*
* Abnormal end
20 CONTINUE
*
END
SUBROUTINE CONVERT (CDIR)
*
CHARACTER*(*) CDIR
*
INTEGER NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU, LMAIN
REAL FENC , HCV
COMMON/PAWC/NWPAW,IXPAWC,IHDIV,IXHIGZ,IXKU,FENC(5),LMAIN,HCV(9989)
INTEGER IQ ,LQ
REAL Q
DIMENSION IQ(2),Q(2),LQ(8000)
EQUIVALENCE (LQ(1),LMAIN),(IQ(1),LQ(9)),(Q(1),IQ(1))
INTEGER HVERSN,IHWORK,LHBOOK,LHPLOT,LGTIT,LHWORK,
+LCDIR,LSDIR,LIDS,LTAB,LCID,LCONT,LSCAT,LPROX,LPROY,LSLIX,
+LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT,
+LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHDUM ,LCIDN
COMMON/HCBOOK/HVERSN,IHWORK,LHBOOK,LHPLOT,LGTIT,LHWORK,
+LCDIR,LSDIR,LIDS,LTAB,LCID,LCONT,LSCAT,LPROX,LPROY,LSLIX,
+LSLIY,LBANX,LBANY,LPRX,LPRY,LFIX,LLID,LR1,LR2,LNAME,LCHAR,LINT,
+LREAL,LBLOK,LLBLK,LBUFM,LBUF,LTMPM,LTMP,LTMP1,LHDUM(10),LCIDN
*
INTEGER KNCX ,KXMIN ,KXMAX ,KBWIDX ,KMIN ,KMAX ,KNORM ,
+ KTIT1 ,KNCY ,KYMIN ,KYMAX ,KBWIDY ,KSCAL2 ,
+ KTIT2 ,KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH ,
+ KCON1 ,KCON2 ,KBITS ,KNTOT
PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KBWIDX=6,KMIN=7,KMAX=8,KNORM=9,
+ KTIT1=10,KNCY=7,KYMIN=8,KYMAX=9,KBWIDY=10,KSCAL2=11,
+ KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6,
+ KCON1=9,KCON2=3,KBITS=1,KNTOT=2)
parameter (kip1=20)
*
COMMON/QUEST/ IQUEST(100)
*
COMMON/HINFO/LRECL
*
CHARACTER*80 TITLE, RDIR
*
parameter (nev=1000)
parameter (nmax=500)
parameter (nbvmax=40)
parameter (ntotmax=50000000)
dimension x(nmax,nev)
common/event/y(nmax)
dimension iy(nmax)
equivalence (y(1),iy(1))
character*8 tags(nmax),tag1,bname
character*1300 chform
character*1 type
dimension rlow(nmax),rhigh(nmax)
*
WRITE (6, '('' Processing directory: '',A)')
+ CDIR(1:LENOCC(CDIR))
*
RDIR = CDIR
RDIR(3:6) = 'NEWF'
JLS = ICFILA ('/', CDIR, 1, LENOCC(CDIR))
IF (JLS .GT. 2) THEN
CALL HMDIR (RDIR, ' ')
END IF
*
*-* Loop on all keys in file (order of creation)
NKEY = 50000
DO 80 M = 1, NKEY
CALL HCDIR (CDIR, ' ')
CALL RZINK (M, 0, 'S')
IF (IQUEST(1) .NE. 0) GO TO 999
IF (JBIT (IQUEST(14),4) .NE. 0) GO TO 80
IDN = IQUEST(21)
CALL HRIN(IDN,999,0)
IF(IQUEST(1).NE.0) THEN
WRITE (6,'('' NTUPLE OR HISTO '',I10,'' CANNOT BE READ'')')
+ IDN
GO TO 90
END IF
IF (JBIT (IQ(LCID+KBITS),4) .NE. 0) THEN
*-* ntuple
*-* First read the specs of old ntuple
NVAR = NMAX
CALL HGIVEN(IDN,TITLE,NVAR,TAGS,RLOW,RHIGH)
call hnoent(idn,noent)
ntotal=min(ntotmax,noent)
CALL HDELET(IDN)
*-* Change directory to new file. Create new ntuple
*-* Put a maximum of NBVMAX variable per block (hbname)
*-* Blocks are labelled Block1,Block2,etc.
*-* Buffer size per column is set to (nwpaw-100000)/nvar or lrecl-15 words
nwbuf1=(nwpaw-100000)/nvar
if(nwbuf1.gt.33000)nwbuf1=33000
if(nwbuf1.gt.noent)then
nwbuf=noent+1
else
nwmod=mod(nwbuf1,lrecl)
nwbuf=nwbuf1-nwmod-15
endif
** nwbuf=nwbuf1
** if(nwbuf1.gt.lrecl-15)nwbuf=lrecl-15
** if(nwbuf1.gt.2*lrecl-15)nwbuf=2*lrecl-15
if(nwbuf.lt.100)nwbuf=min(noent,nwbuf1)
call hbset('BSIZE',nwbuf,ierr)
print *,' Converting ntuple:',idn,' Bsize =',nwbuf,' words'
call hcdir(rdir,' ')
*-* We want to force new ntuple record to start at word 1 of a new record
lrzcdir=iquest(11)
iq(lrzcdir+kip1)=lrecl+1
call rzmods('CONVER',ierr)
call rzsave
CALL HBNT(IDN,TITLE,' ')
chform=' '
icold=1
nbn=0
type='R'
do 10 i=1,nvar
tag1=tags(i)
if(tag1.eq.' ')then
write(tag1,30000)i
30000 format('VAR',I3)
if(tag1(4:4).eq.' ')tag1(4:4)='0'
if(tag1(5:5).eq.' ')tag1(5:5)='0'
endif
nch=lenocc(tag1)
icnew=icold+nch+2
chform(icold:icnew)=tag1(1:nch)//':'//type//','
if(mod(i,nbvmax).eq.0.or.i.eq.nvar)then
nbn=nbn+1
if (nbn.ge. 1 .and. nbn.lt. 10) then
write(bname,10000)nbn
10000 format('Block',i1)
elseif (nbn.ge. 10 .and. nbn.lt. 100) then
write(bname,10001)nbn
10001 format('Block',i2)
elseif (nbn.ge.100 .and. nbn.lt.1000) then
write(bname,10002)nbn
10002 format('Block',i3)
else
print *, 'CONVERT: In trouble, NBN = ',nbn
bname = 'BlockXYZ'
endif
ibl=(nbn-1)*nbvmax +1
call hbname(idn,bname,y(ibl),chform(1:icnew-1))
icnew=0
chform=' '
endif
icold=icnew+1
10 continue
*
*
*-* Now loop to fill new ntuple.
*-* To avoid changing directory too frequently, buffer NEV events in memory
do 60 i=1,ntotal,nev
print *,' Number of events processed= ',i
call hcdir('//PAWC/OLDF',' ')
call hcdir(cdir,' ')
do 20 j=1,nev
k=i+j-1
if(k.gt.ntotal)go to 30
call hgn(idn,nidn,k,x(1,j),ierror)
20 continue
30 continue
call hcdir('//PAWC',' ')
call hcdir(rdir,' ')
do 50 j=1,nev
k=i+j-1
if(k.gt.ntotal)go to 70
do 40 l=1,nvar
y(l)=x(l,j)
40 continue
call hfnt(idn)
50 continue
60 continue
70 continue
*-* save new ntuple header onto file
call hrout(idn,icycle,' ')
call hdelet(idn)
call hcdir('//PAWC/OLDF',' ')
call hdelet(0)
call hcdir('//PAWC',' ')
ELSE
*-* Histogram
call hcdir(rdir,' ')
call hrout(idn,icycle,' ')
CALL HDELET(IDN)
END IF
80 CONTINUE
GO TO 999
*
* Abnormal end
90 CONTINUE
*
999 END
SELNT 1 | Select the centimetres
TEXT 1 1 'Hello' .3