      SUBROUTINE AVAGE
 
C-----------------------------------------------------------------------
C  AVE(ERAGE) AGE
C
C  CALCULATES AVERAGE AGE AS A FUNCTION OF RADIUS
C  THIS SUBROUTINE IS CALLED FROM MAIN
C-----------------------------------------------------------------------
 
      IMPLICIT NONE
*KEEP,BUFFS.
      COMMON /BUFFS/   RUNH,RUNE,EVTH,EVTE,DATAB,LH
      INTEGER          MAXBUF,MAXLEN
      PARAMETER        (MAXBUF=39*7)
      PARAMETER        (MAXLEN=12)
      REAL             RUNH(MAXBUF),EVTH(MAXBUF),EVTE(MAXBUF),
     *                 RUNE(MAXBUF),DATAB(MAXBUF)
      INTEGER          LH
      CHARACTER*4      CRUNH,CRUNE,CEVTH,CEVTE
      EQUIVALENCE      (RUNH(1),CRUNH), (RUNE(1),CRUNE)
      EQUIVALENCE      (EVTH(1),CEVTH), (EVTE(1),CEVTE)
*KEEP,ELABCT.
      COMMON /ELABCT/  ELCUT
      DOUBLE PRECISION ELCUT(4)
*KEEP,NKGI.
      COMMON /NKGI/    SEL,SELLG,STH,ZEL,ZELLG,ZSL,DIST,
     *                 DISX,DISY,DISXY,DISYX,DLAX,DLAY,DLAXY,DLAYX,
     *                 OBSATI,RADNKG,RMOL,TLEV,TLEVCM,IALT
      DOUBLE PRECISION SEL(10),SELLG(10),STH(10),ZEL(10),ZELLG(10),
     *                 ZSL(10),DIST(10),
     *                 DISX(-10:10),DISY(-10:10),
     *                 DISXY(-10:10,2),DISYX(-10:10,2),
     *                 DLAX (-10:10,2),DLAY (-10:10,2),
     *                 DLAXY(-10:10,2),DLAYX(-10:10,2),
     *                 OBSATI(2),RADNKG,RMOL(2),TLEV(10),TLEVCM(10)
      INTEGER          IALT(2)
*KEEP,NKGS.
      COMMON /NKGS/    CZX,CZY,CZXY,CZYX,SAH,SL,ZNE
      DOUBLE PRECISION CZX(-10:10,2),CZY(-10:10,2),CZXY(-10:10,2),
     *                 CZYX(-10:10,2),SAH(10),SL(10),ZNE(10)
*KEEP,RUNPAR.
      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
     *                 MONIOU,MDEBUG,NUCNUC,
     *                 CETAPE,
     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
     *                 N1STTR,MDBASE,
     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
     *                ,GHEISH,GHESIG
      COMMON /RUNPAC/  DSN,HOST,USER
      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
      REAL             STEPFC
      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
     *                 N1STTR,MDBASE
      INTEGER          CETAPE
      CHARACTER*79     DSN
      CHARACTER*20     HOST,USER
 
      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
     *                ,GHEISH,GHESIG
*KEND.
 
      DOUBLE PRECISION AJ,BJ,CJ,DF(10),SJ(10),SLLG,TH,ZF
      INTEGER          I,ID,IL,IOL,J,K,L
C-----------------------------------------------------------------------
 
      IF ( DEBUG ) WRITE(MDEBUG,*) 'AVAGE :'
 
      IF ( FPRINT ) WRITE(MONIOU,1110) SHOWNO,ELCUT(3),ELCUT(4)
 1110 FORMAT (/' ---------- NKG - OUTPUT OF SHOWER NO ',I10,
     *         ' --------------------------------'/
     *       ' ELECTRON/PHOTON THRESHOLD AT ',F10.5,' /',F10.5,' GEV')
 
C  LOOP OVER ALL DISTANCES WHERE ELECTRON NUMBER IS CALCULATED
      DO 302  K = 1,2
        IF ( OBSATI(K) .GE. 0.D0 ) THEN
          DO 301  ID = -10,10
            DLAX (ID,K) = DLAX (ID,K) + CZX (ID,K)
            DLAY (ID,K) = DLAY (ID,K) + CZY (ID,K)
            DLAXY(ID,K) = DLAXY(ID,K) + CZXY(ID,K)
            DLAYX(ID,K) = DLAYX(ID,K) + CZYX(ID,K)
 301      CONTINUE
        ENDIF
 302  CONTINUE
 
C  CALCULATE LONGITUDINAL SHOWER DEVELOPMENT
      DO 311  IL = 1,IALT(1)
        IF ( SL(IL) .GT. 0.D0 ) THEN
          SEL(IL)   = SEL(IL) + SL(IL)
          SLLG      = LOG10(SL(IL))
          SELLG(IL) = SELLG(IL) + SLLG
          ZEL(IL)   = ZEL(IL) + SL(IL)**2
          ZELLG(IL) = ZELLG(IL) + SLLG**2
          ZF        = ZNE(IL) / SL(IL)
          CALL AGE( ZF,TH )
C  AGE PARAMETERS AVERAGED ON ALL SUBCASCADES AT THIS LEVEL
          SAH(IL) = TH
          STH(IL) = STH(IL) + TH
          ZSL(IL) = ZSL(IL) + TH**2
        ELSE
          SAH(IL) = 0.D0
        ENDIF
        EVTE(175+IL) = SL (IL)
        EVTE(185+IL) = SAH(IL)
        EVTE(215+IL) = TLEV(IL)
        EVTE(225+IL) = TLEVCM(IL)
 311  CONTINUE
 
C  PRINT LONGITUDINAL SHOWER DEVELOPMENT
      IF ( FPRINT ) WRITE(MONIOU,229)
     *  (I,TLEV(I),TLEVCM(I),SL(I),SAH(I),I=1,IALT(1))
  229 FORMAT(
     *  /' LEVEL',2X,'THICKNESS',8X,'HEIGHT',5X,'ELECT. NUMBER',7X,'AGE'
     *  /'  NO. ',2X,'  G/CM**2',8X,'    CM'/
     *        (' ',I4,F12.0,2X,F12.0,1X,F17.3,F10.3) )
 
      DO 312  IOL = 1,2
        IF ( OBSATI(IOL) .LT. 0.D0 ) GOTO 312
C  DETERMINE LOCAL AGE PARAMETER
        DO 50  J = 1,9
          IF ( CZX(J+1,IOL).GT.0.D0  .AND.  CZX(-J-1,IOL).GT.0.D0  .AND.
     *         CZXY(J+1,IOL).GT.0.D0 .AND.  CZXY(-J-1,IOL).GT.0.D0 .AND.
     *         CZYX(J+1,IOL).GT.0.D0 .AND.  CZYX(-J-1,IOL).GT.0.D0 .AND.
     *         CZY(J+1,IOL).GT.0.D0  .AND.  CZY(-J-1,IOL).GT.0.D0 ) THEN
            AJ = 0.125D0 * (
     *           CZX(J,IOL) /CZX(J+1,IOL) + CZX(-J,IOL) /CZX(-J-1,IOL)
     *         + CZXY(J,IOL)/CZXY(J+1,IOL)+ CZXY(-J,IOL)/CZXY(-J-1,IOL)
     *         + CZYX(J,IOL)/CZYX(J+1,IOL)+ CZYX(-J,IOL)/CZYX(-J-1,IOL)
     *         + CZY(J,IOL) /CZY(J+1,IOL) + CZY(-J,IOL) /CZY(-J-1,IOL) )
          ELSE
            AJ = 0.D0
          ENDIF
          IF ( AJ .GT. 0.D0 ) THEN
            BJ    = DIST(J) / DIST(J+1)
            CJ    = (DIST(J)+RMOL(IOL)) / (DIST(J+1)+RMOL(IOL))
            SJ(J) = LOG(AJ * BJ**2 * CJ**4.5D0) / LOG(BJ * CJ)
            DF(J) = 0.5D0 * (DIST(J) + DIST(J+1))
          ELSE
            SJ(J) = 0.D0
            DF(J) = 0.D0
          ENDIF
  50    CONTINUE
 
        DO L = 1,10
          EVTE(165+IOL*40+L) = SJ(L)
        ENDDO
 
        IF ( FPRINT ) THEN
C  WRITE LOCAL AGE PARAMETER
          WRITE(MONIOU,60) IOL,OBSATI(IOL), (I,DF(I),SJ(I),I=1,9)
  60      FORMAT(/' RADIAL BIN  DISTANCE(CM)  LOCAL AGE  AT LEVEL NO.',
     *          I4,' AT HEIGHT:',F10.0,' CM'/
     *         (' ',I10,'   ',F10.0,'  ',F10.3 ) )
 
C  PRINT LATERAL ELECTRON DISTRIBUTION
          WRITE(MONIOU,507) IOL,OBSATI(IOL)
 507      FORMAT(/' LATERAL ELECTRON DENSITY (/CM**2)    AT LEVEL NO.',
     *           I4,' AT HEIGHT:',F10.0,' CM'/
     *           ' --------------------------------------------------',
     *           '---------------------------'/
     *           '  DIST (CM)        CZX            CZY      ',
     *           '      CZXY           CZYX     ')
          WRITE(MONIOU,508) (DISX(I),CZX(I,IOL),CZY(I,IOL),
     *                      CZXY(I,IOL),CZYX(I,IOL),I=-10,10)
 508      FORMAT(' ',0P,F10.0,1P,4E15.5)
        ENDIF
 
 312  CONTINUE
 
      DO  L = 1,10
        EVTE(195+L) = DIST(L)
        EVTE(235+L) = DF(L)
      ENDDO
 
C  WRITE NKG - SHOWER INFORMATION TO EVENT END BLOCK
      DO 353  L = 1,21
        EVTE(  7+L) = CZX (-11+L,1)
        EVTE( 28+L) = CZY (-11+L,1)
        EVTE( 49+L) = CZXY(-11+L,1)
        EVTE( 70+L) = CZYX(-11+L,1)
        EVTE( 91+L) = CZX (-11+L,2)
        EVTE(112+L) = CZY (-11+L,2)
        EVTE(133+L) = CZXY(-11+L,2)
        EVTE(154+L) = CZYX(-11+L,2)
 353  CONTINUE
 
      RETURN
      END
