1 subroutine argos_space_final(fw,fs,lpair,iwz,isz) 2c 3 implicit none 4c 5#include "argos_space_common.fh" 6#include "mafdecls.fh" 7#include "global.fh" 8c 9 real*8 fw(mwm,3,mwa,2),fs(msa,3,2) 10 logical lpair 11 integer iwz(mwm),isz(msa) 12c 13 integer i,il,ih,jl,jh 14c 15 if(np.gt.0) then 16 if(nwm.gt.0) then 17 call ga_distribution(ga_w,me,il,ih,jl,jh) 18 call ga_acc(ga_w,il,ih,jl+6*mwa+3,jl+9*mwa+2,fw,mwm,one) 19 if(llong) call ga_acc(ga_w,il,ih,jl+9*mwa+3,jl+12*mwa+2, 20 + fw(1,1,1,2),mwm,one) 21 call ga_get(ga_w,il,ih,jl+6*mwa+3,jl+9*mwa+2,fw,mwm) 22 if(ltwin) call ga_get(ga_w,il,ih,jl+9*mwa+3,jl+12*mwa+2, 23 + fw(1,1,1,2),mwm) 24 endif 25 if(nsa.gt.0) then 26 call ga_distribution(ga_s,me,il,ih,jl,jh) 27 call ga_acc(ga_s,il,ih,jl+6,jl+8,fs,msa,one) 28 if(llong) call ga_acc(ga_s,il,ih,jl+9,jl+11,fs(1,1,2),msa,one) 29 call ga_get(ga_s,il,ih,jl+6,jl+8,fs,msa) 30 if(ltwin) call ga_get(ga_s,il,ih,jl+9,jl+11,fs(1,1,2),msa) 31 endif 32 endif 33c 34 if(lpair) then 35 if(nwm.gt.0) then 36 call ga_distribution(ga_iwz,me,il,ih,jl,jh) 37 call ga_acc(ga_iwz,il,ih,1,1,iwz,mwm,1) 38 call ga_get(ga_iwz,il,ih,1,1,iwz,mwm) 39 do 1 i=1,nwmloc 40 iwz(i)=min(1,iwz(i)) 41 1 continue 42 endif 43 if(nsa.gt.0) then 44 call ga_distribution(ga_isz,me,il,ih,jl,jh) 45 call ga_acc(ga_isz,il,ih,1,1,isz,msa,1) 46 call ga_get(ga_isz,il,ih,1,1,isz,msa) 47 do 2 i=1,nsaloc 48 isz(i)=min(1,isz(i)) 49 2 continue 50 endif 51 endif 52c 53 return 54 end 55c $Id$ 56