      PROGRAM MMINS

C     Creates MM2/MM3 input files 
C
C     Data are read from PARAM.DAT and are subsequently stored in arrays,
C     usually with the same name as in the MM2 programs. 
C     The number of changed parameter cards are determined by the program
C
C     Output can be given in four ways: MMP85, MM287, MM2HB and MM3 
C     PISYS=.TRUE. notes the presence of a pi system when dealing with
C     MMP85 
C     POINTQ=.TRUE. notes the uses of atomic point charges
C     ORIENT=.TRUE. notes the presence of orientation options (i.e.
C     if NCALC not equals 2 or 4, it will be set to 2)
C     TRANSL=.TRUE. makes a translation table atomlabels -> numbers
C     NDCOVER=.TRUE. the specified value of NDC overrules implicit 
C     values (e.g. charges ignored when NDC 0 OVERRULE is given)
C     LPADD=.TRUE. lone pairs are added to type 6 and 8 on geometrically
C     favorable positions
C     Heat of formation options are not supported by this program.
c
c-LKB  9-JUL-1992 12:58:16 
c   LRPI en LSPI niet op 0 geinitialiseerd !  (misschien nog wel meer)
c
      PARAMETER MAX1=350,MAX2=700
      DIMENSION WGHT(MAX1),ISYMM(MAX1,2),IRESTR(MAX1,4),TORS(MAX1,3),
     1 ITORS(MAX1,5),STR(MAX1,6),ISTR(MAX1,2),DIPAT(MAX1),Q(MAX1),
     2 IDIPAT(MAX1,2),DIPAN(MAX1),IDIPAN(MAX1,2),INEG(MAX1,4),
     3 RNEG(MAX1),ROTS(MAX1),IVDW(MAX1,2),VDW(MAX1,2),IBEND(MAX1,5),
     4 BEND(MAX1,2),IDRIVE(8),DRIVE(8),IP1(8),IP2(8),ITYP(MAX1),
     5 CMATR(3,3),INEW(MAX1,4),RNEW(MAX1,4),ISCRATCH(MAX1),
     6 RSYMM(MAX1,9),ic(MAX2,10),nlspi(MAX2),torstr(max1),its(max1,2),
     7 ICO(max1,2),SCO(max1),ibb(max1,3),bb(max1)
      INTEGER HFORM
      CHARACTER*80 LINE,WORD(80),PARAM,TITLE,TABLE(62)
      CHARACTER*60 ID
      CHARACTER*8 NAM(MAX1),ATLAB(MAX1),CNEW(MAX1,4),CDRIVE(8),PI(MAX1)
     1 ,XFIX(MAX1),YFIX(MAX1),ZFIX(MAX1)
      CHARACTER*5 TEMP
      CHARACTER*1 LOG(MAX1)
      LOGICAL MMP85,MM2HB,MM287,MM3,PISYS,POINTQ,ORIENT,TRANSL,
     1 NDCOVER,LPADD
      COMMON /C/ ATOM(MAX1,3),JATTCH(MAX2),KATTCH(MAX2),
     1 ICONN(60,16),N,NCONN,NATTCH,ITYPE(MAX1),NJOIN,IJOIN(MAX2,2),
     2 NBREAK,IBREAK(MAX2,2),MATCONN(MAX1,MAX1)
      COMMON /LAB/ ATLAB
C     In and Rn are scratch variables

C   ---   Read in default values

      DATA IPRINT,MDERIV,INIT,LABEL,N,NJOIN,NBREAK,NSYMM,
     1 NX,NRSTR,NRESTR,kfixtyp,ispeed
     1 /3,12*0/
      DATA NT,NS,NEG,NV,NB,MUA,MUB,NSB,NH,HFORM,nchrg,nbb,
     1 nco,rdnh,rdnd,nts,adielc /16*0,0.34/
      DATA NBUT,IPUN,IHOPT,IHBVAL,NNEW,JPRINT,MVDW,TMAX,METHOD,NPLANE
     1 /6*0,1,99.,2*0/
      DATA IFINDP,NPI,NXFIX,NYFIX,NZFIX /5*0/
      DATA LOG /MAX1*' '/
      DATA TABLE,ATLAB /62*' ',MAX1*' '/
      DATA MMP85,MM2HB,MM287,MM3,PISYS,POINTQ,ORIENT,TRANSL,NDCOVER,LPADD
     1 /.TRUE.,9*.FALSE./
      DATA CDRIVE /8*' '/
      DATA NAM /MAX1*' '/

C   ---   Get filename

      CALL GETPAR(0,PARAM,IER)
      CALL GETPAR(1,PARAM,IER)
      IF (IER.NE.0) STOP 'Supply filename'

C   ---   Open input & result files

      OPEN(1,FILE=PARAM(1:LENGTH(PARAM))//'.dat',STATUS='OLD',ERR=110,
     1 CARRIAGECONTROL='LIST',READONLY)

C   ---   Read information from input file and store in appropriate 
C         variables

10    CONTINUE
      CALL READ(LINE,WORD,NWORD)

C   ---   Card 1

      IF (WORD(1)(1:2).EQ.'ID'.OR.WORD(1)(1:4).EQ.'TITL') THEN
         L=LENGTH(WORD(1))
         ID=LINE(L+2:L+62)
      ELSE IF (WORD(1)(1:6).EQ.'IPRINT') THEN
         READ(WORD(2),*,ERR=100) IPRINT
      ELSE IF (WORD(1)(1:6).EQ.'MDERIV') THEN
         READ(WORD(2),*,ERR=100) MDERIV
      ELSE IF (WORD(1)(1:4).EQ.'INIT') THEN
         READ(WORD(2),*,ERR=100) INIT
      ELSE IF (WORD(1)(1:4).EQ.'TMAX') THEN
         READ(WORD(2),*,ERR=100) TMAX

C   ---   Card 1a

      ELSE IF (WORD(1)(1:6).EQ.'NPLANE') THEN
         READ(WORD(2),*,ERR=100) NPLANE
         IF (NPLANE.NE.0) NPLANE=1
      ELSE IF (WORD(1)(1:6).EQ.'IFINDP') THEN
         READ(WORD(2),*,ERR=100) IFINDP
         IF (IFINDP.NE.0) IFINDP=1
      ELSE IF (WORD(1)(1:6).EQ.'JPRINT') THEN
         READ(WORD(2),*,ERR=100) JPRINT
      ELSE IF (WORD(1)(1:6).EQ.'SCFMAT'.OR.WORD(1)(1:4).EQ.'ISET') THEN
         READ(WORD(2),*,ERR=100) ISET
C        (matrices must be included manually)
      ELSE IF (WORD(1)(1:5).EQ.'LIMIT') THEN
         READ(WORD(2),*,ERR=100) LIMIT
      ELSE IF (WORD(1)(1:4).EQ.'ITER') THEN
         READ(WORD(2),*,ERR=100) ITER
      ELSE IF (WORD(1)(1:5).EQ.'LPCHG') THEN
         READ(WORD(2),*,ERR=100) LPCHG

C   ---   Card 1c

      ELSE IF (WORD(1)(1:6).EQ.'SCFPAR') THEN
         IBETA=1
         READ(WORD(2),*,ERR=100) EBETA
         READ(WORD(3),*,ERR=100) EBE
         READ(WORD(4),*,ERR=100) EBB

C   ---   Card 1d

      ELSE IF (WORD(1)(1:4).EQ.'LRPI') THEN
         LRPI=1
         I1=0
         I2=0
410      CONTINUE
         I1=I1+1
         I2=I2+2
         IF (WORD(I2).EQ.' '.OR.I1.GT.8) GOTO 420
         READ(WORD(I2),*,ERR=100) IP1(I1)
         READ(WORD(I2+1),*,ERR=100) IP2(I1)
         GOTO 410
420      CONTINUE
         NRLPI=I1

      ELSE IF (WORD(1)(1:4).EQ.'LSPI') THEN
         ilspi = ilspi + 1
         nlspi(ilspi) = 0
         do i1=1,nword-2
            read (word(i1+1),*,err=100) ic(ilspi,i1)
            nlspi(i) = nlspi(i) + 1
         enddo
c-LKB  9-JUL-1992 15:21:38 
c for MM3
c  -- same as lrpi for MM2x
      ELSE IF (WORD(1)(1:5).EQ.'NBPOL') THEN
         NBPOL=1
         I1=0
         I2=0
411      CONTINUE
         I1=I1+1
         I2=I2+2
         IF (WORD(I2).EQ.' '.OR.I1.GT.8) GOTO 421
         READ(WORD(I2),*,ERR=100) IP1(I1)
         READ(WORD(I2+1),*,ERR=100) IP2(I1)
         GOTO 411
421      CONTINUE
         NRLPI=I1

C   ---    Card 2

      ELSE IF (WORD(1)(1:4).EQ.'NBUT') THEN
         READ(WORD(2),*,ERR=100) NBUT
      ELSE IF (WORD(1)(1:3).EQ.'DEL') THEN
         READ(WORD(2),*,ERR=100) DEL
      ELSE IF (WORD(1)(1:6).EQ.'ISPEED') THEN
         READ(WORD(2),*,ERR=100) ispeed
      ELSE IF (WORD(1)(1:2).EQ.'NX') THEN
         READ(WORD(2),*,ERR=100) NX
      ELSE IF (WORD(1)(1:4).EQ.'NROT') THEN
         READ(WORD(2),*,ERR=100) NROT
      ELSE IF (WORD(1)(1:3).EQ.'NDC') THEN
         READ(WORD(2),*,ERR=100) NDC
         IF (NDC.EQ.3) POINTQ=.TRUE.
         IF (WORD(3)(1:4).EQ.'OVER') NDCOVER=.TRUE.
      ELSE IF (WORD(1)(1:5).EQ.'NCALC') THEN
         READ(WORD(2),*,ERR=100) NCALC
      ELSE IF (WORD(1)(1:5).EQ.'HFORM') THEN
         READ(WORD(2),*,ERR=100) HFORM
      ELSE IF (WORD(1)(1:4).EQ.'IPUN') THEN
         READ(WORD(2),*,ERR=100) IPUN
      ELSE IF (WORD(1)(1:4).EQ.'MVDW') THEN
         READ(WORD(2),*,ERR=100) MVDW

C   ---   Card 2a

      ELSE IF (WORD(1)(1:5).EQ.'LABEL') THEN
         LABEL=LABEL+1
         READ(WORD(2),*,ERR=100) ITYP(LABEL)
         if (length(word(3)).eq.1) then
            NAM(LABEL)(2:2)=WORD(3)(1:1)
         else
            NAM(LABEL)(1:2)=WORD(3)(1:2)
         endif
         READ(WORD(4),*,ERR=100) WGHT(LABEL)

C   ---   Card 5

C   ---   'SPF' type atom coordinates

      ELSE IF (WORD(1)(1:4).EQ.'ATOM') THEN
         I1=0
         N=N+1
         ITEST=ICHAR(WORD(2)(1:1))
         IF (ITEST.LT.43.OR.ITEST.GT.57) THEN
            I1=1
            ATLAB(N)=WORD(2)
         ENDIF
         READ(WORD(2+I1),*,ERR=100) ATOM(N,1)
         READ(WORD(3+I1),*,ERR=100) ATOM(N,2)
         READ(WORD(4+I1),*,ERR=100) ATOM(N,3)
         READ(WORD(5+I1),*,ERR=100) ITYPE(N)
         I2=5+I1
510      CONTINUE
         I2=I2+1
         IF (I2.GT.NWORD) GOTO 520
         IF (WORD(I2)(1:1).EQ.'P') THEN
            LOG(N)='T'
            PISYS=.TRUE.
         ELSE IF (WORD(I2)(1:1).EQ.'X') THEN
            IRESTR(NRESTR+1,1)=N
            IRESTR(NRESTR+1,2)=1
         ELSE IF (WORD(I2)(1:1).EQ.'Y') THEN
            IRESTR(NRESTR+1,1)=N
            IRESTR(NRESTR+1,3)=1
         ELSE IF (WORD(I2)(1:1).EQ.'Z') THEN
            IRESTR(NRESTR+1,1)=N
            IRESTR(NRESTR+1,4)=1
         ELSE 
            READ(WORD(I2),*,ERR=100) Q(N)
            POINTQ=.TRUE.
         ENDIF
         GOTO 510
520      CONTINUE
         IF (IRESTR(NRESTR+1,1).NE.0) NRESTR=NRESTR+1

C   ---   Card 5a

      ELSE IF (WORD(1)(1:4).EQ.'CELL') THEN
         READ(WORD(2),*,ERR=100) A
         READ(WORD(3),*,ERR=100) B
         READ(WORD(4),*,ERR=100) C
         READ(WORD(5),*,ERR=100) ALPHA
         READ(WORD(6),*,ERR=100) BETA
         READ(WORD(7),*,ERR=100) GAMMA
         IF (NWORD.GT.7) READ(WORD(8),*,ERR=100) NPUNCH

C   ---   Card 5c&d

      ELSE IF (WORD(1)(1:4).EQ.'ORIG') THEN 
         ORIENT=.TRUE.
         READ(WORD(2),*,ERR=100) IAT1
         IF (NWORD.EQ.3) READ(WORD(3),*,ERR=100) IAT2
      ELSE IF (WORD(1)(1:4).EQ.'AXIS') THEN 
         READ(WORD(2),*,ERR=100) IAT3
         IF (NWORD.EQ.4) THEN
            READ(WORD(2),*,ERR=100) IAT4
            I1=1
         ELSE 
            I1=0
         ENDIF
         IF (WORD(3+I1)(1:1).EQ.'X') THEN 
            IAXIS=1
         ELSE IF (WORD(3+I1)(1:1).EQ.'Y') THEN 
            IAXIS=2
         ELSE IF (WORD(3+I1)(1:1).EQ.'Z') THEN 
            IAXIS=3
         ENDIF
      ELSE IF (WORD(1)(1:5).EQ.'PLANE') THEN 
         READ(WORD(2),*,ERR=100) IAT5
         IF (NWORD.EQ.4) THEN
            READ(WORD(2),*,ERR=100) IAT6
            I1=1
         ELSE 
            I1=0
         ENDIF
         IF (WORD(3+I1)(1:1).EQ.'X') THEN 
            IPLANE=1
         ELSE IF (WORD(3+I1)(1:1).EQ.'Y') THEN 
            IPLANE=2
         ELSE IF (WORD(3+I1)(1:1).EQ.'Z') THEN 
            IPLANE=3
         ENDIF
      ELSE IF (WORD(1)(1:6).EQ.'MOLROT') THEN 
         IF (WORD(2)(1:1).EQ.'E'.OR.WORD(2)(1:1).EQ.'C') THEN 
            ISIGN=-1
         ELSE
            ISIGN=1
         ENDIF
         NROTS=NROTS+1
         I1=0
         I2=2
310      CONTINUE
         I1=I1+1
         I2=I2+1
         IF (WORD(I2).EQ.' ') GOTO 320
         READ(WORD(I2),*,ERR=100) ROTS(NROTS)
         GOTO 310
320      CONTINUE
      ELSE IF (WORD(1)(1:4).EQ.'MOVE') THEN 
         READ(WORD(2),*,ERR=100) IAT7
         IF (NWORD.EQ.6) THEN
            READ(WORD(3),*,ERR=100) IAT8
            READ(WORD(4),*,ERR=100) XMOVE
            READ(WORD(5),*,ERR=100) YMOVE
            READ(WORD(6),*,ERR=100) ZMOVE
         ELSE 
            READ(WORD(3),*,ERR=100) XMOVE
            READ(WORD(4),*,ERR=100) YMOVE
            READ(WORD(5),*,ERR=100) ZMOVE
         ENDIF

C   ---   Card 6

      ELSE IF (WORD(1)(1:4).EQ.'SYMM') THEN 
         NSYMM=NSYMM+1
         READ(WORD(2),*,ERR=100) ISYMM(NSYMM,1)
         READ(WORD(3),*,ERR=100) ISYMM(NSYMM,2)
         READ(WORD(4),*,ERR=100) RSYMM(NSYMM,1)
         READ(WORD(5),*,ERR=100) RSYMM(NSYMM,2)
         READ(WORD(6),*,ERR=100) RSYMM(NSYMM,3)
         READ(WORD(7),*,ERR=100) RSYMM(NSYMM,4)
         READ(WORD(8),*,ERR=100) RSYMM(NSYMM,5)
         READ(WORD(9),*,ERR=100) RSYMM(NSYMM,6)
         READ(WORD(10),*,ERR=100) RSYMM(NSYMM,7)
         READ(WORD(11),*,ERR=100) RSYMM(NSYMM,8)
         READ(WORD(12),*,ERR=100) RSYMM(NSYMM,9)

C   ---   Card 8a

      ELSE IF (WORD(1)(1:5).EQ.'DEWAR') THEN 
         NDEWAR=1
         READ(WORD(2),*,ERR=100) NKSB
         READ(WORD(3),*,ERR=100) NKDB
         READ(WORD(4),*,ERR=100) COSB
         READ(WORD(5),*,ERR=100) CODB

C   ---   Card 9

      ELSE IF (WORD(1)(1:4).EQ.'DIEL') THEN 
         READ(WORD(2),*,ERR=100) DIELC
         IF (WORD(3).NE.' ') READ(WORD(3),*,ERR=100) DIELC1
      ELSE IF (WORD(1)(1:4).EQ.'CSTR') THEN 
         READ(WORD(2),*,ERR=100) CSTR
      ELSE IF (WORD(1)(1:2).EQ.'SF') THEN 
         READ(WORD(2),*,ERR=100) SF
      ELSE IF (WORD(1)(1:3).EQ.'RDN') THEN 
         READ (WORD(2),*,ERR=100) RDN
      ELSE IF (WORD(1)(1:4).EQ.'RDND') THEN 
         READ (WORD(2),*,ERR=100) RDND

C   ---   Card 9a

      ELSE IF (WORD(1)(1:4).EQ.'TORS') THEN 
         NT=NT+1
         READ(WORD(2),*,ERR=100) ITORS(NT,1)
         READ(WORD(3),*,ERR=100) ITORS(NT,2)
         READ(WORD(4),*,ERR=100) ITORS(NT,3)
         READ(WORD(5),*,ERR=100) ITORS(NT,4)
         READ(WORD(6),*,ERR=100) TORS(NT,1)
         READ(WORD(7),*,ERR=100) TORS(NT,2)
         READ(WORD(8),*,ERR=100) TORS(NT,3)
         IF (WORD(9).EQ.'F') ITORS(NT,5)=1

c   ---   Card 9a**

      ELSE IF (WORD(1)(1:6).EQ.'TORSTR') THEN 
         NTS=NTS+1
         READ(WORD(2),*,ERR=100) ITS(NTS,1)
         READ(WORD(3),*,ERR=100) ITS(NTS,2)
         READ(WORD(4),*,ERR=100) TORSTR(NTS)

C   ---   Card 9b

      ELSE IF (WORD(1)(1:4).EQ.'STRE') THEN 
         NS=NS+1
         READ(WORD(2),*,ERR=100) ISTR(NS,1)
         READ(WORD(3),*,ERR=100) ISTR(NS,2)
         READ(WORD(4),*,ERR=100) STR(NS,1)
         READ(WORD(5),*,ERR=100) STR(NS,2)
         IF (WORD(6).NE.' ') THEN
            READ(WORD(6),*,ERR=100) STR(NS,3)
            IF (WORD(7).NE.' ') THEN
               READ(WORD(7),*,ERR=100) STR(NS,4)
               IF (WORD(8).NE.' ') THEN
                  READ(WORD(8),*,ERR=100) STR(NS,5)
                  IF (WORD(9).NE.' ') THEN
                     READ(WORD(9),*,ERR=100) STR(NS,6)
                  ENDIF
               ENDIF
            ENDIF
         ENDIF

C   ---   Card 9b**

      ELSE IF (WORD(1)(1:3).EQ.'NEG') THEN 
         NEG=NEG+1
         READ(WORD(2),*,ERR=100) INEG(NEG,1)
         READ(WORD(3),*,ERR=100) INEG(NEG,2)
         READ(WORD(4),*,ERR=100) INEG(NEG,3)
         READ(WORD(5),*,ERR=100) INEG(NEG,4)
         READ(WORD(6),*,ERR=100) RNEG(NEG)

C   ---   Card 9b*2

      ELSE IF (WORD(1)(1:3).EQ.'NCO') THEN 
         NCO=NCO+1
         READ(WORD(2),*,ERR=100) ICO(NCO,1)
         READ(WORD(3),*,ERR=100) ICO(NCO,2)
         READ(WORD(4),*,ERR=100) SCO(NCO)

C   ---   Card 9c

      ELSE IF (WORD(1)(1:6).EQ.'DIPTYP') THEN 
         MUA=MUA+1
         READ(WORD(2),*,ERR=100) IDIPAT(MUA,1)
         READ(WORD(3),*,ERR=100) IDIPAT(MUA,2)
         READ(WORD(4),*,ERR=100) DIPAT(MUA)

C   ---   Card 9d

      ELSE IF (WORD(1)(1:6).EQ.'DIPNUM') THEN 
         MUB=MUB+1
         READ(WORD(2),*,ERR=100) IDIPAN(MUB,1)
         READ(WORD(3),*,ERR=100) IDIPAN(MUB,2)
         READ(WORD(4),*,ERR=100) DIPAN(MUB)

C   ---   Card 9e

      ELSE IF (WORD(1)(1:3).EQ.'VDW') THEN 
         NV=NV+1
         READ(WORD(2),*,ERR=100) IVDW(NV,1)
         READ(WORD(3),*,ERR=100) VDW(NV,1)
         READ(WORD(4),*,ERR=100) VDW(NV,2)
         IF (WORD(5).NE.' ') READ(WORD(5),*,ERR=100) IVDW(NV,2)

C   ---   Card 9f

      ELSE IF (WORD(1)(1:4).EQ.'BEND') THEN 
         NB=NB+1
         READ(WORD(2),*,ERR=100) IBEND(NB,1)
         READ(WORD(3),*,ERR=100) IBEND(NB,2)
         READ(WORD(4),*,ERR=100) IBEND(NB,3)
         READ(WORD(5),*,ERR=100) BEND(NB,1)
         IF (IBEND(NB,1).NE.0) READ(WORD(6),*,ERR=100) BEND(NB,2)
         IF (NWORD.GT.6) THEN
            IF (WORD(7).EQ.'T') THEN
               IBEND(NB,5)=3
               IF (WORD(8).NE.' ') READ(WORD(8),*,ERR=100) IBEND(NB,4)
            ELSE IF (WORD(7).EQ.'F') THEN
               IBEND(NB,5)=4
               IF (WORD(8).NE.' ') READ(WORD(8),*,ERR=100) IBEND(NB,4)
            ELSE 
               READ(WORD(7),*,ERR=100) IBEND(NB,4)
               IF (WORD(8).EQ.'T') THEN
                  IBEND(NB,5)=3
               ELSE IF (WORD(8).EQ.'F') THEN
                  IBEND(NB,5)=4
               ENDIF
            ENDIF
         ENDIF
C   ---   Card 9f**

      ELSE IF (WORD(1)(1:9).EQ.'BEND-BEND') THEN 
         NBB=NBB+1
         READ(WORD(2),*,ERR=100) IBB(NBB,1)
         READ(WORD(3),*,ERR=100) IBB(NBB,2)
         READ(WORD(4),*,ERR=100) IBB(NBB,3)
         READ(WORD(5),*,ERR=100) BB(NBB)
         IF (NWORD.GT.5) THEN
            IF (WORD(6).EQ.'T') THEN
               IBB(NBB,4)=3
            ELSE 
               IF (WORD(6).EQ.'F')  IBB(NBB,4)=4
            ENDIF
         ENDIF

C   ---   Card 9g

      ELSE IF (WORD(1)(1:5).EQ.'STRBE') THEN
         NSB=1
         READ(WORD(2),*,ERR=100) SB1
         READ(WORD(3),*,ERR=100) SB2
         READ(WORD(4),*,ERR=100) SB1H
         READ(WORD(5),*,ERR=100) SB2H

C   ---   Card 9i

      ELSE IF (WORD(1)(1:5).EQ.'HBOND') THEN
         IHBVAL=1
         READ(WORD(2),*,ERR=100) NMA
         READ(WORD(3),*,ERR=100) RMOO
         READ(WORD(4),*,ERR=100) RMHO
         IF (NWORD.GE.5) READ(WORD(5),*,ERR=100) IHOPT

C   ---   Card 10

      ELSE IF (WORD(1)(1:5).EQ.'DRIVE') THEN
         I1=0
         IF (IDRIVE(1).NE.0.OR.CDRIVE(1).NE.' ') I1=4
         ITEST=ICHAR(WORD(2)(1:1))
         IF (ITEST.LT.48.OR.ITEST.GT.57) THEN
            CDRIVE(1+I1)=WORD(2)
         ELSE
            READ(WORD(2),*,ERR=100) IDRIVE(1+I1)
         ENDIF
         ITEST=ICHAR(WORD(3)(1:1))
         IF (ITEST.LT.48.OR.ITEST.GT.57) THEN
            CDRIVE(2+I1)=WORD(3)
         ELSE
            READ(WORD(3),*,ERR=100) IDRIVE(2+I1)
         ENDIF
         ITEST=ICHAR(WORD(4)(1:1))
         IF (ITEST.LT.48.OR.ITEST.GT.57) THEN
            CDRIVE(3+I1)=WORD(4)
         ELSE
            READ(WORD(4),*,ERR=100) IDRIVE(3+I1)
         ENDIF
         ITEST=ICHAR(WORD(5)(1:1))
         IF (ITEST.LT.48.OR.ITEST.GT.57) THEN
            CDRIVE(4+I1)=WORD(5)
         ELSE
            READ(WORD(5),*,ERR=100) IDRIVE(4+I1)
         ENDIF
         READ(WORD(6),*,ERR=100) DRIVE(1+I1)
         READ(WORD(7),*,ERR=100) DRIVE(2+I1)
         READ(WORD(8),*,ERR=100) DRIVE(3+I1)
         NDRIVE=1
         IF (NWORD.GT.8) THEN
            READ(WORD(9),*,ERR=100) NDRIVE
            IF (ABS(NDRIVE).NE.1) THEN
               WRITE(*,*) 'Driver option set to 1 (General use)'
               WRITE(*,*) 'For side chains use option -1'
               NDRIVE=1
            ENDIF   
         ENDIF

C   ---   Non MM2 options

      ELSE IF (WORD(1)(1:4).EQ.'JOIN') THEN
         NJOIN=NJOIN+1
         READ(WORD(2),*,ERR=100) IJOIN(NJOIN,1)
         READ(WORD(3),*,ERR=100) IJOIN(NJOIN,2)
      ELSE IF (WORD(1)(1:5).EQ.'BREAK') THEN
         NBREAK=NBREAK+1
         READ(WORD(2),*,ERR=100) IBREAK(NBREAK,1)
         READ(WORD(3),*,ERR=100) IBREAK(NBREAK,2)
      ELSE IF (WORD(1)(1:3).EQ.'ADD') THEN
         IF (WORD(2)(1:4).EQ.'LONE'.OR.WORD(2)(1:2).EQ.'LP') THEN
            LPADD=.TRUE.
         ELSE
            NNEW=NNEW+1
            ITEST=ICHAR(WORD(2)(1:1))
            IF (ITEST.LT.48.OR.ITEST.GT.57) CNEW(NNEW,4)=WORD(2)
            READ(WORD(3),*,ERR=100) RNEW(NNEW,1)
            ITEST=ICHAR(WORD(4)(1:1))
            IF (ITEST.GE.48.AND.ITEST.LE.57) THEN
               READ(WORD(4),*,ERR=100) INEW(NNEW,1)
            ELSE
               CNEW(NNEW,1)=WORD(4)
            ENDIF
            READ(WORD(5),*,ERR=100) RNEW(NNEW,2)
            ITEST=ICHAR(WORD(6)(1:1))
            IF (ITEST.GE.48.AND.ITEST.LE.57) THEN
               READ(WORD(6),*,ERR=100) INEW(NNEW,2)
            ELSE
               CNEW(NNEW,2)=WORD(6)
            ENDIF
            READ(WORD(7),*,ERR=100) RNEW(NNEW,3)
            ITEST=ICHAR(WORD(8)(1:1))
            IF (ITEST.GE.48.AND.ITEST.LE.57) THEN
               READ(WORD(8),*,ERR=100) INEW(NNEW,3)
            ELSE
               CNEW(NNEW,3)=WORD(8)
            ENDIF
            READ(WORD(9),*,ERR=100) INEW(NNEW,4)
            IF (NWORD.GT.9) READ(WORD(10),*,ERR=100) RNEW(NNEW,4)
         ENDIF
      ELSE IF (WORD(1)(1:2).EQ.'PI') THEN
         DO I1=2,NWORD
            NPI=NPI+1
            PI(NPI)=WORD(I1)
         ENDDO
C      ELSE IF (WORD(1)(1:4).EQ.'XFIX') THEN
C         DO I1=2,NWORD
C            NXFIX=NXFIX+1
C            XFIX(NXFIX)=WORD(I1)
C         ENDDO
C      ELSE IF (WORD(1)(1:4).EQ.'YFIX') THEN
C         DO I1=2,NWORD
C            NYFIX=NYFIX+1
C            YFIX(NYFIX)=WORD(I1)
C         ENDDO
C      ELSE IF (WORD(1)(1:4).EQ.'ZFIX') THEN
C         DO I1=2,NWORD
C            NZFIX=NZFIX+1
C            ZFIX(NZFIX)=WORD(I1)
C         ENDDO
      ELSE IF (WORD(1)(1:1).EQ.'!'.OR.WORD(1)(1:4).EQ.'MESS') THEN
      ELSE IF (WORD(1)(1:6).EQ.'OUTPUT') THEN
         IF (WORD(2)(1:5).EQ.'MMP85') THEN
            MMP85=.TRUE.
            MM287=.FALSE.
            MM2HB=.FALSE.
            MM3 = .FALSE.
         ELSE IF (WORD(2)(1:5).EQ.'MM2HB') THEN
            MMP85=.FALSE.
            MM287=.FALSE.
            MM2HB=.TRUE.
            MM3 = .FALSE.
         ELSE IF (WORD(2)(1:5).EQ.'MM287') THEN
            MMP85=.FALSE.
            MM287=.TRUE.
            MM2HB=.FALSE.
            MM3 = .FALSE.
         ELSE IF (WORD(2)(1:3).EQ.'MM3') THEN
            MMP85=.FALSE.
            MM287=.FALSE.
            MM2HB=.FALSE.
            MM3 = .TRUE.
         ELSE 
            WRITE(*,*) 'Unknown output type:'
            WRITE(*,*) WORD(2)
         ENDIF
      ELSE IF (WORD(1)(1:5).EQ.'TABLE') THEN
         IF (WORD(2)(1:2).EQ.'ON') THEN
            TRANSL=.TRUE.
         ELSE IF (WORD(2)(1:3).EQ.'OFF') THEN
            TRANSL=.FALSE.
         ENDIF
      ELSE IF (WORD(1)(1:3).EQ.'END') THEN
         GOTO 1000

C   ---   Ignored keywords

      ELSE IF (WORD(1)(1:4).EQ.'CESD'.OR.WORD(1)(1:4).EQ.'SPGR'
     1 .OR.WORD(1)(1:4).EQ.'LATT') THEN
          WRITE(*,*) 'Card ignored: ',WORD(1)(1:20)

C   ---   'DGE' and 'RES' type atom coordinates

      ELSE
         N=N+1
         ITEST=ICHAR(WORD(1)(1:1))
         IF (ITEST.GE.43.AND.ITEST.LE.57) THEN
            READ(WORD(1),*,ERR=100) ATOM(N,1)
            READ(WORD(2),*,ERR=100) ATOM(N,2)
            READ(WORD(3),*,ERR=100) ATOM(N,3)
            READ(WORD(4),*,ERR=100) ITYPE(N)
            I2=4
         ELSE
            ATLAB(N)=WORD(1)
            READ(WORD(2),*,ERR=100) ITYPE(N)
            READ(WORD(3),*,ERR=100) ATOM(N,1)
            READ(WORD(4),*,ERR=100) ATOM(N,2)
            READ(WORD(5),*,ERR=100) ATOM(N,3)
            I2=5
         ENDIF
910      CONTINUE
         I2=I2+1
         IF (I2.GT.NWORD) GOTO 920
         IF (WORD(I2)(1:1).EQ.'P') THEN
            LOG(N)='T'
            PISYS=.TRUE.
         ELSE IF (WORD(I2)(1:1).EQ.'X') THEN
            IRESTR(NRESTR+1,1)=N
            IRESTR(NRESTR+1,2)=1
         ELSE IF (WORD(I2)(1:1).EQ.'Y') THEN
            IRESTR(NRESTR+1,1)=N
            IRESTR(NRESTR+1,3)=1
         ELSE IF (WORD(I2)(1:1).EQ.'Z') THEN
            IRESTR(NRESTR+1,1)=N
            IRESTR(NRESTR+1,4)=1
         ELSE IF (WORD(I2)(1:1).EQ.'(') THEN
         ELSE 
            READ(WORD(I2),*,ERR=100) Q(N)
            POINTQ=.TRUE.
         ENDIF
         GOTO 910
920      CONTINUE
         IF (IRESTR(NRESTR+1,1).NE.0) NRESTR=NRESTR+1
      ENDIF
      GOTO 10
1000  CONTINUE

C   ---   Consistency & Calculations

      IF (MM2HB.AND.PISYS) THEN
         WRITE(*,*) 'Pi atoms ignored - output type is MM2HB'
         PISYS=.FALSE.
      ENDIF
      IF (.NOT.MM2HB.AND.(NBUT.NE.0.OR.IPUN.NE.0.OR.IHBVAL.NE.0)) 
     1 WRITE(*,*) 
     2 'NBUT, IPUN and HBOND ignored - output type is not MM2HB'
      IF (MM2HB.AND.(NEG.NE.0.OR.DEL.NE.0.)) 
     1 WRITE(*,*) 
     2 'Negativity cards and DEL ignored - output type is MM2HB'
      IF (.NOT.(MM287.OR.MM3).AND.(IFINDP.NE.0)) WRITE(*,*)
     1 'IFINDP command ignored - output type is not MM287 or MM3'
      IF ((MM287.OR.MM3).AND.IFINDP.EQ.0.AND.NPLANE.NE.0) WRITE(*,*)
     1 'NPLANE specification will be ignored - IFINDP parameter is 0'
      IF (POINTQ.AND.NDC.NE.3)THEN
         IF (NDCOVER) THEN
            WRITE(*,*) 'Charges ignored - NDC x OVERRULE specified'
            POINTQ=.FALSE.
         ELSE
            WRITE(*,*) 'NDC set to 3 (charges used)'
            NDC=3
            POINTQ=.TRUE.
         ENDIF
      ENDIF
      IF (ORIENT.AND.(NCALC.NE.2.AND.NCALC.NE.4)) THEN
         WRITE(*,*) 'NCALC set to 2 (orientation options  used)'
         NCALC=2
      ENDIF
      IF (NRESTR.GT.0) NRSTR=1
      IF (PISYS.AND.N.GT.60) ICONT=1

C   ---   Calculate carthesian coordinates

      IF (A.NE.0.0) THEN
         CALL CARTH(A,B,C,ALPHA,BETA,GAMMA)
         IF (NCALC.EQ.1.OR.NCALC.EQ.3) NCALC=NCALC-1
      ENDIF

C   ---   Add atoms; interpret atom labels

      DO I=1,NNEW
         DO I2=1,3
            IF (INEW(I,I2).EQ.0) THEN
               CALL FINDNUM(CNEW(I,I2),INEW(I,I2),IERR)
               IF (IERR.NE.0) THEN
                  WRITE(*,*) 'Label not found: ',CNEW(I,I2)
                  WRITE(*,*) 'Atom not added'
                  GOTO 610
               ENDIF
            ENDIF   
         ENDDO
         CALL ADDATOM(N+1,RNEW(I,1),INEW(I,1),RNEW(I,2),INEW(I,2),
     1    RNEW(I,3),INEW(I,3))
         N=N+1
         ATLAB(N)=CNEW(I,4)
         ITYPE(N)=INEW(I,4)         
         Q(N)=RNEW(I,4)
610      CONTINUE
      ENDDO

C   ---   Update pi-system list

      IF (NPI.NE.0) THEN
         PISYS=.TRUE.
         DO I=1,NPI
            CALL UPCASE(PI(I),PI(I))
            IF (PI(I)(1:1).GE.'0'.AND.PI(I)(1:1).LE.'9') THEN
               READ(PI(I),*) I2
               LOG(I2)='T'
            ELSE
               CALL FINDNUM(PI(I),I2,IERR)
               IF (IERR.NE.0) THEN
                  WRITE(*,*) 'Label not found: ',PI(I)
                  WRITE(*,*) 'Atom not added to pi system'
               ELSE
                  LOG(I2)='T'
               ENDIF
            ENDIF
         ENDDO
      ENDIF


C   ---   Total charge

      IF (POINTQ) THEN      
         DO I=1,N
            QTOT=QTOT+Q(I)
         ENDDO
         WRITE(*,*) 'Total charge is ',QTOT
      ENDIF

C   ---   Determine connectivity

      CALL MAKECONN

C   ---   Add lone pairs

      IF (LPADD) THEN
      DO I=1,N
C   ---   Find type 6, 8, 37, 41
         IF (ITYPE(I).EQ.6) THEN
C   ---   Find attached atoms; store in iscratch
            I1=0
            DO J=1,N
               IF (MATCONN(I,J).EQ.1) THEN
                  I1=I1+1
                  ISCRATCH(I1)=J
               ENDIF
            ENDDO
C   ---   Check number of bonded atoms
            IF (I1.NE.2) THEN
              WRITE(*,*) 'Atom ',ATLAB(I),' (nr',I,') has',I1,' bonds'
              WRITE(*,*) 'No lone pairs added to this atom'
            ELSE
C   ---   Calculate vectors  Neighbour -> O; sum & vectorproduct; normalize
               R1X=ATOM(I,1)-ATOM(ISCRATCH(1),1)
               R1Y=ATOM(I,2)-ATOM(ISCRATCH(1),2)
               R1Z=ATOM(I,3)-ATOM(ISCRATCH(1),3)
               R2X=ATOM(I,1)-ATOM(ISCRATCH(2),1)
               R2Y=ATOM(I,2)-ATOM(ISCRATCH(2),2)
               R2Z=ATOM(I,3)-ATOM(ISCRATCH(2),3)
               R3X=R1X+R2X
               R3Y=R1Y+R2Y
               R3Z=R1Z+R2Z
               R3=0.6*COSD(65.5)/SQRT(R3X*R3X+R3Y*R3Y+R3Z*R3Z)
               R3X=R3X*R3
               R3Y=R3Y*R3
               R3Z=R3Z*R3
               R4X=R1Y*R2Z-R1Z*R2Y
               R4Y=R1Z*R2X-R1X*R2Z
               R4Z=R1X*R2Y-R1Y*R2X
               R4=0.6*SIND(65.5)/SQRT(R4X*R4X+R4Y*R4Y+R4Z*R4Z)
               R4X=R4X*R4
               R4Y=R4Y*R4
               R4Z=R4Z*R4
C   ---   Add lone pairs
               N=N+1
               ITYPE(N)=20
               ATOM(N,1)=ATOM(I,1)+R3X+R4X
               ATOM(N,2)=ATOM(I,2)+R3Y+R4Y
               ATOM(N,3)=ATOM(I,3)+R3Z+R4Z
               N=N+1
               ITYPE(N)=20
               ATOM(N,1)=ATOM(I,1)+R3X-R4X
               ATOM(N,2)=ATOM(I,2)+R3Y-R4Y
               ATOM(N,3)=ATOM(I,3)+R3Z-R4Z
C   ---   Update connectivity matrix
               MATCONN(I,N-1)=1
               MATCONN(N-1,I)=1
               MATCONN(I,N)=1
               MATCONN(N,I)=1
            ENDIF
         ELSE IF (ITYPE(I).EQ.8) THEN
C   ---   Find attached atoms; store in iscratch
            I1=0
            DO J=1,N
               IF (MATCONN(I,J).EQ.1) THEN
                  I1=I1+1
                  ISCRATCH(I1)=J
               ENDIF
            ENDDO
C   ---   Check number of bonded atoms
            IF (I1.NE.3) THEN
              WRITE(*,*) 'Atom ',ATLAB(I),' (nr ',I,') has ',I1,'bonds'
              WRITE(*,*) 'No lone pairs added to this atom'
            ELSE
C   ---   Calculate vectors  Neighbour -> N; sum; normalize
               R1X=ATOM(I,1)-ATOM(ISCRATCH(1),1)
               R1Y=ATOM(I,2)-ATOM(ISCRATCH(1),2)
               R1Z=ATOM(I,3)-ATOM(ISCRATCH(1),3)
               R2X=ATOM(I,1)-ATOM(ISCRATCH(2),1)
               R2Y=ATOM(I,2)-ATOM(ISCRATCH(2),2)
               R2Z=ATOM(I,3)-ATOM(ISCRATCH(2),3)
               R3X=ATOM(I,1)-ATOM(ISCRATCH(3),1)
               R3Y=ATOM(I,2)-ATOM(ISCRATCH(3),2)
               R3Z=ATOM(I,3)-ATOM(ISCRATCH(3),3)
               R4X=R1X+R2X+R3X
               R4Y=R1Y+R2Y+R3Y
               R4Z=R1Z+R2Z+R3Z
               R4=0.6/SQRT(R4X*R4X+R4Y*R4Y+R4Z*R4Z)
               R4X=R4X*R4
               R4Y=R4Y*R4
               R4Z=R4Z*R4
C   ---   Add lone pair
               N=N+1
               ITYPE(N)=20
               ATOM(N,1)=ATOM(I,1)+R4X
               ATOM(N,2)=ATOM(I,2)+R4Y
               ATOM(N,3)=ATOM(I,3)+R4Z
C   ---   Update connectivity matrix
               MATCONN(I,N)=1
               MATCONN(N,I)=1
            ENDIF
         ELSE IF (ITYPE(I).EQ.37.OR.ITYPE(I).EQ.41) THEN
C   ---   Find attached atoms; store in iscratch
            I1=0
            DO J=1,N
               IF (MATCONN(I,J).EQ.1) THEN
                  I1=I1+1
                  ISCRATCH(I1)=J
               ENDIF
            ENDDO
C   ---   Check number of bonded atoms
            IF (I1.NE.2) THEN
              WRITE(*,*) 'Atom ',ATLAB(I),' (nr',I,') has',I1,' bonds'
              WRITE(*,*) 'No lone pairs added to this atom'
            ELSE
C   ---   Calculate vectors  Neighbour -> N/O; sum & vectorproduct; normalize
               R1X=ATOM(I,1)-ATOM(ISCRATCH(1),1)
               R1Y=ATOM(I,2)-ATOM(ISCRATCH(1),2)
               R1Z=ATOM(I,3)-ATOM(ISCRATCH(1),3)
               R2X=ATOM(I,1)-ATOM(ISCRATCH(2),1)
               R2Y=ATOM(I,2)-ATOM(ISCRATCH(2),2)
               R2Z=ATOM(I,3)-ATOM(ISCRATCH(2),3)
               R3X=R1X+R2X
               R3Y=R1Y+R2Y
               R3Z=R1Z+R2Z
               IF (ITYPE(I).EQ.37) THEN
                  R3=0.6/SQRT(R3X*R3X+R3Y*R3Y+R3Z*R3Z)
               ELSE IF (ITYPE(I).EQ.41) THEN
                  R3=0.5/SQRT(R3X*R3X+R3Y*R3Y+R3Z*R3Z)
               ENDIF
               R3X=R3X*R3
               R3Y=R3Y*R3
               R3Z=R3Z*R3
C   ---   Add lone pairs
               N=N+1
               ITYPE(N)=20
               ATOM(N,1)=ATOM(I,1)+R3X
               ATOM(N,2)=ATOM(I,2)+R3Y
               ATOM(N,3)=ATOM(I,3)+R3Z
C   ---   Update connectivity matrix
               MATCONN(I,N)=1
               MATCONN(N,I)=1
            ENDIF
         ENDIF
      ENDDO
      ENDIF

C   ---   Number of atoms

      IF (MMP85) THEN
         I1=255
      ELSE IF (MM2HB) THEN
         I1=200
      ELSE IF(MM287) THEN
         I1=100
      ELSE IF(MM3) THEN
         I1=700
      ENDIF
      IF (N.LT.1.OR.N.GT.I1) THEN
         WRITE(*,*) 'WARNING: Number of atoms is ',N
         WRITE(*,*) 'Number of atoms must lie between 1 and ',I1
      ENDIF

C   ---   Check driver 

      IF (NDRIVE.NE.0) THEN
C   ---   Interpret atomlabels
         DO I=1,8
            IF (CDRIVE(I).NE.' ') THEN
               CALL FINDNUM(CDRIVE(I),IDRIVE(I),IERR)
               IF (IERR.NE.0) THEN
                  I1=INT((I-1)/4)+1
                  WRITE(*,*) 'Atomlabel could not be identified in card'
                  WRITE(*,*) 'DRIVER nr ',I2
                  WRITE(*,*) 
     1             'The driver instruction is removed from input'
               IDRIVE(1)=0
               NDRIVE=0
               GOTO 710
               ENDIF
            ENDIF
         ENDDO
C   ---   Check atomnumbers
         IF (IDRIVE(1).GT.N.OR.IDRIVE(2).GT.N.OR.IDRIVE(3).GT.N.OR.
     1    IDRIVE(4).GT.N.OR.IDRIVE(5).GT.N.OR.IDRIVE(6).GT.N.OR.
     2    IDRIVE(7).GT.N.OR.IDRIVE(8).GT.N) WRITE(*,*)
     3    'Illegal atom number in DRIVE option'
C   ---   Check existence of bonds with connectivity matrix
         DO I1=1,5,5
            DO I=I1,I1+2
               IF (MATCONN(IDRIVE(I),IDRIVE(I+1)).EQ.0) THEN
                  WRITE(*,*) 'WARNING: Driver bond does not exist:',
     1             IDRIVE(I),IDRIVE(I+1)
                  WRITE(*,*) 'Driver option ignored'
                  NDRIVE=0
               ENDIF
            ENDDO
         ENDDO
      ENDIF
710   CONTINUE

C   ---   Create attached and connected atom lists

      CALL MM2CONN
      IF (NCONN.GT.20) WRITE(*,*) 
     1 'Maximum number of connectivity cards exceeded by',NCONN-20
      IF ((NT.NE.0).OR.(NS.NE.0).OR.(NEG.NE.0).OR.(NV.NE.0).OR.
     1 (NB.NE.0).OR.(MUA.NE.0).OR.(MUB.NE.0).OR.(NSB.NE.0).OR.
     2 (DIELC.NE.0.).OR.(CSTR.NE.0.).OR.(SF.NE.0.).OR.(RDN.NE.0.).OR.
     3 (RDND.NE.0).OR.(IHBVAL.NE.0).OR.(DIELC1.NE.0)) NCONST=1

C   ---   Write information in MM2 format

C   ---   Open output files - .PAR only in case MM287 is true

      call newfile(2,param(1:length(param))//'.ins',iostat)
      if (iostat.ne.0) goto 120
      IF (MM287) THEN 
         call newfile(3,param(1:length(param))//'.par',iostat)
         if (iostat.ne.0) goto 130
C   ---   Specifies output unit for card 9 (changed parameters)
         NPAROUT=3
      ELSE
        IF (MM3) THEN 
          call newfile(3,'mm3par.par',iostat)
          if (iostat.ne.0) goto 130
C   ---   Specifies output unit for card 9 (changed parameters)
          NPAROUT=3
        ELSE
          NPAROUT=2
        ENDIF
      ENDIF

C   ---   Card 1, 1a, 1b, 1c, 1d

      IF (MM2HB) THEN
         WRITE(2,'(A60,I5,I2,I3,I2,I3,F5.0)') 
     1    ID,N,IPRINT,NRSTR,INIT,NCONST,TMAX
      ELSE IF (MMP85) THEN
         WRITE(2,'(A60,I5,I2,I3,I2,I3,F5.0)') 
     1    ID,N,IPRINT,NRSTR,INIT,NCONST,TMAX
         IF (.NOT.PISYS) THEN
            WRITE(2,'(1X)')
         ELSE
            WRITE(2,'(60A1,6I2,1X,2I2,2X,I1)') (LOG(I),I=1,60),NPLANE,
     1       ISET,JPRINT,IBETA,LIMIT,ITER,NDEWAR,LRPI,ICONT
            IF (ICONT.NE.0) WRITE(2,'(40A1)') (LOG(I),I=61,100)
            IF (IBETA.NE.0) WRITE(2,'(3F10.5)') EBETA,EBE,EBB
            IF (LRPI.NE.0) WRITE(2,'(16I5)') (IP1(I),IP2(I),I=1,NRLPI)
         ENDIF
      ELSE IF (MM287) THEN
         IF (.NOT.PISYS) THEN
            METHOD=0
            WRITE(2,'(A60,I1,I4,I2,I3,I2,I3,F5.0)') 
     1       ID,METHOD,N,IPRINT,NRSTR,INIT,NCONST,TMAX
         ELSE 
            METHOD=1
            WRITE(2,'(A60,I1,I4,I2,I3,I2,I3,F5.0)') 
     1       ID,METHOD,N,IPRINT,NRSTR,INIT,NCONST,TMAX
            WRITE(2,'(60A1,2I1,5I2,1X,2I2,2X,I1)') 
     1       (LOG(I),I=1,60),IFINDP,
     2       NPLANE,ISET,JPRINT,IBETA,LIMIT,ITER,NDEWAR,LRPI,ICONT
            IF (ICONT.NE.0) WRITE(2,'(40A1)') (LOG(I),I=61,100)
            IF (IBETA.NE.0) WRITE(2,'(3F10.5)') EBETA,EBE,EBB
            IF (LRPI.NE.0) WRITE(2,'(16I5)') (IP1(I),IP2(I),I=1,NRLPI)
         ENDIF
      ELSE IF (MM3) THEN
         IF (.NOT.PISYS) THEN
            METHOD=0
            WRITE(2,'(A60,I1,I4,I2,I1,I2,I2,I3,F5.0)') 
     1       ID,METHOD,N,IPRINT,MDERIV,NRSTR,INIT,NCONST,TMAX
         ELSE 
            METHOD=1
            WRITE(2,'(A60,I1,I4,I2,I1,I2,I2,I3,F5.0)') 
     1       ID,METHOD,N,IPRINT,NRSTR,MDERIV,INIT,NCONST,TMAX
            WRITE(2,'(60A1,2I1,5I2,2I2,2I1,i2)') 
     1       (LOG(I),I=1,60),IFINDP,
     2       NPLANE,ISET,JPRINT,IBETA,LIMIT,ITER,NDEWAR,LSPI,NBPOL,
     3       LPCHG,ICONT
            IF (ICONT.NE.0) WRITE(2,'(40A1)') (LOG(I),I=61,100)
            IF (IBETA.NE.0) WRITE(2,'(3F10.5)') EBETA,EBE,EBB
            IF (LSPI.NE.0) WRITE(2,'(16I5)') 
     1       (nlspi(i),(ic(i,j),j=1,nlspi(i)),i=1,ilspi)
            IF (NBPOL.NE.0) WRITE(2,'(16I5)') (IP1(I),IP2(I),I=1,NRLPI)
         ENDIF
      ENDIF

C   ---   Card 2

      IF (MMP85.OR.MM287) THEN
         WRITE(2,'(I5,5X,F10.5,5X,8I5,5X,2I5)') NCONN,DEL,NATTCH,NSYMM,
     1    NX,NROT,LABEL,NDC,NCALC,HFORM,MVDW,NDRIVE
      ELSE IF (MM2HB) THEN
         WRITE(2,'(I5,15X,11I5,I3,I2)') NCONN,NBUT,NATTCH,NSYMM,
     1    NX,NROT,LABEL,NDC,NCALC,HFORM,IHBVAL,MVDW,IPUN,NDRIVE
      ELSE IF (MM3) THEN
         WRITE(2,'(I1,I4,5X,F10.5,9I5,5X,2I5)') KFIXTYP,NCONN,DEL,
     1    ISPEED,NATTCH,NSYMM,NX,NROT,LABEL,NDC,NCALC,HFORM,MVDW,
     2    NDRIVE
      ENDIF

      DO I=1,LABEL
         WRITE(2,'(I5,3X,A2,F10.5)') ITYP(I),NAM(I),WGHT(I)
      ENDDO

      IF (POINTQ) WRITE(2,'(8F10.5)') (Q(I),I=1,N)

C   ---   Card 3

      DO I=1,NCONN
         WRITE(2,'(16I5)') (ICONN(I,J),J=1,16)
      ENDDO

C   ---   Card 4

      WRITE(2,'(16I5)') (JATTCH(I),KATTCH(I),I=1,NATTCH)

C   ---   Card 5

      IF (MMP85.OR.MM287) THEN
         WRITE(2,'(3F10.5,I5)') ((ATOM(I,J),J=1,3),ITYPE(I),I=1,N)
      ELSE
         WRITE(2,'(2(3F10.5,I5,5X))')
     1    ((ATOM(I,J),J=1,3),ITYPE(I),I=1,N)
      ENDIF

      IF (ORIENT) WRITE(2,'(11I5,3F8.5)') IAT1,IAT2,IAT3,IAT4,IAXIS,
     1 IAT5,IAT6,IPLANE,NROTS,IAT7,IAT8,XMOVE,YMOVE,ZMOVE

      IF (NROTS.NE.0) WRITE(2,'(8F10.2)') (ROTS(I),I=1,ABS(NROTS))

C   ---   Card 6

      DO I=1,NSYMM
         WRITE(2,'(2I4,9F8.5)') (ISYMM(I,J),J=1,2),(RSYMM(I,K),K=1,9)
      ENDDO

C   ---   Card 7

      IF (NRSTR.EQ.1) THEN
         WRITE(2,'(I5)') NRESTR 
         WRITE(2,'(16(I2,3I1))') ((IRESTR(I,J),J=1,4),I=1,NRESTR)
      ENDIF

C   ---   Card 8

      IF (PISYS.AND.NDEWAR.EQ.1) WRITE(2,'(2I5,2F10.3)') 
     1 NKSB,NKDB,COSB,CODB

C   ---   Card 9

      IF (NCONST.NE.0) THEN
      IF (MMP85.OR.MM287) THEN
         WRITE(NPAROUT,'(2I5,I2,1X,I2,5I5,5F5.1)')
     1    NT,NS,NEG,NV,NB,MUA,MUB,NSB,NH,DIELC,CSTR,SF,RDN,RDND
      ELSE IF (MM2HB) THEN
         WRITE(NPAROUT,'(7I5,I4,2F3.1,3F5.1)')
     1    NT,NS,NV,NB,MUA,MUB,NSB,NH,DIELC,DIELC1,CSTR,SF,RDN
      ELSE IF (MM3) THEN
         WRITE(NPAROUT,'(2I5,I2,1X,I2,i2,i3,4i5,2f5.0,2i5,2f5.0,
     1    i5,f5.0)')
     2    NT,NS,NEG,NV,NCHRG,NB,MUA,MUB,NSB,NH,DIELC,CSTR,nbb,
     3    nco,rdnh,rdnd,nts,adielc
      ENDIF
      IF (MM3) then 
         print *,'MM3 changed constants not fully tested, please check'
         goto 888
      endif
      DO I=1,NT
         WRITE(NPAROUT,'(I1,I4,3I5,3F10.5)') 
     1    ITORS(I,5),(ITORS(I,J),J=1,4),(TORS(I,K),K=1,3)
      ENDDO
      do i=1,nts
         write(nparout,'(2i5,f10.4)') its(i,1),its(i,2),torstr(i)
      enddo
      DO I=1,NS
         WRITE(NPAROUT,'(2I5,6F10.5)') 
     1    ISTR(I,1),ISTR(I,2),(STR(I,J),J=1,6)
      ENDDO
      IF (MMP85.or.mm3) THEN
         DO I=1,NEG
            WRITE(NPAROUT,'(4I5,F10.5)') (INEG(I,J),J=1,4),RNEG(I)
         ENDDO
      ENDIF
      IF (mm3) THEN
         DO I=1,NCO
            WRITE(NPAROUT,'(2I5,F10.5)') (ICO(I,J),J=1,2),SCO(I)
         ENDDO
      ENDIF
      DO I=1,MUA
         WRITE(NPAROUT,'(2I5,F10.5)') IDIPAT(I,1),IDIPAT(I,2),DIPAT(I)
      ENDDO
      DO I=1,MUB
         WRITE(NPAROUT,'(2I5,F10.5)') IDIPAN(I,1),IDIPAN(I,2),DIPAN(I)
      ENDDO
      IF (MMP85.OR.MM287.OR.MM3) THEN
         DO I=1,NV
            WRITE(NPAROUT,'(2I5,2F10.5)') 
     1       IVDW(I,2),IVDW(I,1),VDW(I,1),VDW(I,2)
         ENDDO
      ELSE
         DO I=1,NV
            WRITE(NPAROUT,'(I10,2F10.5)') IVDW(I,1),VDW(I,1),VDW(I,2)
         ENDDO
      ENDIF

c --  addition of charge in MM3 not implemented 
c      (can be added on mmins input)

      DO I=1,NB
         WRITE(NPAROUT,'(I1,I4,2I5,5X,2F10.5,I5)') 
     1    IBEND(I,5),IBEND(I,1),IBEND(I,2),IBEND(I,3),BEND(I,1),
     2    BEND(I,2),IBEND(I,4)
      ENDDO
      if (MM3) THEN
        DO I=1,NBB
           WRITE(NPAROUT,'(I1,I4,2I5,5X,F10.5)') 
     1      IBB(I,4),IBB(I,1),IBB(I,2),IBB(I,3),BB(I)
        ENDDO
      ENDIF
      IF (NSB.EQ.1) WRITE(NPAROUT,'(4F10.5)') SB1,SB2,SB1H,SB2H
      ENDIF
888   continue

C   ---   Card 10

      IF (NDRIVE.NE.0) WRITE(2,'(2(4I5,5X,3F5.0))') (IDRIVE(I),I=1,4),
     1 (DRIVE(I),I=1,3),(IDRIVE(I),I=5,8),(DRIVE(I),I=5,7)

C   ---   Make translation table atomnumber - atomlabel

      IF (TRANSL) THEN
         call newfile(4,param(1:length(param))//'.ttb',iostat)
         if (iostat.ne.0) stop 'Couldn''t open TTB file'
         WRITE(4,'(A22)') ' Translation table for'
         WRITE(4,'(1X,A60)') ID
         WRITE(4,'(1X)')
         DO I=1,N
            WRITE(TEMP,'(I5)') I
            DO WHILE (TEMP(1:1).EQ.' ')
               TEMP=TEMP(2:)
            ENDDO
            I1=LENGTH(TEMP)
            I2=INT((I-1)/59)
            I3=I-I2*59
            I4=20*I2+1
            I5=20*I2+16
            WRITE(TABLE(I3)(I4:I5),
     1       '(<4-I1>X,A<I1>,A3,A8)') TEMP,'...',ATLAB(I)
         ENDDO
         WRITE(4,'(A80)') (TABLE(I),I=1,59)
      ENDIF

C   ---    Normal end of program

      goto 9876

C   ---   Error handling

C   ---   Error in internal read
100   WRITE(*,*) 'Numeral or integer expected on card '//
     1 WORD(1)(1:LENSTR(WORD(1)))
      WRITE (*,*) LINE
      STOP 'Terminated'
C   ---   Input file cannot be opened
110   WRITE(*,*) 
     1 'Cannot open input file ',PARAM(1:LENGTH(PARAM)),'.dat'
      STOP 'MMINS terminated'
C   ---   Input file cannot be opened
120   WRITE(*,*) 
     1 'Cannot open output file ',PARAM(1:LENGTH(PARAM)),'.ins'
      STOP 'MMINS terminated'
C   ---   Input file cannot be opened
130   WRITE(*,*) 
     1 'Cannot open output file ',PARAM(1:LENGTH(PARAM)),'.par'
      STOP 'MMINS terminated'
9876  continue      
      END


      SUBROUTINE MAKECONN
C
C     Produces a connectivity matrix based on distances between
C     the atoms. The matrix is adapted according to the user specified
C     information contained in IJOIN and IBREAK.
C
      PARAMETER MAX1=350,MAX2=700
      DIMENSION RADIUS(50)
      COMMON /C/ ATOM(MAX1,3),JATTCH(MAX2),KATTCH(MAX2),
     1 ICONN(60,16),N,NCONN,NATTCH,ITYPE(MAX1),NJOIN,IJOIN(MAX2,2),
     2 NBREAK,IBREAK(MAX2,2),MATCONN(MAX1,MAX1)

C   ---   Data from Cambridge Structural data base manual
C         be careful with chlorine/chloride bromine/bromide
C         lone pairs

      DATA RADIUS /0.68,0.68,0.68,0.68,0.23,0.68,0.68,0.68,0.68,0.68,
     1 0.64,0.99,1.21,1.40,1.02,1.02,1.02,1.02,1.20,0.10,
     2 0.23,0.68,0.23,0.23,1.05,0.83,0.83,0.23,0.68,0.68,
     3 1.17,1.46,1.54,1.22,1.47,0.23,0.68,0.68,0.68,0.68,
     4 0.68,1.02,0.68,7*0.68/

C   ---   Set up connectivity matrix

      DO I=1,N-1
         DO J=I+1,N
            DISTX=ATOM(I,1)-ATOM(J,1)
            DISTY=ATOM(I,2)-ATOM(J,2)
            DISTZ=ATOM(I,3)-ATOM(J,3)
            DIST=SQRT(DISTX*DISTX+DISTY*DISTY+DISTZ*DISTZ)
            BOND=RADIUS(ITYPE(I))+RADIUS(ITYPE(J))+0.40
            IF (DIST.LE.BOND) THEN
               MATCONN(I,J)=1
               MATCONN(J,I)=1
            ENDIF
         ENDDO
      ENDDO

C   ---   Add specific join and break instructions to connectivity
C         matrix

      DO I=1,NJOIN
         MATCONN(IJOIN(I,1),IJOIN(I,2))=1
         MATCONN(IJOIN(I,2),IJOIN(I,1))=1
      ENDDO
      DO I=1,NBREAK
         MATCONN(IBREAK(I,1),IBREAK(I,2))=0
         MATCONN(IBREAK(I,2),IBREAK(I,1))=0
      ENDDO
      RETURN
      END



      SUBROUTINE MM2CONN
C
C     PRODUCES MM2 CONNECTIVITY, I.E. 'ATTACHED' ATOMS IN S ARRAYS
C     JATTCH AND KATTCH & 'CONNECTED' ATOMS IN ARRAY ICONN
C
      PARAMETER MAX1=350,MAX2=700
      DIMENSION IEND(MAX1)
      COMMON /C/ ATOM(MAX1,3),JATTCH(MAX2),KATTCH(MAX2),
     1 ICONN(60,16),N,NCONN,NATTCH,ITYPE(MAX1),NJOIN,IJOIN(MAX2,2),
     2 NBREAK,IBREAK(MAX2,2),MATCONN(MAX1,MAX1)

C   ---   Determine attached atoms; store in JATTCH & KATTCH

      NATTCH=0
      DO I=1,N
         NBONDS=0
         DO J=1,N
            IF (MATCONN(I,J).NE.0) THEN
               NBONDS=NBONDS+1
               JBOND=J
            ENDIF
         ENDDO
         IF (NBONDS.EQ.1) THEN
            NATTCH=NATTCH+1
            KATTCH(NATTCH)=I
            JATTCH(NATTCH)=JBOND
         ENDIF
      ENDDO
      DO I=1,NATTCH
         MATCONN(JATTCH(I),KATTCH(I))=0
         MATCONN(KATTCH(I),JATTCH(I))=0
      ENDDO

C   ---   Determine endpoints of connected atom set; store in IEND

      NEND=0
      DO I=1,N
         NBONDS=0
         DO J=1,N
            IF (MATCONN(I,J).NE.0) NBONDS=NBONDS+1
         ENDDO
         IF (NBONDS.EQ.1) THEN
            NEND=NEND+1
            IEND(NEND)=I
         ENDIF
      ENDDO

C   ---   Determine the connected sets starting from an endpoint      

      NCONN=0
      DO I=1,NEND
         K=IEND(I)
         DO J=1,N
            IF (MATCONN(K,J).EQ.1) GOTO 10
         ENDDO
         GOTO 40
C          (start next set)
10       CONTINUE
         NCONN=NCONN+1
         ICONN(NCONN,1)=K
         ICONN(NCONN,2)=J
         NCONN2=2
         MATCONN(K,J)=0
         MATCONN(J,K)=0
20       CONTINUE
         K=J
         DO J=1,N
            IF (MATCONN(K,J).EQ.1) GOTO 30
         ENDDO
         GOTO 40
C          (start next set)
30       CONTINUE
         NCONN2=NCONN2+1
         ICONN(NCONN,NCONN2)=J
         MATCONN(K,J)=0
         MATCONN(J,K)=0
         IF (NCONN2.EQ.16) THEN
            NCONN=NCONN+1
            NCONN2=1
            ICONN(NCONN,1)=ICONN(NCONN-1,16)
         ENDIF
         GOTO 20
40       CONTINUE
      ENDDO

C   ---   Determine the connected sets starting from left over points
C         in the connectivity matrix

      DO I=1,N
         K=I
         DO J=1,N
            IF (MATCONN(K,J).EQ.1) GOTO 50
         ENDDO
         GOTO 80
C          (start next set)
50       CONTINUE
         NCONN=NCONN+1
         ICONN(NCONN,1)=K
         ICONN(NCONN,2)=J
         NCONN2=2
         MATCONN(K,J)=0
         MATCONN(J,K)=0
60       CONTINUE
         K=J
         DO J=1,N
            IF (MATCONN(K,J).EQ.1) GOTO 70
         ENDDO
         GOTO 80
C          (start next set)
70       CONTINUE
         NCONN2=NCONN2+1
         ICONN(NCONN,NCONN2)=J
         MATCONN(K,J)=0
         MATCONN(J,K)=0
         IF (NCONN2.EQ.16) THEN
            NCONN=NCONN+1
            NCONN2=1
            ICONN(NCONN,1)=ICONN(NCONN-1,16)
         ENDIF
         GOTO 60
80       CONTINUE
      ENDDO

      RETURN
      END

      SUBROUTINE CARTH(A,B,C,ALPHA,BETA,GAMMA)
C
C     Orthogonalise fractional coordinates. X axis along a; Y axis in plane 
C     ab, Z axis perpendicular a and b.
C
      PARAMETER MAX1=350,MAX2=700
      DIMENSION CMATR(3,3)
      COMMON /C/ ATOM(MAX1,3),JATTCH(MAX2),KATTCH(MAX2),
     1 ICONN(60,16),N,NCONN,NATTCH,ITYPE(MAX1),NJOIN,IJOIN(MAX2,2),
     2 NBREAK,IBREAK(MAX2,2),MATCONN(MAX1,MAX1)
      CMATR(1,1)=A
      CMATR(1,2)=B*COSD(GAMMA)
      CMATR(1,3)=C*COSD(BETA)
      CMATR(2,1)=0.
      CMATR(2,2)=B*SIND(GAMMA)
      CMATR(2,3)=C*(COSD(ALPHA)-COSD(BETA)*COSD(GAMMA))/SIND(GAMMA)
      CMATR(3,1)=0.
      CMATR(3,2)=0.
      CMATR(3,3)=(C/SIND(GAMMA))*SQRT(1-COSD(ALPHA)*COSD(ALPHA)
     1 -COSD(BETA)*COSD(BETA)-COSD(GAMMA)*COSD(GAMMA)+2*COSD(ALPHA)
     2 *COSD(BETA)*COSD(GAMMA))
      DO I=1,N
         XNEW=CMATR(1,1)*ATOM(I,1)+CMATR(1,2)*ATOM(I,2)+
     1    CMATR(1,3)*ATOM(I,3)
         YNEW=CMATR(2,1)*ATOM(I,1)+CMATR(2,2)*ATOM(I,2)+
     1    CMATR(2,3)*ATOM(I,3)
         ZNEW=CMATR(3,1)*ATOM(I,1)+CMATR(3,2)*ATOM(I,2)+
     1    CMATR(3,3)*ATOM(I,3)
         ATOM(I,1)=XNEW
         ATOM(I,2)=YNEW
         ATOM(I,3)=ZNEW
      ENDDO
      RETURN
      END


      SUBROUTINE FINDNUM(LABEL,ATNUM,IERR)
C
C     Find the atom number corresponding to atomlabel 'LABEL'
C
      PARAMETER MAX1=350,MAX2=700
      CHARACTER*8 LABEL,ATLAB(MAX1)
      INTEGER ATNUM
      COMMON /C/ ATOM(MAX1,3),JATTCH(MAX2),KATTCH(MAX2),
     1 ICONN(60,16),N,NCONN,NATTCH,ITYPE(MAX1),NJOIN,IJOIN(MAX2,2),
     2 NBREAK,IBREAK(MAX2,2),MATCONN(MAX1,MAX1)
      COMMON /LAB/ ATLAB
      IERR=0
      I1=0
10    CONTINUE
      I1=I1+1
      IF(ATLAB(I1).EQ.LABEL) THEN
         ATNUM=I1
         GOTO 20
      ENDIF
      IF (I1.EQ.N) THEN
         IERR=1
         RETURN
      ENDIF
      GOTO 10
20    CONTINUE
      RETURN
      END


      SUBROUTINE ADDATOM(INEW,DIST,I1,THETA,I2,TAU,I3)
C
C     Add an atom to the existing structure. First place i1 on the
C     origin; i2 on x axis; i3 in xy plane. Then add atom and transform 
C     back to original position. One translation and three matrix 
C     rotations are involved
C
      PARAMETER MAX1=350,MAX2=700
      DIMENSION MATRIX1(3,3),MATRIX2(3,3),MATRIX3(3,3)
      REAL MATRIX1,MATRIX2,MATRIX3
      COMMON /C/ ATOM(MAX1,3),JATTCH(MAX2),KATTCH(MAX2),
     1 ICONN(60,16),N,NCONN,NATTCH,ITYPE(MAX1),NJOIN,IJOIN(MAX2,2),
     2 NBREAK,IBREAK(MAX2,2),MATCONN(MAX1,MAX1)
      DATA MATRIX1(1,3),MATRIX1(2,3),MATRIX1(3,1),MATRIX1(3,2),
     1 MATRIX1(3,3),MATRIX2(1,2),MATRIX2(2,1),MATRIX2(2,2),
     2 MATRIX2(2,3),MATRIX2(3,2),MATRIX3(1,1),MATRIX3(1,2),
     3 MATRIX3(1,3),MATRIX3(2,1),MATRIX3(3,1)
     4 /0.,0.,0.,0.,1.,0.,0.,1.,0.,0.,1.,0.,0.,0.,0./
      X1=ATOM(I2,1)-ATOM(I1,1)
      Y1=ATOM(I2,2)-ATOM(I1,2)
      Z1=ATOM(I2,3)-ATOM(I1,3)
      W1=SQRT(X1*X1+Y1*Y1)
      T1=SQRT(X1*X1+Y1*Y1+Z1*Z1)
      MATRIX1(1,1)=X1/W1
      MATRIX1(1,2)=Y1/W1
      MATRIX1(2,1)=-Y1/W1
      MATRIX1(2,2)=X1/W1
      MATRIX2(1,1)=W1/T1
      MATRIX2(1,3)=Z1/T1
      MATRIX2(3,1)=-Z1/T1
      MATRIX2(3,3)=W1/T1
      X2=ATOM(I3,1)-ATOM(I1,1)
      Y2=ATOM(I3,2)-ATOM(I1,2)
      Z2=ATOM(I3,3)-ATOM(I1,3)
      CALL MATPROD(MATRIX1,X2,Y2,Z2,SCR1,SCR2,SCR3)
      CALL MATPROD(MATRIX2,SCR1,SCR2,SCR3,X2,Y2,Z2)
      W2=SQRT(Y2*Y2+Z2*Z2)
      T2=SQRT(X2*X2+Y2*Y2+Z2*Z2)
      MATRIX1(1,2)=-MATRIX1(1,2)
      MATRIX1(2,1)=-MATRIX1(2,1)
      MATRIX2(1,3)=-MATRIX2(1,3)
      MATRIX2(3,1)=-MATRIX2(3,1)
      MATRIX3(2,2)=Y2/W2
      MATRIX3(2,3)=-Z2/W2
      MATRIX3(3,2)=Z2/W2
      MATRIX3(3,3)=Y2/W2
      XNEW=DIST*COSD(THETA)
      YNEW=DIST*SIND(THETA)*COSD(TAU)
      ZNEW=-DIST*SIND(THETA)*SIND(TAU)
      CALL MATPROD(MATRIX3,XNEW,YNEW,ZNEW,SCR1,SCR2,SCR3)
      CALL MATPROD(MATRIX2,SCR1,SCR2,SCR3,XNEW,YNEW,ZNEW)
      CALL MATPROD(MATRIX1,XNEW,YNEW,ZNEW,SCR1,SCR2,SCR3)
      ATOM(INEW,1)=SCR1+ATOM(I1,1)
      ATOM(INEW,2)=SCR2+ATOM(I1,2)
      ATOM(INEW,3)=SCR3+ATOM(I1,3)
      RETURN
      END



      SUBROUTINE MATPROD(MATRIX,XIN,YIN,ZIN,XOUT,YOUT,ZOUT)
      REAL MATRIX(3,3)
      XOUT=XIN*MATRIX(1,1)+YIN*MATRIX(1,2)+ZIN*MATRIX(1,3)
      YOUT=XIN*MATRIX(2,1)+YIN*MATRIX(2,2)+ZIN*MATRIX(2,3)
      ZOUT=XIN*MATRIX(3,1)+YIN*MATRIX(3,2)+ZIN*MATRIX(3,3)
      RETURN
      END
      


      SUBROUTINE READ(LINE,WORD,NWORD)
      CHARACTER*80 WORD(80),LINE
      CHARACTER*1 LETTER
      DO I=1,80
         WORD(I)=' '
      ENDDO
      NWORD=0
10    CONTINUE
      READ (1,'(A)',END=20) LINE
      CALL UPCASE(LINE,LINE)
      IF (LENGTH(LINE).EQ.0) GOTO 10
      IP=1
      DO I=1,80
        LETTER=LINE(I:I)
        IF (LETTER.NE.' ') THEN
          IF (LETTER.EQ.'-') IP=1
          IF(IP.EQ.1) NWORD=NWORD+1
          WORD(NWORD)(IP:IP) = LETTER
          IP=IP+1
        ELSE
         IP=1
        ENDIF
      ENDDO
      IF (WORD(NWORD).EQ.'=') THEN
         NWORD=NWORD-1
         GOTO 10
      ENDIF
      RETURN
20    CONTINUE
      WORD(1)='END'
      RETURN
      END
