



      SUBROUTINE SYMSD (DST)




















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'SYMINC.INC'
      INTEGER       OLD1504
      REAL          DST
      INTEGER       IERR
      SAVE          OLD1504
      DATA OLD1504  /-1/







      IF (WIFPAR(590).LE.0.OR.(.NOT.SYMHAS)) GOTO 998



      IF (OLD1504.NE.WIFPAR(1504)) NEADST=DST-999.9
      OLD1504=WIFPAR(1504)




      IF (DST.GT.NEADST+0.001.OR.
     +     (DST.LT.NEADST-3.0.AND.WIFPAR(592).LE.0)) THEN




         IF (WIFPAR(592).GT.0) THEN
            CALL GVSTT6 ('?M0323')
            WIFPAR(592)=0
         END IF
         CALL SYMIPG (IERR,' ')
         IF (IERR.EQ.0) THEN
            CALL WIFPUSHPPP (56,NINT(100*DST))
            CALL SYMNEA
            CALL WIFPOPPPP (56)
            NEADST=DST
            IF (WIFPAR(1128).EQ.0.AND.WIFPAR(1012).GT.0) CALL GVSTTR 
     +       ('?M0313',DST)
         END IF


      END IF



  998 CONTINUE


      RETURN
      END
      SUBROUTINE FCONAAI (IAA,RAD,FAST,JAAARR,JAASYM,NUM,MAXNUM)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ENVIRO.INC'
      INCLUDE       'SYMINC.INC'
      INTEGER       NUM, MAXNUM, JAAARR(MAXNUM), JAASYM(MAXNUM), NS,
     +              ISYM, JSYM, SYMNEG, ISOU, ISOUP, IAA, JAA
      REAL          DST, RAD, TMP(3), DIST2, TVEC(3)
      LOGICAL       FAST, CONTACT, SYMCUT







      NUM=0
      DST=RAD+SPHRAD(4,IAA)



      IF (WIFPAR(590).GT.0) THEN



         CALL SYMSD (RAD)
         NS=NUMSYM
      ELSE
         NS=1
      ENDIF
      DO 100 ISYM=1,NS



         TMP(1)=SPHRAD(1,IAA)
         TMP(2)=SPHRAD(2,IAA)
         TMP(3)=SPHRAD(3,IAA)
         IF (ISYM.GT.1) THEN
            JSYM=SYMNEG(ISYM)
            TVEC(1)=SYMVEC(1,JSYM)+SYMMAT(1,1,JSYM)*TMP(1)+
     +                             SYMMAT(1,2,JSYM)*TMP(2)+
     +                             SYMMAT(1,3,JSYM)*TMP(3)
            TVEC(2)=SYMVEC(2,JSYM)+SYMMAT(2,1,JSYM)*TMP(1)+
     +                             SYMMAT(2,2,JSYM)*TMP(2)+
     +                             SYMMAT(2,3,JSYM)*TMP(3)
            TVEC(3)=SYMVEC(3,JSYM)+SYMMAT(3,1,JSYM)*TMP(1)+
     +                             SYMMAT(3,2,JSYM)*TMP(2)+
     +                             SYMMAT(3,3,JSYM)*TMP(3)
            TMP(1)=TVEC(1)
            TMP(2)=TVEC(2)
            TMP(3)=TVEC(3)
         END IF
         DO 60 ISOU=1,NUMSOU
            ISOUP=USESOU(ISOU)
            IF (ISOUP.EQ.0) GOTO 60



            IF (SOUPNT(SOUADM(1,ISOUP)).NE.SOUPNT(IAA)) GOTO 60
            IF (MODNMB(SOUADM(1,ISOUP)).NE.MODNMB(IAA)) GOTO 60
            DO 50 JAA=SOUADM(1,ISOUP),SOUADM(2,ISOUP)
               DIST2=(SPHRAD(1,JAA)-TMP(1))**2+
     +               (SPHRAD(2,JAA)-TMP(2))**2+
     +               (SPHRAD(3,JAA)-TMP(3))**2
               IF (DIST2.LT.(SPHRAD(4,JAA)+DST)**2) THEN
                  IF (FAST) THEN
                     CONTACT=.TRUE.
                  ELSE
                     CONTACT=SYMCUT(IAA,JAA,ISYM,RAD)
                  END IF
                  IF (CONTACT) THEN
                     IF (NUM.GE.MAXNUM) THEN
                        IF (MAXNUM.GT.2) THEN
                           CALL GVSTTE ('?M0314')
                           CALL GVSTTI ('?M0315',MAXNUM)
                           CALL GVSTTI ('?M0316',IAA)
                           CALL GVSTTI2 ('?M0317',ISYM,NS)
                           CALL GVSTTI ('?M0318',JAA)
                        END IF
                        GOTO 998
                     END IF
                     NUM=NUM+1
                     JAAARR(NUM)=JAA
                     JAASYM(NUM)=ISYM
                  END IF
               END IF
 50         CONTINUE
 60      CONTINUE
 100  CONTINUE



  998 CONTINUE


      RETURN
      END
      SUBROUTINE FCONAA (IAA,DST,FAST)



















      IMPLICIT      NONE 
      INCLUDE       'BIGINC.INC'
      INCLUDE       'CNTINC.INC'
      INTEGER       IAA
      REAL          DST
      LOGICAL       FAST





      CALL FCONAAI (IAA,DST,FAST,CONIAA,CONSYMAA,NUMCONIAA,MAXCONIAA)





      RETURN
      END
      SUBROUTINE FCONAA1I (X,Y,Z,RAD,JAAARR,JAASYM,NUM,MAXNUM)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ENVIRO.INC'
      INCLUDE       'SYMINC.INC'
      INTEGER       NUM, MAXNUM, JAAARR(MAXNUM), JAASYM(MAXNUM), NS,
     +              ISYM, JSYM, SYMNEG, ISOU, ISOUP, JAA, JAT
      REAL          DST, RAD, TMP(3), DIST2, X, Y, Z







      NUM=0
      DST=RAD



      CALL SYMSD (DST)



      IF (WIFPAR(590).GT.0) THEN
         NS=NUMSYM
      ELSE
         NS=1
      ENDIF
      DO 100 ISYM=1,NS



         TMP(1)=X
         TMP(2)=Y
         TMP(3)=Z
         IF (ISYM.GT.1) THEN
            JSYM=SYMNEG(ISYM)
            CALL GVSMPV (TMP,SYMMAT(1,1,JSYM),SYMVEC(1,JSYM))
         END IF
         DO 60 ISOU=1,NUMSOU
            ISOUP=USESOU(ISOU)
            IF (ISOUP.EQ.0) GOTO 60
            DO 50 JAA=SOUADM(1,ISOUP),SOUADM(2,ISOUP)
               DIST2=(SPHRAD(1,JAA)-TMP(1))**2+
     +               (SPHRAD(2,JAA)-TMP(2))**2+
     +               (SPHRAD(3,JAA)-TMP(3))**2
               IF (DIST2.LT.(SPHRAD(4,JAA)+DST)**2) THEN
                  DO 40 JAT=PNTAAS(JAA),PNTAAE(JAA)
                     DIST2=(XCOORD(JAT)-TMP(1))**2+
     +                     (YCOORD(JAT)-TMP(2))**2+
     +                     (ZCOORD(JAT)-TMP(3))**2
                     IF (DIST2.LT.(VDWRAD(JAT)+DST)**2) THEN
                        IF (NUM.GE.MAXNUM) THEN
                           CALL GVSTTE ('?M0319')
                           CALL GVSTTI ('?M0315',MAXNUM)
                           GOTO 998
                        END IF
                        NUM=NUM+1
                        JAAARR(NUM)=JAA
                        JAASYM(NUM)=ISYM
                        GOTO 41
                     END IF
 40               CONTINUE
 41               CONTINUE
               END IF
 50         CONTINUE
 60      CONTINUE



 100  CONTINUE



  998 CONTINUE


      RETURN
      END
      SUBROUTINE FCONAA1 (X,Y,Z,DST)



















      IMPLICIT      NONE 
      INCLUDE       'BIGINC.INC'
      INCLUDE       'CNTINC.INC'
      REAL          X, Y, Z, DST





      CALL FCONAA1I (X,Y,Z,DST,CONIAA,CONSYMAA,NUMCONIAA,MAXCONIAA)





      RETURN
      END
      SUBROUTINE FCONATI (IAT,RAD,JATARR,JATSYM,JATDST,NUM,MAXNUM)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ENVIRO.INC'
      INCLUDE       'SYMINC.INC'
      INTEGER       MAXNUM
      INTEGER       NUM, JATARR(MAXNUM), JATSYM(MAXNUM), NS, ISYM, JSYM, 
     +              SYMNEG, ISOU, ISOUP, JAA, JAT, IAT, IAA, I, J, IDONE
      REAL          DST, RAD, TMP(3), DIST2, JATDST(MAXNUM)








      NUM=0
      IDONE=0
      IF (.NOT.ISATOK(IAT)) GOTO 997
      IF (WIFPAR(11).GT.0.AND.PROTON(IAT)) GOTO 997
      DST=RAD+VDWRAD(IAT)
      IAA=ATIAA(IAT)



      IF (IAT.LE.0.OR.IAA.LE.0) THEN
         PRINT*,'BAD BUG IN (CALLING) FCONATI',IAT,IAA
         CALL GVSKIL
         GOTO 997
      END IF



      CALL SYMSD (RAD)



      IF (WIFPAR(590).GE.1.AND.SYMHAS) THEN
         NS=MAX(1,NUMSYM)
      ELSE
         NS=1
      END IF
      DO 100 ISYM=1,NS



         TMP(1)=XCOORD(IAT)
         TMP(2)=YCOORD(IAT)
         TMP(3)=ZCOORD(IAT)
         JSYM=ISYM
         IF (ISYM.GT.1) THEN
            JSYM=SYMNEG(ISYM)
            CALL GVSMPV (TMP,SYMMAT(1,1,JSYM),SYMVEC(1,JSYM))
         END IF



         DO 60 ISOU=1,NUMSOU
            ISOUP=USESOU(ISOU)
            IF (ISOUP.EQ.0) GOTO 60



            IF (MODNMB(SOUADM(1,ISOUP)).NE.MODNMB(IAA)) GOTO 60



            IDONE=IDONE+1
            DO 50 JAA=SOUADM(1,ISOUP),SOUADM(2,ISOUP)



               IF (WIFPAR(391).EQ.0.AND.SOUPNT(IAA).NE.
     +          SOUPNT(JAA)) GOTO 50



               DIST2=SQRT((SPHRAD(1,JAA)-TMP(1))**2+
     +                    (SPHRAD(2,JAA)-TMP(2))**2+
     +                    (SPHRAD(3,JAA)-TMP(3))**2)
               IF (DIST2.LT.SPHRAD(4,JAA)+2.0+DST) THEN



                  DO 40 JAT=PNTAAS(JAA),PNTAAE(JAA)
                     DIST2=SQRT((XCOORD(JAT)-TMP(1))**2+
     +                          (YCOORD(JAT)-TMP(2))**2+
     +                          (ZCOORD(JAT)-TMP(3))**2)
                     IF (DIST2.LT.VDWRAD(JAT)+DST.AND.
     +                   (JAT.NE.IAT.OR.ISYM.GT.1)) THEN



                        IF (.NOT.ISATOK(JAT)) GOTO 40
                        IF (PROTON(JAT).AND.WIFPAR(11).GT.0) GOTO 40
                        NUM=NUM+1
                        JATARR(NUM)=JAT
                        JATSYM(NUM)=ISYM
                        JATDST(NUM)=DIST2
                        IF (NUM.GE.MAXNUM) GOTO 101
                     END IF
 40               CONTINUE
               END IF
 50         CONTINUE
 60      CONTINUE



 100  CONTINUE
 101  CONTINUE



      IF (WIFPAR(187).NE.0.AND.NUM.GT.1) THEN
         DO 120 I=1,NUM-1
            DO 110 J=I+1,NUM
               IF (JATDST(I).GT.JATDST(J)) THEN
                  CALL GVSWIP (JATARR(I),JATARR(J))
                  CALL GVSWIP (JATSYM(I),JATSYM(J))
                  CALL GVSWAP (JATDST(I),JATDST(J))
               END IF
  110       CONTINUE
  120    CONTINUE
      END IF
      IF (IDONE.LE.0) THEN
         PRINT*,'So ukkel, ENVIRONMENT weer es vergeten?'
         PRINT*,'NUMSYM,NUMSOU,IAA,IAT=',NS,NUMSOU,IAA,IAT
         PRINT*,'FCONATI IAT:',ONESAT(IAT),IAA,ONESA3(IAA)
         PRINT*,'FCONATI USESOU:',(USESOU(ISOU),ISOU=1,NUMSOU)
         CALL GVSKIL
      END IF



 997  CONTINUE


      RETURN
      END
      SUBROUTINE FCONAT (IAT,DST)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'CNTINC.INC'
      INTEGER       IAT
      REAL          DST





      CALL FCONATI (IAT,DST,CONIAT,CONSYMAT,CONDSTAT,NUMCONIAT,
     + MAXCONIAT)





      RETURN
      END
      SUBROUTINE FCONAT1I (X,Y,Z,RAD,JATARR,JATSYM,JATDST,NUM,MAXNUM)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ENVIRO.INC'
      INCLUDE       'SYMINC.INC'
      INTEGER       NUM, MAXNUM, JATARR(MAXNUM), JATSYM(MAXNUM), NS,
     +              ISYM, JSYM, SYMNEG, ISOU, ISOUP, JAA, JAT
      REAL          X, Y, Z, DST, RAD, TMP(3), DIST2, JATDST(MAXNUM)







      NUM=0
      DST=RAD



      CALL SYMSD (DST)



      IF (WIFPAR(590).GT.0) THEN
         NS=NUMSYM
      ELSE
         NS=1
      ENDIF
      DO 100 ISYM=1,NS



         TMP(1)=X
         TMP(2)=Y
         TMP(3)=Z
         IF (ISYM.GT.1) THEN
            JSYM=SYMNEG(ISYM)
            CALL GVSMPV (TMP,SYMMAT(1,1,JSYM),SYMVEC(1,JSYM))
         END IF



         DO 60 ISOU=1,NUMSOU
            ISOUP=USESOU(ISOU)
            IF (ISOUP.EQ.0) GOTO 60



            DO 50 JAA=SOUADM(1,ISOUP),SOUADM(2,ISOUP)



               DIST2=(SPHRAD(1,JAA)-TMP(1))**2+
     +               (SPHRAD(2,JAA)-TMP(2))**2+
     +               (SPHRAD(3,JAA)-TMP(3))**2
               IF (DIST2.LT.(SPHRAD(4,JAA)+DST)**2) THEN



                  DO 40 JAT=PNTAAS(JAA),PNTAAE(JAA)
                     DIST2=(XCOORD(JAT)-TMP(1))**2+
     +                     (YCOORD(JAT)-TMP(2))**2+
     +                     (ZCOORD(JAT)-TMP(3))**2
                     IF (DIST2.LT.(VDWRAD(JAT)+DST)**2) THEN



                        IF (.NOT.ISATOK(JAT)) GOTO 40
                        IF (WIFPAR(11).GT.0.AND.PROTON(JAT)) GOTO 40
                        IF (NUM.GE.MAXNUM) THEN
                           CALL GVSTTE ('?M0321')
                           CALL GVSTTI ('?M0315',MAXNUM)
                           CALL GVSKIL
                           GOTO 998
                        END IF
                        NUM=NUM+1
                        JATARR(NUM)=JAT
                        JATSYM(NUM)=ISYM
                        JATDST(NUM)=SQRT(DIST2)
                     END IF
 40               CONTINUE
               END IF
 50         CONTINUE
 60      CONTINUE



 100  CONTINUE



  998 CONTINUE


      RETURN
      END
      SUBROUTINE FCONAT1 (X,Y,Z,DST)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'CNTINC.INC'
      REAL          X, Y, Z, DST





      CALL FCONAT1I (X,Y,Z,DST,CONIAT,CONSYMAT,CONDSTAT,
     + NUMCONIAT,MAXCONIAT)





      RETURN
      END
      SUBROUTINE FCONRED (IAT,CUTOFF)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ENVIRO.INC'
      INCLUDE       'SYMINC.INC'
      INCLUDE       'CNTINC.INC'
      INTEGER       IAT, JAT, I, J, ISYM, JSYM, SYMNEG, IAA
      REAL          DIST, CUTOFF, TMP(3)
      LOGICAL       CH2EQCH2







      IF (NUMCONIAT.LE.0) GOTO 998



      CONIATNOW=IAT
      IAA=ATIAA(IAT)



      IF (WIFPAR(457).EQ.1) THEN
 10      CONTINUE
         DO 30 I=NUMCONIAT,1,-1
            JAT=CONIAT(I)
            IF (.NOT.CH2EQCH2(ONESAT(JAT)(1:2),' O')) THEN
               IF (I.LT.NUMCONIAT) THEN
                  DO 20 J=I,NUMCONIAT-1
                     CONIAT(J)=CONIAT(J+1)
                     CONSYMAT(J)=CONSYMAT(J+1)
                     CONDSTAT(J)=CONDSTAT(J+1)
 20               CONTINUE
               END IF
               NUMCONIAT=NUMCONIAT-1
               GOTO 10
            END IF
 30      CONTINUE
      END IF
      IF (WIFPAR(457).EQ.2) THEN
 12      CONTINUE
         DO 32 I=NUMCONIAT,1,-1
            JAT=CONIAT(I)
            IF (.NOT.CH2EQCH2(ONESAT(JAT)(1:2),' O').AND.
     +          .NOT.CH2EQCH2(ONESAT(JAT)(1:2),' N').AND.
     +          .NOT.CH2EQCH2(ONESAT(JAT)(1:2),' S')) THEN
               IF (I.LT.NUMCONIAT) THEN
                  DO 22 J=I,NUMCONIAT-1
                     CONIAT(J)=CONIAT(J+1)
                     CONSYMAT(J)=CONSYMAT(J+1)
                     CONDSTAT(J)=CONDSTAT(J+1)
 22               CONTINUE
               END IF
               NUMCONIAT=NUMCONIAT-1
               GOTO 12
            END IF
 32      CONTINUE
      END IF
      IF (NUMCONIAT.LE.0) GOTO 998



 40   CONTINUE
      DO 60 I=NUMCONIAT,1,-1
         JAT=CONIAT(I)
         IF (.NOT.ISATOK(JAT)) THEN
            IF (I.LT.NUMCONIAT) THEN
               DO 50 J=I,NUMCONIAT-1
                  CONIAT(J)=CONIAT(J+1)
                  CONSYMAT(J)=CONSYMAT(J+1)
                  CONDSTAT(J)=CONDSTAT(J+1)
 50            CONTINUE
            END IF
            NUMCONIAT=NUMCONIAT-1
            GOTO 40
         END IF
 60   CONTINUE
      IF (NUMCONIAT.LE.0) GOTO 998




 119  CONTINUE
      DO 120 I=NUMCONIAT,1,-1
         JAT=CONIAT(I)
         ISYM=CONSYMAT(I)
         JSYM=SYMNEG(ISYM)
         TMP(1)=XCOORD(IAT)
         TMP(2)=YCOORD(IAT)
         TMP(3)=ZCOORD(IAT)
         CALL GVSMPV (TMP,SYMMAT(1,1,JSYM),SYMVEC(1,JSYM))
         DIST=SQRT((XCOORD(JAT)-TMP(1))**2+
     +             (YCOORD(JAT)-TMP(2))**2+
     +             (ZCOORD(JAT)-TMP(3))**2)
         IF (DIST.GT.CUTOFF.OR.DIST.LT.0.5) THEN
            IF (I.LT.NUMCONIAT) THEN
               DO 110 J=I,NUMCONIAT-1
                  CONIAT(J)=CONIAT(J+1)
                  CONSYMAT(J)=CONSYMAT(J+1)
                  CONDSTAT(J)=CONDSTAT(J+1)
 110           CONTINUE
            END IF
            NUMCONIAT=NUMCONIAT-1
            GOTO 119
         END IF
 120  CONTINUE



      IF (NUMCONIAT.EQ.1) THEN
         JAT=CONIAT(1)
         ISYM=CONSYMAT(1)
         JSYM=SYMNEG(ISYM)
         CALL GVSMPV (TMP,SYMMAT(1,1,JSYM),SYMVEC(1,JSYM))
         DIST=SQRT((XCOORD(JAT)-TMP(1))**2+
     +             (YCOORD(JAT)-TMP(2))**2+
     +             (ZCOORD(JAT)-TMP(3))**2)
         IF (DIST.GT.CUTOFF) NUMCONIAT=0
      END IF



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE FCONREC

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'CNTINC.INC'
      INTEGER       IAT, I, J, IAA
      LOGICAL       FCONREH, REH







      IF (NUMCONIAT.LE.0) GOTO 998



      DO 20 I=NUMCONIAT,1,-1
         IAT=CONIAT(I)
         IAA=ATIAA(IAT)
         REH=FCONREH(IAT)
         IF (REH) THEN
            IF (I.LT.NUMCONIAT) THEN
               DO 10 J=I,NUMCONIAT-1
                  CONIAT(J)=CONIAT(J+1)
                  CONSYMAT(J)=CONSYMAT(J+1)
                  CONDSTAT(J)=CONDSTAT(J+1)
 10            CONTINUE
            END IF
            NUMCONIAT=NUMCONIAT-1
         END IF
 20   CONTINUE
      IF (NUMCONIAT.GE.1) CALL ION_SET_JR



  998 CONTINUE


      RETURN
      END   
      LOGICAL FUNCTION FCONREH(IAT)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'CNTINC.INC'
      INTEGER       IAT, JAT, ELMJ, ELMZ, I, IAA, JAA
      LOGICAL       AREBOUND







      FCONREH=.FALSE.
      IAA=ATIAA(IAT)



      ELMJ=ELMZ(IAT)
      IF (ELMJ.EQ.7.OR.ELMJ.EQ.8.OR.ELMJ.EQ.16) GOTO 998



      DO 10 I=1,NUMCONIAT
         JAT=CONIAT(I)
         JAA=ATIAA(JAT)
         ELMJ=ELMZ(JAT)
         IF (JAT.EQ.IAT) GOTO 10
         IF (.NOT.AREBOUND(IAT,JAT)) GOTO 10
         IF (ELMJ.NE.7.AND.ELMJ.NE.8.AND.ELMJ.NE.16) GOTO 10
         FCONREH=.TRUE.
         GOTO 998
 10   CONTINUE



  998 CONTINUE


      RETURN
      END   
