SUBROUTINE ISTACK C----------------------------------------------------------------------- C I(NITIALIZE) STACK C C PREPARES STACK AND EXTERNAL DISK FILE C THIS SUBROUTINE IS CALLED FROM MAIN C----------------------------------------------------------------------- IMPLICIT NONE *KEEP,ETHMAP. COMMON /ETHMAP/ ECTMAP,ELEFT DOUBLE PRECISION ECTMAP,ELEFT *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 *KEEP,STACKF. COMMON /STACKF/ STACK,STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM INTEGER MAXSTK PARAMETER (MAXSTK = 12*340*2) DOUBLE PRECISION STACK(MAXSTK) INTEGER STACKP,EXST,NSHIFT,NOUREC,ICOUNT,NTO,NFROM *KEND. C----------------------------------------------------------------------- IF ( DEBUG ) WRITE(MDEBUG,*) 'ISTACK:' NTO = 0 NFROM = 0 NOUREC = 0 NSHIFT = 0 STACKP = 0 ELEFT = 0.D0 ICOUNT = 1 RETURN END