source/unres/src_MD-M/dif

   1 1,9c1,149
   2 < C-----------------------------------------------------------------------
   3 <       double precision function sscale(r)
   4 <       double precision r,gamm
   5 <       include "COMMON.SPLITELE"
   6 <       if(r.lt.r_cut-rlamb) then
   7 <         sscale=1.0d0
   8 <       else if(r.le.r_cut.and.r.ge.r_cut-rlamb) then
   9 <         gamm=(r-(r_cut-rlamb))/rlamb
  10 <         sscale=1.0d0+gamm*gamm*(2*gamm-3.0d0)
  11 ---
  12 >       subroutine etotal(energia)
  13 >       implicit real*8 (a-h,o-z)
  14 >       include 'DIMENSIONS'
  15 > #ifndef ISNAN
  16 >       external proc_proc
  17 > #ifdef WINPGI
  18 > cMS$ATTRIBUTES C ::  proc_proc
  19 > #endif
  20 > #endif
  21 > #ifdef MPI
  22 >       include "mpif.h"
  23 >       double precision weights_(n_ene)
  24 > #endif
  25 >       include 'COMMON.SETUP'
  26 >       include 'COMMON.IOUNITS'
  27 >       double precision energia(0:n_ene)
  28 >       include 'COMMON.LOCAL'
  29 >       include 'COMMON.FFIELD'
  30 >       include 'COMMON.DERIV'
  31 >       include 'COMMON.INTERACT'
  32 >       include 'COMMON.SBRIDGE'
  33 >       include 'COMMON.CHAIN'
  34 >       include 'COMMON.VAR'
  35 >       include 'COMMON.MD'
  36 >       include 'COMMON.CONTROL'
  37 >       include 'COMMON.TIME1'
  38 >       if (modecalc.eq.12.or.modecalc.eq.14) then
  39 > #ifdef MPI
  40 >         if (fg_rank.eq.0) call int_from_cart1(.false.)
  41 > #else
  42 >         call int_from_cart1(.false.)
  43 > #endif
  44 >       endif
  45 > #ifdef MPI
  46 > c      print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
  47 > c     & " nfgtasks",nfgtasks
  48 >       if (nfgtasks.gt.1) then
  49 >         time00=MPI_Wtime()
  50 > C FG slaves call the following matching MPI_Bcast in ERGASTULUM
  51 >         if (fg_rank.eq.0) then
  52 >           call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
  53 > c          print *,"Processor",myrank," BROADCAST iorder"
  54 > C FG master sets up the WEIGHTS_ array which will be broadcast to the
  55 > C FG slaves as WEIGHTS array.
  56 >           weights_(1)=wsc
  57 >           weights_(2)=wscp
  58 >           weights_(3)=welec
  59 >           weights_(4)=wcorr
  60 >           weights_(5)=wcorr5
  61 >           weights_(6)=wcorr6
  62 >           weights_(7)=wel_loc
  63 >           weights_(8)=wturn3
  64 >           weights_(9)=wturn4
  65 >           weights_(10)=wturn6
  66 >           weights_(11)=wang
  67 >           weights_(12)=wscloc
  68 >           weights_(13)=wtor
  69 >           weights_(14)=wtor_d
  70 >           weights_(15)=wstrain
  71 >           weights_(16)=wvdwpp
  72 >           weights_(17)=wbond
  73 >           weights_(18)=scal14
  74 >           weights_(21)=wsccor
  75 > C FG Master broadcasts the WEIGHTS_ array
  76 >           call MPI_Bcast(weights_(1),n_ene,
  77 >      &        MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
  78 >         else
  79 > C FG slaves receive the WEIGHTS array
  80 >           call MPI_Bcast(weights(1),n_ene,
  81 >      &        MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
  82 >         endif
  83 > c        print *,"Processor",myrank," BROADCAST weights"
  84 >         call MPI_Bcast(c(1,1),maxres6,MPI_DOUBLE_PRECISION,
  85 >      &    king,FG_COMM,IERR)
  86 > c        print *,"Processor",myrank," BROADCAST c"
  87 >         call MPI_Bcast(dc(1,1),maxres6,MPI_DOUBLE_PRECISION,
  88 >      &    king,FG_COMM,IERR)
  89 > c        print *,"Processor",myrank," BROADCAST dc"
  90 >         call MPI_Bcast(dc_norm(1,1),maxres6,MPI_DOUBLE_PRECISION,
  91 >      &    king,FG_COMM,IERR)
  92 > c        print *,"Processor",myrank," BROADCAST dc_norm"
  93 >         call MPI_Bcast(theta(1),nres,MPI_DOUBLE_PRECISION,
  94 >      &    king,FG_COMM,IERR)
  95 > c        print *,"Processor",myrank," BROADCAST theta"
  96 >         call MPI_Bcast(phi(1),nres,MPI_DOUBLE_PRECISION,
  97 >      &    king,FG_COMM,IERR)
  98 > c        print *,"Processor",myrank," BROADCAST phi"
  99 >         call MPI_Bcast(alph(1),nres,MPI_DOUBLE_PRECISION,
 100 >      &    king,FG_COMM,IERR)
 101 > c        print *,"Processor",myrank," BROADCAST alph"
 102 >         call MPI_Bcast(omeg(1),nres,MPI_DOUBLE_PRECISION,
 103 >      &    king,FG_COMM,IERR)
 104 > c        print *,"Processor",myrank," BROADCAST omeg"
 105 >         call MPI_Bcast(vbld(1),2*nres,MPI_DOUBLE_PRECISION,
 106 >      &    king,FG_COMM,IERR)
 107 > c        print *,"Processor",myrank," BROADCAST vbld"
 108 >         call MPI_Bcast(vbld_inv(1),2*nres,MPI_DOUBLE_PRECISION,
 109 >      &    king,FG_COMM,IERR)
 110 >          time_Bcast=time_Bcast+MPI_Wtime()-time00
 111 > c        print *,"Processor",myrank," BROADCAST vbld_inv"
 112 >       endif
 113 > c      print *,'Processor',myrank,' calling etotal ipot=',ipot
 114 > c      print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
 115 > #endif
 116 > C
 117 > C Compute the side-chain and electrostatic interaction energy
 118 > C
 119 >       goto (101,102,103,104,105,106) ipot
 120 > C Lennard-Jones potential.
 121 >   101 call elj(evdw)
 122 > cd    print '(a)','Exit ELJ'
 123 >       goto 107
 124 > C Lennard-Jones-Kihara potential (shifted).
 125 >   102 call eljk(evdw)
 126 >       goto 107
 127 > C Berne-Pechukas potential (dilated LJ, angular dependence).
 128 >   103 call ebp(evdw)
 129 >       goto 107
 130 > C Gay-Berne potential (shifted LJ, angular dependence).
 131 >   104 call egb(evdw)
 132 >       goto 107
 133 > C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
 134 >   105 call egbv(evdw)
 135 >       goto 107
 136 > C Soft-sphere potential
 137 >   106 call e_softsphere(evdw)
 138 > C
 139 > C Calculate electrostatic (H-bonding) energy of the main chain.
 140 > C
 141 >   107 continue
 142 > c      print *,"Processor",myrank," computed USCSC"
 143 >       call vec_and_deriv
 144 > c      print *,"Processor",myrank," left VEC_AND_DERIV"
 145 >       if (ipot.lt.6) then
 146 > #ifdef SPLITELE
 147 >          if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
 148 >      &       wturn3.gt.0d0.or.wturn4.gt.0d0) then
 149 > #else
 150 >          if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
 151 >      &       wturn3.gt.0d0.or.wturn4.gt.0d0) then
 152 > #endif
 153 >             call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
 154 >          else
 155 >             ees=0
 156 >             evdw1=0
 157 >             eel_loc=0
 158 >             eello_turn3=0
 159 >             eello_turn4=0
 160 >          endif
 161 11c151,153
 162 <         sscale=0d0
 163 ---
 164 > c        write (iout,*) "Soft-spheer ELEC potential"
 165 >         call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
 166 >      &   eello_turn4)
 167 13,16c155
 168 <       return
 169 <       end
 170 < C-----------------------------------------------------------------------
 171 <       subroutine elj_long(evdw)
 172 ---
 173 > c      print *,"Processor",myrank," computed UELEC"
 174 18,19c157,261
 175 < C This subroutine calculates the interaction energy of nonbonded side chains
 176 < C assuming the LJ potential of interaction.
 177 ---
 178 > C Calculate excluded-volume interaction energy between peptide groups
 179 > C and side chains.
 180 > C
 181 >       if (ipot.lt.6) then
 182 >        if(wscp.gt.0d0) then
 183 >         call escp(evdw2,evdw2_14)
 184 >        else
 185 >         evdw2=0
 186 >         evdw2_14=0
 187 >        endif
 188 >       else
 189 > c        write (iout,*) "Soft-sphere SCP potential"
 190 >         call escp_soft_sphere(evdw2,evdw2_14)
 191 >       endif
 192 > c
 193 > c Calculate the bond-stretching energy
 194 > c
 195 >       call ebond(estr)
 196 > C
 197 > C Calculate the disulfide-bridge and other energy and the contributions
 198 > C from other distance constraints.
 199 > cd    print *,'Calling EHPB'
 200 >       call edis(ehpb)
 201 > cd    print *,'EHPB exitted succesfully.'
 202 > C
 203 > C Calculate the virtual-bond-angle energy.
 204 > C
 205 >       if (wang.gt.0d0) then
 206 >         call ebend(ebe)
 207 >       else
 208 >         ebe=0
 209 >       endif
 210 > c      print *,"Processor",myrank," computed UB"
 211 > C
 212 > C Calculate the SC local energy.
 213 > C
 214 >       call esc(escloc)
 215 > c      print *,"Processor",myrank," computed USC"
 216 > C
 217 > C Calculate the virtual-bond torsional energy.
 218 > C
 219 > cd    print *,'nterm=',nterm
 220 >       if (wtor.gt.0) then
 221 >        call etor(etors,edihcnstr)
 222 >       else
 223 >        etors=0
 224 >        edihcnstr=0
 225 >       endif
 226 > c      print *,"Processor",myrank," computed Utor"
 227 > C
 228 > C 6/23/01 Calculate double-torsional energy
 229 > C
 230 >       if (wtor_d.gt.0) then
 231 >        call etor_d(etors_d)
 232 >       else
 233 >        etors_d=0
 234 >       endif
 235 > c      print *,"Processor",myrank," computed Utord"
 236 > C
 237 > C 21/5/07 Calculate local sicdechain correlation energy
 238 > C
 239 >       if (wsccor.gt.0.0d0) then
 240 >         call eback_sc_corr(esccor)
 241 >       else
 242 >         esccor=0.0d0
 243 >       endif
 244 > c      print *,"Processor",myrank," computed Usccorr"
 245 > C
 246 > C 12/1/95 Multi-body terms
 247 > C
 248 >       n_corr=0
 249 >       n_corr1=0
 250 >       if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
 251 >      &    .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
 252 >          call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
 253 > c         write (2,*) 'n_corr=',n_corr,' n_corr1=',n_corr1,
 254 > c     &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
 255 >       else
 256 >          ecorr=0
 257 >          ecorr5=0
 258 >          ecorr6=0
 259 >          eturn6=0
 260 >       endif
 261 >       if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
 262 >          call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
 263 >       else
 264 >          ecorr=0
 265 >          ecorr5=0
 266 >          ecorr6=0
 267 >          eturn6=0
 268 >       endif
 269 > c      print *,"Processor",myrank," computed Ucorr"
 270 > C
 271 > C If performing constraint dynamics, call the constraint energy
 272 > C  after the equilibration time
 273 >       if(usampl.and.totT.gt.eq_time) then
 274 >          call EconstrQ
 275 >          call Econstr_back
 276 >       else
 277 >          Uconst=0.0d0
 278 >          Uconst_back=0.0d0
 279 >       endif
 280 > c      print *,"Processor",myrank," computed Uconstr"
 281 > c
 282 > C Sum the energies
 283 20a263,300
 284 >       energia(1)=evdw
 285 > #ifdef SCP14
 286 >       energia(2)=evdw2-evdw2_14
 287 >       energia(18)=evdw2_14
 288 > #else
 289 >       energia(2)=evdw2
 290 >       energia(18)=0.0d0
 291 > #endif
 292 > #ifdef SPLITELE
 293 >       energia(3)=ees
 294 >       energia(16)=evdw1
 295 > #else
 296 >       energia(3)=ees+evdw1
 297 >       energia(16)=0.0d0
 298 > #endif
 299 >       energia(4)=ecorr
 300 >       energia(5)=ecorr5
 301 >       energia(6)=ecorr6
 302 >       energia(7)=eel_loc
 303 >       energia(8)=eello_turn3
 304 >       energia(9)=eello_turn4
 305 >       energia(10)=eturn6
 306 >       energia(11)=ebe
 307 >       energia(12)=escloc
 308 >       energia(13)=etors
 309 >       energia(14)=etors_d
 310 >       energia(15)=ehpb
 311 >       energia(19)=edihcnstr
 312 >       energia(17)=estr
 313 >       energia(20)=Uconst+Uconst_back
 314 >       energia(21)=esccor
 315 > c      print *," Processor",myrank," calls SUM_ENERGY"
 316 >       call sum_energy(energia,.true.)
 317 > c      print *," Processor",myrank," left SUM_ENERGY"
 318 >       return
 319 >       end
 320 > c-------------------------------------------------------------------------------
 321 >       subroutine sum_energy(energia,reduce)
 322 23,27c303,315
 323 <       parameter (accur=1.0d-10)
 324 <       include 'COMMON.GEO'
 325 <       include 'COMMON.VAR'
 326 <       include 'COMMON.LOCAL'
 327 <       include 'COMMON.CHAIN'
 328 ---
 329 > #ifndef ISNAN
 330 >       external proc_proc
 331 > #ifdef WINPGI
 332 > cMS$ATTRIBUTES C ::  proc_proc
 333 > #endif
 334 > #endif
 335 > #ifdef MPI
 336 >       include "mpif.h"
 337 > #endif
 338 >       include 'COMMON.SETUP'
 339 >       include 'COMMON.IOUNITS'
 340 >       double precision energia(0:n_ene),enebuff(0:n_ene+1)
 341 >       include 'COMMON.FFIELD'
 342 30d317
 343 <       include 'COMMON.TORSION'
 344 32c319,428
 345 <       include 'COMMON.NAMES'
 346 ---
 347 >       include 'COMMON.CHAIN'
 348 >       include 'COMMON.VAR'
 349 >       include 'COMMON.CONTROL'
 350 >       include 'COMMON.TIME1'
 351 >       logical reduce
 352 > #ifdef MPI
 353 >       if (nfgtasks.gt.1 .and. reduce) then
 354 > #ifdef DEBUG
 355 >         write (iout,*) "energies before REDUCE"
 356 >         call enerprint(energia)
 357 >         call flush(iout)
 358 > #endif
 359 >         do i=0,n_ene
 360 >           enebuff(i)=energia(i)
 361 >         enddo
 362 >         time00=MPI_Wtime()
 363 >         call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
 364 >      &    MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
 365 > #ifdef DEBUG
 366 >         write (iout,*) "energies after REDUCE"
 367 >         call enerprint(energia)
 368 >         call flush(iout)
 369 > #endif
 370 >         time_Reduce=time_Reduce+MPI_Wtime()-time00
 371 >       endif
 372 >       if (fg_rank.eq.0) then
 373 > #endif
 374 >       evdw=energia(1)
 375 > #ifdef SCP14
 376 >       evdw2=energia(2)+energia(18)
 377 >       evdw2_14=energia(18)
 378 > #else
 379 >       evdw2=energia(2)
 380 > #endif
 381 > #ifdef SPLITELE
 382 >       ees=energia(3)
 383 >       evdw1=energia(16)
 384 > #else
 385 >       ees=energia(3)
 386 >       evdw1=0.0d0
 387 > #endif
 388 >       ecorr=energia(4)
 389 >       ecorr5=energia(5)
 390 >       ecorr6=energia(6)
 391 >       eel_loc=energia(7)
 392 >       eello_turn3=energia(8)
 393 >       eello_turn4=energia(9)
 394 >       eturn6=energia(10)
 395 >       ebe=energia(11)
 396 >       escloc=energia(12)
 397 >       etors=energia(13)
 398 >       etors_d=energia(14)
 399 >       ehpb=energia(15)
 400 >       edihcnstr=energia(19)
 401 >       estr=energia(17)
 402 >       Uconst=energia(20)
 403 >       esccor=energia(21)
 404 > #ifdef SPLITELE
 405 >       etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
 406 >      & +wang*ebe+wtor*etors+wscloc*escloc
 407 >      & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
 408 >      & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
 409 >      & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
 410 >      & +wbond*estr+Uconst+wsccor*esccor
 411 > #else
 412 >       etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
 413 >      & +wang*ebe+wtor*etors+wscloc*escloc
 414 >      & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
 415 >      & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
 416 >      & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
 417 >      & +wbond*estr+Uconst+wsccor*esccor
 418 > #endif
 419 >       energia(0)=etot
 420 > c detecting NaNQ
 421 > #ifdef ISNAN
 422 > #ifdef AIX
 423 >       if (isnan(etot).ne.0) energia(0)=1.0d+99
 424 > #else
 425 >       if (isnan(etot)) energia(0)=1.0d+99
 426 > #endif
 427 > #else
 428 >       i=0
 429 > #ifdef WINPGI
 430 >       idumm=proc_proc(etot,i)
 431 > #else
 432 >       call proc_proc(etot,i)
 433 > #endif
 434 >       if(i.eq.1)energia(0)=1.0d+99
 435 > #endif
 436 > #ifdef MPI
 437 >       endif
 438 > #endif
 439 >       return
 440 >       end
 441 > c-------------------------------------------------------------------------------
 442 >       subroutine sum_gradient
 443 >       implicit real*8 (a-h,o-z)
 444 >       include 'DIMENSIONS'
 445 > #ifndef ISNAN
 446 >       external proc_proc
 447 > #ifdef WINPGI
 448 > cMS$ATTRIBUTES C ::  proc_proc
 449 > #endif
 450 > #endif
 451 > #ifdef MPI
 452 >       include 'mpif.h'
 453 >       double precision gradbufc(3,maxres),gradbufx(3,maxres),
 454 >      &  glocbuf(4*maxres)
 455 > #endif
 456 >       include 'COMMON.SETUP'
 457 34,45c430,438
 458 <       include 'COMMON.CONTACTS'
 459 <       dimension gg(3)
 460 < c      write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
 461 <       evdw=0.0D0
 462 <       do i=iatsc_s,iatsc_e
 463 <         itypi=itype(i)
 464 <         itypi1=itype(i+1)
 465 <         xi=c(1,nres+i)
 466 <         yi=c(2,nres+i)
 467 <         zi=c(3,nres+i)
 468 < C
 469 < C Calculate SC interaction energy.
 470 ---
 471 >       include 'COMMON.FFIELD'
 472 >       include 'COMMON.DERIV'
 473 >       include 'COMMON.INTERACT'
 474 >       include 'COMMON.SBRIDGE'
 475 >       include 'COMMON.CHAIN'
 476 >       include 'COMMON.VAR'
 477 >       include 'COMMON.CONTROL'
 478 >       include 'COMMON.TIME1'
 479 >       include 'COMMON.MAXGRAD'
 480 47,65c440
 481 <         do iint=1,nint_gr(i)
 482 < cd        write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
 483 < cd   &                  'iend=',iend(i,iint)
 484 <           do j=istart(i,iint),iend(i,iint)
 485 <             itypj=itype(j)
 486 <             xj=c(1,nres+j)-xi
 487 <             yj=c(2,nres+j)-yi
 488 <             zj=c(3,nres+j)-zi
 489 <             rij=xj*xj+yj*yj+zj*zj
 490 <             sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
 491 <             if (sss.lt.1.0d0) then
 492 <               rrij=1.0D0/rij
 493 <               fac=rrij**expon2
 494 <               e1=fac*fac*aa(itypi,itypj)
 495 <               e2=fac*bb(itypi,itypj)
 496 <               evdwij=e1+e2
 497 <               evdw=evdw+(1.0d0-sss)*evdwij
 498 < C
 499 < C Calculate the components of the gradient in DC and X
 500 ---
 501 > C Sum up the components of the Cartesian gradient.
 502 67,83c442
 503 <               fac=-rrij*(e1+evdwij)*(1.0d0-sss)
 504 <               gg(1)=xj*fac
 505 <               gg(2)=yj*fac
 506 <               gg(3)=zj*fac
 507 <               do k=1,3
 508 <                 gvdwx(k,i)=gvdwx(k,i)-gg(k)
 509 <                 gvdwx(k,j)=gvdwx(k,j)+gg(k)
 510 <               enddo
 511 <               do k=i,j-1
 512 <                 do l=1,3
 513 <                   gvdwc(l,k)=gvdwc(l,k)+gg(l)
 514 <                 enddo
 515 <               enddo
 516 <             endif
 517 <           enddo      ! j
 518 <         enddo        ! iint
 519 <       enddo          ! i
 520 ---
 521 > #ifdef SPLITELE
 522 86,87c445,484
 523 <           gvdwc(j,i)=expon*gvdwc(j,i)
 524 <           gvdwx(j,i)=expon*gvdwx(j,i)
 525 ---
 526 >           gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
 527 >      &                welec*gelc(j,i)+wvdwpp*gvdwpp(j,i)+
 528 >      &                wbond*gradb(j,i)+
 529 >      &                wstrain*ghpbc(j,i)+
 530 >      &                wcorr*gradcorr(j,i)+
 531 >      &                wel_loc*gel_loc(j,i)+
 532 >      &                wturn3*gcorr3_turn(j,i)+
 533 >      &                wturn4*gcorr4_turn(j,i)+
 534 >      &                wcorr5*gradcorr5(j,i)+
 535 >      &                wcorr6*gradcorr6(j,i)+
 536 >      &                wturn6*gcorr6_turn(j,i)+
 537 >      &                wsccor*gsccorc(j,i)
 538 >      &               +wscloc*gscloc(j,i)
 539 >           gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
 540 >      &                  wbond*gradbx(j,i)+
 541 >      &                  wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
 542 >      &                  wsccor*gsccorx(j,i)
 543 >      &                 +wscloc*gsclocx(j,i)
 544 >         enddo
 545 >       enddo
 546 > #else
 547 >       do i=1,nct
 548 >         do j=1,3
 549 >           gradc(j,i,icg)=wsc*gvdwc(j,i)+wscp*gvdwc_scp(j,i)+
 550 >      &                welec*gelc(j,i)+wstrain*ghpbc(j,i)+
 551 >      &                wbond*gradb(j,i)+
 552 >      &                wcorr*gradcorr(j,i)+
 553 >      &                wel_loc*gel_loc(j,i)+
 554 >      &                wturn3*gcorr3_turn(j,i)+
 555 >      &                wturn4*gcorr4_turn(j,i)+
 556 >      &                wcorr5*gradcorr5(j,i)+
 557 >      &                wcorr6*gradcorr6(j,i)+
 558 >      &                wturn6*gcorr6_turn(j,i)+
 559 >      &                wsccor*gsccorc(j,i)
 560 >      &               +wscloc*gscloc(j,i)
 561 >           gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
 562 >      &                  wbond*gradbx(j,i)+
 563 >      &                  wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
 564 >      &                  wsccor*gsccorx(j,i)
 565 >      &                 +wscloc*gsclocx(j,i)
 566 88a486,496
 567 >       enddo
 568 > #endif
 569 >       do i=1,nres-3
 570 >         gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
 571 >      &   +wcorr5*g_corr5_loc(i)
 572 >      &   +wcorr6*g_corr6_loc(i)
 573 >      &   +wturn4*gel_loc_turn4(i)
 574 >      &   +wturn3*gel_loc_turn3(i)
 575 >      &   +wturn6*gel_loc_turn6(i)
 576 >      &   +wel_loc*gel_loc_loc(i)
 577 >      &   +wsccor*gsccor_loc(i)
 578 90,98c498,790
 579 < C******************************************************************************
 580 < C
 581 < C                              N O T E !!!
 582 < C
 583 < C To save time, the factor of EXPON has been extracted from ALL components
 584 < C of GVDWC and GRADX. Remember to multiply them by this factor before further
 585 < C use!
 586 < C
 587 < C******************************************************************************
 588 ---
 589 > #ifdef MPI
 590 >       if (nfgtasks.gt.1) then
 591 >         do j=1,3
 592 >           do i=1,nres
 593 >             gradbufc(j,i)=gradc(j,i,icg)
 594 >             gradbufx(j,i)=gradx(j,i,icg)
 595 >           enddo
 596 >         enddo
 597 >         do i=1,4*nres
 598 >           glocbuf(i)=gloc(i,icg)
 599 >         enddo
 600 > C FG slaves call the following matching MPI_Bcast in ERGASTULUM
 601 >         if (fg_rank.eq.0) call MPI_Bcast(1,1,MPI_INTEGER,
 602 >      &      king,FG_COMM,IERROR)
 603 >         time00=MPI_Wtime()
 604 >         call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
 605 >      &    MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
 606 >         call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
 607 >      &    MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
 608 >         call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
 609 >      &    MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
 610 >         time_reduce=time_reduce+MPI_Wtime()-time00
 611 >       endif
 612 > #endif
 613 >       if (gnorm_check) then
 614 > c
 615 > c Compute the maximum elements of the gradient
 616 > c
 617 >       gvdwc_max=0.0d0
 618 >       gvdwc_scp_max=0.0d0
 619 >       gelc_max=0.0d0
 620 >       gvdwpp_max=0.0d0
 621 >       gradb_max=0.0d0
 622 >       ghpbc_max=0.0d0
 623 >       gradcorr_max=0.0d0
 624 >       gel_loc_max=0.0d0
 625 >       gcorr3_turn_max=0.0d0
 626 >       gcorr4_turn_max=0.0d0
 627 >       gradcorr5_max=0.0d0
 628 >       gradcorr6_max=0.0d0
 629 >       gcorr6_turn_max=0.0d0
 630 >       gsccorc_max=0.0d0
 631 >       gscloc_max=0.0d0
 632 >       gvdwx_max=0.0d0
 633 >       gradx_scp_max=0.0d0
 634 >       ghpbx_max=0.0d0
 635 >       gradxorr_max=0.0d0
 636 >       gsccorx_max=0.0d0
 637 >       gsclocx_max=0.0d0
 638 >       do i=1,nct
 639 >         gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
 640 >         if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
 641 >         gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
 642 >         if (gvdwc_scp_norm.gt.gvdwc_scp_max)
 643 >      &   gvdwc_scp_max=gvdwc_scp_norm
 644 >         gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
 645 >         if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
 646 >         gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
 647 >         if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
 648 >         gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
 649 >         if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
 650 >         ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
 651 >         if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
 652 >         gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
 653 >         if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
 654 >         gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
 655 >         if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
 656 >         gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
 657 >      &    gcorr3_turn(1,i)))
 658 >         if (gcorr3_turn_norm.gt.gcorr3_turn_max)
 659 >      &    gcorr3_turn_max=gcorr3_turn_norm
 660 >         gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
 661 >      &    gcorr4_turn(1,i)))
 662 >         if (gcorr4_turn_norm.gt.gcorr4_turn_max)
 663 >      &    gcorr4_turn_max=gcorr4_turn_norm
 664 >         gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
 665 >         if (gradcorr5_norm.gt.gradcorr5_max)
 666 >      &    gradcorr5_max=gradcorr5_norm
 667 >         gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
 668 >         if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
 669 >         gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
 670 >      &    gcorr6_turn(1,i)))
 671 >         if (gcorr6_turn_norm.gt.gcorr6_turn_max)
 672 >      &    gcorr6_turn_max=gcorr6_turn_norm
 673 >         gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
 674 >         if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
 675 >         gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
 676 >         if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
 677 >         gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
 678 >         if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
 679 >         gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
 680 >         if (gradx_scp_norm.gt.gradx_scp_max)
 681 >      &    gradx_scp_max=gradx_scp_norm
 682 >         ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
 683 >         if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
 684 >         gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
 685 >         if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
 686 >         gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
 687 >         if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
 688 >         gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
 689 >         if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
 690 >       enddo
 691 >       if (gradout) then
 692 > #ifdef AIX
 693 >         open(istat,file=statname,position="append")
 694 > #else
 695 >         open(istat,file=statname,access="append")
 696 > #endif
 697 >         write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
 698 >      &     gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
 699 >      &     gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
 700 >      &     gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
 701 >      &     gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
 702 >      &     gsccorx_max,gsclocx_max
 703 >         close(istat)
 704 >         if (gvdwc_max.gt.1.0d4) then
 705 >           write (iout,*) "gvdwc gvdwx gradb gradbx"
 706 >           do i=nnt,nct
 707 >             write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
 708 >      &        gradb(j,i),gradbx(j,i),j=1,3)
 709 >           enddo
 710 >           call pdbout(0.0d0,'cipiszcze',iout)
 711 >           call flush(iout)
 712 >         endif
 713 >       endif
 714 >       endif
 715 > #ifdef DEBUG
 716 >       write (iout,*) "gradc gradx gloc"
 717 >       do i=1,nres
 718 >         write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
 719 >      &   i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
 720 >       enddo
 721 > #endif
 722 >       return
 723 >       end
 724 > c-------------------------------------------------------------------------------
 725 >       subroutine rescale_weights(t_bath)
 726 >       implicit real*8 (a-h,o-z)
 727 >       include 'DIMENSIONS'
 728 >       include 'COMMON.IOUNITS'
 729 >       include 'COMMON.FFIELD'
 730 >       include 'COMMON.SBRIDGE'
 731 >       double precision kfac /2.4d0/
 732 >       double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
 733 > c      facT=temp0/t_bath
 734 > c      facT=2*temp0/(t_bath+temp0)
 735 >       if (rescale_mode.eq.0) then
 736 >         facT=1.0d0
 737 >         facT2=1.0d0
 738 >         facT3=1.0d0
 739 >         facT4=1.0d0
 740 >         facT5=1.0d0
 741 >       else if (rescale_mode.eq.1) then
 742 >         facT=kfac/(kfac-1.0d0+t_bath/temp0)
 743 >         facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
 744 >         facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
 745 >         facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
 746 >         facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
 747 >       else if (rescale_mode.eq.2) then
 748 >         x=t_bath/temp0
 749 >         x2=x*x
 750 >         x3=x2*x
 751 >         x4=x3*x
 752 >         x5=x4*x
 753 >         facT=licznik/dlog(dexp(x)+dexp(-x))
 754 >         facT2=licznik/dlog(dexp(x2)+dexp(-x2))
 755 >         facT3=licznik/dlog(dexp(x3)+dexp(-x3))
 756 >         facT4=licznik/dlog(dexp(x4)+dexp(-x4))
 757 >         facT5=licznik/dlog(dexp(x5)+dexp(-x5))
 758 >       else
 759 >         write (iout,*) "Wrong RESCALE_MODE",rescale_mode
 760 >         write (*,*) "Wrong RESCALE_MODE",rescale_mode
 761 > #ifdef MPI
 762 >        call MPI_Finalize(MPI_COMM_WORLD,IERROR)
 763 > #endif
 764 >        stop 555
 765 >       endif
 766 >       welec=weights(3)*fact
 767 >       wcorr=weights(4)*fact3
 768 >       wcorr5=weights(5)*fact4
 769 >       wcorr6=weights(6)*fact5
 770 >       wel_loc=weights(7)*fact2
 771 >       wturn3=weights(8)*fact2
 772 >       wturn4=weights(9)*fact3
 773 >       wturn6=weights(10)*fact5
 774 >       wtor=weights(13)*fact
 775 >       wtor_d=weights(14)*fact2
 776 >       wsccor=weights(21)*fact
 777 >
 778 >       return
 779 >       end
 780 > C------------------------------------------------------------------------
 781 >       subroutine enerprint(energia)
 782 >       implicit real*8 (a-h,o-z)
 783 >       include 'DIMENSIONS'
 784 >       include 'COMMON.IOUNITS'
 785 >       include 'COMMON.FFIELD'
 786 >       include 'COMMON.SBRIDGE'
 787 >       include 'COMMON.MD'
 788 >       double precision energia(0:n_ene)
 789 >       etot=energia(0)
 790 >       evdw=energia(1)
 791 >       evdw2=energia(2)
 792 > #ifdef SCP14
 793 >       evdw2=energia(2)+energia(18)
 794 > #else
 795 >       evdw2=energia(2)
 796 > #endif
 797 >       ees=energia(3)
 798 > #ifdef SPLITELE
 799 >       evdw1=energia(16)
 800 > #endif
 801 >       ecorr=energia(4)
 802 >       ecorr5=energia(5)
 803 >       ecorr6=energia(6)
 804 >       eel_loc=energia(7)
 805 >       eello_turn3=energia(8)
 806 >       eello_turn4=energia(9)
 807 >       eello_turn6=energia(10)
 808 >       ebe=energia(11)
 809 >       escloc=energia(12)
 810 >       etors=energia(13)
 811 >       etors_d=energia(14)
 812 >       ehpb=energia(15)
 813 >       edihcnstr=energia(19)
 814 >       estr=energia(17)
 815 >       Uconst=energia(20)
 816 >       esccor=energia(21)
 817 > #ifdef SPLITELE
 818 >       write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
 819 >      &  estr,wbond,ebe,wang,
 820 >      &  escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
 821 >      &  ecorr,wcorr,
 822 >      &  ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
 823 >      &  eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
 824 >      &  edihcnstr,ebr*nss,
 825 >      &  Uconst,etot
 826 >    10 format (/'Virtual-chain energies:'//
 827 >      & 'EVDW=  ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
 828 >      & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
 829 >      & 'EES=   ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
 830 >      & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
 831 >      & 'ESTR=  ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
 832 >      & 'EBE=   ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
 833 >      & 'ESC=   ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
 834 >      & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
 835 >      & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
 836 >      & 'EHBP=  ',1pE16.6,' WEIGHT=',1pD16.6,
 837 >      & ' (SS bridges & dist. cnstr.)'/
 838 >      & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
 839 >      & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
 840 >      & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
 841 >      & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
 842 >      & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
 843 >      & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
 844 >      & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
 845 >      & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
 846 >      & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
 847 >      & 'ESS=   ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
 848 >      & 'UCONST= ',1pE16.6,' (Constraint energy)'/
 849 >      & 'ETOT=  ',1pE16.6,' (total)')
 850 > #else
 851 >       write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
 852 >      &  estr,wbond,ebe,wang,
 853 >      &  escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
 854 >      &  ecorr,wcorr,
 855 >      &  ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
 856 >      &  eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
 857 >      &  ebr*nss,Uconst,etot
 858 >    10 format (/'Virtual-chain energies:'//
 859 >      & 'EVDW=  ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
 860 >      & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
 861 >      & 'EES=   ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
 862 >      & 'ESTR=  ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
 863 >      & 'EBE=   ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
 864 >      & 'ESC=   ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
 865 >      & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
 866 >      & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
 867 >      & 'EHBP=  ',1pE16.6,' WEIGHT=',1pD16.6,
 868 >      & ' (SS bridges & dist. cnstr.)'/
 869 >      & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
 870 >      & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
 871 >      & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
 872 >      & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
 873 >      & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
 874 >      & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
 875 >      & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
 876 >      & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
 877 >      & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
 878 >      & 'ESS=   ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
 879 >      & 'UCONST=',1pE16.6,' (Constraint energy)'/
 880 >      & 'ETOT=  ',1pE16.6,' (total)')
 881 > #endif
 882 102c794
 883 <       subroutine elj_short(evdw)
 884 ---
 885 >       subroutine elj(evdw)
 886 129a822,823
 887 > C Change 12/1/95
 888 >         num_conti=0
 889 140a835
 890 > C Change 12/1/95 to calculate four-body interactions
 891 142,149c837,850
 892 <             sss=sscale(dsqrt(rij)/sigma(itypi,itypj))
 893 <             if (sss.gt.0.0d0) then
 894 <               rrij=1.0D0/rij
 895 <               fac=rrij**expon2
 896 <               e1=fac*fac*aa(itypi,itypj)
 897 <               e2=fac*bb(itypi,itypj)
 898 <               evdwij=e1+e2
 899 <               evdw=evdw+sss*evdwij
 900 ---
 901 >             rrij=1.0D0/rij
 902 > c           write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
 903 >             eps0ij=eps(itypi,itypj)
 904 >             fac=rrij**expon2
 905 >             e1=fac*fac*aa(itypi,itypj)
 906 >             e2=fac*bb(itypi,itypj)
 907 >             evdwij=e1+e2
 908 > cd          sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
 909 > cd          epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
 910 > cd          write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
 911 > cd   &        restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
 912 > cd   &        bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
 913 > cd   &        (c(k,i),k=1,3),(c(k,j),k=1,3)
 914 >             evdw=evdw+evdwij
 915 153,164c854,864
 916 <               fac=-rrij*(e1+evdwij)*sss
 917 <               gg(1)=xj*fac
 918 <               gg(2)=yj*fac
 919 <               gg(3)=zj*fac
 920 <               do k=1,3
 921 <                 gvdwx(k,i)=gvdwx(k,i)-gg(k)
 922 <                 gvdwx(k,j)=gvdwx(k,j)+gg(k)
 923 <               enddo
 924 <               do k=i,j-1
 925 <                 do l=1,3
 926 <                   gvdwc(l,k)=gvdwc(l,k)+gg(l)
 927 <                 enddo
 928 ---
 929 >             fac=-rrij*(e1+evdwij)
 930 >             gg(1)=xj*fac
 931 >             gg(2)=yj*fac
 932 >             gg(3)=zj*fac
 933 >             do k=1,3
 934 >               gvdwx(k,i)=gvdwx(k,i)-gg(k)
 935 >               gvdwx(k,j)=gvdwx(k,j)+gg(k)
 936 >             enddo
 937 >             do k=i,j-1
 938 >               do l=1,3
 939 >                 gvdwc(l,k)=gvdwc(l,k)+gg(l)
 940 165a866,921
 941 >             enddo
 942 > C
 943 > C 12/1/95, revised on 5/20/97
 944 > C
 945 > C Calculate the contact function. The ith column of the array JCONT will
 946 > C contain the numbers of atoms that make contacts with the atom I (of numbers
 947 > C greater than I). The arrays FACONT and GACONT will contain the values of
 948 > C the contact function and its derivative.
 949 > C
 950 > C Uncomment next line, if the correlation interactions include EVDW explicitly.
 951 > c           if (j.gt.i+1 .and. evdwij.le.0.0D0) then
 952 > C Uncomment next line, if the correlation interactions are contact function only
 953 >             if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
 954 >               rij=dsqrt(rij)
 955 >               sigij=sigma(itypi,itypj)
 956 >               r0ij=rs0(itypi,itypj)
 957 > C
 958 > C Check whether the SC's are not too far to make a contact.
 959 > C
 960 >               rcut=1.5d0*r0ij
 961 >               call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
 962 > C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
 963 > C
 964 >               if (fcont.gt.0.0D0) then
 965 > C If the SC-SC distance if close to sigma, apply spline.
 966 > cAdam           call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
 967 > cAdam &             fcont1,fprimcont1)
 968 > cAdam           fcont1=1.0d0-fcont1
 969 > cAdam           if (fcont1.gt.0.0d0) then
 970 > cAdam             fprimcont=fprimcont*fcont1+fcont*fprimcont1
 971 > cAdam             fcont=fcont*fcont1
 972 > cAdam           endif
 973 > C Uncomment following 4 lines to have the geometric average of the epsilon0's
 974 > cga             eps0ij=1.0d0/dsqrt(eps0ij)
 975 > cga             do k=1,3
 976 > cga               gg(k)=gg(k)*eps0ij
 977 > cga             enddo
 978 > cga             eps0ij=-evdwij*eps0ij
 979 > C Uncomment for AL's type of SC correlation interactions.
 980 > cadam           eps0ij=-evdwij
 981 >                 num_conti=num_conti+1
 982 >                 jcont(num_conti,i)=j
 983 >                 facont(num_conti,i)=fcont*eps0ij
 984 >                 fprimcont=eps0ij*fprimcont/rij
 985 >                 fcont=expon*fcont
 986 > cAdam           gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
 987 > cAdam           gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
 988 > cAdam           gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
 989 > C Uncomment following 3 lines for Skolnick's type of SC correlation.
 990 >                 gacont(1,num_conti,i)=-fprimcont*xj
 991 >                 gacont(2,num_conti,i)=-fprimcont*yj
 992 >                 gacont(3,num_conti,i)=-fprimcont*zj
 993 > cd              write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
 994 > cd              write (iout,'(2i3,3f10.5)')
 995 > cd   &           i,j,(gacont(kk,num_conti,i),kk=1,3)
 996 >               endif
 997 168a925,926
 998 > C Change 12/1/95
 999 >         num_cont(i)=num_conti
1000 188c946
1001 <       subroutine eljk_long(evdw)
1002 ---
1003 >       subroutine eljk(evdw)
1004 227,243c985,997
1005 <             sss=sscale(rij/sigma(itypi,itypj))
1006 <
1007 <             if (sss.lt.1.0d0) then
1008 <
1009 <               r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1010 <               fac=r_shift_inv**expon
1011 <               e1=fac*fac*aa(itypi,itypj)
1012 <               e2=fac*bb(itypi,itypj)
1013 <               evdwij=e_augm+e1+e2
1014 < cd            sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1015 < cd            epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1016 < cd            write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1017 < cd   &          restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1018 < cd   &          bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1019 < cd   &          sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1020 < cd   &          (c(k,i),k=1,3),(c(k,j),k=1,3)
1021 <               evdw=evdw+evdwij*(1.0d0-sss)
1022 ---
1023 >             r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1024 >             fac=r_shift_inv**expon
1025 >             e1=fac*fac*aa(itypi,itypj)
1026 >             e2=fac*bb(itypi,itypj)
1027 >             evdwij=e_augm+e1+e2
1028 > cd          sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1029 > cd          epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1030 > cd          write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1031 > cd   &        restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1032 > cd   &        bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1033 > cd   &        sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1034 > cd   &        (c(k,i),k=1,3),(c(k,j),k=1,3)
1035 >             evdw=evdw+evdwij
1036 247,259c1001,1011
1037 <               fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1038 <               fac=fac*(1.0d0-sss)
1039 <               gg(1)=xj*fac
1040 <               gg(2)=yj*fac
1041 <               gg(3)=zj*fac
1042 <               do k=1,3
1043 <                 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1044 <                 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1045 <               enddo
1046 <               do k=i,j-1
1047 <                 do l=1,3
1048 <                   gvdwc(l,k)=gvdwc(l,k)+gg(l)
1049 <                 enddo
1050 ---
1051 >             fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1052 >             gg(1)=xj*fac
1053 >             gg(2)=yj*fac
1054 >             gg(3)=zj*fac
1055 >             do k=1,3
1056 >               gvdwx(k,i)=gvdwx(k,i)-gg(k)
1057 >               gvdwx(k,j)=gvdwx(k,j)+gg(k)
1058 >             enddo
1059 >             do k=i,j-1
1060 >               do l=1,3
1061 >                 gvdwc(l,k)=gvdwc(l,k)+gg(l)
1062 261,263c1013
1063 <
1064 <             endif
1065 <
1066 ---
1067 >             enddo
1068 276c1026
1069 <       subroutine eljk_short(evdw)
1070 ---
1071 >       subroutine ebp(evdw)
1072 279c1029
1073 < C assuming the LJK potential of interaction.
1074 ---
1075 > C assuming the Berne-Pechukas potential of interaction.
1076 287a1038
1077 >       include 'COMMON.NAMES'
1078 290,382c1041,1044
1079 <       include 'COMMON.NAMES'
1080 <       dimension gg(3)
1081 <       logical scheck
1082 < c     print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1083 <       evdw=0.0D0
1084 <       do i=iatsc_s,iatsc_e
1085 <         itypi=itype(i)
1086 <         itypi1=itype(i+1)
1087 <         xi=c(1,nres+i)
1088 <         yi=c(2,nres+i)
1089 <         zi=c(3,nres+i)
1090 < C
1091 < C Calculate SC interaction energy.
1092 < C
1093 <         do iint=1,nint_gr(i)
1094 <           do j=istart(i,iint),iend(i,iint)
1095 <             itypj=itype(j)
1096 <             xj=c(1,nres+j)-xi
1097 <             yj=c(2,nres+j)-yi
1098 <             zj=c(3,nres+j)-zi
1099 <             rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1100 <             fac_augm=rrij**expon
1101 <             e_augm=augm(itypi,itypj)*fac_augm
1102 <             r_inv_ij=dsqrt(rrij)
1103 <             rij=1.0D0/r_inv_ij
1104 <             sss=sscale(rij/sigma(itypi,itypj))
1105 <
1106 <             if (sss.gt.0.0d0) then
1107 <
1108 <               r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1109 <               fac=r_shift_inv**expon
1110 <               e1=fac*fac*aa(itypi,itypj)
1111 <               e2=fac*bb(itypi,itypj)
1112 <               evdwij=e_augm+e1+e2
1113 < cd            sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1114 < cd            epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1115 < cd            write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1116 < cd   &          restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1117 < cd   &          bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1118 < cd   &          sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1119 < cd   &          (c(k,i),k=1,3),(c(k,j),k=1,3)
1120 <               evdw=evdw+evdwij*sss
1121 < C
1122 < C Calculate the components of the gradient in DC and X
1123 < C
1124 <               fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1125 <               fac=fac*sss
1126 <               gg(1)=xj*fac
1127 <               gg(2)=yj*fac
1128 <               gg(3)=zj*fac
1129 <               do k=1,3
1130 <                 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1131 <                 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1132 <               enddo
1133 <               do k=i,j-1
1134 <                 do l=1,3
1135 <                   gvdwc(l,k)=gvdwc(l,k)+gg(l)
1136 <                 enddo
1137 <               enddo
1138 <
1139 <             endif
1140 <
1141 <           enddo      ! j
1142 <         enddo        ! iint
1143 <       enddo          ! i
1144 <       do i=1,nct
1145 <         do j=1,3
1146 <           gvdwc(j,i)=expon*gvdwc(j,i)
1147 <           gvdwx(j,i)=expon*gvdwx(j,i)
1148 <         enddo
1149 <       enddo
1150 <       return
1151 <       end
1152 < C-----------------------------------------------------------------------------
1153 <       subroutine ebp_long(evdw)
1154 < C
1155 < C This subroutine calculates the interaction energy of nonbonded side chains
1156 < C assuming the Berne-Pechukas potential of interaction.
1157 < C
1158 <       implicit real*8 (a-h,o-z)
1159 <       include 'DIMENSIONS'
1160 <       include 'COMMON.GEO'
1161 <       include 'COMMON.VAR'
1162 <       include 'COMMON.LOCAL'
1163 <       include 'COMMON.CHAIN'
1164 <       include 'COMMON.DERIV'
1165 <       include 'COMMON.NAMES'
1166 <       include 'COMMON.INTERACT'
1167 <       include 'COMMON.IOUNITS'
1168 <       include 'COMMON.CALC'
1169 <       common /srutu/ icall
1170 < c     double precision rrsave(maxdim)
1171 <       logical lprn
1172 ---
1173 >       include 'COMMON.CALC'
1174 >       common /srutu/ icall
1175 > c     double precision rrsave(maxdim)
1176 >       logical lprn
1177 444,447d1105
1178 <             sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
1179 <
1180 <             if (sss.lt.1.0d0) then
1181 <
1182 449c1107
1183 <               call sc_angular
1184 ---
1185 >             call sc_angular
1186 452,462c1110,1120
1187 <               fac=(rrij*sigsq)**expon2
1188 <               e1=fac*fac*aa(itypi,itypj)
1189 <               e2=fac*bb(itypi,itypj)
1190 <               evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1191 <               eps2der=evdwij*eps3rt
1192 <               eps3der=evdwij*eps2rt
1193 <               evdwij=evdwij*eps2rt*eps3rt
1194 <               evdw=evdw+evdwij*(1.0d0-sss)
1195 <               if (lprn) then
1196 <               sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1197 <               epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1198 ---
1199 >             fac=(rrij*sigsq)**expon2
1200 >             e1=fac*fac*aa(itypi,itypj)
1201 >             e2=fac*bb(itypi,itypj)
1202 >             evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1203 >             eps2der=evdwij*eps3rt
1204 >             eps3der=evdwij*eps2rt
1205 >             evdwij=evdwij*eps2rt*eps3rt
1206 >             evdw=evdw+evdwij
1207 >             if (lprn) then
1208 >             sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1209 >             epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1210 469,482d1126
1211 <               endif
1212 < C Calculate gradient components.
1213 <               e1=e1*eps1*eps2rt**2*eps3rt**2
1214 <               fac=-expon*(e1+evdwij)
1215 <               sigder=fac/sigsq
1216 <               fac=rrij*fac
1217 < C Calculate radial part of the gradient
1218 <               gg(1)=xj*fac
1219 <               gg(2)=yj*fac
1220 <               gg(3)=zj*fac
1221 < C Calculate the angular part of the gradient and sum add the contributions
1222 < C to the appropriate components of the Cartesian gradient.
1223 <               call sc_grad_scale(1.0d0-sss)
1224 <
1225 484,597d1127
1226 <
1227 <           enddo      ! j
1228 <         enddo        ! iint
1229 <       enddo          ! i
1230 < c     stop
1231 <       return
1232 <       end
1233 < C-----------------------------------------------------------------------------
1234 <       subroutine ebp_short(evdw)
1235 < C
1236 < C This subroutine calculates the interaction energy of nonbonded side chains
1237 < C assuming the Berne-Pechukas potential of interaction.
1238 < C
1239 <       implicit real*8 (a-h,o-z)
1240 <       include 'DIMENSIONS'
1241 <       include 'COMMON.GEO'
1242 <       include 'COMMON.VAR'
1243 <       include 'COMMON.LOCAL'
1244 <       include 'COMMON.CHAIN'
1245 <       include 'COMMON.DERIV'
1246 <       include 'COMMON.NAMES'
1247 <       include 'COMMON.INTERACT'
1248 <       include 'COMMON.IOUNITS'
1249 <       include 'COMMON.CALC'
1250 <       common /srutu/ icall
1251 < c     double precision rrsave(maxdim)
1252 <       logical lprn
1253 <       evdw=0.0D0
1254 < c     print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1255 <       evdw=0.0D0
1256 < c     if (icall.eq.0) then
1257 < c       lprn=.true.
1258 < c     else
1259 <         lprn=.false.
1260 < c     endif
1261 <       ind=0
1262 <       do i=iatsc_s,iatsc_e
1263 <         itypi=itype(i)
1264 <         itypi1=itype(i+1)
1265 <         xi=c(1,nres+i)
1266 <         yi=c(2,nres+i)
1267 <         zi=c(3,nres+i)
1268 <         dxi=dc_norm(1,nres+i)
1269 <         dyi=dc_norm(2,nres+i)
1270 <         dzi=dc_norm(3,nres+i)
1271 < c        dsci_inv=dsc_inv(itypi)
1272 <         dsci_inv=vbld_inv(i+nres)
1273 < C
1274 < C Calculate SC interaction energy.
1275 < C
1276 <         do iint=1,nint_gr(i)
1277 <           do j=istart(i,iint),iend(i,iint)
1278 <             ind=ind+1
1279 <             itypj=itype(j)
1280 < c            dscj_inv=dsc_inv(itypj)
1281 <             dscj_inv=vbld_inv(j+nres)
1282 <             chi1=chi(itypi,itypj)
1283 <             chi2=chi(itypj,itypi)
1284 <             chi12=chi1*chi2
1285 <             chip1=chip(itypi)
1286 <             chip2=chip(itypj)
1287 <             chip12=chip1*chip2
1288 <             alf1=alp(itypi)
1289 <             alf2=alp(itypj)
1290 <             alf12=0.5D0*(alf1+alf2)
1291 < C For diagnostics only!!!
1292 < c           chi1=0.0D0
1293 < c           chi2=0.0D0
1294 < c           chi12=0.0D0
1295 < c           chip1=0.0D0
1296 < c           chip2=0.0D0
1297 < c           chip12=0.0D0
1298 < c           alf1=0.0D0
1299 < c           alf2=0.0D0
1300 < c           alf12=0.0D0
1301 <             xj=c(1,nres+j)-xi
1302 <             yj=c(2,nres+j)-yi
1303 <             zj=c(3,nres+j)-zi
1304 <             dxj=dc_norm(1,nres+j)
1305 <             dyj=dc_norm(2,nres+j)
1306 <             dzj=dc_norm(3,nres+j)
1307 <             rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1308 < cd          if (icall.eq.0) then
1309 < cd            rrsave(ind)=rrij
1310 < cd          else
1311 < cd            rrij=rrsave(ind)
1312 < cd          endif
1313 <             rij=dsqrt(rrij)
1314 <             sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
1315 <
1316 <             if (sss.gt.0.0d0) then
1317 <
1318 < C Calculate the angle-dependent terms of energy & contributions to derivatives.
1319 <               call sc_angular
1320 < C Calculate whole angle-dependent part of epsilon and contributions
1321 < C to its derivatives
1322 <               fac=(rrij*sigsq)**expon2
1323 <               e1=fac*fac*aa(itypi,itypj)
1324 <               e2=fac*bb(itypi,itypj)
1325 <               evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1326 <               eps2der=evdwij*eps3rt
1327 <               eps3der=evdwij*eps2rt
1328 <               evdwij=evdwij*eps2rt*eps3rt
1329 <               evdw=evdw+evdwij*sss
1330 <               if (lprn) then
1331 <               sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1332 <               epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1333 < cd            write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1334 < cd     &        restyp(itypi),i,restyp(itypj),j,
1335 < cd     &        epsi,sigm,chi1,chi2,chip1,chip2,
1336 < cd     &        eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1337 < cd     &        om1,om2,om12,1.0D0/dsqrt(rrij),
1338 < cd     &        evdwij
1339 <               endif
1340 599,602c1129,1132
1341 <               e1=e1*eps1*eps2rt**2*eps3rt**2
1342 <               fac=-expon*(e1+evdwij)
1343 <               sigder=fac/sigsq
1344 <               fac=rrij*fac
1345 ---
1346 >             e1=e1*eps1*eps2rt**2*eps3rt**2
1347 >             fac=-expon*(e1+evdwij)
1348 >             sigder=fac/sigsq
1349 >             fac=rrij*fac
1350 604,606c1134,1136
1351 <               gg(1)=xj*fac
1352 <               gg(2)=yj*fac
1353 <               gg(3)=zj*fac
1354 ---
1355 >             gg(1)=xj*fac
1356 >             gg(2)=yj*fac
1357 >             gg(3)=zj*fac
1358 609,612c1139
1359 <               call sc_grad_scale(sss)
1360 <
1361 <             endif
1362 <
1363 ---
1364 >             call sc_grad
1365 620c1147
1366 <       subroutine egb_long(evdw)
1367 ---
1368 >       subroutine egb(evdw)
1369 701,706d1227
1370 <             sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
1371 < c            write(iout,*) "long",i,itypi,j,itypj," rij",1.0d0/rij,
1372 < c     &          " sigmaii",sigmaii(itypi,itypj)," sss",sss
1373 <
1374 <             if (sss.lt.1.0d0) then
1375 <
1376 709,712c1230,1233
1377 <               call sc_angular
1378 <               sigsq=1.0D0/sigsq
1379 <               sig=sig0ij*dsqrt(sigsq)
1380 <               rij_shift=1.0D0/rij-sig+sig0ij
1381 ---
1382 >             call sc_angular
1383 >             sigsq=1.0D0/sigsq
1384 >             sig=sig0ij*dsqrt(sigsq)
1385 >             rij_shift=1.0D0/rij-sig+sig0ij
1386 714c1235
1387 < c              rij_shift=1.2*sig0ij
1388 ---
1389 > c            rij_shift=1.2*sig0ij
1390 716,723c1237,1244
1391 <               if (rij_shift.le.0.0D0) then
1392 <                 evdw=1.0D20
1393 < cd                write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1394 < cd     &          restyp(itypi),i,restyp(itypj),j,
1395 < cd     &          rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1396 <                 return
1397 <               endif
1398 <               sigder=-sig*sigsq
1399 ---
1400 >             if (rij_shift.le.0.0D0) then
1401 >               evdw=1.0D20
1402 > cd              write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1403 > cd     &        restyp(itypi),i,restyp(itypj),j,
1404 > cd     &        rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1405 >               return
1406 >             endif
1407 >             sigder=-sig*sigsq
1408 725,732c1246,1253
1409 <               rij_shift=1.0D0/rij_shift
1410 <               fac=rij_shift**expon
1411 <               e1=fac*fac*aa(itypi,itypj)
1412 <               e2=fac*bb(itypi,itypj)
1413 <               evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1414 <               eps2der=evdwij*eps3rt
1415 <               eps3der=evdwij*eps2rt
1416 < c              write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1417 ---
1418 >             rij_shift=1.0D0/rij_shift
1419 >             fac=rij_shift**expon
1420 >             e1=fac*fac*aa(itypi,itypj)
1421 >             e2=fac*bb(itypi,itypj)
1422 >             evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1423 >             eps2der=evdwij*eps3rt
1424 >             eps3der=evdwij*eps2rt
1425 > c            write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1426 734,746c1255,1266
1427 <               evdwij=evdwij*eps2rt*eps3rt
1428 <               evdw=evdw+evdwij*(1.0d0-sss)
1429 < c              write (iout,*) "evdwij",evdwij," evdw",evdw
1430 <               if (lprn) then
1431 <               sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1432 <               epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1433 <               write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1434 <      &          restyp(itypi),i,restyp(itypj),j,
1435 <      &          epsi,sigm,chi1,chi2,chip1,chip2,
1436 <      &          eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1437 <      &          om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1438 <      &          evdwij
1439 <               endif
1440 ---
1441 >             evdwij=evdwij*eps2rt*eps3rt
1442 >             evdw=evdw+evdwij
1443 >             if (lprn) then
1444 >             sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1445 >             epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1446 >             write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1447 >      &        restyp(itypi),i,restyp(itypj),j,
1448 >      &        epsi,sigm,chi1,chi2,chip1,chip2,
1449 >      &        eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1450 >      &        om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1451 >      &        evdwij
1452 >             endif
1453 748c1268
1454 <               if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1455 ---
1456 >             if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1457 752,756c1272,1276
1458 <               e1=e1*eps1*eps2rt**2*eps3rt**2
1459 <               fac=-expon*(e1+evdwij)*rij_shift
1460 <               sigder=fac*sigder
1461 <               fac=rij*fac
1462 < c              fac=0.0d0
1463 ---
1464 >             e1=e1*eps1*eps2rt**2*eps3rt**2
1465 >             fac=-expon*(e1+evdwij)*rij_shift
1466 >             sigder=fac*sigder
1467 >             fac=rij*fac
1468 > c            fac=0.0d0
1469 758,760c1278,1280
1470 <               gg(1)=xj*fac
1471 <               gg(2)=yj*fac
1472 <               gg(3)=zj*fac
1473 ---
1474 >             gg(1)=xj*fac
1475 >             gg(2)=yj*fac
1476 >             gg(3)=zj*fac
1477 762,765c1282
1478 <               call sc_grad_scale(1.0d0-sss)
1479 <
1480 <             endif
1481 <
1482 ---
1483 >             call sc_grad
1484 773c1290
1485 <       subroutine egb_short(evdw)
1486 ---
1487 >       subroutine egbv(evdw)
1488 776c1293
1489 < C assuming the Gay-Berne potential of interaction.
1490 ---
1491 > C assuming the Gay-Berne-Vorobjev potential of interaction.
1492 789c1306
1493 <       include 'COMMON.CONTROL'
1494 ---
1495 >       common /srutu/ icall
1496 792d1308
1497 < ccccc      energy_dec=.false.
1498 796c1312
1499 < c     if (icall.eq.0) lprn=.false.
1500 ---
1501 > c     if (icall.eq.0) lprn=.true.
1502 809,810d1324
1503 < c        write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1504 < c        write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1505 820,822d1333
1506 < c            write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1507 < c     &       1.0d0/vbld(j+nres)
1508 < c            write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1509 823a1335
1510 >             r0ij=r0(itypi,itypj)
1511 849,851d1360
1512 < c            write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1513 < c            write (iout,*) "j",j," dc_norm",
1514 < c     &       dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1515 854,858d1362
1516 <             sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
1517 < c            write(iout,*) "short",i,itypi,j,itypj," rij",1.0d0/rij,
1518 < c     &          " sigmaii",sigmaii(itypi,itypj)," sss",sss
1519 <             if (sss.gt.0.0d0) then
1520 <
1521 861,866c1365,1368
1522 <               call sc_angular
1523 <               sigsq=1.0D0/sigsq
1524 <               sig=sig0ij*dsqrt(sigsq)
1525 <               rij_shift=1.0D0/rij-sig+sig0ij
1526 < c for diagnostics; uncomment
1527 < c              rij_shift=1.2*sig0ij
1528 ---
1529 >             call sc_angular
1530 >             sigsq=1.0D0/sigsq
1531 >             sig=sig0ij*dsqrt(sigsq)
1532 >             rij_shift=1.0D0/rij-sig+r0ij
1533 868,875c1370,1374
1534 <               if (rij_shift.le.0.0D0) then
1535 <                 evdw=1.0D20
1536 < cd                write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1537 < cd     &          restyp(itypi),i,restyp(itypj),j,
1538 < cd     &          rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1539 <                 return
1540 <               endif
1541 <               sigder=-sig*sigsq
1542 ---
1543 >             if (rij_shift.le.0.0D0) then
1544 >               evdw=1.0D20
1545 >               return
1546 >             endif
1547 >             sigder=-sig*sigsq
1548 877,902c1376,1397
1549 <               rij_shift=1.0D0/rij_shift
1550 <               fac=rij_shift**expon
1551 <               e1=fac*fac*aa(itypi,itypj)
1552 <               e2=fac*bb(itypi,itypj)
1553 <               evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1554 <               eps2der=evdwij*eps3rt
1555 <               eps3der=evdwij*eps2rt
1556 < c              write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1557 < c     &        " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1558 <               evdwij=evdwij*eps2rt*eps3rt
1559 <               evdw=evdw+evdwij*sss
1560 < c              write (iout,*) "evdwij",evdwij," evdw",evdw
1561 <               if (lprn) then
1562 <               sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1563 <               epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1564 <               write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1565 <      &          restyp(itypi),i,restyp(itypj),j,
1566 <      &          epsi,sigm,chi1,chi2,chip1,chip2,
1567 <      &          eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1568 <      &          om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1569 <      &          evdwij
1570 <               endif
1571 <
1572 <               if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1573 <      &                        'evdw',i,j,evdwij
1574 <
1575 ---
1576 >             rij_shift=1.0D0/rij_shift
1577 >             fac=rij_shift**expon
1578 >             e1=fac*fac*aa(itypi,itypj)
1579 >             e2=fac*bb(itypi,itypj)
1580 >             evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1581 >             eps2der=evdwij*eps3rt
1582 >             eps3der=evdwij*eps2rt
1583 >             fac_augm=rrij**expon
1584 >             e_augm=augm(itypi,itypj)*fac_augm
1585 >             evdwij=evdwij*eps2rt*eps3rt
1586 >             evdw=evdw+evdwij+e_augm
1587 >             if (lprn) then
1588 >             sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1589 >             epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1590 >             write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1591 >      &        restyp(itypi),i,restyp(itypj),j,
1592 >      &        epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1593 >      &        chi1,chi2,chip1,chip2,
1594 >      &        eps1,eps2rt**2,eps3rt**2,
1595 >      &        om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1596 >      &        evdwij+e_augm
1597 >             endif
1598 904,908c1399,1402
1599 <               e1=e1*eps1*eps2rt**2*eps3rt**2
1600 <               fac=-expon*(e1+evdwij)*rij_shift
1601 <               sigder=fac*sigder
1602 <               fac=rij*fac
1603 < c              fac=0.0d0
1604 ---
1605 >             e1=e1*eps1*eps2rt**2*eps3rt**2
1606 >             fac=-expon*(e1+evdwij)*rij_shift
1607 >             sigder=fac*sigder
1608 >             fac=rij*fac-2*expon*rrij*e_augm
1609 910,912c1404,1406
1610 <               gg(1)=xj*fac
1611 <               gg(2)=yj*fac
1612 <               gg(3)=zj*fac
1613 ---
1614 >             gg(1)=xj*fac
1615 >             gg(2)=yj*fac
1616 >             gg(3)=zj*fac
1617 914,917c1408
1618 <               call sc_grad_scale(sss)
1619 <
1620 <             endif
1621 <
1622 ---
1623 >             call sc_grad
1624 921,922d1411
1625 < cccc      energy_dec=.false.
1626 <       return
1627 925,1189c1414,1482
1628 <       subroutine egbv_long(evdw)
1629 < C
1630 < C This subroutine calculates the interaction energy of nonbonded side chains
1631 < C assuming the Gay-Berne-Vorobjev potential of interaction.
1632 < C
1633 <       implicit real*8 (a-h,o-z)
1634 <       include 'DIMENSIONS'
1635 <       include 'COMMON.GEO'
1636 <       include 'COMMON.VAR'
1637 <       include 'COMMON.LOCAL'
1638 <       include 'COMMON.CHAIN'
1639 <       include 'COMMON.DERIV'
1640 <       include 'COMMON.NAMES'
1641 <       include 'COMMON.INTERACT'
1642 <       include 'COMMON.IOUNITS'
1643 <       include 'COMMON.CALC'
1644 <       common /srutu/ icall
1645 <       logical lprn
1646 <       evdw=0.0D0
1647 < c     print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1648 <       evdw=0.0D0
1649 <       lprn=.false.
1650 < c     if (icall.eq.0) lprn=.true.
1651 <       ind=0
1652 <       do i=iatsc_s,iatsc_e
1653 <         itypi=itype(i)
1654 <         itypi1=itype(i+1)
1655 <         xi=c(1,nres+i)
1656 <         yi=c(2,nres+i)
1657 <         zi=c(3,nres+i)
1658 <         dxi=dc_norm(1,nres+i)
1659 <         dyi=dc_norm(2,nres+i)
1660 <         dzi=dc_norm(3,nres+i)
1661 < c        dsci_inv=dsc_inv(itypi)
1662 <         dsci_inv=vbld_inv(i+nres)
1663 < C
1664 < C Calculate SC interaction energy.
1665 < C
1666 <         do iint=1,nint_gr(i)
1667 <           do j=istart(i,iint),iend(i,iint)
1668 <             ind=ind+1
1669 <             itypj=itype(j)
1670 < c            dscj_inv=dsc_inv(itypj)
1671 <             dscj_inv=vbld_inv(j+nres)
1672 <             sig0ij=sigma(itypi,itypj)
1673 <             r0ij=r0(itypi,itypj)
1674 <             chi1=chi(itypi,itypj)
1675 <             chi2=chi(itypj,itypi)
1676 <             chi12=chi1*chi2
1677 <             chip1=chip(itypi)
1678 <             chip2=chip(itypj)
1679 <             chip12=chip1*chip2
1680 <             alf1=alp(itypi)
1681 <             alf2=alp(itypj)
1682 <             alf12=0.5D0*(alf1+alf2)
1683 < C For diagnostics only!!!
1684 < c           chi1=0.0D0
1685 < c           chi2=0.0D0
1686 < c           chi12=0.0D0
1687 < c           chip1=0.0D0
1688 < c           chip2=0.0D0
1689 < c           chip12=0.0D0
1690 < c           alf1=0.0D0
1691 < c           alf2=0.0D0
1692 < c           alf12=0.0D0
1693 <             xj=c(1,nres+j)-xi
1694 <             yj=c(2,nres+j)-yi
1695 <             zj=c(3,nres+j)-zi
1696 <             dxj=dc_norm(1,nres+j)
1697 <             dyj=dc_norm(2,nres+j)
1698 <             dzj=dc_norm(3,nres+j)
1699 <             rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1700 <             rij=dsqrt(rrij)
1701 <
1702 <             sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
1703 <
1704 <             if (sss.lt.1.0d0) then
1705 <
1706 < C Calculate angle-dependent terms of energy and contributions to their
1707 < C derivatives.
1708 <               call sc_angular
1709 <               sigsq=1.0D0/sigsq
1710 <               sig=sig0ij*dsqrt(sigsq)
1711 <               rij_shift=1.0D0/rij-sig+r0ij
1712 < C I hate to put IF's in the loops, but here don't have another choice!!!!
1713 <               if (rij_shift.le.0.0D0) then
1714 <                 evdw=1.0D20
1715 <                 return
1716 <               endif
1717 <               sigder=-sig*sigsq
1718 < c---------------------------------------------------------------
1719 <               rij_shift=1.0D0/rij_shift
1720 <               fac=rij_shift**expon
1721 <               e1=fac*fac*aa(itypi,itypj)
1722 <               e2=fac*bb(itypi,itypj)
1723 <               evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1724 <               eps2der=evdwij*eps3rt
1725 <               eps3der=evdwij*eps2rt
1726 <               fac_augm=rrij**expon
1727 <               e_augm=augm(itypi,itypj)*fac_augm
1728 <               evdwij=evdwij*eps2rt*eps3rt
1729 <               evdw=evdw+(evdwij+e_augm)*(1.0d0-sss)
1730 <               if (lprn) then
1731 <               sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1732 <               epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1733 <               write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1734 <      &          restyp(itypi),i,restyp(itypj),j,
1735 <      &          epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1736 <      &          chi1,chi2,chip1,chip2,
1737 <      &          eps1,eps2rt**2,eps3rt**2,
1738 <      &          om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1739 <      &          evdwij+e_augm
1740 <               endif
1741 < C Calculate gradient components.
1742 <               e1=e1*eps1*eps2rt**2*eps3rt**2
1743 <               fac=-expon*(e1+evdwij)*rij_shift
1744 <               sigder=fac*sigder
1745 <               fac=rij*fac-2*expon*rrij*e_augm
1746 < C Calculate the radial part of the gradient
1747 <               gg(1)=xj*fac
1748 <               gg(2)=yj*fac
1749 <               gg(3)=zj*fac
1750 < C Calculate angular part of the gradient.
1751 <               call sc_grad_scale(1.0d0-sss)
1752 <
1753 <             endif
1754 <
1755 <           enddo      ! j
1756 <         enddo        ! iint
1757 <       enddo          ! i
1758 <       end
1759 < C-----------------------------------------------------------------------------
1760 <       subroutine egbv_short(evdw)
1761 < C
1762 < C This subroutine calculates the interaction energy of nonbonded side chains
1763 < C assuming the Gay-Berne-Vorobjev potential of interaction.
1764 < C
1765 <       implicit real*8 (a-h,o-z)
1766 <       include 'DIMENSIONS'
1767 <       include 'COMMON.GEO'
1768 <       include 'COMMON.VAR'
1769 <       include 'COMMON.LOCAL'
1770 <       include 'COMMON.CHAIN'
1771 <       include 'COMMON.DERIV'
1772 <       include 'COMMON.NAMES'
1773 <       include 'COMMON.INTERACT'
1774 <       include 'COMMON.IOUNITS'
1775 <       include 'COMMON.CALC'
1776 <       common /srutu/ icall
1777 <       logical lprn
1778 <       evdw=0.0D0
1779 < c     print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1780 <       evdw=0.0D0
1781 <       lprn=.false.
1782 < c     if (icall.eq.0) lprn=.true.
1783 <       ind=0
1784 <       do i=iatsc_s,iatsc_e
1785 <         itypi=itype(i)
1786 <         itypi1=itype(i+1)
1787 <         xi=c(1,nres+i)
1788 <         yi=c(2,nres+i)
1789 <         zi=c(3,nres+i)
1790 <         dxi=dc_norm(1,nres+i)
1791 <         dyi=dc_norm(2,nres+i)
1792 <         dzi=dc_norm(3,nres+i)
1793 < c        dsci_inv=dsc_inv(itypi)
1794 <         dsci_inv=vbld_inv(i+nres)
1795 < C
1796 < C Calculate SC interaction energy.
1797 < C
1798 <         do iint=1,nint_gr(i)
1799 <           do j=istart(i,iint),iend(i,iint)
1800 <             ind=ind+1
1801 <             itypj=itype(j)
1802 < c            dscj_inv=dsc_inv(itypj)
1803 <             dscj_inv=vbld_inv(j+nres)
1804 <             sig0ij=sigma(itypi,itypj)
1805 <             r0ij=r0(itypi,itypj)
1806 <             chi1=chi(itypi,itypj)
1807 <             chi2=chi(itypj,itypi)
1808 <             chi12=chi1*chi2
1809 <             chip1=chip(itypi)
1810 <             chip2=chip(itypj)
1811 <             chip12=chip1*chip2
1812 <             alf1=alp(itypi)
1813 <             alf2=alp(itypj)
1814 <             alf12=0.5D0*(alf1+alf2)
1815 < C For diagnostics only!!!
1816 < c           chi1=0.0D0
1817 < c           chi2=0.0D0
1818 < c           chi12=0.0D0
1819 < c           chip1=0.0D0
1820 < c           chip2=0.0D0
1821 < c           chip12=0.0D0
1822 < c           alf1=0.0D0
1823 < c           alf2=0.0D0
1824 < c           alf12=0.0D0
1825 <             xj=c(1,nres+j)-xi
1826 <             yj=c(2,nres+j)-yi
1827 <             zj=c(3,nres+j)-zi
1828 <             dxj=dc_norm(1,nres+j)
1829 <             dyj=dc_norm(2,nres+j)
1830 <             dzj=dc_norm(3,nres+j)
1831 <             rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1832 <             rij=dsqrt(rrij)
1833 <
1834 <             sss=sscale(1.0d0/(rij*sigmaii(itypi,itypj)))
1835 <
1836 <             if (sss.gt.0.0d0) then
1837 <
1838 < C Calculate angle-dependent terms of energy and contributions to their
1839 < C derivatives.
1840 <               call sc_angular
1841 <               sigsq=1.0D0/sigsq
1842 <               sig=sig0ij*dsqrt(sigsq)
1843 <               rij_shift=1.0D0/rij-sig+r0ij
1844 < C I hate to put IF's in the loops, but here don't have another choice!!!!
1845 <               if (rij_shift.le.0.0D0) then
1846 <                 evdw=1.0D20
1847 <                 return
1848 <               endif
1849 <               sigder=-sig*sigsq
1850 < c---------------------------------------------------------------
1851 <               rij_shift=1.0D0/rij_shift
1852 <               fac=rij_shift**expon
1853 <               e1=fac*fac*aa(itypi,itypj)
1854 <               e2=fac*bb(itypi,itypj)
1855 <               evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1856 <               eps2der=evdwij*eps3rt
1857 <               eps3der=evdwij*eps2rt
1858 <               fac_augm=rrij**expon
1859 <               e_augm=augm(itypi,itypj)*fac_augm
1860 <               evdwij=evdwij*eps2rt*eps3rt
1861 <               evdw=evdw+(evdwij+e_augm)*sss
1862 <               if (lprn) then
1863 <               sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1864 <               epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1865 <               write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1866 <      &          restyp(itypi),i,restyp(itypj),j,
1867 <      &          epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1868 <      &          chi1,chi2,chip1,chip2,
1869 <      &          eps1,eps2rt**2,eps3rt**2,
1870 <      &          om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1871 <      &          evdwij+e_augm
1872 <               endif
1873 < C Calculate gradient components.
1874 <               e1=e1*eps1*eps2rt**2*eps3rt**2
1875 <               fac=-expon*(e1+evdwij)*rij_shift
1876 <               sigder=fac*sigder
1877 <               fac=rij*fac-2*expon*rrij*e_augm
1878 < C Calculate the radial part of the gradient
1879 <               gg(1)=xj*fac
1880 <               gg(2)=yj*fac
1881 <               gg(3)=zj*fac
1882 < C Calculate angular part of the gradient.
1883 <               call sc_grad_scale(sss)
1884 <
1885 <             endif
1886 <
1887 <           enddo      ! j
1888 <         enddo        ! iint
1889 <       enddo          ! i
1890 <       end
1891 < C----------------------------------------------------------------------------
1892 <       subroutine sc_grad_scale(scalfac)
1893 ---
1894 >       subroutine sc_angular
1895 > C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1896 > C om12. Called by ebp, egb, and egbv.
1897 >       implicit none
1898 >       include 'COMMON.CALC'
1899 >       include 'COMMON.IOUNITS'
1900 >       erij(1)=xj*rij
1901 >       erij(2)=yj*rij
1902 >       erij(3)=zj*rij
1903 >       om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1904 >       om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1905 >       om12=dxi*dxj+dyi*dyj+dzi*dzj
1906 >       chiom12=chi12*om12
1907 > C Calculate eps1(om12) and its derivative in om12
1908 >       faceps1=1.0D0-om12*chiom12
1909 >       faceps1_inv=1.0D0/faceps1
1910 >       eps1=dsqrt(faceps1_inv)
1911 > C Following variable is eps1*deps1/dom12
1912 >       eps1_om12=faceps1_inv*chiom12
1913 > c diagnostics only
1914 > c      faceps1_inv=om12
1915 > c      eps1=om12
1916 > c      eps1_om12=1.0d0
1917 > c      write (iout,*) "om12",om12," eps1",eps1
1918 > C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1919 > C and om12.
1920 >       om1om2=om1*om2
1921 >       chiom1=chi1*om1
1922 >       chiom2=chi2*om2
1923 >       facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1924 >       sigsq=1.0D0-facsig*faceps1_inv
1925 >       sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1926 >       sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1927 >       sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1928 > c diagnostics only
1929 > c      sigsq=1.0d0
1930 > c      sigsq_om1=0.0d0
1931 > c      sigsq_om2=0.0d0
1932 > c      sigsq_om12=0.0d0
1933 > c      write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1934 > c      write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1935 > c     &    " eps1",eps1
1936 > C Calculate eps2 and its derivatives in om1, om2, and om12.
1937 >       chipom1=chip1*om1
1938 >       chipom2=chip2*om2
1939 >       chipom12=chip12*om12
1940 >       facp=1.0D0-om12*chipom12
1941 >       facp_inv=1.0D0/facp
1942 >       facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1943 > c      write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1944 > c     &  " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1945 > C Following variable is the square root of eps2
1946 >       eps2rt=1.0D0-facp1*facp_inv
1947 > C Following three variables are the derivatives of the square root of eps
1948 > C in om1, om2, and om12.
1949 >       eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1950 >       eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1951 >       eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1952 > C Evaluate the "asymmetric" factor in the VDW constant, eps3
1953 >       eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1954 > c      write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1955 > c      write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1956 > c     &  " eps2rt_om12",eps2rt_om12
1957 > C Calculate whole angle-dependent part of epsilon and contributions
1958 > C to its derivatives
1959 >       return
1960 >       end
1961 > C----------------------------------------------------------------------------
1962 >       subroutine sc_grad
1963 1197d1489
1964 <       double precision scalfac
1965 1216c1508
1966 <         gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*scalfac
1967 ---
1968 >         gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1969 1221,1222c1513,1514
1970 <      &        +((eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1971 <      &        +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv)*scalfac
1972 ---
1973 >      &            +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1974 >      &            +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1975 1224,1225c1516,1517
1976 <      &        +((eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1977 <      &        +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv)*scalfac
1978 ---
1979 >      &            +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1980 >      &            +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1981 1240a1533,1605
1982 > C-----------------------------------------------------------------------
1983 >       subroutine e_softsphere(evdw)
1984 > C
1985 > C This subroutine calculates the interaction energy of nonbonded side chains
1986 > C assuming the LJ potential of interaction.
1987 > C
1988 >       implicit real*8 (a-h,o-z)
1989 >       include 'DIMENSIONS'
1990 >       parameter (accur=1.0d-10)
1991 >       include 'COMMON.GEO'
1992 >       include 'COMMON.VAR'
1993 >       include 'COMMON.LOCAL'
1994 >       include 'COMMON.CHAIN'
1995 >       include 'COMMON.DERIV'
1996 >       include 'COMMON.INTERACT'
1997 >       include 'COMMON.TORSION'
1998 >       include 'COMMON.SBRIDGE'
1999 >       include 'COMMON.NAMES'
2000 >       include 'COMMON.IOUNITS'
2001 >       include 'COMMON.CONTACTS'
2002 >       dimension gg(3)
2003 > cd    print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2004 >       evdw=0.0D0
2005 >       do i=iatsc_s,iatsc_e
2006 >         itypi=itype(i)
2007 >         itypi1=itype(i+1)
2008 >         xi=c(1,nres+i)
2009 >         yi=c(2,nres+i)
2010 >         zi=c(3,nres+i)
2011 > C
2012 > C Calculate SC interaction energy.
2013 > C
2014 >         do iint=1,nint_gr(i)
2015 > cd        write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2016 > cd   &                  'iend=',iend(i,iint)
2017 >           do j=istart(i,iint),iend(i,iint)
2018 >             itypj=itype(j)
2019 >             xj=c(1,nres+j)-xi
2020 >             yj=c(2,nres+j)-yi
2021 >             zj=c(3,nres+j)-zi
2022 >             rij=xj*xj+yj*yj+zj*zj
2023 > c           write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2024 >             r0ij=r0(itypi,itypj)
2025 >             r0ijsq=r0ij*r0ij
2026 > c            print *,i,j,r0ij,dsqrt(rij)
2027 >             if (rij.lt.r0ijsq) then
2028 >               evdwij=0.25d0*(rij-r0ijsq)**2
2029 >               fac=rij-r0ijsq
2030 >             else
2031 >               evdwij=0.0d0
2032 >               fac=0.0d0
2033 >             endif
2034 >             evdw=evdw+evdwij
2035 > C
2036 > C Calculate the components of the gradient in DC and X
2037 > C
2038 >             gg(1)=xj*fac
2039 >             gg(2)=yj*fac
2040 >             gg(3)=zj*fac
2041 >             do k=1,3
2042 >               gvdwx(k,i)=gvdwx(k,i)-gg(k)
2043 >               gvdwx(k,j)=gvdwx(k,j)+gg(k)
2044 >             enddo
2045 >             do k=i,j-1
2046 >               do l=1,3
2047 >                 gvdwc(l,k)=gvdwc(l,k)+gg(l)
2048 >               enddo
2049 >             enddo
2050 >           enddo ! j
2051 >         enddo ! iint
2052 >       enddo ! i
2053 >       return
2054 >       end
2055 1242c1607,1608
2056 <       subroutine eelec_scale(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2057 ---
2058 >       subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2059 >      &              eello_turn4)
2060 1244,1248c1610
2061 < C This subroutine calculates the average interaction energy and its gradient
2062 < C in the virtual-bond vectors between non-adjacent peptide groups, based on
2063 < C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2064 < C The potential depends both on the distance of peptide-group centers and on
2065 < C the orientation of the CA-CA virtual bonds.
2066 ---
2067 > C Soft-sphere potential of p-p interaction
2068 1264,1315c1626,1627
2069 <       dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2070 <      &          erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2071 <       double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2072 <      &    aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2073 <       common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2074 < c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2075 < #ifdef MOMENT
2076 <       double precision scal_el /1.0d0/
2077 < #else
2078 <       double precision scal_el /0.5d0/
2079 < #endif
2080 < C 12/13/98
2081 < C 13-go grudnia roku pamietnego...
2082 <       double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2083 <      &                   0.0d0,1.0d0,0.0d0,
2084 <      &                   0.0d0,0.0d0,1.0d0/
2085 < cd      write(iout,*) 'In EELEC'
2086 < cd      do i=1,nloctyp
2087 < cd        write(iout,*) 'Type',i
2088 < cd        write(iout,*) 'B1',B1(:,i)
2089 < cd        write(iout,*) 'B2',B2(:,i)
2090 < cd        write(iout,*) 'CC',CC(:,:,i)
2091 < cd        write(iout,*) 'DD',DD(:,:,i)
2092 < cd        write(iout,*) 'EE',EE(:,:,i)
2093 < cd      enddo
2094 < cd      call check_vecgrad
2095 < cd      stop
2096 <       if (icheckgrad.eq.1) then
2097 <         do i=1,nres-1
2098 <           fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2099 <           do k=1,3
2100 <             dc_norm(k,i)=dc(k,i)*fac
2101 <           enddo
2102 < c          write (iout,*) 'i',i,' fac',fac
2103 <         enddo
2104 <       endif
2105 <       if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2106 <      &    .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2107 <      &    wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2108 < c        call vec_and_deriv
2109 <         call set_matrices
2110 <       endif
2111 < cd      do i=1,nres-1
2112 < cd        write (iout,*) 'i=',i
2113 < cd        do k=1,3
2114 < cd        write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2115 < cd        enddo
2116 < cd        do k=1,3
2117 < cd          write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2118 < cd     &     uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2119 < cd        enddo
2120 < cd      enddo
2121 ---
2122 >       dimension ggg(3)
2123 > cd      write(iout,*) 'In EELEC_soft_sphere'
2124 1323,1373d1634
2125 <       do i=1,nres
2126 <         num_cont_hb(i)=0
2127 <       enddo
2128 < cd      print '(a)','Enter EELEC'
2129 < cd      write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2130 <       do i=1,nres
2131 <         gel_loc_loc(i)=0.0d0
2132 <         gcorr_loc(i)=0.0d0
2133 <       enddo
2134 < cd      do i=1,nres
2135 < cd        write (iout,'(i3,3f10.5,5x,3f10.5)')
2136 < cd     &     i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2137 < cd      enddo
2138 < c
2139 < c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2140 < C
2141 < C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2142 < C
2143 <       do i=iturn3_start,iturn3_end
2144 <         dxi=dc(1,i)
2145 <         dyi=dc(2,i)
2146 <         dzi=dc(3,i)
2147 <         dx_normi=dc_norm(1,i)
2148 <         dy_normi=dc_norm(2,i)
2149 <         dz_normi=dc_norm(3,i)
2150 <         xmedi=c(1,i)+0.5d0*dxi
2151 <         ymedi=c(2,i)+0.5d0*dyi
2152 <         zmedi=c(3,i)+0.5d0*dzi
2153 <         num_conti=0
2154 <         call eelecij_scale(i,i+2,ees,evdw1,eel_loc)
2155 <         if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2156 <         num_cont_hb(i)=num_conti
2157 <       enddo
2158 <       do i=iturn4_start,iturn4_end
2159 <         dxi=dc(1,i)
2160 <         dyi=dc(2,i)
2161 <         dzi=dc(3,i)
2162 <         dx_normi=dc_norm(1,i)
2163 <         dy_normi=dc_norm(2,i)
2164 <         dz_normi=dc_norm(3,i)
2165 <         xmedi=c(1,i)+0.5d0*dxi
2166 <         ymedi=c(2,i)+0.5d0*dyi
2167 <         zmedi=c(3,i)+0.5d0*dzi
2168 <         num_conti=0
2169 <         call eelecij_scale(i,i+3,ees,evdw1,eel_loc)
2170 <         if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
2171 <         num_cont_hb(i)=num_cont_hb(i)+num_conti
2172 <       enddo   ! i
2173 < c
2174 < c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2175 < c
2176 1378,1380d1638
2177 <         dx_normi=dc_norm(1,i)
2178 <         dy_normi=dc_norm(2,i)
2179 <         dz_normi=dc_norm(3,i)
2180 1387c1645,1684
2181 <           call eelecij_scale(i,j,ees,evdw1,eel_loc)
2182 ---
2183 >           ind=ind+1
2184 >           iteli=itel(i)
2185 >           itelj=itel(j)
2186 >           if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2187 >           r0ij=rpp(iteli,itelj)
2188 >           r0ijsq=r0ij*r0ij
2189 >           dxj=dc(1,j)
2190 >           dyj=dc(2,j)
2191 >           dzj=dc(3,j)
2192 >           xj=c(1,j)+0.5D0*dxj-xmedi
2193 >           yj=c(2,j)+0.5D0*dyj-ymedi
2194 >           zj=c(3,j)+0.5D0*dzj-zmedi
2195 >           rij=xj*xj+yj*yj+zj*zj
2196 >           if (rij.lt.r0ijsq) then
2197 >             evdw1ij=0.25d0*(rij-r0ijsq)**2
2198 >             fac=rij-r0ijsq
2199 >           else
2200 >             evdw1ij=0.0d0
2201 >             fac=0.0d0
2202 >           endif
2203 >           evdw1=evdw1+evdw1ij
2204 > C
2205 > C Calculate contributions to the Cartesian gradient.
2206 > C
2207 >           ggg(1)=fac*xj
2208 >           ggg(2)=fac*yj
2209 >           ggg(3)=fac*zj
2210 >           do k=1,3
2211 >             ghalf=0.5D0*ggg(k)
2212 >             gelc(k,i)=gelc(k,i)+ghalf
2213 >             gelc(k,j)=gelc(k,j)+ghalf
2214 >           enddo
2215 > *
2216 > * Loop over residues i+1 thru j-1.
2217 > *
2218 >           do k=i+1,j-1
2219 >             do l=1,3
2220 >               gelc(l,k)=gelc(l,k)+ggg(l)
2221 >             enddo
2222 >           enddo
2223 1389d1685
2224 <         num_cont_hb(i)=num_cont_hb(i)+num_conti
2225 1393,1394c1689,2133
2226 < C-------------------------------------------------------------------------------
2227 <       subroutine eelecij_scale(i,j,ees,evdw1,eel_loc)
2228 ---
2229 > c------------------------------------------------------------------------------
2230 >       subroutine vec_and_deriv
2231 >       implicit real*8 (a-h,o-z)
2232 >       include 'DIMENSIONS'
2233 > #ifdef MPI
2234 >       include 'mpif.h'
2235 > #endif
2236 >       include 'COMMON.IOUNITS'
2237 >       include 'COMMON.GEO'
2238 >       include 'COMMON.VAR'
2239 >       include 'COMMON.LOCAL'
2240 >       include 'COMMON.CHAIN'
2241 >       include 'COMMON.VECTORS'
2242 >       include 'COMMON.SETUP'
2243 >       include 'COMMON.TIME1'
2244 >       dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2245 > C Compute the local reference systems. For reference system (i), the
2246 > C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2247 > C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2248 > c      do i=1,nres-1
2249 >       do i=ivec_start,ivec_end
2250 >           if (i.eq.nres-1) then
2251 > C Case of the last full residue
2252 > C Compute the Z-axis
2253 >             call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2254 >             costh=dcos(pi-theta(nres))
2255 >             fac=1.0d0/dsqrt(1.0d0-costh*costh)
2256 >             do k=1,3
2257 >               uz(k,i)=fac*uz(k,i)
2258 >             enddo
2259 > C Compute the derivatives of uz
2260 >             uzder(1,1,1)= 0.0d0
2261 >             uzder(2,1,1)=-dc_norm(3,i-1)
2262 >             uzder(3,1,1)= dc_norm(2,i-1)
2263 >             uzder(1,2,1)= dc_norm(3,i-1)
2264 >             uzder(2,2,1)= 0.0d0
2265 >             uzder(3,2,1)=-dc_norm(1,i-1)
2266 >             uzder(1,3,1)=-dc_norm(2,i-1)
2267 >             uzder(2,3,1)= dc_norm(1,i-1)
2268 >             uzder(3,3,1)= 0.0d0
2269 >             uzder(1,1,2)= 0.0d0
2270 >             uzder(2,1,2)= dc_norm(3,i)
2271 >             uzder(3,1,2)=-dc_norm(2,i)
2272 >             uzder(1,2,2)=-dc_norm(3,i)
2273 >             uzder(2,2,2)= 0.0d0
2274 >             uzder(3,2,2)= dc_norm(1,i)
2275 >             uzder(1,3,2)= dc_norm(2,i)
2276 >             uzder(2,3,2)=-dc_norm(1,i)
2277 >             uzder(3,3,2)= 0.0d0
2278 > C Compute the Y-axis
2279 >             facy=fac
2280 >             do k=1,3
2281 >               uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2282 >             enddo
2283 > C Compute the derivatives of uy
2284 >             do j=1,3
2285 >               do k=1,3
2286 >                 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2287 >      &                        -dc_norm(k,i)*dc_norm(j,i-1)
2288 >                 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2289 >               enddo
2290 >               uyder(j,j,1)=uyder(j,j,1)-costh
2291 >               uyder(j,j,2)=1.0d0+uyder(j,j,2)
2292 >             enddo
2293 >             do j=1,2
2294 >               do k=1,3
2295 >                 do l=1,3
2296 >                   uygrad(l,k,j,i)=uyder(l,k,j)
2297 >                   uzgrad(l,k,j,i)=uzder(l,k,j)
2298 >                 enddo
2299 >               enddo
2300 >             enddo
2301 >             call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2302 >             call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2303 >             call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2304 >             call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2305 >           else
2306 > C Other residues
2307 > C Compute the Z-axis
2308 >             call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2309 >             costh=dcos(pi-theta(i+2))
2310 >             fac=1.0d0/dsqrt(1.0d0-costh*costh)
2311 >             do k=1,3
2312 >               uz(k,i)=fac*uz(k,i)
2313 >             enddo
2314 > C Compute the derivatives of uz
2315 >             uzder(1,1,1)= 0.0d0
2316 >             uzder(2,1,1)=-dc_norm(3,i+1)
2317 >             uzder(3,1,1)= dc_norm(2,i+1)
2318 >             uzder(1,2,1)= dc_norm(3,i+1)
2319 >             uzder(2,2,1)= 0.0d0
2320 >             uzder(3,2,1)=-dc_norm(1,i+1)
2321 >             uzder(1,3,1)=-dc_norm(2,i+1)
2322 >             uzder(2,3,1)= dc_norm(1,i+1)
2323 >             uzder(3,3,1)= 0.0d0
2324 >             uzder(1,1,2)= 0.0d0
2325 >             uzder(2,1,2)= dc_norm(3,i)
2326 >             uzder(3,1,2)=-dc_norm(2,i)
2327 >             uzder(1,2,2)=-dc_norm(3,i)
2328 >             uzder(2,2,2)= 0.0d0
2329 >             uzder(3,2,2)= dc_norm(1,i)
2330 >             uzder(1,3,2)= dc_norm(2,i)
2331 >             uzder(2,3,2)=-dc_norm(1,i)
2332 >             uzder(3,3,2)= 0.0d0
2333 > C Compute the Y-axis
2334 >             facy=fac
2335 >             do k=1,3
2336 >               uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2337 >             enddo
2338 > C Compute the derivatives of uy
2339 >             do j=1,3
2340 >               do k=1,3
2341 >                 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2342 >      &                        -dc_norm(k,i)*dc_norm(j,i+1)
2343 >                 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2344 >               enddo
2345 >               uyder(j,j,1)=uyder(j,j,1)-costh
2346 >               uyder(j,j,2)=1.0d0+uyder(j,j,2)
2347 >             enddo
2348 >             do j=1,2
2349 >               do k=1,3
2350 >                 do l=1,3
2351 >                   uygrad(l,k,j,i)=uyder(l,k,j)
2352 >                   uzgrad(l,k,j,i)=uzder(l,k,j)
2353 >                 enddo
2354 >               enddo
2355 >             enddo
2356 >             call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2357 >             call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2358 >             call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2359 >             call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2360 >           endif
2361 >       enddo
2362 >       do i=1,nres-1
2363 >         vbld_inv_temp(1)=vbld_inv(i+1)
2364 >         if (i.lt.nres-1) then
2365 >           vbld_inv_temp(2)=vbld_inv(i+2)
2366 >           else
2367 >           vbld_inv_temp(2)=vbld_inv(i)
2368 >           endif
2369 >         do j=1,2
2370 >           do k=1,3
2371 >             do l=1,3
2372 >               uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2373 >               uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2374 >             enddo
2375 >           enddo
2376 >         enddo
2377 >       enddo
2378 > #ifdef MPI
2379 >       if (nfgtasks.gt.1) then
2380 >         time00=MPI_Wtime()
2381 > c        print *,"Processor",fg_rank,kolor," ivec_start",ivec_start,
2382 > c     &   " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2383 > c     &   " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2384 >         call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank),
2385 >      &   MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2386 >      &   FG_COMM,IERR)
2387 >         call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank),
2388 >      &   MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2389 >      &   FG_COMM,IERR)
2390 >         call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2391 >      &   ivec_count(fg_rank),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2392 >      &   ivec_displ(0),MPI_UYZGRAD,FG_COMM,IERR)
2393 >         call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2394 >      &   ivec_count(fg_rank),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2395 >      &   ivec_displ(0),MPI_UYZGRAD,FG_COMM,IERR)
2396 >       endif
2397 >       time_gather=time_gather+MPI_Wtime()-time00
2398 > c      if (fg_rank.eq.0) then
2399 > c        write (iout,*) "Arrays UY and UZ"
2400 > c        do i=1,nres-1
2401 > c          write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2402 > c     &     (uz(k,i),k=1,3)
2403 > c        enddo
2404 > c      endif
2405 > #endif
2406 >       return
2407 >       end
2408 > C-----------------------------------------------------------------------------
2409 >       subroutine check_vecgrad
2410 >       implicit real*8 (a-h,o-z)
2411 >       include 'DIMENSIONS'
2412 >       include 'COMMON.IOUNITS'
2413 >       include 'COMMON.GEO'
2414 >       include 'COMMON.VAR'
2415 >       include 'COMMON.LOCAL'
2416 >       include 'COMMON.CHAIN'
2417 >       include 'COMMON.VECTORS'
2418 >       dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2419 >       dimension uyt(3,maxres),uzt(3,maxres)
2420 >       dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2421 >       double precision delta /1.0d-7/
2422 >       call vec_and_deriv
2423 > cd      do i=1,nres
2424 > crc          write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2425 > crc          write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2426 > crc          write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2427 > cd          write(iout,'(2i5,2(3f10.5,5x))') i,1,
2428 > cd     &     (dc_norm(if90,i),if90=1,3)
2429 > cd          write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2430 > cd          write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2431 > cd          write(iout,'(a)')
2432 > cd      enddo
2433 >       do i=1,nres
2434 >         do j=1,2
2435 >           do k=1,3
2436 >             do l=1,3
2437 >               uygradt(l,k,j,i)=uygrad(l,k,j,i)
2438 >               uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2439 >             enddo
2440 >           enddo
2441 >         enddo
2442 >       enddo
2443 >       call vec_and_deriv
2444 >       do i=1,nres
2445 >         do j=1,3
2446 >           uyt(j,i)=uy(j,i)
2447 >           uzt(j,i)=uz(j,i)
2448 >         enddo
2449 >       enddo
2450 >       do i=1,nres
2451 > cd        write (iout,*) 'i=',i
2452 >         do k=1,3
2453 >           erij(k)=dc_norm(k,i)
2454 >         enddo
2455 >         do j=1,3
2456 >           do k=1,3
2457 >             dc_norm(k,i)=erij(k)
2458 >           enddo
2459 >           dc_norm(j,i)=dc_norm(j,i)+delta
2460 > c          fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2461 > c          do k=1,3
2462 > c            dc_norm(k,i)=dc_norm(k,i)/fac
2463 > c          enddo
2464 > c          write (iout,*) (dc_norm(k,i),k=1,3)
2465 > c          write (iout,*) (erij(k),k=1,3)
2466 >           call vec_and_deriv
2467 >           do k=1,3
2468 >             uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2469 >             uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2470 >             uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2471 >             uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2472 >           enddo
2473 > c          write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2474 > c     &      j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2475 > c     &      (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2476 >         enddo
2477 >         do k=1,3
2478 >           dc_norm(k,i)=erij(k)
2479 >         enddo
2480 > cd        do k=1,3
2481 > cd          write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2482 > cd     &      k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2483 > cd     &      (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2484 > cd          write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2485 > cd     &      k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2486 > cd     &      (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2487 > cd          write (iout,'(a)')
2488 > cd        enddo
2489 >       enddo
2490 >       return
2491 >       end
2492 > C--------------------------------------------------------------------------
2493 >       subroutine set_matrices
2494 >       implicit real*8 (a-h,o-z)
2495 >       include 'DIMENSIONS'
2496 >       include 'COMMON.IOUNITS'
2497 >       include 'COMMON.GEO'
2498 >       include 'COMMON.VAR'
2499 >       include 'COMMON.LOCAL'
2500 >       include 'COMMON.CHAIN'
2501 >       include 'COMMON.DERIV'
2502 >       include 'COMMON.INTERACT'
2503 >       include 'COMMON.CONTACTS'
2504 >       include 'COMMON.TORSION'
2505 >       include 'COMMON.VECTORS'
2506 >       include 'COMMON.FFIELD'
2507 >       double precision auxvec(2),auxmat(2,2)
2508 > C
2509 > C Compute the virtual-bond-torsional-angle dependent quantities needed
2510 > C to calculate the el-loc multibody terms of various order.
2511 > C
2512 >       do i=3,nres+1
2513 >         if (i .lt. nres+1) then
2514 >           sin1=dsin(phi(i))
2515 >           cos1=dcos(phi(i))
2516 >           sintab(i-2)=sin1
2517 >           costab(i-2)=cos1
2518 >           obrot(1,i-2)=cos1
2519 >           obrot(2,i-2)=sin1
2520 >           sin2=dsin(2*phi(i))
2521 >           cos2=dcos(2*phi(i))
2522 >           sintab2(i-2)=sin2
2523 >           costab2(i-2)=cos2
2524 >           obrot2(1,i-2)=cos2
2525 >           obrot2(2,i-2)=sin2
2526 >           Ug(1,1,i-2)=-cos1
2527 >           Ug(1,2,i-2)=-sin1
2528 >           Ug(2,1,i-2)=-sin1
2529 >           Ug(2,2,i-2)= cos1
2530 >           Ug2(1,1,i-2)=-cos2
2531 >           Ug2(1,2,i-2)=-sin2
2532 >           Ug2(2,1,i-2)=-sin2
2533 >           Ug2(2,2,i-2)= cos2
2534 >         else
2535 >           costab(i-2)=1.0d0
2536 >           sintab(i-2)=0.0d0
2537 >           obrot(1,i-2)=1.0d0
2538 >           obrot(2,i-2)=0.0d0
2539 >           obrot2(1,i-2)=0.0d0
2540 >           obrot2(2,i-2)=0.0d0
2541 >           Ug(1,1,i-2)=1.0d0
2542 >           Ug(1,2,i-2)=0.0d0
2543 >           Ug(2,1,i-2)=0.0d0
2544 >           Ug(2,2,i-2)=1.0d0
2545 >           Ug2(1,1,i-2)=0.0d0
2546 >           Ug2(1,2,i-2)=0.0d0
2547 >           Ug2(2,1,i-2)=0.0d0
2548 >           Ug2(2,2,i-2)=0.0d0
2549 >         endif
2550 >         if (i .gt. 3 .and. i .lt. nres+1) then
2551 >           obrot_der(1,i-2)=-sin1
2552 >           obrot_der(2,i-2)= cos1
2553 >           Ugder(1,1,i-2)= sin1
2554 >           Ugder(1,2,i-2)=-cos1
2555 >           Ugder(2,1,i-2)=-cos1
2556 >           Ugder(2,2,i-2)=-sin1
2557 >           dwacos2=cos2+cos2
2558 >           dwasin2=sin2+sin2
2559 >           obrot2_der(1,i-2)=-dwasin2
2560 >           obrot2_der(2,i-2)= dwacos2
2561 >           Ug2der(1,1,i-2)= dwasin2
2562 >           Ug2der(1,2,i-2)=-dwacos2
2563 >           Ug2der(2,1,i-2)=-dwacos2
2564 >           Ug2der(2,2,i-2)=-dwasin2
2565 >         else
2566 >           obrot_der(1,i-2)=0.0d0
2567 >           obrot_der(2,i-2)=0.0d0
2568 >           Ugder(1,1,i-2)=0.0d0
2569 >           Ugder(1,2,i-2)=0.0d0
2570 >           Ugder(2,1,i-2)=0.0d0
2571 >           Ugder(2,2,i-2)=0.0d0
2572 >           obrot2_der(1,i-2)=0.0d0
2573 >           obrot2_der(2,i-2)=0.0d0
2574 >           Ug2der(1,1,i-2)=0.0d0
2575 >           Ug2der(1,2,i-2)=0.0d0
2576 >           Ug2der(2,1,i-2)=0.0d0
2577 >           Ug2der(2,2,i-2)=0.0d0
2578 >         endif
2579 > c        if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2580 >         if (i.gt. nnt+2 .and. i.lt.nct+2) then
2581 >           iti = itortyp(itype(i-2))
2582 >         else
2583 >           iti=ntortyp+1
2584 >         endif
2585 > c        if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2586 >         if (i.gt. nnt+1 .and. i.lt.nct+1) then
2587 >           iti1 = itortyp(itype(i-1))
2588 >         else
2589 >           iti1=ntortyp+1
2590 >         endif
2591 > cd        write (iout,*) '*******i',i,' iti1',iti
2592 > cd        write (iout,*) 'b1',b1(:,iti)
2593 > cd        write (iout,*) 'b2',b2(:,iti)
2594 > cd        write (iout,*) 'Ug',Ug(:,:,i-2)
2595 > c        if (i .gt. iatel_s+2) then
2596 >         if (i .gt. nnt+2) then
2597 >           call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2598 >           call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2599 >           call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2600 >           call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2601 >           call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2602 >           call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2603 >           call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2604 >         else
2605 >           do k=1,2
2606 >             Ub2(k,i-2)=0.0d0
2607 >             Ctobr(k,i-2)=0.0d0
2608 >             Dtobr2(k,i-2)=0.0d0
2609 >             do l=1,2
2610 >               EUg(l,k,i-2)=0.0d0
2611 >               CUg(l,k,i-2)=0.0d0
2612 >               DUg(l,k,i-2)=0.0d0
2613 >               DtUg2(l,k,i-2)=0.0d0
2614 >             enddo
2615 >           enddo
2616 >         endif
2617 >         call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2618 >         call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2619 >         call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2620 >         call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2621 >         call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2622 >         call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2623 >         call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2624 >         do k=1,2
2625 >           muder(k,i-2)=Ub2der(k,i-2)
2626 >         enddo
2627 > c        if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2628 >         if (i.gt. nnt+1 .and. i.lt.nct+1) then
2629 >           iti1 = itortyp(itype(i-1))
2630 >         else
2631 >           iti1=ntortyp+1
2632 >         endif
2633 >         do k=1,2
2634 >           mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2635 >         enddo
2636 > C Vectors and matrices dependent on a single virtual-bond dihedral.
2637 >         call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2638 >         call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2639 >         call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2640 >         call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2641 >         call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2642 >         call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2643 >         call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2644 >         call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2645 >         call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2646 > cd        write (iout,*) 'mu ',mu(:,i-2)
2647 > cd        write (iout,*) 'mu1',mu1(:,i-2)
2648 > cd        write (iout,*) 'mu2',mu2(:,i-2)
2649 >       enddo
2650 > C Matrices dependent on two consecutive virtual-bond dihedrals.
2651 > C The order of matrices is from left to right.
2652 >       do i=2,nres-1
2653 >         call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2654 >         call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2655 >         call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2656 >         call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2657 >         call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2658 >         call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2659 >         call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2660 >         call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2661 >       enddo
2662 > cd      do i=1,nres
2663 > cd        iti = itortyp(itype(i))
2664 > cd        write (iout,*) i
2665 > cd        do j=1,2
2666 > cd        write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2667 > cd     &  (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2668 > cd        enddo
2669 > cd      enddo
2670 >       return
2671 >       end
2672 > C--------------------------------------------------------------------------
2673 >       subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2674 1420,1422c2159
2675 <       common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2676 <      &    dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2677 <      &    num_conti,j1,j2
2678 ---
2679 >       common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2680 1434,1485c2171,2284
2681 <           ind=ind+1
2682 <           iteli=itel(i)
2683 <           itelj=itel(j)
2684 <           if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2685 <           aaa=app(iteli,itelj)
2686 <           bbb=bpp(iteli,itelj)
2687 <           ael6i=ael6(iteli,itelj)
2688 <           ael3i=ael3(iteli,itelj)
2689 < C Diagnostics only!!!
2690 < c         aaa=0.0D0
2691 < c         bbb=0.0D0
2692 < c         ael6i=0.0D0
2693 < c         ael3i=0.0D0
2694 < C End diagnostics
2695 <           dxj=dc(1,j)
2696 <           dyj=dc(2,j)
2697 <           dzj=dc(3,j)
2698 <           dx_normj=dc_norm(1,j)
2699 <           dy_normj=dc_norm(2,j)
2700 <           dz_normj=dc_norm(3,j)
2701 <           xj=c(1,j)+0.5D0*dxj-xmedi
2702 <           yj=c(2,j)+0.5D0*dyj-ymedi
2703 <           zj=c(3,j)+0.5D0*dzj-zmedi
2704 <           rij=xj*xj+yj*yj+zj*zj
2705 <           rrmij=1.0D0/rij
2706 <           rij=dsqrt(rij)
2707 <           rmij=1.0D0/rij
2708 < c For extracting the short-range part of Evdwpp
2709 <           sss=sscale(rij/rpp(iteli,itelj))
2710 < c
2711 <           r3ij=rrmij*rmij
2712 <           r6ij=r3ij*r3ij
2713 <           cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2714 <           cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2715 <           cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2716 <           fac=cosa-3.0D0*cosb*cosg
2717 <           ev1=aaa*r6ij*r6ij
2718 < c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2719 <           if (j.eq.i+2) ev1=scal_el*ev1
2720 <           ev2=bbb*r6ij
2721 <           fac3=ael6i*r6ij
2722 <           fac4=ael3i*r3ij
2723 <           evdwij=ev1+ev2
2724 <           el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2725 <           el2=fac4*fac
2726 <           eesij=el1+el2
2727 < C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2728 <           ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2729 <           ees=ees+eesij
2730 <           evdw1=evdw1+evdwij*(1.0d0-sss)
2731 < cd          write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2732 < cd     &      iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2733 ---
2734 > cd      write(iout,*) 'In EELEC'
2735 > cd      do i=1,nloctyp
2736 > cd        write(iout,*) 'Type',i
2737 > cd        write(iout,*) 'B1',B1(:,i)
2738 > cd        write(iout,*) 'B2',B2(:,i)
2739 > cd        write(iout,*) 'CC',CC(:,:,i)
2740 > cd        write(iout,*) 'DD',DD(:,:,i)
2741 > cd        write(iout,*) 'EE',EE(:,:,i)
2742 > cd      enddo
2743 > cd      call check_vecgrad
2744 > cd      stop
2745 >       if (icheckgrad.eq.1) then
2746 >         do i=1,nres-1
2747 >           fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2748 >           do k=1,3
2749 >             dc_norm(k,i)=dc(k,i)*fac
2750 >           enddo
2751 > c          write (iout,*) 'i',i,' fac',fac
2752 >         enddo
2753 >       endif
2754 >       if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2755 >      &    .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2756 >      &    wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2757 > c        call vec_and_deriv
2758 >         call set_matrices
2759 >       endif
2760 > cd      do i=1,nres-1
2761 > cd        write (iout,*) 'i=',i
2762 > cd        do k=1,3
2763 > cd        write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2764 > cd        enddo
2765 > cd        do k=1,3
2766 > cd          write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2767 > cd     &     uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2768 > cd        enddo
2769 > cd      enddo
2770 >       num_conti_hb=0
2771 >       ees=0.0D0
2772 >       evdw1=0.0D0
2773 >       eel_loc=0.0d0
2774 >       eello_turn3=0.0d0
2775 >       eello_turn4=0.0d0
2776 >       ind=0
2777 >       do i=1,nres
2778 >         num_cont_hb(i)=0
2779 >       enddo
2780 > cd      print '(a)','Enter EELEC'
2781 > cd      write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2782 >       do i=1,nres
2783 >         gel_loc_loc(i)=0.0d0
2784 >         gcorr_loc(i)=0.0d0
2785 >       enddo
2786 >       do i=iatel_s,iatel_e
2787 >         dxi=dc(1,i)
2788 >         dyi=dc(2,i)
2789 >         dzi=dc(3,i)
2790 >         dx_normi=dc_norm(1,i)
2791 >         dy_normi=dc_norm(2,i)
2792 >         dz_normi=dc_norm(3,i)
2793 >         xmedi=c(1,i)+0.5d0*dxi
2794 >         ymedi=c(2,i)+0.5d0*dyi
2795 >         zmedi=c(3,i)+0.5d0*dzi
2796 >         num_conti=0
2797 > c        write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2798 >         do j=ielstart(i),ielend(i)
2799 >           ind=ind+1
2800 >           iteli=itel(i)
2801 >           itelj=itel(j)
2802 >           if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2803 >           aaa=app(iteli,itelj)
2804 >           bbb=bpp(iteli,itelj)
2805 >           ael6i=ael6(iteli,itelj)
2806 >           ael3i=ael3(iteli,itelj)
2807 > C Diagnostics only!!!
2808 > c         aaa=0.0D0
2809 > c         bbb=0.0D0
2810 > c         ael6i=0.0D0
2811 > c         ael3i=0.0D0
2812 > C End diagnostics
2813 >           dxj=dc(1,j)
2814 >           dyj=dc(2,j)
2815 >           dzj=dc(3,j)
2816 >           dx_normj=dc_norm(1,j)
2817 >           dy_normj=dc_norm(2,j)
2818 >           dz_normj=dc_norm(3,j)
2819 >           xj=c(1,j)+0.5D0*dxj-xmedi
2820 >           yj=c(2,j)+0.5D0*dyj-ymedi
2821 >           zj=c(3,j)+0.5D0*dzj-zmedi
2822 >           rij=xj*xj+yj*yj+zj*zj
2823 >           rrmij=1.0D0/rij
2824 >           rij=dsqrt(rij)
2825 >           rmij=1.0D0/rij
2826 >           r3ij=rrmij*rmij
2827 >           r6ij=r3ij*r3ij
2828 >           cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2829 >           cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2830 >           cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2831 >           fac=cosa-3.0D0*cosb*cosg
2832 >           ev1=aaa*r6ij*r6ij
2833 > c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2834 >           if (j.eq.i+2) ev1=scal_el*ev1
2835 >           ev2=bbb*r6ij
2836 >           fac3=ael6i*r6ij
2837 >           fac4=ael3i*r3ij
2838 >           evdwij=ev1+ev2
2839 >           el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2840 >           el2=fac4*fac
2841 >           eesij=el1+el2
2842 > C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2843 >           ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2844 >           ees=ees+eesij
2845 >           evdw1=evdw1+evdwij
2846 > cd          write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2847 > cd     &      iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2848 1498c2297
2849 <           facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss)
2850 ---
2851 >           facvdw=-6*rrmij*(ev1+evdwij)
2852 1540c2339
2853 <           facvdw=(ev1+evdwij)*(1.0d0-sss)
2854 ---
2855 >           facvdw=ev1+evdwij
2856 1876a2676,2683
2857 >           if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
2858 > C Contributions from turns
2859 >             a_temp(1,1)=a22
2860 >             a_temp(1,2)=a23
2861 >             a_temp(2,1)=a32
2862 >             a_temp(2,2)=a33
2863 >             call eturn34(i,j,eello_turn3,eello_turn4)
2864 >           endif
2865 2073a2881,2889
2866 >         enddo ! j
2867 >         num_cont_hb(i)=num_conti
2868 >       enddo   ! i
2869 > cd      do i=1,nres
2870 > cd        write (iout,'(i3,3f10.5,5x,3f10.5)')
2871 > cd     &     i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2872 > cd      enddo
2873 > c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2874 > ccc      eel_loc=eel_loc+eello_turn3
2875 2076,2080c2892,2894
2876 < C-----------------------------------------------------------------------
2877 <       subroutine evdwpp_long(evdw1)
2878 < C
2879 < C Compute Evdwpp
2880 < C
2881 ---
2882 > C-----------------------------------------------------------------------------
2883 >       subroutine eturn34(i,j,eello_turn3,eello_turn4)
2884 > C Third- and fourth-order contributions from turns
2885 2083d2896
2886 <       include 'COMMON.CONTROL'
2887 2094a2908
2888 >       include 'COMMON.CONTROL'
2889 2096,2148c2910,2917
2890 < c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2891 < #ifdef MOMENT
2892 <       double precision scal_el /1.0d0/
2893 < #else
2894 <       double precision scal_el /0.5d0/
2895 < #endif
2896 <       evdw1=0.0D0
2897 <       do i=iatel_s,iatel_e
2898 <         dxi=dc(1,i)
2899 <         dyi=dc(2,i)
2900 <         dzi=dc(3,i)
2901 <         dx_normi=dc_norm(1,i)
2902 <         dy_normi=dc_norm(2,i)
2903 <         dz_normi=dc_norm(3,i)
2904 <         xmedi=c(1,i)+0.5d0*dxi
2905 <         ymedi=c(2,i)+0.5d0*dyi
2906 <         zmedi=c(3,i)+0.5d0*dzi
2907 <         num_conti=0
2908 < c        write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2909 <         do j=ielstart(i),ielend(i)
2910 <           ind=ind+1
2911 <           iteli=itel(i)
2912 <           itelj=itel(j)
2913 <           if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2914 <           aaa=app(iteli,itelj)
2915 <           bbb=bpp(iteli,itelj)
2916 <           dxj=dc(1,j)
2917 <           dyj=dc(2,j)
2918 <           dzj=dc(3,j)
2919 <           dx_normj=dc_norm(1,j)
2920 <           dy_normj=dc_norm(2,j)
2921 <           dz_normj=dc_norm(3,j)
2922 <           xj=c(1,j)+0.5D0*dxj-xmedi
2923 <           yj=c(2,j)+0.5D0*dyj-ymedi
2924 <           zj=c(3,j)+0.5D0*dzj-zmedi
2925 <           rij=xj*xj+yj*yj+zj*zj
2926 <           rrmij=1.0D0/rij
2927 <           rij=dsqrt(rij)
2928 <           sss=sscale(rij/rpp(iteli,itelj))
2929 <           if (sss.lt.1.0d0) then
2930 <             rmij=1.0D0/rij
2931 <             r3ij=rrmij*rmij
2932 <             r6ij=r3ij*r3ij
2933 <             ev1=aaa*r6ij*r6ij
2934 < c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2935 <             if (j.eq.i+2) ev1=scal_el*ev1
2936 <             ev2=bbb*r6ij
2937 <             evdwij=ev1+ev2
2938 <             if (energy_dec) then
2939 <               write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
2940 <               write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2941 <             endif
2942 <             evdw1=evdw1+evdwij*(1.0d0-sss)
2943 ---
2944 >       double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
2945 >      &  e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
2946 >      &  e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
2947 >       double precision agg(3,4),aggi(3,4),aggi1(3,4),
2948 >      &    aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
2949 >       common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,j1,j2
2950 >       if (j.eq.i+2) then
2951 > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2952 2150c2919,2980
2953 < C Calculate contributions to the Cartesian gradient.
2954 ---
2955 > C               Third-order contributions
2956 > C
2957 > C                 (i+2)o----(i+3)
2958 > C                      | |
2959 > C                      | |
2960 > C                 (i+1)o----i
2961 > C
2962 > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2963 > cd        call checkint_turn3(i,a_temp,eello_turn3_num)
2964 >         call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
2965 >         call transpose2(auxmat(1,1),auxmat1(1,1))
2966 >         call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2967 >         eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
2968 >         if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
2969 >      &          'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
2970 > cd        write (2,*) 'i,',i,' j',j,'eello_turn3',
2971 > cd     &    0.5d0*(pizda(1,1)+pizda(2,2)),
2972 > cd     &    ' eello_turn3_num',4*eello_turn3_num
2973 > C Derivatives in gamma(i)
2974 >         call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
2975 >         call transpose2(auxmat2(1,1),auxmat3(1,1))
2976 >         call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
2977 >         gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
2978 > C Derivatives in gamma(i+1)
2979 >         call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
2980 >         call transpose2(auxmat2(1,1),auxmat3(1,1))
2981 >         call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
2982 >         gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
2983 >      &    +0.5d0*(pizda(1,1)+pizda(2,2))
2984 > C Cartesian derivatives
2985 >         do l=1,3
2986 >           a_temp(1,1)=aggi(l,1)
2987 >           a_temp(1,2)=aggi(l,2)
2988 >           a_temp(2,1)=aggi(l,3)
2989 >           a_temp(2,2)=aggi(l,4)
2990 >           call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2991 >           gcorr3_turn(l,i)=gcorr3_turn(l,i)
2992 >      &      +0.5d0*(pizda(1,1)+pizda(2,2))
2993 >           a_temp(1,1)=aggi1(l,1)
2994 >           a_temp(1,2)=aggi1(l,2)
2995 >           a_temp(2,1)=aggi1(l,3)
2996 >           a_temp(2,2)=aggi1(l,4)
2997 >           call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
2998 >           gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
2999 >      &      +0.5d0*(pizda(1,1)+pizda(2,2))
3000 >           a_temp(1,1)=aggj(l,1)
3001 >           a_temp(1,2)=aggj(l,2)
3002 >           a_temp(2,1)=aggj(l,3)
3003 >           a_temp(2,2)=aggj(l,4)
3004 >           call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3005 >           gcorr3_turn(l,j)=gcorr3_turn(l,j)
3006 >      &      +0.5d0*(pizda(1,1)+pizda(2,2))
3007 >           a_temp(1,1)=aggj1(l,1)
3008 >           a_temp(1,2)=aggj1(l,2)
3009 >           a_temp(2,1)=aggj1(l,3)
3010 >           a_temp(2,2)=aggj1(l,4)
3011 >           call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3012 >           gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3013 >      &      +0.5d0*(pizda(1,1)+pizda(2,2))
3014 >         enddo
3015 >       else if (j.eq.i+3) then
3016 > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3017 2152,2172c2982,3119
3018 <             facvdw=-6*rrmij*(ev1+evdwij)*(1.0d0-sss)
3019 <             ggg(1)=facvdw*xj
3020 <             ggg(2)=facvdw*yj
3021 <             ggg(3)=facvdw*zj
3022 <
3023 <             do k=1,3
3024 <               ghalf=0.5D0*ggg(k)
3025 <               gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3026 <               gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3027 <             enddo
3028 < *
3029 < * Loop over residues i+1 thru j-1.
3030 < *
3031 <             do k=i+1,j-1
3032 <               do l=1,3
3033 <                 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3034 <               enddo
3035 <             enddo
3036 <           endif
3037 <         enddo ! j
3038 <       enddo   ! i
3039 ---
3040 > C               Fourth-order contributions
3041 > C
3042 > C                 (i+3)o----(i+4)
3043 > C                     /  |
3044 > C               (i+2)o   |
3045 > C                     \  |
3046 > C                 (i+1)o----i
3047 > C
3048 > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3049 > cd        call checkint_turn4(i,a_temp,eello_turn4_num)
3050 >         iti1=itortyp(itype(i+1))
3051 >         iti2=itortyp(itype(i+2))
3052 >         iti3=itortyp(itype(i+3))
3053 >         call transpose2(EUg(1,1,i+1),e1t(1,1))
3054 >         call transpose2(Eug(1,1,i+2),e2t(1,1))
3055 >         call transpose2(Eug(1,1,i+3),e3t(1,1))
3056 >         call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3057 >         call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3058 >         s1=scalar2(b1(1,iti2),auxvec(1))
3059 >         call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3060 >         call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3061 >         s2=scalar2(b1(1,iti1),auxvec(1))
3062 >         call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3063 >         call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3064 >         s3=0.5d0*(pizda(1,1)+pizda(2,2))
3065 >         eello_turn4=eello_turn4-(s1+s2+s3)
3066 >         if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3067 >      &      'eturn4',i,j,-(s1+s2+s3)
3068 > cd        write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3069 > cd     &    ' eello_turn4_num',8*eello_turn4_num
3070 > C Derivatives in gamma(i)
3071 >         call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3072 >         call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3073 >         call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3074 >         s1=scalar2(b1(1,iti2),auxvec(1))
3075 >         call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3076 >         s3=0.5d0*(pizda(1,1)+pizda(2,2))
3077 >         gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3078 > C Derivatives in gamma(i+1)
3079 >         call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3080 >         call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3081 >         s2=scalar2(b1(1,iti1),auxvec(1))
3082 >         call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3083 >         call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3084 >         s3=0.5d0*(pizda(1,1)+pizda(2,2))
3085 >         gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3086 > C Derivatives in gamma(i+2)
3087 >         call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3088 >         call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3089 >         s1=scalar2(b1(1,iti2),auxvec(1))
3090 >         call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3091 >         call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3092 >         s2=scalar2(b1(1,iti1),auxvec(1))
3093 >         call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3094 >         call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3095 >         s3=0.5d0*(pizda(1,1)+pizda(2,2))
3096 >         gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3097 > C Cartesian derivatives
3098 > C Derivatives of this turn contributions in DC(i+2)
3099 >         if (j.lt.nres-1) then
3100 >           do l=1,3
3101 >             a_temp(1,1)=agg(l,1)
3102 >             a_temp(1,2)=agg(l,2)
3103 >             a_temp(2,1)=agg(l,3)
3104 >             a_temp(2,2)=agg(l,4)
3105 >             call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3106 >             call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3107 >             s1=scalar2(b1(1,iti2),auxvec(1))
3108 >             call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3109 >             call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3110 >             s2=scalar2(b1(1,iti1),auxvec(1))
3111 >             call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3112 >             call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3113 >             s3=0.5d0*(pizda(1,1)+pizda(2,2))
3114 >             ggg(l)=-(s1+s2+s3)
3115 >             gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3116 >           enddo
3117 >         endif
3118 > C Remaining derivatives of this turn contribution
3119 >         do l=1,3
3120 >           a_temp(1,1)=aggi(l,1)
3121 >           a_temp(1,2)=aggi(l,2)
3122 >           a_temp(2,1)=aggi(l,3)
3123 >           a_temp(2,2)=aggi(l,4)
3124 >           call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3125 >           call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3126 >           s1=scalar2(b1(1,iti2),auxvec(1))
3127 >           call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3128 >           call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3129 >           s2=scalar2(b1(1,iti1),auxvec(1))
3130 >           call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3131 >           call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3132 >           s3=0.5d0*(pizda(1,1)+pizda(2,2))
3133 >           gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3134 >           a_temp(1,1)=aggi1(l,1)
3135 >           a_temp(1,2)=aggi1(l,2)
3136 >           a_temp(2,1)=aggi1(l,3)
3137 >           a_temp(2,2)=aggi1(l,4)
3138 >           call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3139 >           call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3140 >           s1=scalar2(b1(1,iti2),auxvec(1))
3141 >           call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3142 >           call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3143 >           s2=scalar2(b1(1,iti1),auxvec(1))
3144 >           call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3145 >           call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3146 >           s3=0.5d0*(pizda(1,1)+pizda(2,2))
3147 >           gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3148 >           a_temp(1,1)=aggj(l,1)
3149 >           a_temp(1,2)=aggj(l,2)
3150 >           a_temp(2,1)=aggj(l,3)
3151 >           a_temp(2,2)=aggj(l,4)
3152 >           call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3153 >           call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3154 >           s1=scalar2(b1(1,iti2),auxvec(1))
3155 >           call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3156 >           call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3157 >           s2=scalar2(b1(1,iti1),auxvec(1))
3158 >           call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3159 >           call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3160 >           s3=0.5d0*(pizda(1,1)+pizda(2,2))
3161 >           gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3162 >           a_temp(1,1)=aggj1(l,1)
3163 >           a_temp(1,2)=aggj1(l,2)
3164 >           a_temp(2,1)=aggj1(l,3)
3165 >           a_temp(2,2)=aggj1(l,4)
3166 >           call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3167 >           call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3168 >           s1=scalar2(b1(1,iti2),auxvec(1))
3169 >           call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3170 >           call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3171 >           s2=scalar2(b1(1,iti1),auxvec(1))
3172 >           call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3173 >           call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3174 >           s3=0.5d0*(pizda(1,1)+pizda(2,2))
3175 >           gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3176 >         enddo
3177 >       endif
3178 2175,2176c3122,3160
3179 < C-----------------------------------------------------------------------
3180 <       subroutine evdwpp_short(evdw1)
3181 ---
3182 > C-----------------------------------------------------------------------------
3183 >       subroutine vecpr(u,v,w)
3184 >       implicit real*8(a-h,o-z)
3185 >       dimension u(3),v(3),w(3)
3186 >       w(1)=u(2)*v(3)-u(3)*v(2)
3187 >       w(2)=-u(1)*v(3)+u(3)*v(1)
3188 >       w(3)=u(1)*v(2)-u(2)*v(1)
3189 >       return
3190 >       end
3191 > C-----------------------------------------------------------------------------
3192 >       subroutine unormderiv(u,ugrad,unorm,ungrad)
3193 > C This subroutine computes the derivatives of a normalized vector u, given
3194 > C the derivatives computed without normalization conditions, ugrad. Returns
3195 > C ungrad.
3196 >       implicit none
3197 >       double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3198 >       double precision vec(3)
3199 >       double precision scalar
3200 >       integer i,j
3201 > c      write (2,*) 'ugrad',ugrad
3202 > c      write (2,*) 'u',u
3203 >       do i=1,3
3204 >         vec(i)=scalar(ugrad(1,i),u(1))
3205 >       enddo
3206 > c      write (2,*) 'vec',vec
3207 >       do i=1,3
3208 >         do j=1,3
3209 >           ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3210 >         enddo
3211 >       enddo
3212 > c      write (2,*) 'ungrad',ungrad
3213 >       return
3214 >       end
3215 > C-----------------------------------------------------------------------------
3216 >       subroutine escp_soft_sphere(evdw2,evdw2_14)
3217 > C
3218 > C This subroutine calculates the excluded-volume interaction energy between
3219 > C peptide-group centers and side chains and its gradient in virtual-bond and
3220 > C side-chain vectors.
3221 2178,2179d3161
3222 < C Compute Evdwpp
3223 < C
3224 2182,2183d3163
3225 <       include 'COMMON.CONTROL'
3226 <       include 'COMMON.IOUNITS'
3227 2190,2192d3169
3228 <       include 'COMMON.CONTACTS'
3229 <       include 'COMMON.TORSION'
3230 <       include 'COMMON.VECTORS'
3231 2194,2291c3171,3172
3232 <       dimension ggg(3)
3233 < c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3234 < #ifdef MOMENT
3235 <       double precision scal_el /1.0d0/
3236 < #else
3237 <       double precision scal_el /0.5d0/
3238 < #endif
3239 <       evdw1=0.0D0
3240 <       do i=iatel_s,iatel_e
3241 <         dxi=dc(1,i)
3242 <         dyi=dc(2,i)
3243 <         dzi=dc(3,i)
3244 <         dx_normi=dc_norm(1,i)
3245 <         dy_normi=dc_norm(2,i)
3246 <         dz_normi=dc_norm(3,i)
3247 <         xmedi=c(1,i)+0.5d0*dxi
3248 <         ymedi=c(2,i)+0.5d0*dyi
3249 <         zmedi=c(3,i)+0.5d0*dzi
3250 <         num_conti=0
3251 < c        write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3252 <         do j=ielstart(i),ielend(i)
3253 <           ind=ind+1
3254 <           iteli=itel(i)
3255 <           itelj=itel(j)
3256 <           if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3257 <           aaa=app(iteli,itelj)
3258 <           bbb=bpp(iteli,itelj)
3259 <           dxj=dc(1,j)
3260 <           dyj=dc(2,j)
3261 <           dzj=dc(3,j)
3262 <           dx_normj=dc_norm(1,j)
3263 <           dy_normj=dc_norm(2,j)
3264 <           dz_normj=dc_norm(3,j)
3265 <           xj=c(1,j)+0.5D0*dxj-xmedi
3266 <           yj=c(2,j)+0.5D0*dyj-ymedi
3267 <           zj=c(3,j)+0.5D0*dzj-zmedi
3268 <           rij=xj*xj+yj*yj+zj*zj
3269 <           rrmij=1.0D0/rij
3270 <           rij=dsqrt(rij)
3271 <           sss=sscale(rij/rpp(iteli,itelj))
3272 <           if (sss.gt.0.0d0) then
3273 <             rmij=1.0D0/rij
3274 <             r3ij=rrmij*rmij
3275 <             r6ij=r3ij*r3ij
3276 <             ev1=aaa*r6ij*r6ij
3277 < c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3278 <             if (j.eq.i+2) ev1=scal_el*ev1
3279 <             ev2=bbb*r6ij
3280 <             evdwij=ev1+ev2
3281 <             if (energy_dec) then
3282 <               write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3283 <               write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3284 <             endif
3285 <             evdw1=evdw1+evdwij*sss
3286 < C
3287 < C Calculate contributions to the Cartesian gradient.
3288 < C
3289 <             facvdw=-6*rrmij*(ev1+evdwij)*sss
3290 <             ggg(1)=facvdw*xj
3291 <             ggg(2)=facvdw*yj
3292 <             ggg(3)=facvdw*zj
3293 <
3294 <             do k=1,3
3295 <               ghalf=0.5D0*ggg(k)
3296 <               gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3297 <               gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3298 <             enddo
3299 < *
3300 < * Loop over residues i+1 thru j-1.
3301 < *
3302 <             do k=i+1,j-1
3303 <               do l=1,3
3304 <                 gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3305 <               enddo
3306 <             enddo
3307 <           endif
3308 <         enddo ! j
3309 <       enddo   ! i
3310 <       return
3311 <       end
3312 < C-----------------------------------------------------------------------------
3313 <       subroutine escp_long(evdw2,evdw2_14)
3314 < C
3315 < C This subroutine calculates the excluded-volume interaction energy between
3316 < C peptide-group centers and side chains and its gradient in virtual-bond and
3317 < C side-chain vectors.
3318 < C
3319 <       implicit real*8 (a-h,o-z)
3320 <       include 'DIMENSIONS'
3321 <       include 'COMMON.GEO'
3322 <       include 'COMMON.VAR'
3323 <       include 'COMMON.LOCAL'
3324 <       include 'COMMON.CHAIN'
3325 <       include 'COMMON.DERIV'
3326 <       include 'COMMON.INTERACT'
3327 <       include 'COMMON.FFIELD'
3328 <       include 'COMMON.IOUNITS'
3329 <       include 'COMMON.CONTROL'
3330 ---
3331 >       include 'COMMON.IOUNITS'
3332 >       include 'COMMON.CONTROL'
3333 2294a3176
3334 >       r0_scp=4.5d0
3335 2315,2332c3197,3207
3336 <           rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3337 <
3338 <           sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli)))
3339 <
3340 <           if (sss.lt.1.0d0) then
3341 <
3342 <             fac=rrij**expon2
3343 <             e1=fac*fac*aad(itypj,iteli)
3344 <             e2=fac*bad(itypj,iteli)
3345 <             if (iabs(j-i) .le. 2) then
3346 <               e1=scal14*e1
3347 <               e2=scal14*e2
3348 <               evdw2_14=evdw2_14+(e1+e2)*(1.0d0-sss)
3349 <             endif
3350 <             evdwij=e1+e2
3351 <             evdw2=evdw2+evdwij*(1.0d0-sss)
3352 <             if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3353 <      &          'evdw2',i,j,evdwij
3354 ---
3355 >           rij=xj*xj+yj*yj+zj*zj
3356 >           r0ij=r0_scp
3357 >           r0ijsq=r0ij*r0ij
3358 >           if (rij.lt.r0ijsq) then
3359 >             evdwij=0.25d0*(rij-r0ijsq)**2
3360 >             fac=rij-r0ijsq
3361 >           else
3362 >             evdwij=0.0d0
3363 >             fac=0.0d0
3364 >           endif
3365 >           evdw2=evdw2+evdwij
3366 2336,2341c3211,3215
3367 <             fac=-(evdwij+e1)*rrij*(1.0d0-sss)
3368 <             ggg(1)=xj*fac
3369 <             ggg(2)=yj*fac
3370 <             ggg(3)=zj*fac
3371 <             if (j.lt.i) then
3372 < cd            write (iout,*) 'j<i'
3373 ---
3374 >           ggg(1)=xj*fac
3375 >           ggg(2)=yj*fac
3376 >           ggg(3)=zj*fac
3377 >           if (j.lt.i) then
3378 > cd          write (iout,*) 'j<i'
3379 2343c3217
3380 < c             do k=1,3
3381 ---
3382 > c           do k=1,3
3383 2345,2353c3219,3221
3384 < c             enddo
3385 <             else
3386 < cd            write (iout,*) 'j>i'
3387 <               do k=1,3
3388 <                 ggg(k)=-ggg(k)
3389 < C Uncomment following line for SC-p interactions
3390 < c               gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3391 <               enddo
3392 <             endif
3393 ---
3394 > c           enddo
3395 >           else
3396 > cd          write (iout,*) 'j>i'
3397 2355c3223,3225
3398 <               gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3399 ---
3400 >               ggg(k)=-ggg(k)
3401 > C Uncomment following line for SC-p interactions
3402 > c             gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3403 2357,2358c3227,3232
3404 <             kstart=min0(i+1,j)
3405 <             kend=max0(i-1,j-1)
3406 ---
3407 >           endif
3408 >           do k=1,3
3409 >             gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3410 >           enddo
3411 >           kstart=min0(i+1,j)
3412 >           kend=max0(i-1,j-1)
3413 2361,2364c3235,3237
3414 <             do k=kstart,kend
3415 <               do l=1,3
3416 <                 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3417 <               enddo
3418 ---
3419 >           do k=kstart,kend
3420 >             do l=1,3
3421 >               gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3422 2366,2368c3239
3423 <
3424 <           endif
3425 <
3426 ---
3427 >           enddo
3428 2373,2387d3243
3429 <       do i=1,nct
3430 <         do j=1,3
3431 <           gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3432 <           gradx_scp(j,i)=expon*gradx_scp(j,i)
3433 <         enddo
3434 <       enddo
3435 < C******************************************************************************
3436 < C
3437 < C                              N O T E !!!
3438 < C
3439 < C To save time the factor EXPON has been extracted from ALL components
3440 < C of GVDWC and GRADX. Remember to multiply them by this factor before further
3441 < C use!
3442 < C
3443 < C******************************************************************************
3444 2391c3247
3445 <       subroutine escp_short(evdw2,evdw2_14)
3446 ---
3447 >       subroutine escp(evdw2,evdw2_14)
3448 2432,2448c3288,3299
3449 <
3450 <           sss=sscale(1.0d0/(dsqrt(rrij)*rscp(itypj,iteli)))
3451 <
3452 <           if (sss.gt.0.0d0) then
3453 <
3454 <             fac=rrij**expon2
3455 <             e1=fac*fac*aad(itypj,iteli)
3456 <             e2=fac*bad(itypj,iteli)
3457 <             if (iabs(j-i) .le. 2) then
3458 <               e1=scal14*e1
3459 <               e2=scal14*e2
3460 <               evdw2_14=evdw2_14+(e1+e2)*sss
3461 <             endif
3462 <             evdwij=e1+e2
3463 <             evdw2=evdw2+evdwij*sss
3464 <             if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3465 <      &          'evdw2',i,j,evdwij
3466 ---
3467 >           fac=rrij**expon2
3468 >           e1=fac*fac*aad(itypj,iteli)
3469 >           e2=fac*bad(itypj,iteli)
3470 >           if (iabs(j-i) .le. 2) then
3471 >             e1=scal14*e1
3472 >             e2=scal14*e2
3473 >             evdw2_14=evdw2_14+e1+e2
3474 >           endif
3475 >           evdwij=e1+e2
3476 >           evdw2=evdw2+evdwij
3477 >           if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3478 >      &        'evdw2',i,j,evdwij
3479 2452,2457c3303,3308
3480 <             fac=-(evdwij+e1)*rrij*sss
3481 <             ggg(1)=xj*fac
3482 <             ggg(2)=yj*fac
3483 <             ggg(3)=zj*fac
3484 <             if (j.lt.i) then
3485 < cd            write (iout,*) 'j<i'
3486 ---
3487 >           fac=-(evdwij+e1)*rrij
3488 >           ggg(1)=xj*fac
3489 >           ggg(2)=yj*fac
3490 >           ggg(3)=zj*fac
3491 >           if (j.lt.i) then
3492 > cd          write (iout,*) 'j<i'
3493 2459c3310
3494 < c             do k=1,3
3495 ---
3496 > c           do k=1,3
3497 2461,2469c3312,3314
3498 < c             enddo
3499 <             else
3500 < cd            write (iout,*) 'j>i'
3501 <               do k=1,3
3502 <                 ggg(k)=-ggg(k)
3503 < C Uncomment following line for SC-p interactions
3504 < c               gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3505 <               enddo
3506 <             endif
3507 ---
3508 > c           enddo
3509 >           else
3510 > cd          write (iout,*) 'j>i'
3511 2471c3316,3318
3512 <               gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3513 ---
3514 >               ggg(k)=-ggg(k)
3515 > C Uncomment following line for SC-p interactions
3516 > c             gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3517 2473,2474c3320,3325
3518 <             kstart=min0(i+1,j)
3519 <             kend=max0(i-1,j-1)
3520 ---
3521 >           endif
3522 >           do k=1,3
3523 >             gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3524 >           enddo
3525 >           kstart=min0(i+1,j)
3526 >           kend=max0(i-1,j-1)
3527 2477,2480c3328,3330
3528 <             do k=kstart,kend
3529 <               do l=1,3
3530 <                 gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3531 <               enddo
3532 ---
3533 >           do k=kstart,kend
3534 >             do l=1,3
3535 >               gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3536 2482,2484c3332
3537 <
3538 <           endif
3539 <
3540 ---
3541 >           enddo
3542 2505a3354,7899
3543 > C--------------------------------------------------------------------------
3544 >       subroutine edis(ehpb)
3545 > C
3546 > C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3547 > C
3548 >       implicit real*8 (a-h,o-z)
3549 >       include 'DIMENSIONS'
3550 >       include 'COMMON.SBRIDGE'
3551 >       include 'COMMON.CHAIN'
3552 >       include 'COMMON.DERIV'
3553 >       include 'COMMON.VAR'
3554 >       include 'COMMON.INTERACT'
3555 >       dimension ggg(3)
3556 >       ehpb=0.0D0
3557 > cd    print *,'edis: nhpb=',nhpb,' fbr=',fbr
3558 > cd    print *,'link_start=',link_start,' link_end=',link_end
3559 >       if (link_end.eq.0) return
3560 >       do i=link_start,link_end
3561 > C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
3562 > C CA-CA distance used in regularization of structure.
3563 >         ii=ihpb(i)
3564 >         jj=jhpb(i)
3565 > C iii and jjj point to the residues for which the distance is assigned.
3566 >         if (ii.gt.nres) then
3567 >           iii=ii-nres
3568 >           jjj=jj-nres
3569 >         else
3570 >           iii=ii
3571 >           jjj=jj
3572 >         endif
3573 > C 24/11/03 AL: SS bridges handled separately because of introducing a specific
3574 > C    distance and angle dependent SS bond potential.
3575 >         if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
3576 >           call ssbond_ene(iii,jjj,eij)
3577 >           ehpb=ehpb+2*eij
3578 >         else
3579 > C Calculate the distance between the two points and its difference from the
3580 > C target distance.
3581 >         dd=dist(ii,jj)
3582 >         rdis=dd-dhpb(i)
3583 > C Get the force constant corresponding to this distance.
3584 >         waga=forcon(i)
3585 > C Calculate the contribution to energy.
3586 >         ehpb=ehpb+waga*rdis*rdis
3587 > C
3588 > C Evaluate gradient.
3589 > C
3590 >         fac=waga*rdis/dd
3591 > cd      print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
3592 > cd   &   ' waga=',waga,' fac=',fac
3593 >         do j=1,3
3594 >           ggg(j)=fac*(c(j,jj)-c(j,ii))
3595 >         enddo
3596 > cd      print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
3597 > C If this is a SC-SC distance, we need to calculate the contributions to the
3598 > C Cartesian gradient in the SC vectors (ghpbx).
3599 >         if (iii.lt.ii) then
3600 >           do j=1,3
3601 >             ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
3602 >             ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
3603 >           enddo
3604 >         endif
3605 >         do j=iii,jjj-1
3606 >           do k=1,3
3607 >             ghpbc(k,j)=ghpbc(k,j)+ggg(k)
3608 >           enddo
3609 >         enddo
3610 >         endif
3611 >       enddo
3612 >       ehpb=0.5D0*ehpb
3613 >       return
3614 >       end
3615 > C--------------------------------------------------------------------------
3616 >       subroutine ssbond_ene(i,j,eij)
3617 > C
3618 > C Calculate the distance and angle dependent SS-bond potential energy
3619 > C using a free-energy function derived based on RHF/6-31G** ab initio
3620 > C calculations of diethyl disulfide.
3621 > C
3622 > C A. Liwo and U. Kozlowska, 11/24/03
3623 > C
3624 >       implicit real*8 (a-h,o-z)
3625 >       include 'DIMENSIONS'
3626 >       include 'COMMON.SBRIDGE'
3627 >       include 'COMMON.CHAIN'
3628 >       include 'COMMON.DERIV'
3629 >       include 'COMMON.LOCAL'
3630 >       include 'COMMON.INTERACT'
3631 >       include 'COMMON.VAR'
3632 >       include 'COMMON.IOUNITS'
3633 >       double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
3634 >       itypi=itype(i)
3635 >       xi=c(1,nres+i)
3636 >       yi=c(2,nres+i)
3637 >       zi=c(3,nres+i)
3638 >       dxi=dc_norm(1,nres+i)
3639 >       dyi=dc_norm(2,nres+i)
3640 >       dzi=dc_norm(3,nres+i)
3641 >       dsci_inv=dsc_inv(itypi)
3642 >       itypj=itype(j)
3643 >       dscj_inv=dsc_inv(itypj)
3644 >       xj=c(1,nres+j)-xi
3645 >       yj=c(2,nres+j)-yi
3646 >       zj=c(3,nres+j)-zi
3647 >       dxj=dc_norm(1,nres+j)
3648 >       dyj=dc_norm(2,nres+j)
3649 >       dzj=dc_norm(3,nres+j)
3650 >       rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3651 >       rij=dsqrt(rrij)
3652 >       erij(1)=xj*rij
3653 >       erij(2)=yj*rij
3654 >       erij(3)=zj*rij
3655 >       om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3656 >       om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3657 >       om12=dxi*dxj+dyi*dyj+dzi*dzj
3658 >       do k=1,3
3659 >         dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3660 >         dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3661 >       enddo
3662 >       rij=1.0d0/rij
3663 >       deltad=rij-d0cm
3664 >       deltat1=1.0d0-om1
3665 >       deltat2=1.0d0+om2
3666 >       deltat12=om2-om1+2.0d0
3667 >       cosphi=om12-om1*om2
3668 >       eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
3669 >      &  +akct*deltad*deltat12
3670 >      &  +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
3671 > c      write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
3672 > c     &  " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
3673 > c     &  " deltat12",deltat12," eij",eij
3674 >       ed=2*akcm*deltad+akct*deltat12
3675 >       pom1=akct*deltad
3676 >       pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
3677 >       eom1=-2*akth*deltat1-pom1-om2*pom2
3678 >       eom2= 2*akth*deltat2+pom1-om1*pom2
3679 >       eom12=pom2
3680 >       do k=1,3
3681 >         gg(k)=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3682 >       enddo
3683 >       do k=1,3
3684 >         ghpbx(k,i)=ghpbx(k,i)-gg(k)
3685 >      &            +(eom12*dc_norm(k,nres+j)+eom1*erij(k))*dsci_inv
3686 >         ghpbx(k,j)=ghpbx(k,j)+gg(k)
3687 >      &            +(eom12*dc_norm(k,nres+i)+eom2*erij(k))*dscj_inv
3688 >       enddo
3689 > C
3690 > C Calculate the components of the gradient in DC and X
3691 > C
3692 >       do k=i,j-1
3693 >         do l=1,3
3694 >           ghpbc(l,k)=ghpbc(l,k)+gg(l)
3695 >         enddo
3696 >       enddo
3697 >       return
3698 >       end
3699 > C--------------------------------------------------------------------------
3700 >       subroutine ebond(estr)
3701 > c
3702 > c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
3703 > c
3704 >       implicit real*8 (a-h,o-z)
3705 >       include 'DIMENSIONS'
3706 >       include 'COMMON.LOCAL'
3707 >       include 'COMMON.GEO'
3708 >       include 'COMMON.INTERACT'
3709 >       include 'COMMON.DERIV'
3710 >       include 'COMMON.VAR'
3711 >       include 'COMMON.CHAIN'
3712 >       include 'COMMON.IOUNITS'
3713 >       include 'COMMON.NAMES'
3714 >       include 'COMMON.FFIELD'
3715 >       include 'COMMON.CONTROL'
3716 >       include 'COMMON.SETUP'
3717 >       double precision u(3),ud(3)
3718 >       estr=0.0d0
3719 >       do i=ibondp_start,ibondp_end
3720 >         diff = vbld(i)-vbldp0
3721 > c        write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
3722 >         estr=estr+diff*diff
3723 >         do j=1,3
3724 >           gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
3725 >         enddo
3726 > c        write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
3727 >       enddo
3728 >       estr=0.5d0*AKP*estr
3729 > c
3730 > c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
3731 > c
3732 >       do i=ibond_start,ibond_end
3733 >         iti=itype(i)
3734 >         if (iti.ne.10) then
3735 >           nbi=nbondterm(iti)
3736 >           if (nbi.eq.1) then
3737 >             diff=vbld(i+nres)-vbldsc0(1,iti)
3738 > c            write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
3739 > c     &      AKSC(1,iti),AKSC(1,iti)*diff*diff
3740 >             estr=estr+0.5d0*AKSC(1,iti)*diff*diff
3741 >             do j=1,3
3742 >               gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
3743 >             enddo
3744 >           else
3745 >             do j=1,nbi
3746 >               diff=vbld(i+nres)-vbldsc0(j,iti)
3747 >               ud(j)=aksc(j,iti)*diff
3748 >               u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
3749 >             enddo
3750 >             uprod=u(1)
3751 >             do j=2,nbi
3752 >               uprod=uprod*u(j)
3753 >             enddo
3754 >             usum=0.0d0
3755 >             usumsqder=0.0d0
3756 >             do j=1,nbi
3757 >               uprod1=1.0d0
3758 >               uprod2=1.0d0
3759 >               do k=1,nbi
3760 >                 if (k.ne.j) then
3761 >                   uprod1=uprod1*u(k)
3762 >                   uprod2=uprod2*u(k)*u(k)
3763 >                 endif
3764 >               enddo
3765 >               usum=usum+uprod1
3766 >               usumsqder=usumsqder+ud(j)*uprod2
3767 >             enddo
3768 >             estr=estr+uprod/usum
3769 >             do j=1,3
3770 >              gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
3771 >             enddo
3772 >           endif
3773 >         endif
3774 >       enddo
3775 >       return
3776 >       end
3777 > #ifdef CRYST_THETA
3778 > C--------------------------------------------------------------------------
3779 >       subroutine ebend(etheta)
3780 > C
3781 > C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3782 > C angles gamma and its derivatives in consecutive thetas and gammas.
3783 > C
3784 >       implicit real*8 (a-h,o-z)
3785 >       include 'DIMENSIONS'
3786 >       include 'COMMON.LOCAL'
3787 >       include 'COMMON.GEO'
3788 >       include 'COMMON.INTERACT'
3789 >       include 'COMMON.DERIV'
3790 >       include 'COMMON.VAR'
3791 >       include 'COMMON.CHAIN'
3792 >       include 'COMMON.IOUNITS'
3793 >       include 'COMMON.NAMES'
3794 >       include 'COMMON.FFIELD'
3795 >       include 'COMMON.CONTROL'
3796 >       common /calcthet/ term1,term2,termm,diffak,ratak,
3797 >      & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3798 >      & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3799 >       double precision y(2),z(2)
3800 >       delta=0.02d0*pi
3801 > c      time11=dexp(-2*time)
3802 > c      time12=1.0d0
3803 >       etheta=0.0D0
3804 > c     write (*,'(a,i2)') 'EBEND ICG=',icg
3805 >       do i=ithet_start,ithet_end
3806 > C Zero the energy function and its derivative at 0 or pi.
3807 >         call splinthet(theta(i),0.5d0*delta,ss,ssd)
3808 >         it=itype(i-1)
3809 >         if (i.gt.3) then
3810 > #ifdef OSF
3811 >         phii=phi(i)
3812 >           if (phii.ne.phii) phii=150.0
3813 > #else
3814 >           phii=phi(i)
3815 > #endif
3816 >           y(1)=dcos(phii)
3817 >           y(2)=dsin(phii)
3818 >         else
3819 >           y(1)=0.0D0
3820 >           y(2)=0.0D0
3821 >         endif
3822 >         if (i.lt.nres) then
3823 > #ifdef OSF
3824 >         phii1=phi(i+1)
3825 >           if (phii1.ne.phii1) phii1=150.0
3826 >           phii1=pinorm(phii1)
3827 >           z(1)=cos(phii1)
3828 > #else
3829 >           phii1=phi(i+1)
3830 >           z(1)=dcos(phii1)
3831 > #endif
3832 >           z(2)=dsin(phii1)
3833 >         else
3834 >           z(1)=0.0D0
3835 >           z(2)=0.0D0
3836 >         endif
3837 > C Calculate the "mean" value of theta from the part of the distribution
3838 > C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
3839 > C In following comments this theta will be referred to as t_c.
3840 >         thet_pred_mean=0.0d0
3841 >         do k=1,2
3842 >           athetk=athet(k,it)
3843 >           bthetk=bthet(k,it)
3844 >           thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
3845 >         enddo
3846 >         dthett=thet_pred_mean*ssd
3847 >         thet_pred_mean=thet_pred_mean*ss+a0thet(it)
3848 > C Derivatives of the "mean" values in gamma1 and gamma2.
3849 >         dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
3850 >         dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
3851 >         if (theta(i).gt.pi-delta) then
3852 >           call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
3853 >      &         E_tc0)
3854 >           call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
3855 >           call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3856 >           call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
3857 >      &        E_theta)
3858 >           call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
3859 >      &        E_tc)
3860 >         else if (theta(i).lt.delta) then
3861 >           call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
3862 >           call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
3863 >           call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
3864 >      &        E_theta)
3865 >           call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
3866 >           call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
3867 >      &        E_tc)
3868 >         else
3869 >           call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
3870 >      &        E_theta,E_tc)
3871 >         endif
3872 >         etheta=etheta+ethetai
3873 >         if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
3874 >      &      'ebend',i,ethetai
3875 >         if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
3876 >         if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
3877 >         gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
3878 >       enddo
3879 > C Ufff.... We've done all this!!!
3880 >       return
3881 >       end
3882 > C---------------------------------------------------------------------------
3883 >       subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
3884 >      &     E_tc)
3885 >       implicit real*8 (a-h,o-z)
3886 >       include 'DIMENSIONS'
3887 >       include 'COMMON.LOCAL'
3888 >       include 'COMMON.IOUNITS'
3889 >       common /calcthet/ term1,term2,termm,diffak,ratak,
3890 >      & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3891 >      & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3892 > C Calculate the contributions to both Gaussian lobes.
3893 > C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
3894 > C The "polynomial part" of the "standard deviation" of this part of
3895 > C the distribution.
3896 >         sig=polthet(3,it)
3897 >         do j=2,0,-1
3898 >           sig=sig*thet_pred_mean+polthet(j,it)
3899 >         enddo
3900 > C Derivative of the "interior part" of the "standard deviation of the"
3901 > C gamma-dependent Gaussian lobe in t_c.
3902 >         sigtc=3*polthet(3,it)
3903 >         do j=2,1,-1
3904 >           sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
3905 >         enddo
3906 >         sigtc=sig*sigtc
3907 > C Set the parameters of both Gaussian lobes of the distribution.
3908 > C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
3909 >         fac=sig*sig+sigc0(it)
3910 >         sigcsq=fac+fac
3911 >         sigc=1.0D0/sigcsq
3912 > C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
3913 >         sigsqtc=-4.0D0*sigcsq*sigtc
3914 > c       print *,i,sig,sigtc,sigsqtc
3915 > C Following variable (sigtc) is d[sigma(t_c)]/dt_c
3916 >         sigtc=-sigtc/(fac*fac)
3917 > C Following variable is sigma(t_c)**(-2)
3918 >         sigcsq=sigcsq*sigcsq
3919 >         sig0i=sig0(it)
3920 >         sig0inv=1.0D0/sig0i**2
3921 >         delthec=thetai-thet_pred_mean
3922 >         delthe0=thetai-theta0i
3923 >         term1=-0.5D0*sigcsq*delthec*delthec
3924 >         term2=-0.5D0*sig0inv*delthe0*delthe0
3925 > C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
3926 > C NaNs in taking the logarithm. We extract the largest exponent which is added
3927 > C to the energy (this being the log of the distribution) at the end of energy
3928 > C term evaluation for this virtual-bond angle.
3929 >         if (term1.gt.term2) then
3930 >           termm=term1
3931 >           term2=dexp(term2-termm)
3932 >           term1=1.0d0
3933 >         else
3934 >           termm=term2
3935 >           term1=dexp(term1-termm)
3936 >           term2=1.0d0
3937 >         endif
3938 > C The ratio between the gamma-independent and gamma-dependent lobes of
3939 > C the distribution is a Gaussian function of thet_pred_mean too.
3940 >         diffak=gthet(2,it)-thet_pred_mean
3941 >         ratak=diffak/gthet(3,it)**2
3942 >         ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
3943 > C Let's differentiate it in thet_pred_mean NOW.
3944 >         aktc=ak*ratak
3945 > C Now put together the distribution terms to make complete distribution.
3946 >         termexp=term1+ak*term2
3947 >         termpre=sigc+ak*sig0i
3948 > C Contribution of the bending energy from this theta is just the -log of
3949 > C the sum of the contributions from the two lobes and the pre-exponential
3950 > C factor. Simple enough, isn't it?
3951 >         ethetai=(-dlog(termexp)-termm+dlog(termpre))
3952 > C NOW the derivatives!!!
3953 > C 6/6/97 Take into account the deformation.
3954 >         E_theta=(delthec*sigcsq*term1
3955 >      &       +ak*delthe0*sig0inv*term2)/termexp
3956 >         E_tc=((sigtc+aktc*sig0i)/termpre
3957 >      &      -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
3958 >      &       aktc*term2)/termexp)
3959 >       return
3960 >       end
3961 > c-----------------------------------------------------------------------------
3962 >       subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
3963 >       implicit real*8 (a-h,o-z)
3964 >       include 'DIMENSIONS'
3965 >       include 'COMMON.LOCAL'
3966 >       include 'COMMON.IOUNITS'
3967 >       common /calcthet/ term1,term2,termm,diffak,ratak,
3968 >      & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
3969 >      & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
3970 >       delthec=thetai-thet_pred_mean
3971 >       delthe0=thetai-theta0i
3972 > C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
3973 >       t3 = thetai-thet_pred_mean
3974 >       t6 = t3**2
3975 >       t9 = term1
3976 >       t12 = t3*sigcsq
3977 >       t14 = t12+t6*sigsqtc
3978 >       t16 = 1.0d0
3979 >       t21 = thetai-theta0i
3980 >       t23 = t21**2
3981 >       t26 = term2
3982 >       t27 = t21*t26
3983 >       t32 = termexp
3984 >       t40 = t32**2
3985 >       E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
3986 >      & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
3987 >      & *(-t12*t9-ak*sig0inv*t27)
3988 >       return
3989 >       end
3990 > #else
3991 > C--------------------------------------------------------------------------
3992 >       subroutine ebend(etheta)
3993 > C
3994 > C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
3995 > C angles gamma and its derivatives in consecutive thetas and gammas.
3996 > C ab initio-derived potentials from
3997 > c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
3998 > C
3999 >       implicit real*8 (a-h,o-z)
4000 >       include 'DIMENSIONS'
4001 >       include 'COMMON.LOCAL'
4002 >       include 'COMMON.GEO'
4003 >       include 'COMMON.INTERACT'
4004 >       include 'COMMON.DERIV'
4005 >       include 'COMMON.VAR'
4006 >       include 'COMMON.CHAIN'
4007 >       include 'COMMON.IOUNITS'
4008 >       include 'COMMON.NAMES'
4009 >       include 'COMMON.FFIELD'
4010 >       include 'COMMON.CONTROL'
4011 >       double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4012 >      & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4013 >      & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4014 >      & sinph1ph2(maxdouble,maxdouble)
4015 >       logical lprn /.false./, lprn1 /.false./
4016 >       etheta=0.0D0
4017 >       do i=ithet_start,ithet_end
4018 >         dethetai=0.0d0
4019 >         dephii=0.0d0
4020 >         dephii1=0.0d0
4021 >         theti2=0.5d0*theta(i)
4022 >         ityp2=ithetyp(itype(i-1))
4023 >         do k=1,nntheterm
4024 >           coskt(k)=dcos(k*theti2)
4025 >           sinkt(k)=dsin(k*theti2)
4026 >         enddo
4027 >         if (i.gt.3) then
4028 > #ifdef OSF
4029 >           phii=phi(i)
4030 >           if (phii.ne.phii) phii=150.0
4031 > #else
4032 >           phii=phi(i)
4033 > #endif
4034 >           ityp1=ithetyp(itype(i-2))
4035 >           do k=1,nsingle
4036 >             cosph1(k)=dcos(k*phii)
4037 >             sinph1(k)=dsin(k*phii)
4038 >           enddo
4039 >         else
4040 >           phii=0.0d0
4041 >           ityp1=nthetyp+1
4042 >           do k=1,nsingle
4043 >             cosph1(k)=0.0d0
4044 >             sinph1(k)=0.0d0
4045 >           enddo
4046 >         endif
4047 >         if (i.lt.nres) then
4048 > #ifdef OSF
4049 >           phii1=phi(i+1)
4050 >           if (phii1.ne.phii1) phii1=150.0
4051 >           phii1=pinorm(phii1)
4052 > #else
4053 >           phii1=phi(i+1)
4054 > #endif
4055 >           ityp3=ithetyp(itype(i))
4056 >           do k=1,nsingle
4057 >             cosph2(k)=dcos(k*phii1)
4058 >             sinph2(k)=dsin(k*phii1)
4059 >           enddo
4060 >         else
4061 >           phii1=0.0d0
4062 >           ityp3=nthetyp+1
4063 >           do k=1,nsingle
4064 >             cosph2(k)=0.0d0
4065 >             sinph2(k)=0.0d0
4066 >           enddo
4067 >         endif
4068 >         ethetai=aa0thet(ityp1,ityp2,ityp3)
4069 >         do k=1,ndouble
4070 >           do l=1,k-1
4071 >             ccl=cosph1(l)*cosph2(k-l)
4072 >             ssl=sinph1(l)*sinph2(k-l)
4073 >             scl=sinph1(l)*cosph2(k-l)
4074 >             csl=cosph1(l)*sinph2(k-l)
4075 >             cosph1ph2(l,k)=ccl-ssl
4076 >             cosph1ph2(k,l)=ccl+ssl
4077 >             sinph1ph2(l,k)=scl+csl
4078 >             sinph1ph2(k,l)=scl-csl
4079 >           enddo
4080 >         enddo
4081 >         if (lprn) then
4082 >         write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4083 >      &    " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4084 >         write (iout,*) "coskt and sinkt"
4085 >         do k=1,nntheterm
4086 >           write (iout,*) k,coskt(k),sinkt(k)
4087 >         enddo
4088 >         endif
4089 >         do k=1,ntheterm
4090 >           ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4091 >           dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4092 >      &      *coskt(k)
4093 >           if (lprn)
4094 >      &    write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4095 >      &     " ethetai",ethetai
4096 >         enddo
4097 >         if (lprn) then
4098 >         write (iout,*) "cosph and sinph"
4099 >         do k=1,nsingle
4100 >           write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4101 >         enddo
4102 >         write (iout,*) "cosph1ph2 and sinph2ph2"
4103 >         do k=2,ndouble
4104 >           do l=1,k-1
4105 >             write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4106 >      &         sinph1ph2(l,k),sinph1ph2(k,l)
4107 >           enddo
4108 >         enddo
4109 >         write(iout,*) "ethetai",ethetai
4110 >         endif
4111 >         do m=1,ntheterm2
4112 >           do k=1,nsingle
4113 >             aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4114 >      &         +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4115 >      &         +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4116 >      &         +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4117 >             ethetai=ethetai+sinkt(m)*aux
4118 >             dethetai=dethetai+0.5d0*m*aux*coskt(m)
4119 >             dephii=dephii+k*sinkt(m)*(
4120 >      &          ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4121 >      &          bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4122 >             dephii1=dephii1+k*sinkt(m)*(
4123 >      &          eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4124 >      &          ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4125 >             if (lprn)
4126 >      &      write (iout,*) "m",m," k",k," bbthet",
4127 >      &         bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4128 >      &         ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4129 >      &         ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4130 >      &         eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4131 >           enddo
4132 >         enddo
4133 >         if (lprn)
4134 >      &  write(iout,*) "ethetai",ethetai
4135 >         do m=1,ntheterm3
4136 >           do k=2,ndouble
4137 >             do l=1,k-1
4138 >               aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4139 >      &            ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4140 >      &            ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4141 >      &            ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4142 >               ethetai=ethetai+sinkt(m)*aux
4143 >               dethetai=dethetai+0.5d0*m*coskt(m)*aux
4144 >               dephii=dephii+l*sinkt(m)*(
4145 >      &           -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4146 >      &            ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4147 >      &            ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4148 >      &            ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4149 >               dephii1=dephii1+(k-l)*sinkt(m)*(
4150 >      &           -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4151 >      &            ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4152 >      &            ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4153 >      &            ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4154 >               if (lprn) then
4155 >               write (iout,*) "m",m," k",k," l",l," ffthet",
4156 >      &            ffthet(l,k,m,ityp1,ityp2,ityp3),
4157 >      &            ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4158 >      &            ggthet(l,k,m,ityp1,ityp2,ityp3),
4159 >      &            ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4160 >               write (iout,*) cosph1ph2(l,k)*sinkt(m),
4161 >      &            cosph1ph2(k,l)*sinkt(m),
4162 >      &            sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4163 >               endif
4164 >             enddo
4165 >           enddo
4166 >         enddo
4167 > 10      continue
4168 >         if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4169 >      &   i,theta(i)*rad2deg,phii*rad2deg,
4170 >      &   phii1*rad2deg,ethetai
4171 >         etheta=etheta+ethetai
4172 >         if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4173 >         if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4174 >         gloc(nphi+i-2,icg)=wang*dethetai
4175 >       enddo
4176 >       return
4177 >       end
4178 > #endif
4179 > #ifdef CRYST_SC
4180 > c-----------------------------------------------------------------------------
4181 >       subroutine esc(escloc)
4182 > C Calculate the local energy of a side chain and its derivatives in the
4183 > C corresponding virtual-bond valence angles THETA and the spherical angles
4184 > C ALPHA and OMEGA.
4185 >       implicit real*8 (a-h,o-z)
4186 >       include 'DIMENSIONS'
4187 >       include 'COMMON.GEO'
4188 >       include 'COMMON.LOCAL'
4189 >       include 'COMMON.VAR'
4190 >       include 'COMMON.INTERACT'
4191 >       include 'COMMON.DERIV'
4192 >       include 'COMMON.CHAIN'
4193 >       include 'COMMON.IOUNITS'
4194 >       include 'COMMON.NAMES'
4195 >       include 'COMMON.FFIELD'
4196 >       include 'COMMON.CONTROL'
4197 >       double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4198 >      &     ddersc0(3),ddummy(3),xtemp(3),temp(3)
4199 >       common /sccalc/ time11,time12,time112,theti,it,nlobit
4200 >       delta=0.02d0*pi
4201 >       escloc=0.0D0
4202 > c     write (iout,'(a)') 'ESC'
4203 >       do i=loc_start,loc_end
4204 >         it=itype(i)
4205 >         if (it.eq.10) goto 1
4206 >         nlobit=nlob(it)
4207 > c       print *,'i=',i,' it=',it,' nlobit=',nlobit
4208 > c       write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4209 >         theti=theta(i+1)-pipol
4210 >         x(1)=dtan(theti)
4211 >         x(2)=alph(i)
4212 >         x(3)=omeg(i)
4213 >
4214 >         if (x(2).gt.pi-delta) then
4215 >           xtemp(1)=x(1)
4216 >           xtemp(2)=pi-delta
4217 >           xtemp(3)=x(3)
4218 >           call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4219 >           xtemp(2)=pi
4220 >           call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4221 >           call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4222 >      &        escloci,dersc(2))
4223 >           call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4224 >      &        ddersc0(1),dersc(1))
4225 >           call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4226 >      &        ddersc0(3),dersc(3))
4227 >           xtemp(2)=pi-delta
4228 >           call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4229 >           xtemp(2)=pi
4230 >           call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4231 >           call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4232 >      &            dersc0(2),esclocbi,dersc02)
4233 >           call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4234 >      &            dersc12,dersc01)
4235 >           call splinthet(x(2),0.5d0*delta,ss,ssd)
4236 >           dersc0(1)=dersc01
4237 >           dersc0(2)=dersc02
4238 >           dersc0(3)=0.0d0
4239 >           do k=1,3
4240 >             dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4241 >           enddo
4242 >           dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4243 > c         write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4244 > c    &             esclocbi,ss,ssd
4245 >           escloci=ss*escloci+(1.0d0-ss)*esclocbi
4246 > c         escloci=esclocbi
4247 > c         write (iout,*) escloci
4248 >         else if (x(2).lt.delta) then
4249 >           xtemp(1)=x(1)
4250 >           xtemp(2)=delta
4251 >           xtemp(3)=x(3)
4252 >           call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4253 >           xtemp(2)=0.0d0
4254 >           call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4255 >           call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4256 >      &        escloci,dersc(2))
4257 >           call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4258 >      &        ddersc0(1),dersc(1))
4259 >           call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4260 >      &        ddersc0(3),dersc(3))
4261 >           xtemp(2)=delta
4262 >           call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4263 >           xtemp(2)=0.0d0
4264 >           call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4265 >           call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4266 >      &            dersc0(2),esclocbi,dersc02)
4267 >           call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4268 >      &            dersc12,dersc01)
4269 >           dersc0(1)=dersc01
4270 >           dersc0(2)=dersc02
4271 >           dersc0(3)=0.0d0
4272 >           call splinthet(x(2),0.5d0*delta,ss,ssd)
4273 >           do k=1,3
4274 >             dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4275 >           enddo
4276 >           dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4277 > c         write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4278 > c    &             esclocbi,ss,ssd
4279 >           escloci=ss*escloci+(1.0d0-ss)*esclocbi
4280 > c         write (iout,*) escloci
4281 >         else
4282 >           call enesc(x,escloci,dersc,ddummy,.false.)
4283 >         endif
4284 >
4285 >         escloc=escloc+escloci
4286 >         if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4287 >      &     'escloc',i,escloci
4288 > c       write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4289 >
4290 >         gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4291 >      &   wscloc*dersc(1)
4292 >         gloc(ialph(i,1),icg)=wscloc*dersc(2)
4293 >         gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4294 >     1   continue
4295 >       enddo
4296 >       return
4297 >       end
4298 > C---------------------------------------------------------------------------
4299 >       subroutine enesc(x,escloci,dersc,ddersc,mixed)
4300 >       implicit real*8 (a-h,o-z)
4301 >       include 'DIMENSIONS'
4302 >       include 'COMMON.GEO'
4303 >       include 'COMMON.LOCAL'
4304 >       include 'COMMON.IOUNITS'
4305 >       common /sccalc/ time11,time12,time112,theti,it,nlobit
4306 >       double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4307 >       double precision contr(maxlob,-1:1)
4308 >       logical mixed
4309 > c       write (iout,*) 'it=',it,' nlobit=',nlobit
4310 >         escloc_i=0.0D0
4311 >         do j=1,3
4312 >           dersc(j)=0.0D0
4313 >           if (mixed) ddersc(j)=0.0d0
4314 >         enddo
4315 >         x3=x(3)
4316 >
4317 > C Because of periodicity of the dependence of the SC energy in omega we have
4318 > C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4319 > C To avoid underflows, first compute & store the exponents.
4320 >
4321 >         do iii=-1,1
4322 >
4323 >           x(3)=x3+iii*dwapi
4324 >
4325 >           do j=1,nlobit
4326 >             do k=1,3
4327 >               z(k)=x(k)-censc(k,j,it)
4328 >             enddo
4329 >             do k=1,3
4330 >               Axk=0.0D0
4331 >               do l=1,3
4332 >                 Axk=Axk+gaussc(l,k,j,it)*z(l)
4333 >               enddo
4334 >               Ax(k,j,iii)=Axk
4335 >             enddo
4336 >             expfac=0.0D0
4337 >             do k=1,3
4338 >               expfac=expfac+Ax(k,j,iii)*z(k)
4339 >             enddo
4340 >             contr(j,iii)=expfac
4341 >           enddo ! j
4342 >
4343 >         enddo ! iii
4344 >
4345 >         x(3)=x3
4346 > C As in the case of ebend, we want to avoid underflows in exponentiation and
4347 > C subsequent NaNs and INFs in energy calculation.
4348 > C Find the largest exponent
4349 >         emin=contr(1,-1)
4350 >         do iii=-1,1
4351 >           do j=1,nlobit
4352 >             if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4353 >           enddo
4354 >         enddo
4355 >         emin=0.5D0*emin
4356 > cd      print *,'it=',it,' emin=',emin
4357 >
4358 > C Compute the contribution to SC energy and derivatives
4359 >         do iii=-1,1
4360 >
4361 >           do j=1,nlobit
4362 > #ifdef OSF
4363 >             adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
4364 >             if(adexp.ne.adexp) adexp=1.0
4365 >             expfac=dexp(adexp)
4366 > #else
4367 >             expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
4368 > #endif
4369 > cd          print *,'j=',j,' expfac=',expfac
4370 >             escloc_i=escloc_i+expfac
4371 >             do k=1,3
4372 >               dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4373 >             enddo
4374 >             if (mixed) then
4375 >               do k=1,3,2
4376 >                 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4377 >      &            +gaussc(k,2,j,it))*expfac
4378 >               enddo
4379 >             endif
4380 >           enddo
4381 >
4382 >         enddo ! iii
4383 >
4384 >         dersc(1)=dersc(1)/cos(theti)**2
4385 >         ddersc(1)=ddersc(1)/cos(theti)**2
4386 >         ddersc(3)=ddersc(3)
4387 >
4388 >         escloci=-(dlog(escloc_i)-emin)
4389 >         do j=1,3
4390 >           dersc(j)=dersc(j)/escloc_i
4391 >         enddo
4392 >         if (mixed) then
4393 >           do j=1,3,2
4394 >             ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4395 >           enddo
4396 >         endif
4397 >       return
4398 >       end
4399 > C------------------------------------------------------------------------------
4400 >       subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4401 >       implicit real*8 (a-h,o-z)
4402 >       include 'DIMENSIONS'
4403 >       include 'COMMON.GEO'
4404 >       include 'COMMON.LOCAL'
4405 >       include 'COMMON.IOUNITS'
4406 >       common /sccalc/ time11,time12,time112,theti,it,nlobit
4407 >       double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4408 >       double precision contr(maxlob)
4409 >       logical mixed
4410 >
4411 >       escloc_i=0.0D0
4412 >
4413 >       do j=1,3
4414 >         dersc(j)=0.0D0
4415 >       enddo
4416 >
4417 >       do j=1,nlobit
4418 >         do k=1,2
4419 >           z(k)=x(k)-censc(k,j,it)
4420 >         enddo
4421 >         z(3)=dwapi
4422 >         do k=1,3
4423 >           Axk=0.0D0
4424 >           do l=1,3
4425 >             Axk=Axk+gaussc(l,k,j,it)*z(l)
4426 >           enddo
4427 >           Ax(k,j)=Axk
4428 >         enddo
4429 >         expfac=0.0D0
4430 >         do k=1,3
4431 >           expfac=expfac+Ax(k,j)*z(k)
4432 >         enddo
4433 >         contr(j)=expfac
4434 >       enddo ! j
4435 >
4436 > C As in the case of ebend, we want to avoid underflows in exponentiation and
4437 > C subsequent NaNs and INFs in energy calculation.
4438 > C Find the largest exponent
4439 >       emin=contr(1)
4440 >       do j=1,nlobit
4441 >         if (emin.gt.contr(j)) emin=contr(j)
4442 >       enddo
4443 >       emin=0.5D0*emin
4444 >
4445 > C Compute the contribution to SC energy and derivatives
4446 >
4447 >       dersc12=0.0d0
4448 >       do j=1,nlobit
4449 >         expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
4450 >         escloc_i=escloc_i+expfac
4451 >         do k=1,2
4452 >           dersc(k)=dersc(k)+Ax(k,j)*expfac
4453 >         enddo
4454 >         if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4455 >      &            +gaussc(1,2,j,it))*expfac
4456 >         dersc(3)=0.0d0
4457 >       enddo
4458 >
4459 >       dersc(1)=dersc(1)/cos(theti)**2
4460 >       dersc12=dersc12/cos(theti)**2
4461 >       escloci=-(dlog(escloc_i)-emin)
4462 >       do j=1,2
4463 >         dersc(j)=dersc(j)/escloc_i
4464 >       enddo
4465 >       if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4466 >       return
4467 >       end
4468 > #else
4469 > c----------------------------------------------------------------------------------
4470 >       subroutine esc(escloc)
4471 > C Calculate the local energy of a side chain and its derivatives in the
4472 > C corresponding virtual-bond valence angles THETA and the spherical angles
4473 > C ALPHA and OMEGA derived from AM1 all-atom calculations.
4474 > C added by Urszula Kozlowska. 07/11/2007
4475 > C
4476 >       implicit real*8 (a-h,o-z)
4477 >       include 'DIMENSIONS'
4478 >       include 'COMMON.GEO'
4479 >       include 'COMMON.LOCAL'
4480 >       include 'COMMON.VAR'
4481 >       include 'COMMON.SCROT'
4482 >       include 'COMMON.INTERACT'
4483 >       include 'COMMON.DERIV'
4484 >       include 'COMMON.CHAIN'
4485 >       include 'COMMON.IOUNITS'
4486 >       include 'COMMON.NAMES'
4487 >       include 'COMMON.FFIELD'
4488 >       include 'COMMON.CONTROL'
4489 >       include 'COMMON.VECTORS'
4490 >       double precision x_prime(3),y_prime(3),z_prime(3)
4491 >      &    , sumene,dsc_i,dp2_i,x(65),
4492 >      &     xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4493 >      &    de_dxx,de_dyy,de_dzz,de_dt
4494 >       double precision s1_t,s1_6_t,s2_t,s2_6_t
4495 >       double precision
4496 >      & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
4497 >      & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
4498 >      & dt_dCi(3),dt_dCi1(3)
4499 >       common /sccalc/ time11,time12,time112,theti,it,nlobit
4500 >       delta=0.02d0*pi
4501 >       escloc=0.0D0
4502 >       do i=loc_start,loc_end
4503 >         costtab(i+1) =dcos(theta(i+1))
4504 >         sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
4505 >         cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
4506 >         sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
4507 >         cosfac2=0.5d0/(1.0d0+costtab(i+1))
4508 >         cosfac=dsqrt(cosfac2)
4509 >         sinfac2=0.5d0/(1.0d0-costtab(i+1))
4510 >         sinfac=dsqrt(sinfac2)
4511 >         it=itype(i)
4512 >         if (it.eq.10) goto 1
4513 > c
4514 > C  Compute the axes of tghe local cartesian coordinates system; store in
4515 > c   x_prime, y_prime and z_prime
4516 > c
4517 >         do j=1,3
4518 >           x_prime(j) = 0.00
4519 >           y_prime(j) = 0.00
4520 >           z_prime(j) = 0.00
4521 >         enddo
4522 > C        write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
4523 > C     &   dc_norm(3,i+nres)
4524 >         do j = 1,3
4525 >           x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
4526 >           y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
4527 >         enddo
4528 >         do j = 1,3
4529 >           z_prime(j) = -uz(j,i-1)
4530 >         enddo
4531 > c       write (2,*) "i",i
4532 > c       write (2,*) "x_prime",(x_prime(j),j=1,3)
4533 > c       write (2,*) "y_prime",(y_prime(j),j=1,3)
4534 > c       write (2,*) "z_prime",(z_prime(j),j=1,3)
4535 > c       write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
4536 > c      & " xy",scalar(x_prime(1),y_prime(1)),
4537 > c      & " xz",scalar(x_prime(1),z_prime(1)),
4538 > c      & " yy",scalar(y_prime(1),y_prime(1)),
4539 > c      & " yz",scalar(y_prime(1),z_prime(1)),
4540 > c      & " zz",scalar(z_prime(1),z_prime(1))
4541 > c
4542 > C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
4543 > C to local coordinate system. Store in xx, yy, zz.
4544 > c
4545 >         xx=0.0d0
4546 >         yy=0.0d0
4547 >         zz=0.0d0
4548 >         do j = 1,3
4549 >           xx = xx + x_prime(j)*dc_norm(j,i+nres)
4550 >           yy = yy + y_prime(j)*dc_norm(j,i+nres)
4551 >           zz = zz + z_prime(j)*dc_norm(j,i+nres)
4552 >         enddo
4553 >
4554 >         xxtab(i)=xx
4555 >         yytab(i)=yy
4556 >         zztab(i)=zz
4557 > C
4558 > C Compute the energy of the ith side cbain
4559 > C
4560 > c        write (2,*) "xx",xx," yy",yy," zz",zz
4561 >         it=itype(i)
4562 >         do j = 1,65
4563 >           x(j) = sc_parmin(j,it)
4564 >         enddo
4565 > #ifdef CHECK_COORD
4566 > Cc diagnostics - remove later
4567 >         xx1 = dcos(alph(2))
4568 >         yy1 = dsin(alph(2))*dcos(omeg(2))
4569 >         zz1 = -dsin(alph(2))*dsin(omeg(2))
4570 >         write(2,'(3f8.1,3f9.3,1x,3f9.3)')
4571 >      &    alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
4572 >      &    xx1,yy1,zz1
4573 > C,"  --- ", xx_w,yy_w,zz_w
4574 > c end diagnostics
4575 > #endif
4576 >         sumene1= x(1)+  x(2)*xx+  x(3)*yy+  x(4)*zz+  x(5)*xx**2
4577 >      &   + x(6)*yy**2+  x(7)*zz**2+  x(8)*xx*zz+  x(9)*xx*yy
4578 >      &   + x(10)*yy*zz
4579 >         sumene2=  x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4580 >      & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4581 >      & + x(20)*yy*zz
4582 >         sumene3=  x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4583 >      &  +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4584 >      &  +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4585 >      &  +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4586 >      &  +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4587 >      &  +x(40)*xx*yy*zz
4588 >         sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4589 >      &  +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4590 >      &  +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4591 >      &  +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4592 >      &  +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4593 >      &  +x(60)*xx*yy*zz
4594 >         dsc_i   = 0.743d0+x(61)
4595 >         dp2_i   = 1.9d0+x(62)
4596 >         dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4597 >      &          *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
4598 >         dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4599 >      &          *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
4600 >         s1=(1+x(63))/(0.1d0 + dscp1)
4601 >         s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4602 >         s2=(1+x(65))/(0.1d0 + dscp2)
4603 >         s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4604 >         sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
4605 >      & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
4606 > c        write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
4607 > c     &   sumene4,
4608 > c     &   dscp1,dscp2,sumene
4609 > c        sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4610 >         escloc = escloc + sumene
4611 > c        write (2,*) "i",i," escloc",sumene,escloc
4612 > #ifdef DEBUG
4613 > C
4614 > C This section to check the numerical derivatives of the energy of ith side
4615 > C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
4616 > C #define DEBUG in the code to turn it on.
4617 > C
4618 >         write (2,*) "sumene               =",sumene
4619 >         aincr=1.0d-7
4620 >         xxsave=xx
4621 >         xx=xx+aincr
4622 >         write (2,*) xx,yy,zz
4623 >         sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4624 >         de_dxx_num=(sumenep-sumene)/aincr
4625 >         xx=xxsave
4626 >         write (2,*) "xx+ sumene from enesc=",sumenep
4627 >         yysave=yy
4628 >         yy=yy+aincr
4629 >         write (2,*) xx,yy,zz
4630 >         sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4631 >         de_dyy_num=(sumenep-sumene)/aincr
4632 >         yy=yysave
4633 >         write (2,*) "yy+ sumene from enesc=",sumenep
4634 >         zzsave=zz
4635 >         zz=zz+aincr
4636 >         write (2,*) xx,yy,zz
4637 >         sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4638 >         de_dzz_num=(sumenep-sumene)/aincr
4639 >         zz=zzsave
4640 >         write (2,*) "zz+ sumene from enesc=",sumenep
4641 >         costsave=cost2tab(i+1)
4642 >         sintsave=sint2tab(i+1)
4643 >         cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
4644 >         sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
4645 >         sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
4646 >         de_dt_num=(sumenep-sumene)/aincr
4647 >         write (2,*) " t+ sumene from enesc=",sumenep
4648 >         cost2tab(i+1)=costsave
4649 >         sint2tab(i+1)=sintsave
4650 > C End of diagnostics section.
4651 > #endif
4652 > C
4653 > C Compute the gradient of esc
4654 > C
4655 >         pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
4656 >         pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
4657 >         pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
4658 >         pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
4659 >         pom_dx=dsc_i*dp2_i*cost2tab(i+1)
4660 >         pom_dy=dsc_i*dp2_i*sint2tab(i+1)
4661 >         pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
4662 >         pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
4663 >         pom1=(sumene3*sint2tab(i+1)+sumene1)
4664 >      &     *(pom_s1/dscp1+pom_s16*dscp1**4)
4665 >         pom2=(sumene4*cost2tab(i+1)+sumene2)
4666 >      &     *(pom_s2/dscp2+pom_s26*dscp2**4)
4667 >         sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
4668 >         sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
4669 >      &  +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
4670 >      &  +x(40)*yy*zz
4671 >         sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
4672 >         sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
4673 >      &  +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
4674 >      &  +x(60)*yy*zz
4675 >         de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
4676 >      &        +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
4677 >      &        +(pom1+pom2)*pom_dx
4678 > #ifdef DEBUG
4679 >         write(2,*), "de_dxx = ", de_dxx,de_dxx_num
4680 > #endif
4681 > C
4682 >         sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
4683 >         sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
4684 >      &  +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
4685 >      &  +x(40)*xx*zz
4686 >         sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
4687 >         sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
4688 >      &  +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
4689 >      &  +x(59)*zz**2 +x(60)*xx*zz
4690 >         de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
4691 >      &        +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
4692 >      &        +(pom1-pom2)*pom_dy
4693 > #ifdef DEBUG
4694 >         write(2,*), "de_dyy = ", de_dyy,de_dyy_num
4695 > #endif
4696 > C
4697 >         de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
4698 >      &  +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
4699 >      &  +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
4700 >      &  +(x(4) + 2*x(7)*zz+  x(8)*xx + x(10)*yy)*(s1+s1_6)
4701 >      &  +(x(44)+2*x(47)*zz +x(48)*xx   +x(50)*yy  +3*x(53)*zz**2
4702 >      &  +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
4703 >      &  +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
4704 >      &  + ( x(14) + 2*x(17)*zz+  x(18)*xx + x(20)*yy)*(s2+s2_6)
4705 > #ifdef DEBUG
4706 >         write(2,*), "de_dzz = ", de_dzz,de_dzz_num
4707 > #endif
4708 > C
4709 >         de_dt =  0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
4710 >      &  -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
4711 >      &  +pom1*pom_dt1+pom2*pom_dt2
4712 > #ifdef DEBUG
4713 >         write(2,*), "de_dt = ", de_dt,de_dt_num
4714 > #endif
4715 > c
4716 > C
4717 >        cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
4718 >        cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
4719 >        cosfac2xx=cosfac2*xx
4720 >        sinfac2yy=sinfac2*yy
4721 >        do k = 1,3
4722 >          dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
4723 >      &      vbld_inv(i+1)
4724 >          dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
4725 >      &      vbld_inv(i)
4726 >          pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
4727 >          pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
4728 > c         write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
4729 > c     &    " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
4730 > c         write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
4731 > c     &   (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
4732 >          dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
4733 >          dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
4734 >          dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
4735 >          dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
4736 >          dZZ_Ci1(k)=0.0d0
4737 >          dZZ_Ci(k)=0.0d0
4738 >          do j=1,3
4739 >            dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
4740 >            dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
4741 >          enddo
4742 >
4743 >          dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
4744 >          dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
4745 >          dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
4746 > c
4747 >          dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
4748 >          dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
4749 >        enddo
4750 >
4751 >        do k=1,3
4752 >          dXX_Ctab(k,i)=dXX_Ci(k)
4753 >          dXX_C1tab(k,i)=dXX_Ci1(k)
4754 >          dYY_Ctab(k,i)=dYY_Ci(k)
4755 >          dYY_C1tab(k,i)=dYY_Ci1(k)
4756 >          dZZ_Ctab(k,i)=dZZ_Ci(k)
4757 >          dZZ_C1tab(k,i)=dZZ_Ci1(k)
4758 >          dXX_XYZtab(k,i)=dXX_XYZ(k)
4759 >          dYY_XYZtab(k,i)=dYY_XYZ(k)
4760 >          dZZ_XYZtab(k,i)=dZZ_XYZ(k)
4761 >        enddo
4762 >
4763 >        do k = 1,3
4764 > c         write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
4765 > c     &    dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
4766 > c         write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
4767 > c     &    dyy_ci(k)," dzz_ci",dzz_ci(k)
4768 > c         write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
4769 > c     &    dt_dci(k)
4770 > c         write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
4771 > c     &    dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
4772 >          gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
4773 >      &    +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
4774 >          gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
4775 >      &    +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
4776 >          gsclocx(k,i)=                 de_dxx*dxx_XYZ(k)
4777 >      &    +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
4778 >        enddo
4779 > c       write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
4780 > c     &  (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
4781 >
4782 > C to check gradient call subroutine check_grad
4783 >
4784 >     1 continue
4785 >       enddo
4786 >       return
4787 >       end
4788 > c------------------------------------------------------------------------------
4789 >       double precision function enesc(x,xx,yy,zz,cost2,sint2)
4790 >       implicit none
4791 >       double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
4792 >      & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
4793 >       sumene1= x(1)+  x(2)*xx+  x(3)*yy+  x(4)*zz+  x(5)*xx**2
4794 >      &   + x(6)*yy**2+  x(7)*zz**2+  x(8)*xx*zz+  x(9)*xx*yy
4795 >      &   + x(10)*yy*zz
4796 >       sumene2=  x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
4797 >      & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
4798 >      & + x(20)*yy*zz
4799 >       sumene3=  x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
4800 >      &  +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
4801 >      &  +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
4802 >      &  +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
4803 >      &  +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
4804 >      &  +x(40)*xx*yy*zz
4805 >       sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
4806 >      &  +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
4807 >      &  +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
4808 >      &  +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
4809 >      &  +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
4810 >      &  +x(60)*xx*yy*zz
4811 >       dsc_i   = 0.743d0+x(61)
4812 >       dp2_i   = 1.9d0+x(62)
4813 >       dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4814 >      &          *(xx*cost2+yy*sint2))
4815 >       dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
4816 >      &          *(xx*cost2-yy*sint2))
4817 >       s1=(1+x(63))/(0.1d0 + dscp1)
4818 >       s1_6=(1+x(64))/(0.1d0 + dscp1**6)
4819 >       s2=(1+x(65))/(0.1d0 + dscp2)
4820 >       s2_6=(1+x(65))/(0.1d0 + dscp2**6)
4821 >       sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
4822 >      & + (sumene4*cost2 +sumene2)*(s2+s2_6)
4823 >       enesc=sumene
4824 >       return
4825 >       end
4826 > #endif
4827 > c------------------------------------------------------------------------------
4828 >       subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
4829 > C
4830 > C This procedure calculates two-body contact function g(rij) and its derivative:
4831 > C
4832 > C           eps0ij                                     !       x < -1
4833 > C g(rij) =  esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5)  ! -1 =< x =< 1
4834 > C            0                                         !       x > 1
4835 > C
4836 > C where x=(rij-r0ij)/delta
4837 > C
4838 > C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
4839 > C
4840 >       implicit none
4841 >       double precision rij,r0ij,eps0ij,fcont,fprimcont
4842 >       double precision x,x2,x4,delta
4843 > c     delta=0.02D0*r0ij
4844 > c      delta=0.2D0*r0ij
4845 >       x=(rij-r0ij)/delta
4846 >       if (x.lt.-1.0D0) then
4847 >         fcont=eps0ij
4848 >         fprimcont=0.0D0
4849 >       else if (x.le.1.0D0) then
4850 >         x2=x*x
4851 >         x4=x2*x2
4852 >         fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
4853 >         fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
4854 >       else
4855 >         fcont=0.0D0
4856 >         fprimcont=0.0D0
4857 >       endif
4858 >       return
4859 >       end
4860 > c------------------------------------------------------------------------------
4861 >       subroutine splinthet(theti,delta,ss,ssder)
4862 >       implicit real*8 (a-h,o-z)
4863 >       include 'DIMENSIONS'
4864 >       include 'COMMON.VAR'
4865 >       include 'COMMON.GEO'
4866 >       thetup=pi-delta
4867 >       thetlow=delta
4868 >       if (theti.gt.pipol) then
4869 >         call gcont(theti,thetup,1.0d0,delta,ss,ssder)
4870 >       else
4871 >         call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
4872 >         ssder=-ssder
4873 >       endif
4874 >       return
4875 >       end
4876 > c------------------------------------------------------------------------------
4877 >       subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
4878 >       implicit none
4879 >       double precision x,x0,delta,f0,f1,fprim0,f,fprim
4880 >       double precision ksi,ksi2,ksi3,a1,a2,a3
4881 >       a1=fprim0*delta/(f1-f0)
4882 >       a2=3.0d0-2.0d0*a1
4883 >       a3=a1-2.0d0
4884 >       ksi=(x-x0)/delta
4885 >       ksi2=ksi*ksi
4886 >       ksi3=ksi2*ksi
4887 >       f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
4888 >       fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
4889 >       return
4890 >       end
4891 > c------------------------------------------------------------------------------
4892 >       subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
4893 >       implicit none
4894 >       double precision x,x0,delta,f0x,f1x,fprim0x,fx
4895 >       double precision ksi,ksi2,ksi3,a1,a2,a3
4896 >       ksi=(x-x0)/delta
4897 >       ksi2=ksi*ksi
4898 >       ksi3=ksi2*ksi
4899 >       a1=fprim0x*delta
4900 >       a2=3*(f1x-f0x)-2*fprim0x*delta
4901 >       a3=fprim0x*delta-2*(f1x-f0x)
4902 >       fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
4903 >       return
4904 >       end
4905 > C-----------------------------------------------------------------------------
4906 > #ifdef CRYST_TOR
4907 > C-----------------------------------------------------------------------------
4908 >       subroutine etor(etors,edihcnstr)
4909 >       implicit real*8 (a-h,o-z)
4910 >       include 'DIMENSIONS'
4911 >       include 'COMMON.VAR'
4912 >       include 'COMMON.GEO'
4913 >       include 'COMMON.LOCAL'
4914 >       include 'COMMON.TORSION'
4915 >       include 'COMMON.INTERACT'
4916 >       include 'COMMON.DERIV'
4917 >       include 'COMMON.CHAIN'
4918 >       include 'COMMON.NAMES'
4919 >       include 'COMMON.IOUNITS'
4920 >       include 'COMMON.FFIELD'
4921 >       include 'COMMON.TORCNSTR'
4922 >       include 'COMMON.CONTROL'
4923 >       logical lprn
4924 > C Set lprn=.true. for debugging
4925 >       lprn=.false.
4926 > c      lprn=.true.
4927 >       etors=0.0D0
4928 >       do i=iphi_start,iphi_end
4929 >       etors_ii=0.0D0
4930 >       itori=itortyp(itype(i-2))
4931 >       itori1=itortyp(itype(i-1))
4932 >         phii=phi(i)
4933 >         gloci=0.0D0
4934 > C Proline-Proline pair is a special case...
4935 >         if (itori.eq.3 .and. itori1.eq.3) then
4936 >           if (phii.gt.-dwapi3) then
4937 >             cosphi=dcos(3*phii)
4938 >             fac=1.0D0/(1.0D0-cosphi)
4939 >             etorsi=v1(1,3,3)*fac
4940 >             etorsi=etorsi+etorsi
4941 >             etors=etors+etorsi-v1(1,3,3)
4942 >             if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
4943 >             gloci=gloci-3*fac*etorsi*dsin(3*phii)
4944 >           endif
4945 >           do j=1,3
4946 >             v1ij=v1(j+1,itori,itori1)
4947 >             v2ij=v2(j+1,itori,itori1)
4948 >             cosphi=dcos(j*phii)
4949 >             sinphi=dsin(j*phii)
4950 >             etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4951 >             if (energy_dec) etors_ii=etors_ii+
4952 >      &                              v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4953 >             gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4954 >           enddo
4955 >         else
4956 >           do j=1,nterm_old
4957 >             v1ij=v1(j,itori,itori1)
4958 >             v2ij=v2(j,itori,itori1)
4959 >             cosphi=dcos(j*phii)
4960 >             sinphi=dsin(j*phii)
4961 >             etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4962 >             if (energy_dec) etors_ii=etors_ii+
4963 >      &                  v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
4964 >             gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
4965 >           enddo
4966 >         endif
4967 >         if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4968 >              'etor',i,etors_ii
4969 >         if (lprn)
4970 >      &  write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
4971 >      &  restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
4972 >      &  (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
4973 >         gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
4974 > c       write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
4975 >       enddo
4976 > ! 6/20/98 - dihedral angle constraints
4977 >       edihcnstr=0.0d0
4978 >       do i=1,ndih_constr
4979 >         itori=idih_constr(i)
4980 >         phii=phi(itori)
4981 >         difi=phii-phi0(i)
4982 >         if (difi.gt.drange(i)) then
4983 >           difi=difi-drange(i)
4984 >           edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4985 >           gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4986 >         else if (difi.lt.-drange(i)) then
4987 >           difi=difi+drange(i)
4988 >           edihcnstr=edihcnstr+0.25d0*ftors*difi**4
4989 >           gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
4990 >         endif
4991 > !        write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
4992 > !     &    rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
4993 >       enddo
4994 > !      write (iout,*) 'edihcnstr',edihcnstr
4995 >       return
4996 >       end
4997 > c------------------------------------------------------------------------------
4998 >       subroutine etor_d(etors_d)
4999 >       etors_d=0.0d0
5000 >       return
5001 >       end
5002 > c----------------------------------------------------------------------------
5003 > #else
5004 >       subroutine etor(etors,edihcnstr)
5005 >       implicit real*8 (a-h,o-z)
5006 >       include 'DIMENSIONS'
5007 >       include 'COMMON.VAR'
5008 >       include 'COMMON.GEO'
5009 >       include 'COMMON.LOCAL'
5010 >       include 'COMMON.TORSION'
5011 >       include 'COMMON.INTERACT'
5012 >       include 'COMMON.DERIV'
5013 >       include 'COMMON.CHAIN'
5014 >       include 'COMMON.NAMES'
5015 >       include 'COMMON.IOUNITS'
5016 >       include 'COMMON.FFIELD'
5017 >       include 'COMMON.TORCNSTR'
5018 >       include 'COMMON.CONTROL'
5019 >       logical lprn
5020 > C Set lprn=.true. for debugging
5021 >       lprn=.false.
5022 > c     lprn=.true.
5023 >       etors=0.0D0
5024 >       do i=iphi_start,iphi_end
5025 >       etors_ii=0.0D0
5026 >         itori=itortyp(itype(i-2))
5027 >         itori1=itortyp(itype(i-1))
5028 >         phii=phi(i)
5029 >         gloci=0.0D0
5030 > C Regular cosine and sine terms
5031 >         do j=1,nterm(itori,itori1)
5032 >           v1ij=v1(j,itori,itori1)
5033 >           v2ij=v2(j,itori,itori1)
5034 >           cosphi=dcos(j*phii)
5035 >           sinphi=dsin(j*phii)
5036 >           etors=etors+v1ij*cosphi+v2ij*sinphi
5037 >           if (energy_dec) etors_ii=etors_ii+
5038 >      &                v1ij*cosphi+v2ij*sinphi
5039 >           gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5040 >         enddo
5041 > C Lorentz terms
5042 > C                         v1
5043 > C  E = SUM ----------------------------------- - v1
5044 > C          [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5045 > C
5046 >         cosphi=dcos(0.5d0*phii)
5047 >         sinphi=dsin(0.5d0*phii)
5048 >         do j=1,nlor(itori,itori1)
5049 >           vl1ij=vlor1(j,itori,itori1)
5050 >           vl2ij=vlor2(j,itori,itori1)
5051 >           vl3ij=vlor3(j,itori,itori1)
5052 >           pom=vl2ij*cosphi+vl3ij*sinphi
5053 >           pom1=1.0d0/(pom*pom+1.0d0)
5054 >           etors=etors+vl1ij*pom1
5055 >           if (energy_dec) etors_ii=etors_ii+
5056 >      &                vl1ij*pom1
5057 >           pom=-pom*pom1*pom1
5058 >           gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5059 >         enddo
5060 > C Subtract the constant term
5061 >         etors=etors-v0(itori,itori1)
5062 >           if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5063 >      &         'etor',i,etors_ii-v0(itori,itori1)
5064 >         if (lprn)
5065 >      &  write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5066 >      &  restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5067 >      &  (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5068 >         gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5069 > c       write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5070 >       enddo
5071 > ! 6/20/98 - dihedral angle constraints
5072 >       edihcnstr=0.0d0
5073 > c      do i=1,ndih_constr
5074 >       do i=idihconstr_start,idihconstr_end
5075 >         itori=idih_constr(i)
5076 >         phii=phi(itori)
5077 >         difi=pinorm(phii-phi0(i))
5078 >         if (difi.gt.drange(i)) then
5079 >           difi=difi-drange(i)
5080 >           edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5081 >           gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5082 >         else if (difi.lt.-drange(i)) then
5083 >           difi=difi+drange(i)
5084 >           edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5085 >           gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5086 >         else
5087 >           difi=0.0
5088 >         endif
5089 > cd        write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5090 > cd     &    rad2deg*phi0(i),  rad2deg*drange(i),
5091 > cd     &    rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5092 >       enddo
5093 > cd       write (iout,*) 'edihcnstr',edihcnstr
5094 >       return
5095 >       end
5096 > c----------------------------------------------------------------------------
5097 >       subroutine etor_d(etors_d)
5098 > C 6/23/01 Compute double torsional energy
5099 >       implicit real*8 (a-h,o-z)
5100 >       include 'DIMENSIONS'
5101 >       include 'COMMON.VAR'
5102 >       include 'COMMON.GEO'
5103 >       include 'COMMON.LOCAL'
5104 >       include 'COMMON.TORSION'
5105 >       include 'COMMON.INTERACT'
5106 >       include 'COMMON.DERIV'
5107 >       include 'COMMON.CHAIN'
5108 >       include 'COMMON.NAMES'
5109 >       include 'COMMON.IOUNITS'
5110 >       include 'COMMON.FFIELD'
5111 >       include 'COMMON.TORCNSTR'
5112 >       logical lprn
5113 > C Set lprn=.true. for debugging
5114 >       lprn=.false.
5115 > c     lprn=.true.
5116 >       etors_d=0.0D0
5117 >       do i=iphid_start,iphid_end
5118 >         itori=itortyp(itype(i-2))
5119 >         itori1=itortyp(itype(i-1))
5120 >         itori2=itortyp(itype(i))
5121 >         phii=phi(i)
5122 >         phii1=phi(i+1)
5123 >         gloci1=0.0D0
5124 >         gloci2=0.0D0
5125 > C Regular cosine and sine terms
5126 >         do j=1,ntermd_1(itori,itori1,itori2)
5127 >           v1cij=v1c(1,j,itori,itori1,itori2)
5128 >           v1sij=v1s(1,j,itori,itori1,itori2)
5129 >           v2cij=v1c(2,j,itori,itori1,itori2)
5130 >           v2sij=v1s(2,j,itori,itori1,itori2)
5131 >           cosphi1=dcos(j*phii)
5132 >           sinphi1=dsin(j*phii)
5133 >           cosphi2=dcos(j*phii1)
5134 >           sinphi2=dsin(j*phii1)
5135 >           etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5136 >      &     v2cij*cosphi2+v2sij*sinphi2
5137 >           gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5138 >           gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5139 >         enddo
5140 >         do k=2,ntermd_2(itori,itori1,itori2)
5141 >           do l=1,k-1
5142 >             v1cdij = v2c(k,l,itori,itori1,itori2)
5143 >             v2cdij = v2c(l,k,itori,itori1,itori2)
5144 >             v1sdij = v2s(k,l,itori,itori1,itori2)
5145 >             v2sdij = v2s(l,k,itori,itori1,itori2)
5146 >             cosphi1p2=dcos(l*phii+(k-l)*phii1)
5147 >             cosphi1m2=dcos(l*phii-(k-l)*phii1)
5148 >             sinphi1p2=dsin(l*phii+(k-l)*phii1)
5149 >             sinphi1m2=dsin(l*phii-(k-l)*phii1)
5150 >             etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5151 >      &        v1sdij*sinphi1p2+v2sdij*sinphi1m2
5152 >             gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5153 >      &        -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5154 >             gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5155 >      &        -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5156 >           enddo
5157 >         enddo
5158 >         gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5159 >         gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5160 >       enddo
5161 >       return
5162 >       end
5163 > #endif
5164 > c------------------------------------------------------------------------------
5165 >       subroutine eback_sc_corr(esccor)
5166 > c 7/21/2007 Correlations between the backbone-local and side-chain-local
5167 > c        conformational states; temporarily implemented as differences
5168 > c        between UNRES torsional potentials (dependent on three types of
5169 > c        residues) and the torsional potentials dependent on all 20 types
5170 > c        of residues computed from AM1  energy surfaces of terminally-blocked
5171 > c        amino-acid residues.
5172 >       implicit real*8 (a-h,o-z)
5173 >       include 'DIMENSIONS'
5174 >       include 'COMMON.VAR'
5175 >       include 'COMMON.GEO'
5176 >       include 'COMMON.LOCAL'
5177 >       include 'COMMON.TORSION'
5178 >       include 'COMMON.SCCOR'
5179 >       include 'COMMON.INTERACT'
5180 >       include 'COMMON.DERIV'
5181 >       include 'COMMON.CHAIN'
5182 >       include 'COMMON.NAMES'
5183 >       include 'COMMON.IOUNITS'
5184 >       include 'COMMON.FFIELD'
5185 >       include 'COMMON.CONTROL'
5186 >       logical lprn
5187 > C Set lprn=.true. for debugging
5188 >       lprn=.false.
5189 > c      lprn=.true.
5190 > c      write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5191 >       esccor=0.0D0
5192 >       do i=iphi_start,iphi_end
5193 >         esccor_ii=0.0D0
5194 >         itori=itype(i-2)
5195 >         itori1=itype(i-1)
5196 >         phii=phi(i)
5197 >         gloci=0.0D0
5198 >         do j=1,nterm_sccor
5199 >           v1ij=v1sccor(j,itori,itori1)
5200 >           v2ij=v2sccor(j,itori,itori1)
5201 >           cosphi=dcos(j*phii)
5202 >           sinphi=dsin(j*phii)
5203 >           esccor=esccor+v1ij*cosphi+v2ij*sinphi
5204 >           gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5205 >         enddo
5206 >         if (lprn)
5207 >      &  write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5208 >      &  restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5209 >      &  (v1sccor(j,itori,itori1),j=1,6),(v2sccor(j,itori,itori1),j=1,6)
5210 >         gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5211 >       enddo
5212 >       return
5213 >       end
5214 > c----------------------------------------------------------------------------
5215 >       subroutine multibody(ecorr)
5216 > C This subroutine calculates multi-body contributions to energy following
5217 > C the idea of Skolnick et al. If side chains I and J make a contact and
5218 > C at the same time side chains I+1 and J+1 make a contact, an extra
5219 > C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5220 >       implicit real*8 (a-h,o-z)
5221 >       include 'DIMENSIONS'
5222 >       include 'COMMON.IOUNITS'
5223 >       include 'COMMON.DERIV'
5224 >       include 'COMMON.INTERACT'
5225 >       include 'COMMON.CONTACTS'
5226 >       double precision gx(3),gx1(3)
5227 >       logical lprn
5228 >
5229 > C Set lprn=.true. for debugging
5230 >       lprn=.false.
5231 >
5232 >       if (lprn) then
5233 >         write (iout,'(a)') 'Contact function values:'
5234 >         do i=nnt,nct-2
5235 >           write (iout,'(i2,20(1x,i2,f10.5))')
5236 >      &        i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5237 >         enddo
5238 >       endif
5239 >       ecorr=0.0D0
5240 >       do i=nnt,nct
5241 >         do j=1,3
5242 >           gradcorr(j,i)=0.0D0
5243 >           gradxorr(j,i)=0.0D0
5244 >         enddo
5245 >       enddo
5246 >       do i=nnt,nct-2
5247 >
5248 >         DO ISHIFT = 3,4
5249 >
5250 >         i1=i+ishift
5251 >         num_conti=num_cont(i)
5252 >         num_conti1=num_cont(i1)
5253 >         do jj=1,num_conti
5254 >           j=jcont(jj,i)
5255 >           do kk=1,num_conti1
5256 >             j1=jcont(kk,i1)
5257 >             if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5258 > cd          write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5259 > cd   &                   ' ishift=',ishift
5260 > C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5261 > C The system gains extra energy.
5262 >               ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5263 >             endif   ! j1==j+-ishift
5264 >           enddo     ! kk
5265 >         enddo       ! jj
5266 >
5267 >         ENDDO ! ISHIFT
5268 >
5269 >       enddo         ! i
5270 >       return
5271 >       end
5272 > c------------------------------------------------------------------------------
5273 >       double precision function esccorr(i,j,k,l,jj,kk)
5274 >       implicit real*8 (a-h,o-z)
5275 >       include 'DIMENSIONS'
5276 >       include 'COMMON.IOUNITS'
5277 >       include 'COMMON.DERIV'
5278 >       include 'COMMON.INTERACT'
5279 >       include 'COMMON.CONTACTS'
5280 >       double precision gx(3),gx1(3)
5281 >       logical lprn
5282 >       lprn=.false.
5283 >       eij=facont(jj,i)
5284 >       ekl=facont(kk,k)
5285 > cd    write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5286 > C Calculate the multi-body contribution to energy.
5287 > C Calculate multi-body contributions to the gradient.
5288 > cd    write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5289 > cd   & k,l,(gacont(m,kk,k),m=1,3)
5290 >       do m=1,3
5291 >         gx(m) =ekl*gacont(m,jj,i)
5292 >         gx1(m)=eij*gacont(m,kk,k)
5293 >         gradxorr(m,i)=gradxorr(m,i)-gx(m)
5294 >         gradxorr(m,j)=gradxorr(m,j)+gx(m)
5295 >         gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5296 >         gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5297 >       enddo
5298 >       do m=i,j-1
5299 >         do ll=1,3
5300 >           gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5301 >         enddo
5302 >       enddo
5303 >       do m=k,l-1
5304 >         do ll=1,3
5305 >           gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5306 >         enddo
5307 >       enddo
5308 >       esccorr=-eij*ekl
5309 >       return
5310 >       end
5311 > c------------------------------------------------------------------------------
5312 > #ifdef MPI
5313 >       subroutine pack_buffer(dimen1,dimen2,atom,indx,buffer)
5314 >       implicit real*8 (a-h,o-z)
5315 >       include 'DIMENSIONS'
5316 >       integer dimen1,dimen2,atom,indx
5317 >       double precision buffer(dimen1,dimen2)
5318 >       double precision zapas
5319 >       common /contacts_hb/ zapas(3,maxconts,maxres,8),
5320 >      &   facont_hb(maxconts,maxres),ees0p(maxconts,maxres),
5321 >      &         ees0m(maxconts,maxres),d_cont(maxconts,maxres),
5322 >      &         num_cont_hb(maxres),jcont_hb(maxconts,maxres)
5323 >       num_kont=num_cont_hb(atom)
5324 >       do i=1,num_kont
5325 >         do k=1,8
5326 >           do j=1,3
5327 >             buffer(i,indx+(k-1)*3+j)=zapas(j,i,atom,k)
5328 >           enddo ! j
5329 >         enddo ! k
5330 >         buffer(i,indx+25)=facont_hb(i,atom)
5331 >         buffer(i,indx+26)=ees0p(i,atom)
5332 >         buffer(i,indx+27)=ees0m(i,atom)
5333 >         buffer(i,indx+28)=d_cont(i,atom)
5334 >         buffer(i,indx+29)=dfloat(jcont_hb(i,atom))
5335 >       enddo ! i
5336 >       buffer(1,indx+30)=dfloat(num_kont)
5337 >       return
5338 >       end
5339 > c------------------------------------------------------------------------------
5340 >       subroutine unpack_buffer(dimen1,dimen2,atom,indx,buffer)
5341 >       implicit real*8 (a-h,o-z)
5342 >       include 'DIMENSIONS'
5343 >       integer dimen1,dimen2,atom,indx
5344 >       double precision buffer(dimen1,dimen2)
5345 >       double precision zapas
5346 >       common /contacts_hb/ zapas(3,maxconts,maxres,8),
5347 >      &   facont_hb(maxconts,maxres),ees0p(maxconts,maxres),
5348 >      &         ees0m(maxconts,maxres),d_cont(maxconts,maxres),
5349 >      &         num_cont_hb(maxres),jcont_hb(maxconts,maxres)
5350 >       num_kont=buffer(1,indx+30)
5351 >       num_kont_old=num_cont_hb(atom)
5352 >       num_cont_hb(atom)=num_kont+num_kont_old
5353 >       do i=1,num_kont
5354 >         ii=i+num_kont_old
5355 >         do k=1,8
5356 >           do j=1,3
5357 >             zapas(j,ii,atom,k)=buffer(i,indx+(k-1)*3+j)
5358 >           enddo ! j
5359 >         enddo ! k
5360 >         facont_hb(ii,atom)=buffer(i,indx+25)
5361 >         ees0p(ii,atom)=buffer(i,indx+26)
5362 >         ees0m(ii,atom)=buffer(i,indx+27)
5363 >         d_cont(i,atom)=buffer(i,indx+28)
5364 >         jcont_hb(ii,atom)=buffer(i,indx+29)
5365 >       enddo ! i
5366 >       return
5367 >       end
5368 > c------------------------------------------------------------------------------
5369 > #endif
5370 >       subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5371 > C This subroutine calculates multi-body contributions to hydrogen-bonding
5372 >       implicit real*8 (a-h,o-z)
5373 >       include 'DIMENSIONS'
5374 >       include 'COMMON.IOUNITS'
5375 > #ifdef MPI
5376 >       include "mpif.h"
5377 >       parameter (max_cont=maxconts)
5378 >       parameter (max_dim=2*(8*3+6))
5379 >       parameter (msglen1=max_cont*max_dim)
5380 >       parameter (msglen2=2*msglen1)
5381 >       integer source,CorrelType,CorrelID,Error
5382 >       double precision buffer(max_cont,max_dim)
5383 >       integer status(MPI_STATUS_SIZE)
5384 > #endif
5385 >       include 'COMMON.SETUP'
5386 >       include 'COMMON.FFIELD'
5387 >       include 'COMMON.DERIV'
5388 >       include 'COMMON.INTERACT'
5389 >       include 'COMMON.CONTACTS'
5390 >       include 'COMMON.CONTROL'
5391 >       double precision gx(3),gx1(3),time00
5392 >       logical lprn,ldone
5393 >
5394 > C Set lprn=.true. for debugging
5395 >       lprn=.false.
5396 > #ifdef MPI
5397 >       n_corr=0
5398 >       n_corr1=0
5399 >       if (nfgtasks.le.1) goto 30
5400 >       if (lprn) then
5401 >         write (iout,'(a)') 'Contact function values:'
5402 >         do i=nnt,nct-2
5403 >           write (iout,'(2i3,50(1x,i2,f5.2))')
5404 >      &    i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5405 >      &    j=1,num_cont_hb(i))
5406 >         enddo
5407 >       endif
5408 > C Caution! Following code assumes that electrostatic interactions concerning
5409 > C a given atom are split among at most two processors!
5410 >       CorrelType=477
5411 >       CorrelID=fg_rank+1
5412 >       ldone=.false.
5413 >       do i=1,max_cont
5414 >         do j=1,max_dim
5415 >           buffer(i,j)=0.0D0
5416 >         enddo
5417 >       enddo
5418 >       mm=mod(fg_rank,2)
5419 > c      write (*,*) 'MyRank',MyRank,' mm',mm
5420 >       if (mm) 20,20,10
5421 >    10 continue
5422 > c      write (*,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5423 >       if (fg_rank.gt.0) then
5424 > C Send correlation contributions to the preceding processor
5425 >         msglen=msglen1
5426 >         nn=num_cont_hb(iatel_s)
5427 >         call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5428 > c        write (*,*) 'The BUFFER array:'
5429 > c        do i=1,nn
5430 > c          write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,30)
5431 > c        enddo
5432 >         if (ielstart(iatel_s).gt.iatel_s+ispp) then
5433 >           msglen=msglen2
5434 >           call pack_buffer(max_cont,max_dim,iatel_s+1,30,buffer)
5435 > C Clear the contacts of the atom passed to the neighboring processor
5436 >         nn=num_cont_hb(iatel_s+1)
5437 > c        do i=1,nn
5438 > c          write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j+30),j=1,30)
5439 > c        enddo
5440 >             num_cont_hb(iatel_s)=0
5441 >         endif
5442 > cd      write (iout,*) 'Processor ',fg_rank,MyRank,
5443 > cd   & ' is sending correlation contribution to processor',fg_rank-1,
5444 > cd   & ' msglen=',msglen
5445 > c        write (*,*) 'Processor ',fg_rank,MyRank,
5446 > c     & ' is sending correlation contribution to processor',fg_rank-1,
5447 > c     & ' msglen=',msglen,' CorrelType=',CorrelType
5448 >         time00=MPI_Wtime()
5449 >         call MPI_Send(buffer,msglen,MPI_DOUBLE_PRECISION,fg_rank-1,
5450 >      &    CorrelType,FG_COMM,IERROR)
5451 >         time_sendrecv=time_sendrecv+MPI_Wtime()-time00
5452 > cd      write (iout,*) 'Processor ',fg_rank,
5453 > cd   & ' has sent correlation contribution to processor',fg_rank-1,
5454 > cd   & ' msglen=',msglen,' CorrelID=',CorrelID
5455 > c        write (*,*) 'Processor ',fg_rank,
5456 > c     & ' has sent correlation contribution to processor',fg_rank-1,
5457 > c     & ' msglen=',msglen,' CorrelID=',CorrelID
5458 > c        msglen=msglen1
5459 >       endif ! (fg_rank.gt.0)
5460 >       if (ldone) goto 30
5461 >       ldone=.true.
5462 >    20 continue
5463 > c      write (*,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5464 >       if (fg_rank.lt.nfgtasks-1) then
5465 > C Receive correlation contributions from the next processor
5466 >         msglen=msglen1
5467 >         if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5468 > cd      write (iout,*) 'Processor',fg_rank,
5469 > cd   & ' is receiving correlation contribution from processor',fg_rank+1,
5470 > cd   & ' msglen=',msglen,' CorrelType=',CorrelType
5471 > c        write (*,*) 'Processor',fg_rank,
5472 > c     &' is receiving correlation contribution from processor',fg_rank+1,
5473 > c     & ' msglen=',msglen,' CorrelType=',CorrelType
5474 >         time00=MPI_Wtime()
5475 >         nbytes=-1
5476 >         do while (nbytes.le.0)
5477 >           call MPI_Probe(fg_rank+1,CorrelType,FG_COMM,status,IERROR)
5478 >           call MPI_Get_count(status,MPI_DOUBLE_PRECISION,nbytes,IERROR)
5479 >         enddo
5480 > c        print *,'Processor',myrank,' msglen',msglen,' nbytes',nbytes
5481 >         call MPI_Recv(buffer,nbytes,MPI_DOUBLE_PRECISION,
5482 >      &    fg_rank+1,CorrelType,FG_COMM,status,IERROR)
5483 >         time_sendrecv=time_sendrecv+MPI_Wtime()-time00
5484 > c        write (*,*) 'Processor',fg_rank,
5485 > c     &' has received correlation contribution from processor',fg_rank+1,
5486 > c     & ' msglen=',msglen,' nbytes=',nbytes
5487 > c        write (*,*) 'The received BUFFER array:'
5488 > c        do i=1,max_cont
5489 > c          write (*,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,60)
5490 > c        enddo
5491 >         if (msglen.eq.msglen1) then
5492 >           call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5493 >         else if (msglen.eq.msglen2)  then
5494 >           call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5495 >           call unpack_buffer(max_cont,max_dim,iatel_e+1,30,buffer)
5496 >         else
5497 >           write (iout,*)
5498 >      & 'ERROR!!!! message length changed while processing correlations.'
5499 >           write (*,*)
5500 >      & 'ERROR!!!! message length changed while processing correlations.'
5501 >           call MPI_Abort(MPI_COMM_WORLD,Error,IERROR)
5502 >         endif ! msglen.eq.msglen1
5503 >       endif ! fg_rank.lt.nfgtasks-1
5504 >       if (ldone) goto 30
5505 >       ldone=.true.
5506 >       goto 10
5507 >    30 continue
5508 > #endif
5509 >       if (lprn) then
5510 >         write (iout,'(a)') 'Contact function values:'
5511 >         do i=nnt,nct-2
5512 >           write (iout,'(2i3,50(1x,i2,f5.2))')
5513 >      &    i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5514 >      &    j=1,num_cont_hb(i))
5515 >         enddo
5516 >       endif
5517 >       ecorr=0.0D0
5518 > C Remove the loop below after debugging !!!
5519 >       do i=nnt,nct
5520 >         do j=1,3
5521 >           gradcorr(j,i)=0.0D0
5522 >           gradxorr(j,i)=0.0D0
5523 >         enddo
5524 >       enddo
5525 > C Calculate the local-electrostatic correlation terms
5526 >       do i=iatel_s,iatel_e+1
5527 >         i1=i+1
5528 >         num_conti=num_cont_hb(i)
5529 >         num_conti1=num_cont_hb(i+1)
5530 >         do jj=1,num_conti
5531 >           j=jcont_hb(jj,i)
5532 >           do kk=1,num_conti1
5533 >             j1=jcont_hb(kk,i1)
5534 > c            write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5535 > c     &         ' jj=',jj,' kk=',kk
5536 >             if (j1.eq.j+1 .or. j1.eq.j-1) then
5537 > C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5538 > C The system gains extra energy.
5539 >               ecorr=ecorr+ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5540 >               if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5541 >      &            'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
5542 >               n_corr=n_corr+1
5543 >             else if (j1.eq.j) then
5544 > C Contacts I-J and I-(J+1) occur simultaneously.
5545 > C The system loses extra energy.
5546 > c             ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5547 >             endif
5548 >           enddo ! kk
5549 >           do kk=1,num_conti
5550 >             j1=jcont_hb(kk,i)
5551 > c           write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5552 > c    &         ' jj=',jj,' kk=',kk
5553 >             if (j1.eq.j+1) then
5554 > C Contacts I-J and (I+1)-J occur simultaneously.
5555 > C The system loses extra energy.
5556 > c             ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5557 >             endif ! j1==j+1
5558 >           enddo ! kk
5559 >         enddo ! jj
5560 >       enddo ! i
5561 >       return
5562 >       end
5563 > c------------------------------------------------------------------------------
5564 >       subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
5565 >      &  n_corr1)
5566 > C This subroutine calculates multi-body contributions to hydrogen-bonding
5567 >       implicit real*8 (a-h,o-z)
5568 >       include 'DIMENSIONS'
5569 >       include 'COMMON.IOUNITS'
5570 > #ifdef MPI
5571 >       include 'mpif.h'
5572 >       parameter (max_cont=maxconts)
5573 >       parameter (max_dim=2*(8*3+6))
5574 > c      parameter (msglen1=max_cont*max_dim*4)
5575 >       parameter (msglen1=max_cont*max_dim/2)
5576 >       parameter (msglen2=2*msglen1)
5577 >       integer source,CorrelType,CorrelID,Error
5578 >       double precision buffer(max_cont,max_dim)
5579 >       integer status(MPI_STATUS_SIZE)
5580 > #endif
5581 >       include 'COMMON.SETUP'
5582 >       include 'COMMON.FFIELD'
5583 >       include 'COMMON.DERIV'
5584 >       include 'COMMON.INTERACT'
5585 >       include 'COMMON.CONTACTS'
5586 >       include 'COMMON.CONTROL'
5587 >       double precision gx(3),gx1(3)
5588 >       logical lprn,ldone
5589 > C Set lprn=.true. for debugging
5590 >       lprn=.false.
5591 >       eturn6=0.0d0
5592 > #ifdef MPI
5593 >       n_corr=0
5594 >       n_corr1=0
5595 >       if (fgProcs.le.1) goto 30
5596 >       if (lprn) then
5597 >         write (iout,'(a)') 'Contact function values:'
5598 >         do i=nnt,nct-2
5599 >           write (iout,'(2i3,50(1x,i2,f5.2))')
5600 >      &    i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5601 >      &    j=1,num_cont_hb(i))
5602 >         enddo
5603 >       endif
5604 > C Caution! Following code assumes that electrostatic interactions concerning
5605 > C a given atom are split among at most two processors!
5606 >       CorrelType=477
5607 >       CorrelID=MyID+1
5608 >       ldone=.false.
5609 >       do i=1,max_cont
5610 >         do j=1,max_dim
5611 >           buffer(i,j)=0.0D0
5612 >         enddo
5613 >       enddo
5614 >       mm=mod(MyRank,2)
5615 > cd    write (iout,*) 'MyRank',MyRank,' mm',mm
5616 >       if (mm) 20,20,10
5617 >    10 continue
5618 > cd    write (iout,*) 'Sending: MyRank',MyRank,' mm',mm,' ldone',ldone
5619 >       if (MyRank.gt.0) then
5620 > C Send correlation contributions to the preceding processor
5621 >         msglen=msglen1
5622 >         nn=num_cont_hb(iatel_s)
5623 >         call pack_buffer(max_cont,max_dim,iatel_s,0,buffer)
5624 > cd      write (iout,*) 'The BUFFER array:'
5625 > cd      do i=1,nn
5626 > cd        write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,30)
5627 > cd      enddo
5628 >         if (ielstart(iatel_s).gt.iatel_s+ispp) then
5629 >           msglen=msglen2
5630 >             call pack_buffer(max_cont,max_dim,iatel_s+1,30,buffer)
5631 > C Clear the contacts of the atom passed to the neighboring processor
5632 >         nn=num_cont_hb(iatel_s+1)
5633 > cd      do i=1,nn
5634 > cd        write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j+30),j=1,30)
5635 > cd      enddo
5636 >             num_cont_hb(iatel_s)=0
5637 >         endif
5638 > cd      write (*,*) 'Processor ',fg_rank,MyRank,
5639 > cd   & ' is sending correlation contribution to processor',fg_rank-1,
5640 > cd   & ' msglen=',msglen
5641 > cd      write (*,*) 'Processor ',MyID,MyRank,
5642 > cd   & ' is sending correlation contribution to processor',fg_rank-1,
5643 > cd   & ' msglen=',msglen,' CorrelType=',CorrelType
5644 >         time00=MPI_Wtime()
5645 >         call MPI_Send(buffer,msglen,MPI_DOUBLE_PRECISION,fg_rank-1,
5646 >      &     CorrelType,FG_COMM,IERROR)
5647 >         time_sendrecv=time_sendrecv+MPI_Wtime()-time00
5648 > cd      write (*,*) 'Processor ',fg_rank,MyRank,
5649 > cd   & ' has sent correlation contribution to processor',fg_rank-1,
5650 > cd   & ' msglen=',msglen,' CorrelID=',CorrelID
5651 > cd      write (*,*) 'Processor ',fg_rank,
5652 > cd   & ' has sent correlation contribution to processor',fg_rank-1,
5653 > cd   & ' msglen=',msglen,' CorrelID=',CorrelID
5654 >         msglen=msglen1
5655 >       endif ! (MyRank.gt.0)
5656 >       if (ldone) goto 30
5657 >       ldone=.true.
5658 >    20 continue
5659 > cd    write (iout,*) 'Receiving: MyRank',MyRank,' mm',mm,' ldone',ldone
5660 >       if (fg_rank.lt.nfgtasks-1) then
5661 > C Receive correlation contributions from the next processor
5662 >         msglen=msglen1
5663 >         if (ielend(iatel_e).lt.nct-1) msglen=msglen2
5664 > cd      write (iout,*) 'Processor',fg_rank,
5665 > cd   & ' is receiving correlation contribution from processor',fg_rank+1,
5666 > cd   & ' msglen=',msglen,' CorrelType=',CorrelType
5667 > cd      write (*,*) 'Processor',fg_rank,
5668 > cd   & ' is receiving correlation contribution from processor',fg_rank+1,
5669 > cd   & ' msglen=',msglen,' CorrelType=',CorrelType
5670 >         time00=MPI_Wtime()
5671 >         nbytes=-1
5672 >         do while (nbytes.le.0)
5673 >           call MPI_Probe(fg_rank+1,CorrelType,FG_COMM,status,IERROR)
5674 >           call MPI_Get_count(status,MPI_DOUBLE_PRECISION,nbytes,IERROR)
5675 >         enddo
5676 > cd      print *,'Processor',MyID,' msglen',msglen,' nbytes',nbytes
5677 >         call MPI_Recv(buffer,nbytes,MPI_DOUBLE_PRECISION,
5678 >      &    fg_rank+1,CorrelType,status,IERROR)
5679 >         time_sendrecv=time_sendrecv+MPI_Wtime()-time00
5680 > cd      write (iout,*) 'Processor',fg_rank,
5681 > cd   & ' has received correlation contribution from processor',fg_rank+1,
5682 > cd   & ' msglen=',msglen,' nbytes=',nbytes
5683 > cd      write (iout,*) 'The received BUFFER array:'
5684 > cd      do i=1,max_cont
5685 > cd        write (iout,'(i2,9(3f8.3,2x))') i,(buffer(i,j),j=1,52)
5686 > cd      enddo
5687 >         if (msglen.eq.msglen1) then
5688 >           call unpack_buffer(max_cont,max_dim,iatel_e+1,0,buffer)
5689 >         else if (msglen.eq.msglen2)  then
5690 >           call unpack_buffer(max_cont,max_dim,iatel_e,0,buffer)
5691 >           call unpack_buffer(max_cont,max_dim,iatel_e+1,30,buffer)
5692 >         else
5693 >           write (iout,*)
5694 >      & 'ERROR!!!! message length changed while processing correlations.'
5695 >           write (*,*)
5696 >      & 'ERROR!!!! message length changed while processing correlations.'
5697 >           call MPI_Abort(MPI_COMM_WORLD,Error,IERROR)
5698 >         endif ! msglen.eq.msglen1
5699 >       endif ! fg_rank.lt.nfgtasks-1
5700 >       if (ldone) goto 30
5701 >       ldone=.true.
5702 >       goto 10
5703 >    30 continue
5704 > #endif
5705 >       if (lprn) then
5706 >         write (iout,'(a)') 'Contact function values:'
5707 >         do i=nnt,nct-2
5708 >           write (iout,'(2i3,50(1x,i2,f5.2))')
5709 >      &    i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5710 >      &    j=1,num_cont_hb(i))
5711 >         enddo
5712 >       endif
5713 >       ecorr=0.0D0
5714 >       ecorr5=0.0d0
5715 >       ecorr6=0.0d0
5716 > C Remove the loop below after debugging !!!
5717 >       do i=nnt,nct
5718 >         do j=1,3
5719 >           gradcorr(j,i)=0.0D0
5720 >           gradxorr(j,i)=0.0D0
5721 >         enddo
5722 >       enddo
5723 > C Calculate the dipole-dipole interaction energies
5724 >       if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
5725 >       do i=iatel_s,iatel_e+1
5726 >         num_conti=num_cont_hb(i)
5727 >         do jj=1,num_conti
5728 >           j=jcont_hb(jj,i)
5729 >           call dipole(i,j,jj)
5730 >         enddo
5731 >       enddo
5732 >       endif
5733 > C Calculate the local-electrostatic correlation terms
5734 >       do i=iatel_s,iatel_e+1
5735 >         i1=i+1
5736 >         num_conti=num_cont_hb(i)
5737 >         num_conti1=num_cont_hb(i+1)
5738 >         do jj=1,num_conti
5739 >           j=jcont_hb(jj,i)
5740 >           do kk=1,num_conti1
5741 >             j1=jcont_hb(kk,i1)
5742 > c            write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5743 > c     &         ' jj=',jj,' kk=',kk
5744 >             if (j1.eq.j+1 .or. j1.eq.j-1) then
5745 > C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
5746 > C The system gains extra energy.
5747 >               n_corr=n_corr+1
5748 >               sqd1=dsqrt(d_cont(jj,i))
5749 >               sqd2=dsqrt(d_cont(kk,i1))
5750 >               sred_geom = sqd1*sqd2
5751 >               IF (sred_geom.lt.cutoff_corr) THEN
5752 >                 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
5753 >      &            ekont,fprimcont)
5754 > cd               write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5755 > cd     &         ' jj=',jj,' kk=',kk
5756 >                 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
5757 >                 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
5758 >                 do l=1,3
5759 >                   g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
5760 >                   g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
5761 >                 enddo
5762 >                 n_corr1=n_corr1+1
5763 > cd               write (iout,*) 'sred_geom=',sred_geom,
5764 > cd     &          ' ekont=',ekont,' fprim=',fprimcont
5765 >                 call calc_eello(i,j,i+1,j1,jj,kk)
5766 >                 if (wcorr4.gt.0.0d0)
5767 >      &            ecorr=ecorr+eello4(i,j,i+1,j1,jj,kk)
5768 >                   if (energy_dec.and.wcorr4.gt.0.0d0)
5769 >      1                 write (iout,'(a6,2i5,0pf7.3)')
5770 >      2                'ecorr4',i,j,eello4(i,j,i+1,j1,jj,kk)
5771 >                 if (wcorr5.gt.0.0d0)
5772 >      &            ecorr5=ecorr5+eello5(i,j,i+1,j1,jj,kk)
5773 >                   if (energy_dec.and.wcorr5.gt.0.0d0)
5774 >      1                 write (iout,'(a6,2i5,0pf7.3)')
5775 >      2                'ecorr5',i,j,eello5(i,j,i+1,j1,jj,kk)
5776 > cd                write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
5777 > cd                write(2,*)'ijkl',i,j,i+1,j1
5778 >                 if (wcorr6.gt.0.0d0 .and. (j.ne.i+4 .or. j1.ne.i+3
5779 >      &               .or. wturn6.eq.0.0d0))then
5780 > cd                  write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
5781 >                   ecorr6=ecorr6+eello6(i,j,i+1,j1,jj,kk)
5782 >                   if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5783 >      1                'ecorr6',i,j,eello6(i,j,i+1,j1,jj,kk)
5784 > cd                write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
5785 > cd     &            'ecorr6=',ecorr6
5786 > cd                write (iout,'(4e15.5)') sred_geom,
5787 > cd     &          dabs(eello4(i,j,i+1,j1,jj,kk)),
5788 > cd     &          dabs(eello5(i,j,i+1,j1,jj,kk)),
5789 > cd     &          dabs(eello6(i,j,i+1,j1,jj,kk))
5790 >                 else if (wturn6.gt.0.0d0
5791 >      &            .and. (j.eq.i+4 .and. j1.eq.i+3)) then
5792 > cd                  write (iout,*) '******eturn6: i,j,i+1,j1',i,j,i+1,j1
5793 >                   eturn6=eturn6+eello_turn6(i,jj,kk)
5794 >                   if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5795 >      1                 'eturn6',i,j,eello_turn6(i,jj,kk)
5796 > cd                  write (2,*) 'multibody_eello:eturn6',eturn6
5797 >                 endif
5798 >               ENDIF
5799 > 1111          continue
5800 >             else if (j1.eq.j) then
5801 > C Contacts I-J and I-(J+1) occur simultaneously.
5802 > C The system loses extra energy.
5803 > c             ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
5804 >             endif
5805 >           enddo ! kk
5806 >           do kk=1,num_conti
5807 >             j1=jcont_hb(kk,i)
5808 > c           write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5809 > c    &         ' jj=',jj,' kk=',kk
5810 >             if (j1.eq.j+1) then
5811 > C Contacts I-J and (I+1)-J occur simultaneously.
5812 > C The system loses extra energy.
5813 > c             ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
5814 >             endif ! j1==j+1
5815 >           enddo ! kk
5816 >         enddo ! jj
5817 >       enddo ! i
5818 >       return
5819 >       end
5820 > c------------------------------------------------------------------------------
5821 >       double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
5822 >       implicit real*8 (a-h,o-z)
5823 >       include 'DIMENSIONS'
5824 >       include 'COMMON.IOUNITS'
5825 >       include 'COMMON.DERIV'
5826 >       include 'COMMON.INTERACT'
5827 >       include 'COMMON.CONTACTS'
5828 >       double precision gx(3),gx1(3)
5829 >       logical lprn
5830 >       lprn=.false.
5831 >       eij=facont_hb(jj,i)
5832 >       ekl=facont_hb(kk,k)
5833 >       ees0pij=ees0p(jj,i)
5834 >       ees0pkl=ees0p(kk,k)
5835 >       ees0mij=ees0m(jj,i)
5836 >       ees0mkl=ees0m(kk,k)
5837 >       ekont=eij*ekl
5838 >       ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
5839 > cd    ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
5840 > C Following 4 lines for diagnostics.
5841 > cd    ees0pkl=0.0D0
5842 > cd    ees0pij=1.0D0
5843 > cd    ees0mkl=0.0D0
5844 > cd    ees0mij=1.0D0
5845 > c     write (iout,*)'Contacts have occurred for peptide groups',i,j,
5846 > c    &   ' and',k,l
5847 > c     write (iout,*)'Contacts have occurred for peptide groups',
5848 > c    &  i,j,' fcont:',eij,' eij',' eesij',ees0pij,ees0mij,' and ',k,l
5849 > c    & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' ees=',ees
5850 > C Calculate the multi-body contribution to energy.
5851 >       ecorr=ecorr+ekont*ees
5852 > C Calculate multi-body contributions to the gradient.
5853 >       do ll=1,3
5854 >         ghalf=0.5D0*ees*ekl*gacont_hbr(ll,jj,i)
5855 >         gradcorr(ll,i)=gradcorr(ll,i)+ghalf
5856 >      &  -ekont*(coeffp*ees0pkl*gacontp_hb1(ll,jj,i)+
5857 >      &  coeffm*ees0mkl*gacontm_hb1(ll,jj,i))
5858 >         gradcorr(ll,j)=gradcorr(ll,j)+ghalf
5859 >      &  -ekont*(coeffp*ees0pkl*gacontp_hb2(ll,jj,i)+
5860 >      &  coeffm*ees0mkl*gacontm_hb2(ll,jj,i))
5861 >         ghalf=0.5D0*ees*eij*gacont_hbr(ll,kk,k)
5862 >         gradcorr(ll,k)=gradcorr(ll,k)+ghalf
5863 >      &  -ekont*(coeffp*ees0pij*gacontp_hb1(ll,kk,k)+
5864 >      &  coeffm*ees0mij*gacontm_hb1(ll,kk,k))
5865 >         gradcorr(ll,l)=gradcorr(ll,l)+ghalf
5866 >      &  -ekont*(coeffp*ees0pij*gacontp_hb2(ll,kk,k)+
5867 >      &  coeffm*ees0mij*gacontm_hb2(ll,kk,k))
5868 >       enddo
5869 >       do m=i+1,j-1
5870 >         do ll=1,3
5871 >           gradcorr(ll,m)=gradcorr(ll,m)+
5872 >      &     ees*ekl*gacont_hbr(ll,jj,i)-
5873 >      &     ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
5874 >      &     coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
5875 >         enddo
5876 >       enddo
5877 >       do m=k+1,l-1
5878 >         do ll=1,3
5879 >           gradcorr(ll,m)=gradcorr(ll,m)+
5880 >      &     ees*eij*gacont_hbr(ll,kk,k)-
5881 >      &     ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
5882 >      &     coeffm*ees0mij*gacontm_hb3(ll,kk,k))
5883 >         enddo
5884 >       enddo
5885 >       ehbcorr=ekont*ees
5886 >       return
5887 >       end
5888 > C---------------------------------------------------------------------------
5889 >       subroutine dipole(i,j,jj)
5890 >       implicit real*8 (a-h,o-z)
5891 >       include 'DIMENSIONS'
5892 >       include 'COMMON.IOUNITS'
5893 >       include 'COMMON.CHAIN'
5894 >       include 'COMMON.FFIELD'
5895 >       include 'COMMON.DERIV'
5896 >       include 'COMMON.INTERACT'
5897 >       include 'COMMON.CONTACTS'
5898 >       include 'COMMON.TORSION'
5899 >       include 'COMMON.VAR'
5900 >       include 'COMMON.GEO'
5901 >       dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
5902 >      &  auxmat(2,2)
5903 >       iti1 = itortyp(itype(i+1))
5904 >       if (j.lt.nres-1) then
5905 >         itj1 = itortyp(itype(j+1))
5906 >       else
5907 >         itj1=ntortyp+1
5908 >       endif
5909 >       do iii=1,2
5910 >         dipi(iii,1)=Ub2(iii,i)
5911 >         dipderi(iii)=Ub2der(iii,i)
5912 >         dipi(iii,2)=b1(iii,iti1)
5913 >         dipj(iii,1)=Ub2(iii,j)
5914 >         dipderj(iii)=Ub2der(iii,j)
5915 >         dipj(iii,2)=b1(iii,itj1)
5916 >       enddo
5917 >       kkk=0
5918 >       do iii=1,2
5919 >         call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
5920 >         do jjj=1,2
5921 >           kkk=kkk+1
5922 >           dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5923 >         enddo
5924 >       enddo
5925 >       do kkk=1,5
5926 >         do lll=1,3
5927 >           mmm=0
5928 >           do iii=1,2
5929 >             call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
5930 >      &        auxvec(1))
5931 >             do jjj=1,2
5932 >               mmm=mmm+1
5933 >               dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
5934 >             enddo
5935 >           enddo
5936 >         enddo
5937 >       enddo
5938 >       call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
5939 >       call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
5940 >       do iii=1,2
5941 >         dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
5942 >       enddo
5943 >       call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
5944 >       do iii=1,2
5945 >         dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
5946 >       enddo
5947 >       return
5948 >       end
5949 > C---------------------------------------------------------------------------
5950 >       subroutine calc_eello(i,j,k,l,jj,kk)
5951 > C
5952 > C This subroutine computes matrices and vectors needed to calculate
5953 > C the fourth-, fifth-, and sixth-order local-electrostatic terms.
5954 > C
5955 >       implicit real*8 (a-h,o-z)
5956 >       include 'DIMENSIONS'
5957 >       include 'COMMON.IOUNITS'
5958 >       include 'COMMON.CHAIN'
5959 >       include 'COMMON.DERIV'
5960 >       include 'COMMON.INTERACT'
5961 >       include 'COMMON.CONTACTS'
5962 >       include 'COMMON.TORSION'
5963 >       include 'COMMON.VAR'
5964 >       include 'COMMON.GEO'
5965 >       include 'COMMON.FFIELD'
5966 >       double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
5967 >      &  aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
5968 >       logical lprn
5969 >       common /kutas/ lprn
5970 > cd      write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
5971 > cd     & ' jj=',jj,' kk=',kk
5972 > cd      if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
5973 >       do iii=1,2
5974 >         do jjj=1,2
5975 >           aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
5976 >           aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
5977 >         enddo
5978 >       enddo
5979 >       call transpose2(aa1(1,1),aa1t(1,1))
5980 >       call transpose2(aa2(1,1),aa2t(1,1))
5981 >       do kkk=1,5
5982 >         do lll=1,3
5983 >           call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
5984 >      &      aa1tder(1,1,lll,kkk))
5985 >           call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
5986 >      &      aa2tder(1,1,lll,kkk))
5987 >         enddo
5988 >       enddo
5989 >       if (l.eq.j+1) then
5990 > C parallel orientation of the two CA-CA-CA frames.
5991 >         if (i.gt.1) then
5992 >           iti=itortyp(itype(i))
5993 >         else
5994 >           iti=ntortyp+1
5995 >         endif
5996 >         itk1=itortyp(itype(k+1))
5997 >         itj=itortyp(itype(j))
5998 >         if (l.lt.nres-1) then
5999 >           itl1=itortyp(itype(l+1))
6000 >         else
6001 >           itl1=ntortyp+1
6002 >         endif
6003 > C A1 kernel(j+1) A2T
6004 > cd        do iii=1,2
6005 > cd          write (iout,'(3f10.5,5x,3f10.5)')
6006 > cd     &     (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6007 > cd        enddo
6008 >         call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6009 >      &   aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6010 >      &   AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6011 > C Following matrices are needed only for 6-th order cumulants
6012 >         IF (wcorr6.gt.0.0d0) THEN
6013 >         call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6014 >      &   aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6015 >      &   AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6016 >         call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6017 >      &   aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6018 >      &   Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6019 >      &   ADtEAderx(1,1,1,1,1,1))
6020 >         lprn=.false.
6021 >         call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6022 >      &   aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6023 >      &   DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6024 >      &   ADtEA1derx(1,1,1,1,1,1))
6025 >         ENDIF
6026 > C End 6-th order cumulants
6027 > cd        lprn=.false.
6028 > cd        if (lprn) then
6029 > cd        write (2,*) 'In calc_eello6'
6030 > cd        do iii=1,2
6031 > cd          write (2,*) 'iii=',iii
6032 > cd          do kkk=1,5
6033 > cd            write (2,*) 'kkk=',kkk
6034 > cd            do jjj=1,2
6035 > cd              write (2,'(3(2f10.5),5x)')
6036 > cd     &        ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6037 > cd            enddo
6038 > cd          enddo
6039 > cd        enddo
6040 > cd        endif
6041 >         call transpose2(EUgder(1,1,k),auxmat(1,1))
6042 >         call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6043 >         call transpose2(EUg(1,1,k),auxmat(1,1))
6044 >         call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6045 >         call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6046 >         do iii=1,2
6047 >           do kkk=1,5
6048 >             do lll=1,3
6049 >               call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6050 >      &          EAEAderx(1,1,lll,kkk,iii,1))
6051 >             enddo
6052 >           enddo
6053 >         enddo
6054 > C A1T kernel(i+1) A2
6055 >         call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6056 >      &   a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6057 >      &   AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6058 > C Following matrices are needed only for 6-th order cumulants
6059 >         IF (wcorr6.gt.0.0d0) THEN
6060 >         call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6061 >      &   a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6062 >      &   AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6063 >         call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6064 >      &   a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6065 >      &   Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6066 >      &   ADtEAderx(1,1,1,1,1,2))
6067 >         call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6068 >      &   a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6069 >      &   DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6070 >      &   ADtEA1derx(1,1,1,1,1,2))
6071 >         ENDIF
6072 > C End 6-th order cumulants
6073 >         call transpose2(EUgder(1,1,l),auxmat(1,1))
6074 >         call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6075 >         call transpose2(EUg(1,1,l),auxmat(1,1))
6076 >         call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6077 >         call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6078 >         do iii=1,2
6079 >           do kkk=1,5
6080 >             do lll=1,3
6081 >               call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6082 >      &          EAEAderx(1,1,lll,kkk,iii,2))
6083 >             enddo
6084 >           enddo
6085 >         enddo
6086 > C AEAb1 and AEAb2
6087 > C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6088 > C They are needed only when the fifth- or the sixth-order cumulants are
6089 > C indluded.
6090 >         IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6091 >         call transpose2(AEA(1,1,1),auxmat(1,1))
6092 >         call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6093 >         call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6094 >         call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6095 >         call transpose2(AEAderg(1,1,1),auxmat(1,1))
6096 >         call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6097 >         call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6098 >         call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6099 >         call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6100 >         call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6101 >         call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6102 >         call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6103 >         call transpose2(AEA(1,1,2),auxmat(1,1))
6104 >         call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6105 >         call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6106 >         call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6107 >         call transpose2(AEAderg(1,1,2),auxmat(1,1))
6108 >         call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6109 >         call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6110 >         call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6111 >         call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6112 >         call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6113 >         call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6114 >         call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6115 > C Calculate the Cartesian derivatives of the vectors.
6116 >         do iii=1,2
6117 >           do kkk=1,5
6118 >             do lll=1,3
6119 >               call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6120 >               call matvec2(auxmat(1,1),b1(1,iti),
6121 >      &          AEAb1derx(1,lll,kkk,iii,1,1))
6122 >               call matvec2(auxmat(1,1),Ub2(1,i),
6123 >      &          AEAb2derx(1,lll,kkk,iii,1,1))
6124 >               call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6125 >      &          AEAb1derx(1,lll,kkk,iii,2,1))
6126 >               call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6127 >      &          AEAb2derx(1,lll,kkk,iii,2,1))
6128 >               call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6129 >               call matvec2(auxmat(1,1),b1(1,itj),
6130 >      &          AEAb1derx(1,lll,kkk,iii,1,2))
6131 >               call matvec2(auxmat(1,1),Ub2(1,j),
6132 >      &          AEAb2derx(1,lll,kkk,iii,1,2))
6133 >               call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6134 >      &          AEAb1derx(1,lll,kkk,iii,2,2))
6135 >               call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6136 >      &          AEAb2derx(1,lll,kkk,iii,2,2))
6137 >             enddo
6138 >           enddo
6139 >         enddo
6140 >         ENDIF
6141 > C End vectors
6142 >       else
6143 > C Antiparallel orientation of the two CA-CA-CA frames.
6144 >         if (i.gt.1) then
6145 >           iti=itortyp(itype(i))
6146 >         else
6147 >           iti=ntortyp+1
6148 >         endif
6149 >         itk1=itortyp(itype(k+1))
6150 >         itl=itortyp(itype(l))
6151 >         itj=itortyp(itype(j))
6152 >         if (j.lt.nres-1) then
6153 >           itj1=itortyp(itype(j+1))
6154 >         else
6155 >           itj1=ntortyp+1
6156 >         endif
6157 > C A2 kernel(j-1)T A1T
6158 >         call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6159 >      &   aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6160 >      &   AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6161 > C Following matrices are needed only for 6-th order cumulants
6162 >         IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6163 >      &     j.eq.i+4 .and. l.eq.i+3)) THEN
6164 >         call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6165 >      &   aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6166 >      &   AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6167 >         call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6168 >      &   aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
6169 >      &   Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6170 >      &   ADtEAderx(1,1,1,1,1,1))
6171 >         call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6172 >      &   aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
6173 >      &   DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6174 >      &   ADtEA1derx(1,1,1,1,1,1))
6175 >         ENDIF
6176 > C End 6-th order cumulants
6177 >         call transpose2(EUgder(1,1,k),auxmat(1,1))
6178 >         call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6179 >         call transpose2(EUg(1,1,k),auxmat(1,1))
6180 >         call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6181 >         call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6182 >         do iii=1,2
6183 >           do kkk=1,5
6184 >             do lll=1,3
6185 >               call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6186 >      &          EAEAderx(1,1,lll,kkk,iii,1))
6187 >             enddo
6188 >           enddo
6189 >         enddo
6190 > C A2T kernel(i+1)T A1
6191 >         call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6192 >      &   a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
6193 >      &   AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6194 > C Following matrices are needed only for 6-th order cumulants
6195 >         IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6196 >      &     j.eq.i+4 .and. l.eq.i+3)) THEN
6197 >         call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6198 >      &   a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
6199 >      &   AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6200 >         call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6201 >      &   a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
6202 >      &   Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6203 >      &   ADtEAderx(1,1,1,1,1,2))
6204 >         call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
6205 >      &   a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
6206 >      &   DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6207 >      &   ADtEA1derx(1,1,1,1,1,2))
6208 >         ENDIF
6209 > C End 6-th order cumulants
6210 >         call transpose2(EUgder(1,1,j),auxmat(1,1))
6211 >         call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
6212 >         call transpose2(EUg(1,1,j),auxmat(1,1))
6213 >         call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6214 >         call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6215 >         do iii=1,2
6216 >           do kkk=1,5
6217 >             do lll=1,3
6218 >               call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6219 >      &          EAEAderx(1,1,lll,kkk,iii,2))
6220 >             enddo
6221 >           enddo
6222 >         enddo
6223 > C AEAb1 and AEAb2
6224 > C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6225 > C They are needed only when the fifth- or the sixth-order cumulants are
6226 > C indluded.
6227 >         IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
6228 >      &    (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
6229 >         call transpose2(AEA(1,1,1),auxmat(1,1))
6230 >         call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6231 >         call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6232 >         call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6233 >         call transpose2(AEAderg(1,1,1),auxmat(1,1))
6234 >         call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6235 >         call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6236 >         call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6237 >         call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6238 >         call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6239 >         call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6240 >         call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6241 >         call transpose2(AEA(1,1,2),auxmat(1,1))
6242 >         call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
6243 >         call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
6244 >         call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
6245 >         call transpose2(AEAderg(1,1,2),auxmat(1,1))
6246 >         call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
6247 >         call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
6248 >         call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
6249 >         call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
6250 >         call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
6251 >         call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
6252 >         call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
6253 > C Calculate the Cartesian derivatives of the vectors.
6254 >         do iii=1,2
6255 >           do kkk=1,5
6256 >             do lll=1,3
6257 >               call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6258 >               call matvec2(auxmat(1,1),b1(1,iti),
6259 >      &          AEAb1derx(1,lll,kkk,iii,1,1))
6260 >               call matvec2(auxmat(1,1),Ub2(1,i),
6261 >      &          AEAb2derx(1,lll,kkk,iii,1,1))
6262 >               call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6263 >      &          AEAb1derx(1,lll,kkk,iii,2,1))
6264 >               call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6265 >      &          AEAb2derx(1,lll,kkk,iii,2,1))
6266 >               call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6267 >               call matvec2(auxmat(1,1),b1(1,itl),
6268 >      &          AEAb1derx(1,lll,kkk,iii,1,2))
6269 >               call matvec2(auxmat(1,1),Ub2(1,l),
6270 >      &          AEAb2derx(1,lll,kkk,iii,1,2))
6271 >               call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
6272 >      &          AEAb1derx(1,lll,kkk,iii,2,2))
6273 >               call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
6274 >      &          AEAb2derx(1,lll,kkk,iii,2,2))
6275 >             enddo
6276 >           enddo
6277 >         enddo
6278 >         ENDIF
6279 > C End vectors
6280 >       endif
6281 >       return
6282 >       end
6283 > C---------------------------------------------------------------------------
6284 >       subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
6285 >      &  KK,KKderg,AKA,AKAderg,AKAderx)
6286 >       implicit none
6287 >       integer nderg
6288 >       logical transp
6289 >       double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
6290 >      &  aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
6291 >      &  AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
6292 >       integer iii,kkk,lll
6293 >       integer jjj,mmm
6294 >       logical lprn
6295 >       common /kutas/ lprn
6296 >       call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
6297 >       do iii=1,nderg
6298 >         call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
6299 >      &    AKAderg(1,1,iii))
6300 >       enddo
6301 > cd      if (lprn) write (2,*) 'In kernel'
6302 >       do kkk=1,5
6303 > cd        if (lprn) write (2,*) 'kkk=',kkk
6304 >         do lll=1,3
6305 >           call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
6306 >      &      KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
6307 > cd          if (lprn) then
6308 > cd            write (2,*) 'lll=',lll
6309 > cd            write (2,*) 'iii=1'
6310 > cd            do jjj=1,2
6311 > cd              write (2,'(3(2f10.5),5x)')
6312 > cd     &        (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
6313 > cd            enddo
6314 > cd          endif
6315 >           call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
6316 >      &      KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
6317 > cd          if (lprn) then
6318 > cd            write (2,*) 'lll=',lll
6319 > cd            write (2,*) 'iii=2'
6320 > cd            do jjj=1,2
6321 > cd              write (2,'(3(2f10.5),5x)')
6322 > cd     &        (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
6323 > cd            enddo
6324 > cd          endif
6325 >         enddo
6326 >       enddo
6327 >       return
6328 >       end
6329 > C---------------------------------------------------------------------------
6330 >       double precision function eello4(i,j,k,l,jj,kk)
6331 >       implicit real*8 (a-h,o-z)
6332 >       include 'DIMENSIONS'
6333 >       include 'COMMON.IOUNITS'
6334 >       include 'COMMON.CHAIN'
6335 >       include 'COMMON.DERIV'
6336 >       include 'COMMON.INTERACT'
6337 >       include 'COMMON.CONTACTS'
6338 >       include 'COMMON.TORSION'
6339 >       include 'COMMON.VAR'
6340 >       include 'COMMON.GEO'
6341 >       double precision pizda(2,2),ggg1(3),ggg2(3)
6342 > cd      if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
6343 > cd        eello4=0.0d0
6344 > cd        return
6345 > cd      endif
6346 > cd      print *,'eello4:',i,j,k,l,jj,kk
6347 > cd      write (2,*) 'i',i,' j',j,' k',k,' l',l
6348 > cd      call checkint4(i,j,k,l,jj,kk,eel4_num)
6349 > cold      eij=facont_hb(jj,i)
6350 > cold      ekl=facont_hb(kk,k)
6351 > cold      ekont=eij*ekl
6352 >       eel4=-EAEA(1,1,1)-EAEA(2,2,1)
6353 > cd      eel41=-EAEA(1,1,2)-EAEA(2,2,2)
6354 >       gcorr_loc(k-1)=gcorr_loc(k-1)
6355 >      &   -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
6356 >       if (l.eq.j+1) then
6357 >         gcorr_loc(l-1)=gcorr_loc(l-1)
6358 >      &     -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6359 >       else
6360 >         gcorr_loc(j-1)=gcorr_loc(j-1)
6361 >      &     -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
6362 >       endif
6363 >       do iii=1,2
6364 >         do kkk=1,5
6365 >           do lll=1,3
6366 >             derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
6367 >      &                        -EAEAderx(2,2,lll,kkk,iii,1)
6368 > cd            derx(lll,kkk,iii)=0.0d0
6369 >           enddo
6370 >         enddo
6371 >       enddo
6372 > cd      gcorr_loc(l-1)=0.0d0
6373 > cd      gcorr_loc(j-1)=0.0d0
6374 > cd      gcorr_loc(k-1)=0.0d0
6375 > cd      eel4=1.0d0
6376 > cd      write (iout,*)'Contacts have occurred for peptide groups',
6377 > cd     &  i,j,' fcont:',eij,' eij',' and ',k,l,
6378 > cd     &  ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
6379 >       if (j.lt.nres-1) then
6380 >         j1=j+1
6381 >         j2=j-1
6382 >       else
6383 >         j1=j-1
6384 >         j2=j-2
6385 >       endif
6386 >       if (l.lt.nres-1) then
6387 >         l1=l+1
6388 >         l2=l-1
6389 >       else
6390 >         l1=l-1
6391 >         l2=l-2
6392 >       endif
6393 >       do ll=1,3
6394 > cold        ghalf=0.5d0*eel4*ekl*gacont_hbr(ll,jj,i)
6395 >         ggg1(ll)=eel4*g_contij(ll,1)
6396 >         ggg2(ll)=eel4*g_contij(ll,2)
6397 >         ghalf=0.5d0*ggg1(ll)
6398 > cd        ghalf=0.0d0
6399 >         gradcorr(ll,i)=gradcorr(ll,i)+ghalf+ekont*derx(ll,2,1)
6400 >         gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
6401 >         gradcorr(ll,j)=gradcorr(ll,j)+ghalf+ekont*derx(ll,4,1)
6402 >         gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
6403 > cold        ghalf=0.5d0*eel4*eij*gacont_hbr(ll,kk,k)
6404 >         ghalf=0.5d0*ggg2(ll)
6405 > cd        ghalf=0.0d0
6406 >         gradcorr(ll,k)=gradcorr(ll,k)+ghalf+ekont*derx(ll,2,2)
6407 >         gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
6408 >         gradcorr(ll,l)=gradcorr(ll,l)+ghalf+ekont*derx(ll,4,2)
6409 >         gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
6410 >       enddo
6411 > cd      goto 1112
6412 >       do m=i+1,j-1
6413 >         do ll=1,3
6414 > cold          gradcorr(ll,m)=gradcorr(ll,m)+eel4*ekl*gacont_hbr(ll,jj,i)
6415 >           gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
6416 >         enddo
6417 >       enddo
6418 >       do m=k+1,l-1
6419 >         do ll=1,3
6420 > cold          gradcorr(ll,m)=gradcorr(ll,m)+eel4*eij*gacont_hbr(ll,kk,k)
6421 >           gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
6422 >         enddo
6423 >       enddo
6424 > 1112  continue
6425 >       do m=i+2,j2
6426 >         do ll=1,3
6427 >           gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
6428 >         enddo
6429 >       enddo
6430 >       do m=k+2,l2
6431 >         do ll=1,3
6432 >           gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
6433 >         enddo
6434 >       enddo
6435 > cd      do iii=1,nres-3
6436 > cd        write (2,*) iii,gcorr_loc(iii)
6437 > cd      enddo
6438 >       eello4=ekont*eel4
6439 > cd      write (2,*) 'ekont',ekont
6440 > cd      write (iout,*) 'eello4',ekont*eel4
6441 >       return
6442 >       end
6443 > C---------------------------------------------------------------------------
6444 >       double precision function eello5(i,j,k,l,jj,kk)
6445 >       implicit real*8 (a-h,o-z)
6446 >       include 'DIMENSIONS'
6447 >       include 'COMMON.IOUNITS'
6448 >       include 'COMMON.CHAIN'
6449 >       include 'COMMON.DERIV'
6450 >       include 'COMMON.INTERACT'
6451 >       include 'COMMON.CONTACTS'
6452 >       include 'COMMON.TORSION'
6453 >       include 'COMMON.VAR'
6454 >       include 'COMMON.GEO'
6455 >       double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
6456 >       double precision ggg1(3),ggg2(3)
6457 > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6458 > C                                                                              C
6459 > C                            Parallel chains                                   C
6460 > C                                                                              C
6461 > C          o             o                   o             o                   C
6462 > C         /l\           / \             \   / \           / \   /              C
6463 > C        /   \         /   \             \ /   \         /   \ /               C
6464 > C       j| o |l1       | o |            o| o |         | o |o                C
6465 > C     \  |/k\|         |/ \|  /            |/ \|         |/ \|                 C
6466 > C      \i/   \         /   \ /             /   \         /   \                 C
6467 > C       o    k1             o                                                  C
6468 > C         (I)          (II)                (III)          (IV)                 C
6469 > C                                                                              C
6470 > C      eello5_1        eello5_2            eello5_3       eello5_4             C
6471 > C                                                                              C
6472 > C                            Antiparallel chains                               C
6473 > C                                                                              C
6474 > C          o             o                   o             o                   C
6475 > C         /j\           / \             \   / \           / \   /              C
6476 > C        /   \         /   \             \ /   \         /   \ /               C
6477 > C      j1| o |l        | o |            o| o |         | o |o                C
6478 > C     \  |/k\|         |/ \|  /            |/ \|         |/ \|                 C
6479 > C      \i/   \         /   \ /             /   \         /   \                 C
6480 > C       o     k1            o                                                  C
6481 > C         (I)          (II)                (III)          (IV)                 C
6482 > C                                                                              C
6483 > C      eello5_1        eello5_2            eello5_3       eello5_4             C
6484 > C                                                                              C
6485 > C o denotes a local interaction, vertical lines an electrostatic interaction.  C
6486 > C                                                                              C
6487 > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6488 > cd      if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
6489 > cd        eello5=0.0d0
6490 > cd        return
6491 > cd      endif
6492 > cd      write (iout,*)
6493 > cd     &   'EELLO5: Contacts have occurred for peptide groups',i,j,
6494 > cd     &   ' and',k,l
6495 >       itk=itortyp(itype(k))
6496 >       itl=itortyp(itype(l))
6497 >       itj=itortyp(itype(j))
6498 >       eello5_1=0.0d0
6499 >       eello5_2=0.0d0
6500 >       eello5_3=0.0d0
6501 >       eello5_4=0.0d0
6502 > cd      call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
6503 > cd     &   eel5_3_num,eel5_4_num)
6504 >       do iii=1,2
6505 >         do kkk=1,5
6506 >           do lll=1,3
6507 >             derx(lll,kkk,iii)=0.0d0
6508 >           enddo
6509 >         enddo
6510 >       enddo
6511 > cd      eij=facont_hb(jj,i)
6512 > cd      ekl=facont_hb(kk,k)
6513 > cd      ekont=eij*ekl
6514 > cd      write (iout,*)'Contacts have occurred for peptide groups',
6515 > cd     &  i,j,' fcont:',eij,' eij',' and ',k,l
6516 > cd      goto 1111
6517 > C Contribution from the graph I.
6518 > cd      write (2,*) 'AEA  ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
6519 > cd      write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
6520 >       call transpose2(EUg(1,1,k),auxmat(1,1))
6521 >       call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
6522 >       vv(1)=pizda(1,1)-pizda(2,2)
6523 >       vv(2)=pizda(1,2)+pizda(2,1)
6524 >       eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
6525 >      & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6526 > C Explicit gradient in virtual-dihedral angles.
6527 >       if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
6528 >      & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
6529 >      & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
6530 >       call transpose2(EUgder(1,1,k),auxmat1(1,1))
6531 >       call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
6532 >       vv(1)=pizda(1,1)-pizda(2,2)
6533 >       vv(2)=pizda(1,2)+pizda(2,1)
6534 >       g_corr5_loc(k-1)=g_corr5_loc(k-1)
6535 >      & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
6536 >      & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6537 >       call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
6538 >       vv(1)=pizda(1,1)-pizda(2,2)
6539 >       vv(2)=pizda(1,2)+pizda(2,1)
6540 >       if (l.eq.j+1) then
6541 >         if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
6542 >      &   +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6543 >      &   +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6544 >       else
6545 >         if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
6546 >      &   +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
6547 >      &   +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
6548 >       endif
6549 > C Cartesian gradient
6550 >       do iii=1,2
6551 >         do kkk=1,5
6552 >           do lll=1,3
6553 >             call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
6554 >      &        pizda(1,1))
6555 >             vv(1)=pizda(1,1)-pizda(2,2)
6556 >             vv(2)=pizda(1,2)+pizda(2,1)
6557 >             derx(lll,kkk,iii)=derx(lll,kkk,iii)
6558 >      &       +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
6559 >      &       +0.5d0*scalar2(vv(1),Dtobr2(1,i))
6560 >           enddo
6561 >         enddo
6562 >       enddo
6563 > c      goto 1112
6564 > c1111  continue
6565 > C Contribution from graph II
6566 >       call transpose2(EE(1,1,itk),auxmat(1,1))
6567 >       call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
6568 >       vv(1)=pizda(1,1)+pizda(2,2)
6569 >       vv(2)=pizda(2,1)-pizda(1,2)
6570 >       eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
6571 >      & -0.5d0*scalar2(vv(1),Ctobr(1,k))
6572 > C Explicit gradient in virtual-dihedral angles.
6573 >       g_corr5_loc(k-1)=g_corr5_loc(k-1)
6574 >      & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
6575 >       call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
6576 >       vv(1)=pizda(1,1)+pizda(2,2)
6577 >       vv(2)=pizda(2,1)-pizda(1,2)
6578 >       if (l.eq.j+1) then
6579 >         g_corr5_loc(l-1)=g_corr5_loc(l-1)
6580 >      &   +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6581 >      &   -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6582 >       else
6583 >         g_corr5_loc(j-1)=g_corr5_loc(j-1)
6584 >      &   +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
6585 >      &   -0.5d0*scalar2(vv(1),Ctobr(1,k)))
6586 >       endif
6587 > C Cartesian gradient
6588 >       do iii=1,2
6589 >         do kkk=1,5
6590 >           do lll=1,3
6591 >             call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6592 >      &        pizda(1,1))
6593 >             vv(1)=pizda(1,1)+pizda(2,2)
6594 >             vv(2)=pizda(2,1)-pizda(1,2)
6595 >             derx(lll,kkk,iii)=derx(lll,kkk,iii)
6596 >      &       +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
6597 >      &       -0.5d0*scalar2(vv(1),Ctobr(1,k))
6598 >           enddo
6599 >         enddo
6600 >       enddo
6601 > cd      goto 1112
6602 > cd1111  continue
6603 >       if (l.eq.j+1) then
6604 > cd        goto 1110
6605 > C Parallel orientation
6606 > C Contribution from graph III
6607 >         call transpose2(EUg(1,1,l),auxmat(1,1))
6608 >         call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6609 >         vv(1)=pizda(1,1)-pizda(2,2)
6610 >         vv(2)=pizda(1,2)+pizda(2,1)
6611 >         eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
6612 >      &   +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6613 > C Explicit gradient in virtual-dihedral angles.
6614 >         g_corr5_loc(j-1)=g_corr5_loc(j-1)
6615 >      &   +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
6616 >      &   +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
6617 >         call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6618 >         vv(1)=pizda(1,1)-pizda(2,2)
6619 >         vv(2)=pizda(1,2)+pizda(2,1)
6620 >         g_corr5_loc(k-1)=g_corr5_loc(k-1)
6621 >      &   +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
6622 >      &   +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6623 >         call transpose2(EUgder(1,1,l),auxmat1(1,1))
6624 >         call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6625 >         vv(1)=pizda(1,1)-pizda(2,2)
6626 >         vv(2)=pizda(1,2)+pizda(2,1)
6627 >         g_corr5_loc(l-1)=g_corr5_loc(l-1)
6628 >      &   +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
6629 >      &   +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
6630 > C Cartesian gradient
6631 >         do iii=1,2
6632 >           do kkk=1,5
6633 >             do lll=1,3
6634 >               call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6635 >      &          pizda(1,1))
6636 >               vv(1)=pizda(1,1)-pizda(2,2)
6637 >               vv(2)=pizda(1,2)+pizda(2,1)
6638 >               derx(lll,kkk,iii)=derx(lll,kkk,iii)
6639 >      &         +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
6640 >      &         +0.5d0*scalar2(vv(1),Dtobr2(1,j))
6641 >             enddo
6642 >           enddo
6643 >         enddo
6644 > cd        goto 1112
6645 > C Contribution from graph IV
6646 > cd1110    continue
6647 >         call transpose2(EE(1,1,itl),auxmat(1,1))
6648 >         call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6649 >         vv(1)=pizda(1,1)+pizda(2,2)
6650 >         vv(2)=pizda(2,1)-pizda(1,2)
6651 >         eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
6652 >      &   -0.5d0*scalar2(vv(1),Ctobr(1,l))
6653 > C Explicit gradient in virtual-dihedral angles.
6654 >         g_corr5_loc(l-1)=g_corr5_loc(l-1)
6655 >      &   -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
6656 >         call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6657 >         vv(1)=pizda(1,1)+pizda(2,2)
6658 >         vv(2)=pizda(2,1)-pizda(1,2)
6659 >         g_corr5_loc(k-1)=g_corr5_loc(k-1)
6660 >      &   +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
6661 >      &   -0.5d0*scalar2(vv(1),Ctobr(1,l)))
6662 > C Cartesian gradient
6663 >         do iii=1,2
6664 >           do kkk=1,5
6665 >             do lll=1,3
6666 >               call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6667 >      &          pizda(1,1))
6668 >               vv(1)=pizda(1,1)+pizda(2,2)
6669 >               vv(2)=pizda(2,1)-pizda(1,2)
6670 >               derx(lll,kkk,iii)=derx(lll,kkk,iii)
6671 >      &         +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
6672 >      &         -0.5d0*scalar2(vv(1),Ctobr(1,l))
6673 >             enddo
6674 >           enddo
6675 >         enddo
6676 >       else
6677 > C Antiparallel orientation
6678 > C Contribution from graph III
6679 > c        goto 1110
6680 >         call transpose2(EUg(1,1,j),auxmat(1,1))
6681 >         call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
6682 >         vv(1)=pizda(1,1)-pizda(2,2)
6683 >         vv(2)=pizda(1,2)+pizda(2,1)
6684 >         eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
6685 >      &   +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6686 > C Explicit gradient in virtual-dihedral angles.
6687 >         g_corr5_loc(l-1)=g_corr5_loc(l-1)
6688 >      &   +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
6689 >      &   +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
6690 >         call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
6691 >         vv(1)=pizda(1,1)-pizda(2,2)
6692 >         vv(2)=pizda(1,2)+pizda(2,1)
6693 >         g_corr5_loc(k-1)=g_corr5_loc(k-1)
6694 >      &   +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
6695 >      &   +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6696 >         call transpose2(EUgder(1,1,j),auxmat1(1,1))
6697 >         call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
6698 >         vv(1)=pizda(1,1)-pizda(2,2)
6699 >         vv(2)=pizda(1,2)+pizda(2,1)
6700 >         g_corr5_loc(j-1)=g_corr5_loc(j-1)
6701 >      &   +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
6702 >      &   +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
6703 > C Cartesian gradient
6704 >         do iii=1,2
6705 >           do kkk=1,5
6706 >             do lll=1,3
6707 >               call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
6708 >      &          pizda(1,1))
6709 >               vv(1)=pizda(1,1)-pizda(2,2)
6710 >               vv(2)=pizda(1,2)+pizda(2,1)
6711 >               derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6712 >      &         +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
6713 >      &         +0.5d0*scalar2(vv(1),Dtobr2(1,l))
6714 >             enddo
6715 >           enddo
6716 >         enddo
6717 > cd        goto 1112
6718 > C Contribution from graph IV
6719 > 1110    continue
6720 >         call transpose2(EE(1,1,itj),auxmat(1,1))
6721 >         call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
6722 >         vv(1)=pizda(1,1)+pizda(2,2)
6723 >         vv(2)=pizda(2,1)-pizda(1,2)
6724 >         eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
6725 >      &   -0.5d0*scalar2(vv(1),Ctobr(1,j))
6726 > C Explicit gradient in virtual-dihedral angles.
6727 >         g_corr5_loc(j-1)=g_corr5_loc(j-1)
6728 >      &   -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
6729 >         call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
6730 >         vv(1)=pizda(1,1)+pizda(2,2)
6731 >         vv(2)=pizda(2,1)-pizda(1,2)
6732 >         g_corr5_loc(k-1)=g_corr5_loc(k-1)
6733 >      &   +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
6734 >      &   -0.5d0*scalar2(vv(1),Ctobr(1,j)))
6735 > C Cartesian gradient
6736 >         do iii=1,2
6737 >           do kkk=1,5
6738 >             do lll=1,3
6739 >               call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6740 >      &          pizda(1,1))
6741 >               vv(1)=pizda(1,1)+pizda(2,2)
6742 >               vv(2)=pizda(2,1)-pizda(1,2)
6743 >               derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
6744 >      &         +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
6745 >      &         -0.5d0*scalar2(vv(1),Ctobr(1,j))
6746 >             enddo
6747 >           enddo
6748 >         enddo
6749 >       endif
6750 > 1112  continue
6751 >       eel5=eello5_1+eello5_2+eello5_3+eello5_4
6752 > cd      if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
6753 > cd        write (2,*) 'ijkl',i,j,k,l
6754 > cd        write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
6755 > cd     &     ' eello5_3',eello5_3,' eello5_4',eello5_4
6756 > cd      endif
6757 > cd      write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
6758 > cd      write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
6759 > cd      write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
6760 > cd      write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
6761 >       if (j.lt.nres-1) then
6762 >         j1=j+1
6763 >         j2=j-1
6764 >       else
6765 >         j1=j-1
6766 >         j2=j-2
6767 >       endif
6768 >       if (l.lt.nres-1) then
6769 >         l1=l+1
6770 >         l2=l-1
6771 >       else
6772 >         l1=l-1
6773 >         l2=l-2
6774 >       endif
6775 > cd      eij=1.0d0
6776 > cd      ekl=1.0d0
6777 > cd      ekont=1.0d0
6778 > cd      write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
6779 >       do ll=1,3
6780 >         ggg1(ll)=eel5*g_contij(ll,1)
6781 >         ggg2(ll)=eel5*g_contij(ll,2)
6782 > cold        ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
6783 >         ghalf=0.5d0*ggg1(ll)
6784 > cd        ghalf=0.0d0
6785 >         gradcorr5(ll,i)=gradcorr5(ll,i)+ghalf+ekont*derx(ll,2,1)
6786 >         gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
6787 >         gradcorr5(ll,j)=gradcorr5(ll,j)+ghalf+ekont*derx(ll,4,1)
6788 >         gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
6789 > cold        ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
6790 >         ghalf=0.5d0*ggg2(ll)
6791 > cd        ghalf=0.0d0
6792 >         gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
6793 >         gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
6794 >         gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
6795 >         gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
6796 >       enddo
6797 > cd      goto 1112
6798 >       do m=i+1,j-1
6799 >         do ll=1,3
6800 > cold          gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
6801 >           gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
6802 >         enddo
6803 >       enddo
6804 >       do m=k+1,l-1
6805 >         do ll=1,3
6806 > cold          gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
6807 >           gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
6808 >         enddo
6809 >       enddo
6810 > c1112  continue
6811 >       do m=i+2,j2
6812 >         do ll=1,3
6813 >           gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
6814 >         enddo
6815 >       enddo
6816 >       do m=k+2,l2
6817 >         do ll=1,3
6818 >           gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
6819 >         enddo
6820 >       enddo
6821 > cd      do iii=1,nres-3
6822 > cd        write (2,*) iii,g_corr5_loc(iii)
6823 > cd      enddo
6824 >       eello5=ekont*eel5
6825 > cd      write (2,*) 'ekont',ekont
6826 > cd      write (iout,*) 'eello5',ekont*eel5
6827 >       return
6828 >       end
6829 > c--------------------------------------------------------------------------
6830 >       double precision function eello6(i,j,k,l,jj,kk)
6831 >       implicit real*8 (a-h,o-z)
6832 >       include 'DIMENSIONS'
6833 >       include 'COMMON.IOUNITS'
6834 >       include 'COMMON.CHAIN'
6835 >       include 'COMMON.DERIV'
6836 >       include 'COMMON.INTERACT'
6837 >       include 'COMMON.CONTACTS'
6838 >       include 'COMMON.TORSION'
6839 >       include 'COMMON.VAR'
6840 >       include 'COMMON.GEO'
6841 >       include 'COMMON.FFIELD'
6842 >       double precision ggg1(3),ggg2(3)
6843 > cd      if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
6844 > cd        eello6=0.0d0
6845 > cd        return
6846 > cd      endif
6847 > cd      write (iout,*)
6848 > cd     &   'EELLO6: Contacts have occurred for peptide groups',i,j,
6849 > cd     &   ' and',k,l
6850 >       eello6_1=0.0d0
6851 >       eello6_2=0.0d0
6852 >       eello6_3=0.0d0
6853 >       eello6_4=0.0d0
6854 >       eello6_5=0.0d0
6855 >       eello6_6=0.0d0
6856 > cd      call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
6857 > cd     &   eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
6858 >       do iii=1,2
6859 >         do kkk=1,5
6860 >           do lll=1,3
6861 >             derx(lll,kkk,iii)=0.0d0
6862 >           enddo
6863 >         enddo
6864 >       enddo
6865 > cd      eij=facont_hb(jj,i)
6866 > cd      ekl=facont_hb(kk,k)
6867 > cd      ekont=eij*ekl
6868 > cd      eij=1.0d0
6869 > cd      ekl=1.0d0
6870 > cd      ekont=1.0d0
6871 >       if (l.eq.j+1) then
6872 >         eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6873 >         eello6_2=eello6_graph1(j,i,l,k,2,.false.)
6874 >         eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
6875 >         eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6876 >         eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
6877 >         eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
6878 >       else
6879 >         eello6_1=eello6_graph1(i,j,k,l,1,.false.)
6880 >         eello6_2=eello6_graph1(l,k,j,i,2,.true.)
6881 >         eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
6882 >         eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
6883 >         if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
6884 >           eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
6885 >         else
6886 >           eello6_5=0.0d0
6887 >         endif
6888 >         eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
6889 >       endif
6890 > C If turn contributions are considered, they will be handled separately.
6891 >       eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
6892 > cd      write(iout,*) 'eello6_1',eello6_1,' eel6_1_num',16*eel6_1_num
6893 > cd      write(iout,*) 'eello6_2',eello6_2,' eel6_2_num',16*eel6_2_num
6894 > cd      write(iout,*) 'eello6_3',eello6_3,' eel6_3_num',16*eel6_3_num
6895 > cd      write(iout,*) 'eello6_4',eello6_4,' eel6_4_num',16*eel6_4_num
6896 > cd      write(iout,*) 'eello6_5',eello6_5,' eel6_5_num',16*eel6_5_num
6897 > cd      write(iout,*) 'eello6_6',eello6_6,' eel6_6_num',16*eel6_6_num
6898 > cd      goto 1112
6899 >       if (j.lt.nres-1) then
6900 >         j1=j+1
6901 >         j2=j-1
6902 >       else
6903 >         j1=j-1
6904 >         j2=j-2
6905 >       endif
6906 >       if (l.lt.nres-1) then
6907 >         l1=l+1
6908 >         l2=l-1
6909 >       else
6910 >         l1=l-1
6911 >         l2=l-2
6912 >       endif
6913 >       do ll=1,3
6914 >         ggg1(ll)=eel6*g_contij(ll,1)
6915 >         ggg2(ll)=eel6*g_contij(ll,2)
6916 > cold        ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
6917 >         ghalf=0.5d0*ggg1(ll)
6918 > cd        ghalf=0.0d0
6919 >         gradcorr6(ll,i)=gradcorr6(ll,i)+ghalf+ekont*derx(ll,2,1)
6920 >         gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
6921 >         gradcorr6(ll,j)=gradcorr6(ll,j)+ghalf+ekont*derx(ll,4,1)
6922 >         gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
6923 >         ghalf=0.5d0*ggg2(ll)
6924 > cold        ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
6925 > cd        ghalf=0.0d0
6926 >         gradcorr6(ll,k)=gradcorr6(ll,k)+ghalf+ekont*derx(ll,2,2)
6927 >         gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
6928 >         gradcorr6(ll,l)=gradcorr6(ll,l)+ghalf+ekont*derx(ll,4,2)
6929 >         gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
6930 >       enddo
6931 > cd      goto 1112
6932 >       do m=i+1,j-1
6933 >         do ll=1,3
6934 > cold          gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
6935 >           gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
6936 >         enddo
6937 >       enddo
6938 >       do m=k+1,l-1
6939 >         do ll=1,3
6940 > cold          gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
6941 >           gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
6942 >         enddo
6943 >       enddo
6944 > 1112  continue
6945 >       do m=i+2,j2
6946 >         do ll=1,3
6947 >           gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
6948 >         enddo
6949 >       enddo
6950 >       do m=k+2,l2
6951 >         do ll=1,3
6952 >           gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
6953 >         enddo
6954 >       enddo
6955 > cd      do iii=1,nres-3
6956 > cd        write (2,*) iii,g_corr6_loc(iii)
6957 > cd      enddo
6958 >       eello6=ekont*eel6
6959 > cd      write (2,*) 'ekont',ekont
6960 > cd      write (iout,*) 'eello6',ekont*eel6
6961 >       return
6962 >       end
6963 > c--------------------------------------------------------------------------
6964 >       double precision function eello6_graph1(i,j,k,l,imat,swap)
6965 >       implicit real*8 (a-h,o-z)
6966 >       include 'DIMENSIONS'
6967 >       include 'COMMON.IOUNITS'
6968 >       include 'COMMON.CHAIN'
6969 >       include 'COMMON.DERIV'
6970 >       include 'COMMON.INTERACT'
6971 >       include 'COMMON.CONTACTS'
6972 >       include 'COMMON.TORSION'
6973 >       include 'COMMON.VAR'
6974 >       include 'COMMON.GEO'
6975 >       double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
6976 >       logical swap
6977 >       logical lprn
6978 >       common /kutas/ lprn
6979 > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6980 > C
6981 > C      Parallel       Antiparallel
6982 > C
6983 > C          o             o
6984 > C         /l\           /j\
6985 > C        /   \         /   \
6986 > C       /| o |         | o |\
6987 > C     \ j|/k\|  /   \  |/k\|l /
6988 > C      \ /   \ /     \ /   \ /
6989 > C       o     o       o     o
6990 > C       i             i
6991 > C
6992 > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
6993 >       itk=itortyp(itype(k))
6994 >       s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
6995 >       s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
6996 >       s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
6997 >       call transpose2(EUgC(1,1,k),auxmat(1,1))
6998 >       call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
6999 >       vv1(1)=pizda1(1,1)-pizda1(2,2)
7000 >       vv1(2)=pizda1(1,2)+pizda1(2,1)
7001 >       s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7002 >       vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7003 >       vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7004 >       s5=scalar2(vv(1),Dtobr2(1,i))
7005 > cd      write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7006 >       eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7007 >       if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7008 >      & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7009 >      & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7010 >      & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7011 >      & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7012 >      & +scalar2(vv(1),Dtobr2der(1,i)))
7013 >       call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7014 >       vv1(1)=pizda1(1,1)-pizda1(2,2)
7015 >       vv1(2)=pizda1(1,2)+pizda1(2,1)
7016 >       vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7017 >       vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7018 >       if (l.eq.j+1) then
7019 >         g_corr6_loc(l-1)=g_corr6_loc(l-1)
7020 >      & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7021 >      & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7022 >      & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7023 >      & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7024 >       else
7025 >         g_corr6_loc(j-1)=g_corr6_loc(j-1)
7026 >      & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7027 >      & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7028 >      & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7029 >      & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7030 >       endif
7031 >       call transpose2(EUgCder(1,1,k),auxmat(1,1))
7032 >       call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7033 >       vv1(1)=pizda1(1,1)-pizda1(2,2)
7034 >       vv1(2)=pizda1(1,2)+pizda1(2,1)
7035 >       if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7036 >      & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7037 >      & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7038 >      & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7039 >       do iii=1,2
7040 >         if (swap) then
7041 >           ind=3-iii
7042 >         else
7043 >           ind=iii
7044 >         endif
7045 >         do kkk=1,5
7046 >           do lll=1,3
7047 >             s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7048 >             s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7049 >             s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7050 >             call transpose2(EUgC(1,1,k),auxmat(1,1))
7051 >             call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7052 >      &        pizda1(1,1))
7053 >             vv1(1)=pizda1(1,1)-pizda1(2,2)
7054 >             vv1(2)=pizda1(1,2)+pizda1(2,1)
7055 >             s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7056 >             vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7057 >      &       -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7058 >             vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7059 >      &       +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7060 >             s5=scalar2(vv(1),Dtobr2(1,i))
7061 >             derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7062 >           enddo
7063 >         enddo
7064 >       enddo
7065 >       return
7066 >       end
7067 > c----------------------------------------------------------------------------
7068 >       double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7069 >       implicit real*8 (a-h,o-z)
7070 >       include 'DIMENSIONS'
7071 >       include 'COMMON.IOUNITS'
7072 >       include 'COMMON.CHAIN'
7073 >       include 'COMMON.DERIV'
7074 >       include 'COMMON.INTERACT'
7075 >       include 'COMMON.CONTACTS'
7076 >       include 'COMMON.TORSION'
7077 >       include 'COMMON.VAR'
7078 >       include 'COMMON.GEO'
7079 >       logical swap
7080 >       double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7081 >      & auxvec1(2),auxvec2(1),auxmat1(2,2)
7082 >       logical lprn
7083 >       common /kutas/ lprn
7084 > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7085 > C
7086 > C      Parallel       Antiparallel
7087 > C
7088 > C          o             o
7089 > C     \   /l\           /j\   /
7090 > C      \ /   \         /   \ /
7091 > C       o| o |         | o |o
7092 > C     \ j|/k\|      \  |/k\|l
7093 > C      \ /   \       \ /   \
7094 > C       o             o
7095 > C       i             i
7096 > C
7097 > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7098 > cd      write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7099 > C AL 7/4/01 s1 would occur in the sixth-order moment,
7100 > C           but not in a cluster cumulant
7101 > #ifdef MOMENT
7102 >       s1=dip(1,jj,i)*dip(1,kk,k)
7103 > #endif
7104 >       call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7105 >       s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7106 >       call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7107 >       s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7108 >       call transpose2(EUg(1,1,k),auxmat(1,1))
7109 >       call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7110 >       vv(1)=pizda(1,1)-pizda(2,2)
7111 >       vv(2)=pizda(1,2)+pizda(2,1)
7112 >       s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7113 > cd      write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7114 > #ifdef MOMENT
7115 >       eello6_graph2=-(s1+s2+s3+s4)
7116 > #else
7117 >       eello6_graph2=-(s2+s3+s4)
7118 > #endif
7119 > c      eello6_graph2=-s3
7120 > C Derivatives in gamma(i-1)
7121 >       if (i.gt.1) then
7122 > #ifdef MOMENT
7123 >         s1=dipderg(1,jj,i)*dip(1,kk,k)
7124 > #endif
7125 >         s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7126 >         call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7127 >         s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7128 >         s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7129 > #ifdef MOMENT
7130 >         g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7131 > #else
7132 >         g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7133 > #endif
7134 > c        g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7135 >       endif
7136 > C Derivatives in gamma(k-1)
7137 > #ifdef MOMENT
7138 >       s1=dip(1,jj,i)*dipderg(1,kk,k)
7139 > #endif
7140 >       call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7141 >       s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7142 >       call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7143 >       s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7144 >       call transpose2(EUgder(1,1,k),auxmat1(1,1))
7145 >       call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
7146 >       vv(1)=pizda(1,1)-pizda(2,2)
7147 >       vv(2)=pizda(1,2)+pizda(2,1)
7148 >       s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7149 > #ifdef MOMENT
7150 >       g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7151 > #else
7152 >       g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7153 > #endif
7154 > c      g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
7155 > C Derivatives in gamma(j-1) or gamma(l-1)
7156 >       if (j.gt.1) then
7157 > #ifdef MOMENT
7158 >         s1=dipderg(3,jj,i)*dip(1,kk,k)
7159 > #endif
7160 >         call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
7161 >         s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7162 >         s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
7163 >         call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
7164 >         vv(1)=pizda(1,1)-pizda(2,2)
7165 >         vv(2)=pizda(1,2)+pizda(2,1)
7166 >         s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7167 > #ifdef MOMENT
7168 >         if (swap) then
7169 >           g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7170 >         else
7171 >           g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7172 >         endif
7173 > #endif
7174 >         g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
7175 > c        g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
7176 >       endif
7177 > C Derivatives in gamma(l-1) or gamma(j-1)
7178 >       if (l.gt.1) then
7179 > #ifdef MOMENT
7180 >         s1=dip(1,jj,i)*dipderg(3,kk,k)
7181 > #endif
7182 >         call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
7183 >         s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7184 >         call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
7185 >         s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7186 >         call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
7187 >         vv(1)=pizda(1,1)-pizda(2,2)
7188 >         vv(2)=pizda(1,2)+pizda(2,1)
7189 >         s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7190 > #ifdef MOMENT
7191 >         if (swap) then
7192 >           g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
7193 >         else
7194 >           g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
7195 >         endif
7196 > #endif
7197 >         g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
7198 > c        g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
7199 >       endif
7200 > C Cartesian derivatives.
7201 >       if (lprn) then
7202 >         write (2,*) 'In eello6_graph2'
7203 >         do iii=1,2
7204 >           write (2,*) 'iii=',iii
7205 >           do kkk=1,5
7206 >             write (2,*) 'kkk=',kkk
7207 >             do jjj=1,2
7208 >               write (2,'(3(2f10.5),5x)')
7209 >      &        ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7210 >             enddo
7211 >           enddo
7212 >         enddo
7213 >       endif
7214 >       do iii=1,2
7215 >         do kkk=1,5
7216 >           do lll=1,3
7217 > #ifdef MOMENT
7218 >             if (iii.eq.1) then
7219 >               s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
7220 >             else
7221 >               s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
7222 >             endif
7223 > #endif
7224 >             call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
7225 >      &        auxvec(1))
7226 >             s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7227 >             call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
7228 >      &        auxvec(1))
7229 >             s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
7230 >             call transpose2(EUg(1,1,k),auxmat(1,1))
7231 >             call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
7232 >      &        pizda(1,1))
7233 >             vv(1)=pizda(1,1)-pizda(2,2)
7234 >             vv(2)=pizda(1,2)+pizda(2,1)
7235 >             s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7236 > cd            write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
7237 > #ifdef MOMENT
7238 >             derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7239 > #else
7240 >             derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7241 > #endif
7242 >             if (swap) then
7243 >               derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7244 >             else
7245 >               derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7246 >             endif
7247 >           enddo
7248 >         enddo
7249 >       enddo
7250 >       return
7251 >       end
7252 > c----------------------------------------------------------------------------
7253 >       double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
7254 >       implicit real*8 (a-h,o-z)
7255 >       include 'DIMENSIONS'
7256 >       include 'COMMON.IOUNITS'
7257 >       include 'COMMON.CHAIN'
7258 >       include 'COMMON.DERIV'
7259 >       include 'COMMON.INTERACT'
7260 >       include 'COMMON.CONTACTS'
7261 >       include 'COMMON.TORSION'
7262 >       include 'COMMON.VAR'
7263 >       include 'COMMON.GEO'
7264 >       double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
7265 >       logical swap
7266 > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7267 > C
7268 > C      Parallel       Antiparallel
7269 > C
7270 > C          o             o
7271 > C         /l\   /   \   /j\
7272 > C        /   \ /     \ /   \
7273 > C       /| o |o       o| o |\
7274 > C       j|/k\|  /      |/k\|l /
7275 > C        /   \ /       /   \ /
7276 > C       /     o       /     o
7277 > C       i             i
7278 > C
7279 > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7280 > C
7281 > C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7282 > C           energy moment and not to the cluster cumulant.
7283 >       iti=itortyp(itype(i))
7284 >       if (j.lt.nres-1) then
7285 >         itj1=itortyp(itype(j+1))
7286 >       else
7287 >         itj1=ntortyp+1
7288 >       endif
7289 >       itk=itortyp(itype(k))
7290 >       itk1=itortyp(itype(k+1))
7291 >       if (l.lt.nres-1) then
7292 >         itl1=itortyp(itype(l+1))
7293 >       else
7294 >         itl1=ntortyp+1
7295 >       endif
7296 > #ifdef MOMENT
7297 >       s1=dip(4,jj,i)*dip(4,kk,k)
7298 > #endif
7299 >       call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
7300 >       s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7301 >       call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
7302 >       s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7303 >       call transpose2(EE(1,1,itk),auxmat(1,1))
7304 >       call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
7305 >       vv(1)=pizda(1,1)+pizda(2,2)
7306 >       vv(2)=pizda(2,1)-pizda(1,2)
7307 >       s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7308 > cd      write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7309 > #ifdef MOMENT
7310 >       eello6_graph3=-(s1+s2+s3+s4)
7311 > #else
7312 >       eello6_graph3=-(s2+s3+s4)
7313 > #endif
7314 > c      eello6_graph3=-s4
7315 > C Derivatives in gamma(k-1)
7316 >       call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
7317 >       s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7318 >       s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
7319 >       g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
7320 > C Derivatives in gamma(l-1)
7321 >       call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
7322 >       s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7323 >       call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
7324 >       vv(1)=pizda(1,1)+pizda(2,2)
7325 >       vv(2)=pizda(2,1)-pizda(1,2)
7326 >       s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7327 >       g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7328 > C Cartesian derivatives.
7329 >       do iii=1,2
7330 >         do kkk=1,5
7331 >           do lll=1,3
7332 > #ifdef MOMENT
7333 >             if (iii.eq.1) then
7334 >               s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
7335 >             else
7336 >               s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
7337 >             endif
7338 > #endif
7339 >             call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7340 >      &        auxvec(1))
7341 >             s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
7342 >             call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7343 >      &        auxvec(1))
7344 >             s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
7345 >             call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
7346 >      &        pizda(1,1))
7347 >             vv(1)=pizda(1,1)+pizda(2,2)
7348 >             vv(2)=pizda(2,1)-pizda(1,2)
7349 >             s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
7350 > #ifdef MOMENT
7351 >             derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7352 > #else
7353 >             derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7354 > #endif
7355 >             if (swap) then
7356 >               derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7357 >             else
7358 >               derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7359 >             endif
7360 > c            derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
7361 >           enddo
7362 >         enddo
7363 >       enddo
7364 >       return
7365 >       end
7366 > c----------------------------------------------------------------------------
7367 >       double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
7368 >       implicit real*8 (a-h,o-z)
7369 >       include 'DIMENSIONS'
7370 >       include 'COMMON.IOUNITS'
7371 >       include 'COMMON.CHAIN'
7372 >       include 'COMMON.DERIV'
7373 >       include 'COMMON.INTERACT'
7374 >       include 'COMMON.CONTACTS'
7375 >       include 'COMMON.TORSION'
7376 >       include 'COMMON.VAR'
7377 >       include 'COMMON.GEO'
7378 >       include 'COMMON.FFIELD'
7379 >       double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7380 >      & auxvec1(2),auxmat1(2,2)
7381 >       logical swap
7382 > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7383 > C
7384 > C      Parallel       Antiparallel
7385 > C
7386 > C          o             o
7387 > C         /l\   /   \   /j\
7388 > C        /   \ /     \ /   \
7389 > C       /| o |o       o| o |\
7390 > C     \ j|/k\|      \  |/k\|l
7391 > C      \ /   \       \ /   \
7392 > C       o     \       o     \
7393 > C       i             i
7394 > C
7395 > CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7396 > C
7397 > C 4/7/01 AL Component s1 was removed, because it pertains to the respective
7398 > C           energy moment and not to the cluster cumulant.
7399 > cd      write (2,*) 'eello_graph4: wturn6',wturn6
7400 >       iti=itortyp(itype(i))
7401 >       itj=itortyp(itype(j))
7402 >       if (j.lt.nres-1) then
7403 >         itj1=itortyp(itype(j+1))
7404 >       else
7405 >         itj1=ntortyp+1
7406 >       endif
7407 >       itk=itortyp(itype(k))
7408 >       if (k.lt.nres-1) then
7409 >         itk1=itortyp(itype(k+1))
7410 >       else
7411 >         itk1=ntortyp+1
7412 >       endif
7413 >       itl=itortyp(itype(l))
7414 >       if (l.lt.nres-1) then
7415 >         itl1=itortyp(itype(l+1))
7416 >       else
7417 >         itl1=ntortyp+1
7418 >       endif
7419 > cd      write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
7420 > cd      write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
7421 > cd     & ' itl',itl,' itl1',itl1
7422 > #ifdef MOMENT
7423 >       if (imat.eq.1) then
7424 >         s1=dip(3,jj,i)*dip(3,kk,k)
7425 >       else
7426 >         s1=dip(2,jj,j)*dip(2,kk,l)
7427 >       endif
7428 > #endif
7429 >       call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
7430 >       s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7431 >       if (j.eq.l+1) then
7432 >         call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
7433 >         s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7434 >       else
7435 >         call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
7436 >         s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7437 >       endif
7438 >       call transpose2(EUg(1,1,k),auxmat(1,1))
7439 >       call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
7440 >       vv(1)=pizda(1,1)-pizda(2,2)
7441 >       vv(2)=pizda(2,1)+pizda(1,2)
7442 >       s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7443 > cd      write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7444 > #ifdef MOMENT
7445 >       eello6_graph4=-(s1+s2+s3+s4)
7446 > #else
7447 >       eello6_graph4=-(s2+s3+s4)
7448 > #endif
7449 > C Derivatives in gamma(i-1)
7450 >       if (i.gt.1) then
7451 > #ifdef MOMENT
7452 >         if (imat.eq.1) then
7453 >           s1=dipderg(2,jj,i)*dip(3,kk,k)
7454 >         else
7455 >           s1=dipderg(4,jj,j)*dip(2,kk,l)
7456 >         endif
7457 > #endif
7458 >         s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7459 >         if (j.eq.l+1) then
7460 >           call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
7461 >           s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7462 >         else
7463 >           call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
7464 >           s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7465 >         endif
7466 >         s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7467 >         if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7468 > cd          write (2,*) 'turn6 derivatives'
7469 > #ifdef MOMENT
7470 >           gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
7471 > #else
7472 >           gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
7473 > #endif
7474 >         else
7475 > #ifdef MOMENT
7476 >           g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7477 > #else
7478 >           g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7479 > #endif
7480 >         endif
7481 >       endif
7482 > C Derivatives in gamma(k-1)
7483 > #ifdef MOMENT
7484 >       if (imat.eq.1) then
7485 >         s1=dip(3,jj,i)*dipderg(2,kk,k)
7486 >       else
7487 >         s1=dip(2,jj,j)*dipderg(4,kk,l)
7488 >       endif
7489 > #endif
7490 >       call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
7491 >       s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
7492 >       if (j.eq.l+1) then
7493 >         call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
7494 >         s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
7495 >       else
7496 >         call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
7497 >         s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
7498 >       endif
7499 >       call transpose2(EUgder(1,1,k),auxmat1(1,1))
7500 >       call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
7501 >       vv(1)=pizda(1,1)-pizda(2,2)
7502 >       vv(2)=pizda(2,1)+pizda(1,2)
7503 >       s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7504 >       if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7505 > #ifdef MOMENT
7506 >         gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
7507 > #else
7508 >         gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
7509 > #endif
7510 >       else
7511 > #ifdef MOMENT
7512 >         g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
7513 > #else
7514 >         g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
7515 > #endif
7516 >       endif
7517 > C Derivatives in gamma(j-1) or gamma(l-1)
7518 >       if (l.eq.j+1 .and. l.gt.1) then
7519 >         call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7520 >         s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7521 >         call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7522 >         vv(1)=pizda(1,1)-pizda(2,2)
7523 >         vv(2)=pizda(2,1)+pizda(1,2)
7524 >         s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7525 >         g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
7526 >       else if (j.gt.1) then
7527 >         call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
7528 >         s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7529 >         call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
7530 >         vv(1)=pizda(1,1)-pizda(2,2)
7531 >         vv(2)=pizda(2,1)+pizda(1,2)
7532 >         s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7533 >         if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7534 >           gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
7535 >         else
7536 >           g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
7537 >         endif
7538 >       endif
7539 > C Cartesian derivatives.
7540 >       do iii=1,2
7541 >         do kkk=1,5
7542 >           do lll=1,3
7543 > #ifdef MOMENT
7544 >             if (iii.eq.1) then
7545 >               if (imat.eq.1) then
7546 >                 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
7547 >               else
7548 >                 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
7549 >               endif
7550 >             else
7551 >               if (imat.eq.1) then
7552 >                 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
7553 >               else
7554 >                 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
7555 >               endif
7556 >             endif
7557 > #endif
7558 >             call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
7559 >      &        auxvec(1))
7560 >             s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
7561 >             if (j.eq.l+1) then
7562 >               call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7563 >      &          b1(1,itj1),auxvec(1))
7564 >               s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
7565 >             else
7566 >               call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
7567 >      &          b1(1,itl1),auxvec(1))
7568 >               s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
7569 >             endif
7570 >             call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7571 >      &        pizda(1,1))
7572 >             vv(1)=pizda(1,1)-pizda(2,2)
7573 >             vv(2)=pizda(2,1)+pizda(1,2)
7574 >             s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
7575 >             if (swap) then
7576 >               if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
7577 > #ifdef MOMENT
7578 >                 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7579 >      &             -(s1+s2+s4)
7580 > #else
7581 >                 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
7582 >      &             -(s2+s4)
7583 > #endif
7584 >                 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
7585 >               else
7586 > #ifdef MOMENT
7587 >                 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
7588 > #else
7589 >                 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
7590 > #endif
7591 >                 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7592 >               endif
7593 >             else
7594 > #ifdef MOMENT
7595 >               derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
7596 > #else
7597 >               derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
7598 > #endif
7599 >               if (l.eq.j+1) then
7600 >                 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
7601 >               else
7602 >                 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
7603 >               endif
7604 >             endif
7605 >           enddo
7606 >         enddo
7607 >       enddo
7608 >       return
7609 >       end
7610 > c----------------------------------------------------------------------------
7611 >       double precision function eello_turn6(i,jj,kk)
7612 >       implicit real*8 (a-h,o-z)
7613 >       include 'DIMENSIONS'
7614 >       include 'COMMON.IOUNITS'
7615 >       include 'COMMON.CHAIN'
7616 >       include 'COMMON.DERIV'
7617 >       include 'COMMON.INTERACT'
7618 >       include 'COMMON.CONTACTS'
7619 >       include 'COMMON.TORSION'
7620 >       include 'COMMON.VAR'
7621 >       include 'COMMON.GEO'
7622 >       double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
7623 >      &  atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
7624 >      &  ggg1(3),ggg2(3)
7625 >       double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
7626 >      &  atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
7627 > C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
7628 > C           the respective energy moment and not to the cluster cumulant.
7629 >       s1=0.0d0
7630 >       s8=0.0d0
7631 >       s13=0.0d0
7632 > c
7633 >       eello_turn6=0.0d0
7634 >       j=i+4
7635 >       k=i+1
7636 >       l=i+3
7637 >       iti=itortyp(itype(i))
7638 >       itk=itortyp(itype(k))
7639 >       itk1=itortyp(itype(k+1))
7640 >       itl=itortyp(itype(l))
7641 >       itj=itortyp(itype(j))
7642 > cd      write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
7643 > cd      write (2,*) 'i',i,' k',k,' j',j,' l',l
7644 > cd      if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7645 > cd        eello6=0.0d0
7646 > cd        return
7647 > cd      endif
7648 > cd      write (iout,*)
7649 > cd     &   'EELLO6: Contacts have occurred for peptide groups',i,j,
7650 > cd     &   ' and',k,l
7651 > cd      call checkint_turn6(i,jj,kk,eel_turn6_num)
7652 >       do iii=1,2
7653 >         do kkk=1,5
7654 >           do lll=1,3
7655 >             derx_turn(lll,kkk,iii)=0.0d0
7656 >           enddo
7657 >         enddo
7658 >       enddo
7659 > cd      eij=1.0d0
7660 > cd      ekl=1.0d0
7661 > cd      ekont=1.0d0
7662 >       eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7663 > cd      eello6_5=0.0d0
7664 > cd      write (2,*) 'eello6_5',eello6_5
7665 > #ifdef MOMENT
7666 >       call transpose2(AEA(1,1,1),auxmat(1,1))
7667 >       call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
7668 >       ss1=scalar2(Ub2(1,i+2),b1(1,itl))
7669 >       s1 = (auxmat(1,1)+auxmat(2,2))*ss1
7670 > #endif
7671 >       call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7672 >       call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
7673 >       s2 = scalar2(b1(1,itk),vtemp1(1))
7674 > #ifdef MOMENT
7675 >       call transpose2(AEA(1,1,2),atemp(1,1))
7676 >       call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
7677 >       call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
7678 >       s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7679 > #endif
7680 >       call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
7681 >       call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
7682 >       s12 = scalar2(Ub2(1,i+2),vtemp3(1))
7683 > #ifdef MOMENT
7684 >       call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
7685 >       call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
7686 >       call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
7687 >       call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
7688 >       ss13 = scalar2(b1(1,itk),vtemp4(1))
7689 >       s13 = (gtemp(1,1)+gtemp(2,2))*ss13
7690 > #endif
7691 > c      write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
7692 > c      s1=0.0d0
7693 > c      s2=0.0d0
7694 > c      s8=0.0d0
7695 > c      s12=0.0d0
7696 > c      s13=0.0d0
7697 >       eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
7698 > C Derivatives in gamma(i+2)
7699 >       s1d =0.0d0
7700 >       s8d =0.0d0
7701 > #ifdef MOMENT
7702 >       call transpose2(AEA(1,1,1),auxmatd(1,1))
7703 >       call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7704 >       s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7705 >       call transpose2(AEAderg(1,1,2),atempd(1,1))
7706 >       call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7707 >       s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7708 > #endif
7709 >       call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
7710 >       call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7711 >       s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7712 > c      s1d=0.0d0
7713 > c      s2d=0.0d0
7714 > c      s8d=0.0d0
7715 > c      s12d=0.0d0
7716 > c      s13d=0.0d0
7717 >       gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
7718 > C Derivatives in gamma(i+3)
7719 > #ifdef MOMENT
7720 >       call transpose2(AEA(1,1,1),auxmatd(1,1))
7721 >       call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7722 >       ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
7723 >       s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
7724 > #endif
7725 >       call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
7726 >       call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
7727 >       s2d = scalar2(b1(1,itk),vtemp1d(1))
7728 > #ifdef MOMENT
7729 >       call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
7730 >       s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
7731 > #endif
7732 >       s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
7733 > #ifdef MOMENT
7734 >       call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
7735 >       call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7736 >       s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7737 > #endif
7738 > c      s1d=0.0d0
7739 > c      s2d=0.0d0
7740 > c      s8d=0.0d0
7741 > c      s12d=0.0d0
7742 > c      s13d=0.0d0
7743 > #ifdef MOMENT
7744 >       gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7745 >      &               -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7746 > #else
7747 >       gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
7748 >      &               -0.5d0*ekont*(s2d+s12d)
7749 > #endif
7750 > C Derivatives in gamma(i+4)
7751 >       call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
7752 >       call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7753 >       s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7754 > #ifdef MOMENT
7755 >       call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
7756 >       call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
7757 >       s13d = (gtempd(1,1)+gtempd(2,2))*ss13
7758 > #endif
7759 > c      s1d=0.0d0
7760 > c      s2d=0.0d0
7761 > c      s8d=0.0d0
7762 > C      s12d=0.0d0
7763 > c      s13d=0.0d0
7764 > #ifdef MOMENT
7765 >       gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
7766 > #else
7767 >       gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
7768 > #endif
7769 > C Derivatives in gamma(i+5)
7770 > #ifdef MOMENT
7771 >       call transpose2(AEAderg(1,1,1),auxmatd(1,1))
7772 >       call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7773 >       s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7774 > #endif
7775 >       call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
7776 >       call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
7777 >       s2d = scalar2(b1(1,itk),vtemp1d(1))
7778 > #ifdef MOMENT
7779 >       call transpose2(AEA(1,1,2),atempd(1,1))
7780 >       call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
7781 >       s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
7782 > #endif
7783 >       call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
7784 >       s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7785 > #ifdef MOMENT
7786 >       call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
7787 >       ss13d = scalar2(b1(1,itk),vtemp4d(1))
7788 >       s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7789 > #endif
7790 > c      s1d=0.0d0
7791 > c      s2d=0.0d0
7792 > c      s8d=0.0d0
7793 > c      s12d=0.0d0
7794 > c      s13d=0.0d0
7795 > #ifdef MOMENT
7796 >       gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7797 >      &               -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
7798 > #else
7799 >       gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
7800 >      &               -0.5d0*ekont*(s2d+s12d)
7801 > #endif
7802 > C Cartesian derivatives
7803 >       do iii=1,2
7804 >         do kkk=1,5
7805 >           do lll=1,3
7806 > #ifdef MOMENT
7807 >             call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
7808 >             call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
7809 >             s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
7810 > #endif
7811 >             call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
7812 >             call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
7813 >      &          vtemp1d(1))
7814 >             s2d = scalar2(b1(1,itk),vtemp1d(1))
7815 > #ifdef MOMENT
7816 >             call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
7817 >             call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
7818 >             s8d = -(atempd(1,1)+atempd(2,2))*
7819 >      &           scalar2(cc(1,1,itl),vtemp2(1))
7820 > #endif
7821 >             call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
7822 >      &           auxmatd(1,1))
7823 >             call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
7824 >             s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
7825 > c      s1d=0.0d0
7826 > c      s2d=0.0d0
7827 > c      s8d=0.0d0
7828 > c      s12d=0.0d0
7829 > c      s13d=0.0d0
7830 > #ifdef MOMENT
7831 >             derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7832 >      &        - 0.5d0*(s1d+s2d)
7833 > #else
7834 >             derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
7835 >      &        - 0.5d0*s2d
7836 > #endif
7837 > #ifdef MOMENT
7838 >             derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7839 >      &        - 0.5d0*(s8d+s12d)
7840 > #else
7841 >             derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
7842 >      &        - 0.5d0*s12d
7843 > #endif
7844 >           enddo
7845 >         enddo
7846 >       enddo
7847 > #ifdef MOMENT
7848 >       do kkk=1,5
7849 >         do lll=1,3
7850 >           call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
7851 >      &      achuj_tempd(1,1))
7852 >           call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
7853 >           call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
7854 >           s13d=(gtempd(1,1)+gtempd(2,2))*ss13
7855 >           derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
7856 >           call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
7857 >      &      vtemp4d(1))
7858 >           ss13d = scalar2(b1(1,itk),vtemp4d(1))
7859 >           s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
7860 >           derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
7861 >         enddo
7862 >       enddo
7863 > #endif
7864 > cd      write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
7865 > cd     &  16*eel_turn6_num
7866 > cd      goto 1112
7867 >       if (j.lt.nres-1) then
7868 >         j1=j+1
7869 >         j2=j-1
7870 >       else
7871 >         j1=j-1
7872 >         j2=j-2
7873 >       endif
7874 >       if (l.lt.nres-1) then
7875 >         l1=l+1
7876 >         l2=l-1
7877 >       else
7878 >         l1=l-1
7879 >         l2=l-2
7880 >       endif
7881 >       do ll=1,3
7882 >         ggg1(ll)=eel_turn6*g_contij(ll,1)
7883 >         ggg2(ll)=eel_turn6*g_contij(ll,2)
7884 >         ghalf=0.5d0*ggg1(ll)
7885 > cd        ghalf=0.0d0
7886 >         gcorr6_turn(ll,i)=gcorr6_turn(ll,i)+ghalf
7887 >      &    +ekont*derx_turn(ll,2,1)
7888 >         gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
7889 >         gcorr6_turn(ll,j)=gcorr6_turn(ll,j)+ghalf
7890 >      &    +ekont*derx_turn(ll,4,1)
7891 >         gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
7892 >         ghalf=0.5d0*ggg2(ll)
7893 > cd        ghalf=0.0d0
7894 >         gcorr6_turn(ll,k)=gcorr6_turn(ll,k)+ghalf
7895 >      &    +ekont*derx_turn(ll,2,2)
7896 >         gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
7897 >         gcorr6_turn(ll,l)=gcorr6_turn(ll,l)+ghalf
7898 >      &    +ekont*derx_turn(ll,4,2)
7899 >         gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
7900 >       enddo
7901 > cd      goto 1112
7902 >       do m=i+1,j-1
7903 >         do ll=1,3
7904 >           gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
7905 >         enddo
7906 >       enddo
7907 >       do m=k+1,l-1
7908 >         do ll=1,3
7909 >           gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
7910 >         enddo
7911 >       enddo
7912 > 1112  continue
7913 >       do m=i+2,j2
7914 >         do ll=1,3
7915 >           gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
7916 >         enddo
7917 >       enddo
7918 >       do m=k+2,l2
7919 >         do ll=1,3
7920 >           gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
7921 >         enddo
7922 >       enddo
7923 > cd      do iii=1,nres-3
7924 > cd        write (2,*) iii,g_corr6_loc(iii)
7925 > cd      enddo
7926 >       eello_turn6=ekont*eel_turn6
7927 > cd      write (2,*) 'ekont',ekont
7928 > cd      write (2,*) 'eel_turn6',ekont*eel_turn6
7929 >       return
7930 >       end
7931 >
7932 > C-----------------------------------------------------------------------------
7933 >       double precision function scalar(u,v)
7934 > !DIR$ INLINEALWAYS scalar
7935 > #ifndef OSF
7936 > cDEC$ ATTRIBUTES FORCEINLINE::scalar
7937 > #endif
7938 >       implicit none
7939 >       double precision u(3),v(3)
7940 > cd      double precision sc
7941 > cd      integer i
7942 > cd      sc=0.0d0
7943 > cd      do i=1,3
7944 > cd        sc=sc+u(i)*v(i)
7945 > cd      enddo
7946 > cd      scalar=sc
7947 >
7948 >       scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
7949 >       return
7950 >       end
7951 > crc-------------------------------------------------
7952 >       SUBROUTINE MATVEC2(A1,V1,V2)
7953 > !DIR$ INLINEALWAYS MATVEC2
7954 > #ifndef OSF
7955 > cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
7956 > #endif
7957 >       implicit real*8 (a-h,o-z)
7958 >       include 'DIMENSIONS'
7959 >       DIMENSION A1(2,2),V1(2),V2(2)
7960 > c      DO 1 I=1,2
7961 > c        VI=0.0
7962 > c        DO 3 K=1,2
7963 > c    3     VI=VI+A1(I,K)*V1(K)
7964 > c        Vaux(I)=VI
7965 > c    1 CONTINUE
7966 >
7967 >       vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
7968 >       vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
7969 >
7970 >       v2(1)=vaux1
7971 >       v2(2)=vaux2
7972 >       END
7973 > C---------------------------------------
7974 >       SUBROUTINE MATMAT2(A1,A2,A3)
7975 > #ifndef OSF
7976 > cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
7977 > #endif
7978 >       implicit real*8 (a-h,o-z)
7979 >       include 'DIMENSIONS'
7980 >       DIMENSION A1(2,2),A2(2,2),A3(2,2)
7981 > c      DIMENSION AI3(2,2)
7982 > c        DO  J=1,2
7983 > c          A3IJ=0.0
7984 > c          DO K=1,2
7985 > c           A3IJ=A3IJ+A1(I,K)*A2(K,J)
7986 > c          enddo
7987 > c          A3(I,J)=A3IJ
7988 > c       enddo
7989 > c      enddo
7990 >
7991 >       ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
7992 >       ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
7993 >       ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
7994 >       ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
7995 >
7996 >       A3(1,1)=AI3_11
7997 >       A3(2,1)=AI3_21
7998 >       A3(1,2)=AI3_12
7999 >       A3(2,2)=AI3_22
8000 >       END
8001 >
8002 > c-------------------------------------------------------------------------
8003 >       double precision function scalar2(u,v)
8004 > !DIR$ INLINEALWAYS scalar2
8005 >       implicit none
8006 >       double precision u(2),v(2)
8007 >       double precision sc
8008 >       integer i
8009 >       scalar2=u(1)*v(1)+u(2)*v(2)
8010 >       return
8011 >       end
8012 >
8013 > C-----------------------------------------------------------------------------
8014 >
8015 >       subroutine transpose2(a,at)
8016 > !DIR$ INLINEALWAYS transpose2
8017 > #ifndef OSF
8018 > cDEC$ ATTRIBUTES FORCEINLINE::transpose2
8019 > #endif
8020 >       implicit none
8021 >       double precision a(2,2),at(2,2)
8022 >       at(1,1)=a(1,1)
8023 >       at(1,2)=a(2,1)
8024 >       at(2,1)=a(1,2)
8025 >       at(2,2)=a(2,2)
8026 >       return
8027 >       end
8028 > c--------------------------------------------------------------------------
8029 >       subroutine transpose(n,a,at)
8030 >       implicit none
8031 >       integer n,i,j
8032 >       double precision a(n,n),at(n,n)
8033 >       do i=1,n
8034 >         do j=1,n
8035 >           at(j,i)=a(i,j)
8036 >         enddo
8037 >       enddo
8038 >       return
8039 >       end
8040 > C---------------------------------------------------------------------------
8041 >       subroutine prodmat3(a1,a2,kk,transp,prod)
8042 > !DIR$ INLINEALWAYS prodmat3
8043 > #ifndef OSF
8044 > cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
8045 > #endif
8046 >       implicit none
8047 >       integer i,j
8048 >       double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8049 >       logical transp
8050 > crc      double precision auxmat(2,2),prod_(2,2)
8051 >
8052 >       if (transp) then
8053 > crc        call transpose2(kk(1,1),auxmat(1,1))
8054 > crc        call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8055 > crc        call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8056 >
8057 >            prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8058 >      & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8059 >            prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8060 >      & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8061 >            prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8062 >      & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8063 >            prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8064 >      & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8065 >
8066 >       else
8067 > crc        call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8068 > crc        call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8069 >
8070 >            prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8071 >      &  +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8072 >            prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8073 >      &  +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8074 >            prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8075 >      &  +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8076 >            prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8077 >      &  +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8078 >
8079 >       endif
8080 > c      call transpose2(a2(1,1),a2t(1,1))
8081 >
8082 > crc      print *,transp
8083 > crc      print *,((prod_(i,j),i=1,2),j=1,2)
8084 > crc      print *,((prod(i,j),i=1,2),j=1,2)
8085 >
8086 >       return
8087 >       end
8088 >