1c 2c 3c ################################################### 4c ## COPYRIGHT (C) 1990 by Jay William Ponder ## 5c ## All Rights Reserved ## 6c ################################################### 7c 8c ########################################################## 9c ## ## 10c ## subroutine rings -- locate and store small rings ## 11c ## ## 12c ########################################################## 13c 14c 15c "rings" searches the structure for small rings and stores 16c their constituent atoms, and optionally reduces large rings 17c into their component smaller rings 18c 19c note by default reducible rings are not removed since they 20c are needed for force field parameter assignment 21c 22c 23 subroutine rings 24 use angbnd 25 use atoms 26 use bitor 27 use bndstr 28 use couple 29 use inform 30 use iounit 31 use ring 32 use tors 33 implicit none 34 integer i,j,k,m 35 integer kk,imax 36 integer ia,ib,ic,id 37 integer ie,ig,ih 38 integer list1,list2 39 integer list3,list4 40 integer maxring 41 integer, allocatable :: list(:) 42 logical reduce 43c 44c 45c zero out the number of small rings in the structure 46c 47 reduce = .false. 48 nring3 = 0 49 nring4 = 0 50 nring5 = 0 51 nring6 = 0 52 nring7 = 0 53c 54c parse to find bonds, angles, torsions and bitorsions 55c 56 if (nbond .eq. 0) call bonds 57 if (nangle .eq. 0) call angles 58 if (ntors .eq. 0) call torsions 59 if (nbitor .eq. 0) call bitors 60c 61c perform dynamic allocation of some global arrays 62c 63 maxring = 10000 64 if (.not. allocated(iring3)) allocate (iring3(3,maxring)) 65 if (.not. allocated(iring4)) allocate (iring4(4,maxring)) 66 if (.not. allocated(iring5)) allocate (iring5(5,maxring)) 67 if (.not. allocated(iring6)) allocate (iring6(6,maxring)) 68 if (.not. allocated(iring7)) allocate (iring7(7,maxring)) 69c 70c search for and store all of the 3-membered rings 71c 72 do i = 1, nangle 73 ia = iang(1,i) 74 ib = iang(2,i) 75 ic = iang(3,i) 76 if (ib.lt.ia .and. ib.lt.ic) then 77 do j = 1, n12(ia) 78 if (i12(j,ia) .eq. ic) then 79 nring3 = nring3 + 1 80 if (nring3 .gt. maxring) then 81 write (iout,10) 82 10 format (/,' RINGS -- Too many 3-Membered Rings;', 83 & ' Increase MAXRING') 84 call fatal 85 end if 86 iring3(1,nring3) = ia 87 iring3(2,nring3) = ib 88 iring3(3,nring3) = ic 89 goto 20 90 end if 91 end do 92 20 continue 93 end if 94 end do 95c 96c perform dynamic allocation of some local arrays 97c 98 allocate (list(n)) 99c 100c search for and store all of the 4-membered rings 101c 102 do i = 1, n 103 list(i) = 0 104 end do 105 do i = 1, ntors 106 ia = itors(1,i) 107 ib = itors(2,i) 108 ic = itors(3,i) 109 id = itors(4,i) 110 if (ia.lt.ic .and. id.lt.ib) then 111 do j = 1, n12(ia) 112 if (i12(j,ia) .eq. id) then 113 nring4 = nring4 + 1 114 if (nring4 .gt. maxring) then 115 write (iout,30) 116 30 format (/,' RINGS -- Too many 4-Membered Rings;', 117 & ' Increase MAXRING') 118 call fatal 119 end if 120 iring4(1,nring4) = ia 121 iring4(2,nring4) = ib 122 iring4(3,nring4) = ic 123 iring4(4,nring4) = id 124c 125c remove the ring if it is reducible into smaller rings 126c 127 if (reduce) then 128 list(ia) = nring4 129 list(ib) = nring4 130 list(ic) = nring4 131 list(id) = nring4 132 do m = 1, nring3 133 list1 = list(iring3(1,m)) 134 list2 = list(iring3(2,m)) 135 list3 = list(iring3(3,m)) 136 if (list1.eq.nring4 .and. 137 & list2.eq.nring4 .and. 138 & list3.eq.nring4) then 139 nring4 = nring4 - 1 140 list(ia) = 0 141 list(ib) = 0 142 list(ic) = 0 143 list(id) = 0 144 goto 40 145 end if 146 end do 147 end if 148 goto 40 149 end if 150 end do 151 40 continue 152 end if 153 end do 154c 155c search for and store all of the 5-membered rings 156c 157 do i = 1, n 158 list(i) = 0 159 end do 160 do i = 1, nbitor 161 ia = ibitor(1,i) 162 ib = ibitor(2,i) 163 ic = ibitor(3,i) 164 id = ibitor(4,i) 165 ie = ibitor(5,i) 166 if (ia.lt.id .and. ie.lt.ib .and. min(ia,ie).lt.ic) then 167 do j = 1, n12(ia) 168 if (i12(j,ia) .eq. ie) then 169 nring5 = nring5 + 1 170 if (nring5 .gt. maxring) then 171 write (iout,50) 172 50 format (/,' RINGS -- Too many 5-Membered Rings;', 173 & ' Increase MAXRING') 174 call fatal 175 end if 176 iring5(1,nring5) = ia 177 iring5(2,nring5) = ib 178 iring5(3,nring5) = ic 179 iring5(4,nring5) = id 180 iring5(5,nring5) = ie 181c 182c remove the ring if it is reducible into smaller rings 183c 184 if (reduce) then 185 list(ia) = nring5 186 list(ib) = nring5 187 list(ic) = nring5 188 list(id) = nring5 189 list(ie) = nring5 190 do m = 1, nring3 191 list1 = list(iring3(1,m)) 192 list2 = list(iring3(2,m)) 193 list3 = list(iring3(3,m)) 194 if (list1.eq.nring5 .and. 195 & list2.eq.nring5 .and. 196 & list3.eq.nring5) then 197 nring5 = nring5 - 1 198 list(ia) = 0 199 list(ib) = 0 200 list(ic) = 0 201 list(id) = 0 202 list(ie) = 0 203 goto 60 204 end if 205 end do 206 end if 207 goto 60 208 end if 209 end do 210 60 continue 211 end if 212 end do 213c 214c search for and store all of the 6-membered rings 215c 216 do i = 1, n 217 list(i) = 0 218 end do 219 do i = 1, nbitor 220 ia = ibitor(1,i) 221 ib = ibitor(2,i) 222 ic = ibitor(3,i) 223 id = ibitor(4,i) 224 ie = ibitor(5,i) 225 imax = max(ia,ib,ic,id,ie) 226 do j = 1, n12(ia) 227 ig = i12(j,ia) 228 if (ig .gt. imax) then 229 do k = 1, n12(ie) 230 if (i12(k,ie) .eq. ig) then 231 nring6 = nring6 + 1 232 if (nring6 .gt. maxring) then 233 write (iout,70) 234 70 format (/,' RINGS -- Too many 6-Membered', 235 & ' Rings; Increase MAXRING') 236 call fatal 237 end if 238 iring6(1,nring6) = ia 239 iring6(2,nring6) = ib 240 iring6(3,nring6) = ic 241 iring6(4,nring6) = id 242 iring6(5,nring6) = ie 243 iring6(6,nring6) = ig 244c 245c remove the ring if it is reducible into smaller rings 246c 247 if (reduce) then 248 list(ia) = nring6 249 list(ib) = nring6 250 list(ic) = nring6 251 list(id) = nring6 252 list(ie) = nring6 253 list(ig) = nring6 254 do m = 1, nring3 255 list1 = list(iring3(1,m)) 256 list2 = list(iring3(2,m)) 257 list3 = list(iring3(3,m)) 258 if (list1.eq.nring6 .and. 259 & list2.eq.nring6 .and. 260 & list3.eq.nring6) then 261 nring6 = nring6 - 1 262 list(ia) = 0 263 list(ib) = 0 264 list(ic) = 0 265 list(id) = 0 266 list(ie) = 0 267 list(ig) = 0 268 goto 80 269 end if 270 end do 271 do m = 1, nring4 272 list1 = list(iring4(1,m)) 273 list2 = list(iring4(2,m)) 274 list3 = list(iring4(3,m)) 275 list4 = list(iring4(4,m)) 276 if (list1.eq.nring6 .and. 277 & list2.eq.nring6 .and. 278 & list3.eq.nring6 .and. 279 & list4.eq.nring6) then 280 nring6 = nring6 - 1 281 list(ia) = 0 282 list(ib) = 0 283 list(ic) = 0 284 list(id) = 0 285 list(ie) = 0 286 list(ig) = 0 287 goto 80 288 end if 289 end do 290 end if 291 80 continue 292 end if 293 end do 294 end if 295 end do 296 end do 297c 298c search for and store all of the 7-membered rings 299c 300 do i = 1, n 301 list(i) = 0 302 end do 303 do i = 1, nbitor 304 ia = ibitor(1,i) 305 ib = ibitor(2,i) 306 ic = ibitor(3,i) 307 id = ibitor(4,i) 308 ie = ibitor(5,i) 309 imax = max(ia,ib,ic,id,ie) 310 do j = 1, n12(ia) 311 ih = i12(j,ia) 312 do k = 1, n12(ie) 313 ig = i12(k,ie) 314 if (ig.ne.id .and. ih.ne.ib .and. 315 & ((ig.gt.imax.and.ih.gt.ie) .or. 316 & (ih.gt.imax.and.ig.gt.ia))) then 317 do kk = 1, n12(ig) 318 if (i12(kk,ig) .eq. ih) then 319 nring7 = nring7 + 1 320 if (nring7 .gt. maxring) then 321 write (iout,90) 322 90 format (/,' RINGS -- Too many 7-Membered', 323 & ' Rings; Increase MAXRING') 324 call fatal 325 end if 326 iring7(1,nring7) = ia 327 iring7(2,nring7) = ib 328 iring7(3,nring7) = ic 329 iring7(4,nring7) = id 330 iring7(5,nring7) = ie 331 iring7(6,nring7) = ig 332 iring7(7,nring7) = ih 333c 334c remove the ring if it is reducible into smaller rings 335c 336 if (reduce) then 337 list(ia) = nring7 338 list(ib) = nring7 339 list(ic) = nring7 340 list(id) = nring7 341 list(ie) = nring7 342 list(ig) = nring7 343 list(ih) = nring7 344 do m = 1, nring3 345 list1 = list(iring3(1,m)) 346 list2 = list(iring3(2,m)) 347 list3 = list(iring3(3,m)) 348 if (list1.eq.nring7 .and. 349 & list2.eq.nring7 .and. 350 & list3.eq.nring7) then 351 nring7 = nring7 - 1 352 list(ia) = 0 353 list(ib) = 0 354 list(ic) = 0 355 list(id) = 0 356 list(ie) = 0 357 list(ig) = 0 358 list(ih) = 0 359 goto 100 360 end if 361 end do 362 do m = 1, nring4 363 list1 = list(iring4(1,m)) 364 list2 = list(iring4(2,m)) 365 list3 = list(iring4(3,m)) 366 list4 = list(iring4(4,m)) 367 if (list1.eq.nring7 .and. 368 & list2.eq.nring7 .and. 369 & list3.eq.nring7 .and. 370 & list4.eq.nring7) then 371 nring7 = nring7 - 1 372 list(ia) = 0 373 list(ib) = 0 374 list(ic) = 0 375 list(id) = 0 376 list(ie) = 0 377 list(ig) = 0 378 list(ih) = 0 379 goto 100 380 end if 381 end do 382 end if 383 100 continue 384 end if 385 end do 386 end if 387 end do 388 end do 389 end do 390c 391c perform deallocation of some local arrays 392c 393 deallocate (list) 394c 395c print out lists of the small rings in the structure 396c 397 if (debug) then 398 if (nring3 .gt. 0) then 399 write (iout,110) 400 110 format (/,' Three-Membered Rings in the Structure :', 401 & //,3x,'Ring',14x,'Atoms in Ring',/) 402 do i = 1, nring3 403 write (iout,120) i,(iring3(j,i),j=1,3) 404 120 format (i6,7x,3i7) 405 end do 406 end if 407 if (nring4 .gt. 0) then 408 write (iout,130) 409 130 format (/,' Four-Membered Rings in the Structure :', 410 & //,3x,'Ring',17x,'Atoms in Ring',/) 411 do i = 1, nring4 412 write (iout,140) i,(iring4(j,i),j=1,4) 413 140 format (i6,7x,4i7) 414 end do 415 end if 416 if (nring5 .gt. 0) then 417 write (iout,150) 418 150 format (/,' Five-Membered Rings in the Structure :', 419 & //,3x,'Ring',20x,'Atoms in Ring',/) 420 do i = 1, nring5 421 write (iout,160) i,(iring5(j,i),j=1,5) 422 160 format (i6,7x,5i7) 423 end do 424 end if 425 if (nring6 .gt. 0) then 426 write (iout,170) 427 170 format (/,' Six-Membered Rings in the Structure :', 428 & //,3x,'Ring',23x,'Atoms in Ring',/) 429 do i = 1, nring6 430 write (iout,180) i,(iring6(j,i),j=1,6) 431 180 format (i6,7x,6i7) 432 end do 433 end if 434 if (nring7 .gt. 0) then 435 write (iout,190) 436 190 format (/,' Seven-Membered Rings in the Structure :', 437 & //,3x,'Ring',26x,'Atoms in Ring',/) 438 do i = 1, nring7 439 write (iout,200) i,(iring7(j,i),j=1,7) 440 200 format (i6,7x,7i7) 441 end do 442 end if 443 end if 444 return 445 end 446