source: redvar.f@ 32289cd

Last change on this file since 32289cd was cb47b9c, checked in by baerbaer <baerbaer@…>, 14 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: 21.8 KB
Line 
1!**************************************************************
2!
3! This file contains the subroutines: redvar
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 redvar
14
15! ...................................................................
16!
17! PURPOSE: Read global parameters for molecules from lines
18!
19! +--------------------------------------------------+
20! |@ molecule no. : six floats separated by commas |
21! +--------------------------------------------------+
22!
23! NB: 1) if omit field with molecule no. assume: nml=1
24! 2) last 3 float are angles in deg.
25!
26! Read and interpret file to SET and FIX internal variables
27! by commands:
28!
29! +-----------------------------------------+
30! | molecule : residue : variable : value |
31! +-----------------------------------------+
32!
33! * Lines containing '&' assign FIXED variable(s), they will
34! not be varied during subsequent minimization etc.
35!
36! * Empty LINES or lines containing '#' are ignored
37! * Several commands on same line must be separated by ';'
38! * Empty COMMANDS, i.e. ' : : ' are ignored
39! * All spaces are not significant and are therefore ignored
40!
41! * A command consists of up to 4 (maxfld) fields, separated
42! by ':'
43!
44! - last field : value for VARIABLE (REAL)
45! ! should never be empty
46! - 1st before last: name(s) (CHAR) or index(ices) of VARIABLE(S)
47! - 2nd before last: name(s) or index(ices) of RESIDUE(S)
48! - 3rd before last: name or number(ices) of MOLECULE(S)
49!
50! * molecules, residues, variables can be identified, either by,
51! INDICES (zones 'n1-n2' possible) or NAMES
52!
53! * several identifiers in a field can be separated by ','
54!
55! * INDICES: for residues - refer to numbering within molecule
56! : for variables - refer to numbering within residue
57! * ZONES: '-n2' indicates '1-n2'
58! 'n1-' indicates 'n1-(all)'
59! * NAMES or their ends can be indicated by wild-card '*'
60! are case-sensitive
61!
62! Example: phi:-65; psi:-45 >set all phi=-65, all psi=-45
63! om*: 180 & >set all omg, omt ... to 180 & fix them
64! 5 : x* : -60 >set all xi-angles of residue 5 to 60
65!
66! CALLS: setvar,extstr,iendst,ibegst,iopfil,iredin,iredrl
67! ......................................................................
68
69
70 include 'INCL.H'
71
72! functions
73 integer iopfil, iendst, iredin, iredrl, ibegst
74! maxfld: max. # of fields in one command
75! maxide: max. # of identifiers in a field
76! maxcmd: max. # of commands to be interpreted
77! ilrg: a large integer
78
79 integer maxfld, maxide, maxcmd, ilrg, ifdend, icb, i, ib, ibz
80 integer ife, ifb, ide, id, ice, ie, ieh, ieh1, iez, ihz, ifx, ifld
81 integer ile, ii, ihy, ilb, iml, it, in ,io, inum, kbz, iv, ity, jb
82 integer j, k, l, kez, kk, kv, lez, lbz,ll, ll1, ll2, n, nfi, ncmd
83 integer nfld, nide, nml, ntlvr
84 double precision vlvrx, rn, vr, val
85 parameter (maxfld=4,
86 & maxide=30,
87 & maxcmd=5000,
88 & ilrg=1000000)
89
90 character spcm,spfd,spcc,sphy,cmt,wdc,sfix,blnk, sglp,
91 & line*132,lincmd*132,linfld(maxfld)*132,linide*132,
92 & linh*132,strg(6)*17
93 dimension ifdend(maxfld),vlvrx(mxvr),rn(6)
94 logical fix,did,exa,forml(mxml),forrs(mxrs),forvr(mxvr),
95 & stvr(mxvr)
96 data spcm/';'/,spfd/':'/,spcc/','/,sphy/'-'/,cmt/'#'/,wdc/'*'/,
97 & sfix/'&'/,blnk/' '/, sglp/'@'/
98
99
100! ___________________________________ Checks
101 ntlvr=ivrml1(ntlml)+nvrml(ntlml)-1
102 if (ntlvr.eq.0) then
103 write (*,*) ' redvar> No variables defined in molecule(s)'
104 return
105 endif
106! ___________________________________ Initialize
107
108 io=iopfil(lunvar,varfil,'old','formatted')
109 if (io.eq.0) then
110 write (*,'(a,/,a,i3,2a)')
111 & ' redvar> ERROR opening file to set variables:',
112 & ' LUN=',lunvar,' FILE=',varfil(1:iendst(varfil))
113 stop
114 elseif (io.eq.-1) then
115 return
116 endif
117! ___________________________________ Initialization
118 do i=1,ntlml
119 forml(i)=.true.
120 do j=irsml1(i),irsml2(i)
121 forrs(j)=.true.
122 enddo
123 enddo
124
125 do i=1,ntlvr
126 fxvr(i)=.false.
127 forvr(i)=.true.
128 stvr(i)=.false.
129
130 it=ityvr(i) ! var. type
131 if (it.eq.3) then ! torsion
132 vr=toat(iatvr(i))
133 elseif (it.eq.2) then ! b.angle
134 vr=baat(iatvr(i))
135 elseif (it.eq.1) then ! b.length
136 vr=blat(iatvr(i))
137 else
138 write(*,*) 'redvar> unknown variable type: ',it,' !'
139 stop
140 endif
141 vlvrx(i)=vr
142 enddo
143
144 ncmd=0
145
146 1 read (lunvar,'(a)',end=2) line
147 ile=iendst(line)
148! _________________________________ ! ignore empty and commentary lines
149 if (ile.gt.0.and.index(line(1:ile),cmt).le.0) then
150
151! _________________________________________ Global variables
152 ilb = index(line(1:ile),sglp)+1
153 if (ilb.ge.2) then
154
155 if (index(line(ilb:ile),spfd).gt.0) then ! field with mol.#
156
157 call extstr(spfd,ilb,ile,line,lincmd,l)
158
159 if (iredin(lincmd,nml).le.0.or.
160 & nml.le.0.or.nml.gt.ntlml) then
161 write (*,*) 'redvar> ','Incorrect molecule number >',
162 & lincmd(1:l),'< Must be in range [1,',
163 & ntlml,'] !'
164 close(lunvar)
165 stop
166 endif
167
168 else
169 nml = 1 ! assume mol. #1
170 endif
171
172 l=ile-ilb+1
173 if (l.le.0) goto 105
174 lincmd=blnk
175 lincmd(1:l)=line(ilb:ile)
176
177 k = 1
178 do i = 1,5 ! try to read 5 parameters
179 call extstr(spcc,k,l,lincmd,linh,n)
180 if (k.gt.l.or.iredrl(linh,rn(i)).le.0) goto 105
181 enddo
182
183 n=l-k+1 ! try 6th parameter
184 if (n.le.0) goto 105
185 linh=blnk
186 linh(1:n)=lincmd(k:l)
187 if (iredrl(linh,rn(6)).le.0) goto 105
188
189! ---------------------------------------- check global angles
190 if ( abs(rn(4)).gt.(1.8d2+1d-6)
191 & .or. abs(rn(5)).gt.(9d1+1d-6)
192 & .or. abs(rn(6)).gt.(1.8d2+1d-6)
193 & ) goto 106
194
195 do i = 1,3
196 gbpr(i,nml) = rn(i)
197 enddo
198 do i = 4,6
199 gbpr(i,nml) = rn(i)*cdr
200 enddo
201
202 goto 1
203
204 endif ! global vars
205
206
207 ilb=1
208
209 do while (ilb.le.ile) ! ________________________ Commands
210 call extstr(spcm,ilb,ile,line,lincmd,ice)
211
212 if (ice.gt.0) then ! ignore empty commands
213 ncmd=ncmd+1
214 if (ncmd.gt.maxcmd) goto 101
215
216 ifx=index(lincmd(1:ice),sfix)
217 if (ifx.gt.0) then ! check for commands to fix variables
218 fix=.true.
219 lincmd(ifx:ifx)=blnk
220 if (ifx.eq.ice) then
221 ice=ice-1
222 if (ice.eq.0) then ! fix all
223 ice=1
224 lincmd(1:1)=wdc
225 endif
226 endif
227 else
228 fix=.false.
229 endif
230
231! _________________________________________ Extract Command Fields
232 nfld=0
233 icb=1
234 do while (icb.le.ice)
235 nfld=nfld+1
236 if (nfld.gt.maxfld) goto 100
237 call extstr(spfd,icb,ice,lincmd,linfld(nfld),ifdend(nfld))
238
239 if (ifdend(nfld).le.0) then ! empty field means 'all'
240 linfld(nfld)(1:1)=wdc
241 ifdend(nfld)=1
242 endif
243
244 enddo
245! _______________________________ Interpret Command Fields (except last)
246 do i=1,nfld-1
247 ii=i
248 ifld=nfld-i
249
250 if (ifld.eq.3) then ! Initialize Molecules
251 do j=1,ntlml
252 forml(j)=.false.
253 enddo
254 elseif (ifld.eq.2) then ! Initialize Residues
255 do j=1,ntlml
256 do k=irsml1(j),irsml2(j)
257 forrs(k)=.false.
258 enddo
259 enddo
260 elseif (ifld.eq.1) then ! Initialize Variables
261 do j=1,ntlvr
262 forvr(j)=.false.
263 enddo
264 endif
265! __________________________________ Identifiers in field
266 nide=0
267 ifb=1
268 ife=ifdend(i)
269 do while (ifb.le.ife)
270 nide=nide+1
271 if (nide.gt.maxide) goto 103
272 call extstr(spcc,ifb,ife,linfld(ii),linide,ide)
273 if (ide.le.0.or.linide(1:1).eq.wdc) then ! ... All
274 if (ifld.eq.3) then ! Mol.
275 do j=1,ntlml
276 forml(j)=.true.
277 enddo
278 elseif (ifld.eq.2) then ! Res.
279 do j=1,ntlml
280 if (forml(j)) then
281 do k=irsml1(j),irsml2(j)
282 forrs(k)=.true.
283 enddo
284 endif
285 enddo
286 elseif (ifld.eq.1) then ! Var.
287 do j=1,ntlml
288 if (forml(j)) then
289 do k=irsml1(j),irsml2(j)
290 if (forrs(k)) then
291 ll=ivrrs1(k)
292 do l=ll,ll+nvrrs(k)-1
293 forvr(l)=.true.
294 enddo
295 endif
296 enddo
297 endif
298 enddo
299 endif
300
301 else ! ...................... Identifier .ne. wdc
302
303 ihy=index(linide(1:ide),sphy) ! ? zone of numbers
304
305 if (ihy.le.0) then ! _____ No zone
306 if (iredin(linide,inum).gt.0) then ! ... number
307 if (ifld.eq.3) then ! Mol.
308
309! ################### impossible # (inum) of molecule
310
311 if (inum.le.0.or.inum.gt.ntlml) then
312 write (*,*) ' # 1: ',inum
313 goto 104
314 endif
315
316 forml(inum)=.true.
317 elseif (ifld.eq.2) then ! Res.
318 do j=1,ntlml
319 if (forml(j)) then
320 nfi=irsml1(j)
321 k=inum+nfi-1
322
323! ################### impossible # of residue (inum) in molecule
324
325 if (k.lt.nfi.or.k.gt.irsml2(j)) then
326 write (*,*) ' # 2: ',inum
327 goto 104
328 endif
329
330 forrs(k)=.true.
331 endif
332 enddo
333 elseif (ifld.eq.1) then ! Var.
334 do j=1,ntlml
335 if (forml(j)) then
336 do k=irsml1(j),irsml2(j)
337 if (forrs(k)) then
338 nfi=ivrrs1(k)
339 l=inum+nfi-1
340
341! ################### impossible # of variable (inum) in residue
342
343 if (l.lt.nfi.or.
344 & l.gt.nfi+nvrrs(k)-1) then
345 write (*,*) ' # 3: ',inum
346 goto 104
347 endif
348
349 forvr(l)=.true.
350 endif
351 enddo
352 endif
353 enddo
354 endif
355
356 else ! ... Name
357 if (linide(ide:ide).eq.wdc) then
358 id=ide-1
359 exa=.false.
360 else ! exact match of names
361 id=ide
362 exa=.true.
363 endif
364
365 if (ifld.eq.3) then ! Mol.
366 do j=1,ntlml
367 ib=ibegst(nmml(j))
368 if (ib.gt.0) then
369 linh=blnk
370 ieh=iendst(nmml(j))
371 ieh1=ieh-ib+1
372 linh(1:ieh1)=nmml(j)(ib:ieh)
373 if (((exa.and.ieh1.eq.id).or.
374 & (.not.exa.and.ieh1.ge.id)).and.
375 & linh(1:id).eq.linide(1:id))
376 & forml(j)=.true.
377 endif
378 enddo
379 elseif (ifld.eq.2) then ! Res.
380 do j=1,ntlml
381 if (forml(j)) then
382 do k=irsml1(j),irsml2(j)
383 ib=ibegst(seq(k))
384 if (ib.gt.0) then
385 linh=blnk
386 ieh=iendst(seq(k))
387 ieh1=ieh-ib+1
388 linh(1:ieh1)=seq(k)(ib:ieh)
389 if (((exa.and.ieh1.eq.id).or.
390 & (.not.exa.and.ieh1.ge.id))
391 & .and.linh(1:id).eq.linide(1:id))
392 & forrs(k)=.true.
393 endif
394 enddo
395 endif
396 enddo
397 elseif (ifld.eq.1) then ! Var.
398 do j=1,ntlml
399 if (forml(j)) then
400 do k=irsml1(j),irsml2(j)
401 if (forrs(k)) then
402 ll=ivrrs1(k)
403 do l=ll,ll+nvrrs(k)-1
404 ib=ibegst(nmvr(l))
405 if (ib.gt.0) then
406 linh=blnk
407 ieh=iendst(nmvr(l))
408 ieh1=ieh-ib+1
409 linh(1:ieh1)=nmvr(l)(ib:ieh)
410 if (((exa.and.ieh1.eq.id)
411 & .or.(.not.exa.and.ieh1.ge.id))
412 & .and.linh(1:id).eq.linide(1:id))
413 & forvr(l)=.true.
414 endif
415 enddo
416 endif
417 enddo
418 endif
419 enddo
420 endif
421
422 endif
423
424 else ! ___ Zone
425
426! ################### impossible zone '-' (without integer)
427
428 if (ide.eq.1.and.ihy.eq.ide) then
429 write (*,*) ' # 4: ',ide
430 goto 104
431 endif
432
433 if (ihy.eq.1) then
434 ibz=1
435 else
436 linh=blnk
437 linh=linide(1:ihy-1)
438
439! ################### impossible (to read) integer before '-'
440
441 if (iredin(linh,ibz).le.0.or.ibz.le.0)
442 & then
443 write (*,*) ' # 5 '
444 goto 104
445 endif
446
447 endif
448 if (ihy.eq.ide) then
449 iez=ilrg
450 else
451 linh=blnk
452 linh=linide(ihy+1:ide)
453
454! ################### impossible (to read) integer after '-'
455
456 if (iredin(linh,iez).le.0.or.iez.le.0.or.
457 & iez.lt.ibz) then
458 write (*,*) ' # 6 '
459 goto 104
460 endif
461
462 endif
463
464 if (ifld.eq.3) then ! Mol.
465 if (iez.gt.ntlml) iez=ntlml
466 do j=ibz,iez
467 forml(j)=.true.
468 enddo
469 elseif (ifld.eq.2) then ! Res.
470 do j=1,ntlml
471 if (forml(j)) then
472 kbz=irsml1(j)+ibz-1
473 kez=irsml1(j)+iez-1
474 if (kez.gt.irsml2(j)) then
475 kk=irsml2(j)
476 else
477 kk=kez
478 endif
479 do k=kbz,kk
480 forrs(k)=.true.
481 enddo
482 endif
483 enddo
484 elseif (ifld.eq.1) then ! Var.
485 do j=1,ntlml
486 if (forml(j)) then
487 do k=irsml1(j),irsml2(j)
488 kv=nvrrs(k)
489 if (forrs(k).and.kv.gt.0) then
490 ll=ivrrs1(k)
491 lbz=ll+ibz-1
492 if (iez.gt.kv) then
493 lez=ll+kv-1
494 else
495 lez=ll+iez-1
496 endif
497 do l=lbz,lez
498 forvr(l)=.true.
499 enddo
500 endif
501 enddo
502 endif
503 enddo
504 endif
505
506 endif
507 endif
508
509 enddo ! ... identifiers
510 enddo ! ... Fields (excl. value)
511
512! _____________________________________________________ Execute Command
513
514 if (iredrl(linfld(nfld),val).gt.izero) then ! Read Value
515 did=.false.
516 do i=1,ntlvr
517 if (forvr(i)) then
518 did=.true.
519 vlvrx(i)=val
520
521 fxvr(i)=fix
522
523 stvr(i)=.true.
524 endif
525 enddo
526 if (.not.did) write (*,'(3a)')
527 & ' redvar> No variables affected by command >',
528 & lincmd(1:ice),'<'
529 else
530
531 ll1=ibegst(linfld(nfld))
532 ll2=iendst(linfld(nfld))
533 write (*,*) 'll1,ll2, linfld(nfld): ',ll1,ll2,
534 & '>',linfld(nfld)(ll1:ll2),'<'
535
536 goto 102
537 endif
538
539 endif
540 enddo ! ... Commands at one line
541 endif
542 goto 1
543
544 2 close(lunvar)
545! __________________________ Summary
546 iv=0
547 do i=1,ntlml
548
549 ie=iendst(nmml(i))
550
551 do j =1,6
552 if (gbpr(j,i).ne.zero) then
553
554 do k = 1,3
555 write(strg(k),'(f17.6)') gbpr(k,i)
556 enddo
557 do k = 4,6
558 write(strg(k),'(f17.6)') (gbpr(k,i)*crd)
559 enddo
560
561 write (*,'(3a,/,1x,5(a,2x),a)') ' redvar> ',nmml(i)(1:ie),
562 & ' with global parameters:',
563 & (strg(k)(ibegst(strg(k)):),k=1,6)
564 call setvar(i,vlvrx)
565 goto 3
566 endif
567 enddo
568
569 3 if (nvrml(i).gt.0) then
570 iml=i
571 did=.false.
572 in=0
573 jb=irsml1(i)-1
574 do j=irsml1(i),irsml2(i)
575 kk=ivrrs1(j)
576 do k=kk,kk+nvrrs(j)-1
577 iv=iv+1
578 if (stvr(iv)) then
579 did=.true.
580 if (fxvr(iv)) then
581 write (*,'(3a,i4,1x,4a,f10.3,a)') ' redvar> ',
582 & nmml(i)(1:ie),': residue ',j-jb,seq(j),
583 & ': ',nmvr(iv),' set ',vlvrx(iv),' Fixed'
584 else
585 write (*,'(3a,i4,1x,4a,f10.3)') ' redvar> ',
586 & nmml(i)(1:ie),': residue ',j-jb,seq(j),
587 & ': ',nmvr(iv),' set ',vlvrx(iv)
588 endif
589 ity=ityvr(iv)
590 if (ity.eq.3.or.ity.eq.2)
591 & vlvrx(iv)=vlvrx(iv)*cdr ! angles
592
593 else
594 in=in+1
595 endif
596 enddo
597 enddo
598 if (did) then
599 if (in.gt.0) write (*,'(3a,i5,a)')
600 & ' redvar> Molecule ',nmml(i)(1:ie),': ',in,
601 & ' variable(s) remain unchanged'
602 call setvar(iml,vlvrx)
603 else
604 write (*,'(3a)') ' redvar> Molecule ',
605 & nmml(i)(1:ie),': No internal variables changed'
606 endif
607 endif
608 enddo
609
610 return
611! ____________________________________________________________ Errors
612 100 write (*,'(3a)') ' redvar> Cannot interpret command >',
613 & lincmd(1:ice),'<'
614 close(lunvar)
615 stop
616 101 write (*,'(a,i5,a)') ' redvar> Command number ',ncmd,' reached'
617 close(lunvar)
618 stop
619 102 write (*,'(3a)') ' redvar> Cannot read value from >',
620 & lincmd(1:ice),'<'
621 close(lunvar)
622 stop
623 103 write (*,'(a,i3,3a)') ' redvar> Cannot read >',maxide,
624 & ' identifiers from >',linfld(ii)(1:ife),'<'
625 close(lunvar)
626 stop
627 104 write (*,'(5a)') ' redvar> Error in identifier >',
628 & linide(1:ide),'< of command >',lincmd(1:ice),'<'
629 close(lunvar)
630 stop
631 105 write (*,'(a,/,a,/,2a,/)') ' redvar> line with global paramters:',
632 & line(1:ile),' must contain 6 floating',
633 & ' point numbers separated by commas !'
634 close(lunvar)
635 stop
636
637 106 write (*,'(a,/,a,/,2a,/)') ' redvar> line with global paramters:',
638 & line(1:ile),' angles must be inside ',
639 &'ranges [-180,180], [-90,90], and [-180,180] Deg., respectively !'
640 close(lunvar)
641 stop
642
643 end
Note: See TracBrowser for help on using the repository browser.