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.
4214 if (i.gt. nnt+2 .and. i.lt.nct+2) then
4215 iti = itortyp(itype(i-2))
4219 if (i.gt. nnt+1 .and. i.lt.nct+1) then
4220 iti1 = itortyp(itype(i-1))
4224 b1(1,i-2)=bnew1(1,1,iti)*sin(theta(i-1)/2.0)
4225 & +bnew1(2,1,iti)*sin(theta(i-1))
4226 & +bnew1(3,1,iti)*cos(theta(i-1)/2.0)
4227 b2(1,i-2)=bnew2(1,1,iti)*sin(theta(i-1)/2.0)
4228 & +bnew2(2,1,iti)*sin(theta(i-1))
4229 & +bnew2(3,1,iti)*cos(theta(i-1)/2.0)
4230 b1(2,i-2)=bnew1(1,2,iti)
4231 b2(2,i-2)=bnew2(1,2,iti)
4233 write (iout,*) "i",i," iti",iti," theta",theta(i-1)
4234 write (iout,*) "bnew1",bnew1(1,1,iti),bnew1(2,1,iti),
4235 & bnew1(3,1,iti),bnew1(1,2,iti)
4236 write (iout,*) "bnew2",bnew2(1,1,iti),bnew2(2,1,iti),
4237 & bnew2(3,1,iti),bnew2(1,2,iti)
4239 EE(1,1,i-2)=eenew(1,iti)*dcos(theta(i-1))
4240 EE(1,2,i-2)=eeold(1,2,iti)
4241 EE(2,1,i-2)=eeold(2,1,iti)
4242 EE(2,2,i-2)=eeold(2,2,iti)
4243 b1tilde(1,i-2)=b1(1,i-2)
4244 b1tilde(2,i-2)=-b1(2,i-2)
4249 do i=ivec_start+2,ivec_end+2
4253 if (i .lt. nres+1) then
4290 if (i .gt. 3 .and. i .lt. nres+1) then
4291 obrot_der(1,i-2)=-sin1
4292 obrot_der(2,i-2)= cos1
4293 Ugder(1,1,i-2)= sin1
4294 Ugder(1,2,i-2)=-cos1
4295 Ugder(2,1,i-2)=-cos1
4296 Ugder(2,2,i-2)=-sin1
4299 obrot2_der(1,i-2)=-dwasin2
4300 obrot2_der(2,i-2)= dwacos2
4301 Ug2der(1,1,i-2)= dwasin2
4302 Ug2der(1,2,i-2)=-dwacos2
4303 Ug2der(2,1,i-2)=-dwacos2
4304 Ug2der(2,2,i-2)=-dwasin2
4306 obrot_der(1,i-2)=0.0d0
4307 obrot_der(2,i-2)=0.0d0
4308 Ugder(1,1,i-2)=0.0d0
4309 Ugder(1,2,i-2)=0.0d0
4310 Ugder(2,1,i-2)=0.0d0
4311 Ugder(2,2,i-2)=0.0d0
4312 obrot2_der(1,i-2)=0.0d0
4313 obrot2_der(2,i-2)=0.0d0
4314 Ug2der(1,1,i-2)=0.0d0
4315 Ug2der(1,2,i-2)=0.0d0
4316 Ug2der(2,1,i-2)=0.0d0
4317 Ug2der(2,2,i-2)=0.0d0
4319 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
4320 if (i.gt. nnt+2 .and. i.lt.nct+2) then
4321 iti = itortyp(itype(i-2))
4325 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
4326 if (i.gt. nnt+1 .and. i.lt.nct+1) then
4327 iti1 = itortyp(itype(i-1))
4331 cd write (iout,*) '*******i',i,' iti1',iti
4332 cd write (iout,*) 'b1',b1(:,i-2)
4333 cd write (iout,*) 'b2',b2(:,i-2)
4334 cd write (iout,*) 'Ug',Ug(:,:,i-2)
4335 c if (i .gt. iatel_s+2) then
4336 if (i .gt. nnt+2) then
4337 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
4338 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
4339 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
4341 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
4342 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
4343 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
4344 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
4345 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
4356 DtUg2(l,k,i-2)=0.0d0
4360 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
4361 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
4363 muder(k,i-2)=Ub2der(k,i-2)
4365 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
4366 if (i.gt. nnt+1 .and. i.lt.nct+1) then
4367 iti1 = itortyp(itype(i-1))
4372 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
4374 cd write (iout,*) 'mu ',mu(:,i-2)
4375 cd write (iout,*) 'mu1',mu1(:,i-2)
4376 cd write (iout,*) 'mu2',mu2(:,i-2)
4377 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
4379 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
4380 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
4381 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
4382 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
4383 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
4384 C Vectors and matrices dependent on a single virtual-bond dihedral.
4385 call matvec2(DD(1,1,iti),b1tilde(1,i-1),auxvec(1))
4386 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
4387 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
4388 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
4389 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
4390 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
4391 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
4392 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
4393 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
4396 C Matrices dependent on two consecutive virtual-bond dihedrals.
4397 C The order of matrices is from left to right.
4398 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
4400 c do i=max0(ivec_start,2),ivec_end
4402 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
4403 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
4404 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
4405 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
4406 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
4407 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
4408 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
4409 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
4412 #if defined(MPI) && defined(PARMAT)
4414 c if (fg_rank.eq.0) then
4415 write (iout,*) "Arrays UG and UGDER before GATHER"
4417 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
4418 & ((ug(l,k,i),l=1,2),k=1,2),
4419 & ((ugder(l,k,i),l=1,2),k=1,2)
4421 write (iout,*) "Arrays UG2 and UG2DER"
4423 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
4424 & ((ug2(l,k,i),l=1,2),k=1,2),
4425 & ((ug2der(l,k,i),l=1,2),k=1,2)
4427 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
4429 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
4430 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
4431 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
4433 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
4435 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
4436 & costab(i),sintab(i),costab2(i),sintab2(i)
4438 write (iout,*) "Array MUDER"
4440 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
4444 if (nfgtasks.gt.1) then
4446 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
4447 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
4448 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
4450 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
4451 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
4453 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
4454 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
4456 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
4457 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
4459 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
4460 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
4462 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
4463 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
4465 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
4466 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
4468 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
4469 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
4470 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
4471 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
4472 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
4473 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
4474 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
4475 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
4476 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
4477 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
4478 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
4479 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
4480 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
4482 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
4483 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
4485 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
4486 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
4488 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
4489 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
4491 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
4492 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
4494 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
4495 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
4497 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
4498 & ivec_count(fg_rank1),
4499 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
4501 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
4502 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
4504 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
4505 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
4507 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
4508 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
4510 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
4511 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
4513 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
4514 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
4516 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
4517 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
4519 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
4520 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
4522 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
4523 & ivec_count(fg_rank1),
4524 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
4526 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
4527 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
4529 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
4530 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
4532 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
4533 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
4535 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
4536 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
4538 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
4539 & ivec_count(fg_rank1),
4540 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
4542 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
4543 & ivec_count(fg_rank1),
4544 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
4546 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
4547 & ivec_count(fg_rank1),
4548 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
4549 & MPI_MAT2,FG_COMM1,IERR)
4550 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
4551 & ivec_count(fg_rank1),
4552 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
4553 & MPI_MAT2,FG_COMM1,IERR)
4556 c Passes matrix info through the ring
4559 if (irecv.lt.0) irecv=nfgtasks1-1
4562 if (inext.ge.nfgtasks1) inext=0
4564 c write (iout,*) "isend",isend," irecv",irecv
4566 lensend=lentyp(isend)
4567 lenrecv=lentyp(irecv)
4568 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
4569 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
4570 c & MPI_ROTAT1(lensend),inext,2200+isend,
4571 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
4572 c & iprev,2200+irecv,FG_COMM,status,IERR)
4573 c write (iout,*) "Gather ROTAT1"
4575 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
4576 c & MPI_ROTAT2(lensend),inext,3300+isend,
4577 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
4578 c & iprev,3300+irecv,FG_COMM,status,IERR)
4579 c write (iout,*) "Gather ROTAT2"
4581 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
4582 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
4583 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
4584 & iprev,4400+irecv,FG_COMM,status,IERR)
4585 c write (iout,*) "Gather ROTAT_OLD"
4587 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
4588 & MPI_PRECOMP11(lensend),inext,5500+isend,
4589 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
4590 & iprev,5500+irecv,FG_COMM,status,IERR)
4591 c write (iout,*) "Gather PRECOMP11"
4593 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
4594 & MPI_PRECOMP12(lensend),inext,6600+isend,
4595 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
4596 & iprev,6600+irecv,FG_COMM,status,IERR)
4597 c write (iout,*) "Gather PRECOMP12"
4599 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
4601 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
4602 & MPI_ROTAT2(lensend),inext,7700+isend,
4603 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
4604 & iprev,7700+irecv,FG_COMM,status,IERR)
4605 c write (iout,*) "Gather PRECOMP21"
4607 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
4608 & MPI_PRECOMP22(lensend),inext,8800+isend,
4609 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
4610 & iprev,8800+irecv,FG_COMM,status,IERR)
4611 c write (iout,*) "Gather PRECOMP22"
4613 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
4614 & MPI_PRECOMP23(lensend),inext,9900+isend,
4615 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
4616 & MPI_PRECOMP23(lenrecv),
4617 & iprev,9900+irecv,FG_COMM,status,IERR)
4618 c write (iout,*) "Gather PRECOMP23"
4623 if (irecv.lt.0) irecv=nfgtasks1-1
4626 time_gather=time_gather+MPI_Wtime()-time00
4629 c if (fg_rank.eq.0) then
4630 write (iout,*) "Arrays UG and UGDER"
4632 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
4633 & ((ug(l,k,i),l=1,2),k=1,2),
4634 & ((ugder(l,k,i),l=1,2),k=1,2)
4636 write (iout,*) "Arrays UG2 and UG2DER"
4638 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
4639 & ((ug2(l,k,i),l=1,2),k=1,2),
4640 & ((ug2der(l,k,i),l=1,2),k=1,2)
4642 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
4644 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
4645 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
4646 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
4648 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
4650 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
4651 & costab(i),sintab(i),costab2(i),sintab2(i)
4653 write (iout,*) "Array MUDER"
4655 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
4661 cd iti = itortyp(itype(i))
4664 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
4665 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
4670 C--------------------------------------------------------------------------
4671 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
4673 C This subroutine calculates the average interaction energy and its gradient
4674 C in the virtual-bond vectors between non-adjacent peptide groups, based on
4675 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
4676 C The potential depends both on the distance of peptide-group centers and on
4677 C the orientation of the CA-CA virtual bonds.
4679 implicit real*8 (a-h,o-z)
4683 include 'DIMENSIONS'
4684 include 'COMMON.CONTROL'
4685 include 'COMMON.SETUP'
4686 include 'COMMON.IOUNITS'
4687 include 'COMMON.GEO'
4688 include 'COMMON.VAR'
4689 include 'COMMON.LOCAL'
4690 include 'COMMON.CHAIN'
4691 include 'COMMON.DERIV'
4692 include 'COMMON.INTERACT'
4693 include 'COMMON.CONTACTS'
4694 include 'COMMON.TORSION'
4695 include 'COMMON.VECTORS'
4696 include 'COMMON.FFIELD'
4697 include 'COMMON.TIME1'
4698 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
4699 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
4700 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
4701 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
4702 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4703 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4705 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
4707 double precision scal_el /1.0d0/
4709 double precision scal_el /0.5d0/
4712 C 13-go grudnia roku pamietnego...
4713 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
4714 & 0.0d0,1.0d0,0.0d0,
4715 & 0.0d0,0.0d0,1.0d0/
4716 cd write(iout,*) 'In EELEC'
4718 cd write(iout,*) 'Type',i
4719 cd write(iout,*) 'B1',B1(:,i)
4720 cd write(iout,*) 'B2',B2(:,i)
4721 cd write(iout,*) 'CC',CC(:,:,i)
4722 cd write(iout,*) 'DD',DD(:,:,i)
4723 cd write(iout,*) 'EE',EE(:,:,i)
4725 cd call check_vecgrad
4727 if (icheckgrad.eq.1) then
4729 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
4731 dc_norm(k,i)=dc(k,i)*fac
4733 c write (iout,*) 'i',i,' fac',fac
4736 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
4737 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
4738 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
4739 c call vec_and_deriv
4745 time_mat=time_mat+MPI_Wtime()-time01
4749 cd write (iout,*) 'i=',i
4751 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
4754 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
4755 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
4768 cd print '(a)','Enter EELEC'
4769 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
4771 gel_loc_loc(i)=0.0d0
4776 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
4778 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
4780 do i=iturn3_start,iturn3_end
4784 dx_normi=dc_norm(1,i)
4785 dy_normi=dc_norm(2,i)
4786 dz_normi=dc_norm(3,i)
4787 xmedi=c(1,i)+0.5d0*dxi
4788 ymedi=c(2,i)+0.5d0*dyi
4789 zmedi=c(3,i)+0.5d0*dzi
4791 call eelecij(i,i+2,ees,evdw1,eel_loc)
4792 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
4793 num_cont_hb(i)=num_conti
4795 do i=iturn4_start,iturn4_end
4799 dx_normi=dc_norm(1,i)
4800 dy_normi=dc_norm(2,i)
4801 dz_normi=dc_norm(3,i)
4802 xmedi=c(1,i)+0.5d0*dxi
4803 ymedi=c(2,i)+0.5d0*dyi
4804 zmedi=c(3,i)+0.5d0*dzi
4805 num_conti=num_cont_hb(i)
4806 call eelecij(i,i+3,ees,evdw1,eel_loc)
4807 if (wturn4.gt.0.0d0) call eturn4(i,eello_turn4)
4808 num_cont_hb(i)=num_conti
4811 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
4813 do i=iatel_s,iatel_e
4817 dx_normi=dc_norm(1,i)
4818 dy_normi=dc_norm(2,i)
4819 dz_normi=dc_norm(3,i)
4820 xmedi=c(1,i)+0.5d0*dxi
4821 ymedi=c(2,i)+0.5d0*dyi
4822 zmedi=c(3,i)+0.5d0*dzi
4823 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
4824 num_conti=num_cont_hb(i)
4825 do j=ielstart(i),ielend(i)
4826 call eelecij(i,j,ees,evdw1,eel_loc)
4828 num_cont_hb(i)=num_conti
4830 c write (iout,*) "Number of loop steps in EELEC:",ind
4832 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
4833 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
4835 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
4836 ccc eel_loc=eel_loc+eello_turn3
4837 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
4840 C-------------------------------------------------------------------------------
4841 subroutine eelecij(i,j,ees,evdw1,eel_loc)
4842 implicit real*8 (a-h,o-z)
4843 include 'DIMENSIONS'
4847 include 'COMMON.CONTROL'
4848 include 'COMMON.IOUNITS'
4849 include 'COMMON.GEO'
4850 include 'COMMON.VAR'
4851 include 'COMMON.LOCAL'
4852 include 'COMMON.CHAIN'
4853 include 'COMMON.DERIV'
4854 include 'COMMON.INTERACT'
4855 include 'COMMON.CONTACTS'
4856 include 'COMMON.TORSION'
4857 include 'COMMON.VECTORS'
4858 include 'COMMON.FFIELD'
4859 include 'COMMON.TIME1'
4860 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
4861 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
4862 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
4863 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
4864 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4865 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4867 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
4869 double precision scal_el /1.0d0/
4871 double precision scal_el /0.5d0/
4874 C 13-go grudnia roku pamietnego...
4875 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
4876 & 0.0d0,1.0d0,0.0d0,
4877 & 0.0d0,0.0d0,1.0d0/
4878 c time00=MPI_Wtime()
4879 cd write (iout,*) "eelecij",i,j
4883 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
4884 aaa=app(iteli,itelj)
4885 bbb=bpp(iteli,itelj)
4886 ael6i=ael6(iteli,itelj)
4887 ael3i=ael3(iteli,itelj)
4891 dx_normj=dc_norm(1,j)
4892 dy_normj=dc_norm(2,j)
4893 dz_normj=dc_norm(3,j)
4894 xj=c(1,j)+0.5D0*dxj-xmedi
4895 yj=c(2,j)+0.5D0*dyj-ymedi
4896 zj=c(3,j)+0.5D0*dzj-zmedi
4897 rij=xj*xj+yj*yj+zj*zj
4903 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
4904 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
4905 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
4906 fac=cosa-3.0D0*cosb*cosg
4908 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
4909 if (j.eq.i+2) ev1=scal_el*ev1
4914 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
4917 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
4918 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
4921 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
4922 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
4923 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
4924 cd & xmedi,ymedi,zmedi,xj,yj,zj
4926 if (energy_dec) then
4927 write (iout,'(a6,2i5,0pf7.3)') 'evdw1',i,j,evdwij
4928 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
4932 C Calculate contributions to the Cartesian gradient.
4935 facvdw=-6*rrmij*(ev1+evdwij)
4936 facel=-3*rrmij*(el1+eesij)
4942 * Radial derivatives. First process both termini of the fragment (i,j)
4948 c ghalf=0.5D0*ggg(k)
4949 c gelc(k,i)=gelc(k,i)+ghalf
4950 c gelc(k,j)=gelc(k,j)+ghalf
4952 c 9/28/08 AL Gradient compotents will be summed only at the end
4954 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
4955 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
4958 * Loop over residues i+1 thru j-1.
4962 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
4969 c ghalf=0.5D0*ggg(k)
4970 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
4971 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
4973 c 9/28/08 AL Gradient compotents will be summed only at the end
4975 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
4976 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
4979 * Loop over residues i+1 thru j-1.
4983 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
4990 fac=-3*rrmij*(facvdw+facvdw+facel)
4995 * Radial derivatives. First process both termini of the fragment (i,j)
5001 c ghalf=0.5D0*ggg(k)
5002 c gelc(k,i)=gelc(k,i)+ghalf
5003 c gelc(k,j)=gelc(k,j)+ghalf
5005 c 9/28/08 AL Gradient compotents will be summed only at the end
5007 gelc_long(k,j)=gelc(k,j)+ggg(k)
5008 gelc_long(k,i)=gelc(k,i)-ggg(k)
5011 * Loop over residues i+1 thru j-1.
5015 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
5018 c 9/28/08 AL Gradient compotents will be summed only at the end
5023 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
5024 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
5030 ecosa=2.0D0*fac3*fac1+fac4
5033 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
5034 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
5036 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
5037 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
5039 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
5040 cd & (dcosg(k),k=1,3)
5042 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
5045 c ghalf=0.5D0*ggg(k)
5046 c gelc(k,i)=gelc(k,i)+ghalf
5047 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
5048 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
5049 c gelc(k,j)=gelc(k,j)+ghalf
5050 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
5051 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
5055 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
5060 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
5061 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
5063 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
5064 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
5065 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
5066 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
5068 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
5069 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
5070 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
5072 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
5073 C energy of a peptide unit is assumed in the form of a second-order
5074 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
5075 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
5076 C are computed for EVERY pair of non-contiguous peptide groups.
5078 if (j.lt.nres-1) then
5089 muij(kkk)=mu(k,i)*mu(l,j)
5092 cd write (iout,*) 'EELEC: i',i,' j',j
5093 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
5094 cd write(iout,*) 'muij',muij
5095 ury=scalar(uy(1,i),erij)
5096 urz=scalar(uz(1,i),erij)
5097 vry=scalar(uy(1,j),erij)
5098 vrz=scalar(uz(1,j),erij)
5099 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
5100 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
5101 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
5102 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
5103 fac=dsqrt(-ael6i)*r3ij
5108 cd write (iout,'(4i5,4f10.5)')
5109 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
5110 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
5111 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
5112 cd & uy(:,j),uz(:,j)
5113 cd write (iout,'(4f10.5)')
5114 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
5115 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
5116 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
5117 cd write (iout,'(9f10.5/)')
5118 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
5119 C Derivatives of the elements of A in virtual-bond vectors
5120 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
5122 uryg(k,1)=scalar(erder(1,k),uy(1,i))
5123 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
5124 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
5125 urzg(k,1)=scalar(erder(1,k),uz(1,i))
5126 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
5127 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
5128 vryg(k,1)=scalar(erder(1,k),uy(1,j))
5129 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
5130 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
5131 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
5132 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
5133 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
5135 C Compute radial contributions to the gradient
5153 C Add the contributions coming from er
5156 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
5157 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
5158 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
5159 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
5162 C Derivatives in DC(i)
5163 cgrad ghalf1=0.5d0*agg(k,1)
5164 cgrad ghalf2=0.5d0*agg(k,2)
5165 cgrad ghalf3=0.5d0*agg(k,3)
5166 cgrad ghalf4=0.5d0*agg(k,4)
5167 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
5168 & -3.0d0*uryg(k,2)*vry)!+ghalf1
5169 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
5170 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
5171 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
5172 & -3.0d0*urzg(k,2)*vry)!+ghalf3
5173 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
5174 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
5175 C Derivatives in DC(i+1)
5176 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
5177 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
5178 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
5179 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
5180 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
5181 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
5182 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
5183 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
5184 C Derivatives in DC(j)
5185 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
5186 & -3.0d0*vryg(k,2)*ury)!+ghalf1
5187 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
5188 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
5189 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
5190 & -3.0d0*vryg(k,2)*urz)!+ghalf3
5191 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
5192 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
5193 C Derivatives in DC(j+1) or DC(nres-1)
5194 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
5195 & -3.0d0*vryg(k,3)*ury)
5196 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
5197 & -3.0d0*vrzg(k,3)*ury)
5198 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
5199 & -3.0d0*vryg(k,3)*urz)
5200 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
5201 & -3.0d0*vrzg(k,3)*urz)
5202 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
5204 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
5217 aggi(k,l)=-aggi(k,l)
5218 aggi1(k,l)=-aggi1(k,l)
5219 aggj(k,l)=-aggj(k,l)
5220 aggj1(k,l)=-aggj1(k,l)
5223 if (j.lt.nres-1) then
5229 aggi(k,l)=-aggi(k,l)
5230 aggi1(k,l)=-aggi1(k,l)
5231 aggj(k,l)=-aggj(k,l)
5232 aggj1(k,l)=-aggj1(k,l)
5243 aggi(k,l)=-aggi(k,l)
5244 aggi1(k,l)=-aggi1(k,l)
5245 aggj(k,l)=-aggj(k,l)
5246 aggj1(k,l)=-aggj1(k,l)
5251 IF (wel_loc.gt.0.0d0) THEN
5252 C Contribution to the local-electrostatic energy coming from the i-j pair
5253 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
5255 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
5257 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5258 & 'eelloc',i,j,eel_loc_ij
5260 eel_loc=eel_loc+eel_loc_ij
5261 C Partial derivatives in virtual-bond dihedral angles gamma
5263 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
5264 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
5265 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
5266 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
5267 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
5268 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
5269 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
5271 ggg(l)=agg(l,1)*muij(1)+
5272 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
5273 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
5274 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
5275 cgrad ghalf=0.5d0*ggg(l)
5276 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
5277 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
5281 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
5284 C Remaining derivatives of eello
5286 gel_loc(l,i)=gel_loc(l,i)+aggi(l,1)*muij(1)+
5287 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4)
5288 gel_loc(l,i+1)=gel_loc(l,i+1)+aggi1(l,1)*muij(1)+
5289 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4)
5290 gel_loc(l,j)=gel_loc(l,j)+aggj(l,1)*muij(1)+
5291 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4)
5292 gel_loc(l,j1)=gel_loc(l,j1)+aggj1(l,1)*muij(1)+
5293 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4)
5296 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
5297 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
5298 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
5299 & .and. num_conti.le.maxconts) then
5300 c write (iout,*) i,j," entered corr"
5302 C Calculate the contact function. The ith column of the array JCONT will
5303 C contain the numbers of atoms that make contacts with the atom I (of numbers
5304 C greater than I). The arrays FACONT and GACONT will contain the values of
5305 C the contact function and its derivative.
5306 c r0ij=1.02D0*rpp(iteli,itelj)
5307 c r0ij=1.11D0*rpp(iteli,itelj)
5308 r0ij=2.20D0*rpp(iteli,itelj)
5309 c r0ij=1.55D0*rpp(iteli,itelj)
5310 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
5311 if (fcont.gt.0.0D0) then
5312 num_conti=num_conti+1
5313 if (num_conti.gt.maxconts) then
5314 write (iout,*) 'WARNING - max. # of contacts exceeded;',
5315 & ' will skip next contacts for this conf.'
5317 jcont_hb(num_conti,i)=j
5318 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
5319 cd & " jcont_hb",jcont_hb(num_conti,i)
5320 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
5321 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
5322 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
5324 d_cont(num_conti,i)=rij
5325 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
5326 C --- Electrostatic-interaction matrix ---
5327 a_chuj(1,1,num_conti,i)=a22
5328 a_chuj(1,2,num_conti,i)=a23
5329 a_chuj(2,1,num_conti,i)=a32
5330 a_chuj(2,2,num_conti,i)=a33
5331 C --- Gradient of rij
5333 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
5340 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
5341 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
5342 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
5343 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
5344 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
5349 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
5350 C Calculate contact energies
5352 wij=cosa-3.0D0*cosb*cosg
5355 c fac3=dsqrt(-ael6i)/r0ij**3
5356 fac3=dsqrt(-ael6i)*r3ij
5357 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
5358 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
5359 if (ees0tmp.gt.0) then
5360 ees0pij=dsqrt(ees0tmp)
5364 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
5365 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
5366 if (ees0tmp.gt.0) then
5367 ees0mij=dsqrt(ees0tmp)
5372 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
5373 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
5374 C Diagnostics. Comment out or remove after debugging!
5375 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
5376 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
5377 c ees0m(num_conti,i)=0.0D0
5379 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
5380 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
5381 C Angular derivatives of the contact function
5382 ees0pij1=fac3/ees0pij
5383 ees0mij1=fac3/ees0mij
5384 fac3p=-3.0D0*fac3*rrmij
5385 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
5386 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
5388 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
5389 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
5390 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
5391 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
5392 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
5393 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
5394 ecosap=ecosa1+ecosa2
5395 ecosbp=ecosb1+ecosb2
5396 ecosgp=ecosg1+ecosg2
5397 ecosam=ecosa1-ecosa2
5398 ecosbm=ecosb1-ecosb2
5399 ecosgm=ecosg1-ecosg2
5408 facont_hb(num_conti,i)=fcont
5409 fprimcont=fprimcont/rij
5410 cd facont_hb(num_conti,i)=1.0D0
5411 C Following line is for diagnostics.
5414 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
5415 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
5418 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
5419 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
5421 gggp(1)=gggp(1)+ees0pijp*xj
5422 gggp(2)=gggp(2)+ees0pijp*yj
5423 gggp(3)=gggp(3)+ees0pijp*zj
5424 gggm(1)=gggm(1)+ees0mijp*xj
5425 gggm(2)=gggm(2)+ees0mijp*yj
5426 gggm(3)=gggm(3)+ees0mijp*zj
5427 C Derivatives due to the contact function
5428 gacont_hbr(1,num_conti,i)=fprimcont*xj
5429 gacont_hbr(2,num_conti,i)=fprimcont*yj
5430 gacont_hbr(3,num_conti,i)=fprimcont*zj
5433 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
5434 c following the change of gradient-summation algorithm.
5436 cgrad ghalfp=0.5D0*gggp(k)
5437 cgrad ghalfm=0.5D0*gggm(k)
5438 gacontp_hb1(k,num_conti,i)=!ghalfp
5439 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
5440 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
5441 gacontp_hb2(k,num_conti,i)=!ghalfp
5442 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
5443 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
5444 gacontp_hb3(k,num_conti,i)=gggp(k)
5445 gacontm_hb1(k,num_conti,i)=!ghalfm
5446 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
5447 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
5448 gacontm_hb2(k,num_conti,i)=!ghalfm
5449 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
5450 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
5451 gacontm_hb3(k,num_conti,i)=gggm(k)
5453 C Diagnostics. Comment out or remove after debugging!
5455 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
5456 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
5457 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
5458 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
5459 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
5460 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
5463 endif ! num_conti.le.maxconts
5466 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
5469 ghalf=0.5d0*agg(l,k)
5470 aggi(l,k)=aggi(l,k)+ghalf
5471 aggi1(l,k)=aggi1(l,k)+agg(l,k)
5472 aggj(l,k)=aggj(l,k)+ghalf
5475 if (j.eq.nres-1 .and. i.lt.j-2) then
5478 aggj1(l,k)=aggj1(l,k)+agg(l,k)
5483 c t_eelecij=t_eelecij+MPI_Wtime()-time00
5486 C-----------------------------------------------------------------------------
5487 subroutine eturn3(i,eello_turn3)
5488 C Third- and fourth-order contributions from turns
5489 implicit real*8 (a-h,o-z)
5490 include 'DIMENSIONS'
5491 include 'COMMON.IOUNITS'
5492 include 'COMMON.GEO'
5493 include 'COMMON.VAR'
5494 include 'COMMON.LOCAL'
5495 include 'COMMON.CHAIN'
5496 include 'COMMON.DERIV'
5497 include 'COMMON.INTERACT'
5498 include 'COMMON.CONTACTS'
5499 include 'COMMON.TORSION'
5500 include 'COMMON.VECTORS'
5501 include 'COMMON.FFIELD'
5502 include 'COMMON.CONTROL'
5504 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
5505 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
5506 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
5507 double precision agg(3,4),aggi(3,4),aggi1(3,4),
5508 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
5509 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
5510 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
5513 c write (iout,*) "eturn3",i,j,j1,j2
5518 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5520 C Third-order contributions
5527 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5528 cd call checkint_turn3(i,a_temp,eello_turn3_num)
5529 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
5530 call transpose2(auxmat(1,1),auxmat1(1,1))
5531 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
5532 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
5533 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5534 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
5535 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
5536 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
5537 cd & ' eello_turn3_num',4*eello_turn3_num
5538 C Derivatives in gamma(i)
5539 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
5540 call transpose2(auxmat2(1,1),auxmat3(1,1))
5541 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
5542 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
5543 C Derivatives in gamma(i+1)
5544 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
5545 call transpose2(auxmat2(1,1),auxmat3(1,1))
5546 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
5547 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
5548 & +0.5d0*(pizda(1,1)+pizda(2,2))
5549 C Cartesian derivatives
5551 c ghalf1=0.5d0*agg(l,1)
5552 c ghalf2=0.5d0*agg(l,2)
5553 c ghalf3=0.5d0*agg(l,3)
5554 c ghalf4=0.5d0*agg(l,4)
5555 a_temp(1,1)=aggi(l,1)!+ghalf1
5556 a_temp(1,2)=aggi(l,2)!+ghalf2
5557 a_temp(2,1)=aggi(l,3)!+ghalf3
5558 a_temp(2,2)=aggi(l,4)!+ghalf4
5559 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
5560 gcorr3_turn(l,i)=gcorr3_turn(l,i)
5561 & +0.5d0*(pizda(1,1)+pizda(2,2))
5562 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
5563 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
5564 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
5565 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
5566 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
5567 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
5568 & +0.5d0*(pizda(1,1)+pizda(2,2))
5569 a_temp(1,1)=aggj(l,1)!+ghalf1
5570 a_temp(1,2)=aggj(l,2)!+ghalf2
5571 a_temp(2,1)=aggj(l,3)!+ghalf3
5572 a_temp(2,2)=aggj(l,4)!+ghalf4
5573 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
5574 gcorr3_turn(l,j)=gcorr3_turn(l,j)
5575 & +0.5d0*(pizda(1,1)+pizda(2,2))
5576 a_temp(1,1)=aggj1(l,1)
5577 a_temp(1,2)=aggj1(l,2)
5578 a_temp(2,1)=aggj1(l,3)
5579 a_temp(2,2)=aggj1(l,4)
5580 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
5581 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
5582 & +0.5d0*(pizda(1,1)+pizda(2,2))
5586 C-------------------------------------------------------------------------------
5587 subroutine eturn4(i,eello_turn4)
5588 C Third- and fourth-order contributions from turns
5589 implicit real*8 (a-h,o-z)
5590 include 'DIMENSIONS'
5591 include 'COMMON.IOUNITS'
5592 include 'COMMON.GEO'
5593 include 'COMMON.VAR'
5594 include 'COMMON.LOCAL'
5595 include 'COMMON.CHAIN'
5596 include 'COMMON.DERIV'
5597 include 'COMMON.INTERACT'
5598 include 'COMMON.CONTACTS'
5599 include 'COMMON.TORSION'
5600 include 'COMMON.VECTORS'
5601 include 'COMMON.FFIELD'
5602 include 'COMMON.CONTROL'
5604 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
5605 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
5606 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
5607 double precision agg(3,4),aggi(3,4),aggi1(3,4),
5608 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
5609 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
5610 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
5613 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5615 C Fourth-order contributions
5623 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
5624 cd call checkint_turn4(i,a_temp,eello_turn4_num)
5625 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
5630 iti1=itortyp(itype(i+1))
5631 iti2=itortyp(itype(i+2))
5632 iti3=itortyp(itype(i+3))
5633 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
5634 call transpose2(EUg(1,1,i+1),e1t(1,1))
5635 call transpose2(Eug(1,1,i+2),e2t(1,1))
5636 call transpose2(Eug(1,1,i+3),e3t(1,1))
5637 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5638 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5639 s1=scalar2(b1(1,i+2),auxvec(1))
5640 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5641 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5642 s2=scalar2(b1(1,i+1),auxvec(1))
5643 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5644 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5645 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5646 eello_turn4=eello_turn4-(s1+s2+s3)
5647 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5648 & 'eturn4',i,j,-(s1+s2+s3)
5649 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
5650 cd & ' eello_turn4_num',8*eello_turn4_num
5651 C Derivatives in gamma(i)
5652 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
5653 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
5654 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
5655 s1=scalar2(b1(1,i+2),auxvec(1))
5656 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
5657 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5658 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
5659 C Derivatives in gamma(i+1)
5660 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
5661 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
5662 s2=scalar2(b1(1,i+1),auxvec(1))
5663 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
5664 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
5665 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5666 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
5667 C Derivatives in gamma(i+2)
5668 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
5669 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
5670 s1=scalar2(b1(1,i+2),auxvec(1))
5671 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
5672 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
5673 s2=scalar2(b1(1,i+1),auxvec(1))
5674 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
5675 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
5676 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5677 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
5678 C Cartesian derivatives
5679 C Derivatives of this turn contributions in DC(i+2)
5680 if (j.lt.nres-1) then
5682 a_temp(1,1)=agg(l,1)
5683 a_temp(1,2)=agg(l,2)
5684 a_temp(2,1)=agg(l,3)
5685 a_temp(2,2)=agg(l,4)
5686 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5687 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5688 s1=scalar2(b1(1,i+2),auxvec(1))
5689 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5690 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5691 s2=scalar2(b1(1,i+1),auxvec(1))
5692 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5693 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5694 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5696 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
5699 C Remaining derivatives of this turn contribution
5701 a_temp(1,1)=aggi(l,1)
5702 a_temp(1,2)=aggi(l,2)
5703 a_temp(2,1)=aggi(l,3)
5704 a_temp(2,2)=aggi(l,4)
5705 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5706 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5707 s1=scalar2(b1(1,i+2),auxvec(1))
5708 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5709 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5710 s2=scalar2(b1(1,i+1),auxvec(1))
5711 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5712 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5713 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5714 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
5715 a_temp(1,1)=aggi1(l,1)
5716 a_temp(1,2)=aggi1(l,2)
5717 a_temp(2,1)=aggi1(l,3)
5718 a_temp(2,2)=aggi1(l,4)
5719 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5720 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5721 s1=scalar2(b1(1,i+2),auxvec(1))
5722 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5723 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5724 s2=scalar2(b1(1,i+1),auxvec(1))
5725 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5726 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5727 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5728 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
5729 a_temp(1,1)=aggj(l,1)
5730 a_temp(1,2)=aggj(l,2)
5731 a_temp(2,1)=aggj(l,3)
5732 a_temp(2,2)=aggj(l,4)
5733 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5734 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5735 s1=scalar2(b1(1,i+2),auxvec(1))
5736 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5737 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5738 s2=scalar2(b1(1,i+1),auxvec(1))
5739 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5740 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5741 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5742 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
5743 a_temp(1,1)=aggj1(l,1)
5744 a_temp(1,2)=aggj1(l,2)
5745 a_temp(2,1)=aggj1(l,3)
5746 a_temp(2,2)=aggj1(l,4)
5747 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
5748 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
5749 s1=scalar2(b1(1,i+2),auxvec(1))
5750 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
5751 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
5752 s2=scalar2(b1(1,i+1),auxvec(1))
5753 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
5754 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
5755 s3=0.5d0*(pizda(1,1)+pizda(2,2))
5756 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
5757 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
5761 C-----------------------------------------------------------------------------
5762 subroutine vecpr(u,v,w)
5763 implicit real*8(a-h,o-z)
5764 dimension u(3),v(3),w(3)
5765 w(1)=u(2)*v(3)-u(3)*v(2)
5766 w(2)=-u(1)*v(3)+u(3)*v(1)
5767 w(3)=u(1)*v(2)-u(2)*v(1)
5770 C-----------------------------------------------------------------------------
5771 subroutine unormderiv(u,ugrad,unorm,ungrad)
5772 C This subroutine computes the derivatives of a normalized vector u, given
5773 C the derivatives computed without normalization conditions, ugrad. Returns
5776 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
5777 double precision vec(3)
5778 double precision scalar
5780 c write (2,*) 'ugrad',ugrad
5783 vec(i)=scalar(ugrad(1,i),u(1))
5785 c write (2,*) 'vec',vec
5788 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
5791 c write (2,*) 'ungrad',ungrad
5794 C-----------------------------------------------------------------------------
5795 subroutine escp_soft_sphere(evdw2,evdw2_14)
5797 C This subroutine calculates the excluded-volume interaction energy between
5798 C peptide-group centers and side chains and its gradient in virtual-bond and
5799 C side-chain vectors.
5801 implicit real*8 (a-h,o-z)
5802 include 'DIMENSIONS'
5803 include 'COMMON.GEO'
5804 include 'COMMON.VAR'
5805 include 'COMMON.LOCAL'
5806 include 'COMMON.CHAIN'
5807 include 'COMMON.DERIV'
5808 include 'COMMON.INTERACT'
5809 include 'COMMON.FFIELD'
5810 include 'COMMON.IOUNITS'
5811 include 'COMMON.CONTROL'
5816 cd print '(a)','Enter ESCP'
5817 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
5818 do i=iatscp_s,iatscp_e
5820 xi=0.5D0*(c(1,i)+c(1,i+1))
5821 yi=0.5D0*(c(2,i)+c(2,i+1))
5822 zi=0.5D0*(c(3,i)+c(3,i+1))
5824 do iint=1,nscp_gr(i)
5826 do j=iscpstart(i,iint),iscpend(i,iint)
5828 C Uncomment following three lines for SC-p interactions
5832 C Uncomment following three lines for Ca-p interactions
5836 rij=xj*xj+yj*yj+zj*zj
5839 if (rij.lt.r0ijsq) then
5840 evdwij=0.25d0*(rij-r0ijsq)**2
5848 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5853 cgrad if (j.lt.i) then
5854 cd write (iout,*) 'j<i'
5855 C Uncomment following three lines for SC-p interactions
5857 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5860 cd write (iout,*) 'j>i'
5862 cgrad ggg(k)=-ggg(k)
5863 C Uncomment following line for SC-p interactions
5864 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5868 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5870 cgrad kstart=min0(i+1,j)
5871 cgrad kend=max0(i-1,j-1)
5872 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5873 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5874 cgrad do k=kstart,kend
5876 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5880 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5881 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5889 C-----------------------------------------------------------------------------
5890 subroutine escp(evdw2,evdw2_14)
5892 C This subroutine calculates the excluded-volume interaction energy between
5893 C peptide-group centers and side chains and its gradient in virtual-bond and
5894 C side-chain vectors.
5896 implicit real*8 (a-h,o-z)
5897 include 'DIMENSIONS'
5898 include 'COMMON.GEO'
5899 include 'COMMON.VAR'
5900 include 'COMMON.LOCAL'
5901 include 'COMMON.CHAIN'
5902 include 'COMMON.DERIV'
5903 include 'COMMON.INTERACT'
5904 include 'COMMON.FFIELD'
5905 include 'COMMON.IOUNITS'
5906 include 'COMMON.CONTROL'
5910 cd print '(a)','Enter ESCP'
5911 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
5912 do i=iatscp_s,iatscp_e
5914 xi=0.5D0*(c(1,i)+c(1,i+1))
5915 yi=0.5D0*(c(2,i)+c(2,i+1))
5916 zi=0.5D0*(c(3,i)+c(3,i+1))
5918 do iint=1,nscp_gr(i)
5920 do j=iscpstart(i,iint),iscpend(i,iint)
5922 C Uncomment following three lines for SC-p interactions
5926 C Uncomment following three lines for Ca-p interactions
5930 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5932 e1=fac*fac*aad(itypj,iteli)
5933 e2=fac*bad(itypj,iteli)
5934 if (iabs(j-i) .le. 2) then
5937 evdw2_14=evdw2_14+e1+e2
5941 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
5942 & 'evdw2',i,j,evdwij
5944 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5946 fac=-(evdwij+e1)*rrij
5950 cgrad if (j.lt.i) then
5951 cd write (iout,*) 'j<i'
5952 C Uncomment following three lines for SC-p interactions
5954 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5957 cd write (iout,*) 'j>i'
5959 cgrad ggg(k)=-ggg(k)
5960 C Uncomment following line for SC-p interactions
5961 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5962 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5966 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5968 cgrad kstart=min0(i+1,j)
5969 cgrad kend=max0(i-1,j-1)
5970 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5971 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5972 cgrad do k=kstart,kend
5974 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5978 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5979 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5987 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
5988 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
5989 gradx_scp(j,i)=expon*gradx_scp(j,i)
5992 C******************************************************************************
5996 C To save time the factor EXPON has been extracted from ALL components
5997 C of GVDWC and GRADX. Remember to multiply them by this factor before further
6000 C******************************************************************************
6003 C--------------------------------------------------------------------------
6004 subroutine edis(ehpb)
6006 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
6008 implicit real*8 (a-h,o-z)
6009 include 'DIMENSIONS'
6010 include 'COMMON.SBRIDGE'
6011 include 'COMMON.CHAIN'
6012 include 'COMMON.DERIV'
6013 include 'COMMON.VAR'
6014 include 'COMMON.INTERACT'
6015 include 'COMMON.IOUNITS'
6018 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
6019 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
6020 if (link_end.eq.0) return
6021 do i=link_start,link_end
6022 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
6023 C CA-CA distance used in regularization of structure.
6026 C iii and jjj point to the residues for which the distance is assigned.
6027 if (ii.gt.nres) then
6034 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
6035 c & dhpb(i),dhpb1(i),forcon(i)
6036 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
6037 C distance and angle dependent SS bond potential.
6038 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
6039 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
6040 if (.not.dyn_ss .and. i.le.nss) then
6041 C 15/02/13 CC dynamic SSbond - additional check
6043 & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
6044 call ssbond_ene(iii,jjj,eij)
6047 cd write (iout,*) "eij",eij
6048 else if (ii.gt.nres .and. jj.gt.nres) then
6049 c Restraints from contact prediction
6051 if (dhpb1(i).gt.0.0d0) then
6052 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
6053 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
6054 c write (iout,*) "beta nmr",
6055 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
6059 C Get the force constant corresponding to this distance.
6061 C Calculate the contribution to energy.
6062 ehpb=ehpb+waga*rdis*rdis
6063 c write (iout,*) "beta reg",dd,waga*rdis*rdis
6065 C Evaluate gradient.
6070 ggg(j)=fac*(c(j,jj)-c(j,ii))
6073 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
6074 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
6077 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
6078 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
6081 C Calculate the distance between the two points and its difference from the
6084 if (dhpb1(i).gt.0.0d0) then
6085 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
6086 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
6087 c write (iout,*) "alph nmr",
6088 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
6091 C Get the force constant corresponding to this distance.
6093 C Calculate the contribution to energy.
6094 ehpb=ehpb+waga*rdis*rdis
6095 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
6097 C Evaluate gradient.
6101 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
6102 cd & ' waga=',waga,' fac=',fac
6104 ggg(j)=fac*(c(j,jj)-c(j,ii))
6106 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
6107 C If this is a SC-SC distance, we need to calculate the contributions to the
6108 C Cartesian gradient in the SC vectors (ghpbx).
6111 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
6112 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
6115 cgrad do j=iii,jjj-1
6117 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
6121 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
6122 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
6129 C--------------------------------------------------------------------------
6130 subroutine ssbond_ene(i,j,eij)
6132 C Calculate the distance and angle dependent SS-bond potential energy
6133 C using a free-energy function derived based on RHF/6-31G** ab initio
6134 C calculations of diethyl disulfide.
6136 C A. Liwo and U. Kozlowska, 11/24/03
6138 implicit real*8 (a-h,o-z)
6139 include 'DIMENSIONS'
6140 include 'COMMON.SBRIDGE'
6141 include 'COMMON.CHAIN'
6142 include 'COMMON.DERIV'
6143 include 'COMMON.LOCAL'
6144 include 'COMMON.INTERACT'
6145 include 'COMMON.VAR'
6146 include 'COMMON.IOUNITS'
6147 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
6152 dxi=dc_norm(1,nres+i)
6153 dyi=dc_norm(2,nres+i)
6154 dzi=dc_norm(3,nres+i)
6155 c dsci_inv=dsc_inv(itypi)
6156 dsci_inv=vbld_inv(nres+i)
6158 c dscj_inv=dsc_inv(itypj)
6159 dscj_inv=vbld_inv(nres+j)
6163 dxj=dc_norm(1,nres+j)
6164 dyj=dc_norm(2,nres+j)
6165 dzj=dc_norm(3,nres+j)
6166 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
6171 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
6172 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
6173 om12=dxi*dxj+dyi*dyj+dzi*dzj
6175 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
6176 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
6182 deltat12=om2-om1+2.0d0
6184 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
6185 & +akct*deltad*deltat12+ebr
6186 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi
6187 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
6188 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
6189 c & " deltat12",deltat12," eij",eij
6190 ed=2*akcm*deltad+akct*deltat12
6192 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
6193 eom1=-2*akth*deltat1-pom1-om2*pom2
6194 eom2= 2*akth*deltat2+pom1-om1*pom2
6197 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
6198 ghpbx(k,i)=ghpbx(k,i)-ggk
6199 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
6200 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
6201 ghpbx(k,j)=ghpbx(k,j)+ggk
6202 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
6203 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
6204 ghpbc(k,i)=ghpbc(k,i)-ggk
6205 ghpbc(k,j)=ghpbc(k,j)+ggk
6208 C Calculate the components of the gradient in DC and X
6212 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
6217 C--------------------------------------------------------------------------
6218 subroutine ebond(estr)
6220 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
6222 implicit real*8 (a-h,o-z)
6223 include 'DIMENSIONS'
6224 include 'COMMON.LOCAL'
6225 include 'COMMON.GEO'
6226 include 'COMMON.INTERACT'
6227 include 'COMMON.DERIV'
6228 include 'COMMON.VAR'
6229 include 'COMMON.CHAIN'
6230 include 'COMMON.IOUNITS'
6231 include 'COMMON.NAMES'
6232 include 'COMMON.FFIELD'
6233 include 'COMMON.CONTROL'
6234 include 'COMMON.SETUP'
6235 double precision u(3),ud(3)
6237 do i=ibondp_start,ibondp_end
6238 diff = vbld(i)-vbldp0
6239 c write (iout,*) i,vbld(i),vbldp0,diff,AKP*diff*diff
6242 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
6244 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
6248 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
6250 do i=ibond_start,ibond_end
6255 diff=vbld(i+nres)-vbldsc0(1,iti)
6256 c write (iout,*) i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
6257 c & AKSC(1,iti),AKSC(1,iti)*diff*diff
6258 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
6260 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
6264 diff=vbld(i+nres)-vbldsc0(j,iti)
6265 ud(j)=aksc(j,iti)*diff
6266 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
6280 uprod2=uprod2*u(k)*u(k)
6284 usumsqder=usumsqder+ud(j)*uprod2
6286 estr=estr+uprod/usum
6288 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
6296 C--------------------------------------------------------------------------
6297 subroutine ebend(etheta)
6299 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
6300 C angles gamma and its derivatives in consecutive thetas and gammas.
6302 implicit real*8 (a-h,o-z)
6303 include 'DIMENSIONS'
6304 include 'COMMON.LOCAL'
6305 include 'COMMON.GEO'
6306 include 'COMMON.INTERACT'
6307 include 'COMMON.DERIV'
6308 include 'COMMON.VAR'
6309 include 'COMMON.CHAIN'
6310 include 'COMMON.IOUNITS'
6311 include 'COMMON.NAMES'
6312 include 'COMMON.FFIELD'
6313 include 'COMMON.CONTROL'
6314 common /calcthet/ term1,term2,termm,diffak,ratak,
6315 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
6316 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6317 double precision y(2),z(2)
6319 c time11=dexp(-2*time)
6322 c write (*,'(a,i2)') 'EBEND ICG=',icg
6323 do i=ithet_start,ithet_end
6324 C Zero the energy function and its derivative at 0 or pi.
6325 call splinthet(theta(i),0.5d0*delta,ss,ssd)
6330 if (phii.ne.phii) phii=150.0
6343 if (phii1.ne.phii1) phii1=150.0
6355 C Calculate the "mean" value of theta from the part of the distribution
6356 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
6357 C In following comments this theta will be referred to as t_c.
6358 thet_pred_mean=0.0d0
6362 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
6364 dthett=thet_pred_mean*ssd
6365 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
6366 C Derivatives of the "mean" values in gamma1 and gamma2.
6367 dthetg1=(-athet(1,it)*y(2)+athet(2,it)*y(1))*ss
6368 dthetg2=(-bthet(1,it)*z(2)+bthet(2,it)*z(1))*ss
6369 if (theta(i).gt.pi-delta) then
6370 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
6372 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
6373 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
6374 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
6376 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
6378 else if (theta(i).lt.delta) then
6379 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
6380 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
6381 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
6383 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
6384 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
6387 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
6390 etheta=etheta+ethetai
6391 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6393 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
6394 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
6395 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)
6397 C Ufff.... We've done all this!!!
6400 C---------------------------------------------------------------------------
6401 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
6403 implicit real*8 (a-h,o-z)
6404 include 'DIMENSIONS'
6405 include 'COMMON.LOCAL'
6406 include 'COMMON.IOUNITS'
6407 common /calcthet/ term1,term2,termm,diffak,ratak,
6408 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
6409 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6410 C Calculate the contributions to both Gaussian lobes.
6411 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
6412 C The "polynomial part" of the "standard deviation" of this part of
6416 sig=sig*thet_pred_mean+polthet(j,it)
6418 C Derivative of the "interior part" of the "standard deviation of the"
6419 C gamma-dependent Gaussian lobe in t_c.
6420 sigtc=3*polthet(3,it)
6422 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
6425 C Set the parameters of both Gaussian lobes of the distribution.
6426 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
6427 fac=sig*sig+sigc0(it)
6430 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
6431 sigsqtc=-4.0D0*sigcsq*sigtc
6432 c print *,i,sig,sigtc,sigsqtc
6433 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
6434 sigtc=-sigtc/(fac*fac)
6435 C Following variable is sigma(t_c)**(-2)
6436 sigcsq=sigcsq*sigcsq
6438 sig0inv=1.0D0/sig0i**2
6439 delthec=thetai-thet_pred_mean
6440 delthe0=thetai-theta0i
6441 term1=-0.5D0*sigcsq*delthec*delthec
6442 term2=-0.5D0*sig0inv*delthe0*delthe0
6443 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
6444 C NaNs in taking the logarithm. We extract the largest exponent which is added
6445 C to the energy (this being the log of the distribution) at the end of energy
6446 C term evaluation for this virtual-bond angle.
6447 if (term1.gt.term2) then
6449 term2=dexp(term2-termm)
6453 term1=dexp(term1-termm)
6456 C The ratio between the gamma-independent and gamma-dependent lobes of
6457 C the distribution is a Gaussian function of thet_pred_mean too.
6458 diffak=gthet(2,it)-thet_pred_mean
6459 ratak=diffak/gthet(3,it)**2
6460 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
6461 C Let's differentiate it in thet_pred_mean NOW.
6463 C Now put together the distribution terms to make complete distribution.
6464 termexp=term1+ak*term2
6465 termpre=sigc+ak*sig0i
6466 C Contribution of the bending energy from this theta is just the -log of
6467 C the sum of the contributions from the two lobes and the pre-exponential
6468 C factor. Simple enough, isn't it?
6469 ethetai=(-dlog(termexp)-termm+dlog(termpre))
6470 C NOW the derivatives!!!
6471 C 6/6/97 Take into account the deformation.
6472 E_theta=(delthec*sigcsq*term1
6473 & +ak*delthe0*sig0inv*term2)/termexp
6474 E_tc=((sigtc+aktc*sig0i)/termpre
6475 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
6476 & aktc*term2)/termexp)
6479 c-----------------------------------------------------------------------------
6480 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
6481 implicit real*8 (a-h,o-z)
6482 include 'DIMENSIONS'
6483 include 'COMMON.LOCAL'
6484 include 'COMMON.IOUNITS'
6485 common /calcthet/ term1,term2,termm,diffak,ratak,
6486 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
6487 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
6488 delthec=thetai-thet_pred_mean
6489 delthe0=thetai-theta0i
6490 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
6491 t3 = thetai-thet_pred_mean
6495 t14 = t12+t6*sigsqtc
6497 t21 = thetai-theta0i
6503 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
6504 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
6505 & *(-t12*t9-ak*sig0inv*t27)
6509 C--------------------------------------------------------------------------
6510 subroutine ebend(etheta)
6512 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
6513 C angles gamma and its derivatives in consecutive thetas and gammas.
6514 C ab initio-derived potentials from
6515 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
6517 implicit real*8 (a-h,o-z)
6518 include 'DIMENSIONS'
6519 include 'COMMON.LOCAL'
6520 include 'COMMON.GEO'
6521 include 'COMMON.INTERACT'
6522 include 'COMMON.DERIV'
6523 include 'COMMON.VAR'
6524 include 'COMMON.CHAIN'
6525 include 'COMMON.IOUNITS'
6526 include 'COMMON.NAMES'
6527 include 'COMMON.FFIELD'
6528 include 'COMMON.CONTROL'
6529 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
6530 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
6531 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
6532 & sinph1ph2(maxdouble,maxdouble)
6533 logical lprn /.false./, lprn1 /.false./
6535 do i=ithet_start,ithet_end
6539 theti2=0.5d0*theta(i)
6540 ityp2=ithetyp(itype(i-1))
6542 coskt(k)=dcos(k*theti2)
6543 sinkt(k)=dsin(k*theti2)
6548 if (phii.ne.phii) phii=150.0
6552 ityp1=ithetyp(itype(i-2))
6554 cosph1(k)=dcos(k*phii)
6555 sinph1(k)=dsin(k*phii)
6568 if (phii1.ne.phii1) phii1=150.0
6573 ityp3=ithetyp(itype(i))
6575 cosph2(k)=dcos(k*phii1)
6576 sinph2(k)=dsin(k*phii1)
6586 ethetai=aa0thet(ityp1,ityp2,ityp3)
6589 ccl=cosph1(l)*cosph2(k-l)
6590 ssl=sinph1(l)*sinph2(k-l)
6591 scl=sinph1(l)*cosph2(k-l)
6592 csl=cosph1(l)*sinph2(k-l)
6593 cosph1ph2(l,k)=ccl-ssl
6594 cosph1ph2(k,l)=ccl+ssl
6595 sinph1ph2(l,k)=scl+csl
6596 sinph1ph2(k,l)=scl-csl
6600 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
6601 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
6602 write (iout,*) "coskt and sinkt"
6604 write (iout,*) k,coskt(k),sinkt(k)
6608 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3)*sinkt(k)
6609 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3)
6612 & write (iout,*) "k",k," aathet",aathet(k,ityp1,ityp2,ityp3),
6613 & " ethetai",ethetai
6616 write (iout,*) "cosph and sinph"
6618 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
6620 write (iout,*) "cosph1ph2 and sinph2ph2"
6623 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
6624 & sinph1ph2(l,k),sinph1ph2(k,l)
6627 write(iout,*) "ethetai",ethetai
6631 aux=bbthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)
6632 & +ccthet(k,m,ityp1,ityp2,ityp3)*sinph1(k)
6633 & +ddthet(k,m,ityp1,ityp2,ityp3)*cosph2(k)
6634 & +eethet(k,m,ityp1,ityp2,ityp3)*sinph2(k)
6635 ethetai=ethetai+sinkt(m)*aux
6636 dethetai=dethetai+0.5d0*m*aux*coskt(m)
6637 dephii=dephii+k*sinkt(m)*(
6638 & ccthet(k,m,ityp1,ityp2,ityp3)*cosph1(k)-
6639 & bbthet(k,m,ityp1,ityp2,ityp3)*sinph1(k))
6640 dephii1=dephii1+k*sinkt(m)*(
6641 & eethet(k,m,ityp1,ityp2,ityp3)*cosph2(k)-
6642 & ddthet(k,m,ityp1,ityp2,ityp3)*sinph2(k))
6644 & write (iout,*) "m",m," k",k," bbthet",
6645 & bbthet(k,m,ityp1,ityp2,ityp3)," ccthet",
6646 & ccthet(k,m,ityp1,ityp2,ityp3)," ddthet",
6647 & ddthet(k,m,ityp1,ityp2,ityp3)," eethet",
6648 & eethet(k,m,ityp1,ityp2,ityp3)," ethetai",ethetai
6652 & write(iout,*) "ethetai",ethetai
6656 aux=ffthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
6657 & ffthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l)+
6658 & ggthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
6659 & ggthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)
6660 ethetai=ethetai+sinkt(m)*aux
6661 dethetai=dethetai+0.5d0*m*coskt(m)*aux
6662 dephii=dephii+l*sinkt(m)*(
6663 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)-
6664 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
6665 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)+
6666 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
6667 dephii1=dephii1+(k-l)*sinkt(m)*(
6668 & -ffthet(l,k,m,ityp1,ityp2,ityp3)*sinph1ph2(l,k)+
6669 & ffthet(k,l,m,ityp1,ityp2,ityp3)*sinph1ph2(k,l)+
6670 & ggthet(l,k,m,ityp1,ityp2,ityp3)*cosph1ph2(l,k)-
6671 & ggthet(k,l,m,ityp1,ityp2,ityp3)*cosph1ph2(k,l))
6673 write (iout,*) "m",m," k",k," l",l," ffthet",
6674 & ffthet(l,k,m,ityp1,ityp2,ityp3),
6675 & ffthet(k,l,m,ityp1,ityp2,ityp3)," ggthet",
6676 & ggthet(l,k,m,ityp1,ityp2,ityp3),
6677 & ggthet(k,l,m,ityp1,ityp2,ityp3)," ethetai",ethetai
6678 write (iout,*) cosph1ph2(l,k)*sinkt(m),
6679 & cosph1ph2(k,l)*sinkt(m),
6680 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
6686 if (lprn1) write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
6687 & i,theta(i)*rad2deg,phii*rad2deg,
6688 & phii1*rad2deg,ethetai
6689 etheta=etheta+ethetai
6690 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
6691 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
6692 gloc(nphi+i-2,icg)=wang*dethetai
6698 c-----------------------------------------------------------------------------
6699 subroutine esc(escloc)
6700 C Calculate the local energy of a side chain and its derivatives in the
6701 C corresponding virtual-bond valence angles THETA and the spherical angles
6703 implicit real*8 (a-h,o-z)
6704 include 'DIMENSIONS'
6705 include 'COMMON.GEO'
6706 include 'COMMON.LOCAL'
6707 include 'COMMON.VAR'
6708 include 'COMMON.INTERACT'
6709 include 'COMMON.DERIV'
6710 include 'COMMON.CHAIN'
6711 include 'COMMON.IOUNITS'
6712 include 'COMMON.NAMES'
6713 include 'COMMON.FFIELD'
6714 include 'COMMON.CONTROL'
6715 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
6716 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
6717 common /sccalc/ time11,time12,time112,theti,it,nlobit
6720 c write (iout,'(a)') 'ESC'
6721 do i=loc_start,loc_end
6723 if (it.eq.10) goto 1
6725 c print *,'i=',i,' it=',it,' nlobit=',nlobit
6726 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
6727 theti=theta(i+1)-pipol
6732 if (x(2).gt.pi-delta) then
6736 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6738 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6739 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
6741 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6742 & ddersc0(1),dersc(1))
6743 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
6744 & ddersc0(3),dersc(3))
6746 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6748 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6749 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
6750 & dersc0(2),esclocbi,dersc02)
6751 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6753 call splinthet(x(2),0.5d0*delta,ss,ssd)
6758 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6760 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6761 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6763 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6765 c write (iout,*) escloci
6766 else if (x(2).lt.delta) then
6770 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6772 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6773 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
6775 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6776 & ddersc0(1),dersc(1))
6777 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
6778 & ddersc0(3),dersc(3))
6780 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6782 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6783 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
6784 & dersc0(2),esclocbi,dersc02)
6785 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6790 call splinthet(x(2),0.5d0*delta,ss,ssd)
6792 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6794 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6795 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6797 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6798 c write (iout,*) escloci
6800 call enesc(x,escloci,dersc,ddummy,.false.)
6803 escloc=escloc+escloci
6804 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6805 & 'escloc',i,escloci
6806 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
6808 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
6810 gloc(ialph(i,1),icg)=wscloc*dersc(2)
6811 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
6816 C---------------------------------------------------------------------------
6817 subroutine enesc(x,escloci,dersc,ddersc,mixed)
6818 implicit real*8 (a-h,o-z)
6819 include 'DIMENSIONS'
6820 include 'COMMON.GEO'
6821 include 'COMMON.LOCAL'
6822 include 'COMMON.IOUNITS'
6823 common /sccalc/ time11,time12,time112,theti,it,nlobit
6824 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
6825 double precision contr(maxlob,-1:1)
6827 c write (iout,*) 'it=',it,' nlobit=',nlobit
6831 if (mixed) ddersc(j)=0.0d0
6835 C Because of periodicity of the dependence of the SC energy in omega we have
6836 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
6837 C To avoid underflows, first compute & store the exponents.
6845 z(k)=x(k)-censc(k,j,it)
6850 Axk=Axk+gaussc(l,k,j,it)*z(l)
6856 expfac=expfac+Ax(k,j,iii)*z(k)
6864 C As in the case of ebend, we want to avoid underflows in exponentiation and
6865 C subsequent NaNs and INFs in energy calculation.
6866 C Find the largest exponent
6870 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
6874 cd print *,'it=',it,' emin=',emin
6876 C Compute the contribution to SC energy and derivatives
6881 adexp=bsc(j,it)-0.5D0*contr(j,iii)+emin
6882 if(adexp.ne.adexp) adexp=1.0
6885 expfac=dexp(bsc(j,it)-0.5D0*contr(j,iii)+emin)
6887 cd print *,'j=',j,' expfac=',expfac
6888 escloc_i=escloc_i+expfac
6890 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
6894 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
6895 & +gaussc(k,2,j,it))*expfac
6902 dersc(1)=dersc(1)/cos(theti)**2
6903 ddersc(1)=ddersc(1)/cos(theti)**2
6906 escloci=-(dlog(escloc_i)-emin)
6908 dersc(j)=dersc(j)/escloc_i
6912 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
6917 C------------------------------------------------------------------------------
6918 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
6919 implicit real*8 (a-h,o-z)
6920 include 'DIMENSIONS'
6921 include 'COMMON.GEO'
6922 include 'COMMON.LOCAL'
6923 include 'COMMON.IOUNITS'
6924 common /sccalc/ time11,time12,time112,theti,it,nlobit
6925 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
6926 double precision contr(maxlob)
6937 z(k)=x(k)-censc(k,j,it)
6943 Axk=Axk+gaussc(l,k,j,it)*z(l)
6949 expfac=expfac+Ax(k,j)*z(k)
6954 C As in the case of ebend, we want to avoid underflows in exponentiation and
6955 C subsequent NaNs and INFs in energy calculation.
6956 C Find the largest exponent
6959 if (emin.gt.contr(j)) emin=contr(j)
6963 C Compute the contribution to SC energy and derivatives
6967 expfac=dexp(bsc(j,it)-0.5D0*contr(j)+emin)
6968 escloc_i=escloc_i+expfac
6970 dersc(k)=dersc(k)+Ax(k,j)*expfac
6972 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
6973 & +gaussc(1,2,j,it))*expfac
6977 dersc(1)=dersc(1)/cos(theti)**2
6978 dersc12=dersc12/cos(theti)**2
6979 escloci=-(dlog(escloc_i)-emin)
6981 dersc(j)=dersc(j)/escloc_i
6983 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6987 c----------------------------------------------------------------------------------
6988 subroutine esc(escloc)
6989 C Calculate the local energy of a side chain and its derivatives in the
6990 C corresponding virtual-bond valence angles THETA and the spherical angles
6991 C ALPHA and OMEGA derived from AM1 all-atom calculations.
6992 C added by Urszula Kozlowska. 07/11/2007
6994 implicit real*8 (a-h,o-z)
6995 include 'DIMENSIONS'
6996 include 'COMMON.GEO'
6997 include 'COMMON.LOCAL'
6998 include 'COMMON.VAR'
6999 include 'COMMON.SCROT'
7000 include 'COMMON.INTERACT'
7001 include 'COMMON.DERIV'
7002 include 'COMMON.CHAIN'
7003 include 'COMMON.IOUNITS'
7004 include 'COMMON.NAMES'
7005 include 'COMMON.FFIELD'
7006 include 'COMMON.CONTROL'
7007 include 'COMMON.VECTORS'
7008 double precision x_prime(3),y_prime(3),z_prime(3)
7009 & , sumene,dsc_i,dp2_i,x(65),
7010 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
7011 & de_dxx,de_dyy,de_dzz,de_dt
7012 double precision s1_t,s1_6_t,s2_t,s2_6_t
7014 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
7015 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
7016 & dt_dCi(3),dt_dCi1(3)
7017 common /sccalc/ time11,time12,time112,theti,it,nlobit
7020 do i=loc_start,loc_end
7021 costtab(i+1) =dcos(theta(i+1))
7022 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
7023 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
7024 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
7025 cosfac2=0.5d0/(1.0d0+costtab(i+1))
7026 cosfac=dsqrt(cosfac2)
7027 sinfac2=0.5d0/(1.0d0-costtab(i+1))
7028 sinfac=dsqrt(sinfac2)
7030 if (it.eq.10) goto 1
7032 C Compute the axes of tghe local cartesian coordinates system; store in
7033 c x_prime, y_prime and z_prime
7040 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
7041 C & dc_norm(3,i+nres)
7043 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
7044 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
7047 z_prime(j) = -uz(j,i-1)
7050 c write (2,*) "x_prime",(x_prime(j),j=1,3)
7051 c write (2,*) "y_prime",(y_prime(j),j=1,3)
7052 c write (2,*) "z_prime",(z_prime(j),j=1,3)
7053 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
7054 c & " xy",scalar(x_prime(1),y_prime(1)),
7055 c & " xz",scalar(x_prime(1),z_prime(1)),
7056 c & " yy",scalar(y_prime(1),y_prime(1)),
7057 c & " yz",scalar(y_prime(1),z_prime(1)),
7058 c & " zz",scalar(z_prime(1),z_prime(1))
7060 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
7061 C to local coordinate system. Store in xx, yy, zz.
7067 xx = xx + x_prime(j)*dc_norm(j,i+nres)
7068 yy = yy + y_prime(j)*dc_norm(j,i+nres)
7069 zz = zz + z_prime(j)*dc_norm(j,i+nres)
7076 C Compute the energy of the ith side cbain
7078 c write (2,*) "xx",xx," yy",yy," zz",zz
7081 x(j) = sc_parmin(j,it)
7084 Cc diagnostics - remove later
7086 yy1 = dsin(alph(2))*dcos(omeg(2))
7087 zz1 = -dsin(alph(2))*dsin(omeg(2))
7088 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
7089 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
7091 C," --- ", xx_w,yy_w,zz_w
7094 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
7095 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
7097 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
7098 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
7100 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
7101 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
7102 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
7103 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
7104 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
7106 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
7107 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
7108 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
7109 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
7110 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
7112 dsc_i = 0.743d0+x(61)
7114 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
7115 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
7116 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
7117 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
7118 s1=(1+x(63))/(0.1d0 + dscp1)
7119 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
7120 s2=(1+x(65))/(0.1d0 + dscp2)
7121 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
7122 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
7123 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
7124 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
7126 c & dscp1,dscp2,sumene
7127 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
7128 escloc = escloc + sumene
7129 c write (2,*) "i",i," escloc",sumene,escloc
7132 C This section to check the numerical derivatives of the energy of ith side
7133 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
7134 C #define DEBUG in the code to turn it on.
7136 write (2,*) "sumene =",sumene
7140 write (2,*) xx,yy,zz
7141 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
7142 de_dxx_num=(sumenep-sumene)/aincr
7144 write (2,*) "xx+ sumene from enesc=",sumenep
7147 write (2,*) xx,yy,zz
7148 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
7149 de_dyy_num=(sumenep-sumene)/aincr
7151 write (2,*) "yy+ sumene from enesc=",sumenep
7154 write (2,*) xx,yy,zz
7155 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
7156 de_dzz_num=(sumenep-sumene)/aincr
7158 write (2,*) "zz+ sumene from enesc=",sumenep
7159 costsave=cost2tab(i+1)
7160 sintsave=sint2tab(i+1)
7161 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
7162 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
7163 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
7164 de_dt_num=(sumenep-sumene)/aincr
7165 write (2,*) " t+ sumene from enesc=",sumenep
7166 cost2tab(i+1)=costsave
7167 sint2tab(i+1)=sintsave
7168 C End of diagnostics section.
7171 C Compute the gradient of esc
7173 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
7174 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
7175 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
7176 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
7177 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
7178 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
7179 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
7180 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
7181 pom1=(sumene3*sint2tab(i+1)+sumene1)
7182 & *(pom_s1/dscp1+pom_s16*dscp1**4)
7183 pom2=(sumene4*cost2tab(i+1)+sumene2)
7184 & *(pom_s2/dscp2+pom_s26*dscp2**4)
7185 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
7186 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
7187 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
7189 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
7190 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
7191 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
7193 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
7194 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
7195 & +(pom1+pom2)*pom_dx
7197 write(2,*), "de_dxx = ", de_dxx,de_dxx_num
7200 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
7201 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
7202 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
7204 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
7205 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
7206 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
7207 & +x(59)*zz**2 +x(60)*xx*zz
7208 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
7209 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
7210 & +(pom1-pom2)*pom_dy
7212 write(2,*), "de_dyy = ", de_dyy,de_dyy_num
7215 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
7216 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
7217 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
7218 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
7219 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
7220 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
7221 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
7222 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
7224 write(2,*), "de_dzz = ", de_dzz,de_dzz_num
7227 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
7228 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
7229 & +pom1*pom_dt1+pom2*pom_dt2
7231 write(2,*), "de_dt = ", de_dt,de_dt_num
7235 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
7236 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
7237 cosfac2xx=cosfac2*xx
7238 sinfac2yy=sinfac2*yy
7240 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
7242 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
7244 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
7245 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
7246 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
7247 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
7248 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
7249 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
7250 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
7251 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
7252 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
7253 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
7257 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)*dC_norm(j,i+nres)
7258 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)*dC_norm(j,i+nres)
7261 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
7262 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
7263 dZZ_XYZ(k)=vbld_inv(i+nres)*(z_prime(k)-zz*dC_norm(k,i+nres))
7265 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
7266 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
7270 dXX_Ctab(k,i)=dXX_Ci(k)
7271 dXX_C1tab(k,i)=dXX_Ci1(k)
7272 dYY_Ctab(k,i)=dYY_Ci(k)
7273 dYY_C1tab(k,i)=dYY_Ci1(k)
7274 dZZ_Ctab(k,i)=dZZ_Ci(k)
7275 dZZ_C1tab(k,i)=dZZ_Ci1(k)
7276 dXX_XYZtab(k,i)=dXX_XYZ(k)
7277 dYY_XYZtab(k,i)=dYY_XYZ(k)
7278 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
7282 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
7283 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
7284 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
7285 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
7286 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
7288 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
7289 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
7290 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
7291 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
7292 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
7293 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
7294 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
7295 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
7297 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
7298 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
7300 C to check gradient call subroutine check_grad
7306 c------------------------------------------------------------------------------
7307 double precision function enesc(x,xx,yy,zz,cost2,sint2)
7309 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
7310 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
7311 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
7312 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
7314 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
7315 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
7317 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
7318 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
7319 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
7320 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
7321 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
7323 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
7324 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
7325 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
7326 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
7327 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
7329 dsc_i = 0.743d0+x(61)
7331 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
7332 & *(xx*cost2+yy*sint2))
7333 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
7334 & *(xx*cost2-yy*sint2))
7335 s1=(1+x(63))/(0.1d0 + dscp1)
7336 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
7337 s2=(1+x(65))/(0.1d0 + dscp2)
7338 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
7339 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
7340 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
7345 c------------------------------------------------------------------------------
7346 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
7348 C This procedure calculates two-body contact function g(rij) and its derivative:
7351 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
7354 C where x=(rij-r0ij)/delta
7356 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
7359 double precision rij,r0ij,eps0ij,fcont,fprimcont
7360 double precision x,x2,x4,delta
7364 if (x.lt.-1.0D0) then
7367 else if (x.le.1.0D0) then
7370 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
7371 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
7378 c------------------------------------------------------------------------------
7379 subroutine splinthet(theti,delta,ss,ssder)
7380 implicit real*8 (a-h,o-z)
7381 include 'DIMENSIONS'
7382 include 'COMMON.VAR'
7383 include 'COMMON.GEO'
7386 if (theti.gt.pipol) then
7387 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
7389 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
7394 c------------------------------------------------------------------------------
7395 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
7397 double precision x,x0,delta,f0,f1,fprim0,f,fprim
7398 double precision ksi,ksi2,ksi3,a1,a2,a3
7399 a1=fprim0*delta/(f1-f0)
7405 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
7406 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
7409 c------------------------------------------------------------------------------
7410 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
7412 double precision x,x0,delta,f0x,f1x,fprim0x,fx
7413 double precision ksi,ksi2,ksi3,a1,a2,a3
7418 a2=3*(f1x-f0x)-2*fprim0x*delta
7419 a3=fprim0x*delta-2*(f1x-f0x)
7420 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
7423 C-----------------------------------------------------------------------------
7425 C-----------------------------------------------------------------------------
7426 subroutine etor(etors,edihcnstr)
7427 implicit real*8 (a-h,o-z)
7428 include 'DIMENSIONS'
7429 include 'COMMON.VAR'
7430 include 'COMMON.GEO'
7431 include 'COMMON.LOCAL'
7432 include 'COMMON.TORSION'
7433 include 'COMMON.INTERACT'
7434 include 'COMMON.DERIV'
7435 include 'COMMON.CHAIN'
7436 include 'COMMON.NAMES'
7437 include 'COMMON.IOUNITS'
7438 include 'COMMON.FFIELD'
7439 include 'COMMON.TORCNSTR'
7440 include 'COMMON.CONTROL'
7442 C Set lprn=.true. for debugging
7446 do i=iphi_start,iphi_end
7448 itori=itortyp(itype(i-2))
7449 itori1=itortyp(itype(i-1))
7452 C Proline-Proline pair is a special case...
7453 if (itori.eq.3 .and. itori1.eq.3) then
7454 if (phii.gt.-dwapi3) then
7456 fac=1.0D0/(1.0D0-cosphi)
7457 etorsi=v1(1,3,3)*fac
7458 etorsi=etorsi+etorsi
7459 etors=etors+etorsi-v1(1,3,3)
7460 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
7461 gloci=gloci-3*fac*etorsi*dsin(3*phii)
7464 v1ij=v1(j+1,itori,itori1)
7465 v2ij=v2(j+1,itori,itori1)
7468 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7469 if (energy_dec) etors_ii=etors_ii+
7470 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7471 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7475 v1ij=v1(j,itori,itori1)
7476 v2ij=v2(j,itori,itori1)
7479 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7480 if (energy_dec) etors_ii=etors_ii+
7481 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
7482 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7485 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
7488 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7489 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7490 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
7491 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7492 write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7494 ! 6/20/98 - dihedral angle constraints
7497 itori=idih_constr(i)
7500 if (difi.gt.drange(i)) then
7502 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
7503 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
7504 else if (difi.lt.-drange(i)) then
7506 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
7507 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
7509 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
7510 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
7512 ! write (iout,*) 'edihcnstr',edihcnstr
7515 c------------------------------------------------------------------------------
7516 subroutine etor_d(etors_d)
7520 c----------------------------------------------------------------------------
7522 subroutine etor(etors,edihcnstr)
7523 implicit real*8 (a-h,o-z)
7524 include 'DIMENSIONS'
7525 include 'COMMON.VAR'
7526 include 'COMMON.GEO'
7527 include 'COMMON.LOCAL'
7528 include 'COMMON.TORSION'
7529 include 'COMMON.INTERACT'
7530 include 'COMMON.DERIV'
7531 include 'COMMON.CHAIN'
7532 include 'COMMON.NAMES'
7533 include 'COMMON.IOUNITS'
7534 include 'COMMON.FFIELD'
7535 include 'COMMON.TORCNSTR'
7536 include 'COMMON.CONTROL'
7538 C Set lprn=.true. for debugging
7542 do i=iphi_start,iphi_end
7544 itori=itortyp(itype(i-2))
7545 itori1=itortyp(itype(i-1))
7548 C Regular cosine and sine terms
7549 do j=1,nterm(itori,itori1)
7550 v1ij=v1(j,itori,itori1)
7551 v2ij=v2(j,itori,itori1)
7554 etors=etors+v1ij*cosphi+v2ij*sinphi
7555 if (energy_dec) etors_ii=etors_ii+
7556 & v1ij*cosphi+v2ij*sinphi
7557 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7561 C E = SUM ----------------------------------- - v1
7562 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
7564 cosphi=dcos(0.5d0*phii)
7565 sinphi=dsin(0.5d0*phii)
7566 do j=1,nlor(itori,itori1)
7567 vl1ij=vlor1(j,itori,itori1)
7568 vl2ij=vlor2(j,itori,itori1)
7569 vl3ij=vlor3(j,itori,itori1)
7570 pom=vl2ij*cosphi+vl3ij*sinphi
7571 pom1=1.0d0/(pom*pom+1.0d0)
7572 etors=etors+vl1ij*pom1
7573 if (energy_dec) etors_ii=etors_ii+
7576 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
7578 C Subtract the constant term
7579 etors=etors-v0(itori,itori1)
7580 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
7581 & 'etor',i,etors_ii-v0(itori,itori1)
7583 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7584 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7585 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
7586 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
7587 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
7589 ! 6/20/98 - dihedral angle constraints
7591 c do i=1,ndih_constr
7592 do i=idihconstr_start,idihconstr_end
7593 itori=idih_constr(i)
7595 difi=pinorm(phii-phi0(i))
7596 if (difi.gt.drange(i)) then
7598 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
7599 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
7600 else if (difi.lt.-drange(i)) then
7602 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
7603 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
7607 c write (iout,*) "gloci", gloc(i-3,icg)
7608 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
7609 cd & rad2deg*phi0(i), rad2deg*drange(i),
7610 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
7612 cd write (iout,*) 'edihcnstr',edihcnstr
7615 c----------------------------------------------------------------------------
7616 subroutine etor_d(etors_d)
7617 C 6/23/01 Compute double torsional energy
7618 implicit real*8 (a-h,o-z)
7619 include 'DIMENSIONS'
7620 include 'COMMON.VAR'
7621 include 'COMMON.GEO'
7622 include 'COMMON.LOCAL'
7623 include 'COMMON.TORSION'
7624 include 'COMMON.INTERACT'
7625 include 'COMMON.DERIV'
7626 include 'COMMON.CHAIN'
7627 include 'COMMON.NAMES'
7628 include 'COMMON.IOUNITS'
7629 include 'COMMON.FFIELD'
7630 include 'COMMON.TORCNSTR'
7632 C Set lprn=.true. for debugging
7636 do i=iphid_start,iphid_end
7637 itori=itortyp(itype(i-2))
7638 itori1=itortyp(itype(i-1))
7639 itori2=itortyp(itype(i))
7644 do j=1,ntermd_1(itori,itori1,itori2)
7645 v1cij=v1c(1,j,itori,itori1,itori2)
7646 v1sij=v1s(1,j,itori,itori1,itori2)
7647 v2cij=v1c(2,j,itori,itori1,itori2)
7648 v2sij=v1s(2,j,itori,itori1,itori2)
7649 cosphi1=dcos(j*phii)
7650 sinphi1=dsin(j*phii)
7651 cosphi2=dcos(j*phii1)
7652 sinphi2=dsin(j*phii1)
7653 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
7654 & v2cij*cosphi2+v2sij*sinphi2
7655 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
7656 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
7658 do k=2,ntermd_2(itori,itori1,itori2)
7660 v1cdij = v2c(k,l,itori,itori1,itori2)
7661 v2cdij = v2c(l,k,itori,itori1,itori2)
7662 v1sdij = v2s(k,l,itori,itori1,itori2)
7663 v2sdij = v2s(l,k,itori,itori1,itori2)
7664 cosphi1p2=dcos(l*phii+(k-l)*phii1)
7665 cosphi1m2=dcos(l*phii-(k-l)*phii1)
7666 sinphi1p2=dsin(l*phii+(k-l)*phii1)
7667 sinphi1m2=dsin(l*phii-(k-l)*phii1)
7668 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
7669 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
7670 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
7671 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
7672 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
7673 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
7676 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
7677 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
7678 c write (iout,*) "gloci", gloc(i-3,icg)
7683 c------------------------------------------------------------------------------
7684 subroutine eback_sc_corr(esccor)
7685 c 7/21/2007 Correlations between the backbone-local and side-chain-local
7686 c conformational states; temporarily implemented as differences
7687 c between UNRES torsional potentials (dependent on three types of
7688 c residues) and the torsional potentials dependent on all 20 types
7689 c of residues computed from AM1 energy surfaces of terminally-blocked
7690 c amino-acid residues.
7691 implicit real*8 (a-h,o-z)
7692 include 'DIMENSIONS'
7693 include 'COMMON.VAR'
7694 include 'COMMON.GEO'
7695 include 'COMMON.LOCAL'
7696 include 'COMMON.TORSION'
7697 include 'COMMON.SCCOR'
7698 include 'COMMON.INTERACT'
7699 include 'COMMON.DERIV'
7700 include 'COMMON.CHAIN'
7701 include 'COMMON.NAMES'
7702 include 'COMMON.IOUNITS'
7703 include 'COMMON.FFIELD'
7704 include 'COMMON.CONTROL'
7706 C Set lprn=.true. for debugging
7709 c write (iout,*) "EBACK_SC_COR",iphi_start,iphi_end,nterm_sccor
7711 do i=itau_start,itau_end
7713 isccori=isccortyp(itype(i-2))
7714 isccori1=isccortyp(itype(i-1))
7716 cccc Added 9 May 2012
7717 cc Tauangle is torsional engle depending on the value of first digit
7718 c(see comment below)
7719 cc Omicron is flat angle depending on the value of first digit
7720 c(see comment below)
7723 do intertyp=1,3 !intertyp
7724 cc Added 09 May 2012 (Adasko)
7725 cc Intertyp means interaction type of backbone mainchain correlation:
7726 c 1 = SC...Ca...Ca...Ca
7727 c 2 = Ca...Ca...Ca...SC
7728 c 3 = SC...Ca...Ca...SCi
7730 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
7731 & (itype(i-1).eq.10).or.(itype(i-2).eq.21).or.
7732 & (itype(i-1).eq.21)))
7733 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
7734 & .or.(itype(i-2).eq.21)))
7735 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
7736 & (itype(i-1).eq.21)))) cycle
7737 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.21)) cycle
7738 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.21))
7740 do j=1,nterm_sccor(isccori,isccori1)
7741 v1ij=v1sccor(j,intertyp,isccori,isccori1)
7742 v2ij=v2sccor(j,intertyp,isccori,isccori1)
7743 cosphi=dcos(j*tauangle(intertyp,i))
7744 sinphi=dsin(j*tauangle(intertyp,i))
7745 esccor=esccor+v1ij*cosphi+v2ij*sinphi
7746 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7748 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
7749 c write (iout,*) "WTF",intertyp,i,itype(i),v1ij*cosphi+v2ij*sinphi
7750 c &gloc_sc(intertyp,i-3,icg)
7752 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7753 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
7754 & (v1sccor(j,intertyp,itori,itori1),j=1,6)
7755 & ,(v2sccor(j,intertyp,itori,itori1),j=1,6)
7756 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
7760 c write (iout,*) "W@T@F", gloc_sc(1,i,icg),gloc(i,icg)
7764 c----------------------------------------------------------------------------
7765 subroutine multibody(ecorr)
7766 C This subroutine calculates multi-body contributions to energy following
7767 C the idea of Skolnick et al. If side chains I and J make a contact and
7768 C at the same time side chains I+1 and J+1 make a contact, an extra
7769 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
7770 implicit real*8 (a-h,o-z)
7771 include 'DIMENSIONS'
7772 include 'COMMON.IOUNITS'
7773 include 'COMMON.DERIV'
7774 include 'COMMON.INTERACT'
7775 include 'COMMON.CONTACTS'
7776 double precision gx(3),gx1(3)
7779 C Set lprn=.true. for debugging
7783 write (iout,'(a)') 'Contact function values:'
7785 write (iout,'(i2,20(1x,i2,f10.5))')
7786 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
7801 num_conti=num_cont(i)
7802 num_conti1=num_cont(i1)
7807 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
7808 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7809 cd & ' ishift=',ishift
7810 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
7811 C The system gains extra energy.
7812 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
7813 endif ! j1==j+-ishift
7822 c------------------------------------------------------------------------------
7823 double precision function esccorr(i,j,k,l,jj,kk)
7824 implicit real*8 (a-h,o-z)
7825 include 'DIMENSIONS'
7826 include 'COMMON.IOUNITS'
7827 include 'COMMON.DERIV'
7828 include 'COMMON.INTERACT'
7829 include 'COMMON.CONTACTS'
7830 double precision gx(3),gx1(3)
7835 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7836 C Calculate the multi-body contribution to energy.
7837 C Calculate multi-body contributions to the gradient.
7838 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7839 cd & k,l,(gacont(m,kk,k),m=1,3)
7841 gx(m) =ekl*gacont(m,jj,i)
7842 gx1(m)=eij*gacont(m,kk,k)
7843 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7844 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7845 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7846 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7850 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7855 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7861 c------------------------------------------------------------------------------
7862 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7863 C This subroutine calculates multi-body contributions to hydrogen-bonding
7864 implicit real*8 (a-h,o-z)
7865 include 'DIMENSIONS'
7866 include 'COMMON.IOUNITS'
7869 parameter (max_cont=maxconts)
7870 parameter (max_dim=26)
7871 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7872 double precision zapas(max_dim,maxconts,max_fg_procs),
7873 & zapas_recv(max_dim,maxconts,max_fg_procs)
7874 common /przechowalnia/ zapas
7875 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7876 & status_array(MPI_STATUS_SIZE,maxconts*2)
7878 include 'COMMON.SETUP'
7879 include 'COMMON.FFIELD'
7880 include 'COMMON.DERIV'
7881 include 'COMMON.INTERACT'
7882 include 'COMMON.CONTACTS'
7883 include 'COMMON.CONTROL'
7884 include 'COMMON.LOCAL'
7885 double precision gx(3),gx1(3),time00
7888 C Set lprn=.true. for debugging
7893 if (nfgtasks.le.1) goto 30
7895 write (iout,'(a)') 'Contact function values before RECEIVE:'
7897 write (iout,'(2i3,50(1x,i2,f5.2))')
7898 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7899 & j=1,num_cont_hb(i))
7903 do i=1,ntask_cont_from
7906 do i=1,ntask_cont_to
7909 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7911 C Make the list of contacts to send to send to other procesors
7912 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
7914 do i=iturn3_start,iturn3_end
7915 c write (iout,*) "make contact list turn3",i," num_cont",
7917 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
7919 do i=iturn4_start,iturn4_end
7920 c write (iout,*) "make contact list turn4",i," num_cont",
7922 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
7926 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7928 do j=1,num_cont_hb(i)
7931 iproc=iint_sent_local(k,jjc,ii)
7932 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7933 if (iproc.gt.0) then
7934 ncont_sent(iproc)=ncont_sent(iproc)+1
7935 nn=ncont_sent(iproc)
7937 zapas(2,nn,iproc)=jjc
7938 zapas(3,nn,iproc)=facont_hb(j,i)
7939 zapas(4,nn,iproc)=ees0p(j,i)
7940 zapas(5,nn,iproc)=ees0m(j,i)
7941 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
7942 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
7943 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
7944 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
7945 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
7946 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
7947 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
7948 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
7949 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
7950 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
7951 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
7952 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
7953 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
7954 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
7955 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
7956 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
7957 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
7958 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
7959 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
7960 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
7961 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
7968 & "Numbers of contacts to be sent to other processors",
7969 & (ncont_sent(i),i=1,ntask_cont_to)
7970 write (iout,*) "Contacts sent"
7971 do ii=1,ntask_cont_to
7973 iproc=itask_cont_to(ii)
7974 write (iout,*) nn," contacts to processor",iproc,
7975 & " of CONT_TO_COMM group"
7977 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7985 CorrelID1=nfgtasks+fg_rank+1
7987 C Receive the numbers of needed contacts from other processors
7988 do ii=1,ntask_cont_from
7989 iproc=itask_cont_from(ii)
7991 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7992 & FG_COMM,req(ireq),IERR)
7994 c write (iout,*) "IRECV ended"
7996 C Send the number of contacts needed by other processors
7997 do ii=1,ntask_cont_to
7998 iproc=itask_cont_to(ii)
8000 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
8001 & FG_COMM,req(ireq),IERR)
8003 c write (iout,*) "ISEND ended"
8004 c write (iout,*) "number of requests (nn)",ireq
8007 & call MPI_Waitall(ireq,req,status_array,ierr)
8009 c & "Numbers of contacts to be received from other processors",
8010 c & (ncont_recv(i),i=1,ntask_cont_from)
8014 do ii=1,ntask_cont_from
8015 iproc=itask_cont_from(ii)
8017 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
8018 c & " of CONT_TO_COMM group"
8022 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
8023 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8024 c write (iout,*) "ireq,req",ireq,req(ireq)
8027 C Send the contacts to processors that need them
8028 do ii=1,ntask_cont_to
8029 iproc=itask_cont_to(ii)
8031 c write (iout,*) nn," contacts to processor",iproc,
8032 c & " of CONT_TO_COMM group"
8035 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
8036 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8037 c write (iout,*) "ireq,req",ireq,req(ireq)
8039 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8043 c write (iout,*) "number of requests (contacts)",ireq
8044 c write (iout,*) "req",(req(i),i=1,4)
8047 & call MPI_Waitall(ireq,req,status_array,ierr)
8048 do iii=1,ntask_cont_from
8049 iproc=itask_cont_from(iii)
8052 write (iout,*) "Received",nn," contacts from processor",iproc,
8053 & " of CONT_FROM_COMM group"
8056 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
8061 ii=zapas_recv(1,i,iii)
8062 c Flag the received contacts to prevent double-counting
8063 jj=-zapas_recv(2,i,iii)
8064 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
8066 nnn=num_cont_hb(ii)+1
8069 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
8070 ees0p(nnn,ii)=zapas_recv(4,i,iii)
8071 ees0m(nnn,ii)=zapas_recv(5,i,iii)
8072 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
8073 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
8074 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
8075 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
8076 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
8077 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
8078 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
8079 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
8080 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
8081 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
8082 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
8083 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
8084 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
8085 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
8086 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
8087 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
8088 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
8089 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
8090 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
8091 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
8092 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
8097 write (iout,'(a)') 'Contact function values after receive:'
8099 write (iout,'(2i3,50(1x,i3,f5.2))')
8100 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8101 & j=1,num_cont_hb(i))
8108 write (iout,'(a)') 'Contact function values:'
8110 write (iout,'(2i3,50(1x,i3,f5.2))')
8111 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8112 & j=1,num_cont_hb(i))
8116 C Remove the loop below after debugging !!!
8123 C Calculate the local-electrostatic correlation terms
8124 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
8126 num_conti=num_cont_hb(i)
8127 num_conti1=num_cont_hb(i+1)
8134 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8135 c & ' jj=',jj,' kk=',kk
8136 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
8137 & .or. j.lt.0 .and. j1.gt.0) .and.
8138 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
8139 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
8140 C The system gains extra energy.
8141 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
8142 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
8143 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
8145 else if (j1.eq.j) then
8146 C Contacts I-J and I-(J+1) occur simultaneously.
8147 C The system loses extra energy.
8148 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
8153 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8154 c & ' jj=',jj,' kk=',kk
8156 C Contacts I-J and (I+1)-J occur simultaneously.
8157 C The system loses extra energy.
8158 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
8165 c------------------------------------------------------------------------------
8166 subroutine add_hb_contact(ii,jj,itask)
8167 implicit real*8 (a-h,o-z)
8168 include "DIMENSIONS"
8169 include "COMMON.IOUNITS"
8172 parameter (max_cont=maxconts)
8173 parameter (max_dim=26)
8174 include "COMMON.CONTACTS"
8175 double precision zapas(max_dim,maxconts,max_fg_procs),
8176 & zapas_recv(max_dim,maxconts,max_fg_procs)
8177 common /przechowalnia/ zapas
8178 integer i,j,ii,jj,iproc,itask(4),nn
8179 c write (iout,*) "itask",itask
8182 if (iproc.gt.0) then
8183 do j=1,num_cont_hb(ii)
8185 c write (iout,*) "i",ii," j",jj," jjc",jjc
8187 ncont_sent(iproc)=ncont_sent(iproc)+1
8188 nn=ncont_sent(iproc)
8189 zapas(1,nn,iproc)=ii
8190 zapas(2,nn,iproc)=jjc
8191 zapas(3,nn,iproc)=facont_hb(j,ii)
8192 zapas(4,nn,iproc)=ees0p(j,ii)
8193 zapas(5,nn,iproc)=ees0m(j,ii)
8194 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
8195 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
8196 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
8197 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
8198 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
8199 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
8200 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
8201 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
8202 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
8203 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
8204 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
8205 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
8206 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
8207 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
8208 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
8209 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
8210 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
8211 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
8212 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
8213 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
8214 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
8222 c------------------------------------------------------------------------------
8223 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
8225 C This subroutine calculates multi-body contributions to hydrogen-bonding
8226 implicit real*8 (a-h,o-z)
8227 include 'DIMENSIONS'
8228 include 'COMMON.IOUNITS'
8231 parameter (max_cont=maxconts)
8232 parameter (max_dim=70)
8233 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
8234 double precision zapas(max_dim,maxconts,max_fg_procs),
8235 & zapas_recv(max_dim,maxconts,max_fg_procs)
8236 common /przechowalnia/ zapas
8237 integer status(MPI_STATUS_SIZE),req(maxconts*2),
8238 & status_array(MPI_STATUS_SIZE,maxconts*2)
8240 include 'COMMON.SETUP'
8241 include 'COMMON.FFIELD'
8242 include 'COMMON.DERIV'
8243 include 'COMMON.LOCAL'
8244 include 'COMMON.INTERACT'
8245 include 'COMMON.CONTACTS'
8246 include 'COMMON.CHAIN'
8247 include 'COMMON.CONTROL'
8248 double precision gx(3),gx1(3)
8249 integer num_cont_hb_old(maxres)
8251 double precision eello4,eello5,eelo6,eello_turn6
8252 external eello4,eello5,eello6,eello_turn6
8253 C Set lprn=.true. for debugging
8258 num_cont_hb_old(i)=num_cont_hb(i)
8262 if (nfgtasks.le.1) goto 30
8264 write (iout,'(a)') 'Contact function values before RECEIVE:'
8266 write (iout,'(2i3,50(1x,i2,f5.2))')
8267 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
8268 & j=1,num_cont_hb(i))
8272 do i=1,ntask_cont_from
8275 do i=1,ntask_cont_to
8278 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
8280 C Make the list of contacts to send to send to other procesors
8281 do i=iturn3_start,iturn3_end
8282 c write (iout,*) "make contact list turn3",i," num_cont",
8284 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
8286 do i=iturn4_start,iturn4_end
8287 c write (iout,*) "make contact list turn4",i," num_cont",
8289 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
8293 c write (iout,*) "make contact list longrange",i,ii," num_cont",
8295 do j=1,num_cont_hb(i)
8298 iproc=iint_sent_local(k,jjc,ii)
8299 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
8300 if (iproc.ne.0) then
8301 ncont_sent(iproc)=ncont_sent(iproc)+1
8302 nn=ncont_sent(iproc)
8304 zapas(2,nn,iproc)=jjc
8305 zapas(3,nn,iproc)=d_cont(j,i)
8309 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
8314 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
8322 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
8333 & "Numbers of contacts to be sent to other processors",
8334 & (ncont_sent(i),i=1,ntask_cont_to)
8335 write (iout,*) "Contacts sent"
8336 do ii=1,ntask_cont_to
8338 iproc=itask_cont_to(ii)
8339 write (iout,*) nn," contacts to processor",iproc,
8340 & " of CONT_TO_COMM group"
8342 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
8350 CorrelID1=nfgtasks+fg_rank+1
8352 C Receive the numbers of needed contacts from other processors
8353 do ii=1,ntask_cont_from
8354 iproc=itask_cont_from(ii)
8356 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
8357 & FG_COMM,req(ireq),IERR)
8359 c write (iout,*) "IRECV ended"
8361 C Send the number of contacts needed by other processors
8362 do ii=1,ntask_cont_to
8363 iproc=itask_cont_to(ii)
8365 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
8366 & FG_COMM,req(ireq),IERR)
8368 c write (iout,*) "ISEND ended"
8369 c write (iout,*) "number of requests (nn)",ireq
8372 & call MPI_Waitall(ireq,req,status_array,ierr)
8374 c & "Numbers of contacts to be received from other processors",
8375 c & (ncont_recv(i),i=1,ntask_cont_from)
8379 do ii=1,ntask_cont_from
8380 iproc=itask_cont_from(ii)
8382 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
8383 c & " of CONT_TO_COMM group"
8387 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
8388 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8389 c write (iout,*) "ireq,req",ireq,req(ireq)
8392 C Send the contacts to processors that need them
8393 do ii=1,ntask_cont_to
8394 iproc=itask_cont_to(ii)
8396 c write (iout,*) nn," contacts to processor",iproc,
8397 c & " of CONT_TO_COMM group"
8400 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
8401 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
8402 c write (iout,*) "ireq,req",ireq,req(ireq)
8404 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
8408 c write (iout,*) "number of requests (contacts)",ireq
8409 c write (iout,*) "req",(req(i),i=1,4)
8412 & call MPI_Waitall(ireq,req,status_array,ierr)
8413 do iii=1,ntask_cont_from
8414 iproc=itask_cont_from(iii)
8417 write (iout,*) "Received",nn," contacts from processor",iproc,
8418 & " of CONT_FROM_COMM group"
8421 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
8426 ii=zapas_recv(1,i,iii)
8427 c Flag the received contacts to prevent double-counting
8428 jj=-zapas_recv(2,i,iii)
8429 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
8431 nnn=num_cont_hb(ii)+1
8434 d_cont(nnn,ii)=zapas_recv(3,i,iii)
8438 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
8443 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
8451 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
8460 write (iout,'(a)') 'Contact function values after receive:'
8462 write (iout,'(2i3,50(1x,i3,5f6.3))')
8463 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
8464 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8471 write (iout,'(a)') 'Contact function values:'
8473 write (iout,'(2i3,50(1x,i2,5f6.3))')
8474 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
8475 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
8481 C Remove the loop below after debugging !!!
8488 C Calculate the dipole-dipole interaction energies
8489 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
8490 do i=iatel_s,iatel_e+1
8491 num_conti=num_cont_hb(i)
8500 C Calculate the local-electrostatic correlation terms
8501 c write (iout,*) "gradcorr5 in eello5 before loop"
8503 c write (iout,'(i5,3f10.5)')
8504 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8506 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
8507 c write (iout,*) "corr loop i",i
8509 num_conti=num_cont_hb(i)
8510 num_conti1=num_cont_hb(i+1)
8517 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
8518 c & ' jj=',jj,' kk=',kk
8519 c if (j1.eq.j+1 .or. j1.eq.j-1) then
8520 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
8521 & .or. j.lt.0 .and. j1.gt.0) .and.
8522 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
8523 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
8524 C The system gains extra energy.
8526 sqd1=dsqrt(d_cont(jj,i))
8527 sqd2=dsqrt(d_cont(kk,i1))
8528 sred_geom = sqd1*sqd2
8529 IF (sred_geom.lt.cutoff_corr) THEN
8530 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
8532 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
8533 cd & ' jj=',jj,' kk=',kk
8534 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
8535 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
8537 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
8538 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
8541 cd write (iout,*) 'sred_geom=',sred_geom,
8542 cd & ' ekont=',ekont,' fprim=',fprimcont,
8543 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
8544 cd write (iout,*) "g_contij",g_contij
8545 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
8546 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
8547 call calc_eello(i,jp,i+1,jp1,jj,kk)
8548 if (wcorr4.gt.0.0d0)
8549 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
8550 if (energy_dec.and.wcorr4.gt.0.0d0)
8551 1 write (iout,'(a6,4i5,0pf7.3)')
8552 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
8553 c write (iout,*) "gradcorr5 before eello5"
8555 c write (iout,'(i5,3f10.5)')
8556 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8558 if (wcorr5.gt.0.0d0)
8559 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
8560 c write (iout,*) "gradcorr5 after eello5"
8562 c write (iout,'(i5,3f10.5)')
8563 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8565 if (energy_dec.and.wcorr5.gt.0.0d0)
8566 1 write (iout,'(a6,4i5,0pf7.3)')
8567 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
8568 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
8569 cd write(2,*)'ijkl',i,jp,i+1,jp1
8570 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
8571 & .or. wturn6.eq.0.0d0))then
8572 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
8573 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
8574 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
8575 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
8576 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
8577 cd & 'ecorr6=',ecorr6
8578 cd write (iout,'(4e15.5)') sred_geom,
8579 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
8580 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
8581 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
8582 else if (wturn6.gt.0.0d0
8583 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
8584 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
8585 eturn6=eturn6+eello_turn6(i,jj,kk)
8586 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
8587 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
8588 cd write (2,*) 'multibody_eello:eturn6',eturn6
8597 num_cont_hb(i)=num_cont_hb_old(i)
8599 c write (iout,*) "gradcorr5 in eello5"
8601 c write (iout,'(i5,3f10.5)')
8602 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
8606 c------------------------------------------------------------------------------
8607 subroutine add_hb_contact_eello(ii,jj,itask)
8608 implicit real*8 (a-h,o-z)
8609 include "DIMENSIONS"
8610 include "COMMON.IOUNITS"
8613 parameter (max_cont=maxconts)
8614 parameter (max_dim=70)
8615 include "COMMON.CONTACTS"
8616 double precision zapas(max_dim,maxconts,max_fg_procs),
8617 & zapas_recv(max_dim,maxconts,max_fg_procs)
8618 common /przechowalnia/ zapas
8619 integer i,j,ii,jj,iproc,itask(4),nn
8620 c write (iout,*) "itask",itask
8623 if (iproc.gt.0) then
8624 do j=1,num_cont_hb(ii)
8626 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
8628 ncont_sent(iproc)=ncont_sent(iproc)+1
8629 nn=ncont_sent(iproc)
8630 zapas(1,nn,iproc)=ii
8631 zapas(2,nn,iproc)=jjc
8632 zapas(3,nn,iproc)=d_cont(j,ii)
8636 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
8641 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
8649 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
8661 c------------------------------------------------------------------------------
8662 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
8663 implicit real*8 (a-h,o-z)
8664 include 'DIMENSIONS'
8665 include 'COMMON.IOUNITS'
8666 include 'COMMON.DERIV'
8667 include 'COMMON.INTERACT'
8668 include 'COMMON.CONTACTS'
8669 double precision gx(3),gx1(3)
8679 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
8680 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
8681 C Following 4 lines for diagnostics.
8686 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
8687 c & 'Contacts ',i,j,
8688 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
8689 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
8691 C Calculate the multi-body contribution to energy.
8692 c ecorr=ecorr+ekont*ees
8693 C Calculate multi-body contributions to the gradient.
8694 coeffpees0pij=coeffp*ees0pij
8695 coeffmees0mij=coeffm*ees0mij
8696 coeffpees0pkl=coeffp*ees0pkl
8697 coeffmees0mkl=coeffm*ees0mkl
8699 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
8700 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
8701 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
8702 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
8703 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
8704 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
8705 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
8706 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
8707 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
8708 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
8709 & coeffmees0mij*gacontm_hb1(ll,kk,k))
8710 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
8711 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
8712 & coeffmees0mij*gacontm_hb2(ll,kk,k))
8713 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
8714 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
8715 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
8716 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
8717 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
8718 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
8719 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
8720 & coeffmees0mij*gacontm_hb3(ll,kk,k))
8721 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
8722 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
8723 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
8728 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8729 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
8730 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
8731 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
8736 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8737 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
8738 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
8739 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
8742 c write (iout,*) "ehbcorr",ekont*ees
8747 C---------------------------------------------------------------------------
8748 subroutine dipole(i,j,jj)
8749 implicit real*8 (a-h,o-z)
8750 include 'DIMENSIONS'
8751 include 'COMMON.IOUNITS'
8752 include 'COMMON.CHAIN'
8753 include 'COMMON.FFIELD'
8754 include 'COMMON.DERIV'
8755 include 'COMMON.INTERACT'
8756 include 'COMMON.CONTACTS'
8757 include 'COMMON.TORSION'
8758 include 'COMMON.VAR'
8759 include 'COMMON.GEO'
8760 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
8762 iti1 = itortyp(itype(i+1))
8763 if (j.lt.nres-1) then
8764 itj1 = itortyp(itype(j+1))
8769 dipi(iii,1)=Ub2(iii,i)
8770 dipderi(iii)=Ub2der(iii,i)
8771 dipi(iii,2)=b1(iii,i+1)
8772 dipj(iii,1)=Ub2(iii,j)
8773 dipderj(iii)=Ub2der(iii,j)
8774 dipj(iii,2)=b1(iii,i+1)
8778 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
8781 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8788 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
8792 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8797 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
8798 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
8800 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
8802 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
8804 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
8809 C---------------------------------------------------------------------------
8810 subroutine calc_eello(i,j,k,l,jj,kk)
8812 C This subroutine computes matrices and vectors needed to calculate
8813 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
8815 implicit real*8 (a-h,o-z)
8816 include 'DIMENSIONS'
8817 include 'COMMON.IOUNITS'
8818 include 'COMMON.CHAIN'
8819 include 'COMMON.DERIV'
8820 include 'COMMON.INTERACT'
8821 include 'COMMON.CONTACTS'
8822 include 'COMMON.TORSION'
8823 include 'COMMON.VAR'
8824 include 'COMMON.GEO'
8825 include 'COMMON.FFIELD'
8826 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
8827 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
8830 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
8831 cd & ' jj=',jj,' kk=',kk
8832 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
8833 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
8834 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
8837 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
8838 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
8841 call transpose2(aa1(1,1),aa1t(1,1))
8842 call transpose2(aa2(1,1),aa2t(1,1))
8845 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
8846 & aa1tder(1,1,lll,kkk))
8847 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
8848 & aa2tder(1,1,lll,kkk))
8852 C parallel orientation of the two CA-CA-CA frames.
8854 iti=itortyp(itype(i))
8858 itk1=itortyp(itype(k+1))
8859 itj=itortyp(itype(j))
8860 if (l.lt.nres-1) then
8861 itl1=itortyp(itype(l+1))
8865 C A1 kernel(j+1) A2T
8867 cd write (iout,'(3f10.5,5x,3f10.5)')
8868 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
8870 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8871 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
8872 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8873 C Following matrices are needed only for 6-th order cumulants
8874 IF (wcorr6.gt.0.0d0) THEN
8875 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8876 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
8877 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8878 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8879 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
8880 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8881 & ADtEAderx(1,1,1,1,1,1))
8883 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8884 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
8885 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8886 & ADtEA1derx(1,1,1,1,1,1))
8888 C End 6-th order cumulants
8891 cd write (2,*) 'In calc_eello6'
8893 cd write (2,*) 'iii=',iii
8895 cd write (2,*) 'kkk=',kkk
8897 cd write (2,'(3(2f10.5),5x)')
8898 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8903 call transpose2(EUgder(1,1,k),auxmat(1,1))
8904 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8905 call transpose2(EUg(1,1,k),auxmat(1,1))
8906 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8907 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8911 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8912 & EAEAderx(1,1,lll,kkk,iii,1))
8916 C A1T kernel(i+1) A2
8917 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8918 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
8919 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8920 C Following matrices are needed only for 6-th order cumulants
8921 IF (wcorr6.gt.0.0d0) THEN
8922 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8923 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
8924 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8925 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8926 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
8927 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8928 & ADtEAderx(1,1,1,1,1,2))
8929 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8930 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
8931 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8932 & ADtEA1derx(1,1,1,1,1,2))
8934 C End 6-th order cumulants
8935 call transpose2(EUgder(1,1,l),auxmat(1,1))
8936 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
8937 call transpose2(EUg(1,1,l),auxmat(1,1))
8938 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8939 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8943 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8944 & EAEAderx(1,1,lll,kkk,iii,2))
8949 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8950 C They are needed only when the fifth- or the sixth-order cumulants are
8952 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
8953 call transpose2(AEA(1,1,1),auxmat(1,1))
8954 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8955 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8956 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8957 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8958 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8959 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8960 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8961 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8962 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8963 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8964 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8965 call transpose2(AEA(1,1,2),auxmat(1,1))
8966 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
8967 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
8968 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
8969 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8970 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
8971 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
8972 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
8973 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
8974 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
8975 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
8976 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
8977 C Calculate the Cartesian derivatives of the vectors.
8981 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8982 call matvec2(auxmat(1,1),b1(1,i),
8983 & AEAb1derx(1,lll,kkk,iii,1,1))
8984 call matvec2(auxmat(1,1),Ub2(1,i),
8985 & AEAb2derx(1,lll,kkk,iii,1,1))
8986 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8987 & AEAb1derx(1,lll,kkk,iii,2,1))
8988 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8989 & AEAb2derx(1,lll,kkk,iii,2,1))
8990 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8991 call matvec2(auxmat(1,1),b1(1,j),
8992 & AEAb1derx(1,lll,kkk,iii,1,2))
8993 call matvec2(auxmat(1,1),Ub2(1,j),
8994 & AEAb2derx(1,lll,kkk,iii,1,2))
8995 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8996 & AEAb1derx(1,lll,kkk,iii,2,2))
8997 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
8998 & AEAb2derx(1,lll,kkk,iii,2,2))
9005 C Antiparallel orientation of the two CA-CA-CA frames.
9007 iti=itortyp(itype(i))
9011 itk1=itortyp(itype(k+1))
9012 itl=itortyp(itype(l))
9013 itj=itortyp(itype(j))
9014 if (j.lt.nres-1) then
9015 itj1=itortyp(itype(j+1))
9019 C A2 kernel(j-1)T A1T
9020 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9021 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
9022 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
9023 C Following matrices are needed only for 6-th order cumulants
9024 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
9025 & j.eq.i+4 .and. l.eq.i+3)) THEN
9026 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9027 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
9028 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
9029 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9030 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
9031 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
9032 & ADtEAderx(1,1,1,1,1,1))
9033 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
9034 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
9035 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
9036 & ADtEA1derx(1,1,1,1,1,1))
9038 C End 6-th order cumulants
9039 call transpose2(EUgder(1,1,k),auxmat(1,1))
9040 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
9041 call transpose2(EUg(1,1,k),auxmat(1,1))
9042 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
9043 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
9047 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
9048 & EAEAderx(1,1,lll,kkk,iii,1))
9052 C A2T kernel(i+1)T A1
9053 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9054 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
9055 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
9056 C Following matrices are needed only for 6-th order cumulants
9057 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
9058 & j.eq.i+4 .and. l.eq.i+3)) THEN
9059 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9060 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
9061 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
9062 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9063 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
9064 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
9065 & ADtEAderx(1,1,1,1,1,2))
9066 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
9067 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
9068 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
9069 & ADtEA1derx(1,1,1,1,1,2))
9071 C End 6-th order cumulants
9072 call transpose2(EUgder(1,1,j),auxmat(1,1))
9073 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
9074 call transpose2(EUg(1,1,j),auxmat(1,1))
9075 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
9076 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
9080 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9081 & EAEAderx(1,1,lll,kkk,iii,2))
9086 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
9087 C They are needed only when the fifth- or the sixth-order cumulants are
9089 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
9090 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
9091 call transpose2(AEA(1,1,1),auxmat(1,1))
9092 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
9093 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
9094 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
9095 call transpose2(AEAderg(1,1,1),auxmat(1,1))
9096 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
9097 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
9098 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
9099 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
9100 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
9101 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
9102 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
9103 call transpose2(AEA(1,1,2),auxmat(1,1))
9104 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
9105 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
9106 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
9107 call transpose2(AEAderg(1,1,2),auxmat(1,1))
9108 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
9109 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
9110 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
9111 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
9112 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
9113 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
9114 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
9115 C Calculate the Cartesian derivatives of the vectors.
9119 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
9120 call matvec2(auxmat(1,1),b1(1,i),
9121 & AEAb1derx(1,lll,kkk,iii,1,1))
9122 call matvec2(auxmat(1,1),Ub2(1,i),
9123 & AEAb2derx(1,lll,kkk,iii,1,1))
9124 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9125 & AEAb1derx(1,lll,kkk,iii,2,1))
9126 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
9127 & AEAb2derx(1,lll,kkk,iii,2,1))
9128 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
9129 call matvec2(auxmat(1,1),b1(1,l),
9130 & AEAb1derx(1,lll,kkk,iii,1,2))
9131 call matvec2(auxmat(1,1),Ub2(1,l),
9132 & AEAb2derx(1,lll,kkk,iii,1,2))
9133 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
9134 & AEAb1derx(1,lll,kkk,iii,2,2))
9135 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
9136 & AEAb2derx(1,lll,kkk,iii,2,2))
9145 C---------------------------------------------------------------------------
9146 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
9147 & KK,KKderg,AKA,AKAderg,AKAderx)
9151 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
9152 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
9153 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
9158 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
9160 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
9163 cd if (lprn) write (2,*) 'In kernel'
9165 cd if (lprn) write (2,*) 'kkk=',kkk
9167 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
9168 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
9170 cd write (2,*) 'lll=',lll
9171 cd write (2,*) 'iii=1'
9173 cd write (2,'(3(2f10.5),5x)')
9174 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
9177 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
9178 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
9180 cd write (2,*) 'lll=',lll
9181 cd write (2,*) 'iii=2'
9183 cd write (2,'(3(2f10.5),5x)')
9184 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
9191 C---------------------------------------------------------------------------
9192 double precision function eello4(i,j,k,l,jj,kk)
9193 implicit real*8 (a-h,o-z)
9194 include 'DIMENSIONS'
9195 include 'COMMON.IOUNITS'
9196 include 'COMMON.CHAIN'
9197 include 'COMMON.DERIV'
9198 include 'COMMON.INTERACT'
9199 include 'COMMON.CONTACTS'
9200 include 'COMMON.TORSION'
9201 include 'COMMON.VAR'
9202 include 'COMMON.GEO'
9203 double precision pizda(2,2),ggg1(3),ggg2(3)
9204 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
9208 cd print *,'eello4:',i,j,k,l,jj,kk
9209 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
9210 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
9211 cold eij=facont_hb(jj,i)
9212 cold ekl=facont_hb(kk,k)
9214 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
9215 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
9216 gcorr_loc(k-1)=gcorr_loc(k-1)
9217 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
9219 gcorr_loc(l-1)=gcorr_loc(l-1)
9220 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9222 gcorr_loc(j-1)=gcorr_loc(j-1)
9223 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
9228 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
9229 & -EAEAderx(2,2,lll,kkk,iii,1)
9230 cd derx(lll,kkk,iii)=0.0d0
9234 cd gcorr_loc(l-1)=0.0d0
9235 cd gcorr_loc(j-1)=0.0d0
9236 cd gcorr_loc(k-1)=0.0d0
9238 cd write (iout,*)'Contacts have occurred for peptide groups',
9239 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
9240 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
9241 if (j.lt.nres-1) then
9248 if (l.lt.nres-1) then
9256 cgrad ggg1(ll)=eel4*g_contij(ll,1)
9257 cgrad ggg2(ll)=eel4*g_contij(ll,2)
9258 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
9259 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
9260 cgrad ghalf=0.5d0*ggg1(ll)
9261 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
9262 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
9263 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
9264 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
9265 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
9266 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
9267 cgrad ghalf=0.5d0*ggg2(ll)
9268 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
9269 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
9270 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
9271 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
9272 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
9273 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
9277 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
9282 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
9287 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
9292 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
9296 cd write (2,*) iii,gcorr_loc(iii)
9299 cd write (2,*) 'ekont',ekont
9300 cd write (iout,*) 'eello4',ekont*eel4
9303 C---------------------------------------------------------------------------
9304 double precision function eello5(i,j,k,l,jj,kk)
9305 implicit real*8 (a-h,o-z)
9306 include 'DIMENSIONS'
9307 include 'COMMON.IOUNITS'
9308 include 'COMMON.CHAIN'
9309 include 'COMMON.DERIV'
9310 include 'COMMON.INTERACT'
9311 include 'COMMON.CONTACTS'
9312 include 'COMMON.TORSION'
9313 include 'COMMON.VAR'
9314 include 'COMMON.GEO'
9315 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
9316 double precision ggg1(3),ggg2(3)
9317 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9322 C /l\ / \ \ / \ / \ / C
9323 C / \ / \ \ / \ / \ / C
9324 C j| o |l1 | o | o| o | | o |o C
9325 C \ |/k\| |/ \| / |/ \| |/ \| C
9326 C \i/ \ / \ / / \ / \ C
9328 C (I) (II) (III) (IV) C
9330 C eello5_1 eello5_2 eello5_3 eello5_4 C
9332 C Antiparallel chains C
9335 C /j\ / \ \ / \ / \ / C
9336 C / \ / \ \ / \ / \ / C
9337 C j1| o |l | o | o| o | | o |o C
9338 C \ |/k\| |/ \| / |/ \| |/ \| C
9339 C \i/ \ / \ / / \ / \ C
9341 C (I) (II) (III) (IV) C
9343 C eello5_1 eello5_2 eello5_3 eello5_4 C
9345 C o denotes a local interaction, vertical lines an electrostatic interaction. C
9347 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9348 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
9353 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
9355 itk=itortyp(itype(k))
9356 itl=itortyp(itype(l))
9357 itj=itortyp(itype(j))
9362 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
9363 cd & eel5_3_num,eel5_4_num)
9367 derx(lll,kkk,iii)=0.0d0
9371 cd eij=facont_hb(jj,i)
9372 cd ekl=facont_hb(kk,k)
9374 cd write (iout,*)'Contacts have occurred for peptide groups',
9375 cd & i,j,' fcont:',eij,' eij',' and ',k,l
9377 C Contribution from the graph I.
9378 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
9379 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
9380 call transpose2(EUg(1,1,k),auxmat(1,1))
9381 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
9382 vv(1)=pizda(1,1)-pizda(2,2)
9383 vv(2)=pizda(1,2)+pizda(2,1)
9384 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
9385 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9386 C Explicit gradient in virtual-dihedral angles.
9387 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
9388 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
9389 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
9390 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9391 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
9392 vv(1)=pizda(1,1)-pizda(2,2)
9393 vv(2)=pizda(1,2)+pizda(2,1)
9394 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9395 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
9396 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9397 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
9398 vv(1)=pizda(1,1)-pizda(2,2)
9399 vv(2)=pizda(1,2)+pizda(2,1)
9401 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
9402 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
9403 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9405 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
9406 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
9407 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
9409 C Cartesian gradient
9413 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
9415 vv(1)=pizda(1,1)-pizda(2,2)
9416 vv(2)=pizda(1,2)+pizda(2,1)
9417 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9418 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
9419 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
9425 C Contribution from graph II
9426 call transpose2(EE(1,1,itk),auxmat(1,1))
9427 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
9428 vv(1)=pizda(1,1)+pizda(2,2)
9429 vv(2)=pizda(2,1)-pizda(1,2)
9430 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
9431 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
9432 C Explicit gradient in virtual-dihedral angles.
9433 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9434 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
9435 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
9436 vv(1)=pizda(1,1)+pizda(2,2)
9437 vv(2)=pizda(2,1)-pizda(1,2)
9439 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9440 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
9441 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
9443 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9444 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
9445 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
9447 C Cartesian gradient
9451 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
9453 vv(1)=pizda(1,1)+pizda(2,2)
9454 vv(2)=pizda(2,1)-pizda(1,2)
9455 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9456 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
9457 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
9465 C Parallel orientation
9466 C Contribution from graph III
9467 call transpose2(EUg(1,1,l),auxmat(1,1))
9468 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9469 vv(1)=pizda(1,1)-pizda(2,2)
9470 vv(2)=pizda(1,2)+pizda(2,1)
9471 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
9472 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
9473 C Explicit gradient in virtual-dihedral angles.
9474 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9475 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
9476 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
9477 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9478 vv(1)=pizda(1,1)-pizda(2,2)
9479 vv(2)=pizda(1,2)+pizda(2,1)
9480 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9481 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
9482 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
9483 call transpose2(EUgder(1,1,l),auxmat1(1,1))
9484 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9485 vv(1)=pizda(1,1)-pizda(2,2)
9486 vv(2)=pizda(1,2)+pizda(2,1)
9487 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9488 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
9489 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
9490 C Cartesian gradient
9494 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
9496 vv(1)=pizda(1,1)-pizda(2,2)
9497 vv(2)=pizda(1,2)+pizda(2,1)
9498 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9499 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
9500 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
9505 C Contribution from graph IV
9507 call transpose2(EE(1,1,itl),auxmat(1,1))
9508 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9509 vv(1)=pizda(1,1)+pizda(2,2)
9510 vv(2)=pizda(2,1)-pizda(1,2)
9511 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
9512 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
9513 C Explicit gradient in virtual-dihedral angles.
9514 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9515 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
9516 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9517 vv(1)=pizda(1,1)+pizda(2,2)
9518 vv(2)=pizda(2,1)-pizda(1,2)
9519 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9520 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
9521 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
9522 C Cartesian gradient
9526 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9528 vv(1)=pizda(1,1)+pizda(2,2)
9529 vv(2)=pizda(2,1)-pizda(1,2)
9530 derx(lll,kkk,iii)=derx(lll,kkk,iii)
9531 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
9532 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
9537 C Antiparallel orientation
9538 C Contribution from graph III
9540 call transpose2(EUg(1,1,j),auxmat(1,1))
9541 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
9542 vv(1)=pizda(1,1)-pizda(2,2)
9543 vv(2)=pizda(1,2)+pizda(2,1)
9544 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
9545 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9546 C Explicit gradient in virtual-dihedral angles.
9547 g_corr5_loc(l-1)=g_corr5_loc(l-1)
9548 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
9549 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
9550 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
9551 vv(1)=pizda(1,1)-pizda(2,2)
9552 vv(2)=pizda(1,2)+pizda(2,1)
9553 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9554 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
9555 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9556 call transpose2(EUgder(1,1,j),auxmat1(1,1))
9557 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
9558 vv(1)=pizda(1,1)-pizda(2,2)
9559 vv(2)=pizda(1,2)+pizda(2,1)
9560 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9561 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
9562 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
9563 C Cartesian gradient
9567 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
9569 vv(1)=pizda(1,1)-pizda(2,2)
9570 vv(2)=pizda(1,2)+pizda(2,1)
9571 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9572 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
9573 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
9578 C Contribution from graph IV
9580 call transpose2(EE(1,1,itj),auxmat(1,1))
9581 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
9582 vv(1)=pizda(1,1)+pizda(2,2)
9583 vv(2)=pizda(2,1)-pizda(1,2)
9584 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
9585 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9586 C Explicit gradient in virtual-dihedral angles.
9587 g_corr5_loc(j-1)=g_corr5_loc(j-1)
9588 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
9589 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
9590 vv(1)=pizda(1,1)+pizda(2,2)
9591 vv(2)=pizda(2,1)-pizda(1,2)
9592 g_corr5_loc(k-1)=g_corr5_loc(k-1)
9593 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
9594 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
9595 C Cartesian gradient
9599 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
9601 vv(1)=pizda(1,1)+pizda(2,2)
9602 vv(2)=pizda(2,1)-pizda(1,2)
9603 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
9604 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
9605 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
9611 eel5=eello5_1+eello5_2+eello5_3+eello5_4
9612 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
9613 cd write (2,*) 'ijkl',i,j,k,l
9614 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
9615 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
9617 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
9618 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
9619 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
9620 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
9621 if (j.lt.nres-1) then
9628 if (l.lt.nres-1) then
9638 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
9639 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
9640 C summed up outside the subrouine as for the other subroutines
9641 C handling long-range interactions. The old code is commented out
9642 C with "cgrad" to keep track of changes.
9644 cgrad ggg1(ll)=eel5*g_contij(ll,1)
9645 cgrad ggg2(ll)=eel5*g_contij(ll,2)
9646 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
9647 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
9648 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
9649 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
9650 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
9651 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
9652 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
9653 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
9655 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
9656 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
9657 cgrad ghalf=0.5d0*ggg1(ll)
9659 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
9660 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
9661 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
9662 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
9663 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
9664 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
9665 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
9666 cgrad ghalf=0.5d0*ggg2(ll)
9668 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
9669 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
9670 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
9671 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
9672 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
9673 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
9678 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
9679 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
9684 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
9685 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
9691 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
9696 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
9700 cd write (2,*) iii,g_corr5_loc(iii)
9703 cd write (2,*) 'ekont',ekont
9704 cd write (iout,*) 'eello5',ekont*eel5
9707 c--------------------------------------------------------------------------
9708 double precision function eello6(i,j,k,l,jj,kk)
9709 implicit real*8 (a-h,o-z)
9710 include 'DIMENSIONS'
9711 include 'COMMON.IOUNITS'
9712 include 'COMMON.CHAIN'
9713 include 'COMMON.DERIV'
9714 include 'COMMON.INTERACT'
9715 include 'COMMON.CONTACTS'
9716 include 'COMMON.TORSION'
9717 include 'COMMON.VAR'
9718 include 'COMMON.GEO'
9719 include 'COMMON.FFIELD'
9720 double precision ggg1(3),ggg2(3)
9721 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9726 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9734 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
9735 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
9739 derx(lll,kkk,iii)=0.0d0
9743 cd eij=facont_hb(jj,i)
9744 cd ekl=facont_hb(kk,k)
9750 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9751 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
9752 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
9753 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9754 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
9755 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
9757 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9758 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
9759 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
9760 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9761 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
9762 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9766 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
9768 C If turn contributions are considered, they will be handled separately.
9769 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
9770 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
9771 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
9772 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
9773 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
9774 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
9775 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
9777 if (j.lt.nres-1) then
9784 if (l.lt.nres-1) then
9792 cgrad ggg1(ll)=eel6*g_contij(ll,1)
9793 cgrad ggg2(ll)=eel6*g_contij(ll,2)
9794 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
9795 cgrad ghalf=0.5d0*ggg1(ll)
9797 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
9798 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
9799 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
9800 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
9801 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
9802 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
9803 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
9804 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
9805 cgrad ghalf=0.5d0*ggg2(ll)
9806 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
9808 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
9809 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
9810 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
9811 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
9812 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
9813 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
9818 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
9819 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
9824 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
9825 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
9831 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
9836 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
9840 cd write (2,*) iii,g_corr6_loc(iii)
9843 cd write (2,*) 'ekont',ekont
9844 cd write (iout,*) 'eello6',ekont*eel6
9847 c--------------------------------------------------------------------------
9848 double precision function eello6_graph1(i,j,k,l,imat,swap)
9849 implicit real*8 (a-h,o-z)
9850 include 'DIMENSIONS'
9851 include 'COMMON.IOUNITS'
9852 include 'COMMON.CHAIN'
9853 include 'COMMON.DERIV'
9854 include 'COMMON.INTERACT'
9855 include 'COMMON.CONTACTS'
9856 include 'COMMON.TORSION'
9857 include 'COMMON.VAR'
9858 include 'COMMON.GEO'
9859 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
9863 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9865 C Parallel Antiparallel
9871 C \ j|/k\| / \ |/k\|l /
9876 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9877 itk=itortyp(itype(k))
9878 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
9879 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
9880 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
9881 call transpose2(EUgC(1,1,k),auxmat(1,1))
9882 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9883 vv1(1)=pizda1(1,1)-pizda1(2,2)
9884 vv1(2)=pizda1(1,2)+pizda1(2,1)
9885 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9886 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
9887 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
9888 s5=scalar2(vv(1),Dtobr2(1,i))
9889 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
9890 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
9891 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
9892 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
9893 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
9894 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
9895 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
9896 & +scalar2(vv(1),Dtobr2der(1,i)))
9897 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
9898 vv1(1)=pizda1(1,1)-pizda1(2,2)
9899 vv1(2)=pizda1(1,2)+pizda1(2,1)
9900 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
9901 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
9903 g_corr6_loc(l-1)=g_corr6_loc(l-1)
9904 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9905 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9906 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9907 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9909 g_corr6_loc(j-1)=g_corr6_loc(j-1)
9910 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9911 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9912 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9913 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9915 call transpose2(EUgCder(1,1,k),auxmat(1,1))
9916 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9917 vv1(1)=pizda1(1,1)-pizda1(2,2)
9918 vv1(2)=pizda1(1,2)+pizda1(2,1)
9919 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
9920 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
9921 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
9922 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
9931 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
9932 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
9933 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
9934 call transpose2(EUgC(1,1,k),auxmat(1,1))
9935 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9937 vv1(1)=pizda1(1,1)-pizda1(2,2)
9938 vv1(2)=pizda1(1,2)+pizda1(2,1)
9939 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9940 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
9941 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
9942 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
9943 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
9944 s5=scalar2(vv(1),Dtobr2(1,i))
9945 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
9951 c----------------------------------------------------------------------------
9952 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
9953 implicit real*8 (a-h,o-z)
9954 include 'DIMENSIONS'
9955 include 'COMMON.IOUNITS'
9956 include 'COMMON.CHAIN'
9957 include 'COMMON.DERIV'
9958 include 'COMMON.INTERACT'
9959 include 'COMMON.CONTACTS'
9960 include 'COMMON.TORSION'
9961 include 'COMMON.VAR'
9962 include 'COMMON.GEO'
9964 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9965 & auxvec1(2),auxvec2(2),auxmat1(2,2)
9968 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9970 C Parallel Antiparallel C
9976 C \ j|/k\| \ |/k\|l C
9981 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9982 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
9983 C AL 7/4/01 s1 would occur in the sixth-order moment,
9984 C but not in a cluster cumulant
9986 s1=dip(1,jj,i)*dip(1,kk,k)
9988 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
9989 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9990 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
9991 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
9992 call transpose2(EUg(1,1,k),auxmat(1,1))
9993 call matmat2(ADtEA1(1,1,1),auxmat(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))
9997 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9999 eello6_graph2=-(s1+s2+s3+s4)
10001 eello6_graph2=-(s2+s3+s4)
10003 c eello6_graph2=-s3
10004 C Derivatives in gamma(i-1)
10007 s1=dipderg(1,jj,i)*dip(1,kk,k)
10009 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
10010 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
10011 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10012 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
10014 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
10016 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
10018 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
10020 C Derivatives in gamma(k-1)
10022 s1=dip(1,jj,i)*dipderg(1,kk,k)
10024 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
10025 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10026 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
10027 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10028 call transpose2(EUgder(1,1,k),auxmat1(1,1))
10029 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
10030 vv(1)=pizda(1,1)-pizda(2,2)
10031 vv(2)=pizda(1,2)+pizda(2,1)
10032 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10034 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
10036 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
10038 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
10039 C Derivatives in gamma(j-1) or gamma(l-1)
10042 s1=dipderg(3,jj,i)*dip(1,kk,k)
10044 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
10045 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10046 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
10047 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
10048 vv(1)=pizda(1,1)-pizda(2,2)
10049 vv(2)=pizda(1,2)+pizda(2,1)
10050 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10053 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
10055 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
10058 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
10059 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
10061 C Derivatives in gamma(l-1) or gamma(j-1)
10064 s1=dip(1,jj,i)*dipderg(3,kk,k)
10066 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
10067 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
10068 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
10069 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
10070 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
10071 vv(1)=pizda(1,1)-pizda(2,2)
10072 vv(2)=pizda(1,2)+pizda(2,1)
10073 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10076 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
10078 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
10081 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
10082 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
10084 C Cartesian derivatives.
10086 write (2,*) 'In eello6_graph2'
10088 write (2,*) 'iii=',iii
10090 write (2,*) 'kkk=',kkk
10092 write (2,'(3(2f10.5),5x)')
10093 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
10103 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
10105 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
10108 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
10110 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
10111 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
10113 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
10114 call transpose2(EUg(1,1,k),auxmat(1,1))
10115 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
10117 vv(1)=pizda(1,1)-pizda(2,2)
10118 vv(2)=pizda(1,2)+pizda(2,1)
10119 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
10120 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
10122 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10124 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10127 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10129 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10136 c----------------------------------------------------------------------------
10137 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
10138 implicit real*8 (a-h,o-z)
10139 include 'DIMENSIONS'
10140 include 'COMMON.IOUNITS'
10141 include 'COMMON.CHAIN'
10142 include 'COMMON.DERIV'
10143 include 'COMMON.INTERACT'
10144 include 'COMMON.CONTACTS'
10145 include 'COMMON.TORSION'
10146 include 'COMMON.VAR'
10147 include 'COMMON.GEO'
10148 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
10150 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10152 C Parallel Antiparallel C
10157 C /| o |o o| o |\ C
10158 C j|/k\| / |/k\|l / C
10163 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10165 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
10166 C energy moment and not to the cluster cumulant.
10167 iti=itortyp(itype(i))
10168 if (j.lt.nres-1) then
10169 itj1=itortyp(itype(j+1))
10173 itk=itortyp(itype(k))
10174 itk1=itortyp(itype(k+1))
10175 if (l.lt.nres-1) then
10176 itl1=itortyp(itype(l+1))
10181 s1=dip(4,jj,i)*dip(4,kk,k)
10183 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
10184 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10185 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
10186 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10187 call transpose2(EE(1,1,itk),auxmat(1,1))
10188 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
10189 vv(1)=pizda(1,1)+pizda(2,2)
10190 vv(2)=pizda(2,1)-pizda(1,2)
10191 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10192 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
10193 cd & "sum",-(s2+s3+s4)
10195 eello6_graph3=-(s1+s2+s3+s4)
10197 eello6_graph3=-(s2+s3+s4)
10199 c eello6_graph3=-s4
10200 C Derivatives in gamma(k-1)
10201 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
10202 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10203 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
10204 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
10205 C Derivatives in gamma(l-1)
10206 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
10207 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10208 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
10209 vv(1)=pizda(1,1)+pizda(2,2)
10210 vv(2)=pizda(2,1)-pizda(1,2)
10211 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10212 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10213 C Cartesian derivatives.
10219 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
10221 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
10224 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
10226 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
10227 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
10229 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
10230 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
10232 vv(1)=pizda(1,1)+pizda(2,2)
10233 vv(2)=pizda(2,1)-pizda(1,2)
10234 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
10236 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10238 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10241 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10243 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10245 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
10251 c----------------------------------------------------------------------------
10252 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
10253 implicit real*8 (a-h,o-z)
10254 include 'DIMENSIONS'
10255 include 'COMMON.IOUNITS'
10256 include 'COMMON.CHAIN'
10257 include 'COMMON.DERIV'
10258 include 'COMMON.INTERACT'
10259 include 'COMMON.CONTACTS'
10260 include 'COMMON.TORSION'
10261 include 'COMMON.VAR'
10262 include 'COMMON.GEO'
10263 include 'COMMON.FFIELD'
10264 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
10265 & auxvec1(2),auxmat1(2,2)
10267 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10269 C Parallel Antiparallel C
10274 C /| o |o o| o |\ C
10275 C \ j|/k\| \ |/k\|l C
10280 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
10282 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
10283 C energy moment and not to the cluster cumulant.
10284 cd write (2,*) 'eello_graph4: wturn6',wturn6
10285 iti=itortyp(itype(i))
10286 itj=itortyp(itype(j))
10287 if (j.lt.nres-1) then
10288 itj1=itortyp(itype(j+1))
10292 itk=itortyp(itype(k))
10293 if (k.lt.nres-1) then
10294 itk1=itortyp(itype(k+1))
10298 itl=itortyp(itype(l))
10299 if (l.lt.nres-1) then
10300 itl1=itortyp(itype(l+1))
10304 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
10305 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
10306 cd & ' itl',itl,' itl1',itl1
10308 if (imat.eq.1) then
10309 s1=dip(3,jj,i)*dip(3,kk,k)
10311 s1=dip(2,jj,j)*dip(2,kk,l)
10314 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
10315 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10317 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
10318 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10320 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
10321 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10323 call transpose2(EUg(1,1,k),auxmat(1,1))
10324 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
10325 vv(1)=pizda(1,1)-pizda(2,2)
10326 vv(2)=pizda(2,1)+pizda(1,2)
10327 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10328 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
10330 eello6_graph4=-(s1+s2+s3+s4)
10332 eello6_graph4=-(s2+s3+s4)
10334 C Derivatives in gamma(i-1)
10337 if (imat.eq.1) then
10338 s1=dipderg(2,jj,i)*dip(3,kk,k)
10340 s1=dipderg(4,jj,j)*dip(2,kk,l)
10343 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
10345 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
10346 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10348 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
10349 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10351 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
10352 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10353 cd write (2,*) 'turn6 derivatives'
10355 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
10357 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
10361 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
10363 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
10367 C Derivatives in gamma(k-1)
10369 if (imat.eq.1) then
10370 s1=dip(3,jj,i)*dipderg(2,kk,k)
10372 s1=dip(2,jj,j)*dipderg(4,kk,l)
10375 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
10376 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
10378 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
10379 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
10381 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
10382 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
10384 call transpose2(EUgder(1,1,k),auxmat1(1,1))
10385 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
10386 vv(1)=pizda(1,1)-pizda(2,2)
10387 vv(2)=pizda(2,1)+pizda(1,2)
10388 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10389 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10391 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
10393 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
10397 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
10399 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
10402 C Derivatives in gamma(j-1) or gamma(l-1)
10403 if (l.eq.j+1 .and. l.gt.1) then
10404 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10405 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10406 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10407 vv(1)=pizda(1,1)-pizda(2,2)
10408 vv(2)=pizda(2,1)+pizda(1,2)
10409 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10410 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
10411 else if (j.gt.1) then
10412 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
10413 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10414 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
10415 vv(1)=pizda(1,1)-pizda(2,2)
10416 vv(2)=pizda(2,1)+pizda(1,2)
10417 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10418 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10419 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
10421 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
10424 C Cartesian derivatives.
10430 if (imat.eq.1) then
10431 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
10433 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
10436 if (imat.eq.1) then
10437 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
10439 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
10443 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
10445 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
10447 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
10448 & b1(1,j+1),auxvec(1))
10449 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
10451 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
10452 & b1(1,l+1),auxvec(1))
10453 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
10455 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
10457 vv(1)=pizda(1,1)-pizda(2,2)
10458 vv(2)=pizda(2,1)+pizda(1,2)
10459 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
10461 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
10463 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
10466 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
10469 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
10472 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
10474 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
10476 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10480 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
10482 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
10485 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
10487 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
10495 c----------------------------------------------------------------------------
10496 double precision function eello_turn6(i,jj,kk)
10497 implicit real*8 (a-h,o-z)
10498 include 'DIMENSIONS'
10499 include 'COMMON.IOUNITS'
10500 include 'COMMON.CHAIN'
10501 include 'COMMON.DERIV'
10502 include 'COMMON.INTERACT'
10503 include 'COMMON.CONTACTS'
10504 include 'COMMON.TORSION'
10505 include 'COMMON.VAR'
10506 include 'COMMON.GEO'
10507 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
10508 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
10510 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
10511 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
10512 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
10513 C the respective energy moment and not to the cluster cumulant.
10522 iti=itortyp(itype(i))
10523 itk=itortyp(itype(k))
10524 itk1=itortyp(itype(k+1))
10525 itl=itortyp(itype(l))
10526 itj=itortyp(itype(j))
10527 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
10528 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
10529 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
10534 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
10536 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
10540 derx_turn(lll,kkk,iii)=0.0d0
10547 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
10549 cd write (2,*) 'eello6_5',eello6_5
10551 call transpose2(AEA(1,1,1),auxmat(1,1))
10552 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
10553 ss1=scalar2(Ub2(1,i+2),b1(1,l))
10554 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
10556 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10557 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
10558 s2 = scalar2(b1(1,k),vtemp1(1))
10560 call transpose2(AEA(1,1,2),atemp(1,1))
10561 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
10562 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
10563 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10565 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
10566 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
10567 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
10569 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
10570 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
10571 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
10572 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
10573 ss13 = scalar2(b1(1,k),vtemp4(1))
10574 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
10576 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
10582 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
10583 C Derivatives in gamma(i+2)
10587 call transpose2(AEA(1,1,1),auxmatd(1,1))
10588 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10589 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10590 call transpose2(AEAderg(1,1,2),atempd(1,1))
10591 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10592 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10594 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
10595 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10596 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10602 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
10603 C Derivatives in gamma(i+3)
10605 call transpose2(AEA(1,1,1),auxmatd(1,1))
10606 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10607 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
10608 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
10610 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
10611 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
10612 s2d = scalar2(b1(1,k),vtemp1d(1))
10614 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
10615 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
10617 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
10619 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
10620 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10621 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10629 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10630 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10632 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
10633 & -0.5d0*ekont*(s2d+s12d)
10635 C Derivatives in gamma(i+4)
10636 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
10637 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10638 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10640 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
10641 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
10642 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
10650 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
10652 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
10654 C Derivatives in gamma(i+5)
10656 call transpose2(AEAderg(1,1,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,l),vtemp1d(1))
10661 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
10662 s2d = scalar2(b1(1,k),vtemp1d(1))
10664 call transpose2(AEA(1,1,2),atempd(1,1))
10665 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
10666 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10668 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
10669 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10671 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
10672 ss13d = scalar2(b1(1,k),vtemp4d(1))
10673 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10681 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10682 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10684 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10685 & -0.5d0*ekont*(s2d+s12d)
10687 C Cartesian derivatives
10692 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
10693 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10694 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10696 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10697 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
10699 s2d = scalar2(b1(1,k),vtemp1d(1))
10701 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
10702 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10703 s8d = -(atempd(1,1)+atempd(2,2))*
10704 & scalar2(cc(1,1,itl),vtemp2(1))
10706 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
10708 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10709 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10716 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10717 & - 0.5d0*(s1d+s2d)
10719 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10723 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10724 & - 0.5d0*(s8d+s12d)
10726 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10735 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
10736 & achuj_tempd(1,1))
10737 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
10738 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10739 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
10740 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
10741 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
10743 ss13d = scalar2(b1(1,k),vtemp4d(1))
10744 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10745 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
10749 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
10750 cd & 16*eel_turn6_num
10752 if (j.lt.nres-1) then
10759 if (l.lt.nres-1) then
10767 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
10768 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
10769 cgrad ghalf=0.5d0*ggg1(ll)
10771 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
10772 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
10773 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
10774 & +ekont*derx_turn(ll,2,1)
10775 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
10776 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
10777 & +ekont*derx_turn(ll,4,1)
10778 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
10779 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
10780 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
10781 cgrad ghalf=0.5d0*ggg2(ll)
10783 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
10784 & +ekont*derx_turn(ll,2,2)
10785 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
10786 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
10787 & +ekont*derx_turn(ll,4,2)
10788 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
10789 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
10790 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
10795 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
10800 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
10806 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
10811 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
10815 cd write (2,*) iii,g_corr6_loc(iii)
10817 eello_turn6=ekont*eel_turn6
10818 cd write (2,*) 'ekont',ekont
10819 cd write (2,*) 'eel_turn6',ekont*eel_turn6
10823 C-----------------------------------------------------------------------------
10824 double precision function scalar(u,v)
10825 !DIR$ INLINEALWAYS scalar
10827 cDEC$ ATTRIBUTES FORCEINLINE::scalar
10830 double precision u(3),v(3)
10831 cd double precision sc
10839 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
10842 crc-------------------------------------------------
10843 SUBROUTINE MATVEC2(A1,V1,V2)
10844 !DIR$ INLINEALWAYS MATVEC2
10846 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
10848 implicit real*8 (a-h,o-z)
10849 include 'DIMENSIONS'
10850 DIMENSION A1(2,2),V1(2),V2(2)
10854 c 3 VI=VI+A1(I,K)*V1(K)
10858 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
10859 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
10864 C---------------------------------------
10865 SUBROUTINE MATMAT2(A1,A2,A3)
10867 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
10869 implicit real*8 (a-h,o-z)
10870 include 'DIMENSIONS'
10871 DIMENSION A1(2,2),A2(2,2),A3(2,2)
10872 c DIMENSION AI3(2,2)
10876 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
10882 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
10883 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
10884 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
10885 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
10893 c-------------------------------------------------------------------------
10894 double precision function scalar2(u,v)
10895 !DIR$ INLINEALWAYS scalar2
10897 double precision u(2),v(2)
10898 double precision sc
10900 scalar2=u(1)*v(1)+u(2)*v(2)
10904 C-----------------------------------------------------------------------------
10906 subroutine transpose2(a,at)
10907 !DIR$ INLINEALWAYS transpose2
10909 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
10912 double precision a(2,2),at(2,2)
10919 c--------------------------------------------------------------------------
10920 subroutine transpose(n,a,at)
10923 double precision a(n,n),at(n,n)
10931 C---------------------------------------------------------------------------
10932 subroutine prodmat3(a1,a2,kk,transp,prod)
10933 !DIR$ INLINEALWAYS prodmat3
10935 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
10939 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
10941 crc double precision auxmat(2,2),prod_(2,2)
10944 crc call transpose2(kk(1,1),auxmat(1,1))
10945 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
10946 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10948 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
10949 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
10950 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
10951 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
10952 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
10953 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
10954 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
10955 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
10958 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
10959 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10961 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
10962 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
10963 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
10964 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
10965 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
10966 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
10967 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
10968 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
10971 c call transpose2(a2(1,1),a2t(1,1))
10974 crc print *,((prod_(i,j),i=1,2),j=1,2)
10975 crc print *,((prod(i,j),i=1,2),j=1,2)