double precision function rmscalc(ishif,i,j,jcon,lprn)
      implicit real*8 (a-h,o-z)
      include 'DIMENSIONS'
      include 'DIMENSIONS.ZSCOPT'
      include 'DIMENSIONS.COMPAR'
      include 'DIMENSIONS.FREE'
      include 'COMMON.IOUNITS'
      include 'COMMON.COMPAR'
      include 'COMMON.CHAIN' 
      include 'COMMON.INTERACT'
      include 'COMMON.VAR'
      include 'COMMON.CONTROL'
      double precision przes(3),obrot(3,3)
      double precision creff(3,maxres2),cc(3,maxres2)
      logical iadded(maxres)
      integer inumber(2,maxres)
      common /ccc/ creff,cc,iadded,inumber
      logical lprn
      logical non_conv
      integer ishif,i,j
      if (lprn) then
        write (iout,*) "i",i," j",j," jcont",jcon," ishif",ishif
        write (iout,*) "npiece",npiece(j,i)
        call flush(iout)
      endif
c      write (iout,*) "symetr",symetr
c      call flush(iout)
      nperm=1
      do idup=1,symetr
      nperm=nperm*idup
      enddo
c      write (iout,*) "nperm",nperm
c      call flush(iout)
      do kkk=1,nperm
      idup=0
      do l=1,nres
        iadded(l)=.false.
      enddo
c      write (iout,*) "kkk",kkk
c      call flush(iout)
      do k=1,npiece(j,i)
        if (i.eq.1) then
          if (lprn) then
            write (iout,*) "Level 1: j=",j,"k=",k," adding fragment",
     &         ifrag(1,k,j),ifrag(2,k,j)
            call flush(iout)
          endif
          call cprep(ifrag(1,k,j),ifrag(2,k,j),ishif,idup,kkk)
c          write (iout,*) "Exit cprep"
c          call flush(iout)
c          write (iout,*) "ii=",ii
        else
          kk = ipiece(k,j,i)
c          write (iout,*) "kk",kk," npiece",npiece(kk,1)
          do l=1,npiece(kk,1)
            if (lprn) then
              write (iout,*) "Level",i,": j=",j,"k=",k," kk=",kk,
     &          " l=",l," adding fragment",
     &          ifrag(1,l,kk),ifrag(2,l,kk)
              call flush(iout)
            endif
            call cprep(ifrag(1,l,kk),ifrag(2,l,kk),ishif,idup,kkk)
c            write (iout,*) "After cprep"
c            call flush(iout)
          enddo 
        endif
      enddo
      enddo
      if (lprn) then
        write (iout,*) "tuszukaj"
        do kkk=1,nperm
          do k=1,idup
            write(iout,'(5i4,2(3f10.5,5x))') i,j,k,inumber(1,k),
     &        inumber(2,k),(creff(l,k),l=1,3),(cc(l,k),l=1,3)
          enddo
        enddo
        call flush(iout)
      endif
      rminrms=1.0d10
      do kkk=1,nperm
      call fitsq(rms,cc(1,1),creff(1,1),idup,przes,obrot,non_conv)
      if (non_conv) then
        print *,'Error: FITSQ non-convergent, jcon',jcon,i
        rms = 1.0d10
      else if (rms.lt.-1.0d-6) then 
        print *,'Error: rms^2 = ',rms,jcon,i
        rms = 1.0d10
      else if (rms.ge.1.0d-6 .and. rms.lt.0) then
        rms = 0.0d0
      endif
c      write (iout,*) "rmsmin", rminrms, "rms", rms
      if (rms.le.rminrms) rminrms=rms
      enddo
      rmscalc = dsqrt(rminrms)
c      write (iout, *) "analysys", rmscalc,anatemp
      return
      end
c-------------------------------------------------------------------------
      subroutine cprep(if1,if2,ishif,idup,kwa)
      implicit real*8 (a-h,o-z)
      include 'DIMENSIONS'
      include 'DIMENSIONS.ZSCOPT'
      include 'DIMENSIONS.COMPAR'
      include 'DIMENSIONS.FREE'
      include 'COMMON.CONTROL'
      include 'COMMON.IOUNITS'
      include 'COMMON.COMPAR'
      include 'COMMON.CHAIN' 
      include 'COMMON.INTERACT'
      include 'COMMON.VAR'
      double precision przes(3),obrot(3,3)
      double precision creff(3,maxres2),cc(3,maxres2)
      logical iadded(maxres)
      integer inumber(2,maxres),iistrart,kwa,blar
      common /ccc/ creff,cc,iadded,inumber
c      write (iout,*) "Calling cprep symetr",symetr," kwa",kwa
      nperm=1
      do blar=1,symetr
      nperm=nperm*blar
      enddo
c      write (iout,*) "nperm",nperm
      kkk=kwa
c      ii=0
      do l=if1,if2
c        write (iout,*) "l",l," iadded",iadded(l)
c        call flush(iout)
        if (l+ishif.gt.1 .and. l+ishif.le.nres .and. .not.iadded(l)) 
     &  then
          idup=idup+1
          iadded(l)=.true.
          inumber(1,idup)=l
          inumber(2,idup)=l+ishif
          do m=1,3
            creff(m,idup)=cref(m,l,kkk)
            cc(m,idup)=c(m,l+ishif)
          enddo
        endif
      enddo
      return
      end
c-------------------------------------------------------------------------
      double precision function rmsnat(jcon)
      implicit real*8 (a-h,o-z)
      include 'DIMENSIONS'
      include 'DIMENSIONS.ZSCOPT'
      include 'DIMENSIONS.COMPAR'
      include 'DIMENSIONS.FREE'
      include 'COMMON.IOUNITS'
      include 'COMMON.COMPAR'
      include 'COMMON.CHAIN' 
      include 'COMMON.INTERACT'
      include 'COMMON.VAR'
      include 'COMMON.CONTROL'
      double precision przes(3),obrot(3,3),cc(3,2*maxres),
     &   ccref(3,2*maxres)
      logical non_conv
      integer ishif,i,j,resprzesun
      rminrms=10.0d10
      rmsminsing=10d10
      nperm=1
C      write (iout,*) "tu2", nres,nsup
      noverlap=nres
      if (nres.gt.nsup) noverlap=nsup
      write (iout,*) "tu3,",noverlap
      do i=1,symetr
       nperm=nperm*i
      enddo
      do kkk=1,nperm
       nnsup=0
       do i=1,noverlap
        if (itype(i).ne.ntyp1) then
          nnsup=nnsup+1
          do j=1,3
            cc(j,nnsup)=c(j,i)
            ccref(j,nnsup)=cref(j,i,kkk)
          enddo
        endif
       enddo
       call fitsq(rms,cc(1,1),ccref(1,1),nnsup,przes,obrot,non_conv)
       if (non_conv) then
        print *,'Error: FITSQ non-convergent, jcon',jcon,i
        rms=1.0d10
       else if (rms.lt.-1.0d-6) then 
        print *,'Error: rms^2 = ',rms,jcon,i
        rms = 1.0d10
       else if (rms.ge.1.0d-6 .and. rms.lt.0) then
        rms=0.0d0
       endif
       if (rms.le.rminrms) rminrms=rms
c       write (iout,*) "kkk",kkk," rmsnat",rms , rminrms
      enddo
      rmsnat = dsqrt(rminrms)
C      write (iout,*)  "analysys",rmsnat, anatemp
C      liczenie rmsdla pojedynczego lancucha
      return
      end
c-----------------------------------------------------------------------------
      double precision function gyrate(jcon)
      implicit real*8 (a-h,o-z)
      include 'DIMENSIONS'
      include 'COMMON.INTERACT'
      include 'COMMON.CHAIN'
      double precision cen(3),rg

      do j=1,3
       cen(j)=0.0d0
      enddo

      do i=nnt,nct
          do j=1,3
            cen(j)=cen(j)+c(j,i)
          enddo
      enddo
      do j=1,3
            cen(j)=cen(j)/dble(nct-nnt+1)
      enddo
      rg = 0.0d0
      do i = nnt, nct
        do j=1,3
         rg = rg + (c(j,i)-cen(j))**2
        enddo
      end do
      gyrate = dsqrt(rg/dble(nct-nnt+1))
      return
      end