Re: ROOT files from FORTRAN

Valery Fine (fine@mail.cern.ch)
Mon, 29 Sep 1997 17:34:15 +0100


#include "cfortran.h"
#include <TROOT.h>
#include <TOrdCollection.h>
#include <TH1.h>
#include <TH2.h>

enum EBookType {kHbook1=1, kHbook2, kHtable, kNtuple, kHbookN } ;

//____________________________________________________________________
class THBookObject : public TObject {
private:
Int_t fId; // index of the "native" HBOOK object
TObject *fHbookObject; // ROOT representation of the HBOOK object
EBookType fBookTypes; // Type of Hbook object created;

public:
THBookObject(Int_t index, TObject *obj,EBookType type=kHbook1)
{
fId = index;fHbookObject=obj; fBookTypes = type;
}
~THBookObject(){ if (fHbookObject) delete fHbookObject;}

Int_t Compare(TObject *obj){if (obj) return ((THBookObject*)obj)->GetHBOOKIndex()-fId; return 0;}
TObject *GetHBOOKObject(){ return fHbookObject;}
Int_t GetHBOOKIndex(){ return fId;}
EBookType GetHBOOKType(){ return fBookTypes;}
};

//____________________________________________________________________

class THBook {
private:
static TOrdCollection *fMapOfHbookObject;
static THBookObject *GetHbookObject(Int_t idx)
{
THBookObject *obj=0;
TIter next(fMapOfHbookObject);
while (obj=(THBookObject *)next())
if ( obj->GetHBOOKIndex() == idx)
return obj;
return 0;
}

public:
/* _________________________________________________ */
// THBook(){fMapOfHbookObject = new TOrdCollection ;}
/* _________________________________________________ */
// ~THBook(){ delete fMapOfHbookObject;}
/* _________________________________________________ */
static void Add(int id, TObject * hbook, EBookType type=kHbook1)
{
if (hbook) {
THBookObject *newhb = new THBookObject(id,hbook,type);
fMapOfHbookObject->Add(newhb);
}
}
/* _________________________________________________ */
static void Delete(int id)
{
if (id) {
TObject *obj=GetHbookObject(id);
if (obj) {
fMapOfHbookObject->Remove(obj);
delete obj;
}
}
else {
TIter next(fMapOfHbookObject);
TObject *obj = 0;
while (obj = (TObject *)next())
{
fMapOfHbookObject->Remove(obj);
delete obj;
}
}
}
// _____________________________________________________________________
static void Hbook1(int id, char *title, int nx, float xmin, float xmax, float value)
{
char idbuf[10]="h";
itoa(id,&idbuf[1],10);
if (idbuf[1]=='-') idbuf[1]='m';
Add(id,new TH1F(idbuf,title,nx,xmin,xmax));
}
/* _________________________________________________ */
static void Hbook2(int id, char *title, int nx, float xmin, float xmax,
int ny, float ymin, float ymax,
float value)
{
char idbuf[10]="h";
itoa(id,&idbuf[1],10);
if (idbuf[1]=='-') idbuf[1]='m';
Add(id,new TH2F(idbuf,title,nx,xmin,xmax,ny,ymin,ymax),kHbook2);
}
/* _________________________________________________ */
static void Hdelet(int id)
{
Delete(id);
printf(" Hdelet %d \n",id);
}
/* _________________________________________________ */
static void Hfill(int id, float x, float y, float w)
{
THBookObject *obj = GetHbookObject(id);
if (!obj) return;
EBookType type=obj->GetHBOOKType();

// printf(" hfill id=%d, x=%f, y=%f, w=%f %d \n",id,x,y,w,type);
switch (type){
case kHbook1:
if (TMath::Abs(w) > 0)
((TH1F *)(obj->GetHBOOKObject()))->Fill(x,(Stat_t)w);
else
((TH1F *)(obj->GetHBOOKObject()))->Fill(x);
break;
case kHbook2:
if (TMath::Abs(w) > 0)
((TH2F *)(obj->GetHBOOKObject()))->Fill(x,y,(Stat_t)w);
else
((TH2F *)(obj->GetHBOOKObject()))->Fill(x,y);
break;
case kHtable:
break;
case kNtuple:
break;
case kHbookN:
break;
default:
break;
};
}
/* _________________________________________________ */
static void Hlimit(int limit)
{
printf (" Hlimit %d \n", limit);
}
/* _________________________________________________ */
static void Houtpu(int lun)
{
printf(" houtpu lun=%d \n",lun);
}
/* _________________________________________________ */
static void Hpagsz(int isize)
{
printf(" hpagsz = %d\n",isize);
}
/* _________________________________________________ */
static void Hprint(int id=0)
{
if (id) {
THBookObject *obj=GetHbookObject(id);
if (obj)
obj->GetHBOOKObject()->Print();
}
else {
TIter next(fMapOfHbookObject);
THBookObject *obj = 0;
while (obj = (THBookObject *)next())
{
printf(" ID= %d \n",(obj->GetHBOOKIndex()));
(obj->GetHBOOKObject())->Print();
}
}
}
/* _________________________________________________ */
static void Histdo()
{
Hprint();
}
/* _________________________________________________ */
static void Htable(int id, char *title, int nx, float xmin, float xmax,
int ny, float ymin, float ymax,
float value)
{
printf(" HTABLE 2 %d %s \n",id,title);
}
/* _________________________________________________ */
static void Htitle(char *title)
{
printf(" htitle %s \n", title);
}
/* _________________________________________________ */
};

TOrdCollection *THBook::fMapOfHbookObject = new TOrdCollection;
TROOT HbookInterface("Hbook", "Fortran/Root interface");

// THBook *gHBook = new THBook;

//__________________________________________________

///////////////////////////////////////////////////////////////
// //
// HBOOK FORTRAN callable interface to THBOOK global object //
// //
///////////////////////////////////////////////////////////////

#ifdef NONIMPLEMENTED
FCALLSCSUB3(THBook::Harray,HARRAY,harray,INT,INT,PINT)
FCALLSCSUB4(THBook::Hbandx,HBANDX,hbandx,INT,FLOAT,FLOAT,FLOAT)
FCALLSCSUB4(THBook::Hbandy,HBANDY,hbandy,INT,FLOAT,FLOAT,FLOAT)
FCALLSFSUB1(THBook::Hbarx,HBARX,hbarx,INT)
FCALLSCSUB1(THBook::Hbary,HBARY,hbary,INT)
FCALLSCSUB6(THBook::Hbfun1,HBFUN1,hbfun1,INT,STRING,INT,FLOAT,FLOAT,ROUTINE)
FCALLSCSUB9(THBook::Hbfun2,HBFUN2,hbfun2,INT,STRING,INT,FLOAT,FLOAT,INT,FLOAT,FLOAT,ROUTINE)
FCALLSCSUB2(THBook::Hbigbi,HBIGBI,hbigbi,INT,INT)
FCALLSCSUB1(THBook::Hbinsz,HBINSZ,hbinsz,STRING)
FCALLSCSUB4(THBook::Hbnamc,HBNAMC,hbnamc,INT,STRING,STRINGV,STRING)
FCALLSCSUB4(THBook::Hbname,HBNAME,hbname,INT,STRING,INTV,STRING)
FCALLSCSUB3(THBook::Hbnt,HBNT,hbnt,INT,STRING,STRING)
FCALLSCSUB5(THBook::HBOOKB,hbookb,INT,STRING,INT,FLOATV,FLOAT)
FCALLSCSUB6(THBook::Hbookb,HBOOKN,hbookn,INT,STRING,INT,STRING,INT,STRINGV)
#endif

FCALLSCSUB6(THBook::Hbook1,HBOOK1,hbook1,INT,STRING,INT,FLOAT,FLOAT,FLOAT)
FCALLSCSUB9(THBook::Hbook2,HBOOK2,hbook2,INT,STRING,INT,FLOAT,FLOAT,INT,FLOAT,FLOAT,FLOAT)

#if 0
FCALLSCSUB2(THBook::Hbpro,HBPRO,hbpro,INT,FLOAT)
FCALLSCSUB8(THBook::Hbprof,HBPROF,hbprof,INT,STRING,INT,FLOAT,FLOAT,FLOAT,FLOAT,STRING)
FCALLSCSUB2(THBook::Hbprox,HBPROX,hbprox,INT,FLOAT)
FCALLSCSUB2(THBook::Hbproy,HBPROY,hbproy,INT,FLOAT)
FCALLSCSUB3(THBook::Hbset,HBSET,hbset,STRING,INT,PINT)
FCALLSCSUB3(THBook::Hbslix,HBSLIX,hbslix,INT,INT,FLOAT)
FCALLSCSUB3(THBook::Hbsliy,HBSLIY,hbsliy,INT,INT,FLOAT)
FCALLSCSUB2(THBook::Hcdir,HCDIR,hcdir,PSTRING,STRING)
FCALLSCSUB2(THBook::Hcompa,HCOMPA,hcompa,INTV,INT)
FCALLSCSUB3(THBook::Hcopy,HCOPY,hcopy,INT,INT,STRING)
FCALLSCSUB3(THBook::Hcopym,HCOPYM,hcopym,INT,INTV,INT)
#endif

FCALLSCSUB1(THBook::Hdelet,HDELET,hdelet,INT)

#if 0
FCALLSCSUB1(THBook::Hderiv,HDERIV,hderiv,FLOATV)
FCALLSCSUB4(THBook::Hdiff,HDIFF,hdiff,INT,INT,PFLOAT,STRING)
FCALLSCSUB7(THBook::Hdiffb,HDIFFB,hdiffb,INT,INT,FLOAT,INT,STRING,INT,FLOATV)
FCALLSCSUB1(THBook::Hdump,HDUMP,hdump,INT)
FCALLSCSUB1(THBook::Hermes,HERMES,hermes,INT)
FCALLSCSUB7(THBook::Hfc2,HFC2,hfc2,INT,INT,STRING,INT,STRING,FLOAT,STRING)
FCALLSCSUB4(THBook::Hff1,HFF1,hff1,INT,PINT,FLOAT,FLOAT)
FCALLSCSUB5(THBook::Hff2,HFF2,hff2,INT,PINT,FLOAT,FLOAT,FLOAT)
#endif

FCALLSCSUB4(THBook::Hfill,HFILL,hfill,INT,FLOAT,FLOAT,FLOAT)

#if 0
FCALLSCSUB3(THBook::Hfinam,HFINAM,hfinam,INT,STRINGV,INT)
FCALLSCSUB6(THBook::Hfitex,HFITEX,hfitex,INT,PFLOAT,PFLOAT,FLOAT,INT,FLOATV)
FCALLSCSUB7(THBook::Hfitga,HFITGA,hfitga,INT,PFLOAT,PFLOAT,PFLOAT,FLOAT,INT,FLOATV)
FCALLSCSUB10(THBook::Hfith,HFITH,hfith,INT,ROUTINE,STRING,INT,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,PFLOAT)
FCALLSCSUB10(THBook::Hfithn,HFITHN,hfithn,INT,STRING,STRING,INT,FLOATV,FLOATV,FLOATV,FLOATV,FLOATV,FLOAT)

/* cannot handle more than 10 parameters
FCALLSCSUB11(THBook::Hfitl,HFITL,hfitl,INT,ROUTINE,INT,DOUBLEV,PFLOAT,INT,PFLOAT,PFLOAT,FLOATV,FLOATV,FLOATV)
FCALLSCSUB16(THBook::Hfitn,HFITN,hfitn,PFLOAT,FLOATV,FLOATV,INT,INT,INT,ROUTINE,INT,DOUBLEV,PFLOAT,INT,PFLOAT,PFLOAT,FLOATV,FLOATV,FLOATV)
*/

FCALLSCSUB6(THBook::Hfitpo,HFITPO,hfitpo,INT,INT,PFLOAT,FLOAT,INT,FLOATV)
FCALLSCSUB7(THBook::Hfits,HFITS,hfits,INT,ROUTINE,INT,DOUBLEV,PFLOAT,INT,PFLOAT)

/* cannot handle more than 10 parameters
FCALLSCSUB15(THBook::Hfitv,HFITV,hfitv,INT,INT,INT,PFLOAT,FLOATV,FLOATV,ROUTINE,STRING,INT,FLOATV,FLOATV,FLOATV,FLOATV,PFLOAT,PFLOAT)
*/

FCALLSCSUB10(THBook::Hfit1,HFIT1,hfit1,FLOATV,FLOATV,FLOATV,INT,ROUTINE,INT,DOUBLEV,PFLOAT,INT,PFLOAT)
FCALLSCSUB2(THBook::Hfn,HFN,hfn,INT,FLOATV)
FCALLSCSUB1(THBook::Hfnt,HFNT,hfnt,INT)
FCALLSCSUB2(THBook::Hfntb,HFNTB,hfntb,INT,STRING)
FCALLSCSUB4(THBook::Hfpak1,HFPAK1,hfpak1,INT,PINT,FLOATV,INT)
FCALLSCSUB2(THBook::Hfunc,HFUNC,hfunc,INT,ROUTINE)
FCALLSCSUB3(THBook::Hf1,HF1,hf1,INT,FLOAT,FLOAT)
FCALLSCSUB4(THBook::Hf2,HF2,hf2,INT,FLOAT,FLOAT,FLOAT)
FCALLSCSUB7(THBook::Hgfit,HGFIT,hgfit,INT,PINT,PINT,PFLOAT,PFLOAT,PFLOAT,PSTRINGV)
FCALLSCSUB10(THBook::Hgive,HGIVE,hgive,INT,STRING,PINT,PFLOAT,PFLOAT,PINT,PFLOAT,PFLOAT,PINT,PINT)
FCALLSCSUB6(THBook::Hgiven,HGIVEN,hgiven,INT,PSTRING,PINT,PSTRINGV,PFLOAT,PFLOAT)
FCALLSCSUB5(THBook::Hgn,HGN,hgn,INT,PINT,INT,PFLOAT,PINT)
FCALLSCSUB4(THBook::Hgnf,HGNF,hgnf,INT,INT,PFLOAT,PINT)
FCALLSCSUB2(THBook::Hgnpar,HGNPAR,hgnpar,INT,STRING)
FCALLSCSUB3(THBook::Hgnt,HGNT,hgnt,INT,INT,INT)
FCALLSCSUB4(THBook::Hgntb,HGNTB,hgntb,INT,STRING,INT,INT)
FCALLSCSUB3(THBook::Hgntf,HGNTF,hgntf,INT,INT,PINT)
FCALLSCSUB5(THBook::Hgntv,HGNTV,hgntv,INT,STRINGV,INT,INT,INT)
FCALLSCSUB2(THBook::Hidall,HIDALL,hidall,INTV,PINT)
FCALLSCSUB2(THBook::Hidopt,HIDOPT,hidopt,INT,STRING)
FCALLSCSUB2(THBook::Hid1,HID1,hid1,PINT,PINT)
FCALLSCSUB2(THBook::Hid2,HID2,hid2,PINT,PINT)
FCALLSCSUB5(THBook::Hijxy,HIJXY,hijxy,INT,INT,INT,PFLOAT,PFLOAT)
FCALLSCSUB0(THBook::Hindex,HINDEX,hindex)
FCALLSCSUB4(THBook::Hipak1,HIPAK1,hipak1,INT,PINT,INTV,INT)
#endif

FCALLSCSUB0(THBook::Histdo,HISTDO,histdo)

#if 0
FCALLSCSUB3(THBook::Hix,HIX,hix,INT,INT,PFLOAT)
FCALLSCSUB4(THBook::Hlabel,HLABEL,hlabel,INT,INT,STRINGV,STRING)
FCALLSCSUB2(THBook::Hldir,HLDIR,hldir,STRING,STRING)
FCALLSCSUB2(THBook::Hlimap,HLIMAP,hlimap,INT,STRING)
#endif

FCALLSCSUB1(THBook::Hlimit,HLIMIT,hlimit,INT)

#if 0
FCALLSCSUB2(THBook::Hlocat,HLOCAT,hlocat,INT,PINT)
FCALLSCSUB2(THBook::Hmaxim,HMAXIM,hmaxim,INT,FLOAT)
FCALLSCSUB2(THBook::Hmdir,HMDIR,hmdir,STRING,STRING)
FCALLSCSUB2(THBook::Hminim,HMINIM,hminim,INT,FLOAT)
FCALLSCSUB2(THBook::Hnoent,HNOENT,hnoent,INT,PINT)
FCALLSCSUB2(THBook::Hnorma,HNORMA,hnorma,INT,FLOAT)
FCALLSCSUB6(THBook::Hopera,HOPERA,hopera,INT,STRING,INT,INT,FLOAT,FLOAT)
#endif

FCALLSCSUB1(THBook::Houtpu,HOUTPU,houtpu,INT)
FCALLSCSUB1(THBook::Hpagsz,HPAGSZ,hpagsz,INT)

#if 0
FCALLSCSUB2(THBook::Hpak,HPAK,hpak,INT,FLOATV)
FCALLSCSUB2(THBook::Hpakad,HPAKAD,hpakad,INT,FLOATV)
FCALLSCSUB2(THBook::Hpake,HPAKE,hpake,INT,FLOATV)
FCALLSCSUB7(THBook::Hparam,HPARAM,hparam,INT,INT,FLOAT,INTV,PDOUBLE,PINT,PINT)

/* cannot handle more than 10 parameters
FCALLSCSUB11(THBook::Hparmn,HPARMN,hparmn,PFLOAT,FLOATV,FLOATV,INT,INT,INT,FLOAT,INTV,PDOUBLE,PINT,PINT)
*/

FCALLSCSUB2(THBook::Hpchar,HPCHAR,hpchar,INTV,INTV)
FCALLSCSUB2(THBook::Hpdir,HPDIR,hpdir,STRING,STRING)
FCALLSCSUB3(THBook::Hphist,HPHIST,hphist,INT,STRING,INT)
FCALLSCSUB1(THBook::Hphs,HPHS,hphs,INT)
FCALLSCSUB1(THBook::Hphst,HPHST,hphst,INT)
FCALLSCSUB0(THBook::Hponce,HPONCE,hponce)
#endif

FCALLSCSUB1(THBook::Hprint,HPRINT,hprint,INT)

#if 0
FCALLSCSUB1(THBook::Hprnt,HPRNT,hprnt,INT)
FCALLSCSUB7(THBook::Hproj1,HPROJ1,hproj1,INT,INT,INT,ROUTINE,INT,INT,INT)
FCALLSCSUB8(THBook::Hproj2,HPROJ2,hproj2,INT,INT,INT,ROUTINE,INT,INT,INT,INT)
FCALLSCSUB3(THBook::Hprot,HPROT,hprot,INT,STRING,INT)
FCALLSCSUB1(THBook::Hpscat,HPSCAT,hpscat,INT)
FCALLSCSUB1(THBook::Hptab,HPTAB,hptab,INT)

/* cannot handle more than 10 parameters
FCALLSCSUB11(THBook::Hquad,HQUAD,hquad,INT,STRING,INT,FLOAT,FLOAT,PINT,PFLOAT,PINT,PFLOAT,PFLOAT,PINT)
*/

FCALLSCSUB3(THBook::Hrdir,HRDIR,hrdir,INT,PSTRINGV,PINT,A1,A2,A3)
FCALLSCSUB8(THBook::Hrebin,HREBIN,hrebin,INT,PFLOAT,PFLOAT,PFLOAT,PFLOAT,INT,INT,INT)
FCALLSCSUB2(THBook::Hrecov,HRECOV,hrecov,INT,STRING)
FCALLSCSUB1(THBook::Hrend,HREND,hrend,STRING)
FCALLSCSUB2(THBook::Hreset,HRESET,hreset,INT,STRING)
FCALLSCSUB3(THBook::Hrfile,HRFILE,hrfile,INT,STRING,STRING)
FCALLSCSUB3(THBook::Hrget,HRGET,hrget,INT,STRING,STRING)
FCALLSCSUB3(THBook::Hrin,HRIN,hrin,INT,INT,INT)
FCALLSCSUB3(THBook::Hrndm2,HRNDM2,hrndm2,INT,PFLOAT,PFLOAT)
FCALLSCSUB6(THBook::Hropen,HROPEN,hropen,INT,STRING,STRING,STRING,PINT,PINT)
FCALLSCSUB3(THBook::Hrout,HROUT,hrout,INT,PINT,STRING)
FCALLSCSUB3(THBook::Hrput,HRPUT,hrput,INT,STRING,STRING)
FCALLSCSUB2(THBook::Hscale,HSCALE,hscale,INT,FLOAT)
FCALLSCSUB3(THBook::Hscr,HSCR,hscr,INT,INT,STRING)
FCALLSCSUB2(THBook::Hsetpr,HSETPR,hsetpr,STRING,FLOAT)
FCALLSCSUB3(THBook::Hsmoof,HSMOOF,hsmoof,INT,INT,FLOAT)
FCALLSCSUB5(THBook::Hspli1,HSPLI1,hspli1,INT,INT,INT,INT,PFLOAT)
FCALLSCSUB5(THBook::Hspli2,HSPLI2,hspli2,INT,INT,INT,INT,INT)
FCALLSCSUB1(THBook::Hsquez,HSQUEZ,hsquez,STRING)
#endif

FCALLSCSUB9(THBook::Htable,HTABLE,htable,INT,STRING,INT,FLOAT,FLOAT,INT,FLOAT,FLOAT,FLOAT)
FCALLSCSUB1(THBook::Htitle,HTITLE,htitle,STRING)

#ifdef NONIMPLEMENTED
FCALLSCSUB4(THBook::Hunpak,HUNPAK,hunpak,INT,PFLOAT,STRING,INT)
FCALLSCSUB4(THBook::Hunpke,HUNPKE,hunpke,INT,PFLOAT,STRING,INT)
FCALLSCSUB5(THBook::Huwfun,HUWFUN,huwfun,INT,INT,STRING,INT,STRING)
FCALLSCSUB3(THBook::Hxi,HXI,hxi,INT,FLOAT,PINT)
FCALLSCSUB5(THBook::Hxyij,HXYIJ,hxyij,INT,FLOAT,FLOAT,PINT,PINT)
FCALLSCFUN1(THBook::Hexist,HEXIST,hexist,INT)
FCALLSCFUN2(THBook::Hi,HI,hi,INT,INT)
FCALLSCFUN2(THBook::Hie,HIE,hie,INT,INT)
FCALLSCFUN2(THBook::Hif,HIF,hif,INT,INT)
FCALLSCFUN3(THBook::Hij,HIJ,hij,INT,INT,INT)
FCALLSCFUN1(THBook::Hmax,HMAX,hmax,INT)
FCALLSCFUN1(THBook::Hmin,HMIN,hmin,INT)
FCALLSCFUN1(THBook::Hrndm1,HRNDM1,hrndm1,INT)
FCALLSCFUN4(THBook::Hspfun,HSPFUN,hspfun,INT,FLOAT,INT,INT)
FCALLSCFUN4(THBook::Hstati,HSTATI,hstati,INT,INT,STRING,INT)
FCALLSCFUN1(THBook::Hsum,HSUM,hsum,INT)
FCALLSCFUN2(THBook::Hx,HX,hx,INT,FLOAT)
FCALLSCFUN2(THBook::Hxe,HXE,hxe,INT,FLOAT)
FCALLSCFUN3(THBook::Hxy,HXY,hxy,INT,FLOAT,FLOAT)

#if defined(vms) || defined(__vms)

FCALLSCFUN3(THBook::Hcreateg,HCREATEG,hcreateg,STRING,INT,FLOATV)
FCALLSCFUN3(THBook::Hmapg,HMAPG,hmapg,STRING,INT,PINT)

#else

FCALLSCSUB2(THBook::Hlimap,HLIMAP,hlimap,INT,STRING)

#endif
#endif /* NONIMPLEMENTED */