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 Here are the energies showed per procesor if the are more processors
300 c per molecule then we sum it up in sum_energy subroutine
301 c print *," Processor",myrank," calls SUM_ENERGY"
302 call sum_energy(energia,.true.)
303 c print *," Processor",myrank," left SUM_ENERGY"
305 time_sumene=time_sumene+MPI_Wtime()-time00
309 c-------------------------------------------------------------------------------
310 subroutine sum_energy(energia,reduce)
311 implicit real*8 (a-h,o-z)
316 cMS$ATTRIBUTES C :: proc_proc
322 include 'COMMON.SETUP'
323 include 'COMMON.IOUNITS'
324 double precision energia(0:n_ene),enebuff(0:n_ene+1)
325 include 'COMMON.FFIELD'
326 include 'COMMON.DERIV'
327 include 'COMMON.INTERACT'
328 include 'COMMON.SBRIDGE'
329 include 'COMMON.CHAIN'
331 include 'COMMON.CONTROL'
332 include 'COMMON.TIME1'
335 if (nfgtasks.gt.1 .and. reduce) then
337 write (iout,*) "energies before REDUCE"
338 call enerprint(energia)
342 enebuff(i)=energia(i)
345 call MPI_Barrier(FG_COMM,IERR)
346 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
348 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
349 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
351 write (iout,*) "energies after REDUCE"
352 call enerprint(energia)
355 time_Reduce=time_Reduce+MPI_Wtime()-time00
357 if (fg_rank.eq.0) then
361 evdw2=energia(2)+energia(18)
377 eello_turn3=energia(8)
378 eello_turn4=energia(9)
385 edihcnstr=energia(19)
390 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
391 & +wang*ebe+wtor*etors+wscloc*escloc
392 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
393 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
394 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
395 & +wbond*estr+Uconst+wsccor*esccor
397 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
398 & +wang*ebe+wtor*etors+wscloc*escloc
399 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
400 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
401 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
402 & +wbond*estr+Uconst+wsccor*esccor
408 if (isnan(etot).ne.0) energia(0)=1.0d+99
410 if (isnan(etot)) energia(0)=1.0d+99
415 idumm=proc_proc(etot,i)
417 call proc_proc(etot,i)
419 if(i.eq.1)energia(0)=1.0d+99
426 c-------------------------------------------------------------------------------
427 subroutine sum_gradient
428 implicit real*8 (a-h,o-z)
433 cMS$ATTRIBUTES C :: proc_proc
438 double precision gradbufc(3,maxres),gradbufx(3,maxres),
439 & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres)
441 include 'COMMON.SETUP'
442 include 'COMMON.IOUNITS'
443 include 'COMMON.FFIELD'
444 include 'COMMON.DERIV'
445 include 'COMMON.INTERACT'
446 include 'COMMON.SBRIDGE'
447 include 'COMMON.CHAIN'
449 include 'COMMON.CONTROL'
450 include 'COMMON.TIME1'
451 include 'COMMON.MAXGRAD'
452 include 'COMMON.SCCOR'
457 write (iout,*) "sum_gradient gvdwc, gvdwx"
459 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
460 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
465 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
466 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
467 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
470 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
471 C in virtual-bond-vector coordinates
474 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
476 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
477 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
479 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
481 c write (iout,'(i5,3f10.5,2x,f10.5)')
482 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
484 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
486 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
487 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
495 gradbufc(j,i)=wsc*gvdwc(j,i)+
496 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
497 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
498 & wel_loc*gel_loc_long(j,i)+
499 & wcorr*gradcorr_long(j,i)+
500 & wcorr5*gradcorr5_long(j,i)+
501 & wcorr6*gradcorr6_long(j,i)+
502 & wturn6*gcorr6_turn_long(j,i)+
509 gradbufc(j,i)=wsc*gvdwc(j,i)+
510 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
511 & welec*gelc_long(j,i)+
513 & wel_loc*gel_loc_long(j,i)+
514 & wcorr*gradcorr_long(j,i)+
515 & wcorr5*gradcorr5_long(j,i)+
516 & wcorr6*gradcorr6_long(j,i)+
517 & wturn6*gcorr6_turn_long(j,i)+
523 if (nfgtasks.gt.1) then
526 write (iout,*) "gradbufc before allreduce"
528 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
534 gradbufc_sum(j,i)=gradbufc(j,i)
537 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
538 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
539 c time_reduce=time_reduce+MPI_Wtime()-time00
541 c write (iout,*) "gradbufc_sum after allreduce"
543 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
548 c time_allreduce=time_allreduce+MPI_Wtime()-time00
556 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
557 write (iout,*) (i," jgrad_start",jgrad_start(i),
558 & " jgrad_end ",jgrad_end(i),
559 & i=igrad_start,igrad_end)
562 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
563 c do not parallelize this part.
565 c do i=igrad_start,igrad_end
566 c do j=jgrad_start(i),jgrad_end(i)
568 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
573 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
577 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
581 write (iout,*) "gradbufc after summing"
583 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
590 write (iout,*) "gradbufc"
592 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
598 gradbufc_sum(j,i)=gradbufc(j,i)
603 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
607 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
612 c gradbufc(k,i)=0.0d0
616 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
621 write (iout,*) "gradbufc after summing"
623 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
631 gradbufc(k,nres)=0.0d0
636 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
637 & wel_loc*gel_loc(j,i)+
638 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
639 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
640 & wel_loc*gel_loc_long(j,i)+
641 & wcorr*gradcorr_long(j,i)+
642 & wcorr5*gradcorr5_long(j,i)+
643 & wcorr6*gradcorr6_long(j,i)+
644 & wturn6*gcorr6_turn_long(j,i))+
646 & wcorr*gradcorr(j,i)+
647 & wturn3*gcorr3_turn(j,i)+
648 & wturn4*gcorr4_turn(j,i)+
649 & wcorr5*gradcorr5(j,i)+
650 & wcorr6*gradcorr6(j,i)+
651 & wturn6*gcorr6_turn(j,i)+
652 & wsccor*gsccorc(j,i)
653 & +wscloc*gscloc(j,i)
655 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
656 & wel_loc*gel_loc(j,i)+
657 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
658 & welec*gelc_long(j,i)
659 & wel_loc*gel_loc_long(j,i)+
660 & wcorr*gcorr_long(j,i)+
661 & wcorr5*gradcorr5_long(j,i)+
662 & wcorr6*gradcorr6_long(j,i)+
663 & wturn6*gcorr6_turn_long(j,i))+
665 & wcorr*gradcorr(j,i)+
666 & wturn3*gcorr3_turn(j,i)+
667 & wturn4*gcorr4_turn(j,i)+
668 & wcorr5*gradcorr5(j,i)+
669 & wcorr6*gradcorr6(j,i)+
670 & wturn6*gcorr6_turn(j,i)+
671 & wsccor*gsccorc(j,i)
672 & +wscloc*gscloc(j,i)
674 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
676 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
677 & wsccor*gsccorx(j,i)
678 & +wscloc*gsclocx(j,i)
682 write (iout,*) "gloc before adding corr"
684 write (iout,*) i,gloc(i,icg)
688 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
689 & +wcorr5*g_corr5_loc(i)
690 & +wcorr6*g_corr6_loc(i)
691 & +wturn4*gel_loc_turn4(i)
692 & +wturn3*gel_loc_turn3(i)
693 & +wturn6*gel_loc_turn6(i)
694 & +wel_loc*gel_loc_loc(i)
697 write (iout,*) "gloc after adding corr"
699 write (iout,*) i,gloc(i,icg)
703 if (nfgtasks.gt.1) then
706 gradbufc(j,i)=gradc(j,i,icg)
707 gradbufx(j,i)=gradx(j,i,icg)
711 glocbuf(i)=gloc(i,icg)
715 write (iout,*) "gloc_sc before reduce"
718 write (iout,*) i,j,gloc_sc(j,i,icg)
725 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
729 call MPI_Barrier(FG_COMM,IERR)
730 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
732 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
733 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
734 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
735 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
736 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
737 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
738 time_reduce=time_reduce+MPI_Wtime()-time00
739 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
740 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
741 time_reduce=time_reduce+MPI_Wtime()-time00
744 write (iout,*) "gloc_sc after reduce"
747 write (iout,*) i,j,gloc_sc(j,i,icg)
753 write (iout,*) "gloc after reduce"
755 write (iout,*) i,gloc(i,icg)
760 if (gnorm_check) then
762 c Compute the maximum elements of the gradient
772 gcorr3_turn_max=0.0d0
773 gcorr4_turn_max=0.0d0
776 gcorr6_turn_max=0.0d0
786 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
787 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
788 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
789 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
790 & gvdwc_scp_max=gvdwc_scp_norm
791 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
792 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
793 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
794 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
795 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
796 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
797 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
798 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
799 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
800 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
801 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
802 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
803 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
805 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
806 & gcorr3_turn_max=gcorr3_turn_norm
807 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
809 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
810 & gcorr4_turn_max=gcorr4_turn_norm
811 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
812 if (gradcorr5_norm.gt.gradcorr5_max)
813 & gradcorr5_max=gradcorr5_norm
814 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
815 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
816 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
818 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
819 & gcorr6_turn_max=gcorr6_turn_norm
820 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
821 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
822 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
823 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
824 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
825 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
826 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
827 if (gradx_scp_norm.gt.gradx_scp_max)
828 & gradx_scp_max=gradx_scp_norm
829 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
830 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
831 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
832 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
833 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
834 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
835 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
836 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
840 open(istat,file=statname,position="append")
842 open(istat,file=statname,access="append")
844 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
845 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
846 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
847 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
848 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
849 & gsccorx_max,gsclocx_max
851 if (gvdwc_max.gt.1.0d4) then
852 write (iout,*) "gvdwc gvdwx gradb gradbx"
854 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
855 & gradb(j,i),gradbx(j,i),j=1,3)
857 call pdbout(0.0d0,'cipiszcze',iout)
863 write (iout,*) "gradc gradx gloc"
865 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
866 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
870 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
874 c-------------------------------------------------------------------------------
875 subroutine rescale_weights(t_bath)
876 implicit real*8 (a-h,o-z)
878 include 'COMMON.IOUNITS'
879 include 'COMMON.FFIELD'
880 include 'COMMON.SBRIDGE'
881 double precision kfac /2.4d0/
882 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
884 c facT=2*temp0/(t_bath+temp0)
885 if (rescale_mode.eq.0) then
891 else if (rescale_mode.eq.1) then
892 facT=kfac/(kfac-1.0d0+t_bath/temp0)
893 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
894 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
895 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
896 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
897 else if (rescale_mode.eq.2) then
903 facT=licznik/dlog(dexp(x)+dexp(-x))
904 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
905 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
906 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
907 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
909 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
910 write (*,*) "Wrong RESCALE_MODE",rescale_mode
912 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
916 welec=weights(3)*fact
917 wcorr=weights(4)*fact3
918 wcorr5=weights(5)*fact4
919 wcorr6=weights(6)*fact5
920 wel_loc=weights(7)*fact2
921 wturn3=weights(8)*fact2
922 wturn4=weights(9)*fact3
923 wturn6=weights(10)*fact5
924 wtor=weights(13)*fact
925 wtor_d=weights(14)*fact2
926 wsccor=weights(21)*fact
930 C------------------------------------------------------------------------
931 subroutine enerprint(energia)
932 implicit real*8 (a-h,o-z)
934 include 'COMMON.IOUNITS'
935 include 'COMMON.FFIELD'
936 include 'COMMON.SBRIDGE'
938 double precision energia(0:n_ene)
943 evdw2=energia(2)+energia(18)
955 eello_turn3=energia(8)
956 eello_turn4=energia(9)
957 eello_turn6=energia(10)
963 edihcnstr=energia(19)
968 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
969 & estr,wbond,ebe,wang,
970 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
972 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
973 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
976 10 format (/'Virtual-chain energies:'//
977 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
978 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
979 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
980 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
981 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
982 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
983 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
984 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
985 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
986 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
987 & ' (SS bridges & dist. cnstr.)'/
988 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
989 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
990 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
991 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
992 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
993 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
994 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
995 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
996 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
997 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
998 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
999 & 'ETOT= ',1pE16.6,' (total)')
1001 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1002 & estr,wbond,ebe,wang,
1003 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1005 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1006 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1007 & ebr*nss,Uconst,etot
1008 10 format (/'Virtual-chain energies:'//
1009 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1010 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1011 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1012 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1013 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1014 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1015 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1016 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1017 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1018 & ' (SS bridges & dist. cnstr.)'/
1019 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1020 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1021 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1022 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1023 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1024 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1025 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1026 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1027 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1028 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1029 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1030 & 'ETOT= ',1pE16.6,' (total)')
1034 C-----------------------------------------------------------------------
1035 subroutine elj(evdw)
1037 C This subroutine calculates the interaction energy of nonbonded side chains
1038 C assuming the LJ potential of interaction.
1040 implicit real*8 (a-h,o-z)
1041 include 'DIMENSIONS'
1042 parameter (accur=1.0d-10)
1043 include 'COMMON.GEO'
1044 include 'COMMON.VAR'
1045 include 'COMMON.LOCAL'
1046 include 'COMMON.CHAIN'
1047 include 'COMMON.DERIV'
1048 include 'COMMON.INTERACT'
1049 include 'COMMON.TORSION'
1050 include 'COMMON.SBRIDGE'
1051 include 'COMMON.NAMES'
1052 include 'COMMON.IOUNITS'
1053 include 'COMMON.CONTACTS'
1055 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1057 do i=iatsc_s,iatsc_e
1058 itypi=iabs(itype(i))
1059 if (itypi.eq.ntyp1) cycle
1060 itypi1=iabs(itype(i+1))
1067 C Calculate SC interaction energy.
1069 do iint=1,nint_gr(i)
1070 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1071 cd & 'iend=',iend(i,iint)
1072 do j=istart(i,iint),iend(i,iint)
1073 itypj=iabs(itype(j))
1074 if (itypj.eq.ntyp1) cycle
1078 C Change 12/1/95 to calculate four-body interactions
1079 rij=xj*xj+yj*yj+zj*zj
1081 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1082 eps0ij=eps(itypi,itypj)
1084 e1=fac*fac*aa(itypi,itypj)
1085 e2=fac*bb(itypi,itypj)
1087 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1088 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1089 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1090 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1091 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1092 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1095 C Calculate the components of the gradient in DC and X
1097 fac=-rrij*(e1+evdwij)
1102 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1103 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1104 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1105 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1109 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1113 C 12/1/95, revised on 5/20/97
1115 C Calculate the contact function. The ith column of the array JCONT will
1116 C contain the numbers of atoms that make contacts with the atom I (of numbers
1117 C greater than I). The arrays FACONT and GACONT will contain the values of
1118 C the contact function and its derivative.
1120 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1121 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1122 C Uncomment next line, if the correlation interactions are contact function only
1123 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1125 sigij=sigma(itypi,itypj)
1126 r0ij=rs0(itypi,itypj)
1128 C Check whether the SC's are not too far to make a contact.
1131 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1132 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1134 if (fcont.gt.0.0D0) then
1135 C If the SC-SC distance if close to sigma, apply spline.
1136 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1137 cAdam & fcont1,fprimcont1)
1138 cAdam fcont1=1.0d0-fcont1
1139 cAdam if (fcont1.gt.0.0d0) then
1140 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1141 cAdam fcont=fcont*fcont1
1143 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1144 cga eps0ij=1.0d0/dsqrt(eps0ij)
1146 cga gg(k)=gg(k)*eps0ij
1148 cga eps0ij=-evdwij*eps0ij
1149 C Uncomment for AL's type of SC correlation interactions.
1150 cadam eps0ij=-evdwij
1151 num_conti=num_conti+1
1152 jcont(num_conti,i)=j
1153 facont(num_conti,i)=fcont*eps0ij
1154 fprimcont=eps0ij*fprimcont/rij
1156 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1157 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1158 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1159 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1160 gacont(1,num_conti,i)=-fprimcont*xj
1161 gacont(2,num_conti,i)=-fprimcont*yj
1162 gacont(3,num_conti,i)=-fprimcont*zj
1163 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1164 cd write (iout,'(2i3,3f10.5)')
1165 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1171 num_cont(i)=num_conti
1175 gvdwc(j,i)=expon*gvdwc(j,i)
1176 gvdwx(j,i)=expon*gvdwx(j,i)
1179 C******************************************************************************
1183 C To save time, the factor of EXPON has been extracted from ALL components
1184 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1187 C******************************************************************************
1190 C-----------------------------------------------------------------------------
1191 subroutine eljk(evdw)
1193 C This subroutine calculates the interaction energy of nonbonded side chains
1194 C assuming the LJK potential of interaction.
1196 implicit real*8 (a-h,o-z)
1197 include 'DIMENSIONS'
1198 include 'COMMON.GEO'
1199 include 'COMMON.VAR'
1200 include 'COMMON.LOCAL'
1201 include 'COMMON.CHAIN'
1202 include 'COMMON.DERIV'
1203 include 'COMMON.INTERACT'
1204 include 'COMMON.IOUNITS'
1205 include 'COMMON.NAMES'
1208 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1210 do i=iatsc_s,iatsc_e
1211 itypi=iabs(itype(i))
1212 if (itypi.eq.ntyp1) cycle
1213 itypi1=iabs(itype(i+1))
1218 C Calculate SC interaction energy.
1220 do iint=1,nint_gr(i)
1221 do j=istart(i,iint),iend(i,iint)
1222 itypj=iabs(itype(j))
1223 if (itypj.eq.ntyp1) cycle
1227 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1228 fac_augm=rrij**expon
1229 e_augm=augm(itypi,itypj)*fac_augm
1230 r_inv_ij=dsqrt(rrij)
1232 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1233 fac=r_shift_inv**expon
1234 e1=fac*fac*aa(itypi,itypj)
1235 e2=fac*bb(itypi,itypj)
1237 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1238 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1239 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1240 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1241 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1242 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1243 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1246 C Calculate the components of the gradient in DC and X
1248 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1253 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1254 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1255 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1256 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1260 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1268 gvdwc(j,i)=expon*gvdwc(j,i)
1269 gvdwx(j,i)=expon*gvdwx(j,i)
1274 C-----------------------------------------------------------------------------
1275 subroutine ebp(evdw)
1277 C This subroutine calculates the interaction energy of nonbonded side chains
1278 C assuming the Berne-Pechukas potential of interaction.
1280 implicit real*8 (a-h,o-z)
1281 include 'DIMENSIONS'
1282 include 'COMMON.GEO'
1283 include 'COMMON.VAR'
1284 include 'COMMON.LOCAL'
1285 include 'COMMON.CHAIN'
1286 include 'COMMON.DERIV'
1287 include 'COMMON.NAMES'
1288 include 'COMMON.INTERACT'
1289 include 'COMMON.IOUNITS'
1290 include 'COMMON.CALC'
1291 common /srutu/ icall
1292 c double precision rrsave(maxdim)
1295 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1297 c if (icall.eq.0) then
1303 do i=iatsc_s,iatsc_e
1304 itypi=iabs(itype(i))
1305 if (itypi.eq.ntyp1) cycle
1306 itypi1=iabs(itype(i+1))
1310 dxi=dc_norm(1,nres+i)
1311 dyi=dc_norm(2,nres+i)
1312 dzi=dc_norm(3,nres+i)
1313 c dsci_inv=dsc_inv(itypi)
1314 dsci_inv=vbld_inv(i+nres)
1316 C Calculate SC interaction energy.
1318 do iint=1,nint_gr(i)
1319 do j=istart(i,iint),iend(i,iint)
1321 itypj=iabs(itype(j))
1322 if (itypj.eq.ntyp1) cycle
1323 c dscj_inv=dsc_inv(itypj)
1324 dscj_inv=vbld_inv(j+nres)
1325 chi1=chi(itypi,itypj)
1326 chi2=chi(itypj,itypi)
1333 alf12=0.5D0*(alf1+alf2)
1334 C For diagnostics only!!!
1347 dxj=dc_norm(1,nres+j)
1348 dyj=dc_norm(2,nres+j)
1349 dzj=dc_norm(3,nres+j)
1350 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1351 cd if (icall.eq.0) then
1357 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1359 C Calculate whole angle-dependent part of epsilon and contributions
1360 C to its derivatives
1361 fac=(rrij*sigsq)**expon2
1362 e1=fac*fac*aa(itypi,itypj)
1363 e2=fac*bb(itypi,itypj)
1364 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1365 eps2der=evdwij*eps3rt
1366 eps3der=evdwij*eps2rt
1367 evdwij=evdwij*eps2rt*eps3rt
1370 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1371 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1372 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1373 cd & restyp(itypi),i,restyp(itypj),j,
1374 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1375 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1376 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1379 C Calculate gradient components.
1380 e1=e1*eps1*eps2rt**2*eps3rt**2
1381 fac=-expon*(e1+evdwij)
1384 C Calculate radial part of the gradient
1388 C Calculate the angular part of the gradient and sum add the contributions
1389 C to the appropriate components of the Cartesian gradient.
1397 C-----------------------------------------------------------------------------
1398 subroutine egb(evdw)
1400 C This subroutine calculates the interaction energy of nonbonded side chains
1401 C assuming the Gay-Berne potential of interaction.
1403 implicit real*8 (a-h,o-z)
1404 include 'DIMENSIONS'
1405 include 'COMMON.GEO'
1406 include 'COMMON.VAR'
1407 include 'COMMON.LOCAL'
1408 include 'COMMON.CHAIN'
1409 include 'COMMON.DERIV'
1410 include 'COMMON.NAMES'
1411 include 'COMMON.INTERACT'
1412 include 'COMMON.IOUNITS'
1413 include 'COMMON.CALC'
1414 include 'COMMON.CONTROL'
1417 ccccc energy_dec=.false.
1418 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1421 c if (icall.eq.0) lprn=.false.
1423 do i=iatsc_s,iatsc_e
1424 itypi=iabs(itype(i))
1425 if (itypi.eq.ntyp1) cycle
1426 itypi1=iabs(itype(i+1))
1430 dxi=dc_norm(1,nres+i)
1431 dyi=dc_norm(2,nres+i)
1432 dzi=dc_norm(3,nres+i)
1433 c dsci_inv=dsc_inv(itypi)
1434 dsci_inv=vbld_inv(i+nres)
1435 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1436 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1438 C Calculate SC interaction energy.
1440 do iint=1,nint_gr(i)
1441 do j=istart(i,iint),iend(i,iint)
1443 itypj=iabs(itype(j))
1444 if (itypj.eq.ntyp1) cycle
1445 c dscj_inv=dsc_inv(itypj)
1446 dscj_inv=vbld_inv(j+nres)
1447 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1448 c & 1.0d0/vbld(j+nres)
1449 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1450 sig0ij=sigma(itypi,itypj)
1451 chi1=chi(itypi,itypj)
1452 chi2=chi(itypj,itypi)
1459 alf12=0.5D0*(alf1+alf2)
1460 C For diagnostics only!!!
1473 dxj=dc_norm(1,nres+j)
1474 dyj=dc_norm(2,nres+j)
1475 dzj=dc_norm(3,nres+j)
1476 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1477 c write (iout,*) "j",j," dc_norm",
1478 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1479 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1481 C Calculate angle-dependent terms of energy and contributions to their
1485 sig=sig0ij*dsqrt(sigsq)
1486 rij_shift=1.0D0/rij-sig+sig0ij
1487 c for diagnostics; uncomment
1488 c rij_shift=1.2*sig0ij
1489 C I hate to put IF's in the loops, but here don't have another choice!!!!
1490 if (rij_shift.le.0.0D0) then
1492 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1493 cd & restyp(itypi),i,restyp(itypj),j,
1494 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1498 c---------------------------------------------------------------
1499 rij_shift=1.0D0/rij_shift
1500 fac=rij_shift**expon
1501 e1=fac*fac*aa(itypi,itypj)
1502 e2=fac*bb(itypi,itypj)
1503 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1504 eps2der=evdwij*eps3rt
1505 eps3der=evdwij*eps2rt
1506 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1507 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1508 evdwij=evdwij*eps2rt*eps3rt
1511 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1512 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1513 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1514 & restyp(itypi),i,restyp(itypj),j,
1515 & epsi,sigm,chi1,chi2,chip1,chip2,
1516 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1517 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1521 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1524 C Calculate gradient components.
1525 e1=e1*eps1*eps2rt**2*eps3rt**2
1526 fac=-expon*(e1+evdwij)*rij_shift
1530 C Calculate the radial part of the gradient
1534 C Calculate angular part of the gradient.
1539 c write (iout,*) "Number of loop steps in EGB:",ind
1540 cccc energy_dec=.false.
1543 C-----------------------------------------------------------------------------
1544 subroutine egbv(evdw)
1546 C This subroutine calculates the interaction energy of nonbonded side chains
1547 C assuming the Gay-Berne-Vorobjev potential of interaction.
1549 implicit real*8 (a-h,o-z)
1550 include 'DIMENSIONS'
1551 include 'COMMON.GEO'
1552 include 'COMMON.VAR'
1553 include 'COMMON.LOCAL'
1554 include 'COMMON.CHAIN'
1555 include 'COMMON.DERIV'
1556 include 'COMMON.NAMES'
1557 include 'COMMON.INTERACT'
1558 include 'COMMON.IOUNITS'
1559 include 'COMMON.CALC'
1560 common /srutu/ icall
1563 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1566 c if (icall.eq.0) lprn=.true.
1568 do i=iatsc_s,iatsc_e
1569 itypi=iabs(itype(i))
1570 if (itypi.eq.ntyp1) cycle
1571 itypi1=iabs(itype(i+1))
1575 dxi=dc_norm(1,nres+i)
1576 dyi=dc_norm(2,nres+i)
1577 dzi=dc_norm(3,nres+i)
1578 c dsci_inv=dsc_inv(itypi)
1579 dsci_inv=vbld_inv(i+nres)
1581 C Calculate SC interaction energy.
1583 do iint=1,nint_gr(i)
1584 do j=istart(i,iint),iend(i,iint)
1586 itypj=iabs(itype(j))
1587 if (itypj.eq.ntyp1) cycle
1588 c dscj_inv=dsc_inv(itypj)
1589 dscj_inv=vbld_inv(j+nres)
1590 sig0ij=sigma(itypi,itypj)
1591 r0ij=r0(itypi,itypj)
1592 chi1=chi(itypi,itypj)
1593 chi2=chi(itypj,itypi)
1600 alf12=0.5D0*(alf1+alf2)
1601 C For diagnostics only!!!
1614 dxj=dc_norm(1,nres+j)
1615 dyj=dc_norm(2,nres+j)
1616 dzj=dc_norm(3,nres+j)
1617 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1619 C Calculate angle-dependent terms of energy and contributions to their
1623 sig=sig0ij*dsqrt(sigsq)
1624 rij_shift=1.0D0/rij-sig+r0ij
1625 C I hate to put IF's in the loops, but here don't have another choice!!!!
1626 if (rij_shift.le.0.0D0) then
1631 c---------------------------------------------------------------
1632 rij_shift=1.0D0/rij_shift
1633 fac=rij_shift**expon
1634 e1=fac*fac*aa(itypi,itypj)
1635 e2=fac*bb(itypi,itypj)
1636 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1637 eps2der=evdwij*eps3rt
1638 eps3der=evdwij*eps2rt
1639 fac_augm=rrij**expon
1640 e_augm=augm(itypi,itypj)*fac_augm
1641 evdwij=evdwij*eps2rt*eps3rt
1642 evdw=evdw+evdwij+e_augm
1644 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1645 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1646 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1647 & restyp(itypi),i,restyp(itypj),j,
1648 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1649 & chi1,chi2,chip1,chip2,
1650 & eps1,eps2rt**2,eps3rt**2,
1651 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1654 C Calculate gradient components.
1655 e1=e1*eps1*eps2rt**2*eps3rt**2
1656 fac=-expon*(e1+evdwij)*rij_shift
1658 fac=rij*fac-2*expon*rrij*e_augm
1659 C Calculate the radial part of the gradient
1663 C Calculate angular part of the gradient.
1669 C-----------------------------------------------------------------------------
1670 subroutine sc_angular
1671 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1672 C om12. Called by ebp, egb, and egbv.
1674 include 'COMMON.CALC'
1675 include 'COMMON.IOUNITS'
1679 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1680 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1681 om12=dxi*dxj+dyi*dyj+dzi*dzj
1683 C Calculate eps1(om12) and its derivative in om12
1684 faceps1=1.0D0-om12*chiom12
1685 faceps1_inv=1.0D0/faceps1
1686 eps1=dsqrt(faceps1_inv)
1687 C Following variable is eps1*deps1/dom12
1688 eps1_om12=faceps1_inv*chiom12
1693 c write (iout,*) "om12",om12," eps1",eps1
1694 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1699 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1700 sigsq=1.0D0-facsig*faceps1_inv
1701 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1702 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1703 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1709 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1710 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1712 C Calculate eps2 and its derivatives in om1, om2, and om12.
1715 chipom12=chip12*om12
1716 facp=1.0D0-om12*chipom12
1718 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1719 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1720 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1721 C Following variable is the square root of eps2
1722 eps2rt=1.0D0-facp1*facp_inv
1723 C Following three variables are the derivatives of the square root of eps
1724 C in om1, om2, and om12.
1725 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1726 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1727 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1728 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1729 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1730 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1731 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1732 c & " eps2rt_om12",eps2rt_om12
1733 C Calculate whole angle-dependent part of epsilon and contributions
1734 C to its derivatives
1737 C----------------------------------------------------------------------------
1739 implicit real*8 (a-h,o-z)
1740 include 'DIMENSIONS'
1741 include 'COMMON.CHAIN'
1742 include 'COMMON.DERIV'
1743 include 'COMMON.CALC'
1744 include 'COMMON.IOUNITS'
1745 double precision dcosom1(3),dcosom2(3)
1746 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1747 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1748 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1749 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1753 c eom12=evdwij*eps1_om12
1755 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1756 c & " sigder",sigder
1757 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1758 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1760 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1761 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1764 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1766 c write (iout,*) "gg",(gg(k),k=1,3)
1768 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1769 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1770 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1771 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1772 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1773 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1774 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1775 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1776 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1777 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1780 C Calculate the components of the gradient in DC and X
1784 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1788 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1789 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1793 C-----------------------------------------------------------------------
1794 subroutine e_softsphere(evdw)
1796 C This subroutine calculates the interaction energy of nonbonded side chains
1797 C assuming the LJ potential of interaction.
1799 implicit real*8 (a-h,o-z)
1800 include 'DIMENSIONS'
1801 parameter (accur=1.0d-10)
1802 include 'COMMON.GEO'
1803 include 'COMMON.VAR'
1804 include 'COMMON.LOCAL'
1805 include 'COMMON.CHAIN'
1806 include 'COMMON.DERIV'
1807 include 'COMMON.INTERACT'
1808 include 'COMMON.TORSION'
1809 include 'COMMON.SBRIDGE'
1810 include 'COMMON.NAMES'
1811 include 'COMMON.IOUNITS'
1812 include 'COMMON.CONTACTS'
1814 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1816 do i=iatsc_s,iatsc_e
1817 itypi=iabs(itype(i))
1818 if (itypi.eq.ntyp1) cycle
1819 itypi1=iabs(itype(i+1))
1824 C Calculate SC interaction energy.
1826 do iint=1,nint_gr(i)
1827 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1828 cd & 'iend=',iend(i,iint)
1829 do j=istart(i,iint),iend(i,iint)
1830 itypj=iabs(itype(j))
1831 if (itypj.eq.ntyp1) cycle
1835 rij=xj*xj+yj*yj+zj*zj
1836 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1837 r0ij=r0(itypi,itypj)
1839 c print *,i,j,r0ij,dsqrt(rij)
1840 if (rij.lt.r0ijsq) then
1841 evdwij=0.25d0*(rij-r0ijsq)**2
1849 C Calculate the components of the gradient in DC and X
1855 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1856 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1857 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1858 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1862 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1870 C--------------------------------------------------------------------------
1871 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
1874 C Soft-sphere potential of p-p interaction
1876 implicit real*8 (a-h,o-z)
1877 include 'DIMENSIONS'
1878 include 'COMMON.CONTROL'
1879 include 'COMMON.IOUNITS'
1880 include 'COMMON.GEO'
1881 include 'COMMON.VAR'
1882 include 'COMMON.LOCAL'
1883 include 'COMMON.CHAIN'
1884 include 'COMMON.DERIV'
1885 include 'COMMON.INTERACT'
1886 include 'COMMON.CONTACTS'
1887 include 'COMMON.TORSION'
1888 include 'COMMON.VECTORS'
1889 include 'COMMON.FFIELD'
1891 cd write(iout,*) 'In EELEC_soft_sphere'
1898 do i=iatel_s,iatel_e
1899 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
1903 xmedi=c(1,i)+0.5d0*dxi
1904 ymedi=c(2,i)+0.5d0*dyi
1905 zmedi=c(3,i)+0.5d0*dzi
1907 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
1908 do j=ielstart(i),ielend(i)
1909 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
1913 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
1914 r0ij=rpp(iteli,itelj)
1919 xj=c(1,j)+0.5D0*dxj-xmedi
1920 yj=c(2,j)+0.5D0*dyj-ymedi
1921 zj=c(3,j)+0.5D0*dzj-zmedi
1922 rij=xj*xj+yj*yj+zj*zj
1923 if (rij.lt.r0ijsq) then
1924 evdw1ij=0.25d0*(rij-r0ijsq)**2
1932 C Calculate contributions to the Cartesian gradient.
1938 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
1939 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
1942 * Loop over residues i+1 thru j-1.
1946 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
1951 cgrad do i=nnt,nct-1
1953 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
1955 cgrad do j=i+1,nct-1
1957 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
1963 c------------------------------------------------------------------------------
1964 subroutine vec_and_deriv
1965 implicit real*8 (a-h,o-z)
1966 include 'DIMENSIONS'
1970 include 'COMMON.IOUNITS'
1971 include 'COMMON.GEO'
1972 include 'COMMON.VAR'
1973 include 'COMMON.LOCAL'
1974 include 'COMMON.CHAIN'
1975 include 'COMMON.VECTORS'
1976 include 'COMMON.SETUP'
1977 include 'COMMON.TIME1'
1978 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
1979 C Compute the local reference systems. For reference system (i), the
1980 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
1981 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
1983 do i=ivec_start,ivec_end
1987 if (i.eq.nres-1) then
1988 C Case of the last full residue
1989 C Compute the Z-axis
1990 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
1991 costh=dcos(pi-theta(nres))
1992 fac=1.0d0/dsqrt(1.0d0-costh*costh)
1996 C Compute the derivatives of uz
1998 uzder(2,1,1)=-dc_norm(3,i-1)
1999 uzder(3,1,1)= dc_norm(2,i-1)
2000 uzder(1,2,1)= dc_norm(3,i-1)
2002 uzder(3,2,1)=-dc_norm(1,i-1)
2003 uzder(1,3,1)=-dc_norm(2,i-1)
2004 uzder(2,3,1)= dc_norm(1,i-1)
2007 uzder(2,1,2)= dc_norm(3,i)
2008 uzder(3,1,2)=-dc_norm(2,i)
2009 uzder(1,2,2)=-dc_norm(3,i)
2011 uzder(3,2,2)= dc_norm(1,i)
2012 uzder(1,3,2)= dc_norm(2,i)
2013 uzder(2,3,2)=-dc_norm(1,i)
2015 C Compute the Y-axis
2018 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2020 C Compute the derivatives of uy
2023 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2024 & -dc_norm(k,i)*dc_norm(j,i-1)
2025 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2027 uyder(j,j,1)=uyder(j,j,1)-costh
2028 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2033 uygrad(l,k,j,i)=uyder(l,k,j)
2034 uzgrad(l,k,j,i)=uzder(l,k,j)
2038 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2039 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2040 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2041 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2044 C Compute the Z-axis
2045 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2046 costh=dcos(pi-theta(i+2))
2047 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2051 C Compute the derivatives of uz
2053 uzder(2,1,1)=-dc_norm(3,i+1)
2054 uzder(3,1,1)= dc_norm(2,i+1)
2055 uzder(1,2,1)= dc_norm(3,i+1)
2057 uzder(3,2,1)=-dc_norm(1,i+1)
2058 uzder(1,3,1)=-dc_norm(2,i+1)
2059 uzder(2,3,1)= dc_norm(1,i+1)
2062 uzder(2,1,2)= dc_norm(3,i)
2063 uzder(3,1,2)=-dc_norm(2,i)
2064 uzder(1,2,2)=-dc_norm(3,i)
2066 uzder(3,2,2)= dc_norm(1,i)
2067 uzder(1,3,2)= dc_norm(2,i)
2068 uzder(2,3,2)=-dc_norm(1,i)
2070 C Compute the Y-axis
2073 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2075 C Compute the derivatives of uy
2078 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2079 & -dc_norm(k,i)*dc_norm(j,i+1)
2080 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2082 uyder(j,j,1)=uyder(j,j,1)-costh
2083 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2088 uygrad(l,k,j,i)=uyder(l,k,j)
2089 uzgrad(l,k,j,i)=uzder(l,k,j)
2093 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2094 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2095 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2096 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2100 vbld_inv_temp(1)=vbld_inv(i+1)
2101 if (i.lt.nres-1) then
2102 vbld_inv_temp(2)=vbld_inv(i+2)
2104 vbld_inv_temp(2)=vbld_inv(i)
2109 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2110 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2115 #if defined(PARVEC) && defined(MPI)
2116 if (nfgtasks1.gt.1) then
2118 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2119 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2120 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2121 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2122 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2124 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2125 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2127 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2128 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2129 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2130 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2131 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2132 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2133 time_gather=time_gather+MPI_Wtime()-time00
2135 c if (fg_rank.eq.0) then
2136 c write (iout,*) "Arrays UY and UZ"
2138 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2145 C-----------------------------------------------------------------------------
2146 subroutine check_vecgrad
2147 implicit real*8 (a-h,o-z)
2148 include 'DIMENSIONS'
2149 include 'COMMON.IOUNITS'
2150 include 'COMMON.GEO'
2151 include 'COMMON.VAR'
2152 include 'COMMON.LOCAL'
2153 include 'COMMON.CHAIN'
2154 include 'COMMON.VECTORS'
2155 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2156 dimension uyt(3,maxres),uzt(3,maxres)
2157 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2158 double precision delta /1.0d-7/
2161 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2162 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2163 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2164 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2165 cd & (dc_norm(if90,i),if90=1,3)
2166 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2167 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2168 cd write(iout,'(a)')
2174 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2175 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2188 cd write (iout,*) 'i=',i
2190 erij(k)=dc_norm(k,i)
2194 dc_norm(k,i)=erij(k)
2196 dc_norm(j,i)=dc_norm(j,i)+delta
2197 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2199 c dc_norm(k,i)=dc_norm(k,i)/fac
2201 c write (iout,*) (dc_norm(k,i),k=1,3)
2202 c write (iout,*) (erij(k),k=1,3)
2205 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2206 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2207 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2208 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2210 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2211 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2212 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2215 dc_norm(k,i)=erij(k)
2218 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2219 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2220 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2221 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2222 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2223 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2224 cd write (iout,'(a)')
2229 C--------------------------------------------------------------------------
2230 subroutine set_matrices
2231 implicit real*8 (a-h,o-z)
2232 include 'DIMENSIONS'
2235 include "COMMON.SETUP"
2237 integer status(MPI_STATUS_SIZE)
2239 include 'COMMON.IOUNITS'
2240 include 'COMMON.GEO'
2241 include 'COMMON.VAR'
2242 include 'COMMON.LOCAL'
2243 include 'COMMON.CHAIN'
2244 include 'COMMON.DERIV'
2245 include 'COMMON.INTERACT'
2246 include 'COMMON.CONTACTS'
2247 include 'COMMON.TORSION'
2248 include 'COMMON.VECTORS'
2249 include 'COMMON.FFIELD'
2250 double precision auxvec(2),auxmat(2,2)
2252 C Compute the virtual-bond-torsional-angle dependent quantities needed
2253 C to calculate the el-loc multibody terms of various order.
2255 c write(iout,*) 'nphi=',nphi,nres
2257 do i=ivec_start+2,ivec_end+2
2262 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2263 iti = itortyp(itype(i-2))
2267 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2268 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2269 iti1 = itortyp(itype(i-1))
2274 b1(1,i-2)=bnew1(1,1,iti)*sin(theta(i-1)/2.0)
2275 & +bnew1(2,1,iti)*sin(theta(i-1))
2276 & +bnew1(3,1,iti)*cos(theta(i-1)/2.0)
2277 gtb1(1,i-2)=bnew1(1,1,iti)*cos(theta(i-1)/2.0)/2.0
2278 & +bnew1(2,1,iti)*cos(theta(i-1))
2279 & -bnew1(3,1,iti)*sin(theta(i-1)/2.0)/2.0
2280 c & +bnew1(3,1,iti)*sin(alpha(i))*cos(beta(i))
2281 c &*(cos(theta(i)/2.0)
2282 b2(1,i-2)=bnew2(1,1,iti)*sin(theta(i-1)/2.0)
2283 & +bnew2(2,1,iti)*sin(theta(i-1))
2284 & +bnew2(3,1,iti)*cos(theta(i-1)/2.0)
2285 c & +bnew2(3,1,iti)*sin(alpha(i))*cos(beta(i))
2286 c &*(cos(theta(i)/2.0)
2287 gtb2(1,i-2)=bnew2(1,1,iti)*cos(theta(i-1)/2.0)/2.0
2288 & +bnew2(2,1,iti)*cos(theta(i-1))
2289 & -bnew2(3,1,iti)*sin(theta(i-1)/2.0)/2.0
2290 c if (ggb1(1,i).eq.0.0d0) then
2291 c write(iout,*) 'i=',i,ggb1(1,i),
2292 c &bnew1(1,1,iti)*cos(theta(i)/2.0)/2.0,
2293 c &bnew1(2,1,iti)*cos(theta(i)),
2294 c &bnew1(3,1,iti)*sin(theta(i)/2.0)/2.0
2296 b1(2,i-2)=bnew1(1,2,iti)
2298 b2(2,i-2)=bnew2(1,2,iti)
2300 EE(1,1,i-2)=eenew(1,iti)*dcos(theta(i-1))
2301 EE(1,2,i-2)=eeold(1,2,iti)
2302 EE(2,1,i-2)=eeold(2,1,iti)
2303 EE(2,2,i-2)=eeold(2,2,iti)
2304 gtEE(1,1,i-2)=-eenew(1,iti)*dsin(theta(i-1))
2309 c EE(1,2,iti)=0.5d0*eenew(1,iti)
2310 c EE(2,1,iti)=0.5d0*eenew(1,iti)
2311 c b1(2,iti)=bnew1(1,2,iti)*sin(alpha(i))*sin(beta(i))
2312 c b2(2,iti)=bnew2(1,2,iti)*sin(alpha(i))*sin(beta(i))
2313 b1tilde(1,i-2)=b1(1,i-2)
2314 b1tilde(2,i-2)=-b1(2,i-2)
2315 b2tilde(1,i-2)=b2(1,i-2)
2316 b2tilde(2,i-2)=-b2(2,i-2)
2317 c write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
2318 c write (iout,*) 'theta=', theta(i-1)
2321 do i=ivec_start+2,ivec_end+2
2326 if (i .lt. nres+1) then
2363 if (i .gt. 3 .and. i .lt. nres+1) then
2364 obrot_der(1,i-2)=-sin1
2365 obrot_der(2,i-2)= cos1
2366 Ugder(1,1,i-2)= sin1
2367 Ugder(1,2,i-2)=-cos1
2368 Ugder(2,1,i-2)=-cos1
2369 Ugder(2,2,i-2)=-sin1
2372 obrot2_der(1,i-2)=-dwasin2
2373 obrot2_der(2,i-2)= dwacos2
2374 Ug2der(1,1,i-2)= dwasin2
2375 Ug2der(1,2,i-2)=-dwacos2
2376 Ug2der(2,1,i-2)=-dwacos2
2377 Ug2der(2,2,i-2)=-dwasin2
2379 obrot_der(1,i-2)=0.0d0
2380 obrot_der(2,i-2)=0.0d0
2381 Ugder(1,1,i-2)=0.0d0
2382 Ugder(1,2,i-2)=0.0d0
2383 Ugder(2,1,i-2)=0.0d0
2384 Ugder(2,2,i-2)=0.0d0
2385 obrot2_der(1,i-2)=0.0d0
2386 obrot2_der(2,i-2)=0.0d0
2387 Ug2der(1,1,i-2)=0.0d0
2388 Ug2der(1,2,i-2)=0.0d0
2389 Ug2der(2,1,i-2)=0.0d0
2390 Ug2der(2,2,i-2)=0.0d0
2392 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2393 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2394 iti = itortyp(itype(i-2))
2398 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2399 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2400 iti1 = itortyp(itype(i-1))
2404 cd write (iout,*) '*******i',i,' iti1',iti
2405 cd write (iout,*) 'b1',b1(:,iti)
2406 cd write (iout,*) 'b2',b2(:,iti)
2407 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2408 c if (i .gt. iatel_s+2) then
2409 if (i .gt. nnt+2) then
2410 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
2412 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
2413 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
2415 c write(iout,*) "co jest kurwa", iti, EE(1,1,iti),EE(2,1,iti),
2416 c & EE(1,2,iti),EE(2,2,iti)
2417 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
2418 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
2419 c write(iout,*) "Macierz EUG",
2420 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
2422 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2424 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2425 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2426 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2427 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2428 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2439 DtUg2(l,k,i-2)=0.0d0
2443 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
2444 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
2446 muder(k,i-2)=Ub2der(k,i-2)
2448 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2449 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2450 if (itype(i-1).le.ntyp) then
2451 iti1 = itortyp(itype(i-1))
2459 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
2462 write (iout,'(2hmu,i3,3f8.1,7f10.5)') i-2,rad2deg*theta(i-1),
2463 & rad2deg*theta(i),rad2deg*phi(i),mu(1,i-2),mu(2,i-2),
2464 & -b2(1,i-2),b2(2,i-2),b1(1,i-2),b1(2,i-2),
2465 & dsqrt(b2(1,i-1)**2+b2(2,i-1)**2)
2466 & +dsqrt(b1(1,i-1)**2+b1(2,i-1)**2)
2468 cd write (iout,*) 'mu ',mu(:,i-2)
2469 cd write (iout,*) 'mu1',mu1(:,i-2)
2470 cd write (iout,*) 'mu2',mu2(:,i-2)
2471 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2473 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2474 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2475 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2476 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2477 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2478 C Vectors and matrices dependent on a single virtual-bond dihedral.
2479 call matvec2(DD(1,1,iti),b1tilde(1,i-1),auxvec(1))
2480 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2481 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2482 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2483 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2484 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2485 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2486 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2487 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2490 C Matrices dependent on two consecutive virtual-bond dihedrals.
2491 C The order of matrices is from left to right.
2492 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2494 c do i=max0(ivec_start,2),ivec_end
2496 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2497 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2498 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2499 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2500 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2501 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2502 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2503 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2506 #if defined(MPI) && defined(PARMAT)
2508 c if (fg_rank.eq.0) then
2509 write (iout,*) "Arrays UG and UGDER before GATHER"
2511 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2512 & ((ug(l,k,i),l=1,2),k=1,2),
2513 & ((ugder(l,k,i),l=1,2),k=1,2)
2515 write (iout,*) "Arrays UG2 and UG2DER"
2517 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2518 & ((ug2(l,k,i),l=1,2),k=1,2),
2519 & ((ug2der(l,k,i),l=1,2),k=1,2)
2521 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2523 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2524 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2525 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2527 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2529 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2530 & costab(i),sintab(i),costab2(i),sintab2(i)
2532 write (iout,*) "Array MUDER"
2534 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2538 if (nfgtasks.gt.1) then
2540 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2541 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2542 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2544 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2545 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2547 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2548 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2550 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2551 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2553 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2554 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2556 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2557 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2559 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2560 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2562 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2563 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2564 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2565 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2566 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2567 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2568 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2569 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2570 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2571 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2572 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2573 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2574 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2576 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2577 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2579 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2580 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2582 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2583 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2585 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2586 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2588 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2589 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2591 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2592 & ivec_count(fg_rank1),
2593 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2595 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2596 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2598 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2599 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2601 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2602 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2604 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2605 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2607 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2608 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2610 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2611 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2613 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2614 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2616 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2617 & ivec_count(fg_rank1),
2618 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2620 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2621 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2623 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2624 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2626 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2627 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2629 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2630 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2632 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2633 & ivec_count(fg_rank1),
2634 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2636 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2637 & ivec_count(fg_rank1),
2638 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2640 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2641 & ivec_count(fg_rank1),
2642 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2643 & MPI_MAT2,FG_COMM1,IERR)
2644 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2645 & ivec_count(fg_rank1),
2646 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2647 & MPI_MAT2,FG_COMM1,IERR)
2650 c Passes matrix info through the ring
2653 if (irecv.lt.0) irecv=nfgtasks1-1
2656 if (inext.ge.nfgtasks1) inext=0
2658 c write (iout,*) "isend",isend," irecv",irecv
2660 lensend=lentyp(isend)
2661 lenrecv=lentyp(irecv)
2662 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2663 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2664 c & MPI_ROTAT1(lensend),inext,2200+isend,
2665 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2666 c & iprev,2200+irecv,FG_COMM,status,IERR)
2667 c write (iout,*) "Gather ROTAT1"
2669 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2670 c & MPI_ROTAT2(lensend),inext,3300+isend,
2671 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2672 c & iprev,3300+irecv,FG_COMM,status,IERR)
2673 c write (iout,*) "Gather ROTAT2"
2675 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2676 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2677 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2678 & iprev,4400+irecv,FG_COMM,status,IERR)
2679 c write (iout,*) "Gather ROTAT_OLD"
2681 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2682 & MPI_PRECOMP11(lensend),inext,5500+isend,
2683 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2684 & iprev,5500+irecv,FG_COMM,status,IERR)
2685 c write (iout,*) "Gather PRECOMP11"
2687 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2688 & MPI_PRECOMP12(lensend),inext,6600+isend,
2689 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2690 & iprev,6600+irecv,FG_COMM,status,IERR)
2691 c write (iout,*) "Gather PRECOMP12"
2693 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2695 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2696 & MPI_ROTAT2(lensend),inext,7700+isend,
2697 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2698 & iprev,7700+irecv,FG_COMM,status,IERR)
2699 c write (iout,*) "Gather PRECOMP21"
2701 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2702 & MPI_PRECOMP22(lensend),inext,8800+isend,
2703 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2704 & iprev,8800+irecv,FG_COMM,status,IERR)
2705 c write (iout,*) "Gather PRECOMP22"
2707 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2708 & MPI_PRECOMP23(lensend),inext,9900+isend,
2709 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2710 & MPI_PRECOMP23(lenrecv),
2711 & iprev,9900+irecv,FG_COMM,status,IERR)
2712 c write (iout,*) "Gather PRECOMP23"
2717 if (irecv.lt.0) irecv=nfgtasks1-1
2720 time_gather=time_gather+MPI_Wtime()-time00
2723 c if (fg_rank.eq.0) then
2724 write (iout,*) "Arrays UG and UGDER"
2726 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2727 & ((ug(l,k,i),l=1,2),k=1,2),
2728 & ((ugder(l,k,i),l=1,2),k=1,2)
2730 write (iout,*) "Arrays UG2 and UG2DER"
2732 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2733 & ((ug2(l,k,i),l=1,2),k=1,2),
2734 & ((ug2der(l,k,i),l=1,2),k=1,2)
2736 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2738 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2739 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2740 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2742 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2744 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2745 & costab(i),sintab(i),costab2(i),sintab2(i)
2747 write (iout,*) "Array MUDER"
2749 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2755 cd iti = itortyp(itype(i))
2758 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2759 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2764 C--------------------------------------------------------------------------
2765 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2767 C This subroutine calculates the average interaction energy and its gradient
2768 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2769 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2770 C The potential depends both on the distance of peptide-group centers and on
2771 C the orientation of the CA-CA virtual bonds.
2773 implicit real*8 (a-h,o-z)
2777 include 'DIMENSIONS'
2778 include 'COMMON.CONTROL'
2779 include 'COMMON.SETUP'
2780 include 'COMMON.IOUNITS'
2781 include 'COMMON.GEO'
2782 include 'COMMON.VAR'
2783 include 'COMMON.LOCAL'
2784 include 'COMMON.CHAIN'
2785 include 'COMMON.DERIV'
2786 include 'COMMON.INTERACT'
2787 include 'COMMON.CONTACTS'
2788 include 'COMMON.TORSION'
2789 include 'COMMON.VECTORS'
2790 include 'COMMON.FFIELD'
2791 include 'COMMON.TIME1'
2792 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2793 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2794 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2795 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
2796 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2797 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2799 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2801 double precision scal_el /1.0d0/
2803 double precision scal_el /0.5d0/
2806 C 13-go grudnia roku pamietnego...
2807 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2808 & 0.0d0,1.0d0,0.0d0,
2809 & 0.0d0,0.0d0,1.0d0/
2810 cd write(iout,*) 'In EELEC'
2812 cd write(iout,*) 'Type',i
2813 cd write(iout,*) 'B1',B1(:,i)
2814 cd write(iout,*) 'B2',B2(:,i)
2815 cd write(iout,*) 'CC',CC(:,:,i)
2816 cd write(iout,*) 'DD',DD(:,:,i)
2817 cd write(iout,*) 'EE',EE(:,:,i)
2819 cd call check_vecgrad
2821 if (icheckgrad.eq.1) then
2823 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2825 dc_norm(k,i)=dc(k,i)*fac
2827 c write (iout,*) 'i',i,' fac',fac
2830 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2831 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2832 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2833 c call vec_and_deriv
2839 time_mat=time_mat+MPI_Wtime()-time01
2843 cd write (iout,*) 'i=',i
2845 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2848 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2849 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2862 cd print '(a)','Enter EELEC'
2863 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2865 gel_loc_loc(i)=0.0d0
2870 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2872 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2874 do i=iturn3_start,iturn3_end
2875 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2876 & .or. itype(i+2).eq.ntyp1 .or. itype(i+3).eq.ntyp1) cycle
2880 dx_normi=dc_norm(1,i)
2881 dy_normi=dc_norm(2,i)
2882 dz_normi=dc_norm(3,i)
2883 xmedi=c(1,i)+0.5d0*dxi
2884 ymedi=c(2,i)+0.5d0*dyi
2885 zmedi=c(3,i)+0.5d0*dzi
2887 call eelecij(i,i+2,ees,evdw1,eel_loc)
2888 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2889 num_cont_hb(i)=num_conti
2891 do i=iturn4_start,iturn4_end
2892 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2893 & .or. itype(i+3).eq.ntyp1
2894 & .or. itype(i+4).eq.ntyp1) cycle
2898 dx_normi=dc_norm(1,i)
2899 dy_normi=dc_norm(2,i)
2900 dz_normi=dc_norm(3,i)
2901 xmedi=c(1,i)+0.5d0*dxi
2902 ymedi=c(2,i)+0.5d0*dyi
2903 zmedi=c(3,i)+0.5d0*dzi
2904 num_conti=num_cont_hb(i)
2905 c write(iout,*) "JESTEM W PETLI"
2906 call eelecij(i,i+3,ees,evdw1,eel_loc)
2907 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
2908 & call eturn4(i,eello_turn4)
2909 num_cont_hb(i)=num_conti
2912 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2914 do i=iatel_s,iatel_e
2916 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2920 dx_normi=dc_norm(1,i)
2921 dy_normi=dc_norm(2,i)
2922 dz_normi=dc_norm(3,i)
2923 xmedi=c(1,i)+0.5d0*dxi
2924 ymedi=c(2,i)+0.5d0*dyi
2925 zmedi=c(3,i)+0.5d0*dzi
2926 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2927 num_conti=num_cont_hb(i)
2928 do j=ielstart(i),ielend(i)
2930 c write (iout,*) 'tu wchodze',i,j,itype(i),itype(j)
2931 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1) cycle
2932 call eelecij(i,j,ees,evdw1,eel_loc)
2934 num_cont_hb(i)=num_conti
2936 c write (iout,*) "Number of loop steps in EELEC:",ind
2938 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
2939 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
2941 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
2942 ccc eel_loc=eel_loc+eello_turn3
2943 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
2946 C-------------------------------------------------------------------------------
2947 subroutine eelecij(i,j,ees,evdw1,eel_loc)
2948 implicit real*8 (a-h,o-z)
2949 include 'DIMENSIONS'
2953 include 'COMMON.CONTROL'
2954 include 'COMMON.IOUNITS'
2955 include 'COMMON.GEO'
2956 include 'COMMON.VAR'
2957 include 'COMMON.LOCAL'
2958 include 'COMMON.CHAIN'
2959 include 'COMMON.DERIV'
2960 include 'COMMON.INTERACT'
2961 include 'COMMON.CONTACTS'
2962 include 'COMMON.TORSION'
2963 include 'COMMON.VECTORS'
2964 include 'COMMON.FFIELD'
2965 include 'COMMON.TIME1'
2966 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2967 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2968 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2969 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
2970 & gmuij2(4),gmuji2(4)
2971 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2972 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2974 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2976 double precision scal_el /1.0d0/
2978 double precision scal_el /0.5d0/
2981 C 13-go grudnia roku pamietnego...
2982 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2983 & 0.0d0,1.0d0,0.0d0,
2984 & 0.0d0,0.0d0,1.0d0/
2985 c time00=MPI_Wtime()
2986 cd write (iout,*) "eelecij",i,j
2990 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2991 aaa=app(iteli,itelj)
2992 bbb=bpp(iteli,itelj)
2993 ael6i=ael6(iteli,itelj)
2994 ael3i=ael3(iteli,itelj)
2998 dx_normj=dc_norm(1,j)
2999 dy_normj=dc_norm(2,j)
3000 dz_normj=dc_norm(3,j)
3001 xj=c(1,j)+0.5D0*dxj-xmedi
3002 yj=c(2,j)+0.5D0*dyj-ymedi
3003 zj=c(3,j)+0.5D0*dzj-zmedi
3004 rij=xj*xj+yj*yj+zj*zj
3010 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3011 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3012 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3013 fac=cosa-3.0D0*cosb*cosg
3015 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3016 if (j.eq.i+2) ev1=scal_el*ev1
3021 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3024 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3025 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3028 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3029 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3030 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3031 cd & xmedi,ymedi,zmedi,xj,yj,zj
3033 if (energy_dec) then
3034 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3036 &,iteli,itelj,aaa,evdw1
3037 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3041 C Calculate contributions to the Cartesian gradient.
3044 facvdw=-6*rrmij*(ev1+evdwij)
3045 facel=-3*rrmij*(el1+eesij)
3051 * Radial derivatives. First process both termini of the fragment (i,j)
3057 c ghalf=0.5D0*ggg(k)
3058 c gelc(k,i)=gelc(k,i)+ghalf
3059 c gelc(k,j)=gelc(k,j)+ghalf
3061 c 9/28/08 AL Gradient compotents will be summed only at the end
3063 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3064 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3067 * Loop over residues i+1 thru j-1.
3071 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3078 c ghalf=0.5D0*ggg(k)
3079 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3080 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3082 c 9/28/08 AL Gradient compotents will be summed only at the end
3084 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3085 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3088 * Loop over residues i+1 thru j-1.
3092 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3099 fac=-3*rrmij*(facvdw+facvdw+facel)
3104 * Radial derivatives. First process both termini of the fragment (i,j)
3110 c ghalf=0.5D0*ggg(k)
3111 c gelc(k,i)=gelc(k,i)+ghalf
3112 c gelc(k,j)=gelc(k,j)+ghalf
3114 c 9/28/08 AL Gradient compotents will be summed only at the end
3116 gelc_long(k,j)=gelc(k,j)+ggg(k)
3117 gelc_long(k,i)=gelc(k,i)-ggg(k)
3120 * Loop over residues i+1 thru j-1.
3124 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3127 c 9/28/08 AL Gradient compotents will be summed only at the end
3132 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3133 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3139 ecosa=2.0D0*fac3*fac1+fac4
3142 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3143 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3145 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3146 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3148 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3149 cd & (dcosg(k),k=1,3)
3151 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3154 c ghalf=0.5D0*ggg(k)
3155 c gelc(k,i)=gelc(k,i)+ghalf
3156 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3157 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3158 c gelc(k,j)=gelc(k,j)+ghalf
3159 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3160 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3164 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3169 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3170 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3172 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3173 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3174 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3175 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3177 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3178 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3179 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3181 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3182 C energy of a peptide unit is assumed in the form of a second-order
3183 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3184 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3185 C are computed for EVERY pair of non-contiguous peptide groups.
3188 if (j.lt.nres-1) then
3200 muij(kkk)=mu(k,i)*mu(l,j)
3202 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
3203 c write(iout,*) 'kkk=', gtb1(k,i)*mu(l,j),gtb1(k,i),k,i
3204 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
3205 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
3206 c write(iout,*) 'kkk=', gtb1(k,i)*mu(l,j),gtb1(l,j),l,j
3207 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
3211 cd write (iout,*) 'EELEC: i',i,' j',j
3212 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3213 cd write(iout,*) 'muij',muij
3214 ury=scalar(uy(1,i),erij)
3215 urz=scalar(uz(1,i),erij)
3216 vry=scalar(uy(1,j),erij)
3217 vrz=scalar(uz(1,j),erij)
3218 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3219 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3220 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3221 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3222 fac=dsqrt(-ael6i)*r3ij
3227 cd write (iout,'(4i5,4f10.5)')
3228 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3229 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3230 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3231 cd & uy(:,j),uz(:,j)
3232 cd write (iout,'(4f10.5)')
3233 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3234 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3235 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3236 cd write (iout,'(9f10.5/)')
3237 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3238 C Derivatives of the elements of A in virtual-bond vectors
3239 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3241 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3242 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3243 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3244 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3245 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3246 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3247 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3248 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3249 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3250 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3251 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3252 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3254 C Compute radial contributions to the gradient
3272 C Add the contributions coming from er
3275 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3276 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3277 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3278 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3281 C Derivatives in DC(i)
3282 cgrad ghalf1=0.5d0*agg(k,1)
3283 cgrad ghalf2=0.5d0*agg(k,2)
3284 cgrad ghalf3=0.5d0*agg(k,3)
3285 cgrad ghalf4=0.5d0*agg(k,4)
3286 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3287 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3288 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3289 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3290 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3291 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3292 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3293 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3294 C Derivatives in DC(i+1)
3295 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3296 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3297 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3298 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3299 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3300 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3301 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3302 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3303 C Derivatives in DC(j)
3304 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3305 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3306 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3307 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3308 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3309 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3310 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3311 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3312 C Derivatives in DC(j+1) or DC(nres-1)
3313 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3314 & -3.0d0*vryg(k,3)*ury)
3315 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3316 & -3.0d0*vrzg(k,3)*ury)
3317 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3318 & -3.0d0*vryg(k,3)*urz)
3319 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3320 & -3.0d0*vrzg(k,3)*urz)
3321 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3323 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3336 aggi(k,l)=-aggi(k,l)
3337 aggi1(k,l)=-aggi1(k,l)
3338 aggj(k,l)=-aggj(k,l)
3339 aggj1(k,l)=-aggj1(k,l)
3342 if (j.lt.nres-1) then
3348 aggi(k,l)=-aggi(k,l)
3349 aggi1(k,l)=-aggi1(k,l)
3350 aggj(k,l)=-aggj(k,l)
3351 aggj1(k,l)=-aggj1(k,l)
3362 aggi(k,l)=-aggi(k,l)
3363 aggi1(k,l)=-aggi1(k,l)
3364 aggj(k,l)=-aggj(k,l)
3365 aggj1(k,l)=-aggj1(k,l)
3370 IF (wel_loc.gt.0.0d0) THEN
3371 c if ((i.eq.8).and.(j.eq.14)) then
3372 C Contribution to the local-electrostatic energy coming from the i-j pair
3373 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3375 C Calculate patrial derivative for theta angle
3377 geel_loc_ij=a22*gmuij1(1)
3381 c write(iout,*) "derivative over thatai"
3382 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
3384 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
3385 & geel_loc_ij*wel_loc
3386 c write(iout,*) "derivative over thatai-1"
3387 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
3389 geel_loc_ij=a22*gmuij2(1)+a23*gmuij2(2)+a32*gmuij2(3)
3391 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3392 & geel_loc_ij*wel_loc
3393 geel_loc_ji=a22*gmuji1(1)+a23*gmuji1(2)+a32*gmuji1(3)
3395 c write(iout,*) "derivative over thataj"
3396 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
3399 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
3400 & geel_loc_ji*wel_loc
3401 geel_loc_ji=a22*gmuji2(1)+a23*gmuji2(2)+a32*gmuji2(3)
3403 c write(iout,*) "derivative over thataj-1"
3404 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
3406 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
3407 & geel_loc_ji*wel_loc
3409 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3411 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3412 & 'eelloc',i,j,eel_loc_ij
3413 c write (iout,*) a22,muij(1),a23,muij(2),a32,muij(3)
3415 eel_loc=eel_loc+eel_loc_ij
3416 C Partial derivatives in virtual-bond dihedral angles gamma
3418 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3419 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3420 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3421 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3422 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3423 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3424 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3426 ggg(l)=agg(l,1)*muij(1)+
3427 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3428 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3429 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3430 cgrad ghalf=0.5d0*ggg(l)
3431 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3432 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3436 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3439 C Remaining derivatives of eello
3441 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3442 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3443 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3444 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3445 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3446 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3447 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3448 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3452 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3453 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3454 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3455 & .and. num_conti.le.maxconts) then
3456 c write (iout,*) i,j," entered corr"
3458 C Calculate the contact function. The ith column of the array JCONT will
3459 C contain the numbers of atoms that make contacts with the atom I (of numbers
3460 C greater than I). The arrays FACONT and GACONT will contain the values of
3461 C the contact function and its derivative.
3462 c r0ij=1.02D0*rpp(iteli,itelj)
3463 c r0ij=1.11D0*rpp(iteli,itelj)
3464 r0ij=2.20D0*rpp(iteli,itelj)
3465 c r0ij=1.55D0*rpp(iteli,itelj)
3466 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3467 if (fcont.gt.0.0D0) then
3468 num_conti=num_conti+1
3469 if (num_conti.gt.maxconts) then
3470 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3471 & ' will skip next contacts for this conf.'
3473 jcont_hb(num_conti,i)=j
3474 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3475 cd & " jcont_hb",jcont_hb(num_conti,i)
3476 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3477 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3478 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3480 d_cont(num_conti,i)=rij
3481 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3482 C --- Electrostatic-interaction matrix ---
3483 a_chuj(1,1,num_conti,i)=a22
3484 a_chuj(1,2,num_conti,i)=a23
3485 a_chuj(2,1,num_conti,i)=a32
3486 a_chuj(2,2,num_conti,i)=a33
3487 C --- Gradient of rij
3489 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3496 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3497 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3498 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3499 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3500 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3505 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3506 C Calculate contact energies
3508 wij=cosa-3.0D0*cosb*cosg
3511 c fac3=dsqrt(-ael6i)/r0ij**3
3512 fac3=dsqrt(-ael6i)*r3ij
3513 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3514 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3515 if (ees0tmp.gt.0) then
3516 ees0pij=dsqrt(ees0tmp)
3520 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3521 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3522 if (ees0tmp.gt.0) then
3523 ees0mij=dsqrt(ees0tmp)
3528 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3529 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3530 C Diagnostics. Comment out or remove after debugging!
3531 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3532 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3533 c ees0m(num_conti,i)=0.0D0
3535 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3536 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3537 C Angular derivatives of the contact function
3538 ees0pij1=fac3/ees0pij
3539 ees0mij1=fac3/ees0mij
3540 fac3p=-3.0D0*fac3*rrmij
3541 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3542 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3544 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3545 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3546 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3547 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3548 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3549 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3550 ecosap=ecosa1+ecosa2
3551 ecosbp=ecosb1+ecosb2
3552 ecosgp=ecosg1+ecosg2
3553 ecosam=ecosa1-ecosa2
3554 ecosbm=ecosb1-ecosb2
3555 ecosgm=ecosg1-ecosg2
3564 facont_hb(num_conti,i)=fcont
3565 fprimcont=fprimcont/rij
3566 cd facont_hb(num_conti,i)=1.0D0
3567 C Following line is for diagnostics.
3570 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3571 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3574 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3575 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3577 gggp(1)=gggp(1)+ees0pijp*xj
3578 gggp(2)=gggp(2)+ees0pijp*yj
3579 gggp(3)=gggp(3)+ees0pijp*zj
3580 gggm(1)=gggm(1)+ees0mijp*xj
3581 gggm(2)=gggm(2)+ees0mijp*yj
3582 gggm(3)=gggm(3)+ees0mijp*zj
3583 C Derivatives due to the contact function
3584 gacont_hbr(1,num_conti,i)=fprimcont*xj
3585 gacont_hbr(2,num_conti,i)=fprimcont*yj
3586 gacont_hbr(3,num_conti,i)=fprimcont*zj
3589 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3590 c following the change of gradient-summation algorithm.
3592 cgrad ghalfp=0.5D0*gggp(k)
3593 cgrad ghalfm=0.5D0*gggm(k)
3594 gacontp_hb1(k,num_conti,i)=!ghalfp
3595 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3596 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3597 gacontp_hb2(k,num_conti,i)=!ghalfp
3598 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3599 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3600 gacontp_hb3(k,num_conti,i)=gggp(k)
3601 gacontm_hb1(k,num_conti,i)=!ghalfm
3602 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3603 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3604 gacontm_hb2(k,num_conti,i)=!ghalfm
3605 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3606 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3607 gacontm_hb3(k,num_conti,i)=gggm(k)
3609 C Diagnostics. Comment out or remove after debugging!
3611 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3612 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3613 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3614 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3615 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3616 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3619 endif ! num_conti.le.maxconts
3622 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3625 ghalf=0.5d0*agg(l,k)
3626 aggi(l,k)=aggi(l,k)+ghalf
3627 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3628 aggj(l,k)=aggj(l,k)+ghalf
3631 if (j.eq.nres-1 .and. i.lt.j-2) then
3634 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3639 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3642 C-----------------------------------------------------------------------------
3643 subroutine eturn3(i,eello_turn3)
3644 C Third- and fourth-order contributions from turns
3645 implicit real*8 (a-h,o-z)
3646 include 'DIMENSIONS'
3647 include 'COMMON.IOUNITS'
3648 include 'COMMON.GEO'
3649 include 'COMMON.VAR'
3650 include 'COMMON.LOCAL'
3651 include 'COMMON.CHAIN'
3652 include 'COMMON.DERIV'
3653 include 'COMMON.INTERACT'
3654 include 'COMMON.CONTACTS'
3655 include 'COMMON.TORSION'
3656 include 'COMMON.VECTORS'
3657 include 'COMMON.FFIELD'
3658 include 'COMMON.CONTROL'
3660 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3661 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3662 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
3663 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
3664 & auxgmat2(2,2),auxgmatt2(2,2)
3665 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3666 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3667 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3668 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3671 c write (iout,*) "eturn3",i,j,j1,j2
3676 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3678 C Third-order contributions
3685 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3686 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3687 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3688 c auxalary matices for theta gradient
3689 c auxalary matrix for i+1 and constant i+2
3690 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
3691 c auxalary matrix for i+2 and constant i+1
3692 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
3693 call transpose2(auxmat(1,1),auxmat1(1,1))
3694 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
3695 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
3696 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3697 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
3698 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
3699 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3700 C Derivatives in theta
3701 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3702 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
3703 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
3704 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
3706 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3707 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3708 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3709 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3710 cd & ' eello_turn3_num',4*eello_turn3_num
3711 C Derivatives in gamma(i)
3712 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3713 call transpose2(auxmat2(1,1),auxmat3(1,1))
3714 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3715 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3716 C Derivatives in gamma(i+1)
3717 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3718 call transpose2(auxmat2(1,1),auxmat3(1,1))
3719 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3720 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3721 & +0.5d0*(pizda(1,1)+pizda(2,2))
3722 C Cartesian derivatives
3724 c ghalf1=0.5d0*agg(l,1)
3725 c ghalf2=0.5d0*agg(l,2)
3726 c ghalf3=0.5d0*agg(l,3)
3727 c ghalf4=0.5d0*agg(l,4)
3728 a_temp(1,1)=aggi(l,1)!+ghalf1
3729 a_temp(1,2)=aggi(l,2)!+ghalf2
3730 a_temp(2,1)=aggi(l,3)!+ghalf3
3731 a_temp(2,2)=aggi(l,4)!+ghalf4
3732 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3733 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3734 & +0.5d0*(pizda(1,1)+pizda(2,2))
3735 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3736 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3737 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3738 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3739 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3740 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3741 & +0.5d0*(pizda(1,1)+pizda(2,2))
3742 a_temp(1,1)=aggj(l,1)!+ghalf1
3743 a_temp(1,2)=aggj(l,2)!+ghalf2
3744 a_temp(2,1)=aggj(l,3)!+ghalf3
3745 a_temp(2,2)=aggj(l,4)!+ghalf4
3746 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3747 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3748 & +0.5d0*(pizda(1,1)+pizda(2,2))
3749 a_temp(1,1)=aggj1(l,1)
3750 a_temp(1,2)=aggj1(l,2)
3751 a_temp(2,1)=aggj1(l,3)
3752 a_temp(2,2)=aggj1(l,4)
3753 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3754 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3755 & +0.5d0*(pizda(1,1)+pizda(2,2))
3759 C-------------------------------------------------------------------------------
3760 subroutine eturn4(i,eello_turn4)
3761 C Third- and fourth-order contributions from turns
3762 implicit real*8 (a-h,o-z)
3763 include 'DIMENSIONS'
3764 include 'COMMON.IOUNITS'
3765 include 'COMMON.GEO'
3766 include 'COMMON.VAR'
3767 include 'COMMON.LOCAL'
3768 include 'COMMON.CHAIN'
3769 include 'COMMON.DERIV'
3770 include 'COMMON.INTERACT'
3771 include 'COMMON.CONTACTS'
3772 include 'COMMON.TORSION'
3773 include 'COMMON.VECTORS'
3774 include 'COMMON.FFIELD'
3775 include 'COMMON.CONTROL'
3777 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3778 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3779 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
3780 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
3781 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
3782 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
3783 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
3784 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3785 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3786 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3787 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3790 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3792 C Fourth-order contributions
3800 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3801 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3802 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3803 c write(iout,*)"WCHODZE W PROGRAM"
3808 iti1=itortyp(itype(i+1))
3809 iti2=itortyp(itype(i+2))
3810 iti3=itortyp(itype(i+3))
3811 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3812 call transpose2(EUg(1,1,i+1),e1t(1,1))
3813 call transpose2(Eug(1,1,i+2),e2t(1,1))
3814 call transpose2(Eug(1,1,i+3),e3t(1,1))
3815 C Ematrix derivative in theta
3816 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
3817 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
3818 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
3819 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3820 c eta1 in derivative theta
3821 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
3822 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3823 c auxgvec is derivative of Ub2 so i+3 theta
3824 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
3825 c auxalary matrix of E i+1
3826 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
3829 s1=scalar2(b1(1,i+2),auxvec(1))
3830 c derivative of theta i+2 with constant i+3
3831 gs23=scalar2(gtb1(1,i+2),auxvec(1))
3832 c derivative of theta i+2 with constant i+2
3833 gs32=scalar2(b1(1,i+2),auxgvec(1))
3834 c derivative of E matix in theta of i+1
3835 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
3837 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3838 c ea31 in derivative theta
3839 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
3840 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3841 c auxilary matrix auxgvec of Ub2 with constant E matirx
3842 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
3843 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
3844 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
3848 s2=scalar2(b1(1,i+1),auxvec(1))
3849 c derivative of theta i+1 with constant i+3
3850 gs13=scalar2(gtb1(1,i+1),auxvec(1))
3851 c derivative of theta i+2 with constant i+1
3852 gs21=scalar2(b1(1,i+1),auxgvec(1))
3853 c derivative of theta i+3 with constant i+1
3854 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
3855 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
3857 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3858 c two derivatives over diffetent matrices
3859 c gtae3e2 is derivative over i+3
3860 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
3861 c ae3gte2 is derivative over i+2
3862 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
3863 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3864 c three possible derivative over theta E matices
3866 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
3868 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
3870 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
3871 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3873 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
3874 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
3875 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
3877 eello_turn4=eello_turn4-(s1+s2+s3)
3879 gloc(nphi+i,icg)=gloc(nphi+i,icg)
3880 & -(gs13+gsE13+gsEE1)*wturn4
3881 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
3882 & -(gs23+gs21+gsEE2)*wturn4
3883 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
3884 & -(gs32+gsE31+gsEE3)*wturn4
3885 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
3888 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3889 & 'eturn4',i,j,-(s1+s2+s3)
3890 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3891 c & ' eello_turn4_num',8*eello_turn4_num
3892 C Derivatives in gamma(i)
3893 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3894 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3895 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3896 s1=scalar2(b1(1,i+2),auxvec(1))
3897 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3898 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3899 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3900 C Derivatives in gamma(i+1)
3901 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3902 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3903 s2=scalar2(b1(1,i+1),auxvec(1))
3904 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3905 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3906 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3907 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3908 C Derivatives in gamma(i+2)
3909 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3910 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3911 s1=scalar2(b1(1,i+2),auxvec(1))
3912 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3913 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3914 s2=scalar2(b1(1,i+1),auxvec(1))
3915 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3916 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3917 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3918 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3919 C Cartesian derivatives
3920 C Derivatives of this turn contributions in DC(i+2)
3921 if (j.lt.nres-1) then
3923 a_temp(1,1)=agg(l,1)
3924 a_temp(1,2)=agg(l,2)
3925 a_temp(2,1)=agg(l,3)
3926 a_temp(2,2)=agg(l,4)
3927 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3928 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3929 s1=scalar2(b1(1,i+2),auxvec(1))
3930 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3931 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3932 s2=scalar2(b1(1,i+1),auxvec(1))
3933 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3934 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3935 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3937 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3940 C Remaining derivatives of this turn contribution
3942 a_temp(1,1)=aggi(l,1)
3943 a_temp(1,2)=aggi(l,2)
3944 a_temp(2,1)=aggi(l,3)
3945 a_temp(2,2)=aggi(l,4)
3946 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3947 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3948 s1=scalar2(b1(1,i+2),auxvec(1))
3949 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3950 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3951 s2=scalar2(b1(1,i+1),auxvec(1))
3952 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3953 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3954 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3955 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3956 a_temp(1,1)=aggi1(l,1)
3957 a_temp(1,2)=aggi1(l,2)
3958 a_temp(2,1)=aggi1(l,3)
3959 a_temp(2,2)=aggi1(l,4)
3960 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3961 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3962 s1=scalar2(b1(1,i+2),auxvec(1))
3963 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3964 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3965 s2=scalar2(b1(1,i+1),auxvec(1))
3966 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3967 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3968 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3969 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3970 a_temp(1,1)=aggj(l,1)
3971 a_temp(1,2)=aggj(l,2)
3972 a_temp(2,1)=aggj(l,3)
3973 a_temp(2,2)=aggj(l,4)
3974 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3975 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3976 s1=scalar2(b1(1,i+2),auxvec(1))
3977 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3978 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3979 s2=scalar2(b1(1,i+1),auxvec(1))
3980 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3981 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3982 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3983 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3984 a_temp(1,1)=aggj1(l,1)
3985 a_temp(1,2)=aggj1(l,2)
3986 a_temp(2,1)=aggj1(l,3)
3987 a_temp(2,2)=aggj1(l,4)
3988 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3989 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3990 s1=scalar2(b1(1,i+2),auxvec(1))
3991 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3992 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3993 s2=scalar2(b1(1,i+1),auxvec(1))
3994 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3995 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3996 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3997 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3998 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4002 C-----------------------------------------------------------------------------
4003 subroutine vecpr(u,v,w)
4004 implicit real*8(a-h,o-z)
4005 dimension u(3),v(3),w(3)
4006 w(1)=u(2)*v(3)-u(3)*v(2)
4007 w(2)=-u(1)*v(3)+u(3)*v(1)
4008 w(3)=u(1)*v(2)-u(2)*v(1)
4011 C-----------------------------------------------------------------------------
4012 subroutine unormderiv(u,ugrad,unorm,ungrad)
4013 C This subroutine computes the derivatives of a normalized vector u, given
4014 C the derivatives computed without normalization conditions, ugrad. Returns
4017 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4018 double precision vec(3)
4019 double precision scalar
4021 c write (2,*) 'ugrad',ugrad
4024 vec(i)=scalar(ugrad(1,i),u(1))
4026 c write (2,*) 'vec',vec
4029 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4032 c write (2,*) 'ungrad',ungrad
4035 C-----------------------------------------------------------------------------
4036 subroutine escp_soft_sphere(evdw2,evdw2_14)
4038 C This subroutine calculates the excluded-volume interaction energy between
4039 C peptide-group centers and side chains and its gradient in virtual-bond and
4040 C side-chain vectors.
4042 implicit real*8 (a-h,o-z)
4043 include 'DIMENSIONS'
4044 include 'COMMON.GEO'
4045 include 'COMMON.VAR'
4046 include 'COMMON.LOCAL'
4047 include 'COMMON.CHAIN'
4048 include 'COMMON.DERIV'
4049 include 'COMMON.INTERACT'
4050 include 'COMMON.FFIELD'
4051 include 'COMMON.IOUNITS'
4052 include 'COMMON.CONTROL'
4057 cd print '(a)','Enter ESCP'
4058 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4059 do i=iatscp_s,iatscp_e
4060 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4062 xi=0.5D0*(c(1,i)+c(1,i+1))
4063 yi=0.5D0*(c(2,i)+c(2,i+1))
4064 zi=0.5D0*(c(3,i)+c(3,i+1))
4066 do iint=1,nscp_gr(i)
4068 do j=iscpstart(i,iint),iscpend(i,iint)
4069 if (itype(j).eq.ntyp1) cycle
4070 itypj=iabs(itype(j))
4071 C Uncomment following three lines for SC-p interactions
4075 C Uncomment following three lines for Ca-p interactions
4079 rij=xj*xj+yj*yj+zj*zj
4082 if (rij.lt.r0ijsq) then
4083 evdwij=0.25d0*(rij-r0ijsq)**2
4091 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4096 cgrad if (j.lt.i) then
4097 cd write (iout,*) 'j<i'
4098 C Uncomment following three lines for SC-p interactions
4100 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4103 cd write (iout,*) 'j>i'
4105 cgrad ggg(k)=-ggg(k)
4106 C Uncomment following line for SC-p interactions
4107 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4111 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4113 cgrad kstart=min0(i+1,j)
4114 cgrad kend=max0(i-1,j-1)
4115 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4116 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4117 cgrad do k=kstart,kend
4119 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4123 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4124 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4132 C-----------------------------------------------------------------------------
4133 subroutine escp(evdw2,evdw2_14)
4135 C This subroutine calculates the excluded-volume interaction energy between
4136 C peptide-group centers and side chains and its gradient in virtual-bond and
4137 C side-chain vectors.
4139 implicit real*8 (a-h,o-z)
4140 include 'DIMENSIONS'
4141 include 'COMMON.GEO'
4142 include 'COMMON.VAR'
4143 include 'COMMON.LOCAL'
4144 include 'COMMON.CHAIN'
4145 include 'COMMON.DERIV'
4146 include 'COMMON.INTERACT'
4147 include 'COMMON.FFIELD'
4148 include 'COMMON.IOUNITS'
4149 include 'COMMON.CONTROL'
4153 cd print '(a)','Enter ESCP'
4154 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4155 do i=iatscp_s,iatscp_e
4156 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4158 xi=0.5D0*(c(1,i)+c(1,i+1))
4159 yi=0.5D0*(c(2,i)+c(2,i+1))
4160 zi=0.5D0*(c(3,i)+c(3,i+1))
4162 do iint=1,nscp_gr(i)
4164 do j=iscpstart(i,iint),iscpend(i,iint)
4165 itypj=iabs(itype(j))
4166 if (itypj.eq.ntyp1) cycle
4167 C Uncomment following three lines for SC-p interactions
4171 C Uncomment following three lines for Ca-p interactions
4175 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4177 e1=fac*fac*aad(itypj,iteli)
4178 e2=fac*bad(itypj,iteli)
4179 if (iabs(j-i) .le. 2) then
4182 evdw2_14=evdw2_14+e1+e2
4186 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4187 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4190 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4192 fac=-(evdwij+e1)*rrij
4196 cgrad if (j.lt.i) then
4197 cd write (iout,*) 'j<i'
4198 C Uncomment following three lines for SC-p interactions
4200 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4203 cd write (iout,*) 'j>i'
4205 cgrad ggg(k)=-ggg(k)
4206 C Uncomment following line for SC-p interactions
4207 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4208 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4212 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4214 cgrad kstart=min0(i+1,j)
4215 cgrad kend=max0(i-1,j-1)
4216 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4217 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4218 cgrad do k=kstart,kend
4220 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4224 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4225 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4233 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4234 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4235 gradx_scp(j,i)=expon*gradx_scp(j,i)
4238 C******************************************************************************
4242 C To save time the factor EXPON has been extracted from ALL components
4243 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4246 C******************************************************************************
4249 C--------------------------------------------------------------------------
4250 subroutine edis(ehpb)
4252 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4254 implicit real*8 (a-h,o-z)
4255 include 'DIMENSIONS'
4256 include 'COMMON.SBRIDGE'
4257 include 'COMMON.CHAIN'
4258 include 'COMMON.DERIV'
4259 include 'COMMON.VAR'
4260 include 'COMMON.INTERACT'
4261 include 'COMMON.IOUNITS'
4264 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4265 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4266 if (link_end.eq.0) return
4267 do i=link_start,link_end
4268 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4269 C CA-CA distance used in regularization of structure.
4272 C iii and jjj point to the residues for which the distance is assigned.
4273 if (ii.gt.nres) then
4280 cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj
4281 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4282 C distance and angle dependent SS bond potential.
4283 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4284 & iabs(itype(jjj)).eq.1) then
4285 call ssbond_ene(iii,jjj,eij)
4287 cd write (iout,*) "eij",eij
4289 C Calculate the distance between the two points and its difference from the
4293 C Get the force constant corresponding to this distance.
4295 C Calculate the contribution to energy.
4296 ehpb=ehpb+waga*rdis*rdis
4298 C Evaluate gradient.
4301 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4302 cd & ' waga=',waga,' fac=',fac
4304 ggg(j)=fac*(c(j,jj)-c(j,ii))
4306 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4307 C If this is a SC-SC distance, we need to calculate the contributions to the
4308 C Cartesian gradient in the SC vectors (ghpbx).
4311 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4312 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4315 cgrad do j=iii,jjj-1
4317 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4321 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4322 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4329 C--------------------------------------------------------------------------
4330 subroutine ssbond_ene(i,j,eij)
4332 C Calculate the distance and angle dependent SS-bond potential energy
4333 C using a free-energy function derived based on RHF/6-31G** ab initio
4334 C calculations of diethyl disulfide.
4336 C A. Liwo and U. Kozlowska, 11/24/03
4338 implicit real*8 (a-h,o-z)
4339 include 'DIMENSIONS'
4340 include 'COMMON.SBRIDGE'
4341 include 'COMMON.CHAIN'
4342 include 'COMMON.DERIV'
4343 include 'COMMON.LOCAL'
4344 include 'COMMON.INTERACT'
4345 include 'COMMON.VAR'
4346 include 'COMMON.IOUNITS'
4347 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4348 itypi=iabs(itype(i))
4352 dxi=dc_norm(1,nres+i)
4353 dyi=dc_norm(2,nres+i)
4354 dzi=dc_norm(3,nres+i)
4355 c dsci_inv=dsc_inv(itypi)
4356 dsci_inv=vbld_inv(nres+i)
4357 itypj=iabs(itype(j))
4358 c dscj_inv=dsc_inv(itypj)
4359 dscj_inv=vbld_inv(nres+j)
4363 dxj=dc_norm(1,nres+j)
4364 dyj=dc_norm(2,nres+j)
4365 dzj=dc_norm(3,nres+j)
4366 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4371 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4372 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4373 om12=dxi*dxj+dyi*dyj+dzi*dzj
4375 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4376 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4382 deltat12=om2-om1+2.0d0
4384 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4385 & +akct*deltad*deltat12
4386 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4387 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4388 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4389 c & " deltat12",deltat12," eij",eij
4390 ed=2*akcm*deltad+akct*deltat12
4392 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4393 eom1=-2*akth*deltat1-pom1-om2*pom2
4394 eom2= 2*akth*deltat2+pom1-om1*pom2
4397 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4398 ghpbx(k,i)=ghpbx(k,i)-ggk
4399 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4400 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4401 ghpbx(k,j)=ghpbx(k,j)+ggk
4402 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4403 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4404 ghpbc(k,i)=ghpbc(k,i)-ggk
4405 ghpbc(k,j)=ghpbc(k,j)+ggk
4408 C Calculate the components of the gradient in DC and X
4412 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4417 C--------------------------------------------------------------------------
4418 subroutine ebond(estr)
4420 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4422 implicit real*8 (a-h,o-z)
4423 include 'DIMENSIONS'
4424 include 'COMMON.LOCAL'
4425 include 'COMMON.GEO'
4426 include 'COMMON.INTERACT'
4427 include 'COMMON.DERIV'
4428 include 'COMMON.VAR'
4429 include 'COMMON.CHAIN'
4430 include 'COMMON.IOUNITS'
4431 include 'COMMON.NAMES'
4432 include 'COMMON.FFIELD'
4433 include 'COMMON.CONTROL'
4434 include 'COMMON.SETUP'
4435 double precision u(3),ud(3)
4438 do i=ibondp_start,ibondp_end
4439 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4440 estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4442 gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4443 & *dc(j,i-1)/vbld(i)
4445 if (energy_dec) write(iout,*)
4446 & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4448 diff = vbld(i)-vbldp0
4449 if (energy_dec) write (iout,*)
4450 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4453 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4455 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4458 estr=0.5d0*AKP*estr+estr1
4460 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4462 do i=ibond_start,ibond_end
4464 if (iti.ne.10 .and. iti.ne.ntyp1) then
4467 diff=vbld(i+nres)-vbldsc0(1,iti)
4468 if (energy_dec) write (iout,*)
4469 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4470 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4471 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4473 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4477 diff=vbld(i+nres)-vbldsc0(j,iti)
4478 ud(j)=aksc(j,iti)*diff
4479 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4493 uprod2=uprod2*u(k)*u(k)
4497 usumsqder=usumsqder+ud(j)*uprod2
4499 estr=estr+uprod/usum
4501 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4509 C--------------------------------------------------------------------------
4510 subroutine ebend(etheta)
4512 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4513 C angles gamma and its derivatives in consecutive thetas and gammas.
4515 implicit real*8 (a-h,o-z)
4516 include 'DIMENSIONS'
4517 include 'COMMON.LOCAL'
4518 include 'COMMON.GEO'
4519 include 'COMMON.INTERACT'
4520 include 'COMMON.DERIV'
4521 include 'COMMON.VAR'
4522 include 'COMMON.CHAIN'
4523 include 'COMMON.IOUNITS'
4524 include 'COMMON.NAMES'
4525 include 'COMMON.FFIELD'
4526 include 'COMMON.CONTROL'
4527 common /calcthet/ term1,term2,termm,diffak,ratak,
4528 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4529 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4530 double precision y(2),z(2)
4532 c time11=dexp(-2*time)
4535 c write (*,'(a,i2)') 'EBEND ICG=',icg
4536 do i=ithet_start,ithet_end
4537 if (itype(i-1).eq.ntyp1) cycle
4538 C Zero the energy function and its derivative at 0 or pi.
4539 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4541 ichir1=isign(1,itype(i-2))
4542 ichir2=isign(1,itype(i))
4543 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4544 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4545 if (itype(i-1).eq.10) then
4546 itype1=isign(10,itype(i-2))
4547 ichir11=isign(1,itype(i-2))
4548 ichir12=isign(1,itype(i-2))
4549 itype2=isign(10,itype(i))
4550 ichir21=isign(1,itype(i))
4551 ichir22=isign(1,itype(i))
4554 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4557 if (phii.ne.phii) phii=150.0
4567 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4570 if (phii1.ne.phii1) phii1=150.0
4582 C Calculate the "mean" value of theta from the part of the distribution
4583 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4584 C In following comments this theta will be referred to as t_c.
4585 thet_pred_mean=0.0d0
4587 athetk=athet(k,it,ichir1,ichir2)
4588 bthetk=bthet(k,it,ichir1,ichir2)
4590 athetk=athet(k,itype1,ichir11,ichir12)
4591 bthetk=bthet(k,itype2,ichir21,ichir22)
4593 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4595 dthett=thet_pred_mean*ssd
4596 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4597 C Derivatives of the "mean" values in gamma1 and gamma2.
4598 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4599 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4600 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4601 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4603 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4604 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4605 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4606 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4608 if (theta(i).gt.pi-delta) then
4609 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4611 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4612 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4613 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4615 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4617 else if (theta(i).lt.delta) then
4618 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4619 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4620 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4622 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4623 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4626 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4629 etheta=etheta+ethetai
4630 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4632 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4633 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4634 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
4636 C Ufff.... We've done all this!!!
4639 C---------------------------------------------------------------------------
4640 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4642 implicit real*8 (a-h,o-z)
4643 include 'DIMENSIONS'
4644 include 'COMMON.LOCAL'
4645 include 'COMMON.IOUNITS'
4646 common /calcthet/ term1,term2,termm,diffak,ratak,
4647 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4648 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4649 C Calculate the contributions to both Gaussian lobes.
4650 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4651 C The "polynomial part" of the "standard deviation" of this part of
4655 sig=sig*thet_pred_mean+polthet(j,it)
4657 C Derivative of the "interior part" of the "standard deviation of the"
4658 C gamma-dependent Gaussian lobe in t_c.
4659 sigtc=3*polthet(3,it)
4661 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4664 C Set the parameters of both Gaussian lobes of the distribution.
4665 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4666 fac=sig*sig+sigc0(it)
4669 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4670 sigsqtc=-4.0D0*sigcsq*sigtc
4671 c print *,i,sig,sigtc,sigsqtc
4672 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4673 sigtc=-sigtc/(fac*fac)
4674 C Following variable is sigma(t_c)**(-2)
4675 sigcsq=sigcsq*sigcsq
4677 sig0inv=1.0D0/sig0i**2
4678 delthec=thetai-thet_pred_mean
4679 delthe0=thetai-theta0i
4680 term1=-0.5D0*sigcsq*delthec*delthec
4681 term2=-0.5D0*sig0inv*delthe0*delthe0
4682 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4683 C NaNs in taking the logarithm. We extract the largest exponent which is added
4684 C to the energy (this being the log of the distribution) at the end of energy
4685 C term evaluation for this virtual-bond angle.
4686 if (term1.gt.term2) then
4688 term2=dexp(term2-termm)
4692 term1=dexp(term1-termm)
4695 C The ratio between the gamma-independent and gamma-dependent lobes of
4696 C the distribution is a Gaussian function of thet_pred_mean too.
4697 diffak=gthet(2,it)-thet_pred_mean
4698 ratak=diffak/gthet(3,it)**2
4699 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4700 C Let's differentiate it in thet_pred_mean NOW.
4702 C Now put together the distribution terms to make complete distribution.
4703 termexp=term1+ak*term2
4704 termpre=sigc+ak*sig0i
4705 C Contribution of the bending energy from this theta is just the -log of
4706 C the sum of the contributions from the two lobes and the pre-exponential
4707 C factor. Simple enough, isn't it?
4708 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4709 C NOW the derivatives!!!
4710 C 6/6/97 Take into account the deformation.
4711 E_theta=(delthec*sigcsq*term1
4712 & +ak*delthe0*sig0inv*term2)/termexp
4713 E_tc=((sigtc+aktc*sig0i)/termpre
4714 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4715 & aktc*term2)/termexp)
4718 c-----------------------------------------------------------------------------
4719 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4720 implicit real*8 (a-h,o-z)
4721 include 'DIMENSIONS'
4722 include 'COMMON.LOCAL'
4723 include 'COMMON.IOUNITS'
4724 common /calcthet/ term1,term2,termm,diffak,ratak,
4725 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4726 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4727 delthec=thetai-thet_pred_mean
4728 delthe0=thetai-theta0i
4729 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4730 t3 = thetai-thet_pred_mean
4734 t14 = t12+t6*sigsqtc
4736 t21 = thetai-theta0i
4742 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4743 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4744 & *(-t12*t9-ak*sig0inv*t27)
4748 C--------------------------------------------------------------------------
4749 subroutine ebend(etheta)
4751 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4752 C angles gamma and its derivatives in consecutive thetas and gammas.
4753 C ab initio-derived potentials from
4754 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4756 implicit real*8 (a-h,o-z)
4757 include 'DIMENSIONS'
4758 include 'COMMON.LOCAL'
4759 include 'COMMON.GEO'
4760 include 'COMMON.INTERACT'
4761 include 'COMMON.DERIV'
4762 include 'COMMON.VAR'
4763 include 'COMMON.CHAIN'
4764 include 'COMMON.IOUNITS'
4765 include 'COMMON.NAMES'
4766 include 'COMMON.FFIELD'
4767 include 'COMMON.CONTROL'
4768 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4769 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4770 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4771 & sinph1ph2(maxdouble,maxdouble)
4772 logical lprn /.false./, lprn1 /.false./
4774 do i=ithet_start,ithet_end
4775 if (itype(i-1).eq.ntyp1) cycle
4776 if (iabs(itype(i+1)).eq.20) iblock=2
4777 if (iabs(itype(i+1)).ne.20) iblock=1
4781 theti2=0.5d0*theta(i)
4782 ityp2=ithetyp((itype(i-1)))
4784 coskt(k)=dcos(k*theti2)
4785 sinkt(k)=dsin(k*theti2)
4787 if (i.gt.3 .and. itype(i-2).ne.ntyp1) then
4790 if (phii.ne.phii) phii=150.0
4794 ityp1=ithetyp((itype(i-2)))
4795 C propagation of chirality for glycine type
4797 cosph1(k)=dcos(k*phii)
4798 sinph1(k)=dsin(k*phii)
4808 if (i.lt.nres .and. itype(i).ne.ntyp1) then
4811 if (phii1.ne.phii1) phii1=150.0
4816 ityp3=ithetyp((itype(i)))
4818 cosph2(k)=dcos(k*phii1)
4819 sinph2(k)=dsin(k*phii1)
4829 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
4832 ccl=cosph1(l)*cosph2(k-l)
4833 ssl=sinph1(l)*sinph2(k-l)
4834 scl=sinph1(l)*cosph2(k-l)
4835 csl=cosph1(l)*sinph2(k-l)
4836 cosph1ph2(l,k)=ccl-ssl
4837 cosph1ph2(k,l)=ccl+ssl
4838 sinph1ph2(l,k)=scl+csl
4839 sinph1ph2(k,l)=scl-csl
4843 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4844 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4845 write (iout,*) "coskt and sinkt"
4847 write (iout,*) k,coskt(k),sinkt(k)
4851 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
4852 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
4855 & write (iout,*) "k",k,"
4856 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
4857 & " ethetai",ethetai
4860 write (iout,*) "cosph and sinph"
4862 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4864 write (iout,*) "cosph1ph2 and sinph2ph2"
4867 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4868 & sinph1ph2(l,k),sinph1ph2(k,l)
4871 write(iout,*) "ethetai",ethetai
4875 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
4876 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
4877 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
4878 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
4879 ethetai=ethetai+sinkt(m)*aux
4880 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4881 dephii=dephii+k*sinkt(m)*(
4882 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
4883 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
4884 dephii1=dephii1+k*sinkt(m)*(
4885 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
4886 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
4888 & write (iout,*) "m",m," k",k," bbthet",
4889 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
4890 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
4891 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
4892 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
4896 & write(iout,*) "ethetai",ethetai
4900 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4901 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
4902 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4903 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
4904 ethetai=ethetai+sinkt(m)*aux
4905 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4906 dephii=dephii+l*sinkt(m)*(
4907 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
4908 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4909 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
4910 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4911 dephii1=dephii1+(k-l)*sinkt(m)*(
4912 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
4913 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
4914 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
4915 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
4917 write (iout,*) "m",m," k",k," l",l," ffthet",
4918 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4919 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
4920 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
4921 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
4922 & " ethetai",ethetai
4923 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4924 & cosph1ph2(k,l)*sinkt(m),
4925 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4933 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4934 & i,theta(i)*rad2deg,phii*rad2deg,
4935 & phii1*rad2deg,ethetai
4937 etheta=etheta+ethetai
4938 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4939 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4940 gloc(nphi+i-2,icg)=wang*dethetai+gloc(nphi+i-2,icg)
4946 c-----------------------------------------------------------------------------
4947 subroutine esc(escloc)
4948 C Calculate the local energy of a side chain and its derivatives in the
4949 C corresponding virtual-bond valence angles THETA and the spherical angles
4951 implicit real*8 (a-h,o-z)
4952 include 'DIMENSIONS'
4953 include 'COMMON.GEO'
4954 include 'COMMON.LOCAL'
4955 include 'COMMON.VAR'
4956 include 'COMMON.INTERACT'
4957 include 'COMMON.DERIV'
4958 include 'COMMON.CHAIN'
4959 include 'COMMON.IOUNITS'
4960 include 'COMMON.NAMES'
4961 include 'COMMON.FFIELD'
4962 include 'COMMON.CONTROL'
4963 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4964 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4965 common /sccalc/ time11,time12,time112,theti,it,nlobit
4968 c write (iout,'(a)') 'ESC'
4969 do i=loc_start,loc_end
4971 if (it.eq.ntyp1) cycle
4972 if (it.eq.10) goto 1
4973 nlobit=nlob(iabs(it))
4974 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4975 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4976 theti=theta(i+1)-pipol
4981 if (x(2).gt.pi-delta) then
4985 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4987 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4988 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4990 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4991 & ddersc0(1),dersc(1))
4992 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4993 & ddersc0(3),dersc(3))
4995 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4997 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4998 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4999 & dersc0(2),esclocbi,dersc02)
5000 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5002 call splinthet(x(2),0.5d0*delta,ss,ssd)
5007 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5009 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5010 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5012 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5014 c write (iout,*) escloci
5015 else if (x(2).lt.delta) then
5019 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5021 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5022 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5024 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5025 & ddersc0(1),dersc(1))
5026 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5027 & ddersc0(3),dersc(3))
5029 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5031 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5032 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5033 & dersc0(2),esclocbi,dersc02)
5034 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5039 call splinthet(x(2),0.5d0*delta,ss,ssd)
5041 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5043 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5044 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5046 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5047 c write (iout,*) escloci
5049 call enesc(x,escloci,dersc,ddummy,.false.)
5052 escloc=escloc+escloci
5053 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5054 & 'escloc',i,escloci
5055 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5057 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5059 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5060 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5065 C---------------------------------------------------------------------------
5066 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5067 implicit real*8 (a-h,o-z)
5068 include 'DIMENSIONS'
5069 include 'COMMON.GEO'
5070 include 'COMMON.LOCAL'
5071 include 'COMMON.IOUNITS'
5072 common /sccalc/ time11,time12,time112,theti,it,nlobit
5073 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5074 double precision contr(maxlob,-1:1)
5076 c write (iout,*) 'it=',it,' nlobit=',nlobit
5080 if (mixed) ddersc(j)=0.0d0
5084 C Because of periodicity of the dependence of the SC energy in omega we have
5085 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5086 C To avoid underflows, first compute & store the exponents.
5094 z(k)=x(k)-censc(k,j,it)
5099 Axk=Axk+gaussc(l,k,j,it)*z(l)
5105 expfac=expfac+Ax(k,j,iii)*z(k)
5113 C As in the case of ebend, we want to avoid underflows in exponentiation and
5114 C subsequent NaNs and INFs in energy calculation.
5115 C Find the largest exponent
5119 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5123 cd print *,'it=',it,' emin=',emin
5125 C Compute the contribution to SC energy and derivatives
5130 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5131 if(adexp.ne.adexp) adexp=1.0
5134 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5136 cd print *,'j=',j,' expfac=',expfac
5137 escloc_i=escloc_i+expfac
5139 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5143 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5144 & +gaussc(k,2,j,it))*expfac
5151 dersc(1)=dersc(1)/cos(theti)**2
5152 ddersc(1)=ddersc(1)/cos(theti)**2
5155 escloci=-(dlog(escloc_i)-emin)
5157 dersc(j)=dersc(j)/escloc_i
5161 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5166 C------------------------------------------------------------------------------
5167 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5168 implicit real*8 (a-h,o-z)
5169 include 'DIMENSIONS'
5170 include 'COMMON.GEO'
5171 include 'COMMON.LOCAL'
5172 include 'COMMON.IOUNITS'
5173 common /sccalc/ time11,time12,time112,theti,it,nlobit
5174 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5175 double precision contr(maxlob)
5186 z(k)=x(k)-censc(k,j,it)
5192 Axk=Axk+gaussc(l,k,j,it)*z(l)
5198 expfac=expfac+Ax(k,j)*z(k)
5203 C As in the case of ebend, we want to avoid underflows in exponentiation and
5204 C subsequent NaNs and INFs in energy calculation.
5205 C Find the largest exponent
5208 if (emin.gt.contr(j)) emin=contr(j)
5212 C Compute the contribution to SC energy and derivatives
5216 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5217 escloc_i=escloc_i+expfac
5219 dersc(k)=dersc(k)+Ax(k,j)*expfac
5221 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5222 & +gaussc(1,2,j,it))*expfac
5226 dersc(1)=dersc(1)/cos(theti)**2
5227 dersc12=dersc12/cos(theti)**2
5228 escloci=-(dlog(escloc_i)-emin)
5230 dersc(j)=dersc(j)/escloc_i
5232 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5236 c----------------------------------------------------------------------------------
5237 subroutine esc(escloc)
5238 C Calculate the local energy of a side chain and its derivatives in the
5239 C corresponding virtual-bond valence angles THETA and the spherical angles
5240 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5241 C added by Urszula Kozlowska. 07/11/2007
5243 implicit real*8 (a-h,o-z)
5244 include 'DIMENSIONS'
5245 include 'COMMON.GEO'
5246 include 'COMMON.LOCAL'
5247 include 'COMMON.VAR'
5248 include 'COMMON.SCROT'
5249 include 'COMMON.INTERACT'
5250 include 'COMMON.DERIV'
5251 include 'COMMON.CHAIN'
5252 include 'COMMON.IOUNITS'
5253 include 'COMMON.NAMES'
5254 include 'COMMON.FFIELD'
5255 include 'COMMON.CONTROL'
5256 include 'COMMON.VECTORS'
5257 double precision x_prime(3),y_prime(3),z_prime(3)
5258 & , sumene,dsc_i,dp2_i,x(65),
5259 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5260 & de_dxx,de_dyy,de_dzz,de_dt
5261 double precision s1_t,s1_6_t,s2_t,s2_6_t
5263 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5264 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5265 & dt_dCi(3),dt_dCi1(3)
5266 common /sccalc/ time11,time12,time112,theti,it,nlobit
5269 do i=loc_start,loc_end
5270 if (itype(i).eq.ntyp1) cycle
5271 costtab(i+1) =dcos(theta(i+1))
5272 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5273 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5274 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5275 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5276 cosfac=dsqrt(cosfac2)
5277 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5278 sinfac=dsqrt(sinfac2)
5280 if (it.eq.10) goto 1
5282 C Compute the axes of tghe local cartesian coordinates system; store in
5283 c x_prime, y_prime and z_prime
5290 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5291 C & dc_norm(3,i+nres)
5293 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5294 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5297 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5300 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5301 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5302 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5303 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5304 c & " xy",scalar(x_prime(1),y_prime(1)),
5305 c & " xz",scalar(x_prime(1),z_prime(1)),
5306 c & " yy",scalar(y_prime(1),y_prime(1)),
5307 c & " yz",scalar(y_prime(1),z_prime(1)),
5308 c & " zz",scalar(z_prime(1),z_prime(1))
5310 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5311 C to local coordinate system. Store in xx, yy, zz.
5317 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5318 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5319 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5326 C Compute the energy of the ith side cbain
5328 c write (2,*) "xx",xx," yy",yy," zz",zz
5331 x(j) = sc_parmin(j,it)
5334 Cc diagnostics - remove later
5336 yy1 = dsin(alph(2))*dcos(omeg(2))
5337 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5338 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5339 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5341 C," --- ", xx_w,yy_w,zz_w
5344 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5345 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5347 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5348 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5350 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5351 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5352 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5353 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5354 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5356 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5357 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5358 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5359 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5360 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5362 dsc_i = 0.743d0+x(61)
5364 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5365 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5366 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5367 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5368 s1=(1+x(63))/(0.1d0 + dscp1)
5369 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5370 s2=(1+x(65))/(0.1d0 + dscp2)
5371 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5372 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5373 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5374 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5376 c & dscp1,dscp2,sumene
5377 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5378 escloc = escloc + sumene
5379 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
5384 C This section to check the numerical derivatives of the energy of ith side
5385 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5386 C #define DEBUG in the code to turn it on.
5388 write (2,*) "sumene =",sumene
5392 write (2,*) xx,yy,zz
5393 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5394 de_dxx_num=(sumenep-sumene)/aincr
5396 write (2,*) "xx+ sumene from enesc=",sumenep
5399 write (2,*) xx,yy,zz
5400 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5401 de_dyy_num=(sumenep-sumene)/aincr
5403 write (2,*) "yy+ sumene from enesc=",sumenep
5406 write (2,*) xx,yy,zz
5407 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5408 de_dzz_num=(sumenep-sumene)/aincr
5410 write (2,*) "zz+ sumene from enesc=",sumenep
5411 costsave=cost2tab(i+1)
5412 sintsave=sint2tab(i+1)
5413 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5414 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5415 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5416 de_dt_num=(sumenep-sumene)/aincr
5417 write (2,*) " t+ sumene from enesc=",sumenep
5418 cost2tab(i+1)=costsave
5419 sint2tab(i+1)=sintsave
5420 C End of diagnostics section.
5423 C Compute the gradient of esc
5425 c zz=zz*dsign(1.0,dfloat(itype(i)))
5426 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5427 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5428 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5429 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5430 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5431 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5432 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5433 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5434 pom1=(sumene3*sint2tab(i+1)+sumene1)
5435 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5436 pom2=(sumene4*cost2tab(i+1)+sumene2)
5437 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5438 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5439 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5440 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5442 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5443 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5444 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5446 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5447 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5448 & +(pom1+pom2)*pom_dx
5450 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
5453 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5454 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5455 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5457 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5458 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5459 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5460 & +x(59)*zz**2 +x(60)*xx*zz
5461 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5462 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5463 & +(pom1-pom2)*pom_dy
5465 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
5468 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5469 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5470 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5471 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5472 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5473 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5474 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5475 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5477 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
5480 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5481 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5482 & +pom1*pom_dt1+pom2*pom_dt2
5484 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
5489 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5490 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5491 cosfac2xx=cosfac2*xx
5492 sinfac2yy=sinfac2*yy
5494 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5496 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5498 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5499 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5500 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5501 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5502 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5503 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5504 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5505 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5506 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5507 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5511 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5512 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5513 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5514 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5517 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5518 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5519 dZZ_XYZ(k)=vbld_inv(i+nres)*
5520 & (z_prime(k)-zz*dC_norm(k,i+nres))
5522 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5523 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5527 dXX_Ctab(k,i)=dXX_Ci(k)
5528 dXX_C1tab(k,i)=dXX_Ci1(k)
5529 dYY_Ctab(k,i)=dYY_Ci(k)
5530 dYY_C1tab(k,i)=dYY_Ci1(k)
5531 dZZ_Ctab(k,i)=dZZ_Ci(k)
5532 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5533 dXX_XYZtab(k,i)=dXX_XYZ(k)
5534 dYY_XYZtab(k,i)=dYY_XYZ(k)
5535 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5539 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5540 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5541 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5542 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5543 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5545 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5546 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5547 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5548 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5549 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5550 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5551 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5552 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5554 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5555 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5557 C to check gradient call subroutine check_grad
5563 c------------------------------------------------------------------------------
5564 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5566 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5567 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5568 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5569 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5571 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5572 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5574 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5575 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5576 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5577 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5578 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5580 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5581 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5582 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5583 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5584 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5586 dsc_i = 0.743d0+x(61)
5588 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5589 & *(xx*cost2+yy*sint2))
5590 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5591 & *(xx*cost2-yy*sint2))
5592 s1=(1+x(63))/(0.1d0 + dscp1)
5593 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5594 s2=(1+x(65))/(0.1d0 + dscp2)
5595 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5596 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5597 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5602 c------------------------------------------------------------------------------
5603 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5605 C This procedure calculates two-body contact function g(rij) and its derivative:
5608 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5611 C where x=(rij-r0ij)/delta
5613 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5616 double precision rij,r0ij,eps0ij,fcont,fprimcont
5617 double precision x,x2,x4,delta
5621 if (x.lt.-1.0D0) then
5624 else if (x.le.1.0D0) then
5627 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5628 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5635 c------------------------------------------------------------------------------
5636 subroutine splinthet(theti,delta,ss,ssder)
5637 implicit real*8 (a-h,o-z)
5638 include 'DIMENSIONS'
5639 include 'COMMON.VAR'
5640 include 'COMMON.GEO'
5643 if (theti.gt.pipol) then
5644 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5646 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5651 c------------------------------------------------------------------------------
5652 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5654 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5655 double precision ksi,ksi2,ksi3,a1,a2,a3
5656 a1=fprim0*delta/(f1-f0)
5662 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5663 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5666 c------------------------------------------------------------------------------
5667 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5669 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5670 double precision ksi,ksi2,ksi3,a1,a2,a3
5675 a2=3*(f1x-f0x)-2*fprim0x*delta
5676 a3=fprim0x*delta-2*(f1x-f0x)
5677 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5680 C-----------------------------------------------------------------------------
5682 C-----------------------------------------------------------------------------
5683 subroutine etor(etors,edihcnstr)
5684 implicit real*8 (a-h,o-z)
5685 include 'DIMENSIONS'
5686 include 'COMMON.VAR'
5687 include 'COMMON.GEO'
5688 include 'COMMON.LOCAL'
5689 include 'COMMON.TORSION'
5690 include 'COMMON.INTERACT'
5691 include 'COMMON.DERIV'
5692 include 'COMMON.CHAIN'
5693 include 'COMMON.NAMES'
5694 include 'COMMON.IOUNITS'
5695 include 'COMMON.FFIELD'
5696 include 'COMMON.TORCNSTR'
5697 include 'COMMON.CONTROL'
5699 C Set lprn=.true. for debugging
5703 do i=iphi_start,iphi_end
5705 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
5706 & .or. itype(i).eq.ntyp1) cycle
5707 itori=itortyp(itype(i-2))
5708 itori1=itortyp(itype(i-1))
5711 C Proline-Proline pair is a special case...
5712 if (itori.eq.3 .and. itori1.eq.3) then
5713 if (phii.gt.-dwapi3) then
5715 fac=1.0D0/(1.0D0-cosphi)
5716 etorsi=v1(1,3,3)*fac
5717 etorsi=etorsi+etorsi
5718 etors=etors+etorsi-v1(1,3,3)
5719 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5720 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5723 v1ij=v1(j+1,itori,itori1)
5724 v2ij=v2(j+1,itori,itori1)
5727 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5728 if (energy_dec) etors_ii=etors_ii+
5729 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5730 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5734 v1ij=v1(j,itori,itori1)
5735 v2ij=v2(j,itori,itori1)
5738 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5739 if (energy_dec) etors_ii=etors_ii+
5740 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5741 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5744 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5747 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5748 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5749 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5750 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5751 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5753 ! 6/20/98 - dihedral angle constraints
5756 itori=idih_constr(i)
5759 if (difi.gt.drange(i)) then
5761 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5762 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5763 else if (difi.lt.-drange(i)) then
5765 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5766 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5768 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5769 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5771 ! write (iout,*) 'edihcnstr',edihcnstr
5774 c------------------------------------------------------------------------------
5775 subroutine etor_d(etors_d)
5779 c----------------------------------------------------------------------------
5781 subroutine etor(etors,edihcnstr)
5782 implicit real*8 (a-h,o-z)
5783 include 'DIMENSIONS'
5784 include 'COMMON.VAR'
5785 include 'COMMON.GEO'
5786 include 'COMMON.LOCAL'
5787 include 'COMMON.TORSION'
5788 include 'COMMON.INTERACT'
5789 include 'COMMON.DERIV'
5790 include 'COMMON.CHAIN'
5791 include 'COMMON.NAMES'
5792 include 'COMMON.IOUNITS'
5793 include 'COMMON.FFIELD'
5794 include 'COMMON.TORCNSTR'
5795 include 'COMMON.CONTROL'
5797 C Set lprn=.true. for debugging
5801 do i=iphi_start,iphi_end
5802 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5803 & .or. itype(i).eq.ntyp1) cycle
5805 if (iabs(itype(i)).eq.20) then
5810 itori=itortyp(itype(i-2))
5811 itori1=itortyp(itype(i-1))
5814 C Regular cosine and sine terms
5815 do j=1,nterm(itori,itori1,iblock)
5816 v1ij=v1(j,itori,itori1,iblock)
5817 v2ij=v2(j,itori,itori1,iblock)
5820 etors=etors+v1ij*cosphi+v2ij*sinphi
5821 if (energy_dec) etors_ii=etors_ii+
5822 & v1ij*cosphi+v2ij*sinphi
5823 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5827 C E = SUM ----------------------------------- - v1
5828 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5830 cosphi=dcos(0.5d0*phii)
5831 sinphi=dsin(0.5d0*phii)
5832 do j=1,nlor(itori,itori1,iblock)
5833 vl1ij=vlor1(j,itori,itori1)
5834 vl2ij=vlor2(j,itori,itori1)
5835 vl3ij=vlor3(j,itori,itori1)
5836 pom=vl2ij*cosphi+vl3ij*sinphi
5837 pom1=1.0d0/(pom*pom+1.0d0)
5838 etors=etors+vl1ij*pom1
5839 if (energy_dec) etors_ii=etors_ii+
5842 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5844 C Subtract the constant term
5845 etors=etors-v0(itori,itori1,iblock)
5846 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5847 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
5849 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5850 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5851 & (v1(j,itori,itori1,iblock),j=1,6),
5852 & (v2(j,itori,itori1,iblock),j=1,6)
5853 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5854 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5856 ! 6/20/98 - dihedral angle constraints
5858 c do i=1,ndih_constr
5859 do i=idihconstr_start,idihconstr_end
5860 itori=idih_constr(i)
5862 difi=pinorm(phii-phi0(i))
5863 if (difi.gt.drange(i)) then
5865 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5866 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5867 else if (difi.lt.-drange(i)) then
5869 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5870 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5874 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5875 cd & rad2deg*phi0(i), rad2deg*drange(i),
5876 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5878 cd write (iout,*) 'edihcnstr',edihcnstr
5881 c----------------------------------------------------------------------------
5882 subroutine etor_d(etors_d)
5883 C 6/23/01 Compute double torsional energy
5884 implicit real*8 (a-h,o-z)
5885 include 'DIMENSIONS'
5886 include 'COMMON.VAR'
5887 include 'COMMON.GEO'
5888 include 'COMMON.LOCAL'
5889 include 'COMMON.TORSION'
5890 include 'COMMON.INTERACT'
5891 include 'COMMON.DERIV'
5892 include 'COMMON.CHAIN'
5893 include 'COMMON.NAMES'
5894 include 'COMMON.IOUNITS'
5895 include 'COMMON.FFIELD'
5896 include 'COMMON.TORCNSTR'
5898 C Set lprn=.true. for debugging
5902 c write(iout,*) "a tu??"
5903 do i=iphid_start,iphid_end
5904 if (itype(i-2).eq.ntyp1 .or. itype(i-1).eq.ntyp1
5905 & .or. itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
5906 itori=itortyp(itype(i-2))
5907 itori1=itortyp(itype(i-1))
5908 itori2=itortyp(itype(i))
5914 if (iabs(itype(i+1)).eq.20) iblock=2
5916 C Regular cosine and sine terms
5917 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5918 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5919 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5920 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5921 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5922 cosphi1=dcos(j*phii)
5923 sinphi1=dsin(j*phii)
5924 cosphi2=dcos(j*phii1)
5925 sinphi2=dsin(j*phii1)
5926 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5927 & v2cij*cosphi2+v2sij*sinphi2
5928 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5929 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5931 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5933 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5934 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5935 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5936 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5937 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5938 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5939 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5940 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5941 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5942 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5943 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5944 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5945 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5946 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5949 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5950 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5955 c------------------------------------------------------------------------------
5956 subroutine eback_sc_corr(esccor)
5957 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5958 c conformational states; temporarily implemented as differences
5959 c between UNRES torsional potentials (dependent on three types of
5960 c residues) and the torsional potentials dependent on all 20 types
5961 c of residues computed from AM1 energy surfaces of terminally-blocked
5962 c amino-acid residues.
5963 implicit real*8 (a-h,o-z)
5964 include 'DIMENSIONS'
5965 include 'COMMON.VAR'
5966 include 'COMMON.GEO'
5967 include 'COMMON.LOCAL'
5968 include 'COMMON.TORSION'
5969 include 'COMMON.SCCOR'
5970 include 'COMMON.INTERACT'
5971 include 'COMMON.DERIV'
5972 include 'COMMON.CHAIN'
5973 include 'COMMON.NAMES'
5974 include 'COMMON.IOUNITS'
5975 include 'COMMON.FFIELD'
5976 include 'COMMON.CONTROL'
5978 C Set lprn=.true. for debugging
5981 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
5983 do i=itau_start,itau_end
5984 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
5986 isccori=isccortyp(itype(i-2))
5987 isccori1=isccortyp(itype(i-1))
5988 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
5990 do intertyp=1,3 !intertyp
5991 cc Added 09 May 2012 (Adasko)
5992 cc Intertyp means interaction type of backbone mainchain correlation:
5993 c 1 = SC...Ca...Ca...Ca
5994 c 2 = Ca...Ca...Ca...SC
5995 c 3 = SC...Ca...Ca...SCi
5997 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5998 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5999 & (itype(i-1).eq.ntyp1)))
6000 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6001 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6002 & .or.(itype(i).eq.ntyp1)))
6003 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6004 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6005 & (itype(i-3).eq.ntyp1)))) cycle
6006 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6007 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6009 do j=1,nterm_sccor(isccori,isccori1)
6010 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6011 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6012 cosphi=dcos(j*tauangle(intertyp,i))
6013 sinphi=dsin(j*tauangle(intertyp,i))
6014 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6015 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6017 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
6018 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6020 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6021 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
6022 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
6023 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
6024 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6030 c----------------------------------------------------------------------------
6031 subroutine multibody(ecorr)
6032 C This subroutine calculates multi-body contributions to energy following
6033 C the idea of Skolnick et al. If side chains I and J make a contact and
6034 C at the same time side chains I+1 and J+1 make a contact, an extra
6035 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6036 implicit real*8 (a-h,o-z)
6037 include 'DIMENSIONS'
6038 include 'COMMON.IOUNITS'
6039 include 'COMMON.DERIV'
6040 include 'COMMON.INTERACT'
6041 include 'COMMON.CONTACTS'
6042 double precision gx(3),gx1(3)
6045 C Set lprn=.true. for debugging
6049 write (iout,'(a)') 'Contact function values:'
6051 write (iout,'(i2,20(1x,i2,f10.5))')
6052 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6067 num_conti=num_cont(i)
6068 num_conti1=num_cont(i1)
6073 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6074 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6075 cd & ' ishift=',ishift
6076 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6077 C The system gains extra energy.
6078 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6079 endif ! j1==j+-ishift
6088 c------------------------------------------------------------------------------
6089 double precision function esccorr(i,j,k,l,jj,kk)
6090 implicit real*8 (a-h,o-z)
6091 include 'DIMENSIONS'
6092 include 'COMMON.IOUNITS'
6093 include 'COMMON.DERIV'
6094 include 'COMMON.INTERACT'
6095 include 'COMMON.CONTACTS'
6096 double precision gx(3),gx1(3)
6101 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6102 C Calculate the multi-body contribution to energy.
6103 C Calculate multi-body contributions to the gradient.
6104 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6105 cd & k,l,(gacont(m,kk,k),m=1,3)
6107 gx(m) =ekl*gacont(m,jj,i)
6108 gx1(m)=eij*gacont(m,kk,k)
6109 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6110 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6111 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6112 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6116 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6121 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6127 c------------------------------------------------------------------------------
6128 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6129 C This subroutine calculates multi-body contributions to hydrogen-bonding
6130 implicit real*8 (a-h,o-z)
6131 include 'DIMENSIONS'
6132 include 'COMMON.IOUNITS'
6135 parameter (max_cont=maxconts)
6136 parameter (max_dim=26)
6137 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6138 double precision zapas(max_dim,maxconts,max_fg_procs),
6139 & zapas_recv(max_dim,maxconts,max_fg_procs)
6140 common /przechowalnia/ zapas
6141 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6142 & status_array(MPI_STATUS_SIZE,maxconts*2)
6144 include 'COMMON.SETUP'
6145 include 'COMMON.FFIELD'
6146 include 'COMMON.DERIV'
6147 include 'COMMON.INTERACT'
6148 include 'COMMON.CONTACTS'
6149 include 'COMMON.CONTROL'
6150 include 'COMMON.LOCAL'
6151 double precision gx(3),gx1(3),time00
6154 C Set lprn=.true. for debugging
6159 if (nfgtasks.le.1) goto 30
6161 write (iout,'(a)') 'Contact function values before RECEIVE:'
6163 write (iout,'(2i3,50(1x,i2,f5.2))')
6164 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6165 & j=1,num_cont_hb(i))
6169 do i=1,ntask_cont_from
6172 do i=1,ntask_cont_to
6175 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6177 C Make the list of contacts to send to send to other procesors
6178 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6180 do i=iturn3_start,iturn3_end
6181 c write (iout,*) "make contact list turn3",i," num_cont",
6183 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6185 do i=iturn4_start,iturn4_end
6186 c write (iout,*) "make contact list turn4",i," num_cont",
6188 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6192 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6194 do j=1,num_cont_hb(i)
6197 iproc=iint_sent_local(k,jjc,ii)
6198 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6199 if (iproc.gt.0) then
6200 ncont_sent(iproc)=ncont_sent(iproc)+1
6201 nn=ncont_sent(iproc)
6203 zapas(2,nn,iproc)=jjc
6204 zapas(3,nn,iproc)=facont_hb(j,i)
6205 zapas(4,nn,iproc)=ees0p(j,i)
6206 zapas(5,nn,iproc)=ees0m(j,i)
6207 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6208 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6209 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6210 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6211 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6212 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6213 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6214 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6215 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6216 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6217 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6218 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6219 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6220 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6221 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6222 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6223 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6224 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6225 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6226 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6227 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6234 & "Numbers of contacts to be sent to other processors",
6235 & (ncont_sent(i),i=1,ntask_cont_to)
6236 write (iout,*) "Contacts sent"
6237 do ii=1,ntask_cont_to
6239 iproc=itask_cont_to(ii)
6240 write (iout,*) nn," contacts to processor",iproc,
6241 & " of CONT_TO_COMM group"
6243 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6251 CorrelID1=nfgtasks+fg_rank+1
6253 C Receive the numbers of needed contacts from other processors
6254 do ii=1,ntask_cont_from
6255 iproc=itask_cont_from(ii)
6257 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6258 & FG_COMM,req(ireq),IERR)
6260 c write (iout,*) "IRECV ended"
6262 C Send the number of contacts needed by other processors
6263 do ii=1,ntask_cont_to
6264 iproc=itask_cont_to(ii)
6266 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6267 & FG_COMM,req(ireq),IERR)
6269 c write (iout,*) "ISEND ended"
6270 c write (iout,*) "number of requests (nn)",ireq
6273 & call MPI_Waitall(ireq,req,status_array,ierr)
6275 c & "Numbers of contacts to be received from other processors",
6276 c & (ncont_recv(i),i=1,ntask_cont_from)
6280 do ii=1,ntask_cont_from
6281 iproc=itask_cont_from(ii)
6283 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6284 c & " of CONT_TO_COMM group"
6288 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6289 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6290 c write (iout,*) "ireq,req",ireq,req(ireq)
6293 C Send the contacts to processors that need them
6294 do ii=1,ntask_cont_to
6295 iproc=itask_cont_to(ii)
6297 c write (iout,*) nn," contacts to processor",iproc,
6298 c & " of CONT_TO_COMM group"
6301 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6302 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6303 c write (iout,*) "ireq,req",ireq,req(ireq)
6305 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6309 c write (iout,*) "number of requests (contacts)",ireq
6310 c write (iout,*) "req",(req(i),i=1,4)
6313 & call MPI_Waitall(ireq,req,status_array,ierr)
6314 do iii=1,ntask_cont_from
6315 iproc=itask_cont_from(iii)
6318 write (iout,*) "Received",nn," contacts from processor",iproc,
6319 & " of CONT_FROM_COMM group"
6322 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6327 ii=zapas_recv(1,i,iii)
6328 c Flag the received contacts to prevent double-counting
6329 jj=-zapas_recv(2,i,iii)
6330 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6332 nnn=num_cont_hb(ii)+1
6335 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6336 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6337 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6338 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6339 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6340 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6341 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6342 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6343 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6344 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6345 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6346 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6347 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6348 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6349 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6350 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6351 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6352 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6353 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6354 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6355 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6356 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6357 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6358 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6363 write (iout,'(a)') 'Contact function values after receive:'
6365 write (iout,'(2i3,50(1x,i3,f5.2))')
6366 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6367 & j=1,num_cont_hb(i))
6374 write (iout,'(a)') 'Contact function values:'
6376 write (iout,'(2i3,50(1x,i3,f5.2))')
6377 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6378 & j=1,num_cont_hb(i))
6382 C Remove the loop below after debugging !!!
6389 C Calculate the local-electrostatic correlation terms
6390 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6392 num_conti=num_cont_hb(i)
6393 num_conti1=num_cont_hb(i+1)
6400 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6401 c & ' jj=',jj,' kk=',kk
6402 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6403 & .or. j.lt.0 .and. j1.gt.0) .and.
6404 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6405 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6406 C The system gains extra energy.
6407 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6408 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6409 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6411 else if (j1.eq.j) then
6412 C Contacts I-J and I-(J+1) occur simultaneously.
6413 C The system loses extra energy.
6414 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6419 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6420 c & ' jj=',jj,' kk=',kk
6422 C Contacts I-J and (I+1)-J occur simultaneously.
6423 C The system loses extra energy.
6424 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6431 c------------------------------------------------------------------------------
6432 subroutine add_hb_contact(ii,jj,itask)
6433 implicit real*8 (a-h,o-z)
6434 include "DIMENSIONS"
6435 include "COMMON.IOUNITS"
6438 parameter (max_cont=maxconts)
6439 parameter (max_dim=26)
6440 include "COMMON.CONTACTS"
6441 double precision zapas(max_dim,maxconts,max_fg_procs),
6442 & zapas_recv(max_dim,maxconts,max_fg_procs)
6443 common /przechowalnia/ zapas
6444 integer i,j,ii,jj,iproc,itask(4),nn
6445 c write (iout,*) "itask",itask
6448 if (iproc.gt.0) then
6449 do j=1,num_cont_hb(ii)
6451 c write (iout,*) "i",ii," j",jj," jjc",jjc
6453 ncont_sent(iproc)=ncont_sent(iproc)+1
6454 nn=ncont_sent(iproc)
6455 zapas(1,nn,iproc)=ii
6456 zapas(2,nn,iproc)=jjc
6457 zapas(3,nn,iproc)=facont_hb(j,ii)
6458 zapas(4,nn,iproc)=ees0p(j,ii)
6459 zapas(5,nn,iproc)=ees0m(j,ii)
6460 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6461 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6462 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6463 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6464 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6465 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6466 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6467 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6468 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6469 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6470 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6471 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6472 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6473 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6474 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6475 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6476 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6477 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6478 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6479 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6480 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6488 c------------------------------------------------------------------------------
6489 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6491 C This subroutine calculates multi-body contributions to hydrogen-bonding
6492 implicit real*8 (a-h,o-z)
6493 include 'DIMENSIONS'
6494 include 'COMMON.IOUNITS'
6497 parameter (max_cont=maxconts)
6498 parameter (max_dim=70)
6499 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6500 double precision zapas(max_dim,maxconts,max_fg_procs),
6501 & zapas_recv(max_dim,maxconts,max_fg_procs)
6502 common /przechowalnia/ zapas
6503 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6504 & status_array(MPI_STATUS_SIZE,maxconts*2)
6506 include 'COMMON.SETUP'
6507 include 'COMMON.FFIELD'
6508 include 'COMMON.DERIV'
6509 include 'COMMON.LOCAL'
6510 include 'COMMON.INTERACT'
6511 include 'COMMON.CONTACTS'
6512 include 'COMMON.CHAIN'
6513 include 'COMMON.CONTROL'
6514 double precision gx(3),gx1(3)
6515 integer num_cont_hb_old(maxres)
6517 double precision eello4,eello5,eelo6,eello_turn6
6518 external eello4,eello5,eello6,eello_turn6
6519 C Set lprn=.true. for debugging
6524 num_cont_hb_old(i)=num_cont_hb(i)
6528 if (nfgtasks.le.1) goto 30
6530 write (iout,'(a)') 'Contact function values before RECEIVE:'
6532 write (iout,'(2i3,50(1x,i2,f5.2))')
6533 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6534 & j=1,num_cont_hb(i))
6538 do i=1,ntask_cont_from
6541 do i=1,ntask_cont_to
6544 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6546 C Make the list of contacts to send to send to other procesors
6547 do i=iturn3_start,iturn3_end
6548 c write (iout,*) "make contact list turn3",i," num_cont",
6550 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6552 do i=iturn4_start,iturn4_end
6553 c write (iout,*) "make contact list turn4",i," num_cont",
6555 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6559 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6561 do j=1,num_cont_hb(i)
6564 iproc=iint_sent_local(k,jjc,ii)
6565 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6566 if (iproc.ne.0) then
6567 ncont_sent(iproc)=ncont_sent(iproc)+1
6568 nn=ncont_sent(iproc)
6570 zapas(2,nn,iproc)=jjc
6571 zapas(3,nn,iproc)=d_cont(j,i)
6575 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6580 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6588 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6599 & "Numbers of contacts to be sent to other processors",
6600 & (ncont_sent(i),i=1,ntask_cont_to)
6601 write (iout,*) "Contacts sent"
6602 do ii=1,ntask_cont_to
6604 iproc=itask_cont_to(ii)
6605 write (iout,*) nn," contacts to processor",iproc,
6606 & " of CONT_TO_COMM group"
6608 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6616 CorrelID1=nfgtasks+fg_rank+1
6618 C Receive the numbers of needed contacts from other processors
6619 do ii=1,ntask_cont_from
6620 iproc=itask_cont_from(ii)
6622 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6623 & FG_COMM,req(ireq),IERR)
6625 c write (iout,*) "IRECV ended"
6627 C Send the number of contacts needed by other processors
6628 do ii=1,ntask_cont_to
6629 iproc=itask_cont_to(ii)
6631 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6632 & FG_COMM,req(ireq),IERR)
6634 c write (iout,*) "ISEND ended"
6635 c write (iout,*) "number of requests (nn)",ireq
6638 & call MPI_Waitall(ireq,req,status_array,ierr)
6640 c & "Numbers of contacts to be received from other processors",
6641 c & (ncont_recv(i),i=1,ntask_cont_from)
6645 do ii=1,ntask_cont_from
6646 iproc=itask_cont_from(ii)
6648 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6649 c & " of CONT_TO_COMM group"
6653 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6654 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6655 c write (iout,*) "ireq,req",ireq,req(ireq)
6658 C Send the contacts to processors that need them
6659 do ii=1,ntask_cont_to
6660 iproc=itask_cont_to(ii)
6662 c write (iout,*) nn," contacts to processor",iproc,
6663 c & " of CONT_TO_COMM group"
6666 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6667 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6668 c write (iout,*) "ireq,req",ireq,req(ireq)
6670 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6674 c write (iout,*) "number of requests (contacts)",ireq
6675 c write (iout,*) "req",(req(i),i=1,4)
6678 & call MPI_Waitall(ireq,req,status_array,ierr)
6679 do iii=1,ntask_cont_from
6680 iproc=itask_cont_from(iii)
6683 write (iout,*) "Received",nn," contacts from processor",iproc,
6684 & " of CONT_FROM_COMM group"
6687 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6692 ii=zapas_recv(1,i,iii)
6693 c Flag the received contacts to prevent double-counting
6694 jj=-zapas_recv(2,i,iii)
6695 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6697 nnn=num_cont_hb(ii)+1
6700 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6704 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6709 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6717 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6726 write (iout,'(a)') 'Contact function values after receive:'
6728 write (iout,'(2i3,50(1x,i3,5f6.3))')
6729 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6730 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6737 write (iout,'(a)') 'Contact function values:'
6739 write (iout,'(2i3,50(1x,i2,5f6.3))')
6740 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6741 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6747 C Remove the loop below after debugging !!!
6754 C Calculate the dipole-dipole interaction energies
6755 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6756 do i=iatel_s,iatel_e+1
6757 num_conti=num_cont_hb(i)
6766 C Calculate the local-electrostatic correlation terms
6767 c write (iout,*) "gradcorr5 in eello5 before loop"
6769 c write (iout,'(i5,3f10.5)')
6770 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6772 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6773 c write (iout,*) "corr loop i",i
6775 num_conti=num_cont_hb(i)
6776 num_conti1=num_cont_hb(i+1)
6783 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6784 c & ' jj=',jj,' kk=',kk
6785 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6786 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6787 & .or. j.lt.0 .and. j1.gt.0) .and.
6788 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6789 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6790 C The system gains extra energy.
6792 sqd1=dsqrt(d_cont(jj,i))
6793 sqd2=dsqrt(d_cont(kk,i1))
6794 sred_geom = sqd1*sqd2
6795 IF (sred_geom.lt.cutoff_corr) THEN
6796 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6798 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6799 cd & ' jj=',jj,' kk=',kk
6800 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6801 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6803 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6804 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6807 cd write (iout,*) 'sred_geom=',sred_geom,
6808 cd & ' ekont=',ekont,' fprim=',fprimcont,
6809 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6810 cd write (iout,*) "g_contij",g_contij
6811 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6812 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6813 call calc_eello(i,jp,i+1,jp1,jj,kk)
6814 if (wcorr4.gt.0.0d0)
6815 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6816 if (energy_dec.and.wcorr4.gt.0.0d0)
6817 1 write (iout,'(a6,4i5,0pf7.3)')
6818 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6819 c write (iout,*) "gradcorr5 before eello5"
6821 c write (iout,'(i5,3f10.5)')
6822 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6824 if (wcorr5.gt.0.0d0)
6825 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6826 c write (iout,*) "gradcorr5 after eello5"
6828 c write (iout,'(i5,3f10.5)')
6829 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6831 if (energy_dec.and.wcorr5.gt.0.0d0)
6832 1 write (iout,'(a6,4i5,0pf7.3)')
6833 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6834 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6835 cd write(2,*)'ijkl',i,jp,i+1,jp1
6836 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6837 & .or. wturn6.eq.0.0d0))then
6838 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6839 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6840 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6841 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6842 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6843 cd & 'ecorr6=',ecorr6
6844 cd write (iout,'(4e15.5)') sred_geom,
6845 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6846 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6847 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6848 else if (wturn6.gt.0.0d0
6849 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6850 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6851 eturn6=eturn6+eello_turn6(i,jj,kk)
6852 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6853 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6854 cd write (2,*) 'multibody_eello:eturn6',eturn6
6863 num_cont_hb(i)=num_cont_hb_old(i)
6865 c write (iout,*) "gradcorr5 in eello5"
6867 c write (iout,'(i5,3f10.5)')
6868 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6872 c------------------------------------------------------------------------------
6873 subroutine add_hb_contact_eello(ii,jj,itask)
6874 implicit real*8 (a-h,o-z)
6875 include "DIMENSIONS"
6876 include "COMMON.IOUNITS"
6879 parameter (max_cont=maxconts)
6880 parameter (max_dim=70)
6881 include "COMMON.CONTACTS"
6882 double precision zapas(max_dim,maxconts,max_fg_procs),
6883 & zapas_recv(max_dim,maxconts,max_fg_procs)
6884 common /przechowalnia/ zapas
6885 integer i,j,ii,jj,iproc,itask(4),nn
6886 c write (iout,*) "itask",itask
6889 if (iproc.gt.0) then
6890 do j=1,num_cont_hb(ii)
6892 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6894 ncont_sent(iproc)=ncont_sent(iproc)+1
6895 nn=ncont_sent(iproc)
6896 zapas(1,nn,iproc)=ii
6897 zapas(2,nn,iproc)=jjc
6898 zapas(3,nn,iproc)=d_cont(j,ii)
6902 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6907 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6915 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6927 c------------------------------------------------------------------------------
6928 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6929 implicit real*8 (a-h,o-z)
6930 include 'DIMENSIONS'
6931 include 'COMMON.IOUNITS'
6932 include 'COMMON.DERIV'
6933 include 'COMMON.INTERACT'
6934 include 'COMMON.CONTACTS'
6935 double precision gx(3),gx1(3)
6945 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6946 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6947 C Following 4 lines for diagnostics.
6952 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6953 c & 'Contacts ',i,j,
6954 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6955 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6957 C Calculate the multi-body contribution to energy.
6958 c ecorr=ecorr+ekont*ees
6959 C Calculate multi-body contributions to the gradient.
6960 coeffpees0pij=coeffp*ees0pij
6961 coeffmees0mij=coeffm*ees0mij
6962 coeffpees0pkl=coeffp*ees0pkl
6963 coeffmees0mkl=coeffm*ees0mkl
6965 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6966 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6967 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6968 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6969 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6970 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6971 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6972 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6973 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6974 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6975 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6976 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6977 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6978 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6979 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6980 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6981 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6982 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6983 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6984 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6985 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6986 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6987 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6988 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6989 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6994 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6995 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6996 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6997 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7002 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7003 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7004 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7005 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7008 c write (iout,*) "ehbcorr",ekont*ees
7013 C---------------------------------------------------------------------------
7014 subroutine dipole(i,j,jj)
7015 implicit real*8 (a-h,o-z)
7016 include 'DIMENSIONS'
7017 include 'COMMON.IOUNITS'
7018 include 'COMMON.CHAIN'
7019 include 'COMMON.FFIELD'
7020 include 'COMMON.DERIV'
7021 include 'COMMON.INTERACT'
7022 include 'COMMON.CONTACTS'
7023 include 'COMMON.TORSION'
7024 include 'COMMON.VAR'
7025 include 'COMMON.GEO'
7026 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7028 iti1 = itortyp(itype(i+1))
7029 if (j.lt.nres-1) then
7030 itj1 = itortyp(itype(j+1))
7035 dipi(iii,1)=Ub2(iii,i)
7036 dipderi(iii)=Ub2der(iii,i)
7037 dipi(iii,2)=b1(iii,i+1)
7038 dipj(iii,1)=Ub2(iii,j)
7039 dipderj(iii)=Ub2der(iii,j)
7040 dipj(iii,2)=b1(iii,j+1)
7044 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7047 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7054 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7058 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7063 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7064 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7066 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7068 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7070 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7075 C---------------------------------------------------------------------------
7076 subroutine calc_eello(i,j,k,l,jj,kk)
7078 C This subroutine computes matrices and vectors needed to calculate
7079 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7081 implicit real*8 (a-h,o-z)
7082 include 'DIMENSIONS'
7083 include 'COMMON.IOUNITS'
7084 include 'COMMON.CHAIN'
7085 include 'COMMON.DERIV'
7086 include 'COMMON.INTERACT'
7087 include 'COMMON.CONTACTS'
7088 include 'COMMON.TORSION'
7089 include 'COMMON.VAR'
7090 include 'COMMON.GEO'
7091 include 'COMMON.FFIELD'
7092 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7093 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7096 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7097 cd & ' jj=',jj,' kk=',kk
7098 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7099 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7100 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7103 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7104 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7107 call transpose2(aa1(1,1),aa1t(1,1))
7108 call transpose2(aa2(1,1),aa2t(1,1))
7111 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7112 & aa1tder(1,1,lll,kkk))
7113 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7114 & aa2tder(1,1,lll,kkk))
7118 C parallel orientation of the two CA-CA-CA frames.
7120 iti=itortyp(itype(i))
7124 itk1=itortyp(itype(k+1))
7125 itj=itortyp(itype(j))
7126 if (l.lt.nres-1) then
7127 itl1=itortyp(itype(l+1))
7131 C A1 kernel(j+1) A2T
7133 cd write (iout,'(3f10.5,5x,3f10.5)')
7134 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7136 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7137 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7138 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7139 C Following matrices are needed only for 6-th order cumulants
7140 IF (wcorr6.gt.0.0d0) THEN
7141 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7142 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7143 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7144 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7145 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7146 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7147 & ADtEAderx(1,1,1,1,1,1))
7149 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7150 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7151 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7152 & ADtEA1derx(1,1,1,1,1,1))
7154 C End 6-th order cumulants
7157 cd write (2,*) 'In calc_eello6'
7159 cd write (2,*) 'iii=',iii
7161 cd write (2,*) 'kkk=',kkk
7163 cd write (2,'(3(2f10.5),5x)')
7164 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7169 call transpose2(EUgder(1,1,k),auxmat(1,1))
7170 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7171 call transpose2(EUg(1,1,k),auxmat(1,1))
7172 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7173 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7177 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7178 & EAEAderx(1,1,lll,kkk,iii,1))
7182 C A1T kernel(i+1) A2
7183 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7184 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7185 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7186 C Following matrices are needed only for 6-th order cumulants
7187 IF (wcorr6.gt.0.0d0) THEN
7188 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7189 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7190 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7191 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7192 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7193 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7194 & ADtEAderx(1,1,1,1,1,2))
7195 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7196 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7197 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7198 & ADtEA1derx(1,1,1,1,1,2))
7200 C End 6-th order cumulants
7201 call transpose2(EUgder(1,1,l),auxmat(1,1))
7202 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7203 call transpose2(EUg(1,1,l),auxmat(1,1))
7204 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7205 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7209 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7210 & EAEAderx(1,1,lll,kkk,iii,2))
7215 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7216 C They are needed only when the fifth- or the sixth-order cumulants are
7218 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7219 call transpose2(AEA(1,1,1),auxmat(1,1))
7220 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7221 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7222 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7223 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7224 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7225 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7226 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7227 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7228 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7229 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7230 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7231 call transpose2(AEA(1,1,2),auxmat(1,1))
7232 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
7233 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7234 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7235 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7236 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
7237 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7238 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
7239 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
7240 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7241 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7242 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7243 C Calculate the Cartesian derivatives of the vectors.
7247 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7248 call matvec2(auxmat(1,1),b1(1,i),
7249 & AEAb1derx(1,lll,kkk,iii,1,1))
7250 call matvec2(auxmat(1,1),Ub2(1,i),
7251 & AEAb2derx(1,lll,kkk,iii,1,1))
7252 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7253 & AEAb1derx(1,lll,kkk,iii,2,1))
7254 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7255 & AEAb2derx(1,lll,kkk,iii,2,1))
7256 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7257 call matvec2(auxmat(1,1),b1(1,j),
7258 & AEAb1derx(1,lll,kkk,iii,1,2))
7259 call matvec2(auxmat(1,1),Ub2(1,j),
7260 & AEAb2derx(1,lll,kkk,iii,1,2))
7261 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
7262 & AEAb1derx(1,lll,kkk,iii,2,2))
7263 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7264 & AEAb2derx(1,lll,kkk,iii,2,2))
7271 C Antiparallel orientation of the two CA-CA-CA frames.
7273 iti=itortyp(itype(i))
7277 itk1=itortyp(itype(k+1))
7278 itl=itortyp(itype(l))
7279 itj=itortyp(itype(j))
7280 if (j.lt.nres-1) then
7281 itj1=itortyp(itype(j+1))
7285 C A2 kernel(j-1)T A1T
7286 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7287 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7288 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7289 C Following matrices are needed only for 6-th order cumulants
7290 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7291 & j.eq.i+4 .and. l.eq.i+3)) THEN
7292 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7293 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7294 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7295 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7296 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7297 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7298 & ADtEAderx(1,1,1,1,1,1))
7299 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7300 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7301 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7302 & ADtEA1derx(1,1,1,1,1,1))
7304 C End 6-th order cumulants
7305 call transpose2(EUgder(1,1,k),auxmat(1,1))
7306 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7307 call transpose2(EUg(1,1,k),auxmat(1,1))
7308 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7309 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7313 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7314 & EAEAderx(1,1,lll,kkk,iii,1))
7318 C A2T kernel(i+1)T A1
7319 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7320 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7321 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7322 C Following matrices are needed only for 6-th order cumulants
7323 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7324 & j.eq.i+4 .and. l.eq.i+3)) THEN
7325 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7326 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7327 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7328 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7329 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7330 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7331 & ADtEAderx(1,1,1,1,1,2))
7332 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7333 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7334 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7335 & ADtEA1derx(1,1,1,1,1,2))
7337 C End 6-th order cumulants
7338 call transpose2(EUgder(1,1,j),auxmat(1,1))
7339 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7340 call transpose2(EUg(1,1,j),auxmat(1,1))
7341 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7342 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7346 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7347 & EAEAderx(1,1,lll,kkk,iii,2))
7352 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7353 C They are needed only when the fifth- or the sixth-order cumulants are
7355 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7356 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7357 call transpose2(AEA(1,1,1),auxmat(1,1))
7358 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
7359 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7360 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7361 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7362 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
7363 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7364 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
7365 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
7366 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7367 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7368 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7369 call transpose2(AEA(1,1,2),auxmat(1,1))
7370 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
7371 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7372 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7373 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7374 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
7375 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7376 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
7377 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
7378 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7379 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7380 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7381 C Calculate the Cartesian derivatives of the vectors.
7385 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7386 call matvec2(auxmat(1,1),b1(1,i),
7387 & AEAb1derx(1,lll,kkk,iii,1,1))
7388 call matvec2(auxmat(1,1),Ub2(1,i),
7389 & AEAb2derx(1,lll,kkk,iii,1,1))
7390 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
7391 & AEAb1derx(1,lll,kkk,iii,2,1))
7392 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7393 & AEAb2derx(1,lll,kkk,iii,2,1))
7394 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7395 call matvec2(auxmat(1,1),b1(1,l),
7396 & AEAb1derx(1,lll,kkk,iii,1,2))
7397 call matvec2(auxmat(1,1),Ub2(1,l),
7398 & AEAb2derx(1,lll,kkk,iii,1,2))
7399 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
7400 & AEAb1derx(1,lll,kkk,iii,2,2))
7401 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7402 & AEAb2derx(1,lll,kkk,iii,2,2))
7411 C---------------------------------------------------------------------------
7412 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7413 & KK,KKderg,AKA,AKAderg,AKAderx)
7417 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7418 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7419 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7424 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7426 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7429 cd if (lprn) write (2,*) 'In kernel'
7431 cd if (lprn) write (2,*) 'kkk=',kkk
7433 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7434 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7436 cd write (2,*) 'lll=',lll
7437 cd write (2,*) 'iii=1'
7439 cd write (2,'(3(2f10.5),5x)')
7440 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7443 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7444 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7446 cd write (2,*) 'lll=',lll
7447 cd write (2,*) 'iii=2'
7449 cd write (2,'(3(2f10.5),5x)')
7450 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7457 C---------------------------------------------------------------------------
7458 double precision function eello4(i,j,k,l,jj,kk)
7459 implicit real*8 (a-h,o-z)
7460 include 'DIMENSIONS'
7461 include 'COMMON.IOUNITS'
7462 include 'COMMON.CHAIN'
7463 include 'COMMON.DERIV'
7464 include 'COMMON.INTERACT'
7465 include 'COMMON.CONTACTS'
7466 include 'COMMON.TORSION'
7467 include 'COMMON.VAR'
7468 include 'COMMON.GEO'
7469 double precision pizda(2,2),ggg1(3),ggg2(3)
7470 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7474 cd print *,'eello4:',i,j,k,l,jj,kk
7475 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7476 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7477 cold eij=facont_hb(jj,i)
7478 cold ekl=facont_hb(kk,k)
7480 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7481 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7482 gcorr_loc(k-1)=gcorr_loc(k-1)
7483 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7485 gcorr_loc(l-1)=gcorr_loc(l-1)
7486 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7488 gcorr_loc(j-1)=gcorr_loc(j-1)
7489 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7494 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7495 & -EAEAderx(2,2,lll,kkk,iii,1)
7496 cd derx(lll,kkk,iii)=0.0d0
7500 cd gcorr_loc(l-1)=0.0d0
7501 cd gcorr_loc(j-1)=0.0d0
7502 cd gcorr_loc(k-1)=0.0d0
7504 cd write (iout,*)'Contacts have occurred for peptide groups',
7505 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7506 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7507 if (j.lt.nres-1) then
7514 if (l.lt.nres-1) then
7522 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7523 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7524 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7525 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7526 cgrad ghalf=0.5d0*ggg1(ll)
7527 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7528 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7529 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7530 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7531 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7532 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7533 cgrad ghalf=0.5d0*ggg2(ll)
7534 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7535 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7536 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7537 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7538 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7539 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7543 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7548 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7553 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7558 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7562 cd write (2,*) iii,gcorr_loc(iii)
7565 cd write (2,*) 'ekont',ekont
7566 cd write (iout,*) 'eello4',ekont*eel4
7569 C---------------------------------------------------------------------------
7570 double precision function eello5(i,j,k,l,jj,kk)
7571 implicit real*8 (a-h,o-z)
7572 include 'DIMENSIONS'
7573 include 'COMMON.IOUNITS'
7574 include 'COMMON.CHAIN'
7575 include 'COMMON.DERIV'
7576 include 'COMMON.INTERACT'
7577 include 'COMMON.CONTACTS'
7578 include 'COMMON.TORSION'
7579 include 'COMMON.VAR'
7580 include 'COMMON.GEO'
7581 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7582 double precision ggg1(3),ggg2(3)
7583 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7588 C /l\ / \ \ / \ / \ / C
7589 C / \ / \ \ / \ / \ / C
7590 C j| o |l1 | o | o| o | | o |o C
7591 C \ |/k\| |/ \| / |/ \| |/ \| C
7592 C \i/ \ / \ / / \ / \ C
7594 C (I) (II) (III) (IV) C
7596 C eello5_1 eello5_2 eello5_3 eello5_4 C
7598 C Antiparallel chains C
7601 C /j\ / \ \ / \ / \ / C
7602 C / \ / \ \ / \ / \ / C
7603 C j1| o |l | o | o| o | | o |o C
7604 C \ |/k\| |/ \| / |/ \| |/ \| C
7605 C \i/ \ / \ / / \ / \ C
7607 C (I) (II) (III) (IV) C
7609 C eello5_1 eello5_2 eello5_3 eello5_4 C
7611 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7613 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7614 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7619 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7621 itk=itortyp(itype(k))
7622 itl=itortyp(itype(l))
7623 itj=itortyp(itype(j))
7628 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7629 cd & eel5_3_num,eel5_4_num)
7633 derx(lll,kkk,iii)=0.0d0
7637 cd eij=facont_hb(jj,i)
7638 cd ekl=facont_hb(kk,k)
7640 cd write (iout,*)'Contacts have occurred for peptide groups',
7641 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7643 C Contribution from the graph I.
7644 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7645 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7646 call transpose2(EUg(1,1,k),auxmat(1,1))
7647 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7648 vv(1)=pizda(1,1)-pizda(2,2)
7649 vv(2)=pizda(1,2)+pizda(2,1)
7650 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7651 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7652 C Explicit gradient in virtual-dihedral angles.
7653 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7654 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7655 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7656 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7657 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7658 vv(1)=pizda(1,1)-pizda(2,2)
7659 vv(2)=pizda(1,2)+pizda(2,1)
7660 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7661 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7662 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7663 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7664 vv(1)=pizda(1,1)-pizda(2,2)
7665 vv(2)=pizda(1,2)+pizda(2,1)
7667 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7668 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7669 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7671 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7672 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7673 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7675 C Cartesian gradient
7679 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7681 vv(1)=pizda(1,1)-pizda(2,2)
7682 vv(2)=pizda(1,2)+pizda(2,1)
7683 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7684 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7685 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7691 C Contribution from graph II
7692 call transpose2(EE(1,1,itk),auxmat(1,1))
7693 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7694 vv(1)=pizda(1,1)+pizda(2,2)
7695 vv(2)=pizda(2,1)-pizda(1,2)
7696 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
7697 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7698 C Explicit gradient in virtual-dihedral angles.
7699 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7700 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7701 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7702 vv(1)=pizda(1,1)+pizda(2,2)
7703 vv(2)=pizda(2,1)-pizda(1,2)
7705 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7706 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
7707 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7709 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7710 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
7711 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7713 C Cartesian gradient
7717 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7719 vv(1)=pizda(1,1)+pizda(2,2)
7720 vv(2)=pizda(2,1)-pizda(1,2)
7721 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7722 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
7723 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7731 C Parallel orientation
7732 C Contribution from graph III
7733 call transpose2(EUg(1,1,l),auxmat(1,1))
7734 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7735 vv(1)=pizda(1,1)-pizda(2,2)
7736 vv(2)=pizda(1,2)+pizda(2,1)
7737 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7738 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7739 C Explicit gradient in virtual-dihedral angles.
7740 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7741 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7742 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7743 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7744 vv(1)=pizda(1,1)-pizda(2,2)
7745 vv(2)=pizda(1,2)+pizda(2,1)
7746 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7747 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7748 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7749 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7750 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7751 vv(1)=pizda(1,1)-pizda(2,2)
7752 vv(2)=pizda(1,2)+pizda(2,1)
7753 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7754 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7755 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7756 C Cartesian gradient
7760 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7762 vv(1)=pizda(1,1)-pizda(2,2)
7763 vv(2)=pizda(1,2)+pizda(2,1)
7764 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7765 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7766 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7771 C Contribution from graph IV
7773 call transpose2(EE(1,1,itl),auxmat(1,1))
7774 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7775 vv(1)=pizda(1,1)+pizda(2,2)
7776 vv(2)=pizda(2,1)-pizda(1,2)
7777 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
7778 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7779 C Explicit gradient in virtual-dihedral angles.
7780 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7781 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7782 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7783 vv(1)=pizda(1,1)+pizda(2,2)
7784 vv(2)=pizda(2,1)-pizda(1,2)
7785 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7786 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
7787 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7788 C Cartesian gradient
7792 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7794 vv(1)=pizda(1,1)+pizda(2,2)
7795 vv(2)=pizda(2,1)-pizda(1,2)
7796 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7797 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
7798 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7803 C Antiparallel orientation
7804 C Contribution from graph III
7806 call transpose2(EUg(1,1,j),auxmat(1,1))
7807 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7808 vv(1)=pizda(1,1)-pizda(2,2)
7809 vv(2)=pizda(1,2)+pizda(2,1)
7810 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7811 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7812 C Explicit gradient in virtual-dihedral angles.
7813 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7814 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7815 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7816 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7817 vv(1)=pizda(1,1)-pizda(2,2)
7818 vv(2)=pizda(1,2)+pizda(2,1)
7819 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7820 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7821 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7822 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7823 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7824 vv(1)=pizda(1,1)-pizda(2,2)
7825 vv(2)=pizda(1,2)+pizda(2,1)
7826 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7827 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7828 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7829 C Cartesian gradient
7833 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7835 vv(1)=pizda(1,1)-pizda(2,2)
7836 vv(2)=pizda(1,2)+pizda(2,1)
7837 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7838 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7839 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7844 C Contribution from graph IV
7846 call transpose2(EE(1,1,itj),auxmat(1,1))
7847 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7848 vv(1)=pizda(1,1)+pizda(2,2)
7849 vv(2)=pizda(2,1)-pizda(1,2)
7850 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
7851 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7852 C Explicit gradient in virtual-dihedral angles.
7853 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7854 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7855 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7856 vv(1)=pizda(1,1)+pizda(2,2)
7857 vv(2)=pizda(2,1)-pizda(1,2)
7858 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7859 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
7860 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7861 C Cartesian gradient
7865 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7867 vv(1)=pizda(1,1)+pizda(2,2)
7868 vv(2)=pizda(2,1)-pizda(1,2)
7869 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7870 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
7871 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7877 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7878 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7879 cd write (2,*) 'ijkl',i,j,k,l
7880 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7881 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7883 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7884 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7885 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7886 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7887 if (j.lt.nres-1) then
7894 if (l.lt.nres-1) then
7904 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7905 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7906 C summed up outside the subrouine as for the other subroutines
7907 C handling long-range interactions. The old code is commented out
7908 C with "cgrad" to keep track of changes.
7910 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7911 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7912 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7913 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7914 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7915 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7916 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7917 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7918 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7919 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7921 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7922 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7923 cgrad ghalf=0.5d0*ggg1(ll)
7925 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7926 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7927 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7928 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7929 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7930 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7931 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7932 cgrad ghalf=0.5d0*ggg2(ll)
7934 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7935 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7936 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7937 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7938 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7939 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7944 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7945 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7950 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7951 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7957 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7962 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7966 cd write (2,*) iii,g_corr5_loc(iii)
7969 cd write (2,*) 'ekont',ekont
7970 cd write (iout,*) 'eello5',ekont*eel5
7973 c--------------------------------------------------------------------------
7974 double precision function eello6(i,j,k,l,jj,kk)
7975 implicit real*8 (a-h,o-z)
7976 include 'DIMENSIONS'
7977 include 'COMMON.IOUNITS'
7978 include 'COMMON.CHAIN'
7979 include 'COMMON.DERIV'
7980 include 'COMMON.INTERACT'
7981 include 'COMMON.CONTACTS'
7982 include 'COMMON.TORSION'
7983 include 'COMMON.VAR'
7984 include 'COMMON.GEO'
7985 include 'COMMON.FFIELD'
7986 double precision ggg1(3),ggg2(3)
7987 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7992 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8000 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8001 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8005 derx(lll,kkk,iii)=0.0d0
8009 cd eij=facont_hb(jj,i)
8010 cd ekl=facont_hb(kk,k)
8016 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8017 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8018 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8019 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8020 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8021 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8023 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8024 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8025 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8026 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8027 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8028 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8032 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8034 C If turn contributions are considered, they will be handled separately.
8035 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8036 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8037 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8038 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8039 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8040 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8041 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8043 if (j.lt.nres-1) then
8050 if (l.lt.nres-1) then
8058 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8059 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8060 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8061 cgrad ghalf=0.5d0*ggg1(ll)
8063 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8064 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8065 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8066 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8067 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8068 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8069 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8070 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8071 cgrad ghalf=0.5d0*ggg2(ll)
8072 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8074 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8075 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8076 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8077 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8078 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8079 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8084 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8085 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8090 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8091 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8097 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8102 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8106 cd write (2,*) iii,g_corr6_loc(iii)
8109 cd write (2,*) 'ekont',ekont
8110 cd write (iout,*) 'eello6',ekont*eel6
8113 c--------------------------------------------------------------------------
8114 double precision function eello6_graph1(i,j,k,l,imat,swap)
8115 implicit real*8 (a-h,o-z)
8116 include 'DIMENSIONS'
8117 include 'COMMON.IOUNITS'
8118 include 'COMMON.CHAIN'
8119 include 'COMMON.DERIV'
8120 include 'COMMON.INTERACT'
8121 include 'COMMON.CONTACTS'
8122 include 'COMMON.TORSION'
8123 include 'COMMON.VAR'
8124 include 'COMMON.GEO'
8125 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8129 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8131 C Parallel Antiparallel C
8137 C \ j|/k\| / \ |/k\|l / C
8142 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8143 itk=itortyp(itype(k))
8144 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8145 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8146 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8147 call transpose2(EUgC(1,1,k),auxmat(1,1))
8148 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8149 vv1(1)=pizda1(1,1)-pizda1(2,2)
8150 vv1(2)=pizda1(1,2)+pizda1(2,1)
8151 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8152 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
8153 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
8154 s5=scalar2(vv(1),Dtobr2(1,i))
8155 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8156 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8157 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8158 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8159 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8160 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8161 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8162 & +scalar2(vv(1),Dtobr2der(1,i)))
8163 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8164 vv1(1)=pizda1(1,1)-pizda1(2,2)
8165 vv1(2)=pizda1(1,2)+pizda1(2,1)
8166 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
8167 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
8169 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8170 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8171 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8172 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8173 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8175 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8176 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8177 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8178 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8179 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8181 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8182 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8183 vv1(1)=pizda1(1,1)-pizda1(2,2)
8184 vv1(2)=pizda1(1,2)+pizda1(2,1)
8185 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8186 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8187 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8188 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8197 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8198 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8199 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8200 call transpose2(EUgC(1,1,k),auxmat(1,1))
8201 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8203 vv1(1)=pizda1(1,1)-pizda1(2,2)
8204 vv1(2)=pizda1(1,2)+pizda1(2,1)
8205 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8206 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
8207 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
8208 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
8209 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
8210 s5=scalar2(vv(1),Dtobr2(1,i))
8211 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8217 c----------------------------------------------------------------------------
8218 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8219 implicit real*8 (a-h,o-z)
8220 include 'DIMENSIONS'
8221 include 'COMMON.IOUNITS'
8222 include 'COMMON.CHAIN'
8223 include 'COMMON.DERIV'
8224 include 'COMMON.INTERACT'
8225 include 'COMMON.CONTACTS'
8226 include 'COMMON.TORSION'
8227 include 'COMMON.VAR'
8228 include 'COMMON.GEO'
8230 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8231 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8234 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8236 C Parallel Antiparallel C
8242 C \ j|/k\| \ |/k\|l C
8247 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8248 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8249 C AL 7/4/01 s1 would occur in the sixth-order moment,
8250 C but not in a cluster cumulant
8252 s1=dip(1,jj,i)*dip(1,kk,k)
8254 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8255 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8256 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8257 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8258 call transpose2(EUg(1,1,k),auxmat(1,1))
8259 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8260 vv(1)=pizda(1,1)-pizda(2,2)
8261 vv(2)=pizda(1,2)+pizda(2,1)
8262 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8263 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8265 eello6_graph2=-(s1+s2+s3+s4)
8267 eello6_graph2=-(s2+s3+s4)
8270 C Derivatives in gamma(i-1)
8273 s1=dipderg(1,jj,i)*dip(1,kk,k)
8275 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8276 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8277 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8278 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8280 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8282 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8284 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8286 C Derivatives in gamma(k-1)
8288 s1=dip(1,jj,i)*dipderg(1,kk,k)
8290 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8291 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8292 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8293 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8294 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8295 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8296 vv(1)=pizda(1,1)-pizda(2,2)
8297 vv(2)=pizda(1,2)+pizda(2,1)
8298 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8300 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8302 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8304 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8305 C Derivatives in gamma(j-1) or gamma(l-1)
8308 s1=dipderg(3,jj,i)*dip(1,kk,k)
8310 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8311 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8312 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8313 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8314 vv(1)=pizda(1,1)-pizda(2,2)
8315 vv(2)=pizda(1,2)+pizda(2,1)
8316 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8319 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8321 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8324 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8325 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8327 C Derivatives in gamma(l-1) or gamma(j-1)
8330 s1=dip(1,jj,i)*dipderg(3,kk,k)
8332 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8333 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8334 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8335 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8336 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8337 vv(1)=pizda(1,1)-pizda(2,2)
8338 vv(2)=pizda(1,2)+pizda(2,1)
8339 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8342 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8344 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8347 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8348 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8350 C Cartesian derivatives.
8352 write (2,*) 'In eello6_graph2'
8354 write (2,*) 'iii=',iii
8356 write (2,*) 'kkk=',kkk
8358 write (2,'(3(2f10.5),5x)')
8359 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8369 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8371 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8374 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8376 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8377 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8379 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8380 call transpose2(EUg(1,1,k),auxmat(1,1))
8381 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8383 vv(1)=pizda(1,1)-pizda(2,2)
8384 vv(2)=pizda(1,2)+pizda(2,1)
8385 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8386 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8388 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8390 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8393 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8395 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8402 c----------------------------------------------------------------------------
8403 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8404 implicit real*8 (a-h,o-z)
8405 include 'DIMENSIONS'
8406 include 'COMMON.IOUNITS'
8407 include 'COMMON.CHAIN'
8408 include 'COMMON.DERIV'
8409 include 'COMMON.INTERACT'
8410 include 'COMMON.CONTACTS'
8411 include 'COMMON.TORSION'
8412 include 'COMMON.VAR'
8413 include 'COMMON.GEO'
8414 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8416 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8418 C Parallel Antiparallel C
8424 C j|/k\| / |/k\|l / C
8429 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8431 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8432 C energy moment and not to the cluster cumulant.
8433 iti=itortyp(itype(i))
8434 if (j.lt.nres-1) then
8435 itj1=itortyp(itype(j+1))
8439 itk=itortyp(itype(k))
8440 itk1=itortyp(itype(k+1))
8441 if (l.lt.nres-1) then
8442 itl1=itortyp(itype(l+1))
8447 s1=dip(4,jj,i)*dip(4,kk,k)
8449 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
8450 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8451 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
8452 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8453 call transpose2(EE(1,1,itk),auxmat(1,1))
8454 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8455 vv(1)=pizda(1,1)+pizda(2,2)
8456 vv(2)=pizda(2,1)-pizda(1,2)
8457 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8458 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8459 cd & "sum",-(s2+s3+s4)
8461 eello6_graph3=-(s1+s2+s3+s4)
8463 eello6_graph3=-(s2+s3+s4)
8466 C Derivatives in gamma(k-1)
8467 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
8468 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8469 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8470 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8471 C Derivatives in gamma(l-1)
8472 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
8473 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8474 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8475 vv(1)=pizda(1,1)+pizda(2,2)
8476 vv(2)=pizda(2,1)-pizda(1,2)
8477 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8478 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8479 C Cartesian derivatives.
8485 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8487 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8490 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8492 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
8493 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8495 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
8496 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8498 vv(1)=pizda(1,1)+pizda(2,2)
8499 vv(2)=pizda(2,1)-pizda(1,2)
8500 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8502 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8504 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8507 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8509 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8511 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8517 c----------------------------------------------------------------------------
8518 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8519 implicit real*8 (a-h,o-z)
8520 include 'DIMENSIONS'
8521 include 'COMMON.IOUNITS'
8522 include 'COMMON.CHAIN'
8523 include 'COMMON.DERIV'
8524 include 'COMMON.INTERACT'
8525 include 'COMMON.CONTACTS'
8526 include 'COMMON.TORSION'
8527 include 'COMMON.VAR'
8528 include 'COMMON.GEO'
8529 include 'COMMON.FFIELD'
8530 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8531 & auxvec1(2),auxmat1(2,2)
8533 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8535 C Parallel Antiparallel C
8541 C \ j|/k\| \ |/k\|l C
8546 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8548 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8549 C energy moment and not to the cluster cumulant.
8550 cd write (2,*) 'eello_graph4: wturn6',wturn6
8551 iti=itortyp(itype(i))
8552 itj=itortyp(itype(j))
8553 if (j.lt.nres-1) then
8554 itj1=itortyp(itype(j+1))
8558 itk=itortyp(itype(k))
8559 if (k.lt.nres-1) then
8560 itk1=itortyp(itype(k+1))
8564 itl=itortyp(itype(l))
8565 if (l.lt.nres-1) then
8566 itl1=itortyp(itype(l+1))
8570 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8571 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8572 cd & ' itl',itl,' itl1',itl1
8575 s1=dip(3,jj,i)*dip(3,kk,k)
8577 s1=dip(2,jj,j)*dip(2,kk,l)
8580 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8581 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8583 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
8584 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8586 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
8587 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8589 call transpose2(EUg(1,1,k),auxmat(1,1))
8590 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8591 vv(1)=pizda(1,1)-pizda(2,2)
8592 vv(2)=pizda(2,1)+pizda(1,2)
8593 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8594 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8596 eello6_graph4=-(s1+s2+s3+s4)
8598 eello6_graph4=-(s2+s3+s4)
8600 C Derivatives in gamma(i-1)
8604 s1=dipderg(2,jj,i)*dip(3,kk,k)
8606 s1=dipderg(4,jj,j)*dip(2,kk,l)
8609 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8611 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
8612 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8614 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
8615 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8617 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8618 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8619 cd write (2,*) 'turn6 derivatives'
8621 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8623 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8627 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8629 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8633 C Derivatives in gamma(k-1)
8636 s1=dip(3,jj,i)*dipderg(2,kk,k)
8638 s1=dip(2,jj,j)*dipderg(4,kk,l)
8641 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8642 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8644 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
8645 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
8647 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
8648 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
8650 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8651 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8652 vv(1)=pizda(1,1)-pizda(2,2)
8653 vv(2)=pizda(2,1)+pizda(1,2)
8654 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8655 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8657 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8659 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8663 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8665 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8668 C Derivatives in gamma(j-1) or gamma(l-1)
8669 if (l.eq.j+1 .and. l.gt.1) then
8670 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8671 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8672 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8673 vv(1)=pizda(1,1)-pizda(2,2)
8674 vv(2)=pizda(2,1)+pizda(1,2)
8675 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8676 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8677 else if (j.gt.1) then
8678 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8679 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8680 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8681 vv(1)=pizda(1,1)-pizda(2,2)
8682 vv(2)=pizda(2,1)+pizda(1,2)
8683 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8684 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8685 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8687 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8690 C Cartesian derivatives.
8697 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8699 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8703 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8705 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8709 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8711 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8713 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8714 & b1(1,j+1),auxvec(1))
8715 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
8717 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8718 & b1(1,l+1),auxvec(1))
8719 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
8721 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8723 vv(1)=pizda(1,1)-pizda(2,2)
8724 vv(2)=pizda(2,1)+pizda(1,2)
8725 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8727 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8729 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8732 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8735 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8738 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8740 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8742 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8746 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8748 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8751 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8753 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8761 c----------------------------------------------------------------------------
8762 double precision function eello_turn6(i,jj,kk)
8763 implicit real*8 (a-h,o-z)
8764 include 'DIMENSIONS'
8765 include 'COMMON.IOUNITS'
8766 include 'COMMON.CHAIN'
8767 include 'COMMON.DERIV'
8768 include 'COMMON.INTERACT'
8769 include 'COMMON.CONTACTS'
8770 include 'COMMON.TORSION'
8771 include 'COMMON.VAR'
8772 include 'COMMON.GEO'
8773 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8774 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8776 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8777 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8778 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8779 C the respective energy moment and not to the cluster cumulant.
8788 iti=itortyp(itype(i))
8789 itk=itortyp(itype(k))
8790 itk1=itortyp(itype(k+1))
8791 itl=itortyp(itype(l))
8792 itj=itortyp(itype(j))
8793 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8794 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8795 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8800 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8802 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8806 derx_turn(lll,kkk,iii)=0.0d0
8813 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8815 cd write (2,*) 'eello6_5',eello6_5
8817 call transpose2(AEA(1,1,1),auxmat(1,1))
8818 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8819 ss1=scalar2(Ub2(1,i+2),b1(1,l))
8820 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8822 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
8823 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8824 s2 = scalar2(b1(1,k),vtemp1(1))
8826 call transpose2(AEA(1,1,2),atemp(1,1))
8827 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8828 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8829 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8831 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8832 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8833 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8835 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8836 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8837 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8838 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8839 ss13 = scalar2(b1(1,k),vtemp4(1))
8840 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8842 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8848 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8849 C Derivatives in gamma(i+2)
8853 call transpose2(AEA(1,1,1),auxmatd(1,1))
8854 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8855 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8856 call transpose2(AEAderg(1,1,2),atempd(1,1))
8857 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8858 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8860 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8861 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8862 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8868 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8869 C Derivatives in gamma(i+3)
8871 call transpose2(AEA(1,1,1),auxmatd(1,1))
8872 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8873 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
8874 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8876 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
8877 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8878 s2d = scalar2(b1(1,k),vtemp1d(1))
8880 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8881 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8883 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8885 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8886 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8887 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8895 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8896 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8898 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8899 & -0.5d0*ekont*(s2d+s12d)
8901 C Derivatives in gamma(i+4)
8902 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8903 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8904 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8906 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8907 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8908 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8916 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8918 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8920 C Derivatives in gamma(i+5)
8922 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8923 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8924 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8926 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
8927 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8928 s2d = scalar2(b1(1,k),vtemp1d(1))
8930 call transpose2(AEA(1,1,2),atempd(1,1))
8931 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8932 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8934 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8935 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8937 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8938 ss13d = scalar2(b1(1,k),vtemp4d(1))
8939 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8947 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8948 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8950 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8951 & -0.5d0*ekont*(s2d+s12d)
8953 C Cartesian derivatives
8958 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8959 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8960 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8962 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
8963 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8965 s2d = scalar2(b1(1,k),vtemp1d(1))
8967 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8968 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8969 s8d = -(atempd(1,1)+atempd(2,2))*
8970 & scalar2(cc(1,1,itl),vtemp2(1))
8972 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8974 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8975 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8982 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8985 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8989 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8990 & - 0.5d0*(s8d+s12d)
8992 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9001 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9003 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9004 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9005 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9006 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9007 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9009 ss13d = scalar2(b1(1,k),vtemp4d(1))
9010 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9011 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9015 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9016 cd & 16*eel_turn6_num
9018 if (j.lt.nres-1) then
9025 if (l.lt.nres-1) then
9033 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9034 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9035 cgrad ghalf=0.5d0*ggg1(ll)
9037 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9038 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9039 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9040 & +ekont*derx_turn(ll,2,1)
9041 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9042 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9043 & +ekont*derx_turn(ll,4,1)
9044 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9045 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9046 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9047 cgrad ghalf=0.5d0*ggg2(ll)
9049 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9050 & +ekont*derx_turn(ll,2,2)
9051 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9052 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9053 & +ekont*derx_turn(ll,4,2)
9054 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9055 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9056 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9061 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9066 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9072 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9077 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9081 cd write (2,*) iii,g_corr6_loc(iii)
9083 eello_turn6=ekont*eel_turn6
9084 cd write (2,*) 'ekont',ekont
9085 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9089 C-----------------------------------------------------------------------------
9090 double precision function scalar(u,v)
9091 !DIR$ INLINEALWAYS scalar
9093 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9096 double precision u(3),v(3)
9097 cd double precision sc
9105 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9108 crc-------------------------------------------------
9109 SUBROUTINE MATVEC2(A1,V1,V2)
9110 !DIR$ INLINEALWAYS MATVEC2
9112 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9114 implicit real*8 (a-h,o-z)
9115 include 'DIMENSIONS'
9116 DIMENSION A1(2,2),V1(2),V2(2)
9120 c 3 VI=VI+A1(I,K)*V1(K)
9124 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9125 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9130 C---------------------------------------
9131 SUBROUTINE MATMAT2(A1,A2,A3)
9133 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9135 implicit real*8 (a-h,o-z)
9136 include 'DIMENSIONS'
9137 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9138 c DIMENSION AI3(2,2)
9142 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9148 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9149 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9150 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9151 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9159 c-------------------------------------------------------------------------
9160 double precision function scalar2(u,v)
9161 !DIR$ INLINEALWAYS scalar2
9163 double precision u(2),v(2)
9166 scalar2=u(1)*v(1)+u(2)*v(2)
9170 C-----------------------------------------------------------------------------
9172 subroutine transpose2(a,at)
9173 !DIR$ INLINEALWAYS transpose2
9175 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9178 double precision a(2,2),at(2,2)
9185 c--------------------------------------------------------------------------
9186 subroutine transpose(n,a,at)
9189 double precision a(n,n),at(n,n)
9197 C---------------------------------------------------------------------------
9198 subroutine prodmat3(a1,a2,kk,transp,prod)
9199 !DIR$ INLINEALWAYS prodmat3
9201 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9205 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9207 crc double precision auxmat(2,2),prod_(2,2)
9210 crc call transpose2(kk(1,1),auxmat(1,1))
9211 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9212 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9214 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9215 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9216 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9217 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9218 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9219 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9220 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9221 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9224 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9225 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9227 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9228 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9229 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9230 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9231 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9232 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9233 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9234 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9237 c call transpose2(a2(1,1),a2t(1,1))
9240 crc print *,((prod_(i,j),i=1,2),j=1,2)
9241 crc print *,((prod(i,j),i=1,2),j=1,2)