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
36 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
37 if (fg_rank.eq.0) then
38 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
39 c print *,"Processor",myrank," BROADCAST iorder"
40 C FG master sets up the WEIGHTS_ array which will be broadcast to the
41 C FG slaves as WEIGHTS array.
62 C FG Master broadcasts the WEIGHTS_ array
63 call MPI_Bcast(weights_(1),n_ene,
64 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
66 C FG slaves receive the WEIGHTS array
67 call MPI_Bcast(weights(1),n_ene,
68 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
90 time_Bcast=time_Bcast+MPI_Wtime()-time00
91 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
92 c call chainbuild_cart
94 c print *,'Processor',myrank,' calling etotal ipot=',ipot
95 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
97 c if (modecalc.eq.12.or.modecalc.eq.14) then
98 c call int_from_cart1(.false.)
109 C Compute the side-chain and electrostatic interaction energy
111 goto (101,102,103,104,105,106,107) ipot
112 C Lennard-Jones potential.
113 101 call elj(evdw,evdw_p,evdw_m)
114 cd print '(a)','Exit ELJ'
116 C Lennard-Jones-Kihara potential (shifted).
117 102 call eljk(evdw,evdw_p,evdw_m)
119 C Berne-Pechukas potential (dilated LJ, angular dependence).
120 103 call ebp(evdw,evdw_p,evdw_m)
122 C Gay-Berne potential (shifted LJ, angular dependence).
123 104 call egb(evdw,evdw_p,evdw_m)
125 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
126 105 call egbv(evdw,evdw_p,evdw_m)
128 C New SC-SC potential
129 106 call emomo(evdw,evdw_p,evdw_m)
131 C Soft-sphere potential
132 107 call e_softsphere(evdw)
134 C Calculate electrostatic (H-bonding) energy of the main chain.
138 cmc Sep-06: egb takes care of dynamic ss bonds too
140 c if (dyn_ss) call dyn_set_nss
142 c print *,"Processor",myrank," computed USCSC"
153 time_vec=time_vec+MPI_Wtime()-time01
155 time_vec=time_vec+tcpu()-time01
158 c print *,"Processor",myrank," left VEC_AND_DERIV"
161 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
162 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
163 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
164 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
166 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
167 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
168 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
169 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
171 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
180 c write (iout,*) "Soft-spheer ELEC potential"
181 call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
184 c print *,"Processor",myrank," computed UELEC"
186 C Calculate excluded-volume interaction energy between peptide groups
191 call escp(evdw2,evdw2_14)
197 c write (iout,*) "Soft-sphere SCP potential"
198 call escp_soft_sphere(evdw2,evdw2_14)
201 c Calculate the bond-stretching energy
205 C Calculate the disulfide-bridge and other energy and the contributions
206 C from other distance constraints.
207 cd print *,'Calling EHPB'
209 cd print *,'EHPB exitted succesfully.'
211 C Calculate the virtual-bond-angle energy.
213 if (wang.gt.0d0) then
218 c print *,"Processor",myrank," computed UB"
220 C Calculate the SC local energy.
223 c print *,"Processor",myrank," computed USC"
225 C Calculate the virtual-bond torsional energy.
227 cd print *,'nterm=',nterm
229 call etor(etors,edihcnstr)
234 c print *,"Processor",myrank," computed Utor"
236 C 6/23/01 Calculate double-torsional energy
238 if (wtor_d.gt.0) then
243 c print *,"Processor",myrank," computed Utord"
245 C 21/5/07 Calculate local sicdechain correlation energy
247 if (wsccor.gt.0.0d0) then
248 call eback_sc_corr(esccor)
252 c print *,"Processor",myrank," computed Usccorr"
254 C 12/1/95 Multi-body terms
258 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
259 & .or. wturn6.gt.0.0d0) .and. ipot.lt.7) then
260 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
261 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
262 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
269 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.7) then
270 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
271 cd write (iout,*) "multibody_hb ecorr",ecorr
273 c print *,"Processor",myrank," computed Ucorr"
275 C If performing constraint dynamics, call the constraint energy
276 C after the equilibration time
277 if(usampl.and.totT.gt.eq_time) then
286 time_enecalc=time_enecalc+MPI_Wtime()-time00
288 time_enecalc=time_enecalc+tcpu()-time00
291 c print *,"Processor",myrank," computed Uconstr"
304 energia(2)=evdw2-evdw2_14
321 energia(8)=eello_turn3
322 energia(9)=eello_turn4
329 energia(19)=edihcnstr
331 energia(20)=Uconst+Uconst_back
335 c print *," Processor",myrank," calls SUM_ENERGY"
336 call sum_energy(energia,.true.)
337 if (dyn_ss) call dyn_set_nss
338 c print *," Processor",myrank," left SUM_ENERGY"
341 time_sumene=time_sumene+MPI_Wtime()-time00
343 time_sumene=time_sumene+tcpu()-time00
347 END SUBROUTINE etotal
348 c-------------------------------------------------------------------------------
349 subroutine sum_energy(energia,reduce)
350 implicit real*8 (a-h,o-z)
355 cMS$ATTRIBUTES C :: proc_proc
361 include 'COMMON.SETUP'
362 include 'COMMON.IOUNITS'
363 double precision energia(0:n_ene),enebuff(0:n_ene+1)
364 include 'COMMON.FFIELD'
365 include 'COMMON.DERIV'
366 include 'COMMON.INTERACT'
367 include 'COMMON.SBRIDGE'
368 include 'COMMON.CHAIN'
370 include 'COMMON.CONTROL'
371 include 'COMMON.TIME1'
374 if (nfgtasks.gt.1 .and. reduce) then
376 write (iout,*) "energies before REDUCE"
377 call enerprint(energia)
381 enebuff(i)=energia(i)
384 call MPI_Barrier(FG_COMM,IERR)
385 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
387 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
388 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
390 write (iout,*) "energies after REDUCE"
391 call enerprint(energia)
394 time_Reduce=time_Reduce+MPI_Wtime()-time00
396 if (fg_rank.eq.0) then
399 evdw=energia(22)+wsct*energia(23)
404 evdw2=energia(2)+energia(18)
420 eello_turn3=energia(8)
421 eello_turn4=energia(9)
428 edihcnstr=energia(19)
433 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
434 & +wang*ebe+wtor*etors+wscloc*escloc
435 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
436 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
437 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
438 & +wbond*estr+Uconst+wsccor*esccor
440 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
441 & +wang*ebe+wtor*etors+wscloc*escloc
442 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
443 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
444 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
445 & +wbond*estr+Uconst+wsccor*esccor
451 if (isnan(etot).ne.0) energia(0)=1.0d+99
453 if (isnan(etot)) energia(0)=1.0d+99
458 idumm=proc_proc(etot,i)
460 call proc_proc(etot,i)
462 if(i.eq.1)energia(0)=1.0d+99
469 c-------------------------------------------------------------------------------
470 subroutine sum_gradient
471 implicit real*8 (a-h,o-z)
476 cMS$ATTRIBUTES C :: proc_proc
482 double precision gradbufc(3,maxres),gradbufx(3,maxres),
483 & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres)
484 include 'COMMON.SETUP'
485 include 'COMMON.IOUNITS'
486 include 'COMMON.FFIELD'
487 include 'COMMON.DERIV'
488 include 'COMMON.INTERACT'
489 include 'COMMON.SBRIDGE'
490 include 'COMMON.CHAIN'
492 include 'COMMON.CONTROL'
493 include 'COMMON.TIME1'
494 include 'COMMON.MAXGRAD'
495 include 'COMMON.SCCOR'
504 write (iout,*) "sum_gradient gvdwc, gvdwx"
506 write (iout,'(i3,3f10.5,5x,3f10.5,5x,3f10.5,5x,3f10.5)')
507 & i,(gvdwx(j,i),j=1,3),(gvdwcT(j,i),j=1,3),(gvdwc(j,i),j=1,3),
508 & (gvdwcT(j,i),j=1,3)
513 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
514 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
515 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
518 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
519 C in virtual-bond-vector coordinates
522 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
524 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
525 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
527 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
529 c write (iout,'(i5,3f10.5,2x,f10.5)')
530 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
532 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
534 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
535 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
544 gradbufc(j,i)=wsc*gvdwc(j,i)+wsc*wscT*gvdwcT(j,i)+
545 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
546 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
547 & wel_loc*gel_loc_long(j,i)+
548 & wcorr*gradcorr_long(j,i)+
549 & wcorr5*gradcorr5_long(j,i)+
550 & wcorr6*gradcorr6_long(j,i)+
551 & wturn6*gcorr6_turn_long(j,i)+
558 gradbufc(j,i)=wsc*gvdwc(j,i)+
559 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
560 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
561 & wel_loc*gel_loc_long(j,i)+
562 & wcorr*gradcorr_long(j,i)+
563 & wcorr5*gradcorr5_long(j,i)+
564 & wcorr6*gradcorr6_long(j,i)+
565 & wturn6*gcorr6_turn_long(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)+
587 if (nfgtasks.gt.1) then
590 write (iout,*) "gradbufc before allreduce"
592 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
598 gradbufc_sum(j,i)=gradbufc(j,i)
601 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
602 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
603 c time_reduce=time_reduce+MPI_Wtime()-time00
605 c write (iout,*) "gradbufc_sum after allreduce"
607 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
612 c time_allreduce=time_allreduce+MPI_Wtime()-time00
620 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
621 write (iout,*) (i," jgrad_start",jgrad_start(i),
622 & " jgrad_end ",jgrad_end(i),
623 & i=igrad_start,igrad_end)
626 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
627 c do not parallelize this part.
629 c do i=igrad_start,igrad_end
630 c do j=jgrad_start(i),jgrad_end(i)
632 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
637 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
641 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
645 write (iout,*) "gradbufc after summing"
647 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
654 write (iout,*) "gradbufc"
656 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
662 gradbufc_sum(j,i)=gradbufc(j,i)
667 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
671 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
676 c gradbufc(k,i)=0.0d0
680 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
685 write (iout,*) "gradbufc after summing"
687 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
695 gradbufc(k,nres)=0.0d0
700 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
701 & wel_loc*gel_loc(j,i)+
702 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
703 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
704 & wel_loc*gel_loc_long(j,i)+
705 & wcorr*gradcorr_long(j,i)+
706 & wcorr5*gradcorr5_long(j,i)+
707 & wcorr6*gradcorr6_long(j,i)+
708 & wturn6*gcorr6_turn_long(j,i))+
710 & wcorr*gradcorr(j,i)+
711 & wturn3*gcorr3_turn(j,i)+
712 & wturn4*gcorr4_turn(j,i)+
713 & wcorr5*gradcorr5(j,i)+
714 & wcorr6*gradcorr6(j,i)+
715 & wturn6*gcorr6_turn(j,i)+
716 & wsccor*gsccorc(j,i)
717 & +wscloc*gscloc(j,i)
719 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
720 & wel_loc*gel_loc(j,i)+
721 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
722 & welec*gelc_long(j,i)+
723 & wel_loc*gel_loc_long(j,i)+
724 & wcorr*gcorr_long(j,i)+
725 & wcorr5*gradcorr5_long(j,i)+
726 & wcorr6*gradcorr6_long(j,i)+
727 & wturn6*gcorr6_turn_long(j,i))+
729 & wcorr*gradcorr(j,i)+
730 & wturn3*gcorr3_turn(j,i)+
731 & wturn4*gcorr4_turn(j,i)+
732 & wcorr5*gradcorr5(j,i)+
733 & wcorr6*gradcorr6(j,i)+
734 & wturn6*gcorr6_turn(j,i)+
735 & wsccor*gsccorc(j,i)
736 & +wscloc*gscloc(j,i)
739 gradx(j,i,icg)=wsc*gvdwx(j,i)+wsc*wscT*gvdwxT(j,i)+
740 & wscp*gradx_scp(j,i)+
742 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
743 & wsccor*gsccorx(j,i)
744 & +wscloc*gsclocx(j,i)
746 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
748 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
749 & wsccor*gsccorx(j,i)
750 & +wscloc*gsclocx(j,i)
755 write (iout,*) "gloc before adding corr"
757 write (iout,*) i,gloc(i,icg)
761 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
762 & +wcorr5*g_corr5_loc(i)
763 & +wcorr6*g_corr6_loc(i)
764 & +wturn4*gel_loc_turn4(i)
765 & +wturn3*gel_loc_turn3(i)
766 & +wturn6*gel_loc_turn6(i)
767 & +wel_loc*gel_loc_loc(i)
770 write (iout,*) "gloc after adding corr"
772 write (iout,*) i,gloc(i,icg)
776 if (nfgtasks.gt.1) then
779 gradbufc(j,i)=gradc(j,i,icg)
780 gradbufx(j,i)=gradx(j,i,icg)
784 glocbuf(i)=gloc(i,icg)
787 write (iout,*) "gloc_sc before reduce"
790 write (iout,*) i,j,gloc_sc(j,i,icg)
796 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
800 call MPI_Barrier(FG_COMM,IERR)
801 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
803 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
804 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
805 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
806 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
807 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
808 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
809 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
810 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
811 time_reduce=time_reduce+MPI_Wtime()-time00
813 write (iout,*) "gloc_sc after reduce"
816 write (iout,*) i,j,gloc_sc(j,i,icg)
821 write (iout,*) "gloc after reduce"
823 write (iout,*) i,gloc(i,icg)
828 if (gnorm_check) then
830 c Compute the maximum elements of the gradient
840 gcorr3_turn_max=0.0d0
841 gcorr4_turn_max=0.0d0
844 gcorr6_turn_max=0.0d0
854 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
855 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
857 gvdwc_norm=dsqrt(scalar(gvdwcT(1,i),gvdwcT(1,i)))
858 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
860 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
861 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
862 & gvdwc_scp_max=gvdwc_scp_norm
863 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
864 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
865 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
866 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
867 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
868 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
869 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
870 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
871 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
872 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
873 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
874 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
875 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
877 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
878 & gcorr3_turn_max=gcorr3_turn_norm
879 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
881 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
882 & gcorr4_turn_max=gcorr4_turn_norm
883 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
884 if (gradcorr5_norm.gt.gradcorr5_max)
885 & gradcorr5_max=gradcorr5_norm
886 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
887 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
888 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
890 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
891 & gcorr6_turn_max=gcorr6_turn_norm
892 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
893 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
894 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
895 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
896 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
897 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
899 gvdwx_norm=dsqrt(scalar(gvdwxT(1,i),gvdwxT(1,i)))
900 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
902 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
903 if (gradx_scp_norm.gt.gradx_scp_max)
904 & gradx_scp_max=gradx_scp_norm
905 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
906 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
907 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
908 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
909 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
910 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
911 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
912 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
916 open(istat,file=statname,position="append")
918 open(istat,file=statname,access="append")
920 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
921 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
922 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
923 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
924 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
925 & gsccorx_max,gsclocx_max
927 if (gvdwc_max.gt.1.0d4) then
928 write (iout,*) "gvdwc gvdwx gradb gradbx"
930 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
931 & gradb(j,i),gradbx(j,i),j=1,3)
933 call pdbout(0.0d0,'cipiszcze',iout)
939 write (iout,*) "gradc gradx gloc"
941 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
942 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
947 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
949 time_sumgradient=time_sumgradient+tcpu()-time01
954 c-------------------------------------------------------------------------------
955 subroutine rescale_weights(t_bath)
956 implicit real*8 (a-h,o-z)
958 include 'COMMON.IOUNITS'
959 include 'COMMON.FFIELD'
960 include 'COMMON.SBRIDGE'
961 double precision kfac /2.4d0/
962 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
964 c facT=2*temp0/(t_bath+temp0)
965 if (rescale_mode.eq.0) then
971 else if (rescale_mode.eq.1) then
972 facT=kfac/(kfac-1.0d0+t_bath/temp0)
973 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
974 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
975 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
976 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
977 else if (rescale_mode.eq.2) then
983 facT=licznik/dlog(dexp(x)+dexp(-x))
984 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
985 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
986 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
987 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
989 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
990 write (*,*) "Wrong RESCALE_MODE",rescale_mode
992 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
996 welec=weights(3)*fact
997 wcorr=weights(4)*fact3
998 wcorr5=weights(5)*fact4
999 wcorr6=weights(6)*fact5
1000 wel_loc=weights(7)*fact2
1001 wturn3=weights(8)*fact2
1002 wturn4=weights(9)*fact3
1003 wturn6=weights(10)*fact5
1004 wtor=weights(13)*fact
1005 wtor_d=weights(14)*fact2
1006 wsccor=weights(21)*fact
1009 wsct=(320.0+80.0*dtanh((t_bath-320.0)/80.0))/320.0
1013 C------------------------------------------------------------------------
1014 subroutine enerprint(energia)
1015 implicit real*8 (a-h,o-z)
1016 include 'DIMENSIONS'
1017 include 'COMMON.IOUNITS'
1018 include 'COMMON.FFIELD'
1019 include 'COMMON.SBRIDGE'
1021 double precision energia(0:n_ene)
1024 evdw=energia(22)+wsct*energia(23)
1030 evdw2=energia(2)+energia(18)
1042 eello_turn3=energia(8)
1043 eello_turn4=energia(9)
1044 eello_turn6=energia(10)
1050 edihcnstr=energia(19)
1055 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
1056 & estr,wbond,ebe,wang,
1057 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1059 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1060 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
1061 & edihcnstr,ebr*nss,
1063 10 format (/'Virtual-chain energies:'//
1064 & 'EVDW= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-SC)'/
1065 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC-p)'/
1066 & 'EES= ',1pE16.6,' WEIGHT=',1pE16.6,' (p-p)'/
1067 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pE16.6,' (p-p VDW)'/
1068 & 'ESTR= ',1pE16.6,' WEIGHT=',1pE16.6,' (stretching)'/
1069 & 'EBE= ',1pE16.6,' WEIGHT=',1pE16.6,' (bending)'/
1070 & 'ESC= ',1pE16.6,' WEIGHT=',1pE16.6,' (SC local)'/
1071 & 'ETORS= ',1pE16.6,' WEIGHT=',1pE16.6,' (torsional)'/
1072 & 'ETORSD=',1pE16.6,' WEIGHT=',1pE16.6,' (double torsional)'/
1073 & 'EHPB= ',1pE16.6,' WEIGHT=',1pE16.6,
1074 & ' (SS bridges & dist. cnstr.)'/
1075 & 'ECORR4=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1076 & 'ECORR5=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1077 & 'ECORR6=',1pE16.6,' WEIGHT=',1pE16.6,' (multi-body)'/
1078 & 'EELLO= ',1pE16.6,' WEIGHT=',1pE16.6,' (electrostatic-local)'/
1079 & 'ETURN3=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 3rd order)'/
1080 & 'ETURN4=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 4th order)'/
1081 & 'ETURN6=',1pE16.6,' WEIGHT=',1pE16.6,' (turns, 6th order)'/
1082 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pE16.6,' (backbone-rotamer corr)'/
1083 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1084 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1085 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1086 & 'ETOT= ',1pE16.6,' (total)')
1088 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1089 & estr,wbond,ebe,wang,
1090 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1092 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1093 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1094 & ebr*nss,Uconst,etot
1095 10 format (/'Virtual-chain energies:'//
1096 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1097 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1098 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1099 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1100 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1101 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1102 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1103 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1104 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1105 & ' (SS bridges & dist. cnstr.)'/
1106 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1107 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1108 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1109 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1110 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1111 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1112 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1113 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1114 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1115 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1116 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1117 & 'ETOT= ',1pE16.6,' (total)')
1121 C-----------------------------------------------------------------------
1122 subroutine elj(evdw,evdw_p,evdw_m)
1124 C This subroutine calculates the interaction energy of nonbonded side chains
1125 C assuming the LJ potential of interaction.
1127 implicit real*8 (a-h,o-z)
1128 include 'DIMENSIONS'
1129 parameter (accur=1.0d-10)
1130 include 'COMMON.GEO'
1131 include 'COMMON.VAR'
1132 include 'COMMON.LOCAL'
1133 include 'COMMON.CHAIN'
1134 include 'COMMON.DERIV'
1135 include 'COMMON.INTERACT'
1136 include 'COMMON.TORSION'
1137 include 'COMMON.SBRIDGE'
1138 include 'COMMON.NAMES'
1139 include 'COMMON.IOUNITS'
1140 include 'COMMON.CONTACTS'
1142 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1144 do i=iatsc_s,iatsc_e
1153 C Calculate SC interaction energy.
1155 do iint=1,nint_gr(i)
1156 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1157 cd & 'iend=',iend(i,iint)
1158 do j=istart(i,iint),iend(i,iint)
1163 C Change 12/1/95 to calculate four-body interactions
1164 rij=xj*xj+yj*yj+zj*zj
1166 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1167 eps0ij=eps(itypi,itypj)
1169 e1=fac*fac*aa(itypi,itypj)
1170 e2=fac*bb(itypi,itypj)
1172 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1173 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1174 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1175 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1176 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1177 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1179 if (bb(itypi,itypj).gt.0) then
1180 evdw_p=evdw_p+evdwij
1182 evdw_m=evdw_m+evdwij
1188 C Calculate the components of the gradient in DC and X
1190 fac=-rrij*(e1+evdwij)
1195 if (bb(itypi,itypj).gt.0.0d0) then
1197 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1198 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1199 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1200 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1204 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1205 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1206 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1207 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1212 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1213 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1214 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1215 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1220 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1224 C 12/1/95, revised on 5/20/97
1226 C Calculate the contact function. The ith column of the array JCONT will
1227 C contain the numbers of atoms that make contacts with the atom I (of numbers
1228 C greater than I). The arrays FACONT and GACONT will contain the values of
1229 C the contact function and its derivative.
1231 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1232 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1233 C Uncomment next line, if the correlation interactions are contact function only
1234 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1236 sigij=sigma(itypi,itypj)
1237 r0ij=rs0(itypi,itypj)
1239 C Check whether the SC's are not too far to make a contact.
1242 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1243 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1245 if (fcont.gt.0.0D0) then
1246 C If the SC-SC distance if close to sigma, apply spline.
1247 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1248 cAdam & fcont1,fprimcont1)
1249 cAdam fcont1=1.0d0-fcont1
1250 cAdam if (fcont1.gt.0.0d0) then
1251 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1252 cAdam fcont=fcont*fcont1
1254 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1255 cga eps0ij=1.0d0/dsqrt(eps0ij)
1257 cga gg(k)=gg(k)*eps0ij
1259 cga eps0ij=-evdwij*eps0ij
1260 C Uncomment for AL's type of SC correlation interactions.
1261 cadam eps0ij=-evdwij
1262 num_conti=num_conti+1
1263 jcont(num_conti,i)=j
1264 facont(num_conti,i)=fcont*eps0ij
1265 fprimcont=eps0ij*fprimcont/rij
1267 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1268 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1269 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1270 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1271 gacont(1,num_conti,i)=-fprimcont*xj
1272 gacont(2,num_conti,i)=-fprimcont*yj
1273 gacont(3,num_conti,i)=-fprimcont*zj
1274 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1275 cd write (iout,'(2i3,3f10.5)')
1276 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1282 num_cont(i)=num_conti
1286 gvdwc(j,i)=expon*gvdwc(j,i)
1287 gvdwx(j,i)=expon*gvdwx(j,i)
1290 C******************************************************************************
1294 C To save time, the factor of EXPON has been extracted from ALL components
1295 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1298 C******************************************************************************
1301 C-----------------------------------------------------------------------------
1302 subroutine eljk(evdw,evdw_p,evdw_m)
1304 C This subroutine calculates the interaction energy of nonbonded side chains
1305 C assuming the LJK potential of interaction.
1307 implicit real*8 (a-h,o-z)
1308 include 'DIMENSIONS'
1309 include 'COMMON.GEO'
1310 include 'COMMON.VAR'
1311 include 'COMMON.LOCAL'
1312 include 'COMMON.CHAIN'
1313 include 'COMMON.DERIV'
1314 include 'COMMON.INTERACT'
1315 include 'COMMON.IOUNITS'
1316 include 'COMMON.NAMES'
1319 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1321 do i=iatsc_s,iatsc_e
1328 C Calculate SC interaction energy.
1330 do iint=1,nint_gr(i)
1331 do j=istart(i,iint),iend(i,iint)
1336 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1337 fac_augm=rrij**expon
1338 e_augm=augm(itypi,itypj)*fac_augm
1339 r_inv_ij=dsqrt(rrij)
1341 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1342 fac=r_shift_inv**expon
1343 e1=fac*fac*aa(itypi,itypj)
1344 e2=fac*bb(itypi,itypj)
1346 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1347 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1348 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1349 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1350 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1351 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1352 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1354 if (bb(itypi,itypj).gt.0) then
1355 evdw_p=evdw_p+evdwij
1357 evdw_m=evdw_m+evdwij
1363 C Calculate the components of the gradient in DC and X
1365 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1370 if (bb(itypi,itypj).gt.0.0d0) then
1372 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1373 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1374 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1375 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1379 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
1380 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
1381 gvdwcT(k,i)=gvdwcT(k,i)-gg(k)
1382 gvdwcT(k,j)=gvdwcT(k,j)+gg(k)
1387 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1388 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1389 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1390 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1395 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1403 gvdwc(j,i)=expon*gvdwc(j,i)
1404 gvdwx(j,i)=expon*gvdwx(j,i)
1409 C-----------------------------------------------------------------------------
1410 subroutine ebp(evdw,evdw_p,evdw_m)
1412 C This subroutine calculates the interaction energy of nonbonded side chains
1413 C assuming the Berne-Pechukas potential of interaction.
1415 implicit real*8 (a-h,o-z)
1416 include 'DIMENSIONS'
1417 include 'COMMON.GEO'
1418 include 'COMMON.VAR'
1419 include 'COMMON.LOCAL'
1420 include 'COMMON.CHAIN'
1421 include 'COMMON.DERIV'
1422 include 'COMMON.NAMES'
1423 include 'COMMON.INTERACT'
1424 include 'COMMON.IOUNITS'
1425 include 'COMMON.CALC'
1426 common /srutu/ icall
1427 c double precision rrsave(maxdim)
1430 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1432 c if (icall.eq.0) then
1438 do i=iatsc_s,iatsc_e
1444 dxi=dc_norm(1,nres+i)
1445 dyi=dc_norm(2,nres+i)
1446 dzi=dc_norm(3,nres+i)
1447 c dsci_inv=dsc_inv(itypi)
1448 dsci_inv=vbld_inv(i+nres)
1450 C Calculate SC interaction energy.
1452 do iint=1,nint_gr(i)
1453 do j=istart(i,iint),iend(i,iint)
1456 c dscj_inv=dsc_inv(itypj)
1457 dscj_inv=vbld_inv(j+nres)
1458 chi1=chi(itypi,itypj)
1459 chi2=chi(itypj,itypi)
1466 alf12=0.5D0*(alf1+alf2)
1467 C For diagnostics only!!!
1480 dxj=dc_norm(1,nres+j)
1481 dyj=dc_norm(2,nres+j)
1482 dzj=dc_norm(3,nres+j)
1483 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1484 cd if (icall.eq.0) then
1490 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1492 C Calculate whole angle-dependent part of epsilon and contributions
1493 C to its derivatives
1494 fac=(rrij*sigsq)**expon2
1495 e1=fac*fac*aa(itypi,itypj)
1496 e2=fac*bb(itypi,itypj)
1497 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1498 eps2der=evdwij*eps3rt
1499 eps3der=evdwij*eps2rt
1500 evdwij=evdwij*eps2rt*eps3rt
1502 if (bb(itypi,itypj).gt.0) then
1503 evdw_p=evdw_p+evdwij
1505 evdw_m=evdw_m+evdwij
1511 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1512 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1513 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1514 cd & restyp(itypi),i,restyp(itypj),j,
1515 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1516 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1517 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1520 C Calculate gradient components.
1521 e1=e1*eps1*eps2rt**2*eps3rt**2
1522 fac=-expon*(e1+evdwij)
1525 C Calculate radial part of the gradient
1529 C Calculate the angular part of the gradient and sum add the contributions
1530 C to the appropriate components of the Cartesian gradient.
1532 if (bb(itypi,itypj).gt.0) then
1546 C-----------------------------------------------------------------------------
1547 subroutine egb(evdw,evdw_p,evdw_m)
1549 C This subroutine calculates the interaction energy of nonbonded side chains
1550 C assuming the Gay-Berne potential of interaction.
1552 implicit real*8 (a-h,o-z)
1553 include 'DIMENSIONS'
1554 include 'COMMON.GEO'
1555 include 'COMMON.VAR'
1556 include 'COMMON.LOCAL'
1557 include 'COMMON.CHAIN'
1558 include 'COMMON.DERIV'
1559 include 'COMMON.NAMES'
1560 include 'COMMON.INTERACT'
1561 include 'COMMON.IOUNITS'
1562 include 'COMMON.CALC'
1563 include 'COMMON.CONTROL'
1564 include 'COMMON.SBRIDGE'
1566 IF (energy_dec) write (iout,'(a)')
1567 & ' AAi i AAj j 1/rij Rtail evdw Fcav eheadtail'
1568 ccccc energy_dec=.false.
1569 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1574 c if (icall.eq.0) lprn=.false.
1576 do i=iatsc_s,iatsc_e
1582 dxi=dc_norm(1,nres+i)
1583 dyi=dc_norm(2,nres+i)
1584 dzi=dc_norm(3,nres+i)
1585 c dsci_inv=dsc_inv(itypi)
1586 dsci_inv=vbld_inv(i+nres)
1587 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1588 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1590 C Calculate SC interaction energy.
1592 do iint=1,nint_gr(i)
1593 do j=istart(i,iint),iend(i,iint)
1594 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1595 call dyn_ssbond_ene(i,j,evdwij)
1597 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1598 & 'evdw',i,j,evdwij,' ss'
1602 c dscj_inv=dsc_inv(itypj)
1603 dscj_inv=vbld_inv(j+nres)
1604 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1605 c & 1.0d0/vbld(j+nres)
1606 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1607 sig0ij=sigma(itypi,itypj)
1608 chi1=chi(itypi,itypj)
1609 chi2=chi(itypj,itypi)
1616 alf12=0.5D0*(alf1+alf2)
1617 C For diagnostics only!!!
1630 dxj=dc_norm(1,nres+j)
1631 dyj=dc_norm(2,nres+j)
1632 dzj=dc_norm(3,nres+j)
1633 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1634 c write (iout,*) "j",j," dc_norm",
1635 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1636 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1639 C Calculate angle-dependent terms of energy and contributions to their
1643 sig=sig0ij*dsqrt(sigsq)
1644 rij_shift=1.0D0/rij-sig+sig0ij
1645 c for diagnostics; uncomment
1646 c rij_shift=1.2*sig0ij
1647 C I hate to put IF's in the loops, but here don't have another choice!!!!
1648 if (rij_shift.le.0.0D0) then
1650 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1651 cd & restyp(itypi),i,restyp(itypj),j,
1652 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1656 c---------------------------------------------------------------
1657 rij_shift=1.0D0/rij_shift
1658 fac=rij_shift**expon
1659 e1=fac*fac*aa(itypi,itypj)
1660 e2=fac*bb(itypi,itypj)
1661 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1662 eps2der=evdwij*eps3rt
1663 eps3der=evdwij*eps2rt
1664 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1665 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1666 evdwij=evdwij*eps2rt*eps3rt
1668 if (bb(itypi,itypj).gt.0) then
1669 evdw_p=evdw_p+evdwij
1671 evdw_m=evdw_m+evdwij
1677 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1678 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1679 c! write (iout,*) "POT = 4 (GB), ENERGY COMPONENTS:"
1680 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1681 & restyp(itypi),i,restyp(itypj),j,
1682 & epsi,sigm,chi1,chi2,chip1,chip2,
1683 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1684 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1688 c! if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1689 c! & 'evdw',i,j,evdwij
1691 C Calculate gradient components.
1692 e1=e1*eps1*eps2rt**2*eps3rt**2
1693 fac=-expon*(e1+evdwij)*rij_shift
1697 C Calculate the radial part of the gradient
1701 C Calculate angular part of the gradient.
1703 if (bb(itypi,itypj).gt.0) then
1711 IF (energy_dec) write (iout,'(2(1x,a3,i3),2f6.2,4f20.8)')
1712 & restyp(itype(i)),i,restyp(itype(j)),j,
1713 & 1.0d0/rij,Rtail,evdwij,Fcav,eheadtail,evdw
1718 c write (iout,*) "Number of loop steps in EGB:",ind
1719 cccc energy_dec=.false.
1722 C-----------------------------------------------------------------------------
1723 subroutine egbv(evdw,evdw_p,evdw_m)
1725 C This subroutine calculates the interaction energy of nonbonded side chains
1726 C assuming the Gay-Berne-Vorobjev potential of interaction.
1728 implicit real*8 (a-h,o-z)
1729 include 'DIMENSIONS'
1730 include 'COMMON.GEO'
1731 include 'COMMON.VAR'
1732 include 'COMMON.LOCAL'
1733 include 'COMMON.CHAIN'
1734 include 'COMMON.DERIV'
1735 include 'COMMON.NAMES'
1736 include 'COMMON.INTERACT'
1737 include 'COMMON.IOUNITS'
1738 include 'COMMON.CALC'
1739 common /srutu/ icall
1742 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1745 c if (icall.eq.0) lprn=.true.
1747 do i=iatsc_s,iatsc_e
1753 dxi=dc_norm(1,nres+i)
1754 dyi=dc_norm(2,nres+i)
1755 dzi=dc_norm(3,nres+i)
1756 c dsci_inv=dsc_inv(itypi)
1757 dsci_inv=vbld_inv(i+nres)
1759 C Calculate SC interaction energy.
1761 do iint=1,nint_gr(i)
1762 do j=istart(i,iint),iend(i,iint)
1765 c dscj_inv=dsc_inv(itypj)
1766 dscj_inv=vbld_inv(j+nres)
1767 sig0ij=sigma(itypi,itypj)
1768 r0ij=r0(itypi,itypj)
1769 chi1=chi(itypi,itypj)
1770 chi2=chi(itypj,itypi)
1777 alf12=0.5D0*(alf1+alf2)
1778 C For diagnostics only!!!
1791 dxj=dc_norm(1,nres+j)
1792 dyj=dc_norm(2,nres+j)
1793 dzj=dc_norm(3,nres+j)
1794 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1796 C Calculate angle-dependent terms of energy and contributions to their
1800 sig=sig0ij*dsqrt(sigsq)
1801 rij_shift=1.0D0/rij-sig+r0ij
1802 C I hate to put IF's in the loops, but here don't have another choice!!!!
1803 if (rij_shift.le.0.0D0) then
1808 c---------------------------------------------------------------
1809 rij_shift=1.0D0/rij_shift
1810 fac=rij_shift**expon
1811 e1=fac*fac*aa(itypi,itypj)
1812 e2=fac*bb(itypi,itypj)
1813 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1814 eps2der=evdwij*eps3rt
1815 eps3der=evdwij*eps2rt
1816 fac_augm=rrij**expon
1817 e_augm=augm(itypi,itypj)*fac_augm
1818 evdwij=evdwij*eps2rt*eps3rt
1820 if (bb(itypi,itypj).gt.0) then
1821 evdw_p=evdw_p+evdwij+e_augm
1823 evdw_m=evdw_m+evdwij+e_augm
1826 evdw=evdw+evdwij+e_augm
1829 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1830 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1831 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1832 & restyp(itypi),i,restyp(itypj),j,
1833 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1834 & chi1,chi2,chip1,chip2,
1835 & eps1,eps2rt**2,eps3rt**2,
1836 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1839 C Calculate gradient components.
1840 e1=e1*eps1*eps2rt**2*eps3rt**2
1841 fac=-expon*(e1+evdwij)*rij_shift
1843 fac=rij*fac-2*expon*rrij*e_augm
1844 C Calculate the radial part of the gradient
1848 C Calculate angular part of the gradient.
1850 if (bb(itypi,itypj).gt.0) then
1863 C-----------------------------------------------------------------------------
1866 SUBROUTINE emomo(evdw,evdw_p,evdw_m)
1868 C This subroutine calculates the interaction energy of nonbonded side chains
1869 C assuming the Gay-Berne potential of interaction.
1872 INCLUDE 'DIMENSIONS'
1873 INCLUDE 'COMMON.CALC'
1874 INCLUDE 'COMMON.CONTROL'
1875 INCLUDE 'COMMON.CHAIN'
1876 INCLUDE 'COMMON.DERIV'
1877 INCLUDE 'COMMON.EMP'
1878 INCLUDE 'COMMON.GEO'
1879 INCLUDE 'COMMON.INTERACT'
1880 INCLUDE 'COMMON.IOUNITS'
1881 INCLUDE 'COMMON.LOCAL'
1882 INCLUDE 'COMMON.NAMES'
1883 INCLUDE 'COMMON.VAR'
1885 double precision scalar
1886 double precision ener(4)
1889 IF (energy_dec) write (iout,'(a)')
1890 & ' AAi i AAj j 1/rij Rtail Rhead evdwij Fcav Ecl
1891 & Egb Epol Fisocav Elj Equad evdw'
1896 ccccc energy_dec=.false.
1897 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1899 c if (icall.eq.0) lprn=.false.
1902 DO i = iatsc_s, iatsc_e
1904 c itypi1 = itype(i+1)
1905 dxi = dc_norm(1,nres+i)
1906 dyi = dc_norm(2,nres+i)
1907 dzi = dc_norm(3,nres+i)
1908 c dsci_inv=dsc_inv(itypi)
1909 dsci_inv = vbld_inv(i+nres)
1911 c ctail(k,1) = c(k, i+nres)
1912 c & - dtail(1,itypi,itypj) * dc_norm(k, nres+i)
1917 c!-------------------------------------------------------------------
1918 C Calculate SC interaction energy.
1919 DO iint = 1, nint_gr(i)
1920 DO j = istart(i,iint), iend(i,iint)
1921 c! initialize variables for electrostatic gradients
1922 CALL elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
1924 c dscj_inv = dsc_inv(itypj)
1925 dscj_inv = vbld_inv(j+nres)
1926 c! rij holds 1/(distance of Calpha atoms)
1927 rrij = 1.0D0 / ( xj*xj + yj*yj + zj*zj)
1929 c!-------------------------------------------------------------------
1930 C Calculate angle-dependent terms of energy and contributions to their
1934 c! DO troll = 10, 5000
1938 c! sqom1 = om1 * om1
1939 c! sqom2 = om2 * om2
1940 c! sqom12 = om12 * om12
1941 c! rij = 5.0d0 / troll
1943 c! Rtail = troll / 5.0d0
1944 c! Rhead = troll / 5.0d0
1945 c! Rhead = dsqrt((Rtail**2)+((dabs(d1-d2))**2))
1946 c! Rtail = dsqrt((Rtail**2)
1947 c! & +((dabs(dtail(1,itypi,itypj)-dtail(2,itypi,itypj)))**2))
1948 c! rij = 1.0d0/Rtail
1952 c! this should be in elgrad_init but om's are calculated by sc_angular
1953 c! which in turn is used by older potentials
1954 c! which proves how tangled UNRES code is >.<
1955 c! om = omega, sqom = om^2
1958 sqom12 = om12 * om12
1960 c! now we calculate EGB - Gey-Berne
1961 c! It will be summed up in evdwij and saved in evdw
1962 sigsq = 1.0D0 / sigsq
1963 sig = sig0ij * dsqrt(sigsq)
1964 c! rij_shift = 1.0D0 / rij - sig + sig0ij
1965 rij_shift = Rtail - sig + sig0ij
1966 IF (rij_shift.le.0.0D0) THEN
1970 sigder = -sig * sigsq
1971 rij_shift = 1.0D0 / rij_shift
1972 fac = rij_shift**expon
1973 c1 = fac * fac * aa(itypi,itypj)
1975 c2 = fac * bb(itypi,itypj)
1977 evdwij = eps1 * eps2rt * eps3rt * ( c1 + c2 )
1978 eps2der = eps3rt * evdwij
1979 eps3der = eps2rt * evdwij
1980 c! evdwij = 4.0d0 * eps2rt * eps3rt * evdwij
1981 evdwij = eps2rt * eps3rt * evdwij
1983 c! write (*,*) "Gey Berne = ", evdwij
1985 IF (bb(itypi,itypj).gt.0) THEN
1986 evdw_p = evdw_p + evdwij
1988 evdw_m = evdw_m + evdwij
1994 c!-------------------------------------------------------------------
1995 c! Calculate some components of GGB
1996 c1 = c1 * eps1 * eps2rt**2 * eps3rt**2
1997 fac = -expon * (c1 + evdwij) * rij_shift
1998 sigder = fac * sigder
2000 c! Calculate distance derivative
2007 c! write (*,*) "gg(1) = ", gg(1)
2008 c! write (*,*) "gg(2) = ", gg(2)
2009 c! write (*,*) "gg(3) = ", gg(3)
2010 c! The angular derivatives of GGB are brought together in sc_grad
2011 c!-------------------------------------------------------------------
2014 c! Catch gly-gly interactions to skip calculation of something that
2017 IF (itypi.eq.10.and.itypj.eq.10) THEN
2025 c! we are not 2 glycines, so we calculate Fcav (and maybe more)
2026 fac = chis1 * sqom1 + chis2 * sqom2
2027 & - 2.0d0 * chis12 * om1 * om2 * om12
2028 c! we will use pom later in Gcav, so dont mess with it!
2029 pom = 1.0d0 - chis1 * chis2 * sqom12
2031 Lambf = (1.0d0 - (fac / pom))
2032 Lambf = dsqrt(Lambf)
2035 sparrow = 1.0d0 / dsqrt(sig1**2.0d0 + sig2**2.0d0)
2036 c! write (*,*) "sparrow = ", sparrow
2037 Chif = Rtail * sparrow
2038 ChiLambf = Chif * Lambf
2039 eagle = dsqrt(ChiLambf)
2040 bat = ChiLambf ** 11.0d0
2042 top = b1 * ( eagle + b2 * ChiLambf - b3 )
2043 bot = 1.0d0 + b4 * (ChiLambf ** 12.0d0)
2046 c! write (*,*) "sig1 = ",sig1
2047 c! write (*,*) "sig2 = ",sig2
2048 c! write (*,*) "Rtail = ",Rtail
2049 c! write (*,*) "sparrow = ",sparrow
2050 c! write (*,*) "Chis1 = ", chis1
2051 c! write (*,*) "Chis2 = ", chis2
2052 c! write (*,*) "Chis12 = ", chis12
2053 c! write (*,*) "om1 = ", om1
2054 c! write (*,*) "om2 = ", om2
2055 c! write (*,*) "om12 = ", om12
2056 c! write (*,*) "sqom1 = ", sqom1
2057 c! write (*,*) "sqom2 = ", sqom2
2058 c! write (*,*) "sqom12 = ", sqom12
2059 c! write (*,*) "Lambf = ",Lambf
2060 c! write (*,*) "b1 = ",b1
2061 c! write (*,*) "b2 = ",b2
2062 c! write (*,*) "b3 = ",b3
2063 c! write (*,*) "b4 = ",b4
2064 c! write (*,*) "top = ",top
2065 c! write (*,*) "bot = ",bot
2068 c! write (*,*) "Fcav = ", Fcav
2069 c!-------------------------------------------------------------------
2070 c! derivative of Fcav is Gcav...
2071 c!---------------------------------------------------
2073 dtop = b1 * ((Lambf / (2.0d0 * eagle)) + (b2 * Lambf))
2074 dbot = 12.0d0 * b4 * bat * Lambf
2075 dFdR = ((dtop * bot - top * dbot) / botsq) * sparrow
2077 c! write (*,*) "dFcav/dR = ", dFdR
2079 dtop = b1 * ((Chif / (2.0d0 * eagle)) + (b2 * Chif))
2080 dbot = 12.0d0 * b4 * bat * Chif
2082 dFdOM1 = -(chis1 * om1 - chis12 * om2 * om12) / (eagle)
2083 dFdOM2 = -(chis2 * om2 - chis12 * om1 * om12) / (eagle)
2084 dFdOM12 = chis12 * (chis1 * om1 * om12 - om2)
2085 & * (chis2 * om2 * om12 - om1) / (eagle * pom)
2087 dFdL = ((dtop * bot - top * dbot) / botsq)
2089 dCAVdOM1 = dFdL * ( dFdOM1 )
2090 dCAVdOM2 = dFdL * ( dFdOM2 )
2091 dCAVdOM12 = dFdL * ( dFdOM12 )
2092 c! write (*,*) "dFcav/dOM1 = ", dCAVdOM1
2093 c! write (*,*) "dFcav/dOM2 = ", dCAVdOM2
2094 c! write (*,*) "dFcav/dOM12 = ", dCAVdOM12
2096 c!-------------------------------------------------------------------
2097 c! Finally, add the distance derivatives of GB and Fcav to gvdwc
2098 c! Pom is used here to project the gradient vector into
2099 c! cartesian coordinates and at the same time contains
2100 c! dXhb/dXsc derivative (for charged amino acids
2101 c! location of hydrophobic centre of interaction is not
2102 c! the same as geometric centre of side chain, this
2103 c! derivative takes that into account)
2104 c! derivatives of omega angles will be added in sc_grad
2107 ertail(k) = Rtail_distance(k)/Rtail
2109 erdxi = scalar( ertail(1), dC_norm(1,i+nres) )
2110 erdxj = scalar( ertail(1), dC_norm(1,j+nres) )
2111 facd1 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
2112 facd2 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
2114 c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
2115 c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
2116 pom = ertail(k)-facd1*(ertail(k)-erdxi*dC_norm(k,i+nres))
2117 gvdwx(k,i) = gvdwx(k,i)
2118 & - (( dFdR + gg(k) ) * pom)
2119 c! & - ( dFdR * pom )
2120 pom = ertail(k)-facd2*(ertail(k)-erdxj*dC_norm(k,j+nres))
2121 gvdwx(k,j) = gvdwx(k,j)
2122 & + (( dFdR + gg(k) ) * pom)
2123 c! & + ( dFdR * pom )
2125 gvdwc(k,i) = gvdwc(k,i)
2126 & - (( dFdR + gg(k) ) * ertail(k))
2127 c! & - ( dFdR * ertail(k))
2129 gvdwc(k,j) = gvdwc(k,j)
2130 & + (( dFdR + gg(k) ) * ertail(k))
2131 c! & + ( dFdR * ertail(k))
2134 c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
2135 c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
2138 c!-------------------------------------------------------------------
2139 c! Compute head-head and head-tail energies for each state
2141 isel = iabs(Qi) + iabs(Qj)
2143 c! No charges - do nothing
2146 ELSE IF (isel.eq.4) THEN
2147 c! Calculate dipole-dipole interactions
2151 ELSE IF (isel.eq.1 .and. iabs(Qi).eq.1) THEN
2152 c! Charge-nonpolar interactions
2156 ELSE IF (isel.eq.1 .and. iabs(Qj).eq.1) THEN
2157 c! Nonpolar-charge interactions
2161 ELSE IF (isel.eq.3 .and. icharge(itypj).eq.2) THEN
2162 c! Charge-dipole interactions
2163 CALL eqd(ecl, elj, epol)
2164 eheadtail = ECL + elj + epol
2166 ELSE IF (isel.eq.3 .and. icharge(itypi).eq.2) THEN
2167 c! Dipole-charge interactions
2168 CALL edq(ecl, elj, epol)
2169 eheadtail = ECL + elj + epol
2171 ELSE IF ((isel.eq.2.and.
2172 & iabs(Qi).eq.1).and.
2173 & nstate(itypi,itypj).eq.1) THEN
2174 c! Same charge-charge interaction ( +/+ or -/- )
2175 CALL eqq(Ecl,Egb,Epol,Fisocav,Elj)
2176 eheadtail = ECL + Egb + Epol + Fisocav + Elj
2178 ELSE IF ((isel.eq.2.and.
2179 & iabs(Qi).eq.1).and.
2180 & nstate(itypi,itypj).ne.1) THEN
2181 c! Different charge-charge interaction ( +/- or -/+ )
2183 & (istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
2185 END IF ! this endif ends the "catch the gly-gly" at the beggining of Fcav
2186 c! write (*,*) "evdw = ", evdw
2187 c! write (*,*) "Fcav = ", Fcav
2188 c! write (*,*) "eheadtail = ", eheadtail
2193 IF (energy_dec) write (iout,'(2(1x,a3,i3),3f6.2,9f16.7)')
2194 & restyp(itype(i)),i,restyp(itype(j)),j,
2195 & 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,
2197 IF (energy_dec) write (*,'(2(1x,a3,i3),3f6.2,9f16.7)')
2198 & restyp(itype(i)),i,restyp(itype(j)),j,
2199 & 1.0d0/rij,Rtail,Rhead,evdwij,Fcav,Ecl,Egb,Epol,Fisocav,Elj,
2206 c!-------------------------------------------------------------------
2207 c! As all angular derivatives are done, now we sum them up,
2208 c! then transform and project into cartesian vectors and add to gvdwc
2209 c! We call sc_grad always, with the exception of +/- interaction.
2210 c! This is because energy_quad subroutine needs to handle
2211 c! this job in his own way.
2212 c! This IS probably not very efficient and SHOULD be optimised
2213 c! but it will require major restructurization of emomo
2214 c! so it will be left as it is for now
2215 c! write (*,*) 'troll1, nstate =', nstate (itypi,itypj)
2216 IF (nstate(itypi,itypj).eq.1) THEN
2218 IF (bb(itypi,itypj).gt.0) THEN
2227 c!-------------------------------------------------------------------
2232 c write (iout,*) "Number of loop steps in EGB:",ind
2233 c energy_dec=.false.
2235 END SUBROUTINE emomo
2239 C-----------------------------------------------------------------------------
2242 SUBROUTINE eqq(Ecl,Egb,Epol,Fisocav,Elj)
2244 INCLUDE 'DIMENSIONS'
2245 INCLUDE 'COMMON.CALC'
2246 INCLUDE 'COMMON.CHAIN'
2247 INCLUDE 'COMMON.CONTROL'
2248 INCLUDE 'COMMON.DERIV'
2249 INCLUDE 'COMMON.EMP'
2250 INCLUDE 'COMMON.GEO'
2251 INCLUDE 'COMMON.INTERACT'
2252 INCLUDE 'COMMON.IOUNITS'
2253 INCLUDE 'COMMON.LOCAL'
2254 INCLUDE 'COMMON.NAMES'
2255 INCLUDE 'COMMON.VAR'
2256 double precision scalar, facd3, facd4, federmaus, adler
2257 c! Epol and Gpol analytical parameters
2258 alphapol1 = alphapol(itypi,itypj)
2259 alphapol2 = alphapol(itypj,itypi)
2260 c! Fisocav and Gisocav analytical parameters
2261 al1 = alphiso(1,itypi,itypj)
2262 al2 = alphiso(2,itypi,itypj)
2263 al3 = alphiso(3,itypi,itypj)
2264 al4 = alphiso(4,itypi,itypj)
2266 & / dsqrt(sigiso1(itypi, itypj)**2.0d0
2267 & + sigiso2(itypi,itypj)**2.0d0))
2269 pis = sig0head(itypi,itypj)
2270 eps_head = epshead(itypi,itypj)
2271 Rhead_sq = Rhead * Rhead
2272 c! R1 - distance between head of ith side chain and tail of jth sidechain
2273 c! R2 - distance between head of jth side chain and tail of ith sidechain
2277 c! Calculate head-to-tail distances needed by Epol
2278 R1=R1+(ctail(k,2)-chead(k,1))**2
2279 R2=R2+(chead(k,2)-ctail(k,1))**2
2285 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
2286 c! & +dhead(1,1,itypi,itypj))**2))
2287 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
2288 c! & +dhead(2,1,itypi,itypj))**2))
2290 c!-------------------------------------------------------------------
2291 c! Coulomb electrostatic interaction
2292 Ecl = (332.0d0 * Qij) / Rhead
2293 c! derivative of Ecl is Gcl...
2294 dGCLdR = (-332.0d0 * Qij ) / Rhead_sq
2298 c!-------------------------------------------------------------------
2299 c! Generalised Born Solvent Polarization
2300 c! Charged head polarizes the solvent
2301 ee = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
2302 Fgb = sqrt( ( Rhead_sq ) + a12sq * ee)
2303 Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb
2304 c! Derivative of Egb is Ggb...
2305 dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb)
2306 dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee) ) )
2308 dGGBdR = dGGBdFGB * dFGBdR
2309 c!-------------------------------------------------------------------
2310 c! Fisocav - isotropic cavity creation term
2311 c! or "how much energy it costs to put charged head in water"
2313 top = al1 * (dsqrt(pom) + al2 * pom - al3)
2314 bot = (1.0d0 + al4 * pom**12.0d0)
2317 c! write (*,*) "Rhead = ",Rhead
2318 c! write (*,*) "csig = ",csig
2319 c! write (*,*) "pom = ",pom
2320 c! write (*,*) "al1 = ",al1
2321 c! write (*,*) "al2 = ",al2
2322 c! write (*,*) "al3 = ",al3
2323 c! write (*,*) "al4 = ",al4
2324 c! write (*,*) "top = ",top
2325 c! write (*,*) "bot = ",bot
2326 c! Derivative of Fisocav is GCV...
2327 dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
2328 dbot = 12.0d0 * al4 * pom ** 11.0d0
2329 dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
2330 c!-------------------------------------------------------------------
2332 c! Polarization energy - charged heads polarize hydrophobic "neck"
2333 MomoFac1 = (1.0d0 - chi1 * sqom2)
2334 MomoFac2 = (1.0d0 - chi2 * sqom1)
2335 RR1 = ( R1 * R1 ) / MomoFac1
2336 RR2 = ( R2 * R2 ) / MomoFac2
2337 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
2338 ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
2339 fgb1 = sqrt( RR1 + a12sq * ee1 )
2340 fgb2 = sqrt( RR2 + a12sq * ee2 )
2341 epol = 332.0d0 * eps_inout_fac * (
2342 & (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
2344 c write (*,*) "eps_inout_fac = ",eps_inout_fac
2345 c write (*,*) "alphapol1 = ", alphapol1
2346 c write (*,*) "alphapol2 = ", alphapol2
2347 c write (*,*) "fgb1 = ", fgb1
2348 c write (*,*) "fgb2 = ", fgb2
2349 c write (*,*) "epol = ", epol
2350 c! derivative of Epol is Gpol...
2351 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
2353 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
2355 dFGBdR1 = ( (R1 / MomoFac1)
2356 & * ( 2.0d0 - (0.5d0 * ee1) ) )
2357 & / ( 2.0d0 * fgb1 )
2358 dFGBdR2 = ( (R2 / MomoFac2)
2359 & * ( 2.0d0 - (0.5d0 * ee2) ) )
2360 & / ( 2.0d0 * fgb2 )
2361 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
2362 & * ( 2.0d0 - 0.5d0 * ee1) )
2363 & / ( 2.0d0 * fgb1 )
2364 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
2365 & * ( 2.0d0 - 0.5d0 * ee2) )
2366 & / ( 2.0d0 * fgb2 )
2367 dPOLdR1 = dPOLdFGB1 * dFGBdR1
2369 dPOLdR2 = dPOLdFGB2 * dFGBdR2
2371 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
2373 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
2375 c!-------------------------------------------------------------------
2377 c! Lennard-Jones 6-12 interaction between heads
2378 pom = (pis / Rhead)**6.0d0
2379 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
2380 c! derivative of Elj is Glj
2381 dGLJdR = 4.0d0 * eps_head
2382 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
2383 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
2384 c!-------------------------------------------------------------------
2385 c! Return the results
2386 c! These things do the dRdX derivatives, that is
2387 c! allow us to change what we see from function that changes with
2388 c! distance to function that changes with LOCATION (of the interaction
2391 erhead(k) = Rhead_distance(k)/Rhead
2392 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
2393 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
2396 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
2397 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
2398 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
2399 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
2400 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
2401 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
2402 facd1 = d1 * vbld_inv(i+nres)
2403 facd2 = d2 * vbld_inv(j+nres)
2404 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
2405 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
2407 c! Now we add appropriate partial derivatives (one in each dimension)
2409 hawk = (erhead_tail(k,1) +
2410 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
2411 condor = (erhead_tail(k,2) +
2412 & facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
2414 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
2415 gvdwx(k,i) = gvdwx(k,i)
2420 & - dPOLdR2 * (erhead_tail(k,2)
2421 & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
2424 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
2425 gvdwx(k,j) = gvdwx(k,j)
2429 & + dPOLdR1 * (erhead_tail(k,1)
2430 & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
2431 & + dPOLdR2 * condor
2434 gvdwc(k,i) = gvdwc(k,i)
2435 & - dGCLdR * erhead(k)
2436 & - dGGBdR * erhead(k)
2437 & - dGCVdR * erhead(k)
2438 & - dPOLdR1 * erhead_tail(k,1)
2439 & - dPOLdR2 * erhead_tail(k,2)
2440 & - dGLJdR * erhead(k)
2442 gvdwc(k,j) = gvdwc(k,j)
2443 & + dGCLdR * erhead(k)
2444 & + dGGBdR * erhead(k)
2445 & + dGCVdR * erhead(k)
2446 & + dPOLdR1 * erhead_tail(k,1)
2447 & + dPOLdR2 * erhead_tail(k,2)
2448 & + dGLJdR * erhead(k)
2453 c!-------------------------------------------------------------------
2454 SUBROUTINE energy_quad
2455 &(istate,eheadtail,Ecl,Egb,Epol,Fisocav,Elj,Equad)
2457 INCLUDE 'DIMENSIONS'
2458 INCLUDE 'COMMON.CALC'
2459 INCLUDE 'COMMON.CHAIN'
2460 INCLUDE 'COMMON.CONTROL'
2461 INCLUDE 'COMMON.DERIV'
2462 INCLUDE 'COMMON.EMP'
2463 INCLUDE 'COMMON.GEO'
2464 INCLUDE 'COMMON.INTERACT'
2465 INCLUDE 'COMMON.IOUNITS'
2466 INCLUDE 'COMMON.LOCAL'
2467 INCLUDE 'COMMON.NAMES'
2468 INCLUDE 'COMMON.VAR'
2469 double precision scalar
2470 double precision ener(4)
2471 double precision dcosom1(3),dcosom2(3)
2472 c! used in Epol derivatives
2473 double precision facd3, facd4
2474 double precision federmaus, adler
2475 c! Epol and Gpol analytical parameters
2476 alphapol1 = alphapol(itypi,itypj)
2477 alphapol2 = alphapol(itypj,itypi)
2478 c! Fisocav and Gisocav analytical parameters
2479 al1 = alphiso(1,itypi,itypj)
2480 al2 = alphiso(2,itypi,itypj)
2481 al3 = alphiso(3,itypi,itypj)
2482 al4 = alphiso(4,itypi,itypj)
2484 & / dsqrt(sigiso1(itypi, itypj)**2.0d0
2485 & + sigiso2(itypi,itypj)**2.0d0))
2487 w1 = wqdip(1,itypi,itypj)
2488 w2 = wqdip(2,itypi,itypj)
2489 pis = sig0head(itypi,itypj)
2490 eps_head = epshead(itypi,itypj)
2491 c! First things first:
2492 c! We need to do sc_grad's job with GB and Fcav
2494 & eps2der * eps2rt_om1
2495 & - 2.0D0 * alf1 * eps3der
2496 & + sigder * sigsq_om1
2499 & eps2der * eps2rt_om2
2500 & + 2.0D0 * alf2 * eps3der
2501 & + sigder * sigsq_om2
2504 & evdwij * eps1_om12
2505 & + eps2der * eps2rt_om12
2506 & - 2.0D0 * alf12 * eps3der
2507 & + sigder *sigsq_om12
2509 c! now some magical transformations to project gradient into
2510 c! three cartesian vectors
2512 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
2513 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
2514 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
2515 c! this acts on hydrophobic center of interaction
2516 gvdwx(k,i)= gvdwx(k,i) - gg(k)
2517 & + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2518 & + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2519 gvdwx(k,j)= gvdwx(k,j) + gg(k)
2520 & + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2521 & + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2522 c! this acts on Calpha
2523 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2524 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2526 c! sc_grad is done, now we will compute
2535 c! d1 = dhead(1, 1, itypi, itypj)
2536 c! d2 = dhead(2, 1, itypi, itypj)
2537 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
2538 c! & +dhead(1,ii,itypi,itypj))**2))
2539 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
2540 c! & +dhead(2,jj,itypi,itypj))**2))
2541 c! Rhead = dsqrt((Rtail**2)+((dabs(d1-d2))**2))
2542 c! END OF ENERGY DEBUG
2543 c*************************************************************
2544 DO istate = 1, nstate(itypi,itypj)
2545 c*************************************************************
2546 IF (istate.ne.1) THEN
2547 IF (istate.lt.3) THEN
2553 d1 = dhead(1,ii,itypi,itypj)
2554 d2 = dhead(2,jj,itypi,itypj)
2556 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
2557 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
2558 Rhead_distance(k) = chead(k,2) - chead(k,1)
2560 c! pitagoras (root of sum of squares)
2562 & (Rhead_distance(1)*Rhead_distance(1))
2563 & + (Rhead_distance(2)*Rhead_distance(2))
2564 & + (Rhead_distance(3)*Rhead_distance(3)))
2566 Rhead_sq = Rhead * Rhead
2568 c! R1 - distance between head of ith side chain and tail of jth sidechain
2569 c! R2 - distance between head of jth side chain and tail of ith sidechain
2573 c! Calculate head-to-tail distances
2574 R1=R1+(ctail(k,2)-chead(k,1))**2
2575 R2=R2+(chead(k,2)-ctail(k,1))**2
2582 c! write (*,*) "istate = ", istate
2583 c! write (*,*) "ii = ", ii
2584 c! write (*,*) "jj = ", jj
2585 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
2586 c! & +dhead(1,ii,itypi,itypj))**2))
2587 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
2588 c! & +dhead(2,jj,itypi,itypj))**2))
2589 c! Rhead = dsqrt((Rtail**2)+((dabs(d1-d2))**2))
2590 c! Rhead_sq = Rhead * Rhead
2591 c! write (*,*) "d1 = ",d1
2592 c! write (*,*) "d2 = ",d2
2593 c! write (*,*) "R1 = ",R1
2594 c! write (*,*) "R2 = ",R2
2595 c! write (*,*) "Rhead = ",Rhead
2596 c! END OF ENERGY DEBUG
2598 c!-------------------------------------------------------------------
2599 c! Coulomb electrostatic interaction
2600 Ecl = (332.0d0 * Qij) / (Rhead * eps_in)
2602 c! write (*,*) "Ecl = ", Ecl
2603 c! derivative of Ecl is Gcl...
2604 dGCLdR = (-332.0d0 * Qij ) / (Rhead_sq * eps_in)
2609 c!-------------------------------------------------------------------
2610 c! Generalised Born Solvent Polarization
2611 ee = dexp(-( Rhead_sq ) / (4.0d0 * a12sq))
2612 Fgb = sqrt( ( Rhead_sq ) + a12sq * ee)
2613 Egb = -(332.0d0 * Qij * eps_inout_fac) / Fgb
2615 c! write (*,*) "a1*a2 = ", a12sq
2616 c! write (*,*) "Rhead = ", Rhead
2617 c! write (*,*) "Rhead_sq = ", Rhead_sq
2618 c! write (*,*) "ee = ", ee
2619 c! write (*,*) "Fgb = ", Fgb
2620 c! write (*,*) "fac = ", eps_inout_fac
2621 c! write (*,*) "Qij = ", Qij
2622 c! write (*,*) "Egb = ", Egb
2623 c! Derivative of Egb is Ggb...
2624 c! dFGBdR is used by Quad's later...
2625 dGGBdFGB = -(-332.0d0 * Qij * eps_inout_fac) / (Fgb * Fgb)
2626 dFGBdR = ( Rhead * ( 2.0d0 - (0.5d0 * ee) ) )
2628 dGGBdR = dGGBdFGB * dFGBdR
2630 c!-------------------------------------------------------------------
2631 c! Fisocav - isotropic cavity creation term
2633 top = al1 * (dsqrt(pom) + al2 * pom - al3)
2634 bot = (1.0d0 + al4 * pom**12.0d0)
2638 c! write (*,*) "pom = ",pom
2639 c! write (*,*) "al1 = ",al1
2640 c! write (*,*) "al2 = ",al2
2641 c! write (*,*) "al3 = ",al3
2642 c! write (*,*) "al4 = ",al4
2643 c! write (*,*) "top = ",top
2644 c! write (*,*) "bot = ",bot
2645 c! write (*,*) "Fisocav = ", Fisocav
2647 c! Derivative of Fisocav is GCV...
2648 dtop = al1 * ((1.0d0 / (2.0d0 * dsqrt(pom))) + al2)
2649 dbot = 12.0d0 * al4 * pom ** 11.0d0
2650 dGCVdR = ((dtop * bot - top * dbot) / botsq) * csig
2652 c!-------------------------------------------------------------------
2653 c! Polarization energy
2655 MomoFac1 = (1.0d0 - chi1 * sqom2)
2656 MomoFac2 = (1.0d0 - chi2 * sqom1)
2657 RR1 = ( R1 * R1 ) / MomoFac1
2658 RR2 = ( R2 * R2 ) / MomoFac2
2659 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
2660 ee2 = exp(-( RR2 / (4.0d0 * a12sq) ))
2661 fgb1 = sqrt( RR1 + a12sq * ee1 )
2662 fgb2 = sqrt( RR2 + a12sq * ee2 )
2663 epol = 332.0d0 * eps_inout_fac * (
2664 & (( alphapol1 / fgb1 )**4.0d0)+((alphapol2/fgb2) ** 4.0d0 ))
2666 c! derivative of Epol is Gpol...
2667 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
2669 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
2671 dFGBdR1 = ( (R1 / MomoFac1)
2672 & * ( 2.0d0 - (0.5d0 * ee1) ) )
2673 & / ( 2.0d0 * fgb1 )
2674 dFGBdR2 = ( (R2 / MomoFac2)
2675 & * ( 2.0d0 - (0.5d0 * ee2) ) )
2676 & / ( 2.0d0 * fgb2 )
2677 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
2678 & * ( 2.0d0 - 0.5d0 * ee1) )
2679 & / ( 2.0d0 * fgb1 )
2680 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
2681 & * ( 2.0d0 - 0.5d0 * ee2) )
2682 & / ( 2.0d0 * fgb2 )
2683 dPOLdR1 = dPOLdFGB1 * dFGBdR1
2685 dPOLdR2 = dPOLdFGB2 * dFGBdR2
2687 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
2689 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
2691 c!-------------------------------------------------------------------
2693 pom = (pis / Rhead)**6.0d0
2694 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
2696 c! derivative of Elj is Glj
2697 dGLJdR = 4.0d0 * eps_head
2698 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
2699 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
2701 c!-------------------------------------------------------------------
2703 IF (Wqd.ne.0.0d0) THEN
2704 Beta1 = 5.0d0 + 3.0d0 * (sqom12 - 1.0d0)
2705 & - 37.5d0 * ( sqom1 + sqom2 )
2706 & + 157.5d0 * ( sqom1 * sqom2 )
2707 & - 45.0d0 * om1*om2*om12
2708 fac = -( Wqd / (2.0d0 * Fgb**5.0d0) )
2711 c! derivative of Equad...
2712 dQUADdR = ((2.5d0 * Wqd * Beta1) / (Fgb**6.0d0)) * dFGBdR
2715 & * (-75.0d0*om1 + 315.0d0*om1*sqom2 - 45.0d0*om2*om12)
2716 c! dQUADdOM1 = 0.0d0
2718 & * (-75.0d0*om2 + 315.0d0*sqom1*om2 - 45.0d0*om1*om12)
2719 c! dQUADdOM2 = 0.0d0
2721 & * ( 6.0d0*om12 - 45.0d0*om1*om2 )
2722 c! dQUADdOM12 = 0.0d0
2727 c!-------------------------------------------------------------------
2728 c! Return the results
2730 eom1 = dPOLdOM1 + dQUADdOM1
2731 eom2 = dPOLdOM2 + dQUADdOM2
2733 c! now some magical transformations to project gradient into
2734 c! three cartesian vectors
2736 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
2737 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
2738 tuna(k) = eom1 * dcosom1(k) + eom2 * dcosom2(k)
2742 erhead(k) = Rhead_distance(k)/Rhead
2743 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
2744 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
2746 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
2747 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
2748 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
2749 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
2750 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
2751 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
2752 facd1 = d1 * vbld_inv(i+nres)
2753 facd2 = d2 * vbld_inv(j+nres)
2754 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
2755 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
2756 c! Throw the results into gheadtail which holds gradients
2757 c! for each micro-state
2759 hawk = erhead_tail(k,1) +
2760 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres))
2761 condor = erhead_tail(k,2) +
2762 & facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres))
2764 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
2765 c! this acts on hydrophobic center of interaction
2766 gheadtail(k,1,1) = gheadtail(k,1,1)
2771 & - dPOLdR2 * (erhead_tail(k,2)
2772 & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
2776 & + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2777 & + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2779 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
2780 c! this acts on hydrophobic center of interaction
2781 gheadtail(k,2,1) = gheadtail(k,2,1)
2785 & + dPOLdR1 * (erhead_tail(k,1)
2786 & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
2787 & + dPOLdR2 * condor
2791 & + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2792 & + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2794 c! this acts on Calpha
2795 gheadtail(k,3,1) = gheadtail(k,3,1)
2796 & - dGCLdR * erhead(k)
2797 & - dGGBdR * erhead(k)
2798 & - dGCVdR * erhead(k)
2799 & - dPOLdR1 * erhead_tail(k,1)
2800 & - dPOLdR2 * erhead_tail(k,2)
2801 & - dGLJdR * erhead(k)
2802 & - dQUADdR * erhead(k)
2805 c! this acts on Calpha
2806 gheadtail(k,4,1) = gheadtail(k,4,1)
2807 & + dGCLdR * erhead(k)
2808 & + dGGBdR * erhead(k)
2809 & + dGCVdR * erhead(k)
2810 & + dPOLdR1 * erhead_tail(k,1)
2811 & + dPOLdR2 * erhead_tail(k,2)
2812 & + dGLJdR * erhead(k)
2813 & + dQUADdR * erhead(k)
2816 c! write(*,*) "ECL = ", Ecl
2817 c! write(*,*) "Egb = ", Egb
2818 c! write(*,*) "Epol = ", Epol
2819 c! write(*,*) "Fisocav = ", Fisocav
2820 c! write(*,*) "Elj = ", Elj
2821 c! write(*,*) "Equad = ", Equad
2822 c! write(*,*) "wstate = ", wstate(istate,itypi,itypj)
2823 c! write(*,*) "eheadtail = ", eheadtail
2824 c! write(*,*) "TROLL = ", dexp(-betaT * ener(istate))
2825 c! write(*,*) "dGCLdR = ", dGCLdR
2826 c! write(*,*) "dGGBdR = ", dGGBdR
2827 c! write(*,*) "dGCVdR = ", dGCVdR
2828 c! write(*,*) "dPOLdR1 = ", dPOLdR1
2829 c! write(*,*) "dPOLdR2 = ", dPOLdR2
2830 c! write(*,*) "dGLJdR = ", dGLJdR
2831 c! write(*,*) "dQUADdR = ", dQUADdR
2832 c! write(*,*) "tuna(",k,") = ", tuna(k)
2833 ener(istate) = ECL + Egb + Epol + Fisocav + Elj + Equad
2834 eheadtail = eheadtail
2835 & + wstate(istate, itypi, itypj)
2836 & * dexp(-betaT * ener(istate))
2837 c! foreach cartesian dimension
2839 c! foreach of two gvdwx and gvdwc
2841 gheadtail(k,l,2) = gheadtail(k,l,2)
2842 & + wstate( istate, itypi, itypj )
2843 & * dexp(-betaT * ener(istate))
2844 & * gheadtail(k,l,1)
2845 gheadtail(k,l,1) = 0.0d0
2849 c! Here ended the gigantic DO istate = 1, 4, which starts
2850 c! at the beggining of the subroutine
2854 gheadtail(k,l,2) = gheadtail(k,l,2) / eheadtail
2856 gvdwx(k,i) = gvdwx(k,i) + gheadtail(k,1,2)
2857 gvdwx(k,j) = gvdwx(k,j) + gheadtail(k,2,2)
2858 gvdwc(k,i) = gvdwc(k,i) + gheadtail(k,3,2)
2859 gvdwc(k,j) = gvdwc(k,j) + gheadtail(k,4,2)
2861 gheadtail(k,l,1) = 0.0d0
2862 gheadtail(k,l,2) = 0.0d0
2865 eheadtail = (-dlog(eheadtail)) / betaT
2872 END SUBROUTINE energy_quad
2875 c!-------------------------------------------------------------------
2878 SUBROUTINE eqn(Epol)
2880 INCLUDE 'DIMENSIONS'
2881 INCLUDE 'COMMON.CALC'
2882 INCLUDE 'COMMON.CHAIN'
2883 INCLUDE 'COMMON.CONTROL'
2884 INCLUDE 'COMMON.DERIV'
2885 INCLUDE 'COMMON.EMP'
2886 INCLUDE 'COMMON.GEO'
2887 INCLUDE 'COMMON.INTERACT'
2888 INCLUDE 'COMMON.IOUNITS'
2889 INCLUDE 'COMMON.LOCAL'
2890 INCLUDE 'COMMON.NAMES'
2891 INCLUDE 'COMMON.VAR'
2892 double precision scalar, facd4, federmaus
2893 alphapol1 = alphapol(itypi,itypj)
2894 c! R1 - distance between head of ith side chain and tail of jth sidechain
2897 c! Calculate head-to-tail distances
2898 R1=R1+(ctail(k,2)-chead(k,1))**2
2903 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
2904 c! & +dhead(1,1,itypi,itypj))**2))
2905 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
2906 c! & +dhead(2,1,itypi,itypj))**2))
2907 c--------------------------------------------------------------------
2908 c Polarization energy
2910 MomoFac1 = (1.0d0 - chi1 * sqom2)
2911 RR1 = R1 * R1 / MomoFac1
2912 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
2913 fgb1 = sqrt( RR1 + a12sq * ee1)
2914 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
2916 c!------------------------------------------------------------------
2917 c! derivative of Epol is Gpol...
2918 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
2920 dFGBdR1 = ( (R1 / MomoFac1)
2921 & * ( 2.0d0 - (0.5d0 * ee1) ) )
2922 & / ( 2.0d0 * fgb1 )
2923 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
2924 & * (2.0d0 - 0.5d0 * ee1) )
2926 dPOLdR1 = dPOLdFGB1 * dFGBdR1
2929 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
2931 c!-------------------------------------------------------------------
2932 c! Return the results
2933 c! (see comments in Eqq)
2935 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
2937 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
2938 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
2939 facd1 = d1 * vbld_inv(i+nres)
2940 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
2943 hawk = (erhead_tail(k,1) +
2944 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
2946 gvdwx(k,i) = gvdwx(k,i)
2948 gvdwx(k,j) = gvdwx(k,j)
2949 & + dPOLdR1 * (erhead_tail(k,1)
2950 & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
2952 gvdwc(k,i) = gvdwc(k,i)
2953 & - dPOLdR1 * erhead_tail(k,1)
2954 gvdwc(k,j) = gvdwc(k,j)
2955 & + dPOLdR1 * erhead_tail(k,1)
2962 c!-------------------------------------------------------------------
2966 SUBROUTINE enq(Epol)
2968 INCLUDE 'DIMENSIONS'
2969 INCLUDE 'COMMON.CALC'
2970 INCLUDE 'COMMON.CHAIN'
2971 INCLUDE 'COMMON.CONTROL'
2972 INCLUDE 'COMMON.DERIV'
2973 INCLUDE 'COMMON.EMP'
2974 INCLUDE 'COMMON.GEO'
2975 INCLUDE 'COMMON.INTERACT'
2976 INCLUDE 'COMMON.IOUNITS'
2977 INCLUDE 'COMMON.LOCAL'
2978 INCLUDE 'COMMON.NAMES'
2979 INCLUDE 'COMMON.VAR'
2980 double precision scalar, facd3, adler
2981 alphapol2 = alphapol(itypj,itypi)
2982 c! R2 - distance between head of jth side chain and tail of ith sidechain
2985 c! Calculate head-to-tail distances
2986 R2=R2+(chead(k,2)-ctail(k,1))**2
2991 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
2992 c! & +dhead(1,1,itypi,itypj))**2))
2993 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
2994 c! & +dhead(2,1,itypi,itypj))**2))
2995 c------------------------------------------------------------------------
2996 c Polarization energy
2997 MomoFac2 = (1.0d0 - chi2 * sqom1)
2998 RR2 = R2 * R2 / MomoFac2
2999 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
3000 fgb2 = sqrt(RR2 + a12sq * ee2)
3001 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
3003 c!-------------------------------------------------------------------
3004 c! derivative of Epol is Gpol...
3005 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
3007 dFGBdR2 = ( (R2 / MomoFac2)
3008 & * ( 2.0d0 - (0.5d0 * ee2) ) )
3010 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
3011 & * (2.0d0 - 0.5d0 * ee2) )
3013 dPOLdR2 = dPOLdFGB2 * dFGBdR2
3015 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
3018 c!-------------------------------------------------------------------
3019 c! Return the results
3020 c! (See comments in Eqq)
3022 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
3024 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
3025 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
3026 facd2 = d2 * vbld_inv(j+nres)
3027 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
3029 condor = (erhead_tail(k,2)
3030 & + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
3032 gvdwx(k,i) = gvdwx(k,i)
3033 & - dPOLdR2 * (erhead_tail(k,2)
3034 & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
3035 gvdwx(k,j) = gvdwx(k,j)
3036 & + dPOLdR2 * condor
3038 gvdwc(k,i) = gvdwc(k,i)
3039 & - dPOLdR2 * erhead_tail(k,2)
3040 gvdwc(k,j) = gvdwc(k,j)
3041 & + dPOLdR2 * erhead_tail(k,2)
3048 c!-------------------------------------------------------------------
3051 SUBROUTINE eqd(Ecl,Elj,Epol)
3053 INCLUDE 'DIMENSIONS'
3054 INCLUDE 'COMMON.CALC'
3055 INCLUDE 'COMMON.CHAIN'
3056 INCLUDE 'COMMON.CONTROL'
3057 INCLUDE 'COMMON.DERIV'
3058 INCLUDE 'COMMON.EMP'
3059 INCLUDE 'COMMON.GEO'
3060 INCLUDE 'COMMON.INTERACT'
3061 INCLUDE 'COMMON.IOUNITS'
3062 INCLUDE 'COMMON.LOCAL'
3063 INCLUDE 'COMMON.NAMES'
3064 INCLUDE 'COMMON.VAR'
3065 double precision scalar, facd4, federmaus
3066 alphapol1 = alphapol(itypi,itypj)
3067 w1 = wqdip(1,itypi,itypj)
3068 w2 = wqdip(2,itypi,itypj)
3069 pis = sig0head(itypi,itypj)
3070 eps_head = epshead(itypi,itypj)
3071 c!-------------------------------------------------------------------
3072 c! R1 - distance between head of ith side chain and tail of jth sidechain
3075 c! Calculate head-to-tail distances
3076 R1=R1+(ctail(k,2)-chead(k,1))**2
3081 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
3082 c! & +dhead(1,1,itypi,itypj))**2))
3083 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
3084 c! & +dhead(2,1,itypi,itypj))**2))
3086 c!-------------------------------------------------------------------
3088 sparrow = w1 * Qi * om1
3089 hawk = w2 * Qi * Qi * (1.0d0 - sqom2)
3090 Ecl = sparrow / Rhead**2.0d0
3091 & - hawk / Rhead**4.0d0
3092 c!-------------------------------------------------------------------
3093 c! derivative of ecl is Gcl
3095 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0
3096 & + 4.0d0 * hawk / Rhead**5.0d0
3098 dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0)
3100 dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0)
3101 c--------------------------------------------------------------------
3102 c Polarization energy
3104 MomoFac1 = (1.0d0 - chi1 * sqom2)
3105 RR1 = R1 * R1 / MomoFac1
3106 ee1 = exp(-( RR1 / (4.0d0 * a12sq) ))
3107 fgb1 = sqrt( RR1 + a12sq * ee1)
3108 epol = 332.0d0 * eps_inout_fac * (( alphapol1 / fgb1 )**4.0d0)
3110 c!------------------------------------------------------------------
3111 c! derivative of Epol is Gpol...
3112 dPOLdFGB1 = -(1328.0d0 * eps_inout_fac * alphapol1 ** 4.0d0)
3114 dFGBdR1 = ( (R1 / MomoFac1)
3115 & * ( 2.0d0 - (0.5d0 * ee1) ) )
3116 & / ( 2.0d0 * fgb1 )
3117 dFGBdOM2 = (((R1 * R1 * chi1 * om2) / (MomoFac1 * MomoFac1))
3118 & * (2.0d0 - 0.5d0 * ee1) )
3120 dPOLdR1 = dPOLdFGB1 * dFGBdR1
3123 dPOLdOM2 = dPOLdFGB1 * dFGBdOM2
3125 c!-------------------------------------------------------------------
3127 pom = (pis / Rhead)**6.0d0
3128 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
3129 c! derivative of Elj is Glj
3130 dGLJdR = 4.0d0 * eps_head
3131 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
3132 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
3133 c!-------------------------------------------------------------------
3134 c! Return the results
3136 erhead(k) = Rhead_distance(k)/Rhead
3137 erhead_tail(k,1) = ((ctail(k,2)-chead(k,1))/R1)
3140 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
3141 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
3142 bat = scalar( erhead_tail(1,1), dC_norm(1,i+nres) )
3143 federmaus = scalar(erhead_tail(1,1),dC_norm(1,j+nres))
3144 facd1 = d1 * vbld_inv(i+nres)
3145 facd2 = d2 * vbld_inv(j+nres)
3146 facd4 = dtail(2,itypi,itypj) * vbld_inv(j+nres)
3149 hawk = (erhead_tail(k,1) +
3150 & facd1 * (erhead_tail(k,1) - bat * dC_norm(k,i+nres)))
3152 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
3153 gvdwx(k,i) = gvdwx(k,i)
3158 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
3159 gvdwx(k,j) = gvdwx(k,j)
3161 & + dPOLdR1 * (erhead_tail(k,1)
3162 & -facd4 * (erhead_tail(k,1) - federmaus * dC_norm(k,j+nres)))
3166 gvdwc(k,i) = gvdwc(k,i)
3167 & - dGCLdR * erhead(k)
3168 & - dPOLdR1 * erhead_tail(k,1)
3169 & - dGLJdR * erhead(k)
3171 gvdwc(k,j) = gvdwc(k,j)
3172 & + dGCLdR * erhead(k)
3173 & + dPOLdR1 * erhead_tail(k,1)
3174 & + dGLJdR * erhead(k)
3181 c!-------------------------------------------------------------------
3184 SUBROUTINE edq(Ecl,Elj,Epol)
3186 INCLUDE 'DIMENSIONS'
3187 INCLUDE 'COMMON.CALC'
3188 INCLUDE 'COMMON.CHAIN'
3189 INCLUDE 'COMMON.CONTROL'
3190 INCLUDE 'COMMON.DERIV'
3191 INCLUDE 'COMMON.EMP'
3192 INCLUDE 'COMMON.GEO'
3193 INCLUDE 'COMMON.INTERACT'
3194 INCLUDE 'COMMON.IOUNITS'
3195 INCLUDE 'COMMON.LOCAL'
3196 INCLUDE 'COMMON.NAMES'
3197 INCLUDE 'COMMON.VAR'
3198 double precision scalar, facd3, adler
3199 alphapol2 = alphapol(itypj,itypi)
3200 w1 = wqdip(1,itypi,itypj)
3201 w2 = wqdip(2,itypi,itypj)
3202 pis = sig0head(itypi,itypj)
3203 eps_head = epshead(itypi,itypj)
3204 c!-------------------------------------------------------------------
3205 c! R2 - distance between head of jth side chain and tail of ith sidechain
3208 c! Calculate head-to-tail distances
3209 R2=R2+(chead(k,2)-ctail(k,1))**2
3214 c! R1 = dsqrt((Rtail**2)+((dtail(1,itypi,itypj)
3215 c! & +dhead(1,1,itypi,itypj))**2))
3216 c! R2 = dsqrt((Rtail**2)+((dtail(2,itypi,itypj)
3217 c! & +dhead(2,1,itypi,itypj))**2))
3220 c!-------------------------------------------------------------------
3222 sparrow = w1 * Qi * om1
3223 hawk = w2 * Qi * Qi * (1.0d0 - sqom2)
3224 ECL = sparrow / Rhead**2.0d0
3225 & - hawk / Rhead**4.0d0
3226 c!-------------------------------------------------------------------
3227 c! derivative of ecl is Gcl
3229 dGCLdR = - 2.0d0 * sparrow / Rhead**3.0d0
3230 & + 4.0d0 * hawk / Rhead**5.0d0
3232 dGCLdOM1 = (w1 * Qi) / (Rhead**2.0d0)
3234 dGCLdOM2 = (2.0d0 * w2 * Qi * Qi * om2) / (Rhead ** 4.0d0)
3235 c--------------------------------------------------------------------
3236 c Polarization energy
3238 MomoFac2 = (1.0d0 - chi2 * sqom1)
3239 RR2 = R2 * R2 / MomoFac2
3240 ee2 = exp(-(RR2 / (4.0d0 * a12sq)))
3241 fgb2 = sqrt(RR2 + a12sq * ee2)
3242 epol = 332.0d0 * eps_inout_fac * ((alphapol2/fgb2) ** 4.0d0 )
3244 c! derivative of Epol is Gpol...
3245 dPOLdFGB2 = -(1328.0d0 * eps_inout_fac * alphapol2 ** 4.0d0)
3247 dFGBdR2 = ( (R2 / MomoFac2)
3248 & * ( 2.0d0 - (0.5d0 * ee2) ) )
3250 dFGBdOM1 = (((R2 * R2 * chi2 * om1) / (MomoFac2 * MomoFac2))
3251 & * (2.0d0 - 0.5d0 * ee2) )
3253 dPOLdR2 = dPOLdFGB2 * dFGBdR2
3255 dPOLdOM1 = dPOLdFGB2 * dFGBdOM1
3258 c!-------------------------------------------------------------------
3260 pom = (pis / Rhead)**6.0d0
3261 Elj = 4.0d0 * eps_head * pom * (pom-1.0d0)
3262 c! derivative of Elj is Glj
3263 dGLJdR = 4.0d0 * eps_head
3264 & * (((-12.0d0*pis**12.0d0)/(Rhead**13.0d0))
3265 & + (( 6.0d0*pis**6.0d0) /(Rhead**7.0d0)))
3266 c!-------------------------------------------------------------------
3267 c! Return the results
3268 c! (see comments in Eqq)
3270 erhead(k) = Rhead_distance(k)/Rhead
3271 erhead_tail(k,2) = ((chead(k,2)-ctail(k,1))/R2)
3273 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
3274 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
3275 eagle = scalar( erhead_tail(1,2), dC_norm(1,j+nres) )
3276 adler = scalar( erhead_tail(1,2), dC_norm(1,i+nres) )
3277 facd1 = d1 * vbld_inv(i+nres)
3278 facd2 = d2 * vbld_inv(j+nres)
3279 facd3 = dtail(1,itypi,itypj) * vbld_inv(i+nres)
3282 condor = (erhead_tail(k,2)
3283 & + facd2 * (erhead_tail(k,2) - eagle * dC_norm(k,j+nres)))
3285 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
3286 gvdwx(k,i) = gvdwx(k,i)
3288 & - dPOLdR2 * (erhead_tail(k,2)
3289 & -facd3 * (erhead_tail(k,2) - adler * dC_norm(k,i+nres)))
3292 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
3293 gvdwx(k,j) = gvdwx(k,j)
3295 & + dPOLdR2 * condor
3299 gvdwc(k,i) = gvdwc(k,i)
3300 & - dGCLdR * erhead(k)
3301 & - dPOLdR2 * erhead_tail(k,2)
3302 & - dGLJdR * erhead(k)
3304 gvdwc(k,j) = gvdwc(k,j)
3305 & + dGCLdR * erhead(k)
3306 & + dPOLdR2 * erhead_tail(k,2)
3307 & + dGLJdR * erhead(k)
3314 C--------------------------------------------------------------------
3319 INCLUDE 'DIMENSIONS'
3320 INCLUDE 'COMMON.CALC'
3321 INCLUDE 'COMMON.CHAIN'
3322 INCLUDE 'COMMON.CONTROL'
3323 INCLUDE 'COMMON.DERIV'
3324 INCLUDE 'COMMON.EMP'
3325 INCLUDE 'COMMON.GEO'
3326 INCLUDE 'COMMON.INTERACT'
3327 INCLUDE 'COMMON.IOUNITS'
3328 INCLUDE 'COMMON.LOCAL'
3329 INCLUDE 'COMMON.NAMES'
3330 INCLUDE 'COMMON.VAR'
3331 double precision scalar
3332 c! csig = sigiso(itypi,itypj)
3333 w1 = wqdip(1,itypi,itypj)
3334 w2 = wqdip(2,itypi,itypj)
3335 c!-------------------------------------------------------------------
3337 fac = (om12 - 3.0d0 * om1 * om2)
3338 c1 = (w1 / (Rhead**3.0d0)) * fac
3339 c2 = (w2 / Rhead ** 6.0d0)
3340 & * (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
3342 c! write (*,*) "w1 = ", w1
3343 c! write (*,*) "w2 = ", w2
3344 c! write (*,*) "om1 = ", om1
3345 c! write (*,*) "om2 = ", om2
3346 c! write (*,*) "om12 = ", om12
3347 c! write (*,*) "fac = ", fac
3348 c! write (*,*) "c1 = ", c1
3349 c! write (*,*) "c2 = ", c2
3350 c! write (*,*) "Ecl = ", Ecl
3351 c! write (*,*) "c2_1 = ", (w2 / Rhead ** 6.0d0)
3352 c! write (*,*) "c2_2 = ",
3353 c! & (4.0d0 + fac * fac -3.0d0 * (sqom1 + sqom2))
3354 c!-------------------------------------------------------------------
3355 c! dervative of ECL is GCL...
3357 c1 = (-3.0d0 * w1 * fac) / (Rhead ** 4.0d0)
3358 c2 = (-6.0d0 * w2) / (Rhead ** 7.0d0)
3359 & * (4.0d0 + fac * fac - 3.0d0 * (sqom1 + sqom2))
3362 c1 = (-3.0d0 * w1 * om2 ) / (Rhead**3.0d0)
3363 c2 = (-6.0d0 * w2) / (Rhead**6.0d0)
3364 & * ( om2 * om12 - 3.0d0 * om1 * sqom2 + om1 )
3367 c1 = (-3.0d0 * w1 * om1 ) / (Rhead**3.0d0)
3368 c2 = (-6.0d0 * w2) / (Rhead**6.0d0)
3369 & * ( om1 * om12 - 3.0d0 * sqom1 * om2 + om2 )
3372 c1 = w1 / (Rhead ** 3.0d0)
3373 c2 = ( 2.0d0 * w2 * fac ) / Rhead ** 6.0d0
3375 c!-------------------------------------------------------------------
3376 c! Return the results
3377 c! (see comments in Eqq)
3379 erhead(k) = Rhead_distance(k)/Rhead
3381 erdxi = scalar( erhead(1), dC_norm(1,i+nres) )
3382 erdxj = scalar( erhead(1), dC_norm(1,j+nres) )
3383 facd1 = d1 * vbld_inv(i+nres)
3384 facd2 = d2 * vbld_inv(j+nres)
3387 pom = erhead(k)+facd1*(erhead(k)-erdxi*dC_norm(k,i+nres))
3388 gvdwx(k,i) = gvdwx(k,i)
3390 pom = erhead(k)+facd2*(erhead(k)-erdxj*dC_norm(k,j+nres))
3391 gvdwx(k,j) = gvdwx(k,j)
3394 gvdwc(k,i) = gvdwc(k,i)
3395 & - dGCLdR * erhead(k)
3396 gvdwc(k,j) = gvdwc(k,j)
3397 & + dGCLdR * erhead(k)
3403 c!-------------------------------------------------------------------
3406 SUBROUTINE elgrad_init(eheadtail,Egb,Ecl,Elj,Equad,Epol)
3409 INCLUDE 'DIMENSIONS'
3410 c! itypi, itypj, i, j, k, l, chead,
3411 INCLUDE 'COMMON.CALC'
3413 INCLUDE 'COMMON.CHAIN'
3415 INCLUDE 'COMMON.DERIV'
3416 c! electrostatic gradients-specific variables
3417 INCLUDE 'COMMON.EMP'
3418 c! wquad, dhead, alphiso, alphasur, rborn, epsintab
3419 INCLUDE 'COMMON.INTERACT'
3422 c! io for debug, disable it in final builds
3423 INCLUDE 'COMMON.IOUNITS'
3424 c!-------------------------------------------------------------------
3427 c! what amino acid is the aminoacid j'th?
3429 c! 1/(Gas Constant * Thermostate temperature) = BetaT
3430 c! ENABLE THIS LINE WHEN USING CHECKGRAD!!!
3432 c! BetaT = 1.0d0 / (t_bath * Rb)
3433 BetaT = 1.0d0 / (298.0d0 * Rb)
3435 sig0ij = sigma( itypi,itypj )
3436 chi1 = chi( itypi, itypj )
3437 chi2 = chi( itypj, itypi )
3439 chip1 = chipp( itypi, itypj )
3440 chip2 = chipp( itypj, itypi )
3441 chip12 = chip1 * chip2
3442 c! not used by momo potential, but needed by sc_angular which is shared
3443 c! by all energy_potential subroutines
3447 c! location, location, location
3448 xj = c( 1, nres+j ) - xi
3449 yj = c( 2, nres+j ) - yi
3450 zj = c( 3, nres+j ) - zi
3451 dxj = dc_norm( 1, nres+j )
3452 dyj = dc_norm( 2, nres+j )
3453 dzj = dc_norm( 3, nres+j )
3454 c! distance from center of chain(?) to polar/charged head
3455 c! write (*,*) "istate = ", 1
3456 c! write (*,*) "ii = ", 1
3457 c! write (*,*) "jj = ", 1
3458 d1 = dhead(1, 1, itypi, itypj)
3459 d2 = dhead(2, 1, itypi, itypj)
3461 a12sq = rborn(itypi,itypj) * rborn(itypj,itypi)
3462 c! a12sq = a12sq * a12sq
3463 c! charge of amino acid itypi is...
3468 chis1 = chis(itypi,itypj)
3469 chis2 = chis(itypj,itypi)
3470 chis12 = chis1 * chis2
3471 sig1 = sigmap1(itypi,itypj)
3472 sig2 = sigmap2(itypi,itypj)
3473 c! write (*,*) "sig1 = ", sig1
3474 c! write (*,*) "sig2 = ", sig2
3475 c! alpha factors from Fcav/Gcav
3476 b1 = alphasur(1,itypi,itypj)
3477 b2 = alphasur(2,itypi,itypj)
3478 b3 = alphasur(3,itypi,itypj)
3479 b4 = alphasur(4,itypi,itypj)
3480 c! used to determine whether we want to do quadrupole calculations
3481 wqd = wquad(itypi, itypj)
3483 eps_in = epsintab(itypi,itypj)
3484 eps_inout_fac = ( (1.0d0/eps_in) - (1.0d0/eps_out))
3485 c! write (*,*) "eps_inout_fac = ", eps_inout_fac
3486 c!-------------------------------------------------------------------
3487 c! tail location and distance calculations
3490 ctail(k,1)=c(k,i+nres)-dtail(1,itypi,itypj)*dc_norm(k,nres+i)
3491 ctail(k,2)=c(k,j+nres)-dtail(2,itypi,itypj)*dc_norm(k,nres+j)
3493 c! tail distances will be themselves usefull elswhere
3494 c1 (in Gcav, for example)
3495 Rtail_distance(1) = ctail( 1, 2 ) - ctail( 1,1 )
3496 Rtail_distance(2) = ctail( 2, 2 ) - ctail( 2,1 )
3497 Rtail_distance(3) = ctail( 3, 2 ) - ctail( 3,1 )
3499 & (Rtail_distance(1)*Rtail_distance(1))
3500 & + (Rtail_distance(2)*Rtail_distance(2))
3501 & + (Rtail_distance(3)*Rtail_distance(3)))
3502 c!-------------------------------------------------------------------
3503 c! Calculate location and distance between polar heads
3504 c! distance between heads
3505 c! for each one of our three dimensional space...
3507 c! location of polar head is computed by taking hydrophobic centre
3508 c! and moving by a d1 * dc_norm vector
3509 c! see unres publications for very informative images
3510 chead(k,1) = c(k, i+nres) + d1 * dc_norm(k, i+nres)
3511 chead(k,2) = c(k, j+nres) + d2 * dc_norm(k, j+nres)
3513 c! Rsc_distance(k) = dabs(c(k, i+nres) - c(k, j+nres))
3514 c! Rsc(k) = Rsc_distance(k) * Rsc_distance(k)
3515 Rhead_distance(k) = chead(k,2) - chead(k,1)
3517 c! pitagoras (root of sum of squares)
3519 & (Rhead_distance(1)*Rhead_distance(1))
3520 & + (Rhead_distance(2)*Rhead_distance(2))
3521 & + (Rhead_distance(3)*Rhead_distance(3)))
3522 c!-------------------------------------------------------------------
3523 c! zero everything that should be zero'ed
3536 END SUBROUTINE elgrad_init
3539 c!-------------------------------------------------------------------
3541 subroutine sc_angular
3542 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
3543 C om12. Called by ebp, egb, and egbv.
3545 include 'COMMON.CALC'
3546 include 'COMMON.IOUNITS'
3550 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
3551 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
3552 om12=dxi*dxj+dyi*dyj+dzi*dzj
3557 C Calculate eps1(om12) and its derivative in om12
3558 faceps1=1.0D0-om12*chiom12
3559 faceps1_inv=1.0D0/faceps1
3560 eps1=dsqrt(faceps1_inv)
3561 C Following variable is eps1*deps1/dom12
3562 eps1_om12=faceps1_inv*chiom12
3567 c write (iout,*) "om12",om12," eps1",eps1
3568 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
3573 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
3574 sigsq=1.0D0-facsig*faceps1_inv
3575 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
3576 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
3577 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
3583 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
3584 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
3586 C Calculate eps2 and its derivatives in om1, om2, and om12.
3589 chipom12=chip12*om12
3590 facp=1.0D0-om12*chipom12
3592 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
3593 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
3594 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
3595 C Following variable is the square root of eps2
3596 eps2rt=1.0D0-facp1*facp_inv
3597 C Following three variables are the derivatives of the square root of eps
3598 C in om1, om2, and om12.
3599 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
3600 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
3601 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
3602 C Evaluate the "asymmetric" factor in the VDW constant, eps3
3603 c! Note that THIS is 0 in emomo, so we should probably move it out of sc_angular
3604 c! Or frankly, we should restructurize the whole energy section
3605 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
3606 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
3607 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
3608 c & " eps2rt_om12",eps2rt_om12
3609 C Calculate whole angle-dependent part of epsilon and contributions
3610 C to its derivatives
3614 C----------------------------------------------------------------------------
3615 subroutine sc_grad_T
3616 implicit real*8 (a-h,o-z)
3617 include 'DIMENSIONS'
3618 include 'COMMON.CHAIN'
3619 include 'COMMON.DERIV'
3620 include 'COMMON.CALC'
3621 include 'COMMON.IOUNITS'
3622 double precision dcosom1(3),dcosom2(3)
3623 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
3624 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
3625 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
3626 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
3630 c eom12=evdwij*eps1_om12
3632 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
3633 c & " sigder",sigder
3634 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
3635 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
3637 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
3638 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
3641 gg(k)=gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
3643 c write (iout,*) "gg",(gg(k),k=1,3)
3645 gvdwxT(k,i)=gvdwxT(k,i)-gg(k)
3646 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
3647 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
3648 gvdwxT(k,j)=gvdwxT(k,j)+gg(k)
3649 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
3650 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
3651 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
3652 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
3653 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
3654 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
3657 C Calculate the components of the gradient in DC and X
3661 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
3665 gvdwcT(l,i)=gvdwcT(l,i)-gg(l)
3666 gvdwcT(l,j)=gvdwcT(l,j)+gg(l)
3671 C----------------------------------------------------------------------------
3675 IMPLICIT real*8 (a-h,o-z)
3676 INCLUDE 'DIMENSIONS'
3677 INCLUDE 'COMMON.CHAIN'
3678 INCLUDE 'COMMON.DERIV'
3679 INCLUDE 'COMMON.CALC'
3680 INCLUDE 'COMMON.IOUNITS'
3681 INCLUDE 'COMMON.EMP'
3682 double precision dcosom1(3),dcosom2(3)
3683 c! write (*,*) "Start sc_grad"
3684 c! each eom holds sum of omega-angular derivatives of each component
3685 c! of energy function. First GGB, then Gcav, dipole-dipole,...
3687 & eps2der * eps2rt_om1
3688 & - 2.0D0 * alf1 * eps3der
3689 & + sigder * sigsq_om1
3695 & eps2der * eps2rt_om2
3696 & + 2.0D0 * alf2 * eps3der
3697 & + sigder * sigsq_om2
3703 & evdwij * eps1_om12
3704 & + eps2der * eps2rt_om12
3705 & - 2.0D0 * alf12 * eps3der
3706 & + sigder *sigsq_om12
3710 c! write (*,*) "evdwij=", evdwij
3711 c! write (*,*) "eps1_om12=", eps1_om12
3712 c! write (*,*) "eps2der=", eps2rt_om12
3713 c! write (*,*) "alf12=", alf12
3714 c! write (*,*) "eps3der=", eps3der
3715 c! write (*,*) "eom1=", eom1
3716 c! write (*,*) "eom2=", eom2
3717 c! write (*,*) "eom12=", eom12
3724 c! now some magical transformations to project gradient into
3725 c! three cartesian vectors
3726 c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
3727 c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
3728 c! write (*,*) "gg(",k,")=", gg(k)
3729 dcosom1(k) = rij * (dc_norm(k,nres+i) - om1 * erij(k))
3730 dcosom2(k) = rij * (dc_norm(k,nres+j) - om2 * erij(k))
3731 gg(k) = gg(k) + eom1 * dcosom1(k) + eom2 * dcosom2(k)
3732 c! write (*,*) "gg(",k,")=", gg(k)
3733 c! this acts on hydrophobic center of interaction
3734 gvdwx(k,i)= gvdwx(k,i) - gg(k)
3735 & + (eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
3736 & + eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
3737 gvdwx(k,j)= gvdwx(k,j) + gg(k)
3738 & + (eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
3739 & + eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
3740 c! this acts on Calpha
3741 gvdwc(k,i)=gvdwc(k,i)-gg(k)
3742 gvdwc(k,j)=gvdwc(k,j)+gg(k)
3743 c! write (*,*) "Gvdwc(",k,",",i,")=", gvdwc(k,i)
3744 c! write (*,*) "Gvdwc(",k,",",j,")=", gvdwc(k,j)
3746 c! write (*,*) "*************"
3749 END SUBROUTINE sc_grad
3752 C-----------------------------------------------------------------------
3755 subroutine e_softsphere(evdw)
3757 C This subroutine calculates the interaction energy of nonbonded side chains
3758 C assuming the LJ potential of interaction.
3760 implicit real*8 (a-h,o-z)
3761 include 'DIMENSIONS'
3762 parameter (accur=1.0d-10)
3763 include 'COMMON.GEO'
3764 include 'COMMON.VAR'
3765 include 'COMMON.LOCAL'
3766 include 'COMMON.CHAIN'
3767 include 'COMMON.DERIV'
3768 include 'COMMON.INTERACT'
3769 include 'COMMON.TORSION'
3770 include 'COMMON.SBRIDGE'
3771 include 'COMMON.NAMES'
3772 include 'COMMON.IOUNITS'
3773 include 'COMMON.CONTACTS'
3775 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
3777 do i=iatsc_s,iatsc_e
3784 C Calculate SC interaction energy.
3786 do iint=1,nint_gr(i)
3787 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
3788 cd & 'iend=',iend(i,iint)
3789 do j=istart(i,iint),iend(i,iint)
3794 rij=xj*xj+yj*yj+zj*zj
3795 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
3796 r0ij=r0(itypi,itypj)
3798 c print *,i,j,r0ij,dsqrt(rij)
3799 if (rij.lt.r0ijsq) then
3800 evdwij=0.25d0*(rij-r0ijsq)**2
3808 C Calculate the components of the gradient in DC and X
3814 gvdwx(k,i)=gvdwx(k,i)-gg(k)
3815 gvdwx(k,j)=gvdwx(k,j)+gg(k)
3816 gvdwc(k,i)=gvdwc(k,i)-gg(k)
3817 gvdwc(k,j)=gvdwc(k,j)+gg(k)
3821 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
3829 C--------------------------------------------------------------------------
3830 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
3833 C Soft-sphere potential of p-p interaction
3835 implicit real*8 (a-h,o-z)
3836 include 'DIMENSIONS'
3837 include 'COMMON.CONTROL'
3838 include 'COMMON.IOUNITS'
3839 include 'COMMON.GEO'
3840 include 'COMMON.VAR'
3841 include 'COMMON.LOCAL'
3842 include 'COMMON.CHAIN'
3843 include 'COMMON.DERIV'
3844 include 'COMMON.INTERACT'
3845 include 'COMMON.CONTACTS'
3846 include 'COMMON.TORSION'
3847 include 'COMMON.VECTORS'
3848 include 'COMMON.FFIELD'
3850 cd write(iout,*) 'In EELEC_soft_sphere'
3857 do i=iatel_s,iatel_e
3861 xmedi=c(1,i)+0.5d0*dxi
3862 ymedi=c(2,i)+0.5d0*dyi
3863 zmedi=c(3,i)+0.5d0*dzi
3865 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3866 do j=ielstart(i),ielend(i)
3870 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3871 r0ij=rpp(iteli,itelj)
3876 xj=c(1,j)+0.5D0*dxj-xmedi
3877 yj=c(2,j)+0.5D0*dyj-ymedi
3878 zj=c(3,j)+0.5D0*dzj-zmedi
3879 rij=xj*xj+yj*yj+zj*zj
3880 if (rij.lt.r0ijsq) then
3881 evdw1ij=0.25d0*(rij-r0ijsq)**2
3889 C Calculate contributions to the Cartesian gradient.
3895 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3896 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3899 * Loop over residues i+1 thru j-1.
3903 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3908 cgrad do i=nnt,nct-1
3910 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
3912 cgrad do j=i+1,nct-1
3914 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
3920 c------------------------------------------------------------------------------
3921 subroutine vec_and_deriv
3922 implicit real*8 (a-h,o-z)
3923 include 'DIMENSIONS'
3927 include 'COMMON.IOUNITS'
3928 include 'COMMON.GEO'
3929 include 'COMMON.VAR'
3930 include 'COMMON.LOCAL'
3931 include 'COMMON.CHAIN'
3932 include 'COMMON.VECTORS'
3933 include 'COMMON.SETUP'
3934 include 'COMMON.TIME1'
3935 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
3936 C Compute the local reference systems. For reference system (i), the
3937 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
3938 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
3940 do i=ivec_start,ivec_end
3944 if (i.eq.nres-1) then
3945 C Case of the last full residue
3946 C Compute the Z-axis
3947 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
3948 costh=dcos(pi-theta(nres))
3949 fac=1.0d0/dsqrt(1.0d0-costh*costh)
3953 C Compute the derivatives of uz
3955 uzder(2,1,1)=-dc_norm(3,i-1)
3956 uzder(3,1,1)= dc_norm(2,i-1)
3957 uzder(1,2,1)= dc_norm(3,i-1)
3959 uzder(3,2,1)=-dc_norm(1,i-1)
3960 uzder(1,3,1)=-dc_norm(2,i-1)
3961 uzder(2,3,1)= dc_norm(1,i-1)
3964 uzder(2,1,2)= dc_norm(3,i)
3965 uzder(3,1,2)=-dc_norm(2,i)
3966 uzder(1,2,2)=-dc_norm(3,i)
3968 uzder(3,2,2)= dc_norm(1,i)
3969 uzder(1,3,2)= dc_norm(2,i)
3970 uzder(2,3,2)=-dc_norm(1,i)
3972 C Compute the Y-axis
3975 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
3977 C Compute the derivatives of uy
3980 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
3981 & -dc_norm(k,i)*dc_norm(j,i-1)
3982 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
3984 uyder(j,j,1)=uyder(j,j,1)-costh
3985 uyder(j,j,2)=1.0d0+uyder(j,j,2)
3990 uygrad(l,k,j,i)=uyder(l,k,j)
3991 uzgrad(l,k,j,i)=uzder(l,k,j)
3995 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
3996 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
3997 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
3998 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
4001 C Compute the Z-axis
4002 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
4003 costh=dcos(pi-theta(i+2))
4004 fac=1.0d0/dsqrt(1.0d0-costh*costh)
4008 C Compute the derivatives of uz
4010 uzder(2,1,1)=-dc_norm(3,i+1)
4011 uzder(3,1,1)= dc_norm(2,i+1)
4012 uzder(1,2,1)= dc_norm(3,i+1)
4014 uzder(3,2,1)=-dc_norm(1,i+1)
4015 uzder(1,3,1)=-dc_norm(2,i+1)
4016 uzder(2,3,1)= dc_norm(1,i+1)
4019 uzder(2,1,2)= dc_norm(3,i)
4020 uzder(3,1,2)=-dc_norm(2,i)
4021 uzder(1,2,2)=-dc_norm(3,i)
4023 uzder(3,2,2)= dc_norm(1,i)
4024 uzder(1,3,2)= dc_norm(2,i)
4025 uzder(2,3,2)=-dc_norm(1,i)
4027 C Compute the Y-axis
4030 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
4032 C Compute the derivatives of uy
4035 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
4036 & -dc_norm(k,i)*dc_norm(j,i+1)
4037 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
4039 uyder(j,j,1)=uyder(j,j,1)-costh
4040 uyder(j,j,2)=1.0d0+uyder(j,j,2)
4045 uygrad(l,k,j,i)=uyder(l,k,j)
4046 uzgrad(l,k,j,i)=uzder(l,k,j)
4050 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
4051 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
4052 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
4053 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
4057 vbld_inv_temp(1)=vbld_inv(i+1)
4058 if (i.lt.nres-1) then
4059 vbld_inv_temp(2)=vbld_inv(i+2)
4061 vbld_inv_temp(2)=vbld_inv(i)
4066 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
4067 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
4072 #if defined(PARVEC) && defined(MPI)
4073 if (nfgtasks1.gt.1) then
4075 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
4076 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
4077 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
4078 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
4079 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
4081 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
4082 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
4084 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
4085 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
4086 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
4087 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
4088 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
4089 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
4090 time_gather=time_gather+MPI_Wtime()-time00
4092 c if (fg_rank.eq.0) then
4093 c write (iout,*) "Arrays UY and UZ"
4095 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
4102 C-----------------------------------------------------------------------------
4103 subroutine check_vecgrad
4104 implicit real*8 (a-h,o-z)
4105 include 'DIMENSIONS'
4106 include 'COMMON.IOUNITS'
4107 include 'COMMON.GEO'
4108 include 'COMMON.VAR'
4109 include 'COMMON.LOCAL'
4110 include 'COMMON.CHAIN'
4111 include 'COMMON.VECTORS'
4112 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
4113 dimension uyt(3,maxres),uzt(3,maxres)
4114 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
4115 double precision delta /1.0d-7/
4118 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
4119 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
4120 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
4121 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
4122 cd & (dc_norm(if90,i),if90=1,3)
4123 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
4124 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
4125 cd write(iout,'(a)')
4131 uygradt(l,k,j,i)=uygrad(l,k,j,i)
4132 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
4145 cd write (iout,*) 'i=',i
4147 erij(k)=dc_norm(k,i)
4151 dc_norm(k,i)=erij(k)
4153 dc_norm(j,i)=dc_norm(j,i)+delta
4154 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
4156 c dc_norm(k,i)=dc_norm(k,i)/fac
4158 c write (iout,*) (dc_norm(k,i),k=1,3)
4159 c write (iout,*) (erij(k),k=1,3)
4162 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
4163 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
4164 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
4165 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
4167 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
4168 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
4169 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
4172 dc_norm(k,i)=erij(k)
4175 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
4176 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
4177 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
4178 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
4179 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
4180 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
4181 cd write (iout,'(a)')
4186 C--------------------------------------------------------------------------
4187 subroutine set_matrices
4188 implicit real*8 (a-h,o-z)
4189 include 'DIMENSIONS'
4192 include "COMMON.SETUP"
4194 integer status(MPI_STATUS_SIZE)
4196 include 'COMMON.IOUNITS'
4197 include 'COMMON.GEO'
4198 include 'COMMON.VAR'
4199 include 'COMMON.LOCAL'
4200 include 'COMMON.CHAIN'
4201 include 'COMMON.DERIV'
4202 include 'COMMON.INTERACT'
4203 include 'COMMON.CONTACTS'
4204 include 'COMMON.TORSION'
4205 include 'COMMON.VECTORS'
4206 include 'COMMON.FFIELD'
4207 double precision auxvec(2),auxmat(2,2)
4209 C Compute the virtual-bond-torsional-angle dependent quantities needed
4210 C to calculate the el-loc multibody terms of various order.
4213 do i=ivec_start+2,ivec_end+2
4217 if (i .lt. nres+1) then
4254 if (i .gt. 3 .and. i .lt. nres+1) then
4255 obrot_der(1,i-2)=-sin1
4256 obrot_der(2,i-2)= cos1
4257 Ugder(1,1,i-2)= sin1
4258 Ugder(1,2,i-2)=-cos1
4259 Ugder(2,1,i-2)=-cos1
4260 Ugder(2,2,i-2)=-sin1
4263 obrot2_der(1,i-2)=-dwasin2
4264 obrot2_der(2,i-2)= dwacos2
4265 Ug2der(1,1,i-2)= dwasin2
4266 Ug2der(1,2,i-2)=-dwacos2
4267 Ug2der(2,1,i-2)=-dwacos2
4268 Ug2der(2,2,i-2)=-dwasin2
4270 obrot_der(1,i-2)=0.0d0
4271 obrot_der(2,i-2)=0.0d0
4272 Ugder(1,1,i-2)=0.0d0
4273 Ugder(1,2,i-2)=0.0d0
4274 Ugder(2,1,i-2)=0.0d0
4275 Ugder(2,2,i-2)=0.0d0
4276 obrot2_der(1,i-2)=0.0d0
4277 obrot2_der(2,i-2)=0.0d0
4278 Ug2der(1,1,i-2)=0.0d0
4279 Ug2der(1,2,i-2)=0.0d0
4280 Ug2der(2,1,i-2)=0.0d0
4281 Ug2der(2,2,i-2)=0.0d0
4283 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
4284 if (i.gt. nnt+2 .and. i.lt.nct+2) then
4285 iti = itortyp(itype(i-2))
4289 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
4290 if (i.gt. nnt+1 .and. i.lt.nct+1) then
4291 iti1 = itortyp(itype(i-1))
4295 cd write (iout,*) '*******i',i,' iti1',iti
4296 cd write (iout,*) 'b1',b1(:,iti)
4297 cd write (iout,*) 'b2',b2(:,iti)
4298 cd write (iout,*) 'Ug',Ug(:,:,i-2)
4299 c if (i .gt. iatel_s+2) then
4300 if (i .gt. nnt+2) then
4301 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
4302 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
4303 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
4305 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
4306 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
4307 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
4308 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
4309 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
4320 DtUg2(l,k,i-2)=0.0d0
4324 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
4325 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
4327 muder(k,i-2)=Ub2der(k,i-2)
4329 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
4330 if (i.gt. nnt+1 .and. i.lt.nct+1) then
4331 iti1 = itortyp(itype(i-1))
4336 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
4338 cd write (iout,*) 'mu ',mu(:,i-2)
4339 cd write (iout,*) 'mu1',mu1(:,i-2)
4340 cd write (iout,*) 'mu2',mu2(:,i-2)
4341 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
4343 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
4344 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
4345 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
4346 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
4347 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
4348 C Vectors and matrices dependent on a single virtual-bond dihedral.
4349 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
4350 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
4351 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
4352 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
4353 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
4354 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
4355 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
4356 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
4357 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
4360 C Matrices dependent on two consecutive virtual-bond dihedrals.
4361 C The order of matrices is from left to right.
4362 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
4364 c do i=max0(ivec_start,2),ivec_end
4366 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
4367 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
4368 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
4369 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
4370 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
4371 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
4372 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
4373 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
4376 #if defined(MPI) && defined(PARMAT)
4378 c if (fg_rank.eq.0) then
4379 write (iout,*) "Arrays UG and UGDER before GATHER"
4381 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
4382 & ((ug(l,k,i),l=1,2),k=1,2),
4383 & ((ugder(l,k,i),l=1,2),k=1,2)
4385 write (iout,*) "Arrays UG2 and UG2DER"
4387 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
4388 & ((ug2(l,k,i),l=1,2),k=1,2),
4389 & ((ug2der(l,k,i),l=1,2),k=1,2)
4391 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
4393 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
4394 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
4395 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
4397 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
4399 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
4400 & costab(i),sintab(i),costab2(i),sintab2(i)
4402 write (iout,*) "Array MUDER"
4404 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
4408 if (nfgtasks.gt.1) then
4410 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
4411 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
4412 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
4414 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
4415 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
4417 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
4418 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
4420 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
4421 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
4423 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
4424 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
4426 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
4427 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
4429 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
4430 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
4432 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
4433 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
4434 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
4435 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
4436 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
4437 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
4438 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
4439 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
4440 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
4441 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
4442 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
4443 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
4444 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
4446 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
4447 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
4449 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
4450 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
4452 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
4453 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
4455 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
4456 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
4458 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
4459 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
4461 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
4462 & ivec_count(fg_rank1),
4463 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
4465 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
4466 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
4468 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
4469 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
4471 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
4472 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
4474 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
4475 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
4477 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
4478 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
4480 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
4481 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
4483 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
4484 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
4486 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
4487 & ivec_count(fg_rank1),
4488 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
4490 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
4491 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
4493 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
4494 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
4496 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
4497 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
4499 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
4500 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
4502 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
4503 & ivec_count(fg_rank1),
4504 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
4506 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
4507 & ivec_count(fg_rank1),
4508 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
4510 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
4511 & ivec_count(fg_rank1),
4512 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
4513 & MPI_MAT2,FG_COMM1,IERR)
4514 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
4515 & ivec_count(fg_rank1),
4516 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
4517 & MPI_MAT2,FG_COMM1,IERR)
4520 c Passes matrix info through the ring
4523 if (irecv.lt.0) irecv=nfgtasks1-1
4526 if (inext.ge.nfgtasks1) inext=0
4528 c write (iout,*) "isend",isend," irecv",irecv
4530 lensend=lentyp(isend)
4531 lenrecv=lentyp(irecv)
4532 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
4533 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
4534 c & MPI_ROTAT1(lensend),inext,2200+isend,
4535 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
4536 c & iprev,2200+irecv,FG_COMM,status,IERR)
4537 c write (iout,*) "Gather ROTAT1"
4539 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
4540 c & MPI_ROTAT2(lensend),inext,3300+isend,
4541 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
4542 c & iprev,3300+irecv,FG_COMM,status,IERR)
4543 c write (iout,*) "Gather ROTAT2"
4545 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
4546 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
4547 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
4548 & iprev,4400+irecv,FG_COMM,status,IERR)
4549 c write (iout,*) "Gather ROTAT_OLD"
4551 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
4552 & MPI_PRECOMP11(lensend),inext,5500+isend,
4553 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
4554 & iprev,5500+irecv,FG_COMM,status,IERR)
4555 c write (iout,*) "Gather PRECOMP11"
4557 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
4558 & MPI_PRECOMP12(lensend),inext,6600+isend,
4559 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
4560 & iprev,6600+irecv,FG_COMM,status,IERR)
4561 c write (iout,*) "Gather PRECOMP12"
4563 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
4565 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
4566 & MPI_ROTAT2(lensend),inext,7700+isend,
4567 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
4568 & iprev,7700+irecv,FG_COMM,status,IERR)
4569 c write (iout,*) "Gather PRECOMP21"
4571 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
4572 & MPI_PRECOMP22(lensend),inext,8800+isend,
4573 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
4574 & iprev,8800+irecv,FG_COMM,status,IERR)
4575 c write (iout,*) "Gather PRECOMP22"
4577 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
4578 & MPI_PRECOMP23(lensend),inext,9900+isend,
4579 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
4580 & MPI_PRECOMP23(lenrecv),
4581 & iprev,9900+irecv,FG_COMM,status,IERR)
4582 c write (iout,*) "Gather PRECOMP23"
4587 if (irecv.lt.0) irecv=nfgtasks1-1
4590 time_gather=time_gather+MPI_Wtime()-time00
4593 c if (fg_rank.eq.0) then
4594 write (iout,*) "Arrays UG and UGDER"
4596 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
4597 & ((ug(l,k,i),l=1,2),k=1,2),
4598 & ((ugder(l,k,i),l=1,2),k=1,2)
4600 write (iout,*) "Arrays UG2 and UG2DER"
4602 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
4603 & ((ug2(l,k,i),l=1,2),k=1,2),
4604 & ((ug2der(l,k,i),l=1,2),k=1,2)
4606 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
4608 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
4609 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
4610 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
4612 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
4614 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
4615 & costab(i),sintab(i),costab2(i),sintab2(i)
4617 write (iout,*) "Array MUDER"
4619 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
4625 cd iti = itortyp(itype(i))
4628 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
4629 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
4634 C--------------------------------------------------------------------------
4635 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
4637 C This subroutine calculates the average interaction energy and its gradient
4638 C in the virtual-bond vectors between non-adjacent peptide groups, based on
4639 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
4640 C The potential depends both on the distance of peptide-group centers and on
4641 C the orientation of the CA-CA virtual bonds.
4643 implicit real*8 (a-h,o-z)
4647 include 'DIMENSIONS'
4648 include 'COMMON.CONTROL'
4649 include 'COMMON.SETUP'
4650 include 'COMMON.IOUNITS'
4651 include 'COMMON.GEO'
4652 include 'COMMON.VAR'
4653 include 'COMMON.LOCAL'
4654 include 'COMMON.CHAIN'
4655 include 'COMMON.DERIV'
4656 include 'COMMON.INTERACT'
4657 include 'COMMON.CONTACTS'
4658 include 'COMMON.TORSION'
4659 include 'COMMON.VECTORS'
4660 include 'COMMON.FFIELD'
4661 include 'COMMON.TIME1'
4662 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
4663 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
4664 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
4665 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
4666 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4667 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4669 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
4671 double precision scal_el /1.0d0/
4673 double precision scal_el /0.5d0/
4676 C 13-go grudnia roku pamietnego...
4677 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
4678 & 0.0d0,1.0d0,0.0d0,
4679 & 0.0d0,0.0d0,1.0d0/
4680 cd write(iout,*) 'In EELEC'
4682 cd write(iout,*) 'Type',i
4683 cd write(iout,*) 'B1',B1(:,i)
4684 cd write(iout,*) 'B2',B2(:,i)
4685 cd write(iout,*) 'CC',CC(:,:,i)
4686 cd write(iout,*) 'DD',DD(:,:,i)
4687 cd write(iout,*) 'EE',EE(:,:,i)
4689 cd call check_vecgrad
4691 if (icheckgrad.eq.1) then
4693 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
4695 dc_norm(k,i)=dc(k,i)*fac
4697 c write (iout,*) 'i',i,' fac',fac
4700 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
4701 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
4702 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
4703 c call vec_and_deriv
4709 time_mat=time_mat+MPI_Wtime()-time01
4713 cd write (iout,*) 'i=',i
4715 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
4718 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
4719 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
4732 cd print '(a)','Enter EELEC'
4733 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
4735 gel_loc_loc(i)=0.0d0
4740 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
4742 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
4744 do i=iturn3_start,iturn3_end
4748 dx_normi=dc_norm(1,i)
4749 dy_normi=dc_norm(2,i)
4750 dz_normi=dc_norm(3,i)
4751 xmedi=c(1,i)+0.5d0*dxi
4752 ymedi=c(2,i)+0.5d0*dyi
4753 zmedi=c(3,i)+0.5d0*dzi
4755 call eelecij(i,i+2,ees,evdw1,eel_loc)
4756 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
4757 num_cont_hb(i)=num_conti
4759 do i=iturn4_start,iturn4_end
4763 dx_normi=dc_norm(1,i)
4764 dy_normi=dc_norm(2,i)
4765 dz_normi=dc_norm(3,i)
4766 xmedi=c(1,i)+0.5d0*dxi
4767 ymedi=c(2,i)+0.5d0*dyi
4768 zmedi=c(3,i)+0.5d0*dzi
4769 num_conti=num_cont_hb(i)
4770 call eelecij(i,i+3,ees,evdw1,eel_loc)
4771 if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
4772 num_cont_hb(i)=num_conti
4775 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
4777 do i=iatel_s,iatel_e
4781 dx_normi=dc_norm(1,i)
4782 dy_normi=dc_norm(2,i)
4783 dz_normi=dc_norm(3,i)
4784 xmedi=c(1,i)+0.5d0*dxi
4785 ymedi=c(2,i)+0.5d0*dyi
4786 zmedi=c(3,i)+0.5d0*dzi
4787 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
4788 num_conti=num_cont_hb(i)
4789 do j=ielstart(i),ielend(i)
4790 call eelecij(i,j,ees,evdw1,eel_loc)
4792 num_cont_hb(i)=num_conti
4794 c write (iout,*) "Number of loop steps in EELEC:",ind
4796 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
4797 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
4799 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
4800 ccc eel_loc=eel_loc+eello_turn3
4801 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
4804 C-------------------------------------------------------------------------------
4805 subroutine eelecij(i,j,ees,evdw1,eel_loc)
4806 implicit real*8 (a-h,o-z)
4807 include 'DIMENSIONS'
4811 include 'COMMON.CONTROL'
4812 include 'COMMON.IOUNITS'
4813 include 'COMMON.GEO'
4814 include 'COMMON.VAR'
4815 include 'COMMON.LOCAL'
4816 include 'COMMON.CHAIN'
4817 include 'COMMON.DERIV'
4818 include 'COMMON.INTERACT'
4819 include 'COMMON.CONTACTS'
4820 include 'COMMON.TORSION'
4821 include 'COMMON.VECTORS'
4822 include 'COMMON.FFIELD'
4823 include 'COMMON.TIME1'
4824 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
4825 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
4826 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
4827 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
4828 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4829 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4831 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
4833 double precision scal_el /1.0d0/
4835 double precision scal_el /0.5d0/
4838 C 13-go grudnia roku pamietnego...
4839 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
4840 & 0.0d0,1.0d0,0.0d0,
4841 & 0.0d0,0.0d0,1.0d0/
4842 c time00=MPI_Wtime()
4843 cd write (iout,*) "eelecij",i,j
4847 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
4848 aaa=app(iteli,itelj)
4849 bbb=bpp(iteli,itelj)
4850 ael6i=ael6(iteli,itelj)
4851 ael3i=ael3(iteli,itelj)
4855 dx_normj=dc_norm(1,j)
4856 dy_normj=dc_norm(2,j)
4857 dz_normj=dc_norm(3,j)
4858 xj=c(1,j)+0.5D0*dxj-xmedi
4859 yj=c(2,j)+0.5D0*dyj-ymedi
4860 zj=c(3,j)+0.5D0*dzj-zmedi
4861 rij=xj*xj+yj*yj+zj*zj
4867 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
4868 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
4869 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
4870 fac=cosa-3.0D0*cosb*cosg
4872 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
4873 if (j.eq.i+2) ev1=scal_el*ev1
4878 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
4881 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
4882 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
4885 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
4886 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
4887 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
4888 cd & xmedi,ymedi,zmedi,xj,yj,zj
4890 if (energy_dec) then
4891 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
4892 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
4896 C Calculate contributions to the Cartesian gradient.
4899 facvdw=-6*rrmij*(ev1+evdwij)
4900 facel=-3*rrmij*(el1+eesij)
4906 * Radial derivatives. First process both termini of the fragment (i,j)
4912 c ghalf=0.5D0*ggg(k)
4913 c gelc(k,i)=gelc(k,i)+ghalf
4914 c gelc(k,j)=gelc(k,j)+ghalf
4916 c 9/28/08 AL Gradient compotents will be summed only at the end
4918 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
4919 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
4922 * Loop over residues i+1 thru j-1.
4926 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
4933 c ghalf=0.5D0*ggg(k)
4934 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
4935 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
4937 c 9/28/08 AL Gradient compotents will be summed only at the end
4939 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
4940 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
4943 * Loop over residues i+1 thru j-1.
4947 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
4954 fac=-3*rrmij*(facvdw+facvdw+facel)
4959 * Radial derivatives. First process both termini of the fragment (i,j)
4965 c ghalf=0.5D0*ggg(k)
4966 c gelc(k,i)=gelc(k,i)+ghalf
4967 c gelc(k,j)=gelc(k,j)+ghalf
4969 c 9/28/08 AL Gradient compotents will be summed only at the end
4971 gelc_long(k,j)=gelc(k,j)+ggg(k)
4972 gelc_long(k,i)=gelc(k,i)-ggg(k)
4975 * Loop over residues i+1 thru j-1.
4979 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
4982 c 9/28/08 AL Gradient compotents will be summed only at the end
4987 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
4988 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
4994 ecosa=2.0D0*fac3*fac1+fac4
4997 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
4998 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
5000 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
5001 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
5003 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
5004 cd & (dcosg(k),k=1,3)
5006 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
5009 c ghalf=0.5D0*ggg(k)
5010 c gelc(k,i)=gelc(k,i)+ghalf
5011 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
5012 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
5013 c gelc(k,j)=gelc(k,j)+ghalf
5014 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
5015 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
5019 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
5024 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
5025 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
5027 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
5028 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
5029 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
5030 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
5032 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
5033 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
5034 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
5036 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
5037 C energy of a peptide unit is assumed in the form of a second-order
5038 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
5039 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
5040 C are computed for EVERY pair of non-contiguous peptide groups.
5042 if (j.lt.nres-1) then
5053 muij(kkk)=mu(k,i)*mu(l,j)
5056 cd write (iout,*) 'EELEC: i',i,' j',j
5057 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
5058 cd write(iout,*) 'muij',muij
5059 ury=scalar(uy(1,i),erij)
5060 urz=scalar(uz(1,i),erij)
5061 vry=scalar(uy(1,j),erij)
5062 vrz=scalar(uz(1,j),erij)
5063 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
5064 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
5065 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
5066 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
5067 fac=dsqrt(-ael6i)*r3ij
5072 cd write (iout,'(4i5,4f10.5)')
5073 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
5074 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
5075 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
5076 cd & uy(:,j),uz(:,j)
5077 cd write (iout,'(4f10.5)')
5078 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
5079 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
5080 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
5081 cd write (iout,'(9f10.5/)')
5082 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
5083 C Derivatives of the elements of A in virtual-bond vectors
5084 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
5086 uryg(k,1)=scalar(erder(1,k),uy(1,i))
5087 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
5088 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
5089 urzg(k,1)=scalar(erder(1,k),uz(1,i))
5090 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
5091 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
5092 vryg(k,1)=scalar(erder(1,k),uy(1,j))
5093 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
5094 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
5095 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
5096 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
5097 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
5099 C Compute radial contributions to the gradient
5117 C Add the contributions coming from er
5120 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
5121 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
5122 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
5123 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
5126 C Derivatives in DC(i)
5127 cgrad ghalf1=0.5d0*agg(k,1)
5128 cgrad ghalf2=0.5d0*agg(k,2)
5129 cgrad ghalf3=0.5d0*agg(k,3)
5130 cgrad ghalf4=0.5d0*agg(k,4)
5131 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
5132 & -3.0d0*uryg(k,2)*vry)!+ghalf1
5133 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
5134 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
5135 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
5136 & -3.0d0*urzg(k,2)*vry)!+ghalf3
5137 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
5138 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
5139 C Derivatives in DC(i+1)
5140 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
5141 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
5142 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
5143 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
5144 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
5145 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
5146 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
5147 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
5148 C Derivatives in DC(j)
5149 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
5150 & -3.0d0*vryg(k,2)*ury)!+ghalf1
5151 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
5152 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
5153 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
5154 & -3.0d0*vryg(k,2)*urz)!+ghalf3
5155 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
5156 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
5157 C Derivatives in DC(j+1) or DC(nres-1)
5158 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
5159 & -3.0d0*vryg(k,3)*ury)
5160 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
5161 & -3.0d0*vrzg(k,3)*ury)
5162 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
5163 & -3.0d0*vryg(k,3)*urz)
5164 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
5165 & -3.0d0*vrzg(k,3)*urz)
5166 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
5168 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
5181 aggi(k,l)=-aggi(k,l)
5182 aggi1(k,l)=-aggi1(k,l)
5183 aggj(k,l)=-aggj(k,l)
5184 aggj1(k,l)=-aggj1(k,l)
5187 if (j.lt.nres-1) then
5193 aggi(k,l)=-aggi(k,l)
5194 aggi1(k,l)=-aggi1(k,l)
5195 aggj(k,l)=-aggj(k,l)
5196 aggj1(k,l)=-aggj1(k,l)
5207 aggi(k,l)=-aggi(k,l)
5208 aggi1(k,l)=-aggi1(k,l)
5209 aggj(k,l)=-aggj(k,l)
5210 aggj1(k,l)=-aggj1(k,l)
5215 IF (wel_loc.gt.0.0d0) THEN
5216 C Contribution to the local-electrostatic energy coming from the i-j pair
5217 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
5219 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
5221 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5222 & 'eelloc',i,j,eel_loc_ij
5224 eel_loc=eel_loc+eel_loc_ij
5225 C Partial derivatives in virtual-bond dihedral angles gamma
5227 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
5228 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
5229 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
5230 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
5231 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
5232 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
5233 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
5235 ggg(l)=agg(l,1)*muij(1)+
5236 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
5237 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
5238 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
5239 cgrad ghalf=0.5d0*ggg(l)
5240 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
5241 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
5245 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
5248 C Remaining derivatives of eello
5250 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
5251 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
5252 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
5253 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
5254 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
5255 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
5256 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
5257 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
5260 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
5261 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
5262 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
5263 & .and. num_conti.le.maxconts) then
5264 c write (iout,*) i,j," entered corr"
5266 C Calculate the contact function. The ith column of the array JCONT will
5267 C contain the numbers of atoms that make contacts with the atom I (of numbers
5268 C greater than I). The arrays FACONT and GACONT will contain the values of
5269 C the contact function and its derivative.
5270 c r0ij=1.02D0*rpp(iteli,itelj)
5271 c r0ij=1.11D0*rpp(iteli,itelj)
5272 r0ij=2.20D0*rpp(iteli,itelj)
5273 c r0ij=1.55D0*rpp(iteli,itelj)
5274 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
5275 if (fcont.gt.0.0D0) then
5276 num_conti=num_conti+1
5277 if (num_conti.gt.maxconts) then
5278 write (iout,*) 'WARNING - max. # of contacts exceeded;',
5279 & ' will skip next contacts for this conf.'
5281 jcont_hb(num_conti,i)=j
5282 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
5283 cd & " jcont_hb",jcont_hb(num_conti,i)
5284 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
5285 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
5286 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
5288 d_cont(num_conti,i)=rij
5289 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
5290 C --- Electrostatic-interaction matrix ---
5291 a_chuj(1,1,num_conti,i)=a22
5292 a_chuj(1,2,num_conti,i)=a23
5293 a_chuj(2,1,num_conti,i)=a32
5294 a_chuj(2,2,num_conti,i)=a33
5295 C --- Gradient of rij
5297 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
5304 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
5305 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
5306 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
5307 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
5308 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
5313 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
5314 C Calculate contact energies
5316 wij=cosa-3.0D0*cosb*cosg
5319 c fac3=dsqrt(-ael6i)/r0ij**3
5320 fac3=dsqrt(-ael6i)*r3ij
5321 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
5322 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
5323 if (ees0tmp.gt.0) then
5324 ees0pij=dsqrt(ees0tmp)
5328 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
5329 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
5330 if (ees0tmp.gt.0) then
5331 ees0mij=dsqrt(ees0tmp)
5336 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
5337 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
5338 C Diagnostics. Comment out or remove after debugging!
5339 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
5340 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
5341 c ees0m(num_conti,i)=0.0D0
5343 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
5344 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
5345 C Angular derivatives of the contact function
5346 ees0pij1=fac3/ees0pij
5347 ees0mij1=fac3/ees0mij
5348 fac3p=-3.0D0*fac3*rrmij
5349 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
5350 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
5352 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
5353 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
5354 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
5355 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
5356 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
5357 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
5358 ecosap=ecosa1+ecosa2
5359 ecosbp=ecosb1+ecosb2
5360 ecosgp=ecosg1+ecosg2
5361 ecosam=ecosa1-ecosa2
5362 ecosbm=ecosb1-ecosb2
5363 ecosgm=ecosg1-ecosg2
5372 facont_hb(num_conti,i)=fcont
5373 fprimcont=fprimcont/rij
5374 cd facont_hb(num_conti,i)=1.0D0
5375 C Following line is for diagnostics.
5378 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
5379 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
5382 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
5383 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
5385 gggp(1)=gggp(1)+ees0pijp*xj
5386 gggp(2)=gggp(2)+ees0pijp*yj
5387 gggp(3)=gggp(3)+ees0pijp*zj
5388 gggm(1)=gggm(1)+ees0mijp*xj
5389 gggm(2)=gggm(2)+ees0mijp*yj
5390 gggm(3)=gggm(3)+ees0mijp*zj
5391 C Derivatives due to the contact function
5392 gacont_hbr(1,num_conti,i)=fprimcont*xj
5393 gacont_hbr(2,num_conti,i)=fprimcont*yj
5394 gacont_hbr(3,num_conti,i)=fprimcont*zj
5397 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
5398 c following the change of gradient-summation algorithm.
5400 cgrad ghalfp=0.5D0*gggp(k)
5401 cgrad ghalfm=0.5D0*gggm(k)
5402 gacontp_hb1(k,num_conti,i)=!ghalfp
5403 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
5404 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
5405 gacontp_hb2(k,num_conti,i)=!ghalfp
5406 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
5407 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
5408 gacontp_hb3(k,num_conti,i)=gggp(k)
5409 gacontm_hb1(k,num_conti,i)=!ghalfm
5410 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
5411 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
5412 gacontm_hb2(k,num_conti,i)=!ghalfm
5413 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
5414 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
5415 gacontm_hb3(k,num_conti,i)=gggm(k)
5417 C Diagnostics. Comment out or remove after debugging!
5419 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
5420 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
5421 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
5422 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
5423 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
5424 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
5427 endif ! num_conti.le.maxconts
5430 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
5433 ghalf=0.5d0*agg(l,k)
5434 aggi(l,k)=aggi(l,k)+ghalf
5435 aggi1(l,k)=aggi1(l,k)+agg(l,k)
5436 aggj(l,k)=aggj(l,k)+ghalf
5439 if (j.eq.nres-1 .and. i.lt.j-2) then
5442 aggj1(l,k)=aggj1(l,k)+agg(l,k)
5447 c t_eelecij=t_eelecij+MPI_Wtime()-time00
5450 C-----------------------------------------------------------------------------
5451 subroutine eturn3(i,eello_turn3)
5452 C Third- and fourth-order contributions from turns
5453 implicit real*8 (a-h,o-z)
5454 include 'DIMENSIONS'
5455 include 'COMMON.IOUNITS'
5456 include 'COMMON.GEO'
5457 include 'COMMON.VAR'
5458 include 'COMMON.LOCAL'
5459 include 'COMMON.CHAIN'
5460 include 'COMMON.DERIV'
5461 include 'COMMON.INTERACT'
5462 include 'COMMON.CONTACTS'
5463 include 'COMMON.TORSION'
5464 include 'COMMON.VECTORS'
5465 include 'COMMON.FFIELD'
5466 include 'COMMON.CONTROL'
5468 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
5469 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
5470 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
5471 double precision agg(3,4),aggi(3,4),aggi1(3,4),
5472 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
5473 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
5474 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
5477 c write (iout,*) "eturn3",i,j,j1,j2
5482 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5484 C Third-order contributions
5491 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5492 cd call checkint_turn3(i,a_temp,eello_turn3_num)
5493 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
5494 call transpose2(auxmat(1,1),auxmat1(1,1))
5495 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
5496 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
5497 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5498 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
5499 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
5500 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
5501 cd & ' eello_turn3_num',4*eello_turn3_num
5502 C Derivatives in gamma(i)
5503 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
5504 call transpose2(auxmat2(1,1),auxmat3(1,1))
5505 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
5506 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
5507 C Derivatives in gamma(i+1)
5508 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
5509 call transpose2(auxmat2(1,1),auxmat3(1,1))
5510 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
5511 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
5512 & +0.5d0*(pizda(1,1)+pizda(2,2))
5513 C Cartesian derivatives
5515 c ghalf1=0.5d0*agg(l,1)
5516 c ghalf2=0.5d0*agg(l,2)
5517 c ghalf3=0.5d0*agg(l,3)
5518 c ghalf4=0.5d0*agg(l,4)
5519 a_temp(1,1)=aggi(l,1)!+ghalf1
5520 a_temp(1,2)=aggi(l,2)!+ghalf2
5521 a_temp(2,1)=aggi(l,3)!+ghalf3
5522 a_temp(2,2)=aggi(l,4)!+ghalf4
5523 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
5524 gcorr3_turn(l,i)=gcorr3_turn(l,i)
5525 & +0.5d0*(pizda(1,1)+pizda(2,2))
5526 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
5527 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
5528 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
5529 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
5530 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
5531 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
5532 & +0.5d0*(pizda(1,1)+pizda(2,2))
5533 a_temp(1,1)=aggj(l,1)!+ghalf1
5534 a_temp(1,2)=aggj(l,2)!+ghalf2
5535 a_temp(2,1)=aggj(l,3)!+ghalf3
5536 a_temp(2,2)=aggj(l,4)!+ghalf4
5537 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
5538 gcorr3_turn(l,j)=gcorr3_turn(l,j)
5539 & +0.5d0*(pizda(1,1)+pizda(2,2))
5540 a_temp(1,1)=aggj1(l,1)
5541 a_temp(1,2)=aggj1(l,2)
5542 a_temp(2,1)=aggj1(l,3)
5543 a_temp(2,2)=aggj1(l,4)
5544 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
5545 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
5546 & +0.5d0*(pizda(1,1)+pizda(2,2))
5550 C-------------------------------------------------------------------------------
5551 subroutine eturn4(i,eello_turn4)
5552 C Third- and fourth-order contributions from turns
5553 implicit real*8 (a-h,o-z)
5554 include 'DIMENSIONS'
5555 include 'COMMON.IOUNITS'
5556 include 'COMMON.GEO'
5557 include 'COMMON.VAR'
5558 include 'COMMON.LOCAL'
5559 include 'COMMON.CHAIN'
5560 include 'COMMON.DERIV'
5561 include 'COMMON.INTERACT'
5562 include 'COMMON.CONTACTS'
5563 include 'COMMON.TORSION'
5564 include 'COMMON.VECTORS'
5565 include 'COMMON.FFIELD'
5566 include 'COMMON.CONTROL'
5568 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
5569 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
5570 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
5571 double precision agg(3,4),aggi(3,4),aggi1(3,4),
5572 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
5573 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
5574 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
5577 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5579 C Fourth-order contributions
5587 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5588 cd call checkint_turn4(i,a_temp,eello_turn4_num)
5589 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
5594 iti1=itortyp(itype(i+1))
5595 iti2=itortyp(itype(i+2))
5596 iti3=itortyp(itype(i+3))
5597 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
5598 call transpose2(EUg(1,1,i+1),e1t(1,1))
5599 call transpose2(Eug(1,1,i+2),e2t(1,1))
5600 call transpose2(Eug(1,1,i+3),e3t(1,1))
5601 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5602 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5603 s1=scalar2(b1(1,iti2),auxvec(1))
5604 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5605 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5606 s2=scalar2(b1(1,iti1),auxvec(1))
5607 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5608 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5609 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5610 eello_turn4=eello_turn4-(s1+s2+s3)
5611 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5612 & 'eturn4',i,j,-(s1+s2+s3)
5613 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
5614 cd & ' eello_turn4_num',8*eello_turn4_num
5615 C Derivatives in gamma(i)
5616 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
5617 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
5618 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
5619 s1=scalar2(b1(1,iti2),auxvec(1))
5620 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
5621 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5622 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
5623 C Derivatives in gamma(i+1)
5624 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
5625 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
5626 s2=scalar2(b1(1,iti1),auxvec(1))
5627 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
5628 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
5629 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5630 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
5631 C Derivatives in gamma(i+2)
5632 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
5633 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
5634 s1=scalar2(b1(1,iti2),auxvec(1))
5635 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
5636 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
5637 s2=scalar2(b1(1,iti1),auxvec(1))
5638 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
5639 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
5640 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5641 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
5642 C Cartesian derivatives
5643 C Derivatives of this turn contributions in DC(i+2)
5644 if (j.lt.nres-1) then
5646 a_temp(1,1)=agg(l,1)
5647 a_temp(1,2)=agg(l,2)
5648 a_temp(2,1)=agg(l,3)
5649 a_temp(2,2)=agg(l,4)
5650 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5651 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5652 s1=scalar2(b1(1,iti2),auxvec(1))
5653 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5654 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5655 s2=scalar2(b1(1,iti1),auxvec(1))
5656 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5657 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5658 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5660 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
5663 C Remaining derivatives of this turn contribution
5665 a_temp(1,1)=aggi(l,1)
5666 a_temp(1,2)=aggi(l,2)
5667 a_temp(2,1)=aggi(l,3)
5668 a_temp(2,2)=aggi(l,4)
5669 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5670 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5671 s1=scalar2(b1(1,iti2),auxvec(1))
5672 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5673 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5674 s2=scalar2(b1(1,iti1),auxvec(1))
5675 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5676 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5677 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5678 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
5679 a_temp(1,1)=aggi1(l,1)
5680 a_temp(1,2)=aggi1(l,2)
5681 a_temp(2,1)=aggi1(l,3)
5682 a_temp(2,2)=aggi1(l,4)
5683 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5684 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5685 s1=scalar2(b1(1,iti2),auxvec(1))
5686 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5687 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5688 s2=scalar2(b1(1,iti1),auxvec(1))
5689 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5690 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5691 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5692 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
5693 a_temp(1,1)=aggj(l,1)
5694 a_temp(1,2)=aggj(l,2)
5695 a_temp(2,1)=aggj(l,3)
5696 a_temp(2,2)=aggj(l,4)
5697 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5698 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5699 s1=scalar2(b1(1,iti2),auxvec(1))
5700 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5701 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5702 s2=scalar2(b1(1,iti1),auxvec(1))
5703 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5704 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5705 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5706 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
5707 a_temp(1,1)=aggj1(l,1)
5708 a_temp(1,2)=aggj1(l,2)
5709 a_temp(2,1)=aggj1(l,3)
5710 a_temp(2,2)=aggj1(l,4)
5711 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5712 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5713 s1=scalar2(b1(1,iti2),auxvec(1))
5714 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5715 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5716 s2=scalar2(b1(1,iti1),auxvec(1))
5717 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5718 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5719 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5720 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
5721 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
5725 C-----------------------------------------------------------------------------
5726 subroutine vecpr(u,v,w)
5727 implicit real*8(a-h,o-z)
5728 dimension u(3),v(3),w(3)
5729 w(1)=u(2)*v(3)-u(3)*v(2)
5730 w(2)=-u(1)*v(3)+u(3)*v(1)
5731 w(3)=u(1)*v(2)-u(2)*v(1)
5734 C-----------------------------------------------------------------------------
5735 subroutine unormderiv(u,ugrad,unorm,ungrad)
5736 C This subroutine computes the derivatives of a normalized vector u, given
5737 C the derivatives computed without normalization conditions, ugrad. Returns
5740 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
5741 double precision vec(3)
5742 double precision scalar
5744 c write (2,*) 'ugrad',ugrad
5747 vec(i)=scalar(ugrad(1,i),u(1))
5749 c write (2,*) 'vec',vec
5752 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
5755 c write (2,*) 'ungrad',ungrad
5758 C-----------------------------------------------------------------------------
5759 subroutine escp_soft_sphere(evdw2,evdw2_14)
5761 C This subroutine calculates the excluded-volume interaction energy between
5762 C peptide-group centers and side chains and its gradient in virtual-bond and
5763 C side-chain vectors.
5765 implicit real*8 (a-h,o-z)
5766 include 'DIMENSIONS'
5767 include 'COMMON.GEO'
5768 include 'COMMON.VAR'
5769 include 'COMMON.LOCAL'
5770 include 'COMMON.CHAIN'
5771 include 'COMMON.DERIV'
5772 include 'COMMON.INTERACT'
5773 include 'COMMON.FFIELD'
5774 include 'COMMON.IOUNITS'
5775 include 'COMMON.CONTROL'
5780 cd print '(a)','Enter ESCP'
5781 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
5782 do i=iatscp_s,iatscp_e
5784 xi=0.5D0*(c(1,i)+c(1,i+1))
5785 yi=0.5D0*(c(2,i)+c(2,i+1))
5786 zi=0.5D0*(c(3,i)+c(3,i+1))
5788 do iint=1,nscp_gr(i)
5790 do j=iscpstart(i,iint),iscpend(i,iint)
5792 C Uncomment following three lines for SC-p interactions
5796 C Uncomment following three lines for Ca-p interactions
5800 rij=xj*xj+yj*yj+zj*zj
5803 if (rij.lt.r0ijsq) then
5804 evdwij=0.25d0*(rij-r0ijsq)**2
5812 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5817 cgrad if (j.lt.i) then
5818 cd write (iout,*) 'j<i'
5819 C Uncomment following three lines for SC-p interactions
5821 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5824 cd write (iout,*) 'j>i'
5826 cgrad ggg(k)=-ggg(k)
5827 C Uncomment following line for SC-p interactions
5828 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5832 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5834 cgrad kstart=min0(i+1,j)
5835 cgrad kend=max0(i-1,j-1)
5836 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5837 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5838 cgrad do k=kstart,kend
5840 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5844 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5845 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5853 C-----------------------------------------------------------------------------
5854 subroutine escp(evdw2,evdw2_14)
5856 C This subroutine calculates the excluded-volume interaction energy between
5857 C peptide-group centers and side chains and its gradient in virtual-bond and
5858 C side-chain vectors.
5860 implicit real*8 (a-h,o-z)
5861 include 'DIMENSIONS'
5862 include 'COMMON.GEO'
5863 include 'COMMON.VAR'
5864 include 'COMMON.LOCAL'
5865 include 'COMMON.CHAIN'
5866 include 'COMMON.DERIV'
5867 include 'COMMON.INTERACT'
5868 include 'COMMON.FFIELD'
5869 include 'COMMON.IOUNITS'
5870 include 'COMMON.CONTROL'
5874 cd print '(a)','Enter ESCP'
5875 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
5876 do i=iatscp_s,iatscp_e
5878 xi=0.5D0*(c(1,i)+c(1,i+1))
5879 yi=0.5D0*(c(2,i)+c(2,i+1))
5880 zi=0.5D0*(c(3,i)+c(3,i+1))
5882 do iint=1,nscp_gr(i)
5884 do j=iscpstart(i,iint),iscpend(i,iint)
5886 C Uncomment following three lines for SC-p interactions
5890 C Uncomment following three lines for Ca-p interactions
5894 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5896 e1=fac*fac*aad(itypj,iteli)
5897 e2=fac*bad(itypj,iteli)
5898 if (iabs(j-i) .le. 2) then
5901 evdw2_14=evdw2_14+e1+e2
5905 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5906 & 'evdw2',i,j,evdwij
5908 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5910 fac=-(evdwij+e1)*rrij
5914 cgrad if (j.lt.i) then
5915 cd write (iout,*) 'j<i'
5916 C Uncomment following three lines for SC-p interactions
5918 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5921 cd write (iout,*) 'j>i'
5923 cgrad ggg(k)=-ggg(k)
5924 C Uncomment following line for SC-p interactions
5925 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5926 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5930 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5932 cgrad kstart=min0(i+1,j)
5933 cgrad kend=max0(i-1,j-1)
5934 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5935 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5936 cgrad do k=kstart,kend
5938 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5942 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5943 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5951 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
5952 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
5953 gradx_scp(j,i)=expon*gradx_scp(j,i)
5956 C******************************************************************************
5960 C To save time the factor EXPON has been extracted from ALL components
5961 C of GVDWC and GRADX. Remember to multiply them by this factor before further
5964 C******************************************************************************
5967 C--------------------------------------------------------------------------
5968 subroutine edis(ehpb)
5970 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
5972 implicit real*8 (a-h,o-z)
5973 include 'DIMENSIONS'
5974 include 'COMMON.SBRIDGE'
5975 include 'COMMON.CHAIN'
5976 include 'COMMON.DERIV'
5977 include 'COMMON.VAR'
5978 include 'COMMON.INTERACT'
5979 include 'COMMON.IOUNITS'
5982 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
5983 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
5984 if (link_end.eq.0) return
5985 do i=link_start,link_end
5986 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
5987 C CA-CA distance used in regularization of structure.
5990 C iii and jjj point to the residues for which the distance is assigned.
5991 if (ii.gt.nres) then
5998 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
5999 c & dhpb(i),dhpb1(i),forcon(i)
6000 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
6001 C distance and angle dependent SS bond potential.
6002 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
6003 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
6004 if (.not.dyn_ss .and. i.le.nss) then
6005 C 15/02/13 CC dynamic SSbond - additional check
6007 & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
6008 call ssbond_ene(iii,jjj,eij)
6011 cd write (iout,*) "eij",eij
6012 else if (ii.gt.nres .and. jj.gt.nres) then
6013 c Restraints from contact prediction
6015 if (dhpb1(i).gt.0.0d0) then
6016 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
6017 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
6018 c write (iout,*) "beta nmr",
6019 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
6023 C Get the force constant corresponding to this distance.
6025 C Calculate the contribution to energy.
6026 ehpb=ehpb+waga*rdis*rdis
6027 c write (iout,*) "beta reg",dd,waga*rdis*rdis
6029 C Evaluate gradient.
6034 ggg(j)=fac*(c(j,jj)-c(j,ii))
6037 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
6038 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
6041 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
6042 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
6045 C Calculate the distance between the two points and its difference from the
6048 if (dhpb1(i).gt.0.0d0) then
6049 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
6050 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
6051 c write (iout,*) "alph nmr",
6052 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
6055 C Get the force constant corresponding to this distance.
6057 C Calculate the contribution to energy.
6058 ehpb=ehpb+waga*rdis*rdis
6059 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
6061 C Evaluate gradient.
6065 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
6066 cd & ' waga=',waga,' fac=',fac
6068 ggg(j)=fac*(c(j,jj)-c(j,ii))
6070 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
6071 C If this is a SC-SC distance, we need to calculate the contributions to the
6072 C Cartesian gradient in the SC vectors (ghpbx).
6075 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
6076 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
6079 cgrad do j=iii,jjj-1
6081 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
6085 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
6086 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
6093 C--------------------------------------------------------------------------
6094 subroutine ssbond_ene(i,j,eij)
6096 C Calculate the distance and angle dependent SS-bond potential energy
6097 C using a free-energy function derived based on RHF/6-31G** ab initio
6098 C calculations of diethyl disulfide.
6100 C A. Liwo and U. Kozlowska, 11/24/03
6102 implicit real*8 (a-h,o-z)
6103 include 'DIMENSIONS'
6104 include 'COMMON.SBRIDGE'
6105 include 'COMMON.CHAIN'
6106 include 'COMMON.DERIV'
6107 include 'COMMON.LOCAL'
6108 include 'COMMON.INTERACT'
6109 include 'COMMON.VAR'
6110 include 'COMMON.IOUNITS'
6111 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
6116 dxi=dc_norm(1,nres+i)
6117 dyi=dc_norm(2,nres+i)
6118 dzi=dc_norm(3,nres+i)
6119 c dsci_inv=dsc_inv(itypi)
6120 dsci_inv=vbld_inv(nres+i)
6122 c dscj_inv=dsc_inv(itypj)
6123 dscj_inv=vbld_inv(nres+j)
6127 dxj=dc_norm(1,nres+j)
6128 dyj=dc_norm(2,nres+j)
6129 dzj=dc_norm(3,nres+j)
6130 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
6135 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
6136 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
6137 om12=dxi*dxj+dyi*dyj+dzi*dzj
6139 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
6140 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
6146 deltat12=om2-om1+2.0d0
6148 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
6149 & +akct*deltad*deltat12+ebr
6150 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
6151 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
6152 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
6153 c & " deltat12",deltat12," eij",eij
6154 ed=2*akcm*deltad+akct*deltat12
6156 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
6157 eom1=-2*akth*deltat1-pom1-om2*pom2
6158 eom2= 2*akth*deltat2+pom1-om1*pom2
6161 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
6162 ghpbx(k,i)=ghpbx(k,i)-ggk
6163 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
6164 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
6165 ghpbx(k,j)=ghpbx(k,j)+ggk
6166 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
6167 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
6168 ghpbc(k,i)=ghpbc(k,i)-ggk
6169 ghpbc(k,j)=ghpbc(k,j)+ggk
6172 C Calculate the components of the gradient in DC and X
6176 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
6181 C--------------------------------------------------------------------------
6182 subroutine ebond(estr)
6184 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
6186 implicit real*8 (a-h,o-z)
6187 include 'DIMENSIONS'
6188 include 'COMMON.LOCAL'
6189 include 'COMMON.GEO'
6190 include 'COMMON.INTERACT'
6191 include 'COMMON.DERIV'
6192 include 'COMMON.VAR'
6193 include 'COMMON.CHAIN'
6194 include 'COMMON.IOUNITS'
6195 include 'COMMON.NAMES'
6196 include 'COMMON.FFIELD'
6197 include 'COMMON.CONTROL'
6198 include 'COMMON.SETUP'
6199 double precision u(3),ud(3)
6201 do i=ibondp_start,ibondp_end
6202 diff = vbld(i)-vbldp0
6203 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
6206 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
6208 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
6212 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
6214 do i=ibond_start,ibond_end
6219 diff=vbld(i+nres)-vbldsc0(1,iti)
6220 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
6221 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
6222 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
6224 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
6228 diff=vbld(i+nres)-vbldsc0(j,iti)
6229 ud(j)=aksc(j,iti)*diff
6230 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
6244 uprod2=uprod2*u(k)*u(k)
6248 usumsqder=usumsqder+ud(j)*uprod2
6250 estr=estr+uprod/usum
6252 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
6260 C--------------------------------------------------------------------------
6261 subroutine ebend(etheta)
6263 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
6264 C angles gamma and its derivatives in consecutive thetas and gammas.
6266 implicit real*8 (a-h,o-z)
6267 include 'DIMENSIONS'
6268 include 'COMMON.LOCAL'
6269 include 'COMMON.GEO'
6270 include 'COMMON.INTERACT'
6271 include 'COMMON.DERIV'
6272 include 'COMMON.VAR'
6273 include 'COMMON.CHAIN'
6274 include 'COMMON.IOUNITS'
6275 include 'COMMON.NAMES'
6276 include 'COMMON.FFIELD'
6277 include 'COMMON.CONTROL'
6278 common /calcthet/ term1,term2,termm,diffak,ratak,
6279 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
6280 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6281 double precision y(2),z(2)
6283 c time11=dexp(-2*time)
6286 c write (*,'(a,i2)') 'EBEND ICG=',icg
6287 do i=ithet_start,ithet_end
6288 C Zero the energy function and its derivative at 0 or pi.
6289 call splinthet(theta(i),0.5d0*delta,ss,ssd)
6294 if (phii.ne.phii) phii=150.0
6307 if (phii1.ne.phii1) phii1=150.0
6319 C Calculate the "mean" value of theta from the part of the distribution
6320 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
6321 C In following comments this theta will be referred to as t_c.
6322 thet_pred_mean=0.0d0
6326 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
6328 dthett=thet_pred_mean*ssd
6329 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
6330 C Derivatives of the "mean" values in gamma1 and gamma2.
6331 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
6332 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
6333 if (theta(i).gt.pi-delta) then
6334 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
6336 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
6337 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
6338 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
6340 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
6342 else if (theta(i).lt.delta) then
6343 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
6344 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
6345 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
6347 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
6348 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
6351 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
6354 etheta=etheta+ethetai
6355 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6357 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
6358 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
6359 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
6361 C Ufff.... We've done all this!!!
6364 C---------------------------------------------------------------------------
6365 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
6367 implicit real*8 (a-h,o-z)
6368 include 'DIMENSIONS'
6369 include 'COMMON.LOCAL'
6370 include 'COMMON.IOUNITS'
6371 common /calcthet/ term1,term2,termm,diffak,ratak,
6372 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
6373 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6374 C Calculate the contributions to both Gaussian lobes.
6375 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
6376 C The "polynomial part" of the "standard deviation" of this part of
6380 sig=sig*thet_pred_mean+polthet(j,it)
6382 C Derivative of the "interior part" of the "standard deviation of the"
6383 C gamma-dependent Gaussian lobe in t_c.
6384 sigtc=3*polthet(3,it)
6386 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
6389 C Set the parameters of both Gaussian lobes of the distribution.
6390 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
6391 fac=sig*sig+sigc0(it)
6394 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
6395 sigsqtc=-4.0D0*sigcsq*sigtc
6396 c print *,i,sig,sigtc,sigsqtc
6397 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
6398 sigtc=-sigtc/(fac*fac)
6399 C Following variable is sigma(t_c)**(-2)
6400 sigcsq=sigcsq*sigcsq
6402 sig0inv=1.0D0/sig0i**2
6403 delthec=thetai-thet_pred_mean
6404 delthe0=thetai-theta0i
6405 term1=-0.5D0*sigcsq*delthec*delthec
6406 term2=-0.5D0*sig0inv*delthe0*delthe0
6407 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
6408 C NaNs in taking the logarithm. We extract the largest exponent which is added
6409 C to the energy (this being the log of the distribution) at the end of energy
6410 C term evaluation for this virtual-bond angle.
6411 if (term1.gt.term2) then
6413 term2=dexp(term2-termm)
6417 term1=dexp(term1-termm)
6420 C The ratio between the gamma-independent and gamma-dependent lobes of
6421 C the distribution is a Gaussian function of thet_pred_mean too.
6422 diffak=gthet(2,it)-thet_pred_mean
6423 ratak=diffak/gthet(3,it)**2
6424 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
6425 C Let's differentiate it in thet_pred_mean NOW.
6427 C Now put together the distribution terms to make complete distribution.
6428 termexp=term1+ak*term2
6429 termpre=sigc+ak*sig0i
6430 C Contribution of the bending energy from this theta is just the -log of
6431 C the sum of the contributions from the two lobes and the pre-exponential
6432 C factor. Simple enough, isn't it?
6433 ethetai=(-dlog(termexp)-termm+dlog(termpre))
6434 C NOW the derivatives!!!
6435 C 6/6/97 Take into account the deformation.
6436 E_theta=(delthec*sigcsq*term1
6437 & +ak*delthe0*sig0inv*term2)/termexp
6438 E_tc=((sigtc+aktc*sig0i)/termpre
6439 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
6440 & aktc*term2)/termexp)
6443 c-----------------------------------------------------------------------------
6444 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
6445 implicit real*8 (a-h,o-z)
6446 include 'DIMENSIONS'
6447 include 'COMMON.LOCAL'
6448 include 'COMMON.IOUNITS'
6449 common /calcthet/ term1,term2,termm,diffak,ratak,
6450 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
6451 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6452 delthec=thetai-thet_pred_mean
6453 delthe0=thetai-theta0i
6454 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
6455 t3 = thetai-thet_pred_mean
6459 t14 = t12+t6*sigsqtc
6461 t21 = thetai-theta0i
6467 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
6468 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
6469 & *(-t12*t9-ak*sig0inv*t27)
6473 C--------------------------------------------------------------------------
6474 subroutine ebend(etheta)
6476 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
6477 C angles gamma and its derivatives in consecutive thetas and gammas.
6478 C ab initio-derived potentials from
6479 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
6481 implicit real*8 (a-h,o-z)
6482 include 'DIMENSIONS'
6483 include 'COMMON.LOCAL'
6484 include 'COMMON.GEO'
6485 include 'COMMON.INTERACT'
6486 include 'COMMON.DERIV'
6487 include 'COMMON.VAR'
6488 include 'COMMON.CHAIN'
6489 include 'COMMON.IOUNITS'
6490 include 'COMMON.NAMES'
6491 include 'COMMON.FFIELD'
6492 include 'COMMON.CONTROL'
6493 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
6494 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
6495 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
6496 & sinph1ph2(maxdouble,maxdouble)
6497 logical lprn /.false./, lprn1 /.false./
6499 do i=ithet_start,ithet_end
6503 theti2=0.5d0*theta(i)
6504 ityp2=ithetyp(itype(i-1))
6506 coskt(k)=dcos(k*theti2)
6507 sinkt(k)=dsin(k*theti2)
6512 if (phii.ne.phii) phii=150.0
6516 ityp1=ithetyp(itype(i-2))
6518 cosph1(k)=dcos(k*phii)
6519 sinph1(k)=dsin(k*phii)
6532 if (phii1.ne.phii1) phii1=150.0
6537 ityp3=ithetyp(itype(i))
6539 cosph2(k)=dcos(k*phii1)
6540 sinph2(k)=dsin(k*phii1)
6550 ethetai=aa0thet(ityp1,ityp2,ityp3)
6553 ccl=cosph1(l)*cosph2(k-l)
6554 ssl=sinph1(l)*sinph2(k-l)
6555 scl=sinph1(l)*cosph2(k-l)
6556 csl=cosph1(l)*sinph2(k-l)
6557 cosph1ph2(l,k)=ccl-ssl
6558 cosph1ph2(k,l)=ccl+ssl
6559 sinph1ph2(l,k)=scl+csl
6560 sinph1ph2(k,l)=scl-csl
6564 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
6565 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
6566 write (iout,*) "coskt and sinkt"
6568 write (iout,*) k,coskt(k),sinkt(k)
6572 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
6573 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
6576 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
6577 & " ethetai",ethetai
6580 write (iout,*) "cosph and sinph"
6582 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6584 write (iout,*) "cosph1ph2 and sinph2ph2"
6587 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
6588 & sinph1ph2(l,k),sinph1ph2(k,l)
6591 write(iout,*) "ethetai",ethetai
6595 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
6596 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
6597 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
6598 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
6599 ethetai=ethetai+sinkt(m)*aux
6600 dethetai=dethetai+0.5d0*m*aux*coskt(m)
6601 dephii=dephii+k*sinkt(m)*(
6602 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
6603 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
6604 dephii1=dephii1+k*sinkt(m)*(
6605 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
6606 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
6608 & write (iout,*) "m",m," k",k," bbthet",
6609 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
6610 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
6611 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
6612 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
6616 & write(iout,*) "ethetai",ethetai
6620 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
6621 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
6622 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
6623 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
6624 ethetai=ethetai+sinkt(m)*aux
6625 dethetai=dethetai+0.5d0*m*coskt(m)*aux
6626 dephii=dephii+l*sinkt(m)*(
6627 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
6628 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
6629 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
6630 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
6631 dephii1=dephii1+(k-l)*sinkt(m)*(
6632 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
6633 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
6634 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
6635 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
6637 write (iout,*) "m",m," k",k," l",l," ffthet",
6638 & ffthet(l,k,m,ityp1,ityp2,ityp3),
6639 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
6640 & ggthet(l,k,m,ityp1,ityp2,ityp3),
6641 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
6642 write (iout,*) cosph1ph2(l,k)*sinkt(m),
6643 & cosph1ph2(k,l)*sinkt(m),
6644 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
6650 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
6651 & i,theta(i)*rad2deg,phii*rad2deg,
6652 & phii1*rad2deg,ethetai
6653 etheta=etheta+ethetai
6654 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
6655 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
6656 gloc(nphi+i-2,icg)=wang*dethetai
6662 c-----------------------------------------------------------------------------
6663 subroutine esc(escloc)
6664 C Calculate the local energy of a side chain and its derivatives in the
6665 C corresponding virtual-bond valence angles THETA and the spherical angles
6667 implicit real*8 (a-h,o-z)
6668 include 'DIMENSIONS'
6669 include 'COMMON.GEO'
6670 include 'COMMON.LOCAL'
6671 include 'COMMON.VAR'
6672 include 'COMMON.INTERACT'
6673 include 'COMMON.DERIV'
6674 include 'COMMON.CHAIN'
6675 include 'COMMON.IOUNITS'
6676 include 'COMMON.NAMES'
6677 include 'COMMON.FFIELD'
6678 include 'COMMON.CONTROL'
6679 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
6680 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
6681 common /sccalc/ time11,time12,time112,theti,it,nlobit
6684 c write (iout,'(a)') 'ESC'
6685 do i=loc_start,loc_end
6687 if (it.eq.10) goto 1
6689 c print *,'i=',i,' it=',it,' nlobit=',nlobit
6690 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
6691 theti=theta(i+1)-pipol
6696 if (x(2).gt.pi-delta) then
6700 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6702 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6703 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
6705 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6706 & ddersc0(1),dersc(1))
6707 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
6708 & ddersc0(3),dersc(3))
6710 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6712 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6713 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
6714 & dersc0(2),esclocbi,dersc02)
6715 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6717 call splinthet(x(2),0.5d0*delta,ss,ssd)
6722 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6724 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6725 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6727 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6729 c write (iout,*) escloci
6730 else if (x(2).lt.delta) then
6734 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6736 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6737 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
6739 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6740 & ddersc0(1),dersc(1))
6741 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
6742 & ddersc0(3),dersc(3))
6744 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6746 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6747 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
6748 & dersc0(2),esclocbi,dersc02)
6749 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6754 call splinthet(x(2),0.5d0*delta,ss,ssd)
6756 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6758 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6759 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6761 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6762 c write (iout,*) escloci
6764 call enesc(x,escloci,dersc,ddummy,.false.)
6767 escloc=escloc+escloci
6768 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6769 & 'escloc',i,escloci
6770 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
6772 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
6774 gloc(ialph(i,1),icg)=wscloc*dersc(2)
6775 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
6780 C---------------------------------------------------------------------------
6781 subroutine enesc(x,escloci,dersc,ddersc,mixed)
6782 implicit real*8 (a-h,o-z)
6783 include 'DIMENSIONS'
6784 include 'COMMON.GEO'
6785 include 'COMMON.LOCAL'
6786 include 'COMMON.IOUNITS'
6787 common /sccalc/ time11,time12,time112,theti,it,nlobit
6788 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
6789 double precision contr(maxlob,-1:1)
6791 c write (iout,*) 'it=',it,' nlobit=',nlobit
6795 if (mixed) ddersc(j)=0.0d0
6799 C Because of periodicity of the dependence of the SC energy in omega we have
6800 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
6801 C To avoid underflows, first compute & store the exponents.
6809 z(k)=x(k)-censc(k,j,it)
6814 Axk=Axk+gaussc(l,k,j,it)*z(l)
6820 expfac=expfac+Ax(k,j,iii)*z(k)
6828 C As in the case of ebend, we want to avoid underflows in exponentiation and
6829 C subsequent NaNs and INFs in energy calculation.
6830 C Find the largest exponent
6834 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
6838 cd print *,'it=',it,' emin=',emin
6840 C Compute the contribution to SC energy and derivatives
6845 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
6846 if(adexp.ne.adexp) adexp=1.0
6849 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
6851 cd print *,'j=',j,' expfac=',expfac
6852 escloc_i=escloc_i+expfac
6854 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
6858 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
6859 & +gaussc(k,2,j,it))*expfac
6866 dersc(1)=dersc(1)/cos(theti)**2
6867 ddersc(1)=ddersc(1)/cos(theti)**2
6870 escloci=-(dlog(escloc_i)-emin)
6872 dersc(j)=dersc(j)/escloc_i
6876 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
6881 C------------------------------------------------------------------------------
6882 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
6883 implicit real*8 (a-h,o-z)
6884 include 'DIMENSIONS'
6885 include 'COMMON.GEO'
6886 include 'COMMON.LOCAL'
6887 include 'COMMON.IOUNITS'
6888 common /sccalc/ time11,time12,time112,theti,it,nlobit
6889 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
6890 double precision contr(maxlob)
6901 z(k)=x(k)-censc(k,j,it)
6907 Axk=Axk+gaussc(l,k,j,it)*z(l)
6913 expfac=expfac+Ax(k,j)*z(k)
6918 C As in the case of ebend, we want to avoid underflows in exponentiation and
6919 C subsequent NaNs and INFs in energy calculation.
6920 C Find the largest exponent
6923 if (emin.gt.contr(j)) emin=contr(j)
6927 C Compute the contribution to SC energy and derivatives
6931 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
6932 escloc_i=escloc_i+expfac
6934 dersc(k)=dersc(k)+Ax(k,j)*expfac
6936 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
6937 & +gaussc(1,2,j,it))*expfac
6941 dersc(1)=dersc(1)/cos(theti)**2
6942 dersc12=dersc12/cos(theti)**2
6943 escloci=-(dlog(escloc_i)-emin)
6945 dersc(j)=dersc(j)/escloc_i
6947 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6951 c----------------------------------------------------------------------------------
6952 subroutine esc(escloc)
6953 C Calculate the local energy of a side chain and its derivatives in the
6954 C corresponding virtual-bond valence angles THETA and the spherical angles
6955 C ALPHA and OMEGA derived from AM1 all-atom calculations.
6956 C added by Urszula Kozlowska. 07/11/2007
6958 implicit real*8 (a-h,o-z)
6959 include 'DIMENSIONS'
6960 include 'COMMON.GEO'
6961 include 'COMMON.LOCAL'
6962 include 'COMMON.VAR'
6963 include 'COMMON.SCROT'
6964 include 'COMMON.INTERACT'
6965 include 'COMMON.DERIV'
6966 include 'COMMON.CHAIN'
6967 include 'COMMON.IOUNITS'
6968 include 'COMMON.NAMES'
6969 include 'COMMON.FFIELD'
6970 include 'COMMON.CONTROL'
6971 include 'COMMON.VECTORS'
6972 double precision x_prime(3),y_prime(3),z_prime(3)
6973 & , sumene,dsc_i,dp2_i,x(65),
6974 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
6975 & de_dxx,de_dyy,de_dzz,de_dt
6976 double precision s1_t,s1_6_t,s2_t,s2_6_t
6978 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
6979 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
6980 & dt_dCi(3),dt_dCi1(3)
6981 common /sccalc/ time11,time12,time112,theti,it,nlobit
6984 do i=loc_start,loc_end
6985 costtab(i+1) =dcos(theta(i+1))
6986 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6987 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6988 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6989 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6990 cosfac=dsqrt(cosfac2)
6991 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6992 sinfac=dsqrt(sinfac2)
6994 if (it.eq.10) goto 1
6996 C Compute the axes of tghe local cartesian coordinates system; store in
6997 c x_prime, y_prime and z_prime
7004 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
7005 C & dc_norm(3,i+nres)
7007 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
7008 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
7011 z_prime(j) = -uz(j,i-1)
7014 c write (2,*) "x_prime",(x_prime(j),j=1,3)
7015 c write (2,*) "y_prime",(y_prime(j),j=1,3)
7016 c write (2,*) "z_prime",(z_prime(j),j=1,3)
7017 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
7018 c & " xy",scalar(x_prime(1),y_prime(1)),
7019 c & " xz",scalar(x_prime(1),z_prime(1)),
7020 c & " yy",scalar(y_prime(1),y_prime(1)),
7021 c & " yz",scalar(y_prime(1),z_prime(1)),
7022 c & " zz",scalar(z_prime(1),z_prime(1))
7024 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
7025 C to local coordinate system. Store in xx, yy, zz.
7031 xx = xx + x_prime(j)*dc_norm(j,i+nres)
7032 yy = yy + y_prime(j)*dc_norm(j,i+nres)
7033 zz = zz + z_prime(j)*dc_norm(j,i+nres)
7040 C Compute the energy of the ith side cbain
7042 c write (2,*) "xx",xx," yy",yy," zz",zz
7045 x(j) = sc_parmin(j,it)
7048 Cc diagnostics - remove later
7050 yy1 = dsin(alph(2))*dcos(omeg(2))
7051 zz1 = -dsin(alph(2))*dsin(omeg(2))
7052 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
7053 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
7055 C," --- ", xx_w,yy_w,zz_w
7058 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
7059 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
7061 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
7062 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
7064 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
7065 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
7066 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
7067 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
7068 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
7070 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
7071 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
7072 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
7073 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
7074 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
7076 dsc_i = 0.743d0+x(61)
7078 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
7079 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
7080 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
7081 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
7082 s1=(1+x(63))/(0.1d0 + dscp1)
7083 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
7084 s2=(1+x(65))/(0.1d0 + dscp2)
7085 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
7086 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
7087 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
7088 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
7090 c & dscp1,dscp2,sumene
7091 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
7092 escloc = escloc + sumene
7093 c write (2,*) "i",i," escloc",sumene,escloc
7096 C This section to check the numerical derivatives of the energy of ith side
7097 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
7098 C #define DEBUG in the code to turn it on.
7100 write (2,*) "sumene =",sumene
7104 write (2,*) xx,yy,zz
7105 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
7106 de_dxx_num=(sumenep-sumene)/aincr
7108 write (2,*) "xx+ sumene from enesc=",sumenep
7111 write (2,*) xx,yy,zz
7112 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
7113 de_dyy_num=(sumenep-sumene)/aincr
7115 write (2,*) "yy+ sumene from enesc=",sumenep
7118 write (2,*) xx,yy,zz
7119 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
7120 de_dzz_num=(sumenep-sumene)/aincr
7122 write (2,*) "zz+ sumene from enesc=",sumenep
7123 costsave=cost2tab(i+1)
7124 sintsave=sint2tab(i+1)
7125 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
7126 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
7127 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
7128 de_dt_num=(sumenep-sumene)/aincr
7129 write (2,*) " t+ sumene from enesc=",sumenep
7130 cost2tab(i+1)=costsave
7131 sint2tab(i+1)=sintsave
7132 C End of diagnostics section.
7135 C Compute the gradient of esc
7137 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
7138 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
7139 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
7140 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
7141 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
7142 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
7143 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
7144 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
7145 pom1=(sumene3*sint2tab(i+1)+sumene1)
7146 & *(pom_s1/dscp1+pom_s16*dscp1**4)
7147 pom2=(sumene4*cost2tab(i+1)+sumene2)
7148 & *(pom_s2/dscp2+pom_s26*dscp2**4)
7149 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
7150 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
7151 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
7153 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
7154 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
7155 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
7157 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
7158 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
7159 & +(pom1+pom2)*pom_dx
7161 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
7164 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
7165 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
7166 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
7168 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
7169 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
7170 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
7171 & +x(59)*zz**2 +x(60)*xx*zz
7172 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
7173 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
7174 & +(pom1-pom2)*pom_dy
7176 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
7179 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
7180 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
7181 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
7182 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
7183 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
7184 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
7185 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
7186 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
7188 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
7191 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
7192 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
7193 & +pom1*pom_dt1+pom2*pom_dt2
7195 write(2,*), "de_dt = ", de_dt,de_dt_num
7199 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
7200 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
7201 cosfac2xx=cosfac2*xx
7202 sinfac2yy=sinfac2*yy
7204 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
7206 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
7208 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
7209 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
7210 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
7211 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
7212 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
7213 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
7214 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
7215 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
7216 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
7217 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
7221 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
7222 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
7225 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
7226 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
7227 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
7229 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
7230 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
7234 dXX_Ctab(k,i)=dXX_Ci(k)
7235 dXX_C1tab(k,i)=dXX_Ci1(k)
7236 dYY_Ctab(k,i)=dYY_Ci(k)
7237 dYY_C1tab(k,i)=dYY_Ci1(k)
7238 dZZ_Ctab(k,i)=dZZ_Ci(k)
7239 dZZ_C1tab(k,i)=dZZ_Ci1(k)
7240 dXX_XYZtab(k,i)=dXX_XYZ(k)
7241 dYY_XYZtab(k,i)=dYY_XYZ(k)
7242 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
7246 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
7247 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
7248 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
7249 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
7250 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
7252 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
7253 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
7254 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
7255 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
7256 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
7257 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
7258 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
7259 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
7261 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
7262 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
7264 C to check gradient call subroutine check_grad
7270 c------------------------------------------------------------------------------
7271 double precision function enesc(x,xx,yy,zz,cost2,sint2)
7273 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
7274 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
7275 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
7276 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
7278 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
7279 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
7281 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
7282 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
7283 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
7284 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
7285 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
7287 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
7288 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
7289 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
7290 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
7291 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
7293 dsc_i = 0.743d0+x(61)
7295 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
7296 & *(xx*cost2+yy*sint2))
7297 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
7298 & *(xx*cost2-yy*sint2))
7299 s1=(1+x(63))/(0.1d0 + dscp1)
7300 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
7301 s2=(1+x(65))/(0.1d0 + dscp2)
7302 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
7303 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
7304 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
7309 c------------------------------------------------------------------------------
7310 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
7312 C This procedure calculates two-body contact function g(rij) and its derivative:
7315 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
7318 C where x=(rij-r0ij)/delta
7320 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
7323 double precision rij,r0ij,eps0ij,fcont,fprimcont
7324 double precision x,x2,x4,delta
7328 if (x.lt.-1.0D0) then
7331 else if (x.le.1.0D0) then
7334 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
7335 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
7342 c------------------------------------------------------------------------------
7343 subroutine splinthet(theti,delta,ss,ssder)
7344 implicit real*8 (a-h,o-z)
7345 include 'DIMENSIONS'
7346 include 'COMMON.VAR'
7347 include 'COMMON.GEO'
7350 if (theti.gt.pipol) then
7351 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
7353 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
7358 c------------------------------------------------------------------------------
7359 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
7361 double precision x,x0,delta,f0,f1,fprim0,f,fprim
7362 double precision ksi,ksi2,ksi3,a1,a2,a3
7363 a1=fprim0*delta/(f1-f0)
7369 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
7370 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
7373 c------------------------------------------------------------------------------
7374 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
7376 double precision x,x0,delta,f0x,f1x,fprim0x,fx
7377 double precision ksi,ksi2,ksi3,a1,a2,a3
7382 a2=3*(f1x-f0x)-2*fprim0x*delta
7383 a3=fprim0x*delta-2*(f1x-f0x)
7384 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
7387 C-----------------------------------------------------------------------------
7389 C-----------------------------------------------------------------------------
7390 subroutine etor(etors,edihcnstr)
7391 implicit real*8 (a-h,o-z)
7392 include 'DIMENSIONS'
7393 include 'COMMON.VAR'
7394 include 'COMMON.GEO'
7395 include 'COMMON.LOCAL'
7396 include 'COMMON.TORSION'
7397 include 'COMMON.INTERACT'
7398 include 'COMMON.DERIV'
7399 include 'COMMON.CHAIN'
7400 include 'COMMON.NAMES'
7401 include 'COMMON.IOUNITS'
7402 include 'COMMON.FFIELD'
7403 include 'COMMON.TORCNSTR'
7404 include 'COMMON.CONTROL'
7406 C Set lprn=.true. for debugging
7410 do i=iphi_start,iphi_end
7412 itori=itortyp(itype(i-2))
7413 itori1=itortyp(itype(i-1))
7416 C Proline-Proline pair is a special case...
7417 if (itori.eq.3 .and. itori1.eq.3) then
7418 if (phii.gt.-dwapi3) then
7420 fac=1.0D0/(1.0D0-cosphi)
7421 etorsi=v1(1,3,3)*fac
7422 etorsi=etorsi+etorsi
7423 etors=etors+etorsi-v1(1,3,3)
7424 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
7425 gloci=gloci-3*fac*etorsi*dsin(3*phii)
7428 v1ij=v1(j+1,itori,itori1)
7429 v2ij=v2(j+1,itori,itori1)
7432 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7433 if (energy_dec) etors_ii=etors_ii+
7434 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7435 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7439 v1ij=v1(j,itori,itori1)
7440 v2ij=v2(j,itori,itori1)
7443 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7444 if (energy_dec) etors_ii=etors_ii+
7445 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7446 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7449 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
7452 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7453 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7454 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
7455 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7456 write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7458 ! 6/20/98 - dihedral angle constraints
7461 itori=idih_constr(i)
7464 if (difi.gt.drange(i)) then
7466 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
7467 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
7468 else if (difi.lt.-drange(i)) then
7470 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
7471 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
7473 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
7474 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
7476 ! write (iout,*) 'edihcnstr',edihcnstr
7479 c------------------------------------------------------------------------------
7480 subroutine etor_d(etors_d)
7484 c----------------------------------------------------------------------------
7486 subroutine etor(etors,edihcnstr)
7487 implicit real*8 (a-h,o-z)
7488 include 'DIMENSIONS'
7489 include 'COMMON.VAR'
7490 include 'COMMON.GEO'
7491 include 'COMMON.LOCAL'
7492 include 'COMMON.TORSION'
7493 include 'COMMON.INTERACT'
7494 include 'COMMON.DERIV'
7495 include 'COMMON.CHAIN'
7496 include 'COMMON.NAMES'
7497 include 'COMMON.IOUNITS'
7498 include 'COMMON.FFIELD'
7499 include 'COMMON.TORCNSTR'
7500 include 'COMMON.CONTROL'
7502 C Set lprn=.true. for debugging
7506 do i=iphi_start,iphi_end
7508 itori=itortyp(itype(i-2))
7509 itori1=itortyp(itype(i-1))
7512 C Regular cosine and sine terms
7513 do j=1,nterm(itori,itori1)
7514 v1ij=v1(j,itori,itori1)
7515 v2ij=v2(j,itori,itori1)
7518 etors=etors+v1ij*cosphi+v2ij*sinphi
7519 if (energy_dec) etors_ii=etors_ii+
7520 & v1ij*cosphi+v2ij*sinphi
7521 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7525 C E = SUM ----------------------------------- - v1
7526 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
7528 cosphi=dcos(0.5d0*phii)
7529 sinphi=dsin(0.5d0*phii)
7530 do j=1,nlor(itori,itori1)
7531 vl1ij=vlor1(j,itori,itori1)
7532 vl2ij=vlor2(j,itori,itori1)
7533 vl3ij=vlor3(j,itori,itori1)
7534 pom=vl2ij*cosphi+vl3ij*sinphi
7535 pom1=1.0d0/(pom*pom+1.0d0)
7536 etors=etors+vl1ij*pom1
7537 if (energy_dec) etors_ii=etors_ii+
7540 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
7542 C Subtract the constant term
7543 etors=etors-v0(itori,itori1)
7544 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
7545 & 'etor',i,etors_ii-v0(itori,itori1)
7547 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7548 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7549 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
7550 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7551 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7553 ! 6/20/98 - dihedral angle constraints
7555 c do i=1,ndih_constr
7556 do i=idihconstr_start,idihconstr_end
7557 itori=idih_constr(i)
7559 difi=pinorm(phii-phi0(i))
7560 if (difi.gt.drange(i)) then
7562 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
7563 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
7564 else if (difi.lt.-drange(i)) then
7566 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
7567 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
7571 c write (iout,*) "gloci", gloc(i-3,icg)
7572 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
7573 cd & rad2deg*phi0(i), rad2deg*drange(i),
7574 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
7576 cd write (iout,*) 'edihcnstr',edihcnstr
7579 c----------------------------------------------------------------------------
7580 subroutine etor_d(etors_d)
7581 C 6/23/01 Compute double torsional energy
7582 implicit real*8 (a-h,o-z)
7583 include 'DIMENSIONS'
7584 include 'COMMON.VAR'
7585 include 'COMMON.GEO'
7586 include 'COMMON.LOCAL'
7587 include 'COMMON.TORSION'
7588 include 'COMMON.INTERACT'
7589 include 'COMMON.DERIV'
7590 include 'COMMON.CHAIN'
7591 include 'COMMON.NAMES'
7592 include 'COMMON.IOUNITS'
7593 include 'COMMON.FFIELD'
7594 include 'COMMON.TORCNSTR'
7596 C Set lprn=.true. for debugging
7600 do i=iphid_start,iphid_end
7601 itori=itortyp(itype(i-2))
7602 itori1=itortyp(itype(i-1))
7603 itori2=itortyp(itype(i))
7608 do j=1,ntermd_1(itori,itori1,itori2)
7609 v1cij=v1c(1,j,itori,itori1,itori2)
7610 v1sij=v1s(1,j,itori,itori1,itori2)
7611 v2cij=v1c(2,j,itori,itori1,itori2)
7612 v2sij=v1s(2,j,itori,itori1,itori2)
7613 cosphi1=dcos(j*phii)
7614 sinphi1=dsin(j*phii)
7615 cosphi2=dcos(j*phii1)
7616 sinphi2=dsin(j*phii1)
7617 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
7618 & v2cij*cosphi2+v2sij*sinphi2
7619 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
7620 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
7622 do k=2,ntermd_2(itori,itori1,itori2)
7624 v1cdij = v2c(k,l,itori,itori1,itori2)
7625 v2cdij = v2c(l,k,itori,itori1,itori2)
7626 v1sdij = v2s(k,l,itori,itori1,itori2)
7627 v2sdij = v2s(l,k,itori,itori1,itori2)
7628 cosphi1p2=dcos(l*phii+(k-l)*phii1)
7629 cosphi1m2=dcos(l*phii-(k-l)*phii1)
7630 sinphi1p2=dsin(l*phii+(k-l)*phii1)
7631 sinphi1m2=dsin(l*phii-(k-l)*phii1)
7632 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
7633 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
7634 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
7635 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
7636 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
7637 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
7640 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
7641 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
7642 c write (iout,*) "gloci", gloc(i-3,icg)
7647 c------------------------------------------------------------------------------
7648 subroutine eback_sc_corr(esccor)
7649 c 7/21/2007 Correlations between the backbone-local and side-chain-local
7650 c conformational states; temporarily implemented as differences
7651 c between UNRES torsional potentials (dependent on three types of
7652 c residues) and the torsional potentials dependent on all 20 types
7653 c of residues computed from AM1 energy surfaces of terminally-blocked
7654 c amino-acid residues.
7655 implicit real*8 (a-h,o-z)
7656 include 'DIMENSIONS'
7657 include 'COMMON.VAR'
7658 include 'COMMON.GEO'
7659 include 'COMMON.LOCAL'
7660 include 'COMMON.TORSION'
7661 include 'COMMON.SCCOR'
7662 include 'COMMON.INTERACT'
7663 include 'COMMON.DERIV'
7664 include 'COMMON.CHAIN'
7665 include 'COMMON.NAMES'
7666 include 'COMMON.IOUNITS'
7667 include 'COMMON.FFIELD'
7668 include 'COMMON.CONTROL'
7670 C Set lprn=.true. for debugging
7673 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
7675 do i=itau_start,itau_end
7677 isccori=isccortyp(itype(i-2))
7678 isccori1=isccortyp(itype(i-1))
7680 cccc Added 9 May 2012
7681 cc Tauangle is torsional engle depending on the value of first digit
7682 c(see comment below)
7683 cc Omicron is flat angle depending on the value of first digit
7684 c(see comment below)
7687 do intertyp=1,3 !intertyp
7688 cc Added 09 May 2012 (Adasko)
7689 cc Intertyp means interaction type of backbone mainchain correlation:
7690 c 1 = SC...Ca...Ca...Ca
7691 c 2 = Ca...Ca...Ca...SC
7692 c 3 = SC...Ca...Ca...SCi
7694 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
7695 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
7696 & (itype(i-1).eq.21)))
7697 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
7698 & .or.(itype(i-2).eq.21)))
7699 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
7700 & (itype(i-1).eq.21)))) cycle
7701 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
7702 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
7704 do j=1,nterm_sccor(isccori,isccori1)
7705 v1ij=v1sccor(j,intertyp,isccori,isccori1)
7706 v2ij=v2sccor(j,intertyp,isccori,isccori1)
7707 cosphi=dcos(j*tauangle(intertyp,i))
7708 sinphi=dsin(j*tauangle(intertyp,i))
7709 esccor=esccor+v1ij*cosphi+v2ij*sinphi
7710 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7712 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
7713 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
7714 c &gloc_sc(intertyp,i-3,icg)
7716 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7717 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7718 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
7719 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
7720 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
7724 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
7728 c----------------------------------------------------------------------------
7729 subroutine multibody(ecorr)
7730 C This subroutine calculates multi-body contributions to energy following
7731 C the idea of Skolnick et al. If side chains I and J make a contact and
7732 C at the same time side chains I+1 and J+1 make a contact, an extra
7733 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
7734 implicit real*8 (a-h,o-z)
7735 include 'DIMENSIONS'
7736 include 'COMMON.IOUNITS'
7737 include 'COMMON.DERIV'
7738 include 'COMMON.INTERACT'
7739 include 'COMMON.CONTACTS'
7740 double precision gx(3),gx1(3)
7743 C Set lprn=.true. for debugging
7747 write (iout,'(a)') 'Contact function values:'
7749 write (iout,'(i2,20(1x,i2,f10.5))')
7750 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
7765 num_conti=num_cont(i)
7766 num_conti1=num_cont(i1)
7771 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
7772 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7773 cd & ' ishift=',ishift
7774 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
7775 C The system gains extra energy.
7776 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
7777 endif ! j1==j+-ishift
7786 c------------------------------------------------------------------------------
7787 double precision function esccorr(i,j,k,l,jj,kk)
7788 implicit real*8 (a-h,o-z)
7789 include 'DIMENSIONS'
7790 include 'COMMON.IOUNITS'
7791 include 'COMMON.DERIV'
7792 include 'COMMON.INTERACT'
7793 include 'COMMON.CONTACTS'
7794 double precision gx(3),gx1(3)
7799 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7800 C Calculate the multi-body contribution to energy.
7801 C Calculate multi-body contributions to the gradient.
7802 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7803 cd & k,l,(gacont(m,kk,k),m=1,3)
7805 gx(m) =ekl*gacont(m,jj,i)
7806 gx1(m)=eij*gacont(m,kk,k)
7807 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7808 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7809 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7810 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7814 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7819 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7825 c------------------------------------------------------------------------------
7826 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7827 C This subroutine calculates multi-body contributions to hydrogen-bonding
7828 implicit real*8 (a-h,o-z)
7829 include 'DIMENSIONS'
7830 include 'COMMON.IOUNITS'
7833 parameter (max_cont=maxconts)
7834 parameter (max_dim=26)
7835 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7836 double precision zapas(max_dim,maxconts,max_fg_procs),
7837 & zapas_recv(max_dim,maxconts,max_fg_procs)
7838 common /przechowalnia/ zapas
7839 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7840 & status_array(MPI_STATUS_SIZE,maxconts*2)
7842 include 'COMMON.SETUP'
7843 include 'COMMON.FFIELD'
7844 include 'COMMON.DERIV'
7845 include 'COMMON.INTERACT'
7846 include 'COMMON.CONTACTS'
7847 include 'COMMON.CONTROL'
7848 include 'COMMON.LOCAL'
7849 double precision gx(3),gx1(3),time00
7852 C Set lprn=.true. for debugging
7857 if (nfgtasks.le.1) goto 30
7859 write (iout,'(a)') 'Contact function values before RECEIVE:'
7861 write (iout,'(2i3,50(1x,i2,f5.2))')
7862 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7863 & j=1,num_cont_hb(i))
7867 do i=1,ntask_cont_from
7870 do i=1,ntask_cont_to
7873 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7875 C Make the list of contacts to send to send to other procesors
7876 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
7878 do i=iturn3_start,iturn3_end
7879 c write (iout,*) "make contact list turn3",i," num_cont",
7881 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
7883 do i=iturn4_start,iturn4_end
7884 c write (iout,*) "make contact list turn4",i," num_cont",
7886 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
7890 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7892 do j=1,num_cont_hb(i)
7895 iproc=iint_sent_local(k,jjc,ii)
7896 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7897 if (iproc.gt.0) then
7898 ncont_sent(iproc)=ncont_sent(iproc)+1
7899 nn=ncont_sent(iproc)
7901 zapas(2,nn,iproc)=jjc
7902 zapas(3,nn,iproc)=facont_hb(j,i)
7903 zapas(4,nn,iproc)=ees0p(j,i)
7904 zapas(5,nn,iproc)=ees0m(j,i)
7905 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
7906 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
7907 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
7908 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
7909 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
7910 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
7911 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
7912 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
7913 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
7914 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
7915 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
7916 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
7917 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
7918 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
7919 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
7920 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
7921 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
7922 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
7923 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
7924 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
7925 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
7932 & "Numbers of contacts to be sent to other processors",
7933 & (ncont_sent(i),i=1,ntask_cont_to)
7934 write (iout,*) "Contacts sent"
7935 do ii=1,ntask_cont_to
7937 iproc=itask_cont_to(ii)
7938 write (iout,*) nn," contacts to processor",iproc,
7939 & " of CONT_TO_COMM group"
7941 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7949 CorrelID1=nfgtasks+fg_rank+1
7951 C Receive the numbers of needed contacts from other processors
7952 do ii=1,ntask_cont_from
7953 iproc=itask_cont_from(ii)
7955 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7956 & FG_COMM,req(ireq),IERR)
7958 c write (iout,*) "IRECV ended"
7960 C Send the number of contacts needed by other processors
7961 do ii=1,ntask_cont_to
7962 iproc=itask_cont_to(ii)
7964 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7965 & FG_COMM,req(ireq),IERR)
7967 c write (iout,*) "ISEND ended"
7968 c write (iout,*) "number of requests (nn)",ireq
7971 & call MPI_Waitall(ireq,req,status_array,ierr)
7973 c & "Numbers of contacts to be received from other processors",
7974 c & (ncont_recv(i),i=1,ntask_cont_from)
7978 do ii=1,ntask_cont_from
7979 iproc=itask_cont_from(ii)
7981 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7982 c & " of CONT_TO_COMM group"
7986 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7987 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7988 c write (iout,*) "ireq,req",ireq,req(ireq)
7991 C Send the contacts to processors that need them
7992 do ii=1,ntask_cont_to
7993 iproc=itask_cont_to(ii)
7995 c write (iout,*) nn," contacts to processor",iproc,
7996 c & " of CONT_TO_COMM group"
7999 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
8000 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8001 c write (iout,*) "ireq,req",ireq,req(ireq)
8003 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8007 c write (iout,*) "number of requests (contacts)",ireq
8008 c write (iout,*) "req",(req(i),i=1,4)
8011 & call MPI_Waitall(ireq,req,status_array,ierr)
8012 do iii=1,ntask_cont_from
8013 iproc=itask_cont_from(iii)
8016 write (iout,*) "Received",nn," contacts from processor",iproc,
8017 & " of CONT_FROM_COMM group"
8020 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
8025 ii=zapas_recv(1,i,iii)
8026 c Flag the received contacts to prevent double-counting
8027 jj=-zapas_recv(2,i,iii)
8028 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
8030 nnn=num_cont_hb(ii)+1
8033 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
8034 ees0p(nnn,ii)=zapas_recv(4,i,iii)
8035 ees0m(nnn,ii)=zapas_recv(5,i,iii)
8036 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
8037 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
8038 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
8039 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
8040 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
8041 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
8042 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
8043 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
8044 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
8045 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
8046 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
8047 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
8048 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
8049 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
8050 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
8051 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
8052 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
8053 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
8054 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
8055 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
8056 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
8061 write (iout,'(a)') 'Contact function values after receive:'
8063 write (iout,'(2i3,50(1x,i3,f5.2))')
8064 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8065 & j=1,num_cont_hb(i))
8072 write (iout,'(a)') 'Contact function values:'
8074 write (iout,'(2i3,50(1x,i3,f5.2))')
8075 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8076 & j=1,num_cont_hb(i))
8080 C Remove the loop below after debugging !!!
8087 C Calculate the local-electrostatic correlation terms
8088 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
8090 num_conti=num_cont_hb(i)
8091 num_conti1=num_cont_hb(i+1)
8098 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8099 c & ' jj=',jj,' kk=',kk
8100 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
8101 & .or. j.lt.0 .and. j1.gt.0) .and.
8102 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
8103 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
8104 C The system gains extra energy.
8105 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
8106 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
8107 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
8109 else if (j1.eq.j) then
8110 C Contacts I-J and I-(J+1) occur simultaneously.
8111 C The system loses extra energy.
8112 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
8117 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8118 c & ' jj=',jj,' kk=',kk
8120 C Contacts I-J and (I+1)-J occur simultaneously.
8121 C The system loses extra energy.
8122 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
8129 c------------------------------------------------------------------------------
8130 subroutine add_hb_contact(ii,jj,itask)
8131 implicit real*8 (a-h,o-z)
8132 include "DIMENSIONS"
8133 include "COMMON.IOUNITS"
8136 parameter (max_cont=maxconts)
8137 parameter (max_dim=26)
8138 include "COMMON.CONTACTS"
8139 double precision zapas(max_dim,maxconts,max_fg_procs),
8140 & zapas_recv(max_dim,maxconts,max_fg_procs)
8141 common /przechowalnia/ zapas
8142 integer i,j,ii,jj,iproc,itask(4),nn
8143 c write (iout,*) "itask",itask
8146 if (iproc.gt.0) then
8147 do j=1,num_cont_hb(ii)
8149 c write (iout,*) "i",ii," j",jj," jjc",jjc
8151 ncont_sent(iproc)=ncont_sent(iproc)+1
8152 nn=ncont_sent(iproc)
8153 zapas(1,nn,iproc)=ii
8154 zapas(2,nn,iproc)=jjc
8155 zapas(3,nn,iproc)=facont_hb(j,ii)
8156 zapas(4,nn,iproc)=ees0p(j,ii)
8157 zapas(5,nn,iproc)=ees0m(j,ii)
8158 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
8159 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
8160 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
8161 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
8162 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
8163 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
8164 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
8165 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
8166 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
8167 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
8168 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
8169 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
8170 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
8171 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
8172 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
8173 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
8174 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
8175 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
8176 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
8177 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
8178 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
8186 c------------------------------------------------------------------------------
8187 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
8189 C This subroutine calculates multi-body contributions to hydrogen-bonding
8190 implicit real*8 (a-h,o-z)
8191 include 'DIMENSIONS'
8192 include 'COMMON.IOUNITS'
8195 parameter (max_cont=maxconts)
8196 parameter (max_dim=70)
8197 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
8198 double precision zapas(max_dim,maxconts,max_fg_procs),
8199 & zapas_recv(max_dim,maxconts,max_fg_procs)
8200 common /przechowalnia/ zapas
8201 integer status(MPI_STATUS_SIZE),req(maxconts*2),
8202 & status_array(MPI_STATUS_SIZE,maxconts*2)
8204 include 'COMMON.SETUP'
8205 include 'COMMON.FFIELD'
8206 include 'COMMON.DERIV'
8207 include 'COMMON.LOCAL'
8208 include 'COMMON.INTERACT'
8209 include 'COMMON.CONTACTS'
8210 include 'COMMON.CHAIN'
8211 include 'COMMON.CONTROL'
8212 double precision gx(3),gx1(3)
8213 integer num_cont_hb_old(maxres)
8215 double precision eello4,eello5,eelo6,eello_turn6
8216 external eello4,eello5,eello6,eello_turn6
8217 C Set lprn=.true. for debugging
8222 num_cont_hb_old(i)=num_cont_hb(i)
8226 if (nfgtasks.le.1) goto 30
8228 write (iout,'(a)') 'Contact function values before RECEIVE:'
8230 write (iout,'(2i3,50(1x,i2,f5.2))')
8231 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8232 & j=1,num_cont_hb(i))
8236 do i=1,ntask_cont_from
8239 do i=1,ntask_cont_to
8242 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
8244 C Make the list of contacts to send to send to other procesors
8245 do i=iturn3_start,iturn3_end
8246 c write (iout,*) "make contact list turn3",i," num_cont",
8248 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
8250 do i=iturn4_start,iturn4_end
8251 c write (iout,*) "make contact list turn4",i," num_cont",
8253 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
8257 c write (iout,*) "make contact list longrange",i,ii," num_cont",
8259 do j=1,num_cont_hb(i)
8262 iproc=iint_sent_local(k,jjc,ii)
8263 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
8264 if (iproc.ne.0) then
8265 ncont_sent(iproc)=ncont_sent(iproc)+1
8266 nn=ncont_sent(iproc)
8268 zapas(2,nn,iproc)=jjc
8269 zapas(3,nn,iproc)=d_cont(j,i)
8273 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
8278 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
8286 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
8297 & "Numbers of contacts to be sent to other processors",
8298 & (ncont_sent(i),i=1,ntask_cont_to)
8299 write (iout,*) "Contacts sent"
8300 do ii=1,ntask_cont_to
8302 iproc=itask_cont_to(ii)
8303 write (iout,*) nn," contacts to processor",iproc,
8304 & " of CONT_TO_COMM group"
8306 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
8314 CorrelID1=nfgtasks+fg_rank+1
8316 C Receive the numbers of needed contacts from other processors
8317 do ii=1,ntask_cont_from
8318 iproc=itask_cont_from(ii)
8320 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
8321 & FG_COMM,req(ireq),IERR)
8323 c write (iout,*) "IRECV ended"
8325 C Send the number of contacts needed by other processors
8326 do ii=1,ntask_cont_to
8327 iproc=itask_cont_to(ii)
8329 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
8330 & FG_COMM,req(ireq),IERR)
8332 c write (iout,*) "ISEND ended"
8333 c write (iout,*) "number of requests (nn)",ireq
8336 & call MPI_Waitall(ireq,req,status_array,ierr)
8338 c & "Numbers of contacts to be received from other processors",
8339 c & (ncont_recv(i),i=1,ntask_cont_from)
8343 do ii=1,ntask_cont_from
8344 iproc=itask_cont_from(ii)
8346 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
8347 c & " of CONT_TO_COMM group"
8351 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
8352 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8353 c write (iout,*) "ireq,req",ireq,req(ireq)
8356 C Send the contacts to processors that need them
8357 do ii=1,ntask_cont_to
8358 iproc=itask_cont_to(ii)
8360 c write (iout,*) nn," contacts to processor",iproc,
8361 c & " of CONT_TO_COMM group"
8364 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
8365 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8366 c write (iout,*) "ireq,req",ireq,req(ireq)
8368 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8372 c write (iout,*) "number of requests (contacts)",ireq
8373 c write (iout,*) "req",(req(i),i=1,4)
8376 & call MPI_Waitall(ireq,req,status_array,ierr)
8377 do iii=1,ntask_cont_from
8378 iproc=itask_cont_from(iii)
8381 write (iout,*) "Received",nn," contacts from processor",iproc,
8382 & " of CONT_FROM_COMM group"
8385 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
8390 ii=zapas_recv(1,i,iii)
8391 c Flag the received contacts to prevent double-counting
8392 jj=-zapas_recv(2,i,iii)
8393 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
8395 nnn=num_cont_hb(ii)+1
8398 d_cont(nnn,ii)=zapas_recv(3,i,iii)
8402 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
8407 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
8415 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
8424 write (iout,'(a)') 'Contact function values after receive:'
8426 write (iout,'(2i3,50(1x,i3,5f6.3))')
8427 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
8428 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8435 write (iout,'(a)') 'Contact function values:'
8437 write (iout,'(2i3,50(1x,i2,5f6.3))')
8438 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
8439 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8445 C Remove the loop below after debugging !!!
8452 C Calculate the dipole-dipole interaction energies
8453 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
8454 do i=iatel_s,iatel_e+1
8455 num_conti=num_cont_hb(i)
8464 C Calculate the local-electrostatic correlation terms
8465 c write (iout,*) "gradcorr5 in eello5 before loop"
8467 c write (iout,'(i5,3f10.5)')
8468 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8470 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
8471 c write (iout,*) "corr loop i",i
8473 num_conti=num_cont_hb(i)
8474 num_conti1=num_cont_hb(i+1)
8481 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8482 c & ' jj=',jj,' kk=',kk
8483 c if (j1.eq.j+1 .or. j1.eq.j-1) then
8484 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
8485 & .or. j.lt.0 .and. j1.gt.0) .and.
8486 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
8487 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
8488 C The system gains extra energy.
8490 sqd1=dsqrt(d_cont(jj,i))
8491 sqd2=dsqrt(d_cont(kk,i1))
8492 sred_geom = sqd1*sqd2
8493 IF (sred_geom.lt.cutoff_corr) THEN
8494 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
8496 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
8497 cd & ' jj=',jj,' kk=',kk
8498 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
8499 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
8501 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
8502 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
8505 cd write (iout,*) 'sred_geom=',sred_geom,
8506 cd & ' ekont=',ekont,' fprim=',fprimcont,
8507 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
8508 cd write (iout,*) "g_contij",g_contij
8509 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
8510 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
8511 call calc_eello(i,jp,i+1,jp1,jj,kk)
8512 if (wcorr4.gt.0.0d0)
8513 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
8514 if (energy_dec.and.wcorr4.gt.0.0d0)
8515 1 write (iout,'(a6,4i5,0pf7.3)')
8516 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
8517 c write (iout,*) "gradcorr5 before eello5"
8519 c write (iout,'(i5,3f10.5)')
8520 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8522 if (wcorr5.gt.0.0d0)
8523 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
8524 c write (iout,*) "gradcorr5 after eello5"
8526 c write (iout,'(i5,3f10.5)')
8527 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8529 if (energy_dec.and.wcorr5.gt.0.0d0)
8530 1 write (iout,'(a6,4i5,0pf7.3)')
8531 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
8532 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
8533 cd write(2,*)'ijkl',i,jp,i+1,jp1
8534 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
8535 & .or. wturn6.eq.0.0d0))then
8536 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
8537 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
8538 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
8539 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
8540 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
8541 cd & 'ecorr6=',ecorr6
8542 cd write (iout,'(4e15.5)') sred_geom,
8543 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
8544 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
8545 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
8546 else if (wturn6.gt.0.0d0
8547 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
8548 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
8549 eturn6=eturn6+eello_turn6(i,jj,kk)
8550 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
8551 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
8552 cd write (2,*) 'multibody_eello:eturn6',eturn6
8561 num_cont_hb(i)=num_cont_hb_old(i)
8563 c write (iout,*) "gradcorr5 in eello5"
8565 c write (iout,'(i5,3f10.5)')
8566 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8570 c------------------------------------------------------------------------------
8571 subroutine add_hb_contact_eello(ii,jj,itask)
8572 implicit real*8 (a-h,o-z)
8573 include "DIMENSIONS"
8574 include "COMMON.IOUNITS"
8577 parameter (max_cont=maxconts)
8578 parameter (max_dim=70)
8579 include "COMMON.CONTACTS"
8580 double precision zapas(max_dim,maxconts,max_fg_procs),
8581 & zapas_recv(max_dim,maxconts,max_fg_procs)
8582 common /przechowalnia/ zapas
8583 integer i,j,ii,jj,iproc,itask(4),nn
8584 c write (iout,*) "itask",itask
8587 if (iproc.gt.0) then
8588 do j=1,num_cont_hb(ii)
8590 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
8592 ncont_sent(iproc)=ncont_sent(iproc)+1
8593 nn=ncont_sent(iproc)
8594 zapas(1,nn,iproc)=ii
8595 zapas(2,nn,iproc)=jjc
8596 zapas(3,nn,iproc)=d_cont(j,ii)
8600 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
8605 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
8613 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
8625 c------------------------------------------------------------------------------
8626 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
8627 implicit real*8 (a-h,o-z)
8628 include 'DIMENSIONS'
8629 include 'COMMON.IOUNITS'
8630 include 'COMMON.DERIV'
8631 include 'COMMON.INTERACT'
8632 include 'COMMON.CONTACTS'
8633 double precision gx(3),gx1(3)
8643 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
8644 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
8645 C Following 4 lines for diagnostics.
8650 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
8651 c & 'Contacts ',i,j,
8652 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
8653 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
8655 C Calculate the multi-body contribution to energy.
8656 c ecorr=ecorr+ekont*ees
8657 C Calculate multi-body contributions to the gradient.
8658 coeffpees0pij=coeffp*ees0pij
8659 coeffmees0mij=coeffm*ees0mij
8660 coeffpees0pkl=coeffp*ees0pkl
8661 coeffmees0mkl=coeffm*ees0mkl
8663 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
8664 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
8665 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
8666 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
8667 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
8668 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
8669 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
8670 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
8671 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
8672 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
8673 & coeffmees0mij*gacontm_hb1(ll,kk,k))
8674 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
8675 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
8676 & coeffmees0mij*gacontm_hb2(ll,kk,k))
8677 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
8678 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
8679 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
8680 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
8681 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
8682 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
8683 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
8684 & coeffmees0mij*gacontm_hb3(ll,kk,k))
8685 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
8686 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
8687 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
8692 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8693 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
8694 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
8695 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
8700 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8701 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
8702 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
8703 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
8706 c write (iout,*) "ehbcorr",ekont*ees
8711 C---------------------------------------------------------------------------
8712 subroutine dipole(i,j,jj)
8713 implicit real*8 (a-h,o-z)
8714 include 'DIMENSIONS'
8715 include 'COMMON.IOUNITS'
8716 include 'COMMON.CHAIN'
8717 include 'COMMON.FFIELD'
8718 include 'COMMON.DERIV'
8719 include 'COMMON.INTERACT'
8720 include 'COMMON.CONTACTS'
8721 include 'COMMON.TORSION'
8722 include 'COMMON.VAR'
8723 include 'COMMON.GEO'
8724 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
8726 iti1 = itortyp(itype(i+1))
8727 if (j.lt.nres-1) then
8728 itj1 = itortyp(itype(j+1))
8733 dipi(iii,1)=Ub2(iii,i)
8734 dipderi(iii)=Ub2der(iii,i)
8735 dipi(iii,2)=b1(iii,iti1)
8736 dipj(iii,1)=Ub2(iii,j)
8737 dipderj(iii)=Ub2der(iii,j)
8738 dipj(iii,2)=b1(iii,itj1)
8742 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
8745 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8752 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
8756 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8761 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
8762 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
8764 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
8766 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
8768 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
8773 C---------------------------------------------------------------------------
8774 subroutine calc_eello(i,j,k,l,jj,kk)
8776 C This subroutine computes matrices and vectors needed to calculate
8777 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
8779 implicit real*8 (a-h,o-z)
8780 include 'DIMENSIONS'
8781 include 'COMMON.IOUNITS'
8782 include 'COMMON.CHAIN'
8783 include 'COMMON.DERIV'
8784 include 'COMMON.INTERACT'
8785 include 'COMMON.CONTACTS'
8786 include 'COMMON.TORSION'
8787 include 'COMMON.VAR'
8788 include 'COMMON.GEO'
8789 include 'COMMON.FFIELD'
8790 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
8791 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
8794 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
8795 cd & ' jj=',jj,' kk=',kk
8796 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
8797 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
8798 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
8801 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
8802 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
8805 call transpose2(aa1(1,1),aa1t(1,1))
8806 call transpose2(aa2(1,1),aa2t(1,1))
8809 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
8810 & aa1tder(1,1,lll,kkk))
8811 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
8812 & aa2tder(1,1,lll,kkk))
8816 C parallel orientation of the two CA-CA-CA frames.
8818 iti=itortyp(itype(i))
8822 itk1=itortyp(itype(k+1))
8823 itj=itortyp(itype(j))
8824 if (l.lt.nres-1) then
8825 itl1=itortyp(itype(l+1))
8829 C A1 kernel(j+1) A2T
8831 cd write (iout,'(3f10.5,5x,3f10.5)')
8832 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
8834 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8835 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
8836 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8837 C Following matrices are needed only for 6-th order cumulants
8838 IF (wcorr6.gt.0.0d0) THEN
8839 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8840 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
8841 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8842 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8843 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
8844 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8845 & ADtEAderx(1,1,1,1,1,1))
8847 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8848 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
8849 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8850 & ADtEA1derx(1,1,1,1,1,1))
8852 C End 6-th order cumulants
8855 cd write (2,*) 'In calc_eello6'
8857 cd write (2,*) 'iii=',iii
8859 cd write (2,*) 'kkk=',kkk
8861 cd write (2,'(3(2f10.5),5x)')
8862 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8867 call transpose2(EUgder(1,1,k),auxmat(1,1))
8868 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8869 call transpose2(EUg(1,1,k),auxmat(1,1))
8870 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8871 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8875 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8876 & EAEAderx(1,1,lll,kkk,iii,1))
8880 C A1T kernel(i+1) A2
8881 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8882 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
8883 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8884 C Following matrices are needed only for 6-th order cumulants
8885 IF (wcorr6.gt.0.0d0) THEN
8886 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8887 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
8888 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8889 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8890 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
8891 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8892 & ADtEAderx(1,1,1,1,1,2))
8893 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8894 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
8895 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8896 & ADtEA1derx(1,1,1,1,1,2))
8898 C End 6-th order cumulants
8899 call transpose2(EUgder(1,1,l),auxmat(1,1))
8900 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
8901 call transpose2(EUg(1,1,l),auxmat(1,1))
8902 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8903 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8907 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8908 & EAEAderx(1,1,lll,kkk,iii,2))
8913 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8914 C They are needed only when the fifth- or the sixth-order cumulants are
8916 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
8917 call transpose2(AEA(1,1,1),auxmat(1,1))
8918 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
8919 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8920 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8921 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8922 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
8923 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8924 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
8925 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
8926 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8927 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8928 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8929 call transpose2(AEA(1,1,2),auxmat(1,1))
8930 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
8931 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
8932 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
8933 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8934 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
8935 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
8936 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
8937 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
8938 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
8939 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
8940 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
8941 C Calculate the Cartesian derivatives of the vectors.
8945 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8946 call matvec2(auxmat(1,1),b1(1,iti),
8947 & AEAb1derx(1,lll,kkk,iii,1,1))
8948 call matvec2(auxmat(1,1),Ub2(1,i),
8949 & AEAb2derx(1,lll,kkk,iii,1,1))
8950 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8951 & AEAb1derx(1,lll,kkk,iii,2,1))
8952 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8953 & AEAb2derx(1,lll,kkk,iii,2,1))
8954 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8955 call matvec2(auxmat(1,1),b1(1,itj),
8956 & AEAb1derx(1,lll,kkk,iii,1,2))
8957 call matvec2(auxmat(1,1),Ub2(1,j),
8958 & AEAb2derx(1,lll,kkk,iii,1,2))
8959 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8960 & AEAb1derx(1,lll,kkk,iii,2,2))
8961 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
8962 & AEAb2derx(1,lll,kkk,iii,2,2))
8969 C Antiparallel orientation of the two CA-CA-CA frames.
8971 iti=itortyp(itype(i))
8975 itk1=itortyp(itype(k+1))
8976 itl=itortyp(itype(l))
8977 itj=itortyp(itype(j))
8978 if (j.lt.nres-1) then
8979 itj1=itortyp(itype(j+1))
8983 C A2 kernel(j-1)T A1T
8984 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8985 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
8986 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8987 C Following matrices are needed only for 6-th order cumulants
8988 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8989 & j.eq.i+4 .and. l.eq.i+3)) THEN
8990 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8991 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
8992 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8993 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8994 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
8995 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8996 & ADtEAderx(1,1,1,1,1,1))
8997 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8998 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
8999 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
9000 & ADtEA1derx(1,1,1,1,1,1))
9002 C End 6-th order cumulants
9003 call transpose2(EUgder(1,1,k),auxmat(1,1))
9004 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
9005 call transpose2(EUg(1,1,k),auxmat(1,1))
9006 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
9007 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
9011 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
9012 & EAEAderx(1,1,lll,kkk,iii,1))
9016 C A2T kernel(i+1)T A1
9017 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9018 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
9019 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
9020 C Following matrices are needed only for 6-th order cumulants
9021 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
9022 & j.eq.i+4 .and. l.eq.i+3)) THEN
9023 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9024 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
9025 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
9026 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9027 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
9028 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
9029 & ADtEAderx(1,1,1,1,1,2))
9030 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9031 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
9032 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
9033 & ADtEA1derx(1,1,1,1,1,2))
9035 C End 6-th order cumulants
9036 call transpose2(EUgder(1,1,j),auxmat(1,1))
9037 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
9038 call transpose2(EUg(1,1,j),auxmat(1,1))
9039 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
9040 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
9044 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9045 & EAEAderx(1,1,lll,kkk,iii,2))
9050 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
9051 C They are needed only when the fifth- or the sixth-order cumulants are
9053 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
9054 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
9055 call transpose2(AEA(1,1,1),auxmat(1,1))
9056 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
9057 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
9058 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
9059 call transpose2(AEAderg(1,1,1),auxmat(1,1))
9060 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
9061 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
9062 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
9063 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
9064 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
9065 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
9066 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
9067 call transpose2(AEA(1,1,2),auxmat(1,1))
9068 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
9069 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
9070 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
9071 call transpose2(AEAderg(1,1,2),auxmat(1,1))
9072 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
9073 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
9074 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
9075 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
9076 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
9077 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
9078 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
9079 C Calculate the Cartesian derivatives of the vectors.
9083 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
9084 call matvec2(auxmat(1,1),b1(1,iti),
9085 & AEAb1derx(1,lll,kkk,iii,1,1))
9086 call matvec2(auxmat(1,1),Ub2(1,i),
9087 & AEAb2derx(1,lll,kkk,iii,1,1))
9088 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
9089 & AEAb1derx(1,lll,kkk,iii,2,1))
9090 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
9091 & AEAb2derx(1,lll,kkk,iii,2,1))
9092 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
9093 call matvec2(auxmat(1,1),b1(1,itl),
9094 & AEAb1derx(1,lll,kkk,iii,1,2))
9095 call matvec2(auxmat(1,1),Ub2(1,l),
9096 & AEAb2derx(1,lll,kkk,iii,1,2))
9097 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
9098 & AEAb1derx(1,lll,kkk,iii,2,2))
9099 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
9100 & AEAb2derx(1,lll,kkk,iii,2,2))
9109 C---------------------------------------------------------------------------
9110 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
9111 & KK,KKderg,AKA,AKAderg,AKAderx)
9115 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
9116 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
9117 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
9122 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
9124 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
9127 cd if (lprn) write (2,*) 'In kernel'
9129 cd if (lprn) write (2,*) 'kkk=',kkk
9131 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
9132 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
9134 cd write (2,*) 'lll=',lll
9135 cd write (2,*) 'iii=1'
9137 cd write (2,'(3(2f10.5),5x)')
9138 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
9141 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
9142 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
9144 cd write (2,*) 'lll=',lll
9145 cd write (2,*) 'iii=2'
9147 cd write (2,'(3(2f10.5),5x)')
9148 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
9155 C---------------------------------------------------------------------------
9156 double precision function eello4(i,j,k,l,jj,kk)
9157 implicit real*8 (a-h,o-z)
9158 include 'DIMENSIONS'
9159 include 'COMMON.IOUNITS'
9160 include 'COMMON.CHAIN'
9161 include 'COMMON.DERIV'
9162 include 'COMMON.INTERACT'
9163 include 'COMMON.CONTACTS'
9164 include 'COMMON.TORSION'
9165 include 'COMMON.VAR'
9166 include 'COMMON.GEO'
9167 double precision pizda(2,2),ggg1(3),ggg2(3)
9168 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
9172 cd print *,'eello4:',i,j,k,l,jj,kk
9173 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
9174 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
9175 cold eij=facont_hb(jj,i)
9176 cold ekl=facont_hb(kk,k)
9178 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
9179 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
9180 gcorr_loc(k-1)=gcorr_loc(k-1)
9181 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
9183 gcorr_loc(l-1)=gcorr_loc(l-1)
9184 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9186 gcorr_loc(j-1)=gcorr_loc(j-1)
9187 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9192 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
9193 & -EAEAderx(2,2,lll,kkk,iii,1)
9194 cd derx(lll,kkk,iii)=0.0d0
9198 cd gcorr_loc(l-1)=0.0d0
9199 cd gcorr_loc(j-1)=0.0d0
9200 cd gcorr_loc(k-1)=0.0d0
9202 cd write (iout,*)'Contacts have occurred for peptide groups',
9203 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
9204 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
9205 if (j.lt.nres-1) then
9212 if (l.lt.nres-1) then
9220 cgrad ggg1(ll)=eel4*g_contij(ll,1)
9221 cgrad ggg2(ll)=eel4*g_contij(ll,2)
9222 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
9223 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
9224 cgrad ghalf=0.5d0*ggg1(ll)
9225 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
9226 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
9227 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
9228 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
9229 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
9230 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
9231 cgrad ghalf=0.5d0*ggg2(ll)
9232 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
9233 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
9234 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
9235 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
9236 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
9237 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
9241 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
9246 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
9251 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
9256 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
9260 cd write (2,*) iii,gcorr_loc(iii)
9263 cd write (2,*) 'ekont',ekont
9264 cd write (iout,*) 'eello4',ekont*eel4
9267 C---------------------------------------------------------------------------
9268 double precision function eello5(i,j,k,l,jj,kk)
9269 implicit real*8 (a-h,o-z)
9270 include 'DIMENSIONS'
9271 include 'COMMON.IOUNITS'
9272 include 'COMMON.CHAIN'
9273 include 'COMMON.DERIV'
9274 include 'COMMON.INTERACT'
9275 include 'COMMON.CONTACTS'
9276 include 'COMMON.TORSION'
9277 include 'COMMON.VAR'
9278 include 'COMMON.GEO'
9279 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
9280 double precision ggg1(3),ggg2(3)
9281 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9286 C /l\ / \ \ / \ / \ / C
9287 C / \ / \ \ / \ / \ / C
9288 C j| o |l1 | o | o| o | | o |o C
9289 C \ |/k\| |/ \| / |/ \| |/ \| C
9290 C \i/ \ / \ / / \ / \ C
9292 C (I) (II) (III) (IV) C
9294 C eello5_1 eello5_2 eello5_3 eello5_4 C
9296 C Antiparallel chains C
9299 C /j\ / \ \ / \ / \ / C
9300 C / \ / \ \ / \ / \ / C
9301 C j1| o |l | o | o| o | | o |o C
9302 C \ |/k\| |/ \| / |/ \| |/ \| C
9303 C \i/ \ / \ / / \ / \ C
9305 C (I) (II) (III) (IV) C
9307 C eello5_1 eello5_2 eello5_3 eello5_4 C
9309 C o denotes a local interaction, vertical lines an electrostatic interaction. C
9311 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9312 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
9317 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
9319 itk=itortyp(itype(k))
9320 itl=itortyp(itype(l))
9321 itj=itortyp(itype(j))
9326 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
9327 cd & eel5_3_num,eel5_4_num)
9331 derx(lll,kkk,iii)=0.0d0
9335 cd eij=facont_hb(jj,i)
9336 cd ekl=facont_hb(kk,k)
9338 cd write (iout,*)'Contacts have occurred for peptide groups',
9339 cd & i,j,' fcont:',eij,' eij',' and ',k,l
9341 C Contribution from the graph I.
9342 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
9343 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
9344 call transpose2(EUg(1,1,k),auxmat(1,1))
9345 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
9346 vv(1)=pizda(1,1)-pizda(2,2)
9347 vv(2)=pizda(1,2)+pizda(2,1)
9348 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
9349 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9350 C Explicit gradient in virtual-dihedral angles.
9351 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
9352 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
9353 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
9354 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9355 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
9356 vv(1)=pizda(1,1)-pizda(2,2)
9357 vv(2)=pizda(1,2)+pizda(2,1)
9358 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9359 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
9360 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9361 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
9362 vv(1)=pizda(1,1)-pizda(2,2)
9363 vv(2)=pizda(1,2)+pizda(2,1)
9365 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
9366 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
9367 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9369 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
9370 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
9371 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9373 C Cartesian gradient
9377 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
9379 vv(1)=pizda(1,1)-pizda(2,2)
9380 vv(2)=pizda(1,2)+pizda(2,1)
9381 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9382 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
9383 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9389 C Contribution from graph II
9390 call transpose2(EE(1,1,itk),auxmat(1,1))
9391 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
9392 vv(1)=pizda(1,1)+pizda(2,2)
9393 vv(2)=pizda(2,1)-pizda(1,2)
9394 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
9395 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
9396 C Explicit gradient in virtual-dihedral angles.
9397 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9398 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
9399 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
9400 vv(1)=pizda(1,1)+pizda(2,2)
9401 vv(2)=pizda(2,1)-pizda(1,2)
9403 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9404 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
9405 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
9407 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9408 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
9409 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
9411 C Cartesian gradient
9415 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
9417 vv(1)=pizda(1,1)+pizda(2,2)
9418 vv(2)=pizda(2,1)-pizda(1,2)
9419 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9420 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
9421 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
9429 C Parallel orientation
9430 C Contribution from graph III
9431 call transpose2(EUg(1,1,l),auxmat(1,1))
9432 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9433 vv(1)=pizda(1,1)-pizda(2,2)
9434 vv(2)=pizda(1,2)+pizda(2,1)
9435 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
9436 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
9437 C Explicit gradient in virtual-dihedral angles.
9438 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9439 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
9440 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
9441 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9442 vv(1)=pizda(1,1)-pizda(2,2)
9443 vv(2)=pizda(1,2)+pizda(2,1)
9444 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9445 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
9446 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
9447 call transpose2(EUgder(1,1,l),auxmat1(1,1))
9448 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9449 vv(1)=pizda(1,1)-pizda(2,2)
9450 vv(2)=pizda(1,2)+pizda(2,1)
9451 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9452 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
9453 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
9454 C Cartesian gradient
9458 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
9460 vv(1)=pizda(1,1)-pizda(2,2)
9461 vv(2)=pizda(1,2)+pizda(2,1)
9462 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9463 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
9464 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
9469 C Contribution from graph IV
9471 call transpose2(EE(1,1,itl),auxmat(1,1))
9472 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9473 vv(1)=pizda(1,1)+pizda(2,2)
9474 vv(2)=pizda(2,1)-pizda(1,2)
9475 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
9476 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
9477 C Explicit gradient in virtual-dihedral angles.
9478 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9479 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
9480 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9481 vv(1)=pizda(1,1)+pizda(2,2)
9482 vv(2)=pizda(2,1)-pizda(1,2)
9483 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9484 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
9485 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
9486 C Cartesian gradient
9490 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9492 vv(1)=pizda(1,1)+pizda(2,2)
9493 vv(2)=pizda(2,1)-pizda(1,2)
9494 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9495 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
9496 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
9501 C Antiparallel orientation
9502 C Contribution from graph III
9504 call transpose2(EUg(1,1,j),auxmat(1,1))
9505 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9506 vv(1)=pizda(1,1)-pizda(2,2)
9507 vv(2)=pizda(1,2)+pizda(2,1)
9508 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
9509 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9510 C Explicit gradient in virtual-dihedral angles.
9511 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9512 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
9513 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
9514 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9515 vv(1)=pizda(1,1)-pizda(2,2)
9516 vv(2)=pizda(1,2)+pizda(2,1)
9517 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9518 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
9519 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9520 call transpose2(EUgder(1,1,j),auxmat1(1,1))
9521 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9522 vv(1)=pizda(1,1)-pizda(2,2)
9523 vv(2)=pizda(1,2)+pizda(2,1)
9524 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9525 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
9526 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9527 C Cartesian gradient
9531 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
9533 vv(1)=pizda(1,1)-pizda(2,2)
9534 vv(2)=pizda(1,2)+pizda(2,1)
9535 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9536 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
9537 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9542 C Contribution from graph IV
9544 call transpose2(EE(1,1,itj),auxmat(1,1))
9545 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9546 vv(1)=pizda(1,1)+pizda(2,2)
9547 vv(2)=pizda(2,1)-pizda(1,2)
9548 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
9549 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9550 C Explicit gradient in virtual-dihedral angles.
9551 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9552 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
9553 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9554 vv(1)=pizda(1,1)+pizda(2,2)
9555 vv(2)=pizda(2,1)-pizda(1,2)
9556 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9557 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
9558 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
9559 C Cartesian gradient
9563 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9565 vv(1)=pizda(1,1)+pizda(2,2)
9566 vv(2)=pizda(2,1)-pizda(1,2)
9567 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9568 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
9569 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9575 eel5=eello5_1+eello5_2+eello5_3+eello5_4
9576 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
9577 cd write (2,*) 'ijkl',i,j,k,l
9578 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
9579 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
9581 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
9582 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
9583 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
9584 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
9585 if (j.lt.nres-1) then
9592 if (l.lt.nres-1) then
9602 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
9603 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
9604 C summed up outside the subrouine as for the other subroutines
9605 C handling long-range interactions. The old code is commented out
9606 C with "cgrad" to keep track of changes.
9608 cgrad ggg1(ll)=eel5*g_contij(ll,1)
9609 cgrad ggg2(ll)=eel5*g_contij(ll,2)
9610 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
9611 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
9612 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
9613 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
9614 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
9615 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
9616 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
9617 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
9619 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
9620 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
9621 cgrad ghalf=0.5d0*ggg1(ll)
9623 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
9624 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
9625 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
9626 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
9627 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
9628 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
9629 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
9630 cgrad ghalf=0.5d0*ggg2(ll)
9632 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
9633 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
9634 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
9635 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
9636 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
9637 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
9642 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
9643 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
9648 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
9649 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
9655 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
9660 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
9664 cd write (2,*) iii,g_corr5_loc(iii)
9667 cd write (2,*) 'ekont',ekont
9668 cd write (iout,*) 'eello5',ekont*eel5
9671 c--------------------------------------------------------------------------
9672 double precision function eello6(i,j,k,l,jj,kk)
9673 implicit real*8 (a-h,o-z)
9674 include 'DIMENSIONS'
9675 include 'COMMON.IOUNITS'
9676 include 'COMMON.CHAIN'
9677 include 'COMMON.DERIV'
9678 include 'COMMON.INTERACT'
9679 include 'COMMON.CONTACTS'
9680 include 'COMMON.TORSION'
9681 include 'COMMON.VAR'
9682 include 'COMMON.GEO'
9683 include 'COMMON.FFIELD'
9684 double precision ggg1(3),ggg2(3)
9685 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9690 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9698 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
9699 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
9703 derx(lll,kkk,iii)=0.0d0
9707 cd eij=facont_hb(jj,i)
9708 cd ekl=facont_hb(kk,k)
9714 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9715 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
9716 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
9717 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9718 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
9719 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
9721 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9722 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
9723 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
9724 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9725 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
9726 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9730 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
9732 C If turn contributions are considered, they will be handled separately.
9733 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
9734 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
9735 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
9736 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
9737 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
9738 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
9739 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
9741 if (j.lt.nres-1) then
9748 if (l.lt.nres-1) then
9756 cgrad ggg1(ll)=eel6*g_contij(ll,1)
9757 cgrad ggg2(ll)=eel6*g_contij(ll,2)
9758 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
9759 cgrad ghalf=0.5d0*ggg1(ll)
9761 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
9762 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
9763 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
9764 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
9765 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
9766 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
9767 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
9768 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
9769 cgrad ghalf=0.5d0*ggg2(ll)
9770 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
9772 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
9773 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
9774 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
9775 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
9776 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
9777 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
9782 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
9783 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
9788 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
9789 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
9795 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
9800 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
9804 cd write (2,*) iii,g_corr6_loc(iii)
9807 cd write (2,*) 'ekont',ekont
9808 cd write (iout,*) 'eello6',ekont*eel6
9811 c--------------------------------------------------------------------------
9812 double precision function eello6_graph1(i,j,k,l,imat,swap)
9813 implicit real*8 (a-h,o-z)
9814 include 'DIMENSIONS'
9815 include 'COMMON.IOUNITS'
9816 include 'COMMON.CHAIN'
9817 include 'COMMON.DERIV'
9818 include 'COMMON.INTERACT'
9819 include 'COMMON.CONTACTS'
9820 include 'COMMON.TORSION'
9821 include 'COMMON.VAR'
9822 include 'COMMON.GEO'
9823 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
9827 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9829 C Parallel Antiparallel
9835 C \ j|/k\| / \ |/k\|l /
9840 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9841 itk=itortyp(itype(k))
9842 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
9843 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
9844 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
9845 call transpose2(EUgC(1,1,k),auxmat(1,1))
9846 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9847 vv1(1)=pizda1(1,1)-pizda1(2,2)
9848 vv1(2)=pizda1(1,2)+pizda1(2,1)
9849 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9850 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
9851 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
9852 s5=scalar2(vv(1),Dtobr2(1,i))
9853 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
9854 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
9855 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
9856 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
9857 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
9858 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
9859 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
9860 & +scalar2(vv(1),Dtobr2der(1,i)))
9861 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
9862 vv1(1)=pizda1(1,1)-pizda1(2,2)
9863 vv1(2)=pizda1(1,2)+pizda1(2,1)
9864 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
9865 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
9867 g_corr6_loc(l-1)=g_corr6_loc(l-1)
9868 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9869 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9870 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9871 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9873 g_corr6_loc(j-1)=g_corr6_loc(j-1)
9874 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9875 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9876 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9877 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9879 call transpose2(EUgCder(1,1,k),auxmat(1,1))
9880 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9881 vv1(1)=pizda1(1,1)-pizda1(2,2)
9882 vv1(2)=pizda1(1,2)+pizda1(2,1)
9883 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
9884 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
9885 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
9886 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
9895 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
9896 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
9897 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
9898 call transpose2(EUgC(1,1,k),auxmat(1,1))
9899 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9901 vv1(1)=pizda1(1,1)-pizda1(2,2)
9902 vv1(2)=pizda1(1,2)+pizda1(2,1)
9903 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9904 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
9905 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
9906 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
9907 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
9908 s5=scalar2(vv(1),Dtobr2(1,i))
9909 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
9915 c----------------------------------------------------------------------------
9916 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
9917 implicit real*8 (a-h,o-z)
9918 include 'DIMENSIONS'
9919 include 'COMMON.IOUNITS'
9920 include 'COMMON.CHAIN'
9921 include 'COMMON.DERIV'
9922 include 'COMMON.INTERACT'
9923 include 'COMMON.CONTACTS'
9924 include 'COMMON.TORSION'
9925 include 'COMMON.VAR'
9926 include 'COMMON.GEO'
9928 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9929 & auxvec1(2),auxvec2(2),auxmat1(2,2)
9932 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9934 C Parallel Antiparallel C
9940 C \ j|/k\| \ |/k\|l C
9945 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9946 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
9947 C AL 7/4/01 s1 would occur in the sixth-order moment,
9948 C but not in a cluster cumulant
9950 s1=dip(1,jj,i)*dip(1,kk,k)
9952 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
9953 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9954 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
9955 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
9956 call transpose2(EUg(1,1,k),auxmat(1,1))
9957 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
9958 vv(1)=pizda(1,1)-pizda(2,2)
9959 vv(2)=pizda(1,2)+pizda(2,1)
9960 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9961 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9963 eello6_graph2=-(s1+s2+s3+s4)
9965 eello6_graph2=-(s2+s3+s4)
9968 C Derivatives in gamma(i-1)
9971 s1=dipderg(1,jj,i)*dip(1,kk,k)
9973 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9974 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
9975 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9976 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9978 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9980 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9982 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
9984 C Derivatives in gamma(k-1)
9986 s1=dip(1,jj,i)*dipderg(1,kk,k)
9988 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
9989 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9990 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
9991 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9992 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9993 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
9994 vv(1)=pizda(1,1)-pizda(2,2)
9995 vv(2)=pizda(1,2)+pizda(2,1)
9996 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9998 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
10000 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
10002 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
10003 C Derivatives in gamma(j-1) or gamma(l-1)
10006 s1=dipderg(3,jj,i)*dip(1,kk,k)
10008 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
10009 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10010 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
10011 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
10012 vv(1)=pizda(1,1)-pizda(2,2)
10013 vv(2)=pizda(1,2)+pizda(2,1)
10014 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10017 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
10019 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
10022 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
10023 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
10025 C Derivatives in gamma(l-1) or gamma(j-1)
10028 s1=dip(1,jj,i)*dipderg(3,kk,k)
10030 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
10031 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10032 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
10033 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10034 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
10035 vv(1)=pizda(1,1)-pizda(2,2)
10036 vv(2)=pizda(1,2)+pizda(2,1)
10037 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10040 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
10042 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
10045 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
10046 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
10048 C Cartesian derivatives.
10050 write (2,*) 'In eello6_graph2'
10052 write (2,*) 'iii=',iii
10054 write (2,*) 'kkk=',kkk
10056 write (2,'(3(2f10.5),5x)')
10057 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
10067 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
10069 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
10072 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
10074 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
10075 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
10077 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
10078 call transpose2(EUg(1,1,k),auxmat(1,1))
10079 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
10081 vv(1)=pizda(1,1)-pizda(2,2)
10082 vv(2)=pizda(1,2)+pizda(2,1)
10083 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10084 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
10086 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10088 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10091 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10093 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10100 c----------------------------------------------------------------------------
10101 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
10102 implicit real*8 (a-h,o-z)
10103 include 'DIMENSIONS'
10104 include 'COMMON.IOUNITS'
10105 include 'COMMON.CHAIN'
10106 include 'COMMON.DERIV'
10107 include 'COMMON.INTERACT'
10108 include 'COMMON.CONTACTS'
10109 include 'COMMON.TORSION'
10110 include 'COMMON.VAR'
10111 include 'COMMON.GEO'
10112 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
10114 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10116 C Parallel Antiparallel C
10121 C /| o |o o| o |\ C
10122 C j|/k\| / |/k\|l / C
10127 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10129 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
10130 C energy moment and not to the cluster cumulant.
10131 iti=itortyp(itype(i))
10132 if (j.lt.nres-1) then
10133 itj1=itortyp(itype(j+1))
10137 itk=itortyp(itype(k))
10138 itk1=itortyp(itype(k+1))
10139 if (l.lt.nres-1) then
10140 itl1=itortyp(itype(l+1))
10145 s1=dip(4,jj,i)*dip(4,kk,k)
10147 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
10148 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
10149 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
10150 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
10151 call transpose2(EE(1,1,itk),auxmat(1,1))
10152 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
10153 vv(1)=pizda(1,1)+pizda(2,2)
10154 vv(2)=pizda(2,1)-pizda(1,2)
10155 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10156 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
10157 cd & "sum",-(s2+s3+s4)
10159 eello6_graph3=-(s1+s2+s3+s4)
10161 eello6_graph3=-(s2+s3+s4)
10163 c eello6_graph3=-s4
10164 C Derivatives in gamma(k-1)
10165 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
10166 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
10167 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
10168 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
10169 C Derivatives in gamma(l-1)
10170 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
10171 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
10172 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
10173 vv(1)=pizda(1,1)+pizda(2,2)
10174 vv(2)=pizda(2,1)-pizda(1,2)
10175 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10176 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10177 C Cartesian derivatives.
10183 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
10185 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
10188 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
10190 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
10191 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
10193 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
10194 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
10196 vv(1)=pizda(1,1)+pizda(2,2)
10197 vv(2)=pizda(2,1)-pizda(1,2)
10198 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10200 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10202 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10205 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10207 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10209 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
10215 c----------------------------------------------------------------------------
10216 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
10217 implicit real*8 (a-h,o-z)
10218 include 'DIMENSIONS'
10219 include 'COMMON.IOUNITS'
10220 include 'COMMON.CHAIN'
10221 include 'COMMON.DERIV'
10222 include 'COMMON.INTERACT'
10223 include 'COMMON.CONTACTS'
10224 include 'COMMON.TORSION'
10225 include 'COMMON.VAR'
10226 include 'COMMON.GEO'
10227 include 'COMMON.FFIELD'
10228 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
10229 & auxvec1(2),auxmat1(2,2)
10231 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10233 C Parallel Antiparallel C
10238 C /| o |o o| o |\ C
10239 C \ j|/k\| \ |/k\|l C
10244 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10246 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
10247 C energy moment and not to the cluster cumulant.
10248 cd write (2,*) 'eello_graph4: wturn6',wturn6
10249 iti=itortyp(itype(i))
10250 itj=itortyp(itype(j))
10251 if (j.lt.nres-1) then
10252 itj1=itortyp(itype(j+1))
10256 itk=itortyp(itype(k))
10257 if (k.lt.nres-1) then
10258 itk1=itortyp(itype(k+1))
10262 itl=itortyp(itype(l))
10263 if (l.lt.nres-1) then
10264 itl1=itortyp(itype(l+1))
10268 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
10269 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
10270 cd & ' itl',itl,' itl1',itl1
10272 if (imat.eq.1) then
10273 s1=dip(3,jj,i)*dip(3,kk,k)
10275 s1=dip(2,jj,j)*dip(2,kk,l)
10278 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
10279 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10281 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
10282 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
10284 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
10285 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
10287 call transpose2(EUg(1,1,k),auxmat(1,1))
10288 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
10289 vv(1)=pizda(1,1)-pizda(2,2)
10290 vv(2)=pizda(2,1)+pizda(1,2)
10291 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10292 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
10294 eello6_graph4=-(s1+s2+s3+s4)
10296 eello6_graph4=-(s2+s3+s4)
10298 C Derivatives in gamma(i-1)
10301 if (imat.eq.1) then
10302 s1=dipderg(2,jj,i)*dip(3,kk,k)
10304 s1=dipderg(4,jj,j)*dip(2,kk,l)
10307 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
10309 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
10310 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
10312 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
10313 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
10315 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
10316 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10317 cd write (2,*) 'turn6 derivatives'
10319 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
10321 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
10325 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
10327 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
10331 C Derivatives in gamma(k-1)
10333 if (imat.eq.1) then
10334 s1=dip(3,jj,i)*dipderg(2,kk,k)
10336 s1=dip(2,jj,j)*dipderg(4,kk,l)
10339 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
10340 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
10342 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
10343 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
10345 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
10346 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
10348 call transpose2(EUgder(1,1,k),auxmat1(1,1))
10349 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
10350 vv(1)=pizda(1,1)-pizda(2,2)
10351 vv(2)=pizda(2,1)+pizda(1,2)
10352 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10353 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10355 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
10357 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
10361 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
10363 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
10366 C Derivatives in gamma(j-1) or gamma(l-1)
10367 if (l.eq.j+1 .and. l.gt.1) then
10368 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10369 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10370 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10371 vv(1)=pizda(1,1)-pizda(2,2)
10372 vv(2)=pizda(2,1)+pizda(1,2)
10373 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10374 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10375 else if (j.gt.1) then
10376 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10377 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10378 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10379 vv(1)=pizda(1,1)-pizda(2,2)
10380 vv(2)=pizda(2,1)+pizda(1,2)
10381 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10382 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10383 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
10385 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
10388 C Cartesian derivatives.
10394 if (imat.eq.1) then
10395 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
10397 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
10400 if (imat.eq.1) then
10401 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
10403 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
10407 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
10409 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10411 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
10412 & b1(1,itj1),auxvec(1))
10413 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
10415 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
10416 & b1(1,itl1),auxvec(1))
10417 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
10419 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
10421 vv(1)=pizda(1,1)-pizda(2,2)
10422 vv(2)=pizda(2,1)+pizda(1,2)
10423 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10425 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10427 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
10430 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
10433 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
10436 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
10438 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
10440 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10444 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10446 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10449 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10451 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10459 c----------------------------------------------------------------------------
10460 double precision function eello_turn6(i,jj,kk)
10461 implicit real*8 (a-h,o-z)
10462 include 'DIMENSIONS'
10463 include 'COMMON.IOUNITS'
10464 include 'COMMON.CHAIN'
10465 include 'COMMON.DERIV'
10466 include 'COMMON.INTERACT'
10467 include 'COMMON.CONTACTS'
10468 include 'COMMON.TORSION'
10469 include 'COMMON.VAR'
10470 include 'COMMON.GEO'
10471 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
10472 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
10474 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
10475 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
10476 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
10477 C the respective energy moment and not to the cluster cumulant.
10486 iti=itortyp(itype(i))
10487 itk=itortyp(itype(k))
10488 itk1=itortyp(itype(k+1))
10489 itl=itortyp(itype(l))
10490 itj=itortyp(itype(j))
10491 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
10492 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
10493 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
10498 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
10500 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
10504 derx_turn(lll,kkk,iii)=0.0d0
10511 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
10513 cd write (2,*) 'eello6_5',eello6_5
10515 call transpose2(AEA(1,1,1),auxmat(1,1))
10516 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
10517 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
10518 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
10520 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
10521 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
10522 s2 = scalar2(b1(1,itk),vtemp1(1))
10524 call transpose2(AEA(1,1,2),atemp(1,1))
10525 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
10526 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
10527 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10529 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
10530 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
10531 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
10533 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
10534 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
10535 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
10536 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
10537 ss13 = scalar2(b1(1,itk),vtemp4(1))
10538 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
10540 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
10546 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
10547 C Derivatives in gamma(i+2)
10551 call transpose2(AEA(1,1,1),auxmatd(1,1))
10552 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10553 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10554 call transpose2(AEAderg(1,1,2),atempd(1,1))
10555 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10556 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10558 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
10559 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10560 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10566 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
10567 C Derivatives in gamma(i+3)
10569 call transpose2(AEA(1,1,1),auxmatd(1,1))
10570 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10571 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
10572 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
10574 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
10575 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
10576 s2d = scalar2(b1(1,itk),vtemp1d(1))
10578 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
10579 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
10581 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
10583 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
10584 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10585 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10593 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10594 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10596 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10597 & -0.5d0*ekont*(s2d+s12d)
10599 C Derivatives in gamma(i+4)
10600 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
10601 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10602 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10604 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
10605 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
10606 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10614 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
10616 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
10618 C Derivatives in gamma(i+5)
10620 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
10621 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10622 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10624 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
10625 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
10626 s2d = scalar2(b1(1,itk),vtemp1d(1))
10628 call transpose2(AEA(1,1,2),atempd(1,1))
10629 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
10630 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10632 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
10633 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10635 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
10636 ss13d = scalar2(b1(1,itk),vtemp4d(1))
10637 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10645 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10646 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10648 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10649 & -0.5d0*ekont*(s2d+s12d)
10651 C Cartesian derivatives
10656 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
10657 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10658 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10660 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
10661 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
10663 s2d = scalar2(b1(1,itk),vtemp1d(1))
10665 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
10666 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10667 s8d = -(atempd(1,1)+atempd(2,2))*
10668 & scalar2(cc(1,1,itl),vtemp2(1))
10670 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
10672 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10673 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10680 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10681 & - 0.5d0*(s1d+s2d)
10683 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10687 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10688 & - 0.5d0*(s8d+s12d)
10690 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10699 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
10700 & achuj_tempd(1,1))
10701 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
10702 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10703 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
10704 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
10705 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
10707 ss13d = scalar2(b1(1,itk),vtemp4d(1))
10708 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10709 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
10713 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
10714 cd & 16*eel_turn6_num
10716 if (j.lt.nres-1) then
10723 if (l.lt.nres-1) then
10731 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
10732 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
10733 cgrad ghalf=0.5d0*ggg1(ll)
10735 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
10736 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
10737 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
10738 & +ekont*derx_turn(ll,2,1)
10739 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
10740 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
10741 & +ekont*derx_turn(ll,4,1)
10742 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
10743 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
10744 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
10745 cgrad ghalf=0.5d0*ggg2(ll)
10747 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
10748 & +ekont*derx_turn(ll,2,2)
10749 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
10750 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
10751 & +ekont*derx_turn(ll,4,2)
10752 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
10753 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
10754 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
10759 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
10764 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
10770 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
10775 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
10779 cd write (2,*) iii,g_corr6_loc(iii)
10781 eello_turn6=ekont*eel_turn6
10782 cd write (2,*) 'ekont',ekont
10783 cd write (2,*) 'eel_turn6',ekont*eel_turn6
10787 C-----------------------------------------------------------------------------
10788 double precision function scalar(u,v)
10789 !DIR$ INLINEALWAYS scalar
10791 cDEC$ ATTRIBUTES FORCEINLINE::scalar
10794 double precision u(3),v(3)
10795 cd double precision sc
10803 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
10806 crc-------------------------------------------------
10807 SUBROUTINE MATVEC2(A1,V1,V2)
10808 !DIR$ INLINEALWAYS MATVEC2
10810 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
10812 implicit real*8 (a-h,o-z)
10813 include 'DIMENSIONS'
10814 DIMENSION A1(2,2),V1(2),V2(2)
10818 c 3 VI=VI+A1(I,K)*V1(K)
10822 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
10823 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
10828 C---------------------------------------
10829 SUBROUTINE MATMAT2(A1,A2,A3)
10831 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
10833 implicit real*8 (a-h,o-z)
10834 include 'DIMENSIONS'
10835 DIMENSION A1(2,2),A2(2,2),A3(2,2)
10836 c DIMENSION AI3(2,2)
10840 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
10846 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
10847 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
10848 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
10849 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
10857 c-------------------------------------------------------------------------
10858 double precision function scalar2(u,v)
10859 !DIR$ INLINEALWAYS scalar2
10861 double precision u(2),v(2)
10862 double precision sc
10864 scalar2=u(1)*v(1)+u(2)*v(2)
10868 C-----------------------------------------------------------------------------
10870 subroutine transpose2(a,at)
10871 !DIR$ INLINEALWAYS transpose2
10873 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
10876 double precision a(2,2),at(2,2)
10883 c--------------------------------------------------------------------------
10884 subroutine transpose(n,a,at)
10887 double precision a(n,n),at(n,n)
10895 C---------------------------------------------------------------------------
10896 subroutine prodmat3(a1,a2,kk,transp,prod)
10897 !DIR$ INLINEALWAYS prodmat3
10899 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
10903 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
10905 crc double precision auxmat(2,2),prod_(2,2)
10908 crc call transpose2(kk(1,1),auxmat(1,1))
10909 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
10910 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10912 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
10913 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
10914 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
10915 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
10916 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
10917 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
10918 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
10919 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
10922 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
10923 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10925 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
10926 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
10927 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
10928 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
10929 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
10930 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
10931 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
10932 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
10935 c call transpose2(a2(1,1),a2t(1,1))
10938 crc print *,((prod_(i,j),i=1,2),j=1,2)
10939 crc print *,((prod(i,j),i=1,2),j=1,2)