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.
58 C FG Master broadcasts the WEIGHTS_ array
59 call MPI_Bcast(weights_(1),n_ene,
60 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
62 C FG slaves receive the WEIGHTS array
63 call MPI_Bcast(weights(1),n_ene,
64 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
86 time_Bcast=time_Bcast+MPI_Wtime()-time00
87 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
88 c call chainbuild_cart
90 c print *,'Processor',myrank,' calling etotal ipot=',ipot
91 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
93 c if (modecalc.eq.12.or.modecalc.eq.14) then
94 c call int_from_cart1(.false.)
101 C Compute the side-chain and electrostatic interaction energy
103 goto (101,102,103,104,105,106) ipot
104 C Lennard-Jones potential.
105 101 call elj(evdw,evdw_p,evdw_m)
106 cd print '(a)','Exit ELJ'
108 C Lennard-Jones-Kihara potential (shifted).
109 102 call eljk(evdw,evdw_p,evdw_m)
111 C Berne-Pechukas potential (dilated LJ, angular dependence).
112 103 call ebp(evdw,evdw_p,evdw_m)
114 C Gay-Berne potential (shifted LJ, angular dependence).
115 104 call egb(evdw,evdw_p,evdw_m)
117 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
118 105 call egbv(evdw,evdw_p,evdw_m)
120 C Soft-sphere potential
121 106 call e_softsphere(evdw)
123 C Calculate electrostatic (H-bonding) energy of the main chain.
127 C JUYONG for dfa test!
128 if (wdfa_dist.gt.0) call edfad(edfadis)
129 c print*, 'edfad is finished!', edfadis
130 if (wdfa_tor.gt.0) call edfat(edfator)
131 c print*, 'edfat is finished!', edfator
132 if (wdfa_nei.gt.0) call edfan(edfanei)
133 c print*, 'edfan is finished!', edfanei
134 if (wdfa_beta.gt.0) call edfab(edfabet)
135 c print*, 'edfab is finished!', edfabet
139 c print *,"Processor",myrank," computed USCSC"
145 time_vec=time_vec+MPI_Wtime()-time01
147 c print *,"Processor",myrank," left VEC_AND_DERIV"
150 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
151 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
152 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
153 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
155 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
156 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
157 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
158 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
160 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
169 c write (iout,*) "Soft-spheer ELEC potential"
170 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
173 c print *,"Processor",myrank," computed UELEC"
175 C Calculate excluded-volume interaction energy between peptide groups
180 call escp(evdw2,evdw2_14)
186 c write (iout,*) "Soft-sphere SCP potential"
187 call escp_soft_sphere(evdw2,evdw2_14)
190 c Calculate the bond-stretching energy
194 C Calculate the disulfide-bridge and other energy and the contributions
195 C from other distance constraints.
196 cd print *,'Calling EHPB'
198 cd print *,'EHPB exitted succesfully.'
200 C Calculate the virtual-bond-angle energy.
202 if (wang.gt.0d0) then
207 c print *,"Processor",myrank," computed UB"
209 C Calculate the SC local energy.
212 c print *,"Processor",myrank," computed USC"
214 C Calculate the virtual-bond torsional energy.
216 cd print *,'nterm=',nterm
218 call etor(etors,edihcnstr)
223 c print *,"Processor",myrank," computed Utor"
225 C 6/23/01 Calculate double-torsional energy
227 if (wtor_d.gt.0) then
232 c print *,"Processor",myrank," computed Utord"
234 C 21/5/07 Calculate local sicdechain correlation energy
236 if (wsccor.gt.0.0d0) then
237 call eback_sc_corr(esccor)
241 c print *,"Processor",myrank," computed Usccorr"
243 C 12/1/95 Multi-body terms
247 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
248 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
249 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
250 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
251 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
258 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
259 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
260 cd write (iout,*) "multibody_hb ecorr",ecorr
262 c print *,"Processor",myrank," computed Ucorr"
264 C If performing constraint dynamics, call the constraint energy
265 C after the equilibration time
266 if(usampl.and.totT.gt.eq_time) then
274 time_enecalc=time_enecalc+MPI_Wtime()-time00
276 c print *,"Processor",myrank," computed Uconstr"
285 energia(2)=evdw2-evdw2_14
302 energia(8)=eello_turn3
303 energia(9)=eello_turn4
310 energia(19)=edihcnstr
312 energia(20)=Uconst+Uconst_back
320 c print *," Processor",myrank," calls SUM_ENERGY"
321 call sum_energy(energia,.true.)
322 c print *," Processor",myrank," left SUM_ENERGY"
324 time_sumene=time_sumene+MPI_Wtime()-time00
327 c print*, 'etot:',energia(0)
331 c-------------------------------------------------------------------------------
332 subroutine sum_energy(energia,reduce)
333 implicit real*8 (a-h,o-z)
338 cMS$ATTRIBUTES C :: proc_proc
344 include 'COMMON.SETUP'
345 include 'COMMON.IOUNITS'
346 double precision energia(0:n_ene),enebuff(0:n_ene+1)
347 include 'COMMON.FFIELD'
348 include 'COMMON.DERIV'
349 include 'COMMON.INTERACT'
350 include 'COMMON.SBRIDGE'
351 include 'COMMON.CHAIN'
353 include 'COMMON.CONTROL'
354 include 'COMMON.TIME1'
357 if (nfgtasks.gt.1 .and. reduce) then
359 write (iout,*) "energies before REDUCE"
360 call enerprint(energia)
364 enebuff(i)=energia(i)
367 call MPI_Barrier(FG_COMM,IERR)
368 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
370 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
371 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
373 write (iout,*) "energies after REDUCE"
374 call enerprint(energia)
377 time_Reduce=time_Reduce+MPI_Wtime()-time00
379 if (fg_rank.eq.0) then
382 evdw=energia(22)+wsct*energia(23)
387 evdw2=energia(2)+energia(18)
403 eello_turn3=energia(8)
404 eello_turn4=energia(9)
411 edihcnstr=energia(19)
420 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
421 & +wang*ebe+wtor*etors+wscloc*escloc
422 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
423 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
424 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
425 & +wbond*estr+Uconst+wsccor*esccor
426 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
429 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
430 & +wang*ebe+wtor*etors+wscloc*escloc
431 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
432 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
433 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
434 & +wbond*estr+Uconst+wsccor*esccor
435 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
443 if (isnan(etot).ne.0) energia(0)=1.0d+99
445 if (isnan(etot)) energia(0)=1.0d+99
450 idumm=proc_proc(etot,i)
452 call proc_proc(etot,i)
454 if(i.eq.1)energia(0)=1.0d+99
461 c-------------------------------------------------------------------------------
462 subroutine sum_gradient
463 implicit real*8 (a-h,o-z)
468 cMS$ATTRIBUTES C :: proc_proc
473 double precision gradbufc(3,maxres),gradbufx(3,maxres),
474 & glocbuf(4*maxres),gradbufc_sum(3,maxres)
476 double precision gradbufc(3,maxres),gradbufx(3,maxres),
477 & glocbuf(4*maxres),gradbufc_sum(3,maxres)
479 include 'COMMON.SETUP'
480 include 'COMMON.IOUNITS'
481 include 'COMMON.FFIELD'
482 include 'COMMON.DERIV'
483 include 'COMMON.INTERACT'
484 include 'COMMON.SBRIDGE'
485 include 'COMMON.CHAIN'
487 include 'COMMON.CONTROL'
488 include 'COMMON.TIME1'
489 include 'COMMON.MAXGRAD'
494 write (iout,*) "sum_gradient gvdwc, gvdwx"
496 write (iout,'(i3,3f10.5,5x,3f10.5,5x,3f10.5,5x,3f10.5)')
497 & i,(gvdwx(j,i),j=1,3),(gvdwcT(j,i),j=1,3),(gvdwc(j,i),j=1,3),
498 & (gvdwcT(j,i),j=1,3)
503 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
504 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
505 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
508 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
509 C in virtual-bond-vector coordinates
512 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
514 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
515 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
517 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
519 c write (iout,'(i5,3f10.5,2x,f10.5)')
520 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
522 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
524 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
525 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
534 gradbufc(j,i)=wsc*gvdwc(j,i)+wsc*wscT*gvdwcT(j,i)+
535 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
536 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
537 & wel_loc*gel_loc_long(j,i)+
538 & wcorr*gradcorr_long(j,i)+
539 & wcorr5*gradcorr5_long(j,i)+
540 & wcorr6*gradcorr6_long(j,i)+
541 & wturn6*gcorr6_turn_long(j,i)+
542 & wstrain*ghpbc(j,i)+
543 & wdfa_dist*gdfad(j,i)+
544 & wdfa_tor*gdfat(j,i)+
545 & wdfa_nei*gdfan(j,i)+
546 & wdfa_beta*gdfab(j,i)
553 gradbufc(j,i)=wsc*gvdwc(j,i)+
554 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
555 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
556 & wel_loc*gel_loc_long(j,i)+
557 & wcorr*gradcorr_long(j,i)+
558 & wcorr5*gradcorr5_long(j,i)+
559 & wcorr6*gradcorr6_long(j,i)+
560 & wturn6*gcorr6_turn_long(j,i)+
561 & wstrain*ghpbc(j,i)+
562 & wdfa_dist*gdfad(j,i)+
563 & wdfa_tor*gdfat(j,i)+
564 & wdfa_nei*gdfan(j,i)+
565 & wdfa_beta*gdfab(j,i)
573 gradbufc(j,i)=wsc*gvdwc(j,i)+
574 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
575 & welec*gelc_long(j,i)+
577 & wel_loc*gel_loc_long(j,i)+
578 & wcorr*gradcorr_long(j,i)+
579 & wcorr5*gradcorr5_long(j,i)+
580 & wcorr6*gradcorr6_long(j,i)+
581 & wturn6*gcorr6_turn_long(j,i)+
582 & wstrain*ghpbc(j,i)+
583 & wdfa_dist*gdfad(j,i)+
584 & wdfa_tor*gdfat(j,i)+
585 & wdfa_nei*gdfan(j,i)+
586 & wdfa_beta*gdfab(j,i)
593 if (nfgtasks.gt.1) then
596 write (iout,*) "gradbufc before allreduce"
598 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
602 call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
603 & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
604 time_reduce=time_reduce+MPI_Wtime()-time00
606 write (iout,*) "gradbufc_sum after allreduce"
608 write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
613 time_allreduce=time_allreduce+MPI_Wtime()-time00
620 do i=igrad_start,igrad_end
621 do j=jgrad_start(i),jgrad_end(i)
623 gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
630 write (iout,*) "gradbufc"
632 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
642 gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
650 gradbufc(k,nres)=0.0d0
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)+wvdwpp*gvdwpp(j,i)+
659 & wel_loc*gel_loc_long(j,i)+
660 & wcorr*gradcorr_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 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
675 & wel_loc*gel_loc(j,i)+
676 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
677 & welec*gelc_long(j,i)
678 & wel_loc*gel_loc_long(j,i)+
679 & wcorr*gcorr_long(j,i)+
680 & wcorr5*gradcorr5_long(j,i)+
681 & wcorr6*gradcorr6_long(j,i)+
682 & wturn6*gcorr6_turn_long(j,i))+
684 & wcorr*gradcorr(j,i)+
685 & wturn3*gcorr3_turn(j,i)+
686 & wturn4*gcorr4_turn(j,i)+
687 & wcorr5*gradcorr5(j,i)+
688 & wcorr6*gradcorr6(j,i)+
689 & wturn6*gcorr6_turn(j,i)+
690 & wsccor*gsccorc(j,i)
691 & +wscloc*gscloc(j,i)
694 gradx(j,i,icg)=wsc*gvdwx(j,i)+wsc*wscT*gvdwxT(j,i)+
695 & wscp*gradx_scp(j,i)+
697 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
698 & wsccor*gsccorx(j,i)
699 & +wscloc*gsclocx(j,i)
701 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
703 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
704 & wsccor*gsccorx(j,i)
705 & +wscloc*gsclocx(j,i)
710 write (iout,*) "gloc before adding corr"
712 write (iout,*) i,gloc(i,icg)
716 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
717 & +wcorr5*g_corr5_loc(i)
718 & +wcorr6*g_corr6_loc(i)
719 & +wturn4*gel_loc_turn4(i)
720 & +wturn3*gel_loc_turn3(i)
721 & +wturn6*gel_loc_turn6(i)
722 & +wel_loc*gel_loc_loc(i)
723 & +wsccor*gsccor_loc(i)
726 write (iout,*) "gloc after adding corr"
728 write (iout,*) i,gloc(i,icg)
732 if (nfgtasks.gt.1) then
735 gradbufc(j,i)=gradc(j,i,icg)
736 gradbufx(j,i)=gradx(j,i,icg)
740 glocbuf(i)=gloc(i,icg)
743 call MPI_Barrier(FG_COMM,IERR)
744 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
746 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
747 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
748 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
749 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
750 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
751 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
752 time_reduce=time_reduce+MPI_Wtime()-time00
754 write (iout,*) "gloc after reduce"
756 write (iout,*) i,gloc(i,icg)
761 if (gnorm_check) then
763 c Compute the maximum elements of the gradient
773 gcorr3_turn_max=0.0d0
774 gcorr4_turn_max=0.0d0
777 gcorr6_turn_max=0.0d0
787 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
788 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
790 gvdwc_norm=dsqrt(scalar(gvdwcT(1,i),gvdwcT(1,i)))
791 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
793 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
794 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
795 & gvdwc_scp_max=gvdwc_scp_norm
796 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
797 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
798 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
799 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
800 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
801 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
802 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
803 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
804 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
805 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
806 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
807 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
808 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
810 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
811 & gcorr3_turn_max=gcorr3_turn_norm
812 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
814 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
815 & gcorr4_turn_max=gcorr4_turn_norm
816 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
817 if (gradcorr5_norm.gt.gradcorr5_max)
818 & gradcorr5_max=gradcorr5_norm
819 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
820 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
821 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
823 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
824 & gcorr6_turn_max=gcorr6_turn_norm
825 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
826 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
827 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
828 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
829 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
830 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
832 gvdwx_norm=dsqrt(scalar(gvdwxT(1,i),gvdwxT(1,i)))
833 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
835 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
836 if (gradx_scp_norm.gt.gradx_scp_max)
837 & gradx_scp_max=gradx_scp_norm
838 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
839 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
840 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
841 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
842 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
843 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
844 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
845 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
849 open(istat,file=statname,position="append")
851 open(istat,file=statname,access="append")
853 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
854 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
855 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
856 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
857 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
858 & gsccorx_max,gsclocx_max
860 if (gvdwc_max.gt.1.0d4) then
861 write (iout,*) "gvdwc gvdwx gradb gradbx"
863 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
864 & gradb(j,i),gradbx(j,i),j=1,3)
866 call pdbout(0.0d0,'cipiszcze',iout)
872 write (iout,*) "gradc gradx gloc"
874 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
875 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
879 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
883 c-------------------------------------------------------------------------------
884 subroutine rescale_weights(t_bath)
885 implicit real*8 (a-h,o-z)
887 include 'COMMON.IOUNITS'
888 include 'COMMON.FFIELD'
889 include 'COMMON.SBRIDGE'
890 double precision kfac /2.4d0/
891 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
893 c facT=2*temp0/(t_bath+temp0)
894 if (rescale_mode.eq.0) then
900 else if (rescale_mode.eq.1) then
901 facT=kfac/(kfac-1.0d0+t_bath/temp0)
902 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
903 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
904 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
905 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
906 else if (rescale_mode.eq.2) then
912 facT=licznik/dlog(dexp(x)+dexp(-x))
913 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
914 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
915 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
916 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
918 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
919 write (*,*) "Wrong RESCALE_MODE",rescale_mode
921 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
925 welec=weights(3)*fact
926 wcorr=weights(4)*fact3
927 wcorr5=weights(5)*fact4
928 wcorr6=weights(6)*fact5
929 wel_loc=weights(7)*fact2
930 wturn3=weights(8)*fact2
931 wturn4=weights(9)*fact3
932 wturn6=weights(10)*fact5
933 wtor=weights(13)*fact
934 wtor_d=weights(14)*fact2
935 wsccor=weights(21)*fact
938 wsct=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
942 C------------------------------------------------------------------------
943 subroutine enerprint(energia)
944 implicit real*8 (a-h,o-z)
946 include 'COMMON.IOUNITS'
947 include 'COMMON.FFIELD'
948 include 'COMMON.SBRIDGE'
950 double precision energia(0:n_ene)
953 evdw=energia(22)+wsct*energia(23)
959 evdw2=energia(2)+energia(18)
971 eello_turn3=energia(8)
972 eello_turn4=energia(9)
973 eello_turn6=energia(10)
979 edihcnstr=energia(19)
984 edfadis = energia(24)
985 edfator = energia(25)
986 edfanei = energia(26)
987 edfabet = energia(27)
990 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
991 & estr,wbond,ebe,wang,
992 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
994 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
995 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
997 & Uconst,edfadis,edfator,edfanei,edfabet,etot
998 10 format (/'Virtual-chain energies:'//
999 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1000 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1001 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1002 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
1003 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1004 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1005 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1006 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1007 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1008 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1009 & ' (SS bridges & dist. cnstr.)'/
1010 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1011 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1012 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1013 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1014 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1015 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1016 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1017 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1018 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1019 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1020 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1021 & 'EDFAD= ',1pE16.6,' (DFA distance energy)'/
1022 & 'EDFAT= ',1pE16.6,' (DFA torsion energy)'/
1023 & 'EDFAN= ',1pE16.6,' (DFA NCa energy)'/
1024 & 'EDFAB= ',1pE16.6,' (DFA Beta energy)'/
1025 & 'ETOT= ',1pE16.6,' (total)')
1027 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1028 & estr,wbond,ebe,wang,
1029 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1031 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1032 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1034 & Uconst,edfadis,edfator,edfanei,edfabet,etot
1035 10 format (/'Virtual-chain energies:'//
1036 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1037 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1038 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1039 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1040 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1041 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1042 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1043 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1044 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1045 & ' (SS bridges & dist. cnstr.)'/
1046 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1047 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1048 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1049 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1050 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1051 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1052 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1053 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1054 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1055 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1056 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1057 & 'EDFAD= ',1pE16.6,' (DFA distance energy)'/
1058 & 'EDFAT= ',1pE16.6,' (DFA torsion energy)'/
1059 & 'EDFAN= ',1pE16.6,' (DFA NCa energy)'/
1060 & 'EDFAB= ',1pE16.6,' (DFA Beta energy)'/
1061 & 'ETOT= ',1pE16.6,' (total)')
1065 C-----------------------------------------------------------------------
1066 subroutine elj(evdw,evdw_p,evdw_m)
1068 C This subroutine calculates the interaction energy of nonbonded side chains
1069 C assuming the LJ potential of interaction.
1071 implicit real*8 (a-h,o-z)
1072 include 'DIMENSIONS'
1073 parameter (accur=1.0d-10)
1074 include 'COMMON.GEO'
1075 include 'COMMON.VAR'
1076 include 'COMMON.LOCAL'
1077 include 'COMMON.CHAIN'
1078 include 'COMMON.DERIV'
1079 include 'COMMON.INTERACT'
1080 include 'COMMON.TORSION'
1081 include 'COMMON.SBRIDGE'
1082 include 'COMMON.NAMES'
1083 include 'COMMON.IOUNITS'
1084 include 'COMMON.CONTACTS'
1086 include 'COMMON.CONTACTS.MOMENT'
1089 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1091 do i=iatsc_s,iatsc_e
1100 C Calculate SC interaction energy.
1102 do iint=1,nint_gr(i)
1103 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1104 cd & 'iend=',iend(i,iint)
1105 do j=istart(i,iint),iend(i,iint)
1110 C Change 12/1/95 to calculate four-body interactions
1111 rij=xj*xj+yj*yj+zj*zj
1113 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1114 eps0ij=eps(itypi,itypj)
1116 e1=fac*fac*aa(itypi,itypj)
1117 e2=fac*bb(itypi,itypj)
1119 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1120 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1121 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1122 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1123 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1124 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1126 if (bb(itypi,itypj).gt.0) then
1127 evdw_p=evdw_p+evdwij
1129 evdw_m=evdw_m+evdwij
1135 C Calculate the components of the gradient in DC and X
1137 fac=-rrij*(e1+evdwij)
1142 if (bb(itypi,itypj).gt.0.0d0) then
1144 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1145 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1146 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1147 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1151 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1152 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1153 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1154 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1159 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1160 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1161 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1162 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1167 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1171 C 12/1/95, revised on 5/20/97
1173 C Calculate the contact function. The ith column of the array JCONT will
1174 C contain the numbers of atoms that make contacts with the atom I (of numbers
1175 C greater than I). The arrays FACONT and GACONT will contain the values of
1176 C the contact function and its derivative.
1178 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1179 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1180 C Uncomment next line, if the correlation interactions are contact function only
1181 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1183 sigij=sigma(itypi,itypj)
1184 r0ij=rs0(itypi,itypj)
1186 C Check whether the SC's are not too far to make a contact.
1189 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1190 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1192 if (fcont.gt.0.0D0) then
1193 C If the SC-SC distance if close to sigma, apply spline.
1194 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1195 cAdam & fcont1,fprimcont1)
1196 cAdam fcont1=1.0d0-fcont1
1197 cAdam if (fcont1.gt.0.0d0) then
1198 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1199 cAdam fcont=fcont*fcont1
1201 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1202 cga eps0ij=1.0d0/dsqrt(eps0ij)
1204 cga gg(k)=gg(k)*eps0ij
1206 cga eps0ij=-evdwij*eps0ij
1207 C Uncomment for AL's type of SC correlation interactions.
1208 cadam eps0ij=-evdwij
1209 num_conti=num_conti+1
1210 jcont(num_conti,i)=j
1211 facont(num_conti,i)=fcont*eps0ij
1212 fprimcont=eps0ij*fprimcont/rij
1214 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1215 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1216 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1217 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1218 gacont(1,num_conti,i)=-fprimcont*xj
1219 gacont(2,num_conti,i)=-fprimcont*yj
1220 gacont(3,num_conti,i)=-fprimcont*zj
1221 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1222 cd write (iout,'(2i3,3f10.5)')
1223 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1229 num_cont(i)=num_conti
1233 gvdwc(j,i)=expon*gvdwc(j,i)
1234 gvdwx(j,i)=expon*gvdwx(j,i)
1237 C******************************************************************************
1241 C To save time, the factor of EXPON has been extracted from ALL components
1242 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1245 C******************************************************************************
1248 C-----------------------------------------------------------------------------
1249 subroutine eljk(evdw,evdw_p,evdw_m)
1251 C This subroutine calculates the interaction energy of nonbonded side chains
1252 C assuming the LJK potential of interaction.
1254 implicit real*8 (a-h,o-z)
1255 include 'DIMENSIONS'
1256 include 'COMMON.GEO'
1257 include 'COMMON.VAR'
1258 include 'COMMON.LOCAL'
1259 include 'COMMON.CHAIN'
1260 include 'COMMON.DERIV'
1261 include 'COMMON.INTERACT'
1262 include 'COMMON.IOUNITS'
1263 include 'COMMON.NAMES'
1266 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1268 do i=iatsc_s,iatsc_e
1275 C Calculate SC interaction energy.
1277 do iint=1,nint_gr(i)
1278 do j=istart(i,iint),iend(i,iint)
1283 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1284 fac_augm=rrij**expon
1285 e_augm=augm(itypi,itypj)*fac_augm
1286 r_inv_ij=dsqrt(rrij)
1288 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1289 fac=r_shift_inv**expon
1290 e1=fac*fac*aa(itypi,itypj)
1291 e2=fac*bb(itypi,itypj)
1293 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1294 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1295 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1296 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1297 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1298 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1299 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1301 if (bb(itypi,itypj).gt.0) then
1302 evdw_p=evdw_p+evdwij
1304 evdw_m=evdw_m+evdwij
1310 C Calculate the components of the gradient in DC and X
1312 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1317 if (bb(itypi,itypj).gt.0.0d0) then
1319 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1320 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1321 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1322 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1326 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1327 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1328 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1329 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1334 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1335 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1336 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1337 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1342 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1350 gvdwc(j,i)=expon*gvdwc(j,i)
1351 gvdwx(j,i)=expon*gvdwx(j,i)
1356 C-----------------------------------------------------------------------------
1357 subroutine ebp(evdw,evdw_p,evdw_m)
1359 C This subroutine calculates the interaction energy of nonbonded side chains
1360 C assuming the Berne-Pechukas potential of interaction.
1362 implicit real*8 (a-h,o-z)
1363 include 'DIMENSIONS'
1364 include 'COMMON.GEO'
1365 include 'COMMON.VAR'
1366 include 'COMMON.LOCAL'
1367 include 'COMMON.CHAIN'
1368 include 'COMMON.DERIV'
1369 include 'COMMON.NAMES'
1370 include 'COMMON.INTERACT'
1371 include 'COMMON.IOUNITS'
1372 include 'COMMON.CALC'
1373 common /srutu/ icall
1374 c double precision rrsave(maxdim)
1377 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1379 c if (icall.eq.0) then
1385 do i=iatsc_s,iatsc_e
1391 dxi=dc_norm(1,nres+i)
1392 dyi=dc_norm(2,nres+i)
1393 dzi=dc_norm(3,nres+i)
1394 c dsci_inv=dsc_inv(itypi)
1395 dsci_inv=vbld_inv(i+nres)
1397 C Calculate SC interaction energy.
1399 do iint=1,nint_gr(i)
1400 do j=istart(i,iint),iend(i,iint)
1403 c dscj_inv=dsc_inv(itypj)
1404 dscj_inv=vbld_inv(j+nres)
1405 chi1=chi(itypi,itypj)
1406 chi2=chi(itypj,itypi)
1413 alf12=0.5D0*(alf1+alf2)
1414 C For diagnostics only!!!
1427 dxj=dc_norm(1,nres+j)
1428 dyj=dc_norm(2,nres+j)
1429 dzj=dc_norm(3,nres+j)
1430 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1431 cd if (icall.eq.0) then
1437 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1439 C Calculate whole angle-dependent part of epsilon and contributions
1440 C to its derivatives
1441 fac=(rrij*sigsq)**expon2
1442 e1=fac*fac*aa(itypi,itypj)
1443 e2=fac*bb(itypi,itypj)
1444 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1445 eps2der=evdwij*eps3rt
1446 eps3der=evdwij*eps2rt
1447 evdwij=evdwij*eps2rt*eps3rt
1449 if (bb(itypi,itypj).gt.0) then
1450 evdw_p=evdw_p+evdwij
1452 evdw_m=evdw_m+evdwij
1458 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1459 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1460 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1461 cd & restyp(itypi),i,restyp(itypj),j,
1462 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1463 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1464 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1467 C Calculate gradient components.
1468 e1=e1*eps1*eps2rt**2*eps3rt**2
1469 fac=-expon*(e1+evdwij)
1472 C Calculate radial part of the gradient
1476 C Calculate the angular part of the gradient and sum add the contributions
1477 C to the appropriate components of the Cartesian gradient.
1479 if (bb(itypi,itypj).gt.0) then
1493 C-----------------------------------------------------------------------------
1494 subroutine egb(evdw,evdw_p,evdw_m)
1496 C This subroutine calculates the interaction energy of nonbonded side chains
1497 C assuming the Gay-Berne potential of interaction.
1499 implicit real*8 (a-h,o-z)
1500 include 'DIMENSIONS'
1501 include 'COMMON.GEO'
1502 include 'COMMON.VAR'
1503 include 'COMMON.LOCAL'
1504 include 'COMMON.CHAIN'
1505 include 'COMMON.DERIV'
1506 include 'COMMON.NAMES'
1507 include 'COMMON.INTERACT'
1508 include 'COMMON.IOUNITS'
1509 include 'COMMON.CALC'
1510 include 'COMMON.CONTROL'
1513 ccccc energy_dec=.false.
1514 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1519 c if (icall.eq.0) lprn=.false.
1521 do i=iatsc_s,iatsc_e
1527 dxi=dc_norm(1,nres+i)
1528 dyi=dc_norm(2,nres+i)
1529 dzi=dc_norm(3,nres+i)
1530 c dsci_inv=dsc_inv(itypi)
1531 dsci_inv=vbld_inv(i+nres)
1532 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1533 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1535 C Calculate SC interaction energy.
1537 do iint=1,nint_gr(i)
1538 do j=istart(i,iint),iend(i,iint)
1541 c dscj_inv=dsc_inv(itypj)
1542 dscj_inv=vbld_inv(j+nres)
1543 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1544 c & 1.0d0/vbld(j+nres)
1545 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1546 sig0ij=sigma(itypi,itypj)
1547 chi1=chi(itypi,itypj)
1548 chi2=chi(itypj,itypi)
1555 alf12=0.5D0*(alf1+alf2)
1556 C For diagnostics only!!!
1569 dxj=dc_norm(1,nres+j)
1570 dyj=dc_norm(2,nres+j)
1571 dzj=dc_norm(3,nres+j)
1572 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1573 c write (iout,*) "j",j," dc_norm",
1574 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1575 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1577 C Calculate angle-dependent terms of energy and contributions to their
1581 sig=sig0ij*dsqrt(sigsq)
1582 rij_shift=1.0D0/rij-sig+sig0ij
1583 c for diagnostics; uncomment
1584 c rij_shift=1.2*sig0ij
1585 C I hate to put IF's in the loops, but here don't have another choice!!!!
1586 if (rij_shift.le.0.0D0) then
1588 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1589 cd & restyp(itypi),i,restyp(itypj),j,
1590 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1594 c---------------------------------------------------------------
1595 rij_shift=1.0D0/rij_shift
1596 fac=rij_shift**expon
1597 e1=fac*fac*aa(itypi,itypj)
1598 e2=fac*bb(itypi,itypj)
1599 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1600 eps2der=evdwij*eps3rt
1601 eps3der=evdwij*eps2rt
1602 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1603 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1604 evdwij=evdwij*eps2rt*eps3rt
1606 if (bb(itypi,itypj).gt.0) then
1607 evdw_p=evdw_p+evdwij
1609 evdw_m=evdw_m+evdwij
1615 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1616 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1617 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1618 & restyp(itypi),i,restyp(itypj),j,
1619 & epsi,sigm,chi1,chi2,chip1,chip2,
1620 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1621 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1625 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1628 C Calculate gradient components.
1629 e1=e1*eps1*eps2rt**2*eps3rt**2
1630 fac=-expon*(e1+evdwij)*rij_shift
1634 C Calculate the radial part of the gradient
1638 C Calculate angular part of the gradient.
1640 if (bb(itypi,itypj).gt.0) then
1651 c write (iout,*) "Number of loop steps in EGB:",ind
1652 cccc energy_dec=.false.
1655 C-----------------------------------------------------------------------------
1656 subroutine egbv(evdw,evdw_p,evdw_m)
1658 C This subroutine calculates the interaction energy of nonbonded side chains
1659 C assuming the Gay-Berne-Vorobjev potential of interaction.
1661 implicit real*8 (a-h,o-z)
1662 include 'DIMENSIONS'
1663 include 'COMMON.GEO'
1664 include 'COMMON.VAR'
1665 include 'COMMON.LOCAL'
1666 include 'COMMON.CHAIN'
1667 include 'COMMON.DERIV'
1668 include 'COMMON.NAMES'
1669 include 'COMMON.INTERACT'
1670 include 'COMMON.IOUNITS'
1671 include 'COMMON.CALC'
1672 common /srutu/ icall
1675 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1678 c if (icall.eq.0) lprn=.true.
1680 do i=iatsc_s,iatsc_e
1686 dxi=dc_norm(1,nres+i)
1687 dyi=dc_norm(2,nres+i)
1688 dzi=dc_norm(3,nres+i)
1689 c dsci_inv=dsc_inv(itypi)
1690 dsci_inv=vbld_inv(i+nres)
1692 C Calculate SC interaction energy.
1694 do iint=1,nint_gr(i)
1695 do j=istart(i,iint),iend(i,iint)
1698 c dscj_inv=dsc_inv(itypj)
1699 dscj_inv=vbld_inv(j+nres)
1700 sig0ij=sigma(itypi,itypj)
1701 r0ij=r0(itypi,itypj)
1702 chi1=chi(itypi,itypj)
1703 chi2=chi(itypj,itypi)
1710 alf12=0.5D0*(alf1+alf2)
1711 C For diagnostics only!!!
1724 dxj=dc_norm(1,nres+j)
1725 dyj=dc_norm(2,nres+j)
1726 dzj=dc_norm(3,nres+j)
1727 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1729 C Calculate angle-dependent terms of energy and contributions to their
1733 sig=sig0ij*dsqrt(sigsq)
1734 rij_shift=1.0D0/rij-sig+r0ij
1735 C I hate to put IF's in the loops, but here don't have another choice!!!!
1736 if (rij_shift.le.0.0D0) then
1741 c---------------------------------------------------------------
1742 rij_shift=1.0D0/rij_shift
1743 fac=rij_shift**expon
1744 e1=fac*fac*aa(itypi,itypj)
1745 e2=fac*bb(itypi,itypj)
1746 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1747 eps2der=evdwij*eps3rt
1748 eps3der=evdwij*eps2rt
1749 fac_augm=rrij**expon
1750 e_augm=augm(itypi,itypj)*fac_augm
1751 evdwij=evdwij*eps2rt*eps3rt
1753 if (bb(itypi,itypj).gt.0) then
1754 evdw_p=evdw_p+evdwij+e_augm
1756 evdw_m=evdw_m+evdwij+e_augm
1759 evdw=evdw+evdwij+e_augm
1762 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1763 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1764 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1765 & restyp(itypi),i,restyp(itypj),j,
1766 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1767 & chi1,chi2,chip1,chip2,
1768 & eps1,eps2rt**2,eps3rt**2,
1769 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1772 C Calculate gradient components.
1773 e1=e1*eps1*eps2rt**2*eps3rt**2
1774 fac=-expon*(e1+evdwij)*rij_shift
1776 fac=rij*fac-2*expon*rrij*e_augm
1777 C Calculate the radial part of the gradient
1781 C Calculate angular part of the gradient.
1783 if (bb(itypi,itypj).gt.0) then
1795 C-----------------------------------------------------------------------------
1796 subroutine sc_angular
1797 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1798 C om12. Called by ebp, egb, and egbv.
1800 include 'COMMON.CALC'
1801 include 'COMMON.IOUNITS'
1805 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1806 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1807 om12=dxi*dxj+dyi*dyj+dzi*dzj
1809 C Calculate eps1(om12) and its derivative in om12
1810 faceps1=1.0D0-om12*chiom12
1811 faceps1_inv=1.0D0/faceps1
1812 eps1=dsqrt(faceps1_inv)
1813 C Following variable is eps1*deps1/dom12
1814 eps1_om12=faceps1_inv*chiom12
1819 c write (iout,*) "om12",om12," eps1",eps1
1820 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1825 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1826 sigsq=1.0D0-facsig*faceps1_inv
1827 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1828 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1829 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1835 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1836 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1838 C Calculate eps2 and its derivatives in om1, om2, and om12.
1841 chipom12=chip12*om12
1842 facp=1.0D0-om12*chipom12
1844 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1845 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1846 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1847 C Following variable is the square root of eps2
1848 eps2rt=1.0D0-facp1*facp_inv
1849 C Following three variables are the derivatives of the square root of eps
1850 C in om1, om2, and om12.
1851 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1852 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1853 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1854 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1855 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1856 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1857 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1858 c & " eps2rt_om12",eps2rt_om12
1859 C Calculate whole angle-dependent part of epsilon and contributions
1860 C to its derivatives
1864 C----------------------------------------------------------------------------
1865 subroutine sc_grad_T
1866 implicit real*8 (a-h,o-z)
1867 include 'DIMENSIONS'
1868 include 'COMMON.CHAIN'
1869 include 'COMMON.DERIV'
1870 include 'COMMON.CALC'
1871 include 'COMMON.IOUNITS'
1872 double precision dcosom1(3),dcosom2(3)
1873 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1874 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1875 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1876 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1880 c eom12=evdwij*eps1_om12
1882 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1883 c & " sigder",sigder
1884 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1885 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1887 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1888 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1891 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1893 c write (iout,*) "gg",(gg(k),k=1,3)
1895 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1896 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1897 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1898 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1899 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1900 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1901 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1902 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1903 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1904 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1907 C Calculate the components of the gradient in DC and X
1911 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1915 gvdwcT(l,i)=gvdwcT(l,i)-gg(l)
1916 gvdwcT(l,j)=gvdwcT(l,j)+gg(l)
1921 C----------------------------------------------------------------------------
1923 implicit real*8 (a-h,o-z)
1924 include 'DIMENSIONS'
1925 include 'COMMON.CHAIN'
1926 include 'COMMON.DERIV'
1927 include 'COMMON.CALC'
1928 include 'COMMON.IOUNITS'
1929 double precision dcosom1(3),dcosom2(3)
1930 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1931 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1932 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1933 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1937 c eom12=evdwij*eps1_om12
1939 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1940 c & " sigder",sigder
1941 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1942 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1944 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1945 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1948 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1950 c write (iout,*) "gg",(gg(k),k=1,3)
1952 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1953 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1954 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1955 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1956 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1957 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1958 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1959 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1960 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1961 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1964 C Calculate the components of the gradient in DC and X
1968 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1972 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1973 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1977 C-----------------------------------------------------------------------
1978 subroutine e_softsphere(evdw)
1980 C This subroutine calculates the interaction energy of nonbonded side chains
1981 C assuming the LJ potential of interaction.
1983 implicit real*8 (a-h,o-z)
1984 include 'DIMENSIONS'
1985 parameter (accur=1.0d-10)
1986 include 'COMMON.GEO'
1987 include 'COMMON.VAR'
1988 include 'COMMON.LOCAL'
1989 include 'COMMON.CHAIN'
1990 include 'COMMON.DERIV'
1991 include 'COMMON.INTERACT'
1992 include 'COMMON.TORSION'
1993 include 'COMMON.SBRIDGE'
1994 include 'COMMON.NAMES'
1995 include 'COMMON.IOUNITS'
1996 include 'COMMON.CONTACTS'
1998 include 'COMMON.CONTACTS.MOMENT'
2001 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2003 do i=iatsc_s,iatsc_e
2010 C Calculate SC interaction energy.
2012 do iint=1,nint_gr(i)
2013 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2014 cd & 'iend=',iend(i,iint)
2015 do j=istart(i,iint),iend(i,iint)
2020 rij=xj*xj+yj*yj+zj*zj
2021 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2022 r0ij=r0(itypi,itypj)
2024 c print *,i,j,r0ij,dsqrt(rij)
2025 if (rij.lt.r0ijsq) then
2026 evdwij=0.25d0*(rij-r0ijsq)**2
2034 C Calculate the components of the gradient in DC and X
2040 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2041 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2042 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2043 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2047 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2055 C--------------------------------------------------------------------------
2056 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2059 C Soft-sphere potential of p-p interaction
2061 implicit real*8 (a-h,o-z)
2062 include 'DIMENSIONS'
2063 include 'COMMON.CONTROL'
2064 include 'COMMON.IOUNITS'
2065 include 'COMMON.GEO'
2066 include 'COMMON.VAR'
2067 include 'COMMON.LOCAL'
2068 include 'COMMON.CHAIN'
2069 include 'COMMON.DERIV'
2070 include 'COMMON.INTERACT'
2071 include 'COMMON.CONTACTS'
2073 include 'COMMON.CONTACTS.MOMENT'
2075 include 'COMMON.TORSION'
2076 include 'COMMON.VECTORS'
2077 include 'COMMON.FFIELD'
2079 cd write(iout,*) 'In EELEC_soft_sphere'
2086 do i=iatel_s,iatel_e
2090 xmedi=c(1,i)+0.5d0*dxi
2091 ymedi=c(2,i)+0.5d0*dyi
2092 zmedi=c(3,i)+0.5d0*dzi
2094 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2095 do j=ielstart(i),ielend(i)
2099 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2100 r0ij=rpp(iteli,itelj)
2105 xj=c(1,j)+0.5D0*dxj-xmedi
2106 yj=c(2,j)+0.5D0*dyj-ymedi
2107 zj=c(3,j)+0.5D0*dzj-zmedi
2108 rij=xj*xj+yj*yj+zj*zj
2109 if (rij.lt.r0ijsq) then
2110 evdw1ij=0.25d0*(rij-r0ijsq)**2
2118 C Calculate contributions to the Cartesian gradient.
2124 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2125 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2128 * Loop over residues i+1 thru j-1.
2132 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2137 cgrad do i=nnt,nct-1
2139 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2141 cgrad do j=i+1,nct-1
2143 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2149 c------------------------------------------------------------------------------
2150 subroutine vec_and_deriv
2151 implicit real*8 (a-h,o-z)
2152 include 'DIMENSIONS'
2156 include 'COMMON.IOUNITS'
2157 include 'COMMON.GEO'
2158 include 'COMMON.VAR'
2159 include 'COMMON.LOCAL'
2160 include 'COMMON.CHAIN'
2161 include 'COMMON.VECTORS'
2162 include 'COMMON.SETUP'
2163 include 'COMMON.TIME1'
2164 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2165 C Compute the local reference systems. For reference system (i), the
2166 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2167 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2169 do i=ivec_start,ivec_end
2173 if (i.eq.nres-1) then
2174 C Case of the last full residue
2175 C Compute the Z-axis
2176 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2177 costh=dcos(pi-theta(nres))
2178 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2182 C Compute the derivatives of uz
2184 uzder(2,1,1)=-dc_norm(3,i-1)
2185 uzder(3,1,1)= dc_norm(2,i-1)
2186 uzder(1,2,1)= dc_norm(3,i-1)
2188 uzder(3,2,1)=-dc_norm(1,i-1)
2189 uzder(1,3,1)=-dc_norm(2,i-1)
2190 uzder(2,3,1)= dc_norm(1,i-1)
2193 uzder(2,1,2)= dc_norm(3,i)
2194 uzder(3,1,2)=-dc_norm(2,i)
2195 uzder(1,2,2)=-dc_norm(3,i)
2197 uzder(3,2,2)= dc_norm(1,i)
2198 uzder(1,3,2)= dc_norm(2,i)
2199 uzder(2,3,2)=-dc_norm(1,i)
2201 C Compute the Y-axis
2204 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2206 C Compute the derivatives of uy
2209 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2210 & -dc_norm(k,i)*dc_norm(j,i-1)
2211 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2213 uyder(j,j,1)=uyder(j,j,1)-costh
2214 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2219 uygrad(l,k,j,i)=uyder(l,k,j)
2220 uzgrad(l,k,j,i)=uzder(l,k,j)
2224 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2225 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2226 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2227 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2230 C Compute the Z-axis
2231 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2232 costh=dcos(pi-theta(i+2))
2233 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2237 C Compute the derivatives of uz
2239 uzder(2,1,1)=-dc_norm(3,i+1)
2240 uzder(3,1,1)= dc_norm(2,i+1)
2241 uzder(1,2,1)= dc_norm(3,i+1)
2243 uzder(3,2,1)=-dc_norm(1,i+1)
2244 uzder(1,3,1)=-dc_norm(2,i+1)
2245 uzder(2,3,1)= dc_norm(1,i+1)
2248 uzder(2,1,2)= dc_norm(3,i)
2249 uzder(3,1,2)=-dc_norm(2,i)
2250 uzder(1,2,2)=-dc_norm(3,i)
2252 uzder(3,2,2)= dc_norm(1,i)
2253 uzder(1,3,2)= dc_norm(2,i)
2254 uzder(2,3,2)=-dc_norm(1,i)
2256 C Compute the Y-axis
2259 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2261 C Compute the derivatives of uy
2264 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2265 & -dc_norm(k,i)*dc_norm(j,i+1)
2266 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2268 uyder(j,j,1)=uyder(j,j,1)-costh
2269 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2274 uygrad(l,k,j,i)=uyder(l,k,j)
2275 uzgrad(l,k,j,i)=uzder(l,k,j)
2279 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2280 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2281 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2282 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2286 vbld_inv_temp(1)=vbld_inv(i+1)
2287 if (i.lt.nres-1) then
2288 vbld_inv_temp(2)=vbld_inv(i+2)
2290 vbld_inv_temp(2)=vbld_inv(i)
2295 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2296 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2301 #if defined(PARVEC) && defined(MPI)
2302 if (nfgtasks1.gt.1) then
2304 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2305 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2306 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2307 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2308 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2310 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2311 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2313 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2314 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2315 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2316 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2317 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2318 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2319 time_gather=time_gather+MPI_Wtime()-time00
2321 c if (fg_rank.eq.0) then
2322 c write (iout,*) "Arrays UY and UZ"
2324 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2331 C-----------------------------------------------------------------------------
2332 subroutine check_vecgrad
2333 implicit real*8 (a-h,o-z)
2334 include 'DIMENSIONS'
2335 include 'COMMON.IOUNITS'
2336 include 'COMMON.GEO'
2337 include 'COMMON.VAR'
2338 include 'COMMON.LOCAL'
2339 include 'COMMON.CHAIN'
2340 include 'COMMON.VECTORS'
2341 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2342 dimension uyt(3,maxres),uzt(3,maxres)
2343 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2344 double precision delta /1.0d-7/
2347 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2348 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2349 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2350 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2351 cd & (dc_norm(if90,i),if90=1,3)
2352 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2353 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2354 cd write(iout,'(a)')
2360 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2361 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2374 cd write (iout,*) 'i=',i
2376 erij(k)=dc_norm(k,i)
2380 dc_norm(k,i)=erij(k)
2382 dc_norm(j,i)=dc_norm(j,i)+delta
2383 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2385 c dc_norm(k,i)=dc_norm(k,i)/fac
2387 c write (iout,*) (dc_norm(k,i),k=1,3)
2388 c write (iout,*) (erij(k),k=1,3)
2391 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2392 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2393 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2394 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2396 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2397 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2398 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2401 dc_norm(k,i)=erij(k)
2404 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2405 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2406 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2407 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2408 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2409 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2410 cd write (iout,'(a)')
2415 C--------------------------------------------------------------------------
2416 subroutine set_matrices
2417 implicit real*8 (a-h,o-z)
2418 include 'DIMENSIONS'
2421 include "COMMON.SETUP"
2423 integer status(MPI_STATUS_SIZE)
2425 include 'COMMON.IOUNITS'
2426 include 'COMMON.GEO'
2427 include 'COMMON.VAR'
2428 include 'COMMON.LOCAL'
2429 include 'COMMON.CHAIN'
2430 include 'COMMON.DERIV'
2431 include 'COMMON.INTERACT'
2432 include 'COMMON.CONTACTS'
2434 include 'COMMON.CONTACTS.MOMENT'
2436 include 'COMMON.TORSION'
2437 include 'COMMON.VECTORS'
2438 include 'COMMON.FFIELD'
2439 double precision auxvec(2),auxmat(2,2)
2441 C Compute the virtual-bond-torsional-angle dependent quantities needed
2442 C to calculate the el-loc multibody terms of various order.
2445 do i=ivec_start+2,ivec_end+2
2449 if (i .lt. nres+1) then
2486 if (i .gt. 3 .and. i .lt. nres+1) then
2487 obrot_der(1,i-2)=-sin1
2488 obrot_der(2,i-2)= cos1
2489 Ugder(1,1,i-2)= sin1
2490 Ugder(1,2,i-2)=-cos1
2491 Ugder(2,1,i-2)=-cos1
2492 Ugder(2,2,i-2)=-sin1
2495 obrot2_der(1,i-2)=-dwasin2
2496 obrot2_der(2,i-2)= dwacos2
2497 Ug2der(1,1,i-2)= dwasin2
2498 Ug2der(1,2,i-2)=-dwacos2
2499 Ug2der(2,1,i-2)=-dwacos2
2500 Ug2der(2,2,i-2)=-dwasin2
2502 obrot_der(1,i-2)=0.0d0
2503 obrot_der(2,i-2)=0.0d0
2504 Ugder(1,1,i-2)=0.0d0
2505 Ugder(1,2,i-2)=0.0d0
2506 Ugder(2,1,i-2)=0.0d0
2507 Ugder(2,2,i-2)=0.0d0
2508 obrot2_der(1,i-2)=0.0d0
2509 obrot2_der(2,i-2)=0.0d0
2510 Ug2der(1,1,i-2)=0.0d0
2511 Ug2der(1,2,i-2)=0.0d0
2512 Ug2der(2,1,i-2)=0.0d0
2513 Ug2der(2,2,i-2)=0.0d0
2515 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2516 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2517 iti = itortyp(itype(i-2))
2521 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2522 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2523 iti1 = itortyp(itype(i-1))
2527 cd write (iout,*) '*******i',i,' iti1',iti
2528 cd write (iout,*) 'b1',b1(:,iti)
2529 cd write (iout,*) 'b2',b2(:,iti)
2530 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2531 c if (i .gt. iatel_s+2) then
2532 if (i .gt. nnt+2) then
2533 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2534 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2535 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2537 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2538 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2539 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2540 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2541 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2552 DtUg2(l,k,i-2)=0.0d0
2556 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2557 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2559 muder(k,i-2)=Ub2der(k,i-2)
2561 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2562 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2563 iti1 = itortyp(itype(i-1))
2568 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2570 cd write (iout,*) 'mu ',mu(:,i-2)
2571 cd write (iout,*) 'mu1',mu1(:,i-2)
2572 cd write (iout,*) 'mu2',mu2(:,i-2)
2573 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2575 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2576 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2577 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2578 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2579 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2580 C Vectors and matrices dependent on a single virtual-bond dihedral.
2581 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2582 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2583 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2584 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2585 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2586 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2587 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2588 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2589 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2592 C Matrices dependent on two consecutive virtual-bond dihedrals.
2593 C The order of matrices is from left to right.
2594 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2596 c do i=max0(ivec_start,2),ivec_end
2598 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2599 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2600 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2601 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2602 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2603 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2604 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2605 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2608 #if defined(MPI) && defined(PARMAT)
2610 c if (fg_rank.eq.0) then
2611 write (iout,*) "Arrays UG and UGDER before GATHER"
2613 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2614 & ((ug(l,k,i),l=1,2),k=1,2),
2615 & ((ugder(l,k,i),l=1,2),k=1,2)
2617 write (iout,*) "Arrays UG2 and UG2DER"
2619 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2620 & ((ug2(l,k,i),l=1,2),k=1,2),
2621 & ((ug2der(l,k,i),l=1,2),k=1,2)
2623 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2625 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2626 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2627 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2629 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2631 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2632 & costab(i),sintab(i),costab2(i),sintab2(i)
2634 write (iout,*) "Array MUDER"
2636 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2640 if (nfgtasks.gt.1) then
2642 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2643 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2644 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2646 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2647 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2649 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2650 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2652 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2653 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2655 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2656 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2658 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2659 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2661 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2662 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2664 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2665 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2666 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2667 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2668 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2669 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2670 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2671 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2672 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2673 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2674 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2675 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2676 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2678 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2679 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2681 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2682 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2684 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2685 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2687 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2688 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2690 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2691 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2693 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2694 & ivec_count(fg_rank1),
2695 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2697 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2698 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2700 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2701 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2703 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2704 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2706 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2707 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2709 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2710 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2712 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2713 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2715 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2716 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2718 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2719 & ivec_count(fg_rank1),
2720 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2722 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2723 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2725 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2726 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2728 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2729 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2731 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2732 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2734 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2735 & ivec_count(fg_rank1),
2736 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2738 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2739 & ivec_count(fg_rank1),
2740 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2742 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2743 & ivec_count(fg_rank1),
2744 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2745 & MPI_MAT2,FG_COMM1,IERR)
2746 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2747 & ivec_count(fg_rank1),
2748 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2749 & MPI_MAT2,FG_COMM1,IERR)
2752 c Passes matrix info through the ring
2755 if (irecv.lt.0) irecv=nfgtasks1-1
2758 if (inext.ge.nfgtasks1) inext=0
2760 c write (iout,*) "isend",isend," irecv",irecv
2762 lensend=lentyp(isend)
2763 lenrecv=lentyp(irecv)
2764 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2765 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2766 c & MPI_ROTAT1(lensend),inext,2200+isend,
2767 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2768 c & iprev,2200+irecv,FG_COMM,status,IERR)
2769 c write (iout,*) "Gather ROTAT1"
2771 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2772 c & MPI_ROTAT2(lensend),inext,3300+isend,
2773 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2774 c & iprev,3300+irecv,FG_COMM,status,IERR)
2775 c write (iout,*) "Gather ROTAT2"
2777 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2778 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2779 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2780 & iprev,4400+irecv,FG_COMM,status,IERR)
2781 c write (iout,*) "Gather ROTAT_OLD"
2783 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2784 & MPI_PRECOMP11(lensend),inext,5500+isend,
2785 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2786 & iprev,5500+irecv,FG_COMM,status,IERR)
2787 c write (iout,*) "Gather PRECOMP11"
2789 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2790 & MPI_PRECOMP12(lensend),inext,6600+isend,
2791 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2792 & iprev,6600+irecv,FG_COMM,status,IERR)
2793 c write (iout,*) "Gather PRECOMP12"
2795 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2797 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2798 & MPI_ROTAT2(lensend),inext,7700+isend,
2799 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2800 & iprev,7700+irecv,FG_COMM,status,IERR)
2801 c write (iout,*) "Gather PRECOMP21"
2803 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2804 & MPI_PRECOMP22(lensend),inext,8800+isend,
2805 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2806 & iprev,8800+irecv,FG_COMM,status,IERR)
2807 c write (iout,*) "Gather PRECOMP22"
2809 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2810 & MPI_PRECOMP23(lensend),inext,9900+isend,
2811 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2812 & MPI_PRECOMP23(lenrecv),
2813 & iprev,9900+irecv,FG_COMM,status,IERR)
2814 c write (iout,*) "Gather PRECOMP23"
2819 if (irecv.lt.0) irecv=nfgtasks1-1
2822 time_gather=time_gather+MPI_Wtime()-time00
2825 c if (fg_rank.eq.0) then
2826 write (iout,*) "Arrays UG and UGDER"
2828 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2829 & ((ug(l,k,i),l=1,2),k=1,2),
2830 & ((ugder(l,k,i),l=1,2),k=1,2)
2832 write (iout,*) "Arrays UG2 and UG2DER"
2834 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2835 & ((ug2(l,k,i),l=1,2),k=1,2),
2836 & ((ug2der(l,k,i),l=1,2),k=1,2)
2838 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2840 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2841 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2842 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2844 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2846 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2847 & costab(i),sintab(i),costab2(i),sintab2(i)
2849 write (iout,*) "Array MUDER"
2851 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2857 cd iti = itortyp(itype(i))
2860 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2861 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2866 C--------------------------------------------------------------------------
2867 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2869 C This subroutine calculates the average interaction energy and its gradient
2870 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2871 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2872 C The potential depends both on the distance of peptide-group centers and on
2873 C the orientation of the CA-CA virtual bonds.
2875 implicit real*8 (a-h,o-z)
2879 include 'DIMENSIONS'
2880 include 'COMMON.CONTROL'
2881 include 'COMMON.SETUP'
2882 include 'COMMON.IOUNITS'
2883 include 'COMMON.GEO'
2884 include 'COMMON.VAR'
2885 include 'COMMON.LOCAL'
2886 include 'COMMON.CHAIN'
2887 include 'COMMON.DERIV'
2888 include 'COMMON.INTERACT'
2889 include 'COMMON.CONTACTS'
2891 include 'COMMON.CONTACTS.MOMENT'
2893 include 'COMMON.TORSION'
2894 include 'COMMON.VECTORS'
2895 include 'COMMON.FFIELD'
2896 include 'COMMON.TIME1'
2897 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2898 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2899 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2900 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2901 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2902 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2904 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2906 double precision scal_el /1.0d0/
2908 double precision scal_el /0.5d0/
2911 C 13-go grudnia roku pamietnego...
2912 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2913 & 0.0d0,1.0d0,0.0d0,
2914 & 0.0d0,0.0d0,1.0d0/
2915 cd write(iout,*) 'In EELEC'
2917 cd write(iout,*) 'Type',i
2918 cd write(iout,*) 'B1',B1(:,i)
2919 cd write(iout,*) 'B2',B2(:,i)
2920 cd write(iout,*) 'CC',CC(:,:,i)
2921 cd write(iout,*) 'DD',DD(:,:,i)
2922 cd write(iout,*) 'EE',EE(:,:,i)
2924 cd call check_vecgrad
2926 if (icheckgrad.eq.1) then
2928 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2930 dc_norm(k,i)=dc(k,i)*fac
2932 c write (iout,*) 'i',i,' fac',fac
2935 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2936 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2937 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2938 c call vec_and_deriv
2944 time_mat=time_mat+MPI_Wtime()-time01
2948 cd write (iout,*) 'i=',i
2950 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2953 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2954 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2967 cd print '(a)','Enter EELEC'
2968 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2970 gel_loc_loc(i)=0.0d0
2975 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2977 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2979 do i=iturn3_start,iturn3_end
2983 dx_normi=dc_norm(1,i)
2984 dy_normi=dc_norm(2,i)
2985 dz_normi=dc_norm(3,i)
2986 xmedi=c(1,i)+0.5d0*dxi
2987 ymedi=c(2,i)+0.5d0*dyi
2988 zmedi=c(3,i)+0.5d0*dzi
2990 call eelecij(i,i+2,ees,evdw1,eel_loc)
2991 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2992 num_cont_hb(i)=num_conti
2994 do i=iturn4_start,iturn4_end
2998 dx_normi=dc_norm(1,i)
2999 dy_normi=dc_norm(2,i)
3000 dz_normi=dc_norm(3,i)
3001 xmedi=c(1,i)+0.5d0*dxi
3002 ymedi=c(2,i)+0.5d0*dyi
3003 zmedi=c(3,i)+0.5d0*dzi
3004 num_conti=num_cont_hb(i)
3005 call eelecij(i,i+3,ees,evdw1,eel_loc)
3006 if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
3007 num_cont_hb(i)=num_conti
3010 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3012 do i=iatel_s,iatel_e
3016 dx_normi=dc_norm(1,i)
3017 dy_normi=dc_norm(2,i)
3018 dz_normi=dc_norm(3,i)
3019 xmedi=c(1,i)+0.5d0*dxi
3020 ymedi=c(2,i)+0.5d0*dyi
3021 zmedi=c(3,i)+0.5d0*dzi
3022 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3023 num_conti=num_cont_hb(i)
3024 do j=ielstart(i),ielend(i)
3025 call eelecij(i,j,ees,evdw1,eel_loc)
3027 num_cont_hb(i)=num_conti
3029 c write (iout,*) "Number of loop steps in EELEC:",ind
3031 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3032 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3034 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3035 ccc eel_loc=eel_loc+eello_turn3
3036 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3039 C-------------------------------------------------------------------------------
3040 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3041 implicit real*8 (a-h,o-z)
3042 include 'DIMENSIONS'
3046 include 'COMMON.CONTROL'
3047 include 'COMMON.IOUNITS'
3048 include 'COMMON.GEO'
3049 include 'COMMON.VAR'
3050 include 'COMMON.LOCAL'
3051 include 'COMMON.CHAIN'
3052 include 'COMMON.DERIV'
3053 include 'COMMON.INTERACT'
3054 include 'COMMON.CONTACTS'
3056 include 'COMMON.CONTACTS.MOMENT'
3058 include 'COMMON.TORSION'
3059 include 'COMMON.VECTORS'
3060 include 'COMMON.FFIELD'
3061 include 'COMMON.TIME1'
3062 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3063 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3064 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3065 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3066 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3067 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3069 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3071 double precision scal_el /1.0d0/
3073 double precision scal_el /0.5d0/
3076 C 13-go grudnia roku pamietnego...
3077 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3078 & 0.0d0,1.0d0,0.0d0,
3079 & 0.0d0,0.0d0,1.0d0/
3080 c time00=MPI_Wtime()
3081 cd write (iout,*) "eelecij",i,j
3085 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3086 aaa=app(iteli,itelj)
3087 bbb=bpp(iteli,itelj)
3088 ael6i=ael6(iteli,itelj)
3089 ael3i=ael3(iteli,itelj)
3093 dx_normj=dc_norm(1,j)
3094 dy_normj=dc_norm(2,j)
3095 dz_normj=dc_norm(3,j)
3096 xj=c(1,j)+0.5D0*dxj-xmedi
3097 yj=c(2,j)+0.5D0*dyj-ymedi
3098 zj=c(3,j)+0.5D0*dzj-zmedi
3099 rij=xj*xj+yj*yj+zj*zj
3105 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3106 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3107 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3108 fac=cosa-3.0D0*cosb*cosg
3110 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3111 if (j.eq.i+2) ev1=scal_el*ev1
3116 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3119 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3120 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3123 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3124 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3125 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3126 cd & xmedi,ymedi,zmedi,xj,yj,zj
3128 if (energy_dec) then
3129 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3130 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3134 C Calculate contributions to the Cartesian gradient.
3137 facvdw=-6*rrmij*(ev1+evdwij)
3138 facel=-3*rrmij*(el1+eesij)
3144 * Radial derivatives. First process both termini of the fragment (i,j)
3150 c ghalf=0.5D0*ggg(k)
3151 c gelc(k,i)=gelc(k,i)+ghalf
3152 c gelc(k,j)=gelc(k,j)+ghalf
3154 c 9/28/08 AL Gradient compotents will be summed only at the end
3156 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3157 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3160 * Loop over residues i+1 thru j-1.
3164 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3171 c ghalf=0.5D0*ggg(k)
3172 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3173 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3175 c 9/28/08 AL Gradient compotents will be summed only at the end
3177 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3178 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3181 * Loop over residues i+1 thru j-1.
3185 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3192 fac=-3*rrmij*(facvdw+facvdw+facel)
3197 * Radial derivatives. First process both termini of the fragment (i,j)
3203 c ghalf=0.5D0*ggg(k)
3204 c gelc(k,i)=gelc(k,i)+ghalf
3205 c gelc(k,j)=gelc(k,j)+ghalf
3207 c 9/28/08 AL Gradient compotents will be summed only at the end
3209 gelc_long(k,j)=gelc(k,j)+ggg(k)
3210 gelc_long(k,i)=gelc(k,i)-ggg(k)
3213 * Loop over residues i+1 thru j-1.
3217 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3220 c 9/28/08 AL Gradient compotents will be summed only at the end
3225 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3226 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3232 ecosa=2.0D0*fac3*fac1+fac4
3235 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3236 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3238 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3239 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3241 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3242 cd & (dcosg(k),k=1,3)
3244 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3247 c ghalf=0.5D0*ggg(k)
3248 c gelc(k,i)=gelc(k,i)+ghalf
3249 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3250 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3251 c gelc(k,j)=gelc(k,j)+ghalf
3252 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3253 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3257 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3262 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3263 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3265 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3266 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3267 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3268 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3270 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3271 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3272 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3274 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3275 C energy of a peptide unit is assumed in the form of a second-order
3276 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3277 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3278 C are computed for EVERY pair of non-contiguous peptide groups.
3280 if (j.lt.nres-1) then
3291 muij(kkk)=mu(k,i)*mu(l,j)
3294 cd write (iout,*) 'EELEC: i',i,' j',j
3295 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3296 cd write(iout,*) 'muij',muij
3297 ury=scalar(uy(1,i),erij)
3298 urz=scalar(uz(1,i),erij)
3299 vry=scalar(uy(1,j),erij)
3300 vrz=scalar(uz(1,j),erij)
3301 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3302 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3303 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3304 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3305 fac=dsqrt(-ael6i)*r3ij
3310 cd write (iout,'(4i5,4f10.5)')
3311 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3312 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3313 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3314 cd & uy(:,j),uz(:,j)
3315 cd write (iout,'(4f10.5)')
3316 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3317 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3318 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3319 cd write (iout,'(9f10.5/)')
3320 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3321 C Derivatives of the elements of A in virtual-bond vectors
3322 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3324 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3325 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3326 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3327 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3328 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3329 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3330 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3331 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3332 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3333 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3334 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3335 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3337 C Compute radial contributions to the gradient
3355 C Add the contributions coming from er
3358 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3359 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3360 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3361 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3364 C Derivatives in DC(i)
3365 cgrad ghalf1=0.5d0*agg(k,1)
3366 cgrad ghalf2=0.5d0*agg(k,2)
3367 cgrad ghalf3=0.5d0*agg(k,3)
3368 cgrad ghalf4=0.5d0*agg(k,4)
3369 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3370 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3371 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3372 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3373 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3374 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3375 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3376 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3377 C Derivatives in DC(i+1)
3378 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3379 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3380 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3381 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3382 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3383 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3384 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3385 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3386 C Derivatives in DC(j)
3387 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3388 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3389 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3390 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3391 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3392 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3393 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3394 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3395 C Derivatives in DC(j+1) or DC(nres-1)
3396 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3397 & -3.0d0*vryg(k,3)*ury)
3398 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3399 & -3.0d0*vrzg(k,3)*ury)
3400 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3401 & -3.0d0*vryg(k,3)*urz)
3402 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3403 & -3.0d0*vrzg(k,3)*urz)
3404 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3406 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3419 aggi(k,l)=-aggi(k,l)
3420 aggi1(k,l)=-aggi1(k,l)
3421 aggj(k,l)=-aggj(k,l)
3422 aggj1(k,l)=-aggj1(k,l)
3425 if (j.lt.nres-1) then
3431 aggi(k,l)=-aggi(k,l)
3432 aggi1(k,l)=-aggi1(k,l)
3433 aggj(k,l)=-aggj(k,l)
3434 aggj1(k,l)=-aggj1(k,l)
3445 aggi(k,l)=-aggi(k,l)
3446 aggi1(k,l)=-aggi1(k,l)
3447 aggj(k,l)=-aggj(k,l)
3448 aggj1(k,l)=-aggj1(k,l)
3453 IF (wel_loc.gt.0.0d0) THEN
3454 C Contribution to the local-electrostatic energy coming from the i-j pair
3455 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3457 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3459 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3460 & 'eelloc',i,j,eel_loc_ij
3462 eel_loc=eel_loc+eel_loc_ij
3463 C Partial derivatives in virtual-bond dihedral angles gamma
3465 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3466 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3467 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3468 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3469 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3470 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3471 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3473 ggg(l)=agg(l,1)*muij(1)+
3474 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3475 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3476 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3477 cgrad ghalf=0.5d0*ggg(l)
3478 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3479 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3483 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3486 C Remaining derivatives of eello
3488 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3489 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3490 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3491 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3492 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3493 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3494 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3495 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3498 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3499 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3500 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3501 & .and. num_conti.le.maxconts) then
3502 c write (iout,*) i,j," entered corr"
3504 C Calculate the contact function. The ith column of the array JCONT will
3505 C contain the numbers of atoms that make contacts with the atom I (of numbers
3506 C greater than I). The arrays FACONT and GACONT will contain the values of
3507 C the contact function and its derivative.
3508 c r0ij=1.02D0*rpp(iteli,itelj)
3509 c r0ij=1.11D0*rpp(iteli,itelj)
3510 r0ij=2.20D0*rpp(iteli,itelj)
3511 c r0ij=1.55D0*rpp(iteli,itelj)
3512 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3513 if (fcont.gt.0.0D0) then
3514 num_conti=num_conti+1
3515 if (num_conti.gt.maxconts) then
3516 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3517 & ' will skip next contacts for this conf.'
3519 jcont_hb(num_conti,i)=j
3520 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3521 cd & " jcont_hb",jcont_hb(num_conti,i)
3522 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3523 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3524 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3526 d_cont(num_conti,i)=rij
3527 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3528 C --- Electrostatic-interaction matrix ---
3529 a_chuj(1,1,num_conti,i)=a22
3530 a_chuj(1,2,num_conti,i)=a23
3531 a_chuj(2,1,num_conti,i)=a32
3532 a_chuj(2,2,num_conti,i)=a33
3533 C --- Gradient of rij
3535 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3542 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3543 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3544 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3545 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3546 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3551 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3552 C Calculate contact energies
3554 wij=cosa-3.0D0*cosb*cosg
3557 c fac3=dsqrt(-ael6i)/r0ij**3
3558 fac3=dsqrt(-ael6i)*r3ij
3559 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3560 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3561 if (ees0tmp.gt.0) then
3562 ees0pij=dsqrt(ees0tmp)
3566 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3567 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3568 if (ees0tmp.gt.0) then
3569 ees0mij=dsqrt(ees0tmp)
3574 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3575 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3576 C Diagnostics. Comment out or remove after debugging!
3577 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3578 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3579 c ees0m(num_conti,i)=0.0D0
3581 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3582 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3583 C Angular derivatives of the contact function
3584 ees0pij1=fac3/ees0pij
3585 ees0mij1=fac3/ees0mij
3586 fac3p=-3.0D0*fac3*rrmij
3587 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3588 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3590 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3591 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3592 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3593 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3594 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3595 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3596 ecosap=ecosa1+ecosa2
3597 ecosbp=ecosb1+ecosb2
3598 ecosgp=ecosg1+ecosg2
3599 ecosam=ecosa1-ecosa2
3600 ecosbm=ecosb1-ecosb2
3601 ecosgm=ecosg1-ecosg2
3610 facont_hb(num_conti,i)=fcont
3611 fprimcont=fprimcont/rij
3612 cd facont_hb(num_conti,i)=1.0D0
3613 C Following line is for diagnostics.
3616 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3617 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3620 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3621 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3623 gggp(1)=gggp(1)+ees0pijp*xj
3624 gggp(2)=gggp(2)+ees0pijp*yj
3625 gggp(3)=gggp(3)+ees0pijp*zj
3626 gggm(1)=gggm(1)+ees0mijp*xj
3627 gggm(2)=gggm(2)+ees0mijp*yj
3628 gggm(3)=gggm(3)+ees0mijp*zj
3629 C Derivatives due to the contact function
3630 gacont_hbr(1,num_conti,i)=fprimcont*xj
3631 gacont_hbr(2,num_conti,i)=fprimcont*yj
3632 gacont_hbr(3,num_conti,i)=fprimcont*zj
3635 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3636 c following the change of gradient-summation algorithm.
3638 cgrad ghalfp=0.5D0*gggp(k)
3639 cgrad ghalfm=0.5D0*gggm(k)
3640 gacontp_hb1(k,num_conti,i)=!ghalfp
3641 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3642 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3643 gacontp_hb2(k,num_conti,i)=!ghalfp
3644 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3645 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3646 gacontp_hb3(k,num_conti,i)=gggp(k)
3647 gacontm_hb1(k,num_conti,i)=!ghalfm
3648 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3649 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3650 gacontm_hb2(k,num_conti,i)=!ghalfm
3651 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3652 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3653 gacontm_hb3(k,num_conti,i)=gggm(k)
3655 C Diagnostics. Comment out or remove after debugging!
3657 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3658 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3659 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3660 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3661 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3662 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3665 endif ! num_conti.le.maxconts
3668 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3671 ghalf=0.5d0*agg(l,k)
3672 aggi(l,k)=aggi(l,k)+ghalf
3673 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3674 aggj(l,k)=aggj(l,k)+ghalf
3677 if (j.eq.nres-1 .and. i.lt.j-2) then
3680 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3685 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3688 C-----------------------------------------------------------------------------
3689 subroutine eturn3(i,eello_turn3)
3690 C Third- and fourth-order contributions from turns
3691 implicit real*8 (a-h,o-z)
3692 include 'DIMENSIONS'
3693 include 'COMMON.IOUNITS'
3694 include 'COMMON.GEO'
3695 include 'COMMON.VAR'
3696 include 'COMMON.LOCAL'
3697 include 'COMMON.CHAIN'
3698 include 'COMMON.DERIV'
3699 include 'COMMON.INTERACT'
3700 include 'COMMON.CONTACTS'
3702 include 'COMMON.CONTACTS.MOMENT'
3704 include 'COMMON.TORSION'
3705 include 'COMMON.VECTORS'
3706 include 'COMMON.FFIELD'
3707 include 'COMMON.CONTROL'
3709 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3710 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3711 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3712 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3713 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3714 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3715 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3718 c write (iout,*) "eturn3",i,j,j1,j2
3723 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3725 C Third-order contributions
3732 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3733 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3734 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3735 call transpose2(auxmat(1,1),auxmat1(1,1))
3736 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3737 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3738 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3739 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3740 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3741 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3742 cd & ' eello_turn3_num',4*eello_turn3_num
3743 C Derivatives in gamma(i)
3744 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3745 call transpose2(auxmat2(1,1),auxmat3(1,1))
3746 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3747 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3748 C Derivatives in gamma(i+1)
3749 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3750 call transpose2(auxmat2(1,1),auxmat3(1,1))
3751 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3752 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3753 & +0.5d0*(pizda(1,1)+pizda(2,2))
3754 C Cartesian derivatives
3756 c ghalf1=0.5d0*agg(l,1)
3757 c ghalf2=0.5d0*agg(l,2)
3758 c ghalf3=0.5d0*agg(l,3)
3759 c ghalf4=0.5d0*agg(l,4)
3760 a_temp(1,1)=aggi(l,1)!+ghalf1
3761 a_temp(1,2)=aggi(l,2)!+ghalf2
3762 a_temp(2,1)=aggi(l,3)!+ghalf3
3763 a_temp(2,2)=aggi(l,4)!+ghalf4
3764 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3765 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3766 & +0.5d0*(pizda(1,1)+pizda(2,2))
3767 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3768 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3769 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3770 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3771 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3772 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3773 & +0.5d0*(pizda(1,1)+pizda(2,2))
3774 a_temp(1,1)=aggj(l,1)!+ghalf1
3775 a_temp(1,2)=aggj(l,2)!+ghalf2
3776 a_temp(2,1)=aggj(l,3)!+ghalf3
3777 a_temp(2,2)=aggj(l,4)!+ghalf4
3778 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3779 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3780 & +0.5d0*(pizda(1,1)+pizda(2,2))
3781 a_temp(1,1)=aggj1(l,1)
3782 a_temp(1,2)=aggj1(l,2)
3783 a_temp(2,1)=aggj1(l,3)
3784 a_temp(2,2)=aggj1(l,4)
3785 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3786 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3787 & +0.5d0*(pizda(1,1)+pizda(2,2))
3791 C-------------------------------------------------------------------------------
3792 subroutine eturn4(i,eello_turn4)
3793 C Third- and fourth-order contributions from turns
3794 implicit real*8 (a-h,o-z)
3795 include 'DIMENSIONS'
3796 include 'COMMON.IOUNITS'
3797 include 'COMMON.GEO'
3798 include 'COMMON.VAR'
3799 include 'COMMON.LOCAL'
3800 include 'COMMON.CHAIN'
3801 include 'COMMON.DERIV'
3802 include 'COMMON.INTERACT'
3803 include 'COMMON.CONTACTS'
3805 include 'COMMON.CONTACTS.MOMENT'
3807 include 'COMMON.TORSION'
3808 include 'COMMON.VECTORS'
3809 include 'COMMON.FFIELD'
3810 include 'COMMON.CONTROL'
3812 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3813 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3814 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3815 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3816 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3817 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3818 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3821 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3823 C Fourth-order contributions
3831 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3832 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3833 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3838 iti1=itortyp(itype(i+1))
3839 iti2=itortyp(itype(i+2))
3840 iti3=itortyp(itype(i+3))
3841 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3842 call transpose2(EUg(1,1,i+1),e1t(1,1))
3843 call transpose2(Eug(1,1,i+2),e2t(1,1))
3844 call transpose2(Eug(1,1,i+3),e3t(1,1))
3845 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3846 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3847 s1=scalar2(b1(1,iti2),auxvec(1))
3848 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3849 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3850 s2=scalar2(b1(1,iti1),auxvec(1))
3851 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3852 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3853 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3854 eello_turn4=eello_turn4-(s1+s2+s3)
3855 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3856 & 'eturn4',i,j,-(s1+s2+s3)
3857 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3858 cd & ' eello_turn4_num',8*eello_turn4_num
3859 C Derivatives in gamma(i)
3860 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3861 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3862 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3863 s1=scalar2(b1(1,iti2),auxvec(1))
3864 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3865 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3866 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3867 C Derivatives in gamma(i+1)
3868 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3869 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3870 s2=scalar2(b1(1,iti1),auxvec(1))
3871 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3872 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3873 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3874 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3875 C Derivatives in gamma(i+2)
3876 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3877 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3878 s1=scalar2(b1(1,iti2),auxvec(1))
3879 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3880 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3881 s2=scalar2(b1(1,iti1),auxvec(1))
3882 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3883 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3884 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3885 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3886 C Cartesian derivatives
3887 C Derivatives of this turn contributions in DC(i+2)
3888 if (j.lt.nres-1) then
3890 a_temp(1,1)=agg(l,1)
3891 a_temp(1,2)=agg(l,2)
3892 a_temp(2,1)=agg(l,3)
3893 a_temp(2,2)=agg(l,4)
3894 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3895 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3896 s1=scalar2(b1(1,iti2),auxvec(1))
3897 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3898 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3899 s2=scalar2(b1(1,iti1),auxvec(1))
3900 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3901 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3902 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3904 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3907 C Remaining derivatives of this turn contribution
3909 a_temp(1,1)=aggi(l,1)
3910 a_temp(1,2)=aggi(l,2)
3911 a_temp(2,1)=aggi(l,3)
3912 a_temp(2,2)=aggi(l,4)
3913 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3914 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3915 s1=scalar2(b1(1,iti2),auxvec(1))
3916 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3917 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3918 s2=scalar2(b1(1,iti1),auxvec(1))
3919 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3920 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3921 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3922 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3923 a_temp(1,1)=aggi1(l,1)
3924 a_temp(1,2)=aggi1(l,2)
3925 a_temp(2,1)=aggi1(l,3)
3926 a_temp(2,2)=aggi1(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,iti2),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,iti1),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))
3936 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3937 a_temp(1,1)=aggj(l,1)
3938 a_temp(1,2)=aggj(l,2)
3939 a_temp(2,1)=aggj(l,3)
3940 a_temp(2,2)=aggj(l,4)
3941 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3942 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3943 s1=scalar2(b1(1,iti2),auxvec(1))
3944 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3945 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3946 s2=scalar2(b1(1,iti1),auxvec(1))
3947 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3948 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3949 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3950 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3951 a_temp(1,1)=aggj1(l,1)
3952 a_temp(1,2)=aggj1(l,2)
3953 a_temp(2,1)=aggj1(l,3)
3954 a_temp(2,2)=aggj1(l,4)
3955 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3956 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3957 s1=scalar2(b1(1,iti2),auxvec(1))
3958 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3959 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3960 s2=scalar2(b1(1,iti1),auxvec(1))
3961 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3962 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3963 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3964 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3965 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3969 C-----------------------------------------------------------------------------
3970 subroutine vecpr(u,v,w)
3971 implicit real*8(a-h,o-z)
3972 dimension u(3),v(3),w(3)
3973 w(1)=u(2)*v(3)-u(3)*v(2)
3974 w(2)=-u(1)*v(3)+u(3)*v(1)
3975 w(3)=u(1)*v(2)-u(2)*v(1)
3978 C-----------------------------------------------------------------------------
3979 subroutine unormderiv(u,ugrad,unorm,ungrad)
3980 C This subroutine computes the derivatives of a normalized vector u, given
3981 C the derivatives computed without normalization conditions, ugrad. Returns
3984 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3985 double precision vec(3)
3986 double precision scalar
3988 c write (2,*) 'ugrad',ugrad
3991 vec(i)=scalar(ugrad(1,i),u(1))
3993 c write (2,*) 'vec',vec
3996 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3999 c write (2,*) 'ungrad',ungrad
4002 C-----------------------------------------------------------------------------
4003 subroutine escp_soft_sphere(evdw2,evdw2_14)
4005 C This subroutine calculates the excluded-volume interaction energy between
4006 C peptide-group centers and side chains and its gradient in virtual-bond and
4007 C side-chain vectors.
4009 implicit real*8 (a-h,o-z)
4010 include 'DIMENSIONS'
4011 include 'COMMON.GEO'
4012 include 'COMMON.VAR'
4013 include 'COMMON.LOCAL'
4014 include 'COMMON.CHAIN'
4015 include 'COMMON.DERIV'
4016 include 'COMMON.INTERACT'
4017 include 'COMMON.FFIELD'
4018 include 'COMMON.IOUNITS'
4019 include 'COMMON.CONTROL'
4024 cd print '(a)','Enter ESCP'
4025 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4026 do i=iatscp_s,iatscp_e
4028 xi=0.5D0*(c(1,i)+c(1,i+1))
4029 yi=0.5D0*(c(2,i)+c(2,i+1))
4030 zi=0.5D0*(c(3,i)+c(3,i+1))
4032 do iint=1,nscp_gr(i)
4034 do j=iscpstart(i,iint),iscpend(i,iint)
4036 C Uncomment following three lines for SC-p interactions
4040 C Uncomment following three lines for Ca-p interactions
4044 rij=xj*xj+yj*yj+zj*zj
4047 if (rij.lt.r0ijsq) then
4048 evdwij=0.25d0*(rij-r0ijsq)**2
4056 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4061 cgrad if (j.lt.i) then
4062 cd write (iout,*) 'j<i'
4063 C Uncomment following three lines for SC-p interactions
4065 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4068 cd write (iout,*) 'j>i'
4070 cgrad ggg(k)=-ggg(k)
4071 C Uncomment following line for SC-p interactions
4072 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4076 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4078 cgrad kstart=min0(i+1,j)
4079 cgrad kend=max0(i-1,j-1)
4080 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4081 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4082 cgrad do k=kstart,kend
4084 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4088 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4089 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4097 C-----------------------------------------------------------------------------
4098 subroutine escp(evdw2,evdw2_14)
4100 C This subroutine calculates the excluded-volume interaction energy between
4101 C peptide-group centers and side chains and its gradient in virtual-bond and
4102 C side-chain vectors.
4104 implicit real*8 (a-h,o-z)
4105 include 'DIMENSIONS'
4106 include 'COMMON.GEO'
4107 include 'COMMON.VAR'
4108 include 'COMMON.LOCAL'
4109 include 'COMMON.CHAIN'
4110 include 'COMMON.DERIV'
4111 include 'COMMON.INTERACT'
4112 include 'COMMON.FFIELD'
4113 include 'COMMON.IOUNITS'
4114 include 'COMMON.CONTROL'
4118 cd print '(a)','Enter ESCP'
4119 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4120 do i=iatscp_s,iatscp_e
4122 xi=0.5D0*(c(1,i)+c(1,i+1))
4123 yi=0.5D0*(c(2,i)+c(2,i+1))
4124 zi=0.5D0*(c(3,i)+c(3,i+1))
4126 do iint=1,nscp_gr(i)
4128 do j=iscpstart(i,iint),iscpend(i,iint)
4130 C Uncomment following three lines for SC-p interactions
4134 C Uncomment following three lines for Ca-p interactions
4138 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4140 e1=fac*fac*aad(itypj,iteli)
4141 e2=fac*bad(itypj,iteli)
4142 if (iabs(j-i) .le. 2) then
4145 evdw2_14=evdw2_14+e1+e2
4149 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4150 & 'evdw2',i,j,evdwij
4152 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4154 fac=-(evdwij+e1)*rrij
4158 cgrad if (j.lt.i) then
4159 cd write (iout,*) 'j<i'
4160 C Uncomment following three lines for SC-p interactions
4162 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4165 cd write (iout,*) 'j>i'
4167 cgrad ggg(k)=-ggg(k)
4168 C Uncomment following line for SC-p interactions
4169 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4170 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4174 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4176 cgrad kstart=min0(i+1,j)
4177 cgrad kend=max0(i-1,j-1)
4178 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4179 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4180 cgrad do k=kstart,kend
4182 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4186 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4187 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4195 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4196 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4197 gradx_scp(j,i)=expon*gradx_scp(j,i)
4200 C******************************************************************************
4204 C To save time the factor EXPON has been extracted from ALL components
4205 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4208 C******************************************************************************
4211 C--------------------------------------------------------------------------
4212 subroutine edis(ehpb)
4214 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4216 implicit real*8 (a-h,o-z)
4217 include 'DIMENSIONS'
4218 include 'COMMON.SBRIDGE'
4219 include 'COMMON.CHAIN'
4220 include 'COMMON.DERIV'
4221 include 'COMMON.VAR'
4222 include 'COMMON.INTERACT'
4223 include 'COMMON.IOUNITS'
4226 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4227 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4228 if (link_end.eq.0) return
4229 do i=link_start,link_end
4230 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4231 C CA-CA distance used in regularization of structure.
4234 C iii and jjj point to the residues for which the distance is assigned.
4235 if (ii.gt.nres) then
4242 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4243 c & dhpb(i),dhpb1(i),forcon(i)
4244 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4245 C distance and angle dependent SS bond potential.
4246 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4247 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4250 & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4251 call ssbond_ene(iii,jjj,eij)
4254 cd write (iout,*) "eij",eij
4255 else if (ii.gt.nres .and. jj.gt.nres) then
4256 c Restraints from contact prediction
4258 if (dhpb1(i).gt.0.0d0) then
4259 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4260 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4261 c write (iout,*) "beta nmr",
4262 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4266 C Get the force constant corresponding to this distance.
4268 C Calculate the contribution to energy.
4269 ehpb=ehpb+waga*rdis*rdis
4270 c write (iout,*) "beta reg",dd,waga*rdis*rdis
4272 C Evaluate gradient.
4277 ggg(j)=fac*(c(j,jj)-c(j,ii))
4280 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4281 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4284 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4285 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4288 C Calculate the distance between the two points and its difference from the
4291 if (dhpb1(i).gt.0.0d0) then
4292 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4293 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
4294 c write (iout,*) "alph nmr",
4295 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
4298 C Get the force constant corresponding to this distance.
4300 C Calculate the contribution to energy.
4301 ehpb=ehpb+waga*rdis*rdis
4302 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
4304 C Evaluate gradient.
4308 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4309 cd & ' waga=',waga,' fac=',fac
4311 ggg(j)=fac*(c(j,jj)-c(j,ii))
4313 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4314 C If this is a SC-SC distance, we need to calculate the contributions to the
4315 C Cartesian gradient in the SC vectors (ghpbx).
4318 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4319 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4322 cgrad do j=iii,jjj-1
4324 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4328 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4329 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4336 C--------------------------------------------------------------------------
4337 subroutine ssbond_ene(i,j,eij)
4339 C Calculate the distance and angle dependent SS-bond potential energy
4340 C using a free-energy function derived based on RHF/6-31G** ab initio
4341 C calculations of diethyl disulfide.
4343 C A. Liwo and U. Kozlowska, 11/24/03
4345 implicit real*8 (a-h,o-z)
4346 include 'DIMENSIONS'
4347 include 'COMMON.SBRIDGE'
4348 include 'COMMON.CHAIN'
4349 include 'COMMON.DERIV'
4350 include 'COMMON.LOCAL'
4351 include 'COMMON.INTERACT'
4352 include 'COMMON.VAR'
4353 include 'COMMON.IOUNITS'
4354 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4359 dxi=dc_norm(1,nres+i)
4360 dyi=dc_norm(2,nres+i)
4361 dzi=dc_norm(3,nres+i)
4362 c dsci_inv=dsc_inv(itypi)
4363 dsci_inv=vbld_inv(nres+i)
4365 c dscj_inv=dsc_inv(itypj)
4366 dscj_inv=vbld_inv(nres+j)
4370 dxj=dc_norm(1,nres+j)
4371 dyj=dc_norm(2,nres+j)
4372 dzj=dc_norm(3,nres+j)
4373 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4378 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4379 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4380 om12=dxi*dxj+dyi*dyj+dzi*dzj
4382 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4383 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4389 deltat12=om2-om1+2.0d0
4391 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4392 & +akct*deltad*deltat12
4393 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4394 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4395 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4396 c & " deltat12",deltat12," eij",eij
4397 ed=2*akcm*deltad+akct*deltat12
4399 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4400 eom1=-2*akth*deltat1-pom1-om2*pom2
4401 eom2= 2*akth*deltat2+pom1-om1*pom2
4404 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4405 ghpbx(k,i)=ghpbx(k,i)-ggk
4406 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4407 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4408 ghpbx(k,j)=ghpbx(k,j)+ggk
4409 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4410 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4411 ghpbc(k,i)=ghpbc(k,i)-ggk
4412 ghpbc(k,j)=ghpbc(k,j)+ggk
4415 C Calculate the components of the gradient in DC and X
4419 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4424 C--------------------------------------------------------------------------
4425 subroutine ebond(estr)
4427 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4429 implicit real*8 (a-h,o-z)
4430 include 'DIMENSIONS'
4431 include 'COMMON.LOCAL'
4432 include 'COMMON.GEO'
4433 include 'COMMON.INTERACT'
4434 include 'COMMON.DERIV'
4435 include 'COMMON.VAR'
4436 include 'COMMON.CHAIN'
4437 include 'COMMON.IOUNITS'
4438 include 'COMMON.NAMES'
4439 include 'COMMON.FFIELD'
4440 include 'COMMON.CONTROL'
4441 include 'COMMON.SETUP'
4442 double precision u(3),ud(3)
4444 do i=ibondp_start,ibondp_end
4445 diff = vbld(i)-vbldp0
4446 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4449 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4451 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4455 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4457 do i=ibond_start,ibond_end
4462 diff=vbld(i+nres)-vbldsc0(1,iti)
4463 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4464 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4465 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4467 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4471 diff=vbld(i+nres)-vbldsc0(j,iti)
4472 ud(j)=aksc(j,iti)*diff
4473 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4487 uprod2=uprod2*u(k)*u(k)
4491 usumsqder=usumsqder+ud(j)*uprod2
4493 estr=estr+uprod/usum
4495 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4503 C--------------------------------------------------------------------------
4504 subroutine ebend(etheta)
4506 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4507 C angles gamma and its derivatives in consecutive thetas and gammas.
4509 implicit real*8 (a-h,o-z)
4510 include 'DIMENSIONS'
4511 include 'COMMON.LOCAL'
4512 include 'COMMON.GEO'
4513 include 'COMMON.INTERACT'
4514 include 'COMMON.DERIV'
4515 include 'COMMON.VAR'
4516 include 'COMMON.CHAIN'
4517 include 'COMMON.IOUNITS'
4518 include 'COMMON.NAMES'
4519 include 'COMMON.FFIELD'
4520 include 'COMMON.CONTROL'
4521 common /calcthet/ term1,term2,termm,diffak,ratak,
4522 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4523 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4524 double precision y(2),z(2)
4526 c time11=dexp(-2*time)
4529 c write (*,'(a,i2)') 'EBEND ICG=',icg
4530 do i=ithet_start,ithet_end
4531 C Zero the energy function and its derivative at 0 or pi.
4532 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4537 if (phii.ne.phii) phii=150.0
4550 if (phii1.ne.phii1) phii1=150.0
4562 C Calculate the "mean" value of theta from the part of the distribution
4563 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4564 C In following comments this theta will be referred to as t_c.
4565 thet_pred_mean=0.0d0
4569 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4571 dthett=thet_pred_mean*ssd
4572 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4573 C Derivatives of the "mean" values in gamma1 and gamma2.
4574 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4575 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4576 if (theta(i).gt.pi-delta) then
4577 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4579 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4580 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4581 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4583 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4585 else if (theta(i).lt.delta) then
4586 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4587 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4588 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4590 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4591 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4594 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4597 etheta=etheta+ethetai
4598 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4600 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4601 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4602 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4604 C Ufff.... We've done all this!!!
4607 C---------------------------------------------------------------------------
4608 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4610 implicit real*8 (a-h,o-z)
4611 include 'DIMENSIONS'
4612 include 'COMMON.LOCAL'
4613 include 'COMMON.IOUNITS'
4614 common /calcthet/ term1,term2,termm,diffak,ratak,
4615 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4616 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4617 C Calculate the contributions to both Gaussian lobes.
4618 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4619 C The "polynomial part" of the "standard deviation" of this part of
4623 sig=sig*thet_pred_mean+polthet(j,it)
4625 C Derivative of the "interior part" of the "standard deviation of the"
4626 C gamma-dependent Gaussian lobe in t_c.
4627 sigtc=3*polthet(3,it)
4629 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4632 C Set the parameters of both Gaussian lobes of the distribution.
4633 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4634 fac=sig*sig+sigc0(it)
4637 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4638 sigsqtc=-4.0D0*sigcsq*sigtc
4639 c print *,i,sig,sigtc,sigsqtc
4640 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4641 sigtc=-sigtc/(fac*fac)
4642 C Following variable is sigma(t_c)**(-2)
4643 sigcsq=sigcsq*sigcsq
4645 sig0inv=1.0D0/sig0i**2
4646 delthec=thetai-thet_pred_mean
4647 delthe0=thetai-theta0i
4648 term1=-0.5D0*sigcsq*delthec*delthec
4649 term2=-0.5D0*sig0inv*delthe0*delthe0
4650 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4651 C NaNs in taking the logarithm. We extract the largest exponent which is added
4652 C to the energy (this being the log of the distribution) at the end of energy
4653 C term evaluation for this virtual-bond angle.
4654 if (term1.gt.term2) then
4656 term2=dexp(term2-termm)
4660 term1=dexp(term1-termm)
4663 C The ratio between the gamma-independent and gamma-dependent lobes of
4664 C the distribution is a Gaussian function of thet_pred_mean too.
4665 diffak=gthet(2,it)-thet_pred_mean
4666 ratak=diffak/gthet(3,it)**2
4667 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4668 C Let's differentiate it in thet_pred_mean NOW.
4670 C Now put together the distribution terms to make complete distribution.
4671 termexp=term1+ak*term2
4672 termpre=sigc+ak*sig0i
4673 C Contribution of the bending energy from this theta is just the -log of
4674 C the sum of the contributions from the two lobes and the pre-exponential
4675 C factor. Simple enough, isn't it?
4676 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4677 C NOW the derivatives!!!
4678 C 6/6/97 Take into account the deformation.
4679 E_theta=(delthec*sigcsq*term1
4680 & +ak*delthe0*sig0inv*term2)/termexp
4681 E_tc=((sigtc+aktc*sig0i)/termpre
4682 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4683 & aktc*term2)/termexp)
4686 c-----------------------------------------------------------------------------
4687 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4688 implicit real*8 (a-h,o-z)
4689 include 'DIMENSIONS'
4690 include 'COMMON.LOCAL'
4691 include 'COMMON.IOUNITS'
4692 common /calcthet/ term1,term2,termm,diffak,ratak,
4693 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4694 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4695 delthec=thetai-thet_pred_mean
4696 delthe0=thetai-theta0i
4697 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4698 t3 = thetai-thet_pred_mean
4702 t14 = t12+t6*sigsqtc
4704 t21 = thetai-theta0i
4710 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4711 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4712 & *(-t12*t9-ak*sig0inv*t27)
4716 C--------------------------------------------------------------------------
4717 subroutine ebend(etheta)
4719 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4720 C angles gamma and its derivatives in consecutive thetas and gammas.
4721 C ab initio-derived potentials from
4722 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4724 implicit real*8 (a-h,o-z)
4725 include 'DIMENSIONS'
4726 include 'COMMON.LOCAL'
4727 include 'COMMON.GEO'
4728 include 'COMMON.INTERACT'
4729 include 'COMMON.DERIV'
4730 include 'COMMON.VAR'
4731 include 'COMMON.CHAIN'
4732 include 'COMMON.IOUNITS'
4733 include 'COMMON.NAMES'
4734 include 'COMMON.FFIELD'
4735 include 'COMMON.CONTROL'
4736 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4737 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4738 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4739 & sinph1ph2(maxdouble,maxdouble)
4740 logical lprn /.false./, lprn1 /.false./
4742 do i=ithet_start,ithet_end
4746 theti2=0.5d0*theta(i)
4747 ityp2=ithetyp(itype(i-1))
4749 coskt(k)=dcos(k*theti2)
4750 sinkt(k)=dsin(k*theti2)
4755 if (phii.ne.phii) phii=150.0
4759 ityp1=ithetyp(itype(i-2))
4761 cosph1(k)=dcos(k*phii)
4762 sinph1(k)=dsin(k*phii)
4775 if (phii1.ne.phii1) phii1=150.0
4780 ityp3=ithetyp(itype(i))
4782 cosph2(k)=dcos(k*phii1)
4783 sinph2(k)=dsin(k*phii1)
4793 ethetai=aa0thet(ityp1,ityp2,ityp3)
4796 ccl=cosph1(l)*cosph2(k-l)
4797 ssl=sinph1(l)*sinph2(k-l)
4798 scl=sinph1(l)*cosph2(k-l)
4799 csl=cosph1(l)*sinph2(k-l)
4800 cosph1ph2(l,k)=ccl-ssl
4801 cosph1ph2(k,l)=ccl+ssl
4802 sinph1ph2(l,k)=scl+csl
4803 sinph1ph2(k,l)=scl-csl
4807 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4808 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4809 write (iout,*) "coskt and sinkt"
4811 write (iout,*) k,coskt(k),sinkt(k)
4815 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4816 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4819 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4820 & " ethetai",ethetai
4823 write (iout,*) "cosph and sinph"
4825 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4827 write (iout,*) "cosph1ph2 and sinph2ph2"
4830 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4831 & sinph1ph2(l,k),sinph1ph2(k,l)
4834 write(iout,*) "ethetai",ethetai
4838 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4839 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4840 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4841 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4842 ethetai=ethetai+sinkt(m)*aux
4843 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4844 dephii=dephii+k*sinkt(m)*(
4845 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4846 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4847 dephii1=dephii1+k*sinkt(m)*(
4848 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4849 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4851 & write (iout,*) "m",m," k",k," bbthet",
4852 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4853 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4854 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4855 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4859 & write(iout,*) "ethetai",ethetai
4863 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4864 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4865 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4866 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4867 ethetai=ethetai+sinkt(m)*aux
4868 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4869 dephii=dephii+l*sinkt(m)*(
4870 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4871 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4872 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4873 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4874 dephii1=dephii1+(k-l)*sinkt(m)*(
4875 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4876 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4877 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4878 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4880 write (iout,*) "m",m," k",k," l",l," ffthet",
4881 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4882 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4883 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4884 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4885 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4886 & cosph1ph2(k,l)*sinkt(m),
4887 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4893 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4894 & i,theta(i)*rad2deg,phii*rad2deg,
4895 & phii1*rad2deg,ethetai
4896 etheta=etheta+ethetai
4897 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4898 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4899 gloc(nphi+i-2,icg)=wang*dethetai
4905 c-----------------------------------------------------------------------------
4906 subroutine esc(escloc)
4907 C Calculate the local energy of a side chain and its derivatives in the
4908 C corresponding virtual-bond valence angles THETA and the spherical angles
4910 implicit real*8 (a-h,o-z)
4911 include 'DIMENSIONS'
4912 include 'COMMON.GEO'
4913 include 'COMMON.LOCAL'
4914 include 'COMMON.VAR'
4915 include 'COMMON.INTERACT'
4916 include 'COMMON.DERIV'
4917 include 'COMMON.CHAIN'
4918 include 'COMMON.IOUNITS'
4919 include 'COMMON.NAMES'
4920 include 'COMMON.FFIELD'
4921 include 'COMMON.CONTROL'
4922 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4923 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4924 common /sccalc/ time11,time12,time112,theti,it,nlobit
4927 c write (iout,'(a)') 'ESC'
4928 do i=loc_start,loc_end
4930 if (it.eq.10) goto 1
4932 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4933 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4934 theti=theta(i+1)-pipol
4939 if (x(2).gt.pi-delta) then
4943 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4945 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4946 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4948 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4949 & ddersc0(1),dersc(1))
4950 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4951 & ddersc0(3),dersc(3))
4953 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4955 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4956 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4957 & dersc0(2),esclocbi,dersc02)
4958 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4960 call splinthet(x(2),0.5d0*delta,ss,ssd)
4965 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4967 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4968 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4970 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4972 c write (iout,*) escloci
4973 else if (x(2).lt.delta) then
4977 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4979 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4980 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4982 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4983 & ddersc0(1),dersc(1))
4984 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4985 & ddersc0(3),dersc(3))
4987 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4989 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4990 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4991 & dersc0(2),esclocbi,dersc02)
4992 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4997 call splinthet(x(2),0.5d0*delta,ss,ssd)
4999 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5001 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5002 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5004 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5005 c write (iout,*) escloci
5007 call enesc(x,escloci,dersc,ddummy,.false.)
5010 escloc=escloc+escloci
5011 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5012 & 'escloc',i,escloci
5013 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5015 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5017 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5018 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5023 C---------------------------------------------------------------------------
5024 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5025 implicit real*8 (a-h,o-z)
5026 include 'DIMENSIONS'
5027 include 'COMMON.GEO'
5028 include 'COMMON.LOCAL'
5029 include 'COMMON.IOUNITS'
5030 common /sccalc/ time11,time12,time112,theti,it,nlobit
5031 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5032 double precision contr(maxlob,-1:1)
5034 c write (iout,*) 'it=',it,' nlobit=',nlobit
5038 if (mixed) ddersc(j)=0.0d0
5042 C Because of periodicity of the dependence of the SC energy in omega we have
5043 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5044 C To avoid underflows, first compute & store the exponents.
5052 z(k)=x(k)-censc(k,j,it)
5057 Axk=Axk+gaussc(l,k,j,it)*z(l)
5063 expfac=expfac+Ax(k,j,iii)*z(k)
5071 C As in the case of ebend, we want to avoid underflows in exponentiation and
5072 C subsequent NaNs and INFs in energy calculation.
5073 C Find the largest exponent
5077 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5081 cd print *,'it=',it,' emin=',emin
5083 C Compute the contribution to SC energy and derivatives
5088 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
5089 if(adexp.ne.adexp) adexp=1.0
5092 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
5094 cd print *,'j=',j,' expfac=',expfac
5095 escloc_i=escloc_i+expfac
5097 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5101 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5102 & +gaussc(k,2,j,it))*expfac
5109 dersc(1)=dersc(1)/cos(theti)**2
5110 ddersc(1)=ddersc(1)/cos(theti)**2
5113 escloci=-(dlog(escloc_i)-emin)
5115 dersc(j)=dersc(j)/escloc_i
5119 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5124 C------------------------------------------------------------------------------
5125 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5126 implicit real*8 (a-h,o-z)
5127 include 'DIMENSIONS'
5128 include 'COMMON.GEO'
5129 include 'COMMON.LOCAL'
5130 include 'COMMON.IOUNITS'
5131 common /sccalc/ time11,time12,time112,theti,it,nlobit
5132 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5133 double precision contr(maxlob)
5144 z(k)=x(k)-censc(k,j,it)
5150 Axk=Axk+gaussc(l,k,j,it)*z(l)
5156 expfac=expfac+Ax(k,j)*z(k)
5161 C As in the case of ebend, we want to avoid underflows in exponentiation and
5162 C subsequent NaNs and INFs in energy calculation.
5163 C Find the largest exponent
5166 if (emin.gt.contr(j)) emin=contr(j)
5170 C Compute the contribution to SC energy and derivatives
5174 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
5175 escloc_i=escloc_i+expfac
5177 dersc(k)=dersc(k)+Ax(k,j)*expfac
5179 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5180 & +gaussc(1,2,j,it))*expfac
5184 dersc(1)=dersc(1)/cos(theti)**2
5185 dersc12=dersc12/cos(theti)**2
5186 escloci=-(dlog(escloc_i)-emin)
5188 dersc(j)=dersc(j)/escloc_i
5190 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5194 c----------------------------------------------------------------------------------
5195 subroutine esc(escloc)
5196 C Calculate the local energy of a side chain and its derivatives in the
5197 C corresponding virtual-bond valence angles THETA and the spherical angles
5198 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5199 C added by Urszula Kozlowska. 07/11/2007
5201 implicit real*8 (a-h,o-z)
5202 include 'DIMENSIONS'
5203 include 'COMMON.GEO'
5204 include 'COMMON.LOCAL'
5205 include 'COMMON.VAR'
5206 include 'COMMON.SCROT'
5207 include 'COMMON.INTERACT'
5208 include 'COMMON.DERIV'
5209 include 'COMMON.CHAIN'
5210 include 'COMMON.IOUNITS'
5211 include 'COMMON.NAMES'
5212 include 'COMMON.FFIELD'
5213 include 'COMMON.CONTROL'
5214 include 'COMMON.VECTORS'
5215 double precision x_prime(3),y_prime(3),z_prime(3)
5216 & , sumene,dsc_i,dp2_i,x(65),
5217 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5218 & de_dxx,de_dyy,de_dzz,de_dt
5219 double precision s1_t,s1_6_t,s2_t,s2_6_t
5221 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5222 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5223 & dt_dCi(3),dt_dCi1(3)
5224 common /sccalc/ time11,time12,time112,theti,it,nlobit
5227 do i=loc_start,loc_end
5228 costtab(i+1) =dcos(theta(i+1))
5229 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5230 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5231 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5232 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5233 cosfac=dsqrt(cosfac2)
5234 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5235 sinfac=dsqrt(sinfac2)
5237 if (it.eq.10) goto 1
5239 C Compute the axes of tghe local cartesian coordinates system; store in
5240 c x_prime, y_prime and z_prime
5247 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5248 C & dc_norm(3,i+nres)
5250 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5251 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5254 z_prime(j) = -uz(j,i-1)
5257 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5258 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5259 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5260 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5261 c & " xy",scalar(x_prime(1),y_prime(1)),
5262 c & " xz",scalar(x_prime(1),z_prime(1)),
5263 c & " yy",scalar(y_prime(1),y_prime(1)),
5264 c & " yz",scalar(y_prime(1),z_prime(1)),
5265 c & " zz",scalar(z_prime(1),z_prime(1))
5267 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5268 C to local coordinate system. Store in xx, yy, zz.
5274 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5275 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5276 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5283 C Compute the energy of the ith side cbain
5285 c write (2,*) "xx",xx," yy",yy," zz",zz
5288 x(j) = sc_parmin(j,it)
5291 Cc diagnostics - remove later
5293 yy1 = dsin(alph(2))*dcos(omeg(2))
5294 zz1 = -dsin(alph(2))*dsin(omeg(2))
5295 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5296 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5298 C," --- ", xx_w,yy_w,zz_w
5301 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5302 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5304 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5305 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5307 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5308 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5309 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5310 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5311 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5313 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5314 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5315 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5316 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5317 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5319 dsc_i = 0.743d0+x(61)
5321 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5322 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5323 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5324 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5325 s1=(1+x(63))/(0.1d0 + dscp1)
5326 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5327 s2=(1+x(65))/(0.1d0 + dscp2)
5328 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5329 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5330 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5331 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5333 c & dscp1,dscp2,sumene
5334 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5335 escloc = escloc + sumene
5336 c write (2,*) "i",i," escloc",sumene,escloc
5339 C This section to check the numerical derivatives of the energy of ith side
5340 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5341 C #define DEBUG in the code to turn it on.
5343 write (2,*) "sumene =",sumene
5347 write (2,*) xx,yy,zz
5348 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5349 de_dxx_num=(sumenep-sumene)/aincr
5351 write (2,*) "xx+ sumene from enesc=",sumenep
5354 write (2,*) xx,yy,zz
5355 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5356 de_dyy_num=(sumenep-sumene)/aincr
5358 write (2,*) "yy+ sumene from enesc=",sumenep
5361 write (2,*) xx,yy,zz
5362 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5363 de_dzz_num=(sumenep-sumene)/aincr
5365 write (2,*) "zz+ sumene from enesc=",sumenep
5366 costsave=cost2tab(i+1)
5367 sintsave=sint2tab(i+1)
5368 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5369 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5370 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5371 de_dt_num=(sumenep-sumene)/aincr
5372 write (2,*) " t+ sumene from enesc=",sumenep
5373 cost2tab(i+1)=costsave
5374 sint2tab(i+1)=sintsave
5375 C End of diagnostics section.
5378 C Compute the gradient of esc
5380 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5381 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5382 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5383 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5384 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5385 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5386 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5387 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5388 pom1=(sumene3*sint2tab(i+1)+sumene1)
5389 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5390 pom2=(sumene4*cost2tab(i+1)+sumene2)
5391 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5392 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5393 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5394 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5396 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5397 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5398 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5400 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5401 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5402 & +(pom1+pom2)*pom_dx
5404 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5407 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5408 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5409 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5411 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5412 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5413 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5414 & +x(59)*zz**2 +x(60)*xx*zz
5415 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5416 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5417 & +(pom1-pom2)*pom_dy
5419 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5422 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5423 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5424 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5425 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5426 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5427 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5428 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5429 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5431 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5434 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5435 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5436 & +pom1*pom_dt1+pom2*pom_dt2
5438 write(2,*), "de_dt = ", de_dt,de_dt_num
5442 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5443 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5444 cosfac2xx=cosfac2*xx
5445 sinfac2yy=sinfac2*yy
5447 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5449 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5451 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5452 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5453 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5454 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5455 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5456 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5457 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5458 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5459 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5460 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5464 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5465 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5468 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5469 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5470 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5472 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5473 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5477 dXX_Ctab(k,i)=dXX_Ci(k)
5478 dXX_C1tab(k,i)=dXX_Ci1(k)
5479 dYY_Ctab(k,i)=dYY_Ci(k)
5480 dYY_C1tab(k,i)=dYY_Ci1(k)
5481 dZZ_Ctab(k,i)=dZZ_Ci(k)
5482 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5483 dXX_XYZtab(k,i)=dXX_XYZ(k)
5484 dYY_XYZtab(k,i)=dYY_XYZ(k)
5485 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5489 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5490 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5491 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5492 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5493 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5495 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5496 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5497 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5498 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5499 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5500 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5501 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5502 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5504 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5505 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5507 C to check gradient call subroutine check_grad
5513 c------------------------------------------------------------------------------
5514 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5516 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5517 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5518 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5519 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5521 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5522 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5524 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5525 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5526 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5527 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5528 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5530 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5531 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5532 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5533 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5534 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5536 dsc_i = 0.743d0+x(61)
5538 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5539 & *(xx*cost2+yy*sint2))
5540 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5541 & *(xx*cost2-yy*sint2))
5542 s1=(1+x(63))/(0.1d0 + dscp1)
5543 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5544 s2=(1+x(65))/(0.1d0 + dscp2)
5545 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5546 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5547 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5552 c------------------------------------------------------------------------------
5553 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5555 C This procedure calculates two-body contact function g(rij) and its derivative:
5558 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5561 C where x=(rij-r0ij)/delta
5563 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5566 double precision rij,r0ij,eps0ij,fcont,fprimcont
5567 double precision x,x2,x4,delta
5571 if (x.lt.-1.0D0) then
5574 else if (x.le.1.0D0) then
5577 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5578 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5585 c------------------------------------------------------------------------------
5586 subroutine splinthet(theti,delta,ss,ssder)
5587 implicit real*8 (a-h,o-z)
5588 include 'DIMENSIONS'
5589 include 'COMMON.VAR'
5590 include 'COMMON.GEO'
5593 if (theti.gt.pipol) then
5594 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5596 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5601 c------------------------------------------------------------------------------
5602 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5604 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5605 double precision ksi,ksi2,ksi3,a1,a2,a3
5606 a1=fprim0*delta/(f1-f0)
5612 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5613 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5616 c------------------------------------------------------------------------------
5617 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5619 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5620 double precision ksi,ksi2,ksi3,a1,a2,a3
5625 a2=3*(f1x-f0x)-2*fprim0x*delta
5626 a3=fprim0x*delta-2*(f1x-f0x)
5627 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5630 C-----------------------------------------------------------------------------
5632 C-----------------------------------------------------------------------------
5633 subroutine etor(etors,edihcnstr)
5634 implicit real*8 (a-h,o-z)
5635 include 'DIMENSIONS'
5636 include 'COMMON.VAR'
5637 include 'COMMON.GEO'
5638 include 'COMMON.LOCAL'
5639 include 'COMMON.TORSION'
5640 include 'COMMON.INTERACT'
5641 include 'COMMON.DERIV'
5642 include 'COMMON.CHAIN'
5643 include 'COMMON.NAMES'
5644 include 'COMMON.IOUNITS'
5645 include 'COMMON.FFIELD'
5646 include 'COMMON.TORCNSTR'
5647 include 'COMMON.CONTROL'
5649 C Set lprn=.true. for debugging
5653 do i=iphi_start,iphi_end
5655 itori=itortyp(itype(i-2))
5656 itori1=itortyp(itype(i-1))
5659 C Proline-Proline pair is a special case...
5660 if (itori.eq.3 .and. itori1.eq.3) then
5661 if (phii.gt.-dwapi3) then
5663 fac=1.0D0/(1.0D0-cosphi)
5664 etorsi=v1(1,3,3)*fac
5665 etorsi=etorsi+etorsi
5666 etors=etors+etorsi-v1(1,3,3)
5667 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5668 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5671 v1ij=v1(j+1,itori,itori1)
5672 v2ij=v2(j+1,itori,itori1)
5675 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5676 if (energy_dec) etors_ii=etors_ii+
5677 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5678 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5682 v1ij=v1(j,itori,itori1)
5683 v2ij=v2(j,itori,itori1)
5686 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5687 if (energy_dec) etors_ii=etors_ii+
5688 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5689 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5692 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5695 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5696 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5697 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5698 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5699 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5701 ! 6/20/98 - dihedral angle constraints
5704 itori=idih_constr(i)
5707 if (difi.gt.drange(i)) then
5709 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5710 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5711 else if (difi.lt.-drange(i)) then
5713 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5714 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5716 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5717 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5719 ! write (iout,*) 'edihcnstr',edihcnstr
5722 c------------------------------------------------------------------------------
5723 subroutine etor_d(etors_d)
5727 c----------------------------------------------------------------------------
5729 subroutine etor(etors,edihcnstr)
5730 implicit real*8 (a-h,o-z)
5731 include 'DIMENSIONS'
5732 include 'COMMON.VAR'
5733 include 'COMMON.GEO'
5734 include 'COMMON.LOCAL'
5735 include 'COMMON.TORSION'
5736 include 'COMMON.INTERACT'
5737 include 'COMMON.DERIV'
5738 include 'COMMON.CHAIN'
5739 include 'COMMON.NAMES'
5740 include 'COMMON.IOUNITS'
5741 include 'COMMON.FFIELD'
5742 include 'COMMON.TORCNSTR'
5743 include 'COMMON.CONTROL'
5745 C Set lprn=.true. for debugging
5749 do i=iphi_start,iphi_end
5751 itori=itortyp(itype(i-2))
5752 itori1=itortyp(itype(i-1))
5755 C Regular cosine and sine terms
5756 do j=1,nterm(itori,itori1)
5757 v1ij=v1(j,itori,itori1)
5758 v2ij=v2(j,itori,itori1)
5761 etors=etors+v1ij*cosphi+v2ij*sinphi
5762 if (energy_dec) etors_ii=etors_ii+
5763 & v1ij*cosphi+v2ij*sinphi
5764 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5768 C E = SUM ----------------------------------- - v1
5769 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5771 cosphi=dcos(0.5d0*phii)
5772 sinphi=dsin(0.5d0*phii)
5773 do j=1,nlor(itori,itori1)
5774 vl1ij=vlor1(j,itori,itori1)
5775 vl2ij=vlor2(j,itori,itori1)
5776 vl3ij=vlor3(j,itori,itori1)
5777 pom=vl2ij*cosphi+vl3ij*sinphi
5778 pom1=1.0d0/(pom*pom+1.0d0)
5779 etors=etors+vl1ij*pom1
5780 if (energy_dec) etors_ii=etors_ii+
5783 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5785 C Subtract the constant term
5786 etors=etors-v0(itori,itori1)
5787 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5788 & 'etor',i,etors_ii-v0(itori,itori1)
5790 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5791 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5792 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5793 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5794 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5796 ! 6/20/98 - dihedral angle constraints
5798 c do i=1,ndih_constr
5799 do i=idihconstr_start,idihconstr_end
5800 itori=idih_constr(i)
5802 difi=pinorm(phii-phi0(i))
5803 if (difi.gt.drange(i)) then
5805 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5806 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5807 else if (difi.lt.-drange(i)) then
5809 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5810 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5814 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5815 cd & rad2deg*phi0(i), rad2deg*drange(i),
5816 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5818 cd write (iout,*) 'edihcnstr',edihcnstr
5821 c----------------------------------------------------------------------------
5822 subroutine etor_d(etors_d)
5823 C 6/23/01 Compute double torsional energy
5824 implicit real*8 (a-h,o-z)
5825 include 'DIMENSIONS'
5826 include 'COMMON.VAR'
5827 include 'COMMON.GEO'
5828 include 'COMMON.LOCAL'
5829 include 'COMMON.TORSION'
5830 include 'COMMON.INTERACT'
5831 include 'COMMON.DERIV'
5832 include 'COMMON.CHAIN'
5833 include 'COMMON.NAMES'
5834 include 'COMMON.IOUNITS'
5835 include 'COMMON.FFIELD'
5836 include 'COMMON.TORCNSTR'
5838 C Set lprn=.true. for debugging
5842 do i=iphid_start,iphid_end
5843 itori=itortyp(itype(i-2))
5844 itori1=itortyp(itype(i-1))
5845 itori2=itortyp(itype(i))
5850 C Regular cosine and sine terms
5851 do j=1,ntermd_1(itori,itori1,itori2)
5852 v1cij=v1c(1,j,itori,itori1,itori2)
5853 v1sij=v1s(1,j,itori,itori1,itori2)
5854 v2cij=v1c(2,j,itori,itori1,itori2)
5855 v2sij=v1s(2,j,itori,itori1,itori2)
5856 cosphi1=dcos(j*phii)
5857 sinphi1=dsin(j*phii)
5858 cosphi2=dcos(j*phii1)
5859 sinphi2=dsin(j*phii1)
5860 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5861 & v2cij*cosphi2+v2sij*sinphi2
5862 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5863 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5865 do k=2,ntermd_2(itori,itori1,itori2)
5867 v1cdij = v2c(k,l,itori,itori1,itori2)
5868 v2cdij = v2c(l,k,itori,itori1,itori2)
5869 v1sdij = v2s(k,l,itori,itori1,itori2)
5870 v2sdij = v2s(l,k,itori,itori1,itori2)
5871 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5872 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5873 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5874 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5875 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5876 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5877 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5878 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5879 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5880 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5883 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5884 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5889 c------------------------------------------------------------------------------
5890 subroutine eback_sc_corr(esccor)
5891 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5892 c conformational states; temporarily implemented as differences
5893 c between UNRES torsional potentials (dependent on three types of
5894 c residues) and the torsional potentials dependent on all 20 types
5895 c of residues computed from AM1 energy surfaces of terminally-blocked
5896 c amino-acid residues.
5897 implicit real*8 (a-h,o-z)
5898 include 'DIMENSIONS'
5899 include 'COMMON.VAR'
5900 include 'COMMON.GEO'
5901 include 'COMMON.LOCAL'
5902 include 'COMMON.TORSION'
5903 include 'COMMON.SCCOR'
5904 include 'COMMON.INTERACT'
5905 include 'COMMON.DERIV'
5906 include 'COMMON.CHAIN'
5907 include 'COMMON.NAMES'
5908 include 'COMMON.IOUNITS'
5909 include 'COMMON.FFIELD'
5910 include 'COMMON.CONTROL'
5912 C Set lprn=.true. for debugging
5915 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
5917 do i=itau_start,itau_end
5919 isccori=isccortyp(itype(i-2))
5920 isccori1=isccortyp(itype(i-1))
5921 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
5923 do intertyp=1,3 !intertyp
5924 cc Added 09 May 2012 (Adasko)
5925 cc Intertyp means interaction type of backbone mainchain correlation:
5926 c 1 = SC...Ca...Ca...Ca
5927 c 2 = Ca...Ca...Ca...SC
5928 c 3 = SC...Ca...Ca...SCi
5930 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
5931 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
5932 & (itype(i-1).eq.ntyp1)))
5933 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
5934 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
5935 & .or.(itype(i).eq.ntyp1)))
5936 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
5937 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
5938 & (itype(i-3).eq.ntyp1)))) cycle
5939 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
5940 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
5942 do j=1,nterm_sccor(isccori,isccori1)
5943 v1ij=v1sccor(j,intertyp,isccori,isccori1)
5944 v2ij=v2sccor(j,intertyp,isccori,isccori1)
5945 cosphi=dcos(j*tauangle(intertyp,i))
5946 sinphi=dsin(j*tauangle(intertyp,i))
5947 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5948 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5950 c write (iout,*) "EBACK_SC_COR",i,esccor,intertyp
5951 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
5953 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5954 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
5955 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
5956 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
5957 C gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5963 c----------------------------------------------------------------------------
5964 subroutine multibody(ecorr)
5965 C This subroutine calculates multi-body contributions to energy following
5966 C the idea of Skolnick et al. If side chains I and J make a contact and
5967 C at the same time side chains I+1 and J+1 make a contact, an extra
5968 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5969 implicit real*8 (a-h,o-z)
5970 include 'DIMENSIONS'
5971 include 'COMMON.IOUNITS'
5972 include 'COMMON.DERIV'
5973 include 'COMMON.INTERACT'
5974 include 'COMMON.CONTACTS'
5976 include 'COMMON.CONTACTS.MOMENT'
5978 double precision gx(3),gx1(3)
5981 C Set lprn=.true. for debugging
5985 write (iout,'(a)') 'Contact function values:'
5987 write (iout,'(i2,20(1x,i2,f10.5))')
5988 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6003 num_conti=num_cont(i)
6004 num_conti1=num_cont(i1)
6009 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6010 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6011 cd & ' ishift=',ishift
6012 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6013 C The system gains extra energy.
6014 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6015 endif ! j1==j+-ishift
6024 c------------------------------------------------------------------------------
6025 double precision function esccorr(i,j,k,l,jj,kk)
6026 implicit real*8 (a-h,o-z)
6027 include 'DIMENSIONS'
6028 include 'COMMON.IOUNITS'
6029 include 'COMMON.DERIV'
6030 include 'COMMON.INTERACT'
6031 include 'COMMON.CONTACTS'
6033 include 'COMMON.CONTACTS.MOMENT'
6035 double precision gx(3),gx1(3)
6040 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6041 C Calculate the multi-body contribution to energy.
6042 C Calculate multi-body contributions to the gradient.
6043 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6044 cd & k,l,(gacont(m,kk,k),m=1,3)
6046 gx(m) =ekl*gacont(m,jj,i)
6047 gx1(m)=eij*gacont(m,kk,k)
6048 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6049 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6050 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6051 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6055 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6060 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6066 c------------------------------------------------------------------------------
6067 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6068 C This subroutine calculates multi-body contributions to hydrogen-bonding
6069 implicit real*8 (a-h,o-z)
6070 include 'DIMENSIONS'
6071 include 'COMMON.IOUNITS'
6074 parameter (max_cont=maxconts)
6075 parameter (max_dim=26)
6076 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6077 double precision zapas(max_dim,maxconts,max_fg_procs),
6078 & zapas_recv(max_dim,maxconts,max_fg_procs)
6079 common /przechowalnia/ zapas
6080 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6081 & status_array(MPI_STATUS_SIZE,maxconts*2)
6083 include 'COMMON.SETUP'
6084 include 'COMMON.FFIELD'
6085 include 'COMMON.DERIV'
6086 include 'COMMON.INTERACT'
6087 include 'COMMON.CONTACTS'
6089 include 'COMMON.CONTACTS.MOMENT'
6091 include 'COMMON.CONTROL'
6092 include 'COMMON.LOCAL'
6093 double precision gx(3),gx1(3),time00
6096 C Set lprn=.true. for debugging
6101 if (nfgtasks.le.1) goto 30
6103 write (iout,'(a)') 'Contact function values before RECEIVE:'
6105 write (iout,'(2i3,50(1x,i2,f5.2))')
6106 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6107 & j=1,num_cont_hb(i))
6111 do i=1,ntask_cont_from
6114 do i=1,ntask_cont_to
6117 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6119 C Make the list of contacts to send to send to other procesors
6120 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6122 do i=iturn3_start,iturn3_end
6123 c write (iout,*) "make contact list turn3",i," num_cont",
6125 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6127 do i=iturn4_start,iturn4_end
6128 c write (iout,*) "make contact list turn4",i," num_cont",
6130 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6134 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6136 do j=1,num_cont_hb(i)
6139 iproc=iint_sent_local(k,jjc,ii)
6140 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6141 if (iproc.gt.0) then
6142 ncont_sent(iproc)=ncont_sent(iproc)+1
6143 nn=ncont_sent(iproc)
6145 zapas(2,nn,iproc)=jjc
6146 zapas(3,nn,iproc)=facont_hb(j,i)
6147 zapas(4,nn,iproc)=ees0p(j,i)
6148 zapas(5,nn,iproc)=ees0m(j,i)
6149 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6150 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6151 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6152 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6153 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6154 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6155 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6156 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6157 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6158 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6159 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6160 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6161 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6162 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6163 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6164 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6165 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6166 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6167 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6168 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6169 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6176 & "Numbers of contacts to be sent to other processors",
6177 & (ncont_sent(i),i=1,ntask_cont_to)
6178 write (iout,*) "Contacts sent"
6179 do ii=1,ntask_cont_to
6181 iproc=itask_cont_to(ii)
6182 write (iout,*) nn," contacts to processor",iproc,
6183 & " of CONT_TO_COMM group"
6185 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6193 CorrelID1=nfgtasks+fg_rank+1
6195 C Receive the numbers of needed contacts from other processors
6196 do ii=1,ntask_cont_from
6197 iproc=itask_cont_from(ii)
6199 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6200 & FG_COMM,req(ireq),IERR)
6202 c write (iout,*) "IRECV ended"
6204 C Send the number of contacts needed by other processors
6205 do ii=1,ntask_cont_to
6206 iproc=itask_cont_to(ii)
6208 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6209 & FG_COMM,req(ireq),IERR)
6211 c write (iout,*) "ISEND ended"
6212 c write (iout,*) "number of requests (nn)",ireq
6215 & call MPI_Waitall(ireq,req,status_array,ierr)
6217 c & "Numbers of contacts to be received from other processors",
6218 c & (ncont_recv(i),i=1,ntask_cont_from)
6222 do ii=1,ntask_cont_from
6223 iproc=itask_cont_from(ii)
6225 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6226 c & " of CONT_TO_COMM group"
6230 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6231 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6232 c write (iout,*) "ireq,req",ireq,req(ireq)
6235 C Send the contacts to processors that need them
6236 do ii=1,ntask_cont_to
6237 iproc=itask_cont_to(ii)
6239 c write (iout,*) nn," contacts to processor",iproc,
6240 c & " of CONT_TO_COMM group"
6243 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6244 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6245 c write (iout,*) "ireq,req",ireq,req(ireq)
6247 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6251 c write (iout,*) "number of requests (contacts)",ireq
6252 c write (iout,*) "req",(req(i),i=1,4)
6255 & call MPI_Waitall(ireq,req,status_array,ierr)
6256 do iii=1,ntask_cont_from
6257 iproc=itask_cont_from(iii)
6260 write (iout,*) "Received",nn," contacts from processor",iproc,
6261 & " of CONT_FROM_COMM group"
6264 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6269 ii=zapas_recv(1,i,iii)
6270 c Flag the received contacts to prevent double-counting
6271 jj=-zapas_recv(2,i,iii)
6272 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6274 nnn=num_cont_hb(ii)+1
6277 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6278 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6279 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6280 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6281 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6282 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6283 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6284 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6285 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6286 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6287 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6288 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6289 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6290 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6291 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6292 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6293 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6294 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6295 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6296 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6297 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6298 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6299 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6300 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6305 write (iout,'(a)') 'Contact function values after receive:'
6307 write (iout,'(2i3,50(1x,i3,f5.2))')
6308 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6309 & j=1,num_cont_hb(i))
6316 write (iout,'(a)') 'Contact function values:'
6318 write (iout,'(2i3,50(1x,i3,f5.2))')
6319 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6320 & j=1,num_cont_hb(i))
6324 C Remove the loop below after debugging !!!
6331 C Calculate the local-electrostatic correlation terms
6332 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6334 num_conti=num_cont_hb(i)
6335 num_conti1=num_cont_hb(i+1)
6342 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6343 c & ' jj=',jj,' kk=',kk
6344 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6345 & .or. j.lt.0 .and. j1.gt.0) .and.
6346 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6347 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6348 C The system gains extra energy.
6349 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6350 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6351 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6353 else if (j1.eq.j) then
6354 C Contacts I-J and I-(J+1) occur simultaneously.
6355 C The system loses extra energy.
6356 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6361 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6362 c & ' jj=',jj,' kk=',kk
6364 C Contacts I-J and (I+1)-J occur simultaneously.
6365 C The system loses extra energy.
6366 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6373 c------------------------------------------------------------------------------
6374 subroutine add_hb_contact(ii,jj,itask)
6375 implicit real*8 (a-h,o-z)
6376 include "DIMENSIONS"
6377 include "COMMON.IOUNITS"
6380 parameter (max_cont=maxconts)
6381 parameter (max_dim=26)
6382 include "COMMON.CONTACTS"
6384 include 'COMMON.CONTACTS.MOMENT'
6386 double precision zapas(max_dim,maxconts,max_fg_procs),
6387 & zapas_recv(max_dim,maxconts,max_fg_procs)
6388 common /przechowalnia/ zapas
6389 integer i,j,ii,jj,iproc,itask(4),nn
6390 c write (iout,*) "itask",itask
6393 if (iproc.gt.0) then
6394 do j=1,num_cont_hb(ii)
6396 c write (iout,*) "i",ii," j",jj," jjc",jjc
6398 ncont_sent(iproc)=ncont_sent(iproc)+1
6399 nn=ncont_sent(iproc)
6400 zapas(1,nn,iproc)=ii
6401 zapas(2,nn,iproc)=jjc
6402 zapas(3,nn,iproc)=facont_hb(j,ii)
6403 zapas(4,nn,iproc)=ees0p(j,ii)
6404 zapas(5,nn,iproc)=ees0m(j,ii)
6405 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6406 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6407 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6408 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6409 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6410 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6411 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6412 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6413 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6414 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6415 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6416 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6417 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6418 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6419 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6420 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6421 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6422 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6423 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6424 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6425 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6433 c------------------------------------------------------------------------------
6434 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6436 C This subroutine calculates multi-body contributions to hydrogen-bonding
6437 implicit real*8 (a-h,o-z)
6438 include 'DIMENSIONS'
6439 include 'COMMON.IOUNITS'
6442 parameter (max_cont=maxconts)
6443 parameter (max_dim=70)
6444 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6445 double precision zapas(max_dim,maxconts,max_fg_procs),
6446 & zapas_recv(max_dim,maxconts,max_fg_procs)
6447 common /przechowalnia/ zapas
6448 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6449 & status_array(MPI_STATUS_SIZE,maxconts*2)
6451 include 'COMMON.SETUP'
6452 include 'COMMON.FFIELD'
6453 include 'COMMON.DERIV'
6454 include 'COMMON.LOCAL'
6455 include 'COMMON.INTERACT'
6456 include 'COMMON.CONTACTS'
6458 include 'COMMON.CONTACTS.MOMENT'
6460 include 'COMMON.CHAIN'
6461 include 'COMMON.CONTROL'
6462 double precision gx(3),gx1(3)
6463 integer num_cont_hb_old(maxres)
6465 double precision eello4,eello5,eelo6,eello_turn6
6466 external eello4,eello5,eello6,eello_turn6
6467 C Set lprn=.true. for debugging
6472 num_cont_hb_old(i)=num_cont_hb(i)
6476 if (nfgtasks.le.1) goto 30
6478 write (iout,'(a)') 'Contact function values before RECEIVE:'
6480 write (iout,'(2i3,50(1x,i2,f5.2))')
6481 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6482 & j=1,num_cont_hb(i))
6486 do i=1,ntask_cont_from
6489 do i=1,ntask_cont_to
6492 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6494 C Make the list of contacts to send to send to other procesors
6495 do i=iturn3_start,iturn3_end
6496 c write (iout,*) "make contact list turn3",i," num_cont",
6498 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6500 do i=iturn4_start,iturn4_end
6501 c write (iout,*) "make contact list turn4",i," num_cont",
6503 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6507 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6509 do j=1,num_cont_hb(i)
6512 iproc=iint_sent_local(k,jjc,ii)
6513 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6514 if (iproc.ne.0) then
6515 ncont_sent(iproc)=ncont_sent(iproc)+1
6516 nn=ncont_sent(iproc)
6518 zapas(2,nn,iproc)=jjc
6519 zapas(3,nn,iproc)=d_cont(j,i)
6523 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6528 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6536 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6547 & "Numbers of contacts to be sent to other processors",
6548 & (ncont_sent(i),i=1,ntask_cont_to)
6549 write (iout,*) "Contacts sent"
6550 do ii=1,ntask_cont_to
6552 iproc=itask_cont_to(ii)
6553 write (iout,*) nn," contacts to processor",iproc,
6554 & " of CONT_TO_COMM group"
6556 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6564 CorrelID1=nfgtasks+fg_rank+1
6566 C Receive the numbers of needed contacts from other processors
6567 do ii=1,ntask_cont_from
6568 iproc=itask_cont_from(ii)
6570 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6571 & FG_COMM,req(ireq),IERR)
6573 c write (iout,*) "IRECV ended"
6575 C Send the number of contacts needed by other processors
6576 do ii=1,ntask_cont_to
6577 iproc=itask_cont_to(ii)
6579 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6580 & FG_COMM,req(ireq),IERR)
6582 c write (iout,*) "ISEND ended"
6583 c write (iout,*) "number of requests (nn)",ireq
6586 & call MPI_Waitall(ireq,req,status_array,ierr)
6588 c & "Numbers of contacts to be received from other processors",
6589 c & (ncont_recv(i),i=1,ntask_cont_from)
6593 do ii=1,ntask_cont_from
6594 iproc=itask_cont_from(ii)
6596 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6597 c & " of CONT_TO_COMM group"
6601 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6602 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6603 c write (iout,*) "ireq,req",ireq,req(ireq)
6606 C Send the contacts to processors that need them
6607 do ii=1,ntask_cont_to
6608 iproc=itask_cont_to(ii)
6610 c write (iout,*) nn," contacts to processor",iproc,
6611 c & " of CONT_TO_COMM group"
6614 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6615 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6616 c write (iout,*) "ireq,req",ireq,req(ireq)
6618 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6622 c write (iout,*) "number of requests (contacts)",ireq
6623 c write (iout,*) "req",(req(i),i=1,4)
6626 & call MPI_Waitall(ireq,req,status_array,ierr)
6627 do iii=1,ntask_cont_from
6628 iproc=itask_cont_from(iii)
6631 write (iout,*) "Received",nn," contacts from processor",iproc,
6632 & " of CONT_FROM_COMM group"
6635 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6640 ii=zapas_recv(1,i,iii)
6641 c Flag the received contacts to prevent double-counting
6642 jj=-zapas_recv(2,i,iii)
6643 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6645 nnn=num_cont_hb(ii)+1
6648 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6652 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6657 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6665 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6674 write (iout,'(a)') 'Contact function values after receive:'
6676 write (iout,'(2i3,50(1x,i3,5f6.3))')
6677 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6678 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6685 write (iout,'(a)') 'Contact function values:'
6687 write (iout,'(2i3,50(1x,i2,5f6.3))')
6688 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6689 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6695 C Remove the loop below after debugging !!!
6702 C Calculate the dipole-dipole interaction energies
6703 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6704 do i=iatel_s,iatel_e+1
6705 num_conti=num_cont_hb(i)
6714 C Calculate the local-electrostatic correlation terms
6715 c write (iout,*) "gradcorr5 in eello5 before loop"
6717 c write (iout,'(i5,3f10.5)')
6718 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6720 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6721 c write (iout,*) "corr loop i",i
6723 num_conti=num_cont_hb(i)
6724 num_conti1=num_cont_hb(i+1)
6731 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6732 c & ' jj=',jj,' kk=',kk
6733 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6734 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6735 & .or. j.lt.0 .and. j1.gt.0) .and.
6736 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6737 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6738 C The system gains extra energy.
6740 sqd1=dsqrt(d_cont(jj,i))
6741 sqd2=dsqrt(d_cont(kk,i1))
6742 sred_geom = sqd1*sqd2
6743 IF (sred_geom.lt.cutoff_corr) THEN
6744 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6746 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6747 cd & ' jj=',jj,' kk=',kk
6748 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6749 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6751 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6752 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6755 cd write (iout,*) 'sred_geom=',sred_geom,
6756 cd & ' ekont=',ekont,' fprim=',fprimcont,
6757 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6758 cd write (iout,*) "g_contij",g_contij
6759 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6760 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6761 call calc_eello(i,jp,i+1,jp1,jj,kk)
6762 if (wcorr4.gt.0.0d0)
6763 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6764 if (energy_dec.and.wcorr4.gt.0.0d0)
6765 1 write (iout,'(a6,4i5,0pf7.3)')
6766 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6767 c write (iout,*) "gradcorr5 before eello5"
6769 c write (iout,'(i5,3f10.5)')
6770 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6772 if (wcorr5.gt.0.0d0)
6773 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6774 c write (iout,*) "gradcorr5 after eello5"
6776 c write (iout,'(i5,3f10.5)')
6777 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6779 if (energy_dec.and.wcorr5.gt.0.0d0)
6780 1 write (iout,'(a6,4i5,0pf7.3)')
6781 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6782 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6783 cd write(2,*)'ijkl',i,jp,i+1,jp1
6784 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6785 & .or. wturn6.eq.0.0d0))then
6786 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6787 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6788 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6789 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6790 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6791 cd & 'ecorr6=',ecorr6
6792 cd write (iout,'(4e15.5)') sred_geom,
6793 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6794 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6795 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6796 else if (wturn6.gt.0.0d0
6797 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6798 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6799 eturn6=eturn6+eello_turn6(i,jj,kk)
6800 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6801 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6802 cd write (2,*) 'multibody_eello:eturn6',eturn6
6811 num_cont_hb(i)=num_cont_hb_old(i)
6813 c write (iout,*) "gradcorr5 in eello5"
6815 c write (iout,'(i5,3f10.5)')
6816 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6820 c------------------------------------------------------------------------------
6821 subroutine add_hb_contact_eello(ii,jj,itask)
6822 implicit real*8 (a-h,o-z)
6823 include "DIMENSIONS"
6824 include "COMMON.IOUNITS"
6827 parameter (max_cont=maxconts)
6828 parameter (max_dim=70)
6829 include "COMMON.CONTACTS"
6831 include 'COMMON.CONTACTS.MOMENT'
6833 double precision zapas(max_dim,maxconts,max_fg_procs),
6834 & zapas_recv(max_dim,maxconts,max_fg_procs)
6835 common /przechowalnia/ zapas
6836 integer i,j,ii,jj,iproc,itask(4),nn
6837 c write (iout,*) "itask",itask
6840 if (iproc.gt.0) then
6841 do j=1,num_cont_hb(ii)
6843 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6845 ncont_sent(iproc)=ncont_sent(iproc)+1
6846 nn=ncont_sent(iproc)
6847 zapas(1,nn,iproc)=ii
6848 zapas(2,nn,iproc)=jjc
6849 zapas(3,nn,iproc)=d_cont(j,ii)
6853 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6858 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6866 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6878 c------------------------------------------------------------------------------
6879 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6880 implicit real*8 (a-h,o-z)
6881 include 'DIMENSIONS'
6882 include 'COMMON.IOUNITS'
6883 include 'COMMON.DERIV'
6884 include 'COMMON.INTERACT'
6885 include 'COMMON.CONTACTS'
6887 include 'COMMON.CONTACTS.MOMENT'
6889 double precision gx(3),gx1(3)
6899 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6900 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6901 C Following 4 lines for diagnostics.
6906 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6907 c & 'Contacts ',i,j,
6908 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6909 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6911 C Calculate the multi-body contribution to energy.
6912 c ecorr=ecorr+ekont*ees
6913 C Calculate multi-body contributions to the gradient.
6914 coeffpees0pij=coeffp*ees0pij
6915 coeffmees0mij=coeffm*ees0mij
6916 coeffpees0pkl=coeffp*ees0pkl
6917 coeffmees0mkl=coeffm*ees0mkl
6919 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6920 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6921 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6922 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6923 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6924 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6925 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6926 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6927 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6928 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6929 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6930 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6931 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6932 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6933 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6934 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6935 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6936 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6937 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6938 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6939 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6940 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6941 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6942 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6943 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6948 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6949 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6950 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6951 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6956 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6957 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6958 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6959 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6962 c write (iout,*) "ehbcorr",ekont*ees
6967 C---------------------------------------------------------------------------
6968 subroutine dipole(i,j,jj)
6969 implicit real*8 (a-h,o-z)
6970 include 'DIMENSIONS'
6971 include 'COMMON.IOUNITS'
6972 include 'COMMON.CHAIN'
6973 include 'COMMON.FFIELD'
6974 include 'COMMON.DERIV'
6975 include 'COMMON.INTERACT'
6976 include 'COMMON.CONTACTS'
6978 include 'COMMON.CONTACTS.MOMENT'
6980 include 'COMMON.TORSION'
6981 include 'COMMON.VAR'
6982 include 'COMMON.GEO'
6983 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6985 iti1 = itortyp(itype(i+1))
6986 if (j.lt.nres-1) then
6987 itj1 = itortyp(itype(j+1))
6992 dipi(iii,1)=Ub2(iii,i)
6993 dipderi(iii)=Ub2der(iii,i)
6994 dipi(iii,2)=b1(iii,iti1)
6995 dipj(iii,1)=Ub2(iii,j)
6996 dipderj(iii)=Ub2der(iii,j)
6997 dipj(iii,2)=b1(iii,itj1)
7001 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7004 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7011 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7015 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7020 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7021 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7023 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7025 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7027 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7032 C---------------------------------------------------------------------------
7033 subroutine calc_eello(i,j,k,l,jj,kk)
7035 C This subroutine computes matrices and vectors needed to calculate
7036 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7038 implicit real*8 (a-h,o-z)
7039 include 'DIMENSIONS'
7040 include 'COMMON.IOUNITS'
7041 include 'COMMON.CHAIN'
7042 include 'COMMON.DERIV'
7043 include 'COMMON.INTERACT'
7044 include 'COMMON.CONTACTS'
7046 include 'COMMON.CONTACTS.MOMENT'
7048 include 'COMMON.TORSION'
7049 include 'COMMON.VAR'
7050 include 'COMMON.GEO'
7051 include 'COMMON.FFIELD'
7052 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7053 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7056 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7057 cd & ' jj=',jj,' kk=',kk
7058 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7059 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7060 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7063 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7064 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7067 call transpose2(aa1(1,1),aa1t(1,1))
7068 call transpose2(aa2(1,1),aa2t(1,1))
7071 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7072 & aa1tder(1,1,lll,kkk))
7073 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7074 & aa2tder(1,1,lll,kkk))
7078 C parallel orientation of the two CA-CA-CA frames.
7080 iti=itortyp(itype(i))
7084 itk1=itortyp(itype(k+1))
7085 itj=itortyp(itype(j))
7086 if (l.lt.nres-1) then
7087 itl1=itortyp(itype(l+1))
7091 C A1 kernel(j+1) A2T
7093 cd write (iout,'(3f10.5,5x,3f10.5)')
7094 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7096 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7097 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7098 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7099 C Following matrices are needed only for 6-th order cumulants
7100 IF (wcorr6.gt.0.0d0) THEN
7101 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7102 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7103 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7104 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7105 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7106 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7107 & ADtEAderx(1,1,1,1,1,1))
7109 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7110 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7111 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7112 & ADtEA1derx(1,1,1,1,1,1))
7114 C End 6-th order cumulants
7117 cd write (2,*) 'In calc_eello6'
7119 cd write (2,*) 'iii=',iii
7121 cd write (2,*) 'kkk=',kkk
7123 cd write (2,'(3(2f10.5),5x)')
7124 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7129 call transpose2(EUgder(1,1,k),auxmat(1,1))
7130 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7131 call transpose2(EUg(1,1,k),auxmat(1,1))
7132 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7133 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7137 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7138 & EAEAderx(1,1,lll,kkk,iii,1))
7142 C A1T kernel(i+1) A2
7143 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7144 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7145 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7146 C Following matrices are needed only for 6-th order cumulants
7147 IF (wcorr6.gt.0.0d0) THEN
7148 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7149 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7150 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7151 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7152 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7153 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7154 & ADtEAderx(1,1,1,1,1,2))
7155 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7156 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7157 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7158 & ADtEA1derx(1,1,1,1,1,2))
7160 C End 6-th order cumulants
7161 call transpose2(EUgder(1,1,l),auxmat(1,1))
7162 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7163 call transpose2(EUg(1,1,l),auxmat(1,1))
7164 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7165 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7169 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7170 & EAEAderx(1,1,lll,kkk,iii,2))
7175 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7176 C They are needed only when the fifth- or the sixth-order cumulants are
7178 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7179 call transpose2(AEA(1,1,1),auxmat(1,1))
7180 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7181 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7182 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7183 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7184 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7185 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7186 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7187 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7188 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7189 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7190 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7191 call transpose2(AEA(1,1,2),auxmat(1,1))
7192 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7193 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7194 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7195 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7196 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7197 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7198 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7199 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7200 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7201 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7202 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7203 C Calculate the Cartesian derivatives of the vectors.
7207 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7208 call matvec2(auxmat(1,1),b1(1,iti),
7209 & AEAb1derx(1,lll,kkk,iii,1,1))
7210 call matvec2(auxmat(1,1),Ub2(1,i),
7211 & AEAb2derx(1,lll,kkk,iii,1,1))
7212 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7213 & AEAb1derx(1,lll,kkk,iii,2,1))
7214 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7215 & AEAb2derx(1,lll,kkk,iii,2,1))
7216 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7217 call matvec2(auxmat(1,1),b1(1,itj),
7218 & AEAb1derx(1,lll,kkk,iii,1,2))
7219 call matvec2(auxmat(1,1),Ub2(1,j),
7220 & AEAb2derx(1,lll,kkk,iii,1,2))
7221 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7222 & AEAb1derx(1,lll,kkk,iii,2,2))
7223 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7224 & AEAb2derx(1,lll,kkk,iii,2,2))
7231 C Antiparallel orientation of the two CA-CA-CA frames.
7233 iti=itortyp(itype(i))
7237 itk1=itortyp(itype(k+1))
7238 itl=itortyp(itype(l))
7239 itj=itortyp(itype(j))
7240 if (j.lt.nres-1) then
7241 itj1=itortyp(itype(j+1))
7245 C A2 kernel(j-1)T A1T
7246 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7247 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7248 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7249 C Following matrices are needed only for 6-th order cumulants
7250 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7251 & j.eq.i+4 .and. l.eq.i+3)) THEN
7252 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7253 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7254 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7255 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7256 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7257 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7258 & ADtEAderx(1,1,1,1,1,1))
7259 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7260 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7261 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7262 & ADtEA1derx(1,1,1,1,1,1))
7264 C End 6-th order cumulants
7265 call transpose2(EUgder(1,1,k),auxmat(1,1))
7266 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7267 call transpose2(EUg(1,1,k),auxmat(1,1))
7268 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7269 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7273 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7274 & EAEAderx(1,1,lll,kkk,iii,1))
7278 C A2T kernel(i+1)T A1
7279 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7280 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7281 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7282 C Following matrices are needed only for 6-th order cumulants
7283 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7284 & j.eq.i+4 .and. l.eq.i+3)) THEN
7285 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7286 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7287 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7288 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7289 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7290 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7291 & ADtEAderx(1,1,1,1,1,2))
7292 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7293 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7294 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7295 & ADtEA1derx(1,1,1,1,1,2))
7297 C End 6-th order cumulants
7298 call transpose2(EUgder(1,1,j),auxmat(1,1))
7299 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7300 call transpose2(EUg(1,1,j),auxmat(1,1))
7301 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7302 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7306 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7307 & EAEAderx(1,1,lll,kkk,iii,2))
7312 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7313 C They are needed only when the fifth- or the sixth-order cumulants are
7315 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7316 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7317 call transpose2(AEA(1,1,1),auxmat(1,1))
7318 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7319 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7320 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7321 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7322 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7323 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7324 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7325 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7326 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7327 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7328 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7329 call transpose2(AEA(1,1,2),auxmat(1,1))
7330 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7331 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7332 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7333 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7334 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7335 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7336 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7337 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7338 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7339 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7340 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7341 C Calculate the Cartesian derivatives of the vectors.
7345 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7346 call matvec2(auxmat(1,1),b1(1,iti),
7347 & AEAb1derx(1,lll,kkk,iii,1,1))
7348 call matvec2(auxmat(1,1),Ub2(1,i),
7349 & AEAb2derx(1,lll,kkk,iii,1,1))
7350 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7351 & AEAb1derx(1,lll,kkk,iii,2,1))
7352 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7353 & AEAb2derx(1,lll,kkk,iii,2,1))
7354 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7355 call matvec2(auxmat(1,1),b1(1,itl),
7356 & AEAb1derx(1,lll,kkk,iii,1,2))
7357 call matvec2(auxmat(1,1),Ub2(1,l),
7358 & AEAb2derx(1,lll,kkk,iii,1,2))
7359 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7360 & AEAb1derx(1,lll,kkk,iii,2,2))
7361 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7362 & AEAb2derx(1,lll,kkk,iii,2,2))
7371 C---------------------------------------------------------------------------
7372 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7373 & KK,KKderg,AKA,AKAderg,AKAderx)
7377 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7378 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7379 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7384 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7386 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7389 cd if (lprn) write (2,*) 'In kernel'
7391 cd if (lprn) write (2,*) 'kkk=',kkk
7393 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7394 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7396 cd write (2,*) 'lll=',lll
7397 cd write (2,*) 'iii=1'
7399 cd write (2,'(3(2f10.5),5x)')
7400 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7403 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7404 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7406 cd write (2,*) 'lll=',lll
7407 cd write (2,*) 'iii=2'
7409 cd write (2,'(3(2f10.5),5x)')
7410 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7417 C---------------------------------------------------------------------------
7418 double precision function eello4(i,j,k,l,jj,kk)
7419 implicit real*8 (a-h,o-z)
7420 include 'DIMENSIONS'
7421 include 'COMMON.IOUNITS'
7422 include 'COMMON.CHAIN'
7423 include 'COMMON.DERIV'
7424 include 'COMMON.INTERACT'
7425 include 'COMMON.CONTACTS'
7427 include 'COMMON.CONTACTS.MOMENT'
7429 include 'COMMON.TORSION'
7430 include 'COMMON.VAR'
7431 include 'COMMON.GEO'
7432 double precision pizda(2,2),ggg1(3),ggg2(3)
7433 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7437 cd print *,'eello4:',i,j,k,l,jj,kk
7438 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7439 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7440 cold eij=facont_hb(jj,i)
7441 cold ekl=facont_hb(kk,k)
7443 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7444 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7445 gcorr_loc(k-1)=gcorr_loc(k-1)
7446 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7448 gcorr_loc(l-1)=gcorr_loc(l-1)
7449 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7451 gcorr_loc(j-1)=gcorr_loc(j-1)
7452 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7457 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7458 & -EAEAderx(2,2,lll,kkk,iii,1)
7459 cd derx(lll,kkk,iii)=0.0d0
7463 cd gcorr_loc(l-1)=0.0d0
7464 cd gcorr_loc(j-1)=0.0d0
7465 cd gcorr_loc(k-1)=0.0d0
7467 cd write (iout,*)'Contacts have occurred for peptide groups',
7468 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7469 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7470 if (j.lt.nres-1) then
7477 if (l.lt.nres-1) then
7485 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7486 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7487 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7488 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7489 cgrad ghalf=0.5d0*ggg1(ll)
7490 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7491 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7492 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7493 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7494 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7495 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7496 cgrad ghalf=0.5d0*ggg2(ll)
7497 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7498 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7499 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7500 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7501 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7502 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7506 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7511 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7516 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7521 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7525 cd write (2,*) iii,gcorr_loc(iii)
7528 cd write (2,*) 'ekont',ekont
7529 cd write (iout,*) 'eello4',ekont*eel4
7532 C---------------------------------------------------------------------------
7533 double precision function eello5(i,j,k,l,jj,kk)
7534 implicit real*8 (a-h,o-z)
7535 include 'DIMENSIONS'
7536 include 'COMMON.IOUNITS'
7537 include 'COMMON.CHAIN'
7538 include 'COMMON.DERIV'
7539 include 'COMMON.INTERACT'
7540 include 'COMMON.CONTACTS'
7542 include 'COMMON.CONTACTS.MOMENT'
7544 include 'COMMON.TORSION'
7545 include 'COMMON.VAR'
7546 include 'COMMON.GEO'
7547 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7548 double precision ggg1(3),ggg2(3)
7549 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7554 C /l\ / \ \ / \ / \ / C
7555 C / \ / \ \ / \ / \ / C
7556 C j| o |l1 | o | o| o | | o |o C
7557 C \ |/k\| |/ \| / |/ \| |/ \| C
7558 C \i/ \ / \ / / \ / \ C
7560 C (I) (II) (III) (IV) C
7562 C eello5_1 eello5_2 eello5_3 eello5_4 C
7564 C Antiparallel chains C
7567 C /j\ / \ \ / \ / \ / C
7568 C / \ / \ \ / \ / \ / C
7569 C j1| o |l | o | o| o | | o |o C
7570 C \ |/k\| |/ \| / |/ \| |/ \| C
7571 C \i/ \ / \ / / \ / \ C
7573 C (I) (II) (III) (IV) C
7575 C eello5_1 eello5_2 eello5_3 eello5_4 C
7577 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7579 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7580 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7585 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7587 itk=itortyp(itype(k))
7588 itl=itortyp(itype(l))
7589 itj=itortyp(itype(j))
7594 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7595 cd & eel5_3_num,eel5_4_num)
7599 derx(lll,kkk,iii)=0.0d0
7603 cd eij=facont_hb(jj,i)
7604 cd ekl=facont_hb(kk,k)
7606 cd write (iout,*)'Contacts have occurred for peptide groups',
7607 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7609 C Contribution from the graph I.
7610 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7611 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7612 call transpose2(EUg(1,1,k),auxmat(1,1))
7613 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7614 vv(1)=pizda(1,1)-pizda(2,2)
7615 vv(2)=pizda(1,2)+pizda(2,1)
7616 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7617 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7618 C Explicit gradient in virtual-dihedral angles.
7619 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7620 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7621 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7622 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7623 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7624 vv(1)=pizda(1,1)-pizda(2,2)
7625 vv(2)=pizda(1,2)+pizda(2,1)
7626 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7627 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7628 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7629 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7630 vv(1)=pizda(1,1)-pizda(2,2)
7631 vv(2)=pizda(1,2)+pizda(2,1)
7633 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7634 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7635 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7637 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7638 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7639 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7641 C Cartesian gradient
7645 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7647 vv(1)=pizda(1,1)-pizda(2,2)
7648 vv(2)=pizda(1,2)+pizda(2,1)
7649 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7650 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7651 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7657 C Contribution from graph II
7658 call transpose2(EE(1,1,itk),auxmat(1,1))
7659 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7660 vv(1)=pizda(1,1)+pizda(2,2)
7661 vv(2)=pizda(2,1)-pizda(1,2)
7662 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7663 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7664 C Explicit gradient in virtual-dihedral angles.
7665 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7666 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7667 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7668 vv(1)=pizda(1,1)+pizda(2,2)
7669 vv(2)=pizda(2,1)-pizda(1,2)
7671 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7672 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7673 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7675 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7676 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7677 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7679 C Cartesian gradient
7683 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7685 vv(1)=pizda(1,1)+pizda(2,2)
7686 vv(2)=pizda(2,1)-pizda(1,2)
7687 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7688 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7689 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7697 C Parallel orientation
7698 C Contribution from graph III
7699 call transpose2(EUg(1,1,l),auxmat(1,1))
7700 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7701 vv(1)=pizda(1,1)-pizda(2,2)
7702 vv(2)=pizda(1,2)+pizda(2,1)
7703 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7704 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7705 C Explicit gradient in virtual-dihedral angles.
7706 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7707 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7708 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7709 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7710 vv(1)=pizda(1,1)-pizda(2,2)
7711 vv(2)=pizda(1,2)+pizda(2,1)
7712 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7713 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7714 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7715 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7716 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7717 vv(1)=pizda(1,1)-pizda(2,2)
7718 vv(2)=pizda(1,2)+pizda(2,1)
7719 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7720 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7721 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7722 C Cartesian gradient
7726 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7728 vv(1)=pizda(1,1)-pizda(2,2)
7729 vv(2)=pizda(1,2)+pizda(2,1)
7730 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7731 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7732 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7737 C Contribution from graph IV
7739 call transpose2(EE(1,1,itl),auxmat(1,1))
7740 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7741 vv(1)=pizda(1,1)+pizda(2,2)
7742 vv(2)=pizda(2,1)-pizda(1,2)
7743 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7744 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7745 C Explicit gradient in virtual-dihedral angles.
7746 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7747 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7748 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7749 vv(1)=pizda(1,1)+pizda(2,2)
7750 vv(2)=pizda(2,1)-pizda(1,2)
7751 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7752 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7753 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7754 C Cartesian gradient
7758 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7760 vv(1)=pizda(1,1)+pizda(2,2)
7761 vv(2)=pizda(2,1)-pizda(1,2)
7762 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7763 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7764 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7769 C Antiparallel orientation
7770 C Contribution from graph III
7772 call transpose2(EUg(1,1,j),auxmat(1,1))
7773 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7774 vv(1)=pizda(1,1)-pizda(2,2)
7775 vv(2)=pizda(1,2)+pizda(2,1)
7776 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7777 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7778 C Explicit gradient in virtual-dihedral angles.
7779 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7780 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7781 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7782 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7783 vv(1)=pizda(1,1)-pizda(2,2)
7784 vv(2)=pizda(1,2)+pizda(2,1)
7785 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7786 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7787 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7788 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7789 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7790 vv(1)=pizda(1,1)-pizda(2,2)
7791 vv(2)=pizda(1,2)+pizda(2,1)
7792 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7793 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7794 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7795 C Cartesian gradient
7799 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7801 vv(1)=pizda(1,1)-pizda(2,2)
7802 vv(2)=pizda(1,2)+pizda(2,1)
7803 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7804 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7805 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7810 C Contribution from graph IV
7812 call transpose2(EE(1,1,itj),auxmat(1,1))
7813 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7814 vv(1)=pizda(1,1)+pizda(2,2)
7815 vv(2)=pizda(2,1)-pizda(1,2)
7816 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7817 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7818 C Explicit gradient in virtual-dihedral angles.
7819 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7820 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7821 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7822 vv(1)=pizda(1,1)+pizda(2,2)
7823 vv(2)=pizda(2,1)-pizda(1,2)
7824 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7825 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7826 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7827 C Cartesian gradient
7831 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7833 vv(1)=pizda(1,1)+pizda(2,2)
7834 vv(2)=pizda(2,1)-pizda(1,2)
7835 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7836 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7837 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7843 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7844 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7845 cd write (2,*) 'ijkl',i,j,k,l
7846 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7847 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7849 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7850 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7851 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7852 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7853 if (j.lt.nres-1) then
7860 if (l.lt.nres-1) then
7870 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7871 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7872 C summed up outside the subrouine as for the other subroutines
7873 C handling long-range interactions. The old code is commented out
7874 C with "cgrad" to keep track of changes.
7876 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7877 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7878 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7879 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7880 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7881 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7882 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7883 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7884 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7885 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7887 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7888 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7889 cgrad ghalf=0.5d0*ggg1(ll)
7891 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7892 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7893 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7894 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7895 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7896 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7897 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7898 cgrad ghalf=0.5d0*ggg2(ll)
7900 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7901 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7902 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7903 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7904 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7905 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7910 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7911 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7916 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7917 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7923 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7928 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7932 cd write (2,*) iii,g_corr5_loc(iii)
7935 cd write (2,*) 'ekont',ekont
7936 cd write (iout,*) 'eello5',ekont*eel5
7939 c--------------------------------------------------------------------------
7940 double precision function eello6(i,j,k,l,jj,kk)
7941 implicit real*8 (a-h,o-z)
7942 include 'DIMENSIONS'
7943 include 'COMMON.IOUNITS'
7944 include 'COMMON.CHAIN'
7945 include 'COMMON.DERIV'
7946 include 'COMMON.INTERACT'
7947 include 'COMMON.CONTACTS'
7949 include 'COMMON.CONTACTS.MOMENT'
7951 include 'COMMON.TORSION'
7952 include 'COMMON.VAR'
7953 include 'COMMON.GEO'
7954 include 'COMMON.FFIELD'
7955 double precision ggg1(3),ggg2(3)
7956 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7961 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7969 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7970 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7974 derx(lll,kkk,iii)=0.0d0
7978 cd eij=facont_hb(jj,i)
7979 cd ekl=facont_hb(kk,k)
7985 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7986 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7987 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7988 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7989 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7990 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7992 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7993 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7994 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7995 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7996 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7997 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8001 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8003 C If turn contributions are considered, they will be handled separately.
8004 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8005 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8006 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8007 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8008 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8009 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8010 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8012 if (j.lt.nres-1) then
8019 if (l.lt.nres-1) then
8027 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8028 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8029 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8030 cgrad ghalf=0.5d0*ggg1(ll)
8032 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8033 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8034 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8035 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8036 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8037 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8038 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8039 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8040 cgrad ghalf=0.5d0*ggg2(ll)
8041 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8043 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8044 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8045 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8046 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8047 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8048 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8053 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8054 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8059 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8060 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8066 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8071 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8075 cd write (2,*) iii,g_corr6_loc(iii)
8078 cd write (2,*) 'ekont',ekont
8079 cd write (iout,*) 'eello6',ekont*eel6
8082 c--------------------------------------------------------------------------
8083 double precision function eello6_graph1(i,j,k,l,imat,swap)
8084 implicit real*8 (a-h,o-z)
8085 include 'DIMENSIONS'
8086 include 'COMMON.IOUNITS'
8087 include 'COMMON.CHAIN'
8088 include 'COMMON.DERIV'
8089 include 'COMMON.INTERACT'
8090 include 'COMMON.CONTACTS'
8092 include 'COMMON.CONTACTS.MOMENT'
8094 include 'COMMON.TORSION'
8095 include 'COMMON.VAR'
8096 include 'COMMON.GEO'
8097 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8101 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8103 C Parallel Antiparallel C
8109 C \ j|/k\| / \ |/k\|l / C
8114 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8115 itk=itortyp(itype(k))
8116 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8117 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8118 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8119 call transpose2(EUgC(1,1,k),auxmat(1,1))
8120 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8121 vv1(1)=pizda1(1,1)-pizda1(2,2)
8122 vv1(2)=pizda1(1,2)+pizda1(2,1)
8123 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8124 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8125 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8126 s5=scalar2(vv(1),Dtobr2(1,i))
8127 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8128 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8129 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8130 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8131 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8132 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8133 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8134 & +scalar2(vv(1),Dtobr2der(1,i)))
8135 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8136 vv1(1)=pizda1(1,1)-pizda1(2,2)
8137 vv1(2)=pizda1(1,2)+pizda1(2,1)
8138 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8139 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8141 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8142 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8143 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8144 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8145 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8147 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8148 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8149 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8150 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8151 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8153 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8154 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8155 vv1(1)=pizda1(1,1)-pizda1(2,2)
8156 vv1(2)=pizda1(1,2)+pizda1(2,1)
8157 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8158 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8159 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8160 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8169 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8170 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8171 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8172 call transpose2(EUgC(1,1,k),auxmat(1,1))
8173 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8175 vv1(1)=pizda1(1,1)-pizda1(2,2)
8176 vv1(2)=pizda1(1,2)+pizda1(2,1)
8177 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8178 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8179 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8180 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8181 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8182 s5=scalar2(vv(1),Dtobr2(1,i))
8183 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8189 c----------------------------------------------------------------------------
8190 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8191 implicit real*8 (a-h,o-z)
8192 include 'DIMENSIONS'
8193 include 'COMMON.IOUNITS'
8194 include 'COMMON.CHAIN'
8195 include 'COMMON.DERIV'
8196 include 'COMMON.INTERACT'
8197 include 'COMMON.CONTACTS'
8199 include 'COMMON.CONTACTS.MOMENT'
8201 include 'COMMON.TORSION'
8202 include 'COMMON.VAR'
8203 include 'COMMON.GEO'
8205 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8206 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8209 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8211 C Parallel Antiparallel C
8217 C \ j|/k\| \ |/k\|l C
8222 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8223 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8224 C AL 7/4/01 s1 would occur in the sixth-order moment,
8225 C but not in a cluster cumulant
8227 s1=dip(1,jj,i)*dip(1,kk,k)
8229 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8230 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8231 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8232 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8233 call transpose2(EUg(1,1,k),auxmat(1,1))
8234 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8235 vv(1)=pizda(1,1)-pizda(2,2)
8236 vv(2)=pizda(1,2)+pizda(2,1)
8237 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8238 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8240 eello6_graph2=-(s1+s2+s3+s4)
8242 eello6_graph2=-(s2+s3+s4)
8245 C Derivatives in gamma(i-1)
8248 s1=dipderg(1,jj,i)*dip(1,kk,k)
8250 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8251 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8252 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8253 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8255 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8257 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8259 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8261 C Derivatives in gamma(k-1)
8263 s1=dip(1,jj,i)*dipderg(1,kk,k)
8265 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8266 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8267 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8268 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8269 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8270 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8271 vv(1)=pizda(1,1)-pizda(2,2)
8272 vv(2)=pizda(1,2)+pizda(2,1)
8273 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8275 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8277 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8279 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8280 C Derivatives in gamma(j-1) or gamma(l-1)
8283 s1=dipderg(3,jj,i)*dip(1,kk,k)
8285 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8286 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8287 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8288 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8289 vv(1)=pizda(1,1)-pizda(2,2)
8290 vv(2)=pizda(1,2)+pizda(2,1)
8291 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8294 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8296 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8299 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8300 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8302 C Derivatives in gamma(l-1) or gamma(j-1)
8305 s1=dip(1,jj,i)*dipderg(3,kk,k)
8307 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8308 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8309 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8310 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8311 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8312 vv(1)=pizda(1,1)-pizda(2,2)
8313 vv(2)=pizda(1,2)+pizda(2,1)
8314 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8317 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8319 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8322 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8323 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8325 C Cartesian derivatives.
8327 write (2,*) 'In eello6_graph2'
8329 write (2,*) 'iii=',iii
8331 write (2,*) 'kkk=',kkk
8333 write (2,'(3(2f10.5),5x)')
8334 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8344 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8346 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8349 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8351 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8352 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8354 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8355 call transpose2(EUg(1,1,k),auxmat(1,1))
8356 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8358 vv(1)=pizda(1,1)-pizda(2,2)
8359 vv(2)=pizda(1,2)+pizda(2,1)
8360 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8361 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8363 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8365 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8368 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8370 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8377 c----------------------------------------------------------------------------
8378 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8379 implicit real*8 (a-h,o-z)
8380 include 'DIMENSIONS'
8381 include 'COMMON.IOUNITS'
8382 include 'COMMON.CHAIN'
8383 include 'COMMON.DERIV'
8384 include 'COMMON.INTERACT'
8385 include 'COMMON.CONTACTS'
8387 include 'COMMON.CONTACTS.MOMENT'
8389 include 'COMMON.TORSION'
8390 include 'COMMON.VAR'
8391 include 'COMMON.GEO'
8392 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8394 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8396 C Parallel Antiparallel C
8402 C j|/k\| / |/k\|l / C
8407 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8409 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8410 C energy moment and not to the cluster cumulant.
8411 iti=itortyp(itype(i))
8412 if (j.lt.nres-1) then
8413 itj1=itortyp(itype(j+1))
8417 itk=itortyp(itype(k))
8418 itk1=itortyp(itype(k+1))
8419 if (l.lt.nres-1) then
8420 itl1=itortyp(itype(l+1))
8425 s1=dip(4,jj,i)*dip(4,kk,k)
8427 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8428 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8429 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8430 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8431 call transpose2(EE(1,1,itk),auxmat(1,1))
8432 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8433 vv(1)=pizda(1,1)+pizda(2,2)
8434 vv(2)=pizda(2,1)-pizda(1,2)
8435 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8436 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8437 cd & "sum",-(s2+s3+s4)
8439 eello6_graph3=-(s1+s2+s3+s4)
8441 eello6_graph3=-(s2+s3+s4)
8444 C Derivatives in gamma(k-1)
8445 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8446 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8447 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8448 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8449 C Derivatives in gamma(l-1)
8450 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8451 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8452 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8453 vv(1)=pizda(1,1)+pizda(2,2)
8454 vv(2)=pizda(2,1)-pizda(1,2)
8455 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8456 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8457 C Cartesian derivatives.
8463 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8465 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8468 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8470 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8471 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8473 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8474 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8476 vv(1)=pizda(1,1)+pizda(2,2)
8477 vv(2)=pizda(2,1)-pizda(1,2)
8478 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8480 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8482 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8485 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8487 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8489 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8495 c----------------------------------------------------------------------------
8496 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8497 implicit real*8 (a-h,o-z)
8498 include 'DIMENSIONS'
8499 include 'COMMON.IOUNITS'
8500 include 'COMMON.CHAIN'
8501 include 'COMMON.DERIV'
8502 include 'COMMON.INTERACT'
8503 include 'COMMON.CONTACTS'
8505 include 'COMMON.CONTACTS.MOMENT'
8507 include 'COMMON.TORSION'
8508 include 'COMMON.VAR'
8509 include 'COMMON.GEO'
8510 include 'COMMON.FFIELD'
8511 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8512 & auxvec1(2),auxmat1(2,2)
8514 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8516 C Parallel Antiparallel C
8522 C \ j|/k\| \ |/k\|l C
8527 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8529 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8530 C energy moment and not to the cluster cumulant.
8531 cd write (2,*) 'eello_graph4: wturn6',wturn6
8532 iti=itortyp(itype(i))
8533 itj=itortyp(itype(j))
8534 if (j.lt.nres-1) then
8535 itj1=itortyp(itype(j+1))
8539 itk=itortyp(itype(k))
8540 if (k.lt.nres-1) then
8541 itk1=itortyp(itype(k+1))
8545 itl=itortyp(itype(l))
8546 if (l.lt.nres-1) then
8547 itl1=itortyp(itype(l+1))
8551 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8552 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8553 cd & ' itl',itl,' itl1',itl1
8556 s1=dip(3,jj,i)*dip(3,kk,k)
8558 s1=dip(2,jj,j)*dip(2,kk,l)
8561 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8562 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8564 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8565 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8567 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8568 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8570 call transpose2(EUg(1,1,k),auxmat(1,1))
8571 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8572 vv(1)=pizda(1,1)-pizda(2,2)
8573 vv(2)=pizda(2,1)+pizda(1,2)
8574 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8575 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8577 eello6_graph4=-(s1+s2+s3+s4)
8579 eello6_graph4=-(s2+s3+s4)
8581 C Derivatives in gamma(i-1)
8585 s1=dipderg(2,jj,i)*dip(3,kk,k)
8587 s1=dipderg(4,jj,j)*dip(2,kk,l)
8590 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8592 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8593 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8595 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8596 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8598 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8599 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8600 cd write (2,*) 'turn6 derivatives'
8602 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8604 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8608 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8610 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8614 C Derivatives in gamma(k-1)
8617 s1=dip(3,jj,i)*dipderg(2,kk,k)
8619 s1=dip(2,jj,j)*dipderg(4,kk,l)
8622 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8623 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8625 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8626 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8628 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8629 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8631 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8632 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8633 vv(1)=pizda(1,1)-pizda(2,2)
8634 vv(2)=pizda(2,1)+pizda(1,2)
8635 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8636 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8638 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8640 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8644 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8646 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8649 C Derivatives in gamma(j-1) or gamma(l-1)
8650 if (l.eq.j+1 .and. l.gt.1) then
8651 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8652 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8653 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8654 vv(1)=pizda(1,1)-pizda(2,2)
8655 vv(2)=pizda(2,1)+pizda(1,2)
8656 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8657 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8658 else if (j.gt.1) then
8659 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8660 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8661 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8662 vv(1)=pizda(1,1)-pizda(2,2)
8663 vv(2)=pizda(2,1)+pizda(1,2)
8664 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8665 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8666 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8668 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8671 C Cartesian derivatives.
8678 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8680 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8684 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8686 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8690 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8692 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8694 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8695 & b1(1,itj1),auxvec(1))
8696 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8698 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8699 & b1(1,itl1),auxvec(1))
8700 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8702 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8704 vv(1)=pizda(1,1)-pizda(2,2)
8705 vv(2)=pizda(2,1)+pizda(1,2)
8706 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8708 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8710 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8713 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8716 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8719 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8721 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8723 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8727 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8729 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8732 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8734 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8742 c----------------------------------------------------------------------------
8743 double precision function eello_turn6(i,jj,kk)
8744 implicit real*8 (a-h,o-z)
8745 include 'DIMENSIONS'
8746 include 'COMMON.IOUNITS'
8747 include 'COMMON.CHAIN'
8748 include 'COMMON.DERIV'
8749 include 'COMMON.INTERACT'
8750 include 'COMMON.CONTACTS'
8752 include 'COMMON.CONTACTS.MOMENT'
8754 include 'COMMON.TORSION'
8755 include 'COMMON.VAR'
8756 include 'COMMON.GEO'
8757 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8758 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8760 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8761 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8762 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8763 C the respective energy moment and not to the cluster cumulant.
8772 iti=itortyp(itype(i))
8773 itk=itortyp(itype(k))
8774 itk1=itortyp(itype(k+1))
8775 itl=itortyp(itype(l))
8776 itj=itortyp(itype(j))
8777 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8778 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8779 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8784 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8786 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8790 derx_turn(lll,kkk,iii)=0.0d0
8797 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8799 cd write (2,*) 'eello6_5',eello6_5
8801 call transpose2(AEA(1,1,1),auxmat(1,1))
8802 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8803 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8804 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8806 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8807 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8808 s2 = scalar2(b1(1,itk),vtemp1(1))
8810 call transpose2(AEA(1,1,2),atemp(1,1))
8811 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8812 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8813 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8815 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8816 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8817 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8819 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8820 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8821 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8822 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8823 ss13 = scalar2(b1(1,itk),vtemp4(1))
8824 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8826 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8832 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8833 C Derivatives in gamma(i+2)
8837 call transpose2(AEA(1,1,1),auxmatd(1,1))
8838 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8839 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8840 call transpose2(AEAderg(1,1,2),atempd(1,1))
8841 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8842 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8844 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8845 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8846 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8852 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8853 C Derivatives in gamma(i+3)
8855 call transpose2(AEA(1,1,1),auxmatd(1,1))
8856 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8857 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8858 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8860 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8861 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8862 s2d = scalar2(b1(1,itk),vtemp1d(1))
8864 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8865 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8867 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8869 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8870 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8871 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8879 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8880 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8882 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8883 & -0.5d0*ekont*(s2d+s12d)
8885 C Derivatives in gamma(i+4)
8886 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8887 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8888 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8890 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8891 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8892 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8900 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8902 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8904 C Derivatives in gamma(i+5)
8906 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8907 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8908 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8910 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8911 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8912 s2d = scalar2(b1(1,itk),vtemp1d(1))
8914 call transpose2(AEA(1,1,2),atempd(1,1))
8915 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8916 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8918 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8919 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8921 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8922 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8923 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8931 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8932 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8934 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8935 & -0.5d0*ekont*(s2d+s12d)
8937 C Cartesian derivatives
8942 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8943 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8944 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8946 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8947 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8949 s2d = scalar2(b1(1,itk),vtemp1d(1))
8951 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8952 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8953 s8d = -(atempd(1,1)+atempd(2,2))*
8954 & scalar2(cc(1,1,itl),vtemp2(1))
8956 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8958 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8959 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8966 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8969 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8973 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8974 & - 0.5d0*(s8d+s12d)
8976 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8985 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8987 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8988 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8989 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8990 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8991 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8993 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8994 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8995 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8999 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9000 cd & 16*eel_turn6_num
9002 if (j.lt.nres-1) then
9009 if (l.lt.nres-1) then
9017 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9018 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9019 cgrad ghalf=0.5d0*ggg1(ll)
9021 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9022 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9023 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9024 & +ekont*derx_turn(ll,2,1)
9025 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9026 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9027 & +ekont*derx_turn(ll,4,1)
9028 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9029 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9030 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9031 cgrad ghalf=0.5d0*ggg2(ll)
9033 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9034 & +ekont*derx_turn(ll,2,2)
9035 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9036 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9037 & +ekont*derx_turn(ll,4,2)
9038 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9039 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9040 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9045 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9050 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9056 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9061 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9065 cd write (2,*) iii,g_corr6_loc(iii)
9067 eello_turn6=ekont*eel_turn6
9068 cd write (2,*) 'ekont',ekont
9069 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9073 C-----------------------------------------------------------------------------
9074 double precision function scalar(u,v)
9075 !DIR$ INLINEALWAYS scalar
9077 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9080 double precision u(3),v(3)
9081 cd double precision sc
9089 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9092 crc-------------------------------------------------
9093 SUBROUTINE MATVEC2(A1,V1,V2)
9094 !DIR$ INLINEALWAYS MATVEC2
9096 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9098 implicit real*8 (a-h,o-z)
9099 include 'DIMENSIONS'
9100 DIMENSION A1(2,2),V1(2),V2(2)
9104 c 3 VI=VI+A1(I,K)*V1(K)
9108 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9109 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9114 C---------------------------------------
9115 SUBROUTINE MATMAT2(A1,A2,A3)
9117 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9119 implicit real*8 (a-h,o-z)
9120 include 'DIMENSIONS'
9121 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9122 c DIMENSION AI3(2,2)
9126 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9132 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9133 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9134 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9135 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9143 c-------------------------------------------------------------------------
9144 double precision function scalar2(u,v)
9145 !DIR$ INLINEALWAYS scalar2
9147 double precision u(2),v(2)
9150 scalar2=u(1)*v(1)+u(2)*v(2)
9154 C-----------------------------------------------------------------------------
9156 subroutine transpose2(a,at)
9157 !DIR$ INLINEALWAYS transpose2
9159 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9162 double precision a(2,2),at(2,2)
9169 c--------------------------------------------------------------------------
9170 subroutine transpose(n,a,at)
9173 double precision a(n,n),at(n,n)
9181 C---------------------------------------------------------------------------
9182 subroutine prodmat3(a1,a2,kk,transp,prod)
9183 !DIR$ INLINEALWAYS prodmat3
9185 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9189 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9191 crc double precision auxmat(2,2),prod_(2,2)
9194 crc call transpose2(kk(1,1),auxmat(1,1))
9195 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9196 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9198 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9199 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9200 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9201 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9202 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9203 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9204 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9205 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9208 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9209 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9211 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9212 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9213 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9214 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9215 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9216 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9217 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9218 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9221 c call transpose2(a2(1,1),a2t(1,1))
9224 crc print *,((prod_(i,j),i=1,2),j=1,2)
9225 crc print *,((prod(i,j),i=1,2),j=1,2)