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
1092 itypi=iabs(itype(i))
1093 itypi1=iabs(itype(i+1))
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)
1106 itypj=iabs(itype(j))
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
1269 itypi=iabs(itype(i))
1270 itypi1=iabs(itype(i+1))
1275 C Calculate SC interaction energy.
1277 do iint=1,nint_gr(i)
1278 do j=istart(i,iint),iend(i,iint)
1279 itypj=iabs(itype(j))
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
1386 itypi=iabs(itype(i))
1387 itypi1=iabs(itype(i+1))
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
1522 itypi=iabs(itype(i))
1523 itypi1=iabs(itype(i+1))
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)
1540 itypj=iabs(itype(j))
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
1681 itypi=iabs(itype(i))
1682 itypi1=iabs(itype(i+1))
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)
1697 itypj=iabs(itype(j))
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
2004 itypi=iabs(itype(i))
2005 itypi1=iabs(itype(i+1))
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)
2016 itypj=iabs(itype(j))
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)
4035 itypj=iabs(itype(j))
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)
4129 itypj=iabs(itype(j))
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 cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj
4243 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4244 C distance and angle dependent SS bond potential.
4245 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and. iabs(itype(jjj
4247 call ssbond_ene(iii,jjj,eij)
4249 cd write (iout,*) "eij",eij
4251 C Calculate the distance between the two points and its difference from the
4255 C Get the force constant corresponding to this distance.
4257 C Calculate the contribution to energy.
4258 ehpb=ehpb+waga*rdis*rdis
4260 C Evaluate gradient.
4263 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4264 cd & ' waga=',waga,' fac=',fac
4266 ggg(j)=fac*(c(j,jj)-c(j,ii))
4268 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4269 C If this is a SC-SC distance, we need to calculate the contributions to the
4270 C Cartesian gradient in the SC vectors (ghpbx).
4273 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4274 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4277 cgrad do j=iii,jjj-1
4279 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4283 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4284 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4291 C--------------------------------------------------------------------------
4292 subroutine ssbond_ene(i,j,eij)
4294 C Calculate the distance and angle dependent SS-bond potential energy
4295 C using a free-energy function derived based on RHF/6-31G** ab initio
4296 C calculations of diethyl disulfide.
4298 C A. Liwo and U. Kozlowska, 11/24/03
4300 implicit real*8 (a-h,o-z)
4301 include 'DIMENSIONS'
4302 include 'COMMON.SBRIDGE'
4303 include 'COMMON.CHAIN'
4304 include 'COMMON.DERIV'
4305 include 'COMMON.LOCAL'
4306 include 'COMMON.INTERACT'
4307 include 'COMMON.VAR'
4308 include 'COMMON.IOUNITS'
4309 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4310 itypi=iabs(itype(i))
4314 dxi=dc_norm(1,nres+i)
4315 dyi=dc_norm(2,nres+i)
4316 dzi=dc_norm(3,nres+i)
4317 c dsci_inv=dsc_inv(itypi)
4318 dsci_inv=vbld_inv(nres+i)
4319 itypj=iabs(itype(j))
4320 c dscj_inv=dsc_inv(itypj)
4321 dscj_inv=vbld_inv(nres+j)
4325 dxj=dc_norm(1,nres+j)
4326 dyj=dc_norm(2,nres+j)
4327 dzj=dc_norm(3,nres+j)
4328 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4333 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4334 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4335 om12=dxi*dxj+dyi*dyj+dzi*dzj
4337 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4338 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4344 deltat12=om2-om1+2.0d0
4346 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4347 & +akct*deltad*deltat12
4348 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4349 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4350 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4351 c & " deltat12",deltat12," eij",eij
4352 ed=2*akcm*deltad+akct*deltat12
4354 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4355 eom1=-2*akth*deltat1-pom1-om2*pom2
4356 eom2= 2*akth*deltat2+pom1-om1*pom2
4359 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4360 ghpbx(k,i)=ghpbx(k,i)-ggk
4361 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4362 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4363 ghpbx(k,j)=ghpbx(k,j)+ggk
4364 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4365 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4366 ghpbc(k,i)=ghpbc(k,i)-ggk
4367 ghpbc(k,j)=ghpbc(k,j)+ggk
4370 C Calculate the components of the gradient in DC and X
4374 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4379 C--------------------------------------------------------------------------
4380 subroutine ebond(estr)
4382 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4384 implicit real*8 (a-h,o-z)
4385 include 'DIMENSIONS'
4386 include 'COMMON.LOCAL'
4387 include 'COMMON.GEO'
4388 include 'COMMON.INTERACT'
4389 include 'COMMON.DERIV'
4390 include 'COMMON.VAR'
4391 include 'COMMON.CHAIN'
4392 include 'COMMON.IOUNITS'
4393 include 'COMMON.NAMES'
4394 include 'COMMON.FFIELD'
4395 include 'COMMON.CONTROL'
4396 include 'COMMON.SETUP'
4397 double precision u(3),ud(3)
4399 do i=ibondp_start,ibondp_end
4400 diff = vbld(i)-vbldp0
4401 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4404 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4406 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4410 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4412 do i=ibond_start,ibond_end
4417 diff=vbld(i+nres)-vbldsc0(1,iti)
4418 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4419 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4420 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4422 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4426 diff=vbld(i+nres)-vbldsc0(j,iti)
4427 ud(j)=aksc(j,iti)*diff
4428 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4442 uprod2=uprod2*u(k)*u(k)
4446 usumsqder=usumsqder+ud(j)*uprod2
4448 estr=estr+uprod/usum
4450 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4458 C--------------------------------------------------------------------------
4459 subroutine ebend(etheta)
4461 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4462 C angles gamma and its derivatives in consecutive thetas and gammas.
4464 implicit real*8 (a-h,o-z)
4465 include 'DIMENSIONS'
4466 include 'COMMON.LOCAL'
4467 include 'COMMON.GEO'
4468 include 'COMMON.INTERACT'
4469 include 'COMMON.DERIV'
4470 include 'COMMON.VAR'
4471 include 'COMMON.CHAIN'
4472 include 'COMMON.IOUNITS'
4473 include 'COMMON.NAMES'
4474 include 'COMMON.FFIELD'
4475 include 'COMMON.CONTROL'
4476 common /calcthet/ term1,term2,termm,diffak,ratak,
4477 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4478 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4479 double precision y(2),z(2)
4481 c time11=dexp(-2*time)
4484 c write (*,'(a,i2)') 'EBEND ICG=',icg
4485 do i=ithet_start,ithet_end
4486 C Zero the energy function and its derivative at 0 or pi.
4487 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4489 ichir1=isign(1,itype(i-2))
4490 ichir2=isign(1,itype(i))
4491 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4492 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4493 if (itype(i-1).eq.10) then
4494 itype1=isign(10,itype(i-2))
4495 ichir11=isign(1,itype(i-2))
4496 ichir12=isign(1,itype(i-2))
4497 itype2=isign(10,itype(i))
4498 ichir21=isign(1,itype(i))
4499 ichir22=isign(1,itype(i))
4504 if (phii.ne.phii) phii=150.0
4517 if (phii1.ne.phii1) phii1=150.0
4529 C Calculate the "mean" value of theta from the part of the distribution
4530 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4531 C In following comments this theta will be referred to as t_c.
4532 thet_pred_mean=0.0d0
4534 athetk=athet(k,it,ichir1,ichir2)
4535 bthetk=bthet(k,it,ichir1,ichir2)
4537 athetk=athet(k,itype1,ichir11,ichir12)
4538 bthetk=bthet(k,itype2,ichir21,ichir22)
4540 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4542 dthett=thet_pred_mean*ssd
4543 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4544 C Derivatives of the "mean" values in gamma1 and gamma2.
4545 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4546 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4547 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4548 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4550 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4551 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4552 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4553 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4555 if (theta(i).gt.pi-delta) then
4556 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4558 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4559 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4560 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4562 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4564 else if (theta(i).lt.delta) then
4565 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4566 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4567 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4569 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4570 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4573 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4576 etheta=etheta+ethetai
4577 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4579 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4580 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4581 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4583 C Ufff.... We've done all this!!!
4586 C---------------------------------------------------------------------------
4587 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4589 implicit real*8 (a-h,o-z)
4590 include 'DIMENSIONS'
4591 include 'COMMON.LOCAL'
4592 include 'COMMON.IOUNITS'
4593 common /calcthet/ term1,term2,termm,diffak,ratak,
4594 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4595 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4596 C Calculate the contributions to both Gaussian lobes.
4597 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4598 C The "polynomial part" of the "standard deviation" of this part of
4602 sig=sig*thet_pred_mean+polthet(j,it)
4604 C Derivative of the "interior part" of the "standard deviation of the"
4605 C gamma-dependent Gaussian lobe in t_c.
4606 sigtc=3*polthet(3,it)
4608 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4611 C Set the parameters of both Gaussian lobes of the distribution.
4612 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4613 fac=sig*sig+sigc0(it)
4616 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4617 sigsqtc=-4.0D0*sigcsq*sigtc
4618 c print *,i,sig,sigtc,sigsqtc
4619 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4620 sigtc=-sigtc/(fac*fac)
4621 C Following variable is sigma(t_c)**(-2)
4622 sigcsq=sigcsq*sigcsq
4624 sig0inv=1.0D0/sig0i**2
4625 delthec=thetai-thet_pred_mean
4626 delthe0=thetai-theta0i
4627 term1=-0.5D0*sigcsq*delthec*delthec
4628 term2=-0.5D0*sig0inv*delthe0*delthe0
4629 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4630 C NaNs in taking the logarithm. We extract the largest exponent which is added
4631 C to the energy (this being the log of the distribution) at the end of energy
4632 C term evaluation for this virtual-bond angle.
4633 if (term1.gt.term2) then
4635 term2=dexp(term2-termm)
4639 term1=dexp(term1-termm)
4642 C The ratio between the gamma-independent and gamma-dependent lobes of
4643 C the distribution is a Gaussian function of thet_pred_mean too.
4644 diffak=gthet(2,it)-thet_pred_mean
4645 ratak=diffak/gthet(3,it)**2
4646 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4647 C Let's differentiate it in thet_pred_mean NOW.
4649 C Now put together the distribution terms to make complete distribution.
4650 termexp=term1+ak*term2
4651 termpre=sigc+ak*sig0i
4652 C Contribution of the bending energy from this theta is just the -log of
4653 C the sum of the contributions from the two lobes and the pre-exponential
4654 C factor. Simple enough, isn't it?
4655 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4656 C NOW the derivatives!!!
4657 C 6/6/97 Take into account the deformation.
4658 E_theta=(delthec*sigcsq*term1
4659 & +ak*delthe0*sig0inv*term2)/termexp
4660 E_tc=((sigtc+aktc*sig0i)/termpre
4661 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4662 & aktc*term2)/termexp)
4665 c-----------------------------------------------------------------------------
4666 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4667 implicit real*8 (a-h,o-z)
4668 include 'DIMENSIONS'
4669 include 'COMMON.LOCAL'
4670 include 'COMMON.IOUNITS'
4671 common /calcthet/ term1,term2,termm,diffak,ratak,
4672 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4673 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4674 delthec=thetai-thet_pred_mean
4675 delthe0=thetai-theta0i
4676 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4677 t3 = thetai-thet_pred_mean
4681 t14 = t12+t6*sigsqtc
4683 t21 = thetai-theta0i
4689 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4690 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4691 & *(-t12*t9-ak*sig0inv*t27)
4695 C--------------------------------------------------------------------------
4696 subroutine ebend(etheta)
4698 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4699 C angles gamma and its derivatives in consecutive thetas and gammas.
4700 C ab initio-derived potentials from
4701 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4703 implicit real*8 (a-h,o-z)
4704 include 'DIMENSIONS'
4705 include 'COMMON.LOCAL'
4706 include 'COMMON.GEO'
4707 include 'COMMON.INTERACT'
4708 include 'COMMON.DERIV'
4709 include 'COMMON.VAR'
4710 include 'COMMON.CHAIN'
4711 include 'COMMON.IOUNITS'
4712 include 'COMMON.NAMES'
4713 include 'COMMON.FFIELD'
4714 include 'COMMON.CONTROL'
4715 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4716 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4717 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4718 & sinph1ph2(maxdouble,maxdouble)
4719 logical lprn /.false./, lprn1 /.false./
4721 do i=ithet_start,ithet_end
4725 theti2=0.5d0*theta(i)
4726 ityp2=ithetyp(iabs(itype(i-1)))
4728 coskt(k)=dcos(k*theti2)
4729 sinkt(k)=dsin(k*theti2)
4734 if (phii.ne.phii) phii=150.0
4738 ityp1=ithetyp(iabs(itype(i-2)))
4740 cosph1(k)=dcos(k*phii)
4741 sinph1(k)=dsin(k*phii)
4754 if (phii1.ne.phii1) phii1=150.0
4759 ityp3=ithetyp(iabs(itype(i)))
4761 cosph2(k)=dcos(k*phii1)
4762 sinph2(k)=dsin(k*phii1)
4772 ethetai=aa0thet(ityp1,ityp2,ityp3)
4775 ccl=cosph1(l)*cosph2(k-l)
4776 ssl=sinph1(l)*sinph2(k-l)
4777 scl=sinph1(l)*cosph2(k-l)
4778 csl=cosph1(l)*sinph2(k-l)
4779 cosph1ph2(l,k)=ccl-ssl
4780 cosph1ph2(k,l)=ccl+ssl
4781 sinph1ph2(l,k)=scl+csl
4782 sinph1ph2(k,l)=scl-csl
4786 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4787 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4788 write (iout,*) "coskt and sinkt"
4790 write (iout,*) k,coskt(k),sinkt(k)
4794 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4795 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4798 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4799 & " ethetai",ethetai
4802 write (iout,*) "cosph and sinph"
4804 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4806 write (iout,*) "cosph1ph2 and sinph2ph2"
4809 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4810 & sinph1ph2(l,k),sinph1ph2(k,l)
4813 write(iout,*) "ethetai",ethetai
4817 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4818 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4819 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4820 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4821 ethetai=ethetai+sinkt(m)*aux
4822 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4823 dephii=dephii+k*sinkt(m)*(
4824 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4825 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4826 dephii1=dephii1+k*sinkt(m)*(
4827 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4828 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4830 & write (iout,*) "m",m," k",k," bbthet",
4831 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4832 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4833 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4834 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4838 & write(iout,*) "ethetai",ethetai
4842 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4843 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4844 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4845 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4846 ethetai=ethetai+sinkt(m)*aux
4847 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4848 dephii=dephii+l*sinkt(m)*(
4849 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4850 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4851 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4852 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4853 dephii1=dephii1+(k-l)*sinkt(m)*(
4854 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4855 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4856 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4857 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4859 write (iout,*) "m",m," k",k," l",l," ffthet",
4860 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4861 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4862 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4863 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4864 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4865 & cosph1ph2(k,l)*sinkt(m),
4866 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4872 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4873 & i,theta(i)*rad2deg,phii*rad2deg,
4874 & phii1*rad2deg,ethetai
4875 etheta=etheta+ethetai
4876 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4877 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4878 gloc(nphi+i-2,icg)=wang*dethetai
4884 c-----------------------------------------------------------------------------
4885 subroutine esc(escloc)
4886 C Calculate the local energy of a side chain and its derivatives in the
4887 C corresponding virtual-bond valence angles THETA and the spherical angles
4889 implicit real*8 (a-h,o-z)
4890 include 'DIMENSIONS'
4891 include 'COMMON.GEO'
4892 include 'COMMON.LOCAL'
4893 include 'COMMON.VAR'
4894 include 'COMMON.INTERACT'
4895 include 'COMMON.DERIV'
4896 include 'COMMON.CHAIN'
4897 include 'COMMON.IOUNITS'
4898 include 'COMMON.NAMES'
4899 include 'COMMON.FFIELD'
4900 include 'COMMON.CONTROL'
4901 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4902 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4903 common /sccalc/ time11,time12,time112,theti,it,nlobit
4906 c write (iout,'(a)') 'ESC'
4907 do i=loc_start,loc_end
4909 if (it.eq.10) goto 1
4910 nlobit=nlob(iabs(it))
4911 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4912 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4913 theti=theta(i+1)-pipol
4918 if (x(2).gt.pi-delta) then
4922 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4924 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4925 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4927 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4928 & ddersc0(1),dersc(1))
4929 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4930 & ddersc0(3),dersc(3))
4932 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4934 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4935 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4936 & dersc0(2),esclocbi,dersc02)
4937 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4939 call splinthet(x(2),0.5d0*delta,ss,ssd)
4944 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4946 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4947 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4949 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4951 c write (iout,*) escloci
4952 else if (x(2).lt.delta) then
4956 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4958 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4959 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4961 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4962 & ddersc0(1),dersc(1))
4963 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4964 & ddersc0(3),dersc(3))
4966 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4968 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4969 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4970 & dersc0(2),esclocbi,dersc02)
4971 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4976 call splinthet(x(2),0.5d0*delta,ss,ssd)
4978 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4980 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4981 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4983 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4984 c write (iout,*) escloci
4986 call enesc(x,escloci,dersc,ddummy,.false.)
4989 escloc=escloc+escloci
4990 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4991 & 'escloc',i,escloci
4992 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4994 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4996 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4997 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5002 C---------------------------------------------------------------------------
5003 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5004 implicit real*8 (a-h,o-z)
5005 include 'DIMENSIONS'
5006 include 'COMMON.GEO'
5007 include 'COMMON.LOCAL'
5008 include 'COMMON.IOUNITS'
5009 common /sccalc/ time11,time12,time112,theti,it,nlobit
5010 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5011 double precision contr(maxlob,-1:1)
5013 c write (iout,*) 'it=',it,' nlobit=',nlobit
5017 if (mixed) ddersc(j)=0.0d0
5021 C Because of periodicity of the dependence of the SC energy in omega we have
5022 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5023 C To avoid underflows, first compute & store the exponents.
5031 z(k)=x(k)-censc(k,j,it)
5036 Axk=Axk+gaussc(l,k,j,it)*z(l)
5042 expfac=expfac+Ax(k,j,iii)*z(k)
5050 C As in the case of ebend, we want to avoid underflows in exponentiation and
5051 C subsequent NaNs and INFs in energy calculation.
5052 C Find the largest exponent
5056 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5060 cd print *,'it=',it,' emin=',emin
5062 C Compute the contribution to SC energy and derivatives
5067 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5068 if(adexp.ne.adexp) adexp=1.0
5071 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5073 cd print *,'j=',j,' expfac=',expfac
5074 escloc_i=escloc_i+expfac
5076 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5080 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5081 & +gaussc(k,2,j,it))*expfac
5088 dersc(1)=dersc(1)/cos(theti)**2
5089 ddersc(1)=ddersc(1)/cos(theti)**2
5092 escloci=-(dlog(escloc_i)-emin)
5094 dersc(j)=dersc(j)/escloc_i
5098 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5103 C------------------------------------------------------------------------------
5104 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5105 implicit real*8 (a-h,o-z)
5106 include 'DIMENSIONS'
5107 include 'COMMON.GEO'
5108 include 'COMMON.LOCAL'
5109 include 'COMMON.IOUNITS'
5110 common /sccalc/ time11,time12,time112,theti,it,nlobit
5111 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5112 double precision contr(maxlob)
5123 z(k)=x(k)-censc(k,j,it)
5129 Axk=Axk+gaussc(l,k,j,it)*z(l)
5135 expfac=expfac+Ax(k,j)*z(k)
5140 C As in the case of ebend, we want to avoid underflows in exponentiation and
5141 C subsequent NaNs and INFs in energy calculation.
5142 C Find the largest exponent
5145 if (emin.gt.contr(j)) emin=contr(j)
5149 C Compute the contribution to SC energy and derivatives
5153 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5154 escloc_i=escloc_i+expfac
5156 dersc(k)=dersc(k)+Ax(k,j)*expfac
5158 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5159 & +gaussc(1,2,j,it))*expfac
5163 dersc(1)=dersc(1)/cos(theti)**2
5164 dersc12=dersc12/cos(theti)**2
5165 escloci=-(dlog(escloc_i)-emin)
5167 dersc(j)=dersc(j)/escloc_i
5169 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5173 c----------------------------------------------------------------------------------
5174 subroutine esc(escloc)
5175 C Calculate the local energy of a side chain and its derivatives in the
5176 C corresponding virtual-bond valence angles THETA and the spherical angles
5177 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5178 C added by Urszula Kozlowska. 07/11/2007
5180 implicit real*8 (a-h,o-z)
5181 include 'DIMENSIONS'
5182 include 'COMMON.GEO'
5183 include 'COMMON.LOCAL'
5184 include 'COMMON.VAR'
5185 include 'COMMON.SCROT'
5186 include 'COMMON.INTERACT'
5187 include 'COMMON.DERIV'
5188 include 'COMMON.CHAIN'
5189 include 'COMMON.IOUNITS'
5190 include 'COMMON.NAMES'
5191 include 'COMMON.FFIELD'
5192 include 'COMMON.CONTROL'
5193 include 'COMMON.VECTORS'
5194 double precision x_prime(3),y_prime(3),z_prime(3)
5195 & , sumene,dsc_i,dp2_i,x(65),
5196 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5197 & de_dxx,de_dyy,de_dzz,de_dt
5198 double precision s1_t,s1_6_t,s2_t,s2_6_t
5200 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5201 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5202 & dt_dCi(3),dt_dCi1(3)
5203 common /sccalc/ time11,time12,time112,theti,it,nlobit
5206 do i=loc_start,loc_end
5207 costtab(i+1) =dcos(theta(i+1))
5208 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5209 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5210 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5211 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5212 cosfac=dsqrt(cosfac2)
5213 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5214 sinfac=dsqrt(sinfac2)
5216 if (it.eq.10) goto 1
5218 C Compute the axes of tghe local cartesian coordinates system; store in
5219 c x_prime, y_prime and z_prime
5226 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5227 C & dc_norm(3,i+nres)
5229 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5230 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5233 z_prime(j) = -uz(j,i-1)
5236 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5237 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5238 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5239 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5240 c & " xy",scalar(x_prime(1),y_prime(1)),
5241 c & " xz",scalar(x_prime(1),z_prime(1)),
5242 c & " yy",scalar(y_prime(1),y_prime(1)),
5243 c & " yz",scalar(y_prime(1),z_prime(1)),
5244 c & " zz",scalar(z_prime(1),z_prime(1))
5246 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5247 C to local coordinate system. Store in xx, yy, zz.
5253 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5254 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5255 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5262 C Compute the energy of the ith side cbain
5264 c write (2,*) "xx",xx," yy",yy," zz",zz
5267 x(j) = sc_parmin(j,it)
5270 Cc diagnostics - remove later
5272 yy1 = dsin(alph(2))*dcos(omeg(2))
5273 zz1 = -dsin(alph(2))*dsin(omeg(2))
5274 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5275 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5277 C," --- ", xx_w,yy_w,zz_w
5280 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5281 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5283 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5284 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5286 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5287 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5288 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5289 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5290 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5292 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5293 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5294 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5295 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5296 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5298 dsc_i = 0.743d0+x(61)
5300 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5301 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5302 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5303 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5304 s1=(1+x(63))/(0.1d0 + dscp1)
5305 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5306 s2=(1+x(65))/(0.1d0 + dscp2)
5307 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5308 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5309 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5310 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5312 c & dscp1,dscp2,sumene
5313 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5314 escloc = escloc + sumene
5315 c write (2,*) "i",i," escloc",sumene,escloc
5318 C This section to check the numerical derivatives of the energy of ith side
5319 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5320 C #define DEBUG in the code to turn it on.
5322 write (2,*) "sumene =",sumene
5326 write (2,*) xx,yy,zz
5327 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5328 de_dxx_num=(sumenep-sumene)/aincr
5330 write (2,*) "xx+ sumene from enesc=",sumenep
5333 write (2,*) xx,yy,zz
5334 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5335 de_dyy_num=(sumenep-sumene)/aincr
5337 write (2,*) "yy+ sumene from enesc=",sumenep
5340 write (2,*) xx,yy,zz
5341 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5342 de_dzz_num=(sumenep-sumene)/aincr
5344 write (2,*) "zz+ sumene from enesc=",sumenep
5345 costsave=cost2tab(i+1)
5346 sintsave=sint2tab(i+1)
5347 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5348 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5349 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5350 de_dt_num=(sumenep-sumene)/aincr
5351 write (2,*) " t+ sumene from enesc=",sumenep
5352 cost2tab(i+1)=costsave
5353 sint2tab(i+1)=sintsave
5354 C End of diagnostics section.
5357 C Compute the gradient of esc
5359 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5360 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5361 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5362 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5363 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5364 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5365 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5366 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5367 pom1=(sumene3*sint2tab(i+1)+sumene1)
5368 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5369 pom2=(sumene4*cost2tab(i+1)+sumene2)
5370 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5371 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5372 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5373 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5375 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5376 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5377 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5379 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5380 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5381 & +(pom1+pom2)*pom_dx
5383 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5386 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5387 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5388 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5390 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5391 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5392 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5393 & +x(59)*zz**2 +x(60)*xx*zz
5394 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5395 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5396 & +(pom1-pom2)*pom_dy
5398 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5401 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5402 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5403 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5404 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5405 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5406 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5407 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5408 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5410 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5413 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5414 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5415 & +pom1*pom_dt1+pom2*pom_dt2
5417 write(2,*), "de_dt = ", de_dt,de_dt_num
5421 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5422 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5423 cosfac2xx=cosfac2*xx
5424 sinfac2yy=sinfac2*yy
5426 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5428 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5430 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5431 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5432 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5433 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5434 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5435 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5436 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5437 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5438 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5439 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5443 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5444 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5447 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5448 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5449 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5451 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5452 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5456 dXX_Ctab(k,i)=dXX_Ci(k)
5457 dXX_C1tab(k,i)=dXX_Ci1(k)
5458 dYY_Ctab(k,i)=dYY_Ci(k)
5459 dYY_C1tab(k,i)=dYY_Ci1(k)
5460 dZZ_Ctab(k,i)=dZZ_Ci(k)
5461 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5462 dXX_XYZtab(k,i)=dXX_XYZ(k)
5463 dYY_XYZtab(k,i)=dYY_XYZ(k)
5464 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5468 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5469 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5470 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5471 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5472 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5474 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5475 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5476 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5477 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5478 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5479 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5480 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5481 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5483 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5484 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5486 C to check gradient call subroutine check_grad
5492 c------------------------------------------------------------------------------
5493 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5495 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5496 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5497 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5498 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5500 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5501 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5503 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5504 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5505 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5506 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5507 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5509 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5510 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5511 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5512 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5513 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5515 dsc_i = 0.743d0+x(61)
5517 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5518 & *(xx*cost2+yy*sint2))
5519 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5520 & *(xx*cost2-yy*sint2))
5521 s1=(1+x(63))/(0.1d0 + dscp1)
5522 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5523 s2=(1+x(65))/(0.1d0 + dscp2)
5524 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5525 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5526 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5531 c------------------------------------------------------------------------------
5532 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5534 C This procedure calculates two-body contact function g(rij) and its derivative:
5537 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5540 C where x=(rij-r0ij)/delta
5542 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5545 double precision rij,r0ij,eps0ij,fcont,fprimcont
5546 double precision x,x2,x4,delta
5550 if (x.lt.-1.0D0) then
5553 else if (x.le.1.0D0) then
5556 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5557 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5564 c------------------------------------------------------------------------------
5565 subroutine splinthet(theti,delta,ss,ssder)
5566 implicit real*8 (a-h,o-z)
5567 include 'DIMENSIONS'
5568 include 'COMMON.VAR'
5569 include 'COMMON.GEO'
5572 if (theti.gt.pipol) then
5573 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5575 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5580 c------------------------------------------------------------------------------
5581 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5583 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5584 double precision ksi,ksi2,ksi3,a1,a2,a3
5585 a1=fprim0*delta/(f1-f0)
5591 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5592 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5595 c------------------------------------------------------------------------------
5596 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5598 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5599 double precision ksi,ksi2,ksi3,a1,a2,a3
5604 a2=3*(f1x-f0x)-2*fprim0x*delta
5605 a3=fprim0x*delta-2*(f1x-f0x)
5606 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5609 C-----------------------------------------------------------------------------
5611 C-----------------------------------------------------------------------------
5612 subroutine etor(etors,edihcnstr)
5613 implicit real*8 (a-h,o-z)
5614 include 'DIMENSIONS'
5615 include 'COMMON.VAR'
5616 include 'COMMON.GEO'
5617 include 'COMMON.LOCAL'
5618 include 'COMMON.TORSION'
5619 include 'COMMON.INTERACT'
5620 include 'COMMON.DERIV'
5621 include 'COMMON.CHAIN'
5622 include 'COMMON.NAMES'
5623 include 'COMMON.IOUNITS'
5624 include 'COMMON.FFIELD'
5625 include 'COMMON.TORCNSTR'
5626 include 'COMMON.CONTROL'
5628 C Set lprn=.true. for debugging
5632 do i=iphi_start,iphi_end
5634 itori=itortyp(itype(i-2))
5635 itori1=itortyp(itype(i-1))
5636 if (iabs(itype(i)).eq.20) then
5643 C Proline-Proline pair is a special case...
5644 if (itori.eq.3 .and. itori1.eq.3) then
5645 if (phii.gt.-dwapi3) then
5647 fac=1.0D0/(1.0D0-cosphi)
5648 etorsi=v1(1,3,3)*fac
5649 etorsi=etorsi+etorsi
5650 etors=etors+etorsi-v1(1,3,3)
5651 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5652 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5655 v1ij=v1(j+1,itori,itori1)
5656 v2ij=v2(j+1,itori,itori1)
5659 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5660 if (energy_dec) etors_ii=etors_ii+
5661 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5662 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5666 v1ij=v1(j,itori,itori1)
5667 v2ij=v2(j,itori,itori1)
5670 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5671 if (energy_dec) etors_ii=etors_ii+
5672 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5673 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5676 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5679 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5680 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5681 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5682 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5683 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5685 ! 6/20/98 - dihedral angle constraints
5688 itori=idih_constr(i)
5691 if (difi.gt.drange(i)) then
5693 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5694 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5695 else if (difi.lt.-drange(i)) then
5697 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5698 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5700 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5701 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5703 ! write (iout,*) 'edihcnstr',edihcnstr
5706 c------------------------------------------------------------------------------
5707 subroutine etor_d(etors_d)
5711 c----------------------------------------------------------------------------
5713 subroutine etor(etors,edihcnstr)
5714 implicit real*8 (a-h,o-z)
5715 include 'DIMENSIONS'
5716 include 'COMMON.VAR'
5717 include 'COMMON.GEO'
5718 include 'COMMON.LOCAL'
5719 include 'COMMON.TORSION'
5720 include 'COMMON.INTERACT'
5721 include 'COMMON.DERIV'
5722 include 'COMMON.CHAIN'
5723 include 'COMMON.NAMES'
5724 include 'COMMON.IOUNITS'
5725 include 'COMMON.FFIELD'
5726 include 'COMMON.TORCNSTR'
5727 include 'COMMON.CONTROL'
5729 C Set lprn=.true. for debugging
5733 do i=iphi_start,iphi_end
5735 itori=itortyp(itype(i-2))
5736 itori1=itortyp(itype(i-1))
5739 C Regular cosine and sine terms
5740 do j=1,nterm(itori,itori1,iblock)
5741 v1ij=v1(j,itori,itori1,iblock)
5742 v2ij=v2(j,itori,itori1,iblock)
5745 etors=etors+v1ij*cosphi+v2ij*sinphi
5746 if (energy_dec) etors_ii=etors_ii+
5747 & v1ij*cosphi+v2ij*sinphi
5748 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5752 C E = SUM ----------------------------------- - v1
5753 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5755 cosphi=dcos(0.5d0*phii)
5756 sinphi=dsin(0.5d0*phii)
5757 do j=1,nlor(itori,itori1,iblock)
5758 vl1ij=vlor1(j,itori,itori1)
5759 vl2ij=vlor2(j,itori,itori1)
5760 vl3ij=vlor3(j,itori,itori1)
5761 pom=vl2ij*cosphi+vl3ij*sinphi
5762 pom1=1.0d0/(pom*pom+1.0d0)
5763 etors=etors+vl1ij*pom1
5764 if (energy_dec) etors_ii=etors_ii+
5767 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5769 C Subtract the constant term
5770 etors=etors-v0(itori,itori1,iblock)
5771 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5772 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
5774 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5775 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5776 & (v1(j,itori,itori1,iblock),j=1,6),
5777 & (v2(j,itori,itori1,iblock),j=1,6)
5778 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5779 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5781 ! 6/20/98 - dihedral angle constraints
5783 c do i=1,ndih_constr
5784 do i=idihconstr_start,idihconstr_end
5785 itori=idih_constr(i)
5787 difi=pinorm(phii-phi0(i))
5788 if (difi.gt.drange(i)) then
5790 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5791 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5792 else if (difi.lt.-drange(i)) then
5794 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5795 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5799 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5800 cd & rad2deg*phi0(i), rad2deg*drange(i),
5801 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5803 cd write (iout,*) 'edihcnstr',edihcnstr
5806 c----------------------------------------------------------------------------
5807 subroutine etor_d(etors_d)
5808 C 6/23/01 Compute double torsional energy
5809 implicit real*8 (a-h,o-z)
5810 include 'DIMENSIONS'
5811 include 'COMMON.VAR'
5812 include 'COMMON.GEO'
5813 include 'COMMON.LOCAL'
5814 include 'COMMON.TORSION'
5815 include 'COMMON.INTERACT'
5816 include 'COMMON.DERIV'
5817 include 'COMMON.CHAIN'
5818 include 'COMMON.NAMES'
5819 include 'COMMON.IOUNITS'
5820 include 'COMMON.FFIELD'
5821 include 'COMMON.TORCNSTR'
5823 C Set lprn=.true. for debugging
5827 do i=iphid_start,iphid_end
5828 itori=itortyp(itype(i-2))
5829 itori1=itortyp(itype(i-1))
5830 itori2=itortyp(itype(i))
5832 if (iabs(itype(i+1)).eq.20) iblock=2
5837 C Regular cosine and sine terms
5838 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5839 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5840 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5841 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5842 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5843 cosphi1=dcos(j*phii)
5844 sinphi1=dsin(j*phii)
5845 cosphi2=dcos(j*phii1)
5846 sinphi2=dsin(j*phii1)
5847 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5848 & v2cij*cosphi2+v2sij*sinphi2
5849 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5850 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5852 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5854 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5855 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5856 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5857 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5858 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5859 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5860 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5861 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5862 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5863 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5864 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5865 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5866 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5867 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5870 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5871 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5876 c------------------------------------------------------------------------------
5877 subroutine eback_sc_corr(esccor)
5878 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5879 c conformational states; temporarily implemented as differences
5880 c between UNRES torsional potentials (dependent on three types of
5881 c residues) and the torsional potentials dependent on all 20 types
5882 c of residues computed from AM1 energy surfaces of terminally-blocked
5883 c amino-acid residues.
5884 implicit real*8 (a-h,o-z)
5885 include 'DIMENSIONS'
5886 include 'COMMON.VAR'
5887 include 'COMMON.GEO'
5888 include 'COMMON.LOCAL'
5889 include 'COMMON.TORSION'
5890 include 'COMMON.SCCOR'
5891 include 'COMMON.INTERACT'
5892 include 'COMMON.DERIV'
5893 include 'COMMON.CHAIN'
5894 include 'COMMON.NAMES'
5895 include 'COMMON.IOUNITS'
5896 include 'COMMON.FFIELD'
5897 include 'COMMON.CONTROL'
5899 C Set lprn=.true. for debugging
5902 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5904 do i=iphi_start,iphi_end
5911 v1ij=v1sccor(j,itori,itori1)
5912 v2ij=v2sccor(j,itori,itori1)
5915 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5916 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5919 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5920 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5921 & (v1sccor(j,itori,itori1),j=1,6),(v2sccor(j,itori,itori1),j=1,6)
5922 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5926 c----------------------------------------------------------------------------
5927 subroutine multibody(ecorr)
5928 C This subroutine calculates multi-body contributions to energy following
5929 C the idea of Skolnick et al. If side chains I and J make a contact and
5930 C at the same time side chains I+1 and J+1 make a contact, an extra
5931 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5932 implicit real*8 (a-h,o-z)
5933 include 'DIMENSIONS'
5934 include 'COMMON.IOUNITS'
5935 include 'COMMON.DERIV'
5936 include 'COMMON.INTERACT'
5937 include 'COMMON.CONTACTS'
5939 include 'COMMON.CONTACTS.MOMENT'
5941 double precision gx(3),gx1(3)
5944 C Set lprn=.true. for debugging
5948 write (iout,'(a)') 'Contact function values:'
5950 write (iout,'(i2,20(1x,i2,f10.5))')
5951 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5966 num_conti=num_cont(i)
5967 num_conti1=num_cont(i1)
5972 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5973 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5974 cd & ' ishift=',ishift
5975 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5976 C The system gains extra energy.
5977 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5978 endif ! j1==j+-ishift
5987 c------------------------------------------------------------------------------
5988 double precision function esccorr(i,j,k,l,jj,kk)
5989 implicit real*8 (a-h,o-z)
5990 include 'DIMENSIONS'
5991 include 'COMMON.IOUNITS'
5992 include 'COMMON.DERIV'
5993 include 'COMMON.INTERACT'
5994 include 'COMMON.CONTACTS'
5996 include 'COMMON.CONTACTS.MOMENT'
5998 double precision gx(3),gx1(3)
6003 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6004 C Calculate the multi-body contribution to energy.
6005 C Calculate multi-body contributions to the gradient.
6006 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6007 cd & k,l,(gacont(m,kk,k),m=1,3)
6009 gx(m) =ekl*gacont(m,jj,i)
6010 gx1(m)=eij*gacont(m,kk,k)
6011 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6012 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6013 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6014 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6018 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6023 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6029 c------------------------------------------------------------------------------
6030 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6031 C This subroutine calculates multi-body contributions to hydrogen-bonding
6032 implicit real*8 (a-h,o-z)
6033 include 'DIMENSIONS'
6034 include 'COMMON.IOUNITS'
6037 parameter (max_cont=maxconts)
6038 parameter (max_dim=26)
6039 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6040 double precision zapas(max_dim,maxconts,max_fg_procs),
6041 & zapas_recv(max_dim,maxconts,max_fg_procs)
6042 common /przechowalnia/ zapas
6043 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6044 & status_array(MPI_STATUS_SIZE,maxconts*2)
6046 include 'COMMON.SETUP'
6047 include 'COMMON.FFIELD'
6048 include 'COMMON.DERIV'
6049 include 'COMMON.INTERACT'
6050 include 'COMMON.CONTACTS'
6052 include 'COMMON.CONTACTS.MOMENT'
6054 include 'COMMON.CONTROL'
6055 include 'COMMON.LOCAL'
6056 double precision gx(3),gx1(3),time00
6059 C Set lprn=.true. for debugging
6064 if (nfgtasks.le.1) goto 30
6066 write (iout,'(a)') 'Contact function values before RECEIVE:'
6068 write (iout,'(2i3,50(1x,i2,f5.2))')
6069 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6070 & j=1,num_cont_hb(i))
6074 do i=1,ntask_cont_from
6077 do i=1,ntask_cont_to
6080 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6082 C Make the list of contacts to send to send to other procesors
6083 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6085 do i=iturn3_start,iturn3_end
6086 c write (iout,*) "make contact list turn3",i," num_cont",
6088 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6090 do i=iturn4_start,iturn4_end
6091 c write (iout,*) "make contact list turn4",i," num_cont",
6093 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6097 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6099 do j=1,num_cont_hb(i)
6102 iproc=iint_sent_local(k,jjc,ii)
6103 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6104 if (iproc.gt.0) then
6105 ncont_sent(iproc)=ncont_sent(iproc)+1
6106 nn=ncont_sent(iproc)
6108 zapas(2,nn,iproc)=jjc
6109 zapas(3,nn,iproc)=facont_hb(j,i)
6110 zapas(4,nn,iproc)=ees0p(j,i)
6111 zapas(5,nn,iproc)=ees0m(j,i)
6112 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6113 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6114 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6115 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6116 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6117 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6118 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6119 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6120 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6121 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6122 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6123 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6124 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6125 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6126 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6127 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6128 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6129 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6130 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6131 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6132 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6139 & "Numbers of contacts to be sent to other processors",
6140 & (ncont_sent(i),i=1,ntask_cont_to)
6141 write (iout,*) "Contacts sent"
6142 do ii=1,ntask_cont_to
6144 iproc=itask_cont_to(ii)
6145 write (iout,*) nn," contacts to processor",iproc,
6146 & " of CONT_TO_COMM group"
6148 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6156 CorrelID1=nfgtasks+fg_rank+1
6158 C Receive the numbers of needed contacts from other processors
6159 do ii=1,ntask_cont_from
6160 iproc=itask_cont_from(ii)
6162 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6163 & FG_COMM,req(ireq),IERR)
6165 c write (iout,*) "IRECV ended"
6167 C Send the number of contacts needed by other processors
6168 do ii=1,ntask_cont_to
6169 iproc=itask_cont_to(ii)
6171 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6172 & FG_COMM,req(ireq),IERR)
6174 c write (iout,*) "ISEND ended"
6175 c write (iout,*) "number of requests (nn)",ireq
6178 & call MPI_Waitall(ireq,req,status_array,ierr)
6180 c & "Numbers of contacts to be received from other processors",
6181 c & (ncont_recv(i),i=1,ntask_cont_from)
6185 do ii=1,ntask_cont_from
6186 iproc=itask_cont_from(ii)
6188 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6189 c & " of CONT_TO_COMM group"
6193 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6194 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6195 c write (iout,*) "ireq,req",ireq,req(ireq)
6198 C Send the contacts to processors that need them
6199 do ii=1,ntask_cont_to
6200 iproc=itask_cont_to(ii)
6202 c write (iout,*) nn," contacts to processor",iproc,
6203 c & " of CONT_TO_COMM group"
6206 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6207 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6208 c write (iout,*) "ireq,req",ireq,req(ireq)
6210 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6214 c write (iout,*) "number of requests (contacts)",ireq
6215 c write (iout,*) "req",(req(i),i=1,4)
6218 & call MPI_Waitall(ireq,req,status_array,ierr)
6219 do iii=1,ntask_cont_from
6220 iproc=itask_cont_from(iii)
6223 write (iout,*) "Received",nn," contacts from processor",iproc,
6224 & " of CONT_FROM_COMM group"
6227 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6232 ii=zapas_recv(1,i,iii)
6233 c Flag the received contacts to prevent double-counting
6234 jj=-zapas_recv(2,i,iii)
6235 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6237 nnn=num_cont_hb(ii)+1
6240 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6241 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6242 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6243 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6244 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6245 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6246 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6247 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6248 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6249 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6250 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6251 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6252 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6253 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6254 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6255 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6256 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6257 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6258 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6259 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6260 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6261 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6262 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6263 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6268 write (iout,'(a)') 'Contact function values after receive:'
6270 write (iout,'(2i3,50(1x,i3,f5.2))')
6271 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6272 & j=1,num_cont_hb(i))
6279 write (iout,'(a)') 'Contact function values:'
6281 write (iout,'(2i3,50(1x,i3,f5.2))')
6282 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6283 & j=1,num_cont_hb(i))
6287 C Remove the loop below after debugging !!!
6294 C Calculate the local-electrostatic correlation terms
6295 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6297 num_conti=num_cont_hb(i)
6298 num_conti1=num_cont_hb(i+1)
6305 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6306 c & ' jj=',jj,' kk=',kk
6307 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6308 & .or. j.lt.0 .and. j1.gt.0) .and.
6309 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6310 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6311 C The system gains extra energy.
6312 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6313 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6314 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6316 else if (j1.eq.j) then
6317 C Contacts I-J and I-(J+1) occur simultaneously.
6318 C The system loses extra energy.
6319 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6324 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6325 c & ' jj=',jj,' kk=',kk
6327 C Contacts I-J and (I+1)-J occur simultaneously.
6328 C The system loses extra energy.
6329 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6336 c------------------------------------------------------------------------------
6337 subroutine add_hb_contact(ii,jj,itask)
6338 implicit real*8 (a-h,o-z)
6339 include "DIMENSIONS"
6340 include "COMMON.IOUNITS"
6343 parameter (max_cont=maxconts)
6344 parameter (max_dim=26)
6345 include "COMMON.CONTACTS"
6347 include 'COMMON.CONTACTS.MOMENT'
6349 double precision zapas(max_dim,maxconts,max_fg_procs),
6350 & zapas_recv(max_dim,maxconts,max_fg_procs)
6351 common /przechowalnia/ zapas
6352 integer i,j,ii,jj,iproc,itask(4),nn
6353 c write (iout,*) "itask",itask
6356 if (iproc.gt.0) then
6357 do j=1,num_cont_hb(ii)
6359 c write (iout,*) "i",ii," j",jj," jjc",jjc
6361 ncont_sent(iproc)=ncont_sent(iproc)+1
6362 nn=ncont_sent(iproc)
6363 zapas(1,nn,iproc)=ii
6364 zapas(2,nn,iproc)=jjc
6365 zapas(3,nn,iproc)=facont_hb(j,ii)
6366 zapas(4,nn,iproc)=ees0p(j,ii)
6367 zapas(5,nn,iproc)=ees0m(j,ii)
6368 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6369 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6370 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6371 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6372 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6373 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6374 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6375 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6376 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6377 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6378 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6379 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6380 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6381 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6382 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6383 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6384 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6385 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6386 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6387 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6388 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6396 c------------------------------------------------------------------------------
6397 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6399 C This subroutine calculates multi-body contributions to hydrogen-bonding
6400 implicit real*8 (a-h,o-z)
6401 include 'DIMENSIONS'
6402 include 'COMMON.IOUNITS'
6405 parameter (max_cont=maxconts)
6406 parameter (max_dim=70)
6407 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6408 double precision zapas(max_dim,maxconts,max_fg_procs),
6409 & zapas_recv(max_dim,maxconts,max_fg_procs)
6410 common /przechowalnia/ zapas
6411 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6412 & status_array(MPI_STATUS_SIZE,maxconts*2)
6414 include 'COMMON.SETUP'
6415 include 'COMMON.FFIELD'
6416 include 'COMMON.DERIV'
6417 include 'COMMON.LOCAL'
6418 include 'COMMON.INTERACT'
6419 include 'COMMON.CONTACTS'
6421 include 'COMMON.CONTACTS.MOMENT'
6423 include 'COMMON.CHAIN'
6424 include 'COMMON.CONTROL'
6425 double precision gx(3),gx1(3)
6426 integer num_cont_hb_old(maxres)
6428 double precision eello4,eello5,eelo6,eello_turn6
6429 external eello4,eello5,eello6,eello_turn6
6430 C Set lprn=.true. for debugging
6435 num_cont_hb_old(i)=num_cont_hb(i)
6439 if (nfgtasks.le.1) goto 30
6441 write (iout,'(a)') 'Contact function values before RECEIVE:'
6443 write (iout,'(2i3,50(1x,i2,f5.2))')
6444 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6445 & j=1,num_cont_hb(i))
6449 do i=1,ntask_cont_from
6452 do i=1,ntask_cont_to
6455 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6457 C Make the list of contacts to send to send to other procesors
6458 do i=iturn3_start,iturn3_end
6459 c write (iout,*) "make contact list turn3",i," num_cont",
6461 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6463 do i=iturn4_start,iturn4_end
6464 c write (iout,*) "make contact list turn4",i," num_cont",
6466 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6470 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6472 do j=1,num_cont_hb(i)
6475 iproc=iint_sent_local(k,jjc,ii)
6476 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6477 if (iproc.ne.0) then
6478 ncont_sent(iproc)=ncont_sent(iproc)+1
6479 nn=ncont_sent(iproc)
6481 zapas(2,nn,iproc)=jjc
6482 zapas(3,nn,iproc)=d_cont(j,i)
6486 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6491 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6499 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6510 & "Numbers of contacts to be sent to other processors",
6511 & (ncont_sent(i),i=1,ntask_cont_to)
6512 write (iout,*) "Contacts sent"
6513 do ii=1,ntask_cont_to
6515 iproc=itask_cont_to(ii)
6516 write (iout,*) nn," contacts to processor",iproc,
6517 & " of CONT_TO_COMM group"
6519 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6527 CorrelID1=nfgtasks+fg_rank+1
6529 C Receive the numbers of needed contacts from other processors
6530 do ii=1,ntask_cont_from
6531 iproc=itask_cont_from(ii)
6533 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6534 & FG_COMM,req(ireq),IERR)
6536 c write (iout,*) "IRECV ended"
6538 C Send the number of contacts needed by other processors
6539 do ii=1,ntask_cont_to
6540 iproc=itask_cont_to(ii)
6542 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6543 & FG_COMM,req(ireq),IERR)
6545 c write (iout,*) "ISEND ended"
6546 c write (iout,*) "number of requests (nn)",ireq
6549 & call MPI_Waitall(ireq,req,status_array,ierr)
6551 c & "Numbers of contacts to be received from other processors",
6552 c & (ncont_recv(i),i=1,ntask_cont_from)
6556 do ii=1,ntask_cont_from
6557 iproc=itask_cont_from(ii)
6559 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6560 c & " of CONT_TO_COMM group"
6564 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6565 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6566 c write (iout,*) "ireq,req",ireq,req(ireq)
6569 C Send the contacts to processors that need them
6570 do ii=1,ntask_cont_to
6571 iproc=itask_cont_to(ii)
6573 c write (iout,*) nn," contacts to processor",iproc,
6574 c & " of CONT_TO_COMM group"
6577 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6578 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6579 c write (iout,*) "ireq,req",ireq,req(ireq)
6581 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6585 c write (iout,*) "number of requests (contacts)",ireq
6586 c write (iout,*) "req",(req(i),i=1,4)
6589 & call MPI_Waitall(ireq,req,status_array,ierr)
6590 do iii=1,ntask_cont_from
6591 iproc=itask_cont_from(iii)
6594 write (iout,*) "Received",nn," contacts from processor",iproc,
6595 & " of CONT_FROM_COMM group"
6598 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6603 ii=zapas_recv(1,i,iii)
6604 c Flag the received contacts to prevent double-counting
6605 jj=-zapas_recv(2,i,iii)
6606 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6608 nnn=num_cont_hb(ii)+1
6611 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6615 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6620 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6628 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6637 write (iout,'(a)') 'Contact function values after receive:'
6639 write (iout,'(2i3,50(1x,i3,5f6.3))')
6640 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6641 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6648 write (iout,'(a)') 'Contact function values:'
6650 write (iout,'(2i3,50(1x,i2,5f6.3))')
6651 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6652 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6658 C Remove the loop below after debugging !!!
6665 C Calculate the dipole-dipole interaction energies
6666 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6667 do i=iatel_s,iatel_e+1
6668 num_conti=num_cont_hb(i)
6677 C Calculate the local-electrostatic correlation terms
6678 c write (iout,*) "gradcorr5 in eello5 before loop"
6680 c write (iout,'(i5,3f10.5)')
6681 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6683 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6684 c write (iout,*) "corr loop i",i
6686 num_conti=num_cont_hb(i)
6687 num_conti1=num_cont_hb(i+1)
6694 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6695 c & ' jj=',jj,' kk=',kk
6696 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6697 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6698 & .or. j.lt.0 .and. j1.gt.0) .and.
6699 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6700 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6701 C The system gains extra energy.
6703 sqd1=dsqrt(d_cont(jj,i))
6704 sqd2=dsqrt(d_cont(kk,i1))
6705 sred_geom = sqd1*sqd2
6706 IF (sred_geom.lt.cutoff_corr) THEN
6707 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6709 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6710 cd & ' jj=',jj,' kk=',kk
6711 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6712 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6714 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6715 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6718 cd write (iout,*) 'sred_geom=',sred_geom,
6719 cd & ' ekont=',ekont,' fprim=',fprimcont,
6720 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6721 cd write (iout,*) "g_contij",g_contij
6722 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6723 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6724 call calc_eello(i,jp,i+1,jp1,jj,kk)
6725 if (wcorr4.gt.0.0d0)
6726 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6727 if (energy_dec.and.wcorr4.gt.0.0d0)
6728 1 write (iout,'(a6,4i5,0pf7.3)')
6729 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6730 c write (iout,*) "gradcorr5 before eello5"
6732 c write (iout,'(i5,3f10.5)')
6733 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6735 if (wcorr5.gt.0.0d0)
6736 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6737 c write (iout,*) "gradcorr5 after eello5"
6739 c write (iout,'(i5,3f10.5)')
6740 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6742 if (energy_dec.and.wcorr5.gt.0.0d0)
6743 1 write (iout,'(a6,4i5,0pf7.3)')
6744 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6745 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6746 cd write(2,*)'ijkl',i,jp,i+1,jp1
6747 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6748 & .or. wturn6.eq.0.0d0))then
6749 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6750 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6751 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6752 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6753 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6754 cd & 'ecorr6=',ecorr6
6755 cd write (iout,'(4e15.5)') sred_geom,
6756 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6757 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6758 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6759 else if (wturn6.gt.0.0d0
6760 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6761 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6762 eturn6=eturn6+eello_turn6(i,jj,kk)
6763 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6764 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6765 cd write (2,*) 'multibody_eello:eturn6',eturn6
6774 num_cont_hb(i)=num_cont_hb_old(i)
6776 c write (iout,*) "gradcorr5 in eello5"
6778 c write (iout,'(i5,3f10.5)')
6779 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6783 c------------------------------------------------------------------------------
6784 subroutine add_hb_contact_eello(ii,jj,itask)
6785 implicit real*8 (a-h,o-z)
6786 include "DIMENSIONS"
6787 include "COMMON.IOUNITS"
6790 parameter (max_cont=maxconts)
6791 parameter (max_dim=70)
6792 include "COMMON.CONTACTS"
6794 include 'COMMON.CONTACTS.MOMENT'
6796 double precision zapas(max_dim,maxconts,max_fg_procs),
6797 & zapas_recv(max_dim,maxconts,max_fg_procs)
6798 common /przechowalnia/ zapas
6799 integer i,j,ii,jj,iproc,itask(4),nn
6800 c write (iout,*) "itask",itask
6803 if (iproc.gt.0) then
6804 do j=1,num_cont_hb(ii)
6806 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6808 ncont_sent(iproc)=ncont_sent(iproc)+1
6809 nn=ncont_sent(iproc)
6810 zapas(1,nn,iproc)=ii
6811 zapas(2,nn,iproc)=jjc
6812 zapas(3,nn,iproc)=d_cont(j,ii)
6816 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6821 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6829 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6841 c------------------------------------------------------------------------------
6842 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6843 implicit real*8 (a-h,o-z)
6844 include 'DIMENSIONS'
6845 include 'COMMON.IOUNITS'
6846 include 'COMMON.DERIV'
6847 include 'COMMON.INTERACT'
6848 include 'COMMON.CONTACTS'
6850 include 'COMMON.CONTACTS.MOMENT'
6852 double precision gx(3),gx1(3)
6862 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6863 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6864 C Following 4 lines for diagnostics.
6869 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6870 c & 'Contacts ',i,j,
6871 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6872 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6874 C Calculate the multi-body contribution to energy.
6875 c ecorr=ecorr+ekont*ees
6876 C Calculate multi-body contributions to the gradient.
6877 coeffpees0pij=coeffp*ees0pij
6878 coeffmees0mij=coeffm*ees0mij
6879 coeffpees0pkl=coeffp*ees0pkl
6880 coeffmees0mkl=coeffm*ees0mkl
6882 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6883 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6884 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6885 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6886 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6887 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6888 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6889 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6890 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6891 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6892 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6893 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6894 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6895 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6896 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6897 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6898 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6899 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6900 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6901 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6902 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6903 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6904 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6905 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6906 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6911 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6912 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6913 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6914 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6919 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6920 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6921 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6922 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6925 c write (iout,*) "ehbcorr",ekont*ees
6930 C---------------------------------------------------------------------------
6931 subroutine dipole(i,j,jj)
6932 implicit real*8 (a-h,o-z)
6933 include 'DIMENSIONS'
6934 include 'COMMON.IOUNITS'
6935 include 'COMMON.CHAIN'
6936 include 'COMMON.FFIELD'
6937 include 'COMMON.DERIV'
6938 include 'COMMON.INTERACT'
6939 include 'COMMON.CONTACTS'
6941 include 'COMMON.CONTACTS.MOMENT'
6943 include 'COMMON.TORSION'
6944 include 'COMMON.VAR'
6945 include 'COMMON.GEO'
6946 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6948 iti1 = itortyp(itype(i+1))
6949 if (j.lt.nres-1) then
6950 itj1 = itortyp(itype(j+1))
6955 dipi(iii,1)=Ub2(iii,i)
6956 dipderi(iii)=Ub2der(iii,i)
6957 dipi(iii,2)=b1(iii,iti1)
6958 dipj(iii,1)=Ub2(iii,j)
6959 dipderj(iii)=Ub2der(iii,j)
6960 dipj(iii,2)=b1(iii,itj1)
6964 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6967 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6974 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6978 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6983 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6984 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6986 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6988 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6990 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6995 C---------------------------------------------------------------------------
6996 subroutine calc_eello(i,j,k,l,jj,kk)
6998 C This subroutine computes matrices and vectors needed to calculate
6999 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7001 implicit real*8 (a-h,o-z)
7002 include 'DIMENSIONS'
7003 include 'COMMON.IOUNITS'
7004 include 'COMMON.CHAIN'
7005 include 'COMMON.DERIV'
7006 include 'COMMON.INTERACT'
7007 include 'COMMON.CONTACTS'
7009 include 'COMMON.CONTACTS.MOMENT'
7011 include 'COMMON.TORSION'
7012 include 'COMMON.VAR'
7013 include 'COMMON.GEO'
7014 include 'COMMON.FFIELD'
7015 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7016 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7019 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7020 cd & ' jj=',jj,' kk=',kk
7021 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7022 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7023 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7026 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7027 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7030 call transpose2(aa1(1,1),aa1t(1,1))
7031 call transpose2(aa2(1,1),aa2t(1,1))
7034 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7035 & aa1tder(1,1,lll,kkk))
7036 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7037 & aa2tder(1,1,lll,kkk))
7041 C parallel orientation of the two CA-CA-CA frames.
7043 iti=itortyp(itype(i))
7047 itk1=itortyp(itype(k+1))
7048 itj=itortyp(itype(j))
7049 if (l.lt.nres-1) then
7050 itl1=itortyp(itype(l+1))
7054 C A1 kernel(j+1) A2T
7056 cd write (iout,'(3f10.5,5x,3f10.5)')
7057 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7059 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7060 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7061 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7062 C Following matrices are needed only for 6-th order cumulants
7063 IF (wcorr6.gt.0.0d0) THEN
7064 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7065 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7066 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7067 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7068 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7069 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7070 & ADtEAderx(1,1,1,1,1,1))
7072 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7073 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7074 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7075 & ADtEA1derx(1,1,1,1,1,1))
7077 C End 6-th order cumulants
7080 cd write (2,*) 'In calc_eello6'
7082 cd write (2,*) 'iii=',iii
7084 cd write (2,*) 'kkk=',kkk
7086 cd write (2,'(3(2f10.5),5x)')
7087 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7092 call transpose2(EUgder(1,1,k),auxmat(1,1))
7093 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7094 call transpose2(EUg(1,1,k),auxmat(1,1))
7095 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7096 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7100 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7101 & EAEAderx(1,1,lll,kkk,iii,1))
7105 C A1T kernel(i+1) A2
7106 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7107 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7108 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7109 C Following matrices are needed only for 6-th order cumulants
7110 IF (wcorr6.gt.0.0d0) THEN
7111 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7112 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7113 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7114 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7115 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7116 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7117 & ADtEAderx(1,1,1,1,1,2))
7118 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7119 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7120 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7121 & ADtEA1derx(1,1,1,1,1,2))
7123 C End 6-th order cumulants
7124 call transpose2(EUgder(1,1,l),auxmat(1,1))
7125 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7126 call transpose2(EUg(1,1,l),auxmat(1,1))
7127 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7128 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7132 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7133 & EAEAderx(1,1,lll,kkk,iii,2))
7138 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7139 C They are needed only when the fifth- or the sixth-order cumulants are
7141 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7142 call transpose2(AEA(1,1,1),auxmat(1,1))
7143 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7144 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7145 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7146 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7147 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7148 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7149 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7150 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7151 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7152 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7153 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7154 call transpose2(AEA(1,1,2),auxmat(1,1))
7155 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7156 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7157 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7158 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7159 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7160 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7161 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7162 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7163 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7164 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7165 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7166 C Calculate the Cartesian derivatives of the vectors.
7170 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7171 call matvec2(auxmat(1,1),b1(1,iti),
7172 & AEAb1derx(1,lll,kkk,iii,1,1))
7173 call matvec2(auxmat(1,1),Ub2(1,i),
7174 & AEAb2derx(1,lll,kkk,iii,1,1))
7175 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7176 & AEAb1derx(1,lll,kkk,iii,2,1))
7177 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7178 & AEAb2derx(1,lll,kkk,iii,2,1))
7179 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7180 call matvec2(auxmat(1,1),b1(1,itj),
7181 & AEAb1derx(1,lll,kkk,iii,1,2))
7182 call matvec2(auxmat(1,1),Ub2(1,j),
7183 & AEAb2derx(1,lll,kkk,iii,1,2))
7184 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7185 & AEAb1derx(1,lll,kkk,iii,2,2))
7186 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7187 & AEAb2derx(1,lll,kkk,iii,2,2))
7194 C Antiparallel orientation of the two CA-CA-CA frames.
7196 iti=itortyp(itype(i))
7200 itk1=itortyp(itype(k+1))
7201 itl=itortyp(itype(l))
7202 itj=itortyp(itype(j))
7203 if (j.lt.nres-1) then
7204 itj1=itortyp(itype(j+1))
7208 C A2 kernel(j-1)T A1T
7209 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7210 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7211 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7212 C Following matrices are needed only for 6-th order cumulants
7213 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7214 & j.eq.i+4 .and. l.eq.i+3)) THEN
7215 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7216 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7217 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7218 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7219 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7220 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7221 & ADtEAderx(1,1,1,1,1,1))
7222 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7223 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7224 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7225 & ADtEA1derx(1,1,1,1,1,1))
7227 C End 6-th order cumulants
7228 call transpose2(EUgder(1,1,k),auxmat(1,1))
7229 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7230 call transpose2(EUg(1,1,k),auxmat(1,1))
7231 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7232 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7236 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7237 & EAEAderx(1,1,lll,kkk,iii,1))
7241 C A2T kernel(i+1)T A1
7242 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7243 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7244 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7245 C Following matrices are needed only for 6-th order cumulants
7246 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7247 & j.eq.i+4 .and. l.eq.i+3)) THEN
7248 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7249 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7250 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7251 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7252 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7253 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7254 & ADtEAderx(1,1,1,1,1,2))
7255 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7256 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7257 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7258 & ADtEA1derx(1,1,1,1,1,2))
7260 C End 6-th order cumulants
7261 call transpose2(EUgder(1,1,j),auxmat(1,1))
7262 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7263 call transpose2(EUg(1,1,j),auxmat(1,1))
7264 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7265 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7269 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7270 & EAEAderx(1,1,lll,kkk,iii,2))
7275 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7276 C They are needed only when the fifth- or the sixth-order cumulants are
7278 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7279 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7280 call transpose2(AEA(1,1,1),auxmat(1,1))
7281 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7282 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7283 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7284 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7285 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7286 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7287 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7288 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7289 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7290 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7291 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7292 call transpose2(AEA(1,1,2),auxmat(1,1))
7293 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7294 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7295 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7296 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7297 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7298 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7299 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7300 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7301 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7302 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7303 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7304 C Calculate the Cartesian derivatives of the vectors.
7308 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7309 call matvec2(auxmat(1,1),b1(1,iti),
7310 & AEAb1derx(1,lll,kkk,iii,1,1))
7311 call matvec2(auxmat(1,1),Ub2(1,i),
7312 & AEAb2derx(1,lll,kkk,iii,1,1))
7313 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7314 & AEAb1derx(1,lll,kkk,iii,2,1))
7315 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7316 & AEAb2derx(1,lll,kkk,iii,2,1))
7317 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7318 call matvec2(auxmat(1,1),b1(1,itl),
7319 & AEAb1derx(1,lll,kkk,iii,1,2))
7320 call matvec2(auxmat(1,1),Ub2(1,l),
7321 & AEAb2derx(1,lll,kkk,iii,1,2))
7322 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7323 & AEAb1derx(1,lll,kkk,iii,2,2))
7324 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7325 & AEAb2derx(1,lll,kkk,iii,2,2))
7334 C---------------------------------------------------------------------------
7335 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7336 & KK,KKderg,AKA,AKAderg,AKAderx)
7340 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7341 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7342 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7347 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7349 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7352 cd if (lprn) write (2,*) 'In kernel'
7354 cd if (lprn) write (2,*) 'kkk=',kkk
7356 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7357 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7359 cd write (2,*) 'lll=',lll
7360 cd write (2,*) 'iii=1'
7362 cd write (2,'(3(2f10.5),5x)')
7363 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7366 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7367 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7369 cd write (2,*) 'lll=',lll
7370 cd write (2,*) 'iii=2'
7372 cd write (2,'(3(2f10.5),5x)')
7373 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7380 C---------------------------------------------------------------------------
7381 double precision function eello4(i,j,k,l,jj,kk)
7382 implicit real*8 (a-h,o-z)
7383 include 'DIMENSIONS'
7384 include 'COMMON.IOUNITS'
7385 include 'COMMON.CHAIN'
7386 include 'COMMON.DERIV'
7387 include 'COMMON.INTERACT'
7388 include 'COMMON.CONTACTS'
7390 include 'COMMON.CONTACTS.MOMENT'
7392 include 'COMMON.TORSION'
7393 include 'COMMON.VAR'
7394 include 'COMMON.GEO'
7395 double precision pizda(2,2),ggg1(3),ggg2(3)
7396 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7400 cd print *,'eello4:',i,j,k,l,jj,kk
7401 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7402 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7403 cold eij=facont_hb(jj,i)
7404 cold ekl=facont_hb(kk,k)
7406 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7407 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7408 gcorr_loc(k-1)=gcorr_loc(k-1)
7409 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7411 gcorr_loc(l-1)=gcorr_loc(l-1)
7412 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7414 gcorr_loc(j-1)=gcorr_loc(j-1)
7415 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7420 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7421 & -EAEAderx(2,2,lll,kkk,iii,1)
7422 cd derx(lll,kkk,iii)=0.0d0
7426 cd gcorr_loc(l-1)=0.0d0
7427 cd gcorr_loc(j-1)=0.0d0
7428 cd gcorr_loc(k-1)=0.0d0
7430 cd write (iout,*)'Contacts have occurred for peptide groups',
7431 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7432 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7433 if (j.lt.nres-1) then
7440 if (l.lt.nres-1) then
7448 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7449 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7450 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7451 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7452 cgrad ghalf=0.5d0*ggg1(ll)
7453 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7454 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7455 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7456 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7457 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7458 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7459 cgrad ghalf=0.5d0*ggg2(ll)
7460 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7461 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7462 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7463 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7464 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7465 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7469 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7474 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7479 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7484 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7488 cd write (2,*) iii,gcorr_loc(iii)
7491 cd write (2,*) 'ekont',ekont
7492 cd write (iout,*) 'eello4',ekont*eel4
7495 C---------------------------------------------------------------------------
7496 double precision function eello5(i,j,k,l,jj,kk)
7497 implicit real*8 (a-h,o-z)
7498 include 'DIMENSIONS'
7499 include 'COMMON.IOUNITS'
7500 include 'COMMON.CHAIN'
7501 include 'COMMON.DERIV'
7502 include 'COMMON.INTERACT'
7503 include 'COMMON.CONTACTS'
7505 include 'COMMON.CONTACTS.MOMENT'
7507 include 'COMMON.TORSION'
7508 include 'COMMON.VAR'
7509 include 'COMMON.GEO'
7510 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7511 double precision ggg1(3),ggg2(3)
7512 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7517 C /l\ / \ \ / \ / \ / C
7518 C / \ / \ \ / \ / \ / C
7519 C j| o |l1 | o | o| o | | o |o C
7520 C \ |/k\| |/ \| / |/ \| |/ \| C
7521 C \i/ \ / \ / / \ / \ C
7523 C (I) (II) (III) (IV) C
7525 C eello5_1 eello5_2 eello5_3 eello5_4 C
7527 C Antiparallel chains C
7530 C /j\ / \ \ / \ / \ / C
7531 C / \ / \ \ / \ / \ / C
7532 C j1| o |l | o | o| o | | o |o C
7533 C \ |/k\| |/ \| / |/ \| |/ \| C
7534 C \i/ \ / \ / / \ / \ C
7536 C (I) (II) (III) (IV) C
7538 C eello5_1 eello5_2 eello5_3 eello5_4 C
7540 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7542 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7543 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7548 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7550 itk=itortyp(itype(k))
7551 itl=itortyp(itype(l))
7552 itj=itortyp(itype(j))
7557 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7558 cd & eel5_3_num,eel5_4_num)
7562 derx(lll,kkk,iii)=0.0d0
7566 cd eij=facont_hb(jj,i)
7567 cd ekl=facont_hb(kk,k)
7569 cd write (iout,*)'Contacts have occurred for peptide groups',
7570 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7572 C Contribution from the graph I.
7573 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7574 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7575 call transpose2(EUg(1,1,k),auxmat(1,1))
7576 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7577 vv(1)=pizda(1,1)-pizda(2,2)
7578 vv(2)=pizda(1,2)+pizda(2,1)
7579 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7580 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7581 C Explicit gradient in virtual-dihedral angles.
7582 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7583 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7584 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7585 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7586 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7587 vv(1)=pizda(1,1)-pizda(2,2)
7588 vv(2)=pizda(1,2)+pizda(2,1)
7589 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7590 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7591 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7592 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7593 vv(1)=pizda(1,1)-pizda(2,2)
7594 vv(2)=pizda(1,2)+pizda(2,1)
7596 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7597 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7598 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7600 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7601 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7602 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7604 C Cartesian gradient
7608 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7610 vv(1)=pizda(1,1)-pizda(2,2)
7611 vv(2)=pizda(1,2)+pizda(2,1)
7612 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7613 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7614 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7620 C Contribution from graph II
7621 call transpose2(EE(1,1,itk),auxmat(1,1))
7622 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7623 vv(1)=pizda(1,1)+pizda(2,2)
7624 vv(2)=pizda(2,1)-pizda(1,2)
7625 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7626 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7627 C Explicit gradient in virtual-dihedral angles.
7628 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7629 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7630 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7631 vv(1)=pizda(1,1)+pizda(2,2)
7632 vv(2)=pizda(2,1)-pizda(1,2)
7634 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7635 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7636 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7638 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7639 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7640 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7642 C Cartesian gradient
7646 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7648 vv(1)=pizda(1,1)+pizda(2,2)
7649 vv(2)=pizda(2,1)-pizda(1,2)
7650 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7651 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7652 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7660 C Parallel orientation
7661 C Contribution from graph III
7662 call transpose2(EUg(1,1,l),auxmat(1,1))
7663 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7664 vv(1)=pizda(1,1)-pizda(2,2)
7665 vv(2)=pizda(1,2)+pizda(2,1)
7666 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7667 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7668 C Explicit gradient in virtual-dihedral angles.
7669 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7670 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7671 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7672 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7673 vv(1)=pizda(1,1)-pizda(2,2)
7674 vv(2)=pizda(1,2)+pizda(2,1)
7675 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7676 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7677 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7678 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7679 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7680 vv(1)=pizda(1,1)-pizda(2,2)
7681 vv(2)=pizda(1,2)+pizda(2,1)
7682 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7683 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7684 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7685 C Cartesian gradient
7689 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7691 vv(1)=pizda(1,1)-pizda(2,2)
7692 vv(2)=pizda(1,2)+pizda(2,1)
7693 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7694 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7695 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7700 C Contribution from graph IV
7702 call transpose2(EE(1,1,itl),auxmat(1,1))
7703 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7704 vv(1)=pizda(1,1)+pizda(2,2)
7705 vv(2)=pizda(2,1)-pizda(1,2)
7706 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7707 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7708 C Explicit gradient in virtual-dihedral angles.
7709 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7710 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7711 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7712 vv(1)=pizda(1,1)+pizda(2,2)
7713 vv(2)=pizda(2,1)-pizda(1,2)
7714 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7715 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7716 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7717 C Cartesian gradient
7721 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7723 vv(1)=pizda(1,1)+pizda(2,2)
7724 vv(2)=pizda(2,1)-pizda(1,2)
7725 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7726 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7727 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7732 C Antiparallel orientation
7733 C Contribution from graph III
7735 call transpose2(EUg(1,1,j),auxmat(1,1))
7736 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7737 vv(1)=pizda(1,1)-pizda(2,2)
7738 vv(2)=pizda(1,2)+pizda(2,1)
7739 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7740 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7741 C Explicit gradient in virtual-dihedral angles.
7742 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7743 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7744 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7745 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7746 vv(1)=pizda(1,1)-pizda(2,2)
7747 vv(2)=pizda(1,2)+pizda(2,1)
7748 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7749 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7750 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7751 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7752 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7753 vv(1)=pizda(1,1)-pizda(2,2)
7754 vv(2)=pizda(1,2)+pizda(2,1)
7755 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7756 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7757 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7758 C Cartesian gradient
7762 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7764 vv(1)=pizda(1,1)-pizda(2,2)
7765 vv(2)=pizda(1,2)+pizda(2,1)
7766 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7767 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7768 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7773 C Contribution from graph IV
7775 call transpose2(EE(1,1,itj),auxmat(1,1))
7776 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7777 vv(1)=pizda(1,1)+pizda(2,2)
7778 vv(2)=pizda(2,1)-pizda(1,2)
7779 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7780 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7781 C Explicit gradient in virtual-dihedral angles.
7782 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7783 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7784 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7785 vv(1)=pizda(1,1)+pizda(2,2)
7786 vv(2)=pizda(2,1)-pizda(1,2)
7787 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7788 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7789 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7790 C Cartesian gradient
7794 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7796 vv(1)=pizda(1,1)+pizda(2,2)
7797 vv(2)=pizda(2,1)-pizda(1,2)
7798 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7799 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7800 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7806 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7807 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7808 cd write (2,*) 'ijkl',i,j,k,l
7809 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7810 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7812 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7813 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7814 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7815 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7816 if (j.lt.nres-1) then
7823 if (l.lt.nres-1) then
7833 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7834 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7835 C summed up outside the subrouine as for the other subroutines
7836 C handling long-range interactions. The old code is commented out
7837 C with "cgrad" to keep track of changes.
7839 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7840 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7841 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7842 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7843 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7844 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7845 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7846 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7847 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7848 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7850 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7851 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7852 cgrad ghalf=0.5d0*ggg1(ll)
7854 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7855 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7856 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7857 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7858 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7859 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7860 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7861 cgrad ghalf=0.5d0*ggg2(ll)
7863 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7864 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7865 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7866 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7867 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7868 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7873 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7874 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7879 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7880 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7886 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7891 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7895 cd write (2,*) iii,g_corr5_loc(iii)
7898 cd write (2,*) 'ekont',ekont
7899 cd write (iout,*) 'eello5',ekont*eel5
7902 c--------------------------------------------------------------------------
7903 double precision function eello6(i,j,k,l,jj,kk)
7904 implicit real*8 (a-h,o-z)
7905 include 'DIMENSIONS'
7906 include 'COMMON.IOUNITS'
7907 include 'COMMON.CHAIN'
7908 include 'COMMON.DERIV'
7909 include 'COMMON.INTERACT'
7910 include 'COMMON.CONTACTS'
7912 include 'COMMON.CONTACTS.MOMENT'
7914 include 'COMMON.TORSION'
7915 include 'COMMON.VAR'
7916 include 'COMMON.GEO'
7917 include 'COMMON.FFIELD'
7918 double precision ggg1(3),ggg2(3)
7919 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7924 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7932 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7933 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7937 derx(lll,kkk,iii)=0.0d0
7941 cd eij=facont_hb(jj,i)
7942 cd ekl=facont_hb(kk,k)
7948 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7949 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7950 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7951 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7952 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7953 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7955 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7956 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7957 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7958 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7959 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7960 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7964 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7966 C If turn contributions are considered, they will be handled separately.
7967 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7968 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7969 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7970 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7971 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7972 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7973 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7975 if (j.lt.nres-1) then
7982 if (l.lt.nres-1) then
7990 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7991 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7992 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7993 cgrad ghalf=0.5d0*ggg1(ll)
7995 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7996 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7997 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7998 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7999 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8000 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8001 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8002 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8003 cgrad ghalf=0.5d0*ggg2(ll)
8004 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8006 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8007 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8008 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8009 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8010 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8011 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8016 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8017 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8022 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8023 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8029 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8034 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8038 cd write (2,*) iii,g_corr6_loc(iii)
8041 cd write (2,*) 'ekont',ekont
8042 cd write (iout,*) 'eello6',ekont*eel6
8045 c--------------------------------------------------------------------------
8046 double precision function eello6_graph1(i,j,k,l,imat,swap)
8047 implicit real*8 (a-h,o-z)
8048 include 'DIMENSIONS'
8049 include 'COMMON.IOUNITS'
8050 include 'COMMON.CHAIN'
8051 include 'COMMON.DERIV'
8052 include 'COMMON.INTERACT'
8053 include 'COMMON.CONTACTS'
8055 include 'COMMON.CONTACTS.MOMENT'
8057 include 'COMMON.TORSION'
8058 include 'COMMON.VAR'
8059 include 'COMMON.GEO'
8060 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8064 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8066 C Parallel Antiparallel C
8072 C \ j|/k\| / \ |/k\|l / C
8077 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8078 itk=itortyp(itype(k))
8079 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8080 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8081 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8082 call transpose2(EUgC(1,1,k),auxmat(1,1))
8083 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8084 vv1(1)=pizda1(1,1)-pizda1(2,2)
8085 vv1(2)=pizda1(1,2)+pizda1(2,1)
8086 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8087 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8088 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8089 s5=scalar2(vv(1),Dtobr2(1,i))
8090 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8091 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8092 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8093 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8094 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8095 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8096 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8097 & +scalar2(vv(1),Dtobr2der(1,i)))
8098 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8099 vv1(1)=pizda1(1,1)-pizda1(2,2)
8100 vv1(2)=pizda1(1,2)+pizda1(2,1)
8101 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8102 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8104 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8105 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8106 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8107 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8108 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8110 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8111 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8112 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8113 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8114 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8116 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8117 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8118 vv1(1)=pizda1(1,1)-pizda1(2,2)
8119 vv1(2)=pizda1(1,2)+pizda1(2,1)
8120 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8121 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8122 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8123 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8132 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8133 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8134 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8135 call transpose2(EUgC(1,1,k),auxmat(1,1))
8136 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8138 vv1(1)=pizda1(1,1)-pizda1(2,2)
8139 vv1(2)=pizda1(1,2)+pizda1(2,1)
8140 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8141 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8142 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8143 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8144 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8145 s5=scalar2(vv(1),Dtobr2(1,i))
8146 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8152 c----------------------------------------------------------------------------
8153 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8154 implicit real*8 (a-h,o-z)
8155 include 'DIMENSIONS'
8156 include 'COMMON.IOUNITS'
8157 include 'COMMON.CHAIN'
8158 include 'COMMON.DERIV'
8159 include 'COMMON.INTERACT'
8160 include 'COMMON.CONTACTS'
8162 include 'COMMON.CONTACTS.MOMENT'
8164 include 'COMMON.TORSION'
8165 include 'COMMON.VAR'
8166 include 'COMMON.GEO'
8168 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8169 & auxvec1(2),auxvec2(1),auxmat1(2,2)
8172 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8174 C Parallel Antiparallel C
8180 C \ j|/k\| \ |/k\|l C
8185 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8186 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8187 C AL 7/4/01 s1 would occur in the sixth-order moment,
8188 C but not in a cluster cumulant
8190 s1=dip(1,jj,i)*dip(1,kk,k)
8192 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8193 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8194 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8195 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8196 call transpose2(EUg(1,1,k),auxmat(1,1))
8197 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8198 vv(1)=pizda(1,1)-pizda(2,2)
8199 vv(2)=pizda(1,2)+pizda(2,1)
8200 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8201 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8203 eello6_graph2=-(s1+s2+s3+s4)
8205 eello6_graph2=-(s2+s3+s4)
8208 C Derivatives in gamma(i-1)
8211 s1=dipderg(1,jj,i)*dip(1,kk,k)
8213 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8214 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8215 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8216 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8218 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8220 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8222 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8224 C Derivatives in gamma(k-1)
8226 s1=dip(1,jj,i)*dipderg(1,kk,k)
8228 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8229 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8230 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8231 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8232 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8233 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8234 vv(1)=pizda(1,1)-pizda(2,2)
8235 vv(2)=pizda(1,2)+pizda(2,1)
8236 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8238 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8240 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8242 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8243 C Derivatives in gamma(j-1) or gamma(l-1)
8246 s1=dipderg(3,jj,i)*dip(1,kk,k)
8248 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8249 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8250 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8251 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8252 vv(1)=pizda(1,1)-pizda(2,2)
8253 vv(2)=pizda(1,2)+pizda(2,1)
8254 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8257 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8259 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8262 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8263 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8265 C Derivatives in gamma(l-1) or gamma(j-1)
8268 s1=dip(1,jj,i)*dipderg(3,kk,k)
8270 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8271 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8272 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8273 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8274 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8275 vv(1)=pizda(1,1)-pizda(2,2)
8276 vv(2)=pizda(1,2)+pizda(2,1)
8277 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8280 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8282 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8285 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8286 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8288 C Cartesian derivatives.
8290 write (2,*) 'In eello6_graph2'
8292 write (2,*) 'iii=',iii
8294 write (2,*) 'kkk=',kkk
8296 write (2,'(3(2f10.5),5x)')
8297 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8307 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8309 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8312 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8314 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8315 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8317 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8318 call transpose2(EUg(1,1,k),auxmat(1,1))
8319 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8321 vv(1)=pizda(1,1)-pizda(2,2)
8322 vv(2)=pizda(1,2)+pizda(2,1)
8323 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8324 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8326 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8328 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8331 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8333 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8340 c----------------------------------------------------------------------------
8341 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8342 implicit real*8 (a-h,o-z)
8343 include 'DIMENSIONS'
8344 include 'COMMON.IOUNITS'
8345 include 'COMMON.CHAIN'
8346 include 'COMMON.DERIV'
8347 include 'COMMON.INTERACT'
8348 include 'COMMON.CONTACTS'
8350 include 'COMMON.CONTACTS.MOMENT'
8352 include 'COMMON.TORSION'
8353 include 'COMMON.VAR'
8354 include 'COMMON.GEO'
8355 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8357 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8359 C Parallel Antiparallel C
8365 C j|/k\| / |/k\|l / C
8370 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8372 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8373 C energy moment and not to the cluster cumulant.
8374 iti=itortyp(itype(i))
8375 if (j.lt.nres-1) then
8376 itj1=itortyp(itype(j+1))
8380 itk=itortyp(itype(k))
8381 itk1=itortyp(itype(k+1))
8382 if (l.lt.nres-1) then
8383 itl1=itortyp(itype(l+1))
8388 s1=dip(4,jj,i)*dip(4,kk,k)
8390 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8391 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8392 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8393 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8394 call transpose2(EE(1,1,itk),auxmat(1,1))
8395 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8396 vv(1)=pizda(1,1)+pizda(2,2)
8397 vv(2)=pizda(2,1)-pizda(1,2)
8398 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8399 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8400 cd & "sum",-(s2+s3+s4)
8402 eello6_graph3=-(s1+s2+s3+s4)
8404 eello6_graph3=-(s2+s3+s4)
8407 C Derivatives in gamma(k-1)
8408 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8409 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8410 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8411 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8412 C Derivatives in gamma(l-1)
8413 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8414 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8415 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8416 vv(1)=pizda(1,1)+pizda(2,2)
8417 vv(2)=pizda(2,1)-pizda(1,2)
8418 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8419 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8420 C Cartesian derivatives.
8426 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8428 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8431 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8433 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8434 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8436 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8437 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8439 vv(1)=pizda(1,1)+pizda(2,2)
8440 vv(2)=pizda(2,1)-pizda(1,2)
8441 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8443 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8445 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8448 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8450 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8452 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8458 c----------------------------------------------------------------------------
8459 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8460 implicit real*8 (a-h,o-z)
8461 include 'DIMENSIONS'
8462 include 'COMMON.IOUNITS'
8463 include 'COMMON.CHAIN'
8464 include 'COMMON.DERIV'
8465 include 'COMMON.INTERACT'
8466 include 'COMMON.CONTACTS'
8468 include 'COMMON.CONTACTS.MOMENT'
8470 include 'COMMON.TORSION'
8471 include 'COMMON.VAR'
8472 include 'COMMON.GEO'
8473 include 'COMMON.FFIELD'
8474 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8475 & auxvec1(2),auxmat1(2,2)
8477 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8479 C Parallel Antiparallel C
8485 C \ j|/k\| \ |/k\|l C
8490 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8492 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8493 C energy moment and not to the cluster cumulant.
8494 cd write (2,*) 'eello_graph4: wturn6',wturn6
8495 iti=itortyp(itype(i))
8496 itj=itortyp(itype(j))
8497 if (j.lt.nres-1) then
8498 itj1=itortyp(itype(j+1))
8502 itk=itortyp(itype(k))
8503 if (k.lt.nres-1) then
8504 itk1=itortyp(itype(k+1))
8508 itl=itortyp(itype(l))
8509 if (l.lt.nres-1) then
8510 itl1=itortyp(itype(l+1))
8514 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8515 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8516 cd & ' itl',itl,' itl1',itl1
8519 s1=dip(3,jj,i)*dip(3,kk,k)
8521 s1=dip(2,jj,j)*dip(2,kk,l)
8524 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8525 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8527 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8528 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8530 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8531 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8533 call transpose2(EUg(1,1,k),auxmat(1,1))
8534 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8535 vv(1)=pizda(1,1)-pizda(2,2)
8536 vv(2)=pizda(2,1)+pizda(1,2)
8537 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8538 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8540 eello6_graph4=-(s1+s2+s3+s4)
8542 eello6_graph4=-(s2+s3+s4)
8544 C Derivatives in gamma(i-1)
8548 s1=dipderg(2,jj,i)*dip(3,kk,k)
8550 s1=dipderg(4,jj,j)*dip(2,kk,l)
8553 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8555 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8556 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8558 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8559 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8561 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8562 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8563 cd write (2,*) 'turn6 derivatives'
8565 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8567 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8571 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8573 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8577 C Derivatives in gamma(k-1)
8580 s1=dip(3,jj,i)*dipderg(2,kk,k)
8582 s1=dip(2,jj,j)*dipderg(4,kk,l)
8585 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8586 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8588 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8589 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8591 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8592 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8594 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8595 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8596 vv(1)=pizda(1,1)-pizda(2,2)
8597 vv(2)=pizda(2,1)+pizda(1,2)
8598 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8599 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8601 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8603 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8607 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8609 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8612 C Derivatives in gamma(j-1) or gamma(l-1)
8613 if (l.eq.j+1 .and. l.gt.1) then
8614 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8615 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8616 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8617 vv(1)=pizda(1,1)-pizda(2,2)
8618 vv(2)=pizda(2,1)+pizda(1,2)
8619 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8620 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8621 else if (j.gt.1) then
8622 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8623 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8624 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8625 vv(1)=pizda(1,1)-pizda(2,2)
8626 vv(2)=pizda(2,1)+pizda(1,2)
8627 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8628 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8629 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8631 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8634 C Cartesian derivatives.
8641 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8643 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8647 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8649 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8653 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8655 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8657 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8658 & b1(1,itj1),auxvec(1))
8659 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8661 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8662 & b1(1,itl1),auxvec(1))
8663 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8665 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8667 vv(1)=pizda(1,1)-pizda(2,2)
8668 vv(2)=pizda(2,1)+pizda(1,2)
8669 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8671 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8673 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8676 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8679 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8682 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8684 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8686 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8690 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8692 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8695 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8697 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8705 c----------------------------------------------------------------------------
8706 double precision function eello_turn6(i,jj,kk)
8707 implicit real*8 (a-h,o-z)
8708 include 'DIMENSIONS'
8709 include 'COMMON.IOUNITS'
8710 include 'COMMON.CHAIN'
8711 include 'COMMON.DERIV'
8712 include 'COMMON.INTERACT'
8713 include 'COMMON.CONTACTS'
8715 include 'COMMON.CONTACTS.MOMENT'
8717 include 'COMMON.TORSION'
8718 include 'COMMON.VAR'
8719 include 'COMMON.GEO'
8720 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8721 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8723 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8724 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8725 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8726 C the respective energy moment and not to the cluster cumulant.
8735 iti=itortyp(itype(i))
8736 itk=itortyp(itype(k))
8737 itk1=itortyp(itype(k+1))
8738 itl=itortyp(itype(l))
8739 itj=itortyp(itype(j))
8740 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8741 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8742 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8747 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8749 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8753 derx_turn(lll,kkk,iii)=0.0d0
8760 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8762 cd write (2,*) 'eello6_5',eello6_5
8764 call transpose2(AEA(1,1,1),auxmat(1,1))
8765 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8766 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8767 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8769 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8770 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8771 s2 = scalar2(b1(1,itk),vtemp1(1))
8773 call transpose2(AEA(1,1,2),atemp(1,1))
8774 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8775 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8776 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8778 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8779 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8780 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8782 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8783 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8784 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8785 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8786 ss13 = scalar2(b1(1,itk),vtemp4(1))
8787 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8789 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8795 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8796 C Derivatives in gamma(i+2)
8800 call transpose2(AEA(1,1,1),auxmatd(1,1))
8801 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8802 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8803 call transpose2(AEAderg(1,1,2),atempd(1,1))
8804 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8805 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8807 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8808 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8809 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8815 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8816 C Derivatives in gamma(i+3)
8818 call transpose2(AEA(1,1,1),auxmatd(1,1))
8819 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8820 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8821 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8823 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8824 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8825 s2d = scalar2(b1(1,itk),vtemp1d(1))
8827 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8828 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8830 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8832 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8833 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8834 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8842 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8843 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8845 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8846 & -0.5d0*ekont*(s2d+s12d)
8848 C Derivatives in gamma(i+4)
8849 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8850 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8851 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8853 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8854 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8855 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8863 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8865 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8867 C Derivatives in gamma(i+5)
8869 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8870 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8871 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8873 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8874 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8875 s2d = scalar2(b1(1,itk),vtemp1d(1))
8877 call transpose2(AEA(1,1,2),atempd(1,1))
8878 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8879 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8881 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8882 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8884 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8885 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8886 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8894 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8895 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8897 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8898 & -0.5d0*ekont*(s2d+s12d)
8900 C Cartesian derivatives
8905 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8906 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8907 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8909 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8910 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8912 s2d = scalar2(b1(1,itk),vtemp1d(1))
8914 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8915 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8916 s8d = -(atempd(1,1)+atempd(2,2))*
8917 & scalar2(cc(1,1,itl),vtemp2(1))
8919 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8921 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8922 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8929 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8932 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8936 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8937 & - 0.5d0*(s8d+s12d)
8939 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8948 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8950 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8951 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8952 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8953 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8954 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8956 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8957 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8958 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8962 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8963 cd & 16*eel_turn6_num
8965 if (j.lt.nres-1) then
8972 if (l.lt.nres-1) then
8980 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8981 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8982 cgrad ghalf=0.5d0*ggg1(ll)
8984 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8985 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8986 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8987 & +ekont*derx_turn(ll,2,1)
8988 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8989 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8990 & +ekont*derx_turn(ll,4,1)
8991 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8992 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8993 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8994 cgrad ghalf=0.5d0*ggg2(ll)
8996 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8997 & +ekont*derx_turn(ll,2,2)
8998 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8999 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9000 & +ekont*derx_turn(ll,4,2)
9001 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9002 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9003 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9008 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9013 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9019 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9024 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9028 cd write (2,*) iii,g_corr6_loc(iii)
9030 eello_turn6=ekont*eel_turn6
9031 cd write (2,*) 'ekont',ekont
9032 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9036 C-----------------------------------------------------------------------------
9037 double precision function scalar(u,v)
9038 !DIR$ INLINEALWAYS scalar
9040 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9043 double precision u(3),v(3)
9044 cd double precision sc
9052 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9055 crc-------------------------------------------------
9056 SUBROUTINE MATVEC2(A1,V1,V2)
9057 !DIR$ INLINEALWAYS MATVEC2
9059 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9061 implicit real*8 (a-h,o-z)
9062 include 'DIMENSIONS'
9063 DIMENSION A1(2,2),V1(2),V2(2)
9067 c 3 VI=VI+A1(I,K)*V1(K)
9071 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9072 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9077 C---------------------------------------
9078 SUBROUTINE MATMAT2(A1,A2,A3)
9080 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9082 implicit real*8 (a-h,o-z)
9083 include 'DIMENSIONS'
9084 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9085 c DIMENSION AI3(2,2)
9089 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9095 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9096 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9097 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9098 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9106 c-------------------------------------------------------------------------
9107 double precision function scalar2(u,v)
9108 !DIR$ INLINEALWAYS scalar2
9110 double precision u(2),v(2)
9113 scalar2=u(1)*v(1)+u(2)*v(2)
9117 C-----------------------------------------------------------------------------
9119 subroutine transpose2(a,at)
9120 !DIR$ INLINEALWAYS transpose2
9122 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9125 double precision a(2,2),at(2,2)
9132 c--------------------------------------------------------------------------
9133 subroutine transpose(n,a,at)
9136 double precision a(n,n),at(n,n)
9144 C---------------------------------------------------------------------------
9145 subroutine prodmat3(a1,a2,kk,transp,prod)
9146 !DIR$ INLINEALWAYS prodmat3
9148 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9152 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9154 crc double precision auxmat(2,2),prod_(2,2)
9157 crc call transpose2(kk(1,1),auxmat(1,1))
9158 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9159 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9161 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9162 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9163 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9164 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9165 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9166 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9167 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9168 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9171 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9172 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9174 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9175 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9176 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9177 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9178 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9179 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9180 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9181 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9184 c call transpose2(a2(1,1),a2t(1,1))
9187 crc print *,((prod_(i,j),i=1,2),j=1,2)
9188 crc print *,((prod(i,j),i=1,2),j=1,2)