source/unres/src-HCD-5D/check_cartgrad.F

   1       subroutine check_cartgrad
   2 C Check the gradient of Cartesian coordinates in internal coordinates.
   3       implicit none
   4       include 'DIMENSIONS'
   5       include 'COMMON.CONTROL'
   6       include 'COMMON.IOUNITS'
   7       include 'COMMON.VAR'
   8       include 'COMMON.CHAIN'
   9       include 'COMMON.GEO'
  10       include 'COMMON.LOCAL'
  11       include 'COMMON.DERIV'
  12       double precision temp(6,maxres),xx(3),gg(3),thet,theti,phii,alphi,
  13      & omegi,aincr2
  14       integer indmat
  15       integer i,ii,j,k
  16       indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
  17       integer nf
  18 *
  19 * Check the gradient of the virtual-bond and SC vectors in the internal
  20 * coordinates.
  21 *
  22       print '("Calling CHECK_ECART",1pd12.3)',aincr
  23       write (iout,'("Calling CHECK_ECART",1pd12.3)') aincr
  24       aincr2=0.5d0*aincr
  25       call chainbuild_extconf
  26       call cartder
  27       write (iout,'(a)') '**************** dx/dalpha'
  28       write (iout,'(a)')
  29       do i=2,nres-1
  30         alphi=alph(i)
  31         alph(i)=alph(i)+aincr
  32         do k=1,3
  33           temp(k,i)=dc(k,nres+i)
  34         enddo
  35         call chainbuild_extconf
  36         do k=1,3
  37           gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
  38           xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr))
  39         enddo
  40         write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)')
  41      &  i,(gg(k),k=1,3),(dxds(k,i),k=1,3),(xx(k),k=1,3)
  42         write (iout,'(a)')
  43         alph(i)=alphi
  44         call chainbuild_extconf
  45       enddo
  46       write (iout,'(a)')
  47       write (iout,'(a)') '**************** dx/domega'
  48       write (iout,'(a)')
  49       do i=2,nres-1
  50         omegi=omeg(i)
  51         omeg(i)=omeg(i)+aincr
  52         do k=1,3
  53           temp(k,i)=dc(k,nres+i)
  54         enddo
  55         call chainbuild_extconf
  56         do k=1,3
  57           gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
  58           xx(k)=dabs((gg(k)-dxds(k+3,i))/
  59      &          (aincr*dabs(dxds(k+3,i))+aincr))
  60         enddo
  61         write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)')
  62      &      i,(gg(k),k=1,3),(dxds(k+3,i),k=1,3),(xx(k),k=1,3)
  63         write (iout,'(a)')
  64         omeg(i)=omegi
  65         call chainbuild_extconf
  66       enddo
  67       write (iout,'(a)')
  68       write (iout,'(a)') '**************** dx/dtheta'
  69       write (iout,'(a)')
  70       do i=3,nres
  71         theti=theta(i)
  72         theta(i)=theta(i)+aincr
  73         do j=i-1,nres-1
  74           do k=1,3
  75             temp(k,j)=dc(k,nres+j)
  76           enddo
  77         enddo
  78         call chainbuild_extconf
  79         do j=i-1,nres-1
  80           ii = indmat(i-2,j)
  81 c         print *,'i=',i-2,' j=',j-1,' ii=',ii
  82           do k=1,3
  83             gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
  84             xx(k)=dabs((gg(k)-dxdv(k,ii))/
  85      &            (aincr*dabs(dxdv(k,ii))+aincr))
  86           enddo
  87           write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)')
  88      &        i,j,(gg(k),k=1,3),(dxdv(k,ii),k=1,3),(xx(k),k=1,3)
  89           write(iout,'(a)')
  90         enddo
  91         write (iout,'(a)')
  92         theta(i)=theti
  93         call chainbuild_extconf
  94       enddo
  95       write (iout,'(a)') '***************** dx/dphi'
  96       write (iout,'(a)')
  97       do i=4,nres
  98         phi(i)=phi(i)+aincr
  99         do j=i-1,nres-1
 100           do k=1,3
 101             temp(k,j)=dc(k,nres+j)
 102           enddo
 103         enddo
 104         call chainbuild_extconf
 105         do j=i-1,nres-1
 106           ii = indmat(i-2,j)
 107 c         print *,'ii=',ii
 108           do k=1,3
 109             gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
 110             xx(k)=dabs((gg(k)-dxdv(k+3,ii))/
 111      &            (aincr*dabs(dxdv(k+3,ii))+aincr))
 112           enddo
 113           write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)')
 114      &        i,j,(gg(k),k=1,3),(dxdv(k+3,ii),k=1,3),(xx(k),k=1,3)
 115           write(iout,'(a)')
 116         enddo
 117         phi(i)=phi(i)-aincr
 118         call chainbuild_extconf
 119       enddo
 120       write (iout,'(a)') '****************** ddc/dtheta'
 121       do i=1,nres-2
 122         thet=theta(i+2)
 123         theta(i+2)=thet+aincr
 124         do j=i,nres
 125           do k=1,3
 126             temp(k,j)=dc(k,j)
 127           enddo
 128         enddo
 129         call chainbuild_extconf
 130         do j=i+1,nres-1
 131           ii = indmat(i,j)
 132 c         print *,'ii=',ii
 133           do k=1,3
 134             gg(k)=(dc(k,j)-temp(k,j))/aincr
 135             xx(k)=dabs((gg(k)-dcdv(k,ii))/
 136      &           (aincr*dabs(dcdv(k,ii))+aincr))
 137           enddo
 138           write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)')
 139      &           i,j,(gg(k),k=1,3),(dcdv(k,ii),k=1,3),(xx(k),k=1,3)
 140           write (iout,'(a)')
 141         enddo
 142         do j=1,nres
 143           do k=1,3
 144             dc(k,j)=temp(k,j)
 145           enddo
 146         enddo
 147         theta(i+2)=thet
 148       enddo
 149       write (iout,'(a)') '******************* ddc/dphi'
 150       do i=1,nres-3
 151         phii=phi(i+3)
 152         phi(i+3)=phii+aincr
 153         do j=1,nres
 154           do k=1,3
 155             temp(k,j)=dc(k,j)
 156           enddo
 157         enddo
 158         call chainbuild_extconf
 159         do j=i+2,nres-1
 160           ii = indmat(i+1,j)
 161 c         print *,'ii=',ii
 162           do k=1,3
 163             gg(k)=(dc(k,j)-temp(k,j))/aincr
 164             xx(k)=dabs((gg(k)-dcdv(k+3,ii))/
 165      &           (aincr*dabs(dcdv(k+3,ii))+aincr))
 166           enddo
 167           write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)')
 168      &         i,j,(gg(k),k=1,3),(dcdv(k+3,ii),k=1,3),(xx(k),k=1,3)
 169           write (iout,'(a)')
 170         enddo
 171         do j=1,nres
 172           do k=1,3
 173             dc(k,j)=temp(k,j)
 174           enddo
 175         enddo
 176         phi(i+3)=phii
 177       enddo
 178       return
 179       end