



      SUBROUTINE HB2INI




















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       IAA, IAT, IDON, IAMB, JPA, LAST1504
      LOGICAL       ESPBAD
      SAVE          LAST1504
      DATA          LAST1504 /-1/








      CALL WIFPUSHPPP (166,1)
      IF (HB2IDN.AND.WIFPAR(1504).EQ.LAST1504) THEN
         IF (ESPBAD(HB2ES0,HB2ESZ,1)) THEN
            CALL GVSTT6 ('?M1010')
            HB2IDN=.FALSE.
         END IF
      END IF



      IF (HB2IDN.AND.WIFPAR(1504).EQ.LAST1504) GOTO 998
      LAST1504=WIFPAR(1504)





      CALL GVSRT0 (ESPACE(HB2ES0),HB2ESZ-HB2ES0+1)



      CALL ESPSET (HB2ES0,HB2ESZ,1)
      IF (WIFPAR(933).GE.0) CALL GVSTT6 ('?NEWT604')
      CALL GVSBTF (HB2FLX,MAXAA)



      CALL HB2INI6




      HB2EVA=0



      NUMWHB=0



      NUMFIX=0
      NUMFFX=0



      CALL HB2INI9



      CALL CHI004




      CALL HB2INI0







      CALL HBO010




      IF (HBODBG) CALL GVSTTU (17,'?M4489')
      CALL HB2INI2B



      IF (HBODBG) CALL GVSTTU (17,'?M4490')
      CALL HB2INI2C




      IF (HBODBG) CALL GVSTTU (17,'?M4491')
      CALL HB2DAT



      IF (HBODBG) CALL GVSTTU (17,'?M4492')
      CALL HB2INI1




      IF (NAMB2.GT.0) CALL GVSIT0 (HB2DON,NAMB2)
      CALL GVSIT0 (DONAMB,MAXDON)
      CALL GVSIT0 (ATDON, NUMATF)
      CALL GVSIT0 (INXYZH,MAXDON)
      CALL GVSIT0 (NUXYZH,MAXDON)






      IF (HBODBG) CALL GVSTTU (17,'?M4493')
      CALL HB2INI1A



      IF (HBODBG) CALL GVSTTU (17,'?M4494')
      CALL HB2INI2D



      IF (HBODBG) CALL GVSTTU (17,'?M4495')
      CALL HB2INI2



      IF (HBODBG) CALL GVSTTU (17,'?M4496')
      CALL HB2INI2A







      CALL FCONAA (1,FLOAT(WIFPAR(481))/100.0-1.0,.TRUE.)
      IF (WIFPAR(590).GT.0) WIFPAR(592)=1



      IF (HBODBG) CALL GVSTTU (17,'?M4497')
      CALL HB2INI3



      IF (HBODBG) CALL GVSTTU (17,'?M4498')
      CALL HB2INI4



      IF (HBODBG) CALL GVSTTU (17,'?M4499')
      CALL HB2IGR



      IF (WIFPAR(933).GE.0) CALL GVSTT6 ('?NEWT605')
      IF (HBODBG) CALL GVSTTU (17,'?M4500')
      CALL HB2MET



      IF (WIFPAR(933).GE.0) CALL GVSTT6 ('?NEWT606')
      IF (HBODBG) CALL GVSTTU (17,'?M4501')
      CALL FILLHARR




      HB2IDN=.TRUE.



      TOTVAL=0.0
      IF (NUMDON.GT.0) CALL GVSRT0 (HB2DVA,NUMDON)



      IF (HBODBG) CALL GVSTTU (17,'?M4502')
      DO 700 IAMB=1,NAMB1
         IAA=HB2IAA(IAMB)
         IF (IAA.LE.0) GOTO 700
         DO 690 IDON=INDON(IAA)+1,INDON(IAA)+NUDON(IAA)-1
            IF (NUPA(IDON).GT.0) GOTO 700
 690     CONTINUE
         DO 695 JPA=1,NUMTPA
            IAT=ARPAAT(JPA)
            IF (ATIAA(IAT).EQ.IAA.AND.IAT.GT.PNTAAS(IAA)+3) GOTO 700
 695     CONTINUE
         IF (WIFPAR(933).GE.0) CALL DIF008 ('?HB2FMT11',IAA)
         HB2AMB(IAMB)=1
 700  CONTINUE




      DO 800 IAMB=NAMB1+1,NAMB2
         IDON=HB2DON(IAMB)
         IF (IDON.LE.0) GOTO 800
         IF (NUPA(IDON).EQ.0.AND.HB2GRP(IDON).EQ.0) THEN
            IAT=HB2IAT(IAMB)
            IAA=HB2IAA(IAMB)



            DO 795 JPA=1,NUMTPA
               IF (ARPAAT(JPA).EQ.IAT) GOTO 800
 795        CONTINUE



            IF (WIFPAR(933).GE.0) CALL DIF015 (6,'?HB2FMT12',IAT)



            CALL HB2XYZ (IAMB)



            HB2AMB(IAMB)=1
         END IF
 800  CONTINUE




      IF (HBODBG) CALL GVSTTU (17,'?M4503')
      DO 21 IDON=1,NUMDON
         CALL FILL1ACC (IDON)
 21   CONTINUE



      IF (HBODBG) CALL GVSTTU (17,'?M4504')
      CALL HB2IFL



  998 CONTINUE
      CALL WIFPOPPPP (166)



      RETURN
      END
      SUBROUTINE HB2INI0



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'CHIANG.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       IAA, JAT1, JAT2
      REAL          GVFRTD







      NAMB1=0



      DO 100 IAA=1,NUMAAF
         IF (RESTYP(IAA).EQ.7) THEN
            IF (HBODBG) CALL GVSTTU (17,'?M4505')



            NAMB1=NAMB1+1
            HB2IAA(NAMB1)=IAA
            HB2ANG(NAMB1)=5
            HB2ORG(NAMB1)=GVFRTD(CHIANG(5,IAA))
            HB2POS(NAMB1)=1
            HB2BES(NAMB1)=1
            HB2AMB(NAMB1)=2
            IF (WIFPAR(933).GT.0) CALL DIF008 ('?M1229',IAA)
         ELSE IF (RESTYP(IAA).EQ.14) THEN
            IF (HBODBG) CALL GVSTTU (17,'?M4506')
            JAT1=BOUND_TO(1,PNTAAS(IAA)+7)
            JAT2=BOUND_TO(1,PNTAAS(IAA)+8)
            IF (JAT1.GT.0) THEN
               IF (PROTON(JAT1)) JAT1=0
            END IF
            IF (JAT2.GT.0) THEN
               IF (PROTON(JAT2)) JAT2=0
            END IF
            IF (JAT1.NE.0.OR.JAT2.NE.0) THEN



               CALL DIF008 ('?M2605',IAA)
               IF (JAT1.NE.0) CALL DIF008 ('?M2606',ATIAA(JAT1))
               IF (JAT2.NE.0) CALL DIF008 ('?M2606',ATIAA(JAT2))
            ELSE



               NAMB1=NAMB1+1
               HB2IAA(NAMB1)=IAA
               HB2ANG(NAMB1)=6
               HB2ORG(NAMB1)=GVFRTD(CHIANG(6,IAA))
               HB2POS(NAMB1)=1
               HB2BES(NAMB1)=1
               HB2AMB(NAMB1)=2
               IF (WIFPAR(933).GT.0) CALL DIF008 ('?M1230',IAA)
            END IF
         ELSE IF (RESTYP(IAA).EQ.12) THEN
            IF (HBODBG) CALL GVSTTU (17,'?M4507')
            JAT1=BOUND_TO(1,PNTAAS(IAA)+6)
            JAT2=BOUND_TO(1,PNTAAS(IAA)+7)
            IF (JAT1.GT.0) THEN
               IF (PROTON(JAT1)) JAT1=0
            END IF
            IF (JAT2.GT.0) THEN
               IF (PROTON(JAT2)) JAT2=0
            END IF
            IF (JAT1.NE.0.OR.JAT2.NE.0) THEN



               CALL DIF008 ('?M2605A',IAA)
               IF (JAT1.NE.0) CALL DIF008 ('?M2606',ATIAA(JAT1))
               IF (JAT2.NE.0) CALL DIF008 ('?M2606',ATIAA(JAT2))
            ELSE



               NAMB1=NAMB1+1
               HB2IAA(NAMB1)=IAA
               HB2ANG(NAMB1)=5
               HB2ORG(NAMB1)=GVFRTD(CHIANG(5,IAA))
               HB2POS(NAMB1)=1
               HB2BES(NAMB1)=1
               HB2AMB(NAMB1)=2
               IF (WIFPAR(933).GT.0) CALL DIF008 ('?M1231',IAA)
            END IF
         END IF
 100  CONTINUE
      IF (WIFPAR(933).GE.0) CALL GVSTTI ('?NEWZ117',NAMB1)      





      RETURN
      END
      SUBROUTINE HB2INI1



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HBONDS.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       IAA, IAT, TP, NAMB2TMP
      LOGICAL       WIFIRW, HBO011, T54EQUAL







      NAMB2=NAMB1
      IF (WIFPAR(933).GE.0) CALL GVSTT6 ('?NEWT611')



      DO 120 IAA=1,NUMAAT



         IF (WIFIRW(IAA)) THEN
            IF (HBODBG) CALL GVSTTU (17,'?M4508')
            NAMB2TMP=NAMB2
            DO 109 IAT=PNTAAS(IAA),PNTAAE(IAA)
               IF (.NOT.PROTON(IAT).AND.ISATOK(IAT).AND.
     +             USABLE(IAT)) THEN
                  NAMB2TMP=NAMB2TMP+1
               END IF
               IF (NAMB2TMP.GT.MAXAMB) THEN
                  CALL GVSTTE ('?M1521')
                  GOTO 120
               END IF
  109       CONTINUE
            DO 110 IAT=PNTAAS(IAA),PNTAAE(IAA)
               IF (.NOT.PROTON(IAT).AND.ISATOK(IAT).AND.
     +             USABLE(IAT)) THEN
                  NAMB2=NAMB2+1
                  HB2IAA(NAMB2)=IAA
                  HB2IAT(NAMB2)=IAT
                  HB2TYP(NAMB2)=-1
                  HB2POS(NAMB2)=1
                  HB2BES(NAMB2)=1
                  HB2AMB(NAMB2)=MAXH2P
               END IF
 110        CONTINUE



         ELSE
            DO 115 IAT=PNTAAS(IAA),PNTAAE(IAA)
               IF (.NOT.PROTON(IAT).AND.ISATOK(IAT).AND.
     +             USABLE(IAT).AND.DONACC(IAT).GE.0) THEN
                  TP=HBOTYP(RESTYP(IAA),IAT-PNTAAS(IAA)+1)



                  IF (HBO011(IAA,IAT)) THEN
                     NAMB2=NAMB2+1
                     HB2IAA(NAMB2)=IAA
                     HB2IAT(NAMB2)=IAT
                     HB2TYP(NAMB2)=TP
                     HB2POS(NAMB2)=1
                     HB2BES(NAMB2)=1
                     HB2AMB(NAMB2)=HB2SER
                     GOTO 115
                  END IF 
                  IF (TP.EQ.4) THEN



                     NAMB2=NAMB2+1
                     HB2IAA(NAMB2)=IAA
                     HB2IAT(NAMB2)=IAT
                     HB2TYP(NAMB2)=TP
                     HB2POS(NAMB2)=1
                     HB2BES(NAMB2)=1
                     HB2AMB(NAMB2)=HB2SER
                  ELSE IF (TP.EQ.5) THEN



                     NAMB2=NAMB2+1
                     HB2IAA(NAMB2)=IAA
                     HB2IAT(NAMB2)=IAT
                     HB2TYP(NAMB2)=TP
                     HB2POS(NAMB2)=1
                     HB2BES(NAMB2)=1
                     HB2AMB(NAMB2)=HB2LYS
                  ELSE IF (TP.GE.6) THEN



                     NAMB2=NAMB2+1
                     HB2IAA(NAMB2)=IAA
                     HB2IAT(NAMB2)=IAT
                     HB2TYP(NAMB2)=TP



                     IF (.NOT.T54EQUAL(ONESAT(IAT),' NE2')) THEN
                        HB2BES(NAMB2)=2
                     ELSE
                        HB2BES(NAMB2)=1
                     END IF
                     HB2AMB(NAMB2)=2
                     HB2POS(NAMB2)=HB2BES(NAMB2)
                  END IF
               END IF
 115        CONTINUE
         END IF
 120  CONTINUE
      IF (WIFPAR(933).GE.0) CALL GVSTTI ('?NEWZ118',NAMB2-NAMB1)





      RETURN
      END
      SUBROUTINE HB2INI1A






















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HBONDS.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       IAA, IAMB, IAT, IDON, FIXED, TP
      REAL          XYZH(3), XYZB(3), XYZC(3)
      LOGICAL       REALH, WIFIRW, HBO011







      NUMDON=0
      NUMHAR=0
      IF (WIFPAR(933).GE.0) CALL GVSTT6 ('?NEWT612')
      IAMB=NAMB1+1



      DO 140 IAA=1,NUMAAT
         IF (HBODBG) THEN
            WRITE (17,*,ERR=998) 'AT 1'
            CALL SHOUAA (17,IAA)
         END IF
         DO 130 IAT=PNTAAS(IAA),PNTAAE(IAA)
            IF (PROTON(IAT)) GOTO 130
            IF (HBODBG) THEN
               WRITE (17,*,ERR=998) 'HB2INI1A SET:', ONESA3(IAA),'(',
     +          NUMNAM(IAA),')',ONESAT(IAT),PROTON(IAT),ISATOK(IAT),
     +          USABLE(IAT),DONACC(IAT)
               IF (.NOT.ISATOK(IAT)) CALL SHOUAA (17,IAA)
            END IF



            IF (ISATOK(IAT).AND.USABLE(IAT).AND.DONACC(IAT).GE.0) THEN
               NUMDON=NUMDON+1
               IF (WIFIRW(IAA)) THEN
                  IF (HBODBG) WRITE (17,*,ERR=998) 'HB2INI1A:NUMDON->',
     +             NUMDON,ONESA3(IAA),'(',ORGNAM(IAT),')',ONESAT(IAT)
               ELSE
                  IF (HBODBG) WRITE (17,*,ERR=998) 'HB2INI1A:NUMDON->',
     +             NUMDON,ONESA3(IAA),'(',NUMNAM(IAA),')',ONESAT(IAT)
               END IF
               ATDON(IAT)=NUMDON
               IF (NUMDON.GT.MAXDON) CALL GVSTTE ('?NEWE639')
               IF (IAT.EQ.HB2IAT(IAMB)) THEN
                  HB2DON(IAMB)=NUMDON
                  DONAMB(NUMDON)=IAMB
                  IF (IAMB.LT.NAMB2) IAMB=IAMB+1
               END IF
               ARIATD(NUMDON)=IAT
               IF (HBODBG) WRITE (17,*,ERR=998) 'HB2INI1A: ARIATD',
     +          NUMDON,ONESA3(IAA),'(',NUMNAM(IAA),')',ONESAT(IAT),
     +          NUMHAR+1
               INXYZH(NUMDON)=NUMHAR+1
               IF (WIFIRW(IAA)) THEN



                  NUXYZH(NUMDON)=2
               ELSE



                  CALL HBO012 (IAT,XYZH,XYZB,XYZC,FIXED,REALH)
                  IF (HBODBG) WRITE (17,*,ERR=998) 'HB2INI1A: 12',
     +             ONESA3(IAA),'(',NUMNAM(IAA),')',ONESAT(IAT),
     +             FIXED,REALH
                  IF (FIXED.GT.0) THEN
                     NUXYZH(NUMDON)=FIXED
                  ELSE




                     TP=HBOTYP(RESTYP(IAA),IAT-PNTAAS(IAA)+1)
                     IF (TP.EQ.4) THEN
                        NUXYZH(NUMDON)=1
                     ELSE IF (TP.EQ.5) THEN
                        NUXYZH(NUMDON)=3
                     ELSE IF (HBO011(IAA,IAT)) THEN
                        NUXYZH(NUMDON)=1
                     ELSE
                        CALL GVSTTE ('?NEWE640')
                        CALL DIF015 (6,'?M0324',IAT)
                     END IF
                  END IF
               END IF



               NUMHAR=NUMHAR+NUXYZH(NUMDON)
               IF (HBODBG) WRITE (17,*,ERR=998) 'HB2INI1A: NUMHAR=',
     +          NUMHAR
               IF (NUMHAR.GT.MAXHAT) CALL GVSTTE ('?NEWE641')
            END IF
 130     CONTINUE
 140  CONTINUE
      CALL GVSTTI ('?NEWZ119',NUMDON)
      CALL GVSTTI ('?NEWZ120',NUMHAR)



      IAA=0
      CALL GVSITC (INDON,1,MAXAA)
      CALL GVSIT0 (NUDON,MAXAA)
      DO 180 IDON=1,NUMDON
         IAT=ARIATD(IDON)
         IF (ATIAA(IAT).GT.IAA) THEN
            IAA=ATIAA(IAT)
            INDON(IAA)=IDON
            NUDON(IAA)=1
         ELSE IF (IAA.EQ.ATIAA(IAT)) THEN
            NUDON(IAA)=NUDON(IAA)+1
         ELSE
            CALL GVSTTB ('?NEWB253')
         END IF
 180  CONTINUE
      IF (HBODBG) WRITE (17,*,ERR=998) 'INI1A: INDON',(INDON(IAA),
     + IAA=1,NUMAAF)
      IF (HBODBG) WRITE (17,*,ERR=998) 'INI1A: NUDON',(NUDON(IAA),
     + IAA=1,NUMAAF)



 998  CONTINUE


      RETURN
      END
      SUBROUTINE HB2INI2



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       IAA, IAT, IAMB, IATR
      REAL          ACCSAV(MAXTAT)
      LOGICAL       HB2FNK, T54EQUAL
      CHARACTER*23  IAAS, DIF001







      CALL GVSTT6 ('?NEWT609')
      CALL GVSRT0 (HB2PEN,MAXAMB)



      CALL ENVTOT



      DO 390 IAA=1,NUMAAT
         DO 380 IAT=PNTAAS(IAA),PNTAAE(IAA)
            XCOOR1(IAT)=XCOORD(IAT)
            XCOOR2(IAT)=XCOORD(IAT)
            YCOOR1(IAT)=YCOORD(IAT)
            YCOOR2(IAT)=YCOORD(IAT)
            ZCOOR1(IAT)=ZCOORD(IAT)
            ZCOOR2(IAT)=ZCOORD(IAT)
 380     CONTINUE
 390  CONTINUE



      DO 398 IAMB=1,NAMB1
         IAA=HB2IAA(IAMB)
         IF (HBODBG) WRITE (17,*,ERR=998) 'HB2INI2: IAMB=',IAMB,IAA,
     +    ONESA3(IAA),'(',NUMNAM(IAA),')',RESTYP(IAA)



         IF (RESTYP(IAA).EQ.7) THEN
            CALL WIF041 (IAA)
            IATR=0
            DO 500 IAT=PNTAAS(IAA),PNTAAE(IAA)
               IATR=IATR+1
               ACCSAV(IATR)=ACCESS(IAT)
               IF (HBODBG) WRITE (17,*,ERR=998) 'HB2INI2:',IAMB,
     +          ONESA3(IAA),'(',NUMNAM(IAA),')',ONESAT(IAT),ACCESS(IAT)
 500        CONTINUE
         END IF



         CALL CHI010 (IAA,HB2ANG(IAMB),HB2ORG(IAMB)+180.0)



         HB2PEN(IAMB)=DEFFLP




         IF (RESTYP(IAA).EQ.7) THEN
            CALL WIF041 (IAA)
            IATR=0
            DO 800 IAT=PNTAAS(IAA),PNTAAE(IAA)
               IF (PROTON(IAT)) GOTO 800
               IATR=IATR+1
               IF (T54EQUAL(ONESAT(IAT),' ND1').OR.
     +             T54EQUAL(ONESAT(IAT),' NE2')) THEN
                  IF (ACCSAV(IATR).GT.0.0.AND.ACCESS(IAT).LE.0.0) THEN
                     HB2PEN(IAMB)=HB2PEN(IAMB)+HB2EXV
                  END IF
                  IF (ACCSAV(IATR).LE.0.0.AND.ACCESS(IAT).GT.0.0) THEN
                     HB2PEN(IAMB)=HB2PEN(IAMB)-HB2EXV
                  END IF
                  CALL DIF015D (17,IAT,'Acc, Acc-alt, Pen=',ACCESS(IAT),
     +             ACCSAV(IATR),HB2PEN(IAMB))
                  CALL DIF015D (6,IAT,'Acc, Acc-alt, Pen=',ACCESS(IAT),
     +             ACCSAV(IATR),HB2PEN(IAMB))
               END IF
 800        CONTINUE
            IAAS=DIF001(IAA)
            CALL GVSFMT ('?M0325')
            WRITE (LINE,FMT,ERR=999) IAAS,HB2PEN(IAMB)
            IF (WIFPAR(363).EQ.0) CALL GVSTT6 (LINE)
            IF (HBODBG) CALL GVSTTU (17,LINE)
         ELSE IF (HB2FNK(IAA)) THEN
            HB2PEN(IAMB)=0.0
            IAAS=DIF001(IAA)
            CALL GVSFMT ('?M0325')
            WRITE (LINE,FMT,ERR=999) IAAS, HB2PEN(IAMB)
            IF (WIFPAR(363).EQ.0) CALL GVSTT6 (LINE)
            IF (HBODBG) CALL GVSTTU (17,LINE)
         END IF




         DO 395 IAT=PNTAAS(IAA),PNTAAE(IAA)
            XCOOR2(IAT)=XCOORD(IAT)
            YCOOR2(IAT)=YCOORD(IAT)
            ZCOOR2(IAT)=ZCOORD(IAT)
 395     CONTINUE



         CALL CHI010 (IAA,HB2ANG(IAMB),HB2ORG(IAMB))
 398  CONTINUE
      GOTO 998



  999 CONTINUE
      CALL GVSEIW ('HB2INI2')



  998 CONTINUE


      RETURN
      END
      SUBROUTINE HB2INI2A



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INCLUDE       'CNTINC.INC'
      INTEGER       ISOUP, JAA, JAT, ICON, ISYM, JSYM, SYMNEG
      REAL          ELMCHG, CUTACC







      CUTACC=WIFPAR(481)/100.0



      TOTPEN=0



      NUMPLU=0
      DO 100 ISOUP=1,NUMSOU
         IF (HBODBG) WRITE (17,*,ERR=998) 'HB2INI2A: ISOUP=',ISOUP



         IF (SOUADM(3,ISOUP).EQ.1) THEN
            JAA=SOUADM(2,ISOUP)
            DO 50 JAT=PNTAAS(JAA),PNTAAE(JAA)
               IF (PROTON(JAT)) GOTO 50



               IF (ELMCHG(JAT).GT.+0.5) THEN
                  CALL FCONAT (JAT,CUTACC-1.0)
                  IF (HBODBG) WRITE (17,*,ERR=998) 'HB2INI2A: FCON:',
     +             JAA,ONESA3(JAA),'(',NUMNAM(JAA),')',ONESAT(JAT),
     +             NUMCONIAT
                  JSYM=0
                  IF (NUMCONIAT.GT.0) THEN
                     DO 25 ICON=1,NUMCONIAT
                        ISYM=CONSYMAT(ICON)
                        IF (ISYM.GT.JSYM) THEN
                           IF (NUMPLU.GE.MAXPLU) THEN
                              CALL GVSTTE ('?NEWE636')
                              GOTO 998
                           END IF
                           NUMPLU=NUMPLU+1
                           POSIAT(NUMPLU)=JAT
                           POSSYM(NUMPLU)=SYMNEG(ISYM)
                        ELSE IF (ISYM.LT.JSYM) THEN
                           CALL GVSTTB ('?NEWB251')
                        END IF
                        JSYM=ISYM
 25                  CONTINUE
                  END IF
               END IF
 50         CONTINUE
         END IF
 100  CONTINUE
      CALL GVSTTI ('?M0326',NUMPLU)



  998 CONTINUE


      RETURN
      END
      SUBROUTINE HB2INI2B



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'HBONDS.INC'
      INTEGER       ISOUP, JAA, JAT
      REAL          ELMCHG







      DO 100 ISOUP=1,NUMSOU
         IF (HBODBG) WRITE (17,*,ERR=998) 'HB2INI2B: ISOUP=',ISOUP



         IF (SOUADM(3,ISOUP).EQ.1) THEN
            JAA=SOUADM(2,ISOUP)
            DO 50 JAT=PNTAAS(JAA),PNTAAE(JAA)
               IF (PROTON(JAT)) GOTO 50



               IF (ELMCHG(JAT).LT.-0.5) THEN
                  IF (HBODBG) WRITE (17,*,ERR=998) 'HB2INI2B:',JAA,
     +             ONESA3(JAA),'(',NUMNAM(JAA),')',ONESAT(JAT),
     +             ELMCHG(JAT)
                  IF (.NOT.USABLE(JAT)) THEN
                     USABLE(JAT)=.TRUE.
                     DONACC(JAT)=-1
                     CALL DIF015A (JAT,'?NEWT610')
                  END IF
               END IF
 50         CONTINUE
         END IF
 100  CONTINUE



 998  CONTINUE


      RETURN
      END
      SUBROUTINE HB2INI2C



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'HBONDS.INC'
      INTEGER       ISOUP, IAA, IAT, JAT
      LOGICAL       WIFITI, WIFISA, WIFIRO







      DO 100 ISOUP=1,NUMSOU
         IF (HBODBG) WRITE (17,*,ERR=998) 'HB2INI2C: ISOUP=',ISOUP



         IF (WIFISA(ISOUP)) THEN



            IAA=SOUADM(2,ISOUP)
            IAT=PNTAAS(IAA)+2
            IF (ATIAA(IAT).NE.IAA) THEN
               CALL GVSTTB ('?NEWB252')
               GOTO 998
            ELSE



               JAT=BOUND_TO(1,IAT)
               IF (.NOT.WIFITI(JAT)) THEN
                  CALL GVSTTI ('?NEWZ113',IAA)
               ELSE IF (.NOT.USABLE(JAT)) THEN
                  IF (WIFIRO(ATIAA(JAT))) THEN
                     IF (HBODBG) CALL GVSTUI (17,'?NEWZ114',IAA)
                     CALL GVSTTI ('?NEWZ114',IAA)
                     USABLE(JAT)=.TRUE.
                     DONACC(JAT)=-1
                  ELSE
                     CALL GVSTTI ('?NEWZ115',IAA)
                     CALL DIF015 (6,'?M1453',JAT)
                     CALL SHOIAA (IAA)
                  END IF
               END IF
            END IF
         END IF
 100  CONTINUE



  998 CONTINUE


      RETURN
      END
      SUBROUTINE HB2INI2D



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INCLUDE       'HBONDS.INC'
      INCLUDE       'HGRINC.INC'
      INTEGER       IAA, IDON, IAT, IRT, RIAT, IGRP







      NUMHGR=0
      CALL GVSIT0 (HB2GRP,MAXDON)
      CALL GVSIT0 (HB2GRT,MAXHGR)
      CALL GVSIT0 (HB2GRC,MAXHGR)



      DO 100 IAA=1,NUMAAT
         IRT=RESTYP(IAA)
         IF (IRT.EQ.0) GOTO 100
         IF (HGRAAN(IRT).GT.0) THEN
            IF (HBODBG) WRITE (17,*,ERR=998) 'HB2INI2D: IAA=',IAA,
     +       ONESA3(IAA),'(',NUMNAM(IAA),')',IRT



            DO 90 IGRP=1,HGRAAN(IRT)



               IF (NUMHGR.GE.MAXHGR) THEN
                  CALL GVSTTE ('?NEWE637')
                  GOTO 998
               END IF
               NUMHGR=NUMHGR+1
               IF (HBODBG) WRITE (17,*,ERR=998) 'HB2INI2D: NUMHGR=',
     +          NUMHGR,IAA,ONESA3(IAA),'(',NUMNAM(IAA),')'
               HB2GRT(NUMHGR)=HGRAAS(IRT)+IGRP-1
               RIAT=0



               DO 80 IAT=PNTAAS(IAA),PNTAAE(IAA)
                  IF (PROTON(IAT)) GOTO 80
                  RIAT=RIAT+1



                  IF (HGRATI(IRT,RIAT).EQ.IGRP) THEN



                     IF (HBOTYP(IRT,RIAT).GE.6) THEN
                        IF (ISATOK(IAT).AND.USABLE(IAT)) THEN
                           IDON=ATDON(IAT)
                           IF (IDON.GT.0) HB2GRP(IDON)=NUMHGR
                        END IF
                     ELSE
                        CALL GVSTTE ('?NEWE638')
                        CALL SHOIAA (IAA)
                        CALL GVSTTI ('?M4509',IGRP)
                        CALL GVST6C ('?M4510',ONESAT(IAT),.TRUE.)
                     END IF
                  END IF
 80            CONTINUE
 90         CONTINUE
         END IF
 100  CONTINUE
      CALL GVSTTI ('?NEWZ116',NUMHGR)
      IF (WIFPAR(590).EQ.0) THEN
         CALL GVSTT6 ('?M5154')
      ELSE
         CALL GVSTT6 ('?M5155')
      END IF



  998 CONTINUE


      RETURN
      END
      SUBROUTINE HB2INI3



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'CNTINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HBONDS.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       IAA, IAT, JAA, JAT, IDON, ISYM, ICON, LASTIAA
      REAL          CUTACC
      LOGICAL       HB2ISPA, HB2TRN, WIFIRW







      CALL GVSTT6 ('?NEWT608')



      NUMTPA=0
      CUTACC=WIFPAR(481)/100.0
      LASTIAA=0



      IF (HBODBG) WRITE (17,*,ERR=998) 'HB2INI3: NUMDON=',NUMDON
      DO 400 IDON=1,NUMDON
         IAT=ARIATD(IDON)
         IF (PROTON(IAT)) GOTO 400
         IAA=ATIAA(IAT)
         IF (HBODBG) THEN
            IF (WIFIRW(IAA)) THEN
               WRITE (17,*,ERR=998) ONESAT(IAT),ORGNAM(IAT)
            ELSE
               CALL DIF015E (17,IAT,'?M4511')
            END IF
         END IF



         IF (IAA.NE.LASTIAA) CALL FCONAA (IAA,CUTACC-1.0,.TRUE.)
         IF (NUMCONIAA.LE.0) GOTO 400
         LASTIAA=IAA
         INPA(IDON)=NUMTPA+1
         NUPA(IDON)=0
         IF (HBODBG) THEN
            WRITE (17,*,ERR=998) 'HB2INI3: NUMCONIAA=',NUMCONIAA
            IF (.NOT.WIFIRW(IAA)) THEN
               WRITE (17,*,ERR=998) (CONIAA(ICON),ICON=1,NUMCONIAA-1)
               WRITE (17,*,ERR=998) (ONESA3(CONIAA(ICON)),ICON=1,
     +          NUMCONIAA-1)
            END IF
         END IF



         DO 450 ICON=1,NUMCONIAA
            JAA=CONIAA(ICON)
            ISYM=CONSYMAA(ICON)



            DO 420 JAT=PNTAAS(JAA),PNTAAE(JAA)
               IF (PROTON(JAT)) GOTO 420
               IF (HBODBG) THEN
                  IF (WIFIRW(JAA)) THEN
                     WRITE (17,*,ERR=998) 'INI3:',isym,onesa3(jaa),
     +                orgnam(jat),onesat(jat),isatok(jat),proton(jat),
     +                usable(jat),donacc(jat)
                  ELSE
                     WRITE (17,*,ERR=998) 'INI3:',isym,jaa,onesa3(jaa),
     +                onesat(jat),isatok(jat),proton(jat),usable(jat),
     +                donacc(jat)
                  END IF
               END IF
               IF (ISATOK(JAT).AND.USABLE(JAT).AND.DONACC(JAT).LE.0)THEN
                  IF (HB2ISPA(IAT,JAT,ISYM)) THEN
                     GOTO 433
                  END IF
                  IF (HB2TRN(IAA)) THEN
                     CALL HB2COOR (IAA,2)
                     IF (HB2ISPA(IAT,JAT,ISYM)) THEN
                        CALL HB2COOR (IAA,1)
                        GOTO 433
                     END IF
                     IF (HB2TRN(JAA).AND.IAA.NE.JAA) THEN
                        CALL HB2COOR (JAA,2)
                        IF (HB2ISPA(IAT,JAT,ISYM)) THEN
                           CALL HB2COOR (IAA,1)
                           CALL HB2COOR (JAA,1)
                           GOTO 433
                        END IF
                        CALL HB2COOR (IAA,1)
                        IF (HB2ISPA(IAT,JAT,ISYM)) THEN
                           CALL HB2COOR (JAA,1)
                           GOTO 433
                        END IF
                        CALL HB2COOR (JAA,1)
                     ELSE
                        CALL HB2COOR (IAA,1)
                     END IF
                  ELSE IF (HB2TRN(JAA)) THEN
                     CALL HB2COOR (JAA,2)
                     IF (HB2ISPA(IAT,JAT,ISYM)) THEN
                        CALL HB2COOR (IAA,1)
                        CALL HB2COOR (JAA,1)
                        GOTO 433
                     END IF
                     CALL HB2COOR (JAA,1)
                  END IF
                  GOTO 434
 433              CONTINUE
                  NUMTPA=NUMTPA+1
                  IF (NUMTPA.GT.MAXTPA) THEN
                     CALL GVSTTB ('?HB2M008')
                     GOTO 998
                  END IF
                  NUPA(IDON)=NUPA(IDON)+1
                  ARPAAT(NUMTPA)=JAT
                  ARPAIS(NUMTPA)=ISYM
 434              CONTINUE
               END IF
 420        CONTINUE
 450     CONTINUE
 400  CONTINUE
      CALL GVSTTI ('?NEWZ111',NUMTPA)



  998 CONTINUE


      RETURN
      END
      SUBROUTINE HB2INI4



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HBONDS.INC'
      INCLUDE       'HB2INC.INC'
      INCLUDE       'CNTINC.INC'
      INTEGER       IAA, IAMB, IAT, JAA, JDON, JPA, JCON, JSYM, 
     +              SYMNEG, PREVIAA
      REAL          CUTACC







      CALL GVSTT6 ('?NEWT613')
      NUMTAD=0
      PREVIAA=0
      CUTACC=WIFPAR(481)/100.0



      DO 200 IAMB=1,NAMB1
         IAA=HB2IAA(IAMB)
         INAD(IAMB)=NUMTAD+1
         NUAD(IAMB)=0



         IF (IAA.NE.PREVIAA) CALL FCONAA (IAA,CUTACC-1.0,.FALSE.)
         PREVIAA=IAA
         DO 250 JCON=1,NUMCONIAA
            JAA=CONIAA(JCON)
            JSYM=SYMNEG(CONSYMAA(JCON))



            DO 210 IAT=PNTAAS(IAA)+4,PNTAAE(IAA)
               IF (PROTON(IAT)) GOTO 210
               IF (USABLE(IAT).AND.DONACC(IAT).LE.0) THEN



                  DO 220 JDON=INDON(JAA),INDON(JAA)+NUDON(JAA)-1



                     DO 214 JPA=INPA(JDON),INPA(JDON)+NUPA(JDON)-1
                        IF (ARPAAT(JPA).EQ.IAT.AND.
     +                      ARPAIS(JPA).EQ.JSYM) THEN
                           NUMTAD=NUMTAD+1
                           IF (NUMTAD.GT.MAXTAD) CALL GVSTTB ('?M0327')
                           NUAD(IAMB)=NUAD(IAMB)+1
                           ARAD(NUMTAD)=JDON
                           GOTO 220
                        END IF
 214                 CONTINUE
 220              CONTINUE
               END IF
 210        CONTINUE
 250     CONTINUE
 200  CONTINUE



      PREVIAA=0
      DO 300 IAMB=1+NAMB1,NAMB2
         IAA=HB2IAA(IAMB)
         IAT=HB2IAT(IAMB)
         INAD(IAMB)=NUMTAD+1
         NUAD(IAMB)=0



         IF (PREVIAA.NE.IAA) CALL FCONAA (IAA,CUTACC-1.0,.FALSE.)
         PREVIAA=IAA
         DO 350 JCON=1,NUMCONIAA
            JAA=CONIAA(JCON)
            JSYM=SYMNEG(CONSYMAA(JCON))



            DO 320 JDON=INDON(JAA),INDON(JAA)+NUDON(JAA)-1



               DO 314 JPA=INPA(JDON),INPA(JDON)+NUPA(JDON)-1
                  IF (ARPAAT(JPA).EQ.IAT.AND.ARPAIS(JPA).EQ.JSYM) THEN
                     NUMTAD=NUMTAD+1
                     IF (NUMTAD.GT.MAXTAD) CALL GVSTTB ('?M0328')
                     NUAD(IAMB)=NUAD(IAMB)+1
                     ARAD(NUMTAD)=JDON
                     GOTO 320
                  END IF
 314           CONTINUE
 320        CONTINUE
 350     CONTINUE
 300  CONTINUE
      CALL GVSTTI ('?NEWZ121',NUMTAD)





      RETURN
      END
      SUBROUTINE HB2INI6



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      REAL          V(3,MAXH2D), IDEAL, MINDST, DST, MIND2, MAXD2,
     +              GVFSIN, LOWDIS, DI(MAXH2P)
      INTEGER       K(2,MAXH2P), I, J, COUNT,
     +              ICNT, JCNT, I1, I2, J1, J2, NNEI, NLOWDIS
      LOGICAL       DONE(MAXH2P)
      COMMON        /WATHR/ V
      COMMON        /WATHI/ K








      IDEAL=2*GVFSIN(3.1415/180.0*112.0/2)



      CALL WIFPUSHPPP (6,-1)
      CALL WIF083
      CALL WIFPOPPPP (6)



      IF (WIFPAR(68).NE.MAXH2D) THEN
         CALL GVSTTB ('?NEWB238')
         GOTO 998
      END IF
      MINDST=2.0



      DO 10 I=2,WIFPAR(68)
         DST=(XUACC(I)-XUACC(1))**2+
     +        (YUACC(I)-YUACC(1))**2+
     +        (ZUACC(I)-ZUACC(1))**2
         MINDST=MIN(MINDST,DST)
 10   CONTINUE
      MINDST=SQRT(MINDST)




      MIND2=(IDEAL-MINDST/3.0)**2
      MAXD2=(IDEAL+MINDST/3.0)**2



      COUNT=0
      DO 30 I=1,WIFPAR(68)
         V(1,I)=XUACC(I)
         V(2,I)=YUACC(I)
         V(3,I)=ZUACC(I)
         DO 20 J=I+1,WIFPAR(68)
            DST=(XUACC(I)-XUACC(J))**2+
     +           (YUACC(I)-YUACC(J))**2+
     +           (ZUACC(I)-ZUACC(J))**2
            IF (DST.GT.MIND2.AND.DST.LT.MAXD2) THEN
               COUNT=COUNT+1
               K(1,COUNT)=I
               K(2,COUNT)=J
            END IF
 20      CONTINUE
 30   CONTINUE



      IF (COUNT.NE.MAXH2P) THEN
         CALL GVSTTB ('?NEWB239')
         GOTO 998
      END IF



      DO 32 ICNT=1,COUNT
         CALL GVSBTF (DONE,MAXH2P)
         DONE(ICNT)=.TRUE.
         I1=K(1,ICNT)
         I2=K(2,ICNT)
         DO 31 JCNT=1,COUNT
            J1=K(1,JCNT)
            J2=K(2,JCNT)
            DI(JCNT)=MIN(
     +           (V(1,I1)-V(1,J1))**2+(V(2,I1)-V(2,J1))**2+
     +           (V(3,I1)-V(3,J1))**2+(V(1,I2)-V(1,J2))**2+
     +           (V(2,I2)-V(2,J2))**2+(V(3,I2)-V(3,J2))**2,
     +           (V(1,I1)-V(1,J2))**2+(V(2,I1)-V(2,J2))**2+
     +           (V(3,I1)-V(3,J2))**2+(V(1,I2)-V(1,J1))**2+
     +           (V(2,I2)-V(2,J1))**2+(V(3,I2)-V(3,J1))**2)
 31      CONTINUE
         DO 33 NNEI=1,MAXH2N
            NLOWDIS=-1
            LOWDIS=99999.9
            DO 34 JCNT=1,COUNT
               IF (.NOT.DONE(JCNT)) THEN
                  IF (DI(JCNT).LT.LOWDIS) THEN
                     NLOWDIS=JCNT
                     LOWDIS=DI(JCNT)
                  END IF
               END IF
 34         CONTINUE
            IF (NLOWDIS.GT.0) THEN
               HB2H2N(NNEI,ICNT)=NLOWDIS
               DONE(NLOWDIS)=.TRUE.
            ELSE
               CALL GVSTTB ('?HB2M007')
               HB2H2N(NNEI,ICNT)=1
            END IF
 33      CONTINUE
 32   CONTINUE



  998 CONTINUE


      RETURN
      END
      SUBROUTINE HB2INI9



















      IMPLICIT      NONE 
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      CHARACTER*80  FILNAM
      CHARACTER*1   TYP
      INTEGER       IDT,IAT,IAR(18), ARD(40), ARA(18), IANG, ITOR, 
     +              IDIS, LUN, IERR
      LOGICAL       GVFFOP







      CALL GVSRT0 (HB2LUT,9*18*9*2)



      CALL SETFILNAM (FILNAM,'HBOFIELD.DAT',IERR)
      IF (IERR.NE.0) GOTO 999
      CALL GVSROF (LUN,IERR)
      IF (IERR.NE.0) GOTO 997
      CALL GVSOPF (FILNAM,LUN,'OLD')
      IF (.NOT.GVFFOP(LUN)) THEN
         CALL GVSTTE ('?NEWE642')
         GOTO 997
      END IF



   10 CONTINUE
      CALL GVSFMT ('?FMT1359')
      READ (LUN,FMT,END=999,ERR=998) TYP,IDT,IAT
      IF (TYP.EQ.'#') THEN
         CALL GVSFMT ('?FMT1360')
         DO 30 ITOR=1,9
            READ (LUN,FMT,END=998,ERR=998) IAR
            DO 20 IANG=1,18
               HB2LUT(IAT,IANG,ITOR,IDT)=FLOAT(IAR(IANG))/999.0
   20       CONTINUE
   30    CONTINUE
      ELSE IF (TYP.EQ.'A') THEN
         CALL GVSFMT ('?FMT1164')
         READ (LUN,FMT,END=998,ERR=998) ARA
         DO 40 IANG=1,18
            HB2AUT(IANG,IDT,IAT)=FLOAT(ARA(IANG))/999.0
   40    CONTINUE
      ELSE IF (TYP.EQ.'D') THEN
         CALL GVSFMT ('?FMT1164')
         READ (LUN,FMT,END=998,ERR=998) ARD
         DO 50 IDIS=1,40
            HB2DUT(IDIS,IDT,IAT)=FLOAT(ARD(IDIS))/999.0
   50    CONTINUE
      ELSE
         CALL GVSTTB ('?M0329')
      END IF
      GOTO 10



  998 CONTINUE
      CALL GVSTTB ('?NEWB259')



  999 CONTINUE
      CALL GVSCLF (LUN)



  997 CONTINUE


      RETURN
      END
      SUBROUTINE HB2INI9X



















      IMPLICIT      NONE 
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      CHARACTER*80  FILNAM
      CHARACTER*1   TYP
      INTEGER       IDT,IAT,IAR(18), ARD(40), ARA(18), IANG, ITOR, 
     +              IDIS, LUN, IERR
      LOGICAL       GVFFOP







      CALL GVSRT0 (HB2LUT,9*18*9*2)



      CALL SETFILNAM (FILNAM,'HBOFIELD.DAT',IERR)
      IF (IERR.NE.0) GOTO 999
      CALL GVSROF (LUN,IERR)
      IF (IERR.NE.0) GOTO 997
      CALL GVSOPF (FILNAM,LUN,'OLD')
      IF (.NOT.GVFFOP(LUN)) THEN
         CALL GVSTTE ('?NEWE642')
         GOTO 997
      END IF



   10 CONTINUE
      CALL GVSFMT ('?FMT818')
      READ (LUN,FMT,END=999) TYP,IDT,IAT
      IF (TYP.EQ.'#') THEN
         DO 30 ITOR=1,9
            CALL GVSFMT ('?FMT755')
            READ (LUN,FMT,END=998) IAR
            DO 20 IANG=1,18
               HB2LUT(IAT,IANG,ITOR,IDT)=FLOAT(IAR(IANG))/999.0
   20       CONTINUE
   30    CONTINUE
      ELSE IF (TYP.EQ.'A') THEN
         CALL GVSFMT ('?FMT519')
         READ (LUN,FMT,END=998) ARA
         DO 40 IANG=1,18
            HB2AUT(IANG,IDT,IAT)=FLOAT(ARA(IANG))/999.0
   40    CONTINUE
      ELSE IF (TYP.EQ.'D') THEN
         CALL GVSFMT ('?FMT519')
         READ (LUN,FMT,END=998) ARD
         DO 50 IDIS=1,40
            HB2DUT(IDIS,IDT,IAT)=FLOAT(ARD(IDIS))/999.0
   50    CONTINUE
      ELSE
         CALL GVSTTB ('?M0329')
      END IF
      GOTO 10



  998 CONTINUE
      CALL GVSTTB ('?NEWB259')



  999 CONTINUE
      CALL GVSCLF (LUN)



  997 CONTINUE


      RETURN
      END
      SUBROUTINE HB2IGR



















      IMPLICIT      NONE 
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INCLUDE       'HGRINC.INC'
      INTEGER       IDON, IGRP





      CALL GVSIT0 (HB2GRC,MAXHGR)
      CALL GVSTTI ('?M1232',NUMDON)
      DO 100 IDON=1,NUMDON
         IGRP=HB2GRP(IDON)
         IF (IGRP.GT.0) THEN
            HB2GRC(IGRP)=HB2GRC(IGRP)+NUXYZH(IDON)
         END IF
 100  CONTINUE
      PENGRP=0.0
      DO 200 IGRP=1,NUMHGR
         PENGRP=PENGRP+HGRPEN(HB2GRC(IGRP),HB2GRT(IGRP))
 200  CONTINUE





      RETURN
      END
      SUBROUTINE HB2IFL



















      IMPLICIT      NONE 
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       IAMB







      HB2FLP=0



      DO 10 IAMB=1,NAMB1
         IF (HB2POS(IAMB).GT.1) HB2FLP=HB2FLP+HB2PEN(IAMB)
 10   CONTINUE
      CALL GVSTTR ('?M2607',HB2FLP)





      RETURN
      END
      SUBROUTINE HB2DAT



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC' 
      INTEGER       IAT







      CALL GVSIT0 (HB2ACB,3*MAXAT)
      CALL GVSIT0 (HB2ACT,MAXAT)
























      DO 100 IAT=1,NUMATF
         IF (.NOT.PROTON(IAT)) CALL HB2DAT1 (IAT)
 100  CONTINUE





      RETURN
      END
      SUBROUTINE HB2DAT1 (IAT)



















      IMPLICIT      NONE 
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HBONDS.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       IAT, MAXNUM, NUM, JPNT, TARGET, ELMZ, IAA, JAT, I,J
      PARAMETER     (MAXNUM=8)
      INTEGER       JATARR(MAXNUM)
      LOGICAL       WIFIRW, T54EQUAL, PR







      IAA=ATIAA(IAT)
      PR=.FALSE.



      IF (.NOT.USABLE(IAT).OR.DONACC(IAT).GT.0.OR.PROTON(IAT)) 
     + GOTO 998



      CALL FBONDA (IAT,JATARR,MAXNUM,NUM)




      IF (ELMZ(IAT).EQ.8) THEN



         IF (NUM.EQ.1) THEN
            HB2ACB(1,IAT)=JATARR(1)



            IF (RESTYP(IAA).GT.0) THEN 
               IF (RESTYP(IAA).GT.0.AND.HBOTYP(RESTYP(IAA),IAT-
     +              PNTAAS(IAA)+1).LT.6.AND.DONACC(IAT).EQ.0) THEN



                  HB2ACT(IAT)=6
               ELSE



                  CALL FBONDA (HB2ACB(1,IAT),JATARR,MAXNUM,NUM)
                  IF (NUM.EQ.3) THEN
                     HB2ACT(IAT)=8
                     TARGET=1
                     DO 10 JPNT=1,NUM
                        IF (JATARR(JPNT).NE.IAT) THEN
                           TARGET=TARGET+1
                           IF (TARGET.LE.3) THEN
                              HB2ACB(TARGET,IAT)=JATARR(JPNT)
                           ELSE
                              CALL GVSTTB ('?M1454')
                              CALL DIF015 (6,'?M1455',IAT)
                              CALL DIF015 (6,'?M1456',HB2ACB(1,IAT))
                              CALL DIF015 (6,'?M1457',JATARR(1))
                              CALL DIF015 (6,'?M1457',JATARR(2))
                              CALL DIF015 (6,'?M1457',JATARR(3))
                           END IF
                        END IF
 10                  CONTINUE
                     IF (TARGET.NE.3) THEN
                        CALL GVSTTB ('?NEWB256')
                        HB2ACT(IAT)=9
                     END IF



                  ELSE IF (NUM.EQ.4.AND.(T54EQUAL(ONESAT(IAT),' OP1')
     +                .OR.T54EQUAL(ONESAT(IAT),' OP2'))) THEN
                     HB2ACT(IAT)=9
                  ELSE
                     HB2ACT(IAT)=9
                  END IF
               END IF

            ELSE








               CALL FBONDA (HB2ACB(1,IAT),JATARR,MAXNUM,NUM)
               IF (NUM.EQ.3) THEN
                  HB2ACT(IAT)=8
                  TARGET=1
                  DO 12 JPNT=1,NUM
                     IF (JATARR(JPNT).NE.IAT) THEN
                        TARGET=TARGET+1
                        IF (TARGET.LE.3) THEN
                           HB2ACB(TARGET,IAT)=JATARR(JPNT)
                        ELSE
                           CALL GVSTTB ('?M1454')
                           CALL DIF015 (6,'?M1455',IAT)
                           CALL DIF015 (6,'?M1456',HB2ACB(1,IAT))
                           CALL DIF015 (6,'?M1457',JATARR(1))
                           CALL DIF015 (6,'?M1457',JATARR(2))
                           CALL DIF015 (6,'?M1457',JATARR(3))
                        END IF
                     END IF
 12               CONTINUE
                  IF (TARGET.NE.3) THEN
                     CALL GVSTTB ('?NEWB256')
                     HB2ACT(IAT)=9
                  END IF



               ELSE IF (NUM.EQ.4.AND.(T54EQUAL(ONESAT(IAT),' OP1').OR.
     +             T54EQUAL(ONESAT(IAT),' OP2'))) THEN
                  HB2ACT(IAT)=9
               ELSE
                  HB2ACT(IAT)=9
               END IF
            END IF





         ELSE IF (NUM.EQ.0) THEN
            IF (WIFIRW(ATIAA(IAT))) THEN
               HB2ACT(IAT)=5
            ELSE
               PRINT *,'Loose atom!',ATIAA(IAT),IAT,ONESAT(IAT)
               PRINT*,'NUM/B=',NUM,(BOUND_TO(I,IAT),I=1,8)
               HB2ACT(IAT)=9
               CALL SHOSOU
               ATTVAL(IAT)=9.99
               CALL SHOIAA (ATIAA(IAT))
               CALL MOL010 ('?M4703')
               CALL GVSCODA ('AT 1')
            END IF




         ELSE IF (NUM.EQ.2) THEN
            HB2ACT(IAT)=7
            HB2ACB(1,IAT)=JATARR(1)
            HB2ACB(2,IAT)=JATARR(2)
         ELSE IF (NUM.GT.2) THEN
            IAA=ATIAA(IAT)
            CALL GVSTTI ('?NEWB257',NUM)
            CALL DEB012 ('In HBONDS2:')
            CALL SHOSOU
            PRINT*,'PROBLEM: res=',ONESA3(IAA),RESTYP(IAA),
     +       ONESAT(IAT),NUM
            CALL SHOIAA (IAA)
            PRINT*,'BOUND TO:'
            DO 15 JAT=1,NUM
               PRINT*,ONESA3(ATIAA(JATARR(JAT))),ONESAT(JATARR(JAT)),
     +          JATARR(JAT)
 15         CONTINUE

            CALL GVSCODA ('AT 2')
         END IF




      ELSE IF (ELMZ(IAT).EQ.7) THEN



         IF (NUM.EQ.2) THEN
            HB2ACT(IAT)=1
            HB2ACB(1,IAT)=JATARR(1)
            HB2ACB(2,IAT)=JATARR(2)
         ELSE IF (NUM.EQ.3) THEN
            HB2ACT(IAT)=2
            HB2ACB(1,IAT)=JATARR(1)
            HB2ACB(2,IAT)=JATARR(2)
            HB2ACB(3,IAT)=JATARR(3)
         ELSE IF (NUM.EQ.1) THEN
            HB2ACT(IAT)=4
            HB2ACB(1,IAT)=JATARR(1)
         ELSE
            CALL GVSTTB ('?NEWB258')
         END IF



      ELSE IF (ELMZ(IAT).EQ.16) THEN
         IF (NUM.EQ.1) THEN
            HB2ACT(IAT)=9
         ELSE IF (NUM.EQ.2) THEN
            HB2ACT(IAT)=7
            HB2ACB(1,IAT)=JATARR(1)
            HB2ACB(2,IAT)=JATARR(2)
         ELSE
            CALL GVSTTE ('?M0333')
            HB2ACT(IAT)=9
            CALL SHOIAA (ATIAA(IAT))
         END IF
      ELSE
         HB2ACT(IAT)=9
      END IF




  998 CONTINUE


      RETURN
      END
      SUBROUTINE HB2MET



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INCLUDE       'SYMINC.INC'
      INTEGER       IPLU, IAA, IAT, JAT, IATMIN, IAMB, ISYM
      REAL          MINDST, DST2, TMP(3)
      LOGICAL       T54EQUAL







      IF (NUMPLU.LE.0) THEN
         GOTO 998
      END IF
      DO 100 IPLU=1,NUMPLU
         JAT=POSIAT(IPLU)
         ISYM=POSSYM(IPLU)
         TMP(1)=XCOORD(JAT)
         TMP(2)=YCOORD(JAT)
         TMP(3)=ZCOORD(JAT)
         IF (ISYM.GT.1)CALL GVSMPV(TMP, SYMMAT(1,1,ISYM),SYMVEC(1,ISYM))
         DO 90 IAMB=1,NAMB1
            IAA=HB2IAA(IAMB)
            IF (RESTYP(IAA).EQ.7) THEN
               MINDST=25.0
               IATMIN=0
               DO 80 IAT=PNTAAS(IAA),PNTAAE(IAA)
                  IF (.NOT.PROTON(IAT).AND.ISATOK(IAT)) THEN
                     DST2=(TMP(1)-XCOORD(IAT))**2+
     +                    (TMP(2)-YCOORD(IAT))**2+
     +                    (TMP(3)-ZCOORD(IAT))**2
                     IF (DST2.LT.MINDST) THEN
                        MINDST=DST2
                        IATMIN=IAT
                     END IF
                  END IF
 80            CONTINUE
               MINDST=SQRT(MINDST)
               IF (MINDST.LT.3.0) THEN



                  IF (HB2AMB(IAMB).EQ.1) THEN
                     CONTINUE
                  ELSE
                     IF (T54EQUAL(ONESAT(IATMIN),' NE2').OR.
     +                   T54EQUAL(ONESAT(IATMIN),' ND1')) THEN
                        CALL HB2SEP (IAMB,1)
                        HB2AMB(IAMB)=1
                        CALL GVSFMT ('?M0335')
                        WRITE (LINE,FMT,ERR=998) IAA,1
                        CALL GVSTT6 (LINE)
                     ELSE IF (T54EQUAL(ONESAT(IATMIN),' CE1').OR.
     +                   T54EQUAL(ONESAT(IATMIN),' CD2')) THEN
                        CALL HB2SEP (IAMB,2)
                        HB2AMB(IAMB)=2
                        CALL GVSFMT ('?M0335')
                        WRITE (LINE,FMT,ERR=998) IAA,2
                        CALL GVSTT6 (LINE)
                     ELSE
                        CALL GVSTTI ('?M0334',IAA)
                     END IF
                  END IF
               END IF
            END IF
 90      CONTINUE
 100  CONTINUE



  998 CONTINUE


      RETURN
      END
      SUBROUTINE HB2RAN



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       IAMB, GVFIRN
      REAL          OLDFIT








      CALL HB2INI
      IF (NUMDON.EQ.0) GOTO 998
      DO 10 IAMB=1,NAMB1
         IF (HB2AMB(IAMB).GT.1) THEN
            CALL HB2SEP (IAMB,1+GVFIRN(HB2AMB(IAMB)))
         END IF
 10   CONTINUE
      DO 30 IAMB=NAMB1+1,NAMB2
         IF (HB2AMB(IAMB).GT.1) THEN
            CALL HB2SEP (IAMB,1+GVFIRN(HB2AMB(IAMB)))
         END IF
 30   CONTINUE
      CALL AREVAL (OLDFIT)
      IF (WIFPAR(933).GT.0) CALL GVSTTR ('?NEWZ110',OLDFIT)



  998 CONTINUE


      RETURN
      END
      SUBROUTINE HB2ST1



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       IAMB, IPOS, OLDPOS
      REAL          OLDFIT, FIT








      CALL HB2INI
      IF (NUMDON.EQ.0) GOTO 998



      CALL AREVAL (OLDFIT)

      DO 10 IAMB=1,NAMB2
         HB2BES(IAMB)=HB2POS(IAMB)
         IF (HB2AMB(IAMB).GT.1) THEN
            OLDPOS=HB2POS(IAMB)



            IF (HB2AMB(IAMB).EQ.2) THEN
               CALL HB2SEP (IAMB,3-OLDPOS)
               CALL AREVAL (FIT)
               IF (FIT.GT.OLDFIT) THEN
                  OLDFIT=FIT
                  HB2BES(IAMB)=3-OLDPOS
               ELSE
                  CALL HB2SEP (IAMB,OLDPOS)
               END IF



            ELSE IF (HB2AMB(IAMB).EQ.MAXH2P) THEN
               DO 14 IPOS=1,MAXH2N
                  CALL HB2SEP (IAMB,HB2H2N(IPOS,OLDPOS))
                  CALL AREVAL (FIT)
                  IF (FIT.GT.OLDFIT) THEN
                     OLDFIT=FIT
                     HB2BES(IAMB)=HB2H2N(IPOS,OLDPOS)
                  END IF
 14            CONTINUE
               CALL HB2SEP (IAMB,HB2BES(IAMB))



            ELSE
               IPOS=OLDPOS+1
               IF (IPOS.GT.HB2AMB(IAMB)) IPOS=1
               CALL HB2SEP (IAMB,IPOS)
               CALL AREVAL (FIT)
               IF (FIT.GT.OLDFIT) THEN
                  OLDFIT=FIT
                  HB2BES(IAMB)=IPOS
               ELSE
                  CALL HB2SEP (IAMB,OLDPOS)
               END IF
               IPOS=OLDPOS-1
               IF (IPOS.LT.1) IPOS=HB2AMB(IAMB)
               CALL HB2SEP (IAMB,IPOS)
               CALL AREVAL (FIT)
               IF (FIT.GT.OLDFIT) THEN
                  OLDFIT=FIT
                  HB2BES(IAMB)=IPOS
               ELSE
                  CALL HB2SEP (IAMB,OLDPOS)
               END IF
            END IF
         END IF
 10   CONTINUE



  998 CONTINUE


      RETURN
      END
      SUBROUTINE HB2STD



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      REAL          FIT, OLDFIT
      INTEGER       NCYC







      CALL AREVAL (OLDFIT)
      NCYC=1



 10   CONTINUE
      CALL HB2ST1
      CALL AREVAL (FIT)
      IF (FIT.GT.OLDFIT+0.01) THEN
         IF (NCYC.LT.10) THEN 
            OLDFIT=FIT
            NCYC=NCYC+1
            GOTO 10
         ELSE
            CALL GVSTTE ('?HB2M005')
            CALL GVSTTR2 ('?M0336',OLDFIT,FIT)
         END IF
      END IF

      CALL AREVAL (FIT)
      IF (WIFPAR(933).GT.0) CALL GVSTTR ('?NEWZ109',FIT)





      RETURN
      END
      SUBROUTINE HB2MCX



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       IAMB, ICYC, NSTEP
      REAL          VALUE, OLDFIT
      REAL          FIT, TFACT, LOGPOS, FRACC
      REAL          HB2FIT
      EXTERNAL      HB2FIT, HB2SEP
      LOGICAL       INTERRUPTED







      CALL HB2INI
      IF (NUMDON.EQ.0) GOTO 998



      CALL AREVAL (OLDFIT)



      CALL MCXINI (HB2POS,NAMB2,HB2AMB,LOGPOS)




      IF (LOGPOS.EQ.0) GOTO 998
      NSTEP=NINT(LOGPOS*LOG(10.)/LOG(2.))
      IF (WIFPAR(933).GT.0) CALL GVSTTI ('?M4704',NSTEP)



      DO 50 ICYC=1,WIFPAR(596)
         TFACT=FLOAT(WIFPAR(596)-ICYC)/FLOAT(WIFPAR(596))*0.20
         CALL MCXRUN (NSTEP,TFACT,HB2FIT,HB2SEP,FIT,FRACC)
         IF (INTERRUPTED()) GOTO 998
         IF (WIFPAR(933).GE.0) THEN
            IF (NSTEP.GT.100.AND.MOD(ICYC,10).EQ.0) THEN    
               CALL GVSFMT ('?HB2FMT9')
               WRITE (LINE,FMT,ERR=998) ICYC,WIFPAR(596)
               CALL GVSRDB (LINE)
               CALL GVSTO6 (LINE)
            END IF
         END IF
 50   CONTINUE



      CALL MCXRES (HB2BES)
      DO 100 IAMB=1,NAMB2
         IF (HB2AMB(IAMB).GT.1) CALL HB2SEP (IAMB,HB2BES(IAMB))
 100  CONTINUE
      CALL AREVAL (VALUE)
      IF (WIFPAR(933).GE.1) CALL GVSTTR ('?NEWZ102',VALUE)



  998 CONTINUE


      RETURN
      END
      SUBROUTINE HB2TRY



















      IMPLICIT      NONE 
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       MAXTRY
      PARAMETER     (MAXTRY=11)
      INTEGER       ITRY, BESTRY, IAMB, TRY(MAXAMB,MAXTRY), IAA, IAT,
     +              NP(MAXTRY),PP(MAXTRY), IPP, JPP, KPP
      REAL          VAL(MAXTRY), BESVAL, FIT
      LOGICAL       INTERRUPTED
      CHARACTER*23  IAAS, DIF001
      CHARACTER*28  IATS, DIF000
      EQUIVALENCE   (TRY,ESPACE(MAXESP-MAXAMB*MAXTRY))





      CALL ESPSET (MAXESP-MAXAMB*MAXTRY,MAXESP,54)
      DO 100 ITRY=1,MAXTRY
         IF (WIFPAR(933).GE.0) CALL GVSTTI ('?R00218',ITRY)
         CALL HB2RAN
         CALL HB2MCX
         CALL HB2STD
         DO 90 IAMB=1,NAMB2
            TRY(IAMB,ITRY)=HB2POS(IAMB)
 90      CONTINUE
         CALL AREVAL (VAL(ITRY))
         IF (INTERRUPTED()) GOTO 998
 100  CONTINUE



      BESVAL=-1000.0
      BESTRY=0
      DO 200 ITRY=1,MAXTRY
         IF (BESVAL.LT.VAL(ITRY)) THEN
            BESTRY=ITRY
            BESVAL=VAL(ITRY)
         END IF
 200  CONTINUE
      IF (WIFPAR(933).GT.0) CALL GVSTTR ('?HB2M006',BESVAL)



      DO 260 IAMB=1,NAMB2



         IF (HB2AMB(IAMB).GT.1) THEN
            IPP=1



            PP(IPP)=TRY(IAMB,1)
            NP(IPP)=1
            DO 250 ITRY=2,MAXTRY
               DO 240 JPP=1,IPP
                  IF (PP(JPP).EQ.TRY(IAMB,ITRY)) THEN
                     NP(JPP)=NP(JPP)+1
                     GOTO 250
                  END IF
 240           CONTINUE
               IPP=IPP+1
               PP(IPP)=TRY(IAMB,ITRY)
               NP(IPP)=1
 250        CONTINUE
            IF (IPP.EQ.MAXTRY.OR.IPP.EQ.1) THEN
               CALL HB2SEP (IAMB,TRY(IAMB,BESTRY))
            ELSE
               JPP=1
               DO 280 KPP=2,IPP
                  IF (NP(KPP).GT.NP(JPP)) JPP=KPP
 280           CONTINUE
               CALL HB2SEP (IAMB,PP(JPP))
            END IF



            IAA=HB2IAA(IAMB)
            IF (IPP.GT.1) THEN
               IF (IAMB.LE.NAMB1) THEN



                  HB2FLX(IAMB)=.TRUE.
                  IAAS=DIF001(IAA)
                  CALL GVSFMT ('?HB2FMT4')
                  WRITE (BIGLIN,FMT,ERR=998) IAAS,
     +             (TRY(IAMB,ITRY),ITRY=1,MAXTRY), HB2POS(IAMB)
               ELSE
                  IAT=HB2IAT(IAMB)

                  IATS=DIF000(IAT)
                  CALL GVSFMT ('?HB2FMT4')
                  WRITE (BIGLIN,FMT,ERR=998) IATS,
     +             (TRY(IAMB,ITRY),ITRY=1,MAXTRY), HB2POS(IAMB)
               END IF
               IF (WIFPAR(933).GE.1) CALL GVSTT6 (BIGLIN)
            END IF
         END IF
 260  CONTINUE
      CALL AREVAL (FIT)
      IF (WIFPAR(933).GT.0) CALL GVSTTR ('?HB2M001',FIT)
      CALL HB2STD
      CALL AREVAL (FIT)
      IF (WIFPAR(933).GT.0) CALL GVSTTR ('?HB2M002',FIT)
      IF (FIT.GE.BESVAL) THEN
         IF (WIFPAR(933).GT.0) CALL GVSTO6 ('?HB2M003')
      ELSE



         DO 300 IAMB=1,NAMB2
            IF (HB2AMB(IAMB).GT.1) THEN
               CALL HB2SEP (IAMB,TRY(IAMB,BESTRY))
            END IF
 300     CONTINUE
         IF (WIFPAR(933).GT.0) CALL GVSTO6 ('?HB2M004')
      END IF



      CALL ESPKIL (MAXESP-MAXAMB*MAXTRY,MAXESP,54,'HB2TRY')



  998 CONTINUE


      RETURN
      END
      SUBROUTINE HB2SEPI (IAMB,IPOS)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       IAMB, IPOS, IDON, IAD, IAA







      IF (IAMB.LT.1.OR.IAMB.GT.NAMB2) THEN
         CALL GVSTTB ('?NEWB233')
         GOTO 998
      END IF
      IF (IPOS.LT.1.OR.IPOS.GT.HB2AMB(IAMB)) THEN
         CALL GVSTTB ('?NEWB234')
         CALL GVSTTI2 ('1: IAMB,HB2IAA = ',IAMB,HB2IAA(IAMB))
         CALL GVSTTI2 ('1: IPOS,HB2AMB = ',IPOS,HB2AMB(IAMB))
         CALL GVSKIL
         GOTO 998
      END IF
      IF (HB2POS(IAMB).NE.IPOS) THEN
         IAA=HB2IAA(IAMB)
         IF (HB2POS(IAMB).GT.1) THEN
            HB2FLP=HB2FLP-HB2PEN(IAMB)
         END IF
         HB2POS(IAMB)=IPOS



         IF (IAMB.LE.NAMB1) THEN
            CALL HB2COOR (IAA,IPOS)
            IF (IPOS.NE.1) THEN
               HB2FLP=HB2FLP+HB2PEN(IAMB)
            END IF



            IF (NUDON(IAA).GT.1) THEN
               DO 50 IDON=INDON(IAA)+1,INDON(IAA)+NUDON(IAA)-1
                  CALL FILL1HARR (IDON)
                  CALL FILL1ACC (IDON)
 50            CONTINUE
            END IF
         ELSE



            IDON=HB2DON(IAMB)
            CALL FILL1HARR (IDON)
            CALL FILL1ACC (IDON)
         END IF



         IF (NUAD(IAMB).GT.0) THEN
            DO 100 IAD=INAD(IAMB),INAD(IAMB)+NUAD(IAMB)-1
               IDON=ARAD(IAD)



               CALL FILL1ACC (IDON)
 100        CONTINUE
         END IF
      END IF



  998 CONTINUE


      RETURN
      END
      SUBROUTINE HB2COOR (IAA,IPOS)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       IPOS, IAT, IAA
      LOGICAL       WIFIRI





      IF (.NOT.WIFIRI(IAA)) THEN
         CALL GVSTTB ('?NEWB235')
         GOTO 998
      END IF
      IF (IPOS.EQ.1) THEN
         DO 10 IAT=PNTAAS(IAA),PNTAAE(IAA)
            XCOORD(IAT)=XCOOR1(IAT)
            YCOORD(IAT)=YCOOR1(IAT)
            ZCOORD(IAT)=ZCOOR1(IAT)
 10      CONTINUE
      ELSE IF (IPOS.EQ.2) THEN
         DO 20 IAT=PNTAAS(IAA),PNTAAE(IAA)
            XCOORD(IAT)=XCOOR2(IAT)
            YCOORD(IAT)=YCOOR2(IAT)
            ZCOORD(IAT)=ZCOOR2(IAT)
 20      CONTINUE
      ELSE
         CALL GVSTTB ('?NEWB236')
      END IF



  998 CONTINUE


      RETURN
      END
      SUBROUTINE FILLHARR



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       IDON







      NUMHAR=0
      CALL GVSIT0 (ARIATA,2*MAXHAT)
      CALL GVSIT0 (ARSYMA,2*MAXHAT)
      CALL GVSRT0 (ARXYZH,3*MAXHAT)
      CALL GVSRT0 (ARPEN,MAXHAT)



      DO 20 IDON=1,NUMDON
         CALL FILL1HARR (IDON)
 20   CONTINUE





      RETURN
      END
      SUBROUTINE FILL1WATH (IDON)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       K(2,MAXH2P), IAA, IAT, IAMB, IDON
      REAL          V(3,MAXH2D)
      LOGICAL       GVFIBN
      COMMON        /WATHR/ V
      COMMON        /WATHI/ K







      IF (.NOT.GVFIBN(IDON,1,NUMDON)) THEN
         CALL GVSTTB ('?NEWB237')
         GOTO 998
      END IF



      IAMB=DONAMB(IDON)
      IF (IAMB.LT.NAMB1+1.OR.IAMB.GT.NAMB2) THEN
         CALL GVSTTI2 ('?NEWB240',IDON,IAMB)
         CALL GVSKIL
         GOTO 998
      END IF



      IF (HB2AMB(IAMB).NE.MAXH2P) THEN
         CALL GVSTTB ('?NEWB241')
         CALL GVSTTI ('NUMAMB = ',HB2AMB(IAMB))
         GOTO 998
      END IF
      IAA=HB2IAA(IAMB)
      IAT=HB2IAT(IAMB)



      IF (NUXYZH(IDON).NE.2) THEN
         CALL GVSTTB ('?NEWB242')
      END IF



      IF (HB2POS(IAMB).LT.1.OR.HB2POS(IAMB).GT.HB2AMB(IAMB)) THEN
         CALL GVSTTB ('?NEWB243')
         CALL GVSTTI2 ('?NEWZ101',IAA,HB2POS(IAMB))
         HB2POS(IAMB)=1
      END IF



      ARXYZH(1,INXYZH(IDON))  =XCOORD(IAT)+V(1,K(1,HB2POS(IAMB)))
      ARXYZH(2,INXYZH(IDON))  =YCOORD(IAT)+V(2,K(1,HB2POS(IAMB)))
      ARXYZH(3,INXYZH(IDON))  =ZCOORD(IAT)+V(3,K(1,HB2POS(IAMB)))
      ARXYZH(1,INXYZH(IDON)+1)=XCOORD(IAT)+V(1,K(2,HB2POS(IAMB)))
      ARXYZH(2,INXYZH(IDON)+1)=YCOORD(IAT)+V(2,K(2,HB2POS(IAMB)))
      ARXYZH(3,INXYZH(IDON)+1)=ZCOORD(IAT)+V(3,K(2,HB2POS(IAMB)))



  998 CONTINUE


      RETURN
      END
      SUBROUTINE FILL1HARR (IDON)




















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HBONDS.INC'
      INCLUDE       'HB2INC.INC'
      INCLUDE       'SYMINC.INC'
      INCLUDE       'HGRINC.INC'
      INTEGER       IAA, IAT, FIXED, IHAT, IAMB, IERR, IDON, IPLU, 
     +              JAT, ISYM, IGRP
      LOGICAL       REALH, WIFIRW
      REAL          XYZH(3), XYZB(3), XYZC(3), XYZR(3), RMAT(3,3), 
     +              CONANG, GVFDTR, TMP(3), DST2
      CHARACTER*4   T4, CHAR4







      IF (IDON.LT.1.OR.IDON.GT.NUMDON) THEN
         CALL GVSTTB ('?NEWB244')
         CALL GVSTTI2 ('IDON, NUMDON=',IDON,NUMDON)
         GOTO 998
      END IF



      IAT=ARIATD(IDON)
      IAA=ATIAA(IAT)



      IF (.NOT.ISATOK(IAT)) THEN
         IF (WIFPAR(1012).NE.0) THEN
            IF (USABLE(IAT)) THEN
               PRINT*,'Problem..:',IAT,ONESAT(IAT),ORGNAM(IAT),
     +          ISATOK(IAT),USABLE(IAT),DONACC(IAT),XCOORD(IAT),
     +          YCOORD(IAT),ZCOORD(IAT)
               CALL GVST6C ('?M0337',ONESA3(IAA),.TRUE.)
               USABLE(IAT)=.FALSE.
               CALL GVSCOD (' ')
               GOTO 998
            END IF
         END IF
      END IF



      IF (NUXYZH(IDON).GT.0) THEN
         DO 60 IHAT=INXYZH(IDON),INXYZH(IDON)+NUXYZH(IDON)-1
            TOTPEN=TOTPEN-ARPEN(IHAT)
            ARPEN(IHAT)=0
 60      CONTINUE
      END IF



      IAMB=DONAMB(IDON)
      IF (WIFIRW(IAA)) THEN
         CALL FILL1WATH (IDON)
         GOTO 500
      END IF



      CALL HBO012 (IAT,XYZH,XYZB,XYZC,FIXED,REALH)
      IF (FIXED.GT.0) THEN
         ARXYZH(1,INXYZH(IDON))=XYZH(1)
         ARXYZH(2,INXYZH(IDON))=XYZH(2)
         ARXYZH(3,INXYZH(IDON))=XYZH(3)
         IF (FIXED.GT.1) THEN
            ARXYZH(1,INXYZH(IDON)+1)=XYZB(1)
            ARXYZH(2,INXYZH(IDON)+1)=XYZB(2)
            ARXYZH(3,INXYZH(IDON)+1)=XYZB(3)
            IF (FIXED.GT.2) THEN
               ARXYZH(1,INXYZH(IDON)+2)=XYZC(1)
               ARXYZH(2,INXYZH(IDON)+2)=XYZC(2)
               ARXYZH(3,INXYZH(IDON)+2)=XYZC(3)
            END IF
         END IF




         IF (RESTYP(IAA).GT.0) THEN
            IF (HBOTYP(RESTYP(IAA),IAT-PNTAAS(IAA)+1).GE.6) THEN
               IF (IAMB.LT.NAMB1+1.OR.IAMB.GT.NAMB2) THEN
                  CALL GVSTTB ('?NEWB245')
                  GOTO 998
               END IF



               IGRP=HB2GRP(IDON)
               IF (IGRP.GT.0) THEN



                  PENGRP=PENGRP-HGRPEN(HB2GRC(IGRP),HB2GRT(IGRP))
                  IF (NUXYZH(IDON).GT.HB2GRC(IGRP)) THEN
                     CALL GVSTTE ('OOPS: NUXYZ > HB2GRC')
                     CALL GVSTTI ('IDON=',IDON)
                     CALL DIF015 (6,'ARIATD=',ARIATD(IDON))
                     CALL GVSTTI ('NUXYZH=',NUXYZH(IDON))
                     CALL GVSKIL
                  ELSE




                     HB2GRC(IGRP)=HB2GRC(IGRP)-NUXYZH(IDON)
                  END IF
               ELSE



               END IF
               IF (HB2POS(IAMB).EQ.2) THEN
                  NUXYZH(IDON)=0
                  DONACC(IAT)=-1
               ELSE
                  NUXYZH(IDON)=1
                  DONACC(IAT)=1
               END IF
               IF (IGRP.GT.0) THEN



                  HB2GRC(IGRP)=HB2GRC(IGRP)+NUXYZH(IDON)



                  PENGRP=PENGRP+HGRPEN(HB2GRC(IGRP),HB2GRT(IGRP))
               END IF
            ELSE
               IF (IAMB.GT.0) THEN
                  IF (HBOTYP(RESTYP(IAA),IAT-PNTAAS(IAA)+1).GE.4) THEN
                     IF (WIFPAR(933).GT.0) THEN
                        CALL GVSTT6 ('?M0725')
                        CALL DIF015 (6,'?M1458',IAT)
                     END IF



                     DONAMB(IDON)=0
                     HB2AMB(IAMB)=1
                  ELSE
                     CALL GVSTTB ('?NEWB246')
                  END IF 
                  GOTO 998
               END IF
            END IF
         END IF
      ELSE



         IF (IAMB.LT.NAMB1+1.OR.IAMB.GT.NAMB2) THEN
            CALL GVSTTI3 ('?NEWB247',IAMB,NAMB1+1,NAMB2)
            GOTO 998
         END IF



         CALL HBO013 (IAT,XYZC,XYZR,IERR)



         IF (IERR.EQ.0) THEN
            IF (NUXYZH(IDON).GT.0) THEN
               IF (NUXYZH(IDON).EQ.3) THEN
                  CONANG=HB2DLY*HB2POS(IAMB)
               ELSE IF (NUXYZH(IDON).EQ.1) THEN
                  CONANG=HB2DSE*HB2POS(IAMB)
               END IF
               CALL GVSMGM (RMAT,XYZC,GVFDTR(CONANG))
               CALL GVSMVV (XYZR,RMAT)
               IF (NUXYZH(IDON).EQ.1) THEN
                  ARXYZH(1,INXYZH(IDON))=XCOORD(IAT)+XYZR(1)
                  ARXYZH(2,INXYZH(IDON))=YCOORD(IAT)+XYZR(2)
                  ARXYZH(3,INXYZH(IDON))=ZCOORD(IAT)+XYZR(3)
               ELSE
                  CALL GVSMGM (RMAT,XYZC,GVFDTR(120.0))
                  DO 20 IHAT=0,NUXYZH(IDON)-1
                     ARXYZH(1,INXYZH(IDON)+IHAT)=XCOORD(IAT)+XYZR(1)
                     ARXYZH(2,INXYZH(IDON)+IHAT)=YCOORD(IAT)+XYZR(2)
                     ARXYZH(3,INXYZH(IDON)+IHAT)=ZCOORD(IAT)+XYZR(3)
                     CALL GVSMVV (XYZR,RMAT)
 20               CONTINUE
               END IF
            END IF
         ELSE
            CHAR4=T4(ONESAT(IAT))
            CALL GVSTTB ('?NEWB248')
            CALL GVSFMT ('?FMT819')
            CALL GVSCTB (LINE,80)
            WRITE (LINE,FMT,ERR=998) IDON,IAA,ONESA3(IAA),CHAR4,IAMB
            CALL GVSTT6 ('LINE')
         END IF
      END IF
 500  CONTINUE



      IF (NUXYZH(IDON).EQ.0.OR.NUMPLU.EQ.0) GOTO 998
      DO 600 IHAT=INXYZH(IDON),INXYZH(IDON)+NUXYZH(IDON)-1
         DO 550 IPLU=1,NUMPLU
            JAT=POSIAT(IPLU)
            ISYM=POSSYM(IPLU)
            TMP(1)=XCOORD(JAT)
            TMP(2)=YCOORD(JAT)
            TMP(3)=ZCOORD(JAT)
            IF (ISYM.GT.1)
     +           CALL GVSMPV (TMP, SYMMAT(1,1,ISYM),SYMVEC(1,ISYM))
            DST2=(TMP(1)-ARXYZH(1,IHAT))**2+
     +           (TMP(2)-ARXYZH(2,IHAT))**2+
     +           (TMP(3)-ARXYZH(3,IHAT))**2
            IF (DST2.LT.6.25) THEN
               ARPEN(IHAT)=ARPEN(IHAT)+METPEN
               TOTPEN=TOTPEN+METPEN
               GOTO 600
            END IF
 550     CONTINUE
 600  CONTINUE



  998 CONTINUE


      RETURN
      END
      REAL FUNCTION HBO1VAL(IATDON,HYD,IATACC,ISYM,LOOKH)






















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'SYMINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      REAL          DEG,XX
      PARAMETER     (DEG=180.0/3.14159)
      INTEGER       IATDON, IATACC, ISYM, IDOT, IDIS, IANG, JSYM,
     +              SYMNEG, IWHB, IACT, IERR
      REAL          DH, HA, DHA, VDH(3), VHA(3), HYD(3), TMP(3), AFAC,
     +              HB2AFOM, TMPVAL, DOT, DC(3), SHD, GVFACS
      LOGICAL       LOOKH, DEBUG, CH4EQCH4, WIFIRS, T54EQUAL
      CHARACTER*1   FIRSTCHARAT







      IF (IATDON.EQ.IATACC.AND.ISYM.EQ.1) THEN
         HBO1VAL=0.0
         GOTO 998
      END IF
      DEBUG=.FALSE.



      TMP(1)=HYD(1)
      TMP(2)=HYD(2)
      TMP(3)=HYD(3)
      DC(1)=XCOORD(IATDON)
      DC(2)=YCOORD(IATDON)
      DC(3)=ZCOORD(IATDON)
      IF (ISYM.NE.1) THEN
         JSYM=SYMNEG(ISYM)
         CALL GVSMPV (TMP,SYMMAT(1,1,JSYM),SYMVEC(1,JSYM))
         CALL GVSMPV (DC,SYMMAT(1,1,JSYM),SYMVEC(1,JSYM))
      END IF



      VHA(1)=XCOORD(IATACC)-TMP(1)
      VHA(2)=YCOORD(IATACC)-TMP(2)
      VHA(3)=ZCOORD(IATACC)-TMP(3)
      HA=VHA(1)**2+VHA(2)**2+VHA(3)**2



      IF (HA.GT.9.0) THEN
         HBO1VAL=0.0
         GOTO 998
      END IF
      VDH(1)=TMP(1)-DC(1)
      VDH(2)=TMP(2)-DC(2)
      VDH(3)=TMP(3)-DC(3)
      DOT=VHA(1)*VDH(1)+VHA(2)*VDH(2)+VHA(3)*VDH(3)



      IF (DOT.LT.0.0) THEN
         HBO1VAL=0.0
         GOTO 998
      END IF
      DH=VDH(1)**2+VDH(2)**2+VDH(3)**2



      IF (HA.LE.0.1.OR.DH.LE.0.1) THEN
         HBO1VAL=0.0
         GOTO 998
      END IF
      SHD=SQRT(HA*DH)
      IF (ABS(DOT).GE.SHD) THEN
         IF (DOT.GT.0.0) THEN
            DHA=GVFACS(1.0)
         ELSE
            DHA=GVFACS(-1.0)
         END IF
      ELSE
         DHA=GVFACS(DOT/SHD)*DEG
      END IF



      IDOT=1
      IF (FIRSTCHARAT(IATDON).EQ.'O') IDOT=2



      IACT=1
      IF (FIRSTCHARAT(IATACC).EQ.'O') IACT=2



      IF (FIRSTCHARAT(IATACC).EQ.'S'.AND.HA.GT.1.0) THEN
         HA=(SQRT(HA)-0.4)**2
      END IF



      AFAC=HB2AFOM(IDOT,TMP,IATACC,LOOKH,IERR)
      IF (IERR.NE.0) THEN
         HBO1VAL=0.0
         GOTO 998
      END IF
      IDIS=INT(SQRT(HA)*10.0)+1
      IANG=INT(DHA/5.0)+1
      IF (IANG.GT.18) IANG=18
      IF (IDIS.GT.40) IDIS=40



      TMPVAL=AFAC*HB2AUT(IANG,IDOT,IACT)*HB2DUT(IDIS,IDOT,IACT)



      IF (TMPVAL.LE.1.E-8) THEN
         HBO1VAL=0.0
         GOTO 998
      END IF



      TMPVAL=1.0+LOG(TMPVAL)/LOG(2.71828)/HB2ERT



      IF (FIRSTCHARAT(IATACC).EQ.'S') THEN
         TMPVAL=TMPVAL/4.0
      END IF



      IF (NUMWHB.GT.0) THEN
         DO 700 IWHB=1,NUMWHB
            IF (IATDON.EQ.HB2WHD(IWHB).AND.IATACC.EQ.HB2WHA(IWHB)) THEN
               TMPVAL=TMPVAL*WHBFAC
               GOTO 701
            END IF
 700     CONTINUE
      END IF







      IF (WIFPAR(1859).EQ.1) THEN
         IF (CH4EQCH4(ONESA3(ATIAA(IATACC)),'TYR ').AND.
     +       T54EQUAL(ONESAT(IATACC),' OH ')) THEN
            IF (WIFPAR(1860).EQ.0.AND.WIFPAR(1861).EQ.0) 
     +           TMPVAL=TMPVAL*10
            IF (ATIAA(IATACC).EQ.WIFPAR(1860).OR.
     +           ATIAA(IATACC).EQ.WIFPAR(1861)) THEN
               TMPVAL=TMPVAL*10
            END IF
         END IF
      END IF



      IF (WIFPAR(1871).EQ.1) THEN
         IF (CH4EQCH4(ONESA3(ATIAA(IATACC)),'CYS ').AND.
     +       T54EQUAL(ONESAT(IATACC),' SG ').AND.
     +       .NOT.WIFIRS(ATIAA(IATACC))) THEN
            IF (WIFPAR(1872).EQ.0.AND.WIFPAR(1873).EQ.0) 
     +         TMPVAL=TMPVAL*10
            IF (ATIAA(IATACC).EQ.WIFPAR(1872).OR.
     +          ATIAA(IATACC).EQ.WIFPAR(1873)) THEN
               TMPVAL=TMPVAL*10
            END IF
         END IF
      END IF

 701  CONTINUE




      IF (WIFPAR(594).GT.0) THEN
         XX=MAX(XBFACT(IATACC),XBFACT(IATDON))
         XX=(60-XX)/60
         TMPVAL=TMPVAL*MIN(1.0,MAX(0.0,XX))
      END IF



      IF (WEIGHT(IATACC).LE.0.99.OR.WEIGHT(IATDON).LE.0.99) THEN
          TMPVAL=TMPVAL*WEIGHT(IATACC)*WEIGHT(IATDON)
       END IF



      HBO1VAL=MIN(9.99,TMPVAL)



  998 CONTINUE


      RETURN
      END
      REAL FUNCTION HB2AFOM(IDOT,HYD,IAT,LOOKH,IERR)



















      IMPLICIT      NONE 
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      REAL          DEG
      PARAMETER     (DEG=180.0/3.14159)
      INTEGER       METH(9), METHOD, ACT, IAT, IAT1, IAT2, IAT3, IDOT, 
     +              IANG, ITOR, ITMP, IERR
      REAL          V1(3), V3(3), V4(3), V5(3), V6(3), V7(3), HYD(3), 
     +              ANG, TOR, L3, L5, L6, L1, L2, CP, S12, GVFACS
      LOGICAL       LOOKH, GVFIBN
      DATA METH     /2,3,2,4,2,2,2,1,5/







      IERR=0
      CALL GVSRT0 (V4,3)
      CALL GVSRT0 (V5,3)



      ACT=HB2ACT(IAT)
      IF (ACT.LT.1.OR.ACT.GT.9) THEN
         USEAT(IAT)=.TRUE.
         IF (GVFIBN(WIFPAR(451),1,100)) THEN
            CALL GVSTTU (WIFPAR(451),'?NEWB249')
            CALL DIF025A (WIFPAR(451),IAT)
            CALL GVSTTIU3 (WIFPAR(451),'?M2067',ATIAA(IAT),IAT,ACT)
            CALL GVSTUC (WIFPAR(451),'?M2068',ONESAT(IAT),.TRUE.)
         END IF
         HB2AFOM=0.0
         IERR=1
         GOTO 998
      END IF



      METHOD=METH(ACT)
      IF (ACT.EQ.5) THEN
         IF (LOOKH) THEN 
            METHOD=21
         ELSE
            METHOD=5
         END IF
      ELSE IF (ACT.EQ.6) THEN
         IF (LOOKH) THEN 
            METHOD=22
         ELSE
            METHOD=5
         END IF
      END IF



      IAT1=HB2ACB(1,IAT)
      IAT2=HB2ACB(2,IAT)
      IAT3=HB2ACB(3,IAT)



      V1(1)=HYD(1)-XCOORD(IAT)
      V1(2)=HYD(2)-YCOORD(IAT)
      V1(3)=HYD(3)-ZCOORD(IAT)
      IF (METHOD.EQ.1) THEN
         V4(1)=XCOORD(IAT)-XCOORD(IAT1)
         V4(2)=YCOORD(IAT)-YCOORD(IAT1)
         V4(3)=ZCOORD(IAT)-ZCOORD(IAT1)
         V5(1)=XCOORD(IAT1)-XCOORD(IAT2)
         V5(2)=YCOORD(IAT1)-YCOORD(IAT2)
         V5(3)=ZCOORD(IAT1)-ZCOORD(IAT2)
      ELSE IF (METHOD.EQ.2) THEN
         V5(1)=XCOORD(IAT)-XCOORD(IAT1)
         V5(2)=YCOORD(IAT)-YCOORD(IAT1)
         V5(3)=ZCOORD(IAT)-ZCOORD(IAT1)
         L5=SQRT(V5(1)**2+V5(2)**2+V5(3)**2)
         V3(1)=XCOORD(IAT)-XCOORD(IAT2)
         V3(2)=YCOORD(IAT)-YCOORD(IAT2)
         V3(3)=ZCOORD(IAT)-ZCOORD(IAT2)
         L3=SQRT(V3(1)**2+V3(2)**2+V3(3)**2)
         V4(1)=V5(1)*L3+V3(1)*L5
         V4(2)=V5(2)*L3+V3(2)*L5
         V4(3)=V5(3)*L3+V3(3)*L5
      ELSE IF (METHOD.EQ.21) THEN
         ITMP=INXYZH(ATDON(IAT))
         V5(1)=XCOORD(IAT)-ARXYZH(1,ITMP)
         V5(2)=YCOORD(IAT)-ARXYZH(2,ITMP)
         V5(3)=ZCOORD(IAT)-ARXYZH(3,ITMP)
         L5=SQRT(V5(1)**2+V5(2)**2+V5(3)**2)
         V3(1)=XCOORD(IAT)-ARXYZH(1,ITMP+1)
         V3(2)=YCOORD(IAT)-ARXYZH(2,ITMP+1)
         V3(3)=ZCOORD(IAT)-ARXYZH(3,ITMP+1)
         L3=SQRT(V3(1)**2+V3(2)**2+V3(3)**2)
         V4(1)=V5(1)*L3+V3(1)*L5
         V4(2)=V5(2)*L3+V3(2)*L5
         V4(3)=V5(3)*L3+V3(3)*L5
      ELSE IF (METHOD.EQ.22) THEN
         ITMP=INXYZH(ATDON(IAT))
         V5(1)=XCOORD(IAT)-XCOORD(IAT1)
         V5(2)=YCOORD(IAT)-YCOORD(IAT1)
         V5(3)=ZCOORD(IAT)-ZCOORD(IAT1)
         L5=SQRT(V5(1)**2+V5(2)**2+V5(3)**2)
         V3(1)=XCOORD(IAT)-ARXYZH(1,ITMP)
         V3(2)=YCOORD(IAT)-ARXYZH(2,ITMP)
         V3(3)=ZCOORD(IAT)-ARXYZH(3,ITMP)
         L3=SQRT(V3(1)**2+V3(2)**2+V3(3)**2)
         V4(1)=V5(1)*L3+V3(1)*L5
         V4(2)=V5(2)*L3+V3(2)*L5
         V4(3)=V5(3)*L3+V3(3)*L5
      ELSE IF (METHOD.EQ.3) THEN
         V5(1)=XCOORD(IAT)-XCOORD(IAT1)
         V5(2)=YCOORD(IAT)-YCOORD(IAT1)
         V5(3)=ZCOORD(IAT)-ZCOORD(IAT1)
         L5=SQRT(V5(1)**2+V5(2)**2+V5(3)**2)
         V3(1)=XCOORD(IAT)-XCOORD(IAT2)
         V3(2)=YCOORD(IAT)-YCOORD(IAT2)
         V3(3)=ZCOORD(IAT)-ZCOORD(IAT2)
         L3=SQRT(V3(1)**2+V3(2)**2+V3(3)**2)
         V6(1)=XCOORD(IAT)-XCOORD(IAT3)
         V6(2)=YCOORD(IAT)-YCOORD(IAT3)
         V6(3)=ZCOORD(IAT)-ZCOORD(IAT3)
         L6=SQRT(V6(1)**2+V6(2)**2+V6(3)**2)
         V4(1)=V5(1)/L5+V3(1)/L3+V6(1)/L6
         V4(2)=V5(2)/L5+V3(2)/L3+V6(2)/L6
         V4(3)=V5(3)/L5+V3(3)/L3+V6(3)/L6
      ELSE IF (METHOD.EQ.4) THEN
         V4(1)=XCOORD(IAT)-XCOORD(IAT1)
         V4(2)=YCOORD(IAT)-YCOORD(IAT1)
         V4(3)=ZCOORD(IAT)-ZCOORD(IAT1)
      ELSE IF (METHOD.EQ.5) THEN
         CONTINUE
      END IF



      IF (METHOD.GT.20) METHOD=2



      IF (METHOD.LT.5) THEN



         L1=V1(1)**2+V1(2)**2+V1(3)**2
         L2=V4(1)**2+V4(2)**2+V4(3)**2
         CP=V1(1)*V4(1)+V1(2)*V4(2)+V1(3)*V4(3)
         S12=SQRT(L1*L2)
         IF (ABS(CP).GE.S12) THEN
            IF (CP.GT.0.0) THEN
               ANG=GVFACS(1.0)
            ELSE
               ANG=GVFACS(-1.0)
            END IF
         ELSE
            ANG=GVFACS(CP/S12)
         END IF 
         ANG=ANG*DEG

         IF (ANG.GT.90.0) THEN
            HB2AFOM=0.0
            IERR=1
            GOTO 998
         END IF
         IF (METHOD.LT.4) THEN
            V6(1)=V4(2)*V5(3)-V4(3)*V5(2)
            V6(2)=V4(3)*V5(1)-V4(1)*V5(3)
            V6(3)=V4(1)*V5(2)-V4(2)*V5(1)
            V7(1)=V1(2)*V4(3)-V1(3)*V4(2)
            V7(2)=V1(3)*V4(1)-V1(1)*V4(3)
            V7(3)=V1(1)*V4(2)-V1(2)*V4(1)



         L1=V6(1)**2+V6(2)**2+V6(3)**2
         L2=V7(1)**2+V7(2)**2+V7(3)**2
         CP=V6(1)*V7(1)+V6(2)*V7(2)+V6(3)*V7(3)
         S12=SQRT(L1*L2)
         IF (ABS(CP).GE.S12) THEN
            IF (CP.GT.0.0) THEN
               TOR=GVFACS(1.0)
            ELSE
               TOR=GVFACS(-1.0)
            END IF
         ELSE
            TOR=GVFACS(CP/S12)
         END IF 
         TOR=TOR*DEG

            IF (METHOD.LT.3) THEN
               IF (TOR.GT.90.0) TOR=180.0-TOR
            ELSE
               IF (TOR.GT.120.0) TOR=TOR-120.0
               IF (TOR.GT.60.0) TOR=120.0-TOR
            END IF
         ELSE
            TOR=0.0
         END IF
      ELSE
         ANG=0.0
         TOR=0.0
      END IF



      ITOR=INT(TOR/10.0)+1
      IANG=INT(ANG/5.0)+1
      IF (METHOD.EQ.3) THEN
         IF (ITOR.GT.6) ITOR=6
      ELSE
         IF (ITOR.GT.9) ITOR=9
      END IF
      IF (IANG.GT.18) IANG=18



      HB2AFOM=HB2LUT(ACT,IANG,ITOR,IDOT)



  998 CONTINUE

      
      RETURN
      END
      SUBROUTINE FILL1ACC (IDON)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'SYMINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HBONDS.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       IAT, JAT, IHAT, JHAT, IDON, IPA, JDON,
     +              ISYM
      REAL          HBO1VAL, SCR, NEAR, TMP(3), HYD(3)







      IF (NUPA(IDON).EQ.0) GOTO 100



      IAT=ARIATD(IDON)



      TOTVAL=TOTVAL-HB2DVA(IDON)
      HB2DVA(IDON)=0.0



      DO 10 IHAT=INXYZH(IDON),INXYZH(IDON)+NUXYZH(IDON)-1
         ARIATA(1,IHAT)=0
         ARSYMA(1,IHAT)=0
         ARVALA(1,IHAT)=0.0
         ARIATA(2,IHAT)=0
         ARSYMA(2,IHAT)=0
         ARVALA(2,IHAT)=0.0
 10   CONTINUE



      IF (NUXYZH(IDON).LE.0) GOTO 100



      DO 80 IPA=INPA(IDON),INPA(IDON)+NUPA(IDON)-1
         JAT=ARPAAT(IPA)
         ISYM=ARPAIS(IPA)
         IF (USABLE(JAT).AND.DONACC(JAT).LE.0) THEN



            DO 60 IHAT=INXYZH(IDON),INXYZH(IDON)+NUXYZH(IDON)-1
               HYD(1)=ARXYZH(1,IHAT)
               HYD(2)=ARXYZH(2,IHAT)
               HYD(3)=ARXYZH(3,IHAT)



               JDON=ATDON(JAT)
               IF (JDON.GT.0) THEN
                  IF (NUXYZH(JDON).GT.0) THEN
                     NEAR=25.0
                     DO 50 JHAT=INXYZH(JDON),INXYZH(JDON)+NUXYZH(JDON)-1
                        TMP(1)=ARXYZH(1,JHAT)
                        TMP(2)=ARXYZH(2,JHAT)
                        TMP(3)=ARXYZH(3,JHAT)
                        IF (ISYM.NE.1) CALL GVSMPV
     +                       (TMP,SYMMAT(1,1,ISYM),SYMVEC(1,ISYM))
                        NEAR=MIN(NEAR,
     +                       (TMP(1)-HYD(1))**2+
     +                       (TMP(2)-HYD(2))**2+
     +                       (TMP(3)-HYD(3))**2)
 50                  CONTINUE
                     IF (NEAR.LT.3.0) GOTO 60
                  END IF
               END IF



               SCR=HBO1VAL(IAT,HYD,JAT,ISYM,.TRUE.)



               IF (SCR.GT.ARVALA(1,IHAT)) THEN
                  ARVALA(2,IHAT)=ARVALA(1,IHAT)
                  ARIATA(2,IHAT)=ARIATA(1,IHAT)
                  ARSYMA(2,IHAT)=ARSYMA(1,IHAT)
                  ARVALA(1,IHAT)=SCR
                  ARIATA(1,IHAT)=JAT
                  ARSYMA(1,IHAT)=ISYM
               ELSE IF (SCR.GT.ARVALA(2,IHAT)) THEN
                  ARVALA(2,IHAT)=SCR
                  ARIATA(2,IHAT)=JAT
                  ARSYMA(2,IHAT)=ISYM
               END IF
 60         CONTINUE
         END IF
 80   CONTINUE
      DO 85 IHAT=INXYZH(IDON),INXYZH(IDON)+NUXYZH(IDON)-1
         HB2DVA(IDON)=HB2DVA(IDON)+ARVALA(1,IHAT)+ARVALA(2,IHAT)
 85   CONTINUE
      TOTVAL=TOTVAL+HB2DVA(IDON)
 100  CONTINUE





      RETURN
      END
      SUBROUTINE AREVAL (VALUE)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      REAL          VALUE





      VALUE=TOTVAL-TOTPEN-HB2FLP-PENGRP







      HB2EVA=HB2EVA+1





      RETURN
      END
      SUBROUTINE HB2GRA



















      IMPLICIT      NONE


      RETURN
      END
      SUBROUTINE HB2LUH



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       IAT, IAA, IHAT, IDON, IPA
      LOGICAL       ESPBAD, WIFITW







      IF (.NOT.HB2IDN.OR.ESPBAD(HB2ES0,HB2ESZ,1)) THEN
         CALL GVSTTE ('?NEWE631')
         GOTO 998
      END IF



      CALL GVSBTF (ACCDON,MAXAA)



      CALL CDB013 ('BH2NOK','BH2NEU','BH2OK')



      CALL CDB014 (1,'NON-HBO','POOR')
      CALL CDB014 (2,'MIS-HBO','BAD')



      CALL GVSRT0 (ATTVAL,MAXAT)
      DO 100 IDON=1,NUMDON
         IF (NUXYZH(IDON).GT.0) THEN
            IAT=ARIATD(IDON)
            IAA=ATIAA(IAT)
            IF (.NOT.ACCDON(IAA)) CALL WIF041 (IAA)
            IF (.NOT.ISATOK(IAT).OR.ACCESS(IAT).GT.0.001) GOTO 100
            DO 80 IHAT=INXYZH(IDON),INXYZH(IDON)+NUXYZH(IDON)-1
               IF (ARVALA(1,IHAT).GT.0.0) GOTO 80



               CALL DIF015 (6,'?M0338',IAT)
               IF (NUPA(IDON).GT.0) THEN
                  DO 70 IPA=INPA(IDON),INPA(IDON)+NUPA(IDON)-1
                     CALL DIF015 (6,'?M0339',ARPAAT(IPA))
 70               CONTINUE
               END IF
               IF ((RESTYP(IAA).EQ.15.OR.RESTYP(IAA).EQ.9.OR.
     +              RESTYP(IAA).EQ.4.OR.RESTYP(IAA).EQ.3.OR.
     +              RESTYP(IAA).EQ.14.OR.RESTYP(IAA).EQ.12.OR.
     +              RESTYP(IAA).EQ.7).AND.PINIAA(IAT).GT.4) THEN
                  ATTVAL(IAT)=2.0
               ELSE
                  ATTVAL(IAT)=1.0
               END IF
               IF (.NOT.WIFITW(IAT)) THEN
                  CALL PDBC92 (IAA,IAT)
                  CALL PDBS51 (IAA,ATTVAL(IAT),0.1,1.0)
               END IF



               GOTO 100
 80         CONTINUE
         END IF
 100  CONTINUE



      CALL CDB012



  998 CONTINUE


      RETURN
      END
      SUBROUTINE HB2CUH (ICUH)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       IAT, IAA, IHAT, IDON, IPA, ICUH, JAA, JAT
      REAL          WIFDST
      LOGICAL       WIFITW, WIFIRD, WIF040







      CALL GVSBTF (ACCDON,MAXAA)
      ICUH=0



      DO 100 IDON=1,NUMDON
         IF (NUXYZH(IDON).GT.0) THEN
            IAT=ARIATD(IDON)
            IAA=ATIAA(IAT)
            IF (.NOT.ISATOK(IAT)) GOTO 100
            IF (.NOT.ACCDON(IAA)) CALL WIF041 (IAA)
            IF (ACCESS(IAT).GT.0.001) GOTO 100
            DO 150 JAA=NUMAAF,NUMAAT
               IF (WIFIRD(JAA)) THEN
                  IF (WIF040(IAA,JAA,1.0)) THEN
                     DO 120 JAT=PNTAAS(JAA),PNTAAE(JAA)
                        IF (ONESAT(JAT)(1:2).EQ.' N'.OR.
     +                      ONESAT(JAT)(1:2).EQ.' O'.OR.
     +                      PNTAAS(IAA).EQ.PNTAAE(IAA)) THEN
                           IF (WIFDST(IAT,JAT).LT.3.5) GOTO 100
                        END IF
 120                 CONTINUE
                  END IF
               END IF
 150        CONTINUE
            DO 80 IHAT=INXYZH(IDON),INXYZH(IDON)+NUXYZH(IDON)-1
               IF (ARVALA(1,IHAT).GT.0.0) GOTO 80



               CALL DIF015 (6,'?M0338',IAT)
               IF (NUPA(IDON).GT.0) THEN
                  DO 70 IPA=INPA(IDON),INPA(IDON)+NUPA(IDON)-1
                     CALL DIF015 (6,'?M0339',ARPAAT(IPA))
 70               CONTINUE
               END IF
               IF (.NOT.WIFITW(IAT)) ICUH=ICUH+1



               GOTO 100
 80         CONTINUE
         END IF
 100  CONTINUE





      RETURN
      END
      SUBROUTINE HB2LUA



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HBONDS.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       IAT, IAA, IHAT, IDON, IPA, METAL, MSYM
      LOGICAL       ESPBAD, HASPROTEIN







      IF (.NOT.HB2IDN.OR.ESPBAD(HB2ES0,HB2ESZ,1)) THEN
         CALL GVSTTE ('?NEWE631')
         GOTO 998
      END IF



      IF (.NOT.HASPROTEIN().AND.WIFPAR(279).GT.1) THEN
         CALL PDBMES ('R00018')
         GOTO 998
      END IF



      CALL CDB013 ('BH2ANOK','BH2ANEU','BH2AOK')



      CALL CDB014 (1,'MIS-HBO','POOR')



      CALL GVSBTF (ACCDON,MAXAA)



      CALL GVSBTF (USEAT,MAXAT)



      CALL GVSRT0 (ATTVAL,MAXAT)
      DO 100 IDON=1,NUMDON
         IF (NUXYZH(IDON).GT.0) THEN
            DO 80 IHAT=INXYZH(IDON),INXYZH(IDON)+NUXYZH(IDON)-1
               IF (ARIATA(1,IHAT).GT.0) USEAT(ARIATA(1,IHAT))=.TRUE.
               IF (ARIATA(2,IHAT).GT.0) USEAT(ARIATA(2,IHAT))=.TRUE.
 80         CONTINUE
         END IF
 100  CONTINUE

      DO 200 IAA=1,NUMAAT
         DO 190 IAT=PNTAAS(IAA),PNTAAE(IAA)
            IF (.NOT.USABLE(IAT).OR.DONACC(IAT).GT.0.OR.USEAT(IAT))
     +           GOTO 190
            IF (.NOT.ISATOK(IAT)) GOTO 190
            IF (.NOT.ACCDON(IAA)) CALL WIF041 (IAA)
            IF (ACCESS(IAT).GT.0.0) GOTO 190



            CALL DIF015 (6,'?M0340',IAT)
            DO 180 IDON=1,NUMDON
               IF (NUPA(IDON).GT.0) THEN
                  DO 170 IPA=INPA(IDON),INPA(IDON)+NUPA(IDON)-1
                     IF (ARPAAT(IPA).EQ.IAT) THEN
                        CALL DIF015 (6,'?M0341',ARIATD(IDON))
                        GOTO 171
                     END IF
 170              CONTINUE
 171              CONTINUE
               END IF
 180        CONTINUE






            IF ((RESTYP(IAA).EQ.3.OR.RESTYP(IAA).EQ.4.OR.
     +           RESTYP(IAA).EQ.7.OR.RESTYP(IAA).EQ.9.OR.
     +           RESTYP(IAA).EQ.12.OR.RESTYP(IAA).EQ.14).AND.
     +           PINIAA(IAT).GT.4) THEN



               CALL PDBC04C (IAT,METAL,MSYM)
               IF (METAL.GT.0) THEN
                  CALL DIF015 (6,'?R00281',IAT)
               ELSE
                  ATTVAL(IAT)=1.0
                  CALL PDBC92 (IAA,IAT)
                  CALL PDBS51 (IAA,ATTVAL(IAT),0.1,1.0)
               END IF
            END IF
 190     CONTINUE
 200  CONTINUE



      CALL CDB012



  998 CONTINUE

      
      RETURN
      END
      SUBROUTINE HB2CUA (ICUA)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HBONDS.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       IAT, IAA, IHAT, IDON, IPA, METAL, MSYM, ICUA, JAA,
     +              JAT
      REAL          WIFDST
      LOGICAL       WIFIRD, WIF040







      CALL GVSBTF (ACCDON,MAXAA)
      CALL GVSBTF (USEAT,MAXAT)
      CALL GVSRT0 (ATTVAL,MAXAT)
      ICUA=0



      DO 100 IDON=1,NUMDON
         IF (NUXYZH(IDON).GT.0) THEN
            DO 80 IHAT=INXYZH(IDON),INXYZH(IDON)+NUXYZH(IDON)-1
               IF (ARIATA(1,IHAT).GT.0) USEAT(ARIATA(1,IHAT))=.TRUE.
               IF (ARIATA(2,IHAT).GT.0) USEAT(ARIATA(2,IHAT))=.TRUE.
 80         CONTINUE
         END IF
 100  CONTINUE

      DO 200 IAA=1,NUMAAT
         DO 190 IAT=PNTAAS(IAA),PNTAAE(IAA)
            IF (.NOT.USABLE(IAT).OR.DONACC(IAT).GT.0.OR.USEAT(IAT))
     +           GOTO 190
            IF (.NOT.ISATOK(IAT)) GOTO 190
            IF (.NOT.ACCDON(IAA)) CALL WIF041 (IAA)
            IF (ACCESS(IAT).GT.0.0) GOTO 190
            DO 150 JAA=NUMAAF,NUMAAT
               IF (WIFIRD(JAA)) THEN
                  IF (WIF040(IAA,JAA,1.0)) THEN
                     DO 120 JAT=PNTAAS(JAA),PNTAAE(JAA)
                        IF (ONESAT(JAT)(1:2).EQ.' N'.OR.
     +                      ONESAT(JAT)(1:2).EQ.' O'.OR.
     +                      PNTAAS(IAA).EQ.PNTAAE(IAA)) THEN
                           IF (WIFDST(IAT,JAT).LT.3.5) GOTO 190
                        END IF
 120                 CONTINUE
                  END IF
               END IF
 150        CONTINUE



            CALL DIF015 (6,'?M0340',IAT)
            DO 180 IDON=1,NUMDON
               IF (NUPA(IDON).GT.0) THEN
                  DO 170 IPA=INPA(IDON),INPA(IDON)+NUPA(IDON)-1
                     IF (ARPAAT(IPA).EQ.IAT) THEN
                        CALL DIF015 (6,'?M0341',ARIATD(IDON))
                        GOTO 171
                     END IF
 170              CONTINUE
 171              CONTINUE
               END IF
 180        CONTINUE






            IF ((RESTYP(IAA).EQ.3.OR.RESTYP(IAA).EQ.4.OR.
     +           RESTYP(IAA).EQ.7.OR.RESTYP(IAA).EQ.9.OR.
     +           RESTYP(IAA).EQ.12.OR.RESTYP(IAA).EQ.14).AND.
     +           PINIAA(IAT).GT.4) THEN



               CALL PDBC04C (IAT,METAL,MSYM)
               IF (METAL.GT.0) THEN
                  CALL DIF015 (6,'?R00281',IAT)
               ELSE
                  ATTVAL(IAT)=1.0
                  ICUA=ICUA+1
               END IF
            END IF
 190     CONTINUE
 200  CONTINUE




      
      RETURN
      END
      SUBROUTINE HB2LPA



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       IAT, IPA, IDON, ISYM, SYMNEG
      LOGICAL       ESPBAD
      CHARACTER*28  IATS, DIF000







      IF (.NOT.HB2IDN.OR.ESPBAD(HB2ES0,HB2ESZ,1)) THEN
         CALL GVSTTE ('?NEWE631')
         GOTO 998
      END IF



      CALL GRTVIN
      DO 100 IDON=1,NUMDON
         IF (NUPA(IDON).GT.0) THEN
            IAT=ARIATD(IDON)
            CALL DIF015 (6,'?M0342',IAT)
            DO 80 IPA=INPA(IDON),INPA(IDON)+NUPA(IDON)-1
               IAT=ARPAAT(IPA)
               ISYM=ARPAIS(IPA)
               IATS=DIF000(IAT)
               CALL GVSFMT ('?FMT820')
               CALL GVSCTB (LINE,80)
               WRITE (LINE,FMT,ERR=998) IATS,ISYM,SYMNEG(ISYM),
     +          HB2ACT(IAT)
               CALL GVSTT6 (LINE)
 80         CONTINUE
         END IF
 100  CONTINUE



  998 CONTINUE


      RETURN
      END
      SUBROUTINE HB2LAD



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       IAT, IAA, IAD, IDON, IAMB
      LOGICAL       ESPBAD







      IF (.NOT.HB2IDN.OR.ESPBAD(HB2ES0,HB2ESZ,1)) THEN
         CALL GVSTTE ('?NEWE631')
         GOTO 998
      END IF



      CALL GRTVIN
      DO 100 IAMB=1,NAMB1
         IAA=HB2IAA(IAMB)
         CALL DIF008 ('?HB2FMT8',IAA)
         DO 80 IAD=INAD(IAMB),INAD(IAMB)+NUAD(IAMB)-1
            IDON=ARAD(IAD)
            IAT=ARIATD(IDON)
            CALL DIF015 (6,'?M1459',IAT)
 80      CONTINUE
 100  CONTINUE
      DO 200 IAMB=NAMB1+1,NAMB2
         IAT=HB2IAT(IAMB)
         CALL DIF015 (6,'?HB2FMT8',IAT)
         CALL GVSTT6 (LINE)
         DO 180 IAD=INAD(IAMB),INAD(IAMB)+NUAD(IAMB)-1
            IDON=ARAD(IAD)
            IAT=ARIATD(IDON)
            CALL DIF015 (6,'?M1459',IAT)
 180     CONTINUE
 200  CONTINUE



  998 CONTINUE


      RETURN
      END
      SUBROUTINE HB2LIS



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       IAA, IAT, IHAT, JAC, JAT, JAA, IDON, ISYM, IERR
      REAL          DVAANG, DVADIS, HYD(3), DVANIX, HBODVAL
      LOGICAL       ESPBAD, SAME12, WIFIRW, WIFIRA
      CHARACTER*28  IATS, JATS, DIF000







      IF (.NOT.HB2IDN.OR.ESPBAD(HB2ES0,HB2ESZ,1)) THEN
         CALL GVSTTE ('?NEWE631')
         GOTO 998
      END IF



      IF (WIFPAR(415).EQ.0) THEN
         CALL WIFWTF ('?RANGE1',IERR)
         IF (IERR.NE.0) GOTO 998
         CALL GVSCPB (LOCWTF,WRK1TF,MAXAA)
         CALL WIFWTF ('?RANGE2',IERR)
         IF (IERR.NE.0) GOTO 998
      ELSE
         CALL GVSBTT (LOCWTF,NUMAAT)
         CALL GVSBTT (WRK1TF,NUMAAT)
      END IF



      SAME12=.TRUE.
      DO 10 IAA=1,NUMAAT
         IF (.NOT.LOCWTF(IAA).AND.WRK1TF(IAA)) SAME12=.FALSE.
         IF (.NOT.WRK1TF(IAA).AND.LOCWTF(IAA)) SAME12=.FALSE.
   10 CONTINUE



      IF (.NOT.SAME12.AND.WIFPAR(415).EQ.0) CALL GVSBOX ('?M1503')
      DO 100 IDON=1,NUMDON
         IF (NUXYZH(IDON).GT.0) THEN
            IAT=ARIATD(IDON)
            IAA=ATIAA(IAT)
            IF (.NOT.LOCWTF(IAA)) GOTO 100
            DO 80 IHAT=INXYZH(IDON),INXYZH(IDON)+NUXYZH(IDON)-1
               DO 70 JAC=1,2
                  IF (ARIATA(JAC,IHAT).GT.0) THEN
                     JAT=ARIATA(JAC,IHAT)
                     ISYM=ARSYMA(JAC,IHAT)
                     JAA=ATIAA(JAT)
                     IF (.NOT.WRK1TF(JAA)) GOTO 70
                     IATS=DIF000(IAT)          
                     JATS=DIF000(JAT)
                     CALL GVSCTB (BIGLIN,132)
                     CALL GVSFMT ('?FMT350')
                     HYD(1)=ARXYZH(1,IHAT)
                     HYD(2)=ARXYZH(2,IHAT)
                     HYD(3)=ARXYZH(3,IHAT)
                     DVANIX=HBODVAL(IAT,HYD,JAT,ISYM,.FALSE.,DVADIS,
     +                DVAANG)
                     IF (WIFPAR(415).NE.0) THEN
                        IF (IAA.NE.WIFPAR(415).AND.JAA.NE.WIFPAR(415)) 
     +                   GOTO 70
                        IF (IAA.EQ.WIFPAR(415)) THEN
                           IF (WIFIRA(IAA).AND.IAT.LE.PNTAAS(IAA)+3.AND.
     +                      WIFPAR(416).LT.0) GOTO 70
                           IF (WIFIRW(IAA).AND.IAT.NE.WIFPAR(416)) 
     +                      GOTO 70
                        END IF
                        IF (JAA.EQ.WIFPAR(415)) THEN
                           IF (WIFIRA(JAA).AND.JAT.LE.PNTAAS(JAA)+3.AND.
     +                      WIFPAR(416).LT.0) GOTO 70
                           IF (WIFIRW(JAA).AND.JAT.NE.WIFPAR(416)) 
     +                      GOTO 70
                        END IF
                     END IF
                     WRITE (BIGLIN,FMT,ERR=999) IATS,JATS,
     +                ISYM, ARVALA(JAC,IHAT), DVADIS, DVAANG
                     CALL GVSTT6 (BIGLIN)
                  END IF
 70            CONTINUE
 80         CONTINUE
         END IF
 100  CONTINUE



      IF (.NOT.SAME12) THEN
         DO 110 IAA=1,NUMAAT
            CALL GVSWLP (WRK1TF(IAA),LOCWTF(IAA))
  110    CONTINUE
         CALL GVSBOX ('?M1504')
         DO 200 IDON=1,NUMDON
            IF (NUXYZH(IDON).GT.0) THEN
               IAT=ARIATD(IDON)
               IAA=ATIAA(IAT)
               IF (.NOT.LOCWTF(IAA)) GOTO 200
               DO 180 IHAT=INXYZH(IDON),INXYZH(IDON)+NUXYZH(IDON)-1
                  DO 170 JAC=1,2
                     IF (ARIATA(JAC,IHAT).GT.0) THEN
                        JAT=ARIATA(JAC,IHAT)
                        ISYM=ARSYMA(JAC,IHAT)
                        JAA=ATIAA(JAT)
                        IF (.NOT.WRK1TF(JAA)) GOTO 170
                        IATS=DIF000(IAT)
                        JATS=DIF000(JAT)
                        CALL GVSFMT ('?FMT350')
                        HYD(1)=ARXYZH(1,IHAT)
                        HYD(2)=ARXYZH(2,IHAT)
                        HYD(3)=ARXYZH(3,IHAT)
                        DVANIX=HBODVAL(IAT,HYD,JAT,ISYM,.FALSE.,DVADIS,
     +                   DVAANG)
                        WRITE (BIGLIN,FMT,ERR=999) IATS,JATS,
     +                   ISYM, ARVALA(JAC,IHAT), DVADIS, DVAANG
                       CALL GVSTT6 (BIGLIN)
                     END IF
 170              CONTINUE
 180           CONTINUE
            END IF
 200     CONTINUE
      END IF
      GOTO 998



  999 CONTINUE
      CALL GVSEIW ('HB2LIS')



  998 CONTINUE


      RETURN
      END
      SUBROUTINE HB2LDA



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       IAA, IAT, IHAT, JAC, JAT, JAA, IDON, ISYM, IERR
      LOGICAL       ESPBAD
      CHARACTER*28  IATS, JATS, DIF000







      IF (.NOT.HB2IDN.OR.ESPBAD(HB2ES0,HB2ESZ,1)) THEN
         CALL GVSTTE ('?NEWE631')
         GOTO 998
      END IF



      CALL WIFWTF ('?RANGE1',IERR)
      IF (IERR.NE.0) GOTO 998
      CALL GVSCPB (LOCWTF,WRK1TF,MAXAA)
      CALL WIFWTF ('?RANGE2',IERR)
      IF (IERR.NE.0) GOTO 998



      DO 100 IDON=1,NUMDON
         IF (NUXYZH(IDON).GT.0) THEN
            IAT=ARIATD(IDON)
            IAA=ATIAA(IAT)
            IF (.NOT.LOCWTF(IAA)) GOTO 100
            DO 80 IHAT=INXYZH(IDON),INXYZH(IDON)+NUXYZH(IDON)-1
               DO 70 JAC=1,2
                  IF (ARIATA(JAC,IHAT).GT.0) THEN
                     JAT=ARIATA(JAC,IHAT)
                     ISYM=ARSYMA(JAC,IHAT)
                     JAA=ATIAA(JAT)
                     IF (.NOT.WRK1TF(JAA)) GOTO 70
                     IATS=DIF000(IAT)
                     JATS=DIF000(JAT)
                     CALL GVSFMT ('?FMT350')
                     WRITE (LINE,FMT,ERR=999) IATS,JATS,
     +                ISYM, ARVALA(JAC,IHAT)
                     CALL GVSTT6 (LINE)
                  END IF
 70            CONTINUE
 80         CONTINUE
         END IF
 100  CONTINUE
      GOTO 998



  999 CONTINUE
      CALL GVSEIW ('HB2LDA')



  998 CONTINUE


      RETURN
      END
      SUBROUTINE HB2XST



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       IAT, IHAT, JAC, JAT, IDON,
     +              ST(25), ITYP, ICON, ISCN, DTYP, ATYP, HB2ATP
      CHARACTER*80  NAM(5)
      REAL          VA(25)
      LOGICAL       ESPBAD







      CALL GVSRT0 (VA,25)
      CALL GVSIT0 (ST,25)
      ICON=0
      ISCN=0



      IF (.NOT.HB2IDN.OR.ESPBAD(HB2ES0,HB2ESZ,1)) THEN
         CALL GVSTTE ('?NEWE631')
         GOTO 998
      END IF



      DO 30 IDON=1,NUMDON
         IF (NUXYZH(IDON).GT.0) THEN
            IAT=ARIATD(IDON)
            DTYP=HB2ATP(IAT)
            DO 20 IHAT=INXYZH(IDON),INXYZH(IDON)+NUXYZH(IDON)-1
               DO 10 JAC=1,2
                  IF (ARIATA(JAC,IHAT).GT.0) THEN
                     ICON=ICON+1
                     IF (ARSYMA(JAC,IHAT).GT.1) ISCN=ISCN+1
                     JAT=ARIATA(JAC,IHAT)
                     ATYP=HB2ATP(JAT)
                     ITYP=5*DTYP+ATYP-5
                     ST(ITYP)=ST(ITYP)+1
                     VA(ITYP)=VA(ITYP)+ARVALA(JAC,IHAT)
                  END IF
 10            CONTINUE
 20         CONTINUE
         END IF
 30   CONTINUE
      CALL SHOWTEXT ('?HB2TBH1')
      CALL GVSSTX (NAM(1),'?HB2NAM1')
      CALL GVSSTX (NAM(2),'?HB2NAM2')
      CALL GVSSTX (NAM(3),'?HB2NAM3')
      CALL GVSSTX (NAM(4),'?HB2NAM4')
      CALL GVSSTX (NAM(5),'?HB2NAM5')
      CALL GVSFMT ('?HB2FMT1')
      DO 50 DTYP=1,5
         DO 40 ATYP=1,5
            ITYP=5*DTYP+ATYP-5
            IF (ST(ITYP).GT.0) THEN
               WRITE (LINE,FMT,ERR=998) NAM(DTYP),NAM(ATYP),
     +          ST(ITYP),VA(ITYP),VA(ITYP)/ST(ITYP)
               CALL GVSTT6 (LINE)
            END IF
 40      CONTINUE
 50   CONTINUE
      CALL GVSFMT ('?HB2FMT2')
      WRITE (LINE,FMT,ERR=998) ICON
      CALL GVSTT6 (LINE)
      IF (ISCN.GT.0) THEN
         CALL GVSFMT ('?HB2FMT3')
         WRITE (LINE,FMT,ERR=998) ISCN, FLOAT(ISCN)/FLOAT(ICON)*100.0
         CALL GVSTT6 (LINE)
      END IF
      IF (NUMWHB.GT.0) CALL SHOWTEXT ('?M0343')



  998 CONTINUE


      RETURN
      END
      SUBROUTINE HB2LFR



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INCLUDE       'HGRINC.INC'
      INTEGER       IAMB, IAA, IGRP, IDON
      REAL          VALUE
      LOGICAL       ESPBAD, HB2FNK, FIRST







      IF (.NOT.HB2IDN.OR.ESPBAD(HB2ES0,HB2ESZ,1)) THEN
         CALL GVSTT6 ('?NEWT607')
         GOTO 998
      END IF



      FIRST=.TRUE.



      DO 500 IAMB=1,NAMB1
         IAA=HB2IAA(IAMB)
         IF (HB2POS(IAMB).NE.1.AND..NOT.HB2FNK(IAA)) THEN
            CALL DIF008 ('?HB2FMT10',IAA)
            IF (WIFPAR(450).NE.0.AND.WIFPAR(451).NE.0) THEN
               IF (FIRST) THEN
                  FIRST=.FALSE.
                  CALL GVSTT6 ('?M4859')
                  CALL GVSTT6 ('?M4860')
                  CALL GVSTTU (WIFPAR(451),'?M4859')
                  CALL GVSTTU (WIFPAR(451),'?M4860')
               END IF
               CALL GVSFMT ('?FMT1413')
               CALL GVSCTB (LINE,80)
               WRITE (LINE,FMT,ERR=999) IAA,ONESA3(IAA),NUMNAM(IAA),
     +          CHANAM(IAA)
               CALL GVSTT6 (LINE)
               CALL GVSTTU (WIFPAR(451),LINE)
            END IF
         END IF
 500  CONTINUE



      DO 201 IGRP=1,NUMHGR
         IF (HGRPEN(HB2GRC(IGRP),HB2GRT(IGRP)).GT.0.0) THEN
            IF (HB2GRC(IGRP).EQ.1) THEN
               CALL GVSTT6 ('?HB2M010') 
            ELSE IF (HB2GRC(IGRP).EQ.0) THEN
               CALL GVSTT6 ('?HB2M011') 
            ELSE
               CALL GVSFMT ('?HB2FMT13')
               WRITE (LINE,FMT,ERR=998) HB2GRC(IGRP)
               CALL GVSTT6 (LINE)
            END IF
            DO 101 IDON=1,NUMDON
               IF (IGRP.EQ.HB2GRP(IDON)) THEN
                  CALL DIF015 (6,'?M0344',ARIATD(IDON))
               END IF
 101        CONTINUE
         END IF
 201  CONTINUE



      CALL GVSTTR ('?NEWZ103',TOTVAL)
      CALL GVSTTR ('?NEWZ105',PENGRP)
      CALL GVSTTR ('?NEWZ106',HB2FLP)
      CALL GVSTTR ('?NEWZ107',TOTPEN)
      CALL GVSNL6 (1)



      CALL AREVAL (VALUE)
      CALL GVSTTR ('?NEWZ108',VALUE)
      GOTO 998



 999  CONTINUE
      CALL GVSEIW ('HB2LFR')



  998 CONTINUE


      RETURN
      END
      SUBROUTINE HB2RES



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       IAMB
      LOGICAL       ESPBAD







      IF (.NOT.HB2IDN.OR.ESPBAD(HB2ES0,HB2ESZ,1)) THEN
         CALL GVSTT6 ('?NEWT607')
         HB2IDN=.FALSE.
         GOTO 998
      END IF



      DO 500 IAMB=1,NAMB1
         CALL HB2SEP (IAMB,1)
 500  CONTINUE
      HB2IDN=.FALSE.



      WIFPAR(1504)=WIFPAR(1504)+1



  998 CONTINUE


      RETURN
      END
      SUBROUTINE HB2LBF



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       IDON, IAT, IHAT
      LOGICAL       ESPBAD







      IF (.NOT.HB2IDN.OR.ESPBAD(HB2ES0,HB2ESZ,1)) THEN
         CALL GVSTT6 ('?NEWT607')
         GOTO 998
      END IF

      DO 100 IDON=1,NUMDON
         IF (NUXYZH(IDON).GT.0) THEN
            IAT=ARIATD(IDON)
            DO 80 IHAT=INXYZH(IDON),INXYZH(IDON)+NUXYZH(IDON)-1
               IF (ARIATA(1,IHAT).GT.0.AND.ARIATA(2,IHAT).GT.0) THEN
                  CALL DIF015 (6,'?M0345',IAT)
               END IF
 80         CONTINUE
         END IF
 100  CONTINUE



  998 CONTINUE


      RETURN
      END
      SUBROUTINE HB2SPN



















      IMPLICIT      NONE 
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       IAMB, I, GVFFFF, IAA
      LOGICAL       GVFYON, ESPBAD
      REAL          PEN







      IF (.NOT.HB2IDN.OR.ESPBAD(HB2ES0,HB2ESZ,1)) THEN
         CALL GVSTTE ('?NEWE631')
         GOTO 998
      END IF



      IF (GVFYON('?NEWY66',' ')) THEN
         CALL IPROMPT ('?NEWP199')
         I=GVFFFF(1,PEN)
         IF (I.EQ.0) GOTO 998
         IF (PEN.LT.0.0) GOTO 998
         DO 10 IAMB=1,NAMB1
            HB2PEN(IAMB)=PEN
 10      CONTINUE
      ELSE
         CALL IPROMPT ('?NEWP199')
         I=GVFFFF(1,PEN)
         IF (I.EQ.0) GOTO 998
         IF (PEN.LT.0.0) GOTO 998
         CALL WIFGRS (IAA,' ')
         IF (IAA.EQ.0) GOTO 998
         DO 20 IAMB=1,NAMB1
            IF (HB2IAA(IAMB).EQ.IAA) THEN
               HB2PEN(IAMB)=PEN
               CALL HB2IFL
               GOTO 998
            END IF
 20      CONTINUE
         CALL GVSTTE ('?NEWE629')
      END IF
      CALL HB2IFL



  998 CONTINUE


      RETURN
      END
      LOGICAL FUNCTION HB2ISPA(IAT,JAT,ISYM)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'HBONDS.INC'
      INCLUDE       'SYMINC.INC'
      INTEGER       ISYM, IAT, JAT
      REAL          DST, CUTACC, TMP(3)
      LOGICAL       ISHBO, WIFIRW







      WIFPAR(711)=0



      IF (.NOT.USABLE(IAT).OR.DONACC(IAT).LT.0) THEN
         HB2ISPA=.FALSE.
         GOTO 998
      END IF



      IF (.NOT.USABLE(JAT).OR.DONACC(JAT).GT.0) THEN
         HB2ISPA=.FALSE.
         GOTO 998
      END IF
      IF (IAT.EQ.JAT.AND.ISYM.EQ.1) THEN 
         HB2ISPA=.FALSE.
         GOTO 998
      END IF



      IF (WIFPAR(595).GT.0) THEN
         IF (WIFIRW(ATIAA(IAT)).AND.WIFIRW(ATIAA(JAT))) THEN
            PRINT*,'SKIP H2O-H20 BRIDGE...'
            HB2ISPA=.FALSE.
            GOTO 998
         END IF
      END IF




      CUTACC=WIFPAR(481)/100.0+0.5
      TMP(1)=XCOORD(JAT)
      TMP(2)=YCOORD(JAT)
      TMP(3)=ZCOORD(JAT)
      IF (ISYM.NE.1) CALL GVSMPV (TMP,SYMMAT(1,1,ISYM),SYMVEC(1,ISYM))
      DST=(XCOORD(IAT)-TMP(1))**2+
     +    (YCOORD(IAT)-TMP(2))**2+
     +    (ZCOORD(IAT)-TMP(3))**2
      IF (DST.GT.CUTACC**2) THEN
         HB2ISPA=.FALSE.
         GOTO 998
      END IF



      CALL HBO031S (IAT,JAT,ISHBO,ISYM)
      HB2ISPA=ISHBO



  998 CONTINUE


      RETURN
      END
      INTEGER FUNCTION HB2ATP(IAT)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAT, IAA, RIAT, ITYP
      LOGICAL       WIFIRW, WIFIRA, WIFIRN





      IAA=ATIAA(IAT)
      IF (WIFIRA(IAA)) THEN
         RIAT=IAT-PNTAAS(IAA)+1
         IF (RIAT.LT.5) THEN
            ITYP=1
         ELSE
            ITYP=2
         END IF
      ELSE IF (WIFIRN(IAA)) THEN
         ITYP=3
      ELSE IF (WIFIRW(IAA)) THEN
         ITYP=4
      ELSE
         ITYP=5
      END IF
      HB2ATP=ITYP





      RETURN
      END
      REAL FUNCTION HB2FIT()



















      IMPLICIT      NONE
      REAL          TMP







      CALL AREVAL (TMP)
      HB2FIT=TMP





      RETURN
      END
      LOGICAL FUNCTION HB2TRN(IAA)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA







      HB2TRN=(RESTYP(IAA).EQ.7.OR.RESTYP(IAA).EQ.14.OR.
     +        RESTYP(IAA).EQ.12)





      RETURN
      END
      SUBROUTINE HBO031S (IATDON,IATACC,ISHBO,ISYM)




















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'SYMINC.INC'
      INCLUDE       'HBONDS.INC'
      INTEGER       IATDON, IATACC, IERR, ISYM, FIXED
      REAL          XYZ1(3), XYZ2(3), VECT(3), TVEC(3), XYZC(3),
     +              XYZR(3), RMAT(3,3), XYZ3(3), GVFDTR, TMP(3), 
     +              HBO1VAL, HBOVAL
      LOGICAL       ISHBO, WIFITW, REALH







      WIFPAR(711)=0



      IF (DONACC(IATDON).EQ.-1) THEN
         CALL GVSTTB ('?BUGH26')
         GOTO 998
      END IF
      IF (DONACC(IATACC).EQ.1) THEN
         CALL GVSTTB ('?BUGH27')
         GOTO 998
      END IF



      ISHBO=.FALSE.
      IERR=0
      TMP(1)=XCOORD(IATACC)
      TMP(2)=YCOORD(IATACC)
      TMP(3)=ZCOORD(IATACC)
      IF (ISYM.NE.1) CALL GVSMPV (TMP,SYMMAT(1,1,ISYM),
     + SYMVEC(1,ISYM))



      IF (WIFITW(IATDON)) THEN
         XYZ1(1)=TMP(1)-XCOORD(IATDON)
         XYZ1(2)=TMP(2)-YCOORD(IATDON)
         XYZ1(3)=TMP(3)-ZCOORD(IATDON)
         CALL GVSNM3 (XYZ1)
         XYZ1(1)=XYZ1(1)+XCOORD(IATDON)
         XYZ1(2)=XYZ1(2)+YCOORD(IATDON)
         XYZ1(3)=XYZ1(3)+ZCOORD(IATDON)
         HBOVAL=HBO1VAL(IATDON,XYZ1,IATACC,ISYM,.FALSE.)
         WIFPAR(711)=NINT(100*HBOVAL)
         IF (HBOVAL.GT.0.0) ISHBO=.TRUE.
         GOTO 998
      END IF




      CALL HBO012 (IATDON,XYZ1,XYZ2,XYZ3,FIXED,REALH)



      IF (FIXED.GT.0) THEN
         HBOVAL=HBO1VAL(IATDON,XYZ1,IATACC,ISYM,.FALSE.)
         WIFPAR(711)=NINT(100*HBOVAL)
         IF (HBOVAL.GT.0.0) THEN
            ISHBO=.TRUE.
            GOTO 998
         END IF
         IF (FIXED.GT.1) THEN
            HBOVAL=HBO1VAL(IATDON,XYZ2,IATACC,ISYM,.FALSE.)
            WIFPAR(711)=NINT(100*HBOVAL)
            IF (HBOVAL.GT.0.0) THEN
               ISHBO=.TRUE.
               GOTO 998
            END IF
            IF (FIXED.GT.2) THEN
               HBOVAL=HBO1VAL(IATDON,XYZ3,IATACC,ISYM,.FALSE.)
               WIFPAR(711)=NINT(100*HBOVAL)
               IF (HBOVAL.GT.0.0) THEN
                  ISHBO=.TRUE.
                  GOTO 998
               END IF
            END IF
         END IF
      ELSE









         CALL HBO013 (IATDON,XYZC,XYZR,IERR)
         IF (IERR.NE.0) GOTO 998
         CALL GVSNEG (XYZC,3)
         VECT(1)=XCOORD(IATDON)-TMP(1)
         VECT(2)=YCOORD(IATDON)-TMP(2)
         VECT(3)=ZCOORD(IATDON)-TMP(3)
         CALL GVSCP3 (TVEC,XYZC,VECT)
         CALL GVSMGM (RMAT,TVEC,GVFDTR(120.0))
         CALL GVSMV3 (XYZ1,RMAT,XYZC)
         CALL GVSNM3 (XYZ1)



         XYZ1(1)=XYZ1(1)+XCOORD(IATDON)
         XYZ1(2)=XYZ1(2)+YCOORD(IATDON)
         XYZ1(3)=XYZ1(3)+ZCOORD(IATDON)



         HBOVAL=HBO1VAL(IATDON,XYZ1,IATACC,ISYM,.FALSE.)
         WIFPAR(711)=NINT(100*HBOVAL)
         IF (HBOVAL.GT.0) THEN
            ISHBO=.TRUE.
            GOTO 998
         END IF
         CALL GVSMGM (RMAT,TVEC,GVFDTR(-120.0))
         CALL GVSMV3 (XYZ2,RMAT,XYZC)
         CALL GVSNM3 (XYZ2)



         XYZ2(1)=XYZ2(1)+XCOORD(IATDON)
         XYZ2(2)=XYZ2(2)+YCOORD(IATDON)
         XYZ2(3)=XYZ2(3)+ZCOORD(IATDON)
         HBOVAL=HBO1VAL(IATDON,XYZ2,IATACC,ISYM,.FALSE.)
         WIFPAR(711)=NINT(100*HBOVAL)
         IF (HBOVAL.GT.0) THEN
            ISHBO=.TRUE.
            GOTO 998
         END IF
      END IF



  998 CONTINUE


      RETURN
      END
      REAL FUNCTION HBOQVAL(IAT,JAT,ISYM)























      IMPLICIT      NONE 
      INCLUDE       'BIGINC.INC' 
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       IAT, JAT, JATOLD, ISYM, OLD1504
      LOGICAL       HB2ISPA
      SAVE          JATOLD, OLD1504
      DATA          OLD1504 /-1/
      DATA          JATOLD /-1/







      IF (OLD1504.LT.0) THEN
         CALL HB2INI9
      END IF



      IF (JAT.NE.JATOLD.OR.WIFPAR(1504).NE.OLD1504) THEN
         CALL HB2DAT1 (JAT)
         JATOLD=JAT
         OLD1504=WIFPAR(1504)
      END IF



      NUMWHB=0
      IF (HB2ISPA(IAT,JAT,ISYM)) THEN
         HBOQVAL=FLOAT(WIFPAR(711))/100.0
      ELSE
         HBOQVAL=0.0
      END IF





      RETURN
      END
      SUBROUTINE HB2RED



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      LOGICAL*1     SEEN(MAXAMB)
      LOGICAL       INTERRUPTED, WIFIRW, GVFYON
      INTEGER       DONCUR, IAMB, NC2, IAA, HB2MEV, JPA, KDON, IAD, 
     +              JDON, JAMB, JCUR, JAA, JAT, ICUR, JDON1, IPAIR,
     +              JDON2, NUMCN, THECON, BPOS, IPOS, JPOS, IFIX
      REAL          LOGN, LOGLIM, BVAL, VALUE, LOGMCX, LOGCUT, LOGBRF,
     +              LOGNGRP, LOGTOT








      CALL WIFPUSHPPP (166,1)
      CALL WIFPUSHPPP (1183,1)
      IF (WIFPAR(384).NE.0) GOTO 998
      IF (NUMAAT.LE.0) THEN
         CALL GVSTTE ('?SOUEMT')
         GOTO 998
      END IF





      IF (WIFPAR(279).EQ.0) THEN
         IF (WIFPAR(710).LE.0.AND.WIFPAR(1105).LE.0.AND.
     +       WIFPAR(1265).LE.0) THEN
            CALL WIF244 (IPAIR,.TRUE.)
            IF (IPAIR.GT.1) THEN
               CALL SHOWTEXT ('?M2384')
               IF (WIFPAR(493).NE.0) THEN
                  CALL WIFPUSHPPP (1265,1)
                  CALL WIF244 (IPAIR,.TRUE.)
                  CALL WIFPOPPPP (1265)
               ELSE IF (GVFYON('?M2385',' '))  THEN
                  CALL WIFPUSHPPP (1265,1)
                  CALL WIF244 (IPAIR,.TRUE.)
                  CALL WIFPOPPPP (1265)
               ELSE
                  IF (.NOT.GVFYON('?M2386',' ')) GOTO 998
               END IF
            END IF
         ELSE
            CALL WIFPUSHPPP (1265,1)
            CALL WIF244 (IPAIR,.TRUE.)
            CALL WIFPOPPPP (1265)
         END IF
      END IF

      CALL HBO010A
      CALL GVSBTF (USEAT,NUMATF)




      CALL HB2INI

      IF (NUMDON.EQ.0) GOTO 998








      IF (WIFPAR(148).NE.0) THEN
         CALL HB2LSTPEN
         CALL HB2SPN
         CALL HB2LSTPEN
      END IF



      CALL GVSBTF (HB2FLX,MAXAA)
      LOGMCX=0.0
      LOGBRF=0.0
      LOGCUT=0.0
      LOGTOT=0.0
      LOGLIM=FLOAT(WIFPAR(385))/100.0
      HB2MEV=HB2EVA

      DO 140 IAMB=1,NAMB2
         IF (HB2AMB(IAMB).EQ.1) THEN
            SEEN(IAMB)=.TRUE.
         ELSE
            SEEN(IAMB)=.FALSE.
            LOGTOT=LOGTOT+LOG(FLOAT(HB2AMB(IAMB)))/LOG(10.0)
         END IF
 140  CONTINUE



 5    CONTINUE
      IF (LOGTOT.GT.10.0.AND.WIFPAR(363).EQ.0) THEN
         CALL GVSTTR ('?M1009',(LOGMCX+LOGBRF+LOGCUT)/LOGTOT)
      END IF



      DONCUR=0
      CALL GVSBTF (CURCUR,MAXSN2*MAXSN2)
      DO 10 IAMB=1,NAMB2
         IF (.NOT.SEEN(IAMB)) THEN
            NUMCUR=1
            CURR(NUMCUR)=IAMB
            GOTO 20
         END IF
 10   CONTINUE



      CALL GVSTTR ('?M0349',LOGCUT)
      CALL GVSTTR ('?M0350',LOGMCX)
      CALL GVSTTR ('?M0351',LOGBRF)
      CALL GVSTT6 ('?M0352')
      CALL GVSTTI ('?M0353',HB2EVA-HB2MEV) 



      GOTO 900




 20   CONTINUE
      NC2=NUMCUR
      DO 30 ICUR=DONCUR+1,NC2
         IAMB=CURR(ICUR)



         IF (IAMB.GT.NAMB1) THEN
            IAA=HB2IAA(IAMB)
            CALL HB2ARIA (SEEN,IAA,ICUR)
         END IF



         IAA=HB2IAA(IAMB)
         IF (.NOT.WIFIRW(IAA)) THEN
            IF (NUDON(IAA).GT.0) THEN
               DO 200 JDON=INDON(IAA),INDON(IAA)+NUDON(IAA)-1



                  CALL HB2ADIA (SEEN,JDON,ICUR)
 200           CONTINUE
            END IF
         END IF



         IF (NUAD(IAMB).GT.0) THEN
            DO 40 IAD=INAD(IAMB),INAD(IAMB)+NUAD(IAMB)-1
               JDON=ARAD(IAD)



               DO 50 JAMB=NAMB1+1,NAMB2
                  IF (HB2DON(JAMB).EQ.JDON) THEN
                     IF (.NOT.SEEN(JAMB)) THEN
                        CALL HB2RADD (JAMB,ICUR)
                     ELSE IF (HB2AMB(JAMB).GT.1) THEN
                        CALL GVSTTB ('?M0354')
                        CALL GVSTTI2 ('IAMB,JAMB=',IAMB,JAMB)
                        CALL GVSKIL
                     END IF
                  END IF
 50            CONTINUE



               JAT=ARIATD(JDON)
               JAA=ATIAA(JAT)



               IF (JAA.LE.NUMAAF.AND.JAT.LT.PNTAAS(JAA)+4) GOTO 40



               CALL HB2ARIA (SEEN, JAA, ICUR)
 40         CONTINUE
         END IF



         IF (IAMB.GT.NAMB1) THEN



            JDON1=HB2DON(IAMB)
            JDON2=HB2DON(IAMB)
         ELSE



            IAA=HB2IAA(IAMB)
            JDON1=INDON(IAA)+1
            JDON2=INDON(IAA)+NUDON(IAA)-1
         END IF
         IF (JDON2.GE.JDON1) THEN
            DO 70 JDON=JDON1,JDON2



               DO 75 JPA=INPA(JDON),INPA(JDON)+NUPA(JDON)-1
                  JAT=ARPAAT(JPA)
                  JAA=ATIAA(JAT)



                  IF (JAA.GT.NUMAAF.OR.JAT.GT.PNTAAS(JAA)+3) THEN
                     CALL HB2ARIA (SEEN, JAA, ICUR)
                  END IF



                  KDON=ATDON(JAT)
                  IF (KDON.GT.0) CALL HB2ADIA (SEEN, KDON, ICUR)
 75            CONTINUE
 70         CONTINUE
         END IF
 30   CONTINUE

      DONCUR=NC2
      IF (DONCUR.LT.NUMCUR) GOTO 20



      DO 390 ICUR=1,MIN(NUMCUR,MAXSN2)
         CURCUR(ICUR,ICUR)=.FALSE.
 390  CONTINUE
      LOGN=0.0
      DO 620 ICUR=1,NUMCUR
         IAMB=CURR(ICUR)
         LOGN=LOGN+LOG(FLOAT(HB2AMB(IAMB)))/LOG(10.0)
 620  CONTINUE
      LOGCUT=LOGCUT+LOGN
      LOGNGRP=LOGN



      NUMFIX=0
      NUMFFX=0



      IF (NUMCUR.GT.MAXSN2) THEN
         GOTO 500
      END IF




      DO 123 ICUR=1,NUMCUR-1
         DO 122 JCUR=ICUR+1,NUMCUR
            IF (CURCUR(ICUR,JCUR).NEQV.CURCUR(JCUR,ICUR)) THEN
               CALL GVSTTB ('?M0357')
               CALL GVSTTI2 ('ICUR,JCUR=',ICUR,JCUR)
               IAMB=CURR(ICUR)
               JAMB=CURR(JCUR)
               CALL GVSTTI2 ('IAMB,JAMB=',IAMB,JAMB)
               IAA=HB2IAA(IAMB)
               JAA=HB2IAA(JAMB)
               CALL GVSTTI2 ('IAA,JAA=',IAA,JAA)
            END IF
 122     CONTINUE
 123  CONTINUE



 410  CONTINUE



      NUMCN=0
      DO 411 ICUR=1,NUMCUR
         IAMB=CURR(ICUR)
         IF (HB2AMB(IAMB).GT.1) NUMCN=NUMCN+1
 411  CONTINUE
      IF (NUMCN.LE.2) THEN

         GOTO 500
      END IF




      DO 420 ICUR=1,NUMCUR
         NUMCN=0
         THECON=0
         IAMB=CURR(ICUR)



         IF (HB2AMB(IAMB).GT.1) THEN
            DO 430 JCUR=1,NUMCUR
               IF (CURCUR(ICUR,JCUR)) THEN
                  JAMB=CURR(JCUR)
                  IF (HB2AMB(JAMB).GT.1) THEN
                     NUMCN=NUMCN+1
                     THECON=JCUR
                  END IF
               END IF
 430        CONTINUE
         END IF



         IF (NUMCN.EQ.1) THEN



            JAMB=CURR(ICUR)
            IAMB=CURR(THECON)



            LOGN=LOG(1.0*HB2AMB(IAMB)*HB2AMB(JAMB))/LOG(10.0)



            IF (LOGN.LT.LOGLIM.AND.NUMFIX.LT.MAXFIX.AND.
     +           NUMFFX+HB2AMB(JAMB).LE.MAXFFX) THEN
               HB2ORS(NUMFIX+1)=IAMB
               HB2DST(NUMFIX+1)=JAMB
               HB2FAM(NUMFIX+1)=HB2AMB(JAMB)
               HB2FIN(NUMFIX+1)=NUMFFX



               DO 440 IPOS=1,HB2AMB(IAMB)
                  CALL HB2SEP (IAMB,IPOS)
                  BVAL=0.0
                  BPOS=0



                  DO 450 JPOS=1,HB2AMB(JAMB)
                     CALL HB2SEP (JAMB,JPOS)
                     CALL AREVAL (VALUE)
                     IF (VALUE.GT.BVAL) THEN
                        BPOS=JPOS
                        BVAL=VALUE
                     END IF
 450              CONTINUE



                  HB2FFX(NUMFFX+IPOS)=BPOS
 440           CONTINUE



               NUMFIX=NUMFIX+1
               NUMFFX=NUMFFX+HB2AMB(IAMB)



               HB2AMB(JAMB)=1
               GOTO 410
            END IF
         END IF
 420  CONTINUE




 500  CONTINUE
      LOGN=0.0
      DO 120 ICUR=1,NUMCUR
         IAMB=CURR(ICUR)
         LOGN=LOGN+LOG(FLOAT(HB2AMB(IAMB)))/LOG(10.0)
 120  CONTINUE
      IF (LOGN.LT.LOGNGRP.AND.WIFPAR(933).GE.0) THEN
         CALL GVSTTR ('?M0355',LOGN)
      END IF
      LOGCUT=LOGCUT-LOGN

      IF (LOGN.LT.LOGLIM) THEN



         CALL HB2RED1 (CURR,NUMCUR)
         IF (INTERRUPTED()) GOTO 900
         LOGBRF=LOGBRF+LOGN
      ELSE



         CALL HB2TRYS
         IF (INTERRUPTED()) GOTO 900



         DO 560 IFIX=1,NUMFIX
            IAMB=HB2DST(IFIX)
            HB2AMB(IAMB)=HB2FAM(IFIX)
 560     CONTINUE
         LOGMCX=LOGMCX+LOGN
      END IF



      DO 130 ICUR=1,NUMCUR
         IAMB=CURR(ICUR)
         SEEN(IAMB)=.TRUE.
 130  CONTINUE





      GOTO 5



  900 CONTINUE
      WIFPAR(1504)=WIFPAR(1504)+1



  998 CONTINUE
      CALL WIFPOPPPP (1183)
      CALL WIFPOPPPP (166)


      RETURN
      END
      SUBROUTINE HB2RED1 (SUBNET,NSUBNET)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       NSUBNET, SUBNET(NSUBNET), IAMB, TPOS(MAXSNS), INET,
     +              BPOS(MAXSNS), NEVAL
      REAL          VALUE, BVALUE







      IF (NSUBNET.GT.MAXSNS) THEN
         CALL GVSTTB ('?M0360')
         GOTO 998
      END IF

      DO 10 INET=1,NSUBNET
         TPOS(INET)=1
         BPOS(INET)=1
         IAMB=SUBNET(INET)
         IF (HB2AMB(IAMB).GT.1) CALL HB2SEP (IAMB,TPOS(INET))
 10   CONTINUE
      CALL AREVAL (BVALUE)
      NEVAL=0

 20   CONTINUE
      NEVAL=NEVAL+1
      CALL AREVAL (VALUE)
      IF (VALUE.GT.BVALUE) THEN
         BVALUE=VALUE
         DO 30 INET=1,NSUBNET
            BPOS(INET)=TPOS(INET)
 30      CONTINUE
      END IF

      INET=1
      IAMB=SUBNET(INET)
 40   CONTINUE 
      TPOS(INET)=TPOS(INET)+1
      IF (TPOS(INET).GT.HB2AMB(IAMB)) THEN
         TPOS(INET)=1
         IF (HB2AMB(IAMB).GT.1) CALL HB2SEP (IAMB,TPOS(INET))
         INET=INET+1
         IF (INET.GT.NSUBNET) GOTO 50
         IAMB=SUBNET(INET)
         GOTO 40
      END IF
      IF (HB2AMB(IAMB).GT.1) CALL HB2SEP (IAMB,TPOS(INET))
      GOTO 20

 50   CONTINUE
      DO 60 INET=1,NSUBNET
         IAMB=SUBNET(INET)
         IF (HB2AMB(IAMB).GT.1) CALL HB2SEP (IAMB,BPOS(INET))
 60   CONTINUE

      CALL AREVAL (VALUE)
      IF (WIFPAR(933).GE.0) CALL GVSTTR ('?M0361',VALUE)

      IF (ABS(VALUE-BVALUE).GT.0.01) THEN
         IF (WIFPAR(933).GE.0) THEN
            CALL GVSTTB ('?M0362')
            CALL GVSTTR ('?M4522',BVALUE)
         END IF
      ELSE
         DO 70 INET=1,NSUBNET
            IAMB=SUBNET(INET)
            HB2AMB(IAMB)=1
 70      CONTINUE
      END IF



  998 CONTINUE


      RETURN
      END
      SUBROUTINE HB2RADD (JAMB,ICUR)



















      IMPLICIT      NONE 
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       JCUR, JAMB, ICUR





      DO 10 JCUR=1,NUMCUR
         IF (CURR(JCUR).EQ.JAMB) THEN
            IF (ICUR.LE.MAXSN2.AND.JCUR.LE.MAXSN2) THEN
               CURCUR(ICUR,JCUR)=.TRUE.
               CURCUR(JCUR,ICUR)=.TRUE.
            END IF
            GOTO 998
         END IF
 10   CONTINUE
      IF (NUMCUR.GE.MAXSNS) THEN
         CALL GVSTTE ('?M0363')
      ELSE
         NUMCUR=NUMCUR+1
         CURR(NUMCUR)=JAMB
         IF (NUMCUR.LE.MAXSN2) THEN
            CURCUR(ICUR,NUMCUR)=.TRUE.
            CURCUR(NUMCUR,ICUR)=.TRUE.
         END IF
      END IF



  998 CONTINUE


      RETURN
      END
      SUBROUTINE HB2ADIA (SEEN,JDON,ICUR)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       JDON, JAT, JAA, JAMB, ICUR
      LOGICAL*1     SEEN(MAXAMB)
      JAT=ARIATD(JDON)
      JAA=ATIAA(JAT)







      IF (JAA.LE.NUMAAF.AND.JAT.LT.PNTAAS(JAA)+4) GOTO 20



      DO 10 JAMB=1,NAMB1
         IF (HB2IAA(JAMB).EQ.JAA) THEN
            IF (.NOT.SEEN(JAMB)) THEN
               CALL HB2RADD (JAMB,ICUR)
            ELSE IF (HB2AMB(JAMB).GT.1) THEN
               CALL GVSTTB ('?M0364')
               CALL GVSKIL
            END IF
         END IF
 10   CONTINUE



 20   CONTINUE
      DO 30 JAMB=NAMB1+1,NAMB2
         IF (HB2DON(JAMB).EQ.JDON) THEN
            IF (.NOT.SEEN(JAMB)) THEN
               CALL HB2RADD (JAMB,ICUR)
            ELSE IF (HB2AMB(JAMB).GT.1) THEN
               CALL GVSTTB ('?M0364')
               CALL GVSKIL
            END IF
         END IF
 30   CONTINUE





      RETURN
      END
      SUBROUTINE HB2ARIA (SEEN,JAA,ICUR)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       JAA, JAMB, ICUR
      LOGICAL*1     SEEN(MAXAMB)




      
      DO 73 JAMB=1,NAMB1
         IF (HB2IAA(JAMB).EQ.JAA) THEN
            IF (.NOT.SEEN(JAMB)) THEN
               CALL HB2RADD (JAMB,ICUR)
            ELSE IF (HB2AMB(JAMB).GT.1) THEN
               CALL GVSTTB ('?M0365')
               CALL GVSTTI ('JAMB=',JAMB)
               CALL GVSKIL
            END IF
         END IF
 73   CONTINUE





      RETURN
      END
      SUBROUTINE HB2TRYS



















      IMPLICIT      NONE 
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       IAMB, ICUR, SAVAMB(MAXAMB)





      DO 10 IAMB=1,NAMB2
         SAVAMB(IAMB)=HB2AMB(IAMB)
         HB2AMB(IAMB)=1
 10   CONTINUE
      DO 20 ICUR=1,NUMCUR
         IAMB=CURR(ICUR)
         HB2AMB(IAMB)=SAVAMB(IAMB)
 20   CONTINUE
      CALL HB2TRY
      DO 30 IAMB=1,NAMB2
         HB2AMB(IAMB)=SAVAMB(IAMB)
 30   CONTINUE





      RETURN
      END
      SUBROUTINE HB2SEP (GLOBAMB,IPOS)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       IAMB, IPOS, STORE(MAXFIX), NSTOR, ISTOR, NS2, 
     +              NSDONE, GLOBAMB, JAMB, JPOS, IFIX, FFINDEX





      IAMB=GLOBAMB
      IF (IAMB.LT.1.OR.IAMB.GT.NAMB2) THEN
         CALL GVSTTB ('?NEWB233')
         GOTO 998
      END IF
      IF (IPOS.LT.1.OR.IPOS.GT.HB2AMB(IAMB)) THEN
         CALL GVSTTB ('?NEWB234')
         CALL GVSTTI2 ('2: IAMB,HB2IAA = ',IAMB,HB2IAA(IAMB))
         CALL GVSTTI2 ('2: IPOS,HB2AMB = ',IPOS,HB2AMB(IAMB))
         CALL GVSKIL
         GOTO 998
      END IF



      CALL HB2SEPI (IAMB,IPOS)




      IF (NUMFIX.GT.0) THEN



         NSTOR=1
         STORE(NSTOR)=IAMB
         NSDONE=0



 10      CONTINUE



         NS2=NSTOR
         DO 30 ISTOR=NSDONE+1,NS2



            IAMB=STORE(ISTOR)
            DO 20 IFIX=1,NUMFIX



               IF (HB2ORS(IFIX).EQ.IAMB) THEN
                  JAMB=HB2DST(IFIX)
                  IF (HB2AMB(JAMB).EQ.1) THEN
                     HB2AMB(JAMB)=HB2FAM(IFIX)
                     FFINDEX=HB2FIN(IFIX)+HB2POS(IAMB)
                     IF (FFINDEX.GT.NUMFFX) THEN
                        CALL GVSTTB ('?M0366')
                     ELSE



                        JPOS=HB2FFX(FFINDEX)
                        IF (JPOS.GT.HB2AMB(JAMB).OR.JPOS.LE.0) THEN
                           CALL GVSTTI2 ('?M0367',JPOS,HB2AMB(JAMB))
                           GOTO 20
                        ELSE
                           CALL HB2SEPI (JAMB,JPOS)
                        END IF
                     END IF




                     HB2AMB(JAMB)=1
                     NSTOR=NSTOR+1
                     STORE(NSTOR)=JAMB
                  ELSE
                     CALL GVSTTB ('?M0368')
                  END IF
               END IF
 20         CONTINUE
 30      CONTINUE
         NSDONE=NS2




         IF (NSDONE.LT.NSTOR) GOTO 10
      END IF



  998 CONTINUE


      RETURN
      END
      SUBROUTINE HB2AWB



















      IMPLICIT      NONE 
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       IAA, IAT, JAA, JAT, IERR





      IF (NUMWHB.GE.MAXWHB) THEN
         CALL GVSTTE ('?M0369')
         GOTO 998
      END IF

      CALL WIFGAT ('?M0370',IAA,IAT,IERR)
      IF (IERR.NE.0) GOTO 998
      CALL WIFGAT ('?M0371',JAA,JAT,IERR)
      IF (IERR.NE.0) GOTO 998
      NUMWHB=NUMWHB+1
      HB2WHA(NUMWHB)=IAT
      HB2WHD(NUMWHB)=JAT



  998 CONTINUE


      RETURN
      END
      SUBROUTINE HB2CWB



















      IMPLICIT      NONE 
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'





      IF (NUMWHB.GT.0) THEN
         CALL GVSTT6 ('?M0372')
         NUMWHB=0
      ELSE
         CALL GVSTT6 ('?M0373')
      END IF





      RETURN
      END
      SUBROUTINE HB2XYZ (IAMB)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       IAT, IAA, IAMB, IDON, IHAT, NSTEP
      REAL          ANG, HB2TRS
      LOGICAL       WIFIRA, WIFIR1, T54EQUAL





      IAT=HB2IAT(IAMB)
      IAA=HB2IAA(IAMB)
      IF (HB2AMB(IAMB).LT.2) GOTO 998
      IF (RESTYP(IAA).EQ.9.AND.T54EQUAL(ONESAT(IAT),' NZ ')) THEN
         IF (WIFPAR(933).GE.0) CALL GVSTT6 ('?R00212')



         IDON=HB2DON(IAMB)
         IHAT=INXYZH(IDON)
         IF (NUXYZH(IDON).NE.3) THEN
            CALL GVSTTE ('?R00213')
            GOTO 998
         END IF



         ANG=HB2TRS(IAT-2,IAT-1,IAT,IHAT)



         NSTEP=NINT(HB2POS(IAMB)-(180.0-ANG)/HB2DLY)



         NSTEP=MOD(NSTEP+72*HB2LYS-1,HB2LYS)+1



         CALL HB2SEP (IAMB,NSTEP)
         HB2AMB(IAMB)=1
      ELSE IF (WIFIRA(IAA).AND.WIFIR1(IAA).AND.PINIAA(IAT).EQ.1) THEN
         IF (WIFPAR(933).GE.0) CALL GVSTT6 ('?R00214')



         IDON=HB2DON(IAMB)
         IHAT=INXYZH(IDON)
         IF (NUXYZH(IDON).NE.3) THEN
            CALL GVSTTE ('?R00215')
            GOTO 998
         END IF



         ANG=HB2TRS(IAT+2,IAT+1,IAT,IHAT)



         NSTEP=NINT(HB2POS(IAMB)-(180.0-ANG)/HB2DLY)



         NSTEP=MOD(NSTEP+72*HB2LYS-1,HB2LYS)+1



         CALL HB2SEP (IAMB,NSTEP)
         HB2AMB(IAMB)=1
      ELSE IF ((RESTYP(IAA).EQ.16.AND.T54EQUAL(ONESAT(IAT),' OG ')).OR.
     +    (RESTYP(IAA).EQ.17.AND.T54EQUAL(ONESAT(IAT),' OG1'))) THEN
         IF (WIFPAR(933).GE.0) CALL GVSTT6 ('?R00216')



         IDON=HB2DON(IAMB)
         IHAT=INXYZH(IDON)
         IF (NUXYZH(IDON).NE.1) THEN
            CALL GVSTTE ('?R00217')
            GOTO 998
         END IF



         ANG=HB2TRS(IAT-4,IAT-1,IAT,IHAT)



         NSTEP=NINT(HB2POS(IAMB)-(180.0-ANG)/HB2DSE)



         NSTEP=MOD(NSTEP+72*HB2SER-1,HB2SER)+1



         CALL HB2SEP (IAMB,NSTEP)
         HB2AMB(IAMB)=1
      END IF



  998 CONTINUE


      RETURN
      END
      REAL FUNCTION HB2TRS(IAT1,IAT2,IAT3,IHAT)



















      IMPLICIT      NONE 
      INCLUDE       'BIGINC.INC'
      INCLUDE       'CHIANG.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       IAT1,IAT2,IAT3,IHAT
      REAL          DV1(3), DV2(3), DV3(3), VOL, ANG, NORM(3,3),
     +              GVFDP3, GVFRTD, GVFACS







      IF (.NOT.(ISATOK(IAT1).AND.ISATOK(IAT2).AND.ISATOK(IAT3))) THEN
         HB2TRS=0.0
         GOTO 998
      END IF



      DV1(1)=XCOORD(IAT1)-XCOORD(IAT2)
      DV1(2)=YCOORD(IAT1)-YCOORD(IAT2)
      DV1(3)=ZCOORD(IAT1)-ZCOORD(IAT2)
      DV2(1)=XCOORD(IAT2)-XCOORD(IAT3)
      DV2(2)=YCOORD(IAT2)-YCOORD(IAT3)
      DV2(3)=ZCOORD(IAT2)-ZCOORD(IAT3)
      DV3(1)=XCOORD(IAT3)-ARXYZH(1,IHAT)
      DV3(2)=YCOORD(IAT3)-ARXYZH(2,IHAT)
      DV3(3)=ZCOORD(IAT3)-ARXYZH(3,IHAT)



      CALL GVSCP3 (NORM,DV1,DV2)
      CALL GVSCP3 (DV1,DV2,NORM)
      CALL GVSNM3 (DV1)



      CALL GVSCP3 (NORM,DV3,DV2)
      CALL GVSCP3 (DV3,NORM,DV2)
      CALL GVSNM3 (DV3)



      VOL=GVFDP3(DV1,DV3)
      ANG=GVFRTD(GVFACS(VOL))
      IF (GVFDP3(NORM,DV1).GT.0) ANG=-ANG
      HB2TRS=ANG



  998 CONTINUE


      RETURN
      END
      LOGICAL FUNCTION HB2FNK(IAA)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA







      IF (RESTYP(IAA).EQ.12) THEN
         IF (ORGNAM(PNTAAS(IAA)+6).EQ.' AD1'.AND.
     +       ORGNAM(PNTAAS(IAA)+7).EQ.' AD2') THEN
            HB2FNK=.TRUE.
            GOTO 998
         END IF



      ELSE IF (RESTYP(IAA).EQ.14) THEN
         IF (ORGNAM(PNTAAS(IAA)+7).EQ.' AE1'.AND.
     +       ORGNAM(PNTAAS(IAA)+8).EQ.' AE2') THEN
            HB2FNK=.TRUE.
            GOTO 998
         END IF
      END IF



      HB2FNK=.FALSE.



  998 CONTINUE


      RETURN
      END
      SUBROUTINE HB2LSTPEN

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'HB2INC.INC'
      INCLUDE       'ESPACE.INC'
      INTEGER       IAMB








      DO 10 IAMB=1,NAMB1
         CALL DIF002 (6,HB2IAA(IAMB),HB2PEN(IAMB))







   10 CONTINUE





      RETURN
      END   
      SUBROUTINE HB2DB1

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'CNTINC.INC'
      INTEGER       IAA,JAA,KAA,ICON
      REAL          DST,DSTDIF
      LOGICAL       TOUCHED






      CALL ENVTOT
      CALL WIFGRS (IAA,'?M2704')
      CALL WIFGRS (JAA,'?M2705')
      DST=5.0
      DSTDIF=1.0
      TOUCHED=.FALSE.
    4 CONTINUE
      CALL FCONAA (IAA,DST,.FALSE.)
      DO 10 ICON=1,NUMCONIAA
        KAA=CONIAA(ICON)
        IF (KAA.EQ.JAA) GOTO 20
   10 CONTINUE
      CALL GVSTTR ('?M2706',DST)
      IF (TOUCHED) DSTDIF=DSTDIF/2.0
      DST=DST+DSTDIF
      IF (DST.GT.20) GOTO 998
      IF (DSTDIF.LT.0.001) GOTO 998
      GOTO 4
   20 CONTINUE
      CALL GVSTTR ('?M2707',DST)
      IF (.NOT.TOUCHED) DSTDIF=DSTDIF/2.0
      DST=DST-DSTDIF
      IF (DSTDIF.LT.0.001) GOTO 998
      GOTO 4



  998 CONTINUE


      RETURN
      END
      SUBROUTINE HB2FRS



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       IAA, IAMB, I
      LOGICAL       AHEAD







      CALL HB2INI



      CALL WIFGRS (IAA,'?R00314')
      IF (IAA.EQ.0) GOTO 998



      DO 10 IAMB=1,NAMB1
        IF (HB2IAA(IAMB).EQ.IAA) GOTO 20
   10 CONTINUE



      CALL GVSTTE ('?R00315')
      GOTO 998

   20 CONTINUE



      IF (HB2AMB(IAMB).EQ.1) THEN
        CALL GVSTTE ('?R00316')
        GOTO 998
      END IF



      IF (.NOT.AHEAD()) THEN
        CALL GVSTT6 ('?R00317')
      END IF
      CALL WIFG1N ('?R00318',I,0)
      IF (I.EQ.0) THEN
        CALL GVSTT6 ('?R00319')
        GOTO 998
      END IF



      CALL HB2SEP (IAMB, I)
      HB2AMB(IAMB)=1
      CALL GVSTTI ('?R00320',I)



  998 CONTINUE


      RETURN
      END
      SUBROUTINE HB2FAT (IAT,I,IERR)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       IAA, IAT, IERR, IAMB, I
      LOGICAL       AHEAD, WIFIRW, CH4EQCH4







      IERR=0
      IF (WIFPAR(1825).EQ.0) THEN
         CALL HB2INI



         CALL WIFGAT ('?R00321',IAA,IAT,IERR)
      ELSE
         IAA=ATIAA(IAT)
      END IF
      IF (IAA.EQ.0.OR.IAT.EQ.0.OR.IERR.NE.0) GOTO 998



      DO 10 IAMB=NAMB1+1,NAMB2
         IF (HB2IAT(IAMB).EQ.IAT) GOTO 20
   10 CONTINUE



      IERR=1
      CALL GVSTTE ('?R00322')
      CALL DIF025 (IAT)
      GOTO 998

   20 CONTINUE



      IF (HB2AMB(IAMB).EQ.1) THEN
         CALL GVSTT6('?R00323')
         CALL DIF025 (IAT)
         IERR=1
         GOTO 998
      END IF



      IF (WIFPAR(1825).EQ.0) THEN
         IF (.NOT.AHEAD()) THEN



            IF (CH4EQCH4(ONESA3(IAA),'SER ').OR.
     +          CH4EQCH4(ONESA3(IAA),'THR ').OR.
     +          CH4EQCH4(ONESA3(IAA),'TYR ')) THEN
               CALL GVSTTI ('?R00324',HB2SER)
            ELSE IF (CH4EQCH4(ONESA3(IAA),'LYS ')) THEN
               CALL GVSTTI ('?R00325',HB2LYS)
            ELSE IF (CH4EQCH4(ONESA3(IAA),'HIS ').OR.
     +         CH4EQCH4(ONESA3(IAA),'ASP ').OR.
     +         CH4EQCH4(ONESA3(IAA),'GLU ')) THEN
               CALL GVSTT6 ('?R00326')
            ELSE IF (WIFIRW(IAA)) THEN
               CALL GVSTTI ('?R00327',MAXH2P)
            END IF
         END IF
         CALL WIFG1N ('?R00318',I,0)
         IF (I.EQ.0) THEN
            CALL GVSTT6 ('?R00328')
            GOTO 998
         END IF
      END IF



      CALL HB2SEP (IAMB, I)
      HB2AMB(IAMB)=1
      IF (WIFPAR(1825).NE.1) CALL GVSTTI ('?R00329',I)



  998 CONTINUE


      RETURN
      END

      REAL FUNCTION HBODVAL(IATDON,HYD,IATACC,ISYM,LOOKH,DVADIS,DVAANG)
























      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'SYMINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      REAL          DEG,XX
      PARAMETER     (DEG=180.0/3.14159)
      INTEGER       IATDON, IATACC, ISYM, IDOT, IDIS, IANG, JSYM,
     +              SYMNEG, IWHB, IACT, IERR
      REAL          DH, HA, DHA, VDH(3), VHA(3), HYD(3), TMP(3), AFAC,
     +              HB2AFOM, TMPVAL, DOT, DC(3), SHD, DVADIS, DVAANG,
     +              GVFACS
      CHARACTER*1   FIRSTCHARAT
      LOGICAL       LOOKH, DEBUG, CH4EQCH4, WIFIRS, T54EQUAL
      CHARACTER*28  DIF000,D0,D1




      DVADIS=0.0
      DVAANG=0.0



      IF (IATDON.EQ.IATACC.AND.ISYM.EQ.1) THEN
         HBODVAL=0.0
         GOTO 998
      END IF
      DEBUG=.FALSE.
      IF (DEBUG) THEN
        D0=DIF000(IATDON)
        D1=DIF000(IATACC)
      END IF



      TMP(1)=HYD(1)
      TMP(2)=HYD(2)
      TMP(3)=HYD(3)
      DC(1)=XCOORD(IATDON)
      DC(2)=YCOORD(IATDON)
      DC(3)=ZCOORD(IATDON)
      IF (ISYM.NE.1) THEN
         JSYM=SYMNEG(ISYM)
         CALL GVSMPV (TMP,SYMMAT(1,1,JSYM),SYMVEC(1,JSYM))
         CALL GVSMPV (DC,SYMMAT(1,1,JSYM),SYMVEC(1,JSYM))
      END IF



      VHA(1)=XCOORD(IATACC)-TMP(1)
      VHA(2)=YCOORD(IATACC)-TMP(2)
      VHA(3)=ZCOORD(IATACC)-TMP(3)
      HA=VHA(1)**2+VHA(2)**2+VHA(3)**2



      IF (HA.GT.9.0) THEN
         IF (DEBUG) print *,'Distance is too large. Value=0'
         HBODVAL=0.0
         GOTO 998
      END IF
      VDH(1)=TMP(1)-DC(1)
      VDH(2)=TMP(2)-DC(2)
      VDH(3)=TMP(3)-DC(3)
      DOT=VHA(1)*VDH(1)+VHA(2)*VDH(2)+VHA(3)*VDH(3)



      IF (DOT.LT.0.0) THEN
        IF (DEBUG) print *,'Angle DH..A is too small. Value=0'
         HBODVAL=0.0
         GOTO 998
      END IF
      DH=VDH(1)**2+VDH(2)**2+VDH(3)**2



      IF (HA.LE.0.1.OR.DH.LE.0.1) THEN
        IF (DEBUG) print *,'Strange H..A Distance. Value=0'
         HBODVAL=0.0
         GOTO 998
      END IF
      SHD=SQRT(HA*DH)
      IF (ABS(DOT).GE.SHD) THEN
         IF (DOT.GT.0.0) THEN
            DHA=GVFACS(1.0)
         ELSE
            DHA=GVFACS(-1.0)
         END IF
      ELSE
         DHA=GVFACS(DOT/SHD)*DEG
      END IF



      IDOT=1
      IF (FIRSTCHARAT(IATDON).EQ.'O') IDOT=2



      IACT=1
      IF (FIRSTCHARAT(IATACC).EQ.'O') IACT=2



      IF (FIRSTCHARAT(IATACC).EQ.'S'.AND.HA.GT.1.0) THEN
         HA=(SQRT(HA)-0.4)**2
      END IF



      AFAC=HB2AFOM(IDOT,TMP,IATACC,LOOKH,IERR)
      if (debug) PRINT *,'AFOM=',AFAC,'IERR=',IERR
      IF (IERR.NE.0) THEN
         HBODVAL=0.0
         GOTO 998
      END IF
      IDIS=INT(SQRT(HA)*10.0)+1
      IANG=INT(DHA/5.0)+1
      IF (IANG.GT.18) IANG=18
      IF (IDIS.GT.40) IDIS=40



      DVAANG=DHA
      DVADIS=SQRT((XCOORD(IATDON)-XCOORD(IATACC))**2 +
     +            (YCOORD(IATDON)-YCOORD(IATACC))**2 +
     +            (ZCOORD(IATDON)-ZCOORD(IATACC))**2)
      IF (debug) THEN
         PRINT *,'DONOR AT',XCOORD(IATDON),YCOORD(IATDON),ZCOORD(IATDON)
         PRINT *,'ACCEP AT',XCOORD(IATACC),YCOORD(IATACC),ZCOORD(IATACC)
         PRINT *,'HYDRO AT',HYD(1),HYD(2),HYD(3)
         PRINT *,'HA=',HA,' DHA=',DHA
         PRINT *,'IANG=',IANG,' IDIS=',IDIS
         PRINT *,'IDOT=',IDOT,' IACT=',IACT
         PRINT *,'AUT=',HB2AUT(IANG,IDOT,IACT)
         PRINT *,'DUT=',HB2DUT(IDIS,IDOT,IACT)
      END IF
      TMPVAL=AFAC*HB2AUT(IANG,IDOT,IACT)*HB2DUT(IDIS,IDOT,IACT)
      IF (debug) THEN
        PRINT *,'TMPVAL=',TMPVAL
      END IF



      IF (TMPVAL.LE.1.E-8) THEN
         HBODVAL=0.0
         GOTO 998
      END IF



      TMPVAL=1.0+LOG(TMPVAL)/LOG(2.71828)/HB2ERT
      IF (debug) THEN
         PRINT *,'NORMALIZED=',TMPVAL
      END IF



      IF (FIRSTCHARAT(IATACC).EQ.'S') THEN
         if (debug) THEN
            print *,'Scaling hbond to S by factor of 4 down'
         end if
         TMPVAL=TMPVAL/4.0
      END IF



      IF (NUMWHB.GT.0) THEN
         DO 700 IWHB=1,NUMWHB
            IF (IATDON.EQ.HB2WHD(IWHB).AND.IATACC.EQ.HB2WHA(IWHB)) THEN
               TMPVAL=TMPVAL*WHBFAC
               GOTO 701
            END IF
 700     CONTINUE
      END IF







      IF (WIFPAR(1859).EQ.1) THEN
         IF (CH4EQCH4(ONESA3(ATIAA(IATACC)),'TYR ').AND.
     +       T54EQUAL(ONESAT(IATACC),' OH ')) THEN
            IF (WIFPAR(1860).EQ.0.AND.WIFPAR(1861).EQ.0) 
     +         TMPVAL=TMPVAL*10
            IF (ATIAA(IATACC).EQ.WIFPAR(1860).OR.
     +          ATIAA(IATACC).EQ.WIFPAR(1861)) THEN
               TMPVAL=TMPVAL*10
            END IF
         END IF
      END IF



      IF (WIFPAR(1871).EQ.1) THEN
         IF (CH4EQCH4(ONESA3(ATIAA(IATACC)),'CYS ').AND.
     +       T54EQUAL(ONESAT(IATACC),' SG ').AND.
     +       .NOT.WIFIRS(ATIAA(IATACC))) THEN
            IF (WIFPAR(1872).EQ.0.AND.WIFPAR(1873).EQ.0) 
     +         TMPVAL=TMPVAL*10
            IF (ATIAA(IATACC).EQ.WIFPAR(1872).OR.
     +          ATIAA(IATACC).EQ.WIFPAR(1873)) THEN
               TMPVAL=TMPVAL*10
            END IF
         END IF
      END IF

 701  CONTINUE




      IF (WIFPAR(594).GT.0) THEN
         XX=MAX(XBFACT(IATACC),XBFACT(IATDON))
         XX=(60-XX)/60
         TMPVAL=TMPVAL*MIN(1.0,MAX(0.0,XX))
      END IF



      HBODVAL=MIN(9.99,TMPVAL)



  998 CONTINUE


      RETURN
      END

