Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

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