1 logical function argos_prepare_atype(lfnout,lfnpar, 2 + latm,catm,matm,lbnd,mbnd,nbnd, 3 + jlo,ilo,ihi,jhi,ltyp,mtyp,lring,aring,mring, 4 + nring3,nring4,nring5,nring6, 5 + latmt,matmt,natmt,lbndt,mbndt,nbndt) 6c 7c $Id$ 8c 9 implicit none 10c 11#include "util.fh" 12#include "mafdecls.fh" 13#include "argos_prepare_common.fh" 14c 15c in : lfnpar = atom types file number 16c filtyp = atom types file name 17c latm(2,matm) = atomic number 18c 3 = number of bonds 19c 4 = center type 20c catm(1,matm) = atom name 21c 2 = atom name (corrected) 22c matm = dimension atom list 23c natm = length atom list 24c lbnd(1:2,mbnd) = bond indices 25c mbnd = dimension bond list 26c nbnd = length bond list 27c lring(1:6,mring) = ring indices 28c aring(mring) = logical true if aromatic ring 29c 30c out : catm(3,matm) = atom type 31c ltyp(1,mtyp) = saturation 32c 2 = aliphatic ring 33c 3 = aromatic ring 34c 4 = number of hydrogen neigbors 35c 5 = number of neighbors 36c 5+i = index of i-th neighbor 37c 38 integer maty 39 parameter (maty=1000) 40c 41 integer lfnpar,lfnout 42 character*255 filnam 43 integer matm,matmt,mtyp,natmt 44 integer latm(5,matm),latmt(5,matmt) 45 character*6 catm(3,matm) 46 integer mbnd,nbnd,mbndt,nbndt 47 integer lbnd(2,mbnd),lbndt(2,mbndt) 48 integer jlo,ilo,ihi,jhi 49 integer ltyp(15,jlo:jlo+mtyp-1) 50 integer mring,nring3,nring4,nring5,nring6 51 integer lring(6,mring) 52 logical aring(mring) 53c 54 integer i,j,k,kk,l,ll,m,ntype,lt,ld,nadd,len 55 character*4 atype(maty) 56 integer itype(20,maty) 57 character*100 card 58 integer iatnum,nhydr,nonh,irng,ifr,ito 59 logical skipa(5),skipt(5),skipaa(5),skiptt(5) 60c 61c setup typ array with latm data 62c ------------------------------ 63c 64 do 101 i=1,mtyp 65 do 102 j=1,5 66 ltyp(j,i)=0 67 102 continue 68 101 continue 69c 70 do 1 i=jlo,jhi 71 ltyp(1,i)=latm(2,i) 72 1 continue 73c 74c find index for each neighbor 75c ---------------------------- 76c 77 do 2 i=1,nbnd 78 if(lbnd(1,i).ge.jlo.and.lbnd(1,i).le.jhi) then 79 ltyp(5,lbnd(1,i))=ltyp(5,lbnd(1,i))+1 80 ltyp(5+ltyp(5,lbnd(1,i)),lbnd(1,i))=lbnd(2,i) 81 if(latm(2,lbnd(2,i)).eq.1) ltyp(4,lbnd(1,i))=ltyp(4,lbnd(1,i))+1 82 endif 83 if(lbnd(2,i).ge.jlo.and.lbnd(2,i).le.jhi) then 84 ltyp(5,lbnd(2,i))=ltyp(5,lbnd(2,i))+1 85 ltyp(5+ltyp(5,lbnd(2,i)),lbnd(2,i))=lbnd(1,i) 86 if(latm(2,lbnd(1,i)).eq.1) ltyp(4,lbnd(2,i))=ltyp(4,lbnd(2,i))+1 87 endif 88 2 continue 89c 90 ntype=jhi 91 ifr=jlo 92 ito=jhi 93c 94 do 103 i=ifr,ito 95 if(latm(1,i).gt.0) then 96 ntype=ntype+1 97 ltyp(5,i)=ltyp(5,i)+1 98 ltyp(5+ltyp(5,i),i)=ntype 99 ltyp(1,ntype)=latmt(2,latm(1,i)) 100 latm(2,ntype)=latmt(2,latm(1,i)) 101 nadd=0 102 do 104 j=1,nbndt 103 if(lbndt(1,j).eq.latm(1,i)) then 104 nadd=nadd+1 105 ltyp(5,ntype)=ltyp(5,ntype)+1 106 ltyp(5+ltyp(5,ntype),ntype)=ntype+nadd 107 ltyp(1,ntype+nadd)=latmt(2,lbndt(2,j)) 108 latm(2,ntype+nadd)=latmt(2,lbndt(2,j)) 109 if(latmt(2,lbndt(2,j)).eq.1) ltyp(4,ntype)=ltyp(4,ntype)+1 110 elseif(lbndt(2,j).eq.latm(1,i)) then 111 nadd=nadd+1 112 ltyp(5,ntype)=ltyp(5,ntype)+1 113 ltyp(5+ltyp(5,ntype),ntype)=ntype+nadd 114 ltyp(1,ntype+nadd)=latmt(2,lbndt(1,j)) 115 latm(2,ntype+nadd)=latmt(2,lbndt(1,j)) 116 if(latmt(2,lbndt(1,j)).eq.1) ltyp(4,ntype)=ltyp(4,ntype)+1 117 endif 118 104 continue 119 ntype=ntype+nadd 120 if(ltyp(1,i).eq.6.and.ltyp(5,i).eq.3.and.latm(4,i).eq.0) then 121 latm(4,i)=1 122 if(latm(5,i).eq.4) then 123 do 107 j=1,3 124 do 108 k=1,3 125 if(ltyp(1,ltyp(5+j,i)).eq.7.and.ltyp(1,ltyp(5+k,i)).eq.8) 126 + latm(5,i)=2 127 108 continue 128 107 continue 129 endif 130 endif 131 if(ltyp(1,i).eq.7.and.ltyp(5,i).eq.3.and.latm(4,i).eq.0) then 132 do 105 j=1,3 133 if(ltyp(1,ltyp(5+j,i)).eq.6.and.ltyp(5,ltyp(5+j,i)).eq.3) then 134 do 106 k=1,3 135 if(ltyp(1,ltyp(5+k,ltyp(5+j,i))).eq.8) then 136 latm(4,i)=1 137 if(latm(5,i).eq.3) latm(5,i)=1 138 endif 139 106 continue 140 endif 141 105 continue 142 endif 143 endif 144 103 continue 145c 146c order each neighbor list 147c ------------------------ 148c 149 do 3 i=jlo,jhi 150 do 4 j=1,ltyp(5,i)-1 151 do 5 k=j+1,ltyp(5,i) 152 if(ltyp(5+j,i).gt.ltyp(5+k,i)) then 153 l=ltyp(5+j,i) 154 ltyp(5+j,i)=ltyp(5+k,i) 155 ltyp(5+k,i)=l 156 endif 157 5 continue 158 4 continue 159 3 continue 160c 161c saturation 162c ---------- 163c 164c C sp2 : 3 165c C in C=O : 2 166c N sp2 : 3 167c O in =O : 2 168c 169 do 6 i=jlo,jhi 170 ltyp(1,i)=0 171 if(latm(2,i).eq.6.and.ltyp(5,i).eq.3) then 172 ltyp(1,i)=3 173 do 7 j=1,ltyp(5,i) 174 if(latm(2,ltyp(5+j,i)).eq.8.and.ltyp(5,ltyp(5+j,i)).eq.1) then 175 ltyp(1,i)=2 176 endif 177 7 continue 178 endif 179 if(latm(2,i).eq.7.and.ltyp(5,i).eq.3) then 180 ltyp(1,i)=3 181 endif 182 if(latm(2,i).eq.8.and.ltyp(5,i).eq.1) then 183 ltyp(1,i)=2 184 endif 185 6 continue 186c 187c C=C in aromatic 6-ring with 2 sp2 N : 2 188c 189 do 8 i=nring5+1,nring6 190 if(aring(i)) then 191 k=0 192 do 9 j=1,6 193 if(latm(2,i).eq.7) k=k+1 194 9 continue 195 if(k.eq.2) then 196 do 10 j=1,nbnd 197 k=0 198 do 11 l=1,6 199 if(latm(2,lring(l,i)).eq.6) then 200 if(lbnd(1,j).eq.lring(l,i).or.lbnd(2,j).eq.lring(l,i)) k=k+1 201 endif 202 11 continue 203 if(k.eq.2) then 204 ltyp(1,lbnd(1,j))=2 205 ltyp(1,lbnd(2,j))=2 206 goto 8 207 endif 208 10 continue 209 endif 210 endif 211 8 continue 212c 213c ring types 214c ---------- 215c 216 do 40 i=1,nring3 217 do 41 j=1,3 218 if(aring(i)) then 219 ltyp(3,lring(j,i))=10*ltyp(3,lring(j,i))+3 220 else 221 ltyp(2,lring(j,i))=10*ltyp(2,lring(j,i))+3 222 endif 223 41 continue 224 40 continue 225 do 42 i=nring3+1,nring4 226 do 43 j=1,4 227 if(aring(i)) then 228 ltyp(3,lring(j,i))=10*ltyp(3,lring(j,i))+4 229 else 230 ltyp(2,lring(j,i))=10*ltyp(2,lring(j,i))+4 231 endif 232 43 continue 233 42 continue 234 do 12 i=nring4+1,nring5 235 do 13 j=1,5 236 if(aring(i)) then 237 ltyp(3,lring(j,i))=10*ltyp(3,lring(j,i))+5 238 else 239 ltyp(2,lring(j,i))=10*ltyp(2,lring(j,i))+5 240 endif 241 13 continue 242 12 continue 243 do 14 i=nring5+1,nring6 244 do 15 j=1,6 245 if(aring(i)) then 246 ltyp(3,lring(j,i))=10*ltyp(3,lring(j,i))+6 247 else 248 ltyp(2,lring(j,i))=10*ltyp(2,lring(j,i))+6 249 endif 250 15 continue 251 14 continue 252c 253 do 39 i=jlo,jhi 254 if(ltyp(1,i).eq.3) then 255 if(ltyp(3,i).eq.0) then 256 ltyp(1,i)=2 257 else 258 ltyp(1,i)=0 259 endif 260 endif 261 39 continue 262c 263c read the atom type data 264c ----------------------- 265c 266 ntype=0 267 do 900 i=1,mdirpar 268 do 901 j=1,nfilpar(i) 269 write(filnam,'(a,a)') dirpar(i)(1:index(dirpar(i),' ')-1), 270 + filpar(i,j)(1:index(filpar(i,j),' ')) 271 len=index(filnam,' ')-1 272 open(unit=lfnpar,file=filnam(1:len),status='old', 273 + form='formatted',err=901) 274 18 continue 275 read(lfnpar,1000,end=17,err=9999) card 276 if(card(1:10).ne.'Atom types') goto 18 277 if(util_print('files',print_medium)) then 278 write(lfnout,2000) filnam(1:len) 279 2000 format(' Atom type definitions',t40,a) 280 endif 281 16 continue 282 read(lfnpar,1000,end=17,err=9999) card 283 1000 format(a) 284 if(card(1:3).eq.'End') goto 17 285 if(card(1:1).eq.'#'.or.card(1:4).eq.' ') goto 16 286 ntype=ntype+1 287 if(ntype.gt.maty) call md_abort('increase maty',9999) 288 read(card,1001) atype(ntype),(itype(k,ntype),k=1,10) 289 1001 format(a4,i7,i3,2i5,i3,i7,i3,3i7) 290 read(lfnpar,1002) (itype(k,ntype),k=11,15) 291 read(lfnpar,1002) (itype(k,ntype),k=16,20) 292 1002 format(27x,i7,i3,3i7) 293 goto 16 294 17 continue 295 close(unit=lfnpar) 296 if(util_print('where',print_debug)) then 297 write(lfnout,'(a,a)') filnam(1:len),' closed' 298 endif 299 901 continue 300 900 continue 301c 302c determine the atom types 303c ------------------------ 304c 305 if(util_print('atomtypes',print_debug)) then 306 write(lfnout,3000) (i,i=1,7) 307 3000 format(///,' ATOM LIST ',//, 308 + ' 1: Atom number',/, 309 + ' 2: Atom name',/, 310 + ' 3: Atomic number',/, 311 + ' 4: Aliphatic ring',/, 312 + ' 5: Aromatic ring',/, 313 + ' 6: Number of neighboring hydrogen atoms',/, 314 + ' 7: Number of neighboring atoms',//,i5,i4,5i5,//) 315 write(lfnout,'(i5,a4,5i5)') 316 + (i,catm(2,i),(ltyp(j,i),j=1,5),i=ilo,ihi) 317 endif 318c 319 if(util_print('atomtypes',print_debug)) then 320 write(lfnout,3001) 321 3001 format(//,' ATOM TYPING',//, 322 + ' 1: Atom name',/, 323 + ' 2: Atomic number',/, 324 + ' 3: Saturation',/, 325 + ' 4: Aliphatic ring',/, 326 + ' 5: Aromatic ring',/, 327 + ' 6: Number of neighboring hydrogen atoms',/, 328 + ' 7: Number of neighboring atoms',//) 329 endif 330c 331 do 38 i=ilo,ihi 332 if(util_print('atomtypes',print_debug)) then 333 write(lfnout,3002) (j,j=1,7), 334 + 'Atom ',catm(2,i),latm(2,i),(ltyp(j,i),j=1,5) 335 3002 format(/,5x,i4,6i5,//,a,a4,6i5,/) 336 endif 337 if(latm(2,i).gt.0) then 338c 339 if(util_print('atomtypes',print_debug)) then 340 write(lfnout,3003) (j,j=1,7),'ABCDEF' 341 3003 format(//,' ATOM TYPES',//, 342 + ' 1: Atom type',/, 343 + ' 2: Atomic number',/, 344 + ' 3: Saturation',/, 345 + ' 4: Aliphatic ring',/, 346 + ' 5: Aromatic ring',/, 347 + ' 6: Number of neighboring hydrogen atoms',/, 348 + ' 7: Number of neighboring atoms',/, 349 + ' A: Matching atomic number',/, 350 + ' B: Matching explicit saturation',/, 351 + ' C: Matching aliphatic ring',/, 352 + ' D: Matching aromatic ring',/, 353 + ' E: Matching number of neighboring hydrogen atoms',/, 354 + ' F: Matching number of neighboring atoms',//, 355 + 5x,i2,2x,6i5,1x,a,//) 356 endif 357c 358 do 19 j=1,ntype 359 iatnum=itype(1,j) 360 irng=0 361 if(iatnum.ge.60000) then 362 irng=6 363 iatnum=iatnum-60000 364 endif 365 if(iatnum.ge.50000) then 366 irng=5 367 iatnum=iatnum-50000 368 endif 369 nonh=0 370 do 20 k=1,4 371 if(iatnum.ge.1000) then 372 nonh=nonh+1 373 iatnum=iatnum-1000 374 endif 375 20 continue 376 nhydr=0 377 do 21 k=1,4 378 if(iatnum.ge.200) then 379 nhydr=nhydr+1 380 iatnum=iatnum-200 381 endif 382 if(nhydr.eq.4) nhydr=5 383 21 continue 384c 385c itype(1,*) match atom number 386c 2 match explicit saturation 387c 3 match aliphatic ring 388c 4 match aromatic ring 389c 5 match explicit number of neighbors 390c 391 if(util_print('atomtypes',print_debug)) then 392 write(lfnout,'(a,a4,6i5,1x,6l1)') 'Type ',atype(j)(1:4),iatnum, 393 + itype(2,j),itype(3,j),itype(4,j),nhydr,itype(5,j), 394 + iatnum.eq.latm(2,i), 395 + (itype(2,j).eq.0.or.itype(2,j).eq.ltyp(1,i)), 396 + (itype(3,j).eq.0.or.itype(3,j).eq.ltyp(2,i).or. 397 + (itype(3,j).eq.1.and.ltyp(2,i).gt.0)), 398 + (itype(4,j).eq.0.or.itype(4,j).eq.ltyp(3,i).or. 399 + (itype(4,j).eq.1.and.ltyp(3,i).gt.0)), 400 + (nhydr.eq.0.or.(nhydr.eq.5.and.ltyp(4,i).eq.0).or. 401 + nhydr.eq.ltyp(4,i)), 402 + (itype(5,j).eq.0.or.itype(5,j).eq.ltyp(5,i)) 403 endif 404c 405 if(iatnum.eq.latm(2,i).and. 406 + (nhydr.eq.0.or.(nhydr.eq.5.and.ltyp(4,i).eq.0).or. 407 + nhydr.eq.ltyp(4,i)).and. 408 + (itype(2,j).eq.0.or.itype(2,j).eq.ltyp(1,i)).and. 409 + (itype(3,j).eq.0.or.itype(3,j).eq.ltyp(2,i).or. 410 + (itype(3,j).eq.1.and.ltyp(2,i).gt.0)).and. 411 + (itype(4,j).eq.0.or.itype(4,j).eq.ltyp(3,i).or. 412 + (itype(4,j).eq.1.and.ltyp(3,i).gt.0)).and. 413 + (itype(5,j).eq.0.or.itype(5,j).eq.ltyp(5,i))) then 414c 415 if(util_print('atomtypes',print_debug)) then 416 write(lfnout,'(10x,a)') 'try' 417 endif 418c 419c initialize skip vectors for neighbor atoms : skipa(1:neighbors) 420c ----------------------- for atom type cond : skipt(1:3) 421c 422 do 22 k=1,5 423 skipa(k)=.false. 424 22 continue 425 do 23 l=1,3 426 skipt(l)=.false. 427 if(itype(1+l*5,j).eq.0.and.itype(2+l*5,j).eq.0) skipt(l)=.true. 428 23 continue 429c 430c loop over neighbor conditions for the current atom type : l (1:3) 431c ------------------------------------------------------- 432c 433 do 24 l=1,3 434 if(.not.skipt(l)) then 435 if(util_print('atomtypes',print_debug)) then 436 write(lfnout,'(5x,a,i5)') 'neighbor condition ',itype(1+l*5,j) 437 endif 438c 439c loop over neighbor atoms for the current atom : k (1:neighbors) 440c --------------------------------------------- 441c 442 do 25 k=1,ltyp(5,i) 443 if(.not.skipa(k).and..not.skipt(l)) then 444 if(util_print('atomtypes',print_debug)) then 445 write(lfnout,'(5x,a,i5)') 'neighbor atom ', 446 + latm(2,ltyp(5+k,i)) 447 endif 448 iatnum=itype(1+l*5,j) 449 irng=0 450 if(iatnum.ge.60000) then 451 irng=6 452 iatnum=iatnum-60000 453 endif 454 if(iatnum.ge.50000) then 455 irng=5 456 iatnum=iatnum-50000 457 endif 458 nonh=0 459 do 26 m=1,4 460 if(iatnum.ge.1000) then 461 nonh=nonh+1 462 iatnum=iatnum-1000 463 endif 464 26 continue 465 nhydr=0 466 do 27 m=1,4 467 if(iatnum.ge.200) then 468 nhydr=nhydr+1 469 iatnum=iatnum-200 470 endif 471 if(nhydr.eq.4) nhydr=5 472 27 continue 473c 474c check atomic number of neighbor k 475c --------------------------------- 476c 477 if(iatnum.gt.0.and.iatnum.ne.latm(2,ltyp(5+k,i))) goto 25 478c 479c check bonded hydrogens to neighbor k 480c ------------------------------------ 481c 482 if(nhydr.gt.0) then 483 if(nhydr.eq.5) then 484 if(ltyp(4,ltyp(5+k,i)).gt.0) goto 25 485 else 486 if(nhydr.ne.ltyp(4,ltyp(5+k,i))) goto 25 487 endif 488 endif 489c 490c check bonded nonh-hydrogens to neighbor k 491c ----------------------------------------- 492c 493 if(nonh.gt.0) then 494 if(nonh.ne.ltyp(5,ltyp(5+k,i))-ltyp(4,ltyp(5+k,i))) goto 25 495 endif 496c 497c check number of neighbors 498c ------------------------- 499c 500 if(itype(2+l*5,j).gt.0.and. 501 + itype(2+l*5,j).ne.ltyp(5,ltyp(5+k,i))) goto 25 502c 503c check if neighbor in ring 504c ------------------------- 505c 506 if(irng.gt.0) then 507 if(irng.ne.ltyp(3,ltyp(5+k,i))) goto 25 508 endif 509c 510 if(util_print('atomtypes',print_debug)) then 511 write(lfnout,'(5x,a,2i5)') 'neighbor accepted ', 512 + itype(1+l*5,j),latm(2,ltyp(5+k,i)) 513 endif 514c 515c set skip vectors 516c ---------------- 517c 518 do 28 kk=1,ltyp(5,ltyp(5+k,i)) 519 skipaa(kk)=ltyp(5+kk,ltyp(5+k,i)).eq.i 520 28 continue 521 do 29 ll=1,3 522 skiptt(ll)=itype(2+l*5+ll,j).eq.0 523 29 continue 524c 525c loop over the neighbor of neighbor conditions 526c --------------------------------------------- 527c 528 do 30 ll=1,3 529 if(.not.skiptt(ll)) then 530 if(util_print('atomtypes',print_debug)) then 531 write(lfnout,'(10x,a,i5)') 'neighbor condition ', 532 + itype(2+l*5+ll,j) 533 endif 534c 535c loop over neighbor of neighbor atoms 536c ------------------------------------ 537c 538 do 31 kk=1,ltyp(5,ltyp(5+k,i)) 539 if(.not.skipaa(kk).and..not.skiptt(ll)) then 540 if(util_print('atomtypes',print_debug)) then 541 write(lfnout,'(10x,a,i5)') 'neighbor atom ', 542 + latm(2,ltyp(5+kk,ltyp(5+k,i))) 543 endif 544c 545 iatnum=itype(2+l*5+ll,j) 546 irng=0 547 if(iatnum.ge.60000) then 548 irng=6 549 iatnum=iatnum-60000 550 endif 551 if(iatnum.ge.50000) then 552 irng=5 553 iatnum=iatnum-50000 554 endif 555 nonh=0 556 do 32 m=1,4 557 if(iatnum.ge.1000) then 558 nonh=nonh+1 559 iatnum=iatnum-1000 560 endif 561 32 continue 562 nhydr=0 563 do 33 m=1,4 564 if(iatnum.ge.200) then 565 nhydr=nhydr+1 566 iatnum=iatnum-200 567 endif 568 if(nhydr.eq.4) nhydr=5 569 33 continue 570 if(util_print('atomtypes',print_debug)) then 571 write(lfnout,'(30x,a,3i5)') 'condition ia nn nh ', 572 + iatnum,nonh,nhydr 573 write(lfnout,'(30x,a,3i5)') 'found ia nn nh ', 574 + latm(2,ltyp(5+kk,ltyp(5+k,i))), 575 + ltyp(5,ltyp(5+kk,ltyp(5+k,i)))-ltyp(4,ltyp(5+kk,ltyp(5+k,i))), 576 + ltyp(4,ltyp(5+kk,ltyp(5+k,i))) 577 endif 578c 579c check atomic number of neighbor of neighbor k 580c --------------------------------------------- 581c 582 if(iatnum.gt.0.and.iatnum.ne.latm(2,ltyp(5+kk,ltyp(5+k,i)))) 583 + goto 31 584c 585c check bonded hydrogens to neighbor k 586c ------------------------------------ 587c 588 if(nhydr.gt.0) then 589 if(nhydr.eq.5) then 590 if(ltyp(4,ltyp(5+kk,ltyp(5+k,i))).gt.0) goto 31 591 else 592 if(nhydr.ne.ltyp(4,ltyp(5+kk,ltyp(5+k,i)))) goto 31 593 endif 594 endif 595c 596c check bonded nonh-hydrogens to neighbor k 597c ----------------------------------------- 598c 599 if(nonh.gt.0) then 600 if(nonh.ne.ltyp(5,ltyp(5+kk,ltyp(5+k,i)))- 601 + ltyp(4,ltyp(5+kk,ltyp(5+k,i)))) goto 31 602 endif 603c 604c check if neighbor of neighbor in ring 605c ------------------------------------- 606c 607 if(irng.gt.0) then 608 if(irng.ne.ltyp(3,ltyp(5+kk,ltyp(5+k,i)))) goto 31 609 endif 610c 611 if(util_print('atomtypes',print_debug)) then 612 write(lfnout,'(10x,a,4i5)') 'neighbor accepted ', 613 + itype(2+l*5+ll,j),latm(2,ltyp(5+kk,ltyp(5+k,i))),kk,ll 614 endif 615c 616c neighbor of neighbor condition satisfied 617c ---------------------------------------- 618c 619 skipaa(kk)=.true. 620 skiptt(ll)=.true. 621 endif 622 31 continue 623 endif 624 30 continue 625c 626c test if all neighbor of neighbor conditions are satisfied 627c --------------------------------------------------------- 628c 629 do 34 ll=1,3 630 if(.not.skiptt(ll)) goto 25 631 34 continue 632 if(util_print('atomtypes',print_debug)) then 633 write(lfnout,'(20x,a)') 'neighbors of neighbor accepted' 634 endif 635c 636c neighbor condition satisfied 637c ---------------------------- 638c 639 skipa(k)=.true. 640 skipt(l)=.true. 641 endif 642 25 continue 643 endif 644 24 continue 645c 646c test if all neighbor conditions are satisfied 647c --------------------------------------------- 648c 649 do 35 l=1,3 650 if(.not.skipt(l)) goto 19 651 35 continue 652 if(util_print('atomtypes',print_debug)) then 653 write(lfnout,'(30x,a)') 'neighbor accepted' 654 endif 655c 656 catm(3,i)(1:4)=atype(j) 657 if(util_print('atomtypes',print_debug)) then 658 write(lfnout,'(a,a,a,a)') ' Accepted for atom ',catm(1,i), 659 + ' type ',catm(3,i) 660 endif 661c 662 endif 663 19 continue 664 endif 665 38 continue 666c 667 argos_prepare_atype=.true. 668 return 669c 670 9999 argos_prepare_atype=.false. 671 return 672 end 673