1 subroutine argos_cafe_comb(numw,iwat,xwm,nums,isat,xs,wgt) 2c 3 implicit none 4c 5#include "argos_cafe_common.fh" 6#include "global.fh" 7#include "msgids.fh" 8c 9 integer numw,nums 10 real*8 xwm(mwm,3),ww,xs(msa,3) 11 integer iwat(msa),isat(msa) 12 real*8 wgt(mat,mset) 13c 14 integer iwm,iwa,isa 15c 16 xbm(1)=zero 17 xbm(2)=zero 18 xbm(3)=zero 19 if(numw.gt.0) then 20 ww=zero 21 do 1 iwa=1,nwa 22 ww=ww+wgt(iwat(iwa),iset) 23 1 continue 24 do 2 iwm=1,numw 25 xbm(1)=xbm(1)+ww*xwm(iwm,1) 26 xbm(2)=xbm(2)+ww*xwm(iwm,2) 27 xbm(3)=xbm(3)+ww*xwm(iwm,3) 28 2 continue 29 endif 30 if(nums.gt.0) then 31 do 3 isa=1,nums 32 ww=wgt(isat(isa),iset) 33 xbm(1)=xbm(1)+ww*xs(isa,1) 34 xbm(2)=xbm(2)+ww*xs(isa,2) 35 xbm(3)=xbm(3)+ww*xs(isa,3) 36 3 continue 37 endif 38 xbm(1)=xbm(1)/wbox 39 xbm(2)=xbm(2)/wbox 40 xbm(3)=xbm(3)/wbox 41c 42c globally accumulate box center of mass coordinates 43c 44 if(np.gt.1) call ga_dgop(mcf_37,xbm,3,'+') 45c 46 return 47 end 48c $Id$ 49