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 (zi.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 & ((positi-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-positi)/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 & ((positi-bordlipbot)/lipbufthick)
1897 C lipbufthick is thickenes of lipid buffore
1898 sslipj=sscalelip(fracinbuf)
1899 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1900 elseif (zi.gt.bufliptop) then
1901 fracinbuf=1.0d0-((bordliptop-positi)/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)
2704 do i=ivec_start+2,ivec_end+2
2709 if (i .lt. nres+1) then
2746 if (i .gt. 3 .and. i .lt. nres+1) then
2747 obrot_der(1,i-2)=-sin1
2748 obrot_der(2,i-2)= cos1
2749 Ugder(1,1,i-2)= sin1
2750 Ugder(1,2,i-2)=-cos1
2751 Ugder(2,1,i-2)=-cos1
2752 Ugder(2,2,i-2)=-sin1
2755 obrot2_der(1,i-2)=-dwasin2
2756 obrot2_der(2,i-2)= dwacos2
2757 Ug2der(1,1,i-2)= dwasin2
2758 Ug2der(1,2,i-2)=-dwacos2
2759 Ug2der(2,1,i-2)=-dwacos2
2760 Ug2der(2,2,i-2)=-dwasin2
2762 obrot_der(1,i-2)=0.0d0
2763 obrot_der(2,i-2)=0.0d0
2764 Ugder(1,1,i-2)=0.0d0
2765 Ugder(1,2,i-2)=0.0d0
2766 Ugder(2,1,i-2)=0.0d0
2767 Ugder(2,2,i-2)=0.0d0
2768 obrot2_der(1,i-2)=0.0d0
2769 obrot2_der(2,i-2)=0.0d0
2770 Ug2der(1,1,i-2)=0.0d0
2771 Ug2der(1,2,i-2)=0.0d0
2772 Ug2der(2,1,i-2)=0.0d0
2773 Ug2der(2,2,i-2)=0.0d0
2775 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2776 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2777 iti = itortyp(itype(i-2))
2781 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2782 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2783 iti1 = itortyp(itype(i-1))
2787 cd write (iout,*) '*******i',i,' iti1',iti
2788 cd write (iout,*) 'b1',b1(:,iti)
2789 cd write (iout,*) 'b2',b2(:,iti)
2790 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2791 c if (i .gt. iatel_s+2) then
2792 if (i .gt. nnt+2) then
2793 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
2795 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
2796 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
2798 c write(iout,*) "co jest kurwa", iti, EE(1,1,iti),EE(2,1,iti),
2799 c & EE(1,2,iti),EE(2,2,iti)
2800 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
2801 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
2802 c write(iout,*) "Macierz EUG",
2803 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
2805 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2807 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2808 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2809 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2810 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2811 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2822 DtUg2(l,k,i-2)=0.0d0
2826 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
2827 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
2829 muder(k,i-2)=Ub2der(k,i-2)
2831 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2832 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2833 if (itype(i-1).le.ntyp) then
2834 iti1 = itortyp(itype(i-1))
2842 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
2844 c write (iout,*) 'mu ',mu(:,i-2),i-2
2845 cd write (iout,*) 'mu1',mu1(:,i-2)
2846 cd write (iout,*) 'mu2',mu2(:,i-2)
2847 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2849 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2850 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2851 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2852 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2853 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2854 C Vectors and matrices dependent on a single virtual-bond dihedral.
2855 call matvec2(DD(1,1,iti),b1tilde(1,i-1),auxvec(1))
2856 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2857 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2858 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2859 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2860 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2861 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2862 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2863 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2866 C Matrices dependent on two consecutive virtual-bond dihedrals.
2867 C The order of matrices is from left to right.
2868 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2870 c do i=max0(ivec_start,2),ivec_end
2872 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2873 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2874 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2875 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2876 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2877 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2878 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2879 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2882 #if defined(MPI) && defined(PARMAT)
2884 c if (fg_rank.eq.0) then
2885 write (iout,*) "Arrays UG and UGDER before GATHER"
2887 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2888 & ((ug(l,k,i),l=1,2),k=1,2),
2889 & ((ugder(l,k,i),l=1,2),k=1,2)
2891 write (iout,*) "Arrays UG2 and UG2DER"
2893 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2894 & ((ug2(l,k,i),l=1,2),k=1,2),
2895 & ((ug2der(l,k,i),l=1,2),k=1,2)
2897 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2899 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2900 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2901 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2903 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2905 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2906 & costab(i),sintab(i),costab2(i),sintab2(i)
2908 write (iout,*) "Array MUDER"
2910 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2914 if (nfgtasks.gt.1) then
2916 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2917 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2918 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2920 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2921 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2923 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2924 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2926 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2927 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2929 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2930 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2932 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2933 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2935 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2936 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2938 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2939 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2940 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2941 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2942 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2943 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2944 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2945 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2946 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2947 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2948 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2949 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2950 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2952 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2953 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2955 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2956 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2958 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2959 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2961 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
2962 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2964 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
2965 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2967 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
2968 & ivec_count(fg_rank1),
2969 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2971 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
2972 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2974 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
2975 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2977 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
2978 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2980 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
2981 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2983 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
2984 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2986 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
2987 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2989 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
2990 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2992 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
2993 & ivec_count(fg_rank1),
2994 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2996 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
2997 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2999 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
3000 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3002 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
3003 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3005 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
3006 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3008 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
3009 & ivec_count(fg_rank1),
3010 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3012 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
3013 & ivec_count(fg_rank1),
3014 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3016 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
3017 & ivec_count(fg_rank1),
3018 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3019 & MPI_MAT2,FG_COMM1,IERR)
3020 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
3021 & ivec_count(fg_rank1),
3022 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3023 & MPI_MAT2,FG_COMM1,IERR)
3026 c Passes matrix info through the ring
3029 if (irecv.lt.0) irecv=nfgtasks1-1
3032 if (inext.ge.nfgtasks1) inext=0
3034 c write (iout,*) "isend",isend," irecv",irecv
3036 lensend=lentyp(isend)
3037 lenrecv=lentyp(irecv)
3038 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
3039 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
3040 c & MPI_ROTAT1(lensend),inext,2200+isend,
3041 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
3042 c & iprev,2200+irecv,FG_COMM,status,IERR)
3043 c write (iout,*) "Gather ROTAT1"
3045 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
3046 c & MPI_ROTAT2(lensend),inext,3300+isend,
3047 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3048 c & iprev,3300+irecv,FG_COMM,status,IERR)
3049 c write (iout,*) "Gather ROTAT2"
3051 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
3052 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
3053 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
3054 & iprev,4400+irecv,FG_COMM,status,IERR)
3055 c write (iout,*) "Gather ROTAT_OLD"
3057 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
3058 & MPI_PRECOMP11(lensend),inext,5500+isend,
3059 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
3060 & iprev,5500+irecv,FG_COMM,status,IERR)
3061 c write (iout,*) "Gather PRECOMP11"
3063 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
3064 & MPI_PRECOMP12(lensend),inext,6600+isend,
3065 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
3066 & iprev,6600+irecv,FG_COMM,status,IERR)
3067 c write (iout,*) "Gather PRECOMP12"
3069 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3071 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
3072 & MPI_ROTAT2(lensend),inext,7700+isend,
3073 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3074 & iprev,7700+irecv,FG_COMM,status,IERR)
3075 c write (iout,*) "Gather PRECOMP21"
3077 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
3078 & MPI_PRECOMP22(lensend),inext,8800+isend,
3079 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
3080 & iprev,8800+irecv,FG_COMM,status,IERR)
3081 c write (iout,*) "Gather PRECOMP22"
3083 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
3084 & MPI_PRECOMP23(lensend),inext,9900+isend,
3085 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
3086 & MPI_PRECOMP23(lenrecv),
3087 & iprev,9900+irecv,FG_COMM,status,IERR)
3088 c write (iout,*) "Gather PRECOMP23"
3093 if (irecv.lt.0) irecv=nfgtasks1-1
3096 time_gather=time_gather+MPI_Wtime()-time00
3099 c if (fg_rank.eq.0) then
3100 write (iout,*) "Arrays UG and UGDER"
3102 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3103 & ((ug(l,k,i),l=1,2),k=1,2),
3104 & ((ugder(l,k,i),l=1,2),k=1,2)
3106 write (iout,*) "Arrays UG2 and UG2DER"
3108 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3109 & ((ug2(l,k,i),l=1,2),k=1,2),
3110 & ((ug2der(l,k,i),l=1,2),k=1,2)
3112 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3114 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3115 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
3116 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3118 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3120 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3121 & costab(i),sintab(i),costab2(i),sintab2(i)
3123 write (iout,*) "Array MUDER"
3125 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3131 cd iti = itortyp(itype(i))
3134 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
3135 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
3140 C--------------------------------------------------------------------------
3141 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3143 C This subroutine calculates the average interaction energy and its gradient
3144 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3145 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3146 C The potential depends both on the distance of peptide-group centers and on
3147 C the orientation of the CA-CA virtual bonds.
3149 implicit real*8 (a-h,o-z)
3153 include 'DIMENSIONS'
3154 include 'COMMON.CONTROL'
3155 include 'COMMON.SETUP'
3156 include 'COMMON.IOUNITS'
3157 include 'COMMON.GEO'
3158 include 'COMMON.VAR'
3159 include 'COMMON.LOCAL'
3160 include 'COMMON.CHAIN'
3161 include 'COMMON.DERIV'
3162 include 'COMMON.INTERACT'
3163 include 'COMMON.CONTACTS'
3164 include 'COMMON.TORSION'
3165 include 'COMMON.VECTORS'
3166 include 'COMMON.FFIELD'
3167 include 'COMMON.TIME1'
3168 include 'COMMON.SPLITELE'
3169 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3170 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3171 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3172 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
3173 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3174 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3176 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3178 double precision scal_el /1.0d0/
3180 double precision scal_el /0.5d0/
3183 C 13-go grudnia roku pamietnego...
3184 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3185 & 0.0d0,1.0d0,0.0d0,
3186 & 0.0d0,0.0d0,1.0d0/
3187 cd write(iout,*) 'In EELEC'
3189 cd write(iout,*) 'Type',i
3190 cd write(iout,*) 'B1',B1(:,i)
3191 cd write(iout,*) 'B2',B2(:,i)
3192 cd write(iout,*) 'CC',CC(:,:,i)
3193 cd write(iout,*) 'DD',DD(:,:,i)
3194 cd write(iout,*) 'EE',EE(:,:,i)
3196 cd call check_vecgrad
3198 if (icheckgrad.eq.1) then
3200 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3202 dc_norm(k,i)=dc(k,i)*fac
3204 c write (iout,*) 'i',i,' fac',fac
3207 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3208 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3209 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3210 c call vec_and_deriv
3216 time_mat=time_mat+MPI_Wtime()-time01
3220 cd write (iout,*) 'i=',i
3222 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3225 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3226 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3239 cd print '(a)','Enter EELEC'
3240 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3242 gel_loc_loc(i)=0.0d0
3247 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3249 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3251 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
3252 do i=iturn3_start,iturn3_end
3254 C write(iout,*) "tu jest i",i
3255 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3256 & .or. itype(i+2).eq.ntyp1
3257 & .or. itype(i+3).eq.ntyp1
3258 & .or. itype(i-1).eq.ntyp1
3259 & .or. itype(i+4).eq.ntyp1
3264 dx_normi=dc_norm(1,i)
3265 dy_normi=dc_norm(2,i)
3266 dz_normi=dc_norm(3,i)
3267 xmedi=c(1,i)+0.5d0*dxi
3268 ymedi=c(2,i)+0.5d0*dyi
3269 zmedi=c(3,i)+0.5d0*dzi
3270 xmedi=mod(xmedi,boxxsize)
3271 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3272 ymedi=mod(ymedi,boxysize)
3273 if (ymedi.lt.0) ymedi=ymedi+boxysize
3274 zmedi=mod(zmedi,boxzsize)
3275 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3277 call eelecij(i,i+2,ees,evdw1,eel_loc)
3278 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3279 num_cont_hb(i)=num_conti
3281 do i=iturn4_start,iturn4_end
3283 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3284 & .or. itype(i+3).eq.ntyp1
3285 & .or. itype(i+4).eq.ntyp1
3286 & .or. itype(i+5).eq.ntyp1
3287 & .or. itype(i).eq.ntyp1
3288 & .or. itype(i-1).eq.ntyp1
3293 dx_normi=dc_norm(1,i)
3294 dy_normi=dc_norm(2,i)
3295 dz_normi=dc_norm(3,i)
3296 xmedi=c(1,i)+0.5d0*dxi
3297 ymedi=c(2,i)+0.5d0*dyi
3298 zmedi=c(3,i)+0.5d0*dzi
3299 C Return atom into box, boxxsize is size of box in x dimension
3301 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3302 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3303 C Condition for being inside the proper box
3304 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
3305 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
3309 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
3310 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3311 C Condition for being inside the proper box
3312 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
3313 c & (ymedi.lt.((-0.5d0)*boxysize))) then
3317 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3318 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3319 C Condition for being inside the proper box
3320 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
3321 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
3324 xmedi=mod(xmedi,boxxsize)
3325 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3326 ymedi=mod(ymedi,boxysize)
3327 if (ymedi.lt.0) ymedi=ymedi+boxysize
3328 zmedi=mod(zmedi,boxzsize)
3329 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3331 num_conti=num_cont_hb(i)
3332 c write(iout,*) "JESTEM W PETLI"
3333 call eelecij(i,i+3,ees,evdw1,eel_loc)
3334 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
3335 & call eturn4(i,eello_turn4)
3336 num_cont_hb(i)=num_conti
3338 C Loop over all neighbouring boxes
3343 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3345 do i=iatel_s,iatel_e
3347 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3348 & .or. itype(i+2).eq.ntyp1
3349 & .or. itype(i-1).eq.ntyp1
3354 dx_normi=dc_norm(1,i)
3355 dy_normi=dc_norm(2,i)
3356 dz_normi=dc_norm(3,i)
3357 xmedi=c(1,i)+0.5d0*dxi
3358 ymedi=c(2,i)+0.5d0*dyi
3359 zmedi=c(3,i)+0.5d0*dzi
3360 xmedi=mod(xmedi,boxxsize)
3361 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3362 ymedi=mod(ymedi,boxysize)
3363 if (ymedi.lt.0) ymedi=ymedi+boxysize
3364 zmedi=mod(zmedi,boxzsize)
3365 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3366 C xmedi=xmedi+xshift*boxxsize
3367 C ymedi=ymedi+yshift*boxysize
3368 C zmedi=zmedi+zshift*boxzsize
3370 C Return tom into box, boxxsize is size of box in x dimension
3372 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3373 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3374 C Condition for being inside the proper box
3375 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
3376 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
3380 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
3381 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3382 C Condition for being inside the proper box
3383 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
3384 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3388 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3389 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3390 cC Condition for being inside the proper box
3391 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3392 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3396 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3397 num_conti=num_cont_hb(i)
3398 do j=ielstart(i),ielend(i)
3399 C write (iout,*) i,j
3401 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3402 & .or.itype(j+2).eq.ntyp1
3403 & .or.itype(j-1).eq.ntyp1
3405 call eelecij(i,j,ees,evdw1,eel_loc)
3407 num_cont_hb(i)=num_conti
3413 c write (iout,*) "Number of loop steps in EELEC:",ind
3415 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3416 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3418 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3419 ccc eel_loc=eel_loc+eello_turn3
3420 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3423 C-------------------------------------------------------------------------------
3424 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3425 implicit real*8 (a-h,o-z)
3426 include 'DIMENSIONS'
3430 include 'COMMON.CONTROL'
3431 include 'COMMON.IOUNITS'
3432 include 'COMMON.GEO'
3433 include 'COMMON.VAR'
3434 include 'COMMON.LOCAL'
3435 include 'COMMON.CHAIN'
3436 include 'COMMON.DERIV'
3437 include 'COMMON.INTERACT'
3438 include 'COMMON.CONTACTS'
3439 include 'COMMON.TORSION'
3440 include 'COMMON.VECTORS'
3441 include 'COMMON.FFIELD'
3442 include 'COMMON.TIME1'
3443 include 'COMMON.SPLITELE'
3444 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3445 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3446 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3447 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
3448 & gmuij2(4),gmuji2(4)
3449 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3450 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3452 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3454 double precision scal_el /1.0d0/
3456 double precision scal_el /0.5d0/
3459 C 13-go grudnia roku pamietnego...
3460 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3461 & 0.0d0,1.0d0,0.0d0,
3462 & 0.0d0,0.0d0,1.0d0/
3463 c time00=MPI_Wtime()
3464 cd write (iout,*) "eelecij",i,j
3468 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3469 aaa=app(iteli,itelj)
3470 bbb=bpp(iteli,itelj)
3471 ael6i=ael6(iteli,itelj)
3472 ael3i=ael3(iteli,itelj)
3476 dx_normj=dc_norm(1,j)
3477 dy_normj=dc_norm(2,j)
3478 dz_normj=dc_norm(3,j)
3479 C xj=c(1,j)+0.5D0*dxj-xmedi
3480 C yj=c(2,j)+0.5D0*dyj-ymedi
3481 C zj=c(3,j)+0.5D0*dzj-zmedi
3486 if (xj.lt.0) xj=xj+boxxsize
3488 if (yj.lt.0) yj=yj+boxysize
3490 if (zj.lt.0) zj=zj+boxzsize
3491 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
3492 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3500 xj=xj_safe+xshift*boxxsize
3501 yj=yj_safe+yshift*boxysize
3502 zj=zj_safe+zshift*boxzsize
3503 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3504 if(dist_temp.lt.dist_init) then
3514 if (isubchap.eq.1) then
3523 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3525 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3526 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3527 C Condition for being inside the proper box
3528 c if ((xj.gt.((0.5d0)*boxxsize)).or.
3529 c & (xj.lt.((-0.5d0)*boxxsize))) then
3533 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3534 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3535 C Condition for being inside the proper box
3536 c if ((yj.gt.((0.5d0)*boxysize)).or.
3537 c & (yj.lt.((-0.5d0)*boxysize))) then
3541 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3542 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3543 C Condition for being inside the proper box
3544 c if ((zj.gt.((0.5d0)*boxzsize)).or.
3545 c & (zj.lt.((-0.5d0)*boxzsize))) then
3548 C endif !endPBC condintion
3552 rij=xj*xj+yj*yj+zj*zj
3554 sss=sscale(sqrt(rij))
3555 sssgrad=sscagrad(sqrt(rij))
3556 c if (sss.gt.0.0d0) then
3562 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3563 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3564 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3565 fac=cosa-3.0D0*cosb*cosg
3567 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3568 if (j.eq.i+2) ev1=scal_el*ev1
3573 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3577 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3578 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3580 evdw1=evdw1+evdwij*sss
3581 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3582 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3583 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3584 cd & xmedi,ymedi,zmedi,xj,yj,zj
3586 if (energy_dec) then
3587 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3589 &,iteli,itelj,aaa,evdw1
3590 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3594 C Calculate contributions to the Cartesian gradient.
3597 facvdw=-6*rrmij*(ev1+evdwij)*sss
3598 facel=-3*rrmij*(el1+eesij)
3604 * Radial derivatives. First process both termini of the fragment (i,j)
3610 c ghalf=0.5D0*ggg(k)
3611 c gelc(k,i)=gelc(k,i)+ghalf
3612 c gelc(k,j)=gelc(k,j)+ghalf
3614 c 9/28/08 AL Gradient compotents will be summed only at the end
3616 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3617 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3620 * Loop over residues i+1 thru j-1.
3624 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3627 if (sss.gt.0.0) then
3628 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3629 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3630 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3637 c ghalf=0.5D0*ggg(k)
3638 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3639 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3641 c 9/28/08 AL Gradient compotents will be summed only at the end
3643 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3644 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3647 * Loop over residues i+1 thru j-1.
3651 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3656 facvdw=(ev1+evdwij)*sss
3659 fac=-3*rrmij*(facvdw+facvdw+facel)
3664 * Radial derivatives. First process both termini of the fragment (i,j)
3670 c ghalf=0.5D0*ggg(k)
3671 c gelc(k,i)=gelc(k,i)+ghalf
3672 c gelc(k,j)=gelc(k,j)+ghalf
3674 c 9/28/08 AL Gradient compotents will be summed only at the end
3676 gelc_long(k,j)=gelc(k,j)+ggg(k)
3677 gelc_long(k,i)=gelc(k,i)-ggg(k)
3680 * Loop over residues i+1 thru j-1.
3684 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3687 c 9/28/08 AL Gradient compotents will be summed only at the end
3688 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3689 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3690 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3692 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3693 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3699 ecosa=2.0D0*fac3*fac1+fac4
3702 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3703 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3705 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3706 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3708 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3709 cd & (dcosg(k),k=1,3)
3711 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3714 c ghalf=0.5D0*ggg(k)
3715 c gelc(k,i)=gelc(k,i)+ghalf
3716 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3717 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3718 c gelc(k,j)=gelc(k,j)+ghalf
3719 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3720 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3724 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3729 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3730 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3732 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3733 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3734 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3735 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3739 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3740 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3741 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3743 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3744 C energy of a peptide unit is assumed in the form of a second-order
3745 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3746 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3747 C are computed for EVERY pair of non-contiguous peptide groups.
3750 if (j.lt.nres-1) then
3762 muij(kkk)=mu(k,i)*mu(l,j)
3763 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
3765 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
3766 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
3767 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
3768 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
3769 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
3770 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
3774 cd write (iout,*) 'EELEC: i',i,' j',j
3775 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3776 cd write(iout,*) 'muij',muij
3777 ury=scalar(uy(1,i),erij)
3778 urz=scalar(uz(1,i),erij)
3779 vry=scalar(uy(1,j),erij)
3780 vrz=scalar(uz(1,j),erij)
3781 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3782 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3783 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3784 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3785 fac=dsqrt(-ael6i)*r3ij
3790 cd write (iout,'(4i5,4f10.5)')
3791 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3792 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3793 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3794 cd & uy(:,j),uz(:,j)
3795 cd write (iout,'(4f10.5)')
3796 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3797 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3798 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3799 cd write (iout,'(9f10.5/)')
3800 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3801 C Derivatives of the elements of A in virtual-bond vectors
3802 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3804 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3805 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3806 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3807 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3808 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3809 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3810 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3811 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3812 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3813 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3814 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3815 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3817 C Compute radial contributions to the gradient
3835 C Add the contributions coming from er
3838 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3839 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3840 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3841 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3844 C Derivatives in DC(i)
3845 cgrad ghalf1=0.5d0*agg(k,1)
3846 cgrad ghalf2=0.5d0*agg(k,2)
3847 cgrad ghalf3=0.5d0*agg(k,3)
3848 cgrad ghalf4=0.5d0*agg(k,4)
3849 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3850 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3851 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3852 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3853 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3854 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3855 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3856 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3857 C Derivatives in DC(i+1)
3858 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3859 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3860 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3861 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3862 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3863 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3864 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3865 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3866 C Derivatives in DC(j)
3867 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3868 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3869 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3870 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3871 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3872 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3873 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3874 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3875 C Derivatives in DC(j+1) or DC(nres-1)
3876 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3877 & -3.0d0*vryg(k,3)*ury)
3878 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3879 & -3.0d0*vrzg(k,3)*ury)
3880 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3881 & -3.0d0*vryg(k,3)*urz)
3882 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3883 & -3.0d0*vrzg(k,3)*urz)
3884 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3886 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3899 aggi(k,l)=-aggi(k,l)
3900 aggi1(k,l)=-aggi1(k,l)
3901 aggj(k,l)=-aggj(k,l)
3902 aggj1(k,l)=-aggj1(k,l)
3905 if (j.lt.nres-1) then
3911 aggi(k,l)=-aggi(k,l)
3912 aggi1(k,l)=-aggi1(k,l)
3913 aggj(k,l)=-aggj(k,l)
3914 aggj1(k,l)=-aggj1(k,l)
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)
3933 IF (wel_loc.gt.0.0d0) THEN
3934 C Contribution to the local-electrostatic energy coming from the i-j pair
3935 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3937 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
3938 c & ' eel_loc_ij',eel_loc_ij
3939 c write(iout,*) 'muije=',muij(1),muij(2),muij(3),muij(4)
3940 C Calculate patrial derivative for theta angle
3942 geel_loc_ij=a22*gmuij1(1)
3946 c write(iout,*) "derivative over thatai"
3947 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
3949 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
3950 & geel_loc_ij*wel_loc
3951 c write(iout,*) "derivative over thatai-1"
3952 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
3959 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
3960 & geel_loc_ij*wel_loc
3961 c Derivative over j residue
3962 geel_loc_ji=a22*gmuji1(1)
3966 c write(iout,*) "derivative over thataj"
3967 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
3970 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
3971 & geel_loc_ji*wel_loc
3977 c write(iout,*) "derivative over thataj-1"
3978 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
3980 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
3981 & geel_loc_ji*wel_loc
3983 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
3985 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
3986 & 'eelloc',i,j,eel_loc_ij
3987 c if (eel_loc_ij.ne.0)
3988 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
3989 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
3991 eel_loc=eel_loc+eel_loc_ij
3992 C Partial derivatives in virtual-bond dihedral angles gamma
3994 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
3995 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
3996 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
3997 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
3998 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
3999 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
4000 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
4002 ggg(l)=agg(l,1)*muij(1)+
4003 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
4004 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
4005 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
4006 cgrad ghalf=0.5d0*ggg(l)
4007 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
4008 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
4012 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
4015 C Remaining derivatives of eello
4017 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
4018 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
4019 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
4020 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
4021 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
4022 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
4023 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
4024 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
4027 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
4028 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
4029 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
4030 & .and. num_conti.le.maxconts) then
4031 c write (iout,*) i,j," entered corr"
4033 C Calculate the contact function. The ith column of the array JCONT will
4034 C contain the numbers of atoms that make contacts with the atom I (of numbers
4035 C greater than I). The arrays FACONT and GACONT will contain the values of
4036 C the contact function and its derivative.
4037 c r0ij=1.02D0*rpp(iteli,itelj)
4038 c r0ij=1.11D0*rpp(iteli,itelj)
4039 r0ij=2.20D0*rpp(iteli,itelj)
4040 c r0ij=1.55D0*rpp(iteli,itelj)
4041 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4042 if (fcont.gt.0.0D0) then
4043 num_conti=num_conti+1
4044 if (num_conti.gt.maxconts) then
4045 write (iout,*) 'WARNING - max. # of contacts exceeded;',
4046 & ' will skip next contacts for this conf.'
4048 jcont_hb(num_conti,i)=j
4049 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
4050 cd & " jcont_hb",jcont_hb(num_conti,i)
4051 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
4052 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4053 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4055 d_cont(num_conti,i)=rij
4056 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4057 C --- Electrostatic-interaction matrix ---
4058 a_chuj(1,1,num_conti,i)=a22
4059 a_chuj(1,2,num_conti,i)=a23
4060 a_chuj(2,1,num_conti,i)=a32
4061 a_chuj(2,2,num_conti,i)=a33
4062 C --- Gradient of rij
4064 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4071 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4072 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4073 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4074 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4075 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4080 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4081 C Calculate contact energies
4083 wij=cosa-3.0D0*cosb*cosg
4086 c fac3=dsqrt(-ael6i)/r0ij**3
4087 fac3=dsqrt(-ael6i)*r3ij
4088 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4089 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
4090 if (ees0tmp.gt.0) then
4091 ees0pij=dsqrt(ees0tmp)
4095 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4096 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
4097 if (ees0tmp.gt.0) then
4098 ees0mij=dsqrt(ees0tmp)
4103 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
4104 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
4105 C Diagnostics. Comment out or remove after debugging!
4106 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4107 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4108 c ees0m(num_conti,i)=0.0D0
4110 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4111 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4112 C Angular derivatives of the contact function
4113 ees0pij1=fac3/ees0pij
4114 ees0mij1=fac3/ees0mij
4115 fac3p=-3.0D0*fac3*rrmij
4116 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4117 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4119 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4120 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4121 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4122 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4123 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4124 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4125 ecosap=ecosa1+ecosa2
4126 ecosbp=ecosb1+ecosb2
4127 ecosgp=ecosg1+ecosg2
4128 ecosam=ecosa1-ecosa2
4129 ecosbm=ecosb1-ecosb2
4130 ecosgm=ecosg1-ecosg2
4139 facont_hb(num_conti,i)=fcont
4140 fprimcont=fprimcont/rij
4141 cd facont_hb(num_conti,i)=1.0D0
4142 C Following line is for diagnostics.
4145 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4146 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4149 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4150 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4152 gggp(1)=gggp(1)+ees0pijp*xj
4153 gggp(2)=gggp(2)+ees0pijp*yj
4154 gggp(3)=gggp(3)+ees0pijp*zj
4155 gggm(1)=gggm(1)+ees0mijp*xj
4156 gggm(2)=gggm(2)+ees0mijp*yj
4157 gggm(3)=gggm(3)+ees0mijp*zj
4158 C Derivatives due to the contact function
4159 gacont_hbr(1,num_conti,i)=fprimcont*xj
4160 gacont_hbr(2,num_conti,i)=fprimcont*yj
4161 gacont_hbr(3,num_conti,i)=fprimcont*zj
4164 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
4165 c following the change of gradient-summation algorithm.
4167 cgrad ghalfp=0.5D0*gggp(k)
4168 cgrad ghalfm=0.5D0*gggm(k)
4169 gacontp_hb1(k,num_conti,i)=!ghalfp
4170 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
4171 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4172 gacontp_hb2(k,num_conti,i)=!ghalfp
4173 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
4174 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4175 gacontp_hb3(k,num_conti,i)=gggp(k)
4176 gacontm_hb1(k,num_conti,i)=!ghalfm
4177 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
4178 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4179 gacontm_hb2(k,num_conti,i)=!ghalfm
4180 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
4181 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4182 gacontm_hb3(k,num_conti,i)=gggm(k)
4184 C Diagnostics. Comment out or remove after debugging!
4186 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
4187 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
4188 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
4189 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
4190 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
4191 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
4194 endif ! num_conti.le.maxconts
4197 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4200 ghalf=0.5d0*agg(l,k)
4201 aggi(l,k)=aggi(l,k)+ghalf
4202 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4203 aggj(l,k)=aggj(l,k)+ghalf
4206 if (j.eq.nres-1 .and. i.lt.j-2) then
4209 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4214 c t_eelecij=t_eelecij+MPI_Wtime()-time00
4217 C-----------------------------------------------------------------------------
4218 subroutine eturn3(i,eello_turn3)
4219 C Third- and fourth-order contributions from turns
4220 implicit real*8 (a-h,o-z)
4221 include 'DIMENSIONS'
4222 include 'COMMON.IOUNITS'
4223 include 'COMMON.GEO'
4224 include 'COMMON.VAR'
4225 include 'COMMON.LOCAL'
4226 include 'COMMON.CHAIN'
4227 include 'COMMON.DERIV'
4228 include 'COMMON.INTERACT'
4229 include 'COMMON.CONTACTS'
4230 include 'COMMON.TORSION'
4231 include 'COMMON.VECTORS'
4232 include 'COMMON.FFIELD'
4233 include 'COMMON.CONTROL'
4235 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4236 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4237 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
4238 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
4239 & auxgmat2(2,2),auxgmatt2(2,2)
4240 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4241 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4242 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4243 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4246 c write (iout,*) "eturn3",i,j,j1,j2
4251 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4253 C Third-order contributions
4260 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4261 cd call checkint_turn3(i,a_temp,eello_turn3_num)
4262 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4263 c auxalary matices for theta gradient
4264 c auxalary matrix for i+1 and constant i+2
4265 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
4266 c auxalary matrix for i+2 and constant i+1
4267 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
4268 call transpose2(auxmat(1,1),auxmat1(1,1))
4269 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
4270 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
4271 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4272 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
4273 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
4274 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
4275 C Derivatives in theta
4276 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4277 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
4278 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
4279 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
4281 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4282 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
4283 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
4284 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
4285 cd & ' eello_turn3_num',4*eello_turn3_num
4286 C Derivatives in gamma(i)
4287 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4288 call transpose2(auxmat2(1,1),auxmat3(1,1))
4289 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4290 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
4291 C Derivatives in gamma(i+1)
4292 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4293 call transpose2(auxmat2(1,1),auxmat3(1,1))
4294 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4295 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
4296 & +0.5d0*(pizda(1,1)+pizda(2,2))
4297 C Cartesian derivatives
4299 c ghalf1=0.5d0*agg(l,1)
4300 c ghalf2=0.5d0*agg(l,2)
4301 c ghalf3=0.5d0*agg(l,3)
4302 c ghalf4=0.5d0*agg(l,4)
4303 a_temp(1,1)=aggi(l,1)!+ghalf1
4304 a_temp(1,2)=aggi(l,2)!+ghalf2
4305 a_temp(2,1)=aggi(l,3)!+ghalf3
4306 a_temp(2,2)=aggi(l,4)!+ghalf4
4307 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4308 gcorr3_turn(l,i)=gcorr3_turn(l,i)
4309 & +0.5d0*(pizda(1,1)+pizda(2,2))
4310 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4311 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4312 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4313 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4314 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4315 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
4316 & +0.5d0*(pizda(1,1)+pizda(2,2))
4317 a_temp(1,1)=aggj(l,1)!+ghalf1
4318 a_temp(1,2)=aggj(l,2)!+ghalf2
4319 a_temp(2,1)=aggj(l,3)!+ghalf3
4320 a_temp(2,2)=aggj(l,4)!+ghalf4
4321 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4322 gcorr3_turn(l,j)=gcorr3_turn(l,j)
4323 & +0.5d0*(pizda(1,1)+pizda(2,2))
4324 a_temp(1,1)=aggj1(l,1)
4325 a_temp(1,2)=aggj1(l,2)
4326 a_temp(2,1)=aggj1(l,3)
4327 a_temp(2,2)=aggj1(l,4)
4328 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4329 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
4330 & +0.5d0*(pizda(1,1)+pizda(2,2))
4334 C-------------------------------------------------------------------------------
4335 subroutine eturn4(i,eello_turn4)
4336 C Third- and fourth-order contributions from turns
4337 implicit real*8 (a-h,o-z)
4338 include 'DIMENSIONS'
4339 include 'COMMON.IOUNITS'
4340 include 'COMMON.GEO'
4341 include 'COMMON.VAR'
4342 include 'COMMON.LOCAL'
4343 include 'COMMON.CHAIN'
4344 include 'COMMON.DERIV'
4345 include 'COMMON.INTERACT'
4346 include 'COMMON.CONTACTS'
4347 include 'COMMON.TORSION'
4348 include 'COMMON.VECTORS'
4349 include 'COMMON.FFIELD'
4350 include 'COMMON.CONTROL'
4352 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4353 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4354 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
4355 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
4356 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
4357 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
4358 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
4359 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4360 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4361 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4362 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4365 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4367 C Fourth-order contributions
4375 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4376 cd call checkint_turn4(i,a_temp,eello_turn4_num)
4377 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4378 c write(iout,*)"WCHODZE W PROGRAM"
4383 iti1=itortyp(itype(i+1))
4384 iti2=itortyp(itype(i+2))
4385 iti3=itortyp(itype(i+3))
4386 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4387 call transpose2(EUg(1,1,i+1),e1t(1,1))
4388 call transpose2(Eug(1,1,i+2),e2t(1,1))
4389 call transpose2(Eug(1,1,i+3),e3t(1,1))
4390 C Ematrix derivative in theta
4391 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
4392 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
4393 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
4394 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4395 c eta1 in derivative theta
4396 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
4397 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4398 c auxgvec is derivative of Ub2 so i+3 theta
4399 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
4400 c auxalary matrix of E i+1
4401 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
4404 s1=scalar2(b1(1,i+2),auxvec(1))
4405 c derivative of theta i+2 with constant i+3
4406 gs23=scalar2(gtb1(1,i+2),auxvec(1))
4407 c derivative of theta i+2 with constant i+2
4408 gs32=scalar2(b1(1,i+2),auxgvec(1))
4409 c derivative of E matix in theta of i+1
4410 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
4412 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4413 c ea31 in derivative theta
4414 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
4415 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4416 c auxilary matrix auxgvec of Ub2 with constant E matirx
4417 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
4418 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
4419 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
4423 s2=scalar2(b1(1,i+1),auxvec(1))
4424 c derivative of theta i+1 with constant i+3
4425 gs13=scalar2(gtb1(1,i+1),auxvec(1))
4426 c derivative of theta i+2 with constant i+1
4427 gs21=scalar2(b1(1,i+1),auxgvec(1))
4428 c derivative of theta i+3 with constant i+1
4429 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
4430 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
4432 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4433 c two derivatives over diffetent matrices
4434 c gtae3e2 is derivative over i+3
4435 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
4436 c ae3gte2 is derivative over i+2
4437 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
4438 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4439 c three possible derivative over theta E matices
4441 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
4443 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
4445 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
4446 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4448 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
4449 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
4450 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
4452 eello_turn4=eello_turn4-(s1+s2+s3)
4453 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
4454 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
4455 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
4456 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4457 cd & ' eello_turn4_num',8*eello_turn4_num
4459 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4460 & -(gs13+gsE13+gsEE1)*wturn4
4461 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
4462 & -(gs23+gs21+gsEE2)*wturn4
4463 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
4464 & -(gs32+gsE31+gsEE3)*wturn4
4465 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
4468 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4469 & 'eturn4',i,j,-(s1+s2+s3)
4470 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4471 c & ' eello_turn4_num',8*eello_turn4_num
4472 C Derivatives in gamma(i)
4473 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4474 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4475 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4476 s1=scalar2(b1(1,i+2),auxvec(1))
4477 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4478 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4479 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
4480 C Derivatives in gamma(i+1)
4481 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4482 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4483 s2=scalar2(b1(1,i+1),auxvec(1))
4484 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4485 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4486 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4487 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
4488 C Derivatives in gamma(i+2)
4489 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4490 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4491 s1=scalar2(b1(1,i+2),auxvec(1))
4492 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4493 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4494 s2=scalar2(b1(1,i+1),auxvec(1))
4495 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4496 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4497 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4498 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
4499 C Cartesian derivatives
4500 C Derivatives of this turn contributions in DC(i+2)
4501 if (j.lt.nres-1) then
4503 a_temp(1,1)=agg(l,1)
4504 a_temp(1,2)=agg(l,2)
4505 a_temp(2,1)=agg(l,3)
4506 a_temp(2,2)=agg(l,4)
4507 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4508 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4509 s1=scalar2(b1(1,i+2),auxvec(1))
4510 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4511 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4512 s2=scalar2(b1(1,i+1),auxvec(1))
4513 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4514 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4515 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4517 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
4520 C Remaining derivatives of this turn contribution
4522 a_temp(1,1)=aggi(l,1)
4523 a_temp(1,2)=aggi(l,2)
4524 a_temp(2,1)=aggi(l,3)
4525 a_temp(2,2)=aggi(l,4)
4526 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4527 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4528 s1=scalar2(b1(1,i+2),auxvec(1))
4529 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4530 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4531 s2=scalar2(b1(1,i+1),auxvec(1))
4532 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4533 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4534 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4535 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4536 a_temp(1,1)=aggi1(l,1)
4537 a_temp(1,2)=aggi1(l,2)
4538 a_temp(2,1)=aggi1(l,3)
4539 a_temp(2,2)=aggi1(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+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4550 a_temp(1,1)=aggj(l,1)
4551 a_temp(1,2)=aggj(l,2)
4552 a_temp(2,1)=aggj(l,3)
4553 a_temp(2,2)=aggj(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,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4564 a_temp(1,1)=aggj1(l,1)
4565 a_temp(1,2)=aggj1(l,2)
4566 a_temp(2,1)=aggj1(l,3)
4567 a_temp(2,2)=aggj1(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 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4578 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4582 C-----------------------------------------------------------------------------
4583 subroutine vecpr(u,v,w)
4584 implicit real*8(a-h,o-z)
4585 dimension u(3),v(3),w(3)
4586 w(1)=u(2)*v(3)-u(3)*v(2)
4587 w(2)=-u(1)*v(3)+u(3)*v(1)
4588 w(3)=u(1)*v(2)-u(2)*v(1)
4591 C-----------------------------------------------------------------------------
4592 subroutine unormderiv(u,ugrad,unorm,ungrad)
4593 C This subroutine computes the derivatives of a normalized vector u, given
4594 C the derivatives computed without normalization conditions, ugrad. Returns
4597 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4598 double precision vec(3)
4599 double precision scalar
4601 c write (2,*) 'ugrad',ugrad
4604 vec(i)=scalar(ugrad(1,i),u(1))
4606 c write (2,*) 'vec',vec
4609 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4612 c write (2,*) 'ungrad',ungrad
4615 C-----------------------------------------------------------------------------
4616 subroutine escp_soft_sphere(evdw2,evdw2_14)
4618 C This subroutine calculates the excluded-volume interaction energy between
4619 C peptide-group centers and side chains and its gradient in virtual-bond and
4620 C side-chain vectors.
4622 implicit real*8 (a-h,o-z)
4623 include 'DIMENSIONS'
4624 include 'COMMON.GEO'
4625 include 'COMMON.VAR'
4626 include 'COMMON.LOCAL'
4627 include 'COMMON.CHAIN'
4628 include 'COMMON.DERIV'
4629 include 'COMMON.INTERACT'
4630 include 'COMMON.FFIELD'
4631 include 'COMMON.IOUNITS'
4632 include 'COMMON.CONTROL'
4637 cd print '(a)','Enter ESCP'
4638 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4642 do i=iatscp_s,iatscp_e
4643 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4645 xi=0.5D0*(c(1,i)+c(1,i+1))
4646 yi=0.5D0*(c(2,i)+c(2,i+1))
4647 zi=0.5D0*(c(3,i)+c(3,i+1))
4648 C Return atom into box, boxxsize is size of box in x dimension
4650 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4651 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4652 C Condition for being inside the proper box
4653 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4654 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4658 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4659 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4660 C Condition for being inside the proper box
4661 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4662 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4666 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4667 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4668 cC Condition for being inside the proper box
4669 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4670 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4674 if (xi.lt.0) xi=xi+boxxsize
4676 if (yi.lt.0) yi=yi+boxysize
4678 if (zi.lt.0) zi=zi+boxzsize
4679 C xi=xi+xshift*boxxsize
4680 C yi=yi+yshift*boxysize
4681 C zi=zi+zshift*boxzsize
4682 do iint=1,nscp_gr(i)
4684 do j=iscpstart(i,iint),iscpend(i,iint)
4685 if (itype(j).eq.ntyp1) cycle
4686 itypj=iabs(itype(j))
4687 C Uncomment following three lines for SC-p interactions
4691 C Uncomment following three lines for Ca-p interactions
4696 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4697 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4698 C Condition for being inside the proper box
4699 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4700 c & (xj.lt.((-0.5d0)*boxxsize))) then
4704 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4705 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4706 cC Condition for being inside the proper box
4707 c if ((yj.gt.((0.5d0)*boxysize)).or.
4708 c & (yj.lt.((-0.5d0)*boxysize))) then
4712 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4713 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4714 C Condition for being inside the proper box
4715 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4716 c & (zj.lt.((-0.5d0)*boxzsize))) then
4719 if (xj.lt.0) xj=xj+boxxsize
4721 if (yj.lt.0) yj=yj+boxysize
4723 if (zj.lt.0) zj=zj+boxzsize
4724 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4732 xj=xj_safe+xshift*boxxsize
4733 yj=yj_safe+yshift*boxysize
4734 zj=zj_safe+zshift*boxzsize
4735 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4736 if(dist_temp.lt.dist_init) then
4746 if (subchap.eq.1) then
4759 rij=xj*xj+yj*yj+zj*zj
4763 if (rij.lt.r0ijsq) then
4764 evdwij=0.25d0*(rij-r0ijsq)**2
4772 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4777 cgrad if (j.lt.i) then
4778 cd write (iout,*) 'j<i'
4779 C Uncomment following three lines for SC-p interactions
4781 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4784 cd write (iout,*) 'j>i'
4786 cgrad ggg(k)=-ggg(k)
4787 C Uncomment following line for SC-p interactions
4788 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4792 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4794 cgrad kstart=min0(i+1,j)
4795 cgrad kend=max0(i-1,j-1)
4796 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4797 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4798 cgrad do k=kstart,kend
4800 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4804 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4805 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4816 C-----------------------------------------------------------------------------
4817 subroutine escp(evdw2,evdw2_14)
4819 C This subroutine calculates the excluded-volume interaction energy between
4820 C peptide-group centers and side chains and its gradient in virtual-bond and
4821 C side-chain vectors.
4823 implicit real*8 (a-h,o-z)
4824 include 'DIMENSIONS'
4825 include 'COMMON.GEO'
4826 include 'COMMON.VAR'
4827 include 'COMMON.LOCAL'
4828 include 'COMMON.CHAIN'
4829 include 'COMMON.DERIV'
4830 include 'COMMON.INTERACT'
4831 include 'COMMON.FFIELD'
4832 include 'COMMON.IOUNITS'
4833 include 'COMMON.CONTROL'
4834 include 'COMMON.SPLITELE'
4838 c print *,boxxsize,boxysize,boxzsize,'wymiary pudla'
4839 cd print '(a)','Enter ESCP'
4840 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4844 do i=iatscp_s,iatscp_e
4845 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4847 xi=0.5D0*(c(1,i)+c(1,i+1))
4848 yi=0.5D0*(c(2,i)+c(2,i+1))
4849 zi=0.5D0*(c(3,i)+c(3,i+1))
4851 if (xi.lt.0) xi=xi+boxxsize
4853 if (yi.lt.0) yi=yi+boxysize
4855 if (zi.lt.0) zi=zi+boxzsize
4856 c xi=xi+xshift*boxxsize
4857 c yi=yi+yshift*boxysize
4858 c zi=zi+zshift*boxzsize
4859 c print *,xi,yi,zi,'polozenie i'
4860 C Return atom into box, boxxsize is size of box in x dimension
4862 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4863 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4864 C Condition for being inside the proper box
4865 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4866 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4870 c print *,xi,boxxsize,"pierwszy"
4872 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4873 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4874 C Condition for being inside the proper box
4875 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4876 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4880 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4881 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4882 C Condition for being inside the proper box
4883 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4884 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4887 do iint=1,nscp_gr(i)
4889 do j=iscpstart(i,iint),iscpend(i,iint)
4890 itypj=iabs(itype(j))
4891 if (itypj.eq.ntyp1) cycle
4892 C Uncomment following three lines for SC-p interactions
4896 C Uncomment following three lines for Ca-p interactions
4901 if (xj.lt.0) xj=xj+boxxsize
4903 if (yj.lt.0) yj=yj+boxysize
4905 if (zj.lt.0) zj=zj+boxzsize
4907 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4908 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4909 C Condition for being inside the proper box
4910 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4911 c & (xj.lt.((-0.5d0)*boxxsize))) then
4915 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4916 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4917 cC Condition for being inside the proper box
4918 c if ((yj.gt.((0.5d0)*boxysize)).or.
4919 c & (yj.lt.((-0.5d0)*boxysize))) then
4923 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4924 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4925 C Condition for being inside the proper box
4926 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4927 c & (zj.lt.((-0.5d0)*boxzsize))) then
4930 CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE
4931 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4939 xj=xj_safe+xshift*boxxsize
4940 yj=yj_safe+yshift*boxysize
4941 zj=zj_safe+zshift*boxzsize
4942 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4943 if(dist_temp.lt.dist_init) then
4953 if (subchap.eq.1) then
4962 c print *,xj,yj,zj,'polozenie j'
4963 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
4965 sss=sscale(1.0d0/(dsqrt(rrij)))
4966 c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz'
4967 c if (sss.eq.0) print *,'czasem jest OK'
4968 if (sss.le.0.0d0) cycle
4969 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
4971 e1=fac*fac*aad(itypj,iteli)
4972 e2=fac*bad(itypj,iteli)
4973 if (iabs(j-i) .le. 2) then
4976 evdw2_14=evdw2_14+(e1+e2)*sss
4979 evdw2=evdw2+evdwij*sss
4980 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
4981 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
4984 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4986 fac=-(evdwij+e1)*rrij*sss
4987 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
4991 cgrad if (j.lt.i) then
4992 cd write (iout,*) 'j<i'
4993 C Uncomment following three lines for SC-p interactions
4995 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4998 cd write (iout,*) 'j>i'
5000 cgrad ggg(k)=-ggg(k)
5001 C Uncomment following line for SC-p interactions
5002 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5003 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5007 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5009 cgrad kstart=min0(i+1,j)
5010 cgrad kend=max0(i-1,j-1)
5011 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5012 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5013 cgrad do k=kstart,kend
5015 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5019 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5020 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5022 c endif !endif for sscale cutoff
5032 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
5033 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
5034 gradx_scp(j,i)=expon*gradx_scp(j,i)
5037 C******************************************************************************
5041 C To save time the factor EXPON has been extracted from ALL components
5042 C of GVDWC and GRADX. Remember to multiply them by this factor before further
5045 C******************************************************************************
5048 C--------------------------------------------------------------------------
5049 subroutine edis(ehpb)
5051 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
5053 implicit real*8 (a-h,o-z)
5054 include 'DIMENSIONS'
5055 include 'COMMON.SBRIDGE'
5056 include 'COMMON.CHAIN'
5057 include 'COMMON.DERIV'
5058 include 'COMMON.VAR'
5059 include 'COMMON.INTERACT'
5060 include 'COMMON.IOUNITS'
5063 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
5064 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
5065 if (link_end.eq.0) return
5066 do i=link_start,link_end
5067 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
5068 C CA-CA distance used in regularization of structure.
5071 C iii and jjj point to the residues for which the distance is assigned.
5072 if (ii.gt.nres) then
5079 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
5080 c & dhpb(i),dhpb1(i),forcon(i)
5081 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
5082 C distance and angle dependent SS bond potential.
5083 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5084 C & iabs(itype(jjj)).eq.1) then
5085 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5086 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
5087 if (.not.dyn_ss .and. i.le.nss) then
5088 C 15/02/13 CC dynamic SSbond - additional check
5090 & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5091 call ssbond_ene(iii,jjj,eij)
5094 cd write (iout,*) "eij",eij
5096 C Calculate the distance between the two points and its difference from the
5100 C Get the force constant corresponding to this distance.
5102 C Calculate the contribution to energy.
5103 ehpb=ehpb+waga*rdis*rdis
5105 C Evaluate gradient.
5108 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
5109 cd & ' waga=',waga,' fac=',fac
5111 ggg(j)=fac*(c(j,jj)-c(j,ii))
5113 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
5114 C If this is a SC-SC distance, we need to calculate the contributions to the
5115 C Cartesian gradient in the SC vectors (ghpbx).
5118 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5119 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5122 cgrad do j=iii,jjj-1
5124 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
5128 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5129 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5136 C--------------------------------------------------------------------------
5137 subroutine ssbond_ene(i,j,eij)
5139 C Calculate the distance and angle dependent SS-bond potential energy
5140 C using a free-energy function derived based on RHF/6-31G** ab initio
5141 C calculations of diethyl disulfide.
5143 C A. Liwo and U. Kozlowska, 11/24/03
5145 implicit real*8 (a-h,o-z)
5146 include 'DIMENSIONS'
5147 include 'COMMON.SBRIDGE'
5148 include 'COMMON.CHAIN'
5149 include 'COMMON.DERIV'
5150 include 'COMMON.LOCAL'
5151 include 'COMMON.INTERACT'
5152 include 'COMMON.VAR'
5153 include 'COMMON.IOUNITS'
5154 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
5155 itypi=iabs(itype(i))
5159 dxi=dc_norm(1,nres+i)
5160 dyi=dc_norm(2,nres+i)
5161 dzi=dc_norm(3,nres+i)
5162 c dsci_inv=dsc_inv(itypi)
5163 dsci_inv=vbld_inv(nres+i)
5164 itypj=iabs(itype(j))
5165 c dscj_inv=dsc_inv(itypj)
5166 dscj_inv=vbld_inv(nres+j)
5170 dxj=dc_norm(1,nres+j)
5171 dyj=dc_norm(2,nres+j)
5172 dzj=dc_norm(3,nres+j)
5173 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5178 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
5179 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
5180 om12=dxi*dxj+dyi*dyj+dzi*dzj
5182 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
5183 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
5189 deltat12=om2-om1+2.0d0
5191 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
5192 & +akct*deltad*deltat12
5193 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
5194 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
5195 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
5196 c & " deltat12",deltat12," eij",eij
5197 ed=2*akcm*deltad+akct*deltat12
5199 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
5200 eom1=-2*akth*deltat1-pom1-om2*pom2
5201 eom2= 2*akth*deltat2+pom1-om1*pom2
5204 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5205 ghpbx(k,i)=ghpbx(k,i)-ggk
5206 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
5207 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
5208 ghpbx(k,j)=ghpbx(k,j)+ggk
5209 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
5210 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
5211 ghpbc(k,i)=ghpbc(k,i)-ggk
5212 ghpbc(k,j)=ghpbc(k,j)+ggk
5215 C Calculate the components of the gradient in DC and X
5219 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
5224 C--------------------------------------------------------------------------
5225 subroutine ebond(estr)
5227 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5229 implicit real*8 (a-h,o-z)
5230 include 'DIMENSIONS'
5231 include 'COMMON.LOCAL'
5232 include 'COMMON.GEO'
5233 include 'COMMON.INTERACT'
5234 include 'COMMON.DERIV'
5235 include 'COMMON.VAR'
5236 include 'COMMON.CHAIN'
5237 include 'COMMON.IOUNITS'
5238 include 'COMMON.NAMES'
5239 include 'COMMON.FFIELD'
5240 include 'COMMON.CONTROL'
5241 include 'COMMON.SETUP'
5242 double precision u(3),ud(3)
5245 do i=ibondp_start,ibondp_end
5246 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
5247 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5249 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
5250 c & *dc(j,i-1)/vbld(i)
5252 c if (energy_dec) write(iout,*)
5253 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5255 C Checking if it involves dummy (NH3+ or COO-) group
5256 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
5257 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
5258 diff = vbld(i)-vbldpDUM
5260 C NO vbldp0 is the equlibrium lenght of spring for peptide group
5261 diff = vbld(i)-vbldp0
5263 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
5264 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5267 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5269 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5272 estr=0.5d0*AKP*estr+estr1
5274 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5276 do i=ibond_start,ibond_end
5278 if (iti.ne.10 .and. iti.ne.ntyp1) then
5281 diff=vbld(i+nres)-vbldsc0(1,iti)
5282 if (energy_dec) write (iout,*)
5283 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
5284 & AKSC(1,iti),AKSC(1,iti)*diff*diff
5285 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5287 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5291 diff=vbld(i+nres)-vbldsc0(j,iti)
5292 ud(j)=aksc(j,iti)*diff
5293 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5307 uprod2=uprod2*u(k)*u(k)
5311 usumsqder=usumsqder+ud(j)*uprod2
5313 estr=estr+uprod/usum
5315 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5323 C--------------------------------------------------------------------------
5324 subroutine ebend(etheta)
5326 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5327 C angles gamma and its derivatives in consecutive thetas and gammas.
5329 implicit real*8 (a-h,o-z)
5330 include 'DIMENSIONS'
5331 include 'COMMON.LOCAL'
5332 include 'COMMON.GEO'
5333 include 'COMMON.INTERACT'
5334 include 'COMMON.DERIV'
5335 include 'COMMON.VAR'
5336 include 'COMMON.CHAIN'
5337 include 'COMMON.IOUNITS'
5338 include 'COMMON.NAMES'
5339 include 'COMMON.FFIELD'
5340 include 'COMMON.CONTROL'
5341 common /calcthet/ term1,term2,termm,diffak,ratak,
5342 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5343 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5344 double precision y(2),z(2)
5346 c time11=dexp(-2*time)
5349 c write (*,'(a,i2)') 'EBEND ICG=',icg
5350 do i=ithet_start,ithet_end
5351 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5352 & .or.itype(i).eq.ntyp1) cycle
5353 C Zero the energy function and its derivative at 0 or pi.
5354 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5356 ichir1=isign(1,itype(i-2))
5357 ichir2=isign(1,itype(i))
5358 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
5359 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
5360 if (itype(i-1).eq.10) then
5361 itype1=isign(10,itype(i-2))
5362 ichir11=isign(1,itype(i-2))
5363 ichir12=isign(1,itype(i-2))
5364 itype2=isign(10,itype(i))
5365 ichir21=isign(1,itype(i))
5366 ichir22=isign(1,itype(i))
5369 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5372 if (phii.ne.phii) phii=150.0
5382 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5385 if (phii1.ne.phii1) phii1=150.0
5397 C Calculate the "mean" value of theta from the part of the distribution
5398 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5399 C In following comments this theta will be referred to as t_c.
5400 thet_pred_mean=0.0d0
5402 athetk=athet(k,it,ichir1,ichir2)
5403 bthetk=bthet(k,it,ichir1,ichir2)
5405 athetk=athet(k,itype1,ichir11,ichir12)
5406 bthetk=bthet(k,itype2,ichir21,ichir22)
5408 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5409 c write(iout,*) 'chuj tu', y(k),z(k)
5411 dthett=thet_pred_mean*ssd
5412 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5413 C Derivatives of the "mean" values in gamma1 and gamma2.
5414 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
5415 &+athet(2,it,ichir1,ichir2)*y(1))*ss
5416 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
5417 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
5419 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
5420 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
5421 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
5422 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5424 if (theta(i).gt.pi-delta) then
5425 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
5427 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5428 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5429 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
5431 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
5433 else if (theta(i).lt.delta) then
5434 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5435 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5436 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
5438 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5439 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
5442 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
5445 etheta=etheta+ethetai
5446 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
5447 & 'ebend',i,ethetai,theta(i),itype(i)
5448 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5449 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5450 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
5452 C Ufff.... We've done all this!!!
5455 C---------------------------------------------------------------------------
5456 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
5458 implicit real*8 (a-h,o-z)
5459 include 'DIMENSIONS'
5460 include 'COMMON.LOCAL'
5461 include 'COMMON.IOUNITS'
5462 common /calcthet/ term1,term2,termm,diffak,ratak,
5463 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5464 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5465 C Calculate the contributions to both Gaussian lobes.
5466 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5467 C The "polynomial part" of the "standard deviation" of this part of
5468 C the distributioni.
5469 ccc write (iout,*) thetai,thet_pred_mean
5472 sig=sig*thet_pred_mean+polthet(j,it)
5474 C Derivative of the "interior part" of the "standard deviation of the"
5475 C gamma-dependent Gaussian lobe in t_c.
5476 sigtc=3*polthet(3,it)
5478 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5481 C Set the parameters of both Gaussian lobes of the distribution.
5482 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5483 fac=sig*sig+sigc0(it)
5486 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5487 sigsqtc=-4.0D0*sigcsq*sigtc
5488 c print *,i,sig,sigtc,sigsqtc
5489 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
5490 sigtc=-sigtc/(fac*fac)
5491 C Following variable is sigma(t_c)**(-2)
5492 sigcsq=sigcsq*sigcsq
5494 sig0inv=1.0D0/sig0i**2
5495 delthec=thetai-thet_pred_mean
5496 delthe0=thetai-theta0i
5497 term1=-0.5D0*sigcsq*delthec*delthec
5498 term2=-0.5D0*sig0inv*delthe0*delthe0
5499 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
5500 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5501 C NaNs in taking the logarithm. We extract the largest exponent which is added
5502 C to the energy (this being the log of the distribution) at the end of energy
5503 C term evaluation for this virtual-bond angle.
5504 if (term1.gt.term2) then
5506 term2=dexp(term2-termm)
5510 term1=dexp(term1-termm)
5513 C The ratio between the gamma-independent and gamma-dependent lobes of
5514 C the distribution is a Gaussian function of thet_pred_mean too.
5515 diffak=gthet(2,it)-thet_pred_mean
5516 ratak=diffak/gthet(3,it)**2
5517 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5518 C Let's differentiate it in thet_pred_mean NOW.
5520 C Now put together the distribution terms to make complete distribution.
5521 termexp=term1+ak*term2
5522 termpre=sigc+ak*sig0i
5523 C Contribution of the bending energy from this theta is just the -log of
5524 C the sum of the contributions from the two lobes and the pre-exponential
5525 C factor. Simple enough, isn't it?
5526 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5527 C write (iout,*) 'termexp',termexp,termm,termpre,i
5528 C NOW the derivatives!!!
5529 C 6/6/97 Take into account the deformation.
5530 E_theta=(delthec*sigcsq*term1
5531 & +ak*delthe0*sig0inv*term2)/termexp
5532 E_tc=((sigtc+aktc*sig0i)/termpre
5533 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
5534 & aktc*term2)/termexp)
5537 c-----------------------------------------------------------------------------
5538 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
5539 implicit real*8 (a-h,o-z)
5540 include 'DIMENSIONS'
5541 include 'COMMON.LOCAL'
5542 include 'COMMON.IOUNITS'
5543 common /calcthet/ term1,term2,termm,diffak,ratak,
5544 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5545 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5546 delthec=thetai-thet_pred_mean
5547 delthe0=thetai-theta0i
5548 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
5549 t3 = thetai-thet_pred_mean
5553 t14 = t12+t6*sigsqtc
5555 t21 = thetai-theta0i
5561 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
5562 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
5563 & *(-t12*t9-ak*sig0inv*t27)
5567 C--------------------------------------------------------------------------
5568 subroutine ebend(etheta)
5570 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5571 C angles gamma and its derivatives in consecutive thetas and gammas.
5572 C ab initio-derived potentials from
5573 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5575 implicit real*8 (a-h,o-z)
5576 include 'DIMENSIONS'
5577 include 'COMMON.LOCAL'
5578 include 'COMMON.GEO'
5579 include 'COMMON.INTERACT'
5580 include 'COMMON.DERIV'
5581 include 'COMMON.VAR'
5582 include 'COMMON.CHAIN'
5583 include 'COMMON.IOUNITS'
5584 include 'COMMON.NAMES'
5585 include 'COMMON.FFIELD'
5586 include 'COMMON.CONTROL'
5587 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
5588 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
5589 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
5590 & sinph1ph2(maxdouble,maxdouble)
5591 logical lprn /.false./, lprn1 /.false./
5593 do i=ithet_start,ithet_end
5594 c print *,i,itype(i-1),itype(i),itype(i-2)
5595 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5596 & .or.itype(i).eq.ntyp1) cycle
5597 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
5599 if (iabs(itype(i+1)).eq.20) iblock=2
5600 if (iabs(itype(i+1)).ne.20) iblock=1
5604 theti2=0.5d0*theta(i)
5605 ityp2=ithetyp((itype(i-1)))
5607 coskt(k)=dcos(k*theti2)
5608 sinkt(k)=dsin(k*theti2)
5610 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5613 if (phii.ne.phii) phii=150.0
5617 ityp1=ithetyp((itype(i-2)))
5618 C propagation of chirality for glycine type
5620 cosph1(k)=dcos(k*phii)
5621 sinph1(k)=dsin(k*phii)
5631 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5634 if (phii1.ne.phii1) phii1=150.0
5639 ityp3=ithetyp((itype(i)))
5641 cosph2(k)=dcos(k*phii1)
5642 sinph2(k)=dsin(k*phii1)
5652 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5655 ccl=cosph1(l)*cosph2(k-l)
5656 ssl=sinph1(l)*sinph2(k-l)
5657 scl=sinph1(l)*cosph2(k-l)
5658 csl=cosph1(l)*sinph2(k-l)
5659 cosph1ph2(l,k)=ccl-ssl
5660 cosph1ph2(k,l)=ccl+ssl
5661 sinph1ph2(l,k)=scl+csl
5662 sinph1ph2(k,l)=scl-csl
5666 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5667 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5668 write (iout,*) "coskt and sinkt"
5670 write (iout,*) k,coskt(k),sinkt(k)
5674 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5675 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5678 & write (iout,*) "k",k,"
5679 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
5680 & " ethetai",ethetai
5683 write (iout,*) "cosph and sinph"
5685 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5687 write (iout,*) "cosph1ph2 and sinph2ph2"
5690 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5691 & sinph1ph2(l,k),sinph1ph2(k,l)
5694 write(iout,*) "ethetai",ethetai
5698 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5699 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5700 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5701 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5702 ethetai=ethetai+sinkt(m)*aux
5703 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5704 dephii=dephii+k*sinkt(m)*(
5705 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5706 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5707 dephii1=dephii1+k*sinkt(m)*(
5708 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5709 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5711 & write (iout,*) "m",m," k",k," bbthet",
5712 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5713 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5714 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5715 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5719 & write(iout,*) "ethetai",ethetai
5723 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5724 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5725 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5726 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5727 ethetai=ethetai+sinkt(m)*aux
5728 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5729 dephii=dephii+l*sinkt(m)*(
5730 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5731 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5732 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5733 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5734 dephii1=dephii1+(k-l)*sinkt(m)*(
5735 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5736 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5737 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5738 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5740 write (iout,*) "m",m," k",k," l",l," ffthet",
5741 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5742 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5743 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5744 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5745 & " ethetai",ethetai
5746 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5747 & cosph1ph2(k,l)*sinkt(m),
5748 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5756 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5757 & i,theta(i)*rad2deg,phii*rad2deg,
5758 & phii1*rad2deg,ethetai
5760 etheta=etheta+ethetai
5761 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5762 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5763 gloc(nphi+i-2,icg)=wang*dethetai+gloc(nphi+i-2,icg)
5769 c-----------------------------------------------------------------------------
5770 subroutine esc(escloc)
5771 C Calculate the local energy of a side chain and its derivatives in the
5772 C corresponding virtual-bond valence angles THETA and the spherical angles
5774 implicit real*8 (a-h,o-z)
5775 include 'DIMENSIONS'
5776 include 'COMMON.GEO'
5777 include 'COMMON.LOCAL'
5778 include 'COMMON.VAR'
5779 include 'COMMON.INTERACT'
5780 include 'COMMON.DERIV'
5781 include 'COMMON.CHAIN'
5782 include 'COMMON.IOUNITS'
5783 include 'COMMON.NAMES'
5784 include 'COMMON.FFIELD'
5785 include 'COMMON.CONTROL'
5786 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5787 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5788 common /sccalc/ time11,time12,time112,theti,it,nlobit
5791 c write (iout,'(a)') 'ESC'
5792 do i=loc_start,loc_end
5794 if (it.eq.ntyp1) cycle
5795 if (it.eq.10) goto 1
5796 nlobit=nlob(iabs(it))
5797 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5798 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5799 theti=theta(i+1)-pipol
5804 if (x(2).gt.pi-delta) then
5808 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5810 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5811 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5813 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5814 & ddersc0(1),dersc(1))
5815 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5816 & ddersc0(3),dersc(3))
5818 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5820 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5821 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5822 & dersc0(2),esclocbi,dersc02)
5823 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5825 call splinthet(x(2),0.5d0*delta,ss,ssd)
5830 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5832 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5833 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5835 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5837 c write (iout,*) escloci
5838 else if (x(2).lt.delta) then
5842 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5844 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5845 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5847 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5848 & ddersc0(1),dersc(1))
5849 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5850 & ddersc0(3),dersc(3))
5852 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5854 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5855 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5856 & dersc0(2),esclocbi,dersc02)
5857 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5862 call splinthet(x(2),0.5d0*delta,ss,ssd)
5864 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5866 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5867 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5869 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5870 c write (iout,*) escloci
5872 call enesc(x,escloci,dersc,ddummy,.false.)
5875 escloc=escloc+escloci
5876 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5877 & 'escloc',i,escloci
5878 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5880 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5882 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5883 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5888 C---------------------------------------------------------------------------
5889 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5890 implicit real*8 (a-h,o-z)
5891 include 'DIMENSIONS'
5892 include 'COMMON.GEO'
5893 include 'COMMON.LOCAL'
5894 include 'COMMON.IOUNITS'
5895 common /sccalc/ time11,time12,time112,theti,it,nlobit
5896 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5897 double precision contr(maxlob,-1:1)
5899 c write (iout,*) 'it=',it,' nlobit=',nlobit
5903 if (mixed) ddersc(j)=0.0d0
5907 C Because of periodicity of the dependence of the SC energy in omega we have
5908 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5909 C To avoid underflows, first compute & store the exponents.
5917 z(k)=x(k)-censc(k,j,it)
5922 Axk=Axk+gaussc(l,k,j,it)*z(l)
5928 expfac=expfac+Ax(k,j,iii)*z(k)
5936 C As in the case of ebend, we want to avoid underflows in exponentiation and
5937 C subsequent NaNs and INFs in energy calculation.
5938 C Find the largest exponent
5942 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
5946 cd print *,'it=',it,' emin=',emin
5948 C Compute the contribution to SC energy and derivatives
5953 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
5954 if(adexp.ne.adexp) adexp=1.0
5957 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
5959 cd print *,'j=',j,' expfac=',expfac
5960 escloc_i=escloc_i+expfac
5962 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
5966 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
5967 & +gaussc(k,2,j,it))*expfac
5974 dersc(1)=dersc(1)/cos(theti)**2
5975 ddersc(1)=ddersc(1)/cos(theti)**2
5978 escloci=-(dlog(escloc_i)-emin)
5980 dersc(j)=dersc(j)/escloc_i
5984 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
5989 C------------------------------------------------------------------------------
5990 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
5991 implicit real*8 (a-h,o-z)
5992 include 'DIMENSIONS'
5993 include 'COMMON.GEO'
5994 include 'COMMON.LOCAL'
5995 include 'COMMON.IOUNITS'
5996 common /sccalc/ time11,time12,time112,theti,it,nlobit
5997 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
5998 double precision contr(maxlob)
6009 z(k)=x(k)-censc(k,j,it)
6015 Axk=Axk+gaussc(l,k,j,it)*z(l)
6021 expfac=expfac+Ax(k,j)*z(k)
6026 C As in the case of ebend, we want to avoid underflows in exponentiation and
6027 C subsequent NaNs and INFs in energy calculation.
6028 C Find the largest exponent
6031 if (emin.gt.contr(j)) emin=contr(j)
6035 C Compute the contribution to SC energy and derivatives
6039 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6040 escloc_i=escloc_i+expfac
6042 dersc(k)=dersc(k)+Ax(k,j)*expfac
6044 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
6045 & +gaussc(1,2,j,it))*expfac
6049 dersc(1)=dersc(1)/cos(theti)**2
6050 dersc12=dersc12/cos(theti)**2
6051 escloci=-(dlog(escloc_i)-emin)
6053 dersc(j)=dersc(j)/escloc_i
6055 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6059 c----------------------------------------------------------------------------------
6060 subroutine esc(escloc)
6061 C Calculate the local energy of a side chain and its derivatives in the
6062 C corresponding virtual-bond valence angles THETA and the spherical angles
6063 C ALPHA and OMEGA derived from AM1 all-atom calculations.
6064 C added by Urszula Kozlowska. 07/11/2007
6066 implicit real*8 (a-h,o-z)
6067 include 'DIMENSIONS'
6068 include 'COMMON.GEO'
6069 include 'COMMON.LOCAL'
6070 include 'COMMON.VAR'
6071 include 'COMMON.SCROT'
6072 include 'COMMON.INTERACT'
6073 include 'COMMON.DERIV'
6074 include 'COMMON.CHAIN'
6075 include 'COMMON.IOUNITS'
6076 include 'COMMON.NAMES'
6077 include 'COMMON.FFIELD'
6078 include 'COMMON.CONTROL'
6079 include 'COMMON.VECTORS'
6080 double precision x_prime(3),y_prime(3),z_prime(3)
6081 & , sumene,dsc_i,dp2_i,x(65),
6082 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
6083 & de_dxx,de_dyy,de_dzz,de_dt
6084 double precision s1_t,s1_6_t,s2_t,s2_6_t
6086 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
6087 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
6088 & dt_dCi(3),dt_dCi1(3)
6089 common /sccalc/ time11,time12,time112,theti,it,nlobit
6092 do i=loc_start,loc_end
6093 if (itype(i).eq.ntyp1) cycle
6094 costtab(i+1) =dcos(theta(i+1))
6095 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6096 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6097 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6098 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6099 cosfac=dsqrt(cosfac2)
6100 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6101 sinfac=dsqrt(sinfac2)
6103 if (it.eq.10) goto 1
6105 C Compute the axes of tghe local cartesian coordinates system; store in
6106 c x_prime, y_prime and z_prime
6113 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6114 C & dc_norm(3,i+nres)
6116 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6117 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6120 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
6123 c write (2,*) "x_prime",(x_prime(j),j=1,3)
6124 c write (2,*) "y_prime",(y_prime(j),j=1,3)
6125 c write (2,*) "z_prime",(z_prime(j),j=1,3)
6126 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6127 c & " xy",scalar(x_prime(1),y_prime(1)),
6128 c & " xz",scalar(x_prime(1),z_prime(1)),
6129 c & " yy",scalar(y_prime(1),y_prime(1)),
6130 c & " yz",scalar(y_prime(1),z_prime(1)),
6131 c & " zz",scalar(z_prime(1),z_prime(1))
6133 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6134 C to local coordinate system. Store in xx, yy, zz.
6140 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6141 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6142 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6149 C Compute the energy of the ith side cbain
6151 c write (2,*) "xx",xx," yy",yy," zz",zz
6154 x(j) = sc_parmin(j,it)
6157 Cc diagnostics - remove later
6159 yy1 = dsin(alph(2))*dcos(omeg(2))
6160 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
6161 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
6162 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
6164 C," --- ", xx_w,yy_w,zz_w
6167 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6168 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6170 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6171 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6173 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6174 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6175 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6176 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6177 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6179 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6180 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6181 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6182 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6183 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6185 dsc_i = 0.743d0+x(61)
6187 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6188 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6189 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6190 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6191 s1=(1+x(63))/(0.1d0 + dscp1)
6192 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6193 s2=(1+x(65))/(0.1d0 + dscp2)
6194 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6195 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
6196 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6197 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6199 c & dscp1,dscp2,sumene
6200 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6201 escloc = escloc + sumene
6202 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
6207 C This section to check the numerical derivatives of the energy of ith side
6208 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6209 C #define DEBUG in the code to turn it on.
6211 write (2,*) "sumene =",sumene
6215 write (2,*) xx,yy,zz
6216 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6217 de_dxx_num=(sumenep-sumene)/aincr
6219 write (2,*) "xx+ sumene from enesc=",sumenep
6222 write (2,*) xx,yy,zz
6223 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6224 de_dyy_num=(sumenep-sumene)/aincr
6226 write (2,*) "yy+ sumene from enesc=",sumenep
6229 write (2,*) xx,yy,zz
6230 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6231 de_dzz_num=(sumenep-sumene)/aincr
6233 write (2,*) "zz+ sumene from enesc=",sumenep
6234 costsave=cost2tab(i+1)
6235 sintsave=sint2tab(i+1)
6236 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6237 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6238 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6239 de_dt_num=(sumenep-sumene)/aincr
6240 write (2,*) " t+ sumene from enesc=",sumenep
6241 cost2tab(i+1)=costsave
6242 sint2tab(i+1)=sintsave
6243 C End of diagnostics section.
6246 C Compute the gradient of esc
6248 c zz=zz*dsign(1.0,dfloat(itype(i)))
6249 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6250 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6251 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6252 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6253 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6254 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6255 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6256 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6257 pom1=(sumene3*sint2tab(i+1)+sumene1)
6258 & *(pom_s1/dscp1+pom_s16*dscp1**4)
6259 pom2=(sumene4*cost2tab(i+1)+sumene2)
6260 & *(pom_s2/dscp2+pom_s26*dscp2**4)
6261 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6262 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
6263 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
6265 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6266 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
6267 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
6269 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
6270 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
6271 & +(pom1+pom2)*pom_dx
6273 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
6276 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6277 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
6278 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
6280 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6281 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
6282 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
6283 & +x(59)*zz**2 +x(60)*xx*zz
6284 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
6285 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
6286 & +(pom1-pom2)*pom_dy
6288 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
6291 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
6292 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
6293 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
6294 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
6295 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
6296 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
6297 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
6298 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6300 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
6303 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
6304 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
6305 & +pom1*pom_dt1+pom2*pom_dt2
6307 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
6312 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6313 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6314 cosfac2xx=cosfac2*xx
6315 sinfac2yy=sinfac2*yy
6317 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
6319 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
6321 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6322 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6323 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6324 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6325 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6326 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6327 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6328 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6329 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6330 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6334 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
6335 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6336 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
6337 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6340 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6341 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6342 dZZ_XYZ(k)=vbld_inv(i+nres)*
6343 & (z_prime(k)-zz*dC_norm(k,i+nres))
6345 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6346 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6350 dXX_Ctab(k,i)=dXX_Ci(k)
6351 dXX_C1tab(k,i)=dXX_Ci1(k)
6352 dYY_Ctab(k,i)=dYY_Ci(k)
6353 dYY_C1tab(k,i)=dYY_Ci1(k)
6354 dZZ_Ctab(k,i)=dZZ_Ci(k)
6355 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6356 dXX_XYZtab(k,i)=dXX_XYZ(k)
6357 dYY_XYZtab(k,i)=dYY_XYZ(k)
6358 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6362 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6363 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6364 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6365 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
6366 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6368 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6369 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6370 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
6371 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6372 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
6373 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6374 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
6375 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6377 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6378 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6380 C to check gradient call subroutine check_grad
6386 c------------------------------------------------------------------------------
6387 double precision function enesc(x,xx,yy,zz,cost2,sint2)
6389 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
6390 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
6391 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6392 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6394 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6395 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6397 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6398 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6399 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6400 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6401 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6403 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6404 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6405 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6406 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6407 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6409 dsc_i = 0.743d0+x(61)
6411 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6412 & *(xx*cost2+yy*sint2))
6413 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6414 & *(xx*cost2-yy*sint2))
6415 s1=(1+x(63))/(0.1d0 + dscp1)
6416 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6417 s2=(1+x(65))/(0.1d0 + dscp2)
6418 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6419 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
6420 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
6425 c------------------------------------------------------------------------------
6426 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6428 C This procedure calculates two-body contact function g(rij) and its derivative:
6431 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6434 C where x=(rij-r0ij)/delta
6436 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6439 double precision rij,r0ij,eps0ij,fcont,fprimcont
6440 double precision x,x2,x4,delta
6444 if (x.lt.-1.0D0) then
6447 else if (x.le.1.0D0) then
6450 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6451 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6458 c------------------------------------------------------------------------------
6459 subroutine splinthet(theti,delta,ss,ssder)
6460 implicit real*8 (a-h,o-z)
6461 include 'DIMENSIONS'
6462 include 'COMMON.VAR'
6463 include 'COMMON.GEO'
6466 if (theti.gt.pipol) then
6467 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6469 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6474 c------------------------------------------------------------------------------
6475 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6477 double precision x,x0,delta,f0,f1,fprim0,f,fprim
6478 double precision ksi,ksi2,ksi3,a1,a2,a3
6479 a1=fprim0*delta/(f1-f0)
6485 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6486 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6489 c------------------------------------------------------------------------------
6490 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6492 double precision x,x0,delta,f0x,f1x,fprim0x,fx
6493 double precision ksi,ksi2,ksi3,a1,a2,a3
6498 a2=3*(f1x-f0x)-2*fprim0x*delta
6499 a3=fprim0x*delta-2*(f1x-f0x)
6500 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6503 C-----------------------------------------------------------------------------
6505 C-----------------------------------------------------------------------------
6506 subroutine etor(etors,edihcnstr)
6507 implicit real*8 (a-h,o-z)
6508 include 'DIMENSIONS'
6509 include 'COMMON.VAR'
6510 include 'COMMON.GEO'
6511 include 'COMMON.LOCAL'
6512 include 'COMMON.TORSION'
6513 include 'COMMON.INTERACT'
6514 include 'COMMON.DERIV'
6515 include 'COMMON.CHAIN'
6516 include 'COMMON.NAMES'
6517 include 'COMMON.IOUNITS'
6518 include 'COMMON.FFIELD'
6519 include 'COMMON.TORCNSTR'
6520 include 'COMMON.CONTROL'
6522 C Set lprn=.true. for debugging
6526 do i=iphi_start,iphi_end
6528 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6529 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6530 itori=itortyp(itype(i-2))
6531 itori1=itortyp(itype(i-1))
6534 C Proline-Proline pair is a special case...
6535 if (itori.eq.3 .and. itori1.eq.3) then
6536 if (phii.gt.-dwapi3) then
6538 fac=1.0D0/(1.0D0-cosphi)
6539 etorsi=v1(1,3,3)*fac
6540 etorsi=etorsi+etorsi
6541 etors=etors+etorsi-v1(1,3,3)
6542 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
6543 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6546 v1ij=v1(j+1,itori,itori1)
6547 v2ij=v2(j+1,itori,itori1)
6550 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6551 if (energy_dec) etors_ii=etors_ii+
6552 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6553 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6557 v1ij=v1(j,itori,itori1)
6558 v2ij=v2(j,itori,itori1)
6561 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6562 if (energy_dec) etors_ii=etors_ii+
6563 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6564 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6567 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6570 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6571 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6572 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6573 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6574 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6576 ! 6/20/98 - dihedral angle constraints
6579 itori=idih_constr(i)
6582 if (difi.gt.drange(i)) then
6584 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6585 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6586 else if (difi.lt.-drange(i)) then
6588 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6589 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6591 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6592 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6594 ! write (iout,*) 'edihcnstr',edihcnstr
6597 c------------------------------------------------------------------------------
6598 subroutine etor_d(etors_d)
6602 c----------------------------------------------------------------------------
6604 subroutine etor(etors,edihcnstr)
6605 implicit real*8 (a-h,o-z)
6606 include 'DIMENSIONS'
6607 include 'COMMON.VAR'
6608 include 'COMMON.GEO'
6609 include 'COMMON.LOCAL'
6610 include 'COMMON.TORSION'
6611 include 'COMMON.INTERACT'
6612 include 'COMMON.DERIV'
6613 include 'COMMON.CHAIN'
6614 include 'COMMON.NAMES'
6615 include 'COMMON.IOUNITS'
6616 include 'COMMON.FFIELD'
6617 include 'COMMON.TORCNSTR'
6618 include 'COMMON.CONTROL'
6620 C Set lprn=.true. for debugging
6624 do i=iphi_start,iphi_end
6625 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6626 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6627 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
6628 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
6629 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6630 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6631 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6632 C For introducing the NH3+ and COO- group please check the etor_d for reference
6635 if (iabs(itype(i)).eq.20) then
6640 itori=itortyp(itype(i-2))
6641 itori1=itortyp(itype(i-1))
6644 C Regular cosine and sine terms
6645 do j=1,nterm(itori,itori1,iblock)
6646 v1ij=v1(j,itori,itori1,iblock)
6647 v2ij=v2(j,itori,itori1,iblock)
6650 etors=etors+v1ij*cosphi+v2ij*sinphi
6651 if (energy_dec) etors_ii=etors_ii+
6652 & v1ij*cosphi+v2ij*sinphi
6653 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6657 C E = SUM ----------------------------------- - v1
6658 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6660 cosphi=dcos(0.5d0*phii)
6661 sinphi=dsin(0.5d0*phii)
6662 do j=1,nlor(itori,itori1,iblock)
6663 vl1ij=vlor1(j,itori,itori1)
6664 vl2ij=vlor2(j,itori,itori1)
6665 vl3ij=vlor3(j,itori,itori1)
6666 pom=vl2ij*cosphi+vl3ij*sinphi
6667 pom1=1.0d0/(pom*pom+1.0d0)
6668 etors=etors+vl1ij*pom1
6669 if (energy_dec) etors_ii=etors_ii+
6672 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6674 C Subtract the constant term
6675 etors=etors-v0(itori,itori1,iblock)
6676 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6677 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
6679 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6680 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6681 & (v1(j,itori,itori1,iblock),j=1,6),
6682 & (v2(j,itori,itori1,iblock),j=1,6)
6683 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6684 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6686 ! 6/20/98 - dihedral angle constraints
6688 c do i=1,ndih_constr
6689 do i=idihconstr_start,idihconstr_end
6690 itori=idih_constr(i)
6692 difi=pinorm(phii-phi0(i))
6693 if (difi.gt.drange(i)) then
6695 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6696 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6697 else if (difi.lt.-drange(i)) then
6699 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6700 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6704 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6705 cd & rad2deg*phi0(i), rad2deg*drange(i),
6706 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6708 cd write (iout,*) 'edihcnstr',edihcnstr
6711 c----------------------------------------------------------------------------
6712 subroutine etor_d(etors_d)
6713 C 6/23/01 Compute double torsional energy
6714 implicit real*8 (a-h,o-z)
6715 include 'DIMENSIONS'
6716 include 'COMMON.VAR'
6717 include 'COMMON.GEO'
6718 include 'COMMON.LOCAL'
6719 include 'COMMON.TORSION'
6720 include 'COMMON.INTERACT'
6721 include 'COMMON.DERIV'
6722 include 'COMMON.CHAIN'
6723 include 'COMMON.NAMES'
6724 include 'COMMON.IOUNITS'
6725 include 'COMMON.FFIELD'
6726 include 'COMMON.TORCNSTR'
6728 C Set lprn=.true. for debugging
6732 c write(iout,*) "a tu??"
6733 do i=iphid_start,iphid_end
6734 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6735 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6736 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
6737 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
6738 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
6739 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
6740 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
6741 & (itype(i+1).eq.ntyp1)) cycle
6742 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6743 itori=itortyp(itype(i-2))
6744 itori1=itortyp(itype(i-1))
6745 itori2=itortyp(itype(i))
6751 if (iabs(itype(i+1)).eq.20) iblock=2
6752 C Iblock=2 Proline type
6753 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
6754 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
6755 C if (itype(i+1).eq.ntyp1) iblock=3
6756 C The problem of NH3+ group can be resolved by adding new parameters please note if there
6757 C IS or IS NOT need for this
6758 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
6759 C is (itype(i-3).eq.ntyp1) ntblock=2
6760 C ntblock is N-terminal blocking group
6762 C Regular cosine and sine terms
6763 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6764 C Example of changes for NH3+ blocking group
6765 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
6766 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
6767 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6768 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6769 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6770 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6771 cosphi1=dcos(j*phii)
6772 sinphi1=dsin(j*phii)
6773 cosphi2=dcos(j*phii1)
6774 sinphi2=dsin(j*phii1)
6775 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6776 & v2cij*cosphi2+v2sij*sinphi2
6777 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6778 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6780 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6782 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6783 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6784 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6785 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6786 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6787 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6788 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6789 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6790 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6791 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6792 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6793 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6794 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6795 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6798 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6799 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6804 c------------------------------------------------------------------------------
6805 subroutine eback_sc_corr(esccor)
6806 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6807 c conformational states; temporarily implemented as differences
6808 c between UNRES torsional potentials (dependent on three types of
6809 c residues) and the torsional potentials dependent on all 20 types
6810 c of residues computed from AM1 energy surfaces of terminally-blocked
6811 c amino-acid residues.
6812 implicit real*8 (a-h,o-z)
6813 include 'DIMENSIONS'
6814 include 'COMMON.VAR'
6815 include 'COMMON.GEO'
6816 include 'COMMON.LOCAL'
6817 include 'COMMON.TORSION'
6818 include 'COMMON.SCCOR'
6819 include 'COMMON.INTERACT'
6820 include 'COMMON.DERIV'
6821 include 'COMMON.CHAIN'
6822 include 'COMMON.NAMES'
6823 include 'COMMON.IOUNITS'
6824 include 'COMMON.FFIELD'
6825 include 'COMMON.CONTROL'
6827 C Set lprn=.true. for debugging
6830 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
6832 do i=itau_start,itau_end
6833 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6835 isccori=isccortyp(itype(i-2))
6836 isccori1=isccortyp(itype(i-1))
6837 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
6839 do intertyp=1,3 !intertyp
6840 cc Added 09 May 2012 (Adasko)
6841 cc Intertyp means interaction type of backbone mainchain correlation:
6842 c 1 = SC...Ca...Ca...Ca
6843 c 2 = Ca...Ca...Ca...SC
6844 c 3 = SC...Ca...Ca...SCi
6846 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6847 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6848 & (itype(i-1).eq.ntyp1)))
6849 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6850 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6851 & .or.(itype(i).eq.ntyp1)))
6852 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6853 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6854 & (itype(i-3).eq.ntyp1)))) cycle
6855 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6856 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6858 do j=1,nterm_sccor(isccori,isccori1)
6859 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6860 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6861 cosphi=dcos(j*tauangle(intertyp,i))
6862 sinphi=dsin(j*tauangle(intertyp,i))
6863 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6864 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6866 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
6867 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6869 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6870 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
6871 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
6872 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
6873 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6879 c----------------------------------------------------------------------------
6880 subroutine multibody(ecorr)
6881 C This subroutine calculates multi-body contributions to energy following
6882 C the idea of Skolnick et al. If side chains I and J make a contact and
6883 C at the same time side chains I+1 and J+1 make a contact, an extra
6884 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6885 implicit real*8 (a-h,o-z)
6886 include 'DIMENSIONS'
6887 include 'COMMON.IOUNITS'
6888 include 'COMMON.DERIV'
6889 include 'COMMON.INTERACT'
6890 include 'COMMON.CONTACTS'
6891 double precision gx(3),gx1(3)
6894 C Set lprn=.true. for debugging
6898 write (iout,'(a)') 'Contact function values:'
6900 write (iout,'(i2,20(1x,i2,f10.5))')
6901 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6916 num_conti=num_cont(i)
6917 num_conti1=num_cont(i1)
6922 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6923 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6924 cd & ' ishift=',ishift
6925 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6926 C The system gains extra energy.
6927 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6928 endif ! j1==j+-ishift
6937 c------------------------------------------------------------------------------
6938 double precision function esccorr(i,j,k,l,jj,kk)
6939 implicit real*8 (a-h,o-z)
6940 include 'DIMENSIONS'
6941 include 'COMMON.IOUNITS'
6942 include 'COMMON.DERIV'
6943 include 'COMMON.INTERACT'
6944 include 'COMMON.CONTACTS'
6945 double precision gx(3),gx1(3)
6950 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
6951 C Calculate the multi-body contribution to energy.
6952 C Calculate multi-body contributions to the gradient.
6953 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
6954 cd & k,l,(gacont(m,kk,k),m=1,3)
6956 gx(m) =ekl*gacont(m,jj,i)
6957 gx1(m)=eij*gacont(m,kk,k)
6958 gradxorr(m,i)=gradxorr(m,i)-gx(m)
6959 gradxorr(m,j)=gradxorr(m,j)+gx(m)
6960 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
6961 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
6965 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
6970 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
6976 c------------------------------------------------------------------------------
6977 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
6978 C This subroutine calculates multi-body contributions to hydrogen-bonding
6979 implicit real*8 (a-h,o-z)
6980 include 'DIMENSIONS'
6981 include 'COMMON.IOUNITS'
6984 parameter (max_cont=maxconts)
6985 parameter (max_dim=26)
6986 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
6987 double precision zapas(max_dim,maxconts,max_fg_procs),
6988 & zapas_recv(max_dim,maxconts,max_fg_procs)
6989 common /przechowalnia/ zapas
6990 integer status(MPI_STATUS_SIZE),req(maxconts*2),
6991 & status_array(MPI_STATUS_SIZE,maxconts*2)
6993 include 'COMMON.SETUP'
6994 include 'COMMON.FFIELD'
6995 include 'COMMON.DERIV'
6996 include 'COMMON.INTERACT'
6997 include 'COMMON.CONTACTS'
6998 include 'COMMON.CONTROL'
6999 include 'COMMON.LOCAL'
7000 double precision gx(3),gx1(3),time00
7003 C Set lprn=.true. for debugging
7008 if (nfgtasks.le.1) goto 30
7010 write (iout,'(a)') 'Contact function values before RECEIVE:'
7012 write (iout,'(2i3,50(1x,i2,f5.2))')
7013 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7014 & j=1,num_cont_hb(i))
7018 do i=1,ntask_cont_from
7021 do i=1,ntask_cont_to
7024 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7026 C Make the list of contacts to send to send to other procesors
7027 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
7029 do i=iturn3_start,iturn3_end
7030 c write (iout,*) "make contact list turn3",i," num_cont",
7032 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
7034 do i=iturn4_start,iturn4_end
7035 c write (iout,*) "make contact list turn4",i," num_cont",
7037 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
7041 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7043 do j=1,num_cont_hb(i)
7046 iproc=iint_sent_local(k,jjc,ii)
7047 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7048 if (iproc.gt.0) then
7049 ncont_sent(iproc)=ncont_sent(iproc)+1
7050 nn=ncont_sent(iproc)
7052 zapas(2,nn,iproc)=jjc
7053 zapas(3,nn,iproc)=facont_hb(j,i)
7054 zapas(4,nn,iproc)=ees0p(j,i)
7055 zapas(5,nn,iproc)=ees0m(j,i)
7056 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
7057 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
7058 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
7059 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
7060 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
7061 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
7062 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
7063 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
7064 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
7065 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
7066 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
7067 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
7068 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
7069 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
7070 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
7071 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
7072 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
7073 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
7074 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
7075 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
7076 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
7083 & "Numbers of contacts to be sent to other processors",
7084 & (ncont_sent(i),i=1,ntask_cont_to)
7085 write (iout,*) "Contacts sent"
7086 do ii=1,ntask_cont_to
7088 iproc=itask_cont_to(ii)
7089 write (iout,*) nn," contacts to processor",iproc,
7090 & " of CONT_TO_COMM group"
7092 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7100 CorrelID1=nfgtasks+fg_rank+1
7102 C Receive the numbers of needed contacts from other processors
7103 do ii=1,ntask_cont_from
7104 iproc=itask_cont_from(ii)
7106 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7107 & FG_COMM,req(ireq),IERR)
7109 c write (iout,*) "IRECV ended"
7111 C Send the number of contacts needed by other processors
7112 do ii=1,ntask_cont_to
7113 iproc=itask_cont_to(ii)
7115 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7116 & FG_COMM,req(ireq),IERR)
7118 c write (iout,*) "ISEND ended"
7119 c write (iout,*) "number of requests (nn)",ireq
7122 & call MPI_Waitall(ireq,req,status_array,ierr)
7124 c & "Numbers of contacts to be received from other processors",
7125 c & (ncont_recv(i),i=1,ntask_cont_from)
7129 do ii=1,ntask_cont_from
7130 iproc=itask_cont_from(ii)
7132 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7133 c & " of CONT_TO_COMM group"
7137 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7138 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7139 c write (iout,*) "ireq,req",ireq,req(ireq)
7142 C Send the contacts to processors that need them
7143 do ii=1,ntask_cont_to
7144 iproc=itask_cont_to(ii)
7146 c write (iout,*) nn," contacts to processor",iproc,
7147 c & " of CONT_TO_COMM group"
7150 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7151 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7152 c write (iout,*) "ireq,req",ireq,req(ireq)
7154 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7158 c write (iout,*) "number of requests (contacts)",ireq
7159 c write (iout,*) "req",(req(i),i=1,4)
7162 & call MPI_Waitall(ireq,req,status_array,ierr)
7163 do iii=1,ntask_cont_from
7164 iproc=itask_cont_from(iii)
7167 write (iout,*) "Received",nn," contacts from processor",iproc,
7168 & " of CONT_FROM_COMM group"
7171 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
7176 ii=zapas_recv(1,i,iii)
7177 c Flag the received contacts to prevent double-counting
7178 jj=-zapas_recv(2,i,iii)
7179 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7181 nnn=num_cont_hb(ii)+1
7184 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
7185 ees0p(nnn,ii)=zapas_recv(4,i,iii)
7186 ees0m(nnn,ii)=zapas_recv(5,i,iii)
7187 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
7188 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
7189 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
7190 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
7191 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
7192 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
7193 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
7194 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
7195 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
7196 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
7197 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
7198 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
7199 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
7200 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
7201 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
7202 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
7203 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
7204 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
7205 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
7206 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
7207 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
7212 write (iout,'(a)') 'Contact function values after receive:'
7214 write (iout,'(2i3,50(1x,i3,f5.2))')
7215 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7216 & j=1,num_cont_hb(i))
7223 write (iout,'(a)') 'Contact function values:'
7225 write (iout,'(2i3,50(1x,i3,f5.2))')
7226 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7227 & j=1,num_cont_hb(i))
7231 C Remove the loop below after debugging !!!
7238 C Calculate the local-electrostatic correlation terms
7239 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
7241 num_conti=num_cont_hb(i)
7242 num_conti1=num_cont_hb(i+1)
7249 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7250 c & ' jj=',jj,' kk=',kk
7251 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7252 & .or. j.lt.0 .and. j1.gt.0) .and.
7253 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7254 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7255 C The system gains extra energy.
7256 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7257 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
7258 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
7260 else if (j1.eq.j) then
7261 C Contacts I-J and I-(J+1) occur simultaneously.
7262 C The system loses extra energy.
7263 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7268 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7269 c & ' jj=',jj,' kk=',kk
7271 C Contacts I-J and (I+1)-J occur simultaneously.
7272 C The system loses extra energy.
7273 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7280 c------------------------------------------------------------------------------
7281 subroutine add_hb_contact(ii,jj,itask)
7282 implicit real*8 (a-h,o-z)
7283 include "DIMENSIONS"
7284 include "COMMON.IOUNITS"
7287 parameter (max_cont=maxconts)
7288 parameter (max_dim=26)
7289 include "COMMON.CONTACTS"
7290 double precision zapas(max_dim,maxconts,max_fg_procs),
7291 & zapas_recv(max_dim,maxconts,max_fg_procs)
7292 common /przechowalnia/ zapas
7293 integer i,j,ii,jj,iproc,itask(4),nn
7294 c write (iout,*) "itask",itask
7297 if (iproc.gt.0) then
7298 do j=1,num_cont_hb(ii)
7300 c write (iout,*) "i",ii," j",jj," jjc",jjc
7302 ncont_sent(iproc)=ncont_sent(iproc)+1
7303 nn=ncont_sent(iproc)
7304 zapas(1,nn,iproc)=ii
7305 zapas(2,nn,iproc)=jjc
7306 zapas(3,nn,iproc)=facont_hb(j,ii)
7307 zapas(4,nn,iproc)=ees0p(j,ii)
7308 zapas(5,nn,iproc)=ees0m(j,ii)
7309 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
7310 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
7311 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
7312 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
7313 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
7314 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
7315 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
7316 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
7317 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
7318 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
7319 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
7320 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
7321 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
7322 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
7323 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
7324 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
7325 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
7326 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
7327 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
7328 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
7329 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
7337 c------------------------------------------------------------------------------
7338 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
7340 C This subroutine calculates multi-body contributions to hydrogen-bonding
7341 implicit real*8 (a-h,o-z)
7342 include 'DIMENSIONS'
7343 include 'COMMON.IOUNITS'
7346 parameter (max_cont=maxconts)
7347 parameter (max_dim=70)
7348 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7349 double precision zapas(max_dim,maxconts,max_fg_procs),
7350 & zapas_recv(max_dim,maxconts,max_fg_procs)
7351 common /przechowalnia/ zapas
7352 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7353 & status_array(MPI_STATUS_SIZE,maxconts*2)
7355 include 'COMMON.SETUP'
7356 include 'COMMON.FFIELD'
7357 include 'COMMON.DERIV'
7358 include 'COMMON.LOCAL'
7359 include 'COMMON.INTERACT'
7360 include 'COMMON.CONTACTS'
7361 include 'COMMON.CHAIN'
7362 include 'COMMON.CONTROL'
7363 double precision gx(3),gx1(3)
7364 integer num_cont_hb_old(maxres)
7366 double precision eello4,eello5,eelo6,eello_turn6
7367 external eello4,eello5,eello6,eello_turn6
7368 C Set lprn=.true. for debugging
7373 num_cont_hb_old(i)=num_cont_hb(i)
7377 if (nfgtasks.le.1) goto 30
7379 write (iout,'(a)') 'Contact function values before RECEIVE:'
7381 write (iout,'(2i3,50(1x,i2,f5.2))')
7382 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7383 & j=1,num_cont_hb(i))
7387 do i=1,ntask_cont_from
7390 do i=1,ntask_cont_to
7393 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7395 C Make the list of contacts to send to send to other procesors
7396 do i=iturn3_start,iturn3_end
7397 c write (iout,*) "make contact list turn3",i," num_cont",
7399 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
7401 do i=iturn4_start,iturn4_end
7402 c write (iout,*) "make contact list turn4",i," num_cont",
7404 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
7408 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7410 do j=1,num_cont_hb(i)
7413 iproc=iint_sent_local(k,jjc,ii)
7414 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7415 if (iproc.ne.0) then
7416 ncont_sent(iproc)=ncont_sent(iproc)+1
7417 nn=ncont_sent(iproc)
7419 zapas(2,nn,iproc)=jjc
7420 zapas(3,nn,iproc)=d_cont(j,i)
7424 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
7429 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
7437 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
7448 & "Numbers of contacts to be sent to other processors",
7449 & (ncont_sent(i),i=1,ntask_cont_to)
7450 write (iout,*) "Contacts sent"
7451 do ii=1,ntask_cont_to
7453 iproc=itask_cont_to(ii)
7454 write (iout,*) nn," contacts to processor",iproc,
7455 & " of CONT_TO_COMM group"
7457 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7465 CorrelID1=nfgtasks+fg_rank+1
7467 C Receive the numbers of needed contacts from other processors
7468 do ii=1,ntask_cont_from
7469 iproc=itask_cont_from(ii)
7471 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7472 & FG_COMM,req(ireq),IERR)
7474 c write (iout,*) "IRECV ended"
7476 C Send the number of contacts needed by other processors
7477 do ii=1,ntask_cont_to
7478 iproc=itask_cont_to(ii)
7480 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7481 & FG_COMM,req(ireq),IERR)
7483 c write (iout,*) "ISEND ended"
7484 c write (iout,*) "number of requests (nn)",ireq
7487 & call MPI_Waitall(ireq,req,status_array,ierr)
7489 c & "Numbers of contacts to be received from other processors",
7490 c & (ncont_recv(i),i=1,ntask_cont_from)
7494 do ii=1,ntask_cont_from
7495 iproc=itask_cont_from(ii)
7497 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7498 c & " of CONT_TO_COMM group"
7502 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7503 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7504 c write (iout,*) "ireq,req",ireq,req(ireq)
7507 C Send the contacts to processors that need them
7508 do ii=1,ntask_cont_to
7509 iproc=itask_cont_to(ii)
7511 c write (iout,*) nn," contacts to processor",iproc,
7512 c & " of CONT_TO_COMM group"
7515 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7516 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7517 c write (iout,*) "ireq,req",ireq,req(ireq)
7519 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7523 c write (iout,*) "number of requests (contacts)",ireq
7524 c write (iout,*) "req",(req(i),i=1,4)
7527 & call MPI_Waitall(ireq,req,status_array,ierr)
7528 do iii=1,ntask_cont_from
7529 iproc=itask_cont_from(iii)
7532 write (iout,*) "Received",nn," contacts from processor",iproc,
7533 & " of CONT_FROM_COMM group"
7536 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7541 ii=zapas_recv(1,i,iii)
7542 c Flag the received contacts to prevent double-counting
7543 jj=-zapas_recv(2,i,iii)
7544 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7546 nnn=num_cont_hb(ii)+1
7549 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7553 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7558 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7566 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7575 write (iout,'(a)') 'Contact function values after receive:'
7577 write (iout,'(2i3,50(1x,i3,5f6.3))')
7578 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7579 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7586 write (iout,'(a)') 'Contact function values:'
7588 write (iout,'(2i3,50(1x,i2,5f6.3))')
7589 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7590 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7596 C Remove the loop below after debugging !!!
7603 C Calculate the dipole-dipole interaction energies
7604 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7605 do i=iatel_s,iatel_e+1
7606 num_conti=num_cont_hb(i)
7615 C Calculate the local-electrostatic correlation terms
7616 c write (iout,*) "gradcorr5 in eello5 before loop"
7618 c write (iout,'(i5,3f10.5)')
7619 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7621 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7622 c write (iout,*) "corr loop i",i
7624 num_conti=num_cont_hb(i)
7625 num_conti1=num_cont_hb(i+1)
7632 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7633 c & ' jj=',jj,' kk=',kk
7634 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7635 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7636 & .or. j.lt.0 .and. j1.gt.0) .and.
7637 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7638 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7639 C The system gains extra energy.
7641 sqd1=dsqrt(d_cont(jj,i))
7642 sqd2=dsqrt(d_cont(kk,i1))
7643 sred_geom = sqd1*sqd2
7644 IF (sred_geom.lt.cutoff_corr) THEN
7645 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7647 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7648 cd & ' jj=',jj,' kk=',kk
7649 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7650 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7652 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7653 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7656 cd write (iout,*) 'sred_geom=',sred_geom,
7657 cd & ' ekont=',ekont,' fprim=',fprimcont,
7658 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7659 cd write (iout,*) "g_contij",g_contij
7660 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7661 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7662 call calc_eello(i,jp,i+1,jp1,jj,kk)
7663 if (wcorr4.gt.0.0d0)
7664 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7665 if (energy_dec.and.wcorr4.gt.0.0d0)
7666 1 write (iout,'(a6,4i5,0pf7.3)')
7667 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7668 c write (iout,*) "gradcorr5 before eello5"
7670 c write (iout,'(i5,3f10.5)')
7671 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7673 if (wcorr5.gt.0.0d0)
7674 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7675 c write (iout,*) "gradcorr5 after eello5"
7677 c write (iout,'(i5,3f10.5)')
7678 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7680 if (energy_dec.and.wcorr5.gt.0.0d0)
7681 1 write (iout,'(a6,4i5,0pf7.3)')
7682 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7683 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7684 cd write(2,*)'ijkl',i,jp,i+1,jp1
7685 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7686 & .or. wturn6.eq.0.0d0))then
7687 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7688 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7689 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7690 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7691 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7692 cd & 'ecorr6=',ecorr6
7693 cd write (iout,'(4e15.5)') sred_geom,
7694 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7695 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7696 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7697 else if (wturn6.gt.0.0d0
7698 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7699 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7700 eturn6=eturn6+eello_turn6(i,jj,kk)
7701 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7702 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7703 cd write (2,*) 'multibody_eello:eturn6',eturn6
7712 num_cont_hb(i)=num_cont_hb_old(i)
7714 c write (iout,*) "gradcorr5 in eello5"
7716 c write (iout,'(i5,3f10.5)')
7717 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7721 c------------------------------------------------------------------------------
7722 subroutine add_hb_contact_eello(ii,jj,itask)
7723 implicit real*8 (a-h,o-z)
7724 include "DIMENSIONS"
7725 include "COMMON.IOUNITS"
7728 parameter (max_cont=maxconts)
7729 parameter (max_dim=70)
7730 include "COMMON.CONTACTS"
7731 double precision zapas(max_dim,maxconts,max_fg_procs),
7732 & zapas_recv(max_dim,maxconts,max_fg_procs)
7733 common /przechowalnia/ zapas
7734 integer i,j,ii,jj,iproc,itask(4),nn
7735 c write (iout,*) "itask",itask
7738 if (iproc.gt.0) then
7739 do j=1,num_cont_hb(ii)
7741 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7743 ncont_sent(iproc)=ncont_sent(iproc)+1
7744 nn=ncont_sent(iproc)
7745 zapas(1,nn,iproc)=ii
7746 zapas(2,nn,iproc)=jjc
7747 zapas(3,nn,iproc)=d_cont(j,ii)
7751 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7756 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7764 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7776 c------------------------------------------------------------------------------
7777 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7778 implicit real*8 (a-h,o-z)
7779 include 'DIMENSIONS'
7780 include 'COMMON.IOUNITS'
7781 include 'COMMON.DERIV'
7782 include 'COMMON.INTERACT'
7783 include 'COMMON.CONTACTS'
7784 double precision gx(3),gx1(3)
7794 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7795 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7796 C Following 4 lines for diagnostics.
7801 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7802 c & 'Contacts ',i,j,
7803 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7804 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7806 C Calculate the multi-body contribution to energy.
7807 c ecorr=ecorr+ekont*ees
7808 C Calculate multi-body contributions to the gradient.
7809 coeffpees0pij=coeffp*ees0pij
7810 coeffmees0mij=coeffm*ees0mij
7811 coeffpees0pkl=coeffp*ees0pkl
7812 coeffmees0mkl=coeffm*ees0mkl
7814 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7815 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7816 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7817 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7818 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7819 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7820 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7821 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7822 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7823 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7824 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7825 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7826 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7827 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7828 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7829 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7830 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7831 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7832 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7833 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7834 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7835 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7836 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7837 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7838 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7843 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7844 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7845 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7846 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7851 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7852 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7853 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7854 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7857 c write (iout,*) "ehbcorr",ekont*ees
7862 C---------------------------------------------------------------------------
7863 subroutine dipole(i,j,jj)
7864 implicit real*8 (a-h,o-z)
7865 include 'DIMENSIONS'
7866 include 'COMMON.IOUNITS'
7867 include 'COMMON.CHAIN'
7868 include 'COMMON.FFIELD'
7869 include 'COMMON.DERIV'
7870 include 'COMMON.INTERACT'
7871 include 'COMMON.CONTACTS'
7872 include 'COMMON.TORSION'
7873 include 'COMMON.VAR'
7874 include 'COMMON.GEO'
7875 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7877 iti1 = itortyp(itype(i+1))
7878 if (j.lt.nres-1) then
7879 itj1 = itortyp(itype(j+1))
7884 dipi(iii,1)=Ub2(iii,i)
7885 dipderi(iii)=Ub2der(iii,i)
7886 dipi(iii,2)=b1(iii,i+1)
7887 dipj(iii,1)=Ub2(iii,j)
7888 dipderj(iii)=Ub2der(iii,j)
7889 dipj(iii,2)=b1(iii,j+1)
7893 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7896 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7903 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7907 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7912 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7913 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7915 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7917 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7919 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7924 C---------------------------------------------------------------------------
7925 subroutine calc_eello(i,j,k,l,jj,kk)
7927 C This subroutine computes matrices and vectors needed to calculate
7928 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7930 implicit real*8 (a-h,o-z)
7931 include 'DIMENSIONS'
7932 include 'COMMON.IOUNITS'
7933 include 'COMMON.CHAIN'
7934 include 'COMMON.DERIV'
7935 include 'COMMON.INTERACT'
7936 include 'COMMON.CONTACTS'
7937 include 'COMMON.TORSION'
7938 include 'COMMON.VAR'
7939 include 'COMMON.GEO'
7940 include 'COMMON.FFIELD'
7941 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
7942 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
7945 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
7946 cd & ' jj=',jj,' kk=',kk
7947 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
7948 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
7949 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
7952 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
7953 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
7956 call transpose2(aa1(1,1),aa1t(1,1))
7957 call transpose2(aa2(1,1),aa2t(1,1))
7960 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
7961 & aa1tder(1,1,lll,kkk))
7962 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
7963 & aa2tder(1,1,lll,kkk))
7967 C parallel orientation of the two CA-CA-CA frames.
7969 iti=itortyp(itype(i))
7973 itk1=itortyp(itype(k+1))
7974 itj=itortyp(itype(j))
7975 if (l.lt.nres-1) then
7976 itl1=itortyp(itype(l+1))
7980 C A1 kernel(j+1) A2T
7982 cd write (iout,'(3f10.5,5x,3f10.5)')
7983 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
7985 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7986 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
7987 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
7988 C Following matrices are needed only for 6-th order cumulants
7989 IF (wcorr6.gt.0.0d0) THEN
7990 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7991 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
7992 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
7993 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7994 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
7995 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
7996 & ADtEAderx(1,1,1,1,1,1))
7998 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
7999 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
8000 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8001 & ADtEA1derx(1,1,1,1,1,1))
8003 C End 6-th order cumulants
8006 cd write (2,*) 'In calc_eello6'
8008 cd write (2,*) 'iii=',iii
8010 cd write (2,*) 'kkk=',kkk
8012 cd write (2,'(3(2f10.5),5x)')
8013 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8018 call transpose2(EUgder(1,1,k),auxmat(1,1))
8019 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8020 call transpose2(EUg(1,1,k),auxmat(1,1))
8021 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8022 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8026 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8027 & EAEAderx(1,1,lll,kkk,iii,1))
8031 C A1T kernel(i+1) A2
8032 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8033 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
8034 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8035 C Following matrices are needed only for 6-th order cumulants
8036 IF (wcorr6.gt.0.0d0) THEN
8037 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8038 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
8039 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8040 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8041 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
8042 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8043 & ADtEAderx(1,1,1,1,1,2))
8044 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8045 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
8046 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8047 & ADtEA1derx(1,1,1,1,1,2))
8049 C End 6-th order cumulants
8050 call transpose2(EUgder(1,1,l),auxmat(1,1))
8051 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
8052 call transpose2(EUg(1,1,l),auxmat(1,1))
8053 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8054 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8058 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8059 & EAEAderx(1,1,lll,kkk,iii,2))
8064 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8065 C They are needed only when the fifth- or the sixth-order cumulants are
8067 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
8068 call transpose2(AEA(1,1,1),auxmat(1,1))
8069 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8070 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8071 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8072 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8073 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8074 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8075 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8076 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8077 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8078 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8079 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8080 call transpose2(AEA(1,1,2),auxmat(1,1))
8081 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
8082 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
8083 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
8084 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8085 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
8086 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
8087 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
8088 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
8089 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
8090 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
8091 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
8092 C Calculate the Cartesian derivatives of the vectors.
8096 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8097 call matvec2(auxmat(1,1),b1(1,i),
8098 & AEAb1derx(1,lll,kkk,iii,1,1))
8099 call matvec2(auxmat(1,1),Ub2(1,i),
8100 & AEAb2derx(1,lll,kkk,iii,1,1))
8101 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8102 & AEAb1derx(1,lll,kkk,iii,2,1))
8103 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8104 & AEAb2derx(1,lll,kkk,iii,2,1))
8105 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8106 call matvec2(auxmat(1,1),b1(1,j),
8107 & AEAb1derx(1,lll,kkk,iii,1,2))
8108 call matvec2(auxmat(1,1),Ub2(1,j),
8109 & AEAb2derx(1,lll,kkk,iii,1,2))
8110 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8111 & AEAb1derx(1,lll,kkk,iii,2,2))
8112 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
8113 & AEAb2derx(1,lll,kkk,iii,2,2))
8120 C Antiparallel orientation of the two CA-CA-CA frames.
8122 iti=itortyp(itype(i))
8126 itk1=itortyp(itype(k+1))
8127 itl=itortyp(itype(l))
8128 itj=itortyp(itype(j))
8129 if (j.lt.nres-1) then
8130 itj1=itortyp(itype(j+1))
8134 C A2 kernel(j-1)T A1T
8135 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8136 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
8137 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8138 C Following matrices are needed only for 6-th order cumulants
8139 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8140 & j.eq.i+4 .and. l.eq.i+3)) THEN
8141 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8142 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
8143 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8144 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8145 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
8146 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8147 & ADtEAderx(1,1,1,1,1,1))
8148 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8149 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
8150 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8151 & ADtEA1derx(1,1,1,1,1,1))
8153 C End 6-th order cumulants
8154 call transpose2(EUgder(1,1,k),auxmat(1,1))
8155 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8156 call transpose2(EUg(1,1,k),auxmat(1,1))
8157 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8158 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8162 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8163 & EAEAderx(1,1,lll,kkk,iii,1))
8167 C A2T kernel(i+1)T A1
8168 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8169 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
8170 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8171 C Following matrices are needed only for 6-th order cumulants
8172 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8173 & j.eq.i+4 .and. l.eq.i+3)) THEN
8174 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8175 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
8176 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8177 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8178 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
8179 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8180 & ADtEAderx(1,1,1,1,1,2))
8181 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8182 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
8183 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8184 & ADtEA1derx(1,1,1,1,1,2))
8186 C End 6-th order cumulants
8187 call transpose2(EUgder(1,1,j),auxmat(1,1))
8188 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
8189 call transpose2(EUg(1,1,j),auxmat(1,1))
8190 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8191 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8195 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8196 & EAEAderx(1,1,lll,kkk,iii,2))
8201 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8202 C They are needed only when the fifth- or the sixth-order cumulants are
8204 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
8205 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8206 call transpose2(AEA(1,1,1),auxmat(1,1))
8207 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8208 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8209 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8210 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8211 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8212 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8213 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8214 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8215 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8216 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8217 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8218 call transpose2(AEA(1,1,2),auxmat(1,1))
8219 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
8220 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8221 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8222 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8223 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
8224 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8225 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
8226 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
8227 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8228 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8229 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8230 C Calculate the Cartesian derivatives of the vectors.
8234 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8235 call matvec2(auxmat(1,1),b1(1,i),
8236 & AEAb1derx(1,lll,kkk,iii,1,1))
8237 call matvec2(auxmat(1,1),Ub2(1,i),
8238 & AEAb2derx(1,lll,kkk,iii,1,1))
8239 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8240 & AEAb1derx(1,lll,kkk,iii,2,1))
8241 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8242 & AEAb2derx(1,lll,kkk,iii,2,1))
8243 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8244 call matvec2(auxmat(1,1),b1(1,l),
8245 & AEAb1derx(1,lll,kkk,iii,1,2))
8246 call matvec2(auxmat(1,1),Ub2(1,l),
8247 & AEAb2derx(1,lll,kkk,iii,1,2))
8248 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
8249 & AEAb1derx(1,lll,kkk,iii,2,2))
8250 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
8251 & AEAb2derx(1,lll,kkk,iii,2,2))
8260 C---------------------------------------------------------------------------
8261 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
8262 & KK,KKderg,AKA,AKAderg,AKAderx)
8266 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
8267 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
8268 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
8273 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8275 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
8278 cd if (lprn) write (2,*) 'In kernel'
8280 cd if (lprn) write (2,*) 'kkk=',kkk
8282 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
8283 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8285 cd write (2,*) 'lll=',lll
8286 cd write (2,*) 'iii=1'
8288 cd write (2,'(3(2f10.5),5x)')
8289 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8292 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
8293 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8295 cd write (2,*) 'lll=',lll
8296 cd write (2,*) 'iii=2'
8298 cd write (2,'(3(2f10.5),5x)')
8299 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8306 C---------------------------------------------------------------------------
8307 double precision function eello4(i,j,k,l,jj,kk)
8308 implicit real*8 (a-h,o-z)
8309 include 'DIMENSIONS'
8310 include 'COMMON.IOUNITS'
8311 include 'COMMON.CHAIN'
8312 include 'COMMON.DERIV'
8313 include 'COMMON.INTERACT'
8314 include 'COMMON.CONTACTS'
8315 include 'COMMON.TORSION'
8316 include 'COMMON.VAR'
8317 include 'COMMON.GEO'
8318 double precision pizda(2,2),ggg1(3),ggg2(3)
8319 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8323 cd print *,'eello4:',i,j,k,l,jj,kk
8324 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
8325 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
8326 cold eij=facont_hb(jj,i)
8327 cold ekl=facont_hb(kk,k)
8329 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8330 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8331 gcorr_loc(k-1)=gcorr_loc(k-1)
8332 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8334 gcorr_loc(l-1)=gcorr_loc(l-1)
8335 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8337 gcorr_loc(j-1)=gcorr_loc(j-1)
8338 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8343 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
8344 & -EAEAderx(2,2,lll,kkk,iii,1)
8345 cd derx(lll,kkk,iii)=0.0d0
8349 cd gcorr_loc(l-1)=0.0d0
8350 cd gcorr_loc(j-1)=0.0d0
8351 cd gcorr_loc(k-1)=0.0d0
8353 cd write (iout,*)'Contacts have occurred for peptide groups',
8354 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
8355 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8356 if (j.lt.nres-1) then
8363 if (l.lt.nres-1) then
8371 cgrad ggg1(ll)=eel4*g_contij(ll,1)
8372 cgrad ggg2(ll)=eel4*g_contij(ll,2)
8373 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8374 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8375 cgrad ghalf=0.5d0*ggg1(ll)
8376 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8377 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8378 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8379 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8380 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8381 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8382 cgrad ghalf=0.5d0*ggg2(ll)
8383 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8384 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8385 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8386 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8387 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8388 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8392 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8397 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8402 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8407 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8411 cd write (2,*) iii,gcorr_loc(iii)
8414 cd write (2,*) 'ekont',ekont
8415 cd write (iout,*) 'eello4',ekont*eel4
8418 C---------------------------------------------------------------------------
8419 double precision function eello5(i,j,k,l,jj,kk)
8420 implicit real*8 (a-h,o-z)
8421 include 'DIMENSIONS'
8422 include 'COMMON.IOUNITS'
8423 include 'COMMON.CHAIN'
8424 include 'COMMON.DERIV'
8425 include 'COMMON.INTERACT'
8426 include 'COMMON.CONTACTS'
8427 include 'COMMON.TORSION'
8428 include 'COMMON.VAR'
8429 include 'COMMON.GEO'
8430 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
8431 double precision ggg1(3),ggg2(3)
8432 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8437 C /l\ / \ \ / \ / \ / C
8438 C / \ / \ \ / \ / \ / C
8439 C j| o |l1 | o | o| o | | o |o C
8440 C \ |/k\| |/ \| / |/ \| |/ \| C
8441 C \i/ \ / \ / / \ / \ C
8443 C (I) (II) (III) (IV) C
8445 C eello5_1 eello5_2 eello5_3 eello5_4 C
8447 C Antiparallel chains C
8450 C /j\ / \ \ / \ / \ / C
8451 C / \ / \ \ / \ / \ / C
8452 C j1| o |l | o | o| o | | o |o C
8453 C \ |/k\| |/ \| / |/ \| |/ \| C
8454 C \i/ \ / \ / / \ / \ C
8456 C (I) (II) (III) (IV) C
8458 C eello5_1 eello5_2 eello5_3 eello5_4 C
8460 C o denotes a local interaction, vertical lines an electrostatic interaction. C
8462 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8463 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8468 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8470 itk=itortyp(itype(k))
8471 itl=itortyp(itype(l))
8472 itj=itortyp(itype(j))
8477 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8478 cd & eel5_3_num,eel5_4_num)
8482 derx(lll,kkk,iii)=0.0d0
8486 cd eij=facont_hb(jj,i)
8487 cd ekl=facont_hb(kk,k)
8489 cd write (iout,*)'Contacts have occurred for peptide groups',
8490 cd & i,j,' fcont:',eij,' eij',' and ',k,l
8492 C Contribution from the graph I.
8493 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8494 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8495 call transpose2(EUg(1,1,k),auxmat(1,1))
8496 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8497 vv(1)=pizda(1,1)-pizda(2,2)
8498 vv(2)=pizda(1,2)+pizda(2,1)
8499 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
8500 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8501 C Explicit gradient in virtual-dihedral angles.
8502 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
8503 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
8504 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8505 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8506 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8507 vv(1)=pizda(1,1)-pizda(2,2)
8508 vv(2)=pizda(1,2)+pizda(2,1)
8509 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8510 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
8511 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8512 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8513 vv(1)=pizda(1,1)-pizda(2,2)
8514 vv(2)=pizda(1,2)+pizda(2,1)
8516 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
8517 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8518 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8520 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
8521 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8522 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8524 C Cartesian gradient
8528 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
8530 vv(1)=pizda(1,1)-pizda(2,2)
8531 vv(2)=pizda(1,2)+pizda(2,1)
8532 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8533 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
8534 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8540 C Contribution from graph II
8541 call transpose2(EE(1,1,itk),auxmat(1,1))
8542 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8543 vv(1)=pizda(1,1)+pizda(2,2)
8544 vv(2)=pizda(2,1)-pizda(1,2)
8545 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
8546 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8547 C Explicit gradient in virtual-dihedral angles.
8548 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8549 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8550 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8551 vv(1)=pizda(1,1)+pizda(2,2)
8552 vv(2)=pizda(2,1)-pizda(1,2)
8554 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8555 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8556 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8558 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8559 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8560 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8562 C Cartesian gradient
8566 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8568 vv(1)=pizda(1,1)+pizda(2,2)
8569 vv(2)=pizda(2,1)-pizda(1,2)
8570 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8571 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
8572 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8580 C Parallel orientation
8581 C Contribution from graph III
8582 call transpose2(EUg(1,1,l),auxmat(1,1))
8583 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8584 vv(1)=pizda(1,1)-pizda(2,2)
8585 vv(2)=pizda(1,2)+pizda(2,1)
8586 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
8587 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8588 C Explicit gradient in virtual-dihedral angles.
8589 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8590 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
8591 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8592 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8593 vv(1)=pizda(1,1)-pizda(2,2)
8594 vv(2)=pizda(1,2)+pizda(2,1)
8595 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8596 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8597 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8598 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8599 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8600 vv(1)=pizda(1,1)-pizda(2,2)
8601 vv(2)=pizda(1,2)+pizda(2,1)
8602 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8603 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8604 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8605 C Cartesian gradient
8609 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8611 vv(1)=pizda(1,1)-pizda(2,2)
8612 vv(2)=pizda(1,2)+pizda(2,1)
8613 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8614 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8615 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8620 C Contribution from graph IV
8622 call transpose2(EE(1,1,itl),auxmat(1,1))
8623 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8624 vv(1)=pizda(1,1)+pizda(2,2)
8625 vv(2)=pizda(2,1)-pizda(1,2)
8626 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
8627 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8628 C Explicit gradient in virtual-dihedral angles.
8629 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8630 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8631 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8632 vv(1)=pizda(1,1)+pizda(2,2)
8633 vv(2)=pizda(2,1)-pizda(1,2)
8634 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8635 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
8636 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8637 C Cartesian gradient
8641 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8643 vv(1)=pizda(1,1)+pizda(2,2)
8644 vv(2)=pizda(2,1)-pizda(1,2)
8645 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8646 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
8647 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8652 C Antiparallel orientation
8653 C Contribution from graph III
8655 call transpose2(EUg(1,1,j),auxmat(1,1))
8656 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8657 vv(1)=pizda(1,1)-pizda(2,2)
8658 vv(2)=pizda(1,2)+pizda(2,1)
8659 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8660 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8661 C Explicit gradient in virtual-dihedral angles.
8662 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8663 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8664 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8665 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8666 vv(1)=pizda(1,1)-pizda(2,2)
8667 vv(2)=pizda(1,2)+pizda(2,1)
8668 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8669 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
8670 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8671 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8672 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8673 vv(1)=pizda(1,1)-pizda(2,2)
8674 vv(2)=pizda(1,2)+pizda(2,1)
8675 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8676 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
8677 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8678 C Cartesian gradient
8682 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8684 vv(1)=pizda(1,1)-pizda(2,2)
8685 vv(2)=pizda(1,2)+pizda(2,1)
8686 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8687 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8688 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8693 C Contribution from graph IV
8695 call transpose2(EE(1,1,itj),auxmat(1,1))
8696 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8697 vv(1)=pizda(1,1)+pizda(2,2)
8698 vv(2)=pizda(2,1)-pizda(1,2)
8699 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
8700 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8701 C Explicit gradient in virtual-dihedral angles.
8702 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8703 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8704 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8705 vv(1)=pizda(1,1)+pizda(2,2)
8706 vv(2)=pizda(2,1)-pizda(1,2)
8707 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8708 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
8709 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8710 C Cartesian gradient
8714 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8716 vv(1)=pizda(1,1)+pizda(2,2)
8717 vv(2)=pizda(2,1)-pizda(1,2)
8718 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8719 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
8720 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8726 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8727 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8728 cd write (2,*) 'ijkl',i,j,k,l
8729 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8730 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8732 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8733 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8734 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8735 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8736 if (j.lt.nres-1) then
8743 if (l.lt.nres-1) then
8753 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8754 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8755 C summed up outside the subrouine as for the other subroutines
8756 C handling long-range interactions. The old code is commented out
8757 C with "cgrad" to keep track of changes.
8759 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8760 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8761 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8762 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8763 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8764 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8765 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8766 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8767 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8768 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8770 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8771 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8772 cgrad ghalf=0.5d0*ggg1(ll)
8774 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8775 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8776 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8777 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8778 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8779 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8780 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8781 cgrad ghalf=0.5d0*ggg2(ll)
8783 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8784 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8785 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8786 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8787 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8788 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8793 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8794 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8799 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8800 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8806 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8811 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8815 cd write (2,*) iii,g_corr5_loc(iii)
8818 cd write (2,*) 'ekont',ekont
8819 cd write (iout,*) 'eello5',ekont*eel5
8822 c--------------------------------------------------------------------------
8823 double precision function eello6(i,j,k,l,jj,kk)
8824 implicit real*8 (a-h,o-z)
8825 include 'DIMENSIONS'
8826 include 'COMMON.IOUNITS'
8827 include 'COMMON.CHAIN'
8828 include 'COMMON.DERIV'
8829 include 'COMMON.INTERACT'
8830 include 'COMMON.CONTACTS'
8831 include 'COMMON.TORSION'
8832 include 'COMMON.VAR'
8833 include 'COMMON.GEO'
8834 include 'COMMON.FFIELD'
8835 double precision ggg1(3),ggg2(3)
8836 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8841 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8849 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8850 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8854 derx(lll,kkk,iii)=0.0d0
8858 cd eij=facont_hb(jj,i)
8859 cd ekl=facont_hb(kk,k)
8865 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8866 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8867 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8868 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8869 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8870 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8872 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8873 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8874 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8875 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8876 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8877 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8881 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8883 C If turn contributions are considered, they will be handled separately.
8884 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8885 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8886 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8887 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8888 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8889 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8890 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8892 if (j.lt.nres-1) then
8899 if (l.lt.nres-1) then
8907 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8908 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8909 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8910 cgrad ghalf=0.5d0*ggg1(ll)
8912 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8913 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8914 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8915 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8916 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8917 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8918 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8919 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8920 cgrad ghalf=0.5d0*ggg2(ll)
8921 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8923 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8924 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8925 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8926 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8927 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8928 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8933 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8934 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8939 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8940 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
8946 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
8951 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
8955 cd write (2,*) iii,g_corr6_loc(iii)
8958 cd write (2,*) 'ekont',ekont
8959 cd write (iout,*) 'eello6',ekont*eel6
8962 c--------------------------------------------------------------------------
8963 double precision function eello6_graph1(i,j,k,l,imat,swap)
8964 implicit real*8 (a-h,o-z)
8965 include 'DIMENSIONS'
8966 include 'COMMON.IOUNITS'
8967 include 'COMMON.CHAIN'
8968 include 'COMMON.DERIV'
8969 include 'COMMON.INTERACT'
8970 include 'COMMON.CONTACTS'
8971 include 'COMMON.TORSION'
8972 include 'COMMON.VAR'
8973 include 'COMMON.GEO'
8974 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
8978 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8980 C Parallel Antiparallel C
8986 C \ j|/k\| / \ |/k\|l / C
8991 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8992 itk=itortyp(itype(k))
8993 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
8994 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
8995 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
8996 call transpose2(EUgC(1,1,k),auxmat(1,1))
8997 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
8998 vv1(1)=pizda1(1,1)-pizda1(2,2)
8999 vv1(2)=pizda1(1,2)+pizda1(2,1)
9000 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9001 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
9002 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
9003 s5=scalar2(vv(1),Dtobr2(1,i))
9004 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
9005 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
9006 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
9007 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
9008 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
9009 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
9010 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
9011 & +scalar2(vv(1),Dtobr2der(1,i)))
9012 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
9013 vv1(1)=pizda1(1,1)-pizda1(2,2)
9014 vv1(2)=pizda1(1,2)+pizda1(2,1)
9015 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
9016 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
9018 g_corr6_loc(l-1)=g_corr6_loc(l-1)
9019 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9020 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9021 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9022 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9024 g_corr6_loc(j-1)=g_corr6_loc(j-1)
9025 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9026 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9027 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9028 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9030 call transpose2(EUgCder(1,1,k),auxmat(1,1))
9031 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9032 vv1(1)=pizda1(1,1)-pizda1(2,2)
9033 vv1(2)=pizda1(1,2)+pizda1(2,1)
9034 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
9035 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
9036 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
9037 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
9046 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
9047 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
9048 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
9049 call transpose2(EUgC(1,1,k),auxmat(1,1))
9050 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9052 vv1(1)=pizda1(1,1)-pizda1(2,2)
9053 vv1(2)=pizda1(1,2)+pizda1(2,1)
9054 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9055 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
9056 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
9057 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
9058 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
9059 s5=scalar2(vv(1),Dtobr2(1,i))
9060 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
9066 c----------------------------------------------------------------------------
9067 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
9068 implicit real*8 (a-h,o-z)
9069 include 'DIMENSIONS'
9070 include 'COMMON.IOUNITS'
9071 include 'COMMON.CHAIN'
9072 include 'COMMON.DERIV'
9073 include 'COMMON.INTERACT'
9074 include 'COMMON.CONTACTS'
9075 include 'COMMON.TORSION'
9076 include 'COMMON.VAR'
9077 include 'COMMON.GEO'
9079 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9080 & auxvec1(2),auxvec2(2),auxmat1(2,2)
9083 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9085 C Parallel Antiparallel C
9091 C \ j|/k\| \ |/k\|l C
9096 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9097 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
9098 C AL 7/4/01 s1 would occur in the sixth-order moment,
9099 C but not in a cluster cumulant
9101 s1=dip(1,jj,i)*dip(1,kk,k)
9103 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
9104 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9105 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
9106 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
9107 call transpose2(EUg(1,1,k),auxmat(1,1))
9108 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
9109 vv(1)=pizda(1,1)-pizda(2,2)
9110 vv(2)=pizda(1,2)+pizda(2,1)
9111 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9112 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9114 eello6_graph2=-(s1+s2+s3+s4)
9116 eello6_graph2=-(s2+s3+s4)
9119 C Derivatives in gamma(i-1)
9122 s1=dipderg(1,jj,i)*dip(1,kk,k)
9124 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9125 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
9126 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9127 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9129 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9131 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9133 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
9135 C Derivatives in gamma(k-1)
9137 s1=dip(1,jj,i)*dipderg(1,kk,k)
9139 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
9140 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9141 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
9142 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9143 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9144 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
9145 vv(1)=pizda(1,1)-pizda(2,2)
9146 vv(2)=pizda(1,2)+pizda(2,1)
9147 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9149 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9151 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9153 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
9154 C Derivatives in gamma(j-1) or gamma(l-1)
9157 s1=dipderg(3,jj,i)*dip(1,kk,k)
9159 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
9160 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9161 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
9162 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
9163 vv(1)=pizda(1,1)-pizda(2,2)
9164 vv(2)=pizda(1,2)+pizda(2,1)
9165 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9168 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9170 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9173 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
9174 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
9176 C Derivatives in gamma(l-1) or gamma(j-1)
9179 s1=dip(1,jj,i)*dipderg(3,kk,k)
9181 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
9182 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9183 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
9184 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9185 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
9186 vv(1)=pizda(1,1)-pizda(2,2)
9187 vv(2)=pizda(1,2)+pizda(2,1)
9188 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9191 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9193 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9196 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
9197 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
9199 C Cartesian derivatives.
9201 write (2,*) 'In eello6_graph2'
9203 write (2,*) 'iii=',iii
9205 write (2,*) 'kkk=',kkk
9207 write (2,'(3(2f10.5),5x)')
9208 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9218 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9220 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9223 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
9225 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9226 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
9228 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9229 call transpose2(EUg(1,1,k),auxmat(1,1))
9230 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
9232 vv(1)=pizda(1,1)-pizda(2,2)
9233 vv(2)=pizda(1,2)+pizda(2,1)
9234 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9235 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9237 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9239 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9242 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9244 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9251 c----------------------------------------------------------------------------
9252 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
9253 implicit real*8 (a-h,o-z)
9254 include 'DIMENSIONS'
9255 include 'COMMON.IOUNITS'
9256 include 'COMMON.CHAIN'
9257 include 'COMMON.DERIV'
9258 include 'COMMON.INTERACT'
9259 include 'COMMON.CONTACTS'
9260 include 'COMMON.TORSION'
9261 include 'COMMON.VAR'
9262 include 'COMMON.GEO'
9263 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
9265 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9267 C Parallel Antiparallel C
9273 C j|/k\| / |/k\|l / C
9278 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9280 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9281 C energy moment and not to the cluster cumulant.
9282 iti=itortyp(itype(i))
9283 if (j.lt.nres-1) then
9284 itj1=itortyp(itype(j+1))
9288 itk=itortyp(itype(k))
9289 itk1=itortyp(itype(k+1))
9290 if (l.lt.nres-1) then
9291 itl1=itortyp(itype(l+1))
9296 s1=dip(4,jj,i)*dip(4,kk,k)
9298 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
9299 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9300 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
9301 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9302 call transpose2(EE(1,1,itk),auxmat(1,1))
9303 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9304 vv(1)=pizda(1,1)+pizda(2,2)
9305 vv(2)=pizda(2,1)-pizda(1,2)
9306 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9307 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9308 cd & "sum",-(s2+s3+s4)
9310 eello6_graph3=-(s1+s2+s3+s4)
9312 eello6_graph3=-(s2+s3+s4)
9315 C Derivatives in gamma(k-1)
9316 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
9317 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9318 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9319 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9320 C Derivatives in gamma(l-1)
9321 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
9322 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9323 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9324 vv(1)=pizda(1,1)+pizda(2,2)
9325 vv(2)=pizda(2,1)-pizda(1,2)
9326 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9327 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9328 C Cartesian derivatives.
9334 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9336 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9339 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9341 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9342 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
9344 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9345 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
9347 vv(1)=pizda(1,1)+pizda(2,2)
9348 vv(2)=pizda(2,1)-pizda(1,2)
9349 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9351 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9353 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9356 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9358 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9360 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9366 c----------------------------------------------------------------------------
9367 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9368 implicit real*8 (a-h,o-z)
9369 include 'DIMENSIONS'
9370 include 'COMMON.IOUNITS'
9371 include 'COMMON.CHAIN'
9372 include 'COMMON.DERIV'
9373 include 'COMMON.INTERACT'
9374 include 'COMMON.CONTACTS'
9375 include 'COMMON.TORSION'
9376 include 'COMMON.VAR'
9377 include 'COMMON.GEO'
9378 include 'COMMON.FFIELD'
9379 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9380 & auxvec1(2),auxmat1(2,2)
9382 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9384 C Parallel Antiparallel C
9390 C \ j|/k\| \ |/k\|l C
9395 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9397 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9398 C energy moment and not to the cluster cumulant.
9399 cd write (2,*) 'eello_graph4: wturn6',wturn6
9400 iti=itortyp(itype(i))
9401 itj=itortyp(itype(j))
9402 if (j.lt.nres-1) then
9403 itj1=itortyp(itype(j+1))
9407 itk=itortyp(itype(k))
9408 if (k.lt.nres-1) then
9409 itk1=itortyp(itype(k+1))
9413 itl=itortyp(itype(l))
9414 if (l.lt.nres-1) then
9415 itl1=itortyp(itype(l+1))
9419 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9420 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9421 cd & ' itl',itl,' itl1',itl1
9424 s1=dip(3,jj,i)*dip(3,kk,k)
9426 s1=dip(2,jj,j)*dip(2,kk,l)
9429 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9430 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9432 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
9433 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9435 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
9436 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9438 call transpose2(EUg(1,1,k),auxmat(1,1))
9439 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9440 vv(1)=pizda(1,1)-pizda(2,2)
9441 vv(2)=pizda(2,1)+pizda(1,2)
9442 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9443 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9445 eello6_graph4=-(s1+s2+s3+s4)
9447 eello6_graph4=-(s2+s3+s4)
9449 C Derivatives in gamma(i-1)
9453 s1=dipderg(2,jj,i)*dip(3,kk,k)
9455 s1=dipderg(4,jj,j)*dip(2,kk,l)
9458 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9460 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
9461 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9463 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
9464 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9466 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9467 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9468 cd write (2,*) 'turn6 derivatives'
9470 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9472 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9476 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9478 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9482 C Derivatives in gamma(k-1)
9485 s1=dip(3,jj,i)*dipderg(2,kk,k)
9487 s1=dip(2,jj,j)*dipderg(4,kk,l)
9490 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9491 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9493 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
9494 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9496 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
9497 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9499 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9500 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9501 vv(1)=pizda(1,1)-pizda(2,2)
9502 vv(2)=pizda(2,1)+pizda(1,2)
9503 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9504 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9506 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9508 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9512 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9514 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9517 C Derivatives in gamma(j-1) or gamma(l-1)
9518 if (l.eq.j+1 .and. l.gt.1) then
9519 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9520 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9521 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9522 vv(1)=pizda(1,1)-pizda(2,2)
9523 vv(2)=pizda(2,1)+pizda(1,2)
9524 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9525 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9526 else if (j.gt.1) then
9527 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9528 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9529 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9530 vv(1)=pizda(1,1)-pizda(2,2)
9531 vv(2)=pizda(2,1)+pizda(1,2)
9532 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9533 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9534 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9536 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9539 C Cartesian derivatives.
9546 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9548 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9552 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9554 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9558 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
9560 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9562 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9563 & b1(1,j+1),auxvec(1))
9564 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
9566 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9567 & b1(1,l+1),auxvec(1))
9568 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
9570 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9572 vv(1)=pizda(1,1)-pizda(2,2)
9573 vv(2)=pizda(2,1)+pizda(1,2)
9574 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9576 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9578 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9581 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9584 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9587 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9589 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9591 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9595 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9597 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9600 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9602 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9610 c----------------------------------------------------------------------------
9611 double precision function eello_turn6(i,jj,kk)
9612 implicit real*8 (a-h,o-z)
9613 include 'DIMENSIONS'
9614 include 'COMMON.IOUNITS'
9615 include 'COMMON.CHAIN'
9616 include 'COMMON.DERIV'
9617 include 'COMMON.INTERACT'
9618 include 'COMMON.CONTACTS'
9619 include 'COMMON.TORSION'
9620 include 'COMMON.VAR'
9621 include 'COMMON.GEO'
9622 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9623 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9625 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9626 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9627 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9628 C the respective energy moment and not to the cluster cumulant.
9637 iti=itortyp(itype(i))
9638 itk=itortyp(itype(k))
9639 itk1=itortyp(itype(k+1))
9640 itl=itortyp(itype(l))
9641 itj=itortyp(itype(j))
9642 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9643 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9644 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9649 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9651 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
9655 derx_turn(lll,kkk,iii)=0.0d0
9662 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9664 cd write (2,*) 'eello6_5',eello6_5
9666 call transpose2(AEA(1,1,1),auxmat(1,1))
9667 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9668 ss1=scalar2(Ub2(1,i+2),b1(1,l))
9669 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9671 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
9672 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9673 s2 = scalar2(b1(1,k),vtemp1(1))
9675 call transpose2(AEA(1,1,2),atemp(1,1))
9676 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9677 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
9678 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9680 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9681 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9682 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9684 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9685 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9686 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9687 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9688 ss13 = scalar2(b1(1,k),vtemp4(1))
9689 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9691 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9697 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9698 C Derivatives in gamma(i+2)
9702 call transpose2(AEA(1,1,1),auxmatd(1,1))
9703 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9704 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9705 call transpose2(AEAderg(1,1,2),atempd(1,1))
9706 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9707 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9709 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9710 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9711 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9717 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9718 C Derivatives in gamma(i+3)
9720 call transpose2(AEA(1,1,1),auxmatd(1,1))
9721 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9722 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
9723 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9725 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
9726 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9727 s2d = scalar2(b1(1,k),vtemp1d(1))
9729 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9730 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9732 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9734 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9735 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9736 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9744 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9745 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9747 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9748 & -0.5d0*ekont*(s2d+s12d)
9750 C Derivatives in gamma(i+4)
9751 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9752 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9753 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9755 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9756 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9757 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9765 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9767 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9769 C Derivatives in gamma(i+5)
9771 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9772 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9773 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9775 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
9776 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9777 s2d = scalar2(b1(1,k),vtemp1d(1))
9779 call transpose2(AEA(1,1,2),atempd(1,1))
9780 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9781 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9783 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9784 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9786 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9787 ss13d = scalar2(b1(1,k),vtemp4d(1))
9788 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9796 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9797 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9799 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9800 & -0.5d0*ekont*(s2d+s12d)
9802 C Cartesian derivatives
9807 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9808 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9809 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9811 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
9812 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9814 s2d = scalar2(b1(1,k),vtemp1d(1))
9816 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9817 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9818 s8d = -(atempd(1,1)+atempd(2,2))*
9819 & scalar2(cc(1,1,itl),vtemp2(1))
9821 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9823 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9824 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9831 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9834 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9838 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9839 & - 0.5d0*(s8d+s12d)
9841 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9850 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9852 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9853 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9854 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9855 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9856 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9858 ss13d = scalar2(b1(1,k),vtemp4d(1))
9859 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9860 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9864 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9865 cd & 16*eel_turn6_num
9867 if (j.lt.nres-1) then
9874 if (l.lt.nres-1) then
9882 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9883 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9884 cgrad ghalf=0.5d0*ggg1(ll)
9886 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9887 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9888 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9889 & +ekont*derx_turn(ll,2,1)
9890 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9891 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9892 & +ekont*derx_turn(ll,4,1)
9893 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9894 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9895 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9896 cgrad ghalf=0.5d0*ggg2(ll)
9898 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9899 & +ekont*derx_turn(ll,2,2)
9900 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9901 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9902 & +ekont*derx_turn(ll,4,2)
9903 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9904 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9905 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9910 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9915 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9921 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9926 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9930 cd write (2,*) iii,g_corr6_loc(iii)
9932 eello_turn6=ekont*eel_turn6
9933 cd write (2,*) 'ekont',ekont
9934 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9938 C-----------------------------------------------------------------------------
9939 double precision function scalar(u,v)
9940 !DIR$ INLINEALWAYS scalar
9942 cDEC$ ATTRIBUTES FORCEINLINE::scalar
9945 double precision u(3),v(3)
9946 cd double precision sc
9954 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
9957 crc-------------------------------------------------
9958 SUBROUTINE MATVEC2(A1,V1,V2)
9959 !DIR$ INLINEALWAYS MATVEC2
9961 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
9963 implicit real*8 (a-h,o-z)
9964 include 'DIMENSIONS'
9965 DIMENSION A1(2,2),V1(2),V2(2)
9969 c 3 VI=VI+A1(I,K)*V1(K)
9973 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
9974 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
9979 C---------------------------------------
9980 SUBROUTINE MATMAT2(A1,A2,A3)
9982 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
9984 implicit real*8 (a-h,o-z)
9985 include 'DIMENSIONS'
9986 DIMENSION A1(2,2),A2(2,2),A3(2,2)
9987 c DIMENSION AI3(2,2)
9991 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
9997 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
9998 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
9999 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
10000 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
10008 c-------------------------------------------------------------------------
10009 double precision function scalar2(u,v)
10010 !DIR$ INLINEALWAYS scalar2
10012 double precision u(2),v(2)
10013 double precision sc
10015 scalar2=u(1)*v(1)+u(2)*v(2)
10019 C-----------------------------------------------------------------------------
10021 subroutine transpose2(a,at)
10022 !DIR$ INLINEALWAYS transpose2
10024 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
10027 double precision a(2,2),at(2,2)
10034 c--------------------------------------------------------------------------
10035 subroutine transpose(n,a,at)
10038 double precision a(n,n),at(n,n)
10046 C---------------------------------------------------------------------------
10047 subroutine prodmat3(a1,a2,kk,transp,prod)
10048 !DIR$ INLINEALWAYS prodmat3
10050 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
10054 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
10056 crc double precision auxmat(2,2),prod_(2,2)
10059 crc call transpose2(kk(1,1),auxmat(1,1))
10060 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
10061 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10063 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
10064 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
10065 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
10066 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
10067 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
10068 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
10069 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
10070 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
10073 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
10074 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10076 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
10077 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
10078 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
10079 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
10080 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
10081 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
10082 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
10083 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
10086 c call transpose2(a2(1,1),a2t(1,1))
10089 crc print *,((prod_(i,j),i=1,2),j=1,2)
10090 crc print *,((prod(i,j),i=1,2),j=1,2)
10094 CCC----------------------------------------------
10095 subroutine Eliptransfer(eliptran)
10096 implicit real*8 (a-h,o-z)
10097 include 'DIMENSIONS'
10098 include 'COMMON.GEO'
10099 include 'COMMON.VAR'
10100 include 'COMMON.LOCAL'
10101 include 'COMMON.CHAIN'
10102 include 'COMMON.DERIV'
10103 include 'COMMON.NAMES'
10104 include 'COMMON.INTERACT'
10105 include 'COMMON.IOUNITS'
10106 include 'COMMON.CALC'
10107 include 'COMMON.CONTROL'
10108 include 'COMMON.SPLITELE'
10109 include 'COMMON.SBRIDGE'
10110 C this is done by Adasko
10111 C print *,"wchodze"
10112 C structure of box:
10114 C--bordliptop-- buffore starts
10115 C--bufliptop--- here true lipid starts
10117 C--buflipbot--- lipid ends buffore starts
10118 C--bordlipbot--buffore ends
10120 do i=ilip_start,ilip_end
10122 if (itype(i).eq.ntyp1) cycle
10124 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
10125 if (positi.le.0) positi=positi+boxzsize
10127 C first for peptide groups
10128 c for each residue check if it is in lipid or lipid water border area
10129 if ((positi.gt.bordlipbot)
10130 &.and.(positi.lt.bordliptop)) then
10131 C the energy transfer exist
10132 if (positi.lt.buflipbot) then
10133 C what fraction I am in
10135 & ((positi-bordlipbot)/lipbufthick)
10136 C lipbufthick is thickenes of lipid buffore
10137 sslip=sscalelip(fracinbuf)
10138 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
10139 eliptran=eliptran+sslip*pepliptran
10140 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10141 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10142 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10144 C print *,"doing sccale for lower part"
10145 C print *,i,sslip,fracinbuf,ssgradlip
10146 elseif (positi.gt.bufliptop) then
10147 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
10148 sslip=sscalelip(fracinbuf)
10149 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
10150 eliptran=eliptran+sslip*pepliptran
10151 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10152 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10153 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10154 C print *, "doing sscalefor top part"
10155 C print *,i,sslip,fracinbuf,ssgradlip
10157 eliptran=eliptran+pepliptran
10158 C print *,"I am in true lipid"
10161 C eliptran=elpitran+0.0 ! I am in water
10164 C print *, "nic nie bylo w lipidzie?"
10165 C now multiply all by the peptide group transfer factor
10166 C eliptran=eliptran*pepliptran
10167 C now the same for side chains
10169 do i=ilip_start,ilip_end
10170 if (itype(i).eq.ntyp1) cycle
10171 positi=(mod(c(3,i+nres),boxzsize))
10172 if (positi.le.0) positi=positi+boxzsize
10173 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
10174 c for each residue check if it is in lipid or lipid water border area
10175 C respos=mod(c(3,i+nres),boxzsize)
10176 C print *,positi,bordlipbot,buflipbot
10177 if ((positi.gt.bordlipbot)
10178 & .and.(positi.lt.bordliptop)) then
10179 C the energy transfer exist
10180 if (positi.lt.buflipbot) then
10182 & ((positi-bordlipbot)/lipbufthick)
10183 C lipbufthick is thickenes of lipid buffore
10184 sslip=sscalelip(fracinbuf)
10185 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
10186 eliptran=eliptran+sslip*liptranene(itype(i))
10187 gliptranx(3,i)=gliptranx(3,i)
10188 &+ssgradlip*liptranene(itype(i))
10189 gliptranc(3,i-1)= gliptranc(3,i-1)
10190 &+ssgradlip*liptranene(itype(i))
10191 C print *,"doing sccale for lower part"
10192 elseif (positi.gt.bufliptop) then
10194 &((bordliptop-positi)/lipbufthick)
10195 sslip=sscalelip(fracinbuf)
10196 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
10197 eliptran=eliptran+sslip*liptranene(itype(i))
10198 gliptranx(3,i)=gliptranx(3,i)
10199 &+ssgradlip*liptranene(itype(i))
10200 gliptranc(3,i-1)= gliptranc(3,i-1)
10201 &+ssgradlip*liptranene(itype(i))
10202 C print *, "doing sscalefor top part",sslip,fracinbuf
10204 eliptran=eliptran+liptranene(itype(i))
10205 C print *,"I am in true lipid"
10207 endif ! if in lipid or buffor
10209 C eliptran=elpitran+0.0 ! I am in water