SUBROUTINE MMIOUT( FILMMI )
      INCLUDE 'SIZES'
C
C SUBROUTINE FOR DRAW PROGRAM TO OUTPUT A FILE FOR MMI (OR MMII) 
C
      IMPLICIT REAL (A-H,O-Z)
      INTEGER*2 HFORM, ATBOND
      CHARACTER*80 VNAME, FILMMI
      CHARACTER*80 KEYWRD,KOMENT,TITLE,COMAND
      CHARACTER*60 MMITL
      CHARACTER*6 ATSYMB
      LOGICAL ERROR
      COMMON /KEYS/ KEYWRD,KOMENT,TITLE
      COMMON /ATSYMB/ ATSYMB( 200)
      COMMON /ATOMS/ CO(3, NUMATM),IE( NUMATM),NATOMS, ATCHG( NUMATM)
      COMMON /GEOM/ COOLD(3, NUMATM),NA( NUMATM),NB( NUMATM),NC( NUMATM)
      COMMON /DISPLY/ IREM(200), BSCALE, ATBOND( NUMATM, NUMATM),
     .                ISTYPE, LBTYPE, IMASK( NUMATM), ISCOLO
      LOGICAL DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI
      COMMON /DEBCOM/ DEBUG, DEBUGL, DEBUGN, DEBUGO, DEBUGP, DEBUGI
C
      DIMENSION IBONDS( NUMATM,10),IKIND( NUMATM),IATTCH( NUMATM),
     .        ICONN(20,16)
C
C DATABASE UNIQUE TO THIS ROUTINE:
C
C  IBONDS   IS NOT UNIQUE, IT IS USED THE SAME AS IN ROUTINE "LINEBOND"
C  IKIND    HOLDS THE TYPE OF ATOM AS IN MMI - VALENCE AND ATOM TYPE
C  IATCH    PAIRS OF ATTACHED ATOMS.  THESE ARE ATOMS ATTACHED TO ONLY
C             ONE ATOM.
C  ICONN    HOLDS 20 LISTS OF 16 CONNECTED ATOMS.  THESE ARE "CHAINS"
C             OF ATOMS WHICH MAKE-UP THE SKELETON OF THE MOLECULE.
C
C ********************************************************************
C
C  ALGORITHM:
C   1) PRIMARY CONCERN IS TO EVALUATE MOLECULE WRT CAPABILITIES OF MMI
C      - MMI CAN ONLY HANDLE 100 ATOMS
C      - MMI CAN HANDLE ONLY 20 LISTS OF 16 CONNECTED ATOMS
C      - MMI CAN HANDLE ONLY 100 ATTACHED ATOMS
C      - MMI ONLY KNOWS ABOUT CERTAIN BONDING ARRANGEMENTS
C   2) FIRST WE WILL FILL THE BONDING ARRAY.  THIS LOGIC IS PIRATED
C      FROM MY LINEBOND ROUTINE. THIS WILL ALLOW US TO EVALUATE "IKIND"
C   3) USING THE IBOND ARRAY, WE WILL REMOVE ALL ATTACHED ATOMS.  THESE
C      WILL BE FOUND BY SEARCHING FOR ALL ATOMS WITH ONLY ONE BOND IN
C      LOCATION IBONDS(I,10).  AT THE SAME TIME WE WILL LOOK FOR 
C      HYDROGENS WHICH ARE MULTIPLY BONDED OR ANY NON-BONDED ATOMS.
C      THE USER WILL BE PROMPTED FOR ASSISTANCE FOR THESE OCCURRENCES.
C   4) NEXT THE REMAINING ATOMS IN IBOND WILL BE EXTRACTED FOR "ICONN"
C      AS EACH ATOM IS USED, IT WILL BE REMOVED FROM THE ARRAY.  THERE
C      IS A LIMIT OF 16 CONNECTED ATOMS PER LIST.  IF A TRAIL OF ATOMS
C      EXCEEDS 16, A NEW CONNECTION LIST WILL BE STARTED WITH THE FIRST
C      ATOM BEING THE LAST ONE OF THE PREVIOUS LIST.
C      AS EACH ATOM IS ADDED, THE LIST MUST BE EXAMINED FOR RINGS. 
C      THESE WILL BE RECOGNIZED BY DUPLICATING AN ATOM IN THE LIST.
C      A RING WILL TERMINATE A LIST.  ALSO KEEP COUNT OF ALL LISTS BY
C      SIZE AND ICONN NUMBER.  THESE WILL BE USED LATER.
C   5) AT END CREATE OUTPUT FILE.  THE USER MAY BE PROMPTED FOR THE
C      TEXT OF THE NAME ON CARD 1.  THE DEFAULT SHOULD BE THE FIRST
C      60 COLUMNS OF INPUT LINE 2 OR 3 FORM THE .DAT FILE.
C
C *******************************************************************
*******************
* LOCAT FUNCTION DEFINITION
      ATDIST(I,J) = SQRT((CO(1,I)-CO(1,J))**2+
     .          (CO(2,I)-CO(2,J))**2+
     .          (CO(3,I)-CO(3,J))**2)
*******************
      MAXBON=9
C
C CLEAR BOND ARRAY
C
      DO 5 I=1,100
      IKIND(I)=0
      IATTCH(I)=0
 5    IBONDS(I,10) = 0
C
      DO 6 I=1,20
      DO 6 J=1,16
 6    ICONN(I,J)=0
C
C  CREATE BONDS
C
      DO 20 I= 1, NATOMS
         DO 20 J= I, NATOMS
            IF (J .EQ. I ) GO TO 20
c?            D = ATDIST( I, J)
c?            RADII = VRADII( IE( I))+VRADII( IE( J)) * BSCALE
c?            IF (D .LE. RADII) THEN
            IF ( ATBOND( I, J) .NE. 0 ) THEN
               NOBOND = IBONDS(J,10) + 1
               IF (NOBOND .GT. MAXBON) THEN
                   CALL PLOT(0,0,8)
                   WRITE (*,*) 'MMIOUT: EXCESSIVE BONDS:1'
                   CALL PLOT (0,0,9)
               ELSE
                   IBONDS(J,NOBOND) = I
                   IBONDS(J,10) = NOBOND
               ENDIF
               NOBOND = IBONDS(I,10) + 1
               IF (NOBOND .GT. MAXBON ) THEN
                   CALL PLOT(0,0,8)
                   WRITE (*,*) 'MMIOUT: EXCESSIVE BONDS:2'
                   CALL PLOT (0,0,9)
               ELSE
                   IBONDS(I,NOBOND) = J
                   IBONDS(I,10) = NOBOND
               ENDIF
            ENDIF
 20   CONTINUE
C
C NOW TO DETERMINE THE ATOM TYPE
C
C TYPES ARE: (FOR MMI)
C  C  SP3     1
C  C  SP2 (ALKENE)  2
C  C  SP2 (CARBONYL)  3
C  C  SP              4
C  H                  5
C  O    -O-           6
C  O     =O           7
C  N    SP3           8
C  N    SP2           9
C  N    SP           10
C  F                 11
C  Cl                12
C  Br                13
C  I                 14
C  S    -S-          15
C  S   SULFONIUM     16
C  S   SULFOXIDE     17
C  S   SULFONE       18
C  Si                19
C  LP  LONE PAIR     20
C  H    O-H AND N-H  21
C  C   CYCLOPROPANE  22
C
      DO 30 I=1,NATOMS
         IF (IBONDS(I,10) .EQ. 0) THEN
            WRITE (*,*) 'ATOM',I,' IS NOT BONDED.'
            GO TO 30
         ENDIF
         IAT = IE(I)
         IF (IAT .EQ. 1) THEN
            IF (IBONDS(I,10) .GT. 1) THEN
               WRITE (*,*) 'HYDROGEN',I,' IS MULTIPLY BONDED.'
               GO TO 40
            ELSE
               IN=IBONDS(I,1)
               IKIND(I) = 5
               IF (IE(IN) .EQ. 7 .OR. IE(IN) .EQ. 8) IKIND(I)=21
            ENDIF
         ELSEIF (IAT .EQ. 6 ) THEN
            IF (IBONDS(I,10) .GT. 4) THEN
               WRITE (*,*) 'CARBON',I,' HAS',IBONDS(I,10),' BONDS.'
               GO TO 40
            ELSEIF (IBONDS(I,10) .EQ. 4) THEN
               IKIND(I) = 1
            ELSEIF (IBONDS(I,10) .EQ. 3) THEN
               IKIND(I)=2
               DO 32 J=1,IBONDS(I,10)
                  IN=IBONDS(I,J)
                  IF (IE(IN) .EQ. 8) THEN
                     IF (IBONDS(IN,10) .EQ. 1) IKIND(I)=3
                  ENDIF
  32            CONTINUE
             ELSEIF (IBONDS(I,10) .EQ. 2) THEN
                IKIND(I)=4
             ENDIF
          ELSEIF (IAT .EQ. 8) THEN
             IF (IBONDS(I,10) .GT. 2) THEN
                WRITE (*,*) 'OXYGEN',I,' HAS',IBONDS(I,10),' BONDS.'
                GO TO 40
             ELSEIF (IBONDS(I,10) .EQ. 2) THEN
                IKIND(I)=6
             ELSEIF (IBONDS(I,10) .EQ. 1) THEN
                IKIND(I)=7
             ENDIF
          ELSEIF (IAT .EQ. 7) THEN
             IF (IBONDS(I,10) .GT. 4) THEN
                WRITE (*,*) 'NITROGEN',I,' HAS',IBONDS(I,10),' BONDS.'
                GO TO 40
             ELSEIF (IBONDS(I,10) .EQ. 4) THEN
                IKIND(I) = 8
             ELSEIF (IBONDS(I,10) .EQ. 3) THEN
                IKIND(I) = 8
             ELSEIF (IBONDS(I,10) .EQ. 2) THEN
                IKIND(I) = 9
             ELSEIF (IBONDS(I,10) .EQ. 1) THEN
                IKIND(I) = 10
             ENDIF
          ELSEIF (IAT .EQ. 9) THEN
             IF (IBONDS(I,10) .GT. 1) THEN
                WRITE (*,*) 'FLUORINE',I,' HAS',IBONDS(I,10),' BONDS.'
                GO TO 40
             ELSE
                IKIND(I) = 11
             ENDIF
          ELSEIF (IAT .EQ. 17) THEN
             IF (IBONDS(I,10) .GT. 1) THEN
                WRITE (*,*) 'CHLORINE',I,' HAS',IBONDS(I,10),' BONDS.'
                GO TO 40
             ELSE
                IKIND(I) = 12
             ENDIF
          ELSEIF (IAT .EQ. 35) THEN
             IF (IBONDS(I,10) .GT. 1) THEN
                WRITE (*,*) 'BROMINE',I,' HAS',IBONDS(I,10),' BONDS.'
                GO TO 40
             ELSE
                IKIND(I) = 13
             ENDIF
          ELSEIF (IAT .EQ. 53) THEN
             IF (IBONDS(I,10) .GT. 1) THEN
                WRITE (*,*) 'IODINE',I,' HAS',IBONDS(I,10),' BONDS.'
                GO TO 40
             ELSE
                IKIND(I) = 14
             ENDIF
          ELSEIF (IAT .EQ. 19) THEN
             IF (IBONDS(I,10) .GT. 1) THEN
                WRITE (*,*) 'SILICON',I,' HAS',IBONDS(I,10),' BONDS.'
                GO TO 40
             ELSE
                IKIND(I) = 19
             ENDIF
          ELSE
             WRITE (*,9005) I,ATSYMB(IE(I)),IBONDS(I,10)
 9005        FORMAT (1X,'ATOM ',I3,':',A2,' WITH ',I2,' BONDS IS NOT',
     .        ' PERMITTED IN MMI.')
          ENDIF
 30   CONTINUE
C
C DEBUGGING
C
 40   CONTINUE
      IF (DEBUG) THEN
         DO 21 I=1,NATOMS
            WRITE (*,9000) I,ATSYMB(IE(I)),(IBONDS(I,J),J=1,10),
     .          IKIND(I)
9000        FORMAT (1X,I3,':',A2,2X,10I4,5X,I2)
 21      CONTINUE
      ENDIF
C
C ATTACHED ATOMS ARE ATOMS WITH ONLY ONE BOND
C
      NATTCH = 0
      DO 50 I= 1, NATOMS
         IF ( IBONDS( I, 10) .EQ. 1) THEN
            NATTCH = NATTCH + 1
            IF ( NATTCH .GT. 100) THEN
               WRITE (*,*) 'TOO MAYN ATTACHED ATOMS, 100 MAX.'
               GO TO 55
            ENDIF
            IATTCH( NATTCH) = IBONDS(I,1)*1000 + I
            IBONDS( I, 10) = 0
            INB = IBONDS( I, 1)
            NBOND = IBONDS( INB, 10)
            KB = 0
            DO 45 J= 1, NBOND
               IF ( IBONDS( INB, J) .EQ. I) GO TO 45
               KB = KB + 1
               IBONDS( INB, KB) = IBONDS( INB, J)
  45        CONTINUE
            IBONDS( INB, 10) = NBOND - 1
      ENDIF
 50   CONTINUE
C
C DEBUGGING
C
 55   CONTINUE
      IF (DEBUG) THEN
         WRITE (*,*) 'ATTACHED ATOMS:'
         DO 57 I=1, NATTCH,8
            WRITE (*,9010) (IATTCH(J),J=I,I+7)
 9010       FORMAT ( 1X, 8I9)
 57      CONTINUE
      ENDIF
C
C CONNECTED ATOMS
C
      NLIST = 0
C       THIS IS RETURN POINT FOR NEXT CHAIN
 61   CONTINUE
      NSUB=1
      NLIST=NLIST+1
      IF ( NLIST .GT. 20) THEN
         WRITE (*,*) 'MAXLIST EXCEEDED.'
         GO TO 80
      ENDIF
      MAXCON=10
      MAXATM=0
      DO 62 I= 1, NATOMS
         KB=IBONDS(I,10)
         IF ( KB .LT. 1 ) GO TO 62
         IF ( KB .GE. MAXCON) GO TO 62
         MAXCON= KB
         MAXATM= I
 62   CONTINUE
      IF (MAXCON .GE. 10 ) GO TO 80
      NATM = MAXATM
      IF (DEBUG) WRITE (*,*) 'NEW CHAIN Nr.',NLIST,' w ATOM',NATM
      ICONN(NLIST,NSUB)=NATM
      GO TO 67
C
C  LOOP FOR BUILDING CONNECTION LISTS
C
 64   CONTINUE
      NSUB=NSUB+1
      IF (NSUB .GT. 16) THEN
         NSUB=1
         NLIST=NLIST+1
         IF (NLIST .GT. 20) THEN
            WRITE (*,*) 'TOO MANY LISTS, 20 MAX.'
            GO TO 80
         ENDIF
         ICONN(NLIST,NSUB)=ICONN(NLIST-1,16)
         NSUB=NSUB+1
      ENDIF
C
C  INSTALL THIS ATOM
C
      ICONN(NLIST,NSUB)=NATM
C
C CHECK FOR RINGS
C
      DO 65 I=1, NSUB-1
         IF (ICONN(NLIST,I) .EQ. NATM) THEN
            IF (NLIST .GT. 19) THEN
               WRITE (*,*) 'TOO MANY LISTS, MAX IS 20.'
               GO TO 80
            ENDIF
            ICONN(NLIST+1,1)=ICONN(NLIST,NSUB)
            NSUB=1
            GO TO 61
         ENDIF
 65   CONTINUE
C
C NOW PICK THE NEXT ATOM
C
C  IF THIS IS THE SECOND OR THIRD ATOM, PICK THE MOST CONNECTED ONE
C     FOR 4 AND ON, PICK THE ONES WITH DIHEDRAL < 180
C  ABOVE ALL, WE WILL TRY TO CLOSE THE RING
C
 67   CONTINUE
      DO 68 I=1, IBONDS( NATM, 10)
      DO 68 J= 1, NSUB-1
         MAXATM = IBONDS( NATM, I)
         IF ( MAXATM .EQ. ICONN(NLIST, J) ) GO TO 73
 68   CONTINUE
      MAXCON=0
      MAXATM=0
      IF ( NSUB .LT. 4) THEN
         DO 70 I=1,IBONDS(NATM,10)
            MATM=IBONDS(NATM,I)
            IF (IBONDS(MATM,10) .LE. MAXCON) GO TO 70
            MAXCON=IBONDS(MATM,10)
            MAXATM=MATM
 70      CONTINUE
         IF (MAXCON .LT. 1) GO TO 61
      ELSE
         IMM=ICONN(NLIST, NSUB-3)
         JMM=ICONN(NLIST, NSUB-2)
         ANGMIN = 370.0D0
         DO 72 I=1,IBONDS(NATM,10)
            MATM=IBONDS(NATM,I)
            IF (IBONDS(MATM,10) .GT. 1) THEN
               CALL DIHED( IMM, JMM, NATM, MATM, ANGLE)
               IF ( ANGLE .GT. ANGMIN ) GO TO 72
               ANGMIN = ANGLE
               MAXATM = MATM
            ENDIF
 72      CONTINUE
      ENDIF
C
 73   CONTINUE
      IATM=MAXATM
C
C NOW UNBOND THIS ATOM FROM ITS NEIGHBOR
C
      KB=0
      DO 75 I=1,IBONDS(NATM,10)
         IF (IBONDS(NATM,I) .EQ. IATM) GO TO 75
            KB=KB+1
            IBONDS(NATM,KB)=IBONDS(NATM,I)
 75   CONTINUE
      IBONDS(NATM,10)= KB
C
C AND NOW UNBOND THE NEIGHBOR FROM THIS ATOM
C
      KB=0
      DO 76 I=1,IBONDS(IATM,10)
         IF (IBONDS(IATM,I) .EQ. NATM) GO TO 76
            KB=KB+1
            IBONDS(IATM,KB)=IBONDS(IATM,I)
 76   CONTINUE
      IBONDS(IATM,10)= KB
C
      NATM=IATM
      GO TO 64
C
 80   CONTINUE
      NLIST=NLIST-1
      IF (DEBUG) THEN
         DO 86 I=1,NLIST
            DO 84 J=1,16
               IF (ICONN(I,J) .EQ. 0) GO TO 85
 84         CONTINUE
C
 85         WRITE (*,1040) (ICONN(I,JJ),JJ=1,J-1)
 1040       FORMAT (1X,16I4 )
 86      CONTINUE
      ENDIF
C
C NOW TO CREATE THE MMI FILE
C
      MMITL=TITLE(:60)
      WRITE (*,9050) 'Enter 60 char ID STRING [default is] '
      WRITE (*,9050) MMITL
 9050 FORMAT ( 1X, A )
      READ (*,1000) COMAND
 1000 FORMAT ( A )
      IF (COMAND(:1) .NE. ' ') MMITL=COMAND(:60)
      TMAX=5.0
      CALL UPROMP( 'What CPU time limit [def 5.0 min] ? ')
      READ (*,1000) COMAND
      IF (COMAND(:1) .NE. ' ') THEN
         TMAX=READA(COMAND,1,ERROR)
         IF (ERROR) THEN
            WRITE (*,*) 'ERROR, DEFAULT ASSUMED.'
            TMAX=5.0
         ENDIF
      ENDIF
C
      NRSTR=0
      INIT=0
      NCONST=0
      OPEN (UNIT=2,FILE=FILMMI,STATUS='NEW', ERR=8000)
      REWIND 2
      WRITE (2,9100) MMITL,NATOMS,NRSTR,INIT,NCONST,TMAX
 9100 FORMAT ( A60, I5, I3, I2, I3, F5.0 )
      NSYMM=0
      NX=0
      NROT=1
      LABEL=0
      NDC=2
      NCALC=0
      HFORM=0
      NCYCLO=0
      MVDW=0
      NDRIVE=0
      WRITE (2,9110) NLIST,NATTCH,NSYMM,NX,NROT,LABEL,NDC,NCALC,HFORM,
     .               NCYCLO,MVDW,NDRIVE
 9110 FORMAT ( I5, 20X, 11I5 )
      DO 90 I=1, NLIST
         WRITE (2,9020) (ICONN(I,J),J=1,16)
 9020    FORMAT ( 16I5 )
 90   CONTINUE
      DO 93 I=1, NATTCH,8
         WRITE ( 2, 9020) (IATTCH(J)/1000,IATTCH(J)-IATTCH(J)/1000*
     .     1000,J=I,I+7)
 93   CONTINUE
      DO 95 I=1, NATOMS,2
         WRITE ( 2, 9130) ((CO(J,K),J=1,3),IKIND(K),K=I,I+1)
 9130    FORMAT ( 2(3F10.5,I5,5X) )
 95   CONTINUE
      CLOSE (UNIT=2)
      WRITE (*,*) 'MMI output in file '//FILMMI(:INDEX(FILMMI,' '))
C
 900  RETURN
C
 8000 WRITE (*,*) 'I CANNOT OPEN FILE '//FILMMI(:INDEX(FILMMI,' '))
      GO TO 900
C
      END