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
RevLine 
[bd2278d]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! **************************************************************
[e40e335]11
12
13 subroutine setmvs(nml)
14
[bd2278d]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! ......................................................................
[e40e335]47
48 include 'INCL.H'
[cb47b9c]49! ID of molecule
50 integer nml
[e40e335]51
[cb47b9c]52 integer nursvr
[e40e335]53
[cb47b9c]54 logical bb
55 integer mxh, lvw1h, lvw2h, l1h, l2h
[e40e335]56 parameter (mxh=10)
57 dimension lvw1h(mxh),lvw2h(mxh),l1h(mxh),l2h(mxh)
58
[cb47b9c]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
[e40e335]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
[38d77eb]79 write (logString, '(a,i4)')
[bd2278d]80 & ' setmvs> No variables defined in molecule #',nml
[e40e335]81 nmsml(nml)=0
82 nadml(nml)=0
83 return
84 endif
[bd2278d]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
[e40e335]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
[bd2278d]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())
[e40e335]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)
[4e219a3]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
[e40e335]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
[bd2278d]158! ______________________________ Find non-overlapping ranges of atoms (moving
159! sets) for each variable
[e40e335]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
[bd2278d]167! __________________________ First, determine complete mov. set for 'iv'
[e40e335]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
[38d77eb]178 write (logString, '(3a,/,2a,i4,a,i3)')
[bd2278d]179 & ' setmvs> Cannot combine disjunct ranges of atom',
180 & ' indices for torsion ',nmvr(iv),' in residue ',
181 & seq(ir),ir,' of molecule # ',nml
[e40e335]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
[38d77eb]200 write (logString, '(a,i4,a,i5)') ' setmvs> Molecule # ',nml,
[bd2278d]201 & ': Number of moving sets > ',mxms
[e40e335]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
[bd2278d]208! ______________ Next, exclude overlaps between mov. set for 'iv' and the
209! m.s. for 'previous' variables by reducing/splitting those
[e40e335]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
[38d77eb]233 write (logString, '(a,i4,a,i5)')
234 & ' setmvs> Molecule # ',
[bd2278d]235 & nml,': Number of moving sets > ',mxms
[e40e335]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
[bd2278d]275! _______________________________ Finally, add moving set for 'iv'
[e40e335]276 nms=nms+1
277 latms1(nms)=i1
278 latms2(nms)=i2
279 enddo ! variables
280 nmsml(nml)=nms-imsml1(nml)+1
[bd2278d]281! _____________________________ Determine index of moving set for each atom
[e40e335]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
[bd2278d]290! _____________________________ Determine indices of variables which moving
291! set sets have to be added (=are related) to
292! those of a given variable
[e40e335]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
[bd2278d]316! _______________ current var. is torsion & shares base with var. 'j'
[e40e335]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
[38d77eb]323 write (logString, '(a,i4,a,i5)') ' setmvs> Molecule # ',
324 & nml,
[bd2278d]325 & ': Number of added variables > ',mxvr
[e40e335]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
[38d77eb]339 write (logString, '(a,i4,a,i5)')
340 & ' setmvs> Molecule # ',nml,
[bd2278d]341 & ': Number of added variables > ',mxvr
[e40e335]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
[38d77eb]354 write (logString, '(a,i4,a,i5)') ' setmvs> Molecule # ',
355 & nml,
[bd2278d]356 & ': Number of added variables > ',mxvr
[e40e335]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
[bd2278d]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
[38d77eb]381! write (logString, '(a,i3,7a,i4,3a,i4,a)') 'res # ',nursvr(iv),
[bd2278d]382! # ' var: ',nmvr(iv),' base:',nmat(ib),' atoms= ',
383! # nmat(i1),'(',i1,') - ',nmat(i2),'(',i2,')'
384! else
[38d77eb]385! write (logString, '(39x,2a,i4,3a,i4,a)')
[bd2278d]386! # nmat(i1),'(',i1,') - ',nmat(i2),'(',i2,')'
387! endif
388! enddo
389! else
[38d77eb]390! write (logString, '(a,i3,5a)') 'res # ',nursvr(iv),
[bd2278d]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
[38d77eb]396! write (logString, '(a,30(1x,a))') ' Depending variables:',
[bd2278d]397! # (nmvr(ladvr(i)),i=i1a,i2a)
398! else
[38d77eb]399! write (logString, '(a)') ' No dep. variables'
[bd2278d]400! endif
401! enddo
402! _____________________________________ Summary - End
[e40e335]403
404 return
405
[38d77eb]406 6 write (logString, '(a,i4,/,2(a,i5),a)')
[bd2278d]407 & ' setmvs> Error in atom numbering of molecule # ',nml,
408 & ': atom ranges for variables # ',iv,' and # ',jv,
409 & ' overlap only PARTLY'
[e40e335]410 stop
411
412 end
[bd2278d]413! *******************************************************
[e40e335]414 subroutine fndbrn(nml,nrs,ifirg,ilarg,irg1,irg2,bb)
415
[bd2278d]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! .........................................................
[e40e335]429
430 include 'INCL.H'
431
[cb47b9c]432 integer nml, nrs, ifirg, ilarg, irg1, irg2
433
[e40e335]434 logical bb
[cb47b9c]435 integer ibd
[e40e335]436 dimension ibd(4)
437
[cb47b9c]438 integer i, ib, ila, ifi, il, ixt, k, j, jb
439
[e40e335]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.