C   22/06/84 412061343  MEMBER NAME  TAGGTP   (S)           FORTRAN
C
C
C
C------  T A G G T P  ------  T A G G T P  ------  T A G G T P  ------
C
C------  T A G G T P  ------  T A G G T P  ------  T A G G T P  ------
C
C------  T A G G T P  ------  T A G G T P  ------  T A G G T P  ------
C
C
C
C
C     ----   STEERING ROUTINE FOR TP-ING TAGGING DATA  ----
C
C
C
C
C THIS   IS THE MAIN LEVEL OF MY ROUTINES TO TP THE TAGGING SYSTEM
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
       SUBROUTINE  TAGGTP(IWRITE,EN, * , * )
C
C
C COMMONS   ETC FOR A.J.FINCH'S TP OF TAGGING SYSTEM
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
       IMPLICIT INTEGER * 2 ( H)
C
C----------------------------------------------------------------------
C             MACRO CDATA .... BOS COMMON.
C
C             THIS MACRO ONLY DEFINES THE IDATA/HDATA/ADATA NAMES.
C             THE ACTUAL SIZE OF /BCS/ IS FIXED ON MACRO CBCSMX
C             OR BY OTHER MEANS. A DEFAULT SIZE OF 40000 IS GIVEN HERE.
C
C----------------------------------------------------------------------
C
      COMMON /BCS/ IDATA(40000)
      DIMENSION HDATA(80000),ADATA(40000),IPNT(50)
      EQUIVALENCE (HDATA(1),IDATA(1),ADATA(1)),(IPNT(1),IDATA(55))
      EQUIVALENCE (NWORD,IPNT(50))
C
C------------------------ END OF MACRO CDATA --------------------------
C
      COMMON/COMTAG/LISTOK,NLIST(64,9,2),
     1XMAP(64),YMAP(64)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C COMTAG - THESE NUMBERS ARE NEEDED THROUGHOUT THE JOB BY ANALYSIS
C           ROUTINES
C ================================================================
C
C
C LISTOK->  FLAGS THAT NEIGHBOUR LIST HAS BEEN GENERATED
C
C NLIST ->  LIST OF CLOSEST NEIGHBOURS TO A BLOCK   (I,1) = NUMBER
C           OF CLOSEST NEIGHBOURS (I,2-9)ADC ADDRESSES OF NEIGHBOURING
C           BLOCKS  (CLUSFN).THE THIRD ARGUMENT REFERS TO THE MARK
C           OF TAGGING SYSTEM - EITHER MARK 2 OR MARK 3.
C
C XMAP(64) -> XMAP AND YMAP CONTAIN THE X,Y ADDRESSES OF THE BLOCKS IN
C YMAP(64) -> THE 1982 TAGGING SYSTEM
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C
C
C------------ C O M M O N    C W O R K   F O R   T A G A N -------------
C
C
       COMMON/CWORK/MARK,IFLMRK,IMC,NCLST,NNEI,
     *              ISTMZ,ISTPZ,IENDMZ,IENDPZ,
     *              SIGX,SIGY,SIGEN,
     *              CAND(3),CLUS(9,2),CMAP(10,9),
     *              SADC(32,2),CATAG(192)
C
C
C CWORK - WORKSPACE USED ONLY ONCE PER EVENT FOR INTERNAL PROCESSING
C ==================================================================
C
C MARK   ->  WHICH 'MARK' OF TAGGER - 1 = 1981,2
C                                   - 2 = 1983 ONWARDS
C
C IFLMRK ->  SET TO '1' BY TAGMRK
C
C IMC    ->  SET TO '1' BY TAGMRK IF MC DATA
C
C CATAG  ->  CONTAINS THE ADC CONTENTS UNPACKED FROM ATAG
C
C SADC   ->  COMMON FOR ADC'S AFTER SORTING  (SORT 1)
C
C CMAP(I,1...9) ->  ADDRESS OF ADC'S IN CLUSTER I,SORT23 PUTS THESE IN
C                   ORDER OF ENERGY.
C
C CAND(3) ->  X, Y, AND ENERGY OF A FOUND CLUSTER IN AFTER CLSPS
C
C SIGX,SIGY,SIGEN ->  ERROR ON X, Y, AND ENERGY AFTER CLSPS
C
C CLUS(9,2) ->  ADC ADDRESS AND CONTENTS OF CLUSTERS - SORTED BY ENERGY
C
C NCLST   ->  NUMBER OF CLUSTERS THIS END
C ISTMZ   ->  POINTER TO START OF -Z DATA IN CATAG ( ALWAYS  1       )
C ISTPZ   ->  POINTER TO START OF +Z DATA IN CATAG ( EITHER 33 OR 25 )
C IENDMZ  ->  POINTER TO   END OF -Z DATA IN CATAG ( EITHER 32 OR 24 )
C IENDPZ  ->  POINTER TO   END OF +Z DATA IN CATAG ( EITHER 64 OR 48 )
C
C A.J.FINCH 24/2/84
C MODIFIED 12/3/84 CATAG PUT TO END AND INCREASED TO 192
C  TO ALLOW IT TO BE USED FOR 1979,80 TAGGER IN GRAPHICS
C LAST MOD : J. NYE  30/05/84  RE-ORGANIZED INCLUDING IFLMRK
C
C
C-----------------------------------------------------------------------
C
C
C   12/03/84 412041226  MEMBER NAME  CTAGGO   (S)           FORTRAN
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C HERE ARE THE COMMONS THAT EVENTUALLY BECOME THE TP BANKS ACCLS -
C TAGG/O ,1,2,3
C CONVENTION IN NAMING -
C
C FIRST LETTER -
C         C - NAME OF COMMON
C         H - NAME OF VARIABLES *2 TYPE      INTEGER
C         I -   "       "       *4 TYPE         "
C         A -   "       "                    REAL
C
C REST OF NAME AS FOR TAGG BANKS SEE JADE COMPUTER NOTE 16 FOR MORE DETA
C
C ACTUALLY ALL THIS COULD ALSO GO IN WORKSPACE BUT I CANT BE BOTHERED!
C
C**** IMPORTANT :  IF YOU CHANGE THE SIZE OF THESE COMMONS PLEASE
C                  REMEMBER TO CHANGE 'TAGINT' WHICH CLEARS THEM.
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C
      COMMON / CACLS  / HID1,HID2,HIPM,HIPZ,HDUM,HIPL,HDUMM1(134)
      DIMENSION HACLS(140)
      EQUIVALENCE ( HACLS(1) , HID1 )
C
      COMMON / CTAGG0 / HID3,HID4,HTRACK,HTRZMI,HTRZPL,HCLST,
     *                  HCLZMI,HCLZPL,HNEUT,HCOL,HTYPE,HER,HCORR,
     *                  HPBLAT,HDUM1,HDUM2,HSCAL(36),HWPCL,HWPTR,
     *                  HDUMM2(14)
      DIMENSION     ATAGG0(34)
      EQUIVALENCE ( HID3 , ATAGG0(1) )
C
      COMMON / CTAGG1 / HMAP(2,20)
C
      COMMON / CTAGG2 / ATAGG2(260)
      DIMENSION         ITAGG2(260)
      INTEGER*2         HTAGG2(520)
      EQUIVALENCE ( HTAGG2(1) , ITAGG2(1) , ATAGG2(1) )
C
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
       INTEGER  START
       REAL  MZED
       INTEGER  PZMX
C
C PLUS   AND MINUS ZED DISTANCES OF TAGGERS
C
       DATA  PZED,MZED / 3160.0 , -3160.0 /
C
C
C----------------------- C O D E ---------------------------------------
C
C
C
C
C---                                         INITIALISATION
C
       CALL  TAGINT(*999)
C
       HWPCL  = 13
C
C ANGCUT   DEFINES COLINEARITY CRITERION
C FOR  COMPARING  CLUSTERS IN + AND - ZED
C
       ANGCUT  = 3.1
C
C  THRESH   IS THE THRESHOLD ENERGY FOR
C  STARTING   A CLUSTER SEARCH (MEV ?)
C
       THRESH  = EN * 25.0
C
       IF  ( IWRITE .EQ. 1 ) WRITE(6,6009) THRESH
 6009  FORMAT('  THRESHOLD FOR CLUSTER SEARCH IN TAGGER = ',F8.3)
C
C
       HIPM  = 4
C
       ISHALL  = IWRITE
C
C FILL   ARRAY CATAG : -
C TAGADC   DOES RETURN 1 FOR MISSING ATAG BANK - NO PROVISION YET
C NONE   REQUIRED TAGG/0 ONLY WILL BE CREATED ALL OTHER BANKS HAVE
C 0 LENGTH    SHOULD REALLY HAVE CHECKED BEFORE CALLING IT .
C
C
       CALL  TAGADC(ISHALL,*97)
C
C
C      SUBTRACT  PEDESTALS APPEARING DUE TO AC PICK UP ON SIGNAL CABLES
C
C
   97  CALL  TAGPED
C
C RECALIBRATE   USING FACTORS FOUND FROM CALIBR COMMON FILLED PREVIOUSLY
C BY KALIBR   IN CALLING ROUTINE.
C
       CALL  TAGKAL(ISHALL)
C
C WORK  OUT SMZ AND SPZ  I.E. SUM OF ALL BLOCKS AT - Z/ + Z RESPECTIVELY
C
       CALL TAGSUM(-1,SMZ,*98)
   98  CALL TAGSUM(+1,SPZ,*99)
   99  ETOT  = SMZ + SPZ
C
C SAVE   THIS INFORMATION IN WHAT WILL EVENTUALLY BE TAGG/0
C
       ATAGG0(29)  = 0.001 * ETOT
       ATAGG0(29)  = 0.001 * ETOT
       ATAGG0(32)  = 0.001 * ETOT
       ATAGG0(30)  = 0.001 * SMZ
       ATAGG0(33)  = 0.001 * SMZ
       ATAGG0(31)  = 0.001 * SPZ
       ATAGG0(34)  = 0.001 * SPZ
C
C
C NOW  PREPARE  TO DO THE FOLLOWING SECTION OF CODE FOR
C - Z  ONLY  ,LATER IT IS DONE FOR + ZED
C
       N = 0
C
C ZED  IS  - ZED   (IN MM )
C
       ZED = MZED
C
C JPART   IS - 1 FOR    - Z + 1 FOR + Z
C
       JPART = -1
C
C ISTART/IEND   = FIRST AND LAST PARTS OF CATAG TO USE ( - Z CHANNELS )
C
       ISTART = ISTMZ
       IEND   = IENDMZ
C
C IPOINT   IS A POINTER USED IN CONSTRUCTING THE CLUSTER MAP FOR OUTPUT
C
       IPOINT = 4
       HPZ    = IPOINT
C
C
C SORT   ADC'S BY SIZE ORDER  SORTED LIST IS IN SADC
C
    1  CALL TAGSR1(ISTART,IEND,ISHALL)
C
C FIND   ADDRESSES OF MEMBERS OF CLUSTERS
C
       ISHALL  = IWRITE
       CALL  TAGCLS(ISTART,IEND,THRESH,ISHALL)
C
       IF ( IWRITE .EQ. 1 ) WRITE(6,6001) NCLST,JPART
 6001  FORMAT(' TAGCLS FOUND ',I4,' CLUSTERS IN TAGGER JPART ',I4)
C
C SAVE   THE INFORMATION WE HAVE NOW FOR CLUSTERS ( NUMBER OF THEM )
C

       IF  ( JPART .EQ. -1 ) HCLZMI = NCLST
       IF  ( JPART .EQ.  1 ) HCLZPL = NCLST
C
*** PMF 15/10/99: new GOTO label introduced behind the 'END DO'-CONTINUE statement at label 10
*       IF  ( NCLST .EQ. 0 ) GOTO 10
       IF  ( NCLST .EQ. 0 ) GOTO 11
*** PMF (end)
C
C NOW  START  A LOOP OVER EACH CLUSTER IN TURN
C
       DO 10 I = 1,NCLST
          N  = N + 1
C
C SORT   EACH CLUSTER BY ENERGY ,PUT RESULT IN CLUS (9,2)
C
          CALL TAGSR2(I)
C
C CALCULATE   SUM OF ENERGY FOR CLUSTER , ANFD FILL ACLS
C      IPOINT  POINTS TO THE START OF CLUSTER N IN ACLS
C
          HMAP(1,N)  = IPOINT
C
C      FFADC  IS THE ADDRESS OF THE 'PARENT' OF THIS CLUSTER
C
          FFADC  = CMAP(I,1)
C
C      NNEI  IS THE NUMBER OF BLOCKS WHICH ARE NEIGHBOURS OF THIS BLOCK
C
          NNEI  = NLIST(FFADC,1,MARK)
C
C START   A LOOP OVER EACH MEMBER OF CLUSTER TO PUT THEM IN CLUSTER MAP
C AND  WORK  OUT SUM
C
          SUM  = 0
C
          DO 5 J = 1,NNEI
C
C      END  OF CLUSTER IF ENERGY OF THIS BLOCK IS ZERO
C
             IF  ( CLUS(J,2) .LE. 0 ) GOTO 5
             IHAPIN = IPOINT + IPOINT
C
C CONVERT   BACK FROM SOFTWARE ADDRESS TO HARDWARE ADDRESS
C TO REVERSE   ACTION TAKEN IN TAGADC (SOFTWARE ADDRESSES MAKE PROGRAM
C EASIER   TO WRITE AND READ)
C
             IADC  = CLUS(J,1)
             IHADC = TAGS2H(IADC)
C
C TAGS2H   RETURNS A VALUE OF - 1 IF IT CANT WORK OUT HARDWARE ADDRESS
C
             IF ( IHADC .EQ. -1 ) GOTO 5
C
C FILL   CLUSTER MAP - FIRST HALF WORD IS ADDRESS SECOND IS ENERGY
C
             HACLS(IHAPIN - 1) = IHADC
             HACLS(IHAPIN)     = CLUS(J,2)
C
C INCREMENT   POINTER   ALWAYS POINTS TO NEXT WORD TO BE FILLED
C
             IPOINT = IPOINT + 1
             SUM = SUM + CLUS(J,2)
 5        CONTINUE
C
          IF ( IWRITE .EQ. 1 ) WRITE(6,6005) N,JPART,SUM
 6005     FORMAT(1X,'THE ENERGY SUM FOR CLUSTER ',I4,
     1              ' IN JPART ',I4,'   IS ',F12.3)
C
C END  OF  LOOP OVER EACH MEMBER OF CLUSTER
C
C      HMAP(2,N)  IS WHERE TO FIND THE LAST MEMBER OF CLUSTER N IN ACLS
C
         HMAP(2,N)  = IPOINT - 1
C
C WORK   OUT POSITION OF CENTRE OF EACH CLUSTER
C
         CALL TAGPOS(SUM,ISHALL)
C
C WORK   OUT DIRECTION COSINES
C
         CALL TAGDIR(CAND(2 ) ,CAND(3 ) ,ZED,DX,DY,DZ)
C
C NOW  SAVE  INFORMATION FOR THIS CLUSTER
C
          IB = (N - 1) * HWPCL
          HIB = IB * 2
          HTAGG2(HIB + 1) = N
          HTAGG2(HIB + 2) = JPART
          ATAGG2(IB + 5)  = 0.001 * CAND(1 )
          ATAGG2(IB + 6)  = 0.001 * SIGEN
          ATAGG2(IB + 7)  = CAND(2)
          ATAGG2(IB + 8)  = CAND(3)
          ATAGG2(IB + 9)  = SIGX
          ATAGG2(IB + 10) = SIGY
          ATAGG2(IB + 11) = DX
          ATAGG2(IB + 12) = DY
          ATAGG2(IB + 13) = DZ
C
C END  OF  LOOP OVER EACH CLUSTER
C
   10  CONTINUE
*** PMF 15/10/99: new label added for a former GOTO statement
   11  CONTINUE
*** PMF (end) 
C
C SET  UP  FOR AND DO PLUS ZED
C
       JPART  = JPART + 2
       IF ( JPART .GT. 1 ) GOTO 15
       HIPZ   = IPOINT
       ZED    = PZED
       ISTART = ISTPZ
       IEND   = IENDPZ
       GOTO 1
C
   15  CONTINUE
C
C NOW  ALL  CLUSTERS IN - Z AND + Z HAVE BEEN FOUND AND THEIR PROPERTIES
C CALCULATED   - CALCULATE SOME MORE PROPERTIES OF THE EVENT AS A WHOLE
C
       HCLST  = HCLZPL + HCLZMI
       HNEUT  = HCLST
       HIPL   = IPOINT
       ACOLAN = 6.29316
C
C      NOW  DO ACCOLINEARITY CHECKS
C
C      FIRST  CHECK THERE ARE CLUSTERS EACH SIDE
C
*** PMF 15/10/99: new GOTO label introduced behind the 'END DO'-CONTINUE statement at label 20
*       IF ( ( HCLZMI .EQ. 0 ) .OR. ( HCLZPL .EQ. 0 ) ) GOTO 20
       IF ( ( HCLZMI .EQ. 0 ) .OR. ( HCLZPL .EQ. 0 ) ) GOTO 21
* PMF (end)
       EMAX  = 0
C
C FIND   THE CLUSTER IN - Z WITH GREATEST ENERGY (PROBABLY FIRST ONE)
C  MZMX   IS THE RECORD OF THIS (AS CLUSTER NUMBER IN TAGG/2)
C
       DO 16 I = 1,HCLZMI
          IB = (I - 1) * HWPCL
          EN = ATAGG2(IB + 5)
          IF ( EN .LT. EMAX ) GOTO 16
          EMAX = EN
          MZMX = I
   16  CONTINUE
C
C SIMILARLY    FOR + Z
C
       EMAX   = 0
       START  = HCLZMI + 1
       DO 17 I = START,HCLST
          IB = (I - 1) * HWPCL
          EN = ATAGG2(IB + 5)
          IF ( EN .LT. EMAX ) GOTO 17
          EMAX = EN
          PZMX = I
  17   CONTINUE
C
C FIND   THE ANGLE BETWEEN THE  LARGEST CLUSTERS IN + / - Z
C
       CALL TAGCOL(MZMX,PZMX,THETA)
       ACOLAN = THETA
C
C      NOW  FOR EACH CLUSTER IN - Z LOOK FOR A COLINEAR CLUSTER IN + Z
C
       START = HCLZMI + 1
C
       DO 20 I = 1,HCLZMI
C
          DO 22 J = START,HCLST
C
             CALL TAGCOL(I,J,THETA)
C
             IF ( THETA .LT. ANGCUT ) GOTO 22
C
C        COLINEAR PAIR FOUND   - FIRST COUNT HOW MANY THERE ARE
C
             HCOL = HCOL + 1
C
C TELL   - Z CLUSTER ABOUT ITS + Z PARTNER AND VICE VERSA
C
             HIB = 2 * ((I - 1) * HWPCL)
             HTAGG2(HIB + 5) = J
             HIB = 2 * ((J - 1) * HWPCL)
             HTAGG2(HIB + 5) = I
   22     CONTINUE
   20  CONTINUE
*** PMF 15/10/99: new label added for a former GOTO statement
   21  CONTINUE
*** PMF (end) 
       ATAGG0(28) = ACOLAN
C
C FILL   TP BNKS ICLST/IPOINT ARE LENGTHS OF BANKS TO CREATE
C TAGSTO   CREATES THE BOS BANKS 'ACLS' 'TAGG'/0,1,2
C
       ICLST  = HCLST
       CALL TAGSTO(ICLST,IPOINT,IERTAG)
       IF ( IERTAG .NE. 0 ) RETURN 2

       RETURN
C
  999  RETURN 1
       END
