*CMZ : 4.22/07 28/06/94 12.03.34 by Rene Brun *-- Author : Fons Rademakers 22/05/92 SUBROUTINE HUWFUN(LUN, ID1, RNAME1, ITRUN, CHOPT) *.==========> *. *. Write user function to access N-tuple ID1. *. The user function will get name RNAME. *. The file will be written using unit LUN. *. All variable names will be truncated to ITRUN *. characters (ITRUN=0 is no truncation). CHOPT can be 'B' *. to make a file for Batch usage (i.e. with HBNAME calls). *. Or 'P' to make a PAW selection function. Option 'B' is *. the default. *. If option 'I' generates only INCLUDE file *. *..=========> ( A.A.Rademakers ) * **+SEQ,HCNTPAR *+KEEP,HCNTPAR. *CMZ : 4.20/00 21/06/93 12.39.17 by Fons Rademakers *-- Author : INTEGER ZBITS, ZNDIM, ZNOENT, ZNPRIM, ZNRZB, ZIFCON, + ZIFNAM, ZIFCHA, ZIFINT, ZIFREA, ZNWTIT, ZITIT1, + ZNCHRZ, ZDESC, ZLNAME, ZNAME, ZARIND, ZRANGE, ZNADDR, + ZIBLOK, ZNBLOK, ZLCONT, ZIFBIT, ZIBANK, ZIFTMP, ZITMP, + ZID, ZNTMP, ZNTMP1, ZLINK PARAMETER(ZBITS=1, ZNDIM=2, ZNOENT=3, ZNPRIM=4, ZLCONT=6, + ZNRZB=5, ZIFCON=7, ZIFNAM=4, ZIFCHA=5, ZIFINT=6, + ZIFREA=7, ZNWTIT=8, ZITIT1=9, ZNCHRZ=13, ZIFBIT=8, + ZDESC=1, ZLNAME=2, ZNAME=3, ZRANGE=4, ZNADDR=12, + ZARIND=11, ZIBLOK=8, ZNBLOK=10, ZIBANK=9, ZIFTMP=11, + ZID=12, ZITMP=10, ZNTMP=6, ZNTMP1=3, ZLINK=6) * **+SEQ,HCFLAG *+KEEP,HCFLAG *CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun *-- Author : INTEGER ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, + NCHAR ,NRHIST,IERR ,NV COMMON/HCFLAG/ID ,IDBADD,LID ,IDLAST,IDHOLD,NBIT ,NBITCH, + NCHAR ,NRHIST,IERR ,NV * **+SEQ,HCBOOK **+KEEP,HCBOOK. *CMZ : 4.19/01 30/04/93 17.22.15 by Rene Brun *-- Author : 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,LHPLIP,LHDUM, +LHFIT,LFUNC,LHFCO,LHFNA,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,LHPLIP,LHDUM(9), +LHFIT,LFUNC,LHFCO,LHFNA,LCIDN * **+KEEP,HCK *CMZ : 4.19/00 26/04/93 12.34.29 by Rene Brun *-- Author : INTEGER KNCX ,KXMIN ,KXMAX ,KMIN1 ,KMAX1 ,KNORM , KTIT1, + KNCY ,KYMIN ,KYMAX ,KMIN2 ,KMAX2 ,KSCAL2 , KTIT2, + KNBIT ,KNOENT ,KSTAT1 ,KNSDIR ,KNRH , + KCON1 ,KCON2 ,KBITS ,KNTOT PARAMETER(KNCX=3,KXMIN=4,KXMAX=5,KMIN1=7,KMAX1=8,KNORM=9,KTIT1=10, + KNCY=7,KYMIN=8,KYMAX=9,KMIN2=6,KMAX2=10,KSCAL2=11, + KTIT2=12,KNBIT=1,KNOENT=2,KSTAT1=3,KNSDIR=5,KNRH=6, + KCON1=9,KCON2=3,KBITS=1,KNTOT=2) * *+SEQ,HCBITS *+KEEP,HCBITS *CMZ : 4.19/00 13/04/93 16.36.40 by Rene Brun *-- Author : INTEGER I1, I2, I3, I4, I5, I6, I7, I8, + I9, I10, I11, I12, I13, I14, I15, I16, +I17, I18, I19, I20, I21, I22, I23, I24, I25, I26, I27, +I28, I29, I30, I31, I32, I33, I34, I35, I123, I230 COMMON / HCBITS / I1, I2, I3, I4, I5, I6, I7, I8, + I9, I10, I11, I12, I13, I14, I15, I16, +I17, I18, I19, I20, I21, I22, I23, I24, I25, I26, I27, +I28, I29, I30, I31, I32, I33, I34, I35, I123, I230 * * CHARACTER*(*) RNAME1, CHOPT CHARACTER*80 TITLE, RNAME CHARACTER*8 DATE, HOUR CHARACTER*5 SID INTEGER IDATE(2), IHOUR(2) LOGICAL BATCH * ID = ID1 IDPOS = LOCATI(IQ(LTAB+1),IQ(LCDIR+KNRH),ID) IF (IDPOS .LE. 0) THEN CALL HBUG('Unknown N-tuple','HUWFUN',ID1) RETURN ENDIF LCID = LQ(LTAB-IDPOS) I4 = JBIT(IQ(LCID+KBITS),4) IF (I4 .EQ. 0) RETURN IF (IQ(LCID-2) .NE. ZLINK) THEN CALL HBUG('This routine does not work for old N-tuples', + 'HUWFUN',ID) RETURN ENDIF * ITRUNC = ITRUN IF (ITRUNC .LE. 0) ITRUNC = 9999 RNAME = RNAME1(1:MIN(LENOCC(RNAME1),ITRUNC)) * BATCH = .TRUE. IF (CHOPT(1:1) .EQ. 'B') BATCH = .TRUE. IF (CHOPT(1:1) .EQ. 'P') BATCH = .FALSE. IOPTI=INDEX(CHOPT,'I') * TITLE = ' ' * LBLOK = LQ(LCID-1) LCHAR = LQ(LCID-2) LINT = LQ(LCID-3) LREAL = LQ(LCID-4) * ITIT1 = IQ(LCID+ZITIT1) NWTIT = IQ(LCID+ZNWTIT) * *-- write routine header * CALL HITOC(ID1, SID, LL, IERR) CALL UHTOC(IQ(LCID+ITIT1), 4, TITLE, NWTIT*4) CALL DATIMH(IDATE, IHOUR) CALL UHTOC(IDATE, 4, DATE, 8) CALL UHTOC(IHOUR, 4, HOUR, 8) IF (BATCH) THEN WRITE(LUN,1001) SID, TITLE(1:LENOCC(TITLE)), + DATE, HOUR ELSE WRITE(LUN,1501) SID, TITLE(1:LENOCC(TITLE)), + DATE, HOUR WRITE(LUN,1600) ENDIF * *-- write declaration and common blocks * IF (BATCH) THEN CALL HWDECL(LUN,ITRUNC) ELSE CALL HWPDCL(LUN,ITRUNC) ENDIF * *-- write HBNAME definitions * IF (BATCH) THEN WRITE(LUN,2000) '*' CALL HWBNAM(LUN,ITRUNC) ENDIF * *-- formats * 1001 FORMAT( + '*********************************************************',/, + '* *',/, + '* This file was generated by HUWFUN. *',/, + '* *',/, + '*********************************************************',/, + '*',/, + '* Ntuple Id: ',A,/, + '* Ntuple Title: ',A,/, + '* Creation: ',A,' ',A,/, + '*',/, + '*********************************************************',/, + '*') 1501 FORMAT( + '*********************************************************',/, + '* *',/, + '* This file was generated by HUWFUN. *',/, + '* *',/, + '*********************************************************',/, + '*',/, + '* Ntuple Id: ',A,/, + '* Ntuple Title: ',A,/, + '* Creation: ',A,' ',A,/, + '*',/, + '*********************************************************',/, + '*') 1600 FORMAT( + ' LOGICAL CHAIN',/, + ' CHARACTER*128 CFILE',/, + ' INTEGER IDNEVT,NCHEVT,ICHEVT',/, + ' REAL VIDN1,VIDN2,VIDN3,VIDN(10)',/, + '*',/, + ' COMMON /PAWIDN/ IDNEVT,VIDN1,VIDN2,VIDN3,VIDN',/, + ' COMMON /PAWCHN/ CHAIN, NCHEVT, ICHEVT',/, + ' COMMON /PAWCHC/ CFILE',/, + '*',/, + '*-- Ntuple Variable Declarations',/, + '*') 2000 FORMAT(A) * RETURN END