1 subroutine argos_cafe_vs 2 + (xs,ys,vs,vst,esk,nums,isat,ismol,isfrc,ishop,wsm,wgt,vsm) 3c 4 implicit none 5c 6#include "argos_cafe_common.fh" 7#include "global.fh" 8#include "msgids.fh" 9c 10 integer nums 11 integer isat(msa),ismol(msa),isfrc(msa),ishop(msa) 12 real*8 xs(msa,3),ys(msa,3),vs(msa,3),vst(msa,3) 13 real*8 wgt(mat,mset),vsm(msm,3) 14 real*8 wsm(msm) 15 real*8 esk(msf) 16c 17 integer i,j,k 18 real*8 w 19c 20 do 11 i=1,msf 21 esk(i)=zero 22 11 continue 23 if(nums.gt.0) then 24 do 1 j=1,3 25 if(mdalgo.eq.1) then 26 do 2 i=1,nums 27 vst(i,j)=half*(vs(i,j)+vst(i,j)) 28 if(iand(ishop(i),1).ne.1) esk(isfrc(i))= 29 + esk(isfrc(i))+half*wgt(isat(i),iset)*vst(i,j)*vst(i,j) 30 2 continue 31 else 32 do 3 i=1,nums 33 if(iand(ishop(i),1).ne.1) esk(isfrc(i))= 34 + esk(isfrc(i))+half*wgt(isat(i),iset)*vs(i,j)*vs(i,j) 35 3 continue 36 endif 37 1 continue 38 endif 39c 40 eskc(1,1)=zero 41 eskc(2,1)=zero 42 eskc(3,1)=zero 43 eskc(1,2)=zero 44 eskc(2,2)=zero 45 eskc(3,2)=zero 46 eskc(1,3)=zero 47 eskc(2,3)=zero 48 eskc(3,3)=zero 49 do 5 i=1,msm 50 vsm(i,1)=zero 51 vsm(i,2)=zero 52 vsm(i,3)=zero 53 5 continue 54 do 4 i=1,nums 55 if(iand(ishop(i),1).ne.1) then 56 k=ismol(i) 57 w=wgt(isat(i),iset) 58 if(mdalgo.eq.1) then 59 do 6 j=1,3 60 vsm(k,j)=vsm(k,j)+w*vst(i,j) 61 6 continue 62 else 63 do 7 j=1,3 64 vsm(k,j)=vsm(k,j)+w*vs(i,j) 65 7 continue 66 endif 67 endif 68 4 continue 69 if(np.gt.1) call ga_dgop(mcf_43,vsm,3*msm,'+') 70 if(me.eq.0) then 71 do 8 i=1,nsm 72 w=half/wsm(i) 73 eskc(1,1)=eskc(1,1)+w*vsm(i,1)*vsm(i,1) 74 eskc(2,1)=eskc(2,1)+w*vsm(i,2)*vsm(i,1) 75 eskc(3,1)=eskc(3,1)+w*vsm(i,3)*vsm(i,1) 76 eskc(1,2)=eskc(1,2)+w*vsm(i,1)*vsm(i,2) 77 eskc(2,2)=eskc(2,2)+w*vsm(i,2)*vsm(i,2) 78 eskc(3,2)=eskc(3,2)+w*vsm(i,3)*vsm(i,2) 79 eskc(1,3)=eskc(1,3)+w*vsm(i,1)*vsm(i,3) 80 eskc(2,3)=eskc(2,3)+w*vsm(i,2)*vsm(i,3) 81 eskc(3,3)=eskc(3,3)+w*vsm(i,3)*vsm(i,3) 82 8 continue 83 endif 84c 85 return 86 end 87c $Id$ 88