



      SUBROUTINE SC7001

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      LOGICAL       CHKTODO







      CALL TEXSECT ('?CHKM21')



      IF (CHKTODO('BMP')) THEN
         CALL SC7002
      ELSE
         WIFPAR(942)=-999999
      END IF





      RETURN
      END   
      SUBROUTINE SC7002


















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'SYMINC.INC'
      INCLUDE       'CNTINC.INC'
      INCLUDE       'RESULT.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'PDBINC.INC'
      INTEGER       IAA, JAA, IAT, JAT, ISYM, JSYM, ICONT, TAG(10000),
     +              SYMNEG, IBIG, I
      REAL          TMP(3), ERROR, NUCDST, BIGVAL(10000), HBOQVAL,
     +              AVE, ADEV, SDEV, VAR, SKEW, CURT, F
      LOGICAL       ISBUMP, ISHBO, WIFIRW, IS13, IS14, CHABAD
      CHARACTER*5   SYMT
      CHARACTER*2   REASN
      CHARACTER*28  IATS, JATS
      CHARACTER*92  BIGCHR(10000)
      EQUIVALENCE   (BIGCHR,ESPACE(270001))
      EQUIVALENCE   (BIGVAL,ESPACE(270001+250000))
      EQUIVALENCE   (TAG,   ESPACE(270001+260000))







      CALL ESPSET (270001,270000+270000,43)




      CALL GVSRT0 (PRPVAL,MAXAA)
      IBIG=0
      IF (WIFPAR(1296).NE.0) CALL WIFPUSHPPP (590,0)
      GENRVL(47)=0.0
      GENRVL(48)=0.0



      CALL ENVTOT



      CALL PDBC04B



      CALL SC7003 (CHABAD)



      IF (CHABAD) THEN
         CALL CDB013 ('BUMPNOKC','BUMPNEUC','BUMPOK')
      ELSE
         CALL CDB013 ('BUMPNOK','BUMPNEU','BUMPOK')
      END IF



      CALL HBO010



      CALL GVSRAV (XBFACT,PNTAAE(NUMAAF),AVE,ADEV,SDEV,VAR,SKEW,CURT) 



      DO 100 IAA=1,NUMAAT





         CALL FCONAA (IAA,2.0,.TRUE.)



         DO 95 ICONT=1,NUMCONIAA
            JAA=CONIAA(ICONT)
            IF (JAA.GT.NUMAAT) GOTO 95
            JSYM=CONSYMAA(ICONT)
            ISYM=SYMNEG(JSYM)




            IF (.NOT.WIFIRW(IAA).AND.JSYM.EQ.1.AND.IAA.EQ.JAA) GOTO 95



            DO 90 IAT=PNTAAS(IAA),PNTAAE(IAA)
               IF (.NOT.ISATOK(IAT)) GOTO 90
               TMP(1)=XCOORD(IAT)
               TMP(2)=YCOORD(IAT)
               TMP(3)=ZCOORD(IAT)
               IF (ISYM.GT.1) THEN
                  CALL GVSMPV (TMP,SYMMAT(1,1,ISYM),SYMVEC(1,ISYM))
               END IF
               DO 85 JAT=PNTAAS(JAA),PNTAAE(JAA)
                  IF (.NOT.ISATOK(JAT)) GOTO 85
                  IF (JAT.LE.IAT) GOTO 85
                  IF (ISYM.EQ.1.AND.JAT.EQ.IAT) GOTO 85



                  CALL PDBC04A (IAT,JAT,TMP,ISYM,JSYM,ERROR,NUCDST,
     +             ISBUMP,ISHBO,IS13,IS14)



                  IF (ISBUMP) THEN
                     F=1.0
                     IF (ISHBO) THEN
                        ISHBO=HBOQVAL(IAT,JAT,JSYM).GT.0.0.OR.
     +                        HBOQVAL(JAT,IAT,ISYM).GT.0.0
                     END IF
                     IF (JSYM.EQ.1) THEN
                        CALL GVSSTX (SYMT,'INTRA')
                     ELSE
                        CALL GVSSTX (SYMT,'INTER')
                     END IF
                     IF (ISHBO) THEN
                        CALL GVSSTX (REASN,'HB')
                        F=1.5
                     ELSE IF (IS13) THEN
                        CALL GVSSTX (REASN,'B2')
                        F=3.0
                     ELSE IF (IS14) THEN
                        CALL GVSSTX (REASN,'B3')
                        F=2.0
                     ELSE
                        CALL GVSCTB (REASN,2)
                     END IF
                     IF (XBFACT(IAT)+XBFACT(JAT).GT.80.0) THEN
                        CALL GVSSTX (REASN,'BF')
                        F=5.0
                     END IF
                     IF ((XBFACT(IAT).LT.20.0.AND.
     +                    XBFACT(JAT).LT.20.0).OR.
     +                   (XBFACT(IAT).LT.AVE.AND.
     +                    XBFACT(JAT).LT.AVE)) THEN
                        CALL GVSSTX (REASN,'BL')
                        F=0.25
                     END IF
                     CALL PDBS50 (IAT,JAT,0,0,4.0*ERROR,0.01,F)
                     CALL PDBC92A (JAA,JAT)
                     CALL GVSSTX (JATS,LINE92(1:28))
                     CALL PDBC92A (IAA,IAT)
                     CALL GVSSTX (IATS,LINE92(1:28))
                     IF (WIFPAR(279).NE.0) THEN
                        WRITE (LINE92,PDBFMT,ERR=999) IATS,JATS,ERROR,
     +                   NUCDST,SYMT,REASN
                     ELSE
                        IF (WIFPAR(1012).GE.1) THEN
                           WRITE (6,*,ERR=999) IATS,JATS,ERROR,
     +                      NUCDST,SYMT,REASN
                        END IF
                     END IF
                     IF (IBIG.LT.10000) THEN
                        IBIG=IBIG+1
                        CALL GVSSTX (BIGCHR(IBIG),LINE92)
                        BIGVAL(IBIG)=ERROR
                        TAG(IBIG)=IBIG
                     END IF
                     PRPVAL(IAA)=PRPVAL(IAA)+ERROR
                     PRPVAL(JAA)=PRPVAL(JAA)+ERROR
                     GENRVL(47)=GENRVL(47)+ERROR
                     GENRVL(48)=GENRVL(48)+1.0/FLOAT(NUMAAF)
                  END IF
   85          CONTINUE
   90       CONTINUE
   95    CONTINUE
  100 CONTINUE
      IF (IBIG.GE.2) THEN



         CALL GVSDRT (BIGVAL,IBIG,TAG)



         IF (IBIG.GT.4.AND.BIGVAL(5).GT.0.5) WIFPAR(942)=WIFPAR(942)+1



         DO 300 I=1,IBIG
            CALL PDBC93 (BIGCHR(TAG(I)))
 300     CONTINUE
      END IF



      DO 400 IAA=1,NUMAAT
         IF (PRPVAL(IAA).LT.0.001) PRPVAL(IAA)=-1000.0
  400 CONTINUE



      CALL CDB012



      CALL ESPKIL (270001,270000+250000,43,'SC7002')



      GOTO 998



  999 CONTINUE
      CALL GVSEIW ('SC7002')
      CALL GVST6C ('?M5122',PDBFMT,.FALSE.)
      CALL GVST6C ('?M5121',IATS,.FALSE.)
      CALL GVST6C ('?M5123',JATS,.FALSE.)
      CALL GVST6C ('?M5124',SYMT,.FALSE.)
      CALL GVST6C ('?M5125',REASN,.FALSE.)
      CALL GVSTTR2('?M5126',ERROR,NUCDST)



  998 CONTINUE
      IF (WIFPAR(1296).NE.0) CALL WIFPOPPPP (590)


      RETURN
      END
      SUBROUTINE SC7003 (CHABMP)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       ISOUP, JSOUP, IAA, JAA, IAT, JAT
      REAL          D12
      LOGICAL       CHABMP, WIFISW











      CHABMP=.FALSE.



      DO 100 ISOUP=1,NUMSOU-1
         IF (WIFISW(ISOUP)) GOTO 100



         DO 90 JSOUP=ISOUP+1,NUMSOU
            IF (WIFISW(JSOUP)) GOTO 90
            IF (CHANAM(SOUADM(1,ISOUP)).EQ.
     +          CHANAM(SOUADM(1,JSOUP))) GOTO 90
            IF (MODNMB(ISOUP).NE.MODNMB(JSOUP)) GOTO 90



            DO 80 IAA=SOUADM(1,ISOUP),SOUADM(2,ISOUP)



               DO 70 JAA=SOUADM(1,JSOUP),SOUADM(2,JSOUP)



                  D12=SQRT((SPHRAD(1,IAA)-SPHRAD(1,JAA))**2+
     +                     (SPHRAD(2,IAA)-SPHRAD(2,JAA))**2+
     +                     (SPHRAD(3,IAA)-SPHRAD(3,JAA))**2)-
     +                      SPHRAD(4,IAA)-SPHRAD(4,JAA)
                  IF (D12.GT.-1.0) GOTO 70



                  DO 60 IAT=PNTAAS(IAA),PNTAAE(IAA)
                     IF (.NOT.ISATOK(IAT).OR.PROTON(IAT)) GOTO 60
                     DO 50 JAT=PNTAAS(JAA),PNTAAE(JAA)
                        IF (.NOT.ISATOK(JAT).OR.PROTON(JAT)) GOTO 50



                        D12=SQRT((XCOORD(IAT)-XCOORD(JAT))**2+
     +                           (YCOORD(IAT)-YCOORD(JAT))**2+
     +                           (ZCOORD(IAT)-ZCOORD(JAT))**2)
                        IF (D12.GT.VDWRAD(IAT)+VDWRAD(JAT)-1.3) THEN
                           GOTO 50
                        ELSE IF (D12.GT.1.1) THEN
                           CHABMP=.TRUE.
                           GOTO 998
                        END IF
 50                  CONTINUE
 60               CONTINUE
 70            CONTINUE
 80         CONTINUE
 90      CONTINUE
 100  CONTINUE



  998 CONTINUE


      RETURN
      END
