1      logical function argos_prep_removw(ir,xr,
2     + xw,vw,mwm,mwa,nwm,nwa,xwc,vwc,mwmc,nwmc,xs,msa,nsa)
3c
4c $Id$
5c
6      implicit none
7c
8      integer ir
9      real*8 xr(3,2)
10      integer mwa,mwm,nwa,nwm,mwmc,nwmc,msa,nsa
11      real*8 xw(3,mwa,mwm),xwc(3,mwa,mwmc)
12      real*8 vw(3,mwa,mwm),vwc(3,mwa,mwmc)
13      real*8 xs(3,msa)
14c
15      integer i,j,k,l,idel,new
16      real*8 x2,d2
17c
18      write(*,1000)
19 1000 format(/,' Removing selected solvent')
20c
21      if(ir.eq.0) then
22      do 1 i=1,3
23      if(xr(i,1).lt.xr(i,2)) then
24      new=0
25      do 2 k=1,nwm
26      do 3 j=1,nwa
27      if(xw(i,j,k).lt.xr(i,1)) goto 2
28      if(xw(i,j,k).gt.xr(i,2)) goto 2
29    3 continue
30      new=new+1
31      do 4 l=1,3
32      do 5 j=1,nwa
33      xw(l,j,new)=xw(l,j,k)
34      vw(l,j,new)=vw(l,j,k)
35    5 continue
36    4 continue
37    2 continue
38      nwm=new
39      new=0
40      do 6 k=1,nwmc
41      do 7 j=1,nwa
42      if(xwc(i,j,k).lt.xr(i,1)) goto 6
43      if(xwc(i,j,k).gt.xr(i,2)) goto 6
44    7 continue
45      new=new+1
46      do 8 l=1,3
47      do 9 j=1,nwa
48      xwc(l,j,new)=xwc(l,j,k)
49      vwc(l,j,new)=vwc(l,j,k)
50    9 continue
51    8 continue
52    6 continue
53      nwmc=new
54      endif
55    1 continue
56      elseif(ir.eq.1) then
57      new=0
58      do 10 j=1,nwm
59      idel=0
60      do 11 i=1,3
61      if(xr(i,1).lt.xr(i,2)) then
62      do 12 k=1,nwa
63      if(xw(i,k,j).gt.xr(i,1).and.xw(i,k,j).lt.xr(i,2)) idel=idel+1
64   12 continue
65      else
66      idel=idel+nwa
67      endif
68   11 continue
69      if(idel.ne.3*nwa) then
70      new=new+1
71      do 13 l=1,3
72      do 14 k=1,nwa
73      xw(l,k,new)=xw(l,k,j)
74      vw(l,k,new)=vw(l,k,j)
75   14 continue
76   13 continue
77      endif
78   10 continue
79      nwm=new
80      new=0
81      do 15 j=1,nwmc
82      idel=0
83      do 16 i=1,3
84      if(xr(i,1).lt.xr(i,2)) then
85      do 17 k=1,nwa
86      if(xwc(i,k,j).gt.xr(i,1).and.xwc(i,k,j).lt.xr(i,2)) idel=idel+1
87   17 continue
88      else
89      idel=idel+nwa
90      endif
91   16 continue
92      if(idel.ne.3*nwa) then
93      new=new+1
94      do 18 l=1,3
95      do 19 k=1,nwa
96      xwc(l,k,new)=xwc(l,k,j)
97      vwc(l,k,new)=vwc(l,k,j)
98   19 continue
99   18 continue
100      endif
101   15 continue
102      nwmc=new
103      elseif(ir.eq.2) then
104      new=0
105      x2=xr(1,1)**2
106      do 20 j=1,nwm
107      idel=1
108      do 21 k=1,nwa
109      do 22 i=1,nsa
110      d2=(xs(1,i)-xw(1,k,j))**2+(xs(2,i)-xw(2,k,j))**2+
111     + (xs(3,i)-xw(3,k,j))**2
112      if(d2.lt.x2) then
113      idel=0
114      goto 23
115      endif
116   22 continue
117   21 continue
118   23 continue
119      if(idel.eq.0) then
120      new=new+1
121      do 24 k=1,nwa
122      xw(1,k,new)=xw(1,k,j)
123      xw(2,k,new)=xw(2,k,j)
124      xw(3,k,new)=xw(3,k,j)
125      vw(1,k,new)=vw(1,k,j)
126      vw(2,k,new)=vw(2,k,j)
127      vw(3,k,new)=vw(3,k,j)
128   24 continue
129      endif
130   20 continue
131      nwm=new
132      new=0
133      do 25 j=1,nwmc
134      idel=1
135      do 26 k=1,nwa
136      do 27 i=1,nsa
137      d2=(xs(1,i)-xwc(1,k,j))**2+(xs(2,i)-xwc(2,k,j))**2+
138     + (xs(3,i)-xwc(3,k,j))**2
139      if(d2.lt.x2) then
140      idel=0
141      goto 28
142      endif
143   27 continue
144   26 continue
145   28 continue
146      if(idel.eq.0) then
147      new=new+1
148      do 29 k=1,nwa
149      xwc(1,k,new)=xwc(1,k,j)
150      xwc(2,k,new)=xwc(2,k,j)
151      xwc(3,k,new)=xwc(3,k,j)
152      vwc(1,k,new)=vwc(1,k,j)
153      vwc(2,k,new)=vwc(2,k,j)
154      vwc(3,k,new)=vwc(3,k,j)
155   29 continue
156      endif
157   25 continue
158      nwmc=new
159      endif
160c
161      argos_prep_removw=.true.
162c
163      return
164      end
165
166