X-Git-Url: http://mmka.chem.univ.gda.pl/gitweb/?a=blobdiff_plain;f=source%2Funres%2Fsrc-HCD-5D%2Fcheckder_p.F;h=48eeddaafd2e6a532da2e8d8f73ecf8d5b98308c;hb=5836ecdab5a8b95f079bbf6e07374dee3fce8a26;hp=e7f0c1c772a11c2f7752cf6938e0ef1424e8756b;hpb=a05e8996b6fb955dc21aef7a85db21ee73d0a9d3;p=unres.git diff --git a/source/unres/src-HCD-5D/checkder_p.F b/source/unres/src-HCD-5D/checkder_p.F index e7f0c1c..48eedda 100644 --- a/source/unres/src-HCD-5D/checkder_p.F +++ b/source/unres/src-HCD-5D/checkder_p.F @@ -88,265 +88,6 @@ C Check the gradient of the energy in Cartesian coordinates. enddo return end -#ifdef FIVEDIAG -!----------------------------------------------------------------------------- - subroutine check_ecartint -! Check the gradient of the energy in Cartesian coordinates. - implicit none - include 'DIMENSIONS' - include 'COMMON.CONTROL' - include 'COMMON.CHAIN' - include 'COMMON.INTERACT' - include 'COMMON.DERIV' - include 'COMMON.IOUNITS' - include 'COMMON.VAR' - include 'COMMON.CONTACTS' - include 'COMMON.MD' - include 'COMMON.LOCAL' - include 'COMMON.SPLITELE' - integer icall - common /srutu/ icall - double precision ggg(6),ggg1(6),cc(3),xx(3),ddc(3),ddx(3), - & x(maxvar),g(maxvar) - double precision dcnorm_safe(3),dxnorm_safe(3) - double precision grad_s(6,0:maxres),grad_s1(6,0:maxres) - double precision phi_temp(maxres),theta_temp(maxres), - & alph_temp(maxres),omeg_temp(maxres) - double precision ddc1(3),ddcn(3),dcnorm_safe1(3),dcnorm_safe2(3) - double precision energia(0:n_ene),energia1(0:n_ene) - integer uiparm(1) - double precision urparm(1) - double precision fdum - external fdum - integer i,j,k,nf - double precision etot,etot1,etot2,etot11,etot12,etot21,etot22 - double precision dist,alpha,beta - icg=1 - nf=0 - nfl=0 - call intout -! call intcartderiv -! call checkintcartgrad - call zerograd - aincr=1.0D-5 - write(iout,*) 'Calling CHECK_ECARTINT.' - nf=0 - icall=0 - write (iout,*) "Before geom_to_var" - call geom_to_var(nvar,x) - write (iout,*) "after geom_to_var" - write (iout,*) "split_ene ",split_ene - call flush(iout) - if (.not.split_ene) then - write(iout,*) 'Calling CHECK_ECARTINT if' - call etotal(energia) -!elwrite(iout,*) 'Calling CHECK_ECARTINT if' - etot=energia(0) - write (iout,*) "etot",etot - call enerprint(energia(0)) - call flush(iout) -!el call enerprint(energia) -!elwrite(iout,*) 'Calling CHECK_ECARTINT if' -c call flush(iout) -c write (iout,*) "enter cartgrad" -c call flush(iout) - call cartgrad -c Transform the gradient to the CA-SC basis - call grad_transform -!elwrite(iout,*) 'Calling CHECK_ECARTINT if' -c write (iout,*) "exit cartgrad" -c call flush(iout) - icall =1 -c do i=1,nres -c write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3) -c enddo - do j=1,3 - grad_s(j,0)=gcart(j,0) - enddo -!elwrite(iout,*) 'Calling CHECK_ECARTINT if' - do i=1,nres - do j=1,3 - grad_s(j,i)=gcart(j,i) - grad_s(j+3,i)=gxcart(j,i) - enddo - enddo - else -c write(iout,*) 'Calling CHECK_ECARTIN else.' -!- split gradient check - call zerograd - call etotal_long(energia) - call enerprint(energia(0)) -!el call enerprint(energia) -c call flush(iout) -c write (iout,*) "enter cartgrad" -c call flush(iout) - call cartgrad -c Transform the gradient to CA-SC coordinates - call grad_transform -c write (iout,*) "exit cartgrad" -c call flush(iout) - icall =1 - write (iout,*) "longrange grad" - do i=1,nres - write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), - & (gxcart(j,i),j=1,3) - enddo - do j=1,3 - grad_s(j,0)=gcart(j,0) - enddo - do i=1,nres - do j=1,3 - grad_s(j,i)=gcart(j,i) - grad_s(j+3,i)=gxcart(j,i) - enddo - enddo - call zerograd - call etotal_short(energia) - call enerprint(energia(0)) - call flush(iout) -c write (iout,*) "enter cartgrad" -c call flush(iout) - call cartgrad -c write (iout,*) "exit cartgrad" -c call flush(iout) -c Transform the gradient to CA-SC basis - call grad_transform - icall =1 - write (iout,*) "shortrange grad" - do i=1,nres - write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), - & (gxcart(j,i),j=1,3) - enddo - do j=1,3 - grad_s1(j,0)=gcart(j,0) - enddo - do i=1,nres - do j=1,3 - grad_s1(j,i)=gcart(j,i) - grad_s1(j+3,i)=gxcart(j,i) - enddo - enddo - endif - write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors' -! do i=1,nres -c do i=nnt,nct - do i=1,nres - do j=1,3 - if (nnt.gt.1 .and. i.eq.nnt) ddc1(j)=c(j,1) - if (nct.lt.nres .and. i.eq.nct) ddcn(j)=c(j,nres) - ddc(j)=c(j,i) - ddx(j)=c(j,i+nres) - dcnorm_safe1(j)=dc_norm(j,i-1) - dcnorm_safe2(j)=dc_norm(j,i) - dxnorm_safe(j)=dc_norm(j,i+nres) - enddo - do j=1,3 - c(j,i)=ddc(j)+aincr - if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=c(j,1)+aincr - if (nct.lt.nres .and. i.eq.nct) c(j,nres)=c(j,nres)+aincr - if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1) - dc(j,i)=c(j,i+1)-c(j,i) - dc(j,i+nres)=c(j,i+nres)-c(j,i) - call int_from_cart1(.false.) - if (.not.split_ene) then - call etotal(energia1) - etot1=energia1(0) -c write (iout,*) "ij",i,j," etot1",etot1 - else -!- split gradient - call etotal_long(energia1) - etot11=energia1(0) - call etotal_short(energia1) - etot12=energia1(0) - endif -!- end split gradient -! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1 - c(j,i)=ddc(j)-aincr - if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j)-aincr - if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j)-aincr - if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1) - dc(j,i)=c(j,i+1)-c(j,i) - dc(j,i+nres)=c(j,i+nres)-c(j,i) - call int_from_cart1(.false.) - if (.not.split_ene) then - call etotal(energia1) - etot2=energia1(0) -c write (iout,*) "ij",i,j," etot2",etot2 - ggg(j)=(etot1-etot2)/(2*aincr) - else -!- split gradient - call etotal_long(energia1) - etot21=energia1(0) - ggg(j)=(etot11-etot21)/(2*aincr) - call etotal_short(energia1) - etot22=energia1(0) - ggg1(j)=(etot12-etot22)/(2*aincr) -!- end split gradient -! write (iout,*) "etot21",etot21," etot22",etot22 - endif -! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2 - c(j,i)=ddc(j) - if (nnt.gt.1 .and. i.eq.nnt) c(j,1)=ddc1(j) - if (nct.lt.nres .and. i.eq.nct) c(j,nres)=ddcn(j) - if (i.gt.1) dc(j,i-1)=c(j,i)-c(j,i-1) - dc(j,i)=c(j,i+1)-c(j,i) - dc(j,i+nres)=c(j,i+nres)-c(j,i) - dc_norm(j,i-1)=dcnorm_safe1(j) - dc_norm(j,i)=dcnorm_safe2(j) - dc_norm(j,i+nres)=dxnorm_safe(j) - enddo - do j=1,3 - c(j,i+nres)=ddx(j)+aincr - dc(j,i+nres)=c(j,i+nres)-c(j,i) - call int_from_cart1(.false.) - if (.not.split_ene) then - call etotal(energia1) - etot1=energia1(0) - else -!- split gradient - call etotal_long(energia1) - etot11=energia1(0) - call etotal_short(energia1) - etot12=energia1(0) - endif -!- end split gradient - c(j,i+nres)=ddx(j)-aincr - dc(j,i+nres)=c(j,i+nres)-c(j,i) - call int_from_cart1(.false.) - if (.not.split_ene) then - call etotal(energia1) - etot2=energia1(0) - ggg(j+3)=(etot1-etot2)/(2*aincr) - else -!- split gradient - call etotal_long(energia1) - etot21=energia1(0) - ggg(j+3)=(etot11-etot21)/(2*aincr) - call etotal_short(energia1) - etot22=energia1(0) - ggg1(j+3)=(etot12-etot22)/(2*aincr) -!- end split gradient - endif -! write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2 - c(j,i+nres)=ddx(j) - dc(j,i+nres)=c(j,i+nres)-c(j,i) - dc_norm(j,i+nres)=dxnorm_safe(j) - call int_from_cart1(.false.) - enddo - write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') - & i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6) - if (split_ene) then - write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') - & i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i), - & k=1,6) - write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)') - & i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6), - & ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6) - endif - enddo - return - end -#else c---------------------------------------------------------------------------- subroutine check_ecartint C Check the gradient of the energy in Cartesian coordinates. @@ -426,15 +167,15 @@ c call flush(iout) call etotal_long(energia(0)) call enerprint(energia(0)) call flush(iout) - write (iout,*) "enter cartgrad" - call flush(iout) +c write (iout,*) "enter cartgrad" +c call flush(iout) call cartgrad - write (iout,*) "exit cartgrad" - call flush(iout) +c write (iout,*) "exit cartgrad" +c call flush(iout) icall =1 write (iout,*) "longrange grad" do i=1,nres - write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), + write (iout,'(i4,3e12.4,3x,3e12.4)') i,(gcart(j,i),j=1,3), & (gxcart(j,i),j=1,3) enddo do j=1,3 @@ -450,15 +191,15 @@ c call flush(iout) call etotal_short(energia(0)) call enerprint(energia(0)) call flush(iout) - write (iout,*) "enter cartgrad" - call flush(iout) +c write (iout,*) "enter cartgrad" +c call flush(iout) call cartgrad - write (iout,*) "exit cartgrad" - call flush(iout) +c write (iout,*) "exit cartgrad" +c call flush(iout) icall =1 write (iout,*) "shortrange grad" do i=1,nres - write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3), + write (iout,'(i4,3e12.4,3x,3e12.4)') i,(gcart(j,i),j=1,3), & (gxcart(j,i),j=1,3) enddo do j=1,3 @@ -592,7 +333,6 @@ c write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2 enddo return end -#endif c------------------------------------------------------------------------- subroutine int_from_cart1(lprn) implicit none