X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=blobdiff_plain;f=source%2Funres%2Fsrc-HCD-5D%2Fgradient_p.F;h=67275ed61b439f3c53578cdbf8f461684456cfa0;hb=f9783c27de185ff3e1d6e874a37a1a8c4d3c93a3;hp=1d89e0fe369efa73017440e2a8c45f0504b8f377;hpb=48ae9e01d2dd6571fa2cca6c704dc04f86e5fd7b;p=unres.git diff --git a/source/unres/src-HCD-5D/gradient_p.F b/source/unres/src-HCD-5D/gradient_p.F index 1d89e0f..67275ed 100644 --- a/source/unres/src-HCD-5D/gradient_p.F +++ b/source/unres/src-HCD-5D/gradient_p.F @@ -1,3 +1,4 @@ +#ifndef LBFGS subroutine gradient(n,x,nf,g,uiparm,urparm,ufparm) implicit none include 'DIMENSIONS' @@ -36,60 +37,12 @@ c write (iout,*) 'grad 20' 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 @@ -128,7 +81,7 @@ 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 @@ -158,58 +111,33 @@ c write(iout,*) (var(i),i=1,nvar) 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 @@ -219,11 +147,7 @@ C 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 @@ -267,6 +191,7 @@ cd write (iout,'(a2,i5,a3,f25.8)') 'i=',i,' g=',g(i) cd enddo return end +#endif C------------------------------------------------------------------------- subroutine cartgrad implicit none @@ -353,17 +278,20 @@ cd write(iout,*) 'calling int_to_cart' #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 @@ -410,6 +338,11 @@ c--------------------------------------------------------------------------- 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 @@ -420,17 +353,24 @@ c--------------------------------------------------------------------------- ! (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