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 '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) 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) endif ii=0 do l=1,nres iadded(l)=.false. enddo do k=1,npiece(j,i) if (i.eq.1) then if (lprn) & write (iout,*) "Level 1: j=",j,"k=",k," adding fragment", & ifrag(1,k,j),ifrag(2,k,j) call cprep(ifrag(1,k,j),ifrag(2,k,j),ishif,ii) 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) & write (iout,*) "Level",i,": j=",j,"k=",k," kk=",kk, & " l=",l," adding fragment", & ifrag(1,l,kk),ifrag(2,l,kk) call cprep(ifrag(1,l,kk),ifrag(2,l,kk),ishif,ii) enddo endif enddo if (lprn) then do k=1,ii 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 endif call fitsq(rms,cc(1,1),creff(1,1),ii,przes,obrot,non_conv) if (non_conv) then print *,'Error: FITSQ non-convergent, jcon',jcon rmscalc=1.0d2 else if (rms.lt.-1.0d-6) then print *,'Error: rms^2 = ',rms,jcon rmscalc = 1.0d2 else if (rms.ge.1.0d-6 .and. rms.lt.0) then rmscalc=0.0d0 else rmscalc = dsqrt(rms) endif return end c------------------------------------------------------------------------- subroutine cprep(if1,if2,ishif,ii) implicit real*8 (a-h,o-z) include 'DIMENSIONS' include 'DIMENSIONS.ZSCOPT' include 'DIMENSIONS.COMPAR' 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) common /ccc/ creff,cc,iadded,inumber c write (iout,*) "Calling cprep" do l=if1,if2 c write (iout,*) "l",l," iadded",iadded(l) if (l+ishif.gt.1 .and. l+ishif.le.nres .and. .not.iadded(l)) & then ii=ii+1 iadded(l)=.true. inumber(1,ii)=l inumber(2,ii)=l+ishif do m=1,3 creff(m,ii)=cref(m,l) cc(m,ii)=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 'COMMON.IOUNITS' include 'COMMON.COMPAR' include 'COMMON.CHAIN' include 'COMMON.INTERACT' include 'COMMON.VAR' double precision przes(3),obrot(3,3) logical non_conv integer ishif,i,j call fitsq(rms,c(1,nstart_sup),cref(1,nstart_sup),nsup, & przes,obrot,non_conv) if (non_conv) then print *,'Error: FITSQ non-convergent, jcon',jcon rmsnat=1.0d2 else if (rms.lt.-1.0d-6) then print *,'Error: rms^2 = ',rms,jcon rmsnat = 1.0d2 else if (rms.ge.1.0d-6 .and. rms.lt.0) then rmsnat=0.0d0 else rmsnat = dsqrt(rms) endif 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