1 subroutine etotal(energia)
2 implicit real*8 (a-h,o-z)
7 cMS$ATTRIBUTES C :: proc_proc
12 double precision weights_(n_ene)
14 include 'COMMON.SETUP'
15 include 'COMMON.IOUNITS'
16 double precision energia(0:n_ene)
17 include 'COMMON.LOCAL'
18 include 'COMMON.FFIELD'
19 include 'COMMON.DERIV'
20 include 'COMMON.INTERACT'
21 include 'COMMON.SBRIDGE'
22 include 'COMMON.CHAIN'
25 include 'COMMON.CONTROL'
26 include 'COMMON.TIME1'
28 c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
29 c & " nfgtasks",nfgtasks
30 if (nfgtasks.gt.1) then
32 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
33 if (fg_rank.eq.0) then
34 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
35 c print *,"Processor",myrank," BROADCAST iorder"
36 C FG master sets up the WEIGHTS_ array which will be broadcast to the
37 C FG slaves as WEIGHTS array.
58 C FG Master broadcasts the WEIGHTS_ array
59 call MPI_Bcast(weights_(1),n_ene,
60 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
62 C FG slaves receive the WEIGHTS array
63 call MPI_Bcast(weights(1),n_ene,
64 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
86 time_Bcast=time_Bcast+MPI_Wtime()-time00
87 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
88 c call chainbuild_cart
90 c print *,'Processor',myrank,' calling etotal ipot=',ipot
91 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
93 c if (modecalc.eq.12.or.modecalc.eq.14) then
94 c call int_from_cart1(.false.)
101 C Compute the side-chain and electrostatic interaction energy
103 goto (101,102,103,104,105,106) ipot
104 C Lennard-Jones potential.
105 101 call elj(evdw,evdw_p,evdw_m)
106 cd print '(a)','Exit ELJ'
108 C Lennard-Jones-Kihara potential (shifted).
109 102 call eljk(evdw,evdw_p,evdw_m)
111 C Berne-Pechukas potential (dilated LJ, angular dependence).
112 103 call ebp(evdw,evdw_p,evdw_m)
114 C Gay-Berne potential (shifted LJ, angular dependence).
115 104 call egb(evdw,evdw_p,evdw_m)
117 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
118 105 call egbv(evdw,evdw_p,evdw_m)
120 C Soft-sphere potential
121 106 call e_softsphere(evdw)
123 C Calculate electrostatic (H-bonding) energy of the main chain.
127 C JUYONG for dfa test!
128 if (wdfa_dist.gt.0) call edfad(edfadis)
129 c print*, 'edfad is finished!', edfadis
130 if (wdfa_tor.gt.0) call edfat(edfator)
131 c print*, 'edfat is finished!', edfator
132 if (wdfa_nei.gt.0) call edfan(edfanei)
133 c print*, 'edfan is finished!', edfanei
134 if (wdfa_beta.gt.0) call edfab(edfabet)
135 c print*, 'edfab is finished!', edfabet
139 c print *,"Processor",myrank," computed USCSC"
145 time_vec=time_vec+MPI_Wtime()-time01
147 c print *,"Processor",myrank," left VEC_AND_DERIV"
150 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
151 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
152 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
153 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
155 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
156 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
157 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
158 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
160 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
169 c write (iout,*) "Soft-spheer ELEC potential"
170 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
173 c print *,"Processor",myrank," computed UELEC"
175 C Calculate excluded-volume interaction energy between peptide groups
180 call escp(evdw2,evdw2_14)
186 c write (iout,*) "Soft-sphere SCP potential"
187 call escp_soft_sphere(evdw2,evdw2_14)
190 c Calculate the bond-stretching energy
194 C Calculate the disulfide-bridge and other energy and the contributions
195 C from other distance constraints.
196 cd print *,'Calling EHPB'
198 cd print *,'EHPB exitted succesfully.'
200 C Calculate the virtual-bond-angle energy.
202 if (wang.gt.0d0) then
207 c print *,"Processor",myrank," computed UB"
209 C Calculate the SC local energy.
212 c print *,"Processor",myrank," computed USC"
214 C Calculate the virtual-bond torsional energy.
216 cd print *,'nterm=',nterm
218 call etor(etors,edihcnstr)
223 c print *,"Processor",myrank," computed Utor"
225 C 6/23/01 Calculate double-torsional energy
227 if (wtor_d.gt.0) then
232 c print *,"Processor",myrank," computed Utord"
234 C 21/5/07 Calculate local sicdechain correlation energy
236 if (wsccor.gt.0.0d0) then
237 call eback_sc_corr(esccor)
241 c print *,"Processor",myrank," computed Usccorr"
243 C 12/1/95 Multi-body terms
247 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
248 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
249 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
250 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
251 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
258 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
259 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
260 cd write (iout,*) "multibody_hb ecorr",ecorr
262 c print *,"Processor",myrank," computed Ucorr"
264 C If performing constraint dynamics, call the constraint energy
265 C after the equilibration time
266 if(usampl.and.totT.gt.eq_time) then
274 time_enecalc=time_enecalc+MPI_Wtime()-time00
276 c print *,"Processor",myrank," computed Uconstr"
285 energia(2)=evdw2-evdw2_14
302 energia(8)=eello_turn3
303 energia(9)=eello_turn4
310 energia(19)=edihcnstr
312 energia(20)=Uconst+Uconst_back
320 c print *," Processor",myrank," calls SUM_ENERGY"
321 call sum_energy(energia,.true.)
322 c print *," Processor",myrank," left SUM_ENERGY"
324 time_sumene=time_sumene+MPI_Wtime()-time00
327 c print*, 'etot:',energia(0)
331 c-------------------------------------------------------------------------------
332 subroutine sum_energy(energia,reduce)
333 implicit real*8 (a-h,o-z)
338 cMS$ATTRIBUTES C :: proc_proc
344 include 'COMMON.SETUP'
345 include 'COMMON.IOUNITS'
346 double precision energia(0:n_ene),enebuff(0:n_ene+1)
347 include 'COMMON.FFIELD'
348 include 'COMMON.DERIV'
349 include 'COMMON.INTERACT'
350 include 'COMMON.SBRIDGE'
351 include 'COMMON.CHAIN'
353 include 'COMMON.CONTROL'
354 include 'COMMON.TIME1'
357 if (nfgtasks.gt.1 .and. reduce) then
359 write (iout,*) "energies before REDUCE"
360 call enerprint(energia)
364 enebuff(i)=energia(i)
367 call MPI_Barrier(FG_COMM,IERR)
368 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
370 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
371 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
373 write (iout,*) "energies after REDUCE"
374 call enerprint(energia)
377 time_Reduce=time_Reduce+MPI_Wtime()-time00
379 if (fg_rank.eq.0) then
382 evdw=energia(22)+wsct*energia(23)
387 evdw2=energia(2)+energia(18)
403 eello_turn3=energia(8)
404 eello_turn4=energia(9)
411 edihcnstr=energia(19)
420 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
421 & +wang*ebe+wtor*etors+wscloc*escloc
422 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
423 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
424 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
425 & +wbond*estr+Uconst+wsccor*esccor
426 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
429 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
430 & +wang*ebe+wtor*etors+wscloc*escloc
431 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
432 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
433 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
434 & +wbond*estr+Uconst+wsccor*esccor
435 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
443 if (isnan(etot).ne.0) energia(0)=1.0d+99
445 if (isnan(etot)) energia(0)=1.0d+99
450 idumm=proc_proc(etot,i)
452 call proc_proc(etot,i)
454 if(i.eq.1)energia(0)=1.0d+99
461 c-------------------------------------------------------------------------------
462 subroutine sum_gradient
463 implicit real*8 (a-h,o-z)
468 cMS$ATTRIBUTES C :: proc_proc
473 double precision gradbufc(3,maxres),gradbufx(3,maxres),
474 & glocbuf(4*maxres),gradbufc_sum(3,maxres)
476 double precision gradbufc(3,maxres),gradbufx(3,maxres),
477 & glocbuf(4*maxres),gradbufc_sum(3,maxres)
479 include 'COMMON.SETUP'
480 include 'COMMON.IOUNITS'
481 include 'COMMON.FFIELD'
482 include 'COMMON.DERIV'
483 include 'COMMON.INTERACT'
484 include 'COMMON.SBRIDGE'
485 include 'COMMON.CHAIN'
487 include 'COMMON.CONTROL'
488 include 'COMMON.TIME1'
489 include 'COMMON.MAXGRAD'
494 write (iout,*) "sum_gradient gvdwc, gvdwx"
496 write (iout,'(i3,3f10.5,5x,3f10.5,5x,3f10.5,5x,3f10.5)')
497 & i,(gvdwx(j,i),j=1,3),(gvdwcT(j,i),j=1,3),(gvdwc(j,i),j=1,3),
498 & (gvdwcT(j,i),j=1,3)
503 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
504 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
505 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
508 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
509 C in virtual-bond-vector coordinates
512 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
514 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
515 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
517 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
519 c write (iout,'(i5,3f10.5,2x,f10.5)')
520 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
522 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
524 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
525 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
534 gradbufc(j,i)=wsc*gvdwc(j,i)+wsc*wscT*gvdwcT(j,i)+
535 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
536 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
537 & wel_loc*gel_loc_long(j,i)+
538 & wcorr*gradcorr_long(j,i)+
539 & wcorr5*gradcorr5_long(j,i)+
540 & wcorr6*gradcorr6_long(j,i)+
541 & wturn6*gcorr6_turn_long(j,i)+
542 & wstrain*ghpbc(j,i)+
543 & wdfa_dist*gdfad(j,i)+
544 & wdfa_tor*gdfat(j,i)+
545 & wdfa_nei*gdfan(j,i)+
546 & wdfa_beta*gdfab(j,i)
553 gradbufc(j,i)=wsc*gvdwc(j,i)+
554 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
555 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
556 & wel_loc*gel_loc_long(j,i)+
557 & wcorr*gradcorr_long(j,i)+
558 & wcorr5*gradcorr5_long(j,i)+
559 & wcorr6*gradcorr6_long(j,i)+
560 & wturn6*gcorr6_turn_long(j,i)+
561 & wstrain*ghpbc(j,i)+
562 & wdfa_dist*gdfad(j,i)+
563 & wdfa_tor*gdfat(j,i)+
564 & wdfa_nei*gdfan(j,i)+
565 & wdfa_beta*gdfab(j,i)
573 gradbufc(j,i)=wsc*gvdwc(j,i)+
574 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
575 & welec*gelc_long(j,i)+
577 & wel_loc*gel_loc_long(j,i)+
578 & wcorr*gradcorr_long(j,i)+
579 & wcorr5*gradcorr5_long(j,i)+
580 & wcorr6*gradcorr6_long(j,i)+
581 & wturn6*gcorr6_turn_long(j,i)+
582 & wstrain*ghpbc(j,i)+
583 & wdfa_dist*gdfad(j,i)+
584 & wdfa_tor*gdfat(j,i)+
585 & wdfa_nei*gdfan(j,i)+
586 & wdfa_beta*gdfab(j,i)
593 if (nfgtasks.gt.1) then
596 write (iout,*) "gradbufc before allreduce"
598 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
602 call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
603 & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
604 time_reduce=time_reduce+MPI_Wtime()-time00
606 write (iout,*) "gradbufc_sum after allreduce"
608 write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
613 time_allreduce=time_allreduce+MPI_Wtime()-time00
620 do i=igrad_start,igrad_end
621 do j=jgrad_start(i),jgrad_end(i)
623 gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
630 write (iout,*) "gradbufc"
632 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
642 gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
650 gradbufc(k,nres)=0.0d0
655 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
656 & wel_loc*gel_loc(j,i)+
657 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
658 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
659 & wel_loc*gel_loc_long(j,i)+
660 & wcorr*gradcorr_long(j,i)+
661 & wcorr5*gradcorr5_long(j,i)+
662 & wcorr6*gradcorr6_long(j,i)+
663 & wturn6*gcorr6_turn_long(j,i))+
665 & wcorr*gradcorr(j,i)+
666 & wturn3*gcorr3_turn(j,i)+
667 & wturn4*gcorr4_turn(j,i)+
668 & wcorr5*gradcorr5(j,i)+
669 & wcorr6*gradcorr6(j,i)+
670 & wturn6*gcorr6_turn(j,i)+
671 & wsccor*gsccorc(j,i)
672 & +wscloc*gscloc(j,i)
674 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
675 & wel_loc*gel_loc(j,i)+
676 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
677 & welec*gelc_long(j,i)
678 & wel_loc*gel_loc_long(j,i)+
679 & wcorr*gcorr_long(j,i)+
680 & wcorr5*gradcorr5_long(j,i)+
681 & wcorr6*gradcorr6_long(j,i)+
682 & wturn6*gcorr6_turn_long(j,i))+
684 & wcorr*gradcorr(j,i)+
685 & wturn3*gcorr3_turn(j,i)+
686 & wturn4*gcorr4_turn(j,i)+
687 & wcorr5*gradcorr5(j,i)+
688 & wcorr6*gradcorr6(j,i)+
689 & wturn6*gcorr6_turn(j,i)+
690 & wsccor*gsccorc(j,i)
691 & +wscloc*gscloc(j,i)
694 gradx(j,i,icg)=wsc*gvdwx(j,i)+wsc*wscT*gvdwxT(j,i)+
695 & wscp*gradx_scp(j,i)+
697 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
698 & wsccor*gsccorx(j,i)
699 & +wscloc*gsclocx(j,i)
701 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
703 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
704 & wsccor*gsccorx(j,i)
705 & +wscloc*gsclocx(j,i)
710 write (iout,*) "gloc before adding corr"
712 write (iout,*) i,gloc(i,icg)
716 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
717 & +wcorr5*g_corr5_loc(i)
718 & +wcorr6*g_corr6_loc(i)
719 & +wturn4*gel_loc_turn4(i)
720 & +wturn3*gel_loc_turn3(i)
721 & +wturn6*gel_loc_turn6(i)
722 & +wel_loc*gel_loc_loc(i)
723 & +wsccor*gsccor_loc(i)
726 write (iout,*) "gloc after adding corr"
728 write (iout,*) i,gloc(i,icg)
732 if (nfgtasks.gt.1) then
735 gradbufc(j,i)=gradc(j,i,icg)
736 gradbufx(j,i)=gradx(j,i,icg)
740 glocbuf(i)=gloc(i,icg)
743 call MPI_Barrier(FG_COMM,IERR)
744 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
746 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
747 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
748 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
749 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
750 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
751 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
752 time_reduce=time_reduce+MPI_Wtime()-time00
754 write (iout,*) "gloc after reduce"
756 write (iout,*) i,gloc(i,icg)
761 if (gnorm_check) then
763 c Compute the maximum elements of the gradient
773 gcorr3_turn_max=0.0d0
774 gcorr4_turn_max=0.0d0
777 gcorr6_turn_max=0.0d0
787 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
788 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
790 gvdwc_norm=dsqrt(scalar(gvdwcT(1,i),gvdwcT(1,i)))
791 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
793 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
794 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
795 & gvdwc_scp_max=gvdwc_scp_norm
796 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
797 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
798 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
799 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
800 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
801 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
802 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
803 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
804 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
805 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
806 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
807 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
808 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
810 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
811 & gcorr3_turn_max=gcorr3_turn_norm
812 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
814 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
815 & gcorr4_turn_max=gcorr4_turn_norm
816 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
817 if (gradcorr5_norm.gt.gradcorr5_max)
818 & gradcorr5_max=gradcorr5_norm
819 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
820 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
821 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
823 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
824 & gcorr6_turn_max=gcorr6_turn_norm
825 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
826 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
827 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
828 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
829 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
830 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
832 gvdwx_norm=dsqrt(scalar(gvdwxT(1,i),gvdwxT(1,i)))
833 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
835 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
836 if (gradx_scp_norm.gt.gradx_scp_max)
837 & gradx_scp_max=gradx_scp_norm
838 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
839 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
840 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
841 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
842 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
843 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
844 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
845 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
849 open(istat,file=statname,position="append")
851 open(istat,file=statname,access="append")
853 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
854 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
855 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
856 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
857 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
858 & gsccorx_max,gsclocx_max
860 if (gvdwc_max.gt.1.0d4) then
861 write (iout,*) "gvdwc gvdwx gradb gradbx"
863 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
864 & gradb(j,i),gradbx(j,i),j=1,3)
866 call pdbout(0.0d0,'cipiszcze',iout)
872 write (iout,*) "gradc gradx gloc"
874 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
875 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
879 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
883 c-------------------------------------------------------------------------------
884 subroutine rescale_weights(t_bath)
885 implicit real*8 (a-h,o-z)
887 include 'COMMON.IOUNITS'
888 include 'COMMON.FFIELD'
889 include 'COMMON.SBRIDGE'
890 double precision kfac /2.4d0/
891 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
893 c facT=2*temp0/(t_bath+temp0)
894 if (rescale_mode.eq.0) then
900 else if (rescale_mode.eq.1) then
901 facT=kfac/(kfac-1.0d0+t_bath/temp0)
902 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
903 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
904 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
905 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
906 else if (rescale_mode.eq.2) then
912 facT=licznik/dlog(dexp(x)+dexp(-x))
913 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
914 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
915 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
916 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
918 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
919 write (*,*) "Wrong RESCALE_MODE",rescale_mode
921 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
925 welec=weights(3)*fact
926 wcorr=weights(4)*fact3
927 wcorr5=weights(5)*fact4
928 wcorr6=weights(6)*fact5
929 wel_loc=weights(7)*fact2
930 wturn3=weights(8)*fact2
931 wturn4=weights(9)*fact3
932 wturn6=weights(10)*fact5
933 wtor=weights(13)*fact
934 wtor_d=weights(14)*fact2
935 wsccor=weights(21)*fact
938 wsct=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
942 C------------------------------------------------------------------------
943 subroutine enerprint(energia)
944 implicit real*8 (a-h,o-z)
946 include 'COMMON.IOUNITS'
947 include 'COMMON.FFIELD'
948 include 'COMMON.SBRIDGE'
950 double precision energia(0:n_ene)
953 evdw=energia(22)+wsct*energia(23)
959 evdw2=energia(2)+energia(18)
971 eello_turn3=energia(8)
972 eello_turn4=energia(9)
973 eello_turn6=energia(10)
979 edihcnstr=energia(19)
984 edfadis = energia(24)
985 edfator = energia(25)
986 edfanei = energia(26)
987 edfabet = energia(27)
990 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
991 & estr,wbond,ebe,wang,
992 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
994 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
995 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
997 & Uconst,edfadis,edfator,edfanei,edfabet,etot
998 10 format (/'Virtual-chain energies:'//
999 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1000 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1001 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1002 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
1003 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1004 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1005 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1006 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1007 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1008 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1009 & ' (SS bridges & dist. cnstr.)'/
1010 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1011 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1012 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1013 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1014 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1015 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1016 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1017 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1018 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1019 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1020 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1021 & 'EDFAD= ',1pE16.6,' (DFA distance energy)'/
1022 & 'EDFAT= ',1pE16.6,' (DFA torsion energy)'/
1023 & 'EDFAN= ',1pE16.6,' (DFA NCa energy)'/
1024 & 'EDFAB= ',1pE16.6,' (DFA Beta energy)'/
1025 & 'ETOT= ',1pE16.6,' (total)')
1027 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1028 & estr,wbond,ebe,wang,
1029 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1031 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1032 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1034 & Uconst,edfadis,edfator,edfanei,edfabet,etot
1035 10 format (/'Virtual-chain energies:'//
1036 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1037 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1038 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1039 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1040 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1041 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1042 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1043 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1044 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1045 & ' (SS bridges & dist. cnstr.)'/
1046 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1047 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1048 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1049 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1050 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1051 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1052 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1053 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1054 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1055 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1056 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1057 & 'EDFAD= ',1pE16.6,' (DFA distance energy)'/
1058 & 'EDFAT= ',1pE16.6,' (DFA torsion energy)'/
1059 & 'EDFAN= ',1pE16.6,' (DFA NCa energy)'/
1060 & 'EDFAB= ',1pE16.6,' (DFA Beta energy)'/
1061 & 'ETOT= ',1pE16.6,' (total)')
1065 C-----------------------------------------------------------------------
1066 subroutine elj(evdw,evdw_p,evdw_m)
1068 C This subroutine calculates the interaction energy of nonbonded side chains
1069 C assuming the LJ potential of interaction.
1071 implicit real*8 (a-h,o-z)
1072 include 'DIMENSIONS'
1073 parameter (accur=1.0d-10)
1074 include 'COMMON.GEO'
1075 include 'COMMON.VAR'
1076 include 'COMMON.LOCAL'
1077 include 'COMMON.CHAIN'
1078 include 'COMMON.DERIV'
1079 include 'COMMON.INTERACT'
1080 include 'COMMON.TORSION'
1081 include 'COMMON.SBRIDGE'
1082 include 'COMMON.NAMES'
1083 include 'COMMON.IOUNITS'
1084 include 'COMMON.CONTACTS'
1086 include 'COMMON.CONTACTS.MOMENT'
1089 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1091 do i=iatsc_s,iatsc_e
1100 C Calculate SC interaction energy.
1102 do iint=1,nint_gr(i)
1103 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1104 cd & 'iend=',iend(i,iint)
1105 do j=istart(i,iint),iend(i,iint)
1110 C Change 12/1/95 to calculate four-body interactions
1111 rij=xj*xj+yj*yj+zj*zj
1113 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1114 eps0ij=eps(itypi,itypj)
1116 e1=fac*fac*aa(itypi,itypj)
1117 e2=fac*bb(itypi,itypj)
1119 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1120 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1121 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1122 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1123 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1124 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1126 if (bb(itypi,itypj).gt.0) then
1127 evdw_p=evdw_p+evdwij
1129 evdw_m=evdw_m+evdwij
1135 C Calculate the components of the gradient in DC and X
1137 fac=-rrij*(e1+evdwij)
1142 if (bb(itypi,itypj).gt.0.0d0) then
1144 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1145 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1146 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1147 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1151 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1152 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1153 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1154 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1159 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1160 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1161 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1162 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1167 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1171 C 12/1/95, revised on 5/20/97
1173 C Calculate the contact function. The ith column of the array JCONT will
1174 C contain the numbers of atoms that make contacts with the atom I (of numbers
1175 C greater than I). The arrays FACONT and GACONT will contain the values of
1176 C the contact function and its derivative.
1178 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1179 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1180 C Uncomment next line, if the correlation interactions are contact function only
1181 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1183 sigij=sigma(itypi,itypj)
1184 r0ij=rs0(itypi,itypj)
1186 C Check whether the SC's are not too far to make a contact.
1189 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1190 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1192 if (fcont.gt.0.0D0) then
1193 C If the SC-SC distance if close to sigma, apply spline.
1194 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1195 cAdam & fcont1,fprimcont1)
1196 cAdam fcont1=1.0d0-fcont1
1197 cAdam if (fcont1.gt.0.0d0) then
1198 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1199 cAdam fcont=fcont*fcont1
1201 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1202 cga eps0ij=1.0d0/dsqrt(eps0ij)
1204 cga gg(k)=gg(k)*eps0ij
1206 cga eps0ij=-evdwij*eps0ij
1207 C Uncomment for AL's type of SC correlation interactions.
1208 cadam eps0ij=-evdwij
1209 num_conti=num_conti+1
1210 jcont(num_conti,i)=j
1211 facont(num_conti,i)=fcont*eps0ij
1212 fprimcont=eps0ij*fprimcont/rij
1214 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1215 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1216 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1217 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1218 gacont(1,num_conti,i)=-fprimcont*xj
1219 gacont(2,num_conti,i)=-fprimcont*yj
1220 gacont(3,num_conti,i)=-fprimcont*zj
1221 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1222 cd write (iout,'(2i3,3f10.5)')
1223 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1229 num_cont(i)=num_conti
1233 gvdwc(j,i)=expon*gvdwc(j,i)
1234 gvdwx(j,i)=expon*gvdwx(j,i)
1237 C******************************************************************************
1241 C To save time, the factor of EXPON has been extracted from ALL components
1242 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1245 C******************************************************************************
1248 C-----------------------------------------------------------------------------
1249 subroutine eljk(evdw,evdw_p,evdw_m)
1251 C This subroutine calculates the interaction energy of nonbonded side chains
1252 C assuming the LJK potential of interaction.
1254 implicit real*8 (a-h,o-z)
1255 include 'DIMENSIONS'
1256 include 'COMMON.GEO'
1257 include 'COMMON.VAR'
1258 include 'COMMON.LOCAL'
1259 include 'COMMON.CHAIN'
1260 include 'COMMON.DERIV'
1261 include 'COMMON.INTERACT'
1262 include 'COMMON.IOUNITS'
1263 include 'COMMON.NAMES'
1266 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1268 do i=iatsc_s,iatsc_e
1275 C Calculate SC interaction energy.
1277 do iint=1,nint_gr(i)
1278 do j=istart(i,iint),iend(i,iint)
1283 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1284 fac_augm=rrij**expon
1285 e_augm=augm(itypi,itypj)*fac_augm
1286 r_inv_ij=dsqrt(rrij)
1288 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1289 fac=r_shift_inv**expon
1290 e1=fac*fac*aa(itypi,itypj)
1291 e2=fac*bb(itypi,itypj)
1293 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1294 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1295 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1296 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1297 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1298 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1299 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1301 if (bb(itypi,itypj).gt.0) then
1302 evdw_p=evdw_p+evdwij
1304 evdw_m=evdw_m+evdwij
1310 C Calculate the components of the gradient in DC and X
1312 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1317 if (bb(itypi,itypj).gt.0.0d0) then
1319 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1320 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1321 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1322 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1326 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1327 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1328 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1329 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1334 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1335 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1336 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1337 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1342 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1350 gvdwc(j,i)=expon*gvdwc(j,i)
1351 gvdwx(j,i)=expon*gvdwx(j,i)
1356 C-----------------------------------------------------------------------------
1357 subroutine ebp(evdw,evdw_p,evdw_m)
1359 C This subroutine calculates the interaction energy of nonbonded side chains
1360 C assuming the Berne-Pechukas potential of interaction.
1362 implicit real*8 (a-h,o-z)
1363 include 'DIMENSIONS'
1364 include 'COMMON.GEO'
1365 include 'COMMON.VAR'
1366 include 'COMMON.LOCAL'
1367 include 'COMMON.CHAIN'
1368 include 'COMMON.DERIV'
1369 include 'COMMON.NAMES'
1370 include 'COMMON.INTERACT'
1371 include 'COMMON.IOUNITS'
1372 include 'COMMON.CALC'
1373 common /srutu/ icall
1374 c double precision rrsave(maxdim)
1377 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1379 c if (icall.eq.0) then
1385 do i=iatsc_s,iatsc_e
1391 dxi=dc_norm(1,nres+i)
1392 dyi=dc_norm(2,nres+i)
1393 dzi=dc_norm(3,nres+i)
1394 c dsci_inv=dsc_inv(itypi)
1395 dsci_inv=vbld_inv(i+nres)
1397 C Calculate SC interaction energy.
1399 do iint=1,nint_gr(i)
1400 do j=istart(i,iint),iend(i,iint)
1403 c dscj_inv=dsc_inv(itypj)
1404 dscj_inv=vbld_inv(j+nres)
1405 chi1=chi(itypi,itypj)
1406 chi2=chi(itypj,itypi)
1413 alf12=0.5D0*(alf1+alf2)
1414 C For diagnostics only!!!
1427 dxj=dc_norm(1,nres+j)
1428 dyj=dc_norm(2,nres+j)
1429 dzj=dc_norm(3,nres+j)
1430 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1431 cd if (icall.eq.0) then
1437 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1439 C Calculate whole angle-dependent part of epsilon and contributions
1440 C to its derivatives
1441 fac=(rrij*sigsq)**expon2
1442 e1=fac*fac*aa(itypi,itypj)
1443 e2=fac*bb(itypi,itypj)
1444 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1445 eps2der=evdwij*eps3rt
1446 eps3der=evdwij*eps2rt
1447 evdwij=evdwij*eps2rt*eps3rt
1449 if (bb(itypi,itypj).gt.0) then
1450 evdw_p=evdw_p+evdwij
1452 evdw_m=evdw_m+evdwij
1458 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1459 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1460 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1461 cd & restyp(itypi),i,restyp(itypj),j,
1462 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1463 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1464 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1467 C Calculate gradient components.
1468 e1=e1*eps1*eps2rt**2*eps3rt**2
1469 fac=-expon*(e1+evdwij)
1472 C Calculate radial part of the gradient
1476 C Calculate the angular part of the gradient and sum add the contributions
1477 C to the appropriate components of the Cartesian gradient.
1479 if (bb(itypi,itypj).gt.0) then
1493 C-----------------------------------------------------------------------------
1494 subroutine egb(evdw,evdw_p,evdw_m)
1496 C This subroutine calculates the interaction energy of nonbonded side chains
1497 C assuming the Gay-Berne potential of interaction.
1499 implicit real*8 (a-h,o-z)
1500 include 'DIMENSIONS'
1501 include 'COMMON.GEO'
1502 include 'COMMON.VAR'
1503 include 'COMMON.LOCAL'
1504 include 'COMMON.CHAIN'
1505 include 'COMMON.DERIV'
1506 include 'COMMON.NAMES'
1507 include 'COMMON.INTERACT'
1508 include 'COMMON.IOUNITS'
1509 include 'COMMON.CALC'
1510 include 'COMMON.CONTROL'
1513 ccccc energy_dec=.false.
1514 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1519 c if (icall.eq.0) lprn=.false.
1521 do i=iatsc_s,iatsc_e
1527 dxi=dc_norm(1,nres+i)
1528 dyi=dc_norm(2,nres+i)
1529 dzi=dc_norm(3,nres+i)
1530 c dsci_inv=dsc_inv(itypi)
1531 dsci_inv=vbld_inv(i+nres)
1532 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1533 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1535 C Calculate SC interaction energy.
1537 do iint=1,nint_gr(i)
1538 do j=istart(i,iint),iend(i,iint)
1541 c dscj_inv=dsc_inv(itypj)
1542 dscj_inv=vbld_inv(j+nres)
1543 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1544 c & 1.0d0/vbld(j+nres)
1545 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1546 sig0ij=sigma(itypi,itypj)
1547 chi1=chi(itypi,itypj)
1548 chi2=chi(itypj,itypi)
1555 alf12=0.5D0*(alf1+alf2)
1556 C For diagnostics only!!!
1569 dxj=dc_norm(1,nres+j)
1570 dyj=dc_norm(2,nres+j)
1571 dzj=dc_norm(3,nres+j)
1572 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1573 c write (iout,*) "j",j," dc_norm",
1574 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1575 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1577 C Calculate angle-dependent terms of energy and contributions to their
1581 sig=sig0ij*dsqrt(sigsq)
1582 rij_shift=1.0D0/rij-sig+sig0ij
1583 c for diagnostics; uncomment
1584 c rij_shift=1.2*sig0ij
1585 C I hate to put IF's in the loops, but here don't have another choice!!!!
1586 if (rij_shift.le.0.0D0) then
1588 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1589 cd & restyp(itypi),i,restyp(itypj),j,
1590 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1594 c---------------------------------------------------------------
1595 rij_shift=1.0D0/rij_shift
1596 fac=rij_shift**expon
1597 e1=fac*fac*aa(itypi,itypj)
1598 e2=fac*bb(itypi,itypj)
1599 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1600 eps2der=evdwij*eps3rt
1601 eps3der=evdwij*eps2rt
1602 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1603 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1604 evdwij=evdwij*eps2rt*eps3rt
1606 if (bb(itypi,itypj).gt.0) then
1607 evdw_p=evdw_p+evdwij
1609 evdw_m=evdw_m+evdwij
1615 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1616 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1617 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1618 & restyp(itypi),i,restyp(itypj),j,
1619 & epsi,sigm,chi1,chi2,chip1,chip2,
1620 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1621 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1625 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1628 C Calculate gradient components.
1629 e1=e1*eps1*eps2rt**2*eps3rt**2
1630 fac=-expon*(e1+evdwij)*rij_shift
1634 C Calculate the radial part of the gradient
1638 C Calculate angular part of the gradient.
1640 if (bb(itypi,itypj).gt.0) then
1651 c write (iout,*) "Number of loop steps in EGB:",ind
1652 cccc energy_dec=.false.
1655 C-----------------------------------------------------------------------------
1656 subroutine egbv(evdw,evdw_p,evdw_m)
1658 C This subroutine calculates the interaction energy of nonbonded side chains
1659 C assuming the Gay-Berne-Vorobjev potential of interaction.
1661 implicit real*8 (a-h,o-z)
1662 include 'DIMENSIONS'
1663 include 'COMMON.GEO'
1664 include 'COMMON.VAR'
1665 include 'COMMON.LOCAL'
1666 include 'COMMON.CHAIN'
1667 include 'COMMON.DERIV'
1668 include 'COMMON.NAMES'
1669 include 'COMMON.INTERACT'
1670 include 'COMMON.IOUNITS'
1671 include 'COMMON.CALC'
1672 common /srutu/ icall
1675 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1678 c if (icall.eq.0) lprn=.true.
1680 do i=iatsc_s,iatsc_e
1686 dxi=dc_norm(1,nres+i)
1687 dyi=dc_norm(2,nres+i)
1688 dzi=dc_norm(3,nres+i)
1689 c dsci_inv=dsc_inv(itypi)
1690 dsci_inv=vbld_inv(i+nres)
1692 C Calculate SC interaction energy.
1694 do iint=1,nint_gr(i)
1695 do j=istart(i,iint),iend(i,iint)
1698 c dscj_inv=dsc_inv(itypj)
1699 dscj_inv=vbld_inv(j+nres)
1700 sig0ij=sigma(itypi,itypj)
1701 r0ij=r0(itypi,itypj)
1702 chi1=chi(itypi,itypj)
1703 chi2=chi(itypj,itypi)
1710 alf12=0.5D0*(alf1+alf2)
1711 C For diagnostics only!!!
1724 dxj=dc_norm(1,nres+j)
1725 dyj=dc_norm(2,nres+j)
1726 dzj=dc_norm(3,nres+j)
1727 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1729 C Calculate angle-dependent terms of energy and contributions to their
1733 sig=sig0ij*dsqrt(sigsq)
1734 rij_shift=1.0D0/rij-sig+r0ij
1735 C I hate to put IF's in the loops, but here don't have another choice!!!!
1736 if (rij_shift.le.0.0D0) then
1741 c---------------------------------------------------------------
1742 rij_shift=1.0D0/rij_shift
1743 fac=rij_shift**expon
1744 e1=fac*fac*aa(itypi,itypj)
1745 e2=fac*bb(itypi,itypj)
1746 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1747 eps2der=evdwij*eps3rt
1748 eps3der=evdwij*eps2rt
1749 fac_augm=rrij**expon
1750 e_augm=augm(itypi,itypj)*fac_augm
1751 evdwij=evdwij*eps2rt*eps3rt
1753 if (bb(itypi,itypj).gt.0) then
1754 evdw_p=evdw_p+evdwij+e_augm
1756 evdw_m=evdw_m+evdwij+e_augm
1759 evdw=evdw+evdwij+e_augm
1762 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1763 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1764 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1765 & restyp(itypi),i,restyp(itypj),j,
1766 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1767 & chi1,chi2,chip1,chip2,
1768 & eps1,eps2rt**2,eps3rt**2,
1769 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1772 C Calculate gradient components.
1773 e1=e1*eps1*eps2rt**2*eps3rt**2
1774 fac=-expon*(e1+evdwij)*rij_shift
1776 fac=rij*fac-2*expon*rrij*e_augm
1777 C Calculate the radial part of the gradient
1781 C Calculate angular part of the gradient.
1783 if (bb(itypi,itypj).gt.0) then
1795 C-----------------------------------------------------------------------------
1796 subroutine sc_angular
1797 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1798 C om12. Called by ebp, egb, and egbv.
1800 include 'COMMON.CALC'
1801 include 'COMMON.IOUNITS'
1805 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1806 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1807 om12=dxi*dxj+dyi*dyj+dzi*dzj
1809 C Calculate eps1(om12) and its derivative in om12
1810 faceps1=1.0D0-om12*chiom12
1811 faceps1_inv=1.0D0/faceps1
1812 eps1=dsqrt(faceps1_inv)
1813 C Following variable is eps1*deps1/dom12
1814 eps1_om12=faceps1_inv*chiom12
1819 c write (iout,*) "om12",om12," eps1",eps1
1820 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1825 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1826 sigsq=1.0D0-facsig*faceps1_inv
1827 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1828 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1829 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1835 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1836 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1838 C Calculate eps2 and its derivatives in om1, om2, and om12.
1841 chipom12=chip12*om12
1842 facp=1.0D0-om12*chipom12
1844 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1845 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1846 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1847 C Following variable is the square root of eps2
1848 eps2rt=1.0D0-facp1*facp_inv
1849 C Following three variables are the derivatives of the square root of eps
1850 C in om1, om2, and om12.
1851 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1852 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1853 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1854 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1855 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1856 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1857 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1858 c & " eps2rt_om12",eps2rt_om12
1859 C Calculate whole angle-dependent part of epsilon and contributions
1860 C to its derivatives
1864 C----------------------------------------------------------------------------
1865 subroutine sc_grad_T
1866 implicit real*8 (a-h,o-z)
1867 include 'DIMENSIONS'
1868 include 'COMMON.CHAIN'
1869 include 'COMMON.DERIV'
1870 include 'COMMON.CALC'
1871 include 'COMMON.IOUNITS'
1872 double precision dcosom1(3),dcosom2(3)
1873 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1874 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1875 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1876 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1880 c eom12=evdwij*eps1_om12
1882 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1883 c & " sigder",sigder
1884 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1885 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1887 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1888 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1891 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1893 c write (iout,*) "gg",(gg(k),k=1,3)
1895 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1896 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1897 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1898 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1899 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1900 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1901 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1902 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1903 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1904 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1907 C Calculate the components of the gradient in DC and X
1911 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1915 gvdwcT(l,i)=gvdwcT(l,i)-gg(l)
1916 gvdwcT(l,j)=gvdwcT(l,j)+gg(l)
1921 C----------------------------------------------------------------------------
1923 implicit real*8 (a-h,o-z)
1924 include 'DIMENSIONS'
1925 include 'COMMON.CHAIN'
1926 include 'COMMON.DERIV'
1927 include 'COMMON.CALC'
1928 include 'COMMON.IOUNITS'
1929 double precision dcosom1(3),dcosom2(3)
1930 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1931 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1932 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1933 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1937 c eom12=evdwij*eps1_om12
1939 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1940 c & " sigder",sigder
1941 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1942 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1944 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1945 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1948 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1950 c write (iout,*) "gg",(gg(k),k=1,3)
1952 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1953 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1954 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1955 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1956 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1957 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1958 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1959 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1960 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1961 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1964 C Calculate the components of the gradient in DC and X
1968 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1972 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1973 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1977 C-----------------------------------------------------------------------
1978 subroutine e_softsphere(evdw)
1980 C This subroutine calculates the interaction energy of nonbonded side chains
1981 C assuming the LJ potential of interaction.
1983 implicit real*8 (a-h,o-z)
1984 include 'DIMENSIONS'
1985 parameter (accur=1.0d-10)
1986 include 'COMMON.GEO'
1987 include 'COMMON.VAR'
1988 include 'COMMON.LOCAL'
1989 include 'COMMON.CHAIN'
1990 include 'COMMON.DERIV'
1991 include 'COMMON.INTERACT'
1992 include 'COMMON.TORSION'
1993 include 'COMMON.SBRIDGE'
1994 include 'COMMON.NAMES'
1995 include 'COMMON.IOUNITS'
1996 include 'COMMON.CONTACTS'
1998 include 'COMMON.CONTACTS.MOMENT'
2001 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2003 do i=iatsc_s,iatsc_e
2010 C Calculate SC interaction energy.
2012 do iint=1,nint_gr(i)
2013 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2014 cd & 'iend=',iend(i,iint)
2015 do j=istart(i,iint),iend(i,iint)
2020 rij=xj*xj+yj*yj+zj*zj
2021 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2022 r0ij=r0(itypi,itypj)
2024 c print *,i,j,r0ij,dsqrt(rij)
2025 if (rij.lt.r0ijsq) then
2026 evdwij=0.25d0*(rij-r0ijsq)**2
2034 C Calculate the components of the gradient in DC and X
2040 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2041 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2042 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2043 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2047 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2055 C--------------------------------------------------------------------------
2056 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2059 C Soft-sphere potential of p-p interaction
2061 implicit real*8 (a-h,o-z)
2062 include 'DIMENSIONS'
2063 include 'COMMON.CONTROL'
2064 include 'COMMON.IOUNITS'
2065 include 'COMMON.GEO'
2066 include 'COMMON.VAR'
2067 include 'COMMON.LOCAL'
2068 include 'COMMON.CHAIN'
2069 include 'COMMON.DERIV'
2070 include 'COMMON.INTERACT'
2071 include 'COMMON.CONTACTS'
2073 include 'COMMON.CONTACTS.MOMENT'
2075 include 'COMMON.TORSION'
2076 include 'COMMON.VECTORS'
2077 include 'COMMON.FFIELD'
2079 cd write(iout,*) 'In EELEC_soft_sphere'
2086 do i=iatel_s,iatel_e
2090 xmedi=c(1,i)+0.5d0*dxi
2091 ymedi=c(2,i)+0.5d0*dyi
2092 zmedi=c(3,i)+0.5d0*dzi
2094 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2095 do j=ielstart(i),ielend(i)
2099 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2100 r0ij=rpp(iteli,itelj)
2105 xj=c(1,j)+0.5D0*dxj-xmedi
2106 yj=c(2,j)+0.5D0*dyj-ymedi
2107 zj=c(3,j)+0.5D0*dzj-zmedi
2108 rij=xj*xj+yj*yj+zj*zj
2109 if (rij.lt.r0ijsq) then
2110 evdw1ij=0.25d0*(rij-r0ijsq)**2
2118 C Calculate contributions to the Cartesian gradient.
2124 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2125 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2128 * Loop over residues i+1 thru j-1.
2132 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2137 cgrad do i=nnt,nct-1
2139 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2141 cgrad do j=i+1,nct-1
2143 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2149 c------------------------------------------------------------------------------
2150 subroutine vec_and_deriv
2151 implicit real*8 (a-h,o-z)
2152 include 'DIMENSIONS'
2156 include 'COMMON.IOUNITS'
2157 include 'COMMON.GEO'
2158 include 'COMMON.VAR'
2159 include 'COMMON.LOCAL'
2160 include 'COMMON.CHAIN'
2161 include 'COMMON.VECTORS'
2162 include 'COMMON.SETUP'
2163 include 'COMMON.TIME1'
2164 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2165 C Compute the local reference systems. For reference system (i), the
2166 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2167 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2169 do i=ivec_start,ivec_end
2173 if (i.eq.nres-1) then
2174 C Case of the last full residue
2175 C Compute the Z-axis
2176 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2177 costh=dcos(pi-theta(nres))
2178 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2182 C Compute the derivatives of uz
2184 uzder(2,1,1)=-dc_norm(3,i-1)
2185 uzder(3,1,1)= dc_norm(2,i-1)
2186 uzder(1,2,1)= dc_norm(3,i-1)
2188 uzder(3,2,1)=-dc_norm(1,i-1)
2189 uzder(1,3,1)=-dc_norm(2,i-1)
2190 uzder(2,3,1)= dc_norm(1,i-1)
2193 uzder(2,1,2)= dc_norm(3,i)
2194 uzder(3,1,2)=-dc_norm(2,i)
2195 uzder(1,2,2)=-dc_norm(3,i)
2197 uzder(3,2,2)= dc_norm(1,i)
2198 uzder(1,3,2)= dc_norm(2,i)
2199 uzder(2,3,2)=-dc_norm(1,i)
2201 C Compute the Y-axis
2204 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2206 C Compute the derivatives of uy
2209 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2210 & -dc_norm(k,i)*dc_norm(j,i-1)
2211 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2213 uyder(j,j,1)=uyder(j,j,1)-costh
2214 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2219 uygrad(l,k,j,i)=uyder(l,k,j)
2220 uzgrad(l,k,j,i)=uzder(l,k,j)
2224 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2225 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2226 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2227 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2230 C Compute the Z-axis
2231 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2232 costh=dcos(pi-theta(i+2))
2233 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2237 C Compute the derivatives of uz
2239 uzder(2,1,1)=-dc_norm(3,i+1)
2240 uzder(3,1,1)= dc_norm(2,i+1)
2241 uzder(1,2,1)= dc_norm(3,i+1)
2243 uzder(3,2,1)=-dc_norm(1,i+1)
2244 uzder(1,3,1)=-dc_norm(2,i+1)
2245 uzder(2,3,1)= dc_norm(1,i+1)
2248 uzder(2,1,2)= dc_norm(3,i)
2249 uzder(3,1,2)=-dc_norm(2,i)
2250 uzder(1,2,2)=-dc_norm(3,i)
2252 uzder(3,2,2)= dc_norm(1,i)
2253 uzder(1,3,2)= dc_norm(2,i)
2254 uzder(2,3,2)=-dc_norm(1,i)
2256 C Compute the Y-axis
2259 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2261 C Compute the derivatives of uy
2264 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2265 & -dc_norm(k,i)*dc_norm(j,i+1)
2266 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2268 uyder(j,j,1)=uyder(j,j,1)-costh
2269 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2274 uygrad(l,k,j,i)=uyder(l,k,j)
2275 uzgrad(l,k,j,i)=uzder(l,k,j)
2279 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2280 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2281 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2282 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2286 vbld_inv_temp(1)=vbld_inv(i+1)
2287 if (i.lt.nres-1) then
2288 vbld_inv_temp(2)=vbld_inv(i+2)
2290 vbld_inv_temp(2)=vbld_inv(i)
2295 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2296 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2301 #if defined(PARVEC) && defined(MPI)
2302 if (nfgtasks1.gt.1) then
2304 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2305 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2306 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2307 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2308 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2310 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2311 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2313 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2314 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2315 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2316 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2317 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2318 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2319 time_gather=time_gather+MPI_Wtime()-time00
2321 c if (fg_rank.eq.0) then
2322 c write (iout,*) "Arrays UY and UZ"
2324 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2331 C-----------------------------------------------------------------------------
2332 subroutine check_vecgrad
2333 implicit real*8 (a-h,o-z)
2334 include 'DIMENSIONS'
2335 include 'COMMON.IOUNITS'
2336 include 'COMMON.GEO'
2337 include 'COMMON.VAR'
2338 include 'COMMON.LOCAL'
2339 include 'COMMON.CHAIN'
2340 include 'COMMON.VECTORS'
2341 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2342 dimension uyt(3,maxres),uzt(3,maxres)
2343 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2344 double precision delta /1.0d-7/
2347 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2348 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2349 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2350 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2351 cd & (dc_norm(if90,i),if90=1,3)
2352 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2353 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2354 cd write(iout,'(a)')
2360 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2361 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2374 cd write (iout,*) 'i=',i
2376 erij(k)=dc_norm(k,i)
2380 dc_norm(k,i)=erij(k)
2382 dc_norm(j,i)=dc_norm(j,i)+delta
2383 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2385 c dc_norm(k,i)=dc_norm(k,i)/fac
2387 c write (iout,*) (dc_norm(k,i),k=1,3)
2388 c write (iout,*) (erij(k),k=1,3)
2391 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2392 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2393 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2394 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2396 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2397 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2398 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2401 dc_norm(k,i)=erij(k)
2404 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2405 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2406 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2407 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2408 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2409 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2410 cd write (iout,'(a)')
2415 C--------------------------------------------------------------------------
2416 subroutine set_matrices
2417 implicit real*8 (a-h,o-z)
2418 include 'DIMENSIONS'
2421 include "COMMON.SETUP"
2423 integer status(MPI_STATUS_SIZE)
2425 include 'COMMON.IOUNITS'
2426 include 'COMMON.GEO'
2427 include 'COMMON.VAR'
2428 include 'COMMON.LOCAL'
2429 include 'COMMON.CHAIN'
2430 include 'COMMON.DERIV'
2431 include 'COMMON.INTERACT'
2432 include 'COMMON.CONTACTS'
2434 include 'COMMON.CONTACTS.MOMENT'
2436 include 'COMMON.TORSION'
2437 include 'COMMON.VECTORS'
2438 include 'COMMON.FFIELD'
2439 double precision auxvec(2),auxmat(2,2)
2441 C Compute the virtual-bond-torsional-angle dependent quantities needed
2442 C to calculate the el-loc multibody terms of various order.
2445 do i=ivec_start+2,ivec_end+2
2449 if (i .lt. nres+1) then
2486 if (i .gt. 3 .and. i .lt. nres+1) then
2487 obrot_der(1,i-2)=-sin1
2488 obrot_der(2,i-2)= cos1
2489 Ugder(1,1,i-2)= sin1
2490 Ugder(1,2,i-2)=-cos1
2491 Ugder(2,1,i-2)=-cos1
2492 Ugder(2,2,i-2)=-sin1
2495 obrot2_der(1,i-2)=-dwasin2
2496 obrot2_der(2,i-2)= dwacos2
2497 Ug2der(1,1,i-2)= dwasin2
2498 Ug2der(1,2,i-2)=-dwacos2
2499 Ug2der(2,1,i-2)=-dwacos2
2500 Ug2der(2,2,i-2)=-dwasin2
2502 obrot_der(1,i-2)=0.0d0
2503 obrot_der(2,i-2)=0.0d0
2504 Ugder(1,1,i-2)=0.0d0
2505 Ugder(1,2,i-2)=0.0d0
2506 Ugder(2,1,i-2)=0.0d0
2507 Ugder(2,2,i-2)=0.0d0
2508 obrot2_der(1,i-2)=0.0d0
2509 obrot2_der(2,i-2)=0.0d0
2510 Ug2der(1,1,i-2)=0.0d0
2511 Ug2der(1,2,i-2)=0.0d0
2512 Ug2der(2,1,i-2)=0.0d0
2513 Ug2der(2,2,i-2)=0.0d0
2515 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2516 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2517 iti = itortyp(itype(i-2))
2521 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2522 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2523 iti1 = itortyp(itype(i-1))
2527 cd write (iout,*) '*******i',i,' iti1',iti
2528 cd write (iout,*) 'b1',b1(:,iti)
2529 cd write (iout,*) 'b2',b2(:,iti)
2530 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2531 c if (i .gt. iatel_s+2) then
2532 if (i .gt. nnt+2) then
2533 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2534 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2535 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2537 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2538 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2539 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2540 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2541 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2552 DtUg2(l,k,i-2)=0.0d0
2556 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2557 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2559 muder(k,i-2)=Ub2der(k,i-2)
2561 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2562 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2563 iti1 = itortyp(itype(i-1))
2568 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2570 cd write (iout,*) 'mu ',mu(:,i-2)
2571 cd write (iout,*) 'mu1',mu1(:,i-2)
2572 cd write (iout,*) 'mu2',mu2(:,i-2)
2573 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2575 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2576 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2577 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2578 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2579 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2580 C Vectors and matrices dependent on a single virtual-bond dihedral.
2581 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2582 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2583 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2584 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2585 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2586 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2587 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2588 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2589 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2592 C Matrices dependent on two consecutive virtual-bond dihedrals.
2593 C The order of matrices is from left to right.
2594 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2596 c do i=max0(ivec_start,2),ivec_end
2598 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2599 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2600 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2601 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2602 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2603 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2604 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2605 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2608 #if defined(MPI) && defined(PARMAT)
2610 c if (fg_rank.eq.0) then
2611 write (iout,*) "Arrays UG and UGDER before GATHER"
2613 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2614 & ((ug(l,k,i),l=1,2),k=1,2),
2615 & ((ugder(l,k,i),l=1,2),k=1,2)
2617 write (iout,*) "Arrays UG2 and UG2DER"
2619 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2620 & ((ug2(l,k,i),l=1,2),k=1,2),
2621 & ((ug2der(l,k,i),l=1,2),k=1,2)
2623 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2625 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2626 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2627 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2629 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2631 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2632 & costab(i),sintab(i),costab2(i),sintab2(i)
2634 write (iout,*) "Array MUDER"
2636 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2640 if (nfgtasks.gt.1) then
2642 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2643 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2644 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2646 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2647 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2649 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2650 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2652 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2653 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2655 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2656 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2658 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2659 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2661 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2662 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2664 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2665 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2666 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2667 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2668 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2669 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2670 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2671 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2672 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2673 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2674 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2675 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2676 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2678 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2679 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2681 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2682 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2684 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2685 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2687 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2688 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2690 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2691 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2693 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2694 & ivec_count(fg_rank1),
2695 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2697 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2698 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2700 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2701 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2703 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2704 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2706 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2707 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2709 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2710 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2712 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2713 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2715 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2716 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2718 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2719 & ivec_count(fg_rank1),
2720 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2722 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2723 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2725 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2726 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2728 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2729 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2731 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2732 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2734 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2735 & ivec_count(fg_rank1),
2736 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2738 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2739 & ivec_count(fg_rank1),
2740 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2742 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2743 & ivec_count(fg_rank1),
2744 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2745 & MPI_MAT2,FG_COMM1,IERR)
2746 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2747 & ivec_count(fg_rank1),
2748 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2749 & MPI_MAT2,FG_COMM1,IERR)
2752 c Passes matrix info through the ring
2755 if (irecv.lt.0) irecv=nfgtasks1-1
2758 if (inext.ge.nfgtasks1) inext=0
2760 c write (iout,*) "isend",isend," irecv",irecv
2762 lensend=lentyp(isend)
2763 lenrecv=lentyp(irecv)
2764 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2765 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2766 c & MPI_ROTAT1(lensend),inext,2200+isend,
2767 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2768 c & iprev,2200+irecv,FG_COMM,status,IERR)
2769 c write (iout,*) "Gather ROTAT1"
2771 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2772 c & MPI_ROTAT2(lensend),inext,3300+isend,
2773 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2774 c & iprev,3300+irecv,FG_COMM,status,IERR)
2775 c write (iout,*) "Gather ROTAT2"
2777 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2778 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2779 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2780 & iprev,4400+irecv,FG_COMM,status,IERR)
2781 c write (iout,*) "Gather ROTAT_OLD"
2783 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2784 & MPI_PRECOMP11(lensend),inext,5500+isend,
2785 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2786 & iprev,5500+irecv,FG_COMM,status,IERR)
2787 c write (iout,*) "Gather PRECOMP11"
2789 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2790 & MPI_PRECOMP12(lensend),inext,6600+isend,
2791 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2792 & iprev,6600+irecv,FG_COMM,status,IERR)
2793 c write (iout,*) "Gather PRECOMP12"
2795 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2797 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2798 & MPI_ROTAT2(lensend),inext,7700+isend,
2799 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2800 & iprev,7700+irecv,FG_COMM,status,IERR)
2801 c write (iout,*) "Gather PRECOMP21"
2803 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2804 & MPI_PRECOMP22(lensend),inext,8800+isend,
2805 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2806 & iprev,8800+irecv,FG_COMM,status,IERR)
2807 c write (iout,*) "Gather PRECOMP22"
2809 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2810 & MPI_PRECOMP23(lensend),inext,9900+isend,
2811 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2812 & MPI_PRECOMP23(lenrecv),
2813 & iprev,9900+irecv,FG_COMM,status,IERR)
2814 c write (iout,*) "Gather PRECOMP23"
2819 if (irecv.lt.0) irecv=nfgtasks1-1
2822 time_gather=time_gather+MPI_Wtime()-time00
2825 c if (fg_rank.eq.0) then
2826 write (iout,*) "Arrays UG and UGDER"
2828 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2829 & ((ug(l,k,i),l=1,2),k=1,2),
2830 & ((ugder(l,k,i),l=1,2),k=1,2)
2832 write (iout,*) "Arrays UG2 and UG2DER"
2834 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2835 & ((ug2(l,k,i),l=1,2),k=1,2),
2836 & ((ug2der(l,k,i),l=1,2),k=1,2)
2838 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2840 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2841 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2842 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2844 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2846 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2847 & costab(i),sintab(i),costab2(i),sintab2(i)
2849 write (iout,*) "Array MUDER"
2851 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2857 cd iti = itortyp(itype(i))
2860 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2861 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2866 C--------------------------------------------------------------------------
2867 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2869 C This subroutine calculates the average interaction energy and its gradient
2870 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2871 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2872 C The potential depends both on the distance of peptide-group centers and on
2873 C the orientation of the CA-CA virtual bonds.
2875 implicit real*8 (a-h,o-z)
2879 include 'DIMENSIONS'
2880 include 'COMMON.CONTROL'
2881 include 'COMMON.SETUP'
2882 include 'COMMON.IOUNITS'
2883 include 'COMMON.GEO'
2884 include 'COMMON.VAR'
2885 include 'COMMON.LOCAL'
2886 include 'COMMON.CHAIN'
2887 include 'COMMON.DERIV'
2888 include 'COMMON.INTERACT'
2889 include 'COMMON.CONTACTS'
2891 include 'COMMON.CONTACTS.MOMENT'
2893 include 'COMMON.TORSION'
2894 include 'COMMON.VECTORS'
2895 include 'COMMON.FFIELD'
2896 include 'COMMON.TIME1'
2897 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2898 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2899 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2900 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2901 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2902 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2904 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2906 double precision scal_el /1.0d0/
2908 double precision scal_el /0.5d0/
2911 C 13-go grudnia roku pamietnego...
2912 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2913 & 0.0d0,1.0d0,0.0d0,
2914 & 0.0d0,0.0d0,1.0d0/
2915 cd write(iout,*) 'In EELEC'
2917 cd write(iout,*) 'Type',i
2918 cd write(iout,*) 'B1',B1(:,i)
2919 cd write(iout,*) 'B2',B2(:,i)
2920 cd write(iout,*) 'CC',CC(:,:,i)
2921 cd write(iout,*) 'DD',DD(:,:,i)
2922 cd write(iout,*) 'EE',EE(:,:,i)
2924 cd call check_vecgrad
2926 if (icheckgrad.eq.1) then
2928 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2930 dc_norm(k,i)=dc(k,i)*fac
2932 c write (iout,*) 'i',i,' fac',fac
2935 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2936 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2937 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2938 c call vec_and_deriv
2944 time_mat=time_mat+MPI_Wtime()-time01
2948 cd write (iout,*) 'i=',i
2950 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2953 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2954 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2967 cd print '(a)','Enter EELEC'
2968 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2970 gel_loc_loc(i)=0.0d0
2975 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2977 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2979 do i=iturn3_start,iturn3_end
2983 dx_normi=dc_norm(1,i)
2984 dy_normi=dc_norm(2,i)
2985 dz_normi=dc_norm(3,i)
2986 xmedi=c(1,i)+0.5d0*dxi
2987 ymedi=c(2,i)+0.5d0*dyi
2988 zmedi=c(3,i)+0.5d0*dzi
2990 call eelecij(i,i+2,ees,evdw1,eel_loc)
2991 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2992 num_cont_hb(i)=num_conti
2994 do i=iturn4_start,iturn4_end
2998 dx_normi=dc_norm(1,i)
2999 dy_normi=dc_norm(2,i)
3000 dz_normi=dc_norm(3,i)
3001 xmedi=c(1,i)+0.5d0*dxi
3002 ymedi=c(2,i)+0.5d0*dyi
3003 zmedi=c(3,i)+0.5d0*dzi
3004 num_conti=num_cont_hb(i)
3005 call eelecij(i,i+3,ees,evdw1,eel_loc)
3006 if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
3007 num_cont_hb(i)=num_conti
3010 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3012 do i=iatel_s,iatel_e
3016 dx_normi=dc_norm(1,i)
3017 dy_normi=dc_norm(2,i)
3018 dz_normi=dc_norm(3,i)
3019 xmedi=c(1,i)+0.5d0*dxi
3020 ymedi=c(2,i)+0.5d0*dyi
3021 zmedi=c(3,i)+0.5d0*dzi
3022 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3023 num_conti=num_cont_hb(i)
3024 do j=ielstart(i),ielend(i)
3025 call eelecij(i,j,ees,evdw1,eel_loc)
3027 num_cont_hb(i)=num_conti
3029 c write (iout,*) "Number of loop steps in EELEC:",ind
3031 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3032 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3034 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3035 ccc eel_loc=eel_loc+eello_turn3
3036 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3039 C-------------------------------------------------------------------------------
3040 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3041 implicit real*8 (a-h,o-z)
3042 include 'DIMENSIONS'
3046 include 'COMMON.CONTROL'
3047 include 'COMMON.IOUNITS'
3048 include 'COMMON.GEO'
3049 include 'COMMON.VAR'
3050 include 'COMMON.LOCAL'
3051 include 'COMMON.CHAIN'
3052 include 'COMMON.DERIV'
3053 include 'COMMON.INTERACT'
3054 include 'COMMON.CONTACTS'
3056 include 'COMMON.CONTACTS.MOMENT'
3058 include 'COMMON.TORSION'
3059 include 'COMMON.VECTORS'
3060 include 'COMMON.FFIELD'
3061 include 'COMMON.TIME1'
3062 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3063 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3064 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3065 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3066 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3067 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3069 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3071 double precision scal_el /1.0d0/
3073 double precision scal_el /0.5d0/
3076 C 13-go grudnia roku pamietnego...
3077 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3078 & 0.0d0,1.0d0,0.0d0,
3079 & 0.0d0,0.0d0,1.0d0/
3080 c time00=MPI_Wtime()
3081 cd write (iout,*) "eelecij",i,j
3085 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3086 aaa=app(iteli,itelj)
3087 bbb=bpp(iteli,itelj)
3088 ael6i=ael6(iteli,itelj)
3089 ael3i=ael3(iteli,itelj)
3093 dx_normj=dc_norm(1,j)
3094 dy_normj=dc_norm(2,j)
3095 dz_normj=dc_norm(3,j)
3096 xj=c(1,j)+0.5D0*dxj-xmedi
3097 yj=c(2,j)+0.5D0*dyj-ymedi
3098 zj=c(3,j)+0.5D0*dzj-zmedi
3099 rij=xj*xj+yj*yj+zj*zj
3105 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3106 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3107 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3108 fac=cosa-3.0D0*cosb*cosg
3110 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3111 if (j.eq.i+2) ev1=scal_el*ev1
3116 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3119 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3120 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3123 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3124 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3125 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3126 cd & xmedi,ymedi,zmedi,xj,yj,zj
3128 if (energy_dec) then
3129 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3130 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3134 C Calculate contributions to the Cartesian gradient.
3137 facvdw=-6*rrmij*(ev1+evdwij)
3138 facel=-3*rrmij*(el1+eesij)
3144 * Radial derivatives. First process both termini of the fragment (i,j)
3150 c ghalf=0.5D0*ggg(k)
3151 c gelc(k,i)=gelc(k,i)+ghalf
3152 c gelc(k,j)=gelc(k,j)+ghalf
3154 c 9/28/08 AL Gradient compotents will be summed only at the end
3156 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3157 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3160 * Loop over residues i+1 thru j-1.
3164 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3171 c ghalf=0.5D0*ggg(k)
3172 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3173 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3175 c 9/28/08 AL Gradient compotents will be summed only at the end
3177 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3178 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3181 * Loop over residues i+1 thru j-1.
3185 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3192 fac=-3*rrmij*(facvdw+facvdw+facel)
3197 * Radial derivatives. First process both termini of the fragment (i,j)
3203 c ghalf=0.5D0*ggg(k)
3204 c gelc(k,i)=gelc(k,i)+ghalf
3205 c gelc(k,j)=gelc(k,j)+ghalf
3207 c 9/28/08 AL Gradient compotents will be summed only at the end
3209 gelc_long(k,j)=gelc(k,j)+ggg(k)
3210 gelc_long(k,i)=gelc(k,i)-ggg(k)
3213 * Loop over residues i+1 thru j-1.
3217 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3220 c 9/28/08 AL Gradient compotents will be summed only at the end
3225 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3226 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3232 ecosa=2.0D0*fac3*fac1+fac4
3235 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3236 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3238 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3239 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3241 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3242 cd & (dcosg(k),k=1,3)
3244 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3247 c ghalf=0.5D0*ggg(k)
3248 c gelc(k,i)=gelc(k,i)+ghalf
3249 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3250 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3251 c gelc(k,j)=gelc(k,j)+ghalf
3252 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3253 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3257 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3262 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3263 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3265 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3266 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3267 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3268 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3270 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3271 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3272 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3274 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3275 C energy of a peptide unit is assumed in the form of a second-order
3276 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3277 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3278 C are computed for EVERY pair of non-contiguous peptide groups.
3280 if (j.lt.nres-1) then
3291 muij(kkk)=mu(k,i)*mu(l,j)
3294 cd write (iout,*) 'EELEC: i',i,' j',j
3295 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3296 cd write(iout,*) 'muij',muij
3297 ury=scalar(uy(1,i),erij)
3298 urz=scalar(uz(1,i),erij)
3299 vry=scalar(uy(1,j),erij)
3300 vrz=scalar(uz(1,j),erij)
3301 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3302 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3303 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3304 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3305 fac=dsqrt(-ael6i)*r3ij
3310 cd write (iout,'(4i5,4f10.5)')
3311 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3312 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3313 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3314 cd & uy(:,j),uz(:,j)
3315 cd write (iout,'(4f10.5)')
3316 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3317 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3318 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3319 cd write (iout,'(9f10.5/)')
3320 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3321 C Derivatives of the elements of A in virtual-bond vectors
3322 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3324 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3325 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3326 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3327 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3328 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3329 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3330 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3331 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3332 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3333 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3334 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3335 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3337 C Compute radial contributions to the gradient
3355 C Add the contributions coming from er
3358 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3359 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3360 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3361 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3364 C Derivatives in DC(i)
3365 cgrad ghalf1=0.5d0*agg(k,1)
3366 cgrad ghalf2=0.5d0*agg(k,2)
3367 cgrad ghalf3=0.5d0*agg(k,3)
3368 cgrad ghalf4=0.5d0*agg(k,4)
3369 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3370 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3371 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3372 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3373 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3374 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3375 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3376 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3377 C Derivatives in DC(i+1)
3378 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3379 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3380 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3381 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3382 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3383 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3384 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3385 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3386 C Derivatives in DC(j)
3387 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3388 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3389 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3390 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3391 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3392 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3393 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3394 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3395 C Derivatives in DC(j+1) or DC(nres-1)
3396 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3397 & -3.0d0*vryg(k,3)*ury)
3398 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3399 & -3.0d0*vrzg(k,3)*ury)
3400 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3401 & -3.0d0*vryg(k,3)*urz)
3402 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3403 & -3.0d0*vrzg(k,3)*urz)
3404 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3406 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3419 aggi(k,l)=-aggi(k,l)
3420 aggi1(k,l)=-aggi1(k,l)
3421 aggj(k,l)=-aggj(k,l)
3422 aggj1(k,l)=-aggj1(k,l)
3425 if (j.lt.nres-1) then
3431 aggi(k,l)=-aggi(k,l)
3432 aggi1(k,l)=-aggi1(k,l)
3433 aggj(k,l)=-aggj(k,l)
3434 aggj1(k,l)=-aggj1(k,l)
3445 aggi(k,l)=-aggi(k,l)
3446 aggi1(k,l)=-aggi1(k,l)
3447 aggj(k,l)=-aggj(k,l)
3448 aggj1(k,l)=-aggj1(k,l)
3453 IF (wel_loc.gt.0.0d0) THEN
3454 C Contribution to the local-electrostatic energy coming from the i-j pair
3455 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3457 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3459 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3460 & 'eelloc',i,j,eel_loc_ij
3462 eel_loc=eel_loc+eel_loc_ij
3463 C Partial derivatives in virtual-bond dihedral angles gamma
3465 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3466 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3467 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3468 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3469 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3470 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3471 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3473 ggg(l)=agg(l,1)*muij(1)+
3474 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3475 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3476 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3477 cgrad ghalf=0.5d0*ggg(l)
3478 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3479 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3483 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3486 C Remaining derivatives of eello
3488 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3489 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3490 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3491 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3492 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3493 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3494 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3495 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3498 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3499 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3500 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3501 & .and. num_conti.le.maxconts) then
3502 c write (iout,*) i,j," entered corr"
3504 C Calculate the contact function. The ith column of the array JCONT will
3505 C contain the numbers of atoms that make contacts with the atom I (of numbers
3506 C greater than I). The arrays FACONT and GACONT will contain the values of
3507 C the contact function and its derivative.
3508 c r0ij=1.02D0*rpp(iteli,itelj)
3509 c r0ij=1.11D0*rpp(iteli,itelj)
3510 r0ij=2.20D0*rpp(iteli,itelj)
3511 c r0ij=1.55D0*rpp(iteli,itelj)
3512 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3513 if (fcont.gt.0.0D0) then
3514 num_conti=num_conti+1
3515 if (num_conti.gt.maxconts) then
3516 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3517 & ' will skip next contacts for this conf.'
3519 jcont_hb(num_conti,i)=j
3520 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3521 cd & " jcont_hb",jcont_hb(num_conti,i)
3522 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3523 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3524 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3526 d_cont(num_conti,i)=rij
3527 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3528 C --- Electrostatic-interaction matrix ---
3529 a_chuj(1,1,num_conti,i)=a22
3530 a_chuj(1,2,num_conti,i)=a23
3531 a_chuj(2,1,num_conti,i)=a32
3532 a_chuj(2,2,num_conti,i)=a33
3533 C --- Gradient of rij
3535 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3542 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3543 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3544 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3545 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3546 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3551 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3552 C Calculate contact energies
3554 wij=cosa-3.0D0*cosb*cosg
3557 c fac3=dsqrt(-ael6i)/r0ij**3
3558 fac3=dsqrt(-ael6i)*r3ij
3559 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3560 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3561 if (ees0tmp.gt.0) then
3562 ees0pij=dsqrt(ees0tmp)
3566 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3567 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3568 if (ees0tmp.gt.0) then
3569 ees0mij=dsqrt(ees0tmp)
3574 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3575 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3576 C Diagnostics. Comment out or remove after debugging!
3577 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3578 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3579 c ees0m(num_conti,i)=0.0D0
3581 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3582 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3583 C Angular derivatives of the contact function
3584 ees0pij1=fac3/ees0pij
3585 ees0mij1=fac3/ees0mij
3586 fac3p=-3.0D0*fac3*rrmij
3587 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3588 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3590 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3591 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3592 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3593 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3594 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3595 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3596 ecosap=ecosa1+ecosa2
3597 ecosbp=ecosb1+ecosb2
3598 ecosgp=ecosg1+ecosg2
3599 ecosam=ecosa1-ecosa2
3600 ecosbm=ecosb1-ecosb2
3601 ecosgm=ecosg1-ecosg2
3610 facont_hb(num_conti,i)=fcont
3611 fprimcont=fprimcont/rij
3612 cd facont_hb(num_conti,i)=1.0D0
3613 C Following line is for diagnostics.
3616 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3617 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3620 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3621 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3623 gggp(1)=gggp(1)+ees0pijp*xj
3624 gggp(2)=gggp(2)+ees0pijp*yj
3625 gggp(3)=gggp(3)+ees0pijp*zj
3626 gggm(1)=gggm(1)+ees0mijp*xj
3627 gggm(2)=gggm(2)+ees0mijp*yj
3628 gggm(3)=gggm(3)+ees0mijp*zj
3629 C Derivatives due to the contact function
3630 gacont_hbr(1,num_conti,i)=fprimcont*xj
3631 gacont_hbr(2,num_conti,i)=fprimcont*yj
3632 gacont_hbr(3,num_conti,i)=fprimcont*zj
3635 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3636 c following the change of gradient-summation algorithm.
3638 cgrad ghalfp=0.5D0*gggp(k)
3639 cgrad ghalfm=0.5D0*gggm(k)
3640 gacontp_hb1(k,num_conti,i)=!ghalfp
3641 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3642 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3643 gacontp_hb2(k,num_conti,i)=!ghalfp
3644 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3645 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3646 gacontp_hb3(k,num_conti,i)=gggp(k)
3647 gacontm_hb1(k,num_conti,i)=!ghalfm
3648 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3649 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3650 gacontm_hb2(k,num_conti,i)=!ghalfm
3651 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3652 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3653 gacontm_hb3(k,num_conti,i)=gggm(k)
3655 C Diagnostics. Comment out or remove after debugging!
3657 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3658 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3659 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3660 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3661 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3662 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3665 endif ! num_conti.le.maxconts
3668 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3671 ghalf=0.5d0*agg(l,k)
3672 aggi(l,k)=aggi(l,k)+ghalf
3673 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3674 aggj(l,k)=aggj(l,k)+ghalf
3677 if (j.eq.nres-1 .and. i.lt.j-2) then
3680 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3685 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3688 C-----------------------------------------------------------------------------
3689 subroutine eturn3(i,eello_turn3)
3690 C Third- and fourth-order contributions from turns
3691 implicit real*8 (a-h,o-z)
3692 include 'DIMENSIONS'
3693 include 'COMMON.IOUNITS'
3694 include 'COMMON.GEO'
3695 include 'COMMON.VAR'
3696 include 'COMMON.LOCAL'
3697 include 'COMMON.CHAIN'
3698 include 'COMMON.DERIV'
3699 include 'COMMON.INTERACT'
3700 include 'COMMON.CONTACTS'
3702 include 'COMMON.CONTACTS.MOMENT'
3704 include 'COMMON.TORSION'
3705 include 'COMMON.VECTORS'
3706 include 'COMMON.FFIELD'
3707 include 'COMMON.CONTROL'
3709 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3710 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3711 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3712 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3713 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3714 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3715 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3718 c write (iout,*) "eturn3",i,j,j1,j2
3723 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3725 C Third-order contributions
3732 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3733 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3734 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3735 call transpose2(auxmat(1,1),auxmat1(1,1))
3736 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3737 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3738 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3739 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3740 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3741 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3742 cd & ' eello_turn3_num',4*eello_turn3_num
3743 C Derivatives in gamma(i)
3744 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3745 call transpose2(auxmat2(1,1),auxmat3(1,1))
3746 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3747 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3748 C Derivatives in gamma(i+1)
3749 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3750 call transpose2(auxmat2(1,1),auxmat3(1,1))
3751 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3752 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3753 & +0.5d0*(pizda(1,1)+pizda(2,2))
3754 C Cartesian derivatives
3756 c ghalf1=0.5d0*agg(l,1)
3757 c ghalf2=0.5d0*agg(l,2)
3758 c ghalf3=0.5d0*agg(l,3)
3759 c ghalf4=0.5d0*agg(l,4)
3760 a_temp(1,1)=aggi(l,1)!+ghalf1
3761 a_temp(1,2)=aggi(l,2)!+ghalf2
3762 a_temp(2,1)=aggi(l,3)!+ghalf3
3763 a_temp(2,2)=aggi(l,4)!+ghalf4
3764 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3765 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3766 & +0.5d0*(pizda(1,1)+pizda(2,2))
3767 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3768 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3769 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3770 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3771 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3772 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3773 & +0.5d0*(pizda(1,1)+pizda(2,2))
3774 a_temp(1,1)=aggj(l,1)!+ghalf1
3775 a_temp(1,2)=aggj(l,2)!+ghalf2
3776 a_temp(2,1)=aggj(l,3)!+ghalf3
3777 a_temp(2,2)=aggj(l,4)!+ghalf4
3778 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3779 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3780 & +0.5d0*(pizda(1,1)+pizda(2,2))
3781 a_temp(1,1)=aggj1(l,1)
3782 a_temp(1,2)=aggj1(l,2)
3783 a_temp(2,1)=aggj1(l,3)
3784 a_temp(2,2)=aggj1(l,4)
3785 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3786 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3787 & +0.5d0*(pizda(1,1)+pizda(2,2))
3791 C-------------------------------------------------------------------------------
3792 subroutine eturn4(i,eello_turn4)
3793 C Third- and fourth-order contributions from turns
3794 implicit real*8 (a-h,o-z)
3795 include 'DIMENSIONS'
3796 include 'COMMON.IOUNITS'
3797 include 'COMMON.GEO'
3798 include 'COMMON.VAR'
3799 include 'COMMON.LOCAL'
3800 include 'COMMON.CHAIN'
3801 include 'COMMON.DERIV'
3802 include 'COMMON.INTERACT'
3803 include 'COMMON.CONTACTS'
3805 include 'COMMON.CONTACTS.MOMENT'
3807 include 'COMMON.TORSION'
3808 include 'COMMON.VECTORS'
3809 include 'COMMON.FFIELD'
3810 include 'COMMON.CONTROL'
3812 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3813 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3814 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3815 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3816 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3817 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3818 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3821 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3823 C Fourth-order contributions
3831 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3832 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3833 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3838 iti1=itortyp(itype(i+1))
3839 iti2=itortyp(itype(i+2))
3840 iti3=itortyp(itype(i+3))
3841 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3842 call transpose2(EUg(1,1,i+1),e1t(1,1))
3843 call transpose2(Eug(1,1,i+2),e2t(1,1))
3844 call transpose2(Eug(1,1,i+3),e3t(1,1))
3845 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3846 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3847 s1=scalar2(b1(1,iti2),auxvec(1))
3848 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3849 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3850 s2=scalar2(b1(1,iti1),auxvec(1))
3851 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3852 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3853 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3854 eello_turn4=eello_turn4-(s1+s2+s3)
3855 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3856 & 'eturn4',i,j,-(s1+s2+s3)
3857 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3858 cd & ' eello_turn4_num',8*eello_turn4_num
3859 C Derivatives in gamma(i)
3860 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3861 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3862 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3863 s1=scalar2(b1(1,iti2),auxvec(1))
3864 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3865 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3866 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3867 C Derivatives in gamma(i+1)
3868 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3869 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3870 s2=scalar2(b1(1,iti1),auxvec(1))
3871 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3872 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3873 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3874 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3875 C Derivatives in gamma(i+2)
3876 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3877 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3878 s1=scalar2(b1(1,iti2),auxvec(1))
3879 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3880 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3881 s2=scalar2(b1(1,iti1),auxvec(1))
3882 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3883 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3884 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3885 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3886 C Cartesian derivatives
3887 C Derivatives of this turn contributions in DC(i+2)
3888 if (j.lt.nres-1) then
3890 a_temp(1,1)=agg(l,1)
3891 a_temp(1,2)=agg(l,2)
3892 a_temp(2,1)=agg(l,3)
3893 a_temp(2,2)=agg(l,4)
3894 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3895 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3896 s1=scalar2(b1(1,iti2),auxvec(1))
3897 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3898 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3899 s2=scalar2(b1(1,iti1),auxvec(1))
3900 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3901 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3902 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3904 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3907 C Remaining derivatives of this turn contribution
3909 a_temp(1,1)=aggi(l,1)
3910 a_temp(1,2)=aggi(l,2)
3911 a_temp(2,1)=aggi(l,3)
3912 a_temp(2,2)=aggi(l,4)
3913 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3914 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3915 s1=scalar2(b1(1,iti2),auxvec(1))
3916 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3917 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3918 s2=scalar2(b1(1,iti1),auxvec(1))
3919 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3920 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3921 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3922 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3923 a_temp(1,1)=aggi1(l,1)
3924 a_temp(1,2)=aggi1(l,2)
3925 a_temp(2,1)=aggi1(l,3)
3926 a_temp(2,2)=aggi1(l,4)
3927 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3928 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3929 s1=scalar2(b1(1,iti2),auxvec(1))
3930 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3931 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3932 s2=scalar2(b1(1,iti1),auxvec(1))
3933 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3934 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3935 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3936 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3937 a_temp(1,1)=aggj(l,1)
3938 a_temp(1,2)=aggj(l,2)
3939 a_temp(2,1)=aggj(l,3)
3940 a_temp(2,2)=aggj(l,4)
3941 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3942 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3943 s1=scalar2(b1(1,iti2),auxvec(1))
3944 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3945 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3946 s2=scalar2(b1(1,iti1),auxvec(1))
3947 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3948 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3949 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3950 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3951 a_temp(1,1)=aggj1(l,1)
3952 a_temp(1,2)=aggj1(l,2)
3953 a_temp(2,1)=aggj1(l,3)
3954 a_temp(2,2)=aggj1(l,4)
3955 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3956 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3957 s1=scalar2(b1(1,iti2),auxvec(1))
3958 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3959 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3960 s2=scalar2(b1(1,iti1),auxvec(1))
3961 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3962 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3963 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3964 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3965 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3969 C-----------------------------------------------------------------------------
3970 subroutine vecpr(u,v,w)
3971 implicit real*8(a-h,o-z)
3972 dimension u(3),v(3),w(3)
3973 w(1)=u(2)*v(3)-u(3)*v(2)
3974 w(2)=-u(1)*v(3)+u(3)*v(1)
3975 w(3)=u(1)*v(2)-u(2)*v(1)
3978 C-----------------------------------------------------------------------------
3979 subroutine unormderiv(u,ugrad,unorm,ungrad)
3980 C This subroutine computes the derivatives of a normalized vector u, given
3981 C the derivatives computed without normalization conditions, ugrad. Returns
3984 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3985 double precision vec(3)
3986 double precision scalar
3988 c write (2,*) 'ugrad',ugrad
3991 vec(i)=scalar(ugrad(1,i),u(1))
3993 c write (2,*) 'vec',vec
3996 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3999 c write (2,*) 'ungrad',ungrad
4002 C-----------------------------------------------------------------------------
4003 subroutine escp_soft_sphere(evdw2,evdw2_14)
4005 C This subroutine calculates the excluded-volume interaction energy between
4006 C peptide-group centers and side chains and its gradient in virtual-bond and
4007 C side-chain vectors.
4009 implicit real*8 (a-h,o-z)
4010 include 'DIMENSIONS'
4011 include 'COMMON.GEO'
4012 include 'COMMON.VAR'
4013 include 'COMMON.LOCAL'
4014 include 'COMMON.CHAIN'
4015 include 'COMMON.DERIV'
4016 include 'COMMON.INTERACT'
4017 include 'COMMON.FFIELD'
4018 include 'COMMON.IOUNITS'
4019 include 'COMMON.CONTROL'
4024 cd print '(a)','Enter ESCP'
4025 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4026 do i=iatscp_s,iatscp_e
4028 xi=0.5D0*(c(1,i)+c(1,i+1))
4029 yi=0.5D0*(c(2,i)+c(2,i+1))
4030 zi=0.5D0*(c(3,i)+c(3,i+1))
4032 do iint=1,nscp_gr(i)
4034 do j=iscpstart(i,iint),iscpend(i,iint)
4036 C Uncomment following three lines for SC-p interactions
4040 C Uncomment following three lines for Ca-p interactions
4044 rij=xj*xj+yj*yj+zj*zj
4047 if (rij.lt.r0ijsq) then
4048 evdwij=0.25d0*(rij-r0ijsq)**2
4056 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4061 cgrad if (j.lt.i) then
4062 cd write (iout,*) 'j<i'
4063 C Uncomment following three lines for SC-p interactions
4065 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4068 cd write (iout,*) 'j>i'
4070 cgrad ggg(k)=-ggg(k)
4071 C Uncomment following line for SC-p interactions
4072 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4076 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4078 cgrad kstart=min0(i+1,j)
4079 cgrad kend=max0(i-1,j-1)
4080 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4081 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4082 cgrad do k=kstart,kend
4084 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4088 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4089 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4097 C-----------------------------------------------------------------------------
4098 subroutine escp(evdw2,evdw2_14)
4100 C This subroutine calculates the excluded-volume interaction energy between
4101 C peptide-group centers and side chains and its gradient in virtual-bond and
4102 C side-chain vectors.
4104 implicit real*8 (a-h,o-z)
4105 include 'DIMENSIONS'
4106 include 'COMMON.GEO'
4107 include 'COMMON.VAR'
4108 include 'COMMON.LOCAL'
4109 include 'COMMON.CHAIN'
4110 include 'COMMON.DERIV'
4111 include 'COMMON.INTERACT'
4112 include 'COMMON.FFIELD'
4113 include 'COMMON.IOUNITS'
4114 include 'COMMON.CONTROL'
4118 cd print '(a)','Enter ESCP'
4119 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4120 do i=iatscp_s,iatscp_e
4122 xi=0.5D0*(c(1,i)+c(1,i+1))
4123 yi=0.5D0*(c(2,i)+c(2,i+1))
4124 zi=0.5D0*(c(3,i)+c(3,i+1))
4126 do iint=1,nscp_gr(i)
4128 do j=iscpstart(i,iint),iscpend(i,iint)
4130 C Uncomment following three lines for SC-p interactions
4134 C Uncomment following three lines for Ca-p interactions
4138 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4140 e1=fac*fac*aad(itypj,iteli)
4141 e2=fac*bad(itypj,iteli)
4142 if (iabs(j-i) .le. 2) then
4145 evdw2_14=evdw2_14+e1+e2
4149 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4150 & 'evdw2',i,j,evdwij
4152 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4154 fac=-(evdwij+e1)*rrij
4158 cgrad if (j.lt.i) then
4159 cd write (iout,*) 'j<i'
4160 C Uncomment following three lines for SC-p interactions
4162 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4165 cd write (iout,*) 'j>i'
4167 cgrad ggg(k)=-ggg(k)
4168 C Uncomment following line for SC-p interactions
4169 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4170 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4174 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4176 cgrad kstart=min0(i+1,j)
4177 cgrad kend=max0(i-1,j-1)
4178 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4179 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4180 cgrad do k=kstart,kend
4182 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4186 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4187 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4195 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4196 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4197 gradx_scp(j,i)=expon*gradx_scp(j,i)
4200 C******************************************************************************
4204 C To save time the factor EXPON has been extracted from ALL components
4205 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4208 C******************************************************************************
4211 C--------------------------------------------------------------------------
4212 subroutine edis(ehpb)
4214 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4216 implicit real*8 (a-h,o-z)
4217 include 'DIMENSIONS'
4218 include 'COMMON.SBRIDGE'
4219 include 'COMMON.CHAIN'
4220 include 'COMMON.DERIV'
4221 include 'COMMON.VAR'
4222 include 'COMMON.INTERACT'
4223 include 'COMMON.IOUNITS'
4226 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4227 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4228 if (link_end.eq.0) return
4229 do i=link_start,link_end
4230 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4231 C CA-CA distance used in regularization of structure.
4234 C iii and jjj point to the residues for which the distance is assigned.
4235 if (ii.gt.nres) then
4242 cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj
4243 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4244 C distance and angle dependent SS bond potential.
4245 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4246 call ssbond_ene(iii,jjj,eij)
4248 cd write (iout,*) "eij",eij
4250 C Calculate the distance between the two points and its difference from the
4254 C Get the force constant corresponding to this distance.
4256 C Calculate the contribution to energy.
4257 ehpb=ehpb+waga*rdis*rdis
4259 C Evaluate gradient.
4262 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4263 cd & ' waga=',waga,' fac=',fac
4265 ggg(j)=fac*(c(j,jj)-c(j,ii))
4267 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4268 C If this is a SC-SC distance, we need to calculate the contributions to the
4269 C Cartesian gradient in the SC vectors (ghpbx).
4272 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4273 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4276 cgrad do j=iii,jjj-1
4278 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4282 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4283 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4290 C--------------------------------------------------------------------------
4291 subroutine ssbond_ene(i,j,eij)
4293 C Calculate the distance and angle dependent SS-bond potential energy
4294 C using a free-energy function derived based on RHF/6-31G** ab initio
4295 C calculations of diethyl disulfide.
4297 C A. Liwo and U. Kozlowska, 11/24/03
4299 implicit real*8 (a-h,o-z)
4300 include 'DIMENSIONS'
4301 include 'COMMON.SBRIDGE'
4302 include 'COMMON.CHAIN'
4303 include 'COMMON.DERIV'
4304 include 'COMMON.LOCAL'
4305 include 'COMMON.INTERACT'
4306 include 'COMMON.VAR'
4307 include 'COMMON.IOUNITS'
4308 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4313 dxi=dc_norm(1,nres+i)
4314 dyi=dc_norm(2,nres+i)
4315 dzi=dc_norm(3,nres+i)
4316 c dsci_inv=dsc_inv(itypi)
4317 dsci_inv=vbld_inv(nres+i)
4319 c dscj_inv=dsc_inv(itypj)
4320 dscj_inv=vbld_inv(nres+j)
4324 dxj=dc_norm(1,nres+j)
4325 dyj=dc_norm(2,nres+j)
4326 dzj=dc_norm(3,nres+j)
4327 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4332 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4333 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4334 om12=dxi*dxj+dyi*dyj+dzi*dzj
4336 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4337 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4343 deltat12=om2-om1+2.0d0
4345 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4346 & +akct*deltad*deltat12
4347 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4348 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4349 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4350 c & " deltat12",deltat12," eij",eij
4351 ed=2*akcm*deltad+akct*deltat12
4353 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4354 eom1=-2*akth*deltat1-pom1-om2*pom2
4355 eom2= 2*akth*deltat2+pom1-om1*pom2
4358 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4359 ghpbx(k,i)=ghpbx(k,i)-ggk
4360 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4361 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4362 ghpbx(k,j)=ghpbx(k,j)+ggk
4363 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4364 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4365 ghpbc(k,i)=ghpbc(k,i)-ggk
4366 ghpbc(k,j)=ghpbc(k,j)+ggk
4369 C Calculate the components of the gradient in DC and X
4373 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4378 C--------------------------------------------------------------------------
4379 subroutine ebond(estr)
4381 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4383 implicit real*8 (a-h,o-z)
4384 include 'DIMENSIONS'
4385 include 'COMMON.LOCAL'
4386 include 'COMMON.GEO'
4387 include 'COMMON.INTERACT'
4388 include 'COMMON.DERIV'
4389 include 'COMMON.VAR'
4390 include 'COMMON.CHAIN'
4391 include 'COMMON.IOUNITS'
4392 include 'COMMON.NAMES'
4393 include 'COMMON.FFIELD'
4394 include 'COMMON.CONTROL'
4395 include 'COMMON.SETUP'
4396 double precision u(3),ud(3)
4398 do i=ibondp_start,ibondp_end
4399 diff = vbld(i)-vbldp0
4400 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4403 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4405 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4409 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4411 do i=ibond_start,ibond_end
4416 diff=vbld(i+nres)-vbldsc0(1,iti)
4417 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4418 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4419 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4421 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4425 diff=vbld(i+nres)-vbldsc0(j,iti)
4426 ud(j)=aksc(j,iti)*diff
4427 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4441 uprod2=uprod2*u(k)*u(k)
4445 usumsqder=usumsqder+ud(j)*uprod2
4447 estr=estr+uprod/usum
4449 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4457 C--------------------------------------------------------------------------
4458 subroutine ebend(etheta)
4460 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4461 C angles gamma and its derivatives in consecutive thetas and gammas.
4463 implicit real*8 (a-h,o-z)
4464 include 'DIMENSIONS'
4465 include 'COMMON.LOCAL'
4466 include 'COMMON.GEO'
4467 include 'COMMON.INTERACT'
4468 include 'COMMON.DERIV'
4469 include 'COMMON.VAR'
4470 include 'COMMON.CHAIN'
4471 include 'COMMON.IOUNITS'
4472 include 'COMMON.NAMES'
4473 include 'COMMON.FFIELD'
4474 include 'COMMON.CONTROL'
4475 common /calcthet/ term1,term2,termm,diffak,ratak,
4476 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4477 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4478 double precision y(2),z(2)
4480 c time11=dexp(-2*time)
4483 c write (*,'(a,i2)') 'EBEND ICG=',icg
4484 do i=ithet_start,ithet_end
4485 C Zero the energy function and its derivative at 0 or pi.
4486 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4491 if (phii.ne.phii) phii=150.0
4504 if (phii1.ne.phii1) phii1=150.0
4516 C Calculate the "mean" value of theta from the part of the distribution
4517 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4518 C In following comments this theta will be referred to as t_c.
4519 thet_pred_mean=0.0d0
4523 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4525 dthett=thet_pred_mean*ssd
4526 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4527 C Derivatives of the "mean" values in gamma1 and gamma2.
4528 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4529 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4530 if (theta(i).gt.pi-delta) then
4531 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4533 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4534 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4535 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4537 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4539 else if (theta(i).lt.delta) then
4540 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4541 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4542 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4544 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4545 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4548 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4551 etheta=etheta+ethetai
4552 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4554 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4555 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4556 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4558 C Ufff.... We've done all this!!!
4561 C---------------------------------------------------------------------------
4562 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4564 implicit real*8 (a-h,o-z)
4565 include 'DIMENSIONS'
4566 include 'COMMON.LOCAL'
4567 include 'COMMON.IOUNITS'
4568 common /calcthet/ term1,term2,termm,diffak,ratak,
4569 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4570 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4571 C Calculate the contributions to both Gaussian lobes.
4572 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4573 C The "polynomial part" of the "standard deviation" of this part of
4577 sig=sig*thet_pred_mean+polthet(j,it)
4579 C Derivative of the "interior part" of the "standard deviation of the"
4580 C gamma-dependent Gaussian lobe in t_c.
4581 sigtc=3*polthet(3,it)
4583 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4586 C Set the parameters of both Gaussian lobes of the distribution.
4587 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4588 fac=sig*sig+sigc0(it)
4591 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4592 sigsqtc=-4.0D0*sigcsq*sigtc
4593 c print *,i,sig,sigtc,sigsqtc
4594 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4595 sigtc=-sigtc/(fac*fac)
4596 C Following variable is sigma(t_c)**(-2)
4597 sigcsq=sigcsq*sigcsq
4599 sig0inv=1.0D0/sig0i**2
4600 delthec=thetai-thet_pred_mean
4601 delthe0=thetai-theta0i
4602 term1=-0.5D0*sigcsq*delthec*delthec
4603 term2=-0.5D0*sig0inv*delthe0*delthe0
4604 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4605 C NaNs in taking the logarithm. We extract the largest exponent which is added
4606 C to the energy (this being the log of the distribution) at the end of energy
4607 C term evaluation for this virtual-bond angle.
4608 if (term1.gt.term2) then
4610 term2=dexp(term2-termm)
4614 term1=dexp(term1-termm)
4617 C The ratio between the gamma-independent and gamma-dependent lobes of
4618 C the distribution is a Gaussian function of thet_pred_mean too.
4619 diffak=gthet(2,it)-thet_pred_mean
4620 ratak=diffak/gthet(3,it)**2
4621 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4622 C Let's differentiate it in thet_pred_mean NOW.
4624 C Now put together the distribution terms to make complete distribution.
4625 termexp=term1+ak*term2
4626 termpre=sigc+ak*sig0i
4627 C Contribution of the bending energy from this theta is just the -log of
4628 C the sum of the contributions from the two lobes and the pre-exponential
4629 C factor. Simple enough, isn't it?
4630 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4631 C NOW the derivatives!!!
4632 C 6/6/97 Take into account the deformation.
4633 E_theta=(delthec*sigcsq*term1
4634 & +ak*delthe0*sig0inv*term2)/termexp
4635 E_tc=((sigtc+aktc*sig0i)/termpre
4636 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4637 & aktc*term2)/termexp)
4640 c-----------------------------------------------------------------------------
4641 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4642 implicit real*8 (a-h,o-z)
4643 include 'DIMENSIONS'
4644 include 'COMMON.LOCAL'
4645 include 'COMMON.IOUNITS'
4646 common /calcthet/ term1,term2,termm,diffak,ratak,
4647 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4648 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4649 delthec=thetai-thet_pred_mean
4650 delthe0=thetai-theta0i
4651 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4652 t3 = thetai-thet_pred_mean
4656 t14 = t12+t6*sigsqtc
4658 t21 = thetai-theta0i
4664 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4665 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4666 & *(-t12*t9-ak*sig0inv*t27)
4670 C--------------------------------------------------------------------------
4671 subroutine ebend(etheta)
4673 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4674 C angles gamma and its derivatives in consecutive thetas and gammas.
4675 C ab initio-derived potentials from
4676 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4678 implicit real*8 (a-h,o-z)
4679 include 'DIMENSIONS'
4680 include 'COMMON.LOCAL'
4681 include 'COMMON.GEO'
4682 include 'COMMON.INTERACT'
4683 include 'COMMON.DERIV'
4684 include 'COMMON.VAR'
4685 include 'COMMON.CHAIN'
4686 include 'COMMON.IOUNITS'
4687 include 'COMMON.NAMES'
4688 include 'COMMON.FFIELD'
4689 include 'COMMON.CONTROL'
4690 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4691 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4692 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4693 & sinph1ph2(maxdouble,maxdouble)
4694 logical lprn /.false./, lprn1 /.false./
4696 do i=ithet_start,ithet_end
4700 theti2=0.5d0*theta(i)
4701 ityp2=ithetyp(itype(i-1))
4703 coskt(k)=dcos(k*theti2)
4704 sinkt(k)=dsin(k*theti2)
4709 if (phii.ne.phii) phii=150.0
4713 ityp1=ithetyp(itype(i-2))
4715 cosph1(k)=dcos(k*phii)
4716 sinph1(k)=dsin(k*phii)
4729 if (phii1.ne.phii1) phii1=150.0
4734 ityp3=ithetyp(itype(i))
4736 cosph2(k)=dcos(k*phii1)
4737 sinph2(k)=dsin(k*phii1)
4747 ethetai=aa0thet(ityp1,ityp2,ityp3)
4750 ccl=cosph1(l)*cosph2(k-l)
4751 ssl=sinph1(l)*sinph2(k-l)
4752 scl=sinph1(l)*cosph2(k-l)
4753 csl=cosph1(l)*sinph2(k-l)
4754 cosph1ph2(l,k)=ccl-ssl
4755 cosph1ph2(k,l)=ccl+ssl
4756 sinph1ph2(l,k)=scl+csl
4757 sinph1ph2(k,l)=scl-csl
4761 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4762 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4763 write (iout,*) "coskt and sinkt"
4765 write (iout,*) k,coskt(k),sinkt(k)
4769 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4770 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4773 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4774 & " ethetai",ethetai
4777 write (iout,*) "cosph and sinph"
4779 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4781 write (iout,*) "cosph1ph2 and sinph2ph2"
4784 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4785 & sinph1ph2(l,k),sinph1ph2(k,l)
4788 write(iout,*) "ethetai",ethetai
4792 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4793 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4794 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4795 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4796 ethetai=ethetai+sinkt(m)*aux
4797 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4798 dephii=dephii+k*sinkt(m)*(
4799 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4800 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4801 dephii1=dephii1+k*sinkt(m)*(
4802 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4803 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4805 & write (iout,*) "m",m," k",k," bbthet",
4806 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4807 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4808 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4809 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4813 & write(iout,*) "ethetai",ethetai
4817 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4818 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4819 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4820 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4821 ethetai=ethetai+sinkt(m)*aux
4822 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4823 dephii=dephii+l*sinkt(m)*(
4824 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4825 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4826 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4827 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4828 dephii1=dephii1+(k-l)*sinkt(m)*(
4829 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4830 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4831 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4832 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4834 write (iout,*) "m",m," k",k," l",l," ffthet",
4835 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4836 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4837 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4838 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4839 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4840 & cosph1ph2(k,l)*sinkt(m),
4841 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4847 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4848 & i,theta(i)*rad2deg,phii*rad2deg,
4849 & phii1*rad2deg,ethetai
4850 etheta=etheta+ethetai
4851 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4852 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4853 gloc(nphi+i-2,icg)=wang*dethetai
4859 c-----------------------------------------------------------------------------
4860 subroutine esc(escloc)
4861 C Calculate the local energy of a side chain and its derivatives in the
4862 C corresponding virtual-bond valence angles THETA and the spherical angles
4864 implicit real*8 (a-h,o-z)
4865 include 'DIMENSIONS'
4866 include 'COMMON.GEO'
4867 include 'COMMON.LOCAL'
4868 include 'COMMON.VAR'
4869 include 'COMMON.INTERACT'
4870 include 'COMMON.DERIV'
4871 include 'COMMON.CHAIN'
4872 include 'COMMON.IOUNITS'
4873 include 'COMMON.NAMES'
4874 include 'COMMON.FFIELD'
4875 include 'COMMON.CONTROL'
4876 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4877 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4878 common /sccalc/ time11,time12,time112,theti,it,nlobit
4881 c write (iout,'(a)') 'ESC'
4882 do i=loc_start,loc_end
4884 if (it.eq.10) goto 1
4886 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4887 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4888 theti=theta(i+1)-pipol
4893 if (x(2).gt.pi-delta) then
4897 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4899 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4900 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4902 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4903 & ddersc0(1),dersc(1))
4904 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4905 & ddersc0(3),dersc(3))
4907 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4909 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4910 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4911 & dersc0(2),esclocbi,dersc02)
4912 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4914 call splinthet(x(2),0.5d0*delta,ss,ssd)
4919 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4921 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4922 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4924 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4926 c write (iout,*) escloci
4927 else if (x(2).lt.delta) then
4931 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4933 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4934 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4936 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4937 & ddersc0(1),dersc(1))
4938 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4939 & ddersc0(3),dersc(3))
4941 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4943 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4944 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4945 & dersc0(2),esclocbi,dersc02)
4946 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4951 call splinthet(x(2),0.5d0*delta,ss,ssd)
4953 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4955 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4956 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4958 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4959 c write (iout,*) escloci
4961 call enesc(x,escloci,dersc,ddummy,.false.)
4964 escloc=escloc+escloci
4965 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4966 & 'escloc',i,escloci
4967 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4969 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4971 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4972 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4977 C---------------------------------------------------------------------------
4978 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4979 implicit real*8 (a-h,o-z)
4980 include 'DIMENSIONS'
4981 include 'COMMON.GEO'
4982 include 'COMMON.LOCAL'
4983 include 'COMMON.IOUNITS'
4984 common /sccalc/ time11,time12,time112,theti,it,nlobit
4985 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4986 double precision contr(maxlob,-1:1)
4988 c write (iout,*) 'it=',it,' nlobit=',nlobit
4992 if (mixed) ddersc(j)=0.0d0
4996 C Because of periodicity of the dependence of the SC energy in omega we have
4997 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4998 C To avoid underflows, first compute & store the exponents.
5006 z(k)=x(k)-censc(k,j,it)
5011 Axk=Axk+gaussc(l,k,j,it)*z(l)
5017 expfac=expfac+Ax(k,j,iii)*z(k)
5025 C As in the case of ebend, we want to avoid underflows in exponentiation and
5026 C subsequent NaNs and INFs in energy calculation.
5027 C Find the largest exponent
5031 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5035 cd print *,'it=',it,' emin=',emin
5037 C Compute the contribution to SC energy and derivatives
5042 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
5043 if(adexp.ne.adexp) adexp=1.0
5046 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
5048 cd print *,'j=',j,' expfac=',expfac
5049 escloc_i=escloc_i+expfac
5051 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5055 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5056 & +gaussc(k,2,j,it))*expfac
5063 dersc(1)=dersc(1)/cos(theti)**2
5064 ddersc(1)=ddersc(1)/cos(theti)**2
5067 escloci=-(dlog(escloc_i)-emin)
5069 dersc(j)=dersc(j)/escloc_i
5073 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5078 C------------------------------------------------------------------------------
5079 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5080 implicit real*8 (a-h,o-z)
5081 include 'DIMENSIONS'
5082 include 'COMMON.GEO'
5083 include 'COMMON.LOCAL'
5084 include 'COMMON.IOUNITS'
5085 common /sccalc/ time11,time12,time112,theti,it,nlobit
5086 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5087 double precision contr(maxlob)
5098 z(k)=x(k)-censc(k,j,it)
5104 Axk=Axk+gaussc(l,k,j,it)*z(l)
5110 expfac=expfac+Ax(k,j)*z(k)
5115 C As in the case of ebend, we want to avoid underflows in exponentiation and
5116 C subsequent NaNs and INFs in energy calculation.
5117 C Find the largest exponent
5120 if (emin.gt.contr(j)) emin=contr(j)
5124 C Compute the contribution to SC energy and derivatives
5128 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
5129 escloc_i=escloc_i+expfac
5131 dersc(k)=dersc(k)+Ax(k,j)*expfac
5133 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5134 & +gaussc(1,2,j,it))*expfac
5138 dersc(1)=dersc(1)/cos(theti)**2
5139 dersc12=dersc12/cos(theti)**2
5140 escloci=-(dlog(escloc_i)-emin)
5142 dersc(j)=dersc(j)/escloc_i
5144 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5148 c----------------------------------------------------------------------------------
5149 subroutine esc(escloc)
5150 C Calculate the local energy of a side chain and its derivatives in the
5151 C corresponding virtual-bond valence angles THETA and the spherical angles
5152 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5153 C added by Urszula Kozlowska. 07/11/2007
5155 implicit real*8 (a-h,o-z)
5156 include 'DIMENSIONS'
5157 include 'COMMON.GEO'
5158 include 'COMMON.LOCAL'
5159 include 'COMMON.VAR'
5160 include 'COMMON.SCROT'
5161 include 'COMMON.INTERACT'
5162 include 'COMMON.DERIV'
5163 include 'COMMON.CHAIN'
5164 include 'COMMON.IOUNITS'
5165 include 'COMMON.NAMES'
5166 include 'COMMON.FFIELD'
5167 include 'COMMON.CONTROL'
5168 include 'COMMON.VECTORS'
5169 double precision x_prime(3),y_prime(3),z_prime(3)
5170 & , sumene,dsc_i,dp2_i,x(65),
5171 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5172 & de_dxx,de_dyy,de_dzz,de_dt
5173 double precision s1_t,s1_6_t,s2_t,s2_6_t
5175 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5176 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5177 & dt_dCi(3),dt_dCi1(3)
5178 common /sccalc/ time11,time12,time112,theti,it,nlobit
5181 do i=loc_start,loc_end
5182 costtab(i+1) =dcos(theta(i+1))
5183 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5184 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5185 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5186 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5187 cosfac=dsqrt(cosfac2)
5188 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5189 sinfac=dsqrt(sinfac2)
5191 if (it.eq.10) goto 1
5193 C Compute the axes of tghe local cartesian coordinates system; store in
5194 c x_prime, y_prime and z_prime
5201 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5202 C & dc_norm(3,i+nres)
5204 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5205 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5208 z_prime(j) = -uz(j,i-1)
5211 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5212 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5213 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5214 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5215 c & " xy",scalar(x_prime(1),y_prime(1)),
5216 c & " xz",scalar(x_prime(1),z_prime(1)),
5217 c & " yy",scalar(y_prime(1),y_prime(1)),
5218 c & " yz",scalar(y_prime(1),z_prime(1)),
5219 c & " zz",scalar(z_prime(1),z_prime(1))
5221 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5222 C to local coordinate system. Store in xx, yy, zz.
5228 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5229 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5230 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5237 C Compute the energy of the ith side cbain
5239 c write (2,*) "xx",xx," yy",yy," zz",zz
5242 x(j) = sc_parmin(j,it)
5245 Cc diagnostics - remove later
5247 yy1 = dsin(alph(2))*dcos(omeg(2))
5248 zz1 = -dsin(alph(2))*dsin(omeg(2))
5249 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5250 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5252 C," --- ", xx_w,yy_w,zz_w
5255 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5256 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5258 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5259 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5261 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5262 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5263 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5264 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5265 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5267 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5268 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5269 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5270 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5271 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5273 dsc_i = 0.743d0+x(61)
5275 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5276 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5277 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5278 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5279 s1=(1+x(63))/(0.1d0 + dscp1)
5280 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5281 s2=(1+x(65))/(0.1d0 + dscp2)
5282 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5283 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5284 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5285 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5287 c & dscp1,dscp2,sumene
5288 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5289 escloc = escloc + sumene
5290 c write (2,*) "i",i," escloc",sumene,escloc
5293 C This section to check the numerical derivatives of the energy of ith side
5294 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5295 C #define DEBUG in the code to turn it on.
5297 write (2,*) "sumene =",sumene
5301 write (2,*) xx,yy,zz
5302 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5303 de_dxx_num=(sumenep-sumene)/aincr
5305 write (2,*) "xx+ sumene from enesc=",sumenep
5308 write (2,*) xx,yy,zz
5309 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5310 de_dyy_num=(sumenep-sumene)/aincr
5312 write (2,*) "yy+ sumene from enesc=",sumenep
5315 write (2,*) xx,yy,zz
5316 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5317 de_dzz_num=(sumenep-sumene)/aincr
5319 write (2,*) "zz+ sumene from enesc=",sumenep
5320 costsave=cost2tab(i+1)
5321 sintsave=sint2tab(i+1)
5322 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5323 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5324 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5325 de_dt_num=(sumenep-sumene)/aincr
5326 write (2,*) " t+ sumene from enesc=",sumenep
5327 cost2tab(i+1)=costsave
5328 sint2tab(i+1)=sintsave
5329 C End of diagnostics section.
5332 C Compute the gradient of esc
5334 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5335 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5336 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5337 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5338 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5339 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5340 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5341 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5342 pom1=(sumene3*sint2tab(i+1)+sumene1)
5343 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5344 pom2=(sumene4*cost2tab(i+1)+sumene2)
5345 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5346 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5347 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5348 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5350 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5351 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5352 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5354 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5355 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5356 & +(pom1+pom2)*pom_dx
5358 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5361 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5362 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5363 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5365 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5366 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5367 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5368 & +x(59)*zz**2 +x(60)*xx*zz
5369 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5370 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5371 & +(pom1-pom2)*pom_dy
5373 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5376 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5377 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5378 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5379 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5380 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5381 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5382 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5383 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5385 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5388 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5389 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5390 & +pom1*pom_dt1+pom2*pom_dt2
5392 write(2,*), "de_dt = ", de_dt,de_dt_num
5396 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5397 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5398 cosfac2xx=cosfac2*xx
5399 sinfac2yy=sinfac2*yy
5401 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5403 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5405 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5406 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5407 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5408 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5409 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5410 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5411 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5412 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5413 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5414 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5418 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5419 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5422 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5423 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5424 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5426 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5427 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5431 dXX_Ctab(k,i)=dXX_Ci(k)
5432 dXX_C1tab(k,i)=dXX_Ci1(k)
5433 dYY_Ctab(k,i)=dYY_Ci(k)
5434 dYY_C1tab(k,i)=dYY_Ci1(k)
5435 dZZ_Ctab(k,i)=dZZ_Ci(k)
5436 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5437 dXX_XYZtab(k,i)=dXX_XYZ(k)
5438 dYY_XYZtab(k,i)=dYY_XYZ(k)
5439 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5443 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5444 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5445 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5446 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5447 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5449 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5450 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5451 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5452 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5453 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5454 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5455 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5456 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5458 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5459 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5461 C to check gradient call subroutine check_grad
5467 c------------------------------------------------------------------------------
5468 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5470 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5471 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5472 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5473 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5475 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5476 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5478 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5479 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5480 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5481 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5482 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5484 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5485 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5486 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5487 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5488 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5490 dsc_i = 0.743d0+x(61)
5492 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5493 & *(xx*cost2+yy*sint2))
5494 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5495 & *(xx*cost2-yy*sint2))
5496 s1=(1+x(63))/(0.1d0 + dscp1)
5497 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5498 s2=(1+x(65))/(0.1d0 + dscp2)
5499 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5500 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5501 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5506 c------------------------------------------------------------------------------
5507 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5509 C This procedure calculates two-body contact function g(rij) and its derivative:
5512 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5515 C where x=(rij-r0ij)/delta
5517 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5520 double precision rij,r0ij,eps0ij,fcont,fprimcont
5521 double precision x,x2,x4,delta
5525 if (x.lt.-1.0D0) then
5528 else if (x.le.1.0D0) then
5531 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5532 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5539 c------------------------------------------------------------------------------
5540 subroutine splinthet(theti,delta,ss,ssder)
5541 implicit real*8 (a-h,o-z)
5542 include 'DIMENSIONS'
5543 include 'COMMON.VAR'
5544 include 'COMMON.GEO'
5547 if (theti.gt.pipol) then
5548 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5550 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5555 c------------------------------------------------------------------------------
5556 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5558 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5559 double precision ksi,ksi2,ksi3,a1,a2,a3
5560 a1=fprim0*delta/(f1-f0)
5566 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5567 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5570 c------------------------------------------------------------------------------
5571 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5573 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5574 double precision ksi,ksi2,ksi3,a1,a2,a3
5579 a2=3*(f1x-f0x)-2*fprim0x*delta
5580 a3=fprim0x*delta-2*(f1x-f0x)
5581 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5584 C-----------------------------------------------------------------------------
5586 C-----------------------------------------------------------------------------
5587 subroutine etor(etors,edihcnstr)
5588 implicit real*8 (a-h,o-z)
5589 include 'DIMENSIONS'
5590 include 'COMMON.VAR'
5591 include 'COMMON.GEO'
5592 include 'COMMON.LOCAL'
5593 include 'COMMON.TORSION'
5594 include 'COMMON.INTERACT'
5595 include 'COMMON.DERIV'
5596 include 'COMMON.CHAIN'
5597 include 'COMMON.NAMES'
5598 include 'COMMON.IOUNITS'
5599 include 'COMMON.FFIELD'
5600 include 'COMMON.TORCNSTR'
5601 include 'COMMON.CONTROL'
5603 C Set lprn=.true. for debugging
5607 do i=iphi_start,iphi_end
5609 itori=itortyp(itype(i-2))
5610 itori1=itortyp(itype(i-1))
5613 C Proline-Proline pair is a special case...
5614 if (itori.eq.3 .and. itori1.eq.3) then
5615 if (phii.gt.-dwapi3) then
5617 fac=1.0D0/(1.0D0-cosphi)
5618 etorsi=v1(1,3,3)*fac
5619 etorsi=etorsi+etorsi
5620 etors=etors+etorsi-v1(1,3,3)
5621 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5622 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5625 v1ij=v1(j+1,itori,itori1)
5626 v2ij=v2(j+1,itori,itori1)
5629 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5630 if (energy_dec) etors_ii=etors_ii+
5631 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5632 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5636 v1ij=v1(j,itori,itori1)
5637 v2ij=v2(j,itori,itori1)
5640 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5641 if (energy_dec) etors_ii=etors_ii+
5642 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5643 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5646 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5649 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5650 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5651 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5652 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5653 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5655 ! 6/20/98 - dihedral angle constraints
5658 itori=idih_constr(i)
5661 if (difi.gt.drange(i)) then
5663 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5664 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5665 else if (difi.lt.-drange(i)) then
5667 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5668 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5670 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5671 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5673 ! write (iout,*) 'edihcnstr',edihcnstr
5676 c------------------------------------------------------------------------------
5677 subroutine etor_d(etors_d)
5681 c----------------------------------------------------------------------------
5683 subroutine etor(etors,edihcnstr)
5684 implicit real*8 (a-h,o-z)
5685 include 'DIMENSIONS'
5686 include 'COMMON.VAR'
5687 include 'COMMON.GEO'
5688 include 'COMMON.LOCAL'
5689 include 'COMMON.TORSION'
5690 include 'COMMON.INTERACT'
5691 include 'COMMON.DERIV'
5692 include 'COMMON.CHAIN'
5693 include 'COMMON.NAMES'
5694 include 'COMMON.IOUNITS'
5695 include 'COMMON.FFIELD'
5696 include 'COMMON.TORCNSTR'
5697 include 'COMMON.CONTROL'
5699 C Set lprn=.true. for debugging
5703 do i=iphi_start,iphi_end
5705 itori=itortyp(itype(i-2))
5706 itori1=itortyp(itype(i-1))
5709 C Regular cosine and sine terms
5710 do j=1,nterm(itori,itori1)
5711 v1ij=v1(j,itori,itori1)
5712 v2ij=v2(j,itori,itori1)
5715 etors=etors+v1ij*cosphi+v2ij*sinphi
5716 if (energy_dec) etors_ii=etors_ii+
5717 & v1ij*cosphi+v2ij*sinphi
5718 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5722 C E = SUM ----------------------------------- - v1
5723 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5725 cosphi=dcos(0.5d0*phii)
5726 sinphi=dsin(0.5d0*phii)
5727 do j=1,nlor(itori,itori1)
5728 vl1ij=vlor1(j,itori,itori1)
5729 vl2ij=vlor2(j,itori,itori1)
5730 vl3ij=vlor3(j,itori,itori1)
5731 pom=vl2ij*cosphi+vl3ij*sinphi
5732 pom1=1.0d0/(pom*pom+1.0d0)
5733 etors=etors+vl1ij*pom1
5734 if (energy_dec) etors_ii=etors_ii+
5737 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5739 C Subtract the constant term
5740 etors=etors-v0(itori,itori1)
5741 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5742 & 'etor',i,etors_ii-v0(itori,itori1)
5744 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5745 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5746 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5747 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5748 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5750 ! 6/20/98 - dihedral angle constraints
5752 c do i=1,ndih_constr
5753 do i=idihconstr_start,idihconstr_end
5754 itori=idih_constr(i)
5756 difi=pinorm(phii-phi0(i))
5757 if (difi.gt.drange(i)) then
5759 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5760 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5761 else if (difi.lt.-drange(i)) then
5763 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5764 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5768 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5769 cd & rad2deg*phi0(i), rad2deg*drange(i),
5770 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5772 cd write (iout,*) 'edihcnstr',edihcnstr
5775 c----------------------------------------------------------------------------
5776 subroutine etor_d(etors_d)
5777 C 6/23/01 Compute double torsional energy
5778 implicit real*8 (a-h,o-z)
5779 include 'DIMENSIONS'
5780 include 'COMMON.VAR'
5781 include 'COMMON.GEO'
5782 include 'COMMON.LOCAL'
5783 include 'COMMON.TORSION'
5784 include 'COMMON.INTERACT'
5785 include 'COMMON.DERIV'
5786 include 'COMMON.CHAIN'
5787 include 'COMMON.NAMES'
5788 include 'COMMON.IOUNITS'
5789 include 'COMMON.FFIELD'
5790 include 'COMMON.TORCNSTR'
5792 C Set lprn=.true. for debugging
5796 do i=iphid_start,iphid_end
5797 itori=itortyp(itype(i-2))
5798 itori1=itortyp(itype(i-1))
5799 itori2=itortyp(itype(i))
5801 if (iabs(itype(i+1).eq.20)) iblock=2
5806 C Regular cosine and sine terms
5807 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5808 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5809 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5810 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5811 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5812 cosphi1=dcos(j*phii)
5813 sinphi1=dsin(j*phii)
5814 cosphi2=dcos(j*phii1)
5815 sinphi2=dsin(j*phii1)
5816 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5817 & v2cij*cosphi2+v2sij*sinphi2
5818 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5819 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5821 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5823 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5824 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5825 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5826 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5827 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5828 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5829 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5830 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5831 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5832 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5833 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5834 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5835 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5836 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5839 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5840 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5845 c------------------------------------------------------------------------------
5846 subroutine eback_sc_corr(esccor)
5847 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5848 c conformational states; temporarily implemented as differences
5849 c between UNRES torsional potentials (dependent on three types of
5850 c residues) and the torsional potentials dependent on all 20 types
5851 c of residues computed from AM1 energy surfaces of terminally-blocked
5852 c amino-acid residues.
5853 implicit real*8 (a-h,o-z)
5854 include 'DIMENSIONS'
5855 include 'COMMON.VAR'
5856 include 'COMMON.GEO'
5857 include 'COMMON.LOCAL'
5858 include 'COMMON.TORSION'
5859 include 'COMMON.SCCOR'
5860 include 'COMMON.INTERACT'
5861 include 'COMMON.DERIV'
5862 include 'COMMON.CHAIN'
5863 include 'COMMON.NAMES'
5864 include 'COMMON.IOUNITS'
5865 include 'COMMON.FFIELD'
5866 include 'COMMON.CONTROL'
5868 C Set lprn=.true. for debugging
5871 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5873 do i=iphi_start,iphi_end
5880 v1ij=v1sccor(j,itori,itori1)
5881 v2ij=v2sccor(j,itori,itori1)
5884 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5885 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5888 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5889 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5890 & (v1sccor(j,itori,itori1),j=1,6),(v2sccor(j,itori,itori1),j=1,6)
5891 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5895 c----------------------------------------------------------------------------
5896 subroutine multibody(ecorr)
5897 C This subroutine calculates multi-body contributions to energy following
5898 C the idea of Skolnick et al. If side chains I and J make a contact and
5899 C at the same time side chains I+1 and J+1 make a contact, an extra
5900 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5901 implicit real*8 (a-h,o-z)
5902 include 'DIMENSIONS'
5903 include 'COMMON.IOUNITS'
5904 include 'COMMON.DERIV'
5905 include 'COMMON.INTERACT'
5906 include 'COMMON.CONTACTS'
5908 include 'COMMON.CONTACTS.MOMENT'
5910 double precision gx(3),gx1(3)
5913 C Set lprn=.true. for debugging
5917 write (iout,'(a)') 'Contact function values:'
5919 write (iout,'(i2,20(1x,i2,f10.5))')
5920 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5935 num_conti=num_cont(i)
5936 num_conti1=num_cont(i1)
5941 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5942 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5943 cd & ' ishift=',ishift
5944 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5945 C The system gains extra energy.
5946 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5947 endif ! j1==j+-ishift
5956 c------------------------------------------------------------------------------
5957 double precision function esccorr(i,j,k,l,jj,kk)
5958 implicit real*8 (a-h,o-z)
5959 include 'DIMENSIONS'
5960 include 'COMMON.IOUNITS'
5961 include 'COMMON.DERIV'
5962 include 'COMMON.INTERACT'
5963 include 'COMMON.CONTACTS'
5965 include 'COMMON.CONTACTS.MOMENT'
5967 double precision gx(3),gx1(3)
5972 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5973 C Calculate the multi-body contribution to energy.
5974 C Calculate multi-body contributions to the gradient.
5975 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5976 cd & k,l,(gacont(m,kk,k),m=1,3)
5978 gx(m) =ekl*gacont(m,jj,i)
5979 gx1(m)=eij*gacont(m,kk,k)
5980 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5981 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5982 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5983 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5987 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5992 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5998 c------------------------------------------------------------------------------
5999 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6000 C This subroutine calculates multi-body contributions to hydrogen-bonding
6001 implicit real*8 (a-h,o-z)
6002 include 'DIMENSIONS'
6003 include 'COMMON.IOUNITS'
6006 parameter (max_cont=maxconts)
6007 parameter (max_dim=26)
6008 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6009 double precision zapas(max_dim,maxconts,max_fg_procs),
6010 & zapas_recv(max_dim,maxconts,max_fg_procs)
6011 common /przechowalnia/ zapas
6012 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6013 & status_array(MPI_STATUS_SIZE,maxconts*2)
6015 include 'COMMON.SETUP'
6016 include 'COMMON.FFIELD'
6017 include 'COMMON.DERIV'
6018 include 'COMMON.INTERACT'
6019 include 'COMMON.CONTACTS'
6021 include 'COMMON.CONTACTS.MOMENT'
6023 include 'COMMON.CONTROL'
6024 include 'COMMON.LOCAL'
6025 double precision gx(3),gx1(3),time00
6028 C Set lprn=.true. for debugging
6033 if (nfgtasks.le.1) goto 30
6035 write (iout,'(a)') 'Contact function values before RECEIVE:'
6037 write (iout,'(2i3,50(1x,i2,f5.2))')
6038 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6039 & j=1,num_cont_hb(i))
6043 do i=1,ntask_cont_from
6046 do i=1,ntask_cont_to
6049 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6051 C Make the list of contacts to send to send to other procesors
6052 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6054 do i=iturn3_start,iturn3_end
6055 c write (iout,*) "make contact list turn3",i," num_cont",
6057 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6059 do i=iturn4_start,iturn4_end
6060 c write (iout,*) "make contact list turn4",i," num_cont",
6062 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6066 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6068 do j=1,num_cont_hb(i)
6071 iproc=iint_sent_local(k,jjc,ii)
6072 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6073 if (iproc.gt.0) then
6074 ncont_sent(iproc)=ncont_sent(iproc)+1
6075 nn=ncont_sent(iproc)
6077 zapas(2,nn,iproc)=jjc
6078 zapas(3,nn,iproc)=facont_hb(j,i)
6079 zapas(4,nn,iproc)=ees0p(j,i)
6080 zapas(5,nn,iproc)=ees0m(j,i)
6081 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6082 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6083 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6084 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6085 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6086 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6087 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6088 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6089 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6090 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6091 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6092 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6093 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6094 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6095 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6096 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6097 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6098 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6099 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6100 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6101 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6108 & "Numbers of contacts to be sent to other processors",
6109 & (ncont_sent(i),i=1,ntask_cont_to)
6110 write (iout,*) "Contacts sent"
6111 do ii=1,ntask_cont_to
6113 iproc=itask_cont_to(ii)
6114 write (iout,*) nn," contacts to processor",iproc,
6115 & " of CONT_TO_COMM group"
6117 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6125 CorrelID1=nfgtasks+fg_rank+1
6127 C Receive the numbers of needed contacts from other processors
6128 do ii=1,ntask_cont_from
6129 iproc=itask_cont_from(ii)
6131 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6132 & FG_COMM,req(ireq),IERR)
6134 c write (iout,*) "IRECV ended"
6136 C Send the number of contacts needed by other processors
6137 do ii=1,ntask_cont_to
6138 iproc=itask_cont_to(ii)
6140 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6141 & FG_COMM,req(ireq),IERR)
6143 c write (iout,*) "ISEND ended"
6144 c write (iout,*) "number of requests (nn)",ireq
6147 & call MPI_Waitall(ireq,req,status_array,ierr)
6149 c & "Numbers of contacts to be received from other processors",
6150 c & (ncont_recv(i),i=1,ntask_cont_from)
6154 do ii=1,ntask_cont_from
6155 iproc=itask_cont_from(ii)
6157 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6158 c & " of CONT_TO_COMM group"
6162 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6163 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6164 c write (iout,*) "ireq,req",ireq,req(ireq)
6167 C Send the contacts to processors that need them
6168 do ii=1,ntask_cont_to
6169 iproc=itask_cont_to(ii)
6171 c write (iout,*) nn," contacts to processor",iproc,
6172 c & " of CONT_TO_COMM group"
6175 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6176 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6177 c write (iout,*) "ireq,req",ireq,req(ireq)
6179 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6183 c write (iout,*) "number of requests (contacts)",ireq
6184 c write (iout,*) "req",(req(i),i=1,4)
6187 & call MPI_Waitall(ireq,req,status_array,ierr)
6188 do iii=1,ntask_cont_from
6189 iproc=itask_cont_from(iii)
6192 write (iout,*) "Received",nn," contacts from processor",iproc,
6193 & " of CONT_FROM_COMM group"
6196 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6201 ii=zapas_recv(1,i,iii)
6202 c Flag the received contacts to prevent double-counting
6203 jj=-zapas_recv(2,i,iii)
6204 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6206 nnn=num_cont_hb(ii)+1
6209 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6210 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6211 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6212 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6213 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6214 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6215 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6216 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6217 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6218 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6219 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6220 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6221 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6222 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6223 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6224 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6225 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6226 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6227 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6228 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6229 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6230 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6231 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6232 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6237 write (iout,'(a)') 'Contact function values after receive:'
6239 write (iout,'(2i3,50(1x,i3,f5.2))')
6240 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6241 & j=1,num_cont_hb(i))
6248 write (iout,'(a)') 'Contact function values:'
6250 write (iout,'(2i3,50(1x,i3,f5.2))')
6251 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6252 & j=1,num_cont_hb(i))
6256 C Remove the loop below after debugging !!!
6263 C Calculate the local-electrostatic correlation terms
6264 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6266 num_conti=num_cont_hb(i)
6267 num_conti1=num_cont_hb(i+1)
6274 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6275 c & ' jj=',jj,' kk=',kk
6276 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6277 & .or. j.lt.0 .and. j1.gt.0) .and.
6278 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6279 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6280 C The system gains extra energy.
6281 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6282 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6283 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6285 else if (j1.eq.j) then
6286 C Contacts I-J and I-(J+1) occur simultaneously.
6287 C The system loses extra energy.
6288 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6293 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6294 c & ' jj=',jj,' kk=',kk
6296 C Contacts I-J and (I+1)-J occur simultaneously.
6297 C The system loses extra energy.
6298 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6305 c------------------------------------------------------------------------------
6306 subroutine add_hb_contact(ii,jj,itask)
6307 implicit real*8 (a-h,o-z)
6308 include "DIMENSIONS"
6309 include "COMMON.IOUNITS"
6312 parameter (max_cont=maxconts)
6313 parameter (max_dim=26)
6314 include "COMMON.CONTACTS"
6316 include 'COMMON.CONTACTS.MOMENT'
6318 double precision zapas(max_dim,maxconts,max_fg_procs),
6319 & zapas_recv(max_dim,maxconts,max_fg_procs)
6320 common /przechowalnia/ zapas
6321 integer i,j,ii,jj,iproc,itask(4),nn
6322 c write (iout,*) "itask",itask
6325 if (iproc.gt.0) then
6326 do j=1,num_cont_hb(ii)
6328 c write (iout,*) "i",ii," j",jj," jjc",jjc
6330 ncont_sent(iproc)=ncont_sent(iproc)+1
6331 nn=ncont_sent(iproc)
6332 zapas(1,nn,iproc)=ii
6333 zapas(2,nn,iproc)=jjc
6334 zapas(3,nn,iproc)=facont_hb(j,ii)
6335 zapas(4,nn,iproc)=ees0p(j,ii)
6336 zapas(5,nn,iproc)=ees0m(j,ii)
6337 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6338 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6339 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6340 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6341 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6342 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6343 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6344 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6345 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6346 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6347 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6348 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6349 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6350 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6351 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6352 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6353 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6354 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6355 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6356 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6357 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6365 c------------------------------------------------------------------------------
6366 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6368 C This subroutine calculates multi-body contributions to hydrogen-bonding
6369 implicit real*8 (a-h,o-z)
6370 include 'DIMENSIONS'
6371 include 'COMMON.IOUNITS'
6374 parameter (max_cont=maxconts)
6375 parameter (max_dim=70)
6376 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6377 double precision zapas(max_dim,maxconts,max_fg_procs),
6378 & zapas_recv(max_dim,maxconts,max_fg_procs)
6379 common /przechowalnia/ zapas
6380 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6381 & status_array(MPI_STATUS_SIZE,maxconts*2)
6383 include 'COMMON.SETUP'
6384 include 'COMMON.FFIELD'
6385 include 'COMMON.DERIV'
6386 include 'COMMON.LOCAL'
6387 include 'COMMON.INTERACT'
6388 include 'COMMON.CONTACTS'
6390 include 'COMMON.CONTACTS.MOMENT'
6392 include 'COMMON.CHAIN'
6393 include 'COMMON.CONTROL'
6394 double precision gx(3),gx1(3)
6395 integer num_cont_hb_old(maxres)
6397 double precision eello4,eello5,eelo6,eello_turn6
6398 external eello4,eello5,eello6,eello_turn6
6399 C Set lprn=.true. for debugging
6404 num_cont_hb_old(i)=num_cont_hb(i)
6408 if (nfgtasks.le.1) goto 30
6410 write (iout,'(a)') 'Contact function values before RECEIVE:'
6412 write (iout,'(2i3,50(1x,i2,f5.2))')
6413 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6414 & j=1,num_cont_hb(i))
6418 do i=1,ntask_cont_from
6421 do i=1,ntask_cont_to
6424 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6426 C Make the list of contacts to send to send to other procesors
6427 do i=iturn3_start,iturn3_end
6428 c write (iout,*) "make contact list turn3",i," num_cont",
6430 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6432 do i=iturn4_start,iturn4_end
6433 c write (iout,*) "make contact list turn4",i," num_cont",
6435 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6439 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6441 do j=1,num_cont_hb(i)
6444 iproc=iint_sent_local(k,jjc,ii)
6445 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6446 if (iproc.ne.0) then
6447 ncont_sent(iproc)=ncont_sent(iproc)+1
6448 nn=ncont_sent(iproc)
6450 zapas(2,nn,iproc)=jjc
6451 zapas(3,nn,iproc)=d_cont(j,i)
6455 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6460 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6468 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6479 & "Numbers of contacts to be sent to other processors",
6480 & (ncont_sent(i),i=1,ntask_cont_to)
6481 write (iout,*) "Contacts sent"
6482 do ii=1,ntask_cont_to
6484 iproc=itask_cont_to(ii)
6485 write (iout,*) nn," contacts to processor",iproc,
6486 & " of CONT_TO_COMM group"
6488 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6496 CorrelID1=nfgtasks+fg_rank+1
6498 C Receive the numbers of needed contacts from other processors
6499 do ii=1,ntask_cont_from
6500 iproc=itask_cont_from(ii)
6502 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6503 & FG_COMM,req(ireq),IERR)
6505 c write (iout,*) "IRECV ended"
6507 C Send the number of contacts needed by other processors
6508 do ii=1,ntask_cont_to
6509 iproc=itask_cont_to(ii)
6511 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6512 & FG_COMM,req(ireq),IERR)
6514 c write (iout,*) "ISEND ended"
6515 c write (iout,*) "number of requests (nn)",ireq
6518 & call MPI_Waitall(ireq,req,status_array,ierr)
6520 c & "Numbers of contacts to be received from other processors",
6521 c & (ncont_recv(i),i=1,ntask_cont_from)
6525 do ii=1,ntask_cont_from
6526 iproc=itask_cont_from(ii)
6528 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6529 c & " of CONT_TO_COMM group"
6533 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6534 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6535 c write (iout,*) "ireq,req",ireq,req(ireq)
6538 C Send the contacts to processors that need them
6539 do ii=1,ntask_cont_to
6540 iproc=itask_cont_to(ii)
6542 c write (iout,*) nn," contacts to processor",iproc,
6543 c & " of CONT_TO_COMM group"
6546 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6547 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6548 c write (iout,*) "ireq,req",ireq,req(ireq)
6550 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6554 c write (iout,*) "number of requests (contacts)",ireq
6555 c write (iout,*) "req",(req(i),i=1,4)
6558 & call MPI_Waitall(ireq,req,status_array,ierr)
6559 do iii=1,ntask_cont_from
6560 iproc=itask_cont_from(iii)
6563 write (iout,*) "Received",nn," contacts from processor",iproc,
6564 & " of CONT_FROM_COMM group"
6567 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6572 ii=zapas_recv(1,i,iii)
6573 c Flag the received contacts to prevent double-counting
6574 jj=-zapas_recv(2,i,iii)
6575 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6577 nnn=num_cont_hb(ii)+1
6580 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6584 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6589 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6597 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6606 write (iout,'(a)') 'Contact function values after receive:'
6608 write (iout,'(2i3,50(1x,i3,5f6.3))')
6609 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6610 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6617 write (iout,'(a)') 'Contact function values:'
6619 write (iout,'(2i3,50(1x,i2,5f6.3))')
6620 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6621 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6627 C Remove the loop below after debugging !!!
6634 C Calculate the dipole-dipole interaction energies
6635 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6636 do i=iatel_s,iatel_e+1
6637 num_conti=num_cont_hb(i)
6646 C Calculate the local-electrostatic correlation terms
6647 c write (iout,*) "gradcorr5 in eello5 before loop"
6649 c write (iout,'(i5,3f10.5)')
6650 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6652 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6653 c write (iout,*) "corr loop i",i
6655 num_conti=num_cont_hb(i)
6656 num_conti1=num_cont_hb(i+1)
6663 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6664 c & ' jj=',jj,' kk=',kk
6665 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6666 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6667 & .or. j.lt.0 .and. j1.gt.0) .and.
6668 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6669 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6670 C The system gains extra energy.
6672 sqd1=dsqrt(d_cont(jj,i))
6673 sqd2=dsqrt(d_cont(kk,i1))
6674 sred_geom = sqd1*sqd2
6675 IF (sred_geom.lt.cutoff_corr) THEN
6676 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6678 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6679 cd & ' jj=',jj,' kk=',kk
6680 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6681 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6683 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6684 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6687 cd write (iout,*) 'sred_geom=',sred_geom,
6688 cd & ' ekont=',ekont,' fprim=',fprimcont,
6689 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6690 cd write (iout,*) "g_contij",g_contij
6691 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6692 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6693 call calc_eello(i,jp,i+1,jp1,jj,kk)
6694 if (wcorr4.gt.0.0d0)
6695 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6696 if (energy_dec.and.wcorr4.gt.0.0d0)
6697 1 write (iout,'(a6,4i5,0pf7.3)')
6698 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6699 c write (iout,*) "gradcorr5 before eello5"
6701 c write (iout,'(i5,3f10.5)')
6702 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6704 if (wcorr5.gt.0.0d0)
6705 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6706 c write (iout,*) "gradcorr5 after eello5"
6708 c write (iout,'(i5,3f10.5)')
6709 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6711 if (energy_dec.and.wcorr5.gt.0.0d0)
6712 1 write (iout,'(a6,4i5,0pf7.3)')
6713 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6714 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6715 cd write(2,*)'ijkl',i,jp,i+1,jp1
6716 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6717 & .or. wturn6.eq.0.0d0))then
6718 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6719 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6720 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6721 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6722 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6723 cd & 'ecorr6=',ecorr6
6724 cd write (iout,'(4e15.5)') sred_geom,
6725 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6726 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6727 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6728 else if (wturn6.gt.0.0d0
6729 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6730 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6731 eturn6=eturn6+eello_turn6(i,jj,kk)
6732 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6733 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6734 cd write (2,*) 'multibody_eello:eturn6',eturn6
6743 num_cont_hb(i)=num_cont_hb_old(i)
6745 c write (iout,*) "gradcorr5 in eello5"
6747 c write (iout,'(i5,3f10.5)')
6748 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6752 c------------------------------------------------------------------------------
6753 subroutine add_hb_contact_eello(ii,jj,itask)
6754 implicit real*8 (a-h,o-z)
6755 include "DIMENSIONS"
6756 include "COMMON.IOUNITS"
6759 parameter (max_cont=maxconts)
6760 parameter (max_dim=70)
6761 include "COMMON.CONTACTS"
6763 include 'COMMON.CONTACTS.MOMENT'
6765 double precision zapas(max_dim,maxconts,max_fg_procs),
6766 & zapas_recv(max_dim,maxconts,max_fg_procs)
6767 common /przechowalnia/ zapas
6768 integer i,j,ii,jj,iproc,itask(4),nn
6769 c write (iout,*) "itask",itask
6772 if (iproc.gt.0) then
6773 do j=1,num_cont_hb(ii)
6775 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6777 ncont_sent(iproc)=ncont_sent(iproc)+1
6778 nn=ncont_sent(iproc)
6779 zapas(1,nn,iproc)=ii
6780 zapas(2,nn,iproc)=jjc
6781 zapas(3,nn,iproc)=d_cont(j,ii)
6785 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6790 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6798 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6810 c------------------------------------------------------------------------------
6811 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6812 implicit real*8 (a-h,o-z)
6813 include 'DIMENSIONS'
6814 include 'COMMON.IOUNITS'
6815 include 'COMMON.DERIV'
6816 include 'COMMON.INTERACT'
6817 include 'COMMON.CONTACTS'
6819 include 'COMMON.CONTACTS.MOMENT'
6821 double precision gx(3),gx1(3)
6831 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6832 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6833 C Following 4 lines for diagnostics.
6838 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6839 c & 'Contacts ',i,j,
6840 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6841 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6843 C Calculate the multi-body contribution to energy.
6844 c ecorr=ecorr+ekont*ees
6845 C Calculate multi-body contributions to the gradient.
6846 coeffpees0pij=coeffp*ees0pij
6847 coeffmees0mij=coeffm*ees0mij
6848 coeffpees0pkl=coeffp*ees0pkl
6849 coeffmees0mkl=coeffm*ees0mkl
6851 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6852 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6853 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6854 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6855 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6856 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6857 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6858 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6859 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6860 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6861 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6862 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6863 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6864 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6865 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6866 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6867 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6868 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6869 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6870 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6871 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6872 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6873 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6874 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6875 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6880 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6881 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6882 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6883 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6888 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6889 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6890 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6891 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6894 c write (iout,*) "ehbcorr",ekont*ees
6899 C---------------------------------------------------------------------------
6900 subroutine dipole(i,j,jj)
6901 implicit real*8 (a-h,o-z)
6902 include 'DIMENSIONS'
6903 include 'COMMON.IOUNITS'
6904 include 'COMMON.CHAIN'
6905 include 'COMMON.FFIELD'
6906 include 'COMMON.DERIV'
6907 include 'COMMON.INTERACT'
6908 include 'COMMON.CONTACTS'
6910 include 'COMMON.CONTACTS.MOMENT'
6912 include 'COMMON.TORSION'
6913 include 'COMMON.VAR'
6914 include 'COMMON.GEO'
6915 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6917 iti1 = itortyp(itype(i+1))
6918 if (j.lt.nres-1) then
6919 itj1 = itortyp(itype(j+1))
6924 dipi(iii,1)=Ub2(iii,i)
6925 dipderi(iii)=Ub2der(iii,i)
6926 dipi(iii,2)=b1(iii,iti1)
6927 dipj(iii,1)=Ub2(iii,j)
6928 dipderj(iii)=Ub2der(iii,j)
6929 dipj(iii,2)=b1(iii,itj1)
6933 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6936 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6943 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6947 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6952 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6953 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6955 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6957 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6959 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6964 C---------------------------------------------------------------------------
6965 subroutine calc_eello(i,j,k,l,jj,kk)
6967 C This subroutine computes matrices and vectors needed to calculate
6968 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6970 implicit real*8 (a-h,o-z)
6971 include 'DIMENSIONS'
6972 include 'COMMON.IOUNITS'
6973 include 'COMMON.CHAIN'
6974 include 'COMMON.DERIV'
6975 include 'COMMON.INTERACT'
6976 include 'COMMON.CONTACTS'
6978 include 'COMMON.CONTACTS.MOMENT'
6980 include 'COMMON.TORSION'
6981 include 'COMMON.VAR'
6982 include 'COMMON.GEO'
6983 include 'COMMON.FFIELD'
6984 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6985 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6988 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6989 cd & ' jj=',jj,' kk=',kk
6990 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6991 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6992 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6995 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6996 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
6999 call transpose2(aa1(1,1),aa1t(1,1))
7000 call transpose2(aa2(1,1),aa2t(1,1))
7003 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7004 & aa1tder(1,1,lll,kkk))
7005 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7006 & aa2tder(1,1,lll,kkk))
7010 C parallel orientation of the two CA-CA-CA frames.
7012 iti=itortyp(itype(i))
7016 itk1=itortyp(itype(k+1))
7017 itj=itortyp(itype(j))
7018 if (l.lt.nres-1) then
7019 itl1=itortyp(itype(l+1))
7023 C A1 kernel(j+1) A2T
7025 cd write (iout,'(3f10.5,5x,3f10.5)')
7026 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7028 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7029 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7030 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7031 C Following matrices are needed only for 6-th order cumulants
7032 IF (wcorr6.gt.0.0d0) THEN
7033 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7034 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7035 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7036 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7037 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7038 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7039 & ADtEAderx(1,1,1,1,1,1))
7041 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7042 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7043 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7044 & ADtEA1derx(1,1,1,1,1,1))
7046 C End 6-th order cumulants
7049 cd write (2,*) 'In calc_eello6'
7051 cd write (2,*) 'iii=',iii
7053 cd write (2,*) 'kkk=',kkk
7055 cd write (2,'(3(2f10.5),5x)')
7056 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7061 call transpose2(EUgder(1,1,k),auxmat(1,1))
7062 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7063 call transpose2(EUg(1,1,k),auxmat(1,1))
7064 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7065 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7069 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7070 & EAEAderx(1,1,lll,kkk,iii,1))
7074 C A1T kernel(i+1) A2
7075 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7076 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7077 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7078 C Following matrices are needed only for 6-th order cumulants
7079 IF (wcorr6.gt.0.0d0) THEN
7080 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7081 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7082 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7083 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7084 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7085 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7086 & ADtEAderx(1,1,1,1,1,2))
7087 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7088 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7089 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7090 & ADtEA1derx(1,1,1,1,1,2))
7092 C End 6-th order cumulants
7093 call transpose2(EUgder(1,1,l),auxmat(1,1))
7094 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7095 call transpose2(EUg(1,1,l),auxmat(1,1))
7096 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7097 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7101 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7102 & EAEAderx(1,1,lll,kkk,iii,2))
7107 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7108 C They are needed only when the fifth- or the sixth-order cumulants are
7110 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7111 call transpose2(AEA(1,1,1),auxmat(1,1))
7112 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7113 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7114 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7115 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7116 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7117 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7118 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7119 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7120 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7121 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7122 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7123 call transpose2(AEA(1,1,2),auxmat(1,1))
7124 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7125 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7126 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7127 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7128 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7129 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7130 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7131 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7132 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7133 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7134 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7135 C Calculate the Cartesian derivatives of the vectors.
7139 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7140 call matvec2(auxmat(1,1),b1(1,iti),
7141 & AEAb1derx(1,lll,kkk,iii,1,1))
7142 call matvec2(auxmat(1,1),Ub2(1,i),
7143 & AEAb2derx(1,lll,kkk,iii,1,1))
7144 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7145 & AEAb1derx(1,lll,kkk,iii,2,1))
7146 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7147 & AEAb2derx(1,lll,kkk,iii,2,1))
7148 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7149 call matvec2(auxmat(1,1),b1(1,itj),
7150 & AEAb1derx(1,lll,kkk,iii,1,2))
7151 call matvec2(auxmat(1,1),Ub2(1,j),
7152 & AEAb2derx(1,lll,kkk,iii,1,2))
7153 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7154 & AEAb1derx(1,lll,kkk,iii,2,2))
7155 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7156 & AEAb2derx(1,lll,kkk,iii,2,2))
7163 C Antiparallel orientation of the two CA-CA-CA frames.
7165 iti=itortyp(itype(i))
7169 itk1=itortyp(itype(k+1))
7170 itl=itortyp(itype(l))
7171 itj=itortyp(itype(j))
7172 if (j.lt.nres-1) then
7173 itj1=itortyp(itype(j+1))
7177 C A2 kernel(j-1)T A1T
7178 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7179 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7180 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7181 C Following matrices are needed only for 6-th order cumulants
7182 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7183 & j.eq.i+4 .and. l.eq.i+3)) THEN
7184 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7185 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7186 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7187 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7188 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7189 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7190 & ADtEAderx(1,1,1,1,1,1))
7191 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7192 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7193 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7194 & ADtEA1derx(1,1,1,1,1,1))
7196 C End 6-th order cumulants
7197 call transpose2(EUgder(1,1,k),auxmat(1,1))
7198 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7199 call transpose2(EUg(1,1,k),auxmat(1,1))
7200 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7201 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7205 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7206 & EAEAderx(1,1,lll,kkk,iii,1))
7210 C A2T kernel(i+1)T A1
7211 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7212 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7213 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7214 C Following matrices are needed only for 6-th order cumulants
7215 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7216 & j.eq.i+4 .and. l.eq.i+3)) THEN
7217 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7218 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7219 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7220 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7221 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7222 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7223 & ADtEAderx(1,1,1,1,1,2))
7224 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7225 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7226 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7227 & ADtEA1derx(1,1,1,1,1,2))
7229 C End 6-th order cumulants
7230 call transpose2(EUgder(1,1,j),auxmat(1,1))
7231 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7232 call transpose2(EUg(1,1,j),auxmat(1,1))
7233 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7234 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7238 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7239 & EAEAderx(1,1,lll,kkk,iii,2))
7244 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7245 C They are needed only when the fifth- or the sixth-order cumulants are
7247 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7248 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7249 call transpose2(AEA(1,1,1),auxmat(1,1))
7250 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7251 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7252 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7253 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7254 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7255 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7256 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7257 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7258 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7259 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7260 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7261 call transpose2(AEA(1,1,2),auxmat(1,1))
7262 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7263 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7264 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7265 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7266 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7267 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7268 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7269 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7270 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7271 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7272 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7273 C Calculate the Cartesian derivatives of the vectors.
7277 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7278 call matvec2(auxmat(1,1),b1(1,iti),
7279 & AEAb1derx(1,lll,kkk,iii,1,1))
7280 call matvec2(auxmat(1,1),Ub2(1,i),
7281 & AEAb2derx(1,lll,kkk,iii,1,1))
7282 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7283 & AEAb1derx(1,lll,kkk,iii,2,1))
7284 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7285 & AEAb2derx(1,lll,kkk,iii,2,1))
7286 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7287 call matvec2(auxmat(1,1),b1(1,itl),
7288 & AEAb1derx(1,lll,kkk,iii,1,2))
7289 call matvec2(auxmat(1,1),Ub2(1,l),
7290 & AEAb2derx(1,lll,kkk,iii,1,2))
7291 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7292 & AEAb1derx(1,lll,kkk,iii,2,2))
7293 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7294 & AEAb2derx(1,lll,kkk,iii,2,2))
7303 C---------------------------------------------------------------------------
7304 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7305 & KK,KKderg,AKA,AKAderg,AKAderx)
7309 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7310 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7311 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7316 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7318 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7321 cd if (lprn) write (2,*) 'In kernel'
7323 cd if (lprn) write (2,*) 'kkk=',kkk
7325 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7326 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7328 cd write (2,*) 'lll=',lll
7329 cd write (2,*) 'iii=1'
7331 cd write (2,'(3(2f10.5),5x)')
7332 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7335 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7336 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7338 cd write (2,*) 'lll=',lll
7339 cd write (2,*) 'iii=2'
7341 cd write (2,'(3(2f10.5),5x)')
7342 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7349 C---------------------------------------------------------------------------
7350 double precision function eello4(i,j,k,l,jj,kk)
7351 implicit real*8 (a-h,o-z)
7352 include 'DIMENSIONS'
7353 include 'COMMON.IOUNITS'
7354 include 'COMMON.CHAIN'
7355 include 'COMMON.DERIV'
7356 include 'COMMON.INTERACT'
7357 include 'COMMON.CONTACTS'
7359 include 'COMMON.CONTACTS.MOMENT'
7361 include 'COMMON.TORSION'
7362 include 'COMMON.VAR'
7363 include 'COMMON.GEO'
7364 double precision pizda(2,2),ggg1(3),ggg2(3)
7365 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7369 cd print *,'eello4:',i,j,k,l,jj,kk
7370 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7371 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7372 cold eij=facont_hb(jj,i)
7373 cold ekl=facont_hb(kk,k)
7375 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7376 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7377 gcorr_loc(k-1)=gcorr_loc(k-1)
7378 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7380 gcorr_loc(l-1)=gcorr_loc(l-1)
7381 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7383 gcorr_loc(j-1)=gcorr_loc(j-1)
7384 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7389 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7390 & -EAEAderx(2,2,lll,kkk,iii,1)
7391 cd derx(lll,kkk,iii)=0.0d0
7395 cd gcorr_loc(l-1)=0.0d0
7396 cd gcorr_loc(j-1)=0.0d0
7397 cd gcorr_loc(k-1)=0.0d0
7399 cd write (iout,*)'Contacts have occurred for peptide groups',
7400 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7401 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7402 if (j.lt.nres-1) then
7409 if (l.lt.nres-1) then
7417 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7418 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7419 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7420 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7421 cgrad ghalf=0.5d0*ggg1(ll)
7422 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7423 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7424 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7425 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7426 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7427 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7428 cgrad ghalf=0.5d0*ggg2(ll)
7429 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7430 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7431 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7432 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7433 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7434 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7438 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7443 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7448 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7453 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7457 cd write (2,*) iii,gcorr_loc(iii)
7460 cd write (2,*) 'ekont',ekont
7461 cd write (iout,*) 'eello4',ekont*eel4
7464 C---------------------------------------------------------------------------
7465 double precision function eello5(i,j,k,l,jj,kk)
7466 implicit real*8 (a-h,o-z)
7467 include 'DIMENSIONS'
7468 include 'COMMON.IOUNITS'
7469 include 'COMMON.CHAIN'
7470 include 'COMMON.DERIV'
7471 include 'COMMON.INTERACT'
7472 include 'COMMON.CONTACTS'
7474 include 'COMMON.CONTACTS.MOMENT'
7476 include 'COMMON.TORSION'
7477 include 'COMMON.VAR'
7478 include 'COMMON.GEO'
7479 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7480 double precision ggg1(3),ggg2(3)
7481 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7486 C /l\ / \ \ / \ / \ / C
7487 C / \ / \ \ / \ / \ / C
7488 C j| o |l1 | o | o| o | | o |o C
7489 C \ |/k\| |/ \| / |/ \| |/ \| C
7490 C \i/ \ / \ / / \ / \ C
7492 C (I) (II) (III) (IV) C
7494 C eello5_1 eello5_2 eello5_3 eello5_4 C
7496 C Antiparallel chains C
7499 C /j\ / \ \ / \ / \ / C
7500 C / \ / \ \ / \ / \ / C
7501 C j1| o |l | o | o| o | | o |o C
7502 C \ |/k\| |/ \| / |/ \| |/ \| C
7503 C \i/ \ / \ / / \ / \ C
7505 C (I) (II) (III) (IV) C
7507 C eello5_1 eello5_2 eello5_3 eello5_4 C
7509 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7511 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7512 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7517 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7519 itk=itortyp(itype(k))
7520 itl=itortyp(itype(l))
7521 itj=itortyp(itype(j))
7526 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7527 cd & eel5_3_num,eel5_4_num)
7531 derx(lll,kkk,iii)=0.0d0
7535 cd eij=facont_hb(jj,i)
7536 cd ekl=facont_hb(kk,k)
7538 cd write (iout,*)'Contacts have occurred for peptide groups',
7539 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7541 C Contribution from the graph I.
7542 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7543 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7544 call transpose2(EUg(1,1,k),auxmat(1,1))
7545 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7546 vv(1)=pizda(1,1)-pizda(2,2)
7547 vv(2)=pizda(1,2)+pizda(2,1)
7548 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7549 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7550 C Explicit gradient in virtual-dihedral angles.
7551 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7552 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7553 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7554 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7555 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7556 vv(1)=pizda(1,1)-pizda(2,2)
7557 vv(2)=pizda(1,2)+pizda(2,1)
7558 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7559 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7560 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7561 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7562 vv(1)=pizda(1,1)-pizda(2,2)
7563 vv(2)=pizda(1,2)+pizda(2,1)
7565 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7566 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7567 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7569 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7570 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7571 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7573 C Cartesian gradient
7577 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7579 vv(1)=pizda(1,1)-pizda(2,2)
7580 vv(2)=pizda(1,2)+pizda(2,1)
7581 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7582 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7583 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7589 C Contribution from graph II
7590 call transpose2(EE(1,1,itk),auxmat(1,1))
7591 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7592 vv(1)=pizda(1,1)+pizda(2,2)
7593 vv(2)=pizda(2,1)-pizda(1,2)
7594 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7595 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7596 C Explicit gradient in virtual-dihedral angles.
7597 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7598 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7599 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7600 vv(1)=pizda(1,1)+pizda(2,2)
7601 vv(2)=pizda(2,1)-pizda(1,2)
7603 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7604 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7605 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7607 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7608 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7609 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7611 C Cartesian gradient
7615 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7617 vv(1)=pizda(1,1)+pizda(2,2)
7618 vv(2)=pizda(2,1)-pizda(1,2)
7619 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7620 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7621 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7629 C Parallel orientation
7630 C Contribution from graph III
7631 call transpose2(EUg(1,1,l),auxmat(1,1))
7632 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7633 vv(1)=pizda(1,1)-pizda(2,2)
7634 vv(2)=pizda(1,2)+pizda(2,1)
7635 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7636 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7637 C Explicit gradient in virtual-dihedral angles.
7638 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7639 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7640 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7641 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7642 vv(1)=pizda(1,1)-pizda(2,2)
7643 vv(2)=pizda(1,2)+pizda(2,1)
7644 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7645 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7646 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7647 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7648 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7649 vv(1)=pizda(1,1)-pizda(2,2)
7650 vv(2)=pizda(1,2)+pizda(2,1)
7651 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7652 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7653 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7654 C Cartesian gradient
7658 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7660 vv(1)=pizda(1,1)-pizda(2,2)
7661 vv(2)=pizda(1,2)+pizda(2,1)
7662 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7663 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7664 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7669 C Contribution from graph IV
7671 call transpose2(EE(1,1,itl),auxmat(1,1))
7672 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7673 vv(1)=pizda(1,1)+pizda(2,2)
7674 vv(2)=pizda(2,1)-pizda(1,2)
7675 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7676 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7677 C Explicit gradient in virtual-dihedral angles.
7678 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7679 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7680 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7681 vv(1)=pizda(1,1)+pizda(2,2)
7682 vv(2)=pizda(2,1)-pizda(1,2)
7683 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7684 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7685 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7686 C Cartesian gradient
7690 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7692 vv(1)=pizda(1,1)+pizda(2,2)
7693 vv(2)=pizda(2,1)-pizda(1,2)
7694 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7695 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7696 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7701 C Antiparallel orientation
7702 C Contribution from graph III
7704 call transpose2(EUg(1,1,j),auxmat(1,1))
7705 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7706 vv(1)=pizda(1,1)-pizda(2,2)
7707 vv(2)=pizda(1,2)+pizda(2,1)
7708 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7709 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7710 C Explicit gradient in virtual-dihedral angles.
7711 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7712 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7713 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7714 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7715 vv(1)=pizda(1,1)-pizda(2,2)
7716 vv(2)=pizda(1,2)+pizda(2,1)
7717 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7718 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7719 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7720 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7721 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7722 vv(1)=pizda(1,1)-pizda(2,2)
7723 vv(2)=pizda(1,2)+pizda(2,1)
7724 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7725 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7726 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7727 C Cartesian gradient
7731 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7733 vv(1)=pizda(1,1)-pizda(2,2)
7734 vv(2)=pizda(1,2)+pizda(2,1)
7735 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7736 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7737 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7742 C Contribution from graph IV
7744 call transpose2(EE(1,1,itj),auxmat(1,1))
7745 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7746 vv(1)=pizda(1,1)+pizda(2,2)
7747 vv(2)=pizda(2,1)-pizda(1,2)
7748 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7749 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7750 C Explicit gradient in virtual-dihedral angles.
7751 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7752 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7753 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7754 vv(1)=pizda(1,1)+pizda(2,2)
7755 vv(2)=pizda(2,1)-pizda(1,2)
7756 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7757 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7758 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7759 C Cartesian gradient
7763 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7765 vv(1)=pizda(1,1)+pizda(2,2)
7766 vv(2)=pizda(2,1)-pizda(1,2)
7767 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7768 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7769 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7775 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7776 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7777 cd write (2,*) 'ijkl',i,j,k,l
7778 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7779 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7781 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7782 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7783 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7784 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7785 if (j.lt.nres-1) then
7792 if (l.lt.nres-1) then
7802 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7803 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7804 C summed up outside the subrouine as for the other subroutines
7805 C handling long-range interactions. The old code is commented out
7806 C with "cgrad" to keep track of changes.
7808 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7809 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7810 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7811 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7812 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7813 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7814 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7815 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7816 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7817 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7819 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7820 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7821 cgrad ghalf=0.5d0*ggg1(ll)
7823 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7824 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7825 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7826 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7827 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7828 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7829 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7830 cgrad ghalf=0.5d0*ggg2(ll)
7832 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7833 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7834 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7835 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7836 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7837 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7842 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7843 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7848 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7849 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7855 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7860 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7864 cd write (2,*) iii,g_corr5_loc(iii)
7867 cd write (2,*) 'ekont',ekont
7868 cd write (iout,*) 'eello5',ekont*eel5
7871 c--------------------------------------------------------------------------
7872 double precision function eello6(i,j,k,l,jj,kk)
7873 implicit real*8 (a-h,o-z)
7874 include 'DIMENSIONS'
7875 include 'COMMON.IOUNITS'
7876 include 'COMMON.CHAIN'
7877 include 'COMMON.DERIV'
7878 include 'COMMON.INTERACT'
7879 include 'COMMON.CONTACTS'
7881 include 'COMMON.CONTACTS.MOMENT'
7883 include 'COMMON.TORSION'
7884 include 'COMMON.VAR'
7885 include 'COMMON.GEO'
7886 include 'COMMON.FFIELD'
7887 double precision ggg1(3),ggg2(3)
7888 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7893 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7901 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7902 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7906 derx(lll,kkk,iii)=0.0d0
7910 cd eij=facont_hb(jj,i)
7911 cd ekl=facont_hb(kk,k)
7917 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7918 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7919 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7920 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7921 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7922 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7924 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7925 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7926 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7927 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7928 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7929 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7933 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7935 C If turn contributions are considered, they will be handled separately.
7936 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7937 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7938 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7939 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7940 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7941 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7942 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7944 if (j.lt.nres-1) then
7951 if (l.lt.nres-1) then
7959 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7960 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7961 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7962 cgrad ghalf=0.5d0*ggg1(ll)
7964 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7965 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7966 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7967 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7968 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7969 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7970 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7971 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7972 cgrad ghalf=0.5d0*ggg2(ll)
7973 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7975 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7976 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7977 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7978 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7979 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7980 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7985 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7986 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7991 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7992 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7998 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8003 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8007 cd write (2,*) iii,g_corr6_loc(iii)
8010 cd write (2,*) 'ekont',ekont
8011 cd write (iout,*) 'eello6',ekont*eel6
8014 c--------------------------------------------------------------------------
8015 double precision function eello6_graph1(i,j,k,l,imat,swap)
8016 implicit real*8 (a-h,o-z)
8017 include 'DIMENSIONS'
8018 include 'COMMON.IOUNITS'
8019 include 'COMMON.CHAIN'
8020 include 'COMMON.DERIV'
8021 include 'COMMON.INTERACT'
8022 include 'COMMON.CONTACTS'
8024 include 'COMMON.CONTACTS.MOMENT'
8026 include 'COMMON.TORSION'
8027 include 'COMMON.VAR'
8028 include 'COMMON.GEO'
8029 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8033 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8035 C Parallel Antiparallel C
8041 C \ j|/k\| / \ |/k\|l / C
8046 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8047 itk=itortyp(itype(k))
8048 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8049 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8050 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8051 call transpose2(EUgC(1,1,k),auxmat(1,1))
8052 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8053 vv1(1)=pizda1(1,1)-pizda1(2,2)
8054 vv1(2)=pizda1(1,2)+pizda1(2,1)
8055 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8056 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8057 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8058 s5=scalar2(vv(1),Dtobr2(1,i))
8059 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8060 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8061 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8062 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8063 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8064 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8065 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8066 & +scalar2(vv(1),Dtobr2der(1,i)))
8067 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8068 vv1(1)=pizda1(1,1)-pizda1(2,2)
8069 vv1(2)=pizda1(1,2)+pizda1(2,1)
8070 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8071 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8073 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8074 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8075 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8076 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8077 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8079 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8080 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8081 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8082 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8083 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8085 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8086 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8087 vv1(1)=pizda1(1,1)-pizda1(2,2)
8088 vv1(2)=pizda1(1,2)+pizda1(2,1)
8089 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8090 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8091 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8092 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8101 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8102 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8103 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8104 call transpose2(EUgC(1,1,k),auxmat(1,1))
8105 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8107 vv1(1)=pizda1(1,1)-pizda1(2,2)
8108 vv1(2)=pizda1(1,2)+pizda1(2,1)
8109 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8110 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8111 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8112 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8113 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8114 s5=scalar2(vv(1),Dtobr2(1,i))
8115 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8121 c----------------------------------------------------------------------------
8122 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8123 implicit real*8 (a-h,o-z)
8124 include 'DIMENSIONS'
8125 include 'COMMON.IOUNITS'
8126 include 'COMMON.CHAIN'
8127 include 'COMMON.DERIV'
8128 include 'COMMON.INTERACT'
8129 include 'COMMON.CONTACTS'
8131 include 'COMMON.CONTACTS.MOMENT'
8133 include 'COMMON.TORSION'
8134 include 'COMMON.VAR'
8135 include 'COMMON.GEO'
8137 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8138 & auxvec1(2),auxvec2(1),auxmat1(2,2)
8141 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8143 C Parallel Antiparallel C
8149 C \ j|/k\| \ |/k\|l C
8154 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8155 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8156 C AL 7/4/01 s1 would occur in the sixth-order moment,
8157 C but not in a cluster cumulant
8159 s1=dip(1,jj,i)*dip(1,kk,k)
8161 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8162 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8163 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8164 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8165 call transpose2(EUg(1,1,k),auxmat(1,1))
8166 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8167 vv(1)=pizda(1,1)-pizda(2,2)
8168 vv(2)=pizda(1,2)+pizda(2,1)
8169 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8170 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8172 eello6_graph2=-(s1+s2+s3+s4)
8174 eello6_graph2=-(s2+s3+s4)
8177 C Derivatives in gamma(i-1)
8180 s1=dipderg(1,jj,i)*dip(1,kk,k)
8182 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8183 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8184 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8185 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8187 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8189 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8191 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8193 C Derivatives in gamma(k-1)
8195 s1=dip(1,jj,i)*dipderg(1,kk,k)
8197 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8198 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8199 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8200 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8201 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8202 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8203 vv(1)=pizda(1,1)-pizda(2,2)
8204 vv(2)=pizda(1,2)+pizda(2,1)
8205 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8207 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8209 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8211 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8212 C Derivatives in gamma(j-1) or gamma(l-1)
8215 s1=dipderg(3,jj,i)*dip(1,kk,k)
8217 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8218 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8219 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8220 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8221 vv(1)=pizda(1,1)-pizda(2,2)
8222 vv(2)=pizda(1,2)+pizda(2,1)
8223 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8226 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8228 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8231 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8232 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8234 C Derivatives in gamma(l-1) or gamma(j-1)
8237 s1=dip(1,jj,i)*dipderg(3,kk,k)
8239 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8240 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8241 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8242 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8243 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8244 vv(1)=pizda(1,1)-pizda(2,2)
8245 vv(2)=pizda(1,2)+pizda(2,1)
8246 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8249 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8251 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8254 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8255 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8257 C Cartesian derivatives.
8259 write (2,*) 'In eello6_graph2'
8261 write (2,*) 'iii=',iii
8263 write (2,*) 'kkk=',kkk
8265 write (2,'(3(2f10.5),5x)')
8266 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8276 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8278 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8281 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8283 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8284 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8286 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8287 call transpose2(EUg(1,1,k),auxmat(1,1))
8288 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8290 vv(1)=pizda(1,1)-pizda(2,2)
8291 vv(2)=pizda(1,2)+pizda(2,1)
8292 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8293 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8295 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8297 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8300 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8302 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8309 c----------------------------------------------------------------------------
8310 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8311 implicit real*8 (a-h,o-z)
8312 include 'DIMENSIONS'
8313 include 'COMMON.IOUNITS'
8314 include 'COMMON.CHAIN'
8315 include 'COMMON.DERIV'
8316 include 'COMMON.INTERACT'
8317 include 'COMMON.CONTACTS'
8319 include 'COMMON.CONTACTS.MOMENT'
8321 include 'COMMON.TORSION'
8322 include 'COMMON.VAR'
8323 include 'COMMON.GEO'
8324 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8326 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8328 C Parallel Antiparallel C
8334 C j|/k\| / |/k\|l / C
8339 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8341 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8342 C energy moment and not to the cluster cumulant.
8343 iti=itortyp(itype(i))
8344 if (j.lt.nres-1) then
8345 itj1=itortyp(itype(j+1))
8349 itk=itortyp(itype(k))
8350 itk1=itortyp(itype(k+1))
8351 if (l.lt.nres-1) then
8352 itl1=itortyp(itype(l+1))
8357 s1=dip(4,jj,i)*dip(4,kk,k)
8359 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8360 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8361 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8362 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8363 call transpose2(EE(1,1,itk),auxmat(1,1))
8364 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8365 vv(1)=pizda(1,1)+pizda(2,2)
8366 vv(2)=pizda(2,1)-pizda(1,2)
8367 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8368 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8369 cd & "sum",-(s2+s3+s4)
8371 eello6_graph3=-(s1+s2+s3+s4)
8373 eello6_graph3=-(s2+s3+s4)
8376 C Derivatives in gamma(k-1)
8377 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8378 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8379 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8380 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8381 C Derivatives in gamma(l-1)
8382 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8383 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8384 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8385 vv(1)=pizda(1,1)+pizda(2,2)
8386 vv(2)=pizda(2,1)-pizda(1,2)
8387 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8388 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8389 C Cartesian derivatives.
8395 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8397 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8400 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8402 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8403 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8405 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8406 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8408 vv(1)=pizda(1,1)+pizda(2,2)
8409 vv(2)=pizda(2,1)-pizda(1,2)
8410 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8412 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8414 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8417 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8419 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8421 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8427 c----------------------------------------------------------------------------
8428 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8429 implicit real*8 (a-h,o-z)
8430 include 'DIMENSIONS'
8431 include 'COMMON.IOUNITS'
8432 include 'COMMON.CHAIN'
8433 include 'COMMON.DERIV'
8434 include 'COMMON.INTERACT'
8435 include 'COMMON.CONTACTS'
8437 include 'COMMON.CONTACTS.MOMENT'
8439 include 'COMMON.TORSION'
8440 include 'COMMON.VAR'
8441 include 'COMMON.GEO'
8442 include 'COMMON.FFIELD'
8443 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8444 & auxvec1(2),auxmat1(2,2)
8446 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8448 C Parallel Antiparallel C
8454 C \ j|/k\| \ |/k\|l C
8459 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8461 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8462 C energy moment and not to the cluster cumulant.
8463 cd write (2,*) 'eello_graph4: wturn6',wturn6
8464 iti=itortyp(itype(i))
8465 itj=itortyp(itype(j))
8466 if (j.lt.nres-1) then
8467 itj1=itortyp(itype(j+1))
8471 itk=itortyp(itype(k))
8472 if (k.lt.nres-1) then
8473 itk1=itortyp(itype(k+1))
8477 itl=itortyp(itype(l))
8478 if (l.lt.nres-1) then
8479 itl1=itortyp(itype(l+1))
8483 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8484 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8485 cd & ' itl',itl,' itl1',itl1
8488 s1=dip(3,jj,i)*dip(3,kk,k)
8490 s1=dip(2,jj,j)*dip(2,kk,l)
8493 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8494 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8496 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8497 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8499 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8500 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8502 call transpose2(EUg(1,1,k),auxmat(1,1))
8503 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8504 vv(1)=pizda(1,1)-pizda(2,2)
8505 vv(2)=pizda(2,1)+pizda(1,2)
8506 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8507 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8509 eello6_graph4=-(s1+s2+s3+s4)
8511 eello6_graph4=-(s2+s3+s4)
8513 C Derivatives in gamma(i-1)
8517 s1=dipderg(2,jj,i)*dip(3,kk,k)
8519 s1=dipderg(4,jj,j)*dip(2,kk,l)
8522 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8524 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8525 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8527 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8528 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8530 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8531 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8532 cd write (2,*) 'turn6 derivatives'
8534 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8536 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8540 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8542 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8546 C Derivatives in gamma(k-1)
8549 s1=dip(3,jj,i)*dipderg(2,kk,k)
8551 s1=dip(2,jj,j)*dipderg(4,kk,l)
8554 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8555 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8557 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8558 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8560 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8561 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8563 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8564 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8565 vv(1)=pizda(1,1)-pizda(2,2)
8566 vv(2)=pizda(2,1)+pizda(1,2)
8567 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8568 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8570 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8572 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8576 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8578 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8581 C Derivatives in gamma(j-1) or gamma(l-1)
8582 if (l.eq.j+1 .and. l.gt.1) then
8583 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8584 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8585 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8586 vv(1)=pizda(1,1)-pizda(2,2)
8587 vv(2)=pizda(2,1)+pizda(1,2)
8588 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8589 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8590 else if (j.gt.1) then
8591 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8592 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8593 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8594 vv(1)=pizda(1,1)-pizda(2,2)
8595 vv(2)=pizda(2,1)+pizda(1,2)
8596 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8597 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8598 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8600 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8603 C Cartesian derivatives.
8610 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8612 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8616 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8618 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8622 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8624 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8626 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8627 & b1(1,itj1),auxvec(1))
8628 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8630 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8631 & b1(1,itl1),auxvec(1))
8632 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8634 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8636 vv(1)=pizda(1,1)-pizda(2,2)
8637 vv(2)=pizda(2,1)+pizda(1,2)
8638 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8640 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8642 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8645 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8648 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8651 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8653 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8655 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8659 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8661 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8664 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8666 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8674 c----------------------------------------------------------------------------
8675 double precision function eello_turn6(i,jj,kk)
8676 implicit real*8 (a-h,o-z)
8677 include 'DIMENSIONS'
8678 include 'COMMON.IOUNITS'
8679 include 'COMMON.CHAIN'
8680 include 'COMMON.DERIV'
8681 include 'COMMON.INTERACT'
8682 include 'COMMON.CONTACTS'
8684 include 'COMMON.CONTACTS.MOMENT'
8686 include 'COMMON.TORSION'
8687 include 'COMMON.VAR'
8688 include 'COMMON.GEO'
8689 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8690 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8692 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8693 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8694 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8695 C the respective energy moment and not to the cluster cumulant.
8704 iti=itortyp(itype(i))
8705 itk=itortyp(itype(k))
8706 itk1=itortyp(itype(k+1))
8707 itl=itortyp(itype(l))
8708 itj=itortyp(itype(j))
8709 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8710 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8711 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8716 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8718 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8722 derx_turn(lll,kkk,iii)=0.0d0
8729 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8731 cd write (2,*) 'eello6_5',eello6_5
8733 call transpose2(AEA(1,1,1),auxmat(1,1))
8734 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8735 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8736 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8738 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8739 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8740 s2 = scalar2(b1(1,itk),vtemp1(1))
8742 call transpose2(AEA(1,1,2),atemp(1,1))
8743 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8744 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8745 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8747 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8748 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8749 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8751 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8752 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8753 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8754 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8755 ss13 = scalar2(b1(1,itk),vtemp4(1))
8756 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8758 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8764 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8765 C Derivatives in gamma(i+2)
8769 call transpose2(AEA(1,1,1),auxmatd(1,1))
8770 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8771 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8772 call transpose2(AEAderg(1,1,2),atempd(1,1))
8773 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8774 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8776 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8777 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8778 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8784 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8785 C Derivatives in gamma(i+3)
8787 call transpose2(AEA(1,1,1),auxmatd(1,1))
8788 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8789 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8790 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8792 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8793 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8794 s2d = scalar2(b1(1,itk),vtemp1d(1))
8796 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8797 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8799 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8801 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8802 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8803 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8811 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8812 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8814 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8815 & -0.5d0*ekont*(s2d+s12d)
8817 C Derivatives in gamma(i+4)
8818 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8819 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8820 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8822 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8823 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8824 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8832 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8834 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8836 C Derivatives in gamma(i+5)
8838 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8839 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8840 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8842 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8843 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8844 s2d = scalar2(b1(1,itk),vtemp1d(1))
8846 call transpose2(AEA(1,1,2),atempd(1,1))
8847 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8848 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8850 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8851 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8853 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8854 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8855 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8863 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8864 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8866 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8867 & -0.5d0*ekont*(s2d+s12d)
8869 C Cartesian derivatives
8874 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8875 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8876 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8878 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8879 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8881 s2d = scalar2(b1(1,itk),vtemp1d(1))
8883 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8884 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8885 s8d = -(atempd(1,1)+atempd(2,2))*
8886 & scalar2(cc(1,1,itl),vtemp2(1))
8888 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8890 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8891 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8898 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8901 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8905 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8906 & - 0.5d0*(s8d+s12d)
8908 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8917 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8919 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8920 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8921 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8922 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8923 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8925 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8926 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8927 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8931 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8932 cd & 16*eel_turn6_num
8934 if (j.lt.nres-1) then
8941 if (l.lt.nres-1) then
8949 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8950 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8951 cgrad ghalf=0.5d0*ggg1(ll)
8953 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8954 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8955 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8956 & +ekont*derx_turn(ll,2,1)
8957 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8958 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8959 & +ekont*derx_turn(ll,4,1)
8960 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8961 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8962 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8963 cgrad ghalf=0.5d0*ggg2(ll)
8965 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8966 & +ekont*derx_turn(ll,2,2)
8967 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8968 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8969 & +ekont*derx_turn(ll,4,2)
8970 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8971 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8972 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8977 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8982 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8988 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8993 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8997 cd write (2,*) iii,g_corr6_loc(iii)
8999 eello_turn6=ekont*eel_turn6
9000 cd write (2,*) 'ekont',ekont
9001 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9005 C-----------------------------------------------------------------------------
9006 double precision function scalar(u,v)
9007 !DIR$ INLINEALWAYS scalar
9009 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9012 double precision u(3),v(3)
9013 cd double precision sc
9021 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9024 crc-------------------------------------------------
9025 SUBROUTINE MATVEC2(A1,V1,V2)
9026 !DIR$ INLINEALWAYS MATVEC2
9028 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9030 implicit real*8 (a-h,o-z)
9031 include 'DIMENSIONS'
9032 DIMENSION A1(2,2),V1(2),V2(2)
9036 c 3 VI=VI+A1(I,K)*V1(K)
9040 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9041 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9046 C---------------------------------------
9047 SUBROUTINE MATMAT2(A1,A2,A3)
9049 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9051 implicit real*8 (a-h,o-z)
9052 include 'DIMENSIONS'
9053 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9054 c DIMENSION AI3(2,2)
9058 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9064 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9065 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9066 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9067 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9075 c-------------------------------------------------------------------------
9076 double precision function scalar2(u,v)
9077 !DIR$ INLINEALWAYS scalar2
9079 double precision u(2),v(2)
9082 scalar2=u(1)*v(1)+u(2)*v(2)
9086 C-----------------------------------------------------------------------------
9088 subroutine transpose2(a,at)
9089 !DIR$ INLINEALWAYS transpose2
9091 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9094 double precision a(2,2),at(2,2)
9101 c--------------------------------------------------------------------------
9102 subroutine transpose(n,a,at)
9105 double precision a(n,n),at(n,n)
9113 C---------------------------------------------------------------------------
9114 subroutine prodmat3(a1,a2,kk,transp,prod)
9115 !DIR$ INLINEALWAYS prodmat3
9117 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9121 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9123 crc double precision auxmat(2,2),prod_(2,2)
9126 crc call transpose2(kk(1,1),auxmat(1,1))
9127 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9128 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9130 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9131 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9132 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9133 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9134 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9135 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9136 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9137 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9140 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9141 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9143 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9144 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9145 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9146 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9147 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9148 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9149 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9150 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9153 c call transpose2(a2(1,1),a2t(1,1))
9156 crc print *,((prod_(i,j),i=1,2),j=1,2)
9157 crc print *,((prod(i,j),i=1,2),j=1,2)