source/wham/src/rmscalc.f

   1       double precision function rmscalc(ishif,i,j,jcon,lprn)
   2       implicit real*8 (a-h,o-z)
   3       include 'DIMENSIONS'
   4       include 'DIMENSIONS.ZSCOPT'
   5       include 'DIMENSIONS.COMPAR'
   6       include 'COMMON.IOUNITS'
   7       include 'COMMON.COMPAR'
   8       include 'COMMON.CHAIN'
   9       include 'COMMON.INTERACT'
  10       include 'COMMON.VAR'
  11       double precision przes(3),obrot(3,3)
  12       double precision creff(3,maxres2),cc(3,maxres2)
  13       logical iadded(maxres)
  14       integer inumber(2,maxres)
  15       common /ccc/ creff,cc,iadded,inumber
  16       logical lprn
  17       logical non_conv
  18       integer ishif,i,j
  19       if (lprn) then
  20       write (iout,*) "i",i," j",j," jcont",jcon," ishif",ishif
  21       write (iout,*) "npiece",npiece(j,i)
  22       endif
  23       ii=0
  24       do l=1,nres
  25         iadded(l)=.false.
  26       enddo
  27       do k=1,npiece(j,i)
  28         if (i.eq.1) then
  29           if (lprn)
  30      &    write (iout,*) "Level 1: j=",j,"k=",k," adding fragment",
  31      &     ifrag(1,k,j),ifrag(2,k,j)
  32           call cprep(ifrag(1,k,j),ifrag(2,k,j),ishif,ii)
  33 c          write (iout,*) "ii=",ii
  34         else
  35           kk = ipiece(k,j,i)
  36 c          write (iout,*) "kk",kk," npiece",npiece(kk,1)
  37           do l=1,npiece(kk,1)
  38             if (lprn)
  39      &      write (iout,*) "Level",i,": j=",j,"k=",k," kk=",kk,
  40      &       " l=",l," adding fragment",
  41      &       ifrag(1,l,kk),ifrag(2,l,kk)
  42             call cprep(ifrag(1,l,kk),ifrag(2,l,kk),ishif,ii)
  43           enddo
  44         endif
  45       enddo
  46       if (lprn) then
  47       do k=1,ii
  48         write(iout,'(5i4,2(3f10.5,5x))') i,j,k,inumber(1,k),
  49      &         inumber(2,k),(creff(l,k),l=1,3),(cc(l,k),l=1,3)
  50       enddo
  51       endif
  52       call fitsq(rms,cc(1,1),creff(1,1),ii,przes,obrot,non_conv)
  53       if (non_conv) then
  54         print *,'Error: FITSQ non-convergent, jcon',jcon
  55         rmscalc=1.0d2
  56       else if (rms.lt.-1.0d-6) then
  57         print *,'Error: rms^2 = ',rms,jcon
  58         rmscalc = 1.0d2
  59       else if (rms.ge.1.0d-6 .and. rms.lt.0) then
  60         rmscalc=0.0d0
  61       else
  62         rmscalc = dsqrt(rms)
  63       endif
  64       return
  65       end
  66 c-------------------------------------------------------------------------
  67       subroutine cprep(if1,if2,ishif,ii)
  68       implicit real*8 (a-h,o-z)
  69       include 'DIMENSIONS'
  70       include 'DIMENSIONS.ZSCOPT'
  71       include 'DIMENSIONS.COMPAR'
  72       include 'COMMON.IOUNITS'
  73       include 'COMMON.COMPAR'
  74       include 'COMMON.CHAIN'
  75       include 'COMMON.INTERACT'
  76       include 'COMMON.VAR'
  77       double precision przes(3),obrot(3,3)
  78       double precision creff(3,maxres2),cc(3,maxres2)
  79       logical iadded(maxres)
  80       integer inumber(2,maxres)
  81       common /ccc/ creff,cc,iadded,inumber
  82 c      write (iout,*) "Calling cprep"
  83       do l=if1,if2
  84 c        write (iout,*) "l",l," iadded",iadded(l)
  85         if (l+ishif.gt.1 .and. l+ishif.le.nres .and. .not.iadded(l))
  86      &  then
  87           ii=ii+1
  88           iadded(l)=.true.
  89           inumber(1,ii)=l
  90           inumber(2,ii)=l+ishif
  91           do m=1,3
  92             creff(m,ii)=cref(m,l)
  93             cc(m,ii)=c(m,l+ishif)
  94           enddo
  95         endif
  96       enddo
  97       return
  98       end
  99 c-------------------------------------------------------------------------
 100       double precision function rmsnat(jcon)
 101       implicit real*8 (a-h,o-z)
 102       include 'DIMENSIONS'
 103       include 'DIMENSIONS.ZSCOPT'
 104       include 'DIMENSIONS.COMPAR'
 105       include 'COMMON.IOUNITS'
 106       include 'COMMON.COMPAR'
 107       include 'COMMON.CHAIN'
 108       include 'COMMON.INTERACT'
 109       include 'COMMON.VAR'
 110       double precision przes(3),obrot(3,3)
 111       logical non_conv
 112       integer ishif,i,j
 113       call fitsq(rms,c(1,nstart_sup),cref(1,nstart_sup),nsup,
 114      &  przes,obrot,non_conv)
 115       if (non_conv) then
 116         print *,'Error: FITSQ non-convergent, jcon',jcon
 117         rmsnat=1.0d2
 118       else if (rms.lt.-1.0d-6) then
 119         print *,'Error: rms^2 = ',rms,jcon
 120         rmsnat = 1.0d2
 121       else if (rms.ge.1.0d-6 .and. rms.lt.0) then
 122         rmsnat=0.0d0
 123       else
 124         rmsnat = dsqrt(rms)
 125       endif
 126       return
 127       end
 128 c-----------------------------------------------------------------------------
 129       double precision function gyrate(jcon)
 130       implicit real*8 (a-h,o-z)
 131       include 'DIMENSIONS'
 132       include 'COMMON.INTERACT'
 133       include 'COMMON.CHAIN'
 134       double precision cen(3),rg
 135
 136       do j=1,3
 137        cen(j)=0.0d0
 138       enddo
 139
 140       do i=nnt,nct
 141           do j=1,3
 142             cen(j)=cen(j)+c(j,i)
 143           enddo
 144       enddo
 145       do j=1,3
 146             cen(j)=cen(j)/dble(nct-nnt+1)
 147       enddo
 148       rg = 0.0d0
 149       do i = nnt, nct
 150         do j=1,3
 151          rg = rg + (c(j,i)-cen(j))**2
 152         enddo
 153       end do
 154       gyrate = dsqrt(rg/dble(nct-nnt+1))
 155       return
 156       end