source: redvar.f@ bd2278d

Last change on this file since bd2278d was bd2278d, checked in by baerbaer <baerbaer@…>, 16 years ago

Reformatting comments and continuation marks.

Fortran 90 and higher use ! to mark comments no matter where they are in the
code. The only valid continuation marker is &.
I also added the SMMP.kdevelop.filelist to the repository to make it easier
to use kdevelop.

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

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