



C













C
      REAL FUNCTION WIFDSP(IAA,JAA)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, JAA
      LOGICAL       WIFIRI







      WIFDSP=0.0



      IF (.NOT.WIFIRI(IAA)) THEN
         CALL GVSTTI ('?IAOORD',IAA)
         GOTO 998
      END IF
      IF (.NOT.WIFIRI(JAA)) THEN
         CALL GVSTTI ('?JAOORD',JAA)
         GOTO 998
      END IF
      IF (IAA.EQ.JAA) THEN
         CALL GVSTTB ('?IAISJA')
         GOTO 998
      END IF



      WIFDSP=SQRT((SPHRAD(1,IAA)-SPHRAD(1,JAA))**2+
     +            (SPHRAD(2,IAA)-SPHRAD(2,JAA))**2+
     +            (SPHRAD(3,IAA)-SPHRAD(3,JAA))**2)



  998 CONTINUE


      RETURN
      END
      REAL FUNCTION WIFDST(IAT1,IAT2)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAT1, IAT2
      LOGICAL       WIFITI







      WIFDST=0.0
      IF ((.NOT.WIFITI(IAT1)).OR.(.NOT.WIFITI(IAT2))) THEN
         WIFDST=999.9
         GOTO 998
      END IF



      WIFDST=SQRT((XCOORD(IAT1)-XCOORD(IAT2))**2+
     +            (YCOORD(IAT1)-YCOORD(IAT2))**2+
     +            (ZCOORD(IAT1)-ZCOORD(IAT2))**2)



  998 CONTINUE


      RETURN
      END

      REAL FUNCTION WIFAIJ(IAA,JAA,IERR)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'DGLOOP.INC'
      INTEGER       IAA, JAA, IERR
      REAL          ANG, GVFANG, GVFRTD, GVF360
      LOGICAL       WIFIRA







      IERR=0
      WIFAIJ=0.0



      IF ((.NOT.WIFIRA(IAA)).OR.(.NOT.WIFIRA(JAA))) THEN
         IERR=1
         GOTO 998
      END IF



      CALL GETCBETA (IAA,IERR)
      IF (IERR.NE.0) GOTO 998
      SCRRW1(1)=XCOORD(PNTAAC(IAA))-CBETA(1)
      SCRRW1(2)=YCOORD(PNTAAC(IAA))-CBETA(2)
      SCRRW1(3)=ZCOORD(PNTAAC(IAA))-CBETA(3)
      CALL GETCBETA (JAA,IERR)
      IF (IERR.NE.0) GOTO 998
      SCRRW2(1)=XCOORD(PNTAAC(JAA))-CBETA(1)
      SCRRW2(2)=YCOORD(PNTAAC(JAA))-CBETA(2)
      SCRRW2(3)=ZCOORD(PNTAAC(JAA))-CBETA(3)



      ANG=GVFANG(SCRRW1,SCRRW2)
      ANG=GVFRTD(ANG)
      ANG=GVF360(ANG)
      IF (ANG.GT.180.0) ANG=360.0-ANG
      WIFAIJ=ANG



  998 CONTINUE


      RETURN
      END   

      REAL FUNCTION WIFBBA1(IAA,IERR)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, IERR
      REAL          WIFANG
      LOGICAL       WIFIRA







      IF (.NOT.WIFIRA(IAA)) THEN
         CALL GVSTTB ('?M1492')
         CALL GVSKIL
         WIFBBA1=-999.9
         IERR=1
         GOTO 998
      END IF
      IF (.NOT.(ISATOK(PNTAAS(IAA)+0).AND.
     +          ISATOK(PNTAAS(IAA)+1).AND.
     +          ISATOK(PNTAAS(IAA)+2))) THEN
         CALL GVSTTB ('?M1977')
         CALL GVSKIL
         WIFBBA1=-999.9
         IERR=1
         GOTO 998
      END IF



      IERR=0



      WIFBBA1=WIFANG(PNTAAS(IAA)+0,PNTAAS(IAA)+1,PNTAAS(IAA)+2)



  998 CONTINUE


      RETURN
      END   
      REAL FUNCTION WIFBBA2(IAA,IERR)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, IERR
      REAL          WIFANG
      LOGICAL       WIFIRA, WIFIR3







      IF (.NOT.WIFIRA(IAA)) THEN
         CALL GVSTTB ('?M1492')
         CALL GVSKIL
         WIFBBA2=-999.9
         IERR=1
         GOTO 998
      END IF
      IF (WIFIR3(IAA)) THEN
         CALL GVSTTB ('?M1493')
         CALL GVSKIL
         WIFBBA2=-999.9
         IERR=1
         GOTO 998
      END IF



      IERR=0



      WIFBBA2=WIFANG(PNTAAS(IAA)+1,PNTAAS(IAA)+2,PNTAAS(IAA+1))



  998 CONTINUE


      RETURN
      END   
      REAL FUNCTION WIFBBA3(IAA,IERR)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, IERR
      REAL          WIFANG
      LOGICAL       WIFIRA, WIFIR3







      IF (.NOT.WIFIRA(IAA)) THEN
         CALL GVSTTB ('?M1492')
         CALL GVSKIL
         WIFBBA3=-999.9
         IERR=1
         GOTO 998
      END IF
      IF (WIFIR3(IAA)) THEN
         CALL GVSTTB ('?M1493')
         CALL GVSKIL
         WIFBBA3=-999.9
         IERR=1
         GOTO 998
      END IF



      IERR=0



      WIFBBA3=WIFANG(PNTAAS(IAA)+1,PNTAAS(IAA)+2,PNTAAS(IAA)+3)



  998 CONTINUE


      RETURN
      END   
      REAL FUNCTION WIFBBA4(IAA,IERR)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, IERR
      REAL          WIFANG
      LOGICAL       WIFIRA, WIFIR3







      IF (.NOT.WIFIRA(IAA)) THEN
         CALL GVSTTB ('?M1492')
         CALL GVSKIL
         WIFBBA4=-999.9
         IERR=1
         GOTO 998
      END IF
      IF (WIFIR3(IAA)) THEN
         CALL GVSTTB ('?M1493')
         CALL GVSKIL
         WIFBBA4=-999.9
         IERR=1
         GOTO 998
      END IF



      IERR=0



      WIFBBA4=WIFANG(PNTAAS(IAA)+3,PNTAAS(IAA)+2,PNTAAS(IAA+1))



  998 CONTINUE


      RETURN
      END   
      REAL FUNCTION WIFANG(IAT1,IAT2,IAT3)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAT1, IAT2, IAT3
      REAL          V1(3), V2(3), GVFANG, GVFRTD







      WIFANG=0.0



      IF (IAT1.EQ.IAT2.OR.IAT2.EQ.IAT3.OR.IAT3.EQ.IAT1) THEN
         CALL GVSTTE ('?WRATAN')
         CALL GVSTTI3 ('?M1307',IAT1,IAT2,IAT3)
         CALL DIF031 (6,IAT1,IAT2,IAT3)
         CALL GVSKIL
         GOTO 998
      END IF



      V1(1)=XCOORD(IAT1)-XCOORD(IAT2)
      V1(2)=YCOORD(IAT1)-YCOORD(IAT2)
      V1(3)=ZCOORD(IAT1)-ZCOORD(IAT2)
      V2(1)=XCOORD(IAT3)-XCOORD(IAT2)
      V2(2)=YCOORD(IAT3)-YCOORD(IAT2)
      V2(3)=ZCOORD(IAT3)-ZCOORD(IAT2)



      WIFANG=GVFRTD(GVFANG(V1,V2))



  998 CONTINUE


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



























      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAT1, IAT2, IAT3, IAT4, I
      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) THEN
         CALL GVSTTE ('?CHIB01')
         IF (WIFPAR(1012).NE.0) THEN
            PRINT*,'NUMATF :',NUMATF
            PRINT*,'4 ATOMS:',IAT1,IAT2,IAT3,IAT4
            CALL DIF015 (6,'?M1425',IAT1)
            CALL DIF015 (6,'?M1426',IAT2)
            CALL DIF015 (6,'?M1427',IAT3)
            CALL DIF015 (6,'?M1428',IAT4)
            CALL SHOIAA (ATIAA(IAT1))
            IF (ATIAA(IAT2).NE.ATIAA(IAT1).OR.
     +          ATIAA(IAT3).NE.ATIAA(IAT1).OR.
     +          ATIAA(IAT4).NE.ATIAA(IAT1)) THEN
               CALL SHOIAA (ATIAA(IAT2))
               CALL SHOIAA (ATIAA(IAT3))
               CALL SHOIAA (ATIAA(IAT4))
            END IF
         END IF
         CHI001=0.0
         CALL GVSKIL
         GOTO 998
      END IF
      IF ((.NOT.ISATOK(IAT1)).OR.
     +    (.NOT.ISATOK(IAT2)).OR.
     +    (.NOT.ISATOK(IAT3)).OR.
     +    (.NOT.ISATOK(IAT4))) THEN
         CHI001=GVFDTR(999.9)
         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
         CALL GVSTTE ('?M1057')
         IF (WIFPAR(1012).NE.0) THEN
            CALL SHOSOU
            CALL DIF015 (6,'IAT1=',IAT1)
            CALL DIF015 (6,'IAT2=',IAT2)
            CALL DIF015 (6,'IAT3=',IAT3)
            CALL DIF015 (6,'IAT4=',IAT4)
            PRINT*,'ISATOKS:',ISATOK(IAT1),ISATOK(IAT2),
     +       ISATOK(IAT3),ISATOK(IAT4)
            CALL GVSTTR3 ('1:',XCOORD(IAT1),YCOORD(IAT1),ZCOORD(IAT1))
            CALL GVSTTR3 ('2:',XCOORD(IAT2),YCOORD(IAT2),ZCOORD(IAT2))
            CALL GVSTTR3 ('3:',XCOORD(IAT3),YCOORD(IAT3),ZCOORD(IAT3))
            CALL GVSTTR3 ('4:',XCOORD(IAT4),YCOORD(IAT4),ZCOORD(IAT4))
            CALL GVSKIL
         END IF
         CHI001=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
         CALL GVSTTE ('?R00303')
         CHI001=0.0
         IF (WIFPAR(1012).NE.0) THEN
            CALL SHOSOU
            CALL SHOIAA (ATIAA(IAT1))
            CALL DIF015 (6,'IAT1=',IAT1)
            CALL DIF015 (6,'IAT2=',IAT2)
            CALL DIF015 (6,'IAT3=',IAT3)
            CALL DIF015 (6,'IAT4=',IAT4)
            PRINT*,'ISATOKS:',ISATOK(IAT1),ISATOK(IAT2),
     +       ISATOK(IAT3),ISATOK(IAT4)
            CALL GVSTTR3 ('1:',XCOORD(IAT1),YCOORD(IAT1),ZCOORD(IAT1))
            CALL GVSTTR3 ('2:',XCOORD(IAT2),YCOORD(IAT2),ZCOORD(IAT2))
            CALL GVSTTR3 ('3:',XCOORD(IAT3),YCOORD(IAT3),ZCOORD(IAT3))
            CALL GVSTTR3 ('4:',XCOORD(IAT4),YCOORD(IAT4),ZCOORD(IAT4))
         END IF
         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)
      CHI001=TEMP



  998 CONTINUE


      RETURN
      END
      SUBROUTINE CHI002 (X,Y,Z,ZL)























      IMPLICIT      NONE
      REAL          X(3), Y(3), Z(3), ZZ(3), ZL
      INTEGER       I







      ZZ(1)=X(2)*Y(3)-X(3)*Y(2)
      ZZ(2)=X(3)*Y(1)-X(1)*Y(3)
      ZZ(3)=X(1)*Y(2)-X(2)*Y(1)
      ZL=ZZ(1)*ZZ(1)+ZZ(2)*ZZ(2)+ZZ(3)*ZZ(3)
      DO 10 I = 1,3
         Z(I) = ZZ(I)
   10 CONTINUE





      RETURN
      END
      LOGICAL FUNCTION XYZNUL(IAT)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAT
      LOGICAL       WIFITI







      XYZNUL=.FALSE.



      IF (.NOT.WIFITI(IAT)) THEN
         CALL GVSTTI2 ('?M0898',IAT,NUMATF)
         XYZNUL=.TRUE.
         CALL SHOSOU
         CALL SHOIAA (ATIAA(IAT))
         CALL GVSKIL
         GOTO 998
      END IF



      IF (ABS(XCOORD(IAT)).LT.0.0001.AND.
     +    ABS(YCOORD(IAT)).LT.0.0001.AND.
     +    ABS(ZCOORD(IAT)).LT.0.0001) THEN
         XYZNUL=.TRUE.
      END IF



  998 CONTINUE


      RETURN
      END
      LOGICAL FUNCTION XYZNAL(IAT)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAT
      LOGICAL       WIFITI







      XYZNAL=.FALSE.



      IF (.NOT.WIFITI(IAT)) THEN
         CALL GVSTTI2 ('?M0898',IAT,NUMATF)
         XYZNAL=.TRUE.
         CALL SHOSOU
         CALL SHOIAA (ATIAA(IAT))
         CALL GVSKIL
         GOTO 998
      END IF



      IF (ABS(ALTX(IAT)).LT.0.0001.AND.
     +    ABS(ALTY(IAT)).LT.0.0001.AND.
     +    ABS(ALTZ(IAT)).LT.0.0001) THEN
         XYZNAL=.TRUE.
      END IF



  998 CONTINUE


      RETURN
      END
      LOGICAL FUNCTION XYZCUL(X,Y,Z)

















      IMPLICIT      NONE
      REAL          X, Y, Z







      XYZCUL=(ABS(X).LT.0.0001.AND.ABS(Y).LT.0.0001.AND.
     + ABS(Z).LT.0.0001)





      RETURN
      END
      SUBROUTINE WIFELA (IAA,XYZCEN,EV)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'VECTOR.INC'
      INTEGER       IAT, I, J, NUMUSE, IAA
      REAL          MATRIX(3,3), EV(3), EM(3,3), CENTROID(3), XYZCEN(3)







      CENTROID(1)=0.0
      CENTROID(2)=0.0
      CENTROID(3)=0.0
      MATRIX(1,1)=0.0
      MATRIX(1,2)=0.0
      MATRIX(1,3)=0.0
      MATRIX(2,1)=0.0
      MATRIX(2,2)=0.0
      MATRIX(2,3)=0.0
      MATRIX(3,1)=0.0
      MATRIX(3,2)=0.0
      MATRIX(3,3)=0.0
      EV(1)=0.0
      EV(2)=0.0
      EV(3)=0.0
      XYZCEN(1)=0.0
      XYZCEN(2)=0.0
      XYZCEN(3)=0.0



      NUMUSE=0
      DO 5 IAT=PNTAAS(IAA),PNTAAE(IAA)
         IF (ISATOK(IAT)) THEN
            NUMUSE=NUMUSE+1
            XYZCEN(1)=XYZCEN(1)+XCOORD(IAT)
            XYZCEN(2)=XYZCEN(2)+YCOORD(IAT)
            XYZCEN(3)=XYZCEN(3)+ZCOORD(IAT)
         END IF
 5    CONTINUE
      IF (NUMUSE.LE.3) GOTO 998
      DO 6 J=1,3
         XYZCEN(J)=XYZCEN(J)/FLOAT(NUMUSE)
 6    CONTINUE



      DO 30 IAT=PNTAAS(IAA),PNTAAE(IAA)
         IF (ISATOK(IAT)) THEN
            CV(1)=XCOORD(IAT)-XYZCEN(1)
            CV(2)=YCOORD(IAT)-XYZCEN(2)
            CV(3)=ZCOORD(IAT)-XYZCEN(3)
            DO 20 J=1,3
               CENTROID(J)=CENTROID(J)+CV(J)
               DO 10 I=1,3
                  MATRIX(I,J)=MATRIX(I,J)+CV(I)*CV(J)
 10            CONTINUE
 20         CONTINUE
         END IF
 30   CONTINUE



      DO 40 J=1,3
         CENTROID(J)=CENTROID(J)/FLOAT(NUMUSE)
   40 CONTINUE
      DO 60 J=1,3
         DO 50 I=1,3
            MATRIX(I,J)=MATRIX(I,J)/FLOAT(NUMUSE) -
     +       CENTROID(I)*CENTROID(J)
   50    CONTINUE
   60 CONTINUE



      CALL GVSEIG2 (3,MATRIX,EV,EM)
      EV(1)=SQRT(EV(1))*2.236+1.8
      EV(2)=SQRT(EV(2))*2.236+1.8
      EV(3)=SQRT(EV(3))*2.236+1.8



  998 CONTINUE


      RETURN
      END

      REAL FUNCTION WIFPL4(IAT1,IAT2,IAT3,IAT4)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAT1, IAT2, IAT3, IAT4
      REAL          LOCXYZ(3,4), A, B, C, D, RMS







      IF ((.NOT.ISATOK(IAT1)).OR.(.NOT.ISATOK(IAT2)).OR.
     +    (.NOT.ISATOK(IAT3)).OR.(.NOT.ISATOK(IAT2))) THEN
         WIFPL4=999.9
         GOTO 998
      END IF



      LOCXYZ(1,1)=XCOORD(IAT1)
      LOCXYZ(2,1)=YCOORD(IAT1)
      LOCXYZ(3,1)=ZCOORD(IAT1)
      LOCXYZ(1,2)=XCOORD(IAT2)
      LOCXYZ(2,2)=YCOORD(IAT2)
      LOCXYZ(3,2)=ZCOORD(IAT2)
      LOCXYZ(1,3)=XCOORD(IAT3)
      LOCXYZ(2,3)=YCOORD(IAT3)
      LOCXYZ(3,3)=ZCOORD(IAT3)
      LOCXYZ(1,4)=XCOORD(IAT4)
      LOCXYZ(2,4)=YCOORD(IAT4)
      LOCXYZ(3,4)=ZCOORD(IAT4)



      CALL PLN004 (LOCXYZ,4,A,B,C,D,RMS)
      WIFPL4=RMS



  998 CONTINUE


      RETURN
      END   
