C   10/02/89 903051753  MEMBER NAME  GUOUT    (S)           FORTRAN77
C=======================================================================
      SUBROUTINE GUOUT
C=======================================================================
C.
C.    *
C.    *       User routine called at the end of each event
C.    *
C.
C

      COMMON/GCFLAG/IDEBUG,IDEMIN,IDEMAX,ITEST,IDRUN,IDEVT,IEORUN
     +        ,IEOTRI,IEVENT,ISWIT(10),IFINIT(20),NEVENT,NRNDM(2)
      COMMON/GCTRAK/VECT(7),GETOT,GEKIN,VOUT(7),NMEC,LMEC(30),NAMEC(30)
     + ,NSTEP ,MAXNST,DESTEP,SAFETY,SLENG ,STEP  ,SNEXT ,SFIELD,SNPHYS
     + ,TOFG  ,GEKRAT,IGNEXT,INWVOL,ISTOP ,IDECAD,IEKBIN
C
      COMMON /GCVOLU/ NLEVEL, NAMES(15), NUMBER(15),
     + LVOLUM(15),LINDEX(15),GTRAN(3,15),GRMAT(10,15),
     + NGPAR(15),GPAR(50,15),GONLY(15),GLX(3),
     + NJNEXT(2),JNEXT(15),INEXT(15),NNEXT(15)
C
      COMMON / GENPAR / WEIT(3),CNORM(3)
      COMMON / CEBLOK / EBLOCK(16,3)
C
#include "cmctag.for"
C
      INTEGER*2 HGG
C
CC    CALL TVNEXT
CC    CALL GDRAWC( 'TAGS', 3,+340., 10., 10., 0.3, 0.3)
CC    CALL GDXYZ(0)
C                      Z-X-VIEW THROUGH WHOLE VOLUME
CC    CALL TVNEXT
CC    CALL GDRAWC ( 'TAGS', 2, 0.0, 10.0, 10.0, 0.025,0.2)
CC    CALL GDXYZ(0)
C                      Z-X-VIEW THROUGH WHOLE VOLUME
CC    CALL TVNEXT
CC    CALL GDRVOL (2,NAMES,NUMBER,0,90.0,0.,0.0,10.0,10.0,0.025,0.2)
CC    CALL GDXYZ(0)
CC    CALL TVEND
C
C     WRITE(6,*) '  '
      ETOTAL=0.0
      DO 10 ISEG=1,16
         DO 20 IRING=1,3
C
C---AZIMUTHAL PARAMETRISATION OF ENERGY RESPONSE
C
            CALL AZIRES(ISEG,IRING)
C
C---SMEAR THE ENERGIES
            CALL RANNOR(GRAN1,GRAN2)
            ESMEAR=GRAN1*.024*CNORM(IRING)
CC          EBLOCK(ISEG,IRING)=EBLOCK(ISEG,IRING)+ESMEAR
C           WRITE(6,8001) ESMEAR,EBLOCK(ISEG,IRING)
 8001       FORMAT(1X,'ESMEAR ',F8.4,' EBLOCK ',F8.4)
C
C---NORMALISE AND WEIGHT THE ENERGIES
            EBLOCK(ISEG,IRING) =
     &           WEIT(IRING)*EBLOCK(ISEG,IRING)
C           WRITE(6,8002) WEIT(IRING),CNORM(IRING),EBLOCK(ISEG,IRING)
 8002       FORMAT(1X,' WEIT ',F8.4,' CNORM ',F8.4,' EBLOCK ',F8.4)
C
C---CALCULATE TOTAL ENERGY DEPOSITED IN CALORIMETER
            ETOTAL=ETOTAL+EBLOCK(ISEG,IRING)
C           WRITE(6,8003) ETOTAL
 8003       FORMAT(1X,' ETOTAL ',F8.4)
C
C---FILL IN HGG ARRAY ACCORDING TO STANDARD MARK III FORM
C   NOTE THE ARRAY CONSISTS OF ENERGIES
C
C--- -Z END
         IF(ISEG.GT.8) THEN
            IF(IRING.EQ.1) HGG(17-ISEG)=1000.*EBLOCK(ISEG,IRING)
            IF(IRING.EQ.2) HGG(25-ISEG)=1000.*EBLOCK(ISEG,IRING)
            IF(IRING.EQ.3) HGG(33-ISEG)=1000.*EBLOCK(ISEG,IRING)
C--- +Z END
         ELSE
            IOFF=0
            IF(ISEG.GT.4) IOFF=+8
            IF(IRING.EQ.1) HGG(29-ISEG+IOFF)=1000.*EBLOCK(ISEG,IRING)
            IF(IRING.EQ.2) HGG(37-ISEG+IOFF)=1000.*EBLOCK(ISEG,IRING)
            IF(IRING.EQ.3) HGG(45-ISEG+IOFF)=1000.*EBLOCK(ISEG,IRING)
         ENDIF
 20      CONTINUE
 10   CONTINUE
CC    DO 30 I1=1,192
CC       HGG(I1)=0
CC       HGG(I1)=I1*100
C30   CONTINUE
C     WRITE(6,8004) (HGG(I),I=1,192)
 8004 FORMAT(16(12(I5,1X)/))
      RETURN
      END
C***********************************************************************
C SUBROUTINE TO MODIFY RECORDED ENERGY ACCORDING TO AN AZIMUTHAL
C PARAMETRISATION
C
      SUBROUTINE AZIRES(ISEG,IRING)
C
      COMMON / CEBLOK / EBLOCK(16,3)
      COMMON / PATDAT / PATVEC (10), PATPOS (3)
      COMMON / AZIPAR / AZIFIT
      PI=3.14159
C
C---CALCULATE INCIDENT PHI ANGLE
C
      PHI=ATAN(ABS(PATVEC(2)/PATVEC(1)))
      IF(PATVEC(1).LT.0.AND.PATVEC(2).GT.0) PHI=PI-PHI
      IF(PATVEC(1).LT.0.AND.PATVEC(2).LT.0) PHI=PI+PHI
      IF(PATVEC(1).GT.0.AND.PATVEC(2).LT.0) PHI=2*PI-PHI
C
C     WRITE(6,8001) PATVEC(1),PATVEC(2),PHI
 8001 FORMAT(1X,'PX ',F8.4,' PY ',F8.4,' PHI ',F8.4)
C     WRITE(6,8012) ISEG,IRING
 8012 FORMAT(1X,'ISEG ',I2,' IRING ',I2)
C
C---CONVERT TO DEG.
      PHI=360.*PHI/(2*PI)
C
C     WRITE(6,8002) PHI
 8002 FORMAT(1X,' PHI (DEG) ',F8.4)
C
C---DETERMINE IN WHICH PHI GAP THE PARTICLE WAS INCIDENT
C
      IF(PHI.GT.337.5) THEN
          PHITRN=PHI-360.0
          GOTO 20
      ENDIF
      IF(PHI.LT.22.5) THEN
          PHITRN=PHI
          GOTO 20
      ENDIF
      DO 10 IGAP=2,8
         PHIMIN=-22.5+(IGAP-1)*45.
         PHIMAX=22.5+(IGAP-1)*45.
         IF(PHI.GT.PHIMIN.AND.PHI.LT.PHIMAX) THEN
            PHITRN=PHI-(IGAP-1)*45.
            GOTO 20
         ENDIF
 10   CONTINUE
C
C---CALCULATE CORRECTION FACTOR FROM PHI COORDINATE
C
C---CONVERT BACK TO RAD
 20   PHITRN=2*PI*PHITRN/360.
C     WRITE(6,8003) IGAP,PHIMIN,PHIMAX,PHITRN
 8003 FORMAT(1X,' IGAP ',I2,' PHIMIN ',F8.4,' PHIMAX ',
     &       F8.4,' PHITRN ',F8.4)
C     WRITE(6,8004) PHITRN,EBLOCK(ISEG,IRING)
 8004 FORMAT(1X,' PHITRN (MRAD) ',F8.4,' EBLOCK BEF COR ',F8.4)
C
      AZRES=(PI/8.0-AZIFIT*ABS(PHITRN))*8.0/PI
      EBLOCK(ISEG,IRING)=EBLOCK(ISEG,IRING)*AZRES
C     WRITE(6,8005) AZIFIT,AZRES,EBLOCK(ISEG,IRING)
 8005 FORMAT(1X,' AZIFIT ',F8.4,' AZRES ',F8.4,' EBLOCK ',F8.4)
C
      RETURN
      END
