source: setmvs.f@ 32289cd

Last change on this file since 32289cd was cb47b9c, checked in by baerbaer <baerbaer@…>, 15 years ago

Explicitly declare variables.

All variables should be declared so that we can remove the implicit statements
from the beginning of the INCL.H file.

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

  • Property mode set to 100644
File size: 15.7 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
79 write (*,'(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
178 write (*,'(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
200 write (*,'(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
233 write (*,'(a,i4,a,i5)') ' setmvs> Molecule # ',
[bd2278d]234 & nml,': Number of moving sets > ',mxms
[e40e335]235 stop
236 endif
237 jns=jns+1
238 do k=nms,j+2,-1 ! shift ranges of m.s.
239 latms1(k)=latms1(k-1)
240 latms2(k)=latms2(k-1)
241 enddo
242 do ko=jo+1,io
243 k=iorvr(ko)
244 imsvr1(k)=imsvr1(k)+1
245 imsvr2(k)=imsvr2(k)+1
246 enddo
247 latms2(j+1)=j2
248 endif
249 latms1(j+ja)=i2+1
250 ja=ja+1
251 endif
252 if (ja.eq.0) then ! -1 moving set
253 nms=nms-1
254 jns=jns-1
255 do k=j,nms
256 latms1(k)=latms1(k+1)
257 latms2(k)=latms2(k+1)
258 enddo
259 do ko=jo+1,io
260 k=iorvr(ko)
261 imsvr1(k)=imsvr1(k)-1
262 imsvr2(k)=imsvr2(k)-1
263 enddo
264 else
265 j=j+ja
266 endif
267 else ! No overlap
268 j=j+1
269 endif
270 enddo ! mov. sets for 'jv'
271 imsvr2(jv)=j1s+jns-1
272
273 enddo ! prev. variables
[bd2278d]274! _______________________________ Finally, add moving set for 'iv'
[e40e335]275 nms=nms+1
276 latms1(nms)=i1
277 latms2(nms)=i2
278 enddo ! variables
279 nmsml(nml)=nms-imsml1(nml)+1
[bd2278d]280! _____________________________ Determine index of moving set for each atom
[e40e335]281 do ia=ifiat,ilaat
282 ixmsat(ia)=0
283 enddo
284 do is=imsml1(nml),nms
285 do ia=latms1(is),latms2(is)
286 ixmsat(ia)=is
287 enddo
288 enddo
[bd2278d]289! _____________________________ Determine indices of variables which moving
290! set sets have to be added (=are related) to
291! those of a given variable
[e40e335]292
293 i=iorvr(ifivr) ! initialize index of CURRENT var.
294 ii=imsvr1(i) ! -"- index of its 1st m.s
295
296 do io=ifivr,ilavr-1 ! ________ loop over variables
297
298 ic=i ! save index of CURRENT var.
299 ia=iatvr(i) ! ist primar.mv.atom
300 ib=iowat(ia) ! its base
301 it=ityvr(i) ! its type
302 is=ii ! index of its 1st m.s
303
304 n=nad+1
305 iadvr1(i)=n ! # of its 1st 'added' var.
306
307 i=iorvr(io+1) ! index of next-in-order var.
308 ii=imsvr1(i) ! index of its 1st m.s
309
310 do jo=io+1,ilavr ! ______ over following-in-order var.
311 j=iorvr(jo) ! index of var.
312 ja=iatvr(j) ! its prim.mv.at
313 jb=iowat(ja) ! its base
314
[bd2278d]315! _______________ current var. is torsion & shares base with var. 'j'
[e40e335]316 if (it.eq.3.and.jb.eq.ib) then
317 do k=n,nad ! ? has this branch been registered before ?
318 if (iatvr(ladvr(k)).eq.ja) goto 3
319 enddo
320 nad=nad+1
321 if (nad.gt.mxvr) then
322 write (*,'(a,i4,a,i5)') ' setmvs> Molecule # ',nml,
[bd2278d]323 & ': Number of added variables > ',mxvr
[e40e335]324 stop
325 endif
326 ladvr(nad)=j ! save index of 'added' variable
327 endif
328
329 3 if (is.lt.ii) then ! _____ current var. has any m.s:
330 do k=is,ii-1 ! ? base of var. 'j' within m.s ?
331 if (latms1(k).le.jb.and.jb.le.latms2(k)) then
332 do l=n,nad
333 if (iatvr(ladvr(l)).eq.ja) goto 4
334 enddo
335 nad=nad+1
336 if (nad.gt.mxvr) then
337 write (*,'(a,i4,a,i5)') ' setmvs> Molecule # ',nml,
[bd2278d]338 & ': Number of added variables > ',mxvr
[e40e335]339 stop
340 endif
341 ladvr(nad)=j
342 endif
343 4 enddo
344 else ! _____ current var. has no m.s:
345 if (ja.eq.ia) then ! ? share prim.mv.at with var. 'j' ?
346 do k=n,nad
347 if (iatvr(ladvr(k)).eq.ja) goto 5
348 enddo
349 nad=nad+1
350 if (nad.gt.mxvr) then
351 write (*,'(a,i4,a,i5)') ' setmvs> Molecule # ',nml,
[bd2278d]352 & ': Number of added variables > ',mxvr
[e40e335]353 stop
354 endif
355 ladvr(nad)=j
356 endif
357 endif
358 5 enddo ! ... following-in-order variables
359 iadvr2(ic)=nad ! last 'added' var. for current var.
360 enddo ! ... variables
361
362 iadvr1(i)=nad+1 ! don't forget last variable
363 iadvr2(i)=nad
364
365 nadml(nml)=nad-iadml1(nml)+1
[bd2278d]366! _____________________________________ Summary
367! do io=ilavr,ifivr,-1
368! iv=iorvr(io)
369! ib=iowat(iatvr(iv))
370! i1s=imsvr1(iv)
371! i2s=imsvr2(iv)
372! if (i1s.le.i2s) then
373! do i=i1s,i2s
374! i1=latms1(i)
375! i2=latms2(i)
376! if (i.eq.i1s) then
377! write (*,'(a,i3,7a,i4,3a,i4,a)') 'res # ',nursvr(iv),
378! # ' var: ',nmvr(iv),' base:',nmat(ib),' atoms= ',
379! # nmat(i1),'(',i1,') - ',nmat(i2),'(',i2,')'
380! else
381! write (*,'(39x,2a,i4,3a,i4,a)')
382! # nmat(i1),'(',i1,') - ',nmat(i2),'(',i2,')'
383! endif
384! enddo
385! else
386! write (*,'(a,i3,5a)') 'res # ',nursvr(iv),
387! # ' var: ',nmvr(iv),' base:',nmat(ib),' No atoms'
388! endif
389! i1a=iadvr1(iv)
390! i2a=iadvr2(iv)
391! if (i1a.le.i2a) then
392! write (*,'(a,30(1x,a))') ' Depending variables:',
393! # (nmvr(ladvr(i)),i=i1a,i2a)
394! else
395! write (*,'(a)') ' No dep. variables'
396! endif
397! enddo
398! _____________________________________ Summary - End
[e40e335]399
400 return
401
402 6 write (*,'(a,i4,/,2(a,i5),a)')
[bd2278d]403 & ' setmvs> Error in atom numbering of molecule # ',nml,
404 & ': atom ranges for variables # ',iv,' and # ',jv,
405 & ' overlap only PARTLY'
[e40e335]406 stop
407
408 end
[bd2278d]409! *******************************************************
[e40e335]410 subroutine fndbrn(nml,nrs,ifirg,ilarg,irg1,irg2,bb)
411
[bd2278d]412! .........................................................
413! PURPOSE: determine range [ifirg,ilarg] of atom indices
414! for branch starting from atom 'ifirg' of residue
415! 'nrs' in molecule 'nml'
416! OUTPUT: BB - .t. if 'ifirg' is a backbone atom
417! IRG1 & IRG2 - atom indices of ring-closing bond,
418! if 'ifirg' is INSIDE a ring, but NOT
419! its 1st atom ( in 'multiple' rings
420! only LAST closing bond is given !)
421!
422! CALLS: none
423!
424! .........................................................
[e40e335]425
426 include 'INCL.H'
427
[cb47b9c]428 integer nml, nrs, ifirg, ilarg, irg1, irg2
429
[e40e335]430 logical bb
[cb47b9c]431 integer ibd
[e40e335]432 dimension ibd(4)
433
[cb47b9c]434 integer i, ib, ila, ifi, il, ixt, k, j, jb
435
[e40e335]436 ilarg=ifirg
437
438 bb=.false.
439 irg1=0
440
441 ifi=iatrs1(nrs)
442 ila=iatrs2(nrs)
443 ixt=ixatrs(nrs)
444
445 if (ifirg.eq.ifi) then ! = 1st mainchain atom
446 bb=.true.
447 if (nrs.ne.irsml1(nml)) then
448 ilarg=ila
449 else ! 1st residue of 'nml'
450
451 ibd(1)=iowat(ifirg)
452 ibd(2)=ibdat(1,ifirg)
453 ibd(3)=ibdat(2,ifirg)
454 ibd(4)=ibdat(3,ifirg)
455
456 il=0
457 do i=1,nbdat(ifirg)+1
458 ib=ibd(i)
459 if (ib.gt.il.and.iowat(ib).eq.ifirg) il=ib
460 enddo
461 if (il.gt.0) ilarg=il-1
462 endif
463 else
464 if (ifirg.eq.ixt) bb=.true.
465 do i=1,nbdat(ifirg) ! ______________ check bonds
466 ib=ibdat(i,ifirg)
467 if (iowat(ib).eq.ifirg) then ! branch
468 do j=ib,ila
469 if (j.gt.ib.and.iowat(j).lt.ib) goto 1
470 if (j.eq.ixt) bb=.true.
471 do k=1,nbdat(j)
472 jb=ibdat(k,j)
473 if (jb.lt.ifirg) then ! ring
474 irg1=j
475 irg2=jb
476 endif
477 enddo
478 ilarg=j
479 enddo ! ... branch atoms
480 elseif (ib.lt.ifirg) then ! ring
481 irg1=ifirg
482 irg2=ib
483 endif
484 1 enddo ! ... bonds
485 endif
486
487 return
488 end
489
Note: See TracBrowser for help on using the repository browser.