FORTRAN EXAMPLE PROGRAMS

I. Using Histo-Scope with HBOOK:

PROGRAM HBOOKEXAMPLE

C

C PROGRAM TO GENERATE RANDOM NTUPLE AND HISTOGRAM DATA

C

IMPLICIT NONE

#include "histoscope.inc"

C

C IF COMPILING PROGRAM ON VMS OR IBM/AIX SYSTEM, COMMENT OUT

C ABOVE INCLUDE AND REMOVE THE C IN COLUMN 1 OF ONE OF THE FOLLOWING:

C

C IBM/AIX:

C INCLUDE 'histoscope.inc'

C VMS:

C INCLUDE 'HISTO_INC:histoscope.inc'

INTEGER I, J, K, N_VARIABLES

REAL VALUES(8)

REAL RNDOM

CHARACTER*8 TAGS(8)

COMMON/PAWC/H

REAL*4 H(1 000 000)

N_VARIABLES = 8

TAGS(1) = 'X'

TAGS(2) = 'Y'

TAGS(3) = 'IDX'

TAGS(4) = 'SQRT(X)'

TAGS(5) = 'SQRT(Y)'

TAGS(6) = 'LOG(X)'

TAGS(7) = 'LOG(Y)'

TAGS(8) = 'SIN(IDX)'

CALL HS_INITIALIZE('hbookExample.f')

CALL HS_HISTOSCOPE(1)

CALL HLIMIT(250 000)

CALL HBOOKN(900, 'EXAMPLE NTUPLE', N_VARIABLES, ' ', 1000, TAGS)

CALL HBOOK2(5000,'2D HIST EXAMPLE',100,4600.,5400., 100,4600.,

& 5400.0, 0.)

CALL HBOOK1(6000,'EXAMPLE 1D HIST',100,4600.,5400.,0.0)

PRINT *, ' HLDIR CALLED: '

CALL HLDIR('//PAWC', 'T')

CALL HS_HBOOK_SETUP('//PAWC')

C

C RANDOM DATA COMPUTATION - THIS COULD BE ANY CODE YOU WISH

C

DO I = 1, 10000

DO J = 1, 2

VALUES(J) = 0

DO K = 1, 1000

VALUES(J) = VALUES(J) + RNDOM(0) * 10.

ENDDO

ENDDO

VALUES(3) = I

VALUES(4) = SQRT(VALUES(1))

VALUES(5) = SQRT(VALUES(2))

VALUES(6) = LOG(VALUES(1))

VALUES(7) = LOG(VALUES(2))

VALUES(8) = SIN(VALUES(3))

CALL HFILL(5000, VALUES(1), VALUES(2), 1.)

CALL HFILL(6000, VALUES(2), 0., 1.)

CALL HFN(900, VALUES)

CALL HS_UPDATE

IF ( MOD(I, 200) .EQ. 0) THEN

PRINT *, ' Reaching computation ...', I

ENDIF

END DO

CALL HS_COMPLETE

CALL HRPUT(0, 'hbookexample.hst', 'TN')

STOP

END

REAL FUNCTION RNDOM()

INTEGER A,M,Q,R,HI,LO,TEST

DATA A, M, Q, R, ISEED /16807, 2147483647, 127773, 2836, 19283755/

HI = ISEED/Q

LO = MOD(ISEED,Q)

TEST = A*LO - R*HI

IF(TEST.GT.0) THEN

ISEED = TEST

ELSE

ISEED = TEST + M

END IF

RNDOM = FLOAT(ISEED)/M

RETURN

END

II. Using Histo-Scope Routines only (no HBOOK calls)

PROGRAM HSEXAMPLE

C

C PROGRAM TO GENERATE RANDOM NTUPLE AND HISTOGRAM DATA

C

IMPLICIT NONE

#include "histoscope.inc"

C

C IF COMPILING PROGRAM ON VMS OR IBM/AIX SYSTEM, COMMENT OUT

C ABOVE INCLUDE AND REMOVE THE C IN COLUMN 1 OF ONE OF THE FOLLOWING:

C

C IBM/AIX:

C INCLUDE 'histoscope.inc'

C VMS:

C INCLUDE 'HISTO_INC:histoscope.inc'

INTEGER I, J, K, N_VARIABLES, HS1_ID, HS2_ID, NTUPLE_ID

INTEGER IND_ID, ISTAT

REAL VALUES(8)

REAL RNDOM

CHARACTER*8 TAGS(8)

N_VARIABLES = 8

TAGS(1) = 'X'

TAGS(2) = 'Y'

TAGS(3) = 'IDX'

TAGS(4) = 'SQRT(X)'

TAGS(5) = 'SQRT(Y)'

TAGS(6) = 'LOG(X)'

TAGS(7) = 'LOG(Y)'

TAGS(8) = 'SIN(IDX)'

CALL HS_INITIALIZE('hsExample.f')

CALL HS_HISTOSCOPE(1)

NTUPLE_ID = HS_CREATE_NTUPLE(101, 'EXAMPLE NTUPLE', 'HS',

& N_VARIABLES, TAGS)

HS1_ID = HS_CREATE_1D_HIST(102, 'EXAMPLE 1D HIST', 'HS', 'Y',

& 'TOTAL', 100, 4600., 5400.)

HS2_ID = HS_CREATE_2D_HIST(103, '2D HIST EXAMPLE', 'HS','X', 'Y',

& 'TOTAL', 100, 100, 4600., 5400., 4600., 5400.)

IND_ID = HS_CREATE_INDICATOR(104, 'INDICATOR EXAMPLE', 'HS', 0.,

& 10000.)

C

C RANDOM DATA COMPUTATION - THIS COULD BE ANY CODE YOU WISH

C

DO I = 1, 10000

DO J = 1, 2

VALUES(J) = 0

DO K = 1, 1000

VALUES(J) = VALUES(J) + RNDOM() * 10.

ENDDO

ENDDO

VALUES(3) = I

VALUES(4) = SQRT(VALUES(1))

VALUES(5) = SQRT(VALUES(2))

VALUES(6) = LOG(VALUES(1))

VALUES(7) = LOG(VALUES(2))

VALUES(8) = SIN(VALUES(3))

ISTAT = HS_FILL_NTUPLE(NTUPLE_ID, VALUES)

CALL HS_FILL_1D_HIST(HS1_ID, VALUES(2), 1.)

CALL HS_FILL_2D_HIST(HS2_ID, VALUES(1), VALUES(2), 1.)

CALL HS_SET_INDICATOR(IND_ID, FLOAT(I))

CALL HS_UPDATE

IF ( MOD(I, 200) .EQ. 0) THEN

PRINT *, ' Reaching computation ...', I

ENDIF

END DO

ISTAT = HS_SAVE_FILE('hsExample.hs')

CALL HS_COMPLETE

STOP

END

REAL FUNCTION RNDOM()

INTEGER A,M,Q,R,HI,LO,TEST

DATA A, M, Q, R, ISEED /16807, 2147483647, 127773, 2836, 19283755/

HI = ISEED/Q

LO = MOD(ISEED,Q)

TEST = A*LO - R*HI

IF(TEST.GT.0) THEN

ISEED = TEST

ELSE

ISEED = TEST + M

END IF

RNDOM = FLOAT(ISEED)/M

RETURN

END

III. Using Histo-Scope Application Program Interface

PROGRAM APIEXAMPLE

C

C PROGRAM TO GENERATE RANDOM N-TUPLE AND HISTOGRAM DATA AND DEMONSTRATE

C ADVANCED FEATURES OF THE HISTO-SCOPE APPLICATION PROGRAMMING INTERFACE

C

IMPLICIT NONE

#include "histoscope.inc"

C

C IF COMPILING PROGRAM ON VMS OR IBM/AIX SYSTEM, COMMENT OUT

C ABOVE INCLUDE AND REMOVE THE C IN COLUMN 1 OF NEXT ONE

C

C INCLUDE 'histoscope.inc'

INTEGER I, J, K, N_VARIABLES, HS1_ID, HS2_ID, NTUPLE_ID, LEN

INTEGER CTRL_ID, IND_ID, CTRL_NPTS_ID, CTRL_MERRS_ID, I1, I2

INTEGER TRIGGER_ID, NUM_PTS, ISTAT, ID(20), NUM_ITEMS

REAL VALUES(8), CVAL, FVALPTS, ERRVAL_M, R1, R2, R3

REAL ERRS1D(100), ERRS2D(10000), ERRS1D_M(100), ERRS2D_M(10000)

REAL RNDOM, XMIN, XMAX, OVERFLOWS(9)

CHARACTER*8 TAGS(8)

CHARACTER *80 NAME

C

C NTUPLE PARAMETERS:

C

N_VARIABLES = 8

NUM_PTS = 10000

TAGS(1) = 'X'

TAGS(2) = 'Y'

TAGS(3) = 'IDX'

TAGS(4) = 'GAUS-1'

TAGS(5) = 'GAUS-2'

TAGS(6) = 'LOG(X)'

TAGS(7) = 'LOG(Y)'

TAGS(8) = 'SIN(IDX)'

C

C INITIALIZE ERROR ARRAYS FOR HISTOGRAMS:

C

DO I = 1, 10000

ERRS2D(I) = .1

ERRS2D_M(I) = 0.

ENDDO

DO I = 1, 100

ERRS1D(I) = .1

ERRS1D_M(I) = 0.

ENDDO

C

C INITIALIZE THE HISTOSCOPE API, START A PRE-CONNECTED HISTO-SCOPE

C PROCESS, AND CREATE ITEMS TO LOOK AT:

C

CALL HS_INITIALIZE('APIEXAMPLE')

CALL HS_HISTOSCOPE(1)

NTUPLE_ID = HS_CREATE_NTUPLE(101, 'EXAMPLE NTUPLE', 'HS',

& N_VARIABLES, TAGS)

HS1_ID = HS_CREATE_1D_HIST(102, 'EXAMPLE 1D HIST', 'HS', 'Y',

& 'TOTAL' ,100, 4600., 5400.)

HS2_ID = HS_CREATE_2D_HIST(103, '2D HIST EXAMPLE', 'HS',

& 'GAUS-1','GAUS-2', 'TOTAL', 100, 100, -3.5, 3.5, -4., 4.)

IND_ID = HS_CREATE_INDICATOR(104, 'INDICATOR EXAMPLE', 'HS',

& 0., 10000.)

CTRL_ID = HS_CREATE_CONTROL(201, 'CONTROL: PAUSE IF .LT. 0',

& 'HS', -500., +500., 0.)

CTRL_NPTS_ID = HS_CREATE_CONTROL(202, 'CONTROL: NUM OF PTS',

& 'HS', 0., 10000., 10000.)

CTRL_MERRS_ID = HS_CREATE_CONTROL(203,

& 'CONTROL: ACCUM NONSYM NEG ERRS', 'HS', 0., 1., 0.)

TRIGGER_ID = HS_CREATE_TRIGGER(301, 'TRIGGER EXAMPLE', 'HS')

PRINT *

PRINT *, ' NUMBER OF ITEMS CREATED: ', HS_NUM_ITEMS()

PRINT *

C

C RANDOM DATA COMPUTATION - THIS COULD BE ANY CODE YOU WISH

C

I = 1

DO WHILE (I .LE. NUM_PTS)

DO J = 1, 2

VALUES(J) = 0

DO K = 1, 1000

VALUES(J) = VALUES(J) + RNDOM() * 10.

ENDDO

ENDDO

VALUES(3) = I

VALUES(6) = LOG(VALUES(1))

VALUES(7) = LOG(VALUES(2))

VALUES(8) = SIN(VALUES(3))

50 R1 = RNDOM()

R2 = RNDOM()

R1 = 2.0 * R1 - 1.0

R2 = 2.0 * R2 - 1.0

R3 = R1 * R1 + R2 * R2

IF (R3 .GT. 1.0 ) GOTO 50

VALUES(4) = R1 * SQRT((-2.0*LOG(R3))/R3)

VALUES(5) = R2 * SQRT((-2.0*LOG(R3))/R3)

ISTAT = HS_FILL_NTUPLE(NTUPLE_ID, VALUES)

CALL HS_FILL_1D_HIST(HS1_ID, VALUES(2), 1.)

CALL HS_FILL_2D_HIST(HS2_ID, VALUES(4), VALUES(5), 1.)

CALL HS_SET_INDICATOR(IND_ID, FLOAT(I))

IF (HS_CHECK_TRIGGER(TRIGGER_ID) .NE. 0)

& PRINT *, ' Trigger set by HistoScope'

C

C CALL HS_UPDATE EVERY FILL ITERATION, SO THAT THE NEW DATA CAN

C BE SEEN BY THE HISTO-SCOPE USER

C

CALL HS_UPDATE

IF ( MOD(I, 200) .EQ. 0) THEN

PRINT *, ' Reaching computation ...', I

C

C SET POSITIVE ERRORS FOR HISTOGRAMS; IF HISTO-SCOPE USER

C DIRECTED, COMPUTE AND SET NON-SYMMETRIC NEGATIVE ERRORS:

C

CALL HS_SET_1D_ERRORS(HS1_ID, ERRS1D, %VAL(0))

CALL HS_SET_2D_ERRORS(HS2_ID, ERRS2D, %VAL(0))

CALL HS_READ_CONTROL(CTRL_MERRS_ID, ERRVAL_M)

DO K = 1, 10000

ERRS2D(K) = ERRS2D(K) + .1

IF (ERRVAL_M .GT. 0)

& ERRS2D_M(K) = ERRS2D_M(K) + ERRVAL_M

ENDDO

DO K = 1, 100

ERRS1D(K) = ERRS1D(K) + .1

IF (ERRVAL_M .GT. 0)

& ERRS1D_M(K) = ERRS1D_M(K) + ERRVAL_M

ENDDO

IF (ERRVAL_M .GT. 0) THEN

CALL HS_SET_1D_ERRORS(HS1_ID, %VAL(0), ERRS1D_M)

CALL HS_SET_2D_ERRORS(HS2_ID, %VAL(0), ERRS2D_M)

ENDIF

ENDIF

C

C READ CONTROLS AND SET THE NUMBER OF ITERATIONS ACCORDINGLY.

C ABSTAIN FROM DATA COLLECTION IF THE HISTO-SCOPE USER SETS

C "PAUSE IF .LT. 0" CONTROL < 0, BUT STILL READ "NUMBER OF POINTS"

C CONTROL AND CHECK THE TRIGGER:

C

CALL HS_READ_CONTROL(CTRL_ID, CVAL)

CALL HS_READ_CONTROL(CTRL_NPTS_ID, FVALPTS)

NUM_PTS = INT(FVALPTS)

DO WHILE (CVAL .LT. 0.)

IF (HS_CHECK_TRIGGER(TRIGGER_ID) .NE. 0)

& PRINT *, ' Trigger set by HistoScope'

CALL HS_UPDATE

CALL HS_READ_CONTROL(CTRL_ID, CVAL)

ENDDO

I = I + 1

END DO

C

C DATA COLLECTION IS FINISHED. SAVE ALL DATA TO A FILE FOR LATER

C REFERENCE AND PRINT SOME STATISTICS. ALLOW THE HISTO-SCOPE USER

C TO SEE ALL THE DATA HE WISHES BEFORE STOPPING THE PROGRAM.

C

ISTAT = HS_SAVE_FILE('apiExample.hs')

NUM_ITEMS = HS_LIST_ITEMS(' ','HS', ID, 20, 1)

DO J = 1, NUM_ITEMS

PRINT *

IF (HS_TYPE(ID(J)) .EQ. HS_1D_HISTOGRAM) THEN

CALL HS_1D_HIST_RANGE(ID(J), XMIN, XMAX)

PRINT *, ' ITEM UID#', HS_UID(ID(J)),

& ' IS A 1-D HISTOGRAM.'

PRINT *, ' ITS RANGE IS: ', XMIN, ', ', XMAX

PRINT *, ' ITS INTEGRAL IS: ', HS_HIST_INTEGRAL(ID(J))

CALL HS_1D_HIST_STATS(ID(J), R1, R2)

PRINT *, ' ITS MEAN IS: ', R1, 'STD DEV:', R2

ENDIF

IF (HS_TYPE(ID(J)) .EQ. HS_2D_HISTOGRAM) THEN

CALL HS_2D_HIST_OVERFLOWS(ID(J), OVERFLOWS)

PRINT *, ' ITEM UID#', HS_UID(ID(J)),

& ' IS A 2-D HISTOGRAM. '

PRINT *, ' ITS OVERFLOWS ARE: ', OVERFLOWS

CALL HS_2D_HIST_NUM_BINS(ID(J), I1, I2)

PRINT *, ' NUMBER OF BINS IN X:', I1, ', IN Y: ',

& I2

PRINT *, ' BIN VALUE AT (0., 0.) IS: ',

& HS_2D_HIST_XY_VALUE(ID(J), 0., 0.)

CALL HS_2D_HIST_MAXIMUM(ID(J), R1, R2, I, K, R3)

PRINT *, ' MAX VALUE IS AT (', R1, ', ', R2, '): ',

& R3

ENDIF

IF (HS_TYPE(ID(J)) .EQ. HS_NTUPLE) THEN

PRINT *, ' ITEM UID#', HS_UID(ID(J)),

& ' IS AN N-TUPLE WITH ',

& HS_NUM_VARIABLES(NTUPLE_ID), ' VARIABLES.'

LEN = HS_VARIABLE_NAME(ID(J), 1, NAME)

PRINT *, ' THE FIRST VARIABLE NAME IS: ', NAME(1:LEN)

PRINT *, ' THE VALUE OF ', NAME(1:LEN), '[250] IS: ',

& HS_NTUPLE_VALUE(ID(J), 250, 1)

ENDIF

IF (HS_TYPE(ID(J)) .EQ. HS_CONTROL) THEN

LEN = HS_TITLE(ID(J), NAME)

PRINT *, ' ITEM UID#', HS_UID(ID(J)),

& ' IS A CONTROL WITH TITLE: ', NAME(1:LEN)

CALL HS_READ_CONTROL(ID(J), CVAL)

PRINT *, ' ITS VALUE IS: ', CVAL

ENDIF

IF (HS_TYPE(ID(J)) .EQ. HS_INDICATOR) THEN

LEN = HS_TITLE(ID(J), NAME)

PRINT *, ' ITEM UID#', HS_UID(ID(J)),

& ' IS AN INDICATOR WITH TITLE: ', NAME(1:LEN)

ENDIF

IF (HS_TYPE(ID(J)) .EQ. HS_TRIGGER) THEN

LEN = HS_TITLE(ID(J), NAME)

PRINT *, ' ITEM UID#', HS_UID(ID(J)),

& ' IS A TRIGGER WITH TITLE: ', NAME(1:LEN)

ENDIF

END DO

PRINT *

PRINT *, ISTAT, ' ITEMS SAVED TO FILE: apiExample.hs'

CALL HS_COMPLETE_AND_WAIT

STOP

END

REAL FUNCTION RNDOM()

INTEGER A,M,Q,R,HI,LO,TEST

DATA A, M, Q, R, ISEED /16807, 2147483647, 127773, 2836, 19283755/

HI = ISEED/Q

LO = MOD(ISEED,Q)

TEST = A*LO - R*HI

IF(TEST.GT.0) THEN

ISEED = TEST

ELSE

ISEED = TEST + M

END IF

RNDOM = FLOAT(ISEED)/M

RETURN

END

C EXAMPLE PROGRAMS

I. Using Histo-Scope with HBOOK on Unix:

#include <math.h>

#include <stdio.h>

#include <stdlib.h>

#include <histoscope.h>

/*

* HbookExample.c - program to generate random Ntuple and histogram data

*

* ** Note: this program will not work on VMS, since HBOOK will **

* ** expect descriptors for all string parameters **

*/

#define TRUE 1

#define HLIM 250000

struct pawC { int h[HLIM]; } pawc_;

main()

{

int n_variables = 8;

int i, j, k, hlim = HLIM;

float values[8];

float con_1 = 1., con_0 = 0., con_3400 = 3400., con_5400 = 5400.;

int hb_1d = 6000, hb_2d = 5000, hb_nt = 900, ic_100 = 100, ic_1000 = 1000;

static char hbNames[8][8] = { "X ", "Y ", "idx ", "sqrt(X)",

"sqrt(Y)", "log(X) ", "log(Y) ", "sin(idx)" };

hs_initialize("HbookExample.c");

hs_histoscope(TRUE);

hlimit_(&hlim);

hbookn_(&hb_nt, "example_ntuple", &n_variables, " ", &ic_1000, hbNames, 14, 1, 8);

hbook2_(&hb_2d, "2d hist example", &ic_100, &con_3400, &con_5400, &ic_100, &con_3400, &con_5400, &con_0, 15);

hbook1_(&hb_1d, "example 1d hist", &ic_100, &con_3400, &con_5400, &con_0, 15);

printf(" HLDIR called:\n");

hldir_("//PAWC", "T", 6, 1);

hs_hbook_setup("//PAWC");

for (i = 1; i <= 10000; ++i) {

/* Random data computation - This could be any code you wish */

for (j = 0; j < 2; ++j) {

values[j] = 0;

for (k = 0; k < 1000; k++)

values[j] += fmod((float)random(), 10.);

}

values[2] = i;

values[3] = sqrt(values[0]);

values[4] = sqrt(values[1]);

values[5] = log(values[0]);

values[6] = log(values[1]);

values[7] = sin(values[2]);

hfill_(&hb_2d, &values[0], &values[1], &con_1);

hfill_(&hb_1d, &values[1], &con_0, &con_1);

hfn_(&hb_nt, values);

hs_update();

/* Print one period per Ntuple fill, to get */

/* visual feedback of program operation */

printf(".");

fflush(stdout);

}

hs_complete();

hrput_(&con_0, "hbookexample.hst", "TN", 16, 2);

}

II. Using Histo-Scope Routines only (no HBOOK calls)

#include <math.h>

#include <stdio.h>

#include <stdlib.h>

#include <histoscope.h>

/*

* HsExample.c - program to generate random Ntuple and histogram data

*/

#define TRUE 1

main()

{

int n_variables = 8;

float values[8];

int i, j, k, ntuple_id, hs1_id, hs2_id, indic_id;

static char *names[8] = { "X", "Y", "index", "sqrt(X)",

"sqrt(Y)", "log(X)", "log(Y)", "sin(index)" };

hs_initialize("HsExample.c");

hs_histoscope(TRUE);

ntuple_id = hs_create_ntuple(101, "Example Ntuple", "HS", n_variables, names);

hs1_id = hs_create_1d_hist(102, "Example 1d Hist", "HS", "Y", "total", 100,

3400., 5400.);

hs2_id = hs_create_2d_hist(103, "2d Hist Example", "HS","X", "Y", "total",

100, 100, 3400., 5400., 3400., 5400.);

indic_id = hs_create_indicator(104, "Example Indicator", "HS", 0., 10000.);

for (i = 1; i <= 10000; ++i) {

/* Random data computation - This could be any code you wish */

for (j = 0; j < 2; ++j) {

values[j] = 0;

for (k = 0; k < 1000; k++)

values[j] += fmod((float)random(), 10.);

}

values[2] = i;

values[3] = sqrt(values[0]);

values[4] = sqrt(values[1]);

values[5] = log(values[0]);

values[6] = log(values[1]);

values[7] = sin(values[2]);

hs_fill_ntuple(ntuple_id, values);

hs_fill_1d_hist(hs1_id, values[1], 1.);

hs_fill_2d_hist(hs2_id, values[0], values[1], 1.);

hs_set_indicator(indic_id, (float) i);

hs_update();

/* Print one period per Ntuple fill, to get */

/* visual feedback of program operation */

printf(".");

fflush(stdout);

}

hs_save_file("HsExample.hs");

hs_complete();

}