1      subroutine argos_space_acfbl(ibbl,lhandl,fw,fs,lbbl,jpl,
2     + lpair,iwz,isz)
3c
4      implicit none
5c
6#include "argos_space_common.fh"
7#include "global.fh"
8c
9      integer ibbl,lhandl
10      real*8 fw(mwm,3,mwa,2),fs(msa,3,2)
11      integer lbbl(mbbl,mbb2)
12      integer jpl(mbox,mip2)
13      logical lpair
14      integer iwz(mwm),isz(msa)
15c
16      integer i,j,k,l,m,ibox,jbox,jnode,il,ih,jl,jh,ndx,nwnon,nsnon
17      integer jwfr,jwto,jsfr,jsto
18c
19      if(ibbl.le.0.or.ibbl.gt.nbbl)
20     + call md_abort('Index to lbbl out of range',ibbl)
21c
22      jnode=lbbl(ibbl,1)
23      jbox=lbbl(ibbl,2)
24      ibox=lbbl(ibbl,3)
25      lbbl(ibbl,4)=lhandl
26c
27      if(jnode.eq.me) return
28      if(ibbl.lt.nbbl) then
29      if(lbbl(ibbl+1,1).eq.jnode.and.lbbl(ibbl+1,2).eq.jbox) return
30      endif
31c
32      ndx=0
33      do 3 i=1,jpl(1,1)
34      if(jpl(30+i,1).eq.jbox) ndx=30+i
35    3 continue
36      if(ndx.eq.0)
37     + call md_abort('Remote processor cell not found (2) ',0)
38      jwfr=jpl(ndx,2)
39      jwto=jpl(ndx,3)
40      jsfr=jpl(ndx,4)
41      jsto=jpl(ndx,5)
42      if(jwfr.gt.0) then
43      nwnon=jwto-jwfr+1
44      if(nwmloc+nwnon.gt.mwm)
45     + call md_abort('Dimension mwm too small',nwmloc+nwnon)
46      call ga_distribution(ga_w,jnode,il,ih,jl,jh)
47      call ga_acc(ga_w,il+jwfr-1,il+jwto-1,jl+6*mwa+3,jl+9*mwa+2,
48     + fw(nwmloc+1,1,1,1),mwm,one)
49      if(llong) call ga_acc(ga_w,il+jwfr-1,il+jwto-1,jl+9*mwa+3,
50     + jl+12*mwa+2,fw(nwmloc+1,1,1,2),mwm,one)
51      if(lpair) then
52      call ga_distribution(ga_iwz,jnode,il,ih,jl,jh)
53      call ga_acc(ga_iwz,il+jwfr-1,il+jwto-1,jl,jl,iwz(nwmloc+1),mwm,1)
54      endif
55      endif
56      if(jsfr.gt.0) then
57      nsnon=jsto-jsfr+1
58      if(nsaloc+nsnon.gt.msa)
59     + call md_abort('Dimension msa too small (5)',nsaloc+nsnon)
60      call ga_distribution(ga_s,jnode,il,ih,jl,jh)
61      call ga_acc(ga_s,il+jsfr-1,il+jsto-1,jl+6,jl+8,
62     + fs(nsaloc+1,1,1),msa,one)
63      if(llong) call ga_acc(ga_s,il+jsfr-1,il+jsto-1,jl+9,jl+11,
64     + fs(nsaloc+1,1,2),msa,one)
65      if(lpair) then
66      call ga_distribution(ga_isz,jnode,il,ih,jl,jh)
67      call ga_acc(ga_isz,il+jsfr-1,il+jsto-1,jl,jl,isz(nsaloc+1),msa,1)
68      endif
69      endif
70c
71      m=1
72      if(llong) m=2
73c
74      do 9 l=1,m
75      do 4 k=1,mwa
76      do 5 j=1,3
77      do 6 i=nwmloc+1,mwm
78      fw(i,j,k,l)=zero
79    6 continue
80    5 continue
81    4 continue
82c
83      do 7 j=1,3
84      do 8 i=nsaloc+1,msa
85      fs(i,j,l)=zero
86    8 continue
87    7 continue
88    9 continue
89c
90      do 10 i=nwmloc+1,mwm
91      iwz(i)=0
92   10 continue
93      do 11 i=nsaloc+1,msa
94      isz(i)=0
95   11 continue
96c
97      return
98      end
99c $Id$
100