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
+ if (dyn_ss) call dyn_set_nss
+
c print *,"Processor",myrank," computed USCSC"
#ifdef TIMING
#ifdef MPI
do i=1,4*nres
glocbuf(i)=gloc(i,icg)
enddo
-#define DEBUG
#ifdef DEBUG
write (iout,*) "gloc_sc before reduce"
do i=1,nres
enddo
enddo
#endif
-#undef DEBUG
do i=1,nres
do j=1,3
gloc_scbuf(j,i)=gloc_sc(j,i,icg)
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
-#define DEBUG
#ifdef DEBUG
write (iout,*) "gloc_sc after reduce"
do i=1,nres
enddo
enddo
#endif
-#undef DEBUG
#ifdef DEBUG
write (iout,*) "gloc after reduce"
do i=1,4*nres
c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
evdw=0.0D0
do i=iatsc_s,iatsc_e
- itypi=iabs(itype(i))
- itypi1=iabs(itype(i+1))
+ itypi=itype(i)
+ itypi1=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=iabs(itype(j))
+ itypj=itype(j)
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=iabs(itype(i))
- itypi1=iabs(itype(i+1))
+ itypi=itype(i)
+ itypi1=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=iabs(itype(j))
+ itypj=itype(j)
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=iabs(itype(i))
- itypi1=iabs(itype(i+1))
+ itypi=itype(i)
+ itypi1=itype(i+1)
xi=c(1,nres+i)
yi=c(2,nres+i)
zi=c(3,nres+i)
include 'COMMON.IOUNITS'
include 'COMMON.CALC'
include 'COMMON.CONTROL'
+ include 'COMMON.SBRIDGE'
logical lprn
evdw=0.0D0
ccccc energy_dec=.false.
c if (icall.eq.0) lprn=.false.
ind=0
do i=iatsc_s,iatsc_e
- itypi=iabs(itype(i))
- itypi1=iabs(itype(i+1))
+ itypi=itype(i)
+ itypi1=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
+ call dyn_ssbond_ene(i,j,evdwij)
+ evdw=evdw+evdwij
+ ELSE
ind=ind+1
- itypj=iabs(itype(j))
+ itypj=itype(j)
c dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(j+nres)
c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
#else
call sc_grad
#endif
+ 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=iabs(itype(i))
- itypi1=iabs(itype(i+1))
+ itypi=itype(i)
+ itypi1=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=iabs(itype(j))
+ itypj=itype(j)
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=iabs(itype(i))
- itypi1=iabs(itype(i+1))
+ itypi=itype(i)
+ itypi1=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=iabs(itype(j))
+ itypj=itype(j)
xj=c(1,nres+j)-xi
yj=c(2,nres+j)-yi
zj=c(3,nres+j)-zi
do iint=1,nscp_gr(i)
do j=iscpstart(i,iint),iscpend(i,iint)
- itypj=iabs(itype(j))
+ itypj=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
do iint=1,nscp_gr(i)
do j=iscpstart(i,iint),iscpend(i,iint)
- itypj=iabs(itype(j))
+ itypj=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
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. iabs(itype(iii)).eq.1 .and. iabs(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
+c if (.not.dyn_ss .and. i.le.nss) then
+C 15/02/13 CC dynamic SSbond
+ if (.not.dyn_ss.and.
+ & ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
call ssbond_ene(iii,jjj,eij)
ehpb=ehpb+2*eij
cd write (iout,*) "eij",eij
include 'COMMON.VAR'
include 'COMMON.IOUNITS'
double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
- itypi=iabs(itype(i))
+ itypi=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=iabs(itype(j))
+ itypj=itype(j)
c dscj_inv=dsc_inv(itypj)
dscj_inv=vbld_inv(nres+j)
xj=c(1,nres+j)-xi
c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
c
do i=ibond_start,ibond_end
- iti=iabs(itype(i))
+ iti=itype(i)
if (iti.ne.10) then
nbi=nbondterm(iti)
if (nbi.eq.1) then
do i=ithet_start,ithet_end
C Zero the energy function and its derivative at 0 or pi.
call splinthet(theta(i),0.5d0*delta,ss,ssd)
- it=iabs(itype(i-1))
+ it=itype(i-1)
if (i.gt.3) then
#ifdef OSF
phii=phi(i)
dephii=0.0d0
dephii1=0.0d0
theti2=0.5d0*theta(i)
- ityp2=ithetyp(iabs(itype(i-1)))
+ ityp2=ithetyp(itype(i-1))
do k=1,nntheterm
coskt(k)=dcos(k*theti2)
sinkt(k)=dsin(k*theti2)
#else
phii=phi(i)
#endif
- ityp1=ithetyp(iabs(itype(i-2)))
+ ityp1=ithetyp(itype(i-2))
do k=1,nsingle
cosph1(k)=dcos(k*phii)
sinph1(k)=dsin(k*phii)
#else
phii1=phi(i+1)
#endif
- ityp3=ithetyp(iabs(itype(i)))
+ ityp3=ithetyp(itype(i))
do k=1,nsingle
cosph2(k)=dcos(k*phii1)
sinph2(k)=dsin(k*phii1)
do i=loc_start,loc_end
it=itype(i)
if (it.eq.10) goto 1
- nlobit=nlob(iabs(it))
+ nlobit=nlob(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,iabs(it))-0.5D0*contr(j,iii)+emin
+ adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
if(adexp.ne.adexp) adexp=1.0
expfac=dexp(adexp)
#else
- expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
+ expfac=dexp(bsc(j,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,iabs(it))-0.5D0*contr(j)+emin)
+ expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
escloc_i=escloc_i+expfac
do k=1,2
dersc(k)=dersc(k)+Ax(k,j)*expfac
etors_ii=0.0D0
itori=itortyp(itype(i-2))
itori1=itortyp(itype(i-1))
- if (iabs(itype(i)).eq.20) then
- iblock=2
- else
- iblock=1
- endif
phii=phi(i)
gloci=0.0D0
C Regular cosine and sine terms
- do j=1,nterm(itori,itori1,iblock)
- v1ij=v1(j,itori,itori1,iblock)
- v2ij=v2(j,itori,itori1,iblock)
+ do j=1,nterm(itori,itori1)
+ v1ij=v1(j,itori,itori1)
+ v2ij=v2(j,itori,itori1)
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,iblock)
+ do j=1,nlor(itori,itori1)
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,iblock)
+ etors=etors-v0(itori,itori1)
if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
- & 'etor',i,etors_ii-v0(itori,itori1,iblock)
+ & 'etor',i,etors_ii-v0(itori,itori1)
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,iblock),j=1,6),
- & (v2(j,itori,itori1,iblock),j=1,6)
+ & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
enddo
itori=itortyp(itype(i-2))
itori1=itortyp(itype(i-1))
itori2=itortyp(itype(i))
- iblock=1
- if (iabs(itype(i+1).eq.20)) iblock=2
phii=phi(i)
phii1=phi(i+1)
gloci1=0.0D0
gloci2=0.0D0
- 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)
+ 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)
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,iblock)
+ do k=2,ntermd_2(itori,itori1,itori2)
do l=1,k-1
- 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)
+ 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)
cosphi1p2=dcos(l*phii+(k-l)*phii1)
cosphi1m2=dcos(l*phii-(k-l)*phii1)
sinphi1p2=dsin(l*phii+(k-l)*phii1)
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