+PATCH,$CORR. +DECK,CORR1. Updates version: 1.30/00 to 1.30/14 +REP,*TITLE*,TITLE,1. CBOFF 1.30/14 25/06/98 21.19.14 SE +REP,$VERSION,V1_30,1-2. *CMZU: 1.30/13 06/08/97 23.39.23 by Rafik Ouared *CMZU: 1.30/12 29/03/97 22.34.30 by Rafik Ouared *CMZU: 1.30/11 03/03/97 16.32.10 by Rafik Ouared *CMZU: 1.30/10 14/02/97 09.46.18 by Rafik Ouared *CMZU: 1.30/09 26/01/97 14.57.28 by Rafik Ouared *CMZU: 1.30/08 27/11/96 10.09.34 by Rafik Ouared *CMZ : 1.30/07 01/08/96 17.11.03 by Kaemmle *CMZ : 1.30/06 22/07/96 10.51.36 by Kaemmle *CMZ : 1.30/05 03/06/96 10.51.38 by Unknown *CMZ : 1.30/04 15/04/96 15.02.10 by Unknown *CMZ : 1.30/03 03/04/96 19.32.47 by Unknown *CMZ : 1.30/02 15/02/96 15.26.55 by Unknown *CMZ : 1.30/01 14/02/96 17.43.40 by Unknown *CMZU: 1.30/00 21/12/95 18.46.45 by Christian Voelcker *-- Author : Christian Voelcker 21/12/95 *________________________________________________________________________ * *::> VERSION 1.30/13 06/08/97 23.39.23 * * CBSRUN modified to access JU every run and to use for the * MC events the same calibration files as for real data. * CFCOMMON modified to fit with CBKFIT version 3.11/00. *________________________________________________________________________ * *::> VERSION 1.30/12 29/03/97 22.34.30 * modify common TCV3CM and fix label printout CBRLBL (M.Lakata) *________________________________________________________________________ * *::> VERSION 1.30/11 03/03/97 16.32.09 * * CBSRUN: warn user that SV calibration is read from database. * *________________________________________________________________________ * *::> VERSION 1.30/10 14/02/97 09.46.18 * * CBDONE updated for relevant printout (M.Lakata) *________________________________________________________________________ * *::> VERSION 1.30/09 26/01/97 14.57.28 * modified by M.Lakata: * INSTALL * CBRLBL: to get some more labelled information. * CBCOMMON: add new common block CBLAB2 to be used in CBRLBL *________________________________________________________________________ * *::> VERSION 1.30/08 27/11/96 10.09.33 * add in the SVX calibration const. commons SVGCAL and SVECAL in seq SVCALI * CBINIT: turn on the SVX calibration (GTVTCC) * (was set to FALSE in previous version,is now set to TRUE) * CBSRUN: add in the code to pick up the calibration for the SVX * (look under GTVTCC and SVCALI) * CBSRIO: Add calib bank for SVX: KSV * * *::> VERSION 1.30/07 01/08/96 17.11.03 * new parameter for card BANK added DSTF * is the same as DSTN, but keeps the TCHT bank * *::> VERSION 1.30/06 22/07/96 10.51.36 * bug in use of CK- in datacard fixed * CK- now sets all fudge factors to 1.0 for each run * *::> VERSION 1.30/05 03/06/96 10.51.38 * update of installation script for solaris * *::> VERSION 1.30/04 15/04/96 15.02.10 * correction of common blocks which were only in local cmzfile * *::> VERSION 1.30/03 03/04/96 19.32.47 * TCLIFT modified to include to arrays: MTSV1,MTSV2 * as proposed by Rafik Ouared * *::> VERSION 1.30/02 15/02/96 15.26.54 * change of JDC TYPE from NEW to OLD disabled for runs > 21000 * *::> VERSION 1.30/01 14/02/96 17.43.40 * installed BK. * update of tapehandling for sun: * F.-H.Heinsius * routine CBTBOF changed +ADD,$KUMACS,INSTALL,0. *CMZU: 1.30/09 22/01/97 16.18.48 by M.T. Lakata *CMZU: 1.30/05 29/05/96 18.48.10 by F.-H.Heinsius +REP,$KUMACS,INSTALL,34. * SRC Source code directory +DEL,$KUMACS,INSTALL,41. +ADD,$KUMACS,INSTALL,50. version = '' +ADD,$KUMACS,INSTALL,74. (VERSION:*) version = $SUBSTRING([%I],9,100) message '* Extracting version '//[version] +REP,$KUMACS,INSTALL,82-83. Message * Build Level = [BUILDLEVEL] +ADD,$KUMACS,INSTALL,96. (SOLARIS) Select SUN +REP,$KUMACS,INSTALL,122-124. XACL = -XACLP else XACL = -XADCLP +REP,$KUMACS,INSTALL,157-165. DEBUGCCC=' -dba' (HPUX,SGI,SUN,DECS,IBMRT,SOLARIS) DEBUGOPT=' -g -C' DEBUGCCC=' -g' (VAX) DEBUGOPT='/NOOP/DEB' DEBUGCCC='/NOOP/DEB' (ALPHA) Case $OS In (VMS) DEBUGOPT='/NOOP/DEB' DEBUGCCC='/NOOP/DEB' (UNIX) DEBUGOPT=' -g' DEBUGCCC=' -g' Endcase Endcase Else Case $OS In (VMS) DEBUGOPT=' ' DEBUGCCC=' ' (UNIX) DEBUGOPT=' -O ' DEBUGCCC=' -O ' Endcase +REP,$KUMACS,INSTALL,171. if [version] = '' then Sequence //cboff/commcb else Sequence -V [version] //cboff/commcb endif +REP,$KUMACS,INSTALL,190-213. Set '`which g77` -c'//[DEBUGOPT]//' -w $compfile' -C f77 Set '`which gcc` -c'//[DEBUGCCC]//' -w $compfile' -C C else Case $MACHINE In (HPUX) Set 'f77 -c'//[DEBUGOPT]//' +ppu $compfile' -C f77 Set 'cc -c -O -w '//[DEBUGCCC]//' $compfile' -C C (SUN) Set 'f77 -c'//[DEBUGOPT]//' -fnonstd -Nl100 -w $compfile' -C f77 Set 'gcc -c'//[DEBUGCCC]//' -w $compfile' -C C (SOLARIS) Set 'f77 -c'//[DEBUGOPT]//' -w $compfile' -C f77 Set 'gcc -c'//[DEBUGCCC]//' -w $compfile' -C C (LINUX) Set 'g77 -c'//[DEBUGOPT]//' -O -w $compfile' -C f77 (IBMRT) Set 'xlf -c'//[DEBUGOPT]//' -qextname $compfile' -C f77 Set 'cc -c -w '//[DEBUGCCC]//' $compfile' -C C (SGI) Set 'f77 -c'//[DEBUGOPT]//' $compfile G 3' -C f77 Set 'cc -c -w '//[DEBUGCCC]//' $compfile' -C C (DECS) Set 'f77 -c -w -Nl99 '//[DEBUGOPT]//' $compfile' -C f77 Set 'cc -c -w '//[DEBUGCCC]//' $compfile' -C C (VAX) Set 'FOR/OBJ=$compfile.OBJ'//[DEBUGOPT]//' $compfile' -C f77 Set 'CC/OBJ=$compfile.obj'//[DEBUGCCC]//' $compfile' -C C * (ALPHA) Case $OS In (VMS) Set 'FOR/SEPAR/OBJ=$compfile.OBJ'//[DEBUGOPT]//' $compfile' -C f77 Set 'CC/OBJ=$compfile.obj'//[DEBUGCCC]//' $compfile' -C C (UNIX) Set 'f77 -c -O -w -Nl99 '//[DEBUGOPT]//' $compfile' -C f77 Set 'cc -c -O -w '//[DEBUGCCC]//' $compfile' -C C Endcase +REP,$KUMACS,INSTALL,228-235. (NONE) message 'no code extracted' (SOURCE) if [version] = '' then Cxtract * else Cxtract -V [version] * endif Message * fortran code extracted (OBJECT) if [version] = '' then Ccompile * else Ccompile -V [version] * endif Message * fortran objects created (LIB) if [version] = '' then Clib * else Clib -V [version] * endif Message * fortran library created +REP,$KUMACS,INSTALL,251-255. if [version] = '' then Cxtract * else Cxtract -V [version] * endif (OBJECT) if [version] = '' then Ccompile * else Ccompile -V [version] * endif (LIB) if [version] = '' then Clib * else Clib -V [version] * endif +ADD,$KUMACS,INSTALL,303. mess ' VERSION:x.xx/xx - select version x.xx/xx' +ADD,COMMCB,CBCOMMON,0. *CMZU: 1.30/14 07/11/97 18.30.29 by Rafik Ouared *CMZU: 1.30/09 22/01/97 16.45.56 by M.T. Lakata +REP,COMMCB,CBCOMMON,81-87. * 22-jan-97 M.Lakata * added cblab2 common block for use in cbrlbl * * 07-Nov-97 R.Ouared * new common CBTRIG added to keep track up to the USER about the kind of trigger * &KEEP,ZBLENG. INTEGER ZBLENG PARAMETER (ZBLENG = 600000) &KEEP,CBBANK. &CDE, ZBLENG. INTEGER XELENG, XCLENG, XLQLNG, XIQLNG PARAMETER (XELENG = 100000) +ADD,COMMCB,CBCOMMON,562. COMMON /CBLAB2/ FNAMCB, FSETCB CHARACTER FNAMCB*12, FSETCB*6 +ADD,COMMCB,CBCOMMON,627. * &KEEP,CBTRIG. LOGICAL LTRIG0,LTRIG2,LTRIG4 COMMON /CBTRIG/ LTRIG0, LTRIG2, LTRIG4 * +REP,COMMCB,CFCOMMON,1-4. *CMZU: 1.30/13 16/04/97 13.14.11 by Curtis A. Meyer *CMZ : 16/04/97 13.13.00 by Curtis A. Meyer * copy the version 3.11 common blocks from cbkfit to cboff. * Curtis A. Meyer 16 April 1997. *CMZU: 3.11/00 16/04/97 11.32.54 by Pal Hidas *CMZU: 3.10/00 10/09/96 10.58.53 by Unknown *CMZU: 1.28/14 23/08/95 15.39.37 by Christian Voelcker *CMZU: 1.27/04 26/04/95 20.00.57 by Christian Voelcker ! * copy the latest cfcommon to the cboff.cmz file ! * /SQUIDC/ got re-arranged, some other things changed as well! *CMZU: 3.08/03 13/06/95 15.21.53 by Pal Hidas +REP,COMMCB,CFCOMMON,97-101. R ,CHISQ,CUTCL,CFBEAM,CFMISM,CFVTER,CFMIER,CFMISX,VRTKCF L ,MISGAM,MISSKL,MISNEU,MISPRO,CFTRHY,CFTRSU,CFDBUG L ,FPUTZ,CFVERT,CFVRTZ,CFSUPC,CFDEUT,CFORCE,CFGCOV L ,CFIGNR,CFVERZ,CFVERA,CFKS00,CFCHCR,CFKSCC L ,CFCOLL,CFKSKM,CFKSKS,CFCHCV,CFSCAN +REP,COMMCB,CFCOMMON,108-111. REAL VRTKCF(3) LOGICAL MISGAM,MISSKL,MISNEU,MISPRO,CFTRHY,CFTRSU,CFDBUG LOGICAL FPUTZ,CFVERT,CFVRTZ,CFSUPC,CFDEUT,CFORCE,CFGCOV LOGICAL CFIGNR,CFVERZ,CFVERA,CFKS00,CFCHCR,CFKSCC LOGICAL CFCOLL,CFKSKM,CFKSKS,CFCHCV,CFSCAN +ADD,COMMCB,CFCOMMON,158. * CFCHCR : take momenta from TVVP * CFCHCV : take also cov.matrix from TVVP (-> error prop.) * CFSCAN : Kshort vertex scan +REP,COMMCB,CFCOMMON,318. DOUBLE PRECISION CHVMOM(3,4),CHVPAR(9,4),CHKMOM(3,2) +ADD,COMMCB,DBCOMMON,0. *CMZU: 1.30/08 15/11/96 16.13.47 by Michael Doser * added KSV for the vertex detector calibration +REP,COMMCB,DBCOMMON,24. & KSV,KPW, +REP,COMMCB,DBCOMMON,33. & KSV=28, KPW=29, +ADD,COMMCB,DBCOMMON,64. PARTCC(KSV) = 'SV' +ADD,COMMCB,TC_MACRO,0. *CMZU: 1.30/12 14/03/97 17.26.20 by M.T. Lakata *CMZU: 1.30/08 15/11/96 16.23.54 by Michael Doser *CMZ : 1.30/04 15/04/96 15.00.45 by Unknown *CMZ : 1.30/03 03/04/96 19.32.25 by Unknown +ADD,COMMCB,TC_MACRO,142. * 03/04/96 Bernd Kaemmle modifications of Rafik Ouared * TCLIFT modified to include 2 new arrays: MTSV1,MTSV2 * * 15-Nov-96 M.Doser * add in the SVX calibration const. commons SVGCAL and SVECAL * +ADD,COMMCB,TC_MACRO,222. INTEGER MTSV1(5),MTSV2(5) +ADD,COMMCB,TC_MACRO,229. & ,MTSV1,MTSV2 +DEL,COMMCB,TC_MACRO,821. +REP,COMMCB,TC_MACRO,921-939. * some new parameters * V3CHCT - TCVER3: 2-prong charge conservation flag:0=no cons.1=do cons. * VHBD - outlier rejection flag: 1-reject more outliers 0-reject normal outl * VHOR - outlier chi^2 threshold * VHSP - hit phi scaling factor * VHSZ - hit zed scaling factor * * The parameters that end in D are the Defaults * INTEGER V3MNHD INTEGER V3CHCD,VHBDD REAL V3COND, V3DISD, V3BACD REAL VHMCHD,VHGCHD,VHCFLD,VHERCD,VHCTD REAL VHORD, VHSPD, VHSZD PARAMETER ( V3COND = 0.0, V3DISD=20.0, V3BACD=100.0 ) PARAMETER ( V3MNHD = 7 ) PARAMETER ( VHMCHD = 50.0, VHGCHD = 1.8, VHCFLD = 0.0 ) PARAMETER ( VHERCD = 1.0, VHCTD = 0.001 ) PARAMETER ( V3CHCD = 1, VHBDD = 1) PARAMETER ( VHORD = 25.0, VHSPD = 0.917, VHSZD = 0.886 ) * INTEGER VERTVR,VFITVR,V3MNHT REAL V3CONF, V3DIST, V3BACK REAL VHMCH,VHGCH,VHCFL,VHERC, VHCT INTEGER V3CHCT,VHBDT REAL VHORT,VHSPT,VHSZT * COMMON /TCVTCM/ & VERTVR, VFITVR, & V3CONF, V3DIST, V3BACK, V3MNHT, & VHMCH, VHGCH, VHCFL, VHERC, VHCT, & V3CHCT, VHBDT, VHORT, VHSPT, VHSZT +ADD,COMMCB,TC_MACRO,946. &KEEP,SVCALI. * * common blocks for the SVX calibrations constants * * the first common deals with geometrical constants: * * SVXANG = rotation of strip #1 wrt JDC * SVXGDX,GDY,GDZ = shift of center of SVX wrt center of JDC * SVXGRD = radial distance of strip #1 (nominally 12 mm) * SVXDDX,DDY,DDZ = shift of each detector wrt nominal position * SVXDDA,DDB,DDG = rotation -"- (axis = x,y,z) * COMMON /SVGCAL/ SVXANG,SVXGDX,SVXGDY,SVXGDZ,SVXGRD, & SVXDDX(15),SVXDDY(15),SVXDDZ(15), & SVXDDA(15),SVXDDB(15),SVXDDG(15) REAL SVXANG,SVXGDX,SVXGDY,SVXGDZ,SVXGRD,SVXDDX, & SVXDDY,SVXDDZ,SVXDDA,SVXDDB,SVXDDG * the second with energy calibration constants * (back plane and strip side) * * COMMON / SVECAL / SVEBAK(15),SVESTR(15) * REAL SVEBAK,SVESTR &KEEP,TCV3CM. * XXTCVT list of all TCVT banks (some will be dropped) * MAXVRT maximum number of vertices. Should be 2^MAXTRK INTEGER MAXVRT PARAMETER (MAXVRT=256) INTEGER XXTCVT(MAXVRT) COMMON /TCV3CM/ XXTCVT +ADD,CBPHYS,CBDONE,0. *CMZU: 1.30/10 05/02/97 20.39.48 by M.T. Lakata +ADD,CBPHYS,CBDONE,66. & /,5X,'Number of table events read .............',I9, & /,5X,'Number of slow control events read ......',I9, +ADD,CBPHYS,CBINIT,0. *CMZU: 1.30/08 15/11/96 15.56.39 by Michael Doser * Mod. 14.11.96 Michael: turn on the SVX calibration (GTVTCC) *CMZ : 1.30/07 01/08/96 17.10.06 by Kaemmle +ADD,CBPHYS,CBINIT,73. * Mod. 14.11.96 Michael: turn on the SVX calibration (GTVTCC) * (was set to FALSE in previous version, * is now set to TRUE) +REP,CBPHYS,CBINIT,215. GTVTCC = .TRUE. ! set .TRUE. if calibration is availiable +ADD,CBPHYS,CBINIT,479. ELSEIF ( OUTBCB.EQ.4HDSTF ) THEN * new switch for hopefully final production * is the same as above HDSTN but TCHT is preserved * WRITE(LLOG,*) ' Writing Banks according to card BANK DSTF' IXRJDF = IXEVNT ! (JDC pulsshape) needs much cpu IXTJDC = IXEVNT IXTPWC = IXEVNT IXTVXT = IXEVNT * IXTCHT = IXEVNT ! keeping TCHT BANK IXTCTK = IXEVNT IXTCHX = IXEVNT IXTCVX = IXEVNT IXTBEF = IXEVNT !\ IXTBEL = IXEVNT ! \ IXTBEN = IXEVNT ! > can be restored by xtl card IXTBTK = IXEVNT ! / (uses little cpu-time) IXTBCL = IXEVNT !/ +ADD,CBPHYS,CBSRIO,0. *CMZU: 1.30/08 15/11/96 16.11.36 by Michael Doser +ADD,CBPHYS,CBSRIO,23. * Mod. 15-Nov-96 M.Doser * Add calib bank for SVX: KSV +ADD,CBPHYS,CBSRIO,55. DATA APART(KSV)/'SV | SVX pos. correction '/ +ADD,CBPHYS,CBSRUN,0. *CMZU: 1.30/13 06/08/97 23.38.01 by Rafik Ouared *CMZ : 06/08/97 23.35.38 by Rafik Ouared * - Mask MC type foe accessing real data SV calibration. *CMZ : 18/06/97 09.22.27 by Curtis A. Meyer *CMZU: 1.30/11 12/02/97 16.03.21 by Michael Doser *CMZU: 1.30/08 15/11/96 16.20.30 by Michael Doser * - add in the code to pick up the calibration for the SVX * (look under GTVTCC and SVCALI) *CMZ : 1.30/07 23/07/96 11.28.26 by Kaemmle *CMZ : 1.30/06 22/07/96 10.51.11 by Kaemmle *CMZ : 1.30/03 15/02/96 15.39.41 by Unknown *CMZ : 1.30/02 15/02/96 15.26.21 by Unknown * - change of JDC TYPE from new to old JDC for runs .gt. 21000 * disabled +ADD,CBPHYS,CBSRUN,173. &SEQ,SVCALI. +REP,CBPHYS,CBSRUN,192. INTEGER LZFIDH,IS,IL,ISVR +ADD,CBPHYS,CBSRUN,252. ISVR = IRUN +REP,CBPHYS,CBSRUN,360-362. * change from new to old JDC * BK. * fix for some runs in jun 94 IF(IEHDCB(4) .GT. 21000 ) THEN WRITE(LLOG,*) & 'CBSRUN: Change from new to old JDC not allowed !' ELSE OLDJDC = .TRUE. CALL TCOLNW ENDIF ELSEIF(JDCTYP.EQ.1.AND.OLDJDC) THEN * change from old to new JDC +ADD,CBPHYS,CBSRUN,384. READOUT = ' ' +ADD,CBPHYS,CBSRUN,518. *_________________________________________________ * * get SVX geometry data * IF ( GTVTCC ) THEN CALL CCGETC(IRUN, IMVTCC, KSV, LCALB, IERR) IF ( IERR .EQ.0 ) THEN * New constants 110 CALL CBSRIO(KSV) * (re)set variables. LLAST = LQ(LCALB-1) IF ( LLAST.GT.0) THEN IF ( IQ(LLAST+1) .EQ. 1) THEN SVXANG = Q(LLAST+2) SVXGDX = Q(LLAST+3) SVXGDY = Q(LLAST+4) SVXGDZ = Q(LLAST+5) SVXGRD = Q(LLAST+6) DO I = 1,15 SVXDDX(I) = Q(LLAST+6*I+1) SVXDDY(I) = Q(LLAST+6*I+2) SVXDDZ(I) = Q(LLAST+6*I+3) SVXDDA(I) = Q(LLAST+6*I+4) SVXDDB(I) = Q(LLAST+6*I+5) SVXDDG(I) = Q(LLAST+6*I+6) ENDDO ENDIF ENDIF CALL MZDROP(IXSAVE,LCALB,'L') LCALB=0 LLAST=0 * recalculate the SVX geometry WRITE (LLOG,*) ' SV calibration read from data base' CALL TCINIB ELSEIF ( IERR.EQ.1 ) THEN * old constants still valid ELSE * nothing in the data base. * if MC, why not ?! get the newest data base from cern immediately. IF (LTYPMC.AND.LGEOM.NE.0) THEN * MC type is masked to get access to he database. QISMCC=.FALSE. CALL CCGETC(ISVR, IMVTCC, KSV, LCALB, IERR) QISMCC=.TRUE. IF(IERR.EQ.0) THEN GOTO 110 ELSE WRITE(LLOG,5998) 5998 FORMAT(' No entry in data base for SVX.',/, & ' Data base is out of date, get newest one from CERN.') ENDIF ENDIF CALL CBSRIE(KSV,' alignment of detectors wrong') ENDIF ENDIF +ADD,CBPHYS,CBSRUN,1400. * * FOrce TJTIMI to reclculate the tables every time: * QCTIM = .TRUE. * +REP,CBPHYS,CBSRUN,1987. TBCKCC= .TRUE. +ADD,CBPHYS,CBSRUN,1992. ELSE * set fudge factors to 1.0 , ignore database WRITE(LLOG,*) 'CK | ignoring constants from database: ' + //' using 1.0 (no error scaling)' TBCKCC= .TRUE. DO I=1,NFUDGE FUDGE(I) = 1. ENDDO +ADD,CBPHYS,CBTABS,0. *CMZU: 1.30/14 25/06/98 21.18.51 by Rafik Ouared +ADD,CBPHYS,CBTABS,65. * Jun 98 RO print out trigger information LTRIG0 * LTRIG2 and LTRIG4 +ADD,CBPHYS,CBTABS,76. &SEQ,CBTRIG. +REP,CBPHYS,CBTABS,94-100. CHARACTER*100 STRING,TRIG0,TRIG2,TRIG4 CHARACTER*6 IENVIR0,IENVIR2,IENVIR4 INTEGER ILENF0,ILENF2,ILENF4 INTEGER LUN0,LUN2,LUN4 SAVE LUN0,LUN2,LUN4 DATA LUN0,LUN2,LUN4 /87, 88, 89/ INTEGER LENGTH INTEGER HRTBF,HRTBL SAVE RFERA, HRTBF, HRTBL * INTEGER LZFIDH, JBYT, LENOCC EXTERNAL LZFIDH, JBYT, LENOCC +ADD,CBPHYS,CBTABS,444. * ***WHICH TRIGGER * LTRIG0=.FALSE. LTRIG2=.FALSE. LTRIG4=.FALSE. WRITE(IENVIR0,199) LUN0 WRITE(IENVIR2,199) LUN2 WRITE(IENVIR4,199) LUN4 199 FORMAT('FORT',I2) *** WRITE(LLOG,*) 'IENVIR 0,2,4..',IENVIR0,IENVIR2,IENVIR4 CALL GETENV(IENVIR0,TRIG0) CALL GETENV(IENVIR2,TRIG2) CALL GETENV(IENVIR4,TRIG4) *** WRITE(LLOG,*) 'TRIG 0,2,4..',TRIG0,TRIG2,TRIG4 ILENF0=LENOCC(TRIG0) ILENF2=LENOCC(TRIG2) ILENF4=LENOCC(TRIG4) *** WRITE(LLOG,*) 'ILENF 0,2,4..',ILENF0,ILENF2,ILENF4,LENGTH IF(TRIG0(1:ILENF0).EQ.STRING(1:LENGTH)) LTRIG0=.TRUE. IF(TRIG2(1:ILENF2).EQ.STRING(1:LENGTH)) LTRIG2=.TRUE. IF(TRIG4(1:ILENF4).EQ.STRING(1:LENGTH)) LTRIG4=.TRUE. WRITE(LLOG,*) 'LTRIG 0,2,4..',LTRIG0,LTRIG2,LTRIG4 * +REP,CBPHYS,CBTABS,455. * +ADD,CBPHYS,ZBINIT,0. *CMZU: 1.30/01 23/01/96 16.22.40 by F.-H.Heinsius +REP,CBPHYS,ZBINIT,376-378. &SELF,IF=ALT,DECS,SUN,UNIX,IF=-ONLINE. * * +ADD,LABEL,CBRLBL,0. *CMZU: 1.30/12 21/03/97 16.58.28 by M.T. Lakata *CMZU: 1.30/09 22/01/97 15.54.51 by M.T. Lakata +ADD,LABEL,CBRLBL,36. * M.Lakata * outputs some more meaningful header information, mostly for use with * labelled DLTs. * +REP,LABEL,CBRLBL,42-45. INTEGER ASCII,EBSDIC,TEXT PARAMETER (ASCII=1,EBSDIC=2) CHARACTER*25000 BUFF * CHARACTER*12 FNAMCB ! to be added to the label common block! LOGICAL LBLDBG INTEGER NWREC, ISTAT, LINE +REP,LABEL,CBRLBL,58-96. LINE = 1 SLBICB = .FALSE. 100 CONTINUE NWREC = 6000 CALL CFGET(FPINCB,MDINCB,NWREC,NWREC,BUFF,ISTAT) IF ( ISTAT.NE.0) THEN IF(SLBICB) THEN * successfully read at least one header line ISTAT = 0 ENDIF RETURN ENDIF * IF(LBLDBG) WRITE(LTERM,*) 'Header, line',LINE,':',BUFF(1:NWREC) * * * check if possibly a label * * sample raw data header. *HDR1VXONLINE GH299800010020 95354 95354 000000DXTAP7 12:03 *HDR2U230400000060 IF (NWREC .EQ. 20 ) THEN TEXT = ASCII 10 CONTINUE IF ( BUFF(1:4) .EQ. 'VOL1' ) THEN LABICB = BUFF(5:10) WRITE(LLOG,6000) LABICB SLBICB = .TRUE. * new file structure, file name in HDR1 record ELSEIF ( BUFF(1:4) .EQ. 'HDR1' ) THEN FNAMCB = BUFF(5:16) FSETCB = BUFF(22:27) WRITE(LLOG,6001) LABICB, & FNAMCB,FSETCB,BUFF(43:44),BUFF(45:47) SLBICB = .TRUE. * needed for buggy header that I made (MTL) ELSEIF ( BUFF(1:3) .EQ. 'DR1' ) THEN FNAMCB = BUFF(4:15) FSETCB = BUFF(21:26) WRITE(LLOG,6001) LABICB, & FNAMCB,FSETCB,BUFF(42:43),BUFF(44:46) SLBICB = .TRUE. * new file structure, file name in EOF1 record ELSEIF ( BUFF(1:4) .EQ. 'EOF1' ) THEN FNAMCB = BUFF(5:16) WRITE(LLOG,6002) LABICB, & FNAMCB,BUFF(22:27),BUFF(43:44),BUFF(45:47) SLBICB = .TRUE. * old file structure, no info from HDR record ELSEIF(BUFF(1:3).EQ.'HDR'.OR.BUFF(1:3).EQ.'EOF') THEN SLBICB = .TRUE. ELSEIF(TEXT.EQ.ASCII) THEN * translate the label from EBSDIIC to ASCII, if necessary! CALL TRE0A0(BUFF(1:NWREC),NWREC) WRITE(LLOG,*) 'EBSDIC header converted to: ', & BUFF(1:NWREC) WRITE(LLOG,*) 'At line ', LINE,' of label' TEXT = EBSDIC * try again GOTO 10 ENDIF +REP,LABEL,CBRLBL,102-138. * get remaining lines LINE = LINE + 1 GOTO 100 ELSE CALL CBTBOF(FPINCB,IERR) IF(IERR .NE. 0 ) CALL ERRLOG(IER001, & ' CBTBOF Returns non-zero error ') ENDIF * RETURN * 6000 FORMAT(/, & ' *******************************************************',/, & ' * TAPEVOL1 ',A6,' *',/, & ' ********************************************************') 6001 FORMAT(/, & ' *******************************************************',/, & ' * TAPEHDR1 Vol: ',A6,' File: ',A12, ' Set: ',A6,' *',/, & ' * TAPEHDR2 Year: ',A6,' Day: ',A6,' *',/, & ' ********************************************************') 6002 FORMAT(/, & ' *******************************************************',/, & ' * TAPEEOF1 Vol: ',A6,' File: ',A12, ' Set: ',A6,' *',/, & ' * TAPEEOF2 Year: ',A6,' Day: ',A6,' *',/, & ' *******************************************************') +ADD,LABEL,CBTBOF,0. *CMZU: 1.30/01 23/01/96 16.21.16 by F.-H.Heinsius +REP,LABEL,CBTBOF,20-23. #ifndef sun cbt.mt_op=MTBSF; #endif cbt.mt_count=1; filedes=(int)*tape_device; #ifndef sun +ADD,LABEL,CBTBOF,42. #endif +ADD,CRA*,00_PATCH,*. &PATCH,CRA*. *CMZU: 1.30/08 27/11/96 10.08.48 by Rafik Ouared +ADD,CRA*,CORR1,*. &DECK,CORR1. Updates version: 1.30/07 *CMZU: 1.30/08 15/11/96 16.25.20 by Michael Doser *-- Author :