



      SUBROUTINE HAS000 (DONE)


















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'OPTION.INC'
      LOGICAL       DONE







      IF (OPTIN.EQ.MEN6COD(104)) GOTO 998
      CALL MEN040 (OPTIN,DONE)



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE HAS001 (PRTFLG)






















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA
      LOGICAL       WIFIRA, PRTFLG, HASPROTON, AAHASPROTON







      IF (WIFPAR(195).GT.1) CALL GVSTT6 ('?M4747')
      IF (WIFPAR(84).EQ.0) GOTO 998
      IF (WIFPAR(166).EQ.0) THEN
         IF (.NOT.HASPROTON()) GOTO 998
      END IF
      IF (WIFPAR(1209).GT.0) GOTO 998
      IF (WIFPAR(195).GT.2) CALL SHOIAA (1)



      IF (WIFPAR(195).GT.1) CALL GVSTT6 ('?M4748')
      CALL HAS008 (1,NUMAAF)
      IF (WIFPAR(195).GT.2) CALL SHOIAA (1)



      IF (WIFPAR(195).GT.1) CALL GVSTT6 ('?M4749')
      CALL HAS014C (1,NUMAAF)
      IF (WIFPAR(195).GT.2) CALL SHOIAA (1)
      IF (WIFPAR(195).GT.1) CALL GVSTT6 ('?M4750')
      CALL HAS008 (1,NUMAAF)
      IF (WIFPAR(195).GT.2) CALL SHOIAA (1)



      IF (WIFPAR(195).GT.1) CALL GVSTT6 ('?M4751')
      CALL HAS017
      IF (WIFPAR(195).GT.2) CALL SHOIAA (1)



      IF (WIFPAR(195).GT.1) CALL GVSTT6 ('?M4752')
      CALL HAS014 (PRTFLG,1,NUMAAF)
      IF (WIFPAR(195).GT.2) CALL SHOIAA (1)



      IF (WIFPAR(195).GT.1) CALL GVSTT6 ('?M4753')
      CALL HAS014A (PRTFLG,1,NUMAAF)
      IF (WIFPAR(195).GT.2) CALL SHOIAA (1)



      IF (WIFPAR(195).GT.1) CALL GVSTT6 ('?M4754')
      DO 110 IAA=1,NUMAAF
         IF (.NOT.AAHASPROTON(IAA).AND.WIFPAR(166).EQ.0) GOTO 110
         IF (WIFIRA(IAA)) CALL HAS001A (IAA)
  110 CONTINUE
      IF (WIFPAR(195).GT.2) CALL SHOIAA (1)



      IF (WIFPAR(1172).NE.0) THEN
         IF (WIFPAR(195).GT.1) CALL GVSTT6 ('?M4755')
         CALL HAS014B (1,NUMAAF)
      END IF
      IF (WIFPAR(195).GT.2) CALL SHOIAA (1)



      IF (WIFPAR(195).GT.1) CALL GVSTT6 ('?M4756')
      CALL HAS019
      IF (WIFPAR(195).GT.2) CALL SHOIAA (1)



  998 CONTINUE


      RETURN
      END
      SUBROUTINE HAS001A (IAA)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, HATARR(4), JATARR(4), NUM, HNUM, JAT, KAT, IAT,
     +              GVFIMN, MEMORY, OKCNT, LEVEL
      LOGICAL       WIFIRA, WIFIRN, AAHASPROTON







      IF (WIFPAR(84).EQ.0) GOTO 998
      IF (WIFPAR(166).EQ.0) THEN
         IF (.NOT.AAHASPROTON(IAA)) GOTO 998
      END IF
      IF ((.NOT.WIFIRA(IAA)).AND.(.NOT.WIFIRN(IAA))) GOTO 998



      DO 90 IAT=PNTAAS(IAA),PNTAAE(IAA)
         IF (.NOT.PROTON(IAT).AND.ISATOK(IAT).AND.PINIAA(IAT).GT.1) THEN




            CALL FBONDH (IAT,HATARR,4,HNUM)
            IF (HNUM.NE.3) GOTO 90
            OKCNT=0
            MEMORY=0
            LEVEL=0
            DO 10 JAT=1,3
               IF (ISATOK(HATARR(JAT))) THEN
                  OKCNT=OKCNT+1
               ELSE
                  MEMORY=HATARR(JAT)
                  LEVEL=JAT
               END IF
   10       CONTINUE



            IF (OKCNT.EQ.3) THEN



               CALL GVSIR1 (HATARR,HNUM)



               CALL FBONDA (IAT,JATARR,4,NUM)
               IF (NUM.NE.1) THEN
                  CALL GVSTTB ('?R00236')
                  CALL DIF015 (6,'?R00252',IAT)
                  GOTO 998
               END IF
               JAT=JATARR(1)



               CALL FBONDA (JAT,JATARR,4,NUM)
               IF (NUM.LE.1) THEN
                  CALL GVSTTB ('?R00237')
                  GOTO 998
               END IF
               KAT=GVFIMN(JATARR,NUM)



               IF (ISATOK(JAT).AND.ISATOK(KAT)) THEN
                  CALL HAS001C (KAT,JAT,IAT,HATARR(1),HATARR(2),
     +             HATARR(3))
               END IF
            ELSE IF (OKCNT.EQ.2) THEN



               CALL FBONDA (IAT,JATARR,4,NUM)
               IF (NUM.NE.1) THEN
                  CALL GVSTTB ('?R00236')
                  CALL DIF015 (6,'?R00252',IAT)
                  GOTO 998
               END IF
               JAT=JATARR(1)



               CALL HAS001B (IAA,IAT,JAT,HATARR,MEMORY,LEVEL)
               ISATOK(MEMORY)=.TRUE.
               CALL GVSSTX (ORGNAM(MEMORY),'XXXX')



               CALL HAS014AT (IAT)
               DO 20 JAT=1,3
                  IF (ORGNAM(HATARR(JAT)).EQ.'XXXX') THEN
                     MEMORY=HATARR(JAT)
                  END IF
   20          CONTINUE



               XCOORD(MEMORY)=0.0
               YCOORD(MEMORY)=0.0
               ZCOORD(MEMORY)=0.0
               ISATOK(MEMORY)=.FALSE.



               IF (LEVEL.EQ.1) THEN
                  CALL HAS017A (HATARR(1),HATARR(2))
                  CALL HAS017A (HATARR(2),HATARR(3))
               ELSE IF (LEVEL.EQ.2) THEN
                  CALL HAS017A (HATARR(1),HATARR(2))
               END IF
            END IF
         END IF
   90 CONTINUE



  998 CONTINUE


      RETURN 
      END   
      SUBROUTINE HAS001B (IAA,IAT,JAT,HATARR,MEMORY,LEVEL)


















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAT, IAA, JAT, HATARR(4), MEMORY, LEVEL
      LOGICAL       AAHASPROTON







      IF (ISATOK(HATARR(1)).AND.ISATOK(HATARR(2)).AND.
     + ISATOK(HATARR(3))) GOTO 998
      IF (.NOT.ISATOK(IAT).OR.(.NOT.ISATOK(JAT))) GOTO 998
      IF (WIFPAR(166).EQ.0) THEN
         IF (.NOT.AAHASPROTON(IAA)) GOTO 998
      END IF



      SCRRW1(1)=XCOORD(JAT)-XCOORD(IAT)
      SCRRW1(2)=YCOORD(JAT)-YCOORD(IAT)
      SCRRW1(3)=ZCOORD(JAT)-ZCOORD(IAT)
      CALL GVSNM3 (SCRRW1)
      IF (LEVEL.EQ.3) THEN
         SCRRW2(1)=XCOORD(HATARR(1))-XCOORD(IAT)
         SCRRW2(2)=YCOORD(HATARR(1))-YCOORD(IAT)
         SCRRW2(3)=ZCOORD(HATARR(1))-ZCOORD(IAT)
         SCRRW3(1)=XCOORD(HATARR(2))-XCOORD(IAT)
         SCRRW3(2)=YCOORD(HATARR(2))-YCOORD(IAT)
         SCRRW3(3)=ZCOORD(HATARR(2))-ZCOORD(IAT)
      ELSE IF (LEVEL.EQ.2) THEN
         SCRRW2(1)=XCOORD(HATARR(1))-XCOORD(IAT)
         SCRRW2(2)=YCOORD(HATARR(1))-YCOORD(IAT)
         SCRRW2(3)=ZCOORD(HATARR(1))-ZCOORD(IAT)
         SCRRW3(1)=XCOORD(HATARR(3))-XCOORD(IAT)
         SCRRW3(2)=YCOORD(HATARR(3))-YCOORD(IAT)
         SCRRW3(3)=ZCOORD(HATARR(3))-ZCOORD(IAT)
      ELSE IF (LEVEL.EQ.1) THEN
         SCRRW2(1)=XCOORD(HATARR(2))-XCOORD(IAT)
         SCRRW2(2)=YCOORD(HATARR(2))-YCOORD(IAT)
         SCRRW2(3)=ZCOORD(HATARR(2))-ZCOORD(IAT)
         SCRRW3(1)=XCOORD(HATARR(3))-XCOORD(IAT)
         SCRRW3(2)=YCOORD(HATARR(3))-YCOORD(IAT)
         SCRRW3(3)=ZCOORD(HATARR(3))-ZCOORD(IAT)
      ELSE
         CALL GVSTTI ('?M1996',LEVEL)
         GOTO 998
      END IF



      CV(1)=-SCRRW1(1)-SCRRW2(1)-SCRRW3(1)
      CV(2)=-SCRRW1(2)-SCRRW2(2)-SCRRW3(2)
      CV(3)=-SCRRW1(3)-SCRRW2(3)-SCRRW3(3)
      CALL GVSNM3 (CV)



      XCOORD(MEMORY)=CV(1)+XCOORD(IAT)
      YCOORD(MEMORY)=CV(2)+YCOORD(IAT)
      ZCOORD(MEMORY)=CV(3)+ZCOORD(IAT)



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE HAS001C (IAT1,IAT2,IAT3,IAT4,IAT5,IAT6)






















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAT1, IAT2, IAT3, IAT4, IAT5, IAT6
      REAL          CHI001, CHI1, CHI2, CHI3, GVFRTD







      IF (WIFPAR(84).EQ.0) GOTO 998



      IF (IAT4.EQ.0.OR.IAT5.EQ.0.OR.IAT6.EQ.0) THEN
         CALL GVSTT6 ('?M1336')
         GOTO 998
      END IF
      IF (.NOT.(ISATOK(IAT4).AND.ISATOK(IAT5).AND.ISATOK(IAT6))) THEN
         CALL GVSTT6 ('?M1337')
         GOTO 998
      END IF
      IF ((.NOT.PROTON(IAT4)).OR.(.NOT.PROTON(IAT5)).OR.
     +    (.NOT.PROTON(IAT6)).OR.PROTON(IAT1).OR.PROTON(IAT2).OR.
     +    PROTON(IAT3)) THEN
         CALL DIF008 ('?M1412',ATIAA(IAT1))
         CALL GVSKIL
         GOTO 998
      END IF



      CHI1=ABS(GVFRTD(CHI001(IAT1,IAT2,IAT3,IAT4)))
      CHI2=ABS(GVFRTD(CHI001(IAT1,IAT2,IAT3,IAT5)))
      CHI3=ABS(GVFRTD(CHI001(IAT1,IAT2,IAT3,IAT6)))



      IF (CHI1.LT.CHI2.AND.CHI1.LT.CHI3) THEN
         GOTO 10
      ELSE IF (CHI2.LT.CHI1.AND.CHI2.LT.CHI3) THEN



         CALL MOL203I (IAT4,IAT6,0)
         CALL MOL203I (IAT4,IAT5,0)
      ELSE IF (CHI3.LT.CHI1.AND.CHI3.LT.CHI2) THEN



         CALL MOL203I (IAT4,IAT5,0)
         CALL MOL203I (IAT4,IAT6,0)
      END IF



   10 CONTINUE
      CHI1=ABS(GVFRTD(CHI001(IAT1,IAT2,IAT3,IAT4)))
      CHI2=ABS(GVFRTD(CHI001(IAT1,IAT2,IAT3,IAT5)))
      CHI3=ABS(GVFRTD(CHI001(IAT1,IAT2,IAT3,IAT6)))

      IF (CHI1.GT.CHI2.OR.CHI1.GT.CHI3) THEN
         CALL DIF015 (6,'?M1413',IAT3)
         CALL GVSTTR3 ('?M1414',CHI1,CHI2,CHI3)
      END IF



  998 CONTINUE


      RETURN
      END   

      SUBROUTINE HAS003 (JFT1,JFT2)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'HBONDS.INC'
      INTEGER       IAA, IAT, IERR, NUM, JATSYM(4), JFT1, JFT2, ISYM, 
     +              JATARR(4), METAL
      LOGICAL       WIFIR1, WIFIRR, WIFIR6







      IF (WIFPAR(384).NE.0) GOTO 998
      IF (WIFPAR(84).EQ.0) THEN
         CALL GVSTTE ('?R00269')
         GOTO 998
      END IF
      IF (NUMAAT.LE.0) THEN
         CALL GVSTTE ('?SOUEMP')
         GOTO 998
      END IF



      CALL HAS020
      CALL GVSIT0 (FUTURE,MAXAA)




      IF (WIFPAR(1073).EQ.0) THEN
         CALL GVSBTF (WRK1TF,NUMAAT)
         IF (JFT1.EQ.0) THEN
            CALL WIFWTF (' ',IERR)
            IF (IERR.NE.0) GOTO 900
         ELSE
            DO 70 IAA=JFT1,JFT2
               WRK1TF(IAA)=.TRUE.
   70       CONTINUE
         END IF
      END IF
      CALL WRKFUT




      CALL SHOSOU
      CALL KLONKSTART (IERR)
      IF (NUMAAT.GT.NUMAAF) THEN
         CALL WIFPUSHPPP (138,1)
         CALL KLONKUP
         CALL WIFPOPPPP (138)
      END IF
      CALL FUTWRK
      CALL ENVTOT
      CALL HBO010
      CALL FUTWRK



      CALL SHOSOU
      DO 100 IAA=1,NUMAAF
         IF (.NOT.WRK4TF(IAA)) GOTO 100
         IF ((.NOT.WIFIRR(IAA)).AND.(.NOT.WIFIR6(IAA))) GOTO 100



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



         DO 90 IAT=PNTAAS(IAA),PNTAAE(IAA)
            IF (PROTON(IAT)) GOTO 90
            IF (.NOT.ISATOK(IAT)) GOTO 90



            IF (USABLE(IAT).AND.DONACC(IAT).GE.0) GOTO 90



            IF (RESTYP(IAA).EQ.2.AND.PINIAA(IAT).EQ.6) THEN
               CALL FBONDS (IAT,JATARR,JATSYM,4,NUM)
               IF (NUM.GT.2) GOTO 90
               CALL PDBC04C (IAT,METAL,ISYM)
               IF (METAL.GT.0) THEN
                  CALL DIF015 (6,'?R00268',IAT)
                  GOTO 90
               END IF
            END IF



            CALL HAS011 (IAT)
   90    CONTINUE
  100 CONTINUE
      CALL FUTWRK



      DO 120 IAA=1,NUMAAF
         IF (WIFIR1(IAA).AND.WRK4TF(IAA)) THEN
            CALL HAS010 (IAA)
         END IF
 120  CONTINUE
      CALL FUTWRK



      IF (WIFPAR(1146).NE.0) THEN
         DO 130 IAA=1,NUMAAF
            IF (WRK1TF(IAA).AND.(RESTYP(IAA).EQ.3.OR.RESTYP(IAA).EQ.4)) 
     +          THEN
               CALL HAS018 (IAA,2)
            END IF
  130    CONTINUE
      END IF
      CALL FUTWRK



      CALL KLONKDOWN
      CALL KLONKEND
      CALL MOL200
      CALL FUTWRK



      CALL HB2INI
      CALL HB2RED
      CALL FUTWRK



      CALL KLONKSTART (IERR)
      CALL GVSCPB (WRK4TF,WRK1TF,NUMAAT)
      CALL FUTWRK
      CALL HAS003C
      CALL FUTWRK
      CALL KLONKDOWN
      CALL KLONKEND
      CALL MOL200
      CALL FUTWRK



      CALL HAS003A (2,1,NUMAAT)



      CALL COL102 (1,NUMAAT)



  900 CONTINUE



  998 CONTINUE


      RETURN
      END
      SUBROUTINE HAS003A (TAKEALL,IFT1,IFT2)























      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       TAKEALL, IAT, IAA, IFT1, IFT2
      LOGICAL       GVFIBN







      IF (WIFPAR(1209).GT.0) GOTO 998



      CALL MOL200
      CALL MOL199 (1,NUMAAF)
      CALL MOL200
      CALL MOL199 (1,NUMAAF)
      CALL MOL200



      DO 20 IAA=1,NUMAAT
         IF (TAKEALL.EQ.0.OR.TAKEALL.EQ.5) THEN
            IF (IAA.GT.NUMAAF) GOTO 20
         ELSE IF (TAKEALL.EQ.2.OR.TAKEALL.EQ.7) THEN
            IF (.NOT.WRK1TF(IAA)) GOTO 20
         ELSE IF (TAKEALL.EQ.3.OR.TAKEALL.EQ.8) THEN
            IF (.NOT.WRK2TF(IAA)) GOTO 20
         ELSE IF (TAKEALL.EQ.4.OR.TAKEALL.EQ.9) THEN
            IF (.NOT.GVFIBN(IAA,IFT1,IFT2)) GOTO 20
         END IF
         DO 10 IAT=PNTAAS(IAA),PNTAAE(IAA)
            IF (.NOT.PROTON(IAT).AND.TAKEALL.LE.4) GOTO 10
            CALL GVSSTX (ORGNAM(IAT),ONESAT(IAT))
   10    CONTINUE
   20 CONTINUE



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE HAS003B (IAA)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAT, IP, IN, IAA







      IP=0
      IN=0



      DO 10 IAT=PNTAAS(IAA),PNTAAE(IAA)
         IF (PROTON(IAT)) THEN
            IF (ISATOK(IAT)) THEN
               IP=IP+1
            ELSE
               IN=IN+1
            END IF
         END IF
 10   CONTINUE



      IF (IP.NE.0.AND.IN.NE.0) THEN
         DO 20 IAT=PNTAAS(IAA),PNTAAE(IAA)
            IF (PROTON(IAT)) THEN
               XCOORD(IAT)=0.0
               YCOORD(IAT)=0.0
               ZCOORD(IAT)=0.0
               ISATOK(IAT)=.FALSE.
            END IF
 20      CONTINUE
      END IF





      RETURN
      END   
      SUBROUTINE HAS003C

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       IAT, IAA, IDON, HNUM, I, HATARR(6), IATACC,
     +              IERR, NUL, NU, NUMH, IAAACC, JAC, IHIS1, IHIS2, JAA,
     +              JAT
      REAL          D1, D2, WIFDST
      LOGICAL       ESPBAD, WIFITW, INTERRUPTED







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



      IF (WIFPAR(84).EQ.0) THEN
         CALL GVSTTE ('?R00269')
         GOTO 998
      END IF



      CALL GVSIT0 (IATVAL,NUMATF)
      CALL GVSIT0 (IATVL2,NUMATF)
      NUL=0



      IF (HBODBG) THEN
         WRITE (17,*,ERR=999) 'PROTON: numdon=',numdon
         WRITE (17,*,ERR=999) 'ARIATD',(ariatd(idon),idon=1,numdon)
         DO 123 IDON=1,NUMDON
 124        FORMAT (6F6.1)
            IAT=ARIATD(IDON)
            IAA=ATIAA(IAT)
            NUMH=INXYZH(IDON)
            NU=NUXYZH(IDON)
            WRITE (17,*,ERR=999) ONESA3(IAA),'(',NUMNAM(IAA),
     +       ')',ONESAT(IAT),' NU=',NU,' NUMH=',NUMH
            IF (NU.GE.1) WRITE (17,124,ERR=999) XCOORD(IAT),
     +       YCOORD(IAT),ZCOORD(IAT)
            IF (NU.GE.1) THEN
               WRITE (17,124,ERR=999) (ARXYZH(I,NUMH),I=1,3),
     +          SQRT((XCOORD(IAT)-ARXYZH(1,NUMH))**2+
     +               (YCOORD(IAT)-ARXYZH(2,NUMH))**2+
     +               (ZCOORD(IAT)-ARXYZH(3,NUMH))**2)
            END IF
            IF (NU.GE.2) THEN
               WRITE (17,124,ERR=999) (ARXYZH(I,NUMH+1),I=1,3),
     +          SQRT((XCOORD(IAT)-ARXYZH(1,NUMH+1))**2+
     +               (YCOORD(IAT)-ARXYZH(2,NUMH+1))**2+
     +               (ZCOORD(IAT)-ARXYZH(3,NUMH+1))**2)
            END IF
            IF (NU.GE.3) THEN
               WRITE (17,124,ERR=999) (ARXYZH(I,NUMH+2),I=1,3),
     +          SQRT((XCOORD(IAT)-ARXYZH(1,NUMH+2))**2+
     +               (YCOORD(IAT)-ARXYZH(2,NUMH+2))**2+
     +               (ZCOORD(IAT)-ARXYZH(3,NUMH+2))**2)
            END IF
 123     CONTINUE
      END IF



      DO 100 IDON=1,NUMDON




         IAT=ARIATD(IDON)
         IAA=ATIAA(IAT)
         NUMH=INXYZH(IDON)
         NU=NUXYZH(IDON)



         IF (PROTON(IAT)) THEN
            CALL DIF015A (IAT,'?M4626')
            GOTO 100
         END IF
         IF (.NOT.WRK4TF(IAA)) GOTO 100



         IF (NU.EQ.0) THEN
            IF (RESTYP(IAA).EQ.7) THEN
               IF (IAT.GT.PNTAAS(IAA)+4) THEN
                  CALL FBONDH (IAT,HATARR,6,HNUM)
                  CALL HAS012 (HATARR(1))
               END IF
            END IF
            GOTO 100
         END IF



         IF (WIFITW(IAT)) THEN
            IF (HBODBG) WRITE (17,*,ERR=998) 'water:',iat,onesat(iat),
     +       onesat(iat+1)
            IF (NU.NE.2) THEN
               CALL GVSTTI ('?M4625',NU)
               GOTO 100
            END IF
            IF (PROTON(IAT+1)) THEN
               XCOORD(IAT+1)=ARXYZH(1,NUMH)
               YCOORD(IAT+1)=ARXYZH(2,NUMH)
               ZCOORD(IAT+1)=ARXYZH(3,NUMH)
               WEIGHT(IAT+1)=1.0
               ISATOK(IAT+1)=.TRUE.
            ELSE
               CALL GVST6C ('?M3906',ORGNAM(IAT),.TRUE.)
               GOTO 100
            END IF
            IF (PROTON(IAT+2)) THEN
               XCOORD(IAT+2)=ARXYZH(1,NUMH+1)
               YCOORD(IAT+2)=ARXYZH(2,NUMH+1)
               ZCOORD(IAT+2)=ARXYZH(3,NUMH+1)
               WEIGHT(IAT+2)=1.0
               ISATOK(IAT+2)=.TRUE.
            ELSE
               CALL GVST6C ('?M3907',ORGNAM(IAT),.TRUE.)
            END IF
            GOTO 100
         END IF




         CALL FBONDH (IAT,HATARR,4,HNUM)



         IF (HNUM.LT.NU) THEN
            IF (HBODBG) WRITE (17,*,ERR=998) 'NUMBERS =',HNUM,NU



            IF (RESTYP(IAA).EQ.3) THEN
               D1=SQRT(
     +          (XCOORD(PNTAAS(IAA)+6)-ARXYZH(1,INXYZH(IDON)))**2+
     +          (YCOORD(PNTAAS(IAA)+6)-ARXYZH(2,INXYZH(IDON)))**2+
     +          (ZCOORD(PNTAAS(IAA)+6)-ARXYZH(3,INXYZH(IDON)))**2)
               D2=SQRT(
     +          (XCOORD(PNTAAS(IAA)+7)-ARXYZH(1,INXYZH(IDON)))**2+
     +          (YCOORD(PNTAAS(IAA)+7)-ARXYZH(2,INXYZH(IDON)))**2+
     +          (ZCOORD(PNTAAS(IAA)+7)-ARXYZH(3,INXYZH(IDON)))**2)
               IF (D1.LT.D2) THEN
                  CALL GVSWAP (XCOORD(PNTAAS(IAA)+6),
     +             XCOORD(PNTAAS(IAA)+7))
                  CALL GVSWAP (YCOORD(PNTAAS(IAA)+6),
     +             YCOORD(PNTAAS(IAA)+7))
                  CALL GVSWAP (ZCOORD(PNTAAS(IAA)+6),
     +             ZCOORD(PNTAAS(IAA)+7))
               END IF
               CALL KLONKSET (SOUPNT(IAA),NUL,IERR)
               CALL KLONKTOD ('ATOM  ',' HD2 ',' HD2 ',' ','ASP ',
     +          ' ',NUMNAM(IAA),' ',ARXYZH(1,INXYZH(IDON)),
     +          ARXYZH(2,INXYZH(IDON)),ARXYZH(3,INXYZH(IDON)),
     +          1.0,12.0,'  ',0,'ASP ',0,IERR)
               GOTO 100



            ELSE IF (RESTYP(IAA).EQ.4) THEN
               D1=SQRT(
     +          (XCOORD(PNTAAS(IAA)+7)-ARXYZH(1,INXYZH(IDON)))**2+
     +          (YCOORD(PNTAAS(IAA)+7)-ARXYZH(2,INXYZH(IDON)))**2+
     +          (ZCOORD(PNTAAS(IAA)+7)-ARXYZH(3,INXYZH(IDON)))**2)
               D2=SQRT(
     +          (XCOORD(PNTAAS(IAA)+8)-ARXYZH(1,INXYZH(IDON)))**2+
     +          (YCOORD(PNTAAS(IAA)+8)-ARXYZH(2,INXYZH(IDON)))**2+
     +          (ZCOORD(PNTAAS(IAA)+8)-ARXYZH(3,INXYZH(IDON)))**2)
               IF (D1.LT.D2) THEN
                  CALL GVSWAP (XCOORD(PNTAAS(IAA)+7),
     +             XCOORD(PNTAAS(IAA)+8))
                  CALL GVSWAP (YCOORD(PNTAAS(IAA)+7),
     +             YCOORD(PNTAAS(IAA)+8))
                  CALL GVSWAP (ZCOORD(PNTAAS(IAA)+7),
     +             ZCOORD(PNTAAS(IAA)+8))
               END IF
               CALL KLONKSET (SOUPNT(IAA),NUL,IERR)
               CALL KLONKTOD ('ATOM  ',' HE2 ',' HE2 ',' ','GLU ',
     +          ' ',NUMNAM(IAA),' ',ARXYZH(1,INXYZH(IDON)),
     +          ARXYZH(2,INXYZH(IDON)),ARXYZH(3,INXYZH(IDON)),
     +          1.0,12.0,'  ',0,'GLU ',0,IERR)
               GOTO 100
            END IF
            IF (HBODBG) WRITE (17,*,ERR=998) 'PROTON NOT USED FOR:',
     +       IAA,ONESA3(IAA),'(',NUMNAM(IAA),')',IAT,ONESAT(IAT)
            GOTO 100
         END IF



         IF (NU.GE.1) THEN
            XCOORD(HATARR(1))=ARXYZH(1,NUMH)
            YCOORD(HATARR(1))=ARXYZH(2,NUMH)
            ZCOORD(HATARR(1))=ARXYZH(3,NUMH)
            WEIGHT(HATARR(1))=1.0
            ISATOK(HATARR(1))=.TRUE.
         END IF
         IF (NU.GE.2) THEN
            XCOORD(HATARR(2))=ARXYZH(1,NUMH+1)
            YCOORD(HATARR(2))=ARXYZH(2,NUMH+1)
            ZCOORD(HATARR(2))=ARXYZH(3,NUMH+1)
            WEIGHT(HATARR(2))=1.0
            ISATOK(HATARR(2))=.TRUE.
         END IF
         IF (NU.GE.3) THEN
            XCOORD(HATARR(3))=ARXYZH(1,NUMH+2)
            YCOORD(HATARR(3))=ARXYZH(2,NUMH+2)
            ZCOORD(HATARR(3))=ARXYZH(3,NUMH+2)
            WEIGHT(HATARR(3))=1.0
            ISATOK(HATARR(3))=.TRUE.
         END IF




         DO 70 JAC=1,2
            IATACC=ARIATA(JAC,NUMH)
            IF (IATACC.GT.0) THEN
               IAAACC=ATIAA(IATACC)
               IATVAL(IAT)=IATVAL(IAT)+1
               IATVL2(IATACC)=IATVL2(IATACC)+1
            END IF
 70      CONTINUE
         IF (INTERRUPTED()) GOTO 998
 100  CONTINUE



      DO 140 IAA=1,NUMAAF
         IF (RESTYP(IAA).EQ.7) THEN
            IHIS1=PNTAAS(IAA)+14
            IHIS2=PNTAAS(IAA)+17
            IF (ISATOK(IHIS1).OR.ISATOK(IHIS2)) GOTO 140
            IF (IATVL2(IHIS1).GE.1.AND.IATVL2(IHIS2).GE.1) GOTO 140
            DO 110 JAA=NUMAAF,NUMAAT
               IF (PNTAAE(JAA).EQ.PNTAAS(JAA)) THEN
                  JAT=PNTAAS(JAA)
                  IF (ONESAT(JAT)(1:2).EQ.'ZN') THEN
                     IF (WIFDST(IHIS1,JAT).LT.2.6) IATVL2(IHIS1)=
     +                IATVL2(IHIS1)+1
                     IF (WIFDST(IHIS2,JAT).LT.2.6) IATVL2(IHIS2)=
     +                IATVL2(IHIS2)+1
                  END IF
               END IF
 110        CONTINUE
            IF (IATVL2(IHIS1).GE.1.AND.IATVL2(IHIS2).GE.1) GOTO 140
            CALL GVSTTI ('?M4623',IAA)
         END IF
 140  CONTINUE
      DO 150 IAT=1,NUMATF
         IF (ONESAT(IAT)(1:2).EQ.'ZN') THEN
            CALL DIF015A (IAT,'?M4624')
            CALL ZNCOOR (IAT)
         END IF
 150  CONTINUE
      GOTO 998



 999  CONTINUE
      CALL GVSEIW ('HAS003C')



  998 CONTINUE
      CALL GVSRT0 (ATTVAL,NUMATF)
      CALL GVSRT0 (ATTVL2,NUMATF)


      RETURN
      END
      SUBROUTINE HAS004

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'HBONDS.INC'
      INTEGER       FIXED, IAA, IAT, IERR, NUMHS, HSJAT(4), ILOC, IBND,
     +              NUMBND
      REAL          XYZH(3), XYZB(3), XYZC(3), XYZR(3), GVFDTR,
     +              RMAT(3,3)
      LOGICAL       REALH, WIFIR1, WIFIRA, HBO011, WIFIRH, WIFIRW







      IF (WIFPAR(84).EQ.0) GOTO 998



      DO 20 IAA=1,NUMAAT
         IF (WIFIRW(IAA)) GOTO 20
         IF (PNTAAS(IAA).EQ.PNTAAE(IAA)) GOTO 20
         IF (.NOT.WRK1TF(IAA)) GOTO 20
         IF (WIFIRH(IAA)) GOTO 20



         DO 10 IAT=PNTAAS(IAA),PNTAAE(IAA)



            IF (USABLE(IAT).AND.DONACC(IAT).GE.0) THEN



               IF (RESTYP(IAA).EQ.7.AND.PINIAA(IAT).EQ.7) GOTO 10



               IF (WIFIR1(IAA).AND.WIFIRA(IAA).AND.PINIAA(IAT).EQ.1)
     +          GOTO 10
               IF (HBO011(IAA,IAT)) GOTO 10



               CALL FBONDH (IAT,HSJAT,4,NUMHS)
               NUMBND=0
               DO 5 IBND=1,8
                  IF (BOUND_TO(IBND,IAT).GT.0) THEN
                     NUMBND=NUMBND+1
                  END IF
    5          CONTINUE
               IF (NUMHS.LE.0) THEN




                  IF ((RESTYP(IAA).EQ.3.OR.RESTYP(IAA).EQ.4).AND.
     +                 IAT.GT.PNTAAS(IAA)+4) THEN
                     GOTO 10



                  ELSE IF (FAMTYP(RESTYP(IAA)).EQ.6) THEN
                     GOTO 10
                  ELSE
                     CALL SHOIAA (IAA)
                     CALL GVSTTB ('?M1338')
                     CALL DIF015 (6,'?M1339',IAT)
                     CALL GVSKIL
                  END IF
               ELSE



                  CALL HBO012 (IAT,XYZH,XYZB,XYZC,FIXED,REALH)
                  IF (FIXED.GT.0) THEN



                     IF (NUMHS+NUMBND.NE.FIXED) THEN
                        CALL DIF015 (6,'?M1340',IAT)
                        CALL GVSTTI2 ('?M1341',FIXED,NUMHS)
                        CALL GVSTT6 ('?M4636')
                        CALL GVSKIL
                     END IF
                     IF (NUMHS+NUMBND.GE.1) THEN
                        IF (FIXED.GE.1) THEN
                           CALL HAS013 (HSJAT(1),XYZH)
                        ELSE 
                           CALL HAS012 (HSJAT(1))
                        END IF
                     END IF
                     IF (NUMHS+NUMBND.GE.2) THEN
                        IF (FIXED.GE.2) THEN
                           CALL HAS013 (HSJAT(2),XYZB)
                        ELSE 
                           CALL HAS012 (HSJAT(2))
                        END IF
                     END IF
                     IF (NUMHS+NUMBND.GE.3) THEN
                        IF (FIXED.GE.3) THEN
                           CALL HAS013 (HSJAT(3),XYZC)
                        ELSE 
                           CALL HAS012 (HSJAT(3))
                        END IF
                     END IF
                  ELSE





                     CALL HBO013 (IAT,XYZC,XYZR,IERR)
                     IF (NUMHS.GT.1)
     +                CALL GVSMGM (RMAT,XYZC,GVFDTR(360.0/FLOAT(NUMHS)))
                     DO 99 ILOC=1,NUMHS
                        CV(1)=XCOORD(IAT)+XYZR(1)
                        CV(2)=YCOORD(IAT)+XYZR(2)
                        CV(3)=ZCOORD(IAT)+XYZR(3)
                        CALL HAS013 (HSJAT(ILOC),CV)
                        IF (ILOC.LT.NUMHS) CALL GVSMVV (XYZR,RMAT)
   99                CONTINUE
                     IF (NUMHS.GT.0) ISSHIT(IAA)=.TRUE.
                  END IF
               END IF
            END IF
   10    CONTINUE
   20 CONTINUE



      WIFPAR(1504)=WIFPAR(1504)+1



  998 CONTINUE


      RETURN
      END
      SUBROUTINE HAS005

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INTEGER       IAA, IAT, IDON, IHAT, IAATYP, IOUT, I,
     +              IERR, HATARR(4), HNUM
      LOGICAL       WIFIRW, INTERRUPTED, WIFIRA, T54EQUAL







      IF (WIFPAR(84).EQ.0) GOTO 998
      IOUT=0



      CALL HAS007



      WIFPAR(1504)=WIFPAR(1504)+1
      CALL GVSBOX ('?M2390')
      CALL HB2INI






      CALL GVSBOX ('?M2391')
      CALL HB2RED
      IF (INTERRUPTED()) GOTO 998



      CALL KLONKSTART (IERR)



      DO 100 IAA=1,NUMAAT
         IF (.NOT.WRK1TF(IAA)) GOTO 100
         IAATYP=RESTYP(IAA)



         DO 90 IAT=PNTAAS(IAA),PNTAAE(IAA)



            IDON=ATDON(IAT)
            IF (IDON.EQ.0) GOTO 90



            IF (IAATYP.GT.0) THEN
               CALL FBONDH (IAT,HATARR,4,HNUM)



            ELSE IF (.NOT.PROTON(IAT).AND.WIFIRW(IAA)) THEN



               IF (PROTON(IAT+1).AND.PROTON(IAT+2)) THEN
                  HNUM=2
                  HATARR(1)=IAT+1
                  HATARR(2)=IAT+2
               ELSE
                  ATTVAL(IAT+1)=99.9
                  ATTVAL(IAT+1)=99.9
                  CALL GVSTTB ('?M2389')
                  CALL SHOIAA (IAA)
                  HNUM=0
               END IF
            ELSE 
               HNUM=0
            END IF



            IOUT=1
            DO 80 I=1,NUXYZH(IDON)
               IHAT=INXYZH(IDON)+(I-1)
               IF (I.GT.HNUM) THEN
                  CALL KLONKSET (SOUPNT(IAA),MODNMB(IAA),IERR)
                  IF (T54EQUAL(ONESAT(IAT),' OD1').OR.
     +                T54EQUAL(ONESAT(IAT),' OD2')) THEN
                     IOUT=IOUT+1
                     CALL KLONKTOD ('ATOM  ',' HD2',' HD2',' ',
     +                ONESA3(IAA),CHANAM(IAA),NUMNAM(IAA),' ',
     +                ARXYZH(1,IHAT),ARXYZH(2,IHAT),ARXYZH(3,IHAT),
     +                1.0,12.0,'  ',0,ONEORG(IAA),IAA,IERR)
                  ELSE IF (T54EQUAL(ONESAT(IAT),' OE1').OR.
     +                T54EQUAL(ONESAT(IAT),' OE2')) THEN
                     IOUT=IOUT+1
                     CALL KLONKTOD ('ATOM  ',' HE2',' HE2',' ',
     +                ONESA3(IAA),CHANAM(IAA),NUMNAM(IAA),' ',
     +                ARXYZH(1,IHAT),ARXYZH(2,IHAT),ARXYZH(3,IHAT),
     +                1.0,12.0,'  ',0,ONEORG(IAA),IAA,IERR)
                  ELSE IF (CHAINN(1,IAA).EQ.1.AND.WIFIRA(IAA).AND.
     +                T54EQUAL(ONESAT(IAT),' H1 ')) THEN
                     call gvskil
                     IOUT=IOUT+1
                     CALL KLONKTOD ('ATOM  ',' H1 ',' H1 ',' ',
     +                ONESA3(IAA),CHANAM(IAA),NUMNAM(IAA),' ',
     +                ARXYZH(1,IHAT),ARXYZH(2,IHAT),ARXYZH(3,IHAT),
     +                1.0,12.0,'  ',0,ONEORG(IAA),IAA,IERR)
                     CALL GVSTTB ('?M1342')
                     CALL DIF015 (6,'?M1343',IAT)
                  END IF
               ELSE
                  CALL HAS013 (HATARR(I),ARXYZH(1,IHAT))
               END IF
   80       CONTINUE
            DO 85 I=NUXYZH(IDON)+1,HNUM
               CALL HAS012 (HATARR(I))
   85       CONTINUE
   90    CONTINUE
  100 CONTINUE



      IF (IOUT.GT.0) CALL KLONKDOWN
      CALL KLONKEND



      WIFPAR(1504)=WIFPAR(1504)+1



  998 CONTINUE


      RETURN
      END
      SUBROUTINE HAS006 (JFT1,JFT2)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       JFT1, JFT2, IAT, IAA, IERR, JAT, IBND
      LOGICAL       WIFIRR, WIFIRH







      IF (WIFPAR(84).EQ.0) THEN
         CALL GVSTTE ('?R00269')
         CALL GVSKIL
         GOTO 998
      END IF



      CALL GVSBTF (WRK1TF,NUMAAT)



      IF (JFT1.EQ.0) THEN
         CALL WIFWTF (' ',IERR)
         IF (IERR.NE.0) GOTO 998
      ELSE
         DO 10 IAA=JFT1,JFT2
            WRK1TF(IAA)=.TRUE.
   10    CONTINUE
      END IF



      DO 40 IAA=NUMAAT,1,-1
         IF (WRK1TF(IAA).AND.WIFIRH(IAA)) THEN
            CALL MOL101A (CHAINN(2,IAA))
            CALL MOL200
          END IF
   40 CONTINUE



      DO 50 IAA=1,NUMAAT
         IF (WRK1TF(IAA)) THEN
            IF (WIFPAR(1296).NE.0) THEN
               IF (.NOT.WIFIRR(IAA)) GOTO 50
            END IF
            DO 30 IAT=PNTAAS(IAA),PNTAAE(IAA)
               IF (PROTON(IAT)) THEN
                  CALL HAS012 (IAT)
               ELSE
                  DO 35 IBND=1,8
                     JAT=BOUND_TO(IBND,IAT)
                     IF (JAT.NE.0) THEN
                        IF (PROTON(JAT)) THEN
                           CALL HAS012 (JAT)
                           BOUND_TO(IBND,IAT)=0
                        END IF
                     END IF
 35               CONTINUE
               END IF
 30         CONTINUE
         END IF
 50   CONTINUE



      CALL MOL200



  998 CONTINUE

      
      RETURN
      END   
      SUBROUTINE HAS007

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAT, IAA, HSJAT(4), NUMHS, ILOOP







      IF (WIFPAR(84).EQ.0) GOTO 998



      CALL HBO010




      DO 20 IAT=1,PNTAAE(NUMAAT)
         IAA=ATIAA(IAT)
         IF (.NOT.WRK1TF(IAA)) GOTO 20
         IF (.NOT.USABLE(IAT).OR.PROTON(IAT)) GOTO 20
         CALL FBONDH (IAT,HSJAT,4,NUMHS)
         DO 10 ILOOP=1,NUMHS
            ISATOK(HSJAT(ILOOP))=.FALSE.
   10    CONTINUE
   20 CONTINUE



  998 CONTINUE


      RETURN
      END

      SUBROUTINE HAS008 (IFT1,IFT2)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, IAT, ICON, JATARR(4), NUM, JAT, KATARR(4),
     +              KAT, IFT1, IFT2, ELMZ, LOOPS
      REAL          D, WIFDST, DT
      LOGICAL       ISPSEUDOH, AAHASPROTON







      IF (WIFPAR(84).EQ.0) GOTO 998



      DO 30 IAA=IFT1,IFT2
         IF (.NOT.AAHASPROTON(IAA).AND.WIFPAR(166).EQ.0) GOTO 30
         LOOPS=0
   70    CONTINUE
         LOOPS=LOOPS+1



         DO 20 IAT=PNTAAS(IAA),PNTAAE(IAA)




            IF (.NOT.PROTON(IAT)) GOTO 20
            IF (ISPSEUDOH(IAT)) GOTO 20
            IF (.NOT.ISATOK(IAT))GOTO 20
            CALL FBONDA (IAT,JATARR,4,NUM)
            IF (NUM.NE.1) GOTO 20
            D=WIFDST(IAT,JATARR(1))
            IF (D.LT.1.3.OR.(ELMZ(JATARR(1)).GT.8.AND.D.LT.1.5)) GOTO 20



            DO 10 JAT=PNTAAS(IAA),PNTAAE(IAA)
               IF (PROTON(JAT)) GOTO 10
               IF (.NOT.ISATOK(JAT)) GOTO 10
               DT=WIFDST(IAT,JAT)
               IF (DT.LT.1.2.OR.(ELMZ(JAT).GT.8.AND.D.LT.1.5)) GOTO 40
   10       CONTINUE
            GOTO 20



   40       CONTINUE
            CALL FBONDH (JAT,KATARR,4,NUM)
            DO 50 ICON=1,NUM
               IF (ISATOK(KATARR(ICON))) THEN
                  DT=WIFDST(JAT,KATARR(ICON))
                  IF (DT.GT.1.5.AND.(ELMZ(JAT).GT.8.OR.D.GT.1.3)) THEN
                     KAT=KATARR(ICON)
                     GOTO 60
                  END IF
               ELSE
                  KAT=KATARR(ICON)
                  GOTO 60
               END IF
   50       CONTINUE
            CALL GVSTT6 ('?M1417')
            GOTO 20



   60       CONTINUE
            CALL MOL203I (IAT,KAT,0)



            IF (LOOPS.LT.25) GOTO 70
   20    CONTINUE
   30 CONTINUE



  998 CONTINUE


      RETURN
      END
      SUBROUTINE HAS009 (IAA,IERR)

















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







      IF (WIFPAR(84).EQ.0) GOTO 998
      IF (FAMTYP(RESTYP(IAA)).NE.6) THEN
         CALL GVSKIL
         GOTO 998
      END IF



      DO 10 IAT=PNTAAS(IAA),PNTAAE(IAA)
         IF (PROTON(IAT)) THEN
            USEAT(IAT)=.FALSE.
         ELSE
            USEAT(IAT)=.TRUE.
         END IF
  10  CONTINUE



      CALL WIFPUSHPPP (124,100)
      CALL WIFPUSHPPP (125,50)
      CALL WIFPUSHPPP (113,2)
      CALL WIFPUSHPPP (61,2)
      CALL WIFPUSHPPP (50,1)









      CALL WIFPOPPPP (50)
      CALL WIFPOPPPP (61)
      CALL WIFPOPPPP (113)
      CALL WIFPOPPPP (125)
      CALL WIFPOPPPP (124)



  998 CONTINUE


      RETURN
      END 
      SUBROUTINE HAS010 (IAA)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       FIXED, IAA, IAT, IERR, IAATYP, HSJAT(4), NUMHS, 
     +              IATARR(4), NUM, JAT
      REAL          XYZH(3), XYZB(3), XYZC(3)
      LOGICAL       REALH, WIFITI, WIFIRN, HASPROTON









      IF (CHAINN(1,IAA).EQ.2) THEN
         CALL GVSTTB ('?M2392')
         GOTO 998
      END IF
      IF (WIFPAR(166).EQ.0) THEN
         IF (.NOT.HASPROTON()) GOTO 998
      END IF



      IAATYP=RESTYP(IAA)
      CALL KLONKSET (SOUPNT(IAA),MODNMB(IAA),IERR)





      IF (WIFIRN(IAA)) THEN
         IAT=PNTAAS(IAA)+2
         IF (ISATOK(IAT)) THEN
            CALL FBONDA (IAT,IATARR,4,NUM)
            IF (NUM.LE.1) THEN
               CALL HBO013A (IAT,XYZB)
               CALL KLONKTOD ('ATOM  ',' HO3',' HO3',' ',ONESA3(IAA),
     +          CHANAM(IAA),NUMNAM(IAA),' ',XYZB(1),XYZB(2),XYZB(3),
     +          WEIGHT(IAT),12.0,'  ',0,ONEORG(IAA),IAA,IERR)
            END IF
         END IF
         IAT=PNTAAS(IAA)+5
         IF (ISATOK(IAT)) THEN
            CALL FBONDA (IAT,IATARR,4,NUM)
            IF (NUM.LE.1) THEN
               CALL HBO013A (IAT,XYZB)
               CALL KLONKTOD ('ATOM  ',' HO5',' HO5',' ',ONESA3(IAA),
     +          CHANAM(IAA),NUMNAM(IAA),' ',XYZB(1),XYZB(2),XYZB(3),
     +          WEIGHT(IAT),12.0,'  ',0,ONEORG(IAA),IAA,IERR)
            END IF
         END IF
         GOTO 998
      END IF



      IAT=PNTAAS(IAA)
      CALL HBO012 (IAT,XYZH,XYZB,XYZC,FIXED,REALH)


      IF (REALH) THEN
         CALL FBONDH (IAT,HSJAT,4,NUMHS) 
         DO 10 JAT=1,4
            IF (WIFITI(HSJAT(JAT))) ISATOK(HSJAT(JAT))=.FALSE.
   10    CONTINUE
         CALL HBO012 (IAT,XYZH,XYZB,XYZC,FIXED,REALH)
         IF (REALH) GOTO 998
      END IF
      IF (FIXED.GE.2) THEN



         IF (RESTYP(IAA).NE.13.AND.RESTYP(IAA).NE.21) THEN
            CALL HAS013 (PNTAAS(IAA)+HATPRA(IAATYP),XYZH)
         END IF





         CALL KLONKTOD ('ATOM  ',' H2 ',' H2 ',' ',ONESA3(IAA),
     +    CHANAM(IAA),NUMNAM(IAA),' ',XYZB(1),XYZB(2),XYZB(3),
     +    WEIGHT(PNTAAS(IAA)),12.0,'  ',0,ONEORG(IAA),IAA,IERR)



         IF (FIXED.GE.3) THEN


            CALL KLONKTOD ('ATOM  ',' H3 ',' H3 ',' ',ONESA3(IAA),
     +       CHANAM(IAA),NUMNAM(IAA),' ',XYZC(1),XYZC(2),XYZC(3),
     +       WEIGHT(PNTAAS(IAA)),12.0,'  ',0,ONEORG(IAA),IAA,IERR)
         ELSE IF (RESTYP(IAA).EQ.13.OR.RESTYP(IAA).EQ.21) THEN





            CALL KLONKTOD ('ATOM  ',' H3 ',' H3 ',' ',ONESA3(IAA),
     +       CHANAM(IAA),NUMNAM(IAA),' ',XYZH(1),XYZH(2),XYZH(3),
     +       WEIGHT(PNTAAS(IAA)),12.0,'  ',0,ONEORG(IAA),IAA,IERR)
         END IF
      END IF



  998 CONTINUE



      RETURN
      END
      SUBROUTINE HAS011 (IAT)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAT, NUMHS, HSJAT(4), NUMHAS, HASJAT(4), HASLOC(4),
     +              JAT, ILOOP, IAA, JATARR(200), JATSYM(200), NUM, KAT
      LOGICAL       AREBOUND, AREB13
      REAL          OLDBB(3,3), NEWBB(3,3), RMAT(3,3), TVEC(3), GVFANG,
     +              QRMS, QMAX, JATDST(200), ANG1, ANG2, V1(3), V2(3),
     +              GVFRTD, D1, D2, D3, D4, WIFDST







      IF (.NOT.ISATOK(IAT)) THEN
         CALL GVSTTE ('?R00305')
         GOTO 998
      END IF



      IAA=ATIAA(IAT)
      CALL GVSIT0 (HASJAT,4)



      CALL FBONDH (IAT,HSJAT,4,NUMHS) 
      IF (NUMHS.LE.0) GOTO 998



      NUMHAS=1
      HASJAT(1)=IAT
      HASLOC(1)=PINIAA(IAT)
      CALL PRP204 (ATIAA(IAT),'Active residue')
      CALL PRP208 ('With as restyp:',RESTYP(ATIAA(IAT)))
      CALL PRP213 (IAT,'Atom to be protonated')



      DO 10 JAT=PNTAAS(IAA),PNTAAE(IAA)
         IF (PROTON(JAT)) GOTO 10
         IF (JAT.EQ.IAT) GOTO 10
         IF (.NOT.ISATOK(JAT)) GOTO 10
         IF (AREBOUND(IAT,JAT)) THEN
            NUMHAS=NUMHAS+1
            HASJAT(NUMHAS)=JAT
            HASLOC(NUMHAS)=PINIAA(JAT)
            CALL PRP213 (JAT,'Bound atom added for suppos')
            CALL PRP216 (IAT,JAT)
            IF (NUMHAS.GE.3) GOTO 30
         END IF
   10 CONTINUE



      DO 20 JAT=PNTAAS(IAA),PNTAAE(IAA)
         IF (PROTON(JAT)) GOTO 20
         IF (JAT.EQ.IAT) GOTO 20
         IF (.NOT.ISATOK(JAT)) GOTO 20
         IF (AREB13(IAT,JAT,1)) THEN
            NUMHAS=NUMHAS+1
            HASJAT(NUMHAS)=JAT
            HASLOC(NUMHAS)=PINIAA(JAT)
            CALL PRP213 (JAT,'1-3 atom added for suppos')
            CALL PRP216 (IAT,JAT)
            IF (NUMHAS.GE.3) GOTO 30
         END IF
   20 CONTINUE



      IF (NUMHAS.LT.3) THEN
         CALL DIF015 (6,'?R00304',IAT)
         GOTO 998
      END IF



   30 CONTINUE
      DO 35 ILOOP=1,3
         OLDBB(1,ILOOP)=XCOORD(HASJAT(ILOOP))
         OLDBB(2,ILOOP)=YCOORD(HASJAT(ILOOP))
         OLDBB(3,ILOOP)=ZCOORD(HASJAT(ILOOP))
         NEWBB(1,ILOOP)=STDCRD(1,HASLOC(ILOOP),RESTYP(IAA))
         NEWBB(2,ILOOP)=STDCRD(2,HASLOC(ILOOP),RESTYP(IAA))
         NEWBB(3,ILOOP)=STDCRD(3,HASLOC(ILOOP),RESTYP(IAA))
   35 CONTINUE



      CALL GVSSPN (3,OLDBB,NEWBB,RMAT,TVEC,QRMS,QMAX)
      IF (QRMS.GT.0.25) THEN
         CALL GVSTTE ('?R00249')
         CALL GVSTTR2 ('?R00250',QRMS,QMAX)
         CALL DIF008 ('?R00251',IAA)
         DO 89 ILOOP=1,NUMHAS
            CALL DIF015 (6,'?R00252',HASJAT(ILOOP))
   89    CONTINUE



         V1(1)=OLDBB(1,1)-OLDBB(1,2)
         V1(2)=OLDBB(2,1)-OLDBB(2,2)
         V1(3)=OLDBB(3,1)-OLDBB(3,2)
         V2(1)=OLDBB(1,3)-OLDBB(1,2)
         V2(2)=OLDBB(2,3)-OLDBB(2,2)
         V2(3)=OLDBB(3,3)-OLDBB(3,2)
         ANG1=GVFRTD(GVFANG(V1,V2))



         V1(1)=NEWBB(1,1)-NEWBB(1,2)
         V1(2)=NEWBB(2,1)-NEWBB(2,2)
         V1(3)=NEWBB(3,1)-NEWBB(3,2)
         V2(1)=NEWBB(1,3)-NEWBB(1,2)
         V2(2)=NEWBB(2,3)-NEWBB(2,2)
         V2(3)=NEWBB(3,3)-NEWBB(3,2)
         ANG2=GVFRTD(GVFANG(V1,V2))



         D1=SQRT((NEWBB(1,1)-NEWBB(1,2))**2+(NEWBB(2,1)-NEWBB(2,2))**2+
     +           (NEWBB(3,1)-NEWBB(3,2))**2)
         D2=SQRT((NEWBB(1,3)-NEWBB(1,2))**2+(NEWBB(2,3)-NEWBB(2,2))**2+
     +           (NEWBB(3,3)-NEWBB(3,2))**2)
         D3=WIFDST(HASJAT(1),HASJAT(2))
         D4=WIFDST(HASJAT(2),HASJAT(3))



         CALL GVSTTR2 ('DBG> Pred and Obs angles:',ANG1,ANG2)
         CALL GVSTTR4 ('DBG> Four bond lengths:',D1,D2,D3,D4)
         CALL PRP204 (ATIAA(IAT),'Poor geometry')
         CALL PRP202 ('Fatality observed...')
         RESTYP(IAA)=0
         SOUADM(5,CHAINN(2,IAA))=2
         SOUADM(12,CHAINN(2,IAA))=1
         CALL DIF008 ('Topology failed for this residue',IAA)
         CALL PRP204 (IAA,'Topology failed for this residue')
      END IF



      CALL GVSCPR (CV,NEWBB(1,1),3)
      CALL GVSMPV (CV,RMAT,TVEC)
      CALL GVSSV3 (CV,OLDBB(1,1))
      CALL GVSSV3 (TVEC,CV)



      DO 50 ILOOP=1,NUMHS
         CALL GVSCPR (CV,STDCRD(1,PINIAA(HSJAT(ILOOP)),RESTYP(IAA)),3)
         CALL GVSMPV (CV,RMAT,TVEC)
         IF (.NOT.ISATOK(HSJAT(ILOOP))) CALL HAS013 (HSJAT(ILOOP),CV)






         CALL FCONATI (HSJAT(ILOOP),2.5,JATARR,JATSYM,JATDST,NUM,200)
         IF (NUM.GT.0) THEN
            DO 40 JAT=1,NUM
               IF (JATDST(JAT).LT.1.0) THEN
                  KAT=JATARR(JAT)
                  IF (KAT.NE.IAT) THEN
                     ISATOK(HSJAT(ILOOP))=.FALSE.
                  END IF
               END IF
 40         CONTINUE
         END IF
 50   CONTINUE



  998 CONTINUE


      RETURN
      END
      SUBROUTINE HAS012 (IAT)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAT







      IF (IAT.LE.0.OR.IAT.GT.MAXAT) GOTO 998



      ISATOK(IAT)=.FALSE.
      WEIGHT(IAT)=0.0
      XCOORD(IAT)=0.0
      YCOORD(IAT)=0.0
      ZCOORD(IAT)=0.0
      IF (WIFPAR(279).EQ.0) CALL GVSCTB (ORGNAM(IAT),5)



  998 CONTINUE


      RETURN
      END
      SUBROUTINE HAS013 (IAT,VEC)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAT
      REAL          VEC(3)







      ISATOK(IAT)=.TRUE.
      XCOORD(IAT)=VEC(1)
      YCOORD(IAT)=VEC(2)
      ZCOORD(IAT)=VEC(3)
      WEIGHT(IAT)=1.0
      ORGNAM(IAT)=ONESAT(IAT)
      ISSHIT(ATIAA(IAT))=.TRUE.




      
      RETURN
      END
      SUBROUTINE HAS014 (PRTFLG,IFT1,IFT2)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IFT1, IFT2
      INTEGER       IAA, NUMBND, JATARR(10), I, IAT, HATARR(4), HNUM,
     +              LAT
      REAL          CHI001, CHIHAS, VALUE, TARGET, GVFRTD
      LOGICAL       PRTFLG, AAHASPROTON, HASPROTON, DUMMY, T54EQUAL,
     +              CH4EQCH4, WIFIR1







      IF (WIFPAR(195).GT.0) CALL GVSTT6 ('?M4757')
      IF (WIFPAR(166).EQ.0) THEN
         IF (.NOT.HASPROTON()) GOTO 998
      END IF



      DO 100 IAA=IFT1,IFT2
         IF (WIFPAR(195).GT.0) THEN
            CALL GVSTT6 ('?M4758')
            CALL SHOIAA (IAA)
            DUMMY=AAHASPROTON(IAA)
            CALL GVSTTI ('?M4759',WIFPAR(166))
         END IF
         IF (.NOT.AAHASPROTON(IAA).AND.WIFPAR(166).EQ.0) GOTO 100



         IF (RESTYP(IAA).LE.0) GOTO 100



         DO 90 IAT=PNTAAS(IAA),PNTAAE(IAA)
            IF (WIFIR1(IAA).AND.(CH4EQCH4(ONESA3(IAA),'PRO ').OR.
     +       CH4EQCH4(ONESA3(IAA),'HYP '))) GOTO 90



            IF (.NOT.ISATOK(IAT).OR.PROTON(IAT)) GOTO 90
            CALL FBOND (IAT,JATARR,10,NUMBND)
            IF (WIFPAR(195).GT.0) CALL GVSTTI ('?M4760',NUMBND)
            IF (NUMBND.LT.3.OR.NUMBND.GT.4) GOTO 90
            DO 80 I=1,NUMBND
               IF (.NOT.ISATOK(JATARR(I))) GOTO 90
   80       CONTINUE
            CALL GVSIR1 (JATARR,NUMBND)
            IF (WIFPAR(195).GT.0) THEN
               CALL GVST6C ('?M4761',ONESAT(IAT),.TRUE.)
            END IF



            IF (NUMBND.EQ.3) THEN
               VALUE=CHI001(IAT,JATARR(1),JATARR(2),JATARR(3))
               IF (ATIAA(JATARR(1)).LT.IAA) THEN



                  IF (T54EQUAL(ONESAT(IAT),' N  ')) THEN
                     TARGET=0.0
                  ELSE
                     IF (WIFPAR(195).GT.0) THEN
                        CALL DIF015 (6,'?M1419',IAT)
                        DO 98 I=1,NUMBND
                           CALL DIF015 (6,'?R00240',JATARR(I))
 98                     CONTINUE
                     END IF
                     TARGET=0.0
                  END IF
               ELSE IF (ATIAA(JATARR(3)).GT.IAA) THEN



                  IF (T54EQUAL(ONESAT(IAT),' C  ')) THEN
                     TARGET=0.0



                  ELSE IF (T54EQUAL(ONESAT(IAT),' N  ')) THEN
                     TARGET=0.0
                  ELSE



                     IF (PROTON(JATARR(3))) GOTO 90
                     IF (WIFPAR(195).GT.0) THEN
                        CALL DIF015 (6,'?M1420',IAT)
                        DO 97 I=1,NUMBND
                           CALL DIF015 (6,'?R00240',JATARR(I))
 97                     CONTINUE
                     END IF
                     TARGET=0.0
                  END IF
               ELSE



                  TARGET=CHIHAS(IAT,JATARR(1),JATARR(2),JATARR(3))
               END IF
            ELSE IF (NUMBND.EQ.4) THEN
               VALUE=CHI001(JATARR(1),JATARR(2),JATARR(3),JATARR(4))
               IF (ATIAA(JATARR(1)).LT.IAA) THEN



                  IF (T54EQUAL(ONESAT(IAT),' P  ')) THEN
                     TARGET=1.205
                  ELSE
                     CALL DIF015 (6,'?M1421',IAT)
                     TARGET=0.0
                  END IF
               ELSE IF (ATIAA(JATARR(4)).GT.IAA) THEN



                  IF (T54EQUAL(ONESAT(IAT),' N  ')) THEN
                     TARGET=1.33



                     IF (T54EQUAL(ONESAT(JATARR(3)),' H3 ').AND.
     +                T54EQUAL(ONESAT(JATARR(4)),' H2 ')) VALUE=-VALUE



                  ELSE IF (T54EQUAL(ONESAT(IAT),' P  ')) THEN
                     TARGET=1.205
                  ELSE 
                     IF (PROTON(JATARR(4))) GOTO 90
                     CALL DIF015 (6,'?M1866',IAT)
                     DO 123 LAT=1,NUMBND
                        CALL DIF015 (6,'?M4762',JATARR(LAT))
  123                CONTINUE
                     CALL SHOIAA (IAA)
                     TARGET=0.0
                  END IF
               ELSE



                  TARGET=CHIHAS(JATARR(1),JATARR(2),JATARR(3),
     +             JATARR(4))
               END IF
            ELSE
               VALUE=0.0
               TARGET=0.0
               CALL GVSTTB ('?M1346')
            END IF



            IF (ABS(TARGET-VALUE).GT.10.0*(3.14/180.0)) THEN
               IF (ABS(TARGET).LT.5.0*(3.14/180.0)) THEN
                  IF (PRTFLG) CALL DIF015 (6,'?R00238',IAT)
               ELSE IF (TARGET*VALUE.LT.0.0) THEN
                  CALL FBONDH (IAT,HATARR,4,HNUM)
                  IF (HNUM.GE.2) THEN
                     IF (PRTFLG) CALL DIF022 
     +                (6,HATARR(1),HATARR(2),'?M1347')
                     CALL MOL203 (HATARR(1),HATARR(2),0)
                     GOTO 90
                  ELSE
                     IF (WIFPAR(195).GT.0) THEN
                        CALL DIF015 (6,'?R00258',IAT)
                        CALL GVSTTR2 ('?M4763',TARGET,VALUE)
                        DO 43 I=1,NUMBND
                           CALL DIF015 (6,'?R00240',JATARR(I))
 43                     CONTINUE
                     END IF
                  END IF
               ELSE
                  IF (WIFPAR(195).GT.0) THEN
                     CALL DIF015 (6,'?R00239',IAT)
                     DO 40 I=1,NUMBND
                        CALL DIF015 (6,'?R00240',JATARR(I))
 40                  CONTINUE
                     CALL GVSTTR ('?R00241',GVFRTD(TARGET-VALUE))
                     CALL GVSTTR2('?M4763',GVFRTD(TARGET),
     +                GVFRTD(VALUE))
                  END IF
               END IF
            END IF
   90    CONTINUE
  100 CONTINUE



 998  CONTINUE


      RETURN
      END
      SUBROUTINE HAS014AT (IAT)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, NUMBND, JATARR(10), I, IAT, HATARR(4), HNUM,
     +              LAT
      REAL          CHI001, CHIHAS, VALUE, TARGET
      LOGICAL       AAHASPROTON, T54EQUAL, CH4EQCH4







      IAA=ATIAA(IAT)
      IF (WIFPAR(166).EQ.0) THEN
         IF (.NOT.AAHASPROTON(IAA)) GOTO 998
      END IF



      IF (IAT.EQ.1.AND.(CH4EQCH4(ONESA3(IAA),'PRO ').OR.
     + CH4EQCH4(ONESA3(IAA),'HYP '))) GOTO 998
      IF (.NOT.ISATOK(IAT).OR.PROTON(IAT)) GOTO 998



      IF (.NOT.ISATOK(IAT).OR.PROTON(IAT)) GOTO 998
      CALL FBOND (IAT,JATARR,10,NUMBND)
      IF (NUMBND.LT.3.OR.NUMBND.GT.4) GOTO 998
      DO 10 I=1,NUMBND
         IF (.NOT.ISATOK(JATARR(I))) GOTO 998
   10 CONTINUE
      CALL GVSIR1 (JATARR,NUMBND)



      IF (NUMBND.EQ.3) THEN
         VALUE=CHI001(IAT,JATARR(1),JATARR(2),JATARR(3))
         IF (ATIAA(JATARR(1)).LT.IAA) THEN



            IF (T54EQUAL(ONESAT(IAT),' N  ')) THEN
               TARGET=0.0
            ELSE




               TARGET=0.0
            END IF
         ELSE IF (ATIAA(JATARR(3)).GT.IAA) THEN



            IF (T54EQUAL(ONESAT(IAT),' C  ')) THEN
               TARGET=0.0



            ELSE IF (T54EQUAL(ONESAT(IAT),' N  ')) THEN
               TARGET=0.0
            ELSE



               IF (PROTON(JATARR(3))) GOTO 998




               TARGET=0.0
            END IF
         ELSE



            TARGET=CHIHAS(IAT,JATARR(1),JATARR(2),JATARR(3))
         END IF
      ELSE IF (NUMBND.EQ.4) THEN
         VALUE=CHI001(JATARR(1),JATARR(2),JATARR(3),JATARR(4))
         IF (ATIAA(JATARR(1)).LT.IAA) THEN



            IF (T54EQUAL(ONESAT(IAT),' P  ')) THEN
               TARGET=1.205
            ELSE
               CALL DIF015 (6,'?M1421',IAT)
               TARGET=0.0
            END IF
         ELSE IF (ATIAA(JATARR(4)).GT.IAA) THEN



            IF (T54EQUAL(ONESAT(IAT),' N  ')) THEN
               TARGET=1.33



               IF (T54EQUAL(ONESAT(JATARR(3)),' H3 ').AND.
     +          T54EQUAL(ONESAT(JATARR(4)),' H2 ')) VALUE=-VALUE



            ELSE IF (T54EQUAL(ONESAT(IAT),' P  ')) THEN
               TARGET=1.205
            ELSE 
               IF (PROTON(JATARR(4))) GOTO 998
               CALL DIF015 (6,'?M1866',IAT)
               DO 123 LAT=1,NUMBND
                  CALL DIF015 (6,'BOUND_TO:',JATARR(LAT))
  123          CONTINUE
               CALL SHOIAA (IAA)
               TARGET=0.0
            END IF
         ELSE



            TARGET=CHIHAS(JATARR(1),JATARR(2),JATARR(3),
     +       JATARR(4))
         END IF
      ELSE
         VALUE=0.0
         TARGET=0.0
         CALL GVSTTB ('?M1346')
      END IF



      IF (ABS(TARGET-VALUE).GT.10.0*(3.14/180.0)) THEN
         IF (ABS(TARGET).LT.5.0*(3.14/180.0)) THEN

         ELSE IF (TARGET*VALUE.LT.0.0) THEN
            CALL FBONDH (IAT,HATARR,4,HNUM)
            IF (HNUM.GE.2) THEN

               CALL MOL203 (HATARR(1),HATARR(2),0)
               GOTO 998
            ELSE
               IF (WIFPAR(1012).GE.1) THEN





               END IF
            END IF
         ELSE
            IF (WIFPAR(1012).GE.1) THEN







            END IF
         END IF
      END IF



  998 CONTINUE


      RETURN
      END
      SUBROUTINE HAS014A (PRTFLG,IFT1,IFT2)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IFT1, IFT2
      INTEGER       IAA
      REAL          VALUE1, VALUE2, CHI001
      LOGICAL       PRTFLG, WIFIRR, AAHASPROTON







      DO 100 IAA=IFT1,IFT2



         IF (.NOT.AAHASPROTON(IAA).AND.WIFPAR(166).EQ.0) GOTO 100
         IF (RESTYP(IAA).LE.0) GOTO 100
         IF (HATPRA(RESTYP(IAA)).LT.8) GOTO 100
         IF (.NOT.WIFIRR(IAA)) GOTO 100



         IF (RESTYP(IAA).EQ.12) THEN
            VALUE1=CHI001(PNTAAS(IAA)+4,PNTAAS(IAA)+5,PNTAAS(IAA)+7,
     +       PNTAAS(IAA)+12)
            VALUE2=CHI001(PNTAAS(IAA)+4,PNTAAS(IAA)+5,PNTAAS(IAA)+7,
     +       PNTAAS(IAA)+13)
            IF (ABS(VALUE2).LT.ABS(VALUE1)) THEN
               CALL MOL203I (PNTAAS(IAA)+12,PNTAAS(IAA)+13,0)
               IF (PRTFLG) CALL DIF022 (6,PNTAAS(IAA)+12,PNTAAS(IAA)+13,
     +          'SWAPPED 12')
            END IF



         ELSE IF (RESTYP(IAA).EQ.14) THEN
            VALUE1=CHI001(PNTAAS(IAA)+5,PNTAAS(IAA)+6,PNTAAS(IAA)+8,
     +       PNTAAS(IAA)+15)
            VALUE2=CHI001(PNTAAS(IAA)+5,PNTAAS(IAA)+6,PNTAAS(IAA)+8,
     +       PNTAAS(IAA)+16)
            IF (ABS(VALUE2).LT.ABS(VALUE1)) THEN
               CALL MOL203I (PNTAAS(IAA)+15,PNTAAS(IAA)+16,0)
               IF (PRTFLG) CALL DIF022 (6,PNTAAS(IAA)+15,PNTAAS(IAA)+16,
     +          'SWAPPED 14')
            END IF



         ELSE IF (RESTYP(IAA).EQ.15) THEN
            CALL MOL199ARG (IAA)
            IF (.NOT.ISATOK(PNTAAS(IAA)+22)) GOTO 998
            IF (.NOT.ISATOK(PNTAAS(IAA)+23)) GOTO 998
            VALUE1=CHI001(PNTAAS(IAA)+7,PNTAAS(IAA)+8,PNTAAS(IAA)+10,
     +       PNTAAS(IAA)+22)
            VALUE2=CHI001(PNTAAS(IAA)+7,PNTAAS(IAA)+8,PNTAAS(IAA)+10,
     +       PNTAAS(IAA)+23)
            IF (ABS(VALUE2).LT.ABS(VALUE1)) THEN
               CALL MOL203I (PNTAAS(IAA)+22,PNTAAS(IAA)+23,0)
               IF (PRTFLG) CALL DIF022 (6,PNTAAS(IAA)+22,PNTAAS(IAA)+23,
     +          'SWAPPED 15')
            END IF
            IF (.NOT.ISATOK(PNTAAS(IAA)+20)) GOTO 998
            IF (.NOT.ISATOK(PNTAAS(IAA)+21)) GOTO 998
            VALUE1=CHI001(PNTAAS(IAA)+7,PNTAAS(IAA)+8,PNTAAS(IAA)+9,
     +       PNTAAS(IAA)+20)
            VALUE2=CHI001(PNTAAS(IAA)+7,PNTAAS(IAA)+8,PNTAAS(IAA)+9,
     +       PNTAAS(IAA)+21)
            IF (ABS(VALUE2).LT.ABS(VALUE1)) THEN
               CALL MOL203I (PNTAAS(IAA)+20,PNTAAS(IAA)+21,0)
               IF (PRTFLG.OR.WIFPAR(1012).EQ.1) CALL DIF022 
     +          (6,PNTAAS(IAA)+20,PNTAAS(IAA)+21,'SWAPPED 15')
            END IF



         ELSE IF (ONESA3(IAA).EQ.'DADE') THEN
            VALUE1=CHI001(PNTAAS(IAA)+17,PNTAAS(IAA)+15,PNTAAS(IAA)+16,
     +       PNTAAS(IAA)+29)
            VALUE2=CHI001(PNTAAS(IAA)+17,PNTAAS(IAA)+15,PNTAAS(IAA)+16,
     +       PNTAAS(IAA)+30)



            IF (ABS(VALUE2).LT.ABS(VALUE1)) THEN
               CALL MOL203I (PNTAAS(IAA)+29,PNTAAS(IAA)+30,0)
               IF (PRTFLG.OR.WIFPAR(1012).EQ.1) CALL DIF022 
     +          (6,PNTAAS(IAA)+29,PNTAAS(IAA)+30,'SWAPPED 26')
            END IF



         ELSE IF (ONESA3(IAA).EQ.'DGUA') THEN
            VALUE1=CHI001(PNTAAS(IAA)+17,PNTAAS(IAA)+18,PNTAAS(IAA)+19,
     +       PNTAAS(IAA)+31)
            VALUE2=CHI001(PNTAAS(IAA)+17,PNTAAS(IAA)+18,PNTAAS(IAA)+19,
     +       PNTAAS(IAA)+32)



            IF (ABS(VALUE2).LT.ABS(VALUE1)) THEN
               CALL MOL203I (PNTAAS(IAA)+31,PNTAAS(IAA)+32,0)
               IF (PRTFLG.OR.WIFPAR(1012).EQ.1) CALL DIF022 
     +          (6,PNTAAS(IAA)+31,PNTAAS(IAA)+32,'SWAPPED 28')
            END IF



         ELSE IF (ONESA3(IAA).EQ.'DCYT') THEN
            VALUE1=CHI001(PNTAAS(IAA)+16,PNTAAS(IAA)+14,PNTAAS(IAA)+15,
     +       PNTAAS(IAA)+26)
            VALUE2=CHI001(PNTAAS(IAA)+16,PNTAAS(IAA)+14,PNTAAS(IAA)+15,
     +       PNTAAS(IAA)+27)



            IF (ABS(VALUE2).LT.ABS(VALUE1)) THEN
               CALL MOL203I (PNTAAS(IAA)+26,PNTAAS(IAA)+27,0)
               IF (PRTFLG.OR.WIFPAR(1012).EQ.1) CALL DIF022 
     +          (6,PNTAAS(IAA)+26,PNTAAS(IAA)+27,'SWAPPED 29')
            END IF



         ELSE IF (ONESA3(IAA).EQ.'OADE') THEN
            VALUE1=CHI001(PNTAAS(IAA)+17,PNTAAS(IAA)+15,PNTAAS(IAA)+16,
     +       PNTAAS(IAA)+30)
            VALUE2=CHI001(PNTAAS(IAA)+17,PNTAAS(IAA)+15,PNTAAS(IAA)+16,
     +       PNTAAS(IAA)+31)



            IF (ABS(VALUE2).LT.ABS(VALUE1)) THEN
               CALL MOL203I (PNTAAS(IAA)+30,PNTAAS(IAA)+31,0)
               IF (PRTFLG.OR.WIFPAR(1012).EQ.1) CALL DIF022 
     +          (6,PNTAAS(IAA)+30,PNTAAS(IAA)+31,'SWAPPED 30')
            END IF



         ELSE IF (ONESA3(IAA).EQ.'OGUA') THEN
            VALUE1=CHI001(PNTAAS(IAA)+17,PNTAAS(IAA)+18,PNTAAS(IAA)+19,
     +       PNTAAS(IAA)+32)
            VALUE2=CHI001(PNTAAS(IAA)+17,PNTAAS(IAA)+18,PNTAAS(IAA)+19,
     +       PNTAAS(IAA)+33)



            IF (ABS(VALUE2).LT.ABS(VALUE1)) THEN
               CALL MOL203I (PNTAAS(IAA)+32,PNTAAS(IAA)+33,0)
               IF (PRTFLG.OR.WIFPAR(1012).EQ.1) CALL DIF022 
     +          (6,PNTAAS(IAA)+32,PNTAAS(IAA)+33,'SWAPPED 32')
            END IF



         ELSE IF (ONESA3(IAA).EQ.'OCYT') THEN
            VALUE1=CHI001(PNTAAS(IAA)+16,PNTAAS(IAA)+14,PNTAAS(IAA)+15,
     +       PNTAAS(IAA)+27)
            VALUE2=CHI001(PNTAAS(IAA)+16,PNTAAS(IAA)+14,PNTAAS(IAA)+15,
     +       PNTAAS(IAA)+28)



            IF (ABS(VALUE2).LT.ABS(VALUE1)) THEN
               CALL MOL203I (PNTAAS(IAA)+27,PNTAAS(IAA)+28,0)
               IF (PRTFLG.OR.WIFPAR(1012).EQ.1) CALL DIF022 
     +          (6,PNTAAS(IAA)+27,PNTAAS(IAA)+28,'SWAPPED 33')
            END IF
         END IF
  100 CONTINUE



  998 CONTINUE


      RETURN
      END
      SUBROUTINE HAS014B (IFT1,IFT2)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, IFT1, IFT2, JAT
      CHARACTER*4   THISAT
      LOGICAL       CH4EQCH4, WIFITI, T54EQUAL







      IF (WIFPAR(1172).EQ.0) THEN
         CALL GVST6C ('?M1515','HAS014B',.TRUE.)
         GOTO 998
      END IF



      DO 100 IAA=IFT1,IFT2
         IF (FAMTYP(RESTYP(IAA)).EQ.1) THEN



            IF (RESTYP(IAA).EQ.1) THEN
               JAT=BOUND_TO(1,PNTAAS(IAA)+4)
               IF (.NOT.WIFITI(JAT)) GOTO 100
               IF (T54EQUAL(ONESAT(JAT),' MB ')) GOTO 100
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' MB ')



            ELSE IF (RESTYP(IAA).EQ.2) THEN
               JAT=BOUND_TO(1,PNTAAS(IAA)+4)
               IF (.NOT.WIFITI(JAT)) GOTO 100
               IF (T54EQUAL(ONESAT(JAT),' QB ')) GOTO 100
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' QB ')



            ELSE IF (RESTYP(IAA).EQ.3) THEN
               JAT=BOUND_TO(1,PNTAAS(IAA)+4)
               IF (.NOT.WIFITI(JAT)) GOTO 100
               IF (T54EQUAL(ONESAT(JAT),' QB ')) GOTO 100
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' QB ')



            ELSE IF (RESTYP(IAA).EQ.4) THEN
               JAT=BOUND_TO(1,PNTAAS(IAA)+4)
               IF (.NOT.WIFITI(JAT)) GOTO 10
               IF (T54EQUAL(ONESAT(JAT),' QB ')) GOTO 10
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' QB ')
   10          CONTINUE
               JAT=BOUND_TO(1,PNTAAS(IAA)+5)
               IF (.NOT.WIFITI(JAT)) GOTO 100
               IF (T54EQUAL(ONESAT(JAT),' QG ')) GOTO 100
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' QG ')



            ELSE IF (RESTYP(IAA).EQ.5) THEN
               JAT=BOUND_TO(1,PNTAAS(IAA)+4)
               IF (.NOT.WIFITI(JAT)) GOTO 100
               IF (T54EQUAL(ONESAT(JAT),' QB ')) GOTO 100
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' QB ')



            ELSE IF (RESTYP(IAA).EQ.6) THEN
               JAT=BOUND_TO(1,PNTAAS(IAA)+1)
               IF (.NOT.WIFITI(JAT)) GOTO 100
               IF (T54EQUAL(ONESAT(JAT),' QA ')) GOTO 100
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' QA ')



            ELSE IF (RESTYP(IAA).EQ.7) THEN
               JAT=BOUND_TO(1,PNTAAS(IAA)+4)
               IF (.NOT.WIFITI(JAT)) GOTO 100
               IF (T54EQUAL(ONESAT(JAT),' QB ')) GOTO 100
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' QB ')



            ELSE IF (RESTYP(IAA).EQ.8) THEN
               JAT=BOUND_TO(1,PNTAAS(IAA)+6)
               IF (.NOT.WIFITI(JAT)) GOTO 11
               IF (T54EQUAL(ONESAT(JAT),' MG ')) GOTO 11
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' MG ')
   11          CONTINUE
               JAT=BOUND_TO(1,PNTAAS(IAA)+7)
               IF (.NOT.WIFITI(JAT)) GOTO 21
               IF (T54EQUAL(ONESAT(JAT),' MD ')) GOTO 21
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' MD ')
   21          CONTINUE
               JAT=BOUND_TO(1,PNTAAS(IAA)+5)
               IF (.NOT.WIFITI(JAT)) GOTO 100
               IF (T54EQUAL(ONESAT(JAT),' QG ')) GOTO 100
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' QG ')



            ELSE IF (RESTYP(IAA).EQ.9) THEN
               JAT=BOUND_TO(1,PNTAAS(IAA)+4)
               IF (.NOT.WIFITI(JAT)) GOTO 12
               IF (T54EQUAL(ONESAT(JAT),' QB ')) GOTO 12
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' QB ')
   12          CONTINUE
               JAT=BOUND_TO(1,PNTAAS(IAA)+5)
               IF (.NOT.WIFITI(JAT)) GOTO 22
               IF (T54EQUAL(ONESAT(JAT),' QG ')) GOTO 22
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' QG ')
   22          CONTINUE
               JAT=BOUND_TO(1,PNTAAS(IAA)+6)
               IF (.NOT.WIFITI(JAT)) GOTO 32
               IF (T54EQUAL(ONESAT(JAT),' QD ')) GOTO 32
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' QD ')
   32          CONTINUE
               JAT=BOUND_TO(1,PNTAAS(IAA)+7)
               IF (.NOT.WIFITI(JAT)) GOTO 42
               IF (T54EQUAL(ONESAT(JAT),' QE ')) GOTO 42
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' QE ')
   42          CONTINUE
               JAT=BOUND_TO(1,PNTAAS(IAA)+8)
               IF (.NOT.WIFITI(JAT)) GOTO 100
               IF (T54EQUAL(ONESAT(JAT),' QZ ')) GOTO 100
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' QZ ')



            ELSE IF (RESTYP(IAA).EQ.10) THEN
               JAT=BOUND_TO(1,PNTAAS(IAA)+4)
               IF (.NOT.WIFITI(JAT)) GOTO 13
               IF (T54EQUAL(ONESAT(JAT),' QB ')) GOTO 13
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' QB ')
   13          CONTINUE
               JAT=BOUND_TO(1,PNTAAS(IAA)+6)
               IF (.NOT.WIFITI(JAT)) GOTO 23
               IF (T54EQUAL(ONESAT(JAT),' MD1')) GOTO 23
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' MD1')
   23          CONTINUE
               JAT=BOUND_TO(1,PNTAAS(IAA)+7)
               IF (.NOT.WIFITI(JAT)) GOTO 100
               IF (T54EQUAL(ONESAT(JAT),' MD2')) GOTO 100
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' MD2')



            ELSE IF (RESTYP(IAA).EQ.11) THEN
               JAT=BOUND_TO(1,PNTAAS(IAA)+4)
               IF (.NOT.WIFITI(JAT)) GOTO 14
               IF (T54EQUAL(ONESAT(JAT),' QB ')) GOTO 14
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' QB ')
   14          CONTINUE
               JAT=BOUND_TO(1,PNTAAS(IAA)+5)
               IF (.NOT.WIFITI(JAT)) GOTO 24
               IF (T54EQUAL(ONESAT(JAT),' QG ')) GOTO 24
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' QG ')
   24          CONTINUE
               JAT=BOUND_TO(1,PNTAAS(IAA)+7)
               IF (.NOT.WIFITI(JAT)) GOTO 100
               IF (T54EQUAL(ONESAT(JAT),' ME ')) GOTO 100
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' ME ')



            ELSE IF (RESTYP(IAA).EQ.12) THEN
               JAT=BOUND_TO(1,PNTAAS(IAA)+4)
               IF (.NOT.WIFITI(JAT)) GOTO 15
               IF (T54EQUAL(ONESAT(JAT),' QB ')) GOTO 15
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' QB ')
   15          CONTINUE
               JAT=BOUND_TO(1,PNTAAS(IAA)+7)
               IF (.NOT.WIFITI(JAT)) GOTO 100
               IF (T54EQUAL(ONESAT(JAT),' QD ')) GOTO 100
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' QD ')



            ELSE IF (RESTYP(IAA).EQ.13) THEN
               JAT=BOUND_TO(1,PNTAAS(IAA)+4)
               IF (.NOT.WIFITI(JAT)) GOTO 16
               IF (T54EQUAL(ONESAT(JAT),' QB ')) GOTO 16
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' QB ')
   16          CONTINUE
               JAT=BOUND_TO(1,PNTAAS(IAA)+5)
               IF (.NOT.WIFITI(JAT)) GOTO 26
               IF (T54EQUAL(ONESAT(JAT),' QG ')) GOTO 26
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' QG ')
   26          CONTINUE
               JAT=BOUND_TO(1,PNTAAS(IAA)+6)
               IF (.NOT.WIFITI(JAT)) GOTO 100
               IF (T54EQUAL(ONESAT(JAT),' QD ')) GOTO 100
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' QD ')



            ELSE IF (RESTYP(IAA).EQ.14) THEN
               JAT=BOUND_TO(1,PNTAAS(IAA)+4)
               IF (.NOT.WIFITI(JAT)) GOTO 17
               IF (T54EQUAL(ONESAT(JAT),' QB ')) GOTO 17
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' QB ')
   17          CONTINUE
               JAT=BOUND_TO(1,PNTAAS(IAA)+5)
               IF (.NOT.WIFITI(JAT)) GOTO 27
               IF (T54EQUAL(ONESAT(JAT),' QG ')) GOTO 27
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' QG ')
   27          CONTINUE
               JAT=BOUND_TO(1,PNTAAS(IAA)+8)
               IF (.NOT.WIFITI(JAT)) GOTO 100
               IF (T54EQUAL(ONESAT(JAT),' QE ')) GOTO 100
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' QE ')



            ELSE IF (RESTYP(IAA).EQ.15) THEN
               JAT=BOUND_TO(1,PNTAAS(IAA)+4)
               IF (.NOT.WIFITI(JAT)) GOTO 18
               IF (T54EQUAL(ONESAT(JAT),' QB ')) GOTO 18
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' QB ')
   18          CONTINUE
               JAT=BOUND_TO(1,PNTAAS(IAA)+5)
               IF (.NOT.WIFITI(JAT)) GOTO 28
               IF (T54EQUAL(ONESAT(JAT),' QG ')) GOTO 28
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' QG ')
   28          CONTINUE
               JAT=BOUND_TO(1,PNTAAS(IAA)+6)
               IF (.NOT.WIFITI(JAT)) GOTO 38
               IF (T54EQUAL(ONESAT(JAT),' QD ')) GOTO 38
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' QD ')
   38          CONTINUE
               JAT=BOUND_TO(1,PNTAAS(IAA)+9)
               IF (.NOT.WIFITI(JAT)) GOTO 48
               IF (T54EQUAL(ONESAT(JAT),' QH1')) GOTO 48
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' QH1')
   48          CONTINUE
               JAT=BOUND_TO(1,PNTAAS(IAA)+10)
               IF (.NOT.WIFITI(JAT)) GOTO 100
               IF (T54EQUAL(ONESAT(JAT),' QH2')) GOTO 100
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' QH2')



            ELSE IF (RESTYP(IAA).EQ.16) THEN
               JAT=BOUND_TO(1,PNTAAS(IAA)+4)
               IF (.NOT.WIFITI(JAT)) GOTO 100
               IF (T54EQUAL(ONESAT(JAT),' QB ')) GOTO 100
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' QB ')



            ELSE IF (RESTYP(IAA).EQ.17) THEN
               JAT=BOUND_TO(1,PNTAAS(IAA)+6)
               IF (.NOT.WIFITI(JAT)) GOTO 100
               IF (T54EQUAL(ONESAT(JAT),' MG ')) GOTO 100
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' MG ')



            ELSE IF (RESTYP(IAA).EQ.18) THEN
               JAT=BOUND_TO(1,PNTAAS(IAA)+5)
               IF (.NOT.WIFITI(JAT)) GOTO 19
               IF (T54EQUAL(ONESAT(JAT),' MG1')) GOTO 19
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' MG1')
   19          CONTINUE
               JAT=BOUND_TO(1,PNTAAS(IAA)+6)
               IF (.NOT.WIFITI(JAT)) GOTO 100
               IF (T54EQUAL(ONESAT(JAT),' MG2')) GOTO 100
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' MG2')



            ELSE IF (RESTYP(IAA).EQ.19) THEN
               JAT=BOUND_TO(1,PNTAAS(IAA)+4)
               IF (.NOT.WIFITI(JAT)) GOTO 100
               IF (T54EQUAL(ONESAT(JAT),' QB ')) GOTO 100
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' QB ')



            ELSE IF (RESTYP(IAA).EQ.20) THEN
               JAT=BOUND_TO(1,PNTAAS(IAA)+4)
               IF (.NOT.WIFITI(JAT)) GOTO 100
               IF (T54EQUAL(ONESAT(JAT),' QB ')) GOTO 100
               CALL DIF015A (JAT,'?M1516')
               CALL GVSSTX (ONESAT(JAT),' QB ')
            END IF



         ELSE IF (FAMTYP(RESTYP(IAA)).EQ.3) THEN
            IF (CH4EQCH4(THISAT,' Q5*')) GOTO 998
            IF (CH4EQCH4(THISAT,' Q2*')) GOTO 998
            IF (CH4EQCH4(THISAT,' M7 ')) GOTO 998
            IF (CH4EQCH4(THISAT,' M5 ')) GOTO 998
         END IF
  100 CONTINUE



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE HAS014C (IFT1,IFT2)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IFT1, IFT2, IAA, NUMBND, JATARR(10), I, IAT, KAA,
     +              KAT, JAT
      LOGICAL       WIFITI, AAHASPROTON, CH4EQCH4







      DO 100 IAA=IFT1,IFT2
         IF (.NOT.AAHASPROTON(IAA).AND.WIFPAR(166).EQ.0) GOTO 100



         IF (RESTYP(IAA).LE.0) GOTO 100



         DO 90 IAT=PNTAAS(IAA),PNTAAE(IAA)
            IF (IAT.EQ.1.AND.CH4EQCH4(ONESA3(IAA),'PRO ').OR.
     +       CH4EQCH4(ONESA3(IAA),'HYP ')) GOTO 90




            IF (.NOT.ISATOK(IAT).OR.PROTON(IAT)) GOTO 90
            IF (BOUND_TO(1,IAT).EQ.0) GOTO 90
            CALL FBOND (IAT,JATARR,10,NUMBND)






            DO 80 I=1,NUMBND
               JAT=JATARR(I)
               IF (.NOT.PROTON(JAT)) GOTO 80
               IF (ISATOK(JATARR(I))) GOTO 80
               CALL SHOIAA (IAA)



               KAT=BOUND_TO(1,IAT)
               IF (WIFITI(KAT)) THEN
                  IF (PROTON(KAT).AND.ISATOK(KAT)) THEN
                     CALL MOL203I (JAT,KAT,0)
                     print*,'in 014C at 1'
                     CALL DIF015 (6,'?M1867',IAT)
                     IF (.NOT.WIFITI(BOUND_TO(2,IAT))) THEN
                        KAA=ATIAA(KAT)
                        IF (WIFPAR(1012).GE.1) CALL MOL105 (KAA)
                     END IF
                     GOTO 80
                  END IF
               END IF
               KAT=BOUND_TO(2,IAT)
               IF (WIFITI(KAT)) THEN
                  IF (PROTON(KAT).AND.ISATOK(KAT)) THEN
                     CALL MOL203I (JAT,KAT,0)
                     print*,'in 014C at 2'
                     CALL DIF015 (6,'?M1867',IAT)
                     IF (.NOT.ISATOK(BOUND_TO(1,IAT))) THEN
                        KAA=ATIAA(KAT)
                        IF (WIFPAR(1012).GE.1) CALL MOL105 (KAA)
                     END IF
                     GOTO 80
                  END IF
               END IF
   80       CONTINUE
   90    CONTINUE
  100 CONTINUE





      RETURN
      END
      SUBROUTINE HAS015 (JFT1,JFT2)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, JFT1, JFT2, IERR
      LOGICAL       HASPROTON








      IF (WIFPAR(84).EQ.0) THEN
         CALL GVSTTE ('?R00269')
         CALL GVSKIL
         GOTO 998
      END IF
      IF (WIFPAR(166).EQ.0) THEN
         IF (.NOT.HASPROTON()) GOTO 998
      END IF



      CALL ENVTOT
      CALL HBO010
      CALL GVSBTF (WRK1TF,NUMAAT)



      IF (WIFPAR(1073).EQ.0) THEN
         IF (JFT1.EQ.0) THEN
            CALL WIFWTF (' ',IERR)
            IF (IERR.NE.0) GOTO 998
         ELSE
            DO 70 IAA=JFT1,JFT2
               WRK1TF(IAA)=.TRUE.
   70       CONTINUE
         END IF
      END IF



      CALL HAS005



      CALL MOL200



  998 CONTINUE



      RETURN
      END
      SUBROUTINE HAS016 (IFT1,IFT2)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IFT1, IFT2
      LOGICAL       WIFIRI, HASPROTON








      IF (WIFPAR(84).EQ.0) GOTO 998
      IF (WIFPAR(166).EQ.0) THEN
         IF (.NOT.HASPROTON()) GOTO 998
      END IF
      IF (.NOT.WIFIRI(IFT1).OR..NOT.WIFIRI(IFT2)) GOTO 998



      CALL HAS006 (IFT1,IFT2)
      CALL HAS003 (IFT1,IFT2)



  998 CONTINUE



      RETURN
      END   
      SUBROUTINE HAS017

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, IAT, IAT1, IAT2, IAT3, IAT4, IAT5, IAT6,
     +              IERR, ILOOP, ICNT, MINCNT
      REAL          CHIHAS1, GVFRTD, ANGLE, ANGL1, ANGL2, ANGL3, ANGMIN
      LOGICAL       WIFIR1, WIFIRA, WIFITI, HASPROTON, AAHASPROTON,
     +              T54EQUAL







      IF (WIFPAR(84).EQ.0) GOTO 998
      IF (WIFPAR(166).EQ.0) THEN
         IF (.NOT.HASPROTON()) GOTO 998
      END IF



      DO 100 IAA=1,NUMAAF



         IF (.NOT.AAHASPROTON(IAA).AND.WIFPAR(166).EQ.0) GOTO 100
         IF (.NOT.WIFIR1(IAA)) GOTO 100
         IF (.NOT.WIFIRA(IAA)) GOTO 100
         IF (ONESA3(IAA)(1:3).EQ.'PRO'.OR.
     +       ONESA3(IAA)(1:3).EQ.'HYP') GOTO 100




         IF (BOUND_TO(1,PNTAAS(IAA)).EQ.0.OR.
     +    BOUND_TO(2,PNTAAS(IAA)).EQ.0) GOTO 100
         IF (.NOT.PROTON(BOUND_TO(1,PNTAAS(IAA))).OR.
     +    .NOT.PROTON(BOUND_TO(2,PNTAAS(IAA)))) GOTO 100



         IAT1=0
         DO 10 IAT=PNTAAS(IAA),PNTAAE(IAA)
            IF (T54EQUAL(ONESAT(IAT),' HN ')) IAT1=IAT
   10    CONTINUE
         IF (.NOT.WIFITI(IAT1)) GOTO 100
         IAT2=BOUND_TO(1,PNTAAS(IAA))
         IF (.NOT.WIFITI(IAT2)) GOTO 100
         IAT3=BOUND_TO(2,PNTAAS(IAA))
         IF (.NOT.WIFITI(IAT3)) GOTO 100
         ANGLE=CHIHAS1(IAT3,IAT1,IAT2,PNTAAS(IAA),IERR)
         IF (IERR.NE.0) GOTO 100
         IF (ANGLE.GT.0.0) CALL HAS017A (IAT2,IAT3)



         ANGMIN=9999.9
         MINCNT=0
         DO 90 ILOOP=0,2
            IAT4=PNTAAS(IAA)
            IAT5=PNTAAC(IAA)
            IAT6=PNTAAS(IAA)+2
            ANGLE=ABS(GVFRTD(CHIHAS1(IAT1,IAT4,IAT5,IAT6,IERR)))
            IF (IERR.NE.0) GOTO 100
            IF (ANGLE.LT.ANGMIN) THEN
               ANGMIN=ANGLE
               MINCNT=ILOOP
            END IF
            CALL HAS017A (IAT1,IAT2)
            CALL HAS017A (IAT1,IAT3)
   90    CONTINUE
         IF (MINCNT.GT.0) THEN
            DO 95 ILOOP=1,MINCNT
               CALL HAS017A (IAT1,IAT2)
               CALL HAS017A (IAT1,IAT3)
   95       CONTINUE
         END IF
  100 CONTINUE




      DO 200 IAA=1,NUMAAF



         IF (.NOT.WIFIR1(IAA)) GOTO 200
         IF (.NOT.WIFIRA(IAA)) GOTO 200
         IF (.NOT.AAHASPROTON(IAA).AND.WIFPAR(166).EQ.0) GOTO 200
         IF (ONESA3(IAA)(1:3).EQ.'PRO'.OR.
     +       ONESA3(IAA)(1:3).EQ.'HYP') GOTO 200
         DO 110 IAT=PNTAAS(IAA),PNTAAE(IAA)
            IF (T54EQUAL(ONESAT(IAT),' HN ')) IAT1=IAT
  110    CONTINUE
         IF (.NOT.WIFITI(IAT1)) GOTO 200
         IAT2=BOUND_TO(1,PNTAAS(IAA))
         IF (.NOT.WIFITI(IAT2)) GOTO 200
         IAT3=BOUND_TO(2,PNTAAS(IAA))
         IF (.NOT.WIFITI(IAT3)) GOTO 200
         ICNT=0
         IF (ISATOK(IAT1)) ICNT=ICNT+1
         IF (IAT2.NE.0) THEN
            IF (ISATOK(IAT2)) ICNT=ICNT+1
         END IF
         IF (IAT3.NE.0) THEN
            IF (ISATOK(IAT3)) ICNT=ICNT+1
         END IF
         IF (ICNT.NE.2) GOTO 200



         IAT4=PNTAAS(IAA)
         IF (.NOT.WIFITI(IAT4)) GOTO 200
         IAT5=PNTAAC(IAA)
         IF (.NOT.WIFITI(IAT5)) GOTO 200
         IAT6=PNTAAS(IAA)+2
         IF (.NOT.WIFITI(IAT6)) GOTO 200
         ANGL1=ABS(GVFRTD(CHIHAS1(IAT1,IAT4,IAT5,IAT6,IERR)))
         ANGL2=ABS(GVFRTD(CHIHAS1(IAT2,IAT4,IAT5,IAT6,IERR)))
         ANGL3=ABS(GVFRTD(CHIHAS1(IAT3,IAT4,IAT5,IAT6,IERR)))
         IF (IAT3.LE.0) THEN
            IF (ANGL1.GT.ANGL2) CALL HAS017A (IAT1,IAT2)
         ELSE IF (IAT2.LE.0) THEN
            IF (ANGL1.GT.ANGL3) CALL HAS017A (IAT1,IAT3)
         ELSE IF (.NOT.ISATOK(IAT1)) THEN
            IF (ANGL2.GT.ANGL3) CALL HAS017A (IAT2,IAT3)
         END IF
  200 CONTINUE
      DO 300 IAA=1,NUMAAF



         IF (ONESA3(IAA)(1:3).NE.'PRO'.AND.
     +       ONESA3(IAA)(1:3).NE.'HYP') GOTO 300
         IF (.NOT.WIFIR1(IAA)) GOTO 300
         IF (.NOT.WIFIRA(IAA)) GOTO 300
         IF (.NOT.AAHASPROTON(IAA).AND.WIFPAR(166).EQ.0) GOTO 300
         IAT1=PNTAAS(IAA)
         IAT5=BOUND_TO(1,IAT1)
         IAT6=BOUND_TO(2,IAT1)



         IF (IAT5.NE.0.AND.IAT6.NE.0) THEN
            IF (.NOT.WIFITI(IAT5)) GOTO 300
            IF (.NOT.WIFITI(IAT6)) GOTO 300
            IF (.NOT.PROTON(IAT5)) GOTO 300
            IF (.NOT.PROTON(IAT6)) GOTO 300
         ELSE
            GOTO 300
         END IF



         CALL GVSSTX (ONESAT(IAT5),' H2 ')
         CALL GVSSTX (ONESAT(IAT6),' H3 ')



         IAT1=PNTAAS(IAA)
         IAT2=PNTAAS(IAA)+6
         IAT3=PNTAAC(IAA)
         IAT4=BOUND_TO(1,IAT1)
         ANGL1=CHIHAS1(IAT1,IAT2,IAT3,IAT4,IERR)
         IF (IERR.NE.0) GOTO 300



         IF (ANGL1.LT.0.0) THEN
            CALL HAS017A (BOUND_TO(1,IAT1),BOUND_TO(2,IAT1))
         END IF



         IF (T54EQUAL(ONESAT(BOUND_TO(1,IAT1)),' H3 ')) THEN
            CALL HAS017A (BOUND_TO(1,IAT1),BOUND_TO(2,IAT1))
            CALL GVSWCP (ONESAT(BOUND_TO(1,IAT1)),
     +       ONESAT(BOUND_TO(2,IAT1)))
         END IF
  300 CONTINUE



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE HAS017A (IAT1,IAT2)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'JUNIOR.INC'
      INTEGER       IAT1, IAT2







      IF (IAT1.LE.0.OR.IAT2.LE.0) CALL GVSKIL
      IF (ONESAT(IAT1)(2:2).NE.ONESAT(IAT2)(2:2)) GOTO 998



      CALL GVSWAP (XCOORD(IAT1),XCOORD(IAT2))
      CALL GVSWAP (YCOORD(IAT1),YCOORD(IAT2))
      CALL GVSWAP (ZCOORD(IAT1),ZCOORD(IAT2))
      CALL GVSWAP (ACCESS(IAT1),ACCESS(IAT2))
      CALL GVSWAP (VDWRAD(IAT1),VDWRAD(IAT2))
      CALL GVSWIP (ATCOLR(IAT1),ATCOLR(IAT2))
      CALL GVSWIP (PREVCOL(IAT1),PREVCOL(IAT2))
      CALL GVSWCP (MENDLV(IAT1),MENDLV(IAT2))
      CALL GVSWAP (ATTVAL(IAT1),ATTVAL(IAT2))
      CALL GVSWAP (WEIGHT(IAT1),WEIGHT(IAT2))
      CALL GVSWAP (XBFACT(IAT1),XBFACT(IAT2))
      CALL GVSWLP (USEAT(IAT1),USEAT(IAT2))
      CALL GVSWLP (ISATOK(IAT1),ISATOK(IAT2))
      CALL GVSWLP (PROTON(IAT1),PROTON(IAT2))
      CALL GVSWCP (ORGNAM(IAT1),ORGNAM(IAT2))



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE HAS018 (IAA,DE12)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       FIXED, IAA, IAT, IERR, IAATYP, DE12
      REAL          XYZH(3), XYZB(3), XYZC(3)
      LOGICAL       REALH








      IF (WIFPAR(1146).EQ.0) GOTO 998
      IAATYP=RESTYP(IAA)
      IF (IAATYP.NE.3.AND.IAATYP.NE.4) THEN
         CALL GVSTTB ('?M1994')
         GOTO 998
      END IF







      IF (IAATYP.EQ.3) THEN
         IAT=PNTAAS(IAA)+5+DE12
      ELSE IF (IAATYP.EQ.4) THEN
         IAT=PNTAAS(IAA)+6+DE12
      ELSE
         CALL GVSTTB ('?M1994')
         GOTO 998
      END IF
      CALL HBO012 (IAT,XYZH,XYZB,XYZC,FIXED,REALH)



      IF (IAATYP.EQ.3) THEN
         CALL KLONKTOD ('ATOM  ',SPCATM(9),SPCATM(9),' ',ONESA3(IAA),
     +    CHANAM(IAA),NUMNAM(IAA),' ',XYZH(1),XYZH(2),XYZH(3),
     +    WEIGHT(PNTAAS(IAA)),12.0,'  ',0,ONEORG(IAA),IAA,IERR)
      ELSE IF (IAATYP.EQ.4) THEN


         CALL KLONKTOD ('ATOM  ',SPCATM(10),SPCATM(10),' ',ONESA3(IAA),
     +    CHANAM(IAA),NUMNAM(IAA),' ',XYZH(1),XYZH(2),XYZH(3),
     +    WEIGHT(PNTAAS(IAA)),12.0,'  ',0,ONEORG(IAA),IAA,IERR)
      END IF



  998 CONTINUE



      RETURN
      END
      SUBROUTINE HAS019

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, IAT, JAT, IAT1, IAT2, IAT3, IAT4, IAT5, 
     +              IAT6, ILOOP, JLOOP, IERR, ICNT, MINCNT
      REAL          CHIHAS1, GVFRTD, ANGLE, ANGL1, ANGL2, ANGL3, ANGMIN
      LOGICAL       AAHASPROTON, T54EQUAL







      IF (WIFPAR(84).EQ.0) GOTO 998      



      DO 20 IAA=1,NUMAAT
         IF (.NOT.AAHASPROTON(IAA).AND.WIFPAR(166).EQ.0) GOTO 20
         IF (FAMTYP(RESTYP(IAA)).NE.3) GOTO 20
         DO 10 IAT=1,NUMATF
            IF (T54EQUAL(ONESAT(IAT),' H5T')) THEN
               JAT=BOUND_TO(1,IAT)
               IF (JAT.GT.0) THEN
                  IF (FAMTYP(RESTYP(ATIAA(JAT))).EQ.3) THEN
                     CALL GVSSTX (ONESAT(IAT),' HO5')
                     ONESAT(IAT)(1:1)=''''
                  END IF
               END IF
            END IF
            IF (T54EQUAL(ONESAT(IAT),' H3T')) THEN
               JAT=BOUND_TO(1,IAT)
               IF (JAT.GT.0) THEN
                  IF (FAMTYP(RESTYP(ATIAA(JAT))).EQ.3) THEN
                     CALL GVSSTX (ONESAT(IAT),' HO3')
                     ONESAT(IAT)(1:1)=''''
                  END IF
               END IF
            END IF
   10    CONTINUE
   20 CONTINUE



      DO 40 IAA=1,NUMAAF



         IF (RESTYP(IAA).NE.9) GOTO 40
         IF (.NOT.AAHASPROTON(IAA).AND.WIFPAR(166).EQ.0) GOTO 40



         DO 30 ILOOP=1,3
            IAT3=PNTAAS(IAA)+21
            IAT2=PNTAAS(IAA)+20
            IAT1=PNTAAS(IAA)+19
            ICNT=0
            IF (ISATOK(IAT1)) ICNT=ICNT+1
            IF (ISATOK(IAT2)) ICNT=ICNT+1
            IF (ISATOK(IAT3)) ICNT=ICNT+1
            ANGMIN=9999.9
            MINCNT=0
            IF (ICNT.EQ.3) THEN
               DO 25 JLOOP=0,2
                  IAT4=PNTAAS(IAA)+8
                  IAT5=PNTAAS(IAA)+7
                  IAT6=PNTAAS(IAA)+6
                  ANGLE=ABS(GVFRTD(CHIHAS1(IAT1,IAT4,IAT5,IAT6,IERR)))
                  IF (IERR.NE.0) GOTO 40
                  IF (ANGLE.LT.ANGMIN) THEN
                     ANGMIN=ANGLE
                     MINCNT=JLOOP
                  END IF
                  CALL HAS017A (IAT1,IAT2)
                  CALL HAS017A (IAT1,IAT3)
   25          CONTINUE
               IF (MINCNT.NE.0) THEN
                  DO 27 JLOOP=1,MINCNT
                     CALL HAS017A (IAT1,IAT2)
                     CALL HAS017A (IAT1,IAT3)
   27             CONTINUE
               END IF
            ELSE IF (ICNT.EQ.2) THEN
               IF (.NOT.ISATOK(IAT1)) THEN
                  CALL HAS017A (IAT1,IAT2)
                  CALL HAS017A (IAT2,IAT3)
               ELSE IF (.NOT.ISATOK(IAT2)) THEN
                  CALL HAS017A (IAT2,IAT3)
               END IF
               ANGL1=ABS(GVFRTD(CHIHAS1(IAT1,IAT4,IAT5,IAT6,IERR)))
               ANGL2=ABS(GVFRTD(CHIHAS1(IAT2,IAT4,IAT5,IAT6,IERR)))
               ANGL3=ABS(GVFRTD(CHIHAS1(IAT3,IAT4,IAT5,IAT6,IERR)))
               IF (.NOT.ISATOK(IAT3)) THEN
                  IF (ANGL1.GT.ANGL2) CALL HAS017A (IAT1,IAT2)
               ELSE IF (.NOT.ISATOK(IAT2)) THEN
                  IF (ANGL1.GT.ANGL3) CALL HAS017A (IAT1,IAT3)
               ELSE IF (.NOT.ISATOK(IAT1)) THEN
                  IF (ANGL2.GT.ANGL3) CALL HAS017A (IAT2,IAT3)
               END IF
            ELSE IF (ICNT.EQ.1) THEN
               CALL DIF008 ('?M1995',IAA)
            END IF
   30    CONTINUE
   40 CONTINUE



      DO 60 IAA=1,NUMAAF



         IF (ONESA3(IAA).NE.'DTHY') GOTO 60
         IF (.NOT.AAHASPROTON(IAA).AND.WIFPAR(166).EQ.0) GOTO 60



         DO 50 ILOOP=1,3
            IAT1=PNTAAS(IAA)+30
            IAT2=PNTAAS(IAA)+29
            IAT3=PNTAAS(IAA)+28
            IAT4=PNTAAS(IAA)+19
            IAT5=PNTAAS(IAA)+13
            IAT6=PNTAAS(IAA)+14
            ANGLE=ABS(GVFRTD(CHIHAS1(IAT3,IAT4,IAT5,IAT6,IERR)))
            IF (IERR.NE.0) GOTO 60
            IF (ANGLE.GT.60.0) THEN
               CALL HAS017A (IAT1,IAT2)
               CALL HAS017A (IAT1,IAT3)
            END IF
   50    CONTINUE
   60 CONTINUE



  998 CONTINUE


      RETURN
      END   
      LOGICAL FUNCTION ISPROTON(IAT)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAT, LOC







      IF (ONESAT(IAT)(1:1).EQ.''''.AND.ONESAT(IAT)(2:2).EQ.'H') THEN
         ISPROTON=.TRUE.
         GOTO 998
      END IF
      IF (ONESAT(IAT)(1:1).EQ.' '.AND.ONESAT(IAT)(2:2).EQ.'H') THEN
         ISPROTON=.TRUE.
         GOTO 998
      END IF



      IF (ONESAT(IAT).EQ.' HOH '.OR.ONESAT(IAT).EQ.'HOH  '.OR.
     +    ONESAT(IAT).EQ.'HG   '.OR.ONESAT(IAT).EQ.'HO   '.OR.
     +    ONESAT(IAT).EQ.'HE   '.OR.ONESAT(IAT).EQ.'HF   ') THEN
         ISPROTON=.FALSE.
      ELSE
         LOC=ICHAR(ONESAT(IAT)(1:1))
         IF (LOC.EQ.ICHAR(' ')) LOC=ICHAR(ONESAT(IAT)(2:2))
         IF (LOC.EQ.ICHAR(' ')) LOC=ICHAR(ONESAT(IAT)(3:3))
         IF (LOC.EQ.ICHAR(' ')) LOC=ICHAR(ONESAT(IAT)(4:4))

         IF (WIFPAR(1505).EQ.0) THEN
            ISPROTON=((LOC.GE.ICHAR('1').AND.LOC.LE.(ICHAR('9'))).OR.
     +       LOC.EQ.ICHAR('H').OR.LOC.EQ.ICHAR('D').OR.
     +       LOC.EQ.ICHAR('Q').OR.LOC.EQ.ICHAR('M'))
         ELSE
            ISPROTON=((LOC.GE.ICHAR('1').AND.LOC.LE.(ICHAR('9'))).OR.
     +       LOC.EQ.ICHAR('H').OR.LOC.EQ.ICHAR('D'))
         END IF
      END IF



  998 CONTINUE


      RETURN
      END
      LOGICAL FUNCTION ISPSEUDOH(IAT)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAT, LOC







      LOC=ICHAR(ONESAT(IAT)(1:1))
      IF (LOC.EQ.ICHAR(' ')) LOC=ICHAR(ONESAT(IAT)(2:2))
      IF (LOC.EQ.ICHAR(' ')) LOC=ICHAR(ONESAT(IAT)(3:3))
      ISPSEUDOH=(LOC.EQ.ICHAR('Q').OR.LOC.EQ.ICHAR('M'))





      RETURN
      END
      LOGICAL FUNCTION TXTPROTON(CHAR4,CHAR2)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       LOC
      CHARACTER*(*) CHAR2
      CHARACTER*(*) CHAR4







      TXTPROTON=.FALSE.




      IF (CHAR4(1:2).EQ.' H'.OR.CHAR4(1:2).EQ.' D') THEN
         TXTPROTON=.TRUE.
         GOTO 998
      END IF
      IF (CHAR2.EQ.' H'.OR.CHAR2.EQ.' D') THEN
         TXTPROTON=.TRUE.
         GOTO 998
      END IF




      LOC=ICHAR(CHAR4(1:1))
      IF (LOC.GE.ICHAR('1').AND.LOC.LE.ICHAR('9')) THEN
         IF (CHAR4(2:2).EQ.'H'.OR.CHAR4(2:2).EQ.'D') THEN
            TXTPROTON=.TRUE.
            GOTO 998
         END IF
      END IF




      IF (CHAR4(1:2).EQ.'HG') THEN
         IF (CHAR2(1:2).EQ.'HG') THEN
            TXTPROTON=.FALSE.
            GOTO 998
         END IF
      END IF
      IF (CHAR4(1:2).EQ.'HO') THEN
         IF (CHAR2(1:2).EQ.'HO') THEN
            TXTPROTON=.FALSE.
            GOTO 998
         END IF
      END IF




      TXTPROTON=.FALSE.
      LOC=ICHAR(CHAR4(1:1))
      IF (LOC.EQ.ICHAR(' ')) THEN
         LOC=ICHAR(CHAR4(2:2))
         IF (LOC.EQ.ICHAR(' ')) THEN
            LOC=ICHAR(CHAR4(3:3))
            IF (LOC.EQ.ICHAR(' ')) THEN
               LOC=ICHAR(CHAR4(4:4))
               IF (LOC.EQ.ICHAR(' ')) GOTO 998
            END IF
         END IF
      END IF

      IF (WIFPAR(1505).EQ.0) THEN
         TXTPROTON=(LOC.EQ.ICHAR('H').OR.LOC.EQ.ICHAR('D').OR.
     +    LOC.EQ.ICHAR('Q').OR.(LOC.GE.ICHAR('1').AND.
     +    LOC.LE.ICHAR('9')))
      ELSE
         TXTPROTON=(LOC.EQ.ICHAR('H').OR.LOC.EQ.ICHAR('D').OR.
     +    (LOC.GE.ICHAR('1').AND.LOC.LE.ICHAR('9')))
      END IF



  998 CONTINUE



      RETURN
      END
      SUBROUTINE REALHYD (IATIN,NUMRHY,IATRHY,XYZRHY)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IATCON, IAT1, IAT2, IAA, IATIN, 
     +              IATRHY(4), NUMRHY
      REAL          XYZRHY(3,4)
      LOGICAL       GVFIBN







      IF (.NOT.GVFIBN(IATIN,1,NUMATF)) THEN
         CALL GVSKIL
         GOTO 998
      END IF
      IF (PROTON(IATIN)) THEN
         CALL GVSKIL
         GOTO 998
      END IF



      CALL GVSIT0 (IATRHY,4)
      CALL GVSRT0 (XYZRHY,3*4)
      NUMRHY=0
      IAA=ATIAA(IATIN)



      DO 10 IATCON=1,MAXTAT



         IF (MUTCON(1,IATCON,RESTYP(IAA)).NE.0) THEN



            IAT1=PNTAAS(IAA)-1+MUTCON(1,IATCON,RESTYP(IAA))
            IAT2=PNTAAS(IAA)-1+MUTCON(2,IATCON,RESTYP(IAA))



            IF ((IAT1.EQ.IATIN.AND.PROTON(IAT2)).OR.
     +          (IAT2.EQ.IATIN.AND.PROTON(IAT1))) THEN
               NUMRHY=NUMRHY+1
               IATRHY(NUMRHY)=IAT2
               XYZRHY(1,NUMRHY)=XCOORD(IAT2)
               XYZRHY(2,NUMRHY)=YCOORD(IAT2)
               XYZRHY(3,NUMRHY)=ZCOORD(IAT2)
            END IF
         END IF
   10 CONTINUE



  998 CONTINUE


      RETURN
      END   
      LOGICAL FUNCTION ISNMRATOM(THISTP,THISAT)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       THISTP
      CHARACTER*4   THISAT
      LOGICAL       CH4EQCH4







      IF (WIFPAR(1172).EQ.0) THEN
         CALL GVST6C ('?M1515','ISNMRATOM',.TRUE.)
         ISNMRATOM=.FALSE.
         GOTO 998
      END IF



      ISNMRATOM=.TRUE.



      IF (FAMTYP(THISTP).EQ.1) THEN
         IF (THISTP.EQ.1) THEN
            IF (CH4EQCH4(THISAT,' MB ')) GOTO 998
         ELSE IF (THISTP.EQ.2) THEN
            IF (CH4EQCH4(THISAT,' QB ')) GOTO 998
         ELSE IF (THISTP.EQ.3) THEN
            IF (CH4EQCH4(THISAT,' QB ')) GOTO 998
         ELSE IF (THISTP.EQ.4) THEN
            IF (CH4EQCH4(THISAT,' QB ')) GOTO 998
            IF (CH4EQCH4(THISAT,' QG ')) GOTO 998
         ELSE IF (THISTP.EQ.5) THEN
            IF (CH4EQCH4(THISAT,' QB ')) GOTO 998
            IF (CH4EQCH4(THISAT,' QD ')) GOTO 998
            IF (CH4EQCH4(THISAT,' QE ')) GOTO 998
            IF (CH4EQCH4(THISAT,' QR ')) GOTO 998
         ELSE IF (THISTP.EQ.6) THEN
            IF (CH4EQCH4(THISAT,' QA ')) GOTO 998
         ELSE IF (THISTP.EQ.7) THEN
            IF (CH4EQCH4(THISAT,' QB ')) GOTO 998
         ELSE IF (THISTP.EQ.8) THEN
            IF (CH4EQCH4(THISAT,' MG ')) GOTO 998
            IF (CH4EQCH4(THISAT,' MD ')) GOTO 998
            IF (CH4EQCH4(THISAT,' QG ')) GOTO 998
         ELSE IF (THISTP.EQ.9) THEN
            IF (CH4EQCH4(THISAT,' QB ')) GOTO 998
            IF (CH4EQCH4(THISAT,' QG ')) GOTO 998
            IF (CH4EQCH4(THISAT,' QD ')) GOTO 998
            IF (CH4EQCH4(THISAT,' QE ')) GOTO 998
            IF (CH4EQCH4(THISAT,' QZ ')) GOTO 998
         ELSE IF (THISTP.EQ.10) THEN
            IF (CH4EQCH4(THISAT,' MD1')) GOTO 998
            IF (CH4EQCH4(THISAT,' MD2')) GOTO 998
            IF (CH4EQCH4(THISAT,' QB ')) GOTO 998
            IF (CH4EQCH4(THISAT,' QD ')) GOTO 998
         ELSE IF (THISTP.EQ.11) THEN
            IF (CH4EQCH4(THISAT,' QB ')) GOTO 998
            IF (CH4EQCH4(THISAT,' QG ')) GOTO 998
            IF (CH4EQCH4(THISAT,' ME ')) GOTO 998
         ELSE IF (THISTP.EQ.12) THEN
            IF (CH4EQCH4(THISAT,' QB ')) GOTO 998
            IF (CH4EQCH4(THISAT,' QD ')) GOTO 998
         ELSE IF (THISTP.EQ.13) THEN
            IF (CH4EQCH4(THISAT,' QB ')) GOTO 998
            IF (CH4EQCH4(THISAT,' QG ')) GOTO 998
            IF (CH4EQCH4(THISAT,' QD ')) GOTO 998
         ELSE IF (THISTP.EQ.14) THEN
            IF (CH4EQCH4(THISAT,' QB ')) GOTO 998
            IF (CH4EQCH4(THISAT,' QG ')) GOTO 998
            IF (CH4EQCH4(THISAT,' QE ')) GOTO 998
         ELSE IF (THISTP.EQ.15) THEN
            IF (CH4EQCH4(THISAT,' QB ')) GOTO 998
            IF (CH4EQCH4(THISAT,' QG ')) GOTO 998
            IF (CH4EQCH4(THISAT,' QD ')) GOTO 998
            IF (CH4EQCH4(THISAT,' QH1')) GOTO 998
            IF (CH4EQCH4(THISAT,' QH2')) GOTO 998
            IF (CH4EQCH4(THISAT,' QZ ')) GOTO 998
         ELSE IF (THISTP.EQ.16) THEN
            IF (CH4EQCH4(THISAT,' QB ')) GOTO 998
         ELSE IF (THISTP.EQ.17) THEN
            IF (CH4EQCH4(THISAT,' MG ')) GOTO 998
         ELSE IF (THISTP.EQ.18) THEN
            IF (CH4EQCH4(THISAT,' MG1')) GOTO 998
            IF (CH4EQCH4(THISAT,' MG2')) GOTO 998
            IF (CH4EQCH4(THISAT,' QG ')) GOTO 998
         ELSE IF (THISTP.EQ.19) THEN
            IF (CH4EQCH4(THISAT,' QB ')) GOTO 998
         ELSE IF (THISTP.EQ.20) THEN
            IF (CH4EQCH4(THISAT,' QB ')) GOTO 998
            IF (CH4EQCH4(THISAT,' QD ')) GOTO 998
            IF (CH4EQCH4(THISAT,' QE ')) GOTO 998
            IF (CH4EQCH4(THISAT,' QR ')) GOTO 998
         END IF



      ELSE IF (FAMTYP(THISTP).EQ.3) THEN
         IF (CH4EQCH4(THISAT,' Q5*')) GOTO 998
         IF (CH4EQCH4(THISAT,' Q2*')) GOTO 998
         IF (CH4EQCH4(THISAT,' M7 ')) GOTO 998
         IF (CH4EQCH4(THISAT,' M5 ')) GOTO 998
      END IF




      ISNMRATOM=.FALSE.



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE ROUNDXYZ

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAT, IROUND







      DO 10 IAT=1,NUMATF
         IROUND=NINT(1000.0*XCOORD(IAT))
         XCOORD(IAT)=FLOAT(IROUND)/1000.0
         IROUND=NINT(1000.0*YCOORD(IAT))
         YCOORD(IAT)=FLOAT(IROUND)/1000.0
         IROUND=NINT(1000.0*ZCOORD(IAT))
         ZCOORD(IAT)=FLOAT(IROUND)/1000.0
   10 CONTINUE



      CALL MOL200
      CALL MOL199 (1,NUMAAF)
      CALL MOL200
      CALL MOL199 (1,NUMAAF)
      CALL MOL200





      RETURN
      END   
      SUBROUTINE HAS020 

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'REFINC.INC'







      CALL GVSCPR (OLDX,XCOORD,NUMATF)
      CALL GVSCPR (OLDY,YCOORD,NUMATF)
      CALL GVSCPR (OLDZ,ZCOORD,NUMATF)





      RETURN
      END   
      SUBROUTINE HAS021 

















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







      DO 100 IAT=1,NUMATF
         IF (PROTON(IAT)) THEN
            IF (SQRT((XCOORD(IAT)-OLDX(IAT))**2+
     +               (YCOORD(IAT)-OLDY(IAT))**2+
     +               (ZCOORD(IAT)-OLDZ(IAT))**2).LT.0.25) THEN
               XCOORD(IAT)=OLDX(IAT)
               YCOORD(IAT)=OLDY(IAT)
               ZCOORD(IAT)=OLDZ(IAT)
            END IF
         END IF
  100 CONTINUE





      RETURN
      END   
      REAL FUNCTION CHIHAS(IAT1,IAT2,IAT3,IAT4)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAT1, IAT2, IAT3, IAT4, I, IRT, IAA
      REAL          X1(3), X2(3), X3(3), X4(3), U(3), V(3), W(3),
     +              UV(3), VW(3), TAU, ARG, ALMST1, UVL, VWL, GVFACS,
     +              TEMP, GVFDP3, GVFDTR, GVF2PI
      SAVE          ALMST1
      DATA ALMST1  /0.99999999/







      IF (IAT1.LT.1.OR.IAT2.LT.1.OR.IAT3.LT.1.OR.IAT4.LT.1.OR.
     +    IAT1.GT.NUMATF.OR.IAT2.GT.NUMATF.OR.IAT3.GT.NUMATF.OR.
     +    IAT4.GT.NUMATF.OR.IAT1.EQ.IAT2.OR.IAT1.EQ.IAT3.OR.
     +    IAT1.EQ.IAT4.OR.IAT2.EQ.IAT3.OR.IAT2.EQ.IAT4.OR.
     +    IAT3.EQ.IAT4.OR.ATIAA(IAT1).NE.ATIAA(IAT2).OR.
     +    ATIAA(IAT1).NE.ATIAA(IAT3).OR.ATIAA(IAT1).NE.ATIAA(IAT4)) THEN
         IF (WIFPAR(1012).GT.1) THEN
            CALL GVSTTE ('?M1329')
            CALL GVSTTI ('NUMATF :',NUMATF)
            CALL GVSTTI4 ('?M1307',IAT1,IAT2,IAT3,IAT4)
            CALL GVSTTI4 ('?M1330',ATIAA(IAT1),ATIAA(IAT2),
     +       ATIAA(IAT3),ATIAA(IAT4))
         END IF
         CHIHAS=0.0
         CALL MOL010 ('CHIHAS')
         CALL GVSKIL
         GOTO 998
      END IF



      IAA=ATIAA(IAT1)
      IRT=RESTYP(IAA)
      X1(1)=STDCRD(1,PINIAA(IAT1),IRT)
      X1(2)=STDCRD(2,PINIAA(IAT1),IRT)
      X1(3)=STDCRD(3,PINIAA(IAT1),IRT)
      X2(1)=STDCRD(1,PINIAA(IAT2),IRT)
      X2(2)=STDCRD(2,PINIAA(IAT2),IRT)
      X2(3)=STDCRD(3,PINIAA(IAT2),IRT)
      X3(1)=STDCRD(1,PINIAA(IAT3),IRT)
      X3(2)=STDCRD(2,PINIAA(IAT3),IRT)
      X3(3)=STDCRD(3,PINIAA(IAT3),IRT)
      X4(1)=STDCRD(1,PINIAA(IAT4),IRT)
      X4(2)=STDCRD(2,PINIAA(IAT4),IRT)
      X4(3)=STDCRD(3,PINIAA(IAT4),IRT)



      DO 10 I=1,3
         U(I) = X2(I) - X1(I)
         V(I) = X3(I) - X2(I)
         W(I) = X4(I) - X3(I)
 10   CONTINUE



      IF (ABS(U(1))+ABS(U(2))+ABS(U(3)).LT.0.00001.OR.
     +    ABS(V(1))+ABS(V(2))+ABS(V(3)).LT.0.00001.OR.
     +    ABS(W(1))+ABS(W(2))+ABS(W(3)).LT.0.00001) THEN
         IF (WIFPAR(1012).GT.1) CALL GVSTTE ('?M1331')
         CHIHAS=0.0
         GOTO 998
      END IF



      CALL CHI002 (U,V,UV,UVL)
      CALL CHI002 (V,W,VW,VWL)
      IF (ABS(UVL*VWL).LT.0.0000001) THEN
         IF (WIFPAR(1012).GT.1) CALL GVSTTE ('?M1332')
         CHIHAS=0.0
         GOTO 998
      END IF
      ARG=GVFDP3(UV,VW)/SQRT(UVL*VWL)
      IF(ABS(ARG).GT.ALMST1) ARG=SIGN(ALMST1,ARG)
      TAU=GVFACS(ARG)



      TEMP=SIGN(TAU,GVFDP3(UV,W))



      TEMP=GVF2PI(TEMP)
      IF (TEMP.GT.GVFDTR(180.0)) TEMP=TEMP-GVFDTR(360.0)
      CHIHAS=TEMP



  998 CONTINUE


      RETURN
      END
      REAL FUNCTION CHIHAS1(IAT1,IAT2,IAT3,IAT4,IERR)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAT1, IAT2, IAT3, IAT4, I, IERR
      REAL          X1(3), X2(3), X3(3), X4(3), U(3), V(3), W(3),
     +              UV(3), VW(3), TAU, ARG, ALMST1, UVL, VWL, GVFACS,
     +              TEMP, GVFDP3, GVFDTR, GVF2PI
      SAVE          ALMST1
      DATA ALMST1  /0.99999999/







      IERR=0



      IF (IAT1.LT.1.OR.IAT2.LT.1.OR.IAT3.LT.1.OR.IAT4.LT.1.OR.
     +    IAT1.GT.NUMATF.OR.IAT2.GT.NUMATF.OR.IAT3.GT.NUMATF.OR.
     +    IAT4.GT.NUMATF.OR.IAT1.EQ.IAT2.OR.IAT1.EQ.IAT3.OR.
     +    IAT1.EQ.IAT4.OR.IAT2.EQ.IAT3.OR.IAT2.EQ.IAT4.OR.
     +    IAT3.EQ.IAT4.OR.(.NOT.ISATOK(IAT1)).OR.(.NOT.ISATOK(IAT2)).OR.
     +    (.NOT.ISATOK(IAT3)).OR.(.NOT.ISATOK(IAT4))) THEN
         IF (WIFPAR(1012).GT.1) THEN
            CALL GVSTTE ('?M1333')
            CALL GVSTTI ('NUMATF :',NUMATF)
            CALL GVSTTI4 ('4 ATOMS :',IAT1,IAT2,IAT3,IAT4)
         END IF
         CHIHAS1=999.9
         IERR=1
         GOTO 998
      END IF



      X1(1)=XCOORD(IAT1)
      X1(2)=YCOORD(IAT1)
      X1(3)=ZCOORD(IAT1)
      X2(1)=XCOORD(IAT2)
      X2(2)=YCOORD(IAT2)
      X2(3)=ZCOORD(IAT2)
      X3(1)=XCOORD(IAT3)
      X3(2)=YCOORD(IAT3)
      X3(3)=ZCOORD(IAT3)
      X4(1)=XCOORD(IAT4)
      X4(2)=YCOORD(IAT4)
      X4(3)=ZCOORD(IAT4)



      DO 10 I=1,3
         U(I)=X2(I)-X1(I)
         V(I)=X3(I)-X2(I)
         W(I)=X4(I)-X3(I)
 10   CONTINUE



      IF (ABS(U(1))+ABS(U(2))+ABS(U(3)).LT.0.00001.OR.
     +    ABS(V(1))+ABS(V(2))+ABS(V(3)).LT.0.00001.OR.
     +    ABS(W(1))+ABS(W(2))+ABS(W(3)).LT.0.00001) THEN
         IF (WIFPAR(1012).GT.1) CALL GVSTTE ('?M1334')
         CHIHAS1=999.9
         IERR=1
         GOTO 998
      END IF



      CALL CHI002 (U,V,UV,UVL)
      CALL CHI002 (V,W,VW,VWL)
      IF (ABS(UVL*VWL).LT.0.0000001) THEN
         IF (WIFPAR(1012).GT.1) CALL GVSTTE ('?M1335')
         CHIHAS1=0.0
         IERR=1
         GOTO 998
      END IF
      ARG=GVFDP3(UV,VW)/SQRT(UVL*VWL)
      IF(ABS(ARG).GT.ALMST1) ARG=SIGN(ALMST1,ARG)
      TAU=GVFACS(ARG)



      TEMP=SIGN(TAU,GVFDP3(UV,W))



      TEMP=GVF2PI(TEMP)
      IF (TEMP.GT.GVFDTR(180.0)) TEMP=TEMP-GVFDTR(360.0)
      CHIHAS1=TEMP



  998 CONTINUE


      RETURN
      END
      SUBROUTINE ZNCOOR (IAT)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, IAT, JAA, JAT, JATARR(4), CNUM, IHIS, ICYS, I,
     +              IATMIN
      REAL          JATDST(4), ZNCHG, WIFDST, JATSCO(4), SZNCYS, SCOMIN
      LOGICAL       GVFIBN







      IF (ONESAT(IAT)(1:2).NE.'ZN') THEN
         GOTO 999
      END IF



      IHIS=0
      ICYS=0
      ZNCHG=2.0
      CNUM=0
      IAA=ATIAA(IAT)
      CALL GVSIT0 (JATARR,4)
      CALL GVSRT0 (JATDST,4)
      CALL GVSRT0 (JATSCO,4)



      DO 50 JAA=1,NUMAAF
         IF (MODNMB(JAA).NE.MODNMB(IAA)) GOTO 50
         IF (SOUPNT(JAA).NE.SOUPNT(IAA)) GOTO 50
         IF (RESTYP(JAA).EQ.2) THEN
            IF (WIFDST(IAT,PNTAAS(JAA)+5).LT.2.6) THEN
               CNUM=CNUM+1
               JATARR(CNUM)=PNTAAS(JAA)+5
               JATDST(CNUM)=WIFDST(IAT,PNTAAS(JAA)+5)
               JATSCO(CNUM)=SZNCYS(JAA)
               IF (.NOT.ISATOK(PNTAAS(JAA)+10)) ZNCHG=ZNCHG-1.0
               ICYS=ICYS+1
            END IF
         END IF
         IF (RESTYP(JAA).EQ.7) THEN
            IF (WIFDST(IAT,PNTAAS(JAA)+6).LT.2.6) THEN
               CNUM=CNUM+1
               JATARR(CNUM)=PNTAAS(JAA)+6
               JATDST(CNUM)=WIFDST(IAT,PNTAAS(JAA)+6)
               IHIS=IHIS+1
               IF (.NOT.ISATOK(PNTAAS(JAA)+17)) ZNCHG=ZNCHG-1.0
            END IF
            IF (WIFDST(IAT,PNTAAS(JAA)+9).LT.2.6) THEN
               CNUM=CNUM+1
               JATARR(CNUM)=PNTAAS(JAA)+9
               JATDST(CNUM)=WIFDST(IAT,PNTAAS(JAA)+9)
               IHIS=IHIS+1
               IF (.NOT.ISATOK(PNTAAS(JAA)+14)) ZNCHG=ZNCHG-1.0
            END IF
         END IF
 50   CONTINUE

      CALL DIF015B (6,IAT,'?M4764',ZNCHG)
      DO 10 JAT=1,CNUM
         CALL DIF015B (6,JATARR(JAT),' d=',JATDST(JAT))
 10   CONTINUE
      IF (ABS(ZNCHG-1.0).LT.0.1) GOTO 998



      IF (CNUM.NE.4) THEN
         CALL GVSTT6 ('?M4017')
         CALL SHOIAA (IAA)
         GOTO 998
      END IF








      IF (FLOAT(ICYS)+0.1.GT.ZNCHG) THEN




         DO 100 I=1,CNUM
            JAT=JATARR(I)
            JAA=ATIAA(JAT)
            IF (RESTYP(JAA).NE.2) THEN
               JATSCO(I)=900.0
            ELSE
               JATSCO(I)=SZNCYS(JAA)
            END IF
 100     CONTINUE



 101     CONTINUE
         IF (ZNCHG.GT.0.5) THEN
            IATMIN=0
            SCOMIN=999.9



            DO 110 I=1,CNUM
               IF (JATSCO(I).LT.SCOMIN) THEN
                  IATMIN=I
                  SCOMIN=JATSCO(I)
               END IF
 110        CONTINUE



            IF (GVFIBN(IATMIN,1,4)) THEN
               JAA=ATIAA(JATARR(IATMIN))
               IF (RESTYP(JAA).EQ.2) THEN
                  CALL HAS012 (PNTAAS(JAA)+10)
                  ZNCHG=ZNCHG-1.0
                  JATSCO(IATMIN)=901.0
               ELSE
                  CALL GVSTT6 ('?M4017')
                  GOTO 998
               END IF
               GOTO 101
            ELSE
               CALL GVSTT6 ('?M4017')
               GOTO 998
            END IF
         END IF
      ELSE
         CALL GVSTT6 ('?M4017')
      END IF
      GOTO 998



  999 CONTINUE
      CALL GVSEIW ('ZNCOOR')



  998 CONTINUE


      RETURN 
      END
      REAL FUNCTION SZNCYS(IAA)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, IAT, JAT, JSYM
      REAL          OWNDST, ANYDST







      IAT=PNTAAS(IAA)+10
      SZNCYS=0.0




         CALL SC9011 (IAT,OWNDST,ANYDST,JAT,JSYM)
         SZNCYS=MIN(OWNDST,ANYDST)






      RETURN
      END   
      SUBROUTINE WRKFUT

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, FUWSTO, FUWMOD(2500)
      CHARACTER*1   FUWCHA(2500)
      CHARACTER*4   FUWSA3(2500), FUWNNM(2500)
      COMMON /FUWRK/FUWSTO, FUWMOD, FUWCHA, FUWSA3, FUWNNM







      CALL GVSIT0 (FUTURE,MAXAA)
      FUWSTO=0



      DO 10 IAA=1,NUMAAF
         IF (WRK1TF(IAA)) FUTURE(IAA)=1
 10   CONTINUE



      IF (NUMAAT.EQ.NUMAAF) GOTO 998
      DO 20 IAA=NUMAAF+1,NUMAAT
         IF (WRK1TF(IAA)) THEN
            FUWSTO=FUWSTO+1
            CALL GVSSTX (FUWSA3(FUWSTO),ONESA3(IAA))
            CALL GVSSTX (FUWNNM(FUWSTO),NUMNAM(IAA))
            FUWMOD(FUWSTO)=MODNMB(IAA)
            FUWCHA(FUWSTO)=CHANAM(IAA)
         END IF
 20   CONTINUE



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE FUTWRK

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, IFUT, FUWSTO, FUWMOD(2500)
      CHARACTER*1   FUWCHA(2500)
      CHARACTER*4   FUWSA3(2500), FUWNNM(2500)
      COMMON /FUWRK/FUWSTO, FUWMOD, FUWCHA, FUWSA3, FUWNNM







      CALL GVSBTF (WRK1TF,MAXAA)
      CALL GVSBTF (WRK4TF,MAXAA)



      DO 10 IAA=1,NUMAAF
         IF (FUTURE(IAA).GE.1) THEN
            WRK1TF(IAA)=.TRUE.
            WRK4TF(IAA)=.TRUE.
         END IF
 10   CONTINUE



      IF (NUMAAT.LE.NUMAAF.OR.FUWSTO.LE.0) GOTO 998
      DO 30 IAA=NUMAAF+1,NUMAAT
         DO 20 IFUT=1,FUWSTO
            IF (ONESA3(IAA).NE.FUWSA3(IFUT)) GOTO 20
            IF (NUMNAM(IAA).NE.FUWNNM(IFUT)) GOTO 20
            IF (CHANAM(IAA).NE.FUWCHA(IFUT)) GOTO 20
            IF (MODNMB(IAA).NE.FUWMOD(IFUT)) GOTO 20
            WRK1TF(IAA)=.TRUE.
            WRK4TF(IAA)=.TRUE.
            GOTO 30
 20      CONTINUE
 30   CONTINUE



  998 CONTINUE


      RETURN
      END   
