[u/mrichter/AliRoot.git] / GEANT321 / fluka / erup.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1999/05/18 15:55:15  fca
* AliRoot sources
*
* Revision 1.1.1.1  1995/10/24 10:19:55  cernlib
* Geant
*
*
#include "geant321/pilot.h"
#if defined(CERNLIB_OLDNAME)
*CMZ :  3.21/02 29/03/94  15.41.42  by  S.Giani
*-- Author :
*=== erup =============================================================*
*                                                                      *
      SUBROUTINE ERUP (JFISS)
 
#include "geant321/dblprc.inc"
#include "geant321/dimpar.inc"
#include "geant321/iounit.inc"
*
*----------------------------------------------------------------------*
*                                                                      *
*     Created  on   15 may 1990     by     Alfredo & Paola Sala        *
*                                              INFN - Milan            *
*     Last change  on   10-apr-93   by     Alfredo Ferrari, INFN-Milan *
*                                                                      *
*     Derived from the ERUP routine of EVAP-V, HERMES, KFA-Julich      *
*                                                                      *
*----------------------------------------------------------------------*
*
C*****MODIFIED TO OBTAIN APR,ZPR AFTER CAS + EVAP (8-68,T.W.A.)
#include "geant321/eva1.inc"
#include "geant321/forcn.inc"
#include "geant321/inpflg.inc"
#include "geant321/hetc5.inc"
#include "geant321/hetc7.inc"
#include "geant321/hettp.inc"
#include "geant321/higfis.inc"
*     COMMON / AZ /    LOWAZ
      LOGICAL LOPPAR
      DIMENSION  FPART (6)
C     -------------------------------------- CHECK PARAMETER
      FISINH=.FALSE.
*  +-------------------------------------------------------------------*
*  |  Check the excitation energy
      IF ( EX .LE. ZERZER ) THEN
*  |  No excitation energy:
         IF ( JFISS .LE. 0 ) THEN
            DO 201 I=1,6
               NPART(I)=0
  201       CONTINUE
            HEVSUM = ZERZER
         END IF
*        UU = ZERZER
         UU = EX
         RETURN
*  |
*  +-------------------------------------------------------------------*
*  |  Positive excitation energy:
      ELSE
*  |  Try evaporation
         M2 = NINT (APR)
         M3 = NINT (ZPR)
 8801    CONTINUE
         CALL FKDRES (M2,M3,EX,UU,EREC,LOPPAR,JFISS)
         FPARTT = ZERZER
*  |  +----------------------------------------------------------------*
*  |  |  No previous evaporation for this event
         IF ( JFISS .LE. 0 ) THEN
            DO 801 I=1,6
               FPART(I) = NPART(I)
               FPARTT   = FPARTT + FPART (I)
  801       CONTINUE
*  |  |
*  |  +----------------------------------------------------------------*
*  |  |  Other evaporation trials already performed for this event
         ELSE
            DO 802 I=1,6
               FPART(I) = NPART(I)-NPARTF(I,JFISS-1)
               FPARTT   = FPARTT + FPART (I)
  802       CONTINUE
         END IF
*  |  |
*  |  +----------------------------------------------------------------*
*  |  +----------------------------------------------------------------*
*  |  |  No particle evaporated and pairing corrections accounted for
         IF ( FPARTT + FKEY .LT. ANGLGB ) THEN
            IF ( .NOT. LOPPAR ) GO TO 8802
            FKEY = ONEONE
            GO TO 8801
         END IF
*  |  |
*  |  +----------------------------------------------------------------*
 8802    CONTINUE
         FKEY = ZERZER
         ZPR  = ZPR - FPART(2) - FPART(3) - TWOTWO * ( FPART(5)
     &        + FPART(6)) - FPART(4)
         APR  = APR - FPART(1) - FPART(2) - TWOTWO * FPART(3)
     &        - THRTHR * ( FPART(4) + FPART(5) ) - FOUFOU * FPART(6)
         IF (IANG .GT. 0) THEN
         ELSE
            DO 440 K=1,6
               NP = NPART(K)
               IF ( JFISS .GT. 0 ) THEN
                  NP0 = NPARTF(K,JFISS-1) + 1
               ELSE
                  NP0 = 1
               END IF
               DO 410 J=NP0,NP
                  CALL RACO(COSEVP(1,J,K),COSEVP(2,J,K),COSEVP(3,J,K))
  410          CONTINUE
  440       CONTINUE
         END IF
      END IF
*  |
*  +-------------------------------------------------------------------*
      RETURN
*=== End of subroutine Erup ===========================================*
      END
#else
      SUBROUTINE ERUP_DUMMY
      END
#endif
Commit	Line	Data
fe4da5cc	1	*
	2	* $Id$
	3	*
	4	* $Log$
62be6b28	5	* Revision 1.1.1.1 1999/05/18 15:55:15 fca
	6	* AliRoot sources
	7	*
fe4da5cc	8	* Revision 1.1.1.1 1995/10/24 10:19:55 cernlib
	9	* Geant
	10	*
	11	*
	12	#include "geant321/pilot.h"
	13	#if defined(CERNLIB_OLDNAME)
	14	*CMZ : 3.21/02 29/03/94 15.41.42 by S.Giani
	15	*-- Author :
	16	=== erup =============================================================
	17	* *
	18	SUBROUTINE ERUP (JFISS)
	19
	20	#include "geant321/dblprc.inc"
	21	#include "geant321/dimpar.inc"
	22	#include "geant321/iounit.inc"
	23	*
	24	----------------------------------------------------------------------
	25	* *
	26	* Created on 15 may 1990 by Alfredo & Paola Sala *
	27	* INFN - Milan *
	28	* Last change on 10-apr-93 by Alfredo Ferrari, INFN-Milan *
	29	* *
	30	* Derived from the ERUP routine of EVAP-V, HERMES, KFA-Julich *
	31	* *
	32	----------------------------------------------------------------------
	33	*
	34	C*****MODIFIED TO OBTAIN APR,ZPR AFTER CAS + EVAP (8-68,T.W.A.)
	35	#include "geant321/eva1.inc"
	36	#include "geant321/forcn.inc"
	37	#include "geant321/inpflg.inc"
	38	#include "geant321/hetc5.inc"
	39	#include "geant321/hetc7.inc"
	40	#include "geant321/hettp.inc"
	41	#include "geant321/higfis.inc"
	42	* COMMON / AZ / LOWAZ
	43	LOGICAL LOPPAR
	44	DIMENSION FPART (6)
	45	C -------------------------------------- CHECK PARAMETER
	46	FISINH=.FALSE.
	47	* +-------------------------------------------------------------------*
	48	* \| Check the excitation energy
	49	IF ( EX .LE. ZERZER ) THEN
	50	* \| No excitation energy:
	51	IF ( JFISS .LE. 0 ) THEN
	52	DO 201 I=1,6
	53	NPART(I)=0
	54	201 CONTINUE
	55	HEVSUM = ZERZER
	56	END IF
	57	* UU = ZERZER
	58	UU = EX
	59	RETURN
	60	* \|
	61	* +-------------------------------------------------------------------*
	62	* \| Positive excitation energy:
	63	ELSE
	64	* \| Try evaporation
	65	M2 = NINT (APR)
	66	M3 = NINT (ZPR)
	67	8801 CONTINUE
	68	CALL FKDRES (M2,M3,EX,UU,EREC,LOPPAR,JFISS)
	69	FPARTT = ZERZER
	70	* \| +----------------------------------------------------------------*
	71	* \| \| No previous evaporation for this event
72	IF ( JFISS .LE. 0 ) THEN
73	DO 801 I=1,6
74	FPART(I) = NPART(I)
75	FPARTT = FPARTT + FPART (I)
76	801 CONTINUE
77	* \| \|
78	* \| +----------------------------------------------------------------*
79	* \| \| Other evaporation trials already performed for this event
80	ELSE
81	DO 802 I=1,6
82	FPART(I) = NPART(I)-NPARTF(I,JFISS-1)
83	FPARTT = FPARTT + FPART (I)
84	802 CONTINUE
85	END IF
86	* \| \|
87	* \| +----------------------------------------------------------------*
88	* \| +----------------------------------------------------------------*
89	* \| \| No particle evaporated and pairing corrections accounted for
90	IF ( FPARTT + FKEY .LT. ANGLGB ) THEN
91	IF ( .NOT. LOPPAR ) GO TO 8802
92	FKEY = ONEONE
93	GO TO 8801
94	END IF
95	* \| \|
96	* \| +----------------------------------------------------------------*
97	8802 CONTINUE
98	FKEY = ZERZER
99	ZPR = ZPR - FPART(2) - FPART(3) - TWOTWO * ( FPART(5)
100	& + FPART(6)) - FPART(4)
101	APR = APR - FPART(1) - FPART(2) - TWOTWO * FPART(3)
102	& - THRTHR * ( FPART(4) + FPART(5) ) - FOUFOU * FPART(6)
103	IF (IANG .GT. 0) THEN
104	ELSE
105	DO 440 K=1,6
106	NP = NPART(K)
107	IF ( JFISS .GT. 0 ) THEN
108	NP0 = NPARTF(K,JFISS-1) + 1
109	ELSE
110	NP0 = 1
111	END IF
112	DO 410 J=NP0,NP
113	CALL RACO(COSEVP(1,J,K),COSEVP(2,J,K),COSEVP(3,J,K))
114	410 CONTINUE
115	440 CONTINUE
116	END IF
117	END IF
118	* \|
119	* +-------------------------------------------------------------------*
120	RETURN
121	=== End of subroutine Erup ===========================================
122	END
62be6b28	123	#else
	124	SUBROUTINE ERUP_DUMMY
	125	END
fe4da5cc	126	#endif