1 subroutine etotal(energia)
2 implicit real*8 (a-h,o-z)
7 cMS$ATTRIBUTES C :: proc_proc
12 double precision weights_(n_ene)
14 include 'COMMON.SETUP'
15 include 'COMMON.IOUNITS'
16 double precision energia(0:n_ene)
17 include 'COMMON.LOCAL'
18 include 'COMMON.FFIELD'
19 include 'COMMON.DERIV'
20 include 'COMMON.INTERACT'
21 include 'COMMON.SBRIDGE'
22 include 'COMMON.CHAIN'
25 include 'COMMON.CONTROL'
26 include 'COMMON.TIME1'
28 c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
29 c & " nfgtasks",nfgtasks
30 if (nfgtasks.gt.1) then
32 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
33 if (fg_rank.eq.0) then
34 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
35 c print *,"Processor",myrank," BROADCAST iorder"
36 C FG master sets up the WEIGHTS_ array which will be broadcast to the
37 C FG slaves as WEIGHTS array.
57 C FG Master broadcasts the WEIGHTS_ array
58 call MPI_Bcast(weights_(1),n_ene,
59 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
61 C FG slaves receive the WEIGHTS array
62 call MPI_Bcast(weights(1),n_ene,
63 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
84 time_Bcast=time_Bcast+MPI_Wtime()-time00
85 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
86 c call chainbuild_cart
88 c print *,'Processor',myrank,' calling etotal ipot=',ipot
89 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
91 c if (modecalc.eq.12.or.modecalc.eq.14) then
92 c call int_from_cart1(.false.)
99 C Compute the side-chain and electrostatic interaction energy
101 goto (101,102,103,104,105,106) ipot
102 C Lennard-Jones potential.
104 cd print '(a)','Exit ELJ'
106 C Lennard-Jones-Kihara potential (shifted).
109 C Berne-Pechukas potential (dilated LJ, angular dependence).
112 C Gay-Berne potential (shifted LJ, angular dependence).
115 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
118 C Soft-sphere potential
119 106 call e_softsphere(evdw)
121 C Calculate electrostatic (H-bonding) energy of the main chain.
124 c print *,"Processor",myrank," computed USCSC"
130 time_vec=time_vec+MPI_Wtime()-time01
132 c print *,"Processor",myrank," left VEC_AND_DERIV"
135 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
136 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
137 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
138 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
140 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
141 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
142 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
143 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
145 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
154 c write (iout,*) "Soft-spheer ELEC potential"
155 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
158 c print *,"Processor",myrank," computed UELEC"
160 C Calculate excluded-volume interaction energy between peptide groups
165 call escp(evdw2,evdw2_14)
171 c write (iout,*) "Soft-sphere SCP potential"
172 call escp_soft_sphere(evdw2,evdw2_14)
175 c Calculate the bond-stretching energy
179 C Calculate the disulfide-bridge and other energy and the contributions
180 C from other distance constraints.
181 cd print *,'Calling EHPB'
183 cd print *,'EHPB exitted succesfully.'
185 C Calculate the virtual-bond-angle energy.
187 if (wang.gt.0d0) then
192 c print *,"Processor",myrank," computed UB"
194 C Calculate the SC local energy.
197 c print *,"Processor",myrank," computed USC"
199 C Calculate the virtual-bond torsional energy.
201 cd print *,'nterm=',nterm
203 call etor(etors,edihcnstr)
208 c print *,"Processor",myrank," computed Utor"
210 C 6/23/01 Calculate double-torsional energy
212 if (wtor_d.gt.0) then
217 c print *,"Processor",myrank," computed Utord"
219 C 21/5/07 Calculate local sicdechain correlation energy
221 if (wsccor.gt.0.0d0) then
222 call eback_sc_corr(esccor)
226 c print *,"Processor",myrank," computed Usccorr"
228 C 12/1/95 Multi-body terms
232 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
233 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
234 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
235 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
236 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
243 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
244 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
245 cd write (iout,*) "multibody_hb ecorr",ecorr
247 c print *,"Processor",myrank," computed Ucorr"
249 C If performing constraint dynamics, call the constraint energy
250 C after the equilibration time
251 if(usampl.and.totT.gt.eq_time) then
259 time_enecalc=time_enecalc+MPI_Wtime()-time00
261 c print *,"Processor",myrank," computed Uconstr"
270 energia(2)=evdw2-evdw2_14
287 energia(8)=eello_turn3
288 energia(9)=eello_turn4
295 energia(19)=edihcnstr
297 energia(20)=Uconst+Uconst_back
299 c print *," Processor",myrank," calls SUM_ENERGY"
300 call sum_energy(energia,.true.)
301 c print *," Processor",myrank," left SUM_ENERGY"
303 time_sumene=time_sumene+MPI_Wtime()-time00
307 c-------------------------------------------------------------------------------
308 subroutine sum_energy(energia,reduce)
309 implicit real*8 (a-h,o-z)
314 cMS$ATTRIBUTES C :: proc_proc
320 include 'COMMON.SETUP'
321 include 'COMMON.IOUNITS'
322 double precision energia(0:n_ene),enebuff(0:n_ene+1)
323 include 'COMMON.FFIELD'
324 include 'COMMON.DERIV'
325 include 'COMMON.INTERACT'
326 include 'COMMON.SBRIDGE'
327 include 'COMMON.CHAIN'
329 include 'COMMON.CONTROL'
330 include 'COMMON.TIME1'
333 if (nfgtasks.gt.1 .and. reduce) then
335 write (iout,*) "energies before REDUCE"
336 call enerprint(energia)
340 enebuff(i)=energia(i)
343 call MPI_Barrier(FG_COMM,IERR)
344 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
346 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
347 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
349 write (iout,*) "energies after REDUCE"
350 call enerprint(energia)
353 time_Reduce=time_Reduce+MPI_Wtime()-time00
355 if (fg_rank.eq.0) then
359 evdw2=energia(2)+energia(18)
375 eello_turn3=energia(8)
376 eello_turn4=energia(9)
383 edihcnstr=energia(19)
388 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
389 & +wang*ebe+wtor*etors+wscloc*escloc
390 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
391 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
392 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
393 & +wbond*estr+Uconst+wsccor*esccor
395 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
396 & +wang*ebe+wtor*etors+wscloc*escloc
397 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
398 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
399 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
400 & +wbond*estr+Uconst+wsccor*esccor
406 if (isnan(etot).ne.0) energia(0)=1.0d+99
408 if (isnan(etot)) energia(0)=1.0d+99
413 idumm=proc_proc(etot,i)
415 call proc_proc(etot,i)
417 if(i.eq.1)energia(0)=1.0d+99
424 c-------------------------------------------------------------------------------
425 subroutine sum_gradient
426 implicit real*8 (a-h,o-z)
431 cMS$ATTRIBUTES C :: proc_proc
436 double precision gradbufc(3,maxres),gradbufx(3,maxres),
437 & glocbuf(4*maxres),gradbufc_sum(3,maxres)
439 include 'COMMON.SETUP'
440 include 'COMMON.IOUNITS'
441 include 'COMMON.FFIELD'
442 include 'COMMON.DERIV'
443 include 'COMMON.INTERACT'
444 include 'COMMON.SBRIDGE'
445 include 'COMMON.CHAIN'
447 include 'COMMON.CONTROL'
448 include 'COMMON.TIME1'
449 include 'COMMON.MAXGRAD'
454 write (iout,*) "sum_gradient gvdwc, gvdwx"
456 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
457 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
462 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
463 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
464 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
467 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
468 C in virtual-bond-vector coordinates
471 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
473 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
474 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
476 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
478 c write (iout,'(i5,3f10.5,2x,f10.5)')
479 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
481 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
483 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
484 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
492 gradbufc(j,i)=wsc*gvdwc(j,i)+
493 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
494 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
495 & wel_loc*gel_loc_long(j,i)+
496 & wcorr*gradcorr_long(j,i)+
497 & wcorr5*gradcorr5_long(j,i)+
498 & wcorr6*gradcorr6_long(j,i)+
499 & wturn6*gcorr6_turn_long(j,i)+
506 gradbufc(j,i)=wsc*gvdwc(j,i)+
507 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
508 & welec*gelc_long(j,i)+
510 & wel_loc*gel_loc_long(j,i)+
511 & wcorr*gradcorr_long(j,i)+
512 & wcorr5*gradcorr5_long(j,i)+
513 & wcorr6*gradcorr6_long(j,i)+
514 & wturn6*gcorr6_turn_long(j,i)+
520 if (nfgtasks.gt.1) then
523 write (iout,*) "gradbufc before allreduce"
525 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
531 gradbufc_sum(j,i)=gradbufc(j,i)
534 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
535 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
536 c time_reduce=time_reduce+MPI_Wtime()-time00
538 c write (iout,*) "gradbufc_sum after allreduce"
540 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
545 c time_allreduce=time_allreduce+MPI_Wtime()-time00
553 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
554 write (iout,*) (i," jgrad_start",jgrad_start(i),
555 & " jgrad_end ",jgrad_end(i),
556 & i=igrad_start,igrad_end)
559 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
560 c do not parallelize this part.
562 c do i=igrad_start,igrad_end
563 c do j=jgrad_start(i),jgrad_end(i)
565 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
570 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
574 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
578 write (iout,*) "gradbufc after summing"
580 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
587 write (iout,*) "gradbufc"
589 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
595 gradbufc_sum(j,i)=gradbufc(j,i)
600 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
604 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
609 c gradbufc(k,i)=0.0d0
613 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
618 write (iout,*) "gradbufc after summing"
620 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
628 gradbufc(k,nres)=0.0d0
633 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
634 & wel_loc*gel_loc(j,i)+
635 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
636 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
637 & wel_loc*gel_loc_long(j,i)+
638 & wcorr*gradcorr_long(j,i)+
639 & wcorr5*gradcorr5_long(j,i)+
640 & wcorr6*gradcorr6_long(j,i)+
641 & wturn6*gcorr6_turn_long(j,i))+
643 & wcorr*gradcorr(j,i)+
644 & wturn3*gcorr3_turn(j,i)+
645 & wturn4*gcorr4_turn(j,i)+
646 & wcorr5*gradcorr5(j,i)+
647 & wcorr6*gradcorr6(j,i)+
648 & wturn6*gcorr6_turn(j,i)+
649 & wsccor*gsccorc(j,i)
650 & +wscloc*gscloc(j,i)
652 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
653 & wel_loc*gel_loc(j,i)+
654 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
655 & welec*gelc_long(j,i)
656 & wel_loc*gel_loc_long(j,i)+
657 & wcorr*gcorr_long(j,i)+
658 & wcorr5*gradcorr5_long(j,i)+
659 & wcorr6*gradcorr6_long(j,i)+
660 & wturn6*gcorr6_turn_long(j,i))+
662 & wcorr*gradcorr(j,i)+
663 & wturn3*gcorr3_turn(j,i)+
664 & wturn4*gcorr4_turn(j,i)+
665 & wcorr5*gradcorr5(j,i)+
666 & wcorr6*gradcorr6(j,i)+
667 & wturn6*gcorr6_turn(j,i)+
668 & wsccor*gsccorc(j,i)
669 & +wscloc*gscloc(j,i)
671 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
673 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
674 & wsccor*gsccorx(j,i)
675 & +wscloc*gsclocx(j,i)
679 write (iout,*) "gloc before adding corr"
681 write (iout,*) i,gloc(i,icg)
685 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
686 & +wcorr5*g_corr5_loc(i)
687 & +wcorr6*g_corr6_loc(i)
688 & +wturn4*gel_loc_turn4(i)
689 & +wturn3*gel_loc_turn3(i)
690 & +wturn6*gel_loc_turn6(i)
691 & +wel_loc*gel_loc_loc(i)
692 & +wsccor*gsccor_loc(i)
695 write (iout,*) "gloc after adding corr"
697 write (iout,*) i,gloc(i,icg)
701 if (nfgtasks.gt.1) then
704 gradbufc(j,i)=gradc(j,i,icg)
705 gradbufx(j,i)=gradx(j,i,icg)
709 glocbuf(i)=gloc(i,icg)
712 call MPI_Barrier(FG_COMM,IERR)
713 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
715 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
716 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
717 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
718 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
719 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
720 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
721 time_reduce=time_reduce+MPI_Wtime()-time00
723 write (iout,*) "gloc after reduce"
725 write (iout,*) i,gloc(i,icg)
730 if (gnorm_check) then
732 c Compute the maximum elements of the gradient
742 gcorr3_turn_max=0.0d0
743 gcorr4_turn_max=0.0d0
746 gcorr6_turn_max=0.0d0
756 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
757 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
758 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
759 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
760 & gvdwc_scp_max=gvdwc_scp_norm
761 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
762 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
763 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
764 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
765 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
766 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
767 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
768 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
769 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
770 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
771 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
772 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
773 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
775 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
776 & gcorr3_turn_max=gcorr3_turn_norm
777 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
779 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
780 & gcorr4_turn_max=gcorr4_turn_norm
781 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
782 if (gradcorr5_norm.gt.gradcorr5_max)
783 & gradcorr5_max=gradcorr5_norm
784 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
785 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
786 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
788 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
789 & gcorr6_turn_max=gcorr6_turn_norm
790 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
791 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
792 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
793 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
794 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
795 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
796 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
797 if (gradx_scp_norm.gt.gradx_scp_max)
798 & gradx_scp_max=gradx_scp_norm
799 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
800 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
801 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
802 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
803 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
804 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
805 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
806 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
810 open(istat,file=statname,position="append")
812 open(istat,file=statname,access="append")
814 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
815 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
816 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
817 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
818 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
819 & gsccorx_max,gsclocx_max
821 if (gvdwc_max.gt.1.0d4) then
822 write (iout,*) "gvdwc gvdwx gradb gradbx"
824 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
825 & gradb(j,i),gradbx(j,i),j=1,3)
827 call pdbout(0.0d0,'cipiszcze',iout)
833 write (iout,*) "gradc gradx gloc"
835 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
836 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
840 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
844 c-------------------------------------------------------------------------------
845 subroutine rescale_weights(t_bath)
846 implicit real*8 (a-h,o-z)
848 include 'COMMON.IOUNITS'
849 include 'COMMON.FFIELD'
850 include 'COMMON.SBRIDGE'
851 double precision kfac /2.4d0/
852 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
854 c facT=2*temp0/(t_bath+temp0)
855 if (rescale_mode.eq.0) then
861 else if (rescale_mode.eq.1) then
862 facT=kfac/(kfac-1.0d0+t_bath/temp0)
863 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
864 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
865 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
866 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
867 else if (rescale_mode.eq.2) then
873 facT=licznik/dlog(dexp(x)+dexp(-x))
874 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
875 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
876 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
877 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
879 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
880 write (*,*) "Wrong RESCALE_MODE",rescale_mode
882 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
886 welec=weights(3)*fact
887 wcorr=weights(4)*fact3
888 wcorr5=weights(5)*fact4
889 wcorr6=weights(6)*fact5
890 wel_loc=weights(7)*fact2
891 wturn3=weights(8)*fact2
892 wturn4=weights(9)*fact3
893 wturn6=weights(10)*fact5
894 wtor=weights(13)*fact
895 wtor_d=weights(14)*fact2
896 wsccor=weights(21)*fact
900 C------------------------------------------------------------------------
901 subroutine enerprint(energia)
902 implicit real*8 (a-h,o-z)
904 include 'COMMON.IOUNITS'
905 include 'COMMON.FFIELD'
906 include 'COMMON.SBRIDGE'
908 double precision energia(0:n_ene)
913 evdw2=energia(2)+energia(18)
925 eello_turn3=energia(8)
926 eello_turn4=energia(9)
927 eello_turn6=energia(10)
933 edihcnstr=energia(19)
938 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
939 & estr,wbond,ebe,wang,
940 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
942 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
943 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
946 10 format (/'Virtual-chain energies:'//
947 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
948 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
949 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
950 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
951 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
952 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
953 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
954 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
955 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
956 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
957 & ' (SS bridges & dist. cnstr.)'/
958 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
959 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
960 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
961 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
962 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
963 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
964 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
965 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
966 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
967 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
968 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
969 & 'ETOT= ',1pE16.6,' (total)')
971 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
972 & estr,wbond,ebe,wang,
973 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
975 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
976 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
977 & ebr*nss,Uconst,etot
978 10 format (/'Virtual-chain energies:'//
979 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
980 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
981 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
982 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
983 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
984 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
985 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
986 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
987 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
988 & ' (SS bridges & dist. cnstr.)'/
989 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
990 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
991 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
992 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
993 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
994 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
995 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
996 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
997 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
998 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
999 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1000 & 'ETOT= ',1pE16.6,' (total)')
1004 C-----------------------------------------------------------------------
1005 subroutine elj(evdw)
1007 C This subroutine calculates the interaction energy of nonbonded side chains
1008 C assuming the LJ potential of interaction.
1010 implicit real*8 (a-h,o-z)
1011 include 'DIMENSIONS'
1012 parameter (accur=1.0d-10)
1013 include 'COMMON.GEO'
1014 include 'COMMON.VAR'
1015 include 'COMMON.LOCAL'
1016 include 'COMMON.CHAIN'
1017 include 'COMMON.DERIV'
1018 include 'COMMON.INTERACT'
1019 include 'COMMON.TORSION'
1020 include 'COMMON.SBRIDGE'
1021 include 'COMMON.NAMES'
1022 include 'COMMON.IOUNITS'
1023 include 'COMMON.CONTACTS'
1025 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1027 do i=iatsc_s,iatsc_e
1028 itypi=iabs(itype(i))
1029 if (itypi.eq.ntyp1) cycle
1030 itypi1=iabs(itype(i+1))
1037 C Calculate SC interaction energy.
1039 do iint=1,nint_gr(i)
1040 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1041 cd & 'iend=',iend(i,iint)
1042 do j=istart(i,iint),iend(i,iint)
1043 itypj=iabs(itype(j))
1044 if (itypj.eq.ntyp1) cycle
1048 C Change 12/1/95 to calculate four-body interactions
1049 rij=xj*xj+yj*yj+zj*zj
1051 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1052 eps0ij=eps(itypi,itypj)
1054 e1=fac*fac*aa(itypi,itypj)
1055 e2=fac*bb(itypi,itypj)
1057 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1058 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1059 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1060 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1061 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1062 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1065 C Calculate the components of the gradient in DC and X
1067 fac=-rrij*(e1+evdwij)
1072 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1073 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1074 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1075 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1079 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1083 C 12/1/95, revised on 5/20/97
1085 C Calculate the contact function. The ith column of the array JCONT will
1086 C contain the numbers of atoms that make contacts with the atom I (of numbers
1087 C greater than I). The arrays FACONT and GACONT will contain the values of
1088 C the contact function and its derivative.
1090 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1091 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1092 C Uncomment next line, if the correlation interactions are contact function only
1093 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1095 sigij=sigma(itypi,itypj)
1096 r0ij=rs0(itypi,itypj)
1098 C Check whether the SC's are not too far to make a contact.
1101 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1102 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1104 if (fcont.gt.0.0D0) then
1105 C If the SC-SC distance if close to sigma, apply spline.
1106 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1107 cAdam & fcont1,fprimcont1)
1108 cAdam fcont1=1.0d0-fcont1
1109 cAdam if (fcont1.gt.0.0d0) then
1110 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1111 cAdam fcont=fcont*fcont1
1113 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1114 cga eps0ij=1.0d0/dsqrt(eps0ij)
1116 cga gg(k)=gg(k)*eps0ij
1118 cga eps0ij=-evdwij*eps0ij
1119 C Uncomment for AL's type of SC correlation interactions.
1120 cadam eps0ij=-evdwij
1121 num_conti=num_conti+1
1122 jcont(num_conti,i)=j
1123 facont(num_conti,i)=fcont*eps0ij
1124 fprimcont=eps0ij*fprimcont/rij
1126 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1127 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1128 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1129 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1130 gacont(1,num_conti,i)=-fprimcont*xj
1131 gacont(2,num_conti,i)=-fprimcont*yj
1132 gacont(3,num_conti,i)=-fprimcont*zj
1133 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1134 cd write (iout,'(2i3,3f10.5)')
1135 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1141 num_cont(i)=num_conti
1145 gvdwc(j,i)=expon*gvdwc(j,i)
1146 gvdwx(j,i)=expon*gvdwx(j,i)
1149 C******************************************************************************
1153 C To save time, the factor of EXPON has been extracted from ALL components
1154 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1157 C******************************************************************************
1160 C-----------------------------------------------------------------------------
1161 subroutine eljk(evdw)
1163 C This subroutine calculates the interaction energy of nonbonded side chains
1164 C assuming the LJK potential of interaction.
1166 implicit real*8 (a-h,o-z)
1167 include 'DIMENSIONS'
1168 include 'COMMON.GEO'
1169 include 'COMMON.VAR'
1170 include 'COMMON.LOCAL'
1171 include 'COMMON.CHAIN'
1172 include 'COMMON.DERIV'
1173 include 'COMMON.INTERACT'
1174 include 'COMMON.IOUNITS'
1175 include 'COMMON.NAMES'
1178 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1180 do i=iatsc_s,iatsc_e
1181 itypi=iabs(itype(i))
1182 if (itypi.eq.ntyp1) cycle
1183 itypi1=iabs(itype(i+1))
1188 C Calculate SC interaction energy.
1190 do iint=1,nint_gr(i)
1191 do j=istart(i,iint),iend(i,iint)
1192 itypj=iabs(itype(j))
1193 if (itypj.eq.ntyp1) cycle
1197 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1198 fac_augm=rrij**expon
1199 e_augm=augm(itypi,itypj)*fac_augm
1200 r_inv_ij=dsqrt(rrij)
1202 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1203 fac=r_shift_inv**expon
1204 e1=fac*fac*aa(itypi,itypj)
1205 e2=fac*bb(itypi,itypj)
1207 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1208 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1209 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1210 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1211 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1212 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1213 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1216 C Calculate the components of the gradient in DC and X
1218 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1223 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1224 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1225 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1226 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1230 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1238 gvdwc(j,i)=expon*gvdwc(j,i)
1239 gvdwx(j,i)=expon*gvdwx(j,i)
1244 C-----------------------------------------------------------------------------
1245 subroutine ebp(evdw)
1247 C This subroutine calculates the interaction energy of nonbonded side chains
1248 C assuming the Berne-Pechukas potential of interaction.
1250 implicit real*8 (a-h,o-z)
1251 include 'DIMENSIONS'
1252 include 'COMMON.GEO'
1253 include 'COMMON.VAR'
1254 include 'COMMON.LOCAL'
1255 include 'COMMON.CHAIN'
1256 include 'COMMON.DERIV'
1257 include 'COMMON.NAMES'
1258 include 'COMMON.INTERACT'
1259 include 'COMMON.IOUNITS'
1260 include 'COMMON.CALC'
1261 common /srutu/ icall
1262 c double precision rrsave(maxdim)
1265 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1267 c if (icall.eq.0) then
1273 do i=iatsc_s,iatsc_e
1274 itypi=iabs(itype(i))
1275 if (itypi.eq.ntyp1) cycle
1276 itypi1=iabs(itype(i+1))
1280 dxi=dc_norm(1,nres+i)
1281 dyi=dc_norm(2,nres+i)
1282 dzi=dc_norm(3,nres+i)
1283 c dsci_inv=dsc_inv(itypi)
1284 dsci_inv=vbld_inv(i+nres)
1286 C Calculate SC interaction energy.
1288 do iint=1,nint_gr(i)
1289 do j=istart(i,iint),iend(i,iint)
1291 itypj=iabs(itype(j))
1292 if (itypj.eq.ntyp1) cycle
1293 c dscj_inv=dsc_inv(itypj)
1294 dscj_inv=vbld_inv(j+nres)
1295 chi1=chi(itypi,itypj)
1296 chi2=chi(itypj,itypi)
1303 alf12=0.5D0*(alf1+alf2)
1304 C For diagnostics only!!!
1317 dxj=dc_norm(1,nres+j)
1318 dyj=dc_norm(2,nres+j)
1319 dzj=dc_norm(3,nres+j)
1320 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1321 cd if (icall.eq.0) then
1327 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1329 C Calculate whole angle-dependent part of epsilon and contributions
1330 C to its derivatives
1331 fac=(rrij*sigsq)**expon2
1332 e1=fac*fac*aa(itypi,itypj)
1333 e2=fac*bb(itypi,itypj)
1334 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1335 eps2der=evdwij*eps3rt
1336 eps3der=evdwij*eps2rt
1337 evdwij=evdwij*eps2rt*eps3rt
1340 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1341 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1342 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1343 cd & restyp(itypi),i,restyp(itypj),j,
1344 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1345 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1346 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1349 C Calculate gradient components.
1350 e1=e1*eps1*eps2rt**2*eps3rt**2
1351 fac=-expon*(e1+evdwij)
1354 C Calculate radial part of the gradient
1358 C Calculate the angular part of the gradient and sum add the contributions
1359 C to the appropriate components of the Cartesian gradient.
1367 C-----------------------------------------------------------------------------
1368 subroutine egb(evdw)
1370 C This subroutine calculates the interaction energy of nonbonded side chains
1371 C assuming the Gay-Berne potential of interaction.
1373 implicit real*8 (a-h,o-z)
1374 include 'DIMENSIONS'
1375 include 'COMMON.GEO'
1376 include 'COMMON.VAR'
1377 include 'COMMON.LOCAL'
1378 include 'COMMON.CHAIN'
1379 include 'COMMON.DERIV'
1380 include 'COMMON.NAMES'
1381 include 'COMMON.INTERACT'
1382 include 'COMMON.IOUNITS'
1383 include 'COMMON.CALC'
1384 include 'COMMON.CONTROL'
1387 ccccc energy_dec=.false.
1388 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1391 c if (icall.eq.0) lprn=.false.
1393 do i=iatsc_s,iatsc_e
1394 itypi=iabs(itype(i))
1395 if (itypi.eq.ntyp1) cycle
1396 itypi1=iabs(itype(i+1))
1400 dxi=dc_norm(1,nres+i)
1401 dyi=dc_norm(2,nres+i)
1402 dzi=dc_norm(3,nres+i)
1403 c dsci_inv=dsc_inv(itypi)
1404 dsci_inv=vbld_inv(i+nres)
1405 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1406 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1408 C Calculate SC interaction energy.
1410 do iint=1,nint_gr(i)
1411 do j=istart(i,iint),iend(i,iint)
1413 itypj=iabs(itype(j))
1414 if (itypj.eq.ntyp1) cycle
1415 c dscj_inv=dsc_inv(itypj)
1416 dscj_inv=vbld_inv(j+nres)
1417 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1418 c & 1.0d0/vbld(j+nres)
1419 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1420 sig0ij=sigma(itypi,itypj)
1421 chi1=chi(itypi,itypj)
1422 chi2=chi(itypj,itypi)
1429 alf12=0.5D0*(alf1+alf2)
1430 C For diagnostics only!!!
1443 dxj=dc_norm(1,nres+j)
1444 dyj=dc_norm(2,nres+j)
1445 dzj=dc_norm(3,nres+j)
1446 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1447 c write (iout,*) "j",j," dc_norm",
1448 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1449 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1451 C Calculate angle-dependent terms of energy and contributions to their
1455 sig=sig0ij*dsqrt(sigsq)
1456 rij_shift=1.0D0/rij-sig+sig0ij
1457 c for diagnostics; uncomment
1458 c rij_shift=1.2*sig0ij
1459 C I hate to put IF's in the loops, but here don't have another choice!!!!
1460 if (rij_shift.le.0.0D0) then
1462 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1463 cd & restyp(itypi),i,restyp(itypj),j,
1464 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1468 c---------------------------------------------------------------
1469 rij_shift=1.0D0/rij_shift
1470 fac=rij_shift**expon
1471 e1=fac*fac*aa(itypi,itypj)
1472 e2=fac*bb(itypi,itypj)
1473 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1474 eps2der=evdwij*eps3rt
1475 eps3der=evdwij*eps2rt
1476 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1477 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1478 evdwij=evdwij*eps2rt*eps3rt
1481 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1482 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1483 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1484 & restyp(itypi),i,restyp(itypj),j,
1485 & epsi,sigm,chi1,chi2,chip1,chip2,
1486 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1487 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1491 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1494 C Calculate gradient components.
1495 e1=e1*eps1*eps2rt**2*eps3rt**2
1496 fac=-expon*(e1+evdwij)*rij_shift
1500 C Calculate the radial part of the gradient
1504 C Calculate angular part of the gradient.
1509 c write (iout,*) "Number of loop steps in EGB:",ind
1510 cccc energy_dec=.false.
1513 C-----------------------------------------------------------------------------
1514 subroutine egbv(evdw)
1516 C This subroutine calculates the interaction energy of nonbonded side chains
1517 C assuming the Gay-Berne-Vorobjev potential of interaction.
1519 implicit real*8 (a-h,o-z)
1520 include 'DIMENSIONS'
1521 include 'COMMON.GEO'
1522 include 'COMMON.VAR'
1523 include 'COMMON.LOCAL'
1524 include 'COMMON.CHAIN'
1525 include 'COMMON.DERIV'
1526 include 'COMMON.NAMES'
1527 include 'COMMON.INTERACT'
1528 include 'COMMON.IOUNITS'
1529 include 'COMMON.CALC'
1530 common /srutu/ icall
1533 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1536 c if (icall.eq.0) lprn=.true.
1538 do i=iatsc_s,iatsc_e
1539 itypi=iabs(itype(i))
1540 if (itypi.eq.ntyp1) cycle
1541 itypi1=iabs(itype(i+1))
1545 dxi=dc_norm(1,nres+i)
1546 dyi=dc_norm(2,nres+i)
1547 dzi=dc_norm(3,nres+i)
1548 c dsci_inv=dsc_inv(itypi)
1549 dsci_inv=vbld_inv(i+nres)
1551 C Calculate SC interaction energy.
1553 do iint=1,nint_gr(i)
1554 do j=istart(i,iint),iend(i,iint)
1556 itypj=iabs(itype(j))
1557 if (itypj.eq.ntyp1) cycle
1558 c dscj_inv=dsc_inv(itypj)
1559 dscj_inv=vbld_inv(j+nres)
1560 sig0ij=sigma(itypi,itypj)
1561 r0ij=r0(itypi,itypj)
1562 chi1=chi(itypi,itypj)
1563 chi2=chi(itypj,itypi)
1570 alf12=0.5D0*(alf1+alf2)
1571 C For diagnostics only!!!
1584 dxj=dc_norm(1,nres+j)
1585 dyj=dc_norm(2,nres+j)
1586 dzj=dc_norm(3,nres+j)
1587 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1589 C Calculate angle-dependent terms of energy and contributions to their
1593 sig=sig0ij*dsqrt(sigsq)
1594 rij_shift=1.0D0/rij-sig+r0ij
1595 C I hate to put IF's in the loops, but here don't have another choice!!!!
1596 if (rij_shift.le.0.0D0) then
1601 c---------------------------------------------------------------
1602 rij_shift=1.0D0/rij_shift
1603 fac=rij_shift**expon
1604 e1=fac*fac*aa(itypi,itypj)
1605 e2=fac*bb(itypi,itypj)
1606 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1607 eps2der=evdwij*eps3rt
1608 eps3der=evdwij*eps2rt
1609 fac_augm=rrij**expon
1610 e_augm=augm(itypi,itypj)*fac_augm
1611 evdwij=evdwij*eps2rt*eps3rt
1612 evdw=evdw+evdwij+e_augm
1614 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1615 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1616 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1617 & restyp(itypi),i,restyp(itypj),j,
1618 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1619 & chi1,chi2,chip1,chip2,
1620 & eps1,eps2rt**2,eps3rt**2,
1621 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1624 C Calculate gradient components.
1625 e1=e1*eps1*eps2rt**2*eps3rt**2
1626 fac=-expon*(e1+evdwij)*rij_shift
1628 fac=rij*fac-2*expon*rrij*e_augm
1629 C Calculate the radial part of the gradient
1633 C Calculate angular part of the gradient.
1639 C-----------------------------------------------------------------------------
1640 subroutine sc_angular
1641 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1642 C om12. Called by ebp, egb, and egbv.
1644 include 'COMMON.CALC'
1645 include 'COMMON.IOUNITS'
1649 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1650 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1651 om12=dxi*dxj+dyi*dyj+dzi*dzj
1653 C Calculate eps1(om12) and its derivative in om12
1654 faceps1=1.0D0-om12*chiom12
1655 faceps1_inv=1.0D0/faceps1
1656 eps1=dsqrt(faceps1_inv)
1657 C Following variable is eps1*deps1/dom12
1658 eps1_om12=faceps1_inv*chiom12
1663 c write (iout,*) "om12",om12," eps1",eps1
1664 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1669 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1670 sigsq=1.0D0-facsig*faceps1_inv
1671 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1672 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1673 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1679 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1680 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1682 C Calculate eps2 and its derivatives in om1, om2, and om12.
1685 chipom12=chip12*om12
1686 facp=1.0D0-om12*chipom12
1688 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1689 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1690 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1691 C Following variable is the square root of eps2
1692 eps2rt=1.0D0-facp1*facp_inv
1693 C Following three variables are the derivatives of the square root of eps
1694 C in om1, om2, and om12.
1695 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1696 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1697 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1698 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1699 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1700 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1701 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1702 c & " eps2rt_om12",eps2rt_om12
1703 C Calculate whole angle-dependent part of epsilon and contributions
1704 C to its derivatives
1707 C----------------------------------------------------------------------------
1709 implicit real*8 (a-h,o-z)
1710 include 'DIMENSIONS'
1711 include 'COMMON.CHAIN'
1712 include 'COMMON.DERIV'
1713 include 'COMMON.CALC'
1714 include 'COMMON.IOUNITS'
1715 double precision dcosom1(3),dcosom2(3)
1716 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1717 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1718 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1719 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1723 c eom12=evdwij*eps1_om12
1725 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1726 c & " sigder",sigder
1727 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1728 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1730 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1731 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1734 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1736 c write (iout,*) "gg",(gg(k),k=1,3)
1738 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1739 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1740 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1741 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1742 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1743 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1744 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1745 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1746 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1747 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1750 C Calculate the components of the gradient in DC and X
1754 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1758 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1759 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1763 C-----------------------------------------------------------------------
1764 subroutine e_softsphere(evdw)
1766 C This subroutine calculates the interaction energy of nonbonded side chains
1767 C assuming the LJ potential of interaction.
1769 implicit real*8 (a-h,o-z)
1770 include 'DIMENSIONS'
1771 parameter (accur=1.0d-10)
1772 include 'COMMON.GEO'
1773 include 'COMMON.VAR'
1774 include 'COMMON.LOCAL'
1775 include 'COMMON.CHAIN'
1776 include 'COMMON.DERIV'
1777 include 'COMMON.INTERACT'
1778 include 'COMMON.TORSION'
1779 include 'COMMON.SBRIDGE'
1780 include 'COMMON.NAMES'
1781 include 'COMMON.IOUNITS'
1782 include 'COMMON.CONTACTS'
1784 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1786 do i=iatsc_s,iatsc_e
1787 itypi=iabs(itype(i))
1788 if (itypi.eq.ntyp1) cycle
1789 itypi1=iabs(itype(i+1))
1794 C Calculate SC interaction energy.
1796 do iint=1,nint_gr(i)
1797 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1798 cd & 'iend=',iend(i,iint)
1799 do j=istart(i,iint),iend(i,iint)
1800 itypj=iabs(itype(j))
1801 if (itypj.eq.ntyp1) cycle
1805 rij=xj*xj+yj*yj+zj*zj
1806 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1807 r0ij=r0(itypi,itypj)
1809 c print *,i,j,r0ij,dsqrt(rij)
1810 if (rij.lt.r0ijsq) then
1811 evdwij=0.25d0*(rij-r0ijsq)**2
1819 C Calculate the components of the gradient in DC and X
1825 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1826 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1827 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1828 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1832 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1840 C--------------------------------------------------------------------------
1841 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
1844 C Soft-sphere potential of p-p interaction
1846 implicit real*8 (a-h,o-z)
1847 include 'DIMENSIONS'
1848 include 'COMMON.CONTROL'
1849 include 'COMMON.IOUNITS'
1850 include 'COMMON.GEO'
1851 include 'COMMON.VAR'
1852 include 'COMMON.LOCAL'
1853 include 'COMMON.CHAIN'
1854 include 'COMMON.DERIV'
1855 include 'COMMON.INTERACT'
1856 include 'COMMON.CONTACTS'
1857 include 'COMMON.TORSION'
1858 include 'COMMON.VECTORS'
1859 include 'COMMON.FFIELD'
1861 cd write(iout,*) 'In EELEC_soft_sphere'
1868 do i=iatel_s,iatel_e
1869 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
1873 xmedi=c(1,i)+0.5d0*dxi
1874 ymedi=c(2,i)+0.5d0*dyi
1875 zmedi=c(3,i)+0.5d0*dzi
1877 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1878 do j=ielstart(i),ielend(i)
1879 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
1883 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1884 r0ij=rpp(iteli,itelj)
1889 xj=c(1,j)+0.5D0*dxj-xmedi
1890 yj=c(2,j)+0.5D0*dyj-ymedi
1891 zj=c(3,j)+0.5D0*dzj-zmedi
1892 rij=xj*xj+yj*yj+zj*zj
1893 if (rij.lt.r0ijsq) then
1894 evdw1ij=0.25d0*(rij-r0ijsq)**2
1902 C Calculate contributions to the Cartesian gradient.
1908 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
1909 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
1912 * Loop over residues i+1 thru j-1.
1916 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
1921 cgrad do i=nnt,nct-1
1923 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
1925 cgrad do j=i+1,nct-1
1927 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
1933 c------------------------------------------------------------------------------
1934 subroutine vec_and_deriv
1935 implicit real*8 (a-h,o-z)
1936 include 'DIMENSIONS'
1940 include 'COMMON.IOUNITS'
1941 include 'COMMON.GEO'
1942 include 'COMMON.VAR'
1943 include 'COMMON.LOCAL'
1944 include 'COMMON.CHAIN'
1945 include 'COMMON.VECTORS'
1946 include 'COMMON.SETUP'
1947 include 'COMMON.TIME1'
1948 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1949 C Compute the local reference systems. For reference system (i), the
1950 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1951 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1953 do i=ivec_start,ivec_end
1957 if (i.eq.nres-1) then
1958 C Case of the last full residue
1959 C Compute the Z-axis
1960 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1961 costh=dcos(pi-theta(nres))
1962 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1966 C Compute the derivatives of uz
1968 uzder(2,1,1)=-dc_norm(3,i-1)
1969 uzder(3,1,1)= dc_norm(2,i-1)
1970 uzder(1,2,1)= dc_norm(3,i-1)
1972 uzder(3,2,1)=-dc_norm(1,i-1)
1973 uzder(1,3,1)=-dc_norm(2,i-1)
1974 uzder(2,3,1)= dc_norm(1,i-1)
1977 uzder(2,1,2)= dc_norm(3,i)
1978 uzder(3,1,2)=-dc_norm(2,i)
1979 uzder(1,2,2)=-dc_norm(3,i)
1981 uzder(3,2,2)= dc_norm(1,i)
1982 uzder(1,3,2)= dc_norm(2,i)
1983 uzder(2,3,2)=-dc_norm(1,i)
1985 C Compute the Y-axis
1988 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
1990 C Compute the derivatives of uy
1993 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
1994 & -dc_norm(k,i)*dc_norm(j,i-1)
1995 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
1997 uyder(j,j,1)=uyder(j,j,1)-costh
1998 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2003 uygrad(l,k,j,i)=uyder(l,k,j)
2004 uzgrad(l,k,j,i)=uzder(l,k,j)
2008 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2009 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2010 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2011 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2014 C Compute the Z-axis
2015 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2016 costh=dcos(pi-theta(i+2))
2017 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2021 C Compute the derivatives of uz
2023 uzder(2,1,1)=-dc_norm(3,i+1)
2024 uzder(3,1,1)= dc_norm(2,i+1)
2025 uzder(1,2,1)= dc_norm(3,i+1)
2027 uzder(3,2,1)=-dc_norm(1,i+1)
2028 uzder(1,3,1)=-dc_norm(2,i+1)
2029 uzder(2,3,1)= dc_norm(1,i+1)
2032 uzder(2,1,2)= dc_norm(3,i)
2033 uzder(3,1,2)=-dc_norm(2,i)
2034 uzder(1,2,2)=-dc_norm(3,i)
2036 uzder(3,2,2)= dc_norm(1,i)
2037 uzder(1,3,2)= dc_norm(2,i)
2038 uzder(2,3,2)=-dc_norm(1,i)
2040 C Compute the Y-axis
2043 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2045 C Compute the derivatives of uy
2048 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2049 & -dc_norm(k,i)*dc_norm(j,i+1)
2050 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2052 uyder(j,j,1)=uyder(j,j,1)-costh
2053 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2058 uygrad(l,k,j,i)=uyder(l,k,j)
2059 uzgrad(l,k,j,i)=uzder(l,k,j)
2063 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2064 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2065 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2066 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2070 vbld_inv_temp(1)=vbld_inv(i+1)
2071 if (i.lt.nres-1) then
2072 vbld_inv_temp(2)=vbld_inv(i+2)
2074 vbld_inv_temp(2)=vbld_inv(i)
2079 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2080 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2085 #if defined(PARVEC) && defined(MPI)
2086 if (nfgtasks1.gt.1) then
2088 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2089 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2090 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2091 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2092 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2094 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2095 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2097 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2098 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2099 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2100 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2101 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2102 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2103 time_gather=time_gather+MPI_Wtime()-time00
2105 c if (fg_rank.eq.0) then
2106 c write (iout,*) "Arrays UY and UZ"
2108 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2115 C-----------------------------------------------------------------------------
2116 subroutine check_vecgrad
2117 implicit real*8 (a-h,o-z)
2118 include 'DIMENSIONS'
2119 include 'COMMON.IOUNITS'
2120 include 'COMMON.GEO'
2121 include 'COMMON.VAR'
2122 include 'COMMON.LOCAL'
2123 include 'COMMON.CHAIN'
2124 include 'COMMON.VECTORS'
2125 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2126 dimension uyt(3,maxres),uzt(3,maxres)
2127 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2128 double precision delta /1.0d-7/
2131 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2132 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2133 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2134 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2135 cd & (dc_norm(if90,i),if90=1,3)
2136 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2137 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2138 cd write(iout,'(a)')
2144 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2145 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2158 cd write (iout,*) 'i=',i
2160 erij(k)=dc_norm(k,i)
2164 dc_norm(k,i)=erij(k)
2166 dc_norm(j,i)=dc_norm(j,i)+delta
2167 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2169 c dc_norm(k,i)=dc_norm(k,i)/fac
2171 c write (iout,*) (dc_norm(k,i),k=1,3)
2172 c write (iout,*) (erij(k),k=1,3)
2175 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2176 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2177 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2178 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2180 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2181 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2182 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2185 dc_norm(k,i)=erij(k)
2188 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2189 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2190 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2191 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2192 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2193 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2194 cd write (iout,'(a)')
2199 C--------------------------------------------------------------------------
2200 subroutine set_matrices
2201 implicit real*8 (a-h,o-z)
2202 include 'DIMENSIONS'
2205 include "COMMON.SETUP"
2207 integer status(MPI_STATUS_SIZE)
2209 include 'COMMON.IOUNITS'
2210 include 'COMMON.GEO'
2211 include 'COMMON.VAR'
2212 include 'COMMON.LOCAL'
2213 include 'COMMON.CHAIN'
2214 include 'COMMON.DERIV'
2215 include 'COMMON.INTERACT'
2216 include 'COMMON.CONTACTS'
2217 include 'COMMON.TORSION'
2218 include 'COMMON.VECTORS'
2219 include 'COMMON.FFIELD'
2220 double precision auxvec(2),auxmat(2,2)
2222 C Compute the virtual-bond-torsional-angle dependent quantities needed
2223 C to calculate the el-loc multibody terms of various order.
2226 do i=ivec_start+2,ivec_end+2
2230 if (i .lt. nres+1) then
2267 if (i .gt. 3 .and. i .lt. nres+1) then
2268 obrot_der(1,i-2)=-sin1
2269 obrot_der(2,i-2)= cos1
2270 Ugder(1,1,i-2)= sin1
2271 Ugder(1,2,i-2)=-cos1
2272 Ugder(2,1,i-2)=-cos1
2273 Ugder(2,2,i-2)=-sin1
2276 obrot2_der(1,i-2)=-dwasin2
2277 obrot2_der(2,i-2)= dwacos2
2278 Ug2der(1,1,i-2)= dwasin2
2279 Ug2der(1,2,i-2)=-dwacos2
2280 Ug2der(2,1,i-2)=-dwacos2
2281 Ug2der(2,2,i-2)=-dwasin2
2283 obrot_der(1,i-2)=0.0d0
2284 obrot_der(2,i-2)=0.0d0
2285 Ugder(1,1,i-2)=0.0d0
2286 Ugder(1,2,i-2)=0.0d0
2287 Ugder(2,1,i-2)=0.0d0
2288 Ugder(2,2,i-2)=0.0d0
2289 obrot2_der(1,i-2)=0.0d0
2290 obrot2_der(2,i-2)=0.0d0
2291 Ug2der(1,1,i-2)=0.0d0
2292 Ug2der(1,2,i-2)=0.0d0
2293 Ug2der(2,1,i-2)=0.0d0
2294 Ug2der(2,2,i-2)=0.0d0
2296 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2297 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2298 iti = itortyp(itype(i-2))
2302 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2303 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2304 iti1 = itortyp(itype(i-1))
2308 cd write (iout,*) '*******i',i,' iti1',iti
2309 cd write (iout,*) 'b1',b1(:,iti)
2310 cd write (iout,*) 'b2',b2(:,iti)
2311 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2312 c if (i .gt. iatel_s+2) then
2313 if (i .gt. nnt+2) then
2314 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2315 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2316 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2318 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2319 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2320 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2321 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2322 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2333 DtUg2(l,k,i-2)=0.0d0
2337 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2338 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2340 muder(k,i-2)=Ub2der(k,i-2)
2342 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2343 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2344 iti1 = itortyp(itype(i-1))
2349 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2351 cd write (iout,*) 'mu ',mu(:,i-2)
2352 cd write (iout,*) 'mu1',mu1(:,i-2)
2353 cd write (iout,*) 'mu2',mu2(:,i-2)
2354 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2356 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2357 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2358 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2359 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2360 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2361 C Vectors and matrices dependent on a single virtual-bond dihedral.
2362 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2363 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2364 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2365 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2366 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2367 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2368 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2369 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2370 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2373 C Matrices dependent on two consecutive virtual-bond dihedrals.
2374 C The order of matrices is from left to right.
2375 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2377 c do i=max0(ivec_start,2),ivec_end
2379 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2380 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2381 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2382 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2383 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2384 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2385 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2386 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2389 #if defined(MPI) && defined(PARMAT)
2391 c if (fg_rank.eq.0) then
2392 write (iout,*) "Arrays UG and UGDER before GATHER"
2394 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2395 & ((ug(l,k,i),l=1,2),k=1,2),
2396 & ((ugder(l,k,i),l=1,2),k=1,2)
2398 write (iout,*) "Arrays UG2 and UG2DER"
2400 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2401 & ((ug2(l,k,i),l=1,2),k=1,2),
2402 & ((ug2der(l,k,i),l=1,2),k=1,2)
2404 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2406 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2407 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2408 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2410 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2412 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2413 & costab(i),sintab(i),costab2(i),sintab2(i)
2415 write (iout,*) "Array MUDER"
2417 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2421 if (nfgtasks.gt.1) then
2423 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2424 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2425 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2427 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2428 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2430 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2431 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2433 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2434 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2436 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2437 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2439 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2440 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2442 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2443 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2445 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2446 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2447 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2448 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2449 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2450 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2451 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2452 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2453 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2454 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2455 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2456 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2457 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2459 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2460 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2462 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2463 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2465 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2466 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2468 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2469 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2471 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2472 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2474 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2475 & ivec_count(fg_rank1),
2476 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2478 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2479 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2481 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2482 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2484 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2485 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2487 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2488 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2490 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2491 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2493 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2494 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2496 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2497 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2499 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2500 & ivec_count(fg_rank1),
2501 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2503 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2504 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2506 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2507 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2509 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2510 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2512 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2513 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2515 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2516 & ivec_count(fg_rank1),
2517 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2519 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2520 & ivec_count(fg_rank1),
2521 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2523 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2524 & ivec_count(fg_rank1),
2525 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2526 & MPI_MAT2,FG_COMM1,IERR)
2527 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2528 & ivec_count(fg_rank1),
2529 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2530 & MPI_MAT2,FG_COMM1,IERR)
2533 c Passes matrix info through the ring
2536 if (irecv.lt.0) irecv=nfgtasks1-1
2539 if (inext.ge.nfgtasks1) inext=0
2541 c write (iout,*) "isend",isend," irecv",irecv
2543 lensend=lentyp(isend)
2544 lenrecv=lentyp(irecv)
2545 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2546 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2547 c & MPI_ROTAT1(lensend),inext,2200+isend,
2548 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2549 c & iprev,2200+irecv,FG_COMM,status,IERR)
2550 c write (iout,*) "Gather ROTAT1"
2552 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2553 c & MPI_ROTAT2(lensend),inext,3300+isend,
2554 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2555 c & iprev,3300+irecv,FG_COMM,status,IERR)
2556 c write (iout,*) "Gather ROTAT2"
2558 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2559 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2560 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2561 & iprev,4400+irecv,FG_COMM,status,IERR)
2562 c write (iout,*) "Gather ROTAT_OLD"
2564 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2565 & MPI_PRECOMP11(lensend),inext,5500+isend,
2566 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2567 & iprev,5500+irecv,FG_COMM,status,IERR)
2568 c write (iout,*) "Gather PRECOMP11"
2570 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2571 & MPI_PRECOMP12(lensend),inext,6600+isend,
2572 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2573 & iprev,6600+irecv,FG_COMM,status,IERR)
2574 c write (iout,*) "Gather PRECOMP12"
2576 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2578 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2579 & MPI_ROTAT2(lensend),inext,7700+isend,
2580 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2581 & iprev,7700+irecv,FG_COMM,status,IERR)
2582 c write (iout,*) "Gather PRECOMP21"
2584 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2585 & MPI_PRECOMP22(lensend),inext,8800+isend,
2586 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2587 & iprev,8800+irecv,FG_COMM,status,IERR)
2588 c write (iout,*) "Gather PRECOMP22"
2590 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2591 & MPI_PRECOMP23(lensend),inext,9900+isend,
2592 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2593 & MPI_PRECOMP23(lenrecv),
2594 & iprev,9900+irecv,FG_COMM,status,IERR)
2595 c write (iout,*) "Gather PRECOMP23"
2600 if (irecv.lt.0) irecv=nfgtasks1-1
2603 time_gather=time_gather+MPI_Wtime()-time00
2606 c if (fg_rank.eq.0) then
2607 write (iout,*) "Arrays UG and UGDER"
2609 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2610 & ((ug(l,k,i),l=1,2),k=1,2),
2611 & ((ugder(l,k,i),l=1,2),k=1,2)
2613 write (iout,*) "Arrays UG2 and UG2DER"
2615 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2616 & ((ug2(l,k,i),l=1,2),k=1,2),
2617 & ((ug2der(l,k,i),l=1,2),k=1,2)
2619 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2621 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2622 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2623 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2625 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2627 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2628 & costab(i),sintab(i),costab2(i),sintab2(i)
2630 write (iout,*) "Array MUDER"
2632 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2638 cd iti = itortyp(itype(i))
2641 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2642 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2647 C--------------------------------------------------------------------------
2648 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2650 C This subroutine calculates the average interaction energy and its gradient
2651 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2652 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2653 C The potential depends both on the distance of peptide-group centers and on
2654 C the orientation of the CA-CA virtual bonds.
2656 implicit real*8 (a-h,o-z)
2660 include 'DIMENSIONS'
2661 include 'COMMON.CONTROL'
2662 include 'COMMON.SETUP'
2663 include 'COMMON.IOUNITS'
2664 include 'COMMON.GEO'
2665 include 'COMMON.VAR'
2666 include 'COMMON.LOCAL'
2667 include 'COMMON.CHAIN'
2668 include 'COMMON.DERIV'
2669 include 'COMMON.INTERACT'
2670 include 'COMMON.CONTACTS'
2671 include 'COMMON.TORSION'
2672 include 'COMMON.VECTORS'
2673 include 'COMMON.FFIELD'
2674 include 'COMMON.TIME1'
2675 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2676 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2677 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2678 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2679 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2680 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2682 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2684 double precision scal_el /1.0d0/
2686 double precision scal_el /0.5d0/
2689 C 13-go grudnia roku pamietnego...
2690 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2691 & 0.0d0,1.0d0,0.0d0,
2692 & 0.0d0,0.0d0,1.0d0/
2693 cd write(iout,*) 'In EELEC'
2695 cd write(iout,*) 'Type',i
2696 cd write(iout,*) 'B1',B1(:,i)
2697 cd write(iout,*) 'B2',B2(:,i)
2698 cd write(iout,*) 'CC',CC(:,:,i)
2699 cd write(iout,*) 'DD',DD(:,:,i)
2700 cd write(iout,*) 'EE',EE(:,:,i)
2702 cd call check_vecgrad
2704 if (icheckgrad.eq.1) then
2706 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2708 dc_norm(k,i)=dc(k,i)*fac
2710 c write (iout,*) 'i',i,' fac',fac
2713 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2714 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2715 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2716 c call vec_and_deriv
2722 time_mat=time_mat+MPI_Wtime()-time01
2726 cd write (iout,*) 'i=',i
2728 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2731 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2732 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2745 cd print '(a)','Enter EELEC'
2746 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2748 gel_loc_loc(i)=0.0d0
2753 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2755 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2757 do i=iturn3_start,iturn3_end
2758 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2759 & .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle
2763 dx_normi=dc_norm(1,i)
2764 dy_normi=dc_norm(2,i)
2765 dz_normi=dc_norm(3,i)
2766 xmedi=c(1,i)+0.5d0*dxi
2767 ymedi=c(2,i)+0.5d0*dyi
2768 zmedi=c(3,i)+0.5d0*dzi
2770 call eelecij(i,i+2,ees,evdw1,eel_loc)
2771 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2772 num_cont_hb(i)=num_conti
2774 do i=iturn4_start,iturn4_end
2775 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2776 & .or. itype(i+3).eq.ntyp1
2777 & .or. itype(i+4).eq.ntyp1) cycle
2781 dx_normi=dc_norm(1,i)
2782 dy_normi=dc_norm(2,i)
2783 dz_normi=dc_norm(3,i)
2784 xmedi=c(1,i)+0.5d0*dxi
2785 ymedi=c(2,i)+0.5d0*dyi
2786 zmedi=c(3,i)+0.5d0*dzi
2787 num_conti=num_cont_hb(i)
2788 call eelecij(i,i+3,ees,evdw1,eel_loc)
2789 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
2790 & call eturn4(i,eello_turn4)
2791 num_cont_hb(i)=num_conti
2794 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2796 do i=iatel_s,iatel_e
2797 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2801 dx_normi=dc_norm(1,i)
2802 dy_normi=dc_norm(2,i)
2803 dz_normi=dc_norm(3,i)
2804 xmedi=c(1,i)+0.5d0*dxi
2805 ymedi=c(2,i)+0.5d0*dyi
2806 zmedi=c(3,i)+0.5d0*dzi
2807 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2808 num_conti=num_cont_hb(i)
2809 do j=ielstart(i),ielend(i)
2810 c write (iout,*) i,j,itype(i),itype(j)
2811 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle
2812 call eelecij(i,j,ees,evdw1,eel_loc)
2814 num_cont_hb(i)=num_conti
2816 c write (iout,*) "Number of loop steps in EELEC:",ind
2818 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2819 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2821 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2822 ccc eel_loc=eel_loc+eello_turn3
2823 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2826 C-------------------------------------------------------------------------------
2827 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2828 implicit real*8 (a-h,o-z)
2829 include 'DIMENSIONS'
2833 include 'COMMON.CONTROL'
2834 include 'COMMON.IOUNITS'
2835 include 'COMMON.GEO'
2836 include 'COMMON.VAR'
2837 include 'COMMON.LOCAL'
2838 include 'COMMON.CHAIN'
2839 include 'COMMON.DERIV'
2840 include 'COMMON.INTERACT'
2841 include 'COMMON.CONTACTS'
2842 include 'COMMON.TORSION'
2843 include 'COMMON.VECTORS'
2844 include 'COMMON.FFIELD'
2845 include 'COMMON.TIME1'
2846 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2847 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2848 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2849 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2850 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2851 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2853 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2855 double precision scal_el /1.0d0/
2857 double precision scal_el /0.5d0/
2860 C 13-go grudnia roku pamietnego...
2861 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2862 & 0.0d0,1.0d0,0.0d0,
2863 & 0.0d0,0.0d0,1.0d0/
2864 c time00=MPI_Wtime()
2865 cd write (iout,*) "eelecij",i,j
2869 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2870 aaa=app(iteli,itelj)
2871 bbb=bpp(iteli,itelj)
2872 ael6i=ael6(iteli,itelj)
2873 ael3i=ael3(iteli,itelj)
2877 dx_normj=dc_norm(1,j)
2878 dy_normj=dc_norm(2,j)
2879 dz_normj=dc_norm(3,j)
2880 xj=c(1,j)+0.5D0*dxj-xmedi
2881 yj=c(2,j)+0.5D0*dyj-ymedi
2882 zj=c(3,j)+0.5D0*dzj-zmedi
2883 rij=xj*xj+yj*yj+zj*zj
2889 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
2890 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
2891 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
2892 fac=cosa-3.0D0*cosb*cosg
2894 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
2895 if (j.eq.i+2) ev1=scal_el*ev1
2900 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
2903 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
2904 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
2907 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
2908 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
2909 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
2910 cd & xmedi,ymedi,zmedi,xj,yj,zj
2912 if (energy_dec) then
2913 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
2914 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
2918 C Calculate contributions to the Cartesian gradient.
2921 facvdw=-6*rrmij*(ev1+evdwij)
2922 facel=-3*rrmij*(el1+eesij)
2928 * Radial derivatives. First process both termini of the fragment (i,j)
2934 c ghalf=0.5D0*ggg(k)
2935 c gelc(k,i)=gelc(k,i)+ghalf
2936 c gelc(k,j)=gelc(k,j)+ghalf
2938 c 9/28/08 AL Gradient compotents will be summed only at the end
2940 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
2941 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
2944 * Loop over residues i+1 thru j-1.
2948 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2955 c ghalf=0.5D0*ggg(k)
2956 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
2957 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
2959 c 9/28/08 AL Gradient compotents will be summed only at the end
2961 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2962 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2965 * Loop over residues i+1 thru j-1.
2969 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
2976 fac=-3*rrmij*(facvdw+facvdw+facel)
2981 * Radial derivatives. First process both termini of the fragment (i,j)
2987 c ghalf=0.5D0*ggg(k)
2988 c gelc(k,i)=gelc(k,i)+ghalf
2989 c gelc(k,j)=gelc(k,j)+ghalf
2991 c 9/28/08 AL Gradient compotents will be summed only at the end
2993 gelc_long(k,j)=gelc(k,j)+ggg(k)
2994 gelc_long(k,i)=gelc(k,i)-ggg(k)
2997 * Loop over residues i+1 thru j-1.
3001 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3004 c 9/28/08 AL Gradient compotents will be summed only at the end
3009 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3010 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3016 ecosa=2.0D0*fac3*fac1+fac4
3019 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3020 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3022 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3023 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3025 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3026 cd & (dcosg(k),k=1,3)
3028 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3031 c ghalf=0.5D0*ggg(k)
3032 c gelc(k,i)=gelc(k,i)+ghalf
3033 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3034 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3035 c gelc(k,j)=gelc(k,j)+ghalf
3036 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3037 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3041 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3046 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3047 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3049 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3050 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3051 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3052 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3054 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3055 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3056 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3058 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3059 C energy of a peptide unit is assumed in the form of a second-order
3060 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3061 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3062 C are computed for EVERY pair of non-contiguous peptide groups.
3064 if (j.lt.nres-1) then
3075 muij(kkk)=mu(k,i)*mu(l,j)
3078 cd write (iout,*) 'EELEC: i',i,' j',j
3079 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3080 cd write(iout,*) 'muij',muij
3081 ury=scalar(uy(1,i),erij)
3082 urz=scalar(uz(1,i),erij)
3083 vry=scalar(uy(1,j),erij)
3084 vrz=scalar(uz(1,j),erij)
3085 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3086 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3087 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3088 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3089 fac=dsqrt(-ael6i)*r3ij
3094 cd write (iout,'(4i5,4f10.5)')
3095 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3096 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3097 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3098 cd & uy(:,j),uz(:,j)
3099 cd write (iout,'(4f10.5)')
3100 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3101 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3102 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3103 cd write (iout,'(9f10.5/)')
3104 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3105 C Derivatives of the elements of A in virtual-bond vectors
3106 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3108 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3109 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3110 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3111 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3112 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3113 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3114 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3115 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3116 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3117 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3118 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3119 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3121 C Compute radial contributions to the gradient
3139 C Add the contributions coming from er
3142 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3143 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3144 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3145 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3148 C Derivatives in DC(i)
3149 cgrad ghalf1=0.5d0*agg(k,1)
3150 cgrad ghalf2=0.5d0*agg(k,2)
3151 cgrad ghalf3=0.5d0*agg(k,3)
3152 cgrad ghalf4=0.5d0*agg(k,4)
3153 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3154 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3155 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3156 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3157 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3158 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3159 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3160 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3161 C Derivatives in DC(i+1)
3162 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3163 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3164 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3165 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3166 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3167 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3168 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3169 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3170 C Derivatives in DC(j)
3171 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3172 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3173 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3174 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3175 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3176 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3177 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3178 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3179 C Derivatives in DC(j+1) or DC(nres-1)
3180 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3181 & -3.0d0*vryg(k,3)*ury)
3182 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3183 & -3.0d0*vrzg(k,3)*ury)
3184 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3185 & -3.0d0*vryg(k,3)*urz)
3186 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3187 & -3.0d0*vrzg(k,3)*urz)
3188 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3190 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3203 aggi(k,l)=-aggi(k,l)
3204 aggi1(k,l)=-aggi1(k,l)
3205 aggj(k,l)=-aggj(k,l)
3206 aggj1(k,l)=-aggj1(k,l)
3209 if (j.lt.nres-1) then
3215 aggi(k,l)=-aggi(k,l)
3216 aggi1(k,l)=-aggi1(k,l)
3217 aggj(k,l)=-aggj(k,l)
3218 aggj1(k,l)=-aggj1(k,l)
3229 aggi(k,l)=-aggi(k,l)
3230 aggi1(k,l)=-aggi1(k,l)
3231 aggj(k,l)=-aggj(k,l)
3232 aggj1(k,l)=-aggj1(k,l)
3237 IF (wel_loc.gt.0.0d0) THEN
3238 C Contribution to the local-electrostatic energy coming from the i-j pair
3239 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3241 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3243 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3244 & 'eelloc',i,j,eel_loc_ij
3246 eel_loc=eel_loc+eel_loc_ij
3247 C Partial derivatives in virtual-bond dihedral angles gamma
3249 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3250 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3251 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3252 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3253 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3254 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3255 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3257 ggg(l)=agg(l,1)*muij(1)+
3258 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3259 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3260 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3261 cgrad ghalf=0.5d0*ggg(l)
3262 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3263 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3267 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3270 C Remaining derivatives of eello
3272 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3273 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3274 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3275 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3276 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3277 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3278 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3279 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3282 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3283 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3284 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3285 & .and. num_conti.le.maxconts) then
3286 c write (iout,*) i,j," entered corr"
3288 C Calculate the contact function. The ith column of the array JCONT will
3289 C contain the numbers of atoms that make contacts with the atom I (of numbers
3290 C greater than I). The arrays FACONT and GACONT will contain the values of
3291 C the contact function and its derivative.
3292 c r0ij=1.02D0*rpp(iteli,itelj)
3293 c r0ij=1.11D0*rpp(iteli,itelj)
3294 r0ij=2.20D0*rpp(iteli,itelj)
3295 c r0ij=1.55D0*rpp(iteli,itelj)
3296 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3297 if (fcont.gt.0.0D0) then
3298 num_conti=num_conti+1
3299 if (num_conti.gt.maxconts) then
3300 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3301 & ' will skip next contacts for this conf.'
3303 jcont_hb(num_conti,i)=j
3304 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3305 cd & " jcont_hb",jcont_hb(num_conti,i)
3306 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3307 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3308 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3310 d_cont(num_conti,i)=rij
3311 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3312 C --- Electrostatic-interaction matrix ---
3313 a_chuj(1,1,num_conti,i)=a22
3314 a_chuj(1,2,num_conti,i)=a23
3315 a_chuj(2,1,num_conti,i)=a32
3316 a_chuj(2,2,num_conti,i)=a33
3317 C --- Gradient of rij
3319 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3326 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3327 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3328 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3329 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3330 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3335 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3336 C Calculate contact energies
3338 wij=cosa-3.0D0*cosb*cosg
3341 c fac3=dsqrt(-ael6i)/r0ij**3
3342 fac3=dsqrt(-ael6i)*r3ij
3343 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3344 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3345 if (ees0tmp.gt.0) then
3346 ees0pij=dsqrt(ees0tmp)
3350 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3351 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3352 if (ees0tmp.gt.0) then
3353 ees0mij=dsqrt(ees0tmp)
3358 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3359 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3360 C Diagnostics. Comment out or remove after debugging!
3361 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3362 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3363 c ees0m(num_conti,i)=0.0D0
3365 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3366 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3367 C Angular derivatives of the contact function
3368 ees0pij1=fac3/ees0pij
3369 ees0mij1=fac3/ees0mij
3370 fac3p=-3.0D0*fac3*rrmij
3371 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3372 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3374 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3375 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3376 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3377 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3378 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3379 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3380 ecosap=ecosa1+ecosa2
3381 ecosbp=ecosb1+ecosb2
3382 ecosgp=ecosg1+ecosg2
3383 ecosam=ecosa1-ecosa2
3384 ecosbm=ecosb1-ecosb2
3385 ecosgm=ecosg1-ecosg2
3394 facont_hb(num_conti,i)=fcont
3395 fprimcont=fprimcont/rij
3396 cd facont_hb(num_conti,i)=1.0D0
3397 C Following line is for diagnostics.
3400 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3401 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3404 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3405 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3407 gggp(1)=gggp(1)+ees0pijp*xj
3408 gggp(2)=gggp(2)+ees0pijp*yj
3409 gggp(3)=gggp(3)+ees0pijp*zj
3410 gggm(1)=gggm(1)+ees0mijp*xj
3411 gggm(2)=gggm(2)+ees0mijp*yj
3412 gggm(3)=gggm(3)+ees0mijp*zj
3413 C Derivatives due to the contact function
3414 gacont_hbr(1,num_conti,i)=fprimcont*xj
3415 gacont_hbr(2,num_conti,i)=fprimcont*yj
3416 gacont_hbr(3,num_conti,i)=fprimcont*zj
3419 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3420 c following the change of gradient-summation algorithm.
3422 cgrad ghalfp=0.5D0*gggp(k)
3423 cgrad ghalfm=0.5D0*gggm(k)
3424 gacontp_hb1(k,num_conti,i)=!ghalfp
3425 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3426 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3427 gacontp_hb2(k,num_conti,i)=!ghalfp
3428 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3429 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3430 gacontp_hb3(k,num_conti,i)=gggp(k)
3431 gacontm_hb1(k,num_conti,i)=!ghalfm
3432 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3433 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3434 gacontm_hb2(k,num_conti,i)=!ghalfm
3435 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3436 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3437 gacontm_hb3(k,num_conti,i)=gggm(k)
3439 C Diagnostics. Comment out or remove after debugging!
3441 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3442 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3443 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3444 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3445 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3446 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3449 endif ! num_conti.le.maxconts
3452 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3455 ghalf=0.5d0*agg(l,k)
3456 aggi(l,k)=aggi(l,k)+ghalf
3457 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3458 aggj(l,k)=aggj(l,k)+ghalf
3461 if (j.eq.nres-1 .and. i.lt.j-2) then
3464 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3469 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3472 C-----------------------------------------------------------------------------
3473 subroutine eturn3(i,eello_turn3)
3474 C Third- and fourth-order contributions from turns
3475 implicit real*8 (a-h,o-z)
3476 include 'DIMENSIONS'
3477 include 'COMMON.IOUNITS'
3478 include 'COMMON.GEO'
3479 include 'COMMON.VAR'
3480 include 'COMMON.LOCAL'
3481 include 'COMMON.CHAIN'
3482 include 'COMMON.DERIV'
3483 include 'COMMON.INTERACT'
3484 include 'COMMON.CONTACTS'
3485 include 'COMMON.TORSION'
3486 include 'COMMON.VECTORS'
3487 include 'COMMON.FFIELD'
3488 include 'COMMON.CONTROL'
3490 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3491 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3492 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3493 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3494 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3495 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3496 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3499 c write (iout,*) "eturn3",i,j,j1,j2
3504 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3506 C Third-order contributions
3513 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3514 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3515 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3516 call transpose2(auxmat(1,1),auxmat1(1,1))
3517 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3518 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3519 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3520 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3521 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3522 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3523 cd & ' eello_turn3_num',4*eello_turn3_num
3524 C Derivatives in gamma(i)
3525 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3526 call transpose2(auxmat2(1,1),auxmat3(1,1))
3527 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3528 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3529 C Derivatives in gamma(i+1)
3530 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3531 call transpose2(auxmat2(1,1),auxmat3(1,1))
3532 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3533 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3534 & +0.5d0*(pizda(1,1)+pizda(2,2))
3535 C Cartesian derivatives
3537 c ghalf1=0.5d0*agg(l,1)
3538 c ghalf2=0.5d0*agg(l,2)
3539 c ghalf3=0.5d0*agg(l,3)
3540 c ghalf4=0.5d0*agg(l,4)
3541 a_temp(1,1)=aggi(l,1)!+ghalf1
3542 a_temp(1,2)=aggi(l,2)!+ghalf2
3543 a_temp(2,1)=aggi(l,3)!+ghalf3
3544 a_temp(2,2)=aggi(l,4)!+ghalf4
3545 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3546 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3547 & +0.5d0*(pizda(1,1)+pizda(2,2))
3548 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3549 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3550 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3551 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3552 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3553 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3554 & +0.5d0*(pizda(1,1)+pizda(2,2))
3555 a_temp(1,1)=aggj(l,1)!+ghalf1
3556 a_temp(1,2)=aggj(l,2)!+ghalf2
3557 a_temp(2,1)=aggj(l,3)!+ghalf3
3558 a_temp(2,2)=aggj(l,4)!+ghalf4
3559 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3560 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3561 & +0.5d0*(pizda(1,1)+pizda(2,2))
3562 a_temp(1,1)=aggj1(l,1)
3563 a_temp(1,2)=aggj1(l,2)
3564 a_temp(2,1)=aggj1(l,3)
3565 a_temp(2,2)=aggj1(l,4)
3566 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3567 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3568 & +0.5d0*(pizda(1,1)+pizda(2,2))
3572 C-------------------------------------------------------------------------------
3573 subroutine eturn4(i,eello_turn4)
3574 C Third- and fourth-order contributions from turns
3575 implicit real*8 (a-h,o-z)
3576 include 'DIMENSIONS'
3577 include 'COMMON.IOUNITS'
3578 include 'COMMON.GEO'
3579 include 'COMMON.VAR'
3580 include 'COMMON.LOCAL'
3581 include 'COMMON.CHAIN'
3582 include 'COMMON.DERIV'
3583 include 'COMMON.INTERACT'
3584 include 'COMMON.CONTACTS'
3585 include 'COMMON.TORSION'
3586 include 'COMMON.VECTORS'
3587 include 'COMMON.FFIELD'
3588 include 'COMMON.CONTROL'
3590 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3591 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3592 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3593 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3594 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3595 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3596 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3599 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3601 C Fourth-order contributions
3609 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3610 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3611 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3616 iti1=itortyp(itype(i+1))
3617 iti2=itortyp(itype(i+2))
3618 iti3=itortyp(itype(i+3))
3619 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3620 call transpose2(EUg(1,1,i+1),e1t(1,1))
3621 call transpose2(Eug(1,1,i+2),e2t(1,1))
3622 call transpose2(Eug(1,1,i+3),e3t(1,1))
3623 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3624 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3625 s1=scalar2(b1(1,iti2),auxvec(1))
3626 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3627 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3628 s2=scalar2(b1(1,iti1),auxvec(1))
3629 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3630 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3631 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3632 eello_turn4=eello_turn4-(s1+s2+s3)
3633 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3634 & 'eturn4',i,j,-(s1+s2+s3)
3635 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3636 cd & ' eello_turn4_num',8*eello_turn4_num
3637 C Derivatives in gamma(i)
3638 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3639 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3640 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3641 s1=scalar2(b1(1,iti2),auxvec(1))
3642 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3643 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3644 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3645 C Derivatives in gamma(i+1)
3646 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3647 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3648 s2=scalar2(b1(1,iti1),auxvec(1))
3649 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3650 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3651 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3652 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3653 C Derivatives in gamma(i+2)
3654 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3655 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3656 s1=scalar2(b1(1,iti2),auxvec(1))
3657 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3658 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3659 s2=scalar2(b1(1,iti1),auxvec(1))
3660 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3661 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3662 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3663 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3664 C Cartesian derivatives
3665 C Derivatives of this turn contributions in DC(i+2)
3666 if (j.lt.nres-1) then
3668 a_temp(1,1)=agg(l,1)
3669 a_temp(1,2)=agg(l,2)
3670 a_temp(2,1)=agg(l,3)
3671 a_temp(2,2)=agg(l,4)
3672 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3673 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3674 s1=scalar2(b1(1,iti2),auxvec(1))
3675 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3676 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3677 s2=scalar2(b1(1,iti1),auxvec(1))
3678 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3679 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3680 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3682 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3685 C Remaining derivatives of this turn contribution
3687 a_temp(1,1)=aggi(l,1)
3688 a_temp(1,2)=aggi(l,2)
3689 a_temp(2,1)=aggi(l,3)
3690 a_temp(2,2)=aggi(l,4)
3691 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3692 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3693 s1=scalar2(b1(1,iti2),auxvec(1))
3694 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3695 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3696 s2=scalar2(b1(1,iti1),auxvec(1))
3697 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3698 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3699 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3700 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3701 a_temp(1,1)=aggi1(l,1)
3702 a_temp(1,2)=aggi1(l,2)
3703 a_temp(2,1)=aggi1(l,3)
3704 a_temp(2,2)=aggi1(l,4)
3705 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3706 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3707 s1=scalar2(b1(1,iti2),auxvec(1))
3708 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3709 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3710 s2=scalar2(b1(1,iti1),auxvec(1))
3711 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3712 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3713 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3714 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3715 a_temp(1,1)=aggj(l,1)
3716 a_temp(1,2)=aggj(l,2)
3717 a_temp(2,1)=aggj(l,3)
3718 a_temp(2,2)=aggj(l,4)
3719 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3720 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3721 s1=scalar2(b1(1,iti2),auxvec(1))
3722 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3723 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3724 s2=scalar2(b1(1,iti1),auxvec(1))
3725 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3726 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3727 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3728 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3729 a_temp(1,1)=aggj1(l,1)
3730 a_temp(1,2)=aggj1(l,2)
3731 a_temp(2,1)=aggj1(l,3)
3732 a_temp(2,2)=aggj1(l,4)
3733 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3734 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3735 s1=scalar2(b1(1,iti2),auxvec(1))
3736 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3737 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3738 s2=scalar2(b1(1,iti1),auxvec(1))
3739 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3740 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3741 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3742 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3743 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3747 C-----------------------------------------------------------------------------
3748 subroutine vecpr(u,v,w)
3749 implicit real*8(a-h,o-z)
3750 dimension u(3),v(3),w(3)
3751 w(1)=u(2)*v(3)-u(3)*v(2)
3752 w(2)=-u(1)*v(3)+u(3)*v(1)
3753 w(3)=u(1)*v(2)-u(2)*v(1)
3756 C-----------------------------------------------------------------------------
3757 subroutine unormderiv(u,ugrad,unorm,ungrad)
3758 C This subroutine computes the derivatives of a normalized vector u, given
3759 C the derivatives computed without normalization conditions, ugrad. Returns
3762 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3763 double precision vec(3)
3764 double precision scalar
3766 c write (2,*) 'ugrad',ugrad
3769 vec(i)=scalar(ugrad(1,i),u(1))
3771 c write (2,*) 'vec',vec
3774 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3777 c write (2,*) 'ungrad',ungrad
3780 C-----------------------------------------------------------------------------
3781 subroutine escp_soft_sphere(evdw2,evdw2_14)
3783 C This subroutine calculates the excluded-volume interaction energy between
3784 C peptide-group centers and side chains and its gradient in virtual-bond and
3785 C side-chain vectors.
3787 implicit real*8 (a-h,o-z)
3788 include 'DIMENSIONS'
3789 include 'COMMON.GEO'
3790 include 'COMMON.VAR'
3791 include 'COMMON.LOCAL'
3792 include 'COMMON.CHAIN'
3793 include 'COMMON.DERIV'
3794 include 'COMMON.INTERACT'
3795 include 'COMMON.FFIELD'
3796 include 'COMMON.IOUNITS'
3797 include 'COMMON.CONTROL'
3802 cd print '(a)','Enter ESCP'
3803 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3804 do i=iatscp_s,iatscp_e
3805 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3807 xi=0.5D0*(c(1,i)+c(1,i+1))
3808 yi=0.5D0*(c(2,i)+c(2,i+1))
3809 zi=0.5D0*(c(3,i)+c(3,i+1))
3811 do iint=1,nscp_gr(i)
3813 do j=iscpstart(i,iint),iscpend(i,iint)
3814 if (itype(j).eq.ntyp1) cycle
3815 itypj=iabs(itype(j))
3816 C Uncomment following three lines for SC-p interactions
3820 C Uncomment following three lines for Ca-p interactions
3824 rij=xj*xj+yj*yj+zj*zj
3827 if (rij.lt.r0ijsq) then
3828 evdwij=0.25d0*(rij-r0ijsq)**2
3836 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3841 cgrad if (j.lt.i) then
3842 cd write (iout,*) 'j<i'
3843 C Uncomment following three lines for SC-p interactions
3845 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3848 cd write (iout,*) 'j>i'
3850 cgrad ggg(k)=-ggg(k)
3851 C Uncomment following line for SC-p interactions
3852 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3856 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3858 cgrad kstart=min0(i+1,j)
3859 cgrad kend=max0(i-1,j-1)
3860 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3861 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3862 cgrad do k=kstart,kend
3864 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3868 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
3869 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
3877 C-----------------------------------------------------------------------------
3878 subroutine escp(evdw2,evdw2_14)
3880 C This subroutine calculates the excluded-volume interaction energy between
3881 C peptide-group centers and side chains and its gradient in virtual-bond and
3882 C side-chain vectors.
3884 implicit real*8 (a-h,o-z)
3885 include 'DIMENSIONS'
3886 include 'COMMON.GEO'
3887 include 'COMMON.VAR'
3888 include 'COMMON.LOCAL'
3889 include 'COMMON.CHAIN'
3890 include 'COMMON.DERIV'
3891 include 'COMMON.INTERACT'
3892 include 'COMMON.FFIELD'
3893 include 'COMMON.IOUNITS'
3894 include 'COMMON.CONTROL'
3898 cd print '(a)','Enter ESCP'
3899 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
3900 do i=iatscp_s,iatscp_e
3901 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
3903 xi=0.5D0*(c(1,i)+c(1,i+1))
3904 yi=0.5D0*(c(2,i)+c(2,i+1))
3905 zi=0.5D0*(c(3,i)+c(3,i+1))
3907 do iint=1,nscp_gr(i)
3909 do j=iscpstart(i,iint),iscpend(i,iint)
3910 itypj=iabs(itype(j))
3911 if (itypj.eq.ntyp1) cycle
3912 C Uncomment following three lines for SC-p interactions
3916 C Uncomment following three lines for Ca-p interactions
3920 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
3922 e1=fac*fac*aad(itypj,iteli)
3923 e2=fac*bad(itypj,iteli)
3924 if (iabs(j-i) .le. 2) then
3927 evdw2_14=evdw2_14+e1+e2
3931 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3932 & 'evdw2',i,j,evdwij
3934 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
3936 fac=-(evdwij+e1)*rrij
3940 cgrad if (j.lt.i) then
3941 cd write (iout,*) 'j<i'
3942 C Uncomment following three lines for SC-p interactions
3944 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3947 cd write (iout,*) 'j>i'
3949 cgrad ggg(k)=-ggg(k)
3950 C Uncomment following line for SC-p interactions
3951 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
3952 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
3956 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
3958 cgrad kstart=min0(i+1,j)
3959 cgrad kend=max0(i-1,j-1)
3960 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
3961 cd write (iout,*) ggg(1),ggg(2),ggg(3)
3962 cgrad do k=kstart,kend
3964 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
3968 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
3969 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
3977 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
3978 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
3979 gradx_scp(j,i)=expon*gradx_scp(j,i)
3982 C******************************************************************************
3986 C To save time the factor EXPON has been extracted from ALL components
3987 C of GVDWC and GRADX. Remember to multiply them by this factor before further
3990 C******************************************************************************
3993 C--------------------------------------------------------------------------
3994 subroutine edis(ehpb)
3996 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
3998 implicit real*8 (a-h,o-z)
3999 include 'DIMENSIONS'
4000 include 'COMMON.SBRIDGE'
4001 include 'COMMON.CHAIN'
4002 include 'COMMON.DERIV'
4003 include 'COMMON.VAR'
4004 include 'COMMON.INTERACT'
4005 include 'COMMON.IOUNITS'
4008 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4009 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4010 if (link_end.eq.0) return
4011 do i=link_start,link_end
4012 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4013 C CA-CA distance used in regularization of structure.
4016 C iii and jjj point to the residues for which the distance is assigned.
4017 if (ii.gt.nres) then
4024 cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj
4025 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4026 C distance and angle dependent SS bond potential.
4027 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4028 & iabs(itype(jjj)).eq.1) then
4029 call ssbond_ene(iii,jjj,eij)
4031 cd write (iout,*) "eij",eij
4033 C Calculate the distance between the two points and its difference from the
4037 C Get the force constant corresponding to this distance.
4039 C Calculate the contribution to energy.
4040 ehpb=ehpb+waga*rdis*rdis
4042 C Evaluate gradient.
4045 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4046 cd & ' waga=',waga,' fac=',fac
4048 ggg(j)=fac*(c(j,jj)-c(j,ii))
4050 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4051 C If this is a SC-SC distance, we need to calculate the contributions to the
4052 C Cartesian gradient in the SC vectors (ghpbx).
4055 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4056 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4059 cgrad do j=iii,jjj-1
4061 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4065 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4066 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4073 C--------------------------------------------------------------------------
4074 subroutine ssbond_ene(i,j,eij)
4076 C Calculate the distance and angle dependent SS-bond potential energy
4077 C using a free-energy function derived based on RHF/6-31G** ab initio
4078 C calculations of diethyl disulfide.
4080 C A. Liwo and U. Kozlowska, 11/24/03
4082 implicit real*8 (a-h,o-z)
4083 include 'DIMENSIONS'
4084 include 'COMMON.SBRIDGE'
4085 include 'COMMON.CHAIN'
4086 include 'COMMON.DERIV'
4087 include 'COMMON.LOCAL'
4088 include 'COMMON.INTERACT'
4089 include 'COMMON.VAR'
4090 include 'COMMON.IOUNITS'
4091 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4092 itypi=iabs(itype(i))
4096 dxi=dc_norm(1,nres+i)
4097 dyi=dc_norm(2,nres+i)
4098 dzi=dc_norm(3,nres+i)
4099 c dsci_inv=dsc_inv(itypi)
4100 dsci_inv=vbld_inv(nres+i)
4101 itypj=iabs(itype(j))
4102 c dscj_inv=dsc_inv(itypj)
4103 dscj_inv=vbld_inv(nres+j)
4107 dxj=dc_norm(1,nres+j)
4108 dyj=dc_norm(2,nres+j)
4109 dzj=dc_norm(3,nres+j)
4110 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4115 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4116 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4117 om12=dxi*dxj+dyi*dyj+dzi*dzj
4119 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4120 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4126 deltat12=om2-om1+2.0d0
4128 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4129 & +akct*deltad*deltat12
4130 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4131 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4132 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4133 c & " deltat12",deltat12," eij",eij
4134 ed=2*akcm*deltad+akct*deltat12
4136 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4137 eom1=-2*akth*deltat1-pom1-om2*pom2
4138 eom2= 2*akth*deltat2+pom1-om1*pom2
4141 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4142 ghpbx(k,i)=ghpbx(k,i)-ggk
4143 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4144 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4145 ghpbx(k,j)=ghpbx(k,j)+ggk
4146 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4147 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4148 ghpbc(k,i)=ghpbc(k,i)-ggk
4149 ghpbc(k,j)=ghpbc(k,j)+ggk
4152 C Calculate the components of the gradient in DC and X
4156 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4161 C--------------------------------------------------------------------------
4162 subroutine ebond(estr)
4164 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4166 implicit real*8 (a-h,o-z)
4167 include 'DIMENSIONS'
4168 include 'COMMON.LOCAL'
4169 include 'COMMON.GEO'
4170 include 'COMMON.INTERACT'
4171 include 'COMMON.DERIV'
4172 include 'COMMON.VAR'
4173 include 'COMMON.CHAIN'
4174 include 'COMMON.IOUNITS'
4175 include 'COMMON.NAMES'
4176 include 'COMMON.FFIELD'
4177 include 'COMMON.CONTROL'
4178 include 'COMMON.SETUP'
4179 double precision u(3),ud(3)
4182 do i=ibondp_start,ibondp_end
4183 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4184 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4186 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4187 & *dc(j,i-1)/vbld(i)
4189 if (energy_dec) write(iout,*)
4190 & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4192 diff = vbld(i)-vbldp0
4193 if (energy_dec) write (iout,*)
4194 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4197 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4199 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4202 estr=0.5d0*AKP*estr+estr1
4204 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4206 do i=ibond_start,ibond_end
4208 if (iti.ne.10 .and. iti.ne.ntyp1) then
4211 diff=vbld(i+nres)-vbldsc0(1,iti)
4212 if (energy_dec) write (iout,*)
4213 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4214 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4215 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4217 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4221 diff=vbld(i+nres)-vbldsc0(j,iti)
4222 ud(j)=aksc(j,iti)*diff
4223 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4237 uprod2=uprod2*u(k)*u(k)
4241 usumsqder=usumsqder+ud(j)*uprod2
4243 estr=estr+uprod/usum
4245 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4253 C--------------------------------------------------------------------------
4254 subroutine ebend(etheta)
4256 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4257 C angles gamma and its derivatives in consecutive thetas and gammas.
4259 implicit real*8 (a-h,o-z)
4260 include 'DIMENSIONS'
4261 include 'COMMON.LOCAL'
4262 include 'COMMON.GEO'
4263 include 'COMMON.INTERACT'
4264 include 'COMMON.DERIV'
4265 include 'COMMON.VAR'
4266 include 'COMMON.CHAIN'
4267 include 'COMMON.IOUNITS'
4268 include 'COMMON.NAMES'
4269 include 'COMMON.FFIELD'
4270 include 'COMMON.CONTROL'
4271 common /calcthet/ term1,term2,termm,diffak,ratak,
4272 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4273 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4274 double precision y(2),z(2)
4276 c time11=dexp(-2*time)
4279 c write (*,'(a,i2)') 'EBEND ICG=',icg
4280 do i=ithet_start,ithet_end
4281 if (itype(i-1).eq.ntyp1) cycle
4282 C Zero the energy function and its derivative at 0 or pi.
4283 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4285 ichir1=isign(1,itype(i-2))
4286 ichir2=isign(1,itype(i))
4287 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4288 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4289 if (itype(i-1).eq.10) then
4290 itype1=isign(10,itype(i-2))
4291 ichir11=isign(1,itype(i-2))
4292 ichir12=isign(1,itype(i-2))
4293 itype2=isign(10,itype(i))
4294 ichir21=isign(1,itype(i))
4295 ichir22=isign(1,itype(i))
4298 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4301 if (phii.ne.phii) phii=150.0
4311 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4314 if (phii1.ne.phii1) phii1=150.0
4326 C Calculate the "mean" value of theta from the part of the distribution
4327 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4328 C In following comments this theta will be referred to as t_c.
4329 thet_pred_mean=0.0d0
4331 athetk=athet(k,it,ichir1,ichir2)
4332 bthetk=bthet(k,it,ichir1,ichir2)
4334 athetk=athet(k,itype1,ichir11,ichir12)
4335 bthetk=bthet(k,itype2,ichir21,ichir22)
4337 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4339 dthett=thet_pred_mean*ssd
4340 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4341 C Derivatives of the "mean" values in gamma1 and gamma2.
4342 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4343 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4344 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4345 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4347 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4348 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4349 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4350 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4352 if (theta(i).gt.pi-delta) then
4353 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4355 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4356 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4357 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4359 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4361 else if (theta(i).lt.delta) then
4362 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4363 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4364 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4366 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4367 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4370 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4373 etheta=etheta+ethetai
4374 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4376 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4377 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4378 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4380 C Ufff.... We've done all this!!!
4383 C---------------------------------------------------------------------------
4384 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4386 implicit real*8 (a-h,o-z)
4387 include 'DIMENSIONS'
4388 include 'COMMON.LOCAL'
4389 include 'COMMON.IOUNITS'
4390 common /calcthet/ term1,term2,termm,diffak,ratak,
4391 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4392 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4393 C Calculate the contributions to both Gaussian lobes.
4394 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4395 C The "polynomial part" of the "standard deviation" of this part of
4399 sig=sig*thet_pred_mean+polthet(j,it)
4401 C Derivative of the "interior part" of the "standard deviation of the"
4402 C gamma-dependent Gaussian lobe in t_c.
4403 sigtc=3*polthet(3,it)
4405 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4408 C Set the parameters of both Gaussian lobes of the distribution.
4409 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4410 fac=sig*sig+sigc0(it)
4413 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4414 sigsqtc=-4.0D0*sigcsq*sigtc
4415 c print *,i,sig,sigtc,sigsqtc
4416 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4417 sigtc=-sigtc/(fac*fac)
4418 C Following variable is sigma(t_c)**(-2)
4419 sigcsq=sigcsq*sigcsq
4421 sig0inv=1.0D0/sig0i**2
4422 delthec=thetai-thet_pred_mean
4423 delthe0=thetai-theta0i
4424 term1=-0.5D0*sigcsq*delthec*delthec
4425 term2=-0.5D0*sig0inv*delthe0*delthe0
4426 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4427 C NaNs in taking the logarithm. We extract the largest exponent which is added
4428 C to the energy (this being the log of the distribution) at the end of energy
4429 C term evaluation for this virtual-bond angle.
4430 if (term1.gt.term2) then
4432 term2=dexp(term2-termm)
4436 term1=dexp(term1-termm)
4439 C The ratio between the gamma-independent and gamma-dependent lobes of
4440 C the distribution is a Gaussian function of thet_pred_mean too.
4441 diffak=gthet(2,it)-thet_pred_mean
4442 ratak=diffak/gthet(3,it)**2
4443 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4444 C Let's differentiate it in thet_pred_mean NOW.
4446 C Now put together the distribution terms to make complete distribution.
4447 termexp=term1+ak*term2
4448 termpre=sigc+ak*sig0i
4449 C Contribution of the bending energy from this theta is just the -log of
4450 C the sum of the contributions from the two lobes and the pre-exponential
4451 C factor. Simple enough, isn't it?
4452 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4453 C NOW the derivatives!!!
4454 C 6/6/97 Take into account the deformation.
4455 E_theta=(delthec*sigcsq*term1
4456 & +ak*delthe0*sig0inv*term2)/termexp
4457 E_tc=((sigtc+aktc*sig0i)/termpre
4458 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4459 & aktc*term2)/termexp)
4462 c-----------------------------------------------------------------------------
4463 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4464 implicit real*8 (a-h,o-z)
4465 include 'DIMENSIONS'
4466 include 'COMMON.LOCAL'
4467 include 'COMMON.IOUNITS'
4468 common /calcthet/ term1,term2,termm,diffak,ratak,
4469 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4470 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4471 delthec=thetai-thet_pred_mean
4472 delthe0=thetai-theta0i
4473 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4474 t3 = thetai-thet_pred_mean
4478 t14 = t12+t6*sigsqtc
4480 t21 = thetai-theta0i
4486 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4487 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4488 & *(-t12*t9-ak*sig0inv*t27)
4492 C--------------------------------------------------------------------------
4493 subroutine ebend(etheta)
4495 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4496 C angles gamma and its derivatives in consecutive thetas and gammas.
4497 C ab initio-derived potentials from
4498 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4500 implicit real*8 (a-h,o-z)
4501 include 'DIMENSIONS'
4502 include 'COMMON.LOCAL'
4503 include 'COMMON.GEO'
4504 include 'COMMON.INTERACT'
4505 include 'COMMON.DERIV'
4506 include 'COMMON.VAR'
4507 include 'COMMON.CHAIN'
4508 include 'COMMON.IOUNITS'
4509 include 'COMMON.NAMES'
4510 include 'COMMON.FFIELD'
4511 include 'COMMON.CONTROL'
4512 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4513 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4514 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4515 & sinph1ph2(maxdouble,maxdouble)
4516 logical lprn /.false./, lprn1 /.false./
4518 do i=ithet_start,ithet_end
4519 if (itype(i-1).eq.ntyp1) cycle
4523 theti2=0.5d0*theta(i)
4524 ityp2=ithetyp(iabs(itype(i-1)))
4526 coskt(k)=dcos(k*theti2)
4527 sinkt(k)=dsin(k*theti2)
4529 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4532 if (phii.ne.phii) phii=150.0
4536 ityp1=ithetyp(iabs(itype(i-2)))
4538 cosph1(k)=dcos(k*phii)
4539 sinph1(k)=dsin(k*phii)
4549 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4552 if (phii1.ne.phii1) phii1=150.0
4557 ityp3=ithetyp(iabs(itype(i)))
4559 cosph2(k)=dcos(k*phii1)
4560 sinph2(k)=dsin(k*phii1)
4570 ethetai=aa0thet(ityp1,ityp2,ityp3)
4573 ccl=cosph1(l)*cosph2(k-l)
4574 ssl=sinph1(l)*sinph2(k-l)
4575 scl=sinph1(l)*cosph2(k-l)
4576 csl=cosph1(l)*sinph2(k-l)
4577 cosph1ph2(l,k)=ccl-ssl
4578 cosph1ph2(k,l)=ccl+ssl
4579 sinph1ph2(l,k)=scl+csl
4580 sinph1ph2(k,l)=scl-csl
4584 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4585 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4586 write (iout,*) "coskt and sinkt"
4588 write (iout,*) k,coskt(k),sinkt(k)
4592 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4593 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4596 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4597 & " ethetai",ethetai
4600 write (iout,*) "cosph and sinph"
4602 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4604 write (iout,*) "cosph1ph2 and sinph2ph2"
4607 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4608 & sinph1ph2(l,k),sinph1ph2(k,l)
4611 write(iout,*) "ethetai",ethetai
4615 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4616 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4617 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4618 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4619 ethetai=ethetai+sinkt(m)*aux
4620 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4621 dephii=dephii+k*sinkt(m)*(
4622 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4623 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4624 dephii1=dephii1+k*sinkt(m)*(
4625 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4626 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4628 & write (iout,*) "m",m," k",k," bbthet",
4629 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4630 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4631 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4632 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4636 & write(iout,*) "ethetai",ethetai
4640 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4641 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4642 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4643 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4644 ethetai=ethetai+sinkt(m)*aux
4645 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4646 dephii=dephii+l*sinkt(m)*(
4647 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4648 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4649 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4650 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4651 dephii1=dephii1+(k-l)*sinkt(m)*(
4652 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4653 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4654 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4655 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4657 write (iout,*) "m",m," k",k," l",l," ffthet",
4658 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4659 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4660 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4661 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4662 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4663 & cosph1ph2(k,l)*sinkt(m),
4664 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4670 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4671 & i,theta(i)*rad2deg,phii*rad2deg,
4672 & phii1*rad2deg,ethetai
4673 etheta=etheta+ethetai
4674 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4675 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4676 gloc(nphi+i-2,icg)=wang*dethetai
4682 c-----------------------------------------------------------------------------
4683 subroutine esc(escloc)
4684 C Calculate the local energy of a side chain and its derivatives in the
4685 C corresponding virtual-bond valence angles THETA and the spherical angles
4687 implicit real*8 (a-h,o-z)
4688 include 'DIMENSIONS'
4689 include 'COMMON.GEO'
4690 include 'COMMON.LOCAL'
4691 include 'COMMON.VAR'
4692 include 'COMMON.INTERACT'
4693 include 'COMMON.DERIV'
4694 include 'COMMON.CHAIN'
4695 include 'COMMON.IOUNITS'
4696 include 'COMMON.NAMES'
4697 include 'COMMON.FFIELD'
4698 include 'COMMON.CONTROL'
4699 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4700 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4701 common /sccalc/ time11,time12,time112,theti,it,nlobit
4704 c write (iout,'(a)') 'ESC'
4705 do i=loc_start,loc_end
4707 if (it.eq.ntyp1) cycle
4708 if (it.eq.10) goto 1
4709 nlobit=nlob(iabs(it))
4710 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4711 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4712 theti=theta(i+1)-pipol
4717 if (x(2).gt.pi-delta) then
4721 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4723 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4724 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4726 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4727 & ddersc0(1),dersc(1))
4728 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4729 & ddersc0(3),dersc(3))
4731 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4733 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4734 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4735 & dersc0(2),esclocbi,dersc02)
4736 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4738 call splinthet(x(2),0.5d0*delta,ss,ssd)
4743 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4745 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4746 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4748 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4750 c write (iout,*) escloci
4751 else if (x(2).lt.delta) then
4755 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4757 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4758 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4760 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4761 & ddersc0(1),dersc(1))
4762 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4763 & ddersc0(3),dersc(3))
4765 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4767 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4768 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4769 & dersc0(2),esclocbi,dersc02)
4770 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4775 call splinthet(x(2),0.5d0*delta,ss,ssd)
4777 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4779 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4780 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4782 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4783 c write (iout,*) escloci
4785 call enesc(x,escloci,dersc,ddummy,.false.)
4788 escloc=escloc+escloci
4789 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4790 & 'escloc',i,escloci
4791 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4793 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4795 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4796 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4801 C---------------------------------------------------------------------------
4802 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4803 implicit real*8 (a-h,o-z)
4804 include 'DIMENSIONS'
4805 include 'COMMON.GEO'
4806 include 'COMMON.LOCAL'
4807 include 'COMMON.IOUNITS'
4808 common /sccalc/ time11,time12,time112,theti,it,nlobit
4809 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4810 double precision contr(maxlob,-1:1)
4812 c write (iout,*) 'it=',it,' nlobit=',nlobit
4816 if (mixed) ddersc(j)=0.0d0
4820 C Because of periodicity of the dependence of the SC energy in omega we have
4821 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4822 C To avoid underflows, first compute & store the exponents.
4830 z(k)=x(k)-censc(k,j,it)
4835 Axk=Axk+gaussc(l,k,j,it)*z(l)
4841 expfac=expfac+Ax(k,j,iii)*z(k)
4849 C As in the case of ebend, we want to avoid underflows in exponentiation and
4850 C subsequent NaNs and INFs in energy calculation.
4851 C Find the largest exponent
4855 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
4859 cd print *,'it=',it,' emin=',emin
4861 C Compute the contribution to SC energy and derivatives
4866 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
4867 if(adexp.ne.adexp) adexp=1.0
4870 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
4872 cd print *,'j=',j,' expfac=',expfac
4873 escloc_i=escloc_i+expfac
4875 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
4879 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
4880 & +gaussc(k,2,j,it))*expfac
4887 dersc(1)=dersc(1)/cos(theti)**2
4888 ddersc(1)=ddersc(1)/cos(theti)**2
4891 escloci=-(dlog(escloc_i)-emin)
4893 dersc(j)=dersc(j)/escloc_i
4897 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
4902 C------------------------------------------------------------------------------
4903 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
4904 implicit real*8 (a-h,o-z)
4905 include 'DIMENSIONS'
4906 include 'COMMON.GEO'
4907 include 'COMMON.LOCAL'
4908 include 'COMMON.IOUNITS'
4909 common /sccalc/ time11,time12,time112,theti,it,nlobit
4910 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
4911 double precision contr(maxlob)
4922 z(k)=x(k)-censc(k,j,it)
4928 Axk=Axk+gaussc(l,k,j,it)*z(l)
4934 expfac=expfac+Ax(k,j)*z(k)
4939 C As in the case of ebend, we want to avoid underflows in exponentiation and
4940 C subsequent NaNs and INFs in energy calculation.
4941 C Find the largest exponent
4944 if (emin.gt.contr(j)) emin=contr(j)
4948 C Compute the contribution to SC energy and derivatives
4952 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
4953 escloc_i=escloc_i+expfac
4955 dersc(k)=dersc(k)+Ax(k,j)*expfac
4957 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
4958 & +gaussc(1,2,j,it))*expfac
4962 dersc(1)=dersc(1)/cos(theti)**2
4963 dersc12=dersc12/cos(theti)**2
4964 escloci=-(dlog(escloc_i)-emin)
4966 dersc(j)=dersc(j)/escloc_i
4968 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
4972 c----------------------------------------------------------------------------------
4973 subroutine esc(escloc)
4974 C Calculate the local energy of a side chain and its derivatives in the
4975 C corresponding virtual-bond valence angles THETA and the spherical angles
4976 C ALPHA and OMEGA derived from AM1 all-atom calculations.
4977 C added by Urszula Kozlowska. 07/11/2007
4979 implicit real*8 (a-h,o-z)
4980 include 'DIMENSIONS'
4981 include 'COMMON.GEO'
4982 include 'COMMON.LOCAL'
4983 include 'COMMON.VAR'
4984 include 'COMMON.SCROT'
4985 include 'COMMON.INTERACT'
4986 include 'COMMON.DERIV'
4987 include 'COMMON.CHAIN'
4988 include 'COMMON.IOUNITS'
4989 include 'COMMON.NAMES'
4990 include 'COMMON.FFIELD'
4991 include 'COMMON.CONTROL'
4992 include 'COMMON.VECTORS'
4993 double precision x_prime(3),y_prime(3),z_prime(3)
4994 & , sumene,dsc_i,dp2_i,x(65),
4995 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
4996 & de_dxx,de_dyy,de_dzz,de_dt
4997 double precision s1_t,s1_6_t,s2_t,s2_6_t
4999 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5000 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5001 & dt_dCi(3),dt_dCi1(3)
5002 common /sccalc/ time11,time12,time112,theti,it,nlobit
5005 do i=loc_start,loc_end
5006 if (itype(i).eq.ntyp1) cycle
5007 costtab(i+1) =dcos(theta(i+1))
5008 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5009 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5010 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5011 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5012 cosfac=dsqrt(cosfac2)
5013 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5014 sinfac=dsqrt(sinfac2)
5016 if (it.eq.10) goto 1
5018 C Compute the axes of tghe local cartesian coordinates system; store in
5019 c x_prime, y_prime and z_prime
5026 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5027 C & dc_norm(3,i+nres)
5029 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5030 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5033 z_prime(j) = -uz(j,i-1)
5036 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5037 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5038 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5039 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5040 c & " xy",scalar(x_prime(1),y_prime(1)),
5041 c & " xz",scalar(x_prime(1),z_prime(1)),
5042 c & " yy",scalar(y_prime(1),y_prime(1)),
5043 c & " yz",scalar(y_prime(1),z_prime(1)),
5044 c & " zz",scalar(z_prime(1),z_prime(1))
5046 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5047 C to local coordinate system. Store in xx, yy, zz.
5053 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5054 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5055 zz = zz + dsign(1.0,itype(i))*z_prime(j)*dc_norm(j,i+nres)
5062 C Compute the energy of the ith side cbain
5064 c write (2,*) "xx",xx," yy",yy," zz",zz
5067 x(j) = sc_parmin(j,it)
5070 Cc diagnostics - remove later
5072 yy1 = dsin(alph(2))*dcos(omeg(2))
5073 zz1 = -dsign(1.0,itype(i))*dsin(alph(2))*dsin(omeg(2))
5074 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5075 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5077 C," --- ", xx_w,yy_w,zz_w
5080 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5081 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5083 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5084 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5086 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5087 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5088 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5089 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5090 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5092 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5093 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5094 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5095 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5096 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5098 dsc_i = 0.743d0+x(61)
5100 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5101 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5102 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5103 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5104 s1=(1+x(63))/(0.1d0 + dscp1)
5105 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5106 s2=(1+x(65))/(0.1d0 + dscp2)
5107 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5108 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5109 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5110 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5112 c & dscp1,dscp2,sumene
5113 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5114 escloc = escloc + sumene
5115 c write (2,*) "i",i," escloc",sumene,escloc
5118 C This section to check the numerical derivatives of the energy of ith side
5119 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5120 C #define DEBUG in the code to turn it on.
5122 write (2,*) "sumene =",sumene
5126 write (2,*) xx,yy,zz
5127 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5128 de_dxx_num=(sumenep-sumene)/aincr
5130 write (2,*) "xx+ sumene from enesc=",sumenep
5133 write (2,*) xx,yy,zz
5134 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5135 de_dyy_num=(sumenep-sumene)/aincr
5137 write (2,*) "yy+ sumene from enesc=",sumenep
5140 write (2,*) xx,yy,zz
5141 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5142 de_dzz_num=(sumenep-sumene)/aincr
5144 write (2,*) "zz+ sumene from enesc=",sumenep
5145 costsave=cost2tab(i+1)
5146 sintsave=sint2tab(i+1)
5147 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5148 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5149 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5150 de_dt_num=(sumenep-sumene)/aincr
5151 write (2,*) " t+ sumene from enesc=",sumenep
5152 cost2tab(i+1)=costsave
5153 sint2tab(i+1)=sintsave
5154 C End of diagnostics section.
5157 C Compute the gradient of esc
5159 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5160 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5161 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5162 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5163 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5164 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5165 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5166 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5167 pom1=(sumene3*sint2tab(i+1)+sumene1)
5168 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5169 pom2=(sumene4*cost2tab(i+1)+sumene2)
5170 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5171 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5172 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5173 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5175 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5176 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5177 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5179 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5180 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5181 & +(pom1+pom2)*pom_dx
5183 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5186 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5187 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5188 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5190 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5191 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5192 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5193 & +x(59)*zz**2 +x(60)*xx*zz
5194 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5195 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5196 & +(pom1-pom2)*pom_dy
5198 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5201 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5202 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5203 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5204 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5205 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5206 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5207 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5208 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5210 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5213 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5214 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5215 & +pom1*pom_dt1+pom2*pom_dt2
5217 write(2,*), "de_dt = ", de_dt,de_dt_num
5221 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5222 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5223 cosfac2xx=cosfac2*xx
5224 sinfac2yy=sinfac2*yy
5226 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5228 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5230 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5231 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5232 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5233 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5234 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5235 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5236 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5237 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5238 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5239 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5243 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5244 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5247 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5248 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5249 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5251 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5252 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5256 dXX_Ctab(k,i)=dXX_Ci(k)
5257 dXX_C1tab(k,i)=dXX_Ci1(k)
5258 dYY_Ctab(k,i)=dYY_Ci(k)
5259 dYY_C1tab(k,i)=dYY_Ci1(k)
5260 dZZ_Ctab(k,i)=dZZ_Ci(k)
5261 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5262 dXX_XYZtab(k,i)=dXX_XYZ(k)
5263 dYY_XYZtab(k,i)=dYY_XYZ(k)
5264 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5268 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5269 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5270 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5271 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5272 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5274 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5275 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5276 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5277 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5278 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5279 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5280 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5281 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5283 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5284 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5286 C to check gradient call subroutine check_grad
5292 c------------------------------------------------------------------------------
5293 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5295 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5296 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5297 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5298 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5300 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5301 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5303 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5304 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5305 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5306 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5307 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5309 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5310 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5311 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5312 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5313 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5315 dsc_i = 0.743d0+x(61)
5317 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5318 & *(xx*cost2+yy*sint2))
5319 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5320 & *(xx*cost2-yy*sint2))
5321 s1=(1+x(63))/(0.1d0 + dscp1)
5322 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5323 s2=(1+x(65))/(0.1d0 + dscp2)
5324 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5325 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5326 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5331 c------------------------------------------------------------------------------
5332 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5334 C This procedure calculates two-body contact function g(rij) and its derivative:
5337 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5340 C where x=(rij-r0ij)/delta
5342 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5345 double precision rij,r0ij,eps0ij,fcont,fprimcont
5346 double precision x,x2,x4,delta
5350 if (x.lt.-1.0D0) then
5353 else if (x.le.1.0D0) then
5356 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5357 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5364 c------------------------------------------------------------------------------
5365 subroutine splinthet(theti,delta,ss,ssder)
5366 implicit real*8 (a-h,o-z)
5367 include 'DIMENSIONS'
5368 include 'COMMON.VAR'
5369 include 'COMMON.GEO'
5372 if (theti.gt.pipol) then
5373 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5375 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5380 c------------------------------------------------------------------------------
5381 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5383 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5384 double precision ksi,ksi2,ksi3,a1,a2,a3
5385 a1=fprim0*delta/(f1-f0)
5391 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5392 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5395 c------------------------------------------------------------------------------
5396 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5398 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5399 double precision ksi,ksi2,ksi3,a1,a2,a3
5404 a2=3*(f1x-f0x)-2*fprim0x*delta
5405 a3=fprim0x*delta-2*(f1x-f0x)
5406 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5409 C-----------------------------------------------------------------------------
5411 C-----------------------------------------------------------------------------
5412 subroutine etor(etors,edihcnstr)
5413 implicit real*8 (a-h,o-z)
5414 include 'DIMENSIONS'
5415 include 'COMMON.VAR'
5416 include 'COMMON.GEO'
5417 include 'COMMON.LOCAL'
5418 include 'COMMON.TORSION'
5419 include 'COMMON.INTERACT'
5420 include 'COMMON.DERIV'
5421 include 'COMMON.CHAIN'
5422 include 'COMMON.NAMES'
5423 include 'COMMON.IOUNITS'
5424 include 'COMMON.FFIELD'
5425 include 'COMMON.TORCNSTR'
5426 include 'COMMON.CONTROL'
5428 C Set lprn=.true. for debugging
5432 do i=iphi_start,iphi_end
5434 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5435 & .or. itype(i).eq.ntyp1) cycle
5436 itori=itortyp(itype(i-2))
5437 itori1=itortyp(itype(i-1))
5440 C Proline-Proline pair is a special case...
5441 if (itori.eq.3 .and. itori1.eq.3) then
5442 if (phii.gt.-dwapi3) then
5444 fac=1.0D0/(1.0D0-cosphi)
5445 etorsi=v1(1,3,3)*fac
5446 etorsi=etorsi+etorsi
5447 etors=etors+etorsi-v1(1,3,3)
5448 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5449 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5452 v1ij=v1(j+1,itori,itori1)
5453 v2ij=v2(j+1,itori,itori1)
5456 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5457 if (energy_dec) etors_ii=etors_ii+
5458 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5459 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5463 v1ij=v1(j,itori,itori1)
5464 v2ij=v2(j,itori,itori1)
5467 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5468 if (energy_dec) etors_ii=etors_ii+
5469 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5470 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5473 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5476 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5477 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5478 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5479 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5480 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5482 ! 6/20/98 - dihedral angle constraints
5485 itori=idih_constr(i)
5488 if (difi.gt.drange(i)) then
5490 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5491 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5492 else if (difi.lt.-drange(i)) then
5494 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5495 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5497 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5498 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5500 ! write (iout,*) 'edihcnstr',edihcnstr
5503 c------------------------------------------------------------------------------
5504 subroutine etor_d(etors_d)
5508 c----------------------------------------------------------------------------
5510 subroutine etor(etors,edihcnstr)
5511 implicit real*8 (a-h,o-z)
5512 include 'DIMENSIONS'
5513 include 'COMMON.VAR'
5514 include 'COMMON.GEO'
5515 include 'COMMON.LOCAL'
5516 include 'COMMON.TORSION'
5517 include 'COMMON.INTERACT'
5518 include 'COMMON.DERIV'
5519 include 'COMMON.CHAIN'
5520 include 'COMMON.NAMES'
5521 include 'COMMON.IOUNITS'
5522 include 'COMMON.FFIELD'
5523 include 'COMMON.TORCNSTR'
5524 include 'COMMON.CONTROL'
5526 C Set lprn=.true. for debugging
5530 do i=iphi_start,iphi_end
5531 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5532 & .or. itype(i).eq.ntyp1) cycle
5534 if (iabs(itype(i)).eq.20) then
5539 itori=itortyp(itype(i-2))
5540 itori1=itortyp(itype(i-1))
5543 C Regular cosine and sine terms
5544 do j=1,nterm(itori,itori1,iblock)
5545 v1ij=v1(j,itori,itori1,iblock)
5546 v2ij=v2(j,itori,itori1,iblock)
5549 etors=etors+v1ij*cosphi+v2ij*sinphi
5550 if (energy_dec) etors_ii=etors_ii+
5551 & v1ij*cosphi+v2ij*sinphi
5552 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5556 C E = SUM ----------------------------------- - v1
5557 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5559 cosphi=dcos(0.5d0*phii)
5560 sinphi=dsin(0.5d0*phii)
5561 do j=1,nlor(itori,itori1,iblock)
5562 vl1ij=vlor1(j,itori,itori1)
5563 vl2ij=vlor2(j,itori,itori1)
5564 vl3ij=vlor3(j,itori,itori1)
5565 pom=vl2ij*cosphi+vl3ij*sinphi
5566 pom1=1.0d0/(pom*pom+1.0d0)
5567 etors=etors+vl1ij*pom1
5568 if (energy_dec) etors_ii=etors_ii+
5571 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5573 C Subtract the constant term
5574 etors=etors-v0(itori,itori1,iblock)
5575 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5576 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
5578 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5579 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5580 & (v1(j,itori,itori1,iblock),j=1,6),
5581 & (v2(j,itori,itori1,iblock),j=1,6)
5582 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5583 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5585 ! 6/20/98 - dihedral angle constraints
5587 c do i=1,ndih_constr
5588 do i=idihconstr_start,idihconstr_end
5589 itori=idih_constr(i)
5591 difi=pinorm(phii-phi0(i))
5592 if (difi.gt.drange(i)) then
5594 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5595 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5596 else if (difi.lt.-drange(i)) then
5598 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5599 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5603 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5604 cd & rad2deg*phi0(i), rad2deg*drange(i),
5605 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5607 cd write (iout,*) 'edihcnstr',edihcnstr
5610 c----------------------------------------------------------------------------
5611 subroutine etor_d(etors_d)
5612 C 6/23/01 Compute double torsional energy
5613 implicit real*8 (a-h,o-z)
5614 include 'DIMENSIONS'
5615 include 'COMMON.VAR'
5616 include 'COMMON.GEO'
5617 include 'COMMON.LOCAL'
5618 include 'COMMON.TORSION'
5619 include 'COMMON.INTERACT'
5620 include 'COMMON.DERIV'
5621 include 'COMMON.CHAIN'
5622 include 'COMMON.NAMES'
5623 include 'COMMON.IOUNITS'
5624 include 'COMMON.FFIELD'
5625 include 'COMMON.TORCNSTR'
5627 C Set lprn=.true. for debugging
5631 do i=iphid_start,iphid_end
5632 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5633 & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5634 itori=itortyp(itype(i-2))
5635 itori1=itortyp(itype(i-1))
5636 itori2=itortyp(itype(i))
5642 if (iabs(itype(i+1)).eq.20) iblock=2
5644 C Regular cosine and sine terms
5645 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5646 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5647 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5648 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5649 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5650 cosphi1=dcos(j*phii)
5651 sinphi1=dsin(j*phii)
5652 cosphi2=dcos(j*phii1)
5653 sinphi2=dsin(j*phii1)
5654 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5655 & v2cij*cosphi2+v2sij*sinphi2
5656 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5657 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5659 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5661 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5662 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5663 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5664 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5665 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5666 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5667 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5668 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5669 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5670 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5671 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5672 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5673 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5674 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5677 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5678 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5683 c------------------------------------------------------------------------------
5684 subroutine eback_sc_corr(esccor)
5685 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5686 c conformational states; temporarily implemented as differences
5687 c between UNRES torsional potentials (dependent on three types of
5688 c residues) and the torsional potentials dependent on all 20 types
5689 c of residues computed from AM1 energy surfaces of terminally-blocked
5690 c amino-acid residues.
5691 implicit real*8 (a-h,o-z)
5692 include 'DIMENSIONS'
5693 include 'COMMON.VAR'
5694 include 'COMMON.GEO'
5695 include 'COMMON.LOCAL'
5696 include 'COMMON.TORSION'
5697 include 'COMMON.SCCOR'
5698 include 'COMMON.INTERACT'
5699 include 'COMMON.DERIV'
5700 include 'COMMON.CHAIN'
5701 include 'COMMON.NAMES'
5702 include 'COMMON.IOUNITS'
5703 include 'COMMON.FFIELD'
5704 include 'COMMON.CONTROL'
5706 C Set lprn=.true. for debugging
5709 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5711 do i=iphi_start,iphi_end
5712 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1) cycle
5714 itori=iabs(itype(i-2))
5715 itori1=iabs(itype(i-1))
5719 v1ij=v1sccor(j,itori,itori1)
5720 v2ij=v2sccor(j,itori,itori1)
5723 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5724 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5727 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5728 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5729 & (v1sccor(j,itori,itori1),j=1,6),(v2sccor(j,itori,itori1),j=1,6)
5730 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5734 c----------------------------------------------------------------------------
5735 subroutine multibody(ecorr)
5736 C This subroutine calculates multi-body contributions to energy following
5737 C the idea of Skolnick et al. If side chains I and J make a contact and
5738 C at the same time side chains I+1 and J+1 make a contact, an extra
5739 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5740 implicit real*8 (a-h,o-z)
5741 include 'DIMENSIONS'
5742 include 'COMMON.IOUNITS'
5743 include 'COMMON.DERIV'
5744 include 'COMMON.INTERACT'
5745 include 'COMMON.CONTACTS'
5746 double precision gx(3),gx1(3)
5749 C Set lprn=.true. for debugging
5753 write (iout,'(a)') 'Contact function values:'
5755 write (iout,'(i2,20(1x,i2,f10.5))')
5756 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5771 num_conti=num_cont(i)
5772 num_conti1=num_cont(i1)
5777 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5778 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5779 cd & ' ishift=',ishift
5780 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5781 C The system gains extra energy.
5782 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5783 endif ! j1==j+-ishift
5792 c------------------------------------------------------------------------------
5793 double precision function esccorr(i,j,k,l,jj,kk)
5794 implicit real*8 (a-h,o-z)
5795 include 'DIMENSIONS'
5796 include 'COMMON.IOUNITS'
5797 include 'COMMON.DERIV'
5798 include 'COMMON.INTERACT'
5799 include 'COMMON.CONTACTS'
5800 double precision gx(3),gx1(3)
5805 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5806 C Calculate the multi-body contribution to energy.
5807 C Calculate multi-body contributions to the gradient.
5808 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5809 cd & k,l,(gacont(m,kk,k),m=1,3)
5811 gx(m) =ekl*gacont(m,jj,i)
5812 gx1(m)=eij*gacont(m,kk,k)
5813 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5814 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5815 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5816 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5820 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5825 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5831 c------------------------------------------------------------------------------
5832 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5833 C This subroutine calculates multi-body contributions to hydrogen-bonding
5834 implicit real*8 (a-h,o-z)
5835 include 'DIMENSIONS'
5836 include 'COMMON.IOUNITS'
5839 parameter (max_cont=maxconts)
5840 parameter (max_dim=26)
5841 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
5842 double precision zapas(max_dim,maxconts,max_fg_procs),
5843 & zapas_recv(max_dim,maxconts,max_fg_procs)
5844 common /przechowalnia/ zapas
5845 integer status(MPI_STATUS_SIZE),req(maxconts*2),
5846 & status_array(MPI_STATUS_SIZE,maxconts*2)
5848 include 'COMMON.SETUP'
5849 include 'COMMON.FFIELD'
5850 include 'COMMON.DERIV'
5851 include 'COMMON.INTERACT'
5852 include 'COMMON.CONTACTS'
5853 include 'COMMON.CONTROL'
5854 include 'COMMON.LOCAL'
5855 double precision gx(3),gx1(3),time00
5858 C Set lprn=.true. for debugging
5863 if (nfgtasks.le.1) goto 30
5865 write (iout,'(a)') 'Contact function values before RECEIVE:'
5867 write (iout,'(2i3,50(1x,i2,f5.2))')
5868 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
5869 & j=1,num_cont_hb(i))
5873 do i=1,ntask_cont_from
5876 do i=1,ntask_cont_to
5879 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
5881 C Make the list of contacts to send to send to other procesors
5882 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
5884 do i=iturn3_start,iturn3_end
5885 c write (iout,*) "make contact list turn3",i," num_cont",
5887 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
5889 do i=iturn4_start,iturn4_end
5890 c write (iout,*) "make contact list turn4",i," num_cont",
5892 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
5896 c write (iout,*) "make contact list longrange",i,ii," num_cont",
5898 do j=1,num_cont_hb(i)
5901 iproc=iint_sent_local(k,jjc,ii)
5902 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
5903 if (iproc.gt.0) then
5904 ncont_sent(iproc)=ncont_sent(iproc)+1
5905 nn=ncont_sent(iproc)
5907 zapas(2,nn,iproc)=jjc
5908 zapas(3,nn,iproc)=facont_hb(j,i)
5909 zapas(4,nn,iproc)=ees0p(j,i)
5910 zapas(5,nn,iproc)=ees0m(j,i)
5911 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
5912 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
5913 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
5914 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
5915 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
5916 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
5917 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
5918 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
5919 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
5920 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
5921 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
5922 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
5923 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
5924 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
5925 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
5926 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
5927 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
5928 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
5929 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
5930 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
5931 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
5938 & "Numbers of contacts to be sent to other processors",
5939 & (ncont_sent(i),i=1,ntask_cont_to)
5940 write (iout,*) "Contacts sent"
5941 do ii=1,ntask_cont_to
5943 iproc=itask_cont_to(ii)
5944 write (iout,*) nn," contacts to processor",iproc,
5945 & " of CONT_TO_COMM group"
5947 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
5955 CorrelID1=nfgtasks+fg_rank+1
5957 C Receive the numbers of needed contacts from other processors
5958 do ii=1,ntask_cont_from
5959 iproc=itask_cont_from(ii)
5961 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
5962 & FG_COMM,req(ireq),IERR)
5964 c write (iout,*) "IRECV ended"
5966 C Send the number of contacts needed by other processors
5967 do ii=1,ntask_cont_to
5968 iproc=itask_cont_to(ii)
5970 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
5971 & FG_COMM,req(ireq),IERR)
5973 c write (iout,*) "ISEND ended"
5974 c write (iout,*) "number of requests (nn)",ireq
5977 & call MPI_Waitall(ireq,req,status_array,ierr)
5979 c & "Numbers of contacts to be received from other processors",
5980 c & (ncont_recv(i),i=1,ntask_cont_from)
5984 do ii=1,ntask_cont_from
5985 iproc=itask_cont_from(ii)
5987 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
5988 c & " of CONT_TO_COMM group"
5992 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
5993 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
5994 c write (iout,*) "ireq,req",ireq,req(ireq)
5997 C Send the contacts to processors that need them
5998 do ii=1,ntask_cont_to
5999 iproc=itask_cont_to(ii)
6001 c write (iout,*) nn," contacts to processor",iproc,
6002 c & " of CONT_TO_COMM group"
6005 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6006 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6007 c write (iout,*) "ireq,req",ireq,req(ireq)
6009 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6013 c write (iout,*) "number of requests (contacts)",ireq
6014 c write (iout,*) "req",(req(i),i=1,4)
6017 & call MPI_Waitall(ireq,req,status_array,ierr)
6018 do iii=1,ntask_cont_from
6019 iproc=itask_cont_from(iii)
6022 write (iout,*) "Received",nn," contacts from processor",iproc,
6023 & " of CONT_FROM_COMM group"
6026 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6031 ii=zapas_recv(1,i,iii)
6032 c Flag the received contacts to prevent double-counting
6033 jj=-zapas_recv(2,i,iii)
6034 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6036 nnn=num_cont_hb(ii)+1
6039 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6040 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6041 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6042 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6043 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6044 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6045 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6046 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6047 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6048 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6049 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6050 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6051 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6052 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6053 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6054 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6055 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6056 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6057 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6058 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6059 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6060 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6061 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6062 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6067 write (iout,'(a)') 'Contact function values after receive:'
6069 write (iout,'(2i3,50(1x,i3,f5.2))')
6070 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6071 & j=1,num_cont_hb(i))
6078 write (iout,'(a)') 'Contact function values:'
6080 write (iout,'(2i3,50(1x,i3,f5.2))')
6081 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6082 & j=1,num_cont_hb(i))
6086 C Remove the loop below after debugging !!!
6093 C Calculate the local-electrostatic correlation terms
6094 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6096 num_conti=num_cont_hb(i)
6097 num_conti1=num_cont_hb(i+1)
6104 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6105 c & ' jj=',jj,' kk=',kk
6106 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6107 & .or. j.lt.0 .and. j1.gt.0) .and.
6108 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6109 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6110 C The system gains extra energy.
6111 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6112 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6113 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6115 else if (j1.eq.j) then
6116 C Contacts I-J and I-(J+1) occur simultaneously.
6117 C The system loses extra energy.
6118 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6123 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6124 c & ' jj=',jj,' kk=',kk
6126 C Contacts I-J and (I+1)-J occur simultaneously.
6127 C The system loses extra energy.
6128 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6135 c------------------------------------------------------------------------------
6136 subroutine add_hb_contact(ii,jj,itask)
6137 implicit real*8 (a-h,o-z)
6138 include "DIMENSIONS"
6139 include "COMMON.IOUNITS"
6142 parameter (max_cont=maxconts)
6143 parameter (max_dim=26)
6144 include "COMMON.CONTACTS"
6145 double precision zapas(max_dim,maxconts,max_fg_procs),
6146 & zapas_recv(max_dim,maxconts,max_fg_procs)
6147 common /przechowalnia/ zapas
6148 integer i,j,ii,jj,iproc,itask(4),nn
6149 c write (iout,*) "itask",itask
6152 if (iproc.gt.0) then
6153 do j=1,num_cont_hb(ii)
6155 c write (iout,*) "i",ii," j",jj," jjc",jjc
6157 ncont_sent(iproc)=ncont_sent(iproc)+1
6158 nn=ncont_sent(iproc)
6159 zapas(1,nn,iproc)=ii
6160 zapas(2,nn,iproc)=jjc
6161 zapas(3,nn,iproc)=facont_hb(j,ii)
6162 zapas(4,nn,iproc)=ees0p(j,ii)
6163 zapas(5,nn,iproc)=ees0m(j,ii)
6164 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6165 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6166 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6167 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6168 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6169 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6170 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6171 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6172 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6173 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6174 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6175 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6176 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6177 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6178 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6179 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6180 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6181 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6182 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6183 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6184 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6192 c------------------------------------------------------------------------------
6193 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6195 C This subroutine calculates multi-body contributions to hydrogen-bonding
6196 implicit real*8 (a-h,o-z)
6197 include 'DIMENSIONS'
6198 include 'COMMON.IOUNITS'
6201 parameter (max_cont=maxconts)
6202 parameter (max_dim=70)
6203 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6204 double precision zapas(max_dim,maxconts,max_fg_procs),
6205 & zapas_recv(max_dim,maxconts,max_fg_procs)
6206 common /przechowalnia/ zapas
6207 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6208 & status_array(MPI_STATUS_SIZE,maxconts*2)
6210 include 'COMMON.SETUP'
6211 include 'COMMON.FFIELD'
6212 include 'COMMON.DERIV'
6213 include 'COMMON.LOCAL'
6214 include 'COMMON.INTERACT'
6215 include 'COMMON.CONTACTS'
6216 include 'COMMON.CHAIN'
6217 include 'COMMON.CONTROL'
6218 double precision gx(3),gx1(3)
6219 integer num_cont_hb_old(maxres)
6221 double precision eello4,eello5,eelo6,eello_turn6
6222 external eello4,eello5,eello6,eello_turn6
6223 C Set lprn=.true. for debugging
6228 num_cont_hb_old(i)=num_cont_hb(i)
6232 if (nfgtasks.le.1) goto 30
6234 write (iout,'(a)') 'Contact function values before RECEIVE:'
6236 write (iout,'(2i3,50(1x,i2,f5.2))')
6237 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6238 & j=1,num_cont_hb(i))
6242 do i=1,ntask_cont_from
6245 do i=1,ntask_cont_to
6248 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6250 C Make the list of contacts to send to send to other procesors
6251 do i=iturn3_start,iturn3_end
6252 c write (iout,*) "make contact list turn3",i," num_cont",
6254 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6256 do i=iturn4_start,iturn4_end
6257 c write (iout,*) "make contact list turn4",i," num_cont",
6259 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6263 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6265 do j=1,num_cont_hb(i)
6268 iproc=iint_sent_local(k,jjc,ii)
6269 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6270 if (iproc.ne.0) then
6271 ncont_sent(iproc)=ncont_sent(iproc)+1
6272 nn=ncont_sent(iproc)
6274 zapas(2,nn,iproc)=jjc
6275 zapas(3,nn,iproc)=d_cont(j,i)
6279 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6284 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6292 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6303 & "Numbers of contacts to be sent to other processors",
6304 & (ncont_sent(i),i=1,ntask_cont_to)
6305 write (iout,*) "Contacts sent"
6306 do ii=1,ntask_cont_to
6308 iproc=itask_cont_to(ii)
6309 write (iout,*) nn," contacts to processor",iproc,
6310 & " of CONT_TO_COMM group"
6312 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6320 CorrelID1=nfgtasks+fg_rank+1
6322 C Receive the numbers of needed contacts from other processors
6323 do ii=1,ntask_cont_from
6324 iproc=itask_cont_from(ii)
6326 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6327 & FG_COMM,req(ireq),IERR)
6329 c write (iout,*) "IRECV ended"
6331 C Send the number of contacts needed by other processors
6332 do ii=1,ntask_cont_to
6333 iproc=itask_cont_to(ii)
6335 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6336 & FG_COMM,req(ireq),IERR)
6338 c write (iout,*) "ISEND ended"
6339 c write (iout,*) "number of requests (nn)",ireq
6342 & call MPI_Waitall(ireq,req,status_array,ierr)
6344 c & "Numbers of contacts to be received from other processors",
6345 c & (ncont_recv(i),i=1,ntask_cont_from)
6349 do ii=1,ntask_cont_from
6350 iproc=itask_cont_from(ii)
6352 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6353 c & " of CONT_TO_COMM group"
6357 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6358 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6359 c write (iout,*) "ireq,req",ireq,req(ireq)
6362 C Send the contacts to processors that need them
6363 do ii=1,ntask_cont_to
6364 iproc=itask_cont_to(ii)
6366 c write (iout,*) nn," contacts to processor",iproc,
6367 c & " of CONT_TO_COMM group"
6370 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6371 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6372 c write (iout,*) "ireq,req",ireq,req(ireq)
6374 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6378 c write (iout,*) "number of requests (contacts)",ireq
6379 c write (iout,*) "req",(req(i),i=1,4)
6382 & call MPI_Waitall(ireq,req,status_array,ierr)
6383 do iii=1,ntask_cont_from
6384 iproc=itask_cont_from(iii)
6387 write (iout,*) "Received",nn," contacts from processor",iproc,
6388 & " of CONT_FROM_COMM group"
6391 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6396 ii=zapas_recv(1,i,iii)
6397 c Flag the received contacts to prevent double-counting
6398 jj=-zapas_recv(2,i,iii)
6399 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6401 nnn=num_cont_hb(ii)+1
6404 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6408 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6413 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6421 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6430 write (iout,'(a)') 'Contact function values after receive:'
6432 write (iout,'(2i3,50(1x,i3,5f6.3))')
6433 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6434 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6441 write (iout,'(a)') 'Contact function values:'
6443 write (iout,'(2i3,50(1x,i2,5f6.3))')
6444 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6445 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6451 C Remove the loop below after debugging !!!
6458 C Calculate the dipole-dipole interaction energies
6459 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6460 do i=iatel_s,iatel_e+1
6461 num_conti=num_cont_hb(i)
6470 C Calculate the local-electrostatic correlation terms
6471 c write (iout,*) "gradcorr5 in eello5 before loop"
6473 c write (iout,'(i5,3f10.5)')
6474 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6476 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6477 c write (iout,*) "corr loop i",i
6479 num_conti=num_cont_hb(i)
6480 num_conti1=num_cont_hb(i+1)
6487 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6488 c & ' jj=',jj,' kk=',kk
6489 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6490 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6491 & .or. j.lt.0 .and. j1.gt.0) .and.
6492 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6493 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6494 C The system gains extra energy.
6496 sqd1=dsqrt(d_cont(jj,i))
6497 sqd2=dsqrt(d_cont(kk,i1))
6498 sred_geom = sqd1*sqd2
6499 IF (sred_geom.lt.cutoff_corr) THEN
6500 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6502 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6503 cd & ' jj=',jj,' kk=',kk
6504 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6505 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6507 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6508 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6511 cd write (iout,*) 'sred_geom=',sred_geom,
6512 cd & ' ekont=',ekont,' fprim=',fprimcont,
6513 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6514 cd write (iout,*) "g_contij",g_contij
6515 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6516 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6517 call calc_eello(i,jp,i+1,jp1,jj,kk)
6518 if (wcorr4.gt.0.0d0)
6519 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6520 if (energy_dec.and.wcorr4.gt.0.0d0)
6521 1 write (iout,'(a6,4i5,0pf7.3)')
6522 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6523 c write (iout,*) "gradcorr5 before eello5"
6525 c write (iout,'(i5,3f10.5)')
6526 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6528 if (wcorr5.gt.0.0d0)
6529 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6530 c write (iout,*) "gradcorr5 after eello5"
6532 c write (iout,'(i5,3f10.5)')
6533 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6535 if (energy_dec.and.wcorr5.gt.0.0d0)
6536 1 write (iout,'(a6,4i5,0pf7.3)')
6537 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6538 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6539 cd write(2,*)'ijkl',i,jp,i+1,jp1
6540 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6541 & .or. wturn6.eq.0.0d0))then
6542 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6543 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6544 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6545 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6546 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6547 cd & 'ecorr6=',ecorr6
6548 cd write (iout,'(4e15.5)') sred_geom,
6549 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6550 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6551 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6552 else if (wturn6.gt.0.0d0
6553 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6554 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6555 eturn6=eturn6+eello_turn6(i,jj,kk)
6556 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6557 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6558 cd write (2,*) 'multibody_eello:eturn6',eturn6
6567 num_cont_hb(i)=num_cont_hb_old(i)
6569 c write (iout,*) "gradcorr5 in eello5"
6571 c write (iout,'(i5,3f10.5)')
6572 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6576 c------------------------------------------------------------------------------
6577 subroutine add_hb_contact_eello(ii,jj,itask)
6578 implicit real*8 (a-h,o-z)
6579 include "DIMENSIONS"
6580 include "COMMON.IOUNITS"
6583 parameter (max_cont=maxconts)
6584 parameter (max_dim=70)
6585 include "COMMON.CONTACTS"
6586 double precision zapas(max_dim,maxconts,max_fg_procs),
6587 & zapas_recv(max_dim,maxconts,max_fg_procs)
6588 common /przechowalnia/ zapas
6589 integer i,j,ii,jj,iproc,itask(4),nn
6590 c write (iout,*) "itask",itask
6593 if (iproc.gt.0) then
6594 do j=1,num_cont_hb(ii)
6596 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6598 ncont_sent(iproc)=ncont_sent(iproc)+1
6599 nn=ncont_sent(iproc)
6600 zapas(1,nn,iproc)=ii
6601 zapas(2,nn,iproc)=jjc
6602 zapas(3,nn,iproc)=d_cont(j,ii)
6606 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6611 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6619 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6631 c------------------------------------------------------------------------------
6632 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6633 implicit real*8 (a-h,o-z)
6634 include 'DIMENSIONS'
6635 include 'COMMON.IOUNITS'
6636 include 'COMMON.DERIV'
6637 include 'COMMON.INTERACT'
6638 include 'COMMON.CONTACTS'
6639 double precision gx(3),gx1(3)
6649 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6650 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6651 C Following 4 lines for diagnostics.
6656 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6657 c & 'Contacts ',i,j,
6658 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6659 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6661 C Calculate the multi-body contribution to energy.
6662 c ecorr=ecorr+ekont*ees
6663 C Calculate multi-body contributions to the gradient.
6664 coeffpees0pij=coeffp*ees0pij
6665 coeffmees0mij=coeffm*ees0mij
6666 coeffpees0pkl=coeffp*ees0pkl
6667 coeffmees0mkl=coeffm*ees0mkl
6669 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6670 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6671 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6672 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6673 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6674 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6675 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6676 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6677 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6678 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6679 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6680 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6681 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6682 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6683 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6684 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6685 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6686 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6687 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6688 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6689 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6690 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6691 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6692 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6693 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6698 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6699 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6700 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6701 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6706 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6707 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6708 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6709 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6712 c write (iout,*) "ehbcorr",ekont*ees
6717 C---------------------------------------------------------------------------
6718 subroutine dipole(i,j,jj)
6719 implicit real*8 (a-h,o-z)
6720 include 'DIMENSIONS'
6721 include 'COMMON.IOUNITS'
6722 include 'COMMON.CHAIN'
6723 include 'COMMON.FFIELD'
6724 include 'COMMON.DERIV'
6725 include 'COMMON.INTERACT'
6726 include 'COMMON.CONTACTS'
6727 include 'COMMON.TORSION'
6728 include 'COMMON.VAR'
6729 include 'COMMON.GEO'
6730 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6732 iti1 = itortyp(itype(i+1))
6733 if (j.lt.nres-1) then
6734 itj1 = itortyp(itype(j+1))
6739 dipi(iii,1)=Ub2(iii,i)
6740 dipderi(iii)=Ub2der(iii,i)
6741 dipi(iii,2)=b1(iii,iti1)
6742 dipj(iii,1)=Ub2(iii,j)
6743 dipderj(iii)=Ub2der(iii,j)
6744 dipj(iii,2)=b1(iii,itj1)
6748 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6751 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6758 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6762 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6767 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6768 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6770 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6772 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6774 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6779 C---------------------------------------------------------------------------
6780 subroutine calc_eello(i,j,k,l,jj,kk)
6782 C This subroutine computes matrices and vectors needed to calculate
6783 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6785 implicit real*8 (a-h,o-z)
6786 include 'DIMENSIONS'
6787 include 'COMMON.IOUNITS'
6788 include 'COMMON.CHAIN'
6789 include 'COMMON.DERIV'
6790 include 'COMMON.INTERACT'
6791 include 'COMMON.CONTACTS'
6792 include 'COMMON.TORSION'
6793 include 'COMMON.VAR'
6794 include 'COMMON.GEO'
6795 include 'COMMON.FFIELD'
6796 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6797 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6800 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6801 cd & ' jj=',jj,' kk=',kk
6802 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6803 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6804 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6807 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6808 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6811 call transpose2(aa1(1,1),aa1t(1,1))
6812 call transpose2(aa2(1,1),aa2t(1,1))
6815 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6816 & aa1tder(1,1,lll,kkk))
6817 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6818 & aa2tder(1,1,lll,kkk))
6822 C parallel orientation of the two CA-CA-CA frames.
6824 iti=itortyp(itype(i))
6828 itk1=itortyp(itype(k+1))
6829 itj=itortyp(itype(j))
6830 if (l.lt.nres-1) then
6831 itl1=itortyp(itype(l+1))
6835 C A1 kernel(j+1) A2T
6837 cd write (iout,'(3f10.5,5x,3f10.5)')
6838 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6840 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6841 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6842 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6843 C Following matrices are needed only for 6-th order cumulants
6844 IF (wcorr6.gt.0.0d0) THEN
6845 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6846 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6847 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6848 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6849 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6850 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6851 & ADtEAderx(1,1,1,1,1,1))
6853 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6854 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6855 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6856 & ADtEA1derx(1,1,1,1,1,1))
6858 C End 6-th order cumulants
6861 cd write (2,*) 'In calc_eello6'
6863 cd write (2,*) 'iii=',iii
6865 cd write (2,*) 'kkk=',kkk
6867 cd write (2,'(3(2f10.5),5x)')
6868 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
6873 call transpose2(EUgder(1,1,k),auxmat(1,1))
6874 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
6875 call transpose2(EUg(1,1,k),auxmat(1,1))
6876 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
6877 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
6881 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
6882 & EAEAderx(1,1,lll,kkk,iii,1))
6886 C A1T kernel(i+1) A2
6887 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6888 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
6889 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
6890 C Following matrices are needed only for 6-th order cumulants
6891 IF (wcorr6.gt.0.0d0) THEN
6892 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6893 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
6894 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
6895 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6896 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
6897 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
6898 & ADtEAderx(1,1,1,1,1,2))
6899 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
6900 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
6901 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
6902 & ADtEA1derx(1,1,1,1,1,2))
6904 C End 6-th order cumulants
6905 call transpose2(EUgder(1,1,l),auxmat(1,1))
6906 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
6907 call transpose2(EUg(1,1,l),auxmat(1,1))
6908 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
6909 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
6913 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
6914 & EAEAderx(1,1,lll,kkk,iii,2))
6919 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
6920 C They are needed only when the fifth- or the sixth-order cumulants are
6922 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
6923 call transpose2(AEA(1,1,1),auxmat(1,1))
6924 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
6925 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
6926 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
6927 call transpose2(AEAderg(1,1,1),auxmat(1,1))
6928 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
6929 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
6930 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
6931 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
6932 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
6933 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
6934 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
6935 call transpose2(AEA(1,1,2),auxmat(1,1))
6936 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
6937 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
6938 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
6939 call transpose2(AEAderg(1,1,2),auxmat(1,1))
6940 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
6941 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
6942 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
6943 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
6944 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
6945 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
6946 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
6947 C Calculate the Cartesian derivatives of the vectors.
6951 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
6952 call matvec2(auxmat(1,1),b1(1,iti),
6953 & AEAb1derx(1,lll,kkk,iii,1,1))
6954 call matvec2(auxmat(1,1),Ub2(1,i),
6955 & AEAb2derx(1,lll,kkk,iii,1,1))
6956 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
6957 & AEAb1derx(1,lll,kkk,iii,2,1))
6958 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
6959 & AEAb2derx(1,lll,kkk,iii,2,1))
6960 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
6961 call matvec2(auxmat(1,1),b1(1,itj),
6962 & AEAb1derx(1,lll,kkk,iii,1,2))
6963 call matvec2(auxmat(1,1),Ub2(1,j),
6964 & AEAb2derx(1,lll,kkk,iii,1,2))
6965 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
6966 & AEAb1derx(1,lll,kkk,iii,2,2))
6967 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
6968 & AEAb2derx(1,lll,kkk,iii,2,2))
6975 C Antiparallel orientation of the two CA-CA-CA frames.
6977 iti=itortyp(itype(i))
6981 itk1=itortyp(itype(k+1))
6982 itl=itortyp(itype(l))
6983 itj=itortyp(itype(j))
6984 if (j.lt.nres-1) then
6985 itj1=itortyp(itype(j+1))
6989 C A2 kernel(j-1)T A1T
6990 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6991 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
6992 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6993 C Following matrices are needed only for 6-th order cumulants
6994 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
6995 & j.eq.i+4 .and. l.eq.i+3)) THEN
6996 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6997 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
6998 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6999 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7000 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7001 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7002 & ADtEAderx(1,1,1,1,1,1))
7003 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7004 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7005 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7006 & ADtEA1derx(1,1,1,1,1,1))
7008 C End 6-th order cumulants
7009 call transpose2(EUgder(1,1,k),auxmat(1,1))
7010 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7011 call transpose2(EUg(1,1,k),auxmat(1,1))
7012 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7013 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7017 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7018 & EAEAderx(1,1,lll,kkk,iii,1))
7022 C A2T kernel(i+1)T A1
7023 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7024 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7025 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7026 C Following matrices are needed only for 6-th order cumulants
7027 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7028 & j.eq.i+4 .and. l.eq.i+3)) THEN
7029 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7030 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7031 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7032 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7033 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7034 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7035 & ADtEAderx(1,1,1,1,1,2))
7036 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7037 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7038 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7039 & ADtEA1derx(1,1,1,1,1,2))
7041 C End 6-th order cumulants
7042 call transpose2(EUgder(1,1,j),auxmat(1,1))
7043 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7044 call transpose2(EUg(1,1,j),auxmat(1,1))
7045 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7046 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7050 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7051 & EAEAderx(1,1,lll,kkk,iii,2))
7056 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7057 C They are needed only when the fifth- or the sixth-order cumulants are
7059 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7060 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7061 call transpose2(AEA(1,1,1),auxmat(1,1))
7062 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7063 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7064 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7065 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7066 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7067 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7068 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7069 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7070 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7071 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7072 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7073 call transpose2(AEA(1,1,2),auxmat(1,1))
7074 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7075 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7076 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7077 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7078 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7079 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7080 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7081 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7082 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7083 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7084 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7085 C Calculate the Cartesian derivatives of the vectors.
7089 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7090 call matvec2(auxmat(1,1),b1(1,iti),
7091 & AEAb1derx(1,lll,kkk,iii,1,1))
7092 call matvec2(auxmat(1,1),Ub2(1,i),
7093 & AEAb2derx(1,lll,kkk,iii,1,1))
7094 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7095 & AEAb1derx(1,lll,kkk,iii,2,1))
7096 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7097 & AEAb2derx(1,lll,kkk,iii,2,1))
7098 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7099 call matvec2(auxmat(1,1),b1(1,itl),
7100 & AEAb1derx(1,lll,kkk,iii,1,2))
7101 call matvec2(auxmat(1,1),Ub2(1,l),
7102 & AEAb2derx(1,lll,kkk,iii,1,2))
7103 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7104 & AEAb1derx(1,lll,kkk,iii,2,2))
7105 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7106 & AEAb2derx(1,lll,kkk,iii,2,2))
7115 C---------------------------------------------------------------------------
7116 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7117 & KK,KKderg,AKA,AKAderg,AKAderx)
7121 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7122 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7123 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7128 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7130 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7133 cd if (lprn) write (2,*) 'In kernel'
7135 cd if (lprn) write (2,*) 'kkk=',kkk
7137 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7138 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7140 cd write (2,*) 'lll=',lll
7141 cd write (2,*) 'iii=1'
7143 cd write (2,'(3(2f10.5),5x)')
7144 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7147 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7148 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7150 cd write (2,*) 'lll=',lll
7151 cd write (2,*) 'iii=2'
7153 cd write (2,'(3(2f10.5),5x)')
7154 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7161 C---------------------------------------------------------------------------
7162 double precision function eello4(i,j,k,l,jj,kk)
7163 implicit real*8 (a-h,o-z)
7164 include 'DIMENSIONS'
7165 include 'COMMON.IOUNITS'
7166 include 'COMMON.CHAIN'
7167 include 'COMMON.DERIV'
7168 include 'COMMON.INTERACT'
7169 include 'COMMON.CONTACTS'
7170 include 'COMMON.TORSION'
7171 include 'COMMON.VAR'
7172 include 'COMMON.GEO'
7173 double precision pizda(2,2),ggg1(3),ggg2(3)
7174 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7178 cd print *,'eello4:',i,j,k,l,jj,kk
7179 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7180 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7181 cold eij=facont_hb(jj,i)
7182 cold ekl=facont_hb(kk,k)
7184 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7185 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7186 gcorr_loc(k-1)=gcorr_loc(k-1)
7187 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7189 gcorr_loc(l-1)=gcorr_loc(l-1)
7190 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7192 gcorr_loc(j-1)=gcorr_loc(j-1)
7193 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7198 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7199 & -EAEAderx(2,2,lll,kkk,iii,1)
7200 cd derx(lll,kkk,iii)=0.0d0
7204 cd gcorr_loc(l-1)=0.0d0
7205 cd gcorr_loc(j-1)=0.0d0
7206 cd gcorr_loc(k-1)=0.0d0
7208 cd write (iout,*)'Contacts have occurred for peptide groups',
7209 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7210 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7211 if (j.lt.nres-1) then
7218 if (l.lt.nres-1) then
7226 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7227 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7228 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7229 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7230 cgrad ghalf=0.5d0*ggg1(ll)
7231 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7232 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7233 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7234 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7235 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7236 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7237 cgrad ghalf=0.5d0*ggg2(ll)
7238 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7239 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7240 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7241 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7242 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7243 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7247 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7252 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7257 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7262 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7266 cd write (2,*) iii,gcorr_loc(iii)
7269 cd write (2,*) 'ekont',ekont
7270 cd write (iout,*) 'eello4',ekont*eel4
7273 C---------------------------------------------------------------------------
7274 double precision function eello5(i,j,k,l,jj,kk)
7275 implicit real*8 (a-h,o-z)
7276 include 'DIMENSIONS'
7277 include 'COMMON.IOUNITS'
7278 include 'COMMON.CHAIN'
7279 include 'COMMON.DERIV'
7280 include 'COMMON.INTERACT'
7281 include 'COMMON.CONTACTS'
7282 include 'COMMON.TORSION'
7283 include 'COMMON.VAR'
7284 include 'COMMON.GEO'
7285 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7286 double precision ggg1(3),ggg2(3)
7287 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7292 C /l\ / \ \ / \ / \ / C
7293 C / \ / \ \ / \ / \ / C
7294 C j| o |l1 | o | o| o | | o |o C
7295 C \ |/k\| |/ \| / |/ \| |/ \| C
7296 C \i/ \ / \ / / \ / \ C
7298 C (I) (II) (III) (IV) C
7300 C eello5_1 eello5_2 eello5_3 eello5_4 C
7302 C Antiparallel chains C
7305 C /j\ / \ \ / \ / \ / C
7306 C / \ / \ \ / \ / \ / C
7307 C j1| o |l | o | o| o | | o |o C
7308 C \ |/k\| |/ \| / |/ \| |/ \| C
7309 C \i/ \ / \ / / \ / \ C
7311 C (I) (II) (III) (IV) C
7313 C eello5_1 eello5_2 eello5_3 eello5_4 C
7315 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7317 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7318 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7323 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7325 itk=itortyp(itype(k))
7326 itl=itortyp(itype(l))
7327 itj=itortyp(itype(j))
7332 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7333 cd & eel5_3_num,eel5_4_num)
7337 derx(lll,kkk,iii)=0.0d0
7341 cd eij=facont_hb(jj,i)
7342 cd ekl=facont_hb(kk,k)
7344 cd write (iout,*)'Contacts have occurred for peptide groups',
7345 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7347 C Contribution from the graph I.
7348 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7349 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7350 call transpose2(EUg(1,1,k),auxmat(1,1))
7351 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7352 vv(1)=pizda(1,1)-pizda(2,2)
7353 vv(2)=pizda(1,2)+pizda(2,1)
7354 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7355 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7356 C Explicit gradient in virtual-dihedral angles.
7357 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7358 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7359 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7360 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7361 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7362 vv(1)=pizda(1,1)-pizda(2,2)
7363 vv(2)=pizda(1,2)+pizda(2,1)
7364 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7365 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7366 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7367 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7368 vv(1)=pizda(1,1)-pizda(2,2)
7369 vv(2)=pizda(1,2)+pizda(2,1)
7371 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7372 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7373 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7375 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7376 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7377 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7379 C Cartesian gradient
7383 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7385 vv(1)=pizda(1,1)-pizda(2,2)
7386 vv(2)=pizda(1,2)+pizda(2,1)
7387 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7388 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7389 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7395 C Contribution from graph II
7396 call transpose2(EE(1,1,itk),auxmat(1,1))
7397 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7398 vv(1)=pizda(1,1)+pizda(2,2)
7399 vv(2)=pizda(2,1)-pizda(1,2)
7400 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7401 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7402 C Explicit gradient in virtual-dihedral angles.
7403 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7404 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7405 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7406 vv(1)=pizda(1,1)+pizda(2,2)
7407 vv(2)=pizda(2,1)-pizda(1,2)
7409 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7410 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7411 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7413 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7414 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7415 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7417 C Cartesian gradient
7421 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7423 vv(1)=pizda(1,1)+pizda(2,2)
7424 vv(2)=pizda(2,1)-pizda(1,2)
7425 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7426 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7427 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7435 C Parallel orientation
7436 C Contribution from graph III
7437 call transpose2(EUg(1,1,l),auxmat(1,1))
7438 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7439 vv(1)=pizda(1,1)-pizda(2,2)
7440 vv(2)=pizda(1,2)+pizda(2,1)
7441 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7442 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7443 C Explicit gradient in virtual-dihedral angles.
7444 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7445 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7446 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7447 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7448 vv(1)=pizda(1,1)-pizda(2,2)
7449 vv(2)=pizda(1,2)+pizda(2,1)
7450 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7451 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7452 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7453 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7454 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7455 vv(1)=pizda(1,1)-pizda(2,2)
7456 vv(2)=pizda(1,2)+pizda(2,1)
7457 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7458 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7459 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7460 C Cartesian gradient
7464 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7466 vv(1)=pizda(1,1)-pizda(2,2)
7467 vv(2)=pizda(1,2)+pizda(2,1)
7468 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7469 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7470 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7475 C Contribution from graph IV
7477 call transpose2(EE(1,1,itl),auxmat(1,1))
7478 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7479 vv(1)=pizda(1,1)+pizda(2,2)
7480 vv(2)=pizda(2,1)-pizda(1,2)
7481 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7482 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7483 C Explicit gradient in virtual-dihedral angles.
7484 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7485 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7486 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7487 vv(1)=pizda(1,1)+pizda(2,2)
7488 vv(2)=pizda(2,1)-pizda(1,2)
7489 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7490 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7491 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7492 C Cartesian gradient
7496 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7498 vv(1)=pizda(1,1)+pizda(2,2)
7499 vv(2)=pizda(2,1)-pizda(1,2)
7500 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7501 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7502 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7507 C Antiparallel orientation
7508 C Contribution from graph III
7510 call transpose2(EUg(1,1,j),auxmat(1,1))
7511 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7512 vv(1)=pizda(1,1)-pizda(2,2)
7513 vv(2)=pizda(1,2)+pizda(2,1)
7514 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7515 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7516 C Explicit gradient in virtual-dihedral angles.
7517 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7518 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7519 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7520 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7521 vv(1)=pizda(1,1)-pizda(2,2)
7522 vv(2)=pizda(1,2)+pizda(2,1)
7523 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7524 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7525 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7526 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7527 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7528 vv(1)=pizda(1,1)-pizda(2,2)
7529 vv(2)=pizda(1,2)+pizda(2,1)
7530 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7531 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7532 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7533 C Cartesian gradient
7537 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7539 vv(1)=pizda(1,1)-pizda(2,2)
7540 vv(2)=pizda(1,2)+pizda(2,1)
7541 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7542 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7543 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7548 C Contribution from graph IV
7550 call transpose2(EE(1,1,itj),auxmat(1,1))
7551 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7552 vv(1)=pizda(1,1)+pizda(2,2)
7553 vv(2)=pizda(2,1)-pizda(1,2)
7554 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7555 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7556 C Explicit gradient in virtual-dihedral angles.
7557 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7558 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7559 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7560 vv(1)=pizda(1,1)+pizda(2,2)
7561 vv(2)=pizda(2,1)-pizda(1,2)
7562 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7563 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7564 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7565 C Cartesian gradient
7569 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7571 vv(1)=pizda(1,1)+pizda(2,2)
7572 vv(2)=pizda(2,1)-pizda(1,2)
7573 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7574 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7575 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7581 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7582 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7583 cd write (2,*) 'ijkl',i,j,k,l
7584 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7585 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7587 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7588 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7589 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7590 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7591 if (j.lt.nres-1) then
7598 if (l.lt.nres-1) then
7608 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7609 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7610 C summed up outside the subrouine as for the other subroutines
7611 C handling long-range interactions. The old code is commented out
7612 C with "cgrad" to keep track of changes.
7614 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7615 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7616 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7617 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7618 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7619 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7620 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7621 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7622 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7623 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7625 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7626 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7627 cgrad ghalf=0.5d0*ggg1(ll)
7629 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7630 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7631 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7632 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7633 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7634 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7635 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7636 cgrad ghalf=0.5d0*ggg2(ll)
7638 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7639 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7640 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7641 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7642 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7643 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7648 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7649 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7654 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7655 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7661 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7666 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7670 cd write (2,*) iii,g_corr5_loc(iii)
7673 cd write (2,*) 'ekont',ekont
7674 cd write (iout,*) 'eello5',ekont*eel5
7677 c--------------------------------------------------------------------------
7678 double precision function eello6(i,j,k,l,jj,kk)
7679 implicit real*8 (a-h,o-z)
7680 include 'DIMENSIONS'
7681 include 'COMMON.IOUNITS'
7682 include 'COMMON.CHAIN'
7683 include 'COMMON.DERIV'
7684 include 'COMMON.INTERACT'
7685 include 'COMMON.CONTACTS'
7686 include 'COMMON.TORSION'
7687 include 'COMMON.VAR'
7688 include 'COMMON.GEO'
7689 include 'COMMON.FFIELD'
7690 double precision ggg1(3),ggg2(3)
7691 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7696 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7704 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7705 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7709 derx(lll,kkk,iii)=0.0d0
7713 cd eij=facont_hb(jj,i)
7714 cd ekl=facont_hb(kk,k)
7720 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7721 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7722 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7723 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7724 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7725 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7727 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7728 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7729 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7730 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7731 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7732 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7736 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7738 C If turn contributions are considered, they will be handled separately.
7739 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7740 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7741 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7742 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7743 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7744 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7745 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7747 if (j.lt.nres-1) then
7754 if (l.lt.nres-1) then
7762 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7763 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7764 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7765 cgrad ghalf=0.5d0*ggg1(ll)
7767 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7768 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7769 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7770 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7771 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7772 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7773 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7774 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7775 cgrad ghalf=0.5d0*ggg2(ll)
7776 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7778 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7779 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7780 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7781 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7782 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7783 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7788 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7789 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7794 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7795 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7801 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7806 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7810 cd write (2,*) iii,g_corr6_loc(iii)
7813 cd write (2,*) 'ekont',ekont
7814 cd write (iout,*) 'eello6',ekont*eel6
7817 c--------------------------------------------------------------------------
7818 double precision function eello6_graph1(i,j,k,l,imat,swap)
7819 implicit real*8 (a-h,o-z)
7820 include 'DIMENSIONS'
7821 include 'COMMON.IOUNITS'
7822 include 'COMMON.CHAIN'
7823 include 'COMMON.DERIV'
7824 include 'COMMON.INTERACT'
7825 include 'COMMON.CONTACTS'
7826 include 'COMMON.TORSION'
7827 include 'COMMON.VAR'
7828 include 'COMMON.GEO'
7829 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7833 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7835 C Parallel Antiparallel C
7841 C \ j|/k\| / \ |/k\|l / C
7846 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7847 itk=itortyp(itype(k))
7848 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7849 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7850 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7851 call transpose2(EUgC(1,1,k),auxmat(1,1))
7852 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7853 vv1(1)=pizda1(1,1)-pizda1(2,2)
7854 vv1(2)=pizda1(1,2)+pizda1(2,1)
7855 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7856 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7857 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7858 s5=scalar2(vv(1),Dtobr2(1,i))
7859 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7860 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7861 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7862 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7863 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7864 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
7865 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
7866 & +scalar2(vv(1),Dtobr2der(1,i)))
7867 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
7868 vv1(1)=pizda1(1,1)-pizda1(2,2)
7869 vv1(2)=pizda1(1,2)+pizda1(2,1)
7870 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
7871 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
7873 g_corr6_loc(l-1)=g_corr6_loc(l-1)
7874 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7875 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7876 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7877 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7879 g_corr6_loc(j-1)=g_corr6_loc(j-1)
7880 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
7881 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
7882 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
7883 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
7885 call transpose2(EUgCder(1,1,k),auxmat(1,1))
7886 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7887 vv1(1)=pizda1(1,1)-pizda1(2,2)
7888 vv1(2)=pizda1(1,2)+pizda1(2,1)
7889 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
7890 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
7891 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
7892 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
7901 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
7902 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
7903 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
7904 call transpose2(EUgC(1,1,k),auxmat(1,1))
7905 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
7907 vv1(1)=pizda1(1,1)-pizda1(2,2)
7908 vv1(2)=pizda1(1,2)+pizda1(2,1)
7909 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7910 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
7911 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
7912 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
7913 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
7914 s5=scalar2(vv(1),Dtobr2(1,i))
7915 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
7921 c----------------------------------------------------------------------------
7922 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
7923 implicit real*8 (a-h,o-z)
7924 include 'DIMENSIONS'
7925 include 'COMMON.IOUNITS'
7926 include 'COMMON.CHAIN'
7927 include 'COMMON.DERIV'
7928 include 'COMMON.INTERACT'
7929 include 'COMMON.CONTACTS'
7930 include 'COMMON.TORSION'
7931 include 'COMMON.VAR'
7932 include 'COMMON.GEO'
7934 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
7935 & auxvec1(2),auxvec2(1),auxmat1(2,2)
7938 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7940 C Parallel Antiparallel C
7946 C \ j|/k\| \ |/k\|l C
7951 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7952 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
7953 C AL 7/4/01 s1 would occur in the sixth-order moment,
7954 C but not in a cluster cumulant
7956 s1=dip(1,jj,i)*dip(1,kk,k)
7958 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
7959 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
7960 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
7961 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
7962 call transpose2(EUg(1,1,k),auxmat(1,1))
7963 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
7964 vv(1)=pizda(1,1)-pizda(2,2)
7965 vv(2)=pizda(1,2)+pizda(2,1)
7966 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
7967 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
7969 eello6_graph2=-(s1+s2+s3+s4)
7971 eello6_graph2=-(s2+s3+s4)
7974 C Derivatives in gamma(i-1)
7977 s1=dipderg(1,jj,i)*dip(1,kk,k)
7979 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
7980 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
7981 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7982 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
7984 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
7986 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
7988 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
7990 C Derivatives in gamma(k-1)
7992 s1=dip(1,jj,i)*dipderg(1,kk,k)
7994 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
7995 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
7996 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
7997 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
7998 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7999 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8000 vv(1)=pizda(1,1)-pizda(2,2)
8001 vv(2)=pizda(1,2)+pizda(2,1)
8002 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8004 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8006 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8008 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8009 C Derivatives in gamma(j-1) or gamma(l-1)
8012 s1=dipderg(3,jj,i)*dip(1,kk,k)
8014 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8015 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8016 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8017 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8018 vv(1)=pizda(1,1)-pizda(2,2)
8019 vv(2)=pizda(1,2)+pizda(2,1)
8020 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8023 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8025 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8028 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8029 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8031 C Derivatives in gamma(l-1) or gamma(j-1)
8034 s1=dip(1,jj,i)*dipderg(3,kk,k)
8036 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8037 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8038 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8039 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8040 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8041 vv(1)=pizda(1,1)-pizda(2,2)
8042 vv(2)=pizda(1,2)+pizda(2,1)
8043 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8046 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8048 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8051 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8052 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8054 C Cartesian derivatives.
8056 write (2,*) 'In eello6_graph2'
8058 write (2,*) 'iii=',iii
8060 write (2,*) 'kkk=',kkk
8062 write (2,'(3(2f10.5),5x)')
8063 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8073 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8075 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8078 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8080 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8081 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8083 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8084 call transpose2(EUg(1,1,k),auxmat(1,1))
8085 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8087 vv(1)=pizda(1,1)-pizda(2,2)
8088 vv(2)=pizda(1,2)+pizda(2,1)
8089 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8090 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8092 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8094 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8097 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8099 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8106 c----------------------------------------------------------------------------
8107 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8108 implicit real*8 (a-h,o-z)
8109 include 'DIMENSIONS'
8110 include 'COMMON.IOUNITS'
8111 include 'COMMON.CHAIN'
8112 include 'COMMON.DERIV'
8113 include 'COMMON.INTERACT'
8114 include 'COMMON.CONTACTS'
8115 include 'COMMON.TORSION'
8116 include 'COMMON.VAR'
8117 include 'COMMON.GEO'
8118 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8120 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8122 C Parallel Antiparallel C
8128 C j|/k\| / |/k\|l / C
8133 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8135 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8136 C energy moment and not to the cluster cumulant.
8137 iti=itortyp(itype(i))
8138 if (j.lt.nres-1) then
8139 itj1=itortyp(itype(j+1))
8143 itk=itortyp(itype(k))
8144 itk1=itortyp(itype(k+1))
8145 if (l.lt.nres-1) then
8146 itl1=itortyp(itype(l+1))
8151 s1=dip(4,jj,i)*dip(4,kk,k)
8153 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8154 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8155 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8156 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8157 call transpose2(EE(1,1,itk),auxmat(1,1))
8158 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8159 vv(1)=pizda(1,1)+pizda(2,2)
8160 vv(2)=pizda(2,1)-pizda(1,2)
8161 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8162 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8163 cd & "sum",-(s2+s3+s4)
8165 eello6_graph3=-(s1+s2+s3+s4)
8167 eello6_graph3=-(s2+s3+s4)
8170 C Derivatives in gamma(k-1)
8171 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8172 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8173 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8174 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8175 C Derivatives in gamma(l-1)
8176 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8177 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8178 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8179 vv(1)=pizda(1,1)+pizda(2,2)
8180 vv(2)=pizda(2,1)-pizda(1,2)
8181 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8182 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8183 C Cartesian derivatives.
8189 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8191 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8194 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8196 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8197 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8199 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8200 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8202 vv(1)=pizda(1,1)+pizda(2,2)
8203 vv(2)=pizda(2,1)-pizda(1,2)
8204 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8206 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8208 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8211 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8213 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8215 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8221 c----------------------------------------------------------------------------
8222 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8223 implicit real*8 (a-h,o-z)
8224 include 'DIMENSIONS'
8225 include 'COMMON.IOUNITS'
8226 include 'COMMON.CHAIN'
8227 include 'COMMON.DERIV'
8228 include 'COMMON.INTERACT'
8229 include 'COMMON.CONTACTS'
8230 include 'COMMON.TORSION'
8231 include 'COMMON.VAR'
8232 include 'COMMON.GEO'
8233 include 'COMMON.FFIELD'
8234 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8235 & auxvec1(2),auxmat1(2,2)
8237 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8239 C Parallel Antiparallel C
8245 C \ j|/k\| \ |/k\|l C
8250 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8252 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8253 C energy moment and not to the cluster cumulant.
8254 cd write (2,*) 'eello_graph4: wturn6',wturn6
8255 iti=itortyp(itype(i))
8256 itj=itortyp(itype(j))
8257 if (j.lt.nres-1) then
8258 itj1=itortyp(itype(j+1))
8262 itk=itortyp(itype(k))
8263 if (k.lt.nres-1) then
8264 itk1=itortyp(itype(k+1))
8268 itl=itortyp(itype(l))
8269 if (l.lt.nres-1) then
8270 itl1=itortyp(itype(l+1))
8274 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8275 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8276 cd & ' itl',itl,' itl1',itl1
8279 s1=dip(3,jj,i)*dip(3,kk,k)
8281 s1=dip(2,jj,j)*dip(2,kk,l)
8284 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8285 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8287 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8288 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8290 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8291 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8293 call transpose2(EUg(1,1,k),auxmat(1,1))
8294 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8295 vv(1)=pizda(1,1)-pizda(2,2)
8296 vv(2)=pizda(2,1)+pizda(1,2)
8297 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8298 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8300 eello6_graph4=-(s1+s2+s3+s4)
8302 eello6_graph4=-(s2+s3+s4)
8304 C Derivatives in gamma(i-1)
8308 s1=dipderg(2,jj,i)*dip(3,kk,k)
8310 s1=dipderg(4,jj,j)*dip(2,kk,l)
8313 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8315 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8316 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8318 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8319 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8321 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8322 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8323 cd write (2,*) 'turn6 derivatives'
8325 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8327 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8331 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8333 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8337 C Derivatives in gamma(k-1)
8340 s1=dip(3,jj,i)*dipderg(2,kk,k)
8342 s1=dip(2,jj,j)*dipderg(4,kk,l)
8345 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8346 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8348 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8349 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8351 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8352 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8354 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8355 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8356 vv(1)=pizda(1,1)-pizda(2,2)
8357 vv(2)=pizda(2,1)+pizda(1,2)
8358 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8359 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8361 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8363 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8367 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8369 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8372 C Derivatives in gamma(j-1) or gamma(l-1)
8373 if (l.eq.j+1 .and. l.gt.1) then
8374 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8375 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8376 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8377 vv(1)=pizda(1,1)-pizda(2,2)
8378 vv(2)=pizda(2,1)+pizda(1,2)
8379 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8380 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8381 else if (j.gt.1) then
8382 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8383 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8384 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8385 vv(1)=pizda(1,1)-pizda(2,2)
8386 vv(2)=pizda(2,1)+pizda(1,2)
8387 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8388 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8389 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8391 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8394 C Cartesian derivatives.
8401 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8403 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8407 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8409 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8413 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8415 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8417 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8418 & b1(1,itj1),auxvec(1))
8419 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8421 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8422 & b1(1,itl1),auxvec(1))
8423 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8425 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8427 vv(1)=pizda(1,1)-pizda(2,2)
8428 vv(2)=pizda(2,1)+pizda(1,2)
8429 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8431 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8433 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8436 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8439 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8442 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8444 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8446 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8450 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8452 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8455 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8457 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8465 c----------------------------------------------------------------------------
8466 double precision function eello_turn6(i,jj,kk)
8467 implicit real*8 (a-h,o-z)
8468 include 'DIMENSIONS'
8469 include 'COMMON.IOUNITS'
8470 include 'COMMON.CHAIN'
8471 include 'COMMON.DERIV'
8472 include 'COMMON.INTERACT'
8473 include 'COMMON.CONTACTS'
8474 include 'COMMON.TORSION'
8475 include 'COMMON.VAR'
8476 include 'COMMON.GEO'
8477 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8478 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8480 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8481 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8482 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8483 C the respective energy moment and not to the cluster cumulant.
8492 iti=itortyp(itype(i))
8493 itk=itortyp(itype(k))
8494 itk1=itortyp(itype(k+1))
8495 itl=itortyp(itype(l))
8496 itj=itortyp(itype(j))
8497 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8498 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8499 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8504 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8506 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8510 derx_turn(lll,kkk,iii)=0.0d0
8517 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8519 cd write (2,*) 'eello6_5',eello6_5
8521 call transpose2(AEA(1,1,1),auxmat(1,1))
8522 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8523 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8524 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8526 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8527 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8528 s2 = scalar2(b1(1,itk),vtemp1(1))
8530 call transpose2(AEA(1,1,2),atemp(1,1))
8531 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8532 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8533 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8535 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8536 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8537 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8539 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8540 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8541 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8542 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8543 ss13 = scalar2(b1(1,itk),vtemp4(1))
8544 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8546 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8552 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8553 C Derivatives in gamma(i+2)
8557 call transpose2(AEA(1,1,1),auxmatd(1,1))
8558 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8559 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8560 call transpose2(AEAderg(1,1,2),atempd(1,1))
8561 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8562 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8564 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8565 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8566 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8572 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8573 C Derivatives in gamma(i+3)
8575 call transpose2(AEA(1,1,1),auxmatd(1,1))
8576 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8577 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8578 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8580 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8581 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8582 s2d = scalar2(b1(1,itk),vtemp1d(1))
8584 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8585 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8587 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8589 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8590 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8591 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8599 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8600 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8602 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8603 & -0.5d0*ekont*(s2d+s12d)
8605 C Derivatives in gamma(i+4)
8606 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8607 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8608 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8610 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8611 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8612 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8620 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8622 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8624 C Derivatives in gamma(i+5)
8626 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8627 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8628 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8630 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8631 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8632 s2d = scalar2(b1(1,itk),vtemp1d(1))
8634 call transpose2(AEA(1,1,2),atempd(1,1))
8635 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8636 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8638 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8639 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8641 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8642 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8643 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8651 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8652 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8654 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8655 & -0.5d0*ekont*(s2d+s12d)
8657 C Cartesian derivatives
8662 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8663 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8664 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8666 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8667 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8669 s2d = scalar2(b1(1,itk),vtemp1d(1))
8671 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8672 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8673 s8d = -(atempd(1,1)+atempd(2,2))*
8674 & scalar2(cc(1,1,itl),vtemp2(1))
8676 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8678 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8679 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8686 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8689 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8693 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8694 & - 0.5d0*(s8d+s12d)
8696 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8705 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8707 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8708 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8709 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8710 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8711 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8713 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8714 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8715 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8719 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8720 cd & 16*eel_turn6_num
8722 if (j.lt.nres-1) then
8729 if (l.lt.nres-1) then
8737 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8738 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8739 cgrad ghalf=0.5d0*ggg1(ll)
8741 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8742 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8743 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8744 & +ekont*derx_turn(ll,2,1)
8745 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8746 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8747 & +ekont*derx_turn(ll,4,1)
8748 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8749 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8750 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8751 cgrad ghalf=0.5d0*ggg2(ll)
8753 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8754 & +ekont*derx_turn(ll,2,2)
8755 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8756 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8757 & +ekont*derx_turn(ll,4,2)
8758 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8759 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8760 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8765 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8770 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8776 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8781 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8785 cd write (2,*) iii,g_corr6_loc(iii)
8787 eello_turn6=ekont*eel_turn6
8788 cd write (2,*) 'ekont',ekont
8789 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8793 C-----------------------------------------------------------------------------
8794 double precision function scalar(u,v)
8795 !DIR$ INLINEALWAYS scalar
8797 cDEC$ ATTRIBUTES FORCEINLINE::scalar
8800 double precision u(3),v(3)
8801 cd double precision sc
8809 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
8812 crc-------------------------------------------------
8813 SUBROUTINE MATVEC2(A1,V1,V2)
8814 !DIR$ INLINEALWAYS MATVEC2
8816 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
8818 implicit real*8 (a-h,o-z)
8819 include 'DIMENSIONS'
8820 DIMENSION A1(2,2),V1(2),V2(2)
8824 c 3 VI=VI+A1(I,K)*V1(K)
8828 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8829 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8834 C---------------------------------------
8835 SUBROUTINE MATMAT2(A1,A2,A3)
8837 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
8839 implicit real*8 (a-h,o-z)
8840 include 'DIMENSIONS'
8841 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8842 c DIMENSION AI3(2,2)
8846 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8852 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8853 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8854 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8855 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8863 c-------------------------------------------------------------------------
8864 double precision function scalar2(u,v)
8865 !DIR$ INLINEALWAYS scalar2
8867 double precision u(2),v(2)
8870 scalar2=u(1)*v(1)+u(2)*v(2)
8874 C-----------------------------------------------------------------------------
8876 subroutine transpose2(a,at)
8877 !DIR$ INLINEALWAYS transpose2
8879 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
8882 double precision a(2,2),at(2,2)
8889 c--------------------------------------------------------------------------
8890 subroutine transpose(n,a,at)
8893 double precision a(n,n),at(n,n)
8901 C---------------------------------------------------------------------------
8902 subroutine prodmat3(a1,a2,kk,transp,prod)
8903 !DIR$ INLINEALWAYS prodmat3
8905 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
8909 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
8911 crc double precision auxmat(2,2),prod_(2,2)
8914 crc call transpose2(kk(1,1),auxmat(1,1))
8915 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
8916 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8918 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
8919 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
8920 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
8921 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
8922 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
8923 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
8924 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
8925 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
8928 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
8929 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
8931 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
8932 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
8933 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
8934 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
8935 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
8936 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
8937 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
8938 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
8941 c call transpose2(a2(1,1),a2t(1,1))
8944 crc print *,((prod_(i,j),i=1,2),j=1,2)
8945 crc print *,((prod(i,j),i=1,2),j=1,2)