1      subroutine argos_space_lbbl_ind(lbbl,ipl,jpl)
2c
3      implicit none
4c
5#include "argos_space_common.fh"
6#include "global.fh"
7c
8      integer lbbl(mbbl,mbb2),ipl(mbox,mip2),jpl(mbox,mip2)
9c
10      integer ibbl,jproc,jcell,icell,jcproc,jccell,iccell
11      integer i,j,indx,jndx,il,ih,jl,jh,indexw,indexs,nndexw,nndexs
12      character*80 string
13c
14      jcproc=-1
15      jccell=-1
16      iccell=-1
17      indexw=nwmloc+1
18      indexs=nsaloc+1
19      nndexw=indexw
20      nndexs=indexs
21c
22c      if(iand(idebug,16).eq.16) then
23c      write(lfndbg,3000) ((lbbl(ibbl,i),i=1,3),ibbl=1,nbbl)
24c 3000 format(3i5)
25c      endif
26      do 1 ibbl=1,nbbl
27c
28      jproc=lbbl(ibbl,1)
29      jcell=lbbl(ibbl,2)
30      icell=lbbl(ibbl,3)
31      lbbl(ibbl, 5)=0
32      lbbl(ibbl, 6)=0
33      if(iand(idebug,16).eq.16) then
34      write(lfndbg,222) ibbl,nbbl,jproc,jcell,icell,jccell,iccell
35  222 format(7i5)
36      endif
37      do 234 j=1,3
38  234 continue
39c
40c     get indices for icell on the local node
41c
42      if(iccell.ne.icell) then
43      indx=0
44      do 2 i=1,ipl(1,1)
45      if(ipl(30+i,1).eq.icell) indx=30+i
46    2 continue
47      if(indx.eq.0) then
48      do 232 j=1,3
49  232 continue
50      write(*,1000) me,(ipl(30+i,1),i=1,ipl(1,1))
51 1000 format(/,'Cells on proc',i5,' :',t20,20i5,/,(t20,20i5))
52      write(string,1001) icell,me
53 1001 format('SP0001: Could not find icell',i5,' on proc',i5)
54      call md_abort(string,0)
55      endif
56      iccell=icell
57      endif
58      lbbl(ibbl, 7)=ipl(indx,2)
59      lbbl(ibbl, 8)=ipl(indx,3)
60      lbbl(ibbl, 9)=ipl(indx,4)
61      lbbl(ibbl,10)=ipl(indx,5)
62c
63c     get indices for jcell if on the local node
64c
65      if(jproc.eq.me) then
66c
67      if(jccell.ne.jcell) then
68      jndx=0
69      do 3 i=1,ipl(1,1)
70      if(ipl(30+i,1).eq.jcell) jndx=30+i
71    3 continue
72      if(jndx.eq.0) then
73      write(*,1000) me,(ipl(30+i,1),i=1,ipl(1,1))
74      write(string,1002) jcell,me
75 1002 format('SP0001: Could not find jcell',i5,' on proc',i5)
76      call md_abort(string,0)
77      endif
78      jccell=jcell
79      endif
80      lbbl(ibbl,11)=ipl(jndx,2)
81      lbbl(ibbl,12)=ipl(jndx,3)
82      lbbl(ibbl,13)=ipl(jndx,4)
83      lbbl(ibbl,14)=ipl(jndx,5)
84c
85c     get indices for jcell if on the remote node
86c
87      else
88c
89      if(jproc.ne.jcproc) then
90      call ga_distribution(ga_ip,jproc,il,ih,jl,jh)
91      call ga_get(ga_ip,il,ih,jl,jh,jpl,mbox)
92      jcproc=jproc
93      endif
94c
95      if(jcell.ne.jccell) then
96      jndx=0
97      do 4 i=1,jpl(1,1)
98      if(jpl(30+i,1).eq.jcell) jndx=30+i
99    4 continue
100      if(jndx.eq.0) then
101      if(iand(idebug,16).eq.16) then
102      write(lfndbg,1003) jcell,jproc
103 1003 format('Could not find cell',i5,' on proc',i5,
104     + ' in argos_space_lbbl')
105      write(lfndbg,1004) jproc,(jpl(30+i,1),i=1,jpl(1,1))
106 1004 format('Cell list obtained from proc',i5,' is',/,(20i5))
107      call util_flush(lfndbg)
108      endif
109c
110      write(*,1005) jproc,(jpl(30+i,1),i=1,jpl(1,1))
111 1005 format(/,'Cells on proc',i5,':',t20,20i5,/,(t20,20i5))
112      write(string,1006) jcell,jproc
113 1006 format('SP0002: Could not find remote jcell',i5,' on proc',i5)
114      call md_abort(string,me)
115      endif
116      jccell=jcell
117c
118      if(nbget.ne.0) then
119      indexw=nndexw
120      indexs=nndexs
121      if(jpl(jndx,2).gt.0) nndexw=indexw+jpl(jndx,3)-jpl(jndx,2)+1
122      if(jpl(jndx,4).gt.0) nndexs=indexs+jpl(jndx,5)-jpl(jndx,4)+1
123      endif
124c
125      endif
126c
127      lbbl(ibbl, 5)=indexw
128      lbbl(ibbl, 6)=indexs
129      lbbl(ibbl,11)=jpl(jndx,2)
130      lbbl(ibbl,12)=jpl(jndx,3)
131      lbbl(ibbl,13)=jpl(jndx,4)
132      lbbl(ibbl,14)=jpl(jndx,5)
133c
134      endif
135c
136    1 continue
137c
138      if(nndexw.gt.mwm) then
139      write(string,1007) mwm,nndexw
140 1007 format('Increase dimension mwm from ',i7,' to ',i7)
141      call md_abort(string,me)
142      endif
143      if(nndexs.gt.msa) then
144      write(string,1008) msa,nndexs
145 1008 format('Increase dimension msa from ',i7,' to ',i7)
146      call md_abort(string,me)
147      endif
148c
149      return
150      end
151c $Id$
152