C
C $Id: dovir.F,v 1.6 1999/04/06 20:42:45 arjan Exp arjan $
C
C------------------------------------------------------------------------
      SUBROUTINE DOVIR(VIRIAL,GRAD1)

      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
#include "divcon.dim"
#include "divcon.h"

      DIMENSION GRAD1(*),virial(*),virial1(4)


CC-------------------------------------------------------------------CC

C     calculate the virial
c      call etimer(t1v)
       do i=1,4
      virial(i) = 0.0
       enddo
c      do ires=1,nres
c         x = 0.0
c         y = 0.0
c         z = 0.0
c         i1 = irpnt(ires)
c         i2 = irpnt(ires+1)-1
c         do i=i1,i2
c            i3 = 3*i
c            x = x + grad1(i3-2)
c            y = y + grad1(i3-1)
c            z = z + grad1(i3)

    
c         enddo

c         virial(1) = virial(1)+gc(1,ires)*x
c         virial(2) = virial(2)+gc(2,ires)*y
c         virial(3) = virial(3)+gc(3,ires)*z
c         virial(4) = virial(4)+gc(1,ires)*x+gc(2,ires)*y+gc(3,ires)*z
c      enddo

c      do i=1,4
c      virial(i) = -0.333333333333333333*virial(i)
c      enddo

c      call etimer(t2v)
c      tvir = t2v-t1v+tgrad


   
              
c                 ii=-3
c               do i=1,natoms
c                   ii=ii+3
c                virial1(1)=virial1(1)-xyz(1,i)*grad1(ii+1)
c                virial1(2)=virial1(2)-xyz(2,i)*grad1(ii+2)
c                virial1(3)=virial1(3)-xyz(3,i)*grad1(ii+3)
c               enddo

c           virial1(4)=virial1(1)+virial1(2)+virial1(3)


c       write(*,*)virial1(1),virial1(2),virial1(3),virial1(4)
c       write(*,*)virial(1),virial(2),virial(3),virial(4)


         do i=2,natoms
            
          do j=1,i-1
             call pbc xyz(i,j,xj,yj,zj)
c               write(*,*)j
c                write(*,*)xyz(1,j),xyz(2,j),xyz(3,j)
c                write(*,*)xj,yj,zj
c        virial(1)=virial(1)+fxij(i,j)*(xyz(1,i)-xj) 
c        virial(2)=virial(2)+fyij(i,j)*(xyz(2,i)-yj)
c        virial(3)=virial(3)+fzij(i,j)*(xyz(3,i)-zj)         


            
          enddo

         enddo
c            virial(1)=virial(1)
c            virial(2)=virial(2)
c            virial(3)=virial(3)
         virial(4)=virial(1)+virial(2)+virial(3) 

      END