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
103 goto (101,102,103,104,105,106) ipot
104 C Lennard-Jones potential.
106 cd print '(a)','Exit ELJ'
108 C Lennard-Jones-Kihara potential (shifted).
111 C Berne-Pechukas potential (dilated LJ, angular dependence).
114 C Gay-Berne potential (shifted LJ, angular dependence).
116 C print *,"bylem w egb"
118 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
121 C Soft-sphere potential
122 106 call e_softsphere(evdw)
124 C Calculate electrostatic (H-bonding) energy of the main chain.
128 cmc Sep-06: egb takes care of dynamic ss bonds too
130 c if (dyn_ss) call dyn_set_nss
132 c print *,"Processor",myrank," computed USCSC"
138 time_vec=time_vec+MPI_Wtime()-time01
140 C Introduction of shielding effect first for each peptide group
141 C the shielding factor is set this factor is describing how each
142 C peptide group is shielded by side-chains
143 C the matrix - shield_fac(i) the i index describe the ith between i and i+1
144 if (shield_mode.gt.0) then
147 c print *,"Processor",myrank," left VEC_AND_DERIV"
150 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
151 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
152 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
153 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
155 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
156 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
157 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
158 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
160 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
169 write (iout,*) "Soft-spheer ELEC potential"
170 c call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
173 c print *,"Processor",myrank," computed UELEC"
175 C Calculate excluded-volume interaction energy between peptide groups
180 call escp(evdw2,evdw2_14)
186 c write (iout,*) "Soft-sphere SCP potential"
187 call escp_soft_sphere(evdw2,evdw2_14)
190 c Calculate the bond-stretching energy
194 C Calculate the disulfide-bridge and other energy and the contributions
195 C from other distance constraints.
196 cd print *,'Calling EHPB'
198 cd print *,'EHPB exitted succesfully.'
200 C Calculate the virtual-bond-angle energy.
202 if (wang.gt.0d0) then
203 call ebend(ebe,ethetacnstr)
208 c print *,"Processor",myrank," computed UB"
210 C Calculate the SC local energy.
212 C print *,"TU DOCHODZE?"
214 c print *,"Processor",myrank," computed USC"
216 C Calculate the virtual-bond torsional energy.
218 cd print *,'nterm=',nterm
220 call etor(etors,edihcnstr)
225 c print *,"Processor",myrank," computed Utor"
227 C 6/23/01 Calculate double-torsional energy
229 if (wtor_d.gt.0) then
234 c print *,"Processor",myrank," computed Utord"
236 C 21/5/07 Calculate local sicdechain correlation energy
238 if (wsccor.gt.0.0d0) then
239 call eback_sc_corr(esccor)
243 C print *,"PRZED MULIt"
244 c print *,"Processor",myrank," computed Usccorr"
246 C 12/1/95 Multi-body terms
250 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
251 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
252 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
253 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
254 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
261 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
262 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
263 cd write (iout,*) "multibody_hb ecorr",ecorr
265 c print *,"Processor",myrank," computed Ucorr"
267 C If performing constraint dynamics, call the constraint energy
268 C after the equilibration time
269 if(usampl.and.totT.gt.eq_time) then
276 C 01/27/2015 added by adasko
277 C the energy component below is energy transfer into lipid environment
278 C based on partition function
279 C print *,"przed lipidami"
280 if (wliptran.gt.0) then
281 call Eliptransfer(eliptran)
283 C print *,"za lipidami"
284 if (AFMlog.gt.0) then
285 call AFMforce(Eafmforce)
286 else if (selfguide.gt.0) then
287 call AFMvel(Eafmforce)
290 time_enecalc=time_enecalc+MPI_Wtime()-time00
292 c print *,"Processor",myrank," computed Uconstr"
301 energia(2)=evdw2-evdw2_14
318 energia(8)=eello_turn3
319 energia(9)=eello_turn4
326 energia(19)=edihcnstr
328 energia(20)=Uconst+Uconst_back
331 energia(23)=Eafmforce
332 energia(24)=ethetacnstr
333 c Here are the energies showed per procesor if the are more processors
334 c per molecule then we sum it up in sum_energy subroutine
335 c print *," Processor",myrank," calls SUM_ENERGY"
336 call sum_energy(energia,.true.)
337 if (dyn_ss) call dyn_set_nss
338 c print *," Processor",myrank," left SUM_ENERGY"
340 time_sumene=time_sumene+MPI_Wtime()-time00
344 c-------------------------------------------------------------------------------
345 subroutine sum_energy(energia,reduce)
346 implicit real*8 (a-h,o-z)
351 cMS$ATTRIBUTES C :: proc_proc
357 include 'COMMON.SETUP'
358 include 'COMMON.IOUNITS'
359 double precision energia(0:n_ene),enebuff(0:n_ene+1)
360 include 'COMMON.FFIELD'
361 include 'COMMON.DERIV'
362 include 'COMMON.INTERACT'
363 include 'COMMON.SBRIDGE'
364 include 'COMMON.CHAIN'
366 include 'COMMON.CONTROL'
367 include 'COMMON.TIME1'
370 if (nfgtasks.gt.1 .and. reduce) then
372 write (iout,*) "energies before REDUCE"
373 call enerprint(energia)
377 enebuff(i)=energia(i)
380 call MPI_Barrier(FG_COMM,IERR)
381 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
383 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
384 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
386 write (iout,*) "energies after REDUCE"
387 call enerprint(energia)
390 time_Reduce=time_Reduce+MPI_Wtime()-time00
392 if (fg_rank.eq.0) then
396 evdw2=energia(2)+energia(18)
412 eello_turn3=energia(8)
413 eello_turn4=energia(9)
420 edihcnstr=energia(19)
425 Eafmforce=energia(23)
426 ethetacnstr=energia(24)
428 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
429 & +wang*ebe+wtor*etors+wscloc*escloc
430 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
431 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
432 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
433 & +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+Eafmforce
436 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
437 & +wang*ebe+wtor*etors+wscloc*escloc
438 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
439 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
440 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
441 & +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran
449 if (isnan(etot).ne.0) energia(0)=1.0d+99
451 if (isnan(etot)) energia(0)=1.0d+99
456 idumm=proc_proc(etot,i)
458 call proc_proc(etot,i)
460 if(i.eq.1)energia(0)=1.0d+99
467 c-------------------------------------------------------------------------------
468 subroutine sum_gradient
469 implicit real*8 (a-h,o-z)
474 cMS$ATTRIBUTES C :: proc_proc
480 double precision gradbufc(3,-1:maxres),gradbufx(3,-1:maxres),
481 & glocbuf(4*maxres),gradbufc_sum(3,-1:maxres)
482 & ,gloc_scbuf(3,-1:maxres)
483 include 'COMMON.SETUP'
484 include 'COMMON.IOUNITS'
485 include 'COMMON.FFIELD'
486 include 'COMMON.DERIV'
487 include 'COMMON.INTERACT'
488 include 'COMMON.SBRIDGE'
489 include 'COMMON.CHAIN'
491 include 'COMMON.CONTROL'
492 include 'COMMON.TIME1'
493 include 'COMMON.MAXGRAD'
494 include 'COMMON.SCCOR'
499 write (iout,*) "sum_gradient gvdwc, gvdwx"
501 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
502 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
507 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
508 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
509 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
512 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
513 C in virtual-bond-vector coordinates
516 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
518 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
519 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
521 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
523 c write (iout,'(i5,3f10.5,2x,f10.5)')
524 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
526 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
528 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
529 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
537 gradbufc(j,i)=wsc*gvdwc(j,i)+
538 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
539 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
540 & wel_loc*gel_loc_long(j,i)+
541 & wcorr*gradcorr_long(j,i)+
542 & wcorr5*gradcorr5_long(j,i)+
543 & wcorr6*gradcorr6_long(j,i)+
544 & wturn6*gcorr6_turn_long(j,i)+
546 & +wliptran*gliptranc(j,i)
554 gradbufc(j,i)=wsc*gvdwc(j,i)+
555 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
556 & welec*gelc_long(j,i)+
558 & wel_loc*gel_loc_long(j,i)+
559 & wcorr*gradcorr_long(j,i)+
560 & wcorr5*gradcorr5_long(j,i)+
561 & wcorr6*gradcorr6_long(j,i)+
562 & wturn6*gcorr6_turn_long(j,i)+
564 & +wliptran*gliptranc(j,i)
571 if (nfgtasks.gt.1) then
574 write (iout,*) "gradbufc before allreduce"
576 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
582 gradbufc_sum(j,i)=gradbufc(j,i)
585 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
586 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
587 c time_reduce=time_reduce+MPI_Wtime()-time00
589 c write (iout,*) "gradbufc_sum after allreduce"
591 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
596 c time_allreduce=time_allreduce+MPI_Wtime()-time00
604 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
605 write (iout,*) (i," jgrad_start",jgrad_start(i),
606 & " jgrad_end ",jgrad_end(i),
607 & i=igrad_start,igrad_end)
610 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
611 c do not parallelize this part.
613 c do i=igrad_start,igrad_end
614 c do j=jgrad_start(i),jgrad_end(i)
616 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
621 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
625 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
629 write (iout,*) "gradbufc after summing"
631 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
638 write (iout,*) "gradbufc"
640 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
646 gradbufc_sum(j,i)=gradbufc(j,i)
651 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
655 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
660 c gradbufc(k,i)=0.0d0
664 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
669 write (iout,*) "gradbufc after summing"
671 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
679 gradbufc(k,nres)=0.0d0
684 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
685 & wel_loc*gel_loc(j,i)+
686 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
687 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
688 & wel_loc*gel_loc_long(j,i)+
689 & wcorr*gradcorr_long(j,i)+
690 & wcorr5*gradcorr5_long(j,i)+
691 & wcorr6*gradcorr6_long(j,i)+
692 & wturn6*gcorr6_turn_long(j,i))+
694 & wcorr*gradcorr(j,i)+
695 & wturn3*gcorr3_turn(j,i)+
696 & wturn4*gcorr4_turn(j,i)+
697 & wcorr5*gradcorr5(j,i)+
698 & wcorr6*gradcorr6(j,i)+
699 & wturn6*gcorr6_turn(j,i)+
700 & wsccor*gsccorc(j,i)
701 & +wscloc*gscloc(j,i)
702 & +wliptran*gliptranc(j,i)
705 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
706 & wel_loc*gel_loc(j,i)+
707 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
708 & welec*gelc_long(j,i)
709 & wel_loc*gel_loc_long(j,i)+
710 & wcorr*gcorr_long(j,i)+
711 & wcorr5*gradcorr5_long(j,i)+
712 & wcorr6*gradcorr6_long(j,i)+
713 & wturn6*gcorr6_turn_long(j,i))+
715 & wcorr*gradcorr(j,i)+
716 & wturn3*gcorr3_turn(j,i)+
717 & wturn4*gcorr4_turn(j,i)+
718 & wcorr5*gradcorr5(j,i)+
719 & wcorr6*gradcorr6(j,i)+
720 & wturn6*gcorr6_turn(j,i)+
721 & wsccor*gsccorc(j,i)
722 & +wscloc*gscloc(j,i)
723 & +wliptran*gliptranc(j,i)
727 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
729 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
730 & wsccor*gsccorx(j,i)
731 & +wscloc*gsclocx(j,i)
732 & +wliptran*gliptranx(j,i)
736 write (iout,*) "gloc before adding corr"
738 write (iout,*) i,gloc(i,icg)
742 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
743 & +wcorr5*g_corr5_loc(i)
744 & +wcorr6*g_corr6_loc(i)
745 & +wturn4*gel_loc_turn4(i)
746 & +wturn3*gel_loc_turn3(i)
747 & +wturn6*gel_loc_turn6(i)
748 & +wel_loc*gel_loc_loc(i)
751 write (iout,*) "gloc after adding corr"
753 write (iout,*) i,gloc(i,icg)
757 if (nfgtasks.gt.1) then
760 gradbufc(j,i)=gradc(j,i,icg)
761 gradbufx(j,i)=gradx(j,i,icg)
765 glocbuf(i)=gloc(i,icg)
769 write (iout,*) "gloc_sc before reduce"
772 write (iout,*) i,j,gloc_sc(j,i,icg)
779 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
783 call MPI_Barrier(FG_COMM,IERR)
784 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
786 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
787 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
788 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
789 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
790 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
791 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
792 time_reduce=time_reduce+MPI_Wtime()-time00
793 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
794 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
795 time_reduce=time_reduce+MPI_Wtime()-time00
798 write (iout,*) "gloc_sc after reduce"
801 write (iout,*) i,j,gloc_sc(j,i,icg)
807 write (iout,*) "gloc after reduce"
809 write (iout,*) i,gloc(i,icg)
814 if (gnorm_check) then
816 c Compute the maximum elements of the gradient
826 gcorr3_turn_max=0.0d0
827 gcorr4_turn_max=0.0d0
830 gcorr6_turn_max=0.0d0
840 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
841 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
842 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
843 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
844 & gvdwc_scp_max=gvdwc_scp_norm
845 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
846 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
847 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
848 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
849 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
850 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
851 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
852 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
853 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
854 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
855 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
856 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
857 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
859 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
860 & gcorr3_turn_max=gcorr3_turn_norm
861 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
863 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
864 & gcorr4_turn_max=gcorr4_turn_norm
865 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
866 if (gradcorr5_norm.gt.gradcorr5_max)
867 & gradcorr5_max=gradcorr5_norm
868 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
869 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
870 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
872 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
873 & gcorr6_turn_max=gcorr6_turn_norm
874 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
875 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
876 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
877 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
878 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
879 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
880 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
881 if (gradx_scp_norm.gt.gradx_scp_max)
882 & gradx_scp_max=gradx_scp_norm
883 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
884 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
885 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
886 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
887 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
888 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
889 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
890 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
894 open(istat,file=statname,position="append")
896 open(istat,file=statname,access="append")
898 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
899 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
900 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
901 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
902 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
903 & gsccorx_max,gsclocx_max
905 if (gvdwc_max.gt.1.0d4) then
906 write (iout,*) "gvdwc gvdwx gradb gradbx"
908 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
909 & gradb(j,i),gradbx(j,i),j=1,3)
911 call pdbout(0.0d0,'cipiszcze',iout)
917 write (iout,*) "gradc gradx gloc"
919 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
920 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
924 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
928 c-------------------------------------------------------------------------------
929 subroutine rescale_weights(t_bath)
930 implicit real*8 (a-h,o-z)
932 include 'COMMON.IOUNITS'
933 include 'COMMON.FFIELD'
934 include 'COMMON.SBRIDGE'
935 double precision kfac /2.4d0/
936 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
938 c facT=2*temp0/(t_bath+temp0)
939 if (rescale_mode.eq.0) then
945 else if (rescale_mode.eq.1) then
946 facT=kfac/(kfac-1.0d0+t_bath/temp0)
947 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
948 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
949 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
950 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
951 else if (rescale_mode.eq.2) then
957 facT=licznik/dlog(dexp(x)+dexp(-x))
958 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
959 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
960 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
961 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
963 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
964 write (*,*) "Wrong RESCALE_MODE",rescale_mode
966 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
970 welec=weights(3)*fact
971 wcorr=weights(4)*fact3
972 wcorr5=weights(5)*fact4
973 wcorr6=weights(6)*fact5
974 wel_loc=weights(7)*fact2
975 wturn3=weights(8)*fact2
976 wturn4=weights(9)*fact3
977 wturn6=weights(10)*fact5
978 wtor=weights(13)*fact
979 wtor_d=weights(14)*fact2
980 wsccor=weights(21)*fact
984 C------------------------------------------------------------------------
985 subroutine enerprint(energia)
986 implicit real*8 (a-h,o-z)
988 include 'COMMON.IOUNITS'
989 include 'COMMON.FFIELD'
990 include 'COMMON.SBRIDGE'
992 double precision energia(0:n_ene)
997 evdw2=energia(2)+energia(18)
1009 eello_turn3=energia(8)
1010 eello_turn4=energia(9)
1011 eello_turn6=energia(10)
1017 edihcnstr=energia(19)
1021 eliptran=energia(22)
1022 Eafmforce=energia(23)
1023 ethetacnstr=energia(24)
1025 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
1026 & estr,wbond,ebe,wang,
1027 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1029 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1030 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1031 & ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforc,
1033 10 format (/'Virtual-chain energies:'//
1034 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1035 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1036 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1037 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
1038 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1039 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1040 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1041 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1042 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1043 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1044 & ' (SS bridges & dist. cnstr.)'/
1045 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1046 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1047 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1048 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1049 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1050 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1051 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1052 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1053 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1054 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
1055 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1056 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1057 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
1058 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
1059 & 'ETOT= ',1pE16.6,' (total)')
1062 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1063 & estr,wbond,ebe,wang,
1064 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1066 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1067 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1068 & ethetacnstr,ebr*nss,Uconst,eliptran,wliptran,Eafmforc,
1070 10 format (/'Virtual-chain energies:'//
1071 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1072 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1073 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1074 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1075 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1076 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1077 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1078 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1079 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1080 & ' (SS bridges & dist. cnstr.)'/
1081 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1082 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1083 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1084 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1085 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1086 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1087 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1088 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1089 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1090 & 'ETHETC= ',1pE16.6,' (valence angle constraints)'/
1091 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1092 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1093 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
1094 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
1095 & 'ETOT= ',1pE16.6,' (total)')
1099 C-----------------------------------------------------------------------
1100 subroutine elj(evdw)
1102 C This subroutine calculates the interaction energy of nonbonded side chains
1103 C assuming the LJ potential of interaction.
1105 implicit real*8 (a-h,o-z)
1106 include 'DIMENSIONS'
1107 parameter (accur=1.0d-10)
1108 include 'COMMON.GEO'
1109 include 'COMMON.VAR'
1110 include 'COMMON.LOCAL'
1111 include 'COMMON.CHAIN'
1112 include 'COMMON.DERIV'
1113 include 'COMMON.INTERACT'
1114 include 'COMMON.TORSION'
1115 include 'COMMON.SBRIDGE'
1116 include 'COMMON.NAMES'
1117 include 'COMMON.IOUNITS'
1118 include 'COMMON.CONTACTS'
1120 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1122 do i=iatsc_s,iatsc_e
1123 itypi=iabs(itype(i))
1124 if (itypi.eq.ntyp1) cycle
1125 itypi1=iabs(itype(i+1))
1132 C Calculate SC interaction energy.
1134 do iint=1,nint_gr(i)
1135 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1136 cd & 'iend=',iend(i,iint)
1137 do j=istart(i,iint),iend(i,iint)
1138 itypj=iabs(itype(j))
1139 if (itypj.eq.ntyp1) cycle
1143 C Change 12/1/95 to calculate four-body interactions
1144 rij=xj*xj+yj*yj+zj*zj
1146 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1147 eps0ij=eps(itypi,itypj)
1149 C have you changed here?
1153 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1154 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1155 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1156 cd & restyp(itypi),i,restyp(itypj),j,a(itypi,itypj),
1157 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1158 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1161 C Calculate the components of the gradient in DC and X
1163 fac=-rrij*(e1+evdwij)
1168 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1169 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1170 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1171 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1175 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1179 C 12/1/95, revised on 5/20/97
1181 C Calculate the contact function. The ith column of the array JCONT will
1182 C contain the numbers of atoms that make contacts with the atom I (of numbers
1183 C greater than I). The arrays FACONT and GACONT will contain the values of
1184 C the contact function and its derivative.
1186 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1187 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1188 C Uncomment next line, if the correlation interactions are contact function only
1189 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1191 sigij=sigma(itypi,itypj)
1192 r0ij=rs0(itypi,itypj)
1194 C Check whether the SC's are not too far to make a contact.
1197 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1198 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1200 if (fcont.gt.0.0D0) then
1201 C If the SC-SC distance if close to sigma, apply spline.
1202 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1203 cAdam & fcont1,fprimcont1)
1204 cAdam fcont1=1.0d0-fcont1
1205 cAdam if (fcont1.gt.0.0d0) then
1206 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1207 cAdam fcont=fcont*fcont1
1209 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1210 cga eps0ij=1.0d0/dsqrt(eps0ij)
1212 cga gg(k)=gg(k)*eps0ij
1214 cga eps0ij=-evdwij*eps0ij
1215 C Uncomment for AL's type of SC correlation interactions.
1216 cadam eps0ij=-evdwij
1217 num_conti=num_conti+1
1218 jcont(num_conti,i)=j
1219 facont(num_conti,i)=fcont*eps0ij
1220 fprimcont=eps0ij*fprimcont/rij
1222 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1223 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1224 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1225 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1226 gacont(1,num_conti,i)=-fprimcont*xj
1227 gacont(2,num_conti,i)=-fprimcont*yj
1228 gacont(3,num_conti,i)=-fprimcont*zj
1229 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1230 cd write (iout,'(2i3,3f10.5)')
1231 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1237 num_cont(i)=num_conti
1241 gvdwc(j,i)=expon*gvdwc(j,i)
1242 gvdwx(j,i)=expon*gvdwx(j,i)
1245 C******************************************************************************
1249 C To save time, the factor of EXPON has been extracted from ALL components
1250 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1253 C******************************************************************************
1256 C-----------------------------------------------------------------------------
1257 subroutine eljk(evdw)
1259 C This subroutine calculates the interaction energy of nonbonded side chains
1260 C assuming the LJK potential of interaction.
1262 implicit real*8 (a-h,o-z)
1263 include 'DIMENSIONS'
1264 include 'COMMON.GEO'
1265 include 'COMMON.VAR'
1266 include 'COMMON.LOCAL'
1267 include 'COMMON.CHAIN'
1268 include 'COMMON.DERIV'
1269 include 'COMMON.INTERACT'
1270 include 'COMMON.IOUNITS'
1271 include 'COMMON.NAMES'
1274 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1276 do i=iatsc_s,iatsc_e
1277 itypi=iabs(itype(i))
1278 if (itypi.eq.ntyp1) cycle
1279 itypi1=iabs(itype(i+1))
1284 C Calculate SC interaction energy.
1286 do iint=1,nint_gr(i)
1287 do j=istart(i,iint),iend(i,iint)
1288 itypj=iabs(itype(j))
1289 if (itypj.eq.ntyp1) cycle
1293 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1294 fac_augm=rrij**expon
1295 e_augm=augm(itypi,itypj)*fac_augm
1296 r_inv_ij=dsqrt(rrij)
1298 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1299 fac=r_shift_inv**expon
1300 C have you changed here?
1304 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1305 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1306 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1307 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1308 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1309 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1310 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1313 C Calculate the components of the gradient in DC and X
1315 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1320 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1321 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1322 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1323 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1327 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1335 gvdwc(j,i)=expon*gvdwc(j,i)
1336 gvdwx(j,i)=expon*gvdwx(j,i)
1341 C-----------------------------------------------------------------------------
1342 subroutine ebp(evdw)
1344 C This subroutine calculates the interaction energy of nonbonded side chains
1345 C assuming the Berne-Pechukas potential of interaction.
1347 implicit real*8 (a-h,o-z)
1348 include 'DIMENSIONS'
1349 include 'COMMON.GEO'
1350 include 'COMMON.VAR'
1351 include 'COMMON.LOCAL'
1352 include 'COMMON.CHAIN'
1353 include 'COMMON.DERIV'
1354 include 'COMMON.NAMES'
1355 include 'COMMON.INTERACT'
1356 include 'COMMON.IOUNITS'
1357 include 'COMMON.CALC'
1358 common /srutu/ icall
1359 c double precision rrsave(maxdim)
1362 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1364 c if (icall.eq.0) then
1370 do i=iatsc_s,iatsc_e
1371 itypi=iabs(itype(i))
1372 if (itypi.eq.ntyp1) cycle
1373 itypi1=iabs(itype(i+1))
1377 dxi=dc_norm(1,nres+i)
1378 dyi=dc_norm(2,nres+i)
1379 dzi=dc_norm(3,nres+i)
1380 c dsci_inv=dsc_inv(itypi)
1381 dsci_inv=vbld_inv(i+nres)
1383 C Calculate SC interaction energy.
1385 do iint=1,nint_gr(i)
1386 do j=istart(i,iint),iend(i,iint)
1388 itypj=iabs(itype(j))
1389 if (itypj.eq.ntyp1) cycle
1390 c dscj_inv=dsc_inv(itypj)
1391 dscj_inv=vbld_inv(j+nres)
1392 chi1=chi(itypi,itypj)
1393 chi2=chi(itypj,itypi)
1400 alf12=0.5D0*(alf1+alf2)
1401 C For diagnostics only!!!
1414 dxj=dc_norm(1,nres+j)
1415 dyj=dc_norm(2,nres+j)
1416 dzj=dc_norm(3,nres+j)
1417 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1418 cd if (icall.eq.0) then
1424 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1426 C Calculate whole angle-dependent part of epsilon and contributions
1427 C to its derivatives
1428 C have you changed here?
1429 fac=(rrij*sigsq)**expon2
1432 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1433 eps2der=evdwij*eps3rt
1434 eps3der=evdwij*eps2rt
1435 evdwij=evdwij*eps2rt*eps3rt
1438 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1440 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1441 cd & restyp(itypi),i,restyp(itypj),j,
1442 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1443 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1444 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1447 C Calculate gradient components.
1448 e1=e1*eps1*eps2rt**2*eps3rt**2
1449 fac=-expon*(e1+evdwij)
1452 C Calculate radial part of the gradient
1456 C Calculate the angular part of the gradient and sum add the contributions
1457 C to the appropriate components of the Cartesian gradient.
1465 C-----------------------------------------------------------------------------
1466 subroutine egb(evdw)
1468 C This subroutine calculates the interaction energy of nonbonded side chains
1469 C assuming the Gay-Berne potential of interaction.
1471 implicit real*8 (a-h,o-z)
1472 include 'DIMENSIONS'
1473 include 'COMMON.GEO'
1474 include 'COMMON.VAR'
1475 include 'COMMON.LOCAL'
1476 include 'COMMON.CHAIN'
1477 include 'COMMON.DERIV'
1478 include 'COMMON.NAMES'
1479 include 'COMMON.INTERACT'
1480 include 'COMMON.IOUNITS'
1481 include 'COMMON.CALC'
1482 include 'COMMON.CONTROL'
1483 include 'COMMON.SPLITELE'
1484 include 'COMMON.SBRIDGE'
1486 integer xshift,yshift,zshift
1489 ccccc energy_dec=.false.
1490 C print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1493 c if (icall.eq.0) lprn=.false.
1495 C the loop over all 27 posible neigbours (for xshift=0,yshift=0,zshift=0
1496 C we have the original box)
1500 do i=iatsc_s,iatsc_e
1501 itypi=iabs(itype(i))
1502 if (itypi.eq.ntyp1) cycle
1503 itypi1=iabs(itype(i+1))
1507 C Return atom into box, boxxsize is size of box in x dimension
1509 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
1510 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
1511 C Condition for being inside the proper box
1512 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
1513 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
1517 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
1518 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
1519 C Condition for being inside the proper box
1520 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
1521 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
1525 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
1526 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
1527 C Condition for being inside the proper box
1528 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
1529 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
1533 if (xi.lt.0) xi=xi+boxxsize
1535 if (yi.lt.0) yi=yi+boxysize
1537 if (zi.lt.0) zi=zi+boxzsize
1538 C define scaling factor for lipids
1540 C if (positi.le.0) positi=positi+boxzsize
1542 C first for peptide groups
1543 c for each residue check if it is in lipid or lipid water border area
1544 if ((zi.gt.bordlipbot)
1545 &.and.(zi.lt.bordliptop)) then
1546 C the energy transfer exist
1547 if (zi.lt.buflipbot) then
1548 C what fraction I am in
1550 & ((zi-bordlipbot)/lipbufthick)
1551 C lipbufthick is thickenes of lipid buffore
1552 sslipi=sscalelip(fracinbuf)
1553 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1554 elseif (zi.gt.bufliptop) then
1555 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1556 sslipi=sscalelip(fracinbuf)
1557 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1567 C xi=xi+xshift*boxxsize
1568 C yi=yi+yshift*boxysize
1569 C zi=zi+zshift*boxzsize
1571 dxi=dc_norm(1,nres+i)
1572 dyi=dc_norm(2,nres+i)
1573 dzi=dc_norm(3,nres+i)
1574 c dsci_inv=dsc_inv(itypi)
1575 dsci_inv=vbld_inv(i+nres)
1576 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1577 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1579 C Calculate SC interaction energy.
1581 do iint=1,nint_gr(i)
1582 do j=istart(i,iint),iend(i,iint)
1583 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1585 c write(iout,*) "PRZED ZWYKLE", evdwij
1586 call dyn_ssbond_ene(i,j,evdwij)
1587 c write(iout,*) "PO ZWYKLE", evdwij
1590 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1591 & 'evdw',i,j,evdwij,' ss'
1592 C triple bond artifac removal
1593 do k=j+1,iend(i,iint)
1594 C search over all next residues
1595 if (dyn_ss_mask(k)) then
1596 C check if they are cysteins
1597 C write(iout,*) 'k=',k
1599 c write(iout,*) "PRZED TRI", evdwij
1600 evdwij_przed_tri=evdwij
1601 call triple_ssbond_ene(i,j,k,evdwij)
1602 c if(evdwij_przed_tri.ne.evdwij) then
1603 c write (iout,*) "TRI:", evdwij, evdwij_przed_tri
1606 c write(iout,*) "PO TRI", evdwij
1607 C call the energy function that removes the artifical triple disulfide
1608 C bond the soubroutine is located in ssMD.F
1610 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1611 & 'evdw',i,j,evdwij,'tss'
1612 endif!dyn_ss_mask(k)
1616 itypj=iabs(itype(j))
1617 if (itypj.eq.ntyp1) cycle
1618 c dscj_inv=dsc_inv(itypj)
1619 dscj_inv=vbld_inv(j+nres)
1620 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1621 c & 1.0d0/vbld(j+nres)
1622 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1623 sig0ij=sigma(itypi,itypj)
1624 chi1=chi(itypi,itypj)
1625 chi2=chi(itypj,itypi)
1632 alf12=0.5D0*(alf1+alf2)
1633 C For diagnostics only!!!
1646 C Return atom J into box the original box
1648 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
1649 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
1650 C Condition for being inside the proper box
1651 c if ((xj.gt.((0.5d0)*boxxsize)).or.
1652 c & (xj.lt.((-0.5d0)*boxxsize))) then
1656 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
1657 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
1658 C Condition for being inside the proper box
1659 c if ((yj.gt.((0.5d0)*boxysize)).or.
1660 c & (yj.lt.((-0.5d0)*boxysize))) then
1664 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
1665 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
1666 C Condition for being inside the proper box
1667 c if ((zj.gt.((0.5d0)*boxzsize)).or.
1668 c & (zj.lt.((-0.5d0)*boxzsize))) then
1672 if (xj.lt.0) xj=xj+boxxsize
1674 if (yj.lt.0) yj=yj+boxysize
1676 if (zj.lt.0) zj=zj+boxzsize
1677 if ((zj.gt.bordlipbot)
1678 &.and.(zj.lt.bordliptop)) then
1679 C the energy transfer exist
1680 if (zj.lt.buflipbot) then
1681 C what fraction I am in
1683 & ((zj-bordlipbot)/lipbufthick)
1684 C lipbufthick is thickenes of lipid buffore
1685 sslipj=sscalelip(fracinbuf)
1686 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1687 elseif (zj.gt.bufliptop) then
1688 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1689 sslipj=sscalelip(fracinbuf)
1690 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1699 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1700 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1701 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1702 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1703 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'(2e10.5)')
1704 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
1705 C if (ssgradlipj.gt.0.0d0) print *,"??WTF??"
1706 C print *,sslipi,sslipj,bordlipbot,zi,zj
1707 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1715 xj=xj_safe+xshift*boxxsize
1716 yj=yj_safe+yshift*boxysize
1717 zj=zj_safe+zshift*boxzsize
1718 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1719 if(dist_temp.lt.dist_init) then
1729 if (subchap.eq.1) then
1738 dxj=dc_norm(1,nres+j)
1739 dyj=dc_norm(2,nres+j)
1740 dzj=dc_norm(3,nres+j)
1744 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1745 c write (iout,*) "j",j," dc_norm",
1746 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1747 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1749 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1750 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1752 c write (iout,'(a7,4f8.3)')
1753 c & "ssscale",sss,((1.0d0/rij)/sigma(itypi,itypj)),r_cut,rlamb
1754 if (sss.gt.0.0d0) then
1755 C Calculate angle-dependent terms of energy and contributions to their
1759 sig=sig0ij*dsqrt(sigsq)
1760 rij_shift=1.0D0/rij-sig+sig0ij
1761 c for diagnostics; uncomment
1762 c rij_shift=1.2*sig0ij
1763 C I hate to put IF's in the loops, but here don't have another choice!!!!
1764 if (rij_shift.le.0.0D0) then
1766 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1767 cd & restyp(itypi),i,restyp(itypj),j,
1768 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1772 c---------------------------------------------------------------
1773 rij_shift=1.0D0/rij_shift
1774 fac=rij_shift**expon
1775 C here to start with
1780 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1781 eps2der=evdwij*eps3rt
1782 eps3der=evdwij*eps2rt
1783 C write(63,'(2i3,2e10.3,2f10.5)') i,j,aa,bb, evdwij,
1784 C &((sslipi+sslipj)/2.0d0+
1785 C &(2.0d0-sslipi-sslipj)/2.0d0)
1786 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1787 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1788 evdwij=evdwij*eps2rt*eps3rt
1789 evdw=evdw+evdwij*sss
1791 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1793 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1794 & restyp(itypi),i,restyp(itypj),j,
1795 & epsi,sigm,chi1,chi2,chip1,chip2,
1796 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1797 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1801 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1804 C Calculate gradient components.
1805 e1=e1*eps1*eps2rt**2*eps3rt**2
1806 fac=-expon*(e1+evdwij)*rij_shift
1809 c print '(2i4,6f8.4)',i,j,sss,sssgrad*
1810 c & evdwij,fac,sigma(itypi,itypj),expon
1811 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1813 C Calculate the radial part of the gradient
1814 gg_lipi(3)=eps1*(eps2rt*eps2rt)
1815 &*(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip*
1816 & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
1817 &+faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
1818 gg_lipj(3)=ssgradlipj*gg_lipi(3)
1819 gg_lipi(3)=gg_lipi(3)*ssgradlipi
1825 C Calculate angular part of the gradient.
1835 c write (iout,*) "Number of loop steps in EGB:",ind
1836 cccc energy_dec=.false.
1839 C-----------------------------------------------------------------------------
1840 subroutine egbv(evdw)
1842 C This subroutine calculates the interaction energy of nonbonded side chains
1843 C assuming the Gay-Berne-Vorobjev potential of interaction.
1845 implicit real*8 (a-h,o-z)
1846 include 'DIMENSIONS'
1847 include 'COMMON.GEO'
1848 include 'COMMON.VAR'
1849 include 'COMMON.LOCAL'
1850 include 'COMMON.CHAIN'
1851 include 'COMMON.DERIV'
1852 include 'COMMON.NAMES'
1853 include 'COMMON.INTERACT'
1854 include 'COMMON.IOUNITS'
1855 include 'COMMON.CALC'
1856 common /srutu/ icall
1859 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1862 c if (icall.eq.0) lprn=.true.
1864 do i=iatsc_s,iatsc_e
1865 itypi=iabs(itype(i))
1866 if (itypi.eq.ntyp1) cycle
1867 itypi1=iabs(itype(i+1))
1872 if (xi.lt.0) xi=xi+boxxsize
1874 if (yi.lt.0) yi=yi+boxysize
1876 if (zi.lt.0) zi=zi+boxzsize
1877 C define scaling factor for lipids
1879 C if (positi.le.0) positi=positi+boxzsize
1881 C first for peptide groups
1882 c for each residue check if it is in lipid or lipid water border area
1883 if ((zi.gt.bordlipbot)
1884 &.and.(zi.lt.bordliptop)) then
1885 C the energy transfer exist
1886 if (zi.lt.buflipbot) then
1887 C what fraction I am in
1889 & ((zi-bordlipbot)/lipbufthick)
1890 C lipbufthick is thickenes of lipid buffore
1891 sslipi=sscalelip(fracinbuf)
1892 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1893 elseif (zi.gt.bufliptop) then
1894 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1895 sslipi=sscalelip(fracinbuf)
1896 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1906 dxi=dc_norm(1,nres+i)
1907 dyi=dc_norm(2,nres+i)
1908 dzi=dc_norm(3,nres+i)
1909 c dsci_inv=dsc_inv(itypi)
1910 dsci_inv=vbld_inv(i+nres)
1912 C Calculate SC interaction energy.
1914 do iint=1,nint_gr(i)
1915 do j=istart(i,iint),iend(i,iint)
1917 itypj=iabs(itype(j))
1918 if (itypj.eq.ntyp1) cycle
1919 c dscj_inv=dsc_inv(itypj)
1920 dscj_inv=vbld_inv(j+nres)
1921 sig0ij=sigma(itypi,itypj)
1922 r0ij=r0(itypi,itypj)
1923 chi1=chi(itypi,itypj)
1924 chi2=chi(itypj,itypi)
1931 alf12=0.5D0*(alf1+alf2)
1932 C For diagnostics only!!!
1946 if (xj.lt.0) xj=xj+boxxsize
1948 if (yj.lt.0) yj=yj+boxysize
1950 if (zj.lt.0) zj=zj+boxzsize
1951 if ((zj.gt.bordlipbot)
1952 &.and.(zj.lt.bordliptop)) then
1953 C the energy transfer exist
1954 if (zj.lt.buflipbot) then
1955 C what fraction I am in
1957 & ((zj-bordlipbot)/lipbufthick)
1958 C lipbufthick is thickenes of lipid buffore
1959 sslipj=sscalelip(fracinbuf)
1960 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1961 elseif (zj.gt.bufliptop) then
1962 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1963 sslipj=sscalelip(fracinbuf)
1964 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1973 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1974 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1975 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1976 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1977 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'2e10.5')
1978 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
1979 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1987 xj=xj_safe+xshift*boxxsize
1988 yj=yj_safe+yshift*boxysize
1989 zj=zj_safe+zshift*boxzsize
1990 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1991 if(dist_temp.lt.dist_init) then
2001 if (subchap.eq.1) then
2010 dxj=dc_norm(1,nres+j)
2011 dyj=dc_norm(2,nres+j)
2012 dzj=dc_norm(3,nres+j)
2013 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
2015 C Calculate angle-dependent terms of energy and contributions to their
2019 sig=sig0ij*dsqrt(sigsq)
2020 rij_shift=1.0D0/rij-sig+r0ij
2021 C I hate to put IF's in the loops, but here don't have another choice!!!!
2022 if (rij_shift.le.0.0D0) then
2027 c---------------------------------------------------------------
2028 rij_shift=1.0D0/rij_shift
2029 fac=rij_shift**expon
2032 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
2033 eps2der=evdwij*eps3rt
2034 eps3der=evdwij*eps2rt
2035 fac_augm=rrij**expon
2036 e_augm=augm(itypi,itypj)*fac_augm
2037 evdwij=evdwij*eps2rt*eps3rt
2038 evdw=evdw+evdwij+e_augm
2040 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
2042 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
2043 & restyp(itypi),i,restyp(itypj),j,
2044 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
2045 & chi1,chi2,chip1,chip2,
2046 & eps1,eps2rt**2,eps3rt**2,
2047 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
2050 C Calculate gradient components.
2051 e1=e1*eps1*eps2rt**2*eps3rt**2
2052 fac=-expon*(e1+evdwij)*rij_shift
2054 fac=rij*fac-2*expon*rrij*e_augm
2055 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
2056 C Calculate the radial part of the gradient
2060 C Calculate angular part of the gradient.
2066 C-----------------------------------------------------------------------------
2067 subroutine sc_angular
2068 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
2069 C om12. Called by ebp, egb, and egbv.
2071 include 'COMMON.CALC'
2072 include 'COMMON.IOUNITS'
2076 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2077 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2078 om12=dxi*dxj+dyi*dyj+dzi*dzj
2080 C Calculate eps1(om12) and its derivative in om12
2081 faceps1=1.0D0-om12*chiom12
2082 faceps1_inv=1.0D0/faceps1
2083 eps1=dsqrt(faceps1_inv)
2084 C Following variable is eps1*deps1/dom12
2085 eps1_om12=faceps1_inv*chiom12
2090 c write (iout,*) "om12",om12," eps1",eps1
2091 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
2096 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
2097 sigsq=1.0D0-facsig*faceps1_inv
2098 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
2099 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
2100 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
2106 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
2107 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
2109 C Calculate eps2 and its derivatives in om1, om2, and om12.
2112 chipom12=chip12*om12
2113 facp=1.0D0-om12*chipom12
2115 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
2116 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
2117 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
2118 C Following variable is the square root of eps2
2119 eps2rt=1.0D0-facp1*facp_inv
2120 C Following three variables are the derivatives of the square root of eps
2121 C in om1, om2, and om12.
2122 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
2123 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
2124 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
2125 C Evaluate the "asymmetric" factor in the VDW constant, eps3
2126 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
2127 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
2128 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
2129 c & " eps2rt_om12",eps2rt_om12
2130 C Calculate whole angle-dependent part of epsilon and contributions
2131 C to its derivatives
2134 C----------------------------------------------------------------------------
2136 implicit real*8 (a-h,o-z)
2137 include 'DIMENSIONS'
2138 include 'COMMON.CHAIN'
2139 include 'COMMON.DERIV'
2140 include 'COMMON.CALC'
2141 include 'COMMON.IOUNITS'
2142 double precision dcosom1(3),dcosom2(3)
2143 cc print *,'sss=',sss
2144 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2145 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2146 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2147 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2151 c eom12=evdwij*eps1_om12
2153 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2154 c & " sigder",sigder
2155 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2156 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2158 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2159 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2162 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss
2164 c write (iout,*) "gg",(gg(k),k=1,3)
2166 gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k)
2167 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2168 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss
2169 gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)
2170 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2171 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss
2172 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2173 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2174 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2175 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2178 C Calculate the components of the gradient in DC and X
2182 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2186 gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
2187 gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
2191 C-----------------------------------------------------------------------
2192 subroutine e_softsphere(evdw)
2194 C This subroutine calculates the interaction energy of nonbonded side chains
2195 C assuming the LJ potential of interaction.
2197 implicit real*8 (a-h,o-z)
2198 include 'DIMENSIONS'
2199 parameter (accur=1.0d-10)
2200 include 'COMMON.GEO'
2201 include 'COMMON.VAR'
2202 include 'COMMON.LOCAL'
2203 include 'COMMON.CHAIN'
2204 include 'COMMON.DERIV'
2205 include 'COMMON.INTERACT'
2206 include 'COMMON.TORSION'
2207 include 'COMMON.SBRIDGE'
2208 include 'COMMON.NAMES'
2209 include 'COMMON.IOUNITS'
2210 include 'COMMON.CONTACTS'
2212 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2214 do i=iatsc_s,iatsc_e
2215 itypi=iabs(itype(i))
2216 if (itypi.eq.ntyp1) cycle
2217 itypi1=iabs(itype(i+1))
2222 C Calculate SC interaction energy.
2224 do iint=1,nint_gr(i)
2225 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2226 cd & 'iend=',iend(i,iint)
2227 do j=istart(i,iint),iend(i,iint)
2228 itypj=iabs(itype(j))
2229 if (itypj.eq.ntyp1) cycle
2233 rij=xj*xj+yj*yj+zj*zj
2234 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2235 r0ij=r0(itypi,itypj)
2237 c print *,i,j,r0ij,dsqrt(rij)
2238 if (rij.lt.r0ijsq) then
2239 evdwij=0.25d0*(rij-r0ijsq)**2
2247 C Calculate the components of the gradient in DC and X
2253 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2254 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2255 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2256 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2260 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2268 C--------------------------------------------------------------------------
2269 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2272 C Soft-sphere potential of p-p interaction
2274 implicit real*8 (a-h,o-z)
2275 include 'DIMENSIONS'
2276 include 'COMMON.CONTROL'
2277 include 'COMMON.IOUNITS'
2278 include 'COMMON.GEO'
2279 include 'COMMON.VAR'
2280 include 'COMMON.LOCAL'
2281 include 'COMMON.CHAIN'
2282 include 'COMMON.DERIV'
2283 include 'COMMON.INTERACT'
2284 include 'COMMON.CONTACTS'
2285 include 'COMMON.TORSION'
2286 include 'COMMON.VECTORS'
2287 include 'COMMON.FFIELD'
2289 C write(iout,*) 'In EELEC_soft_sphere'
2296 do i=iatel_s,iatel_e
2297 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2301 xmedi=c(1,i)+0.5d0*dxi
2302 ymedi=c(2,i)+0.5d0*dyi
2303 zmedi=c(3,i)+0.5d0*dzi
2304 xmedi=mod(xmedi,boxxsize)
2305 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2306 ymedi=mod(ymedi,boxysize)
2307 if (ymedi.lt.0) ymedi=ymedi+boxysize
2308 zmedi=mod(zmedi,boxzsize)
2309 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2311 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2312 do j=ielstart(i),ielend(i)
2313 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
2317 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2318 r0ij=rpp(iteli,itelj)
2327 if (xj.lt.0) xj=xj+boxxsize
2329 if (yj.lt.0) yj=yj+boxysize
2331 if (zj.lt.0) zj=zj+boxzsize
2332 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2340 xj=xj_safe+xshift*boxxsize
2341 yj=yj_safe+yshift*boxysize
2342 zj=zj_safe+zshift*boxzsize
2343 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2344 if(dist_temp.lt.dist_init) then
2354 if (isubchap.eq.1) then
2363 rij=xj*xj+yj*yj+zj*zj
2364 sss=sscale(sqrt(rij))
2365 sssgrad=sscagrad(sqrt(rij))
2366 if (rij.lt.r0ijsq) then
2367 evdw1ij=0.25d0*(rij-r0ijsq)**2
2373 evdw1=evdw1+evdw1ij*sss
2375 C Calculate contributions to the Cartesian gradient.
2377 ggg(1)=fac*xj*sssgrad
2378 ggg(2)=fac*yj*sssgrad
2379 ggg(3)=fac*zj*sssgrad
2381 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2382 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2385 * Loop over residues i+1 thru j-1.
2389 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2394 cgrad do i=nnt,nct-1
2396 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2398 cgrad do j=i+1,nct-1
2400 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2406 c------------------------------------------------------------------------------
2407 subroutine vec_and_deriv
2408 implicit real*8 (a-h,o-z)
2409 include 'DIMENSIONS'
2413 include 'COMMON.IOUNITS'
2414 include 'COMMON.GEO'
2415 include 'COMMON.VAR'
2416 include 'COMMON.LOCAL'
2417 include 'COMMON.CHAIN'
2418 include 'COMMON.VECTORS'
2419 include 'COMMON.SETUP'
2420 include 'COMMON.TIME1'
2421 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2422 C Compute the local reference systems. For reference system (i), the
2423 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2424 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2426 do i=ivec_start,ivec_end
2430 if (i.eq.nres-1) then
2431 C Case of the last full residue
2432 C Compute the Z-axis
2433 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2434 costh=dcos(pi-theta(nres))
2435 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2439 C Compute the derivatives of uz
2441 uzder(2,1,1)=-dc_norm(3,i-1)
2442 uzder(3,1,1)= dc_norm(2,i-1)
2443 uzder(1,2,1)= dc_norm(3,i-1)
2445 uzder(3,2,1)=-dc_norm(1,i-1)
2446 uzder(1,3,1)=-dc_norm(2,i-1)
2447 uzder(2,3,1)= dc_norm(1,i-1)
2450 uzder(2,1,2)= dc_norm(3,i)
2451 uzder(3,1,2)=-dc_norm(2,i)
2452 uzder(1,2,2)=-dc_norm(3,i)
2454 uzder(3,2,2)= dc_norm(1,i)
2455 uzder(1,3,2)= dc_norm(2,i)
2456 uzder(2,3,2)=-dc_norm(1,i)
2458 C Compute the Y-axis
2461 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2463 C Compute the derivatives of uy
2466 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2467 & -dc_norm(k,i)*dc_norm(j,i-1)
2468 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2470 uyder(j,j,1)=uyder(j,j,1)-costh
2471 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2476 uygrad(l,k,j,i)=uyder(l,k,j)
2477 uzgrad(l,k,j,i)=uzder(l,k,j)
2481 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2482 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2483 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2484 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2487 C Compute the Z-axis
2488 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2489 costh=dcos(pi-theta(i+2))
2490 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2494 C Compute the derivatives of uz
2496 uzder(2,1,1)=-dc_norm(3,i+1)
2497 uzder(3,1,1)= dc_norm(2,i+1)
2498 uzder(1,2,1)= dc_norm(3,i+1)
2500 uzder(3,2,1)=-dc_norm(1,i+1)
2501 uzder(1,3,1)=-dc_norm(2,i+1)
2502 uzder(2,3,1)= dc_norm(1,i+1)
2505 uzder(2,1,2)= dc_norm(3,i)
2506 uzder(3,1,2)=-dc_norm(2,i)
2507 uzder(1,2,2)=-dc_norm(3,i)
2509 uzder(3,2,2)= dc_norm(1,i)
2510 uzder(1,3,2)= dc_norm(2,i)
2511 uzder(2,3,2)=-dc_norm(1,i)
2513 C Compute the Y-axis
2516 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2518 C Compute the derivatives of uy
2521 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2522 & -dc_norm(k,i)*dc_norm(j,i+1)
2523 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2525 uyder(j,j,1)=uyder(j,j,1)-costh
2526 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2531 uygrad(l,k,j,i)=uyder(l,k,j)
2532 uzgrad(l,k,j,i)=uzder(l,k,j)
2536 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2537 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2538 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2539 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2543 vbld_inv_temp(1)=vbld_inv(i+1)
2544 if (i.lt.nres-1) then
2545 vbld_inv_temp(2)=vbld_inv(i+2)
2547 vbld_inv_temp(2)=vbld_inv(i)
2552 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2553 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2558 #if defined(PARVEC) && defined(MPI)
2559 if (nfgtasks1.gt.1) then
2561 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2562 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2563 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2564 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2565 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2567 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2568 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2570 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2571 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2572 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2573 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2574 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2575 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2576 time_gather=time_gather+MPI_Wtime()-time00
2578 c if (fg_rank.eq.0) then
2579 c write (iout,*) "Arrays UY and UZ"
2581 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2588 C-----------------------------------------------------------------------------
2589 subroutine check_vecgrad
2590 implicit real*8 (a-h,o-z)
2591 include 'DIMENSIONS'
2592 include 'COMMON.IOUNITS'
2593 include 'COMMON.GEO'
2594 include 'COMMON.VAR'
2595 include 'COMMON.LOCAL'
2596 include 'COMMON.CHAIN'
2597 include 'COMMON.VECTORS'
2598 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2599 dimension uyt(3,maxres),uzt(3,maxres)
2600 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2601 double precision delta /1.0d-7/
2604 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2605 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2606 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2607 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2608 cd & (dc_norm(if90,i),if90=1,3)
2609 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2610 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2611 cd write(iout,'(a)')
2617 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2618 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2631 cd write (iout,*) 'i=',i
2633 erij(k)=dc_norm(k,i)
2637 dc_norm(k,i)=erij(k)
2639 dc_norm(j,i)=dc_norm(j,i)+delta
2640 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2642 c dc_norm(k,i)=dc_norm(k,i)/fac
2644 c write (iout,*) (dc_norm(k,i),k=1,3)
2645 c write (iout,*) (erij(k),k=1,3)
2648 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2649 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2650 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2651 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2653 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2654 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2655 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2658 dc_norm(k,i)=erij(k)
2661 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2662 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2663 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2664 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2665 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2666 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2667 cd write (iout,'(a)')
2672 C--------------------------------------------------------------------------
2673 subroutine set_matrices
2674 implicit real*8 (a-h,o-z)
2675 include 'DIMENSIONS'
2678 include "COMMON.SETUP"
2680 integer status(MPI_STATUS_SIZE)
2682 include 'COMMON.IOUNITS'
2683 include 'COMMON.GEO'
2684 include 'COMMON.VAR'
2685 include 'COMMON.LOCAL'
2686 include 'COMMON.CHAIN'
2687 include 'COMMON.DERIV'
2688 include 'COMMON.INTERACT'
2689 include 'COMMON.CONTACTS'
2690 include 'COMMON.TORSION'
2691 include 'COMMON.VECTORS'
2692 include 'COMMON.FFIELD'
2693 double precision auxvec(2),auxmat(2,2)
2695 C Compute the virtual-bond-torsional-angle dependent quantities needed
2696 C to calculate the el-loc multibody terms of various order.
2698 c write(iout,*) 'nphi=',nphi,nres
2700 do i=ivec_start+2,ivec_end+2
2705 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2706 iti = itortyp(itype(i-2))
2710 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2711 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2712 iti1 = itortyp(itype(i-1))
2717 b1(1,i-2)=bnew1(1,1,iti)*dsin(theta(i-1)/2.0)
2718 & +bnew1(2,1,iti)*dsin(theta(i-1))
2719 & +bnew1(3,1,iti)*dcos(theta(i-1)/2.0)
2720 gtb1(1,i-2)=bnew1(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2721 & +bnew1(2,1,iti)*dcos(theta(i-1))
2722 & -bnew1(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2723 c & +bnew1(3,1,iti)*sin(alpha(i))*cos(beta(i))
2724 c &*(cos(theta(i)/2.0)
2725 b2(1,i-2)=bnew2(1,1,iti)*dsin(theta(i-1)/2.0)
2726 & +bnew2(2,1,iti)*dsin(theta(i-1))
2727 & +bnew2(3,1,iti)*dcos(theta(i-1)/2.0)
2728 c & +bnew2(3,1,iti)*sin(alpha(i))*cos(beta(i))
2729 c &*(cos(theta(i)/2.0)
2730 gtb2(1,i-2)=bnew2(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2731 & +bnew2(2,1,iti)*dcos(theta(i-1))
2732 & -bnew2(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2733 c if (ggb1(1,i).eq.0.0d0) then
2734 c write(iout,*) 'i=',i,ggb1(1,i),
2735 c &bnew1(1,1,iti)*cos(theta(i)/2.0)/2.0,
2736 c &bnew1(2,1,iti)*cos(theta(i)),
2737 c &bnew1(3,1,iti)*sin(theta(i)/2.0)/2.0
2739 b1(2,i-2)=bnew1(1,2,iti)
2741 b2(2,i-2)=bnew2(1,2,iti)
2743 EE(1,1,i-2)=eenew(1,iti)*dcos(theta(i-1))
2744 EE(1,2,i-2)=eeold(1,2,iti)
2745 EE(2,1,i-2)=eeold(2,1,iti)
2746 EE(2,2,i-2)=eeold(2,2,iti)
2747 gtEE(1,1,i-2)=-eenew(1,iti)*dsin(theta(i-1))
2752 c EE(1,2,iti)=0.5d0*eenew(1,iti)
2753 c EE(2,1,iti)=0.5d0*eenew(1,iti)
2754 c b1(2,iti)=bnew1(1,2,iti)*sin(alpha(i))*sin(beta(i))
2755 c b2(2,iti)=bnew2(1,2,iti)*sin(alpha(i))*sin(beta(i))
2756 b1tilde(1,i-2)=b1(1,i-2)
2757 b1tilde(2,i-2)=-b1(2,i-2)
2758 b2tilde(1,i-2)=b2(1,i-2)
2759 b2tilde(2,i-2)=-b2(2,i-2)
2760 c write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
2761 c write(iout,*) 'b1=',b1(1,i-2)
2762 c write (iout,*) 'theta=', theta(i-1)
2769 b1tilde(1,i-2)=b1(1,i-2)
2770 b1tilde(2,i-2)=-b1(2,i-2)
2771 b2tilde(1,i-2)=b2(1,i-2)
2772 b2tilde(2,i-2)=-b2(2,i-2)
2773 EE(1,2,i-2)=eeold(1,2,iti)
2774 EE(2,1,i-2)=eeold(2,1,iti)
2775 EE(2,2,i-2)=eeold(2,2,iti)
2776 EE(1,1,i-2)=eeold(1,1,iti)
2780 do i=ivec_start+2,ivec_end+2
2784 if (i .lt. nres+1) then
2821 if (i .gt. 3 .and. i .lt. nres+1) then
2822 obrot_der(1,i-2)=-sin1
2823 obrot_der(2,i-2)= cos1
2824 Ugder(1,1,i-2)= sin1
2825 Ugder(1,2,i-2)=-cos1
2826 Ugder(2,1,i-2)=-cos1
2827 Ugder(2,2,i-2)=-sin1
2830 obrot2_der(1,i-2)=-dwasin2
2831 obrot2_der(2,i-2)= dwacos2
2832 Ug2der(1,1,i-2)= dwasin2
2833 Ug2der(1,2,i-2)=-dwacos2
2834 Ug2der(2,1,i-2)=-dwacos2
2835 Ug2der(2,2,i-2)=-dwasin2
2837 obrot_der(1,i-2)=0.0d0
2838 obrot_der(2,i-2)=0.0d0
2839 Ugder(1,1,i-2)=0.0d0
2840 Ugder(1,2,i-2)=0.0d0
2841 Ugder(2,1,i-2)=0.0d0
2842 Ugder(2,2,i-2)=0.0d0
2843 obrot2_der(1,i-2)=0.0d0
2844 obrot2_der(2,i-2)=0.0d0
2845 Ug2der(1,1,i-2)=0.0d0
2846 Ug2der(1,2,i-2)=0.0d0
2847 Ug2der(2,1,i-2)=0.0d0
2848 Ug2der(2,2,i-2)=0.0d0
2850 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2851 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2852 iti = itortyp(itype(i-2))
2856 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2857 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2858 iti1 = itortyp(itype(i-1))
2862 cd write (iout,*) '*******i',i,' iti1',iti
2863 cd write (iout,*) 'b1',b1(:,iti)
2864 cd write (iout,*) 'b2',b2(:,iti)
2865 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2866 c if (i .gt. iatel_s+2) then
2867 if (i .gt. nnt+2) then
2868 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
2870 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
2871 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
2873 c write(iout,*) "co jest kurwa", iti, EE(1,1,iti),EE(2,1,iti),
2874 c & EE(1,2,iti),EE(2,2,iti)
2875 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
2876 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
2877 c write(iout,*) "Macierz EUG",
2878 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
2880 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2882 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2883 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2884 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2885 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2886 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2897 DtUg2(l,k,i-2)=0.0d0
2901 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
2902 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
2904 muder(k,i-2)=Ub2der(k,i-2)
2906 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2907 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2908 if (itype(i-1).le.ntyp) then
2909 iti1 = itortyp(itype(i-1))
2917 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
2919 c write (iout,*) 'mu ',mu(:,i-2),i-2
2920 cd write (iout,*) 'mu1',mu1(:,i-2)
2921 cd write (iout,*) 'mu2',mu2(:,i-2)
2922 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2924 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2925 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2926 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2927 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2928 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2929 C Vectors and matrices dependent on a single virtual-bond dihedral.
2930 call matvec2(DD(1,1,iti),b1tilde(1,i-1),auxvec(1))
2931 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2932 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2933 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2934 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2935 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2936 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2937 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2938 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2941 C Matrices dependent on two consecutive virtual-bond dihedrals.
2942 C The order of matrices is from left to right.
2943 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2945 c do i=max0(ivec_start,2),ivec_end
2947 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2948 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2949 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2950 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2951 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2952 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2953 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2954 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2957 #if defined(MPI) && defined(PARMAT)
2959 c if (fg_rank.eq.0) then
2960 write (iout,*) "Arrays UG and UGDER before GATHER"
2962 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2963 & ((ug(l,k,i),l=1,2),k=1,2),
2964 & ((ugder(l,k,i),l=1,2),k=1,2)
2966 write (iout,*) "Arrays UG2 and UG2DER"
2968 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2969 & ((ug2(l,k,i),l=1,2),k=1,2),
2970 & ((ug2der(l,k,i),l=1,2),k=1,2)
2972 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2974 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2975 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2976 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2978 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2980 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2981 & costab(i),sintab(i),costab2(i),sintab2(i)
2983 write (iout,*) "Array MUDER"
2985 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2989 if (nfgtasks.gt.1) then
2991 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2992 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2993 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2995 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2996 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2998 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2999 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3001 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
3002 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3004 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
3005 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3007 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
3008 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3010 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
3011 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3013 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
3014 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
3015 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3016 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
3017 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
3018 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3019 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
3020 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
3021 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3022 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
3023 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
3024 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
3025 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3027 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
3028 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3030 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
3031 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3033 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
3034 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3036 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
3037 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3039 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
3040 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3042 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
3043 & ivec_count(fg_rank1),
3044 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3046 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
3047 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3049 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
3050 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3052 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
3053 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3055 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
3056 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3058 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
3059 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3061 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
3062 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3064 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
3065 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3067 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
3068 & ivec_count(fg_rank1),
3069 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3071 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
3072 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3074 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
3075 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3077 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
3078 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3080 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
3081 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3083 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
3084 & ivec_count(fg_rank1),
3085 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3087 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
3088 & ivec_count(fg_rank1),
3089 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3091 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
3092 & ivec_count(fg_rank1),
3093 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3094 & MPI_MAT2,FG_COMM1,IERR)
3095 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
3096 & ivec_count(fg_rank1),
3097 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3098 & MPI_MAT2,FG_COMM1,IERR)
3101 c Passes matrix info through the ring
3104 if (irecv.lt.0) irecv=nfgtasks1-1
3107 if (inext.ge.nfgtasks1) inext=0
3109 c write (iout,*) "isend",isend," irecv",irecv
3111 lensend=lentyp(isend)
3112 lenrecv=lentyp(irecv)
3113 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
3114 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
3115 c & MPI_ROTAT1(lensend),inext,2200+isend,
3116 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
3117 c & iprev,2200+irecv,FG_COMM,status,IERR)
3118 c write (iout,*) "Gather ROTAT1"
3120 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
3121 c & MPI_ROTAT2(lensend),inext,3300+isend,
3122 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3123 c & iprev,3300+irecv,FG_COMM,status,IERR)
3124 c write (iout,*) "Gather ROTAT2"
3126 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
3127 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
3128 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
3129 & iprev,4400+irecv,FG_COMM,status,IERR)
3130 c write (iout,*) "Gather ROTAT_OLD"
3132 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
3133 & MPI_PRECOMP11(lensend),inext,5500+isend,
3134 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
3135 & iprev,5500+irecv,FG_COMM,status,IERR)
3136 c write (iout,*) "Gather PRECOMP11"
3138 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
3139 & MPI_PRECOMP12(lensend),inext,6600+isend,
3140 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
3141 & iprev,6600+irecv,FG_COMM,status,IERR)
3142 c write (iout,*) "Gather PRECOMP12"
3144 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3146 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
3147 & MPI_ROTAT2(lensend),inext,7700+isend,
3148 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3149 & iprev,7700+irecv,FG_COMM,status,IERR)
3150 c write (iout,*) "Gather PRECOMP21"
3152 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
3153 & MPI_PRECOMP22(lensend),inext,8800+isend,
3154 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
3155 & iprev,8800+irecv,FG_COMM,status,IERR)
3156 c write (iout,*) "Gather PRECOMP22"
3158 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
3159 & MPI_PRECOMP23(lensend),inext,9900+isend,
3160 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
3161 & MPI_PRECOMP23(lenrecv),
3162 & iprev,9900+irecv,FG_COMM,status,IERR)
3163 c write (iout,*) "Gather PRECOMP23"
3168 if (irecv.lt.0) irecv=nfgtasks1-1
3171 time_gather=time_gather+MPI_Wtime()-time00
3174 c if (fg_rank.eq.0) then
3175 write (iout,*) "Arrays UG and UGDER"
3177 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3178 & ((ug(l,k,i),l=1,2),k=1,2),
3179 & ((ugder(l,k,i),l=1,2),k=1,2)
3181 write (iout,*) "Arrays UG2 and UG2DER"
3183 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3184 & ((ug2(l,k,i),l=1,2),k=1,2),
3185 & ((ug2der(l,k,i),l=1,2),k=1,2)
3187 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3189 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3190 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
3191 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3193 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3195 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3196 & costab(i),sintab(i),costab2(i),sintab2(i)
3198 write (iout,*) "Array MUDER"
3200 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3206 cd iti = itortyp(itype(i))
3209 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
3210 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
3215 C--------------------------------------------------------------------------
3216 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3218 C This subroutine calculates the average interaction energy and its gradient
3219 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3220 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3221 C The potential depends both on the distance of peptide-group centers and on
3222 C the orientation of the CA-CA virtual bonds.
3224 implicit real*8 (a-h,o-z)
3228 include 'DIMENSIONS'
3229 include 'COMMON.CONTROL'
3230 include 'COMMON.SETUP'
3231 include 'COMMON.IOUNITS'
3232 include 'COMMON.GEO'
3233 include 'COMMON.VAR'
3234 include 'COMMON.LOCAL'
3235 include 'COMMON.CHAIN'
3236 include 'COMMON.DERIV'
3237 include 'COMMON.INTERACT'
3238 include 'COMMON.CONTACTS'
3239 include 'COMMON.TORSION'
3240 include 'COMMON.VECTORS'
3241 include 'COMMON.FFIELD'
3242 include 'COMMON.TIME1'
3243 include 'COMMON.SPLITELE'
3244 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3245 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3246 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3247 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
3248 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3249 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3251 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3253 double precision scal_el /1.0d0/
3255 double precision scal_el /0.5d0/
3258 C 13-go grudnia roku pamietnego...
3259 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3260 & 0.0d0,1.0d0,0.0d0,
3261 & 0.0d0,0.0d0,1.0d0/
3262 cd write(iout,*) 'In EELEC'
3264 cd write(iout,*) 'Type',i
3265 cd write(iout,*) 'B1',B1(:,i)
3266 cd write(iout,*) 'B2',B2(:,i)
3267 cd write(iout,*) 'CC',CC(:,:,i)
3268 cd write(iout,*) 'DD',DD(:,:,i)
3269 cd write(iout,*) 'EE',EE(:,:,i)
3271 cd call check_vecgrad
3273 if (icheckgrad.eq.1) then
3275 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3277 dc_norm(k,i)=dc(k,i)*fac
3279 c write (iout,*) 'i',i,' fac',fac
3282 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3283 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3284 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3285 c call vec_and_deriv
3291 time_mat=time_mat+MPI_Wtime()-time01
3295 cd write (iout,*) 'i=',i
3297 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3300 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3301 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3314 cd print '(a)','Enter EELEC'
3315 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3317 gel_loc_loc(i)=0.0d0
3322 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3324 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3326 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
3327 do i=iturn3_start,iturn3_end
3329 C write(iout,*) "tu jest i",i
3330 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3331 C changes suggested by Ana to avoid out of bounds
3332 & .or.((i+4).gt.nres)
3334 C end of changes by Ana
3335 & .or. itype(i+2).eq.ntyp1
3336 & .or. itype(i+3).eq.ntyp1) cycle
3338 if(itype(i-1).eq.ntyp1)cycle
3341 if (itype(i+4).eq.ntyp1) cycle
3346 dx_normi=dc_norm(1,i)
3347 dy_normi=dc_norm(2,i)
3348 dz_normi=dc_norm(3,i)
3349 xmedi=c(1,i)+0.5d0*dxi
3350 ymedi=c(2,i)+0.5d0*dyi
3351 zmedi=c(3,i)+0.5d0*dzi
3352 xmedi=mod(xmedi,boxxsize)
3353 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3354 ymedi=mod(ymedi,boxysize)
3355 if (ymedi.lt.0) ymedi=ymedi+boxysize
3356 zmedi=mod(zmedi,boxzsize)
3357 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3359 call eelecij(i,i+2,ees,evdw1,eel_loc)
3360 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3361 num_cont_hb(i)=num_conti
3363 do i=iturn4_start,iturn4_end
3365 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3366 C changes suggested by Ana to avoid out of bounds
3367 & .or.((i+5).gt.nres)
3369 C end of changes suggested by Ana
3370 & .or. itype(i+3).eq.ntyp1
3371 & .or. itype(i+4).eq.ntyp1
3372 & .or. itype(i+5).eq.ntyp1
3373 & .or. itype(i).eq.ntyp1
3374 & .or. itype(i-1).eq.ntyp1
3379 dx_normi=dc_norm(1,i)
3380 dy_normi=dc_norm(2,i)
3381 dz_normi=dc_norm(3,i)
3382 xmedi=c(1,i)+0.5d0*dxi
3383 ymedi=c(2,i)+0.5d0*dyi
3384 zmedi=c(3,i)+0.5d0*dzi
3385 C Return atom into box, boxxsize is size of box in x dimension
3387 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3388 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3389 C Condition for being inside the proper box
3390 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
3391 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
3395 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
3396 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3397 C Condition for being inside the proper box
3398 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
3399 c & (ymedi.lt.((-0.5d0)*boxysize))) then
3403 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3404 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3405 C Condition for being inside the proper box
3406 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
3407 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
3410 xmedi=mod(xmedi,boxxsize)
3411 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3412 ymedi=mod(ymedi,boxysize)
3413 if (ymedi.lt.0) ymedi=ymedi+boxysize
3414 zmedi=mod(zmedi,boxzsize)
3415 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3417 num_conti=num_cont_hb(i)
3418 c write(iout,*) "JESTEM W PETLI"
3419 call eelecij(i,i+3,ees,evdw1,eel_loc)
3420 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
3421 & call eturn4(i,eello_turn4)
3422 num_cont_hb(i)=num_conti
3424 C Loop over all neighbouring boxes
3429 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3431 do i=iatel_s,iatel_e
3433 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3434 C changes suggested by Ana to avoid out of bounds
3435 & .or.((i+2).gt.nres)
3437 C end of changes by Ana
3438 & .or. itype(i+2).eq.ntyp1
3439 & .or. itype(i-1).eq.ntyp1
3444 dx_normi=dc_norm(1,i)
3445 dy_normi=dc_norm(2,i)
3446 dz_normi=dc_norm(3,i)
3447 xmedi=c(1,i)+0.5d0*dxi
3448 ymedi=c(2,i)+0.5d0*dyi
3449 zmedi=c(3,i)+0.5d0*dzi
3450 xmedi=mod(xmedi,boxxsize)
3451 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3452 ymedi=mod(ymedi,boxysize)
3453 if (ymedi.lt.0) ymedi=ymedi+boxysize
3454 zmedi=mod(zmedi,boxzsize)
3455 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3456 C xmedi=xmedi+xshift*boxxsize
3457 C ymedi=ymedi+yshift*boxysize
3458 C zmedi=zmedi+zshift*boxzsize
3460 C Return tom into box, boxxsize is size of box in x dimension
3462 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3463 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3464 C Condition for being inside the proper box
3465 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
3466 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
3470 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
3471 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3472 C Condition for being inside the proper box
3473 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
3474 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3478 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3479 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3480 cC Condition for being inside the proper box
3481 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3482 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3486 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3487 num_conti=num_cont_hb(i)
3488 do j=ielstart(i),ielend(i)
3489 C write (iout,*) i,j
3491 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3492 C changes suggested by Ana to avoid out of bounds
3493 & .or.((j+2).gt.nres)
3495 C end of changes by Ana
3496 & .or.itype(j+2).eq.ntyp1
3497 & .or.itype(j-1).eq.ntyp1
3499 call eelecij(i,j,ees,evdw1,eel_loc)
3501 num_cont_hb(i)=num_conti
3507 c write (iout,*) "Number of loop steps in EELEC:",ind
3509 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3510 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3512 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3513 ccc eel_loc=eel_loc+eello_turn3
3514 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3517 C-------------------------------------------------------------------------------
3518 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3519 implicit real*8 (a-h,o-z)
3520 include 'DIMENSIONS'
3524 include 'COMMON.CONTROL'
3525 include 'COMMON.IOUNITS'
3526 include 'COMMON.GEO'
3527 include 'COMMON.VAR'
3528 include 'COMMON.LOCAL'
3529 include 'COMMON.CHAIN'
3530 include 'COMMON.DERIV'
3531 include 'COMMON.INTERACT'
3532 include 'COMMON.CONTACTS'
3533 include 'COMMON.TORSION'
3534 include 'COMMON.VECTORS'
3535 include 'COMMON.FFIELD'
3536 include 'COMMON.TIME1'
3537 include 'COMMON.SPLITELE'
3538 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3539 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3540 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3541 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
3542 & gmuij2(4),gmuji2(4)
3543 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3544 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3546 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3548 double precision scal_el /1.0d0/
3550 double precision scal_el /0.5d0/
3553 C 13-go grudnia roku pamietnego...
3554 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3555 & 0.0d0,1.0d0,0.0d0,
3556 & 0.0d0,0.0d0,1.0d0/
3557 c time00=MPI_Wtime()
3558 cd write (iout,*) "eelecij",i,j
3562 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3563 aaa=app(iteli,itelj)
3564 bbb=bpp(iteli,itelj)
3565 ael6i=ael6(iteli,itelj)
3566 ael3i=ael3(iteli,itelj)
3570 dx_normj=dc_norm(1,j)
3571 dy_normj=dc_norm(2,j)
3572 dz_normj=dc_norm(3,j)
3573 C xj=c(1,j)+0.5D0*dxj-xmedi
3574 C yj=c(2,j)+0.5D0*dyj-ymedi
3575 C zj=c(3,j)+0.5D0*dzj-zmedi
3580 if (xj.lt.0) xj=xj+boxxsize
3582 if (yj.lt.0) yj=yj+boxysize
3584 if (zj.lt.0) zj=zj+boxzsize
3585 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
3586 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3594 xj=xj_safe+xshift*boxxsize
3595 yj=yj_safe+yshift*boxysize
3596 zj=zj_safe+zshift*boxzsize
3597 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3598 if(dist_temp.lt.dist_init) then
3608 if (isubchap.eq.1) then
3617 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3619 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3620 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3621 C Condition for being inside the proper box
3622 c if ((xj.gt.((0.5d0)*boxxsize)).or.
3623 c & (xj.lt.((-0.5d0)*boxxsize))) then
3627 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3628 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3629 C Condition for being inside the proper box
3630 c if ((yj.gt.((0.5d0)*boxysize)).or.
3631 c & (yj.lt.((-0.5d0)*boxysize))) then
3635 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3636 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3637 C Condition for being inside the proper box
3638 c if ((zj.gt.((0.5d0)*boxzsize)).or.
3639 c & (zj.lt.((-0.5d0)*boxzsize))) then
3642 C endif !endPBC condintion
3646 rij=xj*xj+yj*yj+zj*zj
3648 sss=sscale(sqrt(rij))
3649 sssgrad=sscagrad(sqrt(rij))
3650 c if (sss.gt.0.0d0) then
3656 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3657 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3658 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3659 fac=cosa-3.0D0*cosb*cosg
3661 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3662 if (j.eq.i+2) ev1=scal_el*ev1
3667 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3671 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3672 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3674 evdw1=evdw1+evdwij*sss
3675 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3676 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3677 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3678 cd & xmedi,ymedi,zmedi,xj,yj,zj
3680 if (energy_dec) then
3681 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3683 &,iteli,itelj,aaa,evdw1
3684 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3688 C Calculate contributions to the Cartesian gradient.
3691 facvdw=-6*rrmij*(ev1+evdwij)*sss
3692 facel=-3*rrmij*(el1+eesij)
3698 * Radial derivatives. First process both termini of the fragment (i,j)
3704 c ghalf=0.5D0*ggg(k)
3705 c gelc(k,i)=gelc(k,i)+ghalf
3706 c gelc(k,j)=gelc(k,j)+ghalf
3708 c 9/28/08 AL Gradient compotents will be summed only at the end
3710 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3711 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3714 * Loop over residues i+1 thru j-1.
3718 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3721 if (sss.gt.0.0) then
3722 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3723 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3724 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3731 c ghalf=0.5D0*ggg(k)
3732 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3733 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3735 c 9/28/08 AL Gradient compotents will be summed only at the end
3737 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3738 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3741 * Loop over residues i+1 thru j-1.
3745 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3750 facvdw=(ev1+evdwij)*sss
3753 fac=-3*rrmij*(facvdw+facvdw+facel)
3758 * Radial derivatives. First process both termini of the fragment (i,j)
3764 c ghalf=0.5D0*ggg(k)
3765 c gelc(k,i)=gelc(k,i)+ghalf
3766 c gelc(k,j)=gelc(k,j)+ghalf
3768 c 9/28/08 AL Gradient compotents will be summed only at the end
3770 gelc_long(k,j)=gelc(k,j)+ggg(k)
3771 gelc_long(k,i)=gelc(k,i)-ggg(k)
3774 * Loop over residues i+1 thru j-1.
3778 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3781 c 9/28/08 AL Gradient compotents will be summed only at the end
3782 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3783 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3784 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3786 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3787 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3793 ecosa=2.0D0*fac3*fac1+fac4
3796 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3797 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3799 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3800 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3802 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3803 cd & (dcosg(k),k=1,3)
3805 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3808 c ghalf=0.5D0*ggg(k)
3809 c gelc(k,i)=gelc(k,i)+ghalf
3810 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3811 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3812 c gelc(k,j)=gelc(k,j)+ghalf
3813 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3814 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3818 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3823 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3824 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3826 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3827 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3828 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3829 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3833 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3834 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3835 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3837 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3838 C energy of a peptide unit is assumed in the form of a second-order
3839 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3840 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3841 C are computed for EVERY pair of non-contiguous peptide groups.
3844 if (j.lt.nres-1) then
3856 muij(kkk)=mu(k,i)*mu(l,j)
3857 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
3859 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
3860 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
3861 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
3862 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
3863 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
3864 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
3868 cd write (iout,*) 'EELEC: i',i,' j',j
3869 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3870 cd write(iout,*) 'muij',muij
3871 ury=scalar(uy(1,i),erij)
3872 urz=scalar(uz(1,i),erij)
3873 vry=scalar(uy(1,j),erij)
3874 vrz=scalar(uz(1,j),erij)
3875 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3876 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3877 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3878 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3879 fac=dsqrt(-ael6i)*r3ij
3884 cd write (iout,'(4i5,4f10.5)')
3885 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3886 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3887 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3888 cd & uy(:,j),uz(:,j)
3889 cd write (iout,'(4f10.5)')
3890 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3891 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3892 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3893 cd write (iout,'(9f10.5/)')
3894 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3895 C Derivatives of the elements of A in virtual-bond vectors
3896 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3898 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3899 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3900 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3901 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3902 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3903 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3904 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3905 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3906 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3907 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3908 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3909 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3911 C Compute radial contributions to the gradient
3929 C Add the contributions coming from er
3932 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3933 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3934 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3935 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3938 C Derivatives in DC(i)
3939 cgrad ghalf1=0.5d0*agg(k,1)
3940 cgrad ghalf2=0.5d0*agg(k,2)
3941 cgrad ghalf3=0.5d0*agg(k,3)
3942 cgrad ghalf4=0.5d0*agg(k,4)
3943 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3944 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3945 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3946 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3947 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3948 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3949 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3950 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3951 C Derivatives in DC(i+1)
3952 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3953 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3954 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3955 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3956 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3957 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3958 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3959 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3960 C Derivatives in DC(j)
3961 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3962 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3963 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3964 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3965 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3966 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3967 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3968 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3969 C Derivatives in DC(j+1) or DC(nres-1)
3970 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3971 & -3.0d0*vryg(k,3)*ury)
3972 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3973 & -3.0d0*vrzg(k,3)*ury)
3974 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3975 & -3.0d0*vryg(k,3)*urz)
3976 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3977 & -3.0d0*vrzg(k,3)*urz)
3978 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3980 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3993 aggi(k,l)=-aggi(k,l)
3994 aggi1(k,l)=-aggi1(k,l)
3995 aggj(k,l)=-aggj(k,l)
3996 aggj1(k,l)=-aggj1(k,l)
3999 if (j.lt.nres-1) then
4005 aggi(k,l)=-aggi(k,l)
4006 aggi1(k,l)=-aggi1(k,l)
4007 aggj(k,l)=-aggj(k,l)
4008 aggj1(k,l)=-aggj1(k,l)
4019 aggi(k,l)=-aggi(k,l)
4020 aggi1(k,l)=-aggi1(k,l)
4021 aggj(k,l)=-aggj(k,l)
4022 aggj1(k,l)=-aggj1(k,l)
4027 IF (wel_loc.gt.0.0d0) THEN
4028 C Contribution to the local-electrostatic energy coming from the i-j pair
4029 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
4031 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
4032 c & ' eel_loc_ij',eel_loc_ij
4033 c write(iout,*) 'muije=',muij(1),muij(2),muij(3),muij(4)
4034 C Calculate patrial derivative for theta angle
4036 geel_loc_ij=a22*gmuij1(1)
4040 c write(iout,*) "derivative over thatai"
4041 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
4043 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
4044 & geel_loc_ij*wel_loc
4045 c write(iout,*) "derivative over thatai-1"
4046 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
4053 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4054 & geel_loc_ij*wel_loc
4055 c Derivative over j residue
4056 geel_loc_ji=a22*gmuji1(1)
4060 c write(iout,*) "derivative over thataj"
4061 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
4064 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
4065 & geel_loc_ji*wel_loc
4071 c write(iout,*) "derivative over thataj-1"
4072 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
4074 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
4075 & geel_loc_ji*wel_loc
4077 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
4079 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4080 & 'eelloc',i,j,eel_loc_ij
4081 c if (eel_loc_ij.ne.0)
4082 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
4083 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
4085 eel_loc=eel_loc+eel_loc_ij
4086 C Partial derivatives in virtual-bond dihedral angles gamma
4088 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
4089 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
4090 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
4091 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
4092 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
4093 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
4094 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
4096 ggg(l)=agg(l,1)*muij(1)+
4097 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
4098 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
4099 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
4100 cgrad ghalf=0.5d0*ggg(l)
4101 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
4102 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
4106 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
4109 C Remaining derivatives of eello
4111 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
4112 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
4113 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
4114 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
4115 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
4116 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
4117 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
4118 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
4121 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
4122 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
4123 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
4124 & .and. num_conti.le.maxconts) then
4125 c write (iout,*) i,j," entered corr"
4127 C Calculate the contact function. The ith column of the array JCONT will
4128 C contain the numbers of atoms that make contacts with the atom I (of numbers
4129 C greater than I). The arrays FACONT and GACONT will contain the values of
4130 C the contact function and its derivative.
4131 c r0ij=1.02D0*rpp(iteli,itelj)
4132 c r0ij=1.11D0*rpp(iteli,itelj)
4133 r0ij=2.20D0*rpp(iteli,itelj)
4134 c r0ij=1.55D0*rpp(iteli,itelj)
4135 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4136 if (fcont.gt.0.0D0) then
4137 num_conti=num_conti+1
4138 if (num_conti.gt.maxconts) then
4139 write (iout,*) 'WARNING - max. # of contacts exceeded;',
4140 & ' will skip next contacts for this conf.'
4142 jcont_hb(num_conti,i)=j
4143 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
4144 cd & " jcont_hb",jcont_hb(num_conti,i)
4145 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
4146 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4147 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4149 d_cont(num_conti,i)=rij
4150 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4151 C --- Electrostatic-interaction matrix ---
4152 a_chuj(1,1,num_conti,i)=a22
4153 a_chuj(1,2,num_conti,i)=a23
4154 a_chuj(2,1,num_conti,i)=a32
4155 a_chuj(2,2,num_conti,i)=a33
4156 C --- Gradient of rij
4158 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4165 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4166 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4167 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4168 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4169 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4174 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4175 C Calculate contact energies
4177 wij=cosa-3.0D0*cosb*cosg
4180 c fac3=dsqrt(-ael6i)/r0ij**3
4181 fac3=dsqrt(-ael6i)*r3ij
4182 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4183 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
4184 if (ees0tmp.gt.0) then
4185 ees0pij=dsqrt(ees0tmp)
4189 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4190 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
4191 if (ees0tmp.gt.0) then
4192 ees0mij=dsqrt(ees0tmp)
4197 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
4198 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
4199 C Diagnostics. Comment out or remove after debugging!
4200 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4201 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4202 c ees0m(num_conti,i)=0.0D0
4204 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4205 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4206 C Angular derivatives of the contact function
4207 ees0pij1=fac3/ees0pij
4208 ees0mij1=fac3/ees0mij
4209 fac3p=-3.0D0*fac3*rrmij
4210 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4211 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4213 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4214 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4215 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4216 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4217 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4218 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4219 ecosap=ecosa1+ecosa2
4220 ecosbp=ecosb1+ecosb2
4221 ecosgp=ecosg1+ecosg2
4222 ecosam=ecosa1-ecosa2
4223 ecosbm=ecosb1-ecosb2
4224 ecosgm=ecosg1-ecosg2
4233 facont_hb(num_conti,i)=fcont
4234 fprimcont=fprimcont/rij
4235 cd facont_hb(num_conti,i)=1.0D0
4236 C Following line is for diagnostics.
4239 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4240 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4243 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4244 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4246 gggp(1)=gggp(1)+ees0pijp*xj
4247 gggp(2)=gggp(2)+ees0pijp*yj
4248 gggp(3)=gggp(3)+ees0pijp*zj
4249 gggm(1)=gggm(1)+ees0mijp*xj
4250 gggm(2)=gggm(2)+ees0mijp*yj
4251 gggm(3)=gggm(3)+ees0mijp*zj
4252 C Derivatives due to the contact function
4253 gacont_hbr(1,num_conti,i)=fprimcont*xj
4254 gacont_hbr(2,num_conti,i)=fprimcont*yj
4255 gacont_hbr(3,num_conti,i)=fprimcont*zj
4258 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
4259 c following the change of gradient-summation algorithm.
4261 cgrad ghalfp=0.5D0*gggp(k)
4262 cgrad ghalfm=0.5D0*gggm(k)
4263 gacontp_hb1(k,num_conti,i)=!ghalfp
4264 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
4265 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4266 gacontp_hb2(k,num_conti,i)=!ghalfp
4267 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
4268 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4269 gacontp_hb3(k,num_conti,i)=gggp(k)
4270 gacontm_hb1(k,num_conti,i)=!ghalfm
4271 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
4272 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4273 gacontm_hb2(k,num_conti,i)=!ghalfm
4274 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
4275 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4276 gacontm_hb3(k,num_conti,i)=gggm(k)
4278 C Diagnostics. Comment out or remove after debugging!
4280 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
4281 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
4282 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
4283 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
4284 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
4285 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
4288 endif ! num_conti.le.maxconts
4291 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4294 ghalf=0.5d0*agg(l,k)
4295 aggi(l,k)=aggi(l,k)+ghalf
4296 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4297 aggj(l,k)=aggj(l,k)+ghalf
4300 if (j.eq.nres-1 .and. i.lt.j-2) then
4303 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4308 c t_eelecij=t_eelecij+MPI_Wtime()-time00
4311 C-----------------------------------------------------------------------------
4312 subroutine eturn3(i,eello_turn3)
4313 C Third- and fourth-order contributions from turns
4314 implicit real*8 (a-h,o-z)
4315 include 'DIMENSIONS'
4316 include 'COMMON.IOUNITS'
4317 include 'COMMON.GEO'
4318 include 'COMMON.VAR'
4319 include 'COMMON.LOCAL'
4320 include 'COMMON.CHAIN'
4321 include 'COMMON.DERIV'
4322 include 'COMMON.INTERACT'
4323 include 'COMMON.CONTACTS'
4324 include 'COMMON.TORSION'
4325 include 'COMMON.VECTORS'
4326 include 'COMMON.FFIELD'
4327 include 'COMMON.CONTROL'
4329 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4330 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4331 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
4332 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
4333 & auxgmat2(2,2),auxgmatt2(2,2)
4334 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4335 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4336 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4337 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4340 c write (iout,*) "eturn3",i,j,j1,j2
4345 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4347 C Third-order contributions
4354 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4355 cd call checkint_turn3(i,a_temp,eello_turn3_num)
4356 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4357 c auxalary matices for theta gradient
4358 c auxalary matrix for i+1 and constant i+2
4359 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
4360 c auxalary matrix for i+2 and constant i+1
4361 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
4362 call transpose2(auxmat(1,1),auxmat1(1,1))
4363 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
4364 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
4365 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4366 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
4367 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
4368 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
4369 C Derivatives in theta
4370 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4371 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
4372 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
4373 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
4375 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4376 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
4377 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
4378 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
4379 cd & ' eello_turn3_num',4*eello_turn3_num
4380 C Derivatives in gamma(i)
4381 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4382 call transpose2(auxmat2(1,1),auxmat3(1,1))
4383 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4384 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
4385 C Derivatives in gamma(i+1)
4386 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4387 call transpose2(auxmat2(1,1),auxmat3(1,1))
4388 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4389 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
4390 & +0.5d0*(pizda(1,1)+pizda(2,2))
4391 C Cartesian derivatives
4393 c ghalf1=0.5d0*agg(l,1)
4394 c ghalf2=0.5d0*agg(l,2)
4395 c ghalf3=0.5d0*agg(l,3)
4396 c ghalf4=0.5d0*agg(l,4)
4397 a_temp(1,1)=aggi(l,1)!+ghalf1
4398 a_temp(1,2)=aggi(l,2)!+ghalf2
4399 a_temp(2,1)=aggi(l,3)!+ghalf3
4400 a_temp(2,2)=aggi(l,4)!+ghalf4
4401 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4402 gcorr3_turn(l,i)=gcorr3_turn(l,i)
4403 & +0.5d0*(pizda(1,1)+pizda(2,2))
4404 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4405 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4406 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4407 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4408 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4409 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
4410 & +0.5d0*(pizda(1,1)+pizda(2,2))
4411 a_temp(1,1)=aggj(l,1)!+ghalf1
4412 a_temp(1,2)=aggj(l,2)!+ghalf2
4413 a_temp(2,1)=aggj(l,3)!+ghalf3
4414 a_temp(2,2)=aggj(l,4)!+ghalf4
4415 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4416 gcorr3_turn(l,j)=gcorr3_turn(l,j)
4417 & +0.5d0*(pizda(1,1)+pizda(2,2))
4418 a_temp(1,1)=aggj1(l,1)
4419 a_temp(1,2)=aggj1(l,2)
4420 a_temp(2,1)=aggj1(l,3)
4421 a_temp(2,2)=aggj1(l,4)
4422 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4423 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
4424 & +0.5d0*(pizda(1,1)+pizda(2,2))
4428 C-------------------------------------------------------------------------------
4429 subroutine eturn4(i,eello_turn4)
4430 C Third- and fourth-order contributions from turns
4431 implicit real*8 (a-h,o-z)
4432 include 'DIMENSIONS'
4433 include 'COMMON.IOUNITS'
4434 include 'COMMON.GEO'
4435 include 'COMMON.VAR'
4436 include 'COMMON.LOCAL'
4437 include 'COMMON.CHAIN'
4438 include 'COMMON.DERIV'
4439 include 'COMMON.INTERACT'
4440 include 'COMMON.CONTACTS'
4441 include 'COMMON.TORSION'
4442 include 'COMMON.VECTORS'
4443 include 'COMMON.FFIELD'
4444 include 'COMMON.CONTROL'
4446 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4447 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4448 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
4449 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
4450 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
4451 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
4452 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
4453 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4454 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4455 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4456 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4459 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4461 C Fourth-order contributions
4469 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4470 cd call checkint_turn4(i,a_temp,eello_turn4_num)
4471 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4472 c write(iout,*)"WCHODZE W PROGRAM"
4477 iti1=itortyp(itype(i+1))
4478 iti2=itortyp(itype(i+2))
4479 iti3=itortyp(itype(i+3))
4480 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4481 call transpose2(EUg(1,1,i+1),e1t(1,1))
4482 call transpose2(Eug(1,1,i+2),e2t(1,1))
4483 call transpose2(Eug(1,1,i+3),e3t(1,1))
4484 C Ematrix derivative in theta
4485 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
4486 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
4487 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
4488 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4489 c eta1 in derivative theta
4490 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
4491 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4492 c auxgvec is derivative of Ub2 so i+3 theta
4493 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
4494 c auxalary matrix of E i+1
4495 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
4498 s1=scalar2(b1(1,i+2),auxvec(1))
4499 c derivative of theta i+2 with constant i+3
4500 gs23=scalar2(gtb1(1,i+2),auxvec(1))
4501 c derivative of theta i+2 with constant i+2
4502 gs32=scalar2(b1(1,i+2),auxgvec(1))
4503 c derivative of E matix in theta of i+1
4504 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
4506 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4507 c ea31 in derivative theta
4508 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
4509 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4510 c auxilary matrix auxgvec of Ub2 with constant E matirx
4511 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
4512 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
4513 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
4517 s2=scalar2(b1(1,i+1),auxvec(1))
4518 c derivative of theta i+1 with constant i+3
4519 gs13=scalar2(gtb1(1,i+1),auxvec(1))
4520 c derivative of theta i+2 with constant i+1
4521 gs21=scalar2(b1(1,i+1),auxgvec(1))
4522 c derivative of theta i+3 with constant i+1
4523 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
4524 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
4526 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4527 c two derivatives over diffetent matrices
4528 c gtae3e2 is derivative over i+3
4529 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
4530 c ae3gte2 is derivative over i+2
4531 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
4532 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4533 c three possible derivative over theta E matices
4535 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
4537 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
4539 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
4540 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4542 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
4543 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
4544 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
4546 eello_turn4=eello_turn4-(s1+s2+s3)
4547 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
4548 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
4549 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
4550 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4551 cd & ' eello_turn4_num',8*eello_turn4_num
4553 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4554 & -(gs13+gsE13+gsEE1)*wturn4
4555 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
4556 & -(gs23+gs21+gsEE2)*wturn4
4557 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
4558 & -(gs32+gsE31+gsEE3)*wturn4
4559 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
4562 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4563 & 'eturn4',i,j,-(s1+s2+s3)
4564 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4565 c & ' eello_turn4_num',8*eello_turn4_num
4566 C Derivatives in gamma(i)
4567 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4568 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4569 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4570 s1=scalar2(b1(1,i+2),auxvec(1))
4571 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4572 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4573 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
4574 C Derivatives in gamma(i+1)
4575 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4576 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4577 s2=scalar2(b1(1,i+1),auxvec(1))
4578 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4579 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4580 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4581 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
4582 C Derivatives in gamma(i+2)
4583 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4584 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4585 s1=scalar2(b1(1,i+2),auxvec(1))
4586 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4587 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4588 s2=scalar2(b1(1,i+1),auxvec(1))
4589 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4590 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4591 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4592 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
4593 C Cartesian derivatives
4594 C Derivatives of this turn contributions in DC(i+2)
4595 if (j.lt.nres-1) then
4597 a_temp(1,1)=agg(l,1)
4598 a_temp(1,2)=agg(l,2)
4599 a_temp(2,1)=agg(l,3)
4600 a_temp(2,2)=agg(l,4)
4601 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4602 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4603 s1=scalar2(b1(1,i+2),auxvec(1))
4604 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4605 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4606 s2=scalar2(b1(1,i+1),auxvec(1))
4607 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4608 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4609 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4611 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
4614 C Remaining derivatives of this turn contribution
4616 a_temp(1,1)=aggi(l,1)
4617 a_temp(1,2)=aggi(l,2)
4618 a_temp(2,1)=aggi(l,3)
4619 a_temp(2,2)=aggi(l,4)
4620 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4621 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4622 s1=scalar2(b1(1,i+2),auxvec(1))
4623 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4624 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4625 s2=scalar2(b1(1,i+1),auxvec(1))
4626 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4627 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4628 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4629 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4630 a_temp(1,1)=aggi1(l,1)
4631 a_temp(1,2)=aggi1(l,2)
4632 a_temp(2,1)=aggi1(l,3)
4633 a_temp(2,2)=aggi1(l,4)
4634 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4635 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4636 s1=scalar2(b1(1,i+2),auxvec(1))
4637 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4638 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4639 s2=scalar2(b1(1,i+1),auxvec(1))
4640 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4641 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4642 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4643 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4644 a_temp(1,1)=aggj(l,1)
4645 a_temp(1,2)=aggj(l,2)
4646 a_temp(2,1)=aggj(l,3)
4647 a_temp(2,2)=aggj(l,4)
4648 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4649 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4650 s1=scalar2(b1(1,i+2),auxvec(1))
4651 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4652 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4653 s2=scalar2(b1(1,i+1),auxvec(1))
4654 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4655 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4656 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4657 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4658 a_temp(1,1)=aggj1(l,1)
4659 a_temp(1,2)=aggj1(l,2)
4660 a_temp(2,1)=aggj1(l,3)
4661 a_temp(2,2)=aggj1(l,4)
4662 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4663 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4664 s1=scalar2(b1(1,i+2),auxvec(1))
4665 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4666 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4667 s2=scalar2(b1(1,i+1),auxvec(1))
4668 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4669 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4670 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4671 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4672 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4676 C-----------------------------------------------------------------------------
4677 subroutine vecpr(u,v,w)
4678 implicit real*8(a-h,o-z)
4679 dimension u(3),v(3),w(3)
4680 w(1)=u(2)*v(3)-u(3)*v(2)
4681 w(2)=-u(1)*v(3)+u(3)*v(1)
4682 w(3)=u(1)*v(2)-u(2)*v(1)
4685 C-----------------------------------------------------------------------------
4686 subroutine unormderiv(u,ugrad,unorm,ungrad)
4687 C This subroutine computes the derivatives of a normalized vector u, given
4688 C the derivatives computed without normalization conditions, ugrad. Returns
4691 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4692 double precision vec(3)
4693 double precision scalar
4695 c write (2,*) 'ugrad',ugrad
4698 vec(i)=scalar(ugrad(1,i),u(1))
4700 c write (2,*) 'vec',vec
4703 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4706 c write (2,*) 'ungrad',ungrad
4709 C-----------------------------------------------------------------------------
4710 subroutine escp_soft_sphere(evdw2,evdw2_14)
4712 C This subroutine calculates the excluded-volume interaction energy between
4713 C peptide-group centers and side chains and its gradient in virtual-bond and
4714 C side-chain vectors.
4716 implicit real*8 (a-h,o-z)
4717 include 'DIMENSIONS'
4718 include 'COMMON.GEO'
4719 include 'COMMON.VAR'
4720 include 'COMMON.LOCAL'
4721 include 'COMMON.CHAIN'
4722 include 'COMMON.DERIV'
4723 include 'COMMON.INTERACT'
4724 include 'COMMON.FFIELD'
4725 include 'COMMON.IOUNITS'
4726 include 'COMMON.CONTROL'
4731 cd print '(a)','Enter ESCP'
4732 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4736 do i=iatscp_s,iatscp_e
4737 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4739 xi=0.5D0*(c(1,i)+c(1,i+1))
4740 yi=0.5D0*(c(2,i)+c(2,i+1))
4741 zi=0.5D0*(c(3,i)+c(3,i+1))
4742 C Return atom into box, boxxsize is size of box in x dimension
4744 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4745 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4746 C Condition for being inside the proper box
4747 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4748 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4752 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4753 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4754 C Condition for being inside the proper box
4755 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4756 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4760 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4761 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4762 cC Condition for being inside the proper box
4763 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4764 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4768 if (xi.lt.0) xi=xi+boxxsize
4770 if (yi.lt.0) yi=yi+boxysize
4772 if (zi.lt.0) zi=zi+boxzsize
4773 C xi=xi+xshift*boxxsize
4774 C yi=yi+yshift*boxysize
4775 C zi=zi+zshift*boxzsize
4776 do iint=1,nscp_gr(i)
4778 do j=iscpstart(i,iint),iscpend(i,iint)
4779 if (itype(j).eq.ntyp1) cycle
4780 itypj=iabs(itype(j))
4781 C Uncomment following three lines for SC-p interactions
4785 C Uncomment following three lines for Ca-p interactions
4790 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4791 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4792 C Condition for being inside the proper box
4793 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4794 c & (xj.lt.((-0.5d0)*boxxsize))) then
4798 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4799 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4800 cC Condition for being inside the proper box
4801 c if ((yj.gt.((0.5d0)*boxysize)).or.
4802 c & (yj.lt.((-0.5d0)*boxysize))) then
4806 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4807 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4808 C Condition for being inside the proper box
4809 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4810 c & (zj.lt.((-0.5d0)*boxzsize))) then
4813 if (xj.lt.0) xj=xj+boxxsize
4815 if (yj.lt.0) yj=yj+boxysize
4817 if (zj.lt.0) zj=zj+boxzsize
4818 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4826 xj=xj_safe+xshift*boxxsize
4827 yj=yj_safe+yshift*boxysize
4828 zj=zj_safe+zshift*boxzsize
4829 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4830 if(dist_temp.lt.dist_init) then
4840 if (subchap.eq.1) then
4853 rij=xj*xj+yj*yj+zj*zj
4857 if (rij.lt.r0ijsq) then
4858 evdwij=0.25d0*(rij-r0ijsq)**2
4866 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4871 cgrad if (j.lt.i) then
4872 cd write (iout,*) 'j<i'
4873 C Uncomment following three lines for SC-p interactions
4875 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4878 cd write (iout,*) 'j>i'
4880 cgrad ggg(k)=-ggg(k)
4881 C Uncomment following line for SC-p interactions
4882 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4886 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4888 cgrad kstart=min0(i+1,j)
4889 cgrad kend=max0(i-1,j-1)
4890 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4891 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4892 cgrad do k=kstart,kend
4894 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4898 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4899 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4910 C-----------------------------------------------------------------------------
4911 subroutine escp(evdw2,evdw2_14)
4913 C This subroutine calculates the excluded-volume interaction energy between
4914 C peptide-group centers and side chains and its gradient in virtual-bond and
4915 C side-chain vectors.
4917 implicit real*8 (a-h,o-z)
4918 include 'DIMENSIONS'
4919 include 'COMMON.GEO'
4920 include 'COMMON.VAR'
4921 include 'COMMON.LOCAL'
4922 include 'COMMON.CHAIN'
4923 include 'COMMON.DERIV'
4924 include 'COMMON.INTERACT'
4925 include 'COMMON.FFIELD'
4926 include 'COMMON.IOUNITS'
4927 include 'COMMON.CONTROL'
4928 include 'COMMON.SPLITELE'
4932 c print *,boxxsize,boxysize,boxzsize,'wymiary pudla'
4933 cd print '(a)','Enter ESCP'
4934 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4938 do i=iatscp_s,iatscp_e
4939 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4941 xi=0.5D0*(c(1,i)+c(1,i+1))
4942 yi=0.5D0*(c(2,i)+c(2,i+1))
4943 zi=0.5D0*(c(3,i)+c(3,i+1))
4945 if (xi.lt.0) xi=xi+boxxsize
4947 if (yi.lt.0) yi=yi+boxysize
4949 if (zi.lt.0) zi=zi+boxzsize
4950 c xi=xi+xshift*boxxsize
4951 c yi=yi+yshift*boxysize
4952 c zi=zi+zshift*boxzsize
4953 c print *,xi,yi,zi,'polozenie i'
4954 C Return atom into box, boxxsize is size of box in x dimension
4956 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4957 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4958 C Condition for being inside the proper box
4959 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4960 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4964 c print *,xi,boxxsize,"pierwszy"
4966 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4967 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4968 C Condition for being inside the proper box
4969 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4970 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4974 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4975 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4976 C Condition for being inside the proper box
4977 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4978 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4981 do iint=1,nscp_gr(i)
4983 do j=iscpstart(i,iint),iscpend(i,iint)
4984 itypj=iabs(itype(j))
4985 if (itypj.eq.ntyp1) cycle
4986 C Uncomment following three lines for SC-p interactions
4990 C Uncomment following three lines for Ca-p interactions
4995 if (xj.lt.0) xj=xj+boxxsize
4997 if (yj.lt.0) yj=yj+boxysize
4999 if (zj.lt.0) zj=zj+boxzsize
5001 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
5002 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
5003 C Condition for being inside the proper box
5004 c if ((xj.gt.((0.5d0)*boxxsize)).or.
5005 c & (xj.lt.((-0.5d0)*boxxsize))) then
5009 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
5010 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
5011 cC Condition for being inside the proper box
5012 c if ((yj.gt.((0.5d0)*boxysize)).or.
5013 c & (yj.lt.((-0.5d0)*boxysize))) then
5017 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
5018 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
5019 C Condition for being inside the proper box
5020 c if ((zj.gt.((0.5d0)*boxzsize)).or.
5021 c & (zj.lt.((-0.5d0)*boxzsize))) then
5024 CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE
5025 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5033 xj=xj_safe+xshift*boxxsize
5034 yj=yj_safe+yshift*boxysize
5035 zj=zj_safe+zshift*boxzsize
5036 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5037 if(dist_temp.lt.dist_init) then
5047 if (subchap.eq.1) then
5056 c print *,xj,yj,zj,'polozenie j'
5057 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5059 sss=sscale(1.0d0/(dsqrt(rrij)))
5060 c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz'
5061 c if (sss.eq.0) print *,'czasem jest OK'
5062 if (sss.le.0.0d0) cycle
5063 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
5065 e1=fac*fac*aad(itypj,iteli)
5066 e2=fac*bad(itypj,iteli)
5067 if (iabs(j-i) .le. 2) then
5070 evdw2_14=evdw2_14+(e1+e2)*sss
5073 evdw2=evdw2+evdwij*sss
5074 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
5075 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
5078 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5080 fac=-(evdwij+e1)*rrij*sss
5081 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
5085 cgrad if (j.lt.i) then
5086 cd write (iout,*) 'j<i'
5087 C Uncomment following three lines for SC-p interactions
5089 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5092 cd write (iout,*) 'j>i'
5094 cgrad ggg(k)=-ggg(k)
5095 C Uncomment following line for SC-p interactions
5096 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5097 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5101 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5103 cgrad kstart=min0(i+1,j)
5104 cgrad kend=max0(i-1,j-1)
5105 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5106 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5107 cgrad do k=kstart,kend
5109 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5113 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5114 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5116 c endif !endif for sscale cutoff
5126 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
5127 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
5128 gradx_scp(j,i)=expon*gradx_scp(j,i)
5131 C******************************************************************************
5135 C To save time the factor EXPON has been extracted from ALL components
5136 C of GVDWC and GRADX. Remember to multiply them by this factor before further
5139 C******************************************************************************
5142 C--------------------------------------------------------------------------
5143 subroutine edis(ehpb)
5145 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
5147 implicit real*8 (a-h,o-z)
5148 include 'DIMENSIONS'
5149 include 'COMMON.SBRIDGE'
5150 include 'COMMON.CHAIN'
5151 include 'COMMON.DERIV'
5152 include 'COMMON.VAR'
5153 include 'COMMON.INTERACT'
5154 include 'COMMON.IOUNITS'
5155 include 'COMMON.CONTROL'
5161 C write (iout,*) ,"link_end",link_end,constr_dist
5162 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
5163 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
5164 if (link_end.eq.0) return
5165 do i=link_start,link_end
5166 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
5167 C CA-CA distance used in regularization of structure.
5170 C iii and jjj point to the residues for which the distance is assigned.
5171 if (ii.gt.nres) then
5178 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
5179 c & dhpb(i),dhpb1(i),forcon(i)
5180 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
5181 C distance and angle dependent SS bond potential.
5182 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5183 C & iabs(itype(jjj)).eq.1) then
5184 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5185 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
5186 if (.not.dyn_ss .and. i.le.nss) then
5187 C 15/02/13 CC dynamic SSbond - additional check
5188 if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5189 & iabs(itype(jjj)).eq.1) then
5190 call ssbond_ene(iii,jjj,eij)
5193 cd write (iout,*) "eij",eij
5194 cd & ' waga=',waga,' fac=',fac
5195 else if (ii.gt.nres .and. jj.gt.nres) then
5196 c Restraints from contact prediction
5198 if (constr_dist.eq.11) then
5199 ehpb=ehpb+fordepth(i)**4.0d0
5200 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5201 fac=fordepth(i)**4.0d0
5202 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5203 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
5204 & ehpb,fordepth(i),dd
5206 if (dhpb1(i).gt.0.0d0) then
5207 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5208 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5209 c write (iout,*) "beta nmr",
5210 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5214 C Get the force constant corresponding to this distance.
5216 C Calculate the contribution to energy.
5217 ehpb=ehpb+waga*rdis*rdis
5218 c write (iout,*) "beta reg",dd,waga*rdis*rdis
5220 C Evaluate gradient.
5226 ggg(j)=fac*(c(j,jj)-c(j,ii))
5229 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5230 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5233 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5234 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5237 C Calculate the distance between the two points and its difference from the
5240 if (constr_dist.eq.11) then
5241 ehpb=ehpb+fordepth(i)**4.0d0
5242 & *rlornmr1(dd,dhpb(i),dhpb1(i),forcon(i))
5243 fac=fordepth(i)**4.0d0
5244 & *rlornmr1prim(dd,dhpb(i),dhpb1(i),forcon(i))/dd
5245 if (energy_dec) write (iout,'(a6,2i5,3f8.3)') "edisl",ii,jj,
5246 & ehpb,fordepth(i),dd
5248 if (dhpb1(i).gt.0.0d0) then
5249 ehpb=ehpb+2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5250 fac=forcon(i)*gnmr1prim(dd,dhpb(i),dhpb1(i))/dd
5251 c write (iout,*) "alph nmr",
5252 c & dd,2*forcon(i)*gnmr1(dd,dhpb(i),dhpb1(i))
5255 C Get the force constant corresponding to this distance.
5257 C Calculate the contribution to energy.
5258 ehpb=ehpb+waga*rdis*rdis
5259 c write (iout,*) "alpha reg",dd,waga*rdis*rdis
5261 C Evaluate gradient.
5267 ggg(j)=fac*(c(j,jj)-c(j,ii))
5269 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
5270 C If this is a SC-SC distance, we need to calculate the contributions to the
5271 C Cartesian gradient in the SC vectors (ghpbx).
5274 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5275 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5278 cgrad do j=iii,jjj-1
5280 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
5284 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5285 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5289 if (constr_dist.ne.11) ehpb=0.5D0*ehpb
5292 C--------------------------------------------------------------------------
5293 subroutine ssbond_ene(i,j,eij)
5295 C Calculate the distance and angle dependent SS-bond potential energy
5296 C using a free-energy function derived based on RHF/6-31G** ab initio
5297 C calculations of diethyl disulfide.
5299 C A. Liwo and U. Kozlowska, 11/24/03
5301 implicit real*8 (a-h,o-z)
5302 include 'DIMENSIONS'
5303 include 'COMMON.SBRIDGE'
5304 include 'COMMON.CHAIN'
5305 include 'COMMON.DERIV'
5306 include 'COMMON.LOCAL'
5307 include 'COMMON.INTERACT'
5308 include 'COMMON.VAR'
5309 include 'COMMON.IOUNITS'
5310 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
5311 itypi=iabs(itype(i))
5315 dxi=dc_norm(1,nres+i)
5316 dyi=dc_norm(2,nres+i)
5317 dzi=dc_norm(3,nres+i)
5318 c dsci_inv=dsc_inv(itypi)
5319 dsci_inv=vbld_inv(nres+i)
5320 itypj=iabs(itype(j))
5321 c dscj_inv=dsc_inv(itypj)
5322 dscj_inv=vbld_inv(nres+j)
5326 dxj=dc_norm(1,nres+j)
5327 dyj=dc_norm(2,nres+j)
5328 dzj=dc_norm(3,nres+j)
5329 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5334 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
5335 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
5336 om12=dxi*dxj+dyi*dyj+dzi*dzj
5338 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
5339 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
5345 deltat12=om2-om1+2.0d0
5347 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
5348 & +akct*deltad*deltat12
5349 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
5350 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
5351 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
5352 c & " deltat12",deltat12," eij",eij
5353 ed=2*akcm*deltad+akct*deltat12
5355 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
5356 eom1=-2*akth*deltat1-pom1-om2*pom2
5357 eom2= 2*akth*deltat2+pom1-om1*pom2
5360 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5361 ghpbx(k,i)=ghpbx(k,i)-ggk
5362 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
5363 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
5364 ghpbx(k,j)=ghpbx(k,j)+ggk
5365 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
5366 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
5367 ghpbc(k,i)=ghpbc(k,i)-ggk
5368 ghpbc(k,j)=ghpbc(k,j)+ggk
5371 C Calculate the components of the gradient in DC and X
5375 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
5380 C--------------------------------------------------------------------------
5381 subroutine ebond(estr)
5383 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5385 implicit real*8 (a-h,o-z)
5386 include 'DIMENSIONS'
5387 include 'COMMON.LOCAL'
5388 include 'COMMON.GEO'
5389 include 'COMMON.INTERACT'
5390 include 'COMMON.DERIV'
5391 include 'COMMON.VAR'
5392 include 'COMMON.CHAIN'
5393 include 'COMMON.IOUNITS'
5394 include 'COMMON.NAMES'
5395 include 'COMMON.FFIELD'
5396 include 'COMMON.CONTROL'
5397 include 'COMMON.SETUP'
5398 double precision u(3),ud(3)
5401 do i=ibondp_start,ibondp_end
5402 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
5403 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5405 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
5406 c & *dc(j,i-1)/vbld(i)
5408 c if (energy_dec) write(iout,*)
5409 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5411 C Checking if it involves dummy (NH3+ or COO-) group
5412 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
5413 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
5414 diff = vbld(i)-vbldpDUM
5416 C NO vbldp0 is the equlibrium lenght of spring for peptide group
5417 diff = vbld(i)-vbldp0
5419 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
5420 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5423 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5425 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5428 estr=0.5d0*AKP*estr+estr1
5430 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5432 do i=ibond_start,ibond_end
5434 if (iti.ne.10 .and. iti.ne.ntyp1) then
5437 diff=vbld(i+nres)-vbldsc0(1,iti)
5438 if (energy_dec) write (iout,*)
5439 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
5440 & AKSC(1,iti),AKSC(1,iti)*diff*diff
5441 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5443 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5447 diff=vbld(i+nres)-vbldsc0(j,iti)
5448 ud(j)=aksc(j,iti)*diff
5449 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5463 uprod2=uprod2*u(k)*u(k)
5467 usumsqder=usumsqder+ud(j)*uprod2
5469 estr=estr+uprod/usum
5471 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5479 C--------------------------------------------------------------------------
5480 subroutine ebend(etheta,ethetacnstr)
5482 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5483 C angles gamma and its derivatives in consecutive thetas and gammas.
5485 implicit real*8 (a-h,o-z)
5486 include 'DIMENSIONS'
5487 include 'COMMON.LOCAL'
5488 include 'COMMON.GEO'
5489 include 'COMMON.INTERACT'
5490 include 'COMMON.DERIV'
5491 include 'COMMON.VAR'
5492 include 'COMMON.CHAIN'
5493 include 'COMMON.IOUNITS'
5494 include 'COMMON.NAMES'
5495 include 'COMMON.FFIELD'
5496 include 'COMMON.CONTROL'
5497 include 'COMMON.TORCNSTR'
5498 common /calcthet/ term1,term2,termm,diffak,ratak,
5499 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5500 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5501 double precision y(2),z(2)
5503 c time11=dexp(-2*time)
5506 c write (*,'(a,i2)') 'EBEND ICG=',icg
5507 do i=ithet_start,ithet_end
5508 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5509 & .or.itype(i).eq.ntyp1) cycle
5510 C Zero the energy function and its derivative at 0 or pi.
5511 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5513 ichir1=isign(1,itype(i-2))
5514 ichir2=isign(1,itype(i))
5515 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
5516 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
5517 if (itype(i-1).eq.10) then
5518 itype1=isign(10,itype(i-2))
5519 ichir11=isign(1,itype(i-2))
5520 ichir12=isign(1,itype(i-2))
5521 itype2=isign(10,itype(i))
5522 ichir21=isign(1,itype(i))
5523 ichir22=isign(1,itype(i))
5526 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5529 if (phii.ne.phii) phii=150.0
5539 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5542 if (phii1.ne.phii1) phii1=150.0
5554 C Calculate the "mean" value of theta from the part of the distribution
5555 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5556 C In following comments this theta will be referred to as t_c.
5557 thet_pred_mean=0.0d0
5559 athetk=athet(k,it,ichir1,ichir2)
5560 bthetk=bthet(k,it,ichir1,ichir2)
5562 athetk=athet(k,itype1,ichir11,ichir12)
5563 bthetk=bthet(k,itype2,ichir21,ichir22)
5565 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5566 c write(iout,*) 'chuj tu', y(k),z(k)
5568 dthett=thet_pred_mean*ssd
5569 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5570 C Derivatives of the "mean" values in gamma1 and gamma2.
5571 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
5572 &+athet(2,it,ichir1,ichir2)*y(1))*ss
5573 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
5574 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
5576 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
5577 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
5578 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
5579 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5581 if (theta(i).gt.pi-delta) then
5582 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
5584 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5585 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5586 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
5588 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
5590 else if (theta(i).lt.delta) then
5591 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5592 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5593 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
5595 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5596 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
5599 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
5602 etheta=etheta+ethetai
5603 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
5604 & 'ebend',i,ethetai,theta(i),itype(i)
5605 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5606 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5607 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
5610 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
5611 do i=ithetaconstr_start,ithetaconstr_end
5612 itheta=itheta_constr(i)
5613 thetiii=theta(itheta)
5614 difi=pinorm(thetiii-theta_constr0(i))
5615 if (difi.gt.theta_drange(i)) then
5616 difi=difi-theta_drange(i)
5617 ethetacnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
5618 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
5619 & +for_thet_constr(i)*difi**3
5620 else if (difi.lt.-drange(i)) then
5622 ethetacnstr=ethetcnstr+0.25d0*for_thet_constr(i)*difi**4
5623 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
5624 & +for_thet_constr(i)*difi**3
5628 if (energy_dec) then
5629 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
5630 & i,itheta,rad2deg*thetiii,
5631 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
5632 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
5633 & gloc(itheta+nphi-2,icg)
5637 C Ufff.... We've done all this!!!
5640 C---------------------------------------------------------------------------
5641 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
5643 implicit real*8 (a-h,o-z)
5644 include 'DIMENSIONS'
5645 include 'COMMON.LOCAL'
5646 include 'COMMON.IOUNITS'
5647 common /calcthet/ term1,term2,termm,diffak,ratak,
5648 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5649 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5650 C Calculate the contributions to both Gaussian lobes.
5651 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5652 C The "polynomial part" of the "standard deviation" of this part of
5653 C the distributioni.
5654 ccc write (iout,*) thetai,thet_pred_mean
5657 sig=sig*thet_pred_mean+polthet(j,it)
5659 C Derivative of the "interior part" of the "standard deviation of the"
5660 C gamma-dependent Gaussian lobe in t_c.
5661 sigtc=3*polthet(3,it)
5663 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5666 C Set the parameters of both Gaussian lobes of the distribution.
5667 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5668 fac=sig*sig+sigc0(it)
5671 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5672 sigsqtc=-4.0D0*sigcsq*sigtc
5673 c print *,i,sig,sigtc,sigsqtc
5674 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
5675 sigtc=-sigtc/(fac*fac)
5676 C Following variable is sigma(t_c)**(-2)
5677 sigcsq=sigcsq*sigcsq
5679 sig0inv=1.0D0/sig0i**2
5680 delthec=thetai-thet_pred_mean
5681 delthe0=thetai-theta0i
5682 term1=-0.5D0*sigcsq*delthec*delthec
5683 term2=-0.5D0*sig0inv*delthe0*delthe0
5684 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
5685 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5686 C NaNs in taking the logarithm. We extract the largest exponent which is added
5687 C to the energy (this being the log of the distribution) at the end of energy
5688 C term evaluation for this virtual-bond angle.
5689 if (term1.gt.term2) then
5691 term2=dexp(term2-termm)
5695 term1=dexp(term1-termm)
5698 C The ratio between the gamma-independent and gamma-dependent lobes of
5699 C the distribution is a Gaussian function of thet_pred_mean too.
5700 diffak=gthet(2,it)-thet_pred_mean
5701 ratak=diffak/gthet(3,it)**2
5702 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5703 C Let's differentiate it in thet_pred_mean NOW.
5705 C Now put together the distribution terms to make complete distribution.
5706 termexp=term1+ak*term2
5707 termpre=sigc+ak*sig0i
5708 C Contribution of the bending energy from this theta is just the -log of
5709 C the sum of the contributions from the two lobes and the pre-exponential
5710 C factor. Simple enough, isn't it?
5711 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5712 C write (iout,*) 'termexp',termexp,termm,termpre,i
5713 C NOW the derivatives!!!
5714 C 6/6/97 Take into account the deformation.
5715 E_theta=(delthec*sigcsq*term1
5716 & +ak*delthe0*sig0inv*term2)/termexp
5717 E_tc=((sigtc+aktc*sig0i)/termpre
5718 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
5719 & aktc*term2)/termexp)
5722 c-----------------------------------------------------------------------------
5723 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
5724 implicit real*8 (a-h,o-z)
5725 include 'DIMENSIONS'
5726 include 'COMMON.LOCAL'
5727 include 'COMMON.IOUNITS'
5728 common /calcthet/ term1,term2,termm,diffak,ratak,
5729 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5730 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5731 delthec=thetai-thet_pred_mean
5732 delthe0=thetai-theta0i
5733 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
5734 t3 = thetai-thet_pred_mean
5738 t14 = t12+t6*sigsqtc
5740 t21 = thetai-theta0i
5746 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
5747 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
5748 & *(-t12*t9-ak*sig0inv*t27)
5752 C--------------------------------------------------------------------------
5753 subroutine ebend(etheta,ethetacnstr)
5755 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5756 C angles gamma and its derivatives in consecutive thetas and gammas.
5757 C ab initio-derived potentials from
5758 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5760 implicit real*8 (a-h,o-z)
5761 include 'DIMENSIONS'
5762 include 'COMMON.LOCAL'
5763 include 'COMMON.GEO'
5764 include 'COMMON.INTERACT'
5765 include 'COMMON.DERIV'
5766 include 'COMMON.VAR'
5767 include 'COMMON.CHAIN'
5768 include 'COMMON.IOUNITS'
5769 include 'COMMON.NAMES'
5770 include 'COMMON.FFIELD'
5771 include 'COMMON.CONTROL'
5772 include 'COMMON.TORCNSTR'
5773 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
5774 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
5775 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
5776 & sinph1ph2(maxdouble,maxdouble)
5777 logical lprn /.false./, lprn1 /.false./
5779 do i=ithet_start,ithet_end
5780 c print *,i,itype(i-1),itype(i),itype(i-2)
5781 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5782 & .or.itype(i).eq.ntyp1) cycle
5783 C print *,i,theta(i)
5784 if (iabs(itype(i+1)).eq.20) iblock=2
5785 if (iabs(itype(i+1)).ne.20) iblock=1
5789 theti2=0.5d0*theta(i)
5790 ityp2=ithetyp((itype(i-1)))
5792 coskt(k)=dcos(k*theti2)
5793 sinkt(k)=dsin(k*theti2)
5796 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5799 if (phii.ne.phii) phii=150.0
5803 ityp1=ithetyp((itype(i-2)))
5804 C propagation of chirality for glycine type
5806 cosph1(k)=dcos(k*phii)
5807 sinph1(k)=dsin(k*phii)
5812 ityp1=ithetyp((itype(i-2)))
5817 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5820 if (phii1.ne.phii1) phii1=150.0
5825 ityp3=ithetyp((itype(i)))
5827 cosph2(k)=dcos(k*phii1)
5828 sinph2(k)=dsin(k*phii1)
5832 ityp3=ithetyp((itype(i)))
5838 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5841 ccl=cosph1(l)*cosph2(k-l)
5842 ssl=sinph1(l)*sinph2(k-l)
5843 scl=sinph1(l)*cosph2(k-l)
5844 csl=cosph1(l)*sinph2(k-l)
5845 cosph1ph2(l,k)=ccl-ssl
5846 cosph1ph2(k,l)=ccl+ssl
5847 sinph1ph2(l,k)=scl+csl
5848 sinph1ph2(k,l)=scl-csl
5852 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5853 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5854 write (iout,*) "coskt and sinkt"
5856 write (iout,*) k,coskt(k),sinkt(k)
5860 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5861 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5864 & write (iout,*) "k",k,"
5865 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
5866 & " ethetai",ethetai
5869 write (iout,*) "cosph and sinph"
5871 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5873 write (iout,*) "cosph1ph2 and sinph2ph2"
5876 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5877 & sinph1ph2(l,k),sinph1ph2(k,l)
5880 write(iout,*) "ethetai",ethetai
5885 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5886 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5887 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5888 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5889 ethetai=ethetai+sinkt(m)*aux
5890 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5891 dephii=dephii+k*sinkt(m)*(
5892 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5893 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5894 dephii1=dephii1+k*sinkt(m)*(
5895 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5896 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5898 & write (iout,*) "m",m," k",k," bbthet",
5899 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5900 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5901 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5902 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5903 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5906 C print *,"cosph1", (cosph1(k), k=1,nsingle)
5907 C print *,"cosph2", (cosph2(k), k=1,nsingle)
5908 C print *,"sinph1", (sinph1(k), k=1,nsingle)
5909 C print *,"sinph2", (sinph2(k), k=1,nsingle)
5911 & write(iout,*) "ethetai",ethetai
5912 C print *,"tu",cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5916 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5917 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5918 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5919 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5920 ethetai=ethetai+sinkt(m)*aux
5921 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5922 dephii=dephii+l*sinkt(m)*(
5923 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5924 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5925 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5926 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5927 dephii1=dephii1+(k-l)*sinkt(m)*(
5928 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5929 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5930 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5931 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5933 write (iout,*) "m",m," k",k," l",l," ffthet",
5934 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5935 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5936 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5937 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5938 & " ethetai",ethetai
5939 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5940 & cosph1ph2(k,l)*sinkt(m),
5941 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5950 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5951 & i,theta(i)*rad2deg,phii*rad2deg,
5952 & phii1*rad2deg,ethetai
5954 etheta=etheta+ethetai
5955 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5956 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5957 gloc(nphi+i-2,icg)=gloc(nphi+i-2,icg)+wang*dethetai
5961 C print *,ithetaconstr_start,ithetaconstr_end,"TU"
5962 do i=ithetaconstr_start,ithetaconstr_end
5963 itheta=itheta_constr(i)
5964 thetiii=theta(itheta)
5965 difi=pinorm(thetiii-theta_constr0(i))
5966 if (difi.gt.theta_drange(i)) then
5967 difi=difi-theta_drange(i)
5968 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5969 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
5970 & +for_thet_constr(i)*difi**3
5971 else if (difi.lt.-drange(i)) then
5973 ethetacnstr=ethetacnstr+0.25d0*for_thet_constr(i)*difi**4
5974 gloc(itheta+nphi-2,icg)=gloc(itheta+nphi-2,icg)
5975 & +for_thet_constr(i)*difi**3
5979 if (energy_dec) then
5980 write (iout,'(a6,2i5,4f8.3,2e14.5)') "ethetc",
5981 & i,itheta,rad2deg*thetiii,
5982 & rad2deg*theta_constr0(i), rad2deg*theta_drange(i),
5983 & rad2deg*difi,0.25d0*for_thet_constr(i)*difi**4,
5984 & gloc(itheta+nphi-2,icg)
5992 c-----------------------------------------------------------------------------
5993 subroutine esc(escloc)
5994 C Calculate the local energy of a side chain and its derivatives in the
5995 C corresponding virtual-bond valence angles THETA and the spherical angles
5997 implicit real*8 (a-h,o-z)
5998 include 'DIMENSIONS'
5999 include 'COMMON.GEO'
6000 include 'COMMON.LOCAL'
6001 include 'COMMON.VAR'
6002 include 'COMMON.INTERACT'
6003 include 'COMMON.DERIV'
6004 include 'COMMON.CHAIN'
6005 include 'COMMON.IOUNITS'
6006 include 'COMMON.NAMES'
6007 include 'COMMON.FFIELD'
6008 include 'COMMON.CONTROL'
6009 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
6010 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
6011 common /sccalc/ time11,time12,time112,theti,it,nlobit
6014 c write (iout,'(a)') 'ESC'
6015 do i=loc_start,loc_end
6017 if (it.eq.ntyp1) cycle
6018 if (it.eq.10) goto 1
6019 nlobit=nlob(iabs(it))
6020 c print *,'i=',i,' it=',it,' nlobit=',nlobit
6021 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
6022 theti=theta(i+1)-pipol
6027 if (x(2).gt.pi-delta) then
6031 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6033 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6034 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
6036 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6037 & ddersc0(1),dersc(1))
6038 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
6039 & ddersc0(3),dersc(3))
6041 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6043 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6044 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
6045 & dersc0(2),esclocbi,dersc02)
6046 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
6048 call splinthet(x(2),0.5d0*delta,ss,ssd)
6053 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6055 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6056 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6058 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6060 c write (iout,*) escloci
6061 else if (x(2).lt.delta) then
6065 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
6067 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
6068 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
6070 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6071 & ddersc0(1),dersc(1))
6072 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
6073 & ddersc0(3),dersc(3))
6075 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
6077 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
6078 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
6079 & dersc0(2),esclocbi,dersc02)
6080 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
6085 call splinthet(x(2),0.5d0*delta,ss,ssd)
6087 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
6089 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
6090 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
6092 escloci=ss*escloci+(1.0d0-ss)*esclocbi
6093 c write (iout,*) escloci
6095 call enesc(x,escloci,dersc,ddummy,.false.)
6098 escloc=escloc+escloci
6099 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6100 & 'escloc',i,escloci
6101 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
6103 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
6105 gloc(ialph(i,1),icg)=wscloc*dersc(2)
6106 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
6111 C---------------------------------------------------------------------------
6112 subroutine enesc(x,escloci,dersc,ddersc,mixed)
6113 implicit real*8 (a-h,o-z)
6114 include 'DIMENSIONS'
6115 include 'COMMON.GEO'
6116 include 'COMMON.LOCAL'
6117 include 'COMMON.IOUNITS'
6118 common /sccalc/ time11,time12,time112,theti,it,nlobit
6119 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
6120 double precision contr(maxlob,-1:1)
6122 c write (iout,*) 'it=',it,' nlobit=',nlobit
6126 if (mixed) ddersc(j)=0.0d0
6130 C Because of periodicity of the dependence of the SC energy in omega we have
6131 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
6132 C To avoid underflows, first compute & store the exponents.
6140 z(k)=x(k)-censc(k,j,it)
6145 Axk=Axk+gaussc(l,k,j,it)*z(l)
6151 expfac=expfac+Ax(k,j,iii)*z(k)
6159 C As in the case of ebend, we want to avoid underflows in exponentiation and
6160 C subsequent NaNs and INFs in energy calculation.
6161 C Find the largest exponent
6165 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
6169 cd print *,'it=',it,' emin=',emin
6171 C Compute the contribution to SC energy and derivatives
6176 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
6177 if(adexp.ne.adexp) adexp=1.0
6180 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
6182 cd print *,'j=',j,' expfac=',expfac
6183 escloc_i=escloc_i+expfac
6185 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
6189 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
6190 & +gaussc(k,2,j,it))*expfac
6197 dersc(1)=dersc(1)/cos(theti)**2
6198 ddersc(1)=ddersc(1)/cos(theti)**2
6201 escloci=-(dlog(escloc_i)-emin)
6203 dersc(j)=dersc(j)/escloc_i
6207 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
6212 C------------------------------------------------------------------------------
6213 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
6214 implicit real*8 (a-h,o-z)
6215 include 'DIMENSIONS'
6216 include 'COMMON.GEO'
6217 include 'COMMON.LOCAL'
6218 include 'COMMON.IOUNITS'
6219 common /sccalc/ time11,time12,time112,theti,it,nlobit
6220 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
6221 double precision contr(maxlob)
6232 z(k)=x(k)-censc(k,j,it)
6238 Axk=Axk+gaussc(l,k,j,it)*z(l)
6244 expfac=expfac+Ax(k,j)*z(k)
6249 C As in the case of ebend, we want to avoid underflows in exponentiation and
6250 C subsequent NaNs and INFs in energy calculation.
6251 C Find the largest exponent
6254 if (emin.gt.contr(j)) emin=contr(j)
6258 C Compute the contribution to SC energy and derivatives
6262 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6263 escloc_i=escloc_i+expfac
6265 dersc(k)=dersc(k)+Ax(k,j)*expfac
6267 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
6268 & +gaussc(1,2,j,it))*expfac
6272 dersc(1)=dersc(1)/cos(theti)**2
6273 dersc12=dersc12/cos(theti)**2
6274 escloci=-(dlog(escloc_i)-emin)
6276 dersc(j)=dersc(j)/escloc_i
6278 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6282 c----------------------------------------------------------------------------------
6283 subroutine esc(escloc)
6284 C Calculate the local energy of a side chain and its derivatives in the
6285 C corresponding virtual-bond valence angles THETA and the spherical angles
6286 C ALPHA and OMEGA derived from AM1 all-atom calculations.
6287 C added by Urszula Kozlowska. 07/11/2007
6289 implicit real*8 (a-h,o-z)
6290 include 'DIMENSIONS'
6291 include 'COMMON.GEO'
6292 include 'COMMON.LOCAL'
6293 include 'COMMON.VAR'
6294 include 'COMMON.SCROT'
6295 include 'COMMON.INTERACT'
6296 include 'COMMON.DERIV'
6297 include 'COMMON.CHAIN'
6298 include 'COMMON.IOUNITS'
6299 include 'COMMON.NAMES'
6300 include 'COMMON.FFIELD'
6301 include 'COMMON.CONTROL'
6302 include 'COMMON.VECTORS'
6303 double precision x_prime(3),y_prime(3),z_prime(3)
6304 & , sumene,dsc_i,dp2_i,x(65),
6305 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
6306 & de_dxx,de_dyy,de_dzz,de_dt
6307 double precision s1_t,s1_6_t,s2_t,s2_6_t
6309 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
6310 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
6311 & dt_dCi(3),dt_dCi1(3)
6312 common /sccalc/ time11,time12,time112,theti,it,nlobit
6315 do i=loc_start,loc_end
6316 if (itype(i).eq.ntyp1) cycle
6317 costtab(i+1) =dcos(theta(i+1))
6318 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6319 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6320 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6321 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6322 cosfac=dsqrt(cosfac2)
6323 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6324 sinfac=dsqrt(sinfac2)
6326 if (it.eq.10) goto 1
6328 C Compute the axes of tghe local cartesian coordinates system; store in
6329 c x_prime, y_prime and z_prime
6336 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6337 C & dc_norm(3,i+nres)
6339 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6340 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6343 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
6346 c write (2,*) "x_prime",(x_prime(j),j=1,3)
6347 c write (2,*) "y_prime",(y_prime(j),j=1,3)
6348 c write (2,*) "z_prime",(z_prime(j),j=1,3)
6349 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6350 c & " xy",scalar(x_prime(1),y_prime(1)),
6351 c & " xz",scalar(x_prime(1),z_prime(1)),
6352 c & " yy",scalar(y_prime(1),y_prime(1)),
6353 c & " yz",scalar(y_prime(1),z_prime(1)),
6354 c & " zz",scalar(z_prime(1),z_prime(1))
6356 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6357 C to local coordinate system. Store in xx, yy, zz.
6363 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6364 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6365 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6372 C Compute the energy of the ith side cbain
6374 c write (2,*) "xx",xx," yy",yy," zz",zz
6377 x(j) = sc_parmin(j,it)
6380 Cc diagnostics - remove later
6382 yy1 = dsin(alph(2))*dcos(omeg(2))
6383 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
6384 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
6385 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
6387 C," --- ", xx_w,yy_w,zz_w
6390 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6391 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6393 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6394 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6396 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6397 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6398 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6399 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6400 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6402 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6403 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6404 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6405 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6406 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6408 dsc_i = 0.743d0+x(61)
6410 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6411 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6412 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6413 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6414 s1=(1+x(63))/(0.1d0 + dscp1)
6415 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6416 s2=(1+x(65))/(0.1d0 + dscp2)
6417 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6418 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
6419 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6420 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6422 c & dscp1,dscp2,sumene
6423 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6424 escloc = escloc + sumene
6425 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
6430 C This section to check the numerical derivatives of the energy of ith side
6431 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6432 C #define DEBUG in the code to turn it on.
6434 write (2,*) "sumene =",sumene
6438 write (2,*) xx,yy,zz
6439 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6440 de_dxx_num=(sumenep-sumene)/aincr
6442 write (2,*) "xx+ sumene from enesc=",sumenep
6445 write (2,*) xx,yy,zz
6446 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6447 de_dyy_num=(sumenep-sumene)/aincr
6449 write (2,*) "yy+ sumene from enesc=",sumenep
6452 write (2,*) xx,yy,zz
6453 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6454 de_dzz_num=(sumenep-sumene)/aincr
6456 write (2,*) "zz+ sumene from enesc=",sumenep
6457 costsave=cost2tab(i+1)
6458 sintsave=sint2tab(i+1)
6459 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6460 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6461 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6462 de_dt_num=(sumenep-sumene)/aincr
6463 write (2,*) " t+ sumene from enesc=",sumenep
6464 cost2tab(i+1)=costsave
6465 sint2tab(i+1)=sintsave
6466 C End of diagnostics section.
6469 C Compute the gradient of esc
6471 c zz=zz*dsign(1.0,dfloat(itype(i)))
6472 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6473 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6474 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6475 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6476 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6477 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6478 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6479 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6480 pom1=(sumene3*sint2tab(i+1)+sumene1)
6481 & *(pom_s1/dscp1+pom_s16*dscp1**4)
6482 pom2=(sumene4*cost2tab(i+1)+sumene2)
6483 & *(pom_s2/dscp2+pom_s26*dscp2**4)
6484 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6485 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
6486 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
6488 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6489 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
6490 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
6492 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
6493 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
6494 & +(pom1+pom2)*pom_dx
6496 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
6499 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6500 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
6501 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
6503 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6504 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
6505 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
6506 & +x(59)*zz**2 +x(60)*xx*zz
6507 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
6508 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
6509 & +(pom1-pom2)*pom_dy
6511 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
6514 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
6515 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
6516 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
6517 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
6518 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
6519 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
6520 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
6521 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6523 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
6526 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
6527 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
6528 & +pom1*pom_dt1+pom2*pom_dt2
6530 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
6535 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6536 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6537 cosfac2xx=cosfac2*xx
6538 sinfac2yy=sinfac2*yy
6540 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
6542 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
6544 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6545 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6546 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6547 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6548 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6549 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6550 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6551 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6552 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6553 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6557 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
6558 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6559 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
6560 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6563 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6564 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6565 dZZ_XYZ(k)=vbld_inv(i+nres)*
6566 & (z_prime(k)-zz*dC_norm(k,i+nres))
6568 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6569 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6573 dXX_Ctab(k,i)=dXX_Ci(k)
6574 dXX_C1tab(k,i)=dXX_Ci1(k)
6575 dYY_Ctab(k,i)=dYY_Ci(k)
6576 dYY_C1tab(k,i)=dYY_Ci1(k)
6577 dZZ_Ctab(k,i)=dZZ_Ci(k)
6578 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6579 dXX_XYZtab(k,i)=dXX_XYZ(k)
6580 dYY_XYZtab(k,i)=dYY_XYZ(k)
6581 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6585 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6586 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6587 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6588 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
6589 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6591 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6592 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6593 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
6594 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6595 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
6596 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6597 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
6598 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6600 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6601 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6603 C to check gradient call subroutine check_grad
6609 c------------------------------------------------------------------------------
6610 double precision function enesc(x,xx,yy,zz,cost2,sint2)
6612 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
6613 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
6614 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6615 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6617 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6618 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6620 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6621 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6622 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6623 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6624 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6626 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6627 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6628 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6629 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6630 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6632 dsc_i = 0.743d0+x(61)
6634 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6635 & *(xx*cost2+yy*sint2))
6636 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6637 & *(xx*cost2-yy*sint2))
6638 s1=(1+x(63))/(0.1d0 + dscp1)
6639 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6640 s2=(1+x(65))/(0.1d0 + dscp2)
6641 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6642 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
6643 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
6648 c------------------------------------------------------------------------------
6649 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6651 C This procedure calculates two-body contact function g(rij) and its derivative:
6654 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6657 C where x=(rij-r0ij)/delta
6659 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6662 double precision rij,r0ij,eps0ij,fcont,fprimcont
6663 double precision x,x2,x4,delta
6667 if (x.lt.-1.0D0) then
6670 else if (x.le.1.0D0) then
6673 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6674 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6681 c------------------------------------------------------------------------------
6682 subroutine splinthet(theti,delta,ss,ssder)
6683 implicit real*8 (a-h,o-z)
6684 include 'DIMENSIONS'
6685 include 'COMMON.VAR'
6686 include 'COMMON.GEO'
6689 if (theti.gt.pipol) then
6690 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6692 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6697 c------------------------------------------------------------------------------
6698 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6700 double precision x,x0,delta,f0,f1,fprim0,f,fprim
6701 double precision ksi,ksi2,ksi3,a1,a2,a3
6702 a1=fprim0*delta/(f1-f0)
6708 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6709 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6712 c------------------------------------------------------------------------------
6713 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6715 double precision x,x0,delta,f0x,f1x,fprim0x,fx
6716 double precision ksi,ksi2,ksi3,a1,a2,a3
6721 a2=3*(f1x-f0x)-2*fprim0x*delta
6722 a3=fprim0x*delta-2*(f1x-f0x)
6723 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6726 C-----------------------------------------------------------------------------
6728 C-----------------------------------------------------------------------------
6729 subroutine etor(etors,edihcnstr)
6730 implicit real*8 (a-h,o-z)
6731 include 'DIMENSIONS'
6732 include 'COMMON.VAR'
6733 include 'COMMON.GEO'
6734 include 'COMMON.LOCAL'
6735 include 'COMMON.TORSION'
6736 include 'COMMON.INTERACT'
6737 include 'COMMON.DERIV'
6738 include 'COMMON.CHAIN'
6739 include 'COMMON.NAMES'
6740 include 'COMMON.IOUNITS'
6741 include 'COMMON.FFIELD'
6742 include 'COMMON.TORCNSTR'
6743 include 'COMMON.CONTROL'
6745 C Set lprn=.true. for debugging
6749 do i=iphi_start,iphi_end
6751 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6752 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6753 itori=itortyp(itype(i-2))
6754 itori1=itortyp(itype(i-1))
6757 C Proline-Proline pair is a special case...
6758 if (itori.eq.3 .and. itori1.eq.3) then
6759 if (phii.gt.-dwapi3) then
6761 fac=1.0D0/(1.0D0-cosphi)
6762 etorsi=v1(1,3,3)*fac
6763 etorsi=etorsi+etorsi
6764 etors=etors+etorsi-v1(1,3,3)
6765 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
6766 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6769 v1ij=v1(j+1,itori,itori1)
6770 v2ij=v2(j+1,itori,itori1)
6773 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6774 if (energy_dec) etors_ii=etors_ii+
6775 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6776 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6780 v1ij=v1(j,itori,itori1)
6781 v2ij=v2(j,itori,itori1)
6784 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6785 if (energy_dec) etors_ii=etors_ii+
6786 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6787 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6790 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6793 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6794 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6795 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6796 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6797 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6799 ! 6/20/98 - dihedral angle constraints
6802 itori=idih_constr(i)
6805 if (difi.gt.drange(i)) then
6807 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6808 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6809 else if (difi.lt.-drange(i)) then
6811 edihcnstr=edihcnstr+0.25d0*ftors(i)**difi**4
6812 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6814 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6815 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6817 ! write (iout,*) 'edihcnstr',edihcnstr
6820 c------------------------------------------------------------------------------
6821 subroutine etor_d(etors_d)
6825 c----------------------------------------------------------------------------
6827 subroutine etor(etors,edihcnstr)
6828 implicit real*8 (a-h,o-z)
6829 include 'DIMENSIONS'
6830 include 'COMMON.VAR'
6831 include 'COMMON.GEO'
6832 include 'COMMON.LOCAL'
6833 include 'COMMON.TORSION'
6834 include 'COMMON.INTERACT'
6835 include 'COMMON.DERIV'
6836 include 'COMMON.CHAIN'
6837 include 'COMMON.NAMES'
6838 include 'COMMON.IOUNITS'
6839 include 'COMMON.FFIELD'
6840 include 'COMMON.TORCNSTR'
6841 include 'COMMON.CONTROL'
6843 C Set lprn=.true. for debugging
6847 do i=iphi_start,iphi_end
6848 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6849 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6850 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
6851 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
6852 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6853 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6854 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6855 C For introducing the NH3+ and COO- group please check the etor_d for reference
6858 if (iabs(itype(i)).eq.20) then
6863 itori=itortyp(itype(i-2))
6864 itori1=itortyp(itype(i-1))
6867 C Regular cosine and sine terms
6868 do j=1,nterm(itori,itori1,iblock)
6869 v1ij=v1(j,itori,itori1,iblock)
6870 v2ij=v2(j,itori,itori1,iblock)
6873 etors=etors+v1ij*cosphi+v2ij*sinphi
6874 if (energy_dec) etors_ii=etors_ii+
6875 & v1ij*cosphi+v2ij*sinphi
6876 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6880 C E = SUM ----------------------------------- - v1
6881 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6883 cosphi=dcos(0.5d0*phii)
6884 sinphi=dsin(0.5d0*phii)
6885 do j=1,nlor(itori,itori1,iblock)
6886 vl1ij=vlor1(j,itori,itori1)
6887 vl2ij=vlor2(j,itori,itori1)
6888 vl3ij=vlor3(j,itori,itori1)
6889 pom=vl2ij*cosphi+vl3ij*sinphi
6890 pom1=1.0d0/(pom*pom+1.0d0)
6891 etors=etors+vl1ij*pom1
6892 if (energy_dec) etors_ii=etors_ii+
6895 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6897 C Subtract the constant term
6898 etors=etors-v0(itori,itori1,iblock)
6899 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6900 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
6902 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6903 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6904 & (v1(j,itori,itori1,iblock),j=1,6),
6905 & (v2(j,itori,itori1,iblock),j=1,6)
6906 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6907 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6909 ! 6/20/98 - dihedral angle constraints
6911 c do i=1,ndih_constr
6912 do i=idihconstr_start,idihconstr_end
6913 itori=idih_constr(i)
6915 difi=pinorm(phii-phi0(i))
6916 if (difi.gt.drange(i)) then
6918 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6919 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6920 else if (difi.lt.-drange(i)) then
6922 edihcnstr=edihcnstr+0.25d0*ftors(i)*difi**4
6923 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors(i)*difi**3
6927 if (energy_dec) then
6928 write (iout,'(a6,2i5,4f8.3,2e14.5)') "edihc",
6929 & i,itori,rad2deg*phii,
6930 & rad2deg*phi0(i), rad2deg*drange(i),
6931 & rad2deg*difi,0.25d0*ftors(i)*difi**4,gloc(itori-3,icg)
6934 cd write (iout,*) 'edihcnstr',edihcnstr
6937 c----------------------------------------------------------------------------
6938 subroutine etor_d(etors_d)
6939 C 6/23/01 Compute double torsional energy
6940 implicit real*8 (a-h,o-z)
6941 include 'DIMENSIONS'
6942 include 'COMMON.VAR'
6943 include 'COMMON.GEO'
6944 include 'COMMON.LOCAL'
6945 include 'COMMON.TORSION'
6946 include 'COMMON.INTERACT'
6947 include 'COMMON.DERIV'
6948 include 'COMMON.CHAIN'
6949 include 'COMMON.NAMES'
6950 include 'COMMON.IOUNITS'
6951 include 'COMMON.FFIELD'
6952 include 'COMMON.TORCNSTR'
6954 C Set lprn=.true. for debugging
6958 c write(iout,*) "a tu??"
6959 do i=iphid_start,iphid_end
6960 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6961 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6962 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
6963 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
6964 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
6965 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
6966 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
6967 & (itype(i+1).eq.ntyp1)) cycle
6968 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6969 itori=itortyp(itype(i-2))
6970 itori1=itortyp(itype(i-1))
6971 itori2=itortyp(itype(i))
6977 if (iabs(itype(i+1)).eq.20) iblock=2
6978 C Iblock=2 Proline type
6979 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
6980 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
6981 C if (itype(i+1).eq.ntyp1) iblock=3
6982 C The problem of NH3+ group can be resolved by adding new parameters please note if there
6983 C IS or IS NOT need for this
6984 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
6985 C is (itype(i-3).eq.ntyp1) ntblock=2
6986 C ntblock is N-terminal blocking group
6988 C Regular cosine and sine terms
6989 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6990 C Example of changes for NH3+ blocking group
6991 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
6992 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
6993 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6994 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6995 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6996 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6997 cosphi1=dcos(j*phii)
6998 sinphi1=dsin(j*phii)
6999 cosphi2=dcos(j*phii1)
7000 sinphi2=dsin(j*phii1)
7001 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
7002 & v2cij*cosphi2+v2sij*sinphi2
7003 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
7004 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
7006 do k=2,ntermd_2(itori,itori1,itori2,iblock)
7008 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
7009 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
7010 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
7011 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
7012 cosphi1p2=dcos(l*phii+(k-l)*phii1)
7013 cosphi1m2=dcos(l*phii-(k-l)*phii1)
7014 sinphi1p2=dsin(l*phii+(k-l)*phii1)
7015 sinphi1m2=dsin(l*phii-(k-l)*phii1)
7016 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
7017 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
7018 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
7019 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
7020 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
7021 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
7024 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
7025 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
7030 c------------------------------------------------------------------------------
7031 subroutine eback_sc_corr(esccor)
7032 c 7/21/2007 Correlations between the backbone-local and side-chain-local
7033 c conformational states; temporarily implemented as differences
7034 c between UNRES torsional potentials (dependent on three types of
7035 c residues) and the torsional potentials dependent on all 20 types
7036 c of residues computed from AM1 energy surfaces of terminally-blocked
7037 c amino-acid residues.
7038 implicit real*8 (a-h,o-z)
7039 include 'DIMENSIONS'
7040 include 'COMMON.VAR'
7041 include 'COMMON.GEO'
7042 include 'COMMON.LOCAL'
7043 include 'COMMON.TORSION'
7044 include 'COMMON.SCCOR'
7045 include 'COMMON.INTERACT'
7046 include 'COMMON.DERIV'
7047 include 'COMMON.CHAIN'
7048 include 'COMMON.NAMES'
7049 include 'COMMON.IOUNITS'
7050 include 'COMMON.FFIELD'
7051 include 'COMMON.CONTROL'
7053 C Set lprn=.true. for debugging
7056 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
7058 do i=itau_start,itau_end
7059 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
7061 isccori=isccortyp(itype(i-2))
7062 isccori1=isccortyp(itype(i-1))
7063 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
7065 do intertyp=1,3 !intertyp
7066 cc Added 09 May 2012 (Adasko)
7067 cc Intertyp means interaction type of backbone mainchain correlation:
7068 c 1 = SC...Ca...Ca...Ca
7069 c 2 = Ca...Ca...Ca...SC
7070 c 3 = SC...Ca...Ca...SCi
7072 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
7073 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
7074 & (itype(i-1).eq.ntyp1)))
7075 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
7076 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
7077 & .or.(itype(i).eq.ntyp1)))
7078 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
7079 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
7080 & (itype(i-3).eq.ntyp1)))) cycle
7081 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
7082 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
7084 do j=1,nterm_sccor(isccori,isccori1)
7085 v1ij=v1sccor(j,intertyp,isccori,isccori1)
7086 v2ij=v2sccor(j,intertyp,isccori,isccori1)
7087 cosphi=dcos(j*tauangle(intertyp,i))
7088 sinphi=dsin(j*tauangle(intertyp,i))
7089 esccor=esccor+v1ij*cosphi+v2ij*sinphi
7090 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
7092 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
7093 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
7095 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
7096 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
7097 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
7098 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
7099 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
7105 c----------------------------------------------------------------------------
7106 subroutine multibody(ecorr)
7107 C This subroutine calculates multi-body contributions to energy following
7108 C the idea of Skolnick et al. If side chains I and J make a contact and
7109 C at the same time side chains I+1 and J+1 make a contact, an extra
7110 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
7111 implicit real*8 (a-h,o-z)
7112 include 'DIMENSIONS'
7113 include 'COMMON.IOUNITS'
7114 include 'COMMON.DERIV'
7115 include 'COMMON.INTERACT'
7116 include 'COMMON.CONTACTS'
7117 double precision gx(3),gx1(3)
7120 C Set lprn=.true. for debugging
7124 write (iout,'(a)') 'Contact function values:'
7126 write (iout,'(i2,20(1x,i2,f10.5))')
7127 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
7142 num_conti=num_cont(i)
7143 num_conti1=num_cont(i1)
7148 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
7149 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7150 cd & ' ishift=',ishift
7151 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
7152 C The system gains extra energy.
7153 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
7154 endif ! j1==j+-ishift
7163 c------------------------------------------------------------------------------
7164 double precision function esccorr(i,j,k,l,jj,kk)
7165 implicit real*8 (a-h,o-z)
7166 include 'DIMENSIONS'
7167 include 'COMMON.IOUNITS'
7168 include 'COMMON.DERIV'
7169 include 'COMMON.INTERACT'
7170 include 'COMMON.CONTACTS'
7171 double precision gx(3),gx1(3)
7176 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7177 C Calculate the multi-body contribution to energy.
7178 C Calculate multi-body contributions to the gradient.
7179 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7180 cd & k,l,(gacont(m,kk,k),m=1,3)
7182 gx(m) =ekl*gacont(m,jj,i)
7183 gx1(m)=eij*gacont(m,kk,k)
7184 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7185 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7186 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7187 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7191 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7196 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7202 c------------------------------------------------------------------------------
7203 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7204 C This subroutine calculates multi-body contributions to hydrogen-bonding
7205 implicit real*8 (a-h,o-z)
7206 include 'DIMENSIONS'
7207 include 'COMMON.IOUNITS'
7210 parameter (max_cont=maxconts)
7211 parameter (max_dim=26)
7212 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7213 double precision zapas(max_dim,maxconts,max_fg_procs),
7214 & zapas_recv(max_dim,maxconts,max_fg_procs)
7215 common /przechowalnia/ zapas
7216 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7217 & status_array(MPI_STATUS_SIZE,maxconts*2)
7219 include 'COMMON.SETUP'
7220 include 'COMMON.FFIELD'
7221 include 'COMMON.DERIV'
7222 include 'COMMON.INTERACT'
7223 include 'COMMON.CONTACTS'
7224 include 'COMMON.CONTROL'
7225 include 'COMMON.LOCAL'
7226 double precision gx(3),gx1(3),time00
7229 C Set lprn=.true. for debugging
7234 if (nfgtasks.le.1) goto 30
7236 write (iout,'(a)') 'Contact function values before RECEIVE:'
7238 write (iout,'(2i3,50(1x,i2,f5.2))')
7239 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7240 & j=1,num_cont_hb(i))
7244 do i=1,ntask_cont_from
7247 do i=1,ntask_cont_to
7250 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7252 C Make the list of contacts to send to send to other procesors
7253 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
7255 do i=iturn3_start,iturn3_end
7256 c write (iout,*) "make contact list turn3",i," num_cont",
7258 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
7260 do i=iturn4_start,iturn4_end
7261 c write (iout,*) "make contact list turn4",i," num_cont",
7263 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
7267 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7269 do j=1,num_cont_hb(i)
7272 iproc=iint_sent_local(k,jjc,ii)
7273 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7274 if (iproc.gt.0) then
7275 ncont_sent(iproc)=ncont_sent(iproc)+1
7276 nn=ncont_sent(iproc)
7278 zapas(2,nn,iproc)=jjc
7279 zapas(3,nn,iproc)=facont_hb(j,i)
7280 zapas(4,nn,iproc)=ees0p(j,i)
7281 zapas(5,nn,iproc)=ees0m(j,i)
7282 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
7283 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
7284 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
7285 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
7286 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
7287 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
7288 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
7289 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
7290 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
7291 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
7292 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
7293 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
7294 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
7295 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
7296 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
7297 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
7298 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
7299 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
7300 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
7301 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
7302 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
7309 & "Numbers of contacts to be sent to other processors",
7310 & (ncont_sent(i),i=1,ntask_cont_to)
7311 write (iout,*) "Contacts sent"
7312 do ii=1,ntask_cont_to
7314 iproc=itask_cont_to(ii)
7315 write (iout,*) nn," contacts to processor",iproc,
7316 & " of CONT_TO_COMM group"
7318 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7326 CorrelID1=nfgtasks+fg_rank+1
7328 C Receive the numbers of needed contacts from other processors
7329 do ii=1,ntask_cont_from
7330 iproc=itask_cont_from(ii)
7332 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7333 & FG_COMM,req(ireq),IERR)
7335 c write (iout,*) "IRECV ended"
7337 C Send the number of contacts needed by other processors
7338 do ii=1,ntask_cont_to
7339 iproc=itask_cont_to(ii)
7341 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7342 & FG_COMM,req(ireq),IERR)
7344 c write (iout,*) "ISEND ended"
7345 c write (iout,*) "number of requests (nn)",ireq
7348 & call MPI_Waitall(ireq,req,status_array,ierr)
7350 c & "Numbers of contacts to be received from other processors",
7351 c & (ncont_recv(i),i=1,ntask_cont_from)
7355 do ii=1,ntask_cont_from
7356 iproc=itask_cont_from(ii)
7358 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7359 c & " of CONT_TO_COMM group"
7363 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7364 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7365 c write (iout,*) "ireq,req",ireq,req(ireq)
7368 C Send the contacts to processors that need them
7369 do ii=1,ntask_cont_to
7370 iproc=itask_cont_to(ii)
7372 c write (iout,*) nn," contacts to processor",iproc,
7373 c & " of CONT_TO_COMM group"
7376 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7377 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7378 c write (iout,*) "ireq,req",ireq,req(ireq)
7380 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7384 c write (iout,*) "number of requests (contacts)",ireq
7385 c write (iout,*) "req",(req(i),i=1,4)
7388 & call MPI_Waitall(ireq,req,status_array,ierr)
7389 do iii=1,ntask_cont_from
7390 iproc=itask_cont_from(iii)
7393 write (iout,*) "Received",nn," contacts from processor",iproc,
7394 & " of CONT_FROM_COMM group"
7397 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
7402 ii=zapas_recv(1,i,iii)
7403 c Flag the received contacts to prevent double-counting
7404 jj=-zapas_recv(2,i,iii)
7405 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7407 nnn=num_cont_hb(ii)+1
7410 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
7411 ees0p(nnn,ii)=zapas_recv(4,i,iii)
7412 ees0m(nnn,ii)=zapas_recv(5,i,iii)
7413 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
7414 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
7415 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
7416 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
7417 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
7418 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
7419 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
7420 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
7421 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
7422 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
7423 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
7424 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
7425 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
7426 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
7427 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
7428 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
7429 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
7430 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
7431 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
7432 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
7433 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
7438 write (iout,'(a)') 'Contact function values after receive:'
7440 write (iout,'(2i3,50(1x,i3,f5.2))')
7441 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7442 & j=1,num_cont_hb(i))
7449 write (iout,'(a)') 'Contact function values:'
7451 write (iout,'(2i3,50(1x,i3,f5.2))')
7452 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7453 & j=1,num_cont_hb(i))
7457 C Remove the loop below after debugging !!!
7464 C Calculate the local-electrostatic correlation terms
7465 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
7467 num_conti=num_cont_hb(i)
7468 num_conti1=num_cont_hb(i+1)
7475 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7476 c & ' jj=',jj,' kk=',kk
7477 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7478 & .or. j.lt.0 .and. j1.gt.0) .and.
7479 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7480 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7481 C The system gains extra energy.
7482 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7483 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
7484 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
7486 else if (j1.eq.j) then
7487 C Contacts I-J and I-(J+1) occur simultaneously.
7488 C The system loses extra energy.
7489 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7494 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7495 c & ' jj=',jj,' kk=',kk
7497 C Contacts I-J and (I+1)-J occur simultaneously.
7498 C The system loses extra energy.
7499 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7506 c------------------------------------------------------------------------------
7507 subroutine add_hb_contact(ii,jj,itask)
7508 implicit real*8 (a-h,o-z)
7509 include "DIMENSIONS"
7510 include "COMMON.IOUNITS"
7513 parameter (max_cont=maxconts)
7514 parameter (max_dim=26)
7515 include "COMMON.CONTACTS"
7516 double precision zapas(max_dim,maxconts,max_fg_procs),
7517 & zapas_recv(max_dim,maxconts,max_fg_procs)
7518 common /przechowalnia/ zapas
7519 integer i,j,ii,jj,iproc,itask(4),nn
7520 c write (iout,*) "itask",itask
7523 if (iproc.gt.0) then
7524 do j=1,num_cont_hb(ii)
7526 c write (iout,*) "i",ii," j",jj," jjc",jjc
7528 ncont_sent(iproc)=ncont_sent(iproc)+1
7529 nn=ncont_sent(iproc)
7530 zapas(1,nn,iproc)=ii
7531 zapas(2,nn,iproc)=jjc
7532 zapas(3,nn,iproc)=facont_hb(j,ii)
7533 zapas(4,nn,iproc)=ees0p(j,ii)
7534 zapas(5,nn,iproc)=ees0m(j,ii)
7535 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
7536 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
7537 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
7538 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
7539 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
7540 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
7541 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
7542 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
7543 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
7544 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
7545 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
7546 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
7547 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
7548 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
7549 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
7550 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
7551 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
7552 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
7553 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
7554 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
7555 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
7563 c------------------------------------------------------------------------------
7564 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
7566 C This subroutine calculates multi-body contributions to hydrogen-bonding
7567 implicit real*8 (a-h,o-z)
7568 include 'DIMENSIONS'
7569 include 'COMMON.IOUNITS'
7572 parameter (max_cont=maxconts)
7573 parameter (max_dim=70)
7574 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7575 double precision zapas(max_dim,maxconts,max_fg_procs),
7576 & zapas_recv(max_dim,maxconts,max_fg_procs)
7577 common /przechowalnia/ zapas
7578 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7579 & status_array(MPI_STATUS_SIZE,maxconts*2)
7581 include 'COMMON.SETUP'
7582 include 'COMMON.FFIELD'
7583 include 'COMMON.DERIV'
7584 include 'COMMON.LOCAL'
7585 include 'COMMON.INTERACT'
7586 include 'COMMON.CONTACTS'
7587 include 'COMMON.CHAIN'
7588 include 'COMMON.CONTROL'
7589 double precision gx(3),gx1(3)
7590 integer num_cont_hb_old(maxres)
7592 double precision eello4,eello5,eelo6,eello_turn6
7593 external eello4,eello5,eello6,eello_turn6
7594 C Set lprn=.true. for debugging
7599 num_cont_hb_old(i)=num_cont_hb(i)
7603 if (nfgtasks.le.1) goto 30
7605 write (iout,'(a)') 'Contact function values before RECEIVE:'
7607 write (iout,'(2i3,50(1x,i2,f5.2))')
7608 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7609 & j=1,num_cont_hb(i))
7613 do i=1,ntask_cont_from
7616 do i=1,ntask_cont_to
7619 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7621 C Make the list of contacts to send to send to other procesors
7622 do i=iturn3_start,iturn3_end
7623 c write (iout,*) "make contact list turn3",i," num_cont",
7625 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
7627 do i=iturn4_start,iturn4_end
7628 c write (iout,*) "make contact list turn4",i," num_cont",
7630 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
7634 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7636 do j=1,num_cont_hb(i)
7639 iproc=iint_sent_local(k,jjc,ii)
7640 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7641 if (iproc.ne.0) then
7642 ncont_sent(iproc)=ncont_sent(iproc)+1
7643 nn=ncont_sent(iproc)
7645 zapas(2,nn,iproc)=jjc
7646 zapas(3,nn,iproc)=d_cont(j,i)
7650 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
7655 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
7663 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
7674 & "Numbers of contacts to be sent to other processors",
7675 & (ncont_sent(i),i=1,ntask_cont_to)
7676 write (iout,*) "Contacts sent"
7677 do ii=1,ntask_cont_to
7679 iproc=itask_cont_to(ii)
7680 write (iout,*) nn," contacts to processor",iproc,
7681 & " of CONT_TO_COMM group"
7683 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7691 CorrelID1=nfgtasks+fg_rank+1
7693 C Receive the numbers of needed contacts from other processors
7694 do ii=1,ntask_cont_from
7695 iproc=itask_cont_from(ii)
7697 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7698 & FG_COMM,req(ireq),IERR)
7700 c write (iout,*) "IRECV ended"
7702 C Send the number of contacts needed by other processors
7703 do ii=1,ntask_cont_to
7704 iproc=itask_cont_to(ii)
7706 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7707 & FG_COMM,req(ireq),IERR)
7709 c write (iout,*) "ISEND ended"
7710 c write (iout,*) "number of requests (nn)",ireq
7713 & call MPI_Waitall(ireq,req,status_array,ierr)
7715 c & "Numbers of contacts to be received from other processors",
7716 c & (ncont_recv(i),i=1,ntask_cont_from)
7720 do ii=1,ntask_cont_from
7721 iproc=itask_cont_from(ii)
7723 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7724 c & " of CONT_TO_COMM group"
7728 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7729 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7730 c write (iout,*) "ireq,req",ireq,req(ireq)
7733 C Send the contacts to processors that need them
7734 do ii=1,ntask_cont_to
7735 iproc=itask_cont_to(ii)
7737 c write (iout,*) nn," contacts to processor",iproc,
7738 c & " of CONT_TO_COMM group"
7741 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7742 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7743 c write (iout,*) "ireq,req",ireq,req(ireq)
7745 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7749 c write (iout,*) "number of requests (contacts)",ireq
7750 c write (iout,*) "req",(req(i),i=1,4)
7753 & call MPI_Waitall(ireq,req,status_array,ierr)
7754 do iii=1,ntask_cont_from
7755 iproc=itask_cont_from(iii)
7758 write (iout,*) "Received",nn," contacts from processor",iproc,
7759 & " of CONT_FROM_COMM group"
7762 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7767 ii=zapas_recv(1,i,iii)
7768 c Flag the received contacts to prevent double-counting
7769 jj=-zapas_recv(2,i,iii)
7770 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7772 nnn=num_cont_hb(ii)+1
7775 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7779 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7784 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7792 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7801 write (iout,'(a)') 'Contact function values after receive:'
7803 write (iout,'(2i3,50(1x,i3,5f6.3))')
7804 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7805 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7812 write (iout,'(a)') 'Contact function values:'
7814 write (iout,'(2i3,50(1x,i2,5f6.3))')
7815 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7816 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7822 C Remove the loop below after debugging !!!
7829 C Calculate the dipole-dipole interaction energies
7830 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7831 do i=iatel_s,iatel_e+1
7832 num_conti=num_cont_hb(i)
7841 C Calculate the local-electrostatic correlation terms
7842 c write (iout,*) "gradcorr5 in eello5 before loop"
7844 c write (iout,'(i5,3f10.5)')
7845 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7847 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7848 c write (iout,*) "corr loop i",i
7850 num_conti=num_cont_hb(i)
7851 num_conti1=num_cont_hb(i+1)
7858 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7859 c & ' jj=',jj,' kk=',kk
7860 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7861 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7862 & .or. j.lt.0 .and. j1.gt.0) .and.
7863 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7864 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7865 C The system gains extra energy.
7867 sqd1=dsqrt(d_cont(jj,i))
7868 sqd2=dsqrt(d_cont(kk,i1))
7869 sred_geom = sqd1*sqd2
7870 IF (sred_geom.lt.cutoff_corr) THEN
7871 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7873 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7874 cd & ' jj=',jj,' kk=',kk
7875 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7876 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7878 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7879 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7882 cd write (iout,*) 'sred_geom=',sred_geom,
7883 cd & ' ekont=',ekont,' fprim=',fprimcont,
7884 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7885 cd write (iout,*) "g_contij",g_contij
7886 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7887 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7888 call calc_eello(i,jp,i+1,jp1,jj,kk)
7889 if (wcorr4.gt.0.0d0)
7890 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7891 if (energy_dec.and.wcorr4.gt.0.0d0)
7892 1 write (iout,'(a6,4i5,0pf7.3)')
7893 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7894 c write (iout,*) "gradcorr5 before eello5"
7896 c write (iout,'(i5,3f10.5)')
7897 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7899 if (wcorr5.gt.0.0d0)
7900 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7901 c write (iout,*) "gradcorr5 after eello5"
7903 c write (iout,'(i5,3f10.5)')
7904 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7906 if (energy_dec.and.wcorr5.gt.0.0d0)
7907 1 write (iout,'(a6,4i5,0pf7.3)')
7908 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7909 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7910 cd write(2,*)'ijkl',i,jp,i+1,jp1
7911 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7912 & .or. wturn6.eq.0.0d0))then
7913 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7914 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7915 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7916 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7917 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7918 cd & 'ecorr6=',ecorr6
7919 cd write (iout,'(4e15.5)') sred_geom,
7920 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7921 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7922 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7923 else if (wturn6.gt.0.0d0
7924 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7925 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7926 eturn6=eturn6+eello_turn6(i,jj,kk)
7927 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7928 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7929 cd write (2,*) 'multibody_eello:eturn6',eturn6
7938 num_cont_hb(i)=num_cont_hb_old(i)
7940 c write (iout,*) "gradcorr5 in eello5"
7942 c write (iout,'(i5,3f10.5)')
7943 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7947 c------------------------------------------------------------------------------
7948 subroutine add_hb_contact_eello(ii,jj,itask)
7949 implicit real*8 (a-h,o-z)
7950 include "DIMENSIONS"
7951 include "COMMON.IOUNITS"
7954 parameter (max_cont=maxconts)
7955 parameter (max_dim=70)
7956 include "COMMON.CONTACTS"
7957 double precision zapas(max_dim,maxconts,max_fg_procs),
7958 & zapas_recv(max_dim,maxconts,max_fg_procs)
7959 common /przechowalnia/ zapas
7960 integer i,j,ii,jj,iproc,itask(4),nn
7961 c write (iout,*) "itask",itask
7964 if (iproc.gt.0) then
7965 do j=1,num_cont_hb(ii)
7967 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7969 ncont_sent(iproc)=ncont_sent(iproc)+1
7970 nn=ncont_sent(iproc)
7971 zapas(1,nn,iproc)=ii
7972 zapas(2,nn,iproc)=jjc
7973 zapas(3,nn,iproc)=d_cont(j,ii)
7977 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7982 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7990 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
8002 c------------------------------------------------------------------------------
8003 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
8004 implicit real*8 (a-h,o-z)
8005 include 'DIMENSIONS'
8006 include 'COMMON.IOUNITS'
8007 include 'COMMON.DERIV'
8008 include 'COMMON.INTERACT'
8009 include 'COMMON.CONTACTS'
8010 double precision gx(3),gx1(3)
8020 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
8021 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
8022 C Following 4 lines for diagnostics.
8027 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
8028 c & 'Contacts ',i,j,
8029 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
8030 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
8032 C Calculate the multi-body contribution to energy.
8033 c ecorr=ecorr+ekont*ees
8034 C Calculate multi-body contributions to the gradient.
8035 coeffpees0pij=coeffp*ees0pij
8036 coeffmees0mij=coeffm*ees0mij
8037 coeffpees0pkl=coeffp*ees0pkl
8038 coeffmees0mkl=coeffm*ees0mkl
8040 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
8041 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
8042 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
8043 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
8044 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
8045 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
8046 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
8047 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
8048 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
8049 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
8050 & coeffmees0mij*gacontm_hb1(ll,kk,k))
8051 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
8052 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
8053 & coeffmees0mij*gacontm_hb2(ll,kk,k))
8054 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
8055 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
8056 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
8057 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
8058 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
8059 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
8060 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
8061 & coeffmees0mij*gacontm_hb3(ll,kk,k))
8062 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
8063 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
8064 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
8069 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8070 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
8071 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
8072 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
8077 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
8078 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
8079 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
8080 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
8083 c write (iout,*) "ehbcorr",ekont*ees
8088 C---------------------------------------------------------------------------
8089 subroutine dipole(i,j,jj)
8090 implicit real*8 (a-h,o-z)
8091 include 'DIMENSIONS'
8092 include 'COMMON.IOUNITS'
8093 include 'COMMON.CHAIN'
8094 include 'COMMON.FFIELD'
8095 include 'COMMON.DERIV'
8096 include 'COMMON.INTERACT'
8097 include 'COMMON.CONTACTS'
8098 include 'COMMON.TORSION'
8099 include 'COMMON.VAR'
8100 include 'COMMON.GEO'
8101 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
8103 iti1 = itortyp(itype(i+1))
8104 if (j.lt.nres-1) then
8105 itj1 = itortyp(itype(j+1))
8110 dipi(iii,1)=Ub2(iii,i)
8111 dipderi(iii)=Ub2der(iii,i)
8112 dipi(iii,2)=b1(iii,i+1)
8113 dipj(iii,1)=Ub2(iii,j)
8114 dipderj(iii)=Ub2der(iii,j)
8115 dipj(iii,2)=b1(iii,j+1)
8119 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
8122 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8129 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
8133 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
8138 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
8139 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
8141 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
8143 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
8145 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
8150 C---------------------------------------------------------------------------
8151 subroutine calc_eello(i,j,k,l,jj,kk)
8153 C This subroutine computes matrices and vectors needed to calculate
8154 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
8156 implicit real*8 (a-h,o-z)
8157 include 'DIMENSIONS'
8158 include 'COMMON.IOUNITS'
8159 include 'COMMON.CHAIN'
8160 include 'COMMON.DERIV'
8161 include 'COMMON.INTERACT'
8162 include 'COMMON.CONTACTS'
8163 include 'COMMON.TORSION'
8164 include 'COMMON.VAR'
8165 include 'COMMON.GEO'
8166 include 'COMMON.FFIELD'
8167 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
8168 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
8171 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
8172 cd & ' jj=',jj,' kk=',kk
8173 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
8174 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
8175 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
8178 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
8179 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
8182 call transpose2(aa1(1,1),aa1t(1,1))
8183 call transpose2(aa2(1,1),aa2t(1,1))
8186 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
8187 & aa1tder(1,1,lll,kkk))
8188 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
8189 & aa2tder(1,1,lll,kkk))
8193 C parallel orientation of the two CA-CA-CA frames.
8195 iti=itortyp(itype(i))
8199 itk1=itortyp(itype(k+1))
8200 itj=itortyp(itype(j))
8201 if (l.lt.nres-1) then
8202 itl1=itortyp(itype(l+1))
8206 C A1 kernel(j+1) A2T
8208 cd write (iout,'(3f10.5,5x,3f10.5)')
8209 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
8211 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8212 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
8213 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8214 C Following matrices are needed only for 6-th order cumulants
8215 IF (wcorr6.gt.0.0d0) THEN
8216 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8217 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
8218 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8219 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8220 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
8221 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8222 & ADtEAderx(1,1,1,1,1,1))
8224 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8225 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
8226 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8227 & ADtEA1derx(1,1,1,1,1,1))
8229 C End 6-th order cumulants
8232 cd write (2,*) 'In calc_eello6'
8234 cd write (2,*) 'iii=',iii
8236 cd write (2,*) 'kkk=',kkk
8238 cd write (2,'(3(2f10.5),5x)')
8239 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8244 call transpose2(EUgder(1,1,k),auxmat(1,1))
8245 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8246 call transpose2(EUg(1,1,k),auxmat(1,1))
8247 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8248 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8252 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8253 & EAEAderx(1,1,lll,kkk,iii,1))
8257 C A1T kernel(i+1) A2
8258 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8259 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
8260 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8261 C Following matrices are needed only for 6-th order cumulants
8262 IF (wcorr6.gt.0.0d0) THEN
8263 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8264 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
8265 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8266 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8267 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
8268 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8269 & ADtEAderx(1,1,1,1,1,2))
8270 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8271 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
8272 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8273 & ADtEA1derx(1,1,1,1,1,2))
8275 C End 6-th order cumulants
8276 call transpose2(EUgder(1,1,l),auxmat(1,1))
8277 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
8278 call transpose2(EUg(1,1,l),auxmat(1,1))
8279 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8280 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8284 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8285 & EAEAderx(1,1,lll,kkk,iii,2))
8290 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8291 C They are needed only when the fifth- or the sixth-order cumulants are
8293 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
8294 call transpose2(AEA(1,1,1),auxmat(1,1))
8295 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8296 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8297 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8298 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8299 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8300 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8301 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8302 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8303 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8304 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8305 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8306 call transpose2(AEA(1,1,2),auxmat(1,1))
8307 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
8308 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
8309 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
8310 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8311 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
8312 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
8313 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
8314 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
8315 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
8316 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
8317 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
8318 C Calculate the Cartesian derivatives of the vectors.
8322 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8323 call matvec2(auxmat(1,1),b1(1,i),
8324 & AEAb1derx(1,lll,kkk,iii,1,1))
8325 call matvec2(auxmat(1,1),Ub2(1,i),
8326 & AEAb2derx(1,lll,kkk,iii,1,1))
8327 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8328 & AEAb1derx(1,lll,kkk,iii,2,1))
8329 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8330 & AEAb2derx(1,lll,kkk,iii,2,1))
8331 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8332 call matvec2(auxmat(1,1),b1(1,j),
8333 & AEAb1derx(1,lll,kkk,iii,1,2))
8334 call matvec2(auxmat(1,1),Ub2(1,j),
8335 & AEAb2derx(1,lll,kkk,iii,1,2))
8336 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8337 & AEAb1derx(1,lll,kkk,iii,2,2))
8338 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
8339 & AEAb2derx(1,lll,kkk,iii,2,2))
8346 C Antiparallel orientation of the two CA-CA-CA frames.
8348 iti=itortyp(itype(i))
8352 itk1=itortyp(itype(k+1))
8353 itl=itortyp(itype(l))
8354 itj=itortyp(itype(j))
8355 if (j.lt.nres-1) then
8356 itj1=itortyp(itype(j+1))
8360 C A2 kernel(j-1)T A1T
8361 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8362 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
8363 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8364 C Following matrices are needed only for 6-th order cumulants
8365 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8366 & j.eq.i+4 .and. l.eq.i+3)) THEN
8367 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8368 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
8369 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8370 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8371 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
8372 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8373 & ADtEAderx(1,1,1,1,1,1))
8374 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8375 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
8376 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8377 & ADtEA1derx(1,1,1,1,1,1))
8379 C End 6-th order cumulants
8380 call transpose2(EUgder(1,1,k),auxmat(1,1))
8381 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8382 call transpose2(EUg(1,1,k),auxmat(1,1))
8383 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8384 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8388 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8389 & EAEAderx(1,1,lll,kkk,iii,1))
8393 C A2T kernel(i+1)T A1
8394 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8395 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
8396 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8397 C Following matrices are needed only for 6-th order cumulants
8398 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8399 & j.eq.i+4 .and. l.eq.i+3)) THEN
8400 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8401 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
8402 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8403 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8404 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
8405 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8406 & ADtEAderx(1,1,1,1,1,2))
8407 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8408 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
8409 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8410 & ADtEA1derx(1,1,1,1,1,2))
8412 C End 6-th order cumulants
8413 call transpose2(EUgder(1,1,j),auxmat(1,1))
8414 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
8415 call transpose2(EUg(1,1,j),auxmat(1,1))
8416 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8417 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8421 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8422 & EAEAderx(1,1,lll,kkk,iii,2))
8427 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8428 C They are needed only when the fifth- or the sixth-order cumulants are
8430 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
8431 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8432 call transpose2(AEA(1,1,1),auxmat(1,1))
8433 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8434 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8435 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8436 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8437 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8438 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8439 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8440 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8441 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8442 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8443 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8444 call transpose2(AEA(1,1,2),auxmat(1,1))
8445 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
8446 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8447 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8448 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8449 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
8450 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8451 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
8452 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
8453 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8454 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8455 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8456 C Calculate the Cartesian derivatives of the vectors.
8460 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8461 call matvec2(auxmat(1,1),b1(1,i),
8462 & AEAb1derx(1,lll,kkk,iii,1,1))
8463 call matvec2(auxmat(1,1),Ub2(1,i),
8464 & AEAb2derx(1,lll,kkk,iii,1,1))
8465 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8466 & AEAb1derx(1,lll,kkk,iii,2,1))
8467 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8468 & AEAb2derx(1,lll,kkk,iii,2,1))
8469 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8470 call matvec2(auxmat(1,1),b1(1,l),
8471 & AEAb1derx(1,lll,kkk,iii,1,2))
8472 call matvec2(auxmat(1,1),Ub2(1,l),
8473 & AEAb2derx(1,lll,kkk,iii,1,2))
8474 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
8475 & AEAb1derx(1,lll,kkk,iii,2,2))
8476 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
8477 & AEAb2derx(1,lll,kkk,iii,2,2))
8486 C---------------------------------------------------------------------------
8487 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
8488 & KK,KKderg,AKA,AKAderg,AKAderx)
8492 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
8493 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
8494 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
8499 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8501 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
8504 cd if (lprn) write (2,*) 'In kernel'
8506 cd if (lprn) write (2,*) 'kkk=',kkk
8508 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
8509 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8511 cd write (2,*) 'lll=',lll
8512 cd write (2,*) 'iii=1'
8514 cd write (2,'(3(2f10.5),5x)')
8515 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8518 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
8519 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8521 cd write (2,*) 'lll=',lll
8522 cd write (2,*) 'iii=2'
8524 cd write (2,'(3(2f10.5),5x)')
8525 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8532 C---------------------------------------------------------------------------
8533 double precision function eello4(i,j,k,l,jj,kk)
8534 implicit real*8 (a-h,o-z)
8535 include 'DIMENSIONS'
8536 include 'COMMON.IOUNITS'
8537 include 'COMMON.CHAIN'
8538 include 'COMMON.DERIV'
8539 include 'COMMON.INTERACT'
8540 include 'COMMON.CONTACTS'
8541 include 'COMMON.TORSION'
8542 include 'COMMON.VAR'
8543 include 'COMMON.GEO'
8544 double precision pizda(2,2),ggg1(3),ggg2(3)
8545 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8549 cd print *,'eello4:',i,j,k,l,jj,kk
8550 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
8551 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
8552 cold eij=facont_hb(jj,i)
8553 cold ekl=facont_hb(kk,k)
8555 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8556 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8557 gcorr_loc(k-1)=gcorr_loc(k-1)
8558 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8560 gcorr_loc(l-1)=gcorr_loc(l-1)
8561 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8563 gcorr_loc(j-1)=gcorr_loc(j-1)
8564 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8569 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
8570 & -EAEAderx(2,2,lll,kkk,iii,1)
8571 cd derx(lll,kkk,iii)=0.0d0
8575 cd gcorr_loc(l-1)=0.0d0
8576 cd gcorr_loc(j-1)=0.0d0
8577 cd gcorr_loc(k-1)=0.0d0
8579 cd write (iout,*)'Contacts have occurred for peptide groups',
8580 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
8581 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8582 if (j.lt.nres-1) then
8589 if (l.lt.nres-1) then
8597 cgrad ggg1(ll)=eel4*g_contij(ll,1)
8598 cgrad ggg2(ll)=eel4*g_contij(ll,2)
8599 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8600 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8601 cgrad ghalf=0.5d0*ggg1(ll)
8602 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8603 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8604 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8605 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8606 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8607 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8608 cgrad ghalf=0.5d0*ggg2(ll)
8609 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8610 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8611 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8612 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8613 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8614 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8618 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8623 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8628 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8633 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8637 cd write (2,*) iii,gcorr_loc(iii)
8640 cd write (2,*) 'ekont',ekont
8641 cd write (iout,*) 'eello4',ekont*eel4
8644 C---------------------------------------------------------------------------
8645 double precision function eello5(i,j,k,l,jj,kk)
8646 implicit real*8 (a-h,o-z)
8647 include 'DIMENSIONS'
8648 include 'COMMON.IOUNITS'
8649 include 'COMMON.CHAIN'
8650 include 'COMMON.DERIV'
8651 include 'COMMON.INTERACT'
8652 include 'COMMON.CONTACTS'
8653 include 'COMMON.TORSION'
8654 include 'COMMON.VAR'
8655 include 'COMMON.GEO'
8656 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
8657 double precision ggg1(3),ggg2(3)
8658 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8663 C /l\ / \ \ / \ / \ / C
8664 C / \ / \ \ / \ / \ / C
8665 C j| o |l1 | o | o| o | | o |o C
8666 C \ |/k\| |/ \| / |/ \| |/ \| C
8667 C \i/ \ / \ / / \ / \ C
8669 C (I) (II) (III) (IV) C
8671 C eello5_1 eello5_2 eello5_3 eello5_4 C
8673 C Antiparallel chains C
8676 C /j\ / \ \ / \ / \ / C
8677 C / \ / \ \ / \ / \ / C
8678 C j1| o |l | o | o| o | | o |o C
8679 C \ |/k\| |/ \| / |/ \| |/ \| C
8680 C \i/ \ / \ / / \ / \ C
8682 C (I) (II) (III) (IV) C
8684 C eello5_1 eello5_2 eello5_3 eello5_4 C
8686 C o denotes a local interaction, vertical lines an electrostatic interaction. C
8688 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8689 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8694 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8696 itk=itortyp(itype(k))
8697 itl=itortyp(itype(l))
8698 itj=itortyp(itype(j))
8703 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8704 cd & eel5_3_num,eel5_4_num)
8708 derx(lll,kkk,iii)=0.0d0
8712 cd eij=facont_hb(jj,i)
8713 cd ekl=facont_hb(kk,k)
8715 cd write (iout,*)'Contacts have occurred for peptide groups',
8716 cd & i,j,' fcont:',eij,' eij',' and ',k,l
8718 C Contribution from the graph I.
8719 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8720 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8721 call transpose2(EUg(1,1,k),auxmat(1,1))
8722 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8723 vv(1)=pizda(1,1)-pizda(2,2)
8724 vv(2)=pizda(1,2)+pizda(2,1)
8725 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
8726 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8727 C Explicit gradient in virtual-dihedral angles.
8728 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
8729 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
8730 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8731 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8732 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8733 vv(1)=pizda(1,1)-pizda(2,2)
8734 vv(2)=pizda(1,2)+pizda(2,1)
8735 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8736 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
8737 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8738 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8739 vv(1)=pizda(1,1)-pizda(2,2)
8740 vv(2)=pizda(1,2)+pizda(2,1)
8742 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
8743 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8744 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8746 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
8747 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8748 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8750 C Cartesian gradient
8754 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
8756 vv(1)=pizda(1,1)-pizda(2,2)
8757 vv(2)=pizda(1,2)+pizda(2,1)
8758 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8759 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
8760 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8766 C Contribution from graph II
8767 call transpose2(EE(1,1,itk),auxmat(1,1))
8768 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8769 vv(1)=pizda(1,1)+pizda(2,2)
8770 vv(2)=pizda(2,1)-pizda(1,2)
8771 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
8772 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8773 C Explicit gradient in virtual-dihedral angles.
8774 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8775 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8776 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8777 vv(1)=pizda(1,1)+pizda(2,2)
8778 vv(2)=pizda(2,1)-pizda(1,2)
8780 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8781 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8782 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8784 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8785 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8786 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8788 C Cartesian gradient
8792 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8794 vv(1)=pizda(1,1)+pizda(2,2)
8795 vv(2)=pizda(2,1)-pizda(1,2)
8796 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8797 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
8798 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8806 C Parallel orientation
8807 C Contribution from graph III
8808 call transpose2(EUg(1,1,l),auxmat(1,1))
8809 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8810 vv(1)=pizda(1,1)-pizda(2,2)
8811 vv(2)=pizda(1,2)+pizda(2,1)
8812 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
8813 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8814 C Explicit gradient in virtual-dihedral angles.
8815 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8816 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
8817 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8818 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8819 vv(1)=pizda(1,1)-pizda(2,2)
8820 vv(2)=pizda(1,2)+pizda(2,1)
8821 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8822 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8823 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8824 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8825 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8826 vv(1)=pizda(1,1)-pizda(2,2)
8827 vv(2)=pizda(1,2)+pizda(2,1)
8828 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8829 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8830 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8831 C Cartesian gradient
8835 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8837 vv(1)=pizda(1,1)-pizda(2,2)
8838 vv(2)=pizda(1,2)+pizda(2,1)
8839 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8840 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8841 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8846 C Contribution from graph IV
8848 call transpose2(EE(1,1,itl),auxmat(1,1))
8849 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8850 vv(1)=pizda(1,1)+pizda(2,2)
8851 vv(2)=pizda(2,1)-pizda(1,2)
8852 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
8853 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8854 C Explicit gradient in virtual-dihedral angles.
8855 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8856 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8857 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8858 vv(1)=pizda(1,1)+pizda(2,2)
8859 vv(2)=pizda(2,1)-pizda(1,2)
8860 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8861 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
8862 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8863 C Cartesian gradient
8867 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8869 vv(1)=pizda(1,1)+pizda(2,2)
8870 vv(2)=pizda(2,1)-pizda(1,2)
8871 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8872 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
8873 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8878 C Antiparallel orientation
8879 C Contribution from graph III
8881 call transpose2(EUg(1,1,j),auxmat(1,1))
8882 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8883 vv(1)=pizda(1,1)-pizda(2,2)
8884 vv(2)=pizda(1,2)+pizda(2,1)
8885 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8886 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8887 C Explicit gradient in virtual-dihedral angles.
8888 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8889 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8890 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8891 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8892 vv(1)=pizda(1,1)-pizda(2,2)
8893 vv(2)=pizda(1,2)+pizda(2,1)
8894 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8895 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
8896 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8897 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8898 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8899 vv(1)=pizda(1,1)-pizda(2,2)
8900 vv(2)=pizda(1,2)+pizda(2,1)
8901 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8902 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
8903 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8904 C Cartesian gradient
8908 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8910 vv(1)=pizda(1,1)-pizda(2,2)
8911 vv(2)=pizda(1,2)+pizda(2,1)
8912 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8913 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8914 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8919 C Contribution from graph IV
8921 call transpose2(EE(1,1,itj),auxmat(1,1))
8922 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8923 vv(1)=pizda(1,1)+pizda(2,2)
8924 vv(2)=pizda(2,1)-pizda(1,2)
8925 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
8926 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8927 C Explicit gradient in virtual-dihedral angles.
8928 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8929 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8930 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8931 vv(1)=pizda(1,1)+pizda(2,2)
8932 vv(2)=pizda(2,1)-pizda(1,2)
8933 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8934 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
8935 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8936 C Cartesian gradient
8940 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8942 vv(1)=pizda(1,1)+pizda(2,2)
8943 vv(2)=pizda(2,1)-pizda(1,2)
8944 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8945 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
8946 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8952 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8953 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8954 cd write (2,*) 'ijkl',i,j,k,l
8955 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8956 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8958 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8959 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8960 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8961 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8962 if (j.lt.nres-1) then
8969 if (l.lt.nres-1) then
8979 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8980 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8981 C summed up outside the subrouine as for the other subroutines
8982 C handling long-range interactions. The old code is commented out
8983 C with "cgrad" to keep track of changes.
8985 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8986 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8987 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8988 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8989 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8990 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8991 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8992 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8993 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8994 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8996 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8997 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8998 cgrad ghalf=0.5d0*ggg1(ll)
9000 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
9001 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
9002 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
9003 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
9004 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
9005 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
9006 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
9007 cgrad ghalf=0.5d0*ggg2(ll)
9009 gradcorr5(ll,k)=gradcorr5(ll,k)+ekont*derx(ll,2,2)
9010 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
9011 gradcorr5(ll,l)=gradcorr5(ll,l)+ekont*derx(ll,4,2)
9012 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
9013 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
9014 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
9019 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
9020 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
9025 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
9026 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
9032 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
9037 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
9041 cd write (2,*) iii,g_corr5_loc(iii)
9044 cd write (2,*) 'ekont',ekont
9045 cd write (iout,*) 'eello5',ekont*eel5
9048 c--------------------------------------------------------------------------
9049 double precision function eello6(i,j,k,l,jj,kk)
9050 implicit real*8 (a-h,o-z)
9051 include 'DIMENSIONS'
9052 include 'COMMON.IOUNITS'
9053 include 'COMMON.CHAIN'
9054 include 'COMMON.DERIV'
9055 include 'COMMON.INTERACT'
9056 include 'COMMON.CONTACTS'
9057 include 'COMMON.TORSION'
9058 include 'COMMON.VAR'
9059 include 'COMMON.GEO'
9060 include 'COMMON.FFIELD'
9061 double precision ggg1(3),ggg2(3)
9062 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9067 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9075 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
9076 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
9080 derx(lll,kkk,iii)=0.0d0
9084 cd eij=facont_hb(jj,i)
9085 cd ekl=facont_hb(kk,k)
9091 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9092 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
9093 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
9094 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9095 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
9096 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
9098 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
9099 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
9100 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
9101 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
9102 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
9103 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9107 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
9109 C If turn contributions are considered, they will be handled separately.
9110 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
9111 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
9112 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
9113 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
9114 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
9115 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
9116 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
9118 if (j.lt.nres-1) then
9125 if (l.lt.nres-1) then
9133 cgrad ggg1(ll)=eel6*g_contij(ll,1)
9134 cgrad ggg2(ll)=eel6*g_contij(ll,2)
9135 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
9136 cgrad ghalf=0.5d0*ggg1(ll)
9138 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
9139 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
9140 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
9141 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
9142 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
9143 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
9144 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
9145 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
9146 cgrad ghalf=0.5d0*ggg2(ll)
9147 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
9149 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
9150 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
9151 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
9152 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
9153 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
9154 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
9159 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
9160 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
9165 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
9166 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
9172 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
9177 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
9181 cd write (2,*) iii,g_corr6_loc(iii)
9184 cd write (2,*) 'ekont',ekont
9185 cd write (iout,*) 'eello6',ekont*eel6
9188 c--------------------------------------------------------------------------
9189 double precision function eello6_graph1(i,j,k,l,imat,swap)
9190 implicit real*8 (a-h,o-z)
9191 include 'DIMENSIONS'
9192 include 'COMMON.IOUNITS'
9193 include 'COMMON.CHAIN'
9194 include 'COMMON.DERIV'
9195 include 'COMMON.INTERACT'
9196 include 'COMMON.CONTACTS'
9197 include 'COMMON.TORSION'
9198 include 'COMMON.VAR'
9199 include 'COMMON.GEO'
9200 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
9204 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9206 C Parallel Antiparallel C
9212 C \ j|/k\| / \ |/k\|l / C
9217 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9218 itk=itortyp(itype(k))
9219 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
9220 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
9221 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
9222 call transpose2(EUgC(1,1,k),auxmat(1,1))
9223 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9224 vv1(1)=pizda1(1,1)-pizda1(2,2)
9225 vv1(2)=pizda1(1,2)+pizda1(2,1)
9226 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9227 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
9228 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
9229 s5=scalar2(vv(1),Dtobr2(1,i))
9230 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
9231 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
9232 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
9233 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
9234 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
9235 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
9236 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
9237 & +scalar2(vv(1),Dtobr2der(1,i)))
9238 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
9239 vv1(1)=pizda1(1,1)-pizda1(2,2)
9240 vv1(2)=pizda1(1,2)+pizda1(2,1)
9241 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
9242 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
9244 g_corr6_loc(l-1)=g_corr6_loc(l-1)
9245 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9246 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9247 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9248 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9250 g_corr6_loc(j-1)=g_corr6_loc(j-1)
9251 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9252 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9253 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9254 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9256 call transpose2(EUgCder(1,1,k),auxmat(1,1))
9257 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9258 vv1(1)=pizda1(1,1)-pizda1(2,2)
9259 vv1(2)=pizda1(1,2)+pizda1(2,1)
9260 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
9261 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
9262 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
9263 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
9272 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
9273 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
9274 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
9275 call transpose2(EUgC(1,1,k),auxmat(1,1))
9276 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9278 vv1(1)=pizda1(1,1)-pizda1(2,2)
9279 vv1(2)=pizda1(1,2)+pizda1(2,1)
9280 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9281 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
9282 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
9283 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
9284 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
9285 s5=scalar2(vv(1),Dtobr2(1,i))
9286 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
9292 c----------------------------------------------------------------------------
9293 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
9294 implicit real*8 (a-h,o-z)
9295 include 'DIMENSIONS'
9296 include 'COMMON.IOUNITS'
9297 include 'COMMON.CHAIN'
9298 include 'COMMON.DERIV'
9299 include 'COMMON.INTERACT'
9300 include 'COMMON.CONTACTS'
9301 include 'COMMON.TORSION'
9302 include 'COMMON.VAR'
9303 include 'COMMON.GEO'
9305 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9306 & auxvec1(2),auxvec2(2),auxmat1(2,2)
9309 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9311 C Parallel Antiparallel C
9317 C \ j|/k\| \ |/k\|l C
9322 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9323 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
9324 C AL 7/4/01 s1 would occur in the sixth-order moment,
9325 C but not in a cluster cumulant
9327 s1=dip(1,jj,i)*dip(1,kk,k)
9329 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
9330 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9331 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
9332 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
9333 call transpose2(EUg(1,1,k),auxmat(1,1))
9334 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
9335 vv(1)=pizda(1,1)-pizda(2,2)
9336 vv(2)=pizda(1,2)+pizda(2,1)
9337 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9338 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9340 eello6_graph2=-(s1+s2+s3+s4)
9342 eello6_graph2=-(s2+s3+s4)
9345 C Derivatives in gamma(i-1)
9348 s1=dipderg(1,jj,i)*dip(1,kk,k)
9350 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9351 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
9352 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9353 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9355 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9357 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9359 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
9361 C Derivatives in gamma(k-1)
9363 s1=dip(1,jj,i)*dipderg(1,kk,k)
9365 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
9366 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9367 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
9368 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9369 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9370 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
9371 vv(1)=pizda(1,1)-pizda(2,2)
9372 vv(2)=pizda(1,2)+pizda(2,1)
9373 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9375 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9377 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9379 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
9380 C Derivatives in gamma(j-1) or gamma(l-1)
9383 s1=dipderg(3,jj,i)*dip(1,kk,k)
9385 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
9386 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9387 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
9388 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
9389 vv(1)=pizda(1,1)-pizda(2,2)
9390 vv(2)=pizda(1,2)+pizda(2,1)
9391 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9394 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9396 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9399 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
9400 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
9402 C Derivatives in gamma(l-1) or gamma(j-1)
9405 s1=dip(1,jj,i)*dipderg(3,kk,k)
9407 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
9408 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9409 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
9410 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9411 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
9412 vv(1)=pizda(1,1)-pizda(2,2)
9413 vv(2)=pizda(1,2)+pizda(2,1)
9414 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9417 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9419 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9422 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
9423 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
9425 C Cartesian derivatives.
9427 write (2,*) 'In eello6_graph2'
9429 write (2,*) 'iii=',iii
9431 write (2,*) 'kkk=',kkk
9433 write (2,'(3(2f10.5),5x)')
9434 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9444 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9446 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9449 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
9451 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9452 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
9454 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9455 call transpose2(EUg(1,1,k),auxmat(1,1))
9456 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
9458 vv(1)=pizda(1,1)-pizda(2,2)
9459 vv(2)=pizda(1,2)+pizda(2,1)
9460 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9461 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9463 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9465 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9468 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9470 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9477 c----------------------------------------------------------------------------
9478 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
9479 implicit real*8 (a-h,o-z)
9480 include 'DIMENSIONS'
9481 include 'COMMON.IOUNITS'
9482 include 'COMMON.CHAIN'
9483 include 'COMMON.DERIV'
9484 include 'COMMON.INTERACT'
9485 include 'COMMON.CONTACTS'
9486 include 'COMMON.TORSION'
9487 include 'COMMON.VAR'
9488 include 'COMMON.GEO'
9489 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
9491 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9493 C Parallel Antiparallel C
9499 C j|/k\| / |/k\|l / C
9504 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9506 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9507 C energy moment and not to the cluster cumulant.
9508 iti=itortyp(itype(i))
9509 if (j.lt.nres-1) then
9510 itj1=itortyp(itype(j+1))
9514 itk=itortyp(itype(k))
9515 itk1=itortyp(itype(k+1))
9516 if (l.lt.nres-1) then
9517 itl1=itortyp(itype(l+1))
9522 s1=dip(4,jj,i)*dip(4,kk,k)
9524 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
9525 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9526 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
9527 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9528 call transpose2(EE(1,1,itk),auxmat(1,1))
9529 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9530 vv(1)=pizda(1,1)+pizda(2,2)
9531 vv(2)=pizda(2,1)-pizda(1,2)
9532 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9533 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9534 cd & "sum",-(s2+s3+s4)
9536 eello6_graph3=-(s1+s2+s3+s4)
9538 eello6_graph3=-(s2+s3+s4)
9541 C Derivatives in gamma(k-1)
9542 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
9543 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9544 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9545 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9546 C Derivatives in gamma(l-1)
9547 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
9548 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9549 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9550 vv(1)=pizda(1,1)+pizda(2,2)
9551 vv(2)=pizda(2,1)-pizda(1,2)
9552 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9553 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9554 C Cartesian derivatives.
9560 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9562 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9565 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9567 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9568 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
9570 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9571 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
9573 vv(1)=pizda(1,1)+pizda(2,2)
9574 vv(2)=pizda(2,1)-pizda(1,2)
9575 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9577 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9579 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9582 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9584 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9586 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9592 c----------------------------------------------------------------------------
9593 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9594 implicit real*8 (a-h,o-z)
9595 include 'DIMENSIONS'
9596 include 'COMMON.IOUNITS'
9597 include 'COMMON.CHAIN'
9598 include 'COMMON.DERIV'
9599 include 'COMMON.INTERACT'
9600 include 'COMMON.CONTACTS'
9601 include 'COMMON.TORSION'
9602 include 'COMMON.VAR'
9603 include 'COMMON.GEO'
9604 include 'COMMON.FFIELD'
9605 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9606 & auxvec1(2),auxmat1(2,2)
9608 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9610 C Parallel Antiparallel C
9616 C \ j|/k\| \ |/k\|l C
9621 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9623 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9624 C energy moment and not to the cluster cumulant.
9625 cd write (2,*) 'eello_graph4: wturn6',wturn6
9626 iti=itortyp(itype(i))
9627 itj=itortyp(itype(j))
9628 if (j.lt.nres-1) then
9629 itj1=itortyp(itype(j+1))
9633 itk=itortyp(itype(k))
9634 if (k.lt.nres-1) then
9635 itk1=itortyp(itype(k+1))
9639 itl=itortyp(itype(l))
9640 if (l.lt.nres-1) then
9641 itl1=itortyp(itype(l+1))
9645 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9646 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9647 cd & ' itl',itl,' itl1',itl1
9650 s1=dip(3,jj,i)*dip(3,kk,k)
9652 s1=dip(2,jj,j)*dip(2,kk,l)
9655 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9656 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9658 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
9659 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9661 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
9662 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9664 call transpose2(EUg(1,1,k),auxmat(1,1))
9665 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9666 vv(1)=pizda(1,1)-pizda(2,2)
9667 vv(2)=pizda(2,1)+pizda(1,2)
9668 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9669 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9671 eello6_graph4=-(s1+s2+s3+s4)
9673 eello6_graph4=-(s2+s3+s4)
9675 C Derivatives in gamma(i-1)
9679 s1=dipderg(2,jj,i)*dip(3,kk,k)
9681 s1=dipderg(4,jj,j)*dip(2,kk,l)
9684 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9686 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
9687 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9689 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
9690 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9692 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9693 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9694 cd write (2,*) 'turn6 derivatives'
9696 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9698 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9702 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9704 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9708 C Derivatives in gamma(k-1)
9711 s1=dip(3,jj,i)*dipderg(2,kk,k)
9713 s1=dip(2,jj,j)*dipderg(4,kk,l)
9716 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9717 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9719 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
9720 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9722 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
9723 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9725 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9726 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9727 vv(1)=pizda(1,1)-pizda(2,2)
9728 vv(2)=pizda(2,1)+pizda(1,2)
9729 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9730 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9732 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9734 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9738 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9740 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9743 C Derivatives in gamma(j-1) or gamma(l-1)
9744 if (l.eq.j+1 .and. l.gt.1) then
9745 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9746 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9747 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9748 vv(1)=pizda(1,1)-pizda(2,2)
9749 vv(2)=pizda(2,1)+pizda(1,2)
9750 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9751 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9752 else if (j.gt.1) then
9753 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9754 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9755 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9756 vv(1)=pizda(1,1)-pizda(2,2)
9757 vv(2)=pizda(2,1)+pizda(1,2)
9758 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9759 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9760 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9762 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9765 C Cartesian derivatives.
9772 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9774 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9778 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9780 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9784 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
9786 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9788 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9789 & b1(1,j+1),auxvec(1))
9790 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
9792 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9793 & b1(1,l+1),auxvec(1))
9794 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
9796 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9798 vv(1)=pizda(1,1)-pizda(2,2)
9799 vv(2)=pizda(2,1)+pizda(1,2)
9800 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9802 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9804 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9807 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9810 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9813 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9815 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9817 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9821 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9823 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9826 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9828 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9836 c----------------------------------------------------------------------------
9837 double precision function eello_turn6(i,jj,kk)
9838 implicit real*8 (a-h,o-z)
9839 include 'DIMENSIONS'
9840 include 'COMMON.IOUNITS'
9841 include 'COMMON.CHAIN'
9842 include 'COMMON.DERIV'
9843 include 'COMMON.INTERACT'
9844 include 'COMMON.CONTACTS'
9845 include 'COMMON.TORSION'
9846 include 'COMMON.VAR'
9847 include 'COMMON.GEO'
9848 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9849 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9851 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9852 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9853 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9854 C the respective energy moment and not to the cluster cumulant.
9863 iti=itortyp(itype(i))
9864 itk=itortyp(itype(k))
9865 itk1=itortyp(itype(k+1))
9866 itl=itortyp(itype(l))
9867 itj=itortyp(itype(j))
9868 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9869 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9870 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9875 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9877 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
9881 derx_turn(lll,kkk,iii)=0.0d0
9888 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9890 cd write (2,*) 'eello6_5',eello6_5
9892 call transpose2(AEA(1,1,1),auxmat(1,1))
9893 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9894 ss1=scalar2(Ub2(1,i+2),b1(1,l))
9895 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9897 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
9898 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9899 s2 = scalar2(b1(1,k),vtemp1(1))
9901 call transpose2(AEA(1,1,2),atemp(1,1))
9902 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9903 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
9904 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9906 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9907 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9908 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9910 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9911 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9912 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9913 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9914 ss13 = scalar2(b1(1,k),vtemp4(1))
9915 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9917 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9923 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9924 C Derivatives in gamma(i+2)
9928 call transpose2(AEA(1,1,1),auxmatd(1,1))
9929 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9930 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9931 call transpose2(AEAderg(1,1,2),atempd(1,1))
9932 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9933 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9935 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9936 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9937 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9943 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9944 C Derivatives in gamma(i+3)
9946 call transpose2(AEA(1,1,1),auxmatd(1,1))
9947 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9948 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
9949 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9951 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
9952 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9953 s2d = scalar2(b1(1,k),vtemp1d(1))
9955 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9956 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9958 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9960 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9961 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9962 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9970 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9971 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9973 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9974 & -0.5d0*ekont*(s2d+s12d)
9976 C Derivatives in gamma(i+4)
9977 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9978 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9979 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9981 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9982 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9983 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9991 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9993 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9995 C Derivatives in gamma(i+5)
9997 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9998 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9999 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10001 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
10002 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
10003 s2d = scalar2(b1(1,k),vtemp1d(1))
10005 call transpose2(AEA(1,1,2),atempd(1,1))
10006 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
10007 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
10009 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
10010 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10012 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
10013 ss13d = scalar2(b1(1,k),vtemp4d(1))
10014 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10022 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10023 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
10025 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
10026 & -0.5d0*ekont*(s2d+s12d)
10028 C Cartesian derivatives
10033 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
10034 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
10035 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
10037 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
10038 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
10040 s2d = scalar2(b1(1,k),vtemp1d(1))
10042 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
10043 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
10044 s8d = -(atempd(1,1)+atempd(2,2))*
10045 & scalar2(cc(1,1,itl),vtemp2(1))
10047 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
10049 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
10050 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
10057 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10058 & - 0.5d0*(s1d+s2d)
10060 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
10064 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10065 & - 0.5d0*(s8d+s12d)
10067 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
10076 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
10077 & achuj_tempd(1,1))
10078 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
10079 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
10080 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
10081 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
10082 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
10084 ss13d = scalar2(b1(1,k),vtemp4d(1))
10085 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
10086 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
10090 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
10091 cd & 16*eel_turn6_num
10093 if (j.lt.nres-1) then
10100 if (l.lt.nres-1) then
10108 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
10109 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
10110 cgrad ghalf=0.5d0*ggg1(ll)
10112 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
10113 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
10114 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
10115 & +ekont*derx_turn(ll,2,1)
10116 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
10117 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
10118 & +ekont*derx_turn(ll,4,1)
10119 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
10120 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
10121 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
10122 cgrad ghalf=0.5d0*ggg2(ll)
10124 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
10125 & +ekont*derx_turn(ll,2,2)
10126 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
10127 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
10128 & +ekont*derx_turn(ll,4,2)
10129 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
10130 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
10131 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
10136 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
10141 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
10147 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
10152 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
10156 cd write (2,*) iii,g_corr6_loc(iii)
10158 eello_turn6=ekont*eel_turn6
10159 cd write (2,*) 'ekont',ekont
10160 cd write (2,*) 'eel_turn6',ekont*eel_turn6
10164 C-----------------------------------------------------------------------------
10165 double precision function scalar(u,v)
10166 !DIR$ INLINEALWAYS scalar
10168 cDEC$ ATTRIBUTES FORCEINLINE::scalar
10171 double precision u(3),v(3)
10172 cd double precision sc
10180 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
10183 crc-------------------------------------------------
10184 SUBROUTINE MATVEC2(A1,V1,V2)
10185 !DIR$ INLINEALWAYS MATVEC2
10187 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
10189 implicit real*8 (a-h,o-z)
10190 include 'DIMENSIONS'
10191 DIMENSION A1(2,2),V1(2),V2(2)
10195 c 3 VI=VI+A1(I,K)*V1(K)
10199 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
10200 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
10205 C---------------------------------------
10206 SUBROUTINE MATMAT2(A1,A2,A3)
10208 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
10210 implicit real*8 (a-h,o-z)
10211 include 'DIMENSIONS'
10212 DIMENSION A1(2,2),A2(2,2),A3(2,2)
10213 c DIMENSION AI3(2,2)
10217 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
10223 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
10224 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
10225 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
10226 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
10234 c-------------------------------------------------------------------------
10235 double precision function scalar2(u,v)
10236 !DIR$ INLINEALWAYS scalar2
10238 double precision u(2),v(2)
10239 double precision sc
10241 scalar2=u(1)*v(1)+u(2)*v(2)
10245 C-----------------------------------------------------------------------------
10247 subroutine transpose2(a,at)
10248 !DIR$ INLINEALWAYS transpose2
10250 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
10253 double precision a(2,2),at(2,2)
10260 c--------------------------------------------------------------------------
10261 subroutine transpose(n,a,at)
10264 double precision a(n,n),at(n,n)
10272 C---------------------------------------------------------------------------
10273 subroutine prodmat3(a1,a2,kk,transp,prod)
10274 !DIR$ INLINEALWAYS prodmat3
10276 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
10280 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
10282 crc double precision auxmat(2,2),prod_(2,2)
10285 crc call transpose2(kk(1,1),auxmat(1,1))
10286 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
10287 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10289 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
10290 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
10291 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
10292 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
10293 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
10294 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
10295 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
10296 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
10299 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
10300 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10302 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
10303 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
10304 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
10305 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
10306 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
10307 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
10308 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
10309 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
10312 c call transpose2(a2(1,1),a2t(1,1))
10315 crc print *,((prod_(i,j),i=1,2),j=1,2)
10316 crc print *,((prod(i,j),i=1,2),j=1,2)
10320 CCC----------------------------------------------
10321 subroutine Eliptransfer(eliptran)
10322 implicit real*8 (a-h,o-z)
10323 include 'DIMENSIONS'
10324 include 'COMMON.GEO'
10325 include 'COMMON.VAR'
10326 include 'COMMON.LOCAL'
10327 include 'COMMON.CHAIN'
10328 include 'COMMON.DERIV'
10329 include 'COMMON.NAMES'
10330 include 'COMMON.INTERACT'
10331 include 'COMMON.IOUNITS'
10332 include 'COMMON.CALC'
10333 include 'COMMON.CONTROL'
10334 include 'COMMON.SPLITELE'
10335 include 'COMMON.SBRIDGE'
10336 C this is done by Adasko
10337 C print *,"wchodze"
10338 C structure of box:
10340 C--bordliptop-- buffore starts
10341 C--bufliptop--- here true lipid starts
10343 C--buflipbot--- lipid ends buffore starts
10344 C--bordlipbot--buffore ends
10346 do i=ilip_start,ilip_end
10348 if (itype(i).eq.ntyp1) cycle
10350 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
10351 if (positi.le.0) positi=positi+boxzsize
10353 C first for peptide groups
10354 c for each residue check if it is in lipid or lipid water border area
10355 if ((positi.gt.bordlipbot)
10356 &.and.(positi.lt.bordliptop)) then
10357 C the energy transfer exist
10358 if (positi.lt.buflipbot) then
10359 C what fraction I am in
10361 & ((positi-bordlipbot)/lipbufthick)
10362 C lipbufthick is thickenes of lipid buffore
10363 sslip=sscalelip(fracinbuf)
10364 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
10365 eliptran=eliptran+sslip*pepliptran
10366 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10367 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10368 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10370 C print *,"doing sccale for lower part"
10371 C print *,i,sslip,fracinbuf,ssgradlip
10372 elseif (positi.gt.bufliptop) then
10373 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
10374 sslip=sscalelip(fracinbuf)
10375 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
10376 eliptran=eliptran+sslip*pepliptran
10377 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10378 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10379 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10380 C print *, "doing sscalefor top part"
10381 C print *,i,sslip,fracinbuf,ssgradlip
10383 eliptran=eliptran+pepliptran
10384 C print *,"I am in true lipid"
10387 C eliptran=elpitran+0.0 ! I am in water
10390 C print *, "nic nie bylo w lipidzie?"
10391 C now multiply all by the peptide group transfer factor
10392 C eliptran=eliptran*pepliptran
10393 C now the same for side chains
10395 do i=ilip_start,ilip_end
10396 if (itype(i).eq.ntyp1) cycle
10397 positi=(mod(c(3,i+nres),boxzsize))
10398 if (positi.le.0) positi=positi+boxzsize
10399 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
10400 c for each residue check if it is in lipid or lipid water border area
10401 C respos=mod(c(3,i+nres),boxzsize)
10402 C print *,positi,bordlipbot,buflipbot
10403 if ((positi.gt.bordlipbot)
10404 & .and.(positi.lt.bordliptop)) then
10405 C the energy transfer exist
10406 if (positi.lt.buflipbot) then
10408 & ((positi-bordlipbot)/lipbufthick)
10409 C lipbufthick is thickenes of lipid buffore
10410 sslip=sscalelip(fracinbuf)
10411 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
10412 eliptran=eliptran+sslip*liptranene(itype(i))
10413 gliptranx(3,i)=gliptranx(3,i)
10414 &+ssgradlip*liptranene(itype(i))
10415 gliptranc(3,i-1)= gliptranc(3,i-1)
10416 &+ssgradlip*liptranene(itype(i))
10417 C print *,"doing sccale for lower part"
10418 elseif (positi.gt.bufliptop) then
10420 &((bordliptop-positi)/lipbufthick)
10421 sslip=sscalelip(fracinbuf)
10422 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
10423 eliptran=eliptran+sslip*liptranene(itype(i))
10424 gliptranx(3,i)=gliptranx(3,i)
10425 &+ssgradlip*liptranene(itype(i))
10426 gliptranc(3,i-1)= gliptranc(3,i-1)
10427 &+ssgradlip*liptranene(itype(i))
10428 C print *, "doing sscalefor top part",sslip,fracinbuf
10430 eliptran=eliptran+liptranene(itype(i))
10431 C print *,"I am in true lipid"
10433 endif ! if in lipid or buffor
10435 C eliptran=elpitran+0.0 ! I am in water
10439 C---------------------------------------------------------
10440 C AFM soubroutine for constant force
10441 subroutine AFMforce(Eafmforce)
10442 implicit real*8 (a-h,o-z)
10443 include 'DIMENSIONS'
10444 include 'COMMON.GEO'
10445 include 'COMMON.VAR'
10446 include 'COMMON.LOCAL'
10447 include 'COMMON.CHAIN'
10448 include 'COMMON.DERIV'
10449 include 'COMMON.NAMES'
10450 include 'COMMON.INTERACT'
10451 include 'COMMON.IOUNITS'
10452 include 'COMMON.CALC'
10453 include 'COMMON.CONTROL'
10454 include 'COMMON.SPLITELE'
10455 include 'COMMON.SBRIDGE'
10460 diffafm(i)=c(i,afmend)-c(i,afmbeg)
10461 dist=dist+diffafm(i)**2
10464 Eafmforce=-forceAFMconst*(dist-distafminit)
10466 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/dist
10467 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/dist
10469 C print *,'AFM',Eafmforce
10472 C---------------------------------------------------------
10473 C AFM subroutine with pseudoconstant velocity
10474 subroutine AFMvel(Eafmforce)
10475 implicit real*8 (a-h,o-z)
10476 include 'DIMENSIONS'
10477 include 'COMMON.GEO'
10478 include 'COMMON.VAR'
10479 include 'COMMON.LOCAL'
10480 include 'COMMON.CHAIN'
10481 include 'COMMON.DERIV'
10482 include 'COMMON.NAMES'
10483 include 'COMMON.INTERACT'
10484 include 'COMMON.IOUNITS'
10485 include 'COMMON.CALC'
10486 include 'COMMON.CONTROL'
10487 include 'COMMON.SPLITELE'
10488 include 'COMMON.SBRIDGE'
10490 C Only for check grad COMMENT if not used for checkgrad
10492 C--------------------------------------------------------
10493 C print *,"wchodze"
10497 diffafm(i)=c(i,afmend)-c(i,afmbeg)
10498 dist=dist+diffafm(i)**2
10501 Eafmforce=0.5d0*forceAFMconst
10502 & *(distafminit+totTafm*velAFMconst-dist)**2
10503 C Eafmforce=-forceAFMconst*(dist-distafminit)
10505 gradafm(i,afmend-1)=-forceAFMconst*
10506 &(distafminit+totTafm*velAFMconst-dist)
10508 gradafm(i,afmbeg-1)=forceAFMconst*
10509 &(distafminit+totTafm*velAFMconst-dist)
10512 C print *,'AFM',Eafmforce,totTafm*velAFMconst,dist