source: addend.f

Last change on this file was 38d77eb, checked in by baerbaer <baerbaer@…>, 14 years ago

Redirected standard out to logString.

SMMP produced a lot of log messages. This became an issue when run in massively
parallel environments. I replaced all writes to standard out to a write to logString.
The next step is to pass this string to a function that writes the messages to a log
file according to their importance and the chosen log level.

git-svn-id: svn+ssh://svn.berlios.de/svnroot/repos/smmp/trunk@34 26dc1dd8-5c4e-0410-9ffe-d298b4865968

  • Property mode set to 100644
File size: 22.4 KB
Line 
1! **************************************************************
2!
3!
4! This file contains the subroutines: addend, redchg, rplgrp
5!
6! Copyright 2003-2005 Frank Eisenmenger, U.H.E. Hansmann,
7! Shura Hayryan, Chin-Ku
8! Copyright 2007 Frank Eisenmenger, U.H.E. Hansmann,
9! Jan H. Meinke, Sandipan Mohanty
10!
11! $Id: addend.f 334 2007-08-07 09:23:59Z meinke $
12! **************************************************************
13 subroutine addend(nml,grpn,grpc)
14
15! ..............................................................
16! PURPOSE: modify terminal residues to complete bonding scheme
17! with residue 'grpn' at N- and residue 'grpc' at C-terminus
18! ! need initial co-ordinates for residues to modify
19! ! for N-terminus: may add only simple groups
20!
21! CALLS: rplgrp,tolost,redchg
22! ..............................................................
23
24 include 'INCL.H'
25
26 character grpn*4,grpc*4
27
28 character res*4,rpat*4,sbrs*4,grn*4,grc*4
29
30 integer nml
31
32 integer i, ifirs, ilars
33
34 double precision cg
35
36 grn = grpn
37 call tolost(grn)
38 grc = grpc
39 call tolost(grc)
40
41 if (grn(:3).eq.'ace'.or.grc(:3).eq.'ace'
42 &.or.grn(:3).eq.'nme'.or.grc(:3).eq.'nme') then
43
44 write (logString, '(2a)')
45 & ' addend> N-Acetyl (ace) or N-Methylamide (nme)',
46 & ' should be put in SEQUENCE file, not added as end groups'
47
48 stop
49 endif
50
51! __________________________________________ N-terminus
52 ifirs=irsml1(nml)
53 rpat='n '
54 res=seq(ifirs)
55 call tolost(res)
56 if (res(:3).ne.'ace') then
57 if (grn(:3).eq.'nh2') then
58 if (res(:3).eq.'hyp'.and..not.flex) then
59 if(sh2) then
60 sbrs='nh2+'
61 else
62 write (logString, '(2a)') ' addend> ',
63 & ' No N-terminal Hyp possible with ECEPP/3 dataset'
64 stop
65 endif
66
67 elseif (res(:3).eq.'pro') then
68 sbrs='nh1 '
69 elseif (res(:3).eq.'gly'.and..not.flex) then
70 if (sh2) then
71 sbrs='nh2 '
72 else
73 sbrs='nh2g'
74 endif
75 else
76 sbrs='nh2 '
77 endif
78
79 elseif (grn.eq.'nh3+') then
80 if (res(:3).eq.'pro'.and..not.flex) then
81 sbrs='nh2+'
82 elseif (res(:3).eq.'gly'.and..not.flex) then
83 sbrs='nh3g'
84 else
85 sbrs='nh3+'
86 endif
87
88 else
89
90 write (logString, '(2a)') ' addend> Can add only ',
91 & 'nh2 or nh3+ to N-terminus'
92 stop
93
94 endif
95
96 call rplgrp(nml,ifirs,rpat,sbrs)
97 if (flex) call redchg(nml,ifirs,rpat,sbrs) ! Flex dataset
98
99 else ! ace
100
101 write (logString, '(2a)') ' addend> Acetyl group',
102 & ' at N-terminus not modified'
103 endif
104
105! __________________________________________ C-terminus
106 ilars=irsml2(nml)
107 rpat='c '
108 res=seq(ilars)
109 call tolost(res)
110
111 if (res(:3).ne.'nme') then
112
113 if (grc.eq.'cooh') then
114
115 if (res(:3).eq.'gly'.and..not.sh2) then
116 sbrs='gooh'
117 else
118 sbrs='cooh'
119 endif
120
121 elseif (grc.eq.'coo-') then
122
123 if (res(:3).eq.'gly'.and..not.sh2) then
124 sbrs='goo-'
125 else
126 sbrs='coo-'
127 endif
128
129 else
130
131 write (logString, '(2a)') ' addend> Can add only ',
132 & 'cooh or coo- to C-terminus'
133 stop
134
135 endif
136
137 call rplgrp(nml,ilars,rpat,sbrs)
138 if (flex) call redchg(nml,ilars,rpat,sbrs) ! Flex dataset
139
140 else ! N'-methylamide
141
142 write (logString, '(2a)') ' addend> N-Methylamide',
143 & ' at C-terminus not modified'
144
145 endif
146
147! ----------------------------- net charge of molecule
148 cg = 0.d0
149 do i=iatrs1(irsml1(nml)),iatrs2(irsml2(nml))
150 cg = cg + cgat(i)
151 enddo
152 if (abs(cg).gt.1.d-5) then
153 write (logString, '(a,i2,a,f7.3)')
154 & ' addend> Net charge of molecule #'
155 & ,nml,': ',cg
156 endif
157
158 return
159 end
160! ****************************************
161 subroutine rplgrp(nml,nrs,rpat,sbrs)
162
163! ...............................................................
164! PURPOSE: replace atom(s) rooted at atom 'rpat' in residue
165! 'nrs' of molecule 'nml' by atom(s) rooted at
166! 'rpat' of residue 'sbrs' (same name of root
167! atom 'rpat' maintains bonding geometry for
168! preceeding atoms in 'nrs')
169!
170! is NOT performed if 'rpat' is within mainchain,
171! except it is first/last mainchain atom of 'nml'
172!
173! CALLS: dihedr,iopfil,iendst,eyring,fndbrn,redres,setsys,valang
174! ...............................................................
175
176 include 'INCL.H'
177
178 character rpat*4,sbrs*4
179 logical ntbb,bb
180 integer nml, nrs, ibd, iybd
181
182 dimension ibd(mxbd+1),iybd(mxbd+1)
183
184 integer iopfil, iendst
185
186 double precision valang, dihedr
187
188 integer ish, i, i1, irng1, irng2, ilavr, ilaat, i2, i3, ibdrg,
189 & ib, iat, ifirs, ifivr, ii, iow, isgbb1, ity, nfi, ilars,
190 & ivrrp, ivrsb, jsh, j, iybdrg, k, lvrrp, nb, natsb, nla,
191 & nfirp, nxt, nsb, nlarp, nfisb, nlasb, nrp, nsh,
192 & nvrsb, nxtbb1, nxtbb2, nxtsb
193 double precision ba, ca, ct, dx, dz, h3, h2, sa, st,to, x1, x2,
194 & x3, y1, y2, y3, z1, z2, z3
195
196 ifirs=irsml1(nml)
197 ilars=irsml2(nml)
198
199 nxt=ixatrs(nrs)
200 nfi=iatrs1(nrs)
201 nla=iatrs2(nrs)
202! __________________________ indices of atoms to be replaced
203 do i=nfi,nla
204 if (rpat.eq.nmat(i)) then
205 nfirp=i
206 goto 1
207 endif
208 enddo
209 write (logString, '(4a,i4,a,i4)') ' rplgrp> cannot find atom >',
210 & rpat,
211 & '< to be replaced in residue ',seq(nrs),nrs,' of molecule ',nml
212 stop
213
214 1 call fndbrn(nml,nrs,nfirp,nlarp,irng1,irng2,bb)
215 if (irng1.gt.0) goto 10
216 ntbb=.false.
217
218 if (bb) then ! ..... backbone
219
220 if (nfirp.eq.nxt.and.nrs.eq.ilars) goto 2 ! last mainchain atom
221
222 if (nfirp.eq.nfi.and.nrs.eq.ifirs) then ! 1st MAINCHAIN ATOM !
223
224 ntbb=.true.
225
226 ibd(1)=iowat(nfirp)
227 iybd(1)=iyowat(nfirp)
228
229 do i=1,mxbd
230 ibd(i+1)=ibdat(i,nfirp)
231 iybd(i+1)=iybdat(i,nfirp)
232 enddo
233
234 ibdrg=0 ! __________________ check ring
235 iybdrg=1
236
237 do i=1,nbdat(nfirp)+1
238 if (iowat(ibd(i)).ne.nfirp) then
239 if (ibdrg.ne.0) then
240 write (logString, '(2a,i3)')
241 & ' rplgrp> Can handle only simple ring at 1st',
242 & ' atom of molecule #',nml
243 stop
244 endif
245 ibdrg=ibd(i)
246 iybdrg=iybd(i)
247 endif
248 enddo
249 nxtbb1=nlarp+1 ! _________________ next backbone atoms
250 isgbb1=iyowat(nxtbb1)
251
252 if (nxtbb1.eq.nxt) then
253 if (nrs.lt.ilars) then
254 nxtbb2=iatrs1(nrs+1)
255 goto 3
256 endif
257 else
258 do i=nxt,nxtbb1+1,-1
259 if (iowat(i).eq.nxtbb1) then
260 nxtbb2=i
261 goto 3
262 endif
263 enddo
264 endif
265 goto 11
266 else
267 write (logString, '(4a,i4,a,i4)')
268 & ' rplgrp> Cannot replace BACKBONE atom ',rpat,
269 & ' of residue ',seq(nrs),nrs,' in molecule #',nml
270 stop
271 endif
272
273 endif ! N-terminus
274! _________________________________ previous atoms
275 2 if (nfirp.eq.nfi.and.nrs.eq.ifirs) goto 11
276 nxtbb1=iowat(nfirp)
277 if (nxtbb1.eq.nfi.and.nrs.eq.ifirs) goto 11
278 nxtbb2=iowat(nxtbb1)
279! _______________________________ get data for substituent atoms
280 3 if (iopfil(lunlib,reslib,'old','formatted').le.izero) then
281 write (logString, '(a,/,a,i3,2a)')
282 & ' rplgrp> ERROR opening library of residues:',
283 & ' LUN=',lunlib,' FILE=',reslib(1:iendst(reslib))
284 stop
285 endif
286 call redres(sbrs,natsb,nxtsb,nvrsb)
287 close (lunlib)
288! __________________________ indices of substituent atoms
289 do i=1,natsb
290 if (rpat.eq.nmath(i)) then
291 nfisb=i
292 goto 4
293 endif
294 enddo
295 write (logString, '(4a)') ' rplgrp> Cannot find atom >',rpat,
296 &'< in substituent residue ',sbrs
297 stop
298
299 4 nlasb=nfisb
300 do i=1,nbdath(nfisb)
301 ib=ibdath(i,nfisb)
302 if (iowath(ib).lt.nfisb) goto 10
303 do j=ib,natsb
304 if (j.gt.ib.and.iowath(j).lt.ib) goto 5
305 do k=1,nbdath(j)
306 if (ibdath(k,j).lt.nfisb) goto 10
307 enddo
308 nlasb=j
309 enddo ! ... branch atoms
310 5 enddo ! ... branches
311! _________________________________________________ local axes at 'nfirp'
312 call setsys(nxtbb1,nfirp,nxtbb2,x1,x2,x3,y1,y2,y3,z1,z2,z3)
313
314 xtoat(nfirp)=x1
315 ytoat(nfirp)=x2
316 ztoat(nfirp)=x3
317 xbaat(nfirp)=z1
318 ybaat(nfirp)=z2
319 zbaat(nfirp)=z3
320
321! _____________________ add virtual atoms
322 if (ntbb) then
323
324 ct=cstoat(nxtbb2) ! t.angle_(+2)
325 st=sntoat(nxtbb2)
326 ca=csbaat(nxtbb1) ! b.angle_(+1)
327 sa=snbaat(nxtbb1)
328
329! ------------------- Eyring
330 h2=-sa*ct
331 h3=-sa*st
332 x1=-ca*x1+h2*y1+h3*z1
333 x2=-ca*x2+h2*y2+h3*z2
334 x3=-ca*x3+h2*y3+h3*z3
335 dx=one/sqrt(x1*x1+x2*x2+x3*x3)
336 x1=x1*dx
337 x2=x2*dx
338 x3=x3*dx
339
340 xat(izero)=xat(nfirp)+x1
341 yat(izero)=yat(nfirp)+x2
342 zat(izero)=zat(nfirp)+x3
343 z1=-st*y1+ct*z1
344 z2=-st*y2+ct*z2
345 z3=-st*y3+ct*z3
346 dz=one/sqrt(z1*z1+z2*z2+z3*z3)
347 z1=z1*dz
348 z2=z2*dz
349 z3=z3*dz
350
351 ct=cstoat(nxtbb1) ! t.angle_(+1)
352 st=sntoat(nxtbb1)
353
354! -------------------- Eyring with b.angle = 90 deg.
355 xat(-ione)=xat(izero)-ct*(z2*x3-z3*x2)-st*z1
356 yat(-ione)=yat(izero)-ct*(z3*x1-z1*x3)-st*z2
357 zat(-ione)=zat(izero)-ct*(z1*x2-z2*x1)-st*z3
358
359 endif
360! _____________________________________________ Shift atom data
361 nrp=nlarp-nfirp
362 nsb=nlasb-nfisb
363 if (nrp.ne.nsb) then
364 nsh=nsb-nrp
365 do i=nfi,nfirp-1 ! bonds to atoms after repl. group
366 do j=1,mxbd
367 ib=ibdat(j,i)
368 if (ib.gt.nlarp.and.ib.le.nla) ibdat(j,i)=ib+nsh
369 enddo
370 enddo
371 ilaat=iatrs2(irsml2(ntlml))
372 if (nrp.gt.nsb) then ! less atoms
373 i1=nlarp+1
374 i2=ilaat
375 i3=1
376 else ! more atoms
377 if ((ilaat+nsh).gt.mxat) then
378 write (logString, '(a,i5)') ' rplgrp> number of atoms > ',
379 & mxat
380 stop
381 endif
382
383 i1=ilaat
384 i2=nlarp+1
385 i3=-1
386 endif
387
388 do i=i1,i2,i3
389 ii=i+nsh
390 nbdat(ii)=nbdat(i)
391
392 ibd(1)=iowat(i)
393 iybd(1)=iyowat(i)
394 do j = 1,mxbd
395 ibd(j+1)=ibdat(j,i)
396 iybd(j+1)=iybdat(j,i)
397 enddo
398
399 do j=1,mxbd+1
400 if (ibd(j).gt.nfirp) ibd(j)=ibd(j)+nsh
401 enddo
402
403 iowat(ii)=ibd(1)
404 iyowat(ii)=iybd(1)
405 do j = 1,mxbd
406 ibdat(j,ii)=ibd(j+1)
407 iybdat(j,ii)=iybd(j+1)
408 enddo
409
410 ityat(ii)=ityat(i)
411 nmat(ii)=nmat(i)
412 cgat(ii)=cgat(i)
413 blat(ii)=blat(i)
414 baat(ii)=baat(i)
415 snbaat(ii)=snbaat(i)
416 csbaat(ii)=csbaat(i)
417 toat(ii)=toat(i)
418 sntoat(ii)=sntoat(i)
419 cstoat(ii)=cstoat(i)
420 xat(ii)=xat(i)
421 yat(ii)=yat(i)
422 zat(ii)=zat(i)
423 xtoat(ii)=xtoat(i)
424 ytoat(ii)=ytoat(i)
425 ztoat(ii)=ztoat(i)
426 xbaat(ii)=xbaat(i)
427 ybaat(ii)=ybaat(i)
428 zbaat(ii)=zbaat(i)
429
430 enddo
431! ____________________________________________ Shift residue data
432 do i=nrs+1,irsml2(ntlml)
433 iatrs1(i)=iatrs1(i)+nsh
434 iatrs2(i)=iatrs2(i)+nsh
435 ixatrs(i)=ixatrs(i)+nsh
436 enddo
437 iatrs2(nrs)=nla+nsh
438 if (nxt.gt.nlarp) ixatrs(nrs)=nxt+nsh
439 else
440 nsh=0
441 endif
442! _________________________________________ Correct data of 'nfirp'
443 ish=nfirp-nfisb
444 ityat(nfirp)=ityath(nfisb)
445
446 if(.not.sh2) cgat(nfirp)=cgath(nfisb) ! NOT for 'ECEPP/2'
447
448 nb=nbdath(nfisb) ! _______________ Bonds
449
450 do i=1,mxbd
451 ib=ibdath(i,nfisb)
452 if (ib.ne.0) then
453 ibd(i)=ib+ish
454 iybd(i)=iybdath(i,nfisb)
455 else
456 ibd(i)=0
457 iybd(i)=1
458 endif
459
460 enddo
461
462 if (ntbb) then
463
464 ibd(mxbd+1)=0
465 iybd(mxbd+1)=1
466
467 ibd(nb+1)=nxtbb1+nsh ! bond to next backbone atom
468 iybd(nb+1)=isgbb1
469
470 if (ibdrg.ne.0) then
471 nb=nb+1
472 if (nb.gt.mxbd) then
473 write (logString, '(6a,/,2a,3(i4,a))')
474 & ' rplgrp> Cannot add atoms following ',rpat,
475 & ' from group ',sbrs,' to atom ',rpat,
476 & ' of residue ',seq(nrs),nrs,' in molecule #',nml,
477 & ' because need >',(mxbd+1),' bonds'
478 stop
479 endif
480 ibd(nb+1)=ibdrg+nsh
481 iybd(nb+1)=iybdrg
482 endif
483 iowat(nfirp)=ibd(1)
484 iyowat(nfirp)=iybd(1)
485 do i=1,mxbd
486 ibdat(i,nfirp)=ibd(i+1)
487 iybdat(i,nfirp)=iybd(i+1)
488 enddo
489 else ! not 'ntbb'
490
491 do i=1,mxbd
492 ibdat(i,nfirp)=ibd(i)
493 iybdat(i,nfirp)=iybd(i)
494 enddo
495
496 endif
497 nbdat(nfirp)=nb
498! _________________________________________ Add data for substituent
499 ii=nfirp
500 do i=nfisb+1,nlasb
501 ii=ii+1
502 nbdat(ii)=nbdath(i)
503
504 iow=iowath(i)+ish
505 iowat(ii)=iow
506 iyowat(ii)=iyowath(i)
507
508 do j=1,mxbd
509 ib=ibdath(j,i)
510 if (ib.ge.nfisb) then
511 ibdat(j,ii)=ib+ish
512 else
513 ibdat(j,ii)=ib
514 endif
515 iybdat(j,ii)=iybdath(j,i)
516 enddo
517
518 ityat(ii)=ityath(i)
519 nmat(ii)=nmath(i)
520 cgat(ii)=cgath(i)
521 blat(ii)=blath(i)
522 ba=baath(i)
523 baat(ii)=ba
524 csbaat(ii)=cos(ba)
525 snbaat(ii)=sin(ba)
526 to=toath(i)
527 toat(ii)=to
528 cstoat(ii)=cos(to)
529 sntoat(ii)=sin(to)
530 call eyring(ii,iow)
531 if (ntbb) then ! reset some internal coordinates
532 if (iow.eq.nfirp) then
533 ba=valang(izero,nfirp,ii)
534 baat(ii)=ba
535 csbaat(ii)=cos(ba)
536 snbaat(ii)=sin(ba)
537 to=dihedr(-ione,izero,nfirp,ii)
538 toat(ii)=to
539 cstoat(ii)=cos(to)
540 sntoat(ii)=sin(to)
541 elseif (iowat(iow).eq.nfirp) then
542 to=dihedr(izero,nfirp,iow,ii)
543 toat(ii)=to
544 cstoat(ii)=cos(to)
545 sntoat(ii)=sin(to)
546 endif
547
548 endif ! ntbb
549
550 enddo ! substituent atoms
551! ___________________________________________________ Take care of Variables
552! (assume variables of replaced group/substituent to be stored CONSECUTIVELY)
553
554 ilavr=ivrml1(ntlml)+nvrml(ntlml)-1
555 ifivr=ivrrs1(nrs) ! variables to be replaced (#=ivrrp,last=lvrrp)
556 ivrrp=0
557 do i=ifivr,ifivr+nvrrs(nrs)-1
558 iat=iatvr(i)
559 if (nfirp.lt.iat.and.iat.le.nlarp) then
560 ivrrp=ivrrp+1
561 lvrrp=i
562 endif
563 enddo
564 if (ivrrp.eq.0) then ! No variables to replace
565 do i=ifivr,ilavr
566 if (iatvr(i).gt.nlarp) then
567 lvrrp=i-1
568 goto 6
569 endif
570 enddo
571 lvrrp=ilavr
572 endif
573 6 ivrsb=0 ! variables from substituent (#=ivrsb)
574 do i=1,nvrsb
575 iat=iatvrh(i)
576 if (nfisb.lt.iat.and.iat.le.nlasb) then
577 ity=ityvrh(i)
578 if (ntbb.and.iowath(iat).eq.nfisb.and.ity.gt.2) goto 7
579 ivrsb=ivrsb+1
580 nmvrh(ivrsb)=nmvrh(i)
581 ityvrh(ivrsb)=ityvrh(i)
582 iclvrh(ivrsb)=iclvrh(i)
583 iatvrh(ivrsb)=iat
584 endif
585 7 enddo
586 if (nsh.ne.0) then ! if # of atoms changed
587 do i=lvrrp+1,ilavr
588 iatvr(i)=iatvr(i)+nsh
589 enddo
590 endif
591
592 if (ivrrp.ne.ivrsb) then ! shift data for variables
593 jsh=ivrsb-ivrrp
594 if (ivrrp.gt.ivrsb) then
595 i1=lvrrp+1
596 i2=ilavr
597 i3=1
598 else
599 if ((ilavr+jsh).gt.mxvr) then
600 write (logString, '(a,i5)')
601 & ' rplgrp> number of variables > ',mxvr
602 stop
603 endif
604 i1=ilavr
605 i2=lvrrp+1
606 i3=-1
607 endif
608 do i=i1,i2,i3
609 ii=i+jsh
610 ityvr(ii)=ityvr(i)
611 iclvr(ii)=iclvr(i)
612 nmvr(ii)=nmvr(i)
613 iatvr(ii)=iatvr(i)
614 enddo
615
616 do i=nrs+1,irsml2(ntlml)
617 ivrrs1(i)=ivrrs1(i)+jsh
618 enddo
619 nvrrs(nrs)=nvrrs(nrs)+jsh
620 nvrml(nml)=nvrml(nml)+jsh
621 do i=nml+1,ntlml
622 ivrml1(i)=ivrml1(i)+jsh
623 enddo
624 endif
625 ii=lvrrp-ivrrp ! Add variables for substitutent
626 do i=1,ivrsb
627 ii=ii+1
628 nmvr(ii)=nmvrh(i)
629 ityvr(ii)=ityvrh(i)
630 iclvr(ii)=iclvrh(i)
631 iatvr(ii)=iatvrh(i)+ish
632 enddo
633
634 return
635! __________________________________________ Errors
636 10 write (logString, '(3a,/,2a,i4,a,i4,/,2a)')
637 & ' rplgrp> Cannot replace atom(s) following ',rpat,
638 & ' from INSIDE a ring',' in residue: ',seq(nrs),nrs,
639 & ' in molecule #',nml,' or in substitute: ',sbrs
640 stop
641 11 write (logString, '(4a,i4,a,i4,/,a)')
642 & ' rplgrp> Cannot replace atom(s) following ',rpat,
643 & ' of residue ',seq(nrs),nrs,' in molecule #',nml,
644 & ' since necessary 2 previous atoms are not available'
645 stop
646
647 end
648! ****************************************
649 subroutine redchg(nml,nrs,rpat,sbrs)
650
651! .........................................................
652! PURPOSE: read and place atomic point charges from residue
653! 'sbrs' to residue 'nrs' of molecule 'nml'
654! from library 'chglib' with LUN=lunchg, if ilib=1
655! 'reslib' with LUN=lunlib, if ilib=2
656!
657! CALLS: iopfil,iendst,tolost
658! ........................................................
659
660 include 'INCL.H'
661
662 character rpat*4,sbrs*4,atnm*4,res*4,cgty*5,line*100
663 integer nml, nrs
664
665 integer iopfil, iendst
666
667 integer ifirs, ilars, ifvr, ilib, i, l, j, nchg
668
669 ifirs=irsml1(nml)
670 ilars=irsml2(nml)
671 res=seq(nrs)
672 call tolost(res)
673
674 if (nrs.eq.ifirs.or.nrs.eq.ilars) then
675
676 if (rpat.eq.'n '.or.rpat.eq.'c ') then
677 if (nrs.eq.ifirs.and.nrs.eq.ilars) goto 10 ! Dont have this yet
678
679 if (rpat.eq.'n '.and.nrs.eq.ifirs) then
680 if (res(1:3).eq.'pro'.or.res(1:3).eq.'hyp') then
681 if (sbrs.eq.'nh1 ') cgty='n'//res
682 if (sbrs.eq.'nh2+') cgty='+'//res
683 else
684 if (sbrs.eq.'nh2 ') cgty='n'//res
685 if (sbrs.eq.'nh3+') cgty='+'//res
686 endif
687 elseif (rpat.eq.'c '.and.nrs.eq.ilars) then
688 if (sbrs.eq.'cooh') cgty='c'//res
689 if (sbrs.eq.'coo-') cgty='-'//res
690 else
691 goto 10
692 endif
693 else
694 write(logString,*)
695 & ' redchg> dont know which end goup is present'
696 stop
697 endif
698 ilib=1
699 else
700 cgty(1:)=sbrs
701 ilib=2
702 endif
703
704 if (ilib.eq.1) then
705
706 if (iopfil(lunchg,chgfil,'old','formatted').le.izero) then
707 write (logString, '(a,/,a,i3,2a)')
708 & ' redchg> ERROR opening library of charges:',
709 & ' LUN=',lunchg,' FILE=',chgfil(1:iendst(chgfil))
710 stop
711 endif
712
713 1 line=' '
714 read (lunchg,'(a)',end=3) line
715 l=iendst(line)
716
717 if (l.ge.10.and.line(1:1).eq.'#'.and.line(2:6).eq.cgty) then
718 read (line(7:10),'(i4)') nchg
719 if (nchg.le.mxath) then
720 read (lunchg,'(10(2x,a4,1x))') (nmath(i),i=1,nchg)
721 read (lunchg,'(10(f6.4,1x))') (cgath(i),i=1,nchg)
722 close(lunchg)
723 do i=iatrs1(nrs),iatrs2(nrs)
724 atnm=nmat(i)
725 do j=1,nchg
726 if (nmath(j).eq.atnm) then
727 cgat(i)=cgath(j)
728 goto 2
729 endif
730 enddo
731 write (logString, '(6a)') ' redchg> Cannot find atom: ',
732 & atnm,
733 & ' for entry: ',cgty,' in library: ',
734 & chgfil(1:iendst(chgfil))
735 stop
736 2 enddo
737 return
738 else
739 write (logString, '(4a)')
740 & ' redchg> must increase MXATH to read data for entry: ',
741 & cgty,' in library: ',chgfil(1:iendst(chgfil))
742 close(lunchg)
743 stop
744 endif
745 endif
746 goto 1
747 3 write (logString, '(4a)')
748 & ' redchg> Cannot find entry: ',cgty,' in library: ',
749 & chgfil(1:iendst(chgfil))
750 close(lunchg)
751 stop
752
753 elseif (ilib.eq.2) then
754
755 if (iopfil(lunlib,reslib,'old','formatted').le.izero) then
756 write (logString, '(a,/,a,i3,2a)')
757 & ' redchg> ERROR opening library of residues:',
758 & ' LUN=',lunlib,' FILE=',reslib(1:iendst(reslib))
759 stop
760 endif
761
762 4 line=' '
763 read (lunlib,'(a)',end=6) line
764 l=iendst(line)
765
766 if (l.ge.9.and.line(1:1).eq.'#'.and.line(2:5).eq.cgty(1:4)) then
767 read (line(6:9),'(i4)') nchg
768 if (nchg.le.mxath) then
769 read (lunlib,'(a4,42x,d7.4)') (nmath(i),cgath(i),i=1,nchg)
770 close(lunlib)
771 do i=iatrs1(nrs),iatrs2(nrs)
772 atnm=nmat(i)
773 do j=1,nchg
774 if (nmath(j).eq.atnm) then
775 cgat(i)=cgath(j)
776 goto 5
777 endif
778 enddo
779 write (logString, '(6a)') ' redchg> Cannot find atom: ',
780 & atnm,
781 & ' for entry: ',cgty,' in library: ',
782 & reslib(1:iendst(reslib))
783 stop
784 5 enddo
785 return
786 else
787 write (logString, '(4a)')
788 & ' redchg> must increase MXATH to read data for entry: ',
789 & cgty,' in library: ',reslib(1:iendst(reslib))
790 close(lunchg)
791 stop
792 endif
793 endif
794 goto 4
795 6 write (logString, '(4a)')
796 & ' redchg> Cannot find entry: ',cgty,' in library: ',
797 & reslib(1:iendst(reslib))
798 close(lunchg)
799 stop
800
801 endif
802
803 10 write (logString, '(4a)')
804 & ' redchg> Do not have charges for N/C-terminal residue ',
805 & res,' modified with group :',sbrs
806 stop
807
808 end
809
Note: See TracBrowser for help on using the repository browser.