| 1 | SUBROUTINE TSTACK | 
|---|
| 2 |  | 
|---|
| 3 | C----------------------------------------------------------------------- | 
|---|
| 4 | C  T(O) STACK | 
|---|
| 5 | C | 
|---|
| 6 | C  ADDS PARTICLE TO INTERMEDIATE STACK UNTIL REACTION IS FINISHED | 
|---|
| 7 | C  THIS SUBROUTINE IS CALLED FROM MANY POINTS ALL OVER THE PROGRAM | 
|---|
| 8 | C----------------------------------------------------------------------- | 
|---|
| 9 |  | 
|---|
| 10 | IMPLICIT NONE | 
|---|
| 11 | *KEEP,BUFFS. | 
|---|
| 12 | COMMON /BUFFS/   RUNH,RUNE,EVTH,EVTE,DATAB,LH | 
|---|
| 13 | INTEGER          MAXBUF,MAXLEN | 
|---|
| 14 | PARAMETER        (MAXBUF=39*7) | 
|---|
| 15 | PARAMETER        (MAXLEN=12) | 
|---|
| 16 | REAL             RUNH(MAXBUF),EVTH(MAXBUF),EVTE(MAXBUF), | 
|---|
| 17 | *                 RUNE(MAXBUF),DATAB(MAXBUF) | 
|---|
| 18 | INTEGER          LH | 
|---|
| 19 | CHARACTER*4      CRUNH,CRUNE,CEVTH,CEVTE | 
|---|
| 20 | EQUIVALENCE      (RUNH(1),CRUNH), (RUNE(1),CRUNE) | 
|---|
| 21 | EQUIVALENCE      (EVTH(1),CEVTH), (EVTE(1),CEVTE) | 
|---|
| 22 | *KEEP,ELABCT. | 
|---|
| 23 | COMMON /ELABCT/  ELCUT | 
|---|
| 24 | DOUBLE PRECISION ELCUT(4) | 
|---|
| 25 | *KEEP,ETHMAP. | 
|---|
| 26 | COMMON /ETHMAP/  ECTMAP,ELEFT | 
|---|
| 27 | DOUBLE PRECISION ECTMAP,ELEFT | 
|---|
| 28 | *KEEP,MUPART. | 
|---|
| 29 | COMMON /MUPART/  AMUPAR,BCUT,CMUON,FMUBRM,FMUORG | 
|---|
| 30 | DOUBLE PRECISION AMUPAR(14),BCUT,CMUON(11) | 
|---|
| 31 | LOGICAL          FMUBRM,FMUORG | 
|---|
| 32 | *KEEP,PAM. | 
|---|
| 33 | COMMON /PAM/     PAMA,SIGNUM | 
|---|
| 34 | DOUBLE PRECISION PAMA(6000),SIGNUM(6000) | 
|---|
| 35 | *KEEP,PARPAR. | 
|---|
| 36 | COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C, | 
|---|
| 37 | *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL | 
|---|
| 38 | DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14), | 
|---|
| 39 | *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH | 
|---|
| 40 | INTEGER          ITYPE,LEVL | 
|---|
| 41 | *KEEP,PARPAE. | 
|---|
| 42 | DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM | 
|---|
| 43 | EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE), | 
|---|
| 44 | *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ), | 
|---|
| 45 | *                 (CURPAR(6), T   ),  (CURPAR(7), X    ), | 
|---|
| 46 | *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ), | 
|---|
| 47 | *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ), | 
|---|
| 48 | *                 (CURPAR(12),ECM ) | 
|---|
| 49 | *KEEP,RUNPAR. | 
|---|
| 50 | COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB, | 
|---|
| 51 | *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN, | 
|---|
| 52 | *                 MONIOU,MDEBUG,NUCNUC, | 
|---|
| 53 | *                 CETAPE, | 
|---|
| 54 | *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL, | 
|---|
| 55 | *                 N1STTR,MDBASE, | 
|---|
| 56 | *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR, | 
|---|
| 57 | *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE | 
|---|
| 58 | *                ,GHEISH,GHESIG | 
|---|
| 59 | COMMON /RUNPAC/  DSN,HOST,USER | 
|---|
| 60 | DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB | 
|---|
| 61 | REAL             STEPFC | 
|---|
| 62 | INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC, | 
|---|
| 63 | *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL, | 
|---|
| 64 | *                 N1STTR,MDBASE | 
|---|
| 65 | INTEGER          CETAPE | 
|---|
| 66 | CHARACTER*79     DSN | 
|---|
| 67 | CHARACTER*20     HOST,USER | 
|---|
| 68 |  | 
|---|
| 69 | LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR, | 
|---|
| 70 | *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE | 
|---|
| 71 | *                ,GHEISH,GHESIG | 
|---|
| 72 | *KEEP,STACKF. | 
|---|
| 73 | COMMON /STACKF/  STACK,STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM | 
|---|
| 74 | INTEGER          MAXSTK | 
|---|
| 75 | PARAMETER        (MAXSTK = 12*340*2) | 
|---|
| 76 | DOUBLE PRECISION STACK(MAXSTK) | 
|---|
| 77 | INTEGER          STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM | 
|---|
| 78 | *KEEP,THNVAR. | 
|---|
| 79 | COMMON /THNVAR/  STACKINT,INT_ICOUNT,THINNING | 
|---|
| 80 | INTEGER          MAXICOUNT | 
|---|
| 81 | PARAMETER        (MAXICOUNT=20000) | 
|---|
| 82 | DOUBLE PRECISION STACKINT(MAXICOUNT,13) | 
|---|
| 83 | INTEGER          INT_ICOUNT | 
|---|
| 84 | LOGICAL          THINNING | 
|---|
| 85 | *KEND. | 
|---|
| 86 |  | 
|---|
| 87 | INTEGER I,J | 
|---|
| 88 | C----------------------------------------------------------------------- | 
|---|
| 89 |  | 
|---|
| 90 | INT_ICOUNT = INT_ICOUNT + 1 | 
|---|
| 91 | IF ( DEBUG ) WRITE(MDEBUG,1) INT_ICOUNT,(SECPAR(J),J=1,9) | 
|---|
| 92 | 1    FORMAT(' TSTACK:',I7,1X,1P,9E10.3) | 
|---|
| 93 |  | 
|---|
| 94 | IF ( INT_ICOUNT .GT. MAXICOUNT ) THEN | 
|---|
| 95 | WRITE(MONIOU,10) MAXICOUNT | 
|---|
| 96 | 10     FORMAT(' TSTACK: TOO MANY SECONDARIES FOR THIS REACTION', | 
|---|
| 97 | *     '  EXCEEDED ',I7,'   A T T E N T I O N  PARTICLE IS LOST') | 
|---|
| 98 | INT_ICOUNT = INT_ICOUNT - 1 | 
|---|
| 99 | RETURN | 
|---|
| 100 | ENDIF | 
|---|
| 101 |  | 
|---|
| 102 | DO I=1,MAXLEN | 
|---|
| 103 | STACKINT(INT_ICOUNT,I) = SECPAR(I) | 
|---|
| 104 | ENDDO | 
|---|
| 105 |  | 
|---|
| 106 | RETURN | 
|---|
| 107 | END | 
|---|