BLOCK DATA TRINBLK
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'DBEAM.CIN'
      INCLUDE 'DBEND.CIN'
      INCLUDE 'DCENT.CIN'
      INCLUDE 'DCVTY.CIN'
      INCLUDE 'DCORR.CIN'
      INCLUDE 'DDRFT.CIN'
      INCLUDE 'DETA.CIN'
      INCLUDE 'DFIT.CIN'
      INCLUDE 'DHKICK.CIN'
      INCLUDE 'DKICK.CIN'
      INCLUDE 'DMAGNE.CIN'
      INCLUDE 'DMIS.CIN'
      INCLUDE 'DOCT.CIN'
      INCLUDE 'DORD.CIN'
      INCLUDE 'DPLT.CIN'
      INCLUDE 'DPRNT.CIN'
      INCLUDE 'DQUAD.CIN'
      INCLUDE 'DRAN.CIN'
      INCLUDE 'DRBND.CIN'
      INCLUDE 'DROT.CIN'
      INCLUDE 'DSHIFT.CIN'
      INCLUDE 'DREPS.CIN'
      INCLUDE 'DSROT.CIN'
      INCLUDE 'DSECT.CIN'
      INCLUDE 'DSEPM.CIN'
      INCLUDE 'DSEXT.CIN'
      INCLUDE 'DSOLE.CIN'
      INCLUDE 'DSPEC.CIN'
      INCLUDE 'DUNIT.CIN'
      INCLUDE 'DUPD.CIN'
      INCLUDE 'KELEM.CIN' 
      INCLUDE 'NELMS.CIN'
      INCLUDE 'NPLIN.CIN'
      INCLUDE 'NXRAN.CIN'
      INCLUDE 'RDCHAR.CIN'
      INCLUDE 'SVALUE.CIN'
      INCLUDE 'UMAD.CIN'
      INCLUDE 'UMETER.CIN'
      INCLUDE 'UMICR.CIN'
      INCLUDE 'UMM.CIN'
      INCLUDE 'UTRANS.CIN'
      INCLUDE 'XMAD.CIN'
      INCLUDE 'XMETER.CIN'
      INCLUDE 'XMICR.CIN'
      INCLUDE 'XMM.CIN'
      INCLUDE 'XTRANS.CIN'
C
C-----------------------------------------------------------------------
      DATA DBEAM( 1)    / 'X       ' /
      DATA DBEAM( 2)    / 'XP      ' /
      DATA DBEAM( 3)    / 'Y       ' /
      DATA DBEAM( 4)    / 'YP      ' /
      DATA DBEAM( 5)    / 'DL      ' /
      DATA DBEAM( 6)    / 'DEL     ' /
      DATA DBEAM( 7)    / 'P0      ' /
      DATA DBEAM( 8)    / 'RMS     ' /
      DATA DBEAM( 9)    / 'NPART   ' /
      DATA DBEAM(10)    / 'BETAX   ' /
      DATA DBEAM(11)    / 'ALPHAX  ' /
      DATA DBEAM(12)    / 'EPSX    ' /
      DATA DBEAM(13)    / 'BETAY   ' /
      DATA DBEAM(14)    / 'ALPHAY  ' /
      DATA DBEAM(15)    / 'EPSY    ' /
      DATA DBEAM(16)    / 'GAUSS   ' /
      DATA DBEAM(17)    / 'SHELL   ' /
      DATA DBEAM(18)    / 'READ    ' /
      DATA DBEAM(19)    / 'L       ' /
      DATA DBEAM(20)    / 'PARENT  ' /
      DATA DBEAM(21)    / 'DAUGHTER1' /
      DATA DBEAM(22)    / 'DAUGHTER2' /
C-----------------------------------------------------------------------
      DATA DROT ( 1)    / 'ANGLE   ' /
      DATA DROT ( 2)    / 'HGAP    ' /
      DATA DROT ( 3)    / 'FINT    ' /
      DATA DROT ( 4)    / 'H       ' /
C-----------------------------------------------------------------------
      DATA DDRFT( 1)    / 'L       ' /
      DATA DDRFT( 2)    / 'TYPE    ' /
C-----------------------------------------------------------------------
      DATA DBEND( 1)    / 'L       ' /
      DATA DBEND( 2)    / 'B       ' /
      DATA DBEND( 3)    / 'RADIUS  ' /
      DATA DBEND( 4)    / 'ANGLE   ' /
      DATA DBEND( 5)    / 'N       ' /
      DATA DBEND( 6)    / 'K1     ' /
      DATA DBEND( 7)    / 'RMPS    ' /
      DATA DBEND( 8)    / 'RNMS    ' /
      DATA DBEND( 9)    / 'VR      ' /
      DATA DBEND(10)    / 'NP      ' /
      DATA DBEND(11)    / 'K1P     ' /
      DATA DBEND(12)    / 'EPS     ' /
      DATA DBEND(13)    / 'K2      ' /
      DATA DBEND(14)    / 'EPSP    ' /
      DATA DBEND(15)    / 'K2P     ' /
      DATA DBEND(16)    / 'EPS3    ' /
      DATA DBEND(17)    / 'K3      ' /
      DATA DBEND(18)    / 'TILT    ' /
      DATA DBEND(19)    / 'TYPE    ' /
C-----------------------------------------------------------------------
      DATA DQUAD( 1)    / 'L       ' /
      DATA DQUAD( 2)    / 'B       ' /
      DATA DQUAD( 3)    / 'APERTURE' /
      DATA DQUAD( 4)    / 'GRADIENT' /
      DATA DQUAD( 5)    / 'K1      ' /
      DATA DQUAD( 6)    / 'TILT    ' /
      DATA DQUAD( 7)    / 'TYPE    ' /
C-----------------------------------------------------------------------
      DATA DUPD ( 1)    / 'NSLIT   ' /
      DATA DUPD ( 2)    / 'HWIDTH  ' /
      DATA DUPD ( 3)    / 'LOCATION' /
      DATA DUPD ( 6)    / 'NSLITO  ' /
      DATA DUPD ( 7)    / 'HHEIGHT ' /
      DATA DUPD ( 4)    / 'R1      ' /
      DATA DUPD ( 5)    / 'R2      ' /
      DATA DUPD ( 8)    / 'X       ' /
      DATA DUPD ( 9)    / 'XP      ' /
      DATA DUPD (10)    / 'Y       ' /
      DATA DUPD (11)    / 'YP      ' /
      DATA DUPD (12)    / 'DL      ' /
      DATA DUPD (13)    / 'DEL     ' /
      DATA DUPD (14)    / 'PARENT  ' /
      DATA DUPD (15)    / 'DAUGHTER1' /
      DATA DUPD (16)    / 'DAUGHTER2' /
C-----------------------------------------------------------------------
      DATA DCENT( 1)    / 'X       ' /
      DATA DCENT( 2)    / 'XP      ' /
      DATA DCENT( 3)    / 'Y       ' /
      DATA DCENT( 4)    / 'YP      ' /
      DATA DCENT( 5)    / 'DL      ' /
      DATA DCENT( 6)    / 'DEL     ' /
C-----------------------------------------------------------------------
      DATA DMIS ( 1)    / 'X       ' /
      DATA DMIS ( 2)    / 'RX      ' /
      DATA DMIS ( 3)    / 'Y       ' /
      DATA DMIS ( 4)    / 'RY      ' /
      DATA DMIS ( 5)    / 'Z       ' /
      DATA DMIS ( 6)    / 'RZ      ' /
      DATA DMIS ( 7)    / 'CODE    ' /
      DATA DMIS ( 8)    / 'REF     ' /
      DATA DMIS ( 9)    / 'LOCATION'/
      DATA DMIS (10)    / 'UNCERTAIN' /
      DATA DMIS (11)    / 'KNOWN   ' /
      DATA DMIS (12)    / 'RANDOM  ' /
      DATA DMIS (13)    / 'BEAM    ' /
      DATA DMIS (14)    / 'TABLE   ' /
      DATA DMIS (15)    / 'SINGLE  ' /
      DATA DMIS (16)    / 'R1      ' /
      DATA DMIS (17)    / 'R2      ' /
      DATA DMIS (18)    / 'MAGNETS ' /
      DATA DMIS (19)    / 'BENDS   ' /
      DATA DMIS (20)    / 'QUADS   ' /
      DATA DMIS (21)    / 'ENTRANCE' /
      DATA DMIS (22)    / 'MIDPOINT' /
      DATA DMIS (23)    / 'EXIT    ' /
      DATA DMIS (24)    / 'CHORD   ' /
      DATA DMIS (25)    / 'TRAJECTORY' /
      DATA DMIS (26)    / 'COMPLETE' /
      DATA DMIS (27)    / 'FOCUS   ' /
C-----------------------------------------------------------------------
      DATA DREPS(1)     / 'N       ' /
C-----------------------------------------------------------------------
      DATA DFIT (1)     / 'I       ' /
      DATA DFIT (2)     / 'J       ' /
      DATA DFIT (3)     / 'VALUE   ' /
      DATA DFIT (4)     / 'TOLERANC' /
      DATA DFIT (5)     / 'NAME    ' /
      DATA DFIT (6)     / 'NONE    ' /
      DATA DFIT (7)     / 'LOCATION' /
      DATA DFIT (8)     / 'LOWER   ' /
      DATA DFIT (9)     / 'UPPER   ' /
      DATA DFIT(10)     / 'SUM     ' /
      DATA DFIT(11)     / 'SUM2    ' /
C-----------------------------------------------------------------------
      DATA DCVTY( 1)    / 'L       ' /
      DATA DCVTY( 2)    / 'VOLT    ' /
      DATA DCVTY( 3)    / 'LAG     ' /
      DATA DCVTY( 4)    / 'WAVELENGTH' /
      DATA DCVTY( 5)    / 'FREQUENCY' /
      DATA DCVTY( 6)    / 'TYPE    ' /
C-----------------------------------------------------------------------
      DATA DCORR( 1)    / 'C21     ' /
      DATA DCORR( 2)    / 'C31     ' /
      DATA DCORR( 3)    / 'C32     ' /
      DATA DCORR( 4)    / 'C41     ' /
      DATA DCORR( 5)    / 'C42     ' /
      DATA DCORR( 6)    / 'C43     ' /
      DATA DCORR( 7)    / 'C51     ' /
      DATA DCORR( 8)    / 'C52     ' /
      DATA DCORR( 9)    / 'C53     ' /
      DATA DCORR(10)    / 'C54     ' /
      DATA DCORR(11)    / 'C61     ' /
      DATA DCORR(12)    / 'C62     ' /
      DATA DCORR(13)    / 'C63     ' /
      DATA DCORR(14)    / 'C64     ' /
      DATA DCORR(15)    / 'C65     ' /
C-----------------------------------------------------------------------
      DATA DPRNT( 1)    / 'NPRINT  ' /
      DATA DPRNT( 2)    / 'LOCATION' /
      DATA DPRNT( 3)    / 'BEAM    ' /
      DATA DPRNT( 4)    / 'TRANS   ' /
      DATA DPRNT( 5)    / 'ALIGN   ' /
      DATA DPRNT( 6)    / 'WAIST   ' /
      DATA DPRNT( 7)    / 'TRAN2   ' /
      DATA DPRNT( 8)    / 'ELEMENTS' /
      DATA DPRNT( 9)    / 'ACCELERA' /
      DATA DPRNT(10)    / 'FLOOR'    /
      DATA DPRNT(11)    / 'PRECISE ' /
      DATA DPRNT(12)    / 'NOPARA  ' /
      DATA DPRNT(13)    / 'ONLY    ' /
      DATA DPRNT(14)    / 'ONELINE ' /
      DATA DPRNT(15)    / 'ON      ' /
      DATA DPRNT(16)    / 'OFF     ' /
      DATA DPRNT(17)    / 'REFER   ' /
      DATA DPRNT(18)    / 'APERTURES' /
      DATA DPRNT(19)    / 'PARENT'   /
      DATA DPRNT(20)    / 'DAUGHTER1' /
      DATA DPRNT(21)    / 'DAUGHTER2' /
      DATA DPRNT(22)    / 'CENTROID' /
      DATA DPRNT(23)    / 'COORDINA' /
      DATA DPRNT(24)    / 'TWISS   ' /
      DATA DPRNT(25)    / 'NARROW  ' /
      DATA DPRNT(26)    / 'ALL     ' /
      DATA DPRNT(27)    / 'MARKERS ' /
      DATA DPRNT(28)    / 'LEVEL   ' /
      DATA DPRNT(29)    / 'R1      ' /
      DATA DPRNT(30)    / 'R2      ' /
      DATA DPRNT(31)    / 'R1INV   ' /
      DATA DPRNT(32)    / 'R2INV   ' /
      DATA DPRNT(33)    / 'BP      ' /
      DATA DPRNT(34)    / 'WARNING ' /
      DATA DPRNT(35)    / 'PARAMETERS'/
      DATA DPRNT(36)    / 'CHARGED ' /
      DATA DPRNT(37)    / 'NEUTRAL ' /
      DATA DPRNT(38)    / 'MAD     ' /
      DATA DPRNT(39)    / 'TRANSPORT'/
      DATA DPRNT(40)    / 'LATDEF' /
      DATA DPRNT(41)    / 'STRUCT' /
      DATA DPRNT(42)    / 'ACAD' /
      DATA DPRNT(43)    / 'FILE' /
C-----------------------------------------------------------------------
      DATA DUNIT( 1)    / 'NUNIT   ' /
      DATA DUNIT( 2)    / 'SIZE   ' /
      DATA DUNIT( 3)    / 'INPUT   ' /
      DATA DUNIT( 4)    / 'OUTPUT  ' /
      DATA DUNIT( 5)    / 'ELEMENT ' /
      DATA DUNIT( 6)    / 'BEAM    ' /
      DATA DUNIT( 7)    / 'FLOOR   ' /
      DATA DUNIT( 8)    / 'ALIGN   ' /
      DATA DUNIT( 9)    / 'X       ' /
      DATA DUNIT(10)    / 'XP      ' /
      DATA DUNIT(11)    / 'DL      ' /
      DATA DUNIT(12)    / 'DEL     ' /
      DATA DUNIT(13)    / 'ANGLE   ' /
      DATA DUNIT(14)    / 'L       ' /
      DATA DUNIT(15)    / 'B       ' /
      DATA DUNIT(16)    / 'MASS    ' /
      DATA DUNIT(17)    / 'P       ' /
      DATA DUNIT(18)    / 'PHASE   ' /
      DATA DUNIT(19)    / 'ROLL    ' /
      DATA DUNIT(20)    / 'V       ' /
      DATA DUNIT(21)    / 'M       ' /
      DATA DUNIT(22)    / 'CM      ' /
      DATA DUNIT(23)    / 'MM      ' /
      DATA DUNIT(24)    / 'MICR    ' /
      DATA DUNIT(25)    / 'FT      ' /
      DATA DUNIT(26)    / 'IN      ' /
      DATA DUNIT(27)    / 'R       ' /
      DATA DUNIT(28)    / 'MR      ' /
      DATA DUNIT(29)    / 'MUR     ' /
      DATA DUNIT(30)    / 'DEG     ' /
      DATA DUNIT(31)    / 'PC      ' /
      DATA DUNIT(32)    / 'PM      ' /
      DATA DUNIT(33)    / 'PMIC    ' /
      DATA DUNIT(34)    / 'N       ' /
      DATA DUNIT(35)    / 'MEV     ' /
      DATA DUNIT(36)    / 'GEV     ' /
      DATA DUNIT(37)    / 'KG      ' /
      DATA DUNIT(38)    / 'G       ' /
      DATA DUNIT(39)    / 'TUNE    ' /
C-----------------------------------------------------------------------
      DATA DSPEC( 1)    / 'N       ' /
      DATA DSPEC( 2)    / 'PARAM   ' /
      DATA DSPEC( 3)    / 'PHASE   ' /
      DATA DSPEC( 4)    / 'EPS     ' /
      DATA DSPEC( 5)    / 'FINT0   ' /
      DATA DSPEC( 6)    / 'PMASS   ' /
      DATA DSPEC( 7)    / 'HWIDTH  ' /
      DATA DSPEC( 8)    / 'HGAP    ' /
      DATA DSPEC( 9)    / 'LENGTH  ' /
      DATA DSPEC(10)    / 'FINT    ' /
      DATA DSPEC(11)    / 'FINT2   ' /
      DATA DSPEC(12)    / 'LDMAX   ' /
      DATA DSPEC(13)    / 'PARAM   ' /
      DATA DSPEC(14)    / 'P0      ' /
      DATA DSPEC(15)    / 'H1      ' /
      DATA DSPEC(16)    / 'H2      ' /
      DATA DSPEC(17)    / 'RANNO   ' /
      DATA DSPEC(18)    / 'FOTILT  ' /
      DATA DSPEC(19)    / 'XBEGIN  ' /
      DATA DSPEC(20)    / 'YBEGIN  ' /
      DATA DSPEC(21)    / 'ZBEGIN  ' /
      DATA DSPEC(22)    / 'YAW     ' /
      DATA DSPEC(23)    / 'PITCH   ' /
      DATA DSPEC(24)    / 'PREF    ' /
      DATA DSPEC(25)    / 'RMPS    ' /
      DATA DSPEC(26)    / 'RNMS    ' /
      DATA DSPEC(27)    / 'VR      ' /
      DATA DSPEC(28)    / 'NP      ' /
      DATA DSPEC(29)    / 'EPSP    ' /
      DATA DSPEC(30)    / 'EPS3    ' /
      DATA DSPEC(31)    / 'QAPA    ' /
      DATA DSPEC(32)    / 'QAPH    ' /
      DATA DSPEC(33)    / 'QAPB    ' /
      DATA DSPEC(34)    / 'LDMIN   ' /
      DATA DSPEC(35)    / 'PARENT  ' /
      DATA DSPEC(36)    / 'DAUGHTER1' /
      DATA DSPEC(37)    / 'DAUGHTER2' /
      DATA DSPEC(38)    / 'CHARGE' /
C-----------------------------------------------------------------------
      DATA DORD(1)      / 'N1      ' /
      DATA DORD(2)      / 'N2      ' /
      DATA DORD(3)      / 'N       ' /
C-----------------------------------------------------------------------
      DATA DSEXT( 1)    / 'L       ' /
      DATA DSEXT( 2)    / 'B       ' /
      DATA DSEXT( 3)    / 'APERTURE' /
      DATA DSEXT( 4)    / 'K2      ' /
      DATA DSEXT( 5)    / 'TILT    ' /
      DATA DSEXT( 6)    / 'TYPE    ' /
C-----------------------------------------------------------------------
      DATA DSOLE( 1)    / 'L       ' /
      DATA DSOLE( 2)    / 'B       ' /
      DATA DSOLE( 3)    / 'KS      ' /
      DATA DSOLE( 4)    / 'TYPE    ' /
C-----------------------------------------------------------------------
      DATA DSROT( 1)    / 'ANGLE   ' /
      DATA DSROT( 2)    / 'TYPE    ' /
C-----------------------------------------------------------------------
      DATA DSECT( 1)    / 'INDEX   ' /
      DATA DSECT( 2)    / 'BEGIN   ' /
      DATA DSECT( 3)    / 'END     ' /
      DATA DSECT( 4)    / 'FORWARD ' /
      DATA DSECT( 5)    / 'BACKWARD' /
C-----------------------------------------------------------------------
      DATA DOCT ( 1)    / 'L       ' /
      DATA DOCT ( 2)    / 'B       ' /
      DATA DOCT ( 3)    / 'APERTURE' /
      DATA DOCT ( 4)    / 'K3      ' /
      DATA DOCT ( 5)    / 'TILT    ' /
      DATA DOCT ( 6)    / 'TYPE    ' /
C-----------------------------------------------------------------------
      DATA DRAN(1)      / 'VARIATION' /
C-----------------------------------------------------------------------
      DATA DETA ( 1)    / 'ETAX    ' /
      DATA DETA ( 2)    / 'DETAX   ' /
      DATA DETA ( 3)    / 'ETAY    ' /
      DATA DETA ( 4)    / 'DETAY   ' /
      DATA DETA ( 5)    / 'ETAL    ' /
      DATA DETA ( 6)    / 'ETAP    ' /
C-----------------------------------------------------------------------
      DATA DRBND( 1)    / 'L       ' /
      DATA DRBND( 2)    / 'B       ' /
      DATA DRBND( 3)    / 'RADIUS  ' /
      DATA DRBND( 4)    / 'ANGLE   ' /
      DATA DRBND( 5)    / 'N       ' /
      DATA DRBND( 6)    / 'K1      ' /
      DATA DRBND( 7)    / 'RMPS    ' /
      DATA DRBND( 8)    / 'RNMS    ' /
      DATA DRBND( 9)    / 'VR      ' /
      DATA DRBND(10)    / 'NP      ' /
      DATA DRBND(11)    / 'K1P     ' /
      DATA DRBND(12)    / 'E1      ' /
      DATA DRBND(13)    / 'E2      ' /
      DATA DRBND(14)    / 'EPS     ' /
      DATA DRBND(15)    / 'K2      ' /
      DATA DRBND(16)    / 'EPSP    ' /
      DATA DRBND(17)    / 'K2P     ' /
      DATA DRBND(18)    / 'H1      ' /
      DATA DRBND(19)    / 'H2      ' /
      DATA DRBND(20)    / 'EPS3    ' /
      DATA DRBND(21)    / 'K3      ' /
      DATA DRBND(22)    / 'HGAP    ' /
      DATA DRBND(23)    / 'FINT    ' /
      DATA DRBND(24)    / 'TILT    ' /
      DATA DRBND(25)    / 'TYPE    ' /
C-----------------------------------------------------------------------
      DATA DHKICK( 1)   / 'L       ' /
      DATA DHKICK( 2)   / 'B       ' /
      DATA DHKICK( 3)   / 'ANGLE   ' /
      DATA DHKICK( 4)   / 'KICK    ' /
      DATA DHKICK( 5)   / 'TILT    ' /
      DATA DHKICK( 6)   / 'TYPE    ' /
C-----------------------------------------------------------------------
      DATA DPLT ( 1)    / 'I1      ' /
      DATA DPLT ( 2)    / 'J1      ' /
      DATA DPLT ( 3)    / 'I2      ' /
      DATA DPLT ( 4)    / 'J2      ' /
      DATA DPLT ( 5)    / 'I3      ' /
      DATA DPLT ( 6)    / 'J3      ' /
      DATA DPLT ( 7)    / 'I4      ' /
      DATA DPLT ( 8)    / 'J4      ' /
      DATA DPLT ( 9)    / 'I5      ' /
      DATA DPLT (10)    / 'J5      ' /
      DATA DPLT (11)    / 'I6      ' /
      DATA DPLT (12)    / 'J6      ' /
      DATA DPLT (13)    / 'I7      ' /
      DATA DPLT (14)    / 'J7      ' /
      DATA DPLT (15)    / 'I8      ' /
      DATA DPLT (16)    / 'J8      ' /
      DATA DPLT (17)    / 'I9      ' /
      DATA DPLT (18)    / 'J9      ' /
      DATA DPLT (19)    / 'I10     ' /
      DATA DPLT (20)    / 'J10     ' /
      DATA DPLT (21)    / 'NAME1   ' /
      DATA DPLT (22)    / 'NAME2   ' /
      DATA DPLT (23)    / 'NAME3   ' /
      DATA DPLT (24)    / 'NAME4   ' /
      DATA DPLT (25)    / 'NAME5   ' /
      DATA DPLT (26)    / 'NAME6   ' /
      DATA DPLT (27)    / 'NAME7   ' /
      DATA DPLT (28)    / 'NAME8   ' /
      DATA DPLT (29)    / 'NAME9   ' /
      DATA DPLT (30)    / 'NAME10  ' /
C-----------------------------------------------------------------------
      DATA DMAGNE( 1)   / 'WIDTH   ' /
      DATA DMAGNE( 2)   / 'HEIGHT  ' /
      DATA DMAGNE( 3)   / 'TYPE    ' /
C-----------------------------------------------------------------------
      DATA DSEPM ( 1)   / 'L       ' /
      DATA DSEPM ( 2)   / 'VOLTAGE ' /
      DATA DSEPM ( 3)   / 'APER    ' /
      DATA DSEPM ( 4)   / 'E       ' /
      DATA DSEPM ( 5)   / 'EOTHER  ' /
      DATA DSEPM ( 6)   / 'OFFSET  ' /
      DATA DSEPM ( 7)   / 'WIRE    ' /
      DATA DSEPM ( 8)   / 'SPACING ' /
      DATA DSEPM ( 9)   / 'RADL    ' /
      DATA DSEPM (10)   / 'TILT    ' /
C-----------------------------------------------------------------------
      DATA DKICK ( 1)   / 'L       ' /
      DATA DKICK ( 2)   / 'HKICK   ' /
      DATA DKICK ( 3)   / 'VKICK   ' /
C-----------------------------------------------------------------------
      DATA DSHIFT( 1)   / 'X       ' /
      DATA DSHIFT( 2)   / 'XP      ' /
      DATA DSHIFT( 3)   / 'Y       ' /
      DATA DSHIFT( 4)   / 'YP      ' /
      DATA DSHIFT( 5)   / 'L       ' /
      DATA DSHIFT( 6)   / 'DEL     ' /
C-----------------------------------------------------------------------
      DATA NELMS  /21, 4, 2,19, 7,16, 6,27, 1,11,
     1              6,15,43,86,39,38, 3, 6, 4, 2,
     2              3, 3, 4, 5, 6, 3, 6,25,25, 1,
     3              1, 2, 2, 7, 6, 6, 4,30, 5, 3,
     4             10, 3, 6, 0, 1, 2, 2, 2/
      DATA NPHST  /23/, NPFLG /13/, NPDCAY /4/
      DATA NPLIN  /1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20/
      DATA NPUPD  /1,2,6,7/
      DATA NPBEND /1,2,5,12,6*0/
      DATA NPRBND /1,2,5,14,6*0/
      DATA NPHKCK /1,2,5,0/
      DATA KELEM /'BEAM    ','ROTATION','DRIFT   ','BEND    ',
     1            'QUADRUPOLE','UPDATE  ','CENTROID','ALIGN   ',
     2            'REPEAT  ','FIT     ','ACCELERATOR','CORRELATION',
     3            'PRINT   ','MATRIX  ','UNITS   ','SPECIAL ',
     4            'ORDER   ','SEXTUPOLE','SOLENOID','SROT    ',
     5            'STRAY   ','DEFRC   ','COMBIN  ','SECTION ',
     6            'OCTUPOLE','RANDOM  ','ETA     ','RBEND   ',
     7            'SBEND   ','PARAMETER','MARKER  ','DUMMY   ',
     8            'STORE   ','PLASMALENS','HKICKER ','VKICKER ',
     9            'ALMARK  ','PLOT    ','LIMIT   ','MAGNET  ',
     A            'SEPTUM  ','KICKER','SHIFT','BROAD',
     B            'HORN    ','HMONITOR','VMONITOR','MONITOR', 
     C            'PHONY   ','HIST    ','AHIST   ', 'DHIST  ',
     D            'FLAG    ','PROFILE', 'DECAY   ','WIGGLER ',
     E            'MULTIPOLE','ELSEPARA','ECOLLIMATOR','RCOLLIMATOR',
     F            'SLIT    ','REALIGN','OBSERVE ','REFERENCE'/
      DATA NXRAN / 0, 7, 1,22, 6, 0, 6, 6, 0, 0,
     1             4, 0, 0, 0, 0, 0, 0, 5, 3, 1,
     2             0, 0, 0, 0, 5, 0, 0,23,23, 0,
     3             0, 0, 0, 5, 0, 0, 0, 0, 0, 0,
     4             0, 0, 6, 0, 0, 1, 1, 1/
      DATA            ALFNUM /'0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ_$%'/
      DATA    PLUS  / '+' /
      DATA    MINUS / '-' /
      DATA    BLANK / ' ' /
      DATA    PERIOD/ '.' /
      DATA SPECL /',;*$"''=/()'/
      DATA SVALUE       /0.0,0.0,0.0,0.0,0.0,
     1                   0.0,0.93827231,0.0,0.0254,0.0/
      DATA UMAD     /1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,
     1               1.0,0.0,1.0,1.0E-3/
      DATA UMETER   /1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,1.0,
     1               1.0,0.0,0.0,1.0E-3/
      DATA UMM      /1.E-3,1.E-3,1.E-3,1.E-3,1.E-3,1.E-3,1.E-3,1.0,
     1               1.0,1.0,1.0,0.0,0.0,1.0E-3/
      DATA UMICR    /1.E-6,1.E-6,1.E-6,1.E-6,1.E-6,1.E-6,1.E-6,1.0,
     1               1.0,1.0,1.0,0.0,0.0,1.0E-3/
      DATA UTRANS   /0.01,1.E-03,0.01,1.E-03,0.01,0.010,0.0,1.0,1.0,
     1               0.0,1.0,0.0,0.0,1.0E-3/
      DATA XMAD     /'M','R','M','R','M','F','R','M','KG','GEV','GEV',
     1               ' ','R','MV'/
      DATA XMETER   /'M','R','M','R','M','R','R','M','KG','GEV','GEV',
     1               'DEG','DEG','MV'/
      DATA XMM      /'MM', 'MR', 'MM', 'MR', 'MM', 'PM', 'MR', 'M',
     1               'KG' ,'GEV', 'GEV', 'DEG', 'DEG', 'MV'/
      DATA XMICR    /'MICR', 'MUR', 'MICR', 'MUR', 'MICR', 'PMIC',
     1               'MUR', 'M','KG' ,'GEV', 'GEV', 'DEG', 'DEG', 'MV'/
      DATA XTRANS   /'CM', 'MR', 'CM', 'MR', 'CM', 'PC', 'DEG', 'M',
     1               'KG' ,'ME', 'GEV', 'DEG', 'DEG', 'MV'/
      END
      SUBROUTINE CNTROL
C
C---- CONTROL ROUTINE FOR "MAD" PROGRAM
C
C     LIST OF COMMON BLOCKS
C
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'CONSTS.CIN'
      INCLUDE 'DATA0A.CIN'
      INCLUDE 'DATA0B.CIN'
      INCLUDE 'DATA1A.CIN'
      INCLUDE 'DATA1C.CIN'
      INCLUDE 'DATA2A.CIN'
      INCLUDE 'DATA2C.CIN'
      INCLUDE 'DATA2D.CIN'
      INCLUDE 'DATUM.CIN'
      INCLUDE 'DPRNT.CIN'
      INCLUDE 'FLUSHC.CIN'
      INCLUDE 'INSERT.CIN'
      INCLUDE 'IODATA.CIN'
      INCLUDE 'IOFLAG.CIN'
      INCLUDE 'IOUNIT.CIN'
      INCLUDE 'LBDAT.CIN'
      INCLUDE 'NDICT.CIN'
      INCLUDE 'NELMS.CIN'
      INCLUDE 'NPLIN.CIN'
      INCLUDE 'OUTFIL.CIN'
      INCLUDE 'PARDAT.CIN'
      INCLUDE 'PARLOC.CIN'
      INCLUDE 'PARVAL.CIN'
      INCLUDE 'PRINTC.CIN'
      INCLUDE 'PRINTL.CIN'
      INCLUDE 'RDCARD.CIN'
      INCLUDE 'RDCHAR.CIN'
      INCLUDE 'RDPRNT.CIN'
      INCLUDE 'RDWRDS.CIN'
      INCLUDE 'UROT.CIN'
      INCLUDE 'VARY.CIN'
      INCLUDE 'VCODE.CIN'
C
C     LOCAL VARIABLES
C
      INTEGER         TEXTP, TEXT
C
      EQUIVALENCE     (NPRNT,NELMS(13))
      EQUIVALENCE     (FAKE,LAKE)
C
      EXTERNAL        IDATA, TEXT
C
C-----------------------------------------------------------------
      ERROR = .FALSE.
C
C     COMMAND LOOP 
C
      IF (NTYPE .EQ. 13) GO TO 1300
      IF (NTYPE .EQ. 30) GO TO 3000
      IF (NTYPE .EQ. 33) GO TO 3300
      IF (NTYPE .EQ. 72) GO TO 7200
      IF (NTYPE .EQ. 73) GO TO 7300
      IF (NTYPE .EQ. 74) GO TO 9000
      IF (NTYPE .EQ. 75) GO TO 7500
      IF (NTYPE .EQ. 76) GO TO 7600
      IF (NTYPE .EQ. 77) GO TO 7700
      IF (NTYPE .EQ. 78) GO TO 7800
      IF (NTYPE .EQ. 79) GO TO 7800
      IF (NTYPE .EQ. 80) GO TO 7800
      IF (NTYPE .EQ. 81) GO TO 8100
      IF (NTYPE .EQ. 82) GO TO 8200
      IF (NTYPE .EQ. 83) GO TO 8300
      IF (NTYPE .EQ. 84) GO TO 8300
      IF (NTYPE .EQ. 85) GO TO 8300
      IF (NTYPE .EQ. 86) GO TO 8300
      IF (NTYPE .EQ. 87) GO TO 8700
C
C---- PHYSICAL ELEMENT DEFINITIONS
C
  100 TEXTP = TEXT(1)
      FILLIT = .FALSE.
      CALL ELMDEF
      IF (ENDFIL) GO TO 9000
      NDICT = NDSAV
      IF (INDS .EQ. 0 .OR. INSERT) THEN
        IF ((FILLIT .OR. .NOT. MADNO) .AND. NTYPE .NE. 1 
     1       .AND. NTYPE .NE. 6 .AND. NTYPE .NE. 53) THEN
          NFILL = NCPARA
          DO 110 J = 1, NFILL
          IF (J .LE. 15) NN = NPORDR(J)
          IF (J .GT. 15) NN = J
          IF (IPTYP(NN) .EQ. 0) THEN
            IPTYP(NN) = 1
            PDATA(NN) = 0.0
          ENDIF
  110     CONTINUE
        ENDIF
C
        NWORD = 1
        NDESC = 0
        LAKE = TEXTP
        DATUM(1) = FAKE
        LABLE = LBDAT
        NDMAX = NDICT
        IF (NTYPE .EQ. 10) NDMAX = 11
        IF (NTYPE .EQ. 39) NDMAX = NDMAX + 2
        IF (NTYPE .EQ. 53) NDMAX = 4
C
        DO 120 J = 1, NDMAX
        IF (IPTYP(J) .NE. 0) THEN
          NWORD = NWORD + 1
          DATUM(NWORD) = PDATA(J)
          IF (VCODE(NWORD) .EQ. 0) VARY(NWORD) = IPDAT(J)
          IF (VCODE(NWORD) .NE. 0) VARY(NWORD) = VCODE(NWORD)
        ENDIF
  120   CONTINUE
C 
        IF (NTYPE .EQ.  8) NDMAX = 9
        IF (NTYPE .EQ. 13) NDMAX = 2
        IF (NTYPE .EQ. 14) NDMAX = 7
        IF (NTYPE .EQ. 15) NDMAX = 8
        IF (NTYPE .EQ. 16) NDMAX = 3
        IF (NTYPE .EQ. 38) NDMAX = 20
        JBASE = 1
        DO 130 J = 1, NDMAX
        IF (IPTYP(J) .NE. 0) THEN
          NDESC = NDESC + JBASE
        ENDIF
        JBASE = 2*JBASE
  130   CONTINUE
C
        CALL ELSTOR
        IF (REMOVE .OR. (INSERT .AND. NINSRT .EQ. 1)) THEN
          INSERT = .FALSE.
          REMOVE = .FALSE.
          CALL INDUCT
        ENDIF
      ELSE
        IF (NTYPE .EQ. 10) THEN
          IF (IPTYP(6) .EQ. -2) GO TO 1000
        ENDIF
        LABLE = LBDAT
        NWORD = 1
        NDMAX = NDICT
        IF (NTYPE .EQ. 39) NDMAX = NDMAX + 2
        DO 160 J = 1, NDMAX
        IF (IPTYP(J) .NE. 0) THEN
          NWORD = NWORD + 1
          DATUM(NWORD) = PDATA(J)
        ENDIF
  160   CONTINUE
        CALL ELMOD
      ENDIF
      GO TO 9000
C
C---- "FIT" --- FIT, NONE
C
 1000 DO 1010 NN = 1, NEL
      II = ISTOR(NN)
      IF (IDATA(II) .EQ. 10) THEN
        LAKE = -10
        DATA(II) = FAKE
      ENDIF
 1010 CONTINUE
      GO TO 9000
C
C---- "PRINT" --- SET PRINT RANGES
C
 1300 CALL DECPAR(NPRNT,DPRNT,1,NPLIN,NPRNT)
      IF (ENDFIL) GO TO 9000
      LABLE = LBDAT
      IF (INDS .EQ. 0 .OR. INSERT) THEN
        NWORD = 2
        NDESC = 1
        IF (LDATA .NE. BLANK) THEN
          NWORD = 3
          NDESC = 3
          CALL FNDELM(LDATA,NLOC,31)
          IF (NLOC .EQ. 0) THEN
            WRITE (NOUT,950)
            NFAIL = NFAIL + 1
            GO TO 9000
          ENDIF
          LLOC = ISTOR(NLOC) + 1
          DATUM(3) = DATA(LLOC)
          VARY(3) = 101
        ENDIF
C
        IF (IPTYP(1) .EQ. 1) THEN
          DATUM(2) = PDATA(1)
          CALL ELSTOR
          GO TO 9000
        ENDIF
C
        IF (ENAME(1:4) .EQ. 'REAL') THEN
          DATUM(2) = 9
          CALL ELSTOR
          GO TO 9000
        ENDIF
C
        IF (ENAME(1:4) .EQ. 'OBSE' .AND. IPTYP(18) .EQ. -2 .AND.
     1      (IPTYP(19) .EQ. -2 .OR. (IPTYP(20) .EQ. 0 .AND.
     2      IPTYP(21) .EQ. 0))) THEN
          DATUM(2) = 10.
          CALL ELSTOR
        ENDIF
C
        IF (ENAME(1:4) .EQ. 'OBSE' .AND. IPTYP(18) .EQ. -2 .AND.
     1      IPTYP(20) .EQ. -2) THEN
          DATUM(2) = 110.
          CALL ELSTOR
        ENDIF
C
        IF (ENAME(1:4) .EQ. 'OBSE' .AND. IPTYP(18) .EQ. -2 .AND.
     1      IPTYP(21) .EQ. -2) THEN
          DATUM(2) = 210.
          CALL ELSTOR
          GO TO 9000
        ENDIF
C
        IF (IPTYP(3) .EQ. -2) THEN
          DATUM(2) = 1
          IF (IPTYP(15) .EQ. -2) DATUM(2) = 3
          IF (IPTYP(16) .EQ. -2) DATUM(2) = 2
          CALL ELSTOR
        ENDIF
C
        IF (IPTYP(4) .EQ. -2 .OR. IPTYP(29) .EQ. -2) THEN
          DATUM(2) = 4
          IF (IPTYP(15) .EQ. -2) DATUM(2) = 6
          IF (IPTYP(16) .EQ. -2) DATUM(2) = 5
          CALL ELSTOR
        ENDIF
C
        IF (IPTYP(22) .EQ. -2) THEN
          DATUM(2) = 37
          IF (IPTYP(15) .EQ. -2) DATUM(2) = 39
          IF (IPTYP(16) .EQ. -2) DATUM(2) = 38
          CALL ELSTOR
        ENDIF
C
        IF (IPTYP(5) .EQ. -2) THEN
          DATUM(2) = 8
          CALL ELSTOR
        ENDIF
C
        IF (IPTYP(6) .EQ. -2) THEN
          DATUM(2) = 14
          CALL ELSTOR
        ENDIF
C
        IF (IPTYP(7) .EQ. -2 .OR. IPTYP(30) .EQ. -2) THEN
          DATUM(2) = 24
          CALL ELSTOR
        ENDIF
C
        IF (IPTYP(8) .EQ. -2
     1      .AND. (IPTYP(15) .EQ. -2 .OR. IPTYP(16) .EQ. 0)) THEN
          DATUM(2) = 27
          CALL ELSTOR
        ENDIF
C
        IF (IPTYP(8) .EQ. -2 .AND. IPTYP(16) .EQ. -2) THEN
          DATUM(2) = 26
          CALL ELSTOR
        ENDIF
C
        IF (IPTYP(9) .EQ. -2) THEN
          DATUM(2) = 7
          CALL ELSTOR
        ENDIF
C
        IF (IPTYP(10) .EQ. -2 .OR. IPTYP(23) .EQ. -2) THEN
          DATUM(2) = 12
          CALL ELSTOR
        ENDIF
C
        IF (IPTYP(11) .EQ. -2) THEN
          DATUM(2) = 16
          CALL ELSTOR
        ENDIF
C
        IF (IPTYP(12) .EQ. -2) THEN
          DATUM(2) = 17
          CALL ELSTOR
        ENDIF
C
        IF (IPTYP(13) .EQ. -2) THEN
          DATUM(2) = 18
          CALL ELSTOR
        ENDIF
C
        IF (IPTYP(14) .EQ. -2) THEN
          DATUM(2) = 19
          CALL ELSTOR
        ENDIF
C
        IF (IPTYP(17) .EQ. -2) THEN
          DATUM(2) = 13
          CALL ELSTOR
        ENDIF
C
        IF (IPTYP(24) .EQ. -2) THEN
          DATUM(2) = 51
          IF (IPTYP(15) .EQ. -2) DATUM(2) = 53
          IF (IPTYP(16) .EQ. -2) DATUM(2) = 52
          CALL ELSTOR
        ENDIF
C
        IF (IPTYP(25) .EQ. -2) THEN
          DATUM(2) = 15
          CALL ELSTOR
        ENDIF
C
        IF (IPTYP(26) .EQ. -2 .AND. 
     1      (IPTYP(15) .EQ. -2 .OR. IPTYP(16) .EQ. 0)) THEN
          DATUM(2) = 50
          CALL ELSTOR
        ENDIF
C
        IF (IPTYP(26) .EQ. -2 .AND. IPTYP(16) .EQ. -2) THEN          
          DATUM(2) = 49
          CALL ELSTOR
        ENDIF
C
        IF (IPTYP(27) .EQ. -2) THEN
          DATUM(2) = 44
          CALL ELSTOR
        ENDIF
C           
        IF (IPTYP(28) .EQ. -2) THEN
          DATUM(2) = 11
          CALL ELSTOR
        ENDIF
C
        IF (IPTYP(31) .EQ. -2) THEN
          DATUM(2) = -4
          CALL ELSTOR
        ENDIF
C
        IF (IPTYP(32) .EQ. -2) THEN
          DATUM(2) = -24
          CALL ELSTOR
        ENDIF
C
        IF (IPTYP(33) .EQ. -2) THEN
          DATUM(2) = 28
          CALL ELSTOR
        ENDIF
C
        IF (IPTYP(16) .EQ. -2 .AND. IPTYP(34) .EQ. -2) THEN
          DATUM(2) = 45
          CALL ELSTOR
        ENDIF
C
        IF (IPTYP(15) .EQ. -2 .AND. IPTYP(34) .EQ. -2) THEN
          DATUM(2) = 46
          CALL ELSTOR
        ENDIF
C
        IF (IPTYP(15) .EQ. -2 .AND. IPTYP(35) .EQ. -2) THEN
          DATUM(2) = 54
          CALL ELSTOR
        ENDIF
C
        IF (IPTYP(16) .EQ. -2 .AND. IPTYP(35) .EQ. -2) THEN
          DATUM(2) = 55
          CALL ELSTOR
        ENDIF
C
        IF (IPTYP(38) .EQ. -2) THEN
          MADL = .TRUE.
          MADFILE = OUTFIL
          LMADF = LOUTF
        ENDIF
C
        IF (IPTYP(39) .EQ. -2) THEN
          TRANSPORTL = .TRUE.
          TRANSPORTFILE = OUTFIL
          LTRANSPORTF = LOUTF
        ENDIF
C
        IF (IPTYP(40) .EQ. -2) THEN
          LATDEFL = .TRUE.
          LATDEFFILE = OUTFIL
          LLATDEFF = LOUTF
        ENDIF
C
        IF (IPTYP(41) .EQ. -2) THEN
          STRUCTL = .TRUE.
          STRUCTFILE = OUTFIL
          LSTRUCTF = LOUTF
        ENDIF
C
        IF (IPTYP(42) .EQ. -2) THEN
          ACADL = .TRUE.
          ACADFILE = OUTFIL
          LACADF = LOUTF
        ENDIF
C
        IF (IPTYP(43) .EQ. -2) THEN
          FILEL = .TRUE.
        ENDIF
C
        IF (REMOVE .OR. (INSERT .AND. NINSRT .EQ. 1)) THEN
          INSERT = .FALSE.
          REMOVE = .FALSE.
          CALL INDUCT
        ENDIF
C           
      ELSE   
        NDSAV = 1
        NPARMS = 1
        CALL ELMOD
      ENDIF
      GO TO 9000
C
C---- "PARAMETER" --- DEFINE PARAMETER
C
 3000 CALL PARAM
      IF (ENDFIL) GO TO 9000
      NDESC = 1
      LAKE = 30
      DATUM(1) = FAKE
      LABLE = LBDAT
      IF (INDS .EQ. 0 .OR. INSERT) THEN
        IF (IOPER .GE. 1) THEN
          NWORD = NPVAR + 2
          VARY(2) = 99
          IADR = ISTOR(NEL) + 4
          LAKE = I + 1
          DATA(IADR) = FAKE
          TIE(IADR) = 100
          CALL ELSTOR
        ELSE
          IF (IPDAT(1) .EQ. 100) THEN
            DATUM(2) = PDATA(1)
            VARY(2) = 100
            CALL ELSTOR
          ELSE
            LABEL(NEL) = LABLE
            IADR = ISTOR(NEL) + 1
            TIE(IADR) = VCODE(2)
          ENDIF
        ENDIF
      ELSE
        IF (NWORD .EQ. 2) THEN
          DATUM(2) = PDATA(1)
          IF (IPDAT(1) .EQ. 100) VCODE(2) = 100
        ENDIF
        NPARMS = 1
        CALL ELMOD
      ENDIF
      GO TO 9000
C
C---- "STORE" --- STORE MATRIX ELEMENT OR ALGEBRAIC COMBINATION
C
 3300 CALL PARAM
      IF (ENDFIL) GO TO 9000
      IF (INDS .EQ. 0 .OR. INSERT) THEN
        NWORD = NPVAR + 2
        NDESC = 1
        LAKE = 30
        DATUM(1) = FAKE
        VARY(2) = 99
        IF (IOPER .EQ. 1) ID = 4
        IF (IOPER .EQ. 0) ID = 3
        IADR = ISTOR(NEL) + ID
        LAKE = I + 1
        DATA(IADR) = FAKE
        TIE(IADR) = 100
        CALL ELSTOR
      ELSE
        CALL ELMOD
      ENDIF
      LAKE = 33
      DATUM(1) = FAKE
      LAKE = ISTOR(NEL) + 1
      DATUM(2) = FAKE
      VARY(2) = 100
      LABLE = LBDAT
      NWORD = 2
      NDESC = 1
      IF (LDATA .NE. BLANK) THEN
        CALL FNDELM(LDATA,NLOC,31)
        LLOC = ISTOR(NLOC) + 1
        NWORD = 3
        NDESC = 3
        DATUM(3) = DATA(LLOC)
        VARY(3) = 101
      ENDIF
      CALL ELSTOR
      GO TO 9000
C
C---- "LINE" --- DEFINE BEAM LINE
C
 7200 CALL LINE
      GO TO 9000
C
C---- "SENTINEL" --- TERMINATE READING OF DATA AND RUN THROUGH BEAM LINE
C
 7300 GO TO 9000
C
C---- "USE" --- DEFINE SUPERPERIOD
C
 7500 CALL USE
      GO TO 9000
C
C---- "VARY" -- VARY PARAMETERS
C
 7600 CALL VARY1(1)
      GO TO 9000
C
C---- "FIX" -- FIX PARAMETERS
C
 7700 CALL VARY1(0)
      GO TO 9000
C
C---- "BEFORE", "AFTER", AND "REMOVE" -- EDITING OF DECK
C
 7800 INSERT = NTYPE .EQ. 78 .OR. NTYPE .EQ. 79
      REMOVE = NTYPE .EQ. 80
      BEFI = NTYPE .EQ. 78
      CALL EDIT
      GO TO 9000
C
C---- "ENDINSERT" -- END OF INSERTED ELEMENTS
C
 8100 INSERT = .FALSE.
      CALL INDUCT
      GO TO 9000
C
C---- "MAD" UNITS
C
 8200 NWORD = 1
      NDESC = 0
      LAKE = NTYPE
      DATUM(1) = FAKE
      UROT = 1.0
      CALL ELSTOR
      GO TO 9000
C
C---- "TRANSPORT" UNITS
C
 8300 NWORD = 1
      NDESC = 0
      LAKE = NTYPE
      DATUM(1) = FAKE
      UROT = 1.0/RADIAN
      CALL ELSTOR
      GO TO 9000
C
C---- STEP SOME PARAMETER
C
 8700 LAKE = NTYPE
      DATUM(1) = FAKE
      CALL RDSTEP
      GO TO 9000        
C
C-----------------------------------------------------------------------
C
 9000 CONTINUE
      RETURN
C-----------------------------------------------------------------------
  930 FORMAT(' ** WARNING ** ELEMENT NOT IMPLEMENTED --- ',
     +       'TREATED LIKE A "SBEND" WITH EDGE ANGLES'/' ')
  940 FORMAT(' *** ERROR *** COMMAND KEYWORD EXPECTED'/' ')
  950 FORMAT (' *** MARKER NOT FOUND FOR MARKER REFERENCE ***')
C-----------------------------------------------------------------------
      END
      SUBROUTINE CODEIT
C
C---- DETERMINE INTERNALLY STORED MISALIGNMENT CODE FROM MNEMONICS
C-----------------------------------------------------------------------
C
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'DATA0A.CIN'
      INCLUDE 'DATA1A.CIN'
      INCLUDE 'DATA2A.CIN'
      INCLUDE 'DATA1C.CIN'
      INCLUDE 'LBDAT.CIN'
      INCLUDE 'PARDAT.CIN'
      INCLUDE 'PARVAL.CIN'
      INCLUDE 'RDPRNT.CIN'
      INCLUDE 'RDWRDS.CIN'
      INTEGER         CODE, CODE1, CODE2, CODE3
      INTEGER         REF, REF1, REF2, REF3
      LOGICAL         NEWC, NEWR
C
C     DETERMINE PREVIOUS ALIGNMENT CODE
C
      NEWC = .FALSE.
      NEWR = .FALSE.
      IF (INDS .EQ. 0) THEN
        IF (IPTYP(7) .EQ. 0) THEN
          CODE = 0
        ELSE
          CODE = IFIX(PDATA(7))
        ENDIF
      ELSE 
        IF (IPTYP(7) .EQ. 0) THEN
          DO 10 NUM = 1, NEL
          IF (LABEL(NUM) .EQ. LBDAT) THEN
            I = ISTOR(NUM)
            GO TO 20
          ENDIF
   10     CONTINUE
   20     CODE = IFIX(DATA(I+7))
        ELSE
          CODE = IFIX(PDATA(7))
        ENDIF
      ENDIF
      CODE1 = CODE/100
      CODE2 = MOD(CODE/10,10)
      CODE3 = MOD(CODE,10)
      IF (INDS .EQ. 0) THEN
        REF = 0
      ELSE IF (IPTYP(8) .EQ. 1) THEN
        REF = IFIX(PDATA(8))
      ELSE
        REF = IFIX(DATA(I+8))
      ENDIF
      REF1 = REF/100
      REF2 = MOD(REF/10,10)
      REF3 = MOD(REF,10)
C
C     DETERMINE NEW ALIGNMENT CODE FROM KEYWORDS
C
      IF (IPTYP(10) .EQ. -2) THEN
        CODE1 = 0
        IPTYP(10) = 0
        NEWC = .TRUE.
      ENDIF
      IF (IPTYP(11) .EQ. -2) THEN
        CODE1 = 1
        IPTYP(11) = 0
        NEWC = .TRUE.
      ENDIF
      IF (IPTYP(12) .EQ. -2) THEN
        CODE1 = 2
        IPTYP(12) = 0
        NEWC = .TRUE.
      ENDIF
      IF (IPTYP(13) .EQ. -2) THEN
        CODE2 = 0
        IPTYP(13) = 0
        NEWC = .TRUE.
      ENDIF
      IF (IPTYP(14) .EQ. -2) THEN
        CODE2 = 1
        IPTYP(14) = 0
        NEWC = .TRUE.
      ENDIF
      IF (IPTYP(15) .EQ. -2) THEN
        CODE3 = 0
        IPTYP(15) = 0
        NEWC = .TRUE.
      ENDIF
      IF (IPTYP(16) .EQ. -2) THEN
        CODE3 = 1
        IPTYP(16) = 0
        NEWC = .TRUE.
      ENDIF
      IF (IPTYP(17) .EQ. -2) THEN
        CODE3 = 2
        IPTYP(17) = 0
        NEWC = .TRUE.
      ENDIF
      IF (IPTYP(18) .EQ. -2) THEN
        CODE3 = 3
        IPTYP(18) = 0
        NEWC = .TRUE.
      ENDIF
      IF (IPTYP(19) .EQ. -2) THEN
        CODE3 = 4
        IPTYP(19) = 0
        NEWC = .TRUE.
      ENDIF
      IF (IPTYP(20) .EQ. -2) THEN
        CODE3 = 5
        IPTYP(20) = 0
        NEWC = .TRUE.
      ENDIF
      CODE = 100*CODE1 + 10*CODE2 + CODE3
      IF (NEWC) THEN
        IPTYP(7) = 1
        PDATA(7) = FLOAT(CODE)
      ENDIF
C
C     DETERMINE NEW ALIGNMENT REFERENCE CODE FROM KEYWORDS
C
      IF (IPTYP(21) .EQ. -2) THEN
        REF1 = 0
        IPTYP(21) = 0
        NEWR = .TRUE.
      ENDIF
      IF (IPTYP(22) .EQ. -2) THEN
        REF1 = 1
        IPTYP(22) = 0
        NEWR = .TRUE.
      ENDIF
      IF (IPTYP(23) .EQ. -2) THEN
        REF1 = 2
        IPTYP(23) = 0
        NEWR = .TRUE.
      ENDIF
      IF (IPTYP(24) .EQ. -2) THEN
        REF2 = 0
        IPTYP(24) = 0
        NEWR = .TRUE.
      ENDIF
      IF (IPTYP(25) .EQ. -2) THEN
        REF2 = 1
        IPTYP(25) = 0
        NEWR = .TRUE.
      ENDIF
      IF (IPTYP(26) .EQ. -2) THEN
        REF3 = 0
        IPTYP(26) = 0
        NEWR = .TRUE.
      ENDIF
      IF (IPTYP(27) .EQ. -2) THEN
        REF3 = 1
        IPTYP(27) = 0
        NEWR = .TRUE.
      ENDIF
      REF = 100*REF1 + 10*REF2 + REF3
C 
      IF (NEWR) THEN
        IPTYP(8) = 1
        PDATA(8) = FLOAT(REF)
      ENDIF
      NWORD = 9
C
      RETURN
      END
      SUBROUTINE DECARB(INAME)
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'ELM14A.CIN'
      INCLUDE 'KELEM.CIN'
      INCLUDE 'KNAME.CIN'
      INCLUDE 'LNAME.CIN'
      INCLUDE 'PARDAT.CIN'
      INCLUDE 'PARVAL.CIN'
C
      CALL FNMTX(KNAME,LNAME,INAME)
      IPTYP(7) = 1
      PDATA(7) = FLOAT(J1)
      IF (IPARM .GE. 8) THEN
        IPTYP(8) = 1
        PDATA(8) = 0.0
      ENDIF
      IF (IPARM .GE. 30) THEN
        IPTYP(30) = 1
        PDATA(30) = 0.0
      ENDIF
      RETURN
      END
      SUBROUTINE DECEXP
C---- DECODE A PARAMETER EXPRESSION
C-----------------------------------------------------------------------
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'DATA1A.CIN'
      INCLUDE 'DATA2A.CIN'
      INCLUDE 'DATUM.CIN'
      INCLUDE 'ICODE.CIN'
      INCLUDE 'INDPAR.CIN'
      INCLUDE 'INSERT.CIN'
      INCLUDE 'IODATA.CIN'
      INCLUDE 'IOFLAG.CIN'
      INCLUDE 'IOUNIT.CIN'
      INCLUDE 'ISEEDX.CIN'
      INCLUDE 'NUMREP.CIN'
      INCLUDE 'PARDAT.CIN'
      INCLUDE 'PARVAL.CIN'
      INCLUDE 'RDBUFF.CIN'
      INCLUDE 'RDCARD.CIN'
      INCLUDE 'RDCHAR.CIN'
      INCLUDE 'RDPRNT.CIN'
      INCLUDE 'RDWRDS.CIN'
      INCLUDE 'STACK.CIN'
      INCLUDE 'SVALUE.CIN'
C-----------------------------------------------------------------------
      PARAMETER       (NFUN = 10)
      CHARACTER*15    KFUN(NFUN), KPARA, SYMBOL(NSYM)
      CHARACTER*15    KNAME
      LOGICAL         FLAG, HELEM
      EQUIVALENCE     (IVSAV,VSAV), (FAKE,LAKE)
C-----------------------------------------------------------------------
      DATA KFUN(1)      / 'NEG     ' /
      DATA KFUN(2)      / 'SQRT    ' /
      DATA KFUN(3)      / 'LOG     ' /
      DATA KFUN(4)      / 'EXP     ' /
      DATA KFUN(5)      / 'SIN     ' /
      DATA KFUN(6)      / 'COS     ' /
      DATA KFUN(7)      / 'SINH    ' /
      DATA KFUN(8)      / 'COSH    ' /
      DATA KFUN(9)      / 'ASIN    ' /
      DATA KFUN(10)     / 'ACOS    ' /
C-----------------------------------------------------------------------
      DATA SYMBOL(1)    / 'PI      ' /
      DATA SYMBOL(2)    / 'TWOPI   ' /
      DATA SYMBOL(3)    / 'DEGRAD  ' /
      DATA SYMBOL(4)    / 'RADDEG  ' /
      DATA SYMBOL(5)    / 'E       ' /
      DATA SYMBOL(6)    / 'EMASS   ' /
      DATA SYMBOL(7)    / 'PMASS   ' /
      DATA SYMBOL(8)    / 'CLIGHT  ' /
      DATA SYMBOL(9)    / 'MTOIN   ' /
      DATA SYMBOL(10)   / 'INTOM   ' /
C-----------------------------------------------------------------------
      ERROR = .FALSE.
C
C---- CLEAR STACK
C
      LEV = 1
      IOPER = 0
      IOP(1) = 0
C
C---- EXPRESSION -------------------------------------------------------
C
      CALL RDNEXT
      IF (ENDFIL) GO TO 700
C
C---- LEFT PARENTHESIS?
C
      IF (ITEM .EQ. '(') THEN
        CALL RDNEXT
        IF (ENDFIL) GO TO 700
        LEV = LEV + 1
        IOP(LEV) = 10
      ENDIF
C
C---- UNARY "+" OR "-"?
C
  100 IF (ITEM .EQ. '+') THEN
        CALL RDNEXT
        IF (ENDFIL) GO TO 700
      ELSE IF (ITEM .EQ. '-') THEN
        CALL RDNEXT
        IF (ENDFIL) GO TO 700
        LEV = LEV + 1
        IOP(LEV) = 12
      ENDIF
C
C---- FACTOR OR TERM ---------------------------------------------------
C---- EXPRESSION IN BRACKETS?
C
  200 IF (ITEM .EQ. '(') THEN
        CALL RDNEXT
        IF (ENDFIL) GO TO 700
        LEV = LEV + 1
        IOP(LEV) = 10
        GO TO 100
C
C---- FUNCTION OR PARAMETER NAME?
C
      ELSE IF (INDEX(ALPHA,ITEM) .NE. 0) THEN
        CALL RDWORD(KNAME,LNAME)
C
C---- FUNCTION?
C
        CALL RDNEXT
        IF (ENDFIL) GO TO 700
        IF (ITEM .EQ. '(') THEN
          CALL RDLOOK(KNAME,LNAME,KFUN,1,NFUN,IFUN)
          IF (IFUN .EQ. 0) THEN
            CALL RDFAIL
            WRITE (NOUT,910) KNAME(1:LNAME)
            GO TO 800
          ENDIF
          CALL RDNEXT
          IF (ENDFIL) GO TO 700
          LEV = LEV + 1
          IOP(LEV) = IFUN + 11
          LEV = LEV + 1
          IOP(LEV) = 10
          GO TO 100
C
C---- ELEMENT PARAMETER?
C
        ELSE IF (ITEM .EQ. '[') THEN
          CALL FNDLAB(KNAME,NELMN)
          IF (NELMN .EQ. 0) THEN
            NWORD = 2
            LAKE = 55
            DATUM(1) = FAKE
            LABLE = KNAME
            CALL ELSTOR
            IVAL(LEV) = ISTOR(NEL) + 1
            IREF(LEV) = 100
            IPDAT(IPARM) = 100
          ENDIF
          CALL RDNEXT
          IF (ENDFIL) GO TO 700
          CALL RDWORD(KPARA,LPARA)
          IF (LPARA .EQ. 0) THEN
            CALL RDFAIL
            WRITE (NOUT,930) 
            GO TO 800
          ENDIF
          CALL RDNEXT
          IF (ENDFIL) GO TO 700
          CALL RDTEST(']',FLAG)
          IF (FLAG) GO TO 800
          IF (NELMN .NE. 0) THEN
            IST = ISTOR(NELMN)
            NTYPE = IDATA(IST)
            CALL RDPARS(KPARA,LPARA,IEP)
          ELSE
            IEP = 0
          ENDIF
          IF (IEP .EQ. 0) THEN
            NWORD = 2
            LAKE = 56
            DATUM(1) = FAKE
            LABLE = KPARA
            CALL ELSTOR
            IVAL(LEV) = ISTOR(NEL) + 1
            IREF(LEV) = 100
          ELSE
            CALL 	SKETCH(NELMN)
            IVAL(LEV) = IST + IPTOJ(IEP)
            IREF(LEV) = 100
          ENDIF
          LAKE = IVAL(LEV)
          PDATA(IPARM) = FAKE
          IPDAT(IPARM) = 100
C
C---- GLOBAL PARAMETER
C
        ELSE
          CALL RDBACK
          HELEM = .FALSE.
          IF ((NTYPE .EQ. 10 .AND. IPARM .EQ. 5)
     1      .OR. NTYPE .EQ. 33 .OR. NTYPE .EQ. 38
     2      .OR. NTYPE .EQ. 50 .OR. NTYPE .EQ. 51 .OR. NTYPE .EQ. 52)
     3      HELEM = .TRUE.
          IF (.NOT. HELEM) THEN
            CALL FNDELM(KNAME,NVAL,30)
            IF (NVAL .NE. 0) THEN
              IVAL(LEV) = ISTOR(NVAL) + 1
              IREF(LEV) = 100
              IPDAT(IPARM) = 100
              GO TO 280
            ENDIF
            CALL FNDNAM(KNAME,LNAME,INAME)
            IF (INAME .NE. 0) THEN
              CALL FITDEF
              GO TO 280
            ENDIF
            CALL FNDELM(KNAME,NNAME,33)
            IF (NNAME .NE. 0) THEN
              INAME = ISTOR(NNAME-1) + 1
              IVAL(LEV) = INAME
              IREF(LEV) = 100
              IPDAT(IPARM) = 100
              GO TO 280
            ENDIF
            CALL RDLOOK(KNAME,LNAME,SYMBOL,1,NSYM,ISYM)
            IF (ISYM .NE. 0) THEN
              VALUE = SVALUE(ISYM)
              CALL PARCON(IVAL(LEV),VALUE)
              IREF(LEV) = 100
              GO TO 280
            ENDIF
            CALL FNDELM(KNAME,NVAL,49)
            IF (NVAL .NE. 0) THEN
              IVAL(LEV) = ISTOR(NVAL) + 1
              IREF(LEV) = 100
              IPDAT(IPARM) = 100
              GO TO 280
            ENDIF
            NWORD = 2
            LAKE = 49
            DATUM(1) = FAKE
            DATUM(2) = 0.0
            LABLE = KNAME
            CALL ELSTOR
            LABLE = ' '
            IVAL(LEV) = ISTOR(NEL) + 1
            IREF(LEV) = 100
            IPDAT(IPARM) = 100
            GO TO 280
          ELSE
            CALL FNDNAM(KNAME,LNAME,INAME)
            IF (INAME .NE. 0) THEN
              CALL FITDEF
              GO TO 250
            ENDIF
            CALL FNDELM(KNAME,NNAME,33)
            IF (NNAME .NE. 0) THEN
              INAME = ISTOR(NNAME-1) + 1
              ICODE = 9
              JCODE = INAME
              IF (INAME .EQ. 0) GO TO 250
              IVAL(LEV) = INAME
              IREF(LEV) = 100
              IPTYP(IPARM) = 3
              GO TO 250
            ENDIF
            CALL FNDELM(KNAME,NVAL,30)
            IF (NVAL .NE. 0) THEN
              IVAL(LEV) = ISTOR(NVAL) + 1
              IREF(LEV) = 100
              IPDAT(IPARM) = 100
              GO TO 250
            ENDIF
            CALL RDLOOK(KNAME,LNAME,SYMBOL,1,NSYM,ISYM)
            IF (ISYM .NE. 0) THEN
              VALUE = SVALUE(ISYM)
              CALL PARCON(IVAL(LEV),VALUE)
              IREF(LEV) = 100
              GO TO 250
            ENDIF
C
  250       IF (IVAL(LEV) .EQ. 0) THEN
              CALL FNDELM(KNAME,NVAL,30)
              IVAL(LEV) = ISTOR(NVAL) + 1
              IREF(LEV) = 100
              IPDAT(IPARM) = 100
            ENDIF
          ENDIF
  280     LAKE = IVAL(LEV)
          PDATA(IPARM) = FAKE
          IPDAT(IPARM) = IREF(LEV)
        ENDIF
C
C---- NUMERIC VALUE?
C
      ELSE IF (INDEX('0123456789.',ITEM) .NE. 0) THEN
        CALL RDNUMB(VALUE,IVALUE,FLAG)
        IF (ENDFIL) GO TO 700 
        IF (FLAG) GO TO 800
        IF (IOP(LEV) .EQ. 12) THEN
          VALUE = - VALUE
          LEV = LEV - 1
        ENDIF
        IF (INDS .EQ. 0 .OR. INSERT) THEN
          IF (NTYPE .EQ. 16 .AND. IPARM .EQ. 17) THEN
            IVSAV = IVALUE
            VALUE = VSAV
            CALL SEEDIT
          ENDIF
          CALL PARCON(IVAL(LEV),VALUE)
          IREF(LEV) = 100
        ELSE
          IF (NTYPE .EQ. 16 .AND. IPARM .EQ. 17) THEN
            LAKE = IVALUE
            PDATA(IPARM) = FAKE
          ELSE
            PDATA(IPARM) = VALUE
          ENDIF
          IPTYP(IPARM) = 1
        ENDIF
C
C---- ANYTHING ELSE
C
      ELSE
        CALL RDFAIL
        WRITE (NOUT,950)
        GO TO 800
      ENDIF
C
C---- UNSTACK UNARY OPERATORS
C
  300 IF (IOP(LEV) .GT. 10) CALL OPDEF
C
C---- UNSTACK MULTIPLY OPERATORS
C
      IF (IOP(LEV) .EQ. 3 .OR. IOP(LEV) .EQ. 4) CALL OPDEF
C
C---- TEST FOR MULTIPLY OPERATORS
C
      CALL RDNEXT
      IF (ENDFIL) GO TO 700
      IF (ITEM .EQ. '*') THEN
        CALL RDNEXT
        IF (ENDFIL) GO TO 700
        LEV = LEV + 1
        IOP(LEV) = 3
        GO TO 200
      ELSE IF (ITEM .EQ. '/') THEN
        CALL RDNEXT
        IF (ENDFIL) GO TO 700
        LEV = LEV + 1
        IOP(LEV) = 4
        GO TO 200
      ENDIF
C
C---- UNSTACK ADDING OPERATORS
C
      IF (IOP(LEV) .EQ. 1 .OR. IOP(LEV) .EQ. 2) CALL OPDEF
C
C---- TEST FOR ADDING OPERATORS
C
      IF (ITEM .EQ. '+') THEN
        CALL RDNEXT
        IF (ENDFIL) GO TO 700
        LEV = LEV + 1
        IOP(LEV) = 1
        GO TO 200
      ELSE IF (ITEM .EQ. '-') THEN
        CALL RDNEXT
        IF (ENDFIL) GO TO 700
        LEV = LEV + 1
        IOP(LEV) = 2
        GO TO 200
      ENDIF
C
C---- UNSTACK PARENTHESES
C
      IF (LEV .NE. 1) THEN
        IF (ITEM .EQ. ')') THEN
          IF (LEV .GE. 2) THEN
            IF (IOP(LEV) .EQ. 10 .AND. IOP(LEV-1) .GT. 10) THEN
              IOPT = IOP(LEV)
              IOP(LEV) = IOP(LEV-1)
              IOP(LEV-1) = IOPT
              CALL OPDEF
            ENDIF
          ENDIF
          LEV = LEV - 1
          IVAL(LEV) = IVAL(LEV+1)
          IREF(LEV) = IREF(LEV+1)
          GO TO 300
        ELSE
          CALL RDFAIL
          WRITE (NOUT,960)
          GO TO 800
        ENDIF
      ELSE IF (ITEM .EQ. ')') THEN
        CALL RDFAIL
        WRITE (NOUT,970)
        GO TO 800
      ENDIF
C
C---- DISCARD UNNEEDED TEMPORARY
C
      CALL RDBACK
  700 GO TO 900
C
C---- ERROR EXIT --- LEAVE PARAMETER UNDEFINED
C
  800 IPTYP(IPARM) = -1
      PDATA(IPARM) = 0.0
      ERROR = .TRUE.
  900 CONTINUE
      RETURN
C-----------------------------------------------------------------------
  910 FORMAT (' *** ERROR *** UNKNOWN FUNCTION "',A,'"'/' ')
  930 FORMAT (' *** ERROR *** PARAMETER KEYWORD EXPECTED'/' ')
  940 FORMAT (' *** ERROR *** UNKNOWN ELEMENT PARAMETER "',A,'[',A,']"'/
     +       ' ')
  950 FORMAT (' *** ERROR *** OPERAND MUST BE NUMBER, PARAMETER NAME,',
     +       ' FUNCTION CALL, OR EXPRESSION IN "()"'/' ')
  960 FORMAT (' *** ERROR *** RIGHT PARENTHESIS MISSING'/' ')
  970 FORMAT (' *** ERROR *** UNBALANCED RIGHT PARENTHESIS'/' ')
  980 FORMAT (' *** ERROR *** UNKNOWN PARAMETER "',A,'"'/' ')
C-----------------------------------------------------------------------
      END
      SUBROUTINE DECFIT(INAME,INAMS)
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'ICODE.CIN'
      INCLUDE 'KNAME.CIN'
      INCLUDE 'LNAME.CIN'
      INCLUDE 'PARDAT.CIN'
      INCLUDE 'PARVAL.CIN'
      INCLUDE 'RDWRDS.CIN'
C
      IPARM = 0
      CALL FNDNAM(KNAME,LNAME,INAME)
      IF (INAME .NE. 0) THEN
        PDATA(INAMS) = FLOAT(ICODE)
        IPTYP(INAMS) = 1
        PDATA(INAMS+1) = FLOAT(JCODE)
        IPTYP(INAMS+1) = 1
        INAMS = INAMS + 2
        IPARM = 3
      ENDIF
C
  100 RETURN
      END
      SUBROUTINE DECFRM
C---- DECODE FORMAL ARGUMENT LIST
C-----------------------------------------------------------------------
      INCLUDE 'FORCNT.CIN'
      INCLUDE 'FORDAT.CIN'
      INCLUDE 'IODATA.CIN'
      INCLUDE 'IOFLAG.CIN'
      INCLUDE 'RDBUFF.CIN'
C-----------------------------------------------------------------------
      CHARACTER*15    KNAME
      LOGICAL         FLAG
C-----------------------------------------------------------------------
      DATA MXFORM /20/
C
      ERROR = .FALSE.
      NFORM = 0
C
C---- ARGUMENT NAME
C
  100 CALL RDNEXT
      IF (ENDFIL) GO TO 400
      CALL RDWORD(KNAME,LNAME)
      IF (LNAME .EQ. 0) THEN
        CALL RDFAIL
        WRITE (IECHO,910)
        GO TO 200
      ENDIF
      CALL RDLOOK(KNAME,15,FNAME,1,NFORM,IFORM)
      IF (IFORM .NE. 0) THEN
        CALL RDFAIL
        WRITE (IECHO,920) KNAME(1:LNAME)
        GO TO 200
      ENDIF
C
C---- SEPARATOR?
C
      CALL RDNEXT
      IF (ENDFIL) GO TO 400
      CALL RDTEST(',)',FLAG)
      IF (FLAG) GO TO 200
C
C---- ALLOCATE CELL TO ARGUMENT
C
      NFORM = NFORM + 1
      IF (NFORM .GT. MXFORM) THEN
        WRITE (IECHO,930)
        NFAIL = NFAIL + 1
        CALL RDEND
        STOP
      ENDIF
      FNAME(NFORM) = KNAME
      GO TO 300
C
C---- ERROR RECOVERY
C
  200 CALL RDFIND(',);')
      IF (ENDFIL) GO TO 400
      ERROR = .TRUE.
  300 IF (ITEM .EQ. ',') GO TO 100
      IF (ITEM .EQ. ')') CALL RDNEXT
  400 CONTINUE
      RETURN
C-----------------------------------------------------------------------
  910 FORMAT(' *** ERROR *** FORMAL ARGUMENT NAME EXPECTED'/' ')
  920 FORMAT(' *** ERROR *** DUPLICATE FORMAL ARGUMENT "',A,'"'/' ')
  930 FORMAT (' *** ERROR *** TOO MANY FORMAL ARGUMENTS'/' ')
C-----------------------------------------------------------------------
      END
      SUBROUTINE DECLST
C---- DECODE A BEAM LIST
C-----------------------------------------------------------------------
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'DATUM.CIN'
      INCLUDE 'FORDAT.CIN'
      INCLUDE 'FORCNT.CIN'
      INCLUDE 'IODATA.CIN'
      INCLUDE 'IOFLAG.CIN'
      INCLUDE 'LPDATA.CIN'
      INCLUDE 'PARVAL.CIN'
      INCLUDE 'RDBUFF.CIN'
      INCLUDE 'RDCARD.CIN'
      INCLUDE 'RDWRDS.CIN'
C-----------------------------------------------------------------------
      CHARACTER*15    KNAME
      INTEGER         ICALL, ICALLO, IDIREP, INAMA, INAME, IREP
      INTEGER         LAKE, LNAME
      LOGICAL         FLAG
      REAL            FAKE
      EQUIVALENCE     (FAKE,LAKE)
C-----------------------------------------------------------------------
C
      ERROR = .FALSE.
C
C---- INITIALIZE
C
      IUSED = 0
      ICALL = 1
      CALL RDNEXT
      IF (ENDFIL) GO TO 700
C
C---- OPENING PARENTHESIS
C
      CALL RDTEST('(',ERROR)
      IF (ERROR) GO TO 800
      CALL RDNEXT
      IF (ENDFIL) GO TO 700
C
C---- PROCEDURE "DECODE LIST" ------------------------------------------
C
  100 IUSED = IUSED + 1
      ILDAT(IUSED,2) = ICALL
C
C---- APPEND A NEW CALL CELL
C
  200 CONTINUE
C
C---- REFLEXION?
C
      IF (ITEM .EQ. '-') THEN
        CALL RDNEXT
        IF (ENDFIL) GO TO 700
        IDIREP = -1
      ELSE
        IDIREP = 1
      ENDIF
C
C---- REPETITION?
C
      INDX = INDEX('0123456789',ITEM)
      IF (INDX .NE. 0) THEN
        CALL RDINT(IREP,FLAG)
        IF (ENDFIL) GO TO 800
        IF (FLAG) GO TO 600
        CALL RDNEXT
        IF (ENDFIL) GO TO 700
        CALL RDTEST('*',FLAG)
        IF (FLAG) GO TO 600
        CALL RDNEXT
        IF (ENDFIL) GO TO 700
        IDIREP = IDIREP * IREP
        NDESC = 1
        LABLE = ' '
        NWORD = 2
        LAKE = 9
        DATUM(1) = FAKE
        LAKE = IREP
        DATUM(2) = FAKE
        CALL ELSTOR
      ENDIF
C
C---- SUBLIST?
C
      IF (ITEM .EQ. '(') THEN
        CALL RDNEXT
        IF (ENDFIL) GO TO 700
        ICALL = 2
        ILDAT(IUSED+1,1) = IDIREP
        GO TO 100
      ENDIF
C
C---- DECODE IDENTIFIER
C
  300 CALL RDWORD(KNAME,LNAME)
      IF (LNAME .EQ. 0) THEN
        CALL RDFAIL
        WRITE (IECHO,910)
        GO TO 600
      ELSE
        CALL RDLOOK(KNAME,15,FNAME,1,NFORM,INAME)
        IF (INAME .EQ. 0) THEN
          IF (IDIREP .GT. 0) THEN
            LAKE = 3
            PDATA(1) = FAKE
          ENDIF
          IF (IDIREP .LT. 0) THEN
            LAKE = 4
            PDATA(1) = FAKE
          ENDIF
          CALL FNDDEF(KNAME,INAME)
        ELSE
          NDESC = 3
          LABLE = KNAME
          NWORD = 3
          LAKE = 32
          DATUM(1) = FAKE
          LAKE = 3
          DATUM(2) = FAKE
          LAKE = INAME
          DATUM(3) = FAKE
          CALL ELSTOR
        ENDIF
        IF (IABS(IDIREP) .GT. 1) THEN
          NDESC = 1
          LABLE = ' '
          NWORD = 2
          LAKE = 9
          DATUM(1) = FAKE
          LAKE = 0
          DATUM(2) = FAKE
          CALL ELSTOR
        ENDIF
      ENDIF
C
C---- ACTUAL ARGUMENT LIST?
C
      CALL RDNEXT
      IF (ENDFIL) GO TO 700
      IF (ITEM .EQ. '(') THEN
        INAMA = 1
        NDESC = 3
        LABLE = KNAME
        NWORD = 3
        LAKE = 32
        DATUM(1) = FAKE
        LAKE = 1 
        DATUM(2) = FAKE
        LAKE = INAMA
        DATUM(3) = FAKE
        CALL ELSTOR
        CALL RDNEXT
        IF (ENDFIL) GO TO 700
        ICALL = 3
        GO TO 100
      ENDIF
C
C---- COMMA OR RIGHT PARENTHESIS?
C
  500 CALL RDTEST(',)',FLAG)
      IF (.NOT. FLAG) GO TO 700
C
C---- ERROR RECOVERY
C
  600 CALL RDFIND('(),;')
      IF (ENDFIL) GO TO 800
      ERROR = .TRUE.
C
C---- ANOTHER MEMBER?
C
  700 IF (ITEM .EQ. ',') THEN
        IF (ICALL .EQ. 3) THEN
          NDESC = 3
          LABLE = KNAME
          NWORD = 3
          LAKE = 32
          DATUM(1) = FAKE
          LAKE = 2
          DATUM(2) = FAKE
          LAKE = INAMA
          DATUM(3) = FAKE
          CALL ELSTOR
          INAMA = INAMA + 1
          NDESC = 3
          LABLE = KNAME
          LAKE = 32
          DATUM(1) = FAKE
          LAKE = 1
          DATUM(2) = FAKE
          LAKE = INAMA
          DATUM(3) = FAKE
          CALL ELSTOR
        ENDIF
  710   CALL RDNEXT
        IF (ENDFIL) GO TO 700
        GO TO 200
      ENDIF
C
C---- END OF LIST?
C
      IF (ITEM .EQ. ')') THEN
        IREP  = ILDAT(IUSED,1)
        ICALLO = ICALL
        IUSED = IUSED - 1
        IF (IUSED .GE. 1) ICALL = ILDAT(IUSED,2)
        GO TO (800,720,730,500), ICALLO
      ENDIF
      GO TO 750
C
C---- CLOSE REPEAT FOR SUBLIST
C
  720 IF (IABS(IREP) .GE. 2) THEN
        NDESC = 1
        LABLE = ' '
        NWORD = 2
        LAKE = 9
        DATUM(1) = FAKE
        LAKE = 0
        DATUM(2) = FAKE
        CALL ELSTOR
      ENDIF
      CALL RDNEXT
      IF (ENDFIL) GO TO 700
      GO TO 500
C
C---- CLOSE DUMMY ARGUMENT SPECIFICATION
C
  730 NDESC = 3
      LABLE = KNAME
      NWORD = 3
      LAKE = 32
      DATUM(1) = FAKE
      LAKE = 2
      DATUM(2) = FAKE
      LAKE = INAMA
      DATUM(3) = FAKE
      CALL ELSTOR
      CALL RDNEXT
      IF (ENDFIL) GO TO 700
      GO TO 500
C
C---- ANOTHER LIST WITHOUT A COMMA?
C
  750 IF (ITEM .EQ. '(') THEN
        CALL RDNEXT
        IF (ENDFIL) GO TO 700
        ICALL = 4
        GO TO 100
      ENDIF
C
C---- END OF BEAM LINE LIST
C
  800 CONTINUE
      RETURN
C-----------------------------------------------------------------------
  910 FORMAT(' *** ERROR *** BEAM LINE MEMBER MUST BE BEAM ELEMENT',
     +       ' NAME, BEAM LINE NAME, OR LIST IN "()"'/' ')
C-----------------------------------------------------------------------
      END
      SUBROUTINE DECMIS(NELMN)
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'KNAME.CIN'
      INCLUDE 'LNAME.CIN'
      INCLUDE 'PARDAT.CIN'
      INCLUDE 'PARVAL.CIN'
      EQUIVALENCE (FAKE,LAKE)
C
      CALL FNDLAB(KNAME,NELMN)
      IF (NELMN .EQ. 0) THEN
        CALL RDFAIL
        WRITE (NOUT,920) KNAME(1:LNAME)
      ENDIF
      IPARM = 9
      IPTYP(9) = 1
      IPDAT(9) = 102
      LAKE = NELMN
      PDATA(9) = FAKE
      CALL RDBACK
C
      RETURN
C-----------------------------------------------------------------------
  920 FORMAT (' *** ERROR *** UNKNOWN BEAM ELEMENT "',A,'"'/' ')
C-----------------------------------------------------------------------
      END
      SUBROUTINE DECPAR(NDICT,DICT,NCPAR,NPPAR,NPF)
C---- DECODE PARAMETER LIST
C-----------------------------------------------------------------------
      CHARACTER*15    DICT(NDICT)
      INTEGER         NPPAR(NCPAR)
C-----------------------------------------------------------------------
C---- LOGICAL UNITS, POINTERS AND COUNTERS FOR I/O
C
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'DATA0A.CIN'
      INCLUDE 'DATA0B.CIN'
      INCLUDE 'DATA1A.CIN'
      INCLUDE 'DATA1E.CIN'
      INCLUDE 'DATA2A.CIN'
      INCLUDE 'DATA2C.CIN'
      INCLUDE 'DATUM.CIN'
      INCLUDE 'ELM14A.CIN'
      INCLUDE 'ICODE.CIN'
      INCLUDE 'ILAST.CIN'
      INCLUDE 'INDPAR.CIN'
      INCLUDE 'INSERT.CIN'
      INCLUDE 'IODATA.CIN'
      INCLUDE 'IOFLAG.CIN'
      INCLUDE 'IOUNIT.CIN'
      INCLUDE 'KNAME.CIN'
      INCLUDE 'LBDAT.CIN'
      INCLUDE 'LNAME.CIN'
      INCLUDE 'NDICT.CIN'
      INCLUDE 'NUMREP.CIN'
      INCLUDE 'OUTFIL.CIN'
      INCLUDE 'PARDAT.CIN'
      INCLUDE 'PARLOC.CIN'
      INCLUDE 'PARVAL.CIN'
      INCLUDE 'RDBUFF.CIN'
      INCLUDE 'RDCARD.CIN'
      INCLUDE 'RDCHAR.CIN'
      INCLUDE 'RDPRNT.CIN'
      INCLUDE 'RDWRDS.CIN'
      INCLUDE 'VARY.CIN'
C-----------------------------------------------------------------------
      CHARACTER*1     COLON, CLETS(15), CLTMP(15)
      CHARACTER*13    NUMC
      CHARACTER*15    CWORD, CWTMP, DAUGHTER1, DAUGHTER2, KPARA, LOCATE, 
     1                NAME, PARENT, PLACE
      LOGICAL         FLAG
      EQUIVALENCE     (CWORD,CLETS(1)), (CWTMP,CLTMP(1))
      EQUIVALENCE     (LAKE,FAKE)
C-----------------------------------------------------------------------
      DATA COLON /':'/, LOCATE /'LOCATION'/, PLACE /'PLACE   '/
      DATA PARENT /'PARENT'/, DAUGHTER1 /'DAUGHTER1'/, 
     1     DAUGHTER2 /'DAUGHTER2'/
      DATA NAME /'NAME'/
      DATA NUMC /'0123456789.+-'/
C
      ERROR = .FALSE.
      MADNO = .FALSE.
      NDSAV = NDICT
      NCPARA = NCPAR
      NCDO = MIN(NCPAR,15)
      DO 10 J = 1, NCDO
   10 NPORDR(J) = NPPAR(J)
      NWRDS = 0
      INAMS = 1
      IPARM = 0
C
C---- ANOTHER PARAMETER?
C
  100 CALL RDNEXT
      IF (ENDFIL) GO TO 600
      IF (ITEM .NE. QUOTE .AND. ITEM .NE. APOST
     1    .AND. NWRDS .GE. NPF) THEN
        CALL RDBACK
        GO TO 500
      ENDIF
      IF (ITEM .EQ. SEMI .OR. ITEM .EQ. DOLLAR .OR. ITEM .EQ. ASTER)
     1    GO TO 500
      IF (ITEM .EQ. COMMA) THEN
        CALL RDNEXT
        IF (ENDFIL) GO TO 600
      ENDIF
C
C---- PARAMETER KEYWORD
C
      IF (INDEX(ALPHA,ITEM) .NE. 0) THEN
        CALL RDWORD(KNAME,LNAME)
        IF (LNAME .EQ. 0) THEN
          CALL RDFAIL
          WRITE (NOUT,910)
          GO TO 200
        ENDIF
C
C---- COLON?
C
        CALL RDNEXT
        IF (ENDFIL) GO TO 600
        IF (ITEM .EQ. COLON) THEN
          CALL RDFAIL
          ERROR = .TRUE.
          CALL RDFIND (';')
          IF (ENDFIL) GO TO 600
          GO TO 500
        ENDIF
C
C---- EQUALS SIGN?
C
        LLC = MAX0(LNAME,2)
        CALL RDLOOK(KNAME,LNAME,DICT,1,NDICT,IPARM)
        IF (KNAME(1:4) .EQ. 'TYPE') GO TO 170
        IF (KNAME .EQ. LOCATE(1:LLC) .OR. KNAME .EQ. PLACE(1:LLC))
     1      GO TO 150
        IF (KNAME .EQ. 'FLAG') GO TO 160
        IF (NTYPE .EQ. 16 .AND. (KNAME .EQ. PARENT(1:LLC) 
     1      .OR. KNAME .EQ. DAUGHTER1(1:LLC) 
     2      .OR. KNAME .EQ. DAUGHTER2(1:LLC))) GO TO 175 
        IF (IPARM .NE. 0) GO TO 120
        IF (NTYPE .EQ. 0 .OR. NTYPE .EQ. 13) THEN
          OUTFIL = KNAME
          LOUTF = LNAME
          CALL RDBACK
          GO TO 180
        ENDIF
C
        IF (NTYPE .EQ. 8) THEN 
          CALL DECMIS(NELMN)
          IF (NELMN .EQ. 0) GO TO 500
          GO TO 180
        ENDIF
C
        IF (NTYPE .EQ. 10) THEN
          CALL DECFIT(INAME,INAMS)
          IF (INAME .NE. 0) GO TO 120
        ENDIF
C
        IF (NTYPE .EQ. 12) THEN
          CALL FNCORR(KNAME,LNAME,INAME)
          IF (INAME .NE. 0) GO TO 120
        ENDIF
C
        IF (NTYPE .EQ. 14) THEN
          CALL DECARB(INAME)
          IF (INAME .NE. 0) GO TO 120
        ENDIF
C
        IF (NTYPE .EQ. 15) THEN
          IF (LBDAT .EQ. BLANK) THEN
            LBDAT = KNAME
            GO TO 120
          ENDIF
        ENDIF
C
        IF (NTYPE .EQ. 38) THEN
          CALL DECPLOT(FLAG,INAMS)
          IF (ENDFIL) GO TO 600
          IF (FLAG) GO TO 500
          GO TO 120
        ENDIF
C
        CALL RDFAIL
        GO TO 200
C
  120   MADNO = .TRUE.
        NWRDS = NWRDS + 1
        IF (ITEM .EQ. EQUAL) THEN
          IPTYP(IPARM) = 1
          CALL DECEXP
          IF (ENDFIL) GO TO 600
          FLAG = ERROR
          IOPERS(IPARM) = IOPER
          IF (IPDAT(IPARM) .NE. 100 .AND. IOPER .EQ. 0
     1        .AND. (INDS .EQ. 0 .OR. INSERT)) THEN
            NEL = NEL - 1
            I = ILAST
            IF (IPTYP(IPARM) .EQ. 1) THEN
              IF (NTYPE .LT. 50 .OR. (NTYPE .GE. 50 .AND. IPARM .NE. 5)) 
     1          PDATA(IPARM) = DATA(I+1)
              ELSE
                PDATA(IPARM) = DATA(I+3)
              ENDIF
          ENDIF
          IF (IOPER .EQ. 1) THEN
            NWORD = NPVAR + 2
            NDESC = 1
            LAKE = 30
            DATUM(1) = FAKE
            VARY(2) = 99
            IADR = ISTOR(NEL) + 4
            LAKE = I + 1
            DATA(IADR) = FAKE
            TIE(IADR) = 100
            LAKE = I + 1
            PDATA(IPARM) = FAKE
            IPTYP(IPARM) = 1
            IPDAT(IPARM) = 100
            CALL ELSTOR
          ENDIF
          IF (FLAG) GO TO 200
        ELSE
          CALL RDBACK
          IF (NTYPE .EQ. 15 .AND. IPARM .EQ. 0) GO TO 180
          IF (NTYPE .NE. 38) IPTYP(IPARM) = -2
        ENDIF
        GO TO 180
C
C---- LOCATION SPECIFICATION FOR MARKER
C
  150   LDATA = BLANK
        IF (ITEM .EQ. EQUAL) THEN
          CALL RDNEXT
          IF (ENDFIL) GO TO 600
          CALL RDWORD(LDATA,LOCN)
          IF (LOCN .EQ. 0) THEN
            CALL RDFAIL
            WRITE (NOUT,910)
            GO TO 200
          ENDIF
        ENDIF
        GO TO 180
C
C---- FLAG SPECIFICATION FOR HISTOGRAM
C
  160   LRDFLG = BLANK
        IF (ITEM .EQ. EQUAL) THEN
          CALL RDNEXT
          IF (ENDFIL) GO TO 600
          CALL RDWORD(LRDFLG,LFLN)
          IF (LFLN .EQ. 0) THEN
            CALL RDFAIL
            WRITE (NOUT,910)
            GO TO 200
          ENDIF
        ENDIF
        GO TO 180
C
C---- TYPE SPECIFICATION?
C
  170   IF (ITEM .EQ. EQUAL) THEN
          NWRDS = NWRDS + 1
          IPTYP(IPARM) = 1
          CALL RDNEXT
          IF (ENDFIL) GO TO 600
          CALL RDTYPE(KTYPE,LTYPE)
        ENDIF
        GO TO 180
C
C---- PARTICLE NAME AND CHARGE
C
  175   IF (ITEM .EQ. EQUAL) THEN
          IPTYP(IPARM) = 1
          CALL RDNEXT
          IF (INDEX(ALPHA,ITEM) .NE. 0) THEN
            CALL RDWORD(KNAME,LNAME)
            LBDAT = KNAME
          ENDIF
        ELSE
          IPTYP(IPARM) = -2
          CALL RDBACK
        ENDIF 
C
C---- SEPARATOR?
C
  180   CALL RDNEXT
        IF (ENDFIL) GO TO 600
        IF (ITEM .EQ. COMMA) GO TO 100
        IF (ITEM .EQ. SEMI .OR. ITEM .EQ. DOLLAR .OR. ITEM .EQ. ASTER)
     1      GO TO 500
        IF (ITEM .EQ. QUOTE .OR. ITEM .EQ. APOST) THEN
          CALL RDBACK
          GO TO 100
        ENDIF
C
C---- ERROR RECOVERY
C
  200   CALL RDFIND(',;')
        IF (ENDFIL) GO TO 600
        ERROR = .TRUE.
        GO TO 100
C
C---- NUMERICAL VALUE
C
      ELSE IF (INDEX(NUMC,ITEM) .NE. 0) THEN
        IF (.NOT. MADNO) THEN
          CALL RDNUMB(VALUE,IVALUE,FLAG)
          IF (ENDFIL) GO TO 600
          IF (NWRDS .GT. NCPAR) THEN
            ERROR = .TRUE.
          ELSE
            NWRDS = NWRDS + 1
            IF (NWRDS .LE. 15) IPARM = NPPAR(NWRDS)
            IF (NWRDS .GT. 15) IPARM = NWRDS
            IF (NTYPE .EQ. 16 .AND. INT(PDATA(1)) .EQ. 14) THEN
              LAKE = IVALUE
              PDATA(IPARM) = FAKE
              CALL SEEDIT
            ELSE
              PDATA(IPARM) = VALUE
            ENDIF
            IPTYP(IPARM) = 1
          ENDIF
          GO TO 100
        ELSE
          CALL RDFIND(',;')
          IF (ENDFIL) GO TO 600
          ERROR = .TRUE.
          GO TO 100
        ENDIF
C
C---- LABEL
C
      ELSE IF (ITEM .EQ. QUOTE .OR. ITEM .EQ. APOST) THEN
        CALL RDSTRG (CWORD, 15, L)
        IF (L .GT. 15) WRITE (NOUT, 9350)
        IF (LABLE .NE. BLANK) WRITE (NOUT, 9360) LABLE
        LL = 0
        CWTMP = BLANK
        DO 410 LLL = 1, L
        IF (CLETS(LLL) .NE. BLANK) THEN
          LL = LL + 1
          CLTMP(LL) = CLETS(LLL)
        ENDIF
  410   CONTINUE
        L = LL
        CWORD = CWTMP
        LBDAT = CWORD
        LABLE = CWORD
        GO TO 100
C
C---- NOTHING RECOGNIZABLE
C
      ELSE
        CALL RDWARN
      ENDIF
  500 NWORD = NWRDS + 1
  600 CONTINUE
      RETURN
C-----------------------------------------------------------------------
  910 FORMAT(' *** ERROR *** PARAMETER KEYWORD EXPECTED'/' ')
 9350 FORMAT ('0NEXT LABEL TRUNCATED TO 15 CHARS.')
 9360 FORMAT (8H0LABEL ",A4,33H" ON NEXT ELEMENT WAS OVERWRITTEN)
 9370 FORMAT ('0NUMBERS MAY NOT FOLLOW KEYWORD PARAMETERS')
C-----------------------------------------------------------------------
      END
      SUBROUTINE DECPLOT(FLAG,INAMS)
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'DATA1A.CIN'
      INCLUDE 'ICODE.CIN'
      INCLUDE 'INDPAR.CIN'
      INCLUDE 'IOFLAG.CIN'
      INCLUDE 'KNAME.CIN'
      INCLUDE 'LNAME.CIN'
      INCLUDE 'PARDAT.CIN'
      INCLUDE 'PARVAL.CIN'
      INCLUDE 'RDBUFF.CIN'
      INCLUDE 'RDWRDS.CIN'
      CHARACTER*15 KPARA
      LOGICAL      FLAG
C
      FLAG = .FALSE.
C
      IPARM = 0
      CALL FNDNAM(KNAME,LNAME,INAME)
      IF (INAME .NE. 0) THEN
        PDATA(INAMS) = FLOAT(ICODE)
        IPTYP(INAMS) = 1
        PDATA(INAMS+1) = FLOAT(JCODE)
        IPTYP(INAMS+1) = 1
        INAMS = INAMS + 2
        IPARM = 3
        GO TO 100
      ENDIF
C
      CALL FNDLAB(KNAME,NELMN)
      IF (NELMN .EQ. 0) THEN
        CALL RDFAIL
        WRITE (NOUT,920) KNAME(1:LNAME)
        FLAG = .TRUE.
        GO TO 100
      ENDIF
      IF (ITEM .EQ. '[') THEN
        CALL RDNEXT
        IF (ENDFIL) GO TO 100
        CALL RDWORD(KPARA,LPARA)
        IF (LPARA .EQ. 0) THEN
          CALL RDFAIL
          WRITE (NOUT,930)
          GO TO 100
        ENDIF
        CALL RDNEXT
        IF (ENDFIL) GO TO 100
        CALL RDTEST(']',FLAG)
        IF (FLAG) GO TO 100
        NTYPE1 = NTYPE
        IST = ISTOR(NELMN)
        NTYPE = IDATA(IST)
        CALL RDPARS(KPARA,LPARA,IEP)
        IF (IEP .EQ. 0) THEN
          CALL RDFAIL
          WRITE (NOUT,940) KNAME(1:LNAME), KPARA(1:LPARA)
          FLAG = .TRUE.
          GO TO 100
        ENDIF
        CALL SKETCH(NELMN)
        PDATA(INAMS+1) = IST + IPTOJ(IEP)
        NTYPE = NTYPE1
      ELSE
        PDATA(INAMS+1) = ISTOR(NELMN) + 1
      ENDIF
      PDATA(INAMS) = 9.0
      IPTYP(INAMS) = 1
      IPTYP(INAMS+1) = 1
      INAMS = INAMS + 2
      IF (ENDFIL) GO TO 100
C
  100 RETURN
C-----------------------------------------------------------------------
  920 FORMAT(' *** ERROR *** UNKNOWN PARAMETER KEYWORD "',A,'"'/' ')
  930 FORMAT(' *** ERROR *** MULTIPLE DEFINITION OF PARAMETER "',A,
     +       '"'/' ')
  940 FORMAT (' *** ERROR *** UNKNOWN ELEMENT PARAMETER "',A,'[',A,']"'/
     +       ' ')
C-----------------------------------------------------------------------
      END
      SUBROUTINE DECUSE(ERROR)
C---- DECODE REFERENCE TO BEAM LINE
C-----------------------------------------------------------------------
      LOGICAL         ERROR
C-----------------------------------------------------------------------
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'DATA1C.CIN'
      INCLUDE 'DATA2A.CIN'
      INCLUDE 'DATUM.CIN'
      INCLUDE 'INSERT.CIN'
      INCLUDE 'IODATA.CIN'
      INCLUDE 'RDBUFF.CIN'
      INCLUDE 'RDCARD.CIN'
      INCLUDE 'RDPRNT.CIN'
      INCLUDE 'RDWRDS.CIN'
      INCLUDE 'VARY.CIN'
C-----------------------------------------------------------------------
      CHARACTER*15    KNAME
      EQUIVALENCE     (FAKE,LAKE)
C-----------------------------------------------------------------------
      ERROR = .FALSE.
C
C---- BEAM LINE NAME
C
      CALL RDWORD(KNAME,LNAME)
      IF (LNAME .EQ. 0) THEN
        CALL RDFAIL
        WRITE (IECHO,910)
        ERROR = .TRUE.
        GO TO 100
      ENDIF
C
C---- STORE REFERENCE TO BEAM LINE TO BE USED
C
   60 IF (INDS .EQ. 0 .OR. INSERT) THEN
        NUSE = NEL + 1
        NDESC = 7
        LABLE = KNAME
        NWORD = 4
        LAKE = 24
        DATUM(1) = FAKE
        LAKE = 3
        DATUM(2) = FAKE
        VARY(3) = 100
        VARY(4) = 100
        CALL ELSTOR
      ELSE
        LABLE = KNAME
        LABEL(NUSE) = LABLE
      ENDIF
C
C---- ACTUAL PARAMETER LIST
C
      IF (ITEM .EQ. '(') THEN
        CALL DECLST
      ENDIF
  100 RETURN
C-----------------------------------------------------------------------
  910 FORMAT(' *** ERROR *** BEAM LINE NAME EXPECTED'/' ')
  920 FORMAT(' *** ERROR *** UNKNOWN BEAM LINE NAME "',A,'"'/' ')
  930 FORMAT(' *** ERROR *** "',A,'" IS NOT A BEAM LINE'/' ')
C-----------------------------------------------------------------------
      END
      SUBROUTINE EDIT
C---- INSERT OR REMOVE ELEMENT OR ELEMENTS INTO OR FROM DATA
C
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'DATA1A.CIN'
      INCLUDE 'DATA2A.CIN'
      INCLUDE 'ICOPY.CIN'
      INCLUDE 'INSERT.CIN'
      INCLUDE 'IOFLAG.CIN'
      INCLUDE 'IOUNIT.CIN'
      INCLUDE 'LABELI.CIN'
      INCLUDE 'LBDAT.CIN'
      INCLUDE 'LIMITS.CIN'
      INCLUDE 'RDBUFF.CIN'
      INCLUDE 'RDCARD.CIN'
      INCLUDE 'RDCHAR.CIN'
C-----------------------------------------------------------------------
C
C---- COMMA?
C
      IF (LBDAT .NE. BLANK) THEN
        LABELI = LBDAT
        GO TO 100
      ENDIF
      CALL RDNEXT
      IF (ENDFIL) GO TO 600
      IF (ITEM .EQ. COMMA) THEN
        CALL RDNEXT
        IF (ENDFIL) GO TO 600
      ENDIF
      IF (ITEM .EQ. QUOTE .OR. ITEM .EQ. APOST) THEN
        IF (LABLE .NE. BLANK) GO TO 100
        CALL RDSTRG (LABELI, 15, L)
        IF (L .GT. 15) WRITE (NOUT, 9350)
      ENDIF
C
  100 CALL EXILE
C
      ISTOR(1) = 1
      NUM = NELLIM - NEL + 1
      NDIF = 1
      NEL = 0
      I = 1
      I100 = 0
      IB100 = ISTOR(NUM)
      CALL FND100
C
      CALL INDUCT
C
  500 CALL RDNEXT
      IF (ENDFIL) GO TO 600
      IF (ITEM .EQ. SEMI) THEN
        NINSRT = 0
      ELSE
        NINSRT = 1
        CALL RDBACK
      ENDIF
C
  600 CONTINUE
      RETURN
 9350 FORMAT ('0NEXT LABEL TRUNCATED TO 15 CHARS.')
 9360 FORMAT (8H0LABEL ",A8,33H" ON NEXT ELEMENT WAS OVERWRITTEN)
      END
      SUBROUTINE ELMDEF
C---- DECODE ELEMENT DEFINITION
C-----------------------------------------------------------------------
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'AHORN.CIN'
      INCLUDE 'CONSTS.CIN'
      INCLUDE 'DATA0A.CIN'
      INCLUDE 'DATA1A.CIN'
      INCLUDE 'DATA1E.CIN'
      INCLUDE 'DBEAM.CIN'
      INCLUDE 'DBEND.CIN'
      INCLUDE 'DCENT.CIN'
      INCLUDE 'DCORR.CIN'
      INCLUDE 'DCVTY.CIN'
      INCLUDE 'DDRFT.CIN'
      INCLUDE 'DETA.CIN'
      INCLUDE 'DFIT.CIN'
      INCLUDE 'DHKICK.CIN'
      INCLUDE 'DHORN.CIN'
      INCLUDE 'DKICK.CIN'
      INCLUDE 'DMAGNE.CIN'
      INCLUDE 'DMARK.CIN'
      INCLUDE 'DMIS.CIN'
      INCLUDE 'DMTX.CIN'
      INCLUDE 'DOCT.CIN'
      INCLUDE 'DORD.CIN'
      INCLUDE 'DPLT.CIN'
      INCLUDE 'DPRNT.CIN'
      INCLUDE 'DQUAD.CIN'
      INCLUDE 'DRAN.CIN'
      INCLUDE 'DRBND.CIN'
      INCLUDE 'DREPS.CIN'
      INCLUDE 'DROT.CIN'
      INCLUDE 'DSECT.CIN'
      INCLUDE 'DSEPM.CIN'
      INCLUDE 'DSEXT.CIN'
      INCLUDE 'DSHIFT.CIN'
      INCLUDE 'DSOLE.CIN'
      INCLUDE 'DSPEC.CIN'
      INCLUDE 'DSROT.CIN'
      INCLUDE 'DSTRA.CIN'
      INCLUDE 'DUNIT.CIN'
      INCLUDE 'DUPD.CIN'
      INCLUDE 'FLUSHC.CIN'
      INCLUDE 'HORNS.CIN'
      INCLUDE 'ICODE.CIN'
      INCLUDE 'INSERT.CIN'
      INCLUDE 'IODATA.CIN'
      INCLUDE 'IOFLAG.CIN'
      INCLUDE 'IOUNIT.CIN'
      INCLUDE 'KELEM.CIN'
      INCLUDE 'LBDAT.CIN'
      INCLUDE 'NDICT.CIN'
      INCLUDE 'NELMS.CIN'
      INCLUDE 'NELMEQ.CIN'
      INCLUDE 'NFLAGS.CIN'
      INCLUDE 'NHORN.CIN'
      INCLUDE 'NPLIN.CIN'
      INCLUDE 'PARDAT.CIN'
      INCLUDE 'PARLOC.CIN'
      INCLUDE 'PARVAL.CIN'
      INCLUDE 'RDCARD.CIN'
      INCLUDE 'RDCHAR.CIN'
      INCLUDE 'RDHIST.CIN'
      INCLUDE 'RDPRNT.CIN'
      INCLUDE 'RDWRDS.CIN'
      INCLUDE 'RHORN.CIN'
      INCLUDE 'RNTYPE.CIN'
      INCLUDE 'THIKNS.CIN'
      INCLUDE 'UROT.CIN'
      INCLUDE 'VCODE.CIN'
      INCLUDE 'ZHORN.CIN'
C-----------------------------------------------------------------------
      CHARACTER*15    DHIST(23), DFLAG(13), DDCAY(4)
      CHARACTER*15    DLIM(3)
      INTEGER         IDATA, IPDATA, IROW
      INTEGER         J, JBEG, JDEF, JEND, JJ, JPAR, JPARS, J1, J2
      INTEGER         KK, LAKE, LLOC
      LOGICAL         CORREC, LTWISS
      REAL            DIST, DPAR, FAKE
      EQUIVALENCE     (FAKE,LAKE)
      EXTERNAL        IDATA, IPDATA
C-----------------------------------------------------------------------
      DATA NCBEAM /8/, NCROT  /1/, NCDRFT /1/, NCBEND /3/, NCQUAD /3/,
     1     NCUPD  /4/, NCCENT /6/, NCMIS  /7/, NCREPS  /1/, NCFIT  /4/,
     2     NCCVTY /4/, NCCORR /15/,            NCMTX  /86/, NCUNIT /2/,
     3     NCSPEC /3/, NCORD  /2/, NCSEXT /3/, NCSOLE /2/, NCSROT /1/,
     4     NCSTRA /3/,                         NCSECT /1/, NCOCT  /3/
     5     NCRAN  /1/, NCETA  /6/, NCRBND /11/,            NCMARK /1/,
     6     NCHKCK /2/,             NCPLT  /20/, NCLIM /2/, NCMAGN /3/,
     7     NCSEPM /3/, NCSHFT /6/, NCHIST /5/, NCFLAG /4/, 
     8     NCDCAY /4/, NCKICK /3/, NCHORN /1/
C-----------------------------------------------------------------------
      DATA DLIM ( 1)    / 'LOWER   ' /
      DATA DLIM ( 2)    / 'UPPER   ' /
      DATA DLIM ( 3)    / 'ABSOLUTE' /
C-----------------------------------------------------------------------
      DATA DHIST( 1)    / 'NCOOR   ' /
      DATA DHIST( 2)    / 'LOWER   ' /
      DATA DHIST( 3)    / 'UPPER   ' /
      DATA DHIST( 4)    / 'STEP' /
      DATA DHIST( 5)    / 'NAME    ' /
      DATA DHIST( 6)    / 'LOCATION' /
      DATA DHIST( 7)    / 'X       ' /
      DATA DHIST( 8)    / 'XP      ' /
      DATA DHIST( 9)    / 'Y       ' /
      DATA DHIST(10)    / 'YP      ' /
      DATA DHIST(11)    / 'DL      ' /
      DATA DHIST(12)    / 'DEL     ' /
      DATA DHIST(13)    / 'L       ' /
      DATA DHIST(14)    / 'P       ' /
      DATA DHIST(15)    / 'COST    ' /
      DATA DHIST(16)    / 'LD      ' /
      DATA DHIST(17)    / 'R       ' /
      DATA DHIST(18)    / 'XI      ' /
      DATA DHIST(19)    / 'PSI     ' /
      DATA DHIST(20)    / 'ZETA    ' /
      DATA DHIST(21)    / 'PARENT  ' /
      DATA DHIST(22)    / 'DAUGHTER1' /
      DATA DHIST(23)    / 'DAUGHTER2' /
C-----------------------------------------------------------------------
      DATA DFLAG( 1)    / 'NCOOR   ' /
      DATA DFLAG( 2)    / 'HWIDTH  ' /
      DATA DFLAG( 3)    / 'IFLAG   ' /
      DATA DFLAG( 4)    / 'LOCATION' /
      DATA DFLAG( 5)    / 'X       ' /
      DATA DFLAG( 6)    / 'XP      ' /
      DATA DFLAG( 7)    / 'Y       ' /
      DATA DFLAG( 8)    / 'YP      ' /
      DATA DFLAG( 9)    / 'DL      ' /
      DATA DFLAG(10)    / 'DEL     ' /
      DATA DFLAG(11)    / 'PARENT  ' /
      DATA DFLAG(12)    / 'DAUGHTER1' /
      DATA DFLAG(13)    / 'DAUGHTER2' /
C-----------------------------------------------------------------------
      DATA DDCAY( 1)    / 'MASS    ' /
      DATA DDCAY( 2)    / 'MASSC   ' /
      DATA DDCAY( 3)    / 'MASSN   ' /
      DATA DDCAY( 4)    / 'LIFETIME' /
C-----------------------------------------------------------------------
C
C---- SWITCH ON ELEMENT TYPE
C 
      IF (NTYPE .EQ. 53) GO TO 5300
      IF (NTYPE .EQ. 60) GO TO 5500
      IF (NTYPE .GE. 50) GO TO 5000
      GO TO ( 100, 200, 300, 400, 500, 600, 700, 800, 900,1000,
     1       1100,1200,6000,1400,1500,1600,1700,1800,1900,2000,
     2       2100,6000,6000,2400,2500,2600,2700,2800,2900,6000,
     3       3100,6000,6000,3400,3500,3600,3700,3800,3900,4000,
     4       4100,4200,4300,4400,4500,4600,4600,4600), NTYPE
C
C---- "BEAM" --- BEAM MATRIX AND MOMENTUM
C
  100 CALL DECPAR(NBEAM,DBEAM,NCBEAM,NPLIN,NBEAM)
      IF (ENDFIL) GO TO 6000
      IF (INDS .EQ. 0 .OR. INSERT) THEN
        LTWISS = IPTYP(10) .NE. 0 .OR. IPTYP(13) .NE. 0
        IF (.NOT. LTWISS) THEN
          DO 120 J = 1, 6
          IF (IPTYP(J) .EQ. 0) THEN
            IPTYP(J) = 1
            PDATA(J) = 0.0
          ENDIF
  120     CONTINUE
        ELSE      
          IF (IPTYP(11) .EQ. 0) THEN
            IPTYP(11) = 1
            PDATA(11) = 0.0
          ENDIF
          IF (IPTYP(14) .EQ. 0) THEN
            IPTYP(14) = 1
            PDATA(14) = 0.0
          ENDIF
        ENDIF
        IF (IPTYP(7) .EQ. 0) THEN
          IPTYP(7) = 1
          PDATA(7) = 0.0
        ENDIF
      ENDIF
      NCPARA = 7
      IF (IPTYP(19) .NE. 0) THEN
        IPTYP(5) = 1
        PDATA(5) = PDATA(19)
        IPTYP(19) = 0
        PDATA(19) = 0.0
      ENDIF
      GO TO 6000
C
C---- "ROTATION" --- POLE FACE ROTATION
C
  200 CALL DECPAR(NROT,DROT,NCROT,NPLIN,NROT)
      GO TO 6000
C
C---- "DRIFT" --- DRIFT SPACE
C---- "ELSEP" --- ELECTROSTATIC SEPARATOR
C---- "ECOLLIMA" --- ELLIPTIC COLLIMATOR
C---- "RCOLLIMA" --- RECTANGULAR COLLIMATOR
C
  300 CALL DECPAR(NDRFT,DDRFT,NCDRFT,NPLIN,NDRFT)
      GO TO 6000
C
C---- "BEND" --- BENDING MAGNET WITHOUT FRINGING FIELDS
C
  400 CALL DECPAR(NBEND,DBEND,NCBEND,NPBEND,NBEND)
      GO TO 6000
C
C---- "QUADRUPO" --- QUADRUPOLE
C
  500 CALL DECPAR(NQUAD,DQUAD,NCQUAD,NPLIN,NQUAD)
      IF (ENDFIL) GO TO 6000
      NTILT = 6
      IF (IPTYP(NTILT) .EQ. -2) THEN
        IPTYP(NTILT) = 1
        PDATA(NTILT) = 0.25*PI/UROT
      ENDIF
      GO TO 6000
C
C---- "UPDATE" --- UPDATE OF TRANSFER MATRIX
C
  600 CALL DECPAR(NUPD,DUPD,NCUPD,NPUPD,NUPD)
      IF (ENDFIL) GO TO 6000
      IF (IPTYP(1) .EQ. 0 .AND. IPTYP(4) .EQ. -2) THEN
        IPTYP(1) = 1
        IPTYP(2) = 1
        IPTYP(4) = 0
        PDATA(1) = 0.0
        PDATA(2) = 1.0
      ENDIF
      IF (IPTYP(1) .EQ. 0 .AND. IPTYP(5) .EQ. -2) THEN
        IPTYP(1) = 1
        IPTYP(2) = 1
        IPTYP(5) = 0
        PDATA(1) = 0.0
        PDATA(2) = 2.0
      ENDIF
      IF (IPTYP(1) .EQ. 0) THEN
        IPTYP(1) = 1
        PDATA(1) = 0.0
      ENDIF
      IF (IPTYP(2) .EQ. 0) THEN
        IPTYP(2) = 1
        PDATA(1) = 0.0
      ENDIF
C
      DO 610 J = 1, 6
      JP7 = J + 7
      IF (IPTYP(JP7) .NE. 0) THEN
        IPTYP(1) = 1
        PDATA(1) = FLOAT(J)
        IPTYP(JP7) = 0
      ENDIF
  610 CONTINUE
C
      IF (PDATA(1) .EQ. 0.0) THEN
        IF (LDATA .NE. BLANK) THEN
          CALL FNDELM(LDATA,NLOC,31)
          LLOC = ISTOR(NLOC) + 1
          IPTYP(3) = 1
          LAKE = IDATA(LLOC)
          PDATA(3) = FAKE
          IPDAT(3) = 101
        ENDIF
        IPTYP(4) = 1
        PDATA(4) = 0.0
      ENDIF
      GO TO 6000
C
C---- "CENTROID" -- BEAM CENTROID SHIFT
C
  700 CALL DECPAR(NCENT,DCENT,NCCENT,NPLIN,NCENT)
      FILLIT = .TRUE.
      GO TO 6000
C
C---- "MISALIGN" -- MAGNET MISALIGNMENT
C
  800 CALL DECPAR(NMIS,DMIS,NCMIS,NPLIN,NMIS)
      IF (ENDFIL) GO TO 6000
      CALL CODEIT
      IF (INDS .EQ. 0 .OR. INSERT) THEN
        DO 810 J = 1, 8
        IF (IPTYP(J) .EQ. 0) THEN
          IPTYP(J) = 1
          PDATA(J) = 0.0
        ENDIF
  810   CONTINUE
      ENDIF
      IF (LDATA .NE. BLANK) THEN
        CALL FNDELM(LDATA,NLOC,31)
        LLOC = ISTOR(NLOC) + 1
        IPTYP(9) = 1
        LAKE = IDATA(LLOC)
        PDATA(9) = FAKE
        IPDAT(9) = 101
      ENDIF
      GO TO 6000
C
C---- "REPEAT" --- REPEAT A GIVEN SECTION OF BEAM LINE
C
  900 CALL DECPAR(NREPS,DREPS,NCREPS,NPLIN,NREPS)
      LAKE = INT(PDATA(1))
      PDATA(1) = FAKE
      FILLIT = .TRUE.
      GO TO 6000
C
C---- "FIT" --- FITTING CONSTRAINTS
C
 1000 CALL DECPAR(NFIT,DFIT,NCFIT,NPLIN,NFIT)
      IF (ENDFIL) GO TO 6000
      IF (VCODE(2) .EQ. 21) VCODE(2) = 1
      IF (VCODE(2) .EQ. 30) VCODE(2) = 2
      IF (IPTYP(8) .NE. 0) THEN
        VCODE(2) = 1
        IPTYP(8) = 0
      ENDIF
      IF (IPTYP(9) .NE. 0) THEN
        VCODE(2) = 2
        IPTYP(9) = 0
      ENDIF
      IF (IPTYP(1) .NE. 0) THEN
        LAKE = INT(PDATA(1))
        PDATA(1) = FAKE
      ENDIF
      IF (IPTYP(2) .NE. 0) THEN
        LAKE = INT(PDATA(2))
        PDATA(2) = FAKE
      ENDIF
      IF (IOPERS(5) .NE. 0 .OR. IPTYP(5) .EQ. 3) THEN
        LAKE = 9
        PDATA(1) = FAKE
        PDATA(2) = PDATA(5)
        IPTYP(1) = 1
        IPTYP(2) = 1
        IPDAT(2) = 100
      ENDIF
      IF (IOPERS(5) .EQ. 0 .AND. IPTYP(5) .NE. 0) THEN
        LAKE = ICODE
        PDATA(1) = FAKE
        IPTYP(1) = 1
        LAKE = JCODE
        PDATA(2) = FAKE
        IPTYP(2) = 1
      ENDIF
      IPTYP(5) = 0
      IF (INDS .NE. 0) GO TO 6000
      IPTYP(10) = 1
      PDATA(10) = 0.0
      IPTYP(11) = 1
      PDATA(11) = 0.0
      IF (LDATA .NE. BLANK .AND. .NOT. FLUSHL) THEN
        CALL FNDELM(LDATA,NLOC,31)
        IF (NLOC .EQ. 0) THEN
          WRITE (NOUT,9651) 
 9651     FORMAT (' *** ERROR *** MARKER ELEMENT NOT FOUND')
          FLUSHL = .TRUE.
          GO TO 6000
        ENDIF
        LLOC = ISTOR(NLOC) + 1
        IPTYP(7) = 1
        PDATA(7) = DATA(LLOC)
      ENDIF
      FILLIT = .TRUE.
      GO TO 6000
C
C---- "RF" --- RF CAVITY
C
 1100 CALL DECPAR(NCVTY,DCVTY,NCCVTY,NPLIN,NCVTY)
      GO TO 6000
C
C---- "CORRELAT" --- CORRELATIONS IN BEAM ELLIPSE
C
 1200 CALL DECPAR(NCORR,DCORR,NCCORR,NPLIN,NCORR)
      FILLIT = .TRUE.
      GO TO 6000
C
C---- "MATRIX" --- ARBITRARY MATRIX
C
 1400 CALL DECPAR(NMTX,DMTX,NCMTX,NPLIN,NMTX)
      IF (ENDFIL) GO TO 6000
      NCPARA = 7
      IF (IPTYP(8) .EQ. 1 .AND. PDATA(8) .EQ. 0.0) NCPARA = 29
      IF (IPTYP(30) .EQ. 1 .AND. PDATA(30) .EQ. 0.0) NCPARA = 86
      IROW = IFIX(PDATA(7))
      IF (IPTYP(IROW) .NE. 1) THEN
        PDATA(IROW) = 1.0
        IPTYP(IROW) = 1
      ENDIF
      FILLIT = .TRUE.
      GO TO 6000
C
C---- "UNITS" --- UNITS CHANGE
C
 1500 CALL DECPAR(NUNIT,DUNIT,NCUNIT,NPLIN,NUNIT)
      IF (ENDFIL) GO TO 6000
      JJ = 0
      JBEG = 9
      JEND = 20
      DO 1510 J = JBEG, JEND
      JJ = JJ + 1
      IF (JJ .EQ. 3) JJ = 5
      IF (IPTYP(J) .NE. 0) THEN
        IPTYP(J) = 0
        IPTYP(1) = 1
        PDATA(1) = FLOAT(JJ)
        GO TO 1520
      ENDIF
 1510 CONTINUE
C
 1520 JBEG = 21
      JEND = 39
      DO 1530 J = JBEG, JEND
      IF (IPTYP(J) .NE. 0) THEN
        IPTYP(J) = 0
        LABLE = DUNIT(J)
        LBDAT = LABLE
        GO TO 1540
      ENDIF
 1530 CONTINUE
C
 1540 IF (IPTYP(1) .EQ. 1 .AND. IPTYP(2) .EQ. 1) GO TO 6000
      IF (IPTYP(1) .EQ. 1 .AND. LABLE .NE. BLANK) THEN
        NWORD = 3
        PDATA(2) = 0.0
        IPTYP(2) = 1
        GO TO 6000
      ENDIF
      IF (IPTYP(1) .EQ. 0) THEN
        NWORD = 2
        PDATA(1) = 0.0
        IPTYP(1) = 1
      ENDIF
      IF (PDATA(1) .EQ. 0.0) THEN
        LABLE = BLANK
        GO TO 6000
      ENDIF
C
      WRITE (NOUT, 9650)
 9650 FORMAT ('0EARROR ON UNITS ELEMENT')
      FLUSHL = .TRUE.
      GO TO 6000
C
C---- "SPECIAL" --- SPECIAL PARAMETERS
C
 1600 CALL DECPAR(NSPEC,DSPEC,NCSPEC,NPLIN,NSPEC)
      IF (ENDFIL) GO TO 6000
      IF (IPTYP(1) .NE. 0) THEN
        IF (PDATA(1) .LT. 0.0) THEN
          NWORD = 4
          GO TO 1640
        ENDIF  
      ENDIF
      NDO = NSPEC - 3
      DO 1610 J = 4, NSPEC
      IF (J .EQ. 38) GO TO 1610
      IF (IPTYP(J) .NE. 0) THEN
        JPAR = J
        GO TO 1620
      ENDIF
 1610 CONTINUE
      JPARS = INT(PDATA(1))
      IF (IPTYP(2) .EQ. 0 .AND. JPARS .GE. 200
     1    .AND. JPARS .LE. 202) THEN
        IPTYP(2) = 1
        IF (JPARS .EQ. 200) PDATA(2) = 1.0
        IF (JPARS .EQ. 201) PDATA(2) = 1.0
        IF (JPARS .EQ. 202) PDATA(2) = 0.0
      ENDIF
      GO TO 1630
C
 1620 NWORD = 3
      JPARS = JPAR - 3
      IF (JPAR .EQ. 31) JPARS = 100
      IF (JPAR .EQ. 32) JPARS = 101
      IF (JPAR .EQ. 33) JPARS = 102
      IF (JPAR .EQ. 34) JPARS = 109
      IF (JPAR .EQ. 35) JPARS = 200
      IF (JPAR .EQ. 36) JPARS = 201
      IF (JPAR .EQ. 37) JPARS = 202
C
      IPTYP(1) = 1
      PDATA(1) = JPARS
      IF (JPARS .GE. 200 .AND. JPARS .LE. 202) THEN 
        IF(IPTYP(38) .NE. 0) THEN
          IPTYP(2) = IPTYP(38)
          PDATA(2) = PDATA(38)
          IPDAT(2) = IPDAT(38)
        ELSE
          IPTYP(2) = 1
          IF (JPARS .EQ. 200) PDATA(2) = 1.0
          IF (JPARS .EQ. 201) PDATA(2) = 1.0
          IF (JPARS .EQ. 202) PDATA(2) = 0.0
          IPDAT(2) = 0
        ENDIF
      ELSE
        IPTYP(2) = IPTYP(JPAR)
        PDATA(2) = PDATA(JPAR)
        IPDAT(2) = IPDAT(JPAR)
      ENDIF
      IPTYP(JPAR) = 0
C
 1630 IF (JPARS .EQ. 200) THEN
        DBEAM(19) = LBDAT
        DUPD(14) = LBDAT 
        DPRNT(19) = LBDAT
        DHIST(21) = LBDAT
        DFLAG(11) = LBDAT
      ENDIF
      IF (JPARS .EQ. 201) THEN
        DBEAM(20) = LBDAT
        DUPD(15) = LBDAT 
        DPRNT(20) = LBDAT
        DHIST(22) = LBDAT
        DFLAG(12) = LBDAT
      ENDIF
      IF (JPARS .EQ. 202) THEN
        DBEAM(21) = LBDAT
        DUPD(16) = LBDAT 
        DPRNT(21) = LBDAT
        DHIST(23) = LBDAT
        DFLAG(13) = LBDAT
      ENDIF
 1640 DO 1650 J = 1, 2
 1650 CONTINUE   
      GO TO 6000
C
C---- "ORDER" --- HIGHER ORDER CALCULATION
C
 1700 CALL DECPAR(NORD,DORD,NCORD,NPLIN,NORD)
      IF (ENDFIL) GO TO 6000
      IF (IPTYP(3) .NE. 0) THEN
        IPTYP(1) = IPTYP(3)
        PDATA(1) = PDATA(3)
        IPTYP(2) = IPTYP(1)
        PDATA(2) = PDATA(1)
        IPTYP(3) = 0
        PDATA(3) = 0.0
      ENDIF
      IF (INDS .EQ. 0 .OR. INSERT) THEN
        IF (IPTYP(1) .EQ. 0) THEN
          IPTYP(1) = 1
          PDATA(1) = 2.0
        ENDIF
        IF (IPTYP(2) .EQ. 0) THEN
          IPTYP(2) = 1
          PDATA(2) = PDATA(1)
        ENDIF
      ENDIF
      GO TO 6000
C
C---- "SEXTUPOL" --- SEXTUPOLE
C
 1800 CALL DECPAR(NSEXT,DSEXT,NCSEXT,NPLIN,NSEXT)
      NTILT = 5
      IF (IPTYP(NTILT) .EQ. -2) THEN
        IPTYP(NTILT) = 1
        PDATA(NTILT) = PI/(6.0*UROT)
      ENDIF
      GO TO 6000
C
C---- "SOLENOID" --- SOLENOID
C
 1900 CALL DECPAR(NSOLE,DSOLE,NCSOLE,NPLIN,NSOLE)
      GO TO 6000
C
C---- "SROT" --- ROTATE AROUND LONGITUDINAL AXIS
C
 2000 CALL DECPAR(NSROT,DSROT,NCSROT,NPLIN,NSROT)
      GO TO 6000
C
C---- "STRAY" --- STRAY FIELD
C
 2100 CALL DECPAR(NSTRA,DSTRA,NCSTRA,NPLIN,NSTRA)
      GO TO 6000
C
C---- "SECTION" -- DEFINED SECTION
C
 2400 CALL DECPAR(NSECT,DSECT,NCSECT,NPLIN,NSECT)
      IF (ENDFIL) GO TO 6000
      NWORD = 2
      LAKE = INT(PDATA(1))
      PDATA(1) = FAKE
      DO 2410 J = 2, 5
      IF (IPTYP(J) .EQ. -2) THEN
        LAKE = J - 1
        PDATA(1) = FAKE
        IPTYP(1) = 1
        IPTYP(J) = 0
      ENDIF
 2410 CONTINUE
      JDEF = IPDATA(1)
      IF (JDEF .GE. 3) THEN
        NWORD = 4
        IPTYP(2) = 100
        IPTYP(3) = 100
      ENDIF
      GO TO 6000
C
C---- "OCTUPOLE" --- OCTUPOLE
C
 2500 CALL DECPAR(NOCT,DOCT,NCOCT,NPLIN,NOCT)
      NTILT = 5
      IF (IPTYP(NTILT) .EQ. -2) THEN
        IPTYP(NTILT) = 1
        PDATA(NTILT) = 0.125*PI/UROT
      ENDIF
      GO TO 6000
C
C---- "RANDOM" --- RANDOM ALTERATIONS TO PHYSICAL PARAMETERS
C
 2600 CALL DECPAR(NELEM,KELEM,NCRAN,NPLIN,1)
      IF (ENDFIL) GO TO 6000
      IF (IPTYP(1) .NE. 0) THEN
        TYPER = INT(PDATA(1))
        IPTYP(1) = 0
      ELSE
        DO 2605 J = 1, NELEM
        IF (IPTYP(J) .EQ. 0) GO TO 2605
        TYPER = J
        IPTYP(J) = 0
        GO TO 2610
 2605   CONTINUE
      ENDIF
C
 2610 IF (TYPER .EQ. 16) GO TO 6000
      CALL ELMPAR
      IF (ENDFIL) GO TO 6000
      NPARS = NELMS(TYPER)
      DO 2615 J = 1, NPARS
      IF (IPTYP(J) .EQ. 0) GO TO 2615
      NPAR = J
      GO TO 2620
 2615 CONTINUE
C
 2620 CALL DECPAR(NRAN,DRAN,NCRAN,NPLIN,1)
      DPAR = PDATA(1)
C
      PDATA(1) = TYPER
      PDATA(2) = NPAR
      PDATA(3) = DPAR
      IPTYP(1) = 1
      IPTYP(2) = 1
      IPTYP(3) = 1
      GO TO 6000
C
C---- "ETA" --- ACCELERATOR FUNCTION ETA
C
 2700 CALL DECPAR(NETA,DETA,NCETA,NPLIN,NETA)
      IF (IPTYP(6) .EQ. 0) THEN
        IPTYP(6) = 1
        PDATA(6) = 1.0
      ENDIF
      FILLIT = .TRUE.
      GO TO 6000
C
C---- "RBEND" --- RECTANGULAR BENDING MAGNET
C
 2800 CALL DECPAR(NRBND,DRBND,NCRBND,NPRBND,NRBND)
      MADNO = .TRUE.
      NTILT = 24
      IF (IPTYP(NTILT) .EQ. -2) THEN
        IPTYP(NTILT) = 1
        PDATA(NTILT) = 0.5*PI/UROT
      ENDIF
      GO TO 6000
C
C---- "SBEND" --- SECTOR BENDING MAGNET
C
 2900 CALL DECPAR(NRBND,DRBND,NCRBND,NPRBND,NRBND)
      MADNO = .TRUE.
      NTILT = 24
      IF (IPTYP(NTILT) .EQ. -2) THEN
        IPTYP(NTILT) = 1
        PDATA(NTILT) = 0.5*PI/UROT
      ENDIF
      GO TO 6000
C
C--- "MARKER" --- POSITION MARKER
C
 3100 CALL DECPAR(NMRKR,DMARK,NCMARK,NPLIN,NMRKR)
      NMARKS = NMARKS + 1
      IPTYP(1) = 1
      LAKE = NMARKS
      PDATA(1) = FAKE
      GO TO 6000
C
C---- "PLASMALE" --- PLASMA LENS
C
 3400 CALL DECPAR(NQUAD,DQUAD,NCQUAD,NPLIN,NQUAD)
      GO TO 6000
C
C ---- "HKICK" --- HORIZONTAL KICK
C
 3500 CALL DECPAR(NHKCK,DHKICK,NCHKCK,NPHKCK,NHKCK)
      NTILT = 5
      IF (IPTYP(NTILT) .EQ. -2) THEN
        IPTYP(NTILT) = 1
        PDATA(NTILT) = 0.5*PI/UROT
      ENDIF
      GO TO 6000
C
C ---- "VKICK" --- VERTICAL KICK
C
 3600 CALL DECPAR(NHKCK,DHKICK,NCHKCK,NPHKCK,NHKCK)
      NTILT = 5
      IF (IPTYP(NTILT) .EQ. -2) THEN
        IPTYP(NTILT) = 1
        PDATA(NTILT) = 0.5*PI/UROT
      ENDIF
      GO TO 6000
C
C---- "ALMARK" --- INDICATION OF BEGINNING OF MISALIGNED SECTION
C
 3700 CALL DECPAR(NUPD,DUPD,NCUPD,NPLIN,NUPD)
      IF (ENDFIL) GO TO 6000
      IF (IPTYP(1) .EQ. 0 .AND. IPTYP(4) .EQ. -2) THEN
        IPTYP(1) = 1
        IPTYP(2) = 1
        IPTYP(4) = 0
        PDATA(1) = 0.0
        PDATA(2) = 1.0
      ENDIF
      IF (IPTYP(1) .EQ. 0 .AND. IPTYP(5) .EQ. -2) THEN
        IPTYP(1) = 1
        IPTYP(2) = 1
        IPTYP(5) = 0
        PDATA(1) = 0.0
        PDATA(2) = 2.0
      ENDIF
      IF (IPTYP(1) .EQ. 0) THEN
        IPTYP(1) = 1
        PDATA(1) = 0.0
      ENDIF
      IF (IPTYP(2) .EQ. 0) THEN
        IPTYP(2) = 1
        PDATA(1) = 0.0
      ENDIF
      IF (PDATA(1) .EQ. 0.0) THEN
        IF (LDATA .NE. BLANK) THEN
          CALL FNDELM(LDATA,NLOC,31)
          LLOC = ISTOR(NLOC) + 1
          IPTYP(3) = 1
          LAKE = IDATA(LLOC)
          PDATA(3) = FAKE
          IPDAT(3) = 101
        ENDIF
        IPTYP(4) = 1
        PDATA(4) = 0.0
      ENDIF
      GO TO 6000
C
C---- "PLOT" --- PLOTTING OF MATRIX ELEMENTS
C
 3800 CALL DECPAR(NPLT,DPLT,NCPLT,NPLIN,NPLT)
      IF (ENDFIL) GO TO 6000
      NKT = 0
      DO 3810 J = 1, 20
      IF (IPTYP(J) .NE. 0) THEN
        NKT = NKT + 1
        LAKE = INT(PDATA(J))
        PDATA(J) = FAKE
      ENDIF
 3810 CONTINUE
C
      DO 3820 J = 1, 10
      IF (IOPERS(J+20) .NE. 0 .OR. IPTYP(J+20) .EQ. 1
     1    .OR. IPTYP(J+20) .EQ. 3) THEN
        J1 = 2*J - 1
        J2 = 2*J
        NKT = MAX0(NKT,J2)
        LAKE = 9
        PDATA(J1) = FAKE
        LAKE = IPDATA(J+20)
        PDATA(J2) = FAKE
        IPTYP(J1) = 1
        IPTYP(J2) = 1
        IPDAT(J2) = 100
      ENDIF
 3820 CONTINUE
C
      IF (IPTYP(3) .EQ. -2) IPTYP(3) = 1
      IF (INDS .NE. 0) GO TO 6000
      IF (LDATA .NE. BLANK) THEN
        CALL FNDELM(LDATA,NLOC,31)
        LLOC = ISTOR(NLOC) + 1
        IPTYP(NKT+1) = 1
        PDATA(NKT+1) = DATA(LLOC)
        IPDAT(NKT+1) = 101
      ENDIF
      GO TO 6000
C
C ---- "LIMIT" --- LIMITS ON PHYSICAL PARAMETERS IN FITTING
C
 3900 CALL DECPAR(NELEM,KELEM,NCRAN,NPLIN,1)
      IF (ENDFIL) GO TO 6000
      DO 3905 J = 1, NELEM
      IF (IPTYP(J) .NE. 0) THEN
        TYPER = J
        IPTYP(J) = 0
        GO TO 3910
      ENDIF
 3905 CONTINUE
C
 3910 IF (TYPER .EQ. 16) GO TO 6000
      NTSAVE = NTYPE
      NTYPE = TYPER
      CALL ELMPAR
      NTYPE = NTSAVE
      IF (ENDFIL) GO TO 6000
      IF (IPTYP(1) .GT. 0) THEN
        NPAR = INT(PDATA(1))
        IPTYP(1) = 0
      ELSE
        NDO = NELMS(TYPER)
        DO 3915 J = 1, NDO
        IF (IPTYP(J) .NE. 0) THEN
          NPAR = J
          IPTYP(J) = 0
          GO TO 3920
        ENDIF
 3915   CONTINUE
      ENDIF
C
 3920 IPTYP(1) = 0
      IPTYP(2) = 0
      IPTYP(3) = 0
      CALL DECPAR(3,DLIM,NCLIM,NPLIN,3)
      IF (IPTYP(3) .EQ. 1) THEN
        IPTYP(5) = 1
        PDATA(5) = PDATA(3)
        IPTYP(3) = 0
        PDATA(3) = 0.0
      ENDIF
      IF (IPTYP(2) .EQ. 1) THEN
        IPTYP(4) = 1
        PDATA(4) = PDATA(2)
      ENDIF
      IF (IPTYP(1) .EQ. 1) THEN
        IPTYP(3) = 1
        PDATA(3) = PDATA(1)
      ENDIF
C
      PDATA(1) = TYPER
      PDATA(2) = NPAR
      IPTYP(1) = 1
      IPTYP(2) = 1
      GO TO 6000
C
C---- "MAGNET" --- GENERAL MAGNET DESCRIPTION
C
 4000 CALL DECPAR(NMAGN,DMAGNE,NCMAGN,NPLIN,NMAGN)
      GO TO 6000
C
C---- "SEPTUM" --- ELECTROSTATIC SEPTUM
C
 4100 CALL DECPAR(NSEPM,DSEPM,NCSEPM,NPLIN,NSEPM)
      NTILT = 10
      IF (IPTYP(NTILT) .EQ. -2) THEN
        IPTYP(NTILT) = 1
        PDATA(NTILT) = 0.5*PI/UROT
      ENDIF
      GO TO 6000
C
C ---- "KICKER" --- KICKER FOR BOTH PLANES
C
 4200 CALL DECPAR(NKICK,DKICK,NCKICK,NPLIN,NKICK)
      GO TO 6000
C
C ---- "SHIFT" --- SHIFT IN THE REFERENCE COORDINATE SYSTEM
C
 4300 CALL DECPAR(NSHIFT,DSHIFT,NCSHFT,NPLIN,NSHIFT)
      FILLIT = .TRUE.
      GO TO 6000
C
C ---- "BROAD' --- BROAD BAND FITTING
C
 4400 NCPARA = 0
      GO TO 6000
C
C ---- "HORN" --- NEUTRINO HORN
C
 4500 CALL DECPAR(NPHORN,DHORN,NCHORN,NPLIN,NPHORN)
      IF (ENDFIL) GO TO 6000
      NHORN = NHORN + 1
      N = NHORN
      CORREC = .TRUE.
      READ (5,1035) (ZHORN(N,J), J = 1, 12)
      READ (5,1035) (RHORN(N,J), J = 1, 12)
      READ (5,1035) (THIKNS(N,J), J = 1, 12)
C
      LASTH(N) = 0
      IF (ABS(RHORN(N,1)) .LT. 0.0001) GO TO 6000
      DO 4501 J = 2, MXHORN
      IF (RHORN(N,J) .LT. 0.0001) GO TO 4502
      LASTH(N) = J
      DIST = ZHORN(N,J) - ZHORN(N,J-1)
      IF (DIST .LT. 0.0) THEN
        AHORN(N,J-1) = 0.0
        CORREC = .FALSE.
      ELSE
        AHORN(N,J-1) = (RHORN(N,J) - RHORN(N,J-1))/DIST
      ENDIF
 4501 CONTINUE
C
 4502 KK = LASTH(N)
      WRITE (NOUT,1036) (ZHORN(N,J), J = 1, KK)
      WRITE (NOUT,1037) (RHORN(N,J), J = 1, KK)
      KK = KK - 1
      WRITE (NOUT,1038) (AHORN(N,J), J = 1, KK)
      WRITE (NOUT,1039) (THIKNS(N,J), J = 1, KK)
 1036 FORMAT (1H ,20X,'  Z = ',12F8.3)
 1037 FORMAT (1H ,20X,'  R = ',12F8.3)
 1038 FORMAT (21X,'  ANGLE = ',12F8.3)
 1039 FORMAT (21X,' THIKNS = ',12F8.3)
C
      IF (.NOT. CORREC) THEN
        WRITE (NOUT,1034)
        NFAIL = NFAIL + 1
      ENDIF
      GO TO 6000
C
C---- "HMONITOR" --- HORIZONTAL MONITOR
C---- "VMONITOR" --- VERTICAL MONITOR
C---- "MONITOR" --- MONITOR FOR BOTH PLANES
C
 4600 CALL DECPAR(NDRFT,DDRFT,NCDRFT,NPLIN,NDRFT)
      GO TO 6000
C
C ---- "HIST" --- HISTOGRAM
C
 5000 CALL DECPAR(NPHST,DHIST,NCHIST,NPLIN,NPHST)
      IF (ENDFIL) GO TO 6000
      NCPARA = 4
      IF (IPTYP(1) .NE. 0) THEN
        LAKE = INT(PDATA(1))
        PDATA(1) = FAKE
      ENDIF
C
      DO 5010 J = 1, 14
      JP6 = J + 6
      IF (IPTYP(JP6) .NE. 0) THEN
        IPTYP(1) = 1
        LAKE = J
        IF (J .EQ. 7) LAKE = 8
        IF (J .EQ. 8) LAKE = 11
        IF (J .EQ. 9) LAKE = 12
        IF (J .EQ. 10) LAKE = 18
        IF (J .EQ. 11) LAKE = 21
        IF (J .EQ. 12) LAKE = 22
        IF (J .EQ. 13) LAKE = 23
        IF (J .EQ. 14) LAKE = 24
        PDATA(1) = FAKE
        IPTYP(JP6) = 0
      ENDIF
 5010 CONTINUE
C
      DO 5020 J = 1, 3
      IF (IPTYP(J+20) .NE. 0) THEN
        FAKE = PDATA(1)
        LAKE = 100*(J-1) + LAKE
        PDATA(1) = FAKE
      ENDIF  
 5020 CONTINUE
C      
      IF (LDATA .NE. BLANK) THEN
        CALL FNDELM(LDATA,NLOC,31)
        IF (NLOC .EQ. 0) THEN
          FLUSHL = .TRUE.
          GO TO 6000
        ENDIF
        LLOC = ISTOR(NLOC) + 1
        IPTYP(6) = 1
        LAKE = IDATA(LLOC)
        PDATA(6) = FAKE
      ENDIF
C
      NI = VCODE(2) + 1
      IF (VCODE(2) .NE. 0 .AND. LRDFLG .EQ. BLANK)
     1    LRDFLG = 'FLAG'//NUMB(NI:NI)
C
      NHSTS = NHSTS + 1
      LRFLAG(NHSTS) = LRDFLG
      GO TO 6000
C
C ---- "FLAG" --- HISTOGRAM FLAG
C
 5300 CALL DECPAR(NPFLG,DFLAG,NCFLAG,NPLIN,NPFLG)
      IF (ENDFIL) GO TO 6000
      IF (LBDAT .EQ. BLANK .AND. VCODE(2) .EQ. 0) THEN
        FLUSHL = .TRUE.
        GO TO 6000
      ENDIF
      NFLAGS = NFLAGS + 1
      NI = VCODE(2) + 1
      IF (VCODE(2) .NE. 0 .AND. LBDAT .EQ. BLANK) 
     1    LBDAT = 'FLAG'//NUMB(NI:NI)
      VCODE(2) = 0
C
      IF (IPTYP(1) .EQ. 0) THEN
        IPTYP(1) = 1
        PDATA(1) = 300.0
      ENDIF
C
      DO 5310 J = 1, 6
      JP4 = J + 4
      IF (IPTYP(JP4) .NE. 0) THEN
        PDATA(1) = PDATA(1) + FLOAT(J)
      ENDIF
 5310 CONTINUE
C
      DO 5320 J = 1, 3
      JP10 = J + 10
      IF (IPTYP(JP10) .NE. 0) THEN
        JOLD = IFIX(PDATA(1))
        JNEW = 100*(J-1) + MOD(JOLD,100)
        PDATA(1) = FLOAT(JNEW)
      ENDIF
 5320 CONTINUE
C
      IF (IPTYP(2) .EQ. 0) THEN
        IPTYP(2) = 1
        PDATA(2) = 0.0
      ENDIF
C
      IPTYP(3) = 1
      LAKE = NFLAGS
      PDATA(3) = FAKE
C
      IF (LDATA .NE. BLANK) THEN
        CALL FNDELM(LDATA,NLOC,31)
        LLOC = ISTOR(NLOC) + 1
        IPTYP(4) = 1
        LAKE = IDATA(LLOC)
        PDATA(4) = FAKE
      ENDIF
      GO TO 6000
C
C ---- "DECAY" --- DECAY CALCULATION
C
 5500 CALL DECPAR(NPDCAY,DDCAY,NCDCAY,NPLIN,NPDCAY)
      FILLIT = .TRUE.
      DO 5501 J = 1, 5
 5501 CONTINUE
      GO TO 6000
C
C---- IF ALL OK THEN DEFINE ELEMENT
C
 6000 CONTINUE
      RETURN
C-----------------------------------------------------------------------
  910 FORMAT(' *** ERROR *** ELEMENT NAME EXPECTED'/' ')
  920 FORMAT(' ** WARNING ** THE ABOVE NAME WAS DEFINED IN LINE ',I5,
     +       ', IT WILL BE REDEFINED'/' ')
  940 FORMAT(' ** WARNING ** ELEMENT NOT IMPLEMENTED --- ',
     +       'TREATED LIKE A "DRIFT"'/' ')
  950 FORMAT(' ** WARNING ** ELEMENT NOT IMPLEMENTED --- ',
     +       'TREATED LIKE A "MARKER"'/' ')
  960 FORMAT(' ** WARNING ** VALUE EXPECTED FOR PARAMETER "',
     +       A,' ',A,' "'/' ')
 1034 FORMAT ( 15H INCORRECT DATA )
 1035 FORMAT (12F5.0)
C-----------------------------------------------------------------------
      END
      SUBROUTINE ELMOD
C
C     MODIFICATION OF ELEMENTS ON SUBSEQUENT STEPS OF A GIVEN PROBLEM  
C
C     LIST OF COMMON BLOCKS
C
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'DATA0A.CIN'
      INCLUDE 'DATA0B.CIN'
      INCLUDE 'DATA1A.CIN'
      INCLUDE 'DATA1C.CIN'
      INCLUDE 'DATA2A.CIN'
      INCLUDE 'DATA2D.CIN'
      INCLUDE 'DATUM.CIN'
      INCLUDE 'FLUSHC.CIN'
      INCLUDE 'INDPAR.CIN'
      INCLUDE 'IOUNIT.CIN'
      INCLUDE 'NDICT.CIN'
      INCLUDE 'PARDAT.CIN'
      INCLUDE 'RDCARD.CIN'
      INCLUDE 'RDCHAR.CIN'
      INCLUDE 'RDWRDS.CIN'
      INCLUDE 'VCODE.CIN'
C--------------------------------------------------------------
      INTEGER         TEXT
      EXTERNAL        IDATA, TEXT
C--------------------------------------------------------------
C
      IF (FLUSHL) GO TO 400
      IF (LABLE .NE. BLANK) GO TO 100
      IF (NTYPE .NE. 0) GO TO 300
      GO TO 400
C
  100 NMATCH = 0
      DO 200 NUM = 1, NEL
      IF (LABLE .NE. LABEL(NUM)) GO TO 200
      NMATCH = NMATCH + 1
      I = ISTOR(NUM)
      IF (IABS(NTYPE) .NE. IABS(IDATA(I))) THEN
        WRITE (NOUT,9271)
 9271   FORMAT (' *** MISMATCH OF ELEMENT TYPES ***')
        FLUSHL = .TRUE.
        GO TO 200
      ELSE
        DATA(I) = DATUM(1)
      ENDIF
C
      CALL SKETCH(NUM)
C
      NW = 1
C
      NDMAX = NDSAV
      IF (NTYPE .EQ. 8) NDMAX = 8
      IF (NTYPE .EQ. 16) NDMAX = 2
      IF (NTYPE .EQ. 38) NDMAX = 20
      IF (NTYPE .EQ. 39) NDMAX = NDMAX + 2
      DO 110 J = 1, NDMAX
      IPTJ = IPTOJ(J)
      IF (IPTYP(J) .EQ. 1) THEN
        IF (IPTJ .NE. 0) THEN
          NW = NW + 1
          IADR = I + IPTJ
          DATA(IADR) = DATUM(NW)
        ELSE 
          WRITE (NOUT,9272)
 9272     FORMAT (' *** ATTEMPT TO CHANGE ORIGINALLY UNSPECIFIED ',
     1            'PARAMETER ***')
          FLUSHL = .TRUE.
        ENDIF
      ENDIF
  110 CONTINUE
C
      NP1 = NPARMS + 1
      DO 120 J = 2, NP1
      IADR = I + J - 1
      IF ((TIE(IADR) .NE. 100 .AND. TIE(IADR) .NE. 101
     1    .AND. TIE(IADR) .NE. 102) .OR. VCODE(J) .NE. 0) 
     3    TIE(IADR) = VCODE(J)
  120 CONTINUE
  200 CONTINUE
      IF (NMATCH .GE. 1) GO TO 400
C
  300 WRITE (NOUT, 9270) LABLE
 9270 FORMAT (27H0NO MATCH FOUND FOR LABEL ",A8,1H")
      FLUSHL = .TRUE.
C
  400 CONTINUE
      RETURN
      END
      SUBROUTINE ELMPAR
C---- DECODE A SINGLE PARAMETER NAME FROM A GIVEN ELEMENT TYPE
C--------------------------------------------------------------------
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'DBEAM.CIN'
      INCLUDE 'DBEND.CIN'
      INCLUDE 'DCENT.CIN'
      INCLUDE 'DCORR.CIN'
      INCLUDE 'DCVTY.CIN'
      INCLUDE 'DDRFT.CIN'
      INCLUDE 'DHKICK.CIN'
      INCLUDE 'DOCT.CIN'
      INCLUDE 'DQUAD.CIN'
      INCLUDE 'DRBND.CIN'
      INCLUDE 'DROT.CIN'
      INCLUDE 'DSEXT.CIN'
      INCLUDE 'DSOLE.CIN'
      INCLUDE 'DSROT.CIN'
      INCLUDE 'NELMS.CIN'
      INCLUDE 'NPLIN.CIN'
      INCLUDE 'NELMEQ.CIN'
      INCLUDE 'RNTYPE.CIN'
C-----------------------------------------------------------------------
C
      GO TO ( 100, 200, 300, 400, 500,5000, 700,5000,5000,5000,
     1       1100,1200,5000,5000,5000,5000,5000,1800,1900,2000,
     2       5000,5000,5000,5000,2500,5000,5000,2800,2800,5000,
     3       5000,5000,5000,3400,3500,3500,5000,5000,5000), TYPER
C
C---- "BEAM" --- INPUT PHASE SPACE
C
  100 CALL DECPAR(NBEAM,DBEAM,1,NPLIN,1)
      GO TO 5000
C
C---- "ROTATION" --- POLE FACE ROTATION
C
  200 CALL DECPAR(NROT,DROT,1,NPLIN,1)
      GO TO 5000
C
C---- "DRIFT" --- DRIFT SPACE
C
  300 CALL DECPAR(NDRFT,DDRFT,1,NPLIN,1)
      GO TO 5000
C
C---- "BEND" --- BENDING MAGNET WITHOUT FRINGING FIELDS
C
  400 CALL DECPAR(NBEND,DBEND,1,NPBEND,1)
      GO TO 5000
C
C---- "QUADRUPO" --- QUADRUPOLE
C
  500 CALL DECPAR(NQUAD,DQUAD,1,NPLIN,1)
      GO TO 5000
C
C---- "CENTROID" -- CENTROID SHIFT
C
  700 CALL DECPAR(NCENT,DCENT,1,NPLIN,1)
      GO TO 5000
C
C---- "ACCELERATOR" --- ACCELERATOR MATRIX
C
 1100 CALL DECPAR(NCVTY,DCVTY,1,NPLIN,1)
      GO TO 5000
C
C---- "CORRELATION" --- CORRELATIONS IN BEAM ELLIPSE
C
 1200 CALL DECPAR(NCORR,DCORR,1,NPLIN,1)
      GO TO 5000
C
C---- "SEXTUPOL" --- SEXTUPOLE
C
 1800 CALL DECPAR(NSEXT,DSEXT,1,NPLIN,1)
      GO TO 5000
C
C---- "SOLENOID" --- SOLENOID
C
 1900 CALL DECPAR(NSOLE,DSOLE,1,NPLIN,1)
      GO TO 5000
C
C---- "SROT" --- ROTATE AROUND LONGITUDINAL AXIS
C
 2000 CALL DECPAR(NSROT,DSROT,1,NPLIN,1)
      GO TO 5000
C
C---- "OCTUPOLE" --- OCTUPOLE
C
 2500 CALL DECPAR(NOCT,DOCT,1,NPLIN,1)
      GO TO 5000
C
C---- "RBEND" OR "SBEND" --- BENDING MAGNETS WITH FRINGING FIELDS
C
 2800 CALL DECPAR(NRBND,DRBND,1,NPRBND,1)
      GO TO 5000
C
C---- "PLASMALE" --- PLASMA LENS
C
 3400 CALL DECPAR(NQUAD,DQUAD,1,NPLIN,1)
      GO TO 5000
C
C---- "HKICK" OR "VKICK" HORIZONTAL AND VERTICAL KICK
C
 3500 CALL DECPAR(NHKCK,DHKICK,1,NPLIN,1)
      GO TO 5000
C
 5000 CONTINUE
      RETURN
      END
      SUBROUTINE ELSTOR
C---- STORE ELEMENT IN DATA ARRAYS
C--------------------------------------------------------------
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'DATA0A.CIN'
      INCLUDE 'DATA0B.CIN'
      INCLUDE 'DATA1A.CIN'
      INCLUDE 'DATA1B.CIN'
      INCLUDE 'DATA1C.CIN'
      INCLUDE 'DATA1D.CIN'
      INCLUDE 'DATA2A.CIN'
      INCLUDE 'DATA2C.CIN'
      INCLUDE 'DATUM.CIN'
      INCLUDE 'FLUSHC.CIN'
      INCLUDE 'ILAST.CIN'
      INCLUDE 'IOUNIT.CIN'
      INCLUDE 'LIMITS.CIN'
      INCLUDE 'RDCARD.CIN'
      INCLUDE 'RDCHAR.CIN'
      INCLUDE 'RDPRNT.CIN'
      INCLUDE 'RDWRDS.CIN'
      INCLUDE 'VARY.CIN'
C-----------------------------------------------------------------------
      CHARACTER*1     ILIM
      INTEGER         TEXT
C
      IF (NTYPE .EQ. 0) THEN
        IF (.NOT. LIST) GO TO 400
        ILIM = BLANK
        IF (LABLE .NE. BLANK) ILIM = APOST
        WRITE (NOUT,9700) ILIM, LABLE, ILIM, CMMNT, PARENC
 9700   FORMAT (2H  ,A1,A8,A1,2H (,79A1)
        GO TO 400
      ENDIF
C
      IF (.NOT. LIST .OR. .NOT. RFM .OR. NWORD .EQ. 0) GO TO 110
      CALL PRINT1(LABLE,NWORD,DATUM,VARY,0)
C
C     READ NEW DATA DECK
C
  110 NEL = NEL + 1
      ILAST = I
C
      IF (NEL .GT. NELLIM .OR. (I + NWORD) .GT. IDLIM) THEN
        FLUSHL = .TRUE.
        IF (NEL .GT. NELLIM) WRITE (NOUT,9001) NEL, NELLIM
 9001   FORMAT (' *** DATA OVERFLOW, NUMBER OF ELEMENTS IS ',I5,2X,
     1          'LIMIT IS ',I5,' ***')
        IF (I + NWORD .GT. IDLIM) WRITE (NOUT,9002) I + NWORD, IDLIM
 9002   FORMAT (' *** DATA OVERFLOW, NUMBER OF DATA ITEMS IS ',I5,2X,
     1          'LIMIT IS ',I5,' ***')
      ENDIF
      IF (FLUSHL) GO TO 150
      NDESCR(NEL) = NDESC
      LABEL(NEL) = LABLE
      LBTYP(NEL) = KTYPE
      IF (NWORD .EQ. 0) GO TO 140
C      
      DO 125 J = 1, NWORD
      DATA(I) = DATUM(J)
      TIE (I) = VARY (J)
  125 I = I + 1
C      
      IF (NWORD .GT. 1) THEN
        DO 135 J = 2, NWORD
        DATUM(J) = 0.0
        VARY(J) = 0
  135   CONTINUE
      ENDIF
C
  140 ISTOR(NEL+1) = I
      GO TO 400
C
  150 I = I + NWORD
C
  400 CONTINUE
      RETURN
      END
      SUBROUTINE EXILE
C
C     TRANSFER DATA TO END OF ARRAYS FOR REPROCESSING
C
C ----------------------------------------------------------------------
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'DATA0A.CIN'
      INCLUDE 'DATA0B.CIN'
      INCLUDE 'DATA1A.CIN'
      INCLUDE 'DATA1B.CIN'
      INCLUDE 'DATA1C.CIN'
      INCLUDE 'DATA2A.CIN'
      INCLUDE 'DATA2D.CIN'
      INCLUDE 'ELM0A.CIN'
      INCLUDE 'INDPAR.CIN'
      INCLUDE 'LIMITS.CIN'
C------------------------------------------------------------------------
      EQUIVALENCE     (FAKE,LAKE)
C
      NSHFT = NELLIM - NEL
      IBIG = ISTOR(NEL+1) - 1
      ISHFT = IDLIM - IBIG
C
      IOLD = 0
      NDEF = 0
      DO 100 NN = 1, NEL
      I = ISTOR(NN)
      TYPE = IDATA(I)
      IF (NUSE .EQ. 0) THEN
        IF (I .LE. IOLD) GO TO 100
      ELSE
        IF (TYPE .NE. 24 .AND. NDEF .GE. 1) GO TO 100
      ENDIF
      IOLD = MAX0(I,IOLD)
      IF (TYPE .GT. 0) CALL SKETCH(NN)
C
      IF (TYPE .EQ. 2 .OR. TYPE .EQ. 3 .OR. TYPE .EQ. 4
     1    .OR. TYPE .EQ. 5 .OR. TYPE .EQ. 7 .OR. TYPE .EQ. 8
     2    .OR. TYPE .EQ. 10 .OR. TYPE .EQ. 11 .OR. TYPE .EQ. 14 
     3    .OR. TYPE .EQ. 16 .OR. TYPE .EQ. 18 .OR. TYPE .EQ. 19 
     4    .OR. TYPE .EQ. 20 .OR. TYPE .EQ. 25 .OR. TYPE .EQ. 28 
     5    .OR. TYPE .EQ. 29 .OR. TYPE .EQ. 30 .OR. TYPE .EQ. 34 
     6    .OR. TYPE .EQ. 35 .OR. TYPE .EQ. 36 .OR. TYPE .EQ. 42) 
     7     GO TO 10
      IF (TYPE .EQ. 22) GO TO 30
      IF (TYPE .EQ. 23) GO TO 40
      IF (TYPE .EQ. 24) GO TO 50
      IF (TYPE .EQ. 50 .OR. TYPE .EQ. 51 .OR. TYPE .EQ. 52) GO TO 60
      GO TO 100
C
C     PHYSICAL ELEMENT
C
   10 DO 15 J = 1, NPARMS
      IADR = I + J
      KREG = IDATA(IADR)
      KTIE = TIE(IADR)
      IF (KTIE .EQ. 100) THEN
        KREG = KREG + ISHFT
        LAKE = KREG
        DATA(IADR) = FAKE
      ENDIF
   15 CONTINUE
      GO TO 100
C
C     IDENTIFICATION OF MATRIX ELEMENT
C
   30 JCODE = IDATA(I+2) 
      JTIE = TIE(I+2)
      IF (JTIE .EQ. 100) JCODE = JCODE + ISHFT
      LAKE = JCODE
      DATA(I+2) = FAKE
      GO TO 100
C
C     ALGEBRAIC COMBINATION
C
   40 K1TIE = TIE(I+1)
      K2TIE = TIE(I+2)
      JTIE = TIE(I+4)
      K1REG = IDATA(I+1)
      K2REG = IDATA(I+2)
      JREG = IDATA(I+4)
      IF (K1TIE .EQ. 100) K1REG = K1REG + ISHFT
      IF (K2TIE .EQ. 100) K2REG = K2REG + ISHFT
      IF (JTIE .EQ. 100) JREG = JREG + ISHFT
      LAKE = K1REG
      DATA(I+1) = FAKE
      LAKE = K2REG
      DATA(I+2) = FAKE
      LAKE = JREG
      DATA(I+4) = FAKE
      GO TO 100
C
C     DEFINED SECTION
C
   50 JDEF = IDATA(I+1)
      IF (JDEF .EQ. 1) NDEF = NDEF + 1
      IF (JDEF .EQ. 2) NDEF = NDEF - 1 
      GO TO 100
C
C     HISTOGRAM
C
   60 IPT5 = IPTOJ(5)
      IF (IPT5 .NE. 0 .AND. TIE(I+IPT5) .EQ. 100) THEN
        NCOO = IDATA(I+IPT5)
        NCOO = NCOO + ISHFT
        LAKE = NCOO
        DATA(I+IPT5) = FAKE
      ENDIF
      GO TO 100
C
  100 CONTINUE
C
      DO 110 NN = 1, NEL
      ISTOR(NN) = ISTOR(NN) + ISHFT
  110 CONTINUE
C
      IF (NUSE .NE. 0) NUSE = NUSE + NSHFT
C
      DO 120 NN = 1, NEL
      NOLD = NEL - NN + 1
      NNEW = NOLD + NSHFT
      ISTOR(NNEW) = ISTOR(NOLD)
      LABEL(NNEW) = LABEL(NOLD)
      NDESCR(NNEW) = NDESCR(NOLD)
  120 CONTINUE
C
      DO 130 IB = 1, IBIG
      I2 = IDLIM - IB + 1
      I1 = IBIG - IB + 1
      DATA(I2) = DATA(I1)
      TIE(I2) = TIE(I1)
  130 CONTINUE
C
      RETURN
      END
      SUBROUTINE FITDEF
C---- STORE REFERENCE TO MATRIX ELEMENT
C---------------------------------------------------------------------
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'DATUM.CIN'
      INCLUDE 'ICODE.CIN'
      INCLUDE 'RDPRNT.CIN'
      INCLUDE 'RDWRDS.CIN'
      INCLUDE 'STACK.CIN'
      INCLUDE 'VARY.CIN'
C
      EQUIVALENCE     (FAKE,LAKE)
C---------------------------------------------------------------------
C
C     STORE MATRIX ELEMENT SPECIFICATION
C
      IF (INDS .EQ. 0) THEN
        NWORD = 4
        NDESC = 7
        LAKE = 22
        DATUM(1) = FAKE
        LAKE = ICODE
        DATUM(2) = FAKE
        LAKE = JCODE
        DATUM(3) = FAKE
        LAKE = LEV
        DATUM(4) = FAKE
        IF (ICODE .EQ. 9) VARY(3) = 100
        CALL ELSTOR
        IVAL(LEV) = LEV
        IREF(LEV) = 0
        IF (ICODE .EQ. 9) IREF(LEV) = 100
      ENDIF
      RETURN
      END
      SUBROUTINE FIXREF
C---- CHANGE REFERENCES TO PARAMETER WHEN ELEMENT IS MOVED TO FRONT
C---- OF DATA ARRAY
C
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'DATA0A.CIN'
      INCLUDE 'DATA0B.CIN'
      INCLUDE 'DATA1A.CIN'
      INCLUDE 'ICOPY.CIN'
      INCLUDE 'LIMITS.CIN'
C-----------------------------------------------------------------------
      EQUIVALENCE     (FAKE,LAKE)
      EXTERNAL        IDATA
C     
      IEND = ISTOR(NELLIM)
      DO 20 III = ICOPY, IEND
      ITIE = TIE(III)
      IDAT = IDATA(III)
      IF (ITIE .EQ. 100 .AND. I100 .EQ. IDAT) THEN
        LAKE = IANEW
        DATA(III) = FAKE
      ENDIF
   20 CONTINUE
      RETURN
      END
      SUBROUTINE FNCORR(KNAME,LNAME,INAME)
C---- FIND AND DECODE REFERENCE TO BEAM MATRIX CORRELATION
C-----------------------------------------------------------------
      CHARACTER*15    KNAME
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'PARDAT.CIN'
C----------------------------------------------------------------
      CHARACTER*15    KNAMM
      CHARACTER*1     KLETS(8)
      EQUIVALENCE     (KNAMM,KLETS(1))
      INTEGER         IARR(6)
      DATA            IARR /0,0,1,3,6,10/
C
      KNAMM = KNAME
      INAME = 0
C
      IF (LNAME .GE. 4) GO TO 100
      IF (KLETS(1) .EQ. 'C') THEN
        IND1 = INDEX('123456',KLETS(2))
        IND2 = INDEX('123456',KLETS(3))
        IF (IND1 .EQ. 0 .OR. IND2 .EQ. 0) GO TO 100
        IF (IND1 .GT. 6 .OR. IND2 .GT. 6) GO TO 100
        IF (IND1 .EQ. IND2) GO TO 100
        IF (IND1 .LT. IND2) THEN
          ISAVE = IND1
          IND1 = IND2
          IND2 = ISAVE
        ENDIF
        IPARM = IARR(IND1) + IND2
        INAME = IPARM
      ENDIF
C
  100 CONTINUE
      RETURN
      END
      SUBROUTINE FND100
C---- LOCATE NEXT REFERENCE TO A PRECEDING PARAMETER
C
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'DATA0B.CIN'
      INCLUDE 'ICOPY.CIN'
      INCLUDE 'LIMITS.CIN'
C
      IEND = IDLIM
      DO 20 III = IB100, IEND
      IF (TIE(III) .EQ. 100) THEN
        IREF = IDATA(III)
        IF (I100 .EQ. 0 .OR. (IREF .GT. I100 .AND. I100 .LT. IB100)
     1      .OR. (IREF .LT. I100 .AND. IREF .GE. IB100)) THEN
          I100 = IREF
        ENDIF
      ENDIF
   20 CONTINUE   
      IB100 = I100 + 1
      RETURN
      END
      SUBROUTINE FNDDEF(KNAME,IELEM)
C---- DEAL WITH ELEMENT NAMELIST
C-----------------------------------------------------------------------
      CHARACTER*15    KNAME
      INTEGER         IELEM
C-----------------------------------------------------------------------
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'DATA1A.CIN'
      INCLUDE 'DATA1B.CIN'
      INCLUDE 'DATA1C.CIN'
      INCLUDE 'DATA2A.CIN'
      INCLUDE 'DATUM.CIN'
      INCLUDE 'RDCARD.CIN'
      INCLUDE 'RDWRDS.CIN'
C-----------------------------------------------------------------------
      REAL            FAKE
      INTEGER         IDATA, IPDATA, II, LAKE, TEXT
      EQUIVALENCE     (FAKE,LAKE)
      EXTERNAL        TEXT
C
C---- PREVIOUS DEFINITION?
C
      CALL RDLOOK(KNAME,15,LABEL,1,NEL,IELEM)
      IF (IELEM .EQ. 0) GO TO 100
      II = ISTOR(IELEM)
      IF (IDATA(II) .EQ. 24) GO TO 100
      NEL = NEL + 1
      ISTOR(NEL) = ISTOR(IELEM)
      LABEL(NEL) = LABEL(IELEM)
      NDESCR(NEL) = NDESCR(IELEM)
      ISTOR(NEL+1) = I
      GO TO 200
C
C---- NEW DEFINITION --- ALLOCATE ELEMENT CELL
C
  100 NDESC = 7
      LABLE = KNAME
      NWORD = 4
      LAKE = 24
      DATUM(1) = FAKE
      LAKE = IPDATA(1)
      DATUM(2) = FAKE
      DATUM(3) = 0
      DATUM(4) = 0
      CALL ELSTOR
C
  200 CONTINUE
      RETURN
      END
      SUBROUTINE FNDELM(KNAME,NPARM,TYPES)
C
C---- DEAL WITH PARAMETER, MARKER, OR STORE NAMELIST
C
      CHARACTER*15      KNAME
      INTEGER           NPARM, TYPES
C
C----------------------------------------------------------------------
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'DATA1A.CIN'
      INCLUDE 'DATA1C.CIN'
      INCLUDE 'DATA2A.CIN'
C-----------------------------------------------------------------------
      INTEGER         TYPEN
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
      NPARM = 0
      DO 100 NN = 1, NEL
      NNN = NN                      	
      II = ISTOR(NN)
      TYPEN = IDATA(II)
      IF (TYPEN .NE. TYPES) GO TO 100
      IF (KNAME .EQ. LABEL(NN)) GO TO 110
  100 CONTINUE
      GO TO 120
C
  110 NPARM = NNN
C
  120 CONTINUE
      RETURN
C-----------------------------------------------------------------------
      END
      SUBROUTINE FNDLAB(KNAME,NELMN)
C
C---- LOCATE NAMED ELEMENT
C
C-----------------------------------------------------------------------
      CHARACTER*15    KNAME
      INTEGER         NELMN
C-----------------------------------------------------------------------
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'DATA1A.CIN'
      INCLUDE 'DATA1C.CIN'
      INCLUDE 'DATA2A.CIN'
C-----------------------------------------------------------------------
      INTEGER         NUMM, TYPEC
C
      NELMN = 0
      IF (NEL .EQ. 0) GO TO 200
      DO 20 NUM = 1, NEL
      NUMM = NUM
      II = ISTOR(NUM)
      TYPEC = IDATA(II)
      IF (TYPEC .NE. 55) THEN
        IF (KNAME .EQ. LABEL(NUM)) GO TO 100
      ENDIF
   20 CONTINUE
      GO TO 200
C
  100 NELMN = NUMM
  200 CONTINUE
      RETURN
      END
      SUBROUTINE FNDNAM(KNAME,LNAME,INAME)
C
C     FIND AND DECODE MATRIX ELEMENT NAME OR CONSTRAINABLE PARAMETER     
C
C----------------------------------------------------------------------
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'ICODE.CIN'
C ---------------------------------------------------------------------
      CHARACTER*15    KNAME, KNAMM
      CHARACTER*1     KLETS(8)
      EQUIVALENCE     (KNAMM,KLETS(1))
C
      KNAMM = KNAME
      ICODE = 0
      JCODE = 0
      INUM = 2
      INAME = 0
C
C     FIRST-ORDER MATRIX CONSTRAINT
C
      IF (KLETS(1) .EQ. 'R' .AND. KLETS(2) .NE. 'O') THEN
        IF (KLETS(2) .EQ. 'A') INUM = 3
        IF (LNAME .NE. INUM + 1) GO TO 300
        IND1 = INDEX('123456',KLETS(INUM))
        IND2 = INDEX('123456',KLETS(INUM+1))
        IF (IND1 .EQ. 0 .OR. IND2 .EQ. 0) GO TO 300
        IF (INUM .EQ. 4) ICODE = - 20
        ICODE = ICODE - IND1
        JCODE = IND2
        GO TO 200
C
C     SECOND ORDER MATRIX CONSTRAINT
C
      ELSE IF (KLETS(1) .EQ. 'T') THEN
        IF (KLETS(2) .EQ. 'A') INUM = 3
        IF (LNAME .NE. INUM + 2) GO TO 300
        IND1 = INDEX('123456',KLETS(INUM))
        IND2 = INDEX('123456',KLETS(INUM+1))
        IND3 = INDEX('123456',KLETS(INUM+2))
        IF (IND1 .EQ. 0 .OR. IND2 .EQ. 0 .OR. IND3 .EQ. 0) GO TO 300
        IF (INUM .EQ. 5) ICODE = - 20
        ICODE = ICODE - IND1
        JCODE = 10*IND2 + IND3
        GO TO 200
C
C     THIRD-ORDER MATRIX CONSTRAINT
C
      ELSE IF (KLETS(1) .EQ. 'U') THEN
        IF (KLETS(2) .EQ. 'A') INUM = 3
        IF (LNAME .NE. INUM + 3) GO TO 300
        IND1 = INDEX('123456',KLETS(INUM))
        IND2 = INDEX('123456',KLETS(INUM+1))
        IND3 = INDEX('123456',KLETS(INUM+2))
        IND4 = INDEX('123456',KLETS(INUM+3))
        IF (IND1 .EQ. 0 .OR. IND2 .EQ. 0 .OR. IND3 .EQ. 0 .OR.
     1      IND4 .EQ. 0) GO TO 300
        IF (INUM .EQ. 6) ICODE = - 20
        ICODE = ICODE - IND1
        JCODE = 100*IND2 + 10*IND3 + IND4
        GO TO 200
C
C     BEAM MATRIX CONSTRAINT
C
      ELSE IF (KLETS(1) .EQ. 'S' .AND. KLETS(2) .NE. 'E'
     1   .AND. KLETS(2) .NE. 'Q') THEN
        IF (LNAME .NE. 3) GO TO 300
        IND1 = INDEX('123456',KLETS(INUM))
        IND2 = INDEX('123456',KLETS(INUM+1))
        IF (IND1 .EQ. 0 .OR. IND2 .EQ. 0) GO TO 300
        ICODE = IND1
        JCODE = IND2
        GO TO 200
C
C     BEAM CORRELATION CONSTRAINT
C
      ELSE IF (KLETS(1) .EQ. 'C') THEN
        IF (LNAME .NE. 3) GO TO 300
        IND1 = INDEX('123456',KLETS(INUM))
        IND2 = INDEX('123456',KLETS(INUM+1))
        IF (IND1 .EQ. 0 .OR. IND2 .EQ. 0) GO TO 300
        ICODE = 10 + IND1
        JCODE = IND2
        GO TO 200
C
C     BEAM SIZE CONSTRAINT
C
      ELSE IF (KNAMM .EQ. 'XBEAM' .OR. KNAMM .EQ. 'XPBEAM'
     1        .OR. KNAMM .EQ. 'YBEAM' .OR. KNAMM .EQ. 'YPBEAM'
     2        .OR. KNAMM .EQ. 'DLBEAM' .OR. KNAMM .EQ. 'DELBEAM')
     3        THEN
        IF (KNAMM .EQ. 'XBEAM') ICODE = 1
        IF (KNAMM .EQ. 'XPBEAM') ICODE = 2
        IF (KNAMM .EQ. 'YBEAM') ICODE = 3
        IF (KNAMM .EQ. 'YPBEAM') ICODE = 4
        IF (KNAMM .EQ. 'DLBEAM') ICODE = 5
        IF (KNAMM .EQ. 'DELBEAM') ICODE = 6
        JCODE = ICODE
        GO TO 200
C
C     BEAM FIRST MOMENT CONSTRAINT
C
      ELSE IF (KNAMM .EQ. 'XC' .OR. KNAMM .EQ. 'XPC'
     1        .OR. KNAMM .EQ. 'YC' .OR. KNAMM .EQ. 'YPC'
     2        .OR. KNAMM .EQ. 'DLC' .OR. KNAMM .EQ. 'DELC') THEN
        ICODE = 7
        IF (KNAMM .EQ. 'XC') JCODE = 1
        IF (KNAMM .EQ. 'XPC') JCODE = 2
        IF (KNAMM .EQ. 'YC') JCODE = 3
        IF (KNAMM .EQ. 'YPC') JCODE = 4
        IF (KNAMM .EQ. 'DLC') JCODE = 5
        IF (KNAMM .EQ. 'DELC') JCODE = 6
        GO TO 200
C
C     BEAM LENGTH CONSTRAINT
C
      ELSE IF (KNAMM .EQ. 'L') THEN
        ICODE = 0
        JCODE  = 0
        GO TO 200
C
C     AGS MACHINE CONSTRAINT
C
      ELSE IF (KNAMM .EQ. 'MUX'.OR. KNAMM .EQ. 'MUY') THEN
        IF (KNAMM .EQ. 'MUX') THEN
          IND1 = 1
          IND2 = 2
        ELSE IF (KNAMM .EQ. 'MUY') THEN
          IND1 = 3
          IND2 = 4
        ENDIF
        ICODE = - 10 - IND1
        JCODE = IND2
        GO TO 200
C
C     BEAM FIRST MOMENT CONSTRAINT
C
      ELSE IF (KNAMM .EQ. 'X' .OR. KNAMM .EQ. 'XP'
     1 .OR. KNAMM .EQ. 'Y' .OR. KNAMM .EQ. 'YP'
     2 .OR. KNAMM .EQ. 'DL' .OR. KNAMM .EQ. 'DEL') THEN
        ICODE = 0
        IF (KNAMM .EQ. 'X')   JCODE = 1
        IF (KNAMM .EQ. 'XP')  JCODE = 2
        IF (KNAMM .EQ. 'Y')   JCODE = 3
        IF (KNAMM .EQ. 'YP')  JCODE = 4
        IF (KNAMM .EQ. 'DL')  JCODE = 5
        IF (KNAMM .EQ. 'DEL') JCODE = 6
        GO TO 200
C
C     FLOOR COORDINATE CONSTRAINT
C
      ELSE
        IF (KNAMM .EQ. 'XFLOOR') JCODE = 1
        IF (KNAMM .EQ. 'YFLOOR') JCODE = 2
        IF (KNAMM .EQ. 'ZFLOOR') JCODE = 3
        IF (KNAMM .EQ. 'YAW')    JCODE = 4
        IF (KNAMM .EQ. 'PITCH')  JCODE = 5
        IF (KNAMM .EQ. 'ROLL')   JCODE = 6
        IF (KNAMM(1:4) .EQ. 'ELEV') JCODE = 7
        IF (JCODE .NE. 0) THEN
          ICODE = 8
          GO TO 200
        ENDIF
C
C     ACCELERATOR FUNCTION CONSTRAINT
C
        IF (KNAMM .EQ. 'BETAX') JCODE = 1
        IF (KNAMM .EQ. 'ALPHAX') JCODE = 2
        IF (KNAMM .EQ. 'BETAY') JCODE = 3
        IF (KNAMM .EQ. 'ALPHAY') JCODE = 4
        IF (KNAMM .EQ. 'SQBX') JCODE = 7
        IF (KNAMM .EQ. 'SQBY') JCODE = 8
        IF (JCODE .NE. 0) THEN
          ICODE = JCODE + 20
          GO TO 200
        ENDIF
C
C     ACCELERATOR FUNCTION ETA CONSTRAINT
C
        IF (KNAMM .EQ. 'ETAX')  JCODE = 1
        IF (KNAMM .EQ. 'DETAX') JCODE = 2
        IF (KNAMM .EQ. 'ETAY')  JCODE = 3
        IF (KNAMM .EQ. 'DETAY') JCODE = 4
        IF (JCODE .NE. 0) THEN
          ICODE = 27
          GO TO 200
        ENDIF
C
C     ACCELERATOR PHASE ADVANCE
C
        IF (KNAMM .EQ. 'PSIX') JCODE = 1
        IF (KNAMM .EQ. 'PSIY') JCODE = 3
        IF (JCODE .NE. 0) THEN
          ICODE = -15
          GO TO 200
        ENDIF
      ENDIF
      GO TO 300
C
C     INDICATE MATRIX ELEMENT IDENTIFIED
C
  200 INAME = 1
  300 CONTINUE
      RETURN
      END
      SUBROUTINE FNMTX(KNAME,LNAME,INAME)
C---- FIND AND DECODE FIRST-, SECOND-, OR THIRD-ORDER TRANSFER
C---- MATRIX ELEMENT
C-----------------------------------------------------------------
      CHARACTER*15    KNAME
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'ELM14A.CIN'
      INCLUDE 'PARDAT.CIN'
C----------------------------------------------------------------
      CHARACTER*15    KNAMM
      CHARACTER*1     KLETS(8)
      EQUIVALENCE     (KNAMM,KLETS(1))
C
      KNAMM = KNAME
      INAME = 0
C
      IF (LNAME .GE. 6) GO TO 100
      IF (KLETS(1) .EQ. 'R') THEN
        IF (LNAME .GE. 4) GO TO 100
        IND1 = INDEX('123456',KLETS(2))
        IND2 = INDEX('123456',KLETS(3))
        IF (IND1 .EQ. 0 .OR. IND1 .GT. 6) GO TO 100
        IF (IND2 .EQ. 0 .OR. IND2 .GT. 6) GO TO 100
        INAME = 1
        J1 = IND1
        IPARM = IND2
      ELSE IF (KLETS(1) .EQ. 'T') THEN
        IF (LNAME .GE. 5) GO TO 100
        IND1 = INDEX('123456',KLETS(2))
        IND2 = INDEX('123456',KLETS(3))
        IND3 = INDEX('123456',KLETS(4))
        IF (IND1 .EQ. 0 .OR. IND1 .GT. 6) GO TO 100
        IF (IND2 .EQ. 0 .OR. IND2 .GT. 6) GO TO 100
        IF (IND3 .EQ. 0 .OR. IND3 .GT. 6) GO TO 100
        J1 = IND1
        IPARM = 8
        DO 20 I2 = 1, 6
        DO 20 I3 = I2, 6
        IPARM = IPARM + 1
        IF (I2 .EQ. IND2 .AND. I3 .EQ. IND3) THEN
          INAME = 1
          GO TO 100
        ENDIF
   20   CONTINUE
      ELSE IF (KLETS(1) .EQ. 'U') THEN
        IND1 = INDEX('123456',KLETS(2))
        IND2 = INDEX('123456',KLETS(3))
        IND3 = INDEX('123456',KLETS(4))
        IND4 = INDEX('123456',KLETS(5))
        IF (IND1 .EQ. 0 .OR. IND1 .GT. 6) GO TO 100
        IF (IND2 .EQ. 0 .OR. IND2 .GT. 6) GO TO 100
        IF (IND3 .EQ. 0 .OR. IND3 .GT. 6) GO TO 100
        IF (IND4 .EQ. 0 .OR. IND4 .GT. 6) GO TO 100
        J1 = IND1
        IPARM = 30
        DO 30 I2 = 1, 6
        DO 30 I3 = I2, 6
        DO 30 I4 = I3, 6
        IPARM = IPARM + 1
        IF (I2 .EQ. IND2 .AND. I3 .EQ. IND3 .AND. I4 .EQ. IND4) THEN
          INAME = 1
          GO TO 100
        ENDIF
   30 CONTINUE
      ENDIF
C
  100 CONTINUE
      RETURN
      END
      INTEGER FUNCTION IDATA(I)
C
C  FUNTION TO EFFECTIVELY EQUIVALENCE REAL VARIABLES IN DATA0A COMMON
C  TO INTEGERS RETURNED BY THE FUNCTION
C  IDATA IS DECLARED INTEGER WITHIN THE DATA0A COMMON BLOCK
C
C     LIST OF COMMON BLOCKS
C
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'DATA0A.CIN'
C
      EQUIVALENCE  (FAKE,LAKE)
C
C--------------------------------------------------------------
      FAKE = DATA(I)
      IDATA = LAKE
      RETURN
      END
      SUBROUTINE INDUCT
C---- MOVE ELEMENTS TO FRONT OF DATA ARRAY, INSERTING OR REMOVING
C---- AS SPECIFIED
C
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'DATA0A.CIN'
      INCLUDE 'DATA0B.CIN'
      INCLUDE 'DATA1A.CIN'
      INCLUDE 'DATA1B.CIN'
      INCLUDE 'DATA1C.CIN'
      INCLUDE 'DATA2A.CIN'
      INCLUDE 'DATA2D.CIN'
      INCLUDE 'FLUSHC.CIN'
      INCLUDE 'INSERT.CIN'
      INCLUDE 'LABELI.CIN'
      INCLUDE 'LIMITS.CIN'
      INCLUDE 'RDCARD.CIN'      
      INCLUDE 'RDWRDS.CIN'
      INCLUDE 'ICOPY.CIN'
C-----------------------------------------------------------------------
C
      IIOLD = 0
      NUMMAX = NELLIM 
      IF (NUM .GE. NELLIM + 1) GO TO 500
   50 II = ISTOR(NUM)
      NTYPE = IABS(IDATA(II))
      LABLE = LABEL(NUM)
      IF (LABLE .EQ. LABELI) THEN
        IF (REMOVE) GO TO 200
        IF (INSERT) THEN
          IF (BEFI) THEN
            GO TO 500
          ELSE
            NUMMAX = NUM - 2
          ENDIF
        ENDIF
      ENDIF
C
C     CHANGE REFERENCES TO PHYSICAL PARAMETERS
C
      NPARMS = 0
      IF (II .LT. IIOLD) GO TO 130
      CALL SKETCH(NUM)
      NEL = NEL + 1
      NP1 = NPARMS + 1
      IIPN = II + NPARMS
      IF (I100 .EQ. 0 .OR. I100 .GT. IIPN) GO TO 100
      DO 70 J = 1, NP1
      IAD = II + J
      IF (IAD .EQ. I100) THEN
        IANEW = ISTOR(NEL) + J
        CALL FIXREF
        CALL FND100
        IF (I100 .GT. IIPN) GO TO 100
      ENDIF
   70 CONTINUE
C
C     COPY ELEMENT TO LIST AT BEGINNING OF DATA ARRAY
C
  100 DO 120 J = 1, NP1
      I1 = II + J - 1
      ICOPY = I1
      DATA(I) = DATA(I1)
      TIE(I) = TIE(I1)
      I = I + 1
  120 CONTINUE
      IF (.NOT. FLUSHL) ISTOR(NEL+1) = I
      IIOLD = MAX0(II,IIOLD)
      GO TO 180
C
  130 NNN = 0
      IF (NEL .EQ. 0) GO TO 180
      DO 140 NN = 1, NEL
      NNN = NN
      IF (LABEL(NN) .EQ. LABLE) GO TO 150
  140 CONTINUE
      GO TO 160
  150 ISTOR(NEL) = ISTOR(NNN)
  160 IF (.NOT. FLUSHL) ISTOR(NEL+1) = I
C
  180 NDESCR(NEL) = NDESCR(NUM)
      LABEL(NEL) = LABLE
C
  200 NUM = NUM + 1
      IF (NUM .LE. NUMMAX) GO TO 50
C
  500 CONTINUE
      RETURN
      END
      INTEGER FUNCTION IPDATA(I)
C-----------------------------------------------------------------------
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'PARVAL.CIN'
C----------------------------------------------------------------------
      EQUIVALENCE     (FAKE,LAKE)
C----------------------------------------------------------------------
C
      FAKE = PDATA(I)
      IPDATA = LAKE
      RETURN
      END
      INTEGER FUNCTION LENNB(STRING)
      INCLUDE 'RDCHAR.CIN'
C
      CHARACTER*15  STRING
C
      LEN = 0
      DO 10 J = 1, 15
      IF (STRING(J:J) .NE. BLANK) LEN = J
   10 CONTINUE
      LENNB = LEN
      RETURN
      END
      SUBROUTINE LCTABS (A)
      CHARACTER A*(*)
C
      PARAMETER (IUC=65, IUCL=IUC+25, ILC=97, IDI=IUC-ILC)
      CHARACTER TAB*1
      DATA      TAB /'	'/
C
      IF (A .EQ. ' ') RETURN
C
      LENA = LEN(A)
      IF (LENA .LE. 0) GO TO 10
      DO I = 1, LENA
        IF (A(I:I) .EQ. TAB) THEN
          A(I:I) = ' '
        ELSE IF (A(I:I) .NE. ' ') THEN
          JUC = ICHAR(A(I:I))
          IF ((JUC .GE. IUC) .AND. (JUC .LE. IUCL)) THEN
            JLC = JUC - IDI
            A(I:I) = CHAR(JLC)
          ENDIF
        ENDIF
      END DO
   10 RETURN
      END
      SUBROUTINE LINE
C---- DEFINE A BEAM LINE
C-----------------------------------------------------------------------
      INCLUDE 'DATUM.CIN'
      INCLUDE 'IODATA.CIN'
      INCLUDE 'IOFLAG.CIN'
      INCLUDE 'LBDAT.CIN'
      INCLUDE 'RDBUFF.CIN'
      INCLUDE 'RDCARD.CIN'
      INCLUDE 'RDCHAR.CIN'
      INCLUDE 'RDWRDS.CIN'
C-----------------------------------------------------------------------
      CHARACTER*15    KNAME
      LOGICAL         FLAG
      EQUIVALENCE     (FAKE,LAKE)
C-----------------------------------------------------------------------
C---- COMMA?
C
      IF (LBDAT .NE. BLANK) GO TO 100
      CALL RDNEXT
      IF (ENDFIL) GO TO 800
      IF (ITEM .EQ. COMMA) THEN
        CALL RDNEXT
        IF (ENDFIL) GO TO 800
      ENDIF
C
C---- BEAM LINE NAME
C
      CALL RDWORD(KNAME,LNAME)
      IF (LNAME .EQ. 0) THEN
        CALL RDFAIL
        WRITE (IECHO,910)
        GO TO 800
      ENDIF
      LBDAT = KNAME
  100 JDEF = 1
      NDESC = 1
      NWORD = 2
      LAKE = 24
      DATUM(1) = FAKE
      LAKE = JDEF
      DATUM(2) = FAKE
      LABLE = LBDAT
      CALL ELSTOR
C
C---- FORMAL ARGUMENT LIST
C
      CALL RDNEXT
      IF (ENDFIL) GO TO 800
      IF (ITEM .EQ. '(') THEN
        CALL DECFRM
        IF (ENDFIL) GO TO 800
        FLAG = ERROR
        IF (FLAG) GO TO 800
      ENDIF
C
C---- EQUALS SIGN?
C
      CALL RDTEST('=',FLAG)
      IF (FLAG) GO TO 800
C
C---- BEAM LINE LIST
C
      CALL DECLST
      FLAG = ERROR
      IF (ENDFIL .OR. FLAG) GO TO 800
C
C---- END OF COMMAND?
C
      CALL RDNEXT
      IF (ENDFIL) GO TO 800
      CALL RDTEST(';',FLAG)
      IF (FLAG) GO TO 800
C
C---- STORE DEFINITION
C
      JDEF = 2
      NDESC = 1
      NWORD = 2
      LAKE = 24
      DATUM(1) = FAKE
      LAKE = JDEF
      DATUM(2) = FAKE
      LABLE = LBDAT
      CALL ELSTOR
      GO TO 900
C
C---- ERROR EXIT --- LEAVE BEAM LINE UNDEFINED
C
  800 ERROR = .TRUE.
  900 RETURN
C-----------------------------------------------------------------------
  910 FORMAT(' *** ERROR *** BEAM LINE NAME EXPECTED'/' ')
  920 FORMAT(' ** WARNING ** THE ABOVE NAME WAS DEFINED IN LINE ',I5,
     +       ', IT WILL BE REDEFINED'/' ')
C-----------------------------------------------------------------------
      END
      SUBROUTINE OPDEF
C---- CONSTRUCT OPERATION ON PARAMETERS
C-------------------------------------------------------------------
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'DATUM.CIN'
      INCLUDE 'FLUSHC.CIN'
      INCLUDE 'INSERT.CIN'
      INCLUDE 'IODATA.CIN'
      INCLUDE 'IOUNIT.CIN'
      INCLUDE 'PARDAT.CIN'
      INCLUDE 'RDPRNT.CIN'
      INCLUDE 'RDWRDS.CIN'
      INCLUDE 'STACK.CIN'
      INCLUDE 'VARY.CIN'
C-------------------------------------------------------------------
      EQUIVALENCE     (FAKE,LAKE)
C
      IF (INDS .EQ. 0 .OR. INSERT) THEN
        NWORD = 5
        NDESC = 15
        LAKE = 23
        DATUM(1) = FAKE
        IF (IOP(LEV) .LT. 10) THEN
          LAKE = IVAL(LEV-1)
          DATUM(2) = FAKE
          VARY(2) = IREF(LEV-1)
          LAKE = IVAL(LEV)
          DATUM(3) = FAKE
          VARY(3) = IREF(LEV)
        ELSE
          LAKE = IVAL(LEV)
          DATUM(2) = FAKE
          VARY(2) = IREF(LEV)
          LAKE = 0
          DATUM(3) = FAKE
        ENDIF
        LAKE = IOP(LEV)
        DATUM(4) = FAKE
        LEV = LEV - 1
        LAKE = LEV
        DATUM(5) = FAKE
        CALL ELSTOR
      ELSE
        FLUSHL = .TRUE.
        WRITE (NOUT,9001)
 9001   FORMAT (' *** SORRY, OPERATIONS CANNOT BE INSERTED WITH ',
     1          'INDICATOR 1 ***')
        LEV = LEV - 1
      ENDIF
      IVAL(LEV) = LEV
      IREF(LEV) = 0
      IOPER = 1
      IPDAT(IPARM) = 100
C
      RETURN                                                            
      END
      SUBROUTINE PARAM
C---- DEFINE A PARAMETER
C-------------------------------------------------------------------
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'IODATA.CIN'
      INCLUDE 'IOFLAG.CIN'
      INCLUDE 'IOUNIT.CIN'
      INCLUDE 'KNAME.CIN'
      INCLUDE 'LBDAT.CIN'
      INCLUDE 'PARDAT.CIN'
      INCLUDE 'PARLOC.CIN'
      INCLUDE 'PARVAL.CIN'
      INCLUDE 'RDBUFF.CIN'
      INCLUDE 'RDCHAR.CIN'
      INCLUDE 'RDWRDS.CIN'
C-------------------------------------------------------------------
      CHARACTER*8     LOCATE, PLACE
      LOGICAL         FLAG
      DATA LOCATE     /'LOCATION'/, PLACE /'PLACE'/
C-------------------------------------------------------------------
C
      IPTYP(1) = 0
      PDATA(1) = 0.0
      LDATA = BLANK
      NWRDS = 0
C
C---- COMMA?
C
      CALL RDNEXT
      IF (ENDFIL) GO TO 900
      IF (ITEM .EQ. COMMA) THEN
        CALL RDNEXT
        IF (ENDFIL) GO TO 900
      ENDIF
      IF (ITEM .EQ. EQUAL) GO TO 120
C
C---- PARAMETER NAME
C
      CALL RDWORD(KNAME,LNAME)
      IF (LNAME .EQ. 0) THEN
        CALL RDFAIL
        WRITE (IECHO,910)
        GO TO 900
      ENDIF
      LBDAT = KNAME
      CALL RDNEXT
      IF (ENDFIL) GO TO 900
C
C---- EQUALS SIGN?
C
  120 IF (ITEM .EQ. EQUAL) THEN
C
C---- KEEP VALUES TO TEST FOR REDEFINITION
C
        IPT = -1
C
C---- PARAMETER EXPRESSION
C
        IPARM = 1
        CALL DECEXP
        IF (ENDFIL) GO TO 900
        FLAG = ERROR
        NWRDS = 1
        IF (FLAG) GO TO 800
      ELSE
        CALL RDBACK
        IPTYP(IPARM) = -2
      ENDIF
C
C---- LOCATION SPECIFICATION ? (FOR STORE COMMAND ONLY)
C
      CALL RDNEXT
      IF (ENDFIL) GO TO 900
      IF (ITEM .NE. COMMA) GO TO 300
      CALL RDNEXT
      IF (ENDFIL) GO TO 900
      IF (INDEX(ALPHA,ITEM) .NE. 0) THEN
        CALL RDWORD(KNAME,LNAME)
        IF (LNAME .EQ. 0) THEN
          CALL RDFAIL
          WRITE (NOUT,910)
          GO TO 800
        ENDIF
        IF (KNAME .NE. LOCATE(1:LNAME) .AND. KNAME .NE. PLACE(1:LNAME))
     1      THEN
          CALL RDFAIL
          WRITE (NOUT,920) KNAME(1:LNAME)
          GO TO 800
        ENDIF
        CALL RDNEXT
        IF (ENDFIL) GO TO 900
        IF (ITEM .EQ. EQUAL) THEN
          CALL RDNEXT
          IF (ENDFIL) GO TO 900
          CALL RDWORD(LDATA,LLOC)
          IF (LLOC .EQ. 0) THEN
            CALL RDFAIL
            WRITE (NOUT,910)
            GO TO 800
          ENDIF
        ENDIF
        CALL RDNEXT
        IF (ENDFIL) GO TO 900
      ELSE
        CALL RDFIND(';')
        IF (ENDFIL) GO TO 900
        ERROR = .TRUE.
        GO TO 800
      ENDIF
C
C---- END OF COMMAND?
C
  300 CALL RDTEST(';',FLAG)
      IF (FLAG) GO TO 800
C
C---- TEST FOR REDEFINITION
C
      IF (IPT .GE. 0) THEN
        CALL RDWARN
        WRITE (IECHO,950) IPT
      ENDIF
      NWORD = NWRDS + 1
      GO TO 901
C
C---- ERROR EXIT --- LEAVE PARAMETER UNDEFINED
C
  800 IPTYP(1) = -1
      PDATA(1) = 0.0
C
  900 ERROR = .TRUE.
  901 RETURN
C-------------------------------------------------------------------
  910 FORMAT(' *** ERROR *** PARAMETER NAME EXPECTED'/' ')
  920 FORMAT(' *** ERROR *** UNKNOWN BEAM ELEMENT "',A,'"'/' ')
  930 FORMAT(' *** ERROR *** PARAMETER KEYWORD EXPECTED'/' ')
  940 FORMAT(' *** ERROR *** UNKNOWN ELEMENT PARAMETER "',
     +       A,' ',A,' "'/' ')
  950 FORMAT(' ** WARNING ** THE ABOVE NAME WAS DEFINED IN LINE ',I5,
     +       ', IT WILL BE REDEFINED'/' ')
C-------------------------------------------------------------------
      END
      SUBROUTINE PARCON(IPARM,VALUE)
C---- ALLOCATE CONSTANT CELL
C
C---------------------------------------------------------------------
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'DATA2A.CIN'
      INCLUDE 'DATUM.CIN'
      INCLUDE 'RDWRDS.CIN'
C---------------------------------------------------------------------
      EQUIVALENCE     (FAKE,LAKE)
C
      IPARM = I + 1
      NWORD = 2
      NDESC = 1
      LAKE = 30
      DATUM(1) = FAKE
      DATUM(2) = VALUE
      CALL ELSTOR
      RETURN
      END
      SUBROUTINE PRINT1(LABEL,NWORD,DATA,VARY,INDEX)
C
C     PRINT DATA FOR ONE ELEMENT
C
C---------------------------------------------------------------------
      INCLUDE 'IOUNIT.CIN'
      INCLUDE 'RDCHAR.CIN'
C ----------------------------------------------------------------------
      CHARACTER*1     CHAR(15), CHARS(12), CHART(30), ILIM, ILIMO
      CHARACTER*8     LABEL
      INTEGER         VARY(100), NV(37), NVT(5)
      EQUIVALENCE     (CHAR(1), CHARS(1), CHART(1)), (NTYPE,FTYPE),
     1                (DATA2,IDATA2), (DATA3,IDATA3)
      REAL            DATA(30)
      DATA NV         /6,-1, 1,-1,-1, 0, 6, 6, 0, 1,
     1                 0,15, 0, 6, 0, 2, 0, 2, 2, 1,
     2                 0, 0, 0, 0, 2, 1, 6,-1,-1, 1,
     3                 0, 0, 0,-1,-1,-1, 0/
      DATA NVT        /1,1,1,1,0/
C
      ILIM = QUOTE
      IF (LABEL .EQ. BLANK) ILIM = BLANK
      IF (INDEX .NE. 1) ILIMO = BLANK
      IF (INDEX .EQ. 1) ILIMO = ASTER
C
      FTYPE = DATA(1)
      KTYPE = IABS(NTYPE)
      IF (KTYPE .EQ. 0) THEN
        WRITE (NOUT,970) ILIMO, ILIM, LABEL, ILIM,
     1                   (DATA(J), J = 2, NWORD), PARENC
        GO TO 100
      ENDIF
      IF (KTYPE .EQ. 16 .AND. DATA(2) .LT. 0.0) THEN
        WRITE (NOUT,980) ILIMO, NTYPE, ILIM, LABEL, ILIM,
     1                   (DATA(J), J = 2, 4)
        GO TO 100
      ENDIF
      IF (KTYPE .EQ. 16 .AND. INT(DATA(2)) .EQ. 14) THEN
        WRITE (NOUT,981) ILIMO, NTYPE, ILIM, LABEL, ILIM,
     1                   DATA(2), DATA(3)
        GO TO 100
      ENDIF
C
      DO 10 J = 1, 30
   10 CHART(J) = BLANK
      IF (NTYPE .LT. 0) GO TO 40
      IF (NTYPE .GT. 37 .AND. NTYPE .LT. 50) GO TO 40
      IF (NTYPE .GE. 55) GO TO 40
C
      IF (NTYPE .LE. 36) THEN
        KV = NV(NTYPE)
        IF (KV .LT. 0) KV = NWORD - 1
      ENDIF
      IF (NTYPE .GE. 50) KV = NVT(NTYPE - 49)
      IF (KV .EQ. 0) GO TO 40
      LV = 0
      LPV = 0
C
      DO 30 JV = 1, KV
      K = IABS(VARY(JV+1))
      IF (K .GE. 99) K = 0
      IF (VARY(JV+1) .GE. 0) GO TO 20
      LV = LV + 1
      CHAR(LV) = MINUS
   20 LV = LV + 1
      IF (K .GT. 1) LPV = LV
   30 CHAR(LV) = TABLE(K+1)
C
      IF (KTYPE .EQ. 12 .AND. LPV .GT. 12) THEN
        WRITE (NOUT,945) ILIMO, NTYPE, CHART, ILIM, LABEL, ILIM,
     1                   (DATA(J), J = 2, NWORD), SEMI
        GO TO 100
      ENDIF
C
   40 IF (NWORD .LE. 1) THEN
        WRITE (NOUT,960) ILIMO, NTYPE, CHARS, ILIM, LABEL, ILIM
        GO TO 100
      ENDIF
      IF (KTYPE .EQ. 10) THEN
        DATA2 = DATA(2)
        DATA2 = FLOAT(IDATA2)
        DATA3 = DATA(3)
        DATA3 = FLOAT(IDATA3)
        WRITE (NOUT,940) ILIMO, NTYPE, CHARS, ILIM, LABEL, ILIM,
     1                   BLANK, DATA2, BLANK, DATA3, BLANK, DATA(4),
     2                   BLANK, DATA(5), SEMI
        GO TO 100
      ENDIF
      IF (KTYPE .EQ. 4 .AND. (DATA(4) .LE. -10000.
     1    .OR. DATA(4) .GE. 100000.)) THEN
        WRITE (NOUT,942) ILIMO, NTYPE, CHARS, ILIM, LABEL, ILIM,
     1                   (DATA(J), J = 2, 4), SEMI
      ELSE
        WRITE (NOUT,940) ILIMO, NTYPE, CHARS, ILIM, LABEL, ILIM,
     1                 (BLANK, DATA(J), J = 2, NWORD), SEMI
      ENDIF
      GO TO 100
C
  100 CONTINUE
      RETURN
C
  940 FORMAT (1H ,A1,I4,'.',12A1,1X,A1,A4,A1,1X,A1,8(F11.5,A1)/
     1       (28X,8(F11.5,A1)))
  942 FORMAT (1H ,A1,I4,'.',12A1,1X,A1,A4,A1,1X,2F12.5,E13.5,A1)
  945 FORMAT (1H ,A1,I4,'.',30A1,1X,A1,A4,A1,7X,6(F12.5)/
     1       /27X,8F12.5/27X,F12.5,A1)
  960 FORMAT (1H ,A1,I4,'.',12A1,1X,A1,A4,A1,1X,1H;)
  970 FORMAT (1H ,A1,A1,A4,A1,2H (,29A4,A1)
  980 FORMAT (1H ,A1,I4,'.',13X,A1,A4,A1,1X,F12.5,E12.4,F12.5,';')
  981 FORMAT (1H ,A1,I4,'.',A1,A4,A1,1X,F12.5,I12,';')
      END
      SUBROUTINE RDBACK
C
C     TAKE A STEP BACK IF CHARACTER IS NOT WHAT WAS ANTICIPATED
C
      INCLUDE 'IODATA.CIN'
      INCLUDE 'RDBUFF.CIN'
C
      ICOL = ICOL - 1
      IF (ICOL .GE. 1) ITEM = KLINE(ICOL)
      RETURN
      END
      SUBROUTINE RDDATA
C---- READ THE DATA UP TO THE NEXT SENTINEL
C---------------------------------------------------------------------
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'CONSTS.CIN'
      INCLUDE 'DATA0A.CIN'
      INCLUDE 'DATA0B.CIN'
      INCLUDE 'DATA1A.CIN'
      INCLUDE 'DATA1B.CIN'
      INCLUDE 'DATA1C.CIN'
      INCLUDE 'DATA2A.CIN'
      INCLUDE 'NFLAGS.CIN'
      INCLUDE 'FLUSHC.CIN'
      INCLUDE 'INSERT.CIN'
      INCLUDE 'IODATA.CIN'
      INCLUDE 'IOFLAG.CIN'
      INCLUDE 'IOUNIT.CIN'
      INCLUDE 'NHORN.CIN'
      INCLUDE 'RDHIST.CIN'
      INCLUDE 'RDPRNT.CIN'
      INCLUDE 'RDWRDS.CIN'
      INCLUDE 'SVALUE.CIN'
      INCLUDE 'UROT.CIN'
C-----------------------------------------------------------------------
C
      NEL = 0
      I = 1
      ISTOR(1) = 1
      FLUSHL = .FALSE.
      NMARKS = 0
      UROT = 1.0/RADIAN
      SVALUE(1) = PI
      SVALUE(2) = 2.0*PI
      SVALUE(3) = RADIAN
      SVALUE(4) = 1.0/RADIAN
      SVALUE(5) = EXP(1.0)
      SVALUE(6) = EMASS
      SVALUE(8) = CLIGHT
      SVALUE(10) = 1.0/SVALUE(9)
      REMOVE = .FALSE.
      INSERT = .FALSE.
      NFLAGS = 0
      NHSTS = 0
      NHORN = 0
C
      IF (BRD) GO TO 200
C
  110 CALL RDELMT
      IF (ENDFIL) GO TO 400
      IF (NTYPE .EQ. 73) GO TO 400
      GO TO 110
C
  200 READ (NDATA) NEL, IEL
      NELP1 = NEL + 1
      READ (NDATA) (DATA(I), I = 1, IEL)
      READ (NDATA) (TIE(I), I = 1, IEL)
      READ (NDATA) (ISTOR(N), N = 1, NELP1)
      READ (NDATA) (NDESCR(N), N = 1, NEL)
      READ (NDATA) (LABEL(N), N = 1, NEL)
C
  400 FLUSHL = FLUSHL .OR. NFAIL .GE. 1
      CALL RDEND
      RETURN
      END
      SUBROUTINE RDELMT
C
C     READ IN DATA FOR ONE ELEMENT
C
C---------------------------------------------------------------------
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'DATA0A.CIN'
      INCLUDE 'DATA1A.CIN'
      INCLUDE 'DATA1B.CIN'
      INCLUDE 'DATA1C.CIN'
      INCLUDE 'DATA1D.CIN'
      INCLUDE 'DATA1E.CIN'
      INCLUDE 'DATA2A.CIN'
      INCLUDE 'DATA2C.CIN'
      INCLUDE 'DATUM.CIN'
      INCLUDE 'FLUSHC.CIN'
      INCLUDE 'IODATA.CIN'
      INCLUDE 'IOFLAG.CIN'
      INCLUDE 'IOUNIT.CIN'
      INCLUDE 'KELEM.CIN'
      INCLUDE 'LBDAT.CIN'
      INCLUDE 'PARDAT.CIN'
      INCLUDE 'PARLOC.CIN'
      INCLUDE 'PARVAL.CIN'
      INCLUDE 'RDBUFF.CIN'
      INCLUDE 'RDCARD.CIN'
      INCLUDE 'RDCHAR.CIN'
      INCLUDE 'RDPRNT.CIN'
      INCLUDE 'RDWRDS.CIN'
      INCLUDE 'VARY.CIN'
      INCLUDE 'VCODE.CIN'
C
C     LOCAL VARIABLES
C
      CHARACTER*1     COLON
      PARAMETER       (NCOMM = 16)
      CHARACTER*15    CWORD, KCOMM(NCOMM), KNAME
      INTEGER         NTELM(NELEM)
      LOGICAL         FLAG
      EQUIVALENCE     (FAKE,LAKE)
      EXTERNAL        IDATA
C
      DATA            NTMAX /NELMCT/, NNMAX /NELEM/
      DATA            COLON /':'/
C-------------------------------------------------------------------
      DATA NTELM / 1, 2, 3, 4, 5, 6, 7, 8, 9,10,
     1            11,12,13,14,15,16,17,18,19,20,
     2            21,22,23,24,25,26,27,28,29,30,
     3            31,32,33,34,35,36,37,38,39,40,
     4            41,42,43,44,45,46,47,48,49,50,
     5            51,52,53,54,60, 3, 3, 3, 3, 3,
     6             6,13,13,13/
C-------------------------------------------------------------------
      DATA (KCOMM(I), I = 1, NCOMM)
     +     / 'LINE    ','SENTINEL','SURVEY  ','USE     ',
     +       'VARY    ','FIX     ','BEFORE  ','AFTER   ',
     +       'REMOVE  ','ENDINSERT','UMAD    ','UTRANS  ',
     +       'UMETER  ','UMM     ','UMICRON ','STEP' /
C-------------------------------------------------------------------
C
C     SET DEFAULT VALUES
C
   10 DO 20 J = 1, 100
      DATUM(J) = 0.0
      VARY(J)  = 0
   20 VCODE(J) = 0
      DO 30 J = 1, MAXPAR
      IPTYP(J) = 0
      IPDAT(J) = 0
      IOPERS(J) = 0
   30 PDATA(J) = 0.0
      NWORD = 0
      NVARY = 0
      LABLE = BLANK
      LBDAT = BLANK
      LDATA = BLANK
      LRDFLG = BLANK
C
C     SEPARATORS
C
  100 CALL RDNEXT
      IF (ENDFIL) GO TO 700
      IF (ITEM .EQ. COMMA) GO TO 100
      IF (ITEM .EQ. SEMI .OR. ITEM .EQ. ASTER
     1   .OR. ITEM .EQ. DOLLAR) THEN
        IF (NWORD .EQ. 0) THEN
          IF (LABLE .EQ. BLANK) GO TO 100
          IF (LABLE .NE. BLANK) GO TO 360
        ENDIF
        IF (NWORD .GE. 1) GO TO 500
      ENDIF
  110 IF (ITEM .EQ. QUOTE .OR. ITEM .EQ. APOST .OR. ITEM .EQ. EQUAL
     1    .OR. ITEM .EQ. SLASH) GO TO 350
      IF (ITEM .EQ. PARENO) GO TO 400
      IF (ITEM .EQ. PARENC) GO TO 130
      GO TO 150
  130 CALL RDFAIL
      GO TO 700
  150 IF (NWORD .GE. 1) GO TO 300
C
C     TYPE CODE (OR LABEL)
C
  200 ISIG = 0
      IF (ITEM .EQ. PLUS) THEN
        CALL RDFWRD
      ENDIF
      IF (ITEM .EQ. MINUS) THEN
        CALL RDFWRD
        ISIG = 1
      ENDIF
      IND = INDEX(NUMB,ITEM)
      IF (IND .NE. 0) GO TO 220
      CALL RDWORD(KNAME,LNAME)
      ICOLB = ICOL
      CALL RDNEXT
      IF (ENDFIL) GO TO 700
      IF (ITEM .EQ. '(') THEN
        CALL DECFRM
        IF (ENDFIL) GO TO 700
        FLAG = ERROR
      ENDIF
      IF (ITEM .EQ. COLON) THEN
        LBDAT = KNAME
        CALL RDNEXT
        IF (ENDFIL) GO TO 700
        IF (ITEM .EQ. EQUAL) THEN
          NTYPE = 30
          CALL RDBACK
          GO TO 300
        ELSE
          CALL RDBACK
        ENDIF
        GO TO 100
      ELSE
        ICOL = ICOLB
        ITEM = KLINE(ICOL)
      ENDIF
      CALL RDLOOK(KNAME,LNAME,KELEM,1,NNMAX,IELEM)
      IF (IELEM .GE. 1) THEN
        NTYPE = NTELM(IELEM)
        ENAME = KNAME
        GO TO 230
      ENDIF
      CALL RDLOOK(KNAME,LNAME,KCOMM,1,NCOMM,IELEM)
      IF (IELEM .GE. 1) THEN
        NTYPE = IELEM + 71
        GO TO 230
      ENDIF
      IF (IELEM .EQ. 0) THEN
        CALL RDFAIL
        CALL RDFIND (';')
        GO TO 700
      ENDIF
C
  220 CALL RDINT (NTYPE, FLAG)
      IF (ENDFIL) GO TO 700
      IF (FLAG) GO TO 130
  230 NWORD = 1
      LAKE = NTYPE
      IF (ISIG .EQ. 1) LAKE = - LAKE
      DATUM(1) = FAKE
  240 ITEM = KLINE(ICOL+1)
      IF (ITEM .NE. PERIOD) GO TO 300
C
C     VARY CODES
C
      CALL RDFWRD
      NVARY = NVARY + 1
  260 CALL RDFWRD
      FLAG = .FALSE.
      IF (ITEM .EQ. MINUS) GO TO 270
      ISIG = 1
      IF (ITEM .NE. PLUS) GO TO 280
      GO TO 275
  270 ISIG = - 1
  275 CALL RDFWRD
      FLAG = .TRUE.
  280 JNUM = INDEX(ALFNUM,ITEM)
      IF (JNUM .NE. 0) GO TO 290
      IF (FLAG) GO TO 130
      CALL RDBACK
      GO TO 300
  290 IF (NVARY .GE. 30) GO TO 260
      NVARY = NVARY + 1
      VCODE(NVARY) = ISIGN(JNUM - 1, ISIG)
      GO TO 260
C
C     DATA VALUE
C
  300 CALL CNTROL
      IF (ENDFIL) GO TO 700
      IF (ERROR) THEN
        IF (RFM) WRITE (NOUT,9510)
        IF (.NOT. RFM) WRITE (NOUT,9520)
        FLUSHL = .TRUE.
      ENDIF
      IF (NTYPE .EQ. 73) GO TO 450
      GO TO 500
C
C     LABEL
C
  350 CALL RDSTRG (CWORD, 15, L)
      IF (L .GT. 15) WRITE (NOUT, 9350)
      IF (LABLE .NE. BLANK) WRITE (NOUT, 9360) LABLE
      LBDAT = CWORD
      GO TO 100
C
C     SEARCH FOR PREVIOUS OCCURANCE OF LABEL
C
  360 DO 370 N = 1, NEL
      NN = NEL - N + 1
      IF (LABEL(NN) .EQ. LBDAT) GO TO 380
  370 CONTINUE
      GO TO 500
  380 IEL = ISTOR(NN)
      NEL = NEL + 1
      ISTOR(NEL+1) = ISTOR(NEL)
      ISTOR(NEL) = IEL
      NTYPE = IDATA(IEL)
      NDESCR(NEL) = NDESCR(NN)
      LABEL(NEL) = LABEL(NN)
      GO TO 500
C
C     COMMENT
C
  400 IF (NWORD .NE. 0) GO TO 130
      NTYPE = 0
      CALL RDSTRG (CMMNT, 78, L)
      IF (L .GT. 78) WRITE (NOUT, 9400)
      NWORD = MIN0(L+1, 80)
      GO TO 700
C
C     SENTINEL
C
  450 GO TO 700
C
C     CHECK VALIDITY OF ELEMENT JUST READ
C
  500 IF (NTYPE .EQ. 0) GO TO 510
      IF (NTYPE .LE. NTMAX) GO TO 530
      IF (NTYPE .EQ. 72 .OR. NTYPE .EQ. 73
     1 .OR. (NTYPE .GE. 75 .AND. NTYPE .LE. NCOMM + 71)) GO TO 700
      IF (NTYPE .LT. 50) GO TO 510
      IF (NTYPE .GT. 56 .AND. NTYPE .NE. 60) GO TO 510
      GO TO 700
C
  510 IF (RFM) WRITE (NOUT, 9510)
      IF (.NOT. RFM) WRITE (NOUT,9520)
      FLUSHL = .TRUE.
      GO TO 700
C
  530 IF (NTYPE .EQ. 16) THEN
        IE = ISTOR(NEL)
        ICODE = INT(DATA(IE+1))
        IVAL = IDATA(IE+2)
        IF (IDATA(IE) .GT. 0 .AND. ICODE .EQ. 14 .AND. IVAL .EQ. 0)
     1      CALL RCLOCK(IDATA(IE+2))
      ENDIF
C
C     PRINT OUT
C
  700 CONTINUE
      RETURN
C
 9130 FORMAT ('0SCANNING STOPS DUE TO ERROR AT POSITION SHOWN BELOW',/
     1        11X,A80/10X,81A1)
 9350 FORMAT ('0NEXT LABEL TRUNCATED TO 15 CHARS.')
 9360 FORMAT (8H0LABEL ",A8,33H" ON NEXT ELEMENT WAS OVERWRITTEN)
 9400 FORMAT ('0NEXT COMMENT TRUNCATED TO 116 CHARS.')
 9500 FORMAT ('0NEXT ELEMENT IS HISTOGRAM - IGNORED')
 9510 FORMAT ('0NEXT ELEMENT IS ILLEGAL - RUN FLUSHED')
 9520 FORMAT ('0PREVIOUS ELEMENT IS ILLEGAL - RUN FLUSHED')
 9560 FORMAT ('0DATA LIST FOR NEXT ELEMENT IS TOO LONG')
      END
      SUBROUTINE RDEND
C---- PRINT NUMBER OF ERROR MESSAGES GENERATED
C-------------------------------------------------------------------
      INCLUDE 'IODATA.CIN'
      INCLUDE 'IOUNIT.CIN'
C-------------------------------------------------------------------
      IF (NWARN .NE. 0 .OR. NFAIL .NE. 0) THEN
        WRITE (NOUT,910)
        WRITE (NOUT,920) NWARN
        WRITE (NOUT,930) NFAIL
        WRITE (NOUT,940)
      ENDIF
      RETURN
C-------------------------------------------------------------------
  910 FORMAT('1**************************************')
  920 FORMAT(' * NUMBER OF WARNING MESSAGES =',I6,' *')
  930 FORMAT(' * NUMBER OF FATAL ERRORS     =',I6,' *')
  940 FORMAT(' **************************************')
C-------------------------------------------------------------------
      END
      SUBROUTINE RDENDF
C---- PRINT THAT END OF FILE HAS BEEN ENCOUNTERED
C-------------------------------------------------------------------
      INCLUDE 'IOUNIT.CIN'
C-------------------------------------------------------------------
      WRITE (NOUT,910)
      RETURN
C-------------------------------------------------------------------
  910 FORMAT (' ***END OF FILE ENCOUNTERED')
C-------------------------------------------------------------------
      END
      SUBROUTINE RDFAIL
C---- MARK PLACE OF FATAL INPUT ERROR
C-------------------------------------------------------------------
      INCLUDE 'IODATA.CIN'
      INCLUDE 'IOUNIT.CIN'
      INCLUDE 'RDBUFF.CIN'
C-------------------------------------------------------------------
      WRITE (NOUT,910) ILINE, KTEXT
      WRITE (NOUT,920) IMARK, (' ', I = 1, IMARK), '?'
      NFAIL = NFAIL + 1
      RETURN
C-------------------------------------------------------------------
  910 FORMAT('0* LINE',I5,' * ',A80)
  920 FORMAT(' * COLUMN',I3,' *',82A1)
C-------------------------------------------------------------------
      END
      SUBROUTINE RDFWRD
C---- READ NEXT CHARACTER IN DATA
C
      INCLUDE 'IODATA.CIN'
      INCLUDE 'RDBUFF.CIN'
C
      ICOL = ICOL + 1
      ITEM = KLINE(ICOL)
      RETURN
      END
      SUBROUTINE RDFIND(STRING)
C---- FIND NEXT CHARACTER OCCURRING IN "STRING"
C-------------------------------------------------------------------
      CHARACTER*(*)   STRING
C-------------------------------------------------------------------
      INCLUDE 'IODATA.CIN'
      INCLUDE 'IOFLAG.CIN'
      INCLUDE 'RDBUFF.CIN'
C-------------------------------------------------------------------
   10 ITEM = KLINE(ICOL)
      IF ((.NOT.ENDFIL) .AND. (INDEX(STRING,ITEM) .EQ. 0)) THEN
        CALL RDNEXT
        IF (.NOT. ENDFIL) GO TO 10
      ENDIF
      RETURN
C-------------------------------------------------------------------
      END
      SUBROUTINE RDIND(FLAG)
C---- READ INDICATOR CARD WITH POSSIBLE KEYWORDS 
C---------------------------------------------------------------------
      LOGICAL         FLAG
C---------------------------------------------------------------------
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'DATA2D.CIN'
      INCLUDE 'IOFLAG.CIN'
      INCLUDE 'NPLIN.CIN'
      INCLUDE 'OUTFIL.CIN'
      INCLUDE 'PARDAT.CIN'
      INCLUDE 'PARVAL.CIN'
      INCLUDE 'PRINTC.CIN'
      INCLUDE 'PRINTL.CIN'
      INCLUDE 'RDBUFF.CIN'
      INCLUDE 'RDCARD.CIN'
      INCLUDE 'RDCHAR.CIN'
      INCLUDE 'RDCOMS.CIN'
      INCLUDE 'RDPRNT.CIN'
      INCLUDE 'RDWRDS.CIN'
C ---------------------------------------------------------------------
      CHARACTER*15    DIND(16)
C
      DATA NIND /16/
      DATA DIND( 1) /'INDICATO'/
      DATA DIND( 2) /'NORAYS'/
      DATA DIND( 3) /'NOLIST'/
      DATA DIND( 4) /'REFORMAT'/
      DATA DIND( 5) /'NOBEFORE'/
      DATA DIND( 6) /'NOPRINT'/
      DATA DIND( 7) /'NOSOLVE'/
      DATA DIND( 8) /'BWRITE'/
      DATA DIND( 9) /'BREAD'/
      DATA DIND(10) /'PRINT'/
      DATA DIND(11) /'MAD'/
      DATA DIND(12) /'TRANSPORT'/
      DATA DIND(13) /'LATDEF'/
      DATA DIND(14) /'STRUCT'/
      DATA DIND(15) /'ACAD'/
      DATA DIND(16) /'FILE'/
C
      DO 30 J = 1, MAXPAR
      IPTYP(J) = 0
      IPDAT(J) = 0
      IOPERS(J) = 0
   30 PDATA(J) = 0.0

      FLAG = .TRUE.
      NCOMS = 0
   40 CALL RDNEXT
      IF (ENDFIL) GO TO 100
      IF (ITEM .EQ. SEMI .OR. ITEM .EQ. ASTER .OR. ITEM .EQ. DOLLAR)
     1    GO TO 40
      IF (ITEM .NE. PARENO) GO TO 50
      NCOMS = NCOMS + 1
      CALL RDSTRG(CMMNT,78,L)
      LCOM = L
      IF (L .EQ. -1) GO TO 50
      GO TO 40
C
   50 IF (INDEX(NUMB,ITEM) .EQ. 0) GO TO 100
      FLAG = .FALSE.
      CALL RDBACK
      NTYPE = 0
      OUTFIL = ' '
      LOUTF = 0
      CALL DECPAR(NIND,DIND,2,NPLIN,NIND)
      IF (ENDFIL) GO TO 100
      IF (IPTYP(1) .NE. 0) INDIC = INT(PDATA(1))
      IF (IPTYP(2) .EQ. 0) NORAYS = INT(PDATA(1))
      IF (IPTYP(2) .NE. 0) NORAYS = INT(PDATA(2))
      IF (IPTYP(3) .EQ. -2) LIST = .FALSE.
      IF (IPTYP(4) .EQ. -2) RFM = .TRUE.
      IF (IPTYP(5) .EQ. -2) BEF = .FALSE.
      IF (IPTYP(6) .EQ. -2) PRNT = .FALSE.
      IF (IPTYP(7) .EQ. -2) SLV = .FALSE.
      IF (IPTYP(8) .EQ. -2) BWT = .TRUE.
      IF (IPTYP(9) .EQ. -2) BRD = .TRUE.
      IF (.NOT. SLV) PRNT = .FALSE.
      IF (.NOT. PRNT) BEF = .FALSE.
C
      IF (IPTYP(10) .EQ. -2 .AND. IPTYP(11) .EQ. -2) THEN
        MADL = .TRUE.
        MADFILE = OUTFIL
        LMADF = LOUTF
      ENDIF
C
      IF (IPTYP(10) .EQ. -2 .AND. IPTYP(12) .EQ. -2) THEN
        TRANSPORTL = .TRUE.
        TRANSPORTFILE = OUTFIL
        LTRANSPORTF = LOUTF
      ENDIF
C
      IF (IPTYP(10) .EQ. -2 .AND. IPTYP(13) .EQ. -2) THEN
        LATDEFL = .TRUE.
        LATDEFFILE = OUTFIL
        LLATDEFF = LOUTF
      ENDIF
C
      IF (IPTYP(10) .EQ. -2 .AND. IPTYP(14) .EQ. -2) THEN
        STRUCTL = .TRUE.
        STRUCTFILE = OUTFIL
        LSTRUCTF = LOUTF
      ENDIF
C
      IF (IPTYP(10) .EQ. -2 .AND. IPTYP(15) .EQ. -2) THEN
        ACADL = .TRUE.
        ACADFILE = OUTFIL
        LACADF = LOUTF
      ENDIF
C
      IF (IPTYP(10) .EQ. -2 .AND. IPTYP(16) .EQ. -2) THEN
        FILEL = .TRUE.
      ENDIF
C
      INDS = MOD(INDIC,10)
      INDP = MOD(INDIC/10,10)
      IF (INDP .NE. 0) LIST = .FALSE.
  100 CONTINUE
      RETURN
      END
      SUBROUTINE RDINIT(LDATA,LECHO)
C
C---- INITIALIZE READ PACKAGE
C
C     LIST OF COMMON BLOCKS
C
      INCLUDE 'IODATA.CIN'
      INCLUDE 'IOFLAG.CIN'
      INCLUDE 'RDBUFF.CIN'
C
C     LOCAL VARIABLES
C
      INTEGER         LDATA, LECHO
C
C-------------------------------------------------------------------
      LDATA = LDATA
      IECHO = LECHO
      ILINE = 0
      ICOL  = 81
      IMARK = 1
      NWARN = 0
      NFAIL = 0
      ENDFIL = .FALSE.
      KTEXT = ' '
      KLINE(81) = ';'
      RETURN
C-------------------------------------------------------------------
      END
      SUBROUTINE RDINT(IVAL,FLAG)
C---- DECODE UNSIGNED INTEGER
C-------------------------------------------------------------------
      LOGICAL         FLAG
C-------------------------------------------------------------------
      INCLUDE 'IODATA.CIN'
      INCLUDE 'IOFLAG.CIN'
      INCLUDE 'IOUNIT.CIN'
      INCLUDE 'RDBUFF.CIN'
      INCLUDE 'RDCHAR.CIN'
C-------------------------------------------------------------------
      CHARACTER*10    NUMREP
      INTEGER         ICOLB, IDIG, ISTART
C-------------------------------------------------------------------
      FLAG = .TRUE.
      IVAL = 0
      NUMREP = BLANK
      ICOLB = ICOL
   10 IDIG = INDEX('0123456789',ITEM) - 1
      IF (IDIG .GE. 0) THEN
        FLAG = .FALSE.
        CALL RDFWRD
        GO TO 10
      ELSE
        CALL RDBACK
        ISTART = ICOLB + 10 - ICOL
        NUMREP(ISTART:10) = KTEXT(ICOLB:ICOL)
        READ (NUMREP,930) IVAL
      ENDIF
      IF (FLAG) THEN
        CALL RDFAIL
        WRITE (NOUT,910)
      ELSE IF (INDEX('.DE',ITEM) .NE. 0) THEN
        CALL RDSKIP('0123456789.E')
        IF (ENDFIL) GO TO 20
        CALL RDFAIL
        WRITE (NOUT,920)
        FLAG = .TRUE.
        IVAL = 0
      ENDIF
   20 CONTINUE
      RETURN
C-------------------------------------------------------------------
  910 FORMAT(' *** ERROR *** UNSIGNED INTEGER EXPECTED'/' ')
  920 FORMAT(' *** ERROR *** REAL VALUE NOT PERMITTED'/' ')
  930 FORMAT (I10)
C-------------------------------------------------------------------
      END
      SUBROUTINE RDLINE
C---- READ INPUT LINE AND PRINT ECHO
C-------------------------------------------------------------------
      INCLUDE 'DATA2A.CIN'
      INCLUDE 'IODATA.CIN'
      INCLUDE 'IOFLAG.CIN'
      INCLUDE 'IOUNIT.CIN'
      INCLUDE 'RDBUFF.CIN'
      INCLUDE 'RDPRNT.CIN'
C-------------------------------------------------------------------
C
      IF (.NOT. ENDFIL) THEN
        IF (NEL .EQ. 0 .OR. INDS .NE. 0 .OR. .NOT. ECHO .OR. RFM)
     1      GO TO 10
        IF (MOD(ILINE,5) .EQ. 0) THEN
          WRITE (NOUT,9140) NEL
 9140     FORMAT (1H+,95X,1H(,I4,' ELEMENTS)')
        ELSE
          WRITE (NOUT,9141) NEL
 9141     FORMAT (1H+,95X,1H(,I4,9X,')')
        ENDIF
C
   10   READ (NIN,910,IOSTAT=ISTAT) KTEXT
        ILINE = ILINE + 1
        IMARK = 1
        ICOL = 0
C
C---- READ ERROR?
C
        IF (ISTAT .GT. 0) THEN
          WRITE (NOUT,920) ILINE
          NFAIL = NFAIL + 1
          ENDFIL = .TRUE.
C
C---- END OF FILE?
C
        ELSE IF (ISTAT .LT. 0) THEN
          ENDFIL = .TRUE.
          KTEXT = ']]] END OF FILE ]]]'
          ICOL = 1
          ITEM = KLINE(ICOL)
C
C---- READ WAS OK
C
        ELSE IF (ECHO .AND. .NOT. RFM) THEN
          IF (MOD(ILINE,5) .EQ. 0) THEN
            WRITE (NOUT,930) ILINE, KTEXT
          ELSE
            WRITE (NOUT,940) KTEXT
          ENDIF
        ENDIF
        CALL UCTABS(KTEXT)
        KLINE(81) = ';'
      ENDIF
      RETURN
C-------------------------------------------------------------------
  910 FORMAT(A80)
  920 FORMAT('0*** ERROR *** READ ERROR ON LOGICAL UNIT ',I2,
     +       ', LINE ',I4,' --- EXECUTION TERMINATED')
  930 FORMAT(' ',I5,5X,A80)
  940 FORMAT(11X,A80)
C-------------------------------------------------------------------
      END
      SUBROUTINE RDLOOK(KWORD,LWORD,KDICT,IDICT1,IDICT2,IDICT)
C---- FIND WORD "KWORD" OF LENGTH "LWORD" IN DICTIONARY "KDICT"
C-------------------------------------------------------------------
      CHARACTER*15    KDICT(*), KWORD
C-------------------------------------------------------------------
      CHARACTER*15      KTEMP, BLANK
      DATA BLANK        /' '/
C-------------------------------------------------------------------
C
      IDICS = 0
      IF (IDICT1 .EQ. 0) GO TO 20
      IF (IDICT1 .GT. IDICT2) GO TO 20
      L = MAX0(4,LWORD)
      DO 10 IDIC = IDICT1, IDICT2
        IF (IDICS .NE. 0 .AND. IDIC .GT. IDICS + 20) GO TO 20
        KTEMP = KDICT(IDIC)(1:L)
        IF (KWORD .EQ. KTEMP) THEN
          LENG = 4
          DO 5 LL = 5, 8
          IF (KDICT(IDIC)(LL:LL) .EQ. BLANK) GO TO 6
          LENG = LL
    5     CONTINUE
    6     IF (L .EQ. LENG) GO TO 30
          IF (IDICS .EQ. 0) IDICS = IDIC
        ENDIF
   10 CONTINUE
   20 IDICT = 0
      IF (IDICS .NE. 0) IDICT = IDICS
      GO TO 50
C
   30 IDICT = IDIC
C
   50 RETURN
      END
      SUBROUTINE RDNEXT
C---- FIND NEXT NON-BLANK INPUT CHARACTER
C-------------------------------------------------------------------
      INCLUDE 'IODATA.CIN'
      INCLUDE 'IOFLAG.CIN'
      INCLUDE 'RDBUFF.CIN'
      INCLUDE 'RDCHAR.CIN'
C-------------------------------------------------------------------
C     COMMON /NCHRS/  NCHRS
      DATA NCHRS /0/
C
    5 CONTINUE
      IF (ICOL .GT. 80) THEN
        CALL RDLINE
        IF (ENDFIL) GO TO 100
        NCHRS = 0
      ENDIF
   10 CONTINUE
      IMARK = ICOL + 1
   20 CALL RDFWRD
      IF (ITEM .EQ. BLANK) GO TO 20
      NCHRS = NCHRS + 1
      IF (ITEM .EQ. '&') THEN
        CALL RDLINE
        IF (ENDFIL) GO TO 100
        NCHRS = 0
        GO TO 10
      ENDIF
      IF (ICOL .LE. 80) IMARK = ICOL
      IF (ITEM .EQ. '!') THEN
        ICOL = 81
        ITEM = KLINE(ICOL)
        IF (NCHRS .EQ. 1) GO TO 5
      ENDIF
C
  100 CONTINUE
      RETURN
      END
      SUBROUTINE RDNUMB (VALUE, IVALUE, FLAG)
C
C---- DECODE A REAL NUMBER
C
C     LIST OF COMMON BLOCKS
C
      INCLUDE 'FLUSHC.CIN'
      INCLUDE 'IODATA.CIN'
      INCLUDE 'IOFLAG.CIN'
      INCLUDE 'IOUNIT.CIN'
      INCLUDE 'NUMREP.CIN'
      INCLUDE 'RDBUFF.CIN'
      INCLUDE 'RDWRDS.CIN'
C-------------------------------------------------------------------
C
C     LOCAL VARIABLES
C
      CHARACTER*1     BLANK
      CHARACTER*10    NUMRES
      LOGICAL         DIG, PNT, EXN, FLAG
C
      DATA BLANK /' '/
      DATA ZERO  /0.0/
C-------------------------------------------------------------------
C
      FLAG = .FALSE.
      VALUE = ZERO
      IVALUE = 0
      NUMREP = BLANK
      EXN = .FALSE.
C
C---- ANY NUMERIC CHARACTER?
C
      IF (INDEX('0123456789+-.',ITEM) .NE. 0) THEN
        ICOLB = ICOL
        DIG = .FALSE.
        PNT = .FALSE.
C
C---- SIGN?
C
        IF (ITEM .EQ. '+' .OR. ITEM .EQ. '-') THEN
          CALL RDFWRD
        ENDIF
C
C---- DIGIT OR DECIMAL POINT?
C
   10   IDIG = INDEX('0123456789',ITEM) - 1
        IF (IDIG .GE. 0) THEN
          DIG = .TRUE.
          CALL RDFWRD
          GO TO 10
        ELSE IF (ITEM .EQ. '.') THEN
          IF (PNT) FLAG = .TRUE.
          PNT = .TRUE.
          CALL RDFWRD
          GO TO 10
        ENDIF
        FLAG = FLAG .OR. (.NOT. DIG)
C
C---- EXPONENT?
C
        IF (INDEX('DE',ITEM) .NE. 0) THEN
          CALL RDFWRD
          DIG = .FALSE.
          EXN = .TRUE.
          IF (ITEM .EQ. '+' .OR. ITEM .EQ. '-') THEN
            CALL RDFWRD
          ENDIF
   20     IDIG = INDEX('0123456789',ITEM) - 1
          IF (IDIG .GE. 0) THEN
            DIG = .TRUE.
            CALL RDFWRD
            GO TO 20
          ENDIF
          FLAG = FLAG .OR. (.NOT. DIG)
   30     IF (INDEX('0123456789.DE',ITEM) .NE. 0) THEN
            CALL RDSKIP('0123456789.DE')
            IF (ENDFIL) GO TO 50
            FLAG = .TRUE.
          ENDIF
        ENDIF
C
C---- RETURN VALUE
C
        IF (FLAG) THEN
          CALL RDFAIL
          WRITE (NOUT,910)
          FLUSHL = .TRUE.
        ELSE
          CALL RDBACK
          ICOLS = 80 - ICOL + ICOLB
          ICOLT = ICOL - ICOLB + 1
          NUMREP(ICOLS:80) = KTEXT(ICOLB:ICOL)
          READ (NUMREP,930) VALUE
          NUMRES = ' '
          DO 40 J = 2, 10
          JP70 = J + 70
          NUMRES(J:J) = NUMREP(JP70:JP70)
   40     CONTINUE
          IF (.NOT. PNT .AND. .NOT. EXN) READ (NUMRES,950) IVALUE
        ENDIF
      ELSE
        CALL RDFAIL
        WRITE (NOUT,920)
        FLAG = .TRUE.
      ENDIF
   50 CONTINUE
      RETURN
C-------------------------------------------------------------------
  910 FORMAT(' *** ERROR *** INCORRECT REAL VALUE'/' ')
  920 FORMAT(' *** ERROR *** REAL VALUE EXPECTED'/' ')
  930 FORMAT (E80.0)
  940 FORMAT (I80)
  950 FORMAT (I10)
C-------------------------------------------------------------------
      END
      SUBROUTINE RDPARS(KPARA,LPARA,IEP)
C---- READ KEYWORD OF GIVEN ELEMENT FOR PARAMETER REFERENCE
C---------------------------------------------------------------------
      CHARACTER*15    KPARA
C---------------------------------------------------------------------
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'DBEAM.CIN'
      INCLUDE 'DBEND.CIN'
      INCLUDE 'DCENT.CIN'
      INCLUDE 'DCVTY.CIN'
      INCLUDE 'DDRFT.CIN'
      INCLUDE 'DETA.CIN'
      INCLUDE 'DFIT.CIN'
      INCLUDE 'DHKICK.CIN'
      INCLUDE 'DKICK.CIN'
      INCLUDE 'DMIS.CIN'
      INCLUDE 'DOCT.CIN'
      INCLUDE 'DPLT.CIN'
      INCLUDE 'DQUAD.CIN'
      INCLUDE 'DRAN.CIN'
      INCLUDE 'DRBND.CIN'
      INCLUDE 'DROT.CIN'
      INCLUDE 'DSECT.CIN'
      INCLUDE 'DSEXT.CIN'
      INCLUDE 'DSHIFT.CIN'
      INCLUDE 'DSOLE.CIN'
      INCLUDE 'DSPEC.CIN'
      INCLUDE 'DSROT.CIN'
      INCLUDE 'DUPD.CIN'
      INCLUDE 'NELMS.CIN'
      INCLUDE 'NELMEQ.CIN'
      INCLUDE 'PARDAT.CIN'
      INCLUDE 'RDWRDS.CIN'
C---------------------------------------------------------------------
C
      GO TO ( 100, 200, 300, 400, 500, 600, 700, 800,5000,1000,
     1       1100,1200,5000,1400,5000,1600,5000,1800,1900,2000,
     2       5000,5000,5000,2400,2500,2600,2700,2800,2800,5000,
     3       5000,5000,5000,3400,3500,3500,5000,3800,5000,5000,
     4       5000,4200,4300), NTYPE                                             
C
  100 CALL RDLOOK(KPARA,LPARA,DBEAM,1,NBEAM,IEP)
      GO TO 5000
C
  200 CALL RDLOOK(KPARA,LPARA,DROT,1,NROT,IEP)
      GO TO 5000
C
  300 CALL RDLOOK(KPARA,LPARA,DDRFT,1,NDRFT,IEP)
      GO TO 5000
C
  400 CALL RDLOOK(KPARA,LPARA,DBEND,1,NBEND,IEP)
      GO TO 5000
C
  500 CALL RDLOOK(KPARA,LPARA,DQUAD,1,NQUAD,IEP)
      GO TO 5000
C
  600 CALL RDLOOK(KPARA,LPARA,DUPD,1,NUPD,IEP)
      GO TO 5000
C
  700 CALL RDLOOK(KPARA,LPARA,DCENT,1,NCENT,IEP)
      GO TO 5000
C
  800 CALL RDLOOK(KPARA,LPARA,DMIS,1,NMIS,IEP)
      GO TO 5000
C
 1000 CALL RDLOOK(KPARA,LPARA,DFIT,1,NFIT,IEP)
      GO TO 5000
C
 1100 CALL RDLOOK(KPARA,LPARA,DCVTY,1,NCVTY,IEP)
      GO TO 5000
C
 1200 CALL FNCORR(KPARA,LPARA,IEP)
      GO TO 5000
C
 1400 CALL FNMTX(KPARA,LPARA,IEP)
      IEP = IPARM
      GO TO 5000
C
 1600 CALL RDLOOK(KPARA,LPARA,DSPEC,1,NSPEC,IEP)
      GO TO 5000
C
 1800 CALL RDLOOK(KPARA,LPARA,DSEXT,1,NSEXT,IEP)
      GO TO 5000
C
 1900 CALL RDLOOK(KPARA,LPARA,DSOLE,1,NSOLE,IEP)
      GO TO 5000
C
 2000 CALL RDLOOK(KPARA,LPARA,DSROT,1,NSROT,IEP)
      GO TO 5000
C
 2400 CALL RDLOOK(KPARA,LPARA,DSECT,1,NSECT,IEP)
      GO TO 5000
C
 2500 CALL RDLOOK(KPARA,LPARA,DOCT,1,NOCT,IEP)
      GO TO 5000
C
 2600 CALL RDLOOK(KPARA,LPARA,DRAN,1,NRAN,IEP)
      GO TO 5000
C
 2700 CALL RDLOOK(KPARA,LPARA,DETA,1,NETA,IEP)
      GO TO 5000
C
 2800 CALL RDLOOK(KPARA,LPARA,DRBND,1,NRBND,IEP)
      GO TO 5000
C
 3400 CALL RDLOOK(KPARA,LPARA,DQUAD,1,NQUAD,IEP)
      GO TO 5000
C
 3500 CALL RDLOOK(KPARA,LPARA,DHKICK,1,NHKCK,IEP)
      GO TO 5000
C
 3800 CALL RDLOOK(KPARA,LPARA,DPLT,1,NPLT,IEP)
      GO TO 5000
C
 4200 CALL RDLOOK(KPARA,LPARA,DKICK,1,NKICK,IEP)
      GO TO 5000
C
 4300 CALL RDLOOK(KPARA,LPARA,DSHIFT,1,NSHIFT,IEP)
      GO TO 5000
C
 5000 CONTINUE
      RETURN
      END
      SUBROUTINE RDSKIP(STRING)
C---- SKIP ANY CHARACTER(S) OCCURRING IN "STRING"
C-------------------------------------------------------------------
      CHARACTER*(*)     STRING
C-------------------------------------------------------------------
      INCLUDE 'IOFLAG.CIN'
      INCLUDE 'RDBUFF.CIN'
C-------------------------------------------------------------------
C
   10 IF ((.NOT.ENDFIL) .AND. (INDEX(STRING,ITEM).NE.0)) THEN
        CALL RDNEXT
        IF (.NOT. ENDFIL) GO TO 10
      ENDIF
      RETURN
      END
      SUBROUTINE RDSTEP
C
C---- DETERMINE IDENTITY, RANGE, AND STEP SIZE FOR STEPPED PARAMETER
C
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'IODATA.CIN'
      INCLUDE 'IOFLAG.CIN'
      INCLUDE 'NPLIN.CIN'
      INCLUDE 'PARDAT.CIN'
      INCLUDE 'PARVAL.CIN'
      INCLUDE 'RDBUFF.CIN'
      INCLUDE 'RDCHAR.CIN'
      INCLUDE 'STEPTC.CIN'
      INCLUDE 'STEPT1.CIN'
C-----------------------------------------------------------------------
      CHARACTER*15    KNAME, KPARA
      CHARACTER*15    DSTEP(3)
      INTEGER         TEXT
      EXTERNAL        IDATA
      DATA            DSTEP /'LOWER','UPPER','STEP'/
      DATA            NCSTEP /3/, NSTEP /3/
C
C---- COMMA?
C
      CALL RDNEXT
      IF (ENDFIL) GO TO 800
      IF (ITEM .EQ. COMMA) THEN
        CALL RDNEXT
        IF (ENDFIL) GO TO 800
      ENDIF
C
C---- PARAMETER KEYWORD
C
      CALL RDWORD(KNAME,LNAME)
      IF (KNAME .NE. 'NAME') GO TO 40
      CALL RDNEXT
      IF (ENDFIL) GO TO 800
      IF (ITEM .NE. EQUAL) THEN
        CALL RDFAIL
        WRITE (IECHO,905)
        GO TO 800
      ENDIF
C
C---- PARAMETER NAME
C
      CALL RDNEXT
      IF (ENDFIL) GO TO 800
      CALL RDWORD(KNAME,LNAME)
      IF (LNAME .EQ. 0) THEN
        CALL RDFAIL
        WRITE (IECHO,910)
        GO TO 800
      ENDIF
   40 STCTYP = KNAME
C
   50 IPARM = 0
      CALL RDNEXT
      IF (ENDFIL) GO TO 800
      IF (ITEM .EQ. '[') THEN
        CALL RDNEXT
        IF (ENDFIL) GO TO 800
        CALL RDWORD(KPARA,LPARA)
        IF (LPARA .EQ. 0) THEN        
          CALL RDFAIL
          WRITE (IECHO,930)
          GO TO 800
        ENDIF
        STCPAR = KPARA
        CALL RDNEXT
        IF (ENDFIL) GO TO 800
        CALL RDTEST(']',ERROR)
C
        IF (ERROR) GO TO 800
        IF (TEXT(1) .LT. 0) GO TO 600
      ELSE
        CALL RDBACK
      ENDIF
C
      CALL DECPAR(NSTEP,DSTEP,NCSTEP,NPLIN,NSTEP)
      IF (ENDFIL) GO TO 600
      STLO = PDATA(1)
      STHI = PDATA(2)
      STEP = PDATA(3)
      LSTEP = .TRUE.
      NSTEPS = IFIX((STHI - STLO)/STEP + 1.001)
C
  600 CONTINUE
      GO TO 900
C
C---- ERROR EXIT
C
  800 ERROR = .TRUE.
  900 RETURN
C-----------------------------------------------------------------------
  905 FORMAT (' *** ERROR *** EQUAL EXPECTED'/' ')
  910 FORMAT (' *** ERROR *** PARAMETER NAME EXPECTED'/' ')
  930 FORMAT (' *** ERROR *** PARAMETER KEYWORD EXPECTED'/' ')
C-----------------------------------------------------------------------
      END
      SUBROUTINE RDSTRG (STRING, LMAX, L)
C
C     READ A CHARACTER STRING
C
      CHARACTER*1     STRING(LMAX)
C---------------------------------------------------------------------
      INCLUDE 'IODATA.CIN'
      INCLUDE 'RDBUFF.CIN'
      INCLUDE 'RDCHAR.CIN'
C
C     LOCAL VARIABLES
C
      CHARACTER*1     ISTOP
C ---------------------------------------------------------------------
C
      DO 10 L = 1, LMAX
   10 STRING(L) = BLANK
      ITEM = KLINE(ICOL)
      L = - 1
      IF (ITEM .EQ. QUOTE .OR. ITEM .EQ. APOST .OR. ITEM .EQ. EQUAL
     1 .OR. ITEM .EQ. SLASH .OR. ITEM .EQ. PARENO) GO TO 30
      GO TO 100
C
   30 ISTOP = ITEM
      IF (ITEM .EQ. PARENO) ISTOP = PARENC
      L = 0
   50 CALL RDFWRD
      IF (ICOL .GT. 80) GO TO 60
      IF (ITEM .EQ. ISTOP) GO TO 60
      L = L + 1
      STRING(L) = ITEM
      GO TO 50
   60 CONTINUE
C
  100 RETURN
      END
      SUBROUTINE RDTEST(STRING,FLAG)
C---- NEXT INPUT CHARACTER MUST BE CONTAINED IN "STRING"
C-------------------------------------------------------------------
      CHARACTER *(*)  STRING
      LOGICAL         FLAG
C-------------------------------------------------------------------
      INCLUDE 'IOUNIT.CIN'
      INCLUDE 'RDBUFF.CIN'
C-------------------------------------------------------------------
      FLAG = .FALSE.
      IF (INDEX(STRING,ITEM) .EQ. 0) THEN
        CALL RDFAIL
        IF (LEN(STRING) .EQ. 1) THEN
          WRITE (NOUT,910) STRING
        ELSE
          WRITE (NOUT,920) STRING
        ENDIF
        FLAG = .TRUE.
      ENDIF
      RETURN
C-------------------------------------------------------------------
  910 FORMAT(' *** ERROR *** "',A1,'" EXPECTED'/' ')
  920 FORMAT(' *** ERROR *** ONE OF "',A,'" EXPECTED'/' ')
C-------------------------------------------------------------------
      END
      SUBROUTINE RDTYPE(KWORD,LWORD)
C---- READ AN IDENTIFIER OR KEYWORD OF UP TO 15 CHARACTERS
C-------------------------------------------------------------------
      CHARACTER*15    KWORD
C-------------------------------------------------------------------
      INCLUDE 'RDBUFF.CIN'
      INCLUDE 'RDCHAR.CIN'
C-------------------------------------------------------------------
C
      KWORD = '        '
      LWORD = 0
      IF (INDEX(ALFNUM,ITEM) .NE. 0) THEN
   10   CONTINUE
          IF (LWORD .LT. 15) THEN
            LWORD = LWORD + 1
            KWORD(LWORD:LWORD) = ITEM
          ENDIF
          CALL RDFWRD
        IF (INDEX(ALFNUM,ITEM) .NE. 0) GO TO 10
        CALL RDBACK
      ENDIF
      RETURN
      END
      SUBROUTINE RDVCEX
C---- CONVERT INTERNAL VARY CODES TO EXTERNAL
C---------------------------------------------------------------------
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'DATA0A.CIN'
      INCLUDE 'DATA0B.CIN'
      INCLUDE 'DATA1A.CIN'
      INCLUDE 'DATA1B.CIN'
      INCLUDE 'DATA1C.CIN'
      INCLUDE 'DATA2A.CIN'
      INCLUDE 'DATA2B.CIN'
      INCLUDE 'DATA2D.CIN'
      INCLUDE 'FLUSHC.CIN'
      INCLUDE 'INSERT.CIN'
      INCLUDE 'IOFLAG.CIN'
      INCLUDE 'IOUNIT.CIN'
      INCLUDE 'RDPRNT.CIN'
      INCLUDE 'RDWRDS.CIN'
C-----------------------------------------------------------------------
      EXTERNAL        IDATA
C-----------------------------------------------------------------------
C
C     CONVERT EXTERNAL VARY CODES TO INTERNAL
C
      IF (FLUSHL) GO TO 220
      DO 210 NUM = 1, NEL
      I = ISTOR(NUM)
      NTYPE = IDATA(I)
      IF (NTYPE .LE. 0 .OR. NTYPE .GE. 50) GO TO 210
      IF (NTYPE .EQ. 10) GO TO 210
      IBEG = I + 1
      IEND = ISTOR(NUM+1) - 1
      DO 208 I = IBEG, IEND
      K = IABS(TIE(I))
      IF (K .NE. 0 .AND. K .LT. 99) TIE(I) = ISIGN(VSTOR(K), TIE(I))
  205 CONTINUE
  208 CONTINUE
  210 CONTINUE
C
C     MODIFY EXISTING SYSTEM
C
  220 NUM = 0
      REMOVE = .FALSE.
      INSERT = .FALSE.
  230 CALL RDELMT
      IF (ENDFIL) GO TO 500
      IF (NTYPE .NE. 73) GO TO 230
C
C     OPTIONALLY PRINT MODIFIED SYSTEM
C
  400 IF (INDS .EQ. 0) GO TO 500
      IF (.NOT. LIST .OR. .NOT. RFM) GO TO 450
      DO 401 NUM = 1, NEL
      IPI = 0
      I = IABS(ISTOR(NUM))
      CALL SKETCH(NUM)
      NWORD = NPARMS + 1
      IF (I .NE. ISTOR(NUM)) THEN
        IPI = 1
        ISTOR(NUM) = I
      ENDIF
      CALL PRINT1(LABEL(NUM),NWORD,DATA(I),TIE(I),IPI)
  401 CONTINUE
C
C     WRITE SYSTEM ONTO DISK
C
  450 IF (.NOT. BWT) GO TO 500
      NELP1 = NEL + 1
      IEL = ISTOR(NELP1) - 1
      WRITE (NDATA) NEL, IEL
      WRITE (NDATA) (DATA(I), I = 1, IEL)
      WRITE (NDATA) (TIE(I), I = 1, IEL)
      WRITE (NDATA) (ISTOR(N), N = 1, NELP1)
      WRITE (NDATA) (NDESCR(N), N = 1, NEL)
      WRITE (NDATA) (LABEL(N), N = 1, NEL)
C
  500 CONTINUE
      RETURN
      END
      SUBROUTINE RDVCIN
C---- CONVERT EXTERNAL VARY CODES TO INTERNAL
C---------------------------------------------------------------------
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'DATA0A.CIN'
      INCLUDE 'DATA0B.CIN'
      INCLUDE 'DATA1A.CIN'
      INCLUDE 'DATA1C.CIN'
      INCLUDE 'DATA2A.CIN'
      INCLUDE 'DATA2B.CIN'
      INCLUDE 'IOUNIT.CIN'
      INCLUDE 'KELEM.CIN'
C-----------------------------------------------------------------------
      DATA            NVMAXP /10/
C-----------------------------------------------------------------------
C
      NORD1 = 1
      NV1 = 0
      NVMAX = NPVAR
      DO 510 J = 1, NPVAR
  510 VSTOR(J) = 0
C
      DO 520 NUM = 1, NEL
      I = ISTOR(NUM)
      NTYPE = IDATA(I)
      IF (NTYPE .EQ. 17) NORD1 = INT(DATA(I+1))
  520 CONTINUE
C
      IF (NORD1 .GE. 2) NVMAX = NVMAXP
C
      IOLD = 0
      DO 700 NUM = 1, NEL
      I = ISTOR(NUM)
      ITYPE = I
      IF (I .LE. IOLD) GO TO 700
      NTYPE = IDATA(I)
      IF (NTYPE .LE. 0 .OR. NTYPE .GE. 50) GO TO 700
      IF (NTYPE .EQ. 10) GO TO 700
      IBEG = I + 1
      NUM1 = NUM
  601 IEND = ISTOR(NUM1 + 1)
      IF (IEND .LT. IBEG) THEN
        NUM1 = NUM1 + 1
        GO TO 601
      ENDIF
  605 IEND = IEND - 1
      DO 690 I = IBEG, IEND
      IVARY = IABS(TIE(I))
      IF (IVARY .GE. 99) GO TO 690
      IF (IVARY .EQ. 0) GO TO 690
      IF (IVARY .EQ. 1) GO TO 650
      IF (IVARY .GE. 7 .AND. IVARY .LE. 9) THEN
        IVARY = IVARY - 5
        TIE(I) = - TIE(I)
      ENDIF
      IF (NV1 .GT. 0) THEN
        DO 630 NN = 1, NV1
        N = NN
        IF (VSTOR(N) .EQ. IVARY) GO TO 680
  630   CONTINUE
      ENDIF
  650 IF (NV1 .GE. NVMAX) THEN
        WRITE (NOUT, 9660) KELEM(NTYPE), LABEL(NUM), NVMAX
        TIE(I) = 0
        GO TO 690
      ELSE
        NV1 = NV1 + 1
        VSTOR(NV1) = IVARY
        N = NV1
      ENDIF
  680 TIE(I) = ISIGN(N, TIE(I))
  690 CONTINUE
  700 IOLD = MAX0(ITYPE,IOLD)
C
      RETURN
C
 9660 FORMAT ('0*** ERROR *** PARAMETER NOT VARIED FOR ',A8,1X,A8,
     1       ' -- TOO MANY VARIED PARAMETERS, ONLY ',I2,' ALLOWED')
      END
      SUBROUTINE RDWARN
C---- MARK PLACE OF WARNING LEVEL ERROR
C-------------------------------------------------------------------
      INCLUDE 'IODATA.CIN'
      INCLUDE 'IOUNIT.CIN'
      INCLUDE 'RDBUFF.CIN'
C-------------------------------------------------------------------
C
      WRITE (NOUT,910) ILINE, KTEXT
      WRITE (NOUT,920) IMARK, (' ',I = 1, IMARK),'?'
      NWARN = NWARN + 1
      RETURN
C-------------------------------------------------------------------
  910 FORMAT('0* LINE',I5,' * ',A80)
  920 FORMAT(' * COLUMN',I3,' *',82A1)
C-------------------------------------------------------------------
      END
      SUBROUTINE RDWORD(KWORD,LWORD)
C---- READ AN IDENTIFIER OR KEYWORD OF UP TO 15 CHARACTERS
C-------------------------------------------------------------------
      CHARACTER*15    KWORD
C-------------------------------------------------------------------
      INCLUDE 'RDBUFF.CIN'
      INCLUDE 'RDCHAR.CIN'
C-------------------------------------------------------------------
C
      KWORD = '        '
      LWORD = 0
      IF (INDEX(ALPHA,ITEM) .NE. 0) THEN
   10   CONTINUE
          IF (LWORD .LT. 15) THEN
            LWORD = LWORD + 1
            KWORD(LWORD:LWORD) = ITEM
          ENDIF
          CALL RDFWRD
        IF (INDEX(ALFNUM,ITEM) .NE. 0) GO TO 10
        CALL RDBACK
      ENDIF
      RETURN
      END
      SUBROUTINE REPAIR
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'DATA0A.CIN'
      INCLUDE 'DATA0B.CIN'
      INCLUDE 'DATA1A.CIN'
      INCLUDE 'DATA1B.CIN'
      INCLUDE 'DATA1C.CIN'
      INCLUDE 'DATA2A.CIN'
      INCLUDE 'DATA2D.CIN'
      INCLUDE 'ELM0A.CIN'
      INCLUDE 'ICOPY.CIN'
      INCLUDE 'LIMITS.CIN'
      INCLUDE 'RDCARD.CIN'
C
      CHARACTER*15  BLANK, LABTYP
      INTEGER       TYPC
      EQUIVALENCE   (FAKE,LAKE)
      DATA          BLANK /' '/
C
      CALL EXILE
C
      ISTOR(1) = 1
      NUM = NELLIM - NEL + 1
      IF (NUM .GT. NELLIM) GO TO 5400
      NDIF = 1
      NEL = 0
      I = 1
      IREFF = 1
      NDEF = 0
C
   50 II = ISTOR(NUM)
      TYPE = IDATA(II)
      LABLE = LABEL(NUM)
      NPARMS = 0
      CALL SKETCH(NUM)
      NPOLD = NPARMS
C      
      IF (TYPE .EQ. 24) GO TO 2400
      IF (TYPE .EQ. 49) GO TO 5300
      IF (TYPE .EQ. 55) GO TO 5300
      IF (TYPE .EQ. 56) GO TO 5300
      GO TO 5010
C
C     24. -- DEFINED SECTION
C
 2400 IF (NUM .EQ. NUSE) THEN
        NUSE = NEL + 1
      ENDIF
      JDEF = IDATA(II+1)
      IF (JDEF .EQ. 1) NDEF = NDEF + 1
      IF (JDEF .EQ. 2) NDEF = NDEF - 1
      GO TO 5010  
C
C     COPY ELEMENT POINTERS AND LABELS TO LIST AT BEGINNING 
C     OF DATA ARRAY
C
 5010 NEL = NEL + 1
      IF (NUSE .EQ. 0 .OR. NDEF .EQ. 0 .OR. TYPE .EQ. 9
     1    .OR. TYPE .EQ. 24 .OR. TYPE .EQ. 32) THEN
        ISTOR(NEL) = I
      ELSE
        ISTOR(NEL) = ISTOR(NUM)
      ENDIF
      LABEL(NEL) = LABEL(NUM)
      NDESCR(NEL) = NDESCR(NUM)
      NDEFT = NDEF
      IF (TYPE .EQ. 24) THEN
        IF (JDEF .EQ. 1) NDEFT = 0
        GO TO 5020
      ENDIF
      IF (NUSE .NE. 0 .AND. NDEFT .GT. 0 .AND. TYPE .NE. 9 
     1    .AND. TYPE .NE. 32) GO TO 5300
C
C     ELEMENT DEFINITION, COPY TO LOWER PLACE IN DATA ARRAY
C
 5020 NP1 = NPOLD + 1
      IORIG = I
      DO 5030 J = 1, NP1
      I1 = II + J - 1
      DATA(I) = DATA(I1)
      TIE(I) = TIE(I1)
      I = I + 1
 5030 CONTINUE
      ICOPY = I1
      IF (NPARMS .GT. NPOLD) THEN
        NP2 = NP1 + 1
        NP1 = NPARMS + 1
        DO 5040 J = NP2, NP1
        DATA(I) = 0.0
        TIE(I) = 0
        I = I + 1
 5040   CONTINUE
      ENDIF
      IF (TYPE .EQ. 9 .OR. TYPE .EQ. 24 .OR. TYPE .EQ. 32) GO TO 5300
C
C     FIND PRECEDING USE OF ELEMENTS
C
 5100 IF (LABLE .EQ. BLANK) GO TO 5140
      NN = 0
      NDEFI = 0
C
 5110 NN = NN + 1
      III = ISTOR(NN)
      TYPC = IDATA(III)
      LABTYP = LABEL(NN)
      IF (TYPC .EQ. 24) THEN
        JDEF = IDATA(III+1)
        IF (JDEF .EQ. 1) NDEFI = NDEFI + 1
        IF (JDEF .EQ. 2) NDEFI = NDEFI - 1
      ENDIF
      IF (LABTYP .EQ. LABLE .AND. TYPC .EQ. TYPE) THEN
        IF (NDEFI .EQ. 0) THEN
          IF (NDEF .EQ. 0 .AND. NN .NE. NEL) GO TO 5120
          ISTOR(NN) = ISTOR(NEL)
          NDESCR(NN) = NDESCR(NEL)
          LABEL(NN) = LABEL(NEL)
        ENDIF
      ENDIF
 5120 IF (NN .LT. NEL - 1) GO TO 5110
C
C     FIND FOLLOWING USE OF ELEMENTS
C
 5140 IF (LABLE .EQ. BLANK) GO TO 5200
      IF (NUM .GE. NELLIM) GO TO 5200
      NN = NUM
      NDEFI = NDEF
C
 5150 NN = NN + 1
      III = ISTOR(NN)
      TYPC = IDATA(III)
      LABTYP = LABEL(NN)
      IF (TYPC .EQ. 24) THEN
        JDEF = IDATA(III+1)
        IF (JDEF .EQ. 1) NDEFI = NDEFI + 1
        IF (JDEF .EQ. 2) NDEFI = NDEFI - 1
      ENDIF
      IF (LABTYP .EQ. LABLE .AND. TYPC .EQ. TYPE) THEN
        IF (NDEFI .NE. 0) THEN
          ISTOR(NN) = ISTOR(NEL)
          NDESCR(NN) = NDESCR(NEL)
          LABEL(NN) = LABEL(NEL)
        ENDIF
      ENDIF
      IF (NN .LT. NELLIM) GO TO 5150
C
C     REVISE PRECEDING REFERENCES TO A PARAMETER
C
 5200 IF (NUSE .NE. 0 .AND. NDEF .NE. 0) GO TO 5300
      IF (NEL .LE. 1) GO TO 5250
C     IF (II + NPARMS .LT. IREF) GO TO 5300
      IP = 0
C
 5220 IP = IP + 1
C     IF (II + IP .LT. IREF .AND. IP .LT. NPOLD) GO TO 5220
      IIP = II + IP
      NN = 0
      NDEFI = 0
C
 5230 NN = NN + 1
      III = IABS(ISTOR(NN))
      IIJ = IABS(ISTOR(NN+1)) - 1
      TYPC = IDATA(III)
      IF (TYPC .EQ. 24) THEN
        JDEF = IDATA(III+1)
        IF (JDEF .EQ. 1 .OR. JDEF .EQ. 2) THEN
          IF (JDEF .EQ. 1) NDEFI = NDEFI + 1
          IF (JDEF .EQ. 2) NDEFI = NDEFI - 1
        ENDIF
      ENDIF
      IF (NDEFI .NE. 0) GO TO 5237
      IPT = 0
      IPMAX = IIJ - III + 1
 5235 IPT = IPT + 1
      IIN = III + IPT
      IF (TIE(IIN) .EQ. 100) THEN
        IF (IDATA(IIN) .EQ. IIP) THEN
          LAKE = IORIG + IP
          DATA(IIN) = FAKE
        ENDIF
      ENDIF
      IF (IPT .LT. IPMAX) GO TO 5235
 5237 IF (NN .LT. NEL - 1) GO TO 5230
      NN = NN + 1
      III = IABS(ISTOR(NN))
      TYPC = IDATA(III)
      IF (TYPC .EQ. 24) THEN
        JDEF = IDATA(III+1)
        IF (JDEF .EQ. 1 .OR. JDEF .EQ. 2) THEN
          IF (JDEF .EQ. 1) NDEFI = NDEFI + 1
          IF (JDEF .EQ. 2) NDEFI = NDEFI - 1
        ENDIF
      ENDIF
      IF (IP .LT. NPOLD) GO TO 5220
C
C     REVISE FOLLOWING REFERENCES TO A PARAMETER
C
 5250 IF (II + NPOLD .LT. IREFF) GO TO 5300 
      IP = 0
      IREFN = IDLIM + 1
C
 5270 IP = IP + 1
      IIP = II + IP
      IF (IIP .LT. IREFF .AND. IP .LT. NPOLD) GO TO 5270
      NDEFI = NDEF
C
      IF (NUM + 1 .GT. NELLIM) GO TO 5300
      NN = NUM
C
 5280 NN = NN + 1
      III = IABS(ISTOR(NN))
      IF (NN .LT. NELLIM) THEN
        IIJ = IABS(ISTOR(NN+1)) - 1
      ELSE
        IIJ = IDLIM
      ENDIF
      TYPC = IDATA(III)
      IF (TYPC .EQ. 24) THEN
        JDEF = IDATA(III+1)
        IF (JDEF .EQ. 1 .OR. JDEF .EQ. 2) THEN
          IF (JDEF .EQ. 1) NDEFI = NDEFI + 1
          IF (JDEF .EQ. 2) NDEFI = NDEFI - 1
        ENDIF
      ELSE
        IF (NUSE .NE. 0 .AND. NDEFI .NE. 0) GO TO 5295
        IPT = 0
        IPMAX = IIJ - III
 5290   IPT = IPT + 1
        IIN = III + IPT
        IF (TIE(IIN) .EQ. 100) THEN
          IF (IDATA(IIN) .EQ. IIP) THEN
            LAKE = IORIG + IP
            DATA(IIN) = FAKE
          ENDIF
          IDIIN = IDATA(IIN)
          IF (IDIIN .LT. IREFN .AND. IDIIN .GT. II) 
     1        IREFN = IDIIN
        ENDIF
        IF (IPT .LT. IPMAX) GO TO 5290
      ENDIF
 5295 IF (NN .LT. NELLIM) GO TO 5280
      IREFF = IREFN
      IF (IREFF .GT. II + NPOLD) GO TO 5300 
      IF (IP .LT. NPOLD) GO TO 5270
C
C     PROCESS NEXT ELEMENT
C
 5300 NUM = NUM + 1
      IF (NUM .LE. NELLIM) GO TO 50
      ISTOR(NEL+1) = I
C
C     RETURN
C
 5400 CONTINUE
      RETURN
      END
      SUBROUTINE REVISE
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'DATA0A.CIN'
      INCLUDE 'DATA0B.CIN'
      INCLUDE 'DATA1A.CIN'
      INCLUDE 'DATA1C.CIN'
      INCLUDE 'DATA2A.CIN'
      INCLUDE 'ELM0A.CIN'
      INCLUDE 'FLUSHC.CIN'
      INCLUDE 'INDPAR.CIN'
      INCLUDE 'IOUNIT.CIN'
      INCLUDE 'RDCARD.CIN'
      INCLUDE 'RDWRDS.CIN'
C--------------------------------------------------------------------------------
      CHARACTER*15  LBTEST
      INTEGER       TYPC, TYPCS
      EQUIVALENCE   (FAKE,LAKE)
C
C
      NUM = 1
      N49 = 0
      N55 = 0
      N56 = 0
      NNSAVE = 0
C
   70 I = ISTOR(NUM)
      TYPE = IDATA(I)
      LABLE = LABEL(NUM)
C
      IF (TYPE .EQ. 24) GO TO 2400
      IF (TYPE .EQ. 49) GO TO 4900
      IF (TYPE .EQ. 55) GO TO 5500
      IF (TYPE .EQ. 56) GO TO 5600
      GO TO 6100
        
 2400 NBEG = 0
      NEND = 0
      NELM = 0
      NDEF = 0
      JDEF = IDATA(I+1)
      IF (JDEF .EQ. 1 .OR. JDEF .EQ. 2) GO TO 6100
      DO 2410 NN = 1, NEL
      II = ISTOR(NN)
      TYPC = IDATA(II)
      LBTEST = LABEL(NN)
      IF (TYPC .EQ. 24) THEN
        JDEFC = IDATA(II+1)
        IF (JDEFC .EQ. 1) NDEF = NDEF + 1
        IF (JDEFC .EQ. 2) NDEF = NDEF - 1
      ENDIF
      IF (LBTEST .EQ. LABLE) THEN
        TYPCS = TYPC
        IF (TYPCS .EQ. 24) THEN
          IF (JDEFC .EQ. 1) NBEG = NN
          IF (JDEFC .EQ. 2) THEN
            NEND = NN
            GO TO 2420
          ENDIF
        ELSE
          IF (NDEF .EQ. 0) THEN
            NELM = NN
            GO TO 2420
          ENDIF
        ENDIF  
      ENDIF
 2410 CONTINUE
C
 2420 IF (TYPCS .EQ. 24) THEN
        IF (JDEF .EQ. 3 .OR. JDEF .EQ. 4) THEN
          LAKE = NBEG
          DATA(I+2) = FAKE
          LAKE = NEND
          DATA(I+3) = FAKE
        ENDIF
      ELSE 
        ISTOR(NUM) = ISTOR(NELM)
      ENDIF
      GO TO 6100      
C
C     PHONY TEMPORARY GLOBAL PARAMETER
C
 4900 N49 = 1
      DO 4910 NN = 1, NEL
      II = ISTOR(NN)
      TYPC = IDATA(II)
      LBTEST = LABEL(NN)
      IF (TYPC .EQ. 30 .AND. LBTEST .EQ. LABEL(NUM)) THEN
        N49 = 0
        IIOLD = ISTOR(NUM) + 1
        IISAVE = ISTOR(NN) + 1
        GO TO 4920
      ENDIF
 4910 CONTINUE
      WRITE (NOUT,9001) LABEL(NUM)
 9001 FORMAT (' *** PARAMETER ', A15, ' NOT FOUND ***')
      GO TO 6200
C
 4920 IIEL = ISTOR(NEL+1) - 1
      DO 4930 II = 1, IIEL 
      IF (TIE(II) .EQ. 100) THEN
        IF (IDATA(II) .EQ. IIOLD) THEN
          LAKE = IISAVE
          DATA(II) = FAKE  
        ENDIF
      ENDIF
 4930 CONTINUE
C
C     PHONY TEMPORARY ELEMENT LABEL FOR ELEMENT PARAMETER
C
 5500 N55 = 1
      NNSAVE = 0
      DO 5510 NN = 1, NEL
      II = ISTOR(NN)
      TYPC = IDATA(II)
      LBTEST = LABEL(NN)
      IF (TYPC .NE. 55 .AND. LBTEST .EQ. LABEL(NUM)) THEN
        NNSAVE = NN
        N55 = 0
        GO TO 6100
      ENDIF
 5510 CONTINUE
      WRITE (NOUT,9002) LABEL(NUM)
 9002 FORMAT (' *** ELEMENT LABEL ', A15, ' NOT FOUND ***')
      GO TO 6200
C
C     PHONY TEMPORARY PARAMETER NAME FOR ELEMENT PARAMETER
C
 5600 N56 = 1
      IF (NNSAVE .EQ. 0) THEN
        WRITE (NOUT,9003) LABEL(NUM)
        GO TO 6200
      ENDIF
      CALL SKETCH(NNSAVE)
      IISAVE = ISTOR(NNSAVE)
      NTYPE = IDATA(IISAVE)
      ILEN = LENNB(LABEL(NUM))
      CALL RDPARS(LABEL(NUM),ILEN,IEP)
      IF (IEP .EQ. 0) THEN
        WRITE (NOUT,9003) LABEL(NUM)
 9003   FORMAT (' *** ELEMENT PARAMETER KEYWORD ',A15,
     1          ' NOT RECOGNIZED ***')
        GO TO 6200
      ENDIF
      IISAVE = IISAVE + IPTOJ(IEP)
C
      IIEL = ISTOR(NEL+1) - 1
      DO 5610 III = 1, IIEL
      IF (TIE(III) .EQ. 100) THEN
        IF (IDATA(III) .EQ. I + 1) THEN
          LAKE = IISAVE
          DATA(III) = FAKE
          N56 = 0
        ENDIF
      ENDIF
 5610 CONTINUE
      GO TO 6100
C
C     ADVANCE TO NEXT ELEMENT
C
 6100 NUM = NUM + 1
      IF (NUM .LE. NEL - 1) GO TO 70
C
 6200 FLUSHL = N49 .GT. 0 .OR. N55 .GT. 0 .OR. N56 .GT. 0
      RETURN
      END
      SUBROUTINE SEEDIT
      INCLUDE 'ISEEDX.CIN'
      INCLUDE 'NUMREP.CIN'
C
      CHARACTER*1     BLANK
      DATA BLANK /' '/
C
      JS = 81
      DO 10 J = 1, 80
      JS = 81 - J
      IF (NUMREP(JS:JS) .EQ. BLANK) GO TO 20
   10 CONTINUE
   20 IF (JS .GE. 65) THEN
        DO 30 J = 65, JS
        NUMREP(J:J) = '0'
   30   CONTINUE
      ENDIF
      READ (NUMREP(65:80),9002) ISEEDX
 9002 FORMAT (4I4)
      ISEEDX(4) = 2*(ISEEDX(4)/2) + 1
      RETURN
      END
      SUBROUTINE SKETCH(NN)
C
C     DETERMINE WHICH PARAMETERS ARE USED TO DESCRIBE ELEMENT
C
C ----------------------------------------------------------------------
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'DATA0A.CIN'
      INCLUDE 'DATA0B.CIN'
      INCLUDE 'DATA1A.CIN'
      INCLUDE 'DATA1B.CIN'
      INCLUDE 'DATA2D.CIN'
      INCLUDE 'ELM0A.CIN'
      INCLUDE 'INDPAR.CIN'
      INCLUDE 'LIMITS.CIN'
      INCLUDE 'NELMS.CIN'
C ---------------------------------------------------------------------
      INTEGER         TYPEN
      INTEGER         NELMX(NELMCT)
      EXTERNAL        IDATA
      DATA NELMX /99,99,99,99,99, 7,99,99,99,11,
     1            99,99, 2,99,99, 2,99,99,99,99,
     2            99, 3, 5, 1,99,99,99,99,99,99,
     3             1, 2, 2,99,99,99, 4,20,99,99,
     4            99,99,99, 1,99,99,99,99/
C
      DO 12 J = 1, 25
      IPTOJ(J) = 0
   12 CONTINUE
C
      ICT = 0
      II = ISTOR(NN)
      TYPEN = IABS(IDATA(II))
      IF (TYPEN .LE. NELMCT) NMAX = NELMX(TYPEN)
      IF (TYPEN .EQ. 16 .AND. DATA(II+1) .LT. 0) NMAX = 3
      IF (TYPEN .EQ. 24 .AND. (IDATA(II+1) .EQ. 3
     1    .OR. IDATA(II+1) .EQ. 4)) NMAX = 3
      IF (TYPEN .GE. 50 .AND. TYPEN .LE. 52) NMAX = NPHST
      IF (TYPEN .EQ. 53) NMAX = NPFLG
      IF (TYPEN .EQ. 60) NMAX = NPDCAY
      IF (TYPEN .GE. 78 .AND. TYPEN .LE. 82) NMAX = 0
      IF (NMAX .EQ. 99) NMAX = NELMS(TYPEN)
      IF (NMAX .EQ. 0) GO TO 20
      IF (TYPEN .EQ. 14) THEN
        IF (II+30 .LE. IDLIM) THEN
          IF (IDATA(II+30) .NE. 0) NMAX = 29
        ENDIF
        IF (II+8 .LE. IDLIM) THEN
          IF (IDATA(II+8) .NE. 0) NMAX = 7
        ENDIF
        NPARMS = NMAX
      ENDIF
      IF (TYPEN .NE. 14) THEN
        NMAX = MIN0(NMAX,25)
      ENDIF
      DESCR = NDESCR(NN)
      DO 15 J = 1, NMAX
      INDEX = MOD(DESCR,2)
      IF (INDEX .NE. 0) THEN
        ICT = ICT + 1
        IPTOJ(J) = ICT
      ENDIF
      DESCR = DESCR/2
      IF (DESCR .EQ. 0) GO TO 20
   15 CONTINUE
   20 IF (TYPEN .NE. 14) THEN
        NPARMS = ICT
      ELSE
        NPARMS = NMAX
      ENDIF
      IF (TYPEN .EQ. 30) THEN
        IF (TIE(II+1) .EQ. 99) NPARMS = 21
      ENDIF
   30 CONTINUE
      RETURN
      END
      INTEGER FUNCTION TEXT(I)
C-----------------------------------------------------------------------
      INCLUDE 'DATUM.CIN'
C
      EQUIVALENCE    (FAKE,LAKE)
C
      FAKE = DATUM(I)
      TEXT = LAKE
C
      RETURN
      END
      SUBROUTINE TITLE
C---- PERFORM "TITLE" COMMAND
C------------------------------------------------------------------
      INCLUDE 'IMAGE.CIN'
      INCLUDE 'IODATA.CIN'
      INCLUDE 'IOFLAG.CIN'
      INCLUDE 'RDBUFF.CIN'
      INCLUDE 'RDCHAR.CIN'
C--------------------------------------------------------------------
      CHARACTER*15    KNAME
      INTEGER         I, IBEG, IEND, ILAST, IST, LNAME
C--------------------------------------------------------------------
C
    5 CALL RDLINE
      IF (.NOT. ENDFIL) THEN
        IBEG = 1
   10   CALL RDNEXT
        IF (ENDFIL) GO TO 200
        IF (ITEM .EQ. QUOTE .OR. ITEM .EQ. APOST) THEN
          IBEG = ICOL + 1
          GO TO 20
        ELSE IF (INDEX(ALPHA,ITEM) .NE. 0) THEN
          CALL RDWORD(KNAME,LNAME)
          IF (KNAME(1:4) .EQ. 'SENT') THEN
            ENDFIL = .TRUE.
            GO TO 200
          ELSE
            GO TO 10
          ENDIF
        ELSE IF (ITEM .EQ. ';') THEN
          GO TO 5
        ENDIF
C
   20   IST = IBEG
        DO 30 I = IST, 80
        ILAST = I
        IF (KLINE(I) .EQ. BLANK) GO TO 30
        IF (KLINE(I) .EQ. QUOTE .OR. KLINE(I) .EQ. APOST) GO TO 80
        IBEG = I
        GO TO 40
   30   CONTINUE
C
   40   IF (IBEG .LT. 80) GO TO 50
        IBEG = 1
        IEND = 80
        GO TO 100
C
   50   IEND = 80
        IST = IBEG
        DO 60 I = IST, 80
        IF (KLINE(I) .NE. QUOTE .AND. KLINE(I) .NE. APOST) GO TO 60
        IEND = I - 1
        GO TO 100
   60   CONTINUE
        GO TO 100
   80   IEND = ILAST - 1
  100   IMAGE = KTEXT(IBEG:IEND)
        ICOL = 81
        ITEM = KLINE(ICOL)
      ENDIF
  200 CONTINUE
      RETURN
      END
      SUBROUTINE UCTABS (A)
      CHARACTER A*(*)
C
      PARAMETER (IUC=65, ILC=97, ILCL=ILC+25, IDI=IUC-ILC)
      CHARACTER TAB*1
      DATA      TAB /'	'/
C
      IF (A .EQ. ' ') RETURN
C
      LENA = LEN(A)
      IF (LENA .LE. 0) GO TO 10
      DO I = 1, LENA
        IF (A(I:I) .EQ. TAB) THEN
          A(I:I) = ' '
        ELSE IF (A(I:I) .NE. ' ') THEN
          JLC = ICHAR(A(I:I))
          IF ((JLC .GE. ILC) .AND. (JLC .LE. ILCL)) THEN
            JUC = JLC + IDI
            A(I:I) = CHAR(JUC)
          ENDIF
        ENDIF
      END DO
   10 RETURN
      END
      SUBROUTINE USE
C---- SET BEAM LINE TO BE USED
C-------------------------------------------------------------------
      INCLUDE 'IOFLAG.CIN'
      INCLUDE 'RDBUFF.CIN'
      INCLUDE 'RDCHAR.CIN'
C-------------------------------------------------------------------
C
C---- COMMA?
C
      CALL RDNEXT
      IF (ENDFIL) GO TO 800
      IF (ITEM .EQ. COMMA) THEN
        CALL RDNEXT
        IF (ENDFIL) GO TO 800
      ENDIF
C
C---- BEAM LINE REFERENCE
C
      CALL DECUSE(ERROR)
      IF (ENDFIL .OR. ERROR) GO TO 800
      GO TO 900
C
C---- ERROR EXIT --- CLEAR LINE DATA
C
  800 ERROR = .TRUE.
  900 RETURN
      END
      SUBROUTINE VARY1(IVAR)
C---- DECLARE PARAMETER AS VARIABLE
C-------------------------------------------------------------------
      INCLUDE 'TRNSPRT_PARAM.CIN'
      INCLUDE 'DATA0A.CIN'
      INCLUDE 'DATA0B.CIN'
      INCLUDE 'DATA1A.CIN'
      INCLUDE 'DATA1C.CIN'
      INCLUDE 'DATA2A.CIN'
      INCLUDE 'ELM14A.CIN'
      INCLUDE 'INDPAR.CIN'
      INCLUDE 'IODATA.CIN'
      INCLUDE 'IOFLAG.CIN'
      INCLUDE 'PARDAT.CIN'
      INCLUDE 'RDBUFF.CIN'
      INCLUDE 'RDCHAR.CIN'
      INCLUDE 'RDWRDS.CIN'
C-------------------------------------------------------------------
      CHARACTER*15    KNAME, KPARA
      INTEGER         TEXT
      EXTERNAL        IDATA, TEXT
C-------------------------------------------------------------------
C
C---- COMMA?
C
      CALL RDNEXT
      IF (ENDFIL) GO TO 800
      IF (ITEM .EQ. COMMA) THEN
        CALL RDNEXT
        IF (ENDFIL) GO TO 800
      ENDIF
C
C---- PARAMETER KEYWORD
C
      CALL RDWORD(KNAME,LNAME)
      IF (KNAME .EQ. 'ALL') GO TO 300
      IF (KNAME .NE. 'NAME') GO TO 50
      CALL RDNEXT
      IF (ENDFIL) GO TO 800
      IF (ITEM .NE. EQUAL) THEN
        CALL RDFAIL
        WRITE (IECHO,905)
        GO TO 800
      ENDIF
C
C---- PARAMETER NAME
C
      CALL RDNEXT
      IF (ENDFIL) GO TO 800
      CALL RDWORD(KNAME,LNAME)
      IF (LNAME .EQ. 0) THEN
        CALL RDFAIL
        WRITE (IECHO,910)
        GO TO 800
      ENDIF
C
   50 IELEM = 0
      IPARM = 0
      IHIGH = 0
      CALL RDNEXT
      IF (ENDFIL) GO TO 800
      IF (ITEM .EQ. '[') THEN
        CALL RDNEXT
        IF (ENDFIL) GO TO 800
        CALL RDWORD(KPARA,LPARA)
        IF (LPARA .EQ. 0) THEN
          CALL RDFAIL
          WRITE (IECHO,930)
          GO TO 800
        ENDIF
        CALL RDNEXT
        IF (ENDFIL) GO TO 800
        CALL RDTEST(']',ERROR)
        IF (ERROR) GO TO 800
        IF (TEXT(1) .LT. 0) GO TO 600
C
        DO 100 NUM = 1, NEL
        IF (LABEL(NUM) .NE. KNAME) GO TO 100
        II = ISTOR(NUM)
        IF (II .LT. IHIGH) GO TO 100
        IHIGH = MAX0(II,IHIGH)
        IF (DATA(II) .LT. 0) GO TO 100
        IELEM = IELEM + 1
        NTYPE = IDATA(II)
        CALL RDPARS(KPARA,LPARA,IEP)
        IF (NTYPE .EQ. 14) THEN
          NROW = IFIX(DATA(II+7))
          IF (J1 .NE. NROW) IEP = 0
        ENDIF
        IF (IEP .EQ. 0) GO TO 100
        CALL SKETCH(NUM)
        IF (NTYPE .NE. 16) THEN
          IDIF = IPTOJ(IEP)
        ELSE
          IDIF = 2
        ENDIF
        IF (IDIF .EQ. 0) GO TO 100
        IPARM = IPARM + 1
        IADR = II + IDIF
        IF (TIE(IADR) .LT. 99) THEN
          TIE(IADR) = IVAR
        ELSE
          CALL RDWARN
          WRITE (IECHO,950)
          GO TO 800
        ENDIF
  100   CONTINUE
C
        IF (IELEM .EQ. 0) THEN
          CALL RDFAIL
          WRITE (IECHO,920) KNAME(1:LNAME)
          GO TO 800
        ENDIF
        IF (IPARM .EQ. 0) THEN
          CALL RDFAIL
          WRITE (IECHO,940) KNAME(1:LNAME), KPARA(1:LPARA)
          GO TO 800
        ENDIF
      ELSE
        IF (TEXT(1) .LT. 0) GO TO 600
        DO 200 NUM = 1, NEL
        IF (LABEL(NUM) .NE. KNAME) GO TO 200
        II = ISTOR(NUM)
        IF (II .LT. IHIGH) GO TO 200
        IHIGH = MAX0(II,IHIGH)
        IELEM = IELEM + 1
        IF (TIE(II+1) .LT. 99) THEN
          TIE(II+1) = IVAR
        ELSE
          CALL RDWARN
          WRITE (IECHO,950)
          GO TO 800
        ENDIF
  200   CONTINUE
        IF (IELEM .EQ. 0) THEN
          CALL RDFAIL
          WRITE (IECHO,920) KNAME(1:LNAME)
          GO TO 800
        ENDIF
      ENDIF
      GO TO 600
C
  300 ILAST = ISTOR(NEL+1) - 1
      DO 320 I = 1, ILAST
      ITIE = TIE(I)
      IF (ITIE .NE. 99 .AND. ITIE .NE. 100) ITIE = 0
      TIE(I) = ITIE
  320 CONTINUE
  600 CONTINUE
      GO TO 900
C
C---- ERROR EXIT
C
  800 ERROR = .TRUE.
  900 RETURN
C------------------------------------------------------------------
  905 FORMAT (' *** ERROR *** EQUAL EXPECTED'/' ')
  910 FORMAT (' *** ERROR *** PARAMETER NAME EXPECTED'/' ')
  920 FORMAT (' *** ERROR *** UNKNOWN BEAM ELEMENT "',A,'"'/' ')
  930 FORMAT (' *** ERROR *** PARAMETER KEYWORD EXPECTED'/' ')
  940 FORMAT (' *** ERROR *** UNKNOWN ELEMENT PARAMETER "',
     +        A,' ',A,' "'/' ')
  950 FORMAT (' *** ERROR *** DEPENDENT PARAMETER CANNOT BE VARIED'/' ')
  960 FORMAT (' ** WARNING ** "STEP" MISSING ---',
     +        ' THIS MAY CAUSE TROUBLE IN MATCHING'/' ')
  970 FORMAT (' ** WARNING ** THIS PARAMETER IS ALREADY VARIABLE',
     +        ' --- NEW DATA USED'/' ')
  980 FORMAT (' *** ERROR *** THIS VERSION OF "MAD" ACCEPTS ONLY ',
     +        I5,' VARIABLE PARAMETERS --- "VARY" IGNORED'/' ')
C-------------------------------------------------------------------
      END