C N BODY M VERTEX SAMPLE GENERATOR C VERSION WITH EXTRA PARAMETER READ-IN FACILITY C WILL READ PARAMETERS INTO BLOCK IN EXBANK DESIGNATED BY NBRNCH(2) C USING PAREAD C REVISED FORTRAN IV VERSION -- SPACE FOR EXBANK IS DIMENSIONED C IN LIMITS, A BLOCK DATA SUBROUTINE C RUN TERMINATES WHEN NBRNCH(1) IS 9 C ************************* COMMON COMMON ************************** COMMON MAP(2000),PARS(1000),MISC(27),KLIST(500),MTABLE(2) COMMON /LIMIT/LIMMNO,LIMLNO,LIMKNO,LIMEX DIMENSION ZMAP(2000) DIMENSION REMARK(500) DIMENSION OTABLE(7,50), JTABLE(7,50), RTABLE(9,20,2), 1 LTABLE(9,20,2), ITABLE(6,20), VAL(100), IVAL(100), 2 WGT(100) DIMENSION PARA(1000),NPARA(1000),SNAME(1000),NAME(1000) DIMENSION HEAD(11), NBRNCH(10),NBRCH2(10),HEAD2(11) DIMENSION KTABLE(7,100) EQUIVALENCE (MAP,ZMAP,KTABLE) EQUIVALENCE (REMARK,MAP(1001)),(NBRCH2,MAP(1501)), 1 (HEAD2,MAP(1511)) EQUIVALENCE (OTABLE,JTABLE,MAP(701)), (RTABLE,LTABLE,MAP(1051)), 1 (ITABLE,MAP(1411)), (VAL,IVAL,MAP(1531)), 2 (WGT,MAP(1631)) EQUIVALENCE (NCFLAG,MAP(1869)), (WEIGHT,MAP(1978)), 1 (NTAPE,MAP(1988)), (EINC,MAP(1998)), 2 (PINC,MAP(1999)), (BINC,MAP(2000)) EQUIVALENCE (MTOT,MAP(1987)) 7/13/68 EQUIVALENCE (PARA,NPARA,PARS),(SNAME,NAME,MAP(1)) EQUIVALENCE (PI, MISC), (RADIAN, MISC(2)), (NIT, MISC(3)), 1 (NOT, MISC(4)), (HEAD, MISC(5)), (NBRNCH, MISC(16)), 2 (NPAGE, MISC(26)), (NORD, MISC(27)) EQUIVALENCE (LTAPE,NBRNCH(9)), (LINK,NBRNCH(10)) C ****************** END OF STANDARD CDE STATEMENTS **************** DATA END/'E'/, LP/-1000/ C PI=3.14159 RADIAN=57.29578 TYPE 701 701 FORMAT(' OUPUT UNIT?'/) ACCEPT 702,NOT,XNAME 702 FORMAT(I,A5) CALL OFILE(NOT,XNAME) TYPE 703 703 FORMAT(' INPUT UNIT?'/) ACCEPT 702,NIT,XNAME CALL IFILE(NIT,XNAME) C ZERO EXBANK NBEGN=LIMMNO+1 IJEND=LIMMNO+LIMEX DO 2 I=NBEGN,IJEND 2 MTABLE(I)=0 1 CALL PAREAD (NIT,NOT,NBRNCH,HEAD,PARS,LP,SNAME,REMARK,500) IF (NBRNCH(1) - 9) 30,3,30 C PARAMETER END BLOCK READ, WRAP IT UP 3 IF (NTAPE) 8, 8, 4 4 END FILE NTAPE 6 REWIND NTAPE 8 CALL EXIT C NBRNCH(2) NONZERO SAYS CALL PAREAD TO READ EXTRA PARAMETERS INTO C BANK INDICATED BY NBRNCH(2). 30 IF(NBRNCH(2)) 10,10,31 31 NCHK=NBRNCH(2)*1000 IF (NCHK-1000-LIMEX) 32,111,111 111 WRITE (NOT,1313) NBRNCH(2),LIMEX 1313 FORMAT(1H0,20X,47HINSUFFICIENT STORAGE AVAILABLE IN EXBANK. EPARS 1I1,29H EXCEEDS EXBANK DIMENSION OF I4/1H 25X,30HPROCEEDING TO NEXT 1 EVENT TYPE.) 33 READ (NIT,9001) ACHECK 9001 FORMAT(A1) IF(ACHECK.NE.END) GO TO 33 GO TO 10 32 NEPARS = NBRNCH(2) NBEGN=NCHK-999+LIMMNO WRITE (NOT,3401)NEPARS 3401 FORMAT(33H1EXTRA PARAMETERS READ INTO EPARS I1 ) IF (NCHK-LIMEX) 35,35,34 34 LENGTH=LIMEX-(NBRNCH(2)-1)*1000 WRITE (NOT,1414) LENGTH 1414 FORMAT (1H0,20X 5HONLY I4,79H SPACES AVAILABLE IN EXBANK. THE REST 1 IS NEEDED FOR SYSTEM AND PROGRAM STORAGE.) GO TO 36 35 LENGTH=1000 36 CALL PAREAD (NIT,NOT,NBRCH2,HEAD2,MTABLE(NBEGN),LENGTH,SNAME, 1 REMARK,500) C READ IN AND SET UP A NEW EVENT TYPE 10 CALL SSWTCH(2,K000FX) GO TO(20,15),K000FX 15 WRITE (NOT,9015) 9015 FORMAT (30H0SENSE SWITCH 2 TERMINATION ) CALL EXIT 20 NERR = 0 CALL SETUP ( NERR ) IF (NERR) 45, 80, 45 C IF NERR = 100 READ IN NEW PARAMETERS 45 IF (NERR - 100) 500, 1, 500 80 CALL HEDING NORD = 0 C BEGINNING OF EVENT GENERATION LOOP, CHECK FOR OPERATOR KILL 90 CALL SSWTCH(1,K000FX) GO TO(95,92),K000FX 92 KILL = NORD + 1 WRITE (NOT,9092)KILL 9092 FORMAT (45H0SENSE SWITCH TERMINATION, LAST EVENT NUMBER I6) NORD = MTOT - 1 95 NORD = NORD + 1 CALL EVENT ( NERR ) C CHECK FOR ERROR DURING EVENT GENERATION IF (NERR) 96, 100, 96 96 IF (NORD-1) 500, 500, 97 97 CALL OHIST(0) GO TO 500 100 CALL EHIST 200 IF (NORD - MTOT) 90, 300, 300 C END OF EVENT GENERATION, SAMPLE COMPLETE, OUTPUT 300 CALL OHIST (0) CALL SSWTCH(1,K000FX) GO TO(10,3),K000FX C FOLLOWING IS DUMP ON ERROR FLAG 500 WRITE (NOT,9500)NERR 9500 FORMAT ( 23H0INPUT DATA ERROR TYPE I4/ 65H FOLLOWING ARE DUMP 1S OF ITABLE, KTABLE, OTABLE, LTABLE, AND KLIST ) CALLPDUMP ( ITABLE(1,1), ITABLE(120,1), 2, KTABLE(1,1), KTABLE(700 1,1), 2, OTABLE(1,1), OTABLE(350,1), 1, LTABLE(1,1,1), LTABLE(360 2,1,1), 2, KLIST(1), KLIST(500), 2 ) CALL SSWTCH(1,K000FX) GO TO(10,3),K000FX END