source/unres/src_MD-M-SAXS-homology/checkder_p.F

   1       subroutine check_cartgrad
   2 C Check the gradient of Cartesian coordinates in internal coordinates.
   3       implicit real*8 (a-h,o-z)
   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       dimension temp(6,maxres),xx(3),gg(3)
  13       indmat(i,j)=((2*(nres-2)-i)*(i-1))/2+j-1
  14 *
  15 * Check the gradient of the virtual-bond and SC vectors in the internal
  16 * coordinates.
  17 *
  18       print '("Calling CHECK_ECART",1pd12.3)',aincr
  19       write (iout,'("Calling CHECK_ECART",1pd12.3)') aincr
  20       aincr2=0.5d0*aincr
  21       call cartder
  22       write (iout,'(a)') '**************** dx/dalpha'
  23       write (iout,'(a)')
  24       do i=2,nres-1
  25         alphi=alph(i)
  26         alph(i)=alph(i)+aincr
  27         do k=1,3
  28           temp(k,i)=dc(k,nres+i)
  29         enddo
  30         call chainbuild
  31         do k=1,3
  32           gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
  33           xx(k)=dabs((gg(k)-dxds(k,i))/(aincr*dabs(dxds(k,i))+aincr))
  34         enddo
  35         write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)')
  36      &  i,(gg(k),k=1,3),(dxds(k,i),k=1,3),(xx(k),k=1,3)
  37         write (iout,'(a)')
  38         alph(i)=alphi
  39         call chainbuild
  40       enddo
  41       write (iout,'(a)')
  42       write (iout,'(a)') '**************** dx/domega'
  43       write (iout,'(a)')
  44       do i=2,nres-1
  45         omegi=omeg(i)
  46         omeg(i)=omeg(i)+aincr
  47         do k=1,3
  48           temp(k,i)=dc(k,nres+i)
  49         enddo
  50         call chainbuild
  51         do k=1,3
  52           gg(k)=(dc(k,nres+i)-temp(k,i))/aincr
  53           xx(k)=dabs((gg(k)-dxds(k+3,i))/
  54      &          (aincr*dabs(dxds(k+3,i))+aincr))
  55         enddo
  56         write (iout,'(i4,3e15.6/4x,3e15.6,3f9.3)')
  57      &      i,(gg(k),k=1,3),(dxds(k+3,i),k=1,3),(xx(k),k=1,3)
  58         write (iout,'(a)')
  59         omeg(i)=omegi
  60         call chainbuild
  61       enddo
  62       write (iout,'(a)')
  63       write (iout,'(a)') '**************** dx/dtheta'
  64       write (iout,'(a)')
  65       do i=3,nres
  66         theti=theta(i)
  67         theta(i)=theta(i)+aincr
  68         do j=i-1,nres-1
  69           do k=1,3
  70             temp(k,j)=dc(k,nres+j)
  71           enddo
  72         enddo
  73         call chainbuild
  74         do j=i-1,nres-1
  75           ii = indmat(i-2,j)
  76 c         print *,'i=',i-2,' j=',j-1,' ii=',ii
  77           do k=1,3
  78             gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
  79             xx(k)=dabs((gg(k)-dxdv(k,ii))/
  80      &            (aincr*dabs(dxdv(k,ii))+aincr))
  81           enddo
  82           write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)')
  83      &        i,j,(gg(k),k=1,3),(dxdv(k,ii),k=1,3),(xx(k),k=1,3)
  84           write(iout,'(a)')
  85         enddo
  86         write (iout,'(a)')
  87         theta(i)=theti
  88         call chainbuild
  89       enddo
  90       write (iout,'(a)') '***************** dx/dphi'
  91       write (iout,'(a)')
  92       do i=4,nres
  93         phi(i)=phi(i)+aincr
  94         do j=i-1,nres-1
  95           do k=1,3
  96             temp(k,j)=dc(k,nres+j)
  97           enddo
  98         enddo
  99         call chainbuild
 100         do j=i-1,nres-1
 101           ii = indmat(i-2,j)
 102 c         print *,'ii=',ii
 103           do k=1,3
 104             gg(k)=(dc(k,nres+j)-temp(k,j))/aincr
 105             xx(k)=dabs((gg(k)-dxdv(k+3,ii))/
 106      &            (aincr*dabs(dxdv(k+3,ii))+aincr))
 107           enddo
 108           write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)')
 109      &        i,j,(gg(k),k=1,3),(dxdv(k+3,ii),k=1,3),(xx(k),k=1,3)
 110           write(iout,'(a)')
 111         enddo
 112         phi(i)=phi(i)-aincr
 113         call chainbuild
 114       enddo
 115       write (iout,'(a)') '****************** ddc/dtheta'
 116       do i=1,nres-2
 117         thet=theta(i+2)
 118         theta(i+2)=thet+aincr
 119         do j=i,nres
 120           do k=1,3
 121             temp(k,j)=dc(k,j)
 122           enddo
 123         enddo
 124         call chainbuild
 125         do j=i+1,nres-1
 126           ii = indmat(i,j)
 127 c         print *,'ii=',ii
 128           do k=1,3
 129             gg(k)=(dc(k,j)-temp(k,j))/aincr
 130             xx(k)=dabs((gg(k)-dcdv(k,ii))/
 131      &           (aincr*dabs(dcdv(k,ii))+aincr))
 132           enddo
 133           write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)')
 134      &           i,j,(gg(k),k=1,3),(dcdv(k,ii),k=1,3),(xx(k),k=1,3)
 135           write (iout,'(a)')
 136         enddo
 137         do j=1,nres
 138           do k=1,3
 139             dc(k,j)=temp(k,j)
 140           enddo
 141         enddo
 142         theta(i+2)=thet
 143       enddo
 144       write (iout,'(a)') '******************* ddc/dphi'
 145       do i=1,nres-3
 146         phii=phi(i+3)
 147         phi(i+3)=phii+aincr
 148         do j=1,nres
 149           do k=1,3
 150             temp(k,j)=dc(k,j)
 151           enddo
 152         enddo
 153         call chainbuild
 154         do j=i+2,nres-1
 155           ii = indmat(i+1,j)
 156 c         print *,'ii=',ii
 157           do k=1,3
 158             gg(k)=(dc(k,j)-temp(k,j))/aincr
 159             xx(k)=dabs((gg(k)-dcdv(k+3,ii))/
 160      &           (aincr*dabs(dcdv(k+3,ii))+aincr))
 161           enddo
 162           write (iout,'(2i4,3e14.6/8x,3e14.6,3f9.3)')
 163      &         i,j,(gg(k),k=1,3),(dcdv(k+3,ii),k=1,3),(xx(k),k=1,3)
 164           write (iout,'(a)')
 165         enddo
 166         do j=1,nres
 167           do k=1,3
 168             dc(k,j)=temp(k,j)
 169           enddo
 170         enddo
 171         phi(i+3)=phii
 172       enddo
 173       return
 174       end
 175 C----------------------------------------------------------------------------
 176       subroutine check_ecart
 177 C Check the gradient of the energy in Cartesian coordinates.
 178       implicit real*8 (a-h,o-z)
 179       include 'DIMENSIONS'
 180       include 'COMMON.CONTROL'
 181       include 'COMMON.CHAIN'
 182       include 'COMMON.DERIV'
 183       include 'COMMON.IOUNITS'
 184       include 'COMMON.VAR'
 185       include 'COMMON.CONTACTS'
 186       common /srutu/ icall
 187       dimension ggg(6),cc(3),xx(3),ddc(3),ddx(3),x(maxvar),g(maxvar)
 188       dimension grad_s(6,maxres)
 189       double precision energia(0:n_ene),energia1(0:n_ene)
 190       integer uiparm(1)
 191       double precision urparm(1)
 192       external fdum
 193       icg=1
 194       nf=0
 195       nfl=0
 196       call zerograd
 197       print '("Calling CHECK_ECART",1pd12.3)',aincr
 198       write (iout,'("Calling CHECK_ECART",1pd12.3)') aincr
 199       nf=0
 200       icall=0
 201       call geom_to_var(nvar,x)
 202       call etotal(energia(0))
 203       etot=energia(0)
 204       call enerprint(energia(0))
 205       call gradient(nvar,x,nf,g,uiparm,urparm,fdum)
 206       icall =1
 207       do i=1,nres
 208         write (iout,'(i5,3f10.5)') i,(gradxorr(j,i),j=1,3)
 209       enddo
 210       do i=1,nres
 211         do j=1,3
 212           grad_s(j,i)=gradc(j,i,icg)
 213           grad_s(j+3,i)=gradx(j,i,icg)
 214         enddo
 215       enddo
 216       call flush(iout)
 217       write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
 218       do i=1,nres
 219         do j=1,3
 220           xx(j)=c(j,i+nres)
 221           ddc(j)=dc(j,i)
 222           ddx(j)=dc(j,i+nres)
 223         enddo
 224         do j=1,3
 225           dc(j,i)=dc(j,i)+aincr
 226           do k=i+1,nres
 227             c(j,k)=c(j,k)+aincr
 228             c(j,k+nres)=c(j,k+nres)+aincr
 229           enddo
 230           call etotal(energia1(0))
 231           etot1=energia1(0)
 232           ggg(j)=(etot1-etot)/aincr
 233           dc(j,i)=ddc(j)
 234           do k=i+1,nres
 235             c(j,k)=c(j,k)-aincr
 236             c(j,k+nres)=c(j,k+nres)-aincr
 237           enddo
 238         enddo
 239         do j=1,3
 240           c(j,i+nres)=c(j,i+nres)+aincr
 241           dc(j,i+nres)=dc(j,i+nres)+aincr
 242           call etotal(energia1(0))
 243           etot1=energia1(0)
 244           ggg(j+3)=(etot1-etot)/aincr
 245           c(j,i+nres)=xx(j)
 246           dc(j,i+nres)=ddx(j)
 247         enddo
 248         write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/)')
 249      &   i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6)
 250       enddo
 251       return
 252       end
 253 c----------------------------------------------------------------------------
 254       subroutine check_ecartint
 255 C Check the gradient of the energy in Cartesian coordinates.
 256       implicit real*8 (a-h,o-z)
 257       include 'DIMENSIONS'
 258       include 'COMMON.CONTROL'
 259       include 'COMMON.CHAIN'
 260       include 'COMMON.DERIV'
 261       include 'COMMON.IOUNITS'
 262       include 'COMMON.VAR'
 263       include 'COMMON.CONTACTS'
 264       include 'COMMON.MD'
 265       include 'COMMON.LOCAL'
 266       include 'COMMON.SPLITELE'
 267       common /srutu/ icall
 268       dimension ggg(6),ggg1(6),cc(3),xx(3),ddc(3),ddx(3),x(maxvar),
 269      &  g(maxvar)
 270       dimension dcnorm_safe(3),dxnorm_safe(3)
 271       dimension grad_s(6,0:maxres),grad_s1(6,0:maxres)
 272       double precision phi_temp(maxres),theta_temp(maxres),
 273      &  alph_temp(maxres),omeg_temp(maxres)
 274       double precision energia(0:n_ene),energia1(0:n_ene)
 275       integer uiparm(1)
 276       double precision urparm(1)
 277       external fdum
 278 c      r_cut=2.0d0
 279 c      rlambd=0.3d0
 280       icg=1
 281       nf=0
 282       nfl=0
 283       print *,"ATU 3"
 284       call int_from_cart1(.false.)
 285       call intout
 286 c      call intcartderiv
 287 c      call checkintcartgrad
 288       call zerograd
 289 c      aincr=8.0D-7
 290 c      aincr=1.0D-7
 291       print '("Calling CHECK_ECARTINT",1pd12.3)',aincr
 292       write (iout,'("Calling CHECK_ECARTINT",1pd12.3)') aincr
 293       nf=0
 294       icall=0
 295       call geom_to_var(nvar,x)
 296       if (.not.split_ene) then
 297         call etotal(energia(0))
 298         etot=energia(0)
 299         call enerprint(energia(0))
 300         call flush(iout)
 301 c        write (iout,*) "enter cartgrad"
 302         call flush(iout)
 303         call cartgrad
 304 c        write (iout,*) "exit cartgrad"
 305         call flush(iout)
 306         icall =1
 307         write (iout,'(//27(1h*)," Checking energy gradient ",27(1h*))')
 308         write (iout,'(//4x,3a12,3x,3a12)')"gcart_x","gcart_y","gcart_z",
 309      &     "gxcart_x","gxcart_y","gxcart_z"
 310         do i=1,nres
 311           write (iout,'(i4,3e12.4,3x,3e12.4)') i,(gcart(j,i),j=1,3),
 312      &      (gxcart(j,i),j=1,3)
 313         enddo
 314         do j=1,3
 315           grad_s(j,0)=gcart(j,0)
 316         enddo
 317         do i=1,nres
 318           do j=1,3
 319             grad_s(j,i)=gcart(j,i)
 320             grad_s(j+3,i)=gxcart(j,i)
 321           enddo
 322         enddo
 323       else
 324 !- split gradient check
 325         call zerograd
 326         call etotal_long(energia(0))
 327         call enerprint(energia(0))
 328         call flush(iout)
 329         write (iout,*) "enter cartgrad"
 330         call flush(iout)
 331         call cartgrad
 332         write (iout,*) "exit cartgrad"
 333         call flush(iout)
 334         icall =1
 335         write (iout,*) "longrange grad"
 336         do i=1,nres
 337           write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),
 338      &    (gxcart(j,i),j=1,3)
 339         enddo
 340         do j=1,3
 341           grad_s(j,0)=gcart(j,0)
 342         enddo
 343         do i=1,nres
 344           do j=1,3
 345             grad_s(j,i)=gcart(j,i)
 346             grad_s(j+3,i)=gxcart(j,i)
 347           enddo
 348         enddo
 349         call zerograd
 350         call etotal_short(energia(0))
 351         call enerprint(energia(0))
 352         call flush(iout)
 353         write (iout,*) "enter cartgrad"
 354         call flush(iout)
 355         call cartgrad
 356         write (iout,*) "exit cartgrad"
 357         call flush(iout)
 358         icall =1
 359         write (iout,*) "shortrange grad"
 360         do i=1,nres
 361           write (iout,'(i5,3f10.5,5x,3f10.5)') i,(gcart(j,i),j=1,3),
 362      &    (gxcart(j,i),j=1,3)
 363         enddo
 364         do j=1,3
 365           grad_s1(j,0)=gcart(j,0)
 366         enddo
 367         do i=1,nres
 368           do j=1,3
 369             grad_s1(j,i)=gcart(j,i)
 370             grad_s1(j+3,i)=gxcart(j,i)
 371           enddo
 372         enddo
 373       endif
 374       write (iout,'(/a/)') 'Gradient in virtual-bond and SC vectors'
 375       do i=0,nres
 376         print *,i
 377         do j=1,3
 378           xx(j)=c(j,i+nres)
 379           ddc(j)=dc(j,i)
 380           ddx(j)=dc(j,i+nres)
 381           do k=1,3
 382             dcnorm_safe(k)=dc_norm(k,i)
 383             dxnorm_safe(k)=dc_norm(k,i+nres)
 384           enddo
 385         enddo
 386         do j=1,3
 387           dc(j,i)=ddc(j)+aincr
 388           call chainbuild_cart
 389 #ifdef MPI
 390 c Broadcast the order to compute internal coordinates to the slaves.
 391 c          if (nfgtasks.gt.1)
 392 c     &      call MPI_Bcast(6,1,MPI_INTEGER,king,FG_COMM,IERROR)
 393 #endif
 394 c          call int_from_cart1(.false.)
 395           if (.not.split_ene) then
 396             call etotal(energia1(0))
 397             etot1=energia1(0)
 398           else
 399 !- split gradient
 400             call etotal_long(energia1(0))
 401             etot11=energia1(0)
 402             call etotal_short(energia1(0))
 403             etot12=energia1(0)
 404 c            write (iout,*) "etot11",etot11," etot12",etot12
 405           endif
 406 !- end split gradient
 407 c          write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
 408           dc(j,i)=ddc(j)-aincr
 409           call chainbuild_cart
 410 C          print *,c(j,i)
 411 c          call int_from_cart1(.false.)
 412           if (.not.split_ene) then
 413             call etotal(energia1(0))
 414             etot2=energia1(0)
 415             ggg(j)=(etot1-etot2)/(2*aincr)
 416           else
 417 !- split gradient
 418             call etotal_long(energia1(0))
 419             etot21=energia1(0)
 420             ggg(j)=(etot11-etot21)/(2*aincr)
 421             call etotal_short(energia1(0))
 422             etot22=energia1(0)
 423             ggg1(j)=(etot12-etot22)/(2*aincr)
 424 !- end split gradient
 425 c            write (iout,*) "etot21",etot21," etot22",etot22
 426           endif
 427 c          write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
 428           dc(j,i)=ddc(j)
 429           call chainbuild_cart
 430         enddo
 431         do j=1,3
 432           dc(j,i+nres)=ddx(j)+aincr
 433           call chainbuild_cart
 434 c          write (iout,*) "i",i," j",j," dxnorm+ and dxnorm"
 435 c          write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
 436 c          write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
 437 c          write (iout,*) "dxnormnorm",dsqrt(
 438 c     &  dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
 439 c          write (iout,*) "dxnormnormsafe",dsqrt(
 440 c     &      dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
 441 c          write (iout,*)
 442           if (.not.split_ene) then
 443             call etotal(energia1(0))
 444             etot1=energia1(0)
 445           else
 446 !- split gradient
 447             call etotal_long(energia1(0))
 448             etot11=energia1(0)
 449             call etotal_short(energia1(0))
 450             etot12=energia1(0)
 451           endif
 452 !- end split gradient
 453 c          write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot1",etot1
 454           dc(j,i+nres)=ddx(j)-aincr
 455           call chainbuild_cart
 456 c          write (iout,*) "i",i," j",j," dxnorm- and dxnorm"
 457 c          write (iout,'(3f15.10)') (dc_norm(k,i+nres),k=1,3)
 458 c          write (iout,'(3f15.10)') (dxnorm_safe(k),k=1,3)
 459 c          write (iout,*)
 460 c          write (iout,*) "dxnormnorm",dsqrt(
 461 c     &  dc_norm(1,i+nres)**2+dc_norm(2,i+nres)**2+dc_norm(3,i+nres)**2)
 462 c          write (iout,*) "dxnormnormsafe",dsqrt(
 463 c     &      dxnorm_safe(1)**2+dxnorm_safe(2)**2+dxnorm_safe(3)**2)
 464           if (.not.split_ene) then
 465             call etotal(energia1(0))
 466             etot2=energia1(0)
 467             ggg(j+3)=(etot1-etot2)/(2*aincr)
 468           else
 469 !- split gradient
 470             call etotal_long(energia1(0))
 471             etot21=energia1(0)
 472             ggg(j+3)=(etot11-etot21)/(2*aincr)
 473             call etotal_short(energia1(0))
 474             etot22=energia1(0)
 475             ggg1(j+3)=(etot12-etot22)/(2*aincr)
 476 !- end split gradient
 477           endif
 478 c          write(iout,'(2i5,2(a,f15.10))')i,j," etot",etot," etot2",etot2
 479           dc(j,i+nres)=ddx(j)
 480           call chainbuild_cart
 481         enddo
 482         write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)')
 483      &   i,(ggg(k),k=1,6),(grad_s(k,i),k=1,6),(ggg(k)/grad_s(k,i),k=1,6)
 484         if (split_ene) then
 485           write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)')
 486      &   i,(ggg1(k),k=1,6),(grad_s1(k,i),k=1,6),(ggg1(k)/grad_s1(k,i),
 487      &   k=1,6)
 488          write (iout,'(i3,6(1pe12.5)/3x,6(1pe12.5)/3x,6(1pe12.5)/)')
 489      &   i,(ggg(k)+ggg1(k),k=1,6),(grad_s(k,i)+grad_s1(k,i),k=1,6),
 490      &   ((ggg(k)+ggg1(k))/(grad_s(k,i)+grad_s1(k,i)),k=1,6)
 491         endif
 492       enddo
 493       return
 494       end
 495 c-------------------------------------------------------------------------
 496       subroutine int_from_cart1(lprn)
 497       implicit real*8 (a-h,o-z)
 498       include 'DIMENSIONS'
 499 #ifdef MPI
 500       include 'mpif.h'
 501       integer ierror
 502 #endif
 503       include 'COMMON.IOUNITS'
 504       include 'COMMON.VAR'
 505       include 'COMMON.CHAIN'
 506       include 'COMMON.GEO'
 507       include 'COMMON.INTERACT'
 508       include 'COMMON.LOCAL'
 509       include 'COMMON.NAMES'
 510       include 'COMMON.SETUP'
 511       include 'COMMON.TIME1'
 512       logical lprn
 513       if (lprn) write (iout,'(/a)') 'Recalculated internal coordinates'
 514 #ifdef TIMING
 515       time01=MPI_Wtime()
 516 #endif
 517 #if defined(PARINT) && defined(MPI)
 518       do i=iint_start,iint_end
 519 #else
 520       do i=2,nres
 521 #endif
 522 C        print *,i
 523         dnorm1=dist(i-1,i)
 524         dnorm2=dist(i,i+1)
 525 C        print *,i,dnorm1,dnorm2
 526         do j=1,3
 527           c(j,maxres2)=0.5D0*(2*c(j,i)+(c(j,i-1)-c(j,i))/dnorm1
 528      &     +(c(j,i+1)-c(j,i))/dnorm2)
 529         enddo
 530         be=0.0D0
 531         if (i.gt.2) then
 532         if (i.le.nres) phi(i+1)=beta(i-2,i-1,i,i+1)
 533         if ((itype(i).ne.10).and.(itype(i-1).ne.10)) then
 534          tauangle(3,i+1)=beta(i+nres-1,i-1,i,i+nres)
 535         endif
 536         if (itype(i-1).ne.10) then
 537          tauangle(1,i+1)=beta(i-1+nres,i-1,i,i+1)
 538          omicron(1,i)=alpha(i-2,i-1,i-1+nres)
 539          omicron(2,i)=alpha(i-1+nres,i-1,i)
 540         endif
 541         if (itype(i).ne.10) then
 542          tauangle(2,i+1)=beta(i-2,i-1,i,i+nres)
 543         endif
 544         endif
 545         omeg(i)=beta(nres+i,i,maxres2,i+1)
 546 C        print *,omeg(i)
 547         alph(i)=alpha(nres+i,i,maxres2)
 548 C        print *,alph(i)
 549         theta(i+1)=alpha(i-1,i,i+1)
 550         vbld(i)=dist(i-1,i)
 551 C        print *,vbld(i)
 552         vbld_inv(i)=1.0d0/vbld(i)
 553         vbld(nres+i)=dist(nres+i,i)
 554 C            print *,vbld(i+nres)
 555
 556         if (itype(i).ne.10) then
 557           vbld_inv(nres+i)=1.0d0/vbld(nres+i)
 558         else
 559           vbld_inv(nres+i)=0.0d0
 560         endif
 561       enddo
 562 #if defined(PARINT) && defined(MPI)
 563        if (nfgtasks1.gt.1) then
 564 cd       write(iout,*) "iint_start",iint_start," iint_count",
 565 cd     &   (iint_count(i),i=0,nfgtasks-1)," iint_displ",
 566 cd     &   (iint_displ(i),i=0,nfgtasks-1)
 567 cd       write (iout,*) "Gather vbld backbone"
 568 cd       call flush(iout)
 569        time00=MPI_Wtime()
 570        call MPI_Allgatherv(vbld(iint_start),iint_count(fg_rank1),
 571      &   MPI_DOUBLE_PRECISION,vbld(1),iint_count(0),iint_displ(0),
 572      &   MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
 573 cd       write (iout,*) "Gather vbld_inv"
 574 cd       call flush(iout)
 575        call MPI_Allgatherv(vbld_inv(iint_start),iint_count(fg_rank1),
 576      &   MPI_DOUBLE_PRECISION,vbld_inv(1),iint_count(0),iint_displ(0),
 577      &   MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
 578 cd       write (iout,*) "Gather vbld side chain"
 579 cd       call flush(iout)
 580        call MPI_Allgatherv(vbld(iint_start+nres),iint_count(fg_rank1),
 581      &  MPI_DOUBLE_PRECISION,vbld(nres+1),iint_count(0),iint_displ(0),
 582      &   MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
 583 cd       write (iout,*) "Gather vbld_inv side chain"
 584 cd       call flush(iout)
 585        call MPI_Allgatherv(vbld_inv(iint_start+nres),
 586      &   iint_count(fg_rank1),MPI_DOUBLE_PRECISION,vbld_inv(nres+1),
 587      &   iint_count(0),iint_displ(0),MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
 588 cd       write (iout,*) "Gather theta"
 589 cd       call flush(iout)
 590        call MPI_Allgatherv(theta(iint_start+1),iint_count(fg_rank1),
 591      &   MPI_DOUBLE_PRECISION,theta(2),iint_count(0),iint_displ(0),
 592      &   MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
 593 cd       write (iout,*) "Gather phi"
 594 cd       call flush(iout)
 595        call MPI_Allgatherv(phi(iint_start+1),iint_count(fg_rank1),
 596      &   MPI_DOUBLE_PRECISION,phi(2),iint_count(0),iint_displ(0),
 597      &   MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
 598 #ifdef CRYST_SC
 599 cd       write (iout,*) "Gather alph"
 600 cd       call flush(iout)
 601        call MPI_Allgatherv(alph(iint_start),iint_count(fg_rank1),
 602      &   MPI_DOUBLE_PRECISION,alph(1),iint_count(0),iint_displ(0),
 603      &   MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
 604 cd       write (iout,*) "Gather omeg"
 605 cd       call flush(iout)
 606        call MPI_Allgatherv(omeg(iint_start),iint_count(fg_rank1),
 607      &   MPI_DOUBLE_PRECISION,omeg(1),iint_count(0),iint_displ(0),
 608      &   MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
 609 #endif
 610        time_gather=time_gather+MPI_Wtime()-time00
 611       endif
 612 #endif
 613       do i=1,nres-1
 614         do j=1,3
 615           dc_norm(j,i)=dc(j,i)*vbld_inv(i+1)
 616         enddo
 617       enddo
 618       do i=2,nres-1
 619         do j=1,3
 620           dc_norm(j,i+nres)=dc(j,i+nres)*vbld_inv(i+nres)
 621         enddo
 622       enddo
 623       if (lprn) then
 624       do i=2,nres
 625        write (iout,1212) restyp(itype(i)),i,vbld(i),
 626      &rad2deg*theta(i),rad2deg*phi(i),vbld(nres+i),
 627      &rad2deg*alph(i),rad2deg*omeg(i)
 628       enddo
 629       endif
 630  1212 format (a3,'(',i3,')',2(f15.10,2f10.2))
 631 #ifdef TIMING
 632       time_intfcart=time_intfcart+MPI_Wtime()-time01
 633 #endif
 634       return
 635       end
 636 c----------------------------------------------------------------------------
 637       subroutine check_eint
 638 C Check the gradient of energy in internal coordinates.
 639       implicit real*8 (a-h,o-z)
 640       include 'DIMENSIONS'
 641       include 'COMMON.CONTROL'
 642       include 'COMMON.CHAIN'
 643       include 'COMMON.DERIV'
 644       include 'COMMON.IOUNITS'
 645       include 'COMMON.VAR'
 646       include 'COMMON.GEO'
 647       common /srutu/ icall
 648       dimension x(maxvar),gana(maxvar),gg(maxvar)
 649       integer uiparm(1)
 650       double precision urparm(1)
 651       double precision energia(0:n_ene),energia1(0:n_ene),
 652      &  energia2(0:n_ene)
 653       character*6 key
 654       external fdum
 655       call zerograd
 656 c      aincr=1.0D-7
 657       print '("Calling CHECK_INT",1pd12.3)',aincr
 658       write (iout,'("Calling CHECK_INT",1pd12.3)') aincr
 659       nf=0
 660       nfl=0
 661       icg=1
 662       call geom_to_var(nvar,x)
 663       call var_to_geom(nvar,x)
 664       call chainbuild
 665       icall=1
 666       print *,'ICG=',ICG
 667       call etotal(energia(0))
 668       etot = energia(0)
 669       call enerprint(energia(0))
 670       print *,'ICG=',ICG
 671 #ifdef MPL
 672       if (MyID.ne.BossID) then
 673         call mp_bcast(x(1),8*(nvar+3),BossID,fgGroupID)
 674         nf=x(nvar+1)
 675         nfl=x(nvar+2)
 676         icg=x(nvar+3)
 677       endif
 678 #endif
 679       nf=1
 680       nfl=3
 681 cd    write (iout,'(10f8.3)') (rad2deg*x(i),i=1,nvar)
 682       call gradient(nvar,x,nf,gana,uiparm,urparm,fdum)
 683 cd    write (iout,'(i3,1pe14.4)') (i,gana(i),i=1,nvar)
 684       icall=1
 685       do i=1,nvar
 686         xi=x(i)
 687         x(i)=xi-0.5D0*aincr
 688         call var_to_geom(nvar,x)
 689         call chainbuild_extconf
 690         call etotal(energia1(0))
 691         etot1=energia1(0)
 692         x(i)=xi+0.5D0*aincr
 693         call var_to_geom(nvar,x)
 694         call chainbuild_extconf
 695         call etotal(energia2(0))
 696         etot2=energia2(0)
 697         gg(i)=(etot2-etot1)/aincr
 698         write (iout,*) i,etot1,etot2
 699         x(i)=xi
 700       enddo
 701       write (iout,'(/2a)')' Variable        Numerical       Analytical',
 702      &    '     RelDiff*100% '
 703       do i=1,nvar
 704         if (i.le.nphi) then
 705           ii=i
 706           key = ' phi'
 707         else if (i.le.nphi+ntheta) then
 708           ii=i-nphi
 709           key=' theta'
 710         else if (i.le.nphi+ntheta+nside) then
 711            ii=i-(nphi+ntheta)
 712            key=' alpha'
 713         else
 714            ii=i-(nphi+ntheta+nside)
 715            key=' omega'
 716         endif
 717         write (iout,'(i3,a,i3,3(1pd16.6))')
 718      & i,key,ii,gg(i),gana(i),
 719      & 100.0D0*dabs(gg(i)-gana(i))/(dabs(gana(i))+aincr)
 720       enddo
 721       return
 722       end