1 subroutine etotal(energia)
2 implicit real*8 (a-h,o-z)
7 cMS$ATTRIBUTES C :: proc_proc
12 double precision weights_(n_ene)
14 include 'COMMON.SETUP'
15 include 'COMMON.IOUNITS'
16 double precision energia(0:n_ene)
17 include 'COMMON.LOCAL'
18 include 'COMMON.FFIELD'
19 include 'COMMON.DERIV'
20 include 'COMMON.INTERACT'
21 include 'COMMON.SBRIDGE'
22 include 'COMMON.CHAIN'
25 include 'COMMON.CONTROL'
26 include 'COMMON.TIME1'
28 c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
29 c & " nfgtasks",nfgtasks
30 if (nfgtasks.gt.1) then
32 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
33 if (fg_rank.eq.0) then
34 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
35 c print *,"Processor",myrank," BROADCAST iorder"
36 C FG master sets up the WEIGHTS_ array which will be broadcast to the
37 C FG slaves as WEIGHTS array.
58 C FG Master broadcasts the WEIGHTS_ array
59 call MPI_Bcast(weights_(1),n_ene,
60 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
62 C FG slaves receive the WEIGHTS array
63 call MPI_Bcast(weights(1),n_ene,
64 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
86 time_Bcast=time_Bcast+MPI_Wtime()-time00
87 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
88 c call chainbuild_cart
90 c print *,'Processor',myrank,' calling etotal ipot=',ipot
91 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
93 c if (modecalc.eq.12.or.modecalc.eq.14) then
94 c call int_from_cart1(.false.)
101 C Compute the side-chain and electrostatic interaction energy
103 goto (101,102,103,104,105,106) ipot
104 C Lennard-Jones potential.
105 101 call elj(evdw,evdw_p,evdw_m)
106 cd print '(a)','Exit ELJ'
108 C Lennard-Jones-Kihara potential (shifted).
109 102 call eljk(evdw,evdw_p,evdw_m)
111 C Berne-Pechukas potential (dilated LJ, angular dependence).
112 103 call ebp(evdw,evdw_p,evdw_m)
114 C Gay-Berne potential (shifted LJ, angular dependence).
115 104 call egb(evdw,evdw_p,evdw_m)
117 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
118 105 call egbv(evdw,evdw_p,evdw_m)
120 C Soft-sphere potential
121 106 call e_softsphere(evdw)
123 C Calculate electrostatic (H-bonding) energy of the main chain.
127 C JUYONG for dfa test!
128 if (wdfa_dist.gt.0) call edfad(edfadis)
129 c print*, 'edfad is finished!', edfadis
130 if (wdfa_tor.gt.0) call edfat(edfator)
131 c print*, 'edfat is finished!', edfator
132 if (wdfa_nei.gt.0) call edfan(edfanei)
133 c print*, 'edfan is finished!', edfanei
134 if (wdfa_beta.gt.0) call edfab(edfabet)
135 c print*, 'edfab is finished!', edfabet
139 c print *,"Processor",myrank," computed USCSC"
145 time_vec=time_vec+MPI_Wtime()-time01
147 c print *,"Processor",myrank," left VEC_AND_DERIV"
150 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
151 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
152 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
153 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
155 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
156 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
157 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
158 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
160 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
169 c write (iout,*) "Soft-spheer ELEC potential"
170 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
173 c print *,"Processor",myrank," computed UELEC"
175 C Calculate excluded-volume interaction energy between peptide groups
180 call escp(evdw2,evdw2_14)
186 c write (iout,*) "Soft-sphere SCP potential"
187 call escp_soft_sphere(evdw2,evdw2_14)
190 c Calculate the bond-stretching energy
194 C Calculate the disulfide-bridge and other energy and the contributions
195 C from other distance constraints.
196 cd print *,'Calling EHPB'
198 cd print *,'EHPB exitted succesfully.'
200 C Calculate the virtual-bond-angle energy.
202 if (wang.gt.0d0) then
207 c print *,"Processor",myrank," computed UB"
209 C Calculate the SC local energy.
212 c print *,"Processor",myrank," computed USC"
214 C Calculate the virtual-bond torsional energy.
216 cd print *,'nterm=',nterm
218 call etor(etors,edihcnstr)
223 c print *,"Processor",myrank," computed Utor"
225 C 6/23/01 Calculate double-torsional energy
227 if (wtor_d.gt.0) then
232 c print *,"Processor",myrank," computed Utord"
234 C 21/5/07 Calculate local sicdechain correlation energy
236 if (wsccor.gt.0.0d0) then
237 call eback_sc_corr(esccor)
241 c print *,"Processor",myrank," computed Usccorr"
243 C 12/1/95 Multi-body terms
247 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
248 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
249 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
250 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
251 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
258 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
259 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
260 cd write (iout,*) "multibody_hb ecorr",ecorr
262 c print *,"Processor",myrank," computed Ucorr"
264 C If performing constraint dynamics, call the constraint energy
265 C after the equilibration time
266 if(usampl.and.totT.gt.eq_time) then
274 time_enecalc=time_enecalc+MPI_Wtime()-time00
276 c print *,"Processor",myrank," computed Uconstr"
285 energia(2)=evdw2-evdw2_14
302 energia(8)=eello_turn3
303 energia(9)=eello_turn4
310 energia(19)=edihcnstr
312 energia(20)=Uconst+Uconst_back
320 c print *," Processor",myrank," calls SUM_ENERGY"
321 call sum_energy(energia,.true.)
322 c print *," Processor",myrank," left SUM_ENERGY"
324 time_sumene=time_sumene+MPI_Wtime()-time00
327 c print*, 'etot:',energia(0)
331 c-------------------------------------------------------------------------------
332 subroutine sum_energy(energia,reduce)
333 implicit real*8 (a-h,o-z)
338 cMS$ATTRIBUTES C :: proc_proc
344 include 'COMMON.SETUP'
345 include 'COMMON.IOUNITS'
346 double precision energia(0:n_ene),enebuff(0:n_ene+1)
347 include 'COMMON.FFIELD'
348 include 'COMMON.DERIV'
349 include 'COMMON.INTERACT'
350 include 'COMMON.SBRIDGE'
351 include 'COMMON.CHAIN'
353 include 'COMMON.CONTROL'
354 include 'COMMON.TIME1'
357 if (nfgtasks.gt.1 .and. reduce) then
359 write (iout,*) "energies before REDUCE"
360 call enerprint(energia)
364 enebuff(i)=energia(i)
367 call MPI_Barrier(FG_COMM,IERR)
368 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
370 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
371 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
373 write (iout,*) "energies after REDUCE"
374 call enerprint(energia)
377 time_Reduce=time_Reduce+MPI_Wtime()-time00
379 if (fg_rank.eq.0) then
382 evdw=energia(22)+wsct*energia(23)
387 evdw2=energia(2)+energia(18)
403 eello_turn3=energia(8)
404 eello_turn4=energia(9)
411 edihcnstr=energia(19)
420 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
421 & +wang*ebe+wtor*etors+wscloc*escloc
422 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
423 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
424 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
425 & +wbond*estr+Uconst+wsccor*esccor
426 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
429 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
430 & +wang*ebe+wtor*etors+wscloc*escloc
431 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
432 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
433 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
434 & +wbond*estr+Uconst+wsccor*esccor
435 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
443 if (isnan(etot).ne.0) energia(0)=1.0d+99
445 if (isnan(etot)) energia(0)=1.0d+99
450 idumm=proc_proc(etot,i)
452 call proc_proc(etot,i)
454 if(i.eq.1)energia(0)=1.0d+99
461 c-------------------------------------------------------------------------------
462 subroutine sum_gradient
463 implicit real*8 (a-h,o-z)
468 cMS$ATTRIBUTES C :: proc_proc
473 double precision gradbufc(3,maxres),gradbufx(3,maxres),
474 & glocbuf(4*maxres),gradbufc_sum(3,maxres)
476 double precision gradbufc(3,maxres),gradbufx(3,maxres),
477 & glocbuf(4*maxres),gradbufc_sum(3,maxres)
479 include 'COMMON.SETUP'
480 include 'COMMON.IOUNITS'
481 include 'COMMON.FFIELD'
482 include 'COMMON.DERIV'
483 include 'COMMON.INTERACT'
484 include 'COMMON.SBRIDGE'
485 include 'COMMON.CHAIN'
487 include 'COMMON.CONTROL'
488 include 'COMMON.TIME1'
489 include 'COMMON.MAXGRAD'
494 write (iout,*) "sum_gradient gvdwc, gvdwx"
496 write (iout,'(i3,3f10.5,5x,3f10.5,5x,3f10.5,5x,3f10.5)')
497 & i,(gvdwx(j,i),j=1,3),(gvdwcT(j,i),j=1,3),(gvdwc(j,i),j=1,3),
498 & (gvdwcT(j,i),j=1,3)
503 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
504 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
505 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
508 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
509 C in virtual-bond-vector coordinates
512 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
514 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
515 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
517 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
519 c write (iout,'(i5,3f10.5,2x,f10.5)')
520 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
522 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
524 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
525 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
534 gradbufc(j,i)=wsc*gvdwc(j,i)+wsc*wscT*gvdwcT(j,i)+
535 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
536 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
537 & wel_loc*gel_loc_long(j,i)+
538 & wcorr*gradcorr_long(j,i)+
539 & wcorr5*gradcorr5_long(j,i)+
540 & wcorr6*gradcorr6_long(j,i)+
541 & wturn6*gcorr6_turn_long(j,i)+
542 & wstrain*ghpbc(j,i)+
543 & wdfa_dist*gdfad(j,i)+
544 & wdfa_tor*gdfat(j,i)+
545 & wdfa_nei*gdfan(j,i)+
546 & wdfa_beta*gdfab(j,i)
553 gradbufc(j,i)=wsc*gvdwc(j,i)+
554 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
555 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
556 & wel_loc*gel_loc_long(j,i)+
557 & wcorr*gradcorr_long(j,i)+
558 & wcorr5*gradcorr5_long(j,i)+
559 & wcorr6*gradcorr6_long(j,i)+
560 & wturn6*gcorr6_turn_long(j,i)+
561 & wstrain*ghpbc(j,i)+
562 & wdfa_dist*gdfad(j,i)+
563 & wdfa_tor*gdfat(j,i)+
564 & wdfa_nei*gdfan(j,i)+
565 & wdfa_beta*gdfab(j,i)
573 gradbufc(j,i)=wsc*gvdwc(j,i)+
574 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
575 & welec*gelc_long(j,i)+
577 & wel_loc*gel_loc_long(j,i)+
578 & wcorr*gradcorr_long(j,i)+
579 & wcorr5*gradcorr5_long(j,i)+
580 & wcorr6*gradcorr6_long(j,i)+
581 & wturn6*gcorr6_turn_long(j,i)+
582 & wstrain*ghpbc(j,i)+
583 & wdfa_dist*gdfad(j,i)+
584 & wdfa_tor*gdfat(j,i)+
585 & wdfa_nei*gdfan(j,i)+
586 & wdfa_beta*gdfab(j,i)
593 if (nfgtasks.gt.1) then
596 write (iout,*) "gradbufc before allreduce"
598 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
602 call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
603 & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
604 time_reduce=time_reduce+MPI_Wtime()-time00
606 write (iout,*) "gradbufc_sum after allreduce"
608 write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
613 time_allreduce=time_allreduce+MPI_Wtime()-time00
620 do i=igrad_start,igrad_end
621 do j=jgrad_start(i),jgrad_end(i)
623 gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
630 write (iout,*) "gradbufc"
632 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
642 gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
650 gradbufc(k,nres)=0.0d0
655 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
656 & wel_loc*gel_loc(j,i)+
657 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
658 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
659 & wel_loc*gel_loc_long(j,i)+
660 & wcorr*gradcorr_long(j,i)+
661 & wcorr5*gradcorr5_long(j,i)+
662 & wcorr6*gradcorr6_long(j,i)+
663 & wturn6*gcorr6_turn_long(j,i))+
665 & wcorr*gradcorr(j,i)+
666 & wturn3*gcorr3_turn(j,i)+
667 & wturn4*gcorr4_turn(j,i)+
668 & wcorr5*gradcorr5(j,i)+
669 & wcorr6*gradcorr6(j,i)+
670 & wturn6*gcorr6_turn(j,i)+
671 & wsccor*gsccorc(j,i)
672 & +wscloc*gscloc(j,i)
674 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
675 & wel_loc*gel_loc(j,i)+
676 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
677 & welec*gelc_long(j,i)
678 & wel_loc*gel_loc_long(j,i)+
679 & wcorr*gcorr_long(j,i)+
680 & wcorr5*gradcorr5_long(j,i)+
681 & wcorr6*gradcorr6_long(j,i)+
682 & wturn6*gcorr6_turn_long(j,i))+
684 & wcorr*gradcorr(j,i)+
685 & wturn3*gcorr3_turn(j,i)+
686 & wturn4*gcorr4_turn(j,i)+
687 & wcorr5*gradcorr5(j,i)+
688 & wcorr6*gradcorr6(j,i)+
689 & wturn6*gcorr6_turn(j,i)+
690 & wsccor*gsccorc(j,i)
691 & +wscloc*gscloc(j,i)
694 gradx(j,i,icg)=wsc*gvdwx(j,i)+wsc*wscT*gvdwxT(j,i)+
695 & wscp*gradx_scp(j,i)+
697 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
698 & wsccor*gsccorx(j,i)
699 & +wscloc*gsclocx(j,i)
701 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
703 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
704 & wsccor*gsccorx(j,i)
705 & +wscloc*gsclocx(j,i)
710 write (iout,*) "gloc before adding corr"
712 write (iout,*) i,gloc(i,icg)
716 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
717 & +wcorr5*g_corr5_loc(i)
718 & +wcorr6*g_corr6_loc(i)
719 & +wturn4*gel_loc_turn4(i)
720 & +wturn3*gel_loc_turn3(i)
721 & +wturn6*gel_loc_turn6(i)
722 & +wel_loc*gel_loc_loc(i)
723 & +wsccor*gsccor_loc(i)
726 write (iout,*) "gloc after adding corr"
728 write (iout,*) i,gloc(i,icg)
732 if (nfgtasks.gt.1) then
735 gradbufc(j,i)=gradc(j,i,icg)
736 gradbufx(j,i)=gradx(j,i,icg)
740 glocbuf(i)=gloc(i,icg)
743 call MPI_Barrier(FG_COMM,IERR)
744 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
746 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
747 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
748 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
749 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
750 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
751 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
752 time_reduce=time_reduce+MPI_Wtime()-time00
754 write (iout,*) "gloc after reduce"
756 write (iout,*) i,gloc(i,icg)
761 if (gnorm_check) then
763 c Compute the maximum elements of the gradient
773 gcorr3_turn_max=0.0d0
774 gcorr4_turn_max=0.0d0
777 gcorr6_turn_max=0.0d0
787 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
788 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
790 gvdwc_norm=dsqrt(scalar(gvdwcT(1,i),gvdwcT(1,i)))
791 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
793 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
794 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
795 & gvdwc_scp_max=gvdwc_scp_norm
796 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
797 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
798 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
799 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
800 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
801 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
802 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
803 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
804 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
805 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
806 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
807 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
808 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
810 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
811 & gcorr3_turn_max=gcorr3_turn_norm
812 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
814 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
815 & gcorr4_turn_max=gcorr4_turn_norm
816 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
817 if (gradcorr5_norm.gt.gradcorr5_max)
818 & gradcorr5_max=gradcorr5_norm
819 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
820 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
821 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
823 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
824 & gcorr6_turn_max=gcorr6_turn_norm
825 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
826 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
827 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
828 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
829 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
830 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
832 gvdwx_norm=dsqrt(scalar(gvdwxT(1,i),gvdwxT(1,i)))
833 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
835 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
836 if (gradx_scp_norm.gt.gradx_scp_max)
837 & gradx_scp_max=gradx_scp_norm
838 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
839 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
840 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
841 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
842 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
843 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
844 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
845 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
849 open(istat,file=statname,position="append")
851 open(istat,file=statname,access="append")
853 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
854 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
855 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
856 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
857 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
858 & gsccorx_max,gsclocx_max
860 if (gvdwc_max.gt.1.0d4) then
861 write (iout,*) "gvdwc gvdwx gradb gradbx"
863 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
864 & gradb(j,i),gradbx(j,i),j=1,3)
866 call pdbout(0.0d0,'cipiszcze',iout)
872 write (iout,*) "gradc gradx gloc"
874 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
875 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
879 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
883 c-------------------------------------------------------------------------------
884 subroutine rescale_weights(t_bath)
885 implicit real*8 (a-h,o-z)
887 include 'COMMON.IOUNITS'
888 include 'COMMON.FFIELD'
889 include 'COMMON.SBRIDGE'
890 double precision kfac /2.4d0/
891 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
893 c facT=2*temp0/(t_bath+temp0)
894 if (rescale_mode.eq.0) then
900 else if (rescale_mode.eq.1) then
901 facT=kfac/(kfac-1.0d0+t_bath/temp0)
902 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
903 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
904 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
905 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
906 else if (rescale_mode.eq.2) then
912 facT=licznik/dlog(dexp(x)+dexp(-x))
913 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
914 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
915 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
916 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
918 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
919 write (*,*) "Wrong RESCALE_MODE",rescale_mode
921 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
925 welec=weights(3)*fact
926 wcorr=weights(4)*fact3
927 wcorr5=weights(5)*fact4
928 wcorr6=weights(6)*fact5
929 wel_loc=weights(7)*fact2
930 wturn3=weights(8)*fact2
931 wturn4=weights(9)*fact3
932 wturn6=weights(10)*fact5
933 wtor=weights(13)*fact
934 wtor_d=weights(14)*fact2
935 wsccor=weights(21)*fact
938 wsct=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
942 C------------------------------------------------------------------------
943 subroutine enerprint(energia)
944 implicit real*8 (a-h,o-z)
946 include 'COMMON.IOUNITS'
947 include 'COMMON.FFIELD'
948 include 'COMMON.SBRIDGE'
950 double precision energia(0:n_ene)
953 evdw=energia(22)+wsct*energia(23)
959 evdw2=energia(2)+energia(18)
971 eello_turn3=energia(8)
972 eello_turn4=energia(9)
973 eello_turn6=energia(10)
979 edihcnstr=energia(19)
984 edfadis = energia(24)
985 edfator = energia(25)
986 edfanei = energia(26)
987 edfabet = energia(27)
990 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
991 & estr,wbond,ebe,wang,
992 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
994 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
995 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
997 & Uconst,edfadis,edfator,edfanei,edfabet,etot
998 10 format (/'Virtual-chain energies:'//
999 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1000 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1001 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1002 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
1003 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1004 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1005 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1006 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1007 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1008 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1009 & ' (SS bridges & dist. cnstr.)'/
1010 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1011 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1012 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1013 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1014 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1015 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1016 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1017 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1018 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1019 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1020 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1021 & 'EDFAD= ',1pE16.6,' (DFA distance energy)'/
1022 & 'EDFAT= ',1pE16.6,' (DFA torsion energy)'/
1023 & 'EDFAN= ',1pE16.6,' (DFA NCa energy)'/
1024 & 'EDFAB= ',1pE16.6,' (DFA Beta energy)'/
1025 & 'ETOT= ',1pE16.6,' (total)')
1027 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1028 & estr,wbond,ebe,wang,
1029 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1031 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1032 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1034 & Uconst,edfadis,edfator,edfanei,edfabet,etot
1035 10 format (/'Virtual-chain energies:'//
1036 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1037 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1038 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1039 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1040 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1041 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1042 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1043 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1044 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1045 & ' (SS bridges & dist. cnstr.)'/
1046 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1047 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1048 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1049 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1050 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1051 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1052 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1053 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1054 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1055 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1056 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1057 & 'EDFAD= ',1pE16.6,' (DFA distance energy)'/
1058 & 'EDFAT= ',1pE16.6,' (DFA torsion energy)'/
1059 & 'EDFAN= ',1pE16.6,' (DFA NCa energy)'/
1060 & 'EDFAB= ',1pE16.6,' (DFA Beta energy)'/
1061 & 'ETOT= ',1pE16.6,' (total)')
1065 C-----------------------------------------------------------------------
1066 subroutine elj(evdw,evdw_p,evdw_m)
1068 C This subroutine calculates the interaction energy of nonbonded side chains
1069 C assuming the LJ potential of interaction.
1071 implicit real*8 (a-h,o-z)
1072 include 'DIMENSIONS'
1073 parameter (accur=1.0d-10)
1074 include 'COMMON.GEO'
1075 include 'COMMON.VAR'
1076 include 'COMMON.LOCAL'
1077 include 'COMMON.CHAIN'
1078 include 'COMMON.DERIV'
1079 include 'COMMON.INTERACT'
1080 include 'COMMON.TORSION'
1081 include 'COMMON.SBRIDGE'
1082 include 'COMMON.NAMES'
1083 include 'COMMON.IOUNITS'
1084 include 'COMMON.CONTACTS'
1086 include 'COMMON.CONTACTS.MOMENT'
1089 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1091 do i=iatsc_s,iatsc_e
1100 C Calculate SC interaction energy.
1102 do iint=1,nint_gr(i)
1103 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1104 cd & 'iend=',iend(i,iint)
1105 do j=istart(i,iint),iend(i,iint)
1110 C Change 12/1/95 to calculate four-body interactions
1111 rij=xj*xj+yj*yj+zj*zj
1113 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1114 eps0ij=eps(itypi,itypj)
1116 e1=fac*fac*aa(itypi,itypj)
1117 e2=fac*bb(itypi,itypj)
1119 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1120 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1121 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1122 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1123 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1124 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1126 if (bb(itypi,itypj).gt.0) then
1127 evdw_p=evdw_p+evdwij
1129 evdw_m=evdw_m+evdwij
1135 C Calculate the components of the gradient in DC and X
1137 fac=-rrij*(e1+evdwij)
1142 if (bb(itypi,itypj).gt.0.0d0) then
1144 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1145 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1146 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1147 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1151 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1152 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1153 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1154 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1159 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1160 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1161 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1162 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1167 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1171 C 12/1/95, revised on 5/20/97
1173 C Calculate the contact function. The ith column of the array JCONT will
1174 C contain the numbers of atoms that make contacts with the atom I (of numbers
1175 C greater than I). The arrays FACONT and GACONT will contain the values of
1176 C the contact function and its derivative.
1178 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1179 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1180 C Uncomment next line, if the correlation interactions are contact function only
1181 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1183 sigij=sigma(itypi,itypj)
1184 r0ij=rs0(itypi,itypj)
1186 C Check whether the SC's are not too far to make a contact.
1189 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1190 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1192 if (fcont.gt.0.0D0) then
1193 C If the SC-SC distance if close to sigma, apply spline.
1194 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1195 cAdam & fcont1,fprimcont1)
1196 cAdam fcont1=1.0d0-fcont1
1197 cAdam if (fcont1.gt.0.0d0) then
1198 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1199 cAdam fcont=fcont*fcont1
1201 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1202 cga eps0ij=1.0d0/dsqrt(eps0ij)
1204 cga gg(k)=gg(k)*eps0ij
1206 cga eps0ij=-evdwij*eps0ij
1207 C Uncomment for AL's type of SC correlation interactions.
1208 cadam eps0ij=-evdwij
1209 num_conti=num_conti+1
1210 jcont(num_conti,i)=j
1211 facont(num_conti,i)=fcont*eps0ij
1212 fprimcont=eps0ij*fprimcont/rij
1214 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1215 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1216 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1217 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1218 gacont(1,num_conti,i)=-fprimcont*xj
1219 gacont(2,num_conti,i)=-fprimcont*yj
1220 gacont(3,num_conti,i)=-fprimcont*zj
1221 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1222 cd write (iout,'(2i3,3f10.5)')
1223 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1229 num_cont(i)=num_conti
1233 gvdwc(j,i)=expon*gvdwc(j,i)
1234 gvdwx(j,i)=expon*gvdwx(j,i)
1237 C******************************************************************************
1241 C To save time, the factor of EXPON has been extracted from ALL components
1242 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1245 C******************************************************************************
1248 C-----------------------------------------------------------------------------
1249 subroutine eljk(evdw,evdw_p,evdw_m)
1251 C This subroutine calculates the interaction energy of nonbonded side chains
1252 C assuming the LJK potential of interaction.
1254 implicit real*8 (a-h,o-z)
1255 include 'DIMENSIONS'
1256 include 'COMMON.GEO'
1257 include 'COMMON.VAR'
1258 include 'COMMON.LOCAL'
1259 include 'COMMON.CHAIN'
1260 include 'COMMON.DERIV'
1261 include 'COMMON.INTERACT'
1262 include 'COMMON.IOUNITS'
1263 include 'COMMON.NAMES'
1266 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1268 do i=iatsc_s,iatsc_e
1275 C Calculate SC interaction energy.
1277 do iint=1,nint_gr(i)
1278 do j=istart(i,iint),iend(i,iint)
1283 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1284 fac_augm=rrij**expon
1285 e_augm=augm(itypi,itypj)*fac_augm
1286 r_inv_ij=dsqrt(rrij)
1288 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1289 fac=r_shift_inv**expon
1290 e1=fac*fac*aa(itypi,itypj)
1291 e2=fac*bb(itypi,itypj)
1293 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1294 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1295 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1296 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1297 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1298 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1299 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1301 if (bb(itypi,itypj).gt.0) then
1302 evdw_p=evdw_p+evdwij
1304 evdw_m=evdw_m+evdwij
1310 C Calculate the components of the gradient in DC and X
1312 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1317 if (bb(itypi,itypj).gt.0.0d0) then
1319 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1320 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1321 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1322 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1326 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1327 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1328 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1329 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1334 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1335 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1336 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1337 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1342 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1350 gvdwc(j,i)=expon*gvdwc(j,i)
1351 gvdwx(j,i)=expon*gvdwx(j,i)
1356 C-----------------------------------------------------------------------------
1357 subroutine ebp(evdw,evdw_p,evdw_m)
1359 C This subroutine calculates the interaction energy of nonbonded side chains
1360 C assuming the Berne-Pechukas potential of interaction.
1362 implicit real*8 (a-h,o-z)
1363 include 'DIMENSIONS'
1364 include 'COMMON.GEO'
1365 include 'COMMON.VAR'
1366 include 'COMMON.LOCAL'
1367 include 'COMMON.CHAIN'
1368 include 'COMMON.DERIV'
1369 include 'COMMON.NAMES'
1370 include 'COMMON.INTERACT'
1371 include 'COMMON.IOUNITS'
1372 include 'COMMON.CALC'
1373 common /srutu/ icall
1374 c double precision rrsave(maxdim)
1377 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1379 c if (icall.eq.0) then
1385 do i=iatsc_s,iatsc_e
1391 dxi=dc_norm(1,nres+i)
1392 dyi=dc_norm(2,nres+i)
1393 dzi=dc_norm(3,nres+i)
1394 c dsci_inv=dsc_inv(itypi)
1395 dsci_inv=vbld_inv(i+nres)
1397 C Calculate SC interaction energy.
1399 do iint=1,nint_gr(i)
1400 do j=istart(i,iint),iend(i,iint)
1403 c dscj_inv=dsc_inv(itypj)
1404 dscj_inv=vbld_inv(j+nres)
1405 chi1=chi(itypi,itypj)
1406 chi2=chi(itypj,itypi)
1413 alf12=0.5D0*(alf1+alf2)
1414 C For diagnostics only!!!
1427 dxj=dc_norm(1,nres+j)
1428 dyj=dc_norm(2,nres+j)
1429 dzj=dc_norm(3,nres+j)
1430 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1431 cd if (icall.eq.0) then
1437 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1439 C Calculate whole angle-dependent part of epsilon and contributions
1440 C to its derivatives
1441 fac=(rrij*sigsq)**expon2
1442 e1=fac*fac*aa(itypi,itypj)
1443 e2=fac*bb(itypi,itypj)
1444 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1445 eps2der=evdwij*eps3rt
1446 eps3der=evdwij*eps2rt
1447 evdwij=evdwij*eps2rt*eps3rt
1449 if (bb(itypi,itypj).gt.0) then
1450 evdw_p=evdw_p+evdwij
1452 evdw_m=evdw_m+evdwij
1458 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1459 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1460 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1461 cd & restyp(itypi),i,restyp(itypj),j,
1462 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1463 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1464 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1467 C Calculate gradient components.
1468 e1=e1*eps1*eps2rt**2*eps3rt**2
1469 fac=-expon*(e1+evdwij)
1472 C Calculate radial part of the gradient
1476 C Calculate the angular part of the gradient and sum add the contributions
1477 C to the appropriate components of the Cartesian gradient.
1479 if (bb(itypi,itypj).gt.0) then
1493 C-----------------------------------------------------------------------------
1494 subroutine egb(evdw,evdw_p,evdw_m)
1496 C This subroutine calculates the interaction energy of nonbonded side chains
1497 C assuming the Gay-Berne potential of interaction.
1499 implicit real*8 (a-h,o-z)
1500 include 'DIMENSIONS'
1501 include 'COMMON.GEO'
1502 include 'COMMON.VAR'
1503 include 'COMMON.LOCAL'
1504 include 'COMMON.CHAIN'
1505 include 'COMMON.DERIV'
1506 include 'COMMON.NAMES'
1507 include 'COMMON.INTERACT'
1508 include 'COMMON.IOUNITS'
1509 include 'COMMON.CALC'
1510 include 'COMMON.CONTROL'
1513 ccccc energy_dec=.false.
1514 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1519 c if (icall.eq.0) lprn=.false.
1521 do i=iatsc_s,iatsc_e
1527 dxi=dc_norm(1,nres+i)
1528 dyi=dc_norm(2,nres+i)
1529 dzi=dc_norm(3,nres+i)
1530 c dsci_inv=dsc_inv(itypi)
1531 dsci_inv=vbld_inv(i+nres)
1532 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1533 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1535 C Calculate SC interaction energy.
1537 do iint=1,nint_gr(i)
1538 do j=istart(i,iint),iend(i,iint)
1541 c dscj_inv=dsc_inv(itypj)
1542 dscj_inv=vbld_inv(j+nres)
1543 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1544 c & 1.0d0/vbld(j+nres)
1545 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1546 sig0ij=sigma(itypi,itypj)
1547 chi1=chi(itypi,itypj)
1548 chi2=chi(itypj,itypi)
1555 alf12=0.5D0*(alf1+alf2)
1556 C For diagnostics only!!!
1569 dxj=dc_norm(1,nres+j)
1570 dyj=dc_norm(2,nres+j)
1571 dzj=dc_norm(3,nres+j)
1572 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1573 c write (iout,*) "j",j," dc_norm",
1574 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1575 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1577 C Calculate angle-dependent terms of energy and contributions to their
1581 sig=sig0ij*dsqrt(sigsq)
1582 rij_shift=1.0D0/rij-sig+sig0ij
1583 c for diagnostics; uncomment
1584 c rij_shift=1.2*sig0ij
1585 C I hate to put IF's in the loops, but here don't have another choice!!!!
1586 if (rij_shift.le.0.0D0) then
1588 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1589 cd & restyp(itypi),i,restyp(itypj),j,
1590 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1594 c---------------------------------------------------------------
1595 rij_shift=1.0D0/rij_shift
1596 fac=rij_shift**expon
1597 e1=fac*fac*aa(itypi,itypj)
1598 e2=fac*bb(itypi,itypj)
1599 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1600 eps2der=evdwij*eps3rt
1601 eps3der=evdwij*eps2rt
1602 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1603 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1604 evdwij=evdwij*eps2rt*eps3rt
1606 if (bb(itypi,itypj).gt.0) then
1607 evdw_p=evdw_p+evdwij
1609 evdw_m=evdw_m+evdwij
1615 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1616 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1617 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1618 & restyp(itypi),i,restyp(itypj),j,
1619 & epsi,sigm,chi1,chi2,chip1,chip2,
1620 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1621 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1625 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1628 C Calculate gradient components.
1629 e1=e1*eps1*eps2rt**2*eps3rt**2
1630 fac=-expon*(e1+evdwij)*rij_shift
1634 C Calculate the radial part of the gradient
1638 C Calculate angular part of the gradient.
1640 if (bb(itypi,itypj).gt.0) then
1651 c write (iout,*) "Number of loop steps in EGB:",ind
1652 cccc energy_dec=.false.
1655 C-----------------------------------------------------------------------------
1656 subroutine egbv(evdw,evdw_p,evdw_m)
1658 C This subroutine calculates the interaction energy of nonbonded side chains
1659 C assuming the Gay-Berne-Vorobjev potential of interaction.
1661 implicit real*8 (a-h,o-z)
1662 include 'DIMENSIONS'
1663 include 'COMMON.GEO'
1664 include 'COMMON.VAR'
1665 include 'COMMON.LOCAL'
1666 include 'COMMON.CHAIN'
1667 include 'COMMON.DERIV'
1668 include 'COMMON.NAMES'
1669 include 'COMMON.INTERACT'
1670 include 'COMMON.IOUNITS'
1671 include 'COMMON.CALC'
1672 common /srutu/ icall
1675 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1678 c if (icall.eq.0) lprn=.true.
1680 do i=iatsc_s,iatsc_e
1686 dxi=dc_norm(1,nres+i)
1687 dyi=dc_norm(2,nres+i)
1688 dzi=dc_norm(3,nres+i)
1689 c dsci_inv=dsc_inv(itypi)
1690 dsci_inv=vbld_inv(i+nres)
1692 C Calculate SC interaction energy.
1694 do iint=1,nint_gr(i)
1695 do j=istart(i,iint),iend(i,iint)
1698 c dscj_inv=dsc_inv(itypj)
1699 dscj_inv=vbld_inv(j+nres)
1700 sig0ij=sigma(itypi,itypj)
1701 r0ij=r0(itypi,itypj)
1702 chi1=chi(itypi,itypj)
1703 chi2=chi(itypj,itypi)
1710 alf12=0.5D0*(alf1+alf2)
1711 C For diagnostics only!!!
1724 dxj=dc_norm(1,nres+j)
1725 dyj=dc_norm(2,nres+j)
1726 dzj=dc_norm(3,nres+j)
1727 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1729 C Calculate angle-dependent terms of energy and contributions to their
1733 sig=sig0ij*dsqrt(sigsq)
1734 rij_shift=1.0D0/rij-sig+r0ij
1735 C I hate to put IF's in the loops, but here don't have another choice!!!!
1736 if (rij_shift.le.0.0D0) then
1741 c---------------------------------------------------------------
1742 rij_shift=1.0D0/rij_shift
1743 fac=rij_shift**expon
1744 e1=fac*fac*aa(itypi,itypj)
1745 e2=fac*bb(itypi,itypj)
1746 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1747 eps2der=evdwij*eps3rt
1748 eps3der=evdwij*eps2rt
1749 fac_augm=rrij**expon
1750 e_augm=augm(itypi,itypj)*fac_augm
1751 evdwij=evdwij*eps2rt*eps3rt
1753 if (bb(itypi,itypj).gt.0) then
1754 evdw_p=evdw_p+evdwij+e_augm
1756 evdw_m=evdw_m+evdwij+e_augm
1759 evdw=evdw+evdwij+e_augm
1762 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1763 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1764 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1765 & restyp(itypi),i,restyp(itypj),j,
1766 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1767 & chi1,chi2,chip1,chip2,
1768 & eps1,eps2rt**2,eps3rt**2,
1769 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1772 C Calculate gradient components.
1773 e1=e1*eps1*eps2rt**2*eps3rt**2
1774 fac=-expon*(e1+evdwij)*rij_shift
1776 fac=rij*fac-2*expon*rrij*e_augm
1777 C Calculate the radial part of the gradient
1781 C Calculate angular part of the gradient.
1783 if (bb(itypi,itypj).gt.0) then
1795 C-----------------------------------------------------------------------------
1796 subroutine sc_angular
1797 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1798 C om12. Called by ebp, egb, and egbv.
1800 include 'COMMON.CALC'
1801 include 'COMMON.IOUNITS'
1805 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1806 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1807 om12=dxi*dxj+dyi*dyj+dzi*dzj
1809 C Calculate eps1(om12) and its derivative in om12
1810 faceps1=1.0D0-om12*chiom12
1811 faceps1_inv=1.0D0/faceps1
1812 eps1=dsqrt(faceps1_inv)
1813 C Following variable is eps1*deps1/dom12
1814 eps1_om12=faceps1_inv*chiom12
1819 c write (iout,*) "om12",om12," eps1",eps1
1820 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1825 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1826 sigsq=1.0D0-facsig*faceps1_inv
1827 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1828 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1829 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1835 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1836 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1838 C Calculate eps2 and its derivatives in om1, om2, and om12.
1841 chipom12=chip12*om12
1842 facp=1.0D0-om12*chipom12
1844 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1845 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1846 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1847 C Following variable is the square root of eps2
1848 eps2rt=1.0D0-facp1*facp_inv
1849 C Following three variables are the derivatives of the square root of eps
1850 C in om1, om2, and om12.
1851 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1852 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1853 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1854 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1855 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1856 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1857 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1858 c & " eps2rt_om12",eps2rt_om12
1859 C Calculate whole angle-dependent part of epsilon and contributions
1860 C to its derivatives
1864 C----------------------------------------------------------------------------
1865 subroutine sc_grad_T
1866 implicit real*8 (a-h,o-z)
1867 include 'DIMENSIONS'
1868 include 'COMMON.CHAIN'
1869 include 'COMMON.DERIV'
1870 include 'COMMON.CALC'
1871 include 'COMMON.IOUNITS'
1872 double precision dcosom1(3),dcosom2(3)
1873 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1874 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1875 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1876 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1880 c eom12=evdwij*eps1_om12
1882 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1883 c & " sigder",sigder
1884 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1885 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1887 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1888 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1891 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1893 c write (iout,*) "gg",(gg(k),k=1,3)
1895 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1896 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1897 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1898 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1899 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1900 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1901 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1902 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1903 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1904 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1907 C Calculate the components of the gradient in DC and X
1911 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1915 gvdwcT(l,i)=gvdwcT(l,i)-gg(l)
1916 gvdwcT(l,j)=gvdwcT(l,j)+gg(l)
1921 C----------------------------------------------------------------------------
1923 implicit real*8 (a-h,o-z)
1924 include 'DIMENSIONS'
1925 include 'COMMON.CHAIN'
1926 include 'COMMON.DERIV'
1927 include 'COMMON.CALC'
1928 include 'COMMON.IOUNITS'
1929 double precision dcosom1(3),dcosom2(3)
1930 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1931 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1932 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1933 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1937 c eom12=evdwij*eps1_om12
1939 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1940 c & " sigder",sigder
1941 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1942 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1944 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1945 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1948 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1950 c write (iout,*) "gg",(gg(k),k=1,3)
1952 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1953 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1954 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1955 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1956 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1957 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1958 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1959 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1960 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1961 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1964 C Calculate the components of the gradient in DC and X
1968 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1972 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1973 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1977 C-----------------------------------------------------------------------
1978 subroutine e_softsphere(evdw)
1980 C This subroutine calculates the interaction energy of nonbonded side chains
1981 C assuming the LJ potential of interaction.
1983 implicit real*8 (a-h,o-z)
1984 include 'DIMENSIONS'
1985 parameter (accur=1.0d-10)
1986 include 'COMMON.GEO'
1987 include 'COMMON.VAR'
1988 include 'COMMON.LOCAL'
1989 include 'COMMON.CHAIN'
1990 include 'COMMON.DERIV'
1991 include 'COMMON.INTERACT'
1992 include 'COMMON.TORSION'
1993 include 'COMMON.SBRIDGE'
1994 include 'COMMON.NAMES'
1995 include 'COMMON.IOUNITS'
1996 include 'COMMON.CONTACTS'
1998 include 'COMMON.CONTACTS.MOMENT'
2001 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2003 do i=iatsc_s,iatsc_e
2010 C Calculate SC interaction energy.
2012 do iint=1,nint_gr(i)
2013 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2014 cd & 'iend=',iend(i,iint)
2015 do j=istart(i,iint),iend(i,iint)
2020 rij=xj*xj+yj*yj+zj*zj
2021 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2022 r0ij=r0(itypi,itypj)
2024 c print *,i,j,r0ij,dsqrt(rij)
2025 if (rij.lt.r0ijsq) then
2026 evdwij=0.25d0*(rij-r0ijsq)**2
2034 C Calculate the components of the gradient in DC and X
2040 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2041 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2042 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2043 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2047 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2055 C--------------------------------------------------------------------------
2056 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2059 C Soft-sphere potential of p-p interaction
2061 implicit real*8 (a-h,o-z)
2062 include 'DIMENSIONS'
2063 include 'COMMON.CONTROL'
2064 include 'COMMON.IOUNITS'
2065 include 'COMMON.GEO'
2066 include 'COMMON.VAR'
2067 include 'COMMON.LOCAL'
2068 include 'COMMON.CHAIN'
2069 include 'COMMON.DERIV'
2070 include 'COMMON.INTERACT'
2071 include 'COMMON.CONTACTS'
2073 include 'COMMON.CONTACTS.MOMENT'
2075 include 'COMMON.TORSION'
2076 include 'COMMON.VECTORS'
2077 include 'COMMON.FFIELD'
2079 cd write(iout,*) 'In EELEC_soft_sphere'
2086 do i=iatel_s,iatel_e
2090 xmedi=c(1,i)+0.5d0*dxi
2091 ymedi=c(2,i)+0.5d0*dyi
2092 zmedi=c(3,i)+0.5d0*dzi
2094 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2095 do j=ielstart(i),ielend(i)
2099 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2100 r0ij=rpp(iteli,itelj)
2105 xj=c(1,j)+0.5D0*dxj-xmedi
2106 yj=c(2,j)+0.5D0*dyj-ymedi
2107 zj=c(3,j)+0.5D0*dzj-zmedi
2108 rij=xj*xj+yj*yj+zj*zj
2109 if (rij.lt.r0ijsq) then
2110 evdw1ij=0.25d0*(rij-r0ijsq)**2
2118 C Calculate contributions to the Cartesian gradient.
2124 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2125 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2128 * Loop over residues i+1 thru j-1.
2132 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2137 cgrad do i=nnt,nct-1
2139 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2141 cgrad do j=i+1,nct-1
2143 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2149 c------------------------------------------------------------------------------
2150 subroutine vec_and_deriv
2151 implicit real*8 (a-h,o-z)
2152 include 'DIMENSIONS'
2156 include 'COMMON.IOUNITS'
2157 include 'COMMON.GEO'
2158 include 'COMMON.VAR'
2159 include 'COMMON.LOCAL'
2160 include 'COMMON.CHAIN'
2161 include 'COMMON.VECTORS'
2162 include 'COMMON.SETUP'
2163 include 'COMMON.TIME1'
2164 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2165 C Compute the local reference systems. For reference system (i), the
2166 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2167 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2169 do i=ivec_start,ivec_end
2173 if (i.eq.nres-1) then
2174 C Case of the last full residue
2175 C Compute the Z-axis
2176 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2177 costh=dcos(pi-theta(nres))
2178 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2182 C Compute the derivatives of uz
2184 uzder(2,1,1)=-dc_norm(3,i-1)
2185 uzder(3,1,1)= dc_norm(2,i-1)
2186 uzder(1,2,1)= dc_norm(3,i-1)
2188 uzder(3,2,1)=-dc_norm(1,i-1)
2189 uzder(1,3,1)=-dc_norm(2,i-1)
2190 uzder(2,3,1)= dc_norm(1,i-1)
2193 uzder(2,1,2)= dc_norm(3,i)
2194 uzder(3,1,2)=-dc_norm(2,i)
2195 uzder(1,2,2)=-dc_norm(3,i)
2197 uzder(3,2,2)= dc_norm(1,i)
2198 uzder(1,3,2)= dc_norm(2,i)
2199 uzder(2,3,2)=-dc_norm(1,i)
2201 C Compute the Y-axis
2204 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2206 C Compute the derivatives of uy
2209 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2210 & -dc_norm(k,i)*dc_norm(j,i-1)
2211 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2213 uyder(j,j,1)=uyder(j,j,1)-costh
2214 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2219 uygrad(l,k,j,i)=uyder(l,k,j)
2220 uzgrad(l,k,j,i)=uzder(l,k,j)
2224 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2225 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2226 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2227 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2230 C Compute the Z-axis
2231 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2232 costh=dcos(pi-theta(i+2))
2233 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2237 C Compute the derivatives of uz
2239 uzder(2,1,1)=-dc_norm(3,i+1)
2240 uzder(3,1,1)= dc_norm(2,i+1)
2241 uzder(1,2,1)= dc_norm(3,i+1)
2243 uzder(3,2,1)=-dc_norm(1,i+1)
2244 uzder(1,3,1)=-dc_norm(2,i+1)
2245 uzder(2,3,1)= dc_norm(1,i+1)
2248 uzder(2,1,2)= dc_norm(3,i)
2249 uzder(3,1,2)=-dc_norm(2,i)
2250 uzder(1,2,2)=-dc_norm(3,i)
2252 uzder(3,2,2)= dc_norm(1,i)
2253 uzder(1,3,2)= dc_norm(2,i)
2254 uzder(2,3,2)=-dc_norm(1,i)
2256 C Compute the Y-axis
2259 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2261 C Compute the derivatives of uy
2264 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2265 & -dc_norm(k,i)*dc_norm(j,i+1)
2266 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2268 uyder(j,j,1)=uyder(j,j,1)-costh
2269 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2274 uygrad(l,k,j,i)=uyder(l,k,j)
2275 uzgrad(l,k,j,i)=uzder(l,k,j)
2279 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2280 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2281 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2282 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2286 vbld_inv_temp(1)=vbld_inv(i+1)
2287 if (i.lt.nres-1) then
2288 vbld_inv_temp(2)=vbld_inv(i+2)
2290 vbld_inv_temp(2)=vbld_inv(i)
2295 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2296 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2301 #if defined(PARVEC) && defined(MPI)
2302 if (nfgtasks1.gt.1) then
2304 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2305 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2306 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2307 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2308 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2310 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2311 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2313 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2314 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2315 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2316 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2317 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2318 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2319 time_gather=time_gather+MPI_Wtime()-time00
2321 c if (fg_rank.eq.0) then
2322 c write (iout,*) "Arrays UY and UZ"
2324 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2331 C-----------------------------------------------------------------------------
2332 subroutine check_vecgrad
2333 implicit real*8 (a-h,o-z)
2334 include 'DIMENSIONS'
2335 include 'COMMON.IOUNITS'
2336 include 'COMMON.GEO'
2337 include 'COMMON.VAR'
2338 include 'COMMON.LOCAL'
2339 include 'COMMON.CHAIN'
2340 include 'COMMON.VECTORS'
2341 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2342 dimension uyt(3,maxres),uzt(3,maxres)
2343 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2344 double precision delta /1.0d-7/
2347 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2348 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2349 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2350 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2351 cd & (dc_norm(if90,i),if90=1,3)
2352 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2353 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2354 cd write(iout,'(a)')
2360 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2361 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2374 cd write (iout,*) 'i=',i
2376 erij(k)=dc_norm(k,i)
2380 dc_norm(k,i)=erij(k)
2382 dc_norm(j,i)=dc_norm(j,i)+delta
2383 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2385 c dc_norm(k,i)=dc_norm(k,i)/fac
2387 c write (iout,*) (dc_norm(k,i),k=1,3)
2388 c write (iout,*) (erij(k),k=1,3)
2391 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2392 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2393 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2394 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2396 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2397 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2398 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2401 dc_norm(k,i)=erij(k)
2404 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2405 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2406 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2407 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2408 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2409 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2410 cd write (iout,'(a)')
2415 C--------------------------------------------------------------------------
2416 subroutine set_matrices
2417 implicit real*8 (a-h,o-z)
2418 include 'DIMENSIONS'
2421 include "COMMON.SETUP"
2423 integer status(MPI_STATUS_SIZE)
2425 include 'COMMON.IOUNITS'
2426 include 'COMMON.GEO'
2427 include 'COMMON.VAR'
2428 include 'COMMON.LOCAL'
2429 include 'COMMON.CHAIN'
2430 include 'COMMON.DERIV'
2431 include 'COMMON.INTERACT'
2432 include 'COMMON.CONTACTS'
2434 include 'COMMON.CONTACTS.MOMENT'
2436 include 'COMMON.TORSION'
2437 include 'COMMON.VECTORS'
2438 include 'COMMON.FFIELD'
2439 double precision auxvec(2),auxmat(2,2)
2441 C Compute the virtual-bond-torsional-angle dependent quantities needed
2442 C to calculate the el-loc multibody terms of various order.
2445 do i=ivec_start+2,ivec_end+2
2449 if (i .lt. nres+1) then
2486 if (i .gt. 3 .and. i .lt. nres+1) then
2487 obrot_der(1,i-2)=-sin1
2488 obrot_der(2,i-2)= cos1
2489 Ugder(1,1,i-2)= sin1
2490 Ugder(1,2,i-2)=-cos1
2491 Ugder(2,1,i-2)=-cos1
2492 Ugder(2,2,i-2)=-sin1
2495 obrot2_der(1,i-2)=-dwasin2
2496 obrot2_der(2,i-2)= dwacos2
2497 Ug2der(1,1,i-2)= dwasin2
2498 Ug2der(1,2,i-2)=-dwacos2
2499 Ug2der(2,1,i-2)=-dwacos2
2500 Ug2der(2,2,i-2)=-dwasin2
2502 obrot_der(1,i-2)=0.0d0
2503 obrot_der(2,i-2)=0.0d0
2504 Ugder(1,1,i-2)=0.0d0
2505 Ugder(1,2,i-2)=0.0d0
2506 Ugder(2,1,i-2)=0.0d0
2507 Ugder(2,2,i-2)=0.0d0
2508 obrot2_der(1,i-2)=0.0d0
2509 obrot2_der(2,i-2)=0.0d0
2510 Ug2der(1,1,i-2)=0.0d0
2511 Ug2der(1,2,i-2)=0.0d0
2512 Ug2der(2,1,i-2)=0.0d0
2513 Ug2der(2,2,i-2)=0.0d0
2515 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2516 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2517 iti = itortyp(itype(i-2))
2521 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2522 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2523 iti1 = itortyp(itype(i-1))
2527 cd write (iout,*) '*******i',i,' iti1',iti
2528 cd write (iout,*) 'b1',b1(:,iti)
2529 cd write (iout,*) 'b2',b2(:,iti)
2530 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2531 c if (i .gt. iatel_s+2) then
2532 if (i .gt. nnt+2) then
2533 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2534 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2535 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2537 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2538 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2539 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2540 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2541 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2552 DtUg2(l,k,i-2)=0.0d0
2556 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2557 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2559 muder(k,i-2)=Ub2der(k,i-2)
2561 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2562 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2563 iti1 = itortyp(itype(i-1))
2568 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2570 cd write (iout,*) 'mu ',mu(:,i-2)
2571 cd write (iout,*) 'mu1',mu1(:,i-2)
2572 cd write (iout,*) 'mu2',mu2(:,i-2)
2573 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2575 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2576 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2577 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2578 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2579 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2580 C Vectors and matrices dependent on a single virtual-bond dihedral.
2581 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2582 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2583 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2584 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2585 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2586 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2587 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2588 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2589 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2592 C Matrices dependent on two consecutive virtual-bond dihedrals.
2593 C The order of matrices is from left to right.
2594 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2596 c do i=max0(ivec_start,2),ivec_end
2598 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2599 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2600 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2601 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2602 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2603 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2604 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2605 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2608 #if defined(MPI) && defined(PARMAT)
2610 c if (fg_rank.eq.0) then
2611 write (iout,*) "Arrays UG and UGDER before GATHER"
2613 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2614 & ((ug(l,k,i),l=1,2),k=1,2),
2615 & ((ugder(l,k,i),l=1,2),k=1,2)
2617 write (iout,*) "Arrays UG2 and UG2DER"
2619 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2620 & ((ug2(l,k,i),l=1,2),k=1,2),
2621 & ((ug2der(l,k,i),l=1,2),k=1,2)
2623 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2625 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2626 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2627 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2629 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2631 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2632 & costab(i),sintab(i),costab2(i),sintab2(i)
2634 write (iout,*) "Array MUDER"
2636 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2640 if (nfgtasks.gt.1) then
2642 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2643 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2644 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2646 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2647 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2649 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2650 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2652 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2653 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2655 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2656 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2658 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2659 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2661 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2662 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2664 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2665 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2666 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2667 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2668 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2669 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2670 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2671 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2672 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2673 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2674 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2675 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2676 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2678 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2679 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2681 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2682 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2684 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2685 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2687 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2688 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2690 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2691 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2693 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2694 & ivec_count(fg_rank1),
2695 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2697 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2698 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2700 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2701 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2703 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2704 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2706 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2707 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2709 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2710 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2712 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2713 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2715 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2716 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2718 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2719 & ivec_count(fg_rank1),
2720 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2722 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2723 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2725 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2726 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2728 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2729 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2731 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2732 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2734 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2735 & ivec_count(fg_rank1),
2736 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2738 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2739 & ivec_count(fg_rank1),
2740 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2742 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2743 & ivec_count(fg_rank1),
2744 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2745 & MPI_MAT2,FG_COMM1,IERR)
2746 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2747 & ivec_count(fg_rank1),
2748 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2749 & MPI_MAT2,FG_COMM1,IERR)
2752 c Passes matrix info through the ring
2755 if (irecv.lt.0) irecv=nfgtasks1-1
2758 if (inext.ge.nfgtasks1) inext=0
2760 c write (iout,*) "isend",isend," irecv",irecv
2762 lensend=lentyp(isend)
2763 lenrecv=lentyp(irecv)
2764 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2765 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2766 c & MPI_ROTAT1(lensend),inext,2200+isend,
2767 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2768 c & iprev,2200+irecv,FG_COMM,status,IERR)
2769 c write (iout,*) "Gather ROTAT1"
2771 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2772 c & MPI_ROTAT2(lensend),inext,3300+isend,
2773 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2774 c & iprev,3300+irecv,FG_COMM,status,IERR)
2775 c write (iout,*) "Gather ROTAT2"
2777 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2778 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2779 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2780 & iprev,4400+irecv,FG_COMM,status,IERR)
2781 c write (iout,*) "Gather ROTAT_OLD"
2783 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2784 & MPI_PRECOMP11(lensend),inext,5500+isend,
2785 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2786 & iprev,5500+irecv,FG_COMM,status,IERR)
2787 c write (iout,*) "Gather PRECOMP11"
2789 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2790 & MPI_PRECOMP12(lensend),inext,6600+isend,
2791 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2792 & iprev,6600+irecv,FG_COMM,status,IERR)
2793 c write (iout,*) "Gather PRECOMP12"
2795 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2797 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2798 & MPI_ROTAT2(lensend),inext,7700+isend,
2799 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2800 & iprev,7700+irecv,FG_COMM,status,IERR)
2801 c write (iout,*) "Gather PRECOMP21"
2803 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2804 & MPI_PRECOMP22(lensend),inext,8800+isend,
2805 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2806 & iprev,8800+irecv,FG_COMM,status,IERR)
2807 c write (iout,*) "Gather PRECOMP22"
2809 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2810 & MPI_PRECOMP23(lensend),inext,9900+isend,
2811 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2812 & MPI_PRECOMP23(lenrecv),
2813 & iprev,9900+irecv,FG_COMM,status,IERR)
2814 c write (iout,*) "Gather PRECOMP23"
2819 if (irecv.lt.0) irecv=nfgtasks1-1
2822 time_gather=time_gather+MPI_Wtime()-time00
2825 c if (fg_rank.eq.0) then
2826 write (iout,*) "Arrays UG and UGDER"
2828 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2829 & ((ug(l,k,i),l=1,2),k=1,2),
2830 & ((ugder(l,k,i),l=1,2),k=1,2)
2832 write (iout,*) "Arrays UG2 and UG2DER"
2834 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2835 & ((ug2(l,k,i),l=1,2),k=1,2),
2836 & ((ug2der(l,k,i),l=1,2),k=1,2)
2838 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2840 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2841 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2842 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2844 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2846 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2847 & costab(i),sintab(i),costab2(i),sintab2(i)
2849 write (iout,*) "Array MUDER"
2851 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2857 cd iti = itortyp(itype(i))
2860 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2861 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2866 C--------------------------------------------------------------------------
2867 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2869 C This subroutine calculates the average interaction energy and its gradient
2870 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2871 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2872 C The potential depends both on the distance of peptide-group centers and on
2873 C the orientation of the CA-CA virtual bonds.
2875 implicit real*8 (a-h,o-z)
2879 include 'DIMENSIONS'
2880 include 'COMMON.CONTROL'
2881 include 'COMMON.SETUP'
2882 include 'COMMON.IOUNITS'
2883 include 'COMMON.GEO'
2884 include 'COMMON.VAR'
2885 include 'COMMON.LOCAL'
2886 include 'COMMON.CHAIN'
2887 include 'COMMON.DERIV'
2888 include 'COMMON.INTERACT'
2889 include 'COMMON.CONTACTS'
2891 include 'COMMON.CONTACTS.MOMENT'
2893 include 'COMMON.TORSION'
2894 include 'COMMON.VECTORS'
2895 include 'COMMON.FFIELD'
2896 include 'COMMON.TIME1'
2897 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2898 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2899 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2900 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2901 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2902 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2904 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2906 double precision scal_el /1.0d0/
2908 double precision scal_el /0.5d0/
2911 C 13-go grudnia roku pamietnego...
2912 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2913 & 0.0d0,1.0d0,0.0d0,
2914 & 0.0d0,0.0d0,1.0d0/
2915 cd write(iout,*) 'In EELEC'
2917 cd write(iout,*) 'Type',i
2918 cd write(iout,*) 'B1',B1(:,i)
2919 cd write(iout,*) 'B2',B2(:,i)
2920 cd write(iout,*) 'CC',CC(:,:,i)
2921 cd write(iout,*) 'DD',DD(:,:,i)
2922 cd write(iout,*) 'EE',EE(:,:,i)
2924 cd call check_vecgrad
2926 if (icheckgrad.eq.1) then
2928 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2930 dc_norm(k,i)=dc(k,i)*fac
2932 c write (iout,*) 'i',i,' fac',fac
2935 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2936 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2937 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2938 c call vec_and_deriv
2944 time_mat=time_mat+MPI_Wtime()-time01
2948 cd write (iout,*) 'i=',i
2950 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2953 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2954 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2967 cd print '(a)','Enter EELEC'
2968 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2970 gel_loc_loc(i)=0.0d0
2975 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2977 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2979 do i=iturn3_start,iturn3_end
2983 dx_normi=dc_norm(1,i)
2984 dy_normi=dc_norm(2,i)
2985 dz_normi=dc_norm(3,i)
2986 xmedi=c(1,i)+0.5d0*dxi
2987 ymedi=c(2,i)+0.5d0*dyi
2988 zmedi=c(3,i)+0.5d0*dzi
2990 call eelecij(i,i+2,ees,evdw1,eel_loc)
2991 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2992 num_cont_hb(i)=num_conti
2994 do i=iturn4_start,iturn4_end
2998 dx_normi=dc_norm(1,i)
2999 dy_normi=dc_norm(2,i)
3000 dz_normi=dc_norm(3,i)
3001 xmedi=c(1,i)+0.5d0*dxi
3002 ymedi=c(2,i)+0.5d0*dyi
3003 zmedi=c(3,i)+0.5d0*dzi
3004 num_conti=num_cont_hb(i)
3005 call eelecij(i,i+3,ees,evdw1,eel_loc)
3006 if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
3007 num_cont_hb(i)=num_conti
3010 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3012 do i=iatel_s,iatel_e
3016 dx_normi=dc_norm(1,i)
3017 dy_normi=dc_norm(2,i)
3018 dz_normi=dc_norm(3,i)
3019 xmedi=c(1,i)+0.5d0*dxi
3020 ymedi=c(2,i)+0.5d0*dyi
3021 zmedi=c(3,i)+0.5d0*dzi
3022 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3023 num_conti=num_cont_hb(i)
3024 do j=ielstart(i),ielend(i)
3025 call eelecij(i,j,ees,evdw1,eel_loc)
3027 num_cont_hb(i)=num_conti
3029 c write (iout,*) "Number of loop steps in EELEC:",ind
3031 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3032 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3034 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3035 ccc eel_loc=eel_loc+eello_turn3
3036 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3039 C-------------------------------------------------------------------------------
3040 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3041 implicit real*8 (a-h,o-z)
3042 include 'DIMENSIONS'
3046 include 'COMMON.CONTROL'
3047 include 'COMMON.IOUNITS'
3048 include 'COMMON.GEO'
3049 include 'COMMON.VAR'
3050 include 'COMMON.LOCAL'
3051 include 'COMMON.CHAIN'
3052 include 'COMMON.DERIV'
3053 include 'COMMON.INTERACT'
3054 include 'COMMON.CONTACTS'
3056 include 'COMMON.CONTACTS.MOMENT'
3058 include 'COMMON.TORSION'
3059 include 'COMMON.VECTORS'
3060 include 'COMMON.FFIELD'
3061 include 'COMMON.TIME1'
3062 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3063 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3064 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3065 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3066 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3067 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3069 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3071 double precision scal_el /1.0d0/
3073 double precision scal_el /0.5d0/
3076 C 13-go grudnia roku pamietnego...
3077 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3078 & 0.0d0,1.0d0,0.0d0,
3079 & 0.0d0,0.0d0,1.0d0/
3080 c time00=MPI_Wtime()
3081 cd write (iout,*) "eelecij",i,j
3085 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3086 aaa=app(iteli,itelj)
3087 bbb=bpp(iteli,itelj)
3088 ael6i=ael6(iteli,itelj)
3089 ael3i=ael3(iteli,itelj)
3093 dx_normj=dc_norm(1,j)
3094 dy_normj=dc_norm(2,j)
3095 dz_normj=dc_norm(3,j)
3096 xj=c(1,j)+0.5D0*dxj-xmedi
3097 yj=c(2,j)+0.5D0*dyj-ymedi
3098 zj=c(3,j)+0.5D0*dzj-zmedi
3099 rij=xj*xj+yj*yj+zj*zj
3105 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3106 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3107 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3108 fac=cosa-3.0D0*cosb*cosg
3110 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3111 if (j.eq.i+2) ev1=scal_el*ev1
3116 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3119 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3120 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3123 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3124 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3125 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3126 cd & xmedi,ymedi,zmedi,xj,yj,zj
3128 if (energy_dec) then
3129 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3130 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3134 C Calculate contributions to the Cartesian gradient.
3137 facvdw=-6*rrmij*(ev1+evdwij)
3138 facel=-3*rrmij*(el1+eesij)
3144 * Radial derivatives. First process both termini of the fragment (i,j)
3150 c ghalf=0.5D0*ggg(k)
3151 c gelc(k,i)=gelc(k,i)+ghalf
3152 c gelc(k,j)=gelc(k,j)+ghalf
3154 c 9/28/08 AL Gradient compotents will be summed only at the end
3156 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3157 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3160 * Loop over residues i+1 thru j-1.
3164 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3171 c ghalf=0.5D0*ggg(k)
3172 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3173 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3175 c 9/28/08 AL Gradient compotents will be summed only at the end
3177 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3178 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3181 * Loop over residues i+1 thru j-1.
3185 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3192 fac=-3*rrmij*(facvdw+facvdw+facel)
3197 * Radial derivatives. First process both termini of the fragment (i,j)
3203 c ghalf=0.5D0*ggg(k)
3204 c gelc(k,i)=gelc(k,i)+ghalf
3205 c gelc(k,j)=gelc(k,j)+ghalf
3207 c 9/28/08 AL Gradient compotents will be summed only at the end
3209 gelc_long(k,j)=gelc(k,j)+ggg(k)
3210 gelc_long(k,i)=gelc(k,i)-ggg(k)
3213 * Loop over residues i+1 thru j-1.
3217 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3220 c 9/28/08 AL Gradient compotents will be summed only at the end
3225 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3226 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3232 ecosa=2.0D0*fac3*fac1+fac4
3235 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3236 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3238 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3239 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3241 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3242 cd & (dcosg(k),k=1,3)
3244 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3247 c ghalf=0.5D0*ggg(k)
3248 c gelc(k,i)=gelc(k,i)+ghalf
3249 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3250 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3251 c gelc(k,j)=gelc(k,j)+ghalf
3252 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3253 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3257 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3262 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3263 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3265 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3266 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3267 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3268 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3270 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3271 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3272 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3274 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3275 C energy of a peptide unit is assumed in the form of a second-order
3276 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3277 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3278 C are computed for EVERY pair of non-contiguous peptide groups.
3280 if (j.lt.nres-1) then
3291 muij(kkk)=mu(k,i)*mu(l,j)
3294 cd write (iout,*) 'EELEC: i',i,' j',j
3295 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3296 cd write(iout,*) 'muij',muij
3297 ury=scalar(uy(1,i),erij)
3298 urz=scalar(uz(1,i),erij)
3299 vry=scalar(uy(1,j),erij)
3300 vrz=scalar(uz(1,j),erij)
3301 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3302 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3303 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3304 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3305 fac=dsqrt(-ael6i)*r3ij
3310 cd write (iout,'(4i5,4f10.5)')
3311 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3312 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3313 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3314 cd & uy(:,j),uz(:,j)
3315 cd write (iout,'(4f10.5)')
3316 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3317 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3318 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3319 cd write (iout,'(9f10.5/)')
3320 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3321 C Derivatives of the elements of A in virtual-bond vectors
3322 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3324 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3325 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3326 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3327 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3328 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3329 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3330 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3331 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3332 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3333 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3334 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3335 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3337 C Compute radial contributions to the gradient
3355 C Add the contributions coming from er
3358 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3359 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3360 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3361 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3364 C Derivatives in DC(i)
3365 cgrad ghalf1=0.5d0*agg(k,1)
3366 cgrad ghalf2=0.5d0*agg(k,2)
3367 cgrad ghalf3=0.5d0*agg(k,3)
3368 cgrad ghalf4=0.5d0*agg(k,4)
3369 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3370 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3371 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3372 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3373 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3374 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3375 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3376 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3377 C Derivatives in DC(i+1)
3378 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3379 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3380 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3381 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3382 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3383 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3384 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3385 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3386 C Derivatives in DC(j)
3387 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3388 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3389 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3390 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3391 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3392 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3393 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3394 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3395 C Derivatives in DC(j+1) or DC(nres-1)
3396 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3397 & -3.0d0*vryg(k,3)*ury)
3398 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3399 & -3.0d0*vrzg(k,3)*ury)
3400 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3401 & -3.0d0*vryg(k,3)*urz)
3402 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3403 & -3.0d0*vrzg(k,3)*urz)
3404 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3406 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3419 aggi(k,l)=-aggi(k,l)
3420 aggi1(k,l)=-aggi1(k,l)
3421 aggj(k,l)=-aggj(k,l)
3422 aggj1(k,l)=-aggj1(k,l)
3425 if (j.lt.nres-1) then
3431 aggi(k,l)=-aggi(k,l)
3432 aggi1(k,l)=-aggi1(k,l)
3433 aggj(k,l)=-aggj(k,l)
3434 aggj1(k,l)=-aggj1(k,l)
3445 aggi(k,l)=-aggi(k,l)
3446 aggi1(k,l)=-aggi1(k,l)
3447 aggj(k,l)=-aggj(k,l)
3448 aggj1(k,l)=-aggj1(k,l)
3453 IF (wel_loc.gt.0.0d0) THEN
3454 C Contribution to the local-electrostatic energy coming from the i-j pair
3455 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3457 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3459 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3460 & 'eelloc',i,j,eel_loc_ij
3462 eel_loc=eel_loc+eel_loc_ij
3463 C Partial derivatives in virtual-bond dihedral angles gamma
3465 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3466 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3467 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3468 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3469 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3470 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3471 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3473 ggg(l)=agg(l,1)*muij(1)+
3474 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3475 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3476 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3477 cgrad ghalf=0.5d0*ggg(l)
3478 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3479 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3483 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3486 C Remaining derivatives of eello
3488 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3489 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3490 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3491 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3492 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3493 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3494 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3495 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3498 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3499 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3500 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3501 & .and. num_conti.le.maxconts) then
3502 c write (iout,*) i,j," entered corr"
3504 C Calculate the contact function. The ith column of the array JCONT will
3505 C contain the numbers of atoms that make contacts with the atom I (of numbers
3506 C greater than I). The arrays FACONT and GACONT will contain the values of
3507 C the contact function and its derivative.
3508 c r0ij=1.02D0*rpp(iteli,itelj)
3509 c r0ij=1.11D0*rpp(iteli,itelj)
3510 r0ij=2.20D0*rpp(iteli,itelj)
3511 c r0ij=1.55D0*rpp(iteli,itelj)
3512 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3513 if (fcont.gt.0.0D0) then
3514 num_conti=num_conti+1
3515 if (num_conti.gt.maxconts) then
3516 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3517 & ' will skip next contacts for this conf.'
3519 jcont_hb(num_conti,i)=j
3520 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3521 cd & " jcont_hb",jcont_hb(num_conti,i)
3522 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3523 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3524 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3526 d_cont(num_conti,i)=rij
3527 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3528 C --- Electrostatic-interaction matrix ---
3529 a_chuj(1,1,num_conti,i)=a22
3530 a_chuj(1,2,num_conti,i)=a23
3531 a_chuj(2,1,num_conti,i)=a32
3532 a_chuj(2,2,num_conti,i)=a33
3533 C --- Gradient of rij
3535 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3542 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3543 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3544 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3545 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3546 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3551 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3552 C Calculate contact energies
3554 wij=cosa-3.0D0*cosb*cosg
3557 c fac3=dsqrt(-ael6i)/r0ij**3
3558 fac3=dsqrt(-ael6i)*r3ij
3559 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3560 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3561 if (ees0tmp.gt.0) then
3562 ees0pij=dsqrt(ees0tmp)
3566 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3567 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3568 if (ees0tmp.gt.0) then
3569 ees0mij=dsqrt(ees0tmp)
3574 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3575 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3576 C Diagnostics. Comment out or remove after debugging!
3577 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3578 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3579 c ees0m(num_conti,i)=0.0D0
3581 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3582 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3583 C Angular derivatives of the contact function
3584 ees0pij1=fac3/ees0pij
3585 ees0mij1=fac3/ees0mij
3586 fac3p=-3.0D0*fac3*rrmij
3587 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3588 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3590 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3591 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3592 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3593 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3594 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3595 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3596 ecosap=ecosa1+ecosa2
3597 ecosbp=ecosb1+ecosb2
3598 ecosgp=ecosg1+ecosg2
3599 ecosam=ecosa1-ecosa2
3600 ecosbm=ecosb1-ecosb2
3601 ecosgm=ecosg1-ecosg2
3610 facont_hb(num_conti,i)=fcont
3611 fprimcont=fprimcont/rij
3612 cd facont_hb(num_conti,i)=1.0D0
3613 C Following line is for diagnostics.
3616 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3617 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3620 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3621 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3623 gggp(1)=gggp(1)+ees0pijp*xj
3624 gggp(2)=gggp(2)+ees0pijp*yj
3625 gggp(3)=gggp(3)+ees0pijp*zj
3626 gggm(1)=gggm(1)+ees0mijp*xj
3627 gggm(2)=gggm(2)+ees0mijp*yj
3628 gggm(3)=gggm(3)+ees0mijp*zj
3629 C Derivatives due to the contact function
3630 gacont_hbr(1,num_conti,i)=fprimcont*xj
3631 gacont_hbr(2,num_conti,i)=fprimcont*yj
3632 gacont_hbr(3,num_conti,i)=fprimcont*zj
3635 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3636 c following the change of gradient-summation algorithm.
3638 cgrad ghalfp=0.5D0*gggp(k)
3639 cgrad ghalfm=0.5D0*gggm(k)
3640 gacontp_hb1(k,num_conti,i)=!ghalfp
3641 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3642 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3643 gacontp_hb2(k,num_conti,i)=!ghalfp
3644 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3645 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3646 gacontp_hb3(k,num_conti,i)=gggp(k)
3647 gacontm_hb1(k,num_conti,i)=!ghalfm
3648 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3649 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3650 gacontm_hb2(k,num_conti,i)=!ghalfm
3651 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3652 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3653 gacontm_hb3(k,num_conti,i)=gggm(k)
3655 C Diagnostics. Comment out or remove after debugging!
3657 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3658 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3659 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3660 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3661 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3662 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3665 endif ! num_conti.le.maxconts
3668 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3671 ghalf=0.5d0*agg(l,k)
3672 aggi(l,k)=aggi(l,k)+ghalf
3673 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3674 aggj(l,k)=aggj(l,k)+ghalf
3677 if (j.eq.nres-1 .and. i.lt.j-2) then
3680 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3685 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3688 C-----------------------------------------------------------------------------
3689 subroutine eturn3(i,eello_turn3)
3690 C Third- and fourth-order contributions from turns
3691 implicit real*8 (a-h,o-z)
3692 include 'DIMENSIONS'
3693 include 'COMMON.IOUNITS'
3694 include 'COMMON.GEO'
3695 include 'COMMON.VAR'
3696 include 'COMMON.LOCAL'
3697 include 'COMMON.CHAIN'
3698 include 'COMMON.DERIV'
3699 include 'COMMON.INTERACT'
3700 include 'COMMON.CONTACTS'
3702 include 'COMMON.CONTACTS.MOMENT'
3704 include 'COMMON.TORSION'
3705 include 'COMMON.VECTORS'
3706 include 'COMMON.FFIELD'
3707 include 'COMMON.CONTROL'
3709 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3710 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3711 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3712 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3713 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3714 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3715 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3718 c write (iout,*) "eturn3",i,j,j1,j2
3723 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3725 C Third-order contributions
3732 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3733 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3734 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3735 call transpose2(auxmat(1,1),auxmat1(1,1))
3736 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3737 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3738 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3739 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3740 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3741 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3742 cd & ' eello_turn3_num',4*eello_turn3_num
3743 C Derivatives in gamma(i)
3744 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3745 call transpose2(auxmat2(1,1),auxmat3(1,1))
3746 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3747 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3748 C Derivatives in gamma(i+1)
3749 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3750 call transpose2(auxmat2(1,1),auxmat3(1,1))
3751 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3752 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3753 & +0.5d0*(pizda(1,1)+pizda(2,2))
3754 C Cartesian derivatives
3756 c ghalf1=0.5d0*agg(l,1)
3757 c ghalf2=0.5d0*agg(l,2)
3758 c ghalf3=0.5d0*agg(l,3)
3759 c ghalf4=0.5d0*agg(l,4)
3760 a_temp(1,1)=aggi(l,1)!+ghalf1
3761 a_temp(1,2)=aggi(l,2)!+ghalf2
3762 a_temp(2,1)=aggi(l,3)!+ghalf3
3763 a_temp(2,2)=aggi(l,4)!+ghalf4
3764 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3765 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3766 & +0.5d0*(pizda(1,1)+pizda(2,2))
3767 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3768 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3769 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3770 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3771 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3772 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3773 & +0.5d0*(pizda(1,1)+pizda(2,2))
3774 a_temp(1,1)=aggj(l,1)!+ghalf1
3775 a_temp(1,2)=aggj(l,2)!+ghalf2
3776 a_temp(2,1)=aggj(l,3)!+ghalf3
3777 a_temp(2,2)=aggj(l,4)!+ghalf4
3778 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3779 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3780 & +0.5d0*(pizda(1,1)+pizda(2,2))
3781 a_temp(1,1)=aggj1(l,1)
3782 a_temp(1,2)=aggj1(l,2)
3783 a_temp(2,1)=aggj1(l,3)
3784 a_temp(2,2)=aggj1(l,4)
3785 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3786 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3787 & +0.5d0*(pizda(1,1)+pizda(2,2))
3791 C-------------------------------------------------------------------------------
3792 subroutine eturn4(i,eello_turn4)
3793 C Third- and fourth-order contributions from turns
3794 implicit real*8 (a-h,o-z)
3795 include 'DIMENSIONS'
3796 include 'COMMON.IOUNITS'
3797 include 'COMMON.GEO'
3798 include 'COMMON.VAR'
3799 include 'COMMON.LOCAL'
3800 include 'COMMON.CHAIN'
3801 include 'COMMON.DERIV'
3802 include 'COMMON.INTERACT'
3803 include 'COMMON.CONTACTS'
3805 include 'COMMON.CONTACTS.MOMENT'
3807 include 'COMMON.TORSION'
3808 include 'COMMON.VECTORS'
3809 include 'COMMON.FFIELD'
3810 include 'COMMON.CONTROL'
3812 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3813 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3814 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3815 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3816 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3817 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3818 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3821 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3823 C Fourth-order contributions
3831 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3832 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3833 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3838 iti1=itortyp(itype(i+1))
3839 iti2=itortyp(itype(i+2))
3840 iti3=itortyp(itype(i+3))
3841 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3842 call transpose2(EUg(1,1,i+1),e1t(1,1))
3843 call transpose2(Eug(1,1,i+2),e2t(1,1))
3844 call transpose2(Eug(1,1,i+3),e3t(1,1))
3845 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3846 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3847 s1=scalar2(b1(1,iti2),auxvec(1))
3848 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3849 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3850 s2=scalar2(b1(1,iti1),auxvec(1))
3851 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3852 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3853 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3854 eello_turn4=eello_turn4-(s1+s2+s3)
3855 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3856 & 'eturn4',i,j,-(s1+s2+s3)
3857 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3858 cd & ' eello_turn4_num',8*eello_turn4_num
3859 C Derivatives in gamma(i)
3860 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3861 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3862 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3863 s1=scalar2(b1(1,iti2),auxvec(1))
3864 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3865 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3866 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3867 C Derivatives in gamma(i+1)
3868 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3869 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3870 s2=scalar2(b1(1,iti1),auxvec(1))
3871 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3872 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3873 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3874 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3875 C Derivatives in gamma(i+2)
3876 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3877 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3878 s1=scalar2(b1(1,iti2),auxvec(1))
3879 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3880 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3881 s2=scalar2(b1(1,iti1),auxvec(1))
3882 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3883 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3884 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3885 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3886 C Cartesian derivatives
3887 C Derivatives of this turn contributions in DC(i+2)
3888 if (j.lt.nres-1) then
3890 a_temp(1,1)=agg(l,1)
3891 a_temp(1,2)=agg(l,2)
3892 a_temp(2,1)=agg(l,3)
3893 a_temp(2,2)=agg(l,4)
3894 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3895 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3896 s1=scalar2(b1(1,iti2),auxvec(1))
3897 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3898 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3899 s2=scalar2(b1(1,iti1),auxvec(1))
3900 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3901 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3902 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3904 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3907 C Remaining derivatives of this turn contribution
3909 a_temp(1,1)=aggi(l,1)
3910 a_temp(1,2)=aggi(l,2)
3911 a_temp(2,1)=aggi(l,3)
3912 a_temp(2,2)=aggi(l,4)
3913 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3914 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3915 s1=scalar2(b1(1,iti2),auxvec(1))
3916 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3917 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3918 s2=scalar2(b1(1,iti1),auxvec(1))
3919 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3920 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3921 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3922 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3923 a_temp(1,1)=aggi1(l,1)
3924 a_temp(1,2)=aggi1(l,2)
3925 a_temp(2,1)=aggi1(l,3)
3926 a_temp(2,2)=aggi1(l,4)
3927 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3928 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3929 s1=scalar2(b1(1,iti2),auxvec(1))
3930 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3931 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3932 s2=scalar2(b1(1,iti1),auxvec(1))
3933 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3934 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3935 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3936 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3937 a_temp(1,1)=aggj(l,1)
3938 a_temp(1,2)=aggj(l,2)
3939 a_temp(2,1)=aggj(l,3)
3940 a_temp(2,2)=aggj(l,4)
3941 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3942 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3943 s1=scalar2(b1(1,iti2),auxvec(1))
3944 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3945 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3946 s2=scalar2(b1(1,iti1),auxvec(1))
3947 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3948 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3949 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3950 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3951 a_temp(1,1)=aggj1(l,1)
3952 a_temp(1,2)=aggj1(l,2)
3953 a_temp(2,1)=aggj1(l,3)
3954 a_temp(2,2)=aggj1(l,4)
3955 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3956 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3957 s1=scalar2(b1(1,iti2),auxvec(1))
3958 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3959 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3960 s2=scalar2(b1(1,iti1),auxvec(1))
3961 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3962 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3963 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3964 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3965 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3969 C-----------------------------------------------------------------------------
3970 subroutine vecpr(u,v,w)
3971 implicit real*8(a-h,o-z)
3972 dimension u(3),v(3),w(3)
3973 w(1)=u(2)*v(3)-u(3)*v(2)
3974 w(2)=-u(1)*v(3)+u(3)*v(1)
3975 w(3)=u(1)*v(2)-u(2)*v(1)
3978 C-----------------------------------------------------------------------------
3979 subroutine unormderiv(u,ugrad,unorm,ungrad)
3980 C This subroutine computes the derivatives of a normalized vector u, given
3981 C the derivatives computed without normalization conditions, ugrad. Returns
3984 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3985 double precision vec(3)
3986 double precision scalar
3988 c write (2,*) 'ugrad',ugrad
3991 vec(i)=scalar(ugrad(1,i),u(1))
3993 c write (2,*) 'vec',vec
3996 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3999 c write (2,*) 'ungrad',ungrad
4002 C-----------------------------------------------------------------------------
4003 subroutine escp_soft_sphere(evdw2,evdw2_14)
4005 C This subroutine calculates the excluded-volume interaction energy between
4006 C peptide-group centers and side chains and its gradient in virtual-bond and
4007 C side-chain vectors.
4009 implicit real*8 (a-h,o-z)
4010 include 'DIMENSIONS'
4011 include 'COMMON.GEO'
4012 include 'COMMON.VAR'
4013 include 'COMMON.LOCAL'
4014 include 'COMMON.CHAIN'
4015 include 'COMMON.DERIV'
4016 include 'COMMON.INTERACT'
4017 include 'COMMON.FFIELD'
4018 include 'COMMON.IOUNITS'
4019 include 'COMMON.CONTROL'
4024 cd print '(a)','Enter ESCP'
4025 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4026 do i=iatscp_s,iatscp_e
4028 xi=0.5D0*(c(1,i)+c(1,i+1))
4029 yi=0.5D0*(c(2,i)+c(2,i+1))
4030 zi=0.5D0*(c(3,i)+c(3,i+1))
4032 do iint=1,nscp_gr(i)
4034 do j=iscpstart(i,iint),iscpend(i,iint)
4036 C Uncomment following three lines for SC-p interactions
4040 C Uncomment following three lines for Ca-p interactions
4044 rij=xj*xj+yj*yj+zj*zj
4047 if (rij.lt.r0ijsq) then
4048 evdwij=0.25d0*(rij-r0ijsq)**2
4056 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4061 cgrad if (j.lt.i) then
4062 cd write (iout,*) 'j<i'
4063 C Uncomment following three lines for SC-p interactions
4065 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4068 cd write (iout,*) 'j>i'
4070 cgrad ggg(k)=-ggg(k)
4071 C Uncomment following line for SC-p interactions
4072 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4076 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4078 cgrad kstart=min0(i+1,j)
4079 cgrad kend=max0(i-1,j-1)
4080 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4081 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4082 cgrad do k=kstart,kend
4084 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4088 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4089 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4097 C-----------------------------------------------------------------------------
4098 subroutine escp(evdw2,evdw2_14)
4100 C This subroutine calculates the excluded-volume interaction energy between
4101 C peptide-group centers and side chains and its gradient in virtual-bond and
4102 C side-chain vectors.
4104 implicit real*8 (a-h,o-z)
4105 include 'DIMENSIONS'
4106 include 'COMMON.GEO'
4107 include 'COMMON.VAR'
4108 include 'COMMON.LOCAL'
4109 include 'COMMON.CHAIN'
4110 include 'COMMON.DERIV'
4111 include 'COMMON.INTERACT'
4112 include 'COMMON.FFIELD'
4113 include 'COMMON.IOUNITS'
4114 include 'COMMON.CONTROL'
4118 cd print '(a)','Enter ESCP'
4119 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4120 do i=iatscp_s,iatscp_e
4122 xi=0.5D0*(c(1,i)+c(1,i+1))
4123 yi=0.5D0*(c(2,i)+c(2,i+1))
4124 zi=0.5D0*(c(3,i)+c(3,i+1))
4126 do iint=1,nscp_gr(i)
4128 do j=iscpstart(i,iint),iscpend(i,iint)
4130 C Uncomment following three lines for SC-p interactions
4134 C Uncomment following three lines for Ca-p interactions
4138 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4140 e1=fac*fac*aad(itypj,iteli)
4141 e2=fac*bad(itypj,iteli)
4142 if (iabs(j-i) .le. 2) then
4145 evdw2_14=evdw2_14+e1+e2
4149 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4150 & 'evdw2',i,j,evdwij
4152 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4154 fac=-(evdwij+e1)*rrij
4158 cgrad if (j.lt.i) then
4159 cd write (iout,*) 'j<i'
4160 C Uncomment following three lines for SC-p interactions
4162 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4165 cd write (iout,*) 'j>i'
4167 cgrad ggg(k)=-ggg(k)
4168 C Uncomment following line for SC-p interactions
4169 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4170 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4174 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4176 cgrad kstart=min0(i+1,j)
4177 cgrad kend=max0(i-1,j-1)
4178 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4179 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4180 cgrad do k=kstart,kend
4182 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4186 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4187 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4195 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4196 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4197 gradx_scp(j,i)=expon*gradx_scp(j,i)
4200 C******************************************************************************
4204 C To save time the factor EXPON has been extracted from ALL components
4205 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4208 C******************************************************************************
4211 C--------------------------------------------------------------------------
4212 subroutine edis(ehpb)
4214 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4216 implicit real*8 (a-h,o-z)
4217 include 'DIMENSIONS'
4218 include 'COMMON.SBRIDGE'
4219 include 'COMMON.CHAIN'
4220 include 'COMMON.DERIV'
4221 include 'COMMON.VAR'
4222 include 'COMMON.INTERACT'
4223 include 'COMMON.IOUNITS'
4226 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4227 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4228 if (link_end.eq.0) return
4229 do i=link_start,link_end
4230 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4231 C CA-CA distance used in regularization of structure.
4234 C iii and jjj point to the residues for which the distance is assigned.
4235 if (ii.gt.nres) then
4242 cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj
4243 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4244 C distance and angle dependent SS bond potential.
4245 if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4246 call ssbond_ene(iii,jjj,eij)
4248 cd write (iout,*) "eij",eij
4250 C Calculate the distance between the two points and its difference from the
4254 C Get the force constant corresponding to this distance.
4256 C Calculate the contribution to energy.
4257 ehpb=ehpb+waga*rdis*rdis
4259 C Evaluate gradient.
4262 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4263 cd & ' waga=',waga,' fac=',fac
4265 ggg(j)=fac*(c(j,jj)-c(j,ii))
4267 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4268 C If this is a SC-SC distance, we need to calculate the contributions to the
4269 C Cartesian gradient in the SC vectors (ghpbx).
4272 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4273 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4276 cgrad do j=iii,jjj-1
4278 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4282 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4283 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4290 C--------------------------------------------------------------------------
4291 subroutine ssbond_ene(i,j,eij)
4293 C Calculate the distance and angle dependent SS-bond potential energy
4294 C using a free-energy function derived based on RHF/6-31G** ab initio
4295 C calculations of diethyl disulfide.
4297 C A. Liwo and U. Kozlowska, 11/24/03
4299 implicit real*8 (a-h,o-z)
4300 include 'DIMENSIONS'
4301 include 'COMMON.SBRIDGE'
4302 include 'COMMON.CHAIN'
4303 include 'COMMON.DERIV'
4304 include 'COMMON.LOCAL'
4305 include 'COMMON.INTERACT'
4306 include 'COMMON.VAR'
4307 include 'COMMON.IOUNITS'
4308 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4313 dxi=dc_norm(1,nres+i)
4314 dyi=dc_norm(2,nres+i)
4315 dzi=dc_norm(3,nres+i)
4316 c dsci_inv=dsc_inv(itypi)
4317 dsci_inv=vbld_inv(nres+i)
4319 c dscj_inv=dsc_inv(itypj)
4320 dscj_inv=vbld_inv(nres+j)
4324 dxj=dc_norm(1,nres+j)
4325 dyj=dc_norm(2,nres+j)
4326 dzj=dc_norm(3,nres+j)
4327 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4332 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4333 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4334 om12=dxi*dxj+dyi*dyj+dzi*dzj
4336 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4337 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4343 deltat12=om2-om1+2.0d0
4345 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4346 & +akct*deltad*deltat12
4347 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4348 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4349 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4350 c & " deltat12",deltat12," eij",eij
4351 ed=2*akcm*deltad+akct*deltat12
4353 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4354 eom1=-2*akth*deltat1-pom1-om2*pom2
4355 eom2= 2*akth*deltat2+pom1-om1*pom2
4358 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4359 ghpbx(k,i)=ghpbx(k,i)-ggk
4360 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4361 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4362 ghpbx(k,j)=ghpbx(k,j)+ggk
4363 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4364 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4365 ghpbc(k,i)=ghpbc(k,i)-ggk
4366 ghpbc(k,j)=ghpbc(k,j)+ggk
4369 C Calculate the components of the gradient in DC and X
4373 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4378 C--------------------------------------------------------------------------
4379 subroutine ebond(estr)
4381 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4383 implicit real*8 (a-h,o-z)
4384 include 'DIMENSIONS'
4385 include 'COMMON.LOCAL'
4386 include 'COMMON.GEO'
4387 include 'COMMON.INTERACT'
4388 include 'COMMON.DERIV'
4389 include 'COMMON.VAR'
4390 include 'COMMON.CHAIN'
4391 include 'COMMON.IOUNITS'
4392 include 'COMMON.NAMES'
4393 include 'COMMON.FFIELD'
4394 include 'COMMON.CONTROL'
4395 include 'COMMON.SETUP'
4396 double precision u(3),ud(3)
4398 do i=ibondp_start,ibondp_end
4399 diff = vbld(i)-vbldp0
4400 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4403 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4405 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4409 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4411 do i=ibond_start,ibond_end
4416 diff=vbld(i+nres)-vbldsc0(1,iti)
4417 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4418 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4419 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4421 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4425 diff=vbld(i+nres)-vbldsc0(j,iti)
4426 ud(j)=aksc(j,iti)*diff
4427 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4441 uprod2=uprod2*u(k)*u(k)
4445 usumsqder=usumsqder+ud(j)*uprod2
4447 estr=estr+uprod/usum
4449 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4457 C--------------------------------------------------------------------------
4458 subroutine ebend(etheta)
4460 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4461 C angles gamma and its derivatives in consecutive thetas and gammas.
4463 implicit real*8 (a-h,o-z)
4464 include 'DIMENSIONS'
4465 include 'COMMON.LOCAL'
4466 include 'COMMON.GEO'
4467 include 'COMMON.INTERACT'
4468 include 'COMMON.DERIV'
4469 include 'COMMON.VAR'
4470 include 'COMMON.CHAIN'
4471 include 'COMMON.IOUNITS'
4472 include 'COMMON.NAMES'
4473 include 'COMMON.FFIELD'
4474 include 'COMMON.CONTROL'
4475 common /calcthet/ term1,term2,termm,diffak,ratak,
4476 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4477 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4478 double precision y(2),z(2)
4480 c time11=dexp(-2*time)
4483 c write (*,'(a,i2)') 'EBEND ICG=',icg
4484 do i=ithet_start,ithet_end
4485 C Zero the energy function and its derivative at 0 or pi.
4486 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4488 ichir1=isign(1,itype(i-2))
4489 ichir2=isign(1,itype(i))
4490 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4491 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4492 if (itype(i-1).eq.10) then
4493 itype1=isign(10,itype(i-2))
4494 ichir11=isign(1,itype(i-2))
4495 ichir12=isign(1,itype(i-2))
4496 itype2=isign(10,itype(i))
4497 ichir21=isign(1,itype(i))
4498 ichir22=isign(1,itype(i))
4503 if (phii.ne.phii) phii=150.0
4516 if (phii1.ne.phii1) phii1=150.0
4528 C Calculate the "mean" value of theta from the part of the distribution
4529 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4530 C In following comments this theta will be referred to as t_c.
4531 thet_pred_mean=0.0d0
4533 athetk=athet(k,it,ichir1,ichir2)
4534 bthetk=bthet(k,it,ichir1,ichir2)
4536 athetk=athet(k,itype1,ichir11,ichir12)
4537 bthetk=bthet(k,itype2,ichir21,ichir22)
4539 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4541 dthett=thet_pred_mean*ssd
4542 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4543 C Derivatives of the "mean" values in gamma1 and gamma2.
4544 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4545 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4546 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4547 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
4549 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
4550 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
4551 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
4552 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
4554 if (theta(i).gt.pi-delta) then
4555 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4557 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4558 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4559 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4561 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4563 else if (theta(i).lt.delta) then
4564 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4565 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4566 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4568 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4569 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4572 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4575 etheta=etheta+ethetai
4576 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4578 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4579 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4580 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4582 C Ufff.... We've done all this!!!
4585 C---------------------------------------------------------------------------
4586 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4588 implicit real*8 (a-h,o-z)
4589 include 'DIMENSIONS'
4590 include 'COMMON.LOCAL'
4591 include 'COMMON.IOUNITS'
4592 common /calcthet/ term1,term2,termm,diffak,ratak,
4593 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4594 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4595 C Calculate the contributions to both Gaussian lobes.
4596 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4597 C The "polynomial part" of the "standard deviation" of this part of
4601 sig=sig*thet_pred_mean+polthet(j,it)
4603 C Derivative of the "interior part" of the "standard deviation of the"
4604 C gamma-dependent Gaussian lobe in t_c.
4605 sigtc=3*polthet(3,it)
4607 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4610 C Set the parameters of both Gaussian lobes of the distribution.
4611 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4612 fac=sig*sig+sigc0(it)
4615 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4616 sigsqtc=-4.0D0*sigcsq*sigtc
4617 c print *,i,sig,sigtc,sigsqtc
4618 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4619 sigtc=-sigtc/(fac*fac)
4620 C Following variable is sigma(t_c)**(-2)
4621 sigcsq=sigcsq*sigcsq
4623 sig0inv=1.0D0/sig0i**2
4624 delthec=thetai-thet_pred_mean
4625 delthe0=thetai-theta0i
4626 term1=-0.5D0*sigcsq*delthec*delthec
4627 term2=-0.5D0*sig0inv*delthe0*delthe0
4628 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4629 C NaNs in taking the logarithm. We extract the largest exponent which is added
4630 C to the energy (this being the log of the distribution) at the end of energy
4631 C term evaluation for this virtual-bond angle.
4632 if (term1.gt.term2) then
4634 term2=dexp(term2-termm)
4638 term1=dexp(term1-termm)
4641 C The ratio between the gamma-independent and gamma-dependent lobes of
4642 C the distribution is a Gaussian function of thet_pred_mean too.
4643 diffak=gthet(2,it)-thet_pred_mean
4644 ratak=diffak/gthet(3,it)**2
4645 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4646 C Let's differentiate it in thet_pred_mean NOW.
4648 C Now put together the distribution terms to make complete distribution.
4649 termexp=term1+ak*term2
4650 termpre=sigc+ak*sig0i
4651 C Contribution of the bending energy from this theta is just the -log of
4652 C the sum of the contributions from the two lobes and the pre-exponential
4653 C factor. Simple enough, isn't it?
4654 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4655 C NOW the derivatives!!!
4656 C 6/6/97 Take into account the deformation.
4657 E_theta=(delthec*sigcsq*term1
4658 & +ak*delthe0*sig0inv*term2)/termexp
4659 E_tc=((sigtc+aktc*sig0i)/termpre
4660 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4661 & aktc*term2)/termexp)
4664 c-----------------------------------------------------------------------------
4665 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4666 implicit real*8 (a-h,o-z)
4667 include 'DIMENSIONS'
4668 include 'COMMON.LOCAL'
4669 include 'COMMON.IOUNITS'
4670 common /calcthet/ term1,term2,termm,diffak,ratak,
4671 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4672 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4673 delthec=thetai-thet_pred_mean
4674 delthe0=thetai-theta0i
4675 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4676 t3 = thetai-thet_pred_mean
4680 t14 = t12+t6*sigsqtc
4682 t21 = thetai-theta0i
4688 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4689 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4690 & *(-t12*t9-ak*sig0inv*t27)
4694 C--------------------------------------------------------------------------
4695 subroutine ebend(etheta)
4697 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4698 C angles gamma and its derivatives in consecutive thetas and gammas.
4699 C ab initio-derived potentials from
4700 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4702 implicit real*8 (a-h,o-z)
4703 include 'DIMENSIONS'
4704 include 'COMMON.LOCAL'
4705 include 'COMMON.GEO'
4706 include 'COMMON.INTERACT'
4707 include 'COMMON.DERIV'
4708 include 'COMMON.VAR'
4709 include 'COMMON.CHAIN'
4710 include 'COMMON.IOUNITS'
4711 include 'COMMON.NAMES'
4712 include 'COMMON.FFIELD'
4713 include 'COMMON.CONTROL'
4714 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4715 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4716 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4717 & sinph1ph2(maxdouble,maxdouble)
4718 logical lprn /.false./, lprn1 /.false./
4720 do i=ithet_start,ithet_end
4724 theti2=0.5d0*theta(i)
4725 ityp2=ithetyp(itype(i-1))
4727 coskt(k)=dcos(k*theti2)
4728 sinkt(k)=dsin(k*theti2)
4733 if (phii.ne.phii) phii=150.0
4737 ityp1=ithetyp(itype(i-2))
4739 cosph1(k)=dcos(k*phii)
4740 sinph1(k)=dsin(k*phii)
4753 if (phii1.ne.phii1) phii1=150.0
4758 ityp3=ithetyp(itype(i))
4760 cosph2(k)=dcos(k*phii1)
4761 sinph2(k)=dsin(k*phii1)
4771 ethetai=aa0thet(ityp1,ityp2,ityp3)
4774 ccl=cosph1(l)*cosph2(k-l)
4775 ssl=sinph1(l)*sinph2(k-l)
4776 scl=sinph1(l)*cosph2(k-l)
4777 csl=cosph1(l)*sinph2(k-l)
4778 cosph1ph2(l,k)=ccl-ssl
4779 cosph1ph2(k,l)=ccl+ssl
4780 sinph1ph2(l,k)=scl+csl
4781 sinph1ph2(k,l)=scl-csl
4785 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4786 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4787 write (iout,*) "coskt and sinkt"
4789 write (iout,*) k,coskt(k),sinkt(k)
4793 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4794 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4797 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4798 & " ethetai",ethetai
4801 write (iout,*) "cosph and sinph"
4803 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4805 write (iout,*) "cosph1ph2 and sinph2ph2"
4808 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4809 & sinph1ph2(l,k),sinph1ph2(k,l)
4812 write(iout,*) "ethetai",ethetai
4816 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4817 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4818 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4819 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4820 ethetai=ethetai+sinkt(m)*aux
4821 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4822 dephii=dephii+k*sinkt(m)*(
4823 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4824 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4825 dephii1=dephii1+k*sinkt(m)*(
4826 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4827 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4829 & write (iout,*) "m",m," k",k," bbthet",
4830 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4831 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4832 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4833 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4837 & write(iout,*) "ethetai",ethetai
4841 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4842 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4843 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4844 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4845 ethetai=ethetai+sinkt(m)*aux
4846 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4847 dephii=dephii+l*sinkt(m)*(
4848 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4849 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4850 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4851 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4852 dephii1=dephii1+(k-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))
4858 write (iout,*) "m",m," k",k," l",l," ffthet",
4859 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4860 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4861 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4862 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4863 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4864 & cosph1ph2(k,l)*sinkt(m),
4865 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4871 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4872 & i,theta(i)*rad2deg,phii*rad2deg,
4873 & phii1*rad2deg,ethetai
4874 etheta=etheta+ethetai
4875 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4876 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4877 gloc(nphi+i-2,icg)=wang*dethetai
4883 c-----------------------------------------------------------------------------
4884 subroutine esc(escloc)
4885 C Calculate the local energy of a side chain and its derivatives in the
4886 C corresponding virtual-bond valence angles THETA and the spherical angles
4888 implicit real*8 (a-h,o-z)
4889 include 'DIMENSIONS'
4890 include 'COMMON.GEO'
4891 include 'COMMON.LOCAL'
4892 include 'COMMON.VAR'
4893 include 'COMMON.INTERACT'
4894 include 'COMMON.DERIV'
4895 include 'COMMON.CHAIN'
4896 include 'COMMON.IOUNITS'
4897 include 'COMMON.NAMES'
4898 include 'COMMON.FFIELD'
4899 include 'COMMON.CONTROL'
4900 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4901 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4902 common /sccalc/ time11,time12,time112,theti,it,nlobit
4905 c write (iout,'(a)') 'ESC'
4906 do i=loc_start,loc_end
4908 if (it.eq.10) goto 1
4910 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4911 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4912 theti=theta(i+1)-pipol
4917 if (x(2).gt.pi-delta) then
4921 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4923 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4924 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4926 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4927 & ddersc0(1),dersc(1))
4928 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4929 & ddersc0(3),dersc(3))
4931 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4933 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4934 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4935 & dersc0(2),esclocbi,dersc02)
4936 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4938 call splinthet(x(2),0.5d0*delta,ss,ssd)
4943 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4945 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4946 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4948 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4950 c write (iout,*) escloci
4951 else if (x(2).lt.delta) then
4955 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4957 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4958 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4960 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4961 & ddersc0(1),dersc(1))
4962 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4963 & ddersc0(3),dersc(3))
4965 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4967 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4968 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4969 & dersc0(2),esclocbi,dersc02)
4970 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4975 call splinthet(x(2),0.5d0*delta,ss,ssd)
4977 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4979 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4980 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4982 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4983 c write (iout,*) escloci
4985 call enesc(x,escloci,dersc,ddummy,.false.)
4988 escloc=escloc+escloci
4989 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4990 & 'escloc',i,escloci
4991 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4993 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4995 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4996 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5001 C---------------------------------------------------------------------------
5002 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5003 implicit real*8 (a-h,o-z)
5004 include 'DIMENSIONS'
5005 include 'COMMON.GEO'
5006 include 'COMMON.LOCAL'
5007 include 'COMMON.IOUNITS'
5008 common /sccalc/ time11,time12,time112,theti,it,nlobit
5009 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5010 double precision contr(maxlob,-1:1)
5012 c write (iout,*) 'it=',it,' nlobit=',nlobit
5016 if (mixed) ddersc(j)=0.0d0
5020 C Because of periodicity of the dependence of the SC energy in omega we have
5021 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5022 C To avoid underflows, first compute & store the exponents.
5030 z(k)=x(k)-censc(k,j,it)
5035 Axk=Axk+gaussc(l,k,j,it)*z(l)
5041 expfac=expfac+Ax(k,j,iii)*z(k)
5049 C As in the case of ebend, we want to avoid underflows in exponentiation and
5050 C subsequent NaNs and INFs in energy calculation.
5051 C Find the largest exponent
5055 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5059 cd print *,'it=',it,' emin=',emin
5061 C Compute the contribution to SC energy and derivatives
5066 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
5067 if(adexp.ne.adexp) adexp=1.0
5070 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
5072 cd print *,'j=',j,' expfac=',expfac
5073 escloc_i=escloc_i+expfac
5075 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5079 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5080 & +gaussc(k,2,j,it))*expfac
5087 dersc(1)=dersc(1)/cos(theti)**2
5088 ddersc(1)=ddersc(1)/cos(theti)**2
5091 escloci=-(dlog(escloc_i)-emin)
5093 dersc(j)=dersc(j)/escloc_i
5097 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5102 C------------------------------------------------------------------------------
5103 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5104 implicit real*8 (a-h,o-z)
5105 include 'DIMENSIONS'
5106 include 'COMMON.GEO'
5107 include 'COMMON.LOCAL'
5108 include 'COMMON.IOUNITS'
5109 common /sccalc/ time11,time12,time112,theti,it,nlobit
5110 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5111 double precision contr(maxlob)
5122 z(k)=x(k)-censc(k,j,it)
5128 Axk=Axk+gaussc(l,k,j,it)*z(l)
5134 expfac=expfac+Ax(k,j)*z(k)
5139 C As in the case of ebend, we want to avoid underflows in exponentiation and
5140 C subsequent NaNs and INFs in energy calculation.
5141 C Find the largest exponent
5144 if (emin.gt.contr(j)) emin=contr(j)
5148 C Compute the contribution to SC energy and derivatives
5152 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
5153 escloc_i=escloc_i+expfac
5155 dersc(k)=dersc(k)+Ax(k,j)*expfac
5157 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5158 & +gaussc(1,2,j,it))*expfac
5162 dersc(1)=dersc(1)/cos(theti)**2
5163 dersc12=dersc12/cos(theti)**2
5164 escloci=-(dlog(escloc_i)-emin)
5166 dersc(j)=dersc(j)/escloc_i
5168 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5172 c----------------------------------------------------------------------------------
5173 subroutine esc(escloc)
5174 C Calculate the local energy of a side chain and its derivatives in the
5175 C corresponding virtual-bond valence angles THETA and the spherical angles
5176 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5177 C added by Urszula Kozlowska. 07/11/2007
5179 implicit real*8 (a-h,o-z)
5180 include 'DIMENSIONS'
5181 include 'COMMON.GEO'
5182 include 'COMMON.LOCAL'
5183 include 'COMMON.VAR'
5184 include 'COMMON.SCROT'
5185 include 'COMMON.INTERACT'
5186 include 'COMMON.DERIV'
5187 include 'COMMON.CHAIN'
5188 include 'COMMON.IOUNITS'
5189 include 'COMMON.NAMES'
5190 include 'COMMON.FFIELD'
5191 include 'COMMON.CONTROL'
5192 include 'COMMON.VECTORS'
5193 double precision x_prime(3),y_prime(3),z_prime(3)
5194 & , sumene,dsc_i,dp2_i,x(65),
5195 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5196 & de_dxx,de_dyy,de_dzz,de_dt
5197 double precision s1_t,s1_6_t,s2_t,s2_6_t
5199 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5200 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5201 & dt_dCi(3),dt_dCi1(3)
5202 common /sccalc/ time11,time12,time112,theti,it,nlobit
5205 do i=loc_start,loc_end
5206 costtab(i+1) =dcos(theta(i+1))
5207 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5208 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5209 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5210 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5211 cosfac=dsqrt(cosfac2)
5212 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5213 sinfac=dsqrt(sinfac2)
5215 if (it.eq.10) goto 1
5217 C Compute the axes of tghe local cartesian coordinates system; store in
5218 c x_prime, y_prime and z_prime
5225 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5226 C & dc_norm(3,i+nres)
5228 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5229 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5232 z_prime(j) = -uz(j,i-1)
5235 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5236 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5237 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5238 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5239 c & " xy",scalar(x_prime(1),y_prime(1)),
5240 c & " xz",scalar(x_prime(1),z_prime(1)),
5241 c & " yy",scalar(y_prime(1),y_prime(1)),
5242 c & " yz",scalar(y_prime(1),z_prime(1)),
5243 c & " zz",scalar(z_prime(1),z_prime(1))
5245 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5246 C to local coordinate system. Store in xx, yy, zz.
5252 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5253 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5254 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5261 C Compute the energy of the ith side cbain
5263 c write (2,*) "xx",xx," yy",yy," zz",zz
5266 x(j) = sc_parmin(j,it)
5269 Cc diagnostics - remove later
5271 yy1 = dsin(alph(2))*dcos(omeg(2))
5272 zz1 = -dsin(alph(2))*dsin(omeg(2))
5273 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5274 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5276 C," --- ", xx_w,yy_w,zz_w
5279 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5280 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5282 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5283 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5285 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5286 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5287 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5288 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5289 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5291 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5292 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5293 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5294 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5295 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5297 dsc_i = 0.743d0+x(61)
5299 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5300 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5301 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5302 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5303 s1=(1+x(63))/(0.1d0 + dscp1)
5304 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5305 s2=(1+x(65))/(0.1d0 + dscp2)
5306 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5307 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5308 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5309 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5311 c & dscp1,dscp2,sumene
5312 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5313 escloc = escloc + sumene
5314 c write (2,*) "i",i," escloc",sumene,escloc
5317 C This section to check the numerical derivatives of the energy of ith side
5318 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5319 C #define DEBUG in the code to turn it on.
5321 write (2,*) "sumene =",sumene
5325 write (2,*) xx,yy,zz
5326 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5327 de_dxx_num=(sumenep-sumene)/aincr
5329 write (2,*) "xx+ sumene from enesc=",sumenep
5332 write (2,*) xx,yy,zz
5333 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5334 de_dyy_num=(sumenep-sumene)/aincr
5336 write (2,*) "yy+ sumene from enesc=",sumenep
5339 write (2,*) xx,yy,zz
5340 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5341 de_dzz_num=(sumenep-sumene)/aincr
5343 write (2,*) "zz+ sumene from enesc=",sumenep
5344 costsave=cost2tab(i+1)
5345 sintsave=sint2tab(i+1)
5346 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5347 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5348 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5349 de_dt_num=(sumenep-sumene)/aincr
5350 write (2,*) " t+ sumene from enesc=",sumenep
5351 cost2tab(i+1)=costsave
5352 sint2tab(i+1)=sintsave
5353 C End of diagnostics section.
5356 C Compute the gradient of esc
5358 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5359 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5360 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5361 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5362 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5363 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5364 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5365 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5366 pom1=(sumene3*sint2tab(i+1)+sumene1)
5367 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5368 pom2=(sumene4*cost2tab(i+1)+sumene2)
5369 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5370 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5371 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5372 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5374 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5375 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5376 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5378 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5379 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5380 & +(pom1+pom2)*pom_dx
5382 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5385 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5386 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5387 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5389 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5390 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5391 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5392 & +x(59)*zz**2 +x(60)*xx*zz
5393 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5394 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5395 & +(pom1-pom2)*pom_dy
5397 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5400 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5401 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5402 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5403 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5404 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5405 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5406 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5407 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5409 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5412 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5413 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5414 & +pom1*pom_dt1+pom2*pom_dt2
5416 write(2,*), "de_dt = ", de_dt,de_dt_num
5420 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5421 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5422 cosfac2xx=cosfac2*xx
5423 sinfac2yy=sinfac2*yy
5425 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5427 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5429 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5430 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5431 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5432 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5433 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5434 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5435 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5436 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5437 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5438 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5442 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5443 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5446 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5447 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5448 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5450 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5451 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5455 dXX_Ctab(k,i)=dXX_Ci(k)
5456 dXX_C1tab(k,i)=dXX_Ci1(k)
5457 dYY_Ctab(k,i)=dYY_Ci(k)
5458 dYY_C1tab(k,i)=dYY_Ci1(k)
5459 dZZ_Ctab(k,i)=dZZ_Ci(k)
5460 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5461 dXX_XYZtab(k,i)=dXX_XYZ(k)
5462 dYY_XYZtab(k,i)=dYY_XYZ(k)
5463 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5467 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5468 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5469 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5470 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5471 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5473 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5474 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5475 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5476 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5477 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5478 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5479 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5480 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5482 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5483 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5485 C to check gradient call subroutine check_grad
5491 c------------------------------------------------------------------------------
5492 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5494 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5495 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5496 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5497 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5499 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5500 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5502 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5503 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5504 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5505 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5506 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5508 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5509 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5510 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5511 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5512 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5514 dsc_i = 0.743d0+x(61)
5516 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5517 & *(xx*cost2+yy*sint2))
5518 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5519 & *(xx*cost2-yy*sint2))
5520 s1=(1+x(63))/(0.1d0 + dscp1)
5521 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5522 s2=(1+x(65))/(0.1d0 + dscp2)
5523 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5524 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5525 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5530 c------------------------------------------------------------------------------
5531 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5533 C This procedure calculates two-body contact function g(rij) and its derivative:
5536 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5539 C where x=(rij-r0ij)/delta
5541 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5544 double precision rij,r0ij,eps0ij,fcont,fprimcont
5545 double precision x,x2,x4,delta
5549 if (x.lt.-1.0D0) then
5552 else if (x.le.1.0D0) then
5555 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5556 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5563 c------------------------------------------------------------------------------
5564 subroutine splinthet(theti,delta,ss,ssder)
5565 implicit real*8 (a-h,o-z)
5566 include 'DIMENSIONS'
5567 include 'COMMON.VAR'
5568 include 'COMMON.GEO'
5571 if (theti.gt.pipol) then
5572 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5574 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5579 c------------------------------------------------------------------------------
5580 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5582 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5583 double precision ksi,ksi2,ksi3,a1,a2,a3
5584 a1=fprim0*delta/(f1-f0)
5590 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5591 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5594 c------------------------------------------------------------------------------
5595 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5597 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5598 double precision ksi,ksi2,ksi3,a1,a2,a3
5603 a2=3*(f1x-f0x)-2*fprim0x*delta
5604 a3=fprim0x*delta-2*(f1x-f0x)
5605 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5608 C-----------------------------------------------------------------------------
5610 C-----------------------------------------------------------------------------
5611 subroutine etor(etors,edihcnstr)
5612 implicit real*8 (a-h,o-z)
5613 include 'DIMENSIONS'
5614 include 'COMMON.VAR'
5615 include 'COMMON.GEO'
5616 include 'COMMON.LOCAL'
5617 include 'COMMON.TORSION'
5618 include 'COMMON.INTERACT'
5619 include 'COMMON.DERIV'
5620 include 'COMMON.CHAIN'
5621 include 'COMMON.NAMES'
5622 include 'COMMON.IOUNITS'
5623 include 'COMMON.FFIELD'
5624 include 'COMMON.TORCNSTR'
5625 include 'COMMON.CONTROL'
5627 C Set lprn=.true. for debugging
5631 do i=iphi_start,iphi_end
5633 itori=itortyp(itype(i-2))
5634 itori1=itortyp(itype(i-1))
5637 C Proline-Proline pair is a special case...
5638 if (itori.eq.3 .and. itori1.eq.3) then
5639 if (phii.gt.-dwapi3) then
5641 fac=1.0D0/(1.0D0-cosphi)
5642 etorsi=v1(1,3,3)*fac
5643 etorsi=etorsi+etorsi
5644 etors=etors+etorsi-v1(1,3,3)
5645 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5646 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5649 v1ij=v1(j+1,itori,itori1)
5650 v2ij=v2(j+1,itori,itori1)
5653 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5654 if (energy_dec) etors_ii=etors_ii+
5655 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5656 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5660 v1ij=v1(j,itori,itori1)
5661 v2ij=v2(j,itori,itori1)
5664 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5665 if (energy_dec) etors_ii=etors_ii+
5666 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5667 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5670 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5673 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5674 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5675 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5676 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5677 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5679 ! 6/20/98 - dihedral angle constraints
5682 itori=idih_constr(i)
5685 if (difi.gt.drange(i)) then
5687 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5688 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5689 else if (difi.lt.-drange(i)) then
5691 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5692 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5694 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5695 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5697 ! write (iout,*) 'edihcnstr',edihcnstr
5700 c------------------------------------------------------------------------------
5701 subroutine etor_d(etors_d)
5705 c----------------------------------------------------------------------------
5707 subroutine etor(etors,edihcnstr)
5708 implicit real*8 (a-h,o-z)
5709 include 'DIMENSIONS'
5710 include 'COMMON.VAR'
5711 include 'COMMON.GEO'
5712 include 'COMMON.LOCAL'
5713 include 'COMMON.TORSION'
5714 include 'COMMON.INTERACT'
5715 include 'COMMON.DERIV'
5716 include 'COMMON.CHAIN'
5717 include 'COMMON.NAMES'
5718 include 'COMMON.IOUNITS'
5719 include 'COMMON.FFIELD'
5720 include 'COMMON.TORCNSTR'
5721 include 'COMMON.CONTROL'
5723 C Set lprn=.true. for debugging
5727 do i=iphi_start,iphi_end
5729 itori=itortyp(itype(i-2))
5730 itori1=itortyp(itype(i-1))
5733 C Regular cosine and sine terms
5734 do j=1,nterm(itori,itori1)
5735 v1ij=v1(j,itori,itori1)
5736 v2ij=v2(j,itori,itori1)
5739 etors=etors+v1ij*cosphi+v2ij*sinphi
5740 if (energy_dec) etors_ii=etors_ii+
5741 & v1ij*cosphi+v2ij*sinphi
5742 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5746 C E = SUM ----------------------------------- - v1
5747 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5749 cosphi=dcos(0.5d0*phii)
5750 sinphi=dsin(0.5d0*phii)
5751 do j=1,nlor(itori,itori1)
5752 vl1ij=vlor1(j,itori,itori1)
5753 vl2ij=vlor2(j,itori,itori1)
5754 vl3ij=vlor3(j,itori,itori1)
5755 pom=vl2ij*cosphi+vl3ij*sinphi
5756 pom1=1.0d0/(pom*pom+1.0d0)
5757 etors=etors+vl1ij*pom1
5758 if (energy_dec) etors_ii=etors_ii+
5761 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5763 C Subtract the constant term
5764 etors=etors-v0(itori,itori1)
5765 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5766 & 'etor',i,etors_ii-v0(itori,itori1)
5768 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5769 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5770 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5771 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5772 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5774 ! 6/20/98 - dihedral angle constraints
5776 c do i=1,ndih_constr
5777 do i=idihconstr_start,idihconstr_end
5778 itori=idih_constr(i)
5780 difi=pinorm(phii-phi0(i))
5781 if (difi.gt.drange(i)) then
5783 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5784 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5785 else if (difi.lt.-drange(i)) then
5787 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5788 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5792 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5793 cd & rad2deg*phi0(i), rad2deg*drange(i),
5794 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5796 cd write (iout,*) 'edihcnstr',edihcnstr
5799 c----------------------------------------------------------------------------
5800 subroutine etor_d(etors_d)
5801 C 6/23/01 Compute double torsional energy
5802 implicit real*8 (a-h,o-z)
5803 include 'DIMENSIONS'
5804 include 'COMMON.VAR'
5805 include 'COMMON.GEO'
5806 include 'COMMON.LOCAL'
5807 include 'COMMON.TORSION'
5808 include 'COMMON.INTERACT'
5809 include 'COMMON.DERIV'
5810 include 'COMMON.CHAIN'
5811 include 'COMMON.NAMES'
5812 include 'COMMON.IOUNITS'
5813 include 'COMMON.FFIELD'
5814 include 'COMMON.TORCNSTR'
5816 C Set lprn=.true. for debugging
5820 do i=iphid_start,iphid_end
5821 itori=itortyp(itype(i-2))
5822 itori1=itortyp(itype(i-1))
5823 itori2=itortyp(itype(i))
5825 if (iabs(itype(i+1)).eq.20) iblock=2
5830 C Regular cosine and sine terms
5831 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5832 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5833 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5834 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5835 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5836 cosphi1=dcos(j*phii)
5837 sinphi1=dsin(j*phii)
5838 cosphi2=dcos(j*phii1)
5839 sinphi2=dsin(j*phii1)
5840 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5841 & v2cij*cosphi2+v2sij*sinphi2
5842 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5843 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5845 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5847 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5848 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5849 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5850 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5851 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5852 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5853 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5854 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5855 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5856 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5857 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5858 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5859 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5860 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5863 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5864 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5869 c------------------------------------------------------------------------------
5870 subroutine eback_sc_corr(esccor)
5871 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5872 c conformational states; temporarily implemented as differences
5873 c between UNRES torsional potentials (dependent on three types of
5874 c residues) and the torsional potentials dependent on all 20 types
5875 c of residues computed from AM1 energy surfaces of terminally-blocked
5876 c amino-acid residues.
5877 implicit real*8 (a-h,o-z)
5878 include 'DIMENSIONS'
5879 include 'COMMON.VAR'
5880 include 'COMMON.GEO'
5881 include 'COMMON.LOCAL'
5882 include 'COMMON.TORSION'
5883 include 'COMMON.SCCOR'
5884 include 'COMMON.INTERACT'
5885 include 'COMMON.DERIV'
5886 include 'COMMON.CHAIN'
5887 include 'COMMON.NAMES'
5888 include 'COMMON.IOUNITS'
5889 include 'COMMON.FFIELD'
5890 include 'COMMON.CONTROL'
5892 C Set lprn=.true. for debugging
5895 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5897 do i=iphi_start,iphi_end
5904 v1ij=v1sccor(j,itori,itori1)
5905 v2ij=v2sccor(j,itori,itori1)
5908 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5909 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5912 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5913 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5914 & (v1sccor(j,itori,itori1),j=1,6),(v2sccor(j,itori,itori1),j=1,6)
5915 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5919 c----------------------------------------------------------------------------
5920 subroutine multibody(ecorr)
5921 C This subroutine calculates multi-body contributions to energy following
5922 C the idea of Skolnick et al. If side chains I and J make a contact and
5923 C at the same time side chains I+1 and J+1 make a contact, an extra
5924 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5925 implicit real*8 (a-h,o-z)
5926 include 'DIMENSIONS'
5927 include 'COMMON.IOUNITS'
5928 include 'COMMON.DERIV'
5929 include 'COMMON.INTERACT'
5930 include 'COMMON.CONTACTS'
5932 include 'COMMON.CONTACTS.MOMENT'
5934 double precision gx(3),gx1(3)
5937 C Set lprn=.true. for debugging
5941 write (iout,'(a)') 'Contact function values:'
5943 write (iout,'(i2,20(1x,i2,f10.5))')
5944 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5959 num_conti=num_cont(i)
5960 num_conti1=num_cont(i1)
5965 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5966 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5967 cd & ' ishift=',ishift
5968 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5969 C The system gains extra energy.
5970 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5971 endif ! j1==j+-ishift
5980 c------------------------------------------------------------------------------
5981 double precision function esccorr(i,j,k,l,jj,kk)
5982 implicit real*8 (a-h,o-z)
5983 include 'DIMENSIONS'
5984 include 'COMMON.IOUNITS'
5985 include 'COMMON.DERIV'
5986 include 'COMMON.INTERACT'
5987 include 'COMMON.CONTACTS'
5989 include 'COMMON.CONTACTS.MOMENT'
5991 double precision gx(3),gx1(3)
5996 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5997 C Calculate the multi-body contribution to energy.
5998 C Calculate multi-body contributions to the gradient.
5999 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6000 cd & k,l,(gacont(m,kk,k),m=1,3)
6002 gx(m) =ekl*gacont(m,jj,i)
6003 gx1(m)=eij*gacont(m,kk,k)
6004 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6005 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6006 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6007 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6011 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6016 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6022 c------------------------------------------------------------------------------
6023 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6024 C This subroutine calculates multi-body contributions to hydrogen-bonding
6025 implicit real*8 (a-h,o-z)
6026 include 'DIMENSIONS'
6027 include 'COMMON.IOUNITS'
6030 parameter (max_cont=maxconts)
6031 parameter (max_dim=26)
6032 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6033 double precision zapas(max_dim,maxconts,max_fg_procs),
6034 & zapas_recv(max_dim,maxconts,max_fg_procs)
6035 common /przechowalnia/ zapas
6036 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6037 & status_array(MPI_STATUS_SIZE,maxconts*2)
6039 include 'COMMON.SETUP'
6040 include 'COMMON.FFIELD'
6041 include 'COMMON.DERIV'
6042 include 'COMMON.INTERACT'
6043 include 'COMMON.CONTACTS'
6045 include 'COMMON.CONTACTS.MOMENT'
6047 include 'COMMON.CONTROL'
6048 include 'COMMON.LOCAL'
6049 double precision gx(3),gx1(3),time00
6052 C Set lprn=.true. for debugging
6057 if (nfgtasks.le.1) goto 30
6059 write (iout,'(a)') 'Contact function values before RECEIVE:'
6061 write (iout,'(2i3,50(1x,i2,f5.2))')
6062 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6063 & j=1,num_cont_hb(i))
6067 do i=1,ntask_cont_from
6070 do i=1,ntask_cont_to
6073 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6075 C Make the list of contacts to send to send to other procesors
6076 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6078 do i=iturn3_start,iturn3_end
6079 c write (iout,*) "make contact list turn3",i," num_cont",
6081 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6083 do i=iturn4_start,iturn4_end
6084 c write (iout,*) "make contact list turn4",i," num_cont",
6086 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6090 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6092 do j=1,num_cont_hb(i)
6095 iproc=iint_sent_local(k,jjc,ii)
6096 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6097 if (iproc.gt.0) then
6098 ncont_sent(iproc)=ncont_sent(iproc)+1
6099 nn=ncont_sent(iproc)
6101 zapas(2,nn,iproc)=jjc
6102 zapas(3,nn,iproc)=facont_hb(j,i)
6103 zapas(4,nn,iproc)=ees0p(j,i)
6104 zapas(5,nn,iproc)=ees0m(j,i)
6105 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6106 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6107 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6108 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6109 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6110 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6111 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6112 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6113 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6114 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6115 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6116 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6117 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6118 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6119 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6120 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6121 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6122 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6123 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6124 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6125 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6132 & "Numbers of contacts to be sent to other processors",
6133 & (ncont_sent(i),i=1,ntask_cont_to)
6134 write (iout,*) "Contacts sent"
6135 do ii=1,ntask_cont_to
6137 iproc=itask_cont_to(ii)
6138 write (iout,*) nn," contacts to processor",iproc,
6139 & " of CONT_TO_COMM group"
6141 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6149 CorrelID1=nfgtasks+fg_rank+1
6151 C Receive the numbers of needed contacts from other processors
6152 do ii=1,ntask_cont_from
6153 iproc=itask_cont_from(ii)
6155 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6156 & FG_COMM,req(ireq),IERR)
6158 c write (iout,*) "IRECV ended"
6160 C Send the number of contacts needed by other processors
6161 do ii=1,ntask_cont_to
6162 iproc=itask_cont_to(ii)
6164 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6165 & FG_COMM,req(ireq),IERR)
6167 c write (iout,*) "ISEND ended"
6168 c write (iout,*) "number of requests (nn)",ireq
6171 & call MPI_Waitall(ireq,req,status_array,ierr)
6173 c & "Numbers of contacts to be received from other processors",
6174 c & (ncont_recv(i),i=1,ntask_cont_from)
6178 do ii=1,ntask_cont_from
6179 iproc=itask_cont_from(ii)
6181 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6182 c & " of CONT_TO_COMM group"
6186 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6187 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6188 c write (iout,*) "ireq,req",ireq,req(ireq)
6191 C Send the contacts to processors that need them
6192 do ii=1,ntask_cont_to
6193 iproc=itask_cont_to(ii)
6195 c write (iout,*) nn," contacts to processor",iproc,
6196 c & " of CONT_TO_COMM group"
6199 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6200 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6201 c write (iout,*) "ireq,req",ireq,req(ireq)
6203 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6207 c write (iout,*) "number of requests (contacts)",ireq
6208 c write (iout,*) "req",(req(i),i=1,4)
6211 & call MPI_Waitall(ireq,req,status_array,ierr)
6212 do iii=1,ntask_cont_from
6213 iproc=itask_cont_from(iii)
6216 write (iout,*) "Received",nn," contacts from processor",iproc,
6217 & " of CONT_FROM_COMM group"
6220 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6225 ii=zapas_recv(1,i,iii)
6226 c Flag the received contacts to prevent double-counting
6227 jj=-zapas_recv(2,i,iii)
6228 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6230 nnn=num_cont_hb(ii)+1
6233 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6234 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6235 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6236 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6237 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6238 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6239 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6240 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6241 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6242 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6243 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6244 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6245 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6246 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6247 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6248 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6249 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6250 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6251 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6252 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6253 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6254 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6255 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6256 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6261 write (iout,'(a)') 'Contact function values after receive:'
6263 write (iout,'(2i3,50(1x,i3,f5.2))')
6264 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6265 & j=1,num_cont_hb(i))
6272 write (iout,'(a)') 'Contact function values:'
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))
6280 C Remove the loop below after debugging !!!
6287 C Calculate the local-electrostatic correlation terms
6288 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6290 num_conti=num_cont_hb(i)
6291 num_conti1=num_cont_hb(i+1)
6298 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6299 c & ' jj=',jj,' kk=',kk
6300 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6301 & .or. j.lt.0 .and. j1.gt.0) .and.
6302 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6303 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6304 C The system gains extra energy.
6305 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6306 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6307 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6309 else if (j1.eq.j) then
6310 C Contacts I-J and I-(J+1) occur simultaneously.
6311 C The system loses extra energy.
6312 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6317 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6318 c & ' jj=',jj,' kk=',kk
6320 C Contacts I-J and (I+1)-J occur simultaneously.
6321 C The system loses extra energy.
6322 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6329 c------------------------------------------------------------------------------
6330 subroutine add_hb_contact(ii,jj,itask)
6331 implicit real*8 (a-h,o-z)
6332 include "DIMENSIONS"
6333 include "COMMON.IOUNITS"
6336 parameter (max_cont=maxconts)
6337 parameter (max_dim=26)
6338 include "COMMON.CONTACTS"
6340 include 'COMMON.CONTACTS.MOMENT'
6342 double precision zapas(max_dim,maxconts,max_fg_procs),
6343 & zapas_recv(max_dim,maxconts,max_fg_procs)
6344 common /przechowalnia/ zapas
6345 integer i,j,ii,jj,iproc,itask(4),nn
6346 c write (iout,*) "itask",itask
6349 if (iproc.gt.0) then
6350 do j=1,num_cont_hb(ii)
6352 c write (iout,*) "i",ii," j",jj," jjc",jjc
6354 ncont_sent(iproc)=ncont_sent(iproc)+1
6355 nn=ncont_sent(iproc)
6356 zapas(1,nn,iproc)=ii
6357 zapas(2,nn,iproc)=jjc
6358 zapas(3,nn,iproc)=facont_hb(j,ii)
6359 zapas(4,nn,iproc)=ees0p(j,ii)
6360 zapas(5,nn,iproc)=ees0m(j,ii)
6361 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6362 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6363 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6364 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6365 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6366 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6367 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6368 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6369 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6370 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6371 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6372 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6373 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6374 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6375 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6376 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6377 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6378 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6379 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6380 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6381 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6389 c------------------------------------------------------------------------------
6390 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6392 C This subroutine calculates multi-body contributions to hydrogen-bonding
6393 implicit real*8 (a-h,o-z)
6394 include 'DIMENSIONS'
6395 include 'COMMON.IOUNITS'
6398 parameter (max_cont=maxconts)
6399 parameter (max_dim=70)
6400 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6401 double precision zapas(max_dim,maxconts,max_fg_procs),
6402 & zapas_recv(max_dim,maxconts,max_fg_procs)
6403 common /przechowalnia/ zapas
6404 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6405 & status_array(MPI_STATUS_SIZE,maxconts*2)
6407 include 'COMMON.SETUP'
6408 include 'COMMON.FFIELD'
6409 include 'COMMON.DERIV'
6410 include 'COMMON.LOCAL'
6411 include 'COMMON.INTERACT'
6412 include 'COMMON.CONTACTS'
6414 include 'COMMON.CONTACTS.MOMENT'
6416 include 'COMMON.CHAIN'
6417 include 'COMMON.CONTROL'
6418 double precision gx(3),gx1(3)
6419 integer num_cont_hb_old(maxres)
6421 double precision eello4,eello5,eelo6,eello_turn6
6422 external eello4,eello5,eello6,eello_turn6
6423 C Set lprn=.true. for debugging
6428 num_cont_hb_old(i)=num_cont_hb(i)
6432 if (nfgtasks.le.1) goto 30
6434 write (iout,'(a)') 'Contact function values before RECEIVE:'
6436 write (iout,'(2i3,50(1x,i2,f5.2))')
6437 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6438 & j=1,num_cont_hb(i))
6442 do i=1,ntask_cont_from
6445 do i=1,ntask_cont_to
6448 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6450 C Make the list of contacts to send to send to other procesors
6451 do i=iturn3_start,iturn3_end
6452 c write (iout,*) "make contact list turn3",i," num_cont",
6454 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6456 do i=iturn4_start,iturn4_end
6457 c write (iout,*) "make contact list turn4",i," num_cont",
6459 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6463 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6465 do j=1,num_cont_hb(i)
6468 iproc=iint_sent_local(k,jjc,ii)
6469 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6470 if (iproc.ne.0) then
6471 ncont_sent(iproc)=ncont_sent(iproc)+1
6472 nn=ncont_sent(iproc)
6474 zapas(2,nn,iproc)=jjc
6475 zapas(3,nn,iproc)=d_cont(j,i)
6479 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6484 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6492 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6503 & "Numbers of contacts to be sent to other processors",
6504 & (ncont_sent(i),i=1,ntask_cont_to)
6505 write (iout,*) "Contacts sent"
6506 do ii=1,ntask_cont_to
6508 iproc=itask_cont_to(ii)
6509 write (iout,*) nn," contacts to processor",iproc,
6510 & " of CONT_TO_COMM group"
6512 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6520 CorrelID1=nfgtasks+fg_rank+1
6522 C Receive the numbers of needed contacts from other processors
6523 do ii=1,ntask_cont_from
6524 iproc=itask_cont_from(ii)
6526 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6527 & FG_COMM,req(ireq),IERR)
6529 c write (iout,*) "IRECV ended"
6531 C Send the number of contacts needed by other processors
6532 do ii=1,ntask_cont_to
6533 iproc=itask_cont_to(ii)
6535 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6536 & FG_COMM,req(ireq),IERR)
6538 c write (iout,*) "ISEND ended"
6539 c write (iout,*) "number of requests (nn)",ireq
6542 & call MPI_Waitall(ireq,req,status_array,ierr)
6544 c & "Numbers of contacts to be received from other processors",
6545 c & (ncont_recv(i),i=1,ntask_cont_from)
6549 do ii=1,ntask_cont_from
6550 iproc=itask_cont_from(ii)
6552 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6553 c & " of CONT_TO_COMM group"
6557 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6558 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6559 c write (iout,*) "ireq,req",ireq,req(ireq)
6562 C Send the contacts to processors that need them
6563 do ii=1,ntask_cont_to
6564 iproc=itask_cont_to(ii)
6566 c write (iout,*) nn," contacts to processor",iproc,
6567 c & " of CONT_TO_COMM group"
6570 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6571 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6572 c write (iout,*) "ireq,req",ireq,req(ireq)
6574 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6578 c write (iout,*) "number of requests (contacts)",ireq
6579 c write (iout,*) "req",(req(i),i=1,4)
6582 & call MPI_Waitall(ireq,req,status_array,ierr)
6583 do iii=1,ntask_cont_from
6584 iproc=itask_cont_from(iii)
6587 write (iout,*) "Received",nn," contacts from processor",iproc,
6588 & " of CONT_FROM_COMM group"
6591 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6596 ii=zapas_recv(1,i,iii)
6597 c Flag the received contacts to prevent double-counting
6598 jj=-zapas_recv(2,i,iii)
6599 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6601 nnn=num_cont_hb(ii)+1
6604 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6608 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6613 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6621 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6630 write (iout,'(a)') 'Contact function values after receive:'
6632 write (iout,'(2i3,50(1x,i3,5f6.3))')
6633 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6634 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6641 write (iout,'(a)') 'Contact function values:'
6643 write (iout,'(2i3,50(1x,i2,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))
6651 C Remove the loop below after debugging !!!
6658 C Calculate the dipole-dipole interaction energies
6659 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6660 do i=iatel_s,iatel_e+1
6661 num_conti=num_cont_hb(i)
6670 C Calculate the local-electrostatic correlation terms
6671 c write (iout,*) "gradcorr5 in eello5 before loop"
6673 c write (iout,'(i5,3f10.5)')
6674 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6676 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6677 c write (iout,*) "corr loop i",i
6679 num_conti=num_cont_hb(i)
6680 num_conti1=num_cont_hb(i+1)
6687 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6688 c & ' jj=',jj,' kk=',kk
6689 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6690 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6691 & .or. j.lt.0 .and. j1.gt.0) .and.
6692 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6693 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6694 C The system gains extra energy.
6696 sqd1=dsqrt(d_cont(jj,i))
6697 sqd2=dsqrt(d_cont(kk,i1))
6698 sred_geom = sqd1*sqd2
6699 IF (sred_geom.lt.cutoff_corr) THEN
6700 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6702 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6703 cd & ' jj=',jj,' kk=',kk
6704 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6705 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6707 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6708 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6711 cd write (iout,*) 'sred_geom=',sred_geom,
6712 cd & ' ekont=',ekont,' fprim=',fprimcont,
6713 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6714 cd write (iout,*) "g_contij",g_contij
6715 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6716 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6717 call calc_eello(i,jp,i+1,jp1,jj,kk)
6718 if (wcorr4.gt.0.0d0)
6719 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6720 if (energy_dec.and.wcorr4.gt.0.0d0)
6721 1 write (iout,'(a6,4i5,0pf7.3)')
6722 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6723 c write (iout,*) "gradcorr5 before eello5"
6725 c write (iout,'(i5,3f10.5)')
6726 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6728 if (wcorr5.gt.0.0d0)
6729 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6730 c write (iout,*) "gradcorr5 after eello5"
6732 c write (iout,'(i5,3f10.5)')
6733 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6735 if (energy_dec.and.wcorr5.gt.0.0d0)
6736 1 write (iout,'(a6,4i5,0pf7.3)')
6737 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6738 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6739 cd write(2,*)'ijkl',i,jp,i+1,jp1
6740 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6741 & .or. wturn6.eq.0.0d0))then
6742 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6743 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6744 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6745 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6746 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6747 cd & 'ecorr6=',ecorr6
6748 cd write (iout,'(4e15.5)') sred_geom,
6749 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6750 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6751 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6752 else if (wturn6.gt.0.0d0
6753 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6754 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6755 eturn6=eturn6+eello_turn6(i,jj,kk)
6756 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6757 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6758 cd write (2,*) 'multibody_eello:eturn6',eturn6
6767 num_cont_hb(i)=num_cont_hb_old(i)
6769 c write (iout,*) "gradcorr5 in eello5"
6771 c write (iout,'(i5,3f10.5)')
6772 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6776 c------------------------------------------------------------------------------
6777 subroutine add_hb_contact_eello(ii,jj,itask)
6778 implicit real*8 (a-h,o-z)
6779 include "DIMENSIONS"
6780 include "COMMON.IOUNITS"
6783 parameter (max_cont=maxconts)
6784 parameter (max_dim=70)
6785 include "COMMON.CONTACTS"
6787 include 'COMMON.CONTACTS.MOMENT'
6789 double precision zapas(max_dim,maxconts,max_fg_procs),
6790 & zapas_recv(max_dim,maxconts,max_fg_procs)
6791 common /przechowalnia/ zapas
6792 integer i,j,ii,jj,iproc,itask(4),nn
6793 c write (iout,*) "itask",itask
6796 if (iproc.gt.0) then
6797 do j=1,num_cont_hb(ii)
6799 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6801 ncont_sent(iproc)=ncont_sent(iproc)+1
6802 nn=ncont_sent(iproc)
6803 zapas(1,nn,iproc)=ii
6804 zapas(2,nn,iproc)=jjc
6805 zapas(3,nn,iproc)=d_cont(j,ii)
6809 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6814 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6822 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6834 c------------------------------------------------------------------------------
6835 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6836 implicit real*8 (a-h,o-z)
6837 include 'DIMENSIONS'
6838 include 'COMMON.IOUNITS'
6839 include 'COMMON.DERIV'
6840 include 'COMMON.INTERACT'
6841 include 'COMMON.CONTACTS'
6843 include 'COMMON.CONTACTS.MOMENT'
6845 double precision gx(3),gx1(3)
6855 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6856 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6857 C Following 4 lines for diagnostics.
6862 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6863 c & 'Contacts ',i,j,
6864 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6865 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6867 C Calculate the multi-body contribution to energy.
6868 c ecorr=ecorr+ekont*ees
6869 C Calculate multi-body contributions to the gradient.
6870 coeffpees0pij=coeffp*ees0pij
6871 coeffmees0mij=coeffm*ees0mij
6872 coeffpees0pkl=coeffp*ees0pkl
6873 coeffmees0mkl=coeffm*ees0mkl
6875 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6876 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6877 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6878 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6879 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6880 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6881 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6882 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6883 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6884 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6885 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6886 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6887 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6888 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6889 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6890 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6891 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6892 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6893 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6894 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6895 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6896 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6897 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6898 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6899 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6904 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6905 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6906 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6907 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6912 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6913 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6914 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6915 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6918 c write (iout,*) "ehbcorr",ekont*ees
6923 C---------------------------------------------------------------------------
6924 subroutine dipole(i,j,jj)
6925 implicit real*8 (a-h,o-z)
6926 include 'DIMENSIONS'
6927 include 'COMMON.IOUNITS'
6928 include 'COMMON.CHAIN'
6929 include 'COMMON.FFIELD'
6930 include 'COMMON.DERIV'
6931 include 'COMMON.INTERACT'
6932 include 'COMMON.CONTACTS'
6934 include 'COMMON.CONTACTS.MOMENT'
6936 include 'COMMON.TORSION'
6937 include 'COMMON.VAR'
6938 include 'COMMON.GEO'
6939 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6941 iti1 = itortyp(itype(i+1))
6942 if (j.lt.nres-1) then
6943 itj1 = itortyp(itype(j+1))
6948 dipi(iii,1)=Ub2(iii,i)
6949 dipderi(iii)=Ub2der(iii,i)
6950 dipi(iii,2)=b1(iii,iti1)
6951 dipj(iii,1)=Ub2(iii,j)
6952 dipderj(iii)=Ub2der(iii,j)
6953 dipj(iii,2)=b1(iii,itj1)
6957 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6960 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6967 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6971 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6976 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6977 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6979 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6981 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6983 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6988 C---------------------------------------------------------------------------
6989 subroutine calc_eello(i,j,k,l,jj,kk)
6991 C This subroutine computes matrices and vectors needed to calculate
6992 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6994 implicit real*8 (a-h,o-z)
6995 include 'DIMENSIONS'
6996 include 'COMMON.IOUNITS'
6997 include 'COMMON.CHAIN'
6998 include 'COMMON.DERIV'
6999 include 'COMMON.INTERACT'
7000 include 'COMMON.CONTACTS'
7002 include 'COMMON.CONTACTS.MOMENT'
7004 include 'COMMON.TORSION'
7005 include 'COMMON.VAR'
7006 include 'COMMON.GEO'
7007 include 'COMMON.FFIELD'
7008 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7009 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7012 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7013 cd & ' jj=',jj,' kk=',kk
7014 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7015 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7016 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7019 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7020 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7023 call transpose2(aa1(1,1),aa1t(1,1))
7024 call transpose2(aa2(1,1),aa2t(1,1))
7027 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7028 & aa1tder(1,1,lll,kkk))
7029 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7030 & aa2tder(1,1,lll,kkk))
7034 C parallel orientation of the two CA-CA-CA frames.
7036 iti=itortyp(itype(i))
7040 itk1=itortyp(itype(k+1))
7041 itj=itortyp(itype(j))
7042 if (l.lt.nres-1) then
7043 itl1=itortyp(itype(l+1))
7047 C A1 kernel(j+1) A2T
7049 cd write (iout,'(3f10.5,5x,3f10.5)')
7050 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7052 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7053 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7054 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7055 C Following matrices are needed only for 6-th order cumulants
7056 IF (wcorr6.gt.0.0d0) THEN
7057 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7058 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7059 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7060 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7061 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7062 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7063 & ADtEAderx(1,1,1,1,1,1))
7065 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7066 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7067 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7068 & ADtEA1derx(1,1,1,1,1,1))
7070 C End 6-th order cumulants
7073 cd write (2,*) 'In calc_eello6'
7075 cd write (2,*) 'iii=',iii
7077 cd write (2,*) 'kkk=',kkk
7079 cd write (2,'(3(2f10.5),5x)')
7080 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7085 call transpose2(EUgder(1,1,k),auxmat(1,1))
7086 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7087 call transpose2(EUg(1,1,k),auxmat(1,1))
7088 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7089 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7093 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7094 & EAEAderx(1,1,lll,kkk,iii,1))
7098 C A1T kernel(i+1) A2
7099 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7100 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7101 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7102 C Following matrices are needed only for 6-th order cumulants
7103 IF (wcorr6.gt.0.0d0) THEN
7104 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7105 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7106 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7107 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7108 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7109 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7110 & ADtEAderx(1,1,1,1,1,2))
7111 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7112 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7113 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7114 & ADtEA1derx(1,1,1,1,1,2))
7116 C End 6-th order cumulants
7117 call transpose2(EUgder(1,1,l),auxmat(1,1))
7118 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7119 call transpose2(EUg(1,1,l),auxmat(1,1))
7120 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7121 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7125 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7126 & EAEAderx(1,1,lll,kkk,iii,2))
7131 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7132 C They are needed only when the fifth- or the sixth-order cumulants are
7134 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7135 call transpose2(AEA(1,1,1),auxmat(1,1))
7136 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7137 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7138 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7139 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7140 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7141 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7142 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7143 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7144 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7145 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7146 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7147 call transpose2(AEA(1,1,2),auxmat(1,1))
7148 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7149 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7150 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7151 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7152 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7153 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7154 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7155 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7156 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7157 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7158 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7159 C Calculate the Cartesian derivatives of the vectors.
7163 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7164 call matvec2(auxmat(1,1),b1(1,iti),
7165 & AEAb1derx(1,lll,kkk,iii,1,1))
7166 call matvec2(auxmat(1,1),Ub2(1,i),
7167 & AEAb2derx(1,lll,kkk,iii,1,1))
7168 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7169 & AEAb1derx(1,lll,kkk,iii,2,1))
7170 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7171 & AEAb2derx(1,lll,kkk,iii,2,1))
7172 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7173 call matvec2(auxmat(1,1),b1(1,itj),
7174 & AEAb1derx(1,lll,kkk,iii,1,2))
7175 call matvec2(auxmat(1,1),Ub2(1,j),
7176 & AEAb2derx(1,lll,kkk,iii,1,2))
7177 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7178 & AEAb1derx(1,lll,kkk,iii,2,2))
7179 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7180 & AEAb2derx(1,lll,kkk,iii,2,2))
7187 C Antiparallel orientation of the two CA-CA-CA frames.
7189 iti=itortyp(itype(i))
7193 itk1=itortyp(itype(k+1))
7194 itl=itortyp(itype(l))
7195 itj=itortyp(itype(j))
7196 if (j.lt.nres-1) then
7197 itj1=itortyp(itype(j+1))
7201 C A2 kernel(j-1)T A1T
7202 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7203 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7204 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7205 C Following matrices are needed only for 6-th order cumulants
7206 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7207 & j.eq.i+4 .and. l.eq.i+3)) THEN
7208 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7209 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7210 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7211 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7212 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7213 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7214 & ADtEAderx(1,1,1,1,1,1))
7215 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7216 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7217 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7218 & ADtEA1derx(1,1,1,1,1,1))
7220 C End 6-th order cumulants
7221 call transpose2(EUgder(1,1,k),auxmat(1,1))
7222 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7223 call transpose2(EUg(1,1,k),auxmat(1,1))
7224 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7225 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7229 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7230 & EAEAderx(1,1,lll,kkk,iii,1))
7234 C A2T kernel(i+1)T A1
7235 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7236 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7237 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7238 C Following matrices are needed only for 6-th order cumulants
7239 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7240 & j.eq.i+4 .and. l.eq.i+3)) THEN
7241 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7242 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7243 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7244 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7245 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7246 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7247 & ADtEAderx(1,1,1,1,1,2))
7248 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7249 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7250 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7251 & ADtEA1derx(1,1,1,1,1,2))
7253 C End 6-th order cumulants
7254 call transpose2(EUgder(1,1,j),auxmat(1,1))
7255 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7256 call transpose2(EUg(1,1,j),auxmat(1,1))
7257 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7258 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7262 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7263 & EAEAderx(1,1,lll,kkk,iii,2))
7268 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7269 C They are needed only when the fifth- or the sixth-order cumulants are
7271 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7272 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7273 call transpose2(AEA(1,1,1),auxmat(1,1))
7274 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7275 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7276 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7277 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7278 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7279 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7280 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7281 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7282 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7283 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7284 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7285 call transpose2(AEA(1,1,2),auxmat(1,1))
7286 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7287 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7288 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7289 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7290 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7291 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7292 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7293 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7294 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7295 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7296 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7297 C Calculate the Cartesian derivatives of the vectors.
7301 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7302 call matvec2(auxmat(1,1),b1(1,iti),
7303 & AEAb1derx(1,lll,kkk,iii,1,1))
7304 call matvec2(auxmat(1,1),Ub2(1,i),
7305 & AEAb2derx(1,lll,kkk,iii,1,1))
7306 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7307 & AEAb1derx(1,lll,kkk,iii,2,1))
7308 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7309 & AEAb2derx(1,lll,kkk,iii,2,1))
7310 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7311 call matvec2(auxmat(1,1),b1(1,itl),
7312 & AEAb1derx(1,lll,kkk,iii,1,2))
7313 call matvec2(auxmat(1,1),Ub2(1,l),
7314 & AEAb2derx(1,lll,kkk,iii,1,2))
7315 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7316 & AEAb1derx(1,lll,kkk,iii,2,2))
7317 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7318 & AEAb2derx(1,lll,kkk,iii,2,2))
7327 C---------------------------------------------------------------------------
7328 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7329 & KK,KKderg,AKA,AKAderg,AKAderx)
7333 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7334 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7335 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7340 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7342 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7345 cd if (lprn) write (2,*) 'In kernel'
7347 cd if (lprn) write (2,*) 'kkk=',kkk
7349 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7350 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7352 cd write (2,*) 'lll=',lll
7353 cd write (2,*) 'iii=1'
7355 cd write (2,'(3(2f10.5),5x)')
7356 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7359 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7360 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7362 cd write (2,*) 'lll=',lll
7363 cd write (2,*) 'iii=2'
7365 cd write (2,'(3(2f10.5),5x)')
7366 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7373 C---------------------------------------------------------------------------
7374 double precision function eello4(i,j,k,l,jj,kk)
7375 implicit real*8 (a-h,o-z)
7376 include 'DIMENSIONS'
7377 include 'COMMON.IOUNITS'
7378 include 'COMMON.CHAIN'
7379 include 'COMMON.DERIV'
7380 include 'COMMON.INTERACT'
7381 include 'COMMON.CONTACTS'
7383 include 'COMMON.CONTACTS.MOMENT'
7385 include 'COMMON.TORSION'
7386 include 'COMMON.VAR'
7387 include 'COMMON.GEO'
7388 double precision pizda(2,2),ggg1(3),ggg2(3)
7389 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7393 cd print *,'eello4:',i,j,k,l,jj,kk
7394 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7395 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7396 cold eij=facont_hb(jj,i)
7397 cold ekl=facont_hb(kk,k)
7399 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7400 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7401 gcorr_loc(k-1)=gcorr_loc(k-1)
7402 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7404 gcorr_loc(l-1)=gcorr_loc(l-1)
7405 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7407 gcorr_loc(j-1)=gcorr_loc(j-1)
7408 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7413 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7414 & -EAEAderx(2,2,lll,kkk,iii,1)
7415 cd derx(lll,kkk,iii)=0.0d0
7419 cd gcorr_loc(l-1)=0.0d0
7420 cd gcorr_loc(j-1)=0.0d0
7421 cd gcorr_loc(k-1)=0.0d0
7423 cd write (iout,*)'Contacts have occurred for peptide groups',
7424 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7425 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7426 if (j.lt.nres-1) then
7433 if (l.lt.nres-1) then
7441 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7442 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7443 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7444 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7445 cgrad ghalf=0.5d0*ggg1(ll)
7446 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7447 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7448 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7449 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7450 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7451 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7452 cgrad ghalf=0.5d0*ggg2(ll)
7453 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7454 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7455 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7456 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7457 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7458 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7462 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7467 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7472 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7477 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7481 cd write (2,*) iii,gcorr_loc(iii)
7484 cd write (2,*) 'ekont',ekont
7485 cd write (iout,*) 'eello4',ekont*eel4
7488 C---------------------------------------------------------------------------
7489 double precision function eello5(i,j,k,l,jj,kk)
7490 implicit real*8 (a-h,o-z)
7491 include 'DIMENSIONS'
7492 include 'COMMON.IOUNITS'
7493 include 'COMMON.CHAIN'
7494 include 'COMMON.DERIV'
7495 include 'COMMON.INTERACT'
7496 include 'COMMON.CONTACTS'
7498 include 'COMMON.CONTACTS.MOMENT'
7500 include 'COMMON.TORSION'
7501 include 'COMMON.VAR'
7502 include 'COMMON.GEO'
7503 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7504 double precision ggg1(3),ggg2(3)
7505 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7510 C /l\ / \ \ / \ / \ / C
7511 C / \ / \ \ / \ / \ / C
7512 C j| o |l1 | o | o| o | | o |o C
7513 C \ |/k\| |/ \| / |/ \| |/ \| C
7514 C \i/ \ / \ / / \ / \ C
7516 C (I) (II) (III) (IV) C
7518 C eello5_1 eello5_2 eello5_3 eello5_4 C
7520 C Antiparallel chains C
7523 C /j\ / \ \ / \ / \ / C
7524 C / \ / \ \ / \ / \ / C
7525 C j1| o |l | o | o| o | | o |o C
7526 C \ |/k\| |/ \| / |/ \| |/ \| C
7527 C \i/ \ / \ / / \ / \ C
7529 C (I) (II) (III) (IV) C
7531 C eello5_1 eello5_2 eello5_3 eello5_4 C
7533 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7535 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7536 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7541 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7543 itk=itortyp(itype(k))
7544 itl=itortyp(itype(l))
7545 itj=itortyp(itype(j))
7550 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7551 cd & eel5_3_num,eel5_4_num)
7555 derx(lll,kkk,iii)=0.0d0
7559 cd eij=facont_hb(jj,i)
7560 cd ekl=facont_hb(kk,k)
7562 cd write (iout,*)'Contacts have occurred for peptide groups',
7563 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7565 C Contribution from the graph I.
7566 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7567 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7568 call transpose2(EUg(1,1,k),auxmat(1,1))
7569 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7570 vv(1)=pizda(1,1)-pizda(2,2)
7571 vv(2)=pizda(1,2)+pizda(2,1)
7572 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7573 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7574 C Explicit gradient in virtual-dihedral angles.
7575 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7576 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7577 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7578 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7579 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7580 vv(1)=pizda(1,1)-pizda(2,2)
7581 vv(2)=pizda(1,2)+pizda(2,1)
7582 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7583 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7584 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7585 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7586 vv(1)=pizda(1,1)-pizda(2,2)
7587 vv(2)=pizda(1,2)+pizda(2,1)
7589 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7590 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7591 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7593 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7594 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7595 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7597 C Cartesian gradient
7601 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7603 vv(1)=pizda(1,1)-pizda(2,2)
7604 vv(2)=pizda(1,2)+pizda(2,1)
7605 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7606 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7607 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7613 C Contribution from graph II
7614 call transpose2(EE(1,1,itk),auxmat(1,1))
7615 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7616 vv(1)=pizda(1,1)+pizda(2,2)
7617 vv(2)=pizda(2,1)-pizda(1,2)
7618 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7619 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7620 C Explicit gradient in virtual-dihedral angles.
7621 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7622 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7623 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7624 vv(1)=pizda(1,1)+pizda(2,2)
7625 vv(2)=pizda(2,1)-pizda(1,2)
7627 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7628 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7629 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7631 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7632 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7633 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7635 C Cartesian gradient
7639 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7641 vv(1)=pizda(1,1)+pizda(2,2)
7642 vv(2)=pizda(2,1)-pizda(1,2)
7643 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7644 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7645 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7653 C Parallel orientation
7654 C Contribution from graph III
7655 call transpose2(EUg(1,1,l),auxmat(1,1))
7656 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7657 vv(1)=pizda(1,1)-pizda(2,2)
7658 vv(2)=pizda(1,2)+pizda(2,1)
7659 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7660 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7661 C Explicit gradient in virtual-dihedral angles.
7662 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7663 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7664 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7665 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7666 vv(1)=pizda(1,1)-pizda(2,2)
7667 vv(2)=pizda(1,2)+pizda(2,1)
7668 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7669 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7670 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7671 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7672 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7673 vv(1)=pizda(1,1)-pizda(2,2)
7674 vv(2)=pizda(1,2)+pizda(2,1)
7675 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7676 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7677 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7678 C Cartesian gradient
7682 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7684 vv(1)=pizda(1,1)-pizda(2,2)
7685 vv(2)=pizda(1,2)+pizda(2,1)
7686 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7687 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7688 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7693 C Contribution from graph IV
7695 call transpose2(EE(1,1,itl),auxmat(1,1))
7696 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7697 vv(1)=pizda(1,1)+pizda(2,2)
7698 vv(2)=pizda(2,1)-pizda(1,2)
7699 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7700 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7701 C Explicit gradient in virtual-dihedral angles.
7702 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7703 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7704 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7705 vv(1)=pizda(1,1)+pizda(2,2)
7706 vv(2)=pizda(2,1)-pizda(1,2)
7707 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7708 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7709 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7710 C Cartesian gradient
7714 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7716 vv(1)=pizda(1,1)+pizda(2,2)
7717 vv(2)=pizda(2,1)-pizda(1,2)
7718 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7719 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7720 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7725 C Antiparallel orientation
7726 C Contribution from graph III
7728 call transpose2(EUg(1,1,j),auxmat(1,1))
7729 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7730 vv(1)=pizda(1,1)-pizda(2,2)
7731 vv(2)=pizda(1,2)+pizda(2,1)
7732 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7733 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7734 C Explicit gradient in virtual-dihedral angles.
7735 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7736 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7737 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7738 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7739 vv(1)=pizda(1,1)-pizda(2,2)
7740 vv(2)=pizda(1,2)+pizda(2,1)
7741 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7742 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7743 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7744 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7745 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7746 vv(1)=pizda(1,1)-pizda(2,2)
7747 vv(2)=pizda(1,2)+pizda(2,1)
7748 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7749 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7750 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7751 C Cartesian gradient
7755 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7757 vv(1)=pizda(1,1)-pizda(2,2)
7758 vv(2)=pizda(1,2)+pizda(2,1)
7759 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7760 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7761 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7766 C Contribution from graph IV
7768 call transpose2(EE(1,1,itj),auxmat(1,1))
7769 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7770 vv(1)=pizda(1,1)+pizda(2,2)
7771 vv(2)=pizda(2,1)-pizda(1,2)
7772 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7773 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7774 C Explicit gradient in virtual-dihedral angles.
7775 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7776 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7777 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7778 vv(1)=pizda(1,1)+pizda(2,2)
7779 vv(2)=pizda(2,1)-pizda(1,2)
7780 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7781 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7782 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7783 C Cartesian gradient
7787 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7789 vv(1)=pizda(1,1)+pizda(2,2)
7790 vv(2)=pizda(2,1)-pizda(1,2)
7791 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7792 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7793 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7799 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7800 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7801 cd write (2,*) 'ijkl',i,j,k,l
7802 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7803 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7805 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7806 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7807 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7808 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7809 if (j.lt.nres-1) then
7816 if (l.lt.nres-1) then
7826 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7827 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7828 C summed up outside the subrouine as for the other subroutines
7829 C handling long-range interactions. The old code is commented out
7830 C with "cgrad" to keep track of changes.
7832 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7833 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7834 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7835 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7836 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7837 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7838 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7839 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7840 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7841 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7843 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7844 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7845 cgrad ghalf=0.5d0*ggg1(ll)
7847 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7848 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7849 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7850 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7851 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7852 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7853 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7854 cgrad ghalf=0.5d0*ggg2(ll)
7856 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7857 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7858 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7859 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7860 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7861 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7866 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7867 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7872 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7873 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7879 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7884 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7888 cd write (2,*) iii,g_corr5_loc(iii)
7891 cd write (2,*) 'ekont',ekont
7892 cd write (iout,*) 'eello5',ekont*eel5
7895 c--------------------------------------------------------------------------
7896 double precision function eello6(i,j,k,l,jj,kk)
7897 implicit real*8 (a-h,o-z)
7898 include 'DIMENSIONS'
7899 include 'COMMON.IOUNITS'
7900 include 'COMMON.CHAIN'
7901 include 'COMMON.DERIV'
7902 include 'COMMON.INTERACT'
7903 include 'COMMON.CONTACTS'
7905 include 'COMMON.CONTACTS.MOMENT'
7907 include 'COMMON.TORSION'
7908 include 'COMMON.VAR'
7909 include 'COMMON.GEO'
7910 include 'COMMON.FFIELD'
7911 double precision ggg1(3),ggg2(3)
7912 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7917 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7925 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7926 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7930 derx(lll,kkk,iii)=0.0d0
7934 cd eij=facont_hb(jj,i)
7935 cd ekl=facont_hb(kk,k)
7941 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7942 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7943 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7944 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7945 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7946 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7948 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7949 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7950 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7951 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7952 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7953 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7957 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7959 C If turn contributions are considered, they will be handled separately.
7960 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7961 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7962 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7963 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7964 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7965 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7966 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7968 if (j.lt.nres-1) then
7975 if (l.lt.nres-1) then
7983 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7984 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7985 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7986 cgrad ghalf=0.5d0*ggg1(ll)
7988 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7989 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7990 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7991 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7992 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7993 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7994 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7995 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7996 cgrad ghalf=0.5d0*ggg2(ll)
7997 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7999 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8000 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8001 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8002 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8003 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8004 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8009 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8010 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8015 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8016 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8022 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8027 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8031 cd write (2,*) iii,g_corr6_loc(iii)
8034 cd write (2,*) 'ekont',ekont
8035 cd write (iout,*) 'eello6',ekont*eel6
8038 c--------------------------------------------------------------------------
8039 double precision function eello6_graph1(i,j,k,l,imat,swap)
8040 implicit real*8 (a-h,o-z)
8041 include 'DIMENSIONS'
8042 include 'COMMON.IOUNITS'
8043 include 'COMMON.CHAIN'
8044 include 'COMMON.DERIV'
8045 include 'COMMON.INTERACT'
8046 include 'COMMON.CONTACTS'
8048 include 'COMMON.CONTACTS.MOMENT'
8050 include 'COMMON.TORSION'
8051 include 'COMMON.VAR'
8052 include 'COMMON.GEO'
8053 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8057 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8059 C Parallel Antiparallel C
8065 C \ j|/k\| / \ |/k\|l / C
8070 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8071 itk=itortyp(itype(k))
8072 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8073 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8074 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8075 call transpose2(EUgC(1,1,k),auxmat(1,1))
8076 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8077 vv1(1)=pizda1(1,1)-pizda1(2,2)
8078 vv1(2)=pizda1(1,2)+pizda1(2,1)
8079 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8080 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8081 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8082 s5=scalar2(vv(1),Dtobr2(1,i))
8083 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8084 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8085 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8086 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8087 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8088 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8089 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8090 & +scalar2(vv(1),Dtobr2der(1,i)))
8091 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8092 vv1(1)=pizda1(1,1)-pizda1(2,2)
8093 vv1(2)=pizda1(1,2)+pizda1(2,1)
8094 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8095 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8097 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8098 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8099 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8100 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8101 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8103 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8104 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8105 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8106 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8107 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8109 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8110 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8111 vv1(1)=pizda1(1,1)-pizda1(2,2)
8112 vv1(2)=pizda1(1,2)+pizda1(2,1)
8113 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8114 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8115 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8116 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8125 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8126 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8127 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8128 call transpose2(EUgC(1,1,k),auxmat(1,1))
8129 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8131 vv1(1)=pizda1(1,1)-pizda1(2,2)
8132 vv1(2)=pizda1(1,2)+pizda1(2,1)
8133 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8134 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8135 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8136 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8137 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8138 s5=scalar2(vv(1),Dtobr2(1,i))
8139 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8145 c----------------------------------------------------------------------------
8146 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8147 implicit real*8 (a-h,o-z)
8148 include 'DIMENSIONS'
8149 include 'COMMON.IOUNITS'
8150 include 'COMMON.CHAIN'
8151 include 'COMMON.DERIV'
8152 include 'COMMON.INTERACT'
8153 include 'COMMON.CONTACTS'
8155 include 'COMMON.CONTACTS.MOMENT'
8157 include 'COMMON.TORSION'
8158 include 'COMMON.VAR'
8159 include 'COMMON.GEO'
8161 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8162 & auxvec1(2),auxvec2(1),auxmat1(2,2)
8165 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8167 C Parallel Antiparallel C
8173 C \ j|/k\| \ |/k\|l C
8178 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8179 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8180 C AL 7/4/01 s1 would occur in the sixth-order moment,
8181 C but not in a cluster cumulant
8183 s1=dip(1,jj,i)*dip(1,kk,k)
8185 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8186 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8187 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8188 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8189 call transpose2(EUg(1,1,k),auxmat(1,1))
8190 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8191 vv(1)=pizda(1,1)-pizda(2,2)
8192 vv(2)=pizda(1,2)+pizda(2,1)
8193 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8194 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8196 eello6_graph2=-(s1+s2+s3+s4)
8198 eello6_graph2=-(s2+s3+s4)
8201 C Derivatives in gamma(i-1)
8204 s1=dipderg(1,jj,i)*dip(1,kk,k)
8206 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8207 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8208 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8209 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8211 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8213 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8215 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8217 C Derivatives in gamma(k-1)
8219 s1=dip(1,jj,i)*dipderg(1,kk,k)
8221 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8222 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8223 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8224 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8225 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8226 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8227 vv(1)=pizda(1,1)-pizda(2,2)
8228 vv(2)=pizda(1,2)+pizda(2,1)
8229 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8231 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8233 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8235 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8236 C Derivatives in gamma(j-1) or gamma(l-1)
8239 s1=dipderg(3,jj,i)*dip(1,kk,k)
8241 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8242 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8243 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8244 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8245 vv(1)=pizda(1,1)-pizda(2,2)
8246 vv(2)=pizda(1,2)+pizda(2,1)
8247 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8250 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8252 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8255 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8256 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8258 C Derivatives in gamma(l-1) or gamma(j-1)
8261 s1=dip(1,jj,i)*dipderg(3,kk,k)
8263 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8264 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8265 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8266 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8267 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8268 vv(1)=pizda(1,1)-pizda(2,2)
8269 vv(2)=pizda(1,2)+pizda(2,1)
8270 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8273 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8275 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8278 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8279 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8281 C Cartesian derivatives.
8283 write (2,*) 'In eello6_graph2'
8285 write (2,*) 'iii=',iii
8287 write (2,*) 'kkk=',kkk
8289 write (2,'(3(2f10.5),5x)')
8290 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8300 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8302 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8305 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8307 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8308 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8310 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8311 call transpose2(EUg(1,1,k),auxmat(1,1))
8312 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8314 vv(1)=pizda(1,1)-pizda(2,2)
8315 vv(2)=pizda(1,2)+pizda(2,1)
8316 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8317 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8319 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8321 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8324 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8326 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8333 c----------------------------------------------------------------------------
8334 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8335 implicit real*8 (a-h,o-z)
8336 include 'DIMENSIONS'
8337 include 'COMMON.IOUNITS'
8338 include 'COMMON.CHAIN'
8339 include 'COMMON.DERIV'
8340 include 'COMMON.INTERACT'
8341 include 'COMMON.CONTACTS'
8343 include 'COMMON.CONTACTS.MOMENT'
8345 include 'COMMON.TORSION'
8346 include 'COMMON.VAR'
8347 include 'COMMON.GEO'
8348 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8350 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8352 C Parallel Antiparallel C
8358 C j|/k\| / |/k\|l / C
8363 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8365 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8366 C energy moment and not to the cluster cumulant.
8367 iti=itortyp(itype(i))
8368 if (j.lt.nres-1) then
8369 itj1=itortyp(itype(j+1))
8373 itk=itortyp(itype(k))
8374 itk1=itortyp(itype(k+1))
8375 if (l.lt.nres-1) then
8376 itl1=itortyp(itype(l+1))
8381 s1=dip(4,jj,i)*dip(4,kk,k)
8383 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8384 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8385 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8386 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8387 call transpose2(EE(1,1,itk),auxmat(1,1))
8388 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8389 vv(1)=pizda(1,1)+pizda(2,2)
8390 vv(2)=pizda(2,1)-pizda(1,2)
8391 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8392 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8393 cd & "sum",-(s2+s3+s4)
8395 eello6_graph3=-(s1+s2+s3+s4)
8397 eello6_graph3=-(s2+s3+s4)
8400 C Derivatives in gamma(k-1)
8401 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8402 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8403 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8404 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8405 C Derivatives in gamma(l-1)
8406 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8407 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8408 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8409 vv(1)=pizda(1,1)+pizda(2,2)
8410 vv(2)=pizda(2,1)-pizda(1,2)
8411 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8412 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8413 C Cartesian derivatives.
8419 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8421 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8424 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8426 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8427 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8429 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8430 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8432 vv(1)=pizda(1,1)+pizda(2,2)
8433 vv(2)=pizda(2,1)-pizda(1,2)
8434 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8436 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8438 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8441 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8443 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8445 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8451 c----------------------------------------------------------------------------
8452 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8453 implicit real*8 (a-h,o-z)
8454 include 'DIMENSIONS'
8455 include 'COMMON.IOUNITS'
8456 include 'COMMON.CHAIN'
8457 include 'COMMON.DERIV'
8458 include 'COMMON.INTERACT'
8459 include 'COMMON.CONTACTS'
8461 include 'COMMON.CONTACTS.MOMENT'
8463 include 'COMMON.TORSION'
8464 include 'COMMON.VAR'
8465 include 'COMMON.GEO'
8466 include 'COMMON.FFIELD'
8467 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8468 & auxvec1(2),auxmat1(2,2)
8470 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8472 C Parallel Antiparallel C
8478 C \ j|/k\| \ |/k\|l C
8483 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8485 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8486 C energy moment and not to the cluster cumulant.
8487 cd write (2,*) 'eello_graph4: wturn6',wturn6
8488 iti=itortyp(itype(i))
8489 itj=itortyp(itype(j))
8490 if (j.lt.nres-1) then
8491 itj1=itortyp(itype(j+1))
8495 itk=itortyp(itype(k))
8496 if (k.lt.nres-1) then
8497 itk1=itortyp(itype(k+1))
8501 itl=itortyp(itype(l))
8502 if (l.lt.nres-1) then
8503 itl1=itortyp(itype(l+1))
8507 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8508 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8509 cd & ' itl',itl,' itl1',itl1
8512 s1=dip(3,jj,i)*dip(3,kk,k)
8514 s1=dip(2,jj,j)*dip(2,kk,l)
8517 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8518 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8520 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8521 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8523 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8524 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8526 call transpose2(EUg(1,1,k),auxmat(1,1))
8527 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8528 vv(1)=pizda(1,1)-pizda(2,2)
8529 vv(2)=pizda(2,1)+pizda(1,2)
8530 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8531 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8533 eello6_graph4=-(s1+s2+s3+s4)
8535 eello6_graph4=-(s2+s3+s4)
8537 C Derivatives in gamma(i-1)
8541 s1=dipderg(2,jj,i)*dip(3,kk,k)
8543 s1=dipderg(4,jj,j)*dip(2,kk,l)
8546 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8548 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8549 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8551 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8552 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8554 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8555 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8556 cd write (2,*) 'turn6 derivatives'
8558 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8560 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8564 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8566 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8570 C Derivatives in gamma(k-1)
8573 s1=dip(3,jj,i)*dipderg(2,kk,k)
8575 s1=dip(2,jj,j)*dipderg(4,kk,l)
8578 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8579 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8581 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8582 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8584 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8585 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8587 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8588 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8589 vv(1)=pizda(1,1)-pizda(2,2)
8590 vv(2)=pizda(2,1)+pizda(1,2)
8591 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8592 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8594 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8596 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8600 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8602 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8605 C Derivatives in gamma(j-1) or gamma(l-1)
8606 if (l.eq.j+1 .and. l.gt.1) then
8607 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8608 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8609 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8610 vv(1)=pizda(1,1)-pizda(2,2)
8611 vv(2)=pizda(2,1)+pizda(1,2)
8612 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8613 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8614 else if (j.gt.1) then
8615 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8616 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8617 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8618 vv(1)=pizda(1,1)-pizda(2,2)
8619 vv(2)=pizda(2,1)+pizda(1,2)
8620 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8621 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8622 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8624 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8627 C Cartesian derivatives.
8634 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8636 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8640 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8642 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8646 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8648 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8650 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8651 & b1(1,itj1),auxvec(1))
8652 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8654 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8655 & b1(1,itl1),auxvec(1))
8656 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8658 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8660 vv(1)=pizda(1,1)-pizda(2,2)
8661 vv(2)=pizda(2,1)+pizda(1,2)
8662 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8664 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8666 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8669 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8672 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8675 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8677 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8679 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8683 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8685 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8688 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8690 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8698 c----------------------------------------------------------------------------
8699 double precision function eello_turn6(i,jj,kk)
8700 implicit real*8 (a-h,o-z)
8701 include 'DIMENSIONS'
8702 include 'COMMON.IOUNITS'
8703 include 'COMMON.CHAIN'
8704 include 'COMMON.DERIV'
8705 include 'COMMON.INTERACT'
8706 include 'COMMON.CONTACTS'
8708 include 'COMMON.CONTACTS.MOMENT'
8710 include 'COMMON.TORSION'
8711 include 'COMMON.VAR'
8712 include 'COMMON.GEO'
8713 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8714 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8716 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8717 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8718 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8719 C the respective energy moment and not to the cluster cumulant.
8728 iti=itortyp(itype(i))
8729 itk=itortyp(itype(k))
8730 itk1=itortyp(itype(k+1))
8731 itl=itortyp(itype(l))
8732 itj=itortyp(itype(j))
8733 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8734 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8735 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8740 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8742 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8746 derx_turn(lll,kkk,iii)=0.0d0
8753 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8755 cd write (2,*) 'eello6_5',eello6_5
8757 call transpose2(AEA(1,1,1),auxmat(1,1))
8758 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8759 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8760 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8762 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8763 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8764 s2 = scalar2(b1(1,itk),vtemp1(1))
8766 call transpose2(AEA(1,1,2),atemp(1,1))
8767 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8768 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8769 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8771 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8772 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8773 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8775 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8776 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8777 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8778 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8779 ss13 = scalar2(b1(1,itk),vtemp4(1))
8780 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8782 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8788 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8789 C Derivatives in gamma(i+2)
8793 call transpose2(AEA(1,1,1),auxmatd(1,1))
8794 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8795 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8796 call transpose2(AEAderg(1,1,2),atempd(1,1))
8797 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8798 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8800 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8801 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8802 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8808 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8809 C Derivatives in gamma(i+3)
8811 call transpose2(AEA(1,1,1),auxmatd(1,1))
8812 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8813 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8814 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8816 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8817 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8818 s2d = scalar2(b1(1,itk),vtemp1d(1))
8820 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8821 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8823 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8825 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8826 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8827 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8835 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8836 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8838 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8839 & -0.5d0*ekont*(s2d+s12d)
8841 C Derivatives in gamma(i+4)
8842 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8843 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8844 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8846 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8847 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8848 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8856 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8858 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8860 C Derivatives in gamma(i+5)
8862 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8863 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8864 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8866 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8867 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8868 s2d = scalar2(b1(1,itk),vtemp1d(1))
8870 call transpose2(AEA(1,1,2),atempd(1,1))
8871 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8872 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8874 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8875 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8877 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8878 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8879 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8887 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8888 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8890 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8891 & -0.5d0*ekont*(s2d+s12d)
8893 C Cartesian derivatives
8898 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8899 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8900 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8902 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8903 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8905 s2d = scalar2(b1(1,itk),vtemp1d(1))
8907 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8908 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8909 s8d = -(atempd(1,1)+atempd(2,2))*
8910 & scalar2(cc(1,1,itl),vtemp2(1))
8912 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8914 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8915 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8922 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8925 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8929 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8930 & - 0.5d0*(s8d+s12d)
8932 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8941 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8943 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8944 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8945 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8946 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8947 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8949 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8950 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8951 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8955 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8956 cd & 16*eel_turn6_num
8958 if (j.lt.nres-1) then
8965 if (l.lt.nres-1) then
8973 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8974 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8975 cgrad ghalf=0.5d0*ggg1(ll)
8977 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8978 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8979 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8980 & +ekont*derx_turn(ll,2,1)
8981 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8982 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8983 & +ekont*derx_turn(ll,4,1)
8984 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8985 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8986 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8987 cgrad ghalf=0.5d0*ggg2(ll)
8989 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8990 & +ekont*derx_turn(ll,2,2)
8991 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8992 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8993 & +ekont*derx_turn(ll,4,2)
8994 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8995 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8996 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9001 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9006 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9012 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9017 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9021 cd write (2,*) iii,g_corr6_loc(iii)
9023 eello_turn6=ekont*eel_turn6
9024 cd write (2,*) 'ekont',ekont
9025 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9029 C-----------------------------------------------------------------------------
9030 double precision function scalar(u,v)
9031 !DIR$ INLINEALWAYS scalar
9033 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9036 double precision u(3),v(3)
9037 cd double precision sc
9045 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9048 crc-------------------------------------------------
9049 SUBROUTINE MATVEC2(A1,V1,V2)
9050 !DIR$ INLINEALWAYS MATVEC2
9052 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9054 implicit real*8 (a-h,o-z)
9055 include 'DIMENSIONS'
9056 DIMENSION A1(2,2),V1(2),V2(2)
9060 c 3 VI=VI+A1(I,K)*V1(K)
9064 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9065 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9070 C---------------------------------------
9071 SUBROUTINE MATMAT2(A1,A2,A3)
9073 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9075 implicit real*8 (a-h,o-z)
9076 include 'DIMENSIONS'
9077 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9078 c DIMENSION AI3(2,2)
9082 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9088 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9089 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9090 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9091 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9099 c-------------------------------------------------------------------------
9100 double precision function scalar2(u,v)
9101 !DIR$ INLINEALWAYS scalar2
9103 double precision u(2),v(2)
9106 scalar2=u(1)*v(1)+u(2)*v(2)
9110 C-----------------------------------------------------------------------------
9112 subroutine transpose2(a,at)
9113 !DIR$ INLINEALWAYS transpose2
9115 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9118 double precision a(2,2),at(2,2)
9125 c--------------------------------------------------------------------------
9126 subroutine transpose(n,a,at)
9129 double precision a(n,n),at(n,n)
9137 C---------------------------------------------------------------------------
9138 subroutine prodmat3(a1,a2,kk,transp,prod)
9139 !DIR$ INLINEALWAYS prodmat3
9141 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9145 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9147 crc double precision auxmat(2,2),prod_(2,2)
9150 crc call transpose2(kk(1,1),auxmat(1,1))
9151 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9152 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9154 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9155 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9156 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9157 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9158 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9159 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9160 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9161 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9164 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9165 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9167 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9168 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9169 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9170 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9171 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9172 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9173 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9174 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9177 c call transpose2(a2(1,1),a2t(1,1))
9180 crc print *,((prod_(i,j),i=1,2),j=1,2)
9181 crc print *,((prod(i,j),i=1,2),j=1,2)