*$ CREATE USRSUWEV.FOR
*COPY USRSUWEV
*
*=== Usrsuwev ========================================================*
*
      PROGRAM USRSUWEV

      INCLUDE '(DBLPRC)'
      INCLUDE '(DIMPAR)'
      INCLUDE '(IOUNIT)'
*
*----------------------------------------------------------------------*
*                                                                      *
*     Copyright (C) 1995-2021      by    Alfredo Ferrari & Paola Sala  *
*     All Rights Reserved.                                             *
*                                                                      *
*                                                                      *
*     USer Residual scoring SUm and Weighting and EVolution:           *
*                                                                      *
*     Authors:                           Alfredo Ferrari & Paola Sala  *
*                                                                      *
*                                                                      *
*     Created on    12 July 1995   by    Alfredo Ferrari & Paola Sala  *
*                                                Infn - Milan          *
*                                                                      *
*     Last change on  13-May-21    by    Alfredo Ferrari & Paola Sala  *
*                                            Private      Infn - Milan *
*                                                                      *
*----------------------------------------------------------------------*
*
      INCLUDE '(ISOTOP)'
      INCLUDE '(RDCYCM)'
      INCLUDE '(USRSNC)'
*
      CHARACTER FILE*132,FILE1*80,RUNTIT*80,RUNTIM*32,CHSTAT*10,CHERR*3,
     &          CHISMR*10,CHCTOT*15,YES*1
*
      PARAMETER ( MXDUMM = 700000 )
      PARAMETER ( NMXGRP = 1000 )
      PARAMETER ( NMXEBN = 1000 )
      PARAMETER ( MXARSN =  400 )
      PARAMETER ( MXITHR = 1200 )
      PARAMETER ( MXIDAU =  130 )
      PARAMETER ( MXACTV =  100 * 100 * MXIDAU )
*
      DIMENSION GMSTOR (MXDUMM), GDSTOR (MXDUMM), GBSTOR (MXDUMM),
     &          GESTOR (MXDUMM), GCSTOR (MXDUMM),
     &          TOTTOT (MXRSNC), TOTERR (MXRSNC),
     &          TOTUNS (MXRSNC), TOTUER (MXRSNC),
     &          BIRHLP (MXIRRD), TIRHLP (MXIRRD),
     &          KAURSN (MXRSNC), JX (MXRSNC), ACCUMA (NMXEBN+NMXGRP),
     &          ACCUMZ (NMXEBN+NMXGRP), RCCUMA (NMXEBN+NMXGRP),
     &          RCCUMZ (NMXEBN+NMXGRP), TDECAY (MXRSNC),
     &          KZURSN (MXRSNC), IABEG (100), IAEND (100)
      REAL      WEIPRI, BEAINT, TIMEIR, TDECAY, VURHLP, GMSTOR, TOTA,
     &          TOTB  , RCCUMA, RCCUMZ, BIRHLP, TIRHLP
      DIMENSION IAD   ( MXIDAU ), IZD ( MXIDAU ), ISD ( MXIDAU ),
     &          ACTIV ( MXACTV ), BRCTOT ( MXIDAU )
*
      DIMENSION IATHR  (MXITHR), IZTHR  (MXITHR), ACTHR  (MXITHR),
     &          ERTHR  (MXITHR), IAIZTH (MXITHR), ICORTH (MXITHR),
     &          IMTHR  (MXITHR)
      DIMENSION T12DDA (MXDCIS), BRDDAU (MXDCIS), IDCDAU (MXDCIS),
     &          KKA    (MXDCIS), KKZ    (MXDCIS)
*
      CHARACTER CHSYM*2
      LOGICAL LISMRS, LSTATI, LCHECK, LPATCH, LFIEND, LEVOLN, LOFFEV,
     &        LOLDIR
      LOGICAL LPRINT
*
      EXTERNAL TIM1O2, BDNOPT
      DIMENSION IASTLN (100), RESNUC (100,MXARSN), RESERR (100,MXARSN)
      DATA IASTLN /
     &     1,       4,       7,       9,      11,      12,
     &    14,      16,      19,      20,      23,      24,
     &    27,      28,      31,      32,      35,      40,
     &    39,      40,      45,      48,      51,      52,
     &    55,      56,      59,      59,      64,      65,
     &    70,      73,      75,      79,      80,      84,
     &    86,      88,      89,      91,      93,      96,
     &    97,     101,     103,     107,     108,     113,
     &   115,     118,     122,     128,     127,     131,
     &   133,     137,     139,     140,     141,     144,
     &   145,     150,     152,     157,     159,     163,
     &   165,     167,     169,     173,     175,     179,
     &   181,     184,     186,     190,     192,     195,
     &   197,     201,     204,     207,     209,     209,
     &   210,     222,     223,     226,     227,     232,
     &   231,     238,     237,     244,     243,     247,
     &   247,     251,     254,     257 /
*
      CALL CMSPPR
*
*     Note that all addresses are for zero index (KBURSN,KAURSN)
*
      DO 5555 I = 1, MXDUMM
         GMSTOR (I) = 0.E+00
         GBSTOR (I) = ZERZER
         GDSTOR (I) = ZERZER
         GCSTOR (I) = ZERZER
         GESTOR (I) = ZERZER
 5555 CONTINUE
      DO 4444 I = 1, MXRSNC
         TOTTOT (I) = ZERZER
         TOTERR (I) = ZERZER
         TOTUNS (I) = ZERZER
         TOTUNS (I) = ZERZER
         NISMRS (I) = 0
 4444 CONTINUE
      CHERR  = '+/-'
      NCTOT  = 0
      MCTOT  = 0
      WCTOT  = ZERZER
      MBATCH = 0
      IFILE  = 0
      LPRINT = .FALSE.
      LSTATI = .FALSE.
      LISMRS = .FALSE.
      LEVOLN = .FALSE.
      K0     = 0
      KK0    = 0
      KI0    = 0
      KI1    = 0
      KMAX   = 0
      NRNDC  = 0
      LQOLD  = 0
      WRITE (*,*)' Do you want to patch isomers (def=no)?'
      READ  (*,'(A)') YES
      LPATCH = YES .EQ. 'Y' .OR. YES .NE. 'y'
      WRITE (*,*) ' Beam intensity (=part/s, if < 0 irr. profile):'
      READ  (*,*) FACMUL
      CALL ISOINI
1111  CONTINUE
      LFIEND = .FALSE.
      WRITE(*,'('' Type the input file: '',$)')
      READ (*,'(A)')FILE
      LQ     = LNNBLN (FILE)
      IF (LQ .LE. 0) GO TO 2000
      OPEN (UNIT=1,FILE=FILE,STATUS='OLD',FORM='UNFORMATTED',ERR=1111)
      IFILE  = IFILE + 1
      IRECRD = 0
      READ (1,ERR=100) RUNTIT, RUNTIM, WEIPRI, NCASE, MCASE, NBATCH,
     &                 LISFVR, LMSFVR
      IRECRD = IRECRD + 1
      WRITE(*,*) RUNTIT
      WRITE(*,*) RUNTIM
      WRITE(*,*) WEIPRI
      WRITE(*,*) ABS (NCASE)
      WRITE(*,*) ABS (MCASE)
      WRITE(*,*) NBATCH
      GO TO 200
 100  CONTINUE
      READ (1,ERR=110) RUNTIT, RUNTIM, WEIPRI, NCASE, MCASE, NBATCH
      IRECRD = IRECRD + 1
      WRITE(*,*) RUNTIT
      WRITE(*,*) RUNTIM
      WRITE(*,*) WEIPRI
      WRITE(*,*) ABS (NCASE)
      WRITE(*,*) ABS (MCASE)
      WRITE(*,*) NBATCH
      LISFVR = 0
      LMSFVR = 0
      GO TO 200
 110  CONTINUE
      REWIND 1
      IRECRD = 0
      READ (1,ERR=120) RUNTIT, RUNTIM, WEIPRI, NCASE, NBATCH
      IRECRD = IRECRD + 1
      WRITE(*,*) RUNTIT
      WRITE(*,*) RUNTIM
      WRITE(*,*) WEIPRI
      WRITE(*,*) ABS (NCASE)
      MCASE  = 0
      LISFVR = 0
      LMSFVR = 0
      GO TO 200
 120  CONTINUE
      REWIND 1
      IRECRD = 0
      READ (1) RUNTIT, RUNTIM, WEIPRI, NCASE
      IRECRD = IRECRD + 1
      WRITE (*,*) RUNTIT
      WRITE (*,*) RUNTIM
      WRITE (*,*) WEIPRI
      WRITE (*,*) ABS (NCASE)
      MCASE  = 0
      NBATCH = 1
      LISFVR = 0
      LMSFVR = 0
 200  CONTINUE
      IF ( KISFVR .NE. LISFVR .OR. KMSFVR .NE. LMSFVR ) THEN
         WRITE (*,'(A)')
     &   ' The nuclear.bin file used by this code must be consistent'
         WRITE (*,'(A)')
     &   ' with the one used to generate the residual nuclei files.'
         WRITE (*,'(A)')
     &   ' Unfortunately it does not seem the case, the current'
         WRITE (*,'(A)')
     &   ' nuclear.bin file version does not match the one used'
         WRITE (*,'(A)')
     &   ' to generate the residual nuclei files. Execution stopped'
         WRITE (*,'(A)')
     &   ' If you need further clarifications about this issue'
         WRITE (*,'(A)')
     &   ' please write to fluka-discuss@fluka.org and you will'
         WRITE (*,'(A)')
     &   ' get help/suggestions and workarounds'
         STOP
      END IF
      IF ( IFILE .EQ. 1 ) THEN
         JISFVR = LISFVR
         JMSFVR = LMSFVR
      ELSE IF ( JISFVR .NE. LISFVR .OR. JMSFVR .NE. LMSFVR ) THEN
         WRITE (*,'(A)')
     &   ' The nuclear.bin files used when generating the different'
         WRITE (*,'(A)')
     &   ' residual nuclei outputs are not the same. You cannot sum'
         WRITE (*,'(A)')
     &   ' residual nuclei files generated with different versions'
         WRITE (*,'(A)')
     &   ' of nuclear.bin and/or Fluka. Execution stopped'
         STOP
      END IF
      LOFFEV = INDEX ( RUNTIM, 'Time Evolution' ) .GT. 0
      IF ( NCASE * MCASE .LT. 0 ) STOP ' INVALID NCASE/MCASE'
      LEVOLN = LOFFEV .OR. ( NCASE .LT. 0 .OR. MCASE .LT. 0 )
      LOLDIR = NCASE  .GE. 0 .AND. MCASE .GE. 0
      NCASE  = ABS (NCASE)
      MCASE  = ABS (MCASE)
      IF ( LEVOLN ) THEN
         IF ( LOLDIR ) THEN
            READ (1) BEAINT, TIMEIR
            IRECRD = IRECRD + 1
            NIRRDT = 1
            BIRRDT (1) = BEAINT
            TIRRDT (1) = TIMEIR
         ELSE
            READ (1) NIRRDT, ( BIRHLP(IR), TIRHLP(IR), IR = 1, NIRRDT )
            IRECRD = IRECRD + 1
            BEAINT = ZERZER
            TPREV  = ZERZER
            DO IR = 1, NIRRDT
               BIRRDT (IR) = BIRHLP (IR)
               TIRRDT (IR) = TIRHLP (IR)
               BEAINT = BEAINT + BIRRDT (IR) * ( TIRRDT (IR) - TPREV )
               TPREV  = TIRRDT (IR)
            END DO
            TIMEIR = TIRRDT (NIRRDT)
            BEAINT = BEAINT / TIMEIR
         END IF
         WRITE (*,*) ' Intensity:', BEAINT, ' pr/s'
         WRITE (*,*) ' T_irrad. :', TIMEIR, ' s'
         WRITE (*,*)
     &   ' Are you sure you want to evolve an evolution file??'
      END IF
      NCTOT  = NCTOT + NCASE
      MCTOT  = MCTOT + MCASE
      IF ( NCTOT .GE. 1000000000 ) THEN
         NCTOT = NCTOT - 1000000000
         MCTOT = MCTOT + 1
      END IF
      WCTOT  = WCTOT  + DBLE (WEIPRI)
      MBATCH = MBATCH + NBATCH
      KLAST  = 0
      KMAX   = 0
      NRNDC  = 0
      MRNDC  = 0
      NRNMN  = 0
*  +-------------------------------------------------------------------*
*  |                            Read from binary file the results!!!
      DO 6600 IX = 1,1000
         NRN = IX - NRNMN
         READ (1,ERR=6350,END=1000) CHSTAT,IJX
         IRECRD = IRECRD + 1
         IF ( CHSTAT .EQ. 'STATISTICS') THEN
            LSTATI = .TRUE.
            NRNDC  = MRNDC
            IF ( .NOT. LEVOLN ) GO TO 1000
            NRNMN = NRNMN + 1
            DO J = 1, NRNDC
               READ (1)
               READ (1)
               READ (1)
               READ (1)
               READ (1)
               READ (1)
               IRECRD = IRECRD + 6
               IF ( LISMRS ) THEN
                  READ (1)
                  IRECRD = IRECRD + 1
               END IF
            END DO
            MRNDC = 0
            GO TO 6600
         END IF
         IRECRD = IRECRD - 1
 6350    CONTINUE
*        BACKSPACE 1
         REWIND 1
         DO IR = 1, IRECRD
            READ (1)
         END DO
         READ (1,ERR=6400,END=1000)
     &                MRN, TIURSN(NRN), ITURSN(NRN), NRURSN(NRN),
     &                VURHLP, IMRHGH (NRN), IZRHGH (NRN), NMZMNM
         IRECRD = IRECRD + 1
         VURSNC (NRN) = VURHLP
         IF ( LEVOLN ) READ (1) TDECAY (NRN)
         IF ( LEVOLN ) IRECRD = IRECRD + 1
         GO TO 6500
 6400    CONTINUE
*        BACKSPACE 1
         REWIND 1
         DO IR = 1, IRECRD
            READ (1)
         END DO
         READ (1,ERR=6450) CHSTAT,IJX
         IRECRD = IRECRD + 1
         IF ( CHSTAT .EQ. 'STATISTICS' ) THEN
            LSTATI = .TRUE.
            NRNDC  = MRNDC
            IF ( .NOT. LEVOLN ) GO TO 1000
            NRNMN = NRNMN + 1
            DO J = 1, NRNDC
               READ (1)
               READ (1)
               READ (1)
               READ (1)
               READ (1)
               READ (1)
               IRECRD = IRECRD + 6
               IF ( LISMRS ) THEN
                  READ (1)
                  IRECRD = IRECRD + 1
               END IF
            END DO
            MRNDC = 0
            GO TO 6600
         END IF
 6450    CONTINUE
         STOP ' 2ND-RECORD'
 6500    CONTINUE
         JX (IX-NRNMN) = NRN
         NRNMX   = NRN
         MRNDC   = MRNDC + 1
***************************************************************
*********** Note KBURSN is used for 0 address *****************
***************************************************************
         KBURSN (NRN) = KLAST
         K0     = KLAST + 1
         K1     = IMRHGH (NRN) * IZRHGH (NRN) + K0 - 1
         KLAST  = K1
         READ (1) (GMSTOR(J), J = K0, K1)
         IRECRD = IRECRD + 1
         KMAX   = MAX ( KMAX, K1 )
         READ (1,ERR=6530,END=6525) CHISMR,NISMRS(NRN)
         IRECRD = IRECRD + 1
         IF ( CHISMR .EQ. 'ISOMERS:  ' ) THEN
            KI0   = K1 + 1
            KI1   = K1 + NISMRS (NRN)
            KLAST = KI1
            KMAX  = MAX ( KMAX, KI1 )
            IF ( KI1 .GE. KI0 ) THEN
               READ (1) (GMSTOR(J), J = KI0, KI1)
            ELSE
               READ (1)
            END IF
            IRECRD = IRECRD + 1
            LISMRS = .TRUE.
            LPATCH = .FALSE.
            GO TO 6535
         ELSE
*           WRITE (*,*) ' CHISMR  ', CHISMR
            NISMRS(NRN) = 0
            IRECRD = IRECRD - 1
            GO TO 6530
         END IF
 6525    CONTINUE
         LFIEND = .TRUE.
 6530    CONTINUE
*        BACKSPACE 1
         REWIND 1
         DO IR = 1, IRECRD
            READ (1)
         END DO
         KI1    = K1
*+++++++++++++++ Patch to add the isomers:
*  |  +----------------------------------------------------------------*
*  |  |
         IF ( LPATCH ) THEN
            LISMRS = .TRUE.
            IAMXMM = 2 * IZRHGH (NRN) + IMRHGH (NRN) + NMZMNM
            NISMRS (NRN) = ISMHLP (IAMXMM)
            KI0    = K1 + 1
            KI1    = K1 + NISMRS (NRN)
            KLAST  = KI1
            KMAX   = MAX ( KMAX, KI1 )
*  |  |  +-------------------------------------------------------------*
*  |  |  |
            DO IM = 1, IMRHGH (NRN)
*  |  |  |  +----------------------------------------------------------*
*  |  |  |  |
               DO IZ = 1, IZRHGH (NRN)
                  IN  = IM + IZ + NMZMNM
                  IA  = IN + IZ
                  IZN = IZ + IZRHGH (NRN) * ( IM - 1 ) + KBURSN (NRN)
*  |  |  |  |  +-------------------------------------------------------*
*  |  |  |  |  |  No unstable nucleus for A=<2
                  IF ( IA .GT. 2 .AND. IZ .LE. IA .AND. GMSTOR (IZN)
     &                 .GT. 0.E+00 ) THEN
                     ISOMER = -1
                     T12CUR = TIM1O2 ( IA, IZ, KKA, KKZ, T12DDA, BRDDAU,
     &                                 IDCDAU, ISOMER )
*  |  |  |  |  |  avoid to "boost" 207m-Pb production, since it
*  |  |  |  |  |  is mostly produced by thermal capture on the ground
*  |  |  |  |  |  state (??? to be checked)
                     IF ( IA .EQ. 207 .AND. IZ .EQ. 82 ) ISOMER = 0
                     ISOMER = ABS (ISOMER)
                     DO IS = 1, ISOMER
                        KS = 0
                        CALL ISMRCH ( IA, IZ, IS, KS, ADUMMY, BDUMMY,
     &                                JDUMMY, IDUMMY )
                        IF ( KS .LE. 0 ) WRITE(*,*)' IA,IZ,IS,KS',
     &                                               IA,IZ,IS,KS
                        IF ( KS .LE. 0 ) STOP ' STOP:KS-ISOMER'
                        JZN = KI0 - 1 + KS
                        IF ( JZN .GT. KLAST ) STOP ' STOP:JZN-KLAST'
                        GMSTOR (JZN) = GMSTOR (IZN) / DBLE (ISOMER+1)
                     END DO
                     GMSTOR (IZN) = GMSTOR (IZN) / DBLE (ISOMER+1)
                  END IF
*  |  |  |  |  |
*  |  |  |  |  +-------------------------------------------------------*
               END DO
*  |  |  |  |
*  |  |  |  +----------------------------------------------------------*
            END DO
*  |  |  |
*  |  |  +-------------------------------------------------------------*
            WRITE (*,*)' *** Isomer patch completed ***',NISMRS(NRN),NRN
*           WRITE (*,*)' *** K0,K1,KI0,KI1',K0,K1,KI0,KI1,' ***'
*  |  |
*  |  +----------------------------------------------------------------*
*  |  |  With the new decay channels going on isomeric states we need
*  |  |  the isomer storage allocation anyway:
         ELSE IF ( .NOT. LISMRS ) THEN
            LISMRS = .TRUE.
            IAMXMM = 2 * IZRHGH (NRN) + IMRHGH (NRN) + NMZMNM
            NISMRS (NRN) = ISMHLP (IAMXMM)
            KI0    = K1 + 1
            KI1    = K1 + NISMRS (NRN)
            KLAST  = KI1
            KMAX   = MAX ( KMAX, KI1 )
            DO KS = KI0, KI1
               GMSTOR (KS) = 0.E+00
            END DO
         END IF
*  |  |
*  |  +----------------------------------------------------------------*
*-------------- Patch to add the isomers:
 6535    CONTINUE
         DO J = K0, KI1
            GDSTOR (J) = GDSTOR (J) + DBLE (GMSTOR(J))
     &                 * ( DBLE (NCASE) + DBLE (MCASE) * 1.D+09 )
            GBSTOR (J) = GBSTOR (J) + DBLE (GMSTOR(J))**2
     &                 * ( DBLE (NCASE) + DBLE (MCASE) * 1.D+09 )
         END DO
         KMAX = MAX ( KMAX, KI1 )
         IF ( LFIEND ) GO TO 1000
 6600 CONTINUE
*  |
*  +-------------------------------------------------------------------*
 1000 CONTINUE
      IX = NRNMX
      IF ( NRNDC .EQ. 0 ) NRNDC = NRNMX
      WRITE (*,*) ' Nrnmx:', NRNMX
*  +-------------------------------------------------------------------*
*  |  First run: allocate the room for A-mass yields:
      IF ( MBATCH .EQ. 1 .OR. IFILE .EQ. 1 ) THEN
         DO IIX = 1, IX
            NRN = JX (IIX)
            KAURSN (NRN) = KLAST
            KLAST = KLAST + IMRHGH (NRN) + 2 * IZRHGH (NRN) + NMZMNM
            KZURSN (NRN) = KLAST
            KLAST = KLAST + IZRHGH (NRN)
            KMAX  = MAX ( KMAX, KLAST )
         END DO
         FILE1 = FILE
         LQOLD = LQ
      END IF
*  |
*  +-------------------------------------------------------------------*
      CLOSE (UNIT=1)
      KLAST = 0
*  +-------------------------------------------------------------------*
*  |  Loop over the scorings:
      DO 7000 IIX = 1, IX
         NRN    = JX (IIX)
         ACCUMP = ZERZER
         ACCUNS = ZERZER
*  |  +----------------------------------------------------------------*
*  |  |
         DO IG  = 1, IMRHGH (NRN) + 2 * IZRHGH (NRN) + NMZMNM
            ACCUMA (IG) = ZERZER
            ACCUMZ (IG) = ZERZER
         END DO
*  |  |
*  |  +----------------------------------------------------------------*
         AFACT = DBLE (NCASE) + DBLE (MCASE) * 1.D+09
         K0    = KLAST + 1
         K1    = IMRHGH (NRN) * IZRHGH (NRN) + K0 - 1
         KLAST = K1
*  |  +----------------------------------------------------------------*
*  |  |
         DO 6540 IM = 1, IMRHGH (NRN)
*  |  |  +-------------------------------------------------------------*
*  |  |  |
            DO 6520 IZ = 1, IZRHGH (NRN)
               IN     = IM + IZ + NMZMNM
               IA     = IN + IZ
               IZN    = IZ + IZRHGH (NRN) * ( IM - 1 ) + KBURSN (NRN)
               KK0    = IZN
               KMAX   = MAX ( KMAX, KK0 )
               DSCORE = DBLE ( GMSTOR (IZN) )
               IF ( IZN .GT. K1 ) STOP ' IZN>K1'
               IF ( IA  .LT.  1 ) GO TO 6520
               ACCUMP = ACCUMP + DSCORE
               ACCUMA (IA) = ACCUMA (IA) + DSCORE
               ACCUMZ (IZ) = ACCUMZ (IZ) + DSCORE
               IS     = 0
               KS     = 0
               IF ( DSCORE .GT. ZERZER ) THEN
                  CALL ISMRCH ( IA, IZ, IS, KS, T12ISO, BDUMMY, JDUMMY,
     &                          IDUMMY )
                  IF ( T12ISO .LT. AINFNT ) ACCUNS = ACCUNS + DSCORE
               END IF
 6520       CONTINUE
*  |  |  |
*  |  |  +-------------------------------------------------------------*
 6540    CONTINUE
*  |  |
*  |  +----------------------------------------------------------------*
         KI0   = K1 + 1
         KI1   = K1 + NISMRS (NRN)
         KLAST = KI1
*  |  +----------------------------------------------------------------*
*  |  |  Loop over possible isomers:
         DO 6550 KS = 1, NISMRS (NRN)
            IZN = KS - 1 + KI0
            IF ( IZN .GT. KI1 ) STOP ' IZN>KI1'
            IF ( GMSTOR (IZN) .GT. 0.E+00 ) THEN
               CALL ISMRCH ( IA, IZ, IS, KS, T12ISO, BDUMMY, JDUMMY,
     &                       IDUMMY )
               DSCORE = DBLE ( GMSTOR (IZN) )
               IF ( IA .LT. 1 ) GO TO 6550
               ACCUMP = ACCUMP + DSCORE
               ACCUMA (IA) = ACCUMA (IA) + DSCORE
               ACCUMZ (IZ) = ACCUMZ (IZ) + DSCORE
               IF ( T12ISO .LT. AINFNT ) ACCUNS = ACCUNS + DSCORE
            END IF
 6550    CONTINUE
*  |  |
*  |  +----------------------------------------------------------------*
         TOTTOT (NRN) = TOTTOT (NRN) + ACCUMP * AFACT
         TOTERR (NRN) = TOTERR (NRN) + ACCUMP * ACCUMP * AFACT
         TOTUNS (NRN) = TOTUNS (NRN) + ACCUNS * AFACT
         TOTUER (NRN) = TOTUER (NRN) + ACCUNS * ACCUNS * AFACT
*  |  +----------------------------------------------------------------*
*  |  |
         DO IA = 1, IMRHGH (NRN) + 2 * IZRHGH (NRN) + NMZMNM
            KK0 = KAURSN (NRN) + IA
            GDSTOR (KK0) = GDSTOR (KK0) + ACCUMA (IA) * AFACT
            GBSTOR (KK0) = GBSTOR (KK0) + ACCUMA (IA) * ACCUMA (IA)
     &                   * AFACT
            KMAX = MAX ( KMAX, KK0 )
         END DO
*  |  |
*  |  +----------------------------------------------------------------*
*  |  +----------------------------------------------------------------*
*  |  |
         DO IZ = 1, IZRHGH (NRN)
            KK0 = KZURSN (NRN) + IZ
            GDSTOR (KK0) = GDSTOR (KK0) + ACCUMZ (IZ) * AFACT
            GBSTOR (KK0) = GBSTOR (KK0) + ACCUMZ (IZ) * ACCUMZ (IZ)
     &                   * AFACT
            KMAX = MAX ( KMAX, KK0 )
         END DO
*  |  |
*  |  +----------------------------------------------------------------*
         KMAX = MAX ( KMAX, KK0 )
 7000 CONTINUE
*  |
*  +-------------------------------------------------------------------*
**sr bug patch
      DO J = K0, KI1
         GMSTOR(J) = 0.0E+00
      END DO
**
      GO TO 1111
 2000 CONTINUE
*  +-------------------------------------------------------------------*
*  |
      DO J = 1, KMAX
         GDSTOR (J) = GDSTOR (J)
     &              / ( DBLE (NCTOT) + DBLE (MCTOT) * 1.D+09 )
         GBSTOR (J) = GBSTOR (J)
     &              / ( DBLE (NCTOT) + DBLE (MCTOT) * 1.D+09 )
      END DO
*  |
*  +-------------------------------------------------------------------*
*  +-------------------------------------------------------------------*
*  |
      DO IIX = 1, IX
         NRN = JX (IIX)
         TOTTOT (NRN) = TOTTOT (NRN)
     &                / ( DBLE (NCTOT) + DBLE (MCTOT) * 1.D+09 )
         TOTERR (NRN) = TOTERR (NRN)
     &                / ( DBLE (NCTOT) + DBLE (MCTOT) * 1.D+09 )
         TOTUNS (NRN) = TOTUNS (NRN)
     &                / ( DBLE (NCTOT) + DBLE (MCTOT) * 1.D+09 )
         TOTUER (NRN) = TOTUER (NRN)
     &                / ( DBLE (NCTOT) + DBLE (MCTOT) * 1.D+09 )
      END DO
*  |
*  +-------------------------------------------------------------------*
*  +-------------------------------------------------------------------*
*  |  Real sum of Mbatch runs:
      IF ( MBATCH - 1 .GT. 0 .AND. ( .NOT. LSTATI .OR. IFILE .GT. 1 )
     &    ) THEN
         DO J = 1, KMAX
            GBSTOR (J) = SQRT ( GBSTOR (J) )
            GBSTOR (J) = ( GBSTOR (J) - GDSTOR (J) )
     &                 * ( GBSTOR (J) + GDSTOR (J) )
     &                 / DBLE (MBATCH-1)
            IF ( ABS ( GBSTOR (J) ) .LT. 1.D-12 * GDSTOR (J)**2 )
     &         GBSTOR (J) = ZERZER
            IF ( GDSTOR (J) .GT. ZERZER ) THEN
               GBSTOR (J) = MIN ( SQRT ( GBSTOR (J) ) / GDSTOR (J),
     &                            0.99D+00 )
            END IF
         END DO
         DO IIX = 1, IX
            NRN = JX (IIX)
            TOTERR (NRN) = SQRT (TOTERR(NRN))
            TOTERR (NRN) = ( TOTERR (NRN) - TOTTOT (NRN) )
     &                   * ( TOTERR (NRN) + TOTTOT (NRN) )
     &                   / DBLE (MBATCH-1)
            IF ( ABS ( TOTERR (NRN) ) .LT. 1.D-12 * TOTTOT (NRN)**2 )
     &              TOTERR (NRN) = ZERZER
            IF ( TOTTOT (NRN) .GT. ZERZER ) THEN
               TOTERR (NRN) = MIN ( SQRT ( TOTERR(NRN) ) / TOTTOT (NRN),
     &                              0.99D+00)
            END IF
            TOTUER (NRN) = SQRT (TOTUER(NRN))
            TOTUER (NRN) = ( TOTUER (NRN) - TOTUNS (NRN) )
     &                   * ( TOTUER (NRN) + TOTUNS (NRN) )
     &                   / DBLE (MBATCH-1)
            IF ( ABS ( TOTUER (NRN) ) .LT. 1.D-12 * TOTUNS (NRN)**2 )
     &              TOTUER (NRN) = ZERZER
            IF ( TOTUNS (NRN) .GT. ZERZER ) THEN
               TOTUER (NRN) = MIN ( SQRT ( TOTUER(NRN) ) / TOTUNS (NRN),
     &                              0.99D+00)
            END IF
         END DO
         LSTATI = .FALSE.
*  |
*  +-------------------------------------------------------------------*
*  |  Only one run, check if it is already a sum with statistics:
      ELSE IF ( LSTATI ) THEN
         OPEN ( UNIT=11, FILE=FILE1, STATUS='OLD', FORM='UNFORMATTED' )
         READ (11)
         IF ( LEVOLN ) READ (11)
         KLAST = 0
         DO JJX = 1, IX / NRNDC
            DO JIX = 1, NRNDC
               READ (11)
               IF ( LEVOLN ) READ (11)
               READ (11)
               IF ( LISMRS .AND. .NOT. LPATCH ) THEN
                  READ (11)
                  READ (11)
               END IF
            END DO
            READ (11) CHSTAT,IJX
            IF ( CHSTAT .NE. 'STATISTICS' .OR. IJX .NE. NRNDC )
     &         STOP 'STATI'
            DO 7400 JIX = 1, NRNDC
               IIX = (JJX-1)*NRNDC + JIX
               NRN = JX (IIX)
               READ (11) TOTA, TOTB
               IF ( ABS (TOTA-TOTTOT(NRN)) .GT. 1.D-05*TOTA )
     &            WRITE (*,*)' *** Error Tota:',TOTA,TOTTOT(NRN)
               TOTERR (NRN) = TOTB
*  |  |  |  Anyway wrong:
               TOTUER (NRN) = TOTB * SQRT ( TOTTOT (NRN)
     &                                    / MAX ( AZRZRZ, TOTUNS (NRN)))
               KK0 = 1
               KK1 = IMRHGH (NRN) + 2 * IZRHGH (NRN) + NMZMNM
               READ (11) ( RCCUMA (J), J = KK0, KK1 )
               IF ( .NOT. LEVOLN ) THEN
                  DO 7100 J = KK0, KK1
                     IF ( ABS (RCCUMA(J)-GDSTOR(J+KAURSN(NRN))) .GT.
     &                    1.D-05*RCCUMA(J) )
     &               WRITE (*,*)' *** Error Gdstor:',RCCUMA(J),
     &                            GDSTOR(J+KAURSN(NRN))
 7100             CONTINUE
               END IF
               READ (11) ( RCCUMA (J), J = KK0, KK1 )
               DO 7150 J = KK0, KK1
                  GBSTOR (J+KAURSN(NRN)) = RCCUMA (J)
 7150          CONTINUE
               KK0 = 1
               KK1 = IZRHGH (NRN)
               READ (11) ( RCCUMZ (J), J = KK0, KK1 )
               IF ( .NOT. LEVOLN ) THEN
                  DO 7200 J = KK0, KK1
                     IF ( ABS (RCCUMZ(J)-GDSTOR(J+KZURSN(NRN))) .GT.
     &                    1.D-05*RCCUMZ(J) )
     &               WRITE (*,*)' *** Error Gdstor:',RCCUMZ(J),
     &                            GDSTOR(J+KZURSN(NRN))
 7200             CONTINUE
               END IF
               READ (11) ( RCCUMZ (J), J = KK0, KK1 )
               DO 7250 J = KK0, KK1
                  GBSTOR (J+KZURSN(NRN)) = RCCUMZ (J)
 7250          CONTINUE
               K0    = KLAST + 1
               K1    = IMRHGH (NRN) * IZRHGH (NRN) + K0 - 1
               KLAST = K1
               READ (11) ( GMSTOR(J), J = K0, K1 )
               DO 7300 J = K0, K1
                  GBSTOR (J) = DBLE (GMSTOR(J))
 7300          CONTINUE
               IF ( LISMRS .AND. .NOT. LPATCH ) THEN
                  KI0   = KLAST + 1
                  KI1   = KLAST + NISMRS (NRN)
                  KLAST = KI1
                  IF ( NISMRS (NRN) .GT. 0 ) THEN
                     READ (11) ( GMSTOR(J), J = KI0, KI1 )
                  ELSE
                     READ (11)
                  END IF
                  DO 7350 J = KI0, KI1
                     GBSTOR (J) = DBLE (GMSTOR(J))
 7350             CONTINUE
               ELSE IF ( LISMRS ) THEN
                  KI0   = KLAST + 1
                  KI1   = KLAST + NISMRS (NRN)
                  KLAST = KI1
                  DO KS = 1, NISMRS (NRN)
                     J = KI0 + KS - 1
                     CALL ISMRCH ( IA, IZ, IS, KS, ADUMMY, BDUMMY,
     &                             JDUMMY, IDUMMY )
                     IM = IA - 2 * IZ - NMZMNM
                     IF ( IA .GE. 1 ) THEN
                        IZN = K0 - 1 + ( IM - 1 ) * IZRHGH (NRN) + IZ
                        GBSTOR (J) = DBLE (GBSTOR(IZN))
                     END IF
                  END DO
               END IF
 7400       CONTINUE
         END DO
         KLAST = 0
         CLOSE ( UNIT=11 )
*  |
*  +-------------------------------------------------------------------*
*  |  Only one plain run, no possibility of making statistics:
      ELSE
         LSTATI = .FALSE.
         DO J =1, KMAX
            IF ( GDSTOR (J) .GT. ZERZER ) THEN
               GBSTOR (J) = 0.99D+00
            END IF
         END DO
         DO IIX = 1, IX
            NRN = JX (IIX)
            IF ( TOTTOT (NRN) .GT. ZERZER ) THEN
               TOTERR (NRN) = 0.99D+00
            END IF
            IF ( TOTUNS (NRN) .GT. ZERZER ) THEN
               TOTUER (NRN) = 0.99D+00
            END IF
         END DO
      END IF
*  |
*  +-------------------------------------------------------------------*
*  +-------------------------------------------------------------------*
*  |  If 1 run already with statistics, no need to create a new output
      IF ( .NOT. LSTATI .OR. IFILE .GT. 1 ) THEN
         IF ( LEVOLN ) THEN
            RUNTIM='   ***** Time Evolution *****'
         ELSE
            RUNTIM='      ***** Sum file *****'
         END IF
         WRITE(*,*)' Type the output file name:'
         READ (*,'(A)') FILE
         LQ = LNNBLN (FILE)
* Start_VAX_seq
*        OPEN (UNIT=1,FILE=FILE,STATUS='NEW',FORM='UNFORMATTED')
* End_VAX_seq
* Start_UNIX_seq
         LQS = LLOCCR(FILE,'/') + 1
*  |  +----------------------------------------------------------------*
*  |  |  Be sure to add the default suffix if no one is specified:
         IF ( LQ .GE. LQS ) THEN
            LQD = INDEX (FILE(LQS:LQ),'.')
            IF ( LQD .EQ. LQ-LQS+1 ) THEN
               LQD = 0
               LQ  = LQ - 1
            END IF
            IF ( LQD .LE. 0 ) THEN
               FILE = FILE(1:LQ)//'.rnc'
               LQ   = LQ+4
            END IF
         END IF
*  |  |
*  |  +----------------------------------------------------------------*
         OPEN (UNIT=1,FILE=FILE,STATUS='UNKNOWN',FORM='UNFORMATTED')
* End_UNIX_seq
         IF ( LEVOLN ) THEN
            WRITE (1) RUNTIT, RUNTIM, SNGL (WCTOT),-NCTOT,-MCTOT,
     &                MBATCH, LISFVR, LMSFVR
            WRITE (1) NIRRDT, ( SNGL (BIRRDT(IR)), SNGL (TIRRDT(IR)),
     &                          IR = 1, NIRRDT )
         ELSE
            WRITE (1) RUNTIT, RUNTIM, SNGL (WCTOT), NCTOT, MCTOT,
     &                MBATCH, LISFVR, LMSFVR
         END IF
*  |
*  +-------------------------------------------------------------------*
*  |
      ELSE
         FILE = FILE1
         LQ   = LQOLD
      END IF
*  |
*  +-------------------------------------------------------------------*
      KLAST  = 0
*  +-------------------------------------------------------------------*
*  |  Loop over scorings:
      DO 6800 JJ=1,IX
         NRN   = JX(JJ)
         IF ( .NOT. LSTATI .OR. IFILE .GT. 1 )
     &   WRITE (1)    NRN, TIURSN (NRN), ITURSN (NRN), NRURSN (NRN),
     &          SNGL (VURSNC (NRN)), IMRHGH(NRN), IZRHGH(NRN), NMZMNM
         IF ( LEVOLN .AND. .NOT. LSTATI ) WRITE (1) TDECAY (NRN)
         K0    = KLAST  + 1
         K1    = IMRHGH (NRN) * IZRHGH (NRN) + K0 - 1
         KLAST = K1
         IF ( .NOT. LSTATI .OR. IFILE .GT. 1 )
     &   WRITE (1) (SNGL(GDSTOR(J)), J = K0, K1)
         IF ( ( .NOT. LSTATI .OR. IFILE .GT. 1 ) .AND. LISMRS ) THEN
            WRITE (1) 'ISOMERS:  ', NISMRS (NRN)
            KI0   = KLAST + 1
            KI1   = KLAST + NISMRS (NRN)
            KLAST = KI1
            IF ( KI1 .GE. KI0 ) THEN
               WRITE (1) (SNGL(GDSTOR(J)), J = KI0, KI1)
            ELSE
               WRITE (1)
            END IF
         END IF
 6800 CONTINUE
*  |
*  +-------------------------------------------------------------------*
*  Now write the statistical data, first a record to flag them
      IF ( .NOT. LSTATI .OR. IFILE .GT. 1 ) WRITE (1) 'STATISTICS',IX
*  Then the errors concerning the binning data
      KLAST  = 0
      INDX   = INDLST ( FILE, '.' )
      IF ( INDX .GT. 0 ) THEN
* Start_VAX_seq
*        OPEN (UNIT=3,FILE=FILE(1:INDX-1)//'_SUM.LIS',STATUS='NEW',
*    &         CARRIAGECONTROL='LIST')
* End_VAX_seq
* Start_UNIX_seq
         OPEN (UNIT=3,FILE=FILE(1:INDX-1)//'_sum.lis',STATUS='UNKNOWN')
* End_UNIX_seq
      ELSE
* Start_VAX_seq
*        OPEN (UNIT=3,FILE=FILE(1:LQ)//'_SUM.LIS',STATUS='NEW',
*    &         CARRIAGECONTROL='LIST')
* End_VAX_seq
* Start_UNIX_seq
         OPEN (UNIT=3,FILE=FILE(1:LQ)//'_sum.lis',STATUS='UNKNOWN')
* End_UNIX_seq
      END IF
      WRITE (3,*)' **** ',FILE(1:LQ),' ****'
      WRITE (3,*)
      WRITE (3,*)
      WRITE (CHCTOT,'(F15.0)') DBLE (NCTOT) + DBLE (MCTOT) * 1.D+09
      WRITE (3,'(A,2X,A14)')'  Total primaries run:',CHCTOT
      WRITE (3,*)
      WRITE (3,*)'   Total weight of the primaries run:',SNGL(WCTOT)
      WRITE (3,*)
D     IF ( INDX .GT. 0 ) THEN
D        OPEN (UNIT=98,FILE=FILE(1:INDX-1)//'_yield.txt',
D    &         STATUS='UNKNOWN')
D     ELSE
D        OPEN (UNIT=98,FILE=FILE(1:LQ)//'_yield.txt',
D    &         STATUS='UNKNOWN')
D     END IF
D     WRITE (98,'(I5)') IX
*  +-------------------------------------------------------------------*
*  |  Loop over scorings:
      DO 6850 JJ = 1, IX
         NRN = JX(JJ)
         IF ( .NOT. LSTATI .OR. IFILE .GT. 1 )
     &   WRITE (1) SNGL(TOTTOT(NRN)),SNGL(TOTERR(NRN))
D        WRITE(98,'(I5,1X,A10,1P,2G16.7)')
D    &         NRN,TIURSN(NRN),TOTTOT(NRN),TOTERR(NRN)
D        WRITE(98,'(I5,1X,A10,1P,2G16.7)')
D    &         NRN,TIURSN(NRN),TOTUNS(NRN),TOTUER(NRN)
         IF ( LEVOLN ) THEN
            WRITE (3,*)
            WRITE (3,*) ' Beam intensity  :',BEAINT,' pr/s'
            WRITE (3,*)
            WRITE (3,*) ' Irradiation time:',TIMEIR,' s'
            WRITE (3,*)
            WRITE (3,*) ' Decay time      :',TDECAY(NRN),' s'
         END IF
         WRITE (3,*)
         WRITE (3,*) ' Detector n: ', NRN,'  ',TIURSN (NRN)
         WRITE (3,*) '    (Region',NRURSN(NRN),' Volume:  ',
     &                     SNGL(VURSNC(NRN)),' cmc,'
         WRITE (3,*) '     distr. type  :',ITURSN(NRN),'   ,'
         WRITE (3,*) '     Z_max:',IZRHGH(NRN),', N-Z_max:',
     &                     IMRHGH(NRN)+NMZMNM,', N-Z_min:',NMZMNM+1,
     &               ')'
         WRITE (3,*)
         WRITE (3,*)'    Tot. response (n/cmc/pr)', SNGL(TOTTOT(NRN)),
     &              '  +/-',SNGL(TOTERR(NRN))*100.0,' %'
         WRITE (3,*)'    ( --> Nuclei/pr         ',
     &                      SNGL(TOTTOT(NRN)*VURSNC(NRN)),
     &              '  +/-',SNGL(TOTERR(NRN))*100.0,' % )'
         WRITE (3,*)
         WRITE (3,*)'    out of which the unstable ones are:'
         WRITE (3,*)
         WRITE (3,*)'    Tot. unstable (n/cmc/pr)', SNGL(TOTUNS(NRN)),
     &              '  +/-',SNGL(TOTUER(NRN))*100.0,' %'
         WRITE (3,*)'    ( --> Nuclei/pr         ',
     &                      SNGL(TOTUNS(NRN)*VURSNC(NRN)),
     &              '  +/-',SNGL(TOTUER(NRN))*100.0,' % )'
         WRITE (3,*)
         WRITE (3,*)
         WRITE (3,*)
     &         ' **** Isotope Yield as a function of Mass Number ****',
     &         ' ****            (nuclei / cmc / pr)             ****'
         WRITE (3,*)
         WRITE (3,*)
         WRITE (3,*) ' A_min:',1,' -  A_max:', IMRHGH(NRN)+2*IZRHGH(NRN)
     &                                       + NMZMNM
         WRITE (3,*)
         KK0 = KAURSN (NRN) + 1
         KK1 = KAURSN (NRN) + IMRHGH (NRN) + 2 * IZRHGH (NRN) + NMZMNM
         DO J = KK1, KK0, -1
            IA = J - KK0 + 1
            IF ( GDSTOR(J) .GT. AZRZRZ .AND. IA .GE. 1 )
     &      WRITE (3,8310) IA, GDSTOR(J), GBSTOR(J)*100.D+00
         END DO
 8310    FORMAT (1X,' A: ',I12,1X,1P,E14.7,' +/- ',1X,E14.7,' %')
         IF ( .NOT. LSTATI .OR. IFILE .GT. 1 ) THEN
            WRITE (1) ( SNGL (GDSTOR(J)), J = KK0, KK1 )
            WRITE (1) ( SNGL (GBSTOR(J)), J = KK0, KK1 )
         END IF
         WRITE (3,*)
         WRITE (3,*)
     &       ' **** Isotope Yield as a function of Atomic Number ****',
     &       ' ****             (nuclei / cmc / pr)              ****'
         WRITE (3,*)
         WRITE (3,*)
         WRITE (3,*) ' Z_min:',1,' -  Z_max:',IZRHGH(NRN)
         WRITE (3,*)
         KK0 = KZURSN (NRN) + 1
         KK1 = KZURSN (NRN) + IZRHGH (NRN)
         DO J = KK1, KK0, -1
            IZ = J - KK0 + 1
            IF ( GDSTOR(J) .GT. AZRZRZ )
     &         WRITE (3,8320) IZ, GDSTOR(J), GBSTOR(J)*100.D+00
         END DO
 8320    FORMAT (1X,' Z: ',I12,1X,1P,E14.7,' +/- ',1X,E14.7,' %')
         IF ( .NOT. LSTATI .OR. IFILE .GT. 1 ) THEN
            WRITE (1) ( SNGL (GDSTOR(J)), J = KK0, KK1 )
            WRITE (1) ( SNGL (GBSTOR(J)), J = KK0, KK1 )
         END IF
         K0    = KLAST + 1
         K1    = IMRHGH (NRN) * IZRHGH (NRN) + K0 - 1
         KLAST = K1
         IF ( .NOT. LSTATI .OR. IFILE .GT. 1 )
     &   WRITE (1) (SNGL(GBSTOR(J)), J = K0, K1)
         WRITE (3,*)
         WRITE (3,*)
         WRITE (3,*)' Residual nuclei distribution:'
         WRITE (3,*)
     &         ' **** Residual nuclei distribution  ****',
     &         ' ****    (nuclei / cmc / pr)        ****'
         WRITE (3,*)
         WRITE (3,*)
         DO IA = 1, MXARSN
            DO IZ = 1, 100
               RESNUC (IZ,IA) = ZERZER
               RESERR (IZ,IA) = ZERZER
               IABEG  (IZ) = 500
               IAEND  (IZ) = 0
            END DO
         END DO
         DO IM = 1, IMRHGH (NRN)
            DO IZ  = 1, IZRHGH (NRN)
               IN  = IM + IZ + NMZMNM
               IA  = IN + IZ
               IF ( IA .GE. 1 ) THEN
                  IZN = K0 - 1 + ( IM - 1 ) * IZRHGH (NRN) + IZ
                  RESNUC (IZ,IA) = GDSTOR (IZN)
                  IF ( ABS (GDSTOR (IZN)) .GT. 0.E+00 ) THEN
                     IABEG (IZ) = MIN ( IABEG (IZ), IA )
                     IAEND (IZ) = MAX ( IAEND (IZ), IA )
                     RESERR (IZ,IA) = GBSTOR (IZN) * 100.D+00
                  END IF
               END IF
            END DO
         END DO
         IASTRT = IMRHGH (NRN) + 2 * IZRHGH (NRN) + NMZMNM
         IZ0    = IZRHGH (NRN) + 1
 9220    CONTINUE
         IZ1 = IZ0 - 1
         IZ0 = MAX ( 1, IZ1 - 10 )
*        IAS1= IASTLN (MIN(MAX(IZ1,1),100))
*        IAS0= IASTLN (MIN(MAX(IZ0,1),100))
*        IA1 = MIN ( IASTRT, IAS1 + MAX ( MIN (IZ1/5,10),  5 ) )
*        IA0 = MAX ( IZ0   , IAS0 - MAX ( MIN (IZ1/3,20), 10 ) )
*        IA1 = MIN ( IA1, IMRHGH (NRN) + 2 * IZ1 + NMZMNM )
*        IA0 = MAX ( IA0, 1 + 2 * IZ0 + NMZMNM )
*        IA0 = MAX ( IA0, 1 )
         IA1 = 0
         IA0 = 500
         DO IZ = IZ0, IZ1
            IA1 = MAX ( IA1, IAEND (IZ) )
            IA0 = MIN ( IA0, IABEG (IZ) )
         END DO
         WRITE (3,9240) ( IZ, IZ = IZ0, IZ1 )
         DO 9230 IA = IA1, IA0, - 1
            LCHECK = .FALSE.
            DO IZ = IZ0, IZ1
               LCHECK = LCHECK .OR. RESNUC (IZ,IA) .GE. AZRZRZ
            END DO
            IF ( LCHECK ) THEN
            WRITE (3,9250) IA, ( RESNUC (IZ,IA), IZ = IZ0, IZ1 )
            WRITE (3,9260)     ( CHERR, RESERR (IZ,IA), IZ = IZ0, IZ1 )
            END IF
 9230    CONTINUE
         IF ( IZ0 .GT. 1 ) GO TO 9220
         WRITE (3,*)
         IF ( LISMRS ) THEN
            KI0   = KLAST + 1
            KI1   = KLAST + NISMRS (NRN)
            KLAST = KI1
            IF ( .NOT. LSTATI .OR. IFILE .GT. 1 ) THEN
               IF ( NISMRS (NRN) .GT. 0 ) THEN
                  WRITE (1) (SNGL(GBSTOR(J)),J=KI0,KI1)
               ELSE
                  WRITE (1)
               END IF
            END IF
            IF ( NISMRS (NRN) .GT. 0 ) THEN
               WRITE (3,*) ' **** Isomers (nuclei / cmc / pr)     ****'
               WRITE (3,*) '     A        Z       mth'
            END IF
            DO KS = 1, NISMRS (NRN)
               IZN = KI0 + KS - 1
               IF ( GDSTOR(IZN) .GT. AZRZRZ ) THEN
                  CALL ISMRCH ( IA, IZ, IS, KS, ADUMMY, BDUMMY, JDUMMY,
     &                          IDUMMY )
                  WRITE (3,9270) IA, IZ, IS, SNGL(GDSTOR(IZN)),
     &                               SNGL(GBSTOR(IZN)*100.D+0)
               END IF
            END DO
            WRITE (3,*)
         END IF
 6850 CONTINUE
*  |
*  +-------------------------------------------------------------------*
      IF ( .NOT. LSTATI .OR. IFILE .GT. 1 ) CLOSE ( UNIT = 1 )
      CLOSE ( UNIT = 3 )
D     CLOSE ( UNIT =98 )
***** here start irradiation build up
      TIRRDT (0) = ZERZER
      CIRRDT (0) = ZERZER
      IF ( FACMUL .LT. ZERZER ) THEN
         NIRRDT = 0
         TIMEIR = ZERZER
         DO IRR = 1, MXIRRD
            WRITE (*,*)' New irradiation interval (s) (end if < 0):'
            READ  (*,*)  TIMEIN
            IF ( TIMEIN .LE. ZERZER ) GO TO 6870
            NIRRDT = NIRRDT + 1
            TIMEIR = TIMEIR + TIMEIN
            TIRRDT (NIRRDT) = TIMEIN + TIRRDT (NIRRDT-1)
            WRITE (*,*)' Beam intensity (p/s):'
            READ  (*,*)  BEAMIN
            BIRRDT (NIRRDT) = MAX ( BEAMIN, ZERZER )
            CIRRDT (NIRRDT) = CIRRDT (NIRRDT-1) + BIRRDT (NIRRDT)
     &                    * ( TIRRDT (NIRRDT)   - TIRRDT (NIRRDT-1) )
         END DO
 6870    CONTINUE
         FACMUL = CIRRDT (NIRRDT) / TIMEIR
      ELSE
         WRITE (*,*)' Irradiation time (s):'
         READ  (*,*)  TIMEIR
         NIRRDT = 1
         TIRRDT (NIRRDT) = TIMEIR
         BIRRDT (NIRRDT) = FACMUL
         CIRRDT (NIRRDT) = BIRRDT (NIRRDT) * TIRRDT (NIRRDT)
      END IF
      NTRDCY = 1
      TIMEDC = ZERZER
      TIRDCY (NTRDCY) = TIMEDC
      LEVOLN = .TRUE.
      BEAINT = FACMUL
      RUNTIM ='   ***** Time Evolution *****'
      WRITE(*,*)' Type the evolution output file name:'
      READ (*,'(A)') FILE
      LQ     = LNNBLN (FILE)
* Start_VAX_seq
*     OPEN (UNIT=1,FILE=FILE,STATUS='NEW',FORM='UNFORMATTED')
* End_VAX_seq
* Start_UNIX_seq
      LQS = LLOCCR(FILE,'/') + 1
*  +-------------------------------------------------------------------*
*  |  Be sure to add the default suffix if no one is specified:
      IF ( LQ .GE. LQS ) THEN
         LQD = INDEX (FILE(LQS:LQ),'.')
         IF ( LQD .EQ. LQ-LQS+1 ) THEN
            LQD = 0
            LQ  = LQ - 1
         END IF
         IF ( LQD .LE. 0 ) THEN
            FILE = FILE(1:LQ)//'.rnc'
            LQ   = LQ+4
         END IF
      END IF
*  |
*  +-------------------------------------------------------------------*
      OPEN (UNIT=1,FILE=FILE,STATUS='UNKNOWN',FORM='UNFORMATTED')
* End_UNIX_seq
      WRITE (1) RUNTIT, RUNTIM, SNGL(WCTOT), -NCTOT, -MCTOT, MBATCH
      WRITE (1) NIRRDT, ( SNGL (BIRRDT(IR)), SNGL (TIRRDT(IR)),
     &                    IR = 1, NIRRDT )
      INDX   = INDEX ( FILE,'.')
      IF ( INDX .GT. 0 ) THEN
* Start_VAX_seq
*        OPEN (UNIT=3,FILE=FILE(1:INDX-1)//'_SUM.LIS',STATUS='NEW',
*    &         CARRIAGECONTROL='LIST')
*        OPEN (UNIT=66,FILE=FILE(1:INDX-1)//'_RES.LIS',STATUS='NEW',
*    &         CARRIAGECONTROL='LIST')
*        OPEN (UNIT=67,FILE=FILE(1:INDX-1)//'_TOT.LIS',STATUS='NEW',
*    &         CARRIAGECONTROL='LIST')
* End_VAX_seq
* Start_UNIX_seq
         OPEN (UNIT= 3,FILE=FILE(1:INDX-1)//'_sum.lis',STATUS='UNKNOWN')
         OPEN (UNIT=66,FILE=FILE(1:INDX-1)//'_res.lis',STATUS='UNKNOWN')
         OPEN (UNIT=67,FILE=FILE(1:INDX-1)//'_tot.lis',STATUS='UNKNOWN')
* End_UNIX_seq
      ELSE
* Start_VAX_seq
*        OPEN (UNIT=3,FILE=FILE(1:LQ)//'_SUM.LIS',STATUS='NEW',
*    &         CARRIAGECONTROL='LIST')
*        OPEN (UNIT=66,FILE=FILE(1:LQ)//'_RES.LIS',STATUS='NEW',
*    &         CARRIAGECONTROL='LIST')
*        OPEN (UNIT=67,FILE=FILE(1:LQ)//'_TOT.LIS',STATUS='NEW',
*    &         CARRIAGECONTROL='LIST')
* End_VAX_seq
* Start_UNIX_seq
         OPEN (UNIT= 3,FILE=FILE(1:LQ)//'_sum.lis',STATUS='UNKNOWN')
         OPEN (UNIT=66,FILE=FILE(1:LQ)//'_res.lis',STATUS='UNKNOWN')
         OPEN (UNIT=67,FILE=FILE(1:LQ)//'_tot.lis',STATUS='UNKNOWN')
* End_UNIX_seq
      END IF
      WRITE (3,*)' **** ',FILE(1:LQ),' ****'
      WRITE (3,*)
      WRITE (3,*)
      WRITE (CHCTOT,'(F15.0)') DBLE (NCTOT) + DBLE (MCTOT) * 1.D+09
      WRITE (3,'(A,2X,A14)')'  Total primaries run:',CHCTOT
      WRITE (3,*)
      WRITE (3,*)'   Total weight of the primaries run:',SNGL(WCTOT)
      WRITE (3,*)
      WRITE (3,9500) NIRRDT,
     &      ( IR, TIRRDT (IR), BIRRDT (IR), IR = 1, NIRRDT )
**************
      WRITE (66,*)' **** ',FILE(1:LQ),' ****'
      WRITE (66,*)
      WRITE (66,*)
      WRITE (CHCTOT,'(F15.0)') DBLE (NCTOT) + DBLE (MCTOT) * 1.D+09
      WRITE (66,'(A,2X,A14)')'  Total primaries run:',CHCTOT
      WRITE (66,*)
      WRITE (66,*)'   Total weight of the primaries run:',SNGL(WCTOT)
      WRITE (66,*)
      WRITE (66,9500) NIRRDT,
     &      ( IR, TIRRDT (IR), BIRRDT (IR), IR = 1, NIRRDT )
**************
**************
      WRITE (67,*)' **** ',FILE(1:LQ),' ****'
      WRITE (67,*) NRNMX
**************
***** HERE ASK FOR DECAY TIMES
D     IF ( INDX .GT. 0 ) THEN
D        OPEN (UNIT=98,FILE=FILE(1:INDX-1)//'_evo.txt',
D    &         STATUS='UNKNOWN')
D     ELSE
D        OPEN (UNIT=98,FILE=FILE(1:LQ)//'_evo.txt',
D    &         STATUS='UNKNOWN')
D     END IF
D     WRITE (98,'(I5)') IX
 9999 CONTINUE
      WRITE (*,*)' Decay time (s):'
      READ  (*,*) TIMEDC
      IF ( TIMEDC .GT. ZERZER ) THEN
         NTRDCY = NTRDCY + 1
         TIRDCY (NTRDCY) = TIMEDC
         GO TO 9999
      END IF
D     WRITE (98,'(I5)') NTRDCY
      NXIDAU = MXACTV / MAX ( NIRRDT, 1 ) / MAX ( NTRDCY, 1 )
      NXIDAU = MIN ( NXIDAU, MXIDAU )
      MXCRIR = MAX ( NIRRDT, 1 )
      MXCRDT = MAX ( NTRDCY, 1 )
      MXCRDA = NXIDAU
      KDIM   = KMAX
      KKMAX  = KMAX * NTRDCY
*  +-------------------------------------------------------------------*
*  |  Set up the starting condition at T_ir (only for radioactive
*  |  nuclei):
      DO J = 1, KKMAX
         GESTOR (J) = GDSTOR (J)
         GCSTOR (J) = GBSTOR (J)
         GDSTOR (J) = ZERZER
         GBSTOR (J) = ZERZER
      END DO
*  |
*  +-------------------------------------------------------------------*
      KLAST  = 0
*  +-------------------------------------------------------------------*
*  |  Loop on the residual nuclei sets:
      DO 8300 JJ = 1, IX
         NRN   = JX(JJ)
         K0    = KLAST  + 1
         K1    = IMRHGH (NRN) * IZRHGH (NRN) + K0 - 1
         KI0   = K1 + 1
         KLAST = K1
*  |  +----------------------------------------------------------------*
*  |  |  Loop on N-Z-NMZmin:
         DO 8888 IM = 1, IMRHGH (NRN)
*  |  |  +-------------------------------------------------------------*
*  |  |  |  Loop on Z:
            DO 8000 IZ  = 1, IZRHGH (NRN)
               IN  = IM + IZ + NMZMNM
               IA  = IN + IZ
*              LPRINT = IA .EQ. 207 .AND. IZ .EQ. 82
*  |  |  |  +----------------------------------------------------------*
*  |  |  |  |  Possible isotope:
               IF ( IA .GE. 1 .AND. IZ .LE. IA ) THEN
                  IZN    = K0 - 1 + ( IM - 1 ) * IZRHGH (NRN) + IZ
                  IF ( GESTOR (IZN) .LE. AZRZRZ ) GO TO 8000
                  ISOMER = 0
                  T12CUR = TIM1O2 ( IA, IZ, KKA, KKZ, T12DDA, BRDDAU,
     &                              IDCDAU, ISOMER )
*                 IF ( T12CUR .LT. T12ZER ) GO TO 8000
                  CALL FLLACT ( IA, IZ, ISOMER, NDAUGH, IAD, IZD,
     &                          ISD, ACTIV, BRCTOT, MXCRIR, MXCRDT,
     &                          MXCRDA, MXIDAU )
                  IF ( MXCRIR .NE. NIRRDT .OR. MXCRDT .NE. NTRDCY .OR.
     &                 MXCRDA .NE. NXIDAU )
     &               CALL FLABRT ( 'USRSUWEV', 'MXCRIR,MXCRDT,MXCRDA' )
                  WEIISO = ONEONE
*  |  |  |  |  +-------------------------------------------------------*
*  |  |  |  |  |  Not stable:
                  IF ( NDAUGH .GT. 0 ) THEN
                     ORI  = GESTOR (IZN)
                     EORI = GCSTOR (IZN)
*  |  |  |  |  |  +----------------------------------------------------*
*  |  |  |  |  |  |  Loop on daughters
                     DO 8050 IDAUGH = 1, NDAUGH
                        KZ  = IZD (IDAUGH)
                        KA  = IAD (IDAUGH)
                        ISM = ISD (IDAUGH)
*  |  |  |  |  |  |  Possible if of negligible weight:
                        IF ( KA .LE. 0 ) GO TO 8050
                        KN  = KA - KZ
*                       LPRINT = LPRINT .OR. KA .EQ.207 .AND. KZ .EQ. 82
*  |  |  |  |  |  |  +-------------------------------------------------*
*  |  |  |  |  |  |  |  Normal (ground state) isotope:
                        IF ( ISM .LE. 0 ) THEN
                           KM = KA - 2 * KZ - NMZMNM
                           IF ( KM .LE. 0 .OR. KM .GT. IMRHGH (NRN) )
     &                          GO TO 8050
                           IF ( KZ .LE. 0 .OR. KZ .GT. IZRHGH (NRN) )
     &                          GO TO 8050
                           KZN = K0 - 1 + ( KM - 1 ) * IZRHGH (NRN) + KZ
*  |  |  |  |  |  |  |
*  |  |  |  |  |  |  +-------------------------------------------------*
*  |  |  |  |  |  |  |  Isomer:
                        ELSE
                           KSM = 0
                           CALL ISMRCH ( KA, KZ, ISM, KSM, ADUMMY,
     &                                   BDUMMY, JDUMMY, IDUMMY )
                           IF ( KSM .GT. NISMRS (NRN) ) GO TO 8050
                           KZN = KI0 - 1 + KSM
*                          goto 8050
                        END IF
*  |  |  |  |  |  |  |
*  |  |  |  |  |  |  +-------------------------------------------------*
*  |  |  |  |  |  |  +-------------------------------------------------*
*  |  |  |  |  |  |  |
                        DO 8701 ITD = 1, NTRDCY
                           KIND   = KZN + (ITD-1) * KDIM
                           IF ( KIND .GT. KKMAX )
     &                     CALL FLABRT ( 'USRSUW', 'KIND>KKMAX')
                           IF ( KIND .GT. ITD*KDIM )
     &                     CALL FLABRT ( 'USRSUW', 'KIND>ITD*KDIM')
                           IF ( KIND .LE. (ITD-1)*KDIM )
     &                     CALL FLABRT ( 'USRSUW', 'KIND=<(ITD-1)*KDIM')
                           ERRDAU = ZERZER
*  |  |  |  |  |  |  |  +----------------------------------------------*
*  |  |  |  |  |  |  |  |
                           DO 8700 ITR = 1, NIRRDT
*                             ORIT = ORI
*    &                             / ( TIRRDT (ITR) - TIRRDT (ITR-1) )
                              ORIT = ORI * BIRRDT (ITR)
*  |  |  |  |  |  |  |  |  Activ = Activ(Nirrdt,Ntrdcy,Nxidau)
                              IRIDIA = ITR + NIRRDT * ( ITD - 1 )
     &                               + NIRRDT * NTRDCY * ( IDAUGH - 1 )
                              DCYFCT = ACTIV ( IRIDIA )
                              IF ( LPRINT ) THEN
                                 WRITE(90+NIRRDT,*)
                                 WRITE(90+NIRRDT,*)
     &                          ' IA,IZ,ISOMER,T12CUR,ORIT,NDAUGH',
     &                            IA,IZ,ISOMER,T12CUR,ORIT,NDAUGH
                                 WRITE(90+NIRRDT,*)
     &              ' KA,KZ,ISM,DCYFCT,ITR,ITD,TIRDCY(ITD),IDAUGH,KIND',
     &                KA,KZ,ISM,DCYFCT,ITR,ITD,TIRDCY(ITD),IDAUGH,KIND
                              END IF
                              GDSTOR (KIND) = GDSTOR (KIND) + WEIISO
     &                                      * ORIT * DCYFCT
                              ERRDAU        = ERRDAU + WEIISO
     &                                      * EORI * ORIT * DCYFCT
*                             write (77,*)
*    &                          ' score: itr,itd, ka,kz,ism,kind,ia,iz',
*    &                                   itr,itd, ka,kz,ism,kind,ia,iz
*                              write (77,*)
*     &                          ' score: ori, gdstor(kind), dcyfct',
*     &                                   ori, gdstor(kind), dcyfct
 8700                      CONTINUE
*  |  |  |  |  |  |  |  |
*  |  |  |  |  |  |  |  +----------------------------------------------*
                           GBSTOR (KIND) = GBSTOR (KIND) + ERRDAU**2
 8701                   CONTINUE
*  |  |  |  |  |  |  |
*  |  |  |  |  |  |  +-------------------------------------------------*
 8050                CONTINUE
*  |  |  |  |  |  |
*  |  |  |  |  |  +----------------------------------------------------*
                  END IF
*  |  |  |  |  |
*  |  |  |  |  +-------------------------------------------------------*
               END IF
*  |  |  |  |
*  |  |  |  +----------------------------------------------------------*
 8000       CONTINUE
*  |  |  |
*  |  |  +-------------------------------------------------------------*
 8888    CONTINUE
*  |  |
*  |  +----------------------------------------------------------------*
***********  The same for isomers
         KI0   = K1  + 1
         KI1   = KI0 + NISMRS (NRN) - 1
         KLAST = KI1
*  |  +----------------------------------------------------------------*
*  |  |  Isomers:
         IF ( LISMRS .AND. NISMRS (NRN) .GT. 0 ) THEN
*  |  |  +-------------------------------------------------------------*
*  |  |  |  Loop on ( possible) isomers of the current residual
*  |  |  |  nucleus:
            DO 8889 KS = 1, NISMRS (NRN)
               IDAUGH = -1000
               IZN    = KI0 + KS - 1
               IF ( GESTOR (IZN) .LE. AZRZRZ ) GO TO 8889
               WEIISO = ONEONE
               CALL ISMRCH ( IA, IZ, IS, KS, ADUMMY, BDUMMY, JDUMMY,
     &                       IDUMMY )
               JSOMER = IS
*              LPRINT = IA .EQ. 207 .AND. IZ .EQ. 82
               CALL FLLACT ( IA, IZ, JSOMER, NDAUGH, IAD, IZD, ISD,
     &                       ACTIV, BRCTOT, MXCRIR, MXCRDT, MXCRDA,
     &                       MXIDAU )
               IF ( MXCRIR .NE. NIRRDT .OR. MXCRDT .NE. NTRDCY .OR.
     &              MXCRDA .NE. NXIDAU )
     &            CALL FLABRT ( 'USRSUWEV', 'MXCRIR,MXCRDT,MXCRDA' )
*  |  |  |  +----------------------------------------------------------*
*  |  |  |  |  Not stable:
               IF ( NDAUGH .GT. 0 ) THEN
                  ORI  = GESTOR (IZN)
                  EORI = GCSTOR (IZN)
*  |  |  |  |  +-------------------------------------------------------*
*  |  |  |  |  |  Loop on daughters
                  DO 8250 IDAUGH = 1, NDAUGH
                     KZ  = IZD (IDAUGH)
                     KA  = IAD (IDAUGH)
                     ISM = ISD (IDAUGH)
*  |  |  |  |  |  Possible if of negligible weight:
                     IF ( KA .LE. 0 ) GO TO 8250
                     KN  = KA - KZ
*                    LPRINT = LPRINT .OR. KA .EQ. 207 .AND. KZ .EQ. 82
*  |  |  |  |  |  +----------------------------------------------------*
*  |  |  |  |  |  |  Normal (ground state) isotope:
                     IF ( ISM .LE. 0 ) THEN
                        KM  = KA - 2 * KZ - NMZMNM
                        IF ( KM .LE. 0 .OR. KM .GT. IMRHGH (NRN) )
     &                       GO TO 8250
                        IF ( KZ .LE. 0 .OR. KZ .GT. IZRHGH (NRN) )
     &                       GO TO 8250
                        KZN = K0 - 1 + ( KM - 1 ) * IZRHGH (NRN) + KZ
*  |  |  |  |  |  |
*  |  |  |  |  |  +----------------------------------------------------*
*  |  |  |  |  |  |  Isomer:
                     ELSE
                        KSM = 0
                        CALL ISMRCH ( KA, KZ, ISM, KSM, ADUMMY,
     &                       BDUMMY, JDUMMY, IDUMMY )
                        IF ( KSM .GT. NISMRS (NRN) ) GO TO 8250
                        KZN = KI0 - 1 + KSM
*                       go to 8250
                     END IF
*  |  |  |  |  |  |
*  |  |  |  |  |  +----------------------------------------------------*
*  |  |  |  |  |  +----------------------------------------------------*
*  |  |  |  |  |  |
                     DO 8703 ITD = 1, NTRDCY
                        KIND   = KZN + (ITD-1) * KDIM
                        ERRDAU = ZERZER
*  |  |  |  |  |  |  +-------------------------------------------------*
*  |  |  |  |  |  |  |
                        DO 8702 ITR = 1, NIRRDT
*                          ORIT = ORI
*    &                          / ( TIRRDT (ITR) - TIRRDT (ITR-1) )
                           ORIT = ORI * BIRRDT (ITR)
*  |  |  |  |  |  |  |  Activ = Activ(Nirrdt,Ntrdcy,Nxidau)
                           IRIDIA = ITR + NIRRDT * ( ITD - 1 )
     &                            + NIRRDT * NTRDCY * ( IDAUGH - 1 )
                           DCYFCT = ACTIV ( IRIDIA )
                           IF ( LPRINT ) THEN
                              WRITE(90+NIRRDT,*)
                              WRITE(90+NIRRDT,*)
     &                          ' IA,IZ,JSOMER,T12CUR,ORIT,NDAUGH',
     &                            IA,IZ,JSOMER,T12CUR,ORIT,NDAUGH
                              WRITE(90+NIRRDT,*)
     &              ' KA,KZ,ISM,DCYFCT,ITR,ITD,TIRDCY(ITD),IDAUGH,KIND',
     &                KA,KZ,ISM,DCYFCT,ITR,ITD,TIRDCY(ITD),IDAUGH,KIND
                           END IF
                           GDSTOR (KIND) = GDSTOR (KIND) + WEIISO
     &                                   * ORIT * DCYFCT
                           ERRDAU        = ERRDAU + WEIISO
     &                                   * EORI * ORIT * DCYFCT
*                          write (77,*)
*    &                      ' score iso: itr,itd, ka,kz,ism,kind,ia,iz',
*    &                                   itr,itd, ka,kz,ism,kind,ia,iz
*                          write (77,*)
*    &                      ' score: ori, gdstor(kind), dcyfct',
*    &                               ori, gdstor(kind), dcyfct
 8702                   CONTINUE
*  |  |  |  |  |  |  |
*  |  |  |  |  |  |  +-------------------------------------------------*
                        GBSTOR (KIND) = GBSTOR (KIND) + ERRDAU**2
 8703                CONTINUE
*  |  |  |  |  |  |
*  |  |  |  |  |  +----------------------------------------------------*
*  |  |  |  |  |
*  |  |  |  |  +-------------------------------------------------------*
 8250             CONTINUE
               ELSE
                  WRITE (*,*)' ??? Isomer',IA,IZ,' with no daughters'
               END IF
*  |  |  |  |
*  |  |  |  +----------------------------------------------------------*
 8889       CONTINUE
*  |  |  |
*  |  |  +-------------------------------------------------------------*
         END IF
*  |  |
*  |  +----------------------------------------------------------------*
 8300 CONTINUE
*  |
*  +-------------------------------------------------------------------*
****  Now prepare for output
*  +-------------------------------------------------------------------*
*  |  Loop on decay times
      DO 9000 ITD = 1, NTRDCY
         KOFFS = ( ITD - 1 ) * KDIM
         KLAST = KOFFS
         close (unit=99)
*  |  +----------------------------------------------------------------*
*  |  |  Loop on detectors for totals and errors
         DO 9001 JJ = 1, IX
            NRN   = JX (JJ)
            K0    = KLAST  + 1
            K1    = IMRHGH (NRN) * IZRHGH (NRN) + K0 - 1
            KLAST = K1
            IF ( LISMRS ) THEN
               KI0   = KLAST + 1
               KI1   = KLAST + NISMRS (NRN)
               KLAST = KI1
            ELSE
               KI1   = K1
            END IF
            TOTTOT (NRN) = ZERZER
            TOTERR (NRN) = ZERZER
*  |  |  +-------------------------------------------------------------*
*  |  |  |
            DO J = K0, KI1
               IF ( GDSTOR (J) .LT. AZRZRZ ) GDSTOR (J) = ZERZER
               TOTTOT (NRN) = TOTTOT (NRN) + GDSTOR (J)
               TOTERR (NRN) = TOTERR (NRN) + GBSTOR (J)
            END DO
*  |  |  |
*  |  |  +-------------------------------------------------------------*
            TOTERR (NRN) = SQRT (TOTERR (NRN))
            IF ( TOTTOT (NRN) .GT. ZERZER ) TOTERR (NRN) = TOTERR (NRN)
     &                                                   / TOTTOT (NRN)
 9001    CONTINUE
*  |  |
*  |  +----------------------------------------------------------------*
*  |  +----------------------------------------------------------------*
*  |  |  Compute errors:
         DO J = KOFFS + 1, KOFFS + KDIM
            GBSTOR (J) = SQRT (GBSTOR(J))
            IF ( GDSTOR (J) .GT. ZERZER )
     &         GBSTOR (J) = GBSTOR (J) / GDSTOR (J)
         END DO
*  |  |
*  |  +----------------------------------------------------------------*
         KLAST = KOFFS
D        WRITE (98,'(I5,1P,G16.7)') ITD, TIRDCY (ITD)
*  |  +----------------------------------------------------------------*
*  |  |  Now write down:
         DO 7850 JJ=1,IX
            NRN   = JX(JJ)
D           WRITE(98,'(I5,1X,A10,1P,2G16.7)')
D    &            NRN,TIURSN(NRN),TOTTOT(NRN),TOTERR(NRN)
            K0    = KLAST + 1
            K1    = IMRHGH (NRN) * IZRHGH (NRN) + K0 - 1
            KLAST = K1
            WRITE (3,*)
            WRITE (3,*) ' Beam intensity  :',BEAINT,' pr/s'
            WRITE (3,*)
            WRITE (3,*) ' Irradiation time:',SNGL(TIRRDT(NIRRDT)),' s'
            WRITE (3,*)
            WRITE (3,*) ' Decay time      :',SNGL(TIRDCY(ITD)),   ' s'
            WRITE (3,*)
            WRITE (3,*) ' Detector n: ', NRN,'  ',TIURSN (NRN)
            WRITE (3,*) '    (Region',NRURSN(NRN),' Volume:  ',
     &           SNGL(VURSNC(NRN)),' cmc,'
            WRITE (3,*) '     distr. type  :',ITURSN(NRN),'   ,'
            WRITE (3,*) '     Z_max:',IZRHGH(NRN),', N-Z_max:',
     &           IMRHGH(NRN)+NMZMNM,', N-Z_min:',NMZMNM+1,
     &           ')'
            WRITE (3,*)
            WRITE (3,*)'    Tot. response (Bq/cmc)',
     &           SNGL(TOTTOT(NRN)),
     &           '  +/-',SNGL(TOTERR(NRN))*100.0,' %'
            WRITE (3,*)'    ( --> Bq              ',
     &           SNGL(TOTTOT(NRN)*VURSNC(NRN)),
     &           '  +/-',SNGL(TOTERR(NRN))*100.0,' % )'
            WRITE (3,*)
            WRITE (3,*)
     &           ' **** Residual nuclei distribution  ****',
     &           ' ****           (Bq/cmc)            ****'
            WRITE (3,*)
            WRITE (3,*)
            THRESH = TOTTOT(NRN) * 0.001
*************************
            WRITE (66,*)
            WRITE (66,*)
            WRITE (66,*) ' Beam intensity  :',BEAINT,' pr/s'
            WRITE (66,*)
            WRITE (66,*) ' Irradiation time:',SNGL(TIRRDT(NIRRDT)),' s'
            WRITE (66,*)
            WRITE (66,*) ' Decay time      :',SNGL(TIRDCY(ITD)),   ' s'
            WRITE (66,*)
            WRITE (66,*) ' Detector n: ', NRN,'  ',TIURSN (NRN)
            WRITE (66,*) '    (Region',NRURSN(NRN),' Volume:  ',
     &           SNGL(VURSNC(NRN)),' cmc,'
            WRITE (66,*) '     distr. type  :',ITURSN(NRN),'   ,'
            WRITE (66,*) '     Z_max:',IZRHGH(NRN),', N-Z_max:',
     &           IMRHGH(NRN)+NMZMNM,', N-Z_min:',NMZMNM+1,
     &           ')'
            WRITE (66,*)
            WRITE (66,*)'    Tot. response (Bq/cmc)',
     &           SNGL(TOTTOT(NRN)),
     &           '  +/-',SNGL(TOTERR(NRN))*100.0,' %'
            WRITE (66,*)'    ( --> Bq              ',
     &           SNGL(TOTTOT(NRN)*VURSNC(NRN)),
     &           '  +/-',SNGL(TOTERR(NRN))*100.0,' % )'
            WRITE (66,*)
            WRITE (66,*)
     &           ' **** Residual nuclei distribution  ****',
     &           ' ****           (Bq/cmc)            ****'
            WRITE (66,*)
            WRITE (66,9340)
            WRITE (66,*)
*************
*************
            WRITE (67,*) NRN, SNGL(TIRRDT(NIRRDT)), SNGL(TIRDCY(ITD))
            WRITE (67,*) SNGL(TOTTOT(NRN)), SNGL(TOTERR(NRN))
*************
            DO IA = 1, MXARSN
               DO IZ = 1, 100
                  RESNUC (IZ,IA) = ZERZER
                  RESERR (IZ,IA) = ZERZER
                  IABEG  (IZ) = 500
                  IAEND  (IZ) = 0
               END DO
            END DO
            ITHR  = 0
            DO IM = 1, IMRHGH (NRN)
               DO IZ  = 1, IZRHGH (NRN)
                  IN  = IM + IZ + NMZMNM
                  IA  = IN + IZ
                  IF ( IA .GE. 1 ) THEN
                     IZN = K0 - 1 + ( IM - 1 ) * IZRHGH (NRN) + IZ
                     RESNUC (IZ,IA) = GDSTOR (IZN)
                     IF ( ABS (GDSTOR (IZN)) .GT. ZERZER ) THEN
                        IABEG (IZ) = MIN ( IABEG (IZ), IA )
                        IAEND (IZ) = MAX ( IAEND (IZ), IA )
                        RESERR (IZ,IA) = GBSTOR (IZN) * 100.D+00
                        IF ( RESNUC (IZ,IA). GT. THRESH ) THEN
                           ITHR = ITHR + 1
                           IATHR (ITHR) = IA
                           IZTHR (ITHR) = IZ
                           IMTHR (ITHR) = 0
                           ACTHR (ITHR) = RESNUC (IZ,IA)
                           ERTHR (ITHR) = RESERR (IZ,IA)
                        END IF
                     END IF
                  END IF
               END DO
            END DO
*
            DO JTHR = 1, ITHR
               IAIZTH (JTHR) = IATHR (JTHR) * 1000 + IZTHR (JTHR) * 10
     &              + IMTHR (JTHR)
               ICORTH (JTHR) = JTHR
            END DO
            CALL IORDIN ( IAIZTH, ICORTH, ITHR )
            DO KTHR = 1, ITHR
               JTHR = ICORTH (KTHR)
               IF ( ICHSYZ ( IZTHR (JTHR), CHSYM ) .NE. IZTHR (JTHR) )
     &              STOP 'ICHSYZ'
               ISOMER = IMTHR (JTHR)
               T12CUR = TIM1O2 ( IATHR (JTHR), IZTHR (JTHR), KKA, KKZ,
     &                           T12DDA, BRDDAU, IDCDAU, ISOMER )
               WRITE (66,9350) IATHR (JTHR), CHSYM, IZTHR (JTHR),
     &              ACTHR (JTHR), ERTHR (JTHR), T12CUR
            END DO
            ITHR   = 0
*
            IASTRT = IMRHGH (NRN) + 2 * IZRHGH (NRN) + NMZMNM
            IZ0    = IZRHGH (NRN) + 1
 8220       CONTINUE
            IZ1 = IZ0 - 1
            IZ0 = MAX ( 1, IZ1 - 10 )
*           IAS1= IASTLN (MIN(MAX(IZ1,1),100))
*           IAS0= IASTLN (MIN(MAX(IZ0,1),100))
*           IA1 = MIN ( IASTRT, IAS1 + MAX ( MIN (IZ1/5,10),  5 ) )
*           IA0 = MAX ( IZ0   , IAS0 - MAX ( MIN (IZ1/3,20), 10 ) )
*           IA1 = MIN ( IA1, IMRHGH (NRN) + 2 * IZ1 + NMZMNM )
*           IA0 = MAX ( IA0, 1 + 2 * IZ0 + NMZMNM )
*           IA0 = MAX ( IA0, 1 )
            IA1 = 0
            IA0 = 500
            DO IZ = IZ0, IZ1
               IA1 = MAX ( IA1, IAEND (IZ) )
               IA0 = MIN ( IA0, IABEG (IZ) )
            END DO
            WRITE (3,9240) ( IZ, IZ = IZ0, IZ1 )
            DO 8230 IA = IA1, IA0, - 1
               LCHECK = .FALSE.
               DO IZ = IZ0, IZ1
                  LCHECK = LCHECK .OR. RESNUC (IZ,IA) .GE. AZRZRZ
               END DO
               IF ( LCHECK ) THEN
                  WRITE (3,9250) IA, ( RESNUC (IZ,IA), IZ = IZ0, IZ1 )
                  WRITE (3,9260)
     &                        ( CHERR, RESERR (IZ,IA), IZ = IZ0, IZ1 )
               END IF
 8230       CONTINUE
            IF ( IZ0 .GT. 1 ) GO TO 8220
            WRITE (3,*)
***********
            WRITE (66,*)
            ITHR = 0
***********
            IF ( LISMRS ) THEN
               KI0   = KLAST + 1
               KI1   = KLAST + NISMRS (NRN)
               KLAST = KI1
               IF ( NISMRS (NRN) .GT. 0 ) THEN
                  WRITE (3,*) ' **** Isomers (Bq/cmc)     ****'
                  WRITE (3,*) '     A        Z       mth'
***********
                  WRITE(66,*) ' **** Isomers (Bq/cmc)     ****'
                  WRITE(66,*)
                  WRITE(66,9360)
                  WRITE(66,*)
***********
               END IF
               DO KS = 1, NISMRS (NRN)
                  IZN = KI0 + KS - 1
                  IF ( GDSTOR(IZN) .GT. AZRZRZ ) THEN
                     CALL ISMRCH ( IA, IZ, IS, KS, ADUMMY, BDUMMY,
     &                             JDUMMY, IDUMMY )
                     WRITE (3,9270) IA, IZ, IS, SNGL(GDSTOR(IZN)),
     &                              SNGL(GBSTOR(IZN)*100.D+00)
***********
                     IF ( GDSTOR(IZN) .GT. THRESH ) THEN
                        ITHR = ITHR + 1
                        IZTHR (ITHR) = IZ
                        IATHR (ITHR) = IA
                        IMTHR (ITHR) = IS
                        ACTHR (ITHR) = GDSTOR (IZN)
                        ERTHR (ITHR) = GBSTOR (IZN) * 100.D+00
                     END IF
***********
                  END IF
               END DO
*
               DO JTHR = 1, ITHR
                  IAIZTH (JTHR) = IATHR (JTHR) * 10000
     &                 + IZTHR (JTHR) * 10 + IMTHR (JTHR)
                  ICORTH (JTHR) = JTHR
               END DO
               CALL IORDIN ( IAIZTH, ICORTH, ITHR )
               DO KTHR = 1, ITHR
                  JTHR = ICORTH (KTHR)
                  IF ( ICHSYZ ( IZTHR (JTHR), CHSYM )
     &                 .NE. IZTHR (JTHR) )
     &                 STOP 'ICHSYZ'
                  ISOMER = IMTHR (JTHR)
                  T12CUR = TIM1O2 ( IATHR (JTHR), IZTHR (JTHR), KKA,
     &                              KKZ, T12DDA, BRDDAU, IDCDAU,
     &                              ISOMER )
                  WRITE (66,9370) IATHR (JTHR), CHSYM, IZTHR (JTHR),
     &                            IMTHR (JTHR), ACTHR (JTHR),
     &                            ERTHR (JTHR), T12CUR
               END DO
               ITHR = 0
*
               WRITE (3,*)
***********
               WRITE (66,*)
***********
            END IF
*  |  Write on binary file the results:
            WRITE (1)    NRN, TIURSN(NRN), ITURSN(NRN), NRURSN(NRN),
     &              SNGL(VURSNC (NRN)), IMRHGH(NRN), IZRHGH(NRN), NMZMNM
            IF ( LEVOLN ) WRITE (1) SNGL (TIRDCY(ITD))
            WRITE (1) (SNGL(GDSTOR(J)), J = K0, K1)
            IF ( LISMRS ) THEN
               WRITE (1) 'ISOMERS:  ', NISMRS (NRN)
               IF ( KI1 .GE. KI0 ) THEN
                  WRITE (1) (SNGL(GDSTOR(J)), J = KI0, KI1)
               ELSE
                  WRITE (1)
               END IF
            END IF
 7850    CONTINUE
*  |  |
*  |  +----------------------------------------------------------------*
         KLAST = KOFFS
*  Now write the statistical data, first a record to flag them
         WRITE (1) 'STATISTICS',IX
*  |  +----------------------------------------------------------------*
*  |  |
         DO 7860 JJ=1,IX
            NRN   = JX(JJ)
            K0    = KLAST + 1
            K1    = IMRHGH (NRN) * IZRHGH (NRN) + K0 - 1
            KLAST = K1
            WRITE (1) SNGL (TOTTOT(NRN)), SNGL (TOTERR(NRN))
*     |  These data are zeroes for an evolution file:
            KK0 = KAURSN (NRN) + 1
            KK1 = KAURSN (NRN) + IMRHGH (NRN) + 2 * IZRHGH (NRN) +NMZMNM
            WRITE (1) ( SNGL (GDSTOR(J)), J = KK0, KK1 )
            WRITE (1) ( SNGL (GBSTOR(J)), J = KK0, KK1 )
*     |  These data are zeroes for an evolution file:
            KK0 = KZURSN (NRN) + 1
            KK1 = KZURSN (NRN) + IZRHGH (NRN)
            WRITE (1) ( SNGL (GDSTOR(J)), J = KK0, KK1 )
            WRITE (1) ( SNGL (GBSTOR(J)), J = KK0, KK1 )
*     |  Errors on the A/Z matrix:
            WRITE (1) ( SNGL (GBSTOR(J)), J = K0 , K1  )
            IF ( LISMRS ) THEN
               KI0   = KLAST + 1
               KI1   = KLAST + NISMRS (NRN)
               KLAST = KI1
               IF ( KI1 .GE. KI0 ) THEN
                  WRITE (1) ( SNGL (GBSTOR(J)), J = KI0, KI1 )
               ELSE
                  WRITE (1)
               END IF
            END IF
 7860    CONTINUE
*  |  |
*  |  +----------------------------------------------------------------*
 9000 CONTINUE
*  |
*  +-------------------------------------------------------------------*
      CLOSE (UNIT= 1)
      CLOSE (UNIT= 3)
      CLOSE (UNIT=66)
      CLOSE (UNIT=67)
*
 9240 FORMAT ( /, 1X,' A \\ Z',2X,I3,3X,10(5X,I3,3X) )
 9250 FORMAT ( 1X,I3,11(3X,1P,E8.2) )
 9260 FORMAT ( 1X,3X,11(2X,A3,F4.1,' %') )
 9270 FORMAT(1X,I8,I8,I8,4X,1P,E8.2,' +/- ',0P,F4.1,' %')
 9340 FORMAT(7X,'A ',2X,'Sym.',2X,6X,'Z ',4X,' Bq/cmc  ',5X,'Err.',2X,
     &       4X,'  T 1/2 (s)')
 9350 FORMAT(1X,I8,3X,A2,3X,I8,4X,1P,E9.3,' +/- ',0P,F4.1,' %',
     &       4X,1P,E9.3)
 9360 FORMAT(7X,'A ',2X,'Sym.',2X,6X,'Z ',' mth',4X,' Bq/cmc  ',
     &       5X,'Err.',2X,4X,'  T 1/2 (s)')
 9370 FORMAT(1X,I8,3X,A2,3X,I8,I4,4X,1P,E9.3,' +/- ',0P,F4.1,' %',
     &       4X,1P,E9.3)
 9500 FORMAT (/,I6,' irradiation intervals defined',
     &        /,5X,'    #    Length (s)  Intensity (p/s)',
     &        (/,5X,0P,I5,1P,3X,E12.5,4X,E12.5))
      STOP
      END

