










C

C
      SUBROUTINE USEDD1



























      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       ISOUP, OLD1504, IAA, IERR, IAT, INDAA3
      LOGICAL       GVFISF, FIRSTWARN, WIFIR6, WIFIRO, WIFIR4, WIFIRH,
     +              GVFFOP, GOTFILE
      SAVE          OLD1504, FIRSTWARN
      DATA OLD1504  /-1/
      DATA FIRSTWARN  /.FALSE./







      CALL GVSCCC (LINE,FILDIR(10),'?M4565')
      IF (.NOT.GVFISF(LINE)) THEN
         IF (.NOT.FIRSTWARN) THEN
            CALL GVSTT6 ('?M3627')
            CALL GVST6C ('?M4563',LINE,.TRUE.)
            FIRSTWARN=.TRUE.
         END IF
         WIFPAR(1052)=0
      END IF



      IF (WIFPAR(1012).EQ.1) THEN
         IF (GVFFOP(DAVBUG)) THEN
            CALL GVSTTU (DAVBUG,'USEDD1 found an existing file')
            CALL GVSTUM (DAVBUG)
         ELSE
            IF (GVFISF('DAVABUG.LOG')) CALL GVSDEL ('DAVABUG.LOG')
            IF (.NOT.GOTFILE(DAVBUG,'DAVABUG.LOG')) GOTO 999
            CALL GVSTTU (DAVBUG,'USEDD1 made a fresh file')
            CALL GVSTUM (DAVBUG)
         END IF
      END IF




      IF (WIFPAR(1247).GT.0) THEN
         CALL GVSTUI (DAVBUG,'?M4564',WIFPAR(1247))
         CALL GVSTTI ('?M4564',WIFPAR(1247))
         GOTO 998
      END IF
      WIFPAR(1247)=1
      WIFPAR(75)=1



      IF (NUMCOF.LE.0) THEN
         CALL GVSTTU (DAVBUG,'No drugs found in soup')
         GOTO 998
      END IF




      IF (WIFPAR(269).EQ.1) THEN
         CALL GVSTTU (DAVBUG,'No action required because of flag 269')
         GOTO 998
      END IF



      IF (OLD1504.EQ.WIFPAR(1504)) THEN
         CALL GVSTTU (DAVBUG,'No action required because of flag 1504')
         GOTO 998
      END IF









      CALL GVSDEL ('?M4566')
      CALL GVSDEL ('?M4566A')
      CALL GVSDEL ('?M4566B')
      WIFPAR(360)=0



      CALL USED10




 10   CONTINUE
         CALL USEDD7 (ISOUP)
         IF (ISOUP.LE.0) GOTO 20
         CALL PRP203 (SOUADM(1,ISOUP),'?M4830')
         CALL WIFPUSHPPP (281,1)
         CALL WIFPUSHPPP (332,1)
         WIFPAR(360)=MOD(WIFPAR(360)+1,36)
         CALL USED17 (ISOUP)
         CALL USEDD2 (ISOUP,IERR)
         CALL WIFPOPPPP (332)
         CALL WIFPOPPPP (281)
         CALL PRP206 ('?M4831')
      GOTO 10
 20   CONTINUE



      CALL USED11



      IF (WIFPAR(279).GE.1) GOTO 998
      DO 100 IAA=NUMAAF+1,NUMAAT
         IF (WIFIRO(IAA)) GOTO 100
         IF (WIFIR4(IAA)) GOTO 100
         IF (WIFIRH(IAA)) GOTO 100
         IF (RESTYP(IAA).LE.0) THEN
            RESTYP(IAA)=INDAA3(ONESA3(IAA))
         END IF
         IF (.NOT.WIFIR6(IAA)) GOTO 100



         DO 12 IAT=PNTAAS(IAA),PNTAAE(IAA)
            IF (PROTON(IAT)) THEN
               XCOORD(IAT)=0.0
               YCOORD(IAT)=0.0
               ZCOORD(IAT)=0.0
               ISATOK(IAT)=.FALSE.
            END IF
 12      CONTINUE





         DO 90 IAT=PNTAAS(IAA),PNTAAE(IAA)
            IF (PROTON(IAT)) GOTO 90
            IF (.NOT.ISATOK(IAT)) GOTO 90
            CALL HAS011 (IAT)
   90    CONTINUE
  100 CONTINUE
      GOTO 998



  999 CONTINUE
      CALL GVSEIW ('USEDD1')



  998 CONTINUE
      OLD1504=WIFPAR(1504)
      WIFPAR(75)=0
      WIFPAR(1247)=0

      
      RETURN
      END 
      SUBROUTINE USEDD2 (ISOUP,IERR)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'DATBAS.INC'
      INTEGER       ISOUP, IAA, IERR, I, IAT
      LOGICAL       SKIP, DR, CH4EQCH4, BNDMEM
      CHARACTER*1   CHAMEM
      CHARACTER*4   CHAR4







      CALL PRP210 (IERR)



      DR=IERR.EQ.0
      CALL GVSSTX (CHAR4,ONESA3(SOUADM(1,ISOUP)))



      IAA=SOUADM(1,ISOUP)
      IF (WIFPAR(156).EQ.0) THEN
         IF (WIFPAR(642).EQ.0.AND.WIFPAR(363).EQ.0) CALL DIF008A 
     +    (6,IAA,'?M4878')
         IF (DR) CALL DIF008A (DATLOG,IAA,'?M4878')
      END IF
      IF (SOUADM(10,ISOUP).GE.1) THEN
         IF (WIFPAR(156).EQ.0) CALL GVSTT6 ('?M4879')
         GOTO 998
      END IF



      CALL USEDD4 (ISOUP,SKIP)
      IF (SKIP) THEN
         SOUADM(10,ISOUP)=0
         CALL MOL012 (ISOUP)
         SOUADM(10,ISOUP)=1
         GOTO 998
      END IF



      IERR=0



      CALL PRP203 (SOUADM(1,ISOUP),'?M4832')
      CALL WIFPUSHPPP (168,1)
      CHAMEM=CHANAM(SOUADM(1,ISOUP))
      CALL USEDD3 (ISOUP,IERR)
      CALL WIFPOPPPP (168)
      IF (IERR.NE.0) THEN
         IF (WIFPAR(156).EQ.0) THEN
            CALL DIF008A (6,IAA,'?M4880')
            IF (DR) CALL DIF008A (DATLOG,IAA,'?M4880')
         END IF
         GOTO 998
      END IF



      BNDMEM=NOBOND(SOUADM(1,ISOUP))
      NOBOND(SOUADM(1,ISOUP))=.TRUE.
      CALL MOL101A (ISOUP)
      CALL MOL200
      CALL PRP202 ('?M4834')
      CALL KLONKSTART (IERR)
      CALL KLONKUP
      CALL KLONKSET (WIFPAR(491),0,IERR)
      CALL USED15 (CHAMEM)
      CALL KLONKDOWN
      CALL KLONKEND
      CALL GVSCLF (11)
      CALL GVSCLF (13)
      CALL MOL200
      CALL PRP202 ('?M4835')
      NOBOND(SOUADM(1,ISOUP))=BNDMEM



      DO 20 I=1,NUMSOU
         IF (SOUADM(3,I).EQ.1) THEN
            IF (CH4EQCH4(ONESA3(SOUADM(1,I)),CHAR4)) THEN
               SOUADM(6,I)=1
               SOUADM(10,I)=1
               DO 10 IAT=PNTAAS(SOUADM(1,I)),PNTAAE(SOUADM(2,I))
                  CALL GVSSTX (ORGNAM(IAT),ONESAT(IAT))
 10            CONTINUE
            END IF
         END IF
 20   CONTINUE



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE USEDD3 (ISOUP,IERR)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'DATBAS.INC'
      INTEGER       IERR, ISOUP, CC, IAA
      LOGICAL       GVFISF, GVFIBN, DR
      CHARACTER*4   CHAR4_1
      CHARACTER*256 DAVLN1







      CALL GVSCTB (DAVLN1,256)
      IERR=0
      CC=WIFPAR(360)
      IAA=SOUADM(1,ISOUP)
      CALL GVSSTX (CHAR4_1,ONESA3(IAA))



      CALL PRP210 (IERR)
      DR=IERR.EQ.0



      CALL PRP206 ('?M4836')
      CALL USEDD6 (ISOUP,IERR)



      CALL GVSCCC (DAVLN1,FILDIR(10),'?M4565')
      CALL GVSCBC (DAVLN1,DAVDRG)
      CALL GVSCBC (DAVLN1,FILDIR(10))
      CALL GVSCPC (DAVLN1,'DAVADRUG.TOP')



      IF (WIFPAR(352).EQ.1) THEN
         CALL GVSCBC (DAVLN1,'CGRP FF=oplsaapd talk')
      ELSE IF (WIFPAR(352).EQ.0) THEN
         CALL GVSCBC (DAVLN1,'CGRP FF=gro96pd talk')
      END IF



      IF (WIFPAR(1296).EQ.0) THEN
         IF (WIFPAR(345).EQ.0) THEN
            CALL GVSCBC (DAVLN1,' >PRODRUG.OUT')
            IF (GVFIBN(CC,1,36)) THEN
               CALL GVSCPC (DAVLN1,CHADEF(CC:CC))
            ELSE
               SOUADM(6,ISOUP)=1
               SOUADM(10,ISOUP)=1
               IERR=1
               GOTO 998
            END IF
         END IF
      END IF



      IF (WIFPAR(1012).NE.0) THEN
         CALL GVSCCC (LINE,FILDIR(10),'?M4565')
         IF (.NOT.GVFISF(LINE)) CALL GVSTT6 ('?M4567')
         CALL GVSCCC (LINE,FILDIR(10),'DAVADRUG.TOP')
         IF (.NOT.GVFISF(LINE)) CALL GVSTT6 ('?M4569')
         IF (.NOT.GVFISF(DAVDRG)) CALL GVST6C (DAVDRG,'?M4568',.TRUE.)
      END IF
      CALL GVSDEL ('DRGDRG.ERR')
      CALL PRP206 (DAVLN1)

      CALL GVSSPL (DAVLN1)



      CALL USED12 (ISOUP,IERR)
      IF (.NOT.GVFISF('DRGWIF.TOP').OR.GVFISF('DRGDRG.ERR').OR.
     +    IERR.NE.0) THEN
         IF (WIFPAR(642).EQ.0.AND.WIFPAR(363).EQ.0) THEN
            IF (GVFISF('DRGDRG.ERR')) CALL SYSTEM ('more DRGDRG.ERR')
            IF (WIFPAR(1270).NE.0.OR.WIFPAR(345).NE.0) THEN
               CALL SHOWTEXT ('?DAVA021')
               CALL GVSSPL ('?M4570')
               IF (WIFPAR(919).GT.0) CALL GVSDEL ('DRGDRG.ERR')
            END IF
            SOUADM(10,ISOUP)=1
            CALL GVSBOX ('Work to do...')
            SOUADM(6,ISOUP)=1
            SOUADM(10,ISOUP)=1
            IERR=1
         END IF
         GOTO 998
      END IF





      CALL TOP004 (IERR)










      IF (IERR.NE.0) THEN
         CALL DIF008A (6,IAA,'?M4850')
         IF (DR) CALL DIF008A (DATLOG,IAA,'?M4850')
      END IF



  998 CONTINUE


      RETURN
      END
      SUBROUTINE USEDD4 (ISOUP,SKIP)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'DATBAS.INC'
      INTEGER       IAA, ISOUP, IERR
      LOGICAL       SKIP, DR
      CHARACTER*4   CHAR4_1







      SKIP=.TRUE.
      IAA=SOUADM(1,ISOUP)



      CALL PRP210 (IERR)
      DR=IERR.EQ.0



      IF (SOUADM(12,ISOUP).GE.1) THEN
         SKIP=.TRUE.
         SOUADM(10,ISOUP)=1
         GOTO 998
      END IF         



      CALL GVSSTX (CHAR4_1,ONESA3(IAA))
      CALL MOL012A (ISOUP,SKIP,IERR)
      IF (SKIP.OR.IERR.NE.0) THEN
         IF (DR.AND.WIFPAR(156).EQ.0) CALL GVSTUC (DATLOG,'?M3695',
     +    CHAR4_1,.TRUE.)
         IF (WIFPAR(156).EQ.0) THEN

            IF (DR) CALL DIF008A (DATLOG,IAA,'?M4963')
         END IF
         SOUADM(10,ISOUP)=1
         SOUADM(13,ISOUP)=1
         GOTO 998
      END IF




      CALL MOL012B (ISOUP,SKIP,IERR)
      IF (SKIP.OR.IERR.NE.0) THEN
         IF (DR.AND.WIFPAR(156).EQ.0) CALL GVSTUC (DATLOG,'?M3696',
     +    CHAR4_1,.TRUE.)
         IF (WIFPAR(156).EQ.0) THEN

            IF (DR) CALL DIF008A (DATLOG,IAA,'?M4964')
         END IF
         SOUADM(10,ISOUP)=1
         SOUADM(13,ISOUP)=2
         GOTO 998
      END IF



      CALL MOL012C (ISOUP,SKIP,IERR)
      IF (SKIP.OR.IERR.NE.0) THEN
         IF (DR.AND.WIFPAR(156).EQ.0) CALL GVSTUC (DATLOG,'?M3697',
     +    CHAR4_1,.TRUE.)
         IF (WIFPAR(156).EQ.0) THEN

            IF (DR) CALL DIF008A(DATLOG,IAA,'?M4965')
         END IF
         SOUADM(10,ISOUP)=1
         SOUADM(13,ISOUP)=3
         GOTO 998
      END IF



      CALL MOL012D (ISOUP,SKIP,IERR)
      IF (SKIP.OR.IERR.NE.0) THEN
         IF (DR.AND.WIFPAR(156).EQ.0) CALL GVSTUC (DATLOG,'?M3699',
     +    CHAR4_1,.TRUE.)
         IF (WIFPAR(156).EQ.0) THEN

            IF (DR) CALL DIF008A (DATLOG,IAA,'?M4966')
         END IF
         SOUADM(10,ISOUP)=1
         SOUADM(13,ISOUP)=4
         GOTO 998
      END IF



      CALL MOL012E (ISOUP,SKIP,IERR)
      IF (SKIP.OR.IERR.NE.0) THEN
         IF (DR.AND.WIFPAR(156).EQ.0) CALL GVSTUC (DATLOG,'?M4849',
     +    CHAR4_1,.TRUE.)
         IF (WIFPAR(156).EQ.0) THEN

            IF (DR) CALL DIF008A (DATLOG,IAA,'?M4967')
         END IF
         SOUADM(10,ISOUP)=1
         SOUADM(13,ISOUP)=5
         GOTO 998
      END IF



      SKIP=.FALSE.
  998 CONTINUE


      RETURN
      END   
      SUBROUTINE USEDD5 (ISOUP,IERR)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       ISOUP, IAA, IAT, NUMUSE, IERR







      XDDOFF=0.0
      YDDOFF=0.0
      ZDDOFF=0.0
      IERR=0
      NUMUSE=0



      DO 100 IAA=SOUADM(1,ISOUP),SOUADM(2,ISOUP)
         DO 90 IAT=PNTAAS(IAA),PNTAAE(IAA)
            IF (ISATOK(IAT)) THEN
               XDDOFF=XDDOFF+XCOORD(IAT)
               YDDOFF=YDDOFF+YCOORD(IAT)
               ZDDOFF=ZDDOFF+ZCOORD(IAT)
               NUMUSE=NUMUSE+1
            END IF
 90      CONTINUE
 100  CONTINUE



      IF (NUMUSE.GT.0) THEN
         XDDOFF=XDDOFF/FLOAT(NUMUSE)
         YDDOFF=YDDOFF/FLOAT(NUMUSE)
         ZDDOFF=ZDDOFF/FLOAT(NUMUSE)
      ELSE
         IERR=1
      END IF





      RETURN
      END   
      SUBROUTINE USEDD6 (ISOUP,IERR)


















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ANATRA.INC'
      INTEGER       ISOUP, IERR, IUNIT, IOUT, IAA, IAT, JAT, JAA, IBND,
     +              JATARR(6), NUM, IAT1, IAT2, CC, JOUT
      REAL          W, BS, BA
      LOGICAL       GVFIBN
      CHARACTER*4   ATMLOC, T4







      CALL PRP203 (SOUADM(1,ISOUP),'?M4882')
      CALL GVSRT0 (ATTVL2,NUMATF)
      IOUT=0
      W=1.0
      BS=20.0
      BA=1.0
      CC=WIFPAR(360)



      CALL USEDD5 (ISOUP,IERR)
      IF (IERR.NE.0) THEN
         CALL GVSTT6 ('?DAV001')
         GOTO 998
      END IF



      IF (WIFPAR(1275).NE.0) THEN
         IAT1=PNTAAS(SOUADM(1,ISOUP))
         IAT2=PNTAAE(SOUADM(2,ISOUP))
         DO 20 IAT=IAT1,IAT2
            DO 10 IBND=1,8
               JAT=BOUND_TO(IBND,IAT)
               IF (JAT.NE.0) THEN
                  IF (JAT.LE.PNTAAE(NUMAAT)) THEN
                     ATTVL2(IAT)=FLOAT(JAT)
                  ELSE
                     ATTVL2(IAT)=0.0
                  END IF
               END IF
 10         CONTINUE
 20      CONTINUE
      END IF



      CALL GVSROF (IUNIT,IERR)
      IF (IUNIT.LE.0.OR.IERR.NE.0) GOTO 999
      IF (WIFPAR(1296).EQ.0) THEN
         IF (GVFIBN(CC,1,36)) THEN
            CALL GVSCCC (DAVDRG,'DAVADRUG.PDB',CHADEF(CC:CC))
         ELSE
            CALL GVSSTX (DAVDRG,'DAVADRUG.PDB')
         END IF
      ELSE
         CALL GVSSTX (DAVDRG,'DAVADRUG.PDB')
      END IF
      CALL GETFILN (IUNIT,' ',DAVDRG,IERR)
      IF (IERR.NE.0) THEN
         CALL GVSTT6 ('?DAV001')
         GOTO 998
      END IF



      CALL GVSFMT ('?FMT927')
      IAA=SOUADM(1,ISOUP)
      DO 40 IAT=PNTAAS(IAA),PNTAAE(IAA)



         IF (WIFPAR(351).NE.0.AND.PROTON(IAT)) GOTO 40



         CALL GVSSTX (ATMLOC,T4(ONESAT(IAT)))
         CALL GVSCTB (LINE,80)
         IOUT=IOUT+1
         WRITE (LINE,FMT,ERR=999) IOUT,ATMLOC,ONESA3(IAA),
     +    NUMNAM(IAA),XCOORD(IAT)-XDDOFF,YCOORD(IAT)-YDDOFF,
     +    ZCOORD(IAT)-ZDDOFF,W,BS
         CALL GVSTTU (IUNIT,LINE)
         CALL PRP206 (LINE)



         IF (WIFPAR(1275).GT.0) THEN
            IF (ATTVL2(IAT).GT.0.5) THEN
               JOUT=-1
               JAT=NINT(ATTVL2(IAT))
               IF (.NOT.PROTON(JAT).AND.ISATOK(JAT)) THEN
                  JAA=ATIAA(JAT)
                  CALL GVSSTX (ATMLOC,T4(ONESAT(JAT)))
                  CALL GVSCTB (LINE,80)
                  WRITE (LINE,FMT,ERR=999) JOUT,ATMLOC,ONESA3(IAA),
     +             NUMNAM(IAA),XCOORD(JAT)-XDDOFF,YCOORD(JAT)-YDDOFF,
     +             ZCOORD(JAT)-ZDDOFF,W,BA
                  CALL GVSTTU (IUNIT,LINE)
                  CALL PRP206 (LINE)
               END IF



               CALL FBONDAOK (JAT,JATARR,6,NUM)
               IF (NUM.GT.0) THEN
                  DO 30 IBND=1,NUM
                     JAT=JATARR(IBND)
                     IF (.NOT.GVFIBN(JAT,IAT1,IAT2).AND.ISATOK(JAT))THEN
                        JOUT=-1
                        CALL GVSSTX (ATMLOC,T4(ONESAT(JAT)))
                        CALL GVSCTB (LINE,80)
                        WRITE (LINE,FMT,ERR=999) JOUT,ATMLOC,
     +                   ONESA3(IAA),NUMNAM(IAA),XCOORD(JAT)-XDDOFF,
     +                   YCOORD(JAT)-YDDOFF,ZCOORD(JAT)-ZDDOFF,W,BA
                        CALL GVSTTU (IUNIT,LINE)
                        CALL PRP206 (LINE)
                        WRITE (LINE,FMT,ERR=999) JOUT,ATMLOC,
     +                   ONESA3(IAA),NUMNAM(IAA),XCOORD(JAT),
     +                   YCOORD(JAT),ZCOORD(JAT),W,BA
                        CALL PRP206 (LINE)
                     END IF
 30               CONTINUE
               END IF
            END IF
         END IF
 40   CONTINUE
      
      GOTO 998



  999 CONTINUE
      IERR=1
      CALL GVSEIW ('USEDD6')



  998 CONTINUE
      CALL GVSCLF (IUNIT)


      RETURN
      END   
      SUBROUTINE USEDD7 (ISOUNB)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'DATBAS.INC'
      INTEGER       ISOUP, JSOUP, ISOUNB, IAA, JAA, IERR, IOK, JOK,
     +              IAATYP, INDAA3
      LOGICAL       WIFISO, WIFISW, WIFISR, GVFIBN, CH4EQCH4, DL







      ISOUNB=0
      CALL PRP210 (IERR)
      DL=IERR.EQ.0



      DO 20 ISOUP=1,NUMSOU
         IAA=SOUADM(1,ISOUP)
         IAATYP=INDAA3(ONESA3(IAA))
         IF (DL) WRITE (DATLOG,*,ERR=999) 'DD7 TRY:',IAA,
     +    ONESA3(IAA),' (',NUMNAM(IAA),') ',SOUADM(6,ISOUP),
     +    SOUADM(10,ISOUP),WIFISO(ISOUP),WIFISW(ISOUP),WIFISR(ISOUP),
     +    SOUADM(1,ISOUP),SOUADM(2,ISOUP),SOUADM(4,ISOUP),IAATYP,
     +    GVFIBN(RESTYP(IAA),1,WIFPAR(276))
         IF (INDAA3(ONESA3(IAA)).GE.1) GOTO 20
         IF (SOUADM(6,ISOUP).NE.0.OR.SOUADM(10,ISOUP).NE.0) GOTO 20
         IF (WIFISO(ISOUP).OR.WIFISW(ISOUP).OR.WIFISR(ISOUP)) GOTO 20
         IF (SOUADM(1,ISOUP).EQ.SOUADM(2,ISOUP).AND.
     +    GVFIBN(RESTYP(SOUADM(1,ISOUP)),1,WIFPAR(276))) GOTO 20
         IF (SOUADM(4,ISOUP).LE.1) GOTO 20



         ISOUNB=ISOUP



         IF (ISOUNB.EQ.NUMSOU) GOTO 998



         CALL USEDD9 (IAA,IOK)
         DO 10 JSOUP=ISOUP+1,NUMSOU
            IF (SOUADM(10,JSOUP).GE.1) GOTO 10
            IF (WIFISO(JSOUP).OR.WIFISW(JSOUP).OR.WIFISR(JSOUP)) GOTO 20
            JAA=SOUADM(1,JSOUP)
            IF (CH4EQCH4(ONESA3(IAA),ONESA3(JAA))) THEN
               CALL USEDD9 (JAA,JOK)
               IF (JOK.GT.IOK) THEN
                  CALL GVSTT6 ('?M4884')
                  ISOUNB=JSOUP
                  IAA=SOUADM(1,JSOUP)
                  IOK=JOK
                  IF (DL) THEN
                     CALL PRP203 (IAA,'?M4846')
                     CALL PRP203 (JAA,'?M4847')
                  END IF
               END IF
            END IF
 10      CONTINUE
         GOTO 998
 20   CONTINUE
      GOTO 998



  999 CONTINUE
      CALL GVSEIW ('USEDD7')



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE USEDD8 (IERR)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IERR, ISOUP







      IF (WIFPAR(1052).NE.0) THEN
         IERR=1
         GOTO 998
      END IF



      IERR=0



      DO 10 ISOUP=1,NUMSOU
         IF (SOUADM(5,ISOUP).EQ.2.OR.SOUADM(5,ISOUP).EQ.4) THEN
            CALL MOL012 (ISOUP)
         END IF
 10   CONTINUE



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE USEDD9 (IAA,NUMOK)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, IAT, NUMOK







      NUMOK=0



      DO 10 IAT=PNTAAS(IAA),PNTAAE(IAA)
         IF (.NOT.PROTON(IAT).AND.ISATOK(IAT).AND.
     +    WEIGHT(IAT).GE.0.01) NUMOK=NUMOK+1
 10   CONTINUE





      RETURN
      END   
      SUBROUTINE USED10

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       ISOUP, JSOUP, IAA, JAA, IAT, JAT, JATARR(6), NJAT,
     +              BATARR(6), NBAT, LOOP, BAT, OAT
      REAL          DIST, WIFDST
      LOGICAL       WIFISD, DONE, ISC, ISO, ISN, FIRST







      IF (NUMSOU.LE.1) GOTO 998



      DONE=.FALSE.
      FIRST=.TRUE.



      DO 100 ISOUP=2,NUMSOU
         IF (SOUADM(5,ISOUP).EQ.2) THEN
            IAA=SOUADM(1,ISOUP)



            DO 90 JSOUP=1,ISOUP-1
               IF (WIFISD(JSOUP)) THEN
                  JAA=SOUADM(1,JSOUP)



                  IF (ONESA3(IAA).EQ.ONESA3(JAA)) THEN
                     IF (SOUADM(4,ISOUP).NE.SOUADM(4,JSOUP)) THEN
                        CALL GVSTTIU2 (DAVBUG,'Unequal atom # in :',
     +                   JAA,IAA)
                        CALL GVSTTIU2 (DAVBUG,'Unequal atom # :',
     +                   SOUADM(4,JSOUP),SOUADM(4,ISOUP))
                        CALL SHOUAA (DAVBUG,JAA)
                        CALL SHOUAA (DAVBUG,IAA)
                        CALL USED14 (IAA)
                        DONE=.TRUE.
                        GOTO 100
                     ELSE 
                        DO 10 IAT=PNTAAS(IAA),PNTAAE(IAA)
                           JAT=PNTAAS(JAA)-PNTAAS(IAA)+IAT
                           IF (ONESAT(IAT).NE.ONESAT(JAT)) THEN
                              CALL GVSTTU (DAVBUG,'Unequal atom names')
                              CALL SHOUAA (DAVBUG,JAA)
                              CALL SHOUAA (DAVBUG,IAA)
                              CALL USED14 (IAA)
                              DONE=.TRUE.
                              GOTO 100
                           END IF
 10                     CONTINUE
                     END IF
                  END IF
               END IF
 90         CONTINUE
         END IF
 100  CONTINUE



      DO 200 ISOUP=1,NUMSOU
         IF (.NOT.WIFISD(ISOUP)) GOTO 200
         CALL MOL012 (ISOUP)
         SOUADM(10,ISOUP)=0
         IAA=SOUADM(1,ISOUP)



         IF (SOUADM(5,ISOUP).EQ.2) THEN
            CALL PRP203 (IAA,'?M4972')



            DO 120 IAT=PNTAAS(IAA),PNTAAE(IAA)
               IF (ONESAT(IAT)(1:2).NE.' C') GOTO 120
               CALL FBONDA (IAT,JATARR,6,NJAT)
               IF (NJAT.EQ.3) THEN
                  ISC=.FALSE.
                  ISO=.FALSE.
                  ISN=.FALSE.
                  DO 110 LOOP=1,3
                     BAT=JATARR(LOOP)
                     IF (ONESAT(BAT)(1:2).EQ.' O') THEN
                        CALL FBONDA (BAT,BATARR,6,NBAT)
                        IF (NBAT.EQ.1) ISO=.TRUE.
                        OAT=BAT
                     END IF
                     IF (ONESAT(BAT)(1:2).EQ.' N') THEN
                        CALL FBONDA (BAT,BATARR,6,NBAT)
                        IF (NBAT.EQ.1) ISN=.TRUE.
                     END IF
                     IF (ONESAT(BAT)(1:2).EQ.' C') THEN
                        CALL FBONDA (BAT,BATARR,6,NBAT)
                        ISC=.TRUE.
                     END IF
 110              CONTINUE
                  IF (ISO.AND.ISN.AND.ISC) THEN
                     IF (FIRST) THEN
                        CALL PRP202 ('?M4971')
                        FIRST=.FALSE.
                     END IF
                     CALL PRP206 ('?M4975')
                     CALL PRP213 (JATARR(1),'Bound atom 1')
                     CALL PRP213 (JATARR(2),'Bound atom 2')
                     CALL PRP213 (JATARR(3),'Bound atom 3')
                     DIST=WIFDST(IAT,OAT)
                     CV(1)=XCOORD(OAT)-XCOORD(IAT)
                     CV(2)=YCOORD(OAT)-YCOORD(IAT)
                     CV(3)=ZCOORD(OAT)-ZCOORD(IAT)
                     CALL PRP213 (IAT,'?M4976')
                     CALL PRP213 (OAT,'?M4977')
                     CALL GVSNM3 (CV)
                     CALL GVSVXC (CV,1.231,3)
                     XCOORD(OAT)=XCOORD(IAT)+CV(1)
                     YCOORD(OAT)=YCOORD(IAT)+CV(2)
                     ZCOORD(OAT)=ZCOORD(IAT)+CV(3)
                  END IF
               END IF
 120        CONTINUE



            DO 140 IAT=PNTAAS(IAA),PNTAAE(IAA)
               IF (ONESAT(IAT)(1:2).NE.' P') GOTO 140
               DO 130 JAT=IAT,PNTAAE(IAA)
                  IF (JAT.EQ.IAT) GOTO 130
                  IF (ONESAT(JAT)(1:2).NE.' C') GOTO 130
                  DIST=WIFDST(IAT,JAT)
                  IF (DIST.GT.1.5.AND.DIST.LT.1.85) THEN
                     CV(1)=XCOORD(JAT)-XCOORD(IAT)
                     CV(2)=YCOORD(JAT)-YCOORD(IAT)
                     CV(3)=ZCOORD(JAT)-ZCOORD(IAT)
                     CALL PRP213 (IAT,'?M4976')
                     CALL PRP213 (JAT,'?M4978')
                     CALL GVSNM3 (CV)
                     CALL GVSVXC (CV,1.700,3)                
                     XCOORD(JAT)=XCOORD(IAT)+CV(1)
                     YCOORD(JAT)=YCOORD(IAT)+CV(2)
                     ZCOORD(JAT)=ZCOORD(IAT)+CV(3)
                  END IF
 130           CONTINUE
 140        CONTINUE
         END IF
 200  CONTINUE



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE USED11

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IERR, ISOUP, IAA
      LOGICAL       WIFISA, WIFISW, WIFISN







      CALL MOL200
      CALL DRG106 (IERR)
      DO 30 ISOUP=1,NUMSOU
         IF (SOUADM(10,ISOUP).EQ.1) THEN
            CALL MOL012 (ISOUP)
         END IF
         CALL ENVSET (ISOUP)
         IAA=SOUADM(1,ISOUP)
         IF (.NOT.WIFISA(ISOUP).AND.(.NOT.WIFISW(ISOUP)).AND.
     +       (.NOT.WIFISN(ISOUP))) THEN
            IF (WIFPAR(1208).GE.3) CALL GVSTTI ('?DAV004',ISOUP)
            CALL MOL004A (ISOUP)
         END IF
 30   CONTINUE
      CALL DRG107 (IERR)
      CALL MOL200





      RETURN
      END   
      SUBROUTINE USED12 (ISOUP,IERR)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IERR, ISOUP, IUNIT, JUNIT, IAT, CC
      REAL          X, Y, Z
      LOGICAL       GRTFILE, GOTFILE, FOUND, PROH, GVFIBN, GVFISF
      CHARACTER*256 DAVLN1







      CALL PRP206 ('?M4979')
      DO 10 IAT=PNTAAS(SOUADM(1,ISOUP)),PNTAAE(SOUADM(2,ISOUP))
         ATTVAL(IAT)=0.0
 10   CONTINUE
      CC=WIFPAR(360)
      IERR=0
      IUNIT=0
      JUNIT=0



      IF (.NOT.GVFISF('DRGGMX.PDB')) GOTO 999





      CALL GVSCTB (DAVLN1,256)
      CALL GVSSTX (DAVLN1,'DRGGMX.PDB')
      IF (.NOT.GRTFILE(IUNIT,DAVLN1)) GOTO 999



      IF (WIFPAR(1296).EQ.0) THEN
         IF (GVFIBN(CC,1,36)) CALL GVSCPC (DAVLN1,CHADEF(CC:CC))
         IF (.NOT.GOTFILE(JUNIT,DAVLN1)) GOTO 999
         CALL GVSSTX (DAVOUT,DAVLN1(1:80))
      ELSE
         IF (.NOT.GOTFILE(JUNIT,'WHAT.THE')) GOTO 999
         CALL GVSSTX (DAVOUT,'WHAT.THE')
      END IF



 20   CONTINUE



         CALL GVSCTB (LINE,80)
         CALL GETLINE (IUNIT,LINE,IERR)
         CALL PRP206 (LINE)
         IF (IERR.EQ.1) GOTO 999



         IF (LINE(1:6).EQ.'REMARK') GOTO 20
         IF (LINE(1:6).EQ.'HETATM'.OR.LINE(1:6).EQ.'ATOM  ') THEN



            CALL GVSSTX (LINE(23:26),NUMNAM(SOUADM(1,ISOUP)))



            PROH=LINE(14:14).EQ.'H'



            CALL GVSFMT ('?FMT730')
            READ (LINE(31:54),FMT,ERR=999) X,Y,Z
            X=X+XDDOFF
            Y=Y+YDDOFF
            Z=Z+ZDDOFF



            CALL XYZINIAA (SOUADM(1,ISOUP),X,Y,Z,PROH,FOUND)
            IF (.NOT.FOUND) THEN
               CALL GVSCTB (LINE(8:9),2)
               CALL GVSSTX (LINE(10:11),'-1')
               CALL PRP206 ('?M4982')
               CALL PRP206 (LINE)
            END IF




            WRITE (LINE(31:54),FMT,ERR=999) X,Y,Z
            CALL GVSTTU (JUNIT,LINE)
            CALL PRP206 (LINE)
         END IF
         IF (IERR.EQ.2) THEN
            IERR=0
            GOTO 997
         END IF
      IF (IERR.EQ.0) GOTO 20



  999 CONTINUE
      IERR=1



 997  CONTINUE
      XDDOFF=0.0
      YDDOFF=0.0
      ZDDOFF=0.0
      CALL USED13 (ISOUP)



      IF (IUNIT.NE.0) CALL GVSCLF (IUNIT)
      IF (JUNIT.NE.0) CALL GVSCLF (JUNIT)


      RETURN
      END   
      SUBROUTINE USED13 (ISOUP)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       ISOUP, IERR, IAT







      DO 10 IAT=PNTAAS(SOUADM(1,ISOUP)),PNTAAE(SOUADM(2,ISOUP))
         IF (.NOT.PROTON(IAT).AND.ATTVAL(IAT).LT.0.5) THEN
            IERR=1
            CALL DIF008A (6,SOUADM(1,ISOUP),'?M4980')
            CALL MOL012 (ISOUP)
            SOUADM(10,ISOUP)=2
            GOTO 998
         END IF
 10   CONTINUE



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE USED14 (IAA)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, JAA, I, J
      LOGICAL       USED16, CH4EQCH4
      CHARACTER*4   CHAR4, CHARMEM







      CALL GVSSTX (CHARMEM,ONESA3(IAA))



      DO 20 I=1,36
         DO 10 J=10,99
            CALL GVSCTB (CHAR4,4)
            CHAR4(1:1)=CHADEF2(I:I)
            WRITE (CHAR4(2:3),'(I2)',ERR=999) J
            IF (USED16(CHAR4)) GOTO 10
            GOTO 21
 10      CONTINUE
 20   CONTINUE
 21   CONTINUE
      
      DO 30 JAA=IAA,NUMAAT
         IF (CH4EQCH4(ONESA3(IAA),CHARMEM)) THEN
            CALL GVSSTX (ONESA3(IAA),CHAR4)
            CALL GVSSTX (ONEORG(IAA),CHAR4)



            CALL GVSCTB (LINE,80)
            CALL GVSFMT ('?FMT1408')
            WRITE (LINE,FMT,ERR=999) CHARMEM,NUMNAM(IAA),CHAR4
            CALL GVSTT6 (LINE)
            CALL PRP206 (LINE)
         END IF
 30   CONTINUE
      GOTO 998



  999 CONTINUE
      CALL GVSEIW ('USED14')



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE USED15 (CHAMEM)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IERR, IUNIT, CC
      LOGICAL       GRTFILE, GVFIBN
      CHARACTER*1   CHAMEM
      CHARACTER*256 DAVLN1







      CALL PRP206 ('?M4981')
      IUNIT=0



      CALL GVSCTB (DAVLN1,256)
      CALL GVSSTX (DAVLN1,'DRGGMX.PDB')
      IF (WIFPAR(1296).EQ.0) THEN
         CC=WIFPAR(360)
         IF (GVFIBN(CC,1,36)) CALL GVSCPC (DAVLN1,CHADEF(CC:CC))
      END IF
      IF (.NOT.GRTFILE(IUNIT,DAVLN1)) GOTO 999



 20   CONTINUE



         CALL GVSCTB (LINE,80)
         CALL GETLINE (IUNIT,LINE,IERR)
         CALL PRP206 (LINE)
         IF (IERR.EQ.1) GOTO 999



         IF (LINE(1:6).EQ.'HETATM'.OR.LINE(1:6).EQ.'ATOM  ') THEN
            LINE(22:22)=CHAMEM
            CALL LINTOKLONK (LINE)
         END IF
         IF (IERR.EQ.2) THEN
            IERR=0
            GOTO 998
         END IF
      IF (IERR.EQ.0) GOTO 20



  999 CONTINUE
      IERR=1
      CALL GVSEIW ('USED15')



 998  CONTINUE
      IF (WIFPAR(642).EQ.0.AND.WIFPAR(363).EQ.0) CALL GVSTT6 ('?M4942')
      IF (IUNIT.NE.0) CALL GVSCLF (IUNIT)


      RETURN
      END   
      LOGICAL FUNCTION USED16(CHAR4)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA
      LOGICAL       CH4EQCH4
      CHARACTER*4   CHAR4







      USED16=.FALSE.



      DO 10 IAA=1,NUMAAT
         IF (CH4EQCH4(ONESA3(IAA),CHAR4)) THEN
            USED16=.TRUE.
            GOTO 998
         END IF
 10   CONTINUE



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE USED17 (ISOUP)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       ISOUP, IAA, IAT, IBND, JAT, IERR
      LOGICAL       GVFIBN







      IF (SOUADM(1,ISOUP).NE.SOUADM(2,ISOUP)) THEN
         CALL GVSTTB ('Wrong molecule type in USED17')
         GOTO 998
      END IF



      IAA=SOUADM(1,ISOUP)
      DO 100 IAT=PNTAAS(IAA),PNTAAE(IAA)
         DO 90 IBND=1,8
            JAT=BOUND_TO(IBND,IAT)
            IF (JAT.NE.0) THEN
               IF (.NOT.GVFIBN(JAT,PNTAAS(IAA),PNTAAE(IAA))) THEN
                  CALL SETUNBOUNDTO (IAT,JAT,IERR)
               END IF
            END IF
 90      CONTINUE
 100  CONTINUE



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE XYZINIAA (IAA,XIN,YIN,ZIN,PROH,FOUND)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, IAT
      REAL          XIN, YIN, ZIN
      LOGICAL       FOUND, PROH







      IF (PROH) THEN
         FOUND=.TRUE.
      ELSE
         FOUND=.FALSE.
      END IF



      DO 10 IAT=PNTAAS(IAA),PNTAAE(IAA)
         IF (ABS(XIN-XCOORD(IAT)).LT.0.1.AND.
     +       ABS(YIN-YCOORD(IAT)).LT.0.1.AND.
     +       ABS(ZIN-ZCOORD(IAT)).LT.0.1) THEN
            ATTVAL(IAT)=1.0
            FOUND=.TRUE.
            GOTO 998
         END IF
 10   CONTINUE



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE MOL012 (ISOUP)























      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAT, ISOUP, IAT1, IAT2, IERR
      REAL          WIFDST, WIFVDW, ADDFAC, DIST
      LOGICAL       ISSULPHUR







      IF (PNTAAS(SOUADM(1,ISOUP)).LT.1.OR.
     +    PNTAAE(SOUADM(2,ISOUP)).GT.NUMATF) THEN
         CALL GVSKIL
         WIFPAR(154)=1
         GOTO 998
      END IF
      IF (SOUADM(10,ISOUP).GE.2) GOTO 998



      RESTYP(SOUADM(1,ISOUP))=0




      DO 10 IAT=PNTAAS(SOUADM(1,ISOUP)),PNTAAE(SOUADM(2,ISOUP))
         IF (VDWRAD(IAT).LT.0.1) VDWRAD(IAT)=WIFVDW(ONESAT(IAT))
         IF (ISSULPHUR(IAT)) VDWRAD(IAT)=
     +    VDWRAD(IAT)+0.25
         CALL GVSIT0 (BOUND_TO(1,IAT),8)
   10 CONTINUE



      IF (PNTAAS(SOUADM(1,ISOUP)).EQ.PNTAAE(SOUADM(2,ISOUP))) THEN
         SOUADM(5,ISOUP)=4
         GOTO 998
      END IF



      DO 30 IAT1=PNTAAS(SOUADM(1,ISOUP)),PNTAAE(SOUADM(2,ISOUP))-1
         ADDFAC=0.0



   15    CONTINUE
         DO 20 IAT2=IAT1+1,PNTAAE(SOUADM(2,ISOUP))
            DIST=WIFDST(IAT1,IAT2)
            IF (DIST.LT.0.5*(VDWRAD(IAT1)+VDWRAD(IAT2))+ADDFAC) THEN
               CALL SETBOUNDTO (IAT1,IAT2,IERR)
            END IF
 20      CONTINUE




         IF (BOUND_TO(1,IAT1).NE.0) GOTO 30
         ADDFAC=ADDFAC+0.12
         IF (ADDFAC.LT.0.5) GOTO 15
 30   CONTINUE



      DO 40 IAT=PNTAAS(SOUADM(1,ISOUP)),PNTAAE(SOUADM(2,ISOUP))
         IF (ISSULPHUR(IAT)) VDWRAD(IAT)=
     +    VDWRAD(IAT)-0.25
   40 CONTINUE



  998 CONTINUE


      RETURN
      END
      SUBROUTINE MOL012A (ISOUP,SKIP,IERR)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       ISOUP, IERR, IAT, ITYPE, IAA
      LOGICAL       WIFISR, WIFISW, WIFISH, GVFIBN, SKIP
      CHARACTER*2   ALLOWED(10) 
      SAVE          ALLOWED
      DATA ALLOWED  /' N',' C',' O',' S',' P','CL',' I','BR',' F',' H'/







      IF (.NOT.GVFIBN(ISOUP,1,NUMSOU)) THEN
         IERR=1
         SKIP=.TRUE.
         GOTO 998
      END IF



      IERR=0
      SKIP=.FALSE.
      IAA=SOUADM(1,ISOUP)



      IF (WIFISR(ISOUP).OR.WIFISW(ISOUP).OR.WIFISH(ISOUP).OR.
     +    RESTYP(SOUADM(1,ISOUP)).NE.0.OR.SOUADM(5,ISOUP).EQ.6) THEN
         SKIP=.TRUE.
         GOTO 998
      END IF



      DO 20 IAT=PNTAAS(IAA),PNTAAE(IAA)
         DO 10 ITYPE=1,10
            IF (ONESAT(IAT)(1:2).EQ.ALLOWED(ITYPE)) GOTO 20
 10      CONTINUE
         CALL GVSCTB (LINE,80)
         CALL GVSFMT ('?M2959')
         WRITE (LINE,FMT,ERR=999) ONESAT(IAT)(1:2),ONESA3(IAA),
     +    NUMNAM(IAA)
         CALL GVSTT6 (LINE)
         SKIP=.TRUE.
         SOUADM(10,ISOUP)=1
         GOTO 998
 20   CONTINUE



      IF (SOUADM(4,ISOUP).GE.125) THEN
         CALL GVSCTB (LINE,80)
         CALL GVSFMT ('?M2959A')
         WRITE (LINE,FMT,ERR=999) ONESA3(IAA),NUMNAM(IAA)
         CALL GVSTT6 (LINE)
         SKIP=.TRUE.
         SOUADM(10,ISOUP)=1
         GOTO 998
      END IF         
      GOTO 998



  999 CONTINUE
      CALL GVSEIW ('MOL012A')



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE MOL012B (ISOUP,SKIP,IERR)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       ISOUP, IERR
      LOGICAL       GVFIBN, SKIP







      IF (.NOT.GVFIBN(ISOUP,1,NUMSOU)) THEN
         IERR=1
         SKIP=.TRUE.
         GOTO 998
      END IF



      IERR=0
      SKIP=.FALSE.




  998 CONTINUE


      RETURN
      END   
      SUBROUTINE MOL012C (ISOUP,SKIP,IERR)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       ISOUP, IERR
      LOGICAL       SKIP







      IERR=0      
      SKIP=.FALSE.



      IF (SOUADM(4,ISOUP).LE.2.OR.SOUADM(4,ISOUP).GT.WIFPAR(346).OR.
     +    PNTAAE(SOUADM(2,ISOUP))-PNTAAS(SOUADM(1,ISOUP)).GT.
     +    WIFPAR(346)-1.OR.SOUADM(3,ISOUP).GT.1) THEN
         IF (WIFPAR(345).GE.1) CALL GVSTTI ('?M3698',SOUADM(4,ISOUP))
         SKIP=.TRUE.



         IF (WIFPAR(1510).EQ.1) IERR=1
      END IF





      RETURN
      END   
      SUBROUTINE MOL012D (ISOUP,SKIP,IERR)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'DATBAS.INC'
      INTEGER       ISOUP, IERR, IAA, IAT, DL
      REAL          CLUS
      LOGICAL       GVFIBN, SKIP, DONE







      IF (.NOT.GVFIBN(ISOUP,1,NUMSOU)) THEN
         IERR=1
         SKIP=.TRUE.
         GOTO 998
      END IF



      IERR=0
      SKIP=.FALSE.
      IAA=SOUADM(1,ISOUP)
      CALL PRP210 (DL)



      SOUADM(10,ISOUP)=0
      CALL MOL012 (ISOUP)
      SOUADM(10,ISOUP)=1



      DO 10 IAT=PNTAAS(IAA),PNTAAE(IAA)
         ATTVAL(IAT)=-1.0
 10   CONTINUE



      CLUS=0.0
 20      CONTINUE
         CLUS=CLUS+1.0
         DONE=.FALSE.
         DO 30 IAT=PNTAAS(IAA),PNTAAE(IAA)
            IF (ATTVAL(IAT).LT.-0.5) THEN
               ATTVAL(IAT)=CLUS
               DONE=.TRUE.
               CALL ATTCON (IAT)
               GOTO 20
            END IF
 30      CONTINUE




      CLUS=CLUS-1.0
      IF (CLUS.GT.1.1) THEN
         IF (DL.LE.0) CALL DIF008C (DATLOG,IAA,'?M4844',NINT(CLUS))
         CALL DIF008C (6,IAA,'?M4844',NINT(CLUS))
         SOUADM(10,ISOUP)=2
         SKIP=.TRUE.
      END IF



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE MOL012E (ISOUP,SKIP,IERR)


















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       ISOUP, IERR, IAT
      LOGICAL       SKIP







      IERR=0
      SKIP=.FALSE.



      IF (SOUADM(4,ISOUP).LE.4) GOTO 998



      DO 10 IAT=PNTAAS(SOUADM(1,ISOUP)),PNTAAE(SOUADM(2,ISOUP))
         IF (ONESAT(IAT)(1:2).NE.' O'.AND.ONESAT(IAT)(1:2).NE.' N') 
     +    GOTO 998
 10   CONTINUE



      DO 20 IAT=PNTAAS(SOUADM(1,ISOUP)),PNTAAE(SOUADM(2,ISOUP))
         CALL GVSSTX (ONESAT(IAT)(1:2),' C') 
 20   CONTINUE
      SKIP=.TRUE.



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE ATTCON (IATIN)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IATIN, IAAIN, IAT, JAT, IBND
      LOGICAL       DONE







      IAAIN=ATIAA(IATIN)



 10   CONTINUE
         DONE=.FALSE.
         DO 30 IAT=PNTAAS(IAAIN),PNTAAE(IAAIN)
            IF (ATTVAL(IAT).LT.-0.5) THEN
               DO 20 IBND=1,8
                  JAT=BOUND_TO(IBND,IAT)
                  IF (JAT.NE.0) THEN
                     IF (ABS(ATTVAL(JAT)-ATTVAL(IATIN)).LT.0.1) THEN
                        ATTVAL(IAT)=ATTVAL(IATIN)
                        DONE=.TRUE.
                     END IF
                  END IF
 20            CONTINUE
            END IF
 30      CONTINUE
      IF (DONE) GOTO 10
      GOTO 998



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE USED50 (TEXT)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       ISOUP, IAA, IAT, ICNT
      LOGICAL       WIFISD
      CHARACTER(*)  TEXT







      CALL GVSBOX (TEXT)



      DO 20 ISOUP=1,NUMSOU
         IF (WIFISD(ISOUP)) THEN
            IAA=SOUADM(1,ISOUP)
            ICNT=0
            DO 10 IAT=PNTAAS(IAA),PNTAAE(IAA)
               IF (.NOT.PROTON(IAT)) ICNT=ICNT+1
 10         CONTINUE
            PRINT*,ISOUP,' ',IAA,' ',ONESA3(IAA),' (',NUMNAM(IAA),') ',
     +       SOUADM(3,ISOUP),SOUADM(4,ISOUP),ICNT
         END IF
 20   CONTINUE



      CALL GVSNL6 (1)





      RETURN
      END   
