+#ifndef LBFGS
subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm)
implicit none
include 'DIMENSIONS'
if (nf.eq.0) return
goto 40
30 call var_to_geom(n,x)
- call chainbuild
+ call chainbuild_extconf
c write (iout,*) 'grad 30'
C
-C Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
-C
- 40 call cartder
-c write (iout,*) 'grad 40'
-c print *,'GRADIENT: nnt=',nnt,' nct=',nct,' expon=',expon
-C
-C Convert the Cartesian gradient into internal-coordinate gradient.
+C Transform the gradient to the gradient in angles.
C
- ind=0
- ind1=0
- do i=1,nres-2
- gthetai=0.0D0
- gphii=0.0D0
- do j=i+1,nres-1
- ind=ind+1
-c ind=indmat(i,j)
-c print *,'GRAD: i=',i,' jc=',j,' ind=',ind
- do k=1,3
- gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
- enddo
- do k=1,3
- gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
- enddo
- enddo
- do j=i+1,nres-1
- ind1=ind1+1
-c ind1=indmat(i,j)
-c print *,'GRAD: i=',i,' jx=',j,' ind1=',ind1
- do k=1,3
- gthetai=gthetai+dxdv(k,ind1)*gradx(k,j,icg)
- gphii=gphii+dxdv(k+3,ind1)*gradx(k,j,icg)
- enddo
- enddo
- if (i.gt.1) g(i-1)=gphii
- if (n.gt.nphi) g(nphi+i)=gthetai
- enddo
- if (n.le.nphi+ntheta) goto 10
- do i=2,nres-1
- if (itype(i).ne.10) then
- galphai=0.0D0
- gomegai=0.0D0
- do k=1,3
- galphai=galphai+dxds(k,i)*gradx(k,i,icg)
- enddo
- do k=1,3
- gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
- enddo
- g(ialph(i,1))=galphai
- g(ialph(i,1)+nside)=gomegai
- endif
- enddo
+ 40 call cart2intgrad(n,g)
C
C Add the components corresponding to local energy terms.
C
external ufparm
integer uiparm(1)
double precision urparm(1)
- double precision x(maxvar),g(maxvar)
+ double precision x(maxvar),g(maxvar),gg(maxvar)
integer i,j,k,ig,ind,ij,igall
double precision f,gthetai,gphii,galphai,gomegai
C
C Evaluate the derivatives of virtual bond lengths and SC vectors in variables.
C
- 40 call cartder
+ 40 call cart2intgrad(n,gg)
C
C Convert the Cartesian gradient into internal-coordinate gradient.
C
ig=0
- ind=nres-2
+ ind=nres-2
do i=2,nres-2
- IF (mask_phi(i+2).eq.1) THEN
- gphii=0.0D0
- do j=i+1,nres-1
- ind=ind+1
- do k=1,3
- gphii=gphii+dcdv(k+3,ind)*gradc(k,j,icg)
- gphii=gphii+dxdv(k+3,ind)*gradx(k,j,icg)
- enddo
- enddo
+ IF (mask_phi(i+2).eq.1) THEN
ig=ig+1
- g(ig)=gphii
- ELSE
- ind=ind+nres-1-i
+ g(ig)=gg(i-1)
ENDIF
enddo
- ind=0
do i=1,nres-2
IF (mask_theta(i+2).eq.1) THEN
ig=ig+1
- gthetai=0.0D0
- do j=i+1,nres-1
- ind=ind+1
- do k=1,3
- gthetai=gthetai+dcdv(k,ind)*gradc(k,j,icg)
- gthetai=gthetai+dxdv(k,ind)*gradx(k,j,icg)
- enddo
- enddo
- g(ig)=gthetai
- ELSE
- ind=ind+nres-1-i
+ g(ig)=gg(nphi+i)
ENDIF
enddo
do i=2,nres-1
- if (itype(i).ne.10) then
+ if (itype(i).ne.10) then
IF (mask_side(i).eq.1) THEN
ig=ig+1
- galphai=0.0D0
- do k=1,3
- galphai=galphai+dxds(k,i)*gradx(k,i,icg)
- enddo
- g(ig)=galphai
+ g(ig)=gg(ialph(i,1))
ENDIF
endif
enddo
if (itype(i).ne.10) then
IF (mask_side(i).eq.1) THEN
ig=ig+1
- gomegai=0.0D0
- do k=1,3
- gomegai=gomegai+dxds(k+3,i)*gradx(k,i,icg)
- enddo
- g(ig)=gomegai
+ g(ig)=gg(ialph(i,1)+nside)
ENDIF
endif
enddo
cd enddo
return
end
+#endif
C-------------------------------------------------------------------------
subroutine cartgrad
implicit none
#ifdef DEBUG
write (iout,*) "gcart, gxcart, gloc before int_to_cart"
#endif
- do i=1,nct
+ do i=0,nct
do j=1,3
gcart(j,i)=gradc(j,i,icg)
gxcart(j,i)=gradx(j,i,icg)
enddo
#ifdef DEBUG
- if((itype(i).ne.10).and.(itype(i).ne.ntyp1)) then
+ if (i.eq.0) then
+ write (iout,'(i5,2(3f10.5,5x),4f10.5)') i,(gcart(j,i),j=1,3),
+ & (gxcart(j,i),j=1,3)
+ else if((itype(i).ne.10).and.(itype(i).ne.ntyp1)) then
write (iout,'(i5,2(3f10.5,5x),4f10.5)') i,(gcart(j,i),j=1,3),
& (gxcart(j,i),j=1,3),gloc(i,icg),gloc(i+nphi,icg),
& gloc(ialph(i,1),icg),gloc(ialph(i,1)+nside,icg)
- else
+ else
write (iout,'(i5,2(3f10.5,5x),4f10.5)') i,(gcart(j,i),j=1,3),
& (gxcart(j,i),j=1,3),gloc(i,icg),gloc(i+nphi,icg)
endif
integer i,j,kk
#ifdef DEBUG
write (iout,*)"Converting virtual-bond gradient to CA/SC gradient"
+ write (iout,*) "dC/dX gradient"
+ do i=0,nres
+ write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),
+ & (gxcart(j,i),j=1,3)
+ enddo
#endif
do i=nres,1,-1
do j=1,3
! (gcart_new(j,i),j=1,3),(gxcart(j,i),j=1,3)
enddo
! Correction: dummy residues
- if (nnt.gt.1) then
- do j=1,3
- gcart(j,nnt)=gcart(j,nnt)+gcart(j,1)
- enddo
- endif
- if (nct.lt.nres) then
- do j=1,3
-! gcart_new(j,nct)=gcart_new(j,nct)+gcart_new(j,nres)
- gcart(j,nct)=gcart(j,nct)+gcart(j,nres)
- enddo
- endif
+ do i=2,nres
+ if (itype(i-1).eq.ntyp1 .and. itype(i).ne.ntyp1) then
+ gcart(:,i)=gcart(:,i)+gcart(:,i-1)
+ else if (itype(i-1).ne.ntyp1 .and. itype(i).eq.ntyp1) then
+ gcart(:,i-1)=gcart(:,i-1)+gcart(:,i)
+ endif
+ enddo
+c if (nnt.gt.1) then
+c do j=1,3
+c gcart(j,nnt)=gcart(j,nnt)+gcart(j,1)
+c enddo
+c endif
+c if (nct.lt.nres) then
+c do j=1,3
+c! gcart_new(j,nct)=gcart_new(j,nct)+gcart_new(j,nres)
+c gcart(j,nct)=gcart(j,nct)+gcart(j,nres)
+c enddo
+c endif
#ifdef DEBUG
write (iout,*) "CA/SC gradient"
do i=1,nres
projects / unres.git / blobdiff