1 SUBROUTINE etotal(energia)
\r
2 implicit real*8 (a-h,o-z)
\r
7 cMS$ATTRIBUTES C :: proc_proc
\r
12 double precision weights_(n_ene)
\r
14 include 'COMMON.SETUP'
\r
15 include 'COMMON.IOUNITS'
\r
16 double precision energia(0:n_ene)
\r
17 include 'COMMON.LOCAL'
\r
18 include 'COMMON.FFIELD'
\r
19 include 'COMMON.DERIV'
\r
20 include 'COMMON.INTERACT'
\r
21 include 'COMMON.SBRIDGE'
\r
22 include 'COMMON.CHAIN'
\r
23 include 'COMMON.VAR'
\r
25 include 'COMMON.CONTROL'
\r
26 include 'COMMON.TIME1'
\r
28 c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
\r
29 c & " nfgtasks",nfgtasks
\r
30 if (nfgtasks.gt.1) then
\r
36 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
\r
37 if (fg_rank.eq.0) then
\r
38 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
\r
39 c print *,"Processor",myrank," BROADCAST iorder"
\r
40 C FG master sets up the WEIGHTS_ array which will be broadcast to the
\r
41 C FG slaves as WEIGHTS array.
\r
56 weights_(15)=wstrain
\r
62 C FG Master broadcasts the WEIGHTS_ array
\r
63 call MPI_Bcast(weights_(1),n_ene,
\r
64 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
\r
66 C FG slaves receive the WEIGHTS array
\r
67 call MPI_Bcast(weights(1),n_ene,
\r
68 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
\r
90 time_Bcast=time_Bcast+MPI_Wtime()-time00
\r
91 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
\r
92 c call chainbuild_cart
\r
94 c print *,'Processor',myrank,' calling etotal ipot=',ipot
\r
95 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
\r
97 c if (modecalc.eq.12.or.modecalc.eq.14) then
\r
98 c call int_from_cart1(.false.)
\r
109 C Compute the side-chain and electrostatic interaction energy
\r
111 goto (101,102,103,104,105,106,107) ipot
\r
112 C Lennard-Jones potential.
\r
113 101 call elj(evdw,evdw_p,evdw_m)
\r
114 cd print '(a)','Exit ELJ'
\r
116 C Lennard-Jones-Kihara potential (shifted).
\r
117 102 call eljk(evdw,evdw_p,evdw_m)
\r
119 C Berne-Pechukas potential (dilated LJ, angular dependence).
\r
120 103 call ebp(evdw,evdw_p,evdw_m)
\r
122 C Gay-Berne potential (shifted LJ, angular dependence).
\r
123 104 call egb(evdw,evdw_p,evdw_m)
\r
125 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
\r
126 105 call egbv(evdw,evdw_p,evdw_m)
\r
128 C New SC-SC potential
\r
129 106 call emomo(evdw,evdw_p,evdw_m)
\r
131 C Soft-sphere potential
\r
132 107 call e_softsphere(evdw)
\r
134 C Calculate electrostatic (H-bonding) energy of the main chain.
\r
137 c print *,"Processor",myrank," computed USCSC"
\r
140 time01=MPI_Wtime()
\r
148 time_vec=time_vec+MPI_Wtime()-time01
\r
150 time_vec=time_vec+tcpu()-time01
\r
153 c print *,"Processor",myrank," left VEC_AND_DERIV"
\r
154 IF (ipot.lt.7) THEN
\r
156 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
\r
157 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
\r
158 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
\r
159 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
\r
161 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
\r
162 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
\r
163 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
\r
164 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
\r
166 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
\r
175 c write (iout,*) "Soft-spheer ELEC potential"
\r
176 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
\r
179 c print *,"Processor",myrank," computed UELEC"
\r
181 C Calculate excluded-volume interaction energy between peptide groups
\r
184 if (ipot.lt.7) then
\r
185 if(wscp.gt.0d0) then
\r
186 call escp(evdw2,evdw2_14)
\r
192 c write (iout,*) "Soft-sphere SCP potential"
\r
193 call escp_soft_sphere(evdw2,evdw2_14)
\r
196 c Calculate the bond-stretching energy
\r
200 C Calculate the disulfide-bridge and other energy and the contributions
\r
201 C from other distance constraints.
\r
202 cd print *,'Calling EHPB'
\r
204 cd print *,'EHPB exitted succesfully.'
\r
206 C Calculate the virtual-bond-angle energy.
\r
208 if (wang.gt.0d0) then
\r
213 c print *,"Processor",myrank," computed UB"
\r
215 C Calculate the SC local energy.
\r
218 c print *,"Processor",myrank," computed USC"
\r
220 C Calculate the virtual-bond torsional energy.
\r
222 cd print *,'nterm=',nterm
\r
223 if (wtor.gt.0) then
\r
224 call etor(etors,edihcnstr)
\r
229 c print *,"Processor",myrank," computed Utor"
\r
231 C 6/23/01 Calculate double-torsional energy
\r
233 if (wtor_d.gt.0) then
\r
234 call etor_d(etors_d)
\r
238 c print *,"Processor",myrank," computed Utord"
\r
240 C 21/5/07 Calculate local sicdechain correlation energy
\r
242 write (*,*) "eback_sc_corr XX"
\r
243 if (wsccor.gt.0.0d0) then
\r
244 write (*,*) "eback_sc_corr 00a"
\r
245 call eback_sc_corr(esccor)
\r
247 write (*,*) "eback_sc_corr 00b"
\r
250 c print *,"Processor",myrank," computed Usccorr"
\r
252 C 12/1/95 Multi-body terms
\r
256 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
\r
257 & .or. wturn6.gt.0.0d0) .and. ipot.lt.7) then
\r
258 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
\r
259 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
\r
260 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
\r
267 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.7) then
\r
268 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
\r
269 cd write (iout,*) "multibody_hb ecorr",ecorr
\r
271 c print *,"Processor",myrank," computed Ucorr"
\r
273 C If performing constraint dynamics, call the constraint energy
\r
274 C after the equilibration time
\r
275 IF(usampl.and.totT.gt.eq_time) THEN
\r
284 time_enecalc=time_enecalc+MPI_Wtime()-time00
\r
286 time_enecalc=time_enecalc+tcpu()-time00
\r
289 c print *,"Processor",myrank," computed Uconstr"
\r
302 energia(2)=evdw2-evdw2_14
\r
303 energia(18)=evdw2_14
\r
312 energia(3)=ees+evdw1
\r
319 energia(8)=eello_turn3
\r
320 energia(9)=eello_turn4
\r
325 energia(14)=etors_d
\r
327 energia(19)=edihcnstr
\r
329 energia(20)=Uconst+Uconst_back
\r
333 c print *," Processor",myrank," calls SUM_ENERGY"
\r
334 call sum_energy(energia,.true.)
\r
335 c print *," Processor",myrank," left SUM_ENERGY"
\r
338 time_sumene=time_sumene+MPI_Wtime()-time00
\r
340 time_sumene=time_sumene+tcpu()-time00
\r
344 END SUBROUTINE etotal
\r
347 c-------------------------------------------------------------------------------
\r
350 subroutine sum_energy(energia,reduce)
\r
351 implicit real*8 (a-h,o-z)
\r
352 include 'DIMENSIONS'
\r
356 cMS$ATTRIBUTES C :: proc_proc
\r
362 include 'COMMON.SETUP'
\r
363 include 'COMMON.IOUNITS'
\r
364 double precision energia(0:n_ene),enebuff(0:n_ene+1)
\r
365 include 'COMMON.FFIELD'
\r
366 include 'COMMON.DERIV'
\r
367 include 'COMMON.INTERACT'
\r
368 include 'COMMON.SBRIDGE'
\r
369 include 'COMMON.CHAIN'
\r
370 include 'COMMON.VAR'
\r
371 include 'COMMON.CONTROL'
\r
372 include 'COMMON.TIME1'
\r
375 if (nfgtasks.gt.1 .and. reduce) then
\r
377 write (iout,*) "energies before REDUCE"
\r
378 call enerprint(energia)
\r
382 enebuff(i)=energia(i)
\r
385 call MPI_Barrier(FG_COMM,IERR)
\r
386 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
\r
388 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
\r
389 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
\r
391 write (iout,*) "energies after REDUCE"
\r
392 call enerprint(energia)
\r
395 time_Reduce=time_Reduce+MPI_Wtime()-time00
\r
397 if (fg_rank.eq.0) then
\r
400 evdw=energia(22)+wsct*energia(23)
\r
405 evdw2=energia(2)+energia(18)
\r
406 evdw2_14=energia(18)
\r
421 eello_turn3=energia(8)
\r
422 eello_turn4=energia(9)
\r
427 etors_d=energia(14)
\r
429 edihcnstr=energia(19)
\r
434 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
\r
435 & +wang*ebe+wtor*etors+wscloc*escloc
\r
436 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
\r
437 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
\r
438 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
\r
439 & +wbond*estr+Uconst+wsccor*esccor
\r
441 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
\r
442 & +wang*ebe+wtor*etors+wscloc*escloc
\r
443 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
\r
444 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
\r
445 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
\r
446 & +wbond*estr+Uconst+wsccor*esccor
\r
452 if (isnan(etot).ne.0) energia(0)=1.0d+99
\r
454 if (isnan(etot)) energia(0)=1.0d+99
\r
459 idumm=proc_proc(etot,i)
\r
461 call proc_proc(etot,i)
\r
463 if(i.eq.1)energia(0)=1.0d+99
\r
472 c-------------------------------------------------------------------------------
\r
475 subroutine sum_gradient
\r
476 implicit real*8 (a-h,o-z)
\r
477 include 'DIMENSIONS'
\r
481 cMS$ATTRIBUTES C :: proc_proc
\r
487 double precision gradbufc(3,maxres),gradbufx(3,maxres),
\r
488 & glocbuf(4*maxres),gradbufc_sum(3,maxres)
\r
489 include 'COMMON.SETUP'
\r
490 include 'COMMON.IOUNITS'
\r
491 include 'COMMON.FFIELD'
\r
492 include 'COMMON.DERIV'
\r
493 include 'COMMON.INTERACT'
\r
494 include 'COMMON.SBRIDGE'
\r
495 include 'COMMON.CHAIN'
\r
496 include 'COMMON.VAR'
\r
497 include 'COMMON.CONTROL'
\r
498 include 'COMMON.TIME1'
\r
499 include 'COMMON.MAXGRAD'
\r
508 write (iout,*) "sum_gradient gvdwc, gvdwx"
\r
510 write (iout,'(i3,3f10.5,5x,3f10.5,5x,3f10.5,5x,3f10.5)')
\r
511 & i,(gvdwx(j,i),j=1,3),(gvdwcT(j,i),j=1,3),(gvdwc(j,i),j=1,3),
\r
512 & (gvdwcT(j,i),j=1,3)
\r
517 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
\r
518 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
\r
519 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
\r
522 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
\r
523 C in virtual-bond-vector coordinates
\r
526 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
\r
528 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
\r
529 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
\r
531 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
\r
533 c write (iout,'(i5,3f10.5,2x,f10.5)')
\r
534 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
\r
536 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
\r
538 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
\r
539 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
\r
548 gradbufc(j,i)=wsc*gvdwc(j,i)+wsc*wscT*gvdwcT(j,i)+
\r
549 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
\r
550 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
\r
551 & wel_loc*gel_loc_long(j,i)+
\r
552 & wcorr*gradcorr_long(j,i)+
\r
553 & wcorr5*gradcorr5_long(j,i)+
\r
554 & wcorr6*gradcorr6_long(j,i)+
\r
555 & wturn6*gcorr6_turn_long(j,i)+
\r
556 & wstrain*ghpbc(j,i)
\r
562 gradbufc(j,i)=wsc*gvdwc(j,i)+
\r
563 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
\r
564 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
\r
565 & wel_loc*gel_loc_long(j,i)+
\r
566 & wcorr*gradcorr_long(j,i)+
\r
567 & wcorr5*gradcorr5_long(j,i)+
\r
568 & wcorr6*gradcorr6_long(j,i)+
\r
569 & wturn6*gcorr6_turn_long(j,i)+
\r
570 & wstrain*ghpbc(j,i)
\r
577 gradbufc(j,i)=wsc*gvdwc(j,i)+
\r
578 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
\r
579 & welec*gelc_long(j,i)+
\r
580 & wbond*gradb(j,i)+
\r
581 & wel_loc*gel_loc_long(j,i)+
\r
582 & wcorr*gradcorr_long(j,i)+
\r
583 & wcorr5*gradcorr5_long(j,i)+
\r
584 & wcorr6*gradcorr6_long(j,i)+
\r
585 & wturn6*gcorr6_turn_long(j,i)+
\r
586 & wstrain*ghpbc(j,i)
\r
591 if (nfgtasks.gt.1) then
\r
594 write (iout,*) "gradbufc before allreduce"
\r
596 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
\r
602 gradbufc_sum(j,i)=gradbufc(j,i)
\r
605 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
\r
606 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
\r
607 c time_reduce=time_reduce+MPI_Wtime()-time00
\r
609 c write (iout,*) "gradbufc_sum after allreduce"
\r
611 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
\r
616 c time_allreduce=time_allreduce+MPI_Wtime()-time00
\r
620 gradbufc(k,i)=0.0d0
\r
624 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
\r
625 write (iout,*) (i," jgrad_start",jgrad_start(i),
\r
626 & " jgrad_end ",jgrad_end(i),
\r
627 & i=igrad_start,igrad_end)
\r
630 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
\r
631 c do not parallelize this part.
\r
633 c do i=igrad_start,igrad_end
\r
634 c do j=jgrad_start(i),jgrad_end(i)
\r
636 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
\r
641 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
\r
645 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
\r
649 write (iout,*) "gradbufc after summing"
\r
651 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
\r
658 write (iout,*) "gradbufc"
\r
660 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
\r
666 gradbufc_sum(j,i)=gradbufc(j,i)
\r
667 gradbufc(j,i)=0.0d0
\r
671 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
\r
675 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
\r
680 c gradbufc(k,i)=0.0d0
\r
684 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
\r
689 write (iout,*) "gradbufc after summing"
\r
691 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
\r
699 gradbufc(k,nres)=0.0d0
\r
704 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
\r
705 & wel_loc*gel_loc(j,i)+
\r
706 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
\r
707 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
\r
708 & wel_loc*gel_loc_long(j,i)+
\r
709 & wcorr*gradcorr_long(j,i)+
\r
710 & wcorr5*gradcorr5_long(j,i)+
\r
711 & wcorr6*gradcorr6_long(j,i)+
\r
712 & wturn6*gcorr6_turn_long(j,i))+
\r
713 & wbond*gradb(j,i)+
\r
714 & wcorr*gradcorr(j,i)+
\r
715 & wturn3*gcorr3_turn(j,i)+
\r
716 & wturn4*gcorr4_turn(j,i)+
\r
717 & wcorr5*gradcorr5(j,i)+
\r
718 & wcorr6*gradcorr6(j,i)+
\r
719 & wturn6*gcorr6_turn(j,i)+
\r
720 & wsccor*gsccorc(j,i)
\r
721 & +wscloc*gscloc(j,i)
\r
723 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
\r
724 & wel_loc*gel_loc(j,i)+
\r
725 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
\r
726 & welec*gelc_long(j,i)+
\r
727 & wel_loc*gel_loc_long(j,i)+
\r
728 & wcorr*gcorr_long(j,i)+
\r
729 & wcorr5*gradcorr5_long(j,i)+
\r
730 & wcorr6*gradcorr6_long(j,i)+
\r
731 & wturn6*gcorr6_turn_long(j,i))+
\r
732 & wbond*gradb(j,i)+
\r
733 & wcorr*gradcorr(j,i)+
\r
734 & wturn3*gcorr3_turn(j,i)+
\r
735 & wturn4*gcorr4_turn(j,i)+
\r
736 & wcorr5*gradcorr5(j,i)+
\r
737 & wcorr6*gradcorr6(j,i)+
\r
738 & wturn6*gcorr6_turn(j,i)+
\r
739 & wsccor*gsccorc(j,i)
\r
740 & +wscloc*gscloc(j,i)
\r
743 gradx(j,i,icg)=wsc*gvdwx(j,i)+wsc*wscT*gvdwxT(j,i)+
\r
744 & wscp*gradx_scp(j,i)+
\r
745 & wbond*gradbx(j,i)+
\r
746 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
\r
747 & wsccor*gsccorx(j,i)
\r
748 & +wscloc*gsclocx(j,i)
\r
750 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
\r
751 & wbond*gradbx(j,i)+
\r
752 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
\r
753 & wsccor*gsccorx(j,i)
\r
754 & +wscloc*gsclocx(j,i)
\r
760 write (iout,*) "gloc before adding corr"
\r
762 write (iout,*) i,gloc(i,icg)
\r
766 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
\r
767 & +wcorr5*g_corr5_loc(i)
\r
768 & +wcorr6*g_corr6_loc(i)
\r
769 & +wturn4*gel_loc_turn4(i)
\r
770 & +wturn3*gel_loc_turn3(i)
\r
771 & +wturn6*gel_loc_turn6(i)
\r
772 & +wel_loc*gel_loc_loc(i)
\r
773 & +wsccor*gsccor_loc(i)
\r
776 write (iout,*) "gloc after adding corr"
\r
778 write (iout,*) i,gloc(i,icg)
\r
782 if (nfgtasks.gt.1) then
\r
785 gradbufc(j,i)=gradc(j,i,icg)
\r
786 gradbufx(j,i)=gradx(j,i,icg)
\r
790 glocbuf(i)=gloc(i,icg)
\r
793 call MPI_Barrier(FG_COMM,IERR)
\r
794 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
\r
796 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
\r
797 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
\r
798 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
\r
799 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
\r
800 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
\r
801 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
\r
802 time_reduce=time_reduce+MPI_Wtime()-time00
\r
804 write (iout,*) "gloc after reduce"
\r
806 write (iout,*) i,gloc(i,icg)
\r
811 if (gnorm_check) then
\r
813 c Compute the maximum elements of the gradient
\r
816 gvdwc_scp_max=0.0d0
\r
823 gcorr3_turn_max=0.0d0
\r
824 gcorr4_turn_max=0.0d0
\r
825 gradcorr5_max=0.0d0
\r
826 gradcorr6_max=0.0d0
\r
827 gcorr6_turn_max=0.0d0
\r
831 gradx_scp_max=0.0d0
\r
837 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
\r
838 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
\r
840 gvdwc_norm=dsqrt(scalar(gvdwcT(1,i),gvdwcT(1,i)))
\r
841 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
\r
843 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
\r
844 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
\r
845 & gvdwc_scp_max=gvdwc_scp_norm
\r
846 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
\r
847 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
\r
848 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
\r
849 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
\r
850 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
\r
851 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
\r
852 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
\r
853 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
\r
854 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
\r
855 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
\r
856 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
\r
857 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
\r
858 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
\r
859 & gcorr3_turn(1,i)))
\r
860 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
\r
861 & gcorr3_turn_max=gcorr3_turn_norm
\r
862 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
\r
863 & gcorr4_turn(1,i)))
\r
864 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
\r
865 & gcorr4_turn_max=gcorr4_turn_norm
\r
866 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
\r
867 if (gradcorr5_norm.gt.gradcorr5_max)
\r
868 & gradcorr5_max=gradcorr5_norm
\r
869 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
\r
870 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
\r
871 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
\r
872 & gcorr6_turn(1,i)))
\r
873 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
\r
874 & gcorr6_turn_max=gcorr6_turn_norm
\r
875 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
\r
876 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
\r
877 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
\r
878 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
\r
879 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
\r
880 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
\r
882 gvdwx_norm=dsqrt(scalar(gvdwxT(1,i),gvdwxT(1,i)))
\r
883 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
\r
885 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
\r
886 if (gradx_scp_norm.gt.gradx_scp_max)
\r
887 & gradx_scp_max=gradx_scp_norm
\r
888 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
\r
889 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
\r
890 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
\r
891 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
\r
892 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
\r
893 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
\r
894 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
\r
895 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
\r
899 open(istat,file=statname,position="append")
\r
901 open(istat,file=statname,access="append")
\r
903 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
\r
904 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
\r
905 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
\r
906 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
\r
907 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
\r
908 & gsccorx_max,gsclocx_max
\r
910 if (gvdwc_max.gt.1.0d4) then
\r
911 write (iout,*) "gvdwc gvdwx gradb gradbx"
\r
913 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
\r
914 & gradb(j,i),gradbx(j,i),j=1,3)
\r
916 call pdbout(0.0d0,'cipiszcze',iout)
\r
922 write (iout,*) "gradc gradx gloc"
\r
924 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
\r
925 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
\r
930 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
\r
932 time_sumgradient=time_sumgradient+tcpu()-time01
\r
939 c-------------------------------------------------------------------------------
\r
942 subroutine rescale_weights(t_bath)
\r
943 implicit real*8 (a-h,o-z)
\r
944 include 'DIMENSIONS'
\r
945 include 'COMMON.IOUNITS'
\r
946 include 'COMMON.FFIELD'
\r
947 include 'COMMON.SBRIDGE'
\r
948 double precision kfac /2.4d0/
\r
949 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
\r
950 c facT=temp0/t_bath
\r
951 c facT=2*temp0/(t_bath+temp0)
\r
952 if (rescale_mode.eq.0) then
\r
958 else if (rescale_mode.eq.1) then
\r
959 facT=kfac/(kfac-1.0d0+t_bath/temp0)
\r
960 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
\r
961 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
\r
962 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
\r
963 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
\r
964 else if (rescale_mode.eq.2) then
\r
970 facT=licznik/dlog(dexp(x)+dexp(-x))
\r
971 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
\r
972 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
\r
973 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
\r
974 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
\r
976 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
\r
977 write (*,*) "Wrong RESCALE_MODE",rescale_mode
\r
979 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
\r
983 welec=weights(3)*fact
\r
984 wcorr=weights(4)*fact3
\r
985 wcorr5=weights(5)*fact4
\r
986 wcorr6=weights(6)*fact5
\r
987 wel_loc=weights(7)*fact2
\r
988 wturn3=weights(8)*fact2
\r
989 wturn4=weights(9)*fact3
\r
990 wturn6=weights(10)*fact5
\r
991 wtor=weights(13)*fact
\r
992 wtor_d=weights(14)*fact2
\r
993 wsccor=weights(21)*fact
\r
995 c wsct=t_bath/temp0
\r
996 wsct=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
\r
1002 C------------------------------------------------------------------------
\r
1005 subroutine enerprint(energia)
\r
1006 implicit real*8 (a-h,o-z)
\r
1007 include 'DIMENSIONS'
\r
1008 include 'COMMON.IOUNITS'
\r
1009 include 'COMMON.FFIELD'
\r
1010 include 'COMMON.SBRIDGE'
\r
1011 include 'COMMON.MD'
\r
1012 double precision energia(0:n_ene)
\r
1015 evdw=energia(22)+wsct*energia(23)
\r
1021 evdw2=energia(2)+energia(18)
\r
1032 eel_loc=energia(7)
\r
1033 eello_turn3=energia(8)
\r
1034 eello_turn4=energia(9)
\r
1035 eello_turn6=energia(10)
\r
1037 escloc=energia(12)
\r
1039 etors_d=energia(14)
\r
1041 edihcnstr=energia(19)
\r
1043 Uconst=energia(20)
\r
1044 esccor=energia(21)
\r
1046 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
\r
1047 & estr,wbond,ebe,wang,
\r
1048 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
\r
1050 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
\r
1051 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
\r
1052 & edihcnstr,ebr*nss,
\r
1054 10 format (/'Virtual-chain energies:'//
\r
1055 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
\r
1056 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
\r
1057 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
\r
1058 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
\r
1059 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
\r
1060 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
\r
1061 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
\r
1062 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
\r
1063 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
\r
1064 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
\r
1065 & ' (SS bridges & dist. cnstr.)'/
\r
1066 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
\r
1067 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
\r
1068 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
\r
1069 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
\r
1070 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
\r
1071 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
\r
1072 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
\r
1073 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
\r
1074 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
\r
1075 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
\r
1076 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
\r
1077 & 'ETOT= ',1pE16.6,' (total)')
\r
1079 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
\r
1080 & estr,wbond,ebe,wang,
\r
1081 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
\r
1083 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
\r
1084 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
\r
1085 & ebr*nss,Uconst,etot
\r
1086 10 format (/'Virtual-chain energies:'//
\r
1087 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
\r
1088 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
\r
1089 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
\r
1090 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
\r
1091 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
\r
1092 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
\r
1093 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
\r
1094 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
\r
1095 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
\r
1096 & ' (SS bridges & dist. cnstr.)'/
\r
1097 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
\r
1098 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
\r
1099 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
\r
1100 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
\r
1101 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
\r
1102 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
\r
1103 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
\r
1104 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
\r
1105 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
\r
1106 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
\r
1107 & 'UCONST=',1pE16.6,' (Constraint energy)'/
\r
1108 & 'ETOT= ',1pE16.6,' (total)')
\r
1114 C-----------------------------------------------------------------------
\r
1117 subroutine elj(evdw,evdw_p,evdw_m)
\r
1119 C This subroutine calculates the interaction energy of nonbonded side chains
\r
1120 C assuming the LJ potential of interaction.
\r
1122 implicit real*8 (a-h,o-z)
\r
1123 include 'DIMENSIONS'
\r
1124 parameter (accur=1.0d-10)
\r
1125 include 'COMMON.GEO'
\r
1126 include 'COMMON.VAR'
\r
1127 include 'COMMON.LOCAL'
\r
1128 include 'COMMON.CHAIN'
\r
1129 include 'COMMON.DERIV'
\r
1130 include 'COMMON.INTERACT'
\r
1131 include 'COMMON.TORSION'
\r
1132 include 'COMMON.SBRIDGE'
\r
1133 include 'COMMON.NAMES'
\r
1134 include 'COMMON.IOUNITS'
\r
1135 include 'COMMON.CONTACTS'
\r
1137 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
\r
1139 do i=iatsc_s,iatsc_e
\r
1148 C Calculate SC interaction energy.
\r
1150 do iint=1,nint_gr(i)
\r
1151 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
\r
1152 cd & 'iend=',iend(i,iint)
\r
1153 do j=istart(i,iint),iend(i,iint)
\r
1158 C Change 12/1/95 to calculate four-body interactions
\r
1159 rij=xj*xj+yj*yj+zj*zj
\r
1161 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
\r
1162 eps0ij=eps(itypi,itypj)
\r
1164 e1=fac*fac*aa(itypi,itypj)
\r
1165 e2=fac*bb(itypi,itypj)
\r
1167 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
\r
1168 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
\r
1169 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
\r
1170 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
\r
1171 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
\r
1172 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
\r
1174 if (bb(itypi,itypj).gt.0) then
\r
1175 evdw_p=evdw_p+evdwij
\r
1177 evdw_m=evdw_m+evdwij
\r
1183 C Calculate the components of the gradient in DC and X
\r
1185 fac=-rrij*(e1+evdwij)
\r
1190 if (bb(itypi,itypj).gt.0.0d0) then
\r
1192 gvdwx(k,i)=gvdwx(k,i)-gg(k)
\r
1193 gvdwx(k,j)=gvdwx(k,j)+gg(k)
\r
1194 gvdwc(k,i)=gvdwc(k,i)-gg(k)
\r
1195 gvdwc(k,j)=gvdwc(k,j)+gg(k)
\r
1199 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
\r
1200 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
\r
1201 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
\r
1202 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
\r
1207 gvdwx(k,i)=gvdwx(k,i)-gg(k)
\r
1208 gvdwx(k,j)=gvdwx(k,j)+gg(k)
\r
1209 gvdwc(k,i)=gvdwc(k,i)-gg(k)
\r
1210 gvdwc(k,j)=gvdwc(k,j)+gg(k)
\r
1215 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
\r
1219 C 12/1/95, revised on 5/20/97
\r
1221 C Calculate the contact function. The ith column of the array JCONT will
\r
1222 C contain the numbers of atoms that make contacts with the atom I (of numbers
\r
1223 C greater than I). The arrays FACONT and GACONT will contain the values of
\r
1224 C the contact function and its derivative.
\r
1226 C Uncomment next line, if the correlation interactions include EVDW explicitly.
\r
1227 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
\r
1228 C Uncomment next line, if the correlation interactions are contact function only
\r
1229 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
\r
1231 sigij=sigma(itypi,itypj)
\r
1232 r0ij=rs0(itypi,itypj)
\r
1234 C Check whether the SC's are not too far to make a contact.
\r
1237 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
\r
1238 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
\r
1240 if (fcont.gt.0.0D0) then
\r
1241 C If the SC-SC distance if close to sigma, apply spline.
\r
1242 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
\r
1243 cAdam & fcont1,fprimcont1)
\r
1244 cAdam fcont1=1.0d0-fcont1
\r
1245 cAdam if (fcont1.gt.0.0d0) then
\r
1246 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
\r
1247 cAdam fcont=fcont*fcont1
\r
1249 C Uncomment following 4 lines to have the geometric average of the epsilon0's
\r
1250 cga eps0ij=1.0d0/dsqrt(eps0ij)
\r
1252 cga gg(k)=gg(k)*eps0ij
\r
1254 cga eps0ij=-evdwij*eps0ij
\r
1255 C Uncomment for AL's type of SC correlation interactions.
\r
1256 cadam eps0ij=-evdwij
\r
1257 num_conti=num_conti+1
\r
1258 jcont(num_conti,i)=j
\r
1259 facont(num_conti,i)=fcont*eps0ij
\r
1260 fprimcont=eps0ij*fprimcont/rij
\r
1262 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
\r
1263 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
\r
1264 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
\r
1265 C Uncomment following 3 lines for Skolnick's type of SC correlation.
\r
1266 gacont(1,num_conti,i)=-fprimcont*xj
\r
1267 gacont(2,num_conti,i)=-fprimcont*yj
\r
1268 gacont(3,num_conti,i)=-fprimcont*zj
\r
1269 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
\r
1270 cd write (iout,'(2i3,3f10.5)')
\r
1271 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
\r
1279 num_cont(i)=num_conti
\r
1283 gvdwc(j,i)=expon*gvdwc(j,i)
\r
1284 gvdwx(j,i)=expon*gvdwx(j,i)
\r
1287 C******************************************************************************
\r
1291 C To save time, the factor of EXPON has been extracted from ALL components
\r
1292 C of GVDWC and GRADX. Remember to multiply them by this factor before further
\r
1295 C******************************************************************************
\r
1300 C-----------------------------------------------------------------------------
\r
1303 subroutine eljk(evdw,evdw_p,evdw_m)
\r
1305 C This subroutine calculates the interaction energy of nonbonded side chains
\r
1306 C assuming the LJK potential of interaction.
\r
1308 implicit real*8 (a-h,o-z)
\r
1309 include 'DIMENSIONS'
\r
1310 include 'COMMON.GEO'
\r
1311 include 'COMMON.VAR'
\r
1312 include 'COMMON.LOCAL'
\r
1313 include 'COMMON.CHAIN'
\r
1314 include 'COMMON.DERIV'
\r
1315 include 'COMMON.INTERACT'
\r
1316 include 'COMMON.IOUNITS'
\r
1317 include 'COMMON.NAMES'
\r
1320 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
\r
1322 do i=iatsc_s,iatsc_e
\r
1329 C Calculate SC interaction energy.
\r
1331 do iint=1,nint_gr(i)
\r
1332 do j=istart(i,iint),iend(i,iint)
\r
1337 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
\r
1338 fac_augm=rrij**expon
\r
1339 e_augm=augm(itypi,itypj)*fac_augm
\r
1340 r_inv_ij=dsqrt(rrij)
\r
1341 rij=1.0D0/r_inv_ij
\r
1342 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
\r
1343 fac=r_shift_inv**expon
\r
1344 e1=fac*fac*aa(itypi,itypj)
\r
1345 e2=fac*bb(itypi,itypj)
\r
1346 evdwij=e_augm+e1+e2
\r
1347 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
\r
1348 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
\r
1349 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
\r
1350 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
\r
1351 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
\r
1352 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
\r
1353 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
\r
1355 if (bb(itypi,itypj).gt.0) then
\r
1356 evdw_p=evdw_p+evdwij
\r
1358 evdw_m=evdw_m+evdwij
\r
1364 C Calculate the components of the gradient in DC and X
\r
1366 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
\r
1371 if (bb(itypi,itypj).gt.0.0d0) then
\r
1373 gvdwx(k,i)=gvdwx(k,i)-gg(k)
\r
1374 gvdwx(k,j)=gvdwx(k,j)+gg(k)
\r
1375 gvdwc(k,i)=gvdwc(k,i)-gg(k)
\r
1376 gvdwc(k,j)=gvdwc(k,j)+gg(k)
\r
1380 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
\r
1381 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
\r
1382 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
\r
1383 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
\r
1388 gvdwx(k,i)=gvdwx(k,i)-gg(k)
\r
1389 gvdwx(k,j)=gvdwx(k,j)+gg(k)
\r
1390 gvdwc(k,i)=gvdwc(k,i)-gg(k)
\r
1391 gvdwc(k,j)=gvdwc(k,j)+gg(k)
\r
1396 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
\r
1404 gvdwc(j,i)=expon*gvdwc(j,i)
\r
1405 gvdwx(j,i)=expon*gvdwx(j,i)
\r
1412 C-----------------------------------------------------------------------------
\r
1415 subroutine ebp(evdw,evdw_p,evdw_m)
\r
1417 C This subroutine calculates the interaction energy of nonbonded side chains
\r
1418 C assuming the Berne-Pechukas potential of interaction.
\r
1420 implicit real*8 (a-h,o-z)
\r
1421 include 'DIMENSIONS'
\r
1422 include 'COMMON.GEO'
\r
1423 include 'COMMON.VAR'
\r
1424 include 'COMMON.LOCAL'
\r
1425 include 'COMMON.CHAIN'
\r
1426 include 'COMMON.DERIV'
\r
1427 include 'COMMON.NAMES'
\r
1428 include 'COMMON.INTERACT'
\r
1429 include 'COMMON.IOUNITS'
\r
1430 include 'COMMON.CALC'
\r
1431 common /srutu/ icall
\r
1432 c double precision rrsave(maxdim)
\r
1435 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
\r
1437 c if (icall.eq.0) then
\r
1443 do i=iatsc_s,iatsc_e
\r
1449 dxi=dc_norm(1,nres+i)
\r
1450 dyi=dc_norm(2,nres+i)
\r
1451 dzi=dc_norm(3,nres+i)
\r
1452 c dsci_inv=dsc_inv(itypi)
\r
1453 dsci_inv=vbld_inv(i+nres)
\r
1455 C Calculate SC interaction energy.
\r
1457 do iint=1,nint_gr(i)
\r
1458 do j=istart(i,iint),iend(i,iint)
\r
1461 c dscj_inv=dsc_inv(itypj)
\r
1462 dscj_inv=vbld_inv(j+nres)
\r
1463 chi1=chi(itypi,itypj)
\r
1464 chi2=chi(itypj,itypi)
\r
1468 chip12=chip1*chip2
\r
1471 alf12=0.5D0*(alf1+alf2)
\r
1472 C For diagnostics only!!!
\r
1485 dxj=dc_norm(1,nres+j)
\r
1486 dyj=dc_norm(2,nres+j)
\r
1487 dzj=dc_norm(3,nres+j)
\r
1488 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
\r
1489 cd if (icall.eq.0) then
\r
1490 cd rrsave(ind)=rrij
\r
1492 cd rrij=rrsave(ind)
\r
1495 C Calculate the angle-dependent terms of energy & contributions to derivatives.
\r
1497 C Calculate whole angle-dependent part of epsilon and contributions
\r
1498 C to its derivatives
\r
1499 fac=(rrij*sigsq)**expon2
\r
1500 e1=fac*fac*aa(itypi,itypj)
\r
1501 e2=fac*bb(itypi,itypj)
\r
1502 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
\r
1503 eps2der=evdwij*eps3rt
\r
1504 eps3der=evdwij*eps2rt
\r
1505 evdwij=evdwij*eps2rt*eps3rt
\r
1507 if (bb(itypi,itypj).gt.0) then
\r
1508 evdw_p=evdw_p+evdwij
\r
1510 evdw_m=evdw_m+evdwij
\r
1516 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
\r
1517 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
\r
1518 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
\r
1519 cd & restyp(itypi),i,restyp(itypj),j,
\r
1520 cd & epsi,sigm,chi1,chi2,chip1,chip2,
\r
1521 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
\r
1522 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
\r
1525 C Calculate gradient components.
\r
1526 e1=e1*eps1*eps2rt**2*eps3rt**2
\r
1527 fac=-expon*(e1+evdwij)
\r
1530 C Calculate radial part of the gradient
\r
1534 C Calculate the angular part of the gradient and sum add the contributions
\r
1535 C to the appropriate components of the Cartesian gradient.
\r
1537 if (bb(itypi,itypj).gt.0) then
\r
1553 C-----------------------------------------------------------------------------
\r
1556 SUBROUTINE egb(evdw,evdw_p,evdw_m)
\r
1558 C This subroutine calculates the interaction energy of nonbonded side chains
\r
1559 C assuming the Gay-Berne potential of interaction.
\r
1561 implicit real*8 (a-h,o-z)
\r
1562 include 'DIMENSIONS'
\r
1563 include 'COMMON.GEO'
\r
1564 include 'COMMON.VAR'
\r
1565 include 'COMMON.LOCAL'
\r
1566 include 'COMMON.CHAIN'
\r
1567 include 'COMMON.DERIV'
\r
1568 include 'COMMON.NAMES'
\r
1569 include 'COMMON.INTERACT'
\r
1570 include 'COMMON.IOUNITS'
\r
1571 include 'COMMON.CALC'
\r
1572 include 'COMMON.CONTROL'
\r
1575 ccccc energy_dec=.false.
\r
1576 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
\r
1581 c if (icall.eq.0) lprn=.false.
\r
1583 do i=iatsc_s,iatsc_e
\r
1589 dxi=dc_norm(1,nres+i)
\r
1590 dyi=dc_norm(2,nres+i)
\r
1591 dzi=dc_norm(3,nres+i)
\r
1592 c dsci_inv=dsc_inv(itypi)
\r
1593 dsci_inv=vbld_inv(i+nres)
\r
1594 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
\r
1595 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
\r
1597 C Calculate SC interaction energy.
\r
1599 do iint=1,nint_gr(i)
\r
1600 do j=istart(i,iint),iend(i,iint)
\r
1603 c dscj_inv=dsc_inv(itypj)
\r
1604 dscj_inv=vbld_inv(j+nres)
\r
1605 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
\r
1606 c & 1.0d0/vbld(j+nres)
\r
1607 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
\r
1608 sig0ij=sigma(itypi,itypj)
\r
1609 chi1=chi(itypi,itypj)
\r
1610 chi2=chi(itypj,itypi)
\r
1614 chip12=chip1*chip2
\r
1617 alf12=0.5D0*(alf1+alf2)
\r
1618 C For diagnostics only!!!
\r
1631 dxj=dc_norm(1,nres+j)
\r
1632 dyj=dc_norm(2,nres+j)
\r
1633 dzj=dc_norm(3,nres+j)
\r
1634 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
\r
1635 c write (iout,*) "j",j," dc_norm",
\r
1636 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
\r
1637 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
\r
1639 c---------------------------------------------------------------
\r
1640 C Calculate angle-dependent terms of energy and contributions to their
\r
1644 sig=sig0ij*dsqrt(sigsq)
\r
1645 rij_shift=1.0D0/rij-sig+sig0ij
\r
1646 c for diagnostics; uncomment
\r
1647 c rij_shift=1.2*sig0ij
\r
1648 C I hate to put IF's in the loops, but here don't have another choice!!!!
\r
1649 if (rij_shift.le.0.0D0) then
\r
1651 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
\r
1652 cd & restyp(itypi),i,restyp(itypj),j,
\r
1653 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
\r
1657 c---------------------------------------------------------------
\r
1658 rij_shift=1.0D0/rij_shift
\r
1659 fac=rij_shift**expon
\r
1660 e1=fac*fac*aa(itypi,itypj)
\r
1661 e2=fac*bb(itypi,itypj)
\r
1662 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
\r
1663 eps2der=evdwij*eps3rt
\r
1664 eps3der=evdwij*eps2rt
\r
1665 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
\r
1666 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
\r
1667 evdwij=evdwij*eps2rt*eps3rt
\r
1669 if (bb(itypi,itypj).gt.0) then
\r
1670 evdw_p=evdw_p+evdwij
\r
1672 evdw_m=evdw_m+evdwij
\r
1678 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
\r
1679 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
\r
1680 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
\r
1681 & restyp(itypi),i,restyp(itypj),j,
\r
1682 & epsi,sigm,chi1,chi2,chip1,chip2,
\r
1683 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
\r
1684 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
\r
1687 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
\r
1688 & 'evdw',i,j,evdwij
\r
1689 C Calculate gradient components.
\r
1690 e1=e1*eps1*eps2rt**2*eps3rt**2
\r
1691 fac=-expon*(e1+evdwij)*rij_shift
\r
1692 sigder = fac * sigder
\r
1695 C Calculate the radial part of the gradient
\r
1699 C Calculate angular part of the gradient.
\r
1701 if (bb(itypi,itypj).gt.0) then
\r
1712 c write (iout,*) "Number of loop steps in EGB:",ind
\r
1713 cccc energy_dec=.false.
\r
1718 C-----------------------------------------------------------------------------
\r
1721 subroutine egbv(evdw,evdw_p,evdw_m)
\r
1723 C This subroutine calculates the interaction energy of nonbonded side chains
\r
1724 C assuming the Gay-Berne-Vorobjev potential of interaction.
\r
1726 implicit real*8 (a-h,o-z)
\r
1727 include 'DIMENSIONS'
\r
1728 include 'COMMON.GEO'
\r
1729 include 'COMMON.VAR'
\r
1730 include 'COMMON.LOCAL'
\r
1731 include 'COMMON.CHAIN'
\r
1732 include 'COMMON.DERIV'
\r
1733 include 'COMMON.NAMES'
\r
1734 include 'COMMON.INTERACT'
\r
1735 include 'COMMON.IOUNITS'
\r
1736 include 'COMMON.CALC'
\r
1737 common /srutu/ icall
\r
1740 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
\r
1743 c if (icall.eq.0) lprn=.true.
\r
1745 do i=iatsc_s,iatsc_e
\r
1751 dxi=dc_norm(1,nres+i)
\r
1752 dyi=dc_norm(2,nres+i)
\r
1753 dzi=dc_norm(3,nres+i)
\r
1754 c dsci_inv=dsc_inv(itypi)
\r
1755 dsci_inv=vbld_inv(i+nres)
\r
1757 C Calculate SC interaction energy.
\r
1759 do iint=1,nint_gr(i)
\r
1760 do j=istart(i,iint),iend(i,iint)
\r
1763 c dscj_inv=dsc_inv(itypj)
\r
1764 dscj_inv=vbld_inv(j+nres)
\r
1765 sig0ij=sigma(itypi,itypj)
\r
1766 r0ij=r0(itypi,itypj)
\r
1767 chi1=chi(itypi,itypj)
\r
1768 chi2=chi(itypj,itypi)
\r
1772 chip12=chip1*chip2
\r
1775 alf12=0.5D0*(alf1+alf2)
\r
1776 C For diagnostics only!!!
\r
1789 dxj=dc_norm(1,nres+j)
\r
1790 dyj=dc_norm(2,nres+j)
\r
1791 dzj=dc_norm(3,nres+j)
\r
1792 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
\r
1794 C Calculate angle-dependent terms of energy and contributions to their
\r
1798 sig=sig0ij*dsqrt(sigsq)
\r
1799 rij_shift=1.0D0/rij-sig+r0ij
\r
1800 C I hate to put IF's in the loops, but here don't have another choice!!!!
\r
1801 if (rij_shift.le.0.0D0) then
\r
1806 c---------------------------------------------------------------
\r
1807 rij_shift=1.0D0/rij_shift
\r
1808 fac=rij_shift**expon
\r
1809 e1=fac*fac*aa(itypi,itypj)
\r
1810 e2=fac*bb(itypi,itypj)
\r
1811 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
\r
1812 eps2der=evdwij*eps3rt
\r
1813 eps3der=evdwij*eps2rt
\r
1814 fac_augm=rrij**expon
\r
1815 e_augm=augm(itypi,itypj)*fac_augm
\r
1816 evdwij=evdwij*eps2rt*eps3rt
\r
1818 if (bb(itypi,itypj).gt.0) then
\r
1819 evdw_p=evdw_p+evdwij+e_augm
\r
1821 evdw_m=evdw_m+evdwij+e_augm
\r
1824 evdw=evdw+evdwij+e_augm
\r
1827 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
\r
1828 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
\r
1829 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
\r
1830 & restyp(itypi),i,restyp(itypj),j,
\r
1831 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
\r
1832 & chi1,chi2,chip1,chip2,
\r
1833 & eps1,eps2rt**2,eps3rt**2,
\r
1834 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
\r
1837 C Calculate gradient components.
\r
1838 e1=e1*eps1*eps2rt**2*eps3rt**2
\r
1839 fac=-expon*(e1+evdwij)*rij_shift
\r
1841 fac=rij*fac-2*expon*rrij*e_augm
\r
1842 C Calculate the radial part of the gradient
\r
1846 C Calculate angular part of the gradient.
\r
1848 if (bb(itypi,itypj).gt.0) then
\r
1862 C-----------------------------------------------------------------------------
\r
1865 SUBROUTINE emomo(evdw,evdw_p,evdw_m)
\r
1867 C This subroutine calculates the interaction energy of nonbonded side chains
\r
1868 C assuming the Gay-Berne potential of interaction.
\r
1871 INCLUDE 'DIMENSIONS'
\r
1872 INCLUDE 'COMMON.CALC'
\r
1873 INCLUDE 'COMMON.CONTROL'
\r
1874 INCLUDE 'COMMON.CHAIN'
\r
1875 INCLUDE 'COMMON.DERIV'
\r
1876 INCLUDE 'COMMON.EMP'
\r
1877 INCLUDE 'COMMON.GEO'
\r
1878 INCLUDE 'COMMON.INTERACT'
\r
1879 INCLUDE 'COMMON.IOUNITS'
\r
1880 INCLUDE 'COMMON.LOCAL'
\r
1881 INCLUDE 'COMMON.NAMES'
\r
1882 INCLUDE 'COMMON.VAR'
\r
1884 double precision scalar
\r
1885 double precision ener(4)
\r
1890 ccccc energy_dec=.false.
\r
1891 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
\r
1893 c if (icall.eq.0) lprn=.false.
\r
1896 DO i = iatsc_s, iatsc_e
\r
1898 c itypi1 = itype(i+1)
\r
1899 dxi = dc_norm(1,nres+i)
\r
1900 dyi = dc_norm(2,nres+i)
\r
1901 dzi = dc_norm(3,nres+i)
\r
1902 c dsci_inv=dsc_inv(itypi)
\r
1903 dsci_inv = vbld_inv(i+nres)
\r
1904 c! This small loop calculates hydrophobic centre location
\r
1905 c! by taking Calpha location and moving by appropriate
\r
1906 c! vector built by dtail * dc_norm
\r
1908 ctail(k,1) = c(k, i+nres)
\r
1909 & - dtail(k, itypi) * dc_norm(k, nres+i)
\r
1914 c!-------------------------------------------------------------------
\r
1915 C Calculate SC interaction energy.
\r
1916 DO iint = 1, nint_gr(i)
\r
1917 DO j = istart(i,iint), iend(i,iint)
\r
1918 c! initialize variables for electrostatic gradients
\r
1919 CALL elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
\r
1921 c dscj_inv = dsc_inv(itypj)
\r
1922 dscj_inv = vbld_inv(j+nres)
\r
1923 c! rij holds 1/(distance of Calpha atoms)
\r
1924 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
\r
1926 c!-------------------------------------------------------------------
\r
1927 C Calculate angle-dependent terms of energy and contributions to their
\r
1930 c! this should be in elgrad_init but om's are calculated by sc_angular
\r
1931 c! which in turn is used by older potentials
\r
1932 c! which proves how tangled UNRES code is >.<
\r
1933 c! om = omega, sqom = om^2
\r
1936 sqom12 = om12 * om12
\r
1937 c! now we calculate FGB - Gey-Berne Force.
\r
1938 c! It will be summed up in evdwij and saved in evdw
\r
1939 sigsq = 1.0D0 / sigsq
\r
1940 sig = sig0ij * dsqrt(sigsq)
\r
1941 rij_shift = 1.0D0 / rij - sig + sig0ij
\r
1942 IF (rij_shift.le.0.0D0) THEN
\r
1946 sigder = -sig * sigsq
\r
1947 rij_shift = 1.0D0 / rij_shift
\r
1948 fac = rij_shift**expon
\r
1949 c1 = fac * fac * aa(itypi,itypj)
\r
1950 c2 = fac * bb(itypi,itypj)
\r
1951 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
\r
1952 eps2der = evdwij * eps3rt
\r
1953 eps3der = evdwij * eps2rt
\r
1954 evdwij = evdwij * eps2rt * eps3rt
\r
1956 IF (bb(itypi,itypj).gt.0) THEN
\r
1957 evdw_p = evdw_p + evdwij
\r
1959 evdw_m = evdw_m + evdwij
\r
1965 c!-------------------------------------------------------------------
\r
1966 c! Calculate some components of GGB and EGB
\r
1967 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
\r
1968 fac = -expon * (c1 + evdwij) * rij_shift
\r
1969 sigder = fac * sigder
\r
1972 c! Calculate the radial part of GGB
\r
1977 c! The angular derivatives of GGB are brought together in sc_grad
\r
1978 c!-------------------------------------------------------------------
\r
1981 c! Catch gly-gly interactions to skip calculation of something that
\r
1984 IF (itypi.eq.10.and.itypj.eq.10) THEN
\r
1992 c! we are not 2 glycines, so we calculate Fcav
\r
1993 fac = chis1 * sqom1 + chis2 * sqom2
\r
1994 & - 2.0d0 * chis12 * om1 * om2 * om12
\r
1995 c! we will use pom later in Gcav, so dont mess with it!
\r
1996 pom = 1.0d0 - chis1 * chis2 * sqom12
\r
1998 Lambf = (1.0d0 - (fac / pom))
\r
1999 Lambf = dsqrt(Lambf)
\r
2001 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
\r
2002 Chif = Rtail * sparrow
\r
2003 ChiLambf = Chif * Lambf
\r
2004 eagle = dsqrt(ChiLambf)
\r
2005 bat = ChiLambf ** 11.0d0
\r
2007 top = b1 * ( eagle + b2 * ChiLambf - b3 )
\r
2008 bot = 1.0d0 + b4 * (ChiLambf * bat)
\r
2013 c!-------------------------------------------------------------------
\r
2014 c! derivative of Fcav is Gcav...
\r
2015 c!---------------------------------------------------
\r
2017 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
\r
2018 dbot = 12.0d0 * b4 * bat * Lambf
\r
2019 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
\r
2021 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
\r
2022 dbot = 12.0d0 * b4 * bat * Chif
\r
2023 eagle = Lambf * pom
\r
2024 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
\r
2025 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
\r
2026 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2)
\r
2027 & * (chis2 * om2 * om12 - om1) / (eagle * pom)
\r
2029 dFdL = ((dtop * bot - top * dbot) / botsq)
\r
2030 dCAVdOM1 = dFdL * ( dFdOM1 )
\r
2031 dCAVdOM2 = dFdL * ( dFdOM2 )
\r
2032 dCAVdOM12 = dFdL * ( dFdOM12 )
\r
2033 c!----------------------------------------------------
\r
2034 c! Finally, add the distance derivatives to gvdwc
\r
2035 c! Fac is used here to project the gradient vector into
\r
2036 c! cartesian coordinates
\r
2037 c! derivatives of omega angles will be added in sc_grad
\r
2039 fac = Rtail_distance(k) / Rtail
\r
2040 gvdwx(k,i) = gvdwx(k,i)
\r
2043 gvdwx(k,j) = gvdwx(k,j)
\r
2046 gvdwc(k,i) = gvdwc(k,i)
\r
2049 gvdwc(k,j) = gvdwc(k,j)
\r
2053 c!-------------------------------------------------------------------
\r
2054 c! Compute head-head and head-tail energies for each state
\r
2056 isel = iabs(Qi) + iabs(Qj)
\r
2057 IF (isel.eq.0) THEN
\r
2058 c! No charges - do nothing
\r
2061 ELSE IF (isel.eq.4) THEN
\r
2062 c! Calculate dipole-dipole interactions
\r
2066 ELSE IF (isel.eq.1 .and. iabs(Qi).eq.1) THEN
\r
2067 c! Charge-nonpolar interactions
\r
2071 ELSE IF (isel.eq.1 .and. iabs(Qj).eq.1) THEN
\r
2072 c! Nonpolar-charge interactions
\r
2076 ELSE IF (isel.eq.3 .and. icharge(itypj).eq.2) THEN
\r
2077 c! Charge-dipole interactions
\r
2078 CALL eqd(ecl, elj, epol)
\r
2079 eheadtail = ECL + elj + epol
\r
2081 ELSE IF (isel.eq.3 .and. icharge(itypi).eq.2) THEN
\r
2082 c! Dipole-charge interactions
\r
2083 CALL edq(ecl, elj, epol)
\r
2084 eheadtail = ECL + elj + epol
\r
2086 ELSE IF ((isel.eq.2.and.
\r
2087 & iabs(Qi).eq.1).and.
\r
2088 & nstate(itypi,itypj).eq.1) THEN
\r
2089 c! Same charge-charge interaction ( +/+ or -/- )
\r
2090 CALL eqq(Ecl,Egb,Epol,Fisocav,Elj)
\r
2091 eheadtail = ECL + Egb + Epol + Fisocav + Elj
\r
2093 ELSE IF ((isel.eq.2.and.
\r
2094 & iabs(Qi).eq.1).and.
\r
2095 & nstate(itypi,itypj).ne.1) THEN
\r
2096 c! Different charge-charge interaction ( +/- or -/+ )
\r
2098 & (istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
\r
2101 c! this endif ends the "catch the gly-gly" at the beggining of Fcav
\r
2106 c!-------------------------------------------------------------------
\r
2107 c! As all angular derivatives are done, now we sum them up,
\r
2108 c! then transform and project into cartesian vectors and add to gvdwc
\r
2109 c! We call sc_grad always, with the exception of +/- interaction.
\r
2110 c! This is because energy_quad subroutine needs to handle
\r
2111 c! this job in his own way.
\r
2112 c! This IS probably not very efficient and SHOULD be optimised
\r
2113 c! but it will require major restructurization of emomo
\r
2114 c! so it will be left as it is for now
\r
2115 IF (nstate(itypi,itypj).eq.1) THEN
\r
2117 IF (bb(itypi,itypj).gt.0) THEN
\r
2126 c!-------------------------------------------------------------------
\r
2134 c write (iout,*) "Number of loop steps in EGB:",ind
\r
2135 cccc energy_dec=.false.
\r
2137 END SUBROUTINE emomo
\r
2140 C--------------------------------------------------------------------
\r
2143 SUBROUTINE eqq(Ecl,Egb,Epol,Fisocav,Elj)
\r
2145 INCLUDE 'DIMENSIONS'
\r
2146 INCLUDE 'COMMON.CALC'
\r
2147 INCLUDE 'COMMON.CHAIN'
\r
2148 INCLUDE 'COMMON.CONTROL'
\r
2149 INCLUDE 'COMMON.DERIV'
\r
2150 INCLUDE 'COMMON.EMP'
\r
2151 INCLUDE 'COMMON.GEO'
\r
2152 INCLUDE 'COMMON.INTERACT'
\r
2153 INCLUDE 'COMMON.IOUNITS'
\r
2154 INCLUDE 'COMMON.LOCAL'
\r
2155 INCLUDE 'COMMON.NAMES'
\r
2156 INCLUDE 'COMMON.VAR'
\r
2157 double precision scalar
\r
2158 c! Epol and Gpol analytical parameters
\r
2159 alphapol1 = alphapol(itypi,itypj)
\r
2160 alphapol2 = alphapol(itypj,itypi)
\r
2161 c! Fisocav and Gisocav analytical parameters
\r
2162 al1 = alphiso(1,itypi,itypj)
\r
2163 al2 = alphiso(2,itypi,itypj)
\r
2164 al3 = alphiso(3,itypi,itypj)
\r
2165 al4 = alphiso(4,itypi,itypj)
\r
2166 csig = sigiso(itypi, itypj)
\r
2168 w1 = wqdip(1,itypi,itypj)
\r
2169 w2 = wqdip(2,itypi,itypj)
\r
2170 pis = sig0head(itypi,itypj)
\r
2171 eps0 = epshead(itypi,itypj)
\r
2172 Rhead_sq = Rhead * Rhead
\r
2174 c! R1 - distance between head of ith side chain and tail of jth sidechain
\r
2175 c! R2 - distance between head of jth side chain and tail of ith sidechain
\r
2179 c! Calculate head-to-tail distances
\r
2180 R1=R1+(ctail(k,2)-chead(k,1))**2
\r
2181 R2=R2+(chead(k,2)-ctail(k,1))**2
\r
2187 c!-------------------------------------------------------------------
\r
2188 c! Coulomb electrostatic interaction
\r
2189 Ecl = (332.0d0 * Qij) / Rhead
\r
2190 c! write (*,*) "Ecl = ", Ecl
\r
2191 c! derivative of Ecl is Gcl...
\r
2192 dGCLdR = (-332.0d0 * Qij ) / Rhead_sq
\r
2200 c!-------------------------------------------------------------------
\r
2201 c! Generalised Born Solvent Polarization
\r
2202 ee = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
\r
2203 Fgb = sqrt( ( Rhead_sq ) + a12sq * ee)
\r
2204 Egb = (332.0d0 * Qij * eps_inout_fac) / Fgb
\r
2206 c! Derivative of Egb is Ggb...
\r
2207 dGGBdFGB = (-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb)
\r
2208 dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee) ) )
\r
2209 & / ( 2.0d0 * Fgb )
\r
2210 dGGBdR = dGGBdFGB * dFGBdR
\r
2213 c! write (*,*) "Fgb = ", Fgb
\r
2214 c! write (*,*) "Egb = ", Egb
\r
2215 c! write (*,*) "dFGBdR = ", dFGBdR
\r
2216 c! write (*,*) "dGGBdR = ", dGGBdR
\r
2220 c!-------------------------------------------------------------------
\r
2221 c! Fisocav - isotropic cavity creation term
\r
2222 pom = Rhead * csig
\r
2223 top = al1 * (dsqrt(pom) + al2 * pom - al3)
\r
2224 bot = (1.0d0 + al4 * pom**12.0d0)
\r
2226 FisoCav = top / bot
\r
2228 c! Derivative of Fisocav is GCV...
\r
2229 dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
\r
2230 dbot = 12.0d0 * al4 * pom ** 11.0d0
\r
2231 dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
\r
2234 c! FisoCav = 0.0d0
\r
2237 c!-------------------------------------------------------------------
\r
2238 c! Polarization energy
\r
2240 MomoFac1 = (1.0d0 - chi1 * sqom2)
\r
2241 MomoFac2 = (1.0d0 - chi2 * sqom1)
\r
2242 RR1 = ( R1 * R1 ) / MomoFac1
\r
2243 RR2 = ( R2 * R2 ) / MomoFac2
\r
2244 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
\r
2245 ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
\r
2246 fgb1 = sqrt( RR1 + a12sq * ee1 )
\r
2247 fgb2 = sqrt( RR2 + a12sq * ee2 )
\r
2248 epol = 332.0d0 * eps_inout_fac * (
\r
2249 & (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
\r
2251 c! derivative of Epol is Gpol...
\r
2252 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
\r
2253 & / (fgb1 ** 5.0d0)
\r
2254 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
\r
2255 & / (fgb2 ** 5.0d0)
\r
2256 dFGBdR1 = ( (R1 / MomoFac1)
\r
2257 & * ( 2.0d0 - (0.5d0 * ee1) ) )
\r
2258 & / ( 2.0d0 * fgb1 )
\r
2259 dFGBdR2 = ( (R2 / MomoFac2)
\r
2260 & * ( 2.0d0 - (0.5d0 * ee2) ) )
\r
2261 & / ( 2.0d0 * fgb2 )
\r
2262 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
\r
2263 & * ( 2.0d0 - 0.5d0 * ee1) )
\r
2264 & / ( 2.0d0 * fgb1 )
\r
2265 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
\r
2266 & * ( 2.0d0 - 0.5d0 * ee2) )
\r
2267 & / ( 2.0d0 * fgb2 )
\r
2268 dPOLdR1 = dPOLdFGB1 * dFGBdR1
\r
2269 dPOLdR2 = dPOLdFGB2 * dFGBdR2
\r
2270 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
\r
2271 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
\r
2274 c! dPOLdR1 = 0.0d0
\r
2275 c! dPOLdR2 = 0.0d0
\r
2276 c! dPOLdOM1 = 0.0d0
\r
2277 c! dPOLdOM2 = 0.0d0
\r
2279 c!-------------------------------------------------------------------
\r
2281 pom = (pis / Rhead)**6.0d0
\r
2282 Elj = 4.0d0 * eps0 * pom * (pom-1.0d0)
\r
2283 c! write (*,*) "ELJ = ", ELJ
\r
2284 c! derivative of Elj is Glj
\r
2285 Glj = 4.0d0 * eps0
\r
2286 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
\r
2287 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
\r
2288 c! dGLJdR = glj * fish
\r
2294 c!-------------------------------------------------------------------
\r
2295 c! Return the results
\r
2297 erhead(k) = Rhead_distance(k)/Rhead
\r
2298 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
\r
2299 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
\r
2302 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
\r
2303 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
\r
2304 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
\r
2305 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
\r
2306 facd1 = d1 * vbld_inv(i+nres)
\r
2307 facd2 = d2 * vbld_inv(j+nres)
\r
2310 hawk = (erhead_tail(k,1) +
\r
2311 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
\r
2312 condor = (erhead_tail(k,2) +
\r
2313 & facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
\r
2315 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
\r
2316 gvdwx(k,i) = gvdwx(k,i)
\r
2320 & - dPOLdR1 * hawk
\r
2321 & - dPOLdR2 * erhead_tail(k,2)
\r
2324 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
\r
2325 gvdwx(k,j) = gvdwx(k,j)
\r
2329 & + dPOLdR1 * erhead_tail(k,1)
\r
2330 & + dPOLdR2 * condor
\r
2333 gvdwc(k,i) = gvdwc(k,i)
\r
2334 & - dGCLdR * erhead(k)
\r
2335 & - dGGBdR * erhead(k)
\r
2336 & - dGCVdR * erhead(k)
\r
2337 & - dPOLdR1 * erhead_tail(k,1)
\r
2338 & - dPOLdR2 * erhead_tail(k,2)
\r
2339 & - dGLJdR * erhead(k)
\r
2341 gvdwc(k,j) = gvdwc(k,j)
\r
2342 & + dGCLdR * erhead(k)
\r
2343 & + dGGBdR * erhead(k)
\r
2344 & + dGCVdR * erhead(k)
\r
2345 & + dPOLdR1 * erhead_tail(k,1)
\r
2346 & + dPOLdR2 * erhead_tail(k,2)
\r
2347 & + dGLJdR * erhead(k)
\r
2351 END SUBROUTINE eqq
\r
2354 c!-------------------------------------------------------------------
\r
2356 SUBROUTINE energy_quad
\r
2357 &(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
\r
2359 INCLUDE 'DIMENSIONS'
\r
2360 INCLUDE 'COMMON.CALC'
\r
2361 INCLUDE 'COMMON.CHAIN'
\r
2362 INCLUDE 'COMMON.CONTROL'
\r
2363 INCLUDE 'COMMON.DERIV'
\r
2364 INCLUDE 'COMMON.EMP'
\r
2365 INCLUDE 'COMMON.GEO'
\r
2366 INCLUDE 'COMMON.INTERACT'
\r
2367 INCLUDE 'COMMON.IOUNITS'
\r
2368 INCLUDE 'COMMON.LOCAL'
\r
2369 INCLUDE 'COMMON.NAMES'
\r
2370 INCLUDE 'COMMON.VAR'
\r
2371 double precision scalar
\r
2372 double precision ener(4)
\r
2373 double precision dcosom1(3),dcosom2(3)
\r
2374 c! Epol and Gpol analytical parameters
\r
2375 alphapol1 = alphapol(itypi,itypj)
\r
2376 alphapol2 = alphapol(itypj,itypi)
\r
2377 c! Fisocav and Gisocav analytical parameters
\r
2378 al1 = alphiso(1,itypi,itypj)
\r
2379 al2 = alphiso(2,itypi,itypj)
\r
2380 al3 = alphiso(3,itypi,itypj)
\r
2381 al4 = alphiso(4,itypi,itypj)
\r
2382 csig = sigiso(itypi, itypj)
\r
2384 w1 = wqdip(1,itypi,itypj)
\r
2385 w2 = wqdip(2,itypi,itypj)
\r
2386 pis = sig0head(itypi,itypj)
\r
2387 eps0 = epshead(itypi,itypj)
\r
2389 c! First things first:
\r
2390 c! We need to do sc_grad's job with GB and Fcav
\r
2393 & eps2der * eps2rt_om1
\r
2394 & - 2.0D0 * alf1 * eps3der
\r
2395 & + sigder * sigsq_om1
\r
2399 & eps2der * eps2rt_om2
\r
2400 & + 2.0D0 * alf2 * eps3der
\r
2401 & + sigder * sigsq_om2
\r
2405 & evdwij * eps1_om12
\r
2406 & + eps2der * eps2rt_om12
\r
2407 & - 2.0D0 * alf12 * eps3der
\r
2408 & + sigder *sigsq_om12
\r
2411 c! now some magical transformations to project gradient into
\r
2412 c! three cartesian vectors
\r
2415 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
\r
2416 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
\r
2417 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
\r
2418 c! this acts on hydrophobic center of interaction
\r
2419 gvdwx(k,i)= gvdwx(k,i) - gg(k)
\r
2420 & + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
\r
2421 & + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
\r
2422 gvdwx(k,j)= gvdwx(k,j) + gg(k)
\r
2423 & + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
\r
2424 & + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
\r
2425 c! this acts on Calpha
\r
2426 gvdwc(k,i)=gvdwc(k,i)-gg(k)
\r
2427 gvdwc(k,j)=gvdwc(k,j)+gg(k)
\r
2430 c! sc_grad is done, now we will compute
\r
2436 c*************************************************************
\r
2437 DO istate = 1, nstate(itypi,itypj)
\r
2438 c! DO istate = 1, 1
\r
2439 c! write (*,*) "istate = ", istate
\r
2440 c*************************************************************
\r
2441 IF (istate.ne.1) THEN
\r
2442 IF (istate.lt.3) THEN
\r
2448 d1 = dhead(1,ii,itypi,itypj)
\r
2449 d2 = dhead(2,jj,itypi,itypj)
\r
2451 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
\r
2452 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
\r
2453 Rhead_distance(k) = chead(k,2) - chead(k,1)
\r
2455 c! pitagoras (root of sum of squares)
\r
2457 & (Rhead_distance(1)*Rhead_distance(1))
\r
2458 & + (Rhead_distance(2)*Rhead_distance(2))
\r
2459 & + (Rhead_distance(3)*Rhead_distance(3)))
\r
2461 Rhead_sq = Rhead * Rhead
\r
2463 c! R1 - distance between head of ith side chain and tail of jth sidechain
\r
2464 c! R2 - distance between head of jth side chain and tail of ith sidechain
\r
2468 c! Calculate head-to-tail distances
\r
2469 R1=R1+(ctail(k,2)-chead(k,1))**2
\r
2470 R2=R2+(chead(k,2)-ctail(k,1))**2
\r
2476 c!-------------------------------------------------------------------
\r
2477 c! Coulomb electrostatic interaction
\r
2478 Ecl = (332.0d0 * Qij) / Rhead
\r
2479 c! write (*,*) "Ecl = ", Ecl
\r
2480 c! derivative of Ecl is Gcl...
\r
2481 dGCLdR = (-332.0d0 * Qij ) / Rhead_sq
\r
2483 c! write (*,*) "Ecl = ", Ecl
\r
2484 c! write (*,*) "dGCLdR = ", dGCLdR
\r
2491 c!-------------------------------------------------------------------
\r
2492 c! Generalised Born Solvent Polarization
\r
2493 ee = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
\r
2494 Fgb = sqrt( ( Rhead_sq ) + a12sq * ee)
\r
2495 Egb = (332.0d0 * Qij * eps_inout_fac) / Fgb
\r
2497 c! Derivative of Egb is Ggb...
\r
2498 dGGBdFGB = (-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb)
\r
2499 dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee) ) )
\r
2500 & / ( 2.0d0 * Fgb )
\r
2501 dGGBdR = dGGBdFGB * dFGBdR
\r
2504 c! write (*,*) "Fgb = ", Fgb
\r
2505 c! write (*,*) "Egb = ", Egb
\r
2506 c! write (*,*) "dFGBdR = ", dFGBdR
\r
2507 c! write (*,*) "dGGBdR = ", dGGBdR
\r
2511 c!-------------------------------------------------------------------
\r
2512 c! Fisocav - isotropic cavity creation term
\r
2513 pom = Rhead * csig
\r
2514 top = al1 * (dsqrt(pom) + al2 * pom - al3)
\r
2515 bot = (1.0d0 + al4 * pom**12.0d0)
\r
2517 FisoCav = top / bot
\r
2519 c! Derivative of Fisocav is GCV...
\r
2520 dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
\r
2521 dbot = 12.0d0 * al4 * pom ** 11.0d0
\r
2522 dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
\r
2525 c! write(*,*) "FisoCav = ", Fisocav
\r
2526 c! write(*,*) "dGCVdR = ", dGCVdR
\r
2527 c! FisoCav = 0.0d0
\r
2530 c!-------------------------------------------------------------------
\r
2531 c! Polarization energy
\r
2533 MomoFac1 = (1.0d0 - chi1 * sqom2)
\r
2534 MomoFac2 = (1.0d0 - chi2 * sqom1)
\r
2535 RR1 = ( R1 * R1 ) / MomoFac1
\r
2536 RR2 = ( R2 * R2 ) / MomoFac2
\r
2537 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
\r
2538 ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
\r
2539 fgb1 = sqrt( RR1 + a12sq * ee1 )
\r
2540 fgb2 = sqrt( RR2 + a12sq * ee2 )
\r
2541 epol = 332.0d0 * eps_inout_fac * (
\r
2542 & (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
\r
2544 c! derivative of Epol is Gpol...
\r
2545 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
\r
2546 & / (fgb1 ** 5.0d0)
\r
2547 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
\r
2548 & / (fgb2 ** 5.0d0)
\r
2549 dFGBdR1 = ( (R1 / MomoFac1)
\r
2550 & * ( 2.0d0 - (0.5d0 * ee1) ) )
\r
2551 & / ( 2.0d0 * fgb1 )
\r
2552 dFGBdR2 = ( (R2 / MomoFac2)
\r
2553 & * ( 2.0d0 - (0.5d0 * ee2) ) )
\r
2554 & / ( 2.0d0 * fgb2 )
\r
2555 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
\r
2556 & * ( 2.0d0 - 0.5d0 * ee1) )
\r
2557 & / ( 2.0d0 * fgb1 )
\r
2558 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
\r
2559 & * ( 2.0d0 - 0.5d0 * ee2) )
\r
2560 & / ( 2.0d0 * fgb2 )
\r
2561 dPOLdR1 = dPOLdFGB1 * dFGBdR1
\r
2562 dPOLdR2 = dPOLdFGB2 * dFGBdR2
\r
2563 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
\r
2564 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
\r
2566 c! write(*,*) "Epol = ", Epol
\r
2567 c! write(*,*) "dPOLdR1 = ", dPOLdOM2
\r
2568 c! write(*,*) "dPOLdR2 = ", dPOLdR2
\r
2569 c! write(*,*) "dPOLdOM1 = ", dPOLdOM1
\r
2570 c! write(*,*) "dPOLdOM2 = ", dPOLdOM2
\r
2572 c! dPOLdR1 = 0.0d0
\r
2573 c! dPOLdR2 = 0.0d0
\r
2574 c! dPOLdOM1 = 0.0d0
\r
2575 c! dPOLdOM2 = 0.0d0
\r
2577 c!-------------------------------------------------------------------
\r
2579 pom = (pis / Rhead)**6.0d0
\r
2580 Elj = 4.0d0 * eps0 * pom * (pom-1.0d0)
\r
2581 c! write (*,*) "ELJ = ", ELJ
\r
2582 c! derivative of Elj is Glj
\r
2583 dGLJdR = 4.0d0 * eps0
\r
2584 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
\r
2585 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
\r
2588 c! write (*,*) "Elj = ", Elj
\r
2589 c! write (*,*) "dGLJdR = ", dGLJdR
\r
2593 c!-------------------------------------------------------------------
\r
2595 IF (Wqd.ne.0.0d0) THEN
\r
2597 Beta1 = 5.0d0 + 3.0d0 * (sqom12 - 1.0d0)
\r
2598 & - 37.5d0 * ( sqom1 + sqom2 )
\r
2599 & + 157.5d0 * ( sqom1 * sqom2 )
\r
2600 & - 45.0d0 * om1*om2*om12
\r
2601 fac = -( Wqd / (2.0d0 * Fgb**5.0d0) )
\r
2602 Equad = fac * Beta1
\r
2603 c! derivative of Equad...
\r
2604 dQUADdR = ((2.5d0 * Wqd * Beta1) / (Fgb**6.0d0)) * dFGBdR
\r
2606 & * (-75.0d0*om1 + 315.0d0*om1*sqom2 - 45.0d0*om2*om12)
\r
2608 & * (-75.0d0*om2 + 315.0d0*sqom1*om2 - 45.0d0*om1*om12)
\r
2610 & * ( 6.0d0*om12 - 45.0d0*om1*om2 )
\r
2611 c! write(*,*) "Equad = ", Equad
\r
2612 c! write(*,*) "dQUADdR = ", dQUADdR
\r
2613 c! write(*,*) "dQUADdOM1 = ", dQUADdOM1
\r
2614 c! write(*,*) "dQUADdOM2 = ", dQUADdOM2
\r
2615 c! write(*,*) "dQUADdOM12 = ", dQUADdOM12
\r
2620 c!-------------------------------------------------------------------
\r
2621 c! Return the results
\r
2624 c! eom1 = eom1 + dPOLdOM1 + dQUADdOM1
\r
2625 c! eom2 = eom2 + dPOLdOM2 + dQUADdOM2
\r
2626 c! eom12 = eom12 + dQUADdOM12
\r
2627 eom1 = dPOLdOM1 + dQUADdOM1
\r
2628 eom2 = dPOLdOM2 + dQUADdOM2
\r
2629 eom12 = dQUADdOM12
\r
2630 c! now some magical transformations to project gradient into
\r
2631 c! three cartesian vectors
\r
2633 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
\r
2634 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
\r
2635 c! gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
\r
2636 tuna(k) = eom1 * dcosom1(k) + eom2 * dcosom2(k)
\r
2641 erhead(k) = Rhead_distance(k)/Rhead
\r
2642 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
\r
2643 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
\r
2645 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
\r
2646 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
\r
2647 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
\r
2648 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
\r
2649 facd1 = d1 * vbld_inv(i+nres)
\r
2650 facd2 = d2 * vbld_inv(j+nres)
\r
2652 c! Throw the results into gheadtail which holds gradients
\r
2653 c! for each micro-state
\r
2656 hawk = (erhead_tail(k,1) +
\r
2657 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
\r
2658 condor = (erhead_tail(k,2) +
\r
2659 & facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
\r
2661 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
\r
2662 c! this acts on hydrophobic center of interaction
\r
2663 c! gvdwx(k,i) = gvdwx(k,i)
\r
2664 gheadtail(k,1,1) = gheadtail(k,1,1)
\r
2668 & - dPOLdR1 * hawk
\r
2669 & - dPOLdR2 * erhead_tail(k,2)
\r
2673 & + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
\r
2674 & + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
\r
2675 c! write (*,*) "gheadtail(k,1,1) = ", gheadtail(k,1,1)
\r
2677 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
\r
2678 c! this acts on hydrophobic center of interaction
\r
2679 c! gvdwx(k,j) = gvdwx(k,j)
\r
2680 gheadtail(k,2,1) = gheadtail(k,2,1)
\r
2684 & + dPOLdR1 * erhead_tail(k,1)
\r
2685 & + dPOLdR2 * condor
\r
2689 & + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
\r
2690 & + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
\r
2692 c! this acts on Calpha
\r
2693 c! gvdwc(k,i) = gvdwc(k,i)
\r
2694 gheadtail(k,3,1) = gheadtail(k,3,1)
\r
2695 & - dGCLdR * erhead(k)
\r
2696 & - dGGBdR * erhead(k)
\r
2697 & - dGCVdR * erhead(k)
\r
2698 & - dPOLdR1 * erhead_tail(k,1)
\r
2699 & - dPOLdR2 * erhead_tail(k,2)
\r
2700 & - dGLJdR * erhead(k)
\r
2701 & - dQUADdR * erhead(k)
\r
2704 c! this acts on Calpha
\r
2705 c! gvdwc(k,j) = gvdwc(k,j)
\r
2706 gheadtail(k,4,1) = gheadtail(k,4,1)
\r
2707 & + dGCLdR * erhead(k)
\r
2708 & + dGGBdR * erhead(k)
\r
2709 & + dGCVdR * erhead(k)
\r
2710 & + dPOLdR1 * erhead_tail(k,1)
\r
2711 & + dPOLdR2 * erhead_tail(k,2)
\r
2712 & + dGLJdR * erhead(k)
\r
2713 & + dQUADdR * erhead(k)
\r
2716 ener(istate) = ECL + Egb + Epol + Fisocav + Elj + Equad
\r
2717 c! write (*,*) "ener(",istate,") = ", ener(istate)
\r
2718 eheadtail = eheadtail
\r
2719 & + wstate(istate, itypi, itypj)
\r
2720 & * dexp(-betaT * ener(istate))
\r
2721 c! write (*,*) "wstate = ", wstate(istate, itypi, itypj)
\r
2722 c! write (*,*) "betaT = ", betaT
\r
2723 c! write (*,*) "-E1beta = ", (-betaT * ener(istate))
\r
2724 c! write (*,*) "w1exp = ", (wstate(istate, itypi, itypj)
\r
2725 c! & * dexp(-betaT * ener(istate)))
\r
2726 c! foreach cartesian dimension
\r
2728 c! foreach of two gvdwx and gvdwc
\r
2730 gheadtail(k,l,2) = gheadtail(k,l,2)
\r
2731 & + wstate( istate, itypi, itypj )
\r
2732 & * dexp(-betaT * ener(istate))
\r
2733 & * gheadtail(k,l,1)
\r
2734 gheadtail(k,l,1) = 0.0d0
\r
2735 c! write (*,*) "wstate = ", wstate(istate,itypi,itypj)
\r
2736 c! write (*,*) "-G1beta =", (-betaT * gheadtail(k,l,1))
\r
2737 c! write (*,*) "top(",k,",",l,",",2,") = ", gheadtail(k,l,2)
\r
2741 c! Here ended the gigantic DO istate = 1, 4, which starts
\r
2742 c! at the beggining of the subroutine
\r
2746 gheadtail(k,l,2) = gheadtail(k,l,2) / eheadtail
\r
2747 c! write (*,*) "eheadtail = ", eheadtail
\r
2748 c! write (*,*) "gheadtail(",k,",",l,",2) = ",
\r
2749 c! & gheadtail(k,l,2)
\r
2751 gvdwx(k,i) = gvdwx(k,i) + gheadtail(k,1,2)
\r
2752 gvdwx(k,j) = gvdwx(k,j) + gheadtail(k,2,2)
\r
2753 gvdwc(k,i) = gvdwc(k,i) + gheadtail(k,3,2)
\r
2754 gvdwc(k,j) = gvdwc(k,j) + gheadtail(k,4,2)
\r
2756 gheadtail(k,l,1) = 0.0d0
\r
2757 gheadtail(k,l,2) = 0.0d0
\r
2760 eheadtail = (-dlog(eheadtail)) / betaT
\r
2761 c! write (*,*) "eheadtail_final = ", eheadtail
\r
2766 dQUADdOM12 = 0.0d0
\r
2768 END SUBROUTINE energy_quad
\r
2771 c!-------------------------------------------------------------------
\r
2774 SUBROUTINE eqn(Epol)
\r
2776 INCLUDE 'DIMENSIONS'
\r
2777 INCLUDE 'COMMON.CALC'
\r
2778 INCLUDE 'COMMON.CHAIN'
\r
2779 INCLUDE 'COMMON.CONTROL'
\r
2780 INCLUDE 'COMMON.DERIV'
\r
2781 INCLUDE 'COMMON.EMP'
\r
2782 INCLUDE 'COMMON.GEO'
\r
2783 INCLUDE 'COMMON.INTERACT'
\r
2784 INCLUDE 'COMMON.IOUNITS'
\r
2785 INCLUDE 'COMMON.LOCAL'
\r
2786 INCLUDE 'COMMON.NAMES'
\r
2787 INCLUDE 'COMMON.VAR'
\r
2788 double precision scalar
\r
2789 alphapol1 = alphapol(itypi,itypj)
\r
2790 c! R1 - distance between head of ith side chain and tail of jth sidechain
\r
2793 c! Calculate head-to-tail distances
\r
2794 R1=R1+(ctail(k,2)-chead(k,1))**2
\r
2798 c--------------------------------------------------------------------
\r
2799 c Polarization energy
\r
2801 MomoFac1 = (1.0d0 - chi1 * sqom2)
\r
2802 RR1 = R1 * R1 / MomoFac1
\r
2803 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
\r
2804 fgb1 = sqrt( RR1 + a12sq * ee1)
\r
2805 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
\r
2806 c!------------------------------------------------------------------
\r
2807 c! derivative of Epol is Gpol...
\r
2808 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
\r
2809 & / (fgb1 ** 5.0d0)
\r
2811 dFGBdR1 = ( (R1 / MomoFac1)
\r
2812 & * ( 2.0d0 - (0.5d0 * ee1) ) )
\r
2813 & / ( 2.0d0 * fgb1 )
\r
2815 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
\r
2816 & * (2.0d0 - 0.5d0 * ee1) )
\r
2817 & / (2.0d0 * fgb1)
\r
2819 dPOLdR1 = dPOLdFGB1 * dFGBdR1
\r
2823 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
\r
2824 c!-------------------------------------------------------------------
\r
2825 c! Return the results
\r
2827 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
\r
2830 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
\r
2831 facd1 = d1 * vbld_inv(i+nres)
\r
2834 hawk = (erhead_tail(k,1) +
\r
2835 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
\r
2837 gvdwx(k,i) = gvdwx(k,i)
\r
2838 & - dPOLdR1 * hawk
\r
2840 gvdwx(k,j) = gvdwx(k,j)
\r
2841 & + dPOLdR1 * erhead_tail(k,1)
\r
2843 gvdwc(k,i) = gvdwc(k,i)
\r
2844 & - dPOLdR1 * erhead_tail(k,1)
\r
2846 gvdwc(k,j) = gvdwc(k,j)
\r
2847 & + dPOLdR1 * erhead_tail(k,1)
\r
2851 END SUBROUTINE eqn
\r
2854 c!-------------------------------------------------------------------
\r
2858 SUBROUTINE enq(Epol)
\r
2860 INCLUDE 'DIMENSIONS'
\r
2861 INCLUDE 'COMMON.CALC'
\r
2862 INCLUDE 'COMMON.CHAIN'
\r
2863 INCLUDE 'COMMON.CONTROL'
\r
2864 INCLUDE 'COMMON.DERIV'
\r
2865 INCLUDE 'COMMON.EMP'
\r
2866 INCLUDE 'COMMON.GEO'
\r
2867 INCLUDE 'COMMON.INTERACT'
\r
2868 INCLUDE 'COMMON.IOUNITS'
\r
2869 INCLUDE 'COMMON.LOCAL'
\r
2870 INCLUDE 'COMMON.NAMES'
\r
2871 INCLUDE 'COMMON.VAR'
\r
2872 double precision scalar
\r
2873 alphapol2 = alphapol(itypj,itypi)
\r
2874 c! R2 - distance between head of jth side chain and tail of ith sidechain
\r
2877 c! Calculate head-to-tail distances
\r
2878 R2=R2+(chead(k,2)-ctail(k,1))**2
\r
2882 c------------------------------------------------------------------------
\r
2883 c Polarization energy
\r
2884 MomoFac2 = (1.0d0 - chi2 * sqom1)
\r
2885 RR2 = R2 * R2 / MomoFac2
\r
2886 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
\r
2887 fgb2 = sqrt(RR2 + a12sq * ee2)
\r
2888 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
\r
2889 c!-------------------------------------------------------------------
\r
2890 c! derivative of Epol is Gpol...
\r
2891 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
\r
2892 & / (fgb2 ** 5.0d0)
\r
2894 dFGBdR2 = ( (R2 / MomoFac2)
\r
2895 & * ( 2.0d0 - (0.5d0 * ee2) ) )
\r
2896 & / (2.0d0 * fgb2)
\r
2898 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
\r
2899 & * (2.0d0 - 0.5d0 * ee2) )
\r
2900 & / (2.0d0 * fgb2)
\r
2902 dPOLdR2 = dPOLdFGB2 * dFGBdR2
\r
2904 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
\r
2907 c!-------------------------------------------------------------------
\r
2908 c! Return the results
\r
2910 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
\r
2912 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
\r
2913 facd2 = d2 * vbld_inv(j+nres)
\r
2915 condor = (erhead_tail(k,2)
\r
2916 & + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
\r
2918 gvdwx(k,i) = gvdwx(k,i)
\r
2919 & - dPOLdR2 * erhead_tail(k,2)
\r
2921 gvdwx(k,j) = gvdwx(k,j)
\r
2922 & + dPOLdR2 * condor
\r
2924 gvdwc(k,i) = gvdwc(k,i)
\r
2925 & - dPOLdR2 * erhead_tail(k,2)
\r
2927 gvdwc(k,j) = gvdwc(k,j)
\r
2928 & + dPOLdR2 * erhead_tail(k,2)
\r
2932 END SUBROUTINE enq
\r
2935 c!-------------------------------------------------------------------
\r
2938 SUBROUTINE eqd(Ecl,Elj,Epol)
\r
2940 INCLUDE 'DIMENSIONS'
\r
2941 INCLUDE 'COMMON.CALC'
\r
2942 INCLUDE 'COMMON.CHAIN'
\r
2943 INCLUDE 'COMMON.CONTROL'
\r
2944 INCLUDE 'COMMON.DERIV'
\r
2945 INCLUDE 'COMMON.EMP'
\r
2946 INCLUDE 'COMMON.GEO'
\r
2947 INCLUDE 'COMMON.INTERACT'
\r
2948 INCLUDE 'COMMON.IOUNITS'
\r
2949 INCLUDE 'COMMON.LOCAL'
\r
2950 INCLUDE 'COMMON.NAMES'
\r
2951 INCLUDE 'COMMON.VAR'
\r
2952 double precision scalar
\r
2953 alphapol1 = alphapol(itypi,itypj)
\r
2954 w1 = wqdip(1,itypi,itypj)
\r
2955 w2 = wqdip(2,itypi,itypj)
\r
2956 pis = sig0head(itypi,itypj)
\r
2957 eps0 = epshead(itypi,itypj)
\r
2958 c!-------------------------------------------------------------------
\r
2959 c! R1 - distance between head of ith side chain and tail of jth sidechain
\r
2962 c! Calculate head-to-tail distances
\r
2963 R1=R1+(ctail(k,2)-chead(k,1))**2
\r
2968 c!-------------------------------------------------------------------
\r
2970 sparrow = w1 * Qi * om1
\r
2971 hawk = w2 * Qi * Qi * (1.0d0 - sqom2)
\r
2972 Ecl = sparrow / Rhead**2.0d0
\r
2973 & - hawk / Rhead**4.0d0
\r
2975 c! write (iout,*) "ECL = ", ECL
\r
2976 c!-------------------------------------------------------------------
\r
2977 c! derivative of ecl is Gcl
\r
2979 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0
\r
2980 & + 4.0d0 * hawk / Rhead**5.0d0
\r
2983 dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0)
\r
2984 c! dGCLdOM1 = 0.0d0
\r
2986 dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0)
\r
2987 c! dGCLdOM2 = 0.0d0
\r
2988 c--------------------------------------------------------------------
\r
2989 c Polarization energy
\r
2991 MomoFac1 = (1.0d0 - chi1 * sqom2)
\r
2992 RR1 = R1 * R1 / MomoFac1
\r
2993 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
\r
2994 fgb1 = sqrt( RR1 + a12sq * ee1)
\r
2995 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
\r
2997 c! write (iout,*) "EPOL = ", EPOL
\r
2998 c!------------------------------------------------------------------
\r
2999 c! derivative of Epol is Gpol...
\r
3000 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
\r
3001 & / (fgb1 ** 5.0d0)
\r
3002 dFGBdR1 = ( (R1 / MomoFac1)
\r
3003 & * ( 2.0d0 - (0.5d0 * ee1) ) )
\r
3004 & / ( 2.0d0 * fgb1 )
\r
3005 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
\r
3006 & * (2.0d0 - 0.5d0 * ee1) )
\r
3007 & / (2.0d0 * fgb1)
\r
3008 dPOLdR1 = dPOLdFGB1 * dFGBdR1
\r
3009 c! dPOLdR1 = 0.0d0
\r
3011 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
\r
3012 c! dPOLdOM2 = 0.0d0
\r
3013 c!-------------------------------------------------------------------
\r
3015 pom = (pis / Rhead)**6.0d0
\r
3016 Elj = 4.0d0 * eps0 * pom * (pom-1.0d0)
\r
3017 c! write (*,*) "ELJ = ", ELJ
\r
3018 c! derivative of Elj is Glj
\r
3019 dGLJdR = 4.0d0 * eps0
\r
3020 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
\r
3021 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
\r
3022 c!-------------------------------------------------------------------
\r
3023 c! Return the results
\r
3025 erhead(k) = Rhead_distance(k)/Rhead
\r
3026 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
\r
3029 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
\r
3030 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
\r
3031 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
\r
3032 facd1 = d1 * vbld_inv(i+nres)
\r
3033 facd2 = d2 * vbld_inv(j+nres)
\r
3036 hawk = (erhead_tail(k,1) +
\r
3037 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
\r
3039 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
\r
3040 gvdwx(k,i) = gvdwx(k,i)
\r
3042 & - dPOLdR1 * hawk
\r
3045 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
\r
3046 gvdwx(k,j) = gvdwx(k,j)
\r
3048 & + dPOLdR1 * erhead_tail(k,1)
\r
3052 gvdwc(k,i) = gvdwc(k,i)
\r
3053 & - dGCLdR * erhead(k)
\r
3054 & - dPOLdR1 * erhead_tail(k,1)
\r
3055 & - dGLJdR * erhead(k)
\r
3057 gvdwc(k,j) = gvdwc(k,j)
\r
3058 & + dGCLdR * erhead(k)
\r
3059 & + dPOLdR1 * erhead_tail(k,1)
\r
3060 & + dGLJdR * erhead(k)
\r
3064 END SUBROUTINE eqd
\r
3067 c!-------------------------------------------------------------------
\r
3070 SUBROUTINE edq(Ecl,Elj,Epol)
\r
3072 INCLUDE 'DIMENSIONS'
\r
3073 INCLUDE 'COMMON.CALC'
\r
3074 INCLUDE 'COMMON.CHAIN'
\r
3075 INCLUDE 'COMMON.CONTROL'
\r
3076 INCLUDE 'COMMON.DERIV'
\r
3077 INCLUDE 'COMMON.EMP'
\r
3078 INCLUDE 'COMMON.GEO'
\r
3079 INCLUDE 'COMMON.INTERACT'
\r
3080 INCLUDE 'COMMON.IOUNITS'
\r
3081 INCLUDE 'COMMON.LOCAL'
\r
3082 INCLUDE 'COMMON.NAMES'
\r
3083 INCLUDE 'COMMON.VAR'
\r
3084 double precision scalar
\r
3085 alphapol2 = alphapol(itypj,itypi)
\r
3086 w1 = wqdip(1,itypi,itypj)
\r
3087 w2 = wqdip(2,itypi,itypj)
\r
3088 pis = sig0head(itypi,itypj)
\r
3089 eps0 = epshead(itypi,itypj)
\r
3090 c!-------------------------------------------------------------------
\r
3091 c! R2 - distance between head of jth side chain and tail of ith sidechain
\r
3094 c! Calculate head-to-tail distances
\r
3095 R2=R2+(chead(k,2)-ctail(k,1))**2
\r
3100 c!-------------------------------------------------------------------
\r
3102 sparrow = w1 * Qi * om1
\r
3103 hawk = w2 * Qi * Qi * (1.0d0 - sqom2)
\r
3104 ECL = sparrow / Rhead**2.0d0
\r
3105 & - hawk / Rhead**4.0d0
\r
3106 c! write (iout,*) "ECL = ", ECL
\r
3108 c!-------------------------------------------------------------------
\r
3109 c! derivative of ecl is Gcl
\r
3111 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0
\r
3112 & + 4.0d0 * hawk / Rhead**5.0d0
\r
3115 dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0)
\r
3116 c! dGCLdOM1 = 0.0d0
\r
3118 dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0)
\r
3119 c! dGCLdOM2 = 0.0d0
\r
3120 c--------------------------------------------------------------------
\r
3121 c Polarization energy
\r
3123 MomoFac2 = (1.0d0 - chi2 * sqom1)
\r
3124 RR2 = R2 * R2 / MomoFac2
\r
3125 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
\r
3126 fgb2 = sqrt(RR2 + a12sq * ee2)
\r
3127 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
\r
3128 c! write (iout,*) "EPOL = ", EPOL
\r
3130 c!------------------------------------------------------------------
\r
3131 c! derivative of Epol is Gpol...
\r
3132 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
\r
3133 & / (fgb2 ** 5.0d0)
\r
3134 dFGBdR2 = ( (R2 / MomoFac2)
\r
3135 & * ( 2.0d0 - (0.5d0 * ee2) ) )
\r
3136 & / (2.0d0 * fgb2)
\r
3137 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
\r
3138 & * (2.0d0 - 0.5d0 * ee2) )
\r
3139 & / (2.0d0 * fgb2)
\r
3140 dPOLdR2 = dPOLdFGB2 * dFGBdR2
\r
3141 c! dPOLdR1 = 0.0d0
\r
3142 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
\r
3143 c! dPOLdOM1 = 0.0d0
\r
3145 c!-------------------------------------------------------------------
\r
3147 pom = (pis / Rhead)**6.0d0
\r
3148 Elj = 4.0d0 * eps0 * pom * (pom-1.0d0)
\r
3149 c! write (iout,*) "ELJ = ", ELJ
\r
3150 c! derivative of Elj is Glj
\r
3151 dGLJdR = 4.0d0 * eps0
\r
3152 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
\r
3153 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
\r
3154 c!-------------------------------------------------------------------
\r
3155 c! Return the results
\r
3157 erhead(k) = Rhead_distance(k)/Rhead
\r
3158 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
\r
3161 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
\r
3162 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
\r
3163 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
\r
3164 facd1 = d1 * vbld_inv(i+nres)
\r
3165 facd2 = d2 * vbld_inv(j+nres)
\r
3168 condor = (erhead_tail(k,2)
\r
3169 & + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
\r
3171 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
\r
3172 gvdwx(k,i) = gvdwx(k,i)
\r
3174 & - dPOLdR2 * erhead_tail(k,2)
\r
3177 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
\r
3178 gvdwx(k,j) = gvdwx(k,j)
\r
3180 & + dPOLdR2 * condor
\r
3184 gvdwc(k,i) = gvdwc(k,i)
\r
3185 & - dGCLdR * erhead(k)
\r
3186 & - dPOLdR2 * erhead_tail(k,2)
\r
3187 & - dGLJdR * erhead(k)
\r
3189 gvdwc(k,j) = gvdwc(k,j)
\r
3190 & + dGCLdR * erhead(k)
\r
3191 & + dPOLdR2 * erhead_tail(k,2)
\r
3192 & + dGLJdR * erhead(k)
\r
3196 END SUBROUTINE edq
\r
3199 C--------------------------------------------------------------------
\r
3202 SUBROUTINE edd(ECL)
\r
3204 INCLUDE 'DIMENSIONS'
\r
3205 INCLUDE 'COMMON.CALC'
\r
3206 INCLUDE 'COMMON.CHAIN'
\r
3207 INCLUDE 'COMMON.CONTROL'
\r
3208 INCLUDE 'COMMON.DERIV'
\r
3209 INCLUDE 'COMMON.EMP'
\r
3210 INCLUDE 'COMMON.GEO'
\r
3211 INCLUDE 'COMMON.INTERACT'
\r
3212 INCLUDE 'COMMON.IOUNITS'
\r
3213 INCLUDE 'COMMON.LOCAL'
\r
3214 INCLUDE 'COMMON.NAMES'
\r
3215 INCLUDE 'COMMON.VAR'
\r
3216 double precision scalar
\r
3217 csig = sigiso(itypi,itypj)
\r
3218 w1 = wqdip(1,itypi,itypj)
\r
3219 w2 = wqdip(2,itypi,itypj)
\r
3221 sparrow = -3.0d0 * w1
\r
3222 rosella = 6.0d0 * w2
\r
3223 hawk = Rhead**3.0d0
\r
3226 c! condor = -3w1 / R^3
\r
3227 condor = sparrow / hawk
\r
3228 c! eagle = 6w2 / R^6
\r
3229 eagle = rosella / bat
\r
3230 fac = (om12 - 3.0d0 * om1 * om2)
\r
3231 c1 = (w1 / hawk) * fac
\r
3232 c2 = (w2 / Rhead ** 6.0d0)
\r
3233 & * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
\r
3235 c!-------------------------------------------------------------------
\r
3236 c! dervative of ECL is GCL...
\r
3238 c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
\r
3239 c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0)
\r
3240 & * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
\r
3243 c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
\r
3244 c2 = (-6.0d0 * w2) / (Rhead**6.0d0)
\r
3245 & * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
\r
3246 dGCLdOM1 = c1 - c2
\r
3248 c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
\r
3249 c2 = (-6.0d0 * w2) / (Rhead**6.0d0)
\r
3250 & * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
\r
3251 dGCLdOM2 = c1 - c2
\r
3253 c1 = w1 / (Rhead ** 3.0d0)
\r
3254 c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
\r
3255 dGCLdOM12 = c1 - c2
\r
3256 c!-------------------------------------------------------------------
\r
3257 c! Return the results
\r
3259 erhead(k) = Rhead_distance(k)/Rhead
\r
3261 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
\r
3262 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
\r
3263 facd1 = d1 * vbld_inv(i+nres)
\r
3264 facd2 = d2 * vbld_inv(j+nres)
\r
3267 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
\r
3268 gvdwx(k,i) = gvdwx(k,i)
\r
3270 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
\r
3271 gvdwx(k,j) = gvdwx(k,j)
\r
3274 gvdwc(k,i) = gvdwc(k,i)
\r
3275 & - dGCLdR * erhead(k)
\r
3276 gvdwc(k,j) = gvdwc(k,j)
\r
3277 & + dGCLdR * erhead(k)
\r
3280 END SUBROUTINE edd
\r
3283 c!-------------------------------------------------------------------
\r
3286 SUBROUTINE elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
\r
3289 INCLUDE 'DIMENSIONS'
\r
3290 c! itypi, itypj, i, j, k, l, chead,
\r
3291 INCLUDE 'COMMON.CALC'
\r
3292 c! c, nres, dc_norm
\r
3293 INCLUDE 'COMMON.CHAIN'
\r
3295 INCLUDE 'COMMON.DERIV'
\r
3296 c! electrostatic gradients-specific variables
\r
3297 INCLUDE 'COMMON.EMP'
\r
3298 c! wquad, dhead, alphiso, alphasur, rborn, epsintab
\r
3299 INCLUDE 'COMMON.INTERACT'
\r
3301 INCLUDE 'COMMON.MD'
\r
3302 c! io for debug, disable it in final builds
\r
3303 INCLUDE 'COMMON.IOUNITS'
\r
3304 c!-------------------------------------------------------------------
\r
3307 c! what amino acid is the aminoacid j'th?
\r
3309 c! 1/(Gas Constant * Thermostate temperature) = BetaT
\r
3310 BetaT = 1.0d0 / (t_bath * Rb)
\r
3311 c! write (*,*) "t_bath = ", t_bath, "Rb = ", Rb
\r
3312 c! write (*,'(a,f5.3)') " Betat = ", BetaT
\r
3313 c! Gay-berne var's
\r
3314 sig0ij = sigma( itypi,itypj )
\r
3315 chi1 = chi( itypi, itypj )
\r
3316 chi2 = chi( itypj, itypi )
\r
3317 chi12 = chi1 * chi2
\r
3318 chip1 = chipp( itypi, itypj )
\r
3319 chip2 = chipp( itypj, itypi )
\r
3320 chip12 = chip1 * chip2
\r
3321 c! not used by momo potential, but needed by sc_angular which is shared
\r
3322 c! by all energy_potential subroutines
\r
3326 c! location, location, location
\r
3327 xj = c( 1, nres+j ) - xi
\r
3328 yj = c( 2, nres+j ) - yi
\r
3329 zj = c( 3, nres+j ) - zi
\r
3330 dxj = dc_norm( 1, nres+j )
\r
3331 dyj = dc_norm( 2, nres+j )
\r
3332 dzj = dc_norm( 3, nres+j )
\r
3333 c! distance from center of chain(?) to polar/charged head
\r
3334 d1 = dhead(1, 1, itypi, itypj)
\r
3335 d2 = dhead(2, 1, itypi, itypj)
\r
3337 a12sq = rborn(itypi,itypj)
\r
3338 a12sq = a12sq * a12sq
\r
3339 c! charge of amino acid itypi is...
\r
3340 Qi = icharge(itypi)
\r
3341 Qj = icharge(itypj)
\r
3343 c! Eps'(i,j) for Elj
\r
3344 eps_head = epshead(itypi,itypj)
\r
3346 chis1 = chis(itypi,itypj)
\r
3347 chis2 = chis(itypj,itypi)
\r
3348 chis12 = chis1 * chis2
\r
3349 sig1 = sigmap(itypi,itypj)
\r
3350 sig2 = sigmap(itypj,itypi)
\r
3351 c! alpha factors from Fcav/Gcav
\r
3352 b1 = alphasur(1,itypi,itypj)
\r
3353 b2 = alphasur(2,itypi,itypj)
\r
3354 b3 = alphasur(3,itypi,itypj)
\r
3355 b4 = alphasur(4,itypi,itypj)
\r
3356 c! used to determine wheter we want to do quadrupole calculations
\r
3357 wqd = wquad(itypi, itypj)
\r
3358 eps_in = epsintab(itypi,itypj)
\r
3359 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
\r
3360 c! write (*,*) "eps_inout_fac = ", eps_inout_fac
\r
3361 c!-------------------------------------------------------------------
\r
3362 c! tail location and distance calculations
\r
3363 c! shameless ripoff from emomo
\r
3366 ctail(k,1)=c(k,i+nres)-dtail(k,itypi)*dc_norm(k,nres+i)
\r
3367 ctail(k,2)=c(k,j+nres)-dtail(k,itypj)*dc_norm(k,nres+j)
\r
3369 c! tail distances will be themselves usefull elswhere
\r
3370 c1 (in Gcav, for example)
\r
3371 Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 )
\r
3372 Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
\r
3373 Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
\r
3375 & (Rtail_distance(1)*Rtail_distance(1))
\r
3376 & + (Rtail_distance(2)*Rtail_distance(2))
\r
3377 & + (Rtail_distance(3)*Rtail_distance(3)))
\r
3378 c!-------------------------------------------------------------------
\r
3379 c! Calculate location and distance between polar heads
\r
3380 c! distance between heads
\r
3381 c! for each one of our three dimensional space...
\r
3383 c! location of polar head is computed by taking hydrophobic centre
\r
3384 c! and moving by a d1 * dc_norm vector
\r
3385 c! see unres publications for very informative images
\r
3386 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
\r
3387 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
\r
3389 c! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
\r
3390 c! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
\r
3391 Rhead_distance(k) = chead(k,2) - chead(k,1)
\r
3393 c! pitagoras (root of sum of squares)
\r
3395 & (Rhead_distance(1)*Rhead_distance(1))
\r
3396 & + (Rhead_distance(2)*Rhead_distance(2))
\r
3397 & + (Rhead_distance(3)*Rhead_distance(3)))
\r
3398 c!-------------------------------------------------------------------
\r
3399 c! zero everything that should be zero'ed
\r
3419 END SUBROUTINE elgrad_init
\r
3422 c!-------------------------------------------------------------------
\r
3425 SUBROUTINE sc_angular
\r
3426 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
\r
3427 C om12. Called by ebp, egb, egbv, and emomo
\r
3429 c! ntyp needed in other commons
\r
3430 INCLUDE 'DIMENSIONS'
\r
3431 INCLUDE 'COMMON.CALC'
\r
3433 INCLUDE 'COMMON.INTERACT'
\r
3434 INCLUDE 'COMMON.IOUNITS'
\r
3435 INCLUDE 'COMMON.EMP'
\r
3437 erij(1) = xj * rij
\r
3438 erij(2) = yj * rij
\r
3439 erij(3) = zj * rij
\r
3440 om1 = dxi * erij(1) + dyi * erij(2) + dzi * erij(3)
\r
3441 om2 = dxj * erij(1) + dyj * erij(2) + dzj * erij(3)
\r
3442 om12 = dxi * dxj + dyi * dyj + dzi * dzj
\r
3443 chiom12 = chi12 * om12
\r
3444 C Calculate eps1(om12) and its derivative in om12
\r
3445 faceps1 = 1.0D0 - om12 * chiom12
\r
3446 faceps1_inv = 1.0D0 / faceps1
\r
3447 eps1 = dsqrt(faceps1_inv)
\r
3448 C Following variable is eps1*deps1/dom12
\r
3449 eps1_om12 = faceps1_inv * chiom12
\r
3450 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
\r
3452 om1om2 = om1 * om2
\r
3453 chiom1 = chi1 * om1
\r
3454 chiom2 = chi2 * om2
\r
3455 facsig = om1 * chiom1 + om2 * chiom2
\r
3456 & - 2.0D0 * om1om2 * chiom12
\r
3457 sigsq = 1.0D0 - facsig * faceps1_inv
\r
3458 sigsq_om1 = (chiom1 - chiom12 * om2) * faceps1_inv
\r
3459 sigsq_om2 = (chiom2 - chiom12 * om1) * faceps1_inv
\r
3460 sigsq_om12 = -chi12 * (om1om2 * faceps1 - om12 * facsig)
\r
3461 & * faceps1_inv**2
\r
3462 C Calculate eps2 and its derivatives in om1, om2, and om12.
\r
3463 chipom1 = chip1 * om1
\r
3464 chipom2 = chip2 * om2
\r
3465 chipom12 = chip12 * om12
\r
3466 facp = 1.0D0 - om12 * chipom12
\r
3467 facp_inv = 1.0D0 / facp
\r
3468 facp1 = om1 * chipom1 + om2 * chipom2
\r
3469 & -2.0D0 * om1om2 * chipom12
\r
3470 C Following variable is the square root of eps2
\r
3471 eps2rt = 1.0D0 - facp1 * facp_inv
\r
3473 C Following three variables are the derivatives of the square root of eps
\r
3474 C in om1, om2, and om12.
\r
3475 eps2rt_om1 =-4.0D0 * (chipom1 - chipom12 * om2) * facp_inv
\r
3476 eps2rt_om2 =-4.0D0 * (chipom2 - chipom12 * om1) * facp_inv
\r
3477 eps2rt_om12 = 4.0D0 * chip12
\r
3478 & * (om1om2*facp-om12*facp1)*facp_inv**2
\r
3480 c! Evaluate the "asymmetric" factor in the VDW constant, eps3
\r
3481 c! Note that THIS is 0 in emomo, so we should probably move it out of sc_angular
\r
3482 c! Or frankly, we should restructurize the whole energy section
\r
3483 eps3rt = 1.0D0 - alf1 * om1 + alf2 * om2 - alf12 * om12
\r
3485 C Calculate whole angle-dependent part of epsilon and contributions
\r
3486 C to its derivatives
\r
3489 END SUBROUTINE sc_angular
\r
3492 C--------------------------------------------------------------------
\r
3495 subroutine sc_grad_T
\r
3496 implicit real*8 (a-h,o-z)
\r
3497 include 'DIMENSIONS'
\r
3498 include 'COMMON.CHAIN'
\r
3499 include 'COMMON.DERIV'
\r
3500 include 'COMMON.CALC'
\r
3501 include 'COMMON.IOUNITS'
\r
3502 double precision dcosom1(3),dcosom2(3)
\r
3503 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
\r
3504 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
\r
3505 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
\r
3506 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
\r
3507 c diagnostics only
\r
3510 c eom12=evdwij*eps1_om12
\r
3512 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
\r
3513 c & " sigder",sigder
\r
3514 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
\r
3515 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
\r
3517 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
\r
3518 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
\r
3521 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
\r
3523 c write (iout,*) "gg",(gg(k),k=1,3)
\r
3525 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
\r
3526 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
\r
3527 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
\r
3528 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
\r
3529 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
\r
3530 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
\r
3531 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
\r
3532 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
\r
3533 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
\r
3534 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
\r
3537 C Calculate the components of the gradient in DC and X
\r
3541 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
\r
3545 gvdwcT(l,i)=gvdwcT(l,i)-gg(l)
\r
3546 gvdwcT(l,j)=gvdwcT(l,j)+gg(l)
\r
3552 C--------------------------------------------------------------------
\r
3555 SUBROUTINE sc_grad
\r
3556 IMPLICIT real*8 (a-h,o-z)
\r
3557 INCLUDE 'DIMENSIONS'
\r
3558 INCLUDE 'COMMON.CHAIN'
\r
3559 INCLUDE 'COMMON.DERIV'
\r
3560 INCLUDE 'COMMON.CALC'
\r
3561 INCLUDE 'COMMON.IOUNITS'
\r
3562 INCLUDE 'COMMON.EMP'
\r
3563 double precision dcosom1(3),dcosom2(3)
\r
3565 c! each eom holds sum of omega-angular derivatives of each component
\r
3566 c! of energy function. First GGB, then Gcav, dipole-dipole,...
\r
3568 & eps2der * eps2rt_om1
\r
3569 & - 2.0D0 * alf1 * eps3der
\r
3570 & + sigder * sigsq_om1
\r
3576 & eps2der * eps2rt_om2
\r
3577 & + 2.0D0 * alf2 * eps3der
\r
3578 & + sigder * sigsq_om2
\r
3584 & evdwij * eps1_om12
\r
3585 & + eps2der * eps2rt_om12
\r
3586 & - 2.0D0 * alf12 * eps3der
\r
3587 & + sigder *sigsq_om12
\r
3591 c! now some magical transformations to project gradient into
\r
3592 c! three cartesian vectors
\r
3595 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
\r
3596 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
\r
3597 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
\r
3598 c! this acts on hydrophobic center of interaction
\r
3599 gvdwx(k,i)= gvdwx(k,i) - gg(k)
\r
3600 & + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
\r
3601 & + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
\r
3602 gvdwx(k,j)= gvdwx(k,j) + gg(k)
\r
3603 & + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
\r
3604 & + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
\r
3605 c! this acts on Calpha
\r
3606 gvdwc(k,i)=gvdwc(k,i)-gg(k)
\r
3607 gvdwc(k,j)=gvdwc(k,j)+gg(k)
\r
3610 END SUBROUTINE sc_grad
\r
3613 C--------------------------------------------------------------------
\r
3616 subroutine e_softsphere(evdw)
\r
3618 C This subroutine calculates the interaction energy of nonbonded side chains
\r
3619 C assuming the LJ potential of interaction.
\r
3621 implicit real*8 (a-h,o-z)
\r
3622 include 'DIMENSIONS'
\r
3623 parameter (accur=1.0d-10)
\r
3624 include 'COMMON.GEO'
\r
3625 include 'COMMON.VAR'
\r
3626 include 'COMMON.LOCAL'
\r
3627 include 'COMMON.CHAIN'
\r
3628 include 'COMMON.DERIV'
\r
3629 include 'COMMON.INTERACT'
\r
3630 include 'COMMON.TORSION'
\r
3631 include 'COMMON.SBRIDGE'
\r
3632 include 'COMMON.NAMES'
\r
3633 include 'COMMON.IOUNITS'
\r
3634 include 'COMMON.CONTACTS'
\r
3636 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
\r
3638 do i=iatsc_s,iatsc_e
\r
3645 C Calculate SC interaction energy.
\r
3647 do iint=1,nint_gr(i)
\r
3648 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
\r
3649 cd & 'iend=',iend(i,iint)
\r
3650 do j=istart(i,iint),iend(i,iint)
\r
3655 rij=xj*xj+yj*yj+zj*zj
\r
3656 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
\r
3657 r0ij=r0(itypi,itypj)
\r
3659 c print *,i,j,r0ij,dsqrt(rij)
\r
3660 if (rij.lt.r0ijsq) then
\r
3661 evdwij=0.25d0*(rij-r0ijsq)**2
\r
3669 C Calculate the components of the gradient in DC and X
\r
3675 gvdwx(k,i)=gvdwx(k,i)-gg(k)
\r
3676 gvdwx(k,j)=gvdwx(k,j)+gg(k)
\r
3677 gvdwc(k,i)=gvdwc(k,i)-gg(k)
\r
3678 gvdwc(k,j)=gvdwc(k,j)+gg(k)
\r
3682 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
\r
3692 C--------------------------------------------------------------------
\r
3695 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
\r
3698 C Soft-sphere potential of p-p interaction
\r
3700 implicit real*8 (a-h,o-z)
\r
3701 include 'DIMENSIONS'
\r
3702 include 'COMMON.CONTROL'
\r
3703 include 'COMMON.IOUNITS'
\r
3704 include 'COMMON.GEO'
\r
3705 include 'COMMON.VAR'
\r
3706 include 'COMMON.LOCAL'
\r
3707 include 'COMMON.CHAIN'
\r
3708 include 'COMMON.DERIV'
\r
3709 include 'COMMON.INTERACT'
\r
3710 include 'COMMON.CONTACTS'
\r
3711 include 'COMMON.TORSION'
\r
3712 include 'COMMON.VECTORS'
\r
3713 include 'COMMON.FFIELD'
\r
3715 cd write(iout,*) 'In EELEC_soft_sphere'
\r
3722 do i=iatel_s,iatel_e
\r
3726 xmedi=c(1,i)+0.5d0*dxi
\r
3727 ymedi=c(2,i)+0.5d0*dyi
\r
3728 zmedi=c(3,i)+0.5d0*dzi
\r
3730 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
\r
3731 do j=ielstart(i),ielend(i)
\r
3735 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
\r
3736 r0ij=rpp(iteli,itelj)
\r
3741 xj=c(1,j)+0.5D0*dxj-xmedi
\r
3742 yj=c(2,j)+0.5D0*dyj-ymedi
\r
3743 zj=c(3,j)+0.5D0*dzj-zmedi
\r
3744 rij=xj*xj+yj*yj+zj*zj
\r
3745 if (rij.lt.r0ijsq) then
\r
3746 evdw1ij=0.25d0*(rij-r0ijsq)**2
\r
3752 evdw1=evdw1+evdw1ij
\r
3754 C Calculate contributions to the Cartesian gradient.
\r
3760 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
\r
3761 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
\r
3764 * Loop over residues i+1 thru j-1.
\r
3766 cgrad do k=i+1,j-1
\r
3768 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
\r
3773 cgrad do i=nnt,nct-1
\r
3775 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
\r
3777 cgrad do j=i+1,nct-1
\r
3779 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
\r
3787 c--------------------------------------------------------------------
\r
3790 subroutine vec_and_deriv
\r
3791 implicit real*8 (a-h,o-z)
\r
3792 include 'DIMENSIONS'
\r
3796 include 'COMMON.IOUNITS'
\r
3797 include 'COMMON.GEO'
\r
3798 include 'COMMON.VAR'
\r
3799 include 'COMMON.LOCAL'
\r
3800 include 'COMMON.CHAIN'
\r
3801 include 'COMMON.VECTORS'
\r
3802 include 'COMMON.SETUP'
\r
3803 include 'COMMON.TIME1'
\r
3804 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
\r
3805 C Compute the local reference systems. For reference system (i), the
\r
3806 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
\r
3807 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
\r
3809 do i=ivec_start,ivec_end
\r
3813 if (i.eq.nres-1) then
\r
3814 C Case of the last full residue
\r
3815 C Compute the Z-axis
\r
3816 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
\r
3817 costh=dcos(pi-theta(nres))
\r
3818 fac=1.0d0/dsqrt(1.0d0-costh*costh)
\r
3820 uz(k,i)=fac*uz(k,i)
\r
3822 C Compute the derivatives of uz
\r
3823 uzder(1,1,1)= 0.0d0
\r
3824 uzder(2,1,1)=-dc_norm(3,i-1)
\r
3825 uzder(3,1,1)= dc_norm(2,i-1)
\r
3826 uzder(1,2,1)= dc_norm(3,i-1)
\r
3827 uzder(2,2,1)= 0.0d0
\r
3828 uzder(3,2,1)=-dc_norm(1,i-1)
\r
3829 uzder(1,3,1)=-dc_norm(2,i-1)
\r
3830 uzder(2,3,1)= dc_norm(1,i-1)
\r
3831 uzder(3,3,1)= 0.0d0
\r
3832 uzder(1,1,2)= 0.0d0
\r
3833 uzder(2,1,2)= dc_norm(3,i)
\r
3834 uzder(3,1,2)=-dc_norm(2,i)
\r
3835 uzder(1,2,2)=-dc_norm(3,i)
\r
3836 uzder(2,2,2)= 0.0d0
\r
3837 uzder(3,2,2)= dc_norm(1,i)
\r
3838 uzder(1,3,2)= dc_norm(2,i)
\r
3839 uzder(2,3,2)=-dc_norm(1,i)
\r
3840 uzder(3,3,2)= 0.0d0
\r
3841 C Compute the Y-axis
\r
3844 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
\r
3846 C Compute the derivatives of uy
\r
3849 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
\r
3850 & -dc_norm(k,i)*dc_norm(j,i-1)
\r
3851 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
\r
3853 uyder(j,j,1)=uyder(j,j,1)-costh
\r
3854 uyder(j,j,2)=1.0d0+uyder(j,j,2)
\r
3859 uygrad(l,k,j,i)=uyder(l,k,j)
\r
3860 uzgrad(l,k,j,i)=uzder(l,k,j)
\r
3864 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
\r
3865 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
\r
3866 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
\r
3867 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
\r
3870 C Compute the Z-axis
\r
3871 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
\r
3872 costh=dcos(pi-theta(i+2))
\r
3873 fac=1.0d0/dsqrt(1.0d0-costh*costh)
\r
3875 uz(k,i)=fac*uz(k,i)
\r
3877 C Compute the derivatives of uz
\r
3878 uzder(1,1,1)= 0.0d0
\r
3879 uzder(2,1,1)=-dc_norm(3,i+1)
\r
3880 uzder(3,1,1)= dc_norm(2,i+1)
\r
3881 uzder(1,2,1)= dc_norm(3,i+1)
\r
3882 uzder(2,2,1)= 0.0d0
\r
3883 uzder(3,2,1)=-dc_norm(1,i+1)
\r
3884 uzder(1,3,1)=-dc_norm(2,i+1)
\r
3885 uzder(2,3,1)= dc_norm(1,i+1)
\r
3886 uzder(3,3,1)= 0.0d0
\r
3887 uzder(1,1,2)= 0.0d0
\r
3888 uzder(2,1,2)= dc_norm(3,i)
\r
3889 uzder(3,1,2)=-dc_norm(2,i)
\r
3890 uzder(1,2,2)=-dc_norm(3,i)
\r
3891 uzder(2,2,2)= 0.0d0
\r
3892 uzder(3,2,2)= dc_norm(1,i)
\r
3893 uzder(1,3,2)= dc_norm(2,i)
\r
3894 uzder(2,3,2)=-dc_norm(1,i)
\r
3895 uzder(3,3,2)= 0.0d0
\r
3896 C Compute the Y-axis
\r
3899 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
\r
3901 C Compute the derivatives of uy
\r
3904 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
\r
3905 & -dc_norm(k,i)*dc_norm(j,i+1)
\r
3906 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
\r
3908 uyder(j,j,1)=uyder(j,j,1)-costh
\r
3909 uyder(j,j,2)=1.0d0+uyder(j,j,2)
\r
3914 uygrad(l,k,j,i)=uyder(l,k,j)
\r
3915 uzgrad(l,k,j,i)=uzder(l,k,j)
\r
3919 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
\r
3920 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
\r
3921 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
\r
3922 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
\r
3926 vbld_inv_temp(1)=vbld_inv(i+1)
\r
3927 if (i.lt.nres-1) then
\r
3928 vbld_inv_temp(2)=vbld_inv(i+2)
\r
3930 vbld_inv_temp(2)=vbld_inv(i)
\r
3935 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
\r
3936 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
\r
3941 #if defined(PARVEC) && defined(MPI)
\r
3942 if (nfgtasks1.gt.1) then
\r
3943 time00=MPI_Wtime()
\r
3944 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
\r
3945 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
\r
3946 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
\r
3947 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
\r
3948 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
\r
3950 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
\r
3951 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
\r
3953 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
\r
3954 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
\r
3955 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
\r
3956 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
\r
3957 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
\r
3958 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
\r
3959 time_gather=time_gather+MPI_Wtime()-time00
\r
3961 c if (fg_rank.eq.0) then
\r
3962 c write (iout,*) "Arrays UY and UZ"
\r
3964 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
\r
3965 c & (uz(k,i),k=1,3)
\r
3973 C--------------------------------------------------------------------
\r
3976 subroutine check_vecgrad
\r
3977 implicit real*8 (a-h,o-z)
\r
3978 include 'DIMENSIONS'
\r
3979 include 'COMMON.IOUNITS'
\r
3980 include 'COMMON.GEO'
\r
3981 include 'COMMON.VAR'
\r
3982 include 'COMMON.LOCAL'
\r
3983 include 'COMMON.CHAIN'
\r
3984 include 'COMMON.VECTORS'
\r
3985 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
\r
3986 dimension uyt(3,maxres),uzt(3,maxres)
\r
3987 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
\r
3988 double precision delta /1.0d-7/
\r
3989 call vec_and_deriv
\r
3991 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
\r
3992 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
\r
3993 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
\r
3994 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
\r
3995 cd & (dc_norm(if90,i),if90=1,3)
\r
3996 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
\r
3997 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
\r
3998 cd write(iout,'(a)')
\r
4004 uygradt(l,k,j,i)=uygrad(l,k,j,i)
\r
4005 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
\r
4010 call vec_and_deriv
\r
4018 cd write (iout,*) 'i=',i
\r
4020 erij(k)=dc_norm(k,i)
\r
4024 dc_norm(k,i)=erij(k)
\r
4026 dc_norm(j,i)=dc_norm(j,i)+delta
\r
4027 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
\r
4029 c dc_norm(k,i)=dc_norm(k,i)/fac
\r
4031 c write (iout,*) (dc_norm(k,i),k=1,3)
\r
4032 c write (iout,*) (erij(k),k=1,3)
\r
4033 call vec_and_deriv
\r
4035 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
\r
4036 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
\r
4037 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
\r
4038 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
\r
4040 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
\r
4041 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
\r
4042 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
\r
4045 dc_norm(k,i)=erij(k)
\r
4048 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
\r
4049 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
\r
4050 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
\r
4051 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
\r
4052 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
\r
4053 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
\r
4054 cd write (iout,'(a)')
\r
4061 C--------------------------------------------------------------------------
\r
4064 subroutine set_matrices
\r
4065 implicit real*8 (a-h,o-z)
\r
4066 include 'DIMENSIONS'
\r
4069 include "COMMON.SETUP"
\r
4071 integer status(MPI_STATUS_SIZE)
\r
4073 include 'COMMON.IOUNITS'
\r
4074 include 'COMMON.GEO'
\r
4075 include 'COMMON.VAR'
\r
4076 include 'COMMON.LOCAL'
\r
4077 include 'COMMON.CHAIN'
\r
4078 include 'COMMON.DERIV'
\r
4079 include 'COMMON.INTERACT'
\r
4080 include 'COMMON.CONTACTS'
\r
4081 include 'COMMON.TORSION'
\r
4082 include 'COMMON.VECTORS'
\r
4083 include 'COMMON.FFIELD'
\r
4084 double precision auxvec(2),auxmat(2,2)
\r
4086 C Compute the virtual-bond-torsional-angle dependent quantities needed
\r
4087 C to calculate the el-loc multibody terms of various order.
\r
4090 do i=ivec_start+2,ivec_end+2
\r
4094 if (i .lt. nres+1) then
\r
4101 sin2=dsin(2*phi(i))
\r
4102 cos2=dcos(2*phi(i))
\r
4105 obrot2(1,i-2)=cos2
\r
4106 obrot2(2,i-2)=sin2
\r
4111 Ug2(1,1,i-2)=-cos2
\r
4112 Ug2(1,2,i-2)=-sin2
\r
4113 Ug2(2,1,i-2)=-sin2
\r
4114 Ug2(2,2,i-2)= cos2
\r
4118 obrot(1,i-2)=1.0d0
\r
4119 obrot(2,i-2)=0.0d0
\r
4120 obrot2(1,i-2)=0.0d0
\r
4121 obrot2(2,i-2)=0.0d0
\r
4126 Ug2(1,1,i-2)=0.0d0
\r
4127 Ug2(1,2,i-2)=0.0d0
\r
4128 Ug2(2,1,i-2)=0.0d0
\r
4129 Ug2(2,2,i-2)=0.0d0
\r
4131 if (i .gt. 3 .and. i .lt. nres+1) then
\r
4132 obrot_der(1,i-2)=-sin1
\r
4133 obrot_der(2,i-2)= cos1
\r
4134 Ugder(1,1,i-2)= sin1
\r
4135 Ugder(1,2,i-2)=-cos1
\r
4136 Ugder(2,1,i-2)=-cos1
\r
4137 Ugder(2,2,i-2)=-sin1
\r
4140 obrot2_der(1,i-2)=-dwasin2
\r
4141 obrot2_der(2,i-2)= dwacos2
\r
4142 Ug2der(1,1,i-2)= dwasin2
\r
4143 Ug2der(1,2,i-2)=-dwacos2
\r
4144 Ug2der(2,1,i-2)=-dwacos2
\r
4145 Ug2der(2,2,i-2)=-dwasin2
\r
4147 obrot_der(1,i-2)=0.0d0
\r
4148 obrot_der(2,i-2)=0.0d0
\r
4149 Ugder(1,1,i-2)=0.0d0
\r
4150 Ugder(1,2,i-2)=0.0d0
\r
4151 Ugder(2,1,i-2)=0.0d0
\r
4152 Ugder(2,2,i-2)=0.0d0
\r
4153 obrot2_der(1,i-2)=0.0d0
\r
4154 obrot2_der(2,i-2)=0.0d0
\r
4155 Ug2der(1,1,i-2)=0.0d0
\r
4156 Ug2der(1,2,i-2)=0.0d0
\r
4157 Ug2der(2,1,i-2)=0.0d0
\r
4158 Ug2der(2,2,i-2)=0.0d0
\r
4160 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
\r
4161 if (i.gt. nnt+2 .and. i.lt.nct+2) then
\r
4162 iti = itortyp(itype(i-2))
\r
4166 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
\r
4167 if (i.gt. nnt+1 .and. i.lt.nct+1) then
\r
4168 iti1 = itortyp(itype(i-1))
\r
4172 cd write (iout,*) '*******i',i,' iti1',iti
\r
4173 cd write (iout,*) 'b1',b1(:,iti)
\r
4174 cd write (iout,*) 'b2',b2(:,iti)
\r
4175 cd write (iout,*) 'Ug',Ug(:,:,i-2)
\r
4176 c if (i .gt. iatel_s+2) then
\r
4177 if (i .gt. nnt+2) then
\r
4178 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
\r
4179 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
\r
4180 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
\r
4182 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
\r
4183 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
\r
4184 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
\r
4185 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
\r
4186 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
\r
4191 Ctobr(k,i-2)=0.0d0
\r
4192 Dtobr2(k,i-2)=0.0d0
\r
4194 EUg(l,k,i-2)=0.0d0
\r
4195 CUg(l,k,i-2)=0.0d0
\r
4196 DUg(l,k,i-2)=0.0d0
\r
4197 DtUg2(l,k,i-2)=0.0d0
\r
4201 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
\r
4202 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
\r
4204 muder(k,i-2)=Ub2der(k,i-2)
\r
4206 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
\r
4207 if (i.gt. nnt+1 .and. i.lt.nct+1) then
\r
4208 iti1 = itortyp(itype(i-1))
\r
4213 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
\r
4215 cd write (iout,*) 'mu ',mu(:,i-2)
\r
4216 cd write (iout,*) 'mu1',mu1(:,i-2)
\r
4217 cd write (iout,*) 'mu2',mu2(:,i-2)
\r
4218 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
\r
4220 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
\r
4221 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
\r
4222 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
\r
4223 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
\r
4224 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
\r
4225 C Vectors and matrices dependent on a single virtual-bond dihedral.
\r
4226 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
\r
4227 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
\r
4228 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
\r
4229 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
\r
4230 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
\r
4231 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
\r
4232 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
\r
4233 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
\r
4234 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
\r
4237 C Matrices dependent on two consecutive virtual-bond dihedrals.
\r
4238 C The order of matrices is from left to right.
\r
4239 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
\r
4241 c do i=max0(ivec_start,2),ivec_end
\r
4243 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
\r
4244 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
\r
4245 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
\r
4246 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
\r
4247 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
\r
4248 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
\r
4249 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
\r
4250 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
\r
4253 #if defined(MPI) && defined(PARMAT)
\r
4255 c if (fg_rank.eq.0) then
\r
4256 write (iout,*) "Arrays UG and UGDER before GATHER"
\r
4258 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
\r
4259 & ((ug(l,k,i),l=1,2),k=1,2),
\r
4260 & ((ugder(l,k,i),l=1,2),k=1,2)
\r
4262 write (iout,*) "Arrays UG2 and UG2DER"
\r
4264 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
\r
4265 & ((ug2(l,k,i),l=1,2),k=1,2),
\r
4266 & ((ug2der(l,k,i),l=1,2),k=1,2)
\r
4268 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
\r
4270 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
\r
4271 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
\r
4272 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
\r
4274 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
\r
4276 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
\r
4277 & costab(i),sintab(i),costab2(i),sintab2(i)
\r
4279 write (iout,*) "Array MUDER"
\r
4281 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
\r
4285 if (nfgtasks.gt.1) then
\r
4286 time00=MPI_Wtime()
\r
4287 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
\r
4288 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
\r
4289 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
\r
4291 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
\r
4292 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
\r
4294 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
\r
4295 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
\r
4297 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
\r
4298 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
\r
4300 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
\r
4301 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
\r
4303 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
\r
4304 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
\r
4306 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
\r
4307 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
\r
4309 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
\r
4310 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
\r
4311 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
\r
4312 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
\r
4313 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
\r
4314 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
\r
4315 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
\r
4316 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
\r
4317 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
\r
4318 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
\r
4319 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
\r
4320 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
\r
4321 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
\r
4323 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
\r
4324 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
\r
4326 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
\r
4327 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
\r
4329 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
\r
4330 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
\r
4332 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
\r
4333 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
\r
4335 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
\r
4336 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
\r
4338 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
\r
4339 & ivec_count(fg_rank1),
\r
4340 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
\r
4342 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
\r
4343 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
\r
4345 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
\r
4346 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
\r
4348 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
\r
4349 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
\r
4351 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
\r
4352 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
\r
4354 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
\r
4355 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
\r
4357 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
\r
4358 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
\r
4360 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
\r
4361 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
\r
4363 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
\r
4364 & ivec_count(fg_rank1),
\r
4365 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
\r
4367 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
\r
4368 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
\r
4370 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
\r
4371 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
\r
4373 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
\r
4374 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
\r
4376 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
\r
4377 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
\r
4379 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
\r
4380 & ivec_count(fg_rank1),
\r
4381 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
\r
4383 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
\r
4384 & ivec_count(fg_rank1),
\r
4385 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
\r
4387 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
\r
4388 & ivec_count(fg_rank1),
\r
4389 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
\r
4390 & MPI_MAT2,FG_COMM1,IERR)
\r
4391 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
\r
4392 & ivec_count(fg_rank1),
\r
4393 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
\r
4394 & MPI_MAT2,FG_COMM1,IERR)
\r
4397 c Passes matrix info through the ring
\r
4400 if (irecv.lt.0) irecv=nfgtasks1-1
\r
4403 if (inext.ge.nfgtasks1) inext=0
\r
4404 do i=1,nfgtasks1-1
\r
4405 c write (iout,*) "isend",isend," irecv",irecv
\r
4406 c call flush(iout)
\r
4407 lensend=lentyp(isend)
\r
4408 lenrecv=lentyp(irecv)
\r
4409 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
\r
4410 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
\r
4411 c & MPI_ROTAT1(lensend),inext,2200+isend,
\r
4412 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
\r
4413 c & iprev,2200+irecv,FG_COMM,status,IERR)
\r
4414 c write (iout,*) "Gather ROTAT1"
\r
4415 c call flush(iout)
\r
4416 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
\r
4417 c & MPI_ROTAT2(lensend),inext,3300+isend,
\r
4418 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
\r
4419 c & iprev,3300+irecv,FG_COMM,status,IERR)
\r
4420 c write (iout,*) "Gather ROTAT2"
\r
4421 c call flush(iout)
\r
4422 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
\r
4423 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
\r
4424 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
\r
4425 & iprev,4400+irecv,FG_COMM,status,IERR)
\r
4426 c write (iout,*) "Gather ROTAT_OLD"
\r
4427 c call flush(iout)
\r
4428 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
\r
4429 & MPI_PRECOMP11(lensend),inext,5500+isend,
\r
4430 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
\r
4431 & iprev,5500+irecv,FG_COMM,status,IERR)
\r
4432 c write (iout,*) "Gather PRECOMP11"
\r
4433 c call flush(iout)
\r
4434 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
\r
4435 & MPI_PRECOMP12(lensend),inext,6600+isend,
\r
4436 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
\r
4437 & iprev,6600+irecv,FG_COMM,status,IERR)
\r
4438 c write (iout,*) "Gather PRECOMP12"
\r
4439 c call flush(iout)
\r
4440 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
\r
4442 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
\r
4443 & MPI_ROTAT2(lensend),inext,7700+isend,
\r
4444 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
\r
4445 & iprev,7700+irecv,FG_COMM,status,IERR)
\r
4446 c write (iout,*) "Gather PRECOMP21"
\r
4447 c call flush(iout)
\r
4448 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
\r
4449 & MPI_PRECOMP22(lensend),inext,8800+isend,
\r
4450 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
\r
4451 & iprev,8800+irecv,FG_COMM,status,IERR)
\r
4452 c write (iout,*) "Gather PRECOMP22"
\r
4453 c call flush(iout)
\r
4454 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
\r
4455 & MPI_PRECOMP23(lensend),inext,9900+isend,
\r
4456 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
\r
4457 & MPI_PRECOMP23(lenrecv),
\r
4458 & iprev,9900+irecv,FG_COMM,status,IERR)
\r
4459 c write (iout,*) "Gather PRECOMP23"
\r
4460 c call flush(iout)
\r
4464 if (irecv.lt.0) irecv=nfgtasks1-1
\r
4467 time_gather=time_gather+MPI_Wtime()-time00
\r
4470 c if (fg_rank.eq.0) then
\r
4471 write (iout,*) "Arrays UG and UGDER"
\r
4473 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
\r
4474 & ((ug(l,k,i),l=1,2),k=1,2),
\r
4475 & ((ugder(l,k,i),l=1,2),k=1,2)
\r
4477 write (iout,*) "Arrays UG2 and UG2DER"
\r
4479 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
\r
4480 & ((ug2(l,k,i),l=1,2),k=1,2),
\r
4481 & ((ug2der(l,k,i),l=1,2),k=1,2)
\r
4483 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
\r
4485 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
\r
4486 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
\r
4487 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
\r
4489 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
\r
4491 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
\r
4492 & costab(i),sintab(i),costab2(i),sintab2(i)
\r
4494 write (iout,*) "Array MUDER"
\r
4496 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
\r
4502 cd iti = itortyp(itype(i))
\r
4503 cd write (iout,*) i
\r
4505 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
\r
4506 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
\r
4513 C--------------------------------------------------------------------------
\r
4516 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
\r
4518 C This subroutine calculates the average interaction energy and its gradient
\r
4519 C in the virtual-bond vectors between non-adjacent peptide groups, based on
\r
4520 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
\r
4521 C The potential depends both on the distance of peptide-group centers and on
\r
4522 C the orientation of the CA-CA virtual bonds.
\r
4524 implicit real*8 (a-h,o-z)
\r
4528 include 'DIMENSIONS'
\r
4529 include 'COMMON.CONTROL'
\r
4530 include 'COMMON.SETUP'
\r
4531 include 'COMMON.IOUNITS'
\r
4532 include 'COMMON.GEO'
\r
4533 include 'COMMON.VAR'
\r
4534 include 'COMMON.LOCAL'
\r
4535 include 'COMMON.CHAIN'
\r
4536 include 'COMMON.DERIV'
\r
4537 include 'COMMON.INTERACT'
\r
4538 include 'COMMON.CONTACTS'
\r
4539 include 'COMMON.TORSION'
\r
4540 include 'COMMON.VECTORS'
\r
4541 include 'COMMON.FFIELD'
\r
4542 include 'COMMON.TIME1'
\r
4543 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
\r
4544 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
\r
4545 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
\r
4546 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
\r
4547 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
\r
4548 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
\r
4550 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
\r
4552 double precision scal_el /1.0d0/
\r
4554 double precision scal_el /0.5d0/
\r
4557 C 13-go grudnia roku pamietnego...
\r
4558 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
\r
4559 & 0.0d0,1.0d0,0.0d0,
\r
4560 & 0.0d0,0.0d0,1.0d0/
\r
4561 cd write(iout,*) 'In EELEC'
\r
4563 cd write(iout,*) 'Type',i
\r
4564 cd write(iout,*) 'B1',B1(:,i)
\r
4565 cd write(iout,*) 'B2',B2(:,i)
\r
4566 cd write(iout,*) 'CC',CC(:,:,i)
\r
4567 cd write(iout,*) 'DD',DD(:,:,i)
\r
4568 cd write(iout,*) 'EE',EE(:,:,i)
\r
4570 cd call check_vecgrad
\r
4572 if (icheckgrad.eq.1) then
\r
4574 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
\r
4576 dc_norm(k,i)=dc(k,i)*fac
\r
4578 c write (iout,*) 'i',i,' fac',fac
\r
4581 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
\r
4582 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
\r
4583 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
\r
4584 c call vec_and_deriv
\r
4586 time01=MPI_Wtime()
\r
4590 time_mat=time_mat+MPI_Wtime()-time01
\r
4594 cd write (iout,*) 'i=',i
\r
4596 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
\r
4599 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
\r
4600 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
\r
4613 cd print '(a)','Enter EELEC'
\r
4614 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
\r
4616 gel_loc_loc(i)=0.0d0
\r
4617 gcorr_loc(i)=0.0d0
\r
4621 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
\r
4623 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
\r
4625 do i=iturn3_start,iturn3_end
\r
4629 dx_normi=dc_norm(1,i)
\r
4630 dy_normi=dc_norm(2,i)
\r
4631 dz_normi=dc_norm(3,i)
\r
4632 xmedi=c(1,i)+0.5d0*dxi
\r
4633 ymedi=c(2,i)+0.5d0*dyi
\r
4634 zmedi=c(3,i)+0.5d0*dzi
\r
4636 call eelecij(i,i+2,ees,evdw1,eel_loc)
\r
4637 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
\r
4638 num_cont_hb(i)=num_conti
\r
4640 do i=iturn4_start,iturn4_end
\r
4644 dx_normi=dc_norm(1,i)
\r
4645 dy_normi=dc_norm(2,i)
\r
4646 dz_normi=dc_norm(3,i)
\r
4647 xmedi=c(1,i)+0.5d0*dxi
\r
4648 ymedi=c(2,i)+0.5d0*dyi
\r
4649 zmedi=c(3,i)+0.5d0*dzi
\r
4650 num_conti=num_cont_hb(i)
\r
4651 call eelecij(i,i+3,ees,evdw1,eel_loc)
\r
4652 if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
\r
4653 num_cont_hb(i)=num_conti
\r
4656 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
\r
4658 do i=iatel_s,iatel_e
\r
4662 dx_normi=dc_norm(1,i)
\r
4663 dy_normi=dc_norm(2,i)
\r
4664 dz_normi=dc_norm(3,i)
\r
4665 xmedi=c(1,i)+0.5d0*dxi
\r
4666 ymedi=c(2,i)+0.5d0*dyi
\r
4667 zmedi=c(3,i)+0.5d0*dzi
\r
4668 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
\r
4669 num_conti=num_cont_hb(i)
\r
4670 do j=ielstart(i),ielend(i)
\r
4671 call eelecij(i,j,ees,evdw1,eel_loc)
\r
4673 num_cont_hb(i)=num_conti
\r
4675 c write (iout,*) "Number of loop steps in EELEC:",ind
\r
4677 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
\r
4678 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
\r
4680 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
\r
4681 ccc eel_loc=eel_loc+eello_turn3
\r
4682 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
\r
4687 C-------------------------------------------------------------------------------
\r
4690 cDEC$ ATTRIBUTES FORCEINLINE :: eelecij
\r
4691 subroutine eelecij(i,j,ees,evdw1,eel_loc)
\r
4692 implicit real*8 (a-h,o-z)
\r
4693 include 'DIMENSIONS'
\r
4697 include 'COMMON.CONTROL'
\r
4698 include 'COMMON.IOUNITS'
\r
4699 include 'COMMON.GEO'
\r
4700 include 'COMMON.VAR'
\r
4701 include 'COMMON.LOCAL'
\r
4702 include 'COMMON.CHAIN'
\r
4703 include 'COMMON.DERIV'
\r
4704 include 'COMMON.INTERACT'
\r
4705 include 'COMMON.CONTACTS'
\r
4706 include 'COMMON.TORSION'
\r
4707 include 'COMMON.VECTORS'
\r
4708 include 'COMMON.FFIELD'
\r
4709 include 'COMMON.TIME1'
\r
4710 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
\r
4711 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
\r
4712 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
\r
4713 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
\r
4714 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
\r
4715 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
\r
4717 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
\r
4719 double precision scal_el /1.0d0/
\r
4721 double precision scal_el /0.5d0/
\r
4724 C 13-go grudnia roku pamietnego...
\r
4725 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
\r
4726 & 0.0d0,1.0d0,0.0d0,
\r
4727 & 0.0d0,0.0d0,1.0d0/
\r
4728 c time00=MPI_Wtime()
\r
4729 cd write (iout,*) "eelecij",i,j
\r
4733 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
\r
4734 aaa=app(iteli,itelj)
\r
4735 bbb=bpp(iteli,itelj)
\r
4736 ael6i=ael6(iteli,itelj)
\r
4737 ael3i=ael3(iteli,itelj)
\r
4741 dx_normj=dc_norm(1,j)
\r
4742 dy_normj=dc_norm(2,j)
\r
4743 dz_normj=dc_norm(3,j)
\r
4744 xj=c(1,j)+0.5D0*dxj-xmedi
\r
4745 yj=c(2,j)+0.5D0*dyj-ymedi
\r
4746 zj=c(3,j)+0.5D0*dzj-zmedi
\r
4747 rij=xj*xj+yj*yj+zj*zj
\r
4753 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
\r
4754 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
\r
4755 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
\r
4756 fac=cosa-3.0D0*cosb*cosg
\r
4758 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
\r
4759 if (j.eq.i+2) ev1=scal_el*ev1
\r
4764 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
\r
4767 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
\r
4768 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
\r
4770 evdw1=evdw1+evdwij
\r
4771 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
\r
4772 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
\r
4773 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
\r
4774 cd & xmedi,ymedi,zmedi,xj,yj,zj
\r
4776 if (energy_dec) then
\r
4777 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
\r
4778 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
\r
4782 C Calculate contributions to the Cartesian gradient.
\r
4785 facvdw=-6*rrmij*(ev1+evdwij)
\r
4786 facel=-3*rrmij*(el1+eesij)
\r
4792 * Radial derivatives. First process both termini of the fragment (i,j)
\r
4798 c ghalf=0.5D0*ggg(k)
\r
4799 c gelc(k,i)=gelc(k,i)+ghalf
\r
4800 c gelc(k,j)=gelc(k,j)+ghalf
\r
4802 c 9/28/08 AL Gradient compotents will be summed only at the end
\r
4804 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
\r
4805 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
\r
4808 * Loop over residues i+1 thru j-1.
\r
4810 cgrad do k=i+1,j-1
\r
4812 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
\r
4819 c ghalf=0.5D0*ggg(k)
\r
4820 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
\r
4821 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
\r
4823 c 9/28/08 AL Gradient compotents will be summed only at the end
\r
4825 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
\r
4826 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
\r
4829 * Loop over residues i+1 thru j-1.
\r
4831 cgrad do k=i+1,j-1
\r
4833 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
\r
4837 facvdw=ev1+evdwij
\r
4840 fac=-3*rrmij*(facvdw+facvdw+facel)
\r
4845 * Radial derivatives. First process both termini of the fragment (i,j)
\r
4851 c ghalf=0.5D0*ggg(k)
\r
4852 c gelc(k,i)=gelc(k,i)+ghalf
\r
4853 c gelc(k,j)=gelc(k,j)+ghalf
\r
4855 c 9/28/08 AL Gradient compotents will be summed only at the end
\r
4857 gelc_long(k,j)=gelc(k,j)+ggg(k)
\r
4858 gelc_long(k,i)=gelc(k,i)-ggg(k)
\r
4861 * Loop over residues i+1 thru j-1.
\r
4863 cgrad do k=i+1,j-1
\r
4865 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
\r
4868 c 9/28/08 AL Gradient compotents will be summed only at the end
\r
4873 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
\r
4874 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
\r
4880 ecosa=2.0D0*fac3*fac1+fac4
\r
4883 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
\r
4884 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
\r
4886 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
\r
4887 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
\r
4889 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
\r
4890 cd & (dcosg(k),k=1,3)
\r
4892 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
\r
4895 c ghalf=0.5D0*ggg(k)
\r
4896 c gelc(k,i)=gelc(k,i)+ghalf
\r
4897 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
\r
4898 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
\r
4899 c gelc(k,j)=gelc(k,j)+ghalf
\r
4900 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
\r
4901 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
\r
4903 cgrad do k=i+1,j-1
\r
4905 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
\r
4909 gelc(k,i)=gelc(k,i)
\r
4910 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
\r
4911 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
\r
4912 gelc(k,j)=gelc(k,j)
\r
4913 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
\r
4914 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
\r
4915 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
\r
4916 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
\r
4918 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
\r
4919 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
\r
4920 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
\r
4922 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
\r
4923 C energy of a peptide unit is assumed in the form of a second-order
\r
4924 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
\r
4925 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
\r
4926 C are computed for EVERY pair of non-contiguous peptide groups.
\r
4928 if (j.lt.nres-1) then
\r
4939 muij(kkk)=mu(k,i)*mu(l,j)
\r
4942 cd write (iout,*) 'EELEC: i',i,' j',j
\r
4943 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
\r
4944 cd write(iout,*) 'muij',muij
\r
4945 ury=scalar(uy(1,i),erij)
\r
4946 urz=scalar(uz(1,i),erij)
\r
4947 vry=scalar(uy(1,j),erij)
\r
4948 vrz=scalar(uz(1,j),erij)
\r
4949 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
\r
4950 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
\r
4951 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
\r
4952 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
\r
4953 fac=dsqrt(-ael6i)*r3ij
\r
4958 cd write (iout,'(4i5,4f10.5)')
\r
4959 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
\r
4960 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
\r
4961 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
\r
4962 cd & uy(:,j),uz(:,j)
\r
4963 cd write (iout,'(4f10.5)')
\r
4964 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
\r
4965 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
\r
4966 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
\r
4967 cd write (iout,'(9f10.5/)')
\r
4968 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
\r
4969 C Derivatives of the elements of A in virtual-bond vectors
\r
4970 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
\r
4972 uryg(k,1)=scalar(erder(1,k),uy(1,i))
\r
4973 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
\r
4974 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
\r
4975 urzg(k,1)=scalar(erder(1,k),uz(1,i))
\r
4976 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
\r
4977 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
\r
4978 vryg(k,1)=scalar(erder(1,k),uy(1,j))
\r
4979 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
\r
4980 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
\r
4981 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
\r
4982 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
\r
4983 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
\r
4985 C Compute radial contributions to the gradient
\r
4991 agg(1,1)=a22der*xj
\r
4992 agg(2,1)=a22der*yj
\r
4993 agg(3,1)=a22der*zj
\r
4994 agg(1,2)=a23der*xj
\r
4995 agg(2,2)=a23der*yj
\r
4996 agg(3,2)=a23der*zj
\r
4997 agg(1,3)=a32der*xj
\r
4998 agg(2,3)=a32der*yj
\r
4999 agg(3,3)=a32der*zj
\r
5000 agg(1,4)=a33der*xj
\r
5001 agg(2,4)=a33der*yj
\r
5002 agg(3,4)=a33der*zj
\r
5003 C Add the contributions coming from er
\r
5006 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
\r
5007 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
\r
5008 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
\r
5009 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
\r
5012 C Derivatives in DC(i)
\r
5013 cgrad ghalf1=0.5d0*agg(k,1)
\r
5014 cgrad ghalf2=0.5d0*agg(k,2)
\r
5015 cgrad ghalf3=0.5d0*agg(k,3)
\r
5016 cgrad ghalf4=0.5d0*agg(k,4)
\r
5017 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
\r
5018 & -3.0d0*uryg(k,2)*vry)!+ghalf1
\r
5019 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
\r
5020 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
\r
5021 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
\r
5022 & -3.0d0*urzg(k,2)*vry)!+ghalf3
\r
5023 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
\r
5024 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
\r
5025 C Derivatives in DC(i+1)
\r
5026 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
\r
5027 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
\r
5028 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
\r
5029 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
\r
5030 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
\r
5031 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
\r
5032 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
\r
5033 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
\r
5034 C Derivatives in DC(j)
\r
5035 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
\r
5036 & -3.0d0*vryg(k,2)*ury)!+ghalf1
\r
5037 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
\r
5038 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
\r
5039 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
\r
5040 & -3.0d0*vryg(k,2)*urz)!+ghalf3
\r
5041 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
\r
5042 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
\r
5043 C Derivatives in DC(j+1) or DC(nres-1)
\r
5044 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
\r
5045 & -3.0d0*vryg(k,3)*ury)
\r
5046 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
\r
5047 & -3.0d0*vrzg(k,3)*ury)
\r
5048 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
\r
5049 & -3.0d0*vryg(k,3)*urz)
\r
5050 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
\r
5051 & -3.0d0*vrzg(k,3)*urz)
\r
5052 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
\r
5054 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
\r
5066 agg(k,l)=-agg(k,l)
\r
5067 aggi(k,l)=-aggi(k,l)
\r
5068 aggi1(k,l)=-aggi1(k,l)
\r
5069 aggj(k,l)=-aggj(k,l)
\r
5070 aggj1(k,l)=-aggj1(k,l)
\r
5073 if (j.lt.nres-1) then
\r
5078 agg(k,l)=-agg(k,l)
\r
5079 aggi(k,l)=-aggi(k,l)
\r
5080 aggi1(k,l)=-aggi1(k,l)
\r
5081 aggj(k,l)=-aggj(k,l)
\r
5082 aggj1(k,l)=-aggj1(k,l)
\r
5092 agg(k,l)=-agg(k,l)
\r
5093 aggi(k,l)=-aggi(k,l)
\r
5094 aggi1(k,l)=-aggi1(k,l)
\r
5095 aggj(k,l)=-aggj(k,l)
\r
5096 aggj1(k,l)=-aggj1(k,l)
\r
5101 IF (wel_loc.gt.0.0d0) THEN
\r
5102 C Contribution to the local-electrostatic energy coming from the i-j pair
\r
5103 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
\r
5105 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
\r
5107 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
\r
5108 & 'eelloc',i,j,eel_loc_ij
\r
5110 eel_loc=eel_loc+eel_loc_ij
\r
5111 C Partial derivatives in virtual-bond dihedral angles gamma
\r
5113 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
\r
5114 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
\r
5115 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
\r
5116 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
\r
5117 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
\r
5118 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
\r
5119 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
\r
5121 ggg(l)=agg(l,1)*muij(1)+
\r
5122 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
\r
5123 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
\r
5124 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
\r
5125 cgrad ghalf=0.5d0*ggg(l)
\r
5126 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
\r
5127 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
\r
5131 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
\r
5134 C Remaining derivatives of eello
\r
5136 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
\r
5137 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
\r
5138 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
\r
5139 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
\r
5140 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
\r
5141 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
\r
5142 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
\r
5143 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
\r
5146 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
\r
5147 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
\r
5148 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
\r
5149 & .and. num_conti.le.maxconts) then
\r
5150 c write (iout,*) i,j," entered corr"
\r
5152 C Calculate the contact function. The ith column of the array JCONT will
\r
5153 C contain the numbers of atoms that make contacts with the atom I (of numbers
\r
5154 C greater than I). The arrays FACONT and GACONT will contain the values of
\r
5155 C the contact function and its derivative.
\r
5156 c r0ij=1.02D0*rpp(iteli,itelj)
\r
5157 c r0ij=1.11D0*rpp(iteli,itelj)
\r
5158 r0ij=2.20D0*rpp(iteli,itelj)
\r
5159 c r0ij=1.55D0*rpp(iteli,itelj)
\r
5160 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
\r
5161 if (fcont.gt.0.0D0) then
\r
5162 num_conti=num_conti+1
\r
5163 if (num_conti.gt.maxconts) then
\r
5164 write (iout,*) 'WARNING - max. # of contacts exceeded;',
\r
5165 & ' will skip next contacts for this conf.'
\r
5167 jcont_hb(num_conti,i)=j
\r
5168 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
\r
5169 cd & " jcont_hb",jcont_hb(num_conti,i)
\r
5170 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
\r
5171 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
\r
5172 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
\r
5174 d_cont(num_conti,i)=rij
\r
5175 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
\r
5176 C --- Electrostatic-interaction matrix ---
\r
5177 a_chuj(1,1,num_conti,i)=a22
\r
5178 a_chuj(1,2,num_conti,i)=a23
\r
5179 a_chuj(2,1,num_conti,i)=a32
\r
5180 a_chuj(2,2,num_conti,i)=a33
\r
5181 C --- Gradient of rij
\r
5183 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
\r
5190 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
\r
5191 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
\r
5192 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
\r
5193 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
\r
5194 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
\r
5199 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
\r
5200 C Calculate contact energies
\r
5202 wij=cosa-3.0D0*cosb*cosg
\r
5205 c fac3=dsqrt(-ael6i)/r0ij**3
\r
5206 fac3=dsqrt(-ael6i)*r3ij
\r
5207 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
\r
5208 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
\r
5209 if (ees0tmp.gt.0) then
\r
5210 ees0pij=dsqrt(ees0tmp)
\r
5214 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
\r
5215 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
\r
5216 if (ees0tmp.gt.0) then
\r
5217 ees0mij=dsqrt(ees0tmp)
\r
5222 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
\r
5223 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
\r
5224 C Diagnostics. Comment out or remove after debugging!
\r
5225 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
\r
5226 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
\r
5227 c ees0m(num_conti,i)=0.0D0
\r
5228 C End diagnostics.
\r
5229 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
\r
5230 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
\r
5231 C Angular derivatives of the contact function
\r
5232 ees0pij1=fac3/ees0pij
\r
5233 ees0mij1=fac3/ees0mij
\r
5234 fac3p=-3.0D0*fac3*rrmij
\r
5235 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
\r
5236 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
\r
5238 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
\r
5239 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
\r
5240 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
\r
5241 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
\r
5242 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
\r
5243 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
\r
5244 ecosap=ecosa1+ecosa2
\r
5245 ecosbp=ecosb1+ecosb2
\r
5246 ecosgp=ecosg1+ecosg2
\r
5247 ecosam=ecosa1-ecosa2
\r
5248 ecosbm=ecosb1-ecosb2
\r
5249 ecosgm=ecosg1-ecosg2
\r
5258 facont_hb(num_conti,i)=fcont
\r
5259 fprimcont=fprimcont/rij
\r
5260 cd facont_hb(num_conti,i)=1.0D0
\r
5261 C Following line is for diagnostics.
\r
5262 cd fprimcont=0.0D0
\r
5264 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
\r
5265 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
\r
5268 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
\r
5269 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
\r
5271 gggp(1)=gggp(1)+ees0pijp*xj
\r
5272 gggp(2)=gggp(2)+ees0pijp*yj
\r
5273 gggp(3)=gggp(3)+ees0pijp*zj
\r
5274 gggm(1)=gggm(1)+ees0mijp*xj
\r
5275 gggm(2)=gggm(2)+ees0mijp*yj
\r
5276 gggm(3)=gggm(3)+ees0mijp*zj
\r
5277 C Derivatives due to the contact function
\r
5278 gacont_hbr(1,num_conti,i)=fprimcont*xj
\r
5279 gacont_hbr(2,num_conti,i)=fprimcont*yj
\r
5280 gacont_hbr(3,num_conti,i)=fprimcont*zj
\r
5283 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
\r
5284 c following the change of gradient-summation algorithm.
\r
5286 cgrad ghalfp=0.5D0*gggp(k)
\r
5287 cgrad ghalfm=0.5D0*gggm(k)
\r
5288 gacontp_hb1(k,num_conti,i)=!ghalfp
\r
5289 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
\r
5290 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
\r
5291 gacontp_hb2(k,num_conti,i)=!ghalfp
\r
5292 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
\r
5293 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
\r
5294 gacontp_hb3(k,num_conti,i)=gggp(k)
\r
5295 gacontm_hb1(k,num_conti,i)=!ghalfm
\r
5296 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
\r
5297 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
\r
5298 gacontm_hb2(k,num_conti,i)=!ghalfm
\r
5299 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
\r
5300 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
\r
5301 gacontm_hb3(k,num_conti,i)=gggm(k)
\r
5303 C Diagnostics. Comment out or remove after debugging!
\r
5305 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
\r
5306 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
\r
5307 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
\r
5308 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
\r
5309 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
\r
5310 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
\r
5313 endif ! num_conti.le.maxconts
\r
5314 endif ! fcont.gt.0
\r
5316 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
\r
5319 ghalf=0.5d0*agg(l,k)
\r
5320 aggi(l,k)=aggi(l,k)+ghalf
\r
5321 aggi1(l,k)=aggi1(l,k)+agg(l,k)
\r
5322 aggj(l,k)=aggj(l,k)+ghalf
\r
5325 if (j.eq.nres-1 .and. i.lt.j-2) then
\r
5328 aggj1(l,k)=aggj1(l,k)+agg(l,k)
\r
5333 c t_eelecij=t_eelecij+MPI_Wtime()-time00
\r
5338 C--------------------------------------------------------------------
\r
5341 subroutine eturn3(i,eello_turn3)
\r
5342 C Third- and fourth-order contributions from turns
\r
5343 implicit real*8 (a-h,o-z)
\r
5344 include 'DIMENSIONS'
\r
5345 include 'COMMON.IOUNITS'
\r
5346 include 'COMMON.GEO'
\r
5347 include 'COMMON.VAR'
\r
5348 include 'COMMON.LOCAL'
\r
5349 include 'COMMON.CHAIN'
\r
5350 include 'COMMON.DERIV'
\r
5351 include 'COMMON.INTERACT'
\r
5352 include 'COMMON.CONTACTS'
\r
5353 include 'COMMON.TORSION'
\r
5354 include 'COMMON.VECTORS'
\r
5355 include 'COMMON.FFIELD'
\r
5356 include 'COMMON.CONTROL'
\r
5358 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
\r
5359 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
\r
5360 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
\r
5361 double precision agg(3,4),aggi(3,4),aggi1(3,4),
\r
5362 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
\r
5363 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
\r
5364 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
\r
5367 c write (iout,*) "eturn3",i,j,j1,j2
\r
5372 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
\r
5374 C Third-order contributions
\r
5381 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
\r
5382 cd call checkint_turn3(i,a_temp,eello_turn3_num)
\r
5383 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
\r
5384 call transpose2(auxmat(1,1),auxmat1(1,1))
\r
5385 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
\r
5386 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
\r
5387 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
\r
5388 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
\r
5389 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
\r
5390 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
\r
5391 cd & ' eello_turn3_num',4*eello_turn3_num
\r
5392 C Derivatives in gamma(i)
\r
5393 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
\r
5394 call transpose2(auxmat2(1,1),auxmat3(1,1))
\r
5395 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
\r
5396 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
\r
5397 C Derivatives in gamma(i+1)
\r
5398 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
\r
5399 call transpose2(auxmat2(1,1),auxmat3(1,1))
\r
5400 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
\r
5401 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
\r
5402 & +0.5d0*(pizda(1,1)+pizda(2,2))
\r
5403 C Cartesian derivatives
\r
5405 c ghalf1=0.5d0*agg(l,1)
\r
5406 c ghalf2=0.5d0*agg(l,2)
\r
5407 c ghalf3=0.5d0*agg(l,3)
\r
5408 c ghalf4=0.5d0*agg(l,4)
\r
5409 a_temp(1,1)=aggi(l,1)!+ghalf1
\r
5410 a_temp(1,2)=aggi(l,2)!+ghalf2
\r
5411 a_temp(2,1)=aggi(l,3)!+ghalf3
\r
5412 a_temp(2,2)=aggi(l,4)!+ghalf4
\r
5413 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
\r
5414 gcorr3_turn(l,i)=gcorr3_turn(l,i)
\r
5415 & +0.5d0*(pizda(1,1)+pizda(2,2))
\r
5416 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
\r
5417 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
\r
5418 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
\r
5419 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
\r
5420 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
\r
5421 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
\r
5422 & +0.5d0*(pizda(1,1)+pizda(2,2))
\r
5423 a_temp(1,1)=aggj(l,1)!+ghalf1
\r
5424 a_temp(1,2)=aggj(l,2)!+ghalf2
\r
5425 a_temp(2,1)=aggj(l,3)!+ghalf3
\r
5426 a_temp(2,2)=aggj(l,4)!+ghalf4
\r
5427 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
\r
5428 gcorr3_turn(l,j)=gcorr3_turn(l,j)
\r
5429 & +0.5d0*(pizda(1,1)+pizda(2,2))
\r
5430 a_temp(1,1)=aggj1(l,1)
\r
5431 a_temp(1,2)=aggj1(l,2)
\r
5432 a_temp(2,1)=aggj1(l,3)
\r
5433 a_temp(2,2)=aggj1(l,4)
\r
5434 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
\r
5435 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
\r
5436 & +0.5d0*(pizda(1,1)+pizda(2,2))
\r
5442 C-------------------------------------------------------------------------------
\r
5445 subroutine eturn4(i,eello_turn4)
\r
5446 C Third- and fourth-order contributions from turns
\r
5447 implicit real*8 (a-h,o-z)
\r
5448 include 'DIMENSIONS'
\r
5449 include 'COMMON.IOUNITS'
\r
5450 include 'COMMON.GEO'
\r
5451 include 'COMMON.VAR'
\r
5452 include 'COMMON.LOCAL'
\r
5453 include 'COMMON.CHAIN'
\r
5454 include 'COMMON.DERIV'
\r
5455 include 'COMMON.INTERACT'
\r
5456 include 'COMMON.CONTACTS'
\r
5457 include 'COMMON.TORSION'
\r
5458 include 'COMMON.VECTORS'
\r
5459 include 'COMMON.FFIELD'
\r
5460 include 'COMMON.CONTROL'
\r
5462 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
\r
5463 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
\r
5464 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
\r
5465 double precision agg(3,4),aggi(3,4),aggi1(3,4),
\r
5466 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
\r
5467 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
\r
5468 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
\r
5471 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
\r
5473 C Fourth-order contributions
\r
5481 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
\r
5482 cd call checkint_turn4(i,a_temp,eello_turn4_num)
\r
5483 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
\r
5488 iti1=itortyp(itype(i+1))
\r
5489 iti2=itortyp(itype(i+2))
\r
5490 iti3=itortyp(itype(i+3))
\r
5491 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
\r
5492 call transpose2(EUg(1,1,i+1),e1t(1,1))
\r
5493 call transpose2(Eug(1,1,i+2),e2t(1,1))
\r
5494 call transpose2(Eug(1,1,i+3),e3t(1,1))
\r
5495 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
\r
5496 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
\r
5497 s1=scalar2(b1(1,iti2),auxvec(1))
\r
5498 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
\r
5499 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
\r
5500 s2=scalar2(b1(1,iti1),auxvec(1))
\r
5501 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
\r
5502 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
\r
5503 s3=0.5d0*(pizda(1,1)+pizda(2,2))
\r
5504 eello_turn4=eello_turn4-(s1+s2+s3)
\r
5505 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
\r
5506 & 'eturn4',i,j,-(s1+s2+s3)
\r
5507 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
\r
5508 cd & ' eello_turn4_num',8*eello_turn4_num
\r
5509 C Derivatives in gamma(i)
\r
5510 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
\r
5511 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
\r
5512 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
\r
5513 s1=scalar2(b1(1,iti2),auxvec(1))
\r
5514 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
\r
5515 s3=0.5d0*(pizda(1,1)+pizda(2,2))
\r
5516 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
\r
5517 C Derivatives in gamma(i+1)
\r
5518 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
\r
5519 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
\r
5520 s2=scalar2(b1(1,iti1),auxvec(1))
\r
5521 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
\r
5522 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
\r
5523 s3=0.5d0*(pizda(1,1)+pizda(2,2))
\r
5524 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
\r
5525 C Derivatives in gamma(i+2)
\r
5526 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
\r
5527 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
\r
5528 s1=scalar2(b1(1,iti2),auxvec(1))
\r
5529 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
\r
5530 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
\r
5531 s2=scalar2(b1(1,iti1),auxvec(1))
\r
5532 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
\r
5533 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
\r
5534 s3=0.5d0*(pizda(1,1)+pizda(2,2))
\r
5535 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
\r
5536 C Cartesian derivatives
\r
5537 C Derivatives of this turn contributions in DC(i+2)
\r
5538 if (j.lt.nres-1) then
\r
5540 a_temp(1,1)=agg(l,1)
\r
5541 a_temp(1,2)=agg(l,2)
\r
5542 a_temp(2,1)=agg(l,3)
\r
5543 a_temp(2,2)=agg(l,4)
\r
5544 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
\r
5545 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
\r
5546 s1=scalar2(b1(1,iti2),auxvec(1))
\r
5547 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
\r
5548 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
\r
5549 s2=scalar2(b1(1,iti1),auxvec(1))
\r
5550 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
\r
5551 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
\r
5552 s3=0.5d0*(pizda(1,1)+pizda(2,2))
\r
5553 ggg(l)=-(s1+s2+s3)
\r
5554 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
\r
5557 C Remaining derivatives of this turn contribution
\r
5559 a_temp(1,1)=aggi(l,1)
\r
5560 a_temp(1,2)=aggi(l,2)
\r
5561 a_temp(2,1)=aggi(l,3)
\r
5562 a_temp(2,2)=aggi(l,4)
\r
5563 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
\r
5564 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
\r
5565 s1=scalar2(b1(1,iti2),auxvec(1))
\r
5566 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
\r
5567 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
\r
5568 s2=scalar2(b1(1,iti1),auxvec(1))
\r
5569 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
\r
5570 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
\r
5571 s3=0.5d0*(pizda(1,1)+pizda(2,2))
\r
5572 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
\r
5573 a_temp(1,1)=aggi1(l,1)
\r
5574 a_temp(1,2)=aggi1(l,2)
\r
5575 a_temp(2,1)=aggi1(l,3)
\r
5576 a_temp(2,2)=aggi1(l,4)
\r
5577 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
\r
5578 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
\r
5579 s1=scalar2(b1(1,iti2),auxvec(1))
\r
5580 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
\r
5581 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
\r
5582 s2=scalar2(b1(1,iti1),auxvec(1))
\r
5583 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
\r
5584 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
\r
5585 s3=0.5d0*(pizda(1,1)+pizda(2,2))
\r
5586 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
\r
5587 a_temp(1,1)=aggj(l,1)
\r
5588 a_temp(1,2)=aggj(l,2)
\r
5589 a_temp(2,1)=aggj(l,3)
\r
5590 a_temp(2,2)=aggj(l,4)
\r
5591 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
\r
5592 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
\r
5593 s1=scalar2(b1(1,iti2),auxvec(1))
\r
5594 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
\r
5595 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
\r
5596 s2=scalar2(b1(1,iti1),auxvec(1))
\r
5597 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
\r
5598 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
\r
5599 s3=0.5d0*(pizda(1,1)+pizda(2,2))
\r
5600 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
\r
5601 a_temp(1,1)=aggj1(l,1)
\r
5602 a_temp(1,2)=aggj1(l,2)
\r
5603 a_temp(2,1)=aggj1(l,3)
\r
5604 a_temp(2,2)=aggj1(l,4)
\r
5605 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
\r
5606 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
\r
5607 s1=scalar2(b1(1,iti2),auxvec(1))
\r
5608 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
\r
5609 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
\r
5610 s2=scalar2(b1(1,iti1),auxvec(1))
\r
5611 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
\r
5612 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
\r
5613 s3=0.5d0*(pizda(1,1)+pizda(2,2))
\r
5614 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
\r
5615 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
\r
5621 C-----------------------------------------------------------------------------
\r
5624 subroutine vecpr(u,v,w)
\r
5625 implicit real*8(a-h,o-z)
\r
5626 dimension u(3),v(3),w(3)
\r
5627 w(1)=u(2)*v(3)-u(3)*v(2)
\r
5628 w(2)=-u(1)*v(3)+u(3)*v(1)
\r
5629 w(3)=u(1)*v(2)-u(2)*v(1)
\r
5634 C--------------------------------------------------------------------
\r
5637 subroutine unormderiv(u,ugrad,unorm,ungrad)
\r
5638 C This subroutine computes the derivatives of a normalized vector u, given
\r
5639 C the derivatives computed without normalization conditions, ugrad. Returns
\r
5642 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
\r
5643 double precision vec(3)
\r
5644 double precision scalar
\r
5646 c write (2,*) 'ugrad',ugrad
\r
5647 c write (2,*) 'u',u
\r
5649 vec(i)=scalar(ugrad(1,i),u(1))
\r
5651 c write (2,*) 'vec',vec
\r
5654 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
\r
5657 c write (2,*) 'ungrad',ungrad
\r
5662 C--------------------------------------------------------------------
\r
5665 subroutine escp_soft_sphere(evdw2,evdw2_14)
\r
5667 C This subroutine calculates the excluded-volume interaction energy between
\r
5668 C peptide-group centers and side chains and its gradient in virtual-bond and
\r
5669 C side-chain vectors.
\r
5671 implicit real*8 (a-h,o-z)
\r
5672 include 'DIMENSIONS'
\r
5673 include 'COMMON.GEO'
\r
5674 include 'COMMON.VAR'
\r
5675 include 'COMMON.LOCAL'
\r
5676 include 'COMMON.CHAIN'
\r
5677 include 'COMMON.DERIV'
\r
5678 include 'COMMON.INTERACT'
\r
5679 include 'COMMON.FFIELD'
\r
5680 include 'COMMON.IOUNITS'
\r
5681 include 'COMMON.CONTROL'
\r
5686 cd print '(a)','Enter ESCP'
\r
5687 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
\r
5688 do i=iatscp_s,iatscp_e
\r
5690 xi=0.5D0*(c(1,i)+c(1,i+1))
\r
5691 yi=0.5D0*(c(2,i)+c(2,i+1))
\r
5692 zi=0.5D0*(c(3,i)+c(3,i+1))
\r
5694 do iint=1,nscp_gr(i)
\r
5696 do j=iscpstart(i,iint),iscpend(i,iint)
\r
5698 C Uncomment following three lines for SC-p interactions
\r
5699 c xj=c(1,nres+j)-xi
\r
5700 c yj=c(2,nres+j)-yi
\r
5701 c zj=c(3,nres+j)-zi
\r
5702 C Uncomment following three lines for Ca-p interactions
\r
5706 rij=xj*xj+yj*yj+zj*zj
\r
5709 if (rij.lt.r0ijsq) then
\r
5710 evdwij=0.25d0*(rij-r0ijsq)**2
\r
5716 evdw2=evdw2+evdwij
\r
5718 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
\r
5723 cgrad if (j.lt.i) then
\r
5724 cd write (iout,*) 'j<i'
\r
5725 C Uncomment following three lines for SC-p interactions
\r
5727 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
\r
5730 cd write (iout,*) 'j>i'
\r
5732 cgrad ggg(k)=-ggg(k)
\r
5733 C Uncomment following line for SC-p interactions
\r
5734 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
\r
5738 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
\r
5740 cgrad kstart=min0(i+1,j)
\r
5741 cgrad kend=max0(i-1,j-1)
\r
5742 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
\r
5743 cd write (iout,*) ggg(1),ggg(2),ggg(3)
\r
5744 cgrad do k=kstart,kend
\r
5746 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
\r
5750 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
\r
5751 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
\r
5761 C-----------------------------------------------------------------------------
\r
5764 subroutine escp(evdw2,evdw2_14)
\r
5766 C This subroutine calculates the excluded-volume interaction energy between
\r
5767 C peptide-group centers and side chains and its gradient in virtual-bond and
\r
5768 C side-chain vectors.
\r
5770 implicit real*8 (a-h,o-z)
\r
5771 include 'DIMENSIONS'
\r
5772 include 'COMMON.GEO'
\r
5773 include 'COMMON.VAR'
\r
5774 include 'COMMON.LOCAL'
\r
5775 include 'COMMON.CHAIN'
\r
5776 include 'COMMON.DERIV'
\r
5777 include 'COMMON.INTERACT'
\r
5778 include 'COMMON.FFIELD'
\r
5779 include 'COMMON.IOUNITS'
\r
5780 include 'COMMON.CONTROL'
\r
5784 cd print '(a)','Enter ESCP'
\r
5785 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
\r
5786 do i=iatscp_s,iatscp_e
\r
5788 xi=0.5D0*(c(1,i)+c(1,i+1))
\r
5789 yi=0.5D0*(c(2,i)+c(2,i+1))
\r
5790 zi=0.5D0*(c(3,i)+c(3,i+1))
\r
5792 do iint=1,nscp_gr(i)
\r
5794 do j=iscpstart(i,iint),iscpend(i,iint)
\r
5796 C Uncomment following three lines for SC-p interactions
\r
5797 c xj=c(1,nres+j)-xi
\r
5798 c yj=c(2,nres+j)-yi
\r
5799 c zj=c(3,nres+j)-zi
\r
5800 C Uncomment following three lines for Ca-p interactions
\r
5804 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
\r
5806 e1=fac*fac*aad(itypj,iteli)
\r
5807 e2=fac*bad(itypj,iteli)
\r
5808 if (iabs(j-i) .le. 2) then
\r
5811 evdw2_14=evdw2_14+e1+e2
\r
5814 evdw2=evdw2+evdwij
\r
5815 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
\r
5816 & 'evdw2',i,j,evdwij
\r
5818 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
\r
5820 fac=-(evdwij+e1)*rrij
\r
5824 cgrad if (j.lt.i) then
\r
5825 cd write (iout,*) 'j<i'
\r
5826 C Uncomment following three lines for SC-p interactions
\r
5828 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
\r
5831 cd write (iout,*) 'j>i'
\r
5833 cgrad ggg(k)=-ggg(k)
\r
5834 C Uncomment following line for SC-p interactions
\r
5835 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
\r
5836 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
\r
5840 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
\r
5842 cgrad kstart=min0(i+1,j)
\r
5843 cgrad kend=max0(i-1,j-1)
\r
5844 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
\r
5845 cd write (iout,*) ggg(1),ggg(2),ggg(3)
\r
5846 cgrad do k=kstart,kend
\r
5848 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
\r
5852 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
\r
5853 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
\r
5861 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
\r
5862 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
\r
5863 gradx_scp(j,i)=expon*gradx_scp(j,i)
\r
5866 C******************************************************************************
\r
5870 C To save time the factor EXPON has been extracted from ALL components
\r
5871 C of GVDWC and GRADX. Remember to multiply them by this factor before further
\r
5874 C******************************************************************************
\r
5879 C--------------------------------------------------------------------
\r
5882 subroutine edis(ehpb)
\r
5884 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
\r
5886 implicit real*8 (a-h,o-z)
\r
5887 include 'DIMENSIONS'
\r
5888 include 'COMMON.SBRIDGE'
\r
5889 include 'COMMON.CHAIN'
\r
5890 include 'COMMON.DERIV'
\r
5891 include 'COMMON.VAR'
\r
5892 include 'COMMON.INTERACT'
\r
5893 include 'COMMON.IOUNITS'
\r
5896 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
\r
5897 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
\r
5898 if (link_end.eq.0) return
\r
5899 do i=link_start,link_end
\r
5900 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
\r
5901 C CA-CA distance used in regularization of structure.
\r
5904 C iii and jjj point to the residues for which the distance is assigned.
\r
5905 if (ii.gt.nres) then
\r
5912 cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj
\r
5913 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
\r
5914 C distance and angle dependent SS bond potential.
\r
5915 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
\r
5916 call ssbond_ene(iii,jjj,eij)
\r
5918 cd write (iout,*) "eij",eij
\r
5920 C Calculate the distance between the two points and its difference from the
\r
5921 C target distance.
\r
5924 C Get the force constant corresponding to this distance.
\r
5926 C Calculate the contribution to energy.
\r
5927 ehpb=ehpb+waga*rdis*rdis
\r
5929 C Evaluate gradient.
\r
5932 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
\r
5933 cd & ' waga=',waga,' fac=',fac
\r
5935 ggg(j)=fac*(c(j,jj)-c(j,ii))
\r
5937 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
\r
5938 C If this is a SC-SC distance, we need to calculate the contributions to the
\r
5939 C Cartesian gradient in the SC vectors (ghpbx).
\r
5940 if (iii.lt.ii) then
\r
5942 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
\r
5943 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
\r
5946 cgrad do j=iii,jjj-1
\r
5948 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
\r
5952 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
\r
5953 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
\r
5962 C--------------------------------------------------------------------
\r
5965 subroutine ssbond_ene(i,j,eij)
\r
5967 C Calculate the distance and angle dependent SS-bond potential energy
\r
5968 C using a free-energy function derived based on RHF/6-31G** ab initio
\r
5969 C calculations of diethyl disulfide.
\r
5971 C A. Liwo and U. Kozlowska, 11/24/03
\r
5973 implicit real*8 (a-h,o-z)
\r
5974 include 'DIMENSIONS'
\r
5975 include 'COMMON.SBRIDGE'
\r
5976 include 'COMMON.CHAIN'
\r
5977 include 'COMMON.DERIV'
\r
5978 include 'COMMON.LOCAL'
\r
5979 include 'COMMON.INTERACT'
\r
5980 include 'COMMON.VAR'
\r
5981 include 'COMMON.IOUNITS'
\r
5982 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
\r
5987 dxi=dc_norm(1,nres+i)
\r
5988 dyi=dc_norm(2,nres+i)
\r
5989 dzi=dc_norm(3,nres+i)
\r
5990 c dsci_inv=dsc_inv(itypi)
\r
5991 dsci_inv=vbld_inv(nres+i)
\r
5993 c dscj_inv=dsc_inv(itypj)
\r
5994 dscj_inv=vbld_inv(nres+j)
\r
5998 dxj=dc_norm(1,nres+j)
\r
5999 dyj=dc_norm(2,nres+j)
\r
6000 dzj=dc_norm(3,nres+j)
\r
6001 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
\r
6006 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
\r
6007 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
\r
6008 om12=dxi*dxj+dyi*dyj+dzi*dzj
\r
6010 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
\r
6011 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
\r
6017 deltat12=om2-om1+2.0d0
\r
6018 cosphi=om12-om1*om2
\r
6019 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
\r
6020 & +akct*deltad*deltat12
\r
6021 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
\r
6022 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
\r
6023 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
\r
6024 c & " deltat12",deltat12," eij",eij
\r
6025 ed=2*akcm*deltad+akct*deltat12
\r
6027 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
\r
6028 eom1=-2*akth*deltat1-pom1-om2*pom2
\r
6029 eom2= 2*akth*deltat2+pom1-om1*pom2
\r
6032 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
\r
6033 ghpbx(k,i)=ghpbx(k,i)-ggk
\r
6034 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
\r
6035 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
\r
6036 ghpbx(k,j)=ghpbx(k,j)+ggk
\r
6037 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
\r
6038 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
\r
6039 ghpbc(k,i)=ghpbc(k,i)-ggk
\r
6040 ghpbc(k,j)=ghpbc(k,j)+ggk
\r
6043 C Calculate the components of the gradient in DC and X
\r
6047 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
\r
6054 C--------------------------------------------------------------------
\r
6057 subroutine ebond(estr)
\r
6059 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
\r
6061 implicit real*8 (a-h,o-z)
\r
6062 include 'DIMENSIONS'
\r
6063 include 'COMMON.LOCAL'
\r
6064 include 'COMMON.GEO'
\r
6065 include 'COMMON.INTERACT'
\r
6066 include 'COMMON.DERIV'
\r
6067 include 'COMMON.VAR'
\r
6068 include 'COMMON.CHAIN'
\r
6069 include 'COMMON.IOUNITS'
\r
6070 include 'COMMON.NAMES'
\r
6071 include 'COMMON.FFIELD'
\r
6072 include 'COMMON.CONTROL'
\r
6073 include 'COMMON.SETUP'
\r
6074 double precision u(3),ud(3)
\r
6076 do i=ibondp_start,ibondp_end
\r
6077 diff = vbld(i)-vbldp0
\r
6078 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
\r
6079 estr=estr+diff*diff
\r
6081 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
\r
6083 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
\r
6085 estr=0.5d0*AKP*estr
\r
6087 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
\r
6089 do i=ibond_start,ibond_end
\r
6091 if (iti.ne.10) then
\r
6092 nbi=nbondterm(iti)
\r
6093 if (nbi.eq.1) then
\r
6094 diff=vbld(i+nres)-vbldsc0(1,iti)
\r
6095 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
\r
6096 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
\r
6097 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
\r
6099 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
\r
6103 diff=vbld(i+nres)-vbldsc0(j,iti)
\r
6104 ud(j)=aksc(j,iti)*diff
\r
6105 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
\r
6118 uprod1=uprod1*u(k)
\r
6119 uprod2=uprod2*u(k)*u(k)
\r
6123 usumsqder=usumsqder+ud(j)*uprod2
\r
6125 estr=estr+uprod/usum
\r
6127 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
\r
6134 #ifdef CRYST_THETA
\r
6137 C--------------------------------------------------------------------
\r
6140 subroutine ebend(etheta)
\r
6142 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
\r
6143 C angles gamma and its derivatives in consecutive thetas and gammas.
\r
6145 implicit real*8 (a-h,o-z)
\r
6146 include 'DIMENSIONS'
\r
6147 include 'COMMON.LOCAL'
\r
6148 include 'COMMON.GEO'
\r
6149 include 'COMMON.INTERACT'
\r
6150 include 'COMMON.DERIV'
\r
6151 include 'COMMON.VAR'
\r
6152 include 'COMMON.CHAIN'
\r
6153 include 'COMMON.IOUNITS'
\r
6154 include 'COMMON.NAMES'
\r
6155 include 'COMMON.FFIELD'
\r
6156 include 'COMMON.CONTROL'
\r
6157 common /calcthet/ term1,term2,termm,diffak,ratak,
\r
6158 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
\r
6159 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
\r
6160 double precision y(2),z(2)
\r
6162 c time11=dexp(-2*time)
\r
6165 c write (*,'(a,i2)') 'EBEND ICG=',icg
\r
6166 do i=ithet_start,ithet_end
\r
6167 C Zero the energy function and its derivative at 0 or pi.
\r
6168 call splinthet(theta(i),0.5d0*delta,ss,ssd)
\r
6173 if (phii.ne.phii) phii=150.0
\r
6183 if (i.lt.nres) then
\r
6186 if (phii1.ne.phii1) phii1=150.0
\r
6187 phii1=pinorm(phii1)
\r
6198 C Calculate the "mean" value of theta from the part of the distribution
\r
6199 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
\r
6200 C In following comments this theta will be referred to as t_c.
\r
6201 thet_pred_mean=0.0d0
\r
6203 athetk=athet(k,it)
\r
6204 bthetk=bthet(k,it)
\r
6205 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
\r
6207 dthett=thet_pred_mean*ssd
\r
6208 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
\r
6209 C Derivatives of the "mean" values in gamma1 and gamma2.
\r
6210 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
\r
6211 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
\r
6212 if (theta(i).gt.pi-delta) then
\r
6213 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
\r
6215 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
\r
6216 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
\r
6217 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
\r
6219 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
\r
6221 else if (theta(i).lt.delta) then
\r
6222 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
\r
6223 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
\r
6224 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
\r
6226 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
\r
6227 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
\r
6230 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
\r
6233 etheta=etheta+ethetai
\r
6234 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
\r
6235 & 'ebend',i,ethetai
\r
6236 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
\r
6237 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
\r
6238 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
\r
6240 C Ufff.... We've done all this!!!
\r
6245 C---------------------------------------------------------------------------
\r
6248 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
\r
6250 implicit real*8 (a-h,o-z)
\r
6251 include 'DIMENSIONS'
\r
6252 include 'COMMON.LOCAL'
\r
6253 include 'COMMON.IOUNITS'
\r
6254 common /calcthet/ term1,term2,termm,diffak,ratak,
\r
6255 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
\r
6256 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
\r
6257 C Calculate the contributions to both Gaussian lobes.
\r
6258 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
\r
6259 C The "polynomial part" of the "standard deviation" of this part of
\r
6260 C the distribution.
\r
6263 sig=sig*thet_pred_mean+polthet(j,it)
\r
6265 C Derivative of the "interior part" of the "standard deviation of the"
\r
6266 C gamma-dependent Gaussian lobe in t_c.
\r
6267 sigtc=3*polthet(3,it)
\r
6269 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
\r
6272 C Set the parameters of both Gaussian lobes of the distribution.
\r
6273 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
\r
6274 fac=sig*sig+sigc0(it)
\r
6277 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
\r
6278 sigsqtc=-4.0D0*sigcsq*sigtc
\r
6279 c print *,i,sig,sigtc,sigsqtc
\r
6280 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
\r
6281 sigtc=-sigtc/(fac*fac)
\r
6282 C Following variable is sigma(t_c)**(-2)
\r
6283 sigcsq=sigcsq*sigcsq
\r
6285 sig0inv=1.0D0/sig0i**2
\r
6286 delthec=thetai-thet_pred_mean
\r
6287 delthe0=thetai-theta0i
\r
6288 term1=-0.5D0*sigcsq*delthec*delthec
\r
6289 term2=-0.5D0*sig0inv*delthe0*delthe0
\r
6290 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
\r
6291 C NaNs in taking the logarithm. We extract the largest exponent which is added
\r
6292 C to the energy (this being the log of the distribution) at the end of energy
\r
6293 C term evaluation for this virtual-bond angle.
\r
6294 if (term1.gt.term2) then
\r
6296 term2=dexp(term2-termm)
\r
6300 term1=dexp(term1-termm)
\r
6303 C The ratio between the gamma-independent and gamma-dependent lobes of
\r
6304 C the distribution is a Gaussian function of thet_pred_mean too.
\r
6305 diffak=gthet(2,it)-thet_pred_mean
\r
6306 ratak=diffak/gthet(3,it)**2
\r
6307 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
\r
6308 C Let's differentiate it in thet_pred_mean NOW.
\r
6310 C Now put together the distribution terms to make complete distribution.
\r
6311 termexp=term1+ak*term2
\r
6312 termpre=sigc+ak*sig0i
\r
6313 C Contribution of the bending energy from this theta is just the -log of
\r
6314 C the sum of the contributions from the two lobes and the pre-exponential
\r
6315 C factor. Simple enough, isn't it?
\r
6316 ethetai=(-dlog(termexp)-termm+dlog(termpre))
\r
6317 C NOW the derivatives!!!
\r
6318 C 6/6/97 Take into account the deformation.
\r
6319 E_theta=(delthec*sigcsq*term1
\r
6320 & +ak*delthe0*sig0inv*term2)/termexp
\r
6321 E_tc=((sigtc+aktc*sig0i)/termpre
\r
6322 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
\r
6323 & aktc*term2)/termexp)
\r
6328 c--------------------------------------------------------------------
\r
6331 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
\r
6332 implicit real*8 (a-h,o-z)
\r
6333 include 'DIMENSIONS'
\r
6334 include 'COMMON.LOCAL'
\r
6335 include 'COMMON.IOUNITS'
\r
6336 common /calcthet/ term1,term2,termm,diffak,ratak,
\r
6337 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
\r
6338 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
\r
6339 delthec=thetai-thet_pred_mean
\r
6340 delthe0=thetai-theta0i
\r
6341 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
\r
6342 t3 = thetai-thet_pred_mean
\r
6346 t14 = t12+t6*sigsqtc
\r
6348 t21 = thetai-theta0i
\r
6354 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
\r
6355 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
\r
6356 & *(-t12*t9-ak*sig0inv*t27)
\r
6362 C--------------------------------------------------------------------
\r
6365 subroutine ebend(etheta)
\r
6367 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
\r
6368 C angles gamma and its derivatives in consecutive thetas and gammas.
\r
6369 C ab initio-derived potentials from
\r
6370 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
\r
6372 implicit real*8 (a-h,o-z)
\r
6373 include 'DIMENSIONS'
\r
6374 include 'COMMON.LOCAL'
\r
6375 include 'COMMON.GEO'
\r
6376 include 'COMMON.INTERACT'
\r
6377 include 'COMMON.DERIV'
\r
6378 include 'COMMON.VAR'
\r
6379 include 'COMMON.CHAIN'
\r
6380 include 'COMMON.IOUNITS'
\r
6381 include 'COMMON.NAMES'
\r
6382 include 'COMMON.FFIELD'
\r
6383 include 'COMMON.CONTROL'
\r
6384 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
\r
6385 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
\r
6386 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
\r
6387 & sinph1ph2(maxdouble,maxdouble)
\r
6388 logical lprn /.false./, lprn1 /.false./
\r
6390 do i=ithet_start,ithet_end
\r
6394 theti2=0.5d0*theta(i)
\r
6395 ityp2=ithetyp(itype(i-1))
\r
6397 coskt(k)=dcos(k*theti2)
\r
6398 sinkt(k)=dsin(k*theti2)
\r
6403 if (phii.ne.phii) phii=150.0
\r
6407 ityp1=ithetyp(itype(i-2))
\r
6409 cosph1(k)=dcos(k*phii)
\r
6410 sinph1(k)=dsin(k*phii)
\r
6420 if (i.lt.nres) then
\r
6423 if (phii1.ne.phii1) phii1=150.0
\r
6424 phii1=pinorm(phii1)
\r
6428 ityp3=ithetyp(itype(i))
\r
6430 cosph2(k)=dcos(k*phii1)
\r
6431 sinph2(k)=dsin(k*phii1)
\r
6441 ethetai=aa0thet(ityp1,ityp2,ityp3)
\r
6444 ccl=cosph1(l)*cosph2(k-l)
\r
6445 ssl=sinph1(l)*sinph2(k-l)
\r
6446 scl=sinph1(l)*cosph2(k-l)
\r
6447 csl=cosph1(l)*sinph2(k-l)
\r
6448 cosph1ph2(l,k)=ccl-ssl
\r
6449 cosph1ph2(k,l)=ccl+ssl
\r
6450 sinph1ph2(l,k)=scl+csl
\r
6451 sinph1ph2(k,l)=scl-csl
\r
6455 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
\r
6456 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
\r
6457 write (iout,*) "coskt and sinkt"
\r
6459 write (iout,*) k,coskt(k),sinkt(k)
\r
6463 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
\r
6464 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
\r
6467 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
\r
6468 & " ethetai",ethetai
\r
6471 write (iout,*) "cosph and sinph"
\r
6473 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
\r
6475 write (iout,*) "cosph1ph2 and sinph2ph2"
\r
6478 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
\r
6479 & sinph1ph2(l,k),sinph1ph2(k,l)
\r
6482 write(iout,*) "ethetai",ethetai
\r
6486 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
\r
6487 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
\r
6488 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
\r
6489 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
\r
6490 ethetai=ethetai+sinkt(m)*aux
\r
6491 dethetai=dethetai+0.5d0*m*aux*coskt(m)
\r
6492 dephii=dephii+k*sinkt(m)*(
\r
6493 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
\r
6494 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
\r
6495 dephii1=dephii1+k*sinkt(m)*(
\r
6496 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
\r
6497 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
\r
6499 & write (iout,*) "m",m," k",k," bbthet",
\r
6500 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
\r
6501 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
\r
6502 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
\r
6503 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
\r
6507 & write(iout,*) "ethetai",ethetai
\r
6511 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
\r
6512 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
\r
6513 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
\r
6514 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
\r
6515 ethetai=ethetai+sinkt(m)*aux
\r
6516 dethetai=dethetai+0.5d0*m*coskt(m)*aux
\r
6517 dephii=dephii+l*sinkt(m)*(
\r
6518 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
\r
6519 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
\r
6520 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
\r
6521 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
\r
6522 dephii1=dephii1+(k-l)*sinkt(m)*(
\r
6523 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
\r
6524 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
\r
6525 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
\r
6526 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
\r
6528 write (iout,*) "m",m," k",k," l",l," ffthet",
\r
6529 & ffthet(l,k,m,ityp1,ityp2,ityp3),
\r
6530 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
\r
6531 & ggthet(l,k,m,ityp1,ityp2,ityp3),
\r
6532 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
\r
6533 write (iout,*) cosph1ph2(l,k)*sinkt(m),
\r
6534 & cosph1ph2(k,l)*sinkt(m),
\r
6535 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
\r
6541 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
\r
6542 & i,theta(i)*rad2deg,phii*rad2deg,
\r
6543 & phii1*rad2deg,ethetai
\r
6544 etheta=etheta+ethetai
\r
6545 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
\r
6546 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
\r
6547 gloc(nphi+i-2,icg)=wang*dethetai
\r
6555 c--------------------------------------------------------------------
\r
6558 subroutine esc(escloc)
\r
6559 C Calculate the local energy of a side chain and its derivatives in the
\r
6560 C corresponding virtual-bond valence angles THETA and the spherical angles
\r
6561 C ALPHA and OMEGA.
\r
6562 implicit real*8 (a-h,o-z)
\r
6563 include 'DIMENSIONS'
\r
6564 include 'COMMON.GEO'
\r
6565 include 'COMMON.LOCAL'
\r
6566 include 'COMMON.VAR'
\r
6567 include 'COMMON.INTERACT'
\r
6568 include 'COMMON.DERIV'
\r
6569 include 'COMMON.CHAIN'
\r
6570 include 'COMMON.IOUNITS'
\r
6571 include 'COMMON.NAMES'
\r
6572 include 'COMMON.FFIELD'
\r
6573 include 'COMMON.CONTROL'
\r
6574 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
\r
6575 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
\r
6576 common /sccalc/ time11,time12,time112,theti,it,nlobit
\r
6579 c write (iout,'(a)') 'ESC'
\r
6580 do i=loc_start,loc_end
\r
6582 if (it.eq.10) goto 1
\r
6584 c print *,'i=',i,' it=',it,' nlobit=',nlobit
\r
6585 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
\r
6586 theti=theta(i+1)-pipol
\r
6591 if (x(2).gt.pi-delta) then
\r
6595 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
\r
6597 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
\r
6598 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
\r
6599 & escloci,dersc(2))
\r
6600 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
\r
6601 & ddersc0(1),dersc(1))
\r
6602 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
\r
6603 & ddersc0(3),dersc(3))
\r
6605 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
\r
6607 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
\r
6608 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
\r
6609 & dersc0(2),esclocbi,dersc02)
\r
6610 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
\r
6611 & dersc12,dersc01)
\r
6612 call splinthet(x(2),0.5d0*delta,ss,ssd)
\r
6617 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
\r
6619 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
\r
6620 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
\r
6621 c & esclocbi,ss,ssd
\r
6622 escloci=ss*escloci+(1.0d0-ss)*esclocbi
\r
6623 c escloci=esclocbi
\r
6624 c write (iout,*) escloci
\r
6625 else if (x(2).lt.delta) then
\r
6629 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
\r
6631 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
\r
6632 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
\r
6633 & escloci,dersc(2))
\r
6634 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
\r
6635 & ddersc0(1),dersc(1))
\r
6636 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
\r
6637 & ddersc0(3),dersc(3))
\r
6639 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
\r
6641 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
\r
6642 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
\r
6643 & dersc0(2),esclocbi,dersc02)
\r
6644 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
\r
6645 & dersc12,dersc01)
\r
6649 call splinthet(x(2),0.5d0*delta,ss,ssd)
\r
6651 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
\r
6653 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
\r
6654 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
\r
6655 c & esclocbi,ss,ssd
\r
6656 escloci=ss*escloci+(1.0d0-ss)*esclocbi
\r
6657 c write (iout,*) escloci
\r
6659 call enesc(x,escloci,dersc,ddummy,.false.)
\r
6662 escloc=escloc+escloci
\r
6663 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
\r
6664 & 'escloc',i,escloci
\r
6665 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
\r
6667 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
\r
6669 gloc(ialph(i,1),icg)=wscloc*dersc(2)
\r
6670 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
\r
6677 C--------------------------------------------------------------------
\r
6680 subroutine enesc(x,escloci,dersc,ddersc,mixed)
\r
6681 implicit real*8 (a-h,o-z)
\r
6682 include 'DIMENSIONS'
\r
6683 include 'COMMON.GEO'
\r
6684 include 'COMMON.LOCAL'
\r
6685 include 'COMMON.IOUNITS'
\r
6686 common /sccalc/ time11,time12,time112,theti,it,nlobit
\r
6687 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
\r
6688 double precision contr(maxlob,-1:1)
\r
6690 c write (iout,*) 'it=',it,' nlobit=',nlobit
\r
6694 if (mixed) ddersc(j)=0.0d0
\r
6698 C Because of periodicity of the dependence of the SC energy in omega we have
\r
6699 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
\r
6700 C To avoid underflows, first compute & store the exponents.
\r
6708 z(k)=x(k)-censc(k,j,it)
\r
6713 Axk=Axk+gaussc(l,k,j,it)*z(l)
\r
6719 expfac=expfac+Ax(k,j,iii)*z(k)
\r
6721 contr(j,iii)=expfac
\r
6727 C As in the case of ebend, we want to avoid underflows in exponentiation and
\r
6728 C subsequent NaNs and INFs in energy calculation.
\r
6729 C Find the largest exponent
\r
6733 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
\r
6737 cd print *,'it=',it,' emin=',emin
\r
6739 C Compute the contribution to SC energy and derivatives
\r
6744 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
\r
6745 if(adexp.ne.adexp) adexp=1.0
\r
6746 expfac=dexp(adexp)
\r
6748 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
\r
6750 cd print *,'j=',j,' expfac=',expfac
\r
6751 escloc_i=escloc_i+expfac
\r
6753 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
\r
6757 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
\r
6758 & +gaussc(k,2,j,it))*expfac
\r
6765 dersc(1)=dersc(1)/cos(theti)**2
\r
6766 ddersc(1)=ddersc(1)/cos(theti)**2
\r
6767 ddersc(3)=ddersc(3)
\r
6769 escloci=-(dlog(escloc_i)-emin)
\r
6771 dersc(j)=dersc(j)/escloc_i
\r
6775 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
\r
6782 C--------------------------------------------------------------------
\r
6785 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
\r
6786 implicit real*8 (a-h,o-z)
\r
6787 include 'DIMENSIONS'
\r
6788 include 'COMMON.GEO'
\r
6789 include 'COMMON.LOCAL'
\r
6790 include 'COMMON.IOUNITS'
\r
6791 common /sccalc/ time11,time12,time112,theti,it,nlobit
\r
6792 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
\r
6793 double precision contr(maxlob)
\r
6804 z(k)=x(k)-censc(k,j,it)
\r
6810 Axk=Axk+gaussc(l,k,j,it)*z(l)
\r
6816 expfac=expfac+Ax(k,j)*z(k)
\r
6821 C As in the case of ebend, we want to avoid underflows in exponentiation and
\r
6822 C subsequent NaNs and INFs in energy calculation.
\r
6823 C Find the largest exponent
\r
6826 if (emin.gt.contr(j)) emin=contr(j)
\r
6830 C Compute the contribution to SC energy and derivatives
\r
6834 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
\r
6835 escloc_i=escloc_i+expfac
\r
6837 dersc(k)=dersc(k)+Ax(k,j)*expfac
\r
6839 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
\r
6840 & +gaussc(1,2,j,it))*expfac
\r
6844 dersc(1)=dersc(1)/cos(theti)**2
\r
6845 dersc12=dersc12/cos(theti)**2
\r
6846 escloci=-(dlog(escloc_i)-emin)
\r
6848 dersc(j)=dersc(j)/escloc_i
\r
6850 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
\r
6856 c--------------------------------------------------------------------
\r
6859 subroutine esc(escloc)
\r
6860 C Calculate the local energy of a side chain and its derivatives in the
\r
6861 C corresponding virtual-bond valence angles THETA and the spherical angles
\r
6862 C ALPHA and OMEGA derived from AM1 all-atom calculations.
\r
6863 C added by Urszula Kozlowska. 07/11/2007
\r
6865 implicit real*8 (a-h,o-z)
\r
6866 include 'DIMENSIONS'
\r
6867 include 'COMMON.GEO'
\r
6868 include 'COMMON.LOCAL'
\r
6869 include 'COMMON.VAR'
\r
6870 include 'COMMON.SCROT'
\r
6871 include 'COMMON.INTERACT'
\r
6872 include 'COMMON.DERIV'
\r
6873 include 'COMMON.CHAIN'
\r
6874 include 'COMMON.IOUNITS'
\r
6875 include 'COMMON.NAMES'
\r
6876 include 'COMMON.FFIELD'
\r
6877 include 'COMMON.CONTROL'
\r
6878 include 'COMMON.VECTORS'
\r
6879 double precision x_prime(3),y_prime(3),z_prime(3)
\r
6880 & , sumene,dsc_i,dp2_i,x(65),
\r
6881 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
\r
6882 & de_dxx,de_dyy,de_dzz,de_dt
\r
6883 double precision s1_t,s1_6_t,s2_t,s2_6_t
\r
6885 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
\r
6886 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
\r
6887 & dt_dCi(3),dt_dCi1(3)
\r
6888 common /sccalc/ time11,time12,time112,theti,it,nlobit
\r
6891 do i=loc_start,loc_end
\r
6892 costtab(i+1) =dcos(theta(i+1))
\r
6893 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
\r
6894 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
\r
6895 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
\r
6896 cosfac2=0.5d0/(1.0d0+costtab(i+1))
\r
6897 cosfac=dsqrt(cosfac2)
\r
6898 sinfac2=0.5d0/(1.0d0-costtab(i+1))
\r
6899 sinfac=dsqrt(sinfac2)
\r
6901 if (it.eq.10) goto 1
\r
6903 C Compute the axes of tghe local cartesian coordinates system; store in
\r
6904 c x_prime, y_prime and z_prime
\r
6911 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
\r
6912 C & dc_norm(3,i+nres)
\r
6914 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
\r
6915 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
\r
6918 z_prime(j) = -uz(j,i-1)
\r
6920 c write (2,*) "i",i
\r
6921 c write (2,*) "x_prime",(x_prime(j),j=1,3)
\r
6922 c write (2,*) "y_prime",(y_prime(j),j=1,3)
\r
6923 c write (2,*) "z_prime",(z_prime(j),j=1,3)
\r
6924 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
\r
6925 c & " xy",scalar(x_prime(1),y_prime(1)),
\r
6926 c & " xz",scalar(x_prime(1),z_prime(1)),
\r
6927 c & " yy",scalar(y_prime(1),y_prime(1)),
\r
6928 c & " yz",scalar(y_prime(1),z_prime(1)),
\r
6929 c & " zz",scalar(z_prime(1),z_prime(1))
\r
6931 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
\r
6932 C to local coordinate system. Store in xx, yy, zz.
\r
6938 xx = xx + x_prime(j)*dc_norm(j,i+nres)
\r
6939 yy = yy + y_prime(j)*dc_norm(j,i+nres)
\r
6940 zz = zz + z_prime(j)*dc_norm(j,i+nres)
\r
6947 C Compute the energy of the ith side cbain
\r
6949 c write (2,*) "xx",xx," yy",yy," zz",zz
\r
6952 x(j) = sc_parmin(j,it)
\r
6954 #ifdef CHECK_COORD
\r
6955 Cc diagnostics - remove later
\r
6956 xx1 = dcos(alph(2))
\r
6957 yy1 = dsin(alph(2))*dcos(omeg(2))
\r
6958 zz1 = -dsin(alph(2))*dsin(omeg(2))
\r
6959 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
\r
6960 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
\r
6962 C," --- ", xx_w,yy_w,zz_w
\r
6965 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
\r
6966 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
\r
6968 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
\r
6969 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
\r
6971 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
\r
6972 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
\r
6973 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
\r
6974 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
\r
6975 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
\r
6977 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
\r
6978 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
\r
6979 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
\r
6980 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
\r
6981 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
\r
6983 dsc_i = 0.743d0+x(61)
\r
6984 dp2_i = 1.9d0+x(62)
\r
6985 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
\r
6986 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
\r
6987 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
\r
6988 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
\r
6989 s1=(1+x(63))/(0.1d0 + dscp1)
\r
6990 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
\r
6991 s2=(1+x(65))/(0.1d0 + dscp2)
\r
6992 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
\r
6993 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
\r
6994 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
\r
6995 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
\r
6997 c & dscp1,dscp2,sumene
\r
6998 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
\r
6999 escloc = escloc + sumene
\r
7000 c write (2,*) "i",i," escloc",sumene,escloc
\r
7003 C This section to check the numerical derivatives of the energy of ith side
\r
7004 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
\r
7005 C #define DEBUG in the code to turn it on.
\r
7007 write (2,*) "sumene =",sumene
\r
7011 write (2,*) xx,yy,zz
\r
7012 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
\r
7013 de_dxx_num=(sumenep-sumene)/aincr
\r
7015 write (2,*) "xx+ sumene from enesc=",sumenep
\r
7018 write (2,*) xx,yy,zz
\r
7019 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
\r
7020 de_dyy_num=(sumenep-sumene)/aincr
\r
7022 write (2,*) "yy+ sumene from enesc=",sumenep
\r
7025 write (2,*) xx,yy,zz
\r
7026 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
\r
7027 de_dzz_num=(sumenep-sumene)/aincr
\r
7029 write (2,*) "zz+ sumene from enesc=",sumenep
\r
7030 costsave=cost2tab(i+1)
\r
7031 sintsave=sint2tab(i+1)
\r
7032 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
\r
7033 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
\r
7034 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
\r
7035 de_dt_num=(sumenep-sumene)/aincr
\r
7036 write (2,*) " t+ sumene from enesc=",sumenep
\r
7037 cost2tab(i+1)=costsave
\r
7038 sint2tab(i+1)=sintsave
\r
7039 C End of diagnostics section.
\r
7042 C Compute the gradient of esc
\r
7044 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
\r
7045 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
\r
7046 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
\r
7047 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
\r
7048 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
\r
7049 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
\r
7050 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
\r
7051 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
\r
7052 pom1=(sumene3*sint2tab(i+1)+sumene1)
\r
7053 & *(pom_s1/dscp1+pom_s16*dscp1**4)
\r
7054 pom2=(sumene4*cost2tab(i+1)+sumene2)
\r
7055 & *(pom_s2/dscp2+pom_s26*dscp2**4)
\r
7056 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
\r
7057 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
\r
7058 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
\r
7060 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
\r
7061 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
\r
7062 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
\r
7064 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
\r
7065 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
\r
7066 & +(pom1+pom2)*pom_dx
\r
7068 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
\r
7071 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
\r
7072 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
\r
7073 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
\r
7075 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
\r
7076 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
\r
7077 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
\r
7078 & +x(59)*zz**2 +x(60)*xx*zz
\r
7079 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
\r
7080 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
\r
7081 & +(pom1-pom2)*pom_dy
\r
7083 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
\r
7086 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
\r
7087 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
\r
7088 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
\r
7089 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
\r
7090 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
\r
7091 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
\r
7092 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
\r
7093 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
\r
7095 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
\r
7098 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
\r
7099 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
\r
7100 & +pom1*pom_dt1+pom2*pom_dt2
\r
7102 write(2,*), "de_dt = ", de_dt,de_dt_num
\r
7106 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
\r
7107 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
\r
7108 cosfac2xx=cosfac2*xx
\r
7109 sinfac2yy=sinfac2*yy
\r
7111 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
\r
7113 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
\r
7115 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
\r
7116 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
\r
7117 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
\r
7118 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
\r
7119 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
\r
7120 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
\r
7121 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
\r
7122 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
\r
7123 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
\r
7124 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
\r
7128 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
\r
7129 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
\r
7132 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
\r
7133 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
\r
7134 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
\r
7136 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
\r
7137 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
\r
7141 dXX_Ctab(k,i)=dXX_Ci(k)
\r
7142 dXX_C1tab(k,i)=dXX_Ci1(k)
\r
7143 dYY_Ctab(k,i)=dYY_Ci(k)
\r
7144 dYY_C1tab(k,i)=dYY_Ci1(k)
\r
7145 dZZ_Ctab(k,i)=dZZ_Ci(k)
\r
7146 dZZ_C1tab(k,i)=dZZ_Ci1(k)
\r
7147 dXX_XYZtab(k,i)=dXX_XYZ(k)
\r
7148 dYY_XYZtab(k,i)=dYY_XYZ(k)
\r
7149 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
\r
7153 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
\r
7154 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
\r
7155 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
\r
7156 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
\r
7157 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
\r
7159 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
\r
7160 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
\r
7161 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
\r
7162 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
\r
7163 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
\r
7164 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
\r
7165 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
\r
7166 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
\r
7168 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
\r
7169 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
\r
7171 C to check gradient call subroutine check_grad
\r
7179 c--------------------------------------------------------------------
\r
7182 double precision function enesc(x,xx,yy,zz,cost2,sint2)
\r
7184 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
\r
7185 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
\r
7186 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
\r
7187 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
\r
7189 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
\r
7190 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
\r
7192 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
\r
7193 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
\r
7194 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
\r
7195 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
\r
7196 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
\r
7198 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
\r
7199 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
\r
7200 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
\r
7201 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
\r
7202 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
\r
7204 dsc_i = 0.743d0+x(61)
\r
7205 dp2_i = 1.9d0+x(62)
\r
7206 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
\r
7207 & *(xx*cost2+yy*sint2))
\r
7208 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
\r
7209 & *(xx*cost2-yy*sint2))
\r
7210 s1=(1+x(63))/(0.1d0 + dscp1)
\r
7211 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
\r
7212 s2=(1+x(65))/(0.1d0 + dscp2)
\r
7213 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
\r
7214 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
\r
7215 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
\r
7222 c--------------------------------------------------------------------
\r
7225 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
\r
7227 C This procedure calculates two-body contact function g(rij) and its derivative:
\r
7230 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
\r
7233 C where x=(rij-r0ij)/delta
\r
7235 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
\r
7238 double precision rij,r0ij,eps0ij,fcont,fprimcont
\r
7239 double precision x,x2,x4,delta
\r
7240 c delta=0.02D0*r0ij
\r
7241 c delta=0.2D0*r0ij
\r
7242 x=(rij-r0ij)/delta
\r
7243 if (x.lt.-1.0D0) then
\r
7246 else if (x.le.1.0D0) then
\r
7249 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
\r
7250 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
\r
7259 c--------------------------------------------------------------------
\r
7262 subroutine splinthet(theti,delta,ss,ssder)
\r
7263 implicit real*8 (a-h,o-z)
\r
7264 include 'DIMENSIONS'
\r
7265 include 'COMMON.VAR'
\r
7266 include 'COMMON.GEO'
\r
7269 if (theti.gt.pipol) then
\r
7270 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
\r
7272 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
\r
7279 c--------------------------------------------------------------------
\r
7282 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
\r
7284 double precision x,x0,delta,f0,f1,fprim0,f,fprim
\r
7285 double precision ksi,ksi2,ksi3,a1,a2,a3
\r
7286 a1=fprim0*delta/(f1-f0)
\r
7292 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
\r
7293 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
\r
7298 c--------------------------------------------------------------------
\r
7301 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
\r
7303 double precision x,x0,delta,f0x,f1x,fprim0x,fx
\r
7304 double precision ksi,ksi2,ksi3,a1,a2,a3
\r
7309 a2=3*(f1x-f0x)-2*fprim0x*delta
\r
7310 a3=fprim0x*delta-2*(f1x-f0x)
\r
7311 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
\r
7316 C--------------------------------------------------------------------
\r
7318 C--------------------------------------------------------------------
\r
7321 subroutine etor(etors,edihcnstr)
\r
7322 implicit real*8 (a-h,o-z)
\r
7323 include 'DIMENSIONS'
\r
7324 include 'COMMON.VAR'
\r
7325 include 'COMMON.GEO'
\r
7326 include 'COMMON.LOCAL'
\r
7327 include 'COMMON.TORSION'
\r
7328 include 'COMMON.INTERACT'
\r
7329 include 'COMMON.DERIV'
\r
7330 include 'COMMON.CHAIN'
\r
7331 include 'COMMON.NAMES'
\r
7332 include 'COMMON.IOUNITS'
\r
7333 include 'COMMON.FFIELD'
\r
7334 include 'COMMON.TORCNSTR'
\r
7335 include 'COMMON.CONTROL'
\r
7337 C Set lprn=.true. for debugging
\r
7341 do i=iphi_start,iphi_end
\r
7343 itori=itortyp(itype(i-2))
\r
7344 itori1=itortyp(itype(i-1))
\r
7347 C Proline-Proline pair is a special case...
\r
7348 if (itori.eq.3 .and. itori1.eq.3) then
\r
7349 if (phii.gt.-dwapi3) then
\r
7350 cosphi=dcos(3*phii)
\r
7351 fac=1.0D0/(1.0D0-cosphi)
\r
7352 etorsi=v1(1,3,3)*fac
\r
7353 etorsi=etorsi+etorsi
\r
7354 etors=etors+etorsi-v1(1,3,3)
\r
7355 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
\r
7356 gloci=gloci-3*fac*etorsi*dsin(3*phii)
\r
7359 v1ij=v1(j+1,itori,itori1)
\r
7360 v2ij=v2(j+1,itori,itori1)
\r
7361 cosphi=dcos(j*phii)
\r
7362 sinphi=dsin(j*phii)
\r
7363 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
\r
7364 if (energy_dec) etors_ii=etors_ii+
\r
7365 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
\r
7366 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
\r
7370 v1ij=v1(j,itori,itori1)
\r
7371 v2ij=v2(j,itori,itori1)
\r
7372 cosphi=dcos(j*phii)
\r
7373 sinphi=dsin(j*phii)
\r
7374 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
\r
7375 if (energy_dec) etors_ii=etors_ii+
\r
7376 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
\r
7377 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
\r
7380 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
\r
7381 & 'etor',i,etors_ii
\r
7383 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
\r
7384 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
\r
7385 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
\r
7386 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
\r
7387 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
\r
7389 ! 6/20/98 - dihedral angle constraints
\r
7391 do i=1,ndih_constr
\r
7392 itori=idih_constr(i)
\r
7395 if (difi.gt.drange(i)) then
\r
7396 difi=difi-drange(i)
\r
7397 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
\r
7398 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
\r
7399 else if (difi.lt.-drange(i)) then
\r
7400 difi=difi+drange(i)
\r
7401 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
\r
7402 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
\r
7404 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
\r
7405 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
\r
7407 ! write (iout,*) 'edihcnstr',edihcnstr
\r
7412 c--------------------------------------------------------------------
\r
7415 subroutine etor_d(etors_d)
\r
7421 c--------------------------------------------------------------------
\r
7425 subroutine etor(etors,edihcnstr)
\r
7426 implicit real*8 (a-h,o-z)
\r
7427 include 'DIMENSIONS'
\r
7428 include 'COMMON.VAR'
\r
7429 include 'COMMON.GEO'
\r
7430 include 'COMMON.LOCAL'
\r
7431 include 'COMMON.TORSION'
\r
7432 include 'COMMON.INTERACT'
\r
7433 include 'COMMON.DERIV'
\r
7434 include 'COMMON.CHAIN'
\r
7435 include 'COMMON.NAMES'
\r
7436 include 'COMMON.IOUNITS'
\r
7437 include 'COMMON.FFIELD'
\r
7438 include 'COMMON.TORCNSTR'
\r
7439 include 'COMMON.CONTROL'
\r
7441 C Set lprn=.true. for debugging
\r
7445 do i=iphi_start,iphi_end
\r
7447 itori=itortyp(itype(i-2))
\r
7448 itori1=itortyp(itype(i-1))
\r
7451 C Regular cosine and sine terms
\r
7452 do j=1,nterm(itori,itori1)
\r
7453 v1ij=v1(j,itori,itori1)
\r
7454 v2ij=v2(j,itori,itori1)
\r
7455 cosphi=dcos(j*phii)
\r
7456 sinphi=dsin(j*phii)
\r
7457 etors=etors+v1ij*cosphi+v2ij*sinphi
\r
7458 if (energy_dec) etors_ii=etors_ii+
\r
7459 & v1ij*cosphi+v2ij*sinphi
\r
7460 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
\r
7464 C E = SUM ----------------------------------- - v1
\r
7465 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
\r
7467 cosphi=dcos(0.5d0*phii)
\r
7468 sinphi=dsin(0.5d0*phii)
\r
7469 do j=1,nlor(itori,itori1)
\r
7470 vl1ij=vlor1(j,itori,itori1)
\r
7471 vl2ij=vlor2(j,itori,itori1)
\r
7472 vl3ij=vlor3(j,itori,itori1)
\r
7473 pom=vl2ij*cosphi+vl3ij*sinphi
\r
7474 pom1=1.0d0/(pom*pom+1.0d0)
\r
7475 etors=etors+vl1ij*pom1
\r
7476 if (energy_dec) etors_ii=etors_ii+
\r
7478 pom=-pom*pom1*pom1
\r
7479 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
\r
7481 C Subtract the constant term
\r
7482 etors=etors-v0(itori,itori1)
\r
7483 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
\r
7484 & 'etor',i,etors_ii-v0(itori,itori1)
\r
7486 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
\r
7487 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
\r
7488 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
\r
7489 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
\r
7490 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
\r
7492 ! 6/20/98 - dihedral angle constraints
\r
7494 c do i=1,ndih_constr
\r
7495 do i=idihconstr_start,idihconstr_end
\r
7496 itori=idih_constr(i)
\r
7498 difi=pinorm(phii-phi0(i))
\r
7499 if (difi.gt.drange(i)) then
\r
7500 difi=difi-drange(i)
\r
7501 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
\r
7502 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
\r
7503 else if (difi.lt.-drange(i)) then
\r
7504 difi=difi+drange(i)
\r
7505 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
\r
7506 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
\r
7510 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
\r
7511 cd & rad2deg*phi0(i), rad2deg*drange(i),
\r
7512 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
\r
7514 cd write (iout,*) 'edihcnstr',edihcnstr
\r
7519 c--------------------------------------------------------------------
\r
7522 subroutine etor_d(etors_d)
\r
7523 C 6/23/01 Compute double torsional energy
\r
7524 implicit real*8 (a-h,o-z)
\r
7525 include 'DIMENSIONS'
\r
7526 include 'COMMON.VAR'
\r
7527 include 'COMMON.GEO'
\r
7528 include 'COMMON.LOCAL'
\r
7529 include 'COMMON.TORSION'
\r
7530 include 'COMMON.INTERACT'
\r
7531 include 'COMMON.DERIV'
\r
7532 include 'COMMON.CHAIN'
\r
7533 include 'COMMON.NAMES'
\r
7534 include 'COMMON.IOUNITS'
\r
7535 include 'COMMON.FFIELD'
\r
7536 include 'COMMON.TORCNSTR'
\r
7538 C Set lprn=.true. for debugging
\r
7542 do i=iphid_start,iphid_end
\r
7543 itori=itortyp(itype(i-2))
\r
7544 itori1=itortyp(itype(i-1))
\r
7545 itori2=itortyp(itype(i))
\r
7550 C Regular cosine and sine terms
\r
7551 do j=1,ntermd_1(itori,itori1,itori2)
\r
7552 v1cij=v1c(1,j,itori,itori1,itori2)
\r
7553 v1sij=v1s(1,j,itori,itori1,itori2)
\r
7554 v2cij=v1c(2,j,itori,itori1,itori2)
\r
7555 v2sij=v1s(2,j,itori,itori1,itori2)
\r
7556 cosphi1=dcos(j*phii)
\r
7557 sinphi1=dsin(j*phii)
\r
7558 cosphi2=dcos(j*phii1)
\r
7559 sinphi2=dsin(j*phii1)
\r
7560 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
\r
7561 & v2cij*cosphi2+v2sij*sinphi2
\r
7562 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
\r
7563 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
\r
7565 do k=2,ntermd_2(itori,itori1,itori2)
\r
7567 v1cdij = v2c(k,l,itori,itori1,itori2)
\r
7568 v2cdij = v2c(l,k,itori,itori1,itori2)
\r
7569 v1sdij = v2s(k,l,itori,itori1,itori2)
\r
7570 v2sdij = v2s(l,k,itori,itori1,itori2)
\r
7571 cosphi1p2=dcos(l*phii+(k-l)*phii1)
\r
7572 cosphi1m2=dcos(l*phii-(k-l)*phii1)
\r
7573 sinphi1p2=dsin(l*phii+(k-l)*phii1)
\r
7574 sinphi1m2=dsin(l*phii-(k-l)*phii1)
\r
7575 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
\r
7576 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
\r
7577 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
\r
7578 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
\r
7579 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
\r
7580 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
\r
7583 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
\r
7584 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
\r
7591 c--------------------------------------------------------------------
\r
7594 subroutine eback_sc_corr(esccor)
\r
7595 c 7/21/2007 Correlations between the backbone-local and side-chain-local
\r
7596 c conformational states; temporarily implemented as differences
\r
7597 c between UNRES torsional potentials (dependent on three types of
\r
7598 c residues) and the torsional potentials dependent on all 20 types
\r
7599 c of residues computed from AM1 energy surfaces of terminally-blocked
\r
7600 c amino-acid residues.
\r
7601 implicit real*8 (a-h,o-z)
\r
7602 include 'DIMENSIONS'
\r
7603 include 'COMMON.VAR'
\r
7604 include 'COMMON.GEO'
\r
7605 include 'COMMON.LOCAL'
\r
7606 include 'COMMON.TORSION'
\r
7607 include 'COMMON.SCCOR'
\r
7608 include 'COMMON.INTERACT'
\r
7609 include 'COMMON.DERIV'
\r
7610 include 'COMMON.CHAIN'
\r
7611 include 'COMMON.NAMES'
\r
7612 include 'COMMON.IOUNITS'
\r
7613 include 'COMMON.FFIELD'
\r
7614 include 'COMMON.CONTROL'
\r
7616 C Set lprn=.true. for debugging
\r
7617 write (*,*) "eback_sc_corr 01"
\r
7620 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
\r
7622 do i=iphi_start,iphi_end
\r
7623 write (*,*) "eback_sc_corr 02"
\r
7629 do j=1,nterm_sccor
\r
7630 write (*,*) "eback_sc_corr 03"
\r
7631 v1ij=v1sccor(j,itori,itori1)
\r
7632 v2ij=v2sccor(j,itori,itori1)
\r
7633 cosphi=dcos(j*phii)
\r
7634 sinphi=dsin(j*phii)
\r
7635 esccor=esccor+v1ij*cosphi+v2ij*sinphi
\r
7636 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
\r
7639 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
\r
7640 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
\r
7641 & (v1sccor(j,itori,itori1),j=1,6),(v2sccor(j,itori,itori1),j=1,6)
\r
7642 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
\r
7644 write (*,*) "eback_sc_corr 04"
\r
7649 c--------------------------------------------------------------------
\r
7652 subroutine multibody(ecorr)
\r
7653 C This subroutine calculates multi-body contributions to energy following
\r
7654 C the idea of Skolnick et al. If side chains I and J make a contact and
\r
7655 C at the same time side chains I+1 and J+1 make a contact, an extra
\r
7656 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
\r
7657 implicit real*8 (a-h,o-z)
\r
7658 include 'DIMENSIONS'
\r
7659 include 'COMMON.IOUNITS'
\r
7660 include 'COMMON.DERIV'
\r
7661 include 'COMMON.INTERACT'
\r
7662 include 'COMMON.CONTACTS'
\r
7663 double precision gx(3),gx1(3)
\r
7666 C Set lprn=.true. for debugging
\r
7670 write (iout,'(a)') 'Contact function values:'
\r
7672 write (iout,'(i2,20(1x,i2,f10.5))')
\r
7673 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
\r
7679 gradcorr(j,i)=0.0D0
\r
7680 gradxorr(j,i)=0.0D0
\r
7688 num_conti=num_cont(i)
\r
7689 num_conti1=num_cont(i1)
\r
7692 do kk=1,num_conti1
\r
7694 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
\r
7695 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
\r
7696 cd & ' ishift=',ishift
\r
7697 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
\r
7698 C The system gains extra energy.
\r
7699 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
\r
7700 endif ! j1==j+-ishift
\r
7711 c--------------------------------------------------------------------
\r
7714 double precision function esccorr(i,j,k,l,jj,kk)
\r
7715 implicit real*8 (a-h,o-z)
\r
7716 include 'DIMENSIONS'
\r
7717 include 'COMMON.IOUNITS'
\r
7718 include 'COMMON.DERIV'
\r
7719 include 'COMMON.INTERACT'
\r
7720 include 'COMMON.CONTACTS'
\r
7721 double precision gx(3),gx1(3)
\r
7726 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
\r
7727 C Calculate the multi-body contribution to energy.
\r
7728 C Calculate multi-body contributions to the gradient.
\r
7729 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
\r
7730 cd & k,l,(gacont(m,kk,k),m=1,3)
\r
7732 gx(m) =ekl*gacont(m,jj,i)
\r
7733 gx1(m)=eij*gacont(m,kk,k)
\r
7734 gradxorr(m,i)=gradxorr(m,i)-gx(m)
\r
7735 gradxorr(m,j)=gradxorr(m,j)+gx(m)
\r
7736 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
\r
7737 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
\r
7741 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
\r
7746 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
\r
7754 c--------------------------------------------------------------------
\r
7757 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
\r
7758 C This subroutine calculates multi-body contributions to hydrogen-bonding
\r
7759 implicit real*8 (a-h,o-z)
\r
7760 include 'DIMENSIONS'
\r
7761 include 'COMMON.IOUNITS'
\r
7764 parameter (max_cont=maxconts)
\r
7765 parameter (max_dim=26)
\r
7766 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
\r
7767 double precision zapas(max_dim,maxconts,max_fg_procs),
\r
7768 & zapas_recv(max_dim,maxconts,max_fg_procs)
\r
7769 common /przechowalnia/ zapas
\r
7770 integer status(MPI_STATUS_SIZE),req(maxconts*2),
\r
7771 & status_array(MPI_STATUS_SIZE,maxconts*2)
\r
7773 include 'COMMON.SETUP'
\r
7774 include 'COMMON.FFIELD'
\r
7775 include 'COMMON.DERIV'
\r
7776 include 'COMMON.INTERACT'
\r
7777 include 'COMMON.CONTACTS'
\r
7778 include 'COMMON.CONTROL'
\r
7779 include 'COMMON.LOCAL'
\r
7780 double precision gx(3),gx1(3),time00
\r
7781 logical lprn,ldone
\r
7783 C Set lprn=.true. for debugging
\r
7788 if (nfgtasks.le.1) goto 30
\r
7790 write (iout,'(a)') 'Contact function values before RECEIVE:'
\r
7792 write (iout,'(2i3,50(1x,i2,f5.2))')
\r
7793 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
\r
7794 & j=1,num_cont_hb(i))
\r
7798 do i=1,ntask_cont_from
\r
7801 do i=1,ntask_cont_to
\r
7804 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
\r
7806 C Make the list of contacts to send to send to other procesors
\r
7807 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
\r
7808 c call flush(iout)
\r
7809 do i=iturn3_start,iturn3_end
\r
7810 c write (iout,*) "make contact list turn3",i," num_cont",
\r
7811 c & num_cont_hb(i)
\r
7812 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
\r
7814 do i=iturn4_start,iturn4_end
\r
7815 c write (iout,*) "make contact list turn4",i," num_cont",
\r
7816 c & num_cont_hb(i)
\r
7817 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
\r
7821 c write (iout,*) "make contact list longrange",i,ii," num_cont",
\r
7822 c & num_cont_hb(i)
\r
7823 do j=1,num_cont_hb(i)
\r
7826 iproc=iint_sent_local(k,jjc,ii)
\r
7827 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
\r
7828 if (iproc.gt.0) then
\r
7829 ncont_sent(iproc)=ncont_sent(iproc)+1
\r
7830 nn=ncont_sent(iproc)
\r
7831 zapas(1,nn,iproc)=i
\r
7832 zapas(2,nn,iproc)=jjc
\r
7833 zapas(3,nn,iproc)=facont_hb(j,i)
\r
7834 zapas(4,nn,iproc)=ees0p(j,i)
\r
7835 zapas(5,nn,iproc)=ees0m(j,i)
\r
7836 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
\r
7837 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
\r
7838 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
\r
7839 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
\r
7840 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
\r
7841 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
\r
7842 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
\r
7843 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
\r
7844 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
\r
7845 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
\r
7846 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
\r
7847 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
\r
7848 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
\r
7849 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
\r
7850 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
\r
7851 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
\r
7852 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
\r
7853 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
\r
7854 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
\r
7855 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
\r
7856 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
\r
7863 & "Numbers of contacts to be sent to other processors",
\r
7864 & (ncont_sent(i),i=1,ntask_cont_to)
\r
7865 write (iout,*) "Contacts sent"
\r
7866 do ii=1,ntask_cont_to
\r
7868 iproc=itask_cont_to(ii)
\r
7869 write (iout,*) nn," contacts to processor",iproc,
\r
7870 & " of CONT_TO_COMM group"
\r
7872 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
\r
7878 CorrelID=fg_rank+1
\r
7880 CorrelID1=nfgtasks+fg_rank+1
\r
7882 C Receive the numbers of needed contacts from other processors
\r
7883 do ii=1,ntask_cont_from
\r
7884 iproc=itask_cont_from(ii)
\r
7886 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
\r
7887 & FG_COMM,req(ireq),IERR)
\r
7889 c write (iout,*) "IRECV ended"
\r
7890 c call flush(iout)
\r
7891 C Send the number of contacts needed by other processors
\r
7892 do ii=1,ntask_cont_to
\r
7893 iproc=itask_cont_to(ii)
\r
7895 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
\r
7896 & FG_COMM,req(ireq),IERR)
\r
7898 c write (iout,*) "ISEND ended"
\r
7899 c write (iout,*) "number of requests (nn)",ireq
\r
7902 & call MPI_Waitall(ireq,req,status_array,ierr)
\r
7904 c & "Numbers of contacts to be received from other processors",
\r
7905 c & (ncont_recv(i),i=1,ntask_cont_from)
\r
7906 c call flush(iout)
\r
7907 C Receive contacts
\r
7909 do ii=1,ntask_cont_from
\r
7910 iproc=itask_cont_from(ii)
\r
7912 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
\r
7913 c & " of CONT_TO_COMM group"
\r
7917 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
\r
7918 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
\r
7919 c write (iout,*) "ireq,req",ireq,req(ireq)
\r
7922 C Send the contacts to processors that need them
\r
7923 do ii=1,ntask_cont_to
\r
7924 iproc=itask_cont_to(ii)
\r
7926 c write (iout,*) nn," contacts to processor",iproc,
\r
7927 c & " of CONT_TO_COMM group"
\r
7930 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
\r
7931 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
\r
7932 c write (iout,*) "ireq,req",ireq,req(ireq)
\r
7934 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
\r
7938 c write (iout,*) "number of requests (contacts)",ireq
\r
7939 c write (iout,*) "req",(req(i),i=1,4)
\r
7940 c call flush(iout)
\r
7942 & call MPI_Waitall(ireq,req,status_array,ierr)
\r
7943 do iii=1,ntask_cont_from
\r
7944 iproc=itask_cont_from(iii)
\r
7945 nn=ncont_recv(iii)
\r
7947 write (iout,*) "Received",nn," contacts from processor",iproc,
\r
7948 & " of CONT_FROM_COMM group"
\r
7951 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
\r
7956 ii=zapas_recv(1,i,iii)
\r
7957 c Flag the received contacts to prevent double-counting
\r
7958 jj=-zapas_recv(2,i,iii)
\r
7959 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
\r
7960 c call flush(iout)
\r
7961 nnn=num_cont_hb(ii)+1
\r
7962 num_cont_hb(ii)=nnn
\r
7963 jcont_hb(nnn,ii)=jj
\r
7964 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
\r
7965 ees0p(nnn,ii)=zapas_recv(4,i,iii)
\r
7966 ees0m(nnn,ii)=zapas_recv(5,i,iii)
\r
7967 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
\r
7968 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
\r
7969 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
\r
7970 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
\r
7971 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
\r
7972 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
\r
7973 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
\r
7974 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
\r
7975 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
\r
7976 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
\r
7977 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
\r
7978 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
\r
7979 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
\r
7980 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
\r
7981 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
\r
7982 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
\r
7983 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
\r
7984 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
\r
7985 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
\r
7986 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
\r
7987 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
\r
7992 write (iout,'(a)') 'Contact function values after receive:'
\r
7994 write (iout,'(2i3,50(1x,i3,f5.2))')
\r
7995 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
\r
7996 & j=1,num_cont_hb(i))
\r
8003 write (iout,'(a)') 'Contact function values:'
\r
8005 write (iout,'(2i3,50(1x,i3,f5.2))')
\r
8006 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
\r
8007 & j=1,num_cont_hb(i))
\r
8011 C Remove the loop below after debugging !!!
\r
8014 gradcorr(j,i)=0.0D0
\r
8015 gradxorr(j,i)=0.0D0
\r
8018 C Calculate the local-electrostatic correlation terms
\r
8019 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
\r
8021 num_conti=num_cont_hb(i)
\r
8022 num_conti1=num_cont_hb(i+1)
\r
8026 do kk=1,num_conti1
\r
8027 j1=jcont_hb(kk,i1)
\r
8029 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
\r
8030 c & ' jj=',jj,' kk=',kk
\r
8031 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
\r
8032 & .or. j.lt.0 .and. j1.gt.0) .and.
\r
8033 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
\r
8034 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
\r
8035 C The system gains extra energy.
\r
8036 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
\r
8037 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
\r
8038 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
\r
8040 else if (j1.eq.j) then
\r
8041 C Contacts I-J and I-(J+1) occur simultaneously.
\r
8042 C The system loses extra energy.
\r
8043 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
\r
8048 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
\r
8049 c & ' jj=',jj,' kk=',kk
\r
8050 if (j1.eq.j+1) then
\r
8051 C Contacts I-J and (I+1)-J occur simultaneously.
\r
8052 C The system loses extra energy.
\r
8053 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
\r
8062 c--------------------------------------------------------------------
\r
8065 subroutine add_hb_contact(ii,jj,itask)
\r
8066 implicit real*8 (a-h,o-z)
\r
8067 include "DIMENSIONS"
\r
8068 include "COMMON.IOUNITS"
\r
8071 parameter (max_cont=maxconts)
\r
8072 parameter (max_dim=26)
\r
8073 include "COMMON.CONTACTS"
\r
8074 double precision zapas(max_dim,maxconts,max_fg_procs),
\r
8075 & zapas_recv(max_dim,maxconts,max_fg_procs)
\r
8076 common /przechowalnia/ zapas
\r
8077 integer i,j,ii,jj,iproc,itask(4),nn
\r
8078 c write (iout,*) "itask",itask
\r
8081 if (iproc.gt.0) then
\r
8082 do j=1,num_cont_hb(ii)
\r
8083 jjc=jcont_hb(j,ii)
\r
8084 c write (iout,*) "i",ii," j",jj," jjc",jjc
\r
8085 if (jjc.eq.jj) then
\r
8086 ncont_sent(iproc)=ncont_sent(iproc)+1
\r
8087 nn=ncont_sent(iproc)
\r
8088 zapas(1,nn,iproc)=ii
\r
8089 zapas(2,nn,iproc)=jjc
\r
8090 zapas(3,nn,iproc)=facont_hb(j,ii)
\r
8091 zapas(4,nn,iproc)=ees0p(j,ii)
\r
8092 zapas(5,nn,iproc)=ees0m(j,ii)
\r
8093 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
\r
8094 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
\r
8095 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
\r
8096 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
\r
8097 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
\r
8098 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
\r
8099 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
\r
8100 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
\r
8101 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
\r
8102 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
\r
8103 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
\r
8104 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
\r
8105 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
\r
8106 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
\r
8107 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
\r
8108 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
\r
8109 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
\r
8110 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
\r
8111 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
\r
8112 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
\r
8113 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
\r
8123 c--------------------------------------------------------------------
\r
8126 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
\r
8128 C This subroutine calculates multi-body contributions to hydrogen-bonding
\r
8129 implicit real*8 (a-h,o-z)
\r
8130 include 'DIMENSIONS'
\r
8131 include 'COMMON.IOUNITS'
\r
8134 parameter (max_cont=maxconts)
\r
8135 parameter (max_dim=70)
\r
8136 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
\r
8137 double precision zapas(max_dim,maxconts,max_fg_procs),
\r
8138 & zapas_recv(max_dim,maxconts,max_fg_procs)
\r
8139 common /przechowalnia/ zapas
\r
8140 integer status(MPI_STATUS_SIZE),req(maxconts*2),
\r
8141 & status_array(MPI_STATUS_SIZE,maxconts*2)
\r
8143 include 'COMMON.SETUP'
\r
8144 include 'COMMON.FFIELD'
\r
8145 include 'COMMON.DERIV'
\r
8146 include 'COMMON.LOCAL'
\r
8147 include 'COMMON.INTERACT'
\r
8148 include 'COMMON.CONTACTS'
\r
8149 include 'COMMON.CHAIN'
\r
8150 include 'COMMON.CONTROL'
\r
8151 double precision gx(3),gx1(3)
\r
8152 integer num_cont_hb_old(maxres)
\r
8153 logical lprn,ldone
\r
8154 double precision eello4,eello5,eelo6,eello_turn6
\r
8155 external eello4,eello5,eello6,eello_turn6
\r
8156 C Set lprn=.true. for debugging
\r
8161 num_cont_hb_old(i)=num_cont_hb(i)
\r
8165 if (nfgtasks.le.1) goto 30
\r
8167 write (iout,'(a)') 'Contact function values before RECEIVE:'
\r
8169 write (iout,'(2i3,50(1x,i2,f5.2))')
\r
8170 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
\r
8171 & j=1,num_cont_hb(i))
\r
8175 do i=1,ntask_cont_from
\r
8178 do i=1,ntask_cont_to
\r
8181 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
\r
8183 C Make the list of contacts to send to send to other procesors
\r
8184 do i=iturn3_start,iturn3_end
\r
8185 c write (iout,*) "make contact list turn3",i," num_cont",
\r
8186 c & num_cont_hb(i)
\r
8187 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
\r
8189 do i=iturn4_start,iturn4_end
\r
8190 c write (iout,*) "make contact list turn4",i," num_cont",
\r
8191 c & num_cont_hb(i)
\r
8192 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
\r
8196 c write (iout,*) "make contact list longrange",i,ii," num_cont",
\r
8197 c & num_cont_hb(i)
\r
8198 do j=1,num_cont_hb(i)
\r
8201 iproc=iint_sent_local(k,jjc,ii)
\r
8202 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
\r
8203 if (iproc.ne.0) then
\r
8204 ncont_sent(iproc)=ncont_sent(iproc)+1
\r
8205 nn=ncont_sent(iproc)
\r
8206 zapas(1,nn,iproc)=i
\r
8207 zapas(2,nn,iproc)=jjc
\r
8208 zapas(3,nn,iproc)=d_cont(j,i)
\r
8212 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
\r
8217 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
\r
8225 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
\r
8236 & "Numbers of contacts to be sent to other processors",
\r
8237 & (ncont_sent(i),i=1,ntask_cont_to)
\r
8238 write (iout,*) "Contacts sent"
\r
8239 do ii=1,ntask_cont_to
\r
8241 iproc=itask_cont_to(ii)
\r
8242 write (iout,*) nn," contacts to processor",iproc,
\r
8243 & " of CONT_TO_COMM group"
\r
8245 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
\r
8251 CorrelID=fg_rank+1
\r
8253 CorrelID1=nfgtasks+fg_rank+1
\r
8255 C Receive the numbers of needed contacts from other processors
\r
8256 do ii=1,ntask_cont_from
\r
8257 iproc=itask_cont_from(ii)
\r
8259 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
\r
8260 & FG_COMM,req(ireq),IERR)
\r
8262 c write (iout,*) "IRECV ended"
\r
8263 c call flush(iout)
\r
8264 C Send the number of contacts needed by other processors
\r
8265 do ii=1,ntask_cont_to
\r
8266 iproc=itask_cont_to(ii)
\r
8268 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
\r
8269 & FG_COMM,req(ireq),IERR)
\r
8271 c write (iout,*) "ISEND ended"
\r
8272 c write (iout,*) "number of requests (nn)",ireq
\r
8275 & call MPI_Waitall(ireq,req,status_array,ierr)
\r
8277 c & "Numbers of contacts to be received from other processors",
\r
8278 c & (ncont_recv(i),i=1,ntask_cont_from)
\r
8279 c call flush(iout)
\r
8280 C Receive contacts
\r
8282 do ii=1,ntask_cont_from
\r
8283 iproc=itask_cont_from(ii)
\r
8285 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
\r
8286 c & " of CONT_TO_COMM group"
\r
8290 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
\r
8291 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
\r
8292 c write (iout,*) "ireq,req",ireq,req(ireq)
\r
8295 C Send the contacts to processors that need them
\r
8296 do ii=1,ntask_cont_to
\r
8297 iproc=itask_cont_to(ii)
\r
8299 c write (iout,*) nn," contacts to processor",iproc,
\r
8300 c & " of CONT_TO_COMM group"
\r
8303 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
\r
8304 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
\r
8305 c write (iout,*) "ireq,req",ireq,req(ireq)
\r
8307 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
\r
8311 c write (iout,*) "number of requests (contacts)",ireq
\r
8312 c write (iout,*) "req",(req(i),i=1,4)
\r
8313 c call flush(iout)
\r
8315 & call MPI_Waitall(ireq,req,status_array,ierr)
\r
8316 do iii=1,ntask_cont_from
\r
8317 iproc=itask_cont_from(iii)
\r
8318 nn=ncont_recv(iii)
\r
8320 write (iout,*) "Received",nn," contacts from processor",iproc,
\r
8321 & " of CONT_FROM_COMM group"
\r
8324 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
\r
8329 ii=zapas_recv(1,i,iii)
\r
8330 c Flag the received contacts to prevent double-counting
\r
8331 jj=-zapas_recv(2,i,iii)
\r
8332 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
\r
8333 c call flush(iout)
\r
8334 nnn=num_cont_hb(ii)+1
\r
8335 num_cont_hb(ii)=nnn
\r
8336 jcont_hb(nnn,ii)=jj
\r
8337 d_cont(nnn,ii)=zapas_recv(3,i,iii)
\r
8341 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
\r
8346 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
\r
8354 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
\r
8363 write (iout,'(a)') 'Contact function values after receive:'
\r
8365 write (iout,'(2i3,50(1x,i3,5f6.3))')
\r
8366 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
\r
8367 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
\r
8374 write (iout,'(a)') 'Contact function values:'
\r
8376 write (iout,'(2i3,50(1x,i2,5f6.3))')
\r
8377 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
\r
8378 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
\r
8384 C Remove the loop below after debugging !!!
\r
8387 gradcorr(j,i)=0.0D0
\r
8388 gradxorr(j,i)=0.0D0
\r
8391 C Calculate the dipole-dipole interaction energies
\r
8392 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
\r
8393 do i=iatel_s,iatel_e+1
\r
8394 num_conti=num_cont_hb(i)
\r
8398 call dipole(i,j,jj)
\r
8403 C Calculate the local-electrostatic correlation terms
\r
8404 c write (iout,*) "gradcorr5 in eello5 before loop"
\r
8406 c write (iout,'(i5,3f10.5)')
\r
8407 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
\r
8409 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
\r
8410 c write (iout,*) "corr loop i",i
\r
8412 num_conti=num_cont_hb(i)
\r
8413 num_conti1=num_cont_hb(i+1)
\r
8417 do kk=1,num_conti1
\r
8418 j1=jcont_hb(kk,i1)
\r
8420 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
\r
8421 c & ' jj=',jj,' kk=',kk
\r
8422 c if (j1.eq.j+1 .or. j1.eq.j-1) then
\r
8423 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
\r
8424 & .or. j.lt.0 .and. j1.gt.0) .and.
\r
8425 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
\r
8426 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
\r
8427 C The system gains extra energy.
\r
8429 sqd1=dsqrt(d_cont(jj,i))
\r
8430 sqd2=dsqrt(d_cont(kk,i1))
\r
8431 sred_geom = sqd1*sqd2
\r
8432 IF (sred_geom.lt.cutoff_corr) THEN
\r
8433 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
\r
8434 & ekont,fprimcont)
\r
8435 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
\r
8436 cd & ' jj=',jj,' kk=',kk
\r
8437 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
\r
8438 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
\r
8440 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
\r
8441 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
\r
8444 cd write (iout,*) 'sred_geom=',sred_geom,
\r
8445 cd & ' ekont=',ekont,' fprim=',fprimcont,
\r
8446 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
\r
8447 cd write (iout,*) "g_contij",g_contij
\r
8448 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
\r
8449 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
\r
8450 call calc_eello(i,jp,i+1,jp1,jj,kk)
\r
8451 if (wcorr4.gt.0.0d0)
\r
8452 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
\r
8453 if (energy_dec.and.wcorr4.gt.0.0d0)
\r
8454 1 write (iout,'(a6,4i5,0pf7.3)')
\r
8455 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
\r
8456 c write (iout,*) "gradcorr5 before eello5"
\r
8458 c write (iout,'(i5,3f10.5)')
\r
8459 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
\r
8461 if (wcorr5.gt.0.0d0)
\r
8462 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
\r
8463 c write (iout,*) "gradcorr5 after eello5"
\r
8465 c write (iout,'(i5,3f10.5)')
\r
8466 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
\r
8468 if (energy_dec.and.wcorr5.gt.0.0d0)
\r
8469 1 write (iout,'(a6,4i5,0pf7.3)')
\r
8470 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
\r
8471 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
\r
8472 cd write(2,*)'ijkl',i,jp,i+1,jp1
\r
8473 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
\r
8474 & .or. wturn6.eq.0.0d0))then
\r
8475 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
\r
8476 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
\r
8477 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
\r
8478 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
\r
8479 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
\r
8480 cd & 'ecorr6=',ecorr6
\r
8481 cd write (iout,'(4e15.5)') sred_geom,
\r
8482 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
\r
8483 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
\r
8484 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
\r
8485 else if (wturn6.gt.0.0d0
\r
8486 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
\r
8487 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
\r
8488 eturn6=eturn6+eello_turn6(i,jj,kk)
\r
8489 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
\r
8490 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
\r
8491 cd write (2,*) 'multibody_eello:eturn6',eturn6
\r
8500 num_cont_hb(i)=num_cont_hb_old(i)
\r
8502 c write (iout,*) "gradcorr5 in eello5"
\r
8504 c write (iout,'(i5,3f10.5)')
\r
8505 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
\r
8511 c--------------------------------------------------------------------
\r
8514 subroutine add_hb_contact_eello(ii,jj,itask)
\r
8515 implicit real*8 (a-h,o-z)
\r
8516 include "DIMENSIONS"
\r
8517 include "COMMON.IOUNITS"
\r
8520 parameter (max_cont=maxconts)
\r
8521 parameter (max_dim=70)
\r
8522 include "COMMON.CONTACTS"
\r
8523 double precision zapas(max_dim,maxconts,max_fg_procs),
\r
8524 & zapas_recv(max_dim,maxconts,max_fg_procs)
\r
8525 common /przechowalnia/ zapas
\r
8526 integer i,j,ii,jj,iproc,itask(4),nn
\r
8527 c write (iout,*) "itask",itask
\r
8530 if (iproc.gt.0) then
\r
8531 do j=1,num_cont_hb(ii)
\r
8532 jjc=jcont_hb(j,ii)
\r
8533 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
\r
8534 if (jjc.eq.jj) then
\r
8535 ncont_sent(iproc)=ncont_sent(iproc)+1
\r
8536 nn=ncont_sent(iproc)
\r
8537 zapas(1,nn,iproc)=ii
\r
8538 zapas(2,nn,iproc)=jjc
\r
8539 zapas(3,nn,iproc)=d_cont(j,ii)
\r
8543 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
\r
8548 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
\r
8556 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
\r
8570 c--------------------------------------------------------------------
\r
8573 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
\r
8574 implicit real*8 (a-h,o-z)
\r
8575 include 'DIMENSIONS'
\r
8576 include 'COMMON.IOUNITS'
\r
8577 include 'COMMON.DERIV'
\r
8578 include 'COMMON.INTERACT'
\r
8579 include 'COMMON.CONTACTS'
\r
8580 double precision gx(3),gx1(3)
\r
8583 eij=facont_hb(jj,i)
\r
8584 ekl=facont_hb(kk,k)
\r
8585 ees0pij=ees0p(jj,i)
\r
8586 ees0pkl=ees0p(kk,k)
\r
8587 ees0mij=ees0m(jj,i)
\r
8588 ees0mkl=ees0m(kk,k)
\r
8590 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
\r
8591 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
\r
8592 C Following 4 lines for diagnostics.
\r
8597 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
\r
8598 c & 'Contacts ',i,j,
\r
8599 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
\r
8600 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
\r
8601 c & 'gradcorr_long'
\r
8602 C Calculate the multi-body contribution to energy.
\r
8603 c ecorr=ecorr+ekont*ees
\r
8604 C Calculate multi-body contributions to the gradient.
\r
8605 coeffpees0pij=coeffp*ees0pij
\r
8606 coeffmees0mij=coeffm*ees0mij
\r
8607 coeffpees0pkl=coeffp*ees0pkl
\r
8608 coeffmees0mkl=coeffm*ees0mkl
\r
8610 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
\r
8611 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
\r
8612 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
\r
8613 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
\r
8614 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
\r
8615 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
\r
8616 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
\r
8617 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
\r
8618 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
\r
8619 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
\r
8620 & coeffmees0mij*gacontm_hb1(ll,kk,k))
\r
8621 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
\r
8622 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
\r
8623 & coeffmees0mij*gacontm_hb2(ll,kk,k))
\r
8624 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
\r
8625 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
\r
8626 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
\r
8627 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
\r
8628 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
\r
8629 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
\r
8630 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
\r
8631 & coeffmees0mij*gacontm_hb3(ll,kk,k))
\r
8632 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
\r
8633 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
\r
8634 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
\r
8637 cgrad do m=i+1,j-1
\r
8639 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
\r
8640 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
\r
8641 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
\r
8642 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
\r
8645 cgrad do m=k+1,l-1
\r
8647 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
\r
8648 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
\r
8649 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
\r
8650 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
\r
8653 c write (iout,*) "ehbcorr",ekont*ees
\r
8660 C--------------------------------------------------------------------
\r
8663 subroutine dipole(i,j,jj)
\r
8664 implicit real*8 (a-h,o-z)
\r
8665 include 'DIMENSIONS'
\r
8666 include 'COMMON.IOUNITS'
\r
8667 include 'COMMON.CHAIN'
\r
8668 include 'COMMON.FFIELD'
\r
8669 include 'COMMON.DERIV'
\r
8670 include 'COMMON.INTERACT'
\r
8671 include 'COMMON.CONTACTS'
\r
8672 include 'COMMON.TORSION'
\r
8673 include 'COMMON.VAR'
\r
8674 include 'COMMON.GEO'
\r
8675 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
\r
8677 iti1 = itortyp(itype(i+1))
\r
8678 if (j.lt.nres-1) then
\r
8679 itj1 = itortyp(itype(j+1))
\r
8684 dipi(iii,1)=Ub2(iii,i)
\r
8685 dipderi(iii)=Ub2der(iii,i)
\r
8686 dipi(iii,2)=b1(iii,iti1)
\r
8687 dipj(iii,1)=Ub2(iii,j)
\r
8688 dipderj(iii)=Ub2der(iii,j)
\r
8689 dipj(iii,2)=b1(iii,itj1)
\r
8693 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
\r
8696 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
\r
8703 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
\r
8707 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
\r
8712 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
\r
8713 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
\r
8715 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
\r
8717 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
\r
8719 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
\r
8726 C--------------------------------------------------------------------
\r
8729 subroutine calc_eello(i,j,k,l,jj,kk)
\r
8731 C This subroutine computes matrices and vectors needed to calculate
\r
8732 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
\r
8734 implicit real*8 (a-h,o-z)
\r
8735 include 'DIMENSIONS'
\r
8736 include 'COMMON.IOUNITS'
\r
8737 include 'COMMON.CHAIN'
\r
8738 include 'COMMON.DERIV'
\r
8739 include 'COMMON.INTERACT'
\r
8740 include 'COMMON.CONTACTS'
\r
8741 include 'COMMON.TORSION'
\r
8742 include 'COMMON.VAR'
\r
8743 include 'COMMON.GEO'
\r
8744 include 'COMMON.FFIELD'
\r
8745 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
\r
8746 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
\r
8748 common /kutas/ lprn
\r
8749 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
\r
8750 cd & ' jj=',jj,' kk=',kk
\r
8751 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
\r
8752 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
\r
8753 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
\r
8756 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
\r
8757 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
\r
8760 call transpose2(aa1(1,1),aa1t(1,1))
\r
8761 call transpose2(aa2(1,1),aa2t(1,1))
\r
8764 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
\r
8765 & aa1tder(1,1,lll,kkk))
\r
8766 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
\r
8767 & aa2tder(1,1,lll,kkk))
\r
8770 if (l.eq.j+1) then
\r
8771 C parallel orientation of the two CA-CA-CA frames.
\r
8773 iti=itortyp(itype(i))
\r
8777 itk1=itortyp(itype(k+1))
\r
8778 itj=itortyp(itype(j))
\r
8779 if (l.lt.nres-1) then
\r
8780 itl1=itortyp(itype(l+1))
\r
8784 C A1 kernel(j+1) A2T
\r
8786 cd write (iout,'(3f10.5,5x,3f10.5)')
\r
8787 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
\r
8789 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
\r
8790 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
\r
8791 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
\r
8792 C Following matrices are needed only for 6-th order cumulants
\r
8793 IF (wcorr6.gt.0.0d0) THEN
\r
8794 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
\r
8795 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
\r
8796 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
\r
8797 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
\r
8798 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
\r
8799 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
\r
8800 & ADtEAderx(1,1,1,1,1,1))
\r
8802 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
\r
8803 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
\r
8804 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
\r
8805 & ADtEA1derx(1,1,1,1,1,1))
\r
8807 C End 6-th order cumulants
\r
8810 cd write (2,*) 'In calc_eello6'
\r
8812 cd write (2,*) 'iii=',iii
\r
8814 cd write (2,*) 'kkk=',kkk
\r
8816 cd write (2,'(3(2f10.5),5x)')
\r
8817 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
\r
8822 call transpose2(EUgder(1,1,k),auxmat(1,1))
\r
8823 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
\r
8824 call transpose2(EUg(1,1,k),auxmat(1,1))
\r
8825 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
\r
8826 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
\r
8830 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
\r
8831 & EAEAderx(1,1,lll,kkk,iii,1))
\r
8835 C A1T kernel(i+1) A2
\r
8836 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
\r
8837 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
\r
8838 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
\r
8839 C Following matrices are needed only for 6-th order cumulants
\r
8840 IF (wcorr6.gt.0.0d0) THEN
\r
8841 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
\r
8842 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
\r
8843 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
\r
8844 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
\r
8845 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
\r
8846 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
\r
8847 & ADtEAderx(1,1,1,1,1,2))
\r
8848 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
\r
8849 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
\r
8850 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
\r
8851 & ADtEA1derx(1,1,1,1,1,2))
\r
8853 C End 6-th order cumulants
\r
8854 call transpose2(EUgder(1,1,l),auxmat(1,1))
\r
8855 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
\r
8856 call transpose2(EUg(1,1,l),auxmat(1,1))
\r
8857 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
\r
8858 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
\r
8862 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
\r
8863 & EAEAderx(1,1,lll,kkk,iii,2))
\r
8868 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
\r
8869 C They are needed only when the fifth- or the sixth-order cumulants are
\r
8871 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
\r
8872 call transpose2(AEA(1,1,1),auxmat(1,1))
\r
8873 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
\r
8874 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
\r
8875 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
\r
8876 call transpose2(AEAderg(1,1,1),auxmat(1,1))
\r
8877 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
\r
8878 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
\r
8879 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
\r
8880 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
\r
8881 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
\r
8882 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
\r
8883 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
\r
8884 call transpose2(AEA(1,1,2),auxmat(1,1))
\r
8885 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
\r
8886 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
\r
8887 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
\r
8888 call transpose2(AEAderg(1,1,2),auxmat(1,1))
\r
8889 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
\r
8890 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
\r
8891 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
\r
8892 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
\r
8893 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
\r
8894 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
\r
8895 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
\r
8896 C Calculate the Cartesian derivatives of the vectors.
\r
8900 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
\r
8901 call matvec2(auxmat(1,1),b1(1,iti),
\r
8902 & AEAb1derx(1,lll,kkk,iii,1,1))
\r
8903 call matvec2(auxmat(1,1),Ub2(1,i),
\r
8904 & AEAb2derx(1,lll,kkk,iii,1,1))
\r
8905 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
\r
8906 & AEAb1derx(1,lll,kkk,iii,2,1))
\r
8907 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
\r
8908 & AEAb2derx(1,lll,kkk,iii,2,1))
\r
8909 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
\r
8910 call matvec2(auxmat(1,1),b1(1,itj),
\r
8911 & AEAb1derx(1,lll,kkk,iii,1,2))
\r
8912 call matvec2(auxmat(1,1),Ub2(1,j),
\r
8913 & AEAb2derx(1,lll,kkk,iii,1,2))
\r
8914 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
\r
8915 & AEAb1derx(1,lll,kkk,iii,2,2))
\r
8916 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
\r
8917 & AEAb2derx(1,lll,kkk,iii,2,2))
\r
8924 C Antiparallel orientation of the two CA-CA-CA frames.
\r
8926 iti=itortyp(itype(i))
\r
8930 itk1=itortyp(itype(k+1))
\r
8931 itl=itortyp(itype(l))
\r
8932 itj=itortyp(itype(j))
\r
8933 if (j.lt.nres-1) then
\r
8934 itj1=itortyp(itype(j+1))
\r
8938 C A2 kernel(j-1)T A1T
\r
8939 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
\r
8940 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
\r
8941 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
\r
8942 C Following matrices are needed only for 6-th order cumulants
\r
8943 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
\r
8944 & j.eq.i+4 .and. l.eq.i+3)) THEN
\r
8945 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
\r
8946 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
\r
8947 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
\r
8948 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
\r
8949 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
\r
8950 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
\r
8951 & ADtEAderx(1,1,1,1,1,1))
\r
8952 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
\r
8953 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
\r
8954 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
\r
8955 & ADtEA1derx(1,1,1,1,1,1))
\r
8957 C End 6-th order cumulants
\r
8958 call transpose2(EUgder(1,1,k),auxmat(1,1))
\r
8959 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
\r
8960 call transpose2(EUg(1,1,k),auxmat(1,1))
\r
8961 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
\r
8962 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
\r
8966 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
\r
8967 & EAEAderx(1,1,lll,kkk,iii,1))
\r
8971 C A2T kernel(i+1)T A1
\r
8972 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
\r
8973 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
\r
8974 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
\r
8975 C Following matrices are needed only for 6-th order cumulants
\r
8976 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
\r
8977 & j.eq.i+4 .and. l.eq.i+3)) THEN
\r
8978 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
\r
8979 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
\r
8980 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
\r
8981 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
\r
8982 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
\r
8983 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
\r
8984 & ADtEAderx(1,1,1,1,1,2))
\r
8985 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
\r
8986 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
\r
8987 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
\r
8988 & ADtEA1derx(1,1,1,1,1,2))
\r
8990 C End 6-th order cumulants
\r
8991 call transpose2(EUgder(1,1,j),auxmat(1,1))
\r
8992 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
\r
8993 call transpose2(EUg(1,1,j),auxmat(1,1))
\r
8994 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
\r
8995 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
\r
8999 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
\r
9000 & EAEAderx(1,1,lll,kkk,iii,2))
\r
9005 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
\r
9006 C They are needed only when the fifth- or the sixth-order cumulants are
\r
9008 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
\r
9009 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
\r
9010 call transpose2(AEA(1,1,1),auxmat(1,1))
\r
9011 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
\r
9012 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
\r
9013 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
\r
9014 call transpose2(AEAderg(1,1,1),auxmat(1,1))
\r
9015 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
\r
9016 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
\r
9017 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
\r
9018 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
\r
9019 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
\r
9020 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
\r
9021 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
\r
9022 call transpose2(AEA(1,1,2),auxmat(1,1))
\r
9023 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
\r
9024 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
\r
9025 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
\r
9026 call transpose2(AEAderg(1,1,2),auxmat(1,1))
\r
9027 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
\r
9028 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
\r
9029 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
\r
9030 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
\r
9031 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
\r
9032 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
\r
9033 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
\r
9034 C Calculate the Cartesian derivatives of the vectors.
\r
9038 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
\r
9039 call matvec2(auxmat(1,1),b1(1,iti),
\r
9040 & AEAb1derx(1,lll,kkk,iii,1,1))
\r
9041 call matvec2(auxmat(1,1),Ub2(1,i),
\r
9042 & AEAb2derx(1,lll,kkk,iii,1,1))
\r
9043 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
\r
9044 & AEAb1derx(1,lll,kkk,iii,2,1))
\r
9045 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
\r
9046 & AEAb2derx(1,lll,kkk,iii,2,1))
\r
9047 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
\r
9048 call matvec2(auxmat(1,1),b1(1,itl),
\r
9049 & AEAb1derx(1,lll,kkk,iii,1,2))
\r
9050 call matvec2(auxmat(1,1),Ub2(1,l),
\r
9051 & AEAb2derx(1,lll,kkk,iii,1,2))
\r
9052 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
\r
9053 & AEAb1derx(1,lll,kkk,iii,2,2))
\r
9054 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
\r
9055 & AEAb2derx(1,lll,kkk,iii,2,2))
\r
9066 C--------------------------------------------------------------------
\r
9069 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
\r
9070 & KK,KKderg,AKA,AKAderg,AKAderx)
\r
9074 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
\r
9075 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
\r
9076 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
\r
9077 integer iii,kkk,lll
\r
9080 common /kutas/ lprn
\r
9081 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
\r
9083 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
\r
9084 & AKAderg(1,1,iii))
\r
9086 cd if (lprn) write (2,*) 'In kernel'
\r
9088 cd if (lprn) write (2,*) 'kkk=',kkk
\r
9090 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
\r
9091 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
\r
9093 cd write (2,*) 'lll=',lll
\r
9094 cd write (2,*) 'iii=1'
\r
9096 cd write (2,'(3(2f10.5),5x)')
\r
9097 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
\r
9100 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
\r
9101 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
\r
9103 cd write (2,*) 'lll=',lll
\r
9104 cd write (2,*) 'iii=2'
\r
9106 cd write (2,'(3(2f10.5),5x)')
\r
9107 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
\r
9116 C--------------------------------------------------------------------
\r
9119 double precision function eello4(i,j,k,l,jj,kk)
\r
9120 implicit real*8 (a-h,o-z)
\r
9121 include 'DIMENSIONS'
\r
9122 include 'COMMON.IOUNITS'
\r
9123 include 'COMMON.CHAIN'
\r
9124 include 'COMMON.DERIV'
\r
9125 include 'COMMON.INTERACT'
\r
9126 include 'COMMON.CONTACTS'
\r
9127 include 'COMMON.TORSION'
\r
9128 include 'COMMON.VAR'
\r
9129 include 'COMMON.GEO'
\r
9130 double precision pizda(2,2),ggg1(3),ggg2(3)
\r
9131 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
\r
9135 cd print *,'eello4:',i,j,k,l,jj,kk
\r
9136 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
\r
9137 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
\r
9138 cold eij=facont_hb(jj,i)
\r
9139 cold ekl=facont_hb(kk,k)
\r
9140 cold ekont=eij*ekl
\r
9141 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
\r
9142 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
\r
9143 gcorr_loc(k-1)=gcorr_loc(k-1)
\r
9144 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
\r
9145 if (l.eq.j+1) then
\r
9146 gcorr_loc(l-1)=gcorr_loc(l-1)
\r
9147 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
\r
9149 gcorr_loc(j-1)=gcorr_loc(j-1)
\r
9150 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
\r
9155 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
\r
9156 & -EAEAderx(2,2,lll,kkk,iii,1)
\r
9157 cd derx(lll,kkk,iii)=0.0d0
\r
9161 cd gcorr_loc(l-1)=0.0d0
\r
9162 cd gcorr_loc(j-1)=0.0d0
\r
9163 cd gcorr_loc(k-1)=0.0d0
\r
9165 cd write (iout,*)'Contacts have occurred for peptide groups',
\r
9166 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
\r
9167 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
\r
9168 if (j.lt.nres-1) then
\r
9175 if (l.lt.nres-1) then
\r
9183 cgrad ggg1(ll)=eel4*g_contij(ll,1)
\r
9184 cgrad ggg2(ll)=eel4*g_contij(ll,2)
\r
9185 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
\r
9186 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
\r
9187 cgrad ghalf=0.5d0*ggg1(ll)
\r
9188 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
\r
9189 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
\r
9190 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
\r
9191 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
\r
9192 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
\r
9193 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
\r
9194 cgrad ghalf=0.5d0*ggg2(ll)
\r
9195 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
\r
9196 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
\r
9197 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
\r
9198 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
\r
9199 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
\r
9200 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
\r
9202 cgrad do m=i+1,j-1
\r
9204 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
\r
9207 cgrad do m=k+1,l-1
\r
9209 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
\r
9214 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
\r
9219 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
\r
9222 cd do iii=1,nres-3
\r
9223 cd write (2,*) iii,gcorr_loc(iii)
\r
9226 cd write (2,*) 'ekont',ekont
\r
9227 cd write (iout,*) 'eello4',ekont*eel4
\r
9232 C--------------------------------------------------------------------
\r
9235 double precision function eello5(i,j,k,l,jj,kk)
\r
9236 implicit real*8 (a-h,o-z)
\r
9237 include 'DIMENSIONS'
\r
9238 include 'COMMON.IOUNITS'
\r
9239 include 'COMMON.CHAIN'
\r
9240 include 'COMMON.DERIV'
\r
9241 include 'COMMON.INTERACT'
\r
9242 include 'COMMON.CONTACTS'
\r
9243 include 'COMMON.TORSION'
\r
9244 include 'COMMON.VAR'
\r
9245 include 'COMMON.GEO'
\r
9246 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
\r
9247 double precision ggg1(3),ggg2(3)
\r
9248 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
\r
9250 C Parallel chains C
\r
9253 C /l\ / \ \ / \ / \ / C
\r
9254 C / \ / \ \ / \ / \ / C
\r
9255 C j| o |l1 | o | o| o | | o |o C
\r
9256 C \ |/k\| |/ \| / |/ \| |/ \| C
\r
9257 C \i/ \ / \ / / \ / \ C
\r
9259 C (I) (II) (III) (IV) C
\r
9261 C eello5_1 eello5_2 eello5_3 eello5_4 C
\r
9263 C Antiparallel chains C
\r
9266 C /j\ / \ \ / \ / \ / C
\r
9267 C / \ / \ \ / \ / \ / C
\r
9268 C j1| o |l | o | o| o | | o |o C
\r
9269 C \ |/k\| |/ \| / |/ \| |/ \| C
\r
9270 C \i/ \ / \ / / \ / \ C
\r
9272 C (I) (II) (III) (IV) C
\r
9274 C eello5_1 eello5_2 eello5_3 eello5_4 C
\r
9276 C o denotes a local interaction, vertical lines an electrostatic interaction. C
\r
9278 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
\r
9279 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
\r
9284 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
\r
9286 itk=itortyp(itype(k))
\r
9287 itl=itortyp(itype(l))
\r
9288 itj=itortyp(itype(j))
\r
9293 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
\r
9294 cd & eel5_3_num,eel5_4_num)
\r
9298 derx(lll,kkk,iii)=0.0d0
\r
9302 cd eij=facont_hb(jj,i)
\r
9303 cd ekl=facont_hb(kk,k)
\r
9305 cd write (iout,*)'Contacts have occurred for peptide groups',
\r
9306 cd & i,j,' fcont:',eij,' eij',' and ',k,l
\r
9308 C Contribution from the graph I.
\r
9309 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
\r
9310 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
\r
9311 call transpose2(EUg(1,1,k),auxmat(1,1))
\r
9312 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
\r
9313 vv(1)=pizda(1,1)-pizda(2,2)
\r
9314 vv(2)=pizda(1,2)+pizda(2,1)
\r
9315 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
\r
9316 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
\r
9317 C Explicit gradient in virtual-dihedral angles.
\r
9318 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
\r
9319 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
\r
9320 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
\r
9321 call transpose2(EUgder(1,1,k),auxmat1(1,1))
\r
9322 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
\r
9323 vv(1)=pizda(1,1)-pizda(2,2)
\r
9324 vv(2)=pizda(1,2)+pizda(2,1)
\r
9325 g_corr5_loc(k-1)=g_corr5_loc(k-1)
\r
9326 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
\r
9327 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
\r
9328 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
\r
9329 vv(1)=pizda(1,1)-pizda(2,2)
\r
9330 vv(2)=pizda(1,2)+pizda(2,1)
\r
9331 if (l.eq.j+1) then
\r
9332 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
\r
9333 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
\r
9334 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
\r
9336 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
\r
9337 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
\r
9338 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
\r
9340 C Cartesian gradient
\r
9344 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
\r
9346 vv(1)=pizda(1,1)-pizda(2,2)
\r
9347 vv(2)=pizda(1,2)+pizda(2,1)
\r
9348 derx(lll,kkk,iii)=derx(lll,kkk,iii)
\r
9349 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
\r
9350 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
\r
9356 C Contribution from graph II
\r
9357 call transpose2(EE(1,1,itk),auxmat(1,1))
\r
9358 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
\r
9359 vv(1)=pizda(1,1)+pizda(2,2)
\r
9360 vv(2)=pizda(2,1)-pizda(1,2)
\r
9361 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
\r
9362 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
\r
9363 C Explicit gradient in virtual-dihedral angles.
\r
9364 g_corr5_loc(k-1)=g_corr5_loc(k-1)
\r
9365 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
\r
9366 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
\r
9367 vv(1)=pizda(1,1)+pizda(2,2)
\r
9368 vv(2)=pizda(2,1)-pizda(1,2)
\r
9369 if (l.eq.j+1) then
\r
9370 g_corr5_loc(l-1)=g_corr5_loc(l-1)
\r
9371 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
\r
9372 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
\r
9374 g_corr5_loc(j-1)=g_corr5_loc(j-1)
\r
9375 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
\r
9376 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
\r
9378 C Cartesian gradient
\r
9382 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
\r
9384 vv(1)=pizda(1,1)+pizda(2,2)
\r
9385 vv(2)=pizda(2,1)-pizda(1,2)
\r
9386 derx(lll,kkk,iii)=derx(lll,kkk,iii)
\r
9387 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
\r
9388 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
\r
9394 if (l.eq.j+1) then
\r
9396 C Parallel orientation
\r
9397 C Contribution from graph III
\r
9398 call transpose2(EUg(1,1,l),auxmat(1,1))
\r
9399 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
\r
9400 vv(1)=pizda(1,1)-pizda(2,2)
\r
9401 vv(2)=pizda(1,2)+pizda(2,1)
\r
9402 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
\r
9403 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
\r
9404 C Explicit gradient in virtual-dihedral angles.
\r
9405 g_corr5_loc(j-1)=g_corr5_loc(j-1)
\r
9406 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
\r
9407 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
\r
9408 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
\r
9409 vv(1)=pizda(1,1)-pizda(2,2)
\r
9410 vv(2)=pizda(1,2)+pizda(2,1)
\r
9411 g_corr5_loc(k-1)=g_corr5_loc(k-1)
\r
9412 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
\r
9413 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
\r
9414 call transpose2(EUgder(1,1,l),auxmat1(1,1))
\r
9415 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
\r
9416 vv(1)=pizda(1,1)-pizda(2,2)
\r
9417 vv(2)=pizda(1,2)+pizda(2,1)
\r
9418 g_corr5_loc(l-1)=g_corr5_loc(l-1)
\r
9419 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
\r
9420 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
\r
9421 C Cartesian gradient
\r
9425 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
\r
9427 vv(1)=pizda(1,1)-pizda(2,2)
\r
9428 vv(2)=pizda(1,2)+pizda(2,1)
\r
9429 derx(lll,kkk,iii)=derx(lll,kkk,iii)
\r
9430 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
\r
9431 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
\r
9436 C Contribution from graph IV
\r
9438 call transpose2(EE(1,1,itl),auxmat(1,1))
\r
9439 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
\r
9440 vv(1)=pizda(1,1)+pizda(2,2)
\r
9441 vv(2)=pizda(2,1)-pizda(1,2)
\r
9442 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
\r
9443 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
\r
9444 C Explicit gradient in virtual-dihedral angles.
\r
9445 g_corr5_loc(l-1)=g_corr5_loc(l-1)
\r
9446 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
\r
9447 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
\r
9448 vv(1)=pizda(1,1)+pizda(2,2)
\r
9449 vv(2)=pizda(2,1)-pizda(1,2)
\r
9450 g_corr5_loc(k-1)=g_corr5_loc(k-1)
\r
9451 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
\r
9452 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
\r
9453 C Cartesian gradient
\r
9457 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
\r
9459 vv(1)=pizda(1,1)+pizda(2,2)
\r
9460 vv(2)=pizda(2,1)-pizda(1,2)
\r
9461 derx(lll,kkk,iii)=derx(lll,kkk,iii)
\r
9462 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
\r
9463 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
\r
9468 C Antiparallel orientation
\r
9469 C Contribution from graph III
\r
9471 call transpose2(EUg(1,1,j),auxmat(1,1))
\r
9472 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
\r
9473 vv(1)=pizda(1,1)-pizda(2,2)
\r
9474 vv(2)=pizda(1,2)+pizda(2,1)
\r
9475 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
\r
9476 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
\r
9477 C Explicit gradient in virtual-dihedral angles.
\r
9478 g_corr5_loc(l-1)=g_corr5_loc(l-1)
\r
9479 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
\r
9480 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
\r
9481 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
\r
9482 vv(1)=pizda(1,1)-pizda(2,2)
\r
9483 vv(2)=pizda(1,2)+pizda(2,1)
\r
9484 g_corr5_loc(k-1)=g_corr5_loc(k-1)
\r
9485 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
\r
9486 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
\r
9487 call transpose2(EUgder(1,1,j),auxmat1(1,1))
\r
9488 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
\r
9489 vv(1)=pizda(1,1)-pizda(2,2)
\r
9490 vv(2)=pizda(1,2)+pizda(2,1)
\r
9491 g_corr5_loc(j-1)=g_corr5_loc(j-1)
\r
9492 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
\r
9493 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
\r
9494 C Cartesian gradient
\r
9498 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
\r
9500 vv(1)=pizda(1,1)-pizda(2,2)
\r
9501 vv(2)=pizda(1,2)+pizda(2,1)
\r
9502 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
\r
9503 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
\r
9504 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
\r
9509 C Contribution from graph IV
\r
9511 call transpose2(EE(1,1,itj),auxmat(1,1))
\r
9512 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
\r
9513 vv(1)=pizda(1,1)+pizda(2,2)
\r
9514 vv(2)=pizda(2,1)-pizda(1,2)
\r
9515 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
\r
9516 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
\r
9517 C Explicit gradient in virtual-dihedral angles.
\r
9518 g_corr5_loc(j-1)=g_corr5_loc(j-1)
\r
9519 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
\r
9520 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
\r
9521 vv(1)=pizda(1,1)+pizda(2,2)
\r
9522 vv(2)=pizda(2,1)-pizda(1,2)
\r
9523 g_corr5_loc(k-1)=g_corr5_loc(k-1)
\r
9524 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
\r
9525 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
\r
9526 C Cartesian gradient
\r
9530 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
\r
9532 vv(1)=pizda(1,1)+pizda(2,2)
\r
9533 vv(2)=pizda(2,1)-pizda(1,2)
\r
9534 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
\r
9535 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
\r
9536 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
\r
9542 eel5=eello5_1+eello5_2+eello5_3+eello5_4
\r
9543 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
\r
9544 cd write (2,*) 'ijkl',i,j,k,l
\r
9545 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
\r
9546 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
\r
9548 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
\r
9549 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
\r
9550 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
\r
9551 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
\r
9552 if (j.lt.nres-1) then
\r
9559 if (l.lt.nres-1) then
\r
9569 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
\r
9570 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
\r
9571 C summed up outside the subrouine as for the other subroutines
\r
9572 C handling long-range interactions. The old code is commented out
\r
9573 C with "cgrad" to keep track of changes.
\r
9575 cgrad ggg1(ll)=eel5*g_contij(ll,1)
\r
9576 cgrad ggg2(ll)=eel5*g_contij(ll,2)
\r
9577 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
\r
9578 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
\r
9579 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
\r
9580 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
\r
9581 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
\r
9582 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
\r
9583 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
\r
9584 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
\r
9586 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
\r
9587 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
\r
9588 cgrad ghalf=0.5d0*ggg1(ll)
\r
9590 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
\r
9591 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
\r
9592 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
\r
9593 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
\r
9594 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
\r
9595 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
\r
9596 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
\r
9597 cgrad ghalf=0.5d0*ggg2(ll)
\r
9599 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
\r
9600 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
\r
9601 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
\r
9602 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
\r
9603 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
\r
9604 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
\r
9607 cgrad do m=i+1,j-1
\r
9609 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
\r
9610 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
\r
9613 cgrad do m=k+1,l-1
\r
9615 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
\r
9616 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
\r
9622 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
\r
9627 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
\r
9630 cd do iii=1,nres-3
\r
9631 cd write (2,*) iii,g_corr5_loc(iii)
\r
9634 cd write (2,*) 'ekont',ekont
\r
9635 cd write (iout,*) 'eello5',ekont*eel5
\r
9640 c--------------------------------------------------------------------
\r
9643 double precision function eello6(i,j,k,l,jj,kk)
\r
9644 implicit real*8 (a-h,o-z)
\r
9645 include 'DIMENSIONS'
\r
9646 include 'COMMON.IOUNITS'
\r
9647 include 'COMMON.CHAIN'
\r
9648 include 'COMMON.DERIV'
\r
9649 include 'COMMON.INTERACT'
\r
9650 include 'COMMON.CONTACTS'
\r
9651 include 'COMMON.TORSION'
\r
9652 include 'COMMON.VAR'
\r
9653 include 'COMMON.GEO'
\r
9654 include 'COMMON.FFIELD'
\r
9655 double precision ggg1(3),ggg2(3)
\r
9656 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
\r
9661 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
\r
9669 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
\r
9670 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
\r
9674 derx(lll,kkk,iii)=0.0d0
\r
9678 cd eij=facont_hb(jj,i)
\r
9679 cd ekl=facont_hb(kk,k)
\r
9684 if (l.eq.j+1) then
\r
9685 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
\r
9686 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
\r
9687 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
\r
9688 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
\r
9689 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
\r
9690 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
\r
9692 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
\r
9693 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
\r
9694 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
\r
9695 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
\r
9696 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
\r
9697 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
\r
9701 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
\r
9703 C If turn contributions are considered, they will be handled separately.
\r
9704 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
\r
9705 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
\r
9706 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
\r
9707 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
\r
9708 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
\r
9709 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
\r
9710 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
\r
9712 if (j.lt.nres-1) then
\r
9719 if (l.lt.nres-1) then
\r
9727 cgrad ggg1(ll)=eel6*g_contij(ll,1)
\r
9728 cgrad ggg2(ll)=eel6*g_contij(ll,2)
\r
9729 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
\r
9730 cgrad ghalf=0.5d0*ggg1(ll)
\r
9732 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
\r
9733 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
\r
9734 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
\r
9735 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
\r
9736 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
\r
9737 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
\r
9738 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
\r
9739 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
\r
9740 cgrad ghalf=0.5d0*ggg2(ll)
\r
9741 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
\r
9743 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
\r
9744 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
\r
9745 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
\r
9746 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
\r
9747 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
\r
9748 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
\r
9751 cgrad do m=i+1,j-1
\r
9753 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
\r
9754 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
\r
9757 cgrad do m=k+1,l-1
\r
9759 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
\r
9760 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
\r
9763 cgrad1112 continue
\r
9766 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
\r
9771 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
\r
9774 cd do iii=1,nres-3
\r
9775 cd write (2,*) iii,g_corr6_loc(iii)
\r
9778 cd write (2,*) 'ekont',ekont
\r
9779 cd write (iout,*) 'eello6',ekont*eel6
\r
9784 c--------------------------------------------------------------------
\r
9787 double precision function eello6_graph1(i,j,k,l,imat,swap)
\r
9788 implicit real*8 (a-h,o-z)
\r
9789 include 'DIMENSIONS'
\r
9790 include 'COMMON.IOUNITS'
\r
9791 include 'COMMON.CHAIN'
\r
9792 include 'COMMON.DERIV'
\r
9793 include 'COMMON.INTERACT'
\r
9794 include 'COMMON.CONTACTS'
\r
9795 include 'COMMON.TORSION'
\r
9796 include 'COMMON.VAR'
\r
9797 include 'COMMON.GEO'
\r
9798 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
\r
9801 common /kutas/ lprn
\r
9802 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
\r
9804 C Parallel Antiparallel
\r
9810 C \ j|/k\| / \ |/k\|l /
\r
9811 C \ / \ / \ / \ /
\r
9815 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
\r
9816 itk=itortyp(itype(k))
\r
9817 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
\r
9818 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
\r
9819 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
\r
9820 call transpose2(EUgC(1,1,k),auxmat(1,1))
\r
9821 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
\r
9822 vv1(1)=pizda1(1,1)-pizda1(2,2)
\r
9823 vv1(2)=pizda1(1,2)+pizda1(2,1)
\r
9824 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
\r
9825 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
\r
9826 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
\r
9827 s5=scalar2(vv(1),Dtobr2(1,i))
\r
9828 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
\r
9829 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
\r
9830 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
\r
9831 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
\r
9832 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
\r
9833 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
\r
9834 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
\r
9835 & +scalar2(vv(1),Dtobr2der(1,i)))
\r
9836 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
\r
9837 vv1(1)=pizda1(1,1)-pizda1(2,2)
\r
9838 vv1(2)=pizda1(1,2)+pizda1(2,1)
\r
9839 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
\r
9840 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
\r
9841 if (l.eq.j+1) then
\r
9842 g_corr6_loc(l-1)=g_corr6_loc(l-1)
\r
9843 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
\r
9844 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
\r
9845 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
\r
9846 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
\r
9848 g_corr6_loc(j-1)=g_corr6_loc(j-1)
\r
9849 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
\r
9850 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
\r
9851 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
\r
9852 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
\r
9854 call transpose2(EUgCder(1,1,k),auxmat(1,1))
\r
9855 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
\r
9856 vv1(1)=pizda1(1,1)-pizda1(2,2)
\r
9857 vv1(2)=pizda1(1,2)+pizda1(2,1)
\r
9858 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
\r
9859 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
\r
9860 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
\r
9861 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
\r
9870 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
\r
9871 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
\r
9872 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
\r
9873 call transpose2(EUgC(1,1,k),auxmat(1,1))
\r
9874 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
\r
9876 vv1(1)=pizda1(1,1)-pizda1(2,2)
\r
9877 vv1(2)=pizda1(1,2)+pizda1(2,1)
\r
9878 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
\r
9879 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
\r
9880 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
\r
9881 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
\r
9882 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
\r
9883 s5=scalar2(vv(1),Dtobr2(1,i))
\r
9884 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
\r
9892 c--------------------------------------------------------------------
\r
9895 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
\r
9896 implicit real*8 (a-h,o-z)
\r
9897 include 'DIMENSIONS'
\r
9898 include 'COMMON.IOUNITS'
\r
9899 include 'COMMON.CHAIN'
\r
9900 include 'COMMON.DERIV'
\r
9901 include 'COMMON.INTERACT'
\r
9902 include 'COMMON.CONTACTS'
\r
9903 include 'COMMON.TORSION'
\r
9904 include 'COMMON.VAR'
\r
9905 include 'COMMON.GEO'
\r
9907 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
\r
9908 & auxvec1(2),auxvec2(1),auxmat1(2,2)
\r
9910 common /kutas/ lprn
\r
9911 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
\r
9913 C Parallel Antiparallel
\r
9919 C \ j|/k\| \ |/k\|l
\r
9924 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
\r
9925 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
\r
9926 C AL 7/4/01 s1 would occur in the sixth-order moment,
\r
9927 C but not in a cluster cumulant
\r
9929 s1=dip(1,jj,i)*dip(1,kk,k)
\r
9931 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
\r
9932 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
\r
9933 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
\r
9934 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
\r
9935 call transpose2(EUg(1,1,k),auxmat(1,1))
\r
9936 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
\r
9937 vv(1)=pizda(1,1)-pizda(2,2)
\r
9938 vv(2)=pizda(1,2)+pizda(2,1)
\r
9939 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
\r
9940 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
\r
9942 eello6_graph2=-(s1+s2+s3+s4)
\r
9944 eello6_graph2=-(s2+s3+s4)
\r
9946 c eello6_graph2=-s3
\r
9947 C Derivatives in gamma(i-1)
\r
9950 s1=dipderg(1,jj,i)*dip(1,kk,k)
\r
9952 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
\r
9953 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
\r
9954 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
\r
9955 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
\r
9957 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
\r
9959 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
\r
9961 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
\r
9963 C Derivatives in gamma(k-1)
\r
9965 s1=dip(1,jj,i)*dipderg(1,kk,k)
\r
9967 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
\r
9968 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
\r
9969 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
\r
9970 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
\r
9971 call transpose2(EUgder(1,1,k),auxmat1(1,1))
\r
9972 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
\r
9973 vv(1)=pizda(1,1)-pizda(2,2)
\r
9974 vv(2)=pizda(1,2)+pizda(2,1)
\r
9975 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
\r
9977 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
\r
9979 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
\r
9981 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
\r
9982 C Derivatives in gamma(j-1) or gamma(l-1)
\r
9985 s1=dipderg(3,jj,i)*dip(1,kk,k)
\r
9987 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
\r
9988 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
\r
9989 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
\r
9990 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
\r
9991 vv(1)=pizda(1,1)-pizda(2,2)
\r
9992 vv(2)=pizda(1,2)+pizda(2,1)
\r
9993 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
\r
9996 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
\r
9998 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
\r
10001 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
\r
10002 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
\r
10004 C Derivatives in gamma(l-1) or gamma(j-1)
\r
10005 if (l.gt.1) then
\r
10007 s1=dip(1,jj,i)*dipderg(3,kk,k)
\r
10009 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
\r
10010 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
\r
10011 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
\r
10012 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
\r
10013 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
\r
10014 vv(1)=pizda(1,1)-pizda(2,2)
\r
10015 vv(2)=pizda(1,2)+pizda(2,1)
\r
10016 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
\r
10019 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
\r
10021 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
\r
10024 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
\r
10025 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
\r
10027 C Cartesian derivatives.
\r
10029 write (2,*) 'In eello6_graph2'
\r
10031 write (2,*) 'iii=',iii
\r
10033 write (2,*) 'kkk=',kkk
\r
10035 write (2,'(3(2f10.5),5x)')
\r
10036 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
\r
10045 if (iii.eq.1) then
\r
10046 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
\r
10048 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
\r
10051 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
\r
10053 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
\r
10054 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
\r
10056 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
\r
10057 call transpose2(EUg(1,1,k),auxmat(1,1))
\r
10058 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
\r
10060 vv(1)=pizda(1,1)-pizda(2,2)
\r
10061 vv(2)=pizda(1,2)+pizda(2,1)
\r
10062 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
\r
10063 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
\r
10065 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
\r
10067 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
\r
10070 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
\r
10072 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
\r
10081 c--------------------------------------------------------------------
\r
10084 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
\r
10085 implicit real*8 (a-h,o-z)
\r
10086 include 'DIMENSIONS'
\r
10087 include 'COMMON.IOUNITS'
\r
10088 include 'COMMON.CHAIN'
\r
10089 include 'COMMON.DERIV'
\r
10090 include 'COMMON.INTERACT'
\r
10091 include 'COMMON.CONTACTS'
\r
10092 include 'COMMON.TORSION'
\r
10093 include 'COMMON.VAR'
\r
10094 include 'COMMON.GEO'
\r
10095 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
\r
10097 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
\r
10099 C Parallel Antiparallel
\r
10104 C /| o |o o| o |\
\r
10105 C j|/k\| / |/k\|l /
\r
10110 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
\r
10112 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
\r
10113 C energy moment and not to the cluster cumulant.
\r
10114 iti=itortyp(itype(i))
\r
10115 if (j.lt.nres-1) then
\r
10116 itj1=itortyp(itype(j+1))
\r
10120 itk=itortyp(itype(k))
\r
10121 itk1=itortyp(itype(k+1))
\r
10122 if (l.lt.nres-1) then
\r
10123 itl1=itortyp(itype(l+1))
\r
10128 s1=dip(4,jj,i)*dip(4,kk,k)
\r
10130 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
\r
10131 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
\r
10132 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
\r
10133 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
\r
10134 call transpose2(EE(1,1,itk),auxmat(1,1))
\r
10135 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
\r
10136 vv(1)=pizda(1,1)+pizda(2,2)
\r
10137 vv(2)=pizda(2,1)-pizda(1,2)
\r
10138 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
\r
10139 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
\r
10140 cd & "sum",-(s2+s3+s4)
\r
10142 eello6_graph3=-(s1+s2+s3+s4)
\r
10144 eello6_graph3=-(s2+s3+s4)
\r
10146 c eello6_graph3=-s4
\r
10147 C Derivatives in gamma(k-1)
\r
10148 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
\r
10149 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
\r
10150 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
\r
10151 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
\r
10152 C Derivatives in gamma(l-1)
\r
10153 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
\r
10154 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
\r
10155 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
\r
10156 vv(1)=pizda(1,1)+pizda(2,2)
\r
10157 vv(2)=pizda(2,1)-pizda(1,2)
\r
10158 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
\r
10159 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
\r
10160 C Cartesian derivatives.
\r
10165 if (iii.eq.1) then
\r
10166 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
\r
10168 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
\r
10171 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
\r
10173 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
\r
10174 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
\r
10176 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
\r
10177 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
\r
10179 vv(1)=pizda(1,1)+pizda(2,2)
\r
10180 vv(2)=pizda(2,1)-pizda(1,2)
\r
10181 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
\r
10183 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
\r
10185 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
\r
10188 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
\r
10190 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
\r
10192 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
\r
10200 c--------------------------------------------------------------------
\r
10203 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
\r
10204 implicit real*8 (a-h,o-z)
\r
10205 include 'DIMENSIONS'
\r
10206 include 'COMMON.IOUNITS'
\r
10207 include 'COMMON.CHAIN'
\r
10208 include 'COMMON.DERIV'
\r
10209 include 'COMMON.INTERACT'
\r
10210 include 'COMMON.CONTACTS'
\r
10211 include 'COMMON.TORSION'
\r
10212 include 'COMMON.VAR'
\r
10213 include 'COMMON.GEO'
\r
10214 include 'COMMON.FFIELD'
\r
10215 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
\r
10216 & auxvec1(2),auxmat1(2,2)
\r
10218 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
\r
10220 C Parallel Antiparallel
\r
10225 C /| o |o o| o |\
\r
10226 C \ j|/k\| \ |/k\|l
\r
10231 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
\r
10233 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
\r
10234 C energy moment and not to the cluster cumulant.
\r
10235 cd write (2,*) 'eello_graph4: wturn6',wturn6
\r
10236 iti=itortyp(itype(i))
\r
10237 itj=itortyp(itype(j))
\r
10238 if (j.lt.nres-1) then
\r
10239 itj1=itortyp(itype(j+1))
\r
10243 itk=itortyp(itype(k))
\r
10244 if (k.lt.nres-1) then
\r
10245 itk1=itortyp(itype(k+1))
\r
10249 itl=itortyp(itype(l))
\r
10250 if (l.lt.nres-1) then
\r
10251 itl1=itortyp(itype(l+1))
\r
10255 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
\r
10256 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
\r
10257 cd & ' itl',itl,' itl1',itl1
\r
10259 if (imat.eq.1) then
\r
10260 s1=dip(3,jj,i)*dip(3,kk,k)
\r
10262 s1=dip(2,jj,j)*dip(2,kk,l)
\r
10265 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
\r
10266 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
\r
10267 if (j.eq.l+1) then
\r
10268 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
\r
10269 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
\r
10271 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
\r
10272 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
\r
10274 call transpose2(EUg(1,1,k),auxmat(1,1))
\r
10275 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
\r
10276 vv(1)=pizda(1,1)-pizda(2,2)
\r
10277 vv(2)=pizda(2,1)+pizda(1,2)
\r
10278 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
\r
10279 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
\r
10281 eello6_graph4=-(s1+s2+s3+s4)
\r
10283 eello6_graph4=-(s2+s3+s4)
\r
10285 C Derivatives in gamma(i-1)
\r
10288 if (imat.eq.1) then
\r
10289 s1=dipderg(2,jj,i)*dip(3,kk,k)
\r
10291 s1=dipderg(4,jj,j)*dip(2,kk,l)
\r
10294 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
\r
10295 if (j.eq.l+1) then
\r
10296 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
\r
10297 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
\r
10299 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
\r
10300 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
\r
10302 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
\r
10303 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
\r
10304 cd write (2,*) 'turn6 derivatives'
\r
10306 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
\r
10308 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
\r
10312 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
\r
10314 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
\r
10318 C Derivatives in gamma(k-1)
\r
10320 if (imat.eq.1) then
\r
10321 s1=dip(3,jj,i)*dipderg(2,kk,k)
\r
10323 s1=dip(2,jj,j)*dipderg(4,kk,l)
\r
10326 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
\r
10327 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
\r
10328 if (j.eq.l+1) then
\r
10329 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
\r
10330 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
\r
10332 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
\r
10333 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
\r
10335 call transpose2(EUgder(1,1,k),auxmat1(1,1))
\r
10336 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
\r
10337 vv(1)=pizda(1,1)-pizda(2,2)
\r
10338 vv(2)=pizda(2,1)+pizda(1,2)
\r
10339 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
\r
10340 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
\r
10342 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
\r
10344 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
\r
10348 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
\r
10350 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
\r
10353 C Derivatives in gamma(j-1) or gamma(l-1)
\r
10354 if (l.eq.j+1 .and. l.gt.1) then
\r
10355 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
\r
10356 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
\r
10357 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
\r
10358 vv(1)=pizda(1,1)-pizda(2,2)
\r
10359 vv(2)=pizda(2,1)+pizda(1,2)
\r
10360 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
\r
10361 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
\r
10362 else if (j.gt.1) then
\r
10363 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
\r
10364 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
\r
10365 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
\r
10366 vv(1)=pizda(1,1)-pizda(2,2)
\r
10367 vv(2)=pizda(2,1)+pizda(1,2)
\r
10368 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
\r
10369 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
\r
10370 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
\r
10372 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
\r
10375 C Cartesian derivatives.
\r
10380 if (iii.eq.1) then
\r
10381 if (imat.eq.1) then
\r
10382 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
\r
10384 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
\r
10387 if (imat.eq.1) then
\r
10388 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
\r
10390 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
\r
10394 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
\r
10396 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
\r
10397 if (j.eq.l+1) then
\r
10398 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
\r
10399 & b1(1,itj1),auxvec(1))
\r
10400 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
\r
10402 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
\r
10403 & b1(1,itl1),auxvec(1))
\r
10404 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
\r
10406 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
\r
10408 vv(1)=pizda(1,1)-pizda(2,2)
\r
10409 vv(2)=pizda(2,1)+pizda(1,2)
\r
10410 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
\r
10412 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
\r
10414 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
\r
10417 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
\r
10420 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
\r
10423 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
\r
10425 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
\r
10427 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
\r
10431 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
\r
10433 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
\r
10435 if (l.eq.j+1) then
\r
10436 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
\r
10438 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
\r
10448 c--------------------------------------------------------------------
\r
10451 double precision function eello_turn6(i,jj,kk)
\r
10452 implicit real*8 (a-h,o-z)
\r
10453 include 'DIMENSIONS'
\r
10454 include 'COMMON.IOUNITS'
\r
10455 include 'COMMON.CHAIN'
\r
10456 include 'COMMON.DERIV'
\r
10457 include 'COMMON.INTERACT'
\r
10458 include 'COMMON.CONTACTS'
\r
10459 include 'COMMON.TORSION'
\r
10460 include 'COMMON.VAR'
\r
10461 include 'COMMON.GEO'
\r
10462 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
\r
10463 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
\r
10464 & ggg1(3),ggg2(3)
\r
10465 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
\r
10466 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
\r
10467 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
\r
10468 C the respective energy moment and not to the cluster cumulant.
\r
10473 eello_turn6=0.0d0
\r
10477 iti=itortyp(itype(i))
\r
10478 itk=itortyp(itype(k))
\r
10479 itk1=itortyp(itype(k+1))
\r
10480 itl=itortyp(itype(l))
\r
10481 itj=itortyp(itype(j))
\r
10482 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
\r
10483 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
\r
10484 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
\r
10488 cd write (iout,*)
\r
10489 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
\r
10491 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
\r
10495 derx_turn(lll,kkk,iii)=0.0d0
\r
10502 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
\r
10503 cd eello6_5=0.0d0
\r
10504 cd write (2,*) 'eello6_5',eello6_5
\r
10506 call transpose2(AEA(1,1,1),auxmat(1,1))
\r
10507 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
\r
10508 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
\r
10509 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
\r
10511 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
\r
10512 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
\r
10513 s2 = scalar2(b1(1,itk),vtemp1(1))
\r
10515 call transpose2(AEA(1,1,2),atemp(1,1))
\r
10516 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
\r
10517 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
\r
10518 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
\r
10520 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
\r
10521 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
\r
10522 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
\r
10524 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
\r
10525 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
\r
10526 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
\r
10527 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
\r
10528 ss13 = scalar2(b1(1,itk),vtemp4(1))
\r
10529 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
\r
10531 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
\r
10537 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
\r
10538 C Derivatives in gamma(i+2)
\r
10542 call transpose2(AEA(1,1,1),auxmatd(1,1))
\r
10543 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
\r
10544 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
\r
10545 call transpose2(AEAderg(1,1,2),atempd(1,1))
\r
10546 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
\r
10547 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
\r
10549 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
\r
10550 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
\r
10551 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
\r
10557 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
\r
10558 C Derivatives in gamma(i+3)
\r
10560 call transpose2(AEA(1,1,1),auxmatd(1,1))
\r
10561 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
\r
10562 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
\r
10563 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
\r
10565 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
\r
10566 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
\r
10567 s2d = scalar2(b1(1,itk),vtemp1d(1))
\r
10569 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
\r
10570 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
\r
10572 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
\r
10574 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
\r
10575 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
\r
10576 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
\r
10584 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
\r
10585 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
\r
10587 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
\r
10588 & -0.5d0*ekont*(s2d+s12d)
\r
10590 C Derivatives in gamma(i+4)
\r
10591 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
\r
10592 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
\r
10593 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
\r
10595 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
\r
10596 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
\r
10597 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
\r
10605 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
\r
10607 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
\r
10609 C Derivatives in gamma(i+5)
\r
10611 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
\r
10612 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
\r
10613 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
\r
10615 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
\r
10616 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
\r
10617 s2d = scalar2(b1(1,itk),vtemp1d(1))
\r
10619 call transpose2(AEA(1,1,2),atempd(1,1))
\r
10620 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
\r
10621 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
\r
10623 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
\r
10624 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
\r
10626 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
\r
10627 ss13d = scalar2(b1(1,itk),vtemp4d(1))
\r
10628 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
\r
10636 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
\r
10637 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
\r
10639 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
\r
10640 & -0.5d0*ekont*(s2d+s12d)
\r
10642 C Cartesian derivatives
\r
10647 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
\r
10648 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
\r
10649 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
\r
10651 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
\r
10652 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
\r
10654 s2d = scalar2(b1(1,itk),vtemp1d(1))
\r
10656 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
\r
10657 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
\r
10658 s8d = -(atempd(1,1)+atempd(2,2))*
\r
10659 & scalar2(cc(1,1,itl),vtemp2(1))
\r
10661 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
\r
10663 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
\r
10664 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
\r
10671 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
\r
10672 & - 0.5d0*(s1d+s2d)
\r
10674 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
\r
10678 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
\r
10679 & - 0.5d0*(s8d+s12d)
\r
10681 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
\r
10690 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
\r
10691 & achuj_tempd(1,1))
\r
10692 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
\r
10693 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
\r
10694 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
\r
10695 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
\r
10696 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
\r
10698 ss13d = scalar2(b1(1,itk),vtemp4d(1))
\r
10699 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
\r
10700 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
\r
10704 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
\r
10705 cd & 16*eel_turn6_num
\r
10707 if (j.lt.nres-1) then
\r
10714 if (l.lt.nres-1) then
\r
10722 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
\r
10723 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
\r
10724 cgrad ghalf=0.5d0*ggg1(ll)
\r
10726 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
\r
10727 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
\r
10728 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
\r
10729 & +ekont*derx_turn(ll,2,1)
\r
10730 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
\r
10731 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
\r
10732 & +ekont*derx_turn(ll,4,1)
\r
10733 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
\r
10734 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
\r
10735 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
\r
10736 cgrad ghalf=0.5d0*ggg2(ll)
\r
10738 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
\r
10739 & +ekont*derx_turn(ll,2,2)
\r
10740 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
\r
10741 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
\r
10742 & +ekont*derx_turn(ll,4,2)
\r
10743 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
\r
10744 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
\r
10745 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
\r
10748 cgrad do m=i+1,j-1
\r
10750 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
\r
10753 cgrad do m=k+1,l-1
\r
10755 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
\r
10758 cgrad1112 continue
\r
10759 cgrad do m=i+2,j2
\r
10761 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
\r
10764 cgrad do m=k+2,l2
\r
10766 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
\r
10769 cd do iii=1,nres-3
\r
10770 cd write (2,*) iii,g_corr6_loc(iii)
\r
10772 eello_turn6=ekont*eel_turn6
\r
10773 cd write (2,*) 'ekont',ekont
\r
10774 cd write (2,*) 'eel_turn6',ekont*eel_turn6
\r
10779 C--------------------------------------------------------------------
\r
10782 double precision function scalar(u,v)
\r
10783 !DIR$ INLINEALWAYS scalar
\r
10785 cDEC$ ATTRIBUTES FORCEINLINE::scalar
\r
10788 double precision u(3),v(3)
\r
10789 cd double precision sc
\r
10793 cd sc=sc+u(i)*v(i)
\r
10797 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
\r
10802 crc-----------------------------------------------------------------
\r
10805 SUBROUTINE MATVEC2(A1,V1,V2)
\r
10806 !DIR$ INLINEALWAYS MATVEC2
\r
10808 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
\r
10810 implicit real*8 (a-h,o-z)
\r
10811 include 'DIMENSIONS'
\r
10812 DIMENSION A1(2,2),V1(2),V2(2)
\r
10816 c 3 VI=VI+A1(I,K)*V1(K)
\r
10820 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
\r
10821 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
\r
10828 C--------------------------------------------------------------------
\r
10831 SUBROUTINE MATMAT2(A1,A2,A3)
\r
10833 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
\r
10835 implicit real*8 (a-h,o-z)
\r
10836 include 'DIMENSIONS'
\r
10837 DIMENSION A1(2,2),A2(2,2),A3(2,2)
\r
10838 c DIMENSION AI3(2,2)
\r
10842 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
\r
10848 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
\r
10849 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
\r
10850 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
\r
10851 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
\r
10860 c--------------------------------------------------------------------
\r
10863 double precision function scalar2(u,v)
\r
10864 !DIR$ INLINEALWAYS scalar2
\r
10866 double precision u(2),v(2)
\r
10867 double precision sc
\r
10869 scalar2=u(1)*v(1)+u(2)*v(2)
\r
10874 C--------------------------------------------------------------------
\r
10877 subroutine transpose2(a,at)
\r
10878 !DIR$ INLINEALWAYS transpose2
\r
10880 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
\r
10883 double precision a(2,2),at(2,2)
\r
10892 c--------------------------------------------------------------------
\r
10895 subroutine transpose(n,a,at)
\r
10898 double precision a(n,n),at(n,n)
\r
10908 C--------------------------------------------------------------------
\r
10911 subroutine prodmat3(a1,a2,kk,transp,prod)
\r
10912 !DIR$ INLINEALWAYS prodmat3
\r
10914 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
\r
10918 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
\r
10920 crc double precision auxmat(2,2),prod_(2,2)
\r
10923 crc call transpose2(kk(1,1),auxmat(1,1))
\r
10924 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
\r
10925 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
\r
10927 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
\r
10928 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
\r
10929 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
\r
10930 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
\r
10931 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
\r
10932 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
\r
10933 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
\r
10934 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
\r
10937 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
\r
10938 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
\r
10940 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
\r
10941 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
\r
10942 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
\r
10943 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
\r
10944 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
\r
10945 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
\r
10946 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
\r
10947 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
\r
10950 c call transpose2(a2(1,1),a2t(1,1))
\r
10952 crc print *,transp
\r
10953 crc print *,((prod_(i,j),i=1,2),j=1,2)
\r
10954 crc print *,((prod(i,j),i=1,2),j=1,2)
\r