double precision function qwolynes(seg1,seg2,flag,seg3,seg4) implicit real*8 (a-h,o-z) include 'DIMENSIONS' include 'COMMON.IOUNITS' include 'COMMON.CHAIN' include 'COMMON.INTERACT' include 'COMMON.VAR' integer i,j,jl,k,l,il,kl,nl,np,ip,kp,seg1,seg2,seg3,seg4, & secseg integer nsep /3/ double precision dist,qm double precision qq,qqij,qqijCM,dij,d0ij,dijCM,d0ijCM logical lprn /.false./ logical flag double precision sigm,x sigm(x)=0.25d0*x #ifdef DEBUG write (iout,*) "qwolynes: nperm",nperm," flag",flag, & " seg1",seg1," seg2",seg2," nsep",nsep #endif do kkk=1,nperm qq = 0.0d0 nl=0 if(flag) then do il=seg1+nsep,seg2 do jl=seg1,il-nsep nl=nl+1 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ & (cref(2,jl,kkk)-cref(2,il,kkk))**2+ & (cref(3,jl,kkk)-cref(3,il,kkk))**2) dij=dist(il,jl) qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2) qq = qq+qqij if (itype(il).ne.10 .or. itype(jl).ne.10) then nl=nl+1 d0ijCM=dsqrt( & (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ & (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ & (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2) dijCM=dist(il+nres,jl+nres) qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2) qq = qq+qqijCM endif c write (iout,*) "il",il,itype(il)," jl",jl,itype(jl), c & " qqiij",qqij," qqijCM",qqijCM enddo enddo #ifdef DEBUG write (iout,*) "qwolynes: nl",nl #endif qq = qq/nl else do il=seg1,seg2 if((seg3-il).lt.3) then secseg=il+3 else secseg=seg3 endif do jl=secseg,seg4 nl=nl+1 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ & (cref(2,jl,kkk)-cref(2,il,kkk))**2+ & (cref(3,jl,kkk)-cref(3,il,kkk))**2) dij=dist(il,jl) qqij = dexp(-0.5d0*((dij-d0ij)/(sigm(d0ij)))**2) qq = qq+qqij if (itype(il).ne.10 .or. itype(jl).ne.10) then nl=nl+1 d0ijCM=dsqrt( & (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ & (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ & (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2) dijCM=dist(il+nres,jl+nres) qqijCM = dexp(-0.5d0*((dijCM-d0ijCM)/(sigm(d0ijCM)))**2) endif c write (iout,*) "il",il,itype(il)," jl",jl,itype(jl), c & " qqiij",qqij," qqijCM",qqijCM qq = qq+qqijCM enddo enddo qq = qq/nl endif enddo c write (iout,*) "qq",qq qwolynes=1.0d0-qq return end c------------------------------------------------------------------- subroutine qwolynes_prim(seg1,seg2,flag,seg3,seg4) implicit real*8 (a-h,o-z) include 'DIMENSIONS' include 'COMMON.IOUNITS' include 'COMMON.CHAIN' include 'COMMON.INTERACT' include 'COMMON.VAR' include 'COMMON.MD' integer i,j,jl,k,l,il,nl,seg1,seg2,seg3,seg4, & secseg integer nsep /3/ double precision dist double precision dij,d0ij,dijCM,d0ijCM logical lprn /.false./ logical flag double precision sigm,x,sim,dd0,fac,ddqij sigm(x)=0.25d0*x #ifdef DEBUG write (iout,*) "qwolynes: flag",flag," seg1 seg1",seg1,seg2, & " nsep",nsep write (iout,*) "nperm",nperm #endif do kkk=1,nperm do i=0,nres do j=1,3 dqwol(j,i)=0.0d0 dxqwol(j,i)=0.0d0 enddo enddo nl=0 if(flag) then do il=seg1+nsep,seg2 do jl=seg1,il-nsep nl=nl+1 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ & (cref(2,jl,kkk)-cref(2,il,kkk))**2+ & (cref(3,jl,kkk)-cref(3,il,kkk))**2) dij=dist(il,jl) sim = 1.0d0/sigm(d0ij) sim = sim*sim dd0 = dij-d0ij fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim) do k=1,3 ddqij = (c(k,il)-c(k,jl))*fac dqwol(k,il)=dqwol(k,il)+ddqij dqwol(k,jl)=dqwol(k,jl)-ddqij enddo if (itype(il).ne.10 .or. itype(jl).ne.10) then nl=nl+1 d0ijCM=dsqrt( & (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ & (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ & (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2) dijCM=dist(il+nres,jl+nres) sim = 1.0d0/sigm(d0ijCM) sim = sim*sim dd0=dijCM-d0ijCM fac=dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim) do k=1,3 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac dxqwol(k,il)=dxqwol(k,il)+ddqij dxqwol(k,jl)=dxqwol(k,jl)-ddqij enddo endif #ifdef DEBUG write (iout,*) "prim il",il,itype(il)," jl",jl,itype(jl), & " dqwol",(dqwol(k,il),k=1,3)," dxqwol",(dxqwol(k,il),k=1,3) #endif enddo enddo else do il=seg1,seg2 if((seg3-il).lt.3) then secseg=il+3 else secseg=seg3 endif do jl=secseg,seg4 nl=nl+1 d0ij=dsqrt((cref(1,jl,kkk)-cref(1,il,kkk))**2+ & (cref(2,jl,kkk)-cref(2,il,kkk))**2+ & (cref(3,jl,kkk)-cref(3,il,kkk))**2) dij=dist(il,jl) sim = 1.0d0/sigm(d0ij) sim = sim*sim dd0 = dij-d0ij fac = dd0*sim/dij*dexp(-0.5d0*dd0*dd0*sim) do k=1,3 ddqij = (c(k,il)-c(k,jl))*fac dqwol(k,il)=dqwol(k,il)+ddqij dqwol(k,jl)=dqwol(k,jl)-ddqij enddo if (itype(il).ne.10 .or. itype(jl).ne.10) then nl=nl+1 d0ijCM=dsqrt( & (cref(1,jl+nres,kkk)-cref(1,il+nres,kkk))**2+ & (cref(2,jl+nres,kkk)-cref(2,il+nres,kkk))**2+ & (cref(3,jl+nres,kkk)-cref(3,il+nres,kkk))**2) dijCM=dist(il+nres,jl+nres) sim = 1.0d0/sigm(d0ijCM) sim=sim*sim dd0 = dijCM-d0ijCM fac = dd0*sim/dijCM*dexp(-0.5d0*dd0*dd0*sim) do k=1,3 ddqij = (c(k,il+nres)-c(k,jl+nres))*fac dxqwol(k,il)=dxqwol(k,il)+ddqij dxqwol(k,jl)=dxqwol(k,jl)-ddqij enddo endif enddo enddo endif enddo #ifdef DEBUG write (iout,*) "qwolynes: nl",nl #endif do i=0,nres do j=1,3 dqwol(j,i)=dqwol(j,i)/nl dxqwol(j,i)=dxqwol(j,i)/nl enddo enddo return end c------------------------------------------------------------------- subroutine qwol_num(seg1,seg2,flag,seg3,seg4) implicit real*8 (a-h,o-z) include 'DIMENSIONS' include 'COMMON.IOUNITS' include 'COMMON.CHAIN' include 'COMMON.INTERACT' include 'COMMON.VAR' integer seg1,seg2,seg3,seg4 logical flag double precision qwolan(3,0:maxres),cdummy(3,0:maxres2), & qwolxan(3,0:maxres),q1,q2 double precision delta /1.0d-10/ do i=0,nres do j=1,3 q1=qwolynes(seg1,seg2,flag,seg3,seg4) cdummy(j,i)=c(j,i) c(j,i)=c(j,i)+delta q2=qwolynes(seg1,seg2,flag,seg3,seg4) qwolan(j,i)=(q2-q1)/delta c(j,i)=cdummy(j,i) enddo enddo do i=0,nres do j=1,3 q1=qwolynes(seg1,seg2,flag,seg3,seg4) cdummy(j,i+nres)=c(j,i+nres) c(j,i+nres)=c(j,i+nres)+delta q2=qwolynes(seg1,seg2,flag,seg3,seg4) qwolxan(j,i)=(q2-q1)/delta c(j,i+nres)=cdummy(j,i+nres) enddo enddo c write(iout,*) "Numerical Q carteisan gradients backbone: " c do i=0,nct c write(iout,'(i5,3e15.5)') i, (qwolan(j,i),j=1,3) c enddo c write(iout,*) "Numerical Q carteisan gradients side-chain: " c do i=0,nct c write(iout,'(i5,3e15.5)') i, (qwolxan(j,i),j=1,3) c enddo return end c------------------------------------------------------------------------