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 print *,"Processor",myrank," left VEC_AND_DERIV"
143 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
144 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
145 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
146 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
148 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
149 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
150 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
151 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
153 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
162 write (iout,*) "Soft-spheer ELEC potential"
163 c call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
166 c print *,"Processor",myrank," computed UELEC"
168 C Calculate excluded-volume interaction energy between peptide groups
173 call escp(evdw2,evdw2_14)
179 c write (iout,*) "Soft-sphere SCP potential"
180 call escp_soft_sphere(evdw2,evdw2_14)
183 c Calculate the bond-stretching energy
187 C Calculate the disulfide-bridge and other energy and the contributions
188 C from other distance constraints.
189 cd print *,'Calling EHPB'
191 cd print *,'EHPB exitted succesfully.'
193 C Calculate the virtual-bond-angle energy.
195 if (wang.gt.0d0) then
200 c print *,"Processor",myrank," computed UB"
202 C Calculate the SC local energy.
204 C print *,"TU DOCHODZE?"
206 c print *,"Processor",myrank," computed USC"
208 C Calculate the virtual-bond torsional energy.
210 cd print *,'nterm=',nterm
212 call etor(etors,edihcnstr)
217 c print *,"Processor",myrank," computed Utor"
219 C 6/23/01 Calculate double-torsional energy
221 if (wtor_d.gt.0) then
226 c print *,"Processor",myrank," computed Utord"
228 C 21/5/07 Calculate local sicdechain correlation energy
230 if (wsccor.gt.0.0d0) then
231 call eback_sc_corr(esccor)
235 C print *,"PRZED MULIt"
236 c print *,"Processor",myrank," computed Usccorr"
238 C 12/1/95 Multi-body terms
242 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
243 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
244 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
245 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
246 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
253 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
254 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
255 cd write (iout,*) "multibody_hb ecorr",ecorr
257 c print *,"Processor",myrank," computed Ucorr"
259 C If performing constraint dynamics, call the constraint energy
260 C after the equilibration time
261 if(usampl.and.totT.gt.eq_time) then
268 C 01/27/2015 added by adasko
269 C the energy component below is energy transfer into lipid environment
270 C based on partition function
271 C print *,"przed lipidami"
272 if (wliptran.gt.0) then
273 call Eliptransfer(eliptran)
275 C print *,"za lipidami"
277 time_enecalc=time_enecalc+MPI_Wtime()-time00
279 c print *,"Processor",myrank," computed Uconstr"
288 energia(2)=evdw2-evdw2_14
305 energia(8)=eello_turn3
306 energia(9)=eello_turn4
313 energia(19)=edihcnstr
315 energia(20)=Uconst+Uconst_back
318 c Here are the energies showed per procesor if the are more processors
319 c per molecule then we sum it up in sum_energy subroutine
320 c print *," Processor",myrank," calls SUM_ENERGY"
321 call sum_energy(energia,.true.)
322 if (dyn_ss) call dyn_set_nss
323 c print *," Processor",myrank," left SUM_ENERGY"
325 time_sumene=time_sumene+MPI_Wtime()-time00
329 c-------------------------------------------------------------------------------
330 subroutine sum_energy(energia,reduce)
331 implicit real*8 (a-h,o-z)
336 cMS$ATTRIBUTES C :: proc_proc
342 include 'COMMON.SETUP'
343 include 'COMMON.IOUNITS'
344 double precision energia(0:n_ene),enebuff(0:n_ene+1)
345 include 'COMMON.FFIELD'
346 include 'COMMON.DERIV'
347 include 'COMMON.INTERACT'
348 include 'COMMON.SBRIDGE'
349 include 'COMMON.CHAIN'
351 include 'COMMON.CONTROL'
352 include 'COMMON.TIME1'
355 if (nfgtasks.gt.1 .and. reduce) then
357 write (iout,*) "energies before REDUCE"
358 call enerprint(energia)
362 enebuff(i)=energia(i)
365 call MPI_Barrier(FG_COMM,IERR)
366 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
368 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
369 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
371 write (iout,*) "energies after REDUCE"
372 call enerprint(energia)
375 time_Reduce=time_Reduce+MPI_Wtime()-time00
377 if (fg_rank.eq.0) then
381 evdw2=energia(2)+energia(18)
397 eello_turn3=energia(8)
398 eello_turn4=energia(9)
405 edihcnstr=energia(19)
411 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
412 & +wang*ebe+wtor*etors+wscloc*escloc
413 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
414 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
415 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
416 & +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran
418 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
419 & +wang*ebe+wtor*etors+wscloc*escloc
420 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
421 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
422 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
423 & +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran
429 if (isnan(etot).ne.0) energia(0)=1.0d+99
431 if (isnan(etot)) energia(0)=1.0d+99
436 idumm=proc_proc(etot,i)
438 call proc_proc(etot,i)
440 if(i.eq.1)energia(0)=1.0d+99
447 c-------------------------------------------------------------------------------
448 subroutine sum_gradient
449 implicit real*8 (a-h,o-z)
454 cMS$ATTRIBUTES C :: proc_proc
460 double precision gradbufc(3,-1:maxres),gradbufx(3,-1:maxres),
461 & glocbuf(4*maxres),gradbufc_sum(3,-1:maxres)
462 & ,gloc_scbuf(3,-1:maxres)
463 include 'COMMON.SETUP'
464 include 'COMMON.IOUNITS'
465 include 'COMMON.FFIELD'
466 include 'COMMON.DERIV'
467 include 'COMMON.INTERACT'
468 include 'COMMON.SBRIDGE'
469 include 'COMMON.CHAIN'
471 include 'COMMON.CONTROL'
472 include 'COMMON.TIME1'
473 include 'COMMON.MAXGRAD'
474 include 'COMMON.SCCOR'
479 write (iout,*) "sum_gradient gvdwc, gvdwx"
481 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
482 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
487 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
488 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
489 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
492 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
493 C in virtual-bond-vector coordinates
496 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
498 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
499 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
501 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
503 c write (iout,'(i5,3f10.5,2x,f10.5)')
504 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
506 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
508 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
509 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
517 gradbufc(j,i)=wsc*gvdwc(j,i)+
518 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
519 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
520 & wel_loc*gel_loc_long(j,i)+
521 & wcorr*gradcorr_long(j,i)+
522 & wcorr5*gradcorr5_long(j,i)+
523 & wcorr6*gradcorr6_long(j,i)+
524 & wturn6*gcorr6_turn_long(j,i)+
526 & +wliptran*gliptranc(j,i)
533 gradbufc(j,i)=wsc*gvdwc(j,i)+
534 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
535 & welec*gelc_long(j,i)+
537 & wel_loc*gel_loc_long(j,i)+
538 & wcorr*gradcorr_long(j,i)+
539 & wcorr5*gradcorr5_long(j,i)+
540 & wcorr6*gradcorr6_long(j,i)+
541 & wturn6*gcorr6_turn_long(j,i)+
543 & +wliptran*gliptranc(j,i)
548 if (nfgtasks.gt.1) then
551 write (iout,*) "gradbufc before allreduce"
553 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
559 gradbufc_sum(j,i)=gradbufc(j,i)
562 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
563 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
564 c time_reduce=time_reduce+MPI_Wtime()-time00
566 c write (iout,*) "gradbufc_sum after allreduce"
568 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
573 c time_allreduce=time_allreduce+MPI_Wtime()-time00
581 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
582 write (iout,*) (i," jgrad_start",jgrad_start(i),
583 & " jgrad_end ",jgrad_end(i),
584 & i=igrad_start,igrad_end)
587 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
588 c do not parallelize this part.
590 c do i=igrad_start,igrad_end
591 c do j=jgrad_start(i),jgrad_end(i)
593 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
598 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
602 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
606 write (iout,*) "gradbufc after summing"
608 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
615 write (iout,*) "gradbufc"
617 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
623 gradbufc_sum(j,i)=gradbufc(j,i)
628 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
632 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
637 c gradbufc(k,i)=0.0d0
641 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
646 write (iout,*) "gradbufc after summing"
648 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
656 gradbufc(k,nres)=0.0d0
661 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
662 & wel_loc*gel_loc(j,i)+
663 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
664 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
665 & wel_loc*gel_loc_long(j,i)+
666 & wcorr*gradcorr_long(j,i)+
667 & wcorr5*gradcorr5_long(j,i)+
668 & wcorr6*gradcorr6_long(j,i)+
669 & wturn6*gcorr6_turn_long(j,i))+
671 & wcorr*gradcorr(j,i)+
672 & wturn3*gcorr3_turn(j,i)+
673 & wturn4*gcorr4_turn(j,i)+
674 & wcorr5*gradcorr5(j,i)+
675 & wcorr6*gradcorr6(j,i)+
676 & wturn6*gcorr6_turn(j,i)+
677 & wsccor*gsccorc(j,i)
678 & +wscloc*gscloc(j,i)
679 & +wliptran*gliptranc(j,i)
681 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
682 & wel_loc*gel_loc(j,i)+
683 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
684 & welec*gelc_long(j,i)
685 & wel_loc*gel_loc_long(j,i)+
686 & wcorr*gcorr_long(j,i)+
687 & wcorr5*gradcorr5_long(j,i)+
688 & wcorr6*gradcorr6_long(j,i)+
689 & wturn6*gcorr6_turn_long(j,i))+
691 & wcorr*gradcorr(j,i)+
692 & wturn3*gcorr3_turn(j,i)+
693 & wturn4*gcorr4_turn(j,i)+
694 & wcorr5*gradcorr5(j,i)+
695 & wcorr6*gradcorr6(j,i)+
696 & wturn6*gcorr6_turn(j,i)+
697 & wsccor*gsccorc(j,i)
698 & +wscloc*gscloc(j,i)
699 & +wliptran*gliptranc(j,i)
701 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
703 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
704 & wsccor*gsccorx(j,i)
705 & +wscloc*gsclocx(j,i)
706 & +wliptran*gliptranx(j,i)
710 write (iout,*) "gloc before adding corr"
712 write (iout,*) i,gloc(i,icg)
716 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
717 & +wcorr5*g_corr5_loc(i)
718 & +wcorr6*g_corr6_loc(i)
719 & +wturn4*gel_loc_turn4(i)
720 & +wturn3*gel_loc_turn3(i)
721 & +wturn6*gel_loc_turn6(i)
722 & +wel_loc*gel_loc_loc(i)
725 write (iout,*) "gloc after adding corr"
727 write (iout,*) i,gloc(i,icg)
731 if (nfgtasks.gt.1) then
734 gradbufc(j,i)=gradc(j,i,icg)
735 gradbufx(j,i)=gradx(j,i,icg)
739 glocbuf(i)=gloc(i,icg)
743 write (iout,*) "gloc_sc before reduce"
746 write (iout,*) i,j,gloc_sc(j,i,icg)
753 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
757 call MPI_Barrier(FG_COMM,IERR)
758 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
760 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
761 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
762 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
763 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
764 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
765 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
766 time_reduce=time_reduce+MPI_Wtime()-time00
767 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
768 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
769 time_reduce=time_reduce+MPI_Wtime()-time00
772 write (iout,*) "gloc_sc after reduce"
775 write (iout,*) i,j,gloc_sc(j,i,icg)
781 write (iout,*) "gloc after reduce"
783 write (iout,*) i,gloc(i,icg)
788 if (gnorm_check) then
790 c Compute the maximum elements of the gradient
800 gcorr3_turn_max=0.0d0
801 gcorr4_turn_max=0.0d0
804 gcorr6_turn_max=0.0d0
814 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
815 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
816 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
817 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
818 & gvdwc_scp_max=gvdwc_scp_norm
819 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
820 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
821 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
822 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
823 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
824 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
825 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
826 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
827 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
828 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
829 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
830 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
831 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
833 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
834 & gcorr3_turn_max=gcorr3_turn_norm
835 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
837 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
838 & gcorr4_turn_max=gcorr4_turn_norm
839 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
840 if (gradcorr5_norm.gt.gradcorr5_max)
841 & gradcorr5_max=gradcorr5_norm
842 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
843 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
844 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
846 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
847 & gcorr6_turn_max=gcorr6_turn_norm
848 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
849 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
850 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
851 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
852 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
853 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
854 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
855 if (gradx_scp_norm.gt.gradx_scp_max)
856 & gradx_scp_max=gradx_scp_norm
857 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
858 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
859 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
860 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
861 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
862 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
863 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
864 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
868 open(istat,file=statname,position="append")
870 open(istat,file=statname,access="append")
872 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
873 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
874 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
875 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
876 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
877 & gsccorx_max,gsclocx_max
879 if (gvdwc_max.gt.1.0d4) then
880 write (iout,*) "gvdwc gvdwx gradb gradbx"
882 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
883 & gradb(j,i),gradbx(j,i),j=1,3)
885 call pdbout(0.0d0,'cipiszcze',iout)
891 write (iout,*) "gradc gradx gloc"
893 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
894 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
898 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
902 c-------------------------------------------------------------------------------
903 subroutine rescale_weights(t_bath)
904 implicit real*8 (a-h,o-z)
906 include 'COMMON.IOUNITS'
907 include 'COMMON.FFIELD'
908 include 'COMMON.SBRIDGE'
909 double precision kfac /2.4d0/
910 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
912 c facT=2*temp0/(t_bath+temp0)
913 if (rescale_mode.eq.0) then
919 else if (rescale_mode.eq.1) then
920 facT=kfac/(kfac-1.0d0+t_bath/temp0)
921 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
922 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
923 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
924 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
925 else if (rescale_mode.eq.2) then
931 facT=licznik/dlog(dexp(x)+dexp(-x))
932 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
933 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
934 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
935 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
937 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
938 write (*,*) "Wrong RESCALE_MODE",rescale_mode
940 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
944 welec=weights(3)*fact
945 wcorr=weights(4)*fact3
946 wcorr5=weights(5)*fact4
947 wcorr6=weights(6)*fact5
948 wel_loc=weights(7)*fact2
949 wturn3=weights(8)*fact2
950 wturn4=weights(9)*fact3
951 wturn6=weights(10)*fact5
952 wtor=weights(13)*fact
953 wtor_d=weights(14)*fact2
954 wsccor=weights(21)*fact
958 C------------------------------------------------------------------------
959 subroutine enerprint(energia)
960 implicit real*8 (a-h,o-z)
962 include 'COMMON.IOUNITS'
963 include 'COMMON.FFIELD'
964 include 'COMMON.SBRIDGE'
966 double precision energia(0:n_ene)
971 evdw2=energia(2)+energia(18)
983 eello_turn3=energia(8)
984 eello_turn4=energia(9)
985 eello_turn6=energia(10)
991 edihcnstr=energia(19)
997 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
998 & estr,wbond,ebe,wang,
999 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1001 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1002 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
1003 & edihcnstr,ebr*nss,
1004 & Uconst,eliptran,wliptran,etot
1005 10 format (/'Virtual-chain energies:'//
1006 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1007 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1008 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1009 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
1010 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1011 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1012 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1013 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1014 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1015 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1016 & ' (SS bridges & dist. cnstr.)'/
1017 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1018 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1019 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1020 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1021 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1022 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1023 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1024 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1025 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1026 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1027 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1028 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
1029 & 'ETOT= ',1pE16.6,' (total)')
1031 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1032 & estr,wbond,ebe,wang,
1033 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1035 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1036 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1037 & ebr*nss,Uconst,eliptran,wliptran,etot
1038 10 format (/'Virtual-chain energies:'//
1039 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1040 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1041 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1042 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1043 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1044 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1045 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1046 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1047 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1048 & ' (SS bridges & dist. cnstr.)'/
1049 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1050 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1051 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1052 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1053 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1054 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1055 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1056 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1057 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1058 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1059 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1060 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
1061 & 'ETOT= ',1pE16.6,' (total)')
1065 C-----------------------------------------------------------------------
1066 subroutine elj(evdw)
1068 C This subroutine calculates the interaction energy of nonbonded side chains
1069 C assuming the LJ potential of interaction.
1071 implicit real*8 (a-h,o-z)
1072 include 'DIMENSIONS'
1073 parameter (accur=1.0d-10)
1074 include 'COMMON.GEO'
1075 include 'COMMON.VAR'
1076 include 'COMMON.LOCAL'
1077 include 'COMMON.CHAIN'
1078 include 'COMMON.DERIV'
1079 include 'COMMON.INTERACT'
1080 include 'COMMON.TORSION'
1081 include 'COMMON.SBRIDGE'
1082 include 'COMMON.NAMES'
1083 include 'COMMON.IOUNITS'
1084 include 'COMMON.CONTACTS'
1086 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1088 do i=iatsc_s,iatsc_e
1089 itypi=iabs(itype(i))
1090 if (itypi.eq.ntyp1) cycle
1091 itypi1=iabs(itype(i+1))
1098 C Calculate SC interaction energy.
1100 do iint=1,nint_gr(i)
1101 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1102 cd & 'iend=',iend(i,iint)
1103 do j=istart(i,iint),iend(i,iint)
1104 itypj=iabs(itype(j))
1105 if (itypj.eq.ntyp1) cycle
1109 C Change 12/1/95 to calculate four-body interactions
1110 rij=xj*xj+yj*yj+zj*zj
1112 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1113 eps0ij=eps(itypi,itypj)
1115 C have you changed here?
1119 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1120 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1121 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1122 cd & restyp(itypi),i,restyp(itypj),j,a(itypi,itypj),
1123 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1124 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1127 C Calculate the components of the gradient in DC and X
1129 fac=-rrij*(e1+evdwij)
1134 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1135 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1136 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1137 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1141 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1145 C 12/1/95, revised on 5/20/97
1147 C Calculate the contact function. The ith column of the array JCONT will
1148 C contain the numbers of atoms that make contacts with the atom I (of numbers
1149 C greater than I). The arrays FACONT and GACONT will contain the values of
1150 C the contact function and its derivative.
1152 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1153 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1154 C Uncomment next line, if the correlation interactions are contact function only
1155 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1157 sigij=sigma(itypi,itypj)
1158 r0ij=rs0(itypi,itypj)
1160 C Check whether the SC's are not too far to make a contact.
1163 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1164 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1166 if (fcont.gt.0.0D0) then
1167 C If the SC-SC distance if close to sigma, apply spline.
1168 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1169 cAdam & fcont1,fprimcont1)
1170 cAdam fcont1=1.0d0-fcont1
1171 cAdam if (fcont1.gt.0.0d0) then
1172 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1173 cAdam fcont=fcont*fcont1
1175 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1176 cga eps0ij=1.0d0/dsqrt(eps0ij)
1178 cga gg(k)=gg(k)*eps0ij
1180 cga eps0ij=-evdwij*eps0ij
1181 C Uncomment for AL's type of SC correlation interactions.
1182 cadam eps0ij=-evdwij
1183 num_conti=num_conti+1
1184 jcont(num_conti,i)=j
1185 facont(num_conti,i)=fcont*eps0ij
1186 fprimcont=eps0ij*fprimcont/rij
1188 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1189 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1190 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1191 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1192 gacont(1,num_conti,i)=-fprimcont*xj
1193 gacont(2,num_conti,i)=-fprimcont*yj
1194 gacont(3,num_conti,i)=-fprimcont*zj
1195 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1196 cd write (iout,'(2i3,3f10.5)')
1197 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1203 num_cont(i)=num_conti
1207 gvdwc(j,i)=expon*gvdwc(j,i)
1208 gvdwx(j,i)=expon*gvdwx(j,i)
1211 C******************************************************************************
1215 C To save time, the factor of EXPON has been extracted from ALL components
1216 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1219 C******************************************************************************
1222 C-----------------------------------------------------------------------------
1223 subroutine eljk(evdw)
1225 C This subroutine calculates the interaction energy of nonbonded side chains
1226 C assuming the LJK potential of interaction.
1228 implicit real*8 (a-h,o-z)
1229 include 'DIMENSIONS'
1230 include 'COMMON.GEO'
1231 include 'COMMON.VAR'
1232 include 'COMMON.LOCAL'
1233 include 'COMMON.CHAIN'
1234 include 'COMMON.DERIV'
1235 include 'COMMON.INTERACT'
1236 include 'COMMON.IOUNITS'
1237 include 'COMMON.NAMES'
1240 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1242 do i=iatsc_s,iatsc_e
1243 itypi=iabs(itype(i))
1244 if (itypi.eq.ntyp1) cycle
1245 itypi1=iabs(itype(i+1))
1250 C Calculate SC interaction energy.
1252 do iint=1,nint_gr(i)
1253 do j=istart(i,iint),iend(i,iint)
1254 itypj=iabs(itype(j))
1255 if (itypj.eq.ntyp1) cycle
1259 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1260 fac_augm=rrij**expon
1261 e_augm=augm(itypi,itypj)*fac_augm
1262 r_inv_ij=dsqrt(rrij)
1264 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1265 fac=r_shift_inv**expon
1266 C have you changed here?
1270 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1271 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1272 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1273 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1274 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1275 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1276 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1279 C Calculate the components of the gradient in DC and X
1281 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1286 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1287 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1288 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1289 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1293 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1301 gvdwc(j,i)=expon*gvdwc(j,i)
1302 gvdwx(j,i)=expon*gvdwx(j,i)
1307 C-----------------------------------------------------------------------------
1308 subroutine ebp(evdw)
1310 C This subroutine calculates the interaction energy of nonbonded side chains
1311 C assuming the Berne-Pechukas potential of interaction.
1313 implicit real*8 (a-h,o-z)
1314 include 'DIMENSIONS'
1315 include 'COMMON.GEO'
1316 include 'COMMON.VAR'
1317 include 'COMMON.LOCAL'
1318 include 'COMMON.CHAIN'
1319 include 'COMMON.DERIV'
1320 include 'COMMON.NAMES'
1321 include 'COMMON.INTERACT'
1322 include 'COMMON.IOUNITS'
1323 include 'COMMON.CALC'
1324 common /srutu/ icall
1325 c double precision rrsave(maxdim)
1328 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1330 c if (icall.eq.0) then
1336 do i=iatsc_s,iatsc_e
1337 itypi=iabs(itype(i))
1338 if (itypi.eq.ntyp1) cycle
1339 itypi1=iabs(itype(i+1))
1343 dxi=dc_norm(1,nres+i)
1344 dyi=dc_norm(2,nres+i)
1345 dzi=dc_norm(3,nres+i)
1346 c dsci_inv=dsc_inv(itypi)
1347 dsci_inv=vbld_inv(i+nres)
1349 C Calculate SC interaction energy.
1351 do iint=1,nint_gr(i)
1352 do j=istart(i,iint),iend(i,iint)
1354 itypj=iabs(itype(j))
1355 if (itypj.eq.ntyp1) cycle
1356 c dscj_inv=dsc_inv(itypj)
1357 dscj_inv=vbld_inv(j+nres)
1358 chi1=chi(itypi,itypj)
1359 chi2=chi(itypj,itypi)
1366 alf12=0.5D0*(alf1+alf2)
1367 C For diagnostics only!!!
1380 dxj=dc_norm(1,nres+j)
1381 dyj=dc_norm(2,nres+j)
1382 dzj=dc_norm(3,nres+j)
1383 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1384 cd if (icall.eq.0) then
1390 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1392 C Calculate whole angle-dependent part of epsilon and contributions
1393 C to its derivatives
1394 C have you changed here?
1395 fac=(rrij*sigsq)**expon2
1398 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1399 eps2der=evdwij*eps3rt
1400 eps3der=evdwij*eps2rt
1401 evdwij=evdwij*eps2rt*eps3rt
1404 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1406 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1407 cd & restyp(itypi),i,restyp(itypj),j,
1408 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1409 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1410 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1413 C Calculate gradient components.
1414 e1=e1*eps1*eps2rt**2*eps3rt**2
1415 fac=-expon*(e1+evdwij)
1418 C Calculate radial part of the gradient
1422 C Calculate the angular part of the gradient and sum add the contributions
1423 C to the appropriate components of the Cartesian gradient.
1431 C-----------------------------------------------------------------------------
1432 subroutine egb(evdw)
1434 C This subroutine calculates the interaction energy of nonbonded side chains
1435 C assuming the Gay-Berne potential of interaction.
1437 implicit real*8 (a-h,o-z)
1438 include 'DIMENSIONS'
1439 include 'COMMON.GEO'
1440 include 'COMMON.VAR'
1441 include 'COMMON.LOCAL'
1442 include 'COMMON.CHAIN'
1443 include 'COMMON.DERIV'
1444 include 'COMMON.NAMES'
1445 include 'COMMON.INTERACT'
1446 include 'COMMON.IOUNITS'
1447 include 'COMMON.CALC'
1448 include 'COMMON.CONTROL'
1449 include 'COMMON.SPLITELE'
1450 include 'COMMON.SBRIDGE'
1452 integer xshift,yshift,zshift
1454 ccccc energy_dec=.false.
1455 C print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1458 c if (icall.eq.0) lprn=.false.
1460 C the loop over all 27 posible neigbours (for xshift=0,yshift=0,zshift=0
1461 C we have the original box)
1465 do i=iatsc_s,iatsc_e
1466 itypi=iabs(itype(i))
1467 if (itypi.eq.ntyp1) cycle
1468 itypi1=iabs(itype(i+1))
1472 C Return atom into box, boxxsize is size of box in x dimension
1474 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
1475 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
1476 C Condition for being inside the proper box
1477 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
1478 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
1482 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
1483 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
1484 C Condition for being inside the proper box
1485 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
1486 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
1490 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
1491 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
1492 C Condition for being inside the proper box
1493 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
1494 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
1498 if (xi.lt.0) xi=xi+boxxsize
1500 if (yi.lt.0) yi=yi+boxysize
1502 if (zi.lt.0) zi=zi+boxzsize
1503 C define scaling factor for lipids
1505 C if (positi.le.0) positi=positi+boxzsize
1507 C first for peptide groups
1508 c for each residue check if it is in lipid or lipid water border area
1509 if ((zi.gt.bordlipbot)
1510 &.and.(zi.lt.bordliptop)) then
1511 C the energy transfer exist
1512 if (zi.lt.buflipbot) then
1513 C what fraction I am in
1515 & ((zi-bordlipbot)/lipbufthick)
1516 C lipbufthick is thickenes of lipid buffore
1517 sslipi=sscalelip(fracinbuf)
1518 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1519 elseif (zi.gt.bufliptop) then
1520 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1521 sslipi=sscalelip(fracinbuf)
1522 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1532 C xi=xi+xshift*boxxsize
1533 C yi=yi+yshift*boxysize
1534 C zi=zi+zshift*boxzsize
1536 dxi=dc_norm(1,nres+i)
1537 dyi=dc_norm(2,nres+i)
1538 dzi=dc_norm(3,nres+i)
1539 c dsci_inv=dsc_inv(itypi)
1540 dsci_inv=vbld_inv(i+nres)
1541 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1542 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1544 C Calculate SC interaction energy.
1546 do iint=1,nint_gr(i)
1547 do j=istart(i,iint),iend(i,iint)
1548 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1549 call dyn_ssbond_ene(i,j,evdwij)
1551 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1552 & 'evdw',i,j,evdwij,' ss'
1555 itypj=iabs(itype(j))
1556 if (itypj.eq.ntyp1) cycle
1557 c dscj_inv=dsc_inv(itypj)
1558 dscj_inv=vbld_inv(j+nres)
1559 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1560 c & 1.0d0/vbld(j+nres)
1561 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1562 sig0ij=sigma(itypi,itypj)
1563 chi1=chi(itypi,itypj)
1564 chi2=chi(itypj,itypi)
1571 alf12=0.5D0*(alf1+alf2)
1572 C For diagnostics only!!!
1585 C Return atom J into box the original box
1587 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
1588 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
1589 C Condition for being inside the proper box
1590 c if ((xj.gt.((0.5d0)*boxxsize)).or.
1591 c & (xj.lt.((-0.5d0)*boxxsize))) then
1595 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
1596 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
1597 C Condition for being inside the proper box
1598 c if ((yj.gt.((0.5d0)*boxysize)).or.
1599 c & (yj.lt.((-0.5d0)*boxysize))) then
1603 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
1604 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
1605 C Condition for being inside the proper box
1606 c if ((zj.gt.((0.5d0)*boxzsize)).or.
1607 c & (zj.lt.((-0.5d0)*boxzsize))) then
1611 if (xj.lt.0) xj=xj+boxxsize
1613 if (yj.lt.0) yj=yj+boxysize
1615 if (zj.lt.0) zj=zj+boxzsize
1616 if ((zj.gt.bordlipbot)
1617 &.and.(zj.lt.bordliptop)) then
1618 C the energy transfer exist
1619 if (zj.lt.buflipbot) then
1620 C what fraction I am in
1622 & ((zj-bordlipbot)/lipbufthick)
1623 C lipbufthick is thickenes of lipid buffore
1624 sslipj=sscalelip(fracinbuf)
1625 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1626 elseif (zj.gt.bufliptop) then
1627 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1628 sslipj=sscalelip(fracinbuf)
1629 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1638 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1639 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1640 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1641 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1642 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'(2e10.5)')
1643 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
1644 C if (ssgradlipj.gt.0.0d0) print *,"??WTF??"
1645 C print *,sslipi,sslipj,bordlipbot,zi,zj
1646 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1654 xj=xj_safe+xshift*boxxsize
1655 yj=yj_safe+yshift*boxysize
1656 zj=zj_safe+zshift*boxzsize
1657 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1658 if(dist_temp.lt.dist_init) then
1668 if (subchap.eq.1) then
1677 dxj=dc_norm(1,nres+j)
1678 dyj=dc_norm(2,nres+j)
1679 dzj=dc_norm(3,nres+j)
1683 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1684 c write (iout,*) "j",j," dc_norm",
1685 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1686 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1688 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1689 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1691 c write (iout,'(a7,4f8.3)')
1692 c & "ssscale",sss,((1.0d0/rij)/sigma(itypi,itypj)),r_cut,rlamb
1693 if (sss.gt.0.0d0) then
1694 C Calculate angle-dependent terms of energy and contributions to their
1698 sig=sig0ij*dsqrt(sigsq)
1699 rij_shift=1.0D0/rij-sig+sig0ij
1700 c for diagnostics; uncomment
1701 c rij_shift=1.2*sig0ij
1702 C I hate to put IF's in the loops, but here don't have another choice!!!!
1703 if (rij_shift.le.0.0D0) then
1705 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1706 cd & restyp(itypi),i,restyp(itypj),j,
1707 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1711 c---------------------------------------------------------------
1712 rij_shift=1.0D0/rij_shift
1713 fac=rij_shift**expon
1714 C here to start with
1719 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1720 eps2der=evdwij*eps3rt
1721 eps3der=evdwij*eps2rt
1722 C write(63,'(2i3,2e10.3,2f10.5)') i,j,aa,bb, evdwij,
1723 C &((sslipi+sslipj)/2.0d0+
1724 C &(2.0d0-sslipi-sslipj)/2.0d0)
1725 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1726 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1727 evdwij=evdwij*eps2rt*eps3rt
1728 evdw=evdw+evdwij*sss
1730 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1732 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1733 & restyp(itypi),i,restyp(itypj),j,
1734 & epsi,sigm,chi1,chi2,chip1,chip2,
1735 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1736 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1740 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1743 C Calculate gradient components.
1744 e1=e1*eps1*eps2rt**2*eps3rt**2
1745 fac=-expon*(e1+evdwij)*rij_shift
1748 c print '(2i4,6f8.4)',i,j,sss,sssgrad*
1749 c & evdwij,fac,sigma(itypi,itypj),expon
1750 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1752 C Calculate the radial part of the gradient
1753 gg_lipi(3)=eps1*(eps2rt*eps2rt)
1754 &*(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip*
1755 & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
1756 &+faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
1757 gg_lipj(3)=ssgradlipj*gg_lipi(3)
1758 gg_lipi(3)=gg_lipi(3)*ssgradlipi
1764 C Calculate angular part of the gradient.
1774 c write (iout,*) "Number of loop steps in EGB:",ind
1775 cccc energy_dec=.false.
1778 C-----------------------------------------------------------------------------
1779 subroutine egbv(evdw)
1781 C This subroutine calculates the interaction energy of nonbonded side chains
1782 C assuming the Gay-Berne-Vorobjev potential of interaction.
1784 implicit real*8 (a-h,o-z)
1785 include 'DIMENSIONS'
1786 include 'COMMON.GEO'
1787 include 'COMMON.VAR'
1788 include 'COMMON.LOCAL'
1789 include 'COMMON.CHAIN'
1790 include 'COMMON.DERIV'
1791 include 'COMMON.NAMES'
1792 include 'COMMON.INTERACT'
1793 include 'COMMON.IOUNITS'
1794 include 'COMMON.CALC'
1795 common /srutu/ icall
1798 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1801 c if (icall.eq.0) lprn=.true.
1803 do i=iatsc_s,iatsc_e
1804 itypi=iabs(itype(i))
1805 if (itypi.eq.ntyp1) cycle
1806 itypi1=iabs(itype(i+1))
1811 if (xi.lt.0) xi=xi+boxxsize
1813 if (yi.lt.0) yi=yi+boxysize
1815 if (zi.lt.0) zi=zi+boxzsize
1816 C define scaling factor for lipids
1818 C if (positi.le.0) positi=positi+boxzsize
1820 C first for peptide groups
1821 c for each residue check if it is in lipid or lipid water border area
1822 if ((zi.gt.bordlipbot)
1823 &.and.(zi.lt.bordliptop)) then
1824 C the energy transfer exist
1825 if (zi.lt.buflipbot) then
1826 C what fraction I am in
1828 & ((zi-bordlipbot)/lipbufthick)
1829 C lipbufthick is thickenes of lipid buffore
1830 sslipi=sscalelip(fracinbuf)
1831 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1832 elseif (zi.gt.bufliptop) then
1833 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1834 sslipi=sscalelip(fracinbuf)
1835 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1845 dxi=dc_norm(1,nres+i)
1846 dyi=dc_norm(2,nres+i)
1847 dzi=dc_norm(3,nres+i)
1848 c dsci_inv=dsc_inv(itypi)
1849 dsci_inv=vbld_inv(i+nres)
1851 C Calculate SC interaction energy.
1853 do iint=1,nint_gr(i)
1854 do j=istart(i,iint),iend(i,iint)
1856 itypj=iabs(itype(j))
1857 if (itypj.eq.ntyp1) cycle
1858 c dscj_inv=dsc_inv(itypj)
1859 dscj_inv=vbld_inv(j+nres)
1860 sig0ij=sigma(itypi,itypj)
1861 r0ij=r0(itypi,itypj)
1862 chi1=chi(itypi,itypj)
1863 chi2=chi(itypj,itypi)
1870 alf12=0.5D0*(alf1+alf2)
1871 C For diagnostics only!!!
1885 if (xj.lt.0) xj=xj+boxxsize
1887 if (yj.lt.0) yj=yj+boxysize
1889 if (zj.lt.0) zj=zj+boxzsize
1890 if ((zj.gt.bordlipbot)
1891 &.and.(zj.lt.bordliptop)) then
1892 C the energy transfer exist
1893 if (zj.lt.buflipbot) then
1894 C what fraction I am in
1896 & ((zj-bordlipbot)/lipbufthick)
1897 C lipbufthick is thickenes of lipid buffore
1898 sslipj=sscalelip(fracinbuf)
1899 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1900 elseif (zj.gt.bufliptop) then
1901 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1902 sslipj=sscalelip(fracinbuf)
1903 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1912 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1913 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1914 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1915 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1916 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'2e10.5')
1917 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
1918 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1926 xj=xj_safe+xshift*boxxsize
1927 yj=yj_safe+yshift*boxysize
1928 zj=zj_safe+zshift*boxzsize
1929 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1930 if(dist_temp.lt.dist_init) then
1940 if (subchap.eq.1) then
1949 dxj=dc_norm(1,nres+j)
1950 dyj=dc_norm(2,nres+j)
1951 dzj=dc_norm(3,nres+j)
1952 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1954 C Calculate angle-dependent terms of energy and contributions to their
1958 sig=sig0ij*dsqrt(sigsq)
1959 rij_shift=1.0D0/rij-sig+r0ij
1960 C I hate to put IF's in the loops, but here don't have another choice!!!!
1961 if (rij_shift.le.0.0D0) then
1966 c---------------------------------------------------------------
1967 rij_shift=1.0D0/rij_shift
1968 fac=rij_shift**expon
1971 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1972 eps2der=evdwij*eps3rt
1973 eps3der=evdwij*eps2rt
1974 fac_augm=rrij**expon
1975 e_augm=augm(itypi,itypj)*fac_augm
1976 evdwij=evdwij*eps2rt*eps3rt
1977 evdw=evdw+evdwij+e_augm
1979 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1981 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1982 & restyp(itypi),i,restyp(itypj),j,
1983 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
1984 & chi1,chi2,chip1,chip2,
1985 & eps1,eps2rt**2,eps3rt**2,
1986 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1989 C Calculate gradient components.
1990 e1=e1*eps1*eps2rt**2*eps3rt**2
1991 fac=-expon*(e1+evdwij)*rij_shift
1993 fac=rij*fac-2*expon*rrij*e_augm
1994 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1995 C Calculate the radial part of the gradient
1999 C Calculate angular part of the gradient.
2005 C-----------------------------------------------------------------------------
2006 subroutine sc_angular
2007 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
2008 C om12. Called by ebp, egb, and egbv.
2010 include 'COMMON.CALC'
2011 include 'COMMON.IOUNITS'
2015 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2016 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2017 om12=dxi*dxj+dyi*dyj+dzi*dzj
2019 C Calculate eps1(om12) and its derivative in om12
2020 faceps1=1.0D0-om12*chiom12
2021 faceps1_inv=1.0D0/faceps1
2022 eps1=dsqrt(faceps1_inv)
2023 C Following variable is eps1*deps1/dom12
2024 eps1_om12=faceps1_inv*chiom12
2029 c write (iout,*) "om12",om12," eps1",eps1
2030 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
2035 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
2036 sigsq=1.0D0-facsig*faceps1_inv
2037 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
2038 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
2039 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
2045 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
2046 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
2048 C Calculate eps2 and its derivatives in om1, om2, and om12.
2051 chipom12=chip12*om12
2052 facp=1.0D0-om12*chipom12
2054 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
2055 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
2056 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
2057 C Following variable is the square root of eps2
2058 eps2rt=1.0D0-facp1*facp_inv
2059 C Following three variables are the derivatives of the square root of eps
2060 C in om1, om2, and om12.
2061 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
2062 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
2063 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
2064 C Evaluate the "asymmetric" factor in the VDW constant, eps3
2065 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
2066 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
2067 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
2068 c & " eps2rt_om12",eps2rt_om12
2069 C Calculate whole angle-dependent part of epsilon and contributions
2070 C to its derivatives
2073 C----------------------------------------------------------------------------
2075 implicit real*8 (a-h,o-z)
2076 include 'DIMENSIONS'
2077 include 'COMMON.CHAIN'
2078 include 'COMMON.DERIV'
2079 include 'COMMON.CALC'
2080 include 'COMMON.IOUNITS'
2081 double precision dcosom1(3),dcosom2(3)
2082 cc print *,'sss=',sss
2083 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2084 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2085 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2086 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2090 c eom12=evdwij*eps1_om12
2092 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2093 c & " sigder",sigder
2094 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2095 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2097 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2098 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2101 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss
2103 c write (iout,*) "gg",(gg(k),k=1,3)
2105 gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k)
2106 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2107 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss
2108 gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)
2109 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2110 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss
2111 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2112 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2113 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2114 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2117 C Calculate the components of the gradient in DC and X
2121 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2125 gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
2126 gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
2130 C-----------------------------------------------------------------------
2131 subroutine e_softsphere(evdw)
2133 C This subroutine calculates the interaction energy of nonbonded side chains
2134 C assuming the LJ potential of interaction.
2136 implicit real*8 (a-h,o-z)
2137 include 'DIMENSIONS'
2138 parameter (accur=1.0d-10)
2139 include 'COMMON.GEO'
2140 include 'COMMON.VAR'
2141 include 'COMMON.LOCAL'
2142 include 'COMMON.CHAIN'
2143 include 'COMMON.DERIV'
2144 include 'COMMON.INTERACT'
2145 include 'COMMON.TORSION'
2146 include 'COMMON.SBRIDGE'
2147 include 'COMMON.NAMES'
2148 include 'COMMON.IOUNITS'
2149 include 'COMMON.CONTACTS'
2151 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2153 do i=iatsc_s,iatsc_e
2154 itypi=iabs(itype(i))
2155 if (itypi.eq.ntyp1) cycle
2156 itypi1=iabs(itype(i+1))
2161 C Calculate SC interaction energy.
2163 do iint=1,nint_gr(i)
2164 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2165 cd & 'iend=',iend(i,iint)
2166 do j=istart(i,iint),iend(i,iint)
2167 itypj=iabs(itype(j))
2168 if (itypj.eq.ntyp1) cycle
2172 rij=xj*xj+yj*yj+zj*zj
2173 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2174 r0ij=r0(itypi,itypj)
2176 c print *,i,j,r0ij,dsqrt(rij)
2177 if (rij.lt.r0ijsq) then
2178 evdwij=0.25d0*(rij-r0ijsq)**2
2186 C Calculate the components of the gradient in DC and X
2192 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2193 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2194 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2195 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2199 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2207 C--------------------------------------------------------------------------
2208 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2211 C Soft-sphere potential of p-p interaction
2213 implicit real*8 (a-h,o-z)
2214 include 'DIMENSIONS'
2215 include 'COMMON.CONTROL'
2216 include 'COMMON.IOUNITS'
2217 include 'COMMON.GEO'
2218 include 'COMMON.VAR'
2219 include 'COMMON.LOCAL'
2220 include 'COMMON.CHAIN'
2221 include 'COMMON.DERIV'
2222 include 'COMMON.INTERACT'
2223 include 'COMMON.CONTACTS'
2224 include 'COMMON.TORSION'
2225 include 'COMMON.VECTORS'
2226 include 'COMMON.FFIELD'
2228 C write(iout,*) 'In EELEC_soft_sphere'
2235 do i=iatel_s,iatel_e
2236 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2240 xmedi=c(1,i)+0.5d0*dxi
2241 ymedi=c(2,i)+0.5d0*dyi
2242 zmedi=c(3,i)+0.5d0*dzi
2243 xmedi=mod(xmedi,boxxsize)
2244 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2245 ymedi=mod(ymedi,boxysize)
2246 if (ymedi.lt.0) ymedi=ymedi+boxysize
2247 zmedi=mod(zmedi,boxzsize)
2248 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2250 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2251 do j=ielstart(i),ielend(i)
2252 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
2256 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2257 r0ij=rpp(iteli,itelj)
2266 if (xj.lt.0) xj=xj+boxxsize
2268 if (yj.lt.0) yj=yj+boxysize
2270 if (zj.lt.0) zj=zj+boxzsize
2271 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2279 xj=xj_safe+xshift*boxxsize
2280 yj=yj_safe+yshift*boxysize
2281 zj=zj_safe+zshift*boxzsize
2282 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2283 if(dist_temp.lt.dist_init) then
2293 if (isubchap.eq.1) then
2302 rij=xj*xj+yj*yj+zj*zj
2303 sss=sscale(sqrt(rij))
2304 sssgrad=sscagrad(sqrt(rij))
2305 if (rij.lt.r0ijsq) then
2306 evdw1ij=0.25d0*(rij-r0ijsq)**2
2312 evdw1=evdw1+evdw1ij*sss
2314 C Calculate contributions to the Cartesian gradient.
2316 ggg(1)=fac*xj*sssgrad
2317 ggg(2)=fac*yj*sssgrad
2318 ggg(3)=fac*zj*sssgrad
2320 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2321 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2324 * Loop over residues i+1 thru j-1.
2328 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2333 cgrad do i=nnt,nct-1
2335 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2337 cgrad do j=i+1,nct-1
2339 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2345 c------------------------------------------------------------------------------
2346 subroutine vec_and_deriv
2347 implicit real*8 (a-h,o-z)
2348 include 'DIMENSIONS'
2352 include 'COMMON.IOUNITS'
2353 include 'COMMON.GEO'
2354 include 'COMMON.VAR'
2355 include 'COMMON.LOCAL'
2356 include 'COMMON.CHAIN'
2357 include 'COMMON.VECTORS'
2358 include 'COMMON.SETUP'
2359 include 'COMMON.TIME1'
2360 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2361 C Compute the local reference systems. For reference system (i), the
2362 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2363 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2365 do i=ivec_start,ivec_end
2369 if (i.eq.nres-1) then
2370 C Case of the last full residue
2371 C Compute the Z-axis
2372 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2373 costh=dcos(pi-theta(nres))
2374 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2378 C Compute the derivatives of uz
2380 uzder(2,1,1)=-dc_norm(3,i-1)
2381 uzder(3,1,1)= dc_norm(2,i-1)
2382 uzder(1,2,1)= dc_norm(3,i-1)
2384 uzder(3,2,1)=-dc_norm(1,i-1)
2385 uzder(1,3,1)=-dc_norm(2,i-1)
2386 uzder(2,3,1)= dc_norm(1,i-1)
2389 uzder(2,1,2)= dc_norm(3,i)
2390 uzder(3,1,2)=-dc_norm(2,i)
2391 uzder(1,2,2)=-dc_norm(3,i)
2393 uzder(3,2,2)= dc_norm(1,i)
2394 uzder(1,3,2)= dc_norm(2,i)
2395 uzder(2,3,2)=-dc_norm(1,i)
2397 C Compute the Y-axis
2400 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2402 C Compute the derivatives of uy
2405 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2406 & -dc_norm(k,i)*dc_norm(j,i-1)
2407 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2409 uyder(j,j,1)=uyder(j,j,1)-costh
2410 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2415 uygrad(l,k,j,i)=uyder(l,k,j)
2416 uzgrad(l,k,j,i)=uzder(l,k,j)
2420 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2421 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2422 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2423 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2426 C Compute the Z-axis
2427 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2428 costh=dcos(pi-theta(i+2))
2429 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2433 C Compute the derivatives of uz
2435 uzder(2,1,1)=-dc_norm(3,i+1)
2436 uzder(3,1,1)= dc_norm(2,i+1)
2437 uzder(1,2,1)= dc_norm(3,i+1)
2439 uzder(3,2,1)=-dc_norm(1,i+1)
2440 uzder(1,3,1)=-dc_norm(2,i+1)
2441 uzder(2,3,1)= dc_norm(1,i+1)
2444 uzder(2,1,2)= dc_norm(3,i)
2445 uzder(3,1,2)=-dc_norm(2,i)
2446 uzder(1,2,2)=-dc_norm(3,i)
2448 uzder(3,2,2)= dc_norm(1,i)
2449 uzder(1,3,2)= dc_norm(2,i)
2450 uzder(2,3,2)=-dc_norm(1,i)
2452 C Compute the Y-axis
2455 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2457 C Compute the derivatives of uy
2460 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2461 & -dc_norm(k,i)*dc_norm(j,i+1)
2462 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2464 uyder(j,j,1)=uyder(j,j,1)-costh
2465 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2470 uygrad(l,k,j,i)=uyder(l,k,j)
2471 uzgrad(l,k,j,i)=uzder(l,k,j)
2475 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2476 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2477 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2478 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2482 vbld_inv_temp(1)=vbld_inv(i+1)
2483 if (i.lt.nres-1) then
2484 vbld_inv_temp(2)=vbld_inv(i+2)
2486 vbld_inv_temp(2)=vbld_inv(i)
2491 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2492 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2497 #if defined(PARVEC) && defined(MPI)
2498 if (nfgtasks1.gt.1) then
2500 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2501 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2502 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2503 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2504 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2506 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2507 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2509 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2510 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2511 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2512 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2513 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2514 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2515 time_gather=time_gather+MPI_Wtime()-time00
2517 c if (fg_rank.eq.0) then
2518 c write (iout,*) "Arrays UY and UZ"
2520 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2527 C-----------------------------------------------------------------------------
2528 subroutine check_vecgrad
2529 implicit real*8 (a-h,o-z)
2530 include 'DIMENSIONS'
2531 include 'COMMON.IOUNITS'
2532 include 'COMMON.GEO'
2533 include 'COMMON.VAR'
2534 include 'COMMON.LOCAL'
2535 include 'COMMON.CHAIN'
2536 include 'COMMON.VECTORS'
2537 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2538 dimension uyt(3,maxres),uzt(3,maxres)
2539 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2540 double precision delta /1.0d-7/
2543 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2544 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2545 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2546 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2547 cd & (dc_norm(if90,i),if90=1,3)
2548 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2549 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2550 cd write(iout,'(a)')
2556 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2557 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2570 cd write (iout,*) 'i=',i
2572 erij(k)=dc_norm(k,i)
2576 dc_norm(k,i)=erij(k)
2578 dc_norm(j,i)=dc_norm(j,i)+delta
2579 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2581 c dc_norm(k,i)=dc_norm(k,i)/fac
2583 c write (iout,*) (dc_norm(k,i),k=1,3)
2584 c write (iout,*) (erij(k),k=1,3)
2587 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2588 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2589 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2590 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2592 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2593 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2594 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2597 dc_norm(k,i)=erij(k)
2600 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2601 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2602 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2603 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2604 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2605 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2606 cd write (iout,'(a)')
2611 C--------------------------------------------------------------------------
2612 subroutine set_matrices
2613 implicit real*8 (a-h,o-z)
2614 include 'DIMENSIONS'
2617 include "COMMON.SETUP"
2619 integer status(MPI_STATUS_SIZE)
2621 include 'COMMON.IOUNITS'
2622 include 'COMMON.GEO'
2623 include 'COMMON.VAR'
2624 include 'COMMON.LOCAL'
2625 include 'COMMON.CHAIN'
2626 include 'COMMON.DERIV'
2627 include 'COMMON.INTERACT'
2628 include 'COMMON.CONTACTS'
2629 include 'COMMON.TORSION'
2630 include 'COMMON.VECTORS'
2631 include 'COMMON.FFIELD'
2632 double precision auxvec(2),auxmat(2,2)
2634 C Compute the virtual-bond-torsional-angle dependent quantities needed
2635 C to calculate the el-loc multibody terms of various order.
2637 c write(iout,*) 'nphi=',nphi,nres
2639 do i=ivec_start+2,ivec_end+2
2644 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2645 iti = itortyp(itype(i-2))
2649 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2650 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2651 iti1 = itortyp(itype(i-1))
2656 b1(1,i-2)=bnew1(1,1,iti)*dsin(theta(i-1)/2.0)
2657 & +bnew1(2,1,iti)*dsin(theta(i-1))
2658 & +bnew1(3,1,iti)*dcos(theta(i-1)/2.0)
2659 gtb1(1,i-2)=bnew1(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2660 & +bnew1(2,1,iti)*dcos(theta(i-1))
2661 & -bnew1(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2662 c & +bnew1(3,1,iti)*sin(alpha(i))*cos(beta(i))
2663 c &*(cos(theta(i)/2.0)
2664 b2(1,i-2)=bnew2(1,1,iti)*dsin(theta(i-1)/2.0)
2665 & +bnew2(2,1,iti)*dsin(theta(i-1))
2666 & +bnew2(3,1,iti)*dcos(theta(i-1)/2.0)
2667 c & +bnew2(3,1,iti)*sin(alpha(i))*cos(beta(i))
2668 c &*(cos(theta(i)/2.0)
2669 gtb2(1,i-2)=bnew2(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2670 & +bnew2(2,1,iti)*dcos(theta(i-1))
2671 & -bnew2(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2672 c if (ggb1(1,i).eq.0.0d0) then
2673 c write(iout,*) 'i=',i,ggb1(1,i),
2674 c &bnew1(1,1,iti)*cos(theta(i)/2.0)/2.0,
2675 c &bnew1(2,1,iti)*cos(theta(i)),
2676 c &bnew1(3,1,iti)*sin(theta(i)/2.0)/2.0
2678 b1(2,i-2)=bnew1(1,2,iti)
2680 b2(2,i-2)=bnew2(1,2,iti)
2682 EE(1,1,i-2)=eenew(1,iti)*dcos(theta(i-1))
2683 EE(1,2,i-2)=eeold(1,2,iti)
2684 EE(2,1,i-2)=eeold(2,1,iti)
2685 EE(2,2,i-2)=eeold(2,2,iti)
2686 gtEE(1,1,i-2)=-eenew(1,iti)*dsin(theta(i-1))
2691 c EE(1,2,iti)=0.5d0*eenew(1,iti)
2692 c EE(2,1,iti)=0.5d0*eenew(1,iti)
2693 c b1(2,iti)=bnew1(1,2,iti)*sin(alpha(i))*sin(beta(i))
2694 c b2(2,iti)=bnew2(1,2,iti)*sin(alpha(i))*sin(beta(i))
2695 b1tilde(1,i-2)=b1(1,i-2)
2696 b1tilde(2,i-2)=-b1(2,i-2)
2697 b2tilde(1,i-2)=b2(1,i-2)
2698 b2tilde(2,i-2)=-b2(2,i-2)
2699 c write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
2700 c write(iout,*) 'b1=',b1(1,i-2)
2701 c write (iout,*) 'theta=', theta(i-1)
2708 b1tilde(1,i-2)=b1(1,i-2)
2709 b1tilde(2,i-2)=-b1(2,i-2)
2710 b2tilde(1,i-2)=b2(1,i-2)
2711 b2tilde(2,i-2)=-b2(2,i-2)
2712 EE(1,2,i-2)=eeold(1,2,iti)
2713 EE(2,1,i-2)=eeold(2,1,iti)
2714 EE(2,2,i-2)=eeold(2,2,iti)
2715 EE(1,1,i-2)=eeold(1,1,iti)
2719 do i=ivec_start+2,ivec_end+2
2723 if (i .lt. nres+1) then
2760 if (i .gt. 3 .and. i .lt. nres+1) then
2761 obrot_der(1,i-2)=-sin1
2762 obrot_der(2,i-2)= cos1
2763 Ugder(1,1,i-2)= sin1
2764 Ugder(1,2,i-2)=-cos1
2765 Ugder(2,1,i-2)=-cos1
2766 Ugder(2,2,i-2)=-sin1
2769 obrot2_der(1,i-2)=-dwasin2
2770 obrot2_der(2,i-2)= dwacos2
2771 Ug2der(1,1,i-2)= dwasin2
2772 Ug2der(1,2,i-2)=-dwacos2
2773 Ug2der(2,1,i-2)=-dwacos2
2774 Ug2der(2,2,i-2)=-dwasin2
2776 obrot_der(1,i-2)=0.0d0
2777 obrot_der(2,i-2)=0.0d0
2778 Ugder(1,1,i-2)=0.0d0
2779 Ugder(1,2,i-2)=0.0d0
2780 Ugder(2,1,i-2)=0.0d0
2781 Ugder(2,2,i-2)=0.0d0
2782 obrot2_der(1,i-2)=0.0d0
2783 obrot2_der(2,i-2)=0.0d0
2784 Ug2der(1,1,i-2)=0.0d0
2785 Ug2der(1,2,i-2)=0.0d0
2786 Ug2der(2,1,i-2)=0.0d0
2787 Ug2der(2,2,i-2)=0.0d0
2789 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2790 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2791 iti = itortyp(itype(i-2))
2795 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2796 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2797 iti1 = itortyp(itype(i-1))
2801 cd write (iout,*) '*******i',i,' iti1',iti
2802 cd write (iout,*) 'b1',b1(:,iti)
2803 cd write (iout,*) 'b2',b2(:,iti)
2804 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2805 c if (i .gt. iatel_s+2) then
2806 if (i .gt. nnt+2) then
2807 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
2809 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
2810 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
2812 c write(iout,*) "co jest kurwa", iti, EE(1,1,iti),EE(2,1,iti),
2813 c & EE(1,2,iti),EE(2,2,iti)
2814 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
2815 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
2816 c write(iout,*) "Macierz EUG",
2817 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
2819 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2821 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2822 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2823 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2824 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2825 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2836 DtUg2(l,k,i-2)=0.0d0
2840 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
2841 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
2843 muder(k,i-2)=Ub2der(k,i-2)
2845 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2846 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2847 if (itype(i-1).le.ntyp) then
2848 iti1 = itortyp(itype(i-1))
2856 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
2858 c write (iout,*) 'mu ',mu(:,i-2),i-2
2859 cd write (iout,*) 'mu1',mu1(:,i-2)
2860 cd write (iout,*) 'mu2',mu2(:,i-2)
2861 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2863 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2864 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2865 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2866 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2867 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2868 C Vectors and matrices dependent on a single virtual-bond dihedral.
2869 call matvec2(DD(1,1,iti),b1tilde(1,i-1),auxvec(1))
2870 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2871 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2872 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2873 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2874 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2875 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2876 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2877 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2880 C Matrices dependent on two consecutive virtual-bond dihedrals.
2881 C The order of matrices is from left to right.
2882 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2884 c do i=max0(ivec_start,2),ivec_end
2886 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2887 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2888 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2889 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2890 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2891 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2892 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2893 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2896 #if defined(MPI) && defined(PARMAT)
2898 c if (fg_rank.eq.0) then
2899 write (iout,*) "Arrays UG and UGDER before GATHER"
2901 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2902 & ((ug(l,k,i),l=1,2),k=1,2),
2903 & ((ugder(l,k,i),l=1,2),k=1,2)
2905 write (iout,*) "Arrays UG2 and UG2DER"
2907 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2908 & ((ug2(l,k,i),l=1,2),k=1,2),
2909 & ((ug2der(l,k,i),l=1,2),k=1,2)
2911 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2913 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2914 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2915 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2917 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2919 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2920 & costab(i),sintab(i),costab2(i),sintab2(i)
2922 write (iout,*) "Array MUDER"
2924 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2928 if (nfgtasks.gt.1) then
2930 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2931 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2932 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2934 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2935 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2937 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2938 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2940 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2941 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2943 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2944 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2946 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2947 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2949 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2950 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2952 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2953 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2954 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2955 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2956 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2957 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2958 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2959 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2960 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2961 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2962 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2963 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2964 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2966 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2967 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2969 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2970 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2972 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2973 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2975 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2976 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2978 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2979 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2981 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2982 & ivec_count(fg_rank1),
2983 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2985 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2986 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2988 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2989 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2991 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2992 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2994 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2995 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2997 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2998 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3000 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
3001 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3003 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
3004 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3006 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
3007 & ivec_count(fg_rank1),
3008 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3010 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
3011 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3013 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
3014 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3016 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
3017 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3019 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
3020 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3022 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
3023 & ivec_count(fg_rank1),
3024 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3026 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
3027 & ivec_count(fg_rank1),
3028 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3030 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
3031 & ivec_count(fg_rank1),
3032 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3033 & MPI_MAT2,FG_COMM1,IERR)
3034 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
3035 & ivec_count(fg_rank1),
3036 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3037 & MPI_MAT2,FG_COMM1,IERR)
3040 c Passes matrix info through the ring
3043 if (irecv.lt.0) irecv=nfgtasks1-1
3046 if (inext.ge.nfgtasks1) inext=0
3048 c write (iout,*) "isend",isend," irecv",irecv
3050 lensend=lentyp(isend)
3051 lenrecv=lentyp(irecv)
3052 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
3053 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
3054 c & MPI_ROTAT1(lensend),inext,2200+isend,
3055 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
3056 c & iprev,2200+irecv,FG_COMM,status,IERR)
3057 c write (iout,*) "Gather ROTAT1"
3059 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
3060 c & MPI_ROTAT2(lensend),inext,3300+isend,
3061 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3062 c & iprev,3300+irecv,FG_COMM,status,IERR)
3063 c write (iout,*) "Gather ROTAT2"
3065 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
3066 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
3067 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
3068 & iprev,4400+irecv,FG_COMM,status,IERR)
3069 c write (iout,*) "Gather ROTAT_OLD"
3071 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
3072 & MPI_PRECOMP11(lensend),inext,5500+isend,
3073 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
3074 & iprev,5500+irecv,FG_COMM,status,IERR)
3075 c write (iout,*) "Gather PRECOMP11"
3077 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
3078 & MPI_PRECOMP12(lensend),inext,6600+isend,
3079 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
3080 & iprev,6600+irecv,FG_COMM,status,IERR)
3081 c write (iout,*) "Gather PRECOMP12"
3083 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3085 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
3086 & MPI_ROTAT2(lensend),inext,7700+isend,
3087 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3088 & iprev,7700+irecv,FG_COMM,status,IERR)
3089 c write (iout,*) "Gather PRECOMP21"
3091 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
3092 & MPI_PRECOMP22(lensend),inext,8800+isend,
3093 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
3094 & iprev,8800+irecv,FG_COMM,status,IERR)
3095 c write (iout,*) "Gather PRECOMP22"
3097 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
3098 & MPI_PRECOMP23(lensend),inext,9900+isend,
3099 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
3100 & MPI_PRECOMP23(lenrecv),
3101 & iprev,9900+irecv,FG_COMM,status,IERR)
3102 c write (iout,*) "Gather PRECOMP23"
3107 if (irecv.lt.0) irecv=nfgtasks1-1
3110 time_gather=time_gather+MPI_Wtime()-time00
3113 c if (fg_rank.eq.0) then
3114 write (iout,*) "Arrays UG and UGDER"
3116 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3117 & ((ug(l,k,i),l=1,2),k=1,2),
3118 & ((ugder(l,k,i),l=1,2),k=1,2)
3120 write (iout,*) "Arrays UG2 and UG2DER"
3122 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3123 & ((ug2(l,k,i),l=1,2),k=1,2),
3124 & ((ug2der(l,k,i),l=1,2),k=1,2)
3126 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3128 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3129 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
3130 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3132 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3134 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3135 & costab(i),sintab(i),costab2(i),sintab2(i)
3137 write (iout,*) "Array MUDER"
3139 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3145 cd iti = itortyp(itype(i))
3148 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
3149 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
3154 C--------------------------------------------------------------------------
3155 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3157 C This subroutine calculates the average interaction energy and its gradient
3158 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3159 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3160 C The potential depends both on the distance of peptide-group centers and on
3161 C the orientation of the CA-CA virtual bonds.
3163 implicit real*8 (a-h,o-z)
3167 include 'DIMENSIONS'
3168 include 'COMMON.CONTROL'
3169 include 'COMMON.SETUP'
3170 include 'COMMON.IOUNITS'
3171 include 'COMMON.GEO'
3172 include 'COMMON.VAR'
3173 include 'COMMON.LOCAL'
3174 include 'COMMON.CHAIN'
3175 include 'COMMON.DERIV'
3176 include 'COMMON.INTERACT'
3177 include 'COMMON.CONTACTS'
3178 include 'COMMON.TORSION'
3179 include 'COMMON.VECTORS'
3180 include 'COMMON.FFIELD'
3181 include 'COMMON.TIME1'
3182 include 'COMMON.SPLITELE'
3183 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3184 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3185 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3186 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
3187 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3188 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3190 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3192 double precision scal_el /1.0d0/
3194 double precision scal_el /0.5d0/
3197 C 13-go grudnia roku pamietnego...
3198 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3199 & 0.0d0,1.0d0,0.0d0,
3200 & 0.0d0,0.0d0,1.0d0/
3201 cd write(iout,*) 'In EELEC'
3203 cd write(iout,*) 'Type',i
3204 cd write(iout,*) 'B1',B1(:,i)
3205 cd write(iout,*) 'B2',B2(:,i)
3206 cd write(iout,*) 'CC',CC(:,:,i)
3207 cd write(iout,*) 'DD',DD(:,:,i)
3208 cd write(iout,*) 'EE',EE(:,:,i)
3210 cd call check_vecgrad
3212 if (icheckgrad.eq.1) then
3214 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3216 dc_norm(k,i)=dc(k,i)*fac
3218 c write (iout,*) 'i',i,' fac',fac
3221 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3222 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3223 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3224 c call vec_and_deriv
3230 time_mat=time_mat+MPI_Wtime()-time01
3234 cd write (iout,*) 'i=',i
3236 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3239 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3240 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3253 cd print '(a)','Enter EELEC'
3254 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3256 gel_loc_loc(i)=0.0d0
3261 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3263 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3265 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
3266 do i=iturn3_start,iturn3_end
3268 C write(iout,*) "tu jest i",i
3269 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3270 & .or. itype(i+2).eq.ntyp1
3271 & .or. itype(i+3).eq.ntyp1
3272 & .or. itype(i-1).eq.ntyp1
3273 & .or. itype(i+4).eq.ntyp1
3278 dx_normi=dc_norm(1,i)
3279 dy_normi=dc_norm(2,i)
3280 dz_normi=dc_norm(3,i)
3281 xmedi=c(1,i)+0.5d0*dxi
3282 ymedi=c(2,i)+0.5d0*dyi
3283 zmedi=c(3,i)+0.5d0*dzi
3284 xmedi=mod(xmedi,boxxsize)
3285 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3286 ymedi=mod(ymedi,boxysize)
3287 if (ymedi.lt.0) ymedi=ymedi+boxysize
3288 zmedi=mod(zmedi,boxzsize)
3289 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3291 call eelecij(i,i+2,ees,evdw1,eel_loc)
3292 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3293 num_cont_hb(i)=num_conti
3295 do i=iturn4_start,iturn4_end
3297 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3298 & .or. itype(i+3).eq.ntyp1
3299 & .or. itype(i+4).eq.ntyp1
3300 & .or. itype(i+5).eq.ntyp1
3301 & .or. itype(i).eq.ntyp1
3302 & .or. itype(i-1).eq.ntyp1
3307 dx_normi=dc_norm(1,i)
3308 dy_normi=dc_norm(2,i)
3309 dz_normi=dc_norm(3,i)
3310 xmedi=c(1,i)+0.5d0*dxi
3311 ymedi=c(2,i)+0.5d0*dyi
3312 zmedi=c(3,i)+0.5d0*dzi
3313 C Return atom into box, boxxsize is size of box in x dimension
3315 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3316 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3317 C Condition for being inside the proper box
3318 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
3319 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
3323 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
3324 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3325 C Condition for being inside the proper box
3326 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
3327 c & (ymedi.lt.((-0.5d0)*boxysize))) then
3331 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3332 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3333 C Condition for being inside the proper box
3334 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
3335 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
3338 xmedi=mod(xmedi,boxxsize)
3339 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3340 ymedi=mod(ymedi,boxysize)
3341 if (ymedi.lt.0) ymedi=ymedi+boxysize
3342 zmedi=mod(zmedi,boxzsize)
3343 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3345 num_conti=num_cont_hb(i)
3346 c write(iout,*) "JESTEM W PETLI"
3347 call eelecij(i,i+3,ees,evdw1,eel_loc)
3348 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
3349 & call eturn4(i,eello_turn4)
3350 num_cont_hb(i)=num_conti
3352 C Loop over all neighbouring boxes
3357 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3359 do i=iatel_s,iatel_e
3361 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3362 & .or. itype(i+2).eq.ntyp1
3363 & .or. itype(i-1).eq.ntyp1
3368 dx_normi=dc_norm(1,i)
3369 dy_normi=dc_norm(2,i)
3370 dz_normi=dc_norm(3,i)
3371 xmedi=c(1,i)+0.5d0*dxi
3372 ymedi=c(2,i)+0.5d0*dyi
3373 zmedi=c(3,i)+0.5d0*dzi
3374 xmedi=mod(xmedi,boxxsize)
3375 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3376 ymedi=mod(ymedi,boxysize)
3377 if (ymedi.lt.0) ymedi=ymedi+boxysize
3378 zmedi=mod(zmedi,boxzsize)
3379 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3380 C xmedi=xmedi+xshift*boxxsize
3381 C ymedi=ymedi+yshift*boxysize
3382 C zmedi=zmedi+zshift*boxzsize
3384 C Return tom into box, boxxsize is size of box in x dimension
3386 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3387 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3388 C Condition for being inside the proper box
3389 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
3390 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
3394 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
3395 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3396 C Condition for being inside the proper box
3397 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
3398 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3402 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3403 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3404 cC Condition for being inside the proper box
3405 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3406 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3410 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3411 num_conti=num_cont_hb(i)
3412 do j=ielstart(i),ielend(i)
3413 C write (iout,*) i,j
3415 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3416 & .or.itype(j+2).eq.ntyp1
3417 & .or.itype(j-1).eq.ntyp1
3419 call eelecij(i,j,ees,evdw1,eel_loc)
3421 num_cont_hb(i)=num_conti
3427 c write (iout,*) "Number of loop steps in EELEC:",ind
3429 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3430 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3432 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3433 ccc eel_loc=eel_loc+eello_turn3
3434 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3437 C-------------------------------------------------------------------------------
3438 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3439 implicit real*8 (a-h,o-z)
3440 include 'DIMENSIONS'
3444 include 'COMMON.CONTROL'
3445 include 'COMMON.IOUNITS'
3446 include 'COMMON.GEO'
3447 include 'COMMON.VAR'
3448 include 'COMMON.LOCAL'
3449 include 'COMMON.CHAIN'
3450 include 'COMMON.DERIV'
3451 include 'COMMON.INTERACT'
3452 include 'COMMON.CONTACTS'
3453 include 'COMMON.TORSION'
3454 include 'COMMON.VECTORS'
3455 include 'COMMON.FFIELD'
3456 include 'COMMON.TIME1'
3457 include 'COMMON.SPLITELE'
3458 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3459 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3460 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3461 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
3462 & gmuij2(4),gmuji2(4)
3463 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3464 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3466 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3468 double precision scal_el /1.0d0/
3470 double precision scal_el /0.5d0/
3473 C 13-go grudnia roku pamietnego...
3474 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3475 & 0.0d0,1.0d0,0.0d0,
3476 & 0.0d0,0.0d0,1.0d0/
3477 c time00=MPI_Wtime()
3478 cd write (iout,*) "eelecij",i,j
3482 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3483 aaa=app(iteli,itelj)
3484 bbb=bpp(iteli,itelj)
3485 ael6i=ael6(iteli,itelj)
3486 ael3i=ael3(iteli,itelj)
3490 dx_normj=dc_norm(1,j)
3491 dy_normj=dc_norm(2,j)
3492 dz_normj=dc_norm(3,j)
3493 C xj=c(1,j)+0.5D0*dxj-xmedi
3494 C yj=c(2,j)+0.5D0*dyj-ymedi
3495 C zj=c(3,j)+0.5D0*dzj-zmedi
3500 if (xj.lt.0) xj=xj+boxxsize
3502 if (yj.lt.0) yj=yj+boxysize
3504 if (zj.lt.0) zj=zj+boxzsize
3505 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
3506 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3514 xj=xj_safe+xshift*boxxsize
3515 yj=yj_safe+yshift*boxysize
3516 zj=zj_safe+zshift*boxzsize
3517 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3518 if(dist_temp.lt.dist_init) then
3528 if (isubchap.eq.1) then
3537 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3539 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3540 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3541 C Condition for being inside the proper box
3542 c if ((xj.gt.((0.5d0)*boxxsize)).or.
3543 c & (xj.lt.((-0.5d0)*boxxsize))) then
3547 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3548 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3549 C Condition for being inside the proper box
3550 c if ((yj.gt.((0.5d0)*boxysize)).or.
3551 c & (yj.lt.((-0.5d0)*boxysize))) then
3555 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3556 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3557 C Condition for being inside the proper box
3558 c if ((zj.gt.((0.5d0)*boxzsize)).or.
3559 c & (zj.lt.((-0.5d0)*boxzsize))) then
3562 C endif !endPBC condintion
3566 rij=xj*xj+yj*yj+zj*zj
3568 sss=sscale(sqrt(rij))
3569 sssgrad=sscagrad(sqrt(rij))
3570 c if (sss.gt.0.0d0) then
3576 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3577 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3578 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3579 fac=cosa-3.0D0*cosb*cosg
3581 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3582 if (j.eq.i+2) ev1=scal_el*ev1
3587 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3591 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3592 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3594 evdw1=evdw1+evdwij*sss
3595 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3596 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3597 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3598 cd & xmedi,ymedi,zmedi,xj,yj,zj
3600 if (energy_dec) then
3601 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3603 &,iteli,itelj,aaa,evdw1
3604 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3608 C Calculate contributions to the Cartesian gradient.
3611 facvdw=-6*rrmij*(ev1+evdwij)*sss
3612 facel=-3*rrmij*(el1+eesij)
3618 * Radial derivatives. First process both termini of the fragment (i,j)
3624 c ghalf=0.5D0*ggg(k)
3625 c gelc(k,i)=gelc(k,i)+ghalf
3626 c gelc(k,j)=gelc(k,j)+ghalf
3628 c 9/28/08 AL Gradient compotents will be summed only at the end
3630 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3631 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3634 * Loop over residues i+1 thru j-1.
3638 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3641 if (sss.gt.0.0) then
3642 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3643 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3644 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3651 c ghalf=0.5D0*ggg(k)
3652 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3653 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3655 c 9/28/08 AL Gradient compotents will be summed only at the end
3657 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3658 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3661 * Loop over residues i+1 thru j-1.
3665 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3670 facvdw=(ev1+evdwij)*sss
3673 fac=-3*rrmij*(facvdw+facvdw+facel)
3678 * Radial derivatives. First process both termini of the fragment (i,j)
3684 c ghalf=0.5D0*ggg(k)
3685 c gelc(k,i)=gelc(k,i)+ghalf
3686 c gelc(k,j)=gelc(k,j)+ghalf
3688 c 9/28/08 AL Gradient compotents will be summed only at the end
3690 gelc_long(k,j)=gelc(k,j)+ggg(k)
3691 gelc_long(k,i)=gelc(k,i)-ggg(k)
3694 * Loop over residues i+1 thru j-1.
3698 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3701 c 9/28/08 AL Gradient compotents will be summed only at the end
3702 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3703 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3704 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3706 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3707 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3713 ecosa=2.0D0*fac3*fac1+fac4
3716 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3717 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3719 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3720 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3722 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3723 cd & (dcosg(k),k=1,3)
3725 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3728 c ghalf=0.5D0*ggg(k)
3729 c gelc(k,i)=gelc(k,i)+ghalf
3730 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3731 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3732 c gelc(k,j)=gelc(k,j)+ghalf
3733 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3734 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3738 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3743 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3744 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3746 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3747 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3748 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3749 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3753 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3754 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3755 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3757 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3758 C energy of a peptide unit is assumed in the form of a second-order
3759 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3760 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3761 C are computed for EVERY pair of non-contiguous peptide groups.
3764 if (j.lt.nres-1) then
3776 muij(kkk)=mu(k,i)*mu(l,j)
3777 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
3779 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
3780 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
3781 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
3782 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
3783 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
3784 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
3788 cd write (iout,*) 'EELEC: i',i,' j',j
3789 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3790 cd write(iout,*) 'muij',muij
3791 ury=scalar(uy(1,i),erij)
3792 urz=scalar(uz(1,i),erij)
3793 vry=scalar(uy(1,j),erij)
3794 vrz=scalar(uz(1,j),erij)
3795 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3796 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3797 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3798 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3799 fac=dsqrt(-ael6i)*r3ij
3804 cd write (iout,'(4i5,4f10.5)')
3805 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3806 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3807 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3808 cd & uy(:,j),uz(:,j)
3809 cd write (iout,'(4f10.5)')
3810 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3811 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3812 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3813 cd write (iout,'(9f10.5/)')
3814 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3815 C Derivatives of the elements of A in virtual-bond vectors
3816 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3818 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3819 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3820 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3821 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3822 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3823 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3824 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3825 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3826 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3827 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3828 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3829 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3831 C Compute radial contributions to the gradient
3849 C Add the contributions coming from er
3852 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3853 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3854 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3855 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3858 C Derivatives in DC(i)
3859 cgrad ghalf1=0.5d0*agg(k,1)
3860 cgrad ghalf2=0.5d0*agg(k,2)
3861 cgrad ghalf3=0.5d0*agg(k,3)
3862 cgrad ghalf4=0.5d0*agg(k,4)
3863 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3864 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3865 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3866 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3867 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3868 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3869 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3870 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3871 C Derivatives in DC(i+1)
3872 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3873 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3874 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3875 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3876 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3877 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3878 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3879 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3880 C Derivatives in DC(j)
3881 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3882 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3883 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3884 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3885 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3886 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3887 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3888 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3889 C Derivatives in DC(j+1) or DC(nres-1)
3890 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3891 & -3.0d0*vryg(k,3)*ury)
3892 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3893 & -3.0d0*vrzg(k,3)*ury)
3894 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3895 & -3.0d0*vryg(k,3)*urz)
3896 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3897 & -3.0d0*vrzg(k,3)*urz)
3898 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3900 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3913 aggi(k,l)=-aggi(k,l)
3914 aggi1(k,l)=-aggi1(k,l)
3915 aggj(k,l)=-aggj(k,l)
3916 aggj1(k,l)=-aggj1(k,l)
3919 if (j.lt.nres-1) then
3925 aggi(k,l)=-aggi(k,l)
3926 aggi1(k,l)=-aggi1(k,l)
3927 aggj(k,l)=-aggj(k,l)
3928 aggj1(k,l)=-aggj1(k,l)
3939 aggi(k,l)=-aggi(k,l)
3940 aggi1(k,l)=-aggi1(k,l)
3941 aggj(k,l)=-aggj(k,l)
3942 aggj1(k,l)=-aggj1(k,l)
3947 IF (wel_loc.gt.0.0d0) THEN
3948 C Contribution to the local-electrostatic energy coming from the i-j pair
3949 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3951 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
3952 c & ' eel_loc_ij',eel_loc_ij
3953 c write(iout,*) 'muije=',muij(1),muij(2),muij(3),muij(4)
3954 C Calculate patrial derivative for theta angle
3956 geel_loc_ij=a22*gmuij1(1)
3960 c write(iout,*) "derivative over thatai"
3961 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
3963 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
3964 & geel_loc_ij*wel_loc
3965 c write(iout,*) "derivative over thatai-1"
3966 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
3973 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3974 & geel_loc_ij*wel_loc
3975 c Derivative over j residue
3976 geel_loc_ji=a22*gmuji1(1)
3980 c write(iout,*) "derivative over thataj"
3981 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
3984 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
3985 & geel_loc_ji*wel_loc
3991 c write(iout,*) "derivative over thataj-1"
3992 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
3994 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
3995 & geel_loc_ji*wel_loc
3997 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3999 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4000 & 'eelloc',i,j,eel_loc_ij
4001 c if (eel_loc_ij.ne.0)
4002 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
4003 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
4005 eel_loc=eel_loc+eel_loc_ij
4006 C Partial derivatives in virtual-bond dihedral angles gamma
4008 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
4009 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
4010 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
4011 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
4012 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
4013 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
4014 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
4016 ggg(l)=agg(l,1)*muij(1)+
4017 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
4018 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
4019 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
4020 cgrad ghalf=0.5d0*ggg(l)
4021 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
4022 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
4026 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
4029 C Remaining derivatives of eello
4031 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
4032 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
4033 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
4034 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
4035 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
4036 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
4037 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
4038 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
4041 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
4042 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
4043 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
4044 & .and. num_conti.le.maxconts) then
4045 c write (iout,*) i,j," entered corr"
4047 C Calculate the contact function. The ith column of the array JCONT will
4048 C contain the numbers of atoms that make contacts with the atom I (of numbers
4049 C greater than I). The arrays FACONT and GACONT will contain the values of
4050 C the contact function and its derivative.
4051 c r0ij=1.02D0*rpp(iteli,itelj)
4052 c r0ij=1.11D0*rpp(iteli,itelj)
4053 r0ij=2.20D0*rpp(iteli,itelj)
4054 c r0ij=1.55D0*rpp(iteli,itelj)
4055 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4056 if (fcont.gt.0.0D0) then
4057 num_conti=num_conti+1
4058 if (num_conti.gt.maxconts) then
4059 write (iout,*) 'WARNING - max. # of contacts exceeded;',
4060 & ' will skip next contacts for this conf.'
4062 jcont_hb(num_conti,i)=j
4063 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
4064 cd & " jcont_hb",jcont_hb(num_conti,i)
4065 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
4066 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4067 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4069 d_cont(num_conti,i)=rij
4070 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4071 C --- Electrostatic-interaction matrix ---
4072 a_chuj(1,1,num_conti,i)=a22
4073 a_chuj(1,2,num_conti,i)=a23
4074 a_chuj(2,1,num_conti,i)=a32
4075 a_chuj(2,2,num_conti,i)=a33
4076 C --- Gradient of rij
4078 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4085 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4086 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4087 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4088 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4089 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4094 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4095 C Calculate contact energies
4097 wij=cosa-3.0D0*cosb*cosg
4100 c fac3=dsqrt(-ael6i)/r0ij**3
4101 fac3=dsqrt(-ael6i)*r3ij
4102 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4103 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
4104 if (ees0tmp.gt.0) then
4105 ees0pij=dsqrt(ees0tmp)
4109 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4110 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
4111 if (ees0tmp.gt.0) then
4112 ees0mij=dsqrt(ees0tmp)
4117 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
4118 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
4119 C Diagnostics. Comment out or remove after debugging!
4120 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4121 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4122 c ees0m(num_conti,i)=0.0D0
4124 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4125 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4126 C Angular derivatives of the contact function
4127 ees0pij1=fac3/ees0pij
4128 ees0mij1=fac3/ees0mij
4129 fac3p=-3.0D0*fac3*rrmij
4130 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4131 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4133 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4134 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4135 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4136 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4137 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4138 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4139 ecosap=ecosa1+ecosa2
4140 ecosbp=ecosb1+ecosb2
4141 ecosgp=ecosg1+ecosg2
4142 ecosam=ecosa1-ecosa2
4143 ecosbm=ecosb1-ecosb2
4144 ecosgm=ecosg1-ecosg2
4153 facont_hb(num_conti,i)=fcont
4154 fprimcont=fprimcont/rij
4155 cd facont_hb(num_conti,i)=1.0D0
4156 C Following line is for diagnostics.
4159 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4160 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4163 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4164 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4166 gggp(1)=gggp(1)+ees0pijp*xj
4167 gggp(2)=gggp(2)+ees0pijp*yj
4168 gggp(3)=gggp(3)+ees0pijp*zj
4169 gggm(1)=gggm(1)+ees0mijp*xj
4170 gggm(2)=gggm(2)+ees0mijp*yj
4171 gggm(3)=gggm(3)+ees0mijp*zj
4172 C Derivatives due to the contact function
4173 gacont_hbr(1,num_conti,i)=fprimcont*xj
4174 gacont_hbr(2,num_conti,i)=fprimcont*yj
4175 gacont_hbr(3,num_conti,i)=fprimcont*zj
4178 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
4179 c following the change of gradient-summation algorithm.
4181 cgrad ghalfp=0.5D0*gggp(k)
4182 cgrad ghalfm=0.5D0*gggm(k)
4183 gacontp_hb1(k,num_conti,i)=!ghalfp
4184 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
4185 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4186 gacontp_hb2(k,num_conti,i)=!ghalfp
4187 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
4188 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4189 gacontp_hb3(k,num_conti,i)=gggp(k)
4190 gacontm_hb1(k,num_conti,i)=!ghalfm
4191 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
4192 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4193 gacontm_hb2(k,num_conti,i)=!ghalfm
4194 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
4195 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4196 gacontm_hb3(k,num_conti,i)=gggm(k)
4198 C Diagnostics. Comment out or remove after debugging!
4200 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
4201 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
4202 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
4203 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
4204 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
4205 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
4208 endif ! num_conti.le.maxconts
4211 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4214 ghalf=0.5d0*agg(l,k)
4215 aggi(l,k)=aggi(l,k)+ghalf
4216 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4217 aggj(l,k)=aggj(l,k)+ghalf
4220 if (j.eq.nres-1 .and. i.lt.j-2) then
4223 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4228 c t_eelecij=t_eelecij+MPI_Wtime()-time00
4231 C-----------------------------------------------------------------------------
4232 subroutine eturn3(i,eello_turn3)
4233 C Third- and fourth-order contributions from turns
4234 implicit real*8 (a-h,o-z)
4235 include 'DIMENSIONS'
4236 include 'COMMON.IOUNITS'
4237 include 'COMMON.GEO'
4238 include 'COMMON.VAR'
4239 include 'COMMON.LOCAL'
4240 include 'COMMON.CHAIN'
4241 include 'COMMON.DERIV'
4242 include 'COMMON.INTERACT'
4243 include 'COMMON.CONTACTS'
4244 include 'COMMON.TORSION'
4245 include 'COMMON.VECTORS'
4246 include 'COMMON.FFIELD'
4247 include 'COMMON.CONTROL'
4249 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4250 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4251 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
4252 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
4253 & auxgmat2(2,2),auxgmatt2(2,2)
4254 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4255 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4256 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4257 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4260 c write (iout,*) "eturn3",i,j,j1,j2
4265 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4267 C Third-order contributions
4274 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4275 cd call checkint_turn3(i,a_temp,eello_turn3_num)
4276 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4277 c auxalary matices for theta gradient
4278 c auxalary matrix for i+1 and constant i+2
4279 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
4280 c auxalary matrix for i+2 and constant i+1
4281 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
4282 call transpose2(auxmat(1,1),auxmat1(1,1))
4283 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
4284 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
4285 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4286 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
4287 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
4288 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
4289 C Derivatives in theta
4290 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4291 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
4292 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
4293 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
4295 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4296 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
4297 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
4298 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
4299 cd & ' eello_turn3_num',4*eello_turn3_num
4300 C Derivatives in gamma(i)
4301 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4302 call transpose2(auxmat2(1,1),auxmat3(1,1))
4303 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4304 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
4305 C Derivatives in gamma(i+1)
4306 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4307 call transpose2(auxmat2(1,1),auxmat3(1,1))
4308 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4309 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
4310 & +0.5d0*(pizda(1,1)+pizda(2,2))
4311 C Cartesian derivatives
4313 c ghalf1=0.5d0*agg(l,1)
4314 c ghalf2=0.5d0*agg(l,2)
4315 c ghalf3=0.5d0*agg(l,3)
4316 c ghalf4=0.5d0*agg(l,4)
4317 a_temp(1,1)=aggi(l,1)!+ghalf1
4318 a_temp(1,2)=aggi(l,2)!+ghalf2
4319 a_temp(2,1)=aggi(l,3)!+ghalf3
4320 a_temp(2,2)=aggi(l,4)!+ghalf4
4321 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4322 gcorr3_turn(l,i)=gcorr3_turn(l,i)
4323 & +0.5d0*(pizda(1,1)+pizda(2,2))
4324 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4325 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4326 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4327 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4328 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4329 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
4330 & +0.5d0*(pizda(1,1)+pizda(2,2))
4331 a_temp(1,1)=aggj(l,1)!+ghalf1
4332 a_temp(1,2)=aggj(l,2)!+ghalf2
4333 a_temp(2,1)=aggj(l,3)!+ghalf3
4334 a_temp(2,2)=aggj(l,4)!+ghalf4
4335 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4336 gcorr3_turn(l,j)=gcorr3_turn(l,j)
4337 & +0.5d0*(pizda(1,1)+pizda(2,2))
4338 a_temp(1,1)=aggj1(l,1)
4339 a_temp(1,2)=aggj1(l,2)
4340 a_temp(2,1)=aggj1(l,3)
4341 a_temp(2,2)=aggj1(l,4)
4342 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4343 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
4344 & +0.5d0*(pizda(1,1)+pizda(2,2))
4348 C-------------------------------------------------------------------------------
4349 subroutine eturn4(i,eello_turn4)
4350 C Third- and fourth-order contributions from turns
4351 implicit real*8 (a-h,o-z)
4352 include 'DIMENSIONS'
4353 include 'COMMON.IOUNITS'
4354 include 'COMMON.GEO'
4355 include 'COMMON.VAR'
4356 include 'COMMON.LOCAL'
4357 include 'COMMON.CHAIN'
4358 include 'COMMON.DERIV'
4359 include 'COMMON.INTERACT'
4360 include 'COMMON.CONTACTS'
4361 include 'COMMON.TORSION'
4362 include 'COMMON.VECTORS'
4363 include 'COMMON.FFIELD'
4364 include 'COMMON.CONTROL'
4366 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4367 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4368 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
4369 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
4370 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
4371 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
4372 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
4373 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4374 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4375 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4376 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4379 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4381 C Fourth-order contributions
4389 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4390 cd call checkint_turn4(i,a_temp,eello_turn4_num)
4391 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4392 c write(iout,*)"WCHODZE W PROGRAM"
4397 iti1=itortyp(itype(i+1))
4398 iti2=itortyp(itype(i+2))
4399 iti3=itortyp(itype(i+3))
4400 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4401 call transpose2(EUg(1,1,i+1),e1t(1,1))
4402 call transpose2(Eug(1,1,i+2),e2t(1,1))
4403 call transpose2(Eug(1,1,i+3),e3t(1,1))
4404 C Ematrix derivative in theta
4405 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
4406 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
4407 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
4408 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4409 c eta1 in derivative theta
4410 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
4411 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4412 c auxgvec is derivative of Ub2 so i+3 theta
4413 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
4414 c auxalary matrix of E i+1
4415 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
4418 s1=scalar2(b1(1,i+2),auxvec(1))
4419 c derivative of theta i+2 with constant i+3
4420 gs23=scalar2(gtb1(1,i+2),auxvec(1))
4421 c derivative of theta i+2 with constant i+2
4422 gs32=scalar2(b1(1,i+2),auxgvec(1))
4423 c derivative of E matix in theta of i+1
4424 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
4426 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4427 c ea31 in derivative theta
4428 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
4429 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4430 c auxilary matrix auxgvec of Ub2 with constant E matirx
4431 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
4432 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
4433 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
4437 s2=scalar2(b1(1,i+1),auxvec(1))
4438 c derivative of theta i+1 with constant i+3
4439 gs13=scalar2(gtb1(1,i+1),auxvec(1))
4440 c derivative of theta i+2 with constant i+1
4441 gs21=scalar2(b1(1,i+1),auxgvec(1))
4442 c derivative of theta i+3 with constant i+1
4443 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
4444 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
4446 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4447 c two derivatives over diffetent matrices
4448 c gtae3e2 is derivative over i+3
4449 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
4450 c ae3gte2 is derivative over i+2
4451 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
4452 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4453 c three possible derivative over theta E matices
4455 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
4457 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
4459 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
4460 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4462 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
4463 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
4464 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
4466 eello_turn4=eello_turn4-(s1+s2+s3)
4467 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
4468 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
4469 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
4470 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4471 cd & ' eello_turn4_num',8*eello_turn4_num
4473 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4474 & -(gs13+gsE13+gsEE1)*wturn4
4475 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
4476 & -(gs23+gs21+gsEE2)*wturn4
4477 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
4478 & -(gs32+gsE31+gsEE3)*wturn4
4479 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
4482 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4483 & 'eturn4',i,j,-(s1+s2+s3)
4484 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4485 c & ' eello_turn4_num',8*eello_turn4_num
4486 C Derivatives in gamma(i)
4487 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4488 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4489 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4490 s1=scalar2(b1(1,i+2),auxvec(1))
4491 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4492 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4493 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
4494 C Derivatives in gamma(i+1)
4495 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4496 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4497 s2=scalar2(b1(1,i+1),auxvec(1))
4498 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4499 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4500 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4501 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
4502 C Derivatives in gamma(i+2)
4503 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4504 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4505 s1=scalar2(b1(1,i+2),auxvec(1))
4506 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4507 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4508 s2=scalar2(b1(1,i+1),auxvec(1))
4509 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4510 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4511 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4512 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
4513 C Cartesian derivatives
4514 C Derivatives of this turn contributions in DC(i+2)
4515 if (j.lt.nres-1) then
4517 a_temp(1,1)=agg(l,1)
4518 a_temp(1,2)=agg(l,2)
4519 a_temp(2,1)=agg(l,3)
4520 a_temp(2,2)=agg(l,4)
4521 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4522 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4523 s1=scalar2(b1(1,i+2),auxvec(1))
4524 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4525 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4526 s2=scalar2(b1(1,i+1),auxvec(1))
4527 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4528 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4529 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4531 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
4534 C Remaining derivatives of this turn contribution
4536 a_temp(1,1)=aggi(l,1)
4537 a_temp(1,2)=aggi(l,2)
4538 a_temp(2,1)=aggi(l,3)
4539 a_temp(2,2)=aggi(l,4)
4540 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4541 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4542 s1=scalar2(b1(1,i+2),auxvec(1))
4543 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4544 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4545 s2=scalar2(b1(1,i+1),auxvec(1))
4546 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4547 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4548 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4549 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4550 a_temp(1,1)=aggi1(l,1)
4551 a_temp(1,2)=aggi1(l,2)
4552 a_temp(2,1)=aggi1(l,3)
4553 a_temp(2,2)=aggi1(l,4)
4554 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4555 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4556 s1=scalar2(b1(1,i+2),auxvec(1))
4557 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4558 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4559 s2=scalar2(b1(1,i+1),auxvec(1))
4560 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4561 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4562 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4563 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4564 a_temp(1,1)=aggj(l,1)
4565 a_temp(1,2)=aggj(l,2)
4566 a_temp(2,1)=aggj(l,3)
4567 a_temp(2,2)=aggj(l,4)
4568 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4569 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4570 s1=scalar2(b1(1,i+2),auxvec(1))
4571 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4572 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4573 s2=scalar2(b1(1,i+1),auxvec(1))
4574 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4575 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4576 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4577 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4578 a_temp(1,1)=aggj1(l,1)
4579 a_temp(1,2)=aggj1(l,2)
4580 a_temp(2,1)=aggj1(l,3)
4581 a_temp(2,2)=aggj1(l,4)
4582 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4583 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4584 s1=scalar2(b1(1,i+2),auxvec(1))
4585 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4586 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4587 s2=scalar2(b1(1,i+1),auxvec(1))
4588 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4589 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4590 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4591 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4592 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4596 C-----------------------------------------------------------------------------
4597 subroutine vecpr(u,v,w)
4598 implicit real*8(a-h,o-z)
4599 dimension u(3),v(3),w(3)
4600 w(1)=u(2)*v(3)-u(3)*v(2)
4601 w(2)=-u(1)*v(3)+u(3)*v(1)
4602 w(3)=u(1)*v(2)-u(2)*v(1)
4605 C-----------------------------------------------------------------------------
4606 subroutine unormderiv(u,ugrad,unorm,ungrad)
4607 C This subroutine computes the derivatives of a normalized vector u, given
4608 C the derivatives computed without normalization conditions, ugrad. Returns
4611 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4612 double precision vec(3)
4613 double precision scalar
4615 c write (2,*) 'ugrad',ugrad
4618 vec(i)=scalar(ugrad(1,i),u(1))
4620 c write (2,*) 'vec',vec
4623 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4626 c write (2,*) 'ungrad',ungrad
4629 C-----------------------------------------------------------------------------
4630 subroutine escp_soft_sphere(evdw2,evdw2_14)
4632 C This subroutine calculates the excluded-volume interaction energy between
4633 C peptide-group centers and side chains and its gradient in virtual-bond and
4634 C side-chain vectors.
4636 implicit real*8 (a-h,o-z)
4637 include 'DIMENSIONS'
4638 include 'COMMON.GEO'
4639 include 'COMMON.VAR'
4640 include 'COMMON.LOCAL'
4641 include 'COMMON.CHAIN'
4642 include 'COMMON.DERIV'
4643 include 'COMMON.INTERACT'
4644 include 'COMMON.FFIELD'
4645 include 'COMMON.IOUNITS'
4646 include 'COMMON.CONTROL'
4651 cd print '(a)','Enter ESCP'
4652 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4656 do i=iatscp_s,iatscp_e
4657 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4659 xi=0.5D0*(c(1,i)+c(1,i+1))
4660 yi=0.5D0*(c(2,i)+c(2,i+1))
4661 zi=0.5D0*(c(3,i)+c(3,i+1))
4662 C Return atom into box, boxxsize is size of box in x dimension
4664 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4665 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4666 C Condition for being inside the proper box
4667 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4668 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4672 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4673 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4674 C Condition for being inside the proper box
4675 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4676 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4680 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4681 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4682 cC Condition for being inside the proper box
4683 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4684 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4688 if (xi.lt.0) xi=xi+boxxsize
4690 if (yi.lt.0) yi=yi+boxysize
4692 if (zi.lt.0) zi=zi+boxzsize
4693 C xi=xi+xshift*boxxsize
4694 C yi=yi+yshift*boxysize
4695 C zi=zi+zshift*boxzsize
4696 do iint=1,nscp_gr(i)
4698 do j=iscpstart(i,iint),iscpend(i,iint)
4699 if (itype(j).eq.ntyp1) cycle
4700 itypj=iabs(itype(j))
4701 C Uncomment following three lines for SC-p interactions
4705 C Uncomment following three lines for Ca-p interactions
4710 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4711 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4712 C Condition for being inside the proper box
4713 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4714 c & (xj.lt.((-0.5d0)*boxxsize))) then
4718 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4719 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4720 cC Condition for being inside the proper box
4721 c if ((yj.gt.((0.5d0)*boxysize)).or.
4722 c & (yj.lt.((-0.5d0)*boxysize))) then
4726 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4727 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4728 C Condition for being inside the proper box
4729 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4730 c & (zj.lt.((-0.5d0)*boxzsize))) then
4733 if (xj.lt.0) xj=xj+boxxsize
4735 if (yj.lt.0) yj=yj+boxysize
4737 if (zj.lt.0) zj=zj+boxzsize
4738 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4746 xj=xj_safe+xshift*boxxsize
4747 yj=yj_safe+yshift*boxysize
4748 zj=zj_safe+zshift*boxzsize
4749 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4750 if(dist_temp.lt.dist_init) then
4760 if (subchap.eq.1) then
4773 rij=xj*xj+yj*yj+zj*zj
4777 if (rij.lt.r0ijsq) then
4778 evdwij=0.25d0*(rij-r0ijsq)**2
4786 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4791 cgrad if (j.lt.i) then
4792 cd write (iout,*) 'j<i'
4793 C Uncomment following three lines for SC-p interactions
4795 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4798 cd write (iout,*) 'j>i'
4800 cgrad ggg(k)=-ggg(k)
4801 C Uncomment following line for SC-p interactions
4802 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4806 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4808 cgrad kstart=min0(i+1,j)
4809 cgrad kend=max0(i-1,j-1)
4810 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4811 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4812 cgrad do k=kstart,kend
4814 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4818 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4819 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4830 C-----------------------------------------------------------------------------
4831 subroutine escp(evdw2,evdw2_14)
4833 C This subroutine calculates the excluded-volume interaction energy between
4834 C peptide-group centers and side chains and its gradient in virtual-bond and
4835 C side-chain vectors.
4837 implicit real*8 (a-h,o-z)
4838 include 'DIMENSIONS'
4839 include 'COMMON.GEO'
4840 include 'COMMON.VAR'
4841 include 'COMMON.LOCAL'
4842 include 'COMMON.CHAIN'
4843 include 'COMMON.DERIV'
4844 include 'COMMON.INTERACT'
4845 include 'COMMON.FFIELD'
4846 include 'COMMON.IOUNITS'
4847 include 'COMMON.CONTROL'
4848 include 'COMMON.SPLITELE'
4852 c print *,boxxsize,boxysize,boxzsize,'wymiary pudla'
4853 cd print '(a)','Enter ESCP'
4854 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4858 do i=iatscp_s,iatscp_e
4859 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4861 xi=0.5D0*(c(1,i)+c(1,i+1))
4862 yi=0.5D0*(c(2,i)+c(2,i+1))
4863 zi=0.5D0*(c(3,i)+c(3,i+1))
4865 if (xi.lt.0) xi=xi+boxxsize
4867 if (yi.lt.0) yi=yi+boxysize
4869 if (zi.lt.0) zi=zi+boxzsize
4870 c xi=xi+xshift*boxxsize
4871 c yi=yi+yshift*boxysize
4872 c zi=zi+zshift*boxzsize
4873 c print *,xi,yi,zi,'polozenie i'
4874 C Return atom into box, boxxsize is size of box in x dimension
4876 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4877 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4878 C Condition for being inside the proper box
4879 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4880 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4884 c print *,xi,boxxsize,"pierwszy"
4886 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4887 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4888 C Condition for being inside the proper box
4889 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4890 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4894 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4895 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4896 C Condition for being inside the proper box
4897 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4898 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4901 do iint=1,nscp_gr(i)
4903 do j=iscpstart(i,iint),iscpend(i,iint)
4904 itypj=iabs(itype(j))
4905 if (itypj.eq.ntyp1) cycle
4906 C Uncomment following three lines for SC-p interactions
4910 C Uncomment following three lines for Ca-p interactions
4915 if (xj.lt.0) xj=xj+boxxsize
4917 if (yj.lt.0) yj=yj+boxysize
4919 if (zj.lt.0) zj=zj+boxzsize
4921 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4922 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4923 C Condition for being inside the proper box
4924 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4925 c & (xj.lt.((-0.5d0)*boxxsize))) then
4929 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4930 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4931 cC Condition for being inside the proper box
4932 c if ((yj.gt.((0.5d0)*boxysize)).or.
4933 c & (yj.lt.((-0.5d0)*boxysize))) then
4937 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4938 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4939 C Condition for being inside the proper box
4940 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4941 c & (zj.lt.((-0.5d0)*boxzsize))) then
4944 CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE
4945 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4953 xj=xj_safe+xshift*boxxsize
4954 yj=yj_safe+yshift*boxysize
4955 zj=zj_safe+zshift*boxzsize
4956 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4957 if(dist_temp.lt.dist_init) then
4967 if (subchap.eq.1) then
4976 c print *,xj,yj,zj,'polozenie j'
4977 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4979 sss=sscale(1.0d0/(dsqrt(rrij)))
4980 c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz'
4981 c if (sss.eq.0) print *,'czasem jest OK'
4982 if (sss.le.0.0d0) cycle
4983 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
4985 e1=fac*fac*aad(itypj,iteli)
4986 e2=fac*bad(itypj,iteli)
4987 if (iabs(j-i) .le. 2) then
4990 evdw2_14=evdw2_14+(e1+e2)*sss
4993 evdw2=evdw2+evdwij*sss
4994 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4995 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4998 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5000 fac=-(evdwij+e1)*rrij*sss
5001 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
5005 cgrad if (j.lt.i) then
5006 cd write (iout,*) 'j<i'
5007 C Uncomment following three lines for SC-p interactions
5009 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5012 cd write (iout,*) 'j>i'
5014 cgrad ggg(k)=-ggg(k)
5015 C Uncomment following line for SC-p interactions
5016 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5017 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5021 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5023 cgrad kstart=min0(i+1,j)
5024 cgrad kend=max0(i-1,j-1)
5025 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5026 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5027 cgrad do k=kstart,kend
5029 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5033 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5034 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5036 c endif !endif for sscale cutoff
5046 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
5047 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
5048 gradx_scp(j,i)=expon*gradx_scp(j,i)
5051 C******************************************************************************
5055 C To save time the factor EXPON has been extracted from ALL components
5056 C of GVDWC and GRADX. Remember to multiply them by this factor before further
5059 C******************************************************************************
5062 C--------------------------------------------------------------------------
5063 subroutine edis(ehpb)
5065 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
5067 implicit real*8 (a-h,o-z)
5068 include 'DIMENSIONS'
5069 include 'COMMON.SBRIDGE'
5070 include 'COMMON.CHAIN'
5071 include 'COMMON.DERIV'
5072 include 'COMMON.VAR'
5073 include 'COMMON.INTERACT'
5074 include 'COMMON.IOUNITS'
5077 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
5078 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
5079 if (link_end.eq.0) return
5080 do i=link_start,link_end
5081 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
5082 C CA-CA distance used in regularization of structure.
5085 C iii and jjj point to the residues for which the distance is assigned.
5086 if (ii.gt.nres) then
5093 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
5094 c & dhpb(i),dhpb1(i),forcon(i)
5095 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
5096 C distance and angle dependent SS bond potential.
5097 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5098 C & iabs(itype(jjj)).eq.1) then
5099 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5100 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
5101 if (.not.dyn_ss .and. i.le.nss) then
5102 C 15/02/13 CC dynamic SSbond - additional check
5104 & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5105 call ssbond_ene(iii,jjj,eij)
5108 cd write (iout,*) "eij",eij
5110 C Calculate the distance between the two points and its difference from the
5114 C Get the force constant corresponding to this distance.
5116 C Calculate the contribution to energy.
5117 ehpb=ehpb+waga*rdis*rdis
5119 C Evaluate gradient.
5122 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
5123 cd & ' waga=',waga,' fac=',fac
5125 ggg(j)=fac*(c(j,jj)-c(j,ii))
5127 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
5128 C If this is a SC-SC distance, we need to calculate the contributions to the
5129 C Cartesian gradient in the SC vectors (ghpbx).
5132 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5133 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5136 cgrad do j=iii,jjj-1
5138 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
5142 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5143 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5150 C--------------------------------------------------------------------------
5151 subroutine ssbond_ene(i,j,eij)
5153 C Calculate the distance and angle dependent SS-bond potential energy
5154 C using a free-energy function derived based on RHF/6-31G** ab initio
5155 C calculations of diethyl disulfide.
5157 C A. Liwo and U. Kozlowska, 11/24/03
5159 implicit real*8 (a-h,o-z)
5160 include 'DIMENSIONS'
5161 include 'COMMON.SBRIDGE'
5162 include 'COMMON.CHAIN'
5163 include 'COMMON.DERIV'
5164 include 'COMMON.LOCAL'
5165 include 'COMMON.INTERACT'
5166 include 'COMMON.VAR'
5167 include 'COMMON.IOUNITS'
5168 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
5169 itypi=iabs(itype(i))
5173 dxi=dc_norm(1,nres+i)
5174 dyi=dc_norm(2,nres+i)
5175 dzi=dc_norm(3,nres+i)
5176 c dsci_inv=dsc_inv(itypi)
5177 dsci_inv=vbld_inv(nres+i)
5178 itypj=iabs(itype(j))
5179 c dscj_inv=dsc_inv(itypj)
5180 dscj_inv=vbld_inv(nres+j)
5184 dxj=dc_norm(1,nres+j)
5185 dyj=dc_norm(2,nres+j)
5186 dzj=dc_norm(3,nres+j)
5187 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5192 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
5193 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
5194 om12=dxi*dxj+dyi*dyj+dzi*dzj
5196 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
5197 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
5203 deltat12=om2-om1+2.0d0
5205 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
5206 & +akct*deltad*deltat12
5207 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
5208 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
5209 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
5210 c & " deltat12",deltat12," eij",eij
5211 ed=2*akcm*deltad+akct*deltat12
5213 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
5214 eom1=-2*akth*deltat1-pom1-om2*pom2
5215 eom2= 2*akth*deltat2+pom1-om1*pom2
5218 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5219 ghpbx(k,i)=ghpbx(k,i)-ggk
5220 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
5221 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
5222 ghpbx(k,j)=ghpbx(k,j)+ggk
5223 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
5224 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
5225 ghpbc(k,i)=ghpbc(k,i)-ggk
5226 ghpbc(k,j)=ghpbc(k,j)+ggk
5229 C Calculate the components of the gradient in DC and X
5233 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
5238 C--------------------------------------------------------------------------
5239 subroutine ebond(estr)
5241 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5243 implicit real*8 (a-h,o-z)
5244 include 'DIMENSIONS'
5245 include 'COMMON.LOCAL'
5246 include 'COMMON.GEO'
5247 include 'COMMON.INTERACT'
5248 include 'COMMON.DERIV'
5249 include 'COMMON.VAR'
5250 include 'COMMON.CHAIN'
5251 include 'COMMON.IOUNITS'
5252 include 'COMMON.NAMES'
5253 include 'COMMON.FFIELD'
5254 include 'COMMON.CONTROL'
5255 include 'COMMON.SETUP'
5256 double precision u(3),ud(3)
5259 do i=ibondp_start,ibondp_end
5260 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
5261 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5263 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
5264 c & *dc(j,i-1)/vbld(i)
5266 c if (energy_dec) write(iout,*)
5267 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5269 C Checking if it involves dummy (NH3+ or COO-) group
5270 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
5271 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
5272 diff = vbld(i)-vbldpDUM
5274 C NO vbldp0 is the equlibrium lenght of spring for peptide group
5275 diff = vbld(i)-vbldp0
5277 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
5278 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5281 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5283 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5286 estr=0.5d0*AKP*estr+estr1
5288 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5290 do i=ibond_start,ibond_end
5292 if (iti.ne.10 .and. iti.ne.ntyp1) then
5295 diff=vbld(i+nres)-vbldsc0(1,iti)
5296 if (energy_dec) write (iout,*)
5297 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
5298 & AKSC(1,iti),AKSC(1,iti)*diff*diff
5299 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5301 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5305 diff=vbld(i+nres)-vbldsc0(j,iti)
5306 ud(j)=aksc(j,iti)*diff
5307 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5321 uprod2=uprod2*u(k)*u(k)
5325 usumsqder=usumsqder+ud(j)*uprod2
5327 estr=estr+uprod/usum
5329 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5337 C--------------------------------------------------------------------------
5338 subroutine ebend(etheta)
5340 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5341 C angles gamma and its derivatives in consecutive thetas and gammas.
5343 implicit real*8 (a-h,o-z)
5344 include 'DIMENSIONS'
5345 include 'COMMON.LOCAL'
5346 include 'COMMON.GEO'
5347 include 'COMMON.INTERACT'
5348 include 'COMMON.DERIV'
5349 include 'COMMON.VAR'
5350 include 'COMMON.CHAIN'
5351 include 'COMMON.IOUNITS'
5352 include 'COMMON.NAMES'
5353 include 'COMMON.FFIELD'
5354 include 'COMMON.CONTROL'
5355 common /calcthet/ term1,term2,termm,diffak,ratak,
5356 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5357 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5358 double precision y(2),z(2)
5360 c time11=dexp(-2*time)
5363 c write (*,'(a,i2)') 'EBEND ICG=',icg
5364 do i=ithet_start,ithet_end
5365 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5366 & .or.itype(i).eq.ntyp1) cycle
5367 C Zero the energy function and its derivative at 0 or pi.
5368 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5370 ichir1=isign(1,itype(i-2))
5371 ichir2=isign(1,itype(i))
5372 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
5373 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
5374 if (itype(i-1).eq.10) then
5375 itype1=isign(10,itype(i-2))
5376 ichir11=isign(1,itype(i-2))
5377 ichir12=isign(1,itype(i-2))
5378 itype2=isign(10,itype(i))
5379 ichir21=isign(1,itype(i))
5380 ichir22=isign(1,itype(i))
5383 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5386 if (phii.ne.phii) phii=150.0
5396 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5399 if (phii1.ne.phii1) phii1=150.0
5411 C Calculate the "mean" value of theta from the part of the distribution
5412 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5413 C In following comments this theta will be referred to as t_c.
5414 thet_pred_mean=0.0d0
5416 athetk=athet(k,it,ichir1,ichir2)
5417 bthetk=bthet(k,it,ichir1,ichir2)
5419 athetk=athet(k,itype1,ichir11,ichir12)
5420 bthetk=bthet(k,itype2,ichir21,ichir22)
5422 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5423 c write(iout,*) 'chuj tu', y(k),z(k)
5425 dthett=thet_pred_mean*ssd
5426 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5427 C Derivatives of the "mean" values in gamma1 and gamma2.
5428 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
5429 &+athet(2,it,ichir1,ichir2)*y(1))*ss
5430 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
5431 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
5433 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
5434 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
5435 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
5436 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5438 if (theta(i).gt.pi-delta) then
5439 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
5441 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5442 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5443 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
5445 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
5447 else if (theta(i).lt.delta) then
5448 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5449 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5450 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
5452 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5453 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
5456 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
5459 etheta=etheta+ethetai
5460 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
5461 & 'ebend',i,ethetai,theta(i),itype(i)
5462 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5463 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5464 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
5466 C Ufff.... We've done all this!!!
5469 C---------------------------------------------------------------------------
5470 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
5472 implicit real*8 (a-h,o-z)
5473 include 'DIMENSIONS'
5474 include 'COMMON.LOCAL'
5475 include 'COMMON.IOUNITS'
5476 common /calcthet/ term1,term2,termm,diffak,ratak,
5477 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5478 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5479 C Calculate the contributions to both Gaussian lobes.
5480 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5481 C The "polynomial part" of the "standard deviation" of this part of
5482 C the distributioni.
5483 ccc write (iout,*) thetai,thet_pred_mean
5486 sig=sig*thet_pred_mean+polthet(j,it)
5488 C Derivative of the "interior part" of the "standard deviation of the"
5489 C gamma-dependent Gaussian lobe in t_c.
5490 sigtc=3*polthet(3,it)
5492 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5495 C Set the parameters of both Gaussian lobes of the distribution.
5496 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5497 fac=sig*sig+sigc0(it)
5500 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5501 sigsqtc=-4.0D0*sigcsq*sigtc
5502 c print *,i,sig,sigtc,sigsqtc
5503 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
5504 sigtc=-sigtc/(fac*fac)
5505 C Following variable is sigma(t_c)**(-2)
5506 sigcsq=sigcsq*sigcsq
5508 sig0inv=1.0D0/sig0i**2
5509 delthec=thetai-thet_pred_mean
5510 delthe0=thetai-theta0i
5511 term1=-0.5D0*sigcsq*delthec*delthec
5512 term2=-0.5D0*sig0inv*delthe0*delthe0
5513 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
5514 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5515 C NaNs in taking the logarithm. We extract the largest exponent which is added
5516 C to the energy (this being the log of the distribution) at the end of energy
5517 C term evaluation for this virtual-bond angle.
5518 if (term1.gt.term2) then
5520 term2=dexp(term2-termm)
5524 term1=dexp(term1-termm)
5527 C The ratio between the gamma-independent and gamma-dependent lobes of
5528 C the distribution is a Gaussian function of thet_pred_mean too.
5529 diffak=gthet(2,it)-thet_pred_mean
5530 ratak=diffak/gthet(3,it)**2
5531 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5532 C Let's differentiate it in thet_pred_mean NOW.
5534 C Now put together the distribution terms to make complete distribution.
5535 termexp=term1+ak*term2
5536 termpre=sigc+ak*sig0i
5537 C Contribution of the bending energy from this theta is just the -log of
5538 C the sum of the contributions from the two lobes and the pre-exponential
5539 C factor. Simple enough, isn't it?
5540 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5541 C write (iout,*) 'termexp',termexp,termm,termpre,i
5542 C NOW the derivatives!!!
5543 C 6/6/97 Take into account the deformation.
5544 E_theta=(delthec*sigcsq*term1
5545 & +ak*delthe0*sig0inv*term2)/termexp
5546 E_tc=((sigtc+aktc*sig0i)/termpre
5547 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
5548 & aktc*term2)/termexp)
5551 c-----------------------------------------------------------------------------
5552 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
5553 implicit real*8 (a-h,o-z)
5554 include 'DIMENSIONS'
5555 include 'COMMON.LOCAL'
5556 include 'COMMON.IOUNITS'
5557 common /calcthet/ term1,term2,termm,diffak,ratak,
5558 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5559 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5560 delthec=thetai-thet_pred_mean
5561 delthe0=thetai-theta0i
5562 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
5563 t3 = thetai-thet_pred_mean
5567 t14 = t12+t6*sigsqtc
5569 t21 = thetai-theta0i
5575 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
5576 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
5577 & *(-t12*t9-ak*sig0inv*t27)
5581 C--------------------------------------------------------------------------
5582 subroutine ebend(etheta)
5584 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5585 C angles gamma and its derivatives in consecutive thetas and gammas.
5586 C ab initio-derived potentials from
5587 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5589 implicit real*8 (a-h,o-z)
5590 include 'DIMENSIONS'
5591 include 'COMMON.LOCAL'
5592 include 'COMMON.GEO'
5593 include 'COMMON.INTERACT'
5594 include 'COMMON.DERIV'
5595 include 'COMMON.VAR'
5596 include 'COMMON.CHAIN'
5597 include 'COMMON.IOUNITS'
5598 include 'COMMON.NAMES'
5599 include 'COMMON.FFIELD'
5600 include 'COMMON.CONTROL'
5601 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
5602 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
5603 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
5604 & sinph1ph2(maxdouble,maxdouble)
5605 logical lprn /.false./, lprn1 /.false./
5607 do i=ithet_start,ithet_end
5608 c print *,i,itype(i-1),itype(i),itype(i-2)
5609 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5610 & .or.itype(i).eq.ntyp1) cycle
5611 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
5613 if (iabs(itype(i+1)).eq.20) iblock=2
5614 if (iabs(itype(i+1)).ne.20) iblock=1
5618 theti2=0.5d0*theta(i)
5619 ityp2=ithetyp((itype(i-1)))
5621 coskt(k)=dcos(k*theti2)
5622 sinkt(k)=dsin(k*theti2)
5624 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5627 if (phii.ne.phii) phii=150.0
5631 ityp1=ithetyp((itype(i-2)))
5632 C propagation of chirality for glycine type
5634 cosph1(k)=dcos(k*phii)
5635 sinph1(k)=dsin(k*phii)
5645 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5648 if (phii1.ne.phii1) phii1=150.0
5653 ityp3=ithetyp((itype(i)))
5655 cosph2(k)=dcos(k*phii1)
5656 sinph2(k)=dsin(k*phii1)
5666 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5669 ccl=cosph1(l)*cosph2(k-l)
5670 ssl=sinph1(l)*sinph2(k-l)
5671 scl=sinph1(l)*cosph2(k-l)
5672 csl=cosph1(l)*sinph2(k-l)
5673 cosph1ph2(l,k)=ccl-ssl
5674 cosph1ph2(k,l)=ccl+ssl
5675 sinph1ph2(l,k)=scl+csl
5676 sinph1ph2(k,l)=scl-csl
5680 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5681 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5682 write (iout,*) "coskt and sinkt"
5684 write (iout,*) k,coskt(k),sinkt(k)
5688 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5689 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5692 & write (iout,*) "k",k,"
5693 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
5694 & " ethetai",ethetai
5697 write (iout,*) "cosph and sinph"
5699 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5701 write (iout,*) "cosph1ph2 and sinph2ph2"
5704 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5705 & sinph1ph2(l,k),sinph1ph2(k,l)
5708 write(iout,*) "ethetai",ethetai
5712 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5713 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5714 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5715 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5716 ethetai=ethetai+sinkt(m)*aux
5717 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5718 dephii=dephii+k*sinkt(m)*(
5719 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5720 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5721 dephii1=dephii1+k*sinkt(m)*(
5722 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5723 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5725 & write (iout,*) "m",m," k",k," bbthet",
5726 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5727 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5728 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5729 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5733 & write(iout,*) "ethetai",ethetai
5737 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5738 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5739 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5740 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5741 ethetai=ethetai+sinkt(m)*aux
5742 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5743 dephii=dephii+l*sinkt(m)*(
5744 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5745 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5746 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5747 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5748 dephii1=dephii1+(k-l)*sinkt(m)*(
5749 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5750 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5751 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5752 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5754 write (iout,*) "m",m," k",k," l",l," ffthet",
5755 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5756 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5757 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5758 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5759 & " ethetai",ethetai
5760 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5761 & cosph1ph2(k,l)*sinkt(m),
5762 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5770 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5771 & i,theta(i)*rad2deg,phii*rad2deg,
5772 & phii1*rad2deg,ethetai
5774 etheta=etheta+ethetai
5775 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5776 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5777 gloc(nphi+i-2,icg)=wang*dethetai+gloc(nphi+i-2,icg)
5783 c-----------------------------------------------------------------------------
5784 subroutine esc(escloc)
5785 C Calculate the local energy of a side chain and its derivatives in the
5786 C corresponding virtual-bond valence angles THETA and the spherical angles
5788 implicit real*8 (a-h,o-z)
5789 include 'DIMENSIONS'
5790 include 'COMMON.GEO'
5791 include 'COMMON.LOCAL'
5792 include 'COMMON.VAR'
5793 include 'COMMON.INTERACT'
5794 include 'COMMON.DERIV'
5795 include 'COMMON.CHAIN'
5796 include 'COMMON.IOUNITS'
5797 include 'COMMON.NAMES'
5798 include 'COMMON.FFIELD'
5799 include 'COMMON.CONTROL'
5800 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5801 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5802 common /sccalc/ time11,time12,time112,theti,it,nlobit
5805 c write (iout,'(a)') 'ESC'
5806 do i=loc_start,loc_end
5808 if (it.eq.ntyp1) cycle
5809 if (it.eq.10) goto 1
5810 nlobit=nlob(iabs(it))
5811 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5812 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5813 theti=theta(i+1)-pipol
5818 if (x(2).gt.pi-delta) then
5822 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5824 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5825 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5827 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5828 & ddersc0(1),dersc(1))
5829 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5830 & ddersc0(3),dersc(3))
5832 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5834 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5835 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5836 & dersc0(2),esclocbi,dersc02)
5837 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5839 call splinthet(x(2),0.5d0*delta,ss,ssd)
5844 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5846 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5847 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5849 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5851 c write (iout,*) escloci
5852 else if (x(2).lt.delta) then
5856 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5858 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5859 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5861 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5862 & ddersc0(1),dersc(1))
5863 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5864 & ddersc0(3),dersc(3))
5866 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5868 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5869 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5870 & dersc0(2),esclocbi,dersc02)
5871 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5876 call splinthet(x(2),0.5d0*delta,ss,ssd)
5878 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5880 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5881 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5883 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5884 c write (iout,*) escloci
5886 call enesc(x,escloci,dersc,ddummy,.false.)
5889 escloc=escloc+escloci
5890 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5891 & 'escloc',i,escloci
5892 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5894 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5896 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5897 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5902 C---------------------------------------------------------------------------
5903 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5904 implicit real*8 (a-h,o-z)
5905 include 'DIMENSIONS'
5906 include 'COMMON.GEO'
5907 include 'COMMON.LOCAL'
5908 include 'COMMON.IOUNITS'
5909 common /sccalc/ time11,time12,time112,theti,it,nlobit
5910 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5911 double precision contr(maxlob,-1:1)
5913 c write (iout,*) 'it=',it,' nlobit=',nlobit
5917 if (mixed) ddersc(j)=0.0d0
5921 C Because of periodicity of the dependence of the SC energy in omega we have
5922 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5923 C To avoid underflows, first compute & store the exponents.
5931 z(k)=x(k)-censc(k,j,it)
5936 Axk=Axk+gaussc(l,k,j,it)*z(l)
5942 expfac=expfac+Ax(k,j,iii)*z(k)
5950 C As in the case of ebend, we want to avoid underflows in exponentiation and
5951 C subsequent NaNs and INFs in energy calculation.
5952 C Find the largest exponent
5956 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5960 cd print *,'it=',it,' emin=',emin
5962 C Compute the contribution to SC energy and derivatives
5967 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5968 if(adexp.ne.adexp) adexp=1.0
5971 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5973 cd print *,'j=',j,' expfac=',expfac
5974 escloc_i=escloc_i+expfac
5976 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5980 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5981 & +gaussc(k,2,j,it))*expfac
5988 dersc(1)=dersc(1)/cos(theti)**2
5989 ddersc(1)=ddersc(1)/cos(theti)**2
5992 escloci=-(dlog(escloc_i)-emin)
5994 dersc(j)=dersc(j)/escloc_i
5998 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
6003 C------------------------------------------------------------------------------
6004 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
6005 implicit real*8 (a-h,o-z)
6006 include 'DIMENSIONS'
6007 include 'COMMON.GEO'
6008 include 'COMMON.LOCAL'
6009 include 'COMMON.IOUNITS'
6010 common /sccalc/ time11,time12,time112,theti,it,nlobit
6011 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
6012 double precision contr(maxlob)
6023 z(k)=x(k)-censc(k,j,it)
6029 Axk=Axk+gaussc(l,k,j,it)*z(l)
6035 expfac=expfac+Ax(k,j)*z(k)
6040 C As in the case of ebend, we want to avoid underflows in exponentiation and
6041 C subsequent NaNs and INFs in energy calculation.
6042 C Find the largest exponent
6045 if (emin.gt.contr(j)) emin=contr(j)
6049 C Compute the contribution to SC energy and derivatives
6053 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6054 escloc_i=escloc_i+expfac
6056 dersc(k)=dersc(k)+Ax(k,j)*expfac
6058 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
6059 & +gaussc(1,2,j,it))*expfac
6063 dersc(1)=dersc(1)/cos(theti)**2
6064 dersc12=dersc12/cos(theti)**2
6065 escloci=-(dlog(escloc_i)-emin)
6067 dersc(j)=dersc(j)/escloc_i
6069 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6073 c----------------------------------------------------------------------------------
6074 subroutine esc(escloc)
6075 C Calculate the local energy of a side chain and its derivatives in the
6076 C corresponding virtual-bond valence angles THETA and the spherical angles
6077 C ALPHA and OMEGA derived from AM1 all-atom calculations.
6078 C added by Urszula Kozlowska. 07/11/2007
6080 implicit real*8 (a-h,o-z)
6081 include 'DIMENSIONS'
6082 include 'COMMON.GEO'
6083 include 'COMMON.LOCAL'
6084 include 'COMMON.VAR'
6085 include 'COMMON.SCROT'
6086 include 'COMMON.INTERACT'
6087 include 'COMMON.DERIV'
6088 include 'COMMON.CHAIN'
6089 include 'COMMON.IOUNITS'
6090 include 'COMMON.NAMES'
6091 include 'COMMON.FFIELD'
6092 include 'COMMON.CONTROL'
6093 include 'COMMON.VECTORS'
6094 double precision x_prime(3),y_prime(3),z_prime(3)
6095 & , sumene,dsc_i,dp2_i,x(65),
6096 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
6097 & de_dxx,de_dyy,de_dzz,de_dt
6098 double precision s1_t,s1_6_t,s2_t,s2_6_t
6100 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
6101 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
6102 & dt_dCi(3),dt_dCi1(3)
6103 common /sccalc/ time11,time12,time112,theti,it,nlobit
6106 do i=loc_start,loc_end
6107 if (itype(i).eq.ntyp1) cycle
6108 costtab(i+1) =dcos(theta(i+1))
6109 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6110 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6111 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6112 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6113 cosfac=dsqrt(cosfac2)
6114 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6115 sinfac=dsqrt(sinfac2)
6117 if (it.eq.10) goto 1
6119 C Compute the axes of tghe local cartesian coordinates system; store in
6120 c x_prime, y_prime and z_prime
6127 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6128 C & dc_norm(3,i+nres)
6130 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6131 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6134 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
6137 c write (2,*) "x_prime",(x_prime(j),j=1,3)
6138 c write (2,*) "y_prime",(y_prime(j),j=1,3)
6139 c write (2,*) "z_prime",(z_prime(j),j=1,3)
6140 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6141 c & " xy",scalar(x_prime(1),y_prime(1)),
6142 c & " xz",scalar(x_prime(1),z_prime(1)),
6143 c & " yy",scalar(y_prime(1),y_prime(1)),
6144 c & " yz",scalar(y_prime(1),z_prime(1)),
6145 c & " zz",scalar(z_prime(1),z_prime(1))
6147 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6148 C to local coordinate system. Store in xx, yy, zz.
6154 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6155 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6156 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6163 C Compute the energy of the ith side cbain
6165 c write (2,*) "xx",xx," yy",yy," zz",zz
6168 x(j) = sc_parmin(j,it)
6171 Cc diagnostics - remove later
6173 yy1 = dsin(alph(2))*dcos(omeg(2))
6174 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
6175 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
6176 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
6178 C," --- ", xx_w,yy_w,zz_w
6181 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6182 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6184 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6185 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6187 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6188 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6189 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6190 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6191 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6193 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6194 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6195 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6196 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6197 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6199 dsc_i = 0.743d0+x(61)
6201 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6202 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6203 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6204 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6205 s1=(1+x(63))/(0.1d0 + dscp1)
6206 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6207 s2=(1+x(65))/(0.1d0 + dscp2)
6208 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6209 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
6210 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6211 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6213 c & dscp1,dscp2,sumene
6214 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6215 escloc = escloc + sumene
6216 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
6221 C This section to check the numerical derivatives of the energy of ith side
6222 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6223 C #define DEBUG in the code to turn it on.
6225 write (2,*) "sumene =",sumene
6229 write (2,*) xx,yy,zz
6230 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6231 de_dxx_num=(sumenep-sumene)/aincr
6233 write (2,*) "xx+ sumene from enesc=",sumenep
6236 write (2,*) xx,yy,zz
6237 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6238 de_dyy_num=(sumenep-sumene)/aincr
6240 write (2,*) "yy+ sumene from enesc=",sumenep
6243 write (2,*) xx,yy,zz
6244 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6245 de_dzz_num=(sumenep-sumene)/aincr
6247 write (2,*) "zz+ sumene from enesc=",sumenep
6248 costsave=cost2tab(i+1)
6249 sintsave=sint2tab(i+1)
6250 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6251 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6252 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6253 de_dt_num=(sumenep-sumene)/aincr
6254 write (2,*) " t+ sumene from enesc=",sumenep
6255 cost2tab(i+1)=costsave
6256 sint2tab(i+1)=sintsave
6257 C End of diagnostics section.
6260 C Compute the gradient of esc
6262 c zz=zz*dsign(1.0,dfloat(itype(i)))
6263 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6264 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6265 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6266 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6267 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6268 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6269 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6270 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6271 pom1=(sumene3*sint2tab(i+1)+sumene1)
6272 & *(pom_s1/dscp1+pom_s16*dscp1**4)
6273 pom2=(sumene4*cost2tab(i+1)+sumene2)
6274 & *(pom_s2/dscp2+pom_s26*dscp2**4)
6275 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6276 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
6277 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
6279 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6280 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
6281 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
6283 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
6284 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
6285 & +(pom1+pom2)*pom_dx
6287 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
6290 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6291 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
6292 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
6294 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6295 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
6296 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
6297 & +x(59)*zz**2 +x(60)*xx*zz
6298 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
6299 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
6300 & +(pom1-pom2)*pom_dy
6302 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
6305 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
6306 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
6307 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
6308 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
6309 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
6310 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
6311 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
6312 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6314 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
6317 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
6318 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
6319 & +pom1*pom_dt1+pom2*pom_dt2
6321 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
6326 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6327 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6328 cosfac2xx=cosfac2*xx
6329 sinfac2yy=sinfac2*yy
6331 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
6333 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
6335 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6336 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6337 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6338 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6339 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6340 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6341 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6342 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6343 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6344 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6348 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
6349 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6350 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
6351 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6354 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6355 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6356 dZZ_XYZ(k)=vbld_inv(i+nres)*
6357 & (z_prime(k)-zz*dC_norm(k,i+nres))
6359 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6360 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6364 dXX_Ctab(k,i)=dXX_Ci(k)
6365 dXX_C1tab(k,i)=dXX_Ci1(k)
6366 dYY_Ctab(k,i)=dYY_Ci(k)
6367 dYY_C1tab(k,i)=dYY_Ci1(k)
6368 dZZ_Ctab(k,i)=dZZ_Ci(k)
6369 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6370 dXX_XYZtab(k,i)=dXX_XYZ(k)
6371 dYY_XYZtab(k,i)=dYY_XYZ(k)
6372 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6376 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6377 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6378 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6379 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
6380 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6382 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6383 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6384 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
6385 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6386 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
6387 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6388 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
6389 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6391 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6392 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6394 C to check gradient call subroutine check_grad
6400 c------------------------------------------------------------------------------
6401 double precision function enesc(x,xx,yy,zz,cost2,sint2)
6403 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
6404 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
6405 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6406 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6408 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6409 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6411 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6412 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6413 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6414 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6415 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6417 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6418 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6419 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6420 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6421 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6423 dsc_i = 0.743d0+x(61)
6425 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6426 & *(xx*cost2+yy*sint2))
6427 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6428 & *(xx*cost2-yy*sint2))
6429 s1=(1+x(63))/(0.1d0 + dscp1)
6430 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6431 s2=(1+x(65))/(0.1d0 + dscp2)
6432 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6433 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
6434 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
6439 c------------------------------------------------------------------------------
6440 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6442 C This procedure calculates two-body contact function g(rij) and its derivative:
6445 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6448 C where x=(rij-r0ij)/delta
6450 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6453 double precision rij,r0ij,eps0ij,fcont,fprimcont
6454 double precision x,x2,x4,delta
6458 if (x.lt.-1.0D0) then
6461 else if (x.le.1.0D0) then
6464 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6465 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6472 c------------------------------------------------------------------------------
6473 subroutine splinthet(theti,delta,ss,ssder)
6474 implicit real*8 (a-h,o-z)
6475 include 'DIMENSIONS'
6476 include 'COMMON.VAR'
6477 include 'COMMON.GEO'
6480 if (theti.gt.pipol) then
6481 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6483 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6488 c------------------------------------------------------------------------------
6489 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6491 double precision x,x0,delta,f0,f1,fprim0,f,fprim
6492 double precision ksi,ksi2,ksi3,a1,a2,a3
6493 a1=fprim0*delta/(f1-f0)
6499 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6500 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6503 c------------------------------------------------------------------------------
6504 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6506 double precision x,x0,delta,f0x,f1x,fprim0x,fx
6507 double precision ksi,ksi2,ksi3,a1,a2,a3
6512 a2=3*(f1x-f0x)-2*fprim0x*delta
6513 a3=fprim0x*delta-2*(f1x-f0x)
6514 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6517 C-----------------------------------------------------------------------------
6519 C-----------------------------------------------------------------------------
6520 subroutine etor(etors,edihcnstr)
6521 implicit real*8 (a-h,o-z)
6522 include 'DIMENSIONS'
6523 include 'COMMON.VAR'
6524 include 'COMMON.GEO'
6525 include 'COMMON.LOCAL'
6526 include 'COMMON.TORSION'
6527 include 'COMMON.INTERACT'
6528 include 'COMMON.DERIV'
6529 include 'COMMON.CHAIN'
6530 include 'COMMON.NAMES'
6531 include 'COMMON.IOUNITS'
6532 include 'COMMON.FFIELD'
6533 include 'COMMON.TORCNSTR'
6534 include 'COMMON.CONTROL'
6536 C Set lprn=.true. for debugging
6540 do i=iphi_start,iphi_end
6542 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6543 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6544 itori=itortyp(itype(i-2))
6545 itori1=itortyp(itype(i-1))
6548 C Proline-Proline pair is a special case...
6549 if (itori.eq.3 .and. itori1.eq.3) then
6550 if (phii.gt.-dwapi3) then
6552 fac=1.0D0/(1.0D0-cosphi)
6553 etorsi=v1(1,3,3)*fac
6554 etorsi=etorsi+etorsi
6555 etors=etors+etorsi-v1(1,3,3)
6556 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
6557 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6560 v1ij=v1(j+1,itori,itori1)
6561 v2ij=v2(j+1,itori,itori1)
6564 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6565 if (energy_dec) etors_ii=etors_ii+
6566 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6567 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6571 v1ij=v1(j,itori,itori1)
6572 v2ij=v2(j,itori,itori1)
6575 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6576 if (energy_dec) etors_ii=etors_ii+
6577 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6578 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6581 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6584 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6585 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6586 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6587 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6588 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6590 ! 6/20/98 - dihedral angle constraints
6593 itori=idih_constr(i)
6596 if (difi.gt.drange(i)) then
6598 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6599 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6600 else if (difi.lt.-drange(i)) then
6602 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6603 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6605 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6606 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6608 ! write (iout,*) 'edihcnstr',edihcnstr
6611 c------------------------------------------------------------------------------
6612 subroutine etor_d(etors_d)
6616 c----------------------------------------------------------------------------
6618 subroutine etor(etors,edihcnstr)
6619 implicit real*8 (a-h,o-z)
6620 include 'DIMENSIONS'
6621 include 'COMMON.VAR'
6622 include 'COMMON.GEO'
6623 include 'COMMON.LOCAL'
6624 include 'COMMON.TORSION'
6625 include 'COMMON.INTERACT'
6626 include 'COMMON.DERIV'
6627 include 'COMMON.CHAIN'
6628 include 'COMMON.NAMES'
6629 include 'COMMON.IOUNITS'
6630 include 'COMMON.FFIELD'
6631 include 'COMMON.TORCNSTR'
6632 include 'COMMON.CONTROL'
6634 C Set lprn=.true. for debugging
6638 do i=iphi_start,iphi_end
6639 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6640 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6641 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
6642 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
6643 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6644 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6645 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6646 C For introducing the NH3+ and COO- group please check the etor_d for reference
6649 if (iabs(itype(i)).eq.20) then
6654 itori=itortyp(itype(i-2))
6655 itori1=itortyp(itype(i-1))
6658 C Regular cosine and sine terms
6659 do j=1,nterm(itori,itori1,iblock)
6660 v1ij=v1(j,itori,itori1,iblock)
6661 v2ij=v2(j,itori,itori1,iblock)
6664 etors=etors+v1ij*cosphi+v2ij*sinphi
6665 if (energy_dec) etors_ii=etors_ii+
6666 & v1ij*cosphi+v2ij*sinphi
6667 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6671 C E = SUM ----------------------------------- - v1
6672 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6674 cosphi=dcos(0.5d0*phii)
6675 sinphi=dsin(0.5d0*phii)
6676 do j=1,nlor(itori,itori1,iblock)
6677 vl1ij=vlor1(j,itori,itori1)
6678 vl2ij=vlor2(j,itori,itori1)
6679 vl3ij=vlor3(j,itori,itori1)
6680 pom=vl2ij*cosphi+vl3ij*sinphi
6681 pom1=1.0d0/(pom*pom+1.0d0)
6682 etors=etors+vl1ij*pom1
6683 if (energy_dec) etors_ii=etors_ii+
6686 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6688 C Subtract the constant term
6689 etors=etors-v0(itori,itori1,iblock)
6690 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6691 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
6693 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6694 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6695 & (v1(j,itori,itori1,iblock),j=1,6),
6696 & (v2(j,itori,itori1,iblock),j=1,6)
6697 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6698 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6700 ! 6/20/98 - dihedral angle constraints
6702 c do i=1,ndih_constr
6703 do i=idihconstr_start,idihconstr_end
6704 itori=idih_constr(i)
6706 difi=pinorm(phii-phi0(i))
6707 if (difi.gt.drange(i)) then
6709 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6710 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6711 else if (difi.lt.-drange(i)) then
6713 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6714 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6718 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6719 cd & rad2deg*phi0(i), rad2deg*drange(i),
6720 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6722 cd write (iout,*) 'edihcnstr',edihcnstr
6725 c----------------------------------------------------------------------------
6726 subroutine etor_d(etors_d)
6727 C 6/23/01 Compute double torsional energy
6728 implicit real*8 (a-h,o-z)
6729 include 'DIMENSIONS'
6730 include 'COMMON.VAR'
6731 include 'COMMON.GEO'
6732 include 'COMMON.LOCAL'
6733 include 'COMMON.TORSION'
6734 include 'COMMON.INTERACT'
6735 include 'COMMON.DERIV'
6736 include 'COMMON.CHAIN'
6737 include 'COMMON.NAMES'
6738 include 'COMMON.IOUNITS'
6739 include 'COMMON.FFIELD'
6740 include 'COMMON.TORCNSTR'
6742 C Set lprn=.true. for debugging
6746 c write(iout,*) "a tu??"
6747 do i=iphid_start,iphid_end
6748 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6749 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6750 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
6751 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
6752 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
6753 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
6754 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
6755 & (itype(i+1).eq.ntyp1)) cycle
6756 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6757 itori=itortyp(itype(i-2))
6758 itori1=itortyp(itype(i-1))
6759 itori2=itortyp(itype(i))
6765 if (iabs(itype(i+1)).eq.20) iblock=2
6766 C Iblock=2 Proline type
6767 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
6768 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
6769 C if (itype(i+1).eq.ntyp1) iblock=3
6770 C The problem of NH3+ group can be resolved by adding new parameters please note if there
6771 C IS or IS NOT need for this
6772 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
6773 C is (itype(i-3).eq.ntyp1) ntblock=2
6774 C ntblock is N-terminal blocking group
6776 C Regular cosine and sine terms
6777 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6778 C Example of changes for NH3+ blocking group
6779 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
6780 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
6781 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6782 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6783 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6784 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6785 cosphi1=dcos(j*phii)
6786 sinphi1=dsin(j*phii)
6787 cosphi2=dcos(j*phii1)
6788 sinphi2=dsin(j*phii1)
6789 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6790 & v2cij*cosphi2+v2sij*sinphi2
6791 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6792 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6794 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6796 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6797 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6798 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6799 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6800 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6801 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6802 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6803 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6804 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6805 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6806 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6807 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6808 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6809 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6812 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6813 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6818 c------------------------------------------------------------------------------
6819 subroutine eback_sc_corr(esccor)
6820 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6821 c conformational states; temporarily implemented as differences
6822 c between UNRES torsional potentials (dependent on three types of
6823 c residues) and the torsional potentials dependent on all 20 types
6824 c of residues computed from AM1 energy surfaces of terminally-blocked
6825 c amino-acid residues.
6826 implicit real*8 (a-h,o-z)
6827 include 'DIMENSIONS'
6828 include 'COMMON.VAR'
6829 include 'COMMON.GEO'
6830 include 'COMMON.LOCAL'
6831 include 'COMMON.TORSION'
6832 include 'COMMON.SCCOR'
6833 include 'COMMON.INTERACT'
6834 include 'COMMON.DERIV'
6835 include 'COMMON.CHAIN'
6836 include 'COMMON.NAMES'
6837 include 'COMMON.IOUNITS'
6838 include 'COMMON.FFIELD'
6839 include 'COMMON.CONTROL'
6841 C Set lprn=.true. for debugging
6844 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
6846 do i=itau_start,itau_end
6847 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6849 isccori=isccortyp(itype(i-2))
6850 isccori1=isccortyp(itype(i-1))
6851 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
6853 do intertyp=1,3 !intertyp
6854 cc Added 09 May 2012 (Adasko)
6855 cc Intertyp means interaction type of backbone mainchain correlation:
6856 c 1 = SC...Ca...Ca...Ca
6857 c 2 = Ca...Ca...Ca...SC
6858 c 3 = SC...Ca...Ca...SCi
6860 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6861 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6862 & (itype(i-1).eq.ntyp1)))
6863 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6864 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6865 & .or.(itype(i).eq.ntyp1)))
6866 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6867 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6868 & (itype(i-3).eq.ntyp1)))) cycle
6869 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6870 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6872 do j=1,nterm_sccor(isccori,isccori1)
6873 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6874 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6875 cosphi=dcos(j*tauangle(intertyp,i))
6876 sinphi=dsin(j*tauangle(intertyp,i))
6877 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6878 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6880 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
6881 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6883 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6884 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
6885 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
6886 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
6887 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6893 c----------------------------------------------------------------------------
6894 subroutine multibody(ecorr)
6895 C This subroutine calculates multi-body contributions to energy following
6896 C the idea of Skolnick et al. If side chains I and J make a contact and
6897 C at the same time side chains I+1 and J+1 make a contact, an extra
6898 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6899 implicit real*8 (a-h,o-z)
6900 include 'DIMENSIONS'
6901 include 'COMMON.IOUNITS'
6902 include 'COMMON.DERIV'
6903 include 'COMMON.INTERACT'
6904 include 'COMMON.CONTACTS'
6905 double precision gx(3),gx1(3)
6908 C Set lprn=.true. for debugging
6912 write (iout,'(a)') 'Contact function values:'
6914 write (iout,'(i2,20(1x,i2,f10.5))')
6915 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6930 num_conti=num_cont(i)
6931 num_conti1=num_cont(i1)
6936 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6937 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6938 cd & ' ishift=',ishift
6939 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6940 C The system gains extra energy.
6941 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6942 endif ! j1==j+-ishift
6951 c------------------------------------------------------------------------------
6952 double precision function esccorr(i,j,k,l,jj,kk)
6953 implicit real*8 (a-h,o-z)
6954 include 'DIMENSIONS'
6955 include 'COMMON.IOUNITS'
6956 include 'COMMON.DERIV'
6957 include 'COMMON.INTERACT'
6958 include 'COMMON.CONTACTS'
6959 double precision gx(3),gx1(3)
6964 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6965 C Calculate the multi-body contribution to energy.
6966 C Calculate multi-body contributions to the gradient.
6967 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6968 cd & k,l,(gacont(m,kk,k),m=1,3)
6970 gx(m) =ekl*gacont(m,jj,i)
6971 gx1(m)=eij*gacont(m,kk,k)
6972 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6973 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6974 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6975 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6979 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6984 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6990 c------------------------------------------------------------------------------
6991 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6992 C This subroutine calculates multi-body contributions to hydrogen-bonding
6993 implicit real*8 (a-h,o-z)
6994 include 'DIMENSIONS'
6995 include 'COMMON.IOUNITS'
6998 parameter (max_cont=maxconts)
6999 parameter (max_dim=26)
7000 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7001 double precision zapas(max_dim,maxconts,max_fg_procs),
7002 & zapas_recv(max_dim,maxconts,max_fg_procs)
7003 common /przechowalnia/ zapas
7004 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7005 & status_array(MPI_STATUS_SIZE,maxconts*2)
7007 include 'COMMON.SETUP'
7008 include 'COMMON.FFIELD'
7009 include 'COMMON.DERIV'
7010 include 'COMMON.INTERACT'
7011 include 'COMMON.CONTACTS'
7012 include 'COMMON.CONTROL'
7013 include 'COMMON.LOCAL'
7014 double precision gx(3),gx1(3),time00
7017 C Set lprn=.true. for debugging
7022 if (nfgtasks.le.1) goto 30
7024 write (iout,'(a)') 'Contact function values before RECEIVE:'
7026 write (iout,'(2i3,50(1x,i2,f5.2))')
7027 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7028 & j=1,num_cont_hb(i))
7032 do i=1,ntask_cont_from
7035 do i=1,ntask_cont_to
7038 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7040 C Make the list of contacts to send to send to other procesors
7041 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
7043 do i=iturn3_start,iturn3_end
7044 c write (iout,*) "make contact list turn3",i," num_cont",
7046 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
7048 do i=iturn4_start,iturn4_end
7049 c write (iout,*) "make contact list turn4",i," num_cont",
7051 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
7055 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7057 do j=1,num_cont_hb(i)
7060 iproc=iint_sent_local(k,jjc,ii)
7061 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7062 if (iproc.gt.0) then
7063 ncont_sent(iproc)=ncont_sent(iproc)+1
7064 nn=ncont_sent(iproc)
7066 zapas(2,nn,iproc)=jjc
7067 zapas(3,nn,iproc)=facont_hb(j,i)
7068 zapas(4,nn,iproc)=ees0p(j,i)
7069 zapas(5,nn,iproc)=ees0m(j,i)
7070 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
7071 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
7072 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
7073 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
7074 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
7075 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
7076 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
7077 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
7078 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
7079 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
7080 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
7081 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
7082 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
7083 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
7084 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
7085 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
7086 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
7087 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
7088 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
7089 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
7090 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
7097 & "Numbers of contacts to be sent to other processors",
7098 & (ncont_sent(i),i=1,ntask_cont_to)
7099 write (iout,*) "Contacts sent"
7100 do ii=1,ntask_cont_to
7102 iproc=itask_cont_to(ii)
7103 write (iout,*) nn," contacts to processor",iproc,
7104 & " of CONT_TO_COMM group"
7106 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7114 CorrelID1=nfgtasks+fg_rank+1
7116 C Receive the numbers of needed contacts from other processors
7117 do ii=1,ntask_cont_from
7118 iproc=itask_cont_from(ii)
7120 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7121 & FG_COMM,req(ireq),IERR)
7123 c write (iout,*) "IRECV ended"
7125 C Send the number of contacts needed by other processors
7126 do ii=1,ntask_cont_to
7127 iproc=itask_cont_to(ii)
7129 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7130 & FG_COMM,req(ireq),IERR)
7132 c write (iout,*) "ISEND ended"
7133 c write (iout,*) "number of requests (nn)",ireq
7136 & call MPI_Waitall(ireq,req,status_array,ierr)
7138 c & "Numbers of contacts to be received from other processors",
7139 c & (ncont_recv(i),i=1,ntask_cont_from)
7143 do ii=1,ntask_cont_from
7144 iproc=itask_cont_from(ii)
7146 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7147 c & " of CONT_TO_COMM group"
7151 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7152 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7153 c write (iout,*) "ireq,req",ireq,req(ireq)
7156 C Send the contacts to processors that need them
7157 do ii=1,ntask_cont_to
7158 iproc=itask_cont_to(ii)
7160 c write (iout,*) nn," contacts to processor",iproc,
7161 c & " of CONT_TO_COMM group"
7164 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7165 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7166 c write (iout,*) "ireq,req",ireq,req(ireq)
7168 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7172 c write (iout,*) "number of requests (contacts)",ireq
7173 c write (iout,*) "req",(req(i),i=1,4)
7176 & call MPI_Waitall(ireq,req,status_array,ierr)
7177 do iii=1,ntask_cont_from
7178 iproc=itask_cont_from(iii)
7181 write (iout,*) "Received",nn," contacts from processor",iproc,
7182 & " of CONT_FROM_COMM group"
7185 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
7190 ii=zapas_recv(1,i,iii)
7191 c Flag the received contacts to prevent double-counting
7192 jj=-zapas_recv(2,i,iii)
7193 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7195 nnn=num_cont_hb(ii)+1
7198 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
7199 ees0p(nnn,ii)=zapas_recv(4,i,iii)
7200 ees0m(nnn,ii)=zapas_recv(5,i,iii)
7201 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
7202 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
7203 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
7204 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
7205 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
7206 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
7207 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
7208 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
7209 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
7210 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
7211 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
7212 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
7213 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
7214 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
7215 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
7216 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
7217 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
7218 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
7219 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
7220 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
7221 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
7226 write (iout,'(a)') 'Contact function values after receive:'
7228 write (iout,'(2i3,50(1x,i3,f5.2))')
7229 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7230 & j=1,num_cont_hb(i))
7237 write (iout,'(a)') 'Contact function values:'
7239 write (iout,'(2i3,50(1x,i3,f5.2))')
7240 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7241 & j=1,num_cont_hb(i))
7245 C Remove the loop below after debugging !!!
7252 C Calculate the local-electrostatic correlation terms
7253 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
7255 num_conti=num_cont_hb(i)
7256 num_conti1=num_cont_hb(i+1)
7263 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7264 c & ' jj=',jj,' kk=',kk
7265 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7266 & .or. j.lt.0 .and. j1.gt.0) .and.
7267 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7268 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7269 C The system gains extra energy.
7270 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7271 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
7272 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
7274 else if (j1.eq.j) then
7275 C Contacts I-J and I-(J+1) occur simultaneously.
7276 C The system loses extra energy.
7277 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7282 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7283 c & ' jj=',jj,' kk=',kk
7285 C Contacts I-J and (I+1)-J occur simultaneously.
7286 C The system loses extra energy.
7287 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7294 c------------------------------------------------------------------------------
7295 subroutine add_hb_contact(ii,jj,itask)
7296 implicit real*8 (a-h,o-z)
7297 include "DIMENSIONS"
7298 include "COMMON.IOUNITS"
7301 parameter (max_cont=maxconts)
7302 parameter (max_dim=26)
7303 include "COMMON.CONTACTS"
7304 double precision zapas(max_dim,maxconts,max_fg_procs),
7305 & zapas_recv(max_dim,maxconts,max_fg_procs)
7306 common /przechowalnia/ zapas
7307 integer i,j,ii,jj,iproc,itask(4),nn
7308 c write (iout,*) "itask",itask
7311 if (iproc.gt.0) then
7312 do j=1,num_cont_hb(ii)
7314 c write (iout,*) "i",ii," j",jj," jjc",jjc
7316 ncont_sent(iproc)=ncont_sent(iproc)+1
7317 nn=ncont_sent(iproc)
7318 zapas(1,nn,iproc)=ii
7319 zapas(2,nn,iproc)=jjc
7320 zapas(3,nn,iproc)=facont_hb(j,ii)
7321 zapas(4,nn,iproc)=ees0p(j,ii)
7322 zapas(5,nn,iproc)=ees0m(j,ii)
7323 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
7324 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
7325 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
7326 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
7327 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
7328 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
7329 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
7330 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
7331 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
7332 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
7333 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
7334 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
7335 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
7336 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
7337 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
7338 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
7339 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
7340 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
7341 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
7342 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
7343 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
7351 c------------------------------------------------------------------------------
7352 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
7354 C This subroutine calculates multi-body contributions to hydrogen-bonding
7355 implicit real*8 (a-h,o-z)
7356 include 'DIMENSIONS'
7357 include 'COMMON.IOUNITS'
7360 parameter (max_cont=maxconts)
7361 parameter (max_dim=70)
7362 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7363 double precision zapas(max_dim,maxconts,max_fg_procs),
7364 & zapas_recv(max_dim,maxconts,max_fg_procs)
7365 common /przechowalnia/ zapas
7366 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7367 & status_array(MPI_STATUS_SIZE,maxconts*2)
7369 include 'COMMON.SETUP'
7370 include 'COMMON.FFIELD'
7371 include 'COMMON.DERIV'
7372 include 'COMMON.LOCAL'
7373 include 'COMMON.INTERACT'
7374 include 'COMMON.CONTACTS'
7375 include 'COMMON.CHAIN'
7376 include 'COMMON.CONTROL'
7377 double precision gx(3),gx1(3)
7378 integer num_cont_hb_old(maxres)
7380 double precision eello4,eello5,eelo6,eello_turn6
7381 external eello4,eello5,eello6,eello_turn6
7382 C Set lprn=.true. for debugging
7387 num_cont_hb_old(i)=num_cont_hb(i)
7391 if (nfgtasks.le.1) goto 30
7393 write (iout,'(a)') 'Contact function values before RECEIVE:'
7395 write (iout,'(2i3,50(1x,i2,f5.2))')
7396 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7397 & j=1,num_cont_hb(i))
7401 do i=1,ntask_cont_from
7404 do i=1,ntask_cont_to
7407 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7409 C Make the list of contacts to send to send to other procesors
7410 do i=iturn3_start,iturn3_end
7411 c write (iout,*) "make contact list turn3",i," num_cont",
7413 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
7415 do i=iturn4_start,iturn4_end
7416 c write (iout,*) "make contact list turn4",i," num_cont",
7418 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
7422 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7424 do j=1,num_cont_hb(i)
7427 iproc=iint_sent_local(k,jjc,ii)
7428 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7429 if (iproc.ne.0) then
7430 ncont_sent(iproc)=ncont_sent(iproc)+1
7431 nn=ncont_sent(iproc)
7433 zapas(2,nn,iproc)=jjc
7434 zapas(3,nn,iproc)=d_cont(j,i)
7438 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
7443 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
7451 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
7462 & "Numbers of contacts to be sent to other processors",
7463 & (ncont_sent(i),i=1,ntask_cont_to)
7464 write (iout,*) "Contacts sent"
7465 do ii=1,ntask_cont_to
7467 iproc=itask_cont_to(ii)
7468 write (iout,*) nn," contacts to processor",iproc,
7469 & " of CONT_TO_COMM group"
7471 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7479 CorrelID1=nfgtasks+fg_rank+1
7481 C Receive the numbers of needed contacts from other processors
7482 do ii=1,ntask_cont_from
7483 iproc=itask_cont_from(ii)
7485 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7486 & FG_COMM,req(ireq),IERR)
7488 c write (iout,*) "IRECV ended"
7490 C Send the number of contacts needed by other processors
7491 do ii=1,ntask_cont_to
7492 iproc=itask_cont_to(ii)
7494 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7495 & FG_COMM,req(ireq),IERR)
7497 c write (iout,*) "ISEND ended"
7498 c write (iout,*) "number of requests (nn)",ireq
7501 & call MPI_Waitall(ireq,req,status_array,ierr)
7503 c & "Numbers of contacts to be received from other processors",
7504 c & (ncont_recv(i),i=1,ntask_cont_from)
7508 do ii=1,ntask_cont_from
7509 iproc=itask_cont_from(ii)
7511 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7512 c & " of CONT_TO_COMM group"
7516 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7517 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7518 c write (iout,*) "ireq,req",ireq,req(ireq)
7521 C Send the contacts to processors that need them
7522 do ii=1,ntask_cont_to
7523 iproc=itask_cont_to(ii)
7525 c write (iout,*) nn," contacts to processor",iproc,
7526 c & " of CONT_TO_COMM group"
7529 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7530 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7531 c write (iout,*) "ireq,req",ireq,req(ireq)
7533 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7537 c write (iout,*) "number of requests (contacts)",ireq
7538 c write (iout,*) "req",(req(i),i=1,4)
7541 & call MPI_Waitall(ireq,req,status_array,ierr)
7542 do iii=1,ntask_cont_from
7543 iproc=itask_cont_from(iii)
7546 write (iout,*) "Received",nn," contacts from processor",iproc,
7547 & " of CONT_FROM_COMM group"
7550 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7555 ii=zapas_recv(1,i,iii)
7556 c Flag the received contacts to prevent double-counting
7557 jj=-zapas_recv(2,i,iii)
7558 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7560 nnn=num_cont_hb(ii)+1
7563 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7567 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7572 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7580 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7589 write (iout,'(a)') 'Contact function values after receive:'
7591 write (iout,'(2i3,50(1x,i3,5f6.3))')
7592 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7593 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7600 write (iout,'(a)') 'Contact function values:'
7602 write (iout,'(2i3,50(1x,i2,5f6.3))')
7603 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7604 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7610 C Remove the loop below after debugging !!!
7617 C Calculate the dipole-dipole interaction energies
7618 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7619 do i=iatel_s,iatel_e+1
7620 num_conti=num_cont_hb(i)
7629 C Calculate the local-electrostatic correlation terms
7630 c write (iout,*) "gradcorr5 in eello5 before loop"
7632 c write (iout,'(i5,3f10.5)')
7633 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7635 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7636 c write (iout,*) "corr loop i",i
7638 num_conti=num_cont_hb(i)
7639 num_conti1=num_cont_hb(i+1)
7646 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7647 c & ' jj=',jj,' kk=',kk
7648 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7649 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7650 & .or. j.lt.0 .and. j1.gt.0) .and.
7651 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7652 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7653 C The system gains extra energy.
7655 sqd1=dsqrt(d_cont(jj,i))
7656 sqd2=dsqrt(d_cont(kk,i1))
7657 sred_geom = sqd1*sqd2
7658 IF (sred_geom.lt.cutoff_corr) THEN
7659 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7661 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7662 cd & ' jj=',jj,' kk=',kk
7663 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7664 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7666 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7667 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7670 cd write (iout,*) 'sred_geom=',sred_geom,
7671 cd & ' ekont=',ekont,' fprim=',fprimcont,
7672 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7673 cd write (iout,*) "g_contij",g_contij
7674 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7675 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7676 call calc_eello(i,jp,i+1,jp1,jj,kk)
7677 if (wcorr4.gt.0.0d0)
7678 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7679 if (energy_dec.and.wcorr4.gt.0.0d0)
7680 1 write (iout,'(a6,4i5,0pf7.3)')
7681 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7682 c write (iout,*) "gradcorr5 before eello5"
7684 c write (iout,'(i5,3f10.5)')
7685 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7687 if (wcorr5.gt.0.0d0)
7688 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7689 c write (iout,*) "gradcorr5 after eello5"
7691 c write (iout,'(i5,3f10.5)')
7692 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7694 if (energy_dec.and.wcorr5.gt.0.0d0)
7695 1 write (iout,'(a6,4i5,0pf7.3)')
7696 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7697 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7698 cd write(2,*)'ijkl',i,jp,i+1,jp1
7699 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7700 & .or. wturn6.eq.0.0d0))then
7701 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7702 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7703 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7704 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7705 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7706 cd & 'ecorr6=',ecorr6
7707 cd write (iout,'(4e15.5)') sred_geom,
7708 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7709 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7710 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7711 else if (wturn6.gt.0.0d0
7712 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7713 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7714 eturn6=eturn6+eello_turn6(i,jj,kk)
7715 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7716 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7717 cd write (2,*) 'multibody_eello:eturn6',eturn6
7726 num_cont_hb(i)=num_cont_hb_old(i)
7728 c write (iout,*) "gradcorr5 in eello5"
7730 c write (iout,'(i5,3f10.5)')
7731 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7735 c------------------------------------------------------------------------------
7736 subroutine add_hb_contact_eello(ii,jj,itask)
7737 implicit real*8 (a-h,o-z)
7738 include "DIMENSIONS"
7739 include "COMMON.IOUNITS"
7742 parameter (max_cont=maxconts)
7743 parameter (max_dim=70)
7744 include "COMMON.CONTACTS"
7745 double precision zapas(max_dim,maxconts,max_fg_procs),
7746 & zapas_recv(max_dim,maxconts,max_fg_procs)
7747 common /przechowalnia/ zapas
7748 integer i,j,ii,jj,iproc,itask(4),nn
7749 c write (iout,*) "itask",itask
7752 if (iproc.gt.0) then
7753 do j=1,num_cont_hb(ii)
7755 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7757 ncont_sent(iproc)=ncont_sent(iproc)+1
7758 nn=ncont_sent(iproc)
7759 zapas(1,nn,iproc)=ii
7760 zapas(2,nn,iproc)=jjc
7761 zapas(3,nn,iproc)=d_cont(j,ii)
7765 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7770 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7778 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7790 c------------------------------------------------------------------------------
7791 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7792 implicit real*8 (a-h,o-z)
7793 include 'DIMENSIONS'
7794 include 'COMMON.IOUNITS'
7795 include 'COMMON.DERIV'
7796 include 'COMMON.INTERACT'
7797 include 'COMMON.CONTACTS'
7798 double precision gx(3),gx1(3)
7808 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7809 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7810 C Following 4 lines for diagnostics.
7815 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7816 c & 'Contacts ',i,j,
7817 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7818 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7820 C Calculate the multi-body contribution to energy.
7821 c ecorr=ecorr+ekont*ees
7822 C Calculate multi-body contributions to the gradient.
7823 coeffpees0pij=coeffp*ees0pij
7824 coeffmees0mij=coeffm*ees0mij
7825 coeffpees0pkl=coeffp*ees0pkl
7826 coeffmees0mkl=coeffm*ees0mkl
7828 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7829 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7830 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7831 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7832 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7833 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7834 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7835 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7836 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7837 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7838 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7839 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7840 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7841 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7842 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7843 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7844 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7845 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7846 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7847 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7848 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7849 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7850 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7851 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7852 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7857 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7858 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7859 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7860 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7865 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7866 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7867 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7868 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7871 c write (iout,*) "ehbcorr",ekont*ees
7876 C---------------------------------------------------------------------------
7877 subroutine dipole(i,j,jj)
7878 implicit real*8 (a-h,o-z)
7879 include 'DIMENSIONS'
7880 include 'COMMON.IOUNITS'
7881 include 'COMMON.CHAIN'
7882 include 'COMMON.FFIELD'
7883 include 'COMMON.DERIV'
7884 include 'COMMON.INTERACT'
7885 include 'COMMON.CONTACTS'
7886 include 'COMMON.TORSION'
7887 include 'COMMON.VAR'
7888 include 'COMMON.GEO'
7889 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7891 iti1 = itortyp(itype(i+1))
7892 if (j.lt.nres-1) then
7893 itj1 = itortyp(itype(j+1))
7898 dipi(iii,1)=Ub2(iii,i)
7899 dipderi(iii)=Ub2der(iii,i)
7900 dipi(iii,2)=b1(iii,i+1)
7901 dipj(iii,1)=Ub2(iii,j)
7902 dipderj(iii)=Ub2der(iii,j)
7903 dipj(iii,2)=b1(iii,j+1)
7907 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7910 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7917 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7921 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7926 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7927 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7929 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7931 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7933 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7938 C---------------------------------------------------------------------------
7939 subroutine calc_eello(i,j,k,l,jj,kk)
7941 C This subroutine computes matrices and vectors needed to calculate
7942 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7944 implicit real*8 (a-h,o-z)
7945 include 'DIMENSIONS'
7946 include 'COMMON.IOUNITS'
7947 include 'COMMON.CHAIN'
7948 include 'COMMON.DERIV'
7949 include 'COMMON.INTERACT'
7950 include 'COMMON.CONTACTS'
7951 include 'COMMON.TORSION'
7952 include 'COMMON.VAR'
7953 include 'COMMON.GEO'
7954 include 'COMMON.FFIELD'
7955 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7956 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7959 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7960 cd & ' jj=',jj,' kk=',kk
7961 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7962 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7963 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7966 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7967 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7970 call transpose2(aa1(1,1),aa1t(1,1))
7971 call transpose2(aa2(1,1),aa2t(1,1))
7974 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7975 & aa1tder(1,1,lll,kkk))
7976 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7977 & aa2tder(1,1,lll,kkk))
7981 C parallel orientation of the two CA-CA-CA frames.
7983 iti=itortyp(itype(i))
7987 itk1=itortyp(itype(k+1))
7988 itj=itortyp(itype(j))
7989 if (l.lt.nres-1) then
7990 itl1=itortyp(itype(l+1))
7994 C A1 kernel(j+1) A2T
7996 cd write (iout,'(3f10.5,5x,3f10.5)')
7997 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7999 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8000 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
8001 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8002 C Following matrices are needed only for 6-th order cumulants
8003 IF (wcorr6.gt.0.0d0) THEN
8004 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8005 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
8006 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8007 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8008 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
8009 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8010 & ADtEAderx(1,1,1,1,1,1))
8012 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8013 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
8014 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8015 & ADtEA1derx(1,1,1,1,1,1))
8017 C End 6-th order cumulants
8020 cd write (2,*) 'In calc_eello6'
8022 cd write (2,*) 'iii=',iii
8024 cd write (2,*) 'kkk=',kkk
8026 cd write (2,'(3(2f10.5),5x)')
8027 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8032 call transpose2(EUgder(1,1,k),auxmat(1,1))
8033 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8034 call transpose2(EUg(1,1,k),auxmat(1,1))
8035 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8036 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8040 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8041 & EAEAderx(1,1,lll,kkk,iii,1))
8045 C A1T kernel(i+1) A2
8046 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8047 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
8048 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8049 C Following matrices are needed only for 6-th order cumulants
8050 IF (wcorr6.gt.0.0d0) THEN
8051 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8052 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
8053 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8054 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8055 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
8056 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8057 & ADtEAderx(1,1,1,1,1,2))
8058 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8059 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
8060 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8061 & ADtEA1derx(1,1,1,1,1,2))
8063 C End 6-th order cumulants
8064 call transpose2(EUgder(1,1,l),auxmat(1,1))
8065 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
8066 call transpose2(EUg(1,1,l),auxmat(1,1))
8067 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8068 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8072 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8073 & EAEAderx(1,1,lll,kkk,iii,2))
8078 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8079 C They are needed only when the fifth- or the sixth-order cumulants are
8081 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
8082 call transpose2(AEA(1,1,1),auxmat(1,1))
8083 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8084 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8085 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8086 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8087 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8088 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8089 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8090 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8091 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8092 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8093 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8094 call transpose2(AEA(1,1,2),auxmat(1,1))
8095 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
8096 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
8097 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
8098 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8099 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
8100 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
8101 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
8102 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
8103 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
8104 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
8105 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
8106 C Calculate the Cartesian derivatives of the vectors.
8110 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8111 call matvec2(auxmat(1,1),b1(1,i),
8112 & AEAb1derx(1,lll,kkk,iii,1,1))
8113 call matvec2(auxmat(1,1),Ub2(1,i),
8114 & AEAb2derx(1,lll,kkk,iii,1,1))
8115 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8116 & AEAb1derx(1,lll,kkk,iii,2,1))
8117 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8118 & AEAb2derx(1,lll,kkk,iii,2,1))
8119 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8120 call matvec2(auxmat(1,1),b1(1,j),
8121 & AEAb1derx(1,lll,kkk,iii,1,2))
8122 call matvec2(auxmat(1,1),Ub2(1,j),
8123 & AEAb2derx(1,lll,kkk,iii,1,2))
8124 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8125 & AEAb1derx(1,lll,kkk,iii,2,2))
8126 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
8127 & AEAb2derx(1,lll,kkk,iii,2,2))
8134 C Antiparallel orientation of the two CA-CA-CA frames.
8136 iti=itortyp(itype(i))
8140 itk1=itortyp(itype(k+1))
8141 itl=itortyp(itype(l))
8142 itj=itortyp(itype(j))
8143 if (j.lt.nres-1) then
8144 itj1=itortyp(itype(j+1))
8148 C A2 kernel(j-1)T A1T
8149 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8150 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
8151 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8152 C Following matrices are needed only for 6-th order cumulants
8153 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8154 & j.eq.i+4 .and. l.eq.i+3)) THEN
8155 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8156 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
8157 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8158 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8159 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
8160 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8161 & ADtEAderx(1,1,1,1,1,1))
8162 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8163 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
8164 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8165 & ADtEA1derx(1,1,1,1,1,1))
8167 C End 6-th order cumulants
8168 call transpose2(EUgder(1,1,k),auxmat(1,1))
8169 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8170 call transpose2(EUg(1,1,k),auxmat(1,1))
8171 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8172 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8176 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8177 & EAEAderx(1,1,lll,kkk,iii,1))
8181 C A2T kernel(i+1)T A1
8182 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8183 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
8184 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8185 C Following matrices are needed only for 6-th order cumulants
8186 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8187 & j.eq.i+4 .and. l.eq.i+3)) THEN
8188 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8189 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
8190 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8191 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8192 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
8193 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8194 & ADtEAderx(1,1,1,1,1,2))
8195 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8196 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
8197 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8198 & ADtEA1derx(1,1,1,1,1,2))
8200 C End 6-th order cumulants
8201 call transpose2(EUgder(1,1,j),auxmat(1,1))
8202 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
8203 call transpose2(EUg(1,1,j),auxmat(1,1))
8204 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8205 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8209 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8210 & EAEAderx(1,1,lll,kkk,iii,2))
8215 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8216 C They are needed only when the fifth- or the sixth-order cumulants are
8218 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
8219 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8220 call transpose2(AEA(1,1,1),auxmat(1,1))
8221 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8222 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8223 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8224 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8225 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8226 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8227 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8228 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8229 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8230 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8231 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8232 call transpose2(AEA(1,1,2),auxmat(1,1))
8233 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
8234 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8235 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8236 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8237 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
8238 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8239 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
8240 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
8241 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8242 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8243 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8244 C Calculate the Cartesian derivatives of the vectors.
8248 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8249 call matvec2(auxmat(1,1),b1(1,i),
8250 & AEAb1derx(1,lll,kkk,iii,1,1))
8251 call matvec2(auxmat(1,1),Ub2(1,i),
8252 & AEAb2derx(1,lll,kkk,iii,1,1))
8253 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8254 & AEAb1derx(1,lll,kkk,iii,2,1))
8255 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8256 & AEAb2derx(1,lll,kkk,iii,2,1))
8257 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8258 call matvec2(auxmat(1,1),b1(1,l),
8259 & AEAb1derx(1,lll,kkk,iii,1,2))
8260 call matvec2(auxmat(1,1),Ub2(1,l),
8261 & AEAb2derx(1,lll,kkk,iii,1,2))
8262 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
8263 & AEAb1derx(1,lll,kkk,iii,2,2))
8264 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
8265 & AEAb2derx(1,lll,kkk,iii,2,2))
8274 C---------------------------------------------------------------------------
8275 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
8276 & KK,KKderg,AKA,AKAderg,AKAderx)
8280 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
8281 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
8282 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
8287 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8289 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
8292 cd if (lprn) write (2,*) 'In kernel'
8294 cd if (lprn) write (2,*) 'kkk=',kkk
8296 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
8297 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8299 cd write (2,*) 'lll=',lll
8300 cd write (2,*) 'iii=1'
8302 cd write (2,'(3(2f10.5),5x)')
8303 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8306 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
8307 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8309 cd write (2,*) 'lll=',lll
8310 cd write (2,*) 'iii=2'
8312 cd write (2,'(3(2f10.5),5x)')
8313 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8320 C---------------------------------------------------------------------------
8321 double precision function eello4(i,j,k,l,jj,kk)
8322 implicit real*8 (a-h,o-z)
8323 include 'DIMENSIONS'
8324 include 'COMMON.IOUNITS'
8325 include 'COMMON.CHAIN'
8326 include 'COMMON.DERIV'
8327 include 'COMMON.INTERACT'
8328 include 'COMMON.CONTACTS'
8329 include 'COMMON.TORSION'
8330 include 'COMMON.VAR'
8331 include 'COMMON.GEO'
8332 double precision pizda(2,2),ggg1(3),ggg2(3)
8333 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8337 cd print *,'eello4:',i,j,k,l,jj,kk
8338 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
8339 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
8340 cold eij=facont_hb(jj,i)
8341 cold ekl=facont_hb(kk,k)
8343 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8344 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8345 gcorr_loc(k-1)=gcorr_loc(k-1)
8346 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8348 gcorr_loc(l-1)=gcorr_loc(l-1)
8349 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8351 gcorr_loc(j-1)=gcorr_loc(j-1)
8352 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8357 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
8358 & -EAEAderx(2,2,lll,kkk,iii,1)
8359 cd derx(lll,kkk,iii)=0.0d0
8363 cd gcorr_loc(l-1)=0.0d0
8364 cd gcorr_loc(j-1)=0.0d0
8365 cd gcorr_loc(k-1)=0.0d0
8367 cd write (iout,*)'Contacts have occurred for peptide groups',
8368 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
8369 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8370 if (j.lt.nres-1) then
8377 if (l.lt.nres-1) then
8385 cgrad ggg1(ll)=eel4*g_contij(ll,1)
8386 cgrad ggg2(ll)=eel4*g_contij(ll,2)
8387 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8388 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8389 cgrad ghalf=0.5d0*ggg1(ll)
8390 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8391 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8392 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8393 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8394 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8395 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8396 cgrad ghalf=0.5d0*ggg2(ll)
8397 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8398 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8399 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8400 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8401 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8402 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8406 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8411 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8416 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8421 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8425 cd write (2,*) iii,gcorr_loc(iii)
8428 cd write (2,*) 'ekont',ekont
8429 cd write (iout,*) 'eello4',ekont*eel4
8432 C---------------------------------------------------------------------------
8433 double precision function eello5(i,j,k,l,jj,kk)
8434 implicit real*8 (a-h,o-z)
8435 include 'DIMENSIONS'
8436 include 'COMMON.IOUNITS'
8437 include 'COMMON.CHAIN'
8438 include 'COMMON.DERIV'
8439 include 'COMMON.INTERACT'
8440 include 'COMMON.CONTACTS'
8441 include 'COMMON.TORSION'
8442 include 'COMMON.VAR'
8443 include 'COMMON.GEO'
8444 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
8445 double precision ggg1(3),ggg2(3)
8446 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8451 C /l\ / \ \ / \ / \ / C
8452 C / \ / \ \ / \ / \ / C
8453 C j| o |l1 | o | o| o | | o |o C
8454 C \ |/k\| |/ \| / |/ \| |/ \| C
8455 C \i/ \ / \ / / \ / \ C
8457 C (I) (II) (III) (IV) C
8459 C eello5_1 eello5_2 eello5_3 eello5_4 C
8461 C Antiparallel chains C
8464 C /j\ / \ \ / \ / \ / C
8465 C / \ / \ \ / \ / \ / C
8466 C j1| o |l | o | o| o | | o |o C
8467 C \ |/k\| |/ \| / |/ \| |/ \| C
8468 C \i/ \ / \ / / \ / \ C
8470 C (I) (II) (III) (IV) C
8472 C eello5_1 eello5_2 eello5_3 eello5_4 C
8474 C o denotes a local interaction, vertical lines an electrostatic interaction. C
8476 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8477 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8482 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8484 itk=itortyp(itype(k))
8485 itl=itortyp(itype(l))
8486 itj=itortyp(itype(j))
8491 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8492 cd & eel5_3_num,eel5_4_num)
8496 derx(lll,kkk,iii)=0.0d0
8500 cd eij=facont_hb(jj,i)
8501 cd ekl=facont_hb(kk,k)
8503 cd write (iout,*)'Contacts have occurred for peptide groups',
8504 cd & i,j,' fcont:',eij,' eij',' and ',k,l
8506 C Contribution from the graph I.
8507 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8508 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8509 call transpose2(EUg(1,1,k),auxmat(1,1))
8510 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8511 vv(1)=pizda(1,1)-pizda(2,2)
8512 vv(2)=pizda(1,2)+pizda(2,1)
8513 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
8514 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8515 C Explicit gradient in virtual-dihedral angles.
8516 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
8517 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
8518 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8519 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8520 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8521 vv(1)=pizda(1,1)-pizda(2,2)
8522 vv(2)=pizda(1,2)+pizda(2,1)
8523 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8524 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
8525 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8526 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8527 vv(1)=pizda(1,1)-pizda(2,2)
8528 vv(2)=pizda(1,2)+pizda(2,1)
8530 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
8531 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8532 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8534 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
8535 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8536 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8538 C Cartesian gradient
8542 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
8544 vv(1)=pizda(1,1)-pizda(2,2)
8545 vv(2)=pizda(1,2)+pizda(2,1)
8546 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8547 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
8548 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8554 C Contribution from graph II
8555 call transpose2(EE(1,1,itk),auxmat(1,1))
8556 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8557 vv(1)=pizda(1,1)+pizda(2,2)
8558 vv(2)=pizda(2,1)-pizda(1,2)
8559 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
8560 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8561 C Explicit gradient in virtual-dihedral angles.
8562 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8563 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8564 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8565 vv(1)=pizda(1,1)+pizda(2,2)
8566 vv(2)=pizda(2,1)-pizda(1,2)
8568 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8569 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8570 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8572 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8573 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8574 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8576 C Cartesian gradient
8580 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8582 vv(1)=pizda(1,1)+pizda(2,2)
8583 vv(2)=pizda(2,1)-pizda(1,2)
8584 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8585 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
8586 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8594 C Parallel orientation
8595 C Contribution from graph III
8596 call transpose2(EUg(1,1,l),auxmat(1,1))
8597 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8598 vv(1)=pizda(1,1)-pizda(2,2)
8599 vv(2)=pizda(1,2)+pizda(2,1)
8600 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
8601 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8602 C Explicit gradient in virtual-dihedral angles.
8603 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8604 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
8605 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8606 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8607 vv(1)=pizda(1,1)-pizda(2,2)
8608 vv(2)=pizda(1,2)+pizda(2,1)
8609 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8610 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8611 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8612 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8613 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8614 vv(1)=pizda(1,1)-pizda(2,2)
8615 vv(2)=pizda(1,2)+pizda(2,1)
8616 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8617 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8618 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8619 C Cartesian gradient
8623 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8625 vv(1)=pizda(1,1)-pizda(2,2)
8626 vv(2)=pizda(1,2)+pizda(2,1)
8627 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8628 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8629 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8634 C Contribution from graph IV
8636 call transpose2(EE(1,1,itl),auxmat(1,1))
8637 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8638 vv(1)=pizda(1,1)+pizda(2,2)
8639 vv(2)=pizda(2,1)-pizda(1,2)
8640 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
8641 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8642 C Explicit gradient in virtual-dihedral angles.
8643 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8644 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8645 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8646 vv(1)=pizda(1,1)+pizda(2,2)
8647 vv(2)=pizda(2,1)-pizda(1,2)
8648 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8649 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
8650 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8651 C Cartesian gradient
8655 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8657 vv(1)=pizda(1,1)+pizda(2,2)
8658 vv(2)=pizda(2,1)-pizda(1,2)
8659 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8660 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
8661 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8666 C Antiparallel orientation
8667 C Contribution from graph III
8669 call transpose2(EUg(1,1,j),auxmat(1,1))
8670 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8671 vv(1)=pizda(1,1)-pizda(2,2)
8672 vv(2)=pizda(1,2)+pizda(2,1)
8673 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8674 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8675 C Explicit gradient in virtual-dihedral angles.
8676 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8677 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8678 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8679 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8680 vv(1)=pizda(1,1)-pizda(2,2)
8681 vv(2)=pizda(1,2)+pizda(2,1)
8682 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8683 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
8684 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8685 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8686 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8687 vv(1)=pizda(1,1)-pizda(2,2)
8688 vv(2)=pizda(1,2)+pizda(2,1)
8689 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8690 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
8691 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8692 C Cartesian gradient
8696 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8698 vv(1)=pizda(1,1)-pizda(2,2)
8699 vv(2)=pizda(1,2)+pizda(2,1)
8700 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8701 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8702 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8707 C Contribution from graph IV
8709 call transpose2(EE(1,1,itj),auxmat(1,1))
8710 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8711 vv(1)=pizda(1,1)+pizda(2,2)
8712 vv(2)=pizda(2,1)-pizda(1,2)
8713 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
8714 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8715 C Explicit gradient in virtual-dihedral angles.
8716 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8717 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8718 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8719 vv(1)=pizda(1,1)+pizda(2,2)
8720 vv(2)=pizda(2,1)-pizda(1,2)
8721 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8722 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
8723 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8724 C Cartesian gradient
8728 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8730 vv(1)=pizda(1,1)+pizda(2,2)
8731 vv(2)=pizda(2,1)-pizda(1,2)
8732 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8733 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
8734 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8740 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8741 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8742 cd write (2,*) 'ijkl',i,j,k,l
8743 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8744 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8746 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8747 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8748 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8749 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8750 if (j.lt.nres-1) then
8757 if (l.lt.nres-1) then
8767 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8768 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8769 C summed up outside the subrouine as for the other subroutines
8770 C handling long-range interactions. The old code is commented out
8771 C with "cgrad" to keep track of changes.
8773 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8774 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8775 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8776 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8777 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8778 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8779 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8780 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8781 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8782 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8784 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8785 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8786 cgrad ghalf=0.5d0*ggg1(ll)
8788 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8789 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8790 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8791 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8792 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8793 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8794 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8795 cgrad ghalf=0.5d0*ggg2(ll)
8797 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8798 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8799 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8800 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8801 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8802 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8807 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8808 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8813 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8814 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8820 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8825 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8829 cd write (2,*) iii,g_corr5_loc(iii)
8832 cd write (2,*) 'ekont',ekont
8833 cd write (iout,*) 'eello5',ekont*eel5
8836 c--------------------------------------------------------------------------
8837 double precision function eello6(i,j,k,l,jj,kk)
8838 implicit real*8 (a-h,o-z)
8839 include 'DIMENSIONS'
8840 include 'COMMON.IOUNITS'
8841 include 'COMMON.CHAIN'
8842 include 'COMMON.DERIV'
8843 include 'COMMON.INTERACT'
8844 include 'COMMON.CONTACTS'
8845 include 'COMMON.TORSION'
8846 include 'COMMON.VAR'
8847 include 'COMMON.GEO'
8848 include 'COMMON.FFIELD'
8849 double precision ggg1(3),ggg2(3)
8850 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8855 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8863 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8864 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8868 derx(lll,kkk,iii)=0.0d0
8872 cd eij=facont_hb(jj,i)
8873 cd ekl=facont_hb(kk,k)
8879 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8880 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8881 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8882 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8883 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8884 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8886 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8887 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8888 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8889 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8890 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8891 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8895 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8897 C If turn contributions are considered, they will be handled separately.
8898 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8899 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8900 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8901 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8902 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8903 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8904 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8906 if (j.lt.nres-1) then
8913 if (l.lt.nres-1) then
8921 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8922 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8923 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8924 cgrad ghalf=0.5d0*ggg1(ll)
8926 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8927 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8928 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8929 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8930 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8931 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8932 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8933 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8934 cgrad ghalf=0.5d0*ggg2(ll)
8935 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8937 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8938 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8939 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8940 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8941 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8942 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8947 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8948 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8953 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8954 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8960 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8965 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8969 cd write (2,*) iii,g_corr6_loc(iii)
8972 cd write (2,*) 'ekont',ekont
8973 cd write (iout,*) 'eello6',ekont*eel6
8976 c--------------------------------------------------------------------------
8977 double precision function eello6_graph1(i,j,k,l,imat,swap)
8978 implicit real*8 (a-h,o-z)
8979 include 'DIMENSIONS'
8980 include 'COMMON.IOUNITS'
8981 include 'COMMON.CHAIN'
8982 include 'COMMON.DERIV'
8983 include 'COMMON.INTERACT'
8984 include 'COMMON.CONTACTS'
8985 include 'COMMON.TORSION'
8986 include 'COMMON.VAR'
8987 include 'COMMON.GEO'
8988 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8992 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8994 C Parallel Antiparallel C
9000 C \ j|/k\| / \ |/k\|l / C
9005 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9006 itk=itortyp(itype(k))
9007 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
9008 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
9009 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
9010 call transpose2(EUgC(1,1,k),auxmat(1,1))
9011 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9012 vv1(1)=pizda1(1,1)-pizda1(2,2)
9013 vv1(2)=pizda1(1,2)+pizda1(2,1)
9014 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9015 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
9016 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
9017 s5=scalar2(vv(1),Dtobr2(1,i))
9018 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
9019 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
9020 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
9021 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
9022 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
9023 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
9024 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
9025 & +scalar2(vv(1),Dtobr2der(1,i)))
9026 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
9027 vv1(1)=pizda1(1,1)-pizda1(2,2)
9028 vv1(2)=pizda1(1,2)+pizda1(2,1)
9029 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
9030 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
9032 g_corr6_loc(l-1)=g_corr6_loc(l-1)
9033 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9034 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9035 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9036 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9038 g_corr6_loc(j-1)=g_corr6_loc(j-1)
9039 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9040 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9041 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9042 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9044 call transpose2(EUgCder(1,1,k),auxmat(1,1))
9045 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9046 vv1(1)=pizda1(1,1)-pizda1(2,2)
9047 vv1(2)=pizda1(1,2)+pizda1(2,1)
9048 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
9049 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
9050 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
9051 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
9060 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
9061 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
9062 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
9063 call transpose2(EUgC(1,1,k),auxmat(1,1))
9064 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9066 vv1(1)=pizda1(1,1)-pizda1(2,2)
9067 vv1(2)=pizda1(1,2)+pizda1(2,1)
9068 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9069 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
9070 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
9071 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
9072 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
9073 s5=scalar2(vv(1),Dtobr2(1,i))
9074 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
9080 c----------------------------------------------------------------------------
9081 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
9082 implicit real*8 (a-h,o-z)
9083 include 'DIMENSIONS'
9084 include 'COMMON.IOUNITS'
9085 include 'COMMON.CHAIN'
9086 include 'COMMON.DERIV'
9087 include 'COMMON.INTERACT'
9088 include 'COMMON.CONTACTS'
9089 include 'COMMON.TORSION'
9090 include 'COMMON.VAR'
9091 include 'COMMON.GEO'
9093 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9094 & auxvec1(2),auxvec2(2),auxmat1(2,2)
9097 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9099 C Parallel Antiparallel C
9105 C \ j|/k\| \ |/k\|l C
9110 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9111 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
9112 C AL 7/4/01 s1 would occur in the sixth-order moment,
9113 C but not in a cluster cumulant
9115 s1=dip(1,jj,i)*dip(1,kk,k)
9117 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
9118 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9119 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
9120 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
9121 call transpose2(EUg(1,1,k),auxmat(1,1))
9122 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
9123 vv(1)=pizda(1,1)-pizda(2,2)
9124 vv(2)=pizda(1,2)+pizda(2,1)
9125 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9126 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9128 eello6_graph2=-(s1+s2+s3+s4)
9130 eello6_graph2=-(s2+s3+s4)
9133 C Derivatives in gamma(i-1)
9136 s1=dipderg(1,jj,i)*dip(1,kk,k)
9138 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9139 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
9140 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9141 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9143 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9145 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9147 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
9149 C Derivatives in gamma(k-1)
9151 s1=dip(1,jj,i)*dipderg(1,kk,k)
9153 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
9154 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9155 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
9156 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9157 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9158 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
9159 vv(1)=pizda(1,1)-pizda(2,2)
9160 vv(2)=pizda(1,2)+pizda(2,1)
9161 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9163 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9165 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9167 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
9168 C Derivatives in gamma(j-1) or gamma(l-1)
9171 s1=dipderg(3,jj,i)*dip(1,kk,k)
9173 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
9174 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9175 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
9176 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
9177 vv(1)=pizda(1,1)-pizda(2,2)
9178 vv(2)=pizda(1,2)+pizda(2,1)
9179 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9182 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9184 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9187 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
9188 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
9190 C Derivatives in gamma(l-1) or gamma(j-1)
9193 s1=dip(1,jj,i)*dipderg(3,kk,k)
9195 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
9196 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9197 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
9198 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9199 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
9200 vv(1)=pizda(1,1)-pizda(2,2)
9201 vv(2)=pizda(1,2)+pizda(2,1)
9202 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9205 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9207 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9210 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
9211 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
9213 C Cartesian derivatives.
9215 write (2,*) 'In eello6_graph2'
9217 write (2,*) 'iii=',iii
9219 write (2,*) 'kkk=',kkk
9221 write (2,'(3(2f10.5),5x)')
9222 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9232 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9234 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9237 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
9239 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9240 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
9242 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9243 call transpose2(EUg(1,1,k),auxmat(1,1))
9244 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
9246 vv(1)=pizda(1,1)-pizda(2,2)
9247 vv(2)=pizda(1,2)+pizda(2,1)
9248 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9249 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9251 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9253 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9256 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9258 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9265 c----------------------------------------------------------------------------
9266 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
9267 implicit real*8 (a-h,o-z)
9268 include 'DIMENSIONS'
9269 include 'COMMON.IOUNITS'
9270 include 'COMMON.CHAIN'
9271 include 'COMMON.DERIV'
9272 include 'COMMON.INTERACT'
9273 include 'COMMON.CONTACTS'
9274 include 'COMMON.TORSION'
9275 include 'COMMON.VAR'
9276 include 'COMMON.GEO'
9277 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
9279 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9281 C Parallel Antiparallel C
9287 C j|/k\| / |/k\|l / C
9292 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9294 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9295 C energy moment and not to the cluster cumulant.
9296 iti=itortyp(itype(i))
9297 if (j.lt.nres-1) then
9298 itj1=itortyp(itype(j+1))
9302 itk=itortyp(itype(k))
9303 itk1=itortyp(itype(k+1))
9304 if (l.lt.nres-1) then
9305 itl1=itortyp(itype(l+1))
9310 s1=dip(4,jj,i)*dip(4,kk,k)
9312 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
9313 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9314 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
9315 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9316 call transpose2(EE(1,1,itk),auxmat(1,1))
9317 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9318 vv(1)=pizda(1,1)+pizda(2,2)
9319 vv(2)=pizda(2,1)-pizda(1,2)
9320 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9321 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9322 cd & "sum",-(s2+s3+s4)
9324 eello6_graph3=-(s1+s2+s3+s4)
9326 eello6_graph3=-(s2+s3+s4)
9329 C Derivatives in gamma(k-1)
9330 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
9331 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9332 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9333 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9334 C Derivatives in gamma(l-1)
9335 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
9336 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9337 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9338 vv(1)=pizda(1,1)+pizda(2,2)
9339 vv(2)=pizda(2,1)-pizda(1,2)
9340 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9341 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9342 C Cartesian derivatives.
9348 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9350 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9353 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9355 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9356 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
9358 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9359 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
9361 vv(1)=pizda(1,1)+pizda(2,2)
9362 vv(2)=pizda(2,1)-pizda(1,2)
9363 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9365 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9367 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9370 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9372 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9374 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9380 c----------------------------------------------------------------------------
9381 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9382 implicit real*8 (a-h,o-z)
9383 include 'DIMENSIONS'
9384 include 'COMMON.IOUNITS'
9385 include 'COMMON.CHAIN'
9386 include 'COMMON.DERIV'
9387 include 'COMMON.INTERACT'
9388 include 'COMMON.CONTACTS'
9389 include 'COMMON.TORSION'
9390 include 'COMMON.VAR'
9391 include 'COMMON.GEO'
9392 include 'COMMON.FFIELD'
9393 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9394 & auxvec1(2),auxmat1(2,2)
9396 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9398 C Parallel Antiparallel C
9404 C \ j|/k\| \ |/k\|l C
9409 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9411 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9412 C energy moment and not to the cluster cumulant.
9413 cd write (2,*) 'eello_graph4: wturn6',wturn6
9414 iti=itortyp(itype(i))
9415 itj=itortyp(itype(j))
9416 if (j.lt.nres-1) then
9417 itj1=itortyp(itype(j+1))
9421 itk=itortyp(itype(k))
9422 if (k.lt.nres-1) then
9423 itk1=itortyp(itype(k+1))
9427 itl=itortyp(itype(l))
9428 if (l.lt.nres-1) then
9429 itl1=itortyp(itype(l+1))
9433 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9434 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9435 cd & ' itl',itl,' itl1',itl1
9438 s1=dip(3,jj,i)*dip(3,kk,k)
9440 s1=dip(2,jj,j)*dip(2,kk,l)
9443 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9444 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9446 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
9447 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9449 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
9450 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9452 call transpose2(EUg(1,1,k),auxmat(1,1))
9453 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9454 vv(1)=pizda(1,1)-pizda(2,2)
9455 vv(2)=pizda(2,1)+pizda(1,2)
9456 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9457 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9459 eello6_graph4=-(s1+s2+s3+s4)
9461 eello6_graph4=-(s2+s3+s4)
9463 C Derivatives in gamma(i-1)
9467 s1=dipderg(2,jj,i)*dip(3,kk,k)
9469 s1=dipderg(4,jj,j)*dip(2,kk,l)
9472 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9474 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
9475 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9477 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
9478 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9480 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9481 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9482 cd write (2,*) 'turn6 derivatives'
9484 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9486 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9490 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9492 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9496 C Derivatives in gamma(k-1)
9499 s1=dip(3,jj,i)*dipderg(2,kk,k)
9501 s1=dip(2,jj,j)*dipderg(4,kk,l)
9504 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9505 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9507 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
9508 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9510 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
9511 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9513 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9514 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9515 vv(1)=pizda(1,1)-pizda(2,2)
9516 vv(2)=pizda(2,1)+pizda(1,2)
9517 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9518 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9520 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9522 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9526 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9528 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9531 C Derivatives in gamma(j-1) or gamma(l-1)
9532 if (l.eq.j+1 .and. l.gt.1) then
9533 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9534 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9535 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9536 vv(1)=pizda(1,1)-pizda(2,2)
9537 vv(2)=pizda(2,1)+pizda(1,2)
9538 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9539 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9540 else if (j.gt.1) then
9541 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9542 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9543 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9544 vv(1)=pizda(1,1)-pizda(2,2)
9545 vv(2)=pizda(2,1)+pizda(1,2)
9546 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9547 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9548 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9550 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9553 C Cartesian derivatives.
9560 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9562 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9566 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9568 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9572 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
9574 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9576 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9577 & b1(1,j+1),auxvec(1))
9578 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
9580 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9581 & b1(1,l+1),auxvec(1))
9582 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
9584 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9586 vv(1)=pizda(1,1)-pizda(2,2)
9587 vv(2)=pizda(2,1)+pizda(1,2)
9588 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9590 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9592 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9595 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9598 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9601 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9603 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9605 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9609 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9611 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9614 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9616 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9624 c----------------------------------------------------------------------------
9625 double precision function eello_turn6(i,jj,kk)
9626 implicit real*8 (a-h,o-z)
9627 include 'DIMENSIONS'
9628 include 'COMMON.IOUNITS'
9629 include 'COMMON.CHAIN'
9630 include 'COMMON.DERIV'
9631 include 'COMMON.INTERACT'
9632 include 'COMMON.CONTACTS'
9633 include 'COMMON.TORSION'
9634 include 'COMMON.VAR'
9635 include 'COMMON.GEO'
9636 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9637 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9639 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9640 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9641 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9642 C the respective energy moment and not to the cluster cumulant.
9651 iti=itortyp(itype(i))
9652 itk=itortyp(itype(k))
9653 itk1=itortyp(itype(k+1))
9654 itl=itortyp(itype(l))
9655 itj=itortyp(itype(j))
9656 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9657 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9658 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9663 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9665 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
9669 derx_turn(lll,kkk,iii)=0.0d0
9676 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9678 cd write (2,*) 'eello6_5',eello6_5
9680 call transpose2(AEA(1,1,1),auxmat(1,1))
9681 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9682 ss1=scalar2(Ub2(1,i+2),b1(1,l))
9683 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9685 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
9686 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9687 s2 = scalar2(b1(1,k),vtemp1(1))
9689 call transpose2(AEA(1,1,2),atemp(1,1))
9690 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9691 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
9692 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9694 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9695 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9696 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9698 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9699 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9700 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9701 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9702 ss13 = scalar2(b1(1,k),vtemp4(1))
9703 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9705 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9711 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9712 C Derivatives in gamma(i+2)
9716 call transpose2(AEA(1,1,1),auxmatd(1,1))
9717 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9718 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9719 call transpose2(AEAderg(1,1,2),atempd(1,1))
9720 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9721 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9723 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9724 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9725 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9731 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9732 C Derivatives in gamma(i+3)
9734 call transpose2(AEA(1,1,1),auxmatd(1,1))
9735 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9736 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
9737 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9739 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
9740 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9741 s2d = scalar2(b1(1,k),vtemp1d(1))
9743 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9744 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9746 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9748 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9749 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9750 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9758 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9759 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9761 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9762 & -0.5d0*ekont*(s2d+s12d)
9764 C Derivatives in gamma(i+4)
9765 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9766 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9767 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9769 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9770 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9771 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9779 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9781 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9783 C Derivatives in gamma(i+5)
9785 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9786 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9787 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9789 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
9790 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9791 s2d = scalar2(b1(1,k),vtemp1d(1))
9793 call transpose2(AEA(1,1,2),atempd(1,1))
9794 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9795 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9797 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9798 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9800 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9801 ss13d = scalar2(b1(1,k),vtemp4d(1))
9802 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9810 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9811 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9813 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9814 & -0.5d0*ekont*(s2d+s12d)
9816 C Cartesian derivatives
9821 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9822 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9823 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9825 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
9826 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9828 s2d = scalar2(b1(1,k),vtemp1d(1))
9830 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9831 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9832 s8d = -(atempd(1,1)+atempd(2,2))*
9833 & scalar2(cc(1,1,itl),vtemp2(1))
9835 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9837 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9838 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9845 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9848 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9852 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9853 & - 0.5d0*(s8d+s12d)
9855 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9864 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9866 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9867 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9868 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9869 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9870 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9872 ss13d = scalar2(b1(1,k),vtemp4d(1))
9873 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9874 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9878 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9879 cd & 16*eel_turn6_num
9881 if (j.lt.nres-1) then
9888 if (l.lt.nres-1) then
9896 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9897 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9898 cgrad ghalf=0.5d0*ggg1(ll)
9900 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9901 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9902 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9903 & +ekont*derx_turn(ll,2,1)
9904 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9905 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9906 & +ekont*derx_turn(ll,4,1)
9907 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9908 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9909 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9910 cgrad ghalf=0.5d0*ggg2(ll)
9912 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9913 & +ekont*derx_turn(ll,2,2)
9914 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9915 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9916 & +ekont*derx_turn(ll,4,2)
9917 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9918 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9919 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9924 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9929 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9935 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9940 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9944 cd write (2,*) iii,g_corr6_loc(iii)
9946 eello_turn6=ekont*eel_turn6
9947 cd write (2,*) 'ekont',ekont
9948 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9952 C-----------------------------------------------------------------------------
9953 double precision function scalar(u,v)
9954 !DIR$ INLINEALWAYS scalar
9956 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9959 double precision u(3),v(3)
9960 cd double precision sc
9968 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9971 crc-------------------------------------------------
9972 SUBROUTINE MATVEC2(A1,V1,V2)
9973 !DIR$ INLINEALWAYS MATVEC2
9975 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9977 implicit real*8 (a-h,o-z)
9978 include 'DIMENSIONS'
9979 DIMENSION A1(2,2),V1(2),V2(2)
9983 c 3 VI=VI+A1(I,K)*V1(K)
9987 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9988 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9993 C---------------------------------------
9994 SUBROUTINE MATMAT2(A1,A2,A3)
9996 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9998 implicit real*8 (a-h,o-z)
9999 include 'DIMENSIONS'
10000 DIMENSION A1(2,2),A2(2,2),A3(2,2)
10001 c DIMENSION AI3(2,2)
10005 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
10011 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
10012 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
10013 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
10014 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
10022 c-------------------------------------------------------------------------
10023 double precision function scalar2(u,v)
10024 !DIR$ INLINEALWAYS scalar2
10026 double precision u(2),v(2)
10027 double precision sc
10029 scalar2=u(1)*v(1)+u(2)*v(2)
10033 C-----------------------------------------------------------------------------
10035 subroutine transpose2(a,at)
10036 !DIR$ INLINEALWAYS transpose2
10038 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
10041 double precision a(2,2),at(2,2)
10048 c--------------------------------------------------------------------------
10049 subroutine transpose(n,a,at)
10052 double precision a(n,n),at(n,n)
10060 C---------------------------------------------------------------------------
10061 subroutine prodmat3(a1,a2,kk,transp,prod)
10062 !DIR$ INLINEALWAYS prodmat3
10064 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
10068 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
10070 crc double precision auxmat(2,2),prod_(2,2)
10073 crc call transpose2(kk(1,1),auxmat(1,1))
10074 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
10075 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10077 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
10078 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
10079 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
10080 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
10081 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
10082 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
10083 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
10084 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
10087 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
10088 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10090 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
10091 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
10092 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
10093 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
10094 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
10095 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
10096 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
10097 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
10100 c call transpose2(a2(1,1),a2t(1,1))
10103 crc print *,((prod_(i,j),i=1,2),j=1,2)
10104 crc print *,((prod(i,j),i=1,2),j=1,2)
10108 CCC----------------------------------------------
10109 subroutine Eliptransfer(eliptran)
10110 implicit real*8 (a-h,o-z)
10111 include 'DIMENSIONS'
10112 include 'COMMON.GEO'
10113 include 'COMMON.VAR'
10114 include 'COMMON.LOCAL'
10115 include 'COMMON.CHAIN'
10116 include 'COMMON.DERIV'
10117 include 'COMMON.NAMES'
10118 include 'COMMON.INTERACT'
10119 include 'COMMON.IOUNITS'
10120 include 'COMMON.CALC'
10121 include 'COMMON.CONTROL'
10122 include 'COMMON.SPLITELE'
10123 include 'COMMON.SBRIDGE'
10124 C this is done by Adasko
10125 C print *,"wchodze"
10126 C structure of box:
10128 C--bordliptop-- buffore starts
10129 C--bufliptop--- here true lipid starts
10131 C--buflipbot--- lipid ends buffore starts
10132 C--bordlipbot--buffore ends
10134 do i=ilip_start,ilip_end
10136 if (itype(i).eq.ntyp1) cycle
10138 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
10139 if (positi.le.0) positi=positi+boxzsize
10141 C first for peptide groups
10142 c for each residue check if it is in lipid or lipid water border area
10143 if ((positi.gt.bordlipbot)
10144 &.and.(positi.lt.bordliptop)) then
10145 C the energy transfer exist
10146 if (positi.lt.buflipbot) then
10147 C what fraction I am in
10149 & ((positi-bordlipbot)/lipbufthick)
10150 C lipbufthick is thickenes of lipid buffore
10151 sslip=sscalelip(fracinbuf)
10152 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
10153 eliptran=eliptran+sslip*pepliptran
10154 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10155 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10156 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10158 C print *,"doing sccale for lower part"
10159 C print *,i,sslip,fracinbuf,ssgradlip
10160 elseif (positi.gt.bufliptop) then
10161 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
10162 sslip=sscalelip(fracinbuf)
10163 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
10164 eliptran=eliptran+sslip*pepliptran
10165 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10166 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10167 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10168 C print *, "doing sscalefor top part"
10169 C print *,i,sslip,fracinbuf,ssgradlip
10171 eliptran=eliptran+pepliptran
10172 C print *,"I am in true lipid"
10175 C eliptran=elpitran+0.0 ! I am in water
10178 C print *, "nic nie bylo w lipidzie?"
10179 C now multiply all by the peptide group transfer factor
10180 C eliptran=eliptran*pepliptran
10181 C now the same for side chains
10183 do i=ilip_start,ilip_end
10184 if (itype(i).eq.ntyp1) cycle
10185 positi=(mod(c(3,i+nres),boxzsize))
10186 if (positi.le.0) positi=positi+boxzsize
10187 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
10188 c for each residue check if it is in lipid or lipid water border area
10189 C respos=mod(c(3,i+nres),boxzsize)
10190 C print *,positi,bordlipbot,buflipbot
10191 if ((positi.gt.bordlipbot)
10192 & .and.(positi.lt.bordliptop)) then
10193 C the energy transfer exist
10194 if (positi.lt.buflipbot) then
10196 & ((positi-bordlipbot)/lipbufthick)
10197 C lipbufthick is thickenes of lipid buffore
10198 sslip=sscalelip(fracinbuf)
10199 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
10200 eliptran=eliptran+sslip*liptranene(itype(i))
10201 gliptranx(3,i)=gliptranx(3,i)
10202 &+ssgradlip*liptranene(itype(i))
10203 gliptranc(3,i-1)= gliptranc(3,i-1)
10204 &+ssgradlip*liptranene(itype(i))
10205 C print *,"doing sccale for lower part"
10206 elseif (positi.gt.bufliptop) then
10208 &((bordliptop-positi)/lipbufthick)
10209 sslip=sscalelip(fracinbuf)
10210 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
10211 eliptran=eliptran+sslip*liptranene(itype(i))
10212 gliptranx(3,i)=gliptranx(3,i)
10213 &+ssgradlip*liptranene(itype(i))
10214 gliptranc(3,i-1)= gliptranc(3,i-1)
10215 &+ssgradlip*liptranene(itype(i))
10216 C print *, "doing sscalefor top part",sslip,fracinbuf
10218 eliptran=eliptran+liptranene(itype(i))
10219 C print *,"I am in true lipid"
10221 endif ! if in lipid or buffor
10223 C eliptran=elpitran+0.0 ! I am in water