1 subroutine etotal(energia)
2 implicit real*8 (a-h,o-z)
7 cMS$ATTRIBUTES C :: proc_proc
12 double precision weights_(n_ene)
14 include 'COMMON.SETUP'
15 include 'COMMON.IOUNITS'
16 double precision energia(0:n_ene)
17 include 'COMMON.LOCAL'
18 include 'COMMON.FFIELD'
19 include 'COMMON.DERIV'
20 include 'COMMON.INTERACT'
21 include 'COMMON.SBRIDGE'
22 include 'COMMON.CHAIN'
25 include 'COMMON.CONTROL'
26 include 'COMMON.TIME1'
27 include 'COMMON.SPLITELE'
29 c print*,"ETOTAL Processor",fg_rank," absolute rank",myrank,
30 c & " nfgtasks",nfgtasks
31 if (nfgtasks.gt.1) then
33 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
34 if (fg_rank.eq.0) then
35 call MPI_Bcast(0,1,MPI_INTEGER,king,FG_COMM,IERROR)
36 c print *,"Processor",myrank," BROADCAST iorder"
37 C FG master sets up the WEIGHTS_ array which will be broadcast to the
38 C FG slaves as WEIGHTS array.
58 C FG Master broadcasts the WEIGHTS_ array
59 call MPI_Bcast(weights_(1),n_ene,
60 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
62 C FG slaves receive the WEIGHTS array
63 call MPI_Bcast(weights(1),n_ene,
64 & MPI_DOUBLE_PRECISION,king,FG_COMM,IERROR)
85 time_Bcast=time_Bcast+MPI_Wtime()-time00
86 time_Bcastw=time_Bcastw+MPI_Wtime()-time00
87 c call chainbuild_cart
89 c print *,'Processor',myrank,' calling etotal ipot=',ipot
90 c print *,'Processor',myrank,' nnt=',nnt,' nct=',nct
92 c if (modecalc.eq.12.or.modecalc.eq.14) then
93 c call int_from_cart1(.false.)
100 C Compute the side-chain and electrostatic interaction energy
103 goto (101,102,103,104,105,106) ipot
104 C Lennard-Jones potential.
106 cd print '(a)','Exit ELJ'
108 C Lennard-Jones-Kihara potential (shifted).
111 C Berne-Pechukas potential (dilated LJ, angular dependence).
114 C Gay-Berne potential (shifted LJ, angular dependence).
116 C print *,"bylem w egb"
118 C Gay-Berne-Vorobjev potential (shifted LJ, angular dependence).
121 C Soft-sphere potential
122 106 call e_softsphere(evdw)
124 C Calculate electrostatic (H-bonding) energy of the main chain.
128 cmc Sep-06: egb takes care of dynamic ss bonds too
130 c if (dyn_ss) call dyn_set_nss
132 c print *,"Processor",myrank," computed USCSC"
138 time_vec=time_vec+MPI_Wtime()-time01
140 C Introduction of shielding effect first for each peptide group
141 C the shielding factor is set this factor is describing how each
142 C peptide group is shielded by side-chains
143 C the matrix - shield_fac(i) the i index describe the ith between i and i+1
144 if (shield_mode.gt.0) then
147 c print *,"Processor",myrank," left VEC_AND_DERIV"
150 if (welec.gt.0d0.or.wvdwpp.gt.0d0.or.wel_loc.gt.0d0.or.
151 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
152 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
153 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
155 if (welec.gt.0d0.or.wel_loc.gt.0d0.or.
156 & wturn3.gt.0d0.or.wturn4.gt.0d0 .or. wcorr.gt.0.0d0
157 & .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.d0
158 & .or. wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0 ) then
160 call eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
169 write (iout,*) "Soft-spheer ELEC potential"
170 c call eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
173 c print *,"Processor",myrank," computed UELEC"
175 C Calculate excluded-volume interaction energy between peptide groups
180 call escp(evdw2,evdw2_14)
186 c write (iout,*) "Soft-sphere SCP potential"
187 call escp_soft_sphere(evdw2,evdw2_14)
190 c Calculate the bond-stretching energy
194 C Calculate the disulfide-bridge and other energy and the contributions
195 C from other distance constraints.
196 cd print *,'Calling EHPB'
198 cd print *,'EHPB exitted succesfully.'
200 C Calculate the virtual-bond-angle energy.
202 if (wang.gt.0d0) then
207 c print *,"Processor",myrank," computed UB"
209 C Calculate the SC local energy.
211 C print *,"TU DOCHODZE?"
213 c print *,"Processor",myrank," computed USC"
215 C Calculate the virtual-bond torsional energy.
217 cd print *,'nterm=',nterm
219 call etor(etors,edihcnstr)
224 c print *,"Processor",myrank," computed Utor"
226 C 6/23/01 Calculate double-torsional energy
228 if (wtor_d.gt.0) then
233 c print *,"Processor",myrank," computed Utord"
235 C 21/5/07 Calculate local sicdechain correlation energy
237 if (wsccor.gt.0.0d0) then
238 call eback_sc_corr(esccor)
242 C print *,"PRZED MULIt"
243 c print *,"Processor",myrank," computed Usccorr"
245 C 12/1/95 Multi-body terms
249 if ((wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0
250 & .or. wturn6.gt.0.0d0) .and. ipot.lt.6) then
251 call multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,n_corr1)
252 cd write(2,*)'multibody_eello n_corr=',n_corr,' n_corr1=',n_corr1,
253 cd &" ecorr",ecorr," ecorr5",ecorr5," ecorr6",ecorr6," eturn6",eturn6
260 if ((wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) .and. ipot.lt.6) then
261 call multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
262 cd write (iout,*) "multibody_hb ecorr",ecorr
264 c print *,"Processor",myrank," computed Ucorr"
266 C If performing constraint dynamics, call the constraint energy
267 C after the equilibration time
268 if(usampl.and.totT.gt.eq_time) then
275 C 01/27/2015 added by adasko
276 C the energy component below is energy transfer into lipid environment
277 C based on partition function
278 C print *,"przed lipidami"
279 if (wliptran.gt.0) then
280 call Eliptransfer(eliptran)
282 C print *,"za lipidami"
283 if (AFMlog.gt.0) then
284 call AFMforce(Eafmforce)
285 else if (selfguide.gt.0) then
286 call AFMvel(Eafmforce)
289 time_enecalc=time_enecalc+MPI_Wtime()-time00
291 c print *,"Processor",myrank," computed Uconstr"
300 energia(2)=evdw2-evdw2_14
317 energia(8)=eello_turn3
318 energia(9)=eello_turn4
325 energia(19)=edihcnstr
327 energia(20)=Uconst+Uconst_back
330 energia(23)=Eafmforce
331 c Here are the energies showed per procesor if the are more processors
332 c per molecule then we sum it up in sum_energy subroutine
333 c print *," Processor",myrank," calls SUM_ENERGY"
334 call sum_energy(energia,.true.)
335 if (dyn_ss) call dyn_set_nss
336 c print *," Processor",myrank," left SUM_ENERGY"
338 time_sumene=time_sumene+MPI_Wtime()-time00
342 c-------------------------------------------------------------------------------
343 subroutine sum_energy(energia,reduce)
344 implicit real*8 (a-h,o-z)
349 cMS$ATTRIBUTES C :: proc_proc
355 include 'COMMON.SETUP'
356 include 'COMMON.IOUNITS'
357 double precision energia(0:n_ene),enebuff(0:n_ene+1)
358 include 'COMMON.FFIELD'
359 include 'COMMON.DERIV'
360 include 'COMMON.INTERACT'
361 include 'COMMON.SBRIDGE'
362 include 'COMMON.CHAIN'
364 include 'COMMON.CONTROL'
365 include 'COMMON.TIME1'
368 if (nfgtasks.gt.1 .and. reduce) then
370 write (iout,*) "energies before REDUCE"
371 call enerprint(energia)
375 enebuff(i)=energia(i)
378 call MPI_Barrier(FG_COMM,IERR)
379 time_barrier_e=time_barrier_e+MPI_Wtime()-time00
381 call MPI_Reduce(enebuff(0),energia(0),n_ene+1,
382 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
384 write (iout,*) "energies after REDUCE"
385 call enerprint(energia)
388 time_Reduce=time_Reduce+MPI_Wtime()-time00
390 if (fg_rank.eq.0) then
394 evdw2=energia(2)+energia(18)
410 eello_turn3=energia(8)
411 eello_turn4=energia(9)
418 edihcnstr=energia(19)
423 Eafmforce=energia(23)
425 etot=wsc*evdw+wscp*evdw2+welec*ees+wvdwpp*evdw1
426 & +wang*ebe+wtor*etors+wscloc*escloc
427 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
428 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
429 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
430 & +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran+Eafmforce
432 etot=wsc*evdw+wscp*evdw2+welec*(ees+evdw1)
433 & +wang*ebe+wtor*etors+wscloc*escloc
434 & +wstrain*ehpb+wcorr*ecorr+wcorr5*ecorr5
435 & +wcorr6*ecorr6+wturn4*eello_turn4+wturn3*eello_turn3
436 & +wturn6*eturn6+wel_loc*eel_loc+edihcnstr+wtor_d*etors_d
437 & +wbond*estr+Uconst+wsccor*esccor+wliptran*eliptran
444 if (isnan(etot).ne.0) energia(0)=1.0d+99
446 if (isnan(etot)) energia(0)=1.0d+99
451 idumm=proc_proc(etot,i)
453 call proc_proc(etot,i)
455 if(i.eq.1)energia(0)=1.0d+99
462 c-------------------------------------------------------------------------------
463 subroutine sum_gradient
464 implicit real*8 (a-h,o-z)
469 cMS$ATTRIBUTES C :: proc_proc
475 double precision gradbufc(3,-1:maxres),gradbufx(3,-1:maxres),
476 & glocbuf(4*maxres),gradbufc_sum(3,-1:maxres)
477 & ,gloc_scbuf(3,-1:maxres)
478 include 'COMMON.SETUP'
479 include 'COMMON.IOUNITS'
480 include 'COMMON.FFIELD'
481 include 'COMMON.DERIV'
482 include 'COMMON.INTERACT'
483 include 'COMMON.SBRIDGE'
484 include 'COMMON.CHAIN'
486 include 'COMMON.CONTROL'
487 include 'COMMON.TIME1'
488 include 'COMMON.MAXGRAD'
489 include 'COMMON.SCCOR'
494 write (iout,*) "sum_gradient gvdwc, gvdwx"
496 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
497 & i,(gvdwx(j,i),j=1,3),(gvdwc(j,i),j=1,3)
502 C FG slaves call the following matching MPI_Bcast in ERGASTULUM
503 if (nfgtasks.gt.1 .and. fg_rank.eq.0)
504 & call MPI_Bcast(1,1,MPI_INTEGER,king,FG_COMM,IERROR)
507 C 9/29/08 AL Transform parts of gradients in site coordinates to the gradient
508 C in virtual-bond-vector coordinates
511 c write (iout,*) "gel_loc gel_loc_long and gel_loc_loc"
513 c write (iout,'(i5,3f10.5,2x,3f10.5,2x,f10.5)')
514 c & i,(gel_loc(j,i),j=1,3),(gel_loc_long(j,i),j=1,3),gel_loc_loc(i)
516 c write (iout,*) "gel_loc_tur3 gel_loc_turn4"
518 c write (iout,'(i5,3f10.5,2x,f10.5)')
519 c & i,(gcorr4_turn(j,i),j=1,3),gel_loc_turn4(i)
521 write (iout,*) "gradcorr5 gradcorr5_long gradcorr5_loc"
523 write (iout,'(i3,3f10.5,5x,3f10.5,5x,f10.5)')
524 & i,(gradcorr5(j,i),j=1,3),(gradcorr5_long(j,i),j=1,3),
532 gradbufc(j,i)=wsc*gvdwc(j,i)+
533 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
534 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
535 & wel_loc*gel_loc_long(j,i)+
536 & wcorr*gradcorr_long(j,i)+
537 & wcorr5*gradcorr5_long(j,i)+
538 & wcorr6*gradcorr6_long(j,i)+
539 & wturn6*gcorr6_turn_long(j,i)+
541 & +wliptran*gliptranc(j,i)
549 gradbufc(j,i)=wsc*gvdwc(j,i)+
550 & wscp*(gvdwc_scp(j,i)+gvdwc_scpp(j,i))+
551 & welec*gelc_long(j,i)+
553 & wel_loc*gel_loc_long(j,i)+
554 & wcorr*gradcorr_long(j,i)+
555 & wcorr5*gradcorr5_long(j,i)+
556 & wcorr6*gradcorr6_long(j,i)+
557 & wturn6*gcorr6_turn_long(j,i)+
559 & +wliptran*gliptranc(j,i)
566 if (nfgtasks.gt.1) then
569 write (iout,*) "gradbufc before allreduce"
571 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
577 gradbufc_sum(j,i)=gradbufc(j,i)
580 c call MPI_AllReduce(gradbufc(1,1),gradbufc_sum(1,1),3*nres,
581 c & MPI_DOUBLE_PRECISION,MPI_SUM,FG_COMM,IERR)
582 c time_reduce=time_reduce+MPI_Wtime()-time00
584 c write (iout,*) "gradbufc_sum after allreduce"
586 c write (iout,'(i3,3f10.5)') i,(gradbufc_sum(j,i),j=1,3)
591 c time_allreduce=time_allreduce+MPI_Wtime()-time00
599 write (iout,*) "igrad_start",igrad_start," igrad_end",igrad_end
600 write (iout,*) (i," jgrad_start",jgrad_start(i),
601 & " jgrad_end ",jgrad_end(i),
602 & i=igrad_start,igrad_end)
605 c Obsolete and inefficient code; we can make the effort O(n) and, therefore,
606 c do not parallelize this part.
608 c do i=igrad_start,igrad_end
609 c do j=jgrad_start(i),jgrad_end(i)
611 c gradbufc(k,i)=gradbufc(k,i)+gradbufc_sum(k,j)
616 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
620 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
624 write (iout,*) "gradbufc after summing"
626 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
633 write (iout,*) "gradbufc"
635 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
641 gradbufc_sum(j,i)=gradbufc(j,i)
646 gradbufc(j,nres-1)=gradbufc_sum(j,nres)
650 gradbufc(j,i)=gradbufc(j,i+1)+gradbufc_sum(j,i+1)
655 c gradbufc(k,i)=0.0d0
659 c gradbufc(k,i)=gradbufc(k,i)+gradbufc(k,j)
664 write (iout,*) "gradbufc after summing"
666 write (iout,'(i3,3f10.5)') i,(gradbufc(j,i),j=1,3)
674 gradbufc(k,nres)=0.0d0
679 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
680 & wel_loc*gel_loc(j,i)+
681 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
682 & welec*gelc_long(j,i)+wvdwpp*gvdwpp(j,i)+
683 & wel_loc*gel_loc_long(j,i)+
684 & wcorr*gradcorr_long(j,i)+
685 & wcorr5*gradcorr5_long(j,i)+
686 & wcorr6*gradcorr6_long(j,i)+
687 & wturn6*gcorr6_turn_long(j,i))+
689 & wcorr*gradcorr(j,i)+
690 & wturn3*gcorr3_turn(j,i)+
691 & wturn4*gcorr4_turn(j,i)+
692 & wcorr5*gradcorr5(j,i)+
693 & wcorr6*gradcorr6(j,i)+
694 & wturn6*gcorr6_turn(j,i)+
695 & wsccor*gsccorc(j,i)
696 & +wscloc*gscloc(j,i)
697 & +wliptran*gliptranc(j,i)
700 gradc(j,i,icg)=gradbufc(j,i)+welec*gelc(j,i)+
701 & wel_loc*gel_loc(j,i)+
702 & 0.5d0*(wscp*gvdwc_scpp(j,i)+
703 & welec*gelc_long(j,i)
704 & wel_loc*gel_loc_long(j,i)+
705 & wcorr*gcorr_long(j,i)+
706 & wcorr5*gradcorr5_long(j,i)+
707 & wcorr6*gradcorr6_long(j,i)+
708 & wturn6*gcorr6_turn_long(j,i))+
710 & wcorr*gradcorr(j,i)+
711 & wturn3*gcorr3_turn(j,i)+
712 & wturn4*gcorr4_turn(j,i)+
713 & wcorr5*gradcorr5(j,i)+
714 & wcorr6*gradcorr6(j,i)+
715 & wturn6*gcorr6_turn(j,i)+
716 & wsccor*gsccorc(j,i)
717 & +wscloc*gscloc(j,i)
718 & +wliptran*gliptranc(j,i)
722 gradx(j,i,icg)=wsc*gvdwx(j,i)+wscp*gradx_scp(j,i)+
724 & wstrain*ghpbx(j,i)+wcorr*gradxorr(j,i)+
725 & wsccor*gsccorx(j,i)
726 & +wscloc*gsclocx(j,i)
727 & +wliptran*gliptranx(j,i)
731 write (iout,*) "gloc before adding corr"
733 write (iout,*) i,gloc(i,icg)
737 gloc(i,icg)=gloc(i,icg)+wcorr*gcorr_loc(i)
738 & +wcorr5*g_corr5_loc(i)
739 & +wcorr6*g_corr6_loc(i)
740 & +wturn4*gel_loc_turn4(i)
741 & +wturn3*gel_loc_turn3(i)
742 & +wturn6*gel_loc_turn6(i)
743 & +wel_loc*gel_loc_loc(i)
746 write (iout,*) "gloc after adding corr"
748 write (iout,*) i,gloc(i,icg)
752 if (nfgtasks.gt.1) then
755 gradbufc(j,i)=gradc(j,i,icg)
756 gradbufx(j,i)=gradx(j,i,icg)
760 glocbuf(i)=gloc(i,icg)
764 write (iout,*) "gloc_sc before reduce"
767 write (iout,*) i,j,gloc_sc(j,i,icg)
774 gloc_scbuf(j,i)=gloc_sc(j,i,icg)
778 call MPI_Barrier(FG_COMM,IERR)
779 time_barrier_g=time_barrier_g+MPI_Wtime()-time00
781 call MPI_Reduce(gradbufc(1,1),gradc(1,1,icg),3*nres,
782 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
783 call MPI_Reduce(gradbufx(1,1),gradx(1,1,icg),3*nres,
784 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
785 call MPI_Reduce(glocbuf(1),gloc(1,icg),4*nres,
786 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
787 time_reduce=time_reduce+MPI_Wtime()-time00
788 call MPI_Reduce(gloc_scbuf(1,1),gloc_sc(1,1,icg),3*nres,
789 & MPI_DOUBLE_PRECISION,MPI_SUM,king,FG_COMM,IERR)
790 time_reduce=time_reduce+MPI_Wtime()-time00
793 write (iout,*) "gloc_sc after reduce"
796 write (iout,*) i,j,gloc_sc(j,i,icg)
802 write (iout,*) "gloc after reduce"
804 write (iout,*) i,gloc(i,icg)
809 if (gnorm_check) then
811 c Compute the maximum elements of the gradient
821 gcorr3_turn_max=0.0d0
822 gcorr4_turn_max=0.0d0
825 gcorr6_turn_max=0.0d0
835 gvdwc_norm=dsqrt(scalar(gvdwc(1,i),gvdwc(1,i)))
836 if (gvdwc_norm.gt.gvdwc_max) gvdwc_max=gvdwc_norm
837 gvdwc_scp_norm=dsqrt(scalar(gvdwc_scp(1,i),gvdwc_scp(1,i)))
838 if (gvdwc_scp_norm.gt.gvdwc_scp_max)
839 & gvdwc_scp_max=gvdwc_scp_norm
840 gelc_norm=dsqrt(scalar(gelc(1,i),gelc(1,i)))
841 if (gelc_norm.gt.gelc_max) gelc_max=gelc_norm
842 gvdwpp_norm=dsqrt(scalar(gvdwpp(1,i),gvdwpp(1,i)))
843 if (gvdwpp_norm.gt.gvdwpp_max) gvdwpp_max=gvdwpp_norm
844 gradb_norm=dsqrt(scalar(gradb(1,i),gradb(1,i)))
845 if (gradb_norm.gt.gradb_max) gradb_max=gradb_norm
846 ghpbc_norm=dsqrt(scalar(ghpbc(1,i),ghpbc(1,i)))
847 if (ghpbc_norm.gt.ghpbc_max) ghpbc_max=ghpbc_norm
848 gradcorr_norm=dsqrt(scalar(gradcorr(1,i),gradcorr(1,i)))
849 if (gradcorr_norm.gt.gradcorr_max) gradcorr_max=gradcorr_norm
850 gel_loc_norm=dsqrt(scalar(gel_loc(1,i),gel_loc(1,i)))
851 if (gel_loc_norm.gt.gel_loc_max) gel_loc_max=gel_loc_norm
852 gcorr3_turn_norm=dsqrt(scalar(gcorr3_turn(1,i),
854 if (gcorr3_turn_norm.gt.gcorr3_turn_max)
855 & gcorr3_turn_max=gcorr3_turn_norm
856 gcorr4_turn_norm=dsqrt(scalar(gcorr4_turn(1,i),
858 if (gcorr4_turn_norm.gt.gcorr4_turn_max)
859 & gcorr4_turn_max=gcorr4_turn_norm
860 gradcorr5_norm=dsqrt(scalar(gradcorr5(1,i),gradcorr5(1,i)))
861 if (gradcorr5_norm.gt.gradcorr5_max)
862 & gradcorr5_max=gradcorr5_norm
863 gradcorr6_norm=dsqrt(scalar(gradcorr6(1,i),gradcorr6(1,i)))
864 if (gradcorr6_norm.gt.gradcorr6_max) gcorr6_max=gradcorr6_norm
865 gcorr6_turn_norm=dsqrt(scalar(gcorr6_turn(1,i),
867 if (gcorr6_turn_norm.gt.gcorr6_turn_max)
868 & gcorr6_turn_max=gcorr6_turn_norm
869 gsccorr_norm=dsqrt(scalar(gsccorc(1,i),gsccorc(1,i)))
870 if (gsccorr_norm.gt.gsccorr_max) gsccorr_max=gsccorr_norm
871 gscloc_norm=dsqrt(scalar(gscloc(1,i),gscloc(1,i)))
872 if (gscloc_norm.gt.gscloc_max) gscloc_max=gscloc_norm
873 gvdwx_norm=dsqrt(scalar(gvdwx(1,i),gvdwx(1,i)))
874 if (gvdwx_norm.gt.gvdwx_max) gvdwx_max=gvdwx_norm
875 gradx_scp_norm=dsqrt(scalar(gradx_scp(1,i),gradx_scp(1,i)))
876 if (gradx_scp_norm.gt.gradx_scp_max)
877 & gradx_scp_max=gradx_scp_norm
878 ghpbx_norm=dsqrt(scalar(ghpbx(1,i),ghpbx(1,i)))
879 if (ghpbx_norm.gt.ghpbx_max) ghpbx_max=ghpbx_norm
880 gradxorr_norm=dsqrt(scalar(gradxorr(1,i),gradxorr(1,i)))
881 if (gradxorr_norm.gt.gradxorr_max) gradxorr_max=gradxorr_norm
882 gsccorrx_norm=dsqrt(scalar(gsccorx(1,i),gsccorx(1,i)))
883 if (gsccorrx_norm.gt.gsccorrx_max) gsccorrx_max=gsccorrx_norm
884 gsclocx_norm=dsqrt(scalar(gsclocx(1,i),gsclocx(1,i)))
885 if (gsclocx_norm.gt.gsclocx_max) gsclocx_max=gsclocx_norm
889 open(istat,file=statname,position="append")
891 open(istat,file=statname,access="append")
893 write (istat,'(1h#,21f10.2)') gvdwc_max,gvdwc_scp_max,
894 & gelc_max,gvdwpp_max,gradb_max,ghpbc_max,
895 & gradcorr_max,gel_loc_max,gcorr3_turn_max,gcorr4_turn_max,
896 & gradcorr5_max,gradcorr6_max,gcorr6_turn_max,gsccorc_max,
897 & gscloc_max,gvdwx_max,gradx_scp_max,ghpbx_max,gradxorr_max,
898 & gsccorx_max,gsclocx_max
900 if (gvdwc_max.gt.1.0d4) then
901 write (iout,*) "gvdwc gvdwx gradb gradbx"
903 write(iout,'(i5,4(3f10.2,5x))') i,(gvdwc(j,i),gvdwx(j,i),
904 & gradb(j,i),gradbx(j,i),j=1,3)
906 call pdbout(0.0d0,'cipiszcze',iout)
912 write (iout,*) "gradc gradx gloc"
914 write (iout,'(i5,3f10.5,5x,3f10.5,5x,f10.5)')
915 & i,(gradc(j,i,icg),j=1,3),(gradx(j,i,icg),j=1,3),gloc(i,icg)
919 time_sumgradient=time_sumgradient+MPI_Wtime()-time01
923 c-------------------------------------------------------------------------------
924 subroutine rescale_weights(t_bath)
925 implicit real*8 (a-h,o-z)
927 include 'COMMON.IOUNITS'
928 include 'COMMON.FFIELD'
929 include 'COMMON.SBRIDGE'
930 double precision kfac /2.4d0/
931 double precision x,x2,x3,x4,x5,licznik /1.12692801104297249644/
933 c facT=2*temp0/(t_bath+temp0)
934 if (rescale_mode.eq.0) then
940 else if (rescale_mode.eq.1) then
941 facT=kfac/(kfac-1.0d0+t_bath/temp0)
942 facT2=kfac**2/(kfac**2-1.0d0+(t_bath/temp0)**2)
943 facT3=kfac**3/(kfac**3-1.0d0+(t_bath/temp0)**3)
944 facT4=kfac**4/(kfac**4-1.0d0+(t_bath/temp0)**4)
945 facT5=kfac**5/(kfac**5-1.0d0+(t_bath/temp0)**5)
946 else if (rescale_mode.eq.2) then
952 facT=licznik/dlog(dexp(x)+dexp(-x))
953 facT2=licznik/dlog(dexp(x2)+dexp(-x2))
954 facT3=licznik/dlog(dexp(x3)+dexp(-x3))
955 facT4=licznik/dlog(dexp(x4)+dexp(-x4))
956 facT5=licznik/dlog(dexp(x5)+dexp(-x5))
958 write (iout,*) "Wrong RESCALE_MODE",rescale_mode
959 write (*,*) "Wrong RESCALE_MODE",rescale_mode
961 call MPI_Finalize(MPI_COMM_WORLD,IERROR)
965 welec=weights(3)*fact
966 wcorr=weights(4)*fact3
967 wcorr5=weights(5)*fact4
968 wcorr6=weights(6)*fact5
969 wel_loc=weights(7)*fact2
970 wturn3=weights(8)*fact2
971 wturn4=weights(9)*fact3
972 wturn6=weights(10)*fact5
973 wtor=weights(13)*fact
974 wtor_d=weights(14)*fact2
975 wsccor=weights(21)*fact
979 C------------------------------------------------------------------------
980 subroutine enerprint(energia)
981 implicit real*8 (a-h,o-z)
983 include 'COMMON.IOUNITS'
984 include 'COMMON.FFIELD'
985 include 'COMMON.SBRIDGE'
987 double precision energia(0:n_ene)
992 evdw2=energia(2)+energia(18)
1004 eello_turn3=energia(8)
1005 eello_turn4=energia(9)
1006 eello_turn6=energia(10)
1012 edihcnstr=energia(19)
1016 eliptran=energia(22)
1017 Eafmforce=energia(23)
1019 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,evdw1,wvdwpp,
1020 & estr,wbond,ebe,wang,
1021 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1023 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1024 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccor,
1025 & edihcnstr,ebr*nss,
1026 & Uconst,eliptran,wliptran,Eafmforce,etot
1027 10 format (/'Virtual-chain energies:'//
1028 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1029 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1030 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1031 & 'EVDWPP=',1pE16.6,' WEIGHT=',1pD16.6,' (p-p VDW)'/
1032 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1033 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1034 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1035 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1036 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1037 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1038 & ' (SS bridges & dist. cnstr.)'/
1039 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1040 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1041 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1042 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1043 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1044 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1045 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1046 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1047 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1048 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1049 & 'UCONST= ',1pE16.6,' (Constraint energy)'/
1050 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
1051 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
1052 & 'ETOT= ',1pE16.6,' (total)')
1055 write (iout,10) evdw,wsc,evdw2,wscp,ees,welec,
1056 & estr,wbond,ebe,wang,
1057 & escloc,wscloc,etors,wtor,etors_d,wtor_d,ehpb,wstrain,
1059 & ecorr5,wcorr5,ecorr6,wcorr6,eel_loc,wel_loc,eello_turn3,wturn3,
1060 & eello_turn4,wturn4,eello_turn6,wturn6,esccor,wsccro,edihcnstr,
1061 & ebr*nss,Uconst,eliptran,wliptran,Eafmforc,etot
1062 10 format (/'Virtual-chain energies:'//
1063 & 'EVDW= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-SC)'/
1064 & 'EVDW2= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC-p)'/
1065 & 'EES= ',1pE16.6,' WEIGHT=',1pD16.6,' (p-p)'/
1066 & 'ESTR= ',1pE16.6,' WEIGHT=',1pD16.6,' (stretching)'/
1067 & 'EBE= ',1pE16.6,' WEIGHT=',1pD16.6,' (bending)'/
1068 & 'ESC= ',1pE16.6,' WEIGHT=',1pD16.6,' (SC local)'/
1069 & 'ETORS= ',1pE16.6,' WEIGHT=',1pD16.6,' (torsional)'/
1070 & 'ETORSD=',1pE16.6,' WEIGHT=',1pD16.6,' (double torsional)'/
1071 & 'EHBP= ',1pE16.6,' WEIGHT=',1pD16.6,
1072 & ' (SS bridges & dist. cnstr.)'/
1073 & 'ECORR4=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1074 & 'ECORR5=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1075 & 'ECORR6=',1pE16.6,' WEIGHT=',1pD16.6,' (multi-body)'/
1076 & 'EELLO= ',1pE16.6,' WEIGHT=',1pD16.6,' (electrostatic-local)'/
1077 & 'ETURN3=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 3rd order)'/
1078 & 'ETURN4=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 4th order)'/
1079 & 'ETURN6=',1pE16.6,' WEIGHT=',1pD16.6,' (turns, 6th order)'/
1080 & 'ESCCOR=',1pE16.6,' WEIGHT=',1pD16.6,' (backbone-rotamer corr)'/
1081 & 'EDIHC= ',1pE16.6,' (dihedral angle constraints)'/
1082 & 'ESS= ',1pE16.6,' (disulfide-bridge intrinsic energy)'/
1083 & 'UCONST=',1pE16.6,' (Constraint energy)'/
1084 & 'ELT=',1pE16.6, ' WEIGHT=',1pD16.6,' (Lipid transfer energy)'/
1085 & 'EAFM= ',1pE16.6,' (atomic-force microscopy)'/
1086 & 'ETOT= ',1pE16.6,' (total)')
1090 C-----------------------------------------------------------------------
1091 subroutine elj(evdw)
1093 C This subroutine calculates the interaction energy of nonbonded side chains
1094 C assuming the LJ potential of interaction.
1096 implicit real*8 (a-h,o-z)
1097 include 'DIMENSIONS'
1098 parameter (accur=1.0d-10)
1099 include 'COMMON.GEO'
1100 include 'COMMON.VAR'
1101 include 'COMMON.LOCAL'
1102 include 'COMMON.CHAIN'
1103 include 'COMMON.DERIV'
1104 include 'COMMON.INTERACT'
1105 include 'COMMON.TORSION'
1106 include 'COMMON.SBRIDGE'
1107 include 'COMMON.NAMES'
1108 include 'COMMON.IOUNITS'
1109 include 'COMMON.CONTACTS'
1111 c write(iout,*)'Entering ELJ nnt=',nnt,' nct=',nct,' expon=',expon
1113 do i=iatsc_s,iatsc_e
1114 itypi=iabs(itype(i))
1115 if (itypi.eq.ntyp1) cycle
1116 itypi1=iabs(itype(i+1))
1123 C Calculate SC interaction energy.
1125 do iint=1,nint_gr(i)
1126 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
1127 cd & 'iend=',iend(i,iint)
1128 do j=istart(i,iint),iend(i,iint)
1129 itypj=iabs(itype(j))
1130 if (itypj.eq.ntyp1) cycle
1134 C Change 12/1/95 to calculate four-body interactions
1135 rij=xj*xj+yj*yj+zj*zj
1137 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
1138 eps0ij=eps(itypi,itypj)
1140 C have you changed here?
1144 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1145 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1146 cd write (iout,'(2(a3,i3,2x),6(1pd12.4)/2(3(1pd12.4),5x)/)')
1147 cd & restyp(itypi),i,restyp(itypj),j,a(itypi,itypj),
1148 cd & bb(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,epsi,sigm,
1149 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1152 C Calculate the components of the gradient in DC and X
1154 fac=-rrij*(e1+evdwij)
1159 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1160 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1161 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1162 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1166 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1170 C 12/1/95, revised on 5/20/97
1172 C Calculate the contact function. The ith column of the array JCONT will
1173 C contain the numbers of atoms that make contacts with the atom I (of numbers
1174 C greater than I). The arrays FACONT and GACONT will contain the values of
1175 C the contact function and its derivative.
1177 C Uncomment next line, if the correlation interactions include EVDW explicitly.
1178 c if (j.gt.i+1 .and. evdwij.le.0.0D0) then
1179 C Uncomment next line, if the correlation interactions are contact function only
1180 if (j.gt.i+1.and. eps0ij.gt.0.0D0) then
1182 sigij=sigma(itypi,itypj)
1183 r0ij=rs0(itypi,itypj)
1185 C Check whether the SC's are not too far to make a contact.
1188 call gcont(rij,rcut,1.0d0,0.2d0*rcut,fcont,fprimcont)
1189 C Add a new contact, if the SC's are close enough, but not too close (r<sigma).
1191 if (fcont.gt.0.0D0) then
1192 C If the SC-SC distance if close to sigma, apply spline.
1193 cAdam call gcont(-rij,-1.03d0*sigij,2.0d0*sigij,1.0d0,
1194 cAdam & fcont1,fprimcont1)
1195 cAdam fcont1=1.0d0-fcont1
1196 cAdam if (fcont1.gt.0.0d0) then
1197 cAdam fprimcont=fprimcont*fcont1+fcont*fprimcont1
1198 cAdam fcont=fcont*fcont1
1200 C Uncomment following 4 lines to have the geometric average of the epsilon0's
1201 cga eps0ij=1.0d0/dsqrt(eps0ij)
1203 cga gg(k)=gg(k)*eps0ij
1205 cga eps0ij=-evdwij*eps0ij
1206 C Uncomment for AL's type of SC correlation interactions.
1207 cadam eps0ij=-evdwij
1208 num_conti=num_conti+1
1209 jcont(num_conti,i)=j
1210 facont(num_conti,i)=fcont*eps0ij
1211 fprimcont=eps0ij*fprimcont/rij
1213 cAdam gacont(1,num_conti,i)=-fprimcont*xj+fcont*gg(1)
1214 cAdam gacont(2,num_conti,i)=-fprimcont*yj+fcont*gg(2)
1215 cAdam gacont(3,num_conti,i)=-fprimcont*zj+fcont*gg(3)
1216 C Uncomment following 3 lines for Skolnick's type of SC correlation.
1217 gacont(1,num_conti,i)=-fprimcont*xj
1218 gacont(2,num_conti,i)=-fprimcont*yj
1219 gacont(3,num_conti,i)=-fprimcont*zj
1220 cd write (iout,'(2i5,2f10.5)') i,j,rij,facont(num_conti,i)
1221 cd write (iout,'(2i3,3f10.5)')
1222 cd & i,j,(gacont(kk,num_conti,i),kk=1,3)
1228 num_cont(i)=num_conti
1232 gvdwc(j,i)=expon*gvdwc(j,i)
1233 gvdwx(j,i)=expon*gvdwx(j,i)
1236 C******************************************************************************
1240 C To save time, the factor of EXPON has been extracted from ALL components
1241 C of GVDWC and GRADX. Remember to multiply them by this factor before further
1244 C******************************************************************************
1247 C-----------------------------------------------------------------------------
1248 subroutine eljk(evdw)
1250 C This subroutine calculates the interaction energy of nonbonded side chains
1251 C assuming the LJK potential of interaction.
1253 implicit real*8 (a-h,o-z)
1254 include 'DIMENSIONS'
1255 include 'COMMON.GEO'
1256 include 'COMMON.VAR'
1257 include 'COMMON.LOCAL'
1258 include 'COMMON.CHAIN'
1259 include 'COMMON.DERIV'
1260 include 'COMMON.INTERACT'
1261 include 'COMMON.IOUNITS'
1262 include 'COMMON.NAMES'
1265 c print *,'Entering ELJK nnt=',nnt,' nct=',nct,' expon=',expon
1267 do i=iatsc_s,iatsc_e
1268 itypi=iabs(itype(i))
1269 if (itypi.eq.ntyp1) cycle
1270 itypi1=iabs(itype(i+1))
1275 C Calculate SC interaction energy.
1277 do iint=1,nint_gr(i)
1278 do j=istart(i,iint),iend(i,iint)
1279 itypj=iabs(itype(j))
1280 if (itypj.eq.ntyp1) cycle
1284 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1285 fac_augm=rrij**expon
1286 e_augm=augm(itypi,itypj)*fac_augm
1287 r_inv_ij=dsqrt(rrij)
1289 r_shift_inv=1.0D0/(rij+r0(itypi,itypj)-sigma(itypi,itypj))
1290 fac=r_shift_inv**expon
1291 C have you changed here?
1295 cd sigm=dabs(aa(itypi,itypj)/bb(itypi,itypj))**(1.0D0/6.0D0)
1296 cd epsi=bb(itypi,itypj)**2/aa(itypi,itypj)
1297 cd write (iout,'(2(a3,i3,2x),8(1pd12.4)/2(3(1pd12.4),5x)/)')
1298 cd & restyp(itypi),i,restyp(itypj),j,aa(itypi,itypj),
1299 cd & bb(itypi,itypj),augm(itypi,itypj),epsi,sigm,
1300 cd & sigma(itypi,itypj),1.0D0/dsqrt(rrij),evdwij,
1301 cd & (c(k,i),k=1,3),(c(k,j),k=1,3)
1304 C Calculate the components of the gradient in DC and X
1306 fac=-2.0D0*rrij*e_augm-r_inv_ij*r_shift_inv*(e1+e1+e2)
1311 gvdwx(k,i)=gvdwx(k,i)-gg(k)
1312 gvdwx(k,j)=gvdwx(k,j)+gg(k)
1313 gvdwc(k,i)=gvdwc(k,i)-gg(k)
1314 gvdwc(k,j)=gvdwc(k,j)+gg(k)
1318 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
1326 gvdwc(j,i)=expon*gvdwc(j,i)
1327 gvdwx(j,i)=expon*gvdwx(j,i)
1332 C-----------------------------------------------------------------------------
1333 subroutine ebp(evdw)
1335 C This subroutine calculates the interaction energy of nonbonded side chains
1336 C assuming the Berne-Pechukas potential of interaction.
1338 implicit real*8 (a-h,o-z)
1339 include 'DIMENSIONS'
1340 include 'COMMON.GEO'
1341 include 'COMMON.VAR'
1342 include 'COMMON.LOCAL'
1343 include 'COMMON.CHAIN'
1344 include 'COMMON.DERIV'
1345 include 'COMMON.NAMES'
1346 include 'COMMON.INTERACT'
1347 include 'COMMON.IOUNITS'
1348 include 'COMMON.CALC'
1349 common /srutu/ icall
1350 c double precision rrsave(maxdim)
1353 c print *,'Entering EBP nnt=',nnt,' nct=',nct,' expon=',expon
1355 c if (icall.eq.0) then
1361 do i=iatsc_s,iatsc_e
1362 itypi=iabs(itype(i))
1363 if (itypi.eq.ntyp1) cycle
1364 itypi1=iabs(itype(i+1))
1368 dxi=dc_norm(1,nres+i)
1369 dyi=dc_norm(2,nres+i)
1370 dzi=dc_norm(3,nres+i)
1371 c dsci_inv=dsc_inv(itypi)
1372 dsci_inv=vbld_inv(i+nres)
1374 C Calculate SC interaction energy.
1376 do iint=1,nint_gr(i)
1377 do j=istart(i,iint),iend(i,iint)
1379 itypj=iabs(itype(j))
1380 if (itypj.eq.ntyp1) cycle
1381 c dscj_inv=dsc_inv(itypj)
1382 dscj_inv=vbld_inv(j+nres)
1383 chi1=chi(itypi,itypj)
1384 chi2=chi(itypj,itypi)
1391 alf12=0.5D0*(alf1+alf2)
1392 C For diagnostics only!!!
1405 dxj=dc_norm(1,nres+j)
1406 dyj=dc_norm(2,nres+j)
1407 dzj=dc_norm(3,nres+j)
1408 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1409 cd if (icall.eq.0) then
1415 C Calculate the angle-dependent terms of energy & contributions to derivatives.
1417 C Calculate whole angle-dependent part of epsilon and contributions
1418 C to its derivatives
1419 C have you changed here?
1420 fac=(rrij*sigsq)**expon2
1423 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1424 eps2der=evdwij*eps3rt
1425 eps3der=evdwij*eps2rt
1426 evdwij=evdwij*eps2rt*eps3rt
1429 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1431 cd write (iout,'(2(a3,i3,2x),15(0pf7.3))')
1432 cd & restyp(itypi),i,restyp(itypj),j,
1433 cd & epsi,sigm,chi1,chi2,chip1,chip2,
1434 cd & eps1,eps2rt**2,eps3rt**2,1.0D0/dsqrt(sigsq),
1435 cd & om1,om2,om12,1.0D0/dsqrt(rrij),
1438 C Calculate gradient components.
1439 e1=e1*eps1*eps2rt**2*eps3rt**2
1440 fac=-expon*(e1+evdwij)
1443 C Calculate radial part of the gradient
1447 C Calculate the angular part of the gradient and sum add the contributions
1448 C to the appropriate components of the Cartesian gradient.
1456 C-----------------------------------------------------------------------------
1457 subroutine egb(evdw)
1459 C This subroutine calculates the interaction energy of nonbonded side chains
1460 C assuming the Gay-Berne potential of interaction.
1462 implicit real*8 (a-h,o-z)
1463 include 'DIMENSIONS'
1464 include 'COMMON.GEO'
1465 include 'COMMON.VAR'
1466 include 'COMMON.LOCAL'
1467 include 'COMMON.CHAIN'
1468 include 'COMMON.DERIV'
1469 include 'COMMON.NAMES'
1470 include 'COMMON.INTERACT'
1471 include 'COMMON.IOUNITS'
1472 include 'COMMON.CALC'
1473 include 'COMMON.CONTROL'
1474 include 'COMMON.SPLITELE'
1475 include 'COMMON.SBRIDGE'
1477 integer xshift,yshift,zshift
1479 ccccc energy_dec=.false.
1480 C print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1483 c if (icall.eq.0) lprn=.false.
1485 C the loop over all 27 posible neigbours (for xshift=0,yshift=0,zshift=0
1486 C we have the original box)
1490 do i=iatsc_s,iatsc_e
1491 itypi=iabs(itype(i))
1492 if (itypi.eq.ntyp1) cycle
1493 itypi1=iabs(itype(i+1))
1497 C Return atom into box, boxxsize is size of box in x dimension
1499 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
1500 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
1501 C Condition for being inside the proper box
1502 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
1503 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
1507 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
1508 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
1509 C Condition for being inside the proper box
1510 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
1511 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
1515 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
1516 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
1517 C Condition for being inside the proper box
1518 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
1519 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
1523 if (xi.lt.0) xi=xi+boxxsize
1525 if (yi.lt.0) yi=yi+boxysize
1527 if (zi.lt.0) zi=zi+boxzsize
1528 C define scaling factor for lipids
1530 C if (positi.le.0) positi=positi+boxzsize
1532 C first for peptide groups
1533 c for each residue check if it is in lipid or lipid water border area
1534 if ((zi.gt.bordlipbot)
1535 &.and.(zi.lt.bordliptop)) then
1536 C the energy transfer exist
1537 if (zi.lt.buflipbot) then
1538 C what fraction I am in
1540 & ((zi-bordlipbot)/lipbufthick)
1541 C lipbufthick is thickenes of lipid buffore
1542 sslipi=sscalelip(fracinbuf)
1543 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1544 elseif (zi.gt.bufliptop) then
1545 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1546 sslipi=sscalelip(fracinbuf)
1547 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1557 C xi=xi+xshift*boxxsize
1558 C yi=yi+yshift*boxysize
1559 C zi=zi+zshift*boxzsize
1561 dxi=dc_norm(1,nres+i)
1562 dyi=dc_norm(2,nres+i)
1563 dzi=dc_norm(3,nres+i)
1564 c dsci_inv=dsc_inv(itypi)
1565 dsci_inv=vbld_inv(i+nres)
1566 c write (iout,*) "i",i,dsc_inv(itypi),dsci_inv,1.0d0/vbld(i+nres)
1567 c write (iout,*) "dcnori",dxi*dxi+dyi*dyi+dzi*dzi
1569 C Calculate SC interaction energy.
1571 do iint=1,nint_gr(i)
1572 do j=istart(i,iint),iend(i,iint)
1573 IF (dyn_ss_mask(i).and.dyn_ss_mask(j)) THEN
1574 call dyn_ssbond_ene(i,j,evdwij)
1576 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,a3)')
1577 & 'evdw',i,j,evdwij,' ss'
1580 itypj=iabs(itype(j))
1581 if (itypj.eq.ntyp1) cycle
1582 c dscj_inv=dsc_inv(itypj)
1583 dscj_inv=vbld_inv(j+nres)
1584 c write (iout,*) "j",j,dsc_inv(itypj),dscj_inv,
1585 c & 1.0d0/vbld(j+nres)
1586 c write (iout,*) "i",i," j", j," itype",itype(i),itype(j)
1587 sig0ij=sigma(itypi,itypj)
1588 chi1=chi(itypi,itypj)
1589 chi2=chi(itypj,itypi)
1596 alf12=0.5D0*(alf1+alf2)
1597 C For diagnostics only!!!
1610 C Return atom J into box the original box
1612 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
1613 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
1614 C Condition for being inside the proper box
1615 c if ((xj.gt.((0.5d0)*boxxsize)).or.
1616 c & (xj.lt.((-0.5d0)*boxxsize))) then
1620 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
1621 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
1622 C Condition for being inside the proper box
1623 c if ((yj.gt.((0.5d0)*boxysize)).or.
1624 c & (yj.lt.((-0.5d0)*boxysize))) then
1628 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
1629 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
1630 C Condition for being inside the proper box
1631 c if ((zj.gt.((0.5d0)*boxzsize)).or.
1632 c & (zj.lt.((-0.5d0)*boxzsize))) then
1636 if (xj.lt.0) xj=xj+boxxsize
1638 if (yj.lt.0) yj=yj+boxysize
1640 if (zj.lt.0) zj=zj+boxzsize
1641 if ((zj.gt.bordlipbot)
1642 &.and.(zj.lt.bordliptop)) then
1643 C the energy transfer exist
1644 if (zj.lt.buflipbot) then
1645 C what fraction I am in
1647 & ((zj-bordlipbot)/lipbufthick)
1648 C lipbufthick is thickenes of lipid buffore
1649 sslipj=sscalelip(fracinbuf)
1650 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1651 elseif (zj.gt.bufliptop) then
1652 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1653 sslipj=sscalelip(fracinbuf)
1654 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1663 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1664 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1665 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1666 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1667 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'(2e10.5)')
1668 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
1669 C if (ssgradlipj.gt.0.0d0) print *,"??WTF??"
1670 C print *,sslipi,sslipj,bordlipbot,zi,zj
1671 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1679 xj=xj_safe+xshift*boxxsize
1680 yj=yj_safe+yshift*boxysize
1681 zj=zj_safe+zshift*boxzsize
1682 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1683 if(dist_temp.lt.dist_init) then
1693 if (subchap.eq.1) then
1702 dxj=dc_norm(1,nres+j)
1703 dyj=dc_norm(2,nres+j)
1704 dzj=dc_norm(3,nres+j)
1708 c write (iout,*) "dcnorj",dxi*dxi+dyi*dyi+dzi*dzi
1709 c write (iout,*) "j",j," dc_norm",
1710 c & dc_norm(1,nres+j),dc_norm(2,nres+j),dc_norm(3,nres+j)
1711 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1713 sss=sscale((1.0d0/rij)/sigma(itypi,itypj))
1714 sssgrad=sscagrad((1.0d0/rij)/sigma(itypi,itypj))
1716 c write (iout,'(a7,4f8.3)')
1717 c & "ssscale",sss,((1.0d0/rij)/sigma(itypi,itypj)),r_cut,rlamb
1718 if (sss.gt.0.0d0) then
1719 C Calculate angle-dependent terms of energy and contributions to their
1723 sig=sig0ij*dsqrt(sigsq)
1724 rij_shift=1.0D0/rij-sig+sig0ij
1725 c for diagnostics; uncomment
1726 c rij_shift=1.2*sig0ij
1727 C I hate to put IF's in the loops, but here don't have another choice!!!!
1728 if (rij_shift.le.0.0D0) then
1730 cd write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1731 cd & restyp(itypi),i,restyp(itypj),j,
1732 cd & rij_shift,1.0D0/rij,sig,sig0ij,sigsq,1-dsqrt(sigsq)
1736 c---------------------------------------------------------------
1737 rij_shift=1.0D0/rij_shift
1738 fac=rij_shift**expon
1739 C here to start with
1744 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1745 eps2der=evdwij*eps3rt
1746 eps3der=evdwij*eps2rt
1747 C write(63,'(2i3,2e10.3,2f10.5)') i,j,aa,bb, evdwij,
1748 C &((sslipi+sslipj)/2.0d0+
1749 C &(2.0d0-sslipi-sslipj)/2.0d0)
1750 c write (iout,*) "sigsq",sigsq," sig",sig," eps2rt",eps2rt,
1751 c & " eps3rt",eps3rt," eps1",eps1," e1",e1," e2",e2
1752 evdwij=evdwij*eps2rt*eps3rt
1753 evdw=evdw+evdwij*sss
1755 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
1757 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
1758 & restyp(itypi),i,restyp(itypj),j,
1759 & epsi,sigm,chi1,chi2,chip1,chip2,
1760 & eps1,eps2rt**2,eps3rt**2,sig,sig0ij,
1761 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
1765 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
1768 C Calculate gradient components.
1769 e1=e1*eps1*eps2rt**2*eps3rt**2
1770 fac=-expon*(e1+evdwij)*rij_shift
1773 c print '(2i4,6f8.4)',i,j,sss,sssgrad*
1774 c & evdwij,fac,sigma(itypi,itypj),expon
1775 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
1777 C Calculate the radial part of the gradient
1778 gg_lipi(3)=eps1*(eps2rt*eps2rt)
1779 &*(eps3rt*eps3rt)*sss/2.0d0*(faclip*faclip*
1780 & (aa_lip(itypi,itypj)-aa_aq(itypi,itypj))
1781 &+faclip*(bb_lip(itypi,itypj)-bb_aq(itypi,itypj)))
1782 gg_lipj(3)=ssgradlipj*gg_lipi(3)
1783 gg_lipi(3)=gg_lipi(3)*ssgradlipi
1789 C Calculate angular part of the gradient.
1799 c write (iout,*) "Number of loop steps in EGB:",ind
1800 cccc energy_dec=.false.
1803 C-----------------------------------------------------------------------------
1804 subroutine egbv(evdw)
1806 C This subroutine calculates the interaction energy of nonbonded side chains
1807 C assuming the Gay-Berne-Vorobjev potential of interaction.
1809 implicit real*8 (a-h,o-z)
1810 include 'DIMENSIONS'
1811 include 'COMMON.GEO'
1812 include 'COMMON.VAR'
1813 include 'COMMON.LOCAL'
1814 include 'COMMON.CHAIN'
1815 include 'COMMON.DERIV'
1816 include 'COMMON.NAMES'
1817 include 'COMMON.INTERACT'
1818 include 'COMMON.IOUNITS'
1819 include 'COMMON.CALC'
1820 common /srutu/ icall
1823 c print *,'Entering EGB nnt=',nnt,' nct=',nct,' expon=',expon
1826 c if (icall.eq.0) lprn=.true.
1828 do i=iatsc_s,iatsc_e
1829 itypi=iabs(itype(i))
1830 if (itypi.eq.ntyp1) cycle
1831 itypi1=iabs(itype(i+1))
1836 if (xi.lt.0) xi=xi+boxxsize
1838 if (yi.lt.0) yi=yi+boxysize
1840 if (zi.lt.0) zi=zi+boxzsize
1841 C define scaling factor for lipids
1843 C if (positi.le.0) positi=positi+boxzsize
1845 C first for peptide groups
1846 c for each residue check if it is in lipid or lipid water border area
1847 if ((zi.gt.bordlipbot)
1848 &.and.(zi.lt.bordliptop)) then
1849 C the energy transfer exist
1850 if (zi.lt.buflipbot) then
1851 C what fraction I am in
1853 & ((zi-bordlipbot)/lipbufthick)
1854 C lipbufthick is thickenes of lipid buffore
1855 sslipi=sscalelip(fracinbuf)
1856 ssgradlipi=-sscagradlip(fracinbuf)/lipbufthick
1857 elseif (zi.gt.bufliptop) then
1858 fracinbuf=1.0d0-((bordliptop-zi)/lipbufthick)
1859 sslipi=sscalelip(fracinbuf)
1860 ssgradlipi=sscagradlip(fracinbuf)/lipbufthick
1870 dxi=dc_norm(1,nres+i)
1871 dyi=dc_norm(2,nres+i)
1872 dzi=dc_norm(3,nres+i)
1873 c dsci_inv=dsc_inv(itypi)
1874 dsci_inv=vbld_inv(i+nres)
1876 C Calculate SC interaction energy.
1878 do iint=1,nint_gr(i)
1879 do j=istart(i,iint),iend(i,iint)
1881 itypj=iabs(itype(j))
1882 if (itypj.eq.ntyp1) cycle
1883 c dscj_inv=dsc_inv(itypj)
1884 dscj_inv=vbld_inv(j+nres)
1885 sig0ij=sigma(itypi,itypj)
1886 r0ij=r0(itypi,itypj)
1887 chi1=chi(itypi,itypj)
1888 chi2=chi(itypj,itypi)
1895 alf12=0.5D0*(alf1+alf2)
1896 C For diagnostics only!!!
1910 if (xj.lt.0) xj=xj+boxxsize
1912 if (yj.lt.0) yj=yj+boxysize
1914 if (zj.lt.0) zj=zj+boxzsize
1915 if ((zj.gt.bordlipbot)
1916 &.and.(zj.lt.bordliptop)) then
1917 C the energy transfer exist
1918 if (zj.lt.buflipbot) then
1919 C what fraction I am in
1921 & ((zj-bordlipbot)/lipbufthick)
1922 C lipbufthick is thickenes of lipid buffore
1923 sslipj=sscalelip(fracinbuf)
1924 ssgradlipj=-sscagradlip(fracinbuf)/lipbufthick
1925 elseif (zj.gt.bufliptop) then
1926 fracinbuf=1.0d0-((bordliptop-zj)/lipbufthick)
1927 sslipj=sscalelip(fracinbuf)
1928 ssgradlipj=sscagradlip(fracinbuf)/lipbufthick
1937 aa=aa_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1938 & +aa_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1939 bb=bb_lip(itypi,itypj)*(sslipi+sslipj)/2.0d0
1940 & +bb_aq(itypi,itypj)*(2.0d0-sslipi-sslipj)/2.0d0
1941 C if (aa.ne.aa_aq(itypi,itypj)) write(63,'2e10.5')
1942 C &(aa-aa_aq(itypi,itypj)),(bb-bb_aq(itypi,itypj))
1943 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1951 xj=xj_safe+xshift*boxxsize
1952 yj=yj_safe+yshift*boxysize
1953 zj=zj_safe+zshift*boxzsize
1954 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
1955 if(dist_temp.lt.dist_init) then
1965 if (subchap.eq.1) then
1974 dxj=dc_norm(1,nres+j)
1975 dyj=dc_norm(2,nres+j)
1976 dzj=dc_norm(3,nres+j)
1977 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
1979 C Calculate angle-dependent terms of energy and contributions to their
1983 sig=sig0ij*dsqrt(sigsq)
1984 rij_shift=1.0D0/rij-sig+r0ij
1985 C I hate to put IF's in the loops, but here don't have another choice!!!!
1986 if (rij_shift.le.0.0D0) then
1991 c---------------------------------------------------------------
1992 rij_shift=1.0D0/rij_shift
1993 fac=rij_shift**expon
1996 evdwij=eps1*eps2rt*eps3rt*(e1+e2)
1997 eps2der=evdwij*eps3rt
1998 eps3der=evdwij*eps2rt
1999 fac_augm=rrij**expon
2000 e_augm=augm(itypi,itypj)*fac_augm
2001 evdwij=evdwij*eps2rt*eps3rt
2002 evdw=evdw+evdwij+e_augm
2004 sigm=dabs(aa/bb)**(1.0D0/6.0D0)
2006 write (iout,'(2(a3,i3,2x),17(0pf7.3))')
2007 & restyp(itypi),i,restyp(itypj),j,
2008 & epsi,sigm,sig,(augm(itypi,itypj)/epsi)**(1.0D0/12.0D0),
2009 & chi1,chi2,chip1,chip2,
2010 & eps1,eps2rt**2,eps3rt**2,
2011 & om1,om2,om12,1.0D0/rij,1.0D0/rij_shift,
2014 C Calculate gradient components.
2015 e1=e1*eps1*eps2rt**2*eps3rt**2
2016 fac=-expon*(e1+evdwij)*rij_shift
2018 fac=rij*fac-2*expon*rrij*e_augm
2019 fac=fac+evdwij/sss*sssgrad/sigma(itypi,itypj)*rij
2020 C Calculate the radial part of the gradient
2024 C Calculate angular part of the gradient.
2030 C-----------------------------------------------------------------------------
2031 subroutine sc_angular
2032 C Calculate eps1,eps2,eps3,sigma, and parts of their derivatives in om1,om2,
2033 C om12. Called by ebp, egb, and egbv.
2035 include 'COMMON.CALC'
2036 include 'COMMON.IOUNITS'
2040 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
2041 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
2042 om12=dxi*dxj+dyi*dyj+dzi*dzj
2044 C Calculate eps1(om12) and its derivative in om12
2045 faceps1=1.0D0-om12*chiom12
2046 faceps1_inv=1.0D0/faceps1
2047 eps1=dsqrt(faceps1_inv)
2048 C Following variable is eps1*deps1/dom12
2049 eps1_om12=faceps1_inv*chiom12
2054 c write (iout,*) "om12",om12," eps1",eps1
2055 C Calculate sigma(om1,om2,om12) and the derivatives of sigma**2 in om1,om2,
2060 facsig=om1*chiom1+om2*chiom2-2.0D0*om1om2*chiom12
2061 sigsq=1.0D0-facsig*faceps1_inv
2062 sigsq_om1=(chiom1-chiom12*om2)*faceps1_inv
2063 sigsq_om2=(chiom2-chiom12*om1)*faceps1_inv
2064 sigsq_om12=-chi12*(om1om2*faceps1-om12*facsig)*faceps1_inv**2
2070 c write (iout,*) "chiom1",chiom1," chiom2",chiom2," chiom12",chiom12
2071 c write (iout,*) "faceps1",faceps1," faceps1_inv",faceps1_inv,
2073 C Calculate eps2 and its derivatives in om1, om2, and om12.
2076 chipom12=chip12*om12
2077 facp=1.0D0-om12*chipom12
2079 facp1=om1*chipom1+om2*chipom2-2.0D0*om1om2*chipom12
2080 c write (iout,*) "chipom1",chipom1," chipom2",chipom2,
2081 c & " chipom12",chipom12," facp",facp," facp_inv",facp_inv
2082 C Following variable is the square root of eps2
2083 eps2rt=1.0D0-facp1*facp_inv
2084 C Following three variables are the derivatives of the square root of eps
2085 C in om1, om2, and om12.
2086 eps2rt_om1=-4.0D0*(chipom1-chipom12*om2)*facp_inv
2087 eps2rt_om2=-4.0D0*(chipom2-chipom12*om1)*facp_inv
2088 eps2rt_om12=4.0D0*chip12*(om1om2*facp-om12*facp1)*facp_inv**2
2089 C Evaluate the "asymmetric" factor in the VDW constant, eps3
2090 eps3rt=1.0D0-alf1*om1+alf2*om2-alf12*om12
2091 c write (iout,*) "eps2rt",eps2rt," eps3rt",eps3rt
2092 c write (iout,*) "eps2rt_om1",eps2rt_om1," eps2rt_om2",eps2rt_om2,
2093 c & " eps2rt_om12",eps2rt_om12
2094 C Calculate whole angle-dependent part of epsilon and contributions
2095 C to its derivatives
2098 C----------------------------------------------------------------------------
2100 implicit real*8 (a-h,o-z)
2101 include 'DIMENSIONS'
2102 include 'COMMON.CHAIN'
2103 include 'COMMON.DERIV'
2104 include 'COMMON.CALC'
2105 include 'COMMON.IOUNITS'
2106 double precision dcosom1(3),dcosom2(3)
2107 cc print *,'sss=',sss
2108 eom1=eps2der*eps2rt_om1-2.0D0*alf1*eps3der+sigder*sigsq_om1
2109 eom2=eps2der*eps2rt_om2+2.0D0*alf2*eps3der+sigder*sigsq_om2
2110 eom12=evdwij*eps1_om12+eps2der*eps2rt_om12
2111 & -2.0D0*alf12*eps3der+sigder*sigsq_om12
2115 c eom12=evdwij*eps1_om12
2117 c write (iout,*) "eps2der",eps2der," eps3der",eps3der,
2118 c & " sigder",sigder
2119 c write (iout,*) "eps1_om12",eps1_om12," eps2rt_om12",eps2rt_om12
2120 c write (iout,*) "eom1",eom1," eom2",eom2," eom12",eom12
2122 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
2123 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
2126 gg(k)=(gg(k)+eom1*dcosom1(k)+eom2*dcosom2(k))*sss
2128 c write (iout,*) "gg",(gg(k),k=1,3)
2130 gvdwx(k,i)=gvdwx(k,i)-gg(k)+gg_lipi(k)
2131 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2132 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv*sss
2133 gvdwx(k,j)=gvdwx(k,j)+gg(k)+gg_lipj(k)
2134 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2135 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv*sss
2136 c write (iout,*)(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
2137 c & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
2138 c write (iout,*)(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
2139 c & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
2142 C Calculate the components of the gradient in DC and X
2146 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2150 gvdwc(l,i)=gvdwc(l,i)-gg(l)+gg_lipi(l)
2151 gvdwc(l,j)=gvdwc(l,j)+gg(l)+gg_lipj(l)
2155 C-----------------------------------------------------------------------
2156 subroutine e_softsphere(evdw)
2158 C This subroutine calculates the interaction energy of nonbonded side chains
2159 C assuming the LJ potential of interaction.
2161 implicit real*8 (a-h,o-z)
2162 include 'DIMENSIONS'
2163 parameter (accur=1.0d-10)
2164 include 'COMMON.GEO'
2165 include 'COMMON.VAR'
2166 include 'COMMON.LOCAL'
2167 include 'COMMON.CHAIN'
2168 include 'COMMON.DERIV'
2169 include 'COMMON.INTERACT'
2170 include 'COMMON.TORSION'
2171 include 'COMMON.SBRIDGE'
2172 include 'COMMON.NAMES'
2173 include 'COMMON.IOUNITS'
2174 include 'COMMON.CONTACTS'
2176 cd print *,'Entering Esoft_sphere nnt=',nnt,' nct=',nct
2178 do i=iatsc_s,iatsc_e
2179 itypi=iabs(itype(i))
2180 if (itypi.eq.ntyp1) cycle
2181 itypi1=iabs(itype(i+1))
2186 C Calculate SC interaction energy.
2188 do iint=1,nint_gr(i)
2189 cd write (iout,*) 'i=',i,' iint=',iint,' istart=',istart(i,iint),
2190 cd & 'iend=',iend(i,iint)
2191 do j=istart(i,iint),iend(i,iint)
2192 itypj=iabs(itype(j))
2193 if (itypj.eq.ntyp1) cycle
2197 rij=xj*xj+yj*yj+zj*zj
2198 c write (iout,*)'i=',i,' j=',j,' itypi=',itypi,' itypj=',itypj
2199 r0ij=r0(itypi,itypj)
2201 c print *,i,j,r0ij,dsqrt(rij)
2202 if (rij.lt.r0ijsq) then
2203 evdwij=0.25d0*(rij-r0ijsq)**2
2211 C Calculate the components of the gradient in DC and X
2217 gvdwx(k,i)=gvdwx(k,i)-gg(k)
2218 gvdwx(k,j)=gvdwx(k,j)+gg(k)
2219 gvdwc(k,i)=gvdwc(k,i)-gg(k)
2220 gvdwc(k,j)=gvdwc(k,j)+gg(k)
2224 cgrad gvdwc(l,k)=gvdwc(l,k)+gg(l)
2232 C--------------------------------------------------------------------------
2233 subroutine eelec_soft_sphere(ees,evdw1,eel_loc,eello_turn3,
2236 C Soft-sphere potential of p-p interaction
2238 implicit real*8 (a-h,o-z)
2239 include 'DIMENSIONS'
2240 include 'COMMON.CONTROL'
2241 include 'COMMON.IOUNITS'
2242 include 'COMMON.GEO'
2243 include 'COMMON.VAR'
2244 include 'COMMON.LOCAL'
2245 include 'COMMON.CHAIN'
2246 include 'COMMON.DERIV'
2247 include 'COMMON.INTERACT'
2248 include 'COMMON.CONTACTS'
2249 include 'COMMON.TORSION'
2250 include 'COMMON.VECTORS'
2251 include 'COMMON.FFIELD'
2253 C write(iout,*) 'In EELEC_soft_sphere'
2260 do i=iatel_s,iatel_e
2261 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
2265 xmedi=c(1,i)+0.5d0*dxi
2266 ymedi=c(2,i)+0.5d0*dyi
2267 zmedi=c(3,i)+0.5d0*dzi
2268 xmedi=mod(xmedi,boxxsize)
2269 if (xmedi.lt.0) xmedi=xmedi+boxxsize
2270 ymedi=mod(ymedi,boxysize)
2271 if (ymedi.lt.0) ymedi=ymedi+boxysize
2272 zmedi=mod(zmedi,boxzsize)
2273 if (zmedi.lt.0) zmedi=zmedi+boxzsize
2275 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
2276 do j=ielstart(i),ielend(i)
2277 if (itype(j).eq.ntyp1 .or. itype(j+1).eq.ntyp1) cycle
2281 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
2282 r0ij=rpp(iteli,itelj)
2291 if (xj.lt.0) xj=xj+boxxsize
2293 if (yj.lt.0) yj=yj+boxysize
2295 if (zj.lt.0) zj=zj+boxzsize
2296 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
2304 xj=xj_safe+xshift*boxxsize
2305 yj=yj_safe+yshift*boxysize
2306 zj=zj_safe+zshift*boxzsize
2307 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
2308 if(dist_temp.lt.dist_init) then
2318 if (isubchap.eq.1) then
2327 rij=xj*xj+yj*yj+zj*zj
2328 sss=sscale(sqrt(rij))
2329 sssgrad=sscagrad(sqrt(rij))
2330 if (rij.lt.r0ijsq) then
2331 evdw1ij=0.25d0*(rij-r0ijsq)**2
2337 evdw1=evdw1+evdw1ij*sss
2339 C Calculate contributions to the Cartesian gradient.
2341 ggg(1)=fac*xj*sssgrad
2342 ggg(2)=fac*yj*sssgrad
2343 ggg(3)=fac*zj*sssgrad
2345 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
2346 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
2349 * Loop over residues i+1 thru j-1.
2353 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
2358 cgrad do i=nnt,nct-1
2360 cgrad gelc(k,i)=gelc(k,i)+0.5d0*gelc(k,i)
2362 cgrad do j=i+1,nct-1
2364 cgrad gelc(k,i)=gelc(k,i)+gelc(k,j)
2370 c------------------------------------------------------------------------------
2371 subroutine vec_and_deriv
2372 implicit real*8 (a-h,o-z)
2373 include 'DIMENSIONS'
2377 include 'COMMON.IOUNITS'
2378 include 'COMMON.GEO'
2379 include 'COMMON.VAR'
2380 include 'COMMON.LOCAL'
2381 include 'COMMON.CHAIN'
2382 include 'COMMON.VECTORS'
2383 include 'COMMON.SETUP'
2384 include 'COMMON.TIME1'
2385 dimension uyder(3,3,2),uzder(3,3,2),vbld_inv_temp(2)
2386 C Compute the local reference systems. For reference system (i), the
2387 C X-axis points from CA(i) to CA(i+1), the Y axis is in the
2388 C CA(i)-CA(i+1)-CA(i+2) plane, and the Z axis is perpendicular to this plane.
2390 do i=ivec_start,ivec_end
2394 if (i.eq.nres-1) then
2395 C Case of the last full residue
2396 C Compute the Z-axis
2397 call vecpr(dc_norm(1,i),dc_norm(1,i-1),uz(1,i))
2398 costh=dcos(pi-theta(nres))
2399 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2403 C Compute the derivatives of uz
2405 uzder(2,1,1)=-dc_norm(3,i-1)
2406 uzder(3,1,1)= dc_norm(2,i-1)
2407 uzder(1,2,1)= dc_norm(3,i-1)
2409 uzder(3,2,1)=-dc_norm(1,i-1)
2410 uzder(1,3,1)=-dc_norm(2,i-1)
2411 uzder(2,3,1)= dc_norm(1,i-1)
2414 uzder(2,1,2)= dc_norm(3,i)
2415 uzder(3,1,2)=-dc_norm(2,i)
2416 uzder(1,2,2)=-dc_norm(3,i)
2418 uzder(3,2,2)= dc_norm(1,i)
2419 uzder(1,3,2)= dc_norm(2,i)
2420 uzder(2,3,2)=-dc_norm(1,i)
2422 C Compute the Y-axis
2425 uy(k,i)=fac*(dc_norm(k,i-1)-costh*dc_norm(k,i))
2427 C Compute the derivatives of uy
2430 uyder(k,j,1)=2*dc_norm(k,i-1)*dc_norm(j,i)
2431 & -dc_norm(k,i)*dc_norm(j,i-1)
2432 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2434 uyder(j,j,1)=uyder(j,j,1)-costh
2435 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2440 uygrad(l,k,j,i)=uyder(l,k,j)
2441 uzgrad(l,k,j,i)=uzder(l,k,j)
2445 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2446 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2447 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2448 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2451 C Compute the Z-axis
2452 call vecpr(dc_norm(1,i),dc_norm(1,i+1),uz(1,i))
2453 costh=dcos(pi-theta(i+2))
2454 fac=1.0d0/dsqrt(1.0d0-costh*costh)
2458 C Compute the derivatives of uz
2460 uzder(2,1,1)=-dc_norm(3,i+1)
2461 uzder(3,1,1)= dc_norm(2,i+1)
2462 uzder(1,2,1)= dc_norm(3,i+1)
2464 uzder(3,2,1)=-dc_norm(1,i+1)
2465 uzder(1,3,1)=-dc_norm(2,i+1)
2466 uzder(2,3,1)= dc_norm(1,i+1)
2469 uzder(2,1,2)= dc_norm(3,i)
2470 uzder(3,1,2)=-dc_norm(2,i)
2471 uzder(1,2,2)=-dc_norm(3,i)
2473 uzder(3,2,2)= dc_norm(1,i)
2474 uzder(1,3,2)= dc_norm(2,i)
2475 uzder(2,3,2)=-dc_norm(1,i)
2477 C Compute the Y-axis
2480 uy(k,i)=facy*(dc_norm(k,i+1)-costh*dc_norm(k,i))
2482 C Compute the derivatives of uy
2485 uyder(k,j,1)=2*dc_norm(k,i+1)*dc_norm(j,i)
2486 & -dc_norm(k,i)*dc_norm(j,i+1)
2487 uyder(k,j,2)=-dc_norm(j,i)*dc_norm(k,i)
2489 uyder(j,j,1)=uyder(j,j,1)-costh
2490 uyder(j,j,2)=1.0d0+uyder(j,j,2)
2495 uygrad(l,k,j,i)=uyder(l,k,j)
2496 uzgrad(l,k,j,i)=uzder(l,k,j)
2500 call unormderiv(uy(1,i),uyder(1,1,1),facy,uygrad(1,1,1,i))
2501 call unormderiv(uy(1,i),uyder(1,1,2),facy,uygrad(1,1,2,i))
2502 call unormderiv(uz(1,i),uzder(1,1,1),fac,uzgrad(1,1,1,i))
2503 call unormderiv(uz(1,i),uzder(1,1,2),fac,uzgrad(1,1,2,i))
2507 vbld_inv_temp(1)=vbld_inv(i+1)
2508 if (i.lt.nres-1) then
2509 vbld_inv_temp(2)=vbld_inv(i+2)
2511 vbld_inv_temp(2)=vbld_inv(i)
2516 uygrad(l,k,j,i)=vbld_inv_temp(j)*uygrad(l,k,j,i)
2517 uzgrad(l,k,j,i)=vbld_inv_temp(j)*uzgrad(l,k,j,i)
2522 #if defined(PARVEC) && defined(MPI)
2523 if (nfgtasks1.gt.1) then
2525 c print *,"Processor",fg_rank1,kolor1," ivec_start",ivec_start,
2526 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks1-1),
2527 c & " ivec_count",(ivec_count(i),i=0,nfgtasks1-1)
2528 call MPI_Allgatherv(uy(1,ivec_start),ivec_count(fg_rank1),
2529 & MPI_UYZ,uy(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2531 call MPI_Allgatherv(uz(1,ivec_start),ivec_count(fg_rank1),
2532 & MPI_UYZ,uz(1,1),ivec_count(0),ivec_displ(0),MPI_UYZ,
2534 call MPI_Allgatherv(uygrad(1,1,1,ivec_start),
2535 & ivec_count(fg_rank1),MPI_UYZGRAD,uygrad(1,1,1,1),ivec_count(0),
2536 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2537 call MPI_Allgatherv(uzgrad(1,1,1,ivec_start),
2538 & ivec_count(fg_rank1),MPI_UYZGRAD,uzgrad(1,1,1,1),ivec_count(0),
2539 & ivec_displ(0),MPI_UYZGRAD,FG_COMM1,IERR)
2540 time_gather=time_gather+MPI_Wtime()-time00
2542 c if (fg_rank.eq.0) then
2543 c write (iout,*) "Arrays UY and UZ"
2545 c write (iout,'(i5,3f10.5,5x,3f10.5)') i,(uy(k,i),k=1,3),
2552 C-----------------------------------------------------------------------------
2553 subroutine check_vecgrad
2554 implicit real*8 (a-h,o-z)
2555 include 'DIMENSIONS'
2556 include 'COMMON.IOUNITS'
2557 include 'COMMON.GEO'
2558 include 'COMMON.VAR'
2559 include 'COMMON.LOCAL'
2560 include 'COMMON.CHAIN'
2561 include 'COMMON.VECTORS'
2562 dimension uygradt(3,3,2,maxres),uzgradt(3,3,2,maxres)
2563 dimension uyt(3,maxres),uzt(3,maxres)
2564 dimension uygradn(3,3,2),uzgradn(3,3,2),erij(3)
2565 double precision delta /1.0d-7/
2568 crc write(iout,'(2i5,2(3f10.5,5x))') i,1,dc_norm(:,i)
2569 crc write(iout,'(2i5,2(3f10.5,5x))') i,2,uy(:,i)
2570 crc write(iout,'(2i5,2(3f10.5,5x)/)')i,3,uz(:,i)
2571 cd write(iout,'(2i5,2(3f10.5,5x))') i,1,
2572 cd & (dc_norm(if90,i),if90=1,3)
2573 cd write(iout,'(2i5,2(3f10.5,5x))') i,2,(uy(if90,i),if90=1,3)
2574 cd write(iout,'(2i5,2(3f10.5,5x)/)')i,3,(uz(if90,i),if90=1,3)
2575 cd write(iout,'(a)')
2581 uygradt(l,k,j,i)=uygrad(l,k,j,i)
2582 uzgradt(l,k,j,i)=uzgrad(l,k,j,i)
2595 cd write (iout,*) 'i=',i
2597 erij(k)=dc_norm(k,i)
2601 dc_norm(k,i)=erij(k)
2603 dc_norm(j,i)=dc_norm(j,i)+delta
2604 c fac=dsqrt(scalar(dc_norm(1,i),dc_norm(1,i)))
2606 c dc_norm(k,i)=dc_norm(k,i)/fac
2608 c write (iout,*) (dc_norm(k,i),k=1,3)
2609 c write (iout,*) (erij(k),k=1,3)
2612 uygradn(k,j,1)=(uy(k,i)-uyt(k,i))/delta
2613 uygradn(k,j,2)=(uy(k,i-1)-uyt(k,i-1))/delta
2614 uzgradn(k,j,1)=(uz(k,i)-uzt(k,i))/delta
2615 uzgradn(k,j,2)=(uz(k,i-1)-uzt(k,i-1))/delta
2617 c write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2618 c & j,(uzgradt(k,j,1,i),k=1,3),(uzgradn(k,j,1),k=1,3),
2619 c & (uzgradt(k,j,2,i-1),k=1,3),(uzgradn(k,j,2),k=1,3)
2622 dc_norm(k,i)=erij(k)
2625 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2626 cd & k,(uygradt(k,l,1,i),l=1,3),(uygradn(k,l,1),l=1,3),
2627 cd & (uygradt(k,l,2,i-1),l=1,3),(uygradn(k,l,2),l=1,3)
2628 cd write (iout,'(i5,3f8.5,3x,3f8.5,5x,3f8.5,3x,3f8.5)')
2629 cd & k,(uzgradt(k,l,1,i),l=1,3),(uzgradn(k,l,1),l=1,3),
2630 cd & (uzgradt(k,l,2,i-1),l=1,3),(uzgradn(k,l,2),l=1,3)
2631 cd write (iout,'(a)')
2636 C--------------------------------------------------------------------------
2637 subroutine set_matrices
2638 implicit real*8 (a-h,o-z)
2639 include 'DIMENSIONS'
2642 include "COMMON.SETUP"
2644 integer status(MPI_STATUS_SIZE)
2646 include 'COMMON.IOUNITS'
2647 include 'COMMON.GEO'
2648 include 'COMMON.VAR'
2649 include 'COMMON.LOCAL'
2650 include 'COMMON.CHAIN'
2651 include 'COMMON.DERIV'
2652 include 'COMMON.INTERACT'
2653 include 'COMMON.CONTACTS'
2654 include 'COMMON.TORSION'
2655 include 'COMMON.VECTORS'
2656 include 'COMMON.FFIELD'
2657 double precision auxvec(2),auxmat(2,2)
2659 C Compute the virtual-bond-torsional-angle dependent quantities needed
2660 C to calculate the el-loc multibody terms of various order.
2662 c write(iout,*) 'nphi=',nphi,nres
2664 do i=ivec_start+2,ivec_end+2
2669 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2670 iti = itortyp(itype(i-2))
2674 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2675 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2676 iti1 = itortyp(itype(i-1))
2681 b1(1,i-2)=bnew1(1,1,iti)*dsin(theta(i-1)/2.0)
2682 & +bnew1(2,1,iti)*dsin(theta(i-1))
2683 & +bnew1(3,1,iti)*dcos(theta(i-1)/2.0)
2684 gtb1(1,i-2)=bnew1(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2685 & +bnew1(2,1,iti)*dcos(theta(i-1))
2686 & -bnew1(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2687 c & +bnew1(3,1,iti)*sin(alpha(i))*cos(beta(i))
2688 c &*(cos(theta(i)/2.0)
2689 b2(1,i-2)=bnew2(1,1,iti)*dsin(theta(i-1)/2.0)
2690 & +bnew2(2,1,iti)*dsin(theta(i-1))
2691 & +bnew2(3,1,iti)*dcos(theta(i-1)/2.0)
2692 c & +bnew2(3,1,iti)*sin(alpha(i))*cos(beta(i))
2693 c &*(cos(theta(i)/2.0)
2694 gtb2(1,i-2)=bnew2(1,1,iti)*dcos(theta(i-1)/2.0d0)/2.0d0
2695 & +bnew2(2,1,iti)*dcos(theta(i-1))
2696 & -bnew2(3,1,iti)*dsin(theta(i-1)/2.0d0)/2.0d0
2697 c if (ggb1(1,i).eq.0.0d0) then
2698 c write(iout,*) 'i=',i,ggb1(1,i),
2699 c &bnew1(1,1,iti)*cos(theta(i)/2.0)/2.0,
2700 c &bnew1(2,1,iti)*cos(theta(i)),
2701 c &bnew1(3,1,iti)*sin(theta(i)/2.0)/2.0
2703 b1(2,i-2)=bnew1(1,2,iti)
2705 b2(2,i-2)=bnew2(1,2,iti)
2707 EE(1,1,i-2)=eenew(1,iti)*dcos(theta(i-1))
2708 EE(1,2,i-2)=eeold(1,2,iti)
2709 EE(2,1,i-2)=eeold(2,1,iti)
2710 EE(2,2,i-2)=eeold(2,2,iti)
2711 gtEE(1,1,i-2)=-eenew(1,iti)*dsin(theta(i-1))
2716 c EE(1,2,iti)=0.5d0*eenew(1,iti)
2717 c EE(2,1,iti)=0.5d0*eenew(1,iti)
2718 c b1(2,iti)=bnew1(1,2,iti)*sin(alpha(i))*sin(beta(i))
2719 c b2(2,iti)=bnew2(1,2,iti)*sin(alpha(i))*sin(beta(i))
2720 b1tilde(1,i-2)=b1(1,i-2)
2721 b1tilde(2,i-2)=-b1(2,i-2)
2722 b2tilde(1,i-2)=b2(1,i-2)
2723 b2tilde(2,i-2)=-b2(2,i-2)
2724 c write (iout,*) 'i=',i-2,gtb1(2,i-2),gtb1(1,i-2)
2725 c write(iout,*) 'b1=',b1(1,i-2)
2726 c write (iout,*) 'theta=', theta(i-1)
2733 b1tilde(1,i-2)=b1(1,i-2)
2734 b1tilde(2,i-2)=-b1(2,i-2)
2735 b2tilde(1,i-2)=b2(1,i-2)
2736 b2tilde(2,i-2)=-b2(2,i-2)
2737 EE(1,2,i-2)=eeold(1,2,iti)
2738 EE(2,1,i-2)=eeold(2,1,iti)
2739 EE(2,2,i-2)=eeold(2,2,iti)
2740 EE(1,1,i-2)=eeold(1,1,iti)
2744 do i=ivec_start+2,ivec_end+2
2748 if (i .lt. nres+1) then
2785 if (i .gt. 3 .and. i .lt. nres+1) then
2786 obrot_der(1,i-2)=-sin1
2787 obrot_der(2,i-2)= cos1
2788 Ugder(1,1,i-2)= sin1
2789 Ugder(1,2,i-2)=-cos1
2790 Ugder(2,1,i-2)=-cos1
2791 Ugder(2,2,i-2)=-sin1
2794 obrot2_der(1,i-2)=-dwasin2
2795 obrot2_der(2,i-2)= dwacos2
2796 Ug2der(1,1,i-2)= dwasin2
2797 Ug2der(1,2,i-2)=-dwacos2
2798 Ug2der(2,1,i-2)=-dwacos2
2799 Ug2der(2,2,i-2)=-dwasin2
2801 obrot_der(1,i-2)=0.0d0
2802 obrot_der(2,i-2)=0.0d0
2803 Ugder(1,1,i-2)=0.0d0
2804 Ugder(1,2,i-2)=0.0d0
2805 Ugder(2,1,i-2)=0.0d0
2806 Ugder(2,2,i-2)=0.0d0
2807 obrot2_der(1,i-2)=0.0d0
2808 obrot2_der(2,i-2)=0.0d0
2809 Ug2der(1,1,i-2)=0.0d0
2810 Ug2der(1,2,i-2)=0.0d0
2811 Ug2der(2,1,i-2)=0.0d0
2812 Ug2der(2,2,i-2)=0.0d0
2814 c if (i.gt. iatel_s+2 .and. i.lt.iatel_e+5) then
2815 if (i.gt. nnt+2 .and. i.lt.nct+2) then
2816 iti = itortyp(itype(i-2))
2820 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2821 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2822 iti1 = itortyp(itype(i-1))
2826 cd write (iout,*) '*******i',i,' iti1',iti
2827 cd write (iout,*) 'b1',b1(:,iti)
2828 cd write (iout,*) 'b2',b2(:,iti)
2829 cd write (iout,*) 'Ug',Ug(:,:,i-2)
2830 c if (i .gt. iatel_s+2) then
2831 if (i .gt. nnt+2) then
2832 call matvec2(Ug(1,1,i-2),b2(1,i-2),Ub2(1,i-2))
2834 call matvec2(Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2))
2835 c write (iout,*) Ug(1,1,i-2),gtb2(1,i-2),gUb2(1,i-2),"chuj"
2837 c write(iout,*) "co jest kurwa", iti, EE(1,1,iti),EE(2,1,iti),
2838 c & EE(1,2,iti),EE(2,2,iti)
2839 call matmat2(EE(1,1,i-2),Ug(1,1,i-2),EUg(1,1,i-2))
2840 call matmat2(gtEE(1,1,i-2),Ug(1,1,i-2),gtEUg(1,1,i-2))
2841 c write(iout,*) "Macierz EUG",
2842 c & eug(1,1,i-2),eug(1,2,i-2),eug(2,1,i-2),
2844 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2846 call matmat2(CC(1,1,iti),Ug(1,1,i-2),CUg(1,1,i-2))
2847 call matmat2(DD(1,1,iti),Ug(1,1,i-2),DUg(1,1,i-2))
2848 call matmat2(Dtilde(1,1,iti),Ug2(1,1,i-2),DtUg2(1,1,i-2))
2849 call matvec2(Ctilde(1,1,iti1),obrot(1,i-2),Ctobr(1,i-2))
2850 call matvec2(Dtilde(1,1,iti),obrot2(1,i-2),Dtobr2(1,i-2))
2861 DtUg2(l,k,i-2)=0.0d0
2865 call matvec2(Ugder(1,1,i-2),b2(1,i-2),Ub2der(1,i-2))
2866 call matmat2(EE(1,1,i-2),Ugder(1,1,i-2),EUgder(1,1,i-2))
2868 muder(k,i-2)=Ub2der(k,i-2)
2870 c if (i.gt. iatel_s+1 .and. i.lt.iatel_e+4) then
2871 if (i.gt. nnt+1 .and. i.lt.nct+1) then
2872 if (itype(i-1).le.ntyp) then
2873 iti1 = itortyp(itype(i-1))
2881 mu(k,i-2)=Ub2(k,i-2)+b1(k,i-1)
2883 c write (iout,*) 'mu ',mu(:,i-2),i-2
2884 cd write (iout,*) 'mu1',mu1(:,i-2)
2885 cd write (iout,*) 'mu2',mu2(:,i-2)
2886 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2888 call matmat2(CC(1,1,iti1),Ugder(1,1,i-2),CUgder(1,1,i-2))
2889 call matmat2(DD(1,1,iti),Ugder(1,1,i-2),DUgder(1,1,i-2))
2890 call matmat2(Dtilde(1,1,iti),Ug2der(1,1,i-2),DtUg2der(1,1,i-2))
2891 call matvec2(Ctilde(1,1,iti1),obrot_der(1,i-2),Ctobrder(1,i-2))
2892 call matvec2(Dtilde(1,1,iti),obrot2_der(1,i-2),Dtobr2der(1,i-2))
2893 C Vectors and matrices dependent on a single virtual-bond dihedral.
2894 call matvec2(DD(1,1,iti),b1tilde(1,i-1),auxvec(1))
2895 call matvec2(Ug2(1,1,i-2),auxvec(1),Ug2Db1t(1,i-2))
2896 call matvec2(Ug2der(1,1,i-2),auxvec(1),Ug2Db1tder(1,i-2))
2897 call matvec2(CC(1,1,iti1),Ub2(1,i-2),CUgb2(1,i-2))
2898 call matvec2(CC(1,1,iti1),Ub2der(1,i-2),CUgb2der(1,i-2))
2899 call matmat2(EUg(1,1,i-2),CC(1,1,iti1),EUgC(1,1,i-2))
2900 call matmat2(EUgder(1,1,i-2),CC(1,1,iti1),EUgCder(1,1,i-2))
2901 call matmat2(EUg(1,1,i-2),DD(1,1,iti1),EUgD(1,1,i-2))
2902 call matmat2(EUgder(1,1,i-2),DD(1,1,iti1),EUgDder(1,1,i-2))
2905 C Matrices dependent on two consecutive virtual-bond dihedrals.
2906 C The order of matrices is from left to right.
2907 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.wcorr6.gt.0.0d0)
2909 c do i=max0(ivec_start,2),ivec_end
2911 call matmat2(DtUg2(1,1,i-1),EUg(1,1,i),DtUg2EUg(1,1,i))
2912 call matmat2(DtUg2der(1,1,i-1),EUg(1,1,i),DtUg2EUgder(1,1,1,i))
2913 call matmat2(DtUg2(1,1,i-1),EUgder(1,1,i),DtUg2EUgder(1,1,2,i))
2914 call transpose2(DtUg2(1,1,i-1),auxmat(1,1))
2915 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUg(1,1,i))
2916 call matmat2(auxmat(1,1),EUgder(1,1,i),Ug2DtEUgder(1,1,2,i))
2917 call transpose2(DtUg2der(1,1,i-1),auxmat(1,1))
2918 call matmat2(auxmat(1,1),EUg(1,1,i),Ug2DtEUgder(1,1,1,i))
2921 #if defined(MPI) && defined(PARMAT)
2923 c if (fg_rank.eq.0) then
2924 write (iout,*) "Arrays UG and UGDER before GATHER"
2926 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2927 & ((ug(l,k,i),l=1,2),k=1,2),
2928 & ((ugder(l,k,i),l=1,2),k=1,2)
2930 write (iout,*) "Arrays UG2 and UG2DER"
2932 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2933 & ((ug2(l,k,i),l=1,2),k=1,2),
2934 & ((ug2der(l,k,i),l=1,2),k=1,2)
2936 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
2938 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2939 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
2940 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
2942 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
2944 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
2945 & costab(i),sintab(i),costab2(i),sintab2(i)
2947 write (iout,*) "Array MUDER"
2949 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
2953 if (nfgtasks.gt.1) then
2955 c write(iout,*)"Processor",fg_rank,kolor," ivec_start",ivec_start,
2956 c & " ivec_displ",(ivec_displ(i),i=0,nfgtasks-1),
2957 c & " ivec_count",(ivec_count(i),i=0,nfgtasks-1)
2959 call MPI_Allgatherv(Ub2(1,ivec_start),ivec_count(fg_rank1),
2960 & MPI_MU,Ub2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2962 call MPI_Allgatherv(Ub2der(1,ivec_start),ivec_count(fg_rank1),
2963 & MPI_MU,Ub2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2965 call MPI_Allgatherv(mu(1,ivec_start),ivec_count(fg_rank1),
2966 & MPI_MU,mu(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2968 call MPI_Allgatherv(muder(1,ivec_start),ivec_count(fg_rank1),
2969 & MPI_MU,muder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2971 call MPI_Allgatherv(Eug(1,1,ivec_start),ivec_count(fg_rank1),
2972 & MPI_MAT1,Eug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2974 call MPI_Allgatherv(Eugder(1,1,ivec_start),ivec_count(fg_rank1),
2975 & MPI_MAT1,Eugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
2977 call MPI_Allgatherv(costab(ivec_start),ivec_count(fg_rank1),
2978 & MPI_DOUBLE_PRECISION,costab(1),ivec_count(0),ivec_displ(0),
2979 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2980 call MPI_Allgatherv(sintab(ivec_start),ivec_count(fg_rank1),
2981 & MPI_DOUBLE_PRECISION,sintab(1),ivec_count(0),ivec_displ(0),
2982 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2983 call MPI_Allgatherv(costab2(ivec_start),ivec_count(fg_rank1),
2984 & MPI_DOUBLE_PRECISION,costab2(1),ivec_count(0),ivec_displ(0),
2985 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2986 call MPI_Allgatherv(sintab2(ivec_start),ivec_count(fg_rank1),
2987 & MPI_DOUBLE_PRECISION,sintab2(1),ivec_count(0),ivec_displ(0),
2988 & MPI_DOUBLE_PRECISION,FG_COMM1,IERR)
2989 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
2991 call MPI_Allgatherv(Ctobr(1,ivec_start),ivec_count(fg_rank1),
2992 & MPI_MU,Ctobr(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2994 call MPI_Allgatherv(Ctobrder(1,ivec_start),ivec_count(fg_rank1),
2995 & MPI_MU,Ctobrder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
2997 call MPI_Allgatherv(Dtobr2(1,ivec_start),ivec_count(fg_rank1),
2998 & MPI_MU,Dtobr2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3000 call MPI_Allgatherv(Dtobr2der(1,ivec_start),ivec_count(fg_rank1),
3001 & MPI_MU,Dtobr2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3003 call MPI_Allgatherv(Ug2Db1t(1,ivec_start),ivec_count(fg_rank1),
3004 & MPI_MU,Ug2Db1t(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3006 call MPI_Allgatherv(Ug2Db1tder(1,ivec_start),
3007 & ivec_count(fg_rank1),
3008 & MPI_MU,Ug2Db1tder(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3010 call MPI_Allgatherv(CUgb2(1,ivec_start),ivec_count(fg_rank1),
3011 & MPI_MU,CUgb2(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3013 call MPI_Allgatherv(CUgb2der(1,ivec_start),ivec_count(fg_rank1),
3014 & MPI_MU,CUgb2der(1,1),ivec_count(0),ivec_displ(0),MPI_MU,
3016 call MPI_Allgatherv(Cug(1,1,ivec_start),ivec_count(fg_rank1),
3017 & MPI_MAT1,Cug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3019 call MPI_Allgatherv(Cugder(1,1,ivec_start),ivec_count(fg_rank1),
3020 & MPI_MAT1,Cugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3022 call MPI_Allgatherv(Dug(1,1,ivec_start),ivec_count(fg_rank1),
3023 & MPI_MAT1,Dug(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3025 call MPI_Allgatherv(Dugder(1,1,ivec_start),ivec_count(fg_rank1),
3026 & MPI_MAT1,Dugder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3028 call MPI_Allgatherv(Dtug2(1,1,ivec_start),ivec_count(fg_rank1),
3029 & MPI_MAT1,Dtug2(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3031 call MPI_Allgatherv(Dtug2der(1,1,ivec_start),
3032 & ivec_count(fg_rank1),
3033 & MPI_MAT1,Dtug2der(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3035 call MPI_Allgatherv(EugC(1,1,ivec_start),ivec_count(fg_rank1),
3036 & MPI_MAT1,EugC(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3038 call MPI_Allgatherv(EugCder(1,1,ivec_start),ivec_count(fg_rank1),
3039 & MPI_MAT1,EugCder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3041 call MPI_Allgatherv(EugD(1,1,ivec_start),ivec_count(fg_rank1),
3042 & MPI_MAT1,EugD(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3044 call MPI_Allgatherv(EugDder(1,1,ivec_start),ivec_count(fg_rank1),
3045 & MPI_MAT1,EugDder(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3047 call MPI_Allgatherv(DtUg2EUg(1,1,ivec_start),
3048 & ivec_count(fg_rank1),
3049 & MPI_MAT1,DtUg2EUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3051 call MPI_Allgatherv(Ug2DtEUg(1,1,ivec_start),
3052 & ivec_count(fg_rank1),
3053 & MPI_MAT1,Ug2DtEUg(1,1,1),ivec_count(0),ivec_displ(0),MPI_MAT1,
3055 call MPI_Allgatherv(DtUg2EUgder(1,1,1,ivec_start),
3056 & ivec_count(fg_rank1),
3057 & MPI_MAT2,DtUg2EUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3058 & MPI_MAT2,FG_COMM1,IERR)
3059 call MPI_Allgatherv(Ug2DtEUgder(1,1,1,ivec_start),
3060 & ivec_count(fg_rank1),
3061 & MPI_MAT2,Ug2DtEUgder(1,1,1,1),ivec_count(0),ivec_displ(0),
3062 & MPI_MAT2,FG_COMM1,IERR)
3065 c Passes matrix info through the ring
3068 if (irecv.lt.0) irecv=nfgtasks1-1
3071 if (inext.ge.nfgtasks1) inext=0
3073 c write (iout,*) "isend",isend," irecv",irecv
3075 lensend=lentyp(isend)
3076 lenrecv=lentyp(irecv)
3077 c write (iout,*) "lensend",lensend," lenrecv",lenrecv
3078 c call MPI_SENDRECV(ug(1,1,ivec_displ(isend)+1),1,
3079 c & MPI_ROTAT1(lensend),inext,2200+isend,
3080 c & ug(1,1,ivec_displ(irecv)+1),1,MPI_ROTAT1(lenrecv),
3081 c & iprev,2200+irecv,FG_COMM,status,IERR)
3082 c write (iout,*) "Gather ROTAT1"
3084 c call MPI_SENDRECV(obrot(1,ivec_displ(isend)+1),1,
3085 c & MPI_ROTAT2(lensend),inext,3300+isend,
3086 c & obrot(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3087 c & iprev,3300+irecv,FG_COMM,status,IERR)
3088 c write (iout,*) "Gather ROTAT2"
3090 call MPI_SENDRECV(costab(ivec_displ(isend)+1),1,
3091 & MPI_ROTAT_OLD(lensend),inext,4400+isend,
3092 & costab(ivec_displ(irecv)+1),1,MPI_ROTAT_OLD(lenrecv),
3093 & iprev,4400+irecv,FG_COMM,status,IERR)
3094 c write (iout,*) "Gather ROTAT_OLD"
3096 call MPI_SENDRECV(mu(1,ivec_displ(isend)+1),1,
3097 & MPI_PRECOMP11(lensend),inext,5500+isend,
3098 & mu(1,ivec_displ(irecv)+1),1,MPI_PRECOMP11(lenrecv),
3099 & iprev,5500+irecv,FG_COMM,status,IERR)
3100 c write (iout,*) "Gather PRECOMP11"
3102 call MPI_SENDRECV(Eug(1,1,ivec_displ(isend)+1),1,
3103 & MPI_PRECOMP12(lensend),inext,6600+isend,
3104 & Eug(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP12(lenrecv),
3105 & iprev,6600+irecv,FG_COMM,status,IERR)
3106 c write (iout,*) "Gather PRECOMP12"
3108 if (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0)
3110 call MPI_SENDRECV(ug2db1t(1,ivec_displ(isend)+1),1,
3111 & MPI_ROTAT2(lensend),inext,7700+isend,
3112 & ug2db1t(1,ivec_displ(irecv)+1),1,MPI_ROTAT2(lenrecv),
3113 & iprev,7700+irecv,FG_COMM,status,IERR)
3114 c write (iout,*) "Gather PRECOMP21"
3116 call MPI_SENDRECV(EUgC(1,1,ivec_displ(isend)+1),1,
3117 & MPI_PRECOMP22(lensend),inext,8800+isend,
3118 & EUgC(1,1,ivec_displ(irecv)+1),1,MPI_PRECOMP22(lenrecv),
3119 & iprev,8800+irecv,FG_COMM,status,IERR)
3120 c write (iout,*) "Gather PRECOMP22"
3122 call MPI_SENDRECV(Ug2DtEUgder(1,1,1,ivec_displ(isend)+1),1,
3123 & MPI_PRECOMP23(lensend),inext,9900+isend,
3124 & Ug2DtEUgder(1,1,1,ivec_displ(irecv)+1),1,
3125 & MPI_PRECOMP23(lenrecv),
3126 & iprev,9900+irecv,FG_COMM,status,IERR)
3127 c write (iout,*) "Gather PRECOMP23"
3132 if (irecv.lt.0) irecv=nfgtasks1-1
3135 time_gather=time_gather+MPI_Wtime()-time00
3138 c if (fg_rank.eq.0) then
3139 write (iout,*) "Arrays UG and UGDER"
3141 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3142 & ((ug(l,k,i),l=1,2),k=1,2),
3143 & ((ugder(l,k,i),l=1,2),k=1,2)
3145 write (iout,*) "Arrays UG2 and UG2DER"
3147 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3148 & ((ug2(l,k,i),l=1,2),k=1,2),
3149 & ((ug2der(l,k,i),l=1,2),k=1,2)
3151 write (iout,*) "Arrays OBROT OBROT2 OBROTDER and OBROT2DER"
3153 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3154 & (obrot(k,i),k=1,2),(obrot2(k,i),k=1,2),
3155 & (obrot_der(k,i),k=1,2),(obrot2_der(k,i),k=1,2)
3157 write (iout,*) "Arrays COSTAB SINTAB COSTAB2 and SINTAB2"
3159 write (iout,'(i5,4f10.5,5x,4f10.5)') i,
3160 & costab(i),sintab(i),costab2(i),sintab2(i)
3162 write (iout,*) "Array MUDER"
3164 write (iout,'(i5,2f10.5)') i,muder(1,i),muder(2,i)
3170 cd iti = itortyp(itype(i))
3173 cd write (iout,'(2f10.5,5x,2f10.5,5x,2f10.5)')
3174 cd & (EE(j,k,iti),k=1,2),(Ug(j,k,i),k=1,2),(EUg(j,k,i),k=1,2)
3179 C--------------------------------------------------------------------------
3180 subroutine eelec(ees,evdw1,eel_loc,eello_turn3,eello_turn4)
3182 C This subroutine calculates the average interaction energy and its gradient
3183 C in the virtual-bond vectors between non-adjacent peptide groups, based on
3184 C the potential described in Liwo et al., Protein Sci., 1993, 2, 1715.
3185 C The potential depends both on the distance of peptide-group centers and on
3186 C the orientation of the CA-CA virtual bonds.
3188 implicit real*8 (a-h,o-z)
3192 include 'DIMENSIONS'
3193 include 'COMMON.CONTROL'
3194 include 'COMMON.SETUP'
3195 include 'COMMON.IOUNITS'
3196 include 'COMMON.GEO'
3197 include 'COMMON.VAR'
3198 include 'COMMON.LOCAL'
3199 include 'COMMON.CHAIN'
3200 include 'COMMON.DERIV'
3201 include 'COMMON.INTERACT'
3202 include 'COMMON.CONTACTS'
3203 include 'COMMON.TORSION'
3204 include 'COMMON.VECTORS'
3205 include 'COMMON.FFIELD'
3206 include 'COMMON.TIME1'
3207 include 'COMMON.SPLITELE'
3208 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3209 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3210 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3211 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij(4)
3212 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3213 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3215 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3217 double precision scal_el /1.0d0/
3219 double precision scal_el /0.5d0/
3222 C 13-go grudnia roku pamietnego...
3223 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3224 & 0.0d0,1.0d0,0.0d0,
3225 & 0.0d0,0.0d0,1.0d0/
3226 cd write(iout,*) 'In EELEC'
3228 cd write(iout,*) 'Type',i
3229 cd write(iout,*) 'B1',B1(:,i)
3230 cd write(iout,*) 'B2',B2(:,i)
3231 cd write(iout,*) 'CC',CC(:,:,i)
3232 cd write(iout,*) 'DD',DD(:,:,i)
3233 cd write(iout,*) 'EE',EE(:,:,i)
3235 cd call check_vecgrad
3237 if (icheckgrad.eq.1) then
3239 fac=1.0d0/dsqrt(scalar(dc(1,i),dc(1,i)))
3241 dc_norm(k,i)=dc(k,i)*fac
3243 c write (iout,*) 'i',i,' fac',fac
3246 if (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3247 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0 .or.
3248 & wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) then
3249 c call vec_and_deriv
3255 time_mat=time_mat+MPI_Wtime()-time01
3259 cd write (iout,*) 'i=',i
3261 cd write (iout,'(i5,2f10.5)') k,uy(k,i),uz(k,i)
3264 cd write (iout,'(f10.5,2x,3f10.5,2x,3f10.5)')
3265 cd & uz(k,i),(uzgrad(k,l,1,i),l=1,3),(uzgrad(k,l,2,i),l=1,3)
3278 cd print '(a)','Enter EELEC'
3279 cd write (iout,*) 'iatel_s=',iatel_s,' iatel_e=',iatel_e
3281 gel_loc_loc(i)=0.0d0
3286 c 9/27/08 AL Split the interaction loop to ensure load balancing of turn terms
3288 C Loop over i,i+2 and i,i+3 pairs of the peptide groups
3290 C 14/01/2014 TURN3,TUNR4 does no go under periodic boundry condition
3291 do i=iturn3_start,iturn3_end
3293 C write(iout,*) "tu jest i",i
3294 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3295 C changes suggested by Ana to avoid out of bounds
3296 & .or.((i+4).gt.nres)
3298 C end of changes by Ana
3299 & .or. itype(i+2).eq.ntyp1
3300 & .or. itype(i+3).eq.ntyp1) cycle
3302 if(itype(i-1).eq.ntyp1)cycle
3305 if (itype(i+4).eq.ntyp1) cycle
3310 dx_normi=dc_norm(1,i)
3311 dy_normi=dc_norm(2,i)
3312 dz_normi=dc_norm(3,i)
3313 xmedi=c(1,i)+0.5d0*dxi
3314 ymedi=c(2,i)+0.5d0*dyi
3315 zmedi=c(3,i)+0.5d0*dzi
3316 xmedi=mod(xmedi,boxxsize)
3317 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3318 ymedi=mod(ymedi,boxysize)
3319 if (ymedi.lt.0) ymedi=ymedi+boxysize
3320 zmedi=mod(zmedi,boxzsize)
3321 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3323 call eelecij(i,i+2,ees,evdw1,eel_loc)
3324 if (wturn3.gt.0.0d0) call eturn3(i,eello_turn3)
3325 num_cont_hb(i)=num_conti
3327 do i=iturn4_start,iturn4_end
3329 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3330 C changes suggested by Ana to avoid out of bounds
3331 & .or.((i+5).gt.nres)
3333 C end of changes suggested by Ana
3334 & .or. itype(i+3).eq.ntyp1
3335 & .or. itype(i+4).eq.ntyp1
3336 & .or. itype(i+5).eq.ntyp1
3337 & .or. itype(i).eq.ntyp1
3338 & .or. itype(i-1).eq.ntyp1
3343 dx_normi=dc_norm(1,i)
3344 dy_normi=dc_norm(2,i)
3345 dz_normi=dc_norm(3,i)
3346 xmedi=c(1,i)+0.5d0*dxi
3347 ymedi=c(2,i)+0.5d0*dyi
3348 zmedi=c(3,i)+0.5d0*dzi
3349 C Return atom into box, boxxsize is size of box in x dimension
3351 c if (xmedi.gt.((0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3352 c if (xmedi.lt.((-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3353 C Condition for being inside the proper box
3354 c if ((xmedi.gt.((0.5d0)*boxxsize)).or.
3355 c & (xmedi.lt.((-0.5d0)*boxxsize))) then
3359 c if (ymedi.gt.((0.5d0)*boxysize)) ymedi=ymedi-boxysize
3360 c if (ymedi.lt.((-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3361 C Condition for being inside the proper box
3362 c if ((ymedi.gt.((0.5d0)*boxysize)).or.
3363 c & (ymedi.lt.((-0.5d0)*boxysize))) then
3367 c if (zmedi.gt.((0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3368 c if (zmedi.lt.((-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3369 C Condition for being inside the proper box
3370 c if ((zmedi.gt.((0.5d0)*boxzsize)).or.
3371 c & (zmedi.lt.((-0.5d0)*boxzsize))) then
3374 xmedi=mod(xmedi,boxxsize)
3375 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3376 ymedi=mod(ymedi,boxysize)
3377 if (ymedi.lt.0) ymedi=ymedi+boxysize
3378 zmedi=mod(zmedi,boxzsize)
3379 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3381 num_conti=num_cont_hb(i)
3382 c write(iout,*) "JESTEM W PETLI"
3383 call eelecij(i,i+3,ees,evdw1,eel_loc)
3384 if (wturn4.gt.0.0d0 .and. itype(i+2).ne.ntyp1)
3385 & call eturn4(i,eello_turn4)
3386 num_cont_hb(i)=num_conti
3388 C Loop over all neighbouring boxes
3393 c Loop over all pairs of interacting peptide groups except i,i+2 and i,i+3
3395 do i=iatel_s,iatel_e
3397 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1
3398 C changes suggested by Ana to avoid out of bounds
3399 & .or.((i+2).gt.nres)
3401 C end of changes by Ana
3402 & .or. itype(i+2).eq.ntyp1
3403 & .or. itype(i-1).eq.ntyp1
3408 dx_normi=dc_norm(1,i)
3409 dy_normi=dc_norm(2,i)
3410 dz_normi=dc_norm(3,i)
3411 xmedi=c(1,i)+0.5d0*dxi
3412 ymedi=c(2,i)+0.5d0*dyi
3413 zmedi=c(3,i)+0.5d0*dzi
3414 xmedi=mod(xmedi,boxxsize)
3415 if (xmedi.lt.0) xmedi=xmedi+boxxsize
3416 ymedi=mod(ymedi,boxysize)
3417 if (ymedi.lt.0) ymedi=ymedi+boxysize
3418 zmedi=mod(zmedi,boxzsize)
3419 if (zmedi.lt.0) zmedi=zmedi+boxzsize
3420 C xmedi=xmedi+xshift*boxxsize
3421 C ymedi=ymedi+yshift*boxysize
3422 C zmedi=zmedi+zshift*boxzsize
3424 C Return tom into box, boxxsize is size of box in x dimension
3426 c if (xmedi.gt.((xshift+0.5d0)*boxxsize)) xmedi=xmedi-boxxsize
3427 c if (xmedi.lt.((xshift-0.5d0)*boxxsize)) xmedi=xmedi+boxxsize
3428 C Condition for being inside the proper box
3429 c if ((xmedi.gt.((xshift+0.5d0)*boxxsize)).or.
3430 c & (xmedi.lt.((xshift-0.5d0)*boxxsize))) then
3434 c if (ymedi.gt.((yshift+0.5d0)*boxysize)) ymedi=ymedi-boxysize
3435 c if (ymedi.lt.((yshift-0.5d0)*boxysize)) ymedi=ymedi+boxysize
3436 C Condition for being inside the proper box
3437 c if ((ymedi.gt.((yshift+0.5d0)*boxysize)).or.
3438 c & (ymedi.lt.((yshift-0.5d0)*boxysize))) then
3442 c if (zmedi.gt.((zshift+0.5d0)*boxzsize)) zmedi=zmedi-boxzsize
3443 c if (zmedi.lt.((zshift-0.5d0)*boxzsize)) zmedi=zmedi+boxzsize
3444 cC Condition for being inside the proper box
3445 c if ((zmedi.gt.((zshift+0.5d0)*boxzsize)).or.
3446 c & (zmedi.lt.((zshift-0.5d0)*boxzsize))) then
3450 c write (iout,*) 'i',i,' ielstart',ielstart(i),' ielend',ielend(i)
3451 num_conti=num_cont_hb(i)
3452 do j=ielstart(i),ielend(i)
3453 C write (iout,*) i,j
3455 if (itype(j).eq.ntyp1.or. itype(j+1).eq.ntyp1
3456 C changes suggested by Ana to avoid out of bounds
3457 & .or.((j+2).gt.nres)
3459 C end of changes by Ana
3460 & .or.itype(j+2).eq.ntyp1
3461 & .or.itype(j-1).eq.ntyp1
3463 call eelecij(i,j,ees,evdw1,eel_loc)
3465 num_cont_hb(i)=num_conti
3471 c write (iout,*) "Number of loop steps in EELEC:",ind
3473 cd write (iout,'(i3,3f10.5,5x,3f10.5)')
3474 cd & i,(gel_loc(k,i),k=1,3),gel_loc_loc(i)
3476 c 12/7/99 Adam eello_turn3 will be considered as a separate energy term
3477 ccc eel_loc=eel_loc+eello_turn3
3478 cd print *,"Processor",fg_rank," t_eelecij",t_eelecij
3481 C-------------------------------------------------------------------------------
3482 subroutine eelecij(i,j,ees,evdw1,eel_loc)
3483 implicit real*8 (a-h,o-z)
3484 include 'DIMENSIONS'
3488 include 'COMMON.CONTROL'
3489 include 'COMMON.IOUNITS'
3490 include 'COMMON.GEO'
3491 include 'COMMON.VAR'
3492 include 'COMMON.LOCAL'
3493 include 'COMMON.CHAIN'
3494 include 'COMMON.DERIV'
3495 include 'COMMON.INTERACT'
3496 include 'COMMON.CONTACTS'
3497 include 'COMMON.TORSION'
3498 include 'COMMON.VECTORS'
3499 include 'COMMON.FFIELD'
3500 include 'COMMON.TIME1'
3501 include 'COMMON.SPLITELE'
3502 dimension ggg(3),gggp(3),gggm(3),erij(3),dcosb(3),dcosg(3),
3503 & erder(3,3),uryg(3,3),urzg(3,3),vryg(3,3),vrzg(3,3)
3504 double precision acipa(2,2),agg(3,4),aggi(3,4),aggi1(3,4),
3505 & aggj(3,4),aggj1(3,4),a_temp(2,2),muij(4),gmuij1(4),gmuji1(4),
3506 & gmuij2(4),gmuji2(4)
3507 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
3508 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
3510 c 4/26/02 - AL scaling factor for 1,4 repulsive VDW interactions
3512 double precision scal_el /1.0d0/
3514 double precision scal_el /0.5d0/
3517 C 13-go grudnia roku pamietnego...
3518 double precision unmat(3,3) /1.0d0,0.0d0,0.0d0,
3519 & 0.0d0,1.0d0,0.0d0,
3520 & 0.0d0,0.0d0,1.0d0/
3521 c time00=MPI_Wtime()
3522 cd write (iout,*) "eelecij",i,j
3526 if (j.eq.i+2 .and. itelj.eq.2) iteli=2
3527 aaa=app(iteli,itelj)
3528 bbb=bpp(iteli,itelj)
3529 ael6i=ael6(iteli,itelj)
3530 ael3i=ael3(iteli,itelj)
3534 dx_normj=dc_norm(1,j)
3535 dy_normj=dc_norm(2,j)
3536 dz_normj=dc_norm(3,j)
3537 C xj=c(1,j)+0.5D0*dxj-xmedi
3538 C yj=c(2,j)+0.5D0*dyj-ymedi
3539 C zj=c(3,j)+0.5D0*dzj-zmedi
3544 if (xj.lt.0) xj=xj+boxxsize
3546 if (yj.lt.0) yj=yj+boxysize
3548 if (zj.lt.0) zj=zj+boxzsize
3549 if ((zj.lt.0).or.(xj.lt.0).or.(yj.lt.0)) write (*,*) "CHUJ"
3550 dist_init=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3558 xj=xj_safe+xshift*boxxsize
3559 yj=yj_safe+yshift*boxysize
3560 zj=zj_safe+zshift*boxzsize
3561 dist_temp=(xj-xmedi)**2+(yj-ymedi)**2+(zj-zmedi)**2
3562 if(dist_temp.lt.dist_init) then
3572 if (isubchap.eq.1) then
3581 C if ((i+3).lt.j) then !this condition keeps for turn3 and turn4 not subject to PBC
3583 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
3584 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
3585 C Condition for being inside the proper box
3586 c if ((xj.gt.((0.5d0)*boxxsize)).or.
3587 c & (xj.lt.((-0.5d0)*boxxsize))) then
3591 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
3592 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
3593 C Condition for being inside the proper box
3594 c if ((yj.gt.((0.5d0)*boxysize)).or.
3595 c & (yj.lt.((-0.5d0)*boxysize))) then
3599 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
3600 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
3601 C Condition for being inside the proper box
3602 c if ((zj.gt.((0.5d0)*boxzsize)).or.
3603 c & (zj.lt.((-0.5d0)*boxzsize))) then
3606 C endif !endPBC condintion
3610 rij=xj*xj+yj*yj+zj*zj
3612 sss=sscale(sqrt(rij))
3613 sssgrad=sscagrad(sqrt(rij))
3614 c if (sss.gt.0.0d0) then
3620 cosa=dx_normi*dx_normj+dy_normi*dy_normj+dz_normi*dz_normj
3621 cosb=(xj*dx_normi+yj*dy_normi+zj*dz_normi)*rmij
3622 cosg=(xj*dx_normj+yj*dy_normj+zj*dz_normj)*rmij
3623 fac=cosa-3.0D0*cosb*cosg
3625 c 4/26/02 - AL scaling down 1,4 repulsive VDW interactions
3626 if (j.eq.i+2) ev1=scal_el*ev1
3631 el1=fac3*(4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg))
3635 C 12/26/95 - for the evaluation of multi-body H-bonding interactions
3636 ees0ij=4.0D0+fac*fac-3.0D0*(cosb*cosb+cosg*cosg)
3638 evdw1=evdw1+evdwij*sss
3639 cd write(iout,'(2(2i3,2x),7(1pd12.4)/2(3(1pd12.4),5x)/)')
3640 cd & iteli,i,itelj,j,aaa,bbb,ael6i,ael3i,
3641 cd & 1.0D0/dsqrt(rrmij),evdwij,eesij,
3642 cd & xmedi,ymedi,zmedi,xj,yj,zj
3644 if (energy_dec) then
3645 write (iout,'(a6,2i5,0pf7.3,2i5,2e11.3)')
3647 &,iteli,itelj,aaa,evdw1
3648 write (iout,'(a6,2i5,0pf7.3)') 'ees',i,j,eesij
3652 C Calculate contributions to the Cartesian gradient.
3655 facvdw=-6*rrmij*(ev1+evdwij)*sss
3656 facel=-3*rrmij*(el1+eesij)
3662 * Radial derivatives. First process both termini of the fragment (i,j)
3668 c ghalf=0.5D0*ggg(k)
3669 c gelc(k,i)=gelc(k,i)+ghalf
3670 c gelc(k,j)=gelc(k,j)+ghalf
3672 c 9/28/08 AL Gradient compotents will be summed only at the end
3674 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3675 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3678 * Loop over residues i+1 thru j-1.
3682 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3685 if (sss.gt.0.0) then
3686 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3687 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3688 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3695 c ghalf=0.5D0*ggg(k)
3696 c gvdwpp(k,i)=gvdwpp(k,i)+ghalf
3697 c gvdwpp(k,j)=gvdwpp(k,j)+ghalf
3699 c 9/28/08 AL Gradient compotents will be summed only at the end
3701 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3702 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3705 * Loop over residues i+1 thru j-1.
3709 cgrad gvdwpp(l,k)=gvdwpp(l,k)+ggg(l)
3714 facvdw=(ev1+evdwij)*sss
3717 fac=-3*rrmij*(facvdw+facvdw+facel)
3722 * Radial derivatives. First process both termini of the fragment (i,j)
3728 c ghalf=0.5D0*ggg(k)
3729 c gelc(k,i)=gelc(k,i)+ghalf
3730 c gelc(k,j)=gelc(k,j)+ghalf
3732 c 9/28/08 AL Gradient compotents will be summed only at the end
3734 gelc_long(k,j)=gelc(k,j)+ggg(k)
3735 gelc_long(k,i)=gelc(k,i)-ggg(k)
3738 * Loop over residues i+1 thru j-1.
3742 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3745 c 9/28/08 AL Gradient compotents will be summed only at the end
3746 ggg(1)=facvdw*xj+sssgrad*rmij*evdwij*xj
3747 ggg(2)=facvdw*yj+sssgrad*rmij*evdwij*yj
3748 ggg(3)=facvdw*zj+sssgrad*rmij*evdwij*zj
3750 gvdwpp(k,j)=gvdwpp(k,j)+ggg(k)
3751 gvdwpp(k,i)=gvdwpp(k,i)-ggg(k)
3757 ecosa=2.0D0*fac3*fac1+fac4
3760 ecosb=(fac3*(fac1*cosg+cosb)+cosg*fac4)
3761 ecosg=(fac3*(fac1*cosb+cosg)+cosb*fac4)
3763 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
3764 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
3766 cd print '(2i3,2(3(1pd14.5),3x))',i,j,(dcosb(k),k=1,3),
3767 cd & (dcosg(k),k=1,3)
3769 ggg(k)=ecosb*dcosb(k)+ecosg*dcosg(k)
3772 c ghalf=0.5D0*ggg(k)
3773 c gelc(k,i)=gelc(k,i)+ghalf
3774 c & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3775 c & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3776 c gelc(k,j)=gelc(k,j)+ghalf
3777 c & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3778 c & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3782 cgrad gelc(l,k)=gelc(l,k)+ggg(l)
3787 & +(ecosa*(dc_norm(k,j)-cosa*dc_norm(k,i))
3788 & + ecosb*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
3790 & +(ecosa*(dc_norm(k,i)-cosa*dc_norm(k,j))
3791 & + ecosg*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
3792 gelc_long(k,j)=gelc_long(k,j)+ggg(k)
3793 gelc_long(k,i)=gelc_long(k,i)-ggg(k)
3797 IF (wel_loc.gt.0.0d0 .or. wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0
3798 & .or. wcorr6.gt.0.0d0 .or. wturn3.gt.0.0d0
3799 & .or. wturn4.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
3801 C 9/25/99 Mixed third-order local-electrostatic terms. The local-interaction
3802 C energy of a peptide unit is assumed in the form of a second-order
3803 C Fourier series in the angles lambda1 and lambda2 (see Nishikawa et al.
3804 C Macromolecules, 1974, 7, 797-806 for definition). This correlation terms
3805 C are computed for EVERY pair of non-contiguous peptide groups.
3808 if (j.lt.nres-1) then
3820 muij(kkk)=mu(k,i)*mu(l,j)
3821 c write(iout,*) 'mumu=', mu(k,i),mu(l,j),i,j,k,l
3823 gmuij1(kkk)=gtb1(k,i+1)*mu(l,j)
3824 c write(iout,*) 'k=',k,i,gtb1(k,i+1),gtb1(k,i+1)*mu(l,j)
3825 gmuij2(kkk)=gUb2(k,i)*mu(l,j)
3826 gmuji1(kkk)=mu(k,i)*gtb1(l,j+1)
3827 c write(iout,*) 'l=',l,j,gtb1(l,j+1),gtb1(l,j+1)*mu(k,i)
3828 gmuji2(kkk)=mu(k,i)*gUb2(l,j)
3832 cd write (iout,*) 'EELEC: i',i,' j',j
3833 cd write (iout,*) 'j',j,' j1',j1,' j2',j2
3834 cd write(iout,*) 'muij',muij
3835 ury=scalar(uy(1,i),erij)
3836 urz=scalar(uz(1,i),erij)
3837 vry=scalar(uy(1,j),erij)
3838 vrz=scalar(uz(1,j),erij)
3839 a22=scalar(uy(1,i),uy(1,j))-3*ury*vry
3840 a23=scalar(uy(1,i),uz(1,j))-3*ury*vrz
3841 a32=scalar(uz(1,i),uy(1,j))-3*urz*vry
3842 a33=scalar(uz(1,i),uz(1,j))-3*urz*vrz
3843 fac=dsqrt(-ael6i)*r3ij
3848 cd write (iout,'(4i5,4f10.5)')
3849 cd & i,itortyp(itype(i)),j,itortyp(itype(j)),a22,a23,a32,a33
3850 cd write (iout,'(6f10.5)') (muij(k),k=1,4),fac,eel_loc_ij
3851 cd write (iout,'(2(3f10.5,5x)/2(3f10.5,5x))') uy(:,i),uz(:,i),
3852 cd & uy(:,j),uz(:,j)
3853 cd write (iout,'(4f10.5)')
3854 cd & scalar(uy(1,i),uy(1,j)),scalar(uy(1,i),uz(1,j)),
3855 cd & scalar(uz(1,i),uy(1,j)),scalar(uz(1,i),uz(1,j))
3856 cd write (iout,'(4f10.5)') ury,urz,vry,vrz
3857 cd write (iout,'(9f10.5/)')
3858 cd & fac22,a22,fac23,a23,fac32,a32,fac33,a33,eel_loc_ij
3859 C Derivatives of the elements of A in virtual-bond vectors
3860 call unormderiv(erij(1),unmat(1,1),rmij,erder(1,1))
3862 uryg(k,1)=scalar(erder(1,k),uy(1,i))
3863 uryg(k,2)=scalar(uygrad(1,k,1,i),erij(1))
3864 uryg(k,3)=scalar(uygrad(1,k,2,i),erij(1))
3865 urzg(k,1)=scalar(erder(1,k),uz(1,i))
3866 urzg(k,2)=scalar(uzgrad(1,k,1,i),erij(1))
3867 urzg(k,3)=scalar(uzgrad(1,k,2,i),erij(1))
3868 vryg(k,1)=scalar(erder(1,k),uy(1,j))
3869 vryg(k,2)=scalar(uygrad(1,k,1,j),erij(1))
3870 vryg(k,3)=scalar(uygrad(1,k,2,j),erij(1))
3871 vrzg(k,1)=scalar(erder(1,k),uz(1,j))
3872 vrzg(k,2)=scalar(uzgrad(1,k,1,j),erij(1))
3873 vrzg(k,3)=scalar(uzgrad(1,k,2,j),erij(1))
3875 C Compute radial contributions to the gradient
3893 C Add the contributions coming from er
3896 agg(k,1)=agg(k,1)+fac3*(uryg(k,1)*vry+vryg(k,1)*ury)
3897 agg(k,2)=agg(k,2)+fac3*(uryg(k,1)*vrz+vrzg(k,1)*ury)
3898 agg(k,3)=agg(k,3)+fac3*(urzg(k,1)*vry+vryg(k,1)*urz)
3899 agg(k,4)=agg(k,4)+fac3*(urzg(k,1)*vrz+vrzg(k,1)*urz)
3902 C Derivatives in DC(i)
3903 cgrad ghalf1=0.5d0*agg(k,1)
3904 cgrad ghalf2=0.5d0*agg(k,2)
3905 cgrad ghalf3=0.5d0*agg(k,3)
3906 cgrad ghalf4=0.5d0*agg(k,4)
3907 aggi(k,1)=fac*(scalar(uygrad(1,k,1,i),uy(1,j))
3908 & -3.0d0*uryg(k,2)*vry)!+ghalf1
3909 aggi(k,2)=fac*(scalar(uygrad(1,k,1,i),uz(1,j))
3910 & -3.0d0*uryg(k,2)*vrz)!+ghalf2
3911 aggi(k,3)=fac*(scalar(uzgrad(1,k,1,i),uy(1,j))
3912 & -3.0d0*urzg(k,2)*vry)!+ghalf3
3913 aggi(k,4)=fac*(scalar(uzgrad(1,k,1,i),uz(1,j))
3914 & -3.0d0*urzg(k,2)*vrz)!+ghalf4
3915 C Derivatives in DC(i+1)
3916 aggi1(k,1)=fac*(scalar(uygrad(1,k,2,i),uy(1,j))
3917 & -3.0d0*uryg(k,3)*vry)!+agg(k,1)
3918 aggi1(k,2)=fac*(scalar(uygrad(1,k,2,i),uz(1,j))
3919 & -3.0d0*uryg(k,3)*vrz)!+agg(k,2)
3920 aggi1(k,3)=fac*(scalar(uzgrad(1,k,2,i),uy(1,j))
3921 & -3.0d0*urzg(k,3)*vry)!+agg(k,3)
3922 aggi1(k,4)=fac*(scalar(uzgrad(1,k,2,i),uz(1,j))
3923 & -3.0d0*urzg(k,3)*vrz)!+agg(k,4)
3924 C Derivatives in DC(j)
3925 aggj(k,1)=fac*(scalar(uygrad(1,k,1,j),uy(1,i))
3926 & -3.0d0*vryg(k,2)*ury)!+ghalf1
3927 aggj(k,2)=fac*(scalar(uzgrad(1,k,1,j),uy(1,i))
3928 & -3.0d0*vrzg(k,2)*ury)!+ghalf2
3929 aggj(k,3)=fac*(scalar(uygrad(1,k,1,j),uz(1,i))
3930 & -3.0d0*vryg(k,2)*urz)!+ghalf3
3931 aggj(k,4)=fac*(scalar(uzgrad(1,k,1,j),uz(1,i))
3932 & -3.0d0*vrzg(k,2)*urz)!+ghalf4
3933 C Derivatives in DC(j+1) or DC(nres-1)
3934 aggj1(k,1)=fac*(scalar(uygrad(1,k,2,j),uy(1,i))
3935 & -3.0d0*vryg(k,3)*ury)
3936 aggj1(k,2)=fac*(scalar(uzgrad(1,k,2,j),uy(1,i))
3937 & -3.0d0*vrzg(k,3)*ury)
3938 aggj1(k,3)=fac*(scalar(uygrad(1,k,2,j),uz(1,i))
3939 & -3.0d0*vryg(k,3)*urz)
3940 aggj1(k,4)=fac*(scalar(uzgrad(1,k,2,j),uz(1,i))
3941 & -3.0d0*vrzg(k,3)*urz)
3942 cgrad if (j.eq.nres-1 .and. i.lt.j-2) then
3944 cgrad aggj1(k,l)=aggj1(k,l)+agg(k,l)
3957 aggi(k,l)=-aggi(k,l)
3958 aggi1(k,l)=-aggi1(k,l)
3959 aggj(k,l)=-aggj(k,l)
3960 aggj1(k,l)=-aggj1(k,l)
3963 if (j.lt.nres-1) then
3969 aggi(k,l)=-aggi(k,l)
3970 aggi1(k,l)=-aggi1(k,l)
3971 aggj(k,l)=-aggj(k,l)
3972 aggj1(k,l)=-aggj1(k,l)
3983 aggi(k,l)=-aggi(k,l)
3984 aggi1(k,l)=-aggi1(k,l)
3985 aggj(k,l)=-aggj(k,l)
3986 aggj1(k,l)=-aggj1(k,l)
3991 IF (wel_loc.gt.0.0d0) THEN
3992 C Contribution to the local-electrostatic energy coming from the i-j pair
3993 eel_loc_ij=a22*muij(1)+a23*muij(2)+a32*muij(3)
3995 c write (iout,*) 'i',i,' j',j,itype(i),itype(j),
3996 c & ' eel_loc_ij',eel_loc_ij
3997 c write(iout,*) 'muije=',muij(1),muij(2),muij(3),muij(4)
3998 C Calculate patrial derivative for theta angle
4000 geel_loc_ij=a22*gmuij1(1)
4004 c write(iout,*) "derivative over thatai"
4005 c write(iout,*) a22*gmuij1(1), a23*gmuij1(2) ,a32*gmuij1(3),
4007 gloc(nphi+i,icg)=gloc(nphi+i,icg)+
4008 & geel_loc_ij*wel_loc
4009 c write(iout,*) "derivative over thatai-1"
4010 c write(iout,*) a22*gmuij2(1), a23*gmuij2(2) ,a32*gmuij2(3),
4017 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
4018 & geel_loc_ij*wel_loc
4019 c Derivative over j residue
4020 geel_loc_ji=a22*gmuji1(1)
4024 c write(iout,*) "derivative over thataj"
4025 c write(iout,*) a22*gmuji1(1), a23*gmuji1(2) ,a32*gmuji1(3),
4028 gloc(nphi+j,icg)=gloc(nphi+j,icg)+
4029 & geel_loc_ji*wel_loc
4035 c write(iout,*) "derivative over thataj-1"
4036 c write(iout,*) a22*gmuji2(1), a23*gmuji2(2) ,a32*gmuji2(3),
4038 gloc(nphi+j-1,icg)=gloc(nphi+j-1,icg)+
4039 & geel_loc_ji*wel_loc
4041 cd write (iout,*) 'i',i,' j',j,' eel_loc_ij',eel_loc_ij
4043 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4044 & 'eelloc',i,j,eel_loc_ij
4045 c if (eel_loc_ij.ne.0)
4046 c & write (iout,'(a4,2i4,8f9.5)')'chuj',
4047 c & i,j,a22,muij(1),a23,muij(2),a32,muij(3),a33,muij(4)
4049 eel_loc=eel_loc+eel_loc_ij
4050 C Partial derivatives in virtual-bond dihedral angles gamma
4052 & gel_loc_loc(i-1)=gel_loc_loc(i-1)+
4053 & a22*muder(1,i)*mu(1,j)+a23*muder(1,i)*mu(2,j)
4054 & +a32*muder(2,i)*mu(1,j)+a33*muder(2,i)*mu(2,j)
4055 gel_loc_loc(j-1)=gel_loc_loc(j-1)+
4056 & a22*mu(1,i)*muder(1,j)+a23*mu(1,i)*muder(2,j)
4057 & +a32*mu(2,i)*muder(1,j)+a33*mu(2,i)*muder(2,j)
4058 C Derivatives of eello in DC(i+1) thru DC(j-1) or DC(nres-2)
4060 ggg(l)=agg(l,1)*muij(1)+
4061 & agg(l,2)*muij(2)+agg(l,3)*muij(3)+agg(l,4)*muij(4)
4062 gel_loc_long(l,j)=gel_loc_long(l,j)+ggg(l)
4063 gel_loc_long(l,i)=gel_loc_long(l,i)-ggg(l)
4064 cgrad ghalf=0.5d0*ggg(l)
4065 cgrad gel_loc(l,i)=gel_loc(l,i)+ghalf
4066 cgrad gel_loc(l,j)=gel_loc(l,j)+ghalf
4070 cgrad gel_loc(l,k)=gel_loc(l,k)+ggg(l)
4073 C Remaining derivatives of eello
4075 gel_loc(l,i)=gel_loc(l,i)+(aggi(l,1)*muij(1)+
4076 & aggi(l,2)*muij(2)+aggi(l,3)*muij(3)+aggi(l,4)*muij(4))
4077 gel_loc(l,i+1)=gel_loc(l,i+1)+(aggi1(l,1)*muij(1)+
4078 & aggi1(l,2)*muij(2)+aggi1(l,3)*muij(3)+aggi1(l,4)*muij(4))
4079 gel_loc(l,j)=gel_loc(l,j)+(aggj(l,1)*muij(1)+
4080 & aggj(l,2)*muij(2)+aggj(l,3)*muij(3)+aggj(l,4)*muij(4))
4081 gel_loc(l,j1)=gel_loc(l,j1)+(aggj1(l,1)*muij(1)+
4082 & aggj1(l,2)*muij(2)+aggj1(l,3)*muij(3)+aggj1(l,4)*muij(4))
4085 C Change 12/26/95 to calculate four-body contributions to H-bonding energy
4086 c if (j.gt.i+1 .and. num_conti.le.maxconts) then
4087 if (wcorr+wcorr4+wcorr5+wcorr6.gt.0.0d0
4088 & .and. num_conti.le.maxconts) then
4089 c write (iout,*) i,j," entered corr"
4091 C Calculate the contact function. The ith column of the array JCONT will
4092 C contain the numbers of atoms that make contacts with the atom I (of numbers
4093 C greater than I). The arrays FACONT and GACONT will contain the values of
4094 C the contact function and its derivative.
4095 c r0ij=1.02D0*rpp(iteli,itelj)
4096 c r0ij=1.11D0*rpp(iteli,itelj)
4097 r0ij=2.20D0*rpp(iteli,itelj)
4098 c r0ij=1.55D0*rpp(iteli,itelj)
4099 call gcont(rij,r0ij,1.0D0,0.2d0*r0ij,fcont,fprimcont)
4100 if (fcont.gt.0.0D0) then
4101 num_conti=num_conti+1
4102 if (num_conti.gt.maxconts) then
4103 write (iout,*) 'WARNING - max. # of contacts exceeded;',
4104 & ' will skip next contacts for this conf.'
4106 jcont_hb(num_conti,i)=j
4107 cd write (iout,*) "i",i," j",j," num_conti",num_conti,
4108 cd & " jcont_hb",jcont_hb(num_conti,i)
4109 IF (wcorr4.gt.0.0d0 .or. wcorr5.gt.0.0d0 .or.
4110 & wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) THEN
4111 C 9/30/99 (AL) - store components necessary to evaluate higher-order loc-el
4113 d_cont(num_conti,i)=rij
4114 cd write (2,'(3e15.5)') rij,r0ij+0.2d0*r0ij,rij
4115 C --- Electrostatic-interaction matrix ---
4116 a_chuj(1,1,num_conti,i)=a22
4117 a_chuj(1,2,num_conti,i)=a23
4118 a_chuj(2,1,num_conti,i)=a32
4119 a_chuj(2,2,num_conti,i)=a33
4120 C --- Gradient of rij
4122 grij_hb_cont(kkk,num_conti,i)=erij(kkk)
4129 a_chuj_der(k,l,m,1,num_conti,i)=agg(m,kkll)
4130 a_chuj_der(k,l,m,2,num_conti,i)=aggi(m,kkll)
4131 a_chuj_der(k,l,m,3,num_conti,i)=aggi1(m,kkll)
4132 a_chuj_der(k,l,m,4,num_conti,i)=aggj(m,kkll)
4133 a_chuj_der(k,l,m,5,num_conti,i)=aggj1(m,kkll)
4138 IF (wcorr4.eq.0.0d0 .and. wcorr.gt.0.0d0) THEN
4139 C Calculate contact energies
4141 wij=cosa-3.0D0*cosb*cosg
4144 c fac3=dsqrt(-ael6i)/r0ij**3
4145 fac3=dsqrt(-ael6i)*r3ij
4146 c ees0pij=dsqrt(4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1)
4147 ees0tmp=4.0D0+cosa4+wij*wij-3.0D0*cosbg1*cosbg1
4148 if (ees0tmp.gt.0) then
4149 ees0pij=dsqrt(ees0tmp)
4153 c ees0mij=dsqrt(4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2)
4154 ees0tmp=4.0D0-cosa4+wij*wij-3.0D0*cosbg2*cosbg2
4155 if (ees0tmp.gt.0) then
4156 ees0mij=dsqrt(ees0tmp)
4161 ees0p(num_conti,i)=0.5D0*fac3*(ees0pij+ees0mij)
4162 ees0m(num_conti,i)=0.5D0*fac3*(ees0pij-ees0mij)
4163 C Diagnostics. Comment out or remove after debugging!
4164 c ees0p(num_conti,i)=0.5D0*fac3*ees0pij
4165 c ees0m(num_conti,i)=0.5D0*fac3*ees0mij
4166 c ees0m(num_conti,i)=0.0D0
4168 c write (iout,*) 'i=',i,' j=',j,' rij=',rij,' r0ij=',r0ij,
4169 c & ' ees0ij=',ees0p(num_conti,i),ees0m(num_conti,i),' fcont=',fcont
4170 C Angular derivatives of the contact function
4171 ees0pij1=fac3/ees0pij
4172 ees0mij1=fac3/ees0mij
4173 fac3p=-3.0D0*fac3*rrmij
4174 ees0pijp=0.5D0*fac3p*(ees0pij+ees0mij)
4175 ees0mijp=0.5D0*fac3p*(ees0pij-ees0mij)
4177 ecosa1= ees0pij1*( 1.0D0+0.5D0*wij)
4178 ecosb1=-1.5D0*ees0pij1*(wij*cosg+cosbg1)
4179 ecosg1=-1.5D0*ees0pij1*(wij*cosb+cosbg1)
4180 ecosa2= ees0mij1*(-1.0D0+0.5D0*wij)
4181 ecosb2=-1.5D0*ees0mij1*(wij*cosg+cosbg2)
4182 ecosg2=-1.5D0*ees0mij1*(wij*cosb-cosbg2)
4183 ecosap=ecosa1+ecosa2
4184 ecosbp=ecosb1+ecosb2
4185 ecosgp=ecosg1+ecosg2
4186 ecosam=ecosa1-ecosa2
4187 ecosbm=ecosb1-ecosb2
4188 ecosgm=ecosg1-ecosg2
4197 facont_hb(num_conti,i)=fcont
4198 fprimcont=fprimcont/rij
4199 cd facont_hb(num_conti,i)=1.0D0
4200 C Following line is for diagnostics.
4203 dcosb(k)=rmij*(dc_norm(k,i)-erij(k)*cosb)
4204 dcosg(k)=rmij*(dc_norm(k,j)-erij(k)*cosg)
4207 gggp(k)=ecosbp*dcosb(k)+ecosgp*dcosg(k)
4208 gggm(k)=ecosbm*dcosb(k)+ecosgm*dcosg(k)
4210 gggp(1)=gggp(1)+ees0pijp*xj
4211 gggp(2)=gggp(2)+ees0pijp*yj
4212 gggp(3)=gggp(3)+ees0pijp*zj
4213 gggm(1)=gggm(1)+ees0mijp*xj
4214 gggm(2)=gggm(2)+ees0mijp*yj
4215 gggm(3)=gggm(3)+ees0mijp*zj
4216 C Derivatives due to the contact function
4217 gacont_hbr(1,num_conti,i)=fprimcont*xj
4218 gacont_hbr(2,num_conti,i)=fprimcont*yj
4219 gacont_hbr(3,num_conti,i)=fprimcont*zj
4222 c 10/24/08 cgrad and ! comments indicate the parts of the code removed
4223 c following the change of gradient-summation algorithm.
4225 cgrad ghalfp=0.5D0*gggp(k)
4226 cgrad ghalfm=0.5D0*gggm(k)
4227 gacontp_hb1(k,num_conti,i)=!ghalfp
4228 & +(ecosap*(dc_norm(k,j)-cosa*dc_norm(k,i))
4229 & + ecosbp*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4230 gacontp_hb2(k,num_conti,i)=!ghalfp
4231 & +(ecosap*(dc_norm(k,i)-cosa*dc_norm(k,j))
4232 & + ecosgp*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4233 gacontp_hb3(k,num_conti,i)=gggp(k)
4234 gacontm_hb1(k,num_conti,i)=!ghalfm
4235 & +(ecosam*(dc_norm(k,j)-cosa*dc_norm(k,i))
4236 & + ecosbm*(erij(k)-cosb*dc_norm(k,i)))*vbld_inv(i+1)
4237 gacontm_hb2(k,num_conti,i)=!ghalfm
4238 & +(ecosam*(dc_norm(k,i)-cosa*dc_norm(k,j))
4239 & + ecosgm*(erij(k)-cosg*dc_norm(k,j)))*vbld_inv(j+1)
4240 gacontm_hb3(k,num_conti,i)=gggm(k)
4242 C Diagnostics. Comment out or remove after debugging!
4244 cdiag gacontp_hb1(k,num_conti,i)=0.0D0
4245 cdiag gacontp_hb2(k,num_conti,i)=0.0D0
4246 cdiag gacontp_hb3(k,num_conti,i)=0.0D0
4247 cdiag gacontm_hb1(k,num_conti,i)=0.0D0
4248 cdiag gacontm_hb2(k,num_conti,i)=0.0D0
4249 cdiag gacontm_hb3(k,num_conti,i)=0.0D0
4252 endif ! num_conti.le.maxconts
4255 if (wturn3.gt.0.0d0 .or. wturn4.gt.0.0d0) then
4258 ghalf=0.5d0*agg(l,k)
4259 aggi(l,k)=aggi(l,k)+ghalf
4260 aggi1(l,k)=aggi1(l,k)+agg(l,k)
4261 aggj(l,k)=aggj(l,k)+ghalf
4264 if (j.eq.nres-1 .and. i.lt.j-2) then
4267 aggj1(l,k)=aggj1(l,k)+agg(l,k)
4272 c t_eelecij=t_eelecij+MPI_Wtime()-time00
4275 C-----------------------------------------------------------------------------
4276 subroutine eturn3(i,eello_turn3)
4277 C Third- and fourth-order contributions from turns
4278 implicit real*8 (a-h,o-z)
4279 include 'DIMENSIONS'
4280 include 'COMMON.IOUNITS'
4281 include 'COMMON.GEO'
4282 include 'COMMON.VAR'
4283 include 'COMMON.LOCAL'
4284 include 'COMMON.CHAIN'
4285 include 'COMMON.DERIV'
4286 include 'COMMON.INTERACT'
4287 include 'COMMON.CONTACTS'
4288 include 'COMMON.TORSION'
4289 include 'COMMON.VECTORS'
4290 include 'COMMON.FFIELD'
4291 include 'COMMON.CONTROL'
4293 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4294 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4295 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),gpizda1(2,2),
4296 & gpizda2(2,2),auxgmat1(2,2),auxgmatt1(2,2),
4297 & auxgmat2(2,2),auxgmatt2(2,2)
4298 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4299 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4300 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4301 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4304 c write (iout,*) "eturn3",i,j,j1,j2
4309 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4311 C Third-order contributions
4318 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4319 cd call checkint_turn3(i,a_temp,eello_turn3_num)
4320 call matmat2(EUg(1,1,i+1),EUg(1,1,i+2),auxmat(1,1))
4321 c auxalary matices for theta gradient
4322 c auxalary matrix for i+1 and constant i+2
4323 call matmat2(gtEUg(1,1,i+1),EUg(1,1,i+2),auxgmat1(1,1))
4324 c auxalary matrix for i+2 and constant i+1
4325 call matmat2(EUg(1,1,i+1),gtEUg(1,1,i+2),auxgmat2(1,1))
4326 call transpose2(auxmat(1,1),auxmat1(1,1))
4327 call transpose2(auxgmat1(1,1),auxgmatt1(1,1))
4328 call transpose2(auxgmat2(1,1),auxgmatt2(1,1))
4329 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4330 call matmat2(a_temp(1,1),auxgmatt1(1,1),gpizda1(1,1))
4331 call matmat2(a_temp(1,1),auxgmatt2(1,1),gpizda2(1,1))
4332 eello_turn3=eello_turn3+0.5d0*(pizda(1,1)+pizda(2,2))
4333 C Derivatives in theta
4334 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4335 & +0.5d0*(gpizda1(1,1)+gpizda1(2,2))*wturn3
4336 gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)
4337 & +0.5d0*(gpizda2(1,1)+gpizda2(2,2))*wturn3
4339 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4340 & 'eturn3',i,j,0.5d0*(pizda(1,1)+pizda(2,2))
4341 cd write (2,*) 'i,',i,' j',j,'eello_turn3',
4342 cd & 0.5d0*(pizda(1,1)+pizda(2,2)),
4343 cd & ' eello_turn3_num',4*eello_turn3_num
4344 C Derivatives in gamma(i)
4345 call matmat2(EUgder(1,1,i+1),EUg(1,1,i+2),auxmat2(1,1))
4346 call transpose2(auxmat2(1,1),auxmat3(1,1))
4347 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4348 gel_loc_turn3(i)=gel_loc_turn3(i)+0.5d0*(pizda(1,1)+pizda(2,2))
4349 C Derivatives in gamma(i+1)
4350 call matmat2(EUg(1,1,i+1),EUgder(1,1,i+2),auxmat2(1,1))
4351 call transpose2(auxmat2(1,1),auxmat3(1,1))
4352 call matmat2(a_temp(1,1),auxmat3(1,1),pizda(1,1))
4353 gel_loc_turn3(i+1)=gel_loc_turn3(i+1)
4354 & +0.5d0*(pizda(1,1)+pizda(2,2))
4355 C Cartesian derivatives
4357 c ghalf1=0.5d0*agg(l,1)
4358 c ghalf2=0.5d0*agg(l,2)
4359 c ghalf3=0.5d0*agg(l,3)
4360 c ghalf4=0.5d0*agg(l,4)
4361 a_temp(1,1)=aggi(l,1)!+ghalf1
4362 a_temp(1,2)=aggi(l,2)!+ghalf2
4363 a_temp(2,1)=aggi(l,3)!+ghalf3
4364 a_temp(2,2)=aggi(l,4)!+ghalf4
4365 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4366 gcorr3_turn(l,i)=gcorr3_turn(l,i)
4367 & +0.5d0*(pizda(1,1)+pizda(2,2))
4368 a_temp(1,1)=aggi1(l,1)!+agg(l,1)
4369 a_temp(1,2)=aggi1(l,2)!+agg(l,2)
4370 a_temp(2,1)=aggi1(l,3)!+agg(l,3)
4371 a_temp(2,2)=aggi1(l,4)!+agg(l,4)
4372 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4373 gcorr3_turn(l,i+1)=gcorr3_turn(l,i+1)
4374 & +0.5d0*(pizda(1,1)+pizda(2,2))
4375 a_temp(1,1)=aggj(l,1)!+ghalf1
4376 a_temp(1,2)=aggj(l,2)!+ghalf2
4377 a_temp(2,1)=aggj(l,3)!+ghalf3
4378 a_temp(2,2)=aggj(l,4)!+ghalf4
4379 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4380 gcorr3_turn(l,j)=gcorr3_turn(l,j)
4381 & +0.5d0*(pizda(1,1)+pizda(2,2))
4382 a_temp(1,1)=aggj1(l,1)
4383 a_temp(1,2)=aggj1(l,2)
4384 a_temp(2,1)=aggj1(l,3)
4385 a_temp(2,2)=aggj1(l,4)
4386 call matmat2(a_temp(1,1),auxmat1(1,1),pizda(1,1))
4387 gcorr3_turn(l,j1)=gcorr3_turn(l,j1)
4388 & +0.5d0*(pizda(1,1)+pizda(2,2))
4392 C-------------------------------------------------------------------------------
4393 subroutine eturn4(i,eello_turn4)
4394 C Third- and fourth-order contributions from turns
4395 implicit real*8 (a-h,o-z)
4396 include 'DIMENSIONS'
4397 include 'COMMON.IOUNITS'
4398 include 'COMMON.GEO'
4399 include 'COMMON.VAR'
4400 include 'COMMON.LOCAL'
4401 include 'COMMON.CHAIN'
4402 include 'COMMON.DERIV'
4403 include 'COMMON.INTERACT'
4404 include 'COMMON.CONTACTS'
4405 include 'COMMON.TORSION'
4406 include 'COMMON.VECTORS'
4407 include 'COMMON.FFIELD'
4408 include 'COMMON.CONTROL'
4410 double precision auxmat(2,2),auxmat1(2,2),auxmat2(2,2),pizda(2,2),
4411 & e1t(2,2),e2t(2,2),e3t(2,2),e1tder(2,2),e2tder(2,2),e3tder(2,2),
4412 & e1a(2,2),ae3(2,2),ae3e2(2,2),auxvec(2),auxvec1(2),auxgvec(2),
4413 & auxgEvec1(2),auxgEvec2(2),auxgEvec3(2),
4414 & gte1t(2,2),gte2t(2,2),gte3t(2,2),
4415 & gte1a(2,2),gtae3(2,2),gtae3e2(2,2), ae3gte2(2,2),
4416 & gtEpizda1(2,2),gtEpizda2(2,2),gtEpizda3(2,2)
4417 double precision agg(3,4),aggi(3,4),aggi1(3,4),
4418 & aggj(3,4),aggj1(3,4),a_temp(2,2),auxmat3(2,2)
4419 common /locel/ a_temp,agg,aggi,aggi1,aggj,aggj1,a22,a23,a32,a33,
4420 & dxi,dyi,dzi,dx_normi,dy_normi,dz_normi,xmedi,ymedi,zmedi,
4423 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4425 C Fourth-order contributions
4433 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
4434 cd call checkint_turn4(i,a_temp,eello_turn4_num)
4435 c write (iout,*) "eturn4 i",i," j",j," j1",j1," j2",j2
4436 c write(iout,*)"WCHODZE W PROGRAM"
4441 iti1=itortyp(itype(i+1))
4442 iti2=itortyp(itype(i+2))
4443 iti3=itortyp(itype(i+3))
4444 c write(iout,*) "iti1",iti1," iti2",iti2," iti3",iti3
4445 call transpose2(EUg(1,1,i+1),e1t(1,1))
4446 call transpose2(Eug(1,1,i+2),e2t(1,1))
4447 call transpose2(Eug(1,1,i+3),e3t(1,1))
4448 C Ematrix derivative in theta
4449 call transpose2(gtEUg(1,1,i+1),gte1t(1,1))
4450 call transpose2(gtEug(1,1,i+2),gte2t(1,1))
4451 call transpose2(gtEug(1,1,i+3),gte3t(1,1))
4452 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4453 c eta1 in derivative theta
4454 call matmat2(gte1t(1,1),a_temp(1,1),gte1a(1,1))
4455 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4456 c auxgvec is derivative of Ub2 so i+3 theta
4457 call matvec2(e1a(1,1),gUb2(1,i+3),auxgvec(1))
4458 c auxalary matrix of E i+1
4459 call matvec2(gte1a(1,1),Ub2(1,i+3),auxgEvec1(1))
4462 s1=scalar2(b1(1,i+2),auxvec(1))
4463 c derivative of theta i+2 with constant i+3
4464 gs23=scalar2(gtb1(1,i+2),auxvec(1))
4465 c derivative of theta i+2 with constant i+2
4466 gs32=scalar2(b1(1,i+2),auxgvec(1))
4467 c derivative of E matix in theta of i+1
4468 gsE13=scalar2(b1(1,i+2),auxgEvec1(1))
4470 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4471 c ea31 in derivative theta
4472 call matmat2(a_temp(1,1),gte3t(1,1),gtae3(1,1))
4473 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4474 c auxilary matrix auxgvec of Ub2 with constant E matirx
4475 call matvec2(ae3(1,1),gUb2(1,i+2),auxgvec(1))
4476 c auxilary matrix auxgEvec1 of E matix with Ub2 constant
4477 call matvec2(gtae3(1,1),Ub2(1,i+2),auxgEvec3(1))
4481 s2=scalar2(b1(1,i+1),auxvec(1))
4482 c derivative of theta i+1 with constant i+3
4483 gs13=scalar2(gtb1(1,i+1),auxvec(1))
4484 c derivative of theta i+2 with constant i+1
4485 gs21=scalar2(b1(1,i+1),auxgvec(1))
4486 c derivative of theta i+3 with constant i+1
4487 gsE31=scalar2(b1(1,i+1),auxgEvec3(1))
4488 c write(iout,*) gs1,gs2,'i=',i,auxgvec(1),gUb2(1,i+2),gtb1(1,i+2),
4490 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4491 c two derivatives over diffetent matrices
4492 c gtae3e2 is derivative over i+3
4493 call matmat2(gtae3(1,1),e2t(1,1),gtae3e2(1,1))
4494 c ae3gte2 is derivative over i+2
4495 call matmat2(ae3(1,1),gte2t(1,1),ae3gte2(1,1))
4496 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4497 c three possible derivative over theta E matices
4499 call matmat2(ae3e2(1,1),gte1t(1,1),gtEpizda1(1,1))
4501 call matmat2(ae3gte2(1,1),e1t(1,1),gtEpizda2(1,1))
4503 call matmat2(gtae3e2(1,1),e1t(1,1),gtEpizda3(1,1))
4504 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4506 gsEE1=0.5d0*(gtEpizda1(1,1)+gtEpizda1(2,2))
4507 gsEE2=0.5d0*(gtEpizda2(1,1)+gtEpizda2(2,2))
4508 gsEE3=0.5d0*(gtEpizda3(1,1)+gtEpizda3(2,2))
4510 eello_turn4=eello_turn4-(s1+s2+s3)
4511 c write(iout,*)'chujOWO', auxvec(1),b1(1,iti2)
4512 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,3f7.3)')
4513 & 'eturn4',i,j,-(s1+s2+s3),s1,s2,s3
4514 cd write (2,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4515 cd & ' eello_turn4_num',8*eello_turn4_num
4517 gloc(nphi+i,icg)=gloc(nphi+i,icg)
4518 & -(gs13+gsE13+gsEE1)*wturn4
4519 gloc(nphi+i+1,icg)= gloc(nphi+i+1,icg)
4520 & -(gs23+gs21+gsEE2)*wturn4
4521 gloc(nphi+i+2,icg)= gloc(nphi+i+2,icg)
4522 & -(gs32+gsE31+gsEE3)*wturn4
4523 c gloc(nphi+i+1,icg)=gloc(nphi+i+1,icg)-
4526 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
4527 & 'eturn4',i,j,-(s1+s2+s3)
4528 c write (iout,*) 'i,',i,' j',j,'eello_turn4',-(s1+s2+s3),
4529 c & ' eello_turn4_num',8*eello_turn4_num
4530 C Derivatives in gamma(i)
4531 call transpose2(EUgder(1,1,i+1),e1tder(1,1))
4532 call matmat2(e1tder(1,1),a_temp(1,1),auxmat(1,1))
4533 call matvec2(auxmat(1,1),Ub2(1,i+3),auxvec(1))
4534 s1=scalar2(b1(1,i+2),auxvec(1))
4535 call matmat2(ae3e2(1,1),e1tder(1,1),pizda(1,1))
4536 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4537 gel_loc_turn4(i)=gel_loc_turn4(i)-(s1+s3)
4538 C Derivatives in gamma(i+1)
4539 call transpose2(EUgder(1,1,i+2),e2tder(1,1))
4540 call matvec2(ae3(1,1),Ub2der(1,i+2),auxvec(1))
4541 s2=scalar2(b1(1,i+1),auxvec(1))
4542 call matmat2(ae3(1,1),e2tder(1,1),auxmat(1,1))
4543 call matmat2(auxmat(1,1),e1t(1,1),pizda(1,1))
4544 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4545 gel_loc_turn4(i+1)=gel_loc_turn4(i+1)-(s2+s3)
4546 C Derivatives in gamma(i+2)
4547 call transpose2(EUgder(1,1,i+3),e3tder(1,1))
4548 call matvec2(e1a(1,1),Ub2der(1,i+3),auxvec(1))
4549 s1=scalar2(b1(1,i+2),auxvec(1))
4550 call matmat2(a_temp(1,1),e3tder(1,1),auxmat(1,1))
4551 call matvec2(auxmat(1,1),Ub2(1,i+2),auxvec(1))
4552 s2=scalar2(b1(1,i+1),auxvec(1))
4553 call matmat2(auxmat(1,1),e2t(1,1),auxmat3(1,1))
4554 call matmat2(auxmat3(1,1),e1t(1,1),pizda(1,1))
4555 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4556 gel_loc_turn4(i+2)=gel_loc_turn4(i+2)-(s1+s2+s3)
4557 C Cartesian derivatives
4558 C Derivatives of this turn contributions in DC(i+2)
4559 if (j.lt.nres-1) then
4561 a_temp(1,1)=agg(l,1)
4562 a_temp(1,2)=agg(l,2)
4563 a_temp(2,1)=agg(l,3)
4564 a_temp(2,2)=agg(l,4)
4565 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4566 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4567 s1=scalar2(b1(1,i+2),auxvec(1))
4568 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4569 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4570 s2=scalar2(b1(1,i+1),auxvec(1))
4571 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4572 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4573 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4575 gcorr4_turn(l,i+2)=gcorr4_turn(l,i+2)-(s1+s2+s3)
4578 C Remaining derivatives of this turn contribution
4580 a_temp(1,1)=aggi(l,1)
4581 a_temp(1,2)=aggi(l,2)
4582 a_temp(2,1)=aggi(l,3)
4583 a_temp(2,2)=aggi(l,4)
4584 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4585 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4586 s1=scalar2(b1(1,i+2),auxvec(1))
4587 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4588 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4589 s2=scalar2(b1(1,i+1),auxvec(1))
4590 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4591 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4592 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4593 gcorr4_turn(l,i)=gcorr4_turn(l,i)-(s1+s2+s3)
4594 a_temp(1,1)=aggi1(l,1)
4595 a_temp(1,2)=aggi1(l,2)
4596 a_temp(2,1)=aggi1(l,3)
4597 a_temp(2,2)=aggi1(l,4)
4598 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4599 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4600 s1=scalar2(b1(1,i+2),auxvec(1))
4601 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4602 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4603 s2=scalar2(b1(1,i+1),auxvec(1))
4604 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4605 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4606 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4607 gcorr4_turn(l,i+1)=gcorr4_turn(l,i+1)-(s1+s2+s3)
4608 a_temp(1,1)=aggj(l,1)
4609 a_temp(1,2)=aggj(l,2)
4610 a_temp(2,1)=aggj(l,3)
4611 a_temp(2,2)=aggj(l,4)
4612 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4613 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4614 s1=scalar2(b1(1,i+2),auxvec(1))
4615 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4616 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4617 s2=scalar2(b1(1,i+1),auxvec(1))
4618 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4619 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4620 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4621 gcorr4_turn(l,j)=gcorr4_turn(l,j)-(s1+s2+s3)
4622 a_temp(1,1)=aggj1(l,1)
4623 a_temp(1,2)=aggj1(l,2)
4624 a_temp(2,1)=aggj1(l,3)
4625 a_temp(2,2)=aggj1(l,4)
4626 call matmat2(e1t(1,1),a_temp(1,1),e1a(1,1))
4627 call matvec2(e1a(1,1),Ub2(1,i+3),auxvec(1))
4628 s1=scalar2(b1(1,i+2),auxvec(1))
4629 call matmat2(a_temp(1,1),e3t(1,1),ae3(1,1))
4630 call matvec2(ae3(1,1),Ub2(1,i+2),auxvec(1))
4631 s2=scalar2(b1(1,i+1),auxvec(1))
4632 call matmat2(ae3(1,1),e2t(1,1),ae3e2(1,1))
4633 call matmat2(ae3e2(1,1),e1t(1,1),pizda(1,1))
4634 s3=0.5d0*(pizda(1,1)+pizda(2,2))
4635 c write (iout,*) "s1",s1," s2",s2," s3",s3," s1+s2+s3",s1+s2+s3
4636 gcorr4_turn(l,j1)=gcorr4_turn(l,j1)-(s1+s2+s3)
4640 C-----------------------------------------------------------------------------
4641 subroutine vecpr(u,v,w)
4642 implicit real*8(a-h,o-z)
4643 dimension u(3),v(3),w(3)
4644 w(1)=u(2)*v(3)-u(3)*v(2)
4645 w(2)=-u(1)*v(3)+u(3)*v(1)
4646 w(3)=u(1)*v(2)-u(2)*v(1)
4649 C-----------------------------------------------------------------------------
4650 subroutine unormderiv(u,ugrad,unorm,ungrad)
4651 C This subroutine computes the derivatives of a normalized vector u, given
4652 C the derivatives computed without normalization conditions, ugrad. Returns
4655 double precision u(3),ugrad(3,3),unorm,ungrad(3,3)
4656 double precision vec(3)
4657 double precision scalar
4659 c write (2,*) 'ugrad',ugrad
4662 vec(i)=scalar(ugrad(1,i),u(1))
4664 c write (2,*) 'vec',vec
4667 ungrad(j,i)=(ugrad(j,i)-u(j)*vec(i))*unorm
4670 c write (2,*) 'ungrad',ungrad
4673 C-----------------------------------------------------------------------------
4674 subroutine escp_soft_sphere(evdw2,evdw2_14)
4676 C This subroutine calculates the excluded-volume interaction energy between
4677 C peptide-group centers and side chains and its gradient in virtual-bond and
4678 C side-chain vectors.
4680 implicit real*8 (a-h,o-z)
4681 include 'DIMENSIONS'
4682 include 'COMMON.GEO'
4683 include 'COMMON.VAR'
4684 include 'COMMON.LOCAL'
4685 include 'COMMON.CHAIN'
4686 include 'COMMON.DERIV'
4687 include 'COMMON.INTERACT'
4688 include 'COMMON.FFIELD'
4689 include 'COMMON.IOUNITS'
4690 include 'COMMON.CONTROL'
4695 cd print '(a)','Enter ESCP'
4696 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4700 do i=iatscp_s,iatscp_e
4701 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4703 xi=0.5D0*(c(1,i)+c(1,i+1))
4704 yi=0.5D0*(c(2,i)+c(2,i+1))
4705 zi=0.5D0*(c(3,i)+c(3,i+1))
4706 C Return atom into box, boxxsize is size of box in x dimension
4708 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4709 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4710 C Condition for being inside the proper box
4711 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4712 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4716 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4717 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4718 C Condition for being inside the proper box
4719 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4720 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4724 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4725 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4726 cC Condition for being inside the proper box
4727 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4728 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4732 if (xi.lt.0) xi=xi+boxxsize
4734 if (yi.lt.0) yi=yi+boxysize
4736 if (zi.lt.0) zi=zi+boxzsize
4737 C xi=xi+xshift*boxxsize
4738 C yi=yi+yshift*boxysize
4739 C zi=zi+zshift*boxzsize
4740 do iint=1,nscp_gr(i)
4742 do j=iscpstart(i,iint),iscpend(i,iint)
4743 if (itype(j).eq.ntyp1) cycle
4744 itypj=iabs(itype(j))
4745 C Uncomment following three lines for SC-p interactions
4749 C Uncomment following three lines for Ca-p interactions
4754 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4755 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4756 C Condition for being inside the proper box
4757 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4758 c & (xj.lt.((-0.5d0)*boxxsize))) then
4762 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4763 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4764 cC Condition for being inside the proper box
4765 c if ((yj.gt.((0.5d0)*boxysize)).or.
4766 c & (yj.lt.((-0.5d0)*boxysize))) then
4770 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4771 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4772 C Condition for being inside the proper box
4773 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4774 c & (zj.lt.((-0.5d0)*boxzsize))) then
4777 if (xj.lt.0) xj=xj+boxxsize
4779 if (yj.lt.0) yj=yj+boxysize
4781 if (zj.lt.0) zj=zj+boxzsize
4782 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4790 xj=xj_safe+xshift*boxxsize
4791 yj=yj_safe+yshift*boxysize
4792 zj=zj_safe+zshift*boxzsize
4793 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4794 if(dist_temp.lt.dist_init) then
4804 if (subchap.eq.1) then
4817 rij=xj*xj+yj*yj+zj*zj
4821 if (rij.lt.r0ijsq) then
4822 evdwij=0.25d0*(rij-r0ijsq)**2
4830 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
4835 cgrad if (j.lt.i) then
4836 cd write (iout,*) 'j<i'
4837 C Uncomment following three lines for SC-p interactions
4839 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
4842 cd write (iout,*) 'j>i'
4844 cgrad ggg(k)=-ggg(k)
4845 C Uncomment following line for SC-p interactions
4846 c gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
4850 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
4852 cgrad kstart=min0(i+1,j)
4853 cgrad kend=max0(i-1,j-1)
4854 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
4855 cd write (iout,*) ggg(1),ggg(2),ggg(3)
4856 cgrad do k=kstart,kend
4858 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
4862 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
4863 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
4874 C-----------------------------------------------------------------------------
4875 subroutine escp(evdw2,evdw2_14)
4877 C This subroutine calculates the excluded-volume interaction energy between
4878 C peptide-group centers and side chains and its gradient in virtual-bond and
4879 C side-chain vectors.
4881 implicit real*8 (a-h,o-z)
4882 include 'DIMENSIONS'
4883 include 'COMMON.GEO'
4884 include 'COMMON.VAR'
4885 include 'COMMON.LOCAL'
4886 include 'COMMON.CHAIN'
4887 include 'COMMON.DERIV'
4888 include 'COMMON.INTERACT'
4889 include 'COMMON.FFIELD'
4890 include 'COMMON.IOUNITS'
4891 include 'COMMON.CONTROL'
4892 include 'COMMON.SPLITELE'
4896 c print *,boxxsize,boxysize,boxzsize,'wymiary pudla'
4897 cd print '(a)','Enter ESCP'
4898 cd write (iout,*) 'iatscp_s=',iatscp_s,' iatscp_e=',iatscp_e
4902 do i=iatscp_s,iatscp_e
4903 if (itype(i).eq.ntyp1 .or. itype(i+1).eq.ntyp1) cycle
4905 xi=0.5D0*(c(1,i)+c(1,i+1))
4906 yi=0.5D0*(c(2,i)+c(2,i+1))
4907 zi=0.5D0*(c(3,i)+c(3,i+1))
4909 if (xi.lt.0) xi=xi+boxxsize
4911 if (yi.lt.0) yi=yi+boxysize
4913 if (zi.lt.0) zi=zi+boxzsize
4914 c xi=xi+xshift*boxxsize
4915 c yi=yi+yshift*boxysize
4916 c zi=zi+zshift*boxzsize
4917 c print *,xi,yi,zi,'polozenie i'
4918 C Return atom into box, boxxsize is size of box in x dimension
4920 c if (xi.gt.((xshift+0.5d0)*boxxsize)) xi=xi-boxxsize
4921 c if (xi.lt.((xshift-0.5d0)*boxxsize)) xi=xi+boxxsize
4922 C Condition for being inside the proper box
4923 c if ((xi.gt.((xshift+0.5d0)*boxxsize)).or.
4924 c & (xi.lt.((xshift-0.5d0)*boxxsize))) then
4928 c print *,xi,boxxsize,"pierwszy"
4930 c if (yi.gt.((yshift+0.5d0)*boxysize)) yi=yi-boxysize
4931 c if (yi.lt.((yshift-0.5d0)*boxysize)) yi=yi+boxysize
4932 C Condition for being inside the proper box
4933 c if ((yi.gt.((yshift+0.5d0)*boxysize)).or.
4934 c & (yi.lt.((yshift-0.5d0)*boxysize))) then
4938 c if (zi.gt.((zshift+0.5d0)*boxzsize)) zi=zi-boxzsize
4939 c if (zi.lt.((zshift-0.5d0)*boxzsize)) zi=zi+boxzsize
4940 C Condition for being inside the proper box
4941 c if ((zi.gt.((zshift+0.5d0)*boxzsize)).or.
4942 c & (zi.lt.((zshift-0.5d0)*boxzsize))) then
4945 do iint=1,nscp_gr(i)
4947 do j=iscpstart(i,iint),iscpend(i,iint)
4948 itypj=iabs(itype(j))
4949 if (itypj.eq.ntyp1) cycle
4950 C Uncomment following three lines for SC-p interactions
4954 C Uncomment following three lines for Ca-p interactions
4959 if (xj.lt.0) xj=xj+boxxsize
4961 if (yj.lt.0) yj=yj+boxysize
4963 if (zj.lt.0) zj=zj+boxzsize
4965 c if (xj.gt.((0.5d0)*boxxsize)) xj=xj-boxxsize
4966 c if (xj.lt.((-0.5d0)*boxxsize)) xj=xj+boxxsize
4967 C Condition for being inside the proper box
4968 c if ((xj.gt.((0.5d0)*boxxsize)).or.
4969 c & (xj.lt.((-0.5d0)*boxxsize))) then
4973 c if (yj.gt.((0.5d0)*boxysize)) yj=yj-boxysize
4974 c if (yj.lt.((-0.5d0)*boxysize)) yj=yj+boxysize
4975 cC Condition for being inside the proper box
4976 c if ((yj.gt.((0.5d0)*boxysize)).or.
4977 c & (yj.lt.((-0.5d0)*boxysize))) then
4981 c if (zj.gt.((0.5d0)*boxzsize)) zj=zj-boxzsize
4982 c if (zj.lt.((-0.5d0)*boxzsize)) zj=zj+boxzsize
4983 C Condition for being inside the proper box
4984 c if ((zj.gt.((0.5d0)*boxzsize)).or.
4985 c & (zj.lt.((-0.5d0)*boxzsize))) then
4988 CHERE IS THE CALCULATION WHICH MIRROR IMAGE IS THE CLOSEST ONE
4989 dist_init=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
4997 xj=xj_safe+xshift*boxxsize
4998 yj=yj_safe+yshift*boxysize
4999 zj=zj_safe+zshift*boxzsize
5000 dist_temp=(xj-xi)**2+(yj-yi)**2+(zj-zi)**2
5001 if(dist_temp.lt.dist_init) then
5011 if (subchap.eq.1) then
5020 c print *,xj,yj,zj,'polozenie j'
5021 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5023 sss=sscale(1.0d0/(dsqrt(rrij)))
5024 c print *,r_cut,1.0d0/dsqrt(rrij),sss,'tu patrz'
5025 c if (sss.eq.0) print *,'czasem jest OK'
5026 if (sss.le.0.0d0) cycle
5027 sssgrad=sscagrad(1.0d0/(dsqrt(rrij)))
5029 e1=fac*fac*aad(itypj,iteli)
5030 e2=fac*bad(itypj,iteli)
5031 if (iabs(j-i) .le. 2) then
5034 evdw2_14=evdw2_14+(e1+e2)*sss
5037 evdw2=evdw2+evdwij*sss
5038 if (energy_dec) write (iout,'(a6,2i5,0pf7.3,2i3,3e11.3)')
5039 & 'evdw2',i,j,evdwij,iteli,itypj,fac,aad(itypj,iteli),
5042 C Calculate contributions to the gradient in the virtual-bond and SC vectors.
5044 fac=-(evdwij+e1)*rrij*sss
5045 fac=fac+(evdwij)*sssgrad*dsqrt(rrij)/expon
5049 cgrad if (j.lt.i) then
5050 cd write (iout,*) 'j<i'
5051 C Uncomment following three lines for SC-p interactions
5053 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5056 cd write (iout,*) 'j>i'
5058 cgrad ggg(k)=-ggg(k)
5059 C Uncomment following line for SC-p interactions
5060 ccgrad gradx_scp(k,j)=gradx_scp(k,j)-ggg(k)
5061 c gradx_scp(k,j)=gradx_scp(k,j)+ggg(k)
5065 cgrad gvdwc_scp(k,i)=gvdwc_scp(k,i)-0.5D0*ggg(k)
5067 cgrad kstart=min0(i+1,j)
5068 cgrad kend=max0(i-1,j-1)
5069 cd write (iout,*) 'i=',i,' j=',j,' kstart=',kstart,' kend=',kend
5070 cd write (iout,*) ggg(1),ggg(2),ggg(3)
5071 cgrad do k=kstart,kend
5073 cgrad gvdwc_scp(l,k)=gvdwc_scp(l,k)-ggg(l)
5077 gvdwc_scpp(k,i)=gvdwc_scpp(k,i)-ggg(k)
5078 gvdwc_scp(k,j)=gvdwc_scp(k,j)+ggg(k)
5080 c endif !endif for sscale cutoff
5090 gvdwc_scp(j,i)=expon*gvdwc_scp(j,i)
5091 gvdwc_scpp(j,i)=expon*gvdwc_scpp(j,i)
5092 gradx_scp(j,i)=expon*gradx_scp(j,i)
5095 C******************************************************************************
5099 C To save time the factor EXPON has been extracted from ALL components
5100 C of GVDWC and GRADX. Remember to multiply them by this factor before further
5103 C******************************************************************************
5106 C--------------------------------------------------------------------------
5107 subroutine edis(ehpb)
5109 C Evaluate bridge-strain energy and its gradient in virtual-bond and SC vectors.
5111 implicit real*8 (a-h,o-z)
5112 include 'DIMENSIONS'
5113 include 'COMMON.SBRIDGE'
5114 include 'COMMON.CHAIN'
5115 include 'COMMON.DERIV'
5116 include 'COMMON.VAR'
5117 include 'COMMON.INTERACT'
5118 include 'COMMON.IOUNITS'
5121 cd write(iout,*)'edis: nhpb=',nhpb,' fbr=',fbr
5122 cd write(iout,*)'link_start=',link_start,' link_end=',link_end
5123 if (link_end.eq.0) return
5124 do i=link_start,link_end
5125 C If ihpb(i) and jhpb(i) > NRES, this is a SC-SC distance, otherwise a
5126 C CA-CA distance used in regularization of structure.
5129 C iii and jjj point to the residues for which the distance is assigned.
5130 if (ii.gt.nres) then
5137 c write (iout,*) "i",i," ii",ii," iii",iii," jj",jj," jjj",jjj,
5138 c & dhpb(i),dhpb1(i),forcon(i)
5139 C 24/11/03 AL: SS bridges handled separately because of introducing a specific
5140 C distance and angle dependent SS bond potential.
5141 C if (ii.gt.nres .and. iabs(itype(iii)).eq.1 .and.
5142 C & iabs(itype(jjj)).eq.1) then
5143 cmc if (ii.gt.nres .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5144 C 18/07/06 MC: Use the convention that the first nss pairs are SS bonds
5145 if (.not.dyn_ss .and. i.le.nss) then
5146 C 15/02/13 CC dynamic SSbond - additional check
5148 & .and. itype(iii).eq.1 .and. itype(jjj).eq.1) then
5149 call ssbond_ene(iii,jjj,eij)
5152 cd write (iout,*) "eij",eij
5154 C Calculate the distance between the two points and its difference from the
5158 C Get the force constant corresponding to this distance.
5160 C Calculate the contribution to energy.
5161 ehpb=ehpb+waga*rdis*rdis
5163 C Evaluate gradient.
5166 cd print *,'i=',i,' ii=',ii,' jj=',jj,' dhpb=',dhpb(i),' dd=',dd,
5167 cd & ' waga=',waga,' fac=',fac
5169 ggg(j)=fac*(c(j,jj)-c(j,ii))
5171 cd print '(i3,3(1pe14.5))',i,(ggg(j),j=1,3)
5172 C If this is a SC-SC distance, we need to calculate the contributions to the
5173 C Cartesian gradient in the SC vectors (ghpbx).
5176 ghpbx(j,iii)=ghpbx(j,iii)-ggg(j)
5177 ghpbx(j,jjj)=ghpbx(j,jjj)+ggg(j)
5180 cgrad do j=iii,jjj-1
5182 cgrad ghpbc(k,j)=ghpbc(k,j)+ggg(k)
5186 ghpbc(k,jjj)=ghpbc(k,jjj)+ggg(k)
5187 ghpbc(k,iii)=ghpbc(k,iii)-ggg(k)
5194 C--------------------------------------------------------------------------
5195 subroutine ssbond_ene(i,j,eij)
5197 C Calculate the distance and angle dependent SS-bond potential energy
5198 C using a free-energy function derived based on RHF/6-31G** ab initio
5199 C calculations of diethyl disulfide.
5201 C A. Liwo and U. Kozlowska, 11/24/03
5203 implicit real*8 (a-h,o-z)
5204 include 'DIMENSIONS'
5205 include 'COMMON.SBRIDGE'
5206 include 'COMMON.CHAIN'
5207 include 'COMMON.DERIV'
5208 include 'COMMON.LOCAL'
5209 include 'COMMON.INTERACT'
5210 include 'COMMON.VAR'
5211 include 'COMMON.IOUNITS'
5212 double precision erij(3),dcosom1(3),dcosom2(3),gg(3)
5213 itypi=iabs(itype(i))
5217 dxi=dc_norm(1,nres+i)
5218 dyi=dc_norm(2,nres+i)
5219 dzi=dc_norm(3,nres+i)
5220 c dsci_inv=dsc_inv(itypi)
5221 dsci_inv=vbld_inv(nres+i)
5222 itypj=iabs(itype(j))
5223 c dscj_inv=dsc_inv(itypj)
5224 dscj_inv=vbld_inv(nres+j)
5228 dxj=dc_norm(1,nres+j)
5229 dyj=dc_norm(2,nres+j)
5230 dzj=dc_norm(3,nres+j)
5231 rrij=1.0D0/(xj*xj+yj*yj+zj*zj)
5236 om1=dxi*erij(1)+dyi*erij(2)+dzi*erij(3)
5237 om2=dxj*erij(1)+dyj*erij(2)+dzj*erij(3)
5238 om12=dxi*dxj+dyi*dyj+dzi*dzj
5240 dcosom1(k)=rij*(dc_norm(k,nres+i)-om1*erij(k))
5241 dcosom2(k)=rij*(dc_norm(k,nres+j)-om2*erij(k))
5247 deltat12=om2-om1+2.0d0
5249 eij=akcm*deltad*deltad+akth*(deltat1*deltat1+deltat2*deltat2)
5250 & +akct*deltad*deltat12
5251 & +v1ss*cosphi+v2ss*cosphi*cosphi+v3ss*cosphi*cosphi*cosphi+ebr
5252 c write(iout,*) i,j,"rij",rij,"d0cm",d0cm," akcm",akcm," akth",akth,
5253 c & " akct",akct," deltad",deltad," deltat",deltat1,deltat2,
5254 c & " deltat12",deltat12," eij",eij
5255 ed=2*akcm*deltad+akct*deltat12
5257 pom2=v1ss+2*v2ss*cosphi+3*v3ss*cosphi*cosphi
5258 eom1=-2*akth*deltat1-pom1-om2*pom2
5259 eom2= 2*akth*deltat2+pom1-om1*pom2
5262 ggk=ed*erij(k)+eom1*dcosom1(k)+eom2*dcosom2(k)
5263 ghpbx(k,i)=ghpbx(k,i)-ggk
5264 & +(eom12*(dc_norm(k,nres+j)-om12*dc_norm(k,nres+i))
5265 & +eom1*(erij(k)-om1*dc_norm(k,nres+i)))*dsci_inv
5266 ghpbx(k,j)=ghpbx(k,j)+ggk
5267 & +(eom12*(dc_norm(k,nres+i)-om12*dc_norm(k,nres+j))
5268 & +eom2*(erij(k)-om2*dc_norm(k,nres+j)))*dscj_inv
5269 ghpbc(k,i)=ghpbc(k,i)-ggk
5270 ghpbc(k,j)=ghpbc(k,j)+ggk
5273 C Calculate the components of the gradient in DC and X
5277 cgrad ghpbc(l,k)=ghpbc(l,k)+gg(l)
5282 C--------------------------------------------------------------------------
5283 subroutine ebond(estr)
5285 c Evaluate the energy of stretching of the CA-CA and CA-SC virtual bonds
5287 implicit real*8 (a-h,o-z)
5288 include 'DIMENSIONS'
5289 include 'COMMON.LOCAL'
5290 include 'COMMON.GEO'
5291 include 'COMMON.INTERACT'
5292 include 'COMMON.DERIV'
5293 include 'COMMON.VAR'
5294 include 'COMMON.CHAIN'
5295 include 'COMMON.IOUNITS'
5296 include 'COMMON.NAMES'
5297 include 'COMMON.FFIELD'
5298 include 'COMMON.CONTROL'
5299 include 'COMMON.SETUP'
5300 double precision u(3),ud(3)
5303 do i=ibondp_start,ibondp_end
5304 if (itype(i-1).eq.ntyp1 .and. itype(i).eq.ntyp1) cycle
5305 c estr1=estr1+gnmr1(vbld(i),-1.0d0,distchainmax)
5307 c gradb(j,i-1)=gnmr1prim(vbld(i),-1.0d0,distchainmax)
5308 c & *dc(j,i-1)/vbld(i)
5310 c if (energy_dec) write(iout,*)
5311 c & "estr1",i,gnmr1(vbld(i),-1.0d0,distchainmax)
5313 C Checking if it involves dummy (NH3+ or COO-) group
5314 if (itype(i-1).eq.ntyp1 .or. itype(i).eq.ntyp1) then
5315 C YES vbldpDUM is the equlibrium length of spring for Dummy atom
5316 diff = vbld(i)-vbldpDUM
5318 C NO vbldp0 is the equlibrium lenght of spring for peptide group
5319 diff = vbld(i)-vbldp0
5321 if (energy_dec) write (iout,'(a7,i5,4f7.3)')
5322 & "estr bb",i,vbld(i),vbldp0,diff,AKP*diff*diff
5325 gradb(j,i-1)=AKP*diff*dc(j,i-1)/vbld(i)
5327 c write (iout,'(i5,3f10.5)') i,(gradb(j,i-1),j=1,3)
5330 estr=0.5d0*AKP*estr+estr1
5332 c 09/18/07 AL: multimodal bond potential based on AM1 CA-SC PMF's included
5334 do i=ibond_start,ibond_end
5336 if (iti.ne.10 .and. iti.ne.ntyp1) then
5339 diff=vbld(i+nres)-vbldsc0(1,iti)
5340 if (energy_dec) write (iout,*)
5341 & "estr sc",i,iti,vbld(i+nres),vbldsc0(1,iti),diff,
5342 & AKSC(1,iti),AKSC(1,iti)*diff*diff
5343 estr=estr+0.5d0*AKSC(1,iti)*diff*diff
5345 gradbx(j,i)=AKSC(1,iti)*diff*dc(j,i+nres)/vbld(i+nres)
5349 diff=vbld(i+nres)-vbldsc0(j,iti)
5350 ud(j)=aksc(j,iti)*diff
5351 u(j)=abond0(j,iti)+0.5d0*ud(j)*diff
5365 uprod2=uprod2*u(k)*u(k)
5369 usumsqder=usumsqder+ud(j)*uprod2
5371 estr=estr+uprod/usum
5373 gradbx(j,i)=usumsqder/(usum*usum)*dc(j,i+nres)/vbld(i+nres)
5381 C--------------------------------------------------------------------------
5382 subroutine ebend(etheta)
5384 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5385 C angles gamma and its derivatives in consecutive thetas and gammas.
5387 implicit real*8 (a-h,o-z)
5388 include 'DIMENSIONS'
5389 include 'COMMON.LOCAL'
5390 include 'COMMON.GEO'
5391 include 'COMMON.INTERACT'
5392 include 'COMMON.DERIV'
5393 include 'COMMON.VAR'
5394 include 'COMMON.CHAIN'
5395 include 'COMMON.IOUNITS'
5396 include 'COMMON.NAMES'
5397 include 'COMMON.FFIELD'
5398 include 'COMMON.CONTROL'
5399 common /calcthet/ term1,term2,termm,diffak,ratak,
5400 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5401 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5402 double precision y(2),z(2)
5404 c time11=dexp(-2*time)
5407 c write (*,'(a,i2)') 'EBEND ICG=',icg
5408 do i=ithet_start,ithet_end
5409 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5410 & .or.itype(i).eq.ntyp1) cycle
5411 C Zero the energy function and its derivative at 0 or pi.
5412 call splinthet(theta(i),0.5d0*delta,ss,ssd)
5414 ichir1=isign(1,itype(i-2))
5415 ichir2=isign(1,itype(i))
5416 if (itype(i-2).eq.10) ichir1=isign(1,itype(i-1))
5417 if (itype(i).eq.10) ichir2=isign(1,itype(i-1))
5418 if (itype(i-1).eq.10) then
5419 itype1=isign(10,itype(i-2))
5420 ichir11=isign(1,itype(i-2))
5421 ichir12=isign(1,itype(i-2))
5422 itype2=isign(10,itype(i))
5423 ichir21=isign(1,itype(i))
5424 ichir22=isign(1,itype(i))
5427 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5430 if (phii.ne.phii) phii=150.0
5440 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5443 if (phii1.ne.phii1) phii1=150.0
5455 C Calculate the "mean" value of theta from the part of the distribution
5456 C dependent on the adjacent virtual-bond-valence angles (gamma1 & gamma2).
5457 C In following comments this theta will be referred to as t_c.
5458 thet_pred_mean=0.0d0
5460 athetk=athet(k,it,ichir1,ichir2)
5461 bthetk=bthet(k,it,ichir1,ichir2)
5463 athetk=athet(k,itype1,ichir11,ichir12)
5464 bthetk=bthet(k,itype2,ichir21,ichir22)
5466 thet_pred_mean=thet_pred_mean+athetk*y(k)+bthetk*z(k)
5467 c write(iout,*) 'chuj tu', y(k),z(k)
5469 dthett=thet_pred_mean*ssd
5470 thet_pred_mean=thet_pred_mean*ss+a0thet(it)
5471 C Derivatives of the "mean" values in gamma1 and gamma2.
5472 dthetg1=(-athet(1,it,ichir1,ichir2)*y(2)
5473 &+athet(2,it,ichir1,ichir2)*y(1))*ss
5474 dthetg2=(-bthet(1,it,ichir1,ichir2)*z(2)
5475 & +bthet(2,it,ichir1,ichir2)*z(1))*ss
5477 dthetg1=(-athet(1,itype1,ichir11,ichir12)*y(2)
5478 &+athet(2,itype1,ichir11,ichir12)*y(1))*ss
5479 dthetg2=(-bthet(1,itype2,ichir21,ichir22)*z(2)
5480 & +bthet(2,itype2,ichir21,ichir22)*z(1))*ss
5482 if (theta(i).gt.pi-delta) then
5483 call theteng(pi-delta,thet_pred_mean,theta0(it),f0,fprim0,
5485 call mixder(pi-delta,thet_pred_mean,theta0(it),fprim_tc0)
5486 call theteng(pi,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5487 call spline1(theta(i),pi-delta,delta,f0,f1,fprim0,ethetai,
5489 call spline2(theta(i),pi-delta,delta,E_tc0,E_tc1,fprim_tc0,
5491 else if (theta(i).lt.delta) then
5492 call theteng(delta,thet_pred_mean,theta0(it),f0,fprim0,E_tc0)
5493 call theteng(0.0d0,thet_pred_mean,theta0(it),f1,fprim1,E_tc1)
5494 call spline1(theta(i),delta,-delta,f0,f1,fprim0,ethetai,
5496 call mixder(delta,thet_pred_mean,theta0(it),fprim_tc0)
5497 call spline2(theta(i),delta,-delta,E_tc0,E_tc1,fprim_tc0,
5500 call theteng(theta(i),thet_pred_mean,theta0(it),ethetai,
5503 etheta=etheta+ethetai
5504 if (energy_dec) write (iout,'(a6,i5,0pf7.3,f7.3,i5)')
5505 & 'ebend',i,ethetai,theta(i),itype(i)
5506 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*E_tc*dthetg1
5507 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*E_tc*dthetg2
5508 gloc(nphi+i-2,icg)=wang*(E_theta+E_tc*dthett)+gloc(nphi+i-2,icg)
5510 C Ufff.... We've done all this!!!
5513 C---------------------------------------------------------------------------
5514 subroutine theteng(thetai,thet_pred_mean,theta0i,ethetai,E_theta,
5516 implicit real*8 (a-h,o-z)
5517 include 'DIMENSIONS'
5518 include 'COMMON.LOCAL'
5519 include 'COMMON.IOUNITS'
5520 common /calcthet/ term1,term2,termm,diffak,ratak,
5521 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5522 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5523 C Calculate the contributions to both Gaussian lobes.
5524 C 6/6/97 - Deform the Gaussians using the factor of 1/(1+time)
5525 C The "polynomial part" of the "standard deviation" of this part of
5526 C the distributioni.
5527 ccc write (iout,*) thetai,thet_pred_mean
5530 sig=sig*thet_pred_mean+polthet(j,it)
5532 C Derivative of the "interior part" of the "standard deviation of the"
5533 C gamma-dependent Gaussian lobe in t_c.
5534 sigtc=3*polthet(3,it)
5536 sigtc=sigtc*thet_pred_mean+j*polthet(j,it)
5539 C Set the parameters of both Gaussian lobes of the distribution.
5540 C "Standard deviation" of the gamma-dependent Gaussian lobe (sigtc)
5541 fac=sig*sig+sigc0(it)
5544 C Following variable (sigsqtc) is -(1/2)d[sigma(t_c)**(-2))]/dt_c
5545 sigsqtc=-4.0D0*sigcsq*sigtc
5546 c print *,i,sig,sigtc,sigsqtc
5547 C Following variable (sigtc) is d[sigma(t_c)]/dt_c
5548 sigtc=-sigtc/(fac*fac)
5549 C Following variable is sigma(t_c)**(-2)
5550 sigcsq=sigcsq*sigcsq
5552 sig0inv=1.0D0/sig0i**2
5553 delthec=thetai-thet_pred_mean
5554 delthe0=thetai-theta0i
5555 term1=-0.5D0*sigcsq*delthec*delthec
5556 term2=-0.5D0*sig0inv*delthe0*delthe0
5557 C write (iout,*)'term1',term1,term2,sigcsq,delthec,sig0inv,delthe0
5558 C Following fuzzy logic is to avoid underflows in dexp and subsequent INFs and
5559 C NaNs in taking the logarithm. We extract the largest exponent which is added
5560 C to the energy (this being the log of the distribution) at the end of energy
5561 C term evaluation for this virtual-bond angle.
5562 if (term1.gt.term2) then
5564 term2=dexp(term2-termm)
5568 term1=dexp(term1-termm)
5571 C The ratio between the gamma-independent and gamma-dependent lobes of
5572 C the distribution is a Gaussian function of thet_pred_mean too.
5573 diffak=gthet(2,it)-thet_pred_mean
5574 ratak=diffak/gthet(3,it)**2
5575 ak=dexp(gthet(1,it)-0.5D0*diffak*ratak)
5576 C Let's differentiate it in thet_pred_mean NOW.
5578 C Now put together the distribution terms to make complete distribution.
5579 termexp=term1+ak*term2
5580 termpre=sigc+ak*sig0i
5581 C Contribution of the bending energy from this theta is just the -log of
5582 C the sum of the contributions from the two lobes and the pre-exponential
5583 C factor. Simple enough, isn't it?
5584 ethetai=(-dlog(termexp)-termm+dlog(termpre))
5585 C write (iout,*) 'termexp',termexp,termm,termpre,i
5586 C NOW the derivatives!!!
5587 C 6/6/97 Take into account the deformation.
5588 E_theta=(delthec*sigcsq*term1
5589 & +ak*delthe0*sig0inv*term2)/termexp
5590 E_tc=((sigtc+aktc*sig0i)/termpre
5591 & -((delthec*sigcsq+delthec*delthec*sigsqtc)*term1+
5592 & aktc*term2)/termexp)
5595 c-----------------------------------------------------------------------------
5596 subroutine mixder(thetai,thet_pred_mean,theta0i,E_tc_t)
5597 implicit real*8 (a-h,o-z)
5598 include 'DIMENSIONS'
5599 include 'COMMON.LOCAL'
5600 include 'COMMON.IOUNITS'
5601 common /calcthet/ term1,term2,termm,diffak,ratak,
5602 & ak,aktc,termpre,termexp,sigc,sig0i,time11,time12,sigcsq,
5603 & delthe0,sig0inv,sigtc,sigsqtc,delthec,it
5604 delthec=thetai-thet_pred_mean
5605 delthe0=thetai-theta0i
5606 C "Thank you" to MAPLE (probably spared one day of hand-differentiation).
5607 t3 = thetai-thet_pred_mean
5611 t14 = t12+t6*sigsqtc
5613 t21 = thetai-theta0i
5619 E_tc_t = -((sigcsq+2.D0*t3*sigsqtc)*t9-t14*sigcsq*t3*t16*t9
5620 & -aktc*sig0inv*t27)/t32+(t14*t9+aktc*t26)/t40
5621 & *(-t12*t9-ak*sig0inv*t27)
5625 C--------------------------------------------------------------------------
5626 subroutine ebend(etheta)
5628 C Evaluate the virtual-bond-angle energy given the virtual-bond dihedral
5629 C angles gamma and its derivatives in consecutive thetas and gammas.
5630 C ab initio-derived potentials from
5631 c Kozlowska et al., J. Phys.: Condens. Matter 19 (2007) 285203
5633 implicit real*8 (a-h,o-z)
5634 include 'DIMENSIONS'
5635 include 'COMMON.LOCAL'
5636 include 'COMMON.GEO'
5637 include 'COMMON.INTERACT'
5638 include 'COMMON.DERIV'
5639 include 'COMMON.VAR'
5640 include 'COMMON.CHAIN'
5641 include 'COMMON.IOUNITS'
5642 include 'COMMON.NAMES'
5643 include 'COMMON.FFIELD'
5644 include 'COMMON.CONTROL'
5645 double precision coskt(mmaxtheterm),sinkt(mmaxtheterm),
5646 & cosph1(maxsingle),sinph1(maxsingle),cosph2(maxsingle),
5647 & sinph2(maxsingle),cosph1ph2(maxdouble,maxdouble),
5648 & sinph1ph2(maxdouble,maxdouble)
5649 logical lprn /.false./, lprn1 /.false./
5651 do i=ithet_start,ithet_end
5652 c print *,i,itype(i-1),itype(i),itype(i-2)
5653 if ((itype(i-1).eq.ntyp1).or.itype(i-2).eq.ntyp1
5654 & .or.itype(i).eq.ntyp1) cycle
5655 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
5657 if (iabs(itype(i+1)).eq.20) iblock=2
5658 if (iabs(itype(i+1)).ne.20) iblock=1
5662 theti2=0.5d0*theta(i)
5663 ityp2=ithetyp((itype(i-1)))
5665 coskt(k)=dcos(k*theti2)
5666 sinkt(k)=dsin(k*theti2)
5668 if (i.gt.3 .and. itype(i-3).ne.ntyp1) then
5671 if (phii.ne.phii) phii=150.0
5675 ityp1=ithetyp((itype(i-2)))
5676 C propagation of chirality for glycine type
5678 cosph1(k)=dcos(k*phii)
5679 sinph1(k)=dsin(k*phii)
5689 if (i.lt.nres .and. itype(i+1).ne.ntyp1) then
5692 if (phii1.ne.phii1) phii1=150.0
5697 ityp3=ithetyp((itype(i)))
5699 cosph2(k)=dcos(k*phii1)
5700 sinph2(k)=dsin(k*phii1)
5710 ethetai=aa0thet(ityp1,ityp2,ityp3,iblock)
5713 ccl=cosph1(l)*cosph2(k-l)
5714 ssl=sinph1(l)*sinph2(k-l)
5715 scl=sinph1(l)*cosph2(k-l)
5716 csl=cosph1(l)*sinph2(k-l)
5717 cosph1ph2(l,k)=ccl-ssl
5718 cosph1ph2(k,l)=ccl+ssl
5719 sinph1ph2(l,k)=scl+csl
5720 sinph1ph2(k,l)=scl-csl
5724 write (iout,*) "i",i," ityp1",ityp1," ityp2",ityp2,
5725 & " ityp3",ityp3," theti2",theti2," phii",phii," phii1",phii1
5726 write (iout,*) "coskt and sinkt"
5728 write (iout,*) k,coskt(k),sinkt(k)
5732 ethetai=ethetai+aathet(k,ityp1,ityp2,ityp3,iblock)*sinkt(k)
5733 dethetai=dethetai+0.5d0*k*aathet(k,ityp1,ityp2,ityp3,iblock)
5736 & write (iout,*) "k",k,"
5737 & aathet",aathet(k,ityp1,ityp2,ityp3,iblock),
5738 & " ethetai",ethetai
5741 write (iout,*) "cosph and sinph"
5743 write (iout,*) k,cosph1(k),sinph1(k),cosph2(k),sinph2(k)
5745 write (iout,*) "cosph1ph2 and sinph2ph2"
5748 write (iout,*) l,k,cosph1ph2(l,k),cosph1ph2(k,l),
5749 & sinph1ph2(l,k),sinph1ph2(k,l)
5752 write(iout,*) "ethetai",ethetai
5756 aux=bbthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)
5757 & +ccthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k)
5758 & +ddthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)
5759 & +eethet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k)
5760 ethetai=ethetai+sinkt(m)*aux
5761 dethetai=dethetai+0.5d0*m*aux*coskt(m)
5762 dephii=dephii+k*sinkt(m)*(
5763 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)*cosph1(k)-
5764 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph1(k))
5765 dephii1=dephii1+k*sinkt(m)*(
5766 & eethet(k,m,ityp1,ityp2,ityp3,iblock)*cosph2(k)-
5767 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)*sinph2(k))
5769 & write (iout,*) "m",m," k",k," bbthet",
5770 & bbthet(k,m,ityp1,ityp2,ityp3,iblock)," ccthet",
5771 & ccthet(k,m,ityp1,ityp2,ityp3,iblock)," ddthet",
5772 & ddthet(k,m,ityp1,ityp2,ityp3,iblock)," eethet",
5773 & eethet(k,m,ityp1,ityp2,ityp3,iblock)," ethetai",ethetai
5777 & write(iout,*) "ethetai",ethetai
5781 aux=ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5782 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l)+
5783 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5784 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)
5785 ethetai=ethetai+sinkt(m)*aux
5786 dethetai=dethetai+0.5d0*m*coskt(m)*aux
5787 dephii=dephii+l*sinkt(m)*(
5788 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)-
5789 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5790 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)+
5791 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5792 dephii1=dephii1+(k-l)*sinkt(m)*(
5793 & -ffthet(l,k,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(l,k)+
5794 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)*sinph1ph2(k,l)+
5795 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(l,k)-
5796 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock)*cosph1ph2(k,l))
5798 write (iout,*) "m",m," k",k," l",l," ffthet",
5799 & ffthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5800 & ffthet(k,l,m,ityp1,ityp2,ityp3,iblock)," ggthet",
5801 & ggthet(l,k,m,ityp1,ityp2,ityp3,iblock),
5802 & ggthet(k,l,m,ityp1,ityp2,ityp3,iblock),
5803 & " ethetai",ethetai
5804 write (iout,*) cosph1ph2(l,k)*sinkt(m),
5805 & cosph1ph2(k,l)*sinkt(m),
5806 & sinph1ph2(l,k)*sinkt(m),sinph1ph2(k,l)*sinkt(m)
5814 & write (iout,'(i2,3f8.1,9h ethetai ,f10.5)')
5815 & i,theta(i)*rad2deg,phii*rad2deg,
5816 & phii1*rad2deg,ethetai
5818 etheta=etheta+ethetai
5819 if (i.gt.3) gloc(i-3,icg)=gloc(i-3,icg)+wang*dephii
5820 if (i.lt.nres) gloc(i-2,icg)=gloc(i-2,icg)+wang*dephii1
5821 gloc(nphi+i-2,icg)=wang*dethetai+gloc(nphi+i-2,icg)
5827 c-----------------------------------------------------------------------------
5828 subroutine esc(escloc)
5829 C Calculate the local energy of a side chain and its derivatives in the
5830 C corresponding virtual-bond valence angles THETA and the spherical angles
5832 implicit real*8 (a-h,o-z)
5833 include 'DIMENSIONS'
5834 include 'COMMON.GEO'
5835 include 'COMMON.LOCAL'
5836 include 'COMMON.VAR'
5837 include 'COMMON.INTERACT'
5838 include 'COMMON.DERIV'
5839 include 'COMMON.CHAIN'
5840 include 'COMMON.IOUNITS'
5841 include 'COMMON.NAMES'
5842 include 'COMMON.FFIELD'
5843 include 'COMMON.CONTROL'
5844 double precision x(3),dersc(3),xemp(3),dersc0(3),dersc1(3),
5845 & ddersc0(3),ddummy(3),xtemp(3),temp(3)
5846 common /sccalc/ time11,time12,time112,theti,it,nlobit
5849 c write (iout,'(a)') 'ESC'
5850 do i=loc_start,loc_end
5852 if (it.eq.ntyp1) cycle
5853 if (it.eq.10) goto 1
5854 nlobit=nlob(iabs(it))
5855 c print *,'i=',i,' it=',it,' nlobit=',nlobit
5856 c write (iout,*) 'i=',i,' ssa=',ssa,' ssad=',ssad
5857 theti=theta(i+1)-pipol
5862 if (x(2).gt.pi-delta) then
5866 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5868 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5869 call spline1(x(2),pi-delta,delta,escloci0,escloci1,dersc0(2),
5871 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5872 & ddersc0(1),dersc(1))
5873 call spline2(x(2),pi-delta,delta,dersc0(3),dersc1(3),
5874 & ddersc0(3),dersc(3))
5876 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5878 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5879 call spline1(x(2),pi-delta,delta,esclocbi0,esclocbi1,
5880 & dersc0(2),esclocbi,dersc02)
5881 call spline2(x(2),pi-delta,delta,dersc0(1),dersc1(1),
5883 call splinthet(x(2),0.5d0*delta,ss,ssd)
5888 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5890 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5891 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5893 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5895 c write (iout,*) escloci
5896 else if (x(2).lt.delta) then
5900 call enesc(xtemp,escloci0,dersc0,ddersc0,.true.)
5902 call enesc(xtemp,escloci1,dersc1,ddummy,.false.)
5903 call spline1(x(2),delta,-delta,escloci0,escloci1,dersc0(2),
5905 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5906 & ddersc0(1),dersc(1))
5907 call spline2(x(2),delta,-delta,dersc0(3),dersc1(3),
5908 & ddersc0(3),dersc(3))
5910 call enesc_bound(xtemp,esclocbi0,dersc0,dersc12,.true.)
5912 call enesc_bound(xtemp,esclocbi1,dersc1,chuju,.false.)
5913 call spline1(x(2),delta,-delta,esclocbi0,esclocbi1,
5914 & dersc0(2),esclocbi,dersc02)
5915 call spline2(x(2),delta,-delta,dersc0(1),dersc1(1),
5920 call splinthet(x(2),0.5d0*delta,ss,ssd)
5922 dersc(k)=ss*dersc(k)+(1.0d0-ss)*dersc0(k)
5924 dersc(2)=dersc(2)+ssd*(escloci-esclocbi)
5925 c write (iout,*) 'i=',i,x(2)*rad2deg,escloci0,escloci,
5927 escloci=ss*escloci+(1.0d0-ss)*esclocbi
5928 c write (iout,*) escloci
5930 call enesc(x,escloci,dersc,ddummy,.false.)
5933 escloc=escloc+escloci
5934 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
5935 & 'escloc',i,escloci
5936 c write (iout,*) 'i=',i,' escloci=',escloci,' dersc=',dersc
5938 gloc(nphi+i-1,icg)=gloc(nphi+i-1,icg)+
5940 gloc(ialph(i,1),icg)=wscloc*dersc(2)
5941 gloc(ialph(i,1)+nside,icg)=wscloc*dersc(3)
5946 C---------------------------------------------------------------------------
5947 subroutine enesc(x,escloci,dersc,ddersc,mixed)
5948 implicit real*8 (a-h,o-z)
5949 include 'DIMENSIONS'
5950 include 'COMMON.GEO'
5951 include 'COMMON.LOCAL'
5952 include 'COMMON.IOUNITS'
5953 common /sccalc/ time11,time12,time112,theti,it,nlobit
5954 double precision x(3),z(3),Ax(3,maxlob,-1:1),dersc(3),ddersc(3)
5955 double precision contr(maxlob,-1:1)
5957 c write (iout,*) 'it=',it,' nlobit=',nlobit
5961 if (mixed) ddersc(j)=0.0d0
5965 C Because of periodicity of the dependence of the SC energy in omega we have
5966 C to add up the contributions from x(3)-2*pi, x(3), and x(3+2*pi).
5967 C To avoid underflows, first compute & store the exponents.
5975 z(k)=x(k)-censc(k,j,it)
5980 Axk=Axk+gaussc(l,k,j,it)*z(l)
5986 expfac=expfac+Ax(k,j,iii)*z(k)
5994 C As in the case of ebend, we want to avoid underflows in exponentiation and
5995 C subsequent NaNs and INFs in energy calculation.
5996 C Find the largest exponent
6000 if (emin.gt.contr(j,iii)) emin=contr(j,iii)
6004 cd print *,'it=',it,' emin=',emin
6006 C Compute the contribution to SC energy and derivatives
6011 adexp=bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin
6012 if(adexp.ne.adexp) adexp=1.0
6015 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j,iii)+emin)
6017 cd print *,'j=',j,' expfac=',expfac
6018 escloc_i=escloc_i+expfac
6020 dersc(k)=dersc(k)+Ax(k,j,iii)*expfac
6024 ddersc(k)=ddersc(k)+(-Ax(2,j,iii)*Ax(k,j,iii)
6025 & +gaussc(k,2,j,it))*expfac
6032 dersc(1)=dersc(1)/cos(theti)**2
6033 ddersc(1)=ddersc(1)/cos(theti)**2
6036 escloci=-(dlog(escloc_i)-emin)
6038 dersc(j)=dersc(j)/escloc_i
6042 ddersc(j)=(ddersc(j)/escloc_i+dersc(2)*dersc(j))
6047 C------------------------------------------------------------------------------
6048 subroutine enesc_bound(x,escloci,dersc,dersc12,mixed)
6049 implicit real*8 (a-h,o-z)
6050 include 'DIMENSIONS'
6051 include 'COMMON.GEO'
6052 include 'COMMON.LOCAL'
6053 include 'COMMON.IOUNITS'
6054 common /sccalc/ time11,time12,time112,theti,it,nlobit
6055 double precision x(3),z(3),Ax(3,maxlob),dersc(3)
6056 double precision contr(maxlob)
6067 z(k)=x(k)-censc(k,j,it)
6073 Axk=Axk+gaussc(l,k,j,it)*z(l)
6079 expfac=expfac+Ax(k,j)*z(k)
6084 C As in the case of ebend, we want to avoid underflows in exponentiation and
6085 C subsequent NaNs and INFs in energy calculation.
6086 C Find the largest exponent
6089 if (emin.gt.contr(j)) emin=contr(j)
6093 C Compute the contribution to SC energy and derivatives
6097 expfac=dexp(bsc(j,iabs(it))-0.5D0*contr(j)+emin)
6098 escloc_i=escloc_i+expfac
6100 dersc(k)=dersc(k)+Ax(k,j)*expfac
6102 if (mixed) dersc12=dersc12+(-Ax(2,j)*Ax(1,j)
6103 & +gaussc(1,2,j,it))*expfac
6107 dersc(1)=dersc(1)/cos(theti)**2
6108 dersc12=dersc12/cos(theti)**2
6109 escloci=-(dlog(escloc_i)-emin)
6111 dersc(j)=dersc(j)/escloc_i
6113 if (mixed) dersc12=(dersc12/escloc_i+dersc(2)*dersc(1))
6117 c----------------------------------------------------------------------------------
6118 subroutine esc(escloc)
6119 C Calculate the local energy of a side chain and its derivatives in the
6120 C corresponding virtual-bond valence angles THETA and the spherical angles
6121 C ALPHA and OMEGA derived from AM1 all-atom calculations.
6122 C added by Urszula Kozlowska. 07/11/2007
6124 implicit real*8 (a-h,o-z)
6125 include 'DIMENSIONS'
6126 include 'COMMON.GEO'
6127 include 'COMMON.LOCAL'
6128 include 'COMMON.VAR'
6129 include 'COMMON.SCROT'
6130 include 'COMMON.INTERACT'
6131 include 'COMMON.DERIV'
6132 include 'COMMON.CHAIN'
6133 include 'COMMON.IOUNITS'
6134 include 'COMMON.NAMES'
6135 include 'COMMON.FFIELD'
6136 include 'COMMON.CONTROL'
6137 include 'COMMON.VECTORS'
6138 double precision x_prime(3),y_prime(3),z_prime(3)
6139 & , sumene,dsc_i,dp2_i,x(65),
6140 & xx,yy,zz,sumene1,sumene2,sumene3,sumene4,s1,s1_6,s2,s2_6,
6141 & de_dxx,de_dyy,de_dzz,de_dt
6142 double precision s1_t,s1_6_t,s2_t,s2_6_t
6144 & dXX_Ci1(3),dYY_Ci1(3),dZZ_Ci1(3),dXX_Ci(3),
6145 & dYY_Ci(3),dZZ_Ci(3),dXX_XYZ(3),dYY_XYZ(3),dZZ_XYZ(3),
6146 & dt_dCi(3),dt_dCi1(3)
6147 common /sccalc/ time11,time12,time112,theti,it,nlobit
6150 do i=loc_start,loc_end
6151 if (itype(i).eq.ntyp1) cycle
6152 costtab(i+1) =dcos(theta(i+1))
6153 sinttab(i+1) =dsqrt(1-costtab(i+1)*costtab(i+1))
6154 cost2tab(i+1)=dsqrt(0.5d0*(1.0d0+costtab(i+1)))
6155 sint2tab(i+1)=dsqrt(0.5d0*(1.0d0-costtab(i+1)))
6156 cosfac2=0.5d0/(1.0d0+costtab(i+1))
6157 cosfac=dsqrt(cosfac2)
6158 sinfac2=0.5d0/(1.0d0-costtab(i+1))
6159 sinfac=dsqrt(sinfac2)
6161 if (it.eq.10) goto 1
6163 C Compute the axes of tghe local cartesian coordinates system; store in
6164 c x_prime, y_prime and z_prime
6171 C write(2,*) "dc_norm", dc_norm(1,i+nres),dc_norm(2,i+nres),
6172 C & dc_norm(3,i+nres)
6174 x_prime(j) = (dc_norm(j,i) - dc_norm(j,i-1))*cosfac
6175 y_prime(j) = (dc_norm(j,i) + dc_norm(j,i-1))*sinfac
6178 z_prime(j) = -uz(j,i-1)*dsign(1.0d0,dfloat(itype(i)))
6181 c write (2,*) "x_prime",(x_prime(j),j=1,3)
6182 c write (2,*) "y_prime",(y_prime(j),j=1,3)
6183 c write (2,*) "z_prime",(z_prime(j),j=1,3)
6184 c write (2,*) "xx",scalar(x_prime(1),x_prime(1)),
6185 c & " xy",scalar(x_prime(1),y_prime(1)),
6186 c & " xz",scalar(x_prime(1),z_prime(1)),
6187 c & " yy",scalar(y_prime(1),y_prime(1)),
6188 c & " yz",scalar(y_prime(1),z_prime(1)),
6189 c & " zz",scalar(z_prime(1),z_prime(1))
6191 C Transform the unit vector of the ith side-chain centroid, dC_norm(*,i),
6192 C to local coordinate system. Store in xx, yy, zz.
6198 xx = xx + x_prime(j)*dc_norm(j,i+nres)
6199 yy = yy + y_prime(j)*dc_norm(j,i+nres)
6200 zz = zz + z_prime(j)*dc_norm(j,i+nres)
6207 C Compute the energy of the ith side cbain
6209 c write (2,*) "xx",xx," yy",yy," zz",zz
6212 x(j) = sc_parmin(j,it)
6215 Cc diagnostics - remove later
6217 yy1 = dsin(alph(2))*dcos(omeg(2))
6218 zz1 = -dsign(1.0,dfloat(itype(i)))*dsin(alph(2))*dsin(omeg(2))
6219 write(2,'(3f8.1,3f9.3,1x,3f9.3)')
6220 & alph(2)*rad2deg,omeg(2)*rad2deg,theta(3)*rad2deg,xx,yy,zz,
6222 C," --- ", xx_w,yy_w,zz_w
6225 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6226 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6228 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6229 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6231 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6232 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6233 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6234 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6235 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6237 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6238 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6239 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6240 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6241 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6243 dsc_i = 0.743d0+x(61)
6245 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6246 & *(xx*cost2tab(i+1)+yy*sint2tab(i+1)))
6247 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6248 & *(xx*cost2tab(i+1)-yy*sint2tab(i+1)))
6249 s1=(1+x(63))/(0.1d0 + dscp1)
6250 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6251 s2=(1+x(65))/(0.1d0 + dscp2)
6252 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6253 sumene = ( sumene3*sint2tab(i+1) + sumene1)*(s1+s1_6)
6254 & + (sumene4*cost2tab(i+1) +sumene2)*(s2+s2_6)
6255 c write(2,'(i2," sumene",7f9.3)') i,sumene1,sumene2,sumene3,
6257 c & dscp1,dscp2,sumene
6258 c sumene = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6259 escloc = escloc + sumene
6260 c write (2,*) "i",i," escloc",sumene,escloc,it,itype(i)
6265 C This section to check the numerical derivatives of the energy of ith side
6266 C chain in xx, yy, zz, and theta. Use the -DDEBUG compiler option or insert
6267 C #define DEBUG in the code to turn it on.
6269 write (2,*) "sumene =",sumene
6273 write (2,*) xx,yy,zz
6274 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6275 de_dxx_num=(sumenep-sumene)/aincr
6277 write (2,*) "xx+ sumene from enesc=",sumenep
6280 write (2,*) xx,yy,zz
6281 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6282 de_dyy_num=(sumenep-sumene)/aincr
6284 write (2,*) "yy+ sumene from enesc=",sumenep
6287 write (2,*) xx,yy,zz
6288 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6289 de_dzz_num=(sumenep-sumene)/aincr
6291 write (2,*) "zz+ sumene from enesc=",sumenep
6292 costsave=cost2tab(i+1)
6293 sintsave=sint2tab(i+1)
6294 cost2tab(i+1)=dcos(0.5d0*(theta(i+1)+aincr))
6295 sint2tab(i+1)=dsin(0.5d0*(theta(i+1)+aincr))
6296 sumenep = enesc(x,xx,yy,zz,cost2tab(i+1),sint2tab(i+1))
6297 de_dt_num=(sumenep-sumene)/aincr
6298 write (2,*) " t+ sumene from enesc=",sumenep
6299 cost2tab(i+1)=costsave
6300 sint2tab(i+1)=sintsave
6301 C End of diagnostics section.
6304 C Compute the gradient of esc
6306 c zz=zz*dsign(1.0,dfloat(itype(i)))
6307 pom_s1=(1.0d0+x(63))/(0.1d0 + dscp1)**2
6308 pom_s16=6*(1.0d0+x(64))/(0.1d0 + dscp1**6)**2
6309 pom_s2=(1.0d0+x(65))/(0.1d0 + dscp2)**2
6310 pom_s26=6*(1.0d0+x(65))/(0.1d0 + dscp2**6)**2
6311 pom_dx=dsc_i*dp2_i*cost2tab(i+1)
6312 pom_dy=dsc_i*dp2_i*sint2tab(i+1)
6313 pom_dt1=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)-yy*cost2tab(i+1))
6314 pom_dt2=-0.5d0*dsc_i*dp2_i*(xx*sint2tab(i+1)+yy*cost2tab(i+1))
6315 pom1=(sumene3*sint2tab(i+1)+sumene1)
6316 & *(pom_s1/dscp1+pom_s16*dscp1**4)
6317 pom2=(sumene4*cost2tab(i+1)+sumene2)
6318 & *(pom_s2/dscp2+pom_s26*dscp2**4)
6319 sumene1x=x(2)+2*x(5)*xx+x(8)*zz+ x(9)*yy
6320 sumene3x=x(22)+2*x(25)*xx+x(28)*zz+x(29)*yy+3*x(31)*xx**2
6321 & +2*x(34)*xx*yy +2*x(35)*xx*zz +x(36)*(yy**2) +x(38)*(zz**2)
6323 sumene2x=x(12)+2*x(15)*xx+x(18)*zz+ x(19)*yy
6324 sumene4x=x(42)+2*x(45)*xx +x(48)*zz +x(49)*yy +3*x(51)*xx**2
6325 & +2*x(54)*xx*yy+2*x(55)*xx*zz+x(56)*(yy**2)+x(58)*(zz**2)
6327 de_dxx =(sumene1x+sumene3x*sint2tab(i+1))*(s1+s1_6)
6328 & +(sumene2x+sumene4x*cost2tab(i+1))*(s2+s2_6)
6329 & +(pom1+pom2)*pom_dx
6331 write(2,*), "de_dxx = ", de_dxx,de_dxx_num,itype(i)
6334 sumene1y=x(3) + 2*x(6)*yy + x(9)*xx + x(10)*zz
6335 sumene3y=x(23) +2*x(26)*yy +x(29)*xx +x(30)*zz +3*x(32)*yy**2
6336 & +x(34)*(xx**2) +2*x(36)*yy*xx +2*x(37)*yy*zz +x(39)*(zz**2)
6338 sumene2y=x(13) + 2*x(16)*yy + x(19)*xx + x(20)*zz
6339 sumene4y=x(43)+2*x(46)*yy+x(49)*xx +x(50)*zz
6340 & +3*x(52)*yy**2+x(54)*xx**2+2*x(56)*yy*xx +2*x(57)*yy*zz
6341 & +x(59)*zz**2 +x(60)*xx*zz
6342 de_dyy =(sumene1y+sumene3y*sint2tab(i+1))*(s1+s1_6)
6343 & +(sumene2y+sumene4y*cost2tab(i+1))*(s2+s2_6)
6344 & +(pom1-pom2)*pom_dy
6346 write(2,*), "de_dyy = ", de_dyy,de_dyy_num,itype(i)
6349 de_dzz =(x(24) +2*x(27)*zz +x(28)*xx +x(30)*yy
6350 & +3*x(33)*zz**2 +x(35)*xx**2 +x(37)*yy**2 +2*x(38)*zz*xx
6351 & +2*x(39)*zz*yy +x(40)*xx*yy)*sint2tab(i+1)*(s1+s1_6)
6352 & +(x(4) + 2*x(7)*zz+ x(8)*xx + x(10)*yy)*(s1+s1_6)
6353 & +(x(44)+2*x(47)*zz +x(48)*xx +x(50)*yy +3*x(53)*zz**2
6354 & +x(55)*xx**2 +x(57)*(yy**2)+2*x(58)*zz*xx +2*x(59)*zz*yy
6355 & +x(60)*xx*yy)*cost2tab(i+1)*(s2+s2_6)
6356 & + ( x(14) + 2*x(17)*zz+ x(18)*xx + x(20)*yy)*(s2+s2_6)
6358 write(2,*), "de_dzz = ", de_dzz,de_dzz_num,itype(i)
6361 de_dt = 0.5d0*sumene3*cost2tab(i+1)*(s1+s1_6)
6362 & -0.5d0*sumene4*sint2tab(i+1)*(s2+s2_6)
6363 & +pom1*pom_dt1+pom2*pom_dt2
6365 write(2,*), "de_dt = ", de_dt,de_dt_num,itype(i)
6370 cossc=scalar(dc_norm(1,i),dc_norm(1,i+nres))
6371 cossc1=scalar(dc_norm(1,i-1),dc_norm(1,i+nres))
6372 cosfac2xx=cosfac2*xx
6373 sinfac2yy=sinfac2*yy
6375 dt_dCi(k) = -(dc_norm(k,i-1)+costtab(i+1)*dc_norm(k,i))*
6377 dt_dCi1(k)= -(dc_norm(k,i)+costtab(i+1)*dc_norm(k,i-1))*
6379 pom=(dC_norm(k,i+nres)-cossc*dC_norm(k,i))*vbld_inv(i+1)
6380 pom1=(dC_norm(k,i+nres)-cossc1*dC_norm(k,i-1))*vbld_inv(i)
6381 c write (iout,*) "i",i," k",k," pom",pom," pom1",pom1,
6382 c & " dt_dCi",dt_dCi(k)," dt_dCi1",dt_dCi1(k)
6383 c write (iout,*) "dC_norm",(dC_norm(j,i),j=1,3),
6384 c & (dC_norm(j,i-1),j=1,3)," vbld_inv",vbld_inv(i+1),vbld_inv(i)
6385 dXX_Ci(k)=pom*cosfac-dt_dCi(k)*cosfac2xx
6386 dXX_Ci1(k)=-pom1*cosfac-dt_dCi1(k)*cosfac2xx
6387 dYY_Ci(k)=pom*sinfac+dt_dCi(k)*sinfac2yy
6388 dYY_Ci1(k)=pom1*sinfac+dt_dCi1(k)*sinfac2yy
6392 dZZ_Ci(k)=dZZ_Ci(k)-uzgrad(j,k,2,i-1)
6393 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6394 dZZ_Ci1(k)=dZZ_Ci1(k)-uzgrad(j,k,1,i-1)
6395 & *dsign(1.0d0,dfloat(itype(i)))*dC_norm(j,i+nres)
6398 dXX_XYZ(k)=vbld_inv(i+nres)*(x_prime(k)-xx*dC_norm(k,i+nres))
6399 dYY_XYZ(k)=vbld_inv(i+nres)*(y_prime(k)-yy*dC_norm(k,i+nres))
6400 dZZ_XYZ(k)=vbld_inv(i+nres)*
6401 & (z_prime(k)-zz*dC_norm(k,i+nres))
6403 dt_dCi(k) = -dt_dCi(k)/sinttab(i+1)
6404 dt_dCi1(k)= -dt_dCi1(k)/sinttab(i+1)
6408 dXX_Ctab(k,i)=dXX_Ci(k)
6409 dXX_C1tab(k,i)=dXX_Ci1(k)
6410 dYY_Ctab(k,i)=dYY_Ci(k)
6411 dYY_C1tab(k,i)=dYY_Ci1(k)
6412 dZZ_Ctab(k,i)=dZZ_Ci(k)
6413 dZZ_C1tab(k,i)=dZZ_Ci1(k)
6414 dXX_XYZtab(k,i)=dXX_XYZ(k)
6415 dYY_XYZtab(k,i)=dYY_XYZ(k)
6416 dZZ_XYZtab(k,i)=dZZ_XYZ(k)
6420 c write (iout,*) "k",k," dxx_ci1",dxx_ci1(k)," dyy_ci1",
6421 c & dyy_ci1(k)," dzz_ci1",dzz_ci1(k)
6422 c write (iout,*) "k",k," dxx_ci",dxx_ci(k)," dyy_ci",
6423 c & dyy_ci(k)," dzz_ci",dzz_ci(k)
6424 c write (iout,*) "k",k," dt_dci",dt_dci(k)," dt_dci",
6426 c write (iout,*) "k",k," dxx_XYZ",dxx_XYZ(k)," dyy_XYZ",
6427 c & dyy_XYZ(k)," dzz_XYZ",dzz_XYZ(k)
6428 gscloc(k,i-1)=gscloc(k,i-1)+de_dxx*dxx_ci1(k)
6429 & +de_dyy*dyy_ci1(k)+de_dzz*dzz_ci1(k)+de_dt*dt_dCi1(k)
6430 gscloc(k,i)=gscloc(k,i)+de_dxx*dxx_Ci(k)
6431 & +de_dyy*dyy_Ci(k)+de_dzz*dzz_Ci(k)+de_dt*dt_dCi(k)
6432 gsclocx(k,i)= de_dxx*dxx_XYZ(k)
6433 & +de_dyy*dyy_XYZ(k)+de_dzz*dzz_XYZ(k)
6435 c write(iout,*) "ENERGY GRAD = ", (gscloc(k,i-1),k=1,3),
6436 c & (gscloc(k,i),k=1,3),(gsclocx(k,i),k=1,3)
6438 C to check gradient call subroutine check_grad
6444 c------------------------------------------------------------------------------
6445 double precision function enesc(x,xx,yy,zz,cost2,sint2)
6447 double precision x(65),xx,yy,zz,cost2,sint2,sumene1,sumene2,
6448 & sumene3,sumene4,sumene,dsc_i,dp2_i,dscp1,dscp2,s1,s1_6,s2,s2_6
6449 sumene1= x(1)+ x(2)*xx+ x(3)*yy+ x(4)*zz+ x(5)*xx**2
6450 & + x(6)*yy**2+ x(7)*zz**2+ x(8)*xx*zz+ x(9)*xx*yy
6452 sumene2= x(11) + x(12)*xx + x(13)*yy + x(14)*zz + x(15)*xx**2
6453 & + x(16)*yy**2 + x(17)*zz**2 + x(18)*xx*zz + x(19)*xx*yy
6455 sumene3= x(21) +x(22)*xx +x(23)*yy +x(24)*zz +x(25)*xx**2
6456 & +x(26)*yy**2 +x(27)*zz**2 +x(28)*xx*zz +x(29)*xx*yy
6457 & +x(30)*yy*zz +x(31)*xx**3 +x(32)*yy**3 +x(33)*zz**3
6458 & +x(34)*(xx**2)*yy +x(35)*(xx**2)*zz +x(36)*(yy**2)*xx
6459 & +x(37)*(yy**2)*zz +x(38)*(zz**2)*xx +x(39)*(zz**2)*yy
6461 sumene4= x(41) +x(42)*xx +x(43)*yy +x(44)*zz +x(45)*xx**2
6462 & +x(46)*yy**2 +x(47)*zz**2 +x(48)*xx*zz +x(49)*xx*yy
6463 & +x(50)*yy*zz +x(51)*xx**3 +x(52)*yy**3 +x(53)*zz**3
6464 & +x(54)*(xx**2)*yy +x(55)*(xx**2)*zz +x(56)*(yy**2)*xx
6465 & +x(57)*(yy**2)*zz +x(58)*(zz**2)*xx +x(59)*(zz**2)*yy
6467 dsc_i = 0.743d0+x(61)
6469 dscp1=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6470 & *(xx*cost2+yy*sint2))
6471 dscp2=dsqrt(dsc_i**2+dp2_i**2-2*dsc_i*dp2_i
6472 & *(xx*cost2-yy*sint2))
6473 s1=(1+x(63))/(0.1d0 + dscp1)
6474 s1_6=(1+x(64))/(0.1d0 + dscp1**6)
6475 s2=(1+x(65))/(0.1d0 + dscp2)
6476 s2_6=(1+x(65))/(0.1d0 + dscp2**6)
6477 sumene = ( sumene3*sint2 + sumene1)*(s1+s1_6)
6478 & + (sumene4*cost2 +sumene2)*(s2+s2_6)
6483 c------------------------------------------------------------------------------
6484 subroutine gcont(rij,r0ij,eps0ij,delta,fcont,fprimcont)
6486 C This procedure calculates two-body contact function g(rij) and its derivative:
6489 C g(rij) = esp0ij*(-0.9375*x+0.625*x**3-0.1875*x**5) ! -1 =< x =< 1
6492 C where x=(rij-r0ij)/delta
6494 C rij - interbody distance, r0ij - contact distance, eps0ij - contact energy
6497 double precision rij,r0ij,eps0ij,fcont,fprimcont
6498 double precision x,x2,x4,delta
6502 if (x.lt.-1.0D0) then
6505 else if (x.le.1.0D0) then
6508 fcont=eps0ij*(x*(-0.9375D0+0.6250D0*x2-0.1875D0*x4)+0.5D0)
6509 fprimcont=eps0ij * (-0.9375D0+1.8750D0*x2-0.9375D0*x4)/delta
6516 c------------------------------------------------------------------------------
6517 subroutine splinthet(theti,delta,ss,ssder)
6518 implicit real*8 (a-h,o-z)
6519 include 'DIMENSIONS'
6520 include 'COMMON.VAR'
6521 include 'COMMON.GEO'
6524 if (theti.gt.pipol) then
6525 call gcont(theti,thetup,1.0d0,delta,ss,ssder)
6527 call gcont(-theti,-thetlow,1.0d0,delta,ss,ssder)
6532 c------------------------------------------------------------------------------
6533 subroutine spline1(x,x0,delta,f0,f1,fprim0,f,fprim)
6535 double precision x,x0,delta,f0,f1,fprim0,f,fprim
6536 double precision ksi,ksi2,ksi3,a1,a2,a3
6537 a1=fprim0*delta/(f1-f0)
6543 f=f0+(f1-f0)*ksi*(a1+ksi*(a2+a3*ksi))
6544 fprim=(f1-f0)/delta*(a1+ksi*(2*a2+3*ksi*a3))
6547 c------------------------------------------------------------------------------
6548 subroutine spline2(x,x0,delta,f0x,f1x,fprim0x,fx)
6550 double precision x,x0,delta,f0x,f1x,fprim0x,fx
6551 double precision ksi,ksi2,ksi3,a1,a2,a3
6556 a2=3*(f1x-f0x)-2*fprim0x*delta
6557 a3=fprim0x*delta-2*(f1x-f0x)
6558 fx=f0x+a1*ksi+a2*ksi2+a3*ksi3
6561 C-----------------------------------------------------------------------------
6563 C-----------------------------------------------------------------------------
6564 subroutine etor(etors,edihcnstr)
6565 implicit real*8 (a-h,o-z)
6566 include 'DIMENSIONS'
6567 include 'COMMON.VAR'
6568 include 'COMMON.GEO'
6569 include 'COMMON.LOCAL'
6570 include 'COMMON.TORSION'
6571 include 'COMMON.INTERACT'
6572 include 'COMMON.DERIV'
6573 include 'COMMON.CHAIN'
6574 include 'COMMON.NAMES'
6575 include 'COMMON.IOUNITS'
6576 include 'COMMON.FFIELD'
6577 include 'COMMON.TORCNSTR'
6578 include 'COMMON.CONTROL'
6580 C Set lprn=.true. for debugging
6584 do i=iphi_start,iphi_end
6586 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6587 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6588 itori=itortyp(itype(i-2))
6589 itori1=itortyp(itype(i-1))
6592 C Proline-Proline pair is a special case...
6593 if (itori.eq.3 .and. itori1.eq.3) then
6594 if (phii.gt.-dwapi3) then
6596 fac=1.0D0/(1.0D0-cosphi)
6597 etorsi=v1(1,3,3)*fac
6598 etorsi=etorsi+etorsi
6599 etors=etors+etorsi-v1(1,3,3)
6600 if (energy_dec) etors_ii=etors_ii+etorsi-v1(1,3,3)
6601 gloci=gloci-3*fac*etorsi*dsin(3*phii)
6604 v1ij=v1(j+1,itori,itori1)
6605 v2ij=v2(j+1,itori,itori1)
6608 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6609 if (energy_dec) etors_ii=etors_ii+
6610 & v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6611 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6615 v1ij=v1(j,itori,itori1)
6616 v2ij=v2(j,itori,itori1)
6619 etors=etors+v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6620 if (energy_dec) etors_ii=etors_ii+
6621 & v1ij*cosphi+v2ij*sinphi+dabs(v1ij)+dabs(v2ij)
6622 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6625 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6628 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6629 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6630 & (v1(j,itori,itori1),j=1,6),(v2(j,itori,itori1),j=1,6)
6631 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6632 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6634 ! 6/20/98 - dihedral angle constraints
6637 itori=idih_constr(i)
6640 if (difi.gt.drange(i)) then
6642 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6643 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6644 else if (difi.lt.-drange(i)) then
6646 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6647 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6649 ! write (iout,'(2i5,2f8.3,2e14.5)') i,itori,rad2deg*phii,
6650 ! & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6652 ! write (iout,*) 'edihcnstr',edihcnstr
6655 c------------------------------------------------------------------------------
6656 subroutine etor_d(etors_d)
6660 c----------------------------------------------------------------------------
6662 subroutine etor(etors,edihcnstr)
6663 implicit real*8 (a-h,o-z)
6664 include 'DIMENSIONS'
6665 include 'COMMON.VAR'
6666 include 'COMMON.GEO'
6667 include 'COMMON.LOCAL'
6668 include 'COMMON.TORSION'
6669 include 'COMMON.INTERACT'
6670 include 'COMMON.DERIV'
6671 include 'COMMON.CHAIN'
6672 include 'COMMON.NAMES'
6673 include 'COMMON.IOUNITS'
6674 include 'COMMON.FFIELD'
6675 include 'COMMON.TORCNSTR'
6676 include 'COMMON.CONTROL'
6678 C Set lprn=.true. for debugging
6682 do i=iphi_start,iphi_end
6683 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6684 c if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6685 c & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)) .or.
6686 c & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1))) cycle
6687 if (itype(i-2).eq.ntyp1.or. itype(i-1).eq.ntyp1
6688 & .or. itype(i).eq.ntyp1 .or. itype(i-3).eq.ntyp1) cycle
6689 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6690 C For introducing the NH3+ and COO- group please check the etor_d for reference
6693 if (iabs(itype(i)).eq.20) then
6698 itori=itortyp(itype(i-2))
6699 itori1=itortyp(itype(i-1))
6702 C Regular cosine and sine terms
6703 do j=1,nterm(itori,itori1,iblock)
6704 v1ij=v1(j,itori,itori1,iblock)
6705 v2ij=v2(j,itori,itori1,iblock)
6708 etors=etors+v1ij*cosphi+v2ij*sinphi
6709 if (energy_dec) etors_ii=etors_ii+
6710 & v1ij*cosphi+v2ij*sinphi
6711 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6715 C E = SUM ----------------------------------- - v1
6716 C [v2 cos(phi/2)+v3 sin(phi/2)]^2 + 1
6718 cosphi=dcos(0.5d0*phii)
6719 sinphi=dsin(0.5d0*phii)
6720 do j=1,nlor(itori,itori1,iblock)
6721 vl1ij=vlor1(j,itori,itori1)
6722 vl2ij=vlor2(j,itori,itori1)
6723 vl3ij=vlor3(j,itori,itori1)
6724 pom=vl2ij*cosphi+vl3ij*sinphi
6725 pom1=1.0d0/(pom*pom+1.0d0)
6726 etors=etors+vl1ij*pom1
6727 if (energy_dec) etors_ii=etors_ii+
6730 gloci=gloci+vl1ij*(vl3ij*cosphi-vl2ij*sinphi)*pom
6732 C Subtract the constant term
6733 etors=etors-v0(itori,itori1,iblock)
6734 if (energy_dec) write (iout,'(a6,i5,0pf7.3)')
6735 & 'etor',i,etors_ii-v0(itori,itori1,iblock)
6737 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6738 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,itori,itori1,
6739 & (v1(j,itori,itori1,iblock),j=1,6),
6740 & (v2(j,itori,itori1,iblock),j=1,6)
6741 gloc(i-3,icg)=gloc(i-3,icg)+wtor*gloci
6742 c write (iout,*) 'i=',i,' gloc=',gloc(i-3,icg)
6744 ! 6/20/98 - dihedral angle constraints
6746 c do i=1,ndih_constr
6747 do i=idihconstr_start,idihconstr_end
6748 itori=idih_constr(i)
6750 difi=pinorm(phii-phi0(i))
6751 if (difi.gt.drange(i)) then
6753 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6754 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6755 else if (difi.lt.-drange(i)) then
6757 edihcnstr=edihcnstr+0.25d0*ftors*difi**4
6758 gloc(itori-3,icg)=gloc(itori-3,icg)+ftors*difi**3
6762 cd write (iout,'(2i5,4f8.3,2e14.5)') i,itori,rad2deg*phii,
6763 cd & rad2deg*phi0(i), rad2deg*drange(i),
6764 cd & rad2deg*difi,0.25d0*ftors*difi**4,gloc(itori-3,icg)
6766 cd write (iout,*) 'edihcnstr',edihcnstr
6769 c----------------------------------------------------------------------------
6770 subroutine etor_d(etors_d)
6771 C 6/23/01 Compute double torsional energy
6772 implicit real*8 (a-h,o-z)
6773 include 'DIMENSIONS'
6774 include 'COMMON.VAR'
6775 include 'COMMON.GEO'
6776 include 'COMMON.LOCAL'
6777 include 'COMMON.TORSION'
6778 include 'COMMON.INTERACT'
6779 include 'COMMON.DERIV'
6780 include 'COMMON.CHAIN'
6781 include 'COMMON.NAMES'
6782 include 'COMMON.IOUNITS'
6783 include 'COMMON.FFIELD'
6784 include 'COMMON.TORCNSTR'
6786 C Set lprn=.true. for debugging
6790 c write(iout,*) "a tu??"
6791 do i=iphid_start,iphid_end
6792 C ANY TWO ARE DUMMY ATOMS in row CYCLE
6793 C if (((itype(i-3).eq.ntyp1).and.(itype(i-2).eq.ntyp1)).or.
6794 C & ((itype(i-2).eq.ntyp1).and.(itype(i-1).eq.ntyp1)).or.
6795 C & ((itype(i-1).eq.ntyp1).and.(itype(i).eq.ntyp1)) .or.
6796 C & ((itype(i).eq.ntyp1).and.(itype(i+1).eq.ntyp1))) cycle
6797 if ((itype(i-2).eq.ntyp1).or.itype(i-3).eq.ntyp1.or.
6798 & (itype(i-1).eq.ntyp1).or.(itype(i).eq.ntyp1).or.
6799 & (itype(i+1).eq.ntyp1)) cycle
6800 C In current verion the ALL DUMMY ATOM POTENTIALS ARE OFF
6801 itori=itortyp(itype(i-2))
6802 itori1=itortyp(itype(i-1))
6803 itori2=itortyp(itype(i))
6809 if (iabs(itype(i+1)).eq.20) iblock=2
6810 C Iblock=2 Proline type
6811 C ADASKO: WHEN PARAMETERS FOR THIS TYPE OF BLOCKING GROUP IS READY UNCOMMENT
6812 C CHECK WEATHER THERE IS NECCESITY FOR iblock=3 for COO-
6813 C if (itype(i+1).eq.ntyp1) iblock=3
6814 C The problem of NH3+ group can be resolved by adding new parameters please note if there
6815 C IS or IS NOT need for this
6816 C IF Yes uncomment below and add to parmread.F appropriate changes and to v1cij and so on
6817 C is (itype(i-3).eq.ntyp1) ntblock=2
6818 C ntblock is N-terminal blocking group
6820 C Regular cosine and sine terms
6821 do j=1,ntermd_1(itori,itori1,itori2,iblock)
6822 C Example of changes for NH3+ blocking group
6823 C do j=1,ntermd_1(itori,itori1,itori2,iblock,ntblock)
6824 C v1cij=v1c(1,j,itori,itori1,itori2,iblock,ntblock)
6825 v1cij=v1c(1,j,itori,itori1,itori2,iblock)
6826 v1sij=v1s(1,j,itori,itori1,itori2,iblock)
6827 v2cij=v1c(2,j,itori,itori1,itori2,iblock)
6828 v2sij=v1s(2,j,itori,itori1,itori2,iblock)
6829 cosphi1=dcos(j*phii)
6830 sinphi1=dsin(j*phii)
6831 cosphi2=dcos(j*phii1)
6832 sinphi2=dsin(j*phii1)
6833 etors_d=etors_d+v1cij*cosphi1+v1sij*sinphi1+
6834 & v2cij*cosphi2+v2sij*sinphi2
6835 gloci1=gloci1+j*(v1sij*cosphi1-v1cij*sinphi1)
6836 gloci2=gloci2+j*(v2sij*cosphi2-v2cij*sinphi2)
6838 do k=2,ntermd_2(itori,itori1,itori2,iblock)
6840 v1cdij = v2c(k,l,itori,itori1,itori2,iblock)
6841 v2cdij = v2c(l,k,itori,itori1,itori2,iblock)
6842 v1sdij = v2s(k,l,itori,itori1,itori2,iblock)
6843 v2sdij = v2s(l,k,itori,itori1,itori2,iblock)
6844 cosphi1p2=dcos(l*phii+(k-l)*phii1)
6845 cosphi1m2=dcos(l*phii-(k-l)*phii1)
6846 sinphi1p2=dsin(l*phii+(k-l)*phii1)
6847 sinphi1m2=dsin(l*phii-(k-l)*phii1)
6848 etors_d=etors_d+v1cdij*cosphi1p2+v2cdij*cosphi1m2+
6849 & v1sdij*sinphi1p2+v2sdij*sinphi1m2
6850 gloci1=gloci1+l*(v1sdij*cosphi1p2+v2sdij*cosphi1m2
6851 & -v1cdij*sinphi1p2-v2cdij*sinphi1m2)
6852 gloci2=gloci2+(k-l)*(v1sdij*cosphi1p2-v2sdij*cosphi1m2
6853 & -v1cdij*sinphi1p2+v2cdij*sinphi1m2)
6856 gloc(i-3,icg)=gloc(i-3,icg)+wtor_d*gloci1
6857 gloc(i-2,icg)=gloc(i-2,icg)+wtor_d*gloci2
6862 c------------------------------------------------------------------------------
6863 subroutine eback_sc_corr(esccor)
6864 c 7/21/2007 Correlations between the backbone-local and side-chain-local
6865 c conformational states; temporarily implemented as differences
6866 c between UNRES torsional potentials (dependent on three types of
6867 c residues) and the torsional potentials dependent on all 20 types
6868 c of residues computed from AM1 energy surfaces of terminally-blocked
6869 c amino-acid residues.
6870 implicit real*8 (a-h,o-z)
6871 include 'DIMENSIONS'
6872 include 'COMMON.VAR'
6873 include 'COMMON.GEO'
6874 include 'COMMON.LOCAL'
6875 include 'COMMON.TORSION'
6876 include 'COMMON.SCCOR'
6877 include 'COMMON.INTERACT'
6878 include 'COMMON.DERIV'
6879 include 'COMMON.CHAIN'
6880 include 'COMMON.NAMES'
6881 include 'COMMON.IOUNITS'
6882 include 'COMMON.FFIELD'
6883 include 'COMMON.CONTROL'
6885 C Set lprn=.true. for debugging
6888 c write (iout,*) "EBACK_SC_COR",itau_start,itau_end
6890 do i=itau_start,itau_end
6891 if ((itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)) cycle
6893 isccori=isccortyp(itype(i-2))
6894 isccori1=isccortyp(itype(i-1))
6895 c write (iout,*) "EBACK_SC_COR",i,nterm_sccor(isccori,isccori1)
6897 do intertyp=1,3 !intertyp
6898 cc Added 09 May 2012 (Adasko)
6899 cc Intertyp means interaction type of backbone mainchain correlation:
6900 c 1 = SC...Ca...Ca...Ca
6901 c 2 = Ca...Ca...Ca...SC
6902 c 3 = SC...Ca...Ca...SCi
6904 if (((intertyp.eq.3).and.((itype(i-2).eq.10).or.
6905 & (itype(i-1).eq.10).or.(itype(i-2).eq.ntyp1).or.
6906 & (itype(i-1).eq.ntyp1)))
6907 & .or. ((intertyp.eq.1).and.((itype(i-2).eq.10)
6908 & .or.(itype(i-2).eq.ntyp1).or.(itype(i-1).eq.ntyp1)
6909 & .or.(itype(i).eq.ntyp1)))
6910 & .or.((intertyp.eq.2).and.((itype(i-1).eq.10).or.
6911 & (itype(i-1).eq.ntyp1).or.(itype(i-2).eq.ntyp1).or.
6912 & (itype(i-3).eq.ntyp1)))) cycle
6913 if ((intertyp.eq.2).and.(i.eq.4).and.(itype(1).eq.ntyp1)) cycle
6914 if ((intertyp.eq.1).and.(i.eq.nres).and.(itype(nres).eq.ntyp1))
6916 do j=1,nterm_sccor(isccori,isccori1)
6917 v1ij=v1sccor(j,intertyp,isccori,isccori1)
6918 v2ij=v2sccor(j,intertyp,isccori,isccori1)
6919 cosphi=dcos(j*tauangle(intertyp,i))
6920 sinphi=dsin(j*tauangle(intertyp,i))
6921 esccor=esccor+v1ij*cosphi+v2ij*sinphi
6922 gloci=gloci+j*(v2ij*cosphi-v1ij*sinphi)
6924 c write (iout,*) "EBACK_SC_COR",i,v1ij*cosphi+v2ij*sinphi,intertyp
6925 gloc_sc(intertyp,i-3,icg)=gloc_sc(intertyp,i-3,icg)+wsccor*gloci
6927 & write (iout,'(2(a3,2x,i3,2x),2i3,6f8.3/26x,6f8.3/)')
6928 & restyp(itype(i-2)),i-2,restyp(itype(i-1)),i-1,isccori,isccori1,
6929 & (v1sccor(j,intertyp,isccori,isccori1),j=1,6)
6930 & ,(v2sccor(j,intertyp,isccori,isccori1),j=1,6)
6931 gsccor_loc(i-3)=gsccor_loc(i-3)+gloci
6937 c----------------------------------------------------------------------------
6938 subroutine multibody(ecorr)
6939 C This subroutine calculates multi-body contributions to energy following
6940 C the idea of Skolnick et al. If side chains I and J make a contact and
6941 C at the same time side chains I+1 and J+1 make a contact, an extra
6942 C contribution equal to sqrt(eps(i,j)*eps(i+1,j+1)) is added.
6943 implicit real*8 (a-h,o-z)
6944 include 'DIMENSIONS'
6945 include 'COMMON.IOUNITS'
6946 include 'COMMON.DERIV'
6947 include 'COMMON.INTERACT'
6948 include 'COMMON.CONTACTS'
6949 double precision gx(3),gx1(3)
6952 C Set lprn=.true. for debugging
6956 write (iout,'(a)') 'Contact function values:'
6958 write (iout,'(i2,20(1x,i2,f10.5))')
6959 & i,(jcont(j,i),facont(j,i),j=1,num_cont(i))
6974 num_conti=num_cont(i)
6975 num_conti1=num_cont(i1)
6980 if (j1.eq.j+ishift .or. j1.eq.j-ishift) then
6981 cd write(iout,*)'i=',i,' j=',j,' i1=',i1,' j1=',j1,
6982 cd & ' ishift=',ishift
6983 C Contacts I--J and I+ISHIFT--J+-ISHIFT1 occur simultaneously.
6984 C The system gains extra energy.
6985 ecorr=ecorr+esccorr(i,j,i1,j1,jj,kk)
6986 endif ! j1==j+-ishift
6995 c------------------------------------------------------------------------------
6996 double precision function esccorr(i,j,k,l,jj,kk)
6997 implicit real*8 (a-h,o-z)
6998 include 'DIMENSIONS'
6999 include 'COMMON.IOUNITS'
7000 include 'COMMON.DERIV'
7001 include 'COMMON.INTERACT'
7002 include 'COMMON.CONTACTS'
7003 double precision gx(3),gx1(3)
7008 cd write (iout,'(4i5,3f10.5)') i,j,k,l,eij,ekl,-eij*ekl
7009 C Calculate the multi-body contribution to energy.
7010 C Calculate multi-body contributions to the gradient.
7011 cd write (iout,'(2(2i3,3f10.5))')i,j,(gacont(m,jj,i),m=1,3),
7012 cd & k,l,(gacont(m,kk,k),m=1,3)
7014 gx(m) =ekl*gacont(m,jj,i)
7015 gx1(m)=eij*gacont(m,kk,k)
7016 gradxorr(m,i)=gradxorr(m,i)-gx(m)
7017 gradxorr(m,j)=gradxorr(m,j)+gx(m)
7018 gradxorr(m,k)=gradxorr(m,k)-gx1(m)
7019 gradxorr(m,l)=gradxorr(m,l)+gx1(m)
7023 gradcorr(ll,m)=gradcorr(ll,m)+gx(ll)
7028 gradcorr(ll,m)=gradcorr(ll,m)+gx1(ll)
7034 c------------------------------------------------------------------------------
7035 subroutine multibody_hb(ecorr,ecorr5,ecorr6,n_corr,n_corr1)
7036 C This subroutine calculates multi-body contributions to hydrogen-bonding
7037 implicit real*8 (a-h,o-z)
7038 include 'DIMENSIONS'
7039 include 'COMMON.IOUNITS'
7042 parameter (max_cont=maxconts)
7043 parameter (max_dim=26)
7044 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7045 double precision zapas(max_dim,maxconts,max_fg_procs),
7046 & zapas_recv(max_dim,maxconts,max_fg_procs)
7047 common /przechowalnia/ zapas
7048 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7049 & status_array(MPI_STATUS_SIZE,maxconts*2)
7051 include 'COMMON.SETUP'
7052 include 'COMMON.FFIELD'
7053 include 'COMMON.DERIV'
7054 include 'COMMON.INTERACT'
7055 include 'COMMON.CONTACTS'
7056 include 'COMMON.CONTROL'
7057 include 'COMMON.LOCAL'
7058 double precision gx(3),gx1(3),time00
7061 C Set lprn=.true. for debugging
7066 if (nfgtasks.le.1) goto 30
7068 write (iout,'(a)') 'Contact function values before RECEIVE:'
7070 write (iout,'(2i3,50(1x,i2,f5.2))')
7071 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7072 & j=1,num_cont_hb(i))
7076 do i=1,ntask_cont_from
7079 do i=1,ntask_cont_to
7082 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7084 C Make the list of contacts to send to send to other procesors
7085 c write (iout,*) "limits",max0(iturn4_end-1,iatel_s),iturn3_end
7087 do i=iturn3_start,iturn3_end
7088 c write (iout,*) "make contact list turn3",i," num_cont",
7090 call add_hb_contact(i,i+2,iturn3_sent_local(1,i))
7092 do i=iturn4_start,iturn4_end
7093 c write (iout,*) "make contact list turn4",i," num_cont",
7095 call add_hb_contact(i,i+3,iturn4_sent_local(1,i))
7099 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7101 do j=1,num_cont_hb(i)
7104 iproc=iint_sent_local(k,jjc,ii)
7105 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7106 if (iproc.gt.0) then
7107 ncont_sent(iproc)=ncont_sent(iproc)+1
7108 nn=ncont_sent(iproc)
7110 zapas(2,nn,iproc)=jjc
7111 zapas(3,nn,iproc)=facont_hb(j,i)
7112 zapas(4,nn,iproc)=ees0p(j,i)
7113 zapas(5,nn,iproc)=ees0m(j,i)
7114 zapas(6,nn,iproc)=gacont_hbr(1,j,i)
7115 zapas(7,nn,iproc)=gacont_hbr(2,j,i)
7116 zapas(8,nn,iproc)=gacont_hbr(3,j,i)
7117 zapas(9,nn,iproc)=gacontm_hb1(1,j,i)
7118 zapas(10,nn,iproc)=gacontm_hb1(2,j,i)
7119 zapas(11,nn,iproc)=gacontm_hb1(3,j,i)
7120 zapas(12,nn,iproc)=gacontp_hb1(1,j,i)
7121 zapas(13,nn,iproc)=gacontp_hb1(2,j,i)
7122 zapas(14,nn,iproc)=gacontp_hb1(3,j,i)
7123 zapas(15,nn,iproc)=gacontm_hb2(1,j,i)
7124 zapas(16,nn,iproc)=gacontm_hb2(2,j,i)
7125 zapas(17,nn,iproc)=gacontm_hb2(3,j,i)
7126 zapas(18,nn,iproc)=gacontp_hb2(1,j,i)
7127 zapas(19,nn,iproc)=gacontp_hb2(2,j,i)
7128 zapas(20,nn,iproc)=gacontp_hb2(3,j,i)
7129 zapas(21,nn,iproc)=gacontm_hb3(1,j,i)
7130 zapas(22,nn,iproc)=gacontm_hb3(2,j,i)
7131 zapas(23,nn,iproc)=gacontm_hb3(3,j,i)
7132 zapas(24,nn,iproc)=gacontp_hb3(1,j,i)
7133 zapas(25,nn,iproc)=gacontp_hb3(2,j,i)
7134 zapas(26,nn,iproc)=gacontp_hb3(3,j,i)
7141 & "Numbers of contacts to be sent to other processors",
7142 & (ncont_sent(i),i=1,ntask_cont_to)
7143 write (iout,*) "Contacts sent"
7144 do ii=1,ntask_cont_to
7146 iproc=itask_cont_to(ii)
7147 write (iout,*) nn," contacts to processor",iproc,
7148 & " of CONT_TO_COMM group"
7150 write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7158 CorrelID1=nfgtasks+fg_rank+1
7160 C Receive the numbers of needed contacts from other processors
7161 do ii=1,ntask_cont_from
7162 iproc=itask_cont_from(ii)
7164 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7165 & FG_COMM,req(ireq),IERR)
7167 c write (iout,*) "IRECV ended"
7169 C Send the number of contacts needed by other processors
7170 do ii=1,ntask_cont_to
7171 iproc=itask_cont_to(ii)
7173 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7174 & FG_COMM,req(ireq),IERR)
7176 c write (iout,*) "ISEND ended"
7177 c write (iout,*) "number of requests (nn)",ireq
7180 & call MPI_Waitall(ireq,req,status_array,ierr)
7182 c & "Numbers of contacts to be received from other processors",
7183 c & (ncont_recv(i),i=1,ntask_cont_from)
7187 do ii=1,ntask_cont_from
7188 iproc=itask_cont_from(ii)
7190 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7191 c & " of CONT_TO_COMM group"
7195 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7196 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7197 c write (iout,*) "ireq,req",ireq,req(ireq)
7200 C Send the contacts to processors that need them
7201 do ii=1,ntask_cont_to
7202 iproc=itask_cont_to(ii)
7204 c write (iout,*) nn," contacts to processor",iproc,
7205 c & " of CONT_TO_COMM group"
7208 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7209 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7210 c write (iout,*) "ireq,req",ireq,req(ireq)
7212 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7216 c write (iout,*) "number of requests (contacts)",ireq
7217 c write (iout,*) "req",(req(i),i=1,4)
7220 & call MPI_Waitall(ireq,req,status_array,ierr)
7221 do iii=1,ntask_cont_from
7222 iproc=itask_cont_from(iii)
7225 write (iout,*) "Received",nn," contacts from processor",iproc,
7226 & " of CONT_FROM_COMM group"
7229 write(iout,'(2f5.0,4f10.5)')(zapas_recv(j,i,iii),j=1,5)
7234 ii=zapas_recv(1,i,iii)
7235 c Flag the received contacts to prevent double-counting
7236 jj=-zapas_recv(2,i,iii)
7237 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7239 nnn=num_cont_hb(ii)+1
7242 facont_hb(nnn,ii)=zapas_recv(3,i,iii)
7243 ees0p(nnn,ii)=zapas_recv(4,i,iii)
7244 ees0m(nnn,ii)=zapas_recv(5,i,iii)
7245 gacont_hbr(1,nnn,ii)=zapas_recv(6,i,iii)
7246 gacont_hbr(2,nnn,ii)=zapas_recv(7,i,iii)
7247 gacont_hbr(3,nnn,ii)=zapas_recv(8,i,iii)
7248 gacontm_hb1(1,nnn,ii)=zapas_recv(9,i,iii)
7249 gacontm_hb1(2,nnn,ii)=zapas_recv(10,i,iii)
7250 gacontm_hb1(3,nnn,ii)=zapas_recv(11,i,iii)
7251 gacontp_hb1(1,nnn,ii)=zapas_recv(12,i,iii)
7252 gacontp_hb1(2,nnn,ii)=zapas_recv(13,i,iii)
7253 gacontp_hb1(3,nnn,ii)=zapas_recv(14,i,iii)
7254 gacontm_hb2(1,nnn,ii)=zapas_recv(15,i,iii)
7255 gacontm_hb2(2,nnn,ii)=zapas_recv(16,i,iii)
7256 gacontm_hb2(3,nnn,ii)=zapas_recv(17,i,iii)
7257 gacontp_hb2(1,nnn,ii)=zapas_recv(18,i,iii)
7258 gacontp_hb2(2,nnn,ii)=zapas_recv(19,i,iii)
7259 gacontp_hb2(3,nnn,ii)=zapas_recv(20,i,iii)
7260 gacontm_hb3(1,nnn,ii)=zapas_recv(21,i,iii)
7261 gacontm_hb3(2,nnn,ii)=zapas_recv(22,i,iii)
7262 gacontm_hb3(3,nnn,ii)=zapas_recv(23,i,iii)
7263 gacontp_hb3(1,nnn,ii)=zapas_recv(24,i,iii)
7264 gacontp_hb3(2,nnn,ii)=zapas_recv(25,i,iii)
7265 gacontp_hb3(3,nnn,ii)=zapas_recv(26,i,iii)
7270 write (iout,'(a)') 'Contact function values after receive:'
7272 write (iout,'(2i3,50(1x,i3,f5.2))')
7273 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7274 & j=1,num_cont_hb(i))
7281 write (iout,'(a)') 'Contact function values:'
7283 write (iout,'(2i3,50(1x,i3,f5.2))')
7284 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7285 & j=1,num_cont_hb(i))
7289 C Remove the loop below after debugging !!!
7296 C Calculate the local-electrostatic correlation terms
7297 do i=min0(iatel_s,iturn4_start),max0(iatel_e,iturn3_end)
7299 num_conti=num_cont_hb(i)
7300 num_conti1=num_cont_hb(i+1)
7307 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7308 c & ' jj=',jj,' kk=',kk
7309 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7310 & .or. j.lt.0 .and. j1.gt.0) .and.
7311 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7312 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7313 C The system gains extra energy.
7314 ecorr=ecorr+ehbcorr(i,jp,i+1,jp1,jj,kk,0.72D0,0.32D0)
7315 if (energy_dec) write (iout,'(a6,2i5,0pf7.3)')
7316 & 'ecorrh',i,j,ehbcorr(i,j,i+1,j1,jj,kk,0.72D0,0.32D0)
7318 else if (j1.eq.j) then
7319 C Contacts I-J and I-(J+1) occur simultaneously.
7320 C The system loses extra energy.
7321 c ecorr=ecorr+ehbcorr(i,j,i+1,j,jj,kk,0.60D0,-0.40D0)
7326 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7327 c & ' jj=',jj,' kk=',kk
7329 C Contacts I-J and (I+1)-J occur simultaneously.
7330 C The system loses extra energy.
7331 c ecorr=ecorr+ehbcorr(i,j,i,j+1,jj,kk,0.60D0,-0.40D0)
7338 c------------------------------------------------------------------------------
7339 subroutine add_hb_contact(ii,jj,itask)
7340 implicit real*8 (a-h,o-z)
7341 include "DIMENSIONS"
7342 include "COMMON.IOUNITS"
7345 parameter (max_cont=maxconts)
7346 parameter (max_dim=26)
7347 include "COMMON.CONTACTS"
7348 double precision zapas(max_dim,maxconts,max_fg_procs),
7349 & zapas_recv(max_dim,maxconts,max_fg_procs)
7350 common /przechowalnia/ zapas
7351 integer i,j,ii,jj,iproc,itask(4),nn
7352 c write (iout,*) "itask",itask
7355 if (iproc.gt.0) then
7356 do j=1,num_cont_hb(ii)
7358 c write (iout,*) "i",ii," j",jj," jjc",jjc
7360 ncont_sent(iproc)=ncont_sent(iproc)+1
7361 nn=ncont_sent(iproc)
7362 zapas(1,nn,iproc)=ii
7363 zapas(2,nn,iproc)=jjc
7364 zapas(3,nn,iproc)=facont_hb(j,ii)
7365 zapas(4,nn,iproc)=ees0p(j,ii)
7366 zapas(5,nn,iproc)=ees0m(j,ii)
7367 zapas(6,nn,iproc)=gacont_hbr(1,j,ii)
7368 zapas(7,nn,iproc)=gacont_hbr(2,j,ii)
7369 zapas(8,nn,iproc)=gacont_hbr(3,j,ii)
7370 zapas(9,nn,iproc)=gacontm_hb1(1,j,ii)
7371 zapas(10,nn,iproc)=gacontm_hb1(2,j,ii)
7372 zapas(11,nn,iproc)=gacontm_hb1(3,j,ii)
7373 zapas(12,nn,iproc)=gacontp_hb1(1,j,ii)
7374 zapas(13,nn,iproc)=gacontp_hb1(2,j,ii)
7375 zapas(14,nn,iproc)=gacontp_hb1(3,j,ii)
7376 zapas(15,nn,iproc)=gacontm_hb2(1,j,ii)
7377 zapas(16,nn,iproc)=gacontm_hb2(2,j,ii)
7378 zapas(17,nn,iproc)=gacontm_hb2(3,j,ii)
7379 zapas(18,nn,iproc)=gacontp_hb2(1,j,ii)
7380 zapas(19,nn,iproc)=gacontp_hb2(2,j,ii)
7381 zapas(20,nn,iproc)=gacontp_hb2(3,j,ii)
7382 zapas(21,nn,iproc)=gacontm_hb3(1,j,ii)
7383 zapas(22,nn,iproc)=gacontm_hb3(2,j,ii)
7384 zapas(23,nn,iproc)=gacontm_hb3(3,j,ii)
7385 zapas(24,nn,iproc)=gacontp_hb3(1,j,ii)
7386 zapas(25,nn,iproc)=gacontp_hb3(2,j,ii)
7387 zapas(26,nn,iproc)=gacontp_hb3(3,j,ii)
7395 c------------------------------------------------------------------------------
7396 subroutine multibody_eello(ecorr,ecorr5,ecorr6,eturn6,n_corr,
7398 C This subroutine calculates multi-body contributions to hydrogen-bonding
7399 implicit real*8 (a-h,o-z)
7400 include 'DIMENSIONS'
7401 include 'COMMON.IOUNITS'
7404 parameter (max_cont=maxconts)
7405 parameter (max_dim=70)
7406 integer source,CorrelType,CorrelID,CorrelType1,CorrelID1,Error
7407 double precision zapas(max_dim,maxconts,max_fg_procs),
7408 & zapas_recv(max_dim,maxconts,max_fg_procs)
7409 common /przechowalnia/ zapas
7410 integer status(MPI_STATUS_SIZE),req(maxconts*2),
7411 & status_array(MPI_STATUS_SIZE,maxconts*2)
7413 include 'COMMON.SETUP'
7414 include 'COMMON.FFIELD'
7415 include 'COMMON.DERIV'
7416 include 'COMMON.LOCAL'
7417 include 'COMMON.INTERACT'
7418 include 'COMMON.CONTACTS'
7419 include 'COMMON.CHAIN'
7420 include 'COMMON.CONTROL'
7421 double precision gx(3),gx1(3)
7422 integer num_cont_hb_old(maxres)
7424 double precision eello4,eello5,eelo6,eello_turn6
7425 external eello4,eello5,eello6,eello_turn6
7426 C Set lprn=.true. for debugging
7431 num_cont_hb_old(i)=num_cont_hb(i)
7435 if (nfgtasks.le.1) goto 30
7437 write (iout,'(a)') 'Contact function values before RECEIVE:'
7439 write (iout,'(2i3,50(1x,i2,f5.2))')
7440 & i,num_cont_hb(i),(jcont_hb(j,i),facont_hb(j,i),
7441 & j=1,num_cont_hb(i))
7445 do i=1,ntask_cont_from
7448 do i=1,ntask_cont_to
7451 c write (iout,*) "ntask_cont_from",ntask_cont_from," ntask_cont_to",
7453 C Make the list of contacts to send to send to other procesors
7454 do i=iturn3_start,iturn3_end
7455 c write (iout,*) "make contact list turn3",i," num_cont",
7457 call add_hb_contact_eello(i,i+2,iturn3_sent_local(1,i))
7459 do i=iturn4_start,iturn4_end
7460 c write (iout,*) "make contact list turn4",i," num_cont",
7462 call add_hb_contact_eello(i,i+3,iturn4_sent_local(1,i))
7466 c write (iout,*) "make contact list longrange",i,ii," num_cont",
7468 do j=1,num_cont_hb(i)
7471 iproc=iint_sent_local(k,jjc,ii)
7472 c write (iout,*) "i",i," j",j," k",k," jjc",jjc," iproc",iproc
7473 if (iproc.ne.0) then
7474 ncont_sent(iproc)=ncont_sent(iproc)+1
7475 nn=ncont_sent(iproc)
7477 zapas(2,nn,iproc)=jjc
7478 zapas(3,nn,iproc)=d_cont(j,i)
7482 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,i)
7487 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,i)
7495 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,i)
7506 & "Numbers of contacts to be sent to other processors",
7507 & (ncont_sent(i),i=1,ntask_cont_to)
7508 write (iout,*) "Contacts sent"
7509 do ii=1,ntask_cont_to
7511 iproc=itask_cont_to(ii)
7512 write (iout,*) nn," contacts to processor",iproc,
7513 & " of CONT_TO_COMM group"
7515 write(iout,'(2f5.0,10f10.5)')(zapas(j,i,ii),j=1,10)
7523 CorrelID1=nfgtasks+fg_rank+1
7525 C Receive the numbers of needed contacts from other processors
7526 do ii=1,ntask_cont_from
7527 iproc=itask_cont_from(ii)
7529 call MPI_Irecv(ncont_recv(ii),1,MPI_INTEGER,iproc,CorrelType,
7530 & FG_COMM,req(ireq),IERR)
7532 c write (iout,*) "IRECV ended"
7534 C Send the number of contacts needed by other processors
7535 do ii=1,ntask_cont_to
7536 iproc=itask_cont_to(ii)
7538 call MPI_Isend(ncont_sent(ii),1,MPI_INTEGER,iproc,CorrelType,
7539 & FG_COMM,req(ireq),IERR)
7541 c write (iout,*) "ISEND ended"
7542 c write (iout,*) "number of requests (nn)",ireq
7545 & call MPI_Waitall(ireq,req,status_array,ierr)
7547 c & "Numbers of contacts to be received from other processors",
7548 c & (ncont_recv(i),i=1,ntask_cont_from)
7552 do ii=1,ntask_cont_from
7553 iproc=itask_cont_from(ii)
7555 c write (iout,*) "Receiving",nn," contacts from processor",iproc,
7556 c & " of CONT_TO_COMM group"
7560 call MPI_Irecv(zapas_recv(1,1,ii),nn*max_dim,
7561 & MPI_DOUBLE_PRECISION,iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7562 c write (iout,*) "ireq,req",ireq,req(ireq)
7565 C Send the contacts to processors that need them
7566 do ii=1,ntask_cont_to
7567 iproc=itask_cont_to(ii)
7569 c write (iout,*) nn," contacts to processor",iproc,
7570 c & " of CONT_TO_COMM group"
7573 call MPI_Isend(zapas(1,1,ii),nn*max_dim,MPI_DOUBLE_PRECISION,
7574 & iproc,CorrelType1,FG_COMM,req(ireq),IERR)
7575 c write (iout,*) "ireq,req",ireq,req(ireq)
7577 c write(iout,'(2f5.0,4f10.5)')(zapas(j,i,ii),j=1,5)
7581 c write (iout,*) "number of requests (contacts)",ireq
7582 c write (iout,*) "req",(req(i),i=1,4)
7585 & call MPI_Waitall(ireq,req,status_array,ierr)
7586 do iii=1,ntask_cont_from
7587 iproc=itask_cont_from(iii)
7590 write (iout,*) "Received",nn," contacts from processor",iproc,
7591 & " of CONT_FROM_COMM group"
7594 write(iout,'(2f5.0,10f10.5)')(zapas_recv(j,i,iii),j=1,10)
7599 ii=zapas_recv(1,i,iii)
7600 c Flag the received contacts to prevent double-counting
7601 jj=-zapas_recv(2,i,iii)
7602 c write (iout,*) "iii",iii," i",i," ii",ii," jj",jj
7604 nnn=num_cont_hb(ii)+1
7607 d_cont(nnn,ii)=zapas_recv(3,i,iii)
7611 grij_hb_cont(kk,nnn,ii)=zapas_recv(ind,i,iii)
7616 a_chuj(ll,kk,nnn,ii)=zapas_recv(ind,i,iii)
7624 a_chuj_der(mm,ll,kk,jj,nnn,ii)=zapas_recv(ind,i,iii)
7633 write (iout,'(a)') 'Contact function values after receive:'
7635 write (iout,'(2i3,50(1x,i3,5f6.3))')
7636 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7637 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7644 write (iout,'(a)') 'Contact function values:'
7646 write (iout,'(2i3,50(1x,i2,5f6.3))')
7647 & i,num_cont_hb(i),(jcont_hb(j,i),d_cont(j,i),
7648 & ((a_chuj(ll,kk,j,i),ll=1,2),kk=1,2),j=1,num_cont_hb(i))
7654 C Remove the loop below after debugging !!!
7661 C Calculate the dipole-dipole interaction energies
7662 if (wcorr6.gt.0.0d0 .or. wturn6.gt.0.0d0) then
7663 do i=iatel_s,iatel_e+1
7664 num_conti=num_cont_hb(i)
7673 C Calculate the local-electrostatic correlation terms
7674 c write (iout,*) "gradcorr5 in eello5 before loop"
7676 c write (iout,'(i5,3f10.5)')
7677 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7679 do i=min0(iatel_s,iturn4_start),max0(iatel_e+1,iturn3_end+1)
7680 c write (iout,*) "corr loop i",i
7682 num_conti=num_cont_hb(i)
7683 num_conti1=num_cont_hb(i+1)
7690 c write (iout,*) 'i=',i,' j=',j,' i1=',i1,' j1=',j1,
7691 c & ' jj=',jj,' kk=',kk
7692 c if (j1.eq.j+1 .or. j1.eq.j-1) then
7693 if ((j.gt.0 .and. j1.gt.0 .or. j.gt.0 .and. j1.lt.0
7694 & .or. j.lt.0 .and. j1.gt.0) .and.
7695 & (jp1.eq.jp+1 .or. jp1.eq.jp-1)) then
7696 C Contacts I-J and (I+1)-(J+1) or (I+1)-(J-1) occur simultaneously.
7697 C The system gains extra energy.
7699 sqd1=dsqrt(d_cont(jj,i))
7700 sqd2=dsqrt(d_cont(kk,i1))
7701 sred_geom = sqd1*sqd2
7702 IF (sred_geom.lt.cutoff_corr) THEN
7703 call gcont(sred_geom,r0_corr,1.0D0,delt_corr,
7705 cd write (iout,*) 'i=',i,' j=',jp,' i1=',i1,' j1=',jp1,
7706 cd & ' jj=',jj,' kk=',kk
7707 fac_prim1=0.5d0*sqd2/sqd1*fprimcont
7708 fac_prim2=0.5d0*sqd1/sqd2*fprimcont
7710 g_contij(l,1)=fac_prim1*grij_hb_cont(l,jj,i)
7711 g_contij(l,2)=fac_prim2*grij_hb_cont(l,kk,i1)
7714 cd write (iout,*) 'sred_geom=',sred_geom,
7715 cd & ' ekont=',ekont,' fprim=',fprimcont,
7716 cd & ' fac_prim1',fac_prim1,' fac_prim2',fac_prim2
7717 cd write (iout,*) "g_contij",g_contij
7718 cd write (iout,*) "grij_hb_cont i",grij_hb_cont(:,jj,i)
7719 cd write (iout,*) "grij_hb_cont i1",grij_hb_cont(:,jj,i1)
7720 call calc_eello(i,jp,i+1,jp1,jj,kk)
7721 if (wcorr4.gt.0.0d0)
7722 & ecorr=ecorr+eello4(i,jp,i+1,jp1,jj,kk)
7723 if (energy_dec.and.wcorr4.gt.0.0d0)
7724 1 write (iout,'(a6,4i5,0pf7.3)')
7725 2 'ecorr4',i,j,i+1,j1,eello4(i,jp,i+1,jp1,jj,kk)
7726 c write (iout,*) "gradcorr5 before eello5"
7728 c write (iout,'(i5,3f10.5)')
7729 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7731 if (wcorr5.gt.0.0d0)
7732 & ecorr5=ecorr5+eello5(i,jp,i+1,jp1,jj,kk)
7733 c write (iout,*) "gradcorr5 after eello5"
7735 c write (iout,'(i5,3f10.5)')
7736 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7738 if (energy_dec.and.wcorr5.gt.0.0d0)
7739 1 write (iout,'(a6,4i5,0pf7.3)')
7740 2 'ecorr5',i,j,i+1,j1,eello5(i,jp,i+1,jp1,jj,kk)
7741 cd write(2,*)'wcorr6',wcorr6,' wturn6',wturn6
7742 cd write(2,*)'ijkl',i,jp,i+1,jp1
7743 if (wcorr6.gt.0.0d0 .and. (jp.ne.i+4 .or. jp1.ne.i+3
7744 & .or. wturn6.eq.0.0d0))then
7745 cd write (iout,*) '******ecorr6: i,j,i+1,j1',i,j,i+1,j1
7746 ecorr6=ecorr6+eello6(i,jp,i+1,jp1,jj,kk)
7747 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7748 1 'ecorr6',i,j,i+1,j1,eello6(i,jp,i+1,jp1,jj,kk)
7749 cd write (iout,*) 'ecorr',ecorr,' ecorr5=',ecorr5,
7750 cd & 'ecorr6=',ecorr6
7751 cd write (iout,'(4e15.5)') sred_geom,
7752 cd & dabs(eello4(i,jp,i+1,jp1,jj,kk)),
7753 cd & dabs(eello5(i,jp,i+1,jp1,jj,kk)),
7754 cd & dabs(eello6(i,jp,i+1,jp1,jj,kk))
7755 else if (wturn6.gt.0.0d0
7756 & .and. (jp.eq.i+4 .and. jp1.eq.i+3)) then
7757 cd write (iout,*) '******eturn6: i,j,i+1,j1',i,jip,i+1,jp1
7758 eturn6=eturn6+eello_turn6(i,jj,kk)
7759 if (energy_dec) write (iout,'(a6,4i5,0pf7.3)')
7760 1 'eturn6',i,j,i+1,j1,eello_turn6(i,jj,kk)
7761 cd write (2,*) 'multibody_eello:eturn6',eturn6
7770 num_cont_hb(i)=num_cont_hb_old(i)
7772 c write (iout,*) "gradcorr5 in eello5"
7774 c write (iout,'(i5,3f10.5)')
7775 c & iii,(gradcorr5(jjj,iii),jjj=1,3)
7779 c------------------------------------------------------------------------------
7780 subroutine add_hb_contact_eello(ii,jj,itask)
7781 implicit real*8 (a-h,o-z)
7782 include "DIMENSIONS"
7783 include "COMMON.IOUNITS"
7786 parameter (max_cont=maxconts)
7787 parameter (max_dim=70)
7788 include "COMMON.CONTACTS"
7789 double precision zapas(max_dim,maxconts,max_fg_procs),
7790 & zapas_recv(max_dim,maxconts,max_fg_procs)
7791 common /przechowalnia/ zapas
7792 integer i,j,ii,jj,iproc,itask(4),nn
7793 c write (iout,*) "itask",itask
7796 if (iproc.gt.0) then
7797 do j=1,num_cont_hb(ii)
7799 c write (iout,*) "send turns i",ii," j",jj," jjc",jjc
7801 ncont_sent(iproc)=ncont_sent(iproc)+1
7802 nn=ncont_sent(iproc)
7803 zapas(1,nn,iproc)=ii
7804 zapas(2,nn,iproc)=jjc
7805 zapas(3,nn,iproc)=d_cont(j,ii)
7809 zapas(ind,nn,iproc)=grij_hb_cont(kk,j,ii)
7814 zapas(ind,nn,iproc)=a_chuj(ll,kk,j,ii)
7822 zapas(ind,nn,iproc)=a_chuj_der(mm,ll,kk,jj,j,ii)
7834 c------------------------------------------------------------------------------
7835 double precision function ehbcorr(i,j,k,l,jj,kk,coeffp,coeffm)
7836 implicit real*8 (a-h,o-z)
7837 include 'DIMENSIONS'
7838 include 'COMMON.IOUNITS'
7839 include 'COMMON.DERIV'
7840 include 'COMMON.INTERACT'
7841 include 'COMMON.CONTACTS'
7842 double precision gx(3),gx1(3)
7852 ees=-(coeffp*ees0pij*ees0pkl+coeffm*ees0mij*ees0mkl)
7853 cd ees=-(coeffp*ees0pkl+coeffm*ees0mkl)
7854 C Following 4 lines for diagnostics.
7859 c write (iout,'(2(a,2i3,a,f10.5,a,2f10.5),a,f10.5,a,$)')
7860 c & 'Contacts ',i,j,
7861 c & ' eij',eij,' eesij',ees0pij,ees0mij,' and ',k,l
7862 c & ,' fcont ',ekl,' eeskl',ees0pkl,ees0mkl,' energy=',ekont*ees,
7864 C Calculate the multi-body contribution to energy.
7865 c ecorr=ecorr+ekont*ees
7866 C Calculate multi-body contributions to the gradient.
7867 coeffpees0pij=coeffp*ees0pij
7868 coeffmees0mij=coeffm*ees0mij
7869 coeffpees0pkl=coeffp*ees0pkl
7870 coeffmees0mkl=coeffm*ees0mkl
7872 cgrad ghalfi=ees*ekl*gacont_hbr(ll,jj,i)
7873 gradcorr(ll,i)=gradcorr(ll,i)!+0.5d0*ghalfi
7874 & -ekont*(coeffpees0pkl*gacontp_hb1(ll,jj,i)+
7875 & coeffmees0mkl*gacontm_hb1(ll,jj,i))
7876 gradcorr(ll,j)=gradcorr(ll,j)!+0.5d0*ghalfi
7877 & -ekont*(coeffpees0pkl*gacontp_hb2(ll,jj,i)+
7878 & coeffmees0mkl*gacontm_hb2(ll,jj,i))
7879 cgrad ghalfk=ees*eij*gacont_hbr(ll,kk,k)
7880 gradcorr(ll,k)=gradcorr(ll,k)!+0.5d0*ghalfk
7881 & -ekont*(coeffpees0pij*gacontp_hb1(ll,kk,k)+
7882 & coeffmees0mij*gacontm_hb1(ll,kk,k))
7883 gradcorr(ll,l)=gradcorr(ll,l)!+0.5d0*ghalfk
7884 & -ekont*(coeffpees0pij*gacontp_hb2(ll,kk,k)+
7885 & coeffmees0mij*gacontm_hb2(ll,kk,k))
7886 gradlongij=ees*ekl*gacont_hbr(ll,jj,i)-
7887 & ekont*(coeffpees0pkl*gacontp_hb3(ll,jj,i)+
7888 & coeffmees0mkl*gacontm_hb3(ll,jj,i))
7889 gradcorr_long(ll,j)=gradcorr_long(ll,j)+gradlongij
7890 gradcorr_long(ll,i)=gradcorr_long(ll,i)-gradlongij
7891 gradlongkl=ees*eij*gacont_hbr(ll,kk,k)-
7892 & ekont*(coeffpees0pij*gacontp_hb3(ll,kk,k)+
7893 & coeffmees0mij*gacontm_hb3(ll,kk,k))
7894 gradcorr_long(ll,l)=gradcorr_long(ll,l)+gradlongkl
7895 gradcorr_long(ll,k)=gradcorr_long(ll,k)-gradlongkl
7896 c write (iout,'(2f10.5,2x,$)') gradlongij,gradlongkl
7901 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7902 cgrad & ees*ekl*gacont_hbr(ll,jj,i)-
7903 cgrad & ekont*(coeffp*ees0pkl*gacontp_hb3(ll,jj,i)+
7904 cgrad & coeffm*ees0mkl*gacontm_hb3(ll,jj,i))
7909 cgrad gradcorr(ll,m)=gradcorr(ll,m)+
7910 cgrad & ees*eij*gacont_hbr(ll,kk,k)-
7911 cgrad & ekont*(coeffp*ees0pij*gacontp_hb3(ll,kk,k)+
7912 cgrad & coeffm*ees0mij*gacontm_hb3(ll,kk,k))
7915 c write (iout,*) "ehbcorr",ekont*ees
7920 C---------------------------------------------------------------------------
7921 subroutine dipole(i,j,jj)
7922 implicit real*8 (a-h,o-z)
7923 include 'DIMENSIONS'
7924 include 'COMMON.IOUNITS'
7925 include 'COMMON.CHAIN'
7926 include 'COMMON.FFIELD'
7927 include 'COMMON.DERIV'
7928 include 'COMMON.INTERACT'
7929 include 'COMMON.CONTACTS'
7930 include 'COMMON.TORSION'
7931 include 'COMMON.VAR'
7932 include 'COMMON.GEO'
7933 dimension dipi(2,2),dipj(2,2),dipderi(2),dipderj(2),auxvec(2),
7935 iti1 = itortyp(itype(i+1))
7936 if (j.lt.nres-1) then
7937 itj1 = itortyp(itype(j+1))
7942 dipi(iii,1)=Ub2(iii,i)
7943 dipderi(iii)=Ub2der(iii,i)
7944 dipi(iii,2)=b1(iii,i+1)
7945 dipj(iii,1)=Ub2(iii,j)
7946 dipderj(iii)=Ub2der(iii,j)
7947 dipj(iii,2)=b1(iii,j+1)
7951 call matvec2(a_chuj(1,1,jj,i),dipj(1,iii),auxvec(1))
7954 dip(kkk,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7961 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),dipj(1,iii),
7965 dipderx(lll,kkk,mmm,jj,i)=scalar2(dipi(1,jjj),auxvec(1))
7970 call transpose2(a_chuj(1,1,jj,i),auxmat(1,1))
7971 call matvec2(auxmat(1,1),dipderi(1),auxvec(1))
7973 dipderg(iii,jj,i)=scalar2(auxvec(1),dipj(1,iii))
7975 call matvec2(a_chuj(1,1,jj,i),dipderj(1),auxvec(1))
7977 dipderg(iii+2,jj,i)=scalar2(auxvec(1),dipi(1,iii))
7982 C---------------------------------------------------------------------------
7983 subroutine calc_eello(i,j,k,l,jj,kk)
7985 C This subroutine computes matrices and vectors needed to calculate
7986 C the fourth-, fifth-, and sixth-order local-electrostatic terms.
7988 implicit real*8 (a-h,o-z)
7989 include 'DIMENSIONS'
7990 include 'COMMON.IOUNITS'
7991 include 'COMMON.CHAIN'
7992 include 'COMMON.DERIV'
7993 include 'COMMON.INTERACT'
7994 include 'COMMON.CONTACTS'
7995 include 'COMMON.TORSION'
7996 include 'COMMON.VAR'
7997 include 'COMMON.GEO'
7998 include 'COMMON.FFIELD'
7999 double precision aa1(2,2),aa2(2,2),aa1t(2,2),aa2t(2,2),
8000 & aa1tder(2,2,3,5),aa2tder(2,2,3,5),auxmat(2,2)
8003 cd write (iout,*) 'calc_eello: i=',i,' j=',j,' k=',k,' l=',l,
8004 cd & ' jj=',jj,' kk=',kk
8005 cd if (i.ne.2 .or. j.ne.4 .or. k.ne.3 .or. l.ne.5) return
8006 cd write (iout,*) "a_chujij",((a_chuj(iii,jjj,jj,i),iii=1,2),jjj=1,2)
8007 cd write (iout,*) "a_chujkl",((a_chuj(iii,jjj,kk,k),iii=1,2),jjj=1,2)
8010 aa1(iii,jjj)=a_chuj(iii,jjj,jj,i)
8011 aa2(iii,jjj)=a_chuj(iii,jjj,kk,k)
8014 call transpose2(aa1(1,1),aa1t(1,1))
8015 call transpose2(aa2(1,1),aa2t(1,1))
8018 call transpose2(a_chuj_der(1,1,lll,kkk,jj,i),
8019 & aa1tder(1,1,lll,kkk))
8020 call transpose2(a_chuj_der(1,1,lll,kkk,kk,k),
8021 & aa2tder(1,1,lll,kkk))
8025 C parallel orientation of the two CA-CA-CA frames.
8027 iti=itortyp(itype(i))
8031 itk1=itortyp(itype(k+1))
8032 itj=itortyp(itype(j))
8033 if (l.lt.nres-1) then
8034 itl1=itortyp(itype(l+1))
8038 C A1 kernel(j+1) A2T
8040 cd write (iout,'(3f10.5,5x,3f10.5)')
8041 cd & (EUg(iii,jjj,k),jjj=1,2),(EUg(iii,jjj,l),jjj=1,2)
8043 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8044 & aa2tder(1,1,1,1),1,.false.,EUg(1,1,l),EUgder(1,1,l),
8045 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8046 C Following matrices are needed only for 6-th order cumulants
8047 IF (wcorr6.gt.0.0d0) THEN
8048 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8049 & aa2tder(1,1,1,1),1,.false.,EUgC(1,1,l),EUgCder(1,1,l),
8050 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8051 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8052 & aa2tder(1,1,1,1),2,.false.,Ug2DtEUg(1,1,l),
8053 & Ug2DtEUgder(1,1,1,l),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8054 & ADtEAderx(1,1,1,1,1,1))
8056 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8057 & aa2tder(1,1,1,1),2,.false.,DtUg2EUg(1,1,l),
8058 & DtUg2EUgder(1,1,1,l),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8059 & ADtEA1derx(1,1,1,1,1,1))
8061 C End 6-th order cumulants
8064 cd write (2,*) 'In calc_eello6'
8066 cd write (2,*) 'iii=',iii
8068 cd write (2,*) 'kkk=',kkk
8070 cd write (2,'(3(2f10.5),5x)')
8071 cd & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
8076 call transpose2(EUgder(1,1,k),auxmat(1,1))
8077 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8078 call transpose2(EUg(1,1,k),auxmat(1,1))
8079 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8080 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8084 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8085 & EAEAderx(1,1,lll,kkk,iii,1))
8089 C A1T kernel(i+1) A2
8090 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8091 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUg(1,1,k),EUgder(1,1,k),
8092 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8093 C Following matrices are needed only for 6-th order cumulants
8094 IF (wcorr6.gt.0.0d0) THEN
8095 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8096 & a_chuj_der(1,1,1,1,kk,k),1,.false.,EUgC(1,1,k),EUgCder(1,1,k),
8097 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8098 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8099 & a_chuj_der(1,1,1,1,kk,k),2,.false.,Ug2DtEUg(1,1,k),
8100 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8101 & ADtEAderx(1,1,1,1,1,2))
8102 call kernel(aa1t(1,1),aa2(1,1),aa1tder(1,1,1,1),
8103 & a_chuj_der(1,1,1,1,kk,k),2,.false.,DtUg2EUg(1,1,k),
8104 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8105 & ADtEA1derx(1,1,1,1,1,2))
8107 C End 6-th order cumulants
8108 call transpose2(EUgder(1,1,l),auxmat(1,1))
8109 call matmat2(auxmat(1,1),AEA(1,1,2),EAEAderg(1,1,1,2))
8110 call transpose2(EUg(1,1,l),auxmat(1,1))
8111 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8112 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8116 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8117 & EAEAderx(1,1,lll,kkk,iii,2))
8122 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8123 C They are needed only when the fifth- or the sixth-order cumulants are
8125 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0) THEN
8126 call transpose2(AEA(1,1,1),auxmat(1,1))
8127 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8128 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8129 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8130 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8131 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8132 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8133 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8134 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8135 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8136 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8137 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8138 call transpose2(AEA(1,1,2),auxmat(1,1))
8139 call matvec2(auxmat(1,1),b1(1,j),AEAb1(1,1,2))
8140 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2(1,1,2))
8141 call matvec2(auxmat(1,1),Ub2der(1,j),AEAb2derg(1,2,1,2))
8142 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8143 call matvec2(auxmat(1,1),b1(1,j),AEAb1derg(1,1,2))
8144 call matvec2(auxmat(1,1),Ub2(1,j),AEAb2derg(1,1,1,2))
8145 call matvec2(AEA(1,1,2),b1(1,l+1),AEAb1(1,2,2))
8146 call matvec2(AEAderg(1,1,2),b1(1,l+1),AEAb1derg(1,2,2))
8147 call matvec2(AEA(1,1,2),Ub2(1,l+1),AEAb2(1,2,2))
8148 call matvec2(AEAderg(1,1,2),Ub2(1,l+1),AEAb2derg(1,1,2,2))
8149 call matvec2(AEA(1,1,2),Ub2der(1,l+1),AEAb2derg(1,2,2,2))
8150 C Calculate the Cartesian derivatives of the vectors.
8154 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8155 call matvec2(auxmat(1,1),b1(1,i),
8156 & AEAb1derx(1,lll,kkk,iii,1,1))
8157 call matvec2(auxmat(1,1),Ub2(1,i),
8158 & AEAb2derx(1,lll,kkk,iii,1,1))
8159 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8160 & AEAb1derx(1,lll,kkk,iii,2,1))
8161 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8162 & AEAb2derx(1,lll,kkk,iii,2,1))
8163 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8164 call matvec2(auxmat(1,1),b1(1,j),
8165 & AEAb1derx(1,lll,kkk,iii,1,2))
8166 call matvec2(auxmat(1,1),Ub2(1,j),
8167 & AEAb2derx(1,lll,kkk,iii,1,2))
8168 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
8169 & AEAb1derx(1,lll,kkk,iii,2,2))
8170 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,l+1),
8171 & AEAb2derx(1,lll,kkk,iii,2,2))
8178 C Antiparallel orientation of the two CA-CA-CA frames.
8180 iti=itortyp(itype(i))
8184 itk1=itortyp(itype(k+1))
8185 itl=itortyp(itype(l))
8186 itj=itortyp(itype(j))
8187 if (j.lt.nres-1) then
8188 itj1=itortyp(itype(j+1))
8192 C A2 kernel(j-1)T A1T
8193 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8194 & aa2tder(1,1,1,1),1,.true.,EUg(1,1,j),EUgder(1,1,j),
8195 & AEA(1,1,1),AEAderg(1,1,1),AEAderx(1,1,1,1,1,1))
8196 C Following matrices are needed only for 6-th order cumulants
8197 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8198 & j.eq.i+4 .and. l.eq.i+3)) THEN
8199 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8200 & aa2tder(1,1,1,1),1,.true.,EUgC(1,1,j),EUgCder(1,1,j),
8201 & AECA(1,1,1),AECAderg(1,1,1),AECAderx(1,1,1,1,1,1))
8202 call kernel(aa2(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8203 & aa2tder(1,1,1,1),2,.true.,Ug2DtEUg(1,1,j),
8204 & Ug2DtEUgder(1,1,1,j),ADtEA(1,1,1),ADtEAderg(1,1,1,1),
8205 & ADtEAderx(1,1,1,1,1,1))
8206 call kernel(aa1(1,1),aa2t(1,1),a_chuj_der(1,1,1,1,jj,i),
8207 & aa2tder(1,1,1,1),2,.true.,DtUg2EUg(1,1,j),
8208 & DtUg2EUgder(1,1,1,j),ADtEA1(1,1,1),ADtEA1derg(1,1,1,1),
8209 & ADtEA1derx(1,1,1,1,1,1))
8211 C End 6-th order cumulants
8212 call transpose2(EUgder(1,1,k),auxmat(1,1))
8213 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,1,1))
8214 call transpose2(EUg(1,1,k),auxmat(1,1))
8215 call matmat2(auxmat(1,1),AEA(1,1,1),EAEA(1,1,1))
8216 call matmat2(auxmat(1,1),AEAderg(1,1,1),EAEAderg(1,1,2,1))
8220 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8221 & EAEAderx(1,1,lll,kkk,iii,1))
8225 C A2T kernel(i+1)T A1
8226 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8227 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUg(1,1,k),EUgder(1,1,k),
8228 & AEA(1,1,2),AEAderg(1,1,2),AEAderx(1,1,1,1,1,2))
8229 C Following matrices are needed only for 6-th order cumulants
8230 IF (wcorr6.gt.0.0d0 .or. (wturn6.gt.0.0d0 .and.
8231 & j.eq.i+4 .and. l.eq.i+3)) THEN
8232 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8233 & a_chuj_der(1,1,1,1,jj,i),1,.true.,EUgC(1,1,k),EUgCder(1,1,k),
8234 & AECA(1,1,2),AECAderg(1,1,2),AECAderx(1,1,1,1,1,2))
8235 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8236 & a_chuj_der(1,1,1,1,jj,i),2,.true.,Ug2DtEUg(1,1,k),
8237 & Ug2DtEUgder(1,1,1,k),ADtEA(1,1,2),ADtEAderg(1,1,1,2),
8238 & ADtEAderx(1,1,1,1,1,2))
8239 call kernel(aa2t(1,1),aa1(1,1),aa2tder(1,1,1,1),
8240 & a_chuj_der(1,1,1,1,jj,i),2,.true.,DtUg2EUg(1,1,k),
8241 & DtUg2EUgder(1,1,1,k),ADtEA1(1,1,2),ADtEA1derg(1,1,1,2),
8242 & ADtEA1derx(1,1,1,1,1,2))
8244 C End 6-th order cumulants
8245 call transpose2(EUgder(1,1,j),auxmat(1,1))
8246 call matmat2(auxmat(1,1),AEA(1,1,1),EAEAderg(1,1,2,2))
8247 call transpose2(EUg(1,1,j),auxmat(1,1))
8248 call matmat2(auxmat(1,1),AEA(1,1,2),EAEA(1,1,2))
8249 call matmat2(auxmat(1,1),AEAderg(1,1,2),EAEAderg(1,1,2,2))
8253 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8254 & EAEAderx(1,1,lll,kkk,iii,2))
8259 C Calculate the vectors and their derivatives in virtual-bond dihedral angles.
8260 C They are needed only when the fifth- or the sixth-order cumulants are
8262 IF (wcorr5.gt.0.0d0 .or. wcorr6.gt.0.0d0 .or.
8263 & (wturn6.gt.0.0d0 .and. j.eq.i+4 .and. l.eq.i+3)) THEN
8264 call transpose2(AEA(1,1,1),auxmat(1,1))
8265 call matvec2(auxmat(1,1),b1(1,i),AEAb1(1,1,1))
8266 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2(1,1,1))
8267 call matvec2(auxmat(1,1),Ub2der(1,i),AEAb2derg(1,2,1,1))
8268 call transpose2(AEAderg(1,1,1),auxmat(1,1))
8269 call matvec2(auxmat(1,1),b1(1,i),AEAb1derg(1,1,1))
8270 call matvec2(auxmat(1,1),Ub2(1,i),AEAb2derg(1,1,1,1))
8271 call matvec2(AEA(1,1,1),b1(1,k+1),AEAb1(1,2,1))
8272 call matvec2(AEAderg(1,1,1),b1(1,k+1),AEAb1derg(1,2,1))
8273 call matvec2(AEA(1,1,1),Ub2(1,k+1),AEAb2(1,2,1))
8274 call matvec2(AEAderg(1,1,1),Ub2(1,k+1),AEAb2derg(1,1,2,1))
8275 call matvec2(AEA(1,1,1),Ub2der(1,k+1),AEAb2derg(1,2,2,1))
8276 call transpose2(AEA(1,1,2),auxmat(1,1))
8277 call matvec2(auxmat(1,1),b1(1,j+1),AEAb1(1,1,2))
8278 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2(1,1,2))
8279 call matvec2(auxmat(1,1),Ub2der(1,l),AEAb2derg(1,2,1,2))
8280 call transpose2(AEAderg(1,1,2),auxmat(1,1))
8281 call matvec2(auxmat(1,1),b1(1,l),AEAb1(1,1,2))
8282 call matvec2(auxmat(1,1),Ub2(1,l),AEAb2derg(1,1,1,2))
8283 call matvec2(AEA(1,1,2),b1(1,j+1),AEAb1(1,2,2))
8284 call matvec2(AEAderg(1,1,2),b1(1,j+1),AEAb1derg(1,2,2))
8285 call matvec2(AEA(1,1,2),Ub2(1,j),AEAb2(1,2,2))
8286 call matvec2(AEAderg(1,1,2),Ub2(1,j),AEAb2derg(1,1,2,2))
8287 call matvec2(AEA(1,1,2),Ub2der(1,j),AEAb2derg(1,2,2,2))
8288 C Calculate the Cartesian derivatives of the vectors.
8292 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1))
8293 call matvec2(auxmat(1,1),b1(1,i),
8294 & AEAb1derx(1,lll,kkk,iii,1,1))
8295 call matvec2(auxmat(1,1),Ub2(1,i),
8296 & AEAb2derx(1,lll,kkk,iii,1,1))
8297 call matvec2(AEAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
8298 & AEAb1derx(1,lll,kkk,iii,2,1))
8299 call matvec2(AEAderx(1,1,lll,kkk,iii,1),Ub2(1,k+1),
8300 & AEAb2derx(1,lll,kkk,iii,2,1))
8301 call transpose2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1))
8302 call matvec2(auxmat(1,1),b1(1,l),
8303 & AEAb1derx(1,lll,kkk,iii,1,2))
8304 call matvec2(auxmat(1,1),Ub2(1,l),
8305 & AEAb2derx(1,lll,kkk,iii,1,2))
8306 call matvec2(AEAderx(1,1,lll,kkk,iii,2),b1(1,j+1),
8307 & AEAb1derx(1,lll,kkk,iii,2,2))
8308 call matvec2(AEAderx(1,1,lll,kkk,iii,2),Ub2(1,j),
8309 & AEAb2derx(1,lll,kkk,iii,2,2))
8318 C---------------------------------------------------------------------------
8319 subroutine kernel(aa1,aa2t,aa1derx,aa2tderx,nderg,transp,
8320 & KK,KKderg,AKA,AKAderg,AKAderx)
8324 double precision aa1(2,2),aa2t(2,2),aa1derx(2,2,3,5),
8325 & aa2tderx(2,2,3,5),KK(2,2),KKderg(2,2,nderg),AKA(2,2),
8326 & AKAderg(2,2,nderg),AKAderx(2,2,3,5,2)
8331 call prodmat3(aa1(1,1),aa2t(1,1),KK(1,1),transp,AKA(1,1))
8333 call prodmat3(aa1(1,1),aa2t(1,1),KKderg(1,1,iii),transp,
8336 cd if (lprn) write (2,*) 'In kernel'
8338 cd if (lprn) write (2,*) 'kkk=',kkk
8340 call prodmat3(aa1derx(1,1,lll,kkk),aa2t(1,1),
8341 & KK(1,1),transp,AKAderx(1,1,lll,kkk,1))
8343 cd write (2,*) 'lll=',lll
8344 cd write (2,*) 'iii=1'
8346 cd write (2,'(3(2f10.5),5x)')
8347 cd & (AKAderx(jjj,mmm,lll,kkk,1),mmm=1,2)
8350 call prodmat3(aa1(1,1),aa2tderx(1,1,lll,kkk),
8351 & KK(1,1),transp,AKAderx(1,1,lll,kkk,2))
8353 cd write (2,*) 'lll=',lll
8354 cd write (2,*) 'iii=2'
8356 cd write (2,'(3(2f10.5),5x)')
8357 cd & (AKAderx(jjj,mmm,lll,kkk,2),mmm=1,2)
8364 C---------------------------------------------------------------------------
8365 double precision function eello4(i,j,k,l,jj,kk)
8366 implicit real*8 (a-h,o-z)
8367 include 'DIMENSIONS'
8368 include 'COMMON.IOUNITS'
8369 include 'COMMON.CHAIN'
8370 include 'COMMON.DERIV'
8371 include 'COMMON.INTERACT'
8372 include 'COMMON.CONTACTS'
8373 include 'COMMON.TORSION'
8374 include 'COMMON.VAR'
8375 include 'COMMON.GEO'
8376 double precision pizda(2,2),ggg1(3),ggg2(3)
8377 cd if (i.ne.1 .or. j.ne.5 .or. k.ne.2 .or.l.ne.4) then
8381 cd print *,'eello4:',i,j,k,l,jj,kk
8382 cd write (2,*) 'i',i,' j',j,' k',k,' l',l
8383 cd call checkint4(i,j,k,l,jj,kk,eel4_num)
8384 cold eij=facont_hb(jj,i)
8385 cold ekl=facont_hb(kk,k)
8387 eel4=-EAEA(1,1,1)-EAEA(2,2,1)
8388 cd eel41=-EAEA(1,1,2)-EAEA(2,2,2)
8389 gcorr_loc(k-1)=gcorr_loc(k-1)
8390 & -ekont*(EAEAderg(1,1,1,1)+EAEAderg(2,2,1,1))
8392 gcorr_loc(l-1)=gcorr_loc(l-1)
8393 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8395 gcorr_loc(j-1)=gcorr_loc(j-1)
8396 & -ekont*(EAEAderg(1,1,2,1)+EAEAderg(2,2,2,1))
8401 derx(lll,kkk,iii)=-EAEAderx(1,1,lll,kkk,iii,1)
8402 & -EAEAderx(2,2,lll,kkk,iii,1)
8403 cd derx(lll,kkk,iii)=0.0d0
8407 cd gcorr_loc(l-1)=0.0d0
8408 cd gcorr_loc(j-1)=0.0d0
8409 cd gcorr_loc(k-1)=0.0d0
8411 cd write (iout,*)'Contacts have occurred for peptide groups',
8412 cd & i,j,' fcont:',eij,' eij',' and ',k,l,
8413 cd & ' fcont ',ekl,' eel4=',eel4,' eel4_num',16*eel4_num
8414 if (j.lt.nres-1) then
8421 if (l.lt.nres-1) then
8429 cgrad ggg1(ll)=eel4*g_contij(ll,1)
8430 cgrad ggg2(ll)=eel4*g_contij(ll,2)
8431 glongij=eel4*g_contij(ll,1)+ekont*derx(ll,1,1)
8432 glongkl=eel4*g_contij(ll,2)+ekont*derx(ll,1,2)
8433 cgrad ghalf=0.5d0*ggg1(ll)
8434 gradcorr(ll,i)=gradcorr(ll,i)+ekont*derx(ll,2,1)
8435 gradcorr(ll,i+1)=gradcorr(ll,i+1)+ekont*derx(ll,3,1)
8436 gradcorr(ll,j)=gradcorr(ll,j)+ekont*derx(ll,4,1)
8437 gradcorr(ll,j1)=gradcorr(ll,j1)+ekont*derx(ll,5,1)
8438 gradcorr_long(ll,j)=gradcorr_long(ll,j)+glongij
8439 gradcorr_long(ll,i)=gradcorr_long(ll,i)-glongij
8440 cgrad ghalf=0.5d0*ggg2(ll)
8441 gradcorr(ll,k)=gradcorr(ll,k)+ekont*derx(ll,2,2)
8442 gradcorr(ll,k+1)=gradcorr(ll,k+1)+ekont*derx(ll,3,2)
8443 gradcorr(ll,l)=gradcorr(ll,l)+ekont*derx(ll,4,2)
8444 gradcorr(ll,l1)=gradcorr(ll,l1)+ekont*derx(ll,5,2)
8445 gradcorr_long(ll,l)=gradcorr_long(ll,l)+glongkl
8446 gradcorr_long(ll,k)=gradcorr_long(ll,k)-glongkl
8450 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg1(ll)
8455 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ggg2(ll)
8460 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,1)
8465 cgrad gradcorr(ll,m)=gradcorr(ll,m)+ekont*derx(ll,1,2)
8469 cd write (2,*) iii,gcorr_loc(iii)
8472 cd write (2,*) 'ekont',ekont
8473 cd write (iout,*) 'eello4',ekont*eel4
8476 C---------------------------------------------------------------------------
8477 double precision function eello5(i,j,k,l,jj,kk)
8478 implicit real*8 (a-h,o-z)
8479 include 'DIMENSIONS'
8480 include 'COMMON.IOUNITS'
8481 include 'COMMON.CHAIN'
8482 include 'COMMON.DERIV'
8483 include 'COMMON.INTERACT'
8484 include 'COMMON.CONTACTS'
8485 include 'COMMON.TORSION'
8486 include 'COMMON.VAR'
8487 include 'COMMON.GEO'
8488 double precision pizda(2,2),auxmat(2,2),auxmat1(2,2),vv(2)
8489 double precision ggg1(3),ggg2(3)
8490 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8495 C /l\ / \ \ / \ / \ / C
8496 C / \ / \ \ / \ / \ / C
8497 C j| o |l1 | o | o| o | | o |o C
8498 C \ |/k\| |/ \| / |/ \| |/ \| C
8499 C \i/ \ / \ / / \ / \ C
8501 C (I) (II) (III) (IV) C
8503 C eello5_1 eello5_2 eello5_3 eello5_4 C
8505 C Antiparallel chains C
8508 C /j\ / \ \ / \ / \ / C
8509 C / \ / \ \ / \ / \ / C
8510 C j1| o |l | o | o| o | | o |o C
8511 C \ |/k\| |/ \| / |/ \| |/ \| C
8512 C \i/ \ / \ / / \ / \ C
8514 C (I) (II) (III) (IV) C
8516 C eello5_1 eello5_2 eello5_3 eello5_4 C
8518 C o denotes a local interaction, vertical lines an electrostatic interaction. C
8520 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
8521 cd if (i.ne.2 .or. j.ne.6 .or. k.ne.3 .or. l.ne.5) then
8526 cd & 'EELLO5: Contacts have occurred for peptide groups',i,j,
8528 itk=itortyp(itype(k))
8529 itl=itortyp(itype(l))
8530 itj=itortyp(itype(j))
8535 cd call checkint5(i,j,k,l,jj,kk,eel5_1_num,eel5_2_num,
8536 cd & eel5_3_num,eel5_4_num)
8540 derx(lll,kkk,iii)=0.0d0
8544 cd eij=facont_hb(jj,i)
8545 cd ekl=facont_hb(kk,k)
8547 cd write (iout,*)'Contacts have occurred for peptide groups',
8548 cd & i,j,' fcont:',eij,' eij',' and ',k,l
8550 C Contribution from the graph I.
8551 cd write (2,*) 'AEA ',AEA(1,1,1),AEA(2,1,1),AEA(1,2,1),AEA(2,2,1)
8552 cd write (2,*) 'AEAb2',AEAb2(1,1,1),AEAb2(2,1,1)
8553 call transpose2(EUg(1,1,k),auxmat(1,1))
8554 call matmat2(AEA(1,1,1),auxmat(1,1),pizda(1,1))
8555 vv(1)=pizda(1,1)-pizda(2,2)
8556 vv(2)=pizda(1,2)+pizda(2,1)
8557 eello5_1=scalar2(AEAb2(1,1,1),Ub2(1,k))
8558 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8559 C Explicit gradient in virtual-dihedral angles.
8560 if (i.gt.1) g_corr5_loc(i-1)=g_corr5_loc(i-1)
8561 & +ekont*(scalar2(AEAb2derg(1,2,1,1),Ub2(1,k))
8562 & +0.5d0*scalar2(vv(1),Dtobr2der(1,i)))
8563 call transpose2(EUgder(1,1,k),auxmat1(1,1))
8564 call matmat2(AEA(1,1,1),auxmat1(1,1),pizda(1,1))
8565 vv(1)=pizda(1,1)-pizda(2,2)
8566 vv(2)=pizda(1,2)+pizda(2,1)
8567 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8568 & +ekont*(scalar2(AEAb2(1,1,1),Ub2der(1,k))
8569 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8570 call matmat2(AEAderg(1,1,1),auxmat(1,1),pizda(1,1))
8571 vv(1)=pizda(1,1)-pizda(2,2)
8572 vv(2)=pizda(1,2)+pizda(2,1)
8574 if (l.lt.nres-1) g_corr5_loc(l-1)=g_corr5_loc(l-1)
8575 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8576 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8578 if (j.lt.nres-1) g_corr5_loc(j-1)=g_corr5_loc(j-1)
8579 & +ekont*(scalar2(AEAb2derg(1,1,1,1),Ub2(1,k))
8580 & +0.5d0*scalar2(vv(1),Dtobr2(1,i)))
8582 C Cartesian gradient
8586 call matmat2(AEAderx(1,1,lll,kkk,iii,1),auxmat(1,1),
8588 vv(1)=pizda(1,1)-pizda(2,2)
8589 vv(2)=pizda(1,2)+pizda(2,1)
8590 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8591 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,1),Ub2(1,k))
8592 & +0.5d0*scalar2(vv(1),Dtobr2(1,i))
8598 C Contribution from graph II
8599 call transpose2(EE(1,1,itk),auxmat(1,1))
8600 call matmat2(auxmat(1,1),AEA(1,1,1),pizda(1,1))
8601 vv(1)=pizda(1,1)+pizda(2,2)
8602 vv(2)=pizda(2,1)-pizda(1,2)
8603 eello5_2=scalar2(AEAb1(1,2,1),b1(1,k))
8604 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8605 C Explicit gradient in virtual-dihedral angles.
8606 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8607 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,k))
8608 call matmat2(auxmat(1,1),AEAderg(1,1,1),pizda(1,1))
8609 vv(1)=pizda(1,1)+pizda(2,2)
8610 vv(2)=pizda(2,1)-pizda(1,2)
8612 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8613 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8614 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8616 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8617 & +ekont*(scalar2(AEAb1derg(1,2,1),b1(1,k))
8618 & -0.5d0*scalar2(vv(1),Ctobr(1,k)))
8620 C Cartesian gradient
8624 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,1),
8626 vv(1)=pizda(1,1)+pizda(2,2)
8627 vv(2)=pizda(2,1)-pizda(1,2)
8628 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8629 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,1),b1(1,k))
8630 & -0.5d0*scalar2(vv(1),Ctobr(1,k))
8638 C Parallel orientation
8639 C Contribution from graph III
8640 call transpose2(EUg(1,1,l),auxmat(1,1))
8641 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8642 vv(1)=pizda(1,1)-pizda(2,2)
8643 vv(2)=pizda(1,2)+pizda(2,1)
8644 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,l))
8645 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8646 C Explicit gradient in virtual-dihedral angles.
8647 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8648 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,l))
8649 & +0.5d0*scalar2(vv(1),Dtobr2der(1,j)))
8650 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8651 vv(1)=pizda(1,1)-pizda(2,2)
8652 vv(2)=pizda(1,2)+pizda(2,1)
8653 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8654 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,l))
8655 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8656 call transpose2(EUgder(1,1,l),auxmat1(1,1))
8657 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8658 vv(1)=pizda(1,1)-pizda(2,2)
8659 vv(2)=pizda(1,2)+pizda(2,1)
8660 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8661 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,l))
8662 & +0.5d0*scalar2(vv(1),Dtobr2(1,j)))
8663 C Cartesian gradient
8667 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8669 vv(1)=pizda(1,1)-pizda(2,2)
8670 vv(2)=pizda(1,2)+pizda(2,1)
8671 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8672 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,l))
8673 & +0.5d0*scalar2(vv(1),Dtobr2(1,j))
8678 C Contribution from graph IV
8680 call transpose2(EE(1,1,itl),auxmat(1,1))
8681 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8682 vv(1)=pizda(1,1)+pizda(2,2)
8683 vv(2)=pizda(2,1)-pizda(1,2)
8684 eello5_4=scalar2(AEAb1(1,2,2),b1(1,l))
8685 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8686 C Explicit gradient in virtual-dihedral angles.
8687 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8688 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,l))
8689 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8690 vv(1)=pizda(1,1)+pizda(2,2)
8691 vv(2)=pizda(2,1)-pizda(1,2)
8692 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8693 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,l))
8694 & -0.5d0*scalar2(vv(1),Ctobr(1,l)))
8695 C Cartesian gradient
8699 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8701 vv(1)=pizda(1,1)+pizda(2,2)
8702 vv(2)=pizda(2,1)-pizda(1,2)
8703 derx(lll,kkk,iii)=derx(lll,kkk,iii)
8704 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,l))
8705 & -0.5d0*scalar2(vv(1),Ctobr(1,l))
8710 C Antiparallel orientation
8711 C Contribution from graph III
8713 call transpose2(EUg(1,1,j),auxmat(1,1))
8714 call matmat2(AEA(1,1,2),auxmat(1,1),pizda(1,1))
8715 vv(1)=pizda(1,1)-pizda(2,2)
8716 vv(2)=pizda(1,2)+pizda(2,1)
8717 eello5_3=scalar2(AEAb2(1,1,2),Ub2(1,j))
8718 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8719 C Explicit gradient in virtual-dihedral angles.
8720 g_corr5_loc(l-1)=g_corr5_loc(l-1)
8721 & +ekont*(scalar2(AEAb2derg(1,2,1,2),Ub2(1,j))
8722 & +0.5d0*scalar2(vv(1),Dtobr2der(1,l)))
8723 call matmat2(AEAderg(1,1,2),auxmat(1,1),pizda(1,1))
8724 vv(1)=pizda(1,1)-pizda(2,2)
8725 vv(2)=pizda(1,2)+pizda(2,1)
8726 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8727 & +ekont*(scalar2(AEAb2derg(1,1,1,2),Ub2(1,j))
8728 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8729 call transpose2(EUgder(1,1,j),auxmat1(1,1))
8730 call matmat2(AEA(1,1,2),auxmat1(1,1),pizda(1,1))
8731 vv(1)=pizda(1,1)-pizda(2,2)
8732 vv(2)=pizda(1,2)+pizda(2,1)
8733 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8734 & +ekont*(scalar2(AEAb2(1,1,2),Ub2der(1,j))
8735 & +0.5d0*scalar2(vv(1),Dtobr2(1,l)))
8736 C Cartesian gradient
8740 call matmat2(AEAderx(1,1,lll,kkk,iii,2),auxmat(1,1),
8742 vv(1)=pizda(1,1)-pizda(2,2)
8743 vv(2)=pizda(1,2)+pizda(2,1)
8744 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8745 & +scalar2(AEAb2derx(1,lll,kkk,iii,1,2),Ub2(1,j))
8746 & +0.5d0*scalar2(vv(1),Dtobr2(1,l))
8751 C Contribution from graph IV
8753 call transpose2(EE(1,1,itj),auxmat(1,1))
8754 call matmat2(auxmat(1,1),AEA(1,1,2),pizda(1,1))
8755 vv(1)=pizda(1,1)+pizda(2,2)
8756 vv(2)=pizda(2,1)-pizda(1,2)
8757 eello5_4=scalar2(AEAb1(1,2,2),b1(1,j))
8758 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8759 C Explicit gradient in virtual-dihedral angles.
8760 g_corr5_loc(j-1)=g_corr5_loc(j-1)
8761 & -0.5d0*ekont*scalar2(vv(1),Ctobrder(1,j))
8762 call matmat2(auxmat(1,1),AEAderg(1,1,2),pizda(1,1))
8763 vv(1)=pizda(1,1)+pizda(2,2)
8764 vv(2)=pizda(2,1)-pizda(1,2)
8765 g_corr5_loc(k-1)=g_corr5_loc(k-1)
8766 & +ekont*(scalar2(AEAb1derg(1,2,2),b1(1,j))
8767 & -0.5d0*scalar2(vv(1),Ctobr(1,j)))
8768 C Cartesian gradient
8772 call matmat2(auxmat(1,1),AEAderx(1,1,lll,kkk,iii,2),
8774 vv(1)=pizda(1,1)+pizda(2,2)
8775 vv(2)=pizda(2,1)-pizda(1,2)
8776 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)
8777 & +scalar2(AEAb1derx(1,lll,kkk,iii,2,2),b1(1,j))
8778 & -0.5d0*scalar2(vv(1),Ctobr(1,j))
8784 eel5=eello5_1+eello5_2+eello5_3+eello5_4
8785 cd if (i.eq.2 .and. j.eq.8 .and. k.eq.3 .and. l.eq.7) then
8786 cd write (2,*) 'ijkl',i,j,k,l
8787 cd write (2,*) 'eello5_1',eello5_1,' eello5_2',eello5_2,
8788 cd & ' eello5_3',eello5_3,' eello5_4',eello5_4
8790 cd write(iout,*) 'eello5_1',eello5_1,' eel5_1_num',16*eel5_1_num
8791 cd write(iout,*) 'eello5_2',eello5_2,' eel5_2_num',16*eel5_2_num
8792 cd write(iout,*) 'eello5_3',eello5_3,' eel5_3_num',16*eel5_3_num
8793 cd write(iout,*) 'eello5_4',eello5_4,' eel5_4_num',16*eel5_4_num
8794 if (j.lt.nres-1) then
8801 if (l.lt.nres-1) then
8811 cd write (2,*) 'eij',eij,' ekl',ekl,' ekont',ekont
8812 C 2/11/08 AL Gradients over DC's connecting interacting sites will be
8813 C summed up outside the subrouine as for the other subroutines
8814 C handling long-range interactions. The old code is commented out
8815 C with "cgrad" to keep track of changes.
8817 cgrad ggg1(ll)=eel5*g_contij(ll,1)
8818 cgrad ggg2(ll)=eel5*g_contij(ll,2)
8819 gradcorr5ij=eel5*g_contij(ll,1)+ekont*derx(ll,1,1)
8820 gradcorr5kl=eel5*g_contij(ll,2)+ekont*derx(ll,1,2)
8821 c write (iout,'(a,3i3,a,5f8.3,2i3,a,5f8.3,a,f8.3)')
8822 c & "ecorr5",ll,i,j," derx",derx(ll,2,1),derx(ll,3,1),derx(ll,4,1),
8823 c & derx(ll,5,1),k,l," derx",derx(ll,2,2),derx(ll,3,2),
8824 c & derx(ll,4,2),derx(ll,5,2)," ekont",ekont
8825 c write (iout,'(a,3i3,a,3f8.3,2i3,a,3f8.3)')
8826 c & "ecorr5",ll,i,j," gradcorr5",g_contij(ll,1),derx(ll,1,1),
8828 c & k,l," gradcorr5",g_contij(ll,2),derx(ll,1,2),gradcorr5kl
8829 cold ghalf=0.5d0*eel5*ekl*gacont_hbr(ll,jj,i)
8830 cgrad ghalf=0.5d0*ggg1(ll)
8832 gradcorr5(ll,i)=gradcorr5(ll,i)+ekont*derx(ll,2,1)
8833 gradcorr5(ll,i+1)=gradcorr5(ll,i+1)+ekont*derx(ll,3,1)
8834 gradcorr5(ll,j)=gradcorr5(ll,j)+ekont*derx(ll,4,1)
8835 gradcorr5(ll,j1)=gradcorr5(ll,j1)+ekont*derx(ll,5,1)
8836 gradcorr5_long(ll,j)=gradcorr5_long(ll,j)+gradcorr5ij
8837 gradcorr5_long(ll,i)=gradcorr5_long(ll,i)-gradcorr5ij
8838 cold ghalf=0.5d0*eel5*eij*gacont_hbr(ll,kk,k)
8839 cgrad ghalf=0.5d0*ggg2(ll)
8841 gradcorr5(ll,k)=gradcorr5(ll,k)+ghalf+ekont*derx(ll,2,2)
8842 gradcorr5(ll,k+1)=gradcorr5(ll,k+1)+ekont*derx(ll,3,2)
8843 gradcorr5(ll,l)=gradcorr5(ll,l)+ghalf+ekont*derx(ll,4,2)
8844 gradcorr5(ll,l1)=gradcorr5(ll,l1)+ekont*derx(ll,5,2)
8845 gradcorr5_long(ll,l)=gradcorr5_long(ll,l)+gradcorr5kl
8846 gradcorr5_long(ll,k)=gradcorr5_long(ll,k)-gradcorr5kl
8851 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*ekl*gacont_hbr(ll,jj,i)
8852 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg1(ll)
8857 cold gradcorr5(ll,m)=gradcorr5(ll,m)+eel5*eij*gacont_hbr(ll,kk,k)
8858 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ggg2(ll)
8864 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,1)
8869 cgrad gradcorr5(ll,m)=gradcorr5(ll,m)+ekont*derx(ll,1,2)
8873 cd write (2,*) iii,g_corr5_loc(iii)
8876 cd write (2,*) 'ekont',ekont
8877 cd write (iout,*) 'eello5',ekont*eel5
8880 c--------------------------------------------------------------------------
8881 double precision function eello6(i,j,k,l,jj,kk)
8882 implicit real*8 (a-h,o-z)
8883 include 'DIMENSIONS'
8884 include 'COMMON.IOUNITS'
8885 include 'COMMON.CHAIN'
8886 include 'COMMON.DERIV'
8887 include 'COMMON.INTERACT'
8888 include 'COMMON.CONTACTS'
8889 include 'COMMON.TORSION'
8890 include 'COMMON.VAR'
8891 include 'COMMON.GEO'
8892 include 'COMMON.FFIELD'
8893 double precision ggg1(3),ggg2(3)
8894 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
8899 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
8907 cd call checkint6(i,j,k,l,jj,kk,eel6_1_num,eel6_2_num,
8908 cd & eel6_3_num,eel6_4_num,eel6_5_num,eel6_6_num)
8912 derx(lll,kkk,iii)=0.0d0
8916 cd eij=facont_hb(jj,i)
8917 cd ekl=facont_hb(kk,k)
8923 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8924 eello6_2=eello6_graph1(j,i,l,k,2,.false.)
8925 eello6_3=eello6_graph2(i,j,k,l,jj,kk,.false.)
8926 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8927 eello6_5=eello6_graph4(j,i,l,k,jj,kk,2,.false.)
8928 eello6_6=eello6_graph3(i,j,k,l,jj,kk,.false.)
8930 eello6_1=eello6_graph1(i,j,k,l,1,.false.)
8931 eello6_2=eello6_graph1(l,k,j,i,2,.true.)
8932 eello6_3=eello6_graph2(i,l,k,j,jj,kk,.true.)
8933 eello6_4=eello6_graph4(i,j,k,l,jj,kk,1,.false.)
8934 if (wturn6.eq.0.0d0 .or. j.ne.i+4) then
8935 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
8939 eello6_6=eello6_graph3(i,l,k,j,jj,kk,.true.)
8941 C If turn contributions are considered, they will be handled separately.
8942 eel6=eello6_1+eello6_2+eello6_3+eello6_4+eello6_5+eello6_6
8943 cd write(iout,*) 'eello6_1',eello6_1!,' eel6_1_num',16*eel6_1_num
8944 cd write(iout,*) 'eello6_2',eello6_2!,' eel6_2_num',16*eel6_2_num
8945 cd write(iout,*) 'eello6_3',eello6_3!,' eel6_3_num',16*eel6_3_num
8946 cd write(iout,*) 'eello6_4',eello6_4!,' eel6_4_num',16*eel6_4_num
8947 cd write(iout,*) 'eello6_5',eello6_5!,' eel6_5_num',16*eel6_5_num
8948 cd write(iout,*) 'eello6_6',eello6_6!,' eel6_6_num',16*eel6_6_num
8950 if (j.lt.nres-1) then
8957 if (l.lt.nres-1) then
8965 cgrad ggg1(ll)=eel6*g_contij(ll,1)
8966 cgrad ggg2(ll)=eel6*g_contij(ll,2)
8967 cold ghalf=0.5d0*eel6*ekl*gacont_hbr(ll,jj,i)
8968 cgrad ghalf=0.5d0*ggg1(ll)
8970 gradcorr6ij=eel6*g_contij(ll,1)+ekont*derx(ll,1,1)
8971 gradcorr6kl=eel6*g_contij(ll,2)+ekont*derx(ll,1,2)
8972 gradcorr6(ll,i)=gradcorr6(ll,i)+ekont*derx(ll,2,1)
8973 gradcorr6(ll,i+1)=gradcorr6(ll,i+1)+ekont*derx(ll,3,1)
8974 gradcorr6(ll,j)=gradcorr6(ll,j)+ekont*derx(ll,4,1)
8975 gradcorr6(ll,j1)=gradcorr6(ll,j1)+ekont*derx(ll,5,1)
8976 gradcorr6_long(ll,j)=gradcorr6_long(ll,j)+gradcorr6ij
8977 gradcorr6_long(ll,i)=gradcorr6_long(ll,i)-gradcorr6ij
8978 cgrad ghalf=0.5d0*ggg2(ll)
8979 cold ghalf=0.5d0*eel6*eij*gacont_hbr(ll,kk,k)
8981 gradcorr6(ll,k)=gradcorr6(ll,k)+ekont*derx(ll,2,2)
8982 gradcorr6(ll,k+1)=gradcorr6(ll,k+1)+ekont*derx(ll,3,2)
8983 gradcorr6(ll,l)=gradcorr6(ll,l)+ekont*derx(ll,4,2)
8984 gradcorr6(ll,l1)=gradcorr6(ll,l1)+ekont*derx(ll,5,2)
8985 gradcorr6_long(ll,l)=gradcorr6_long(ll,l)+gradcorr6kl
8986 gradcorr6_long(ll,k)=gradcorr6_long(ll,k)-gradcorr6kl
8991 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*ekl*gacont_hbr(ll,jj,i)
8992 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg1(ll)
8997 cold gradcorr6(ll,m)=gradcorr6(ll,m)+eel6*eij*gacont_hbr(ll,kk,k)
8998 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ggg2(ll)
9004 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,1)
9009 cgrad gradcorr6(ll,m)=gradcorr6(ll,m)+ekont*derx(ll,1,2)
9013 cd write (2,*) iii,g_corr6_loc(iii)
9016 cd write (2,*) 'ekont',ekont
9017 cd write (iout,*) 'eello6',ekont*eel6
9020 c--------------------------------------------------------------------------
9021 double precision function eello6_graph1(i,j,k,l,imat,swap)
9022 implicit real*8 (a-h,o-z)
9023 include 'DIMENSIONS'
9024 include 'COMMON.IOUNITS'
9025 include 'COMMON.CHAIN'
9026 include 'COMMON.DERIV'
9027 include 'COMMON.INTERACT'
9028 include 'COMMON.CONTACTS'
9029 include 'COMMON.TORSION'
9030 include 'COMMON.VAR'
9031 include 'COMMON.GEO'
9032 double precision vv(2),vv1(2),pizda(2,2),auxmat(2,2),pizda1(2,2)
9036 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9038 C Parallel Antiparallel C
9044 C \ j|/k\| / \ |/k\|l / C
9049 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9050 itk=itortyp(itype(k))
9051 s1= scalar2(AEAb1(1,2,imat),CUgb2(1,i))
9052 s2=-scalar2(AEAb2(1,1,imat),Ug2Db1t(1,k))
9053 s3= scalar2(AEAb2(1,1,imat),CUgb2(1,k))
9054 call transpose2(EUgC(1,1,k),auxmat(1,1))
9055 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9056 vv1(1)=pizda1(1,1)-pizda1(2,2)
9057 vv1(2)=pizda1(1,2)+pizda1(2,1)
9058 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9059 vv(1)=AEAb1(1,2,imat)*b1(1,k)-AEAb1(2,2,imat)*b1(2,k)
9060 vv(2)=AEAb1(1,2,imat)*b1(2,k)+AEAb1(2,2,imat)*b1(1,k)
9061 s5=scalar2(vv(1),Dtobr2(1,i))
9062 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4', s4,' s5',s5
9063 eello6_graph1=-0.5d0*(s1+s2+s3+s4+s5)
9064 if (i.gt.1) g_corr6_loc(i-1)=g_corr6_loc(i-1)
9065 & -0.5d0*ekont*(scalar2(AEAb1(1,2,imat),CUgb2der(1,i))
9066 & -scalar2(AEAb2derg(1,2,1,imat),Ug2Db1t(1,k))
9067 & +scalar2(AEAb2derg(1,2,1,imat),CUgb2(1,k))
9068 & +0.5d0*scalar2(vv1(1),Dtobr2der(1,i))
9069 & +scalar2(vv(1),Dtobr2der(1,i)))
9070 call matmat2(AEAderg(1,1,imat),auxmat(1,1),pizda1(1,1))
9071 vv1(1)=pizda1(1,1)-pizda1(2,2)
9072 vv1(2)=pizda1(1,2)+pizda1(2,1)
9073 vv(1)=AEAb1derg(1,2,imat)*b1(1,k)-AEAb1derg(2,2,imat)*b1(2,k)
9074 vv(2)=AEAb1derg(1,2,imat)*b1(2,k)+AEAb1derg(2,2,imat)*b1(1,k)
9076 g_corr6_loc(l-1)=g_corr6_loc(l-1)
9077 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9078 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9079 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9080 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9082 g_corr6_loc(j-1)=g_corr6_loc(j-1)
9083 & +ekont*(-0.5d0*(scalar2(AEAb1derg(1,2,imat),CUgb2(1,i))
9084 & -scalar2(AEAb2derg(1,1,1,imat),Ug2Db1t(1,k))
9085 & +scalar2(AEAb2derg(1,1,1,imat),CUgb2(1,k))
9086 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))+scalar2(vv(1),Dtobr2(1,i))))
9088 call transpose2(EUgCder(1,1,k),auxmat(1,1))
9089 call matmat2(AEA(1,1,imat),auxmat(1,1),pizda1(1,1))
9090 vv1(1)=pizda1(1,1)-pizda1(2,2)
9091 vv1(2)=pizda1(1,2)+pizda1(2,1)
9092 if (k.gt.1) g_corr6_loc(k-1)=g_corr6_loc(k-1)
9093 & +ekont*(-0.5d0*(-scalar2(AEAb2(1,1,imat),Ug2Db1tder(1,k))
9094 & +scalar2(AEAb2(1,1,imat),CUgb2der(1,k))
9095 & +0.5d0*scalar2(vv1(1),Dtobr2(1,i))))
9104 s1= scalar2(AEAb1derx(1,lll,kkk,iii,2,imat),CUgb2(1,i))
9105 s2=-scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),Ug2Db1t(1,k))
9106 s3= scalar2(AEAb2derx(1,lll,kkk,iii,1,imat),CUgb2(1,k))
9107 call transpose2(EUgC(1,1,k),auxmat(1,1))
9108 call matmat2(AEAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9110 vv1(1)=pizda1(1,1)-pizda1(2,2)
9111 vv1(2)=pizda1(1,2)+pizda1(2,1)
9112 s4=0.5d0*scalar2(vv1(1),Dtobr2(1,i))
9113 vv(1)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(1,k)
9114 & -AEAb1derx(2,lll,kkk,iii,2,imat)*b1(2,k)
9115 vv(2)=AEAb1derx(1,lll,kkk,iii,2,imat)*b1(2,k)
9116 & +AEAb1derx(2,lll,kkk,iii,2,imat)*b1(1,k)
9117 s5=scalar2(vv(1),Dtobr2(1,i))
9118 derx(lll,kkk,ind)=derx(lll,kkk,ind)-0.5d0*(s1+s2+s3+s4+s5)
9124 c----------------------------------------------------------------------------
9125 double precision function eello6_graph2(i,j,k,l,jj,kk,swap)
9126 implicit real*8 (a-h,o-z)
9127 include 'DIMENSIONS'
9128 include 'COMMON.IOUNITS'
9129 include 'COMMON.CHAIN'
9130 include 'COMMON.DERIV'
9131 include 'COMMON.INTERACT'
9132 include 'COMMON.CONTACTS'
9133 include 'COMMON.TORSION'
9134 include 'COMMON.VAR'
9135 include 'COMMON.GEO'
9137 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9138 & auxvec1(2),auxvec2(2),auxmat1(2,2)
9141 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9143 C Parallel Antiparallel C
9149 C \ j|/k\| \ |/k\|l C
9154 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9155 cd write (2,*) 'eello6_graph2: i,',i,' j',j,' k',k,' l',l
9156 C AL 7/4/01 s1 would occur in the sixth-order moment,
9157 C but not in a cluster cumulant
9159 s1=dip(1,jj,i)*dip(1,kk,k)
9161 call matvec2(ADtEA1(1,1,1),Ub2(1,k),auxvec(1))
9162 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9163 call matvec2(ADtEA(1,1,2),Ub2(1,l),auxvec1(1))
9164 s3=-0.5d0*scalar2(Ub2(1,j),auxvec1(1))
9165 call transpose2(EUg(1,1,k),auxmat(1,1))
9166 call matmat2(ADtEA1(1,1,1),auxmat(1,1),pizda(1,1))
9167 vv(1)=pizda(1,1)-pizda(2,2)
9168 vv(2)=pizda(1,2)+pizda(2,1)
9169 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9170 cd write (2,*) 'eello6_graph2:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9172 eello6_graph2=-(s1+s2+s3+s4)
9174 eello6_graph2=-(s2+s3+s4)
9177 C Derivatives in gamma(i-1)
9180 s1=dipderg(1,jj,i)*dip(1,kk,k)
9182 s2=-0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9183 call matvec2(ADtEAderg(1,1,1,2),Ub2(1,l),auxvec2(1))
9184 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9185 s4=-0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9187 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9189 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9191 c g_corr6_loc(i-1)=g_corr6_loc(i-1)-s3
9193 C Derivatives in gamma(k-1)
9195 s1=dip(1,jj,i)*dipderg(1,kk,k)
9197 call matvec2(ADtEA1(1,1,1),Ub2der(1,k),auxvec2(1))
9198 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9199 call matvec2(ADtEAderg(1,1,2,2),Ub2(1,l),auxvec2(1))
9200 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9201 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9202 call matmat2(ADtEA1(1,1,1),auxmat1(1,1),pizda(1,1))
9203 vv(1)=pizda(1,1)-pizda(2,2)
9204 vv(2)=pizda(1,2)+pizda(2,1)
9205 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9207 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9209 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9211 c g_corr6_loc(k-1)=g_corr6_loc(k-1)-s3
9212 C Derivatives in gamma(j-1) or gamma(l-1)
9215 s1=dipderg(3,jj,i)*dip(1,kk,k)
9217 call matvec2(ADtEA1derg(1,1,1,1),Ub2(1,k),auxvec2(1))
9218 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9219 s3=-0.5d0*scalar2(Ub2der(1,j),auxvec1(1))
9220 call matmat2(ADtEA1derg(1,1,1,1),auxmat(1,1),pizda(1,1))
9221 vv(1)=pizda(1,1)-pizda(2,2)
9222 vv(2)=pizda(1,2)+pizda(2,1)
9223 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9226 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9228 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9231 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s3+s4)
9232 c g_corr6_loc(j-1)=g_corr6_loc(j-1)-s3
9234 C Derivatives in gamma(l-1) or gamma(j-1)
9237 s1=dip(1,jj,i)*dipderg(3,kk,k)
9239 call matvec2(ADtEA1derg(1,1,2,1),Ub2(1,k),auxvec2(1))
9240 s2=-0.5d0*scalar2(Ub2(1,i),auxvec2(1))
9241 call matvec2(ADtEA(1,1,2),Ub2der(1,l),auxvec2(1))
9242 s3=-0.5d0*scalar2(Ub2(1,j),auxvec2(1))
9243 call matmat2(ADtEA1derg(1,1,2,1),auxmat(1,1),pizda(1,1))
9244 vv(1)=pizda(1,1)-pizda(2,2)
9245 vv(2)=pizda(1,2)+pizda(2,1)
9246 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9249 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*s1
9251 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*s1
9254 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s3+s4)
9255 c g_corr6_loc(l-1)=g_corr6_loc(l-1)-s3
9257 C Cartesian derivatives.
9259 write (2,*) 'In eello6_graph2'
9261 write (2,*) 'iii=',iii
9263 write (2,*) 'kkk=',kkk
9265 write (2,'(3(2f10.5),5x)')
9266 & ((ADtEA1derx(jjj,mmm,lll,kkk,iii,1),mmm=1,2),lll=1,3)
9276 s1=dipderx(lll,kkk,1,jj,i)*dip(1,kk,k)
9278 s1=dip(1,jj,i)*dipderx(lll,kkk,1,kk,k)
9281 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,1),Ub2(1,k),
9283 s2=-0.5d0*scalar2(Ub2(1,i),auxvec(1))
9284 call matvec2(ADtEAderx(1,1,lll,kkk,iii,2),Ub2(1,l),
9286 s3=-0.5d0*scalar2(Ub2(1,j),auxvec(1))
9287 call transpose2(EUg(1,1,k),auxmat(1,1))
9288 call matmat2(ADtEA1derx(1,1,lll,kkk,iii,1),auxmat(1,1),
9290 vv(1)=pizda(1,1)-pizda(2,2)
9291 vv(2)=pizda(1,2)+pizda(2,1)
9292 s4=-0.25d0*scalar2(vv(1),Dtobr2(1,i))
9293 cd write (2,*) 's1',s1,' s2',s2,' s3',s3,' s4',s4
9295 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9297 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9300 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9302 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9309 c----------------------------------------------------------------------------
9310 double precision function eello6_graph3(i,j,k,l,jj,kk,swap)
9311 implicit real*8 (a-h,o-z)
9312 include 'DIMENSIONS'
9313 include 'COMMON.IOUNITS'
9314 include 'COMMON.CHAIN'
9315 include 'COMMON.DERIV'
9316 include 'COMMON.INTERACT'
9317 include 'COMMON.CONTACTS'
9318 include 'COMMON.TORSION'
9319 include 'COMMON.VAR'
9320 include 'COMMON.GEO'
9321 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2)
9323 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9325 C Parallel Antiparallel C
9331 C j|/k\| / |/k\|l / C
9336 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9338 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9339 C energy moment and not to the cluster cumulant.
9340 iti=itortyp(itype(i))
9341 if (j.lt.nres-1) then
9342 itj1=itortyp(itype(j+1))
9346 itk=itortyp(itype(k))
9347 itk1=itortyp(itype(k+1))
9348 if (l.lt.nres-1) then
9349 itl1=itortyp(itype(l+1))
9354 s1=dip(4,jj,i)*dip(4,kk,k)
9356 call matvec2(AECA(1,1,1),b1(1,k+1),auxvec(1))
9357 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9358 call matvec2(AECA(1,1,2),b1(1,l+1),auxvec(1))
9359 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9360 call transpose2(EE(1,1,itk),auxmat(1,1))
9361 call matmat2(auxmat(1,1),AECA(1,1,1),pizda(1,1))
9362 vv(1)=pizda(1,1)+pizda(2,2)
9363 vv(2)=pizda(2,1)-pizda(1,2)
9364 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9365 cd write (2,*) 'eello6_graph3:','s1',s1,' s2',s2,' s3',s3,' s4',s4,
9366 cd & "sum",-(s2+s3+s4)
9368 eello6_graph3=-(s1+s2+s3+s4)
9370 eello6_graph3=-(s2+s3+s4)
9373 C Derivatives in gamma(k-1)
9374 call matvec2(AECAderg(1,1,2),b1(1,l+1),auxvec(1))
9375 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9376 s4=-0.25d0*scalar2(vv(1),Ctobrder(1,k))
9377 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s3+s4)
9378 C Derivatives in gamma(l-1)
9379 call matvec2(AECAderg(1,1,1),b1(1,k+1),auxvec(1))
9380 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9381 call matmat2(auxmat(1,1),AECAderg(1,1,1),pizda(1,1))
9382 vv(1)=pizda(1,1)+pizda(2,2)
9383 vv(2)=pizda(2,1)-pizda(1,2)
9384 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9385 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9386 C Cartesian derivatives.
9392 s1=dipderx(lll,kkk,4,jj,i)*dip(4,kk,k)
9394 s1=dip(4,jj,i)*dipderx(lll,kkk,4,kk,k)
9397 call matvec2(AECAderx(1,1,lll,kkk,iii,1),b1(1,k+1),
9399 s2=0.5d0*scalar2(b1(1,k),auxvec(1))
9400 call matvec2(AECAderx(1,1,lll,kkk,iii,2),b1(1,l+1),
9402 s3=0.5d0*scalar2(b1(1,j+1),auxvec(1))
9403 call matmat2(auxmat(1,1),AECAderx(1,1,lll,kkk,iii,1),
9405 vv(1)=pizda(1,1)+pizda(2,2)
9406 vv(2)=pizda(2,1)-pizda(1,2)
9407 s4=-0.25d0*scalar2(vv(1),Ctobr(1,k))
9409 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9411 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9414 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9416 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9418 c derx(lll,kkk,iii)=derx(lll,kkk,iii)-s4
9424 c----------------------------------------------------------------------------
9425 double precision function eello6_graph4(i,j,k,l,jj,kk,imat,swap)
9426 implicit real*8 (a-h,o-z)
9427 include 'DIMENSIONS'
9428 include 'COMMON.IOUNITS'
9429 include 'COMMON.CHAIN'
9430 include 'COMMON.DERIV'
9431 include 'COMMON.INTERACT'
9432 include 'COMMON.CONTACTS'
9433 include 'COMMON.TORSION'
9434 include 'COMMON.VAR'
9435 include 'COMMON.GEO'
9436 include 'COMMON.FFIELD'
9437 double precision vv(2),pizda(2,2),auxmat(2,2),auxvec(2),
9438 & auxvec1(2),auxmat1(2,2)
9440 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9442 C Parallel Antiparallel C
9448 C \ j|/k\| \ |/k\|l C
9453 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9455 C 4/7/01 AL Component s1 was removed, because it pertains to the respective
9456 C energy moment and not to the cluster cumulant.
9457 cd write (2,*) 'eello_graph4: wturn6',wturn6
9458 iti=itortyp(itype(i))
9459 itj=itortyp(itype(j))
9460 if (j.lt.nres-1) then
9461 itj1=itortyp(itype(j+1))
9465 itk=itortyp(itype(k))
9466 if (k.lt.nres-1) then
9467 itk1=itortyp(itype(k+1))
9471 itl=itortyp(itype(l))
9472 if (l.lt.nres-1) then
9473 itl1=itortyp(itype(l+1))
9477 cd write (2,*) 'eello6_graph4:','i',i,' j',j,' k',k,' l',l
9478 cd write (2,*) 'iti',iti,' itj',itj,' itj1',itj1,' itk',itk,
9479 cd & ' itl',itl,' itl1',itl1
9482 s1=dip(3,jj,i)*dip(3,kk,k)
9484 s1=dip(2,jj,j)*dip(2,kk,l)
9487 call matvec2(AECA(1,1,imat),Ub2(1,k),auxvec(1))
9488 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9490 call matvec2(ADtEA1(1,1,3-imat),b1(1,j+1),auxvec1(1))
9491 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9493 call matvec2(ADtEA1(1,1,3-imat),b1(1,l+1),auxvec1(1))
9494 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9496 call transpose2(EUg(1,1,k),auxmat(1,1))
9497 call matmat2(AECA(1,1,imat),auxmat(1,1),pizda(1,1))
9498 vv(1)=pizda(1,1)-pizda(2,2)
9499 vv(2)=pizda(2,1)+pizda(1,2)
9500 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9501 cd write (2,*) 'eello6_graph4:','s1',s1,' s2',s2,' s3',s3,' s4',s4
9503 eello6_graph4=-(s1+s2+s3+s4)
9505 eello6_graph4=-(s2+s3+s4)
9507 C Derivatives in gamma(i-1)
9511 s1=dipderg(2,jj,i)*dip(3,kk,k)
9513 s1=dipderg(4,jj,j)*dip(2,kk,l)
9516 s2=0.5d0*scalar2(Ub2der(1,i),auxvec(1))
9518 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,j+1),auxvec1(1))
9519 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9521 call matvec2(ADtEA1derg(1,1,1,3-imat),b1(1,l+1),auxvec1(1))
9522 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9524 s4=0.25d0*scalar2(vv(1),Dtobr2der(1,i))
9525 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9526 cd write (2,*) 'turn6 derivatives'
9528 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s1+s2+s3+s4)
9530 gel_loc_turn6(i-1)=gel_loc_turn6(i-1)-ekont*(s2+s3+s4)
9534 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s1+s2+s3+s4)
9536 g_corr6_loc(i-1)=g_corr6_loc(i-1)-ekont*(s2+s3+s4)
9540 C Derivatives in gamma(k-1)
9543 s1=dip(3,jj,i)*dipderg(2,kk,k)
9545 s1=dip(2,jj,j)*dipderg(4,kk,l)
9548 call matvec2(AECA(1,1,imat),Ub2der(1,k),auxvec1(1))
9549 s2=0.5d0*scalar2(Ub2(1,i),auxvec1(1))
9551 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,j+1),auxvec1(1))
9552 s3=-0.5d0*scalar2(b1(1,j),auxvec1(1))
9554 call matvec2(ADtEA1derg(1,1,2,3-imat),b1(1,l+1),auxvec1(1))
9555 s3=-0.5d0*scalar2(b1(1,l),auxvec1(1))
9557 call transpose2(EUgder(1,1,k),auxmat1(1,1))
9558 call matmat2(AECA(1,1,imat),auxmat1(1,1),pizda(1,1))
9559 vv(1)=pizda(1,1)-pizda(2,2)
9560 vv(2)=pizda(2,1)+pizda(1,2)
9561 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9562 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9564 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s1+s2+s3+s4)
9566 gel_loc_turn6(k-1)=gel_loc_turn6(k-1)-ekont*(s2+s3+s4)
9570 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s1+s2+s3+s4)
9572 g_corr6_loc(k-1)=g_corr6_loc(k-1)-ekont*(s2+s3+s4)
9575 C Derivatives in gamma(j-1) or gamma(l-1)
9576 if (l.eq.j+1 .and. l.gt.1) then
9577 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9578 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9579 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9580 vv(1)=pizda(1,1)-pizda(2,2)
9581 vv(2)=pizda(2,1)+pizda(1,2)
9582 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9583 g_corr6_loc(l-1)=g_corr6_loc(l-1)-ekont*(s2+s4)
9584 else if (j.gt.1) then
9585 call matvec2(AECAderg(1,1,imat),Ub2(1,k),auxvec(1))
9586 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9587 call matmat2(AECAderg(1,1,imat),auxmat(1,1),pizda(1,1))
9588 vv(1)=pizda(1,1)-pizda(2,2)
9589 vv(2)=pizda(2,1)+pizda(1,2)
9590 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9591 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9592 gel_loc_turn6(j-1)=gel_loc_turn6(j-1)-ekont*(s2+s4)
9594 g_corr6_loc(j-1)=g_corr6_loc(j-1)-ekont*(s2+s4)
9597 C Cartesian derivatives.
9604 s1=dipderx(lll,kkk,3,jj,i)*dip(3,kk,k)
9606 s1=dipderx(lll,kkk,2,jj,j)*dip(2,kk,l)
9610 s1=dip(3,jj,i)*dipderx(lll,kkk,3,kk,k)
9612 s1=dip(2,jj,j)*dipderx(lll,kkk,2,kk,l)
9616 call matvec2(AECAderx(1,1,lll,kkk,iii,imat),Ub2(1,k),
9618 s2=0.5d0*scalar2(Ub2(1,i),auxvec(1))
9620 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9621 & b1(1,j+1),auxvec(1))
9622 s3=-0.5d0*scalar2(b1(1,j),auxvec(1))
9624 call matvec2(ADtEA1derx(1,1,lll,kkk,iii,3-imat),
9625 & b1(1,l+1),auxvec(1))
9626 s3=-0.5d0*scalar2(b1(1,l),auxvec(1))
9628 call matmat2(AECAderx(1,1,lll,kkk,iii,imat),auxmat(1,1),
9630 vv(1)=pizda(1,1)-pizda(2,2)
9631 vv(2)=pizda(2,1)+pizda(1,2)
9632 s4=0.25d0*scalar2(vv(1),Dtobr2(1,i))
9634 if (wturn6.gt.0.0d0 .and. k.eq.l+4 .and. i.eq.j+2) then
9636 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9639 derx_turn(lll,kkk,3-iii)=derx_turn(lll,kkk,3-iii)
9642 derx_turn(lll,kkk,iii)=derx_turn(lll,kkk,iii)-s3
9645 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s1+s2+s4)
9647 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-(s2+s4)
9649 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9653 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s1+s2+s4)
9655 derx(lll,kkk,iii)=derx(lll,kkk,iii)-(s2+s4)
9658 derx(lll,kkk,iii)=derx(lll,kkk,iii)-s3
9660 derx(lll,kkk,3-iii)=derx(lll,kkk,3-iii)-s3
9668 c----------------------------------------------------------------------------
9669 double precision function eello_turn6(i,jj,kk)
9670 implicit real*8 (a-h,o-z)
9671 include 'DIMENSIONS'
9672 include 'COMMON.IOUNITS'
9673 include 'COMMON.CHAIN'
9674 include 'COMMON.DERIV'
9675 include 'COMMON.INTERACT'
9676 include 'COMMON.CONTACTS'
9677 include 'COMMON.TORSION'
9678 include 'COMMON.VAR'
9679 include 'COMMON.GEO'
9680 double precision vtemp1(2),vtemp2(2),vtemp3(2),vtemp4(2),
9681 & atemp(2,2),auxmat(2,2),achuj_temp(2,2),gtemp(2,2),gvec(2),
9683 double precision vtemp1d(2),vtemp2d(2),vtemp3d(2),vtemp4d(2),
9684 & atempd(2,2),auxmatd(2,2),achuj_tempd(2,2),gtempd(2,2),gvecd(2)
9685 C 4/7/01 AL Components s1, s8, and s13 were removed, because they pertain to
9686 C the respective energy moment and not to the cluster cumulant.
9695 iti=itortyp(itype(i))
9696 itk=itortyp(itype(k))
9697 itk1=itortyp(itype(k+1))
9698 itl=itortyp(itype(l))
9699 itj=itortyp(itype(j))
9700 cd write (2,*) 'itk',itk,' itk1',itk1,' itl',itl,' itj',itj
9701 cd write (2,*) 'i',i,' k',k,' j',j,' l',l
9702 cd if (i.ne.1 .or. j.ne.3 .or. k.ne.2 .or. l.ne.4) then
9707 cd & 'EELLO6: Contacts have occurred for peptide groups',i,j,
9709 cd call checkint_turn6(i,jj,kk,eel_turn6_num)
9713 derx_turn(lll,kkk,iii)=0.0d0
9720 eello6_5=eello6_graph4(l,k,j,i,kk,jj,2,.true.)
9722 cd write (2,*) 'eello6_5',eello6_5
9724 call transpose2(AEA(1,1,1),auxmat(1,1))
9725 call matmat2(EUg(1,1,i+1),auxmat(1,1),auxmat(1,1))
9726 ss1=scalar2(Ub2(1,i+2),b1(1,l))
9727 s1 = (auxmat(1,1)+auxmat(2,2))*ss1
9729 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
9730 call matvec2(AEA(1,1,1),vtemp1(1),vtemp1(1))
9731 s2 = scalar2(b1(1,k),vtemp1(1))
9733 call transpose2(AEA(1,1,2),atemp(1,1))
9734 call matmat2(atemp(1,1),EUg(1,1,i+4),atemp(1,1))
9735 call matvec2(Ug2(1,1,i+2),dd(1,1,itk1),vtemp2(1))
9736 s8 = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9738 call matmat2(EUg(1,1,i+3),AEA(1,1,2),auxmat(1,1))
9739 call matvec2(auxmat(1,1),Ub2(1,i+4),vtemp3(1))
9740 s12 = scalar2(Ub2(1,i+2),vtemp3(1))
9742 call transpose2(a_chuj(1,1,kk,i+1),achuj_temp(1,1))
9743 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtemp(1,1))
9744 call matmat2(gtemp(1,1),EUg(1,1,i+3),gtemp(1,1))
9745 call matvec2(a_chuj(1,1,jj,i),Ub2(1,i+4),vtemp4(1))
9746 ss13 = scalar2(b1(1,k),vtemp4(1))
9747 s13 = (gtemp(1,1)+gtemp(2,2))*ss13
9749 c write (2,*) 's1,s2,s8,s12,s13',s1,s2,s8,s12,s13
9755 eel_turn6 = eello6_5 - 0.5d0*(s1+s2+s12+s8+s13)
9756 C Derivatives in gamma(i+2)
9760 call transpose2(AEA(1,1,1),auxmatd(1,1))
9761 call matmat2(EUgder(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9762 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9763 call transpose2(AEAderg(1,1,2),atempd(1,1))
9764 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9765 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9767 call matmat2(EUg(1,1,i+3),AEAderg(1,1,2),auxmatd(1,1))
9768 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9769 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9775 gel_loc_turn6(i)=gel_loc_turn6(i)-0.5d0*ekont*(s1d+s8d+s12d)
9776 C Derivatives in gamma(i+3)
9778 call transpose2(AEA(1,1,1),auxmatd(1,1))
9779 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9780 ss1d=scalar2(Ub2der(1,i+2),b1(1,l))
9781 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1d
9783 call matvec2(EUgder(1,1,i+2),b1(1,l),vtemp1d(1))
9784 call matvec2(AEA(1,1,1),vtemp1d(1),vtemp1d(1))
9785 s2d = scalar2(b1(1,k),vtemp1d(1))
9787 call matvec2(Ug2der(1,1,i+2),dd(1,1,itk1),vtemp2d(1))
9788 s8d = -(atemp(1,1)+atemp(2,2))*scalar2(cc(1,1,itl),vtemp2d(1))
9790 s12d = scalar2(Ub2der(1,i+2),vtemp3(1))
9792 call matmat2(achuj_temp(1,1),EUgder(1,1,i+2),gtempd(1,1))
9793 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9794 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9802 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9803 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9805 gel_loc_turn6(i+1)=gel_loc_turn6(i+1)
9806 & -0.5d0*ekont*(s2d+s12d)
9808 C Derivatives in gamma(i+4)
9809 call matmat2(EUgder(1,1,i+3),AEA(1,1,2),auxmatd(1,1))
9810 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9811 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9813 call matmat2(achuj_temp(1,1),EUg(1,1,i+2),gtempd(1,1))
9814 call matmat2(gtempd(1,1),EUgder(1,1,i+3),gtempd(1,1))
9815 s13d = (gtempd(1,1)+gtempd(2,2))*ss13
9823 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d+s13d)
9825 gel_loc_turn6(i+2)=gel_loc_turn6(i+2)-0.5d0*ekont*(s12d)
9827 C Derivatives in gamma(i+5)
9829 call transpose2(AEAderg(1,1,1),auxmatd(1,1))
9830 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9831 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9833 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1d(1))
9834 call matvec2(AEAderg(1,1,1),vtemp1d(1),vtemp1d(1))
9835 s2d = scalar2(b1(1,k),vtemp1d(1))
9837 call transpose2(AEA(1,1,2),atempd(1,1))
9838 call matmat2(atempd(1,1),EUgder(1,1,i+4),atempd(1,1))
9839 s8d = -(atempd(1,1)+atempd(2,2))*scalar2(cc(1,1,itl),vtemp2(1))
9841 call matvec2(auxmat(1,1),Ub2der(1,i+4),vtemp3d(1))
9842 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9844 call matvec2(a_chuj(1,1,jj,i),Ub2der(1,i+4),vtemp4d(1))
9845 ss13d = scalar2(b1(1,k),vtemp4d(1))
9846 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9854 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9855 & -0.5d0*ekont*(s1d+s2d+s8d+s12d+s13d)
9857 gel_loc_turn6(i+3)=gel_loc_turn6(i+3)
9858 & -0.5d0*ekont*(s2d+s12d)
9860 C Cartesian derivatives
9865 call transpose2(AEAderx(1,1,lll,kkk,iii,1),auxmatd(1,1))
9866 call matmat2(EUg(1,1,i+1),auxmatd(1,1),auxmatd(1,1))
9867 s1d = (auxmatd(1,1)+auxmatd(2,2))*ss1
9869 call matvec2(EUg(1,1,i+2),b1(1,l),vtemp1(1))
9870 call matvec2(AEAderx(1,1,lll,kkk,iii,1),vtemp1(1),
9872 s2d = scalar2(b1(1,k),vtemp1d(1))
9874 call transpose2(AEAderx(1,1,lll,kkk,iii,2),atempd(1,1))
9875 call matmat2(atempd(1,1),EUg(1,1,i+4),atempd(1,1))
9876 s8d = -(atempd(1,1)+atempd(2,2))*
9877 & scalar2(cc(1,1,itl),vtemp2(1))
9879 call matmat2(EUg(1,1,i+3),AEAderx(1,1,lll,kkk,iii,2),
9881 call matvec2(auxmatd(1,1),Ub2(1,i+4),vtemp3d(1))
9882 s12d = scalar2(Ub2(1,i+2),vtemp3d(1))
9889 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9892 derx_turn(lll,kkk,iii) = derx_turn(lll,kkk,iii)
9896 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9897 & - 0.5d0*(s8d+s12d)
9899 derx_turn(lll,kkk,3-iii) = derx_turn(lll,kkk,3-iii)
9908 call transpose2(a_chuj_der(1,1,lll,kkk,kk,i+1),
9910 call matmat2(achuj_tempd(1,1),EUg(1,1,i+2),gtempd(1,1))
9911 call matmat2(gtempd(1,1),EUg(1,1,i+3),gtempd(1,1))
9912 s13d=(gtempd(1,1)+gtempd(2,2))*ss13
9913 derx_turn(lll,kkk,2) = derx_turn(lll,kkk,2)-0.5d0*s13d
9914 call matvec2(a_chuj_der(1,1,lll,kkk,jj,i),Ub2(1,i+4),
9916 ss13d = scalar2(b1(1,k),vtemp4d(1))
9917 s13d = (gtemp(1,1)+gtemp(2,2))*ss13d
9918 derx_turn(lll,kkk,1) = derx_turn(lll,kkk,1)-0.5d0*s13d
9922 cd write(iout,*) 'eel6_turn6',eel_turn6,' eel_turn6_num',
9923 cd & 16*eel_turn6_num
9925 if (j.lt.nres-1) then
9932 if (l.lt.nres-1) then
9940 cgrad ggg1(ll)=eel_turn6*g_contij(ll,1)
9941 cgrad ggg2(ll)=eel_turn6*g_contij(ll,2)
9942 cgrad ghalf=0.5d0*ggg1(ll)
9944 gturn6ij=eel_turn6*g_contij(ll,1)+ekont*derx_turn(ll,1,1)
9945 gturn6kl=eel_turn6*g_contij(ll,2)+ekont*derx_turn(ll,1,2)
9946 gcorr6_turn(ll,i)=gcorr6_turn(ll,i)!+ghalf
9947 & +ekont*derx_turn(ll,2,1)
9948 gcorr6_turn(ll,i+1)=gcorr6_turn(ll,i+1)+ekont*derx_turn(ll,3,1)
9949 gcorr6_turn(ll,j)=gcorr6_turn(ll,j)!+ghalf
9950 & +ekont*derx_turn(ll,4,1)
9951 gcorr6_turn(ll,j1)=gcorr6_turn(ll,j1)+ekont*derx_turn(ll,5,1)
9952 gcorr6_turn_long(ll,j)=gcorr6_turn_long(ll,j)+gturn6ij
9953 gcorr6_turn_long(ll,i)=gcorr6_turn_long(ll,i)-gturn6ij
9954 cgrad ghalf=0.5d0*ggg2(ll)
9956 gcorr6_turn(ll,k)=gcorr6_turn(ll,k)!+ghalf
9957 & +ekont*derx_turn(ll,2,2)
9958 gcorr6_turn(ll,k+1)=gcorr6_turn(ll,k+1)+ekont*derx_turn(ll,3,2)
9959 gcorr6_turn(ll,l)=gcorr6_turn(ll,l)!+ghalf
9960 & +ekont*derx_turn(ll,4,2)
9961 gcorr6_turn(ll,l1)=gcorr6_turn(ll,l1)+ekont*derx_turn(ll,5,2)
9962 gcorr6_turn_long(ll,l)=gcorr6_turn_long(ll,l)+gturn6kl
9963 gcorr6_turn_long(ll,k)=gcorr6_turn_long(ll,k)-gturn6kl
9968 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg1(ll)
9973 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ggg2(ll)
9979 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,1)
9984 cgrad gcorr6_turn(ll,m)=gcorr6_turn(ll,m)+ekont*derx_turn(ll,1,2)
9988 cd write (2,*) iii,g_corr6_loc(iii)
9990 eello_turn6=ekont*eel_turn6
9991 cd write (2,*) 'ekont',ekont
9992 cd write (2,*) 'eel_turn6',ekont*eel_turn6
9996 C-----------------------------------------------------------------------------
9997 double precision function scalar(u,v)
9998 !DIR$ INLINEALWAYS scalar
10000 cDEC$ ATTRIBUTES FORCEINLINE::scalar
10003 double precision u(3),v(3)
10004 cd double precision sc
10012 scalar=u(1)*v(1)+u(2)*v(2)+u(3)*v(3)
10015 crc-------------------------------------------------
10016 SUBROUTINE MATVEC2(A1,V1,V2)
10017 !DIR$ INLINEALWAYS MATVEC2
10019 cDEC$ ATTRIBUTES FORCEINLINE::MATVEC2
10021 implicit real*8 (a-h,o-z)
10022 include 'DIMENSIONS'
10023 DIMENSION A1(2,2),V1(2),V2(2)
10027 c 3 VI=VI+A1(I,K)*V1(K)
10031 vaux1=a1(1,1)*v1(1)+a1(1,2)*v1(2)
10032 vaux2=a1(2,1)*v1(1)+a1(2,2)*v1(2)
10037 C---------------------------------------
10038 SUBROUTINE MATMAT2(A1,A2,A3)
10040 cDEC$ ATTRIBUTES FORCEINLINE::MATMAT2
10042 implicit real*8 (a-h,o-z)
10043 include 'DIMENSIONS'
10044 DIMENSION A1(2,2),A2(2,2),A3(2,2)
10045 c DIMENSION AI3(2,2)
10049 c A3IJ=A3IJ+A1(I,K)*A2(K,J)
10055 ai3_11=a1(1,1)*a2(1,1)+a1(1,2)*a2(2,1)
10056 ai3_12=a1(1,1)*a2(1,2)+a1(1,2)*a2(2,2)
10057 ai3_21=a1(2,1)*a2(1,1)+a1(2,2)*a2(2,1)
10058 ai3_22=a1(2,1)*a2(1,2)+a1(2,2)*a2(2,2)
10066 c-------------------------------------------------------------------------
10067 double precision function scalar2(u,v)
10068 !DIR$ INLINEALWAYS scalar2
10070 double precision u(2),v(2)
10071 double precision sc
10073 scalar2=u(1)*v(1)+u(2)*v(2)
10077 C-----------------------------------------------------------------------------
10079 subroutine transpose2(a,at)
10080 !DIR$ INLINEALWAYS transpose2
10082 cDEC$ ATTRIBUTES FORCEINLINE::transpose2
10085 double precision a(2,2),at(2,2)
10092 c--------------------------------------------------------------------------
10093 subroutine transpose(n,a,at)
10096 double precision a(n,n),at(n,n)
10104 C---------------------------------------------------------------------------
10105 subroutine prodmat3(a1,a2,kk,transp,prod)
10106 !DIR$ INLINEALWAYS prodmat3
10108 cDEC$ ATTRIBUTES FORCEINLINE::prodmat3
10112 double precision a1(2,2),a2(2,2),a2t(2,2),kk(2,2),prod(2,2)
10114 crc double precision auxmat(2,2),prod_(2,2)
10117 crc call transpose2(kk(1,1),auxmat(1,1))
10118 crc call matmat2(a1(1,1),auxmat(1,1),auxmat(1,1))
10119 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10121 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,1)
10122 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,1)
10123 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(1,2))*a2(1,2)
10124 & +(a1(1,1)*kk(2,1)+a1(1,2)*kk(2,2))*a2(2,2)
10125 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,1)
10126 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,1)
10127 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(1,2))*a2(1,2)
10128 & +(a1(2,1)*kk(2,1)+a1(2,2)*kk(2,2))*a2(2,2)
10131 crc call matmat2(a1(1,1),kk(1,1),auxmat(1,1))
10132 crc call matmat2(auxmat(1,1),a2(1,1),prod_(1,1))
10134 prod(1,1)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,1)
10135 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,1)
10136 prod(1,2)=(a1(1,1)*kk(1,1)+a1(1,2)*kk(2,1))*a2(1,2)
10137 & +(a1(1,1)*kk(1,2)+a1(1,2)*kk(2,2))*a2(2,2)
10138 prod(2,1)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,1)
10139 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,1)
10140 prod(2,2)=(a1(2,1)*kk(1,1)+a1(2,2)*kk(2,1))*a2(1,2)
10141 & +(a1(2,1)*kk(1,2)+a1(2,2)*kk(2,2))*a2(2,2)
10144 c call transpose2(a2(1,1),a2t(1,1))
10147 crc print *,((prod_(i,j),i=1,2),j=1,2)
10148 crc print *,((prod(i,j),i=1,2),j=1,2)
10152 CCC----------------------------------------------
10153 subroutine Eliptransfer(eliptran)
10154 implicit real*8 (a-h,o-z)
10155 include 'DIMENSIONS'
10156 include 'COMMON.GEO'
10157 include 'COMMON.VAR'
10158 include 'COMMON.LOCAL'
10159 include 'COMMON.CHAIN'
10160 include 'COMMON.DERIV'
10161 include 'COMMON.NAMES'
10162 include 'COMMON.INTERACT'
10163 include 'COMMON.IOUNITS'
10164 include 'COMMON.CALC'
10165 include 'COMMON.CONTROL'
10166 include 'COMMON.SPLITELE'
10167 include 'COMMON.SBRIDGE'
10168 C this is done by Adasko
10169 C print *,"wchodze"
10170 C structure of box:
10172 C--bordliptop-- buffore starts
10173 C--bufliptop--- here true lipid starts
10175 C--buflipbot--- lipid ends buffore starts
10176 C--bordlipbot--buffore ends
10178 do i=ilip_start,ilip_end
10180 if (itype(i).eq.ntyp1) cycle
10182 positi=(mod(((c(3,i)+c(3,i+1))/2.0d0),boxzsize))
10183 if (positi.le.0) positi=positi+boxzsize
10185 C first for peptide groups
10186 c for each residue check if it is in lipid or lipid water border area
10187 if ((positi.gt.bordlipbot)
10188 &.and.(positi.lt.bordliptop)) then
10189 C the energy transfer exist
10190 if (positi.lt.buflipbot) then
10191 C what fraction I am in
10193 & ((positi-bordlipbot)/lipbufthick)
10194 C lipbufthick is thickenes of lipid buffore
10195 sslip=sscalelip(fracinbuf)
10196 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
10197 eliptran=eliptran+sslip*pepliptran
10198 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10199 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10200 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10202 C print *,"doing sccale for lower part"
10203 C print *,i,sslip,fracinbuf,ssgradlip
10204 elseif (positi.gt.bufliptop) then
10205 fracinbuf=1.0d0-((bordliptop-positi)/lipbufthick)
10206 sslip=sscalelip(fracinbuf)
10207 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
10208 eliptran=eliptran+sslip*pepliptran
10209 gliptranc(3,i)=gliptranc(3,i)+ssgradlip*pepliptran/2.0d0
10210 gliptranc(3,i-1)=gliptranc(3,i-1)+ssgradlip*pepliptran/2.0d0
10211 C gliptranc(3,i-2)=gliptranc(3,i)+ssgradlip*pepliptran
10212 C print *, "doing sscalefor top part"
10213 C print *,i,sslip,fracinbuf,ssgradlip
10215 eliptran=eliptran+pepliptran
10216 C print *,"I am in true lipid"
10219 C eliptran=elpitran+0.0 ! I am in water
10222 C print *, "nic nie bylo w lipidzie?"
10223 C now multiply all by the peptide group transfer factor
10224 C eliptran=eliptran*pepliptran
10225 C now the same for side chains
10227 do i=ilip_start,ilip_end
10228 if (itype(i).eq.ntyp1) cycle
10229 positi=(mod(c(3,i+nres),boxzsize))
10230 if (positi.le.0) positi=positi+boxzsize
10231 C print *,mod(c(3,i+nres),boxzsize),bordlipbot,bordliptop
10232 c for each residue check if it is in lipid or lipid water border area
10233 C respos=mod(c(3,i+nres),boxzsize)
10234 C print *,positi,bordlipbot,buflipbot
10235 if ((positi.gt.bordlipbot)
10236 & .and.(positi.lt.bordliptop)) then
10237 C the energy transfer exist
10238 if (positi.lt.buflipbot) then
10240 & ((positi-bordlipbot)/lipbufthick)
10241 C lipbufthick is thickenes of lipid buffore
10242 sslip=sscalelip(fracinbuf)
10243 ssgradlip=-sscagradlip(fracinbuf)/lipbufthick
10244 eliptran=eliptran+sslip*liptranene(itype(i))
10245 gliptranx(3,i)=gliptranx(3,i)
10246 &+ssgradlip*liptranene(itype(i))
10247 gliptranc(3,i-1)= gliptranc(3,i-1)
10248 &+ssgradlip*liptranene(itype(i))
10249 C print *,"doing sccale for lower part"
10250 elseif (positi.gt.bufliptop) then
10252 &((bordliptop-positi)/lipbufthick)
10253 sslip=sscalelip(fracinbuf)
10254 ssgradlip=sscagradlip(fracinbuf)/lipbufthick
10255 eliptran=eliptran+sslip*liptranene(itype(i))
10256 gliptranx(3,i)=gliptranx(3,i)
10257 &+ssgradlip*liptranene(itype(i))
10258 gliptranc(3,i-1)= gliptranc(3,i-1)
10259 &+ssgradlip*liptranene(itype(i))
10260 C print *, "doing sscalefor top part",sslip,fracinbuf
10262 eliptran=eliptran+liptranene(itype(i))
10263 C print *,"I am in true lipid"
10265 endif ! if in lipid or buffor
10267 C eliptran=elpitran+0.0 ! I am in water
10271 C---------------------------------------------------------
10272 C AFM soubroutine for constant force
10273 subroutine AFMforce(Eafmforce)
10274 implicit real*8 (a-h,o-z)
10275 include 'DIMENSIONS'
10276 include 'COMMON.GEO'
10277 include 'COMMON.VAR'
10278 include 'COMMON.LOCAL'
10279 include 'COMMON.CHAIN'
10280 include 'COMMON.DERIV'
10281 include 'COMMON.NAMES'
10282 include 'COMMON.INTERACT'
10283 include 'COMMON.IOUNITS'
10284 include 'COMMON.CALC'
10285 include 'COMMON.CONTROL'
10286 include 'COMMON.SPLITELE'
10287 include 'COMMON.SBRIDGE'
10292 diffafm(i)=c(i,afmend)-c(i,afmbeg)
10293 dist=dist+diffafm(i)**2
10296 Eafmforce=-forceAFMconst*(dist-distafminit)
10298 gradafm(i,afmend-1)=-forceAFMconst*diffafm(i)/dist
10299 gradafm(i,afmbeg-1)=forceAFMconst*diffafm(i)/dist
10301 C print *,'AFM',Eafmforce
10304 C---------------------------------------------------------
10305 C AFM subroutine with pseudoconstant velocity
10306 subroutine AFMvel(Eafmforce)
10307 implicit real*8 (a-h,o-z)
10308 include 'DIMENSIONS'
10309 include 'COMMON.GEO'
10310 include 'COMMON.VAR'
10311 include 'COMMON.LOCAL'
10312 include 'COMMON.CHAIN'
10313 include 'COMMON.DERIV'
10314 include 'COMMON.NAMES'
10315 include 'COMMON.INTERACT'
10316 include 'COMMON.IOUNITS'
10317 include 'COMMON.CALC'
10318 include 'COMMON.CONTROL'
10319 include 'COMMON.SPLITELE'
10320 include 'COMMON.SBRIDGE'
10322 C Only for check grad COMMENT if not used for checkgrad
10324 C--------------------------------------------------------
10325 C print *,"wchodze"
10329 diffafm(i)=c(i,afmend)-c(i,afmbeg)
10330 dist=dist+diffafm(i)**2
10333 Eafmforce=0.5d0*forceAFMconst
10334 & *(distafminit+totTafm*velAFMconst-dist)**2
10335 C Eafmforce=-forceAFMconst*(dist-distafminit)
10337 gradafm(i,afmend-1)=-forceAFMconst*
10338 &(distafminit+totTafm*velAFMconst-dist)
10340 gradafm(i,afmbeg-1)=forceAFMconst*
10341 &(distafminit+totTafm*velAFMconst-dist)
10344 C print *,'AFM',Eafmforce,totTafm*velAFMconst,dist