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' 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 '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 '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 do i=1,symetr nperm=nperm*i enddo do kkk=1,nperm nnsup=0 do i=1,nres if (itype(i).ne.21) 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