source: setmvs.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: 16.0 KB
Line 
1!**************************************************************
2!
3! This file contains the subroutines: setmvs,fndbrn
4!
5! Copyright 2003-2005 Frank Eisenmenger, U.H.E. Hansmann,
6! Shura Hayryan, Chin-Ku
7! Copyright 2007 Frank Eisenmenger, U.H.E. Hansmann,
8! Jan H. Meinke, Sandipan Mohanty
9!
10! **************************************************************
11
12
13 subroutine setmvs(nml)
14
15! ......................................................................
16! PURPOSE: 1. ORDER variables according to rules:
17! variables with same base: 1st comes TORSION (can be only
18! one with this base, since PHASE a. assumed to be FIXED),
19! after this, for atoms branching from this base:
20! for a b.angle & b.length with common primary moving
21! atom=branch atom - b.angle comes 1st
22!
23! iorvr(i), i=i_fivr_ml,i_lavr_ml -> indices of ordered var.
24!
25! 2. define NON-OVERLAPPING moving sets of atoms in molecule
26! 'nml' related to local variables
27!
28! nmsml(i_ml) - number of moving sets per molecule
29! imsvr1(i_vr),imsvr2() - indices of 1st/last m.s for var. 'i_vr'
30! in 'latms1' & 'latms2'
31! latms1(i_ms),latms2() - range of atoms of i-th m.s
32!
33! 3. define indices of next-following variables for each var.,
34! which complete its physical moving set ('added' variables)
35!
36! nadml(i_ml) - number of 'added' var.s per molecule
37! iadvr1(i_vr),iadvr2() - indices of 1st/last 'added' var. for
38! var. 'i_vr' in 'ladvr'
39! ladvr() - indices of 'added' variables
40!
41! 4. define index of corresponding variable for each atom
42!
43! ! routine must be called successively for molecules 1 -> ntlml
44!
45! CALLS: fndbrn, nursvr
46! ......................................................................
47
48 include 'INCL.H'
49! ID of molecule
50 integer nml
51
52 integer nursvr
53
54 logical bb
55 integer mxh, lvw1h, lvw2h, l1h, l2h
56 parameter (mxh=10)
57 dimension lvw1h(mxh),lvw2h(mxh),l1h(mxh),l2h(mxh)
58
59 integer ifivr, i, i1, ia, ib, ic, ifirs, ifiat, ko, ilaat, ii,
60 & ilars, ilavr, io, ir, irg1, is, it, iv, j, k, j1, jns,
61 & j2, j1s, ja, jb, jv, jo, l, i2, irg2, n, nad, nms,
62 & ntlvr
63
64 ntlvr=nvrml(nml)
65
66 if (nml.eq.1) then
67 imsml1(1)=1
68 nms=0
69 iadml1(1)=1
70 nad=0
71 else
72 imsml1(nml)=imsml1(nml-1)+nmsml(nml-1)
73 nms=imsml1(nml)-1
74 iadml1(nml)=iadml1(nml-1)+nadml(nml-1)
75 nad=iadml1(nml)-1
76 endif
77
78 if (ntlvr.eq.0) then
79 write (logString, '(a,i4)')
80 & ' setmvs> No variables defined in molecule #',nml
81 nmsml(nml)=0
82 nadml(nml)=0
83 return
84 endif
85! _________________ Take index of primary atom for each variable
86! (i.e. index of atom moved by variable) to
87! sort variables, handling variables with same base:
88! modify indices to obtain appropriate order
89
90 ifirs=irsml1(nml)
91 ilars=irsml2(nml)
92
93 ifivr=ivrml1(nml)
94 ilavr=ifivr+ntlvr-1
95 ifiat=iatrs1(ifirs)
96 ilaat=iatrs2(ilars)
97
98 do n=ifirs,ilars ! ______________________ Residues
99 ib=ivrrs1(n)
100 do i=ib,ib+nvrrs(n)-1 ! _________________ Variables
101 ia=iatvr(i)
102 io=iowat(ia) ! ('ia' cannot be 1st atom of 'nml')
103 it=ityvr(i)
104 if (it.eq.3) then ! torsion
105 do j=1,nbdat(io)
106 ii=ibdat(j,io)
107 if (iowat(ii).eq.io) ia=min(ia,ii)
108 enddo
109 iadvr1(i)=ia*10
110 elseif (it.eq.2) then ! bond angle
111 iadvr1(i)=ia*10+1
112 elseif (it.eq.1) then ! bond length
113 iadvr1(i)=ia*10+2
114 endif
115 iorvr(i)=i ! (initialize for sorting)
116 enddo ! ... Variables
117 enddo ! ... Residues
118! ___________________________________ Sort variables in ascending order
119! (i.e. from start of molecule/base of branches)
120! array 'iorvr' gives indices of (1st,2nd, ... ,n-th) variables;
121! as can be found in arrays for variables (example: ityvr(iorvr())
122 k=ilavr
123 l=ifivr+ntlvr/2
124 ii=ifivr-1
125 1 if (l.gt.ifivr) then
126 l=l-1
127 io=iorvr(l)
128 n=iadvr1(io)
129 else
130 io=iorvr(k)
131 n=iadvr1(io)
132 iorvr(k)=iorvr(ifivr)
133 k=k-1
134 if (k.eq.ifivr) then
135 iorvr(k)=io
136 goto 2
137 endif
138 endif
139 i=l
140 j=l+l-ii
141 do while (j.le.k)
142! if (j.lt.k.and.iadvr1(iorvr(j)).lt.iadvr1(iorvr(j+1))) j=j+1
143 if (j.lt.k) then
144 if (iadvr1(iorvr(j)).lt.iadvr1(iorvr(j+1))) then
145 j = j + 1
146 end if
147 end if
148 if (n.lt.iadvr1(iorvr(j))) then
149 iorvr(i)=iorvr(j)
150 i=j
151 j=j+j-ii
152 else
153 j=k+1
154 endif
155 enddo
156 iorvr(i)=io
157 goto 1
158! ______________________________ Find non-overlapping ranges of atoms (moving
159! sets) for each variable
160 2 nms=imsml1(nml)-1
161
162 do io=ifivr,ilavr ! _____ Loop over variables in 'ascendent' order
163 iv=iorvr(io)
164 ir=nursvr(iv) ! residue for variable 'iv'
165 ia=iatvr(iv) ! primary mov. atom
166 ib=iowat(ia) ! base
167! __________________________ First, determine complete mov. set for 'iv'
168 it=ityvr(iv)
169 if (it.eq.3) then ! torsion
170 i1=0
171 do i=1,nbdat(ib)
172 j=ibdat(i,ib)
173 if (iowat(j).eq.ib) then ! excl. ring
174 call fndbrn(nml,ir,j,k,irg1,irg2,bb)
175 if (bb) k=ilaat
176 if (i1.ne.0) then ! combine ranges
177 if (j.gt.(i2+1).or.k.lt.(i1-1)) then
178 write (logString, '(3a,/,2a,i4,a,i3)')
179 & ' setmvs> Cannot combine disjunct ranges of atom',
180 & ' indices for torsion ',nmvr(iv),' in residue ',
181 & seq(ir),ir,' of molecule # ',nml
182 stop
183 else
184 if (j.lt.i1) i1=j
185 if (k.gt.i2) i2=k
186 endif
187 else
188 i1=j
189 i2=k
190 endif
191 endif
192 enddo
193 elseif (it.eq.2.or.it.eq.1) then ! b. angle, b. length
194 i1=ia
195 call fndbrn(nml,ir,i1,i2,irg1,irg2,bb)
196 if (bb) i2=ilaat
197 endif
198
199 if ((nms+1).gt.mxms) then
200 write (logString, '(a,i4,a,i5)') ' setmvs> Molecule # ',nml,
201 & ': Number of moving sets > ',mxms
202 stop
203 endif
204
205 imsvr1(iv)=nms+1 ! index of 1st
206 imsvr2(iv)=nms+1 ! & last m.s for var. 'iv'
207
208! ______________ Next, exclude overlaps between mov. set for 'iv' and the
209! m.s. for 'previous' variables by reducing/splitting those
210
211 do jo=ifivr,io-1 ! prev. variables ...
212 jv=iorvr(jo)
213
214 j1s=imsvr1(jv) ! index of 1st m.s. for 'jv'
215 jns=imsvr2(jv)-j1s+1 ! # of m.s. for 'jv'
216
217 j=j1s
218 do while (j.lt.(j1s+jns)) ! while there are m.s. for 'jv'
219 j1=latms1(j) ! 1st &
220 j2=latms2(j) ! last atom of m.s. 'j'
221 if (i1.le.j2.and.i2.ge.j1) then ! Overlap
222 ja=0
223 if (i1.gt.j1) then
224 if (i2.gt.j2) goto 6
225 ja=1
226 latms2(j)=i1-1
227 endif
228 if (i2.lt.j2) then
229 if (i1.lt.j1) goto 6
230 if (ja.gt.0) then ! +1 moving set
231 nms=nms+1
232 if (nms.gt.mxms) then
233 write (logString, '(a,i4,a,i5)')
234 & ' setmvs> Molecule # ',
235 & nml,': Number of moving sets > ',mxms
236 stop
237 endif
238 jns=jns+1
239 do k=nms,j+2,-1 ! shift ranges of m.s.
240 latms1(k)=latms1(k-1)
241 latms2(k)=latms2(k-1)
242 enddo
243 do ko=jo+1,io
244 k=iorvr(ko)
245 imsvr1(k)=imsvr1(k)+1
246 imsvr2(k)=imsvr2(k)+1
247 enddo
248 latms2(j+1)=j2
249 endif
250 latms1(j+ja)=i2+1
251 ja=ja+1
252 endif
253 if (ja.eq.0) then ! -1 moving set
254 nms=nms-1
255 jns=jns-1
256 do k=j,nms
257 latms1(k)=latms1(k+1)
258 latms2(k)=latms2(k+1)
259 enddo
260 do ko=jo+1,io
261 k=iorvr(ko)
262 imsvr1(k)=imsvr1(k)-1
263 imsvr2(k)=imsvr2(k)-1
264 enddo
265 else
266 j=j+ja
267 endif
268 else ! No overlap
269 j=j+1
270 endif
271 enddo ! mov. sets for 'jv'
272 imsvr2(jv)=j1s+jns-1
273
274 enddo ! prev. variables
275! _______________________________ Finally, add moving set for 'iv'
276 nms=nms+1
277 latms1(nms)=i1
278 latms2(nms)=i2
279 enddo ! variables
280 nmsml(nml)=nms-imsml1(nml)+1
281! _____________________________ Determine index of moving set for each atom
282 do ia=ifiat,ilaat
283 ixmsat(ia)=0
284 enddo
285 do is=imsml1(nml),nms
286 do ia=latms1(is),latms2(is)
287 ixmsat(ia)=is
288 enddo
289 enddo
290! _____________________________ Determine indices of variables which moving
291! set sets have to be added (=are related) to
292! those of a given variable
293
294 i=iorvr(ifivr) ! initialize index of CURRENT var.
295 ii=imsvr1(i) ! -"- index of its 1st m.s
296
297 do io=ifivr,ilavr-1 ! ________ loop over variables
298
299 ic=i ! save index of CURRENT var.
300 ia=iatvr(i) ! ist primar.mv.atom
301 ib=iowat(ia) ! its base
302 it=ityvr(i) ! its type
303 is=ii ! index of its 1st m.s
304
305 n=nad+1
306 iadvr1(i)=n ! # of its 1st 'added' var.
307
308 i=iorvr(io+1) ! index of next-in-order var.
309 ii=imsvr1(i) ! index of its 1st m.s
310
311 do jo=io+1,ilavr ! ______ over following-in-order var.
312 j=iorvr(jo) ! index of var.
313 ja=iatvr(j) ! its prim.mv.at
314 jb=iowat(ja) ! its base
315
316! _______________ current var. is torsion & shares base with var. 'j'
317 if (it.eq.3.and.jb.eq.ib) then
318 do k=n,nad ! ? has this branch been registered before ?
319 if (iatvr(ladvr(k)).eq.ja) goto 3
320 enddo
321 nad=nad+1
322 if (nad.gt.mxvr) then
323 write (logString, '(a,i4,a,i5)') ' setmvs> Molecule # ',
324 & nml,
325 & ': Number of added variables > ',mxvr
326 stop
327 endif
328 ladvr(nad)=j ! save index of 'added' variable
329 endif
330
331 3 if (is.lt.ii) then ! _____ current var. has any m.s:
332 do k=is,ii-1 ! ? base of var. 'j' within m.s ?
333 if (latms1(k).le.jb.and.jb.le.latms2(k)) then
334 do l=n,nad
335 if (iatvr(ladvr(l)).eq.ja) goto 4
336 enddo
337 nad=nad+1
338 if (nad.gt.mxvr) then
339 write (logString, '(a,i4,a,i5)')
340 & ' setmvs> Molecule # ',nml,
341 & ': Number of added variables > ',mxvr
342 stop
343 endif
344 ladvr(nad)=j
345 endif
346 4 enddo
347 else ! _____ current var. has no m.s:
348 if (ja.eq.ia) then ! ? share prim.mv.at with var. 'j' ?
349 do k=n,nad
350 if (iatvr(ladvr(k)).eq.ja) goto 5
351 enddo
352 nad=nad+1
353 if (nad.gt.mxvr) then
354 write (logString, '(a,i4,a,i5)') ' setmvs> Molecule # ',
355 & nml,
356 & ': Number of added variables > ',mxvr
357 stop
358 endif
359 ladvr(nad)=j
360 endif
361 endif
362 5 enddo ! ... following-in-order variables
363 iadvr2(ic)=nad ! last 'added' var. for current var.
364 enddo ! ... variables
365
366 iadvr1(i)=nad+1 ! don't forget last variable
367 iadvr2(i)=nad
368
369 nadml(nml)=nad-iadml1(nml)+1
370! _____________________________________ Summary
371! do io=ilavr,ifivr,-1
372! iv=iorvr(io)
373! ib=iowat(iatvr(iv))
374! i1s=imsvr1(iv)
375! i2s=imsvr2(iv)
376! if (i1s.le.i2s) then
377! do i=i1s,i2s
378! i1=latms1(i)
379! i2=latms2(i)
380! if (i.eq.i1s) then
381! write (logString, '(a,i3,7a,i4,3a,i4,a)') 'res # ',nursvr(iv),
382! # ' var: ',nmvr(iv),' base:',nmat(ib),' atoms= ',
383! # nmat(i1),'(',i1,') - ',nmat(i2),'(',i2,')'
384! else
385! write (logString, '(39x,2a,i4,3a,i4,a)')
386! # nmat(i1),'(',i1,') - ',nmat(i2),'(',i2,')'
387! endif
388! enddo
389! else
390! write (logString, '(a,i3,5a)') 'res # ',nursvr(iv),
391! # ' var: ',nmvr(iv),' base:',nmat(ib),' No atoms'
392! endif
393! i1a=iadvr1(iv)
394! i2a=iadvr2(iv)
395! if (i1a.le.i2a) then
396! write (logString, '(a,30(1x,a))') ' Depending variables:',
397! # (nmvr(ladvr(i)),i=i1a,i2a)
398! else
399! write (logString, '(a)') ' No dep. variables'
400! endif
401! enddo
402! _____________________________________ Summary - End
403
404 return
405
406 6 write (logString, '(a,i4,/,2(a,i5),a)')
407 & ' setmvs> Error in atom numbering of molecule # ',nml,
408 & ': atom ranges for variables # ',iv,' and # ',jv,
409 & ' overlap only PARTLY'
410 stop
411
412 end
413! *******************************************************
414 subroutine fndbrn(nml,nrs,ifirg,ilarg,irg1,irg2,bb)
415
416! .........................................................
417! PURPOSE: determine range [ifirg,ilarg] of atom indices
418! for branch starting from atom 'ifirg' of residue
419! 'nrs' in molecule 'nml'
420! OUTPUT: BB - .t. if 'ifirg' is a backbone atom
421! IRG1 & IRG2 - atom indices of ring-closing bond,
422! if 'ifirg' is INSIDE a ring, but NOT
423! its 1st atom ( in 'multiple' rings
424! only LAST closing bond is given !)
425!
426! CALLS: none
427!
428! .........................................................
429
430 include 'INCL.H'
431
432 integer nml, nrs, ifirg, ilarg, irg1, irg2
433
434 logical bb
435 integer ibd
436 dimension ibd(4)
437
438 integer i, ib, ila, ifi, il, ixt, k, j, jb
439
440 ilarg=ifirg
441
442 bb=.false.
443 irg1=0
444
445 ifi=iatrs1(nrs)
446 ila=iatrs2(nrs)
447 ixt=ixatrs(nrs)
448
449 if (ifirg.eq.ifi) then ! = 1st mainchain atom
450 bb=.true.
451 if (nrs.ne.irsml1(nml)) then
452 ilarg=ila
453 else ! 1st residue of 'nml'
454
455 ibd(1)=iowat(ifirg)
456 ibd(2)=ibdat(1,ifirg)
457 ibd(3)=ibdat(2,ifirg)
458 ibd(4)=ibdat(3,ifirg)
459
460 il=0
461 do i=1,nbdat(ifirg)+1
462 ib=ibd(i)
463 if (ib.gt.il.and.iowat(ib).eq.ifirg) il=ib
464 enddo
465 if (il.gt.0) ilarg=il-1
466 endif
467 else
468 if (ifirg.eq.ixt) bb=.true.
469 do i=1,nbdat(ifirg) ! ______________ check bonds
470 ib=ibdat(i,ifirg)
471 if (iowat(ib).eq.ifirg) then ! branch
472 do j=ib,ila
473 if (j.gt.ib.and.iowat(j).lt.ib) goto 1
474 if (j.eq.ixt) bb=.true.
475 do k=1,nbdat(j)
476 jb=ibdat(k,j)
477 if (jb.lt.ifirg) then ! ring
478 irg1=j
479 irg2=jb
480 endif
481 enddo
482 ilarg=j
483 enddo ! ... branch atoms
484 elseif (ib.lt.ifirg) then ! ring
485 irg1=ifirg
486 irg2=ib
487 endif
488 1 enddo ! ... bonds
489 endif
490
491 return
492 end
493
Note: See TracBrowser for help on using the repository browser.