1 subroutine argos_space_initf(fw,fs,llng,iwz,isz,lpair) 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 integer iwz(mwm),isz(msa) 11 logical llng,lpair 12c 13 integer i,j,k,l,m,il,ih,jl,jh 14c 15 llong=llng 16c 17 m=1 18 if(llong) m=2 19c 20 do 1 l=1,m 21 if(nwm.gt.0) then 22 do 2 k=1,mwa 23 do 3 j=1,3 24 do 4 i=1,mwm 25 fw(i,j,k,l)=zero 26 4 continue 27 3 continue 28 2 continue 29 endif 30 if(nsa.gt.0) then 31 do 5 j=1,3 32 do 6 i=1,msa 33 fs(i,j,l)=zero 34 6 continue 35 5 continue 36 endif 37 1 continue 38c 39 if(nwm.gt.0) then 40 call ga_distribution(ga_w,me,il,ih,jl,jh) 41 call ga_put(ga_w,il,ih,jl+6*mwa+3,jl+9*mwa+2,fw,mwm) 42 if(llong) call ga_put(ga_w,il,ih,jl+9*mwa+3,jl+12*mwa+2, 43 + fw(1,1,1,2),mwm) 44 endif 45 if(nsa.gt.0) then 46 call ga_distribution(ga_s,me,il,ih,jl,jh) 47 call ga_put(ga_s,il,ih,jl+6,jl+8,fs,msa) 48 if(llong) call ga_put(ga_s,il,ih,jl+9,jl+11,fs(1,1,2),msa) 49 endif 50c 51 if(lpair) then 52 do 7 i=1,mwm 53 iwz(i)=0 54 7 continue 55 do 8 i=1,msa 56 isz(i)=0 57 8 continue 58 call ga_zero(ga_iwz) 59 call ga_zero(ga_isz) 60 endif 61c 62 return 63 end 64c $Id$ 65