C Calculate electrostatic (H-bonding) energy of the main chain.
C
107 continue
+cmc
+cmc Sep-06: egb takes care of dynamic ss bonds too
+cmc
+c if (dyn_ss) call dyn_set_nss
+
c print *,"Processor",myrank," computed USCSC"
#ifdef TIMING
time01=MPI_Wtime()
C Calculate the virtual-bond-angle energy.
C
if (wang.gt.0d0) then
- call ebend(ebe)
+ call ebend(ebe,ethetacnstr)
else
ebe=0
endif
energia(17)=estr
energia(20)=Uconst+Uconst_back
energia(21)=esccor
+C energia(22)=
+c Here are the energies showed per procesor if the are more processors
+c per molecule then we sum it up in sum_energy subroutine
c print *," Processor",myrank," calls SUM_ENERGY"
call sum_energy(energia,.true.)
+ if (dyn_ss) call dyn_set_nss
c print *," Processor",myrank," left SUM_ENERGY"
#ifdef TIMING
time_sumene=time_sumene+MPI_Wtime()-time00
#ifdef MPI
include 'mpif.h'
double precision gradbufc(3,maxres),gradbufx(3,maxres),
- & glocbuf(4*maxres),gradbufc_sum(3,maxres)
+ & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres)
#endif
include 'COMMON.SETUP'
include 'COMMON.IOUNITS'
include 'COMMON.CONTROL'
include 'COMMON.TIME1'
include 'COMMON.MAXGRAD'
+ include 'COMMON.SCCOR'
#ifdef TIMING
time01=MPI_Wtime()
#endif
& +wturn3*gel_loc_turn3(i)
& +wturn6*gel_loc_turn6(i)
& +wel_loc*gel_loc_loc(i)
- & +wsccor*gsccor_loc(i)
enddo
#ifdef DEBUG
write (iout,*) "gloc after adding corr"
do i=1,4*nres
glocbuf(i)=gloc(i,icg)
enddo
+c#define DEBUG
+#ifdef DEBUG
+ write (iout,*) "gloc_sc before reduce"
+ do i=1,nres
+ do j=1,1
+ write (iout,*) i,j,gloc_sc(j,i,icg)
+ enddo
+ enddo
+#endif
+c#undef DEBUG
+ do i=1,nres
+ do j=1,3
+ gloc_scbuf(j,i)=gloc_sc(j,i,icg)
+ enddo
+ enddo
time00=MPI_Wtime()
call MPI_Barrier(FG_COMM,IERR)
time_barrier_g=time_barrier_g+MPI_Wtime()-time00
call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
& MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
time_reduce=time_reduce+MPI_Wtime()-time00
+ call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
+ & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
+ time_reduce=time_reduce+MPI_Wtime()-time00
+c#define DEBUG
+#ifdef DEBUG
+ write (iout,*) "gloc_sc after reduce"
+ do i=1,nres
+ do j=1,1
+ write (iout,*) i,j,gloc_sc(j,i,icg)
+ enddo
+ enddo
+#endif
+c#undef DEBUG
#ifdef DEBUG
write (iout,*) "gloc after reduce"
do i=1,4*nres
& ecorr,wcorr,
& ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
& eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
- & edihcnstr,ebr*nss,
+ & edihcnstr,
+ & ethetacnstr,ebr*nss,
& Uconst,etot
10 format (/'Virtual-chain energies:'//
& 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
& 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
& 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
& 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
+ & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
& 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
& 'UCONST= ',1pE16.6,' (Constraint energy)'/
& 'ETOT= ',1pE16.6,' (total)')
& ecorr,wcorr,
& ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
& eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
+ & ethetacnstr,
& ebr*nss,Uconst,etot
10 format (/'Virtual-chain energies:'//
& 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
& 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
& 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
& 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
+ & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
& 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
& 'UCONST=',1pE16.6,' (Constraint energy)'/
& 'ETOT= ',1pE16.6,' (total)')
c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
evdw=0.0D0
do i=iatsc_s,iatsc_e
- itypi=itype(i)
- if (itypi.eq.21) cycle
- itypi1=itype(i+1)
+ itypi=iabs(itype(i))
+ if (itypi.eq.ntyp1) cycle
+ itypi1=iabs(itype(i+1))
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
cd & 'iend=',iend(i,iint)
do j=istart(i,iint),iend(i,iint)
- itypj=itype(j)
- if (itypj.eq.21) cycle
+ itypj=iabs(itype(j))
+ if (itypj.eq.ntyp1) cycle
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
evdw=0.0D0
do i=iatsc_s,iatsc_e
- itypi=itype(i)
- if (itypi.eq.21) cycle
- itypi1=itype(i+1)
+ itypi=iabs(itype(i))
+ if (itypi.eq.ntyp1) cycle
+ itypi1=iabs(itype(i+1))
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
C
do iint=1,nint_gr(i)
do j=istart(i,iint),iend(i,iint)
- itypj=itype(j)
- if (itypj.eq.21) cycle
+ itypj=iabs(itype(j))
+ if (itypj.eq.ntyp1) cycle
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
c endif
ind=0
do i=iatsc_s,iatsc_e
- itypi=itype(i)
- if (itypi.eq.21) cycle
- itypi1=itype(i+1)
+ itypi=iabs(itype(i))
+ if (itypi.eq.ntyp1) cycle
+ itypi1=iabs(itype(i+1))
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
do iint=1,nint_gr(i)
do j=istart(i,iint),iend(i,iint)
ind=ind+1
- itypj=itype(j)
- if (itypj.eq.21) cycle
+ itypj=iabs(itype(j))
+ if (itypj.eq.ntyp1) cycle
c dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(j+nres)
chi1=chi(itypi,itypj)
include 'COMMON.IOUNITS'
include 'COMMON.CALC'
include 'COMMON.CONTROL'
+ include 'COMMON.SBRIDGE'
logical lprn
+
+c write(iout,*) "Jestem w egb(evdw)"
+
evdw=0.0D0
ccccc energy_dec=.false.
c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
c if (icall.eq.0) lprn=.false.
ind=0
do i=iatsc_s,iatsc_e
- itypi=itype(i)
- if (itypi.eq.21) cycle
- itypi1=itype(i+1)
+ itypi=iabs(itype(i))
+ if (itypi.eq.ntyp1) cycle
+ itypi1=iabs(itype(i+1))
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
C
do iint=1,nint_gr(i)
do j=istart(i,iint),iend(i,iint)
+ IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
+
+c write(iout,*) "PRZED ZWYKLE", evdwij
+ call dyn_ssbond_ene(i,j,evdwij)
+c write(iout,*) "PO ZWYKLE", evdwij
+
+ evdw=evdw+evdwij
+ if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
+ & 'evdw',i,j,evdwij,' ss'
+C triple bond artifac removal
+ do k=j+1,iend(i,iint)
+C search over all next residues
+ if (dyn_ss_mask(k)) then
+C check if they are cysteins
+C write(iout,*) 'k=',k
+
+c write(iout,*) "PRZED TRI", evdwij
+ evdwij_przed_tri=evdwij
+ call triple_ssbond_ene(i,j,k,evdwij)
+c if(evdwij_przed_tri.ne.evdwij) then
+c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
+c endif
+
+c write(iout,*) "PO TRI", evdwij
+C call the energy function that removes the artifical triple disulfide
+C bond the soubroutine is located in ssMD.F
+ evdw=evdw+evdwij
+ if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
+ & 'evdw',i,j,evdwij,'tss'
+ endif!dyn_ss_mask(k)
+ enddo! k
+ ELSE
ind=ind+1
- itypj=itype(j)
- if (itypj.eq.21) cycle
+ itypj=iabs(itype(j))
+ if (itypj.eq.ntyp1) cycle
c dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(j+nres)
c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
gg(3)=zj*fac
C Calculate angular part of the gradient.
call sc_grad
+ ENDIF ! dyn_ss
enddo ! j
enddo ! iint
enddo ! i
c if (icall.eq.0) lprn=.true.
ind=0
do i=iatsc_s,iatsc_e
- itypi=itype(i)
- if (itypi.eq.21) cycle
- itypi1=itype(i+1)
+ itypi=iabs(itype(i))
+ if (itypi.eq.ntyp1) cycle
+ itypi1=iabs(itype(i+1))
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
do iint=1,nint_gr(i)
do j=istart(i,iint),iend(i,iint)
ind=ind+1
- itypj=itype(j)
- if (itypj.eq.21) cycle
+ itypj=iabs(itype(j))
+ if (itypj.eq.ntyp1) cycle
c dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(j+nres)
sig0ij=sigma(itypi,itypj)
cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
evdw=0.0D0
do i=iatsc_s,iatsc_e
- itypi=itype(i)
- if (itypi.eq.21) cycle
- itypi1=itype(i+1)
+ itypi=iabs(itype(i))
+ if (itypi.eq.ntyp1) cycle
+ itypi1=iabs(itype(i+1))
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
cd & 'iend=',iend(i,iint)
do j=istart(i,iint),iend(i,iint)
- itypj=itype(j)
- if (itypj.eq.21) cycle
+ itypj=iabs(itype(j))
+ if (itypj.eq.ntyp1) cycle
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
eello_turn4=0.0d0
ind=0
do i=iatel_s,iatel_e
- if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
+ if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
dxi=dc(1,i)
dyi=dc(2,i)
dzi=dc(3,i)
num_conti=0
c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
do j=ielstart(i),ielend(i)
- if (itype(j).eq.21 .or. itype(j+1).eq.21) cycle
+ if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
ind=ind+1
iteli=itel(i)
itelj=itel(j)
enddo
c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
if (i.gt. nnt+1 .and. i.lt.nct+1) then
- iti1 = itortyp(itype(i-1))
+ if (itype(i-1).le.ntyp) then
+ iti1 = itortyp(itype(i-1))
+ else
+ iti1=ntortyp+1
+ endif
else
iti1=ntortyp+1
endif
C Loop over i,i+2 and i,i+3 pairs of the peptide groups
C
do i=iturn3_start,iturn3_end
- if (itype(i).eq.21 .or. itype(i+1).eq.21
- & .or. itype(i+2).eq.21 .or. itype(i+3).eq.21) cycle
+ if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
+ & .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle
dxi=dc(1,i)
dyi=dc(2,i)
dzi=dc(3,i)
num_cont_hb(i)=num_conti
enddo
do i=iturn4_start,iturn4_end
- if (itype(i).eq.21 .or. itype(i+1).eq.21
- & .or. itype(i+3).eq.21
- & .or. itype(i+4).eq.21) cycle
+ if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
+ & .or. itype(i+3).eq.ntyp1
+ & .or. itype(i+4).eq.ntyp1) cycle
dxi=dc(1,i)
dyi=dc(2,i)
dzi=dc(3,i)
zmedi=c(3,i)+0.5d0*dzi
num_conti=num_cont_hb(i)
call eelecij(i,i+3,ees,evdw1,eel_loc)
- if (wturn4.gt.0.0d0 .and. itype(i+2).ne.21)
+ if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
& call eturn4(i,eello_turn4)
num_cont_hb(i)=num_conti
enddo ! i
c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
c
do i=iatel_s,iatel_e
- if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
+ if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
dxi=dc(1,i)
dyi=dc(2,i)
dzi=dc(3,i)
num_conti=num_cont_hb(i)
do j=ielstart(i),ielend(i)
c write (iout,*) i,j,itype(i),itype(j)
- if (itype(j).eq.21 .or. itype(j+1).eq.21) cycle
+ if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle
call eelecij(i,j,ees,evdw1,eel_loc)
enddo ! j
num_cont_hb(i)=num_conti
cd & xmedi,ymedi,zmedi,xj,yj,zj
if (energy_dec) then
- write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
+ write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
+ &'evdw1',i,j,evdwij
+ &,iteli,itelj,aaa,evdw1
write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
endif
if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
& 'eelloc',i,j,eel_loc_ij
+c write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
eel_loc=eel_loc+eel_loc_ij
C Partial derivatives in virtual-bond dihedral angles gamma
cd print '(a)','Enter ESCP'
cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
do i=iatscp_s,iatscp_e
- if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
+ if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
iteli=itel(i)
xi=0.5D0*(c(1,i)+c(1,i+1))
yi=0.5D0*(c(2,i)+c(2,i+1))
do iint=1,nscp_gr(i)
do j=iscpstart(i,iint),iscpend(i,iint)
- if (itype(j).eq.21) cycle
- itypj=itype(j)
+ if (itype(j).eq.ntyp1) cycle
+ itypj=iabs(itype(j))
C Uncomment following three lines for SC-p interactions
c xj=c(1,nres+j)-xi
c yj=c(2,nres+j)-yi
cd print '(a)','Enter ESCP'
cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
do i=iatscp_s,iatscp_e
- if (itype(i).eq.21 .or. itype(i+1).eq.21) cycle
+ if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
iteli=itel(i)
xi=0.5D0*(c(1,i)+c(1,i+1))
yi=0.5D0*(c(2,i)+c(2,i+1))
do iint=1,nscp_gr(i)
do j=iscpstart(i,iint),iscpend(i,iint)
- itypj=itype(j)
- if (itypj.eq.21) cycle
+ itypj=iabs(itype(j))
+ if (itypj.eq.ntyp1) cycle
C Uncomment following three lines for SC-p interactions
c xj=c(1,nres+j)-xi
c yj=c(2,nres+j)-yi
endif
evdwij=e1+e2
evdw2=evdw2+evdwij
- if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
- & 'evdw2',i,j,evdwij
+ if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
+ & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
+ & bad(itypj,iteli)
C
C Calculate contributions to the gradient in the virtual-bond and SC vectors.
C
include 'COMMON.VAR'
include 'COMMON.INTERACT'
include 'COMMON.IOUNITS'
+ include 'COMMON.CONTROL'
dimension ggg(3)
ehpb=0.0D0
+ do i=1,3
+ ggg(i)=0.0d0
+ enddo
+C write (iout,*) ,"link_end",link_end,constr_dist
cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
cd write(iout,*)'link_start=',link_start,' link_end=',link_end
if (link_end.eq.0) return
iii=ii
jjj=jj
endif
-cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj
+c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
+c & dhpb(i),dhpb1(i),forcon(i)
C 24/11/03 AL: SS bridges handled separately because of introducing a specific
C distance and angle dependent SS bond potential.
- if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
+cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
+C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
+ if (.not.dyn_ss .and. i.le.nss) then
+C 15/02/13 CC dynamic SSbond - additional check
+ if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
+ & iabs(itype(jjj)).eq.1) then
call ssbond_ene(iii,jjj,eij)
ehpb=ehpb+2*eij
+ endif
cd write (iout,*) "eij",eij
+cd & ' waga=',waga,' fac=',fac
+ else if (ii.gt.nres .and. jj.gt.nres) then
+c Restraints from contact prediction
+ dd=dist(ii,jj)
+ if (constr_dist.eq.11) then
+ ehpb=ehpb+fordepth(i)**4.0d0
+ & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
+ fac=fordepth(i)**4.0d0
+ & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
+ if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
+ & ehpb,fordepth(i),dd
+ else
+ if (dhpb1(i).gt.0.0d0) then
+ ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
+ fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
+c write (iout,*) "beta nmr",
+c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
+ else
+ dd=dist(ii,jj)
+ rdis=dd-dhpb(i)
+C Get the force constant corresponding to this distance.
+ waga=forcon(i)
+C Calculate the contribution to energy.
+ ehpb=ehpb+waga*rdis*rdis
+c write (iout,*) "beta reg",dd,waga*rdis*rdis
+C
+C Evaluate gradient.
+C
+ fac=waga*rdis/dd
+ endif
+ endif
+ do j=1,3
+ ggg(j)=fac*(c(j,jj)-c(j,ii))
+ enddo
+ do j=1,3
+ ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
+ ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
+ enddo
+ do k=1,3
+ ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
+ ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
+ enddo
else
C Calculate the distance between the two points and its difference from the
C target distance.
- dd=dist(ii,jj)
- rdis=dd-dhpb(i)
+ dd=dist(ii,jj)
+ if (constr_dist.eq.11) then
+ ehpb=ehpb+fordepth(i)**4.0d0
+ & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
+ fac=fordepth(i)**4.0d0
+ & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
+ if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
+ & ehpb,fordepth(i),dd
+ else
+ if (dhpb1(i).gt.0.0d0) then
+ ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
+ fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
+c write (iout,*) "alph nmr",
+c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
+ else
+ rdis=dd-dhpb(i)
C Get the force constant corresponding to this distance.
- waga=forcon(i)
+ waga=forcon(i)
C Calculate the contribution to energy.
- ehpb=ehpb+waga*rdis*rdis
+ ehpb=ehpb+waga*rdis*rdis
+c write (iout,*) "alpha reg",dd,waga*rdis*rdis
C
C Evaluate gradient.
C
- fac=waga*rdis/dd
-cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
-cd & ' waga=',waga,' fac=',fac
- do j=1,3
- ggg(j)=fac*(c(j,jj)-c(j,ii))
- enddo
+ fac=waga*rdis/dd
+ endif
+ endif
+ do j=1,3
+ ggg(j)=fac*(c(j,jj)-c(j,ii))
+ enddo
cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
C If this is a SC-SC distance, we need to calculate the contributions to the
C Cartesian gradient in the SC vectors (ghpbx).
- if (iii.lt.ii) then
+ if (iii.lt.ii) then
do j=1,3
ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
enddo
- endif
+ endif
cgrad do j=iii,jjj-1
cgrad do k=1,3
cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
cgrad enddo
cgrad enddo
- do k=1,3
- ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
- ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
- enddo
+ do k=1,3
+ ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
+ ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
+ enddo
endif
enddo
- ehpb=0.5D0*ehpb
+ if (constr_dist.ne.11) ehpb=0.5D0*ehpb
return
end
C--------------------------------------------------------------------------
include 'COMMON.VAR'
include 'COMMON.IOUNITS'
double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
- itypi=itype(i)
+ itypi=iabs(itype(i))
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
dzi=dc_norm(3,nres+i)
c dsci_inv=dsc_inv(itypi)
dsci_inv=vbld_inv(nres+i)
- itypj=itype(j)
+ itypj=iabs(itype(j))
c dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(nres+j)
xj=c(1,nres+j)-xi
estr=0.0d0
estr1=0.0d0
do i=ibondp_start,ibondp_end
- if (itype(i-1).eq.21 .or. itype(i).eq.21) then
+ if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
do j=1,3
gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
c
do i=ibond_start,ibond_end
- iti=itype(i)
- if (iti.ne.10 .and. iti.ne.21) then
+ iti=iabs(itype(i))
+ if (iti.ne.10 .and. iti.ne.ntyp1) then
nbi=nbondterm(iti)
if (nbi.eq.1) then
diff=vbld(i+nres)-vbldsc0(1,iti)
etheta=0.0D0
c write (*,'(a,i2)') 'EBEND ICG=',icg
do i=ithet_start,ithet_end
- if (itype(i-1).eq.21) cycle
+ if (itype(i-1).eq.ntyp1) cycle
C Zero the energy function and its derivative at 0 or pi.
call splinthet(theta(i),0.5d0*delta,ss,ssd)
it=itype(i-1)
- if (i.gt.3 .and. itype(i-2).ne.21) then
+ ichir1=isign(1,itype(i-2))
+ ichir2=isign(1,itype(i))
+ if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
+ if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
+ if (itype(i-1).eq.10) then
+ itype1=isign(10,itype(i-2))
+ ichir11=isign(1,itype(i-2))
+ ichir12=isign(1,itype(i-2))
+ itype2=isign(10,itype(i))
+ ichir21=isign(1,itype(i))
+ ichir22=isign(1,itype(i))
+ endif
+
+ if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
#ifdef OSF
phii=phi(i)
if (phii.ne.phii) phii=150.0
y(1)=0.0D0
y(2)=0.0D0
endif
- if (i.lt.nres .and. itype(i).ne.21) then
+ if (i.lt.nres .and. itype(i).ne.ntyp1) then
#ifdef OSF
phii1=phi(i+1)
if (phii1.ne.phii1) phii1=150.0
C In following comments this theta will be referred to as t_c.
thet_pred_mean=0.0d0
do k=1,2
- athetk=athet(k,it)
- bthetk=bthet(k,it)
- thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
+ athetk=athet(k,it,ichir1,ichir2)
+ bthetk=bthet(k,it,ichir1,ichir2)
+ if (it.eq.10) then
+ athetk=athet(k,itype1,ichir11,ichir12)
+ bthetk=bthet(k,itype2,ichir21,ichir22)
+ endif
+ thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
enddo
dthett=thet_pred_mean*ssd
thet_pred_mean=thet_pred_mean*ss+a0thet(it)
C Derivatives of the "mean" values in gamma1 and gamma2.
- dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
- dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
+ dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
+ &+athet(2,it,ichir1,ichir2)*y(1))*ss
+ dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
+ & +bthet(2,it,ichir1,ichir2)*z(1))*ss
+ if (it.eq.10) then
+ dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
+ &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
+ dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
+ & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
+ endif
if (theta(i).gt.pi-delta) then
call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
& E_tc0)
& E_theta,E_tc)
endif
etheta=etheta+ethetai
+ do i=ithetaconstr_start,ithetaconstr_end
+ itheta=itheta_constr(i)
+ thetiii=theta(itori)
+ difi=pinorm(thetiii-theta_constr0(i))
+ if (difi.gt.theta_drange(i)) then
+ difi=difi-theta_drange(i)
+ ethetcnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
+ gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
+ & +for_thet_constr(i)*difi**3
+ else if (difi.lt.-drange(i)) then
+ difi=difi+drange(i)
+ ethetcnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
+ gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
+ & +for_thet_constr(i)*difi**3
+ else
+ difi=0.0
+ endif
+ if (energy_dec) then
+ write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
+ & i,itheta,rad2deg*thetiii,
+ & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
+ & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
+ & gloc(itheta+nphi-2,icg)
+ endif
+ enddo
if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
& 'ebend',i,ethetai
if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
logical lprn /.false./, lprn1 /.false./
etheta=0.0D0
do i=ithet_start,ithet_end
- if (itype(i-1).eq.21) cycle
+ if ((itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
+ &(itype(i).eq.ntyp1)) cycle
+C print *,i,theta(i)
+ if (iabs(itype(i+1)).eq.20) iblock=2
+ if (iabs(itype(i+1)).ne.20) iblock=1
dethetai=0.0d0
dephii=0.0d0
dephii1=0.0d0
theti2=0.5d0*theta(i)
- ityp2=ithetyp(itype(i-1))
+ ityp2=ithetyp((itype(i-1)))
do k=1,nntheterm
coskt(k)=dcos(k*theti2)
sinkt(k)=dsin(k*theti2)
enddo
- if (i.gt.3 .and. itype(i-2).ne.21) then
+C print *,ethetai
+
+ if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
#ifdef OSF
phii=phi(i)
if (phii.ne.phii) phii=150.0
#else
phii=phi(i)
#endif
- ityp1=ithetyp(itype(i-2))
+ ityp1=ithetyp((itype(i-2)))
+C propagation of chirality for glycine type
do k=1,nsingle
cosph1(k)=dcos(k*phii)
sinph1(k)=dsin(k*phii)
enddo
else
phii=0.0d0
- ityp1=nthetyp+1
do k=1,nsingle
+ ityp1=ithetyp((itype(i-2)))
cosph1(k)=0.0d0
sinph1(k)=0.0d0
enddo
endif
- if (i.lt.nres .and. itype(i).ne.21) then
+ if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
#ifdef OSF
phii1=phi(i+1)
if (phii1.ne.phii1) phii1=150.0
#else
phii1=phi(i+1)
#endif
- ityp3=ithetyp(itype(i))
+ ityp3=ithetyp((itype(i)))
do k=1,nsingle
cosph2(k)=dcos(k*phii1)
sinph2(k)=dsin(k*phii1)
enddo
else
phii1=0.0d0
- ityp3=nthetyp+1
+ ityp3=ithetyp((itype(i)))
do k=1,nsingle
cosph2(k)=0.0d0
sinph2(k)=0.0d0
enddo
endif
- ethetai=aa0thet(ityp1,ityp2,ityp3)
+ ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
do k=1,ndouble
do l=1,k-1
ccl=cosph1(l)*cosph2(k-l)
enddo
endif
do k=1,ntheterm
- ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
- dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
+ ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
+ dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
& *coskt(k)
if (lprn)
- & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
+ & write (iout,*) "k",k,"
+ & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
& " ethetai",ethetai
enddo
if (lprn) then
enddo
write(iout,*) "ethetai",ethetai
endif
+C print *,ethetai
do m=1,ntheterm2
do k=1,nsingle
- aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
- & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
- & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
- & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
+ aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
+ & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
+ & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
+ & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
ethetai=ethetai+sinkt(m)*aux
dethetai=dethetai+0.5d0*m*aux*coskt(m)
dephii=dephii+k*sinkt(m)*(
- & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
- & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
+ & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
+ & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
dephii1=dephii1+k*sinkt(m)*(
- & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
- & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
+ & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
+ & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
if (lprn)
& write (iout,*) "m",m," k",k," bbthet",
- & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
- & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
- & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
- & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
+ & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
+ & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
+ & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
+ & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
+C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
enddo
enddo
+C print *,"cosph1", (cosph1(k), k=1,nsingle)
+C print *,"cosph2", (cosph2(k), k=1,nsingle)
+C print *,"sinph1", (sinph1(k), k=1,nsingle)
+C print *,"sinph2", (sinph2(k), k=1,nsingle)
if (lprn)
& write(iout,*) "ethetai",ethetai
+C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
do m=1,ntheterm3
do k=2,ndouble
do l=1,k-1
- aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
- & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
- & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
- & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
+ aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
+ & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
+ & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
+ & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
ethetai=ethetai+sinkt(m)*aux
dethetai=dethetai+0.5d0*m*coskt(m)*aux
dephii=dephii+l*sinkt(m)*(
- & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
- & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
- & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
- & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
+ & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
+ & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
+ & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
+ & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
dephii1=dephii1+(k-l)*sinkt(m)*(
- & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
- & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
- & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
- & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
+ & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
+ & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
+ & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
+ & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
if (lprn) then
write (iout,*) "m",m," k",k," l",l," ffthet",
- & ffthet(l,k,m,ityp1,ityp2,ityp3),
- & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
- & ggthet(l,k,m,ityp1,ityp2,ityp3),
- & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
+ & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
+ & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
+ & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
+ & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
+ & " ethetai",ethetai
write (iout,*) cosph1ph2(l,k)*sinkt(m),
& cosph1ph2(k,l)*sinkt(m),
& sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
enddo
enddo
10 continue
- if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
+C now we have the theta_constrains
+ do i=ithetaconstr_start,ithetaconstr_end
+ itheta=itheta_constr(i)
+ thetiii=theta(itori)
+ difi=pinorm(thetiii-theta_constr0(i))
+ if (difi.gt.theta_drange(i)) then
+ difi=difi-theta_drange(i)
+ ethetcnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
+ gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
+ & +for_thet_constr(i)*difi**3
+ else if (difi.lt.-drange(i)) then
+ difi=difi+drange(i)
+ ethetcnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
+ gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
+ & +for_thet_constr(i)*difi**3
+ else
+ difi=0.0
+ endif
+ if (energy_dec) then
+ write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
+ & i,itheta,rad2deg*thetiii,
+ & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
+ & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
+ & gloc(itheta+nphi-2,icg)
+ endif
+ enddo
+
+c lprn1=.true.
+C print *,ethetai
+ if (lprn1)
+ & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
& i,theta(i)*rad2deg,phii*rad2deg,
& phii1*rad2deg,ethetai
+c lprn1=.false.
etheta=etheta+ethetai
if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
- gloc(nphi+i-2,icg)=wang*dethetai
+ gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
enddo
return
end
c write (iout,'(a)') 'ESC'
do i=loc_start,loc_end
it=itype(i)
- if (it.eq.21) cycle
+ if (it.eq.ntyp1) cycle
if (it.eq.10) goto 1
- nlobit=nlob(it)
+ nlobit=nlob(iabs(it))
c print *,'i=',i,' it=',it,' nlobit=',nlobit
c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
theti=theta(i+1)-pipol
do j=1,nlobit
#ifdef OSF
- adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
+ adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
if(adexp.ne.adexp) adexp=1.0
expfac=dexp(adexp)
#else
- expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
+ expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
#endif
cd print *,'j=',j,' expfac=',expfac
escloc_i=escloc_i+expfac
dersc12=0.0d0
do j=1,nlobit
- expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
+ expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
escloc_i=escloc_i+expfac
do k=1,2
dersc(k)=dersc(k)+Ax(k,j)*expfac
delta=0.02d0*pi
escloc=0.0D0
do i=loc_start,loc_end
- if (itype(i).eq.21) cycle
+ if (itype(i).eq.ntyp1) cycle
costtab(i+1) =dcos(theta(i+1))
sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
cosfac=dsqrt(cosfac2)
sinfac2=0.5d0/(1.0d0-costtab(i+1))
sinfac=dsqrt(sinfac2)
- it=itype(i)
+ it=iabs(itype(i))
if (it.eq.10) goto 1
c
C Compute the axes of tghe local cartesian coordinates system; store in
y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
enddo
do j = 1,3
- z_prime(j) = -uz(j,i-1)
+ z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
enddo
c write (2,*) "i",i
c write (2,*) "x_prime",(x_prime(j),j=1,3)
C Compute the energy of the ith side cbain
C
c write (2,*) "xx",xx," yy",yy," zz",zz
- it=itype(i)
+ it=iabs(itype(i))
do j = 1,65
x(j) = sc_parmin(j,it)
enddo
Cc diagnostics - remove later
xx1 = dcos(alph(2))
yy1 = dsin(alph(2))*dcos(omeg(2))
- zz1 = -dsin(alph(2))*dsin(omeg(2))
+ zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
write(2,'(3f8.1,3f9.3,1x,3f9.3)')
& alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
& xx1,yy1,zz1
c & dscp1,dscp2,sumene
c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
escloc = escloc + sumene
-c write (2,*) "i",i," escloc",sumene,escloc
+c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
+c & ,zz,xx,yy
+c#define DEBUG
#ifdef DEBUG
C
C This section to check the numerical derivatives of the energy of ith side
C
C Compute the gradient of esc
C
+c zz=zz*dsign(1.0,dfloat(itype(i)))
pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
& +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
& +(pom1+pom2)*pom_dx
#ifdef DEBUG
- write(2,*), "de_dxx = ", de_dxx,de_dxx_num
+ write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
#endif
C
sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
& +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
& +(pom1-pom2)*pom_dy
#ifdef DEBUG
- write(2,*), "de_dyy = ", de_dyy,de_dyy_num
+ write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
#endif
C
de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
& +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
& + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
#ifdef DEBUG
- write(2,*), "de_dzz = ", de_dzz,de_dzz_num
+ write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
#endif
C
de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
& -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
& +pom1*pom_dt1+pom2*pom_dt2
#ifdef DEBUG
- write(2,*), "de_dt = ", de_dt,de_dt_num
+ write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
#endif
+c#undef DEBUG
c
C
cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
dZZ_Ci1(k)=0.0d0
dZZ_Ci(k)=0.0d0
do j=1,3
- dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
- dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
+ dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
+ & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
+ dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
+ & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
enddo
dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
- dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
+ dZZ_XYZ(k)=vbld_inv(i+nres)*
+ & (z_prime(k)-zz*dC_norm(k,i+nres))
c
dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
etors=0.0D0
do i=iphi_start,iphi_end
etors_ii=0.0D0
- if (itype(i-2).eq.21 .or. itype(i-1).eq.21
- & .or. itype(i).eq.21) cycle
+ if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
+ & .or. itype(i).eq.ntyp1) cycle
itori=itortyp(itype(i-2))
itori1=itortyp(itype(i-1))
phii=phi(i)
difi=phii-phi0(i)
if (difi.gt.drange(i)) then
difi=difi-drange(i)
- edihcnstr=edihcnstr+0.25d0*ftors*difi**4
- gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
+ edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
+ gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
else if (difi.lt.-drange(i)) then
difi=difi+drange(i)
- edihcnstr=edihcnstr+0.25d0*ftors*difi**4
- gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
+ edihcnstr=edihcnstr+0.25d0*ftors(i)**difi**4
+ gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
endif
! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
c lprn=.true.
etors=0.0D0
do i=iphi_start,iphi_end
- if (itype(i-2).eq.21 .or. itype(i-1).eq.21
- & .or. itype(i).eq.21) cycle
+ if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
+ & .or. itype(i).eq.ntyp1) cycle
etors_ii=0.0D0
+ if (iabs(itype(i)).eq.20) then
+ iblock=2
+ else
+ iblock=1
+ endif
itori=itortyp(itype(i-2))
itori1=itortyp(itype(i-1))
phii=phi(i)
gloci=0.0D0
C Regular cosine and sine terms
- do j=1,nterm(itori,itori1)
- v1ij=v1(j,itori,itori1)
- v2ij=v2(j,itori,itori1)
+ do j=1,nterm(itori,itori1,iblock)
+ v1ij=v1(j,itori,itori1,iblock)
+ v2ij=v2(j,itori,itori1,iblock)
cosphi=dcos(j*phii)
sinphi=dsin(j*phii)
etors=etors+v1ij*cosphi+v2ij*sinphi
C
cosphi=dcos(0.5d0*phii)
sinphi=dsin(0.5d0*phii)
- do j=1,nlor(itori,itori1)
+ do j=1,nlor(itori,itori1,iblock)
vl1ij=vlor1(j,itori,itori1)
vl2ij=vlor2(j,itori,itori1)
vl3ij=vlor3(j,itori,itori1)
gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
enddo
C Subtract the constant term
- etors=etors-v0(itori,itori1)
+ etors=etors-v0(itori,itori1,iblock)
if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
- & 'etor',i,etors_ii-v0(itori,itori1)
+ & 'etor',i,etors_ii-v0(itori,itori1,iblock)
if (lprn)
& write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
& restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
- & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
+ & (v1(j,itori,itori1,iblock),j=1,6),
+ & (v2(j,itori,itori1,iblock),j=1,6)
gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
enddo
difi=pinorm(phii-phi0(i))
if (difi.gt.drange(i)) then
difi=difi-drange(i)
- edihcnstr=edihcnstr+0.25d0*ftors*difi**4
- gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
+ edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
+ gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
else if (difi.lt.-drange(i)) then
difi=difi+drange(i)
- edihcnstr=edihcnstr+0.25d0*ftors*difi**4
- gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
+ edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
+ gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
else
difi=0.0
endif
-cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
-cd & rad2deg*phi0(i), rad2deg*drange(i),
-cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
+ if (energy_dec) then
+ write (iout,'(a6,2i5,4f8.3,2e14.5)') "edihc",
+ & i,itori,rad2deg*phii,
+ & rad2deg*phi0(i), rad2deg*drange(i),
+ & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
+ endif
enddo
cd write (iout,*) 'edihcnstr',edihcnstr
return
lprn=.false.
c lprn=.true.
etors_d=0.0D0
+c write(iout,*) "a tu??"
do i=iphid_start,iphid_end
- if (itype(i-2).eq.21 .or. itype(i-1).eq.21
- & .or. itype(i).eq.21 .or. itype(i+1).eq.21) cycle
+ if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
+ & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
itori=itortyp(itype(i-2))
itori1=itortyp(itype(i-1))
itori2=itortyp(itype(i))
phii1=phi(i+1)
gloci1=0.0D0
gloci2=0.0D0
+ iblock=1
+ if (iabs(itype(i+1)).eq.20) iblock=2
+
C Regular cosine and sine terms
- do j=1,ntermd_1(itori,itori1,itori2)
- v1cij=v1c(1,j,itori,itori1,itori2)
- v1sij=v1s(1,j,itori,itori1,itori2)
- v2cij=v1c(2,j,itori,itori1,itori2)
- v2sij=v1s(2,j,itori,itori1,itori2)
+ do j=1,ntermd_1(itori,itori1,itori2,iblock)
+ v1cij=v1c(1,j,itori,itori1,itori2,iblock)
+ v1sij=v1s(1,j,itori,itori1,itori2,iblock)
+ v2cij=v1c(2,j,itori,itori1,itori2,iblock)
+ v2sij=v1s(2,j,itori,itori1,itori2,iblock)
cosphi1=dcos(j*phii)
sinphi1=dsin(j*phii)
cosphi2=dcos(j*phii1)
gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
enddo
- do k=2,ntermd_2(itori,itori1,itori2)
+ do k=2,ntermd_2(itori,itori1,itori2,iblock)
do l=1,k-1
- v1cdij = v2c(k,l,itori,itori1,itori2)
- v2cdij = v2c(l,k,itori,itori1,itori2)
- v1sdij = v2s(k,l,itori,itori1,itori2)
- v2sdij = v2s(l,k,itori,itori1,itori2)
+ v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
+ v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
+ v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
+ v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
cosphi1p2=dcos(l*phii+(k-l)*phii1)
cosphi1m2=dcos(l*phii-(k-l)*phii1)
sinphi1p2=dsin(l*phii+(k-l)*phii1)
C Set lprn=.true. for debugging
lprn=.false.
c lprn=.true.
-c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
+c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
esccor=0.0D0
- do i=iphi_start,iphi_end
- if (itype(i-2).eq.21 .or. itype(i-1).eq.21) cycle
+ do i=itau_start,itau_end
+ if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
esccor_ii=0.0D0
- itori=itype(i-2)
- itori1=itype(i-1)
+ isccori=isccortyp(itype(i-2))
+ isccori1=isccortyp(itype(i-1))
+c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
phii=phi(i)
+ do intertyp=1,3 !intertyp
+cc Added 09 May 2012 (Adasko)
+cc Intertyp means interaction type of backbone mainchain correlation:
+c 1 = SC...Ca...Ca...Ca
+c 2 = Ca...Ca...Ca...SC
+c 3 = SC...Ca...Ca...SCi
gloci=0.0D0
- do j=1,nterm_sccor
- v1ij=v1sccor(j,itori,itori1)
- v2ij=v2sccor(j,itori,itori1)
- cosphi=dcos(j*phii)
- sinphi=dsin(j*phii)
+ if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
+ & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
+ & (itype(i-1).eq.ntyp1)))
+ & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
+ & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
+ & .or.(itype(i).eq.ntyp1)))
+ & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
+ & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
+ & (itype(i-3).eq.ntyp1)))) cycle
+ if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
+ if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
+ & cycle
+ do j=1,nterm_sccor(isccori,isccori1)
+ v1ij=v1sccor(j,intertyp,isccori,isccori1)
+ v2ij=v2sccor(j,intertyp,isccori,isccori1)
+ cosphi=dcos(j*tauangle(intertyp,i))
+ sinphi=dsin(j*tauangle(intertyp,i))
esccor=esccor+v1ij*cosphi+v2ij*sinphi
gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
enddo
+c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
+ gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
if (lprn)
& write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
- & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
- & (v1sccor(j,itori,itori1),j=1,6),(v2sccor(j,itori,itori1),j=1,6)
+ & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
+ & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
+ & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
+ enddo !intertyp
enddo
+
return
end
c----------------------------------------------------------------------------
cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
cgrad ghalf=0.5d0*ggg2(ll)
cd ghalf=0.0d0
- gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
+ gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
- gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
+ gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
include 'COMMON.GEO'
logical swap
double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
- & auxvec1(2),auxvec2(1),auxmat1(2,2)
+ & auxvec1(2),auxvec2(2),auxmat1(2,2)
logical lprn
common /kutas/ lprn
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C o o C
C \ /l\ /j\ / C
C \ / \ / \ / C
-C o| o | | o |o C
+C o| o | | o |o C
C \ j|/k\| \ |/k\|l C
C \ / \ \ / \ C
C o o C
-C i i C
-C C
+C i i C
+C C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
C AL 7/4/01 s1 would occur in the sixth-order moment,
double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
logical swap
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C C
+C C
C Parallel Antiparallel C
C C
-C o o C
+C o o C
C /l\ / \ /j\ C
C / \ / \ / \ C
C /| o |o o| o |\ C
& auxvec1(2),auxmat1(2,2)
logical swap
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-C C
+C C
C Parallel Antiparallel C
C C
C o o C
C / \ / \ / \ C
C /| o |o o| o |\ C
C \ j|/k\| \ |/k\|l C
-C \ / \ \ / \ C
+C \ / \ \ / \ C
C o \ o \ C
C i i C
-C C
+C C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C 4/7/01 AL Component s1 was removed, because it pertains to the respective
projects / unres.git / blobdiff