1 subroutine etotal(energia)
2 implicit real*8 (a-h,o-z)
7 cMS$ATTRIBUTES C :: proc_proc
12 double precision weights_(n_ene)
14 include 'COMMON.SETUP'
15 include 'COMMON.IOUNITS'
16 double precision energia(0:n_ene)
17 include 'COMMON.LOCAL'
18 include 'COMMON.FFIELD'
19 include 'COMMON.DERIV'
20 include 'COMMON.INTERACT'
21 include 'COMMON.SBRIDGE'
22 include 'COMMON.CHAIN'
25 include 'COMMON.CONTROL'
26 include 'COMMON.TIME1'
28 c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
29 c & " nfgtasks",nfgtasks
30 if (nfgtasks.gt.1) then
32 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
33 if (fg_rank.eq.0) then
34 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
35 c print *,"Processor",myrank," BROADCAST iorder"
36 C FG master sets up the WEIGHTS_ array which will be broadcast to the
37 C FG slaves as WEIGHTS array.
58 C FG Master broadcasts the WEIGHTS_ array
59 call MPI_Bcast(weights_(1),n_ene,
60 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
62 C FG slaves receive the WEIGHTS array
63 call MPI_Bcast(weights(1),n_ene,
64 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
86 time_Bcast=time_Bcast+MPI_Wtime()-time00
87 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
88 c call chainbuild_cart
90 c print *,'Processor',myrank,' calling etotal ipot=',ipot
91 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
93 c if (modecalc.eq.12.or.modecalc.eq.14) then
94 c call int_from_cart1(.false.)
101 C Compute the side-chain and electrostatic interaction energy
103 goto (101,102,103,104,105,106) ipot
104 C Lennard-Jones potential.
105 101 call elj(evdw,evdw_p,evdw_m)
106 cd print '(a)','Exit ELJ'
108 C Lennard-Jones-Kihara potential (shifted).
109 102 call eljk(evdw,evdw_p,evdw_m)
111 C Berne-Pechukas potential (dilated LJ, angular dependence).
112 103 call ebp(evdw,evdw_p,evdw_m)
114 C Gay-Berne potential (shifted LJ, angular dependence).
115 104 call egb(evdw,evdw_p,evdw_m)
117 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
118 105 call egbv(evdw,evdw_p,evdw_m)
120 C Soft-sphere potential
121 106 call e_softsphere(evdw)
123 C Calculate electrostatic (H-bonding) energy of the main chain.
127 C JUYONG for dfa test!
128 if (wdfa_dist.gt.0) call edfad(edfadis)
129 c print*, 'edfad is finished!', edfadis
130 if (wdfa_tor.gt.0) call edfat(edfator)
131 c print*, 'edfat is finished!', edfator
132 if (wdfa_nei.gt.0) call edfan(edfanei)
133 c print*, 'edfan is finished!', edfanei
134 if (wdfa_beta.gt.0) call edfab(edfabet)
135 c print*, 'edfab is finished!', edfabet
139 c print *,"Processor",myrank," computed USCSC"
145 time_vec=time_vec+MPI_Wtime()-time01
147 c print *,"Processor",myrank," left VEC_AND_DERIV"
150 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
151 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
152 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
153 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
155 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
156 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
157 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
158 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
160 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
169 c write (iout,*) "Soft-spheer ELEC potential"
170 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
173 c print *,"Processor",myrank," computed UELEC"
175 C Calculate excluded-volume interaction energy between peptide groups
180 call escp(evdw2,evdw2_14)
186 c write (iout,*) "Soft-sphere SCP potential"
187 call escp_soft_sphere(evdw2,evdw2_14)
190 c Calculate the bond-stretching energy
194 C Calculate the disulfide-bridge and other energy and the contributions
195 C from other distance constraints.
196 cd print *,'Calling EHPB'
198 cd print *,'EHPB exitted succesfully.'
200 C Calculate the virtual-bond-angle energy.
202 if (wang.gt.0d0) then
207 c print *,"Processor",myrank," computed UB"
209 C Calculate the SC local energy.
212 c print *,"Processor",myrank," computed USC"
214 C Calculate the virtual-bond torsional energy.
216 cd print *,'nterm=',nterm
218 call etor(etors,edihcnstr)
223 c print *,"Processor",myrank," computed Utor"
225 C 6/23/01 Calculate double-torsional energy
227 if (wtor_d.gt.0) then
232 c print *,"Processor",myrank," computed Utord"
234 C 21/5/07 Calculate local sicdechain correlation energy
236 if (wsccor.gt.0.0d0) then
237 call eback_sc_corr(esccor)
241 c print *,"Processor",myrank," computed Usccorr"
243 C 12/1/95 Multi-body terms
247 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
248 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
249 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
250 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
251 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
258 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
259 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
260 cd write (iout,*) "multibody_hb ecorr",ecorr
262 c print *,"Processor",myrank," computed Ucorr"
264 C If performing constraint dynamics, call the constraint energy
265 C after the equilibration time
266 if(usampl.and.totT.gt.eq_time) then
274 time_enecalc=time_enecalc+MPI_Wtime()-time00
276 c print *,"Processor",myrank," computed Uconstr"
285 energia(2)=evdw2-evdw2_14
302 energia(8)=eello_turn3
303 energia(9)=eello_turn4
310 energia(19)=edihcnstr
312 energia(20)=Uconst+Uconst_back
320 c print *," Processor",myrank," calls SUM_ENERGY"
321 call sum_energy(energia,.true.)
322 c print *," Processor",myrank," left SUM_ENERGY"
324 time_sumene=time_sumene+MPI_Wtime()-time00
327 c print*, 'etot:',energia(0)
331 c-------------------------------------------------------------------------------
332 subroutine sum_energy(energia,reduce)
333 implicit real*8 (a-h,o-z)
338 cMS$ATTRIBUTES C :: proc_proc
344 include 'COMMON.SETUP'
345 include 'COMMON.IOUNITS'
346 double precision energia(0:n_ene),enebuff(0:n_ene+1)
347 include 'COMMON.FFIELD'
348 include 'COMMON.DERIV'
349 include 'COMMON.INTERACT'
350 include 'COMMON.SBRIDGE'
351 include 'COMMON.CHAIN'
353 include 'COMMON.CONTROL'
354 include 'COMMON.TIME1'
357 if (nfgtasks.gt.1 .and. reduce) then
359 write (iout,*) "energies before REDUCE"
360 call enerprint(energia)
364 enebuff(i)=energia(i)
367 call MPI_Barrier(FG_COMM,IERR)
368 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
370 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
371 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
373 write (iout,*) "energies after REDUCE"
374 call enerprint(energia)
377 time_Reduce=time_Reduce+MPI_Wtime()-time00
379 if (fg_rank.eq.0) then
382 evdw=energia(22)+wsct*energia(23)
387 evdw2=energia(2)+energia(18)
403 eello_turn3=energia(8)
404 eello_turn4=energia(9)
411 edihcnstr=energia(19)
420 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
421 & +wang*ebe+wtor*etors+wscloc*escloc
422 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
423 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
424 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
425 & +wbond*estr+Uconst+wsccor*esccor
426 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
429 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
430 & +wang*ebe+wtor*etors+wscloc*escloc
431 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
432 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
433 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
434 & +wbond*estr+Uconst+wsccor*esccor
435 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
443 if (isnan(etot).ne.0) energia(0)=1.0d+99
445 if (isnan(etot)) energia(0)=1.0d+99
450 idumm=proc_proc(etot,i)
452 call proc_proc(etot,i)
454 if(i.eq.1)energia(0)=1.0d+99
461 c-------------------------------------------------------------------------------
462 subroutine sum_gradient
463 implicit real*8 (a-h,o-z)
468 cMS$ATTRIBUTES C :: proc_proc
473 double precision gradbufc(3,maxres),gradbufx(3,maxres),
474 & glocbuf(4*maxres),gradbufc_sum(3,maxres)
476 double precision gradbufc(3,maxres),gradbufx(3,maxres),
477 & glocbuf(4*maxres),gradbufc_sum(3,maxres)
479 include 'COMMON.SETUP'
480 include 'COMMON.IOUNITS'
481 include 'COMMON.FFIELD'
482 include 'COMMON.DERIV'
483 include 'COMMON.INTERACT'
484 include 'COMMON.SBRIDGE'
485 include 'COMMON.CHAIN'
487 include 'COMMON.CONTROL'
488 include 'COMMON.TIME1'
489 include 'COMMON.MAXGRAD'
494 write (iout,*) "sum_gradient gvdwc, gvdwx"
496 write (iout,'(i3,3f10.5,5x,3f10.5,5x,3f10.5,5x,3f10.5)')
497 & i,(gvdwx(j,i),j=1,3),(gvdwcT(j,i),j=1,3),(gvdwc(j,i),j=1,3),
498 & (gvdwcT(j,i),j=1,3)
503 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
504 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
505 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
508 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
509 C in virtual-bond-vector coordinates
512 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
514 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
515 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
517 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
519 c write (iout,'(i5,3f10.5,2x,f10.5)')
520 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
522 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
524 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
525 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
534 gradbufc(j,i)=wsc*gvdwc(j,i)+wsc*wscT*gvdwcT(j,i)+
535 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
536 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
537 & wel_loc*gel_loc_long(j,i)+
538 & wcorr*gradcorr_long(j,i)+
539 & wcorr5*gradcorr5_long(j,i)+
540 & wcorr6*gradcorr6_long(j,i)+
541 & wturn6*gcorr6_turn_long(j,i)+
542 & wstrain*ghpbc(j,i)+
543 & wdfa_dist*gdfad(j,i)+
544 & wdfa_tor*gdfat(j,i)+
545 & wdfa_nei*gdfan(j,i)+
546 & wdfa_beta*gdfab(j,i)
553 gradbufc(j,i)=wsc*gvdwc(j,i)+
554 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
555 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
556 & wel_loc*gel_loc_long(j,i)+
557 & wcorr*gradcorr_long(j,i)+
558 & wcorr5*gradcorr5_long(j,i)+
559 & wcorr6*gradcorr6_long(j,i)+
560 & wturn6*gcorr6_turn_long(j,i)+
561 & wstrain*ghpbc(j,i)+
562 & wdfa_dist*gdfad(j,i)+
563 & wdfa_tor*gdfat(j,i)+
564 & wdfa_nei*gdfan(j,i)+
565 & wdfa_beta*gdfab(j,i)
573 gradbufc(j,i)=wsc*gvdwc(j,i)+
574 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
575 & welec*gelc_long(j,i)+
577 & wel_loc*gel_loc_long(j,i)+
578 & wcorr*gradcorr_long(j,i)+
579 & wcorr5*gradcorr5_long(j,i)+
580 & wcorr6*gradcorr6_long(j,i)+
581 & wturn6*gcorr6_turn_long(j,i)+
582 & wstrain*ghpbc(j,i)+
583 & wdfa_dist*gdfad(j,i)+
584 & wdfa_tor*gdfat(j,i)+
585 & wdfa_nei*gdfan(j,i)+
586 & wdfa_beta*gdfab(j,i)
593 if (nfgtasks.gt.1) then
596 write (iout,*) "gradbufc before allreduce"
598 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
602 call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
603 & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
604 time_reduce=time_reduce+MPI_Wtime()-time00
606 write (iout,*) "gradbufc_sum after allreduce"
608 write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
613 time_allreduce=time_allreduce+MPI_Wtime()-time00
620 do i=igrad_start,igrad_end
621 do j=jgrad_start(i),jgrad_end(i)
623 gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
630 write (iout,*) "gradbufc"
632 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
642 gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
650 gradbufc(k,nres)=0.0d0
655 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
656 & wel_loc*gel_loc(j,i)+
657 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
658 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
659 & wel_loc*gel_loc_long(j,i)+
660 & wcorr*gradcorr_long(j,i)+
661 & wcorr5*gradcorr5_long(j,i)+
662 & wcorr6*gradcorr6_long(j,i)+
663 & wturn6*gcorr6_turn_long(j,i))+
665 & wcorr*gradcorr(j,i)+
666 & wturn3*gcorr3_turn(j,i)+
667 & wturn4*gcorr4_turn(j,i)+
668 & wcorr5*gradcorr5(j,i)+
669 & wcorr6*gradcorr6(j,i)+
670 & wturn6*gcorr6_turn(j,i)+
671 & wsccor*gsccorc(j,i)
672 & +wscloc*gscloc(j,i)
674 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
675 & wel_loc*gel_loc(j,i)+
676 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
677 & welec*gelc_long(j,i)
678 & wel_loc*gel_loc_long(j,i)+
679 & wcorr*gcorr_long(j,i)+
680 & wcorr5*gradcorr5_long(j,i)+
681 & wcorr6*gradcorr6_long(j,i)+
682 & wturn6*gcorr6_turn_long(j,i))+
684 & wcorr*gradcorr(j,i)+
685 & wturn3*gcorr3_turn(j,i)+
686 & wturn4*gcorr4_turn(j,i)+
687 & wcorr5*gradcorr5(j,i)+
688 & wcorr6*gradcorr6(j,i)+
689 & wturn6*gcorr6_turn(j,i)+
690 & wsccor*gsccorc(j,i)
691 & +wscloc*gscloc(j,i)
694 gradx(j,i,icg)=wsc*gvdwx(j,i)+wsc*wscT*gvdwxT(j,i)+
695 & wscp*gradx_scp(j,i)+
697 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
698 & wsccor*gsccorx(j,i)
699 & +wscloc*gsclocx(j,i)
701 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
703 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
704 & wsccor*gsccorx(j,i)
705 & +wscloc*gsclocx(j,i)
710 write (iout,*) "gloc before adding corr"
712 write (iout,*) i,gloc(i,icg)
716 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
717 & +wcorr5*g_corr5_loc(i)
718 & +wcorr6*g_corr6_loc(i)
719 & +wturn4*gel_loc_turn4(i)
720 & +wturn3*gel_loc_turn3(i)
721 & +wturn6*gel_loc_turn6(i)
722 & +wel_loc*gel_loc_loc(i)
723 & +wsccor*gsccor_loc(i)
726 write (iout,*) "gloc after adding corr"
728 write (iout,*) i,gloc(i,icg)
732 if (nfgtasks.gt.1) then
735 gradbufc(j,i)=gradc(j,i,icg)
736 gradbufx(j,i)=gradx(j,i,icg)
740 glocbuf(i)=gloc(i,icg)
743 call MPI_Barrier(FG_COMM,IERR)
744 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
746 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
747 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
748 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
749 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
750 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
751 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
752 time_reduce=time_reduce+MPI_Wtime()-time00
754 write (iout,*) "gloc after reduce"
756 write (iout,*) i,gloc(i,icg)
761 if (gnorm_check) then
763 c Compute the maximum elements of the gradient
773 gcorr3_turn_max=0.0d0
774 gcorr4_turn_max=0.0d0
777 gcorr6_turn_max=0.0d0
787 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
788 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
790 gvdwc_norm=dsqrt(scalar(gvdwcT(1,i),gvdwcT(1,i)))
791 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
793 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
794 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
795 & gvdwc_scp_max=gvdwc_scp_norm
796 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
797 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
798 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
799 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
800 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
801 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
802 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
803 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
804 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
805 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
806 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
807 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
808 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
810 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
811 & gcorr3_turn_max=gcorr3_turn_norm
812 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
814 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
815 & gcorr4_turn_max=gcorr4_turn_norm
816 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
817 if (gradcorr5_norm.gt.gradcorr5_max)
818 & gradcorr5_max=gradcorr5_norm
819 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
820 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
821 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
823 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
824 & gcorr6_turn_max=gcorr6_turn_norm
825 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
826 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
827 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
828 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
829 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
830 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
832 gvdwx_norm=dsqrt(scalar(gvdwxT(1,i),gvdwxT(1,i)))
833 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
835 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
836 if (gradx_scp_norm.gt.gradx_scp_max)
837 & gradx_scp_max=gradx_scp_norm
838 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
839 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
840 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
841 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
842 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
843 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
844 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
845 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
849 open(istat,file=statname,position="append")
851 open(istat,file=statname,access="append")
853 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
854 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
855 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
856 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
857 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
858 & gsccorx_max,gsclocx_max
860 if (gvdwc_max.gt.1.0d4) then
861 write (iout,*) "gvdwc gvdwx gradb gradbx"
863 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
864 & gradb(j,i),gradbx(j,i),j=1,3)
866 call pdbout(0.0d0,'cipiszcze',iout)
872 write (iout,*) "gradc gradx gloc"
874 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
875 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
879 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
883 c-------------------------------------------------------------------------------
884 subroutine rescale_weights(t_bath)
885 implicit real*8 (a-h,o-z)
887 include 'COMMON.IOUNITS'
888 include 'COMMON.FFIELD'
889 include 'COMMON.SBRIDGE'
890 double precision kfac /2.4d0/
891 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
893 c facT=2*temp0/(t_bath+temp0)
894 if (rescale_mode.eq.0) then
900 else if (rescale_mode.eq.1) then
901 facT=kfac/(kfac-1.0d0+t_bath/temp0)
902 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
903 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
904 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
905 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
906 else if (rescale_mode.eq.2) then
912 facT=licznik/dlog(dexp(x)+dexp(-x))
913 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
914 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
915 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
916 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
918 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
919 write (*,*) "Wrong RESCALE_MODE",rescale_mode
921 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
925 welec=weights(3)*fact
926 wcorr=weights(4)*fact3
927 wcorr5=weights(5)*fact4
928 wcorr6=weights(6)*fact5
929 wel_loc=weights(7)*fact2
930 wturn3=weights(8)*fact2
931 wturn4=weights(9)*fact3
932 wturn6=weights(10)*fact5
933 wtor=weights(13)*fact
934 wtor_d=weights(14)*fact2
935 wsccor=weights(21)*fact
938 wsct=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
942 C------------------------------------------------------------------------
943 subroutine enerprint(energia)
944 implicit real*8 (a-h,o-z)
946 include 'COMMON.IOUNITS'
947 include 'COMMON.FFIELD'
948 include 'COMMON.SBRIDGE'
950 double precision energia(0:n_ene)
953 evdw=energia(22)+wsct*energia(23)
959 evdw2=energia(2)+energia(18)
971 eello_turn3=energia(8)
972 eello_turn4=energia(9)
973 eello_turn6=energia(10)
979 edihcnstr=energia(19)
984 edfadis = energia(24)
985 edfator = energia(25)
986 edfanei = energia(26)
987 edfabet = energia(27)
990 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
991 & estr,wbond,ebe,wang,
992 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
994 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
995 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
997 & Uconst,edfadis,edfator,edfanei,edfabet,etot
998 10 format (/'Virtual-chain energies:'//
999 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1000 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1001 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1002 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
1003 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1004 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1005 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1006 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1007 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1008 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1009 & ' (SS bridges & dist. cnstr.)'/
1010 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1011 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1012 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1013 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1014 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1015 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1016 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1017 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1018 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1019 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1020 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1021 & 'EDFAD= ',1pE16.6,' (DFA distance energy)'/
1022 & 'EDFAT= ',1pE16.6,' (DFA torsion energy)'/
1023 & 'EDFAN= ',1pE16.6,' (DFA NCa energy)'/
1024 & 'EDFAB= ',1pE16.6,' (DFA Beta energy)'/
1025 & 'ETOT= ',1pE16.6,' (total)')
1027 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1028 & estr,wbond,ebe,wang,
1029 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1031 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1032 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1034 & Uconst,edfadis,edfator,edfanei,edfabet,etot
1035 10 format (/'Virtual-chain energies:'//
1036 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1037 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1038 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1039 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1040 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1041 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1042 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1043 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1044 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1045 & ' (SS bridges & dist. cnstr.)'/
1046 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1047 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1048 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1049 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1050 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1051 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1052 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1053 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1054 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1055 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1056 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1057 & 'EDFAD= ',1pE16.6,' (DFA distance energy)'/
1058 & 'EDFAT= ',1pE16.6,' (DFA torsion energy)'/
1059 & 'EDFAN= ',1pE16.6,' (DFA NCa energy)'/
1060 & 'EDFAB= ',1pE16.6,' (DFA Beta energy)'/
1061 & 'ETOT= ',1pE16.6,' (total)')
1065 C-----------------------------------------------------------------------
1066 subroutine elj(evdw,evdw_p,evdw_m)
1068 C This subroutine calculates the interaction energy of nonbonded side chains
1069 C assuming the LJ potential of interaction.
1071 implicit real*8 (a-h,o-z)
1072 include 'DIMENSIONS'
1073 parameter (accur=1.0d-10)
1074 include 'COMMON.GEO'
1075 include 'COMMON.VAR'
1076 include 'COMMON.LOCAL'
1077 include 'COMMON.CHAIN'
1078 include 'COMMON.DERIV'
1079 include 'COMMON.INTERACT'
1080 include 'COMMON.TORSION'
1081 include 'COMMON.SBRIDGE'
1082 include 'COMMON.NAMES'
1083 include 'COMMON.IOUNITS'
1084 include 'COMMON.CONTACTS'
1086 include 'COMMON.CONTACTS.MOMENT'
1089 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1091 do i=iatsc_s,iatsc_e
1092 itypi=iabs(itype(i))
1093 itypi1=iabs(itype(i+1))
1100 C Calculate SC interaction energy.
1102 do iint=1,nint_gr(i)
1103 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1104 cd & 'iend=',iend(i,iint)
1105 do j=istart(i,iint),iend(i,iint)
1106 itypj=iabs(itype(j))
1110 C Change 12/1/95 to calculate four-body interactions
1111 rij=xj*xj+yj*yj+zj*zj
1113 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1114 eps0ij=eps(itypi,itypj)
1116 e1=fac*fac*aa(itypi,itypj)
1117 e2=fac*bb(itypi,itypj)
1119 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1120 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1121 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1122 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1123 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1124 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1126 if (bb(itypi,itypj).gt.0) then
1127 evdw_p=evdw_p+evdwij
1129 evdw_m=evdw_m+evdwij
1135 C Calculate the components of the gradient in DC and X
1137 fac=-rrij*(e1+evdwij)
1142 if (bb(itypi,itypj).gt.0.0d0) then
1144 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1145 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1146 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1147 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1151 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1152 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1153 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1154 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1159 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1160 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1161 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1162 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1167 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1171 C 12/1/95, revised on 5/20/97
1173 C Calculate the contact function. The ith column of the array JCONT will
1174 C contain the numbers of atoms that make contacts with the atom I (of numbers
1175 C greater than I). The arrays FACONT and GACONT will contain the values of
1176 C the contact function and its derivative.
1178 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1179 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1180 C Uncomment next line, if the correlation interactions are contact function only
1181 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1183 sigij=sigma(itypi,itypj)
1184 r0ij=rs0(itypi,itypj)
1186 C Check whether the SC's are not too far to make a contact.
1189 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1190 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1192 if (fcont.gt.0.0D0) then
1193 C If the SC-SC distance if close to sigma, apply spline.
1194 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1195 cAdam & fcont1,fprimcont1)
1196 cAdam fcont1=1.0d0-fcont1
1197 cAdam if (fcont1.gt.0.0d0) then
1198 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1199 cAdam fcont=fcont*fcont1
1201 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1202 cga eps0ij=1.0d0/dsqrt(eps0ij)
1204 cga gg(k)=gg(k)*eps0ij
1206 cga eps0ij=-evdwij*eps0ij
1207 C Uncomment for AL's type of SC correlation interactions.
1208 cadam eps0ij=-evdwij
1209 num_conti=num_conti+1
1210 jcont(num_conti,i)=j
1211 facont(num_conti,i)=fcont*eps0ij
1212 fprimcont=eps0ij*fprimcont/rij
1214 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1215 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1216 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1217 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1218 gacont(1,num_conti,i)=-fprimcont*xj
1219 gacont(2,num_conti,i)=-fprimcont*yj
1220 gacont(3,num_conti,i)=-fprimcont*zj
1221 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1222 cd write (iout,'(2i3,3f10.5)')
1223 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1229 num_cont(i)=num_conti
1233 gvdwc(j,i)=expon*gvdwc(j,i)
1234 gvdwx(j,i)=expon*gvdwx(j,i)
1237 C******************************************************************************
1241 C To save time, the factor of EXPON has been extracted from ALL components
1242 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1245 C******************************************************************************
1248 C-----------------------------------------------------------------------------
1249 subroutine eljk(evdw,evdw_p,evdw_m)
1251 C This subroutine calculates the interaction energy of nonbonded side chains
1252 C assuming the LJK potential of interaction.
1254 implicit real*8 (a-h,o-z)
1255 include 'DIMENSIONS'
1256 include 'COMMON.GEO'
1257 include 'COMMON.VAR'
1258 include 'COMMON.LOCAL'
1259 include 'COMMON.CHAIN'
1260 include 'COMMON.DERIV'
1261 include 'COMMON.INTERACT'
1262 include 'COMMON.IOUNITS'
1263 include 'COMMON.NAMES'
1266 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1268 do i=iatsc_s,iatsc_e
1269 itypi=iabs(itype(i))
1270 itypi1=iabs(itype(i+1))
1275 C Calculate SC interaction energy.
1277 do iint=1,nint_gr(i)
1278 do j=istart(i,iint),iend(i,iint)
1279 itypj=iabs(itype(j))
1283 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1284 fac_augm=rrij**expon
1285 e_augm=augm(itypi,itypj)*fac_augm
1286 r_inv_ij=dsqrt(rrij)
1288 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1289 fac=r_shift_inv**expon
1290 e1=fac*fac*aa(itypi,itypj)
1291 e2=fac*bb(itypi,itypj)
1293 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1294 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1295 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1296 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1297 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1298 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1299 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1301 if (bb(itypi,itypj).gt.0) then
1302 evdw_p=evdw_p+evdwij
1304 evdw_m=evdw_m+evdwij
1310 C Calculate the components of the gradient in DC and X
1312 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1317 if (bb(itypi,itypj).gt.0.0d0) then
1319 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1320 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1321 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1322 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1326 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1327 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1328 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1329 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1334 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1335 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1336 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1337 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1342 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1350 gvdwc(j,i)=expon*gvdwc(j,i)
1351 gvdwx(j,i)=expon*gvdwx(j,i)
1356 C-----------------------------------------------------------------------------
1357 subroutine ebp(evdw,evdw_p,evdw_m)
1359 C This subroutine calculates the interaction energy of nonbonded side chains
1360 C assuming the Berne-Pechukas potential of interaction.
1362 implicit real*8 (a-h,o-z)
1363 include 'DIMENSIONS'
1364 include 'COMMON.GEO'
1365 include 'COMMON.VAR'
1366 include 'COMMON.LOCAL'
1367 include 'COMMON.CHAIN'
1368 include 'COMMON.DERIV'
1369 include 'COMMON.NAMES'
1370 include 'COMMON.INTERACT'
1371 include 'COMMON.IOUNITS'
1372 include 'COMMON.CALC'
1373 common /srutu/ icall
1374 c double precision rrsave(maxdim)
1377 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1379 c if (icall.eq.0) then
1385 do i=iatsc_s,iatsc_e
1386 itypi=iabs(itype(i))
1387 itypi1=iabs(itype(i+1))
1391 dxi=dc_norm(1,nres+i)
1392 dyi=dc_norm(2,nres+i)
1393 dzi=dc_norm(3,nres+i)
1394 c dsci_inv=dsc_inv(itypi)
1395 dsci_inv=vbld_inv(i+nres)
1397 C Calculate SC interaction energy.
1399 do iint=1,nint_gr(i)
1400 do j=istart(i,iint),iend(i,iint)
1403 c dscj_inv=dsc_inv(itypj)
1404 dscj_inv=vbld_inv(j+nres)
1405 chi1=chi(itypi,itypj)
1406 chi2=chi(itypj,itypi)
1413 alf12=0.5D0*(alf1+alf2)
1414 C For diagnostics only!!!
1427 dxj=dc_norm(1,nres+j)
1428 dyj=dc_norm(2,nres+j)
1429 dzj=dc_norm(3,nres+j)
1430 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1431 cd if (icall.eq.0) then
1437 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1439 C Calculate whole angle-dependent part of epsilon and contributions
1440 C to its derivatives
1441 fac=(rrij*sigsq)**expon2
1442 e1=fac*fac*aa(itypi,itypj)
1443 e2=fac*bb(itypi,itypj)
1444 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1445 eps2der=evdwij*eps3rt
1446 eps3der=evdwij*eps2rt
1447 evdwij=evdwij*eps2rt*eps3rt
1449 if (bb(itypi,itypj).gt.0) then
1450 evdw_p=evdw_p+evdwij
1452 evdw_m=evdw_m+evdwij
1458 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1459 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1460 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1461 cd & restyp(itypi),i,restyp(itypj),j,
1462 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1463 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1464 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1467 C Calculate gradient components.
1468 e1=e1*eps1*eps2rt**2*eps3rt**2
1469 fac=-expon*(e1+evdwij)
1472 C Calculate radial part of the gradient
1476 C Calculate the angular part of the gradient and sum add the contributions
1477 C to the appropriate components of the Cartesian gradient.
1479 if (bb(itypi,itypj).gt.0) then
1493 C-----------------------------------------------------------------------------
1494 subroutine egb(evdw,evdw_p,evdw_m)
1496 C This subroutine calculates the interaction energy of nonbonded side chains
1497 C assuming the Gay-Berne potential of interaction.
1499 implicit real*8 (a-h,o-z)
1500 include 'DIMENSIONS'
1501 include 'COMMON.GEO'
1502 include 'COMMON.VAR'
1503 include 'COMMON.LOCAL'
1504 include 'COMMON.CHAIN'
1505 include 'COMMON.DERIV'
1506 include 'COMMON.NAMES'
1507 include 'COMMON.INTERACT'
1508 include 'COMMON.IOUNITS'
1509 include 'COMMON.CALC'
1510 include 'COMMON.CONTROL'
1513 ccccc energy_dec=.false.
1514 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1519 c if (icall.eq.0) lprn=.false.
1521 do i=iatsc_s,iatsc_e
1522 itypi=iabs(itype(i))
1523 itypi1=iabs(itype(i+1))
1527 dxi=dc_norm(1,nres+i)
1528 dyi=dc_norm(2,nres+i)
1529 dzi=dc_norm(3,nres+i)
1530 c dsci_inv=dsc_inv(itypi)
1531 dsci_inv=vbld_inv(i+nres)
1532 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1533 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1535 C Calculate SC interaction energy.
1537 do iint=1,nint_gr(i)
1538 do j=istart(i,iint),iend(i,iint)
1540 itypj=iabs(itype(j))
1541 c dscj_inv=dsc_inv(itypj)
1542 dscj_inv=vbld_inv(j+nres)
1543 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1544 c & 1.0d0/vbld(j+nres)
1545 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1546 sig0ij=sigma(itypi,itypj)
1547 chi1=chi(itypi,itypj)
1548 chi2=chi(itypj,itypi)
1555 alf12=0.5D0*(alf1+alf2)
1556 C For diagnostics only!!!
1569 dxj=dc_norm(1,nres+j)
1570 dyj=dc_norm(2,nres+j)
1571 dzj=dc_norm(3,nres+j)
1572 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1573 c write (iout,*) "j",j," dc_norm",
1574 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1575 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1577 C Calculate angle-dependent terms of energy and contributions to their
1581 sig=sig0ij*dsqrt(sigsq)
1582 rij_shift=1.0D0/rij-sig+sig0ij
1583 c for diagnostics; uncomment
1584 c rij_shift=1.2*sig0ij
1585 C I hate to put IF's in the loops, but here don't have another choice!!!!
1586 if (rij_shift.le.0.0D0) then
1588 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1589 cd & restyp(itypi),i,restyp(itypj),j,
1590 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1594 c---------------------------------------------------------------
1595 rij_shift=1.0D0/rij_shift
1596 fac=rij_shift**expon
1597 e1=fac*fac*aa(itypi,itypj)
1598 e2=fac*bb(itypi,itypj)
1599 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1600 eps2der=evdwij*eps3rt
1601 eps3der=evdwij*eps2rt
1602 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1603 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1604 evdwij=evdwij*eps2rt*eps3rt
1606 if (bb(itypi,itypj).gt.0) then
1607 evdw_p=evdw_p+evdwij
1609 evdw_m=evdw_m+evdwij
1615 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1616 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1617 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1618 & restyp(itypi),i,restyp(itypj),j,
1619 & epsi,sigm,chi1,chi2,chip1,chip2,
1620 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1621 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1625 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1628 C Calculate gradient components.
1629 e1=e1*eps1*eps2rt**2*eps3rt**2
1630 fac=-expon*(e1+evdwij)*rij_shift
1634 C Calculate the radial part of the gradient
1638 C Calculate angular part of the gradient.
1640 if (bb(itypi,itypj).gt.0) then
1651 c write (iout,*) "Number of loop steps in EGB:",ind
1652 cccc energy_dec=.false.
1655 C-----------------------------------------------------------------------------
1656 subroutine egbv(evdw,evdw_p,evdw_m)
1658 C This subroutine calculates the interaction energy of nonbonded side chains
1659 C assuming the Gay-Berne-Vorobjev potential of interaction.
1661 implicit real*8 (a-h,o-z)
1662 include 'DIMENSIONS'
1663 include 'COMMON.GEO'
1664 include 'COMMON.VAR'
1665 include 'COMMON.LOCAL'
1666 include 'COMMON.CHAIN'
1667 include 'COMMON.DERIV'
1668 include 'COMMON.NAMES'
1669 include 'COMMON.INTERACT'
1670 include 'COMMON.IOUNITS'
1671 include 'COMMON.CALC'
1672 common /srutu/ icall
1675 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1678 c if (icall.eq.0) lprn=.true.
1680 do i=iatsc_s,iatsc_e
1681 itypi=iabs(itype(i))
1682 itypi1=iabs(itype(i+1))
1686 dxi=dc_norm(1,nres+i)
1687 dyi=dc_norm(2,nres+i)
1688 dzi=dc_norm(3,nres+i)
1689 c dsci_inv=dsc_inv(itypi)
1690 dsci_inv=vbld_inv(i+nres)
1692 C Calculate SC interaction energy.
1694 do iint=1,nint_gr(i)
1695 do j=istart(i,iint),iend(i,iint)
1697 itypj=iabs(itype(j))
1698 c dscj_inv=dsc_inv(itypj)
1699 dscj_inv=vbld_inv(j+nres)
1700 sig0ij=sigma(itypi,itypj)
1701 r0ij=r0(itypi,itypj)
1702 chi1=chi(itypi,itypj)
1703 chi2=chi(itypj,itypi)
1710 alf12=0.5D0*(alf1+alf2)
1711 C For diagnostics only!!!
1724 dxj=dc_norm(1,nres+j)
1725 dyj=dc_norm(2,nres+j)
1726 dzj=dc_norm(3,nres+j)
1727 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1729 C Calculate angle-dependent terms of energy and contributions to their
1733 sig=sig0ij*dsqrt(sigsq)
1734 rij_shift=1.0D0/rij-sig+r0ij
1735 C I hate to put IF's in the loops, but here don't have another choice!!!!
1736 if (rij_shift.le.0.0D0) then
1741 c---------------------------------------------------------------
1742 rij_shift=1.0D0/rij_shift
1743 fac=rij_shift**expon
1744 e1=fac*fac*aa(itypi,itypj)
1745 e2=fac*bb(itypi,itypj)
1746 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1747 eps2der=evdwij*eps3rt
1748 eps3der=evdwij*eps2rt
1749 fac_augm=rrij**expon
1750 e_augm=augm(itypi,itypj)*fac_augm
1751 evdwij=evdwij*eps2rt*eps3rt
1753 if (bb(itypi,itypj).gt.0) then
1754 evdw_p=evdw_p+evdwij+e_augm
1756 evdw_m=evdw_m+evdwij+e_augm
1759 evdw=evdw+evdwij+e_augm
1762 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1763 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1764 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1765 & restyp(itypi),i,restyp(itypj),j,
1766 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1767 & chi1,chi2,chip1,chip2,
1768 & eps1,eps2rt**2,eps3rt**2,
1769 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1772 C Calculate gradient components.
1773 e1=e1*eps1*eps2rt**2*eps3rt**2
1774 fac=-expon*(e1+evdwij)*rij_shift
1776 fac=rij*fac-2*expon*rrij*e_augm
1777 C Calculate the radial part of the gradient
1781 C Calculate angular part of the gradient.
1783 if (bb(itypi,itypj).gt.0) then
1795 C-----------------------------------------------------------------------------
1796 subroutine sc_angular
1797 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1798 C om12. Called by ebp, egb, and egbv.
1800 include 'COMMON.CALC'
1801 include 'COMMON.IOUNITS'
1805 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1806 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1807 om12=dxi*dxj+dyi*dyj+dzi*dzj
1809 C Calculate eps1(om12) and its derivative in om12
1810 faceps1=1.0D0-om12*chiom12
1811 faceps1_inv=1.0D0/faceps1
1812 eps1=dsqrt(faceps1_inv)
1813 C Following variable is eps1*deps1/dom12
1814 eps1_om12=faceps1_inv*chiom12
1819 c write (iout,*) "om12",om12," eps1",eps1
1820 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1825 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1826 sigsq=1.0D0-facsig*faceps1_inv
1827 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1828 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1829 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1835 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1836 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1838 C Calculate eps2 and its derivatives in om1, om2, and om12.
1841 chipom12=chip12*om12
1842 facp=1.0D0-om12*chipom12
1844 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1845 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1846 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1847 C Following variable is the square root of eps2
1848 eps2rt=1.0D0-facp1*facp_inv
1849 C Following three variables are the derivatives of the square root of eps
1850 C in om1, om2, and om12.
1851 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1852 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1853 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1854 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1855 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1856 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1857 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1858 c & " eps2rt_om12",eps2rt_om12
1859 C Calculate whole angle-dependent part of epsilon and contributions
1860 C to its derivatives
1864 C----------------------------------------------------------------------------
1865 subroutine sc_grad_T
1866 implicit real*8 (a-h,o-z)
1867 include 'DIMENSIONS'
1868 include 'COMMON.CHAIN'
1869 include 'COMMON.DERIV'
1870 include 'COMMON.CALC'
1871 include 'COMMON.IOUNITS'
1872 double precision dcosom1(3),dcosom2(3)
1873 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1874 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1875 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1876 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1880 c eom12=evdwij*eps1_om12
1882 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1883 c & " sigder",sigder
1884 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1885 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1887 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1888 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1891 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1893 c write (iout,*) "gg",(gg(k),k=1,3)
1895 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1896 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1897 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1898 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1899 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1900 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1901 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1902 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1903 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1904 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1907 C Calculate the components of the gradient in DC and X
1911 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1915 gvdwcT(l,i)=gvdwcT(l,i)-gg(l)
1916 gvdwcT(l,j)=gvdwcT(l,j)+gg(l)
1921 C----------------------------------------------------------------------------
1923 implicit real*8 (a-h,o-z)
1924 include 'DIMENSIONS'
1925 include 'COMMON.CHAIN'
1926 include 'COMMON.DERIV'
1927 include 'COMMON.CALC'
1928 include 'COMMON.IOUNITS'
1929 double precision dcosom1(3),dcosom2(3)
1930 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1931 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1932 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1933 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1937 c eom12=evdwij*eps1_om12
1939 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1940 c & " sigder",sigder
1941 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1942 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1944 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1945 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1948 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1950 c write (iout,*) "gg",(gg(k),k=1,3)
1952 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1953 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1954 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1955 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1956 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1957 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1958 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1959 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1960 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1961 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1964 C Calculate the components of the gradient in DC and X
1968 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1972 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1973 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1977 C-----------------------------------------------------------------------
1978 subroutine e_softsphere(evdw)
1980 C This subroutine calculates the interaction energy of nonbonded side chains
1981 C assuming the LJ potential of interaction.
1983 implicit real*8 (a-h,o-z)
1984 include 'DIMENSIONS'
1985 parameter (accur=1.0d-10)
1986 include 'COMMON.GEO'
1987 include 'COMMON.VAR'
1988 include 'COMMON.LOCAL'
1989 include 'COMMON.CHAIN'
1990 include 'COMMON.DERIV'
1991 include 'COMMON.INTERACT'
1992 include 'COMMON.TORSION'
1993 include 'COMMON.SBRIDGE'
1994 include 'COMMON.NAMES'
1995 include 'COMMON.IOUNITS'
1996 include 'COMMON.CONTACTS'
1998 include 'COMMON.CONTACTS.MOMENT'
2001 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2003 do i=iatsc_s,iatsc_e
2004 itypi=iabs(itype(i))
2005 itypi1=iabs(itype(i+1))
2010 C Calculate SC interaction energy.
2012 do iint=1,nint_gr(i)
2013 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2014 cd & 'iend=',iend(i,iint)
2015 do j=istart(i,iint),iend(i,iint)
2016 itypj=iabs(itype(j))
2020 rij=xj*xj+yj*yj+zj*zj
2021 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2022 r0ij=r0(itypi,itypj)
2024 c print *,i,j,r0ij,dsqrt(rij)
2025 if (rij.lt.r0ijsq) then
2026 evdwij=0.25d0*(rij-r0ijsq)**2
2034 C Calculate the components of the gradient in DC and X
2040 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2041 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2042 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2043 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2047 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2055 C--------------------------------------------------------------------------
2056 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2059 C Soft-sphere potential of p-p interaction
2061 implicit real*8 (a-h,o-z)
2062 include 'DIMENSIONS'
2063 include 'COMMON.CONTROL'
2064 include 'COMMON.IOUNITS'
2065 include 'COMMON.GEO'
2066 include 'COMMON.VAR'
2067 include 'COMMON.LOCAL'
2068 include 'COMMON.CHAIN'
2069 include 'COMMON.DERIV'
2070 include 'COMMON.INTERACT'
2071 include 'COMMON.CONTACTS'
2073 include 'COMMON.CONTACTS.MOMENT'
2075 include 'COMMON.TORSION'
2076 include 'COMMON.VECTORS'
2077 include 'COMMON.FFIELD'
2079 cd write(iout,*) 'In EELEC_soft_sphere'
2086 do i=iatel_s,iatel_e
2090 xmedi=c(1,i)+0.5d0*dxi
2091 ymedi=c(2,i)+0.5d0*dyi
2092 zmedi=c(3,i)+0.5d0*dzi
2094 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2095 do j=ielstart(i),ielend(i)
2099 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2100 r0ij=rpp(iteli,itelj)
2105 xj=c(1,j)+0.5D0*dxj-xmedi
2106 yj=c(2,j)+0.5D0*dyj-ymedi
2107 zj=c(3,j)+0.5D0*dzj-zmedi
2108 rij=xj*xj+yj*yj+zj*zj
2109 if (rij.lt.r0ijsq) then
2110 evdw1ij=0.25d0*(rij-r0ijsq)**2
2118 C Calculate contributions to the Cartesian gradient.
2124 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2125 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2128 * Loop over residues i+1 thru j-1.
2132 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2137 cgrad do i=nnt,nct-1
2139 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2141 cgrad do j=i+1,nct-1
2143 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2149 c------------------------------------------------------------------------------
2150 subroutine vec_and_deriv
2151 implicit real*8 (a-h,o-z)
2152 include 'DIMENSIONS'
2156 include 'COMMON.IOUNITS'
2157 include 'COMMON.GEO'
2158 include 'COMMON.VAR'
2159 include 'COMMON.LOCAL'
2160 include 'COMMON.CHAIN'
2161 include 'COMMON.VECTORS'
2162 include 'COMMON.SETUP'
2163 include 'COMMON.TIME1'
2164 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2165 C Compute the local reference systems. For reference system (i), the
2166 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2167 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2169 do i=ivec_start,ivec_end
2173 if (i.eq.nres-1) then
2174 C Case of the last full residue
2175 C Compute the Z-axis
2176 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2177 costh=dcos(pi-theta(nres))
2178 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2182 C Compute the derivatives of uz
2184 uzder(2,1,1)=-dc_norm(3,i-1)
2185 uzder(3,1,1)= dc_norm(2,i-1)
2186 uzder(1,2,1)= dc_norm(3,i-1)
2188 uzder(3,2,1)=-dc_norm(1,i-1)
2189 uzder(1,3,1)=-dc_norm(2,i-1)
2190 uzder(2,3,1)= dc_norm(1,i-1)
2193 uzder(2,1,2)= dc_norm(3,i)
2194 uzder(3,1,2)=-dc_norm(2,i)
2195 uzder(1,2,2)=-dc_norm(3,i)
2197 uzder(3,2,2)= dc_norm(1,i)
2198 uzder(1,3,2)= dc_norm(2,i)
2199 uzder(2,3,2)=-dc_norm(1,i)
2201 C Compute the Y-axis
2204 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2206 C Compute the derivatives of uy
2209 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2210 & -dc_norm(k,i)*dc_norm(j,i-1)
2211 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2213 uyder(j,j,1)=uyder(j,j,1)-costh
2214 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2219 uygrad(l,k,j,i)=uyder(l,k,j)
2220 uzgrad(l,k,j,i)=uzder(l,k,j)
2224 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2225 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2226 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2227 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2230 C Compute the Z-axis
2231 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2232 costh=dcos(pi-theta(i+2))
2233 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2237 C Compute the derivatives of uz
2239 uzder(2,1,1)=-dc_norm(3,i+1)
2240 uzder(3,1,1)= dc_norm(2,i+1)
2241 uzder(1,2,1)= dc_norm(3,i+1)
2243 uzder(3,2,1)=-dc_norm(1,i+1)
2244 uzder(1,3,1)=-dc_norm(2,i+1)
2245 uzder(2,3,1)= dc_norm(1,i+1)
2248 uzder(2,1,2)= dc_norm(3,i)
2249 uzder(3,1,2)=-dc_norm(2,i)
2250 uzder(1,2,2)=-dc_norm(3,i)
2252 uzder(3,2,2)= dc_norm(1,i)
2253 uzder(1,3,2)= dc_norm(2,i)
2254 uzder(2,3,2)=-dc_norm(1,i)
2256 C Compute the Y-axis
2259 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2261 C Compute the derivatives of uy
2264 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2265 & -dc_norm(k,i)*dc_norm(j,i+1)
2266 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2268 uyder(j,j,1)=uyder(j,j,1)-costh
2269 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2274 uygrad(l,k,j,i)=uyder(l,k,j)
2275 uzgrad(l,k,j,i)=uzder(l,k,j)
2279 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2280 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2281 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2282 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2286 vbld_inv_temp(1)=vbld_inv(i+1)
2287 if (i.lt.nres-1) then
2288 vbld_inv_temp(2)=vbld_inv(i+2)
2290 vbld_inv_temp(2)=vbld_inv(i)
2295 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2296 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2301 #if defined(PARVEC) && defined(MPI)
2302 if (nfgtasks1.gt.1) then
2304 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2305 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2306 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2307 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2308 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2310 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2311 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2313 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2314 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2315 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2316 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2317 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2318 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2319 time_gather=time_gather+MPI_Wtime()-time00
2321 c if (fg_rank.eq.0) then
2322 c write (iout,*) "Arrays UY and UZ"
2324 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2331 C-----------------------------------------------------------------------------
2332 subroutine check_vecgrad
2333 implicit real*8 (a-h,o-z)
2334 include 'DIMENSIONS'
2335 include 'COMMON.IOUNITS'
2336 include 'COMMON.GEO'
2337 include 'COMMON.VAR'
2338 include 'COMMON.LOCAL'
2339 include 'COMMON.CHAIN'
2340 include 'COMMON.VECTORS'
2341 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2342 dimension uyt(3,maxres),uzt(3,maxres)
2343 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2344 double precision delta /1.0d-7/
2347 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2348 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2349 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2350 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2351 cd & (dc_norm(if90,i),if90=1,3)
2352 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2353 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2354 cd write(iout,'(a)')
2360 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2361 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2374 cd write (iout,*) 'i=',i
2376 erij(k)=dc_norm(k,i)
2380 dc_norm(k,i)=erij(k)
2382 dc_norm(j,i)=dc_norm(j,i)+delta
2383 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2385 c dc_norm(k,i)=dc_norm(k,i)/fac
2387 c write (iout,*) (dc_norm(k,i),k=1,3)
2388 c write (iout,*) (erij(k),k=1,3)
2391 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2392 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2393 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2394 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2396 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2397 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2398 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2401 dc_norm(k,i)=erij(k)
2404 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2405 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2406 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2407 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2408 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2409 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2410 cd write (iout,'(a)')
2415 C--------------------------------------------------------------------------
2416 subroutine set_matrices
2417 implicit real*8 (a-h,o-z)
2418 include 'DIMENSIONS'
2421 include "COMMON.SETUP"
2423 integer status(MPI_STATUS_SIZE)
2425 include 'COMMON.IOUNITS'
2426 include 'COMMON.GEO'
2427 include 'COMMON.VAR'
2428 include 'COMMON.LOCAL'
2429 include 'COMMON.CHAIN'
2430 include 'COMMON.DERIV'
2431 include 'COMMON.INTERACT'
2432 include 'COMMON.CONTACTS'
2434 include 'COMMON.CONTACTS.MOMENT'
2436 include 'COMMON.TORSION'
2437 include 'COMMON.VECTORS'
2438 include 'COMMON.FFIELD'
2439 double precision auxvec(2),auxmat(2,2)
2441 C Compute the virtual-bond-torsional-angle dependent quantities needed
2442 C to calculate the el-loc multibody terms of various order.
2445 do i=ivec_start+2,ivec_end+2
2449 if (i .lt. nres+1) then
2486 if (i .gt. 3 .and. i .lt. nres+1) then
2487 obrot_der(1,i-2)=-sin1
2488 obrot_der(2,i-2)= cos1
2489 Ugder(1,1,i-2)= sin1
2490 Ugder(1,2,i-2)=-cos1
2491 Ugder(2,1,i-2)=-cos1
2492 Ugder(2,2,i-2)=-sin1
2495 obrot2_der(1,i-2)=-dwasin2
2496 obrot2_der(2,i-2)= dwacos2
2497 Ug2der(1,1,i-2)= dwasin2
2498 Ug2der(1,2,i-2)=-dwacos2
2499 Ug2der(2,1,i-2)=-dwacos2
2500 Ug2der(2,2,i-2)=-dwasin2
2502 obrot_der(1,i-2)=0.0d0
2503 obrot_der(2,i-2)=0.0d0
2504 Ugder(1,1,i-2)=0.0d0
2505 Ugder(1,2,i-2)=0.0d0
2506 Ugder(2,1,i-2)=0.0d0
2507 Ugder(2,2,i-2)=0.0d0
2508 obrot2_der(1,i-2)=0.0d0
2509 obrot2_der(2,i-2)=0.0d0
2510 Ug2der(1,1,i-2)=0.0d0
2511 Ug2der(1,2,i-2)=0.0d0
2512 Ug2der(2,1,i-2)=0.0d0
2513 Ug2der(2,2,i-2)=0.0d0
2515 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2516 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2517 iti = itortyp(itype(i-2))
2521 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2522 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2523 iti1 = itortyp(itype(i-1))
2527 cd write (iout,*) '*******i',i,' iti1',iti
2528 cd write (iout,*) 'b1',b1(:,iti)
2529 cd write (iout,*) 'b2',b2(:,iti)
2530 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2531 c if (i .gt. iatel_s+2) then
2532 if (i .gt. nnt+2) then
2533 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2534 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2535 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2537 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2538 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2539 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2540 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2541 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2552 DtUg2(l,k,i-2)=0.0d0
2556 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2557 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2559 muder(k,i-2)=Ub2der(k,i-2)
2561 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2562 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2563 iti1 = itortyp(itype(i-1))
2568 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2570 cd write (iout,*) 'mu ',mu(:,i-2)
2571 cd write (iout,*) 'mu1',mu1(:,i-2)
2572 cd write (iout,*) 'mu2',mu2(:,i-2)
2573 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2575 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2576 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2577 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2578 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2579 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2580 C Vectors and matrices dependent on a single virtual-bond dihedral.
2581 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2582 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2583 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2584 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2585 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2586 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2587 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2588 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2589 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2592 C Matrices dependent on two consecutive virtual-bond dihedrals.
2593 C The order of matrices is from left to right.
2594 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2596 c do i=max0(ivec_start,2),ivec_end
2598 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2599 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2600 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2601 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2602 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2603 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2604 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2605 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2608 #if defined(MPI) && defined(PARMAT)
2610 c if (fg_rank.eq.0) then
2611 write (iout,*) "Arrays UG and UGDER before GATHER"
2613 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2614 & ((ug(l,k,i),l=1,2),k=1,2),
2615 & ((ugder(l,k,i),l=1,2),k=1,2)
2617 write (iout,*) "Arrays UG2 and UG2DER"
2619 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2620 & ((ug2(l,k,i),l=1,2),k=1,2),
2621 & ((ug2der(l,k,i),l=1,2),k=1,2)
2623 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2625 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2626 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2627 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2629 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2631 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2632 & costab(i),sintab(i),costab2(i),sintab2(i)
2634 write (iout,*) "Array MUDER"
2636 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2640 if (nfgtasks.gt.1) then
2642 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2643 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2644 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2646 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2647 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2649 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2650 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2652 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2653 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2655 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2656 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2658 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2659 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2661 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2662 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2664 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2665 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2666 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2667 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2668 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2669 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2670 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2671 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2672 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2673 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2674 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2675 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2676 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2678 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2679 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2681 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2682 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2684 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2685 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2687 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2688 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2690 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2691 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2693 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2694 & ivec_count(fg_rank1),
2695 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2697 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2698 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2700 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2701 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2703 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2704 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2706 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2707 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2709 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2710 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2712 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2713 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2715 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2716 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2718 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2719 & ivec_count(fg_rank1),
2720 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2722 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2723 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2725 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2726 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2728 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2729 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2731 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2732 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2734 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2735 & ivec_count(fg_rank1),
2736 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2738 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2739 & ivec_count(fg_rank1),
2740 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2742 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2743 & ivec_count(fg_rank1),
2744 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2745 & MPI_MAT2,FG_COMM1,IERR)
2746 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2747 & ivec_count(fg_rank1),
2748 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2749 & MPI_MAT2,FG_COMM1,IERR)
2752 c Passes matrix info through the ring
2755 if (irecv.lt.0) irecv=nfgtasks1-1
2758 if (inext.ge.nfgtasks1) inext=0
2760 c write (iout,*) "isend",isend," irecv",irecv
2762 lensend=lentyp(isend)
2763 lenrecv=lentyp(irecv)
2764 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2765 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2766 c & MPI_ROTAT1(lensend),inext,2200+isend,
2767 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2768 c & iprev,2200+irecv,FG_COMM,status,IERR)
2769 c write (iout,*) "Gather ROTAT1"
2771 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2772 c & MPI_ROTAT2(lensend),inext,3300+isend,
2773 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2774 c & iprev,3300+irecv,FG_COMM,status,IERR)
2775 c write (iout,*) "Gather ROTAT2"
2777 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2778 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2779 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2780 & iprev,4400+irecv,FG_COMM,status,IERR)
2781 c write (iout,*) "Gather ROTAT_OLD"
2783 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2784 & MPI_PRECOMP11(lensend),inext,5500+isend,
2785 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2786 & iprev,5500+irecv,FG_COMM,status,IERR)
2787 c write (iout,*) "Gather PRECOMP11"
2789 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2790 & MPI_PRECOMP12(lensend),inext,6600+isend,
2791 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2792 & iprev,6600+irecv,FG_COMM,status,IERR)
2793 c write (iout,*) "Gather PRECOMP12"
2795 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2797 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2798 & MPI_ROTAT2(lensend),inext,7700+isend,
2799 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2800 & iprev,7700+irecv,FG_COMM,status,IERR)
2801 c write (iout,*) "Gather PRECOMP21"
2803 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2804 & MPI_PRECOMP22(lensend),inext,8800+isend,
2805 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2806 & iprev,8800+irecv,FG_COMM,status,IERR)
2807 c write (iout,*) "Gather PRECOMP22"
2809 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2810 & MPI_PRECOMP23(lensend),inext,9900+isend,
2811 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2812 & MPI_PRECOMP23(lenrecv),
2813 & iprev,9900+irecv,FG_COMM,status,IERR)
2814 c write (iout,*) "Gather PRECOMP23"
2819 if (irecv.lt.0) irecv=nfgtasks1-1
2822 time_gather=time_gather+MPI_Wtime()-time00
2825 c if (fg_rank.eq.0) then
2826 write (iout,*) "Arrays UG and UGDER"
2828 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2829 & ((ug(l,k,i),l=1,2),k=1,2),
2830 & ((ugder(l,k,i),l=1,2),k=1,2)
2832 write (iout,*) "Arrays UG2 and UG2DER"
2834 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2835 & ((ug2(l,k,i),l=1,2),k=1,2),
2836 & ((ug2der(l,k,i),l=1,2),k=1,2)
2838 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2840 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2841 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2842 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2844 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2846 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2847 & costab(i),sintab(i),costab2(i),sintab2(i)
2849 write (iout,*) "Array MUDER"
2851 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2857 cd iti = itortyp(itype(i))
2860 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2861 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2866 C--------------------------------------------------------------------------
2867 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2869 C This subroutine calculates the average interaction energy and its gradient
2870 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2871 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2872 C The potential depends both on the distance of peptide-group centers and on
2873 C the orientation of the CA-CA virtual bonds.
2875 implicit real*8 (a-h,o-z)
2879 include 'DIMENSIONS'
2880 include 'COMMON.CONTROL'
2881 include 'COMMON.SETUP'
2882 include 'COMMON.IOUNITS'
2883 include 'COMMON.GEO'
2884 include 'COMMON.VAR'
2885 include 'COMMON.LOCAL'
2886 include 'COMMON.CHAIN'
2887 include 'COMMON.DERIV'
2888 include 'COMMON.INTERACT'
2889 include 'COMMON.CONTACTS'
2891 include 'COMMON.CONTACTS.MOMENT'
2893 include 'COMMON.TORSION'
2894 include 'COMMON.VECTORS'
2895 include 'COMMON.FFIELD'
2896 include 'COMMON.TIME1'
2897 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2898 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2899 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2900 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2901 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2902 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2904 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2906 double precision scal_el /1.0d0/
2908 double precision scal_el /0.5d0/
2911 C 13-go grudnia roku pamietnego...
2912 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2913 & 0.0d0,1.0d0,0.0d0,
2914 & 0.0d0,0.0d0,1.0d0/
2915 cd write(iout,*) 'In EELEC'
2917 cd write(iout,*) 'Type',i
2918 cd write(iout,*) 'B1',B1(:,i)
2919 cd write(iout,*) 'B2',B2(:,i)
2920 cd write(iout,*) 'CC',CC(:,:,i)
2921 cd write(iout,*) 'DD',DD(:,:,i)
2922 cd write(iout,*) 'EE',EE(:,:,i)
2924 cd call check_vecgrad
2926 if (icheckgrad.eq.1) then
2928 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2930 dc_norm(k,i)=dc(k,i)*fac
2932 c write (iout,*) 'i',i,' fac',fac
2935 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2936 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2937 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2938 c call vec_and_deriv
2944 time_mat=time_mat+MPI_Wtime()-time01
2948 cd write (iout,*) 'i=',i
2950 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2953 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2954 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2967 cd print '(a)','Enter EELEC'
2968 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2970 gel_loc_loc(i)=0.0d0
2975 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2977 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2979 do i=iturn3_start,iturn3_end
2983 dx_normi=dc_norm(1,i)
2984 dy_normi=dc_norm(2,i)
2985 dz_normi=dc_norm(3,i)
2986 xmedi=c(1,i)+0.5d0*dxi
2987 ymedi=c(2,i)+0.5d0*dyi
2988 zmedi=c(3,i)+0.5d0*dzi
2990 call eelecij(i,i+2,ees,evdw1,eel_loc)
2991 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2992 num_cont_hb(i)=num_conti
2994 do i=iturn4_start,iturn4_end
2998 dx_normi=dc_norm(1,i)
2999 dy_normi=dc_norm(2,i)
3000 dz_normi=dc_norm(3,i)
3001 xmedi=c(1,i)+0.5d0*dxi
3002 ymedi=c(2,i)+0.5d0*dyi
3003 zmedi=c(3,i)+0.5d0*dzi
3004 num_conti=num_cont_hb(i)
3005 call eelecij(i,i+3,ees,evdw1,eel_loc)
3006 if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
3007 num_cont_hb(i)=num_conti
3010 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3012 do i=iatel_s,iatel_e
3016 dx_normi=dc_norm(1,i)
3017 dy_normi=dc_norm(2,i)
3018 dz_normi=dc_norm(3,i)
3019 xmedi=c(1,i)+0.5d0*dxi
3020 ymedi=c(2,i)+0.5d0*dyi
3021 zmedi=c(3,i)+0.5d0*dzi
3022 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3023 num_conti=num_cont_hb(i)
3024 do j=ielstart(i),ielend(i)
3025 call eelecij(i,j,ees,evdw1,eel_loc)
3027 num_cont_hb(i)=num_conti
3029 c write (iout,*) "Number of loop steps in EELEC:",ind
3031 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3032 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3034 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3035 ccc eel_loc=eel_loc+eello_turn3
3036 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3039 C-------------------------------------------------------------------------------
3040 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3041 implicit real*8 (a-h,o-z)
3042 include 'DIMENSIONS'
3046 include 'COMMON.CONTROL'
3047 include 'COMMON.IOUNITS'
3048 include 'COMMON.GEO'
3049 include 'COMMON.VAR'
3050 include 'COMMON.LOCAL'
3051 include 'COMMON.CHAIN'
3052 include 'COMMON.DERIV'
3053 include 'COMMON.INTERACT'
3054 include 'COMMON.CONTACTS'
3056 include 'COMMON.CONTACTS.MOMENT'
3058 include 'COMMON.TORSION'
3059 include 'COMMON.VECTORS'
3060 include 'COMMON.FFIELD'
3061 include 'COMMON.TIME1'
3062 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3063 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3064 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3065 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3066 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3067 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3069 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3071 double precision scal_el /1.0d0/
3073 double precision scal_el /0.5d0/
3076 C 13-go grudnia roku pamietnego...
3077 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3078 & 0.0d0,1.0d0,0.0d0,
3079 & 0.0d0,0.0d0,1.0d0/
3080 c time00=MPI_Wtime()
3081 cd write (iout,*) "eelecij",i,j
3085 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3086 aaa=app(iteli,itelj)
3087 bbb=bpp(iteli,itelj)
3088 ael6i=ael6(iteli,itelj)
3089 ael3i=ael3(iteli,itelj)
3093 dx_normj=dc_norm(1,j)
3094 dy_normj=dc_norm(2,j)
3095 dz_normj=dc_norm(3,j)
3096 xj=c(1,j)+0.5D0*dxj-xmedi
3097 yj=c(2,j)+0.5D0*dyj-ymedi
3098 zj=c(3,j)+0.5D0*dzj-zmedi
3099 rij=xj*xj+yj*yj+zj*zj
3105 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3106 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3107 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3108 fac=cosa-3.0D0*cosb*cosg
3110 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3111 if (j.eq.i+2) ev1=scal_el*ev1
3116 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3119 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3120 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3123 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3124 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3125 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3126 cd & xmedi,ymedi,zmedi,xj,yj,zj
3128 if (energy_dec) then
3129 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3130 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3134 C Calculate contributions to the Cartesian gradient.
3137 facvdw=-6*rrmij*(ev1+evdwij)
3138 facel=-3*rrmij*(el1+eesij)
3144 * Radial derivatives. First process both termini of the fragment (i,j)
3150 c ghalf=0.5D0*ggg(k)
3151 c gelc(k,i)=gelc(k,i)+ghalf
3152 c gelc(k,j)=gelc(k,j)+ghalf
3154 c 9/28/08 AL Gradient compotents will be summed only at the end
3156 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3157 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3160 * Loop over residues i+1 thru j-1.
3164 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3171 c ghalf=0.5D0*ggg(k)
3172 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3173 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3175 c 9/28/08 AL Gradient compotents will be summed only at the end
3177 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3178 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3181 * Loop over residues i+1 thru j-1.
3185 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3192 fac=-3*rrmij*(facvdw+facvdw+facel)
3197 * Radial derivatives. First process both termini of the fragment (i,j)
3203 c ghalf=0.5D0*ggg(k)
3204 c gelc(k,i)=gelc(k,i)+ghalf
3205 c gelc(k,j)=gelc(k,j)+ghalf
3207 c 9/28/08 AL Gradient compotents will be summed only at the end
3209 gelc_long(k,j)=gelc(k,j)+ggg(k)
3210 gelc_long(k,i)=gelc(k,i)-ggg(k)
3213 * Loop over residues i+1 thru j-1.
3217 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3220 c 9/28/08 AL Gradient compotents will be summed only at the end
3225 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3226 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3232 ecosa=2.0D0*fac3*fac1+fac4
3235 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3236 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3238 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3239 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3241 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3242 cd & (dcosg(k),k=1,3)
3244 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3247 c ghalf=0.5D0*ggg(k)
3248 c gelc(k,i)=gelc(k,i)+ghalf
3249 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3250 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3251 c gelc(k,j)=gelc(k,j)+ghalf
3252 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3253 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3257 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3262 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3263 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3265 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3266 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3267 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3268 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3270 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3271 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3272 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3274 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3275 C energy of a peptide unit is assumed in the form of a second-order
3276 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3277 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3278 C are computed for EVERY pair of non-contiguous peptide groups.
3280 if (j.lt.nres-1) then
3291 muij(kkk)=mu(k,i)*mu(l,j)
3294 cd write (iout,*) 'EELEC: i',i,' j',j
3295 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3296 cd write(iout,*) 'muij',muij
3297 ury=scalar(uy(1,i),erij)
3298 urz=scalar(uz(1,i),erij)
3299 vry=scalar(uy(1,j),erij)
3300 vrz=scalar(uz(1,j),erij)
3301 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3302 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3303 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3304 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3305 fac=dsqrt(-ael6i)*r3ij
3310 cd write (iout,'(4i5,4f10.5)')
3311 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3312 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3313 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3314 cd & uy(:,j),uz(:,j)
3315 cd write (iout,'(4f10.5)')
3316 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3317 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3318 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3319 cd write (iout,'(9f10.5/)')
3320 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3321 C Derivatives of the elements of A in virtual-bond vectors
3322 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3324 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3325 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3326 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3327 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3328 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3329 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3330 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3331 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3332 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3333 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3334 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3335 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3337 C Compute radial contributions to the gradient
3355 C Add the contributions coming from er
3358 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3359 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3360 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3361 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3364 C Derivatives in DC(i)
3365 cgrad ghalf1=0.5d0*agg(k,1)
3366 cgrad ghalf2=0.5d0*agg(k,2)
3367 cgrad ghalf3=0.5d0*agg(k,3)
3368 cgrad ghalf4=0.5d0*agg(k,4)
3369 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3370 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3371 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3372 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3373 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3374 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3375 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3376 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3377 C Derivatives in DC(i+1)
3378 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3379 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3380 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3381 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3382 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3383 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3384 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3385 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3386 C Derivatives in DC(j)
3387 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3388 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3389 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3390 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3391 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3392 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3393 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3394 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3395 C Derivatives in DC(j+1) or DC(nres-1)
3396 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3397 & -3.0d0*vryg(k,3)*ury)
3398 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3399 & -3.0d0*vrzg(k,3)*ury)
3400 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3401 & -3.0d0*vryg(k,3)*urz)
3402 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3403 & -3.0d0*vrzg(k,3)*urz)
3404 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3406 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3419 aggi(k,l)=-aggi(k,l)
3420 aggi1(k,l)=-aggi1(k,l)
3421 aggj(k,l)=-aggj(k,l)
3422 aggj1(k,l)=-aggj1(k,l)
3425 if (j.lt.nres-1) then
3431 aggi(k,l)=-aggi(k,l)
3432 aggi1(k,l)=-aggi1(k,l)
3433 aggj(k,l)=-aggj(k,l)
3434 aggj1(k,l)=-aggj1(k,l)
3445 aggi(k,l)=-aggi(k,l)
3446 aggi1(k,l)=-aggi1(k,l)
3447 aggj(k,l)=-aggj(k,l)
3448 aggj1(k,l)=-aggj1(k,l)
3453 IF (wel_loc.gt.0.0d0) THEN
3454 C Contribution to the local-electrostatic energy coming from the i-j pair
3455 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3457 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3459 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3460 & 'eelloc',i,j,eel_loc_ij
3462 eel_loc=eel_loc+eel_loc_ij
3463 C Partial derivatives in virtual-bond dihedral angles gamma
3465 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3466 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3467 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3468 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3469 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3470 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3471 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3473 ggg(l)=agg(l,1)*muij(1)+
3474 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3475 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3476 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3477 cgrad ghalf=0.5d0*ggg(l)
3478 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3479 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3483 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3486 C Remaining derivatives of eello
3488 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3489 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3490 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3491 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3492 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3493 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3494 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3495 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3498 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3499 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3500 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3501 & .and. num_conti.le.maxconts) then
3502 c write (iout,*) i,j," entered corr"
3504 C Calculate the contact function. The ith column of the array JCONT will
3505 C contain the numbers of atoms that make contacts with the atom I (of numbers
3506 C greater than I). The arrays FACONT and GACONT will contain the values of
3507 C the contact function and its derivative.
3508 c r0ij=1.02D0*rpp(iteli,itelj)
3509 c r0ij=1.11D0*rpp(iteli,itelj)
3510 r0ij=2.20D0*rpp(iteli,itelj)
3511 c r0ij=1.55D0*rpp(iteli,itelj)
3512 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3513 if (fcont.gt.0.0D0) then
3514 num_conti=num_conti+1
3515 if (num_conti.gt.maxconts) then
3516 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3517 & ' will skip next contacts for this conf.'
3519 jcont_hb(num_conti,i)=j
3520 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3521 cd & " jcont_hb",jcont_hb(num_conti,i)
3522 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3523 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3524 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3526 d_cont(num_conti,i)=rij
3527 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3528 C --- Electrostatic-interaction matrix ---
3529 a_chuj(1,1,num_conti,i)=a22
3530 a_chuj(1,2,num_conti,i)=a23
3531 a_chuj(2,1,num_conti,i)=a32
3532 a_chuj(2,2,num_conti,i)=a33
3533 C --- Gradient of rij
3535 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3542 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3543 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3544 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3545 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3546 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3551 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3552 C Calculate contact energies
3554 wij=cosa-3.0D0*cosb*cosg
3557 c fac3=dsqrt(-ael6i)/r0ij**3
3558 fac3=dsqrt(-ael6i)*r3ij
3559 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3560 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3561 if (ees0tmp.gt.0) then
3562 ees0pij=dsqrt(ees0tmp)
3566 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3567 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3568 if (ees0tmp.gt.0) then
3569 ees0mij=dsqrt(ees0tmp)
3574 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3575 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3576 C Diagnostics. Comment out or remove after debugging!
3577 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3578 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3579 c ees0m(num_conti,i)=0.0D0
3581 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3582 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3583 C Angular derivatives of the contact function
3584 ees0pij1=fac3/ees0pij
3585 ees0mij1=fac3/ees0mij
3586 fac3p=-3.0D0*fac3*rrmij
3587 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3588 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3590 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3591 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3592 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3593 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3594 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3595 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3596 ecosap=ecosa1+ecosa2
3597 ecosbp=ecosb1+ecosb2
3598 ecosgp=ecosg1+ecosg2
3599 ecosam=ecosa1-ecosa2
3600 ecosbm=ecosb1-ecosb2
3601 ecosgm=ecosg1-ecosg2
3610 facont_hb(num_conti,i)=fcont
3611 fprimcont=fprimcont/rij
3612 cd facont_hb(num_conti,i)=1.0D0
3613 C Following line is for diagnostics.
3616 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3617 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3620 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3621 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3623 gggp(1)=gggp(1)+ees0pijp*xj
3624 gggp(2)=gggp(2)+ees0pijp*yj
3625 gggp(3)=gggp(3)+ees0pijp*zj
3626 gggm(1)=gggm(1)+ees0mijp*xj
3627 gggm(2)=gggm(2)+ees0mijp*yj
3628 gggm(3)=gggm(3)+ees0mijp*zj
3629 C Derivatives due to the contact function
3630 gacont_hbr(1,num_conti,i)=fprimcont*xj
3631 gacont_hbr(2,num_conti,i)=fprimcont*yj
3632 gacont_hbr(3,num_conti,i)=fprimcont*zj
3635 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3636 c following the change of gradient-summation algorithm.
3638 cgrad ghalfp=0.5D0*gggp(k)
3639 cgrad ghalfm=0.5D0*gggm(k)
3640 gacontp_hb1(k,num_conti,i)=!ghalfp
3641 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3642 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3643 gacontp_hb2(k,num_conti,i)=!ghalfp
3644 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3645 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3646 gacontp_hb3(k,num_conti,i)=gggp(k)
3647 gacontm_hb1(k,num_conti,i)=!ghalfm
3648 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3649 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3650 gacontm_hb2(k,num_conti,i)=!ghalfm
3651 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3652 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3653 gacontm_hb3(k,num_conti,i)=gggm(k)
3655 C Diagnostics. Comment out or remove after debugging!
3657 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3658 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3659 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3660 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3661 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3662 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3665 endif ! num_conti.le.maxconts
3668 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3671 ghalf=0.5d0*agg(l,k)
3672 aggi(l,k)=aggi(l,k)+ghalf
3673 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3674 aggj(l,k)=aggj(l,k)+ghalf
3677 if (j.eq.nres-1 .and. i.lt.j-2) then
3680 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3685 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3688 C-----------------------------------------------------------------------------
3689 subroutine eturn3(i,eello_turn3)
3690 C Third- and fourth-order contributions from turns
3691 implicit real*8 (a-h,o-z)
3692 include 'DIMENSIONS'
3693 include 'COMMON.IOUNITS'
3694 include 'COMMON.GEO'
3695 include 'COMMON.VAR'
3696 include 'COMMON.LOCAL'
3697 include 'COMMON.CHAIN'
3698 include 'COMMON.DERIV'
3699 include 'COMMON.INTERACT'
3700 include 'COMMON.CONTACTS'
3702 include 'COMMON.CONTACTS.MOMENT'
3704 include 'COMMON.TORSION'
3705 include 'COMMON.VECTORS'
3706 include 'COMMON.FFIELD'
3707 include 'COMMON.CONTROL'
3709 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3710 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3711 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3712 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3713 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3714 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3715 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3718 c write (iout,*) "eturn3",i,j,j1,j2
3723 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3725 C Third-order contributions
3732 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3733 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3734 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3735 call transpose2(auxmat(1,1),auxmat1(1,1))
3736 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3737 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3738 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3739 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3740 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3741 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3742 cd & ' eello_turn3_num',4*eello_turn3_num
3743 C Derivatives in gamma(i)
3744 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3745 call transpose2(auxmat2(1,1),auxmat3(1,1))
3746 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3747 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3748 C Derivatives in gamma(i+1)
3749 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3750 call transpose2(auxmat2(1,1),auxmat3(1,1))
3751 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3752 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3753 & +0.5d0*(pizda(1,1)+pizda(2,2))
3754 C Cartesian derivatives
3756 c ghalf1=0.5d0*agg(l,1)
3757 c ghalf2=0.5d0*agg(l,2)
3758 c ghalf3=0.5d0*agg(l,3)
3759 c ghalf4=0.5d0*agg(l,4)
3760 a_temp(1,1)=aggi(l,1)!+ghalf1
3761 a_temp(1,2)=aggi(l,2)!+ghalf2
3762 a_temp(2,1)=aggi(l,3)!+ghalf3
3763 a_temp(2,2)=aggi(l,4)!+ghalf4
3764 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3765 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3766 & +0.5d0*(pizda(1,1)+pizda(2,2))
3767 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3768 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3769 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3770 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3771 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3772 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3773 & +0.5d0*(pizda(1,1)+pizda(2,2))
3774 a_temp(1,1)=aggj(l,1)!+ghalf1
3775 a_temp(1,2)=aggj(l,2)!+ghalf2
3776 a_temp(2,1)=aggj(l,3)!+ghalf3
3777 a_temp(2,2)=aggj(l,4)!+ghalf4
3778 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3779 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3780 & +0.5d0*(pizda(1,1)+pizda(2,2))
3781 a_temp(1,1)=aggj1(l,1)
3782 a_temp(1,2)=aggj1(l,2)
3783 a_temp(2,1)=aggj1(l,3)
3784 a_temp(2,2)=aggj1(l,4)
3785 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3786 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3787 & +0.5d0*(pizda(1,1)+pizda(2,2))
3791 C-------------------------------------------------------------------------------
3792 subroutine eturn4(i,eello_turn4)
3793 C Third- and fourth-order contributions from turns
3794 implicit real*8 (a-h,o-z)
3795 include 'DIMENSIONS'
3796 include 'COMMON.IOUNITS'
3797 include 'COMMON.GEO'
3798 include 'COMMON.VAR'
3799 include 'COMMON.LOCAL'
3800 include 'COMMON.CHAIN'
3801 include 'COMMON.DERIV'
3802 include 'COMMON.INTERACT'
3803 include 'COMMON.CONTACTS'
3805 include 'COMMON.CONTACTS.MOMENT'
3807 include 'COMMON.TORSION'
3808 include 'COMMON.VECTORS'
3809 include 'COMMON.FFIELD'
3810 include 'COMMON.CONTROL'
3812 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3813 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3814 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3815 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3816 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3817 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3818 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3821 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3823 C Fourth-order contributions
3831 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3832 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3833 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3838 iti1=itortyp(itype(i+1))
3839 iti2=itortyp(itype(i+2))
3840 iti3=itortyp(itype(i+3))
3841 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3842 call transpose2(EUg(1,1,i+1),e1t(1,1))
3843 call transpose2(Eug(1,1,i+2),e2t(1,1))
3844 call transpose2(Eug(1,1,i+3),e3t(1,1))
3845 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3846 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3847 s1=scalar2(b1(1,iti2),auxvec(1))
3848 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3849 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3850 s2=scalar2(b1(1,iti1),auxvec(1))
3851 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3852 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3853 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3854 eello_turn4=eello_turn4-(s1+s2+s3)
3855 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3856 & 'eturn4',i,j,-(s1+s2+s3)
3857 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3858 cd & ' eello_turn4_num',8*eello_turn4_num
3859 C Derivatives in gamma(i)
3860 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3861 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3862 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3863 s1=scalar2(b1(1,iti2),auxvec(1))
3864 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3865 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3866 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3867 C Derivatives in gamma(i+1)
3868 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3869 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3870 s2=scalar2(b1(1,iti1),auxvec(1))
3871 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3872 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3873 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3874 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3875 C Derivatives in gamma(i+2)
3876 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3877 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3878 s1=scalar2(b1(1,iti2),auxvec(1))
3879 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3880 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3881 s2=scalar2(b1(1,iti1),auxvec(1))
3882 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3883 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3884 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3885 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3886 C Cartesian derivatives
3887 C Derivatives of this turn contributions in DC(i+2)
3888 if (j.lt.nres-1) then
3890 a_temp(1,1)=agg(l,1)
3891 a_temp(1,2)=agg(l,2)
3892 a_temp(2,1)=agg(l,3)
3893 a_temp(2,2)=agg(l,4)
3894 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3895 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3896 s1=scalar2(b1(1,iti2),auxvec(1))
3897 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3898 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3899 s2=scalar2(b1(1,iti1),auxvec(1))
3900 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3901 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3902 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3904 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3907 C Remaining derivatives of this turn contribution
3909 a_temp(1,1)=aggi(l,1)
3910 a_temp(1,2)=aggi(l,2)
3911 a_temp(2,1)=aggi(l,3)
3912 a_temp(2,2)=aggi(l,4)
3913 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3914 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3915 s1=scalar2(b1(1,iti2),auxvec(1))
3916 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3917 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3918 s2=scalar2(b1(1,iti1),auxvec(1))
3919 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3920 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3921 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3922 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3923 a_temp(1,1)=aggi1(l,1)
3924 a_temp(1,2)=aggi1(l,2)
3925 a_temp(2,1)=aggi1(l,3)
3926 a_temp(2,2)=aggi1(l,4)
3927 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3928 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3929 s1=scalar2(b1(1,iti2),auxvec(1))
3930 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3931 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3932 s2=scalar2(b1(1,iti1),auxvec(1))
3933 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3934 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3935 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3936 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3937 a_temp(1,1)=aggj(l,1)
3938 a_temp(1,2)=aggj(l,2)
3939 a_temp(2,1)=aggj(l,3)
3940 a_temp(2,2)=aggj(l,4)
3941 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3942 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3943 s1=scalar2(b1(1,iti2),auxvec(1))
3944 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3945 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3946 s2=scalar2(b1(1,iti1),auxvec(1))
3947 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3948 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3949 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3950 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3951 a_temp(1,1)=aggj1(l,1)
3952 a_temp(1,2)=aggj1(l,2)
3953 a_temp(2,1)=aggj1(l,3)
3954 a_temp(2,2)=aggj1(l,4)
3955 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3956 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3957 s1=scalar2(b1(1,iti2),auxvec(1))
3958 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3959 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3960 s2=scalar2(b1(1,iti1),auxvec(1))
3961 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3962 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3963 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3964 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3965 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3969 C-----------------------------------------------------------------------------
3970 subroutine vecpr(u,v,w)
3971 implicit real*8(a-h,o-z)
3972 dimension u(3),v(3),w(3)
3973 w(1)=u(2)*v(3)-u(3)*v(2)
3974 w(2)=-u(1)*v(3)+u(3)*v(1)
3975 w(3)=u(1)*v(2)-u(2)*v(1)
3978 C-----------------------------------------------------------------------------
3979 subroutine unormderiv(u,ugrad,unorm,ungrad)
3980 C This subroutine computes the derivatives of a normalized vector u, given
3981 C the derivatives computed without normalization conditions, ugrad. Returns
3984 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3985 double precision vec(3)
3986 double precision scalar
3988 c write (2,*) 'ugrad',ugrad
3991 vec(i)=scalar(ugrad(1,i),u(1))
3993 c write (2,*) 'vec',vec
3996 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3999 c write (2,*) 'ungrad',ungrad
4002 C-----------------------------------------------------------------------------
4003 subroutine escp_soft_sphere(evdw2,evdw2_14)
4005 C This subroutine calculates the excluded-volume interaction energy between
4006 C peptide-group centers and side chains and its gradient in virtual-bond and
4007 C side-chain vectors.
4009 implicit real*8 (a-h,o-z)
4010 include 'DIMENSIONS'
4011 include 'COMMON.GEO'
4012 include 'COMMON.VAR'
4013 include 'COMMON.LOCAL'
4014 include 'COMMON.CHAIN'
4015 include 'COMMON.DERIV'
4016 include 'COMMON.INTERACT'
4017 include 'COMMON.FFIELD'
4018 include 'COMMON.IOUNITS'
4019 include 'COMMON.CONTROL'
4024 cd print '(a)','Enter ESCP'
4025 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4026 do i=iatscp_s,iatscp_e
4028 xi=0.5D0*(c(1,i)+c(1,i+1))
4029 yi=0.5D0*(c(2,i)+c(2,i+1))
4030 zi=0.5D0*(c(3,i)+c(3,i+1))
4032 do iint=1,nscp_gr(i)
4034 do j=iscpstart(i,iint),iscpend(i,iint)
4035 itypj=iabs(itype(j))
4036 C Uncomment following three lines for SC-p interactions
4040 C Uncomment following three lines for Ca-p interactions
4044 rij=xj*xj+yj*yj+zj*zj
4047 if (rij.lt.r0ijsq) then
4048 evdwij=0.25d0*(rij-r0ijsq)**2
4056 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4061 cgrad if (j.lt.i) then
4062 cd write (iout,*) 'j<i'
4063 C Uncomment following three lines for SC-p interactions
4065 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4068 cd write (iout,*) 'j>i'
4070 cgrad ggg(k)=-ggg(k)
4071 C Uncomment following line for SC-p interactions
4072 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4076 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4078 cgrad kstart=min0(i+1,j)
4079 cgrad kend=max0(i-1,j-1)
4080 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4081 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4082 cgrad do k=kstart,kend
4084 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4088 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4089 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4097 C-----------------------------------------------------------------------------
4098 subroutine escp(evdw2,evdw2_14)
4100 C This subroutine calculates the excluded-volume interaction energy between
4101 C peptide-group centers and side chains and its gradient in virtual-bond and
4102 C side-chain vectors.
4104 implicit real*8 (a-h,o-z)
4105 include 'DIMENSIONS'
4106 include 'COMMON.GEO'
4107 include 'COMMON.VAR'
4108 include 'COMMON.LOCAL'
4109 include 'COMMON.CHAIN'
4110 include 'COMMON.DERIV'
4111 include 'COMMON.INTERACT'
4112 include 'COMMON.FFIELD'
4113 include 'COMMON.IOUNITS'
4114 include 'COMMON.CONTROL'
4118 cd print '(a)','Enter ESCP'
4119 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4120 do i=iatscp_s,iatscp_e
4122 xi=0.5D0*(c(1,i)+c(1,i+1))
4123 yi=0.5D0*(c(2,i)+c(2,i+1))
4124 zi=0.5D0*(c(3,i)+c(3,i+1))
4126 do iint=1,nscp_gr(i)
4128 do j=iscpstart(i,iint),iscpend(i,iint)
4129 itypj=iabs(itype(j))
4130 C Uncomment following three lines for SC-p interactions
4134 C Uncomment following three lines for Ca-p interactions
4138 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4140 e1=fac*fac*aad(itypj,iteli)
4141 e2=fac*bad(itypj,iteli)
4142 if (iabs(j-i) .le. 2) then
4145 evdw2_14=evdw2_14+e1+e2
4149 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4150 & 'evdw2',i,j,evdwij
4152 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4154 fac=-(evdwij+e1)*rrij
4158 cgrad if (j.lt.i) then
4159 cd write (iout,*) 'j<i'
4160 C Uncomment following three lines for SC-p interactions
4162 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4165 cd write (iout,*) 'j>i'
4167 cgrad ggg(k)=-ggg(k)
4168 C Uncomment following line for SC-p interactions
4169 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4170 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4174 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4176 cgrad kstart=min0(i+1,j)
4177 cgrad kend=max0(i-1,j-1)
4178 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4179 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4180 cgrad do k=kstart,kend
4182 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4186 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4187 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4195 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4196 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4197 gradx_scp(j,i)=expon*gradx_scp(j,i)
4200 C******************************************************************************
4204 C To save time the factor EXPON has been extracted from ALL components
4205 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4208 C******************************************************************************
4211 C--------------------------------------------------------------------------
4212 subroutine edis(ehpb)
4214 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4216 implicit real*8 (a-h,o-z)
4217 include 'DIMENSIONS'
4218 include 'COMMON.SBRIDGE'
4219 include 'COMMON.CHAIN'
4220 include 'COMMON.DERIV'
4221 include 'COMMON.VAR'
4222 include 'COMMON.INTERACT'
4223 include 'COMMON.IOUNITS'
4226 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4227 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4228 if (link_end.eq.0) return
4229 do i=link_start,link_end
4230 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4231 C CA-CA distance used in regularization of structure.
4234 C iii and jjj point to the residues for which the distance is assigned.
4235 if (ii.gt.nres) then
4242 cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj
4243 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4244 C distance and angle dependent SS bond potential.
4245 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and. iabs(itype(jjj
4247 call ssbond_ene(iii,jjj,eij)
4249 cd write (iout,*) "eij",eij
4251 C Calculate the distance between the two points and its difference from the
4255 C Get the force constant corresponding to this distance.
4257 C Calculate the contribution to energy.
4258 ehpb=ehpb+waga*rdis*rdis
4260 C Evaluate gradient.
4263 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4264 cd & ' waga=',waga,' fac=',fac
4266 ggg(j)=fac*(c(j,jj)-c(j,ii))
4268 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4269 C If this is a SC-SC distance, we need to calculate the contributions to the
4270 C Cartesian gradient in the SC vectors (ghpbx).
4273 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4274 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4277 cgrad do j=iii,jjj-1
4279 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4283 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4284 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4291 C--------------------------------------------------------------------------
4292 subroutine ssbond_ene(i,j,eij)
4294 C Calculate the distance and angle dependent SS-bond potential energy
4295 C using a free-energy function derived based on RHF/6-31G** ab initio
4296 C calculations of diethyl disulfide.
4298 C A. Liwo and U. Kozlowska, 11/24/03
4300 implicit real*8 (a-h,o-z)
4301 include 'DIMENSIONS'
4302 include 'COMMON.SBRIDGE'
4303 include 'COMMON.CHAIN'
4304 include 'COMMON.DERIV'
4305 include 'COMMON.LOCAL'
4306 include 'COMMON.INTERACT'
4307 include 'COMMON.VAR'
4308 include 'COMMON.IOUNITS'
4309 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4310 itypi=iabs(itype(i))
4314 dxi=dc_norm(1,nres+i)
4315 dyi=dc_norm(2,nres+i)
4316 dzi=dc_norm(3,nres+i)
4317 c dsci_inv=dsc_inv(itypi)
4318 dsci_inv=vbld_inv(nres+i)
4319 itypj=iabs(itype(j))
4320 c dscj_inv=dsc_inv(itypj)
4321 dscj_inv=vbld_inv(nres+j)
4325 dxj=dc_norm(1,nres+j)
4326 dyj=dc_norm(2,nres+j)
4327 dzj=dc_norm(3,nres+j)
4328 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4333 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4334 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4335 om12=dxi*dxj+dyi*dyj+dzi*dzj
4337 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4338 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4344 deltat12=om2-om1+2.0d0
4346 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4347 & +akct*deltad*deltat12
4348 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4349 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4350 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4351 c & " deltat12",deltat12," eij",eij
4352 ed=2*akcm*deltad+akct*deltat12
4354 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4355 eom1=-2*akth*deltat1-pom1-om2*pom2
4356 eom2= 2*akth*deltat2+pom1-om1*pom2
4359 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4360 ghpbx(k,i)=ghpbx(k,i)-ggk
4361 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4362 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4363 ghpbx(k,j)=ghpbx(k,j)+ggk
4364 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4365 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4366 ghpbc(k,i)=ghpbc(k,i)-ggk
4367 ghpbc(k,j)=ghpbc(k,j)+ggk
4370 C Calculate the components of the gradient in DC and X
4374 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4379 C--------------------------------------------------------------------------
4380 subroutine ebond(estr)
4382 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4384 implicit real*8 (a-h,o-z)
4385 include 'DIMENSIONS'
4386 include 'COMMON.LOCAL'
4387 include 'COMMON.GEO'
4388 include 'COMMON.INTERACT'
4389 include 'COMMON.DERIV'
4390 include 'COMMON.VAR'
4391 include 'COMMON.CHAIN'
4392 include 'COMMON.IOUNITS'
4393 include 'COMMON.NAMES'
4394 include 'COMMON.FFIELD'
4395 include 'COMMON.CONTROL'
4396 include 'COMMON.SETUP'
4397 double precision u(3),ud(3)
4399 do i=ibondp_start,ibondp_end
4400 diff = vbld(i)-vbldp0
4401 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4404 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4406 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4410 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4412 do i=ibond_start,ibond_end
4417 diff=vbld(i+nres)-vbldsc0(1,iti)
4418 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4419 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4420 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4422 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4426 diff=vbld(i+nres)-vbldsc0(j,iti)
4427 ud(j)=aksc(j,iti)*diff
4428 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4442 uprod2=uprod2*u(k)*u(k)
4446 usumsqder=usumsqder+ud(j)*uprod2
4448 estr=estr+uprod/usum
4450 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4458 C--------------------------------------------------------------------------
4459 subroutine ebend(etheta)
4461 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4462 C angles gamma and its derivatives in consecutive thetas and gammas.
4464 implicit real*8 (a-h,o-z)
4465 include 'DIMENSIONS'
4466 include 'COMMON.LOCAL'
4467 include 'COMMON.GEO'
4468 include 'COMMON.INTERACT'
4469 include 'COMMON.DERIV'
4470 include 'COMMON.VAR'
4471 include 'COMMON.CHAIN'
4472 include 'COMMON.IOUNITS'
4473 include 'COMMON.NAMES'
4474 include 'COMMON.FFIELD'
4475 include 'COMMON.CONTROL'
4476 common /calcthet/ term1,term2,termm,diffak,ratak,
4477 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4478 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4479 double precision y(2),z(2)
4481 c time11=dexp(-2*time)
4484 c write (*,'(a,i2)') 'EBEND ICG=',icg
4485 do i=ithet_start,ithet_end
4486 C Zero the energy function and its derivative at 0 or pi.
4487 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4492 ichir1=isign(1,itype(i-2))
4493 ichir2=isign(1,itype(i))
4494 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4495 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4496 if (itype(i-1).eq.10) then
4497 itype1=isign(10,itype(i-2))
4498 ichir11=isign(1,itype(i-2))
4499 ichir12=isign(1,itype(i-2))
4500 itype2=isign(10,itype(i))
4501 ichir21=isign(1,itype(i))
4502 ichir22=isign(1,itype(i))
4508 if (phii.ne.phii) phii=150.0
4521 if (phii1.ne.phii1) phii1=150.0
4533 C Calculate the "mean" value of theta from the part of the distribution
4534 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4535 C In following comments this theta will be referred to as t_c.
4536 thet_pred_mean=0.0d0
4538 athetk=athet(k,it,ichir1,ichir2)
4539 bthetk=bthet(k,it,ichir1,ichir2)
4541 athetk=athet(k,itype1,ichir11,ichir12)
4542 bthetk=bthet(k,itype2,ichir21,ichir22)
4544 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4546 dthett=thet_pred_mean*ssd
4547 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4548 C Derivatives of the "mean" values in gamma1 and gamma2.
4549 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4550 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4551 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4552 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4554 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4555 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4556 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4557 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4559 if (theta(i).gt.pi-delta) then
4560 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4562 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4563 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4564 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4566 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4568 else if (theta(i).lt.delta) then
4569 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4570 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4571 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4573 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4574 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4577 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4580 etheta=etheta+ethetai
4581 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4583 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4584 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4585 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4587 C Ufff.... We've done all this!!!
4590 C---------------------------------------------------------------------------
4591 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4593 implicit real*8 (a-h,o-z)
4594 include 'DIMENSIONS'
4595 include 'COMMON.LOCAL'
4596 include 'COMMON.IOUNITS'
4597 common /calcthet/ term1,term2,termm,diffak,ratak,
4598 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4599 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4600 C Calculate the contributions to both Gaussian lobes.
4601 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4602 C The "polynomial part" of the "standard deviation" of this part of
4606 sig=sig*thet_pred_mean+polthet(j,it)
4608 C Derivative of the "interior part" of the "standard deviation of the"
4609 C gamma-dependent Gaussian lobe in t_c.
4610 sigtc=3*polthet(3,it)
4612 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4615 C Set the parameters of both Gaussian lobes of the distribution.
4616 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4617 fac=sig*sig+sigc0(it)
4620 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4621 sigsqtc=-4.0D0*sigcsq*sigtc
4622 c print *,i,sig,sigtc,sigsqtc
4623 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4624 sigtc=-sigtc/(fac*fac)
4625 C Following variable is sigma(t_c)**(-2)
4626 sigcsq=sigcsq*sigcsq
4628 sig0inv=1.0D0/sig0i**2
4629 delthec=thetai-thet_pred_mean
4630 delthe0=thetai-theta0i
4631 term1=-0.5D0*sigcsq*delthec*delthec
4632 term2=-0.5D0*sig0inv*delthe0*delthe0
4633 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4634 C NaNs in taking the logarithm. We extract the largest exponent which is added
4635 C to the energy (this being the log of the distribution) at the end of energy
4636 C term evaluation for this virtual-bond angle.
4637 if (term1.gt.term2) then
4639 term2=dexp(term2-termm)
4643 term1=dexp(term1-termm)
4646 C The ratio between the gamma-independent and gamma-dependent lobes of
4647 C the distribution is a Gaussian function of thet_pred_mean too.
4648 diffak=gthet(2,it)-thet_pred_mean
4649 ratak=diffak/gthet(3,it)**2
4650 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4651 C Let's differentiate it in thet_pred_mean NOW.
4653 C Now put together the distribution terms to make complete distribution.
4654 termexp=term1+ak*term2
4655 termpre=sigc+ak*sig0i
4656 C Contribution of the bending energy from this theta is just the -log of
4657 C the sum of the contributions from the two lobes and the pre-exponential
4658 C factor. Simple enough, isn't it?
4659 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4660 C NOW the derivatives!!!
4661 C 6/6/97 Take into account the deformation.
4662 E_theta=(delthec*sigcsq*term1
4663 & +ak*delthe0*sig0inv*term2)/termexp
4664 E_tc=((sigtc+aktc*sig0i)/termpre
4665 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4666 & aktc*term2)/termexp)
4669 c-----------------------------------------------------------------------------
4670 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4671 implicit real*8 (a-h,o-z)
4672 include 'DIMENSIONS'
4673 include 'COMMON.LOCAL'
4674 include 'COMMON.IOUNITS'
4675 common /calcthet/ term1,term2,termm,diffak,ratak,
4676 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4677 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4678 delthec=thetai-thet_pred_mean
4679 delthe0=thetai-theta0i
4680 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4681 t3 = thetai-thet_pred_mean
4685 t14 = t12+t6*sigsqtc
4687 t21 = thetai-theta0i
4693 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4694 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4695 & *(-t12*t9-ak*sig0inv*t27)
4699 C--------------------------------------------------------------------------
4700 subroutine ebend(etheta)
4702 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4703 C angles gamma and its derivatives in consecutive thetas and gammas.
4704 C ab initio-derived potentials from
4705 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4707 implicit real*8 (a-h,o-z)
4708 include 'DIMENSIONS'
4709 include 'COMMON.LOCAL'
4710 include 'COMMON.GEO'
4711 include 'COMMON.INTERACT'
4712 include 'COMMON.DERIV'
4713 include 'COMMON.VAR'
4714 include 'COMMON.CHAIN'
4715 include 'COMMON.IOUNITS'
4716 include 'COMMON.NAMES'
4717 include 'COMMON.FFIELD'
4718 include 'COMMON.CONTROL'
4719 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4720 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4721 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4722 & sinph1ph2(maxdouble,maxdouble)
4723 logical lprn /.false./, lprn1 /.false./
4725 do i=ithet_start,ithet_end
4729 theti2=0.5d0*theta(i)
4730 ityp2=ithetyp(iabs(itype(i-1)))
4732 coskt(k)=dcos(k*theti2)
4733 sinkt(k)=dsin(k*theti2)
4738 if (phii.ne.phii) phii=150.0
4742 ityp1=ithetyp(iabs(itype(i-2)))
4744 cosph1(k)=dcos(k*phii)
4745 sinph1(k)=dsin(k*phii)
4758 if (phii1.ne.phii1) phii1=150.0
4763 ityp3=ithetyp(iabs(itype(i)))
4765 cosph2(k)=dcos(k*phii1)
4766 sinph2(k)=dsin(k*phii1)
4776 ethetai=aa0thet(ityp1,ityp2,ityp3)
4779 ccl=cosph1(l)*cosph2(k-l)
4780 ssl=sinph1(l)*sinph2(k-l)
4781 scl=sinph1(l)*cosph2(k-l)
4782 csl=cosph1(l)*sinph2(k-l)
4783 cosph1ph2(l,k)=ccl-ssl
4784 cosph1ph2(k,l)=ccl+ssl
4785 sinph1ph2(l,k)=scl+csl
4786 sinph1ph2(k,l)=scl-csl
4790 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4791 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4792 write (iout,*) "coskt and sinkt"
4794 write (iout,*) k,coskt(k),sinkt(k)
4798 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4799 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4802 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4803 & " ethetai",ethetai
4806 write (iout,*) "cosph and sinph"
4808 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4810 write (iout,*) "cosph1ph2 and sinph2ph2"
4813 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4814 & sinph1ph2(l,k),sinph1ph2(k,l)
4817 write(iout,*) "ethetai",ethetai
4821 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4822 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4823 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4824 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4825 ethetai=ethetai+sinkt(m)*aux
4826 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4827 dephii=dephii+k*sinkt(m)*(
4828 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4829 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4830 dephii1=dephii1+k*sinkt(m)*(
4831 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4832 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4834 & write (iout,*) "m",m," k",k," bbthet",
4835 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4836 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4837 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4838 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4842 & write(iout,*) "ethetai",ethetai
4846 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4847 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4848 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4849 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4850 ethetai=ethetai+sinkt(m)*aux
4851 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4852 dephii=dephii+l*sinkt(m)*(
4853 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4854 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4855 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4856 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4857 dephii1=dephii1+(k-l)*sinkt(m)*(
4858 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4859 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4860 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4861 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4863 write (iout,*) "m",m," k",k," l",l," ffthet",
4864 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4865 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4866 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4867 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4868 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4869 & cosph1ph2(k,l)*sinkt(m),
4870 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4876 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4877 & i,theta(i)*rad2deg,phii*rad2deg,
4878 & phii1*rad2deg,ethetai
4879 etheta=etheta+ethetai
4880 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4881 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4882 gloc(nphi+i-2,icg)=wang*dethetai
4888 c-----------------------------------------------------------------------------
4889 subroutine esc(escloc)
4890 C Calculate the local energy of a side chain and its derivatives in the
4891 C corresponding virtual-bond valence angles THETA and the spherical angles
4893 implicit real*8 (a-h,o-z)
4894 include 'DIMENSIONS'
4895 include 'COMMON.GEO'
4896 include 'COMMON.LOCAL'
4897 include 'COMMON.VAR'
4898 include 'COMMON.INTERACT'
4899 include 'COMMON.DERIV'
4900 include 'COMMON.CHAIN'
4901 include 'COMMON.IOUNITS'
4902 include 'COMMON.NAMES'
4903 include 'COMMON.FFIELD'
4904 include 'COMMON.CONTROL'
4905 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4906 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4907 common /sccalc/ time11,time12,time112,theti,it,nlobit
4910 c write (iout,'(a)') 'ESC'
4911 do i=loc_start,loc_end
4913 if (it.eq.10) goto 1
4914 nlobit=nlob(iabs(it))
4915 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4916 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4917 theti=theta(i+1)-pipol
4922 if (x(2).gt.pi-delta) then
4926 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4928 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4929 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4931 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4932 & ddersc0(1),dersc(1))
4933 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4934 & ddersc0(3),dersc(3))
4936 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4938 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4939 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4940 & dersc0(2),esclocbi,dersc02)
4941 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4943 call splinthet(x(2),0.5d0*delta,ss,ssd)
4948 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4950 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4951 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4953 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4955 c write (iout,*) escloci
4956 else if (x(2).lt.delta) then
4960 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4962 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4963 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4965 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4966 & ddersc0(1),dersc(1))
4967 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4968 & ddersc0(3),dersc(3))
4970 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4972 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4973 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4974 & dersc0(2),esclocbi,dersc02)
4975 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4980 call splinthet(x(2),0.5d0*delta,ss,ssd)
4982 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4984 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4985 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4987 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4988 c write (iout,*) escloci
4990 call enesc(x,escloci,dersc,ddummy,.false.)
4993 escloc=escloc+escloci
4994 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4995 & 'escloc',i,escloci
4996 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4998 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5000 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5001 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5006 C---------------------------------------------------------------------------
5007 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5008 implicit real*8 (a-h,o-z)
5009 include 'DIMENSIONS'
5010 include 'COMMON.GEO'
5011 include 'COMMON.LOCAL'
5012 include 'COMMON.IOUNITS'
5013 common /sccalc/ time11,time12,time112,theti,it,nlobit
5014 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5015 double precision contr(maxlob,-1:1)
5017 c write (iout,*) 'it=',it,' nlobit=',nlobit
5021 if (mixed) ddersc(j)=0.0d0
5025 C Because of periodicity of the dependence of the SC energy in omega we have
5026 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5027 C To avoid underflows, first compute & store the exponents.
5035 z(k)=x(k)-censc(k,j,it)
5040 Axk=Axk+gaussc(l,k,j,it)*z(l)
5046 expfac=expfac+Ax(k,j,iii)*z(k)
5054 C As in the case of ebend, we want to avoid underflows in exponentiation and
5055 C subsequent NaNs and INFs in energy calculation.
5056 C Find the largest exponent
5060 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5064 cd print *,'it=',it,' emin=',emin
5066 C Compute the contribution to SC energy and derivatives
5071 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5072 if(adexp.ne.adexp) adexp=1.0
5075 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5077 cd print *,'j=',j,' expfac=',expfac
5078 escloc_i=escloc_i+expfac
5080 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5084 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5085 & +gaussc(k,2,j,it))*expfac
5092 dersc(1)=dersc(1)/cos(theti)**2
5093 ddersc(1)=ddersc(1)/cos(theti)**2
5096 escloci=-(dlog(escloc_i)-emin)
5098 dersc(j)=dersc(j)/escloc_i
5102 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5107 C------------------------------------------------------------------------------
5108 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5109 implicit real*8 (a-h,o-z)
5110 include 'DIMENSIONS'
5111 include 'COMMON.GEO'
5112 include 'COMMON.LOCAL'
5113 include 'COMMON.IOUNITS'
5114 common /sccalc/ time11,time12,time112,theti,it,nlobit
5115 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5116 double precision contr(maxlob)
5127 z(k)=x(k)-censc(k,j,it)
5133 Axk=Axk+gaussc(l,k,j,it)*z(l)
5139 expfac=expfac+Ax(k,j)*z(k)
5144 C As in the case of ebend, we want to avoid underflows in exponentiation and
5145 C subsequent NaNs and INFs in energy calculation.
5146 C Find the largest exponent
5149 if (emin.gt.contr(j)) emin=contr(j)
5153 C Compute the contribution to SC energy and derivatives
5157 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5158 escloc_i=escloc_i+expfac
5160 dersc(k)=dersc(k)+Ax(k,j)*expfac
5162 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5163 & +gaussc(1,2,j,it))*expfac
5167 dersc(1)=dersc(1)/cos(theti)**2
5168 dersc12=dersc12/cos(theti)**2
5169 escloci=-(dlog(escloc_i)-emin)
5171 dersc(j)=dersc(j)/escloc_i
5173 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5177 c----------------------------------------------------------------------------------
5178 subroutine esc(escloc)
5179 C Calculate the local energy of a side chain and its derivatives in the
5180 C corresponding virtual-bond valence angles THETA and the spherical angles
5181 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5182 C added by Urszula Kozlowska. 07/11/2007
5184 implicit real*8 (a-h,o-z)
5185 include 'DIMENSIONS'
5186 include 'COMMON.GEO'
5187 include 'COMMON.LOCAL'
5188 include 'COMMON.VAR'
5189 include 'COMMON.SCROT'
5190 include 'COMMON.INTERACT'
5191 include 'COMMON.DERIV'
5192 include 'COMMON.CHAIN'
5193 include 'COMMON.IOUNITS'
5194 include 'COMMON.NAMES'
5195 include 'COMMON.FFIELD'
5196 include 'COMMON.CONTROL'
5197 include 'COMMON.VECTORS'
5198 double precision x_prime(3),y_prime(3),z_prime(3)
5199 & , sumene,dsc_i,dp2_i,x(65),
5200 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5201 & de_dxx,de_dyy,de_dzz,de_dt
5202 double precision s1_t,s1_6_t,s2_t,s2_6_t
5204 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5205 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5206 & dt_dCi(3),dt_dCi1(3)
5207 common /sccalc/ time11,time12,time112,theti,it,nlobit
5210 do i=loc_start,loc_end
5211 costtab(i+1) =dcos(theta(i+1))
5212 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5213 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5214 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5215 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5216 cosfac=dsqrt(cosfac2)
5217 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5218 sinfac=dsqrt(sinfac2)
5220 if (it.eq.10) goto 1
5222 C Compute the axes of tghe local cartesian coordinates system; store in
5223 c x_prime, y_prime and z_prime
5230 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5231 C & dc_norm(3,i+nres)
5233 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5234 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5237 z_prime(j) = -uz(j,i-1)
5240 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5241 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5242 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5243 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5244 c & " xy",scalar(x_prime(1),y_prime(1)),
5245 c & " xz",scalar(x_prime(1),z_prime(1)),
5246 c & " yy",scalar(y_prime(1),y_prime(1)),
5247 c & " yz",scalar(y_prime(1),z_prime(1)),
5248 c & " zz",scalar(z_prime(1),z_prime(1))
5250 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5251 C to local coordinate system. Store in xx, yy, zz.
5257 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5258 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5259 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5266 C Compute the energy of the ith side cbain
5268 c write (2,*) "xx",xx," yy",yy," zz",zz
5271 x(j) = sc_parmin(j,it)
5274 Cc diagnostics - remove later
5276 yy1 = dsin(alph(2))*dcos(omeg(2))
5277 zz1 = -dsin(alph(2))*dsin(omeg(2))
5278 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5279 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5281 C," --- ", xx_w,yy_w,zz_w
5284 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5285 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5287 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5288 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5290 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5291 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5292 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5293 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5294 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5296 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5297 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5298 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5299 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5300 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5302 dsc_i = 0.743d0+x(61)
5304 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5305 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5306 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5307 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5308 s1=(1+x(63))/(0.1d0 + dscp1)
5309 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5310 s2=(1+x(65))/(0.1d0 + dscp2)
5311 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5312 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5313 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5314 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5316 c & dscp1,dscp2,sumene
5317 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5318 escloc = escloc + sumene
5319 c write (2,*) "i",i," escloc",sumene,escloc
5322 C This section to check the numerical derivatives of the energy of ith side
5323 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5324 C #define DEBUG in the code to turn it on.
5326 write (2,*) "sumene =",sumene
5330 write (2,*) xx,yy,zz
5331 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5332 de_dxx_num=(sumenep-sumene)/aincr
5334 write (2,*) "xx+ sumene from enesc=",sumenep
5337 write (2,*) xx,yy,zz
5338 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5339 de_dyy_num=(sumenep-sumene)/aincr
5341 write (2,*) "yy+ sumene from enesc=",sumenep
5344 write (2,*) xx,yy,zz
5345 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5346 de_dzz_num=(sumenep-sumene)/aincr
5348 write (2,*) "zz+ sumene from enesc=",sumenep
5349 costsave=cost2tab(i+1)
5350 sintsave=sint2tab(i+1)
5351 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5352 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5353 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5354 de_dt_num=(sumenep-sumene)/aincr
5355 write (2,*) " t+ sumene from enesc=",sumenep
5356 cost2tab(i+1)=costsave
5357 sint2tab(i+1)=sintsave
5358 C End of diagnostics section.
5361 C Compute the gradient of esc
5363 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5364 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5365 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5366 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5367 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5368 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5369 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5370 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5371 pom1=(sumene3*sint2tab(i+1)+sumene1)
5372 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5373 pom2=(sumene4*cost2tab(i+1)+sumene2)
5374 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5375 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5376 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5377 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5379 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5380 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5381 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5383 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5384 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5385 & +(pom1+pom2)*pom_dx
5387 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5390 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5391 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5392 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5394 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5395 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5396 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5397 & +x(59)*zz**2 +x(60)*xx*zz
5398 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5399 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5400 & +(pom1-pom2)*pom_dy
5402 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5405 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5406 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5407 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5408 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5409 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5410 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5411 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5412 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5414 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5417 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5418 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5419 & +pom1*pom_dt1+pom2*pom_dt2
5421 write(2,*), "de_dt = ", de_dt,de_dt_num
5425 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5426 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5427 cosfac2xx=cosfac2*xx
5428 sinfac2yy=sinfac2*yy
5430 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5432 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5434 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5435 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5436 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5437 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5438 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5439 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5440 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5441 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5442 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5443 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5447 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5448 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5451 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5452 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5453 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5455 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5456 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5460 dXX_Ctab(k,i)=dXX_Ci(k)
5461 dXX_C1tab(k,i)=dXX_Ci1(k)
5462 dYY_Ctab(k,i)=dYY_Ci(k)
5463 dYY_C1tab(k,i)=dYY_Ci1(k)
5464 dZZ_Ctab(k,i)=dZZ_Ci(k)
5465 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5466 dXX_XYZtab(k,i)=dXX_XYZ(k)
5467 dYY_XYZtab(k,i)=dYY_XYZ(k)
5468 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5472 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5473 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5474 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5475 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5476 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5478 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5479 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5480 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5481 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5482 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5483 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5484 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5485 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5487 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5488 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5490 C to check gradient call subroutine check_grad
5496 c------------------------------------------------------------------------------
5497 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5499 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5500 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5501 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5502 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5504 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5505 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5507 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5508 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5509 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5510 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5511 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5513 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5514 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5515 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5516 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5517 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5519 dsc_i = 0.743d0+x(61)
5521 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5522 & *(xx*cost2+yy*sint2))
5523 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5524 & *(xx*cost2-yy*sint2))
5525 s1=(1+x(63))/(0.1d0 + dscp1)
5526 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5527 s2=(1+x(65))/(0.1d0 + dscp2)
5528 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5529 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5530 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5535 c------------------------------------------------------------------------------
5536 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5538 C This procedure calculates two-body contact function g(rij) and its derivative:
5541 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5544 C where x=(rij-r0ij)/delta
5546 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5549 double precision rij,r0ij,eps0ij,fcont,fprimcont
5550 double precision x,x2,x4,delta
5554 if (x.lt.-1.0D0) then
5557 else if (x.le.1.0D0) then
5560 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5561 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5568 c------------------------------------------------------------------------------
5569 subroutine splinthet(theti,delta,ss,ssder)
5570 implicit real*8 (a-h,o-z)
5571 include 'DIMENSIONS'
5572 include 'COMMON.VAR'
5573 include 'COMMON.GEO'
5576 if (theti.gt.pipol) then
5577 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5579 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5584 c------------------------------------------------------------------------------
5585 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5587 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5588 double precision ksi,ksi2,ksi3,a1,a2,a3
5589 a1=fprim0*delta/(f1-f0)
5595 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5596 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5599 c------------------------------------------------------------------------------
5600 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5602 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5603 double precision ksi,ksi2,ksi3,a1,a2,a3
5608 a2=3*(f1x-f0x)-2*fprim0x*delta
5609 a3=fprim0x*delta-2*(f1x-f0x)
5610 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5613 C-----------------------------------------------------------------------------
5615 C-----------------------------------------------------------------------------
5616 subroutine etor(etors,edihcnstr)
5617 implicit real*8 (a-h,o-z)
5618 include 'DIMENSIONS'
5619 include 'COMMON.VAR'
5620 include 'COMMON.GEO'
5621 include 'COMMON.LOCAL'
5622 include 'COMMON.TORSION'
5623 include 'COMMON.INTERACT'
5624 include 'COMMON.DERIV'
5625 include 'COMMON.CHAIN'
5626 include 'COMMON.NAMES'
5627 include 'COMMON.IOUNITS'
5628 include 'COMMON.FFIELD'
5629 include 'COMMON.TORCNSTR'
5630 include 'COMMON.CONTROL'
5632 C Set lprn=.true. for debugging
5636 do i=iphi_start,iphi_end
5638 itori=itortyp(itype(i-2))
5639 itori1=itortyp(itype(i-1))
5640 if (iabs(itype(i)).eq.20) then
5647 C Proline-Proline pair is a special case...
5648 if (itori.eq.3 .and. itori1.eq.3) then
5649 if (phii.gt.-dwapi3) then
5651 fac=1.0D0/(1.0D0-cosphi)
5652 etorsi=v1(1,3,3)*fac
5653 etorsi=etorsi+etorsi
5654 etors=etors+etorsi-v1(1,3,3)
5655 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5656 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5659 v1ij=v1(j+1,itori,itori1)
5660 v2ij=v2(j+1,itori,itori1)
5663 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5664 if (energy_dec) etors_ii=etors_ii+
5665 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5666 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5670 v1ij=v1(j,itori,itori1)
5671 v2ij=v2(j,itori,itori1)
5674 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5675 if (energy_dec) etors_ii=etors_ii+
5676 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5677 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5680 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5683 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5684 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5685 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5686 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5687 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5689 ! 6/20/98 - dihedral angle constraints
5692 itori=idih_constr(i)
5695 if (difi.gt.drange(i)) then
5697 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5698 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5699 else if (difi.lt.-drange(i)) then
5701 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5702 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5704 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5705 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5707 ! write (iout,*) 'edihcnstr',edihcnstr
5710 c------------------------------------------------------------------------------
5711 subroutine etor_d(etors_d)
5715 c----------------------------------------------------------------------------
5717 subroutine etor(etors,edihcnstr)
5718 implicit real*8 (a-h,o-z)
5719 include 'DIMENSIONS'
5720 include 'COMMON.VAR'
5721 include 'COMMON.GEO'
5722 include 'COMMON.LOCAL'
5723 include 'COMMON.TORSION'
5724 include 'COMMON.INTERACT'
5725 include 'COMMON.DERIV'
5726 include 'COMMON.CHAIN'
5727 include 'COMMON.NAMES'
5728 include 'COMMON.IOUNITS'
5729 include 'COMMON.FFIELD'
5730 include 'COMMON.TORCNSTR'
5731 include 'COMMON.CONTROL'
5733 C Set lprn=.true. for debugging
5737 do i=iphi_start,iphi_end
5739 itori=itortyp(itype(i-2))
5740 itori1=itortyp(itype(i-1))
5743 C Regular cosine and sine terms
5744 do j=1,nterm(itori,itori1,iblock)
5745 v1ij=v1(j,itori,itori1,iblock)
5746 v2ij=v2(j,itori,itori1,iblock)
5749 etors=etors+v1ij*cosphi+v2ij*sinphi
5750 if (energy_dec) etors_ii=etors_ii+
5751 & v1ij*cosphi+v2ij*sinphi
5752 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5756 C E = SUM ----------------------------------- - v1
5757 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5759 cosphi=dcos(0.5d0*phii)
5760 sinphi=dsin(0.5d0*phii)
5761 do j=1,nlor(itori,itori1,iblock)
5762 vl1ij=vlor1(j,itori,itori1)
5763 vl2ij=vlor2(j,itori,itori1)
5764 vl3ij=vlor3(j,itori,itori1)
5765 pom=vl2ij*cosphi+vl3ij*sinphi
5766 pom1=1.0d0/(pom*pom+1.0d0)
5767 etors=etors+vl1ij*pom1
5768 if (energy_dec) etors_ii=etors_ii+
5771 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5773 C Subtract the constant term
5774 etors=etors-v0(itori,itori1,iblock)
5775 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5776 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
5778 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5779 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5780 & (v1(j,itori,itori1,iblock),j=1,6),
5781 & (v2(j,itori,itori1,iblock),j=1,6)
5782 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5783 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5785 ! 6/20/98 - dihedral angle constraints
5787 c do i=1,ndih_constr
5788 do i=idihconstr_start,idihconstr_end
5789 itori=idih_constr(i)
5791 difi=pinorm(phii-phi0(i))
5792 if (difi.gt.drange(i)) then
5794 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5795 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5796 else if (difi.lt.-drange(i)) then
5798 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5799 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5803 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5804 cd & rad2deg*phi0(i), rad2deg*drange(i),
5805 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5807 cd write (iout,*) 'edihcnstr',edihcnstr
5810 c----------------------------------------------------------------------------
5811 subroutine etor_d(etors_d)
5812 C 6/23/01 Compute double torsional energy
5813 implicit real*8 (a-h,o-z)
5814 include 'DIMENSIONS'
5815 include 'COMMON.VAR'
5816 include 'COMMON.GEO'
5817 include 'COMMON.LOCAL'
5818 include 'COMMON.TORSION'
5819 include 'COMMON.INTERACT'
5820 include 'COMMON.DERIV'
5821 include 'COMMON.CHAIN'
5822 include 'COMMON.NAMES'
5823 include 'COMMON.IOUNITS'
5824 include 'COMMON.FFIELD'
5825 include 'COMMON.TORCNSTR'
5827 C Set lprn=.true. for debugging
5831 do i=iphid_start,iphid_end
5832 itori=itortyp(itype(i-2))
5833 itori1=itortyp(itype(i-1))
5834 itori2=itortyp(itype(i))
5836 if (iabs(itype(i+1)).eq.20) iblock=2
5841 C Regular cosine and sine terms
5842 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5843 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5844 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5845 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5846 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5847 cosphi1=dcos(j*phii)
5848 sinphi1=dsin(j*phii)
5849 cosphi2=dcos(j*phii1)
5850 sinphi2=dsin(j*phii1)
5851 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5852 & v2cij*cosphi2+v2sij*sinphi2
5853 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5854 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5856 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5858 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5859 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5860 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5861 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5862 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5863 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5864 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5865 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5866 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5867 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5868 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5869 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5870 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5871 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5874 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5875 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5880 c------------------------------------------------------------------------------
5881 subroutine eback_sc_corr(esccor)
5882 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5883 c conformational states; temporarily implemented as differences
5884 c between UNRES torsional potentials (dependent on three types of
5885 c residues) and the torsional potentials dependent on all 20 types
5886 c of residues computed from AM1 energy surfaces of terminally-blocked
5887 c amino-acid residues.
5888 implicit real*8 (a-h,o-z)
5889 include 'DIMENSIONS'
5890 include 'COMMON.VAR'
5891 include 'COMMON.GEO'
5892 include 'COMMON.LOCAL'
5893 include 'COMMON.TORSION'
5894 include 'COMMON.SCCOR'
5895 include 'COMMON.INTERACT'
5896 include 'COMMON.DERIV'
5897 include 'COMMON.CHAIN'
5898 include 'COMMON.NAMES'
5899 include 'COMMON.IOUNITS'
5900 include 'COMMON.FFIELD'
5901 include 'COMMON.CONTROL'
5903 C Set lprn=.true. for debugging
5906 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5908 do i=iphi_start,iphi_end
5915 v1ij=v1sccor(j,itori,itori1)
5916 v2ij=v2sccor(j,itori,itori1)
5919 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5920 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5923 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5924 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5925 & (v1sccor(j,itori,itori1),j=1,6),(v2sccor(j,itori,itori1),j=1,6)
5926 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5930 c----------------------------------------------------------------------------
5931 subroutine multibody(ecorr)
5932 C This subroutine calculates multi-body contributions to energy following
5933 C the idea of Skolnick et al. If side chains I and J make a contact and
5934 C at the same time side chains I+1 and J+1 make a contact, an extra
5935 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5936 implicit real*8 (a-h,o-z)
5937 include 'DIMENSIONS'
5938 include 'COMMON.IOUNITS'
5939 include 'COMMON.DERIV'
5940 include 'COMMON.INTERACT'
5941 include 'COMMON.CONTACTS'
5943 include 'COMMON.CONTACTS.MOMENT'
5945 double precision gx(3),gx1(3)
5948 C Set lprn=.true. for debugging
5952 write (iout,'(a)') 'Contact function values:'
5954 write (iout,'(i2,20(1x,i2,f10.5))')
5955 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5970 num_conti=num_cont(i)
5971 num_conti1=num_cont(i1)
5976 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5977 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5978 cd & ' ishift=',ishift
5979 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5980 C The system gains extra energy.
5981 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5982 endif ! j1==j+-ishift
5991 c------------------------------------------------------------------------------
5992 double precision function esccorr(i,j,k,l,jj,kk)
5993 implicit real*8 (a-h,o-z)
5994 include 'DIMENSIONS'
5995 include 'COMMON.IOUNITS'
5996 include 'COMMON.DERIV'
5997 include 'COMMON.INTERACT'
5998 include 'COMMON.CONTACTS'
6000 include 'COMMON.CONTACTS.MOMENT'
6002 double precision gx(3),gx1(3)
6007 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6008 C Calculate the multi-body contribution to energy.
6009 C Calculate multi-body contributions to the gradient.
6010 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6011 cd & k,l,(gacont(m,kk,k),m=1,3)
6013 gx(m) =ekl*gacont(m,jj,i)
6014 gx1(m)=eij*gacont(m,kk,k)
6015 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6016 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6017 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6018 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6022 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6027 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6033 c------------------------------------------------------------------------------
6034 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6035 C This subroutine calculates multi-body contributions to hydrogen-bonding
6036 implicit real*8 (a-h,o-z)
6037 include 'DIMENSIONS'
6038 include 'COMMON.IOUNITS'
6041 parameter (max_cont=maxconts)
6042 parameter (max_dim=26)
6043 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6044 double precision zapas(max_dim,maxconts,max_fg_procs),
6045 & zapas_recv(max_dim,maxconts,max_fg_procs)
6046 common /przechowalnia/ zapas
6047 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6048 & status_array(MPI_STATUS_SIZE,maxconts*2)
6050 include 'COMMON.SETUP'
6051 include 'COMMON.FFIELD'
6052 include 'COMMON.DERIV'
6053 include 'COMMON.INTERACT'
6054 include 'COMMON.CONTACTS'
6056 include 'COMMON.CONTACTS.MOMENT'
6058 include 'COMMON.CONTROL'
6059 include 'COMMON.LOCAL'
6060 double precision gx(3),gx1(3),time00
6063 C Set lprn=.true. for debugging
6068 if (nfgtasks.le.1) goto 30
6070 write (iout,'(a)') 'Contact function values before RECEIVE:'
6072 write (iout,'(2i3,50(1x,i2,f5.2))')
6073 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6074 & j=1,num_cont_hb(i))
6078 do i=1,ntask_cont_from
6081 do i=1,ntask_cont_to
6084 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6086 C Make the list of contacts to send to send to other procesors
6087 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6089 do i=iturn3_start,iturn3_end
6090 c write (iout,*) "make contact list turn3",i," num_cont",
6092 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6094 do i=iturn4_start,iturn4_end
6095 c write (iout,*) "make contact list turn4",i," num_cont",
6097 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6101 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6103 do j=1,num_cont_hb(i)
6106 iproc=iint_sent_local(k,jjc,ii)
6107 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6108 if (iproc.gt.0) then
6109 ncont_sent(iproc)=ncont_sent(iproc)+1
6110 nn=ncont_sent(iproc)
6112 zapas(2,nn,iproc)=jjc
6113 zapas(3,nn,iproc)=facont_hb(j,i)
6114 zapas(4,nn,iproc)=ees0p(j,i)
6115 zapas(5,nn,iproc)=ees0m(j,i)
6116 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6117 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6118 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6119 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6120 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6121 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6122 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6123 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6124 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6125 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6126 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6127 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6128 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6129 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6130 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6131 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6132 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6133 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6134 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6135 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6136 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6143 & "Numbers of contacts to be sent to other processors",
6144 & (ncont_sent(i),i=1,ntask_cont_to)
6145 write (iout,*) "Contacts sent"
6146 do ii=1,ntask_cont_to
6148 iproc=itask_cont_to(ii)
6149 write (iout,*) nn," contacts to processor",iproc,
6150 & " of CONT_TO_COMM group"
6152 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6160 CorrelID1=nfgtasks+fg_rank+1
6162 C Receive the numbers of needed contacts from other processors
6163 do ii=1,ntask_cont_from
6164 iproc=itask_cont_from(ii)
6166 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6167 & FG_COMM,req(ireq),IERR)
6169 c write (iout,*) "IRECV ended"
6171 C Send the number of contacts needed by other processors
6172 do ii=1,ntask_cont_to
6173 iproc=itask_cont_to(ii)
6175 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6176 & FG_COMM,req(ireq),IERR)
6178 c write (iout,*) "ISEND ended"
6179 c write (iout,*) "number of requests (nn)",ireq
6182 & call MPI_Waitall(ireq,req,status_array,ierr)
6184 c & "Numbers of contacts to be received from other processors",
6185 c & (ncont_recv(i),i=1,ntask_cont_from)
6189 do ii=1,ntask_cont_from
6190 iproc=itask_cont_from(ii)
6192 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6193 c & " of CONT_TO_COMM group"
6197 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6198 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6199 c write (iout,*) "ireq,req",ireq,req(ireq)
6202 C Send the contacts to processors that need them
6203 do ii=1,ntask_cont_to
6204 iproc=itask_cont_to(ii)
6206 c write (iout,*) nn," contacts to processor",iproc,
6207 c & " of CONT_TO_COMM group"
6210 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6211 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6212 c write (iout,*) "ireq,req",ireq,req(ireq)
6214 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6218 c write (iout,*) "number of requests (contacts)",ireq
6219 c write (iout,*) "req",(req(i),i=1,4)
6222 & call MPI_Waitall(ireq,req,status_array,ierr)
6223 do iii=1,ntask_cont_from
6224 iproc=itask_cont_from(iii)
6227 write (iout,*) "Received",nn," contacts from processor",iproc,
6228 & " of CONT_FROM_COMM group"
6231 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6236 ii=zapas_recv(1,i,iii)
6237 c Flag the received contacts to prevent double-counting
6238 jj=-zapas_recv(2,i,iii)
6239 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6241 nnn=num_cont_hb(ii)+1
6244 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6245 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6246 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6247 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6248 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6249 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6250 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6251 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6252 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6253 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6254 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6255 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6256 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6257 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6258 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6259 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6260 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6261 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6262 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6263 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6264 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6265 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6266 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6267 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6272 write (iout,'(a)') 'Contact function values after receive:'
6274 write (iout,'(2i3,50(1x,i3,f5.2))')
6275 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6276 & j=1,num_cont_hb(i))
6283 write (iout,'(a)') 'Contact function values:'
6285 write (iout,'(2i3,50(1x,i3,f5.2))')
6286 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6287 & j=1,num_cont_hb(i))
6291 C Remove the loop below after debugging !!!
6298 C Calculate the local-electrostatic correlation terms
6299 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6301 num_conti=num_cont_hb(i)
6302 num_conti1=num_cont_hb(i+1)
6309 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6310 c & ' jj=',jj,' kk=',kk
6311 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6312 & .or. j.lt.0 .and. j1.gt.0) .and.
6313 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6314 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6315 C The system gains extra energy.
6316 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6317 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6318 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6320 else if (j1.eq.j) then
6321 C Contacts I-J and I-(J+1) occur simultaneously.
6322 C The system loses extra energy.
6323 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6328 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6329 c & ' jj=',jj,' kk=',kk
6331 C Contacts I-J and (I+1)-J occur simultaneously.
6332 C The system loses extra energy.
6333 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6340 c------------------------------------------------------------------------------
6341 subroutine add_hb_contact(ii,jj,itask)
6342 implicit real*8 (a-h,o-z)
6343 include "DIMENSIONS"
6344 include "COMMON.IOUNITS"
6347 parameter (max_cont=maxconts)
6348 parameter (max_dim=26)
6349 include "COMMON.CONTACTS"
6351 include 'COMMON.CONTACTS.MOMENT'
6353 double precision zapas(max_dim,maxconts,max_fg_procs),
6354 & zapas_recv(max_dim,maxconts,max_fg_procs)
6355 common /przechowalnia/ zapas
6356 integer i,j,ii,jj,iproc,itask(4),nn
6357 c write (iout,*) "itask",itask
6360 if (iproc.gt.0) then
6361 do j=1,num_cont_hb(ii)
6363 c write (iout,*) "i",ii," j",jj," jjc",jjc
6365 ncont_sent(iproc)=ncont_sent(iproc)+1
6366 nn=ncont_sent(iproc)
6367 zapas(1,nn,iproc)=ii
6368 zapas(2,nn,iproc)=jjc
6369 zapas(3,nn,iproc)=facont_hb(j,ii)
6370 zapas(4,nn,iproc)=ees0p(j,ii)
6371 zapas(5,nn,iproc)=ees0m(j,ii)
6372 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6373 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6374 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6375 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6376 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6377 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6378 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6379 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6380 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6381 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6382 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6383 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6384 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6385 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6386 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6387 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6388 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6389 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6390 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6391 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6392 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6400 c------------------------------------------------------------------------------
6401 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6403 C This subroutine calculates multi-body contributions to hydrogen-bonding
6404 implicit real*8 (a-h,o-z)
6405 include 'DIMENSIONS'
6406 include 'COMMON.IOUNITS'
6409 parameter (max_cont=maxconts)
6410 parameter (max_dim=70)
6411 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6412 double precision zapas(max_dim,maxconts,max_fg_procs),
6413 & zapas_recv(max_dim,maxconts,max_fg_procs)
6414 common /przechowalnia/ zapas
6415 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6416 & status_array(MPI_STATUS_SIZE,maxconts*2)
6418 include 'COMMON.SETUP'
6419 include 'COMMON.FFIELD'
6420 include 'COMMON.DERIV'
6421 include 'COMMON.LOCAL'
6422 include 'COMMON.INTERACT'
6423 include 'COMMON.CONTACTS'
6425 include 'COMMON.CONTACTS.MOMENT'
6427 include 'COMMON.CHAIN'
6428 include 'COMMON.CONTROL'
6429 double precision gx(3),gx1(3)
6430 integer num_cont_hb_old(maxres)
6432 double precision eello4,eello5,eelo6,eello_turn6
6433 external eello4,eello5,eello6,eello_turn6
6434 C Set lprn=.true. for debugging
6439 num_cont_hb_old(i)=num_cont_hb(i)
6443 if (nfgtasks.le.1) goto 30
6445 write (iout,'(a)') 'Contact function values before RECEIVE:'
6447 write (iout,'(2i3,50(1x,i2,f5.2))')
6448 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6449 & j=1,num_cont_hb(i))
6453 do i=1,ntask_cont_from
6456 do i=1,ntask_cont_to
6459 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6461 C Make the list of contacts to send to send to other procesors
6462 do i=iturn3_start,iturn3_end
6463 c write (iout,*) "make contact list turn3",i," num_cont",
6465 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6467 do i=iturn4_start,iturn4_end
6468 c write (iout,*) "make contact list turn4",i," num_cont",
6470 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6474 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6476 do j=1,num_cont_hb(i)
6479 iproc=iint_sent_local(k,jjc,ii)
6480 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6481 if (iproc.ne.0) then
6482 ncont_sent(iproc)=ncont_sent(iproc)+1
6483 nn=ncont_sent(iproc)
6485 zapas(2,nn,iproc)=jjc
6486 zapas(3,nn,iproc)=d_cont(j,i)
6490 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6495 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6503 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6514 & "Numbers of contacts to be sent to other processors",
6515 & (ncont_sent(i),i=1,ntask_cont_to)
6516 write (iout,*) "Contacts sent"
6517 do ii=1,ntask_cont_to
6519 iproc=itask_cont_to(ii)
6520 write (iout,*) nn," contacts to processor",iproc,
6521 & " of CONT_TO_COMM group"
6523 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6531 CorrelID1=nfgtasks+fg_rank+1
6533 C Receive the numbers of needed contacts from other processors
6534 do ii=1,ntask_cont_from
6535 iproc=itask_cont_from(ii)
6537 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6538 & FG_COMM,req(ireq),IERR)
6540 c write (iout,*) "IRECV ended"
6542 C Send the number of contacts needed by other processors
6543 do ii=1,ntask_cont_to
6544 iproc=itask_cont_to(ii)
6546 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6547 & FG_COMM,req(ireq),IERR)
6549 c write (iout,*) "ISEND ended"
6550 c write (iout,*) "number of requests (nn)",ireq
6553 & call MPI_Waitall(ireq,req,status_array,ierr)
6555 c & "Numbers of contacts to be received from other processors",
6556 c & (ncont_recv(i),i=1,ntask_cont_from)
6560 do ii=1,ntask_cont_from
6561 iproc=itask_cont_from(ii)
6563 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6564 c & " of CONT_TO_COMM group"
6568 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6569 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6570 c write (iout,*) "ireq,req",ireq,req(ireq)
6573 C Send the contacts to processors that need them
6574 do ii=1,ntask_cont_to
6575 iproc=itask_cont_to(ii)
6577 c write (iout,*) nn," contacts to processor",iproc,
6578 c & " of CONT_TO_COMM group"
6581 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6582 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6583 c write (iout,*) "ireq,req",ireq,req(ireq)
6585 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6589 c write (iout,*) "number of requests (contacts)",ireq
6590 c write (iout,*) "req",(req(i),i=1,4)
6593 & call MPI_Waitall(ireq,req,status_array,ierr)
6594 do iii=1,ntask_cont_from
6595 iproc=itask_cont_from(iii)
6598 write (iout,*) "Received",nn," contacts from processor",iproc,
6599 & " of CONT_FROM_COMM group"
6602 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6607 ii=zapas_recv(1,i,iii)
6608 c Flag the received contacts to prevent double-counting
6609 jj=-zapas_recv(2,i,iii)
6610 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6612 nnn=num_cont_hb(ii)+1
6615 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6619 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6624 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6632 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6641 write (iout,'(a)') 'Contact function values after receive:'
6643 write (iout,'(2i3,50(1x,i3,5f6.3))')
6644 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6645 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6652 write (iout,'(a)') 'Contact function values:'
6654 write (iout,'(2i3,50(1x,i2,5f6.3))')
6655 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6656 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6662 C Remove the loop below after debugging !!!
6669 C Calculate the dipole-dipole interaction energies
6670 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6671 do i=iatel_s,iatel_e+1
6672 num_conti=num_cont_hb(i)
6681 C Calculate the local-electrostatic correlation terms
6682 c write (iout,*) "gradcorr5 in eello5 before loop"
6684 c write (iout,'(i5,3f10.5)')
6685 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6687 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6688 c write (iout,*) "corr loop i",i
6690 num_conti=num_cont_hb(i)
6691 num_conti1=num_cont_hb(i+1)
6698 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6699 c & ' jj=',jj,' kk=',kk
6700 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6701 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6702 & .or. j.lt.0 .and. j1.gt.0) .and.
6703 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6704 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6705 C The system gains extra energy.
6707 sqd1=dsqrt(d_cont(jj,i))
6708 sqd2=dsqrt(d_cont(kk,i1))
6709 sred_geom = sqd1*sqd2
6710 IF (sred_geom.lt.cutoff_corr) THEN
6711 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6713 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6714 cd & ' jj=',jj,' kk=',kk
6715 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6716 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6718 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6719 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6722 cd write (iout,*) 'sred_geom=',sred_geom,
6723 cd & ' ekont=',ekont,' fprim=',fprimcont,
6724 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6725 cd write (iout,*) "g_contij",g_contij
6726 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6727 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6728 call calc_eello(i,jp,i+1,jp1,jj,kk)
6729 if (wcorr4.gt.0.0d0)
6730 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6731 if (energy_dec.and.wcorr4.gt.0.0d0)
6732 1 write (iout,'(a6,4i5,0pf7.3)')
6733 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6734 c write (iout,*) "gradcorr5 before eello5"
6736 c write (iout,'(i5,3f10.5)')
6737 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6739 if (wcorr5.gt.0.0d0)
6740 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6741 c write (iout,*) "gradcorr5 after eello5"
6743 c write (iout,'(i5,3f10.5)')
6744 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6746 if (energy_dec.and.wcorr5.gt.0.0d0)
6747 1 write (iout,'(a6,4i5,0pf7.3)')
6748 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6749 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6750 cd write(2,*)'ijkl',i,jp,i+1,jp1
6751 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6752 & .or. wturn6.eq.0.0d0))then
6753 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6754 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6755 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6756 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6757 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6758 cd & 'ecorr6=',ecorr6
6759 cd write (iout,'(4e15.5)') sred_geom,
6760 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6761 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6762 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6763 else if (wturn6.gt.0.0d0
6764 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6765 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6766 eturn6=eturn6+eello_turn6(i,jj,kk)
6767 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6768 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6769 cd write (2,*) 'multibody_eello:eturn6',eturn6
6778 num_cont_hb(i)=num_cont_hb_old(i)
6780 c write (iout,*) "gradcorr5 in eello5"
6782 c write (iout,'(i5,3f10.5)')
6783 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6787 c------------------------------------------------------------------------------
6788 subroutine add_hb_contact_eello(ii,jj,itask)
6789 implicit real*8 (a-h,o-z)
6790 include "DIMENSIONS"
6791 include "COMMON.IOUNITS"
6794 parameter (max_cont=maxconts)
6795 parameter (max_dim=70)
6796 include "COMMON.CONTACTS"
6798 include 'COMMON.CONTACTS.MOMENT'
6800 double precision zapas(max_dim,maxconts,max_fg_procs),
6801 & zapas_recv(max_dim,maxconts,max_fg_procs)
6802 common /przechowalnia/ zapas
6803 integer i,j,ii,jj,iproc,itask(4),nn
6804 c write (iout,*) "itask",itask
6807 if (iproc.gt.0) then
6808 do j=1,num_cont_hb(ii)
6810 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6812 ncont_sent(iproc)=ncont_sent(iproc)+1
6813 nn=ncont_sent(iproc)
6814 zapas(1,nn,iproc)=ii
6815 zapas(2,nn,iproc)=jjc
6816 zapas(3,nn,iproc)=d_cont(j,ii)
6820 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6825 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6833 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6845 c------------------------------------------------------------------------------
6846 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6847 implicit real*8 (a-h,o-z)
6848 include 'DIMENSIONS'
6849 include 'COMMON.IOUNITS'
6850 include 'COMMON.DERIV'
6851 include 'COMMON.INTERACT'
6852 include 'COMMON.CONTACTS'
6854 include 'COMMON.CONTACTS.MOMENT'
6856 double precision gx(3),gx1(3)
6866 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6867 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6868 C Following 4 lines for diagnostics.
6873 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6874 c & 'Contacts ',i,j,
6875 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6876 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6878 C Calculate the multi-body contribution to energy.
6879 c ecorr=ecorr+ekont*ees
6880 C Calculate multi-body contributions to the gradient.
6881 coeffpees0pij=coeffp*ees0pij
6882 coeffmees0mij=coeffm*ees0mij
6883 coeffpees0pkl=coeffp*ees0pkl
6884 coeffmees0mkl=coeffm*ees0mkl
6886 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6887 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6888 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6889 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6890 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6891 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6892 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6893 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6894 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6895 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6896 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6897 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6898 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6899 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6900 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6901 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6902 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6903 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6904 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6905 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6906 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6907 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6908 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6909 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6910 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6915 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6916 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6917 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6918 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6923 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6924 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6925 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6926 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6929 c write (iout,*) "ehbcorr",ekont*ees
6934 C---------------------------------------------------------------------------
6935 subroutine dipole(i,j,jj)
6936 implicit real*8 (a-h,o-z)
6937 include 'DIMENSIONS'
6938 include 'COMMON.IOUNITS'
6939 include 'COMMON.CHAIN'
6940 include 'COMMON.FFIELD'
6941 include 'COMMON.DERIV'
6942 include 'COMMON.INTERACT'
6943 include 'COMMON.CONTACTS'
6945 include 'COMMON.CONTACTS.MOMENT'
6947 include 'COMMON.TORSION'
6948 include 'COMMON.VAR'
6949 include 'COMMON.GEO'
6950 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6952 iti1 = itortyp(itype(i+1))
6953 if (j.lt.nres-1) then
6954 itj1 = itortyp(itype(j+1))
6959 dipi(iii,1)=Ub2(iii,i)
6960 dipderi(iii)=Ub2der(iii,i)
6961 dipi(iii,2)=b1(iii,iti1)
6962 dipj(iii,1)=Ub2(iii,j)
6963 dipderj(iii)=Ub2der(iii,j)
6964 dipj(iii,2)=b1(iii,itj1)
6968 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6971 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6978 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6982 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6987 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6988 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6990 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6992 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6994 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6999 C---------------------------------------------------------------------------
7000 subroutine calc_eello(i,j,k,l,jj,kk)
7002 C This subroutine computes matrices and vectors needed to calculate
7003 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7005 implicit real*8 (a-h,o-z)
7006 include 'DIMENSIONS'
7007 include 'COMMON.IOUNITS'
7008 include 'COMMON.CHAIN'
7009 include 'COMMON.DERIV'
7010 include 'COMMON.INTERACT'
7011 include 'COMMON.CONTACTS'
7013 include 'COMMON.CONTACTS.MOMENT'
7015 include 'COMMON.TORSION'
7016 include 'COMMON.VAR'
7017 include 'COMMON.GEO'
7018 include 'COMMON.FFIELD'
7019 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7020 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7023 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7024 cd & ' jj=',jj,' kk=',kk
7025 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7026 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7027 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7030 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7031 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7034 call transpose2(aa1(1,1),aa1t(1,1))
7035 call transpose2(aa2(1,1),aa2t(1,1))
7038 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7039 & aa1tder(1,1,lll,kkk))
7040 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7041 & aa2tder(1,1,lll,kkk))
7045 C parallel orientation of the two CA-CA-CA frames.
7047 iti=itortyp(itype(i))
7051 itk1=itortyp(itype(k+1))
7052 itj=itortyp(itype(j))
7053 if (l.lt.nres-1) then
7054 itl1=itortyp(itype(l+1))
7058 C A1 kernel(j+1) A2T
7060 cd write (iout,'(3f10.5,5x,3f10.5)')
7061 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7063 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7064 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7065 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7066 C Following matrices are needed only for 6-th order cumulants
7067 IF (wcorr6.gt.0.0d0) THEN
7068 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7069 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7070 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7071 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7072 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7073 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7074 & ADtEAderx(1,1,1,1,1,1))
7076 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7077 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7078 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7079 & ADtEA1derx(1,1,1,1,1,1))
7081 C End 6-th order cumulants
7084 cd write (2,*) 'In calc_eello6'
7086 cd write (2,*) 'iii=',iii
7088 cd write (2,*) 'kkk=',kkk
7090 cd write (2,'(3(2f10.5),5x)')
7091 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7096 call transpose2(EUgder(1,1,k),auxmat(1,1))
7097 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7098 call transpose2(EUg(1,1,k),auxmat(1,1))
7099 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7100 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7104 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7105 & EAEAderx(1,1,lll,kkk,iii,1))
7109 C A1T kernel(i+1) A2
7110 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7111 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7112 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7113 C Following matrices are needed only for 6-th order cumulants
7114 IF (wcorr6.gt.0.0d0) THEN
7115 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7116 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7117 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7118 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7119 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7120 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7121 & ADtEAderx(1,1,1,1,1,2))
7122 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7123 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7124 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7125 & ADtEA1derx(1,1,1,1,1,2))
7127 C End 6-th order cumulants
7128 call transpose2(EUgder(1,1,l),auxmat(1,1))
7129 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7130 call transpose2(EUg(1,1,l),auxmat(1,1))
7131 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7132 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7136 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7137 & EAEAderx(1,1,lll,kkk,iii,2))
7142 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7143 C They are needed only when the fifth- or the sixth-order cumulants are
7145 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7146 call transpose2(AEA(1,1,1),auxmat(1,1))
7147 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7148 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7149 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7150 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7151 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7152 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7153 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7154 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7155 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7156 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7157 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7158 call transpose2(AEA(1,1,2),auxmat(1,1))
7159 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7160 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7161 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7162 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7163 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7164 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7165 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7166 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7167 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7168 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7169 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7170 C Calculate the Cartesian derivatives of the vectors.
7174 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7175 call matvec2(auxmat(1,1),b1(1,iti),
7176 & AEAb1derx(1,lll,kkk,iii,1,1))
7177 call matvec2(auxmat(1,1),Ub2(1,i),
7178 & AEAb2derx(1,lll,kkk,iii,1,1))
7179 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7180 & AEAb1derx(1,lll,kkk,iii,2,1))
7181 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7182 & AEAb2derx(1,lll,kkk,iii,2,1))
7183 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7184 call matvec2(auxmat(1,1),b1(1,itj),
7185 & AEAb1derx(1,lll,kkk,iii,1,2))
7186 call matvec2(auxmat(1,1),Ub2(1,j),
7187 & AEAb2derx(1,lll,kkk,iii,1,2))
7188 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7189 & AEAb1derx(1,lll,kkk,iii,2,2))
7190 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7191 & AEAb2derx(1,lll,kkk,iii,2,2))
7198 C Antiparallel orientation of the two CA-CA-CA frames.
7200 iti=itortyp(itype(i))
7204 itk1=itortyp(itype(k+1))
7205 itl=itortyp(itype(l))
7206 itj=itortyp(itype(j))
7207 if (j.lt.nres-1) then
7208 itj1=itortyp(itype(j+1))
7212 C A2 kernel(j-1)T A1T
7213 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7214 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7215 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7216 C Following matrices are needed only for 6-th order cumulants
7217 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7218 & j.eq.i+4 .and. l.eq.i+3)) THEN
7219 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7220 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7221 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7222 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7223 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7224 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7225 & ADtEAderx(1,1,1,1,1,1))
7226 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7227 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7228 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7229 & ADtEA1derx(1,1,1,1,1,1))
7231 C End 6-th order cumulants
7232 call transpose2(EUgder(1,1,k),auxmat(1,1))
7233 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7234 call transpose2(EUg(1,1,k),auxmat(1,1))
7235 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7236 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7240 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7241 & EAEAderx(1,1,lll,kkk,iii,1))
7245 C A2T kernel(i+1)T A1
7246 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7247 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7248 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7249 C Following matrices are needed only for 6-th order cumulants
7250 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7251 & j.eq.i+4 .and. l.eq.i+3)) THEN
7252 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7253 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7254 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7255 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7256 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7257 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7258 & ADtEAderx(1,1,1,1,1,2))
7259 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7260 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7261 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7262 & ADtEA1derx(1,1,1,1,1,2))
7264 C End 6-th order cumulants
7265 call transpose2(EUgder(1,1,j),auxmat(1,1))
7266 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7267 call transpose2(EUg(1,1,j),auxmat(1,1))
7268 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7269 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7273 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7274 & EAEAderx(1,1,lll,kkk,iii,2))
7279 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7280 C They are needed only when the fifth- or the sixth-order cumulants are
7282 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7283 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7284 call transpose2(AEA(1,1,1),auxmat(1,1))
7285 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7286 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7287 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7288 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7289 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7290 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7291 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7292 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7293 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7294 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7295 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7296 call transpose2(AEA(1,1,2),auxmat(1,1))
7297 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7298 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7299 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7300 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7301 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7302 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7303 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7304 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7305 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7306 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7307 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7308 C Calculate the Cartesian derivatives of the vectors.
7312 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7313 call matvec2(auxmat(1,1),b1(1,iti),
7314 & AEAb1derx(1,lll,kkk,iii,1,1))
7315 call matvec2(auxmat(1,1),Ub2(1,i),
7316 & AEAb2derx(1,lll,kkk,iii,1,1))
7317 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7318 & AEAb1derx(1,lll,kkk,iii,2,1))
7319 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7320 & AEAb2derx(1,lll,kkk,iii,2,1))
7321 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7322 call matvec2(auxmat(1,1),b1(1,itl),
7323 & AEAb1derx(1,lll,kkk,iii,1,2))
7324 call matvec2(auxmat(1,1),Ub2(1,l),
7325 & AEAb2derx(1,lll,kkk,iii,1,2))
7326 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7327 & AEAb1derx(1,lll,kkk,iii,2,2))
7328 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7329 & AEAb2derx(1,lll,kkk,iii,2,2))
7338 C---------------------------------------------------------------------------
7339 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7340 & KK,KKderg,AKA,AKAderg,AKAderx)
7344 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7345 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7346 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7351 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7353 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7356 cd if (lprn) write (2,*) 'In kernel'
7358 cd if (lprn) write (2,*) 'kkk=',kkk
7360 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7361 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7363 cd write (2,*) 'lll=',lll
7364 cd write (2,*) 'iii=1'
7366 cd write (2,'(3(2f10.5),5x)')
7367 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7370 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7371 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7373 cd write (2,*) 'lll=',lll
7374 cd write (2,*) 'iii=2'
7376 cd write (2,'(3(2f10.5),5x)')
7377 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7384 C---------------------------------------------------------------------------
7385 double precision function eello4(i,j,k,l,jj,kk)
7386 implicit real*8 (a-h,o-z)
7387 include 'DIMENSIONS'
7388 include 'COMMON.IOUNITS'
7389 include 'COMMON.CHAIN'
7390 include 'COMMON.DERIV'
7391 include 'COMMON.INTERACT'
7392 include 'COMMON.CONTACTS'
7394 include 'COMMON.CONTACTS.MOMENT'
7396 include 'COMMON.TORSION'
7397 include 'COMMON.VAR'
7398 include 'COMMON.GEO'
7399 double precision pizda(2,2),ggg1(3),ggg2(3)
7400 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7404 cd print *,'eello4:',i,j,k,l,jj,kk
7405 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7406 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7407 cold eij=facont_hb(jj,i)
7408 cold ekl=facont_hb(kk,k)
7410 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7411 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7412 gcorr_loc(k-1)=gcorr_loc(k-1)
7413 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7415 gcorr_loc(l-1)=gcorr_loc(l-1)
7416 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7418 gcorr_loc(j-1)=gcorr_loc(j-1)
7419 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7424 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7425 & -EAEAderx(2,2,lll,kkk,iii,1)
7426 cd derx(lll,kkk,iii)=0.0d0
7430 cd gcorr_loc(l-1)=0.0d0
7431 cd gcorr_loc(j-1)=0.0d0
7432 cd gcorr_loc(k-1)=0.0d0
7434 cd write (iout,*)'Contacts have occurred for peptide groups',
7435 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7436 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7437 if (j.lt.nres-1) then
7444 if (l.lt.nres-1) then
7452 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7453 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7454 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7455 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7456 cgrad ghalf=0.5d0*ggg1(ll)
7457 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7458 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7459 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7460 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7461 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7462 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7463 cgrad ghalf=0.5d0*ggg2(ll)
7464 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7465 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7466 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7467 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7468 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7469 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7473 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7478 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7483 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7488 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7492 cd write (2,*) iii,gcorr_loc(iii)
7495 cd write (2,*) 'ekont',ekont
7496 cd write (iout,*) 'eello4',ekont*eel4
7499 C---------------------------------------------------------------------------
7500 double precision function eello5(i,j,k,l,jj,kk)
7501 implicit real*8 (a-h,o-z)
7502 include 'DIMENSIONS'
7503 include 'COMMON.IOUNITS'
7504 include 'COMMON.CHAIN'
7505 include 'COMMON.DERIV'
7506 include 'COMMON.INTERACT'
7507 include 'COMMON.CONTACTS'
7509 include 'COMMON.CONTACTS.MOMENT'
7511 include 'COMMON.TORSION'
7512 include 'COMMON.VAR'
7513 include 'COMMON.GEO'
7514 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7515 double precision ggg1(3),ggg2(3)
7516 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7521 C /l\ / \ \ / \ / \ / C
7522 C / \ / \ \ / \ / \ / C
7523 C j| o |l1 | o | o| o | | o |o C
7524 C \ |/k\| |/ \| / |/ \| |/ \| C
7525 C \i/ \ / \ / / \ / \ C
7527 C (I) (II) (III) (IV) C
7529 C eello5_1 eello5_2 eello5_3 eello5_4 C
7531 C Antiparallel chains C
7534 C /j\ / \ \ / \ / \ / C
7535 C / \ / \ \ / \ / \ / C
7536 C j1| o |l | o | o| o | | o |o C
7537 C \ |/k\| |/ \| / |/ \| |/ \| C
7538 C \i/ \ / \ / / \ / \ C
7540 C (I) (II) (III) (IV) C
7542 C eello5_1 eello5_2 eello5_3 eello5_4 C
7544 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7546 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7547 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7552 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7554 itk=itortyp(itype(k))
7555 itl=itortyp(itype(l))
7556 itj=itortyp(itype(j))
7561 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7562 cd & eel5_3_num,eel5_4_num)
7566 derx(lll,kkk,iii)=0.0d0
7570 cd eij=facont_hb(jj,i)
7571 cd ekl=facont_hb(kk,k)
7573 cd write (iout,*)'Contacts have occurred for peptide groups',
7574 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7576 C Contribution from the graph I.
7577 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7578 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7579 call transpose2(EUg(1,1,k),auxmat(1,1))
7580 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7581 vv(1)=pizda(1,1)-pizda(2,2)
7582 vv(2)=pizda(1,2)+pizda(2,1)
7583 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7584 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7585 C Explicit gradient in virtual-dihedral angles.
7586 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7587 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7588 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7589 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7590 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7591 vv(1)=pizda(1,1)-pizda(2,2)
7592 vv(2)=pizda(1,2)+pizda(2,1)
7593 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7594 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7595 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7596 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7597 vv(1)=pizda(1,1)-pizda(2,2)
7598 vv(2)=pizda(1,2)+pizda(2,1)
7600 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7601 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7602 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7604 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7605 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7606 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7608 C Cartesian gradient
7612 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7614 vv(1)=pizda(1,1)-pizda(2,2)
7615 vv(2)=pizda(1,2)+pizda(2,1)
7616 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7617 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7618 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7624 C Contribution from graph II
7625 call transpose2(EE(1,1,itk),auxmat(1,1))
7626 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7627 vv(1)=pizda(1,1)+pizda(2,2)
7628 vv(2)=pizda(2,1)-pizda(1,2)
7629 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7630 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7631 C Explicit gradient in virtual-dihedral angles.
7632 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7633 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7634 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7635 vv(1)=pizda(1,1)+pizda(2,2)
7636 vv(2)=pizda(2,1)-pizda(1,2)
7638 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7639 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7640 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7642 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7643 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7644 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7646 C Cartesian gradient
7650 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7652 vv(1)=pizda(1,1)+pizda(2,2)
7653 vv(2)=pizda(2,1)-pizda(1,2)
7654 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7655 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7656 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7664 C Parallel orientation
7665 C Contribution from graph III
7666 call transpose2(EUg(1,1,l),auxmat(1,1))
7667 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7668 vv(1)=pizda(1,1)-pizda(2,2)
7669 vv(2)=pizda(1,2)+pizda(2,1)
7670 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7671 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7672 C Explicit gradient in virtual-dihedral angles.
7673 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7674 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7675 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7676 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7677 vv(1)=pizda(1,1)-pizda(2,2)
7678 vv(2)=pizda(1,2)+pizda(2,1)
7679 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7680 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7681 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7682 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7683 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7684 vv(1)=pizda(1,1)-pizda(2,2)
7685 vv(2)=pizda(1,2)+pizda(2,1)
7686 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7687 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7688 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7689 C Cartesian gradient
7693 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7695 vv(1)=pizda(1,1)-pizda(2,2)
7696 vv(2)=pizda(1,2)+pizda(2,1)
7697 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7698 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7699 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7704 C Contribution from graph IV
7706 call transpose2(EE(1,1,itl),auxmat(1,1))
7707 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7708 vv(1)=pizda(1,1)+pizda(2,2)
7709 vv(2)=pizda(2,1)-pizda(1,2)
7710 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7711 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7712 C Explicit gradient in virtual-dihedral angles.
7713 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7714 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7715 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7716 vv(1)=pizda(1,1)+pizda(2,2)
7717 vv(2)=pizda(2,1)-pizda(1,2)
7718 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7719 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7720 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7721 C Cartesian gradient
7725 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7727 vv(1)=pizda(1,1)+pizda(2,2)
7728 vv(2)=pizda(2,1)-pizda(1,2)
7729 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7730 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7731 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7736 C Antiparallel orientation
7737 C Contribution from graph III
7739 call transpose2(EUg(1,1,j),auxmat(1,1))
7740 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7741 vv(1)=pizda(1,1)-pizda(2,2)
7742 vv(2)=pizda(1,2)+pizda(2,1)
7743 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7744 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7745 C Explicit gradient in virtual-dihedral angles.
7746 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7747 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7748 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7749 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7750 vv(1)=pizda(1,1)-pizda(2,2)
7751 vv(2)=pizda(1,2)+pizda(2,1)
7752 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7753 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7754 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7755 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7756 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7757 vv(1)=pizda(1,1)-pizda(2,2)
7758 vv(2)=pizda(1,2)+pizda(2,1)
7759 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7760 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7761 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7762 C Cartesian gradient
7766 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7768 vv(1)=pizda(1,1)-pizda(2,2)
7769 vv(2)=pizda(1,2)+pizda(2,1)
7770 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7771 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7772 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7777 C Contribution from graph IV
7779 call transpose2(EE(1,1,itj),auxmat(1,1))
7780 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7781 vv(1)=pizda(1,1)+pizda(2,2)
7782 vv(2)=pizda(2,1)-pizda(1,2)
7783 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7784 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7785 C Explicit gradient in virtual-dihedral angles.
7786 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7787 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7788 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7789 vv(1)=pizda(1,1)+pizda(2,2)
7790 vv(2)=pizda(2,1)-pizda(1,2)
7791 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7792 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7793 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7794 C Cartesian gradient
7798 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7800 vv(1)=pizda(1,1)+pizda(2,2)
7801 vv(2)=pizda(2,1)-pizda(1,2)
7802 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7803 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7804 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7810 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7811 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7812 cd write (2,*) 'ijkl',i,j,k,l
7813 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7814 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7816 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7817 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7818 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7819 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7820 if (j.lt.nres-1) then
7827 if (l.lt.nres-1) then
7837 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7838 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7839 C summed up outside the subrouine as for the other subroutines
7840 C handling long-range interactions. The old code is commented out
7841 C with "cgrad" to keep track of changes.
7843 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7844 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7845 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7846 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7847 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7848 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7849 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7850 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7851 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7852 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7854 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7855 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7856 cgrad ghalf=0.5d0*ggg1(ll)
7858 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7859 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7860 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7861 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7862 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7863 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7864 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7865 cgrad ghalf=0.5d0*ggg2(ll)
7867 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7868 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7869 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7870 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7871 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7872 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7877 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7878 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7883 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7884 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7890 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7895 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7899 cd write (2,*) iii,g_corr5_loc(iii)
7902 cd write (2,*) 'ekont',ekont
7903 cd write (iout,*) 'eello5',ekont*eel5
7906 c--------------------------------------------------------------------------
7907 double precision function eello6(i,j,k,l,jj,kk)
7908 implicit real*8 (a-h,o-z)
7909 include 'DIMENSIONS'
7910 include 'COMMON.IOUNITS'
7911 include 'COMMON.CHAIN'
7912 include 'COMMON.DERIV'
7913 include 'COMMON.INTERACT'
7914 include 'COMMON.CONTACTS'
7916 include 'COMMON.CONTACTS.MOMENT'
7918 include 'COMMON.TORSION'
7919 include 'COMMON.VAR'
7920 include 'COMMON.GEO'
7921 include 'COMMON.FFIELD'
7922 double precision ggg1(3),ggg2(3)
7923 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7928 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7936 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7937 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7941 derx(lll,kkk,iii)=0.0d0
7945 cd eij=facont_hb(jj,i)
7946 cd ekl=facont_hb(kk,k)
7952 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7953 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7954 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7955 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7956 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7957 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7959 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7960 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7961 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7962 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7963 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7964 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7968 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7970 C If turn contributions are considered, they will be handled separately.
7971 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7972 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7973 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7974 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7975 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7976 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7977 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7979 if (j.lt.nres-1) then
7986 if (l.lt.nres-1) then
7994 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7995 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7996 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7997 cgrad ghalf=0.5d0*ggg1(ll)
7999 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8000 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8001 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8002 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8003 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8004 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8005 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8006 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8007 cgrad ghalf=0.5d0*ggg2(ll)
8008 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8010 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8011 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8012 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8013 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8014 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8015 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8020 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8021 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8026 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8027 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8033 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8038 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8042 cd write (2,*) iii,g_corr6_loc(iii)
8045 cd write (2,*) 'ekont',ekont
8046 cd write (iout,*) 'eello6',ekont*eel6
8049 c--------------------------------------------------------------------------
8050 double precision function eello6_graph1(i,j,k,l,imat,swap)
8051 implicit real*8 (a-h,o-z)
8052 include 'DIMENSIONS'
8053 include 'COMMON.IOUNITS'
8054 include 'COMMON.CHAIN'
8055 include 'COMMON.DERIV'
8056 include 'COMMON.INTERACT'
8057 include 'COMMON.CONTACTS'
8059 include 'COMMON.CONTACTS.MOMENT'
8061 include 'COMMON.TORSION'
8062 include 'COMMON.VAR'
8063 include 'COMMON.GEO'
8064 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8068 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8070 C Parallel Antiparallel C
8076 C \ j|/k\| / \ |/k\|l / C
8081 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8082 itk=itortyp(itype(k))
8083 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8084 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8085 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8086 call transpose2(EUgC(1,1,k),auxmat(1,1))
8087 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8088 vv1(1)=pizda1(1,1)-pizda1(2,2)
8089 vv1(2)=pizda1(1,2)+pizda1(2,1)
8090 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8091 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8092 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8093 s5=scalar2(vv(1),Dtobr2(1,i))
8094 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8095 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8096 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8097 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8098 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8099 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8100 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8101 & +scalar2(vv(1),Dtobr2der(1,i)))
8102 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8103 vv1(1)=pizda1(1,1)-pizda1(2,2)
8104 vv1(2)=pizda1(1,2)+pizda1(2,1)
8105 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8106 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8108 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8109 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8110 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8111 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8112 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8114 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8115 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8116 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8117 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8118 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8120 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8121 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8122 vv1(1)=pizda1(1,1)-pizda1(2,2)
8123 vv1(2)=pizda1(1,2)+pizda1(2,1)
8124 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8125 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8126 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8127 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8136 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8137 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8138 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8139 call transpose2(EUgC(1,1,k),auxmat(1,1))
8140 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8142 vv1(1)=pizda1(1,1)-pizda1(2,2)
8143 vv1(2)=pizda1(1,2)+pizda1(2,1)
8144 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8145 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8146 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8147 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8148 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8149 s5=scalar2(vv(1),Dtobr2(1,i))
8150 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8156 c----------------------------------------------------------------------------
8157 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8158 implicit real*8 (a-h,o-z)
8159 include 'DIMENSIONS'
8160 include 'COMMON.IOUNITS'
8161 include 'COMMON.CHAIN'
8162 include 'COMMON.DERIV'
8163 include 'COMMON.INTERACT'
8164 include 'COMMON.CONTACTS'
8166 include 'COMMON.CONTACTS.MOMENT'
8168 include 'COMMON.TORSION'
8169 include 'COMMON.VAR'
8170 include 'COMMON.GEO'
8172 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8173 & auxvec1(2),auxvec2(1),auxmat1(2,2)
8176 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8178 C Parallel Antiparallel C
8184 C \ j|/k\| \ |/k\|l C
8189 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8190 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8191 C AL 7/4/01 s1 would occur in the sixth-order moment,
8192 C but not in a cluster cumulant
8194 s1=dip(1,jj,i)*dip(1,kk,k)
8196 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8197 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8198 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8199 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8200 call transpose2(EUg(1,1,k),auxmat(1,1))
8201 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8202 vv(1)=pizda(1,1)-pizda(2,2)
8203 vv(2)=pizda(1,2)+pizda(2,1)
8204 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8205 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8207 eello6_graph2=-(s1+s2+s3+s4)
8209 eello6_graph2=-(s2+s3+s4)
8212 C Derivatives in gamma(i-1)
8215 s1=dipderg(1,jj,i)*dip(1,kk,k)
8217 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8218 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8219 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8220 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8222 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8224 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8226 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8228 C Derivatives in gamma(k-1)
8230 s1=dip(1,jj,i)*dipderg(1,kk,k)
8232 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8233 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8234 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8235 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8236 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8237 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8238 vv(1)=pizda(1,1)-pizda(2,2)
8239 vv(2)=pizda(1,2)+pizda(2,1)
8240 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8242 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8244 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8246 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8247 C Derivatives in gamma(j-1) or gamma(l-1)
8250 s1=dipderg(3,jj,i)*dip(1,kk,k)
8252 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8253 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8254 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8255 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8256 vv(1)=pizda(1,1)-pizda(2,2)
8257 vv(2)=pizda(1,2)+pizda(2,1)
8258 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8261 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8263 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8266 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8267 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8269 C Derivatives in gamma(l-1) or gamma(j-1)
8272 s1=dip(1,jj,i)*dipderg(3,kk,k)
8274 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8275 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8276 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8277 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8278 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8279 vv(1)=pizda(1,1)-pizda(2,2)
8280 vv(2)=pizda(1,2)+pizda(2,1)
8281 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8284 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8286 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8289 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8290 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8292 C Cartesian derivatives.
8294 write (2,*) 'In eello6_graph2'
8296 write (2,*) 'iii=',iii
8298 write (2,*) 'kkk=',kkk
8300 write (2,'(3(2f10.5),5x)')
8301 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8311 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8313 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8316 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8318 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8319 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8321 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8322 call transpose2(EUg(1,1,k),auxmat(1,1))
8323 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8325 vv(1)=pizda(1,1)-pizda(2,2)
8326 vv(2)=pizda(1,2)+pizda(2,1)
8327 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8328 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8330 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8332 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8335 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8337 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8344 c----------------------------------------------------------------------------
8345 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8346 implicit real*8 (a-h,o-z)
8347 include 'DIMENSIONS'
8348 include 'COMMON.IOUNITS'
8349 include 'COMMON.CHAIN'
8350 include 'COMMON.DERIV'
8351 include 'COMMON.INTERACT'
8352 include 'COMMON.CONTACTS'
8354 include 'COMMON.CONTACTS.MOMENT'
8356 include 'COMMON.TORSION'
8357 include 'COMMON.VAR'
8358 include 'COMMON.GEO'
8359 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8361 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8363 C Parallel Antiparallel C
8369 C j|/k\| / |/k\|l / C
8374 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8376 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8377 C energy moment and not to the cluster cumulant.
8378 iti=itortyp(itype(i))
8379 if (j.lt.nres-1) then
8380 itj1=itortyp(itype(j+1))
8384 itk=itortyp(itype(k))
8385 itk1=itortyp(itype(k+1))
8386 if (l.lt.nres-1) then
8387 itl1=itortyp(itype(l+1))
8392 s1=dip(4,jj,i)*dip(4,kk,k)
8394 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8395 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8396 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8397 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8398 call transpose2(EE(1,1,itk),auxmat(1,1))
8399 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8400 vv(1)=pizda(1,1)+pizda(2,2)
8401 vv(2)=pizda(2,1)-pizda(1,2)
8402 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8403 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8404 cd & "sum",-(s2+s3+s4)
8406 eello6_graph3=-(s1+s2+s3+s4)
8408 eello6_graph3=-(s2+s3+s4)
8411 C Derivatives in gamma(k-1)
8412 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8413 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8414 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8415 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8416 C Derivatives in gamma(l-1)
8417 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8418 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8419 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8420 vv(1)=pizda(1,1)+pizda(2,2)
8421 vv(2)=pizda(2,1)-pizda(1,2)
8422 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8423 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8424 C Cartesian derivatives.
8430 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8432 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8435 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8437 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8438 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8440 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8441 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8443 vv(1)=pizda(1,1)+pizda(2,2)
8444 vv(2)=pizda(2,1)-pizda(1,2)
8445 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8447 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8449 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8452 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8454 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8456 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8462 c----------------------------------------------------------------------------
8463 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8464 implicit real*8 (a-h,o-z)
8465 include 'DIMENSIONS'
8466 include 'COMMON.IOUNITS'
8467 include 'COMMON.CHAIN'
8468 include 'COMMON.DERIV'
8469 include 'COMMON.INTERACT'
8470 include 'COMMON.CONTACTS'
8472 include 'COMMON.CONTACTS.MOMENT'
8474 include 'COMMON.TORSION'
8475 include 'COMMON.VAR'
8476 include 'COMMON.GEO'
8477 include 'COMMON.FFIELD'
8478 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8479 & auxvec1(2),auxmat1(2,2)
8481 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8483 C Parallel Antiparallel C
8489 C \ j|/k\| \ |/k\|l C
8494 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8496 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8497 C energy moment and not to the cluster cumulant.
8498 cd write (2,*) 'eello_graph4: wturn6',wturn6
8499 iti=itortyp(itype(i))
8500 itj=itortyp(itype(j))
8501 if (j.lt.nres-1) then
8502 itj1=itortyp(itype(j+1))
8506 itk=itortyp(itype(k))
8507 if (k.lt.nres-1) then
8508 itk1=itortyp(itype(k+1))
8512 itl=itortyp(itype(l))
8513 if (l.lt.nres-1) then
8514 itl1=itortyp(itype(l+1))
8518 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8519 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8520 cd & ' itl',itl,' itl1',itl1
8523 s1=dip(3,jj,i)*dip(3,kk,k)
8525 s1=dip(2,jj,j)*dip(2,kk,l)
8528 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8529 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8531 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8532 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8534 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8535 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8537 call transpose2(EUg(1,1,k),auxmat(1,1))
8538 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8539 vv(1)=pizda(1,1)-pizda(2,2)
8540 vv(2)=pizda(2,1)+pizda(1,2)
8541 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8542 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8544 eello6_graph4=-(s1+s2+s3+s4)
8546 eello6_graph4=-(s2+s3+s4)
8548 C Derivatives in gamma(i-1)
8552 s1=dipderg(2,jj,i)*dip(3,kk,k)
8554 s1=dipderg(4,jj,j)*dip(2,kk,l)
8557 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8559 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8560 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8562 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8563 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8565 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8566 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8567 cd write (2,*) 'turn6 derivatives'
8569 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8571 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8575 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8577 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8581 C Derivatives in gamma(k-1)
8584 s1=dip(3,jj,i)*dipderg(2,kk,k)
8586 s1=dip(2,jj,j)*dipderg(4,kk,l)
8589 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8590 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8592 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8593 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8595 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8596 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8598 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8599 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8600 vv(1)=pizda(1,1)-pizda(2,2)
8601 vv(2)=pizda(2,1)+pizda(1,2)
8602 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8603 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8605 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8607 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8611 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8613 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8616 C Derivatives in gamma(j-1) or gamma(l-1)
8617 if (l.eq.j+1 .and. l.gt.1) then
8618 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8619 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8620 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8621 vv(1)=pizda(1,1)-pizda(2,2)
8622 vv(2)=pizda(2,1)+pizda(1,2)
8623 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8624 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8625 else if (j.gt.1) then
8626 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8627 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8628 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8629 vv(1)=pizda(1,1)-pizda(2,2)
8630 vv(2)=pizda(2,1)+pizda(1,2)
8631 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8632 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8633 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8635 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8638 C Cartesian derivatives.
8645 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8647 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8651 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8653 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8657 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8659 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8661 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8662 & b1(1,itj1),auxvec(1))
8663 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8665 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8666 & b1(1,itl1),auxvec(1))
8667 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8669 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8671 vv(1)=pizda(1,1)-pizda(2,2)
8672 vv(2)=pizda(2,1)+pizda(1,2)
8673 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8675 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8677 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8680 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8683 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8686 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8688 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8690 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8694 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8696 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8699 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8701 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8709 c----------------------------------------------------------------------------
8710 double precision function eello_turn6(i,jj,kk)
8711 implicit real*8 (a-h,o-z)
8712 include 'DIMENSIONS'
8713 include 'COMMON.IOUNITS'
8714 include 'COMMON.CHAIN'
8715 include 'COMMON.DERIV'
8716 include 'COMMON.INTERACT'
8717 include 'COMMON.CONTACTS'
8719 include 'COMMON.CONTACTS.MOMENT'
8721 include 'COMMON.TORSION'
8722 include 'COMMON.VAR'
8723 include 'COMMON.GEO'
8724 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8725 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8727 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8728 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8729 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8730 C the respective energy moment and not to the cluster cumulant.
8739 iti=itortyp(itype(i))
8740 itk=itortyp(itype(k))
8741 itk1=itortyp(itype(k+1))
8742 itl=itortyp(itype(l))
8743 itj=itortyp(itype(j))
8744 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8745 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8746 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8751 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8753 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8757 derx_turn(lll,kkk,iii)=0.0d0
8764 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8766 cd write (2,*) 'eello6_5',eello6_5
8768 call transpose2(AEA(1,1,1),auxmat(1,1))
8769 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8770 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8771 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8773 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8774 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8775 s2 = scalar2(b1(1,itk),vtemp1(1))
8777 call transpose2(AEA(1,1,2),atemp(1,1))
8778 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8779 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8780 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8782 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8783 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8784 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8786 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8787 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8788 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8789 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8790 ss13 = scalar2(b1(1,itk),vtemp4(1))
8791 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8793 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8799 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8800 C Derivatives in gamma(i+2)
8804 call transpose2(AEA(1,1,1),auxmatd(1,1))
8805 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8806 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8807 call transpose2(AEAderg(1,1,2),atempd(1,1))
8808 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8809 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8811 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8812 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8813 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8819 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8820 C Derivatives in gamma(i+3)
8822 call transpose2(AEA(1,1,1),auxmatd(1,1))
8823 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8824 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8825 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8827 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8828 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8829 s2d = scalar2(b1(1,itk),vtemp1d(1))
8831 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8832 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8834 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8836 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8837 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8838 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8846 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8847 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8849 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8850 & -0.5d0*ekont*(s2d+s12d)
8852 C Derivatives in gamma(i+4)
8853 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8854 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8855 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8857 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8858 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8859 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8867 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8869 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8871 C Derivatives in gamma(i+5)
8873 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8874 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8875 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8877 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8878 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8879 s2d = scalar2(b1(1,itk),vtemp1d(1))
8881 call transpose2(AEA(1,1,2),atempd(1,1))
8882 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8883 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8885 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8886 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8888 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8889 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8890 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8898 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8899 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8901 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8902 & -0.5d0*ekont*(s2d+s12d)
8904 C Cartesian derivatives
8909 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8910 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8911 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8913 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8914 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8916 s2d = scalar2(b1(1,itk),vtemp1d(1))
8918 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8919 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8920 s8d = -(atempd(1,1)+atempd(2,2))*
8921 & scalar2(cc(1,1,itl),vtemp2(1))
8923 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8925 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8926 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8933 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8936 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8940 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8941 & - 0.5d0*(s8d+s12d)
8943 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8952 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8954 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8955 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8956 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8957 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8958 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8960 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8961 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8962 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8966 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8967 cd & 16*eel_turn6_num
8969 if (j.lt.nres-1) then
8976 if (l.lt.nres-1) then
8984 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8985 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8986 cgrad ghalf=0.5d0*ggg1(ll)
8988 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8989 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8990 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8991 & +ekont*derx_turn(ll,2,1)
8992 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8993 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8994 & +ekont*derx_turn(ll,4,1)
8995 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8996 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8997 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8998 cgrad ghalf=0.5d0*ggg2(ll)
9000 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9001 & +ekont*derx_turn(ll,2,2)
9002 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9003 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9004 & +ekont*derx_turn(ll,4,2)
9005 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9006 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9007 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9012 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9017 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9023 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9028 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9032 cd write (2,*) iii,g_corr6_loc(iii)
9034 eello_turn6=ekont*eel_turn6
9035 cd write (2,*) 'ekont',ekont
9036 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9040 C-----------------------------------------------------------------------------
9041 double precision function scalar(u,v)
9042 !DIR$ INLINEALWAYS scalar
9044 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9047 double precision u(3),v(3)
9048 cd double precision sc
9056 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9059 crc-------------------------------------------------
9060 SUBROUTINE MATVEC2(A1,V1,V2)
9061 !DIR$ INLINEALWAYS MATVEC2
9063 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9065 implicit real*8 (a-h,o-z)
9066 include 'DIMENSIONS'
9067 DIMENSION A1(2,2),V1(2),V2(2)
9071 c 3 VI=VI+A1(I,K)*V1(K)
9075 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9076 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9081 C---------------------------------------
9082 SUBROUTINE MATMAT2(A1,A2,A3)
9084 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9086 implicit real*8 (a-h,o-z)
9087 include 'DIMENSIONS'
9088 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9089 c DIMENSION AI3(2,2)
9093 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9099 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9100 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9101 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9102 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9110 c-------------------------------------------------------------------------
9111 double precision function scalar2(u,v)
9112 !DIR$ INLINEALWAYS scalar2
9114 double precision u(2),v(2)
9117 scalar2=u(1)*v(1)+u(2)*v(2)
9121 C-----------------------------------------------------------------------------
9123 subroutine transpose2(a,at)
9124 !DIR$ INLINEALWAYS transpose2
9126 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9129 double precision a(2,2),at(2,2)
9136 c--------------------------------------------------------------------------
9137 subroutine transpose(n,a,at)
9140 double precision a(n,n),at(n,n)
9148 C---------------------------------------------------------------------------
9149 subroutine prodmat3(a1,a2,kk,transp,prod)
9150 !DIR$ INLINEALWAYS prodmat3
9152 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9156 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9158 crc double precision auxmat(2,2),prod_(2,2)
9161 crc call transpose2(kk(1,1),auxmat(1,1))
9162 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9163 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9165 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9166 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9167 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9168 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9169 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9170 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9171 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9172 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9175 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9176 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9178 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9179 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9180 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9181 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9182 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9183 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9184 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9185 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9188 c call transpose2(a2(1,1),a2t(1,1))
9191 crc print *,((prod_(i,j),i=1,2),j=1,2)
9192 crc print *,((prod(i,j),i=1,2),j=1,2)