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 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1088 do i=iatsc_s,iatsc_e
1097 C Calculate SC interaction energy.
1099 do iint=1,nint_gr(i)
1100 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1101 cd & 'iend=',iend(i,iint)
1102 do j=istart(i,iint),iend(i,iint)
1107 C Change 12/1/95 to calculate four-body interactions
1108 rij=xj*xj+yj*yj+zj*zj
1110 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1111 eps0ij=eps(itypi,itypj)
1113 e1=fac*fac*aa(itypi,itypj)
1114 e2=fac*bb(itypi,itypj)
1116 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1117 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1118 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1119 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1120 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1121 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1123 if (bb(itypi,itypj).gt.0) then
1124 evdw_p=evdw_p+evdwij
1126 evdw_m=evdw_m+evdwij
1132 C Calculate the components of the gradient in DC and X
1134 fac=-rrij*(e1+evdwij)
1139 if (bb(itypi,itypj).gt.0.0d0) then
1141 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1142 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1143 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1144 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1148 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1149 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1150 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1151 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1156 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1157 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1158 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1159 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1164 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1168 C 12/1/95, revised on 5/20/97
1170 C Calculate the contact function. The ith column of the array JCONT will
1171 C contain the numbers of atoms that make contacts with the atom I (of numbers
1172 C greater than I). The arrays FACONT and GACONT will contain the values of
1173 C the contact function and its derivative.
1175 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1176 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1177 C Uncomment next line, if the correlation interactions are contact function only
1178 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1180 sigij=sigma(itypi,itypj)
1181 r0ij=rs0(itypi,itypj)
1183 C Check whether the SC's are not too far to make a contact.
1186 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1187 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1189 if (fcont.gt.0.0D0) then
1190 C If the SC-SC distance if close to sigma, apply spline.
1191 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1192 cAdam & fcont1,fprimcont1)
1193 cAdam fcont1=1.0d0-fcont1
1194 cAdam if (fcont1.gt.0.0d0) then
1195 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1196 cAdam fcont=fcont*fcont1
1198 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1199 cga eps0ij=1.0d0/dsqrt(eps0ij)
1201 cga gg(k)=gg(k)*eps0ij
1203 cga eps0ij=-evdwij*eps0ij
1204 C Uncomment for AL's type of SC correlation interactions.
1205 cadam eps0ij=-evdwij
1206 num_conti=num_conti+1
1207 jcont(num_conti,i)=j
1208 facont(num_conti,i)=fcont*eps0ij
1209 fprimcont=eps0ij*fprimcont/rij
1211 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1212 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1213 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1214 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1215 gacont(1,num_conti,i)=-fprimcont*xj
1216 gacont(2,num_conti,i)=-fprimcont*yj
1217 gacont(3,num_conti,i)=-fprimcont*zj
1218 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1219 cd write (iout,'(2i3,3f10.5)')
1220 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1226 num_cont(i)=num_conti
1230 gvdwc(j,i)=expon*gvdwc(j,i)
1231 gvdwx(j,i)=expon*gvdwx(j,i)
1234 C******************************************************************************
1238 C To save time, the factor of EXPON has been extracted from ALL components
1239 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1242 C******************************************************************************
1245 C-----------------------------------------------------------------------------
1246 subroutine eljk(evdw,evdw_p,evdw_m)
1248 C This subroutine calculates the interaction energy of nonbonded side chains
1249 C assuming the LJK potential of interaction.
1251 implicit real*8 (a-h,o-z)
1252 include 'DIMENSIONS'
1253 include 'COMMON.GEO'
1254 include 'COMMON.VAR'
1255 include 'COMMON.LOCAL'
1256 include 'COMMON.CHAIN'
1257 include 'COMMON.DERIV'
1258 include 'COMMON.INTERACT'
1259 include 'COMMON.IOUNITS'
1260 include 'COMMON.NAMES'
1263 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1265 do i=iatsc_s,iatsc_e
1272 C Calculate SC interaction energy.
1274 do iint=1,nint_gr(i)
1275 do j=istart(i,iint),iend(i,iint)
1280 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1281 fac_augm=rrij**expon
1282 e_augm=augm(itypi,itypj)*fac_augm
1283 r_inv_ij=dsqrt(rrij)
1285 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1286 fac=r_shift_inv**expon
1287 e1=fac*fac*aa(itypi,itypj)
1288 e2=fac*bb(itypi,itypj)
1290 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1291 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1292 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1293 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1294 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1295 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1296 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1298 if (bb(itypi,itypj).gt.0) then
1299 evdw_p=evdw_p+evdwij
1301 evdw_m=evdw_m+evdwij
1307 C Calculate the components of the gradient in DC and X
1309 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1314 if (bb(itypi,itypj).gt.0.0d0) then
1316 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1317 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1318 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1319 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1323 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1324 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1325 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1326 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1331 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1332 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1333 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1334 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1339 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1347 gvdwc(j,i)=expon*gvdwc(j,i)
1348 gvdwx(j,i)=expon*gvdwx(j,i)
1353 C-----------------------------------------------------------------------------
1354 subroutine ebp(evdw,evdw_p,evdw_m)
1356 C This subroutine calculates the interaction energy of nonbonded side chains
1357 C assuming the Berne-Pechukas potential of interaction.
1359 implicit real*8 (a-h,o-z)
1360 include 'DIMENSIONS'
1361 include 'COMMON.GEO'
1362 include 'COMMON.VAR'
1363 include 'COMMON.LOCAL'
1364 include 'COMMON.CHAIN'
1365 include 'COMMON.DERIV'
1366 include 'COMMON.NAMES'
1367 include 'COMMON.INTERACT'
1368 include 'COMMON.IOUNITS'
1369 include 'COMMON.CALC'
1370 common /srutu/ icall
1371 c double precision rrsave(maxdim)
1374 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1376 c if (icall.eq.0) then
1382 do i=iatsc_s,iatsc_e
1388 dxi=dc_norm(1,nres+i)
1389 dyi=dc_norm(2,nres+i)
1390 dzi=dc_norm(3,nres+i)
1391 c dsci_inv=dsc_inv(itypi)
1392 dsci_inv=vbld_inv(i+nres)
1394 C Calculate SC interaction energy.
1396 do iint=1,nint_gr(i)
1397 do j=istart(i,iint),iend(i,iint)
1400 c dscj_inv=dsc_inv(itypj)
1401 dscj_inv=vbld_inv(j+nres)
1402 chi1=chi(itypi,itypj)
1403 chi2=chi(itypj,itypi)
1410 alf12=0.5D0*(alf1+alf2)
1411 C For diagnostics only!!!
1424 dxj=dc_norm(1,nres+j)
1425 dyj=dc_norm(2,nres+j)
1426 dzj=dc_norm(3,nres+j)
1427 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1428 cd if (icall.eq.0) then
1434 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1436 C Calculate whole angle-dependent part of epsilon and contributions
1437 C to its derivatives
1438 fac=(rrij*sigsq)**expon2
1439 e1=fac*fac*aa(itypi,itypj)
1440 e2=fac*bb(itypi,itypj)
1441 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1442 eps2der=evdwij*eps3rt
1443 eps3der=evdwij*eps2rt
1444 evdwij=evdwij*eps2rt*eps3rt
1446 if (bb(itypi,itypj).gt.0) then
1447 evdw_p=evdw_p+evdwij
1449 evdw_m=evdw_m+evdwij
1455 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1456 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1457 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1458 cd & restyp(itypi),i,restyp(itypj),j,
1459 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1460 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1461 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1464 C Calculate gradient components.
1465 e1=e1*eps1*eps2rt**2*eps3rt**2
1466 fac=-expon*(e1+evdwij)
1469 C Calculate radial part of the gradient
1473 C Calculate the angular part of the gradient and sum add the contributions
1474 C to the appropriate components of the Cartesian gradient.
1476 if (bb(itypi,itypj).gt.0) then
1490 C-----------------------------------------------------------------------------
1491 subroutine egb(evdw,evdw_p,evdw_m)
1493 C This subroutine calculates the interaction energy of nonbonded side chains
1494 C assuming the Gay-Berne potential of interaction.
1496 implicit real*8 (a-h,o-z)
1497 include 'DIMENSIONS'
1498 include 'COMMON.GEO'
1499 include 'COMMON.VAR'
1500 include 'COMMON.LOCAL'
1501 include 'COMMON.CHAIN'
1502 include 'COMMON.DERIV'
1503 include 'COMMON.NAMES'
1504 include 'COMMON.INTERACT'
1505 include 'COMMON.IOUNITS'
1506 include 'COMMON.CALC'
1507 include 'COMMON.CONTROL'
1510 ccccc energy_dec=.false.
1511 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1516 c if (icall.eq.0) lprn=.false.
1518 do i=iatsc_s,iatsc_e
1524 dxi=dc_norm(1,nres+i)
1525 dyi=dc_norm(2,nres+i)
1526 dzi=dc_norm(3,nres+i)
1527 c dsci_inv=dsc_inv(itypi)
1528 dsci_inv=vbld_inv(i+nres)
1529 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1530 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1532 C Calculate SC interaction energy.
1534 do iint=1,nint_gr(i)
1535 do j=istart(i,iint),iend(i,iint)
1538 c dscj_inv=dsc_inv(itypj)
1539 dscj_inv=vbld_inv(j+nres)
1540 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1541 c & 1.0d0/vbld(j+nres)
1542 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1543 sig0ij=sigma(itypi,itypj)
1544 chi1=chi(itypi,itypj)
1545 chi2=chi(itypj,itypi)
1552 alf12=0.5D0*(alf1+alf2)
1553 C For diagnostics only!!!
1566 dxj=dc_norm(1,nres+j)
1567 dyj=dc_norm(2,nres+j)
1568 dzj=dc_norm(3,nres+j)
1569 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1570 c write (iout,*) "j",j," dc_norm",
1571 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1572 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1574 C Calculate angle-dependent terms of energy and contributions to their
1578 sig=sig0ij*dsqrt(sigsq)
1579 rij_shift=1.0D0/rij-sig+sig0ij
1580 c for diagnostics; uncomment
1581 c rij_shift=1.2*sig0ij
1582 C I hate to put IF's in the loops, but here don't have another choice!!!!
1583 if (rij_shift.le.0.0D0) then
1585 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1586 cd & restyp(itypi),i,restyp(itypj),j,
1587 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1591 c---------------------------------------------------------------
1592 rij_shift=1.0D0/rij_shift
1593 fac=rij_shift**expon
1594 e1=fac*fac*aa(itypi,itypj)
1595 e2=fac*bb(itypi,itypj)
1596 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1597 eps2der=evdwij*eps3rt
1598 eps3der=evdwij*eps2rt
1599 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1600 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1601 evdwij=evdwij*eps2rt*eps3rt
1603 if (bb(itypi,itypj).gt.0) then
1604 evdw_p=evdw_p+evdwij
1606 evdw_m=evdw_m+evdwij
1612 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1613 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1614 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1615 & restyp(itypi),i,restyp(itypj),j,
1616 & epsi,sigm,chi1,chi2,chip1,chip2,
1617 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1618 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1622 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1625 C Calculate gradient components.
1626 e1=e1*eps1*eps2rt**2*eps3rt**2
1627 fac=-expon*(e1+evdwij)*rij_shift
1631 C Calculate the radial part of the gradient
1635 C Calculate angular part of the gradient.
1637 if (bb(itypi,itypj).gt.0) then
1648 c write (iout,*) "Number of loop steps in EGB:",ind
1649 cccc energy_dec=.false.
1652 C-----------------------------------------------------------------------------
1653 subroutine egbv(evdw,evdw_p,evdw_m)
1655 C This subroutine calculates the interaction energy of nonbonded side chains
1656 C assuming the Gay-Berne-Vorobjev potential of interaction.
1658 implicit real*8 (a-h,o-z)
1659 include 'DIMENSIONS'
1660 include 'COMMON.GEO'
1661 include 'COMMON.VAR'
1662 include 'COMMON.LOCAL'
1663 include 'COMMON.CHAIN'
1664 include 'COMMON.DERIV'
1665 include 'COMMON.NAMES'
1666 include 'COMMON.INTERACT'
1667 include 'COMMON.IOUNITS'
1668 include 'COMMON.CALC'
1669 common /srutu/ icall
1672 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1675 c if (icall.eq.0) lprn=.true.
1677 do i=iatsc_s,iatsc_e
1683 dxi=dc_norm(1,nres+i)
1684 dyi=dc_norm(2,nres+i)
1685 dzi=dc_norm(3,nres+i)
1686 c dsci_inv=dsc_inv(itypi)
1687 dsci_inv=vbld_inv(i+nres)
1689 C Calculate SC interaction energy.
1691 do iint=1,nint_gr(i)
1692 do j=istart(i,iint),iend(i,iint)
1695 c dscj_inv=dsc_inv(itypj)
1696 dscj_inv=vbld_inv(j+nres)
1697 sig0ij=sigma(itypi,itypj)
1698 r0ij=r0(itypi,itypj)
1699 chi1=chi(itypi,itypj)
1700 chi2=chi(itypj,itypi)
1707 alf12=0.5D0*(alf1+alf2)
1708 C For diagnostics only!!!
1721 dxj=dc_norm(1,nres+j)
1722 dyj=dc_norm(2,nres+j)
1723 dzj=dc_norm(3,nres+j)
1724 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1726 C Calculate angle-dependent terms of energy and contributions to their
1730 sig=sig0ij*dsqrt(sigsq)
1731 rij_shift=1.0D0/rij-sig+r0ij
1732 C I hate to put IF's in the loops, but here don't have another choice!!!!
1733 if (rij_shift.le.0.0D0) then
1738 c---------------------------------------------------------------
1739 rij_shift=1.0D0/rij_shift
1740 fac=rij_shift**expon
1741 e1=fac*fac*aa(itypi,itypj)
1742 e2=fac*bb(itypi,itypj)
1743 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1744 eps2der=evdwij*eps3rt
1745 eps3der=evdwij*eps2rt
1746 fac_augm=rrij**expon
1747 e_augm=augm(itypi,itypj)*fac_augm
1748 evdwij=evdwij*eps2rt*eps3rt
1750 if (bb(itypi,itypj).gt.0) then
1751 evdw_p=evdw_p+evdwij+e_augm
1753 evdw_m=evdw_m+evdwij+e_augm
1756 evdw=evdw+evdwij+e_augm
1759 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1760 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1761 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1762 & restyp(itypi),i,restyp(itypj),j,
1763 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1764 & chi1,chi2,chip1,chip2,
1765 & eps1,eps2rt**2,eps3rt**2,
1766 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1769 C Calculate gradient components.
1770 e1=e1*eps1*eps2rt**2*eps3rt**2
1771 fac=-expon*(e1+evdwij)*rij_shift
1773 fac=rij*fac-2*expon*rrij*e_augm
1774 C Calculate the radial part of the gradient
1778 C Calculate angular part of the gradient.
1780 if (bb(itypi,itypj).gt.0) then
1792 C-----------------------------------------------------------------------------
1793 subroutine sc_angular
1794 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1795 C om12. Called by ebp, egb, and egbv.
1797 include 'COMMON.CALC'
1798 include 'COMMON.IOUNITS'
1802 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1803 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1804 om12=dxi*dxj+dyi*dyj+dzi*dzj
1806 C Calculate eps1(om12) and its derivative in om12
1807 faceps1=1.0D0-om12*chiom12
1808 faceps1_inv=1.0D0/faceps1
1809 eps1=dsqrt(faceps1_inv)
1810 C Following variable is eps1*deps1/dom12
1811 eps1_om12=faceps1_inv*chiom12
1816 c write (iout,*) "om12",om12," eps1",eps1
1817 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1822 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1823 sigsq=1.0D0-facsig*faceps1_inv
1824 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1825 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1826 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1832 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1833 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1835 C Calculate eps2 and its derivatives in om1, om2, and om12.
1838 chipom12=chip12*om12
1839 facp=1.0D0-om12*chipom12
1841 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1842 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1843 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1844 C Following variable is the square root of eps2
1845 eps2rt=1.0D0-facp1*facp_inv
1846 C Following three variables are the derivatives of the square root of eps
1847 C in om1, om2, and om12.
1848 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1849 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1850 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1851 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1852 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1853 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1854 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1855 c & " eps2rt_om12",eps2rt_om12
1856 C Calculate whole angle-dependent part of epsilon and contributions
1857 C to its derivatives
1861 C----------------------------------------------------------------------------
1862 subroutine sc_grad_T
1863 implicit real*8 (a-h,o-z)
1864 include 'DIMENSIONS'
1865 include 'COMMON.CHAIN'
1866 include 'COMMON.DERIV'
1867 include 'COMMON.CALC'
1868 include 'COMMON.IOUNITS'
1869 double precision dcosom1(3),dcosom2(3)
1870 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1871 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1872 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1873 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1877 c eom12=evdwij*eps1_om12
1879 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1880 c & " sigder",sigder
1881 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1882 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1884 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1885 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1888 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1890 c write (iout,*) "gg",(gg(k),k=1,3)
1892 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1893 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1894 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1895 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1896 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1897 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1898 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1899 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1900 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1901 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1904 C Calculate the components of the gradient in DC and X
1908 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1912 gvdwcT(l,i)=gvdwcT(l,i)-gg(l)
1913 gvdwcT(l,j)=gvdwcT(l,j)+gg(l)
1918 C----------------------------------------------------------------------------
1920 implicit real*8 (a-h,o-z)
1921 include 'DIMENSIONS'
1922 include 'COMMON.CHAIN'
1923 include 'COMMON.DERIV'
1924 include 'COMMON.CALC'
1925 include 'COMMON.IOUNITS'
1926 double precision dcosom1(3),dcosom2(3)
1927 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1928 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1929 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1930 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1934 c eom12=evdwij*eps1_om12
1936 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1937 c & " sigder",sigder
1938 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1939 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1941 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1942 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1945 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1947 c write (iout,*) "gg",(gg(k),k=1,3)
1949 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1950 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1951 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1952 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1953 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1954 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1955 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1956 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1957 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1958 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1961 C Calculate the components of the gradient in DC and X
1965 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1969 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1970 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1974 C-----------------------------------------------------------------------
1975 subroutine e_softsphere(evdw)
1977 C This subroutine calculates the interaction energy of nonbonded side chains
1978 C assuming the LJ potential of interaction.
1980 implicit real*8 (a-h,o-z)
1981 include 'DIMENSIONS'
1982 parameter (accur=1.0d-10)
1983 include 'COMMON.GEO'
1984 include 'COMMON.VAR'
1985 include 'COMMON.LOCAL'
1986 include 'COMMON.CHAIN'
1987 include 'COMMON.DERIV'
1988 include 'COMMON.INTERACT'
1989 include 'COMMON.TORSION'
1990 include 'COMMON.SBRIDGE'
1991 include 'COMMON.NAMES'
1992 include 'COMMON.IOUNITS'
1993 include 'COMMON.CONTACTS'
1995 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1997 do i=iatsc_s,iatsc_e
2004 C Calculate SC interaction energy.
2006 do iint=1,nint_gr(i)
2007 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2008 cd & 'iend=',iend(i,iint)
2009 do j=istart(i,iint),iend(i,iint)
2014 rij=xj*xj+yj*yj+zj*zj
2015 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2016 r0ij=r0(itypi,itypj)
2018 c print *,i,j,r0ij,dsqrt(rij)
2019 if (rij.lt.r0ijsq) then
2020 evdwij=0.25d0*(rij-r0ijsq)**2
2028 C Calculate the components of the gradient in DC and X
2034 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2035 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2036 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2037 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2041 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2049 C--------------------------------------------------------------------------
2050 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2053 C Soft-sphere potential of p-p interaction
2055 implicit real*8 (a-h,o-z)
2056 include 'DIMENSIONS'
2057 include 'COMMON.CONTROL'
2058 include 'COMMON.IOUNITS'
2059 include 'COMMON.GEO'
2060 include 'COMMON.VAR'
2061 include 'COMMON.LOCAL'
2062 include 'COMMON.CHAIN'
2063 include 'COMMON.DERIV'
2064 include 'COMMON.INTERACT'
2065 include 'COMMON.CONTACTS'
2066 include 'COMMON.TORSION'
2067 include 'COMMON.VECTORS'
2068 include 'COMMON.FFIELD'
2070 cd write(iout,*) 'In EELEC_soft_sphere'
2077 do i=iatel_s,iatel_e
2081 xmedi=c(1,i)+0.5d0*dxi
2082 ymedi=c(2,i)+0.5d0*dyi
2083 zmedi=c(3,i)+0.5d0*dzi
2085 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2086 do j=ielstart(i),ielend(i)
2090 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2091 r0ij=rpp(iteli,itelj)
2096 xj=c(1,j)+0.5D0*dxj-xmedi
2097 yj=c(2,j)+0.5D0*dyj-ymedi
2098 zj=c(3,j)+0.5D0*dzj-zmedi
2099 rij=xj*xj+yj*yj+zj*zj
2100 if (rij.lt.r0ijsq) then
2101 evdw1ij=0.25d0*(rij-r0ijsq)**2
2109 C Calculate contributions to the Cartesian gradient.
2115 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2116 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2119 * Loop over residues i+1 thru j-1.
2123 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2128 cgrad do i=nnt,nct-1
2130 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2132 cgrad do j=i+1,nct-1
2134 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2140 c------------------------------------------------------------------------------
2141 subroutine vec_and_deriv
2142 implicit real*8 (a-h,o-z)
2143 include 'DIMENSIONS'
2147 include 'COMMON.IOUNITS'
2148 include 'COMMON.GEO'
2149 include 'COMMON.VAR'
2150 include 'COMMON.LOCAL'
2151 include 'COMMON.CHAIN'
2152 include 'COMMON.VECTORS'
2153 include 'COMMON.SETUP'
2154 include 'COMMON.TIME1'
2155 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2156 C Compute the local reference systems. For reference system (i), the
2157 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2158 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2160 do i=ivec_start,ivec_end
2164 if (i.eq.nres-1) then
2165 C Case of the last full residue
2166 C Compute the Z-axis
2167 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2168 costh=dcos(pi-theta(nres))
2169 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2173 C Compute the derivatives of uz
2175 uzder(2,1,1)=-dc_norm(3,i-1)
2176 uzder(3,1,1)= dc_norm(2,i-1)
2177 uzder(1,2,1)= dc_norm(3,i-1)
2179 uzder(3,2,1)=-dc_norm(1,i-1)
2180 uzder(1,3,1)=-dc_norm(2,i-1)
2181 uzder(2,3,1)= dc_norm(1,i-1)
2184 uzder(2,1,2)= dc_norm(3,i)
2185 uzder(3,1,2)=-dc_norm(2,i)
2186 uzder(1,2,2)=-dc_norm(3,i)
2188 uzder(3,2,2)= dc_norm(1,i)
2189 uzder(1,3,2)= dc_norm(2,i)
2190 uzder(2,3,2)=-dc_norm(1,i)
2192 C Compute the Y-axis
2195 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2197 C Compute the derivatives of uy
2200 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2201 & -dc_norm(k,i)*dc_norm(j,i-1)
2202 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2204 uyder(j,j,1)=uyder(j,j,1)-costh
2205 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2210 uygrad(l,k,j,i)=uyder(l,k,j)
2211 uzgrad(l,k,j,i)=uzder(l,k,j)
2215 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2216 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2217 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2218 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2221 C Compute the Z-axis
2222 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2223 costh=dcos(pi-theta(i+2))
2224 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2228 C Compute the derivatives of uz
2230 uzder(2,1,1)=-dc_norm(3,i+1)
2231 uzder(3,1,1)= dc_norm(2,i+1)
2232 uzder(1,2,1)= dc_norm(3,i+1)
2234 uzder(3,2,1)=-dc_norm(1,i+1)
2235 uzder(1,3,1)=-dc_norm(2,i+1)
2236 uzder(2,3,1)= dc_norm(1,i+1)
2239 uzder(2,1,2)= dc_norm(3,i)
2240 uzder(3,1,2)=-dc_norm(2,i)
2241 uzder(1,2,2)=-dc_norm(3,i)
2243 uzder(3,2,2)= dc_norm(1,i)
2244 uzder(1,3,2)= dc_norm(2,i)
2245 uzder(2,3,2)=-dc_norm(1,i)
2247 C Compute the Y-axis
2250 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2252 C Compute the derivatives of uy
2255 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2256 & -dc_norm(k,i)*dc_norm(j,i+1)
2257 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2259 uyder(j,j,1)=uyder(j,j,1)-costh
2260 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2265 uygrad(l,k,j,i)=uyder(l,k,j)
2266 uzgrad(l,k,j,i)=uzder(l,k,j)
2270 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2271 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2272 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2273 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2277 vbld_inv_temp(1)=vbld_inv(i+1)
2278 if (i.lt.nres-1) then
2279 vbld_inv_temp(2)=vbld_inv(i+2)
2281 vbld_inv_temp(2)=vbld_inv(i)
2286 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2287 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2292 #if defined(PARVEC) && defined(MPI)
2293 if (nfgtasks1.gt.1) then
2295 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2296 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2297 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2298 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2299 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2301 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2302 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2304 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2305 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2306 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2307 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2308 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2309 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2310 time_gather=time_gather+MPI_Wtime()-time00
2312 c if (fg_rank.eq.0) then
2313 c write (iout,*) "Arrays UY and UZ"
2315 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2322 C-----------------------------------------------------------------------------
2323 subroutine check_vecgrad
2324 implicit real*8 (a-h,o-z)
2325 include 'DIMENSIONS'
2326 include 'COMMON.IOUNITS'
2327 include 'COMMON.GEO'
2328 include 'COMMON.VAR'
2329 include 'COMMON.LOCAL'
2330 include 'COMMON.CHAIN'
2331 include 'COMMON.VECTORS'
2332 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2333 dimension uyt(3,maxres),uzt(3,maxres)
2334 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2335 double precision delta /1.0d-7/
2338 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2339 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2340 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2341 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2342 cd & (dc_norm(if90,i),if90=1,3)
2343 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2344 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2345 cd write(iout,'(a)')
2351 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2352 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2365 cd write (iout,*) 'i=',i
2367 erij(k)=dc_norm(k,i)
2371 dc_norm(k,i)=erij(k)
2373 dc_norm(j,i)=dc_norm(j,i)+delta
2374 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2376 c dc_norm(k,i)=dc_norm(k,i)/fac
2378 c write (iout,*) (dc_norm(k,i),k=1,3)
2379 c write (iout,*) (erij(k),k=1,3)
2382 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2383 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2384 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2385 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2387 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2388 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2389 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2392 dc_norm(k,i)=erij(k)
2395 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2396 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2397 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2398 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2399 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2400 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2401 cd write (iout,'(a)')
2406 C--------------------------------------------------------------------------
2407 subroutine set_matrices
2408 implicit real*8 (a-h,o-z)
2409 include 'DIMENSIONS'
2412 include "COMMON.SETUP"
2414 integer status(MPI_STATUS_SIZE)
2416 include 'COMMON.IOUNITS'
2417 include 'COMMON.GEO'
2418 include 'COMMON.VAR'
2419 include 'COMMON.LOCAL'
2420 include 'COMMON.CHAIN'
2421 include 'COMMON.DERIV'
2422 include 'COMMON.INTERACT'
2423 include 'COMMON.CONTACTS'
2424 include 'COMMON.TORSION'
2425 include 'COMMON.VECTORS'
2426 include 'COMMON.FFIELD'
2427 double precision auxvec(2),auxmat(2,2)
2429 C Compute the virtual-bond-torsional-angle dependent quantities needed
2430 C to calculate the el-loc multibody terms of various order.
2433 do i=ivec_start+2,ivec_end+2
2437 if (i .lt. nres+1) then
2474 if (i .gt. 3 .and. i .lt. nres+1) then
2475 obrot_der(1,i-2)=-sin1
2476 obrot_der(2,i-2)= cos1
2477 Ugder(1,1,i-2)= sin1
2478 Ugder(1,2,i-2)=-cos1
2479 Ugder(2,1,i-2)=-cos1
2480 Ugder(2,2,i-2)=-sin1
2483 obrot2_der(1,i-2)=-dwasin2
2484 obrot2_der(2,i-2)= dwacos2
2485 Ug2der(1,1,i-2)= dwasin2
2486 Ug2der(1,2,i-2)=-dwacos2
2487 Ug2der(2,1,i-2)=-dwacos2
2488 Ug2der(2,2,i-2)=-dwasin2
2490 obrot_der(1,i-2)=0.0d0
2491 obrot_der(2,i-2)=0.0d0
2492 Ugder(1,1,i-2)=0.0d0
2493 Ugder(1,2,i-2)=0.0d0
2494 Ugder(2,1,i-2)=0.0d0
2495 Ugder(2,2,i-2)=0.0d0
2496 obrot2_der(1,i-2)=0.0d0
2497 obrot2_der(2,i-2)=0.0d0
2498 Ug2der(1,1,i-2)=0.0d0
2499 Ug2der(1,2,i-2)=0.0d0
2500 Ug2der(2,1,i-2)=0.0d0
2501 Ug2der(2,2,i-2)=0.0d0
2503 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2504 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2505 iti = itortyp(itype(i-2))
2509 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2510 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2511 iti1 = itortyp(itype(i-1))
2515 cd write (iout,*) '*******i',i,' iti1',iti
2516 cd write (iout,*) 'b1',b1(:,iti)
2517 cd write (iout,*) 'b2',b2(:,iti)
2518 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2519 c if (i .gt. iatel_s+2) then
2520 if (i .gt. nnt+2) then
2521 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2522 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2523 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2525 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2526 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2527 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2528 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2529 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2540 DtUg2(l,k,i-2)=0.0d0
2544 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2545 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2547 muder(k,i-2)=Ub2der(k,i-2)
2549 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2550 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2551 iti1 = itortyp(itype(i-1))
2556 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2558 cd write (iout,*) 'mu ',mu(:,i-2)
2559 cd write (iout,*) 'mu1',mu1(:,i-2)
2560 cd write (iout,*) 'mu2',mu2(:,i-2)
2561 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2563 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2564 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2565 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2566 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2567 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2568 C Vectors and matrices dependent on a single virtual-bond dihedral.
2569 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2570 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2571 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2572 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2573 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2574 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2575 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2576 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2577 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2580 C Matrices dependent on two consecutive virtual-bond dihedrals.
2581 C The order of matrices is from left to right.
2582 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2584 c do i=max0(ivec_start,2),ivec_end
2586 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2587 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2588 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2589 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2590 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2591 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2592 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2593 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2596 #if defined(MPI) && defined(PARMAT)
2598 c if (fg_rank.eq.0) then
2599 write (iout,*) "Arrays UG and UGDER before GATHER"
2601 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2602 & ((ug(l,k,i),l=1,2),k=1,2),
2603 & ((ugder(l,k,i),l=1,2),k=1,2)
2605 write (iout,*) "Arrays UG2 and UG2DER"
2607 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2608 & ((ug2(l,k,i),l=1,2),k=1,2),
2609 & ((ug2der(l,k,i),l=1,2),k=1,2)
2611 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2613 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2614 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2615 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2617 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2619 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2620 & costab(i),sintab(i),costab2(i),sintab2(i)
2622 write (iout,*) "Array MUDER"
2624 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2628 if (nfgtasks.gt.1) then
2630 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2631 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2632 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2634 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2635 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2637 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2638 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2640 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2641 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2643 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2644 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2646 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2647 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2649 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2650 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2652 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2653 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2654 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2655 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2656 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2657 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2658 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2659 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2660 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2661 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2662 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2663 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2664 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2666 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2667 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2669 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2670 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2672 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2673 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2675 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2676 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2678 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2679 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2681 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2682 & ivec_count(fg_rank1),
2683 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2685 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2686 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2688 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2689 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2691 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2692 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2694 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2695 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2697 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2698 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2700 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2701 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2703 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2704 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2706 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2707 & ivec_count(fg_rank1),
2708 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2710 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2711 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2713 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2714 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2716 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2717 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2719 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2720 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2722 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2723 & ivec_count(fg_rank1),
2724 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2726 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2727 & ivec_count(fg_rank1),
2728 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2730 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2731 & ivec_count(fg_rank1),
2732 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2733 & MPI_MAT2,FG_COMM1,IERR)
2734 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2735 & ivec_count(fg_rank1),
2736 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2737 & MPI_MAT2,FG_COMM1,IERR)
2740 c Passes matrix info through the ring
2743 if (irecv.lt.0) irecv=nfgtasks1-1
2746 if (inext.ge.nfgtasks1) inext=0
2748 c write (iout,*) "isend",isend," irecv",irecv
2750 lensend=lentyp(isend)
2751 lenrecv=lentyp(irecv)
2752 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2753 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2754 c & MPI_ROTAT1(lensend),inext,2200+isend,
2755 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2756 c & iprev,2200+irecv,FG_COMM,status,IERR)
2757 c write (iout,*) "Gather ROTAT1"
2759 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2760 c & MPI_ROTAT2(lensend),inext,3300+isend,
2761 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2762 c & iprev,3300+irecv,FG_COMM,status,IERR)
2763 c write (iout,*) "Gather ROTAT2"
2765 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2766 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2767 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2768 & iprev,4400+irecv,FG_COMM,status,IERR)
2769 c write (iout,*) "Gather ROTAT_OLD"
2771 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2772 & MPI_PRECOMP11(lensend),inext,5500+isend,
2773 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2774 & iprev,5500+irecv,FG_COMM,status,IERR)
2775 c write (iout,*) "Gather PRECOMP11"
2777 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2778 & MPI_PRECOMP12(lensend),inext,6600+isend,
2779 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2780 & iprev,6600+irecv,FG_COMM,status,IERR)
2781 c write (iout,*) "Gather PRECOMP12"
2783 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2785 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2786 & MPI_ROTAT2(lensend),inext,7700+isend,
2787 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2788 & iprev,7700+irecv,FG_COMM,status,IERR)
2789 c write (iout,*) "Gather PRECOMP21"
2791 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2792 & MPI_PRECOMP22(lensend),inext,8800+isend,
2793 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2794 & iprev,8800+irecv,FG_COMM,status,IERR)
2795 c write (iout,*) "Gather PRECOMP22"
2797 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2798 & MPI_PRECOMP23(lensend),inext,9900+isend,
2799 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2800 & MPI_PRECOMP23(lenrecv),
2801 & iprev,9900+irecv,FG_COMM,status,IERR)
2802 c write (iout,*) "Gather PRECOMP23"
2807 if (irecv.lt.0) irecv=nfgtasks1-1
2810 time_gather=time_gather+MPI_Wtime()-time00
2813 c if (fg_rank.eq.0) then
2814 write (iout,*) "Arrays UG and UGDER"
2816 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2817 & ((ug(l,k,i),l=1,2),k=1,2),
2818 & ((ugder(l,k,i),l=1,2),k=1,2)
2820 write (iout,*) "Arrays UG2 and UG2DER"
2822 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2823 & ((ug2(l,k,i),l=1,2),k=1,2),
2824 & ((ug2der(l,k,i),l=1,2),k=1,2)
2826 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2828 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2829 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2830 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2832 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2834 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2835 & costab(i),sintab(i),costab2(i),sintab2(i)
2837 write (iout,*) "Array MUDER"
2839 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2845 cd iti = itortyp(itype(i))
2848 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2849 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2854 C--------------------------------------------------------------------------
2855 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2857 C This subroutine calculates the average interaction energy and its gradient
2858 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2859 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2860 C The potential depends both on the distance of peptide-group centers and on
2861 C the orientation of the CA-CA virtual bonds.
2863 implicit real*8 (a-h,o-z)
2867 include 'DIMENSIONS'
2868 include 'COMMON.CONTROL'
2869 include 'COMMON.SETUP'
2870 include 'COMMON.IOUNITS'
2871 include 'COMMON.GEO'
2872 include 'COMMON.VAR'
2873 include 'COMMON.LOCAL'
2874 include 'COMMON.CHAIN'
2875 include 'COMMON.DERIV'
2876 include 'COMMON.INTERACT'
2877 include 'COMMON.CONTACTS'
2878 include 'COMMON.TORSION'
2879 include 'COMMON.VECTORS'
2880 include 'COMMON.FFIELD'
2881 include 'COMMON.TIME1'
2882 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2883 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2884 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2885 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2886 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2887 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2889 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2891 double precision scal_el /1.0d0/
2893 double precision scal_el /0.5d0/
2896 C 13-go grudnia roku pamietnego...
2897 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2898 & 0.0d0,1.0d0,0.0d0,
2899 & 0.0d0,0.0d0,1.0d0/
2900 cd write(iout,*) 'In EELEC'
2902 cd write(iout,*) 'Type',i
2903 cd write(iout,*) 'B1',B1(:,i)
2904 cd write(iout,*) 'B2',B2(:,i)
2905 cd write(iout,*) 'CC',CC(:,:,i)
2906 cd write(iout,*) 'DD',DD(:,:,i)
2907 cd write(iout,*) 'EE',EE(:,:,i)
2909 cd call check_vecgrad
2911 if (icheckgrad.eq.1) then
2913 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2915 dc_norm(k,i)=dc(k,i)*fac
2917 c write (iout,*) 'i',i,' fac',fac
2920 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2921 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2922 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2923 c call vec_and_deriv
2929 time_mat=time_mat+MPI_Wtime()-time01
2933 cd write (iout,*) 'i=',i
2935 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2938 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2939 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2952 cd print '(a)','Enter EELEC'
2953 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2955 gel_loc_loc(i)=0.0d0
2960 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2962 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2964 do i=iturn3_start,iturn3_end
2968 dx_normi=dc_norm(1,i)
2969 dy_normi=dc_norm(2,i)
2970 dz_normi=dc_norm(3,i)
2971 xmedi=c(1,i)+0.5d0*dxi
2972 ymedi=c(2,i)+0.5d0*dyi
2973 zmedi=c(3,i)+0.5d0*dzi
2975 call eelecij(i,i+2,ees,evdw1,eel_loc)
2976 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2977 num_cont_hb(i)=num_conti
2979 do i=iturn4_start,iturn4_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
2989 num_conti=num_cont_hb(i)
2990 call eelecij(i,i+3,ees,evdw1,eel_loc)
2991 if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
2992 num_cont_hb(i)=num_conti
2995 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
2997 do i=iatel_s,iatel_e
3001 dx_normi=dc_norm(1,i)
3002 dy_normi=dc_norm(2,i)
3003 dz_normi=dc_norm(3,i)
3004 xmedi=c(1,i)+0.5d0*dxi
3005 ymedi=c(2,i)+0.5d0*dyi
3006 zmedi=c(3,i)+0.5d0*dzi
3007 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3008 num_conti=num_cont_hb(i)
3009 do j=ielstart(i),ielend(i)
3010 call eelecij(i,j,ees,evdw1,eel_loc)
3012 num_cont_hb(i)=num_conti
3014 c write (iout,*) "Number of loop steps in EELEC:",ind
3016 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3017 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3019 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3020 ccc eel_loc=eel_loc+eello_turn3
3021 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3024 C-------------------------------------------------------------------------------
3025 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3026 implicit real*8 (a-h,o-z)
3027 include 'DIMENSIONS'
3031 include 'COMMON.CONTROL'
3032 include 'COMMON.IOUNITS'
3033 include 'COMMON.GEO'
3034 include 'COMMON.VAR'
3035 include 'COMMON.LOCAL'
3036 include 'COMMON.CHAIN'
3037 include 'COMMON.DERIV'
3038 include 'COMMON.INTERACT'
3039 include 'COMMON.CONTACTS'
3040 include 'COMMON.TORSION'
3041 include 'COMMON.VECTORS'
3042 include 'COMMON.FFIELD'
3043 include 'COMMON.TIME1'
3044 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3045 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3046 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3047 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3048 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3049 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3051 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3053 double precision scal_el /1.0d0/
3055 double precision scal_el /0.5d0/
3058 C 13-go grudnia roku pamietnego...
3059 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3060 & 0.0d0,1.0d0,0.0d0,
3061 & 0.0d0,0.0d0,1.0d0/
3062 c time00=MPI_Wtime()
3063 cd write (iout,*) "eelecij",i,j
3067 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3068 aaa=app(iteli,itelj)
3069 bbb=bpp(iteli,itelj)
3070 ael6i=ael6(iteli,itelj)
3071 ael3i=ael3(iteli,itelj)
3075 dx_normj=dc_norm(1,j)
3076 dy_normj=dc_norm(2,j)
3077 dz_normj=dc_norm(3,j)
3078 xj=c(1,j)+0.5D0*dxj-xmedi
3079 yj=c(2,j)+0.5D0*dyj-ymedi
3080 zj=c(3,j)+0.5D0*dzj-zmedi
3081 rij=xj*xj+yj*yj+zj*zj
3087 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3088 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3089 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3090 fac=cosa-3.0D0*cosb*cosg
3092 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3093 if (j.eq.i+2) ev1=scal_el*ev1
3098 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3101 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3102 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3105 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3106 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3107 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3108 cd & xmedi,ymedi,zmedi,xj,yj,zj
3110 if (energy_dec) then
3111 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3112 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3116 C Calculate contributions to the Cartesian gradient.
3119 facvdw=-6*rrmij*(ev1+evdwij)
3120 facel=-3*rrmij*(el1+eesij)
3126 * Radial derivatives. First process both termini of the fragment (i,j)
3132 c ghalf=0.5D0*ggg(k)
3133 c gelc(k,i)=gelc(k,i)+ghalf
3134 c gelc(k,j)=gelc(k,j)+ghalf
3136 c 9/28/08 AL Gradient compotents will be summed only at the end
3138 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3139 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3142 * Loop over residues i+1 thru j-1.
3146 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3153 c ghalf=0.5D0*ggg(k)
3154 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3155 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3157 c 9/28/08 AL Gradient compotents will be summed only at the end
3159 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3160 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3163 * Loop over residues i+1 thru j-1.
3167 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3174 fac=-3*rrmij*(facvdw+facvdw+facel)
3179 * Radial derivatives. First process both termini of the fragment (i,j)
3185 c ghalf=0.5D0*ggg(k)
3186 c gelc(k,i)=gelc(k,i)+ghalf
3187 c gelc(k,j)=gelc(k,j)+ghalf
3189 c 9/28/08 AL Gradient compotents will be summed only at the end
3191 gelc_long(k,j)=gelc(k,j)+ggg(k)
3192 gelc_long(k,i)=gelc(k,i)-ggg(k)
3195 * Loop over residues i+1 thru j-1.
3199 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3202 c 9/28/08 AL Gradient compotents will be summed only at the end
3207 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3208 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3214 ecosa=2.0D0*fac3*fac1+fac4
3217 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3218 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3220 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3221 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3223 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3224 cd & (dcosg(k),k=1,3)
3226 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3229 c ghalf=0.5D0*ggg(k)
3230 c gelc(k,i)=gelc(k,i)+ghalf
3231 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3232 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3233 c gelc(k,j)=gelc(k,j)+ghalf
3234 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3235 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3239 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3244 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3245 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3247 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3248 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3249 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3250 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3252 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3253 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3254 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3256 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3257 C energy of a peptide unit is assumed in the form of a second-order
3258 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3259 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3260 C are computed for EVERY pair of non-contiguous peptide groups.
3262 if (j.lt.nres-1) then
3273 muij(kkk)=mu(k,i)*mu(l,j)
3276 cd write (iout,*) 'EELEC: i',i,' j',j
3277 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3278 cd write(iout,*) 'muij',muij
3279 ury=scalar(uy(1,i),erij)
3280 urz=scalar(uz(1,i),erij)
3281 vry=scalar(uy(1,j),erij)
3282 vrz=scalar(uz(1,j),erij)
3283 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3284 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3285 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3286 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3287 fac=dsqrt(-ael6i)*r3ij
3292 cd write (iout,'(4i5,4f10.5)')
3293 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3294 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3295 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3296 cd & uy(:,j),uz(:,j)
3297 cd write (iout,'(4f10.5)')
3298 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3299 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3300 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3301 cd write (iout,'(9f10.5/)')
3302 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3303 C Derivatives of the elements of A in virtual-bond vectors
3304 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3306 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3307 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3308 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3309 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3310 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3311 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3312 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3313 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3314 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3315 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3316 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3317 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3319 C Compute radial contributions to the gradient
3337 C Add the contributions coming from er
3340 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3341 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3342 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3343 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3346 C Derivatives in DC(i)
3347 cgrad ghalf1=0.5d0*agg(k,1)
3348 cgrad ghalf2=0.5d0*agg(k,2)
3349 cgrad ghalf3=0.5d0*agg(k,3)
3350 cgrad ghalf4=0.5d0*agg(k,4)
3351 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3352 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3353 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3354 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3355 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3356 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3357 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3358 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3359 C Derivatives in DC(i+1)
3360 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3361 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3362 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3363 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3364 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3365 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3366 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3367 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3368 C Derivatives in DC(j)
3369 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3370 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3371 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3372 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3373 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3374 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3375 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3376 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3377 C Derivatives in DC(j+1) or DC(nres-1)
3378 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3379 & -3.0d0*vryg(k,3)*ury)
3380 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3381 & -3.0d0*vrzg(k,3)*ury)
3382 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3383 & -3.0d0*vryg(k,3)*urz)
3384 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3385 & -3.0d0*vrzg(k,3)*urz)
3386 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3388 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3401 aggi(k,l)=-aggi(k,l)
3402 aggi1(k,l)=-aggi1(k,l)
3403 aggj(k,l)=-aggj(k,l)
3404 aggj1(k,l)=-aggj1(k,l)
3407 if (j.lt.nres-1) then
3413 aggi(k,l)=-aggi(k,l)
3414 aggi1(k,l)=-aggi1(k,l)
3415 aggj(k,l)=-aggj(k,l)
3416 aggj1(k,l)=-aggj1(k,l)
3427 aggi(k,l)=-aggi(k,l)
3428 aggi1(k,l)=-aggi1(k,l)
3429 aggj(k,l)=-aggj(k,l)
3430 aggj1(k,l)=-aggj1(k,l)
3435 IF (wel_loc.gt.0.0d0) THEN
3436 C Contribution to the local-electrostatic energy coming from the i-j pair
3437 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3439 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3441 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3442 & 'eelloc',i,j,eel_loc_ij
3444 eel_loc=eel_loc+eel_loc_ij
3445 C Partial derivatives in virtual-bond dihedral angles gamma
3447 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3448 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3449 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3450 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3451 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3452 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3453 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3455 ggg(l)=agg(l,1)*muij(1)+
3456 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3457 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3458 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3459 cgrad ghalf=0.5d0*ggg(l)
3460 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3461 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3465 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3468 C Remaining derivatives of eello
3470 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3471 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3472 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3473 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3474 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3475 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3476 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3477 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3480 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3481 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3482 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3483 & .and. num_conti.le.maxconts) then
3484 c write (iout,*) i,j," entered corr"
3486 C Calculate the contact function. The ith column of the array JCONT will
3487 C contain the numbers of atoms that make contacts with the atom I (of numbers
3488 C greater than I). The arrays FACONT and GACONT will contain the values of
3489 C the contact function and its derivative.
3490 c r0ij=1.02D0*rpp(iteli,itelj)
3491 c r0ij=1.11D0*rpp(iteli,itelj)
3492 r0ij=2.20D0*rpp(iteli,itelj)
3493 c r0ij=1.55D0*rpp(iteli,itelj)
3494 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3495 if (fcont.gt.0.0D0) then
3496 num_conti=num_conti+1
3497 if (num_conti.gt.maxconts) then
3498 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3499 & ' will skip next contacts for this conf.'
3501 jcont_hb(num_conti,i)=j
3502 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3503 cd & " jcont_hb",jcont_hb(num_conti,i)
3504 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3505 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3506 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3508 d_cont(num_conti,i)=rij
3509 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3510 C --- Electrostatic-interaction matrix ---
3511 a_chuj(1,1,num_conti,i)=a22
3512 a_chuj(1,2,num_conti,i)=a23
3513 a_chuj(2,1,num_conti,i)=a32
3514 a_chuj(2,2,num_conti,i)=a33
3515 C --- Gradient of rij
3517 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3524 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3525 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3526 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3527 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3528 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3533 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3534 C Calculate contact energies
3536 wij=cosa-3.0D0*cosb*cosg
3539 c fac3=dsqrt(-ael6i)/r0ij**3
3540 fac3=dsqrt(-ael6i)*r3ij
3541 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3542 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3543 if (ees0tmp.gt.0) then
3544 ees0pij=dsqrt(ees0tmp)
3548 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3549 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3550 if (ees0tmp.gt.0) then
3551 ees0mij=dsqrt(ees0tmp)
3556 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3557 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3558 C Diagnostics. Comment out or remove after debugging!
3559 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3560 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3561 c ees0m(num_conti,i)=0.0D0
3563 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3564 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3565 C Angular derivatives of the contact function
3566 ees0pij1=fac3/ees0pij
3567 ees0mij1=fac3/ees0mij
3568 fac3p=-3.0D0*fac3*rrmij
3569 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3570 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3572 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3573 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3574 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3575 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3576 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3577 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3578 ecosap=ecosa1+ecosa2
3579 ecosbp=ecosb1+ecosb2
3580 ecosgp=ecosg1+ecosg2
3581 ecosam=ecosa1-ecosa2
3582 ecosbm=ecosb1-ecosb2
3583 ecosgm=ecosg1-ecosg2
3592 facont_hb(num_conti,i)=fcont
3593 fprimcont=fprimcont/rij
3594 cd facont_hb(num_conti,i)=1.0D0
3595 C Following line is for diagnostics.
3598 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3599 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3602 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3603 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3605 gggp(1)=gggp(1)+ees0pijp*xj
3606 gggp(2)=gggp(2)+ees0pijp*yj
3607 gggp(3)=gggp(3)+ees0pijp*zj
3608 gggm(1)=gggm(1)+ees0mijp*xj
3609 gggm(2)=gggm(2)+ees0mijp*yj
3610 gggm(3)=gggm(3)+ees0mijp*zj
3611 C Derivatives due to the contact function
3612 gacont_hbr(1,num_conti,i)=fprimcont*xj
3613 gacont_hbr(2,num_conti,i)=fprimcont*yj
3614 gacont_hbr(3,num_conti,i)=fprimcont*zj
3617 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3618 c following the change of gradient-summation algorithm.
3620 cgrad ghalfp=0.5D0*gggp(k)
3621 cgrad ghalfm=0.5D0*gggm(k)
3622 gacontp_hb1(k,num_conti,i)=!ghalfp
3623 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3624 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3625 gacontp_hb2(k,num_conti,i)=!ghalfp
3626 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3627 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3628 gacontp_hb3(k,num_conti,i)=gggp(k)
3629 gacontm_hb1(k,num_conti,i)=!ghalfm
3630 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3631 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3632 gacontm_hb2(k,num_conti,i)=!ghalfm
3633 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3634 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3635 gacontm_hb3(k,num_conti,i)=gggm(k)
3637 C Diagnostics. Comment out or remove after debugging!
3639 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3640 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3641 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3642 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3643 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3644 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3647 endif ! num_conti.le.maxconts
3650 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3653 ghalf=0.5d0*agg(l,k)
3654 aggi(l,k)=aggi(l,k)+ghalf
3655 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3656 aggj(l,k)=aggj(l,k)+ghalf
3659 if (j.eq.nres-1 .and. i.lt.j-2) then
3662 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3667 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3670 C-----------------------------------------------------------------------------
3671 subroutine eturn3(i,eello_turn3)
3672 C Third- and fourth-order contributions from turns
3673 implicit real*8 (a-h,o-z)
3674 include 'DIMENSIONS'
3675 include 'COMMON.IOUNITS'
3676 include 'COMMON.GEO'
3677 include 'COMMON.VAR'
3678 include 'COMMON.LOCAL'
3679 include 'COMMON.CHAIN'
3680 include 'COMMON.DERIV'
3681 include 'COMMON.INTERACT'
3682 include 'COMMON.CONTACTS'
3683 include 'COMMON.TORSION'
3684 include 'COMMON.VECTORS'
3685 include 'COMMON.FFIELD'
3686 include 'COMMON.CONTROL'
3688 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3689 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3690 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3691 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3692 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3693 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3694 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3697 c write (iout,*) "eturn3",i,j,j1,j2
3702 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3704 C Third-order contributions
3711 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3712 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3713 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3714 call transpose2(auxmat(1,1),auxmat1(1,1))
3715 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3716 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3717 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3718 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3719 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3720 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3721 cd & ' eello_turn3_num',4*eello_turn3_num
3722 C Derivatives in gamma(i)
3723 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3724 call transpose2(auxmat2(1,1),auxmat3(1,1))
3725 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3726 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3727 C Derivatives in gamma(i+1)
3728 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3729 call transpose2(auxmat2(1,1),auxmat3(1,1))
3730 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3731 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3732 & +0.5d0*(pizda(1,1)+pizda(2,2))
3733 C Cartesian derivatives
3735 c ghalf1=0.5d0*agg(l,1)
3736 c ghalf2=0.5d0*agg(l,2)
3737 c ghalf3=0.5d0*agg(l,3)
3738 c ghalf4=0.5d0*agg(l,4)
3739 a_temp(1,1)=aggi(l,1)!+ghalf1
3740 a_temp(1,2)=aggi(l,2)!+ghalf2
3741 a_temp(2,1)=aggi(l,3)!+ghalf3
3742 a_temp(2,2)=aggi(l,4)!+ghalf4
3743 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3744 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3745 & +0.5d0*(pizda(1,1)+pizda(2,2))
3746 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3747 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3748 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3749 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3750 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3751 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3752 & +0.5d0*(pizda(1,1)+pizda(2,2))
3753 a_temp(1,1)=aggj(l,1)!+ghalf1
3754 a_temp(1,2)=aggj(l,2)!+ghalf2
3755 a_temp(2,1)=aggj(l,3)!+ghalf3
3756 a_temp(2,2)=aggj(l,4)!+ghalf4
3757 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3758 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3759 & +0.5d0*(pizda(1,1)+pizda(2,2))
3760 a_temp(1,1)=aggj1(l,1)
3761 a_temp(1,2)=aggj1(l,2)
3762 a_temp(2,1)=aggj1(l,3)
3763 a_temp(2,2)=aggj1(l,4)
3764 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3765 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3766 & +0.5d0*(pizda(1,1)+pizda(2,2))
3770 C-------------------------------------------------------------------------------
3771 subroutine eturn4(i,eello_turn4)
3772 C Third- and fourth-order contributions from turns
3773 implicit real*8 (a-h,o-z)
3774 include 'DIMENSIONS'
3775 include 'COMMON.IOUNITS'
3776 include 'COMMON.GEO'
3777 include 'COMMON.VAR'
3778 include 'COMMON.LOCAL'
3779 include 'COMMON.CHAIN'
3780 include 'COMMON.DERIV'
3781 include 'COMMON.INTERACT'
3782 include 'COMMON.CONTACTS'
3783 include 'COMMON.TORSION'
3784 include 'COMMON.VECTORS'
3785 include 'COMMON.FFIELD'
3786 include 'COMMON.CONTROL'
3788 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3789 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3790 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3791 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3792 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3793 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3794 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3797 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3799 C Fourth-order contributions
3807 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3808 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3809 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3814 iti1=itortyp(itype(i+1))
3815 iti2=itortyp(itype(i+2))
3816 iti3=itortyp(itype(i+3))
3817 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3818 call transpose2(EUg(1,1,i+1),e1t(1,1))
3819 call transpose2(Eug(1,1,i+2),e2t(1,1))
3820 call transpose2(Eug(1,1,i+3),e3t(1,1))
3821 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3822 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3823 s1=scalar2(b1(1,iti2),auxvec(1))
3824 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3825 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3826 s2=scalar2(b1(1,iti1),auxvec(1))
3827 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3828 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3829 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3830 eello_turn4=eello_turn4-(s1+s2+s3)
3831 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3832 & 'eturn4',i,j,-(s1+s2+s3)
3833 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3834 cd & ' eello_turn4_num',8*eello_turn4_num
3835 C Derivatives in gamma(i)
3836 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3837 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3838 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3839 s1=scalar2(b1(1,iti2),auxvec(1))
3840 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3841 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3842 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3843 C Derivatives in gamma(i+1)
3844 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3845 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3846 s2=scalar2(b1(1,iti1),auxvec(1))
3847 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3848 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3849 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3850 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3851 C Derivatives in gamma(i+2)
3852 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3853 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3854 s1=scalar2(b1(1,iti2),auxvec(1))
3855 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3856 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3857 s2=scalar2(b1(1,iti1),auxvec(1))
3858 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3859 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3860 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3861 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3862 C Cartesian derivatives
3863 C Derivatives of this turn contributions in DC(i+2)
3864 if (j.lt.nres-1) then
3866 a_temp(1,1)=agg(l,1)
3867 a_temp(1,2)=agg(l,2)
3868 a_temp(2,1)=agg(l,3)
3869 a_temp(2,2)=agg(l,4)
3870 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3871 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3872 s1=scalar2(b1(1,iti2),auxvec(1))
3873 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3874 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3875 s2=scalar2(b1(1,iti1),auxvec(1))
3876 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3877 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3878 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3880 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3883 C Remaining derivatives of this turn contribution
3885 a_temp(1,1)=aggi(l,1)
3886 a_temp(1,2)=aggi(l,2)
3887 a_temp(2,1)=aggi(l,3)
3888 a_temp(2,2)=aggi(l,4)
3889 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3890 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3891 s1=scalar2(b1(1,iti2),auxvec(1))
3892 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3893 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3894 s2=scalar2(b1(1,iti1),auxvec(1))
3895 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3896 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3897 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3898 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3899 a_temp(1,1)=aggi1(l,1)
3900 a_temp(1,2)=aggi1(l,2)
3901 a_temp(2,1)=aggi1(l,3)
3902 a_temp(2,2)=aggi1(l,4)
3903 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3904 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3905 s1=scalar2(b1(1,iti2),auxvec(1))
3906 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3907 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3908 s2=scalar2(b1(1,iti1),auxvec(1))
3909 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3910 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3911 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3912 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3913 a_temp(1,1)=aggj(l,1)
3914 a_temp(1,2)=aggj(l,2)
3915 a_temp(2,1)=aggj(l,3)
3916 a_temp(2,2)=aggj(l,4)
3917 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3918 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3919 s1=scalar2(b1(1,iti2),auxvec(1))
3920 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3921 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3922 s2=scalar2(b1(1,iti1),auxvec(1))
3923 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3924 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3925 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3926 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3927 a_temp(1,1)=aggj1(l,1)
3928 a_temp(1,2)=aggj1(l,2)
3929 a_temp(2,1)=aggj1(l,3)
3930 a_temp(2,2)=aggj1(l,4)
3931 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3932 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3933 s1=scalar2(b1(1,iti2),auxvec(1))
3934 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3935 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3936 s2=scalar2(b1(1,iti1),auxvec(1))
3937 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3938 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3939 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3940 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3941 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3945 C-----------------------------------------------------------------------------
3946 subroutine vecpr(u,v,w)
3947 implicit real*8(a-h,o-z)
3948 dimension u(3),v(3),w(3)
3949 w(1)=u(2)*v(3)-u(3)*v(2)
3950 w(2)=-u(1)*v(3)+u(3)*v(1)
3951 w(3)=u(1)*v(2)-u(2)*v(1)
3954 C-----------------------------------------------------------------------------
3955 subroutine unormderiv(u,ugrad,unorm,ungrad)
3956 C This subroutine computes the derivatives of a normalized vector u, given
3957 C the derivatives computed without normalization conditions, ugrad. Returns
3960 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3961 double precision vec(3)
3962 double precision scalar
3964 c write (2,*) 'ugrad',ugrad
3967 vec(i)=scalar(ugrad(1,i),u(1))
3969 c write (2,*) 'vec',vec
3972 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3975 c write (2,*) 'ungrad',ungrad
3978 C-----------------------------------------------------------------------------
3979 subroutine escp_soft_sphere(evdw2,evdw2_14)
3981 C This subroutine calculates the excluded-volume interaction energy between
3982 C peptide-group centers and side chains and its gradient in virtual-bond and
3983 C side-chain vectors.
3985 implicit real*8 (a-h,o-z)
3986 include 'DIMENSIONS'
3987 include 'COMMON.GEO'
3988 include 'COMMON.VAR'
3989 include 'COMMON.LOCAL'
3990 include 'COMMON.CHAIN'
3991 include 'COMMON.DERIV'
3992 include 'COMMON.INTERACT'
3993 include 'COMMON.FFIELD'
3994 include 'COMMON.IOUNITS'
3995 include 'COMMON.CONTROL'
4000 cd print '(a)','Enter ESCP'
4001 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4002 do i=iatscp_s,iatscp_e
4004 xi=0.5D0*(c(1,i)+c(1,i+1))
4005 yi=0.5D0*(c(2,i)+c(2,i+1))
4006 zi=0.5D0*(c(3,i)+c(3,i+1))
4008 do iint=1,nscp_gr(i)
4010 do j=iscpstart(i,iint),iscpend(i,iint)
4012 C Uncomment following three lines for SC-p interactions
4016 C Uncomment following three lines for Ca-p interactions
4020 rij=xj*xj+yj*yj+zj*zj
4023 if (rij.lt.r0ijsq) then
4024 evdwij=0.25d0*(rij-r0ijsq)**2
4032 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4037 cgrad if (j.lt.i) then
4038 cd write (iout,*) 'j<i'
4039 C Uncomment following three lines for SC-p interactions
4041 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4044 cd write (iout,*) 'j>i'
4046 cgrad ggg(k)=-ggg(k)
4047 C Uncomment following line for SC-p interactions
4048 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4052 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4054 cgrad kstart=min0(i+1,j)
4055 cgrad kend=max0(i-1,j-1)
4056 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4057 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4058 cgrad do k=kstart,kend
4060 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4064 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4065 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4073 C-----------------------------------------------------------------------------
4074 subroutine escp(evdw2,evdw2_14)
4076 C This subroutine calculates the excluded-volume interaction energy between
4077 C peptide-group centers and side chains and its gradient in virtual-bond and
4078 C side-chain vectors.
4080 implicit real*8 (a-h,o-z)
4081 include 'DIMENSIONS'
4082 include 'COMMON.GEO'
4083 include 'COMMON.VAR'
4084 include 'COMMON.LOCAL'
4085 include 'COMMON.CHAIN'
4086 include 'COMMON.DERIV'
4087 include 'COMMON.INTERACT'
4088 include 'COMMON.FFIELD'
4089 include 'COMMON.IOUNITS'
4090 include 'COMMON.CONTROL'
4094 cd print '(a)','Enter ESCP'
4095 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4096 do i=iatscp_s,iatscp_e
4098 xi=0.5D0*(c(1,i)+c(1,i+1))
4099 yi=0.5D0*(c(2,i)+c(2,i+1))
4100 zi=0.5D0*(c(3,i)+c(3,i+1))
4102 do iint=1,nscp_gr(i)
4104 do j=iscpstart(i,iint),iscpend(i,iint)
4106 C Uncomment following three lines for SC-p interactions
4110 C Uncomment following three lines for Ca-p interactions
4114 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4116 e1=fac*fac*aad(itypj,iteli)
4117 e2=fac*bad(itypj,iteli)
4118 if (iabs(j-i) .le. 2) then
4121 evdw2_14=evdw2_14+e1+e2
4125 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4126 & 'evdw2',i,j,evdwij
4128 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4130 fac=-(evdwij+e1)*rrij
4134 cgrad if (j.lt.i) then
4135 cd write (iout,*) 'j<i'
4136 C Uncomment following three lines for SC-p interactions
4138 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4141 cd write (iout,*) 'j>i'
4143 cgrad ggg(k)=-ggg(k)
4144 C Uncomment following line for SC-p interactions
4145 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4146 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4150 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4152 cgrad kstart=min0(i+1,j)
4153 cgrad kend=max0(i-1,j-1)
4154 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4155 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4156 cgrad do k=kstart,kend
4158 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4162 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4163 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4171 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4172 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4173 gradx_scp(j,i)=expon*gradx_scp(j,i)
4176 C******************************************************************************
4180 C To save time the factor EXPON has been extracted from ALL components
4181 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4184 C******************************************************************************
4187 C--------------------------------------------------------------------------
4188 subroutine edis(ehpb)
4190 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4192 implicit real*8 (a-h,o-z)
4193 include 'DIMENSIONS'
4194 include 'COMMON.SBRIDGE'
4195 include 'COMMON.CHAIN'
4196 include 'COMMON.DERIV'
4197 include 'COMMON.VAR'
4198 include 'COMMON.INTERACT'
4199 include 'COMMON.IOUNITS'
4202 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4203 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4204 if (link_end.eq.0) return
4205 do i=link_start,link_end
4206 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4207 C CA-CA distance used in regularization of structure.
4210 C iii and jjj point to the residues for which the distance is assigned.
4211 if (ii.gt.nres) then
4218 cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj
4219 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4220 C distance and angle dependent SS bond potential.
4221 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4222 call ssbond_ene(iii,jjj,eij)
4224 cd write (iout,*) "eij",eij
4226 C Calculate the distance between the two points and its difference from the
4230 C Get the force constant corresponding to this distance.
4232 C Calculate the contribution to energy.
4233 ehpb=ehpb+waga*rdis*rdis
4235 C Evaluate gradient.
4238 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4239 cd & ' waga=',waga,' fac=',fac
4241 ggg(j)=fac*(c(j,jj)-c(j,ii))
4243 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4244 C If this is a SC-SC distance, we need to calculate the contributions to the
4245 C Cartesian gradient in the SC vectors (ghpbx).
4248 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4249 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4252 cgrad do j=iii,jjj-1
4254 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4258 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4259 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4266 C--------------------------------------------------------------------------
4267 subroutine ssbond_ene(i,j,eij)
4269 C Calculate the distance and angle dependent SS-bond potential energy
4270 C using a free-energy function derived based on RHF/6-31G** ab initio
4271 C calculations of diethyl disulfide.
4273 C A. Liwo and U. Kozlowska, 11/24/03
4275 implicit real*8 (a-h,o-z)
4276 include 'DIMENSIONS'
4277 include 'COMMON.SBRIDGE'
4278 include 'COMMON.CHAIN'
4279 include 'COMMON.DERIV'
4280 include 'COMMON.LOCAL'
4281 include 'COMMON.INTERACT'
4282 include 'COMMON.VAR'
4283 include 'COMMON.IOUNITS'
4284 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4289 dxi=dc_norm(1,nres+i)
4290 dyi=dc_norm(2,nres+i)
4291 dzi=dc_norm(3,nres+i)
4292 c dsci_inv=dsc_inv(itypi)
4293 dsci_inv=vbld_inv(nres+i)
4295 c dscj_inv=dsc_inv(itypj)
4296 dscj_inv=vbld_inv(nres+j)
4300 dxj=dc_norm(1,nres+j)
4301 dyj=dc_norm(2,nres+j)
4302 dzj=dc_norm(3,nres+j)
4303 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4308 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4309 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4310 om12=dxi*dxj+dyi*dyj+dzi*dzj
4312 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4313 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4319 deltat12=om2-om1+2.0d0
4321 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4322 & +akct*deltad*deltat12
4323 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4324 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4325 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4326 c & " deltat12",deltat12," eij",eij
4327 ed=2*akcm*deltad+akct*deltat12
4329 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4330 eom1=-2*akth*deltat1-pom1-om2*pom2
4331 eom2= 2*akth*deltat2+pom1-om1*pom2
4334 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4335 ghpbx(k,i)=ghpbx(k,i)-ggk
4336 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4337 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4338 ghpbx(k,j)=ghpbx(k,j)+ggk
4339 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4340 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4341 ghpbc(k,i)=ghpbc(k,i)-ggk
4342 ghpbc(k,j)=ghpbc(k,j)+ggk
4345 C Calculate the components of the gradient in DC and X
4349 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4354 C--------------------------------------------------------------------------
4355 subroutine ebond(estr)
4357 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4359 implicit real*8 (a-h,o-z)
4360 include 'DIMENSIONS'
4361 include 'COMMON.LOCAL'
4362 include 'COMMON.GEO'
4363 include 'COMMON.INTERACT'
4364 include 'COMMON.DERIV'
4365 include 'COMMON.VAR'
4366 include 'COMMON.CHAIN'
4367 include 'COMMON.IOUNITS'
4368 include 'COMMON.NAMES'
4369 include 'COMMON.FFIELD'
4370 include 'COMMON.CONTROL'
4371 include 'COMMON.SETUP'
4372 double precision u(3),ud(3)
4374 do i=ibondp_start,ibondp_end
4375 diff = vbld(i)-vbldp0
4376 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4379 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4381 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4385 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4387 do i=ibond_start,ibond_end
4392 diff=vbld(i+nres)-vbldsc0(1,iti)
4393 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4394 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4395 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4397 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4401 diff=vbld(i+nres)-vbldsc0(j,iti)
4402 ud(j)=aksc(j,iti)*diff
4403 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4417 uprod2=uprod2*u(k)*u(k)
4421 usumsqder=usumsqder+ud(j)*uprod2
4423 estr=estr+uprod/usum
4425 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4433 C--------------------------------------------------------------------------
4434 subroutine ebend(etheta)
4436 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4437 C angles gamma and its derivatives in consecutive thetas and gammas.
4439 implicit real*8 (a-h,o-z)
4440 include 'DIMENSIONS'
4441 include 'COMMON.LOCAL'
4442 include 'COMMON.GEO'
4443 include 'COMMON.INTERACT'
4444 include 'COMMON.DERIV'
4445 include 'COMMON.VAR'
4446 include 'COMMON.CHAIN'
4447 include 'COMMON.IOUNITS'
4448 include 'COMMON.NAMES'
4449 include 'COMMON.FFIELD'
4450 include 'COMMON.CONTROL'
4451 common /calcthet/ term1,term2,termm,diffak,ratak,
4452 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4453 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4454 double precision y(2),z(2)
4456 c time11=dexp(-2*time)
4459 c write (*,'(a,i2)') 'EBEND ICG=',icg
4460 do i=ithet_start,ithet_end
4461 C Zero the energy function and its derivative at 0 or pi.
4462 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4467 if (phii.ne.phii) phii=150.0
4480 if (phii1.ne.phii1) phii1=150.0
4492 C Calculate the "mean" value of theta from the part of the distribution
4493 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4494 C In following comments this theta will be referred to as t_c.
4495 thet_pred_mean=0.0d0
4499 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4501 dthett=thet_pred_mean*ssd
4502 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4503 C Derivatives of the "mean" values in gamma1 and gamma2.
4504 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4505 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4506 if (theta(i).gt.pi-delta) then
4507 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4509 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4510 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4511 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4513 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4515 else if (theta(i).lt.delta) then
4516 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4517 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4518 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4520 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4521 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4524 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4527 etheta=etheta+ethetai
4528 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4530 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4531 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4532 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4534 C Ufff.... We've done all this!!!
4537 C---------------------------------------------------------------------------
4538 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4540 implicit real*8 (a-h,o-z)
4541 include 'DIMENSIONS'
4542 include 'COMMON.LOCAL'
4543 include 'COMMON.IOUNITS'
4544 common /calcthet/ term1,term2,termm,diffak,ratak,
4545 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4546 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4547 C Calculate the contributions to both Gaussian lobes.
4548 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4549 C The "polynomial part" of the "standard deviation" of this part of
4553 sig=sig*thet_pred_mean+polthet(j,it)
4555 C Derivative of the "interior part" of the "standard deviation of the"
4556 C gamma-dependent Gaussian lobe in t_c.
4557 sigtc=3*polthet(3,it)
4559 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4562 C Set the parameters of both Gaussian lobes of the distribution.
4563 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4564 fac=sig*sig+sigc0(it)
4567 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4568 sigsqtc=-4.0D0*sigcsq*sigtc
4569 c print *,i,sig,sigtc,sigsqtc
4570 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4571 sigtc=-sigtc/(fac*fac)
4572 C Following variable is sigma(t_c)**(-2)
4573 sigcsq=sigcsq*sigcsq
4575 sig0inv=1.0D0/sig0i**2
4576 delthec=thetai-thet_pred_mean
4577 delthe0=thetai-theta0i
4578 term1=-0.5D0*sigcsq*delthec*delthec
4579 term2=-0.5D0*sig0inv*delthe0*delthe0
4580 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4581 C NaNs in taking the logarithm. We extract the largest exponent which is added
4582 C to the energy (this being the log of the distribution) at the end of energy
4583 C term evaluation for this virtual-bond angle.
4584 if (term1.gt.term2) then
4586 term2=dexp(term2-termm)
4590 term1=dexp(term1-termm)
4593 C The ratio between the gamma-independent and gamma-dependent lobes of
4594 C the distribution is a Gaussian function of thet_pred_mean too.
4595 diffak=gthet(2,it)-thet_pred_mean
4596 ratak=diffak/gthet(3,it)**2
4597 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4598 C Let's differentiate it in thet_pred_mean NOW.
4600 C Now put together the distribution terms to make complete distribution.
4601 termexp=term1+ak*term2
4602 termpre=sigc+ak*sig0i
4603 C Contribution of the bending energy from this theta is just the -log of
4604 C the sum of the contributions from the two lobes and the pre-exponential
4605 C factor. Simple enough, isn't it?
4606 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4607 C NOW the derivatives!!!
4608 C 6/6/97 Take into account the deformation.
4609 E_theta=(delthec*sigcsq*term1
4610 & +ak*delthe0*sig0inv*term2)/termexp
4611 E_tc=((sigtc+aktc*sig0i)/termpre
4612 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4613 & aktc*term2)/termexp)
4616 c-----------------------------------------------------------------------------
4617 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4618 implicit real*8 (a-h,o-z)
4619 include 'DIMENSIONS'
4620 include 'COMMON.LOCAL'
4621 include 'COMMON.IOUNITS'
4622 common /calcthet/ term1,term2,termm,diffak,ratak,
4623 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4624 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4625 delthec=thetai-thet_pred_mean
4626 delthe0=thetai-theta0i
4627 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4628 t3 = thetai-thet_pred_mean
4632 t14 = t12+t6*sigsqtc
4634 t21 = thetai-theta0i
4640 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4641 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4642 & *(-t12*t9-ak*sig0inv*t27)
4646 C--------------------------------------------------------------------------
4647 subroutine ebend(etheta)
4649 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4650 C angles gamma and its derivatives in consecutive thetas and gammas.
4651 C ab initio-derived potentials from
4652 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4654 implicit real*8 (a-h,o-z)
4655 include 'DIMENSIONS'
4656 include 'COMMON.LOCAL'
4657 include 'COMMON.GEO'
4658 include 'COMMON.INTERACT'
4659 include 'COMMON.DERIV'
4660 include 'COMMON.VAR'
4661 include 'COMMON.CHAIN'
4662 include 'COMMON.IOUNITS'
4663 include 'COMMON.NAMES'
4664 include 'COMMON.FFIELD'
4665 include 'COMMON.CONTROL'
4666 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4667 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4668 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4669 & sinph1ph2(maxdouble,maxdouble)
4670 logical lprn /.false./, lprn1 /.false./
4672 do i=ithet_start,ithet_end
4676 theti2=0.5d0*theta(i)
4677 ityp2=ithetyp(itype(i-1))
4679 coskt(k)=dcos(k*theti2)
4680 sinkt(k)=dsin(k*theti2)
4685 if (phii.ne.phii) phii=150.0
4689 ityp1=ithetyp(itype(i-2))
4691 cosph1(k)=dcos(k*phii)
4692 sinph1(k)=dsin(k*phii)
4705 if (phii1.ne.phii1) phii1=150.0
4710 ityp3=ithetyp(itype(i))
4712 cosph2(k)=dcos(k*phii1)
4713 sinph2(k)=dsin(k*phii1)
4723 ethetai=aa0thet(ityp1,ityp2,ityp3)
4726 ccl=cosph1(l)*cosph2(k-l)
4727 ssl=sinph1(l)*sinph2(k-l)
4728 scl=sinph1(l)*cosph2(k-l)
4729 csl=cosph1(l)*sinph2(k-l)
4730 cosph1ph2(l,k)=ccl-ssl
4731 cosph1ph2(k,l)=ccl+ssl
4732 sinph1ph2(l,k)=scl+csl
4733 sinph1ph2(k,l)=scl-csl
4737 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4738 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4739 write (iout,*) "coskt and sinkt"
4741 write (iout,*) k,coskt(k),sinkt(k)
4745 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4746 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4749 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4750 & " ethetai",ethetai
4753 write (iout,*) "cosph and sinph"
4755 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4757 write (iout,*) "cosph1ph2 and sinph2ph2"
4760 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4761 & sinph1ph2(l,k),sinph1ph2(k,l)
4764 write(iout,*) "ethetai",ethetai
4768 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4769 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4770 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4771 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4772 ethetai=ethetai+sinkt(m)*aux
4773 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4774 dephii=dephii+k*sinkt(m)*(
4775 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4776 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4777 dephii1=dephii1+k*sinkt(m)*(
4778 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4779 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4781 & write (iout,*) "m",m," k",k," bbthet",
4782 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4783 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4784 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4785 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4789 & write(iout,*) "ethetai",ethetai
4793 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4794 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4795 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4796 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4797 ethetai=ethetai+sinkt(m)*aux
4798 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4799 dephii=dephii+l*sinkt(m)*(
4800 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4801 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4802 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4803 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4804 dephii1=dephii1+(k-l)*sinkt(m)*(
4805 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4806 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4807 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4808 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4810 write (iout,*) "m",m," k",k," l",l," ffthet",
4811 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4812 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4813 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4814 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4815 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4816 & cosph1ph2(k,l)*sinkt(m),
4817 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4823 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4824 & i,theta(i)*rad2deg,phii*rad2deg,
4825 & phii1*rad2deg,ethetai
4826 etheta=etheta+ethetai
4827 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4828 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4829 gloc(nphi+i-2,icg)=wang*dethetai
4835 c-----------------------------------------------------------------------------
4836 subroutine esc(escloc)
4837 C Calculate the local energy of a side chain and its derivatives in the
4838 C corresponding virtual-bond valence angles THETA and the spherical angles
4840 implicit real*8 (a-h,o-z)
4841 include 'DIMENSIONS'
4842 include 'COMMON.GEO'
4843 include 'COMMON.LOCAL'
4844 include 'COMMON.VAR'
4845 include 'COMMON.INTERACT'
4846 include 'COMMON.DERIV'
4847 include 'COMMON.CHAIN'
4848 include 'COMMON.IOUNITS'
4849 include 'COMMON.NAMES'
4850 include 'COMMON.FFIELD'
4851 include 'COMMON.CONTROL'
4852 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4853 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4854 common /sccalc/ time11,time12,time112,theti,it,nlobit
4857 c write (iout,'(a)') 'ESC'
4858 do i=loc_start,loc_end
4860 if (it.eq.10) goto 1
4862 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4863 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4864 theti=theta(i+1)-pipol
4869 if (x(2).gt.pi-delta) then
4873 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4875 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4876 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4878 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4879 & ddersc0(1),dersc(1))
4880 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4881 & ddersc0(3),dersc(3))
4883 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4885 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4886 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4887 & dersc0(2),esclocbi,dersc02)
4888 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4890 call splinthet(x(2),0.5d0*delta,ss,ssd)
4895 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4897 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4898 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4900 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4902 c write (iout,*) escloci
4903 else if (x(2).lt.delta) then
4907 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4909 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4910 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4912 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4913 & ddersc0(1),dersc(1))
4914 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4915 & ddersc0(3),dersc(3))
4917 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4919 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4920 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4921 & dersc0(2),esclocbi,dersc02)
4922 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4927 call splinthet(x(2),0.5d0*delta,ss,ssd)
4929 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4931 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4932 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4934 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4935 c write (iout,*) escloci
4937 call enesc(x,escloci,dersc,ddummy,.false.)
4940 escloc=escloc+escloci
4941 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4942 & 'escloc',i,escloci
4943 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4945 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4947 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4948 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4953 C---------------------------------------------------------------------------
4954 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4955 implicit real*8 (a-h,o-z)
4956 include 'DIMENSIONS'
4957 include 'COMMON.GEO'
4958 include 'COMMON.LOCAL'
4959 include 'COMMON.IOUNITS'
4960 common /sccalc/ time11,time12,time112,theti,it,nlobit
4961 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4962 double precision contr(maxlob,-1:1)
4964 c write (iout,*) 'it=',it,' nlobit=',nlobit
4968 if (mixed) ddersc(j)=0.0d0
4972 C Because of periodicity of the dependence of the SC energy in omega we have
4973 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4974 C To avoid underflows, first compute & store the exponents.
4982 z(k)=x(k)-censc(k,j,it)
4987 Axk=Axk+gaussc(l,k,j,it)*z(l)
4993 expfac=expfac+Ax(k,j,iii)*z(k)
5001 C As in the case of ebend, we want to avoid underflows in exponentiation and
5002 C subsequent NaNs and INFs in energy calculation.
5003 C Find the largest exponent
5007 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5011 cd print *,'it=',it,' emin=',emin
5013 C Compute the contribution to SC energy and derivatives
5018 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
5019 if(adexp.ne.adexp) adexp=1.0
5022 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
5024 cd print *,'j=',j,' expfac=',expfac
5025 escloc_i=escloc_i+expfac
5027 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5031 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5032 & +gaussc(k,2,j,it))*expfac
5039 dersc(1)=dersc(1)/cos(theti)**2
5040 ddersc(1)=ddersc(1)/cos(theti)**2
5043 escloci=-(dlog(escloc_i)-emin)
5045 dersc(j)=dersc(j)/escloc_i
5049 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5054 C------------------------------------------------------------------------------
5055 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5056 implicit real*8 (a-h,o-z)
5057 include 'DIMENSIONS'
5058 include 'COMMON.GEO'
5059 include 'COMMON.LOCAL'
5060 include 'COMMON.IOUNITS'
5061 common /sccalc/ time11,time12,time112,theti,it,nlobit
5062 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5063 double precision contr(maxlob)
5074 z(k)=x(k)-censc(k,j,it)
5080 Axk=Axk+gaussc(l,k,j,it)*z(l)
5086 expfac=expfac+Ax(k,j)*z(k)
5091 C As in the case of ebend, we want to avoid underflows in exponentiation and
5092 C subsequent NaNs and INFs in energy calculation.
5093 C Find the largest exponent
5096 if (emin.gt.contr(j)) emin=contr(j)
5100 C Compute the contribution to SC energy and derivatives
5104 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
5105 escloc_i=escloc_i+expfac
5107 dersc(k)=dersc(k)+Ax(k,j)*expfac
5109 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5110 & +gaussc(1,2,j,it))*expfac
5114 dersc(1)=dersc(1)/cos(theti)**2
5115 dersc12=dersc12/cos(theti)**2
5116 escloci=-(dlog(escloc_i)-emin)
5118 dersc(j)=dersc(j)/escloc_i
5120 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5124 c----------------------------------------------------------------------------------
5125 subroutine esc(escloc)
5126 C Calculate the local energy of a side chain and its derivatives in the
5127 C corresponding virtual-bond valence angles THETA and the spherical angles
5128 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5129 C added by Urszula Kozlowska. 07/11/2007
5131 implicit real*8 (a-h,o-z)
5132 include 'DIMENSIONS'
5133 include 'COMMON.GEO'
5134 include 'COMMON.LOCAL'
5135 include 'COMMON.VAR'
5136 include 'COMMON.SCROT'
5137 include 'COMMON.INTERACT'
5138 include 'COMMON.DERIV'
5139 include 'COMMON.CHAIN'
5140 include 'COMMON.IOUNITS'
5141 include 'COMMON.NAMES'
5142 include 'COMMON.FFIELD'
5143 include 'COMMON.CONTROL'
5144 include 'COMMON.VECTORS'
5145 double precision x_prime(3),y_prime(3),z_prime(3)
5146 & , sumene,dsc_i,dp2_i,x(65),
5147 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5148 & de_dxx,de_dyy,de_dzz,de_dt
5149 double precision s1_t,s1_6_t,s2_t,s2_6_t
5151 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5152 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5153 & dt_dCi(3),dt_dCi1(3)
5154 common /sccalc/ time11,time12,time112,theti,it,nlobit
5157 do i=loc_start,loc_end
5158 costtab(i+1) =dcos(theta(i+1))
5159 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5160 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5161 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5162 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5163 cosfac=dsqrt(cosfac2)
5164 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5165 sinfac=dsqrt(sinfac2)
5167 if (it.eq.10) goto 1
5169 C Compute the axes of tghe local cartesian coordinates system; store in
5170 c x_prime, y_prime and z_prime
5177 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5178 C & dc_norm(3,i+nres)
5180 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5181 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5184 z_prime(j) = -uz(j,i-1)
5187 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5188 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5189 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5190 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5191 c & " xy",scalar(x_prime(1),y_prime(1)),
5192 c & " xz",scalar(x_prime(1),z_prime(1)),
5193 c & " yy",scalar(y_prime(1),y_prime(1)),
5194 c & " yz",scalar(y_prime(1),z_prime(1)),
5195 c & " zz",scalar(z_prime(1),z_prime(1))
5197 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5198 C to local coordinate system. Store in xx, yy, zz.
5204 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5205 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5206 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5213 C Compute the energy of the ith side cbain
5215 c write (2,*) "xx",xx," yy",yy," zz",zz
5218 x(j) = sc_parmin(j,it)
5221 Cc diagnostics - remove later
5223 yy1 = dsin(alph(2))*dcos(omeg(2))
5224 zz1 = -dsin(alph(2))*dsin(omeg(2))
5225 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5226 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5228 C," --- ", xx_w,yy_w,zz_w
5231 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5232 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5234 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5235 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5237 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5238 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5239 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5240 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5241 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5243 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5244 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5245 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5246 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5247 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5249 dsc_i = 0.743d0+x(61)
5251 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5252 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5253 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5254 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5255 s1=(1+x(63))/(0.1d0 + dscp1)
5256 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5257 s2=(1+x(65))/(0.1d0 + dscp2)
5258 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5259 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5260 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5261 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5263 c & dscp1,dscp2,sumene
5264 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5265 escloc = escloc + sumene
5266 c write (2,*) "i",i," escloc",sumene,escloc
5269 C This section to check the numerical derivatives of the energy of ith side
5270 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5271 C #define DEBUG in the code to turn it on.
5273 write (2,*) "sumene =",sumene
5277 write (2,*) xx,yy,zz
5278 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5279 de_dxx_num=(sumenep-sumene)/aincr
5281 write (2,*) "xx+ sumene from enesc=",sumenep
5284 write (2,*) xx,yy,zz
5285 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5286 de_dyy_num=(sumenep-sumene)/aincr
5288 write (2,*) "yy+ sumene from enesc=",sumenep
5291 write (2,*) xx,yy,zz
5292 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5293 de_dzz_num=(sumenep-sumene)/aincr
5295 write (2,*) "zz+ sumene from enesc=",sumenep
5296 costsave=cost2tab(i+1)
5297 sintsave=sint2tab(i+1)
5298 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5299 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5300 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5301 de_dt_num=(sumenep-sumene)/aincr
5302 write (2,*) " t+ sumene from enesc=",sumenep
5303 cost2tab(i+1)=costsave
5304 sint2tab(i+1)=sintsave
5305 C End of diagnostics section.
5308 C Compute the gradient of esc
5310 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5311 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5312 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5313 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5314 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5315 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5316 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5317 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5318 pom1=(sumene3*sint2tab(i+1)+sumene1)
5319 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5320 pom2=(sumene4*cost2tab(i+1)+sumene2)
5321 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5322 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5323 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5324 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5326 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5327 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5328 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5330 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5331 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5332 & +(pom1+pom2)*pom_dx
5334 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5337 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5338 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5339 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5341 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5342 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5343 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5344 & +x(59)*zz**2 +x(60)*xx*zz
5345 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5346 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5347 & +(pom1-pom2)*pom_dy
5349 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5352 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5353 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5354 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5355 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5356 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5357 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5358 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5359 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5361 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5364 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5365 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5366 & +pom1*pom_dt1+pom2*pom_dt2
5368 write(2,*), "de_dt = ", de_dt,de_dt_num
5372 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5373 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5374 cosfac2xx=cosfac2*xx
5375 sinfac2yy=sinfac2*yy
5377 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5379 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5381 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5382 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5383 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5384 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5385 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5386 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5387 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5388 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5389 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5390 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5394 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5395 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5398 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5399 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5400 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5402 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5403 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5407 dXX_Ctab(k,i)=dXX_Ci(k)
5408 dXX_C1tab(k,i)=dXX_Ci1(k)
5409 dYY_Ctab(k,i)=dYY_Ci(k)
5410 dYY_C1tab(k,i)=dYY_Ci1(k)
5411 dZZ_Ctab(k,i)=dZZ_Ci(k)
5412 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5413 dXX_XYZtab(k,i)=dXX_XYZ(k)
5414 dYY_XYZtab(k,i)=dYY_XYZ(k)
5415 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5419 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5420 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5421 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5422 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5423 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5425 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5426 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5427 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5428 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5429 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5430 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5431 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5432 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5434 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5435 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5437 C to check gradient call subroutine check_grad
5443 c------------------------------------------------------------------------------
5444 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5446 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5447 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5448 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5449 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5451 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5452 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5454 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5455 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5456 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5457 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5458 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5460 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5461 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5462 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5463 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5464 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5466 dsc_i = 0.743d0+x(61)
5468 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5469 & *(xx*cost2+yy*sint2))
5470 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5471 & *(xx*cost2-yy*sint2))
5472 s1=(1+x(63))/(0.1d0 + dscp1)
5473 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5474 s2=(1+x(65))/(0.1d0 + dscp2)
5475 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5476 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5477 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5482 c------------------------------------------------------------------------------
5483 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5485 C This procedure calculates two-body contact function g(rij) and its derivative:
5488 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5491 C where x=(rij-r0ij)/delta
5493 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5496 double precision rij,r0ij,eps0ij,fcont,fprimcont
5497 double precision x,x2,x4,delta
5501 if (x.lt.-1.0D0) then
5504 else if (x.le.1.0D0) then
5507 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5508 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5515 c------------------------------------------------------------------------------
5516 subroutine splinthet(theti,delta,ss,ssder)
5517 implicit real*8 (a-h,o-z)
5518 include 'DIMENSIONS'
5519 include 'COMMON.VAR'
5520 include 'COMMON.GEO'
5523 if (theti.gt.pipol) then
5524 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5526 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5531 c------------------------------------------------------------------------------
5532 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5534 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5535 double precision ksi,ksi2,ksi3,a1,a2,a3
5536 a1=fprim0*delta/(f1-f0)
5542 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5543 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5546 c------------------------------------------------------------------------------
5547 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5549 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5550 double precision ksi,ksi2,ksi3,a1,a2,a3
5555 a2=3*(f1x-f0x)-2*fprim0x*delta
5556 a3=fprim0x*delta-2*(f1x-f0x)
5557 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5560 C-----------------------------------------------------------------------------
5562 C-----------------------------------------------------------------------------
5563 subroutine etor(etors,edihcnstr)
5564 implicit real*8 (a-h,o-z)
5565 include 'DIMENSIONS'
5566 include 'COMMON.VAR'
5567 include 'COMMON.GEO'
5568 include 'COMMON.LOCAL'
5569 include 'COMMON.TORSION'
5570 include 'COMMON.INTERACT'
5571 include 'COMMON.DERIV'
5572 include 'COMMON.CHAIN'
5573 include 'COMMON.NAMES'
5574 include 'COMMON.IOUNITS'
5575 include 'COMMON.FFIELD'
5576 include 'COMMON.TORCNSTR'
5577 include 'COMMON.CONTROL'
5579 C Set lprn=.true. for debugging
5583 do i=iphi_start,iphi_end
5585 itori=itortyp(itype(i-2))
5586 itori1=itortyp(itype(i-1))
5589 C Proline-Proline pair is a special case...
5590 if (itori.eq.3 .and. itori1.eq.3) then
5591 if (phii.gt.-dwapi3) then
5593 fac=1.0D0/(1.0D0-cosphi)
5594 etorsi=v1(1,3,3)*fac
5595 etorsi=etorsi+etorsi
5596 etors=etors+etorsi-v1(1,3,3)
5597 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5598 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5601 v1ij=v1(j+1,itori,itori1)
5602 v2ij=v2(j+1,itori,itori1)
5605 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5606 if (energy_dec) etors_ii=etors_ii+
5607 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5608 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5612 v1ij=v1(j,itori,itori1)
5613 v2ij=v2(j,itori,itori1)
5616 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5617 if (energy_dec) etors_ii=etors_ii+
5618 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5619 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5622 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5625 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5626 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5627 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5628 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5629 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5631 ! 6/20/98 - dihedral angle constraints
5634 itori=idih_constr(i)
5637 if (difi.gt.drange(i)) then
5639 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5640 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5641 else if (difi.lt.-drange(i)) then
5643 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5644 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5646 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5647 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5649 ! write (iout,*) 'edihcnstr',edihcnstr
5652 c------------------------------------------------------------------------------
5653 subroutine etor_d(etors_d)
5657 c----------------------------------------------------------------------------
5659 subroutine etor(etors,edihcnstr)
5660 implicit real*8 (a-h,o-z)
5661 include 'DIMENSIONS'
5662 include 'COMMON.VAR'
5663 include 'COMMON.GEO'
5664 include 'COMMON.LOCAL'
5665 include 'COMMON.TORSION'
5666 include 'COMMON.INTERACT'
5667 include 'COMMON.DERIV'
5668 include 'COMMON.CHAIN'
5669 include 'COMMON.NAMES'
5670 include 'COMMON.IOUNITS'
5671 include 'COMMON.FFIELD'
5672 include 'COMMON.TORCNSTR'
5673 include 'COMMON.CONTROL'
5675 C Set lprn=.true. for debugging
5679 do i=iphi_start,iphi_end
5681 itori=itortyp(itype(i-2))
5682 itori1=itortyp(itype(i-1))
5685 C Regular cosine and sine terms
5686 do j=1,nterm(itori,itori1)
5687 v1ij=v1(j,itori,itori1)
5688 v2ij=v2(j,itori,itori1)
5691 etors=etors+v1ij*cosphi+v2ij*sinphi
5692 if (energy_dec) etors_ii=etors_ii+
5693 & v1ij*cosphi+v2ij*sinphi
5694 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5698 C E = SUM ----------------------------------- - v1
5699 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5701 cosphi=dcos(0.5d0*phii)
5702 sinphi=dsin(0.5d0*phii)
5703 do j=1,nlor(itori,itori1)
5704 vl1ij=vlor1(j,itori,itori1)
5705 vl2ij=vlor2(j,itori,itori1)
5706 vl3ij=vlor3(j,itori,itori1)
5707 pom=vl2ij*cosphi+vl3ij*sinphi
5708 pom1=1.0d0/(pom*pom+1.0d0)
5709 etors=etors+vl1ij*pom1
5710 if (energy_dec) etors_ii=etors_ii+
5713 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5715 C Subtract the constant term
5716 etors=etors-v0(itori,itori1)
5717 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5718 & 'etor',i,etors_ii-v0(itori,itori1)
5720 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5721 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5722 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5723 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5724 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5726 ! 6/20/98 - dihedral angle constraints
5728 c do i=1,ndih_constr
5729 do i=idihconstr_start,idihconstr_end
5730 itori=idih_constr(i)
5732 difi=pinorm(phii-phi0(i))
5733 if (difi.gt.drange(i)) then
5735 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5736 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5737 else if (difi.lt.-drange(i)) then
5739 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5740 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5744 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5745 cd & rad2deg*phi0(i), rad2deg*drange(i),
5746 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5748 cd write (iout,*) 'edihcnstr',edihcnstr
5751 c----------------------------------------------------------------------------
5752 subroutine etor_d(etors_d)
5753 C 6/23/01 Compute double torsional energy
5754 implicit real*8 (a-h,o-z)
5755 include 'DIMENSIONS'
5756 include 'COMMON.VAR'
5757 include 'COMMON.GEO'
5758 include 'COMMON.LOCAL'
5759 include 'COMMON.TORSION'
5760 include 'COMMON.INTERACT'
5761 include 'COMMON.DERIV'
5762 include 'COMMON.CHAIN'
5763 include 'COMMON.NAMES'
5764 include 'COMMON.IOUNITS'
5765 include 'COMMON.FFIELD'
5766 include 'COMMON.TORCNSTR'
5768 C Set lprn=.true. for debugging
5772 do i=iphid_start,iphid_end
5773 itori=itortyp(itype(i-2))
5774 itori1=itortyp(itype(i-1))
5775 itori2=itortyp(itype(i))
5780 C Regular cosine and sine terms
5781 do j=1,ntermd_1(itori,itori1,itori2)
5782 v1cij=v1c(1,j,itori,itori1,itori2)
5783 v1sij=v1s(1,j,itori,itori1,itori2)
5784 v2cij=v1c(2,j,itori,itori1,itori2)
5785 v2sij=v1s(2,j,itori,itori1,itori2)
5786 cosphi1=dcos(j*phii)
5787 sinphi1=dsin(j*phii)
5788 cosphi2=dcos(j*phii1)
5789 sinphi2=dsin(j*phii1)
5790 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5791 & v2cij*cosphi2+v2sij*sinphi2
5792 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5793 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5795 do k=2,ntermd_2(itori,itori1,itori2)
5797 v1cdij = v2c(k,l,itori,itori1,itori2)
5798 v2cdij = v2c(l,k,itori,itori1,itori2)
5799 v1sdij = v2s(k,l,itori,itori1,itori2)
5800 v2sdij = v2s(l,k,itori,itori1,itori2)
5801 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5802 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5803 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5804 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5805 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5806 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5807 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5808 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5809 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5810 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5813 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5814 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5819 c------------------------------------------------------------------------------
5820 subroutine eback_sc_corr(esccor)
5821 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5822 c conformational states; temporarily implemented as differences
5823 c between UNRES torsional potentials (dependent on three types of
5824 c residues) and the torsional potentials dependent on all 20 types
5825 c of residues computed from AM1 energy surfaces of terminally-blocked
5826 c amino-acid residues.
5827 implicit real*8 (a-h,o-z)
5828 include 'DIMENSIONS'
5829 include 'COMMON.VAR'
5830 include 'COMMON.GEO'
5831 include 'COMMON.LOCAL'
5832 include 'COMMON.TORSION'
5833 include 'COMMON.SCCOR'
5834 include 'COMMON.INTERACT'
5835 include 'COMMON.DERIV'
5836 include 'COMMON.CHAIN'
5837 include 'COMMON.NAMES'
5838 include 'COMMON.IOUNITS'
5839 include 'COMMON.FFIELD'
5840 include 'COMMON.CONTROL'
5842 C Set lprn=.true. for debugging
5845 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5847 do i=iphi_start,iphi_end
5854 v1ij=v1sccor(j,itori,itori1)
5855 v2ij=v2sccor(j,itori,itori1)
5858 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5859 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5862 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5863 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5864 & (v1sccor(j,itori,itori1),j=1,6),(v2sccor(j,itori,itori1),j=1,6)
5865 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5869 c----------------------------------------------------------------------------
5870 subroutine multibody(ecorr)
5871 C This subroutine calculates multi-body contributions to energy following
5872 C the idea of Skolnick et al. If side chains I and J make a contact and
5873 C at the same time side chains I+1 and J+1 make a contact, an extra
5874 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5875 implicit real*8 (a-h,o-z)
5876 include 'DIMENSIONS'
5877 include 'COMMON.IOUNITS'
5878 include 'COMMON.DERIV'
5879 include 'COMMON.INTERACT'
5880 include 'COMMON.CONTACTS'
5881 double precision gx(3),gx1(3)
5884 C Set lprn=.true. for debugging
5888 write (iout,'(a)') 'Contact function values:'
5890 write (iout,'(i2,20(1x,i2,f10.5))')
5891 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5906 num_conti=num_cont(i)
5907 num_conti1=num_cont(i1)
5912 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5913 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5914 cd & ' ishift=',ishift
5915 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5916 C The system gains extra energy.
5917 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5918 endif ! j1==j+-ishift
5927 c------------------------------------------------------------------------------
5928 double precision function esccorr(i,j,k,l,jj,kk)
5929 implicit real*8 (a-h,o-z)
5930 include 'DIMENSIONS'
5931 include 'COMMON.IOUNITS'
5932 include 'COMMON.DERIV'
5933 include 'COMMON.INTERACT'
5934 include 'COMMON.CONTACTS'
5935 double precision gx(3),gx1(3)
5940 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5941 C Calculate the multi-body contribution to energy.
5942 C Calculate multi-body contributions to the gradient.
5943 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5944 cd & k,l,(gacont(m,kk,k),m=1,3)
5946 gx(m) =ekl*gacont(m,jj,i)
5947 gx1(m)=eij*gacont(m,kk,k)
5948 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5949 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5950 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5951 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5955 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5960 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5966 c------------------------------------------------------------------------------
5967 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
5968 C This subroutine calculates multi-body contributions to hydrogen-bonding
5969 implicit real*8 (a-h,o-z)
5970 include 'DIMENSIONS'
5971 include 'COMMON.IOUNITS'
5974 parameter (max_cont=maxconts)
5975 parameter (max_dim=26)
5976 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
5977 double precision zapas(max_dim,maxconts,max_fg_procs),
5978 & zapas_recv(max_dim,maxconts,max_fg_procs)
5979 common /przechowalnia/ zapas
5980 integer status(MPI_STATUS_SIZE),req(maxconts*2),
5981 & status_array(MPI_STATUS_SIZE,maxconts*2)
5983 include 'COMMON.SETUP'
5984 include 'COMMON.FFIELD'
5985 include 'COMMON.DERIV'
5986 include 'COMMON.INTERACT'
5987 include 'COMMON.CONTACTS'
5988 include 'COMMON.CONTROL'
5989 include 'COMMON.LOCAL'
5990 double precision gx(3),gx1(3),time00
5993 C Set lprn=.true. for debugging
5998 if (nfgtasks.le.1) goto 30
6000 write (iout,'(a)') 'Contact function values before RECEIVE:'
6002 write (iout,'(2i3,50(1x,i2,f5.2))')
6003 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6004 & j=1,num_cont_hb(i))
6008 do i=1,ntask_cont_from
6011 do i=1,ntask_cont_to
6014 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6016 C Make the list of contacts to send to send to other procesors
6017 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6019 do i=iturn3_start,iturn3_end
6020 c write (iout,*) "make contact list turn3",i," num_cont",
6022 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6024 do i=iturn4_start,iturn4_end
6025 c write (iout,*) "make contact list turn4",i," num_cont",
6027 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6031 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6033 do j=1,num_cont_hb(i)
6036 iproc=iint_sent_local(k,jjc,ii)
6037 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6038 if (iproc.gt.0) then
6039 ncont_sent(iproc)=ncont_sent(iproc)+1
6040 nn=ncont_sent(iproc)
6042 zapas(2,nn,iproc)=jjc
6043 zapas(3,nn,iproc)=facont_hb(j,i)
6044 zapas(4,nn,iproc)=ees0p(j,i)
6045 zapas(5,nn,iproc)=ees0m(j,i)
6046 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6047 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6048 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6049 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6050 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6051 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6052 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6053 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6054 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6055 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6056 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6057 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6058 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6059 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6060 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6061 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6062 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6063 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6064 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6065 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6066 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6073 & "Numbers of contacts to be sent to other processors",
6074 & (ncont_sent(i),i=1,ntask_cont_to)
6075 write (iout,*) "Contacts sent"
6076 do ii=1,ntask_cont_to
6078 iproc=itask_cont_to(ii)
6079 write (iout,*) nn," contacts to processor",iproc,
6080 & " of CONT_TO_COMM group"
6082 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6090 CorrelID1=nfgtasks+fg_rank+1
6092 C Receive the numbers of needed contacts from other processors
6093 do ii=1,ntask_cont_from
6094 iproc=itask_cont_from(ii)
6096 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6097 & FG_COMM,req(ireq),IERR)
6099 c write (iout,*) "IRECV ended"
6101 C Send the number of contacts needed by other processors
6102 do ii=1,ntask_cont_to
6103 iproc=itask_cont_to(ii)
6105 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6106 & FG_COMM,req(ireq),IERR)
6108 c write (iout,*) "ISEND ended"
6109 c write (iout,*) "number of requests (nn)",ireq
6112 & call MPI_Waitall(ireq,req,status_array,ierr)
6114 c & "Numbers of contacts to be received from other processors",
6115 c & (ncont_recv(i),i=1,ntask_cont_from)
6119 do ii=1,ntask_cont_from
6120 iproc=itask_cont_from(ii)
6122 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6123 c & " of CONT_TO_COMM group"
6127 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6128 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6129 c write (iout,*) "ireq,req",ireq,req(ireq)
6132 C Send the contacts to processors that need them
6133 do ii=1,ntask_cont_to
6134 iproc=itask_cont_to(ii)
6136 c write (iout,*) nn," contacts to processor",iproc,
6137 c & " of CONT_TO_COMM group"
6140 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6141 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6142 c write (iout,*) "ireq,req",ireq,req(ireq)
6144 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6148 c write (iout,*) "number of requests (contacts)",ireq
6149 c write (iout,*) "req",(req(i),i=1,4)
6152 & call MPI_Waitall(ireq,req,status_array,ierr)
6153 do iii=1,ntask_cont_from
6154 iproc=itask_cont_from(iii)
6157 write (iout,*) "Received",nn," contacts from processor",iproc,
6158 & " of CONT_FROM_COMM group"
6161 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6166 ii=zapas_recv(1,i,iii)
6167 c Flag the received contacts to prevent double-counting
6168 jj=-zapas_recv(2,i,iii)
6169 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6171 nnn=num_cont_hb(ii)+1
6174 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6175 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6176 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6177 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6178 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6179 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6180 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6181 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6182 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6183 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6184 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6185 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6186 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6187 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6188 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6189 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6190 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6191 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6192 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6193 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6194 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6195 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6196 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6197 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6202 write (iout,'(a)') 'Contact function values after receive:'
6204 write (iout,'(2i3,50(1x,i3,f5.2))')
6205 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6206 & j=1,num_cont_hb(i))
6213 write (iout,'(a)') 'Contact function values:'
6215 write (iout,'(2i3,50(1x,i3,f5.2))')
6216 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6217 & j=1,num_cont_hb(i))
6221 C Remove the loop below after debugging !!!
6228 C Calculate the local-electrostatic correlation terms
6229 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6231 num_conti=num_cont_hb(i)
6232 num_conti1=num_cont_hb(i+1)
6239 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6240 c & ' jj=',jj,' kk=',kk
6241 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6242 & .or. j.lt.0 .and. j1.gt.0) .and.
6243 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6244 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6245 C The system gains extra energy.
6246 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6247 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6248 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6250 else if (j1.eq.j) then
6251 C Contacts I-J and I-(J+1) occur simultaneously.
6252 C The system loses extra energy.
6253 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6258 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6259 c & ' jj=',jj,' kk=',kk
6261 C Contacts I-J and (I+1)-J occur simultaneously.
6262 C The system loses extra energy.
6263 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6270 c------------------------------------------------------------------------------
6271 subroutine add_hb_contact(ii,jj,itask)
6272 implicit real*8 (a-h,o-z)
6273 include "DIMENSIONS"
6274 include "COMMON.IOUNITS"
6277 parameter (max_cont=maxconts)
6278 parameter (max_dim=26)
6279 include "COMMON.CONTACTS"
6280 double precision zapas(max_dim,maxconts,max_fg_procs),
6281 & zapas_recv(max_dim,maxconts,max_fg_procs)
6282 common /przechowalnia/ zapas
6283 integer i,j,ii,jj,iproc,itask(4),nn
6284 c write (iout,*) "itask",itask
6287 if (iproc.gt.0) then
6288 do j=1,num_cont_hb(ii)
6290 c write (iout,*) "i",ii," j",jj," jjc",jjc
6292 ncont_sent(iproc)=ncont_sent(iproc)+1
6293 nn=ncont_sent(iproc)
6294 zapas(1,nn,iproc)=ii
6295 zapas(2,nn,iproc)=jjc
6296 zapas(3,nn,iproc)=facont_hb(j,ii)
6297 zapas(4,nn,iproc)=ees0p(j,ii)
6298 zapas(5,nn,iproc)=ees0m(j,ii)
6299 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6300 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6301 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6302 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6303 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6304 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6305 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6306 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6307 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6308 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6309 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6310 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6311 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6312 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6313 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6314 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6315 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6316 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6317 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6318 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6319 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6327 c------------------------------------------------------------------------------
6328 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6330 C This subroutine calculates multi-body contributions to hydrogen-bonding
6331 implicit real*8 (a-h,o-z)
6332 include 'DIMENSIONS'
6333 include 'COMMON.IOUNITS'
6336 parameter (max_cont=maxconts)
6337 parameter (max_dim=70)
6338 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6339 double precision zapas(max_dim,maxconts,max_fg_procs),
6340 & zapas_recv(max_dim,maxconts,max_fg_procs)
6341 common /przechowalnia/ zapas
6342 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6343 & status_array(MPI_STATUS_SIZE,maxconts*2)
6345 include 'COMMON.SETUP'
6346 include 'COMMON.FFIELD'
6347 include 'COMMON.DERIV'
6348 include 'COMMON.LOCAL'
6349 include 'COMMON.INTERACT'
6350 include 'COMMON.CONTACTS'
6351 include 'COMMON.CHAIN'
6352 include 'COMMON.CONTROL'
6353 double precision gx(3),gx1(3)
6354 integer num_cont_hb_old(maxres)
6356 double precision eello4,eello5,eelo6,eello_turn6
6357 external eello4,eello5,eello6,eello_turn6
6358 C Set lprn=.true. for debugging
6363 num_cont_hb_old(i)=num_cont_hb(i)
6367 if (nfgtasks.le.1) goto 30
6369 write (iout,'(a)') 'Contact function values before RECEIVE:'
6371 write (iout,'(2i3,50(1x,i2,f5.2))')
6372 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6373 & j=1,num_cont_hb(i))
6377 do i=1,ntask_cont_from
6380 do i=1,ntask_cont_to
6383 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6385 C Make the list of contacts to send to send to other procesors
6386 do i=iturn3_start,iturn3_end
6387 c write (iout,*) "make contact list turn3",i," num_cont",
6389 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6391 do i=iturn4_start,iturn4_end
6392 c write (iout,*) "make contact list turn4",i," num_cont",
6394 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6398 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6400 do j=1,num_cont_hb(i)
6403 iproc=iint_sent_local(k,jjc,ii)
6404 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6405 if (iproc.ne.0) then
6406 ncont_sent(iproc)=ncont_sent(iproc)+1
6407 nn=ncont_sent(iproc)
6409 zapas(2,nn,iproc)=jjc
6410 zapas(3,nn,iproc)=d_cont(j,i)
6414 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6419 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6427 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6438 & "Numbers of contacts to be sent to other processors",
6439 & (ncont_sent(i),i=1,ntask_cont_to)
6440 write (iout,*) "Contacts sent"
6441 do ii=1,ntask_cont_to
6443 iproc=itask_cont_to(ii)
6444 write (iout,*) nn," contacts to processor",iproc,
6445 & " of CONT_TO_COMM group"
6447 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6455 CorrelID1=nfgtasks+fg_rank+1
6457 C Receive the numbers of needed contacts from other processors
6458 do ii=1,ntask_cont_from
6459 iproc=itask_cont_from(ii)
6461 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6462 & FG_COMM,req(ireq),IERR)
6464 c write (iout,*) "IRECV ended"
6466 C Send the number of contacts needed by other processors
6467 do ii=1,ntask_cont_to
6468 iproc=itask_cont_to(ii)
6470 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6471 & FG_COMM,req(ireq),IERR)
6473 c write (iout,*) "ISEND ended"
6474 c write (iout,*) "number of requests (nn)",ireq
6477 & call MPI_Waitall(ireq,req,status_array,ierr)
6479 c & "Numbers of contacts to be received from other processors",
6480 c & (ncont_recv(i),i=1,ntask_cont_from)
6484 do ii=1,ntask_cont_from
6485 iproc=itask_cont_from(ii)
6487 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6488 c & " of CONT_TO_COMM group"
6492 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6493 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6494 c write (iout,*) "ireq,req",ireq,req(ireq)
6497 C Send the contacts to processors that need them
6498 do ii=1,ntask_cont_to
6499 iproc=itask_cont_to(ii)
6501 c write (iout,*) nn," contacts to processor",iproc,
6502 c & " of CONT_TO_COMM group"
6505 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6506 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6507 c write (iout,*) "ireq,req",ireq,req(ireq)
6509 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6513 c write (iout,*) "number of requests (contacts)",ireq
6514 c write (iout,*) "req",(req(i),i=1,4)
6517 & call MPI_Waitall(ireq,req,status_array,ierr)
6518 do iii=1,ntask_cont_from
6519 iproc=itask_cont_from(iii)
6522 write (iout,*) "Received",nn," contacts from processor",iproc,
6523 & " of CONT_FROM_COMM group"
6526 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6531 ii=zapas_recv(1,i,iii)
6532 c Flag the received contacts to prevent double-counting
6533 jj=-zapas_recv(2,i,iii)
6534 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6536 nnn=num_cont_hb(ii)+1
6539 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6543 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6548 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6556 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6565 write (iout,'(a)') 'Contact function values after receive:'
6567 write (iout,'(2i3,50(1x,i3,5f6.3))')
6568 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6569 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6576 write (iout,'(a)') 'Contact function values:'
6578 write (iout,'(2i3,50(1x,i2,5f6.3))')
6579 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6580 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6586 C Remove the loop below after debugging !!!
6593 C Calculate the dipole-dipole interaction energies
6594 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6595 do i=iatel_s,iatel_e+1
6596 num_conti=num_cont_hb(i)
6605 C Calculate the local-electrostatic correlation terms
6606 c write (iout,*) "gradcorr5 in eello5 before loop"
6608 c write (iout,'(i5,3f10.5)')
6609 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6611 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6612 c write (iout,*) "corr loop i",i
6614 num_conti=num_cont_hb(i)
6615 num_conti1=num_cont_hb(i+1)
6622 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6623 c & ' jj=',jj,' kk=',kk
6624 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6625 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6626 & .or. j.lt.0 .and. j1.gt.0) .and.
6627 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6628 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6629 C The system gains extra energy.
6631 sqd1=dsqrt(d_cont(jj,i))
6632 sqd2=dsqrt(d_cont(kk,i1))
6633 sred_geom = sqd1*sqd2
6634 IF (sred_geom.lt.cutoff_corr) THEN
6635 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6637 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6638 cd & ' jj=',jj,' kk=',kk
6639 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6640 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6642 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6643 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6646 cd write (iout,*) 'sred_geom=',sred_geom,
6647 cd & ' ekont=',ekont,' fprim=',fprimcont,
6648 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6649 cd write (iout,*) "g_contij",g_contij
6650 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6651 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6652 call calc_eello(i,jp,i+1,jp1,jj,kk)
6653 if (wcorr4.gt.0.0d0)
6654 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6655 if (energy_dec.and.wcorr4.gt.0.0d0)
6656 1 write (iout,'(a6,4i5,0pf7.3)')
6657 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6658 c write (iout,*) "gradcorr5 before eello5"
6660 c write (iout,'(i5,3f10.5)')
6661 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6663 if (wcorr5.gt.0.0d0)
6664 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6665 c write (iout,*) "gradcorr5 after eello5"
6667 c write (iout,'(i5,3f10.5)')
6668 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6670 if (energy_dec.and.wcorr5.gt.0.0d0)
6671 1 write (iout,'(a6,4i5,0pf7.3)')
6672 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6673 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6674 cd write(2,*)'ijkl',i,jp,i+1,jp1
6675 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6676 & .or. wturn6.eq.0.0d0))then
6677 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6678 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6679 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6680 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6681 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6682 cd & 'ecorr6=',ecorr6
6683 cd write (iout,'(4e15.5)') sred_geom,
6684 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6685 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6686 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6687 else if (wturn6.gt.0.0d0
6688 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6689 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6690 eturn6=eturn6+eello_turn6(i,jj,kk)
6691 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6692 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6693 cd write (2,*) 'multibody_eello:eturn6',eturn6
6702 num_cont_hb(i)=num_cont_hb_old(i)
6704 c write (iout,*) "gradcorr5 in eello5"
6706 c write (iout,'(i5,3f10.5)')
6707 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6711 c------------------------------------------------------------------------------
6712 subroutine add_hb_contact_eello(ii,jj,itask)
6713 implicit real*8 (a-h,o-z)
6714 include "DIMENSIONS"
6715 include "COMMON.IOUNITS"
6718 parameter (max_cont=maxconts)
6719 parameter (max_dim=70)
6720 include "COMMON.CONTACTS"
6721 double precision zapas(max_dim,maxconts,max_fg_procs),
6722 & zapas_recv(max_dim,maxconts,max_fg_procs)
6723 common /przechowalnia/ zapas
6724 integer i,j,ii,jj,iproc,itask(4),nn
6725 c write (iout,*) "itask",itask
6728 if (iproc.gt.0) then
6729 do j=1,num_cont_hb(ii)
6731 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6733 ncont_sent(iproc)=ncont_sent(iproc)+1
6734 nn=ncont_sent(iproc)
6735 zapas(1,nn,iproc)=ii
6736 zapas(2,nn,iproc)=jjc
6737 zapas(3,nn,iproc)=d_cont(j,ii)
6741 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6746 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6754 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6766 c------------------------------------------------------------------------------
6767 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6768 implicit real*8 (a-h,o-z)
6769 include 'DIMENSIONS'
6770 include 'COMMON.IOUNITS'
6771 include 'COMMON.DERIV'
6772 include 'COMMON.INTERACT'
6773 include 'COMMON.CONTACTS'
6774 double precision gx(3),gx1(3)
6784 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6785 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6786 C Following 4 lines for diagnostics.
6791 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6792 c & 'Contacts ',i,j,
6793 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6794 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6796 C Calculate the multi-body contribution to energy.
6797 c ecorr=ecorr+ekont*ees
6798 C Calculate multi-body contributions to the gradient.
6799 coeffpees0pij=coeffp*ees0pij
6800 coeffmees0mij=coeffm*ees0mij
6801 coeffpees0pkl=coeffp*ees0pkl
6802 coeffmees0mkl=coeffm*ees0mkl
6804 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6805 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6806 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6807 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6808 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6809 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6810 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6811 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6812 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6813 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6814 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6815 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6816 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6817 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6818 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6819 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6820 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6821 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6822 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6823 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6824 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6825 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6826 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6827 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6828 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6833 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6834 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6835 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6836 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6841 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6842 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6843 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6844 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6847 c write (iout,*) "ehbcorr",ekont*ees
6852 C---------------------------------------------------------------------------
6853 subroutine dipole(i,j,jj)
6854 implicit real*8 (a-h,o-z)
6855 include 'DIMENSIONS'
6856 include 'COMMON.IOUNITS'
6857 include 'COMMON.CHAIN'
6858 include 'COMMON.FFIELD'
6859 include 'COMMON.DERIV'
6860 include 'COMMON.INTERACT'
6861 include 'COMMON.CONTACTS'
6862 include 'COMMON.TORSION'
6863 include 'COMMON.VAR'
6864 include 'COMMON.GEO'
6865 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6867 iti1 = itortyp(itype(i+1))
6868 if (j.lt.nres-1) then
6869 itj1 = itortyp(itype(j+1))
6874 dipi(iii,1)=Ub2(iii,i)
6875 dipderi(iii)=Ub2der(iii,i)
6876 dipi(iii,2)=b1(iii,iti1)
6877 dipj(iii,1)=Ub2(iii,j)
6878 dipderj(iii)=Ub2der(iii,j)
6879 dipj(iii,2)=b1(iii,itj1)
6883 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6886 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6893 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6897 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6902 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6903 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6905 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6907 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6909 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6914 C---------------------------------------------------------------------------
6915 subroutine calc_eello(i,j,k,l,jj,kk)
6917 C This subroutine computes matrices and vectors needed to calculate
6918 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6920 implicit real*8 (a-h,o-z)
6921 include 'DIMENSIONS'
6922 include 'COMMON.IOUNITS'
6923 include 'COMMON.CHAIN'
6924 include 'COMMON.DERIV'
6925 include 'COMMON.INTERACT'
6926 include 'COMMON.CONTACTS'
6927 include 'COMMON.TORSION'
6928 include 'COMMON.VAR'
6929 include 'COMMON.GEO'
6930 include 'COMMON.FFIELD'
6931 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6932 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6935 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6936 cd & ' jj=',jj,' kk=',kk
6937 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6938 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6939 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6942 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6943 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6946 call transpose2(aa1(1,1),aa1t(1,1))
6947 call transpose2(aa2(1,1),aa2t(1,1))
6950 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
6951 & aa1tder(1,1,lll,kkk))
6952 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
6953 & aa2tder(1,1,lll,kkk))
6957 C parallel orientation of the two CA-CA-CA frames.
6959 iti=itortyp(itype(i))
6963 itk1=itortyp(itype(k+1))
6964 itj=itortyp(itype(j))
6965 if (l.lt.nres-1) then
6966 itl1=itortyp(itype(l+1))
6970 C A1 kernel(j+1) A2T
6972 cd write (iout,'(3f10.5,5x,3f10.5)')
6973 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
6975 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6976 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
6977 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
6978 C Following matrices are needed only for 6-th order cumulants
6979 IF (wcorr6.gt.0.0d0) THEN
6980 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6981 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
6982 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
6983 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6984 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
6985 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
6986 & ADtEAderx(1,1,1,1,1,1))
6988 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
6989 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
6990 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
6991 & ADtEA1derx(1,1,1,1,1,1))
6993 C End 6-th order cumulants
6996 cd write (2,*) 'In calc_eello6'
6998 cd write (2,*) 'iii=',iii
7000 cd write (2,*) 'kkk=',kkk
7002 cd write (2,'(3(2f10.5),5x)')
7003 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7008 call transpose2(EUgder(1,1,k),auxmat(1,1))
7009 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7010 call transpose2(EUg(1,1,k),auxmat(1,1))
7011 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7012 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7016 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7017 & EAEAderx(1,1,lll,kkk,iii,1))
7021 C A1T kernel(i+1) A2
7022 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7023 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7024 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7025 C Following matrices are needed only for 6-th order cumulants
7026 IF (wcorr6.gt.0.0d0) THEN
7027 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7028 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7029 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7030 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7031 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7032 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7033 & ADtEAderx(1,1,1,1,1,2))
7034 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7035 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7036 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7037 & ADtEA1derx(1,1,1,1,1,2))
7039 C End 6-th order cumulants
7040 call transpose2(EUgder(1,1,l),auxmat(1,1))
7041 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7042 call transpose2(EUg(1,1,l),auxmat(1,1))
7043 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7044 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7048 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7049 & EAEAderx(1,1,lll,kkk,iii,2))
7054 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7055 C They are needed only when the fifth- or the sixth-order cumulants are
7057 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7058 call transpose2(AEA(1,1,1),auxmat(1,1))
7059 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7060 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7061 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7062 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7063 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7064 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7065 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7066 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7067 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7068 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7069 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7070 call transpose2(AEA(1,1,2),auxmat(1,1))
7071 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7072 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7073 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7074 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7075 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7076 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7077 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7078 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7079 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7080 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7081 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7082 C Calculate the Cartesian derivatives of the vectors.
7086 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7087 call matvec2(auxmat(1,1),b1(1,iti),
7088 & AEAb1derx(1,lll,kkk,iii,1,1))
7089 call matvec2(auxmat(1,1),Ub2(1,i),
7090 & AEAb2derx(1,lll,kkk,iii,1,1))
7091 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7092 & AEAb1derx(1,lll,kkk,iii,2,1))
7093 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7094 & AEAb2derx(1,lll,kkk,iii,2,1))
7095 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7096 call matvec2(auxmat(1,1),b1(1,itj),
7097 & AEAb1derx(1,lll,kkk,iii,1,2))
7098 call matvec2(auxmat(1,1),Ub2(1,j),
7099 & AEAb2derx(1,lll,kkk,iii,1,2))
7100 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7101 & AEAb1derx(1,lll,kkk,iii,2,2))
7102 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7103 & AEAb2derx(1,lll,kkk,iii,2,2))
7110 C Antiparallel orientation of the two CA-CA-CA frames.
7112 iti=itortyp(itype(i))
7116 itk1=itortyp(itype(k+1))
7117 itl=itortyp(itype(l))
7118 itj=itortyp(itype(j))
7119 if (j.lt.nres-1) then
7120 itj1=itortyp(itype(j+1))
7124 C A2 kernel(j-1)T A1T
7125 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7126 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7127 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7128 C Following matrices are needed only for 6-th order cumulants
7129 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7130 & j.eq.i+4 .and. l.eq.i+3)) THEN
7131 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7132 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7133 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7134 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7135 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7136 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7137 & ADtEAderx(1,1,1,1,1,1))
7138 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7139 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7140 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7141 & ADtEA1derx(1,1,1,1,1,1))
7143 C End 6-th order cumulants
7144 call transpose2(EUgder(1,1,k),auxmat(1,1))
7145 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7146 call transpose2(EUg(1,1,k),auxmat(1,1))
7147 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7148 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7152 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7153 & EAEAderx(1,1,lll,kkk,iii,1))
7157 C A2T kernel(i+1)T A1
7158 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7159 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7160 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7161 C Following matrices are needed only for 6-th order cumulants
7162 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7163 & j.eq.i+4 .and. l.eq.i+3)) THEN
7164 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7165 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7166 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7167 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7168 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7169 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7170 & ADtEAderx(1,1,1,1,1,2))
7171 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7172 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7173 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7174 & ADtEA1derx(1,1,1,1,1,2))
7176 C End 6-th order cumulants
7177 call transpose2(EUgder(1,1,j),auxmat(1,1))
7178 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7179 call transpose2(EUg(1,1,j),auxmat(1,1))
7180 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7181 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7185 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7186 & EAEAderx(1,1,lll,kkk,iii,2))
7191 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7192 C They are needed only when the fifth- or the sixth-order cumulants are
7194 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7195 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7196 call transpose2(AEA(1,1,1),auxmat(1,1))
7197 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7198 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7199 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7200 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7201 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7202 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7203 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7204 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7205 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7206 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7207 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7208 call transpose2(AEA(1,1,2),auxmat(1,1))
7209 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7210 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7211 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7212 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7213 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7214 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7215 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7216 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7217 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7218 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7219 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7220 C Calculate the Cartesian derivatives of the vectors.
7224 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7225 call matvec2(auxmat(1,1),b1(1,iti),
7226 & AEAb1derx(1,lll,kkk,iii,1,1))
7227 call matvec2(auxmat(1,1),Ub2(1,i),
7228 & AEAb2derx(1,lll,kkk,iii,1,1))
7229 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7230 & AEAb1derx(1,lll,kkk,iii,2,1))
7231 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7232 & AEAb2derx(1,lll,kkk,iii,2,1))
7233 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7234 call matvec2(auxmat(1,1),b1(1,itl),
7235 & AEAb1derx(1,lll,kkk,iii,1,2))
7236 call matvec2(auxmat(1,1),Ub2(1,l),
7237 & AEAb2derx(1,lll,kkk,iii,1,2))
7238 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7239 & AEAb1derx(1,lll,kkk,iii,2,2))
7240 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7241 & AEAb2derx(1,lll,kkk,iii,2,2))
7250 C---------------------------------------------------------------------------
7251 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7252 & KK,KKderg,AKA,AKAderg,AKAderx)
7256 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7257 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7258 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7263 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7265 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7268 cd if (lprn) write (2,*) 'In kernel'
7270 cd if (lprn) write (2,*) 'kkk=',kkk
7272 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7273 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7275 cd write (2,*) 'lll=',lll
7276 cd write (2,*) 'iii=1'
7278 cd write (2,'(3(2f10.5),5x)')
7279 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7282 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7283 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7285 cd write (2,*) 'lll=',lll
7286 cd write (2,*) 'iii=2'
7288 cd write (2,'(3(2f10.5),5x)')
7289 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7296 C---------------------------------------------------------------------------
7297 double precision function eello4(i,j,k,l,jj,kk)
7298 implicit real*8 (a-h,o-z)
7299 include 'DIMENSIONS'
7300 include 'COMMON.IOUNITS'
7301 include 'COMMON.CHAIN'
7302 include 'COMMON.DERIV'
7303 include 'COMMON.INTERACT'
7304 include 'COMMON.CONTACTS'
7305 include 'COMMON.TORSION'
7306 include 'COMMON.VAR'
7307 include 'COMMON.GEO'
7308 double precision pizda(2,2),ggg1(3),ggg2(3)
7309 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7313 cd print *,'eello4:',i,j,k,l,jj,kk
7314 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7315 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7316 cold eij=facont_hb(jj,i)
7317 cold ekl=facont_hb(kk,k)
7319 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7320 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7321 gcorr_loc(k-1)=gcorr_loc(k-1)
7322 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7324 gcorr_loc(l-1)=gcorr_loc(l-1)
7325 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7327 gcorr_loc(j-1)=gcorr_loc(j-1)
7328 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7333 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7334 & -EAEAderx(2,2,lll,kkk,iii,1)
7335 cd derx(lll,kkk,iii)=0.0d0
7339 cd gcorr_loc(l-1)=0.0d0
7340 cd gcorr_loc(j-1)=0.0d0
7341 cd gcorr_loc(k-1)=0.0d0
7343 cd write (iout,*)'Contacts have occurred for peptide groups',
7344 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7345 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7346 if (j.lt.nres-1) then
7353 if (l.lt.nres-1) then
7361 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7362 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7363 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7364 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7365 cgrad ghalf=0.5d0*ggg1(ll)
7366 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7367 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7368 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7369 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7370 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7371 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7372 cgrad ghalf=0.5d0*ggg2(ll)
7373 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7374 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7375 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7376 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7377 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7378 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7382 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7387 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7392 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7397 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7401 cd write (2,*) iii,gcorr_loc(iii)
7404 cd write (2,*) 'ekont',ekont
7405 cd write (iout,*) 'eello4',ekont*eel4
7408 C---------------------------------------------------------------------------
7409 double precision function eello5(i,j,k,l,jj,kk)
7410 implicit real*8 (a-h,o-z)
7411 include 'DIMENSIONS'
7412 include 'COMMON.IOUNITS'
7413 include 'COMMON.CHAIN'
7414 include 'COMMON.DERIV'
7415 include 'COMMON.INTERACT'
7416 include 'COMMON.CONTACTS'
7417 include 'COMMON.TORSION'
7418 include 'COMMON.VAR'
7419 include 'COMMON.GEO'
7420 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7421 double precision ggg1(3),ggg2(3)
7422 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7427 C /l\ / \ \ / \ / \ / C
7428 C / \ / \ \ / \ / \ / C
7429 C j| o |l1 | o | o| o | | o |o C
7430 C \ |/k\| |/ \| / |/ \| |/ \| C
7431 C \i/ \ / \ / / \ / \ C
7433 C (I) (II) (III) (IV) C
7435 C eello5_1 eello5_2 eello5_3 eello5_4 C
7437 C Antiparallel chains C
7440 C /j\ / \ \ / \ / \ / C
7441 C / \ / \ \ / \ / \ / C
7442 C j1| o |l | o | o| o | | o |o C
7443 C \ |/k\| |/ \| / |/ \| |/ \| C
7444 C \i/ \ / \ / / \ / \ C
7446 C (I) (II) (III) (IV) C
7448 C eello5_1 eello5_2 eello5_3 eello5_4 C
7450 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7452 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7453 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7458 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7460 itk=itortyp(itype(k))
7461 itl=itortyp(itype(l))
7462 itj=itortyp(itype(j))
7467 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7468 cd & eel5_3_num,eel5_4_num)
7472 derx(lll,kkk,iii)=0.0d0
7476 cd eij=facont_hb(jj,i)
7477 cd ekl=facont_hb(kk,k)
7479 cd write (iout,*)'Contacts have occurred for peptide groups',
7480 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7482 C Contribution from the graph I.
7483 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7484 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7485 call transpose2(EUg(1,1,k),auxmat(1,1))
7486 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7487 vv(1)=pizda(1,1)-pizda(2,2)
7488 vv(2)=pizda(1,2)+pizda(2,1)
7489 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7490 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7491 C Explicit gradient in virtual-dihedral angles.
7492 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7493 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7494 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7495 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7496 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7497 vv(1)=pizda(1,1)-pizda(2,2)
7498 vv(2)=pizda(1,2)+pizda(2,1)
7499 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7500 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7501 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7502 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7503 vv(1)=pizda(1,1)-pizda(2,2)
7504 vv(2)=pizda(1,2)+pizda(2,1)
7506 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7507 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7508 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7510 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7511 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7512 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7514 C Cartesian gradient
7518 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7520 vv(1)=pizda(1,1)-pizda(2,2)
7521 vv(2)=pizda(1,2)+pizda(2,1)
7522 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7523 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7524 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7530 C Contribution from graph II
7531 call transpose2(EE(1,1,itk),auxmat(1,1))
7532 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7533 vv(1)=pizda(1,1)+pizda(2,2)
7534 vv(2)=pizda(2,1)-pizda(1,2)
7535 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7536 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7537 C Explicit gradient in virtual-dihedral angles.
7538 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7539 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7540 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7541 vv(1)=pizda(1,1)+pizda(2,2)
7542 vv(2)=pizda(2,1)-pizda(1,2)
7544 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7545 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7546 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7548 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7549 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7550 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7552 C Cartesian gradient
7556 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7558 vv(1)=pizda(1,1)+pizda(2,2)
7559 vv(2)=pizda(2,1)-pizda(1,2)
7560 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7561 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7562 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7570 C Parallel orientation
7571 C Contribution from graph III
7572 call transpose2(EUg(1,1,l),auxmat(1,1))
7573 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7574 vv(1)=pizda(1,1)-pizda(2,2)
7575 vv(2)=pizda(1,2)+pizda(2,1)
7576 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7577 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7578 C Explicit gradient in virtual-dihedral angles.
7579 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7580 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7581 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7582 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7583 vv(1)=pizda(1,1)-pizda(2,2)
7584 vv(2)=pizda(1,2)+pizda(2,1)
7585 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7586 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7587 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7588 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7589 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7590 vv(1)=pizda(1,1)-pizda(2,2)
7591 vv(2)=pizda(1,2)+pizda(2,1)
7592 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7593 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7594 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7595 C Cartesian gradient
7599 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7601 vv(1)=pizda(1,1)-pizda(2,2)
7602 vv(2)=pizda(1,2)+pizda(2,1)
7603 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7604 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7605 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7610 C Contribution from graph IV
7612 call transpose2(EE(1,1,itl),auxmat(1,1))
7613 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7614 vv(1)=pizda(1,1)+pizda(2,2)
7615 vv(2)=pizda(2,1)-pizda(1,2)
7616 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7617 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7618 C Explicit gradient in virtual-dihedral angles.
7619 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7620 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7621 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7622 vv(1)=pizda(1,1)+pizda(2,2)
7623 vv(2)=pizda(2,1)-pizda(1,2)
7624 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7625 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7626 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7627 C Cartesian gradient
7631 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7633 vv(1)=pizda(1,1)+pizda(2,2)
7634 vv(2)=pizda(2,1)-pizda(1,2)
7635 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7636 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7637 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7642 C Antiparallel orientation
7643 C Contribution from graph III
7645 call transpose2(EUg(1,1,j),auxmat(1,1))
7646 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7647 vv(1)=pizda(1,1)-pizda(2,2)
7648 vv(2)=pizda(1,2)+pizda(2,1)
7649 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7650 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7651 C Explicit gradient in virtual-dihedral angles.
7652 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7653 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7654 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7655 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7656 vv(1)=pizda(1,1)-pizda(2,2)
7657 vv(2)=pizda(1,2)+pizda(2,1)
7658 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7659 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7660 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7661 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7662 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7663 vv(1)=pizda(1,1)-pizda(2,2)
7664 vv(2)=pizda(1,2)+pizda(2,1)
7665 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7666 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7667 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7668 C Cartesian gradient
7672 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7674 vv(1)=pizda(1,1)-pizda(2,2)
7675 vv(2)=pizda(1,2)+pizda(2,1)
7676 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7677 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7678 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7683 C Contribution from graph IV
7685 call transpose2(EE(1,1,itj),auxmat(1,1))
7686 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7687 vv(1)=pizda(1,1)+pizda(2,2)
7688 vv(2)=pizda(2,1)-pizda(1,2)
7689 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7690 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7691 C Explicit gradient in virtual-dihedral angles.
7692 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7693 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7694 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7695 vv(1)=pizda(1,1)+pizda(2,2)
7696 vv(2)=pizda(2,1)-pizda(1,2)
7697 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7698 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7699 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7700 C Cartesian gradient
7704 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7706 vv(1)=pizda(1,1)+pizda(2,2)
7707 vv(2)=pizda(2,1)-pizda(1,2)
7708 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7709 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7710 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7716 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7717 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7718 cd write (2,*) 'ijkl',i,j,k,l
7719 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7720 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7722 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7723 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7724 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7725 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7726 if (j.lt.nres-1) then
7733 if (l.lt.nres-1) then
7743 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7744 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7745 C summed up outside the subrouine as for the other subroutines
7746 C handling long-range interactions. The old code is commented out
7747 C with "cgrad" to keep track of changes.
7749 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7750 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7751 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7752 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7753 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7754 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7755 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7756 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7757 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7758 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7760 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7761 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7762 cgrad ghalf=0.5d0*ggg1(ll)
7764 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7765 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7766 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7767 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7768 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7769 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7770 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7771 cgrad ghalf=0.5d0*ggg2(ll)
7773 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7774 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7775 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7776 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7777 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7778 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7783 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7784 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7789 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7790 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7796 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7801 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7805 cd write (2,*) iii,g_corr5_loc(iii)
7808 cd write (2,*) 'ekont',ekont
7809 cd write (iout,*) 'eello5',ekont*eel5
7812 c--------------------------------------------------------------------------
7813 double precision function eello6(i,j,k,l,jj,kk)
7814 implicit real*8 (a-h,o-z)
7815 include 'DIMENSIONS'
7816 include 'COMMON.IOUNITS'
7817 include 'COMMON.CHAIN'
7818 include 'COMMON.DERIV'
7819 include 'COMMON.INTERACT'
7820 include 'COMMON.CONTACTS'
7821 include 'COMMON.TORSION'
7822 include 'COMMON.VAR'
7823 include 'COMMON.GEO'
7824 include 'COMMON.FFIELD'
7825 double precision ggg1(3),ggg2(3)
7826 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7831 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7839 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7840 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7844 derx(lll,kkk,iii)=0.0d0
7848 cd eij=facont_hb(jj,i)
7849 cd ekl=facont_hb(kk,k)
7855 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7856 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7857 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7858 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7859 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7860 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7862 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7863 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7864 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7865 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7866 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7867 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7871 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7873 C If turn contributions are considered, they will be handled separately.
7874 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7875 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7876 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7877 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7878 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7879 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7880 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7882 if (j.lt.nres-1) then
7889 if (l.lt.nres-1) then
7897 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7898 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7899 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7900 cgrad ghalf=0.5d0*ggg1(ll)
7902 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7903 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7904 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7905 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7906 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7907 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7908 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7909 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7910 cgrad ghalf=0.5d0*ggg2(ll)
7911 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7913 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7914 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7915 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7916 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7917 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7918 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7923 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7924 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7929 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7930 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7936 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
7941 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
7945 cd write (2,*) iii,g_corr6_loc(iii)
7948 cd write (2,*) 'ekont',ekont
7949 cd write (iout,*) 'eello6',ekont*eel6
7952 c--------------------------------------------------------------------------
7953 double precision function eello6_graph1(i,j,k,l,imat,swap)
7954 implicit real*8 (a-h,o-z)
7955 include 'DIMENSIONS'
7956 include 'COMMON.IOUNITS'
7957 include 'COMMON.CHAIN'
7958 include 'COMMON.DERIV'
7959 include 'COMMON.INTERACT'
7960 include 'COMMON.CONTACTS'
7961 include 'COMMON.TORSION'
7962 include 'COMMON.VAR'
7963 include 'COMMON.GEO'
7964 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
7968 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7970 C Parallel Antiparallel
7976 C \ j|/k\| / \ |/k\|l /
7981 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7982 itk=itortyp(itype(k))
7983 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
7984 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
7985 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
7986 call transpose2(EUgC(1,1,k),auxmat(1,1))
7987 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
7988 vv1(1)=pizda1(1,1)-pizda1(2,2)
7989 vv1(2)=pizda1(1,2)+pizda1(2,1)
7990 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
7991 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
7992 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
7993 s5=scalar2(vv(1),Dtobr2(1,i))
7994 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
7995 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
7996 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
7997 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
7998 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
7999 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8000 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8001 & +scalar2(vv(1),Dtobr2der(1,i)))
8002 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8003 vv1(1)=pizda1(1,1)-pizda1(2,2)
8004 vv1(2)=pizda1(1,2)+pizda1(2,1)
8005 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8006 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8008 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8009 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8010 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8011 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8012 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8014 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8015 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8016 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8017 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8018 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8020 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8021 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8022 vv1(1)=pizda1(1,1)-pizda1(2,2)
8023 vv1(2)=pizda1(1,2)+pizda1(2,1)
8024 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8025 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8026 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8027 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8036 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8037 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8038 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8039 call transpose2(EUgC(1,1,k),auxmat(1,1))
8040 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8042 vv1(1)=pizda1(1,1)-pizda1(2,2)
8043 vv1(2)=pizda1(1,2)+pizda1(2,1)
8044 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8045 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8046 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8047 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8048 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8049 s5=scalar2(vv(1),Dtobr2(1,i))
8050 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8056 c----------------------------------------------------------------------------
8057 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8058 implicit real*8 (a-h,o-z)
8059 include 'DIMENSIONS'
8060 include 'COMMON.IOUNITS'
8061 include 'COMMON.CHAIN'
8062 include 'COMMON.DERIV'
8063 include 'COMMON.INTERACT'
8064 include 'COMMON.CONTACTS'
8065 include 'COMMON.TORSION'
8066 include 'COMMON.VAR'
8067 include 'COMMON.GEO'
8069 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8070 & auxvec1(2),auxvec2(1),auxmat1(2,2)
8073 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8075 C Parallel Antiparallel
8086 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8087 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8088 C AL 7/4/01 s1 would occur in the sixth-order moment,
8089 C but not in a cluster cumulant
8091 s1=dip(1,jj,i)*dip(1,kk,k)
8093 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8094 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8095 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8096 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8097 call transpose2(EUg(1,1,k),auxmat(1,1))
8098 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8099 vv(1)=pizda(1,1)-pizda(2,2)
8100 vv(2)=pizda(1,2)+pizda(2,1)
8101 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8102 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8104 eello6_graph2=-(s1+s2+s3+s4)
8106 eello6_graph2=-(s2+s3+s4)
8109 C Derivatives in gamma(i-1)
8112 s1=dipderg(1,jj,i)*dip(1,kk,k)
8114 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8115 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8116 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8117 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8119 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8121 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8123 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8125 C Derivatives in gamma(k-1)
8127 s1=dip(1,jj,i)*dipderg(1,kk,k)
8129 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8130 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8131 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8132 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8133 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8134 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8135 vv(1)=pizda(1,1)-pizda(2,2)
8136 vv(2)=pizda(1,2)+pizda(2,1)
8137 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8139 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8141 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8143 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8144 C Derivatives in gamma(j-1) or gamma(l-1)
8147 s1=dipderg(3,jj,i)*dip(1,kk,k)
8149 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8150 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8151 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8152 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8153 vv(1)=pizda(1,1)-pizda(2,2)
8154 vv(2)=pizda(1,2)+pizda(2,1)
8155 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8158 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8160 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8163 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8164 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8166 C Derivatives in gamma(l-1) or gamma(j-1)
8169 s1=dip(1,jj,i)*dipderg(3,kk,k)
8171 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8172 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8173 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8174 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8175 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8176 vv(1)=pizda(1,1)-pizda(2,2)
8177 vv(2)=pizda(1,2)+pizda(2,1)
8178 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8181 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8183 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8186 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8187 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8189 C Cartesian derivatives.
8191 write (2,*) 'In eello6_graph2'
8193 write (2,*) 'iii=',iii
8195 write (2,*) 'kkk=',kkk
8197 write (2,'(3(2f10.5),5x)')
8198 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8208 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8210 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8213 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8215 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8216 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8218 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8219 call transpose2(EUg(1,1,k),auxmat(1,1))
8220 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8222 vv(1)=pizda(1,1)-pizda(2,2)
8223 vv(2)=pizda(1,2)+pizda(2,1)
8224 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8225 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8227 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8229 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8232 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8234 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8241 c----------------------------------------------------------------------------
8242 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8243 implicit real*8 (a-h,o-z)
8244 include 'DIMENSIONS'
8245 include 'COMMON.IOUNITS'
8246 include 'COMMON.CHAIN'
8247 include 'COMMON.DERIV'
8248 include 'COMMON.INTERACT'
8249 include 'COMMON.CONTACTS'
8250 include 'COMMON.TORSION'
8251 include 'COMMON.VAR'
8252 include 'COMMON.GEO'
8253 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8255 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8257 C Parallel Antiparallel
8268 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8270 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8271 C energy moment and not to the cluster cumulant.
8272 iti=itortyp(itype(i))
8273 if (j.lt.nres-1) then
8274 itj1=itortyp(itype(j+1))
8278 itk=itortyp(itype(k))
8279 itk1=itortyp(itype(k+1))
8280 if (l.lt.nres-1) then
8281 itl1=itortyp(itype(l+1))
8286 s1=dip(4,jj,i)*dip(4,kk,k)
8288 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8289 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8290 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8291 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8292 call transpose2(EE(1,1,itk),auxmat(1,1))
8293 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8294 vv(1)=pizda(1,1)+pizda(2,2)
8295 vv(2)=pizda(2,1)-pizda(1,2)
8296 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8297 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8298 cd & "sum",-(s2+s3+s4)
8300 eello6_graph3=-(s1+s2+s3+s4)
8302 eello6_graph3=-(s2+s3+s4)
8305 C Derivatives in gamma(k-1)
8306 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8307 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8308 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8309 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8310 C Derivatives in gamma(l-1)
8311 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8312 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8313 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8314 vv(1)=pizda(1,1)+pizda(2,2)
8315 vv(2)=pizda(2,1)-pizda(1,2)
8316 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8317 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8318 C Cartesian derivatives.
8324 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8326 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8329 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8331 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8332 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8334 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8335 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8337 vv(1)=pizda(1,1)+pizda(2,2)
8338 vv(2)=pizda(2,1)-pizda(1,2)
8339 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8341 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8343 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8346 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8348 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8350 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8356 c----------------------------------------------------------------------------
8357 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8358 implicit real*8 (a-h,o-z)
8359 include 'DIMENSIONS'
8360 include 'COMMON.IOUNITS'
8361 include 'COMMON.CHAIN'
8362 include 'COMMON.DERIV'
8363 include 'COMMON.INTERACT'
8364 include 'COMMON.CONTACTS'
8365 include 'COMMON.TORSION'
8366 include 'COMMON.VAR'
8367 include 'COMMON.GEO'
8368 include 'COMMON.FFIELD'
8369 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8370 & auxvec1(2),auxmat1(2,2)
8372 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8374 C Parallel Antiparallel
8385 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8387 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8388 C energy moment and not to the cluster cumulant.
8389 cd write (2,*) 'eello_graph4: wturn6',wturn6
8390 iti=itortyp(itype(i))
8391 itj=itortyp(itype(j))
8392 if (j.lt.nres-1) then
8393 itj1=itortyp(itype(j+1))
8397 itk=itortyp(itype(k))
8398 if (k.lt.nres-1) then
8399 itk1=itortyp(itype(k+1))
8403 itl=itortyp(itype(l))
8404 if (l.lt.nres-1) then
8405 itl1=itortyp(itype(l+1))
8409 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8410 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8411 cd & ' itl',itl,' itl1',itl1
8414 s1=dip(3,jj,i)*dip(3,kk,k)
8416 s1=dip(2,jj,j)*dip(2,kk,l)
8419 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8420 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8422 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8423 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8425 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8426 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8428 call transpose2(EUg(1,1,k),auxmat(1,1))
8429 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8430 vv(1)=pizda(1,1)-pizda(2,2)
8431 vv(2)=pizda(2,1)+pizda(1,2)
8432 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8433 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8435 eello6_graph4=-(s1+s2+s3+s4)
8437 eello6_graph4=-(s2+s3+s4)
8439 C Derivatives in gamma(i-1)
8443 s1=dipderg(2,jj,i)*dip(3,kk,k)
8445 s1=dipderg(4,jj,j)*dip(2,kk,l)
8448 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8450 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8451 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8453 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8454 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8456 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8457 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8458 cd write (2,*) 'turn6 derivatives'
8460 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8462 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8466 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8468 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8472 C Derivatives in gamma(k-1)
8475 s1=dip(3,jj,i)*dipderg(2,kk,k)
8477 s1=dip(2,jj,j)*dipderg(4,kk,l)
8480 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8481 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8483 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8484 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8486 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8487 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8489 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8490 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8491 vv(1)=pizda(1,1)-pizda(2,2)
8492 vv(2)=pizda(2,1)+pizda(1,2)
8493 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8494 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8496 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8498 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8502 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8504 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8507 C Derivatives in gamma(j-1) or gamma(l-1)
8508 if (l.eq.j+1 .and. l.gt.1) then
8509 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8510 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8511 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8512 vv(1)=pizda(1,1)-pizda(2,2)
8513 vv(2)=pizda(2,1)+pizda(1,2)
8514 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8515 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8516 else if (j.gt.1) then
8517 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8518 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8519 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8520 vv(1)=pizda(1,1)-pizda(2,2)
8521 vv(2)=pizda(2,1)+pizda(1,2)
8522 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8523 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8524 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8526 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8529 C Cartesian derivatives.
8536 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8538 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8542 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8544 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8548 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8550 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8552 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8553 & b1(1,itj1),auxvec(1))
8554 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8556 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8557 & b1(1,itl1),auxvec(1))
8558 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8560 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8562 vv(1)=pizda(1,1)-pizda(2,2)
8563 vv(2)=pizda(2,1)+pizda(1,2)
8564 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8566 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8568 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8571 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8574 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8577 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8579 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8581 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8585 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8587 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8590 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8592 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8600 c----------------------------------------------------------------------------
8601 double precision function eello_turn6(i,jj,kk)
8602 implicit real*8 (a-h,o-z)
8603 include 'DIMENSIONS'
8604 include 'COMMON.IOUNITS'
8605 include 'COMMON.CHAIN'
8606 include 'COMMON.DERIV'
8607 include 'COMMON.INTERACT'
8608 include 'COMMON.CONTACTS'
8609 include 'COMMON.TORSION'
8610 include 'COMMON.VAR'
8611 include 'COMMON.GEO'
8612 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8613 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8615 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8616 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8617 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8618 C the respective energy moment and not to the cluster cumulant.
8627 iti=itortyp(itype(i))
8628 itk=itortyp(itype(k))
8629 itk1=itortyp(itype(k+1))
8630 itl=itortyp(itype(l))
8631 itj=itortyp(itype(j))
8632 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8633 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8634 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8639 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8641 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8645 derx_turn(lll,kkk,iii)=0.0d0
8652 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8654 cd write (2,*) 'eello6_5',eello6_5
8656 call transpose2(AEA(1,1,1),auxmat(1,1))
8657 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8658 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8659 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8661 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8662 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8663 s2 = scalar2(b1(1,itk),vtemp1(1))
8665 call transpose2(AEA(1,1,2),atemp(1,1))
8666 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8667 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8668 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8670 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8671 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8672 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8674 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8675 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8676 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8677 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8678 ss13 = scalar2(b1(1,itk),vtemp4(1))
8679 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8681 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8687 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8688 C Derivatives in gamma(i+2)
8692 call transpose2(AEA(1,1,1),auxmatd(1,1))
8693 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8694 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8695 call transpose2(AEAderg(1,1,2),atempd(1,1))
8696 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8697 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8699 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8700 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8701 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8707 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8708 C Derivatives in gamma(i+3)
8710 call transpose2(AEA(1,1,1),auxmatd(1,1))
8711 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8712 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8713 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8715 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8716 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8717 s2d = scalar2(b1(1,itk),vtemp1d(1))
8719 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8720 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8722 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8724 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8725 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8726 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8734 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8735 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8737 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8738 & -0.5d0*ekont*(s2d+s12d)
8740 C Derivatives in gamma(i+4)
8741 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8742 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8743 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8745 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8746 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8747 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8755 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8757 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8759 C Derivatives in gamma(i+5)
8761 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8762 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8763 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8765 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8766 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8767 s2d = scalar2(b1(1,itk),vtemp1d(1))
8769 call transpose2(AEA(1,1,2),atempd(1,1))
8770 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8771 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8773 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8774 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8776 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8777 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8778 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8786 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8787 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8789 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8790 & -0.5d0*ekont*(s2d+s12d)
8792 C Cartesian derivatives
8797 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8798 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8799 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8801 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8802 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8804 s2d = scalar2(b1(1,itk),vtemp1d(1))
8806 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8807 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8808 s8d = -(atempd(1,1)+atempd(2,2))*
8809 & scalar2(cc(1,1,itl),vtemp2(1))
8811 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8813 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8814 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8821 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8824 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8828 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8829 & - 0.5d0*(s8d+s12d)
8831 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8840 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8842 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8843 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8844 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8845 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8846 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8848 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8849 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8850 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8854 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8855 cd & 16*eel_turn6_num
8857 if (j.lt.nres-1) then
8864 if (l.lt.nres-1) then
8872 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8873 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8874 cgrad ghalf=0.5d0*ggg1(ll)
8876 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8877 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8878 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8879 & +ekont*derx_turn(ll,2,1)
8880 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8881 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8882 & +ekont*derx_turn(ll,4,1)
8883 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8884 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8885 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8886 cgrad ghalf=0.5d0*ggg2(ll)
8888 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8889 & +ekont*derx_turn(ll,2,2)
8890 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8891 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8892 & +ekont*derx_turn(ll,4,2)
8893 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8894 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8895 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8900 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8905 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8911 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8916 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8920 cd write (2,*) iii,g_corr6_loc(iii)
8922 eello_turn6=ekont*eel_turn6
8923 cd write (2,*) 'ekont',ekont
8924 cd write (2,*) 'eel_turn6',ekont*eel_turn6
8928 C-----------------------------------------------------------------------------
8929 double precision function scalar(u,v)
8930 !DIR$ INLINEALWAYS scalar
8932 cDEC$ ATTRIBUTES FORCEINLINE::scalar
8935 double precision u(3),v(3)
8936 cd double precision sc
8944 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
8947 crc-------------------------------------------------
8948 SUBROUTINE MATVEC2(A1,V1,V2)
8949 !DIR$ INLINEALWAYS MATVEC2
8951 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
8953 implicit real*8 (a-h,o-z)
8954 include 'DIMENSIONS'
8955 DIMENSION A1(2,2),V1(2),V2(2)
8959 c 3 VI=VI+A1(I,K)*V1(K)
8963 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
8964 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
8969 C---------------------------------------
8970 SUBROUTINE MATMAT2(A1,A2,A3)
8972 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
8974 implicit real*8 (a-h,o-z)
8975 include 'DIMENSIONS'
8976 DIMENSION A1(2,2),A2(2,2),A3(2,2)
8977 c DIMENSION AI3(2,2)
8981 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
8987 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
8988 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
8989 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
8990 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
8998 c-------------------------------------------------------------------------
8999 double precision function scalar2(u,v)
9000 !DIR$ INLINEALWAYS scalar2
9002 double precision u(2),v(2)
9005 scalar2=u(1)*v(1)+u(2)*v(2)
9009 C-----------------------------------------------------------------------------
9011 subroutine transpose2(a,at)
9012 !DIR$ INLINEALWAYS transpose2
9014 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9017 double precision a(2,2),at(2,2)
9024 c--------------------------------------------------------------------------
9025 subroutine transpose(n,a,at)
9028 double precision a(n,n),at(n,n)
9036 C---------------------------------------------------------------------------
9037 subroutine prodmat3(a1,a2,kk,transp,prod)
9038 !DIR$ INLINEALWAYS prodmat3
9040 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9044 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9046 crc double precision auxmat(2,2),prod_(2,2)
9049 crc call transpose2(kk(1,1),auxmat(1,1))
9050 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9051 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9053 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9054 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9055 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9056 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9057 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9058 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9059 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9060 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9063 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9064 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9066 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9067 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9068 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9069 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9070 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9071 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9072 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9073 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9076 c call transpose2(a2(1,1),a2t(1,1))
9079 crc print *,((prod_(i,j),i=1,2),j=1,2)
9080 crc print *,((prod(i,j),i=1,2),j=1,2)