1 subroutine etotal(energia)
2 implicit real*8 (a-h,o-z)
7 cMS$ATTRIBUTES C :: proc_proc
12 double precision weights_(n_ene)
14 include 'COMMON.SETUP'
15 include 'COMMON.IOUNITS'
16 double precision energia(0:n_ene)
17 include 'COMMON.LOCAL'
18 include 'COMMON.FFIELD'
19 include 'COMMON.DERIV'
20 include 'COMMON.INTERACT'
21 include 'COMMON.SBRIDGE'
22 include 'COMMON.CHAIN'
25 include 'COMMON.CONTROL'
26 include 'COMMON.TIME1'
28 c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
29 c & " nfgtasks",nfgtasks
30 if (nfgtasks.gt.1) then
32 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
33 if (fg_rank.eq.0) then
34 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
35 c print *,"Processor",myrank," BROADCAST iorder"
36 C FG master sets up the WEIGHTS_ array which will be broadcast to the
37 C FG slaves as WEIGHTS array.
58 C FG Master broadcasts the WEIGHTS_ array
59 call MPI_Bcast(weights_(1),n_ene,
60 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
62 C FG slaves receive the WEIGHTS array
63 call MPI_Bcast(weights(1),n_ene,
64 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
86 time_Bcast=time_Bcast+MPI_Wtime()-time00
87 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
88 c call chainbuild_cart
90 c print *,'Processor',myrank,' calling etotal ipot=',ipot
91 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
93 c if (modecalc.eq.12.or.modecalc.eq.14) then
94 c call int_from_cart1(.false.)
101 C Compute the side-chain and electrostatic interaction energy
103 goto (101,102,103,104,105,106) ipot
104 C Lennard-Jones potential.
105 101 call elj(evdw,evdw_p,evdw_m)
106 cd print '(a)','Exit ELJ'
108 C Lennard-Jones-Kihara potential (shifted).
109 102 call eljk(evdw,evdw_p,evdw_m)
111 C Berne-Pechukas potential (dilated LJ, angular dependence).
112 103 call ebp(evdw,evdw_p,evdw_m)
114 C Gay-Berne potential (shifted LJ, angular dependence).
115 104 call egb(evdw,evdw_p,evdw_m)
117 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
118 105 call egbv(evdw,evdw_p,evdw_m)
120 C Soft-sphere potential
121 106 call e_softsphere(evdw)
123 C Calculate electrostatic (H-bonding) energy of the main chain.
127 C JUYONG for dfa test!
128 if (wdfa_dist.gt.0) call edfad(edfadis)
129 c print*, 'edfad is finished!', edfadis
130 if (wdfa_tor.gt.0) call edfat(edfator)
131 c print*, 'edfat is finished!', edfator
132 if (wdfa_nei.gt.0) call edfan(edfanei)
133 c print*, 'edfan is finished!', edfanei
134 if (wdfa_beta.gt.0) call edfab(edfabet)
135 c print*, 'edfab is finished!', edfabet
139 c print *,"Processor",myrank," computed USCSC"
145 time_vec=time_vec+MPI_Wtime()-time01
147 c print *,"Processor",myrank," left VEC_AND_DERIV"
150 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
151 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
152 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
153 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
155 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
156 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
157 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
158 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
160 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
169 c write (iout,*) "Soft-spheer ELEC potential"
170 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
173 c print *,"Processor",myrank," computed UELEC"
175 C Calculate excluded-volume interaction energy between peptide groups
180 call escp(evdw2,evdw2_14)
186 c write (iout,*) "Soft-sphere SCP potential"
187 call escp_soft_sphere(evdw2,evdw2_14)
190 c Calculate the bond-stretching energy
194 C Calculate the disulfide-bridge and other energy and the contributions
195 C from other distance constraints.
196 cd print *,'Calling EHPB'
198 cd print *,'EHPB exitted succesfully.'
200 C Calculate the virtual-bond-angle energy.
202 if (wang.gt.0d0) then
207 c print *,"Processor",myrank," computed UB"
209 C Calculate the SC local energy.
212 c print *,"Processor",myrank," computed USC"
214 C Calculate the virtual-bond torsional energy.
216 cd print *,'nterm=',nterm
218 call etor(etors,edihcnstr)
223 c print *,"Processor",myrank," computed Utor"
225 C 6/23/01 Calculate double-torsional energy
227 if (wtor_d.gt.0) then
232 c print *,"Processor",myrank," computed Utord"
234 C 21/5/07 Calculate local sicdechain correlation energy
236 if (wsccor.gt.0.0d0) then
237 call eback_sc_corr(esccor)
241 c print *,"Processor",myrank," computed Usccorr"
243 C 12/1/95 Multi-body terms
247 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
248 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
249 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
250 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
251 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
258 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
259 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
260 cd write (iout,*) "multibody_hb ecorr",ecorr
262 c print *,"Processor",myrank," computed Ucorr"
264 C If performing constraint dynamics, call the constraint energy
265 C after the equilibration time
266 if(usampl.and.totT.gt.eq_time) then
274 time_enecalc=time_enecalc+MPI_Wtime()-time00
276 c print *,"Processor",myrank," computed Uconstr"
285 energia(2)=evdw2-evdw2_14
302 energia(8)=eello_turn3
303 energia(9)=eello_turn4
310 energia(19)=edihcnstr
312 energia(20)=Uconst+Uconst_back
320 c print *," Processor",myrank," calls SUM_ENERGY"
321 call sum_energy(energia,.true.)
322 c print *," Processor",myrank," left SUM_ENERGY"
324 time_sumene=time_sumene+MPI_Wtime()-time00
327 c print*, 'etot:',energia(0)
331 c-------------------------------------------------------------------------------
332 subroutine sum_energy(energia,reduce)
333 implicit real*8 (a-h,o-z)
338 cMS$ATTRIBUTES C :: proc_proc
344 include 'COMMON.SETUP'
345 include 'COMMON.IOUNITS'
346 double precision energia(0:n_ene),enebuff(0:n_ene+1)
347 include 'COMMON.FFIELD'
348 include 'COMMON.DERIV'
349 include 'COMMON.INTERACT'
350 include 'COMMON.SBRIDGE'
351 include 'COMMON.CHAIN'
353 include 'COMMON.CONTROL'
354 include 'COMMON.TIME1'
357 if (nfgtasks.gt.1 .and. reduce) then
359 write (iout,*) "energies before REDUCE"
360 call enerprint(energia)
364 enebuff(i)=energia(i)
367 call MPI_Barrier(FG_COMM,IERR)
368 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
370 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
371 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
373 write (iout,*) "energies after REDUCE"
374 call enerprint(energia)
377 time_Reduce=time_Reduce+MPI_Wtime()-time00
379 if (fg_rank.eq.0) then
382 evdw=energia(22)+wsct*energia(23)
387 evdw2=energia(2)+energia(18)
403 eello_turn3=energia(8)
404 eello_turn4=energia(9)
411 edihcnstr=energia(19)
420 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
421 & +wang*ebe+wtor*etors+wscloc*escloc
422 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
423 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
424 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
425 & +wbond*estr+Uconst+wsccor*esccor
426 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
429 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
430 & +wang*ebe+wtor*etors+wscloc*escloc
431 & +wstrain*ehpb+nss*ebr+wcorr*ecorr+wcorr5*ecorr5
432 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
433 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
434 & +wbond*estr+Uconst+wsccor*esccor
435 & +wdfa_dist*edfadis+wdfa_tor*edfator+wdfa_nei*edfanei
443 if (isnan(etot).ne.0) energia(0)=1.0d+99
445 if (isnan(etot)) energia(0)=1.0d+99
450 idumm=proc_proc(etot,i)
452 call proc_proc(etot,i)
454 if(i.eq.1)energia(0)=1.0d+99
461 c-------------------------------------------------------------------------------
462 subroutine sum_gradient
463 implicit real*8 (a-h,o-z)
468 cMS$ATTRIBUTES C :: proc_proc
473 double precision gradbufc(3,maxres),gradbufx(3,maxres),
474 & glocbuf(4*maxres),gradbufc_sum(3,maxres)
476 double precision gradbufc(3,maxres),gradbufx(3,maxres),
477 & glocbuf(4*maxres),gradbufc_sum(3,maxres)
479 include 'COMMON.SETUP'
480 include 'COMMON.IOUNITS'
481 include 'COMMON.FFIELD'
482 include 'COMMON.DERIV'
483 include 'COMMON.INTERACT'
484 include 'COMMON.SBRIDGE'
485 include 'COMMON.CHAIN'
487 include 'COMMON.CONTROL'
488 include 'COMMON.TIME1'
489 include 'COMMON.MAXGRAD'
494 write (iout,*) "sum_gradient gvdwc, gvdwx"
496 write (iout,'(i3,3f10.5,5x,3f10.5,5x,3f10.5,5x,3f10.5)')
497 & i,(gvdwx(j,i),j=1,3),(gvdwcT(j,i),j=1,3),(gvdwc(j,i),j=1,3),
498 & (gvdwcT(j,i),j=1,3)
503 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
504 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
505 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
508 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
509 C in virtual-bond-vector coordinates
512 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
514 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
515 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
517 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
519 c write (iout,'(i5,3f10.5,2x,f10.5)')
520 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
522 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
524 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
525 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
534 gradbufc(j,i)=wsc*gvdwc(j,i)+wsc*wscT*gvdwcT(j,i)+
535 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
536 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
537 & wel_loc*gel_loc_long(j,i)+
538 & wcorr*gradcorr_long(j,i)+
539 & wcorr5*gradcorr5_long(j,i)+
540 & wcorr6*gradcorr6_long(j,i)+
541 & wturn6*gcorr6_turn_long(j,i)+
542 & wstrain*ghpbc(j,i)+
543 & wdfa_dist*gdfad(j,i)+
544 & wdfa_tor*gdfat(j,i)+
545 & wdfa_nei*gdfan(j,i)+
546 & wdfa_beta*gdfab(j,i)
553 gradbufc(j,i)=wsc*gvdwc(j,i)+
554 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
555 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
556 & wel_loc*gel_loc_long(j,i)+
557 & wcorr*gradcorr_long(j,i)+
558 & wcorr5*gradcorr5_long(j,i)+
559 & wcorr6*gradcorr6_long(j,i)+
560 & wturn6*gcorr6_turn_long(j,i)+
561 & wstrain*ghpbc(j,i)+
562 & wdfa_dist*gdfad(j,i)+
563 & wdfa_tor*gdfat(j,i)+
564 & wdfa_nei*gdfan(j,i)+
565 & wdfa_beta*gdfab(j,i)
573 gradbufc(j,i)=wsc*gvdwc(j,i)+
574 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
575 & welec*gelc_long(j,i)+
577 & wel_loc*gel_loc_long(j,i)+
578 & wcorr*gradcorr_long(j,i)+
579 & wcorr5*gradcorr5_long(j,i)+
580 & wcorr6*gradcorr6_long(j,i)+
581 & wturn6*gcorr6_turn_long(j,i)+
582 & wstrain*ghpbc(j,i)+
583 & wdfa_dist*gdfad(j,i)+
584 & wdfa_tor*gdfat(j,i)+
585 & wdfa_nei*gdfan(j,i)+
586 & wdfa_beta*gdfab(j,i)
593 if (nfgtasks.gt.1) then
596 write (iout,*) "gradbufc before allreduce"
598 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
602 call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
603 & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
604 time_reduce=time_reduce+MPI_Wtime()-time00
606 write (iout,*) "gradbufc_sum after allreduce"
608 write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
613 time_allreduce=time_allreduce+MPI_Wtime()-time00
620 do i=igrad_start,igrad_end
621 do j=jgrad_start(i),jgrad_end(i)
623 gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
630 write (iout,*) "gradbufc"
632 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
642 gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
650 gradbufc(k,nres)=0.0d0
655 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
656 & wel_loc*gel_loc(j,i)+
657 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
658 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
659 & wel_loc*gel_loc_long(j,i)+
660 & wcorr*gradcorr_long(j,i)+
661 & wcorr5*gradcorr5_long(j,i)+
662 & wcorr6*gradcorr6_long(j,i)+
663 & wturn6*gcorr6_turn_long(j,i))+
665 & wcorr*gradcorr(j,i)+
666 & wturn3*gcorr3_turn(j,i)+
667 & wturn4*gcorr4_turn(j,i)+
668 & wcorr5*gradcorr5(j,i)+
669 & wcorr6*gradcorr6(j,i)+
670 & wturn6*gcorr6_turn(j,i)+
671 & wsccor*gsccorc(j,i)
672 & +wscloc*gscloc(j,i)
674 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
675 & wel_loc*gel_loc(j,i)+
676 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
677 & welec*gelc_long(j,i)
678 & wel_loc*gel_loc_long(j,i)+
679 & wcorr*gcorr_long(j,i)+
680 & wcorr5*gradcorr5_long(j,i)+
681 & wcorr6*gradcorr6_long(j,i)+
682 & wturn6*gcorr6_turn_long(j,i))+
684 & wcorr*gradcorr(j,i)+
685 & wturn3*gcorr3_turn(j,i)+
686 & wturn4*gcorr4_turn(j,i)+
687 & wcorr5*gradcorr5(j,i)+
688 & wcorr6*gradcorr6(j,i)+
689 & wturn6*gcorr6_turn(j,i)+
690 & wsccor*gsccorc(j,i)
691 & +wscloc*gscloc(j,i)
694 gradx(j,i,icg)=wsc*gvdwx(j,i)+wsc*wscT*gvdwxT(j,i)+
695 & wscp*gradx_scp(j,i)+
697 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
698 & wsccor*gsccorx(j,i)
699 & +wscloc*gsclocx(j,i)
701 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
703 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
704 & wsccor*gsccorx(j,i)
705 & +wscloc*gsclocx(j,i)
710 write (iout,*) "gloc before adding corr"
712 write (iout,*) i,gloc(i,icg)
716 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
717 & +wcorr5*g_corr5_loc(i)
718 & +wcorr6*g_corr6_loc(i)
719 & +wturn4*gel_loc_turn4(i)
720 & +wturn3*gel_loc_turn3(i)
721 & +wturn6*gel_loc_turn6(i)
722 & +wel_loc*gel_loc_loc(i)
723 & +wsccor*gsccor_loc(i)
726 write (iout,*) "gloc after adding corr"
728 write (iout,*) i,gloc(i,icg)
732 if (nfgtasks.gt.1) then
735 gradbufc(j,i)=gradc(j,i,icg)
736 gradbufx(j,i)=gradx(j,i,icg)
740 glocbuf(i)=gloc(i,icg)
743 call MPI_Barrier(FG_COMM,IERR)
744 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
746 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
747 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
748 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
749 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
750 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
751 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
752 time_reduce=time_reduce+MPI_Wtime()-time00
754 write (iout,*) "gloc after reduce"
756 write (iout,*) i,gloc(i,icg)
761 if (gnorm_check) then
763 c Compute the maximum elements of the gradient
773 gcorr3_turn_max=0.0d0
774 gcorr4_turn_max=0.0d0
777 gcorr6_turn_max=0.0d0
787 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
788 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
790 gvdwc_norm=dsqrt(scalar(gvdwcT(1,i),gvdwcT(1,i)))
791 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
793 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
794 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
795 & gvdwc_scp_max=gvdwc_scp_norm
796 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
797 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
798 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
799 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
800 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
801 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
802 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
803 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
804 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
805 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
806 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
807 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
808 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
810 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
811 & gcorr3_turn_max=gcorr3_turn_norm
812 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
814 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
815 & gcorr4_turn_max=gcorr4_turn_norm
816 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
817 if (gradcorr5_norm.gt.gradcorr5_max)
818 & gradcorr5_max=gradcorr5_norm
819 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
820 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
821 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
823 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
824 & gcorr6_turn_max=gcorr6_turn_norm
825 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
826 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
827 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
828 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
829 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
830 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
832 gvdwx_norm=dsqrt(scalar(gvdwxT(1,i),gvdwxT(1,i)))
833 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
835 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
836 if (gradx_scp_norm.gt.gradx_scp_max)
837 & gradx_scp_max=gradx_scp_norm
838 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
839 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
840 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
841 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
842 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
843 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
844 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
845 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
849 open(istat,file=statname,position="append")
851 open(istat,file=statname,access="append")
853 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
854 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
855 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
856 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
857 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
858 & gsccorx_max,gsclocx_max
860 if (gvdwc_max.gt.1.0d4) then
861 write (iout,*) "gvdwc gvdwx gradb gradbx"
863 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
864 & gradb(j,i),gradbx(j,i),j=1,3)
866 call pdbout(0.0d0,'cipiszcze',iout)
872 write (iout,*) "gradc gradx gloc"
874 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
875 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
879 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
883 c-------------------------------------------------------------------------------
884 subroutine rescale_weights(t_bath)
885 implicit real*8 (a-h,o-z)
887 include 'COMMON.IOUNITS'
888 include 'COMMON.FFIELD'
889 include 'COMMON.SBRIDGE'
890 double precision kfac /2.4d0/
891 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
893 c facT=2*temp0/(t_bath+temp0)
894 if (rescale_mode.eq.0) then
900 else if (rescale_mode.eq.1) then
901 facT=kfac/(kfac-1.0d0+t_bath/temp0)
902 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
903 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
904 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
905 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
906 else if (rescale_mode.eq.2) then
912 facT=licznik/dlog(dexp(x)+dexp(-x))
913 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
914 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
915 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
916 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
918 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
919 write (*,*) "Wrong RESCALE_MODE",rescale_mode
921 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
925 welec=weights(3)*fact
926 wcorr=weights(4)*fact3
927 wcorr5=weights(5)*fact4
928 wcorr6=weights(6)*fact5
929 wel_loc=weights(7)*fact2
930 wturn3=weights(8)*fact2
931 wturn4=weights(9)*fact3
932 wturn6=weights(10)*fact5
933 wtor=weights(13)*fact
934 wtor_d=weights(14)*fact2
935 wsccor=weights(21)*fact
938 wsct=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
942 C------------------------------------------------------------------------
943 subroutine enerprint(energia)
944 implicit real*8 (a-h,o-z)
946 include 'COMMON.IOUNITS'
947 include 'COMMON.FFIELD'
948 include 'COMMON.SBRIDGE'
950 double precision energia(0:n_ene)
953 evdw=energia(22)+wsct*energia(23)
959 evdw2=energia(2)+energia(18)
971 eello_turn3=energia(8)
972 eello_turn4=energia(9)
973 eello_turn6=energia(10)
979 edihcnstr=energia(19)
984 edfadis = energia(24)
985 edfator = energia(25)
986 edfanei = energia(26)
987 edfabet = energia(27)
990 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
991 & estr,wbond,ebe,wang,
992 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
994 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
995 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
997 & Uconst,edfadis,edfator,edfanei,edfabet,etot
998 10 format (/'Virtual-chain energies:'//
999 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1000 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1001 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1002 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
1003 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1004 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1005 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1006 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1007 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1008 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1009 & ' (SS bridges & dist. cnstr.)'/
1010 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1011 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1012 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1013 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1014 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1015 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1016 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1017 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1018 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1019 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1020 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1021 & 'EDFAD= ',1pE16.6,' (DFA distance energy)'/
1022 & 'EDFAT= ',1pE16.6,' (DFA torsion energy)'/
1023 & 'EDFAN= ',1pE16.6,' (DFA NCa energy)'/
1024 & 'EDFAB= ',1pE16.6,' (DFA Beta energy)'/
1025 & 'ETOT= ',1pE16.6,' (total)')
1027 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1028 & estr,wbond,ebe,wang,
1029 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1031 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1032 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1034 & Uconst,edfadis,edfator,edfanei,edfabet,etot
1035 10 format (/'Virtual-chain energies:'//
1036 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1037 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1038 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1039 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1040 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1041 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1042 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1043 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1044 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1045 & ' (SS bridges & dist. cnstr.)'/
1046 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1047 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1048 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1049 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1050 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1051 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1052 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1053 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1054 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1055 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1056 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1057 & 'EDFAD= ',1pE16.6,' (DFA distance energy)'/
1058 & 'EDFAT= ',1pE16.6,' (DFA torsion energy)'/
1059 & 'EDFAN= ',1pE16.6,' (DFA NCa energy)'/
1060 & 'EDFAB= ',1pE16.6,' (DFA Beta energy)'/
1061 & 'ETOT= ',1pE16.6,' (total)')
1065 C-----------------------------------------------------------------------
1066 subroutine elj(evdw,evdw_p,evdw_m)
1068 C This subroutine calculates the interaction energy of nonbonded side chains
1069 C assuming the LJ potential of interaction.
1071 implicit real*8 (a-h,o-z)
1072 include 'DIMENSIONS'
1073 parameter (accur=1.0d-10)
1074 include 'COMMON.GEO'
1075 include 'COMMON.VAR'
1076 include 'COMMON.LOCAL'
1077 include 'COMMON.CHAIN'
1078 include 'COMMON.DERIV'
1079 include 'COMMON.INTERACT'
1080 include 'COMMON.TORSION'
1081 include 'COMMON.SBRIDGE'
1082 include 'COMMON.NAMES'
1083 include 'COMMON.IOUNITS'
1084 include 'COMMON.CONTACTS'
1086 include 'COMMON.CONTACTS.MOMENT'
1089 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1091 do i=iatsc_s,iatsc_e
1092 itypi=iabs(itype(i))
1093 itypi1=iabs(itype(i+1))
1100 C Calculate SC interaction energy.
1102 do iint=1,nint_gr(i)
1103 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1104 cd & 'iend=',iend(i,iint)
1105 do j=istart(i,iint),iend(i,iint)
1106 itypj=iabs(itype(j))
1110 C Change 12/1/95 to calculate four-body interactions
1111 rij=xj*xj+yj*yj+zj*zj
1113 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1114 eps0ij=eps(itypi,itypj)
1116 e1=fac*fac*aa(itypi,itypj)
1117 e2=fac*bb(itypi,itypj)
1119 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1120 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1121 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1122 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1123 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1124 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1126 if (bb(itypi,itypj).gt.0) then
1127 evdw_p=evdw_p+evdwij
1129 evdw_m=evdw_m+evdwij
1135 C Calculate the components of the gradient in DC and X
1137 fac=-rrij*(e1+evdwij)
1142 if (bb(itypi,itypj).gt.0.0d0) then
1144 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1145 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1146 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1147 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1151 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1152 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1153 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1154 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1159 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1160 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1161 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1162 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1167 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1171 C 12/1/95, revised on 5/20/97
1173 C Calculate the contact function. The ith column of the array JCONT will
1174 C contain the numbers of atoms that make contacts with the atom I (of numbers
1175 C greater than I). The arrays FACONT and GACONT will contain the values of
1176 C the contact function and its derivative.
1178 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1179 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1180 C Uncomment next line, if the correlation interactions are contact function only
1181 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1183 sigij=sigma(itypi,itypj)
1184 r0ij=rs0(itypi,itypj)
1186 C Check whether the SC's are not too far to make a contact.
1189 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1190 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1192 if (fcont.gt.0.0D0) then
1193 C If the SC-SC distance if close to sigma, apply spline.
1194 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1195 cAdam & fcont1,fprimcont1)
1196 cAdam fcont1=1.0d0-fcont1
1197 cAdam if (fcont1.gt.0.0d0) then
1198 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1199 cAdam fcont=fcont*fcont1
1201 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1202 cga eps0ij=1.0d0/dsqrt(eps0ij)
1204 cga gg(k)=gg(k)*eps0ij
1206 cga eps0ij=-evdwij*eps0ij
1207 C Uncomment for AL's type of SC correlation interactions.
1208 cadam eps0ij=-evdwij
1209 num_conti=num_conti+1
1210 jcont(num_conti,i)=j
1211 facont(num_conti,i)=fcont*eps0ij
1212 fprimcont=eps0ij*fprimcont/rij
1214 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1215 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1216 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1217 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1218 gacont(1,num_conti,i)=-fprimcont*xj
1219 gacont(2,num_conti,i)=-fprimcont*yj
1220 gacont(3,num_conti,i)=-fprimcont*zj
1221 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1222 cd write (iout,'(2i3,3f10.5)')
1223 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1229 num_cont(i)=num_conti
1233 gvdwc(j,i)=expon*gvdwc(j,i)
1234 gvdwx(j,i)=expon*gvdwx(j,i)
1237 C******************************************************************************
1241 C To save time, the factor of EXPON has been extracted from ALL components
1242 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1245 C******************************************************************************
1248 C-----------------------------------------------------------------------------
1249 subroutine eljk(evdw,evdw_p,evdw_m)
1251 C This subroutine calculates the interaction energy of nonbonded side chains
1252 C assuming the LJK potential of interaction.
1254 implicit real*8 (a-h,o-z)
1255 include 'DIMENSIONS'
1256 include 'COMMON.GEO'
1257 include 'COMMON.VAR'
1258 include 'COMMON.LOCAL'
1259 include 'COMMON.CHAIN'
1260 include 'COMMON.DERIV'
1261 include 'COMMON.INTERACT'
1262 include 'COMMON.IOUNITS'
1263 include 'COMMON.NAMES'
1266 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1268 do i=iatsc_s,iatsc_e
1269 itypi=iabs(itype(i))
1270 itypi1=iabs(itype(i+1))
1275 C Calculate SC interaction energy.
1277 do iint=1,nint_gr(i)
1278 do j=istart(i,iint),iend(i,iint)
1279 itypj=iabs(itype(j))
1283 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1284 fac_augm=rrij**expon
1285 e_augm=augm(itypi,itypj)*fac_augm
1286 r_inv_ij=dsqrt(rrij)
1288 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1289 fac=r_shift_inv**expon
1290 e1=fac*fac*aa(itypi,itypj)
1291 e2=fac*bb(itypi,itypj)
1293 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1294 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1295 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1296 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1297 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1298 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1299 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1301 if (bb(itypi,itypj).gt.0) then
1302 evdw_p=evdw_p+evdwij
1304 evdw_m=evdw_m+evdwij
1310 C Calculate the components of the gradient in DC and X
1312 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1317 if (bb(itypi,itypj).gt.0.0d0) then
1319 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1320 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1321 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1322 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1326 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1327 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1328 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1329 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1334 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1335 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1336 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1337 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1342 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1350 gvdwc(j,i)=expon*gvdwc(j,i)
1351 gvdwx(j,i)=expon*gvdwx(j,i)
1356 C-----------------------------------------------------------------------------
1357 subroutine ebp(evdw,evdw_p,evdw_m)
1359 C This subroutine calculates the interaction energy of nonbonded side chains
1360 C assuming the Berne-Pechukas potential of interaction.
1362 implicit real*8 (a-h,o-z)
1363 include 'DIMENSIONS'
1364 include 'COMMON.GEO'
1365 include 'COMMON.VAR'
1366 include 'COMMON.LOCAL'
1367 include 'COMMON.CHAIN'
1368 include 'COMMON.DERIV'
1369 include 'COMMON.NAMES'
1370 include 'COMMON.INTERACT'
1371 include 'COMMON.IOUNITS'
1372 include 'COMMON.CALC'
1373 common /srutu/ icall
1374 c double precision rrsave(maxdim)
1377 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1379 c if (icall.eq.0) then
1385 do i=iatsc_s,iatsc_e
1386 itypi=iabs(itype(i))
1387 itypi1=iabs(itype(i+1))
1391 dxi=dc_norm(1,nres+i)
1392 dyi=dc_norm(2,nres+i)
1393 dzi=dc_norm(3,nres+i)
1394 c dsci_inv=dsc_inv(itypi)
1395 dsci_inv=vbld_inv(i+nres)
1397 C Calculate SC interaction energy.
1399 do iint=1,nint_gr(i)
1400 do j=istart(i,iint),iend(i,iint)
1403 c dscj_inv=dsc_inv(itypj)
1404 dscj_inv=vbld_inv(j+nres)
1405 chi1=chi(itypi,itypj)
1406 chi2=chi(itypj,itypi)
1413 alf12=0.5D0*(alf1+alf2)
1414 C For diagnostics only!!!
1427 dxj=dc_norm(1,nres+j)
1428 dyj=dc_norm(2,nres+j)
1429 dzj=dc_norm(3,nres+j)
1430 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1431 cd if (icall.eq.0) then
1437 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1439 C Calculate whole angle-dependent part of epsilon and contributions
1440 C to its derivatives
1441 fac=(rrij*sigsq)**expon2
1442 e1=fac*fac*aa(itypi,itypj)
1443 e2=fac*bb(itypi,itypj)
1444 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1445 eps2der=evdwij*eps3rt
1446 eps3der=evdwij*eps2rt
1447 evdwij=evdwij*eps2rt*eps3rt
1449 if (bb(itypi,itypj).gt.0) then
1450 evdw_p=evdw_p+evdwij
1452 evdw_m=evdw_m+evdwij
1458 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1459 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1460 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1461 cd & restyp(itypi),i,restyp(itypj),j,
1462 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1463 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1464 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1467 C Calculate gradient components.
1468 e1=e1*eps1*eps2rt**2*eps3rt**2
1469 fac=-expon*(e1+evdwij)
1472 C Calculate radial part of the gradient
1476 C Calculate the angular part of the gradient and sum add the contributions
1477 C to the appropriate components of the Cartesian gradient.
1479 if (bb(itypi,itypj).gt.0) then
1493 C-----------------------------------------------------------------------------
1494 subroutine egb(evdw,evdw_p,evdw_m)
1496 C This subroutine calculates the interaction energy of nonbonded side chains
1497 C assuming the Gay-Berne potential of interaction.
1499 implicit real*8 (a-h,o-z)
1500 include 'DIMENSIONS'
1501 include 'COMMON.GEO'
1502 include 'COMMON.VAR'
1503 include 'COMMON.LOCAL'
1504 include 'COMMON.CHAIN'
1505 include 'COMMON.DERIV'
1506 include 'COMMON.NAMES'
1507 include 'COMMON.INTERACT'
1508 include 'COMMON.IOUNITS'
1509 include 'COMMON.CALC'
1510 include 'COMMON.CONTROL'
1513 ccccc energy_dec=.false.
1514 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1519 c if (icall.eq.0) lprn=.false.
1521 do i=iatsc_s,iatsc_e
1522 itypi=iabs(itype(i))
1523 itypi1=iabs(itype(i+1))
1527 dxi=dc_norm(1,nres+i)
1528 dyi=dc_norm(2,nres+i)
1529 dzi=dc_norm(3,nres+i)
1530 c dsci_inv=dsc_inv(itypi)
1531 dsci_inv=vbld_inv(i+nres)
1532 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1533 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1535 C Calculate SC interaction energy.
1537 do iint=1,nint_gr(i)
1538 do j=istart(i,iint),iend(i,iint)
1540 itypj=iabs(itype(j))
1541 c dscj_inv=dsc_inv(itypj)
1542 dscj_inv=vbld_inv(j+nres)
1543 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1544 c & 1.0d0/vbld(j+nres)
1545 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1546 sig0ij=sigma(itypi,itypj)
1547 chi1=chi(itypi,itypj)
1548 chi2=chi(itypj,itypi)
1555 alf12=0.5D0*(alf1+alf2)
1556 C For diagnostics only!!!
1569 dxj=dc_norm(1,nres+j)
1570 dyj=dc_norm(2,nres+j)
1571 dzj=dc_norm(3,nres+j)
1572 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1573 c write (iout,*) "j",j," dc_norm",
1574 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1575 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1577 C Calculate angle-dependent terms of energy and contributions to their
1581 sig=sig0ij*dsqrt(sigsq)
1582 rij_shift=1.0D0/rij-sig+sig0ij
1583 c for diagnostics; uncomment
1584 c rij_shift=1.2*sig0ij
1585 C I hate to put IF's in the loops, but here don't have another choice!!!!
1586 if (rij_shift.le.0.0D0) then
1588 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1589 cd & restyp(itypi),i,restyp(itypj),j,
1590 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1594 c---------------------------------------------------------------
1595 rij_shift=1.0D0/rij_shift
1596 fac=rij_shift**expon
1597 e1=fac*fac*aa(itypi,itypj)
1598 e2=fac*bb(itypi,itypj)
1599 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1600 eps2der=evdwij*eps3rt
1601 eps3der=evdwij*eps2rt
1602 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1603 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1604 evdwij=evdwij*eps2rt*eps3rt
1606 if (bb(itypi,itypj).gt.0) then
1607 evdw_p=evdw_p+evdwij
1609 evdw_m=evdw_m+evdwij
1615 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1616 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1617 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1618 & restyp(itypi),i,restyp(itypj),j,
1619 & epsi,sigm,chi1,chi2,chip1,chip2,
1620 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1621 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1625 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1628 C Calculate gradient components.
1629 e1=e1*eps1*eps2rt**2*eps3rt**2
1630 fac=-expon*(e1+evdwij)*rij_shift
1634 C Calculate the radial part of the gradient
1638 C Calculate angular part of the gradient.
1640 if (bb(itypi,itypj).gt.0) then
1651 c write (iout,*) "Number of loop steps in EGB:",ind
1652 cccc energy_dec=.false.
1655 C-----------------------------------------------------------------------------
1656 subroutine egbv(evdw,evdw_p,evdw_m)
1658 C This subroutine calculates the interaction energy of nonbonded side chains
1659 C assuming the Gay-Berne-Vorobjev potential of interaction.
1661 implicit real*8 (a-h,o-z)
1662 include 'DIMENSIONS'
1663 include 'COMMON.GEO'
1664 include 'COMMON.VAR'
1665 include 'COMMON.LOCAL'
1666 include 'COMMON.CHAIN'
1667 include 'COMMON.DERIV'
1668 include 'COMMON.NAMES'
1669 include 'COMMON.INTERACT'
1670 include 'COMMON.IOUNITS'
1671 include 'COMMON.CALC'
1672 common /srutu/ icall
1675 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1678 c if (icall.eq.0) lprn=.true.
1680 do i=iatsc_s,iatsc_e
1681 itypi=iabs(itype(i))
1682 itypi1=iabs(itype(i+1))
1686 dxi=dc_norm(1,nres+i)
1687 dyi=dc_norm(2,nres+i)
1688 dzi=dc_norm(3,nres+i)
1689 c dsci_inv=dsc_inv(itypi)
1690 dsci_inv=vbld_inv(i+nres)
1692 C Calculate SC interaction energy.
1694 do iint=1,nint_gr(i)
1695 do j=istart(i,iint),iend(i,iint)
1697 itypj=iabs(itype(j))
1698 c dscj_inv=dsc_inv(itypj)
1699 dscj_inv=vbld_inv(j+nres)
1700 sig0ij=sigma(itypi,itypj)
1701 r0ij=r0(itypi,itypj)
1702 chi1=chi(itypi,itypj)
1703 chi2=chi(itypj,itypi)
1710 alf12=0.5D0*(alf1+alf2)
1711 C For diagnostics only!!!
1724 dxj=dc_norm(1,nres+j)
1725 dyj=dc_norm(2,nres+j)
1726 dzj=dc_norm(3,nres+j)
1727 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1729 C Calculate angle-dependent terms of energy and contributions to their
1733 sig=sig0ij*dsqrt(sigsq)
1734 rij_shift=1.0D0/rij-sig+r0ij
1735 C I hate to put IF's in the loops, but here don't have another choice!!!!
1736 if (rij_shift.le.0.0D0) then
1741 c---------------------------------------------------------------
1742 rij_shift=1.0D0/rij_shift
1743 fac=rij_shift**expon
1744 e1=fac*fac*aa(itypi,itypj)
1745 e2=fac*bb(itypi,itypj)
1746 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1747 eps2der=evdwij*eps3rt
1748 eps3der=evdwij*eps2rt
1749 fac_augm=rrij**expon
1750 e_augm=augm(itypi,itypj)*fac_augm
1751 evdwij=evdwij*eps2rt*eps3rt
1753 if (bb(itypi,itypj).gt.0) then
1754 evdw_p=evdw_p+evdwij+e_augm
1756 evdw_m=evdw_m+evdwij+e_augm
1759 evdw=evdw+evdwij+e_augm
1762 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1763 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1764 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1765 & restyp(itypi),i,restyp(itypj),j,
1766 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1767 & chi1,chi2,chip1,chip2,
1768 & eps1,eps2rt**2,eps3rt**2,
1769 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1772 C Calculate gradient components.
1773 e1=e1*eps1*eps2rt**2*eps3rt**2
1774 fac=-expon*(e1+evdwij)*rij_shift
1776 fac=rij*fac-2*expon*rrij*e_augm
1777 C Calculate the radial part of the gradient
1781 C Calculate angular part of the gradient.
1783 if (bb(itypi,itypj).gt.0) then
1795 C-----------------------------------------------------------------------------
1796 subroutine sc_angular
1797 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1798 C om12. Called by ebp, egb, and egbv.
1800 include 'COMMON.CALC'
1801 include 'COMMON.IOUNITS'
1805 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1806 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1807 om12=dxi*dxj+dyi*dyj+dzi*dzj
1809 C Calculate eps1(om12) and its derivative in om12
1810 faceps1=1.0D0-om12*chiom12
1811 faceps1_inv=1.0D0/faceps1
1812 eps1=dsqrt(faceps1_inv)
1813 C Following variable is eps1*deps1/dom12
1814 eps1_om12=faceps1_inv*chiom12
1819 c write (iout,*) "om12",om12," eps1",eps1
1820 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1825 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1826 sigsq=1.0D0-facsig*faceps1_inv
1827 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1828 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1829 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1835 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1836 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1838 C Calculate eps2 and its derivatives in om1, om2, and om12.
1841 chipom12=chip12*om12
1842 facp=1.0D0-om12*chipom12
1844 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1845 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1846 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1847 C Following variable is the square root of eps2
1848 eps2rt=1.0D0-facp1*facp_inv
1849 C Following three variables are the derivatives of the square root of eps
1850 C in om1, om2, and om12.
1851 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1852 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1853 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1854 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1855 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1856 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1857 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1858 c & " eps2rt_om12",eps2rt_om12
1859 C Calculate whole angle-dependent part of epsilon and contributions
1860 C to its derivatives
1864 C----------------------------------------------------------------------------
1865 subroutine sc_grad_T
1866 implicit real*8 (a-h,o-z)
1867 include 'DIMENSIONS'
1868 include 'COMMON.CHAIN'
1869 include 'COMMON.DERIV'
1870 include 'COMMON.CALC'
1871 include 'COMMON.IOUNITS'
1872 double precision dcosom1(3),dcosom2(3)
1873 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1874 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1875 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1876 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1880 c eom12=evdwij*eps1_om12
1882 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1883 c & " sigder",sigder
1884 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1885 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1887 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1888 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1891 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1893 c write (iout,*) "gg",(gg(k),k=1,3)
1895 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1896 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1897 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1898 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1899 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1900 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1901 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1902 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1903 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1904 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1907 C Calculate the components of the gradient in DC and X
1911 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1915 gvdwcT(l,i)=gvdwcT(l,i)-gg(l)
1916 gvdwcT(l,j)=gvdwcT(l,j)+gg(l)
1921 C----------------------------------------------------------------------------
1923 implicit real*8 (a-h,o-z)
1924 include 'DIMENSIONS'
1925 include 'COMMON.CHAIN'
1926 include 'COMMON.DERIV'
1927 include 'COMMON.CALC'
1928 include 'COMMON.IOUNITS'
1929 double precision dcosom1(3),dcosom2(3)
1930 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1931 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1932 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1933 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1937 c eom12=evdwij*eps1_om12
1939 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1940 c & " sigder",sigder
1941 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1942 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1944 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1945 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1948 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
1950 c write (iout,*) "gg",(gg(k),k=1,3)
1952 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1953 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1954 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1955 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1956 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1957 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1958 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1959 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1960 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1961 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1964 C Calculate the components of the gradient in DC and X
1968 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1972 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1973 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1977 C-----------------------------------------------------------------------
1978 subroutine e_softsphere(evdw)
1980 C This subroutine calculates the interaction energy of nonbonded side chains
1981 C assuming the LJ potential of interaction.
1983 implicit real*8 (a-h,o-z)
1984 include 'DIMENSIONS'
1985 parameter (accur=1.0d-10)
1986 include 'COMMON.GEO'
1987 include 'COMMON.VAR'
1988 include 'COMMON.LOCAL'
1989 include 'COMMON.CHAIN'
1990 include 'COMMON.DERIV'
1991 include 'COMMON.INTERACT'
1992 include 'COMMON.TORSION'
1993 include 'COMMON.SBRIDGE'
1994 include 'COMMON.NAMES'
1995 include 'COMMON.IOUNITS'
1996 include 'COMMON.CONTACTS'
1998 include 'COMMON.CONTACTS.MOMENT'
2001 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2003 do i=iatsc_s,iatsc_e
2004 itypi=iabs(itype(i))
2005 itypi1=iabs(itype(i+1))
2010 C Calculate SC interaction energy.
2012 do iint=1,nint_gr(i)
2013 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2014 cd & 'iend=',iend(i,iint)
2015 do j=istart(i,iint),iend(i,iint)
2016 itypj=iabs(itype(j))
2020 rij=xj*xj+yj*yj+zj*zj
2021 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2022 r0ij=r0(itypi,itypj)
2024 c print *,i,j,r0ij,dsqrt(rij)
2025 if (rij.lt.r0ijsq) then
2026 evdwij=0.25d0*(rij-r0ijsq)**2
2034 C Calculate the components of the gradient in DC and X
2040 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2041 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2042 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2043 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2047 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2055 C--------------------------------------------------------------------------
2056 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2059 C Soft-sphere potential of p-p interaction
2061 implicit real*8 (a-h,o-z)
2062 include 'DIMENSIONS'
2063 include 'COMMON.CONTROL'
2064 include 'COMMON.IOUNITS'
2065 include 'COMMON.GEO'
2066 include 'COMMON.VAR'
2067 include 'COMMON.LOCAL'
2068 include 'COMMON.CHAIN'
2069 include 'COMMON.DERIV'
2070 include 'COMMON.INTERACT'
2071 include 'COMMON.CONTACTS'
2073 include 'COMMON.CONTACTS.MOMENT'
2075 include 'COMMON.TORSION'
2076 include 'COMMON.VECTORS'
2077 include 'COMMON.FFIELD'
2079 cd write(iout,*) 'In EELEC_soft_sphere'
2086 do i=iatel_s,iatel_e
2090 xmedi=c(1,i)+0.5d0*dxi
2091 ymedi=c(2,i)+0.5d0*dyi
2092 zmedi=c(3,i)+0.5d0*dzi
2094 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2095 do j=ielstart(i),ielend(i)
2099 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2100 r0ij=rpp(iteli,itelj)
2105 xj=c(1,j)+0.5D0*dxj-xmedi
2106 yj=c(2,j)+0.5D0*dyj-ymedi
2107 zj=c(3,j)+0.5D0*dzj-zmedi
2108 rij=xj*xj+yj*yj+zj*zj
2109 if (rij.lt.r0ijsq) then
2110 evdw1ij=0.25d0*(rij-r0ijsq)**2
2118 C Calculate contributions to the Cartesian gradient.
2124 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2125 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2128 * Loop over residues i+1 thru j-1.
2132 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2137 cgrad do i=nnt,nct-1
2139 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2141 cgrad do j=i+1,nct-1
2143 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2149 c------------------------------------------------------------------------------
2150 subroutine vec_and_deriv
2151 implicit real*8 (a-h,o-z)
2152 include 'DIMENSIONS'
2156 include 'COMMON.IOUNITS'
2157 include 'COMMON.GEO'
2158 include 'COMMON.VAR'
2159 include 'COMMON.LOCAL'
2160 include 'COMMON.CHAIN'
2161 include 'COMMON.VECTORS'
2162 include 'COMMON.SETUP'
2163 include 'COMMON.TIME1'
2164 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2165 C Compute the local reference systems. For reference system (i), the
2166 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2167 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2169 do i=ivec_start,ivec_end
2173 if (i.eq.nres-1) then
2174 C Case of the last full residue
2175 C Compute the Z-axis
2176 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2177 costh=dcos(pi-theta(nres))
2178 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2182 C Compute the derivatives of uz
2184 uzder(2,1,1)=-dc_norm(3,i-1)
2185 uzder(3,1,1)= dc_norm(2,i-1)
2186 uzder(1,2,1)= dc_norm(3,i-1)
2188 uzder(3,2,1)=-dc_norm(1,i-1)
2189 uzder(1,3,1)=-dc_norm(2,i-1)
2190 uzder(2,3,1)= dc_norm(1,i-1)
2193 uzder(2,1,2)= dc_norm(3,i)
2194 uzder(3,1,2)=-dc_norm(2,i)
2195 uzder(1,2,2)=-dc_norm(3,i)
2197 uzder(3,2,2)= dc_norm(1,i)
2198 uzder(1,3,2)= dc_norm(2,i)
2199 uzder(2,3,2)=-dc_norm(1,i)
2201 C Compute the Y-axis
2204 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2206 C Compute the derivatives of uy
2209 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2210 & -dc_norm(k,i)*dc_norm(j,i-1)
2211 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2213 uyder(j,j,1)=uyder(j,j,1)-costh
2214 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2219 uygrad(l,k,j,i)=uyder(l,k,j)
2220 uzgrad(l,k,j,i)=uzder(l,k,j)
2224 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2225 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2226 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2227 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2230 C Compute the Z-axis
2231 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2232 costh=dcos(pi-theta(i+2))
2233 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2237 C Compute the derivatives of uz
2239 uzder(2,1,1)=-dc_norm(3,i+1)
2240 uzder(3,1,1)= dc_norm(2,i+1)
2241 uzder(1,2,1)= dc_norm(3,i+1)
2243 uzder(3,2,1)=-dc_norm(1,i+1)
2244 uzder(1,3,1)=-dc_norm(2,i+1)
2245 uzder(2,3,1)= dc_norm(1,i+1)
2248 uzder(2,1,2)= dc_norm(3,i)
2249 uzder(3,1,2)=-dc_norm(2,i)
2250 uzder(1,2,2)=-dc_norm(3,i)
2252 uzder(3,2,2)= dc_norm(1,i)
2253 uzder(1,3,2)= dc_norm(2,i)
2254 uzder(2,3,2)=-dc_norm(1,i)
2256 C Compute the Y-axis
2259 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2261 C Compute the derivatives of uy
2264 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2265 & -dc_norm(k,i)*dc_norm(j,i+1)
2266 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2268 uyder(j,j,1)=uyder(j,j,1)-costh
2269 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2274 uygrad(l,k,j,i)=uyder(l,k,j)
2275 uzgrad(l,k,j,i)=uzder(l,k,j)
2279 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2280 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2281 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2282 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2286 vbld_inv_temp(1)=vbld_inv(i+1)
2287 if (i.lt.nres-1) then
2288 vbld_inv_temp(2)=vbld_inv(i+2)
2290 vbld_inv_temp(2)=vbld_inv(i)
2295 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2296 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2301 #if defined(PARVEC) && defined(MPI)
2302 if (nfgtasks1.gt.1) then
2304 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2305 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2306 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2307 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2308 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2310 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2311 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2313 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2314 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2315 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2316 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2317 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2318 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2319 time_gather=time_gather+MPI_Wtime()-time00
2321 c if (fg_rank.eq.0) then
2322 c write (iout,*) "Arrays UY and UZ"
2324 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2331 C-----------------------------------------------------------------------------
2332 subroutine check_vecgrad
2333 implicit real*8 (a-h,o-z)
2334 include 'DIMENSIONS'
2335 include 'COMMON.IOUNITS'
2336 include 'COMMON.GEO'
2337 include 'COMMON.VAR'
2338 include 'COMMON.LOCAL'
2339 include 'COMMON.CHAIN'
2340 include 'COMMON.VECTORS'
2341 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2342 dimension uyt(3,maxres),uzt(3,maxres)
2343 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2344 double precision delta /1.0d-7/
2347 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2348 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2349 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2350 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2351 cd & (dc_norm(if90,i),if90=1,3)
2352 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2353 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2354 cd write(iout,'(a)')
2360 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2361 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2374 cd write (iout,*) 'i=',i
2376 erij(k)=dc_norm(k,i)
2380 dc_norm(k,i)=erij(k)
2382 dc_norm(j,i)=dc_norm(j,i)+delta
2383 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2385 c dc_norm(k,i)=dc_norm(k,i)/fac
2387 c write (iout,*) (dc_norm(k,i),k=1,3)
2388 c write (iout,*) (erij(k),k=1,3)
2391 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2392 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2393 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2394 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2396 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2397 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2398 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2401 dc_norm(k,i)=erij(k)
2404 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2405 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2406 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2407 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2408 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2409 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2410 cd write (iout,'(a)')
2415 C--------------------------------------------------------------------------
2416 subroutine set_matrices
2417 implicit real*8 (a-h,o-z)
2418 include 'DIMENSIONS'
2421 include "COMMON.SETUP"
2423 integer status(MPI_STATUS_SIZE)
2425 include 'COMMON.IOUNITS'
2426 include 'COMMON.GEO'
2427 include 'COMMON.VAR'
2428 include 'COMMON.LOCAL'
2429 include 'COMMON.CHAIN'
2430 include 'COMMON.DERIV'
2431 include 'COMMON.INTERACT'
2432 include 'COMMON.CONTACTS'
2434 include 'COMMON.CONTACTS.MOMENT'
2436 include 'COMMON.TORSION'
2437 include 'COMMON.VECTORS'
2438 include 'COMMON.FFIELD'
2439 double precision auxvec(2),auxmat(2,2)
2441 C Compute the virtual-bond-torsional-angle dependent quantities needed
2442 C to calculate the el-loc multibody terms of various order.
2445 do i=ivec_start+2,ivec_end+2
2449 if (i .lt. nres+1) then
2486 if (i .gt. 3 .and. i .lt. nres+1) then
2487 obrot_der(1,i-2)=-sin1
2488 obrot_der(2,i-2)= cos1
2489 Ugder(1,1,i-2)= sin1
2490 Ugder(1,2,i-2)=-cos1
2491 Ugder(2,1,i-2)=-cos1
2492 Ugder(2,2,i-2)=-sin1
2495 obrot2_der(1,i-2)=-dwasin2
2496 obrot2_der(2,i-2)= dwacos2
2497 Ug2der(1,1,i-2)= dwasin2
2498 Ug2der(1,2,i-2)=-dwacos2
2499 Ug2der(2,1,i-2)=-dwacos2
2500 Ug2der(2,2,i-2)=-dwasin2
2502 obrot_der(1,i-2)=0.0d0
2503 obrot_der(2,i-2)=0.0d0
2504 Ugder(1,1,i-2)=0.0d0
2505 Ugder(1,2,i-2)=0.0d0
2506 Ugder(2,1,i-2)=0.0d0
2507 Ugder(2,2,i-2)=0.0d0
2508 obrot2_der(1,i-2)=0.0d0
2509 obrot2_der(2,i-2)=0.0d0
2510 Ug2der(1,1,i-2)=0.0d0
2511 Ug2der(1,2,i-2)=0.0d0
2512 Ug2der(2,1,i-2)=0.0d0
2513 Ug2der(2,2,i-2)=0.0d0
2515 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2516 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2517 iti = itortyp(itype(i-2))
2521 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2522 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2523 iti1 = itortyp(itype(i-1))
2527 cd write (iout,*) '*******i',i,' iti1',iti
2528 cd write (iout,*) 'b1',b1(:,iti)
2529 cd write (iout,*) 'b2',b2(:,iti)
2530 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2531 c if (i .gt. iatel_s+2) then
2532 if (i .gt. nnt+2) then
2533 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2534 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2535 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2537 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2538 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2539 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2540 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2541 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2552 DtUg2(l,k,i-2)=0.0d0
2556 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2557 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2559 muder(k,i-2)=Ub2der(k,i-2)
2561 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2562 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2563 iti1 = itortyp(itype(i-1))
2568 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2570 cd write (iout,*) 'mu ',mu(:,i-2)
2571 cd write (iout,*) 'mu1',mu1(:,i-2)
2572 cd write (iout,*) 'mu2',mu2(:,i-2)
2573 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2575 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2576 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2577 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2578 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2579 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2580 C Vectors and matrices dependent on a single virtual-bond dihedral.
2581 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2582 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2583 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2584 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2585 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2586 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2587 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2588 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2589 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2592 C Matrices dependent on two consecutive virtual-bond dihedrals.
2593 C The order of matrices is from left to right.
2594 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2596 c do i=max0(ivec_start,2),ivec_end
2598 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2599 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2600 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2601 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2602 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2603 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2604 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2605 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2608 #if defined(MPI) && defined(PARMAT)
2610 c if (fg_rank.eq.0) then
2611 write (iout,*) "Arrays UG and UGDER before GATHER"
2613 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2614 & ((ug(l,k,i),l=1,2),k=1,2),
2615 & ((ugder(l,k,i),l=1,2),k=1,2)
2617 write (iout,*) "Arrays UG2 and UG2DER"
2619 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2620 & ((ug2(l,k,i),l=1,2),k=1,2),
2621 & ((ug2der(l,k,i),l=1,2),k=1,2)
2623 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2625 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2626 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2627 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2629 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2631 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2632 & costab(i),sintab(i),costab2(i),sintab2(i)
2634 write (iout,*) "Array MUDER"
2636 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2640 if (nfgtasks.gt.1) then
2642 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2643 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2644 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2646 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2647 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2649 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2650 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2652 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2653 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2655 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2656 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2658 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2659 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2661 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2662 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2664 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2665 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2666 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2667 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2668 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2669 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2670 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2671 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2672 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2673 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2674 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2675 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2676 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2678 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2679 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2681 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2682 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2684 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2685 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2687 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2688 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2690 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2691 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2693 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2694 & ivec_count(fg_rank1),
2695 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2697 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2698 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2700 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2701 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2703 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2704 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2706 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2707 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2709 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2710 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2712 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2713 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2715 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2716 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2718 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2719 & ivec_count(fg_rank1),
2720 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2722 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2723 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2725 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2726 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2728 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2729 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2731 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2732 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2734 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2735 & ivec_count(fg_rank1),
2736 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2738 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2739 & ivec_count(fg_rank1),
2740 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2742 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2743 & ivec_count(fg_rank1),
2744 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2745 & MPI_MAT2,FG_COMM1,IERR)
2746 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2747 & ivec_count(fg_rank1),
2748 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2749 & MPI_MAT2,FG_COMM1,IERR)
2752 c Passes matrix info through the ring
2755 if (irecv.lt.0) irecv=nfgtasks1-1
2758 if (inext.ge.nfgtasks1) inext=0
2760 c write (iout,*) "isend",isend," irecv",irecv
2762 lensend=lentyp(isend)
2763 lenrecv=lentyp(irecv)
2764 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2765 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2766 c & MPI_ROTAT1(lensend),inext,2200+isend,
2767 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2768 c & iprev,2200+irecv,FG_COMM,status,IERR)
2769 c write (iout,*) "Gather ROTAT1"
2771 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2772 c & MPI_ROTAT2(lensend),inext,3300+isend,
2773 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2774 c & iprev,3300+irecv,FG_COMM,status,IERR)
2775 c write (iout,*) "Gather ROTAT2"
2777 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2778 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2779 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2780 & iprev,4400+irecv,FG_COMM,status,IERR)
2781 c write (iout,*) "Gather ROTAT_OLD"
2783 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2784 & MPI_PRECOMP11(lensend),inext,5500+isend,
2785 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2786 & iprev,5500+irecv,FG_COMM,status,IERR)
2787 c write (iout,*) "Gather PRECOMP11"
2789 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2790 & MPI_PRECOMP12(lensend),inext,6600+isend,
2791 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2792 & iprev,6600+irecv,FG_COMM,status,IERR)
2793 c write (iout,*) "Gather PRECOMP12"
2795 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2797 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2798 & MPI_ROTAT2(lensend),inext,7700+isend,
2799 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2800 & iprev,7700+irecv,FG_COMM,status,IERR)
2801 c write (iout,*) "Gather PRECOMP21"
2803 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2804 & MPI_PRECOMP22(lensend),inext,8800+isend,
2805 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2806 & iprev,8800+irecv,FG_COMM,status,IERR)
2807 c write (iout,*) "Gather PRECOMP22"
2809 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2810 & MPI_PRECOMP23(lensend),inext,9900+isend,
2811 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2812 & MPI_PRECOMP23(lenrecv),
2813 & iprev,9900+irecv,FG_COMM,status,IERR)
2814 c write (iout,*) "Gather PRECOMP23"
2819 if (irecv.lt.0) irecv=nfgtasks1-1
2822 time_gather=time_gather+MPI_Wtime()-time00
2825 c if (fg_rank.eq.0) then
2826 write (iout,*) "Arrays UG and UGDER"
2828 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2829 & ((ug(l,k,i),l=1,2),k=1,2),
2830 & ((ugder(l,k,i),l=1,2),k=1,2)
2832 write (iout,*) "Arrays UG2 and UG2DER"
2834 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2835 & ((ug2(l,k,i),l=1,2),k=1,2),
2836 & ((ug2der(l,k,i),l=1,2),k=1,2)
2838 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2840 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2841 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2842 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2844 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2846 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2847 & costab(i),sintab(i),costab2(i),sintab2(i)
2849 write (iout,*) "Array MUDER"
2851 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2857 cd iti = itortyp(itype(i))
2860 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2861 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2866 C--------------------------------------------------------------------------
2867 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2869 C This subroutine calculates the average interaction energy and its gradient
2870 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2871 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2872 C The potential depends both on the distance of peptide-group centers and on
2873 C the orientation of the CA-CA virtual bonds.
2875 implicit real*8 (a-h,o-z)
2879 include 'DIMENSIONS'
2880 include 'COMMON.CONTROL'
2881 include 'COMMON.SETUP'
2882 include 'COMMON.IOUNITS'
2883 include 'COMMON.GEO'
2884 include 'COMMON.VAR'
2885 include 'COMMON.LOCAL'
2886 include 'COMMON.CHAIN'
2887 include 'COMMON.DERIV'
2888 include 'COMMON.INTERACT'
2889 include 'COMMON.CONTACTS'
2891 include 'COMMON.CONTACTS.MOMENT'
2893 include 'COMMON.TORSION'
2894 include 'COMMON.VECTORS'
2895 include 'COMMON.FFIELD'
2896 include 'COMMON.TIME1'
2897 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2898 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2899 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2900 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2901 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2902 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2904 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2906 double precision scal_el /1.0d0/
2908 double precision scal_el /0.5d0/
2911 C 13-go grudnia roku pamietnego...
2912 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2913 & 0.0d0,1.0d0,0.0d0,
2914 & 0.0d0,0.0d0,1.0d0/
2915 cd write(iout,*) 'In EELEC'
2917 cd write(iout,*) 'Type',i
2918 cd write(iout,*) 'B1',B1(:,i)
2919 cd write(iout,*) 'B2',B2(:,i)
2920 cd write(iout,*) 'CC',CC(:,:,i)
2921 cd write(iout,*) 'DD',DD(:,:,i)
2922 cd write(iout,*) 'EE',EE(:,:,i)
2924 cd call check_vecgrad
2926 if (icheckgrad.eq.1) then
2928 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2930 dc_norm(k,i)=dc(k,i)*fac
2932 c write (iout,*) 'i',i,' fac',fac
2935 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2936 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2937 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2938 c call vec_and_deriv
2944 time_mat=time_mat+MPI_Wtime()-time01
2948 cd write (iout,*) 'i=',i
2950 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2953 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2954 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2967 cd print '(a)','Enter EELEC'
2968 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2970 gel_loc_loc(i)=0.0d0
2975 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2977 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2979 do i=iturn3_start,iturn3_end
2983 dx_normi=dc_norm(1,i)
2984 dy_normi=dc_norm(2,i)
2985 dz_normi=dc_norm(3,i)
2986 xmedi=c(1,i)+0.5d0*dxi
2987 ymedi=c(2,i)+0.5d0*dyi
2988 zmedi=c(3,i)+0.5d0*dzi
2990 call eelecij(i,i+2,ees,evdw1,eel_loc)
2991 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
2992 num_cont_hb(i)=num_conti
2994 do i=iturn4_start,iturn4_end
2998 dx_normi=dc_norm(1,i)
2999 dy_normi=dc_norm(2,i)
3000 dz_normi=dc_norm(3,i)
3001 xmedi=c(1,i)+0.5d0*dxi
3002 ymedi=c(2,i)+0.5d0*dyi
3003 zmedi=c(3,i)+0.5d0*dzi
3004 num_conti=num_cont_hb(i)
3005 call eelecij(i,i+3,ees,evdw1,eel_loc)
3006 if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
3007 num_cont_hb(i)=num_conti
3010 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3012 do i=iatel_s,iatel_e
3016 dx_normi=dc_norm(1,i)
3017 dy_normi=dc_norm(2,i)
3018 dz_normi=dc_norm(3,i)
3019 xmedi=c(1,i)+0.5d0*dxi
3020 ymedi=c(2,i)+0.5d0*dyi
3021 zmedi=c(3,i)+0.5d0*dzi
3022 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3023 num_conti=num_cont_hb(i)
3024 do j=ielstart(i),ielend(i)
3025 call eelecij(i,j,ees,evdw1,eel_loc)
3027 num_cont_hb(i)=num_conti
3029 c write (iout,*) "Number of loop steps in EELEC:",ind
3031 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3032 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3034 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3035 ccc eel_loc=eel_loc+eello_turn3
3036 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3039 C-------------------------------------------------------------------------------
3040 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3041 implicit real*8 (a-h,o-z)
3042 include 'DIMENSIONS'
3046 include 'COMMON.CONTROL'
3047 include 'COMMON.IOUNITS'
3048 include 'COMMON.GEO'
3049 include 'COMMON.VAR'
3050 include 'COMMON.LOCAL'
3051 include 'COMMON.CHAIN'
3052 include 'COMMON.DERIV'
3053 include 'COMMON.INTERACT'
3054 include 'COMMON.CONTACTS'
3056 include 'COMMON.CONTACTS.MOMENT'
3058 include 'COMMON.TORSION'
3059 include 'COMMON.VECTORS'
3060 include 'COMMON.FFIELD'
3061 include 'COMMON.TIME1'
3062 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3063 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3064 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3065 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3066 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3067 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3069 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3071 double precision scal_el /1.0d0/
3073 double precision scal_el /0.5d0/
3076 C 13-go grudnia roku pamietnego...
3077 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3078 & 0.0d0,1.0d0,0.0d0,
3079 & 0.0d0,0.0d0,1.0d0/
3080 c time00=MPI_Wtime()
3081 cd write (iout,*) "eelecij",i,j
3085 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3086 aaa=app(iteli,itelj)
3087 bbb=bpp(iteli,itelj)
3088 ael6i=ael6(iteli,itelj)
3089 ael3i=ael3(iteli,itelj)
3093 dx_normj=dc_norm(1,j)
3094 dy_normj=dc_norm(2,j)
3095 dz_normj=dc_norm(3,j)
3096 xj=c(1,j)+0.5D0*dxj-xmedi
3097 yj=c(2,j)+0.5D0*dyj-ymedi
3098 zj=c(3,j)+0.5D0*dzj-zmedi
3099 rij=xj*xj+yj*yj+zj*zj
3105 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3106 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3107 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3108 fac=cosa-3.0D0*cosb*cosg
3110 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3111 if (j.eq.i+2) ev1=scal_el*ev1
3116 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3119 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3120 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3123 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3124 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3125 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3126 cd & xmedi,ymedi,zmedi,xj,yj,zj
3128 if (energy_dec) then
3129 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
3130 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3134 C Calculate contributions to the Cartesian gradient.
3137 facvdw=-6*rrmij*(ev1+evdwij)
3138 facel=-3*rrmij*(el1+eesij)
3144 * Radial derivatives. First process both termini of the fragment (i,j)
3150 c ghalf=0.5D0*ggg(k)
3151 c gelc(k,i)=gelc(k,i)+ghalf
3152 c gelc(k,j)=gelc(k,j)+ghalf
3154 c 9/28/08 AL Gradient compotents will be summed only at the end
3156 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3157 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3160 * Loop over residues i+1 thru j-1.
3164 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3171 c ghalf=0.5D0*ggg(k)
3172 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3173 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3175 c 9/28/08 AL Gradient compotents will be summed only at the end
3177 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3178 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3181 * Loop over residues i+1 thru j-1.
3185 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3192 fac=-3*rrmij*(facvdw+facvdw+facel)
3197 * Radial derivatives. First process both termini of the fragment (i,j)
3203 c ghalf=0.5D0*ggg(k)
3204 c gelc(k,i)=gelc(k,i)+ghalf
3205 c gelc(k,j)=gelc(k,j)+ghalf
3207 c 9/28/08 AL Gradient compotents will be summed only at the end
3209 gelc_long(k,j)=gelc(k,j)+ggg(k)
3210 gelc_long(k,i)=gelc(k,i)-ggg(k)
3213 * Loop over residues i+1 thru j-1.
3217 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3220 c 9/28/08 AL Gradient compotents will be summed only at the end
3225 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3226 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3232 ecosa=2.0D0*fac3*fac1+fac4
3235 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3236 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3238 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3239 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3241 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3242 cd & (dcosg(k),k=1,3)
3244 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3247 c ghalf=0.5D0*ggg(k)
3248 c gelc(k,i)=gelc(k,i)+ghalf
3249 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3250 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3251 c gelc(k,j)=gelc(k,j)+ghalf
3252 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3253 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3257 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3262 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3263 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3265 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3266 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3267 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3268 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3270 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3271 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3272 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3274 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3275 C energy of a peptide unit is assumed in the form of a second-order
3276 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3277 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3278 C are computed for EVERY pair of non-contiguous peptide groups.
3280 if (j.lt.nres-1) then
3291 muij(kkk)=mu(k,i)*mu(l,j)
3294 cd write (iout,*) 'EELEC: i',i,' j',j
3295 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3296 cd write(iout,*) 'muij',muij
3297 ury=scalar(uy(1,i),erij)
3298 urz=scalar(uz(1,i),erij)
3299 vry=scalar(uy(1,j),erij)
3300 vrz=scalar(uz(1,j),erij)
3301 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3302 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3303 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3304 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3305 fac=dsqrt(-ael6i)*r3ij
3310 cd write (iout,'(4i5,4f10.5)')
3311 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3312 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3313 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3314 cd & uy(:,j),uz(:,j)
3315 cd write (iout,'(4f10.5)')
3316 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3317 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3318 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3319 cd write (iout,'(9f10.5/)')
3320 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3321 C Derivatives of the elements of A in virtual-bond vectors
3322 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3324 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3325 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3326 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3327 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3328 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3329 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3330 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3331 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3332 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3333 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3334 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3335 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3337 C Compute radial contributions to the gradient
3355 C Add the contributions coming from er
3358 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3359 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3360 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3361 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3364 C Derivatives in DC(i)
3365 cgrad ghalf1=0.5d0*agg(k,1)
3366 cgrad ghalf2=0.5d0*agg(k,2)
3367 cgrad ghalf3=0.5d0*agg(k,3)
3368 cgrad ghalf4=0.5d0*agg(k,4)
3369 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3370 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3371 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3372 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3373 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3374 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3375 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3376 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3377 C Derivatives in DC(i+1)
3378 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3379 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3380 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3381 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3382 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3383 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3384 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3385 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3386 C Derivatives in DC(j)
3387 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3388 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3389 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3390 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3391 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3392 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3393 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3394 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3395 C Derivatives in DC(j+1) or DC(nres-1)
3396 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3397 & -3.0d0*vryg(k,3)*ury)
3398 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3399 & -3.0d0*vrzg(k,3)*ury)
3400 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3401 & -3.0d0*vryg(k,3)*urz)
3402 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3403 & -3.0d0*vrzg(k,3)*urz)
3404 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3406 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3419 aggi(k,l)=-aggi(k,l)
3420 aggi1(k,l)=-aggi1(k,l)
3421 aggj(k,l)=-aggj(k,l)
3422 aggj1(k,l)=-aggj1(k,l)
3425 if (j.lt.nres-1) then
3431 aggi(k,l)=-aggi(k,l)
3432 aggi1(k,l)=-aggi1(k,l)
3433 aggj(k,l)=-aggj(k,l)
3434 aggj1(k,l)=-aggj1(k,l)
3445 aggi(k,l)=-aggi(k,l)
3446 aggi1(k,l)=-aggi1(k,l)
3447 aggj(k,l)=-aggj(k,l)
3448 aggj1(k,l)=-aggj1(k,l)
3453 IF (wel_loc.gt.0.0d0) THEN
3454 C Contribution to the local-electrostatic energy coming from the i-j pair
3455 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3457 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3459 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3460 & 'eelloc',i,j,eel_loc_ij
3462 eel_loc=eel_loc+eel_loc_ij
3463 C Partial derivatives in virtual-bond dihedral angles gamma
3465 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3466 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3467 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3468 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3469 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3470 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3471 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3473 ggg(l)=agg(l,1)*muij(1)+
3474 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3475 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3476 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3477 cgrad ghalf=0.5d0*ggg(l)
3478 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3479 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3483 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3486 C Remaining derivatives of eello
3488 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
3489 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
3490 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
3491 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
3492 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
3493 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
3494 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
3495 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
3498 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3499 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3500 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3501 & .and. num_conti.le.maxconts) then
3502 c write (iout,*) i,j," entered corr"
3504 C Calculate the contact function. The ith column of the array JCONT will
3505 C contain the numbers of atoms that make contacts with the atom I (of numbers
3506 C greater than I). The arrays FACONT and GACONT will contain the values of
3507 C the contact function and its derivative.
3508 c r0ij=1.02D0*rpp(iteli,itelj)
3509 c r0ij=1.11D0*rpp(iteli,itelj)
3510 r0ij=2.20D0*rpp(iteli,itelj)
3511 c r0ij=1.55D0*rpp(iteli,itelj)
3512 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3513 if (fcont.gt.0.0D0) then
3514 num_conti=num_conti+1
3515 if (num_conti.gt.maxconts) then
3516 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3517 & ' will skip next contacts for this conf.'
3519 jcont_hb(num_conti,i)=j
3520 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3521 cd & " jcont_hb",jcont_hb(num_conti,i)
3522 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3523 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3524 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3526 d_cont(num_conti,i)=rij
3527 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3528 C --- Electrostatic-interaction matrix ---
3529 a_chuj(1,1,num_conti,i)=a22
3530 a_chuj(1,2,num_conti,i)=a23
3531 a_chuj(2,1,num_conti,i)=a32
3532 a_chuj(2,2,num_conti,i)=a33
3533 C --- Gradient of rij
3535 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3542 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3543 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3544 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3545 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3546 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3551 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3552 C Calculate contact energies
3554 wij=cosa-3.0D0*cosb*cosg
3557 c fac3=dsqrt(-ael6i)/r0ij**3
3558 fac3=dsqrt(-ael6i)*r3ij
3559 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3560 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3561 if (ees0tmp.gt.0) then
3562 ees0pij=dsqrt(ees0tmp)
3566 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3567 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3568 if (ees0tmp.gt.0) then
3569 ees0mij=dsqrt(ees0tmp)
3574 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3575 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3576 C Diagnostics. Comment out or remove after debugging!
3577 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3578 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3579 c ees0m(num_conti,i)=0.0D0
3581 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3582 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3583 C Angular derivatives of the contact function
3584 ees0pij1=fac3/ees0pij
3585 ees0mij1=fac3/ees0mij
3586 fac3p=-3.0D0*fac3*rrmij
3587 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3588 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3590 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3591 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3592 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3593 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3594 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3595 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3596 ecosap=ecosa1+ecosa2
3597 ecosbp=ecosb1+ecosb2
3598 ecosgp=ecosg1+ecosg2
3599 ecosam=ecosa1-ecosa2
3600 ecosbm=ecosb1-ecosb2
3601 ecosgm=ecosg1-ecosg2
3610 facont_hb(num_conti,i)=fcont
3611 fprimcont=fprimcont/rij
3612 cd facont_hb(num_conti,i)=1.0D0
3613 C Following line is for diagnostics.
3616 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3617 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3620 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3621 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3623 gggp(1)=gggp(1)+ees0pijp*xj
3624 gggp(2)=gggp(2)+ees0pijp*yj
3625 gggp(3)=gggp(3)+ees0pijp*zj
3626 gggm(1)=gggm(1)+ees0mijp*xj
3627 gggm(2)=gggm(2)+ees0mijp*yj
3628 gggm(3)=gggm(3)+ees0mijp*zj
3629 C Derivatives due to the contact function
3630 gacont_hbr(1,num_conti,i)=fprimcont*xj
3631 gacont_hbr(2,num_conti,i)=fprimcont*yj
3632 gacont_hbr(3,num_conti,i)=fprimcont*zj
3635 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3636 c following the change of gradient-summation algorithm.
3638 cgrad ghalfp=0.5D0*gggp(k)
3639 cgrad ghalfm=0.5D0*gggm(k)
3640 gacontp_hb1(k,num_conti,i)=!ghalfp
3641 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3642 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3643 gacontp_hb2(k,num_conti,i)=!ghalfp
3644 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3645 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3646 gacontp_hb3(k,num_conti,i)=gggp(k)
3647 gacontm_hb1(k,num_conti,i)=!ghalfm
3648 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3649 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3650 gacontm_hb2(k,num_conti,i)=!ghalfm
3651 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3652 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3653 gacontm_hb3(k,num_conti,i)=gggm(k)
3655 C Diagnostics. Comment out or remove after debugging!
3657 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3658 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3659 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3660 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3661 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3662 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3665 endif ! num_conti.le.maxconts
3668 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3671 ghalf=0.5d0*agg(l,k)
3672 aggi(l,k)=aggi(l,k)+ghalf
3673 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3674 aggj(l,k)=aggj(l,k)+ghalf
3677 if (j.eq.nres-1 .and. i.lt.j-2) then
3680 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3685 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3688 C-----------------------------------------------------------------------------
3689 subroutine eturn3(i,eello_turn3)
3690 C Third- and fourth-order contributions from turns
3691 implicit real*8 (a-h,o-z)
3692 include 'DIMENSIONS'
3693 include 'COMMON.IOUNITS'
3694 include 'COMMON.GEO'
3695 include 'COMMON.VAR'
3696 include 'COMMON.LOCAL'
3697 include 'COMMON.CHAIN'
3698 include 'COMMON.DERIV'
3699 include 'COMMON.INTERACT'
3700 include 'COMMON.CONTACTS'
3702 include 'COMMON.CONTACTS.MOMENT'
3704 include 'COMMON.TORSION'
3705 include 'COMMON.VECTORS'
3706 include 'COMMON.FFIELD'
3707 include 'COMMON.CONTROL'
3709 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3710 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3711 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3712 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3713 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3714 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3715 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3718 c write (iout,*) "eturn3",i,j,j1,j2
3723 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3725 C Third-order contributions
3732 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3733 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3734 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3735 call transpose2(auxmat(1,1),auxmat1(1,1))
3736 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3737 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3738 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3739 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3740 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3741 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3742 cd & ' eello_turn3_num',4*eello_turn3_num
3743 C Derivatives in gamma(i)
3744 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3745 call transpose2(auxmat2(1,1),auxmat3(1,1))
3746 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3747 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3748 C Derivatives in gamma(i+1)
3749 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3750 call transpose2(auxmat2(1,1),auxmat3(1,1))
3751 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3752 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3753 & +0.5d0*(pizda(1,1)+pizda(2,2))
3754 C Cartesian derivatives
3756 c ghalf1=0.5d0*agg(l,1)
3757 c ghalf2=0.5d0*agg(l,2)
3758 c ghalf3=0.5d0*agg(l,3)
3759 c ghalf4=0.5d0*agg(l,4)
3760 a_temp(1,1)=aggi(l,1)!+ghalf1
3761 a_temp(1,2)=aggi(l,2)!+ghalf2
3762 a_temp(2,1)=aggi(l,3)!+ghalf3
3763 a_temp(2,2)=aggi(l,4)!+ghalf4
3764 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3765 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3766 & +0.5d0*(pizda(1,1)+pizda(2,2))
3767 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3768 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3769 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3770 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3771 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3772 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3773 & +0.5d0*(pizda(1,1)+pizda(2,2))
3774 a_temp(1,1)=aggj(l,1)!+ghalf1
3775 a_temp(1,2)=aggj(l,2)!+ghalf2
3776 a_temp(2,1)=aggj(l,3)!+ghalf3
3777 a_temp(2,2)=aggj(l,4)!+ghalf4
3778 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3779 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3780 & +0.5d0*(pizda(1,1)+pizda(2,2))
3781 a_temp(1,1)=aggj1(l,1)
3782 a_temp(1,2)=aggj1(l,2)
3783 a_temp(2,1)=aggj1(l,3)
3784 a_temp(2,2)=aggj1(l,4)
3785 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3786 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3787 & +0.5d0*(pizda(1,1)+pizda(2,2))
3791 C-------------------------------------------------------------------------------
3792 subroutine eturn4(i,eello_turn4)
3793 C Third- and fourth-order contributions from turns
3794 implicit real*8 (a-h,o-z)
3795 include 'DIMENSIONS'
3796 include 'COMMON.IOUNITS'
3797 include 'COMMON.GEO'
3798 include 'COMMON.VAR'
3799 include 'COMMON.LOCAL'
3800 include 'COMMON.CHAIN'
3801 include 'COMMON.DERIV'
3802 include 'COMMON.INTERACT'
3803 include 'COMMON.CONTACTS'
3805 include 'COMMON.CONTACTS.MOMENT'
3807 include 'COMMON.TORSION'
3808 include 'COMMON.VECTORS'
3809 include 'COMMON.FFIELD'
3810 include 'COMMON.CONTROL'
3812 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3813 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3814 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3815 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3816 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3817 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3818 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3821 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3823 C Fourth-order contributions
3831 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3832 cd call checkint_turn4(i,a_temp,eello_turn4_num)
3833 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
3838 iti1=itortyp(itype(i+1))
3839 iti2=itortyp(itype(i+2))
3840 iti3=itortyp(itype(i+3))
3841 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
3842 call transpose2(EUg(1,1,i+1),e1t(1,1))
3843 call transpose2(Eug(1,1,i+2),e2t(1,1))
3844 call transpose2(Eug(1,1,i+3),e3t(1,1))
3845 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3846 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3847 s1=scalar2(b1(1,iti2),auxvec(1))
3848 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3849 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3850 s2=scalar2(b1(1,iti1),auxvec(1))
3851 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3852 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3853 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3854 eello_turn4=eello_turn4-(s1+s2+s3)
3855 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3856 & 'eturn4',i,j,-(s1+s2+s3)
3857 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
3858 cd & ' eello_turn4_num',8*eello_turn4_num
3859 C Derivatives in gamma(i)
3860 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
3861 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
3862 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
3863 s1=scalar2(b1(1,iti2),auxvec(1))
3864 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
3865 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3866 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
3867 C Derivatives in gamma(i+1)
3868 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
3869 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
3870 s2=scalar2(b1(1,iti1),auxvec(1))
3871 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
3872 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
3873 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3874 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
3875 C Derivatives in gamma(i+2)
3876 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
3877 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
3878 s1=scalar2(b1(1,iti2),auxvec(1))
3879 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
3880 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
3881 s2=scalar2(b1(1,iti1),auxvec(1))
3882 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
3883 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
3884 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3885 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
3886 C Cartesian derivatives
3887 C Derivatives of this turn contributions in DC(i+2)
3888 if (j.lt.nres-1) then
3890 a_temp(1,1)=agg(l,1)
3891 a_temp(1,2)=agg(l,2)
3892 a_temp(2,1)=agg(l,3)
3893 a_temp(2,2)=agg(l,4)
3894 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3895 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3896 s1=scalar2(b1(1,iti2),auxvec(1))
3897 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3898 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3899 s2=scalar2(b1(1,iti1),auxvec(1))
3900 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3901 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3902 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3904 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
3907 C Remaining derivatives of this turn contribution
3909 a_temp(1,1)=aggi(l,1)
3910 a_temp(1,2)=aggi(l,2)
3911 a_temp(2,1)=aggi(l,3)
3912 a_temp(2,2)=aggi(l,4)
3913 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3914 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3915 s1=scalar2(b1(1,iti2),auxvec(1))
3916 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3917 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3918 s2=scalar2(b1(1,iti1),auxvec(1))
3919 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3920 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3921 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3922 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
3923 a_temp(1,1)=aggi1(l,1)
3924 a_temp(1,2)=aggi1(l,2)
3925 a_temp(2,1)=aggi1(l,3)
3926 a_temp(2,2)=aggi1(l,4)
3927 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3928 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3929 s1=scalar2(b1(1,iti2),auxvec(1))
3930 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3931 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3932 s2=scalar2(b1(1,iti1),auxvec(1))
3933 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3934 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3935 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3936 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
3937 a_temp(1,1)=aggj(l,1)
3938 a_temp(1,2)=aggj(l,2)
3939 a_temp(2,1)=aggj(l,3)
3940 a_temp(2,2)=aggj(l,4)
3941 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3942 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3943 s1=scalar2(b1(1,iti2),auxvec(1))
3944 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3945 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3946 s2=scalar2(b1(1,iti1),auxvec(1))
3947 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3948 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3949 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3950 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
3951 a_temp(1,1)=aggj1(l,1)
3952 a_temp(1,2)=aggj1(l,2)
3953 a_temp(2,1)=aggj1(l,3)
3954 a_temp(2,2)=aggj1(l,4)
3955 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
3956 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
3957 s1=scalar2(b1(1,iti2),auxvec(1))
3958 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
3959 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
3960 s2=scalar2(b1(1,iti1),auxvec(1))
3961 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
3962 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
3963 s3=0.5d0*(pizda(1,1)+pizda(2,2))
3964 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
3965 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
3969 C-----------------------------------------------------------------------------
3970 subroutine vecpr(u,v,w)
3971 implicit real*8(a-h,o-z)
3972 dimension u(3),v(3),w(3)
3973 w(1)=u(2)*v(3)-u(3)*v(2)
3974 w(2)=-u(1)*v(3)+u(3)*v(1)
3975 w(3)=u(1)*v(2)-u(2)*v(1)
3978 C-----------------------------------------------------------------------------
3979 subroutine unormderiv(u,ugrad,unorm,ungrad)
3980 C This subroutine computes the derivatives of a normalized vector u, given
3981 C the derivatives computed without normalization conditions, ugrad. Returns
3984 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
3985 double precision vec(3)
3986 double precision scalar
3988 c write (2,*) 'ugrad',ugrad
3991 vec(i)=scalar(ugrad(1,i),u(1))
3993 c write (2,*) 'vec',vec
3996 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
3999 c write (2,*) 'ungrad',ungrad
4002 C-----------------------------------------------------------------------------
4003 subroutine escp_soft_sphere(evdw2,evdw2_14)
4005 C This subroutine calculates the excluded-volume interaction energy between
4006 C peptide-group centers and side chains and its gradient in virtual-bond and
4007 C side-chain vectors.
4009 implicit real*8 (a-h,o-z)
4010 include 'DIMENSIONS'
4011 include 'COMMON.GEO'
4012 include 'COMMON.VAR'
4013 include 'COMMON.LOCAL'
4014 include 'COMMON.CHAIN'
4015 include 'COMMON.DERIV'
4016 include 'COMMON.INTERACT'
4017 include 'COMMON.FFIELD'
4018 include 'COMMON.IOUNITS'
4019 include 'COMMON.CONTROL'
4024 cd print '(a)','Enter ESCP'
4025 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4026 do i=iatscp_s,iatscp_e
4028 xi=0.5D0*(c(1,i)+c(1,i+1))
4029 yi=0.5D0*(c(2,i)+c(2,i+1))
4030 zi=0.5D0*(c(3,i)+c(3,i+1))
4032 do iint=1,nscp_gr(i)
4034 do j=iscpstart(i,iint),iscpend(i,iint)
4035 itypj=iabs(itype(j))
4036 C Uncomment following three lines for SC-p interactions
4040 C Uncomment following three lines for Ca-p interactions
4044 rij=xj*xj+yj*yj+zj*zj
4047 if (rij.lt.r0ijsq) then
4048 evdwij=0.25d0*(rij-r0ijsq)**2
4056 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4061 cgrad if (j.lt.i) then
4062 cd write (iout,*) 'j<i'
4063 C Uncomment following three lines for SC-p interactions
4065 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4068 cd write (iout,*) 'j>i'
4070 cgrad ggg(k)=-ggg(k)
4071 C Uncomment following line for SC-p interactions
4072 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4076 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4078 cgrad kstart=min0(i+1,j)
4079 cgrad kend=max0(i-1,j-1)
4080 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4081 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4082 cgrad do k=kstart,kend
4084 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4088 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4089 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4097 C-----------------------------------------------------------------------------
4098 subroutine escp(evdw2,evdw2_14)
4100 C This subroutine calculates the excluded-volume interaction energy between
4101 C peptide-group centers and side chains and its gradient in virtual-bond and
4102 C side-chain vectors.
4104 implicit real*8 (a-h,o-z)
4105 include 'DIMENSIONS'
4106 include 'COMMON.GEO'
4107 include 'COMMON.VAR'
4108 include 'COMMON.LOCAL'
4109 include 'COMMON.CHAIN'
4110 include 'COMMON.DERIV'
4111 include 'COMMON.INTERACT'
4112 include 'COMMON.FFIELD'
4113 include 'COMMON.IOUNITS'
4114 include 'COMMON.CONTROL'
4118 cd print '(a)','Enter ESCP'
4119 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4120 do i=iatscp_s,iatscp_e
4122 xi=0.5D0*(c(1,i)+c(1,i+1))
4123 yi=0.5D0*(c(2,i)+c(2,i+1))
4124 zi=0.5D0*(c(3,i)+c(3,i+1))
4126 do iint=1,nscp_gr(i)
4128 do j=iscpstart(i,iint),iscpend(i,iint)
4129 itypj=iabs(itype(j))
4130 C Uncomment following three lines for SC-p interactions
4134 C Uncomment following three lines for Ca-p interactions
4138 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4140 e1=fac*fac*aad(itypj,iteli)
4141 e2=fac*bad(itypj,iteli)
4142 if (iabs(j-i) .le. 2) then
4145 evdw2_14=evdw2_14+e1+e2
4149 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4150 & 'evdw2',i,j,evdwij
4152 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4154 fac=-(evdwij+e1)*rrij
4158 cgrad if (j.lt.i) then
4159 cd write (iout,*) 'j<i'
4160 C Uncomment following three lines for SC-p interactions
4162 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4165 cd write (iout,*) 'j>i'
4167 cgrad ggg(k)=-ggg(k)
4168 C Uncomment following line for SC-p interactions
4169 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4170 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4174 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4176 cgrad kstart=min0(i+1,j)
4177 cgrad kend=max0(i-1,j-1)
4178 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4179 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4180 cgrad do k=kstart,kend
4182 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4186 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4187 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4195 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4196 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4197 gradx_scp(j,i)=expon*gradx_scp(j,i)
4200 C******************************************************************************
4204 C To save time the factor EXPON has been extracted from ALL components
4205 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4208 C******************************************************************************
4211 C--------------------------------------------------------------------------
4212 subroutine edis(ehpb)
4214 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4216 implicit real*8 (a-h,o-z)
4217 include 'DIMENSIONS'
4218 include 'COMMON.SBRIDGE'
4219 include 'COMMON.CHAIN'
4220 include 'COMMON.DERIV'
4221 include 'COMMON.VAR'
4222 include 'COMMON.INTERACT'
4223 include 'COMMON.IOUNITS'
4226 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4227 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4228 if (link_end.eq.0) return
4229 do i=link_start,link_end
4230 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4231 C CA-CA distance used in regularization of structure.
4234 C iii and jjj point to the residues for which the distance is assigned.
4235 if (ii.gt.nres) then
4242 cd write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj
4243 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4244 C distance and angle dependent SS bond potential.
4245 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and. iabs(itype(jjj
4247 call ssbond_ene(iii,jjj,eij)
4249 cd write (iout,*) "eij",eij
4251 C Calculate the distance between the two points and its difference from the
4255 C Get the force constant corresponding to this distance.
4257 C Calculate the contribution to energy.
4258 ehpb=ehpb+waga*rdis*rdis
4260 C Evaluate gradient.
4263 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4264 cd & ' waga=',waga,' fac=',fac
4266 ggg(j)=fac*(c(j,jj)-c(j,ii))
4268 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4269 C If this is a SC-SC distance, we need to calculate the contributions to the
4270 C Cartesian gradient in the SC vectors (ghpbx).
4273 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4274 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4277 cgrad do j=iii,jjj-1
4279 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4283 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4284 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4291 C--------------------------------------------------------------------------
4292 subroutine ssbond_ene(i,j,eij)
4294 C Calculate the distance and angle dependent SS-bond potential energy
4295 C using a free-energy function derived based on RHF/6-31G** ab initio
4296 C calculations of diethyl disulfide.
4298 C A. Liwo and U. Kozlowska, 11/24/03
4300 implicit real*8 (a-h,o-z)
4301 include 'DIMENSIONS'
4302 include 'COMMON.SBRIDGE'
4303 include 'COMMON.CHAIN'
4304 include 'COMMON.DERIV'
4305 include 'COMMON.LOCAL'
4306 include 'COMMON.INTERACT'
4307 include 'COMMON.VAR'
4308 include 'COMMON.IOUNITS'
4309 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4310 itypi=iabs(itype(i))
4314 dxi=dc_norm(1,nres+i)
4315 dyi=dc_norm(2,nres+i)
4316 dzi=dc_norm(3,nres+i)
4317 c dsci_inv=dsc_inv(itypi)
4318 dsci_inv=vbld_inv(nres+i)
4319 itypj=iabs(itype(j))
4320 c dscj_inv=dsc_inv(itypj)
4321 dscj_inv=vbld_inv(nres+j)
4325 dxj=dc_norm(1,nres+j)
4326 dyj=dc_norm(2,nres+j)
4327 dzj=dc_norm(3,nres+j)
4328 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4333 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4334 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4335 om12=dxi*dxj+dyi*dyj+dzi*dzj
4337 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4338 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4344 deltat12=om2-om1+2.0d0
4346 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4347 & +akct*deltad*deltat12
4348 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
4349 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4350 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4351 c & " deltat12",deltat12," eij",eij
4352 ed=2*akcm*deltad+akct*deltat12
4354 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4355 eom1=-2*akth*deltat1-pom1-om2*pom2
4356 eom2= 2*akth*deltat2+pom1-om1*pom2
4359 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4360 ghpbx(k,i)=ghpbx(k,i)-ggk
4361 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4362 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4363 ghpbx(k,j)=ghpbx(k,j)+ggk
4364 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4365 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4366 ghpbc(k,i)=ghpbc(k,i)-ggk
4367 ghpbc(k,j)=ghpbc(k,j)+ggk
4370 C Calculate the components of the gradient in DC and X
4374 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4379 C--------------------------------------------------------------------------
4380 subroutine ebond(estr)
4382 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4384 implicit real*8 (a-h,o-z)
4385 include 'DIMENSIONS'
4386 include 'COMMON.LOCAL'
4387 include 'COMMON.GEO'
4388 include 'COMMON.INTERACT'
4389 include 'COMMON.DERIV'
4390 include 'COMMON.VAR'
4391 include 'COMMON.CHAIN'
4392 include 'COMMON.IOUNITS'
4393 include 'COMMON.NAMES'
4394 include 'COMMON.FFIELD'
4395 include 'COMMON.CONTROL'
4396 include 'COMMON.SETUP'
4397 double precision u(3),ud(3)
4399 do i=ibondp_start,ibondp_end
4400 diff = vbld(i)-vbldp0
4401 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
4404 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4406 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4410 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4412 do i=ibond_start,ibond_end
4417 diff=vbld(i+nres)-vbldsc0(1,iti)
4418 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4419 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
4420 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4422 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4426 diff=vbld(i+nres)-vbldsc0(j,iti)
4427 ud(j)=aksc(j,iti)*diff
4428 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4442 uprod2=uprod2*u(k)*u(k)
4446 usumsqder=usumsqder+ud(j)*uprod2
4448 estr=estr+uprod/usum
4450 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4458 C--------------------------------------------------------------------------
4459 subroutine ebend(etheta)
4461 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4462 C angles gamma and its derivatives in consecutive thetas and gammas.
4464 implicit real*8 (a-h,o-z)
4465 include 'DIMENSIONS'
4466 include 'COMMON.LOCAL'
4467 include 'COMMON.GEO'
4468 include 'COMMON.INTERACT'
4469 include 'COMMON.DERIV'
4470 include 'COMMON.VAR'
4471 include 'COMMON.CHAIN'
4472 include 'COMMON.IOUNITS'
4473 include 'COMMON.NAMES'
4474 include 'COMMON.FFIELD'
4475 include 'COMMON.CONTROL'
4476 common /calcthet/ term1,term2,termm,diffak,ratak,
4477 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4478 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4479 double precision y(2),z(2)
4481 c time11=dexp(-2*time)
4484 c write (*,'(a,i2)') 'EBEND ICG=',icg
4485 do i=ithet_start,ithet_end
4486 C Zero the energy function and its derivative at 0 or pi.
4487 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4492 if (phii.ne.phii) phii=150.0
4505 if (phii1.ne.phii1) phii1=150.0
4517 C Calculate the "mean" value of theta from the part of the distribution
4518 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4519 C In following comments this theta will be referred to as t_c.
4520 thet_pred_mean=0.0d0
4524 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4526 dthett=thet_pred_mean*ssd
4527 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4528 C Derivatives of the "mean" values in gamma1 and gamma2.
4529 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
4530 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
4531 if (theta(i).gt.pi-delta) then
4532 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
4534 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
4535 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4536 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
4538 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
4540 else if (theta(i).lt.delta) then
4541 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
4542 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
4543 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
4545 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
4546 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
4549 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
4552 etheta=etheta+ethetai
4553 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4555 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
4556 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
4557 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
4559 C Ufff.... We've done all this!!!
4562 C---------------------------------------------------------------------------
4563 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
4565 implicit real*8 (a-h,o-z)
4566 include 'DIMENSIONS'
4567 include 'COMMON.LOCAL'
4568 include 'COMMON.IOUNITS'
4569 common /calcthet/ term1,term2,termm,diffak,ratak,
4570 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4571 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4572 C Calculate the contributions to both Gaussian lobes.
4573 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
4574 C The "polynomial part" of the "standard deviation" of this part of
4578 sig=sig*thet_pred_mean+polthet(j,it)
4580 C Derivative of the "interior part" of the "standard deviation of the"
4581 C gamma-dependent Gaussian lobe in t_c.
4582 sigtc=3*polthet(3,it)
4584 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
4587 C Set the parameters of both Gaussian lobes of the distribution.
4588 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
4589 fac=sig*sig+sigc0(it)
4592 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
4593 sigsqtc=-4.0D0*sigcsq*sigtc
4594 c print *,i,sig,sigtc,sigsqtc
4595 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
4596 sigtc=-sigtc/(fac*fac)
4597 C Following variable is sigma(t_c)**(-2)
4598 sigcsq=sigcsq*sigcsq
4600 sig0inv=1.0D0/sig0i**2
4601 delthec=thetai-thet_pred_mean
4602 delthe0=thetai-theta0i
4603 term1=-0.5D0*sigcsq*delthec*delthec
4604 term2=-0.5D0*sig0inv*delthe0*delthe0
4605 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
4606 C NaNs in taking the logarithm. We extract the largest exponent which is added
4607 C to the energy (this being the log of the distribution) at the end of energy
4608 C term evaluation for this virtual-bond angle.
4609 if (term1.gt.term2) then
4611 term2=dexp(term2-termm)
4615 term1=dexp(term1-termm)
4618 C The ratio between the gamma-independent and gamma-dependent lobes of
4619 C the distribution is a Gaussian function of thet_pred_mean too.
4620 diffak=gthet(2,it)-thet_pred_mean
4621 ratak=diffak/gthet(3,it)**2
4622 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
4623 C Let's differentiate it in thet_pred_mean NOW.
4625 C Now put together the distribution terms to make complete distribution.
4626 termexp=term1+ak*term2
4627 termpre=sigc+ak*sig0i
4628 C Contribution of the bending energy from this theta is just the -log of
4629 C the sum of the contributions from the two lobes and the pre-exponential
4630 C factor. Simple enough, isn't it?
4631 ethetai=(-dlog(termexp)-termm+dlog(termpre))
4632 C NOW the derivatives!!!
4633 C 6/6/97 Take into account the deformation.
4634 E_theta=(delthec*sigcsq*term1
4635 & +ak*delthe0*sig0inv*term2)/termexp
4636 E_tc=((sigtc+aktc*sig0i)/termpre
4637 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
4638 & aktc*term2)/termexp)
4641 c-----------------------------------------------------------------------------
4642 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
4643 implicit real*8 (a-h,o-z)
4644 include 'DIMENSIONS'
4645 include 'COMMON.LOCAL'
4646 include 'COMMON.IOUNITS'
4647 common /calcthet/ term1,term2,termm,diffak,ratak,
4648 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4649 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4650 delthec=thetai-thet_pred_mean
4651 delthe0=thetai-theta0i
4652 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
4653 t3 = thetai-thet_pred_mean
4657 t14 = t12+t6*sigsqtc
4659 t21 = thetai-theta0i
4665 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
4666 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
4667 & *(-t12*t9-ak*sig0inv*t27)
4671 C--------------------------------------------------------------------------
4672 subroutine ebend(etheta)
4674 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4675 C angles gamma and its derivatives in consecutive thetas and gammas.
4676 C ab initio-derived potentials from
4677 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
4679 implicit real*8 (a-h,o-z)
4680 include 'DIMENSIONS'
4681 include 'COMMON.LOCAL'
4682 include 'COMMON.GEO'
4683 include 'COMMON.INTERACT'
4684 include 'COMMON.DERIV'
4685 include 'COMMON.VAR'
4686 include 'COMMON.CHAIN'
4687 include 'COMMON.IOUNITS'
4688 include 'COMMON.NAMES'
4689 include 'COMMON.FFIELD'
4690 include 'COMMON.CONTROL'
4691 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
4692 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
4693 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
4694 & sinph1ph2(maxdouble,maxdouble)
4695 logical lprn /.false./, lprn1 /.false./
4697 do i=ithet_start,ithet_end
4701 theti2=0.5d0*theta(i)
4702 ityp2=ithetyp(iabs(itype(i-1)))
4704 coskt(k)=dcos(k*theti2)
4705 sinkt(k)=dsin(k*theti2)
4710 if (phii.ne.phii) phii=150.0
4714 ityp1=ithetyp(iabs(itype(i-2)))
4716 cosph1(k)=dcos(k*phii)
4717 sinph1(k)=dsin(k*phii)
4730 if (phii1.ne.phii1) phii1=150.0
4735 ityp3=ithetyp(iabs(itype(i)))
4737 cosph2(k)=dcos(k*phii1)
4738 sinph2(k)=dsin(k*phii1)
4748 ethetai=aa0thet(ityp1,ityp2,ityp3)
4751 ccl=cosph1(l)*cosph2(k-l)
4752 ssl=sinph1(l)*sinph2(k-l)
4753 scl=sinph1(l)*cosph2(k-l)
4754 csl=cosph1(l)*sinph2(k-l)
4755 cosph1ph2(l,k)=ccl-ssl
4756 cosph1ph2(k,l)=ccl+ssl
4757 sinph1ph2(l,k)=scl+csl
4758 sinph1ph2(k,l)=scl-csl
4762 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
4763 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
4764 write (iout,*) "coskt and sinkt"
4766 write (iout,*) k,coskt(k),sinkt(k)
4770 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
4771 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
4774 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
4775 & " ethetai",ethetai
4778 write (iout,*) "cosph and sinph"
4780 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
4782 write (iout,*) "cosph1ph2 and sinph2ph2"
4785 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
4786 & sinph1ph2(l,k),sinph1ph2(k,l)
4789 write(iout,*) "ethetai",ethetai
4793 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
4794 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
4795 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
4796 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
4797 ethetai=ethetai+sinkt(m)*aux
4798 dethetai=dethetai+0.5d0*m*aux*coskt(m)
4799 dephii=dephii+k*sinkt(m)*(
4800 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
4801 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
4802 dephii1=dephii1+k*sinkt(m)*(
4803 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
4804 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
4806 & write (iout,*) "m",m," k",k," bbthet",
4807 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
4808 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
4809 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
4810 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4814 & write(iout,*) "ethetai",ethetai
4818 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4819 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
4820 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4821 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
4822 ethetai=ethetai+sinkt(m)*aux
4823 dethetai=dethetai+0.5d0*m*coskt(m)*aux
4824 dephii=dephii+l*sinkt(m)*(
4825 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
4826 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4827 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
4828 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4829 dephii1=dephii1+(k-l)*sinkt(m)*(
4830 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
4831 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
4832 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
4833 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
4835 write (iout,*) "m",m," k",k," l",l," ffthet",
4836 & ffthet(l,k,m,ityp1,ityp2,ityp3),
4837 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
4838 & ggthet(l,k,m,ityp1,ityp2,ityp3),
4839 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
4840 write (iout,*) cosph1ph2(l,k)*sinkt(m),
4841 & cosph1ph2(k,l)*sinkt(m),
4842 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
4848 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
4849 & i,theta(i)*rad2deg,phii*rad2deg,
4850 & phii1*rad2deg,ethetai
4851 etheta=etheta+ethetai
4852 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
4853 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
4854 gloc(nphi+i-2,icg)=wang*dethetai
4860 c-----------------------------------------------------------------------------
4861 subroutine esc(escloc)
4862 C Calculate the local energy of a side chain and its derivatives in the
4863 C corresponding virtual-bond valence angles THETA and the spherical angles
4865 implicit real*8 (a-h,o-z)
4866 include 'DIMENSIONS'
4867 include 'COMMON.GEO'
4868 include 'COMMON.LOCAL'
4869 include 'COMMON.VAR'
4870 include 'COMMON.INTERACT'
4871 include 'COMMON.DERIV'
4872 include 'COMMON.CHAIN'
4873 include 'COMMON.IOUNITS'
4874 include 'COMMON.NAMES'
4875 include 'COMMON.FFIELD'
4876 include 'COMMON.CONTROL'
4877 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
4878 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
4879 common /sccalc/ time11,time12,time112,theti,it,nlobit
4882 c write (iout,'(a)') 'ESC'
4883 do i=loc_start,loc_end
4885 if (it.eq.10) goto 1
4886 nlobit=nlob(iabs(it))
4887 c print *,'i=',i,' it=',it,' nlobit=',nlobit
4888 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
4889 theti=theta(i+1)-pipol
4894 if (x(2).gt.pi-delta) then
4898 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4900 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4901 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
4903 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4904 & ddersc0(1),dersc(1))
4905 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
4906 & ddersc0(3),dersc(3))
4908 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4910 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4911 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
4912 & dersc0(2),esclocbi,dersc02)
4913 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
4915 call splinthet(x(2),0.5d0*delta,ss,ssd)
4920 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4922 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4923 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4925 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4927 c write (iout,*) escloci
4928 else if (x(2).lt.delta) then
4932 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
4934 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
4935 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
4937 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4938 & ddersc0(1),dersc(1))
4939 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
4940 & ddersc0(3),dersc(3))
4942 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
4944 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
4945 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
4946 & dersc0(2),esclocbi,dersc02)
4947 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
4952 call splinthet(x(2),0.5d0*delta,ss,ssd)
4954 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
4956 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
4957 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
4959 escloci=ss*escloci+(1.0d0-ss)*esclocbi
4960 c write (iout,*) escloci
4962 call enesc(x,escloci,dersc,ddummy,.false.)
4965 escloc=escloc+escloci
4966 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
4967 & 'escloc',i,escloci
4968 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
4970 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4972 gloc(ialph(i,1),icg)=wscloc*dersc(2)
4973 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
4978 C---------------------------------------------------------------------------
4979 subroutine enesc(x,escloci,dersc,ddersc,mixed)
4980 implicit real*8 (a-h,o-z)
4981 include 'DIMENSIONS'
4982 include 'COMMON.GEO'
4983 include 'COMMON.LOCAL'
4984 include 'COMMON.IOUNITS'
4985 common /sccalc/ time11,time12,time112,theti,it,nlobit
4986 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
4987 double precision contr(maxlob,-1:1)
4989 c write (iout,*) 'it=',it,' nlobit=',nlobit
4993 if (mixed) ddersc(j)=0.0d0
4997 C Because of periodicity of the dependence of the SC energy in omega we have
4998 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
4999 C To avoid underflows, first compute & store the exponents.
5007 z(k)=x(k)-censc(k,j,it)
5012 Axk=Axk+gaussc(l,k,j,it)*z(l)
5018 expfac=expfac+Ax(k,j,iii)*z(k)
5026 C As in the case of ebend, we want to avoid underflows in exponentiation and
5027 C subsequent NaNs and INFs in energy calculation.
5028 C Find the largest exponent
5032 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5036 cd print *,'it=',it,' emin=',emin
5038 C Compute the contribution to SC energy and derivatives
5043 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5044 if(adexp.ne.adexp) adexp=1.0
5047 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5049 cd print *,'j=',j,' expfac=',expfac
5050 escloc_i=escloc_i+expfac
5052 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5056 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5057 & +gaussc(k,2,j,it))*expfac
5064 dersc(1)=dersc(1)/cos(theti)**2
5065 ddersc(1)=ddersc(1)/cos(theti)**2
5068 escloci=-(dlog(escloc_i)-emin)
5070 dersc(j)=dersc(j)/escloc_i
5074 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5079 C------------------------------------------------------------------------------
5080 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5081 implicit real*8 (a-h,o-z)
5082 include 'DIMENSIONS'
5083 include 'COMMON.GEO'
5084 include 'COMMON.LOCAL'
5085 include 'COMMON.IOUNITS'
5086 common /sccalc/ time11,time12,time112,theti,it,nlobit
5087 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5088 double precision contr(maxlob)
5099 z(k)=x(k)-censc(k,j,it)
5105 Axk=Axk+gaussc(l,k,j,it)*z(l)
5111 expfac=expfac+Ax(k,j)*z(k)
5116 C As in the case of ebend, we want to avoid underflows in exponentiation and
5117 C subsequent NaNs and INFs in energy calculation.
5118 C Find the largest exponent
5121 if (emin.gt.contr(j)) emin=contr(j)
5125 C Compute the contribution to SC energy and derivatives
5129 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5130 escloc_i=escloc_i+expfac
5132 dersc(k)=dersc(k)+Ax(k,j)*expfac
5134 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5135 & +gaussc(1,2,j,it))*expfac
5139 dersc(1)=dersc(1)/cos(theti)**2
5140 dersc12=dersc12/cos(theti)**2
5141 escloci=-(dlog(escloc_i)-emin)
5143 dersc(j)=dersc(j)/escloc_i
5145 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5149 c----------------------------------------------------------------------------------
5150 subroutine esc(escloc)
5151 C Calculate the local energy of a side chain and its derivatives in the
5152 C corresponding virtual-bond valence angles THETA and the spherical angles
5153 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5154 C added by Urszula Kozlowska. 07/11/2007
5156 implicit real*8 (a-h,o-z)
5157 include 'DIMENSIONS'
5158 include 'COMMON.GEO'
5159 include 'COMMON.LOCAL'
5160 include 'COMMON.VAR'
5161 include 'COMMON.SCROT'
5162 include 'COMMON.INTERACT'
5163 include 'COMMON.DERIV'
5164 include 'COMMON.CHAIN'
5165 include 'COMMON.IOUNITS'
5166 include 'COMMON.NAMES'
5167 include 'COMMON.FFIELD'
5168 include 'COMMON.CONTROL'
5169 include 'COMMON.VECTORS'
5170 double precision x_prime(3),y_prime(3),z_prime(3)
5171 & , sumene,dsc_i,dp2_i,x(65),
5172 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5173 & de_dxx,de_dyy,de_dzz,de_dt
5174 double precision s1_t,s1_6_t,s2_t,s2_6_t
5176 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5177 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5178 & dt_dCi(3),dt_dCi1(3)
5179 common /sccalc/ time11,time12,time112,theti,it,nlobit
5182 do i=loc_start,loc_end
5183 costtab(i+1) =dcos(theta(i+1))
5184 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5185 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5186 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5187 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5188 cosfac=dsqrt(cosfac2)
5189 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5190 sinfac=dsqrt(sinfac2)
5192 if (it.eq.10) goto 1
5194 C Compute the axes of tghe local cartesian coordinates system; store in
5195 c x_prime, y_prime and z_prime
5202 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5203 C & dc_norm(3,i+nres)
5205 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5206 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5209 z_prime(j) = -uz(j,i-1)
5212 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5213 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5214 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5215 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5216 c & " xy",scalar(x_prime(1),y_prime(1)),
5217 c & " xz",scalar(x_prime(1),z_prime(1)),
5218 c & " yy",scalar(y_prime(1),y_prime(1)),
5219 c & " yz",scalar(y_prime(1),z_prime(1)),
5220 c & " zz",scalar(z_prime(1),z_prime(1))
5222 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5223 C to local coordinate system. Store in xx, yy, zz.
5229 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5230 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5231 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5238 C Compute the energy of the ith side cbain
5240 c write (2,*) "xx",xx," yy",yy," zz",zz
5243 x(j) = sc_parmin(j,it)
5246 Cc diagnostics - remove later
5248 yy1 = dsin(alph(2))*dcos(omeg(2))
5249 zz1 = -dsin(alph(2))*dsin(omeg(2))
5250 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5251 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5253 C," --- ", xx_w,yy_w,zz_w
5256 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5257 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5259 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5260 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5262 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5263 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5264 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5265 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5266 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5268 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5269 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5270 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5271 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5272 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5274 dsc_i = 0.743d0+x(61)
5276 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5277 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5278 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5279 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5280 s1=(1+x(63))/(0.1d0 + dscp1)
5281 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5282 s2=(1+x(65))/(0.1d0 + dscp2)
5283 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5284 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5285 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5286 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5288 c & dscp1,dscp2,sumene
5289 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5290 escloc = escloc + sumene
5291 c write (2,*) "i",i," escloc",sumene,escloc
5294 C This section to check the numerical derivatives of the energy of ith side
5295 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5296 C #define DEBUG in the code to turn it on.
5298 write (2,*) "sumene =",sumene
5302 write (2,*) xx,yy,zz
5303 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5304 de_dxx_num=(sumenep-sumene)/aincr
5306 write (2,*) "xx+ sumene from enesc=",sumenep
5309 write (2,*) xx,yy,zz
5310 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5311 de_dyy_num=(sumenep-sumene)/aincr
5313 write (2,*) "yy+ sumene from enesc=",sumenep
5316 write (2,*) xx,yy,zz
5317 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5318 de_dzz_num=(sumenep-sumene)/aincr
5320 write (2,*) "zz+ sumene from enesc=",sumenep
5321 costsave=cost2tab(i+1)
5322 sintsave=sint2tab(i+1)
5323 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5324 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5325 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5326 de_dt_num=(sumenep-sumene)/aincr
5327 write (2,*) " t+ sumene from enesc=",sumenep
5328 cost2tab(i+1)=costsave
5329 sint2tab(i+1)=sintsave
5330 C End of diagnostics section.
5333 C Compute the gradient of esc
5335 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5336 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5337 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5338 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5339 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5340 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5341 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5342 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5343 pom1=(sumene3*sint2tab(i+1)+sumene1)
5344 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5345 pom2=(sumene4*cost2tab(i+1)+sumene2)
5346 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5347 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5348 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5349 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5351 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5352 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5353 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5355 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5356 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5357 & +(pom1+pom2)*pom_dx
5359 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
5362 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5363 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5364 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5366 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5367 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5368 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5369 & +x(59)*zz**2 +x(60)*xx*zz
5370 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5371 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5372 & +(pom1-pom2)*pom_dy
5374 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
5377 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5378 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5379 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5380 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5381 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5382 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5383 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5384 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5386 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
5389 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5390 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5391 & +pom1*pom_dt1+pom2*pom_dt2
5393 write(2,*), "de_dt = ", de_dt,de_dt_num
5397 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5398 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5399 cosfac2xx=cosfac2*xx
5400 sinfac2yy=sinfac2*yy
5402 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5404 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5406 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5407 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5408 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5409 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5410 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5411 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5412 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5413 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5414 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5415 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5419 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
5420 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
5423 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5424 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5425 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
5427 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5428 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5432 dXX_Ctab(k,i)=dXX_Ci(k)
5433 dXX_C1tab(k,i)=dXX_Ci1(k)
5434 dYY_Ctab(k,i)=dYY_Ci(k)
5435 dYY_C1tab(k,i)=dYY_Ci1(k)
5436 dZZ_Ctab(k,i)=dZZ_Ci(k)
5437 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5438 dXX_XYZtab(k,i)=dXX_XYZ(k)
5439 dYY_XYZtab(k,i)=dYY_XYZ(k)
5440 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5444 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5445 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5446 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5447 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5448 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5450 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5451 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5452 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5453 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5454 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5455 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5456 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5457 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5459 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5460 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5462 C to check gradient call subroutine check_grad
5468 c------------------------------------------------------------------------------
5469 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5471 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5472 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5473 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5474 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5476 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5477 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5479 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5480 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5481 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5482 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5483 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5485 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5486 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5487 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5488 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5489 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5491 dsc_i = 0.743d0+x(61)
5493 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5494 & *(xx*cost2+yy*sint2))
5495 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5496 & *(xx*cost2-yy*sint2))
5497 s1=(1+x(63))/(0.1d0 + dscp1)
5498 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5499 s2=(1+x(65))/(0.1d0 + dscp2)
5500 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5501 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
5502 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
5507 c------------------------------------------------------------------------------
5508 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
5510 C This procedure calculates two-body contact function g(rij) and its derivative:
5513 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
5516 C where x=(rij-r0ij)/delta
5518 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
5521 double precision rij,r0ij,eps0ij,fcont,fprimcont
5522 double precision x,x2,x4,delta
5526 if (x.lt.-1.0D0) then
5529 else if (x.le.1.0D0) then
5532 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
5533 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
5540 c------------------------------------------------------------------------------
5541 subroutine splinthet(theti,delta,ss,ssder)
5542 implicit real*8 (a-h,o-z)
5543 include 'DIMENSIONS'
5544 include 'COMMON.VAR'
5545 include 'COMMON.GEO'
5548 if (theti.gt.pipol) then
5549 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
5551 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
5556 c------------------------------------------------------------------------------
5557 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
5559 double precision x,x0,delta,f0,f1,fprim0,f,fprim
5560 double precision ksi,ksi2,ksi3,a1,a2,a3
5561 a1=fprim0*delta/(f1-f0)
5567 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
5568 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
5571 c------------------------------------------------------------------------------
5572 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
5574 double precision x,x0,delta,f0x,f1x,fprim0x,fx
5575 double precision ksi,ksi2,ksi3,a1,a2,a3
5580 a2=3*(f1x-f0x)-2*fprim0x*delta
5581 a3=fprim0x*delta-2*(f1x-f0x)
5582 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
5585 C-----------------------------------------------------------------------------
5587 C-----------------------------------------------------------------------------
5588 subroutine etor(etors,edihcnstr)
5589 implicit real*8 (a-h,o-z)
5590 include 'DIMENSIONS'
5591 include 'COMMON.VAR'
5592 include 'COMMON.GEO'
5593 include 'COMMON.LOCAL'
5594 include 'COMMON.TORSION'
5595 include 'COMMON.INTERACT'
5596 include 'COMMON.DERIV'
5597 include 'COMMON.CHAIN'
5598 include 'COMMON.NAMES'
5599 include 'COMMON.IOUNITS'
5600 include 'COMMON.FFIELD'
5601 include 'COMMON.TORCNSTR'
5602 include 'COMMON.CONTROL'
5604 C Set lprn=.true. for debugging
5608 do i=iphi_start,iphi_end
5610 itori=itortyp(itype(i-2))
5611 itori1=itortyp(itype(i-1))
5614 C Proline-Proline pair is a special case...
5615 if (itori.eq.3 .and. itori1.eq.3) then
5616 if (phii.gt.-dwapi3) then
5618 fac=1.0D0/(1.0D0-cosphi)
5619 etorsi=v1(1,3,3)*fac
5620 etorsi=etorsi+etorsi
5621 etors=etors+etorsi-v1(1,3,3)
5622 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
5623 gloci=gloci-3*fac*etorsi*dsin(3*phii)
5626 v1ij=v1(j+1,itori,itori1)
5627 v2ij=v2(j+1,itori,itori1)
5630 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5631 if (energy_dec) etors_ii=etors_ii+
5632 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5633 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5637 v1ij=v1(j,itori,itori1)
5638 v2ij=v2(j,itori,itori1)
5641 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5642 if (energy_dec) etors_ii=etors_ii+
5643 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
5644 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5647 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5650 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5651 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5652 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5653 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5654 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5656 ! 6/20/98 - dihedral angle constraints
5659 itori=idih_constr(i)
5662 if (difi.gt.drange(i)) then
5664 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5665 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5666 else if (difi.lt.-drange(i)) then
5668 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5669 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5671 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
5672 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5674 ! write (iout,*) 'edihcnstr',edihcnstr
5677 c------------------------------------------------------------------------------
5678 subroutine etor_d(etors_d)
5682 c----------------------------------------------------------------------------
5684 subroutine etor(etors,edihcnstr)
5685 implicit real*8 (a-h,o-z)
5686 include 'DIMENSIONS'
5687 include 'COMMON.VAR'
5688 include 'COMMON.GEO'
5689 include 'COMMON.LOCAL'
5690 include 'COMMON.TORSION'
5691 include 'COMMON.INTERACT'
5692 include 'COMMON.DERIV'
5693 include 'COMMON.CHAIN'
5694 include 'COMMON.NAMES'
5695 include 'COMMON.IOUNITS'
5696 include 'COMMON.FFIELD'
5697 include 'COMMON.TORCNSTR'
5698 include 'COMMON.CONTROL'
5700 C Set lprn=.true. for debugging
5704 do i=iphi_start,iphi_end
5706 itori=itortyp(itype(i-2))
5707 itori1=itortyp(itype(i-1))
5710 C Regular cosine and sine terms
5711 do j=1,nterm(itori,itori1)
5712 v1ij=v1(j,itori,itori1)
5713 v2ij=v2(j,itori,itori1)
5716 etors=etors+v1ij*cosphi+v2ij*sinphi
5717 if (energy_dec) etors_ii=etors_ii+
5718 & v1ij*cosphi+v2ij*sinphi
5719 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5723 C E = SUM ----------------------------------- - v1
5724 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
5726 cosphi=dcos(0.5d0*phii)
5727 sinphi=dsin(0.5d0*phii)
5728 do j=1,nlor(itori,itori1)
5729 vl1ij=vlor1(j,itori,itori1)
5730 vl2ij=vlor2(j,itori,itori1)
5731 vl3ij=vlor3(j,itori,itori1)
5732 pom=vl2ij*cosphi+vl3ij*sinphi
5733 pom1=1.0d0/(pom*pom+1.0d0)
5734 etors=etors+vl1ij*pom1
5735 if (energy_dec) etors_ii=etors_ii+
5738 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
5740 C Subtract the constant term
5741 etors=etors-v0(itori,itori1)
5742 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5743 & 'etor',i,etors_ii-v0(itori,itori1)
5745 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5746 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5747 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
5748 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
5749 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
5751 ! 6/20/98 - dihedral angle constraints
5753 c do i=1,ndih_constr
5754 do i=idihconstr_start,idihconstr_end
5755 itori=idih_constr(i)
5757 difi=pinorm(phii-phi0(i))
5758 if (difi.gt.drange(i)) then
5760 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5761 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5762 else if (difi.lt.-drange(i)) then
5764 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
5765 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
5769 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
5770 cd & rad2deg*phi0(i), rad2deg*drange(i),
5771 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
5773 cd write (iout,*) 'edihcnstr',edihcnstr
5776 c----------------------------------------------------------------------------
5777 subroutine etor_d(etors_d)
5778 C 6/23/01 Compute double torsional energy
5779 implicit real*8 (a-h,o-z)
5780 include 'DIMENSIONS'
5781 include 'COMMON.VAR'
5782 include 'COMMON.GEO'
5783 include 'COMMON.LOCAL'
5784 include 'COMMON.TORSION'
5785 include 'COMMON.INTERACT'
5786 include 'COMMON.DERIV'
5787 include 'COMMON.CHAIN'
5788 include 'COMMON.NAMES'
5789 include 'COMMON.IOUNITS'
5790 include 'COMMON.FFIELD'
5791 include 'COMMON.TORCNSTR'
5793 C Set lprn=.true. for debugging
5797 do i=iphid_start,iphid_end
5798 itori=itortyp(itype(i-2))
5799 itori1=itortyp(itype(i-1))
5800 itori2=itortyp(itype(i))
5802 if (iabs(itype(i+1).eq.20)) iblock=2
5807 C Regular cosine and sine terms
5808 do j=1,ntermd_1(itori,itori1,itori2,iblock)
5809 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
5810 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
5811 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
5812 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
5813 cosphi1=dcos(j*phii)
5814 sinphi1=dsin(j*phii)
5815 cosphi2=dcos(j*phii1)
5816 sinphi2=dsin(j*phii1)
5817 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
5818 & v2cij*cosphi2+v2sij*sinphi2
5819 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
5820 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
5822 do k=2,ntermd_2(itori,itori1,itori2,iblock)
5824 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
5825 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
5826 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
5827 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
5828 cosphi1p2=dcos(l*phii+(k-l)*phii1)
5829 cosphi1m2=dcos(l*phii-(k-l)*phii1)
5830 sinphi1p2=dsin(l*phii+(k-l)*phii1)
5831 sinphi1m2=dsin(l*phii-(k-l)*phii1)
5832 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
5833 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
5834 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
5835 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
5836 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
5837 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
5840 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
5841 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
5846 c------------------------------------------------------------------------------
5847 subroutine eback_sc_corr(esccor)
5848 c 7/21/2007 Correlations between the backbone-local and side-chain-local
5849 c conformational states; temporarily implemented as differences
5850 c between UNRES torsional potentials (dependent on three types of
5851 c residues) and the torsional potentials dependent on all 20 types
5852 c of residues computed from AM1 energy surfaces of terminally-blocked
5853 c amino-acid residues.
5854 implicit real*8 (a-h,o-z)
5855 include 'DIMENSIONS'
5856 include 'COMMON.VAR'
5857 include 'COMMON.GEO'
5858 include 'COMMON.LOCAL'
5859 include 'COMMON.TORSION'
5860 include 'COMMON.SCCOR'
5861 include 'COMMON.INTERACT'
5862 include 'COMMON.DERIV'
5863 include 'COMMON.CHAIN'
5864 include 'COMMON.NAMES'
5865 include 'COMMON.IOUNITS'
5866 include 'COMMON.FFIELD'
5867 include 'COMMON.CONTROL'
5869 C Set lprn=.true. for debugging
5872 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
5874 do i=iphi_start,iphi_end
5881 v1ij=v1sccor(j,itori,itori1)
5882 v2ij=v2sccor(j,itori,itori1)
5885 esccor=esccor+v1ij*cosphi+v2ij*sinphi
5886 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
5889 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
5890 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
5891 & (v1sccor(j,itori,itori1),j=1,6),(v2sccor(j,itori,itori1),j=1,6)
5892 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
5896 c----------------------------------------------------------------------------
5897 subroutine multibody(ecorr)
5898 C This subroutine calculates multi-body contributions to energy following
5899 C the idea of Skolnick et al. If side chains I and J make a contact and
5900 C at the same time side chains I+1 and J+1 make a contact, an extra
5901 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
5902 implicit real*8 (a-h,o-z)
5903 include 'DIMENSIONS'
5904 include 'COMMON.IOUNITS'
5905 include 'COMMON.DERIV'
5906 include 'COMMON.INTERACT'
5907 include 'COMMON.CONTACTS'
5909 include 'COMMON.CONTACTS.MOMENT'
5911 double precision gx(3),gx1(3)
5914 C Set lprn=.true. for debugging
5918 write (iout,'(a)') 'Contact function values:'
5920 write (iout,'(i2,20(1x,i2,f10.5))')
5921 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
5936 num_conti=num_cont(i)
5937 num_conti1=num_cont(i1)
5942 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
5943 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
5944 cd & ' ishift=',ishift
5945 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
5946 C The system gains extra energy.
5947 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
5948 endif ! j1==j+-ishift
5957 c------------------------------------------------------------------------------
5958 double precision function esccorr(i,j,k,l,jj,kk)
5959 implicit real*8 (a-h,o-z)
5960 include 'DIMENSIONS'
5961 include 'COMMON.IOUNITS'
5962 include 'COMMON.DERIV'
5963 include 'COMMON.INTERACT'
5964 include 'COMMON.CONTACTS'
5966 include 'COMMON.CONTACTS.MOMENT'
5968 double precision gx(3),gx1(3)
5973 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
5974 C Calculate the multi-body contribution to energy.
5975 C Calculate multi-body contributions to the gradient.
5976 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
5977 cd & k,l,(gacont(m,kk,k),m=1,3)
5979 gx(m) =ekl*gacont(m,jj,i)
5980 gx1(m)=eij*gacont(m,kk,k)
5981 gradxorr(m,i)=gradxorr(m,i)-gx(m)
5982 gradxorr(m,j)=gradxorr(m,j)+gx(m)
5983 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
5984 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
5988 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
5993 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
5999 c------------------------------------------------------------------------------
6000 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6001 C This subroutine calculates multi-body contributions to hydrogen-bonding
6002 implicit real*8 (a-h,o-z)
6003 include 'DIMENSIONS'
6004 include 'COMMON.IOUNITS'
6007 parameter (max_cont=maxconts)
6008 parameter (max_dim=26)
6009 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6010 double precision zapas(max_dim,maxconts,max_fg_procs),
6011 & zapas_recv(max_dim,maxconts,max_fg_procs)
6012 common /przechowalnia/ zapas
6013 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6014 & status_array(MPI_STATUS_SIZE,maxconts*2)
6016 include 'COMMON.SETUP'
6017 include 'COMMON.FFIELD'
6018 include 'COMMON.DERIV'
6019 include 'COMMON.INTERACT'
6020 include 'COMMON.CONTACTS'
6022 include 'COMMON.CONTACTS.MOMENT'
6024 include 'COMMON.CONTROL'
6025 include 'COMMON.LOCAL'
6026 double precision gx(3),gx1(3),time00
6029 C Set lprn=.true. for debugging
6034 if (nfgtasks.le.1) goto 30
6036 write (iout,'(a)') 'Contact function values before RECEIVE:'
6038 write (iout,'(2i3,50(1x,i2,f5.2))')
6039 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6040 & j=1,num_cont_hb(i))
6044 do i=1,ntask_cont_from
6047 do i=1,ntask_cont_to
6050 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6052 C Make the list of contacts to send to send to other procesors
6053 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6055 do i=iturn3_start,iturn3_end
6056 c write (iout,*) "make contact list turn3",i," num_cont",
6058 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6060 do i=iturn4_start,iturn4_end
6061 c write (iout,*) "make contact list turn4",i," num_cont",
6063 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6067 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6069 do j=1,num_cont_hb(i)
6072 iproc=iint_sent_local(k,jjc,ii)
6073 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6074 if (iproc.gt.0) then
6075 ncont_sent(iproc)=ncont_sent(iproc)+1
6076 nn=ncont_sent(iproc)
6078 zapas(2,nn,iproc)=jjc
6079 zapas(3,nn,iproc)=facont_hb(j,i)
6080 zapas(4,nn,iproc)=ees0p(j,i)
6081 zapas(5,nn,iproc)=ees0m(j,i)
6082 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6083 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6084 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6085 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6086 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6087 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6088 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6089 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6090 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6091 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6092 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6093 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6094 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6095 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6096 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6097 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6098 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6099 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6100 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6101 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6102 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6109 & "Numbers of contacts to be sent to other processors",
6110 & (ncont_sent(i),i=1,ntask_cont_to)
6111 write (iout,*) "Contacts sent"
6112 do ii=1,ntask_cont_to
6114 iproc=itask_cont_to(ii)
6115 write (iout,*) nn," contacts to processor",iproc,
6116 & " of CONT_TO_COMM group"
6118 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6126 CorrelID1=nfgtasks+fg_rank+1
6128 C Receive the numbers of needed contacts from other processors
6129 do ii=1,ntask_cont_from
6130 iproc=itask_cont_from(ii)
6132 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6133 & FG_COMM,req(ireq),IERR)
6135 c write (iout,*) "IRECV ended"
6137 C Send the number of contacts needed by other processors
6138 do ii=1,ntask_cont_to
6139 iproc=itask_cont_to(ii)
6141 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6142 & FG_COMM,req(ireq),IERR)
6144 c write (iout,*) "ISEND ended"
6145 c write (iout,*) "number of requests (nn)",ireq
6148 & call MPI_Waitall(ireq,req,status_array,ierr)
6150 c & "Numbers of contacts to be received from other processors",
6151 c & (ncont_recv(i),i=1,ntask_cont_from)
6155 do ii=1,ntask_cont_from
6156 iproc=itask_cont_from(ii)
6158 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6159 c & " of CONT_TO_COMM group"
6163 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6164 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6165 c write (iout,*) "ireq,req",ireq,req(ireq)
6168 C Send the contacts to processors that need them
6169 do ii=1,ntask_cont_to
6170 iproc=itask_cont_to(ii)
6172 c write (iout,*) nn," contacts to processor",iproc,
6173 c & " of CONT_TO_COMM group"
6176 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6177 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6178 c write (iout,*) "ireq,req",ireq,req(ireq)
6180 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6184 c write (iout,*) "number of requests (contacts)",ireq
6185 c write (iout,*) "req",(req(i),i=1,4)
6188 & call MPI_Waitall(ireq,req,status_array,ierr)
6189 do iii=1,ntask_cont_from
6190 iproc=itask_cont_from(iii)
6193 write (iout,*) "Received",nn," contacts from processor",iproc,
6194 & " of CONT_FROM_COMM group"
6197 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6202 ii=zapas_recv(1,i,iii)
6203 c Flag the received contacts to prevent double-counting
6204 jj=-zapas_recv(2,i,iii)
6205 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6207 nnn=num_cont_hb(ii)+1
6210 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6211 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6212 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6213 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6214 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6215 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6216 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6217 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6218 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6219 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6220 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6221 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6222 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6223 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6224 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6225 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6226 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6227 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6228 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6229 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6230 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6231 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6232 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6233 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6238 write (iout,'(a)') 'Contact function values after receive:'
6240 write (iout,'(2i3,50(1x,i3,f5.2))')
6241 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6242 & j=1,num_cont_hb(i))
6249 write (iout,'(a)') 'Contact function values:'
6251 write (iout,'(2i3,50(1x,i3,f5.2))')
6252 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6253 & j=1,num_cont_hb(i))
6257 C Remove the loop below after debugging !!!
6264 C Calculate the local-electrostatic correlation terms
6265 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6267 num_conti=num_cont_hb(i)
6268 num_conti1=num_cont_hb(i+1)
6275 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6276 c & ' jj=',jj,' kk=',kk
6277 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6278 & .or. j.lt.0 .and. j1.gt.0) .and.
6279 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6280 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6281 C The system gains extra energy.
6282 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6283 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6284 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6286 else if (j1.eq.j) then
6287 C Contacts I-J and I-(J+1) occur simultaneously.
6288 C The system loses extra energy.
6289 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6294 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6295 c & ' jj=',jj,' kk=',kk
6297 C Contacts I-J and (I+1)-J occur simultaneously.
6298 C The system loses extra energy.
6299 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6306 c------------------------------------------------------------------------------
6307 subroutine add_hb_contact(ii,jj,itask)
6308 implicit real*8 (a-h,o-z)
6309 include "DIMENSIONS"
6310 include "COMMON.IOUNITS"
6313 parameter (max_cont=maxconts)
6314 parameter (max_dim=26)
6315 include "COMMON.CONTACTS"
6317 include 'COMMON.CONTACTS.MOMENT'
6319 double precision zapas(max_dim,maxconts,max_fg_procs),
6320 & zapas_recv(max_dim,maxconts,max_fg_procs)
6321 common /przechowalnia/ zapas
6322 integer i,j,ii,jj,iproc,itask(4),nn
6323 c write (iout,*) "itask",itask
6326 if (iproc.gt.0) then
6327 do j=1,num_cont_hb(ii)
6329 c write (iout,*) "i",ii," j",jj," jjc",jjc
6331 ncont_sent(iproc)=ncont_sent(iproc)+1
6332 nn=ncont_sent(iproc)
6333 zapas(1,nn,iproc)=ii
6334 zapas(2,nn,iproc)=jjc
6335 zapas(3,nn,iproc)=facont_hb(j,ii)
6336 zapas(4,nn,iproc)=ees0p(j,ii)
6337 zapas(5,nn,iproc)=ees0m(j,ii)
6338 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6339 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6340 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6341 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6342 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6343 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6344 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6345 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6346 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6347 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6348 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6349 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6350 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6351 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6352 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6353 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6354 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6355 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6356 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6357 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6358 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6366 c------------------------------------------------------------------------------
6367 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6369 C This subroutine calculates multi-body contributions to hydrogen-bonding
6370 implicit real*8 (a-h,o-z)
6371 include 'DIMENSIONS'
6372 include 'COMMON.IOUNITS'
6375 parameter (max_cont=maxconts)
6376 parameter (max_dim=70)
6377 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6378 double precision zapas(max_dim,maxconts,max_fg_procs),
6379 & zapas_recv(max_dim,maxconts,max_fg_procs)
6380 common /przechowalnia/ zapas
6381 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6382 & status_array(MPI_STATUS_SIZE,maxconts*2)
6384 include 'COMMON.SETUP'
6385 include 'COMMON.FFIELD'
6386 include 'COMMON.DERIV'
6387 include 'COMMON.LOCAL'
6388 include 'COMMON.INTERACT'
6389 include 'COMMON.CONTACTS'
6391 include 'COMMON.CONTACTS.MOMENT'
6393 include 'COMMON.CHAIN'
6394 include 'COMMON.CONTROL'
6395 double precision gx(3),gx1(3)
6396 integer num_cont_hb_old(maxres)
6398 double precision eello4,eello5,eelo6,eello_turn6
6399 external eello4,eello5,eello6,eello_turn6
6400 C Set lprn=.true. for debugging
6405 num_cont_hb_old(i)=num_cont_hb(i)
6409 if (nfgtasks.le.1) goto 30
6411 write (iout,'(a)') 'Contact function values before RECEIVE:'
6413 write (iout,'(2i3,50(1x,i2,f5.2))')
6414 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6415 & j=1,num_cont_hb(i))
6419 do i=1,ntask_cont_from
6422 do i=1,ntask_cont_to
6425 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6427 C Make the list of contacts to send to send to other procesors
6428 do i=iturn3_start,iturn3_end
6429 c write (iout,*) "make contact list turn3",i," num_cont",
6431 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6433 do i=iturn4_start,iturn4_end
6434 c write (iout,*) "make contact list turn4",i," num_cont",
6436 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6440 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6442 do j=1,num_cont_hb(i)
6445 iproc=iint_sent_local(k,jjc,ii)
6446 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6447 if (iproc.ne.0) then
6448 ncont_sent(iproc)=ncont_sent(iproc)+1
6449 nn=ncont_sent(iproc)
6451 zapas(2,nn,iproc)=jjc
6452 zapas(3,nn,iproc)=d_cont(j,i)
6456 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
6461 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
6469 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
6480 & "Numbers of contacts to be sent to other processors",
6481 & (ncont_sent(i),i=1,ntask_cont_to)
6482 write (iout,*) "Contacts sent"
6483 do ii=1,ntask_cont_to
6485 iproc=itask_cont_to(ii)
6486 write (iout,*) nn," contacts to processor",iproc,
6487 & " of CONT_TO_COMM group"
6489 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
6497 CorrelID1=nfgtasks+fg_rank+1
6499 C Receive the numbers of needed contacts from other processors
6500 do ii=1,ntask_cont_from
6501 iproc=itask_cont_from(ii)
6503 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6504 & FG_COMM,req(ireq),IERR)
6506 c write (iout,*) "IRECV ended"
6508 C Send the number of contacts needed by other processors
6509 do ii=1,ntask_cont_to
6510 iproc=itask_cont_to(ii)
6512 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6513 & FG_COMM,req(ireq),IERR)
6515 c write (iout,*) "ISEND ended"
6516 c write (iout,*) "number of requests (nn)",ireq
6519 & call MPI_Waitall(ireq,req,status_array,ierr)
6521 c & "Numbers of contacts to be received from other processors",
6522 c & (ncont_recv(i),i=1,ntask_cont_from)
6526 do ii=1,ntask_cont_from
6527 iproc=itask_cont_from(ii)
6529 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6530 c & " of CONT_TO_COMM group"
6534 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6535 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6536 c write (iout,*) "ireq,req",ireq,req(ireq)
6539 C Send the contacts to processors that need them
6540 do ii=1,ntask_cont_to
6541 iproc=itask_cont_to(ii)
6543 c write (iout,*) nn," contacts to processor",iproc,
6544 c & " of CONT_TO_COMM group"
6547 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6548 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6549 c write (iout,*) "ireq,req",ireq,req(ireq)
6551 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6555 c write (iout,*) "number of requests (contacts)",ireq
6556 c write (iout,*) "req",(req(i),i=1,4)
6559 & call MPI_Waitall(ireq,req,status_array,ierr)
6560 do iii=1,ntask_cont_from
6561 iproc=itask_cont_from(iii)
6564 write (iout,*) "Received",nn," contacts from processor",iproc,
6565 & " of CONT_FROM_COMM group"
6568 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
6573 ii=zapas_recv(1,i,iii)
6574 c Flag the received contacts to prevent double-counting
6575 jj=-zapas_recv(2,i,iii)
6576 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6578 nnn=num_cont_hb(ii)+1
6581 d_cont(nnn,ii)=zapas_recv(3,i,iii)
6585 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
6590 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
6598 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
6607 write (iout,'(a)') 'Contact function values after receive:'
6609 write (iout,'(2i3,50(1x,i3,5f6.3))')
6610 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6611 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6618 write (iout,'(a)') 'Contact function values:'
6620 write (iout,'(2i3,50(1x,i2,5f6.3))')
6621 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
6622 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
6628 C Remove the loop below after debugging !!!
6635 C Calculate the dipole-dipole interaction energies
6636 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
6637 do i=iatel_s,iatel_e+1
6638 num_conti=num_cont_hb(i)
6647 C Calculate the local-electrostatic correlation terms
6648 c write (iout,*) "gradcorr5 in eello5 before loop"
6650 c write (iout,'(i5,3f10.5)')
6651 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6653 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
6654 c write (iout,*) "corr loop i",i
6656 num_conti=num_cont_hb(i)
6657 num_conti1=num_cont_hb(i+1)
6664 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6665 c & ' jj=',jj,' kk=',kk
6666 c if (j1.eq.j+1 .or. j1.eq.j-1) then
6667 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6668 & .or. j.lt.0 .and. j1.gt.0) .and.
6669 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6670 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6671 C The system gains extra energy.
6673 sqd1=dsqrt(d_cont(jj,i))
6674 sqd2=dsqrt(d_cont(kk,i1))
6675 sred_geom = sqd1*sqd2
6676 IF (sred_geom.lt.cutoff_corr) THEN
6677 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
6679 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
6680 cd & ' jj=',jj,' kk=',kk
6681 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
6682 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
6684 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
6685 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
6688 cd write (iout,*) 'sred_geom=',sred_geom,
6689 cd & ' ekont=',ekont,' fprim=',fprimcont,
6690 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
6691 cd write (iout,*) "g_contij",g_contij
6692 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
6693 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
6694 call calc_eello(i,jp,i+1,jp1,jj,kk)
6695 if (wcorr4.gt.0.0d0)
6696 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
6697 if (energy_dec.and.wcorr4.gt.0.0d0)
6698 1 write (iout,'(a6,4i5,0pf7.3)')
6699 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
6700 c write (iout,*) "gradcorr5 before eello5"
6702 c write (iout,'(i5,3f10.5)')
6703 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6705 if (wcorr5.gt.0.0d0)
6706 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
6707 c write (iout,*) "gradcorr5 after eello5"
6709 c write (iout,'(i5,3f10.5)')
6710 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6712 if (energy_dec.and.wcorr5.gt.0.0d0)
6713 1 write (iout,'(a6,4i5,0pf7.3)')
6714 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
6715 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
6716 cd write(2,*)'ijkl',i,jp,i+1,jp1
6717 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
6718 & .or. wturn6.eq.0.0d0))then
6719 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
6720 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
6721 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6722 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
6723 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
6724 cd & 'ecorr6=',ecorr6
6725 cd write (iout,'(4e15.5)') sred_geom,
6726 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
6727 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
6728 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
6729 else if (wturn6.gt.0.0d0
6730 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
6731 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
6732 eturn6=eturn6+eello_turn6(i,jj,kk)
6733 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
6734 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
6735 cd write (2,*) 'multibody_eello:eturn6',eturn6
6744 num_cont_hb(i)=num_cont_hb_old(i)
6746 c write (iout,*) "gradcorr5 in eello5"
6748 c write (iout,'(i5,3f10.5)')
6749 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
6753 c------------------------------------------------------------------------------
6754 subroutine add_hb_contact_eello(ii,jj,itask)
6755 implicit real*8 (a-h,o-z)
6756 include "DIMENSIONS"
6757 include "COMMON.IOUNITS"
6760 parameter (max_cont=maxconts)
6761 parameter (max_dim=70)
6762 include "COMMON.CONTACTS"
6764 include 'COMMON.CONTACTS.MOMENT'
6766 double precision zapas(max_dim,maxconts,max_fg_procs),
6767 & zapas_recv(max_dim,maxconts,max_fg_procs)
6768 common /przechowalnia/ zapas
6769 integer i,j,ii,jj,iproc,itask(4),nn
6770 c write (iout,*) "itask",itask
6773 if (iproc.gt.0) then
6774 do j=1,num_cont_hb(ii)
6776 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
6778 ncont_sent(iproc)=ncont_sent(iproc)+1
6779 nn=ncont_sent(iproc)
6780 zapas(1,nn,iproc)=ii
6781 zapas(2,nn,iproc)=jjc
6782 zapas(3,nn,iproc)=d_cont(j,ii)
6786 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
6791 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
6799 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
6811 c------------------------------------------------------------------------------
6812 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
6813 implicit real*8 (a-h,o-z)
6814 include 'DIMENSIONS'
6815 include 'COMMON.IOUNITS'
6816 include 'COMMON.DERIV'
6817 include 'COMMON.INTERACT'
6818 include 'COMMON.CONTACTS'
6820 include 'COMMON.CONTACTS.MOMENT'
6822 double precision gx(3),gx1(3)
6832 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
6833 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
6834 C Following 4 lines for diagnostics.
6839 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
6840 c & 'Contacts ',i,j,
6841 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
6842 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
6844 C Calculate the multi-body contribution to energy.
6845 c ecorr=ecorr+ekont*ees
6846 C Calculate multi-body contributions to the gradient.
6847 coeffpees0pij=coeffp*ees0pij
6848 coeffmees0mij=coeffm*ees0mij
6849 coeffpees0pkl=coeffp*ees0pkl
6850 coeffmees0mkl=coeffm*ees0mkl
6852 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
6853 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
6854 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
6855 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
6856 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
6857 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
6858 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
6859 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
6860 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
6861 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
6862 & coeffmees0mij*gacontm_hb1(ll,kk,k))
6863 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
6864 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
6865 & coeffmees0mij*gacontm_hb2(ll,kk,k))
6866 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
6867 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
6868 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
6869 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
6870 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
6871 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
6872 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
6873 & coeffmees0mij*gacontm_hb3(ll,kk,k))
6874 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
6875 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
6876 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
6881 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6882 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
6883 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
6884 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
6889 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
6890 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
6891 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
6892 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
6895 c write (iout,*) "ehbcorr",ekont*ees
6900 C---------------------------------------------------------------------------
6901 subroutine dipole(i,j,jj)
6902 implicit real*8 (a-h,o-z)
6903 include 'DIMENSIONS'
6904 include 'COMMON.IOUNITS'
6905 include 'COMMON.CHAIN'
6906 include 'COMMON.FFIELD'
6907 include 'COMMON.DERIV'
6908 include 'COMMON.INTERACT'
6909 include 'COMMON.CONTACTS'
6911 include 'COMMON.CONTACTS.MOMENT'
6913 include 'COMMON.TORSION'
6914 include 'COMMON.VAR'
6915 include 'COMMON.GEO'
6916 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
6918 iti1 = itortyp(itype(i+1))
6919 if (j.lt.nres-1) then
6920 itj1 = itortyp(itype(j+1))
6925 dipi(iii,1)=Ub2(iii,i)
6926 dipderi(iii)=Ub2der(iii,i)
6927 dipi(iii,2)=b1(iii,iti1)
6928 dipj(iii,1)=Ub2(iii,j)
6929 dipderj(iii)=Ub2der(iii,j)
6930 dipj(iii,2)=b1(iii,itj1)
6934 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
6937 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6944 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
6948 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
6953 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
6954 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
6956 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
6958 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
6960 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
6965 C---------------------------------------------------------------------------
6966 subroutine calc_eello(i,j,k,l,jj,kk)
6968 C This subroutine computes matrices and vectors needed to calculate
6969 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
6971 implicit real*8 (a-h,o-z)
6972 include 'DIMENSIONS'
6973 include 'COMMON.IOUNITS'
6974 include 'COMMON.CHAIN'
6975 include 'COMMON.DERIV'
6976 include 'COMMON.INTERACT'
6977 include 'COMMON.CONTACTS'
6979 include 'COMMON.CONTACTS.MOMENT'
6981 include 'COMMON.TORSION'
6982 include 'COMMON.VAR'
6983 include 'COMMON.GEO'
6984 include 'COMMON.FFIELD'
6985 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
6986 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
6989 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
6990 cd & ' jj=',jj,' kk=',kk
6991 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
6992 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
6993 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
6996 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
6997 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7000 call transpose2(aa1(1,1),aa1t(1,1))
7001 call transpose2(aa2(1,1),aa2t(1,1))
7004 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7005 & aa1tder(1,1,lll,kkk))
7006 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7007 & aa2tder(1,1,lll,kkk))
7011 C parallel orientation of the two CA-CA-CA frames.
7013 iti=itortyp(itype(i))
7017 itk1=itortyp(itype(k+1))
7018 itj=itortyp(itype(j))
7019 if (l.lt.nres-1) then
7020 itl1=itortyp(itype(l+1))
7024 C A1 kernel(j+1) A2T
7026 cd write (iout,'(3f10.5,5x,3f10.5)')
7027 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7029 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7030 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7031 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7032 C Following matrices are needed only for 6-th order cumulants
7033 IF (wcorr6.gt.0.0d0) THEN
7034 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7035 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7036 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7037 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7038 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7039 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7040 & ADtEAderx(1,1,1,1,1,1))
7042 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7043 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7044 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7045 & ADtEA1derx(1,1,1,1,1,1))
7047 C End 6-th order cumulants
7050 cd write (2,*) 'In calc_eello6'
7052 cd write (2,*) 'iii=',iii
7054 cd write (2,*) 'kkk=',kkk
7056 cd write (2,'(3(2f10.5),5x)')
7057 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7062 call transpose2(EUgder(1,1,k),auxmat(1,1))
7063 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7064 call transpose2(EUg(1,1,k),auxmat(1,1))
7065 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7066 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7070 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7071 & EAEAderx(1,1,lll,kkk,iii,1))
7075 C A1T kernel(i+1) A2
7076 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7077 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7078 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7079 C Following matrices are needed only for 6-th order cumulants
7080 IF (wcorr6.gt.0.0d0) THEN
7081 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7082 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7083 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7084 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7085 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7086 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7087 & ADtEAderx(1,1,1,1,1,2))
7088 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7089 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7090 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7091 & ADtEA1derx(1,1,1,1,1,2))
7093 C End 6-th order cumulants
7094 call transpose2(EUgder(1,1,l),auxmat(1,1))
7095 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7096 call transpose2(EUg(1,1,l),auxmat(1,1))
7097 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7098 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7102 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7103 & EAEAderx(1,1,lll,kkk,iii,2))
7108 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7109 C They are needed only when the fifth- or the sixth-order cumulants are
7111 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7112 call transpose2(AEA(1,1,1),auxmat(1,1))
7113 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7114 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7115 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7116 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7117 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7118 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7119 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7120 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7121 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7122 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7123 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7124 call transpose2(AEA(1,1,2),auxmat(1,1))
7125 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7126 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7127 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7128 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7129 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7130 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7131 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7132 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7133 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7134 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7135 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7136 C Calculate the Cartesian derivatives of the vectors.
7140 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7141 call matvec2(auxmat(1,1),b1(1,iti),
7142 & AEAb1derx(1,lll,kkk,iii,1,1))
7143 call matvec2(auxmat(1,1),Ub2(1,i),
7144 & AEAb2derx(1,lll,kkk,iii,1,1))
7145 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7146 & AEAb1derx(1,lll,kkk,iii,2,1))
7147 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7148 & AEAb2derx(1,lll,kkk,iii,2,1))
7149 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7150 call matvec2(auxmat(1,1),b1(1,itj),
7151 & AEAb1derx(1,lll,kkk,iii,1,2))
7152 call matvec2(auxmat(1,1),Ub2(1,j),
7153 & AEAb2derx(1,lll,kkk,iii,1,2))
7154 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7155 & AEAb1derx(1,lll,kkk,iii,2,2))
7156 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7157 & AEAb2derx(1,lll,kkk,iii,2,2))
7164 C Antiparallel orientation of the two CA-CA-CA frames.
7166 iti=itortyp(itype(i))
7170 itk1=itortyp(itype(k+1))
7171 itl=itortyp(itype(l))
7172 itj=itortyp(itype(j))
7173 if (j.lt.nres-1) then
7174 itj1=itortyp(itype(j+1))
7178 C A2 kernel(j-1)T A1T
7179 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7180 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7181 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7182 C Following matrices are needed only for 6-th order cumulants
7183 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7184 & j.eq.i+4 .and. l.eq.i+3)) THEN
7185 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7186 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7187 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7188 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7189 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7190 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7191 & ADtEAderx(1,1,1,1,1,1))
7192 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7193 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7194 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7195 & ADtEA1derx(1,1,1,1,1,1))
7197 C End 6-th order cumulants
7198 call transpose2(EUgder(1,1,k),auxmat(1,1))
7199 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7200 call transpose2(EUg(1,1,k),auxmat(1,1))
7201 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7202 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7206 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7207 & EAEAderx(1,1,lll,kkk,iii,1))
7211 C A2T kernel(i+1)T A1
7212 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7213 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7214 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7215 C Following matrices are needed only for 6-th order cumulants
7216 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7217 & j.eq.i+4 .and. l.eq.i+3)) THEN
7218 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7219 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7220 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7221 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7222 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7223 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7224 & ADtEAderx(1,1,1,1,1,2))
7225 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7226 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7227 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7228 & ADtEA1derx(1,1,1,1,1,2))
7230 C End 6-th order cumulants
7231 call transpose2(EUgder(1,1,j),auxmat(1,1))
7232 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7233 call transpose2(EUg(1,1,j),auxmat(1,1))
7234 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7235 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7239 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7240 & EAEAderx(1,1,lll,kkk,iii,2))
7245 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7246 C They are needed only when the fifth- or the sixth-order cumulants are
7248 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7249 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7250 call transpose2(AEA(1,1,1),auxmat(1,1))
7251 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7252 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7253 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7254 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7255 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7256 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7257 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7258 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7259 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7260 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7261 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7262 call transpose2(AEA(1,1,2),auxmat(1,1))
7263 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7264 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7265 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7266 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7267 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7268 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7269 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7270 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7271 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7272 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7273 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7274 C Calculate the Cartesian derivatives of the vectors.
7278 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7279 call matvec2(auxmat(1,1),b1(1,iti),
7280 & AEAb1derx(1,lll,kkk,iii,1,1))
7281 call matvec2(auxmat(1,1),Ub2(1,i),
7282 & AEAb2derx(1,lll,kkk,iii,1,1))
7283 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7284 & AEAb1derx(1,lll,kkk,iii,2,1))
7285 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7286 & AEAb2derx(1,lll,kkk,iii,2,1))
7287 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7288 call matvec2(auxmat(1,1),b1(1,itl),
7289 & AEAb1derx(1,lll,kkk,iii,1,2))
7290 call matvec2(auxmat(1,1),Ub2(1,l),
7291 & AEAb2derx(1,lll,kkk,iii,1,2))
7292 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7293 & AEAb1derx(1,lll,kkk,iii,2,2))
7294 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7295 & AEAb2derx(1,lll,kkk,iii,2,2))
7304 C---------------------------------------------------------------------------
7305 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7306 & KK,KKderg,AKA,AKAderg,AKAderx)
7310 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7311 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7312 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7317 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7319 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7322 cd if (lprn) write (2,*) 'In kernel'
7324 cd if (lprn) write (2,*) 'kkk=',kkk
7326 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7327 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7329 cd write (2,*) 'lll=',lll
7330 cd write (2,*) 'iii=1'
7332 cd write (2,'(3(2f10.5),5x)')
7333 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7336 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7337 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7339 cd write (2,*) 'lll=',lll
7340 cd write (2,*) 'iii=2'
7342 cd write (2,'(3(2f10.5),5x)')
7343 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7350 C---------------------------------------------------------------------------
7351 double precision function eello4(i,j,k,l,jj,kk)
7352 implicit real*8 (a-h,o-z)
7353 include 'DIMENSIONS'
7354 include 'COMMON.IOUNITS'
7355 include 'COMMON.CHAIN'
7356 include 'COMMON.DERIV'
7357 include 'COMMON.INTERACT'
7358 include 'COMMON.CONTACTS'
7360 include 'COMMON.CONTACTS.MOMENT'
7362 include 'COMMON.TORSION'
7363 include 'COMMON.VAR'
7364 include 'COMMON.GEO'
7365 double precision pizda(2,2),ggg1(3),ggg2(3)
7366 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7370 cd print *,'eello4:',i,j,k,l,jj,kk
7371 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7372 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7373 cold eij=facont_hb(jj,i)
7374 cold ekl=facont_hb(kk,k)
7376 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7377 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7378 gcorr_loc(k-1)=gcorr_loc(k-1)
7379 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7381 gcorr_loc(l-1)=gcorr_loc(l-1)
7382 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7384 gcorr_loc(j-1)=gcorr_loc(j-1)
7385 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7390 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7391 & -EAEAderx(2,2,lll,kkk,iii,1)
7392 cd derx(lll,kkk,iii)=0.0d0
7396 cd gcorr_loc(l-1)=0.0d0
7397 cd gcorr_loc(j-1)=0.0d0
7398 cd gcorr_loc(k-1)=0.0d0
7400 cd write (iout,*)'Contacts have occurred for peptide groups',
7401 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7402 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7403 if (j.lt.nres-1) then
7410 if (l.lt.nres-1) then
7418 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7419 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7420 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7421 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7422 cgrad ghalf=0.5d0*ggg1(ll)
7423 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7424 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7425 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7426 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7427 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7428 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7429 cgrad ghalf=0.5d0*ggg2(ll)
7430 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7431 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7432 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7433 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7434 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7435 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7439 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7444 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7449 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7454 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7458 cd write (2,*) iii,gcorr_loc(iii)
7461 cd write (2,*) 'ekont',ekont
7462 cd write (iout,*) 'eello4',ekont*eel4
7465 C---------------------------------------------------------------------------
7466 double precision function eello5(i,j,k,l,jj,kk)
7467 implicit real*8 (a-h,o-z)
7468 include 'DIMENSIONS'
7469 include 'COMMON.IOUNITS'
7470 include 'COMMON.CHAIN'
7471 include 'COMMON.DERIV'
7472 include 'COMMON.INTERACT'
7473 include 'COMMON.CONTACTS'
7475 include 'COMMON.CONTACTS.MOMENT'
7477 include 'COMMON.TORSION'
7478 include 'COMMON.VAR'
7479 include 'COMMON.GEO'
7480 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
7481 double precision ggg1(3),ggg2(3)
7482 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7487 C /l\ / \ \ / \ / \ / C
7488 C / \ / \ \ / \ / \ / C
7489 C j| o |l1 | o | o| o | | o |o C
7490 C \ |/k\| |/ \| / |/ \| |/ \| C
7491 C \i/ \ / \ / / \ / \ C
7493 C (I) (II) (III) (IV) C
7495 C eello5_1 eello5_2 eello5_3 eello5_4 C
7497 C Antiparallel chains C
7500 C /j\ / \ \ / \ / \ / C
7501 C / \ / \ \ / \ / \ / C
7502 C j1| o |l | o | o| o | | o |o C
7503 C \ |/k\| |/ \| / |/ \| |/ \| C
7504 C \i/ \ / \ / / \ / \ C
7506 C (I) (II) (III) (IV) C
7508 C eello5_1 eello5_2 eello5_3 eello5_4 C
7510 C o denotes a local interaction, vertical lines an electrostatic interaction. C
7512 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
7513 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
7518 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
7520 itk=itortyp(itype(k))
7521 itl=itortyp(itype(l))
7522 itj=itortyp(itype(j))
7527 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
7528 cd & eel5_3_num,eel5_4_num)
7532 derx(lll,kkk,iii)=0.0d0
7536 cd eij=facont_hb(jj,i)
7537 cd ekl=facont_hb(kk,k)
7539 cd write (iout,*)'Contacts have occurred for peptide groups',
7540 cd & i,j,' fcont:',eij,' eij',' and ',k,l
7542 C Contribution from the graph I.
7543 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
7544 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
7545 call transpose2(EUg(1,1,k),auxmat(1,1))
7546 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
7547 vv(1)=pizda(1,1)-pizda(2,2)
7548 vv(2)=pizda(1,2)+pizda(2,1)
7549 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
7550 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7551 C Explicit gradient in virtual-dihedral angles.
7552 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
7553 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
7554 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
7555 call transpose2(EUgder(1,1,k),auxmat1(1,1))
7556 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
7557 vv(1)=pizda(1,1)-pizda(2,2)
7558 vv(2)=pizda(1,2)+pizda(2,1)
7559 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7560 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
7561 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7562 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
7563 vv(1)=pizda(1,1)-pizda(2,2)
7564 vv(2)=pizda(1,2)+pizda(2,1)
7566 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
7567 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7568 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7570 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
7571 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
7572 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
7574 C Cartesian gradient
7578 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
7580 vv(1)=pizda(1,1)-pizda(2,2)
7581 vv(2)=pizda(1,2)+pizda(2,1)
7582 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7583 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
7584 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
7590 C Contribution from graph II
7591 call transpose2(EE(1,1,itk),auxmat(1,1))
7592 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
7593 vv(1)=pizda(1,1)+pizda(2,2)
7594 vv(2)=pizda(2,1)-pizda(1,2)
7595 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
7596 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7597 C Explicit gradient in virtual-dihedral angles.
7598 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7599 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
7600 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
7601 vv(1)=pizda(1,1)+pizda(2,2)
7602 vv(2)=pizda(2,1)-pizda(1,2)
7604 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7605 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7606 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7608 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7609 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
7610 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
7612 C Cartesian gradient
7616 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7618 vv(1)=pizda(1,1)+pizda(2,2)
7619 vv(2)=pizda(2,1)-pizda(1,2)
7620 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7621 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
7622 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
7630 C Parallel orientation
7631 C Contribution from graph III
7632 call transpose2(EUg(1,1,l),auxmat(1,1))
7633 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7634 vv(1)=pizda(1,1)-pizda(2,2)
7635 vv(2)=pizda(1,2)+pizda(2,1)
7636 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
7637 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7638 C Explicit gradient in virtual-dihedral angles.
7639 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7640 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
7641 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
7642 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7643 vv(1)=pizda(1,1)-pizda(2,2)
7644 vv(2)=pizda(1,2)+pizda(2,1)
7645 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7646 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
7647 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7648 call transpose2(EUgder(1,1,l),auxmat1(1,1))
7649 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7650 vv(1)=pizda(1,1)-pizda(2,2)
7651 vv(2)=pizda(1,2)+pizda(2,1)
7652 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7653 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
7654 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
7655 C Cartesian gradient
7659 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7661 vv(1)=pizda(1,1)-pizda(2,2)
7662 vv(2)=pizda(1,2)+pizda(2,1)
7663 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7664 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
7665 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
7670 C Contribution from graph IV
7672 call transpose2(EE(1,1,itl),auxmat(1,1))
7673 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7674 vv(1)=pizda(1,1)+pizda(2,2)
7675 vv(2)=pizda(2,1)-pizda(1,2)
7676 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
7677 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7678 C Explicit gradient in virtual-dihedral angles.
7679 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7680 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
7681 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7682 vv(1)=pizda(1,1)+pizda(2,2)
7683 vv(2)=pizda(2,1)-pizda(1,2)
7684 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7685 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
7686 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
7687 C Cartesian gradient
7691 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7693 vv(1)=pizda(1,1)+pizda(2,2)
7694 vv(2)=pizda(2,1)-pizda(1,2)
7695 derx(lll,kkk,iii)=derx(lll,kkk,iii)
7696 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
7697 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
7702 C Antiparallel orientation
7703 C Contribution from graph III
7705 call transpose2(EUg(1,1,j),auxmat(1,1))
7706 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
7707 vv(1)=pizda(1,1)-pizda(2,2)
7708 vv(2)=pizda(1,2)+pizda(2,1)
7709 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
7710 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7711 C Explicit gradient in virtual-dihedral angles.
7712 g_corr5_loc(l-1)=g_corr5_loc(l-1)
7713 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
7714 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
7715 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
7716 vv(1)=pizda(1,1)-pizda(2,2)
7717 vv(2)=pizda(1,2)+pizda(2,1)
7718 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7719 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
7720 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7721 call transpose2(EUgder(1,1,j),auxmat1(1,1))
7722 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
7723 vv(1)=pizda(1,1)-pizda(2,2)
7724 vv(2)=pizda(1,2)+pizda(2,1)
7725 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7726 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
7727 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
7728 C Cartesian gradient
7732 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
7734 vv(1)=pizda(1,1)-pizda(2,2)
7735 vv(2)=pizda(1,2)+pizda(2,1)
7736 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7737 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
7738 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
7743 C Contribution from graph IV
7745 call transpose2(EE(1,1,itj),auxmat(1,1))
7746 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
7747 vv(1)=pizda(1,1)+pizda(2,2)
7748 vv(2)=pizda(2,1)-pizda(1,2)
7749 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
7750 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7751 C Explicit gradient in virtual-dihedral angles.
7752 g_corr5_loc(j-1)=g_corr5_loc(j-1)
7753 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
7754 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
7755 vv(1)=pizda(1,1)+pizda(2,2)
7756 vv(2)=pizda(2,1)-pizda(1,2)
7757 g_corr5_loc(k-1)=g_corr5_loc(k-1)
7758 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
7759 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
7760 C Cartesian gradient
7764 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7766 vv(1)=pizda(1,1)+pizda(2,2)
7767 vv(2)=pizda(2,1)-pizda(1,2)
7768 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
7769 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
7770 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
7776 eel5=eello5_1+eello5_2+eello5_3+eello5_4
7777 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
7778 cd write (2,*) 'ijkl',i,j,k,l
7779 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
7780 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
7782 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
7783 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
7784 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
7785 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
7786 if (j.lt.nres-1) then
7793 if (l.lt.nres-1) then
7803 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
7804 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
7805 C summed up outside the subrouine as for the other subroutines
7806 C handling long-range interactions. The old code is commented out
7807 C with "cgrad" to keep track of changes.
7809 cgrad ggg1(ll)=eel5*g_contij(ll,1)
7810 cgrad ggg2(ll)=eel5*g_contij(ll,2)
7811 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
7812 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
7813 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
7814 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
7815 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
7816 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
7817 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
7818 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
7820 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
7821 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
7822 cgrad ghalf=0.5d0*ggg1(ll)
7824 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
7825 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
7826 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
7827 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
7828 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
7829 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
7830 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
7831 cgrad ghalf=0.5d0*ggg2(ll)
7833 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
7834 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
7835 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
7836 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
7837 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
7838 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
7843 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
7844 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
7849 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
7850 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
7856 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
7861 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
7865 cd write (2,*) iii,g_corr5_loc(iii)
7868 cd write (2,*) 'ekont',ekont
7869 cd write (iout,*) 'eello5',ekont*eel5
7872 c--------------------------------------------------------------------------
7873 double precision function eello6(i,j,k,l,jj,kk)
7874 implicit real*8 (a-h,o-z)
7875 include 'DIMENSIONS'
7876 include 'COMMON.IOUNITS'
7877 include 'COMMON.CHAIN'
7878 include 'COMMON.DERIV'
7879 include 'COMMON.INTERACT'
7880 include 'COMMON.CONTACTS'
7882 include 'COMMON.CONTACTS.MOMENT'
7884 include 'COMMON.TORSION'
7885 include 'COMMON.VAR'
7886 include 'COMMON.GEO'
7887 include 'COMMON.FFIELD'
7888 double precision ggg1(3),ggg2(3)
7889 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
7894 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
7902 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
7903 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
7907 derx(lll,kkk,iii)=0.0d0
7911 cd eij=facont_hb(jj,i)
7912 cd ekl=facont_hb(kk,k)
7918 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7919 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
7920 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
7921 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7922 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
7923 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
7925 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
7926 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
7927 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
7928 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
7929 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
7930 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
7934 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
7936 C If turn contributions are considered, they will be handled separately.
7937 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
7938 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
7939 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
7940 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
7941 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
7942 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
7943 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
7945 if (j.lt.nres-1) then
7952 if (l.lt.nres-1) then
7960 cgrad ggg1(ll)=eel6*g_contij(ll,1)
7961 cgrad ggg2(ll)=eel6*g_contij(ll,2)
7962 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
7963 cgrad ghalf=0.5d0*ggg1(ll)
7965 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
7966 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
7967 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
7968 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
7969 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
7970 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
7971 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
7972 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
7973 cgrad ghalf=0.5d0*ggg2(ll)
7974 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
7976 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
7977 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
7978 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
7979 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
7980 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
7981 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
7986 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
7987 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
7992 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
7993 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
7999 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8004 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8008 cd write (2,*) iii,g_corr6_loc(iii)
8011 cd write (2,*) 'ekont',ekont
8012 cd write (iout,*) 'eello6',ekont*eel6
8015 c--------------------------------------------------------------------------
8016 double precision function eello6_graph1(i,j,k,l,imat,swap)
8017 implicit real*8 (a-h,o-z)
8018 include 'DIMENSIONS'
8019 include 'COMMON.IOUNITS'
8020 include 'COMMON.CHAIN'
8021 include 'COMMON.DERIV'
8022 include 'COMMON.INTERACT'
8023 include 'COMMON.CONTACTS'
8025 include 'COMMON.CONTACTS.MOMENT'
8027 include 'COMMON.TORSION'
8028 include 'COMMON.VAR'
8029 include 'COMMON.GEO'
8030 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8034 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8036 C Parallel Antiparallel C
8042 C \ j|/k\| / \ |/k\|l / C
8047 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8048 itk=itortyp(itype(k))
8049 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8050 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8051 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8052 call transpose2(EUgC(1,1,k),auxmat(1,1))
8053 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8054 vv1(1)=pizda1(1,1)-pizda1(2,2)
8055 vv1(2)=pizda1(1,2)+pizda1(2,1)
8056 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8057 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8058 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8059 s5=scalar2(vv(1),Dtobr2(1,i))
8060 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8061 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8062 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8063 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8064 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8065 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8066 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8067 & +scalar2(vv(1),Dtobr2der(1,i)))
8068 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8069 vv1(1)=pizda1(1,1)-pizda1(2,2)
8070 vv1(2)=pizda1(1,2)+pizda1(2,1)
8071 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8072 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8074 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8075 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8076 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8077 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8078 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8080 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8081 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8082 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8083 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8084 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8086 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8087 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8088 vv1(1)=pizda1(1,1)-pizda1(2,2)
8089 vv1(2)=pizda1(1,2)+pizda1(2,1)
8090 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8091 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8092 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8093 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8102 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8103 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8104 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8105 call transpose2(EUgC(1,1,k),auxmat(1,1))
8106 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8108 vv1(1)=pizda1(1,1)-pizda1(2,2)
8109 vv1(2)=pizda1(1,2)+pizda1(2,1)
8110 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8111 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8112 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8113 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8114 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8115 s5=scalar2(vv(1),Dtobr2(1,i))
8116 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8122 c----------------------------------------------------------------------------
8123 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8124 implicit real*8 (a-h,o-z)
8125 include 'DIMENSIONS'
8126 include 'COMMON.IOUNITS'
8127 include 'COMMON.CHAIN'
8128 include 'COMMON.DERIV'
8129 include 'COMMON.INTERACT'
8130 include 'COMMON.CONTACTS'
8132 include 'COMMON.CONTACTS.MOMENT'
8134 include 'COMMON.TORSION'
8135 include 'COMMON.VAR'
8136 include 'COMMON.GEO'
8138 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8139 & auxvec1(2),auxvec2(1),auxmat1(2,2)
8142 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8144 C Parallel Antiparallel C
8150 C \ j|/k\| \ |/k\|l C
8155 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8156 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8157 C AL 7/4/01 s1 would occur in the sixth-order moment,
8158 C but not in a cluster cumulant
8160 s1=dip(1,jj,i)*dip(1,kk,k)
8162 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8163 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8164 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8165 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8166 call transpose2(EUg(1,1,k),auxmat(1,1))
8167 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8168 vv(1)=pizda(1,1)-pizda(2,2)
8169 vv(2)=pizda(1,2)+pizda(2,1)
8170 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8171 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8173 eello6_graph2=-(s1+s2+s3+s4)
8175 eello6_graph2=-(s2+s3+s4)
8178 C Derivatives in gamma(i-1)
8181 s1=dipderg(1,jj,i)*dip(1,kk,k)
8183 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8184 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8185 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8186 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8188 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8190 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8192 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8194 C Derivatives in gamma(k-1)
8196 s1=dip(1,jj,i)*dipderg(1,kk,k)
8198 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8199 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8200 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8201 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8202 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8203 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8204 vv(1)=pizda(1,1)-pizda(2,2)
8205 vv(2)=pizda(1,2)+pizda(2,1)
8206 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8208 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8210 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8212 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8213 C Derivatives in gamma(j-1) or gamma(l-1)
8216 s1=dipderg(3,jj,i)*dip(1,kk,k)
8218 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8219 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8220 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8221 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8222 vv(1)=pizda(1,1)-pizda(2,2)
8223 vv(2)=pizda(1,2)+pizda(2,1)
8224 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8227 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8229 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8232 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8233 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8235 C Derivatives in gamma(l-1) or gamma(j-1)
8238 s1=dip(1,jj,i)*dipderg(3,kk,k)
8240 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8241 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8242 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8243 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8244 call matmat2(ADtEA1derg(1,1,2,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(j-1)=g_corr6_loc(j-1)-ekont*s1
8252 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8255 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8256 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8258 C Cartesian derivatives.
8260 write (2,*) 'In eello6_graph2'
8262 write (2,*) 'iii=',iii
8264 write (2,*) 'kkk=',kkk
8266 write (2,'(3(2f10.5),5x)')
8267 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8277 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8279 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8282 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8284 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8285 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8287 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8288 call transpose2(EUg(1,1,k),auxmat(1,1))
8289 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8291 vv(1)=pizda(1,1)-pizda(2,2)
8292 vv(2)=pizda(1,2)+pizda(2,1)
8293 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8294 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8296 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8298 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8301 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8303 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8310 c----------------------------------------------------------------------------
8311 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8312 implicit real*8 (a-h,o-z)
8313 include 'DIMENSIONS'
8314 include 'COMMON.IOUNITS'
8315 include 'COMMON.CHAIN'
8316 include 'COMMON.DERIV'
8317 include 'COMMON.INTERACT'
8318 include 'COMMON.CONTACTS'
8320 include 'COMMON.CONTACTS.MOMENT'
8322 include 'COMMON.TORSION'
8323 include 'COMMON.VAR'
8324 include 'COMMON.GEO'
8325 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8327 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8329 C Parallel Antiparallel C
8335 C j|/k\| / |/k\|l / C
8340 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8342 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8343 C energy moment and not to the cluster cumulant.
8344 iti=itortyp(itype(i))
8345 if (j.lt.nres-1) then
8346 itj1=itortyp(itype(j+1))
8350 itk=itortyp(itype(k))
8351 itk1=itortyp(itype(k+1))
8352 if (l.lt.nres-1) then
8353 itl1=itortyp(itype(l+1))
8358 s1=dip(4,jj,i)*dip(4,kk,k)
8360 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8361 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8362 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8363 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8364 call transpose2(EE(1,1,itk),auxmat(1,1))
8365 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8366 vv(1)=pizda(1,1)+pizda(2,2)
8367 vv(2)=pizda(2,1)-pizda(1,2)
8368 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8369 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8370 cd & "sum",-(s2+s3+s4)
8372 eello6_graph3=-(s1+s2+s3+s4)
8374 eello6_graph3=-(s2+s3+s4)
8377 C Derivatives in gamma(k-1)
8378 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8379 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8380 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8381 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8382 C Derivatives in gamma(l-1)
8383 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8384 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8385 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8386 vv(1)=pizda(1,1)+pizda(2,2)
8387 vv(2)=pizda(2,1)-pizda(1,2)
8388 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8389 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8390 C Cartesian derivatives.
8396 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8398 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8401 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8403 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8404 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8406 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8407 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,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))
8413 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8415 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8418 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8420 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8422 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8428 c----------------------------------------------------------------------------
8429 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8430 implicit real*8 (a-h,o-z)
8431 include 'DIMENSIONS'
8432 include 'COMMON.IOUNITS'
8433 include 'COMMON.CHAIN'
8434 include 'COMMON.DERIV'
8435 include 'COMMON.INTERACT'
8436 include 'COMMON.CONTACTS'
8438 include 'COMMON.CONTACTS.MOMENT'
8440 include 'COMMON.TORSION'
8441 include 'COMMON.VAR'
8442 include 'COMMON.GEO'
8443 include 'COMMON.FFIELD'
8444 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8445 & auxvec1(2),auxmat1(2,2)
8447 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8449 C Parallel Antiparallel C
8455 C \ j|/k\| \ |/k\|l C
8460 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8462 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8463 C energy moment and not to the cluster cumulant.
8464 cd write (2,*) 'eello_graph4: wturn6',wturn6
8465 iti=itortyp(itype(i))
8466 itj=itortyp(itype(j))
8467 if (j.lt.nres-1) then
8468 itj1=itortyp(itype(j+1))
8472 itk=itortyp(itype(k))
8473 if (k.lt.nres-1) then
8474 itk1=itortyp(itype(k+1))
8478 itl=itortyp(itype(l))
8479 if (l.lt.nres-1) then
8480 itl1=itortyp(itype(l+1))
8484 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
8485 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
8486 cd & ' itl',itl,' itl1',itl1
8489 s1=dip(3,jj,i)*dip(3,kk,k)
8491 s1=dip(2,jj,j)*dip(2,kk,l)
8494 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
8495 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8497 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
8498 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8500 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
8501 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8503 call transpose2(EUg(1,1,k),auxmat(1,1))
8504 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
8505 vv(1)=pizda(1,1)-pizda(2,2)
8506 vv(2)=pizda(2,1)+pizda(1,2)
8507 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8508 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8510 eello6_graph4=-(s1+s2+s3+s4)
8512 eello6_graph4=-(s2+s3+s4)
8514 C Derivatives in gamma(i-1)
8518 s1=dipderg(2,jj,i)*dip(3,kk,k)
8520 s1=dipderg(4,jj,j)*dip(2,kk,l)
8523 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8525 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
8526 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8528 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
8529 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8531 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8532 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8533 cd write (2,*) 'turn6 derivatives'
8535 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
8537 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
8541 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8543 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8547 C Derivatives in gamma(k-1)
8550 s1=dip(3,jj,i)*dipderg(2,kk,k)
8552 s1=dip(2,jj,j)*dipderg(4,kk,l)
8555 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
8556 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
8558 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
8559 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
8561 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
8562 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
8564 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8565 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
8566 vv(1)=pizda(1,1)-pizda(2,2)
8567 vv(2)=pizda(2,1)+pizda(1,2)
8568 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8569 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8571 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
8573 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
8577 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8579 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8582 C Derivatives in gamma(j-1) or gamma(l-1)
8583 if (l.eq.j+1 .and. l.gt.1) then
8584 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8585 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8586 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8587 vv(1)=pizda(1,1)-pizda(2,2)
8588 vv(2)=pizda(2,1)+pizda(1,2)
8589 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8590 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8591 else if (j.gt.1) then
8592 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
8593 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8594 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
8595 vv(1)=pizda(1,1)-pizda(2,2)
8596 vv(2)=pizda(2,1)+pizda(1,2)
8597 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8598 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8599 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
8601 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
8604 C Cartesian derivatives.
8611 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
8613 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
8617 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
8619 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
8623 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
8625 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
8627 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8628 & b1(1,itj1),auxvec(1))
8629 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
8631 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
8632 & b1(1,itl1),auxvec(1))
8633 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
8635 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8637 vv(1)=pizda(1,1)-pizda(2,2)
8638 vv(2)=pizda(2,1)+pizda(1,2)
8639 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
8641 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
8643 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8646 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
8649 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
8652 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
8654 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
8656 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8660 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8662 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8665 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8667 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8675 c----------------------------------------------------------------------------
8676 double precision function eello_turn6(i,jj,kk)
8677 implicit real*8 (a-h,o-z)
8678 include 'DIMENSIONS'
8679 include 'COMMON.IOUNITS'
8680 include 'COMMON.CHAIN'
8681 include 'COMMON.DERIV'
8682 include 'COMMON.INTERACT'
8683 include 'COMMON.CONTACTS'
8685 include 'COMMON.CONTACTS.MOMENT'
8687 include 'COMMON.TORSION'
8688 include 'COMMON.VAR'
8689 include 'COMMON.GEO'
8690 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
8691 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
8693 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
8694 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
8695 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
8696 C the respective energy moment and not to the cluster cumulant.
8705 iti=itortyp(itype(i))
8706 itk=itortyp(itype(k))
8707 itk1=itortyp(itype(k+1))
8708 itl=itortyp(itype(l))
8709 itj=itortyp(itype(j))
8710 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
8711 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
8712 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8717 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8719 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
8723 derx_turn(lll,kkk,iii)=0.0d0
8730 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8732 cd write (2,*) 'eello6_5',eello6_5
8734 call transpose2(AEA(1,1,1),auxmat(1,1))
8735 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
8736 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
8737 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
8739 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8740 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
8741 s2 = scalar2(b1(1,itk),vtemp1(1))
8743 call transpose2(AEA(1,1,2),atemp(1,1))
8744 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
8745 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
8746 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8748 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
8749 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
8750 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
8752 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
8753 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
8754 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
8755 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
8756 ss13 = scalar2(b1(1,itk),vtemp4(1))
8757 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
8759 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
8765 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
8766 C Derivatives in gamma(i+2)
8770 call transpose2(AEA(1,1,1),auxmatd(1,1))
8771 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8772 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8773 call transpose2(AEAderg(1,1,2),atempd(1,1))
8774 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8775 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8777 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
8778 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8779 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8785 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
8786 C Derivatives in gamma(i+3)
8788 call transpose2(AEA(1,1,1),auxmatd(1,1))
8789 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8790 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
8791 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
8793 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
8794 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
8795 s2d = scalar2(b1(1,itk),vtemp1d(1))
8797 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
8798 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
8800 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
8802 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
8803 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8804 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8812 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8813 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8815 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
8816 & -0.5d0*ekont*(s2d+s12d)
8818 C Derivatives in gamma(i+4)
8819 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
8820 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8821 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8823 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
8824 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
8825 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
8833 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
8835 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
8837 C Derivatives in gamma(i+5)
8839 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
8840 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8841 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8843 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
8844 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
8845 s2d = scalar2(b1(1,itk),vtemp1d(1))
8847 call transpose2(AEA(1,1,2),atempd(1,1))
8848 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
8849 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
8851 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
8852 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8854 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
8855 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8856 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8864 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8865 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
8867 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
8868 & -0.5d0*ekont*(s2d+s12d)
8870 C Cartesian derivatives
8875 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
8876 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
8877 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
8879 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
8880 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
8882 s2d = scalar2(b1(1,itk),vtemp1d(1))
8884 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
8885 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
8886 s8d = -(atempd(1,1)+atempd(2,2))*
8887 & scalar2(cc(1,1,itl),vtemp2(1))
8889 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
8891 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
8892 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
8899 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8902 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
8906 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8907 & - 0.5d0*(s8d+s12d)
8909 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
8918 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
8920 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
8921 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
8922 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
8923 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
8924 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
8926 ss13d = scalar2(b1(1,itk),vtemp4d(1))
8927 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
8928 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
8932 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
8933 cd & 16*eel_turn6_num
8935 if (j.lt.nres-1) then
8942 if (l.lt.nres-1) then
8950 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
8951 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
8952 cgrad ghalf=0.5d0*ggg1(ll)
8954 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
8955 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
8956 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
8957 & +ekont*derx_turn(ll,2,1)
8958 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
8959 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
8960 & +ekont*derx_turn(ll,4,1)
8961 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
8962 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
8963 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
8964 cgrad ghalf=0.5d0*ggg2(ll)
8966 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
8967 & +ekont*derx_turn(ll,2,2)
8968 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
8969 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
8970 & +ekont*derx_turn(ll,4,2)
8971 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
8972 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
8973 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
8978 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
8983 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
8989 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
8994 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
8998 cd write (2,*) iii,g_corr6_loc(iii)
9000 eello_turn6=ekont*eel_turn6
9001 cd write (2,*) 'ekont',ekont
9002 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9006 C-----------------------------------------------------------------------------
9007 double precision function scalar(u,v)
9008 !DIR$ INLINEALWAYS scalar
9010 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9013 double precision u(3),v(3)
9014 cd double precision sc
9022 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9025 crc-------------------------------------------------
9026 SUBROUTINE MATVEC2(A1,V1,V2)
9027 !DIR$ INLINEALWAYS MATVEC2
9029 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9031 implicit real*8 (a-h,o-z)
9032 include 'DIMENSIONS'
9033 DIMENSION A1(2,2),V1(2),V2(2)
9037 c 3 VI=VI+A1(I,K)*V1(K)
9041 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9042 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9047 C---------------------------------------
9048 SUBROUTINE MATMAT2(A1,A2,A3)
9050 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9052 implicit real*8 (a-h,o-z)
9053 include 'DIMENSIONS'
9054 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9055 c DIMENSION AI3(2,2)
9059 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9065 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9066 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9067 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9068 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9076 c-------------------------------------------------------------------------
9077 double precision function scalar2(u,v)
9078 !DIR$ INLINEALWAYS scalar2
9080 double precision u(2),v(2)
9083 scalar2=u(1)*v(1)+u(2)*v(2)
9087 C-----------------------------------------------------------------------------
9089 subroutine transpose2(a,at)
9090 !DIR$ INLINEALWAYS transpose2
9092 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9095 double precision a(2,2),at(2,2)
9102 c--------------------------------------------------------------------------
9103 subroutine transpose(n,a,at)
9106 double precision a(n,n),at(n,n)
9114 C---------------------------------------------------------------------------
9115 subroutine prodmat3(a1,a2,kk,transp,prod)
9116 !DIR$ INLINEALWAYS prodmat3
9118 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9122 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9124 crc double precision auxmat(2,2),prod_(2,2)
9127 crc call transpose2(kk(1,1),auxmat(1,1))
9128 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9129 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9131 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9132 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9133 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9134 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9135 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9136 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9137 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9138 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9141 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9142 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9144 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9145 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9146 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9147 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9148 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9149 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9150 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9151 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9154 c call transpose2(a2(1,1),a2t(1,1))
9157 crc print *,((prod_(i,j),i=1,2),j=1,2)
9158 crc print *,((prod(i,j),i=1,2),j=1,2)