C   12/03/84 412051642  MEMBER NAME  TAGRAW   (S)           FORTRAN
C
C
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C
       SUBROUTINE TAGRAW(IWRITE,*)
C
C THIS IS A VERSION OF TAGADC THAT HANDLES RAW DATA
C
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
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
C-----------------------------------------------------------------------
C                            MACRO CGRAPH .... GRAPHICS COMMON
C-----------------------------------------------------------------------
C
      LOGICAL DSPDTL,SSTPS,PSTPS,FREEZE
C
      COMMON / CGRAPH / JUSCRN,NDDINN,NDDOUT,IDATSV(11),ICREC,MAXREC,
     +                  LSTCMD,ACMD,LASTVW,ISTANV,
     +                  SXIN,SXAX,SYIN,SYAX,XMIN,XMAX,YMIN,YMAX,
     +                  DSPDTL(30),SSTPS(10),PSTPS(10),FREEZE(30),
     +                  IREADM,LABEL,LSTPS(10),IPSVAR
C
C------- END OF MACRO CGRAPH -------------------------------------------
C
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
       DIMENSION CALIB(2)
       DATA CALIB  / 10.0 , 6.6667 /
       DATA ICOUNT / 0 /
       LOGICAL NOMSG  / .FALSE. /
       LOGICAL LERROR / .FALSE. /
C
C
       IF ( NDDINN .NE. 0 ) NOMSG = .TRUE.
C
C FIND THE POINTERS ETC
C
C
       CALL BLOC(IND,'ATAG',0,*9001)
       I2S = ( IND * 2 ) + 3
       I2F = 2 * ( IND + IDATA(IND) )
       IF ( HDATA(I2F) .EQ. 0 ) I2F = I2F - 1
C
C
C  UNPACK ADC DATA
C
       IADD = 0
       DO  30 IS = I2S,I2F,1
          IDD = HDATA(IS)
C
C IDD GE 0 => DATA,OTHERWISE -(ADDRESS)
C
          IF ( IDD .GE. 0 ) GOTO 103
C
C HERE IF IDD IS AN ADDRESS - CONVERT IT TO A (POSITIVE) ADDRESS
C
          IADD = IDD + 32768
C
C NOW GOTO END OF LOOP - NEXT BIT OF DATA IS CONTENTS BELONGING
C TO THIS ADDRESS
C
          GOTO  30
C
  103     CONTINUE
C
C HERE FOR DATA
C
 5903     CONTINUE
          ITD = IS
          IF ( (IADD .GE. 96) .OR. (IADD .LT. 0) ) GOTO 20
C
C CONVERT HARDWARE ADDRESS TO SOFTWARE ADDRESS
C
          CALL TAGH2S(ISAD,IADD,*19)
C
          IF ( (ISAD .GT. IENDPZ) .OR. (ISAD .LT. 0) ) GOTO 19
C
C
C ISAD - SOFTWARE ADDRESS,IADD HARDWARE - ADDRESS,IDD - DATA
C NOW FILL CATAG LOCATION (ISAD) WITH CORRECT ENERGY FOR
C THIS BLOCK ( APPROXIMATELY IN MEV THANKS TO CALIB)
C
          CATAG(ISAD) = IDD * CALIB(MARK)
C
C
C CHECK FOR CRAZY DATA
C
          IF ( (IDD .GE. 0) .AND. (IDD .LE. 4090) ) GOTO 20
C
C
C
C---------------------------------- ERROR CONDITIONS-----------------
C
   18     CONTINUE
C
           IF ( .NOT. NOMSG ) WRITE(6, 11)ISAD,CATAG(ISAD)
   11      FORMAT(//,' +++  WARNING FROM TAGGING ROUTINE - TAGRAW -',
     *                '   CATAG(',I4,') HAS CRAZY VALUE -',F12.3,
     *                ' ---  IT HAS BEEN SET TO ZERO ')
C
C---                                     SET THE ARRAY TO ZERO
C
           CATAG(ISAD) = 0.0
           IF ( .NOT. NOMSG ) LERROR = .TRUE.
           GOTO 20
C
C--------------------------------------- HERE FOR ILLEGAL ADDRESS
C
   19      IF ( NOMSG ) GOTO 20
           LERROR = .TRUE.
           WRITE(6, 21)IHAD,ISAD
   21      FORMAT(' +++ ILEGAL ADDRESS FOUND IN TAGRAW IHAD,ISAD ',2I10)
C
C    END OF ERROR HANDLING
C
   20     CONTINUE
C
C INCREMENT ADDRESS
C
          IADD=IADD+1
   30  CONTINUE
C
C---                                     NOW TEST FOR ANY ERRORS
C
       IF ( NOMSG .OR. ( .NOT. LERROR ) )  RETURN
       LERROR = .FALSE.
C
C---                                     IF THERE WAS AN ERROR THEN
C---                                     DUMP OUT THE OFFENDING BANK
C
       CALL HPRS('ATAG',0)
C
C---                                     COUNT THE NUMBER OF ERRORS
C
       ICOUNT = ICOUNT + 1
       IF ( ICOUNT .NE. 10 ) RETURN
       NOMSG = .TRUE.
       WRITE(6, 31)
   31  FORMAT(///,'+++  MORE THAN TEN ERRORS DETECTED BY TAGRAW',
     *            '  -- NO MORE MESSAGES  +++',///)
   41  FORMAT(6(/,8(2X,F9.2)))
C
       RETURN
C
 9001  RETURN 1
C
       END
