source: redvar.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.2 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(logString,*)'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 (logString, '(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(logString,*) '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 (logString, *)
162 & 'redvar> ','Incorrect molecule number >',
163 & lincmd(1:l),'< Must be in range [1,',
164 & ntlml,'] !'
165 close(lunvar)
166 stop
167 endif
168
169 else
170 nml = 1 ! assume mol. #1
171 endif
172
173 l=ile-ilb+1
174 if (l.le.0) goto 105
175 lincmd=blnk
176 lincmd(1:l)=line(ilb:ile)
177
178 k = 1
179 do i = 1,5 ! try to read 5 parameters
180 call extstr(spcc,k,l,lincmd,linh,n)
181 if (k.gt.l.or.iredrl(linh,rn(i)).le.0) goto 105
182 enddo
183
184 n=l-k+1 ! try 6th parameter
185 if (n.le.0) goto 105
186 linh=blnk
187 linh(1:n)=lincmd(k:l)
188 if (iredrl(linh,rn(6)).le.0) goto 105
189
190! ---------------------------------------- check global angles
191 if ( abs(rn(4)).gt.(1.8d2+1d-6)
192 & .or. abs(rn(5)).gt.(9d1+1d-6)
193 & .or. abs(rn(6)).gt.(1.8d2+1d-6)
194 & ) goto 106
195
196 do i = 1,3
197 gbpr(i,nml) = rn(i)
198 enddo
199 do i = 4,6
200 gbpr(i,nml) = rn(i)*cdr
201 enddo
202
203 goto 1
204
205 endif ! global vars
206
207
208 ilb=1
209
210 do while (ilb.le.ile) ! ________________________ Commands
211 call extstr(spcm,ilb,ile,line,lincmd,ice)
212
213 if (ice.gt.0) then ! ignore empty commands
214 ncmd=ncmd+1
215 if (ncmd.gt.maxcmd) goto 101
216
217 ifx=index(lincmd(1:ice),sfix)
218 if (ifx.gt.0) then ! check for commands to fix variables
219 fix=.true.
220 lincmd(ifx:ifx)=blnk
221 if (ifx.eq.ice) then
222 ice=ice-1
223 if (ice.eq.0) then ! fix all
224 ice=1
225 lincmd(1:1)=wdc
226 endif
227 endif
228 else
229 fix=.false.
230 endif
231
232! _________________________________________ Extract Command Fields
233 nfld=0
234 icb=1
235 do while (icb.le.ice)
236 nfld=nfld+1
237 if (nfld.gt.maxfld) goto 100
238 call extstr(spfd,icb,ice,lincmd,linfld(nfld),ifdend(nfld))
239
240 if (ifdend(nfld).le.0) then ! empty field means 'all'
241 linfld(nfld)(1:1)=wdc
242 ifdend(nfld)=1
243 endif
244
245 enddo
246! _______________________________ Interpret Command Fields (except last)
247 do i=1,nfld-1
248 ii=i
249 ifld=nfld-i
250
251 if (ifld.eq.3) then ! Initialize Molecules
252 do j=1,ntlml
253 forml(j)=.false.
254 enddo
255 elseif (ifld.eq.2) then ! Initialize Residues
256 do j=1,ntlml
257 do k=irsml1(j),irsml2(j)
258 forrs(k)=.false.
259 enddo
260 enddo
261 elseif (ifld.eq.1) then ! Initialize Variables
262 do j=1,ntlvr
263 forvr(j)=.false.
264 enddo
265 endif
266! __________________________________ Identifiers in field
267 nide=0
268 ifb=1
269 ife=ifdend(i)
270 do while (ifb.le.ife)
271 nide=nide+1
272 if (nide.gt.maxide) goto 103
273 call extstr(spcc,ifb,ife,linfld(ii),linide,ide)
274 if (ide.le.0.or.linide(1:1).eq.wdc) then ! ... All
275 if (ifld.eq.3) then ! Mol.
276 do j=1,ntlml
277 forml(j)=.true.
278 enddo
279 elseif (ifld.eq.2) then ! Res.
280 do j=1,ntlml
281 if (forml(j)) then
282 do k=irsml1(j),irsml2(j)
283 forrs(k)=.true.
284 enddo
285 endif
286 enddo
287 elseif (ifld.eq.1) then ! Var.
288 do j=1,ntlml
289 if (forml(j)) then
290 do k=irsml1(j),irsml2(j)
291 if (forrs(k)) then
292 ll=ivrrs1(k)
293 do l=ll,ll+nvrrs(k)-1
294 forvr(l)=.true.
295 enddo
296 endif
297 enddo
298 endif
299 enddo
300 endif
301
302 else ! ...................... Identifier .ne. wdc
303
304 ihy=index(linide(1:ide),sphy) ! ? zone of numbers
305
306 if (ihy.le.0) then ! _____ No zone
307 if (iredin(linide,inum).gt.0) then ! ... number
308 if (ifld.eq.3) then ! Mol.
309
310! ################### impossible # (inum) of molecule
311
312 if (inum.le.0.or.inum.gt.ntlml) then
313 write (logString, *) ' # 1: ',inum
314 goto 104
315 endif
316
317 forml(inum)=.true.
318 elseif (ifld.eq.2) then ! Res.
319 do j=1,ntlml
320 if (forml(j)) then
321 nfi=irsml1(j)
322 k=inum+nfi-1
323
324! ################### impossible # of residue (inum) in molecule
325
326 if (k.lt.nfi.or.k.gt.irsml2(j)) then
327 write (logString, *) ' # 2: ',inum
328 goto 104
329 endif
330
331 forrs(k)=.true.
332 endif
333 enddo
334 elseif (ifld.eq.1) then ! Var.
335 do j=1,ntlml
336 if (forml(j)) then
337 do k=irsml1(j),irsml2(j)
338 if (forrs(k)) then
339 nfi=ivrrs1(k)
340 l=inum+nfi-1
341
342! ################### impossible # of variable (inum) in residue
343
344 if (l.lt.nfi.or.
345 & l.gt.nfi+nvrrs(k)-1) then
346 write (logString, *) ' # 3: ',inum
347 goto 104
348 endif
349
350 forvr(l)=.true.
351 endif
352 enddo
353 endif
354 enddo
355 endif
356
357 else ! ... Name
358 if (linide(ide:ide).eq.wdc) then
359 id=ide-1
360 exa=.false.
361 else ! exact match of names
362 id=ide
363 exa=.true.
364 endif
365
366 if (ifld.eq.3) then ! Mol.
367 do j=1,ntlml
368 ib=ibegst(nmml(j))
369 if (ib.gt.0) then
370 linh=blnk
371 ieh=iendst(nmml(j))
372 ieh1=ieh-ib+1
373 linh(1:ieh1)=nmml(j)(ib:ieh)
374 if (((exa.and.ieh1.eq.id).or.
375 & (.not.exa.and.ieh1.ge.id)).and.
376 & linh(1:id).eq.linide(1:id))
377 & forml(j)=.true.
378 endif
379 enddo
380 elseif (ifld.eq.2) then ! Res.
381 do j=1,ntlml
382 if (forml(j)) then
383 do k=irsml1(j),irsml2(j)
384 ib=ibegst(seq(k))
385 if (ib.gt.0) then
386 linh=blnk
387 ieh=iendst(seq(k))
388 ieh1=ieh-ib+1
389 linh(1:ieh1)=seq(k)(ib:ieh)
390 if (((exa.and.ieh1.eq.id).or.
391 & (.not.exa.and.ieh1.ge.id))
392 & .and.linh(1:id).eq.linide(1:id))
393 & forrs(k)=.true.
394 endif
395 enddo
396 endif
397 enddo
398 elseif (ifld.eq.1) then ! Var.
399 do j=1,ntlml
400 if (forml(j)) then
401 do k=irsml1(j),irsml2(j)
402 if (forrs(k)) then
403 ll=ivrrs1(k)
404 do l=ll,ll+nvrrs(k)-1
405 ib=ibegst(nmvr(l))
406 if (ib.gt.0) then
407 linh=blnk
408 ieh=iendst(nmvr(l))
409 ieh1=ieh-ib+1
410 linh(1:ieh1)=nmvr(l)(ib:ieh)
411 if (((exa.and.ieh1.eq.id)
412 & .or.(.not.exa.and.ieh1.ge.id))
413 & .and.linh(1:id).eq.linide(1:id))
414 & forvr(l)=.true.
415 endif
416 enddo
417 endif
418 enddo
419 endif
420 enddo
421 endif
422
423 endif
424
425 else ! ___ Zone
426
427! ################### impossible zone '-' (without integer)
428
429 if (ide.eq.1.and.ihy.eq.ide) then
430 write (logString, *) ' # 4: ',ide
431 goto 104
432 endif
433
434 if (ihy.eq.1) then
435 ibz=1
436 else
437 linh=blnk
438 linh=linide(1:ihy-1)
439
440! ################### impossible (to read) integer before '-'
441
442 if (iredin(linh,ibz).le.0.or.ibz.le.0)
443 & then
444 write (logString, *) ' # 5 '
445 goto 104
446 endif
447
448 endif
449 if (ihy.eq.ide) then
450 iez=ilrg
451 else
452 linh=blnk
453 linh=linide(ihy+1:ide)
454
455! ################### impossible (to read) integer after '-'
456
457 if (iredin(linh,iez).le.0.or.iez.le.0.or.
458 & iez.lt.ibz) then
459 write (logString, *) ' # 6 '
460 goto 104
461 endif
462
463 endif
464
465 if (ifld.eq.3) then ! Mol.
466 if (iez.gt.ntlml) iez=ntlml
467 do j=ibz,iez
468 forml(j)=.true.
469 enddo
470 elseif (ifld.eq.2) then ! Res.
471 do j=1,ntlml
472 if (forml(j)) then
473 kbz=irsml1(j)+ibz-1
474 kez=irsml1(j)+iez-1
475 if (kez.gt.irsml2(j)) then
476 kk=irsml2(j)
477 else
478 kk=kez
479 endif
480 do k=kbz,kk
481 forrs(k)=.true.
482 enddo
483 endif
484 enddo
485 elseif (ifld.eq.1) then ! Var.
486 do j=1,ntlml
487 if (forml(j)) then
488 do k=irsml1(j),irsml2(j)
489 kv=nvrrs(k)
490 if (forrs(k).and.kv.gt.0) then
491 ll=ivrrs1(k)
492 lbz=ll+ibz-1
493 if (iez.gt.kv) then
494 lez=ll+kv-1
495 else
496 lez=ll+iez-1
497 endif
498 do l=lbz,lez
499 forvr(l)=.true.
500 enddo
501 endif
502 enddo
503 endif
504 enddo
505 endif
506
507 endif
508 endif
509
510 enddo ! ... identifiers
511 enddo ! ... Fields (excl. value)
512
513! _____________________________________________________ Execute Command
514
515 if (iredrl(linfld(nfld),val).gt.izero) then ! Read Value
516 did=.false.
517 do i=1,ntlvr
518 if (forvr(i)) then
519 did=.true.
520 vlvrx(i)=val
521
522 fxvr(i)=fix
523
524 stvr(i)=.true.
525 endif
526 enddo
527 if (.not.did) write (logString, '(3a)')
528 & ' redvar> No variables affected by command >',
529 & lincmd(1:ice),'<'
530 else
531
532 ll1=ibegst(linfld(nfld))
533 ll2=iendst(linfld(nfld))
534 write (logString, *) 'll1,ll2, linfld(nfld): ',ll1,ll2,
535 & '>',linfld(nfld)(ll1:ll2),'<'
536
537 goto 102
538 endif
539
540 endif
541 enddo ! ... Commands at one line
542 endif
543 goto 1
544
545 2 close(lunvar)
546! __________________________ Summary
547 iv=0
548 do i=1,ntlml
549
550 ie=iendst(nmml(i))
551
552 do j =1,6
553 if (gbpr(j,i).ne.zero) then
554
555 do k = 1,3
556 write(strg(k),'(f17.6)') gbpr(k,i)
557 enddo
558 do k = 4,6
559 write(strg(k),'(f17.6)') (gbpr(k,i)*crd)
560 enddo
561
562 write (logString, '(3a,/,1x,5(a,2x),a)') ' redvar> ',
563 & nmml(i)(1:ie),
564 & ' with global parameters:',
565 & (strg(k)(ibegst(strg(k)):),k=1,6)
566 call setvar(i,vlvrx)
567 goto 3
568 endif
569 enddo
570
571 3 if (nvrml(i).gt.0) then
572 iml=i
573 did=.false.
574 in=0
575 jb=irsml1(i)-1
576 do j=irsml1(i),irsml2(i)
577 kk=ivrrs1(j)
578 do k=kk,kk+nvrrs(j)-1
579 iv=iv+1
580 if (stvr(iv)) then
581 did=.true.
582 if (fxvr(iv)) then
583 write(logString,'(3a,i4,1x,4a,f10.3,a)') ' redvar> ',
584 & nmml(i)(1:ie),': residue ',j-jb,seq(j),
585 & ': ',nmvr(iv),' set ',vlvrx(iv),' Fixed'
586 else
587 write (logString, '(3a,i4,1x,4a,f10.3)') ' redvar> ',
588 & nmml(i)(1:ie),': residue ',j-jb,seq(j),
589 & ': ',nmvr(iv),' set ',vlvrx(iv)
590 endif
591 ity=ityvr(iv)
592 if (ity.eq.3.or.ity.eq.2)
593 & vlvrx(iv)=vlvrx(iv)*cdr ! angles
594
595 else
596 in=in+1
597 endif
598 enddo
599 enddo
600 if (did) then
601 if (in.gt.0) write (logString, '(3a,i5,a)')
602 & ' redvar> Molecule ',nmml(i)(1:ie),': ',in,
603 & ' variable(s) remain unchanged'
604 call setvar(iml,vlvrx)
605 else
606 write (logString, '(3a)') ' redvar> Molecule ',
607 & nmml(i)(1:ie),': No internal variables changed'
608 endif
609 endif
610 enddo
611
612 return
613! ____________________________________________________________ Errors
614 100 write (logString, '(3a)') ' redvar> Cannot interpret command >',
615 & lincmd(1:ice),'<'
616 close(lunvar)
617 stop
618 101 write (logString, '(a,i5,a)') ' redvar> Command number ',ncmd,
619 & ' reached'
620 close(lunvar)
621 stop
622 102 write (logString, '(3a)') ' redvar> Cannot read value from >',
623 & lincmd(1:ice),'<'
624 close(lunvar)
625 stop
626 103 write (logString, '(a,i3,3a)') ' redvar> Cannot read >',maxide,
627 & ' identifiers from >',linfld(ii)(1:ife),'<'
628 close(lunvar)
629 stop
630 104 write (logString, '(5a)') ' redvar> Error in identifier >',
631 & linide(1:ide),'< of command >',lincmd(1:ice),'<'
632 close(lunvar)
633 stop
634 105 write (logString, '(a,/,a,/,2a,/)')
635 & ' redvar> line with global paramters:',
636 & line(1:ile),' must contain 6 floating',
637 & ' point numbers separated by commas !'
638 close(lunvar)
639 stop
640
641 106 write (logString, '(a,/,a,/,2a,/)')
642 & ' redvar> line with global paramters:',
643 & line(1:ile),' angles must be inside ',
644 &'ranges [-180,180], [-90,90], and [-180,180] Deg., respectively !'
645 close(lunvar)
646 stop
647
648 end
Note: See TracBrowser for help on using the repository browser.