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