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'
27 include 'COMMON.SPLITELE'
29 c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
30 c & " nfgtasks",nfgtasks
31 if (nfgtasks.gt.1) then
33 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
34 if (fg_rank.eq.0) then
35 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
36 c print *,"Processor",myrank," BROADCAST iorder"
37 C FG master sets up the WEIGHTS_ array which will be broadcast to the
38 C FG slaves as WEIGHTS array.
58 C FG Master broadcasts the WEIGHTS_ array
59 call MPI_Bcast(weights_(1),n_ene,
60 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
62 C FG slaves receive the WEIGHTS array
63 call MPI_Bcast(weights(1),n_ene,
64 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
85 time_Bcast=time_Bcast+MPI_Wtime()-time00
86 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
87 c call chainbuild_cart
89 c print *,'Processor',myrank,' calling etotal ipot=',ipot
90 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
92 c if (modecalc.eq.12.or.modecalc.eq.14) then
93 c call int_from_cart1(.false.)
100 C Compute the side-chain and electrostatic interaction energy
102 goto (101,102,103,104,105,106) ipot
103 C Lennard-Jones potential.
105 cd print '(a)','Exit ELJ'
107 C Lennard-Jones-Kihara potential (shifted).
110 C Berne-Pechukas potential (dilated LJ, angular dependence).
113 C Gay-Berne potential (shifted LJ, angular dependence).
116 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
119 C Soft-sphere potential
120 106 call e_softsphere(evdw)
122 C Calculate electrostatic (H-bonding) energy of the main chain.
126 cmc Sep-06: egb takes care of dynamic ss bonds too
128 c if (dyn_ss) call dyn_set_nss
130 c print *,"Processor",myrank," computed USCSC"
136 time_vec=time_vec+MPI_Wtime()-time01
138 c print *,"Processor",myrank," left VEC_AND_DERIV"
141 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
142 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
143 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
144 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
146 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
147 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
148 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
149 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
151 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
160 write (iout,*) "Soft-spheer ELEC potential"
161 c call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
164 c print *,"Processor",myrank," computed UELEC"
166 C Calculate excluded-volume interaction energy between peptide groups
171 call escp(evdw2,evdw2_14)
177 c write (iout,*) "Soft-sphere SCP potential"
178 call escp_soft_sphere(evdw2,evdw2_14)
181 c Calculate the bond-stretching energy
185 C Calculate the disulfide-bridge and other energy and the contributions
186 C from other distance constraints.
187 cd print *,'Calling EHPB'
189 cd print *,'EHPB exitted succesfully.'
191 C Calculate the virtual-bond-angle energy.
193 if (wang.gt.0d0) then
198 c print *,"Processor",myrank," computed UB"
200 C Calculate the SC local energy.
203 c print *,"Processor",myrank," computed USC"
205 C Calculate the virtual-bond torsional energy.
207 cd print *,'nterm=',nterm
209 call etor(etors,edihcnstr)
214 c print *,"Processor",myrank," computed Utor"
216 C 6/23/01 Calculate double-torsional energy
218 if (wtor_d.gt.0) then
223 c print *,"Processor",myrank," computed Utord"
225 C 21/5/07 Calculate local sicdechain correlation energy
227 if (wsccor.gt.0.0d0) then
228 call eback_sc_corr(esccor)
232 c print *,"Processor",myrank," computed Usccorr"
234 C 12/1/95 Multi-body terms
238 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
239 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
240 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
241 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
242 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
249 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
250 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
251 cd write (iout,*) "multibody_hb ecorr",ecorr
253 c print *,"Processor",myrank," computed Ucorr"
255 C If performing constraint dynamics, call the constraint energy
256 C after the equilibration time
257 if(usampl.and.totT.gt.eq_time) then
264 C 01/27/2015 added by adasko
265 C the energy component below is energy transfer into lipid environment
266 C based on partition function
267 if (wliptran.gt.0) then
271 time_enecalc=time_enecalc+MPI_Wtime()-time00
273 c print *,"Processor",myrank," computed Uconstr"
282 energia(2)=evdw2-evdw2_14
299 energia(8)=eello_turn3
300 energia(9)=eello_turn4
307 energia(19)=edihcnstr
309 energia(20)=Uconst+Uconst_back
311 energia(22)=eliptrans
312 c Here are the energies showed per procesor if the are more processors
313 c per molecule then we sum it up in sum_energy subroutine
314 c print *," Processor",myrank," calls SUM_ENERGY"
315 call sum_energy(energia,.true.)
316 if (dyn_ss) call dyn_set_nss
317 c print *," Processor",myrank," left SUM_ENERGY"
319 time_sumene=time_sumene+MPI_Wtime()-time00
323 c-------------------------------------------------------------------------------
324 subroutine sum_energy(energia,reduce)
325 implicit real*8 (a-h,o-z)
330 cMS$ATTRIBUTES C :: proc_proc
336 include 'COMMON.SETUP'
337 include 'COMMON.IOUNITS'
338 double precision energia(0:n_ene),enebuff(0:n_ene+1)
339 include 'COMMON.FFIELD'
340 include 'COMMON.DERIV'
341 include 'COMMON.INTERACT'
342 include 'COMMON.SBRIDGE'
343 include 'COMMON.CHAIN'
345 include 'COMMON.CONTROL'
346 include 'COMMON.TIME1'
349 if (nfgtasks.gt.1 .and. reduce) then
351 write (iout,*) "energies before REDUCE"
352 call enerprint(energia)
356 enebuff(i)=energia(i)
359 call MPI_Barrier(FG_COMM,IERR)
360 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
362 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
363 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
365 write (iout,*) "energies after REDUCE"
366 call enerprint(energia)
369 time_Reduce=time_Reduce+MPI_Wtime()-time00
371 if (fg_rank.eq.0) then
375 evdw2=energia(2)+energia(18)
391 eello_turn3=energia(8)
392 eello_turn4=energia(9)
399 edihcnstr=energia(19)
403 energia(22)=eliptrans
405 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
406 & +wang*ebe+wtor*etors+wscloc*escloc
407 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
408 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
409 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
410 & +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran
412 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
413 & +wang*ebe+wtor*etors+wscloc*escloc
414 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
415 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
416 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
417 & +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran
423 if (isnan(etot).ne.0) energia(0)=1.0d+99
425 if (isnan(etot)) energia(0)=1.0d+99
430 idumm=proc_proc(etot,i)
432 call proc_proc(etot,i)
434 if(i.eq.1)energia(0)=1.0d+99
441 c-------------------------------------------------------------------------------
442 subroutine sum_gradient
443 implicit real*8 (a-h,o-z)
448 cMS$ATTRIBUTES C :: proc_proc
454 double precision gradbufc(3,maxres),gradbufx(3,maxres),
455 & glocbuf(4*maxres),gradbufc_sum(3,maxres),gloc_scbuf(3,maxres)
456 include 'COMMON.SETUP'
457 include 'COMMON.IOUNITS'
458 include 'COMMON.FFIELD'
459 include 'COMMON.DERIV'
460 include 'COMMON.INTERACT'
461 include 'COMMON.SBRIDGE'
462 include 'COMMON.CHAIN'
464 include 'COMMON.CONTROL'
465 include 'COMMON.TIME1'
466 include 'COMMON.MAXGRAD'
467 include 'COMMON.SCCOR'
472 write (iout,*) "sum_gradient gvdwc, gvdwx"
474 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
475 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
480 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
481 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
482 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
485 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
486 C in virtual-bond-vector coordinates
489 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
491 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
492 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
494 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
496 c write (iout,'(i5,3f10.5,2x,f10.5)')
497 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
499 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
501 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
502 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
510 gradbufc(j,i)=wsc*gvdwc(j,i)+
511 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
512 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
513 & wel_loc*gel_loc_long(j,i)+
514 & wcorr*gradcorr_long(j,i)+
515 & wcorr5*gradcorr5_long(j,i)+
516 & wcorr6*gradcorr6_long(j,i)+
517 & wturn6*gcorr6_turn_long(j,i)+
524 gradbufc(j,i)=wsc*gvdwc(j,i)+
525 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
526 & welec*gelc_long(j,i)+
528 & wel_loc*gel_loc_long(j,i)+
529 & wcorr*gradcorr_long(j,i)+
530 & wcorr5*gradcorr5_long(j,i)+
531 & wcorr6*gradcorr6_long(j,i)+
532 & wturn6*gcorr6_turn_long(j,i)+
538 if (nfgtasks.gt.1) then
541 write (iout,*) "gradbufc before allreduce"
543 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
549 gradbufc_sum(j,i)=gradbufc(j,i)
552 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
553 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
554 c time_reduce=time_reduce+MPI_Wtime()-time00
556 c write (iout,*) "gradbufc_sum after allreduce"
558 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
563 c time_allreduce=time_allreduce+MPI_Wtime()-time00
571 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
572 write (iout,*) (i," jgrad_start",jgrad_start(i),
573 & " jgrad_end ",jgrad_end(i),
574 & i=igrad_start,igrad_end)
577 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
578 c do not parallelize this part.
580 c do i=igrad_start,igrad_end
581 c do j=jgrad_start(i),jgrad_end(i)
583 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
588 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
592 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
596 write (iout,*) "gradbufc after summing"
598 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
605 write (iout,*) "gradbufc"
607 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
613 gradbufc_sum(j,i)=gradbufc(j,i)
618 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
622 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
627 c gradbufc(k,i)=0.0d0
631 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
636 write (iout,*) "gradbufc after summing"
638 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
646 gradbufc(k,nres)=0.0d0
651 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
652 & wel_loc*gel_loc(j,i)+
653 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
654 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
655 & wel_loc*gel_loc_long(j,i)+
656 & wcorr*gradcorr_long(j,i)+
657 & wcorr5*gradcorr5_long(j,i)+
658 & wcorr6*gradcorr6_long(j,i)+
659 & wturn6*gcorr6_turn_long(j,i))+
661 & wcorr*gradcorr(j,i)+
662 & wturn3*gcorr3_turn(j,i)+
663 & wturn4*gcorr4_turn(j,i)+
664 & wcorr5*gradcorr5(j,i)+
665 & wcorr6*gradcorr6(j,i)+
666 & wturn6*gcorr6_turn(j,i)+
667 & wsccor*gsccorc(j,i)
668 & +wscloc*gscloc(j,i)
669 & +wliptran*gliptranc(j,i)
671 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
672 & wel_loc*gel_loc(j,i)+
673 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
674 & welec*gelc_long(j,i)
675 & wel_loc*gel_loc_long(j,i)+
676 & wcorr*gcorr_long(j,i)+
677 & wcorr5*gradcorr5_long(j,i)+
678 & wcorr6*gradcorr6_long(j,i)+
679 & wturn6*gcorr6_turn_long(j,i))+
681 & wcorr*gradcorr(j,i)+
682 & wturn3*gcorr3_turn(j,i)+
683 & wturn4*gcorr4_turn(j,i)+
684 & wcorr5*gradcorr5(j,i)+
685 & wcorr6*gradcorr6(j,i)+
686 & wturn6*gcorr6_turn(j,i)+
687 & wsccor*gsccorc(j,i)
688 & +wscloc*gscloc(j,i)
689 & +wliptran*gliptranc(j,i)
691 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
693 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
694 & wsccor*gsccorx(j,i)
695 & +wscloc*gsclocx(j,i)
696 & +wliptran*gliptranx(j,i)
700 write (iout,*) "gloc before adding corr"
702 write (iout,*) i,gloc(i,icg)
706 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
707 & +wcorr5*g_corr5_loc(i)
708 & +wcorr6*g_corr6_loc(i)
709 & +wturn4*gel_loc_turn4(i)
710 & +wturn3*gel_loc_turn3(i)
711 & +wturn6*gel_loc_turn6(i)
712 & +wel_loc*gel_loc_loc(i)
715 write (iout,*) "gloc after adding corr"
717 write (iout,*) i,gloc(i,icg)
721 if (nfgtasks.gt.1) then
724 gradbufc(j,i)=gradc(j,i,icg)
725 gradbufx(j,i)=gradx(j,i,icg)
729 glocbuf(i)=gloc(i,icg)
733 write (iout,*) "gloc_sc before reduce"
736 write (iout,*) i,j,gloc_sc(j,i,icg)
743 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
747 call MPI_Barrier(FG_COMM,IERR)
748 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
750 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
751 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
752 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
753 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
754 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
755 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
756 time_reduce=time_reduce+MPI_Wtime()-time00
757 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
758 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
759 time_reduce=time_reduce+MPI_Wtime()-time00
762 write (iout,*) "gloc_sc after reduce"
765 write (iout,*) i,j,gloc_sc(j,i,icg)
771 write (iout,*) "gloc after reduce"
773 write (iout,*) i,gloc(i,icg)
778 if (gnorm_check) then
780 c Compute the maximum elements of the gradient
790 gcorr3_turn_max=0.0d0
791 gcorr4_turn_max=0.0d0
794 gcorr6_turn_max=0.0d0
804 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
805 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
806 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
807 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
808 & gvdwc_scp_max=gvdwc_scp_norm
809 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
810 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
811 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
812 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
813 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
814 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
815 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
816 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
817 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
818 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
819 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
820 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
821 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
823 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
824 & gcorr3_turn_max=gcorr3_turn_norm
825 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
827 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
828 & gcorr4_turn_max=gcorr4_turn_norm
829 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
830 if (gradcorr5_norm.gt.gradcorr5_max)
831 & gradcorr5_max=gradcorr5_norm
832 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
833 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
834 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
836 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
837 & gcorr6_turn_max=gcorr6_turn_norm
838 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
839 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
840 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
841 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
842 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
843 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
844 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
845 if (gradx_scp_norm.gt.gradx_scp_max)
846 & gradx_scp_max=gradx_scp_norm
847 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
848 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
849 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
850 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
851 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
852 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
853 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
854 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
858 open(istat,file=statname,position="append")
860 open(istat,file=statname,access="append")
862 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
863 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
864 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
865 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
866 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
867 & gsccorx_max,gsclocx_max
869 if (gvdwc_max.gt.1.0d4) then
870 write (iout,*) "gvdwc gvdwx gradb gradbx"
872 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
873 & gradb(j,i),gradbx(j,i),j=1,3)
875 call pdbout(0.0d0,'cipiszcze',iout)
881 write (iout,*) "gradc gradx gloc"
883 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
884 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
888 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
892 c-------------------------------------------------------------------------------
893 subroutine rescale_weights(t_bath)
894 implicit real*8 (a-h,o-z)
896 include 'COMMON.IOUNITS'
897 include 'COMMON.FFIELD'
898 include 'COMMON.SBRIDGE'
899 double precision kfac /2.4d0/
900 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
902 c facT=2*temp0/(t_bath+temp0)
903 if (rescale_mode.eq.0) then
909 else if (rescale_mode.eq.1) then
910 facT=kfac/(kfac-1.0d0+t_bath/temp0)
911 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
912 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
913 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
914 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
915 else if (rescale_mode.eq.2) then
921 facT=licznik/dlog(dexp(x)+dexp(-x))
922 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
923 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
924 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
925 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
927 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
928 write (*,*) "Wrong RESCALE_MODE",rescale_mode
930 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
934 welec=weights(3)*fact
935 wcorr=weights(4)*fact3
936 wcorr5=weights(5)*fact4
937 wcorr6=weights(6)*fact5
938 wel_loc=weights(7)*fact2
939 wturn3=weights(8)*fact2
940 wturn4=weights(9)*fact3
941 wturn6=weights(10)*fact5
942 wtor=weights(13)*fact
943 wtor_d=weights(14)*fact2
944 wsccor=weights(21)*fact
948 C------------------------------------------------------------------------
949 subroutine enerprint(energia)
950 implicit real*8 (a-h,o-z)
952 include 'COMMON.IOUNITS'
953 include 'COMMON.FFIELD'
954 include 'COMMON.SBRIDGE'
956 double precision energia(0:n_ene)
961 evdw2=energia(2)+energia(18)
973 eello_turn3=energia(8)
974 eello_turn4=energia(9)
975 eello_turn6=energia(10)
981 edihcnstr=energia(19)
986 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
987 & estr,wbond,ebe,wang,
988 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
990 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
991 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
994 10 format (/'Virtual-chain energies:'//
995 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
996 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
997 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
998 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
999 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1000 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1001 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1002 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1003 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1004 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1005 & ' (SS bridges & dist. cnstr.)'/
1006 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1007 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1008 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1009 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1010 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1011 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1012 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1013 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1014 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1015 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1016 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1017 & 'ETOT= ',1pE16.6,' (total)')
1019 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1020 & estr,wbond,ebe,wang,
1021 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1023 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1024 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1025 & ebr*nss,Uconst,etot
1026 10 format (/'Virtual-chain energies:'//
1027 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1028 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1029 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1030 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1031 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1032 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1033 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1034 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1035 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1036 & ' (SS bridges & dist. cnstr.)'/
1037 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1038 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1039 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1040 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1041 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1042 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1043 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1044 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1045 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1046 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1047 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1048 & 'ETOT= ',1pE16.6,' (total)')
1052 C-----------------------------------------------------------------------
1053 subroutine elj(evdw)
1055 C This subroutine calculates the interaction energy of nonbonded side chains
1056 C assuming the LJ potential of interaction.
1058 implicit real*8 (a-h,o-z)
1059 include 'DIMENSIONS'
1060 parameter (accur=1.0d-10)
1061 include 'COMMON.GEO'
1062 include 'COMMON.VAR'
1063 include 'COMMON.LOCAL'
1064 include 'COMMON.CHAIN'
1065 include 'COMMON.DERIV'
1066 include 'COMMON.INTERACT'
1067 include 'COMMON.TORSION'
1068 include 'COMMON.SBRIDGE'
1069 include 'COMMON.NAMES'
1070 include 'COMMON.IOUNITS'
1071 include 'COMMON.CONTACTS'
1073 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1075 do i=iatsc_s,iatsc_e
1076 itypi=iabs(itype(i))
1077 if (itypi.eq.ntyp1) cycle
1078 itypi1=iabs(itype(i+1))
1085 C Calculate SC interaction energy.
1087 do iint=1,nint_gr(i)
1088 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1089 cd & 'iend=',iend(i,iint)
1090 do j=istart(i,iint),iend(i,iint)
1091 itypj=iabs(itype(j))
1092 if (itypj.eq.ntyp1) cycle
1096 C Change 12/1/95 to calculate four-body interactions
1097 rij=xj*xj+yj*yj+zj*zj
1099 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1100 eps0ij=eps(itypi,itypj)
1102 e1=fac*fac*aa(itypi,itypj)
1103 e2=fac*bb(itypi,itypj)
1105 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1106 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1107 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1108 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1109 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1110 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1113 C Calculate the components of the gradient in DC and X
1115 fac=-rrij*(e1+evdwij)
1120 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1121 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1122 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1123 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1127 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1131 C 12/1/95, revised on 5/20/97
1133 C Calculate the contact function. The ith column of the array JCONT will
1134 C contain the numbers of atoms that make contacts with the atom I (of numbers
1135 C greater than I). The arrays FACONT and GACONT will contain the values of
1136 C the contact function and its derivative.
1138 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1139 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1140 C Uncomment next line, if the correlation interactions are contact function only
1141 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1143 sigij=sigma(itypi,itypj)
1144 r0ij=rs0(itypi,itypj)
1146 C Check whether the SC's are not too far to make a contact.
1149 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1150 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1152 if (fcont.gt.0.0D0) then
1153 C If the SC-SC distance if close to sigma, apply spline.
1154 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1155 cAdam & fcont1,fprimcont1)
1156 cAdam fcont1=1.0d0-fcont1
1157 cAdam if (fcont1.gt.0.0d0) then
1158 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1159 cAdam fcont=fcont*fcont1
1161 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1162 cga eps0ij=1.0d0/dsqrt(eps0ij)
1164 cga gg(k)=gg(k)*eps0ij
1166 cga eps0ij=-evdwij*eps0ij
1167 C Uncomment for AL's type of SC correlation interactions.
1168 cadam eps0ij=-evdwij
1169 num_conti=num_conti+1
1170 jcont(num_conti,i)=j
1171 facont(num_conti,i)=fcont*eps0ij
1172 fprimcont=eps0ij*fprimcont/rij
1174 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1175 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1176 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1177 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1178 gacont(1,num_conti,i)=-fprimcont*xj
1179 gacont(2,num_conti,i)=-fprimcont*yj
1180 gacont(3,num_conti,i)=-fprimcont*zj
1181 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1182 cd write (iout,'(2i3,3f10.5)')
1183 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1189 num_cont(i)=num_conti
1193 gvdwc(j,i)=expon*gvdwc(j,i)
1194 gvdwx(j,i)=expon*gvdwx(j,i)
1197 C******************************************************************************
1201 C To save time, the factor of EXPON has been extracted from ALL components
1202 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1205 C******************************************************************************
1208 C-----------------------------------------------------------------------------
1209 subroutine eljk(evdw)
1211 C This subroutine calculates the interaction energy of nonbonded side chains
1212 C assuming the LJK potential of interaction.
1214 implicit real*8 (a-h,o-z)
1215 include 'DIMENSIONS'
1216 include 'COMMON.GEO'
1217 include 'COMMON.VAR'
1218 include 'COMMON.LOCAL'
1219 include 'COMMON.CHAIN'
1220 include 'COMMON.DERIV'
1221 include 'COMMON.INTERACT'
1222 include 'COMMON.IOUNITS'
1223 include 'COMMON.NAMES'
1226 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1228 do i=iatsc_s,iatsc_e
1229 itypi=iabs(itype(i))
1230 if (itypi.eq.ntyp1) cycle
1231 itypi1=iabs(itype(i+1))
1236 C Calculate SC interaction energy.
1238 do iint=1,nint_gr(i)
1239 do j=istart(i,iint),iend(i,iint)
1240 itypj=iabs(itype(j))
1241 if (itypj.eq.ntyp1) cycle
1245 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1246 fac_augm=rrij**expon
1247 e_augm=augm(itypi,itypj)*fac_augm
1248 r_inv_ij=dsqrt(rrij)
1250 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1251 fac=r_shift_inv**expon
1252 e1=fac*fac*aa(itypi,itypj)
1253 e2=fac*bb(itypi,itypj)
1255 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1256 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1257 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1258 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1259 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1260 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1261 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1264 C Calculate the components of the gradient in DC and X
1266 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1271 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1272 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1273 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1274 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1278 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1286 gvdwc(j,i)=expon*gvdwc(j,i)
1287 gvdwx(j,i)=expon*gvdwx(j,i)
1292 C-----------------------------------------------------------------------------
1293 subroutine ebp(evdw)
1295 C This subroutine calculates the interaction energy of nonbonded side chains
1296 C assuming the Berne-Pechukas potential of interaction.
1298 implicit real*8 (a-h,o-z)
1299 include 'DIMENSIONS'
1300 include 'COMMON.GEO'
1301 include 'COMMON.VAR'
1302 include 'COMMON.LOCAL'
1303 include 'COMMON.CHAIN'
1304 include 'COMMON.DERIV'
1305 include 'COMMON.NAMES'
1306 include 'COMMON.INTERACT'
1307 include 'COMMON.IOUNITS'
1308 include 'COMMON.CALC'
1309 common /srutu/ icall
1310 c double precision rrsave(maxdim)
1313 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1315 c if (icall.eq.0) then
1321 do i=iatsc_s,iatsc_e
1322 itypi=iabs(itype(i))
1323 if (itypi.eq.ntyp1) cycle
1324 itypi1=iabs(itype(i+1))
1328 dxi=dc_norm(1,nres+i)
1329 dyi=dc_norm(2,nres+i)
1330 dzi=dc_norm(3,nres+i)
1331 c dsci_inv=dsc_inv(itypi)
1332 dsci_inv=vbld_inv(i+nres)
1334 C Calculate SC interaction energy.
1336 do iint=1,nint_gr(i)
1337 do j=istart(i,iint),iend(i,iint)
1339 itypj=iabs(itype(j))
1340 if (itypj.eq.ntyp1) cycle
1341 c dscj_inv=dsc_inv(itypj)
1342 dscj_inv=vbld_inv(j+nres)
1343 chi1=chi(itypi,itypj)
1344 chi2=chi(itypj,itypi)
1351 alf12=0.5D0*(alf1+alf2)
1352 C For diagnostics only!!!
1365 dxj=dc_norm(1,nres+j)
1366 dyj=dc_norm(2,nres+j)
1367 dzj=dc_norm(3,nres+j)
1368 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1369 cd if (icall.eq.0) then
1375 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1377 C Calculate whole angle-dependent part of epsilon and contributions
1378 C to its derivatives
1379 fac=(rrij*sigsq)**expon2
1380 e1=fac*fac*aa(itypi,itypj)
1381 e2=fac*bb(itypi,itypj)
1382 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1383 eps2der=evdwij*eps3rt
1384 eps3der=evdwij*eps2rt
1385 evdwij=evdwij*eps2rt*eps3rt
1388 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1389 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1390 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1391 cd & restyp(itypi),i,restyp(itypj),j,
1392 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1393 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1394 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1397 C Calculate gradient components.
1398 e1=e1*eps1*eps2rt**2*eps3rt**2
1399 fac=-expon*(e1+evdwij)
1402 C Calculate radial part of the gradient
1406 C Calculate the angular part of the gradient and sum add the contributions
1407 C to the appropriate components of the Cartesian gradient.
1415 C-----------------------------------------------------------------------------
1416 subroutine egb(evdw)
1418 C This subroutine calculates the interaction energy of nonbonded side chains
1419 C assuming the Gay-Berne potential of interaction.
1421 implicit real*8 (a-h,o-z)
1422 include 'DIMENSIONS'
1423 include 'COMMON.GEO'
1424 include 'COMMON.VAR'
1425 include 'COMMON.LOCAL'
1426 include 'COMMON.CHAIN'
1427 include 'COMMON.DERIV'
1428 include 'COMMON.NAMES'
1429 include 'COMMON.INTERACT'
1430 include 'COMMON.IOUNITS'
1431 include 'COMMON.CALC'
1432 include 'COMMON.CONTROL'
1433 include 'COMMON.SPLITELE'
1434 include 'COMMON.SBRIDGE'
1436 integer xshift,yshift,zshift
1438 ccccc energy_dec=.false.
1439 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1442 c if (icall.eq.0) lprn=.false.
1444 C the loop over all 27 posible neigbours (for xshift=0,yshift=0,zshift=0
1445 C we have the original box)
1449 do i=iatsc_s,iatsc_e
1450 itypi=iabs(itype(i))
1451 if (itypi.eq.ntyp1) cycle
1452 itypi1=iabs(itype(i+1))
1456 C Return atom into box, boxxsize is size of box in x dimension
1458 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
1459 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
1460 C Condition for being inside the proper box
1461 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
1462 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
1466 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
1467 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
1468 C Condition for being inside the proper box
1469 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
1470 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
1474 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
1475 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
1476 C Condition for being inside the proper box
1477 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
1478 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
1482 if (xi.lt.0) xi=xi+boxxsize
1484 if (yi.lt.0) yi=yi+boxysize
1486 if (zi.lt.0) zi=zi+boxzsize
1487 C xi=xi+xshift*boxxsize
1488 C yi=yi+yshift*boxysize
1489 C zi=zi+zshift*boxzsize
1491 dxi=dc_norm(1,nres+i)
1492 dyi=dc_norm(2,nres+i)
1493 dzi=dc_norm(3,nres+i)
1494 c dsci_inv=dsc_inv(itypi)
1495 dsci_inv=vbld_inv(i+nres)
1496 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1497 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1499 C Calculate SC interaction energy.
1501 do iint=1,nint_gr(i)
1502 do j=istart(i,iint),iend(i,iint)
1503 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1504 call dyn_ssbond_ene(i,j,evdwij)
1506 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1507 & 'evdw',i,j,evdwij,' ss'
1510 itypj=iabs(itype(j))
1511 if (itypj.eq.ntyp1) cycle
1512 c dscj_inv=dsc_inv(itypj)
1513 dscj_inv=vbld_inv(j+nres)
1514 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1515 c & 1.0d0/vbld(j+nres)
1516 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1517 sig0ij=sigma(itypi,itypj)
1518 chi1=chi(itypi,itypj)
1519 chi2=chi(itypj,itypi)
1526 alf12=0.5D0*(alf1+alf2)
1527 C For diagnostics only!!!
1540 C Return atom J into box the original box
1542 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
1543 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
1544 C Condition for being inside the proper box
1545 c if ((xj.gt.((0.5d0)*boxxsize)).or.
1546 c & (xj.lt.((-0.5d0)*boxxsize))) then
1550 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
1551 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
1552 C Condition for being inside the proper box
1553 c if ((yj.gt.((0.5d0)*boxysize)).or.
1554 c & (yj.lt.((-0.5d0)*boxysize))) then
1558 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
1559 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
1560 C Condition for being inside the proper box
1561 c if ((zj.gt.((0.5d0)*boxzsize)).or.
1562 c & (zj.lt.((-0.5d0)*boxzsize))) then
1566 if (xj.lt.0) xj=xj+boxxsize
1568 if (yj.lt.0) yj=yj+boxysize
1570 if (zj.lt.0) zj=zj+boxzsize
1571 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1579 xj=xj_safe+xshift*boxxsize
1580 yj=yj_safe+yshift*boxysize
1581 zj=zj_safe+zshift*boxzsize
1582 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1583 if(dist_temp.lt.dist_init) then
1593 if (subchap.eq.1) then
1602 dxj=dc_norm(1,nres+j)
1603 dyj=dc_norm(2,nres+j)
1604 dzj=dc_norm(3,nres+j)
1608 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1609 c write (iout,*) "j",j," dc_norm",
1610 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1611 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1613 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1614 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1616 c write (iout,'(a7,4f8.3)')
1617 c & "ssscale",sss,((1.0d0/rij)/sigma(itypi,itypj)),r_cut,rlamb
1618 if (sss.gt.0.0d0) then
1619 C Calculate angle-dependent terms of energy and contributions to their
1623 sig=sig0ij*dsqrt(sigsq)
1624 rij_shift=1.0D0/rij-sig+sig0ij
1625 c for diagnostics; uncomment
1626 c rij_shift=1.2*sig0ij
1627 C I hate to put IF's in the loops, but here don't have another choice!!!!
1628 if (rij_shift.le.0.0D0) then
1630 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1631 cd & restyp(itypi),i,restyp(itypj),j,
1632 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1636 c---------------------------------------------------------------
1637 rij_shift=1.0D0/rij_shift
1638 fac=rij_shift**expon
1639 e1=fac*fac*aa(itypi,itypj)
1640 e2=fac*bb(itypi,itypj)
1641 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1642 eps2der=evdwij*eps3rt
1643 eps3der=evdwij*eps2rt
1644 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1645 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1646 evdwij=evdwij*eps2rt*eps3rt
1647 evdw=evdw+evdwij*sss
1649 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1650 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1651 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1652 & restyp(itypi),i,restyp(itypj),j,
1653 & epsi,sigm,chi1,chi2,chip1,chip2,
1654 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1655 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1659 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1662 C Calculate gradient components.
1663 e1=e1*eps1*eps2rt**2*eps3rt**2
1664 fac=-expon*(e1+evdwij)*rij_shift
1667 c print '(2i4,6f8.4)',i,j,sss,sssgrad*
1668 c & evdwij,fac,sigma(itypi,itypj),expon
1669 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1671 C Calculate the radial part of the gradient
1675 C Calculate angular part of the gradient.
1684 c write (iout,*) "Number of loop steps in EGB:",ind
1685 cccc energy_dec=.false.
1688 C-----------------------------------------------------------------------------
1689 subroutine egbv(evdw)
1691 C This subroutine calculates the interaction energy of nonbonded side chains
1692 C assuming the Gay-Berne-Vorobjev potential of interaction.
1694 implicit real*8 (a-h,o-z)
1695 include 'DIMENSIONS'
1696 include 'COMMON.GEO'
1697 include 'COMMON.VAR'
1698 include 'COMMON.LOCAL'
1699 include 'COMMON.CHAIN'
1700 include 'COMMON.DERIV'
1701 include 'COMMON.NAMES'
1702 include 'COMMON.INTERACT'
1703 include 'COMMON.IOUNITS'
1704 include 'COMMON.CALC'
1705 common /srutu/ icall
1708 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1711 c if (icall.eq.0) lprn=.true.
1713 do i=iatsc_s,iatsc_e
1714 itypi=iabs(itype(i))
1715 if (itypi.eq.ntyp1) cycle
1716 itypi1=iabs(itype(i+1))
1720 dxi=dc_norm(1,nres+i)
1721 dyi=dc_norm(2,nres+i)
1722 dzi=dc_norm(3,nres+i)
1723 c dsci_inv=dsc_inv(itypi)
1724 dsci_inv=vbld_inv(i+nres)
1726 C Calculate SC interaction energy.
1728 do iint=1,nint_gr(i)
1729 do j=istart(i,iint),iend(i,iint)
1731 itypj=iabs(itype(j))
1732 if (itypj.eq.ntyp1) cycle
1733 c dscj_inv=dsc_inv(itypj)
1734 dscj_inv=vbld_inv(j+nres)
1735 sig0ij=sigma(itypi,itypj)
1736 r0ij=r0(itypi,itypj)
1737 chi1=chi(itypi,itypj)
1738 chi2=chi(itypj,itypi)
1745 alf12=0.5D0*(alf1+alf2)
1746 C For diagnostics only!!!
1759 dxj=dc_norm(1,nres+j)
1760 dyj=dc_norm(2,nres+j)
1761 dzj=dc_norm(3,nres+j)
1762 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1764 C Calculate angle-dependent terms of energy and contributions to their
1768 sig=sig0ij*dsqrt(sigsq)
1769 rij_shift=1.0D0/rij-sig+r0ij
1770 C I hate to put IF's in the loops, but here don't have another choice!!!!
1771 if (rij_shift.le.0.0D0) then
1776 c---------------------------------------------------------------
1777 rij_shift=1.0D0/rij_shift
1778 fac=rij_shift**expon
1779 e1=fac*fac*aa(itypi,itypj)
1780 e2=fac*bb(itypi,itypj)
1781 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1782 eps2der=evdwij*eps3rt
1783 eps3der=evdwij*eps2rt
1784 fac_augm=rrij**expon
1785 e_augm=augm(itypi,itypj)*fac_augm
1786 evdwij=evdwij*eps2rt*eps3rt
1787 evdw=evdw+evdwij+e_augm
1789 sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1790 epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1791 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1792 & restyp(itypi),i,restyp(itypj),j,
1793 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1794 & chi1,chi2,chip1,chip2,
1795 & eps1,eps2rt**2,eps3rt**2,
1796 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1799 C Calculate gradient components.
1800 e1=e1*eps1*eps2rt**2*eps3rt**2
1801 fac=-expon*(e1+evdwij)*rij_shift
1803 fac=rij*fac-2*expon*rrij*e_augm
1804 C Calculate the radial part of the gradient
1808 C Calculate angular part of the gradient.
1814 C-----------------------------------------------------------------------------
1815 subroutine sc_angular
1816 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
1817 C om12. Called by ebp, egb, and egbv.
1819 include 'COMMON.CALC'
1820 include 'COMMON.IOUNITS'
1824 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
1825 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
1826 om12=dxi*dxj+dyi*dyj+dzi*dzj
1828 C Calculate eps1(om12) and its derivative in om12
1829 faceps1=1.0D0-om12*chiom12
1830 faceps1_inv=1.0D0/faceps1
1831 eps1=dsqrt(faceps1_inv)
1832 C Following variable is eps1*deps1/dom12
1833 eps1_om12=faceps1_inv*chiom12
1838 c write (iout,*) "om12",om12," eps1",eps1
1839 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
1844 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
1845 sigsq=1.0D0-facsig*faceps1_inv
1846 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
1847 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
1848 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
1854 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
1855 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
1857 C Calculate eps2 and its derivatives in om1, om2, and om12.
1860 chipom12=chip12*om12
1861 facp=1.0D0-om12*chipom12
1863 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
1864 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
1865 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
1866 C Following variable is the square root of eps2
1867 eps2rt=1.0D0-facp1*facp_inv
1868 C Following three variables are the derivatives of the square root of eps
1869 C in om1, om2, and om12.
1870 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
1871 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
1872 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
1873 C Evaluate the "asymmetric" factor in the VDW constant, eps3
1874 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
1875 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
1876 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
1877 c & " eps2rt_om12",eps2rt_om12
1878 C Calculate whole angle-dependent part of epsilon and contributions
1879 C to its derivatives
1882 C----------------------------------------------------------------------------
1884 implicit real*8 (a-h,o-z)
1885 include 'DIMENSIONS'
1886 include 'COMMON.CHAIN'
1887 include 'COMMON.DERIV'
1888 include 'COMMON.CALC'
1889 include 'COMMON.IOUNITS'
1890 double precision dcosom1(3),dcosom2(3)
1891 cc print *,'sss=',sss
1892 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
1893 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
1894 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
1895 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
1899 c eom12=evdwij*eps1_om12
1901 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
1902 c & " sigder",sigder
1903 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
1904 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
1906 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
1907 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
1910 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss
1912 c write (iout,*) "gg",(gg(k),k=1,3)
1914 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1915 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1916 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss
1917 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1918 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1919 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss
1920 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
1921 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
1922 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
1923 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
1926 C Calculate the components of the gradient in DC and X
1930 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1934 gvdwc(l,i)=gvdwc(l,i)-gg(l)
1935 gvdwc(l,j)=gvdwc(l,j)+gg(l)
1939 C-----------------------------------------------------------------------
1940 subroutine e_softsphere(evdw)
1942 C This subroutine calculates the interaction energy of nonbonded side chains
1943 C assuming the LJ potential of interaction.
1945 implicit real*8 (a-h,o-z)
1946 include 'DIMENSIONS'
1947 parameter (accur=1.0d-10)
1948 include 'COMMON.GEO'
1949 include 'COMMON.VAR'
1950 include 'COMMON.LOCAL'
1951 include 'COMMON.CHAIN'
1952 include 'COMMON.DERIV'
1953 include 'COMMON.INTERACT'
1954 include 'COMMON.TORSION'
1955 include 'COMMON.SBRIDGE'
1956 include 'COMMON.NAMES'
1957 include 'COMMON.IOUNITS'
1958 include 'COMMON.CONTACTS'
1960 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
1962 do i=iatsc_s,iatsc_e
1963 itypi=iabs(itype(i))
1964 if (itypi.eq.ntyp1) cycle
1965 itypi1=iabs(itype(i+1))
1970 C Calculate SC interaction energy.
1972 do iint=1,nint_gr(i)
1973 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1974 cd & 'iend=',iend(i,iint)
1975 do j=istart(i,iint),iend(i,iint)
1976 itypj=iabs(itype(j))
1977 if (itypj.eq.ntyp1) cycle
1981 rij=xj*xj+yj*yj+zj*zj
1982 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1983 r0ij=r0(itypi,itypj)
1985 c print *,i,j,r0ij,dsqrt(rij)
1986 if (rij.lt.r0ijsq) then
1987 evdwij=0.25d0*(rij-r0ijsq)**2
1995 C Calculate the components of the gradient in DC and X
2001 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2002 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2003 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2004 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2008 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2016 C--------------------------------------------------------------------------
2017 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2020 C Soft-sphere potential of p-p interaction
2022 implicit real*8 (a-h,o-z)
2023 include 'DIMENSIONS'
2024 include 'COMMON.CONTROL'
2025 include 'COMMON.IOUNITS'
2026 include 'COMMON.GEO'
2027 include 'COMMON.VAR'
2028 include 'COMMON.LOCAL'
2029 include 'COMMON.CHAIN'
2030 include 'COMMON.DERIV'
2031 include 'COMMON.INTERACT'
2032 include 'COMMON.CONTACTS'
2033 include 'COMMON.TORSION'
2034 include 'COMMON.VECTORS'
2035 include 'COMMON.FFIELD'
2037 C write(iout,*) 'In EELEC_soft_sphere'
2044 do i=iatel_s,iatel_e
2045 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2049 xmedi=c(1,i)+0.5d0*dxi
2050 ymedi=c(2,i)+0.5d0*dyi
2051 zmedi=c(3,i)+0.5d0*dzi
2052 xmedi=mod(xmedi,boxxsize)
2053 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2054 ymedi=mod(ymedi,boxysize)
2055 if (ymedi.lt.0) ymedi=ymedi+boxysize
2056 zmedi=mod(zmedi,boxzsize)
2057 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2059 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2060 do j=ielstart(i),ielend(i)
2061 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
2065 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2066 r0ij=rpp(iteli,itelj)
2075 if (xj.lt.0) xj=xj+boxxsize
2077 if (yj.lt.0) yj=yj+boxysize
2079 if (zj.lt.0) zj=zj+boxzsize
2080 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2088 xj=xj_safe+xshift*boxxsize
2089 yj=yj_safe+yshift*boxysize
2090 zj=zj_safe+zshift*boxzsize
2091 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2092 if(dist_temp.lt.dist_init) then
2102 if (isubchap.eq.1) then
2111 rij=xj*xj+yj*yj+zj*zj
2112 sss=sscale(sqrt(rij))
2113 sssgrad=sscagrad(sqrt(rij))
2114 if (rij.lt.r0ijsq) then
2115 evdw1ij=0.25d0*(rij-r0ijsq)**2
2121 evdw1=evdw1+evdw1ij*sss
2123 C Calculate contributions to the Cartesian gradient.
2125 ggg(1)=fac*xj*sssgrad
2126 ggg(2)=fac*yj*sssgrad
2127 ggg(3)=fac*zj*sssgrad
2129 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2130 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2133 * Loop over residues i+1 thru j-1.
2137 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2142 cgrad do i=nnt,nct-1
2144 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2146 cgrad do j=i+1,nct-1
2148 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2154 c------------------------------------------------------------------------------
2155 subroutine vec_and_deriv
2156 implicit real*8 (a-h,o-z)
2157 include 'DIMENSIONS'
2161 include 'COMMON.IOUNITS'
2162 include 'COMMON.GEO'
2163 include 'COMMON.VAR'
2164 include 'COMMON.LOCAL'
2165 include 'COMMON.CHAIN'
2166 include 'COMMON.VECTORS'
2167 include 'COMMON.SETUP'
2168 include 'COMMON.TIME1'
2169 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2170 C Compute the local reference systems. For reference system (i), the
2171 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2172 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2174 do i=ivec_start,ivec_end
2178 if (i.eq.nres-1) then
2179 C Case of the last full residue
2180 C Compute the Z-axis
2181 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2182 costh=dcos(pi-theta(nres))
2183 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2187 C Compute the derivatives of uz
2189 uzder(2,1,1)=-dc_norm(3,i-1)
2190 uzder(3,1,1)= dc_norm(2,i-1)
2191 uzder(1,2,1)= dc_norm(3,i-1)
2193 uzder(3,2,1)=-dc_norm(1,i-1)
2194 uzder(1,3,1)=-dc_norm(2,i-1)
2195 uzder(2,3,1)= dc_norm(1,i-1)
2198 uzder(2,1,2)= dc_norm(3,i)
2199 uzder(3,1,2)=-dc_norm(2,i)
2200 uzder(1,2,2)=-dc_norm(3,i)
2202 uzder(3,2,2)= dc_norm(1,i)
2203 uzder(1,3,2)= dc_norm(2,i)
2204 uzder(2,3,2)=-dc_norm(1,i)
2206 C Compute the Y-axis
2209 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2211 C Compute the derivatives of uy
2214 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2215 & -dc_norm(k,i)*dc_norm(j,i-1)
2216 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2218 uyder(j,j,1)=uyder(j,j,1)-costh
2219 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2224 uygrad(l,k,j,i)=uyder(l,k,j)
2225 uzgrad(l,k,j,i)=uzder(l,k,j)
2229 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2230 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2231 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2232 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2235 C Compute the Z-axis
2236 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2237 costh=dcos(pi-theta(i+2))
2238 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2242 C Compute the derivatives of uz
2244 uzder(2,1,1)=-dc_norm(3,i+1)
2245 uzder(3,1,1)= dc_norm(2,i+1)
2246 uzder(1,2,1)= dc_norm(3,i+1)
2248 uzder(3,2,1)=-dc_norm(1,i+1)
2249 uzder(1,3,1)=-dc_norm(2,i+1)
2250 uzder(2,3,1)= dc_norm(1,i+1)
2253 uzder(2,1,2)= dc_norm(3,i)
2254 uzder(3,1,2)=-dc_norm(2,i)
2255 uzder(1,2,2)=-dc_norm(3,i)
2257 uzder(3,2,2)= dc_norm(1,i)
2258 uzder(1,3,2)= dc_norm(2,i)
2259 uzder(2,3,2)=-dc_norm(1,i)
2261 C Compute the Y-axis
2264 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2266 C Compute the derivatives of uy
2269 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2270 & -dc_norm(k,i)*dc_norm(j,i+1)
2271 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2273 uyder(j,j,1)=uyder(j,j,1)-costh
2274 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2279 uygrad(l,k,j,i)=uyder(l,k,j)
2280 uzgrad(l,k,j,i)=uzder(l,k,j)
2284 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2285 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2286 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2287 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2291 vbld_inv_temp(1)=vbld_inv(i+1)
2292 if (i.lt.nres-1) then
2293 vbld_inv_temp(2)=vbld_inv(i+2)
2295 vbld_inv_temp(2)=vbld_inv(i)
2300 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2301 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2306 #if defined(PARVEC) && defined(MPI)
2307 if (nfgtasks1.gt.1) then
2309 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2310 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2311 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2312 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2313 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2315 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2316 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2318 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2319 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2320 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2321 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2322 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2323 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2324 time_gather=time_gather+MPI_Wtime()-time00
2326 c if (fg_rank.eq.0) then
2327 c write (iout,*) "Arrays UY and UZ"
2329 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2336 C-----------------------------------------------------------------------------
2337 subroutine check_vecgrad
2338 implicit real*8 (a-h,o-z)
2339 include 'DIMENSIONS'
2340 include 'COMMON.IOUNITS'
2341 include 'COMMON.GEO'
2342 include 'COMMON.VAR'
2343 include 'COMMON.LOCAL'
2344 include 'COMMON.CHAIN'
2345 include 'COMMON.VECTORS'
2346 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2347 dimension uyt(3,maxres),uzt(3,maxres)
2348 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2349 double precision delta /1.0d-7/
2352 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2353 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2354 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2355 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2356 cd & (dc_norm(if90,i),if90=1,3)
2357 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2358 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2359 cd write(iout,'(a)')
2365 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2366 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2379 cd write (iout,*) 'i=',i
2381 erij(k)=dc_norm(k,i)
2385 dc_norm(k,i)=erij(k)
2387 dc_norm(j,i)=dc_norm(j,i)+delta
2388 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2390 c dc_norm(k,i)=dc_norm(k,i)/fac
2392 c write (iout,*) (dc_norm(k,i),k=1,3)
2393 c write (iout,*) (erij(k),k=1,3)
2396 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2397 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2398 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2399 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2401 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2402 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2403 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2406 dc_norm(k,i)=erij(k)
2409 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2410 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2411 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2412 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2413 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2414 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2415 cd write (iout,'(a)')
2420 C--------------------------------------------------------------------------
2421 subroutine set_matrices
2422 implicit real*8 (a-h,o-z)
2423 include 'DIMENSIONS'
2426 include "COMMON.SETUP"
2428 integer status(MPI_STATUS_SIZE)
2430 include 'COMMON.IOUNITS'
2431 include 'COMMON.GEO'
2432 include 'COMMON.VAR'
2433 include 'COMMON.LOCAL'
2434 include 'COMMON.CHAIN'
2435 include 'COMMON.DERIV'
2436 include 'COMMON.INTERACT'
2437 include 'COMMON.CONTACTS'
2438 include 'COMMON.TORSION'
2439 include 'COMMON.VECTORS'
2440 include 'COMMON.FFIELD'
2441 double precision auxvec(2),auxmat(2,2)
2443 C Compute the virtual-bond-torsional-angle dependent quantities needed
2444 C to calculate the el-loc multibody terms of various order.
2447 do i=ivec_start+2,ivec_end+2
2451 if (i .lt. nres+1) then
2488 if (i .gt. 3 .and. i .lt. nres+1) then
2489 obrot_der(1,i-2)=-sin1
2490 obrot_der(2,i-2)= cos1
2491 Ugder(1,1,i-2)= sin1
2492 Ugder(1,2,i-2)=-cos1
2493 Ugder(2,1,i-2)=-cos1
2494 Ugder(2,2,i-2)=-sin1
2497 obrot2_der(1,i-2)=-dwasin2
2498 obrot2_der(2,i-2)= dwacos2
2499 Ug2der(1,1,i-2)= dwasin2
2500 Ug2der(1,2,i-2)=-dwacos2
2501 Ug2der(2,1,i-2)=-dwacos2
2502 Ug2der(2,2,i-2)=-dwasin2
2504 obrot_der(1,i-2)=0.0d0
2505 obrot_der(2,i-2)=0.0d0
2506 Ugder(1,1,i-2)=0.0d0
2507 Ugder(1,2,i-2)=0.0d0
2508 Ugder(2,1,i-2)=0.0d0
2509 Ugder(2,2,i-2)=0.0d0
2510 obrot2_der(1,i-2)=0.0d0
2511 obrot2_der(2,i-2)=0.0d0
2512 Ug2der(1,1,i-2)=0.0d0
2513 Ug2der(1,2,i-2)=0.0d0
2514 Ug2der(2,1,i-2)=0.0d0
2515 Ug2der(2,2,i-2)=0.0d0
2517 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2518 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2519 iti = itortyp(itype(i-2))
2523 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2524 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2525 iti1 = itortyp(itype(i-1))
2529 cd write (iout,*) '*******i',i,' iti1',iti
2530 cd write (iout,*) 'b1',b1(:,iti)
2531 cd write (iout,*) 'b2',b2(:,iti)
2532 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2533 c if (i .gt. iatel_s+2) then
2534 if (i .gt. nnt+2) then
2535 call matvec2(Ug(1,1,i-2),b2(1,iti),Ub2(1,i-2))
2536 call matmat2(EE(1,1,iti),Ug(1,1,i-2),EUg(1,1,i-2))
2537 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2539 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2540 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2541 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2542 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2543 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2554 DtUg2(l,k,i-2)=0.0d0
2558 call matvec2(Ugder(1,1,i-2),b2(1,iti),Ub2der(1,i-2))
2559 call matmat2(EE(1,1,iti),Ugder(1,1,i-2),EUgder(1,1,i-2))
2561 muder(k,i-2)=Ub2der(k,i-2)
2563 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2564 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2565 if (itype(i-1).le.ntyp) then
2566 iti1 = itortyp(itype(i-1))
2574 mu(k,i-2)=Ub2(k,i-2)+b1(k,iti1)
2576 cd write (iout,*) 'mu ',mu(:,i-2)
2577 cd write (iout,*) 'mu1',mu1(:,i-2)
2578 cd write (iout,*) 'mu2',mu2(:,i-2)
2579 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2581 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2582 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2583 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2584 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2585 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2586 C Vectors and matrices dependent on a single virtual-bond dihedral.
2587 call matvec2(DD(1,1,iti),b1tilde(1,iti1),auxvec(1))
2588 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2589 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2590 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2591 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2592 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2593 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2594 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2595 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2598 C Matrices dependent on two consecutive virtual-bond dihedrals.
2599 C The order of matrices is from left to right.
2600 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2602 c do i=max0(ivec_start,2),ivec_end
2604 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2605 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2606 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2607 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2608 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2609 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2610 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2611 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2614 #if defined(MPI) && defined(PARMAT)
2616 c if (fg_rank.eq.0) then
2617 write (iout,*) "Arrays UG and UGDER before GATHER"
2619 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2620 & ((ug(l,k,i),l=1,2),k=1,2),
2621 & ((ugder(l,k,i),l=1,2),k=1,2)
2623 write (iout,*) "Arrays UG2 and UG2DER"
2625 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2626 & ((ug2(l,k,i),l=1,2),k=1,2),
2627 & ((ug2der(l,k,i),l=1,2),k=1,2)
2629 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2631 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2632 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2633 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2635 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2637 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2638 & costab(i),sintab(i),costab2(i),sintab2(i)
2640 write (iout,*) "Array MUDER"
2642 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2646 if (nfgtasks.gt.1) then
2648 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2649 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2650 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2652 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2653 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2655 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2656 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2658 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2659 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2661 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2662 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2664 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2665 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2667 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2668 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2670 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2671 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2672 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2673 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2674 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2675 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2676 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2677 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2678 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2679 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2680 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2681 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2682 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2684 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2685 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2687 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2688 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2690 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2691 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2693 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2694 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2696 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2697 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2699 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2700 & ivec_count(fg_rank1),
2701 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2703 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2704 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2706 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2707 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2709 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2710 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2712 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2713 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2715 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2716 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2718 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2719 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2721 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2722 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2724 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2725 & ivec_count(fg_rank1),
2726 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2728 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2729 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2731 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
2732 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2734 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
2735 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2737 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
2738 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2740 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
2741 & ivec_count(fg_rank1),
2742 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2744 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
2745 & ivec_count(fg_rank1),
2746 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2748 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
2749 & ivec_count(fg_rank1),
2750 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2751 & MPI_MAT2,FG_COMM1,IERR)
2752 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
2753 & ivec_count(fg_rank1),
2754 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
2755 & MPI_MAT2,FG_COMM1,IERR)
2758 c Passes matrix info through the ring
2761 if (irecv.lt.0) irecv=nfgtasks1-1
2764 if (inext.ge.nfgtasks1) inext=0
2766 c write (iout,*) "isend",isend," irecv",irecv
2768 lensend=lentyp(isend)
2769 lenrecv=lentyp(irecv)
2770 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
2771 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
2772 c & MPI_ROTAT1(lensend),inext,2200+isend,
2773 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
2774 c & iprev,2200+irecv,FG_COMM,status,IERR)
2775 c write (iout,*) "Gather ROTAT1"
2777 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
2778 c & MPI_ROTAT2(lensend),inext,3300+isend,
2779 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2780 c & iprev,3300+irecv,FG_COMM,status,IERR)
2781 c write (iout,*) "Gather ROTAT2"
2783 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
2784 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
2785 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
2786 & iprev,4400+irecv,FG_COMM,status,IERR)
2787 c write (iout,*) "Gather ROTAT_OLD"
2789 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
2790 & MPI_PRECOMP11(lensend),inext,5500+isend,
2791 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
2792 & iprev,5500+irecv,FG_COMM,status,IERR)
2793 c write (iout,*) "Gather PRECOMP11"
2795 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
2796 & MPI_PRECOMP12(lensend),inext,6600+isend,
2797 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
2798 & iprev,6600+irecv,FG_COMM,status,IERR)
2799 c write (iout,*) "Gather PRECOMP12"
2801 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2803 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
2804 & MPI_ROTAT2(lensend),inext,7700+isend,
2805 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
2806 & iprev,7700+irecv,FG_COMM,status,IERR)
2807 c write (iout,*) "Gather PRECOMP21"
2809 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
2810 & MPI_PRECOMP22(lensend),inext,8800+isend,
2811 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
2812 & iprev,8800+irecv,FG_COMM,status,IERR)
2813 c write (iout,*) "Gather PRECOMP22"
2815 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
2816 & MPI_PRECOMP23(lensend),inext,9900+isend,
2817 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
2818 & MPI_PRECOMP23(lenrecv),
2819 & iprev,9900+irecv,FG_COMM,status,IERR)
2820 c write (iout,*) "Gather PRECOMP23"
2825 if (irecv.lt.0) irecv=nfgtasks1-1
2828 time_gather=time_gather+MPI_Wtime()-time00
2831 c if (fg_rank.eq.0) then
2832 write (iout,*) "Arrays UG and UGDER"
2834 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2835 & ((ug(l,k,i),l=1,2),k=1,2),
2836 & ((ugder(l,k,i),l=1,2),k=1,2)
2838 write (iout,*) "Arrays UG2 and UG2DER"
2840 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2841 & ((ug2(l,k,i),l=1,2),k=1,2),
2842 & ((ug2der(l,k,i),l=1,2),k=1,2)
2844 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2846 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2847 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2848 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2850 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2852 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2853 & costab(i),sintab(i),costab2(i),sintab2(i)
2855 write (iout,*) "Array MUDER"
2857 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2863 cd iti = itortyp(itype(i))
2866 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
2867 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
2872 C--------------------------------------------------------------------------
2873 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
2875 C This subroutine calculates the average interaction energy and its gradient
2876 C in the virtual-bond vectors between non-adjacent peptide groups, based on
2877 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
2878 C The potential depends both on the distance of peptide-group centers and on
2879 C the orientation of the CA-CA virtual bonds.
2881 implicit real*8 (a-h,o-z)
2885 include 'DIMENSIONS'
2886 include 'COMMON.CONTROL'
2887 include 'COMMON.SETUP'
2888 include 'COMMON.IOUNITS'
2889 include 'COMMON.GEO'
2890 include 'COMMON.VAR'
2891 include 'COMMON.LOCAL'
2892 include 'COMMON.CHAIN'
2893 include 'COMMON.DERIV'
2894 include 'COMMON.INTERACT'
2895 include 'COMMON.CONTACTS'
2896 include 'COMMON.TORSION'
2897 include 'COMMON.VECTORS'
2898 include 'COMMON.FFIELD'
2899 include 'COMMON.TIME1'
2900 include 'COMMON.SPLITELE'
2901 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
2902 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
2903 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
2904 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
2905 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
2906 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
2908 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
2910 double precision scal_el /1.0d0/
2912 double precision scal_el /0.5d0/
2915 C 13-go grudnia roku pamietnego...
2916 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
2917 & 0.0d0,1.0d0,0.0d0,
2918 & 0.0d0,0.0d0,1.0d0/
2919 cd write(iout,*) 'In EELEC'
2921 cd write(iout,*) 'Type',i
2922 cd write(iout,*) 'B1',B1(:,i)
2923 cd write(iout,*) 'B2',B2(:,i)
2924 cd write(iout,*) 'CC',CC(:,:,i)
2925 cd write(iout,*) 'DD',DD(:,:,i)
2926 cd write(iout,*) 'EE',EE(:,:,i)
2928 cd call check_vecgrad
2930 if (icheckgrad.eq.1) then
2932 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
2934 dc_norm(k,i)=dc(k,i)*fac
2936 c write (iout,*) 'i',i,' fac',fac
2939 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
2940 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
2941 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
2942 c call vec_and_deriv
2948 time_mat=time_mat+MPI_Wtime()-time01
2952 cd write (iout,*) 'i=',i
2954 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
2957 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
2958 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
2971 cd print '(a)','Enter EELEC'
2972 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
2974 gel_loc_loc(i)=0.0d0
2979 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
2981 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
2983 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
2984 do i=iturn3_start,iturn3_end
2985 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
2986 & .or. itype(i+2).eq.ntyp1
2987 & .or. itype(i+3).eq.ntyp1
2988 & .or. itype(i-1).eq.ntyp1
2989 & .or. itype(i+4).eq.ntyp1
2994 dx_normi=dc_norm(1,i)
2995 dy_normi=dc_norm(2,i)
2996 dz_normi=dc_norm(3,i)
2997 xmedi=c(1,i)+0.5d0*dxi
2998 ymedi=c(2,i)+0.5d0*dyi
2999 zmedi=c(3,i)+0.5d0*dzi
3000 xmedi=mod(xmedi,boxxsize)
3001 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3002 ymedi=mod(ymedi,boxysize)
3003 if (ymedi.lt.0) ymedi=ymedi+boxysize
3004 zmedi=mod(zmedi,boxzsize)
3005 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3007 call eelecij(i,i+2,ees,evdw1,eel_loc)
3008 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3009 num_cont_hb(i)=num_conti
3011 do i=iturn4_start,iturn4_end
3012 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3013 & .or. itype(i+3).eq.ntyp1
3014 & .or. itype(i+4).eq.ntyp1
3015 & .or. itype(i+5).eq.ntyp1
3016 & .or. itype(i).eq.ntyp1
3017 & .or. itype(i-1).eq.ntyp1
3022 dx_normi=dc_norm(1,i)
3023 dy_normi=dc_norm(2,i)
3024 dz_normi=dc_norm(3,i)
3025 xmedi=c(1,i)+0.5d0*dxi
3026 ymedi=c(2,i)+0.5d0*dyi
3027 zmedi=c(3,i)+0.5d0*dzi
3028 C Return atom into box, boxxsize is size of box in x dimension
3030 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3031 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3032 C Condition for being inside the proper box
3033 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
3034 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
3038 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
3039 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3040 C Condition for being inside the proper box
3041 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
3042 c & (ymedi.lt.((-0.5d0)*boxysize))) then
3046 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3047 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3048 C Condition for being inside the proper box
3049 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
3050 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
3053 xmedi=mod(xmedi,boxxsize)
3054 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3055 ymedi=mod(ymedi,boxysize)
3056 if (ymedi.lt.0) ymedi=ymedi+boxysize
3057 zmedi=mod(zmedi,boxzsize)
3058 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3060 num_conti=num_cont_hb(i)
3061 call eelecij(i,i+3,ees,evdw1,eel_loc)
3062 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
3063 & call eturn4(i,eello_turn4)
3064 num_cont_hb(i)=num_conti
3066 C Loop over all neighbouring boxes
3071 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3073 do i=iatel_s,iatel_e
3074 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3075 & .or. itype(i+2).eq.ntyp1
3076 & .or. itype(i-1).eq.ntyp1
3081 dx_normi=dc_norm(1,i)
3082 dy_normi=dc_norm(2,i)
3083 dz_normi=dc_norm(3,i)
3084 xmedi=c(1,i)+0.5d0*dxi
3085 ymedi=c(2,i)+0.5d0*dyi
3086 zmedi=c(3,i)+0.5d0*dzi
3087 xmedi=mod(xmedi,boxxsize)
3088 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3089 ymedi=mod(ymedi,boxysize)
3090 if (ymedi.lt.0) ymedi=ymedi+boxysize
3091 zmedi=mod(zmedi,boxzsize)
3092 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3093 C xmedi=xmedi+xshift*boxxsize
3094 C ymedi=ymedi+yshift*boxysize
3095 C zmedi=zmedi+zshift*boxzsize
3097 C Return tom into box, boxxsize is size of box in x dimension
3099 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3100 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3101 C Condition for being inside the proper box
3102 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
3103 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
3107 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
3108 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3109 C Condition for being inside the proper box
3110 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
3111 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3115 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3116 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3117 cC Condition for being inside the proper box
3118 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3119 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3123 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3124 num_conti=num_cont_hb(i)
3125 do j=ielstart(i),ielend(i)
3126 c write (iout,*) i,j,itype(i),itype(j)
3127 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3128 & .or.itype(j+2).eq.ntyp1
3129 & .or.itype(j-1).eq.ntyp1
3131 call eelecij(i,j,ees,evdw1,eel_loc)
3133 num_cont_hb(i)=num_conti
3139 c write (iout,*) "Number of loop steps in EELEC:",ind
3141 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3142 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3144 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3145 ccc eel_loc=eel_loc+eello_turn3
3146 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3149 C-------------------------------------------------------------------------------
3150 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3151 implicit real*8 (a-h,o-z)
3152 include 'DIMENSIONS'
3156 include 'COMMON.CONTROL'
3157 include 'COMMON.IOUNITS'
3158 include 'COMMON.GEO'
3159 include 'COMMON.VAR'
3160 include 'COMMON.LOCAL'
3161 include 'COMMON.CHAIN'
3162 include 'COMMON.DERIV'
3163 include 'COMMON.INTERACT'
3164 include 'COMMON.CONTACTS'
3165 include 'COMMON.TORSION'
3166 include 'COMMON.VECTORS'
3167 include 'COMMON.FFIELD'
3168 include 'COMMON.TIME1'
3169 include 'COMMON.SPLITELE'
3170 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3171 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3172 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3173 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4)
3174 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3175 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3177 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3179 double precision scal_el /1.0d0/
3181 double precision scal_el /0.5d0/
3184 C 13-go grudnia roku pamietnego...
3185 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3186 & 0.0d0,1.0d0,0.0d0,
3187 & 0.0d0,0.0d0,1.0d0/
3188 c time00=MPI_Wtime()
3189 cd write (iout,*) "eelecij",i,j
3193 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3194 aaa=app(iteli,itelj)
3195 bbb=bpp(iteli,itelj)
3196 ael6i=ael6(iteli,itelj)
3197 ael3i=ael3(iteli,itelj)
3201 dx_normj=dc_norm(1,j)
3202 dy_normj=dc_norm(2,j)
3203 dz_normj=dc_norm(3,j)
3204 C xj=c(1,j)+0.5D0*dxj-xmedi
3205 C yj=c(2,j)+0.5D0*dyj-ymedi
3206 C zj=c(3,j)+0.5D0*dzj-zmedi
3211 if (xj.lt.0) xj=xj+boxxsize
3213 if (yj.lt.0) yj=yj+boxysize
3215 if (zj.lt.0) zj=zj+boxzsize
3216 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
3217 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3225 xj=xj_safe+xshift*boxxsize
3226 yj=yj_safe+yshift*boxysize
3227 zj=zj_safe+zshift*boxzsize
3228 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3229 if(dist_temp.lt.dist_init) then
3239 if (isubchap.eq.1) then
3248 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3250 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3251 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3252 C Condition for being inside the proper box
3253 c if ((xj.gt.((0.5d0)*boxxsize)).or.
3254 c & (xj.lt.((-0.5d0)*boxxsize))) then
3258 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3259 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3260 C Condition for being inside the proper box
3261 c if ((yj.gt.((0.5d0)*boxysize)).or.
3262 c & (yj.lt.((-0.5d0)*boxysize))) then
3266 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3267 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3268 C Condition for being inside the proper box
3269 c if ((zj.gt.((0.5d0)*boxzsize)).or.
3270 c & (zj.lt.((-0.5d0)*boxzsize))) then
3273 C endif !endPBC condintion
3277 rij=xj*xj+yj*yj+zj*zj
3279 sss=sscale(sqrt(rij))
3280 sssgrad=sscagrad(sqrt(rij))
3281 c if (sss.gt.0.0d0) then
3287 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3288 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3289 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3290 fac=cosa-3.0D0*cosb*cosg
3292 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3293 if (j.eq.i+2) ev1=scal_el*ev1
3298 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3302 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3303 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3305 evdw1=evdw1+evdwij*sss
3306 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3307 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3308 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3309 cd & xmedi,ymedi,zmedi,xj,yj,zj
3311 if (energy_dec) then
3312 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3314 &,iteli,itelj,aaa,evdw1
3315 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3319 C Calculate contributions to the Cartesian gradient.
3322 facvdw=-6*rrmij*(ev1+evdwij)*sss
3323 facel=-3*rrmij*(el1+eesij)
3329 * Radial derivatives. First process both termini of the fragment (i,j)
3335 c ghalf=0.5D0*ggg(k)
3336 c gelc(k,i)=gelc(k,i)+ghalf
3337 c gelc(k,j)=gelc(k,j)+ghalf
3339 c 9/28/08 AL Gradient compotents will be summed only at the end
3341 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3342 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3345 * Loop over residues i+1 thru j-1.
3349 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3352 if (sss.gt.0.0) then
3353 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3354 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3355 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3362 c ghalf=0.5D0*ggg(k)
3363 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3364 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3366 c 9/28/08 AL Gradient compotents will be summed only at the end
3368 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3369 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3372 * Loop over residues i+1 thru j-1.
3376 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3381 facvdw=(ev1+evdwij)*sss
3384 fac=-3*rrmij*(facvdw+facvdw+facel)
3389 * Radial derivatives. First process both termini of the fragment (i,j)
3395 c ghalf=0.5D0*ggg(k)
3396 c gelc(k,i)=gelc(k,i)+ghalf
3397 c gelc(k,j)=gelc(k,j)+ghalf
3399 c 9/28/08 AL Gradient compotents will be summed only at the end
3401 gelc_long(k,j)=gelc(k,j)+ggg(k)
3402 gelc_long(k,i)=gelc(k,i)-ggg(k)
3405 * Loop over residues i+1 thru j-1.
3409 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3412 c 9/28/08 AL Gradient compotents will be summed only at the end
3413 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3414 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3415 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3417 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3418 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3424 ecosa=2.0D0*fac3*fac1+fac4
3427 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3428 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3430 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3431 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3433 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3434 cd & (dcosg(k),k=1,3)
3436 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3439 c ghalf=0.5D0*ggg(k)
3440 c gelc(k,i)=gelc(k,i)+ghalf
3441 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3442 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3443 c gelc(k,j)=gelc(k,j)+ghalf
3444 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3445 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3449 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3454 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3455 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3457 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3458 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3459 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3460 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3464 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3465 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3466 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3468 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3469 C energy of a peptide unit is assumed in the form of a second-order
3470 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3471 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3472 C are computed for EVERY pair of non-contiguous peptide groups.
3474 if (j.lt.nres-1) then
3485 muij(kkk)=mu(k,i)*mu(l,j)
3488 cd write (iout,*) 'EELEC: i',i,' j',j
3489 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3490 cd write(iout,*) 'muij',muij
3491 ury=scalar(uy(1,i),erij)
3492 urz=scalar(uz(1,i),erij)
3493 vry=scalar(uy(1,j),erij)
3494 vrz=scalar(uz(1,j),erij)
3495 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3496 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3497 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3498 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3499 fac=dsqrt(-ael6i)*r3ij
3504 cd write (iout,'(4i5,4f10.5)')
3505 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3506 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3507 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3508 cd & uy(:,j),uz(:,j)
3509 cd write (iout,'(4f10.5)')
3510 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3511 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3512 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3513 cd write (iout,'(9f10.5/)')
3514 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3515 C Derivatives of the elements of A in virtual-bond vectors
3516 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3518 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3519 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3520 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3521 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3522 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3523 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3524 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3525 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3526 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3527 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3528 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3529 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3531 C Compute radial contributions to the gradient
3549 C Add the contributions coming from er
3552 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3553 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3554 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3555 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3558 C Derivatives in DC(i)
3559 cgrad ghalf1=0.5d0*agg(k,1)
3560 cgrad ghalf2=0.5d0*agg(k,2)
3561 cgrad ghalf3=0.5d0*agg(k,3)
3562 cgrad ghalf4=0.5d0*agg(k,4)
3563 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3564 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3565 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3566 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3567 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3568 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3569 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3570 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3571 C Derivatives in DC(i+1)
3572 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3573 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3574 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3575 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3576 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3577 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3578 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3579 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3580 C Derivatives in DC(j)
3581 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3582 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3583 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3584 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3585 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3586 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3587 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3588 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3589 C Derivatives in DC(j+1) or DC(nres-1)
3590 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3591 & -3.0d0*vryg(k,3)*ury)
3592 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3593 & -3.0d0*vrzg(k,3)*ury)
3594 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3595 & -3.0d0*vryg(k,3)*urz)
3596 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3597 & -3.0d0*vrzg(k,3)*urz)
3598 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3600 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3613 aggi(k,l)=-aggi(k,l)
3614 aggi1(k,l)=-aggi1(k,l)
3615 aggj(k,l)=-aggj(k,l)
3616 aggj1(k,l)=-aggj1(k,l)
3619 if (j.lt.nres-1) then
3625 aggi(k,l)=-aggi(k,l)
3626 aggi1(k,l)=-aggi1(k,l)
3627 aggj(k,l)=-aggj(k,l)
3628 aggj1(k,l)=-aggj1(k,l)
3639 aggi(k,l)=-aggi(k,l)
3640 aggi1(k,l)=-aggi1(k,l)
3641 aggj(k,l)=-aggj(k,l)
3642 aggj1(k,l)=-aggj1(k,l)
3647 IF (wel_loc.gt.0.0d0) THEN
3648 C Contribution to the local-electrostatic energy coming from the i-j pair
3649 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3651 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
3652 c & ' eel_loc_ij',eel_loc_ij
3654 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3655 & 'eelloc',i,j,eel_loc_ij
3656 c if (eel_loc_ij.ne.0)
3657 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
3658 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
3660 eel_loc=eel_loc+eel_loc_ij
3661 C Partial derivatives in virtual-bond dihedral angles gamma
3663 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3664 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3665 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3666 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3667 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3668 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
3669 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
3671 ggg(l)=agg(l,1)*muij(1)+
3672 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
3673 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
3674 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
3675 cgrad ghalf=0.5d0*ggg(l)
3676 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
3677 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
3681 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
3684 C Remaining derivatives of eello
3686 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
3687 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
3688 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
3689 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
3690 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
3691 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
3692 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
3693 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
3696 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
3697 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
3698 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
3699 & .and. num_conti.le.maxconts) then
3700 c write (iout,*) i,j," entered corr"
3702 C Calculate the contact function. The ith column of the array JCONT will
3703 C contain the numbers of atoms that make contacts with the atom I (of numbers
3704 C greater than I). The arrays FACONT and GACONT will contain the values of
3705 C the contact function and its derivative.
3706 c r0ij=1.02D0*rpp(iteli,itelj)
3707 c r0ij=1.11D0*rpp(iteli,itelj)
3708 r0ij=2.20D0*rpp(iteli,itelj)
3709 c r0ij=1.55D0*rpp(iteli,itelj)
3710 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
3711 if (fcont.gt.0.0D0) then
3712 num_conti=num_conti+1
3713 if (num_conti.gt.maxconts) then
3714 write (iout,*) 'WARNING - max. # of contacts exceeded;',
3715 & ' will skip next contacts for this conf.'
3717 jcont_hb(num_conti,i)=j
3718 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
3719 cd & " jcont_hb",jcont_hb(num_conti,i)
3720 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
3721 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3722 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
3724 d_cont(num_conti,i)=rij
3725 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
3726 C --- Electrostatic-interaction matrix ---
3727 a_chuj(1,1,num_conti,i)=a22
3728 a_chuj(1,2,num_conti,i)=a23
3729 a_chuj(2,1,num_conti,i)=a32
3730 a_chuj(2,2,num_conti,i)=a33
3731 C --- Gradient of rij
3733 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
3740 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
3741 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
3742 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
3743 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
3744 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
3749 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
3750 C Calculate contact energies
3752 wij=cosa-3.0D0*cosb*cosg
3755 c fac3=dsqrt(-ael6i)/r0ij**3
3756 fac3=dsqrt(-ael6i)*r3ij
3757 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
3758 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
3759 if (ees0tmp.gt.0) then
3760 ees0pij=dsqrt(ees0tmp)
3764 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
3765 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
3766 if (ees0tmp.gt.0) then
3767 ees0mij=dsqrt(ees0tmp)
3772 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
3773 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
3774 C Diagnostics. Comment out or remove after debugging!
3775 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
3776 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
3777 c ees0m(num_conti,i)=0.0D0
3779 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
3780 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
3781 C Angular derivatives of the contact function
3782 ees0pij1=fac3/ees0pij
3783 ees0mij1=fac3/ees0mij
3784 fac3p=-3.0D0*fac3*rrmij
3785 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
3786 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
3788 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
3789 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
3790 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
3791 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
3792 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
3793 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
3794 ecosap=ecosa1+ecosa2
3795 ecosbp=ecosb1+ecosb2
3796 ecosgp=ecosg1+ecosg2
3797 ecosam=ecosa1-ecosa2
3798 ecosbm=ecosb1-ecosb2
3799 ecosgm=ecosg1-ecosg2
3808 facont_hb(num_conti,i)=fcont
3809 fprimcont=fprimcont/rij
3810 cd facont_hb(num_conti,i)=1.0D0
3811 C Following line is for diagnostics.
3814 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3815 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3818 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
3819 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
3821 gggp(1)=gggp(1)+ees0pijp*xj
3822 gggp(2)=gggp(2)+ees0pijp*yj
3823 gggp(3)=gggp(3)+ees0pijp*zj
3824 gggm(1)=gggm(1)+ees0mijp*xj
3825 gggm(2)=gggm(2)+ees0mijp*yj
3826 gggm(3)=gggm(3)+ees0mijp*zj
3827 C Derivatives due to the contact function
3828 gacont_hbr(1,num_conti,i)=fprimcont*xj
3829 gacont_hbr(2,num_conti,i)=fprimcont*yj
3830 gacont_hbr(3,num_conti,i)=fprimcont*zj
3833 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
3834 c following the change of gradient-summation algorithm.
3836 cgrad ghalfp=0.5D0*gggp(k)
3837 cgrad ghalfm=0.5D0*gggm(k)
3838 gacontp_hb1(k,num_conti,i)=!ghalfp
3839 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
3840 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3841 gacontp_hb2(k,num_conti,i)=!ghalfp
3842 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
3843 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3844 gacontp_hb3(k,num_conti,i)=gggp(k)
3845 gacontm_hb1(k,num_conti,i)=!ghalfm
3846 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
3847 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3848 gacontm_hb2(k,num_conti,i)=!ghalfm
3849 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
3850 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3851 gacontm_hb3(k,num_conti,i)=gggm(k)
3853 C Diagnostics. Comment out or remove after debugging!
3855 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
3856 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
3857 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
3858 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
3859 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
3860 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
3863 endif ! num_conti.le.maxconts
3866 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
3869 ghalf=0.5d0*agg(l,k)
3870 aggi(l,k)=aggi(l,k)+ghalf
3871 aggi1(l,k)=aggi1(l,k)+agg(l,k)
3872 aggj(l,k)=aggj(l,k)+ghalf
3875 if (j.eq.nres-1 .and. i.lt.j-2) then
3878 aggj1(l,k)=aggj1(l,k)+agg(l,k)
3883 c t_eelecij=t_eelecij+MPI_Wtime()-time00
3886 C-----------------------------------------------------------------------------
3887 subroutine eturn3(i,eello_turn3)
3888 C Third- and fourth-order contributions from turns
3889 implicit real*8 (a-h,o-z)
3890 include 'DIMENSIONS'
3891 include 'COMMON.IOUNITS'
3892 include 'COMMON.GEO'
3893 include 'COMMON.VAR'
3894 include 'COMMON.LOCAL'
3895 include 'COMMON.CHAIN'
3896 include 'COMMON.DERIV'
3897 include 'COMMON.INTERACT'
3898 include 'COMMON.CONTACTS'
3899 include 'COMMON.TORSION'
3900 include 'COMMON.VECTORS'
3901 include 'COMMON.FFIELD'
3902 include 'COMMON.CONTROL'
3904 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
3905 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
3906 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
3907 double precision agg(3,4),aggi(3,4),aggi1(3,4),
3908 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
3909 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3910 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3913 c write (iout,*) "eturn3",i,j,j1,j2
3918 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3920 C Third-order contributions
3927 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
3928 cd call checkint_turn3(i,a_temp,eello_turn3_num)
3929 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
3930 call transpose2(auxmat(1,1),auxmat1(1,1))
3931 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3932 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
3933 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3934 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
3935 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
3936 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
3937 cd & ' eello_turn3_num',4*eello_turn3_num
3938 C Derivatives in gamma(i)
3939 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
3940 call transpose2(auxmat2(1,1),auxmat3(1,1))
3941 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3942 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
3943 C Derivatives in gamma(i+1)
3944 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
3945 call transpose2(auxmat2(1,1),auxmat3(1,1))
3946 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
3947 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
3948 & +0.5d0*(pizda(1,1)+pizda(2,2))
3949 C Cartesian derivatives
3951 c ghalf1=0.5d0*agg(l,1)
3952 c ghalf2=0.5d0*agg(l,2)
3953 c ghalf3=0.5d0*agg(l,3)
3954 c ghalf4=0.5d0*agg(l,4)
3955 a_temp(1,1)=aggi(l,1)!+ghalf1
3956 a_temp(1,2)=aggi(l,2)!+ghalf2
3957 a_temp(2,1)=aggi(l,3)!+ghalf3
3958 a_temp(2,2)=aggi(l,4)!+ghalf4
3959 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3960 gcorr3_turn(l,i)=gcorr3_turn(l,i)
3961 & +0.5d0*(pizda(1,1)+pizda(2,2))
3962 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
3963 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
3964 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
3965 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
3966 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3967 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
3968 & +0.5d0*(pizda(1,1)+pizda(2,2))
3969 a_temp(1,1)=aggj(l,1)!+ghalf1
3970 a_temp(1,2)=aggj(l,2)!+ghalf2
3971 a_temp(2,1)=aggj(l,3)!+ghalf3
3972 a_temp(2,2)=aggj(l,4)!+ghalf4
3973 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3974 gcorr3_turn(l,j)=gcorr3_turn(l,j)
3975 & +0.5d0*(pizda(1,1)+pizda(2,2))
3976 a_temp(1,1)=aggj1(l,1)
3977 a_temp(1,2)=aggj1(l,2)
3978 a_temp(2,1)=aggj1(l,3)
3979 a_temp(2,2)=aggj1(l,4)
3980 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
3981 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
3982 & +0.5d0*(pizda(1,1)+pizda(2,2))
3986 C-------------------------------------------------------------------------------
3987 subroutine eturn4(i,eello_turn4)
3988 C Third- and fourth-order contributions from turns
3989 implicit real*8 (a-h,o-z)
3990 include 'DIMENSIONS'
3991 include 'COMMON.IOUNITS'
3992 include 'COMMON.GEO'
3993 include 'COMMON.VAR'
3994 include 'COMMON.LOCAL'
3995 include 'COMMON.CHAIN'
3996 include 'COMMON.DERIV'
3997 include 'COMMON.INTERACT'
3998 include 'COMMON.CONTACTS'
3999 include 'COMMON.TORSION'
4000 include 'COMMON.VECTORS'
4001 include 'COMMON.FFIELD'
4002 include 'COMMON.CONTROL'
4004 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4005 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4006 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2)
4007 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4008 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4009 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4010 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4013 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4015 C Fourth-order contributions
4023 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4024 cd call checkint_turn4(i,a_temp,eello_turn4_num)
4025 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4030 iti1=itortyp(itype(i+1))
4031 iti2=itortyp(itype(i+2))
4032 iti3=itortyp(itype(i+3))
4033 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4034 call transpose2(EUg(1,1,i+1),e1t(1,1))
4035 call transpose2(Eug(1,1,i+2),e2t(1,1))
4036 call transpose2(Eug(1,1,i+3),e3t(1,1))
4037 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4038 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4039 s1=scalar2(b1(1,iti2),auxvec(1))
4040 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4041 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4042 s2=scalar2(b1(1,iti1),auxvec(1))
4043 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4044 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4045 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4046 eello_turn4=eello_turn4-(s1+s2+s3)
4047 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
4048 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
4049 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
4050 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4051 cd & ' eello_turn4_num',8*eello_turn4_num
4052 C Derivatives in gamma(i)
4053 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4054 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4055 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4056 s1=scalar2(b1(1,iti2),auxvec(1))
4057 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4058 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4059 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
4060 C Derivatives in gamma(i+1)
4061 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4062 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4063 s2=scalar2(b1(1,iti1),auxvec(1))
4064 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4065 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4066 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4067 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
4068 C Derivatives in gamma(i+2)
4069 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4070 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4071 s1=scalar2(b1(1,iti2),auxvec(1))
4072 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4073 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4074 s2=scalar2(b1(1,iti1),auxvec(1))
4075 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4076 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4077 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4078 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
4079 C Cartesian derivatives
4080 C Derivatives of this turn contributions in DC(i+2)
4081 if (j.lt.nres-1) then
4083 a_temp(1,1)=agg(l,1)
4084 a_temp(1,2)=agg(l,2)
4085 a_temp(2,1)=agg(l,3)
4086 a_temp(2,2)=agg(l,4)
4087 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4088 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4089 s1=scalar2(b1(1,iti2),auxvec(1))
4090 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4091 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4092 s2=scalar2(b1(1,iti1),auxvec(1))
4093 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4094 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4095 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4097 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
4100 C Remaining derivatives of this turn contribution
4102 a_temp(1,1)=aggi(l,1)
4103 a_temp(1,2)=aggi(l,2)
4104 a_temp(2,1)=aggi(l,3)
4105 a_temp(2,2)=aggi(l,4)
4106 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4107 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4108 s1=scalar2(b1(1,iti2),auxvec(1))
4109 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4110 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4111 s2=scalar2(b1(1,iti1),auxvec(1))
4112 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4113 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4114 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4115 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4116 a_temp(1,1)=aggi1(l,1)
4117 a_temp(1,2)=aggi1(l,2)
4118 a_temp(2,1)=aggi1(l,3)
4119 a_temp(2,2)=aggi1(l,4)
4120 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4121 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4122 s1=scalar2(b1(1,iti2),auxvec(1))
4123 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4124 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4125 s2=scalar2(b1(1,iti1),auxvec(1))
4126 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4127 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4128 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4129 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4130 a_temp(1,1)=aggj(l,1)
4131 a_temp(1,2)=aggj(l,2)
4132 a_temp(2,1)=aggj(l,3)
4133 a_temp(2,2)=aggj(l,4)
4134 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4135 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4136 s1=scalar2(b1(1,iti2),auxvec(1))
4137 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4138 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4139 s2=scalar2(b1(1,iti1),auxvec(1))
4140 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4141 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4142 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4143 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4144 a_temp(1,1)=aggj1(l,1)
4145 a_temp(1,2)=aggj1(l,2)
4146 a_temp(2,1)=aggj1(l,3)
4147 a_temp(2,2)=aggj1(l,4)
4148 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4149 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4150 s1=scalar2(b1(1,iti2),auxvec(1))
4151 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4152 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4153 s2=scalar2(b1(1,iti1),auxvec(1))
4154 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4155 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4156 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4157 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4158 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4162 C-----------------------------------------------------------------------------
4163 subroutine vecpr(u,v,w)
4164 implicit real*8(a-h,o-z)
4165 dimension u(3),v(3),w(3)
4166 w(1)=u(2)*v(3)-u(3)*v(2)
4167 w(2)=-u(1)*v(3)+u(3)*v(1)
4168 w(3)=u(1)*v(2)-u(2)*v(1)
4171 C-----------------------------------------------------------------------------
4172 subroutine unormderiv(u,ugrad,unorm,ungrad)
4173 C This subroutine computes the derivatives of a normalized vector u, given
4174 C the derivatives computed without normalization conditions, ugrad. Returns
4177 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4178 double precision vec(3)
4179 double precision scalar
4181 c write (2,*) 'ugrad',ugrad
4184 vec(i)=scalar(ugrad(1,i),u(1))
4186 c write (2,*) 'vec',vec
4189 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4192 c write (2,*) 'ungrad',ungrad
4195 C-----------------------------------------------------------------------------
4196 subroutine escp_soft_sphere(evdw2,evdw2_14)
4198 C This subroutine calculates the excluded-volume interaction energy between
4199 C peptide-group centers and side chains and its gradient in virtual-bond and
4200 C side-chain vectors.
4202 implicit real*8 (a-h,o-z)
4203 include 'DIMENSIONS'
4204 include 'COMMON.GEO'
4205 include 'COMMON.VAR'
4206 include 'COMMON.LOCAL'
4207 include 'COMMON.CHAIN'
4208 include 'COMMON.DERIV'
4209 include 'COMMON.INTERACT'
4210 include 'COMMON.FFIELD'
4211 include 'COMMON.IOUNITS'
4212 include 'COMMON.CONTROL'
4217 cd print '(a)','Enter ESCP'
4218 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4222 do i=iatscp_s,iatscp_e
4223 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4225 xi=0.5D0*(c(1,i)+c(1,i+1))
4226 yi=0.5D0*(c(2,i)+c(2,i+1))
4227 zi=0.5D0*(c(3,i)+c(3,i+1))
4228 C Return atom into box, boxxsize is size of box in x dimension
4230 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4231 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4232 C Condition for being inside the proper box
4233 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4234 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4238 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4239 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4240 C Condition for being inside the proper box
4241 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4242 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4246 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4247 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4248 cC Condition for being inside the proper box
4249 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4250 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4254 if (xi.lt.0) xi=xi+boxxsize
4256 if (yi.lt.0) yi=yi+boxysize
4258 if (zi.lt.0) zi=zi+boxzsize
4259 C xi=xi+xshift*boxxsize
4260 C yi=yi+yshift*boxysize
4261 C zi=zi+zshift*boxzsize
4262 do iint=1,nscp_gr(i)
4264 do j=iscpstart(i,iint),iscpend(i,iint)
4265 if (itype(j).eq.ntyp1) cycle
4266 itypj=iabs(itype(j))
4267 C Uncomment following three lines for SC-p interactions
4271 C Uncomment following three lines for Ca-p interactions
4276 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4277 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4278 C Condition for being inside the proper box
4279 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4280 c & (xj.lt.((-0.5d0)*boxxsize))) then
4284 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4285 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4286 cC Condition for being inside the proper box
4287 c if ((yj.gt.((0.5d0)*boxysize)).or.
4288 c & (yj.lt.((-0.5d0)*boxysize))) then
4292 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4293 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4294 C Condition for being inside the proper box
4295 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4296 c & (zj.lt.((-0.5d0)*boxzsize))) then
4299 if (xj.lt.0) xj=xj+boxxsize
4301 if (yj.lt.0) yj=yj+boxysize
4303 if (zj.lt.0) zj=zj+boxzsize
4304 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4312 xj=xj_safe+xshift*boxxsize
4313 yj=yj_safe+yshift*boxysize
4314 zj=zj_safe+zshift*boxzsize
4315 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4316 if(dist_temp.lt.dist_init) then
4326 if (subchap.eq.1) then
4339 rij=xj*xj+yj*yj+zj*zj
4343 if (rij.lt.r0ijsq) then
4344 evdwij=0.25d0*(rij-r0ijsq)**2
4352 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4357 cgrad if (j.lt.i) then
4358 cd write (iout,*) 'j<i'
4359 C Uncomment following three lines for SC-p interactions
4361 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4364 cd write (iout,*) 'j>i'
4366 cgrad ggg(k)=-ggg(k)
4367 C Uncomment following line for SC-p interactions
4368 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4372 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4374 cgrad kstart=min0(i+1,j)
4375 cgrad kend=max0(i-1,j-1)
4376 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4377 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4378 cgrad do k=kstart,kend
4380 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4384 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4385 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4396 C-----------------------------------------------------------------------------
4397 subroutine escp(evdw2,evdw2_14)
4399 C This subroutine calculates the excluded-volume interaction energy between
4400 C peptide-group centers and side chains and its gradient in virtual-bond and
4401 C side-chain vectors.
4403 implicit real*8 (a-h,o-z)
4404 include 'DIMENSIONS'
4405 include 'COMMON.GEO'
4406 include 'COMMON.VAR'
4407 include 'COMMON.LOCAL'
4408 include 'COMMON.CHAIN'
4409 include 'COMMON.DERIV'
4410 include 'COMMON.INTERACT'
4411 include 'COMMON.FFIELD'
4412 include 'COMMON.IOUNITS'
4413 include 'COMMON.CONTROL'
4414 include 'COMMON.SPLITELE'
4418 c print *,boxxsize,boxysize,boxzsize,'wymiary pudla'
4419 cd print '(a)','Enter ESCP'
4420 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4424 do i=iatscp_s,iatscp_e
4425 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4427 xi=0.5D0*(c(1,i)+c(1,i+1))
4428 yi=0.5D0*(c(2,i)+c(2,i+1))
4429 zi=0.5D0*(c(3,i)+c(3,i+1))
4431 if (xi.lt.0) xi=xi+boxxsize
4433 if (yi.lt.0) yi=yi+boxysize
4435 if (zi.lt.0) zi=zi+boxzsize
4436 c xi=xi+xshift*boxxsize
4437 c yi=yi+yshift*boxysize
4438 c zi=zi+zshift*boxzsize
4439 c print *,xi,yi,zi,'polozenie i'
4440 C Return atom into box, boxxsize is size of box in x dimension
4442 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4443 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4444 C Condition for being inside the proper box
4445 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4446 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4450 c print *,xi,boxxsize,"pierwszy"
4452 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4453 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4454 C Condition for being inside the proper box
4455 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4456 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4460 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4461 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4462 C Condition for being inside the proper box
4463 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4464 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4467 do iint=1,nscp_gr(i)
4469 do j=iscpstart(i,iint),iscpend(i,iint)
4470 itypj=iabs(itype(j))
4471 if (itypj.eq.ntyp1) cycle
4472 C Uncomment following three lines for SC-p interactions
4476 C Uncomment following three lines for Ca-p interactions
4481 if (xj.lt.0) xj=xj+boxxsize
4483 if (yj.lt.0) yj=yj+boxysize
4485 if (zj.lt.0) zj=zj+boxzsize
4487 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4488 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4489 C Condition for being inside the proper box
4490 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4491 c & (xj.lt.((-0.5d0)*boxxsize))) then
4495 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4496 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4497 cC Condition for being inside the proper box
4498 c if ((yj.gt.((0.5d0)*boxysize)).or.
4499 c & (yj.lt.((-0.5d0)*boxysize))) then
4503 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4504 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4505 C Condition for being inside the proper box
4506 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4507 c & (zj.lt.((-0.5d0)*boxzsize))) then
4510 CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE
4511 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4519 xj=xj_safe+xshift*boxxsize
4520 yj=yj_safe+yshift*boxysize
4521 zj=zj_safe+zshift*boxzsize
4522 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4523 if(dist_temp.lt.dist_init) then
4533 if (subchap.eq.1) then
4542 c print *,xj,yj,zj,'polozenie j'
4543 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4545 sss=sscale(1.0d0/(dsqrt(rrij)))
4546 c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz'
4547 c if (sss.eq.0) print *,'czasem jest OK'
4548 if (sss.le.0.0d0) cycle
4549 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
4551 e1=fac*fac*aad(itypj,iteli)
4552 e2=fac*bad(itypj,iteli)
4553 if (iabs(j-i) .le. 2) then
4556 evdw2_14=evdw2_14+(e1+e2)*sss
4559 evdw2=evdw2+evdwij*sss
4560 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4561 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4564 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4566 fac=-(evdwij+e1)*rrij*sss
4567 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
4571 cgrad if (j.lt.i) then
4572 cd write (iout,*) 'j<i'
4573 C Uncomment following three lines for SC-p interactions
4575 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4578 cd write (iout,*) 'j>i'
4580 cgrad ggg(k)=-ggg(k)
4581 C Uncomment following line for SC-p interactions
4582 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4583 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4587 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4589 cgrad kstart=min0(i+1,j)
4590 cgrad kend=max0(i-1,j-1)
4591 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4592 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4593 cgrad do k=kstart,kend
4595 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4599 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4600 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4602 c endif !endif for sscale cutoff
4612 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
4613 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
4614 gradx_scp(j,i)=expon*gradx_scp(j,i)
4617 C******************************************************************************
4621 C To save time the factor EXPON has been extracted from ALL components
4622 C of GVDWC and GRADX. Remember to multiply them by this factor before further
4625 C******************************************************************************
4628 C--------------------------------------------------------------------------
4629 subroutine edis(ehpb)
4631 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
4633 implicit real*8 (a-h,o-z)
4634 include 'DIMENSIONS'
4635 include 'COMMON.SBRIDGE'
4636 include 'COMMON.CHAIN'
4637 include 'COMMON.DERIV'
4638 include 'COMMON.VAR'
4639 include 'COMMON.INTERACT'
4640 include 'COMMON.IOUNITS'
4643 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
4644 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
4645 if (link_end.eq.0) return
4646 do i=link_start,link_end
4647 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
4648 C CA-CA distance used in regularization of structure.
4651 C iii and jjj point to the residues for which the distance is assigned.
4652 if (ii.gt.nres) then
4659 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
4660 c & dhpb(i),dhpb1(i),forcon(i)
4661 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
4662 C distance and angle dependent SS bond potential.
4663 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
4664 & iabs(itype(jjj)).eq.1) then
4665 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4666 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
4667 if (.not.dyn_ss .and. i.le.nss) then
4668 C 15/02/13 CC dynamic SSbond - additional check
4670 & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
4671 >>>>>>> f5379d3246c4bd95e946c4d35d4a1c13e329c4cb
4672 call ssbond_ene(iii,jjj,eij)
4675 cd write (iout,*) "eij",eij
4677 C Calculate the distance between the two points and its difference from the
4681 C Get the force constant corresponding to this distance.
4683 C Calculate the contribution to energy.
4684 ehpb=ehpb+waga*rdis*rdis
4686 C Evaluate gradient.
4689 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
4690 cd & ' waga=',waga,' fac=',fac
4692 ggg(j)=fac*(c(j,jj)-c(j,ii))
4694 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
4695 C If this is a SC-SC distance, we need to calculate the contributions to the
4696 C Cartesian gradient in the SC vectors (ghpbx).
4699 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
4700 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
4703 cgrad do j=iii,jjj-1
4705 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
4709 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
4710 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
4717 C--------------------------------------------------------------------------
4718 subroutine ssbond_ene(i,j,eij)
4720 C Calculate the distance and angle dependent SS-bond potential energy
4721 C using a free-energy function derived based on RHF/6-31G** ab initio
4722 C calculations of diethyl disulfide.
4724 C A. Liwo and U. Kozlowska, 11/24/03
4726 implicit real*8 (a-h,o-z)
4727 include 'DIMENSIONS'
4728 include 'COMMON.SBRIDGE'
4729 include 'COMMON.CHAIN'
4730 include 'COMMON.DERIV'
4731 include 'COMMON.LOCAL'
4732 include 'COMMON.INTERACT'
4733 include 'COMMON.VAR'
4734 include 'COMMON.IOUNITS'
4735 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
4736 itypi=iabs(itype(i))
4740 dxi=dc_norm(1,nres+i)
4741 dyi=dc_norm(2,nres+i)
4742 dzi=dc_norm(3,nres+i)
4743 c dsci_inv=dsc_inv(itypi)
4744 dsci_inv=vbld_inv(nres+i)
4745 itypj=iabs(itype(j))
4746 c dscj_inv=dsc_inv(itypj)
4747 dscj_inv=vbld_inv(nres+j)
4751 dxj=dc_norm(1,nres+j)
4752 dyj=dc_norm(2,nres+j)
4753 dzj=dc_norm(3,nres+j)
4754 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4759 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
4760 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
4761 om12=dxi*dxj+dyi*dyj+dzi*dzj
4763 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
4764 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
4770 deltat12=om2-om1+2.0d0
4772 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
4773 & +akct*deltad*deltat12
4774 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
4775 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
4776 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
4777 c & " deltat12",deltat12," eij",eij
4778 ed=2*akcm*deltad+akct*deltat12
4780 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
4781 eom1=-2*akth*deltat1-pom1-om2*pom2
4782 eom2= 2*akth*deltat2+pom1-om1*pom2
4785 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
4786 ghpbx(k,i)=ghpbx(k,i)-ggk
4787 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
4788 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
4789 ghpbx(k,j)=ghpbx(k,j)+ggk
4790 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
4791 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
4792 ghpbc(k,i)=ghpbc(k,i)-ggk
4793 ghpbc(k,j)=ghpbc(k,j)+ggk
4796 C Calculate the components of the gradient in DC and X
4800 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
4805 C--------------------------------------------------------------------------
4806 subroutine ebond(estr)
4808 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
4810 implicit real*8 (a-h,o-z)
4811 include 'DIMENSIONS'
4812 include 'COMMON.LOCAL'
4813 include 'COMMON.GEO'
4814 include 'COMMON.INTERACT'
4815 include 'COMMON.DERIV'
4816 include 'COMMON.VAR'
4817 include 'COMMON.CHAIN'
4818 include 'COMMON.IOUNITS'
4819 include 'COMMON.NAMES'
4820 include 'COMMON.FFIELD'
4821 include 'COMMON.CONTROL'
4822 include 'COMMON.SETUP'
4823 double precision u(3),ud(3)
4826 do i=ibondp_start,ibondp_end
4827 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
4828 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
4830 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
4831 c & *dc(j,i-1)/vbld(i)
4833 c if (energy_dec) write(iout,*)
4834 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
4836 C Checking if it involves dummy (NH3+ or COO-) group
4837 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
4838 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
4839 diff = vbld(i)-vbldpDUM
4841 C NO vbldp0 is the equlibrium lenght of spring for peptide group
4842 diff = vbld(i)-vbldp0
4844 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
4845 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
4848 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
4850 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
4853 estr=0.5d0*AKP*estr+estr1
4855 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
4857 do i=ibond_start,ibond_end
4859 if (iti.ne.10 .and. iti.ne.ntyp1) then
4862 diff=vbld(i+nres)-vbldsc0(1,iti)
4863 if (energy_dec) write (iout,*)
4864 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
4865 & AKSC(1,iti),AKSC(1,iti)*diff*diff
4866 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
4868 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
4872 diff=vbld(i+nres)-vbldsc0(j,iti)
4873 ud(j)=aksc(j,iti)*diff
4874 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
4888 uprod2=uprod2*u(k)*u(k)
4892 usumsqder=usumsqder+ud(j)*uprod2
4894 estr=estr+uprod/usum
4896 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
4904 C--------------------------------------------------------------------------
4905 subroutine ebend(etheta)
4907 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
4908 C angles gamma and its derivatives in consecutive thetas and gammas.
4910 implicit real*8 (a-h,o-z)
4911 include 'DIMENSIONS'
4912 include 'COMMON.LOCAL'
4913 include 'COMMON.GEO'
4914 include 'COMMON.INTERACT'
4915 include 'COMMON.DERIV'
4916 include 'COMMON.VAR'
4917 include 'COMMON.CHAIN'
4918 include 'COMMON.IOUNITS'
4919 include 'COMMON.NAMES'
4920 include 'COMMON.FFIELD'
4921 include 'COMMON.CONTROL'
4922 common /calcthet/ term1,term2,termm,diffak,ratak,
4923 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
4924 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
4925 double precision y(2),z(2)
4927 c time11=dexp(-2*time)
4930 c write (*,'(a,i2)') 'EBEND ICG=',icg
4931 do i=ithet_start,ithet_end
4932 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
4933 & .or.itype(i).eq.ntyp1) cycle
4934 C Zero the energy function and its derivative at 0 or pi.
4935 call splinthet(theta(i),0.5d0*delta,ss,ssd)
4937 ichir1=isign(1,itype(i-2))
4938 ichir2=isign(1,itype(i))
4939 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
4940 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
4941 if (itype(i-1).eq.10) then
4942 itype1=isign(10,itype(i-2))
4943 ichir11=isign(1,itype(i-2))
4944 ichir12=isign(1,itype(i-2))
4945 itype2=isign(10,itype(i))
4946 ichir21=isign(1,itype(i))
4947 ichir22=isign(1,itype(i))
4950 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
4953 if (phii.ne.phii) phii=150.0
4963 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
4966 if (phii1.ne.phii1) phii1=150.0
4978 C Calculate the "mean" value of theta from the part of the distribution
4979 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
4980 C In following comments this theta will be referred to as t_c.
4981 thet_pred_mean=0.0d0
4983 athetk=athet(k,it,ichir1,ichir2)
4984 bthetk=bthet(k,it,ichir1,ichir2)
4986 athetk=athet(k,itype1,ichir11,ichir12)
4987 bthetk=bthet(k,itype2,ichir21,ichir22)
4989 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
4990 c write(iout,*) 'chuj tu', y(k),z(k)
4992 dthett=thet_pred_mean*ssd
4993 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
4994 C Derivatives of the "mean" values in gamma1 and gamma2.
4995 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
4996 &+athet(2,it,ichir1,ichir2)*y(1))*ss
4997 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
4998 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
5000 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
5001 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
5002 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
5003 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5005 if (theta(i).gt.pi-delta) then
5006 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
5008 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5009 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5010 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
5012 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
5014 else if (theta(i).lt.delta) then
5015 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5016 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5017 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
5019 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5020 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
5023 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
5026 etheta=etheta+ethetai
5027 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
5028 & 'ebend',i,ethetai,theta(i),itype(i)
5029 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5030 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5031 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
5033 C Ufff.... We've done all this!!!
5036 C---------------------------------------------------------------------------
5037 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
5039 implicit real*8 (a-h,o-z)
5040 include 'DIMENSIONS'
5041 include 'COMMON.LOCAL'
5042 include 'COMMON.IOUNITS'
5043 common /calcthet/ term1,term2,termm,diffak,ratak,
5044 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5045 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5046 C Calculate the contributions to both Gaussian lobes.
5047 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5048 C The "polynomial part" of the "standard deviation" of this part of
5049 C the distributioni.
5050 ccc write (iout,*) thetai,thet_pred_mean
5053 sig=sig*thet_pred_mean+polthet(j,it)
5055 C Derivative of the "interior part" of the "standard deviation of the"
5056 C gamma-dependent Gaussian lobe in t_c.
5057 sigtc=3*polthet(3,it)
5059 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5062 C Set the parameters of both Gaussian lobes of the distribution.
5063 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5064 fac=sig*sig+sigc0(it)
5067 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5068 sigsqtc=-4.0D0*sigcsq*sigtc
5069 c print *,i,sig,sigtc,sigsqtc
5070 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
5071 sigtc=-sigtc/(fac*fac)
5072 C Following variable is sigma(t_c)**(-2)
5073 sigcsq=sigcsq*sigcsq
5075 sig0inv=1.0D0/sig0i**2
5076 delthec=thetai-thet_pred_mean
5077 delthe0=thetai-theta0i
5078 term1=-0.5D0*sigcsq*delthec*delthec
5079 term2=-0.5D0*sig0inv*delthe0*delthe0
5080 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
5081 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5082 C NaNs in taking the logarithm. We extract the largest exponent which is added
5083 C to the energy (this being the log of the distribution) at the end of energy
5084 C term evaluation for this virtual-bond angle.
5085 if (term1.gt.term2) then
5087 term2=dexp(term2-termm)
5091 term1=dexp(term1-termm)
5094 C The ratio between the gamma-independent and gamma-dependent lobes of
5095 C the distribution is a Gaussian function of thet_pred_mean too.
5096 diffak=gthet(2,it)-thet_pred_mean
5097 ratak=diffak/gthet(3,it)**2
5098 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5099 C Let's differentiate it in thet_pred_mean NOW.
5101 C Now put together the distribution terms to make complete distribution.
5102 termexp=term1+ak*term2
5103 termpre=sigc+ak*sig0i
5104 C Contribution of the bending energy from this theta is just the -log of
5105 C the sum of the contributions from the two lobes and the pre-exponential
5106 C factor. Simple enough, isn't it?
5107 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5108 C write (iout,*) 'termexp',termexp,termm,termpre,i
5109 C NOW the derivatives!!!
5110 C 6/6/97 Take into account the deformation.
5111 E_theta=(delthec*sigcsq*term1
5112 & +ak*delthe0*sig0inv*term2)/termexp
5113 E_tc=((sigtc+aktc*sig0i)/termpre
5114 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
5115 & aktc*term2)/termexp)
5118 c-----------------------------------------------------------------------------
5119 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
5120 implicit real*8 (a-h,o-z)
5121 include 'DIMENSIONS'
5122 include 'COMMON.LOCAL'
5123 include 'COMMON.IOUNITS'
5124 common /calcthet/ term1,term2,termm,diffak,ratak,
5125 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5126 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5127 delthec=thetai-thet_pred_mean
5128 delthe0=thetai-theta0i
5129 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
5130 t3 = thetai-thet_pred_mean
5134 t14 = t12+t6*sigsqtc
5136 t21 = thetai-theta0i
5142 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
5143 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
5144 & *(-t12*t9-ak*sig0inv*t27)
5148 C--------------------------------------------------------------------------
5149 subroutine ebend(etheta)
5151 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5152 C angles gamma and its derivatives in consecutive thetas and gammas.
5153 C ab initio-derived potentials from
5154 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5156 implicit real*8 (a-h,o-z)
5157 include 'DIMENSIONS'
5158 include 'COMMON.LOCAL'
5159 include 'COMMON.GEO'
5160 include 'COMMON.INTERACT'
5161 include 'COMMON.DERIV'
5162 include 'COMMON.VAR'
5163 include 'COMMON.CHAIN'
5164 include 'COMMON.IOUNITS'
5165 include 'COMMON.NAMES'
5166 include 'COMMON.FFIELD'
5167 include 'COMMON.CONTROL'
5168 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
5169 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
5170 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
5171 & sinph1ph2(maxdouble,maxdouble)
5172 logical lprn /.false./, lprn1 /.false./
5174 do i=ithet_start,ithet_end
5175 c print *,i,itype(i-1),itype(i),itype(i-2)
5176 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5177 & .or.itype(i).eq.ntyp1) cycle
5178 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
5180 if (iabs(itype(i+1)).eq.20) iblock=2
5181 if (iabs(itype(i+1)).ne.20) iblock=1
5185 theti2=0.5d0*theta(i)
5186 ityp2=ithetyp((itype(i-1)))
5188 coskt(k)=dcos(k*theti2)
5189 sinkt(k)=dsin(k*theti2)
5191 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5194 if (phii.ne.phii) phii=150.0
5198 ityp1=ithetyp((itype(i-2)))
5199 C propagation of chirality for glycine type
5201 cosph1(k)=dcos(k*phii)
5202 sinph1(k)=dsin(k*phii)
5212 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5215 if (phii1.ne.phii1) phii1=150.0
5220 ityp3=ithetyp((itype(i)))
5222 cosph2(k)=dcos(k*phii1)
5223 sinph2(k)=dsin(k*phii1)
5233 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5236 ccl=cosph1(l)*cosph2(k-l)
5237 ssl=sinph1(l)*sinph2(k-l)
5238 scl=sinph1(l)*cosph2(k-l)
5239 csl=cosph1(l)*sinph2(k-l)
5240 cosph1ph2(l,k)=ccl-ssl
5241 cosph1ph2(k,l)=ccl+ssl
5242 sinph1ph2(l,k)=scl+csl
5243 sinph1ph2(k,l)=scl-csl
5247 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5248 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5249 write (iout,*) "coskt and sinkt"
5251 write (iout,*) k,coskt(k),sinkt(k)
5255 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5256 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5259 & write (iout,*) "k",k,"
5260 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
5261 & " ethetai",ethetai
5264 write (iout,*) "cosph and sinph"
5266 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5268 write (iout,*) "cosph1ph2 and sinph2ph2"
5271 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5272 & sinph1ph2(l,k),sinph1ph2(k,l)
5275 write(iout,*) "ethetai",ethetai
5279 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5280 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5281 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5282 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5283 ethetai=ethetai+sinkt(m)*aux
5284 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5285 dephii=dephii+k*sinkt(m)*(
5286 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5287 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5288 dephii1=dephii1+k*sinkt(m)*(
5289 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5290 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5292 & write (iout,*) "m",m," k",k," bbthet",
5293 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5294 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5295 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5296 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5300 & write(iout,*) "ethetai",ethetai
5304 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5305 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5306 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5307 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5308 ethetai=ethetai+sinkt(m)*aux
5309 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5310 dephii=dephii+l*sinkt(m)*(
5311 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5312 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5313 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5314 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5315 dephii1=dephii1+(k-l)*sinkt(m)*(
5316 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5317 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5318 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5319 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5321 write (iout,*) "m",m," k",k," l",l," ffthet",
5322 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5323 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5324 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5325 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5326 & " ethetai",ethetai
5327 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5328 & cosph1ph2(k,l)*sinkt(m),
5329 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5337 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5338 & i,theta(i)*rad2deg,phii*rad2deg,
5339 & phii1*rad2deg,ethetai
5341 etheta=etheta+ethetai
5342 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5343 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5344 gloc(nphi+i-2,icg)=wang*dethetai+ gloc(nphi+i-2,icg)
5350 c-----------------------------------------------------------------------------
5351 subroutine esc(escloc)
5352 C Calculate the local energy of a side chain and its derivatives in the
5353 C corresponding virtual-bond valence angles THETA and the spherical angles
5355 implicit real*8 (a-h,o-z)
5356 include 'DIMENSIONS'
5357 include 'COMMON.GEO'
5358 include 'COMMON.LOCAL'
5359 include 'COMMON.VAR'
5360 include 'COMMON.INTERACT'
5361 include 'COMMON.DERIV'
5362 include 'COMMON.CHAIN'
5363 include 'COMMON.IOUNITS'
5364 include 'COMMON.NAMES'
5365 include 'COMMON.FFIELD'
5366 include 'COMMON.CONTROL'
5367 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5368 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5369 common /sccalc/ time11,time12,time112,theti,it,nlobit
5372 c write (iout,'(a)') 'ESC'
5373 do i=loc_start,loc_end
5375 if (it.eq.ntyp1) cycle
5376 if (it.eq.10) goto 1
5377 nlobit=nlob(iabs(it))
5378 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5379 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5380 theti=theta(i+1)-pipol
5385 if (x(2).gt.pi-delta) then
5389 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5391 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5392 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5394 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5395 & ddersc0(1),dersc(1))
5396 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5397 & ddersc0(3),dersc(3))
5399 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5401 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5402 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5403 & dersc0(2),esclocbi,dersc02)
5404 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5406 call splinthet(x(2),0.5d0*delta,ss,ssd)
5411 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5413 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5414 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5416 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5418 c write (iout,*) escloci
5419 else if (x(2).lt.delta) then
5423 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5425 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5426 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5428 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5429 & ddersc0(1),dersc(1))
5430 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5431 & ddersc0(3),dersc(3))
5433 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5435 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5436 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5437 & dersc0(2),esclocbi,dersc02)
5438 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5443 call splinthet(x(2),0.5d0*delta,ss,ssd)
5445 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5447 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5448 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5450 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5451 c write (iout,*) escloci
5453 call enesc(x,escloci,dersc,ddummy,.false.)
5456 escloc=escloc+escloci
5457 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5458 & 'escloc',i,escloci
5459 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5461 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5463 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5464 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5469 C---------------------------------------------------------------------------
5470 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5471 implicit real*8 (a-h,o-z)
5472 include 'DIMENSIONS'
5473 include 'COMMON.GEO'
5474 include 'COMMON.LOCAL'
5475 include 'COMMON.IOUNITS'
5476 common /sccalc/ time11,time12,time112,theti,it,nlobit
5477 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5478 double precision contr(maxlob,-1:1)
5480 c write (iout,*) 'it=',it,' nlobit=',nlobit
5484 if (mixed) ddersc(j)=0.0d0
5488 C Because of periodicity of the dependence of the SC energy in omega we have
5489 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5490 C To avoid underflows, first compute & store the exponents.
5498 z(k)=x(k)-censc(k,j,it)
5503 Axk=Axk+gaussc(l,k,j,it)*z(l)
5509 expfac=expfac+Ax(k,j,iii)*z(k)
5517 C As in the case of ebend, we want to avoid underflows in exponentiation and
5518 C subsequent NaNs and INFs in energy calculation.
5519 C Find the largest exponent
5523 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5527 cd print *,'it=',it,' emin=',emin
5529 C Compute the contribution to SC energy and derivatives
5534 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5535 if(adexp.ne.adexp) adexp=1.0
5538 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5540 cd print *,'j=',j,' expfac=',expfac
5541 escloc_i=escloc_i+expfac
5543 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5547 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5548 & +gaussc(k,2,j,it))*expfac
5555 dersc(1)=dersc(1)/cos(theti)**2
5556 ddersc(1)=ddersc(1)/cos(theti)**2
5559 escloci=-(dlog(escloc_i)-emin)
5561 dersc(j)=dersc(j)/escloc_i
5565 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5570 C------------------------------------------------------------------------------
5571 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5572 implicit real*8 (a-h,o-z)
5573 include 'DIMENSIONS'
5574 include 'COMMON.GEO'
5575 include 'COMMON.LOCAL'
5576 include 'COMMON.IOUNITS'
5577 common /sccalc/ time11,time12,time112,theti,it,nlobit
5578 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5579 double precision contr(maxlob)
5590 z(k)=x(k)-censc(k,j,it)
5596 Axk=Axk+gaussc(l,k,j,it)*z(l)
5602 expfac=expfac+Ax(k,j)*z(k)
5607 C As in the case of ebend, we want to avoid underflows in exponentiation and
5608 C subsequent NaNs and INFs in energy calculation.
5609 C Find the largest exponent
5612 if (emin.gt.contr(j)) emin=contr(j)
5616 C Compute the contribution to SC energy and derivatives
5620 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
5621 escloc_i=escloc_i+expfac
5623 dersc(k)=dersc(k)+Ax(k,j)*expfac
5625 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
5626 & +gaussc(1,2,j,it))*expfac
5630 dersc(1)=dersc(1)/cos(theti)**2
5631 dersc12=dersc12/cos(theti)**2
5632 escloci=-(dlog(escloc_i)-emin)
5634 dersc(j)=dersc(j)/escloc_i
5636 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
5640 c----------------------------------------------------------------------------------
5641 subroutine esc(escloc)
5642 C Calculate the local energy of a side chain and its derivatives in the
5643 C corresponding virtual-bond valence angles THETA and the spherical angles
5644 C ALPHA and OMEGA derived from AM1 all-atom calculations.
5645 C added by Urszula Kozlowska. 07/11/2007
5647 implicit real*8 (a-h,o-z)
5648 include 'DIMENSIONS'
5649 include 'COMMON.GEO'
5650 include 'COMMON.LOCAL'
5651 include 'COMMON.VAR'
5652 include 'COMMON.SCROT'
5653 include 'COMMON.INTERACT'
5654 include 'COMMON.DERIV'
5655 include 'COMMON.CHAIN'
5656 include 'COMMON.IOUNITS'
5657 include 'COMMON.NAMES'
5658 include 'COMMON.FFIELD'
5659 include 'COMMON.CONTROL'
5660 include 'COMMON.VECTORS'
5661 double precision x_prime(3),y_prime(3),z_prime(3)
5662 & , sumene,dsc_i,dp2_i,x(65),
5663 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
5664 & de_dxx,de_dyy,de_dzz,de_dt
5665 double precision s1_t,s1_6_t,s2_t,s2_6_t
5667 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
5668 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
5669 & dt_dCi(3),dt_dCi1(3)
5670 common /sccalc/ time11,time12,time112,theti,it,nlobit
5673 do i=loc_start,loc_end
5674 if (itype(i).eq.ntyp1) cycle
5675 costtab(i+1) =dcos(theta(i+1))
5676 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
5677 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
5678 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
5679 cosfac2=0.5d0/(1.0d0+costtab(i+1))
5680 cosfac=dsqrt(cosfac2)
5681 sinfac2=0.5d0/(1.0d0-costtab(i+1))
5682 sinfac=dsqrt(sinfac2)
5684 if (it.eq.10) goto 1
5686 C Compute the axes of tghe local cartesian coordinates system; store in
5687 c x_prime, y_prime and z_prime
5694 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
5695 C & dc_norm(3,i+nres)
5697 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
5698 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
5701 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
5704 c write (2,*) "x_prime",(x_prime(j),j=1,3)
5705 c write (2,*) "y_prime",(y_prime(j),j=1,3)
5706 c write (2,*) "z_prime",(z_prime(j),j=1,3)
5707 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
5708 c & " xy",scalar(x_prime(1),y_prime(1)),
5709 c & " xz",scalar(x_prime(1),z_prime(1)),
5710 c & " yy",scalar(y_prime(1),y_prime(1)),
5711 c & " yz",scalar(y_prime(1),z_prime(1)),
5712 c & " zz",scalar(z_prime(1),z_prime(1))
5714 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
5715 C to local coordinate system. Store in xx, yy, zz.
5721 xx = xx + x_prime(j)*dc_norm(j,i+nres)
5722 yy = yy + y_prime(j)*dc_norm(j,i+nres)
5723 zz = zz + z_prime(j)*dc_norm(j,i+nres)
5730 C Compute the energy of the ith side cbain
5732 c write (2,*) "xx",xx," yy",yy," zz",zz
5735 x(j) = sc_parmin(j,it)
5738 Cc diagnostics - remove later
5740 yy1 = dsin(alph(2))*dcos(omeg(2))
5741 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
5742 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
5743 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
5745 C," --- ", xx_w,yy_w,zz_w
5748 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5749 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5751 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5752 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5754 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5755 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5756 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5757 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5758 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5760 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5761 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5762 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5763 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5764 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5766 dsc_i = 0.743d0+x(61)
5768 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5769 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
5770 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5771 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
5772 s1=(1+x(63))/(0.1d0 + dscp1)
5773 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5774 s2=(1+x(65))/(0.1d0 + dscp2)
5775 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
5776 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
5777 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
5778 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
5780 c & dscp1,dscp2,sumene
5781 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5782 escloc = escloc + sumene
5783 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
5788 C This section to check the numerical derivatives of the energy of ith side
5789 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
5790 C #define DEBUG in the code to turn it on.
5792 write (2,*) "sumene =",sumene
5796 write (2,*) xx,yy,zz
5797 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5798 de_dxx_num=(sumenep-sumene)/aincr
5800 write (2,*) "xx+ sumene from enesc=",sumenep
5803 write (2,*) xx,yy,zz
5804 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5805 de_dyy_num=(sumenep-sumene)/aincr
5807 write (2,*) "yy+ sumene from enesc=",sumenep
5810 write (2,*) xx,yy,zz
5811 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5812 de_dzz_num=(sumenep-sumene)/aincr
5814 write (2,*) "zz+ sumene from enesc=",sumenep
5815 costsave=cost2tab(i+1)
5816 sintsave=sint2tab(i+1)
5817 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
5818 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
5819 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
5820 de_dt_num=(sumenep-sumene)/aincr
5821 write (2,*) " t+ sumene from enesc=",sumenep
5822 cost2tab(i+1)=costsave
5823 sint2tab(i+1)=sintsave
5824 C End of diagnostics section.
5827 C Compute the gradient of esc
5829 c zz=zz*dsign(1.0,dfloat(itype(i)))
5830 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
5831 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
5832 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
5833 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
5834 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
5835 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
5836 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
5837 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
5838 pom1=(sumene3*sint2tab(i+1)+sumene1)
5839 & *(pom_s1/dscp1+pom_s16*dscp1**4)
5840 pom2=(sumene4*cost2tab(i+1)+sumene2)
5841 & *(pom_s2/dscp2+pom_s26*dscp2**4)
5842 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
5843 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
5844 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
5846 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
5847 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
5848 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
5850 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
5851 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
5852 & +(pom1+pom2)*pom_dx
5854 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
5857 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
5858 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
5859 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
5861 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
5862 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
5863 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
5864 & +x(59)*zz**2 +x(60)*xx*zz
5865 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
5866 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
5867 & +(pom1-pom2)*pom_dy
5869 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
5872 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
5873 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
5874 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
5875 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
5876 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
5877 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
5878 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
5879 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
5881 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
5884 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
5885 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
5886 & +pom1*pom_dt1+pom2*pom_dt2
5888 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
5893 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
5894 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
5895 cosfac2xx=cosfac2*xx
5896 sinfac2yy=sinfac2*yy
5898 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
5900 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
5902 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
5903 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
5904 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
5905 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
5906 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
5907 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
5908 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
5909 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
5910 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
5911 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
5915 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
5916 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5917 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
5918 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
5921 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
5922 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
5923 dZZ_XYZ(k)=vbld_inv(i+nres)*
5924 & (z_prime(k)-zz*dC_norm(k,i+nres))
5926 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
5927 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
5931 dXX_Ctab(k,i)=dXX_Ci(k)
5932 dXX_C1tab(k,i)=dXX_Ci1(k)
5933 dYY_Ctab(k,i)=dYY_Ci(k)
5934 dYY_C1tab(k,i)=dYY_Ci1(k)
5935 dZZ_Ctab(k,i)=dZZ_Ci(k)
5936 dZZ_C1tab(k,i)=dZZ_Ci1(k)
5937 dXX_XYZtab(k,i)=dXX_XYZ(k)
5938 dYY_XYZtab(k,i)=dYY_XYZ(k)
5939 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
5943 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
5944 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
5945 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
5946 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
5947 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
5949 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
5950 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
5951 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
5952 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
5953 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
5954 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
5955 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
5956 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
5958 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
5959 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
5961 C to check gradient call subroutine check_grad
5967 c------------------------------------------------------------------------------
5968 double precision function enesc(x,xx,yy,zz,cost2,sint2)
5970 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
5971 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
5972 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
5973 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
5975 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
5976 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
5978 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
5979 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
5980 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
5981 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
5982 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
5984 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
5985 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
5986 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
5987 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
5988 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
5990 dsc_i = 0.743d0+x(61)
5992 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5993 & *(xx*cost2+yy*sint2))
5994 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
5995 & *(xx*cost2-yy*sint2))
5996 s1=(1+x(63))/(0.1d0 + dscp1)
5997 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
5998 s2=(1+x(65))/(0.1d0 + dscp2)
5999 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6000 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
6001 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
6006 c------------------------------------------------------------------------------
6007 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6009 C This procedure calculates two-body contact function g(rij) and its derivative:
6012 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6015 C where x=(rij-r0ij)/delta
6017 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6020 double precision rij,r0ij,eps0ij,fcont,fprimcont
6021 double precision x,x2,x4,delta
6025 if (x.lt.-1.0D0) then
6028 else if (x.le.1.0D0) then
6031 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6032 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6039 c------------------------------------------------------------------------------
6040 subroutine splinthet(theti,delta,ss,ssder)
6041 implicit real*8 (a-h,o-z)
6042 include 'DIMENSIONS'
6043 include 'COMMON.VAR'
6044 include 'COMMON.GEO'
6047 if (theti.gt.pipol) then
6048 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6050 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6055 c------------------------------------------------------------------------------
6056 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6058 double precision x,x0,delta,f0,f1,fprim0,f,fprim
6059 double precision ksi,ksi2,ksi3,a1,a2,a3
6060 a1=fprim0*delta/(f1-f0)
6066 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6067 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6070 c------------------------------------------------------------------------------
6071 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6073 double precision x,x0,delta,f0x,f1x,fprim0x,fx
6074 double precision ksi,ksi2,ksi3,a1,a2,a3
6079 a2=3*(f1x-f0x)-2*fprim0x*delta
6080 a3=fprim0x*delta-2*(f1x-f0x)
6081 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6084 C-----------------------------------------------------------------------------
6086 C-----------------------------------------------------------------------------
6087 subroutine etor(etors,edihcnstr)
6088 implicit real*8 (a-h,o-z)
6089 include 'DIMENSIONS'
6090 include 'COMMON.VAR'
6091 include 'COMMON.GEO'
6092 include 'COMMON.LOCAL'
6093 include 'COMMON.TORSION'
6094 include 'COMMON.INTERACT'
6095 include 'COMMON.DERIV'
6096 include 'COMMON.CHAIN'
6097 include 'COMMON.NAMES'
6098 include 'COMMON.IOUNITS'
6099 include 'COMMON.FFIELD'
6100 include 'COMMON.TORCNSTR'
6101 include 'COMMON.CONTROL'
6103 C Set lprn=.true. for debugging
6107 do i=iphi_start,iphi_end
6109 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6110 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6111 itori=itortyp(itype(i-2))
6112 itori1=itortyp(itype(i-1))
6115 C Proline-Proline pair is a special case...
6116 if (itori.eq.3 .and. itori1.eq.3) then
6117 if (phii.gt.-dwapi3) then
6119 fac=1.0D0/(1.0D0-cosphi)
6120 etorsi=v1(1,3,3)*fac
6121 etorsi=etorsi+etorsi
6122 etors=etors+etorsi-v1(1,3,3)
6123 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
6124 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6127 v1ij=v1(j+1,itori,itori1)
6128 v2ij=v2(j+1,itori,itori1)
6131 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6132 if (energy_dec) etors_ii=etors_ii+
6133 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6134 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6138 v1ij=v1(j,itori,itori1)
6139 v2ij=v2(j,itori,itori1)
6142 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6143 if (energy_dec) etors_ii=etors_ii+
6144 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6145 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6148 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6151 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6152 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6153 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6154 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6155 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6157 ! 6/20/98 - dihedral angle constraints
6160 itori=idih_constr(i)
6163 if (difi.gt.drange(i)) then
6165 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6166 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6167 else if (difi.lt.-drange(i)) then
6169 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6170 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6172 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6173 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6175 ! write (iout,*) 'edihcnstr',edihcnstr
6178 c------------------------------------------------------------------------------
6179 subroutine etor_d(etors_d)
6183 c----------------------------------------------------------------------------
6185 subroutine etor(etors,edihcnstr)
6186 implicit real*8 (a-h,o-z)
6187 include 'DIMENSIONS'
6188 include 'COMMON.VAR'
6189 include 'COMMON.GEO'
6190 include 'COMMON.LOCAL'
6191 include 'COMMON.TORSION'
6192 include 'COMMON.INTERACT'
6193 include 'COMMON.DERIV'
6194 include 'COMMON.CHAIN'
6195 include 'COMMON.NAMES'
6196 include 'COMMON.IOUNITS'
6197 include 'COMMON.FFIELD'
6198 include 'COMMON.TORCNSTR'
6199 include 'COMMON.CONTROL'
6201 C Set lprn=.true. for debugging
6205 do i=iphi_start,iphi_end
6206 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6207 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6208 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
6209 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
6210 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6211 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6212 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6213 C For introducing the NH3+ and COO- group please check the etor_d for reference
6216 if (iabs(itype(i)).eq.20) then
6221 itori=itortyp(itype(i-2))
6222 itori1=itortyp(itype(i-1))
6225 C Regular cosine and sine terms
6226 do j=1,nterm(itori,itori1,iblock)
6227 v1ij=v1(j,itori,itori1,iblock)
6228 v2ij=v2(j,itori,itori1,iblock)
6231 etors=etors+v1ij*cosphi+v2ij*sinphi
6232 if (energy_dec) etors_ii=etors_ii+
6233 & v1ij*cosphi+v2ij*sinphi
6234 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6238 C E = SUM ----------------------------------- - v1
6239 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6241 cosphi=dcos(0.5d0*phii)
6242 sinphi=dsin(0.5d0*phii)
6243 do j=1,nlor(itori,itori1,iblock)
6244 vl1ij=vlor1(j,itori,itori1)
6245 vl2ij=vlor2(j,itori,itori1)
6246 vl3ij=vlor3(j,itori,itori1)
6247 pom=vl2ij*cosphi+vl3ij*sinphi
6248 pom1=1.0d0/(pom*pom+1.0d0)
6249 etors=etors+vl1ij*pom1
6250 if (energy_dec) etors_ii=etors_ii+
6253 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6255 C Subtract the constant term
6256 etors=etors-v0(itori,itori1,iblock)
6257 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6258 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
6260 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6261 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6262 & (v1(j,itori,itori1,iblock),j=1,6),
6263 & (v2(j,itori,itori1,iblock),j=1,6)
6264 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6265 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6267 ! 6/20/98 - dihedral angle constraints
6269 c do i=1,ndih_constr
6270 do i=idihconstr_start,idihconstr_end
6271 itori=idih_constr(i)
6273 difi=pinorm(phii-phi0(i))
6274 if (difi.gt.drange(i)) then
6276 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6277 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6278 else if (difi.lt.-drange(i)) then
6280 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6281 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6285 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6286 cd & rad2deg*phi0(i), rad2deg*drange(i),
6287 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6289 cd write (iout,*) 'edihcnstr',edihcnstr
6292 c----------------------------------------------------------------------------
6293 subroutine etor_d(etors_d)
6294 C 6/23/01 Compute double torsional energy
6295 implicit real*8 (a-h,o-z)
6296 include 'DIMENSIONS'
6297 include 'COMMON.VAR'
6298 include 'COMMON.GEO'
6299 include 'COMMON.LOCAL'
6300 include 'COMMON.TORSION'
6301 include 'COMMON.INTERACT'
6302 include 'COMMON.DERIV'
6303 include 'COMMON.CHAIN'
6304 include 'COMMON.NAMES'
6305 include 'COMMON.IOUNITS'
6306 include 'COMMON.FFIELD'
6307 include 'COMMON.TORCNSTR'
6309 C Set lprn=.true. for debugging
6313 c write(iout,*) "a tu??"
6314 do i=iphid_start,iphid_end
6315 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6316 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6317 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
6318 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
6319 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
6320 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
6321 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
6322 & (itype(i+1).eq.ntyp1)) cycle
6323 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6324 itori=itortyp(itype(i-2))
6325 itori1=itortyp(itype(i-1))
6326 itori2=itortyp(itype(i))
6332 if (iabs(itype(i+1)).eq.20) iblock=2
6333 C Iblock=2 Proline type
6334 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
6335 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
6336 C if (itype(i+1).eq.ntyp1) iblock=3
6337 C The problem of NH3+ group can be resolved by adding new parameters please note if there
6338 C IS or IS NOT need for this
6339 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
6340 C is (itype(i-3).eq.ntyp1) ntblock=2
6341 C ntblock is N-terminal blocking group
6343 C Regular cosine and sine terms
6344 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6345 C Example of changes for NH3+ blocking group
6346 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
6347 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
6348 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6349 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6350 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6351 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6352 cosphi1=dcos(j*phii)
6353 sinphi1=dsin(j*phii)
6354 cosphi2=dcos(j*phii1)
6355 sinphi2=dsin(j*phii1)
6356 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6357 & v2cij*cosphi2+v2sij*sinphi2
6358 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6359 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6361 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6363 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6364 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6365 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6366 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6367 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6368 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6369 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6370 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6371 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6372 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6373 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6374 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6375 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6376 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6379 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6380 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6385 c------------------------------------------------------------------------------
6386 subroutine eback_sc_corr(esccor)
6387 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6388 c conformational states; temporarily implemented as differences
6389 c between UNRES torsional potentials (dependent on three types of
6390 c residues) and the torsional potentials dependent on all 20 types
6391 c of residues computed from AM1 energy surfaces of terminally-blocked
6392 c amino-acid residues.
6393 implicit real*8 (a-h,o-z)
6394 include 'DIMENSIONS'
6395 include 'COMMON.VAR'
6396 include 'COMMON.GEO'
6397 include 'COMMON.LOCAL'
6398 include 'COMMON.TORSION'
6399 include 'COMMON.SCCOR'
6400 include 'COMMON.INTERACT'
6401 include 'COMMON.DERIV'
6402 include 'COMMON.CHAIN'
6403 include 'COMMON.NAMES'
6404 include 'COMMON.IOUNITS'
6405 include 'COMMON.FFIELD'
6406 include 'COMMON.CONTROL'
6408 C Set lprn=.true. for debugging
6411 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
6413 do i=itau_start,itau_end
6414 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6416 isccori=isccortyp(itype(i-2))
6417 isccori1=isccortyp(itype(i-1))
6418 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
6420 do intertyp=1,3 !intertyp
6421 cc Added 09 May 2012 (Adasko)
6422 cc Intertyp means interaction type of backbone mainchain correlation:
6423 c 1 = SC...Ca...Ca...Ca
6424 c 2 = Ca...Ca...Ca...SC
6425 c 3 = SC...Ca...Ca...SCi
6427 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6428 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6429 & (itype(i-1).eq.ntyp1)))
6430 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6431 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6432 & .or.(itype(i).eq.ntyp1)))
6433 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6434 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6435 & (itype(i-3).eq.ntyp1)))) cycle
6436 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6437 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6439 do j=1,nterm_sccor(isccori,isccori1)
6440 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6441 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6442 cosphi=dcos(j*tauangle(intertyp,i))
6443 sinphi=dsin(j*tauangle(intertyp,i))
6444 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6445 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6447 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
6448 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6450 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6451 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
6452 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
6453 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
6454 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6460 c----------------------------------------------------------------------------
6461 subroutine multibody(ecorr)
6462 C This subroutine calculates multi-body contributions to energy following
6463 C the idea of Skolnick et al. If side chains I and J make a contact and
6464 C at the same time side chains I+1 and J+1 make a contact, an extra
6465 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6466 implicit real*8 (a-h,o-z)
6467 include 'DIMENSIONS'
6468 include 'COMMON.IOUNITS'
6469 include 'COMMON.DERIV'
6470 include 'COMMON.INTERACT'
6471 include 'COMMON.CONTACTS'
6472 double precision gx(3),gx1(3)
6475 C Set lprn=.true. for debugging
6479 write (iout,'(a)') 'Contact function values:'
6481 write (iout,'(i2,20(1x,i2,f10.5))')
6482 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6497 num_conti=num_cont(i)
6498 num_conti1=num_cont(i1)
6503 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6504 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6505 cd & ' ishift=',ishift
6506 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6507 C The system gains extra energy.
6508 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6509 endif ! j1==j+-ishift
6518 c------------------------------------------------------------------------------
6519 double precision function esccorr(i,j,k,l,jj,kk)
6520 implicit real*8 (a-h,o-z)
6521 include 'DIMENSIONS'
6522 include 'COMMON.IOUNITS'
6523 include 'COMMON.DERIV'
6524 include 'COMMON.INTERACT'
6525 include 'COMMON.CONTACTS'
6526 double precision gx(3),gx1(3)
6531 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6532 C Calculate the multi-body contribution to energy.
6533 C Calculate multi-body contributions to the gradient.
6534 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6535 cd & k,l,(gacont(m,kk,k),m=1,3)
6537 gx(m) =ekl*gacont(m,jj,i)
6538 gx1(m)=eij*gacont(m,kk,k)
6539 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6540 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6541 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6542 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6546 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6551 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6557 c------------------------------------------------------------------------------
6558 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6559 C This subroutine calculates multi-body contributions to hydrogen-bonding
6560 implicit real*8 (a-h,o-z)
6561 include 'DIMENSIONS'
6562 include 'COMMON.IOUNITS'
6565 parameter (max_cont=maxconts)
6566 parameter (max_dim=26)
6567 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6568 double precision zapas(max_dim,maxconts,max_fg_procs),
6569 & zapas_recv(max_dim,maxconts,max_fg_procs)
6570 common /przechowalnia/ zapas
6571 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6572 & status_array(MPI_STATUS_SIZE,maxconts*2)
6574 include 'COMMON.SETUP'
6575 include 'COMMON.FFIELD'
6576 include 'COMMON.DERIV'
6577 include 'COMMON.INTERACT'
6578 include 'COMMON.CONTACTS'
6579 include 'COMMON.CONTROL'
6580 include 'COMMON.LOCAL'
6581 double precision gx(3),gx1(3),time00
6584 C Set lprn=.true. for debugging
6589 if (nfgtasks.le.1) goto 30
6591 write (iout,'(a)') 'Contact function values before RECEIVE:'
6593 write (iout,'(2i3,50(1x,i2,f5.2))')
6594 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6595 & j=1,num_cont_hb(i))
6599 do i=1,ntask_cont_from
6602 do i=1,ntask_cont_to
6605 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6607 C Make the list of contacts to send to send to other procesors
6608 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
6610 do i=iturn3_start,iturn3_end
6611 c write (iout,*) "make contact list turn3",i," num_cont",
6613 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
6615 do i=iturn4_start,iturn4_end
6616 c write (iout,*) "make contact list turn4",i," num_cont",
6618 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
6622 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6624 do j=1,num_cont_hb(i)
6627 iproc=iint_sent_local(k,jjc,ii)
6628 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6629 if (iproc.gt.0) then
6630 ncont_sent(iproc)=ncont_sent(iproc)+1
6631 nn=ncont_sent(iproc)
6633 zapas(2,nn,iproc)=jjc
6634 zapas(3,nn,iproc)=facont_hb(j,i)
6635 zapas(4,nn,iproc)=ees0p(j,i)
6636 zapas(5,nn,iproc)=ees0m(j,i)
6637 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
6638 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
6639 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
6640 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
6641 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
6642 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
6643 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
6644 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
6645 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
6646 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
6647 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
6648 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
6649 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
6650 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
6651 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
6652 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
6653 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
6654 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
6655 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
6656 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
6657 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
6664 & "Numbers of contacts to be sent to other processors",
6665 & (ncont_sent(i),i=1,ntask_cont_to)
6666 write (iout,*) "Contacts sent"
6667 do ii=1,ntask_cont_to
6669 iproc=itask_cont_to(ii)
6670 write (iout,*) nn," contacts to processor",iproc,
6671 & " of CONT_TO_COMM group"
6673 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6681 CorrelID1=nfgtasks+fg_rank+1
6683 C Receive the numbers of needed contacts from other processors
6684 do ii=1,ntask_cont_from
6685 iproc=itask_cont_from(ii)
6687 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
6688 & FG_COMM,req(ireq),IERR)
6690 c write (iout,*) "IRECV ended"
6692 C Send the number of contacts needed by other processors
6693 do ii=1,ntask_cont_to
6694 iproc=itask_cont_to(ii)
6696 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
6697 & FG_COMM,req(ireq),IERR)
6699 c write (iout,*) "ISEND ended"
6700 c write (iout,*) "number of requests (nn)",ireq
6703 & call MPI_Waitall(ireq,req,status_array,ierr)
6705 c & "Numbers of contacts to be received from other processors",
6706 c & (ncont_recv(i),i=1,ntask_cont_from)
6710 do ii=1,ntask_cont_from
6711 iproc=itask_cont_from(ii)
6713 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
6714 c & " of CONT_TO_COMM group"
6718 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
6719 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6720 c write (iout,*) "ireq,req",ireq,req(ireq)
6723 C Send the contacts to processors that need them
6724 do ii=1,ntask_cont_to
6725 iproc=itask_cont_to(ii)
6727 c write (iout,*) nn," contacts to processor",iproc,
6728 c & " of CONT_TO_COMM group"
6731 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
6732 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
6733 c write (iout,*) "ireq,req",ireq,req(ireq)
6735 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
6739 c write (iout,*) "number of requests (contacts)",ireq
6740 c write (iout,*) "req",(req(i),i=1,4)
6743 & call MPI_Waitall(ireq,req,status_array,ierr)
6744 do iii=1,ntask_cont_from
6745 iproc=itask_cont_from(iii)
6748 write (iout,*) "Received",nn," contacts from processor",iproc,
6749 & " of CONT_FROM_COMM group"
6752 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
6757 ii=zapas_recv(1,i,iii)
6758 c Flag the received contacts to prevent double-counting
6759 jj=-zapas_recv(2,i,iii)
6760 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
6762 nnn=num_cont_hb(ii)+1
6765 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
6766 ees0p(nnn,ii)=zapas_recv(4,i,iii)
6767 ees0m(nnn,ii)=zapas_recv(5,i,iii)
6768 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
6769 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
6770 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
6771 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
6772 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
6773 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
6774 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
6775 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
6776 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
6777 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
6778 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
6779 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
6780 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
6781 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
6782 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
6783 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
6784 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
6785 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
6786 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
6787 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
6788 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
6793 write (iout,'(a)') 'Contact function values after receive:'
6795 write (iout,'(2i3,50(1x,i3,f5.2))')
6796 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6797 & j=1,num_cont_hb(i))
6804 write (iout,'(a)') 'Contact function values:'
6806 write (iout,'(2i3,50(1x,i3,f5.2))')
6807 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6808 & j=1,num_cont_hb(i))
6812 C Remove the loop below after debugging !!!
6819 C Calculate the local-electrostatic correlation terms
6820 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
6822 num_conti=num_cont_hb(i)
6823 num_conti1=num_cont_hb(i+1)
6830 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6831 c & ' jj=',jj,' kk=',kk
6832 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
6833 & .or. j.lt.0 .and. j1.gt.0) .and.
6834 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
6835 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
6836 C The system gains extra energy.
6837 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
6838 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
6839 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
6841 else if (j1.eq.j) then
6842 C Contacts I-J and I-(J+1) occur simultaneously.
6843 C The system loses extra energy.
6844 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
6849 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6850 c & ' jj=',jj,' kk=',kk
6852 C Contacts I-J and (I+1)-J occur simultaneously.
6853 C The system loses extra energy.
6854 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
6861 c------------------------------------------------------------------------------
6862 subroutine add_hb_contact(ii,jj,itask)
6863 implicit real*8 (a-h,o-z)
6864 include "DIMENSIONS"
6865 include "COMMON.IOUNITS"
6868 parameter (max_cont=maxconts)
6869 parameter (max_dim=26)
6870 include "COMMON.CONTACTS"
6871 double precision zapas(max_dim,maxconts,max_fg_procs),
6872 & zapas_recv(max_dim,maxconts,max_fg_procs)
6873 common /przechowalnia/ zapas
6874 integer i,j,ii,jj,iproc,itask(4),nn
6875 c write (iout,*) "itask",itask
6878 if (iproc.gt.0) then
6879 do j=1,num_cont_hb(ii)
6881 c write (iout,*) "i",ii," j",jj," jjc",jjc
6883 ncont_sent(iproc)=ncont_sent(iproc)+1
6884 nn=ncont_sent(iproc)
6885 zapas(1,nn,iproc)=ii
6886 zapas(2,nn,iproc)=jjc
6887 zapas(3,nn,iproc)=facont_hb(j,ii)
6888 zapas(4,nn,iproc)=ees0p(j,ii)
6889 zapas(5,nn,iproc)=ees0m(j,ii)
6890 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
6891 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
6892 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
6893 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
6894 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
6895 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
6896 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
6897 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
6898 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
6899 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
6900 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
6901 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
6902 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
6903 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
6904 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
6905 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
6906 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
6907 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
6908 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
6909 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
6910 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
6918 c------------------------------------------------------------------------------
6919 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
6921 C This subroutine calculates multi-body contributions to hydrogen-bonding
6922 implicit real*8 (a-h,o-z)
6923 include 'DIMENSIONS'
6924 include 'COMMON.IOUNITS'
6927 parameter (max_cont=maxconts)
6928 parameter (max_dim=70)
6929 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6930 double precision zapas(max_dim,maxconts,max_fg_procs),
6931 & zapas_recv(max_dim,maxconts,max_fg_procs)
6932 common /przechowalnia/ zapas
6933 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6934 & status_array(MPI_STATUS_SIZE,maxconts*2)
6936 include 'COMMON.SETUP'
6937 include 'COMMON.FFIELD'
6938 include 'COMMON.DERIV'
6939 include 'COMMON.LOCAL'
6940 include 'COMMON.INTERACT'
6941 include 'COMMON.CONTACTS'
6942 include 'COMMON.CHAIN'
6943 include 'COMMON.CONTROL'
6944 double precision gx(3),gx1(3)
6945 integer num_cont_hb_old(maxres)
6947 double precision eello4,eello5,eelo6,eello_turn6
6948 external eello4,eello5,eello6,eello_turn6
6949 C Set lprn=.true. for debugging
6954 num_cont_hb_old(i)=num_cont_hb(i)
6958 if (nfgtasks.le.1) goto 30
6960 write (iout,'(a)') 'Contact function values before RECEIVE:'
6962 write (iout,'(2i3,50(1x,i2,f5.2))')
6963 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
6964 & j=1,num_cont_hb(i))
6968 do i=1,ntask_cont_from
6971 do i=1,ntask_cont_to
6974 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
6976 C Make the list of contacts to send to send to other procesors
6977 do i=iturn3_start,iturn3_end
6978 c write (iout,*) "make contact list turn3",i," num_cont",
6980 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
6982 do i=iturn4_start,iturn4_end
6983 c write (iout,*) "make contact list turn4",i," num_cont",
6985 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
6989 c write (iout,*) "make contact list longrange",i,ii," num_cont",
6991 do j=1,num_cont_hb(i)
6994 iproc=iint_sent_local(k,jjc,ii)
6995 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
6996 if (iproc.ne.0) then
6997 ncont_sent(iproc)=ncont_sent(iproc)+1
6998 nn=ncont_sent(iproc)
7000 zapas(2,nn,iproc)=jjc
7001 zapas(3,nn,iproc)=d_cont(j,i)
7005 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
7010 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
7018 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
7029 & "Numbers of contacts to be sent to other processors",
7030 & (ncont_sent(i),i=1,ntask_cont_to)
7031 write (iout,*) "Contacts sent"
7032 do ii=1,ntask_cont_to
7034 iproc=itask_cont_to(ii)
7035 write (iout,*) nn," contacts to processor",iproc,
7036 & " of CONT_TO_COMM group"
7038 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7046 CorrelID1=nfgtasks+fg_rank+1
7048 C Receive the numbers of needed contacts from other processors
7049 do ii=1,ntask_cont_from
7050 iproc=itask_cont_from(ii)
7052 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7053 & FG_COMM,req(ireq),IERR)
7055 c write (iout,*) "IRECV ended"
7057 C Send the number of contacts needed by other processors
7058 do ii=1,ntask_cont_to
7059 iproc=itask_cont_to(ii)
7061 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7062 & FG_COMM,req(ireq),IERR)
7064 c write (iout,*) "ISEND ended"
7065 c write (iout,*) "number of requests (nn)",ireq
7068 & call MPI_Waitall(ireq,req,status_array,ierr)
7070 c & "Numbers of contacts to be received from other processors",
7071 c & (ncont_recv(i),i=1,ntask_cont_from)
7075 do ii=1,ntask_cont_from
7076 iproc=itask_cont_from(ii)
7078 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7079 c & " of CONT_TO_COMM group"
7083 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7084 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7085 c write (iout,*) "ireq,req",ireq,req(ireq)
7088 C Send the contacts to processors that need them
7089 do ii=1,ntask_cont_to
7090 iproc=itask_cont_to(ii)
7092 c write (iout,*) nn," contacts to processor",iproc,
7093 c & " of CONT_TO_COMM group"
7096 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7097 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7098 c write (iout,*) "ireq,req",ireq,req(ireq)
7100 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7104 c write (iout,*) "number of requests (contacts)",ireq
7105 c write (iout,*) "req",(req(i),i=1,4)
7108 & call MPI_Waitall(ireq,req,status_array,ierr)
7109 do iii=1,ntask_cont_from
7110 iproc=itask_cont_from(iii)
7113 write (iout,*) "Received",nn," contacts from processor",iproc,
7114 & " of CONT_FROM_COMM group"
7117 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7122 ii=zapas_recv(1,i,iii)
7123 c Flag the received contacts to prevent double-counting
7124 jj=-zapas_recv(2,i,iii)
7125 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7127 nnn=num_cont_hb(ii)+1
7130 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7134 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7139 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7147 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7156 write (iout,'(a)') 'Contact function values after receive:'
7158 write (iout,'(2i3,50(1x,i3,5f6.3))')
7159 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7160 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7167 write (iout,'(a)') 'Contact function values:'
7169 write (iout,'(2i3,50(1x,i2,5f6.3))')
7170 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7171 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7177 C Remove the loop below after debugging !!!
7184 C Calculate the dipole-dipole interaction energies
7185 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7186 do i=iatel_s,iatel_e+1
7187 num_conti=num_cont_hb(i)
7196 C Calculate the local-electrostatic correlation terms
7197 c write (iout,*) "gradcorr5 in eello5 before loop"
7199 c write (iout,'(i5,3f10.5)')
7200 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7202 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7203 c write (iout,*) "corr loop i",i
7205 num_conti=num_cont_hb(i)
7206 num_conti1=num_cont_hb(i+1)
7213 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7214 c & ' jj=',jj,' kk=',kk
7215 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7216 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7217 & .or. j.lt.0 .and. j1.gt.0) .and.
7218 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7219 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7220 C The system gains extra energy.
7222 sqd1=dsqrt(d_cont(jj,i))
7223 sqd2=dsqrt(d_cont(kk,i1))
7224 sred_geom = sqd1*sqd2
7225 IF (sred_geom.lt.cutoff_corr) THEN
7226 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7228 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7229 cd & ' jj=',jj,' kk=',kk
7230 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7231 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7233 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7234 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7237 cd write (iout,*) 'sred_geom=',sred_geom,
7238 cd & ' ekont=',ekont,' fprim=',fprimcont,
7239 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7240 cd write (iout,*) "g_contij",g_contij
7241 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7242 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7243 call calc_eello(i,jp,i+1,jp1,jj,kk)
7244 if (wcorr4.gt.0.0d0)
7245 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7246 if (energy_dec.and.wcorr4.gt.0.0d0)
7247 1 write (iout,'(a6,4i5,0pf7.3)')
7248 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7249 c write (iout,*) "gradcorr5 before eello5"
7251 c write (iout,'(i5,3f10.5)')
7252 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7254 if (wcorr5.gt.0.0d0)
7255 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7256 c write (iout,*) "gradcorr5 after eello5"
7258 c write (iout,'(i5,3f10.5)')
7259 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7261 if (energy_dec.and.wcorr5.gt.0.0d0)
7262 1 write (iout,'(a6,4i5,0pf7.3)')
7263 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7264 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7265 cd write(2,*)'ijkl',i,jp,i+1,jp1
7266 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7267 & .or. wturn6.eq.0.0d0))then
7268 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7269 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7270 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7271 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7272 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7273 cd & 'ecorr6=',ecorr6
7274 cd write (iout,'(4e15.5)') sred_geom,
7275 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7276 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7277 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7278 else if (wturn6.gt.0.0d0
7279 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7280 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7281 eturn6=eturn6+eello_turn6(i,jj,kk)
7282 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7283 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7284 cd write (2,*) 'multibody_eello:eturn6',eturn6
7293 num_cont_hb(i)=num_cont_hb_old(i)
7295 c write (iout,*) "gradcorr5 in eello5"
7297 c write (iout,'(i5,3f10.5)')
7298 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7302 c------------------------------------------------------------------------------
7303 subroutine add_hb_contact_eello(ii,jj,itask)
7304 implicit real*8 (a-h,o-z)
7305 include "DIMENSIONS"
7306 include "COMMON.IOUNITS"
7309 parameter (max_cont=maxconts)
7310 parameter (max_dim=70)
7311 include "COMMON.CONTACTS"
7312 double precision zapas(max_dim,maxconts,max_fg_procs),
7313 & zapas_recv(max_dim,maxconts,max_fg_procs)
7314 common /przechowalnia/ zapas
7315 integer i,j,ii,jj,iproc,itask(4),nn
7316 c write (iout,*) "itask",itask
7319 if (iproc.gt.0) then
7320 do j=1,num_cont_hb(ii)
7322 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7324 ncont_sent(iproc)=ncont_sent(iproc)+1
7325 nn=ncont_sent(iproc)
7326 zapas(1,nn,iproc)=ii
7327 zapas(2,nn,iproc)=jjc
7328 zapas(3,nn,iproc)=d_cont(j,ii)
7332 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7337 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7345 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7357 c------------------------------------------------------------------------------
7358 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7359 implicit real*8 (a-h,o-z)
7360 include 'DIMENSIONS'
7361 include 'COMMON.IOUNITS'
7362 include 'COMMON.DERIV'
7363 include 'COMMON.INTERACT'
7364 include 'COMMON.CONTACTS'
7365 double precision gx(3),gx1(3)
7375 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7376 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7377 C Following 4 lines for diagnostics.
7382 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7383 c & 'Contacts ',i,j,
7384 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7385 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7387 C Calculate the multi-body contribution to energy.
7388 c ecorr=ecorr+ekont*ees
7389 C Calculate multi-body contributions to the gradient.
7390 coeffpees0pij=coeffp*ees0pij
7391 coeffmees0mij=coeffm*ees0mij
7392 coeffpees0pkl=coeffp*ees0pkl
7393 coeffmees0mkl=coeffm*ees0mkl
7395 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7396 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7397 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7398 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7399 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7400 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7401 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7402 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7403 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7404 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7405 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7406 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7407 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7408 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7409 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7410 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7411 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7412 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7413 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7414 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7415 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7416 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7417 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7418 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7419 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7424 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7425 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7426 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7427 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7432 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7433 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7434 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7435 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7438 c write (iout,*) "ehbcorr",ekont*ees
7443 C---------------------------------------------------------------------------
7444 subroutine dipole(i,j,jj)
7445 implicit real*8 (a-h,o-z)
7446 include 'DIMENSIONS'
7447 include 'COMMON.IOUNITS'
7448 include 'COMMON.CHAIN'
7449 include 'COMMON.FFIELD'
7450 include 'COMMON.DERIV'
7451 include 'COMMON.INTERACT'
7452 include 'COMMON.CONTACTS'
7453 include 'COMMON.TORSION'
7454 include 'COMMON.VAR'
7455 include 'COMMON.GEO'
7456 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7458 iti1 = itortyp(itype(i+1))
7459 if (j.lt.nres-1) then
7460 itj1 = itortyp(itype(j+1))
7465 dipi(iii,1)=Ub2(iii,i)
7466 dipderi(iii)=Ub2der(iii,i)
7467 dipi(iii,2)=b1(iii,iti1)
7468 dipj(iii,1)=Ub2(iii,j)
7469 dipderj(iii)=Ub2der(iii,j)
7470 dipj(iii,2)=b1(iii,itj1)
7474 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7477 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7484 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7488 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7493 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7494 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7496 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7498 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7500 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7505 C---------------------------------------------------------------------------
7506 subroutine calc_eello(i,j,k,l,jj,kk)
7508 C This subroutine computes matrices and vectors needed to calculate
7509 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7511 implicit real*8 (a-h,o-z)
7512 include 'DIMENSIONS'
7513 include 'COMMON.IOUNITS'
7514 include 'COMMON.CHAIN'
7515 include 'COMMON.DERIV'
7516 include 'COMMON.INTERACT'
7517 include 'COMMON.CONTACTS'
7518 include 'COMMON.TORSION'
7519 include 'COMMON.VAR'
7520 include 'COMMON.GEO'
7521 include 'COMMON.FFIELD'
7522 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7523 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7526 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7527 cd & ' jj=',jj,' kk=',kk
7528 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7529 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7530 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7533 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7534 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7537 call transpose2(aa1(1,1),aa1t(1,1))
7538 call transpose2(aa2(1,1),aa2t(1,1))
7541 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7542 & aa1tder(1,1,lll,kkk))
7543 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7544 & aa2tder(1,1,lll,kkk))
7548 C parallel orientation of the two CA-CA-CA frames.
7550 iti=itortyp(itype(i))
7554 itk1=itortyp(itype(k+1))
7555 itj=itortyp(itype(j))
7556 if (l.lt.nres-1) then
7557 itl1=itortyp(itype(l+1))
7561 C A1 kernel(j+1) A2T
7563 cd write (iout,'(3f10.5,5x,3f10.5)')
7564 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7566 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7567 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7568 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7569 C Following matrices are needed only for 6-th order cumulants
7570 IF (wcorr6.gt.0.0d0) THEN
7571 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7572 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7573 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7574 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7575 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7576 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7577 & ADtEAderx(1,1,1,1,1,1))
7579 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7580 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
7581 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7582 & ADtEA1derx(1,1,1,1,1,1))
7584 C End 6-th order cumulants
7587 cd write (2,*) 'In calc_eello6'
7589 cd write (2,*) 'iii=',iii
7591 cd write (2,*) 'kkk=',kkk
7593 cd write (2,'(3(2f10.5),5x)')
7594 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
7599 call transpose2(EUgder(1,1,k),auxmat(1,1))
7600 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7601 call transpose2(EUg(1,1,k),auxmat(1,1))
7602 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7603 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7607 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7608 & EAEAderx(1,1,lll,kkk,iii,1))
7612 C A1T kernel(i+1) A2
7613 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7614 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
7615 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7616 C Following matrices are needed only for 6-th order cumulants
7617 IF (wcorr6.gt.0.0d0) THEN
7618 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7619 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
7620 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7621 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7622 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
7623 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7624 & ADtEAderx(1,1,1,1,1,2))
7625 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
7626 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
7627 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7628 & ADtEA1derx(1,1,1,1,1,2))
7630 C End 6-th order cumulants
7631 call transpose2(EUgder(1,1,l),auxmat(1,1))
7632 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
7633 call transpose2(EUg(1,1,l),auxmat(1,1))
7634 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7635 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7639 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7640 & EAEAderx(1,1,lll,kkk,iii,2))
7645 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7646 C They are needed only when the fifth- or the sixth-order cumulants are
7648 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
7649 call transpose2(AEA(1,1,1),auxmat(1,1))
7650 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7651 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7652 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7653 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7654 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7655 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7656 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7657 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7658 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7659 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7660 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7661 call transpose2(AEA(1,1,2),auxmat(1,1))
7662 call matvec2(auxmat(1,1),b1(1,itj),AEAb1(1,1,2))
7663 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
7664 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
7665 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7666 call matvec2(auxmat(1,1),b1(1,itj),AEAb1derg(1,1,2))
7667 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
7668 call matvec2(AEA(1,1,2),b1(1,itl1),AEAb1(1,2,2))
7669 call matvec2(AEAderg(1,1,2),b1(1,itl1),AEAb1derg(1,2,2))
7670 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
7671 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
7672 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
7673 C Calculate the Cartesian derivatives of the vectors.
7677 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7678 call matvec2(auxmat(1,1),b1(1,iti),
7679 & AEAb1derx(1,lll,kkk,iii,1,1))
7680 call matvec2(auxmat(1,1),Ub2(1,i),
7681 & AEAb2derx(1,lll,kkk,iii,1,1))
7682 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7683 & AEAb1derx(1,lll,kkk,iii,2,1))
7684 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7685 & AEAb2derx(1,lll,kkk,iii,2,1))
7686 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7687 call matvec2(auxmat(1,1),b1(1,itj),
7688 & AEAb1derx(1,lll,kkk,iii,1,2))
7689 call matvec2(auxmat(1,1),Ub2(1,j),
7690 & AEAb2derx(1,lll,kkk,iii,1,2))
7691 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
7692 & AEAb1derx(1,lll,kkk,iii,2,2))
7693 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
7694 & AEAb2derx(1,lll,kkk,iii,2,2))
7701 C Antiparallel orientation of the two CA-CA-CA frames.
7703 iti=itortyp(itype(i))
7707 itk1=itortyp(itype(k+1))
7708 itl=itortyp(itype(l))
7709 itj=itortyp(itype(j))
7710 if (j.lt.nres-1) then
7711 itj1=itortyp(itype(j+1))
7715 C A2 kernel(j-1)T A1T
7716 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7717 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
7718 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7719 C Following matrices are needed only for 6-th order cumulants
7720 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7721 & j.eq.i+4 .and. l.eq.i+3)) THEN
7722 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7723 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
7724 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7725 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7726 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
7727 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7728 & ADtEAderx(1,1,1,1,1,1))
7729 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7730 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
7731 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
7732 & ADtEA1derx(1,1,1,1,1,1))
7734 C End 6-th order cumulants
7735 call transpose2(EUgder(1,1,k),auxmat(1,1))
7736 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
7737 call transpose2(EUg(1,1,k),auxmat(1,1))
7738 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
7739 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
7743 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
7744 & EAEAderx(1,1,lll,kkk,iii,1))
7748 C A2T kernel(i+1)T A1
7749 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7750 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
7751 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
7752 C Following matrices are needed only for 6-th order cumulants
7753 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
7754 & j.eq.i+4 .and. l.eq.i+3)) THEN
7755 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7756 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
7757 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
7758 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7759 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
7760 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
7761 & ADtEAderx(1,1,1,1,1,2))
7762 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
7763 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
7764 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
7765 & ADtEA1derx(1,1,1,1,1,2))
7767 C End 6-th order cumulants
7768 call transpose2(EUgder(1,1,j),auxmat(1,1))
7769 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
7770 call transpose2(EUg(1,1,j),auxmat(1,1))
7771 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
7772 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
7776 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
7777 & EAEAderx(1,1,lll,kkk,iii,2))
7782 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
7783 C They are needed only when the fifth- or the sixth-order cumulants are
7785 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
7786 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
7787 call transpose2(AEA(1,1,1),auxmat(1,1))
7788 call matvec2(auxmat(1,1),b1(1,iti),AEAb1(1,1,1))
7789 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
7790 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
7791 call transpose2(AEAderg(1,1,1),auxmat(1,1))
7792 call matvec2(auxmat(1,1),b1(1,iti),AEAb1derg(1,1,1))
7793 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
7794 call matvec2(AEA(1,1,1),b1(1,itk1),AEAb1(1,2,1))
7795 call matvec2(AEAderg(1,1,1),b1(1,itk1),AEAb1derg(1,2,1))
7796 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
7797 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
7798 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
7799 call transpose2(AEA(1,1,2),auxmat(1,1))
7800 call matvec2(auxmat(1,1),b1(1,itj1),AEAb1(1,1,2))
7801 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
7802 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
7803 call transpose2(AEAderg(1,1,2),auxmat(1,1))
7804 call matvec2(auxmat(1,1),b1(1,itl),AEAb1(1,1,2))
7805 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
7806 call matvec2(AEA(1,1,2),b1(1,itj1),AEAb1(1,2,2))
7807 call matvec2(AEAderg(1,1,2),b1(1,itj1),AEAb1derg(1,2,2))
7808 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
7809 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
7810 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
7811 C Calculate the Cartesian derivatives of the vectors.
7815 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
7816 call matvec2(auxmat(1,1),b1(1,iti),
7817 & AEAb1derx(1,lll,kkk,iii,1,1))
7818 call matvec2(auxmat(1,1),Ub2(1,i),
7819 & AEAb2derx(1,lll,kkk,iii,1,1))
7820 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
7821 & AEAb1derx(1,lll,kkk,iii,2,1))
7822 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
7823 & AEAb2derx(1,lll,kkk,iii,2,1))
7824 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
7825 call matvec2(auxmat(1,1),b1(1,itl),
7826 & AEAb1derx(1,lll,kkk,iii,1,2))
7827 call matvec2(auxmat(1,1),Ub2(1,l),
7828 & AEAb2derx(1,lll,kkk,iii,1,2))
7829 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,itj1),
7830 & AEAb1derx(1,lll,kkk,iii,2,2))
7831 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
7832 & AEAb2derx(1,lll,kkk,iii,2,2))
7841 C---------------------------------------------------------------------------
7842 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
7843 & KK,KKderg,AKA,AKAderg,AKAderx)
7847 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
7848 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
7849 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
7854 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
7856 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
7859 cd if (lprn) write (2,*) 'In kernel'
7861 cd if (lprn) write (2,*) 'kkk=',kkk
7863 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
7864 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
7866 cd write (2,*) 'lll=',lll
7867 cd write (2,*) 'iii=1'
7869 cd write (2,'(3(2f10.5),5x)')
7870 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
7873 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
7874 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
7876 cd write (2,*) 'lll=',lll
7877 cd write (2,*) 'iii=2'
7879 cd write (2,'(3(2f10.5),5x)')
7880 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
7887 C---------------------------------------------------------------------------
7888 double precision function eello4(i,j,k,l,jj,kk)
7889 implicit real*8 (a-h,o-z)
7890 include 'DIMENSIONS'
7891 include 'COMMON.IOUNITS'
7892 include 'COMMON.CHAIN'
7893 include 'COMMON.DERIV'
7894 include 'COMMON.INTERACT'
7895 include 'COMMON.CONTACTS'
7896 include 'COMMON.TORSION'
7897 include 'COMMON.VAR'
7898 include 'COMMON.GEO'
7899 double precision pizda(2,2),ggg1(3),ggg2(3)
7900 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
7904 cd print *,'eello4:',i,j,k,l,jj,kk
7905 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
7906 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
7907 cold eij=facont_hb(jj,i)
7908 cold ekl=facont_hb(kk,k)
7910 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
7911 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
7912 gcorr_loc(k-1)=gcorr_loc(k-1)
7913 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
7915 gcorr_loc(l-1)=gcorr_loc(l-1)
7916 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7918 gcorr_loc(j-1)=gcorr_loc(j-1)
7919 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
7924 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
7925 & -EAEAderx(2,2,lll,kkk,iii,1)
7926 cd derx(lll,kkk,iii)=0.0d0
7930 cd gcorr_loc(l-1)=0.0d0
7931 cd gcorr_loc(j-1)=0.0d0
7932 cd gcorr_loc(k-1)=0.0d0
7934 cd write (iout,*)'Contacts have occurred for peptide groups',
7935 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
7936 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
7937 if (j.lt.nres-1) then
7944 if (l.lt.nres-1) then
7952 cgrad ggg1(ll)=eel4*g_contij(ll,1)
7953 cgrad ggg2(ll)=eel4*g_contij(ll,2)
7954 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
7955 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
7956 cgrad ghalf=0.5d0*ggg1(ll)
7957 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
7958 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
7959 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
7960 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
7961 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
7962 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
7963 cgrad ghalf=0.5d0*ggg2(ll)
7964 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
7965 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
7966 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
7967 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
7968 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
7969 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
7973 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
7978 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
7983 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
7988 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
7992 cd write (2,*) iii,gcorr_loc(iii)
7995 cd write (2,*) 'ekont',ekont
7996 cd write (iout,*) 'eello4',ekont*eel4
7999 C---------------------------------------------------------------------------
8000 double precision function eello5(i,j,k,l,jj,kk)
8001 implicit real*8 (a-h,o-z)
8002 include 'DIMENSIONS'
8003 include 'COMMON.IOUNITS'
8004 include 'COMMON.CHAIN'
8005 include 'COMMON.DERIV'
8006 include 'COMMON.INTERACT'
8007 include 'COMMON.CONTACTS'
8008 include 'COMMON.TORSION'
8009 include 'COMMON.VAR'
8010 include 'COMMON.GEO'
8011 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
8012 double precision ggg1(3),ggg2(3)
8013 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8018 C /l\ / \ \ / \ / \ / C
8019 C / \ / \ \ / \ / \ / C
8020 C j| o |l1 | o | o| o | | o |o C
8021 C \ |/k\| |/ \| / |/ \| |/ \| C
8022 C \i/ \ / \ / / \ / \ C
8024 C (I) (II) (III) (IV) C
8026 C eello5_1 eello5_2 eello5_3 eello5_4 C
8028 C Antiparallel chains C
8031 C /j\ / \ \ / \ / \ / C
8032 C / \ / \ \ / \ / \ / C
8033 C j1| o |l | o | o| o | | o |o C
8034 C \ |/k\| |/ \| / |/ \| |/ \| C
8035 C \i/ \ / \ / / \ / \ C
8037 C (I) (II) (III) (IV) C
8039 C eello5_1 eello5_2 eello5_3 eello5_4 C
8041 C o denotes a local interaction, vertical lines an electrostatic interaction. C
8043 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8044 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8049 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8051 itk=itortyp(itype(k))
8052 itl=itortyp(itype(l))
8053 itj=itortyp(itype(j))
8058 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8059 cd & eel5_3_num,eel5_4_num)
8063 derx(lll,kkk,iii)=0.0d0
8067 cd eij=facont_hb(jj,i)
8068 cd ekl=facont_hb(kk,k)
8070 cd write (iout,*)'Contacts have occurred for peptide groups',
8071 cd & i,j,' fcont:',eij,' eij',' and ',k,l
8073 C Contribution from the graph I.
8074 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8075 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8076 call transpose2(EUg(1,1,k),auxmat(1,1))
8077 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8078 vv(1)=pizda(1,1)-pizda(2,2)
8079 vv(2)=pizda(1,2)+pizda(2,1)
8080 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
8081 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8082 C Explicit gradient in virtual-dihedral angles.
8083 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
8084 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
8085 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8086 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8087 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8088 vv(1)=pizda(1,1)-pizda(2,2)
8089 vv(2)=pizda(1,2)+pizda(2,1)
8090 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8091 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
8092 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8093 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8094 vv(1)=pizda(1,1)-pizda(2,2)
8095 vv(2)=pizda(1,2)+pizda(2,1)
8097 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
8098 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8099 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8101 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
8102 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8103 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8105 C Cartesian gradient
8109 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
8111 vv(1)=pizda(1,1)-pizda(2,2)
8112 vv(2)=pizda(1,2)+pizda(2,1)
8113 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8114 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
8115 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8121 C Contribution from graph II
8122 call transpose2(EE(1,1,itk),auxmat(1,1))
8123 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8124 vv(1)=pizda(1,1)+pizda(2,2)
8125 vv(2)=pizda(2,1)-pizda(1,2)
8126 eello5_2=scalar2(AEAb1(1,2,1),b1(1,itk))
8127 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8128 C Explicit gradient in virtual-dihedral angles.
8129 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8130 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8131 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8132 vv(1)=pizda(1,1)+pizda(2,2)
8133 vv(2)=pizda(2,1)-pizda(1,2)
8135 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8136 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
8137 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8139 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8140 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,itk))
8141 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8143 C Cartesian gradient
8147 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8149 vv(1)=pizda(1,1)+pizda(2,2)
8150 vv(2)=pizda(2,1)-pizda(1,2)
8151 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8152 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,itk))
8153 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8161 C Parallel orientation
8162 C Contribution from graph III
8163 call transpose2(EUg(1,1,l),auxmat(1,1))
8164 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8165 vv(1)=pizda(1,1)-pizda(2,2)
8166 vv(2)=pizda(1,2)+pizda(2,1)
8167 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
8168 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8169 C Explicit gradient in virtual-dihedral angles.
8170 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8171 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
8172 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8173 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8174 vv(1)=pizda(1,1)-pizda(2,2)
8175 vv(2)=pizda(1,2)+pizda(2,1)
8176 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8177 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8178 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8179 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8180 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8181 vv(1)=pizda(1,1)-pizda(2,2)
8182 vv(2)=pizda(1,2)+pizda(2,1)
8183 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8184 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8185 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8186 C Cartesian gradient
8190 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8192 vv(1)=pizda(1,1)-pizda(2,2)
8193 vv(2)=pizda(1,2)+pizda(2,1)
8194 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8195 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8196 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8201 C Contribution from graph IV
8203 call transpose2(EE(1,1,itl),auxmat(1,1))
8204 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8205 vv(1)=pizda(1,1)+pizda(2,2)
8206 vv(2)=pizda(2,1)-pizda(1,2)
8207 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itl))
8208 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8209 C Explicit gradient in virtual-dihedral angles.
8210 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8211 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8212 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8213 vv(1)=pizda(1,1)+pizda(2,2)
8214 vv(2)=pizda(2,1)-pizda(1,2)
8215 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8216 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itl))
8217 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8218 C Cartesian gradient
8222 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8224 vv(1)=pizda(1,1)+pizda(2,2)
8225 vv(2)=pizda(2,1)-pizda(1,2)
8226 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8227 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itl))
8228 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8233 C Antiparallel orientation
8234 C Contribution from graph III
8236 call transpose2(EUg(1,1,j),auxmat(1,1))
8237 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8238 vv(1)=pizda(1,1)-pizda(2,2)
8239 vv(2)=pizda(1,2)+pizda(2,1)
8240 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8241 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8242 C Explicit gradient in virtual-dihedral angles.
8243 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8244 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8245 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8246 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8247 vv(1)=pizda(1,1)-pizda(2,2)
8248 vv(2)=pizda(1,2)+pizda(2,1)
8249 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8250 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
8251 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8252 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8253 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8254 vv(1)=pizda(1,1)-pizda(2,2)
8255 vv(2)=pizda(1,2)+pizda(2,1)
8256 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8257 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
8258 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8259 C Cartesian gradient
8263 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8265 vv(1)=pizda(1,1)-pizda(2,2)
8266 vv(2)=pizda(1,2)+pizda(2,1)
8267 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8268 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8269 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8274 C Contribution from graph IV
8276 call transpose2(EE(1,1,itj),auxmat(1,1))
8277 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8278 vv(1)=pizda(1,1)+pizda(2,2)
8279 vv(2)=pizda(2,1)-pizda(1,2)
8280 eello5_4=scalar2(AEAb1(1,2,2),b1(1,itj))
8281 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8282 C Explicit gradient in virtual-dihedral angles.
8283 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8284 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8285 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8286 vv(1)=pizda(1,1)+pizda(2,2)
8287 vv(2)=pizda(2,1)-pizda(1,2)
8288 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8289 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,itj))
8290 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8291 C Cartesian gradient
8295 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8297 vv(1)=pizda(1,1)+pizda(2,2)
8298 vv(2)=pizda(2,1)-pizda(1,2)
8299 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8300 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,itj))
8301 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8307 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8308 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8309 cd write (2,*) 'ijkl',i,j,k,l
8310 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8311 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8313 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8314 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8315 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8316 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8317 if (j.lt.nres-1) then
8324 if (l.lt.nres-1) then
8334 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8335 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8336 C summed up outside the subrouine as for the other subroutines
8337 C handling long-range interactions. The old code is commented out
8338 C with "cgrad" to keep track of changes.
8340 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8341 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8342 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8343 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8344 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8345 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8346 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8347 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8348 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8349 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8351 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8352 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8353 cgrad ghalf=0.5d0*ggg1(ll)
8355 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8356 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8357 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8358 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8359 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8360 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8361 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8362 cgrad ghalf=0.5d0*ggg2(ll)
8364 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8365 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8366 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8367 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8368 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8369 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8374 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8375 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8380 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8381 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8387 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8392 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8396 cd write (2,*) iii,g_corr5_loc(iii)
8399 cd write (2,*) 'ekont',ekont
8400 cd write (iout,*) 'eello5',ekont*eel5
8403 c--------------------------------------------------------------------------
8404 double precision function eello6(i,j,k,l,jj,kk)
8405 implicit real*8 (a-h,o-z)
8406 include 'DIMENSIONS'
8407 include 'COMMON.IOUNITS'
8408 include 'COMMON.CHAIN'
8409 include 'COMMON.DERIV'
8410 include 'COMMON.INTERACT'
8411 include 'COMMON.CONTACTS'
8412 include 'COMMON.TORSION'
8413 include 'COMMON.VAR'
8414 include 'COMMON.GEO'
8415 include 'COMMON.FFIELD'
8416 double precision ggg1(3),ggg2(3)
8417 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8422 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8430 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8431 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8435 derx(lll,kkk,iii)=0.0d0
8439 cd eij=facont_hb(jj,i)
8440 cd ekl=facont_hb(kk,k)
8446 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8447 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8448 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8449 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8450 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8451 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8453 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8454 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8455 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8456 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8457 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8458 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8462 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8464 C If turn contributions are considered, they will be handled separately.
8465 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8466 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8467 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8468 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8469 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8470 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8471 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8473 if (j.lt.nres-1) then
8480 if (l.lt.nres-1) then
8488 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8489 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8490 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8491 cgrad ghalf=0.5d0*ggg1(ll)
8493 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8494 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8495 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8496 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8497 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8498 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8499 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8500 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8501 cgrad ghalf=0.5d0*ggg2(ll)
8502 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8504 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8505 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8506 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8507 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8508 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8509 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8514 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8515 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8520 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8521 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8527 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8532 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8536 cd write (2,*) iii,g_corr6_loc(iii)
8539 cd write (2,*) 'ekont',ekont
8540 cd write (iout,*) 'eello6',ekont*eel6
8543 c--------------------------------------------------------------------------
8544 double precision function eello6_graph1(i,j,k,l,imat,swap)
8545 implicit real*8 (a-h,o-z)
8546 include 'DIMENSIONS'
8547 include 'COMMON.IOUNITS'
8548 include 'COMMON.CHAIN'
8549 include 'COMMON.DERIV'
8550 include 'COMMON.INTERACT'
8551 include 'COMMON.CONTACTS'
8552 include 'COMMON.TORSION'
8553 include 'COMMON.VAR'
8554 include 'COMMON.GEO'
8555 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8559 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8561 C Parallel Antiparallel C
8567 C \ j|/k\| / \ |/k\|l / C
8572 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8573 itk=itortyp(itype(k))
8574 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8575 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8576 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8577 call transpose2(EUgC(1,1,k),auxmat(1,1))
8578 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8579 vv1(1)=pizda1(1,1)-pizda1(2,2)
8580 vv1(2)=pizda1(1,2)+pizda1(2,1)
8581 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8582 vv(1)=AEAb1(1,2,imat)*b1(1,itk)-AEAb1(2,2,imat)*b1(2,itk)
8583 vv(2)=AEAb1(1,2,imat)*b1(2,itk)+AEAb1(2,2,imat)*b1(1,itk)
8584 s5=scalar2(vv(1),Dtobr2(1,i))
8585 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
8586 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
8587 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
8588 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
8589 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
8590 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
8591 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
8592 & +scalar2(vv(1),Dtobr2der(1,i)))
8593 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
8594 vv1(1)=pizda1(1,1)-pizda1(2,2)
8595 vv1(2)=pizda1(1,2)+pizda1(2,1)
8596 vv(1)=AEAb1derg(1,2,imat)*b1(1,itk)-AEAb1derg(2,2,imat)*b1(2,itk)
8597 vv(2)=AEAb1derg(1,2,imat)*b1(2,itk)+AEAb1derg(2,2,imat)*b1(1,itk)
8599 g_corr6_loc(l-1)=g_corr6_loc(l-1)
8600 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8601 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8602 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8603 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8605 g_corr6_loc(j-1)=g_corr6_loc(j-1)
8606 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
8607 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
8608 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
8609 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
8611 call transpose2(EUgCder(1,1,k),auxmat(1,1))
8612 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8613 vv1(1)=pizda1(1,1)-pizda1(2,2)
8614 vv1(2)=pizda1(1,2)+pizda1(2,1)
8615 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
8616 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
8617 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
8618 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
8627 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
8628 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
8629 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
8630 call transpose2(EUgC(1,1,k),auxmat(1,1))
8631 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
8633 vv1(1)=pizda1(1,1)-pizda1(2,2)
8634 vv1(2)=pizda1(1,2)+pizda1(2,1)
8635 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
8636 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,itk)
8637 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,itk)
8638 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,itk)
8639 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,itk)
8640 s5=scalar2(vv(1),Dtobr2(1,i))
8641 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
8647 c----------------------------------------------------------------------------
8648 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
8649 implicit real*8 (a-h,o-z)
8650 include 'DIMENSIONS'
8651 include 'COMMON.IOUNITS'
8652 include 'COMMON.CHAIN'
8653 include 'COMMON.DERIV'
8654 include 'COMMON.INTERACT'
8655 include 'COMMON.CONTACTS'
8656 include 'COMMON.TORSION'
8657 include 'COMMON.VAR'
8658 include 'COMMON.GEO'
8660 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8661 & auxvec1(2),auxvec2(2),auxmat1(2,2)
8664 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8666 C Parallel Antiparallel C
8672 C \ j|/k\| \ |/k\|l C
8677 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8678 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
8679 C AL 7/4/01 s1 would occur in the sixth-order moment,
8680 C but not in a cluster cumulant
8682 s1=dip(1,jj,i)*dip(1,kk,k)
8684 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
8685 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8686 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
8687 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
8688 call transpose2(EUg(1,1,k),auxmat(1,1))
8689 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
8690 vv(1)=pizda(1,1)-pizda(2,2)
8691 vv(2)=pizda(1,2)+pizda(2,1)
8692 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8693 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
8695 eello6_graph2=-(s1+s2+s3+s4)
8697 eello6_graph2=-(s2+s3+s4)
8700 C Derivatives in gamma(i-1)
8703 s1=dipderg(1,jj,i)*dip(1,kk,k)
8705 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
8706 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
8707 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8708 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
8710 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
8712 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
8714 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
8716 C Derivatives in gamma(k-1)
8718 s1=dip(1,jj,i)*dipderg(1,kk,k)
8720 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
8721 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8722 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
8723 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8724 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8725 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
8726 vv(1)=pizda(1,1)-pizda(2,2)
8727 vv(2)=pizda(1,2)+pizda(2,1)
8728 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8730 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
8732 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
8734 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
8735 C Derivatives in gamma(j-1) or gamma(l-1)
8738 s1=dipderg(3,jj,i)*dip(1,kk,k)
8740 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
8741 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8742 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
8743 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
8744 vv(1)=pizda(1,1)-pizda(2,2)
8745 vv(2)=pizda(1,2)+pizda(2,1)
8746 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8749 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8751 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8754 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
8755 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
8757 C Derivatives in gamma(l-1) or gamma(j-1)
8760 s1=dip(1,jj,i)*dipderg(3,kk,k)
8762 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
8763 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
8764 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
8765 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
8766 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
8767 vv(1)=pizda(1,1)-pizda(2,2)
8768 vv(2)=pizda(1,2)+pizda(2,1)
8769 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8772 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
8774 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
8777 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
8778 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
8780 C Cartesian derivatives.
8782 write (2,*) 'In eello6_graph2'
8784 write (2,*) 'iii=',iii
8786 write (2,*) 'kkk=',kkk
8788 write (2,'(3(2f10.5),5x)')
8789 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8799 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
8801 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
8804 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
8806 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
8807 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
8809 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
8810 call transpose2(EUg(1,1,k),auxmat(1,1))
8811 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
8813 vv(1)=pizda(1,1)-pizda(2,2)
8814 vv(2)=pizda(1,2)+pizda(2,1)
8815 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
8816 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
8818 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8820 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8823 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8825 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8832 c----------------------------------------------------------------------------
8833 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
8834 implicit real*8 (a-h,o-z)
8835 include 'DIMENSIONS'
8836 include 'COMMON.IOUNITS'
8837 include 'COMMON.CHAIN'
8838 include 'COMMON.DERIV'
8839 include 'COMMON.INTERACT'
8840 include 'COMMON.CONTACTS'
8841 include 'COMMON.TORSION'
8842 include 'COMMON.VAR'
8843 include 'COMMON.GEO'
8844 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
8846 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8848 C Parallel Antiparallel C
8854 C j|/k\| / |/k\|l / C
8859 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8861 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8862 C energy moment and not to the cluster cumulant.
8863 iti=itortyp(itype(i))
8864 if (j.lt.nres-1) then
8865 itj1=itortyp(itype(j+1))
8869 itk=itortyp(itype(k))
8870 itk1=itortyp(itype(k+1))
8871 if (l.lt.nres-1) then
8872 itl1=itortyp(itype(l+1))
8877 s1=dip(4,jj,i)*dip(4,kk,k)
8879 call matvec2(AECA(1,1,1),b1(1,itk1),auxvec(1))
8880 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8881 call matvec2(AECA(1,1,2),b1(1,itl1),auxvec(1))
8882 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8883 call transpose2(EE(1,1,itk),auxmat(1,1))
8884 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
8885 vv(1)=pizda(1,1)+pizda(2,2)
8886 vv(2)=pizda(2,1)-pizda(1,2)
8887 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8888 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
8889 cd & "sum",-(s2+s3+s4)
8891 eello6_graph3=-(s1+s2+s3+s4)
8893 eello6_graph3=-(s2+s3+s4)
8896 C Derivatives in gamma(k-1)
8897 call matvec2(AECAderg(1,1,2),b1(1,itl1),auxvec(1))
8898 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8899 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
8900 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
8901 C Derivatives in gamma(l-1)
8902 call matvec2(AECAderg(1,1,1),b1(1,itk1),auxvec(1))
8903 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8904 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
8905 vv(1)=pizda(1,1)+pizda(2,2)
8906 vv(2)=pizda(2,1)-pizda(1,2)
8907 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8908 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
8909 C Cartesian derivatives.
8915 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
8917 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
8920 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,itk1),
8922 s2=0.5d0*scalar2(b1(1,itk),auxvec(1))
8923 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,itl1),
8925 s3=0.5d0*scalar2(b1(1,itj1),auxvec(1))
8926 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
8928 vv(1)=pizda(1,1)+pizda(2,2)
8929 vv(2)=pizda(2,1)-pizda(1,2)
8930 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
8932 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
8934 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
8937 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
8939 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
8941 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
8947 c----------------------------------------------------------------------------
8948 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
8949 implicit real*8 (a-h,o-z)
8950 include 'DIMENSIONS'
8951 include 'COMMON.IOUNITS'
8952 include 'COMMON.CHAIN'
8953 include 'COMMON.DERIV'
8954 include 'COMMON.INTERACT'
8955 include 'COMMON.CONTACTS'
8956 include 'COMMON.TORSION'
8957 include 'COMMON.VAR'
8958 include 'COMMON.GEO'
8959 include 'COMMON.FFIELD'
8960 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
8961 & auxvec1(2),auxmat1(2,2)
8963 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8965 C Parallel Antiparallel C
8971 C \ j|/k\| \ |/k\|l C
8976 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8978 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
8979 C energy moment and not to the cluster cumulant.
8980 cd write (2,*) 'eello_graph4: wturn6',wturn6
8981 iti=itortyp(itype(i))
8982 itj=itortyp(itype(j))
8983 if (j.lt.nres-1) then
8984 itj1=itortyp(itype(j+1))
8988 itk=itortyp(itype(k))
8989 if (k.lt.nres-1) then
8990 itk1=itortyp(itype(k+1))
8994 itl=itortyp(itype(l))
8995 if (l.lt.nres-1) then
8996 itl1=itortyp(itype(l+1))
9000 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9001 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9002 cd & ' itl',itl,' itl1',itl1
9005 s1=dip(3,jj,i)*dip(3,kk,k)
9007 s1=dip(2,jj,j)*dip(2,kk,l)
9010 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9011 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9013 call matvec2(ADtEA1(1,1,3-imat),b1(1,itj1),auxvec1(1))
9014 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9016 call matvec2(ADtEA1(1,1,3-imat),b1(1,itl1),auxvec1(1))
9017 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9019 call transpose2(EUg(1,1,k),auxmat(1,1))
9020 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9021 vv(1)=pizda(1,1)-pizda(2,2)
9022 vv(2)=pizda(2,1)+pizda(1,2)
9023 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9024 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9026 eello6_graph4=-(s1+s2+s3+s4)
9028 eello6_graph4=-(s2+s3+s4)
9030 C Derivatives in gamma(i-1)
9034 s1=dipderg(2,jj,i)*dip(3,kk,k)
9036 s1=dipderg(4,jj,j)*dip(2,kk,l)
9039 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9041 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itj1),auxvec1(1))
9042 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9044 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,itl1),auxvec1(1))
9045 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9047 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9048 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9049 cd write (2,*) 'turn6 derivatives'
9051 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9053 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9057 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9059 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9063 C Derivatives in gamma(k-1)
9066 s1=dip(3,jj,i)*dipderg(2,kk,k)
9068 s1=dip(2,jj,j)*dipderg(4,kk,l)
9071 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9072 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9074 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itj1),auxvec1(1))
9075 s3=-0.5d0*scalar2(b1(1,itj),auxvec1(1))
9077 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,itl1),auxvec1(1))
9078 s3=-0.5d0*scalar2(b1(1,itl),auxvec1(1))
9080 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9081 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9082 vv(1)=pizda(1,1)-pizda(2,2)
9083 vv(2)=pizda(2,1)+pizda(1,2)
9084 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9085 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9087 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9089 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9093 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9095 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9098 C Derivatives in gamma(j-1) or gamma(l-1)
9099 if (l.eq.j+1 .and. l.gt.1) then
9100 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9101 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9102 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9103 vv(1)=pizda(1,1)-pizda(2,2)
9104 vv(2)=pizda(2,1)+pizda(1,2)
9105 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9106 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9107 else if (j.gt.1) then
9108 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9109 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9110 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9111 vv(1)=pizda(1,1)-pizda(2,2)
9112 vv(2)=pizda(2,1)+pizda(1,2)
9113 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9114 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9115 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9117 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9120 C Cartesian derivatives.
9127 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9129 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9133 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9135 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9139 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
9141 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9143 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9144 & b1(1,itj1),auxvec(1))
9145 s3=-0.5d0*scalar2(b1(1,itj),auxvec(1))
9147 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9148 & b1(1,itl1),auxvec(1))
9149 s3=-0.5d0*scalar2(b1(1,itl),auxvec(1))
9151 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9153 vv(1)=pizda(1,1)-pizda(2,2)
9154 vv(2)=pizda(2,1)+pizda(1,2)
9155 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9157 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9159 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9162 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9165 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9168 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9170 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9172 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9176 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9178 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9181 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9183 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9191 c----------------------------------------------------------------------------
9192 double precision function eello_turn6(i,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 vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9204 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9206 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9207 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9208 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9209 C the respective energy moment and not to the cluster cumulant.
9218 iti=itortyp(itype(i))
9219 itk=itortyp(itype(k))
9220 itk1=itortyp(itype(k+1))
9221 itl=itortyp(itype(l))
9222 itj=itortyp(itype(j))
9223 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9224 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9225 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9230 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9232 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
9236 derx_turn(lll,kkk,iii)=0.0d0
9243 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9245 cd write (2,*) 'eello6_5',eello6_5
9247 call transpose2(AEA(1,1,1),auxmat(1,1))
9248 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9249 ss1=scalar2(Ub2(1,i+2),b1(1,itl))
9250 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9252 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9253 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9254 s2 = scalar2(b1(1,itk),vtemp1(1))
9256 call transpose2(AEA(1,1,2),atemp(1,1))
9257 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9258 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
9259 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9261 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9262 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9263 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9265 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9266 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9267 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9268 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9269 ss13 = scalar2(b1(1,itk),vtemp4(1))
9270 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9272 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9278 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9279 C Derivatives in gamma(i+2)
9283 call transpose2(AEA(1,1,1),auxmatd(1,1))
9284 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9285 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9286 call transpose2(AEAderg(1,1,2),atempd(1,1))
9287 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9288 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9290 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9291 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9292 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9298 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9299 C Derivatives in gamma(i+3)
9301 call transpose2(AEA(1,1,1),auxmatd(1,1))
9302 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9303 ss1d=scalar2(Ub2der(1,i+2),b1(1,itl))
9304 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9306 call matvec2(EUgder(1,1,i+2),b1(1,itl),vtemp1d(1))
9307 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9308 s2d = scalar2(b1(1,itk),vtemp1d(1))
9310 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9311 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9313 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9315 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9316 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9317 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9325 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9326 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9328 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9329 & -0.5d0*ekont*(s2d+s12d)
9331 C Derivatives in gamma(i+4)
9332 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9333 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9334 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9336 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9337 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9338 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9346 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9348 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9350 C Derivatives in gamma(i+5)
9352 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9353 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9354 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9356 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1d(1))
9357 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9358 s2d = scalar2(b1(1,itk),vtemp1d(1))
9360 call transpose2(AEA(1,1,2),atempd(1,1))
9361 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9362 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9364 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9365 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9367 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9368 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9369 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9377 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9378 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9380 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9381 & -0.5d0*ekont*(s2d+s12d)
9383 C Cartesian derivatives
9388 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9389 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9390 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9392 call matvec2(EUg(1,1,i+2),b1(1,itl),vtemp1(1))
9393 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9395 s2d = scalar2(b1(1,itk),vtemp1d(1))
9397 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9398 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9399 s8d = -(atempd(1,1)+atempd(2,2))*
9400 & scalar2(cc(1,1,itl),vtemp2(1))
9402 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9404 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9405 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9412 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9415 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9419 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9420 & - 0.5d0*(s8d+s12d)
9422 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9431 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9433 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9434 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9435 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9436 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9437 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9439 ss13d = scalar2(b1(1,itk),vtemp4d(1))
9440 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9441 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9445 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9446 cd & 16*eel_turn6_num
9448 if (j.lt.nres-1) then
9455 if (l.lt.nres-1) then
9463 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9464 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9465 cgrad ghalf=0.5d0*ggg1(ll)
9467 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9468 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9469 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9470 & +ekont*derx_turn(ll,2,1)
9471 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9472 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9473 & +ekont*derx_turn(ll,4,1)
9474 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9475 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9476 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9477 cgrad ghalf=0.5d0*ggg2(ll)
9479 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9480 & +ekont*derx_turn(ll,2,2)
9481 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9482 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9483 & +ekont*derx_turn(ll,4,2)
9484 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9485 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9486 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9491 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9496 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9502 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9507 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9511 cd write (2,*) iii,g_corr6_loc(iii)
9513 eello_turn6=ekont*eel_turn6
9514 cd write (2,*) 'ekont',ekont
9515 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9519 C-----------------------------------------------------------------------------
9520 double precision function scalar(u,v)
9521 !DIR$ INLINEALWAYS scalar
9523 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9526 double precision u(3),v(3)
9527 cd double precision sc
9535 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9538 crc-------------------------------------------------
9539 SUBROUTINE MATVEC2(A1,V1,V2)
9540 !DIR$ INLINEALWAYS MATVEC2
9542 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9544 implicit real*8 (a-h,o-z)
9545 include 'DIMENSIONS'
9546 DIMENSION A1(2,2),V1(2),V2(2)
9550 c 3 VI=VI+A1(I,K)*V1(K)
9554 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9555 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9560 C---------------------------------------
9561 SUBROUTINE MATMAT2(A1,A2,A3)
9563 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9565 implicit real*8 (a-h,o-z)
9566 include 'DIMENSIONS'
9567 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9568 c DIMENSION AI3(2,2)
9572 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9578 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9579 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9580 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
9581 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
9589 c-------------------------------------------------------------------------
9590 double precision function scalar2(u,v)
9591 !DIR$ INLINEALWAYS scalar2
9593 double precision u(2),v(2)
9596 scalar2=u(1)*v(1)+u(2)*v(2)
9600 C-----------------------------------------------------------------------------
9602 subroutine transpose2(a,at)
9603 !DIR$ INLINEALWAYS transpose2
9605 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
9608 double precision a(2,2),at(2,2)
9615 c--------------------------------------------------------------------------
9616 subroutine transpose(n,a,at)
9619 double precision a(n,n),at(n,n)
9627 C---------------------------------------------------------------------------
9628 subroutine prodmat3(a1,a2,kk,transp,prod)
9629 !DIR$ INLINEALWAYS prodmat3
9631 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
9635 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
9637 crc double precision auxmat(2,2),prod_(2,2)
9640 crc call transpose2(kk(1,1),auxmat(1,1))
9641 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
9642 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9644 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
9645 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
9646 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
9647 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
9648 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
9649 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
9650 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
9651 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
9654 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
9655 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
9657 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
9658 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
9659 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
9660 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
9661 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
9662 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
9663 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
9664 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
9667 c call transpose2(a2(1,1),a2t(1,1))
9670 crc print *,((prod_(i,j),i=1,2),j=1,2)
9671 crc print *,((prod(i,j),i=1,2),j=1,2)
9675 CCC----------------------------------------------
9676 subroutine Eliptransfer(eliptran)
9677 include 'DIMENSIONS'
9678 include 'COMMON.GEO'
9679 include 'COMMON.VAR'
9680 include 'COMMON.LOCAL'
9681 include 'COMMON.CHAIN'
9682 include 'COMMON.DERIV'
9683 include 'COMMON.NAMES'
9684 include 'COMMON.INTERACT'
9685 include 'COMMON.IOUNITS'
9686 include 'COMMON.CALC'
9687 include 'COMMON.CONTROL'
9688 include 'COMMON.SPLITELE'
9689 include 'COMMON.SBRIDGE'
9692 C--bordliptop-- buffore starts
9693 C--bufliptop--- here true lipid starts
9695 C--buflipbot--- lipid ends buffore starts
9696 C--bordlipbot--buffore ends
9699 C first for peptide groups
9700 c for each residue check if it is in lipid or lipid water border area
9701 if ((mod(c(3,i),boxzsize).gt.bordlipbot)
9702 &.and.(mod(c(3,i),boxzsize).lt.bordliptop)) then
9703 C the energy transfer exist
9704 if (mod(c(3,i),boxzsize).lt.buflipbot) then
9705 C what fraction I am in
9707 & ((mod(c(3,i),boxzsize)-bordlipbot)/lipbufthick)
9708 C lipbufthick is thickenes of lipid buffore
9709 ssslip=sscale(fracinbuf)
9710 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
9711 eliptran=eliptran+sslip
9712 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran
9713 C print *,"doing sccale for lower part"
9714 elseif (mod(c(3,i),boxzsize).gt.bufliptop) then
9715 fracinbuf=1.0d0-((bordliptop-mod(c(3,i),boxzsize))/lipbufthick)
9716 ssslip=sscale(fracinbuf)
9717 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
9718 eliptran=eliptran+sslip
9719 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran
9720 print *, "doing sscalefor top part"
9722 eliptran=eliptran+1.0d0
9723 print *,"I am in true lipid"
9726 C eliptran=elpitran+0.0 ! I am in water
9729 C now multiply all by the peptide group transfer factor
9730 eliptran=eliptran*pepliptran
9731 C now the same for side chains
9733 c for each residue check if it is in lipid or lipid water border area
9734 if ((mod(c(3,i+nres),boxzsize).gt.bordlipbot)
9735 & .and.(mod(c(3,i+nres),boxzsize).lt.bordliptop)) then
9736 C the energy transfer exist
9737 if (mod(c(3,i+nres),boxzsize).lt.buflipbot) then
9739 & ((mod(c(3,i+nres),boxzsize)-bordlipbot)/lipbufthick)
9740 C lipbufthick is thickenes of lipid buffore
9741 ssslip=sscale(fracinbuf)
9742 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
9743 eliptran=eliptran+sslip*liptranene(itype(i))
9744 gliptranx(3,i)=gliptranx(3,i)+ssgradlip*liptranene(itype(i))
9745 print *,"doing sccale for lower part"
9746 elseif (mod(c(3,i+nres),boxzsize).gt.bufliptop) then
9748 &((bordliptop-mod(c(3,i+nres),boxzsize))/lipbufthick)
9749 ssslip=sscale(fracinbuf)
9750 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
9751 eliptran=eliptran+sslip*liptranene(itype(i))
9752 gliptranx(3,i)=gliptranx(3,i)+ssgradlip*liptranene(itype(i))
9753 print *, "doing sscalefor top part"
9755 eliptran=eliptran+liptranene(itype(i))
9756 print *,"I am in true lipid"
9759 C eliptran=elpitran+0.0 ! I am in water