1 logical function pre_rdsgm(lfnout,nparms,mparms, 2 + imol,isgm,igrp, 3 + ipgrp,lfnsgm,filsgm,lfnmat,filmat, 4 + latm,catm,qatm,matm,natm,lbnd,rbnd,mbnd,nbnd, 5 + lang,rang,mang,nang,ldih,nfdih,kdih,rdih,mdih,ndih, 6 + limp,kimp,rimp,mimp,nimp, 7 + wcorr,npar,ipardef,itopol) 8c 9c $Id$ 10c 11 implicit none 12c 13#include "util.fh" 14#include "pre_common.fh" 15c 16 external loc 17 integer loc 18c 19 integer lfnout,lfnsgm,imol,isgm,igrp,ipgrp,lfnmat,nparms,mparms 20 character*255 filsgm,filmat 21 integer matm,natm,itopol 22 integer latm(11,matm) 23 character*6 catm(mparms,matm) 24 real*8 qatm(nparms,2,matm) 25 integer mbnd,nbnd 26 integer lbnd(4,mbnd) 27 real*8 rbnd(nparms,2,mbnd) 28 integer mang,nang 29 integer lang(5,mang) 30 real*8 rang(nparms,4,mang) 31 integer mdih,ndih 32 integer ldih(6,mdih),nfdih(nparms,mdih),kdih(6,nparms,mdih) 33 real*8 rdih(6,nparms,2,mdih) 34 integer mimp,nimp 35 integer limp(6,mimp),kimp(nparms,mimp) 36 real*8 rimp(nparms,2,mimp) 37 real*8 wcorr(10) 38 real*8 version 39c 40 character*80 card 41 integer i,j,k,l,length,na,jmol,nzmat,npar,ipardef,idhop 42 integer nsatm,nsbnd,nsang,nsdih,nsimp,ld(6),md(10),izm(4) 43 real*8 rd(10,2),zm(3) 44c 45 integer itemp 46 real*8 dtemp 47 character*6 ctemp 48c 49 jmol=imol 50c 51 length=index(filsgm,' ')-1 52 open(unit=lfnsgm,file=filsgm(1:length),form='formatted', 53 + status='old',err=9999) 54c 55 if(util_print('where',print_debug)) then 56 write(lfnout,1110) filsgm(1:length) 57 1110 format('READING SEGMENT FILE ',a) 58 endif 59c 60 1 continue 61 read(lfnsgm,1000) card 62 1000 format(a) 63 if(card(1:1).eq.'#'.or.card(1:1).eq.'$') goto 1 64 read(card,1001,err=9999) version 65 1001 format(f12.6) 66 read(lfnsgm,1002,err=9999) 67 + nsatm,nsbnd,nsang,nsdih,nsimp,nzmat,npar,ipardef 68 1002 format(8i5) 69 if(ipardef.eq.0) ipardef=1 70 if(npar.gt.nparms) call md_abort('Error in number par sets',npar) 71 do 2 i=1,npar 72 read(lfnsgm,1003) wcorr(i) 73 1003 format(f12.6) 74 2 continue 75 do 102 i=npar+1,nparms 76 wcorr(i)=wcorr(npar) 77 102 continue 78c 79 if(natm+nsatm.gt.matm) call md_abort('increase matm',9999) 80 if(nbnd+nsbnd.gt.mbnd) call md_abort('increase mbnd',9999) 81 if(nang+nsang.gt.mang) call md_abort('increase mang',9999) 82 if(ndih+nsdih.gt.mdih) call md_abort('increase mdih',9998) 83 if(nimp+nsimp.gt.mimp) call md_abort('increase mimp',9999) 84c 85c read the atom list 86c ------------------ 87c 88 na=natm 89 do 3 i=1,nsatm 90 natm=natm+1 91 read(lfnsgm,1004) catm(1,natm),latm(3,natm),latm(4,natm), 92 + latm(10,natm),latm(1,natm),latm(2,natm) 93 1004 format(5x,a6,5i5) 94c write(*,1004) catm(1,natm),latm(3,natm),latm(4,natm), 95c + latm(10,natm),latm(1,natm),latm(2,natm) 96 read(lfnsgm,1005) (catm(j+1,natm),qatm(j,1,natm),qatm(j,2,natm), 97 + j=1,npar) 98 1005 format(5x,a6,2f12.6) 99c 100 latm(5,natm)=isgm 101 latm(6,natm)=jmol 102 jmol=iabs(jmol) 103 latm(1,natm)=latm(1,natm)+igrp 104 latm(2,natm)=latm(2,natm)+ipgrp 105c 106 if(isgm.eq.0) then 107 do 4 j=2,npar+1 108 catm(j,natm)(6:6)='w' 109 4 continue 110 endif 111c 112 do 103 j=npar+1,nparms 113 catm(j+1,natm)=catm(npar+1,natm) 114 qatm(j,1,natm)=qatm(npar,1,natm) 115 qatm(j,2,natm)=qatm(npar,2,natm) 116 103 continue 117c 118 idhop=0 119 do 1103 j=1,npar 120 if(catm(j+1,natm)(6:6).ne.'D') idhop=idhop+2**(j-1) 121 1103 continue 122 latm(11,natm)=idhop 123c 124 if(util_print('connectivity',print_debug)) then 125 write(lfnout,1004) catm(1,natm),(latm(j,natm),j=1,4) 126 write(lfnout,1005) (catm(j+1,natm),qatm(j,1,natm),qatm(j,2,natm), 127 + j=1,nparms) 128 endif 129c 130 if(itopol.eq.0.and.ipardef.gt.1) then 131 ctemp=catm(2,natm) 132 catm(2,natm)=catm(1+ipardef,natm) 133 catm(1+ipardef,natm)=ctemp 134 dtemp=qatm(1,1,natm) 135 qatm(1,1,natm)=qatm(ipardef,1,natm) 136 qatm(ipardef,1,natm)=dtemp 137 dtemp=qatm(1,2,natm) 138 qatm(1,2,natm)=qatm(ipardef,2,natm) 139 qatm(ipardef,2,natm)=dtemp 140 endif 141 3 continue 142c 143 igrp=latm(1,natm) 144 ipgrp=latm(2,natm) 145c 146c read the bond list 147c ------------------ 148c 149 do 5 i=1,nsbnd 150 nbnd=nbnd+1 151 read(lfnsgm,1006) (lbnd(j,nbnd),j=1,4) 152 1006 format(5x,4i5) 153 read(lfnsgm,1007) (rbnd(j,1,nbnd),rbnd(j,2,nbnd),j=1,npar) 154 1007 format(f12.6,e12.5) 155c 156 lbnd(1,nbnd)=lbnd(1,nbnd)+na 157 lbnd(2,nbnd)=lbnd(2,nbnd)+na 158c 159 do 105 j=npar+1,nparms 160 rbnd(j,1,nbnd)=rbnd(npar,1,nbnd) 161 rbnd(j,2,nbnd)=rbnd(npar,2,nbnd) 162 105 continue 163c 164 if(util_print('connectivity',print_debug)) then 165 write(lfnout,1006) (lbnd(j,nbnd),j=1,4) 166 write(lfnout,1007) (rbnd(j,1,nbnd),rbnd(j,2,nbnd),j=1,nparms) 167 endif 168c 169 if(itopol.eq.0.and.ipardef.gt.1) then 170 dtemp=rbnd(1,1,nbnd) 171 rbnd(1,1,nbnd)=rbnd(ipardef,1,nbnd) 172 rbnd(ipardef,1,nbnd)=dtemp 173 dtemp=rbnd(1,2,nbnd) 174 rbnd(1,2,nbnd)=rbnd(ipardef,2,nbnd) 175 rbnd(ipardef,2,nbnd)=dtemp 176 endif 177c 178 5 continue 179c 180c read the angle list 181c ------------------- 182c 183 do 6 i=1,nsang 184 nang=nang+1 185 read(lfnsgm,1008) (lang(j,nang),j=1,5) 186 1008 format(5x,5i5) 187 if(ffield(1:6).ne.'charmm') then 188 read(lfnsgm,1009) (rang(j,1,nang),rang(j,2,nang),j=1,npar) 189 1009 format(f10.6,e12.5) 190 else 191 read(lfnsgm,1019) (rang(j,1,nang),rang(j,2,nang), 192 + rang(j,3,nang),rang(j,4,nang),j=1,npar) 193 1019 format(2(f10.6,e12.5)) 194 endif 195 lang(1,nang)=lang(1,nang)+na 196 lang(2,nang)=lang(2,nang)+na 197 lang(3,nang)=lang(3,nang)+na 198c 199 do 106 j=npar+1,nparms 200 rang(j,1,nbnd)=rang(npar,1,nang) 201 rang(j,2,nbnd)=rang(npar,2,nang) 202 if(ffield(1:6).eq.'charmm') then 203 rang(j,3,nbnd)=rang(npar,3,nang) 204 rang(j,4,nbnd)=rang(npar,4,nang) 205 endif 206 106 continue 207c 208 if(util_print('connectivity',print_debug)) then 209 write(lfnout,1008) (lang(j,nang),j=1,5) 210 if(ffield(1:6).ne.'charmm') then 211 write(lfnout,1009) (rang(j,1,nang),rang(j,2,nang),j=1,nparms) 212 else 213 write(lfnout,1019) (rang(j,1,nang),rang(j,2,nang), 214 + rang(j,3,nang),rang(j,4,nang),j=1,nparms) 215 endif 216 endif 217c 218 if(itopol.eq.0.and.ipardef.gt.1) then 219 dtemp=rang(1,1,nang) 220 rang(1,1,nang)=rang(ipardef,1,nang) 221 rang(ipardef,1,nang)=dtemp 222 dtemp=rang(1,2,nang) 223 rang(1,2,nang)=rang(ipardef,2,nang) 224 rang(ipardef,2,nang)=dtemp 225 if(ffield(1:6).eq.'charmm') then 226 dtemp=rang(1,1,nang) 227 rang(1,3,nang)=rang(ipardef,3,nang) 228 rang(ipardef,3,nang)=dtemp 229 dtemp=rang(1,4,nang) 230 rang(1,4,nang)=rang(ipardef,4,nang) 231 rang(ipardef,4,nang)=dtemp 232 endif 233 endif 234c 235 6 continue 236c 237c read the torsion list 238c --------------------- 239c 240 do 7 i=1,nsdih 241 read(lfnsgm,1010) (ld(j),j=1,6) 242 1010 format(5x,6i5) 243 read(lfnsgm,1011) (md(j),rd(j,1),rd(j,2),j=1,npar) 244 1011 format(i3,f10.6,e12.5) 245c 246 if(itopol.eq.0.and.ipardef.gt.1) then 247 itemp=md(1) 248 md(1)=md(ipardef) 249 md(ipardef)=itemp 250 dtemp=rd(1,1) 251 rd(1,1)=rd(ipardef,1) 252 rd(ipardef,1)=dtemp 253 dtemp=rd(1,2) 254 rd(1,2)=rd(ipardef,2) 255 rd(ipardef,2)=dtemp 256 endif 257c 258 l=0 259 do 8 j=1,npar 260 if(md(j).ge.0) l=l+1 261 8 continue 262 if(l.eq.npar) then 263 ndih=ndih+1 264 do 9 j=1,nparms 265 nfdih(j,ndih)=1 266 9 continue 267 do 10 j=1,6 268 ldih(j,ndih)=ld(j) 269 10 continue 270 else 271 do 11 j=1,npar 272 if(md(j).lt.0) nfdih(j,ndih)=nfdih(j,ndih)+1 273 11 continue 274 endif 275c 276 do 12 l=1,nparms 277 do 13 j=1,nparms 278 rdih(nfdih(l,ndih),j,1,ndih)=rd(j,1) 279 rdih(nfdih(l,ndih),j,2,ndih)=rd(j,2) 280 kdih(nfdih(l,ndih),j,ndih)=md(j) 281 13 continue 282 12 continue 283c 284 ldih(1,ndih)=ldih(1,ndih)+na 285 ldih(2,ndih)=ldih(2,ndih)+na 286 ldih(3,ndih)=ldih(3,ndih)+na 287 ldih(4,ndih)=ldih(4,ndih)+na 288c 289 do 107 j=npar+1,nparms 290 nfdih(j,ndih)=nfdih(npar,ndih) 291 do 117 k=1,nfdih(j,ndih) 292 kdih(k,j,ndih)=kdih(k,npar,ndih) 293 rdih(k,j,1,ndih)=rdih(k,npar,1,ndih) 294 rdih(k,j,2,ndih)=rdih(k,npar,2,ndih) 295 117 continue 296 107 continue 297c 298 if(util_print('connectivity',print_debug)) then 299 write(lfnout,1010) (ldih(j,ndih),j=1,6) 300 write(lfnout,1011) ((kdih(l,j,ndih),rdih(l,j,1,ndih), 301 + rdih(l,j,2,ndih),l=1,nfdih(j,ndih)),j=1,nparms) 302 endif 303c 304 7 continue 305c 306c read the improper torsion list 307c ------------------------------ 308c 309 do 14 i=1,nsimp 310 nimp=nimp+1 311 if(ffield(1:5).eq.'amber') then 312 read(lfnsgm,1012) limp(2,nimp),limp(3,nimp),limp(1,nimp), 313 + (limp(j,nimp),j=4,6) 314 else 315 read(lfnsgm,1012) (limp(j,nimp),j=1,6) 316 endif 317 1012 format(5x,6i5) 318 read(lfnsgm,1013) (kimp(j,nimp),rimp(j,1,nimp), 319 + rimp(j,2,nimp),j=1,npar) 320 1013 format(i3,f10.6,e12.5) 321c 322 limp(1,nimp)=limp(1,nimp)+na 323 limp(2,nimp)=limp(2,nimp)+na 324 limp(3,nimp)=limp(3,nimp)+na 325 limp(4,nimp)=limp(4,nimp)+na 326c 327 do 114 j=npar+1,nparms 328 kimp(j,nimp)=kimp(npar,nimp) 329 rimp(j,1,nimp)=rimp(npar,1,nimp) 330 rimp(j,2,nimp)=rimp(npar,2,nimp) 331 114 continue 332c 333 if(util_print('connectivity',print_debug)) then 334 write(lfnout,1012) (limp(j,nimp),j=1,6) 335 write(lfnout,1013) (kimp(j,nimp),rimp(j,1,nimp), 336 + rimp(j,2,nimp),j=1,nparms) 337 endif 338c 339 if(itopol.eq.0.and.ipardef.gt.1) then 340 itemp=kimp(1,nimp) 341 kimp(1,nimp)=kimp(ipardef,nimp) 342 kimp(ipardef,nimp)=itemp 343 dtemp=rimp(1,1,nimp) 344 rimp(1,1,nimp)=rimp(ipardef,1,nimp) 345 rimp(ipardef,1,nimp)=dtemp 346 dtemp=rimp(1,2,nimp) 347 rimp(1,2,nimp)=rimp(ipardef,2,nimp) 348 rimp(ipardef,2,nimp)=dtemp 349 endif 350c 351 14 continue 352c 353c copy the z-matrix information 354c ----------------------------- 355c 356 if(nzmat.gt.0) then 357 open(unit=lfnmat,file=filmat(1:index(filmat,' ')-1), 358 + form='formatted',status='unknown',err=9999) 359 do 15 i=1,nzmat 360 read(lfnsgm,1014) izm,zm 361 write(lfnmat,1015) izm,zm 362 1014 format(5x,4i5,3f12.6) 363 1015 format(4i5,3f12.6) 364 15 continue 365 close(unit=lfnmat) 366 endif 367c 368 close(unit=lfnsgm) 369c 370 if(util_print('where',print_debug)) then 371 write(lfnout,1120) filsgm(1:length) 372 1120 format('READING SEGMENT FILE ',a,' DONE') 373 endif 374c 375 pre_rdsgm=.true. 376 return 377 9999 continue 378 pre_rdsgm=.false. 379 return 380 end 381 382